math.vectors: rename "v." to "vdot"
John Benediktsson
parent
29054e53e8
commit
1c5d417100
|
|
@ -11,7 +11,7 @@ CONSTANT: adler-32-modulus 65521
|
|||
M: adler-32 checksum-bytes ( bytes checksum -- value )
|
||||
drop
|
||||
[ sum 1 + ]
|
||||
[ [ dup length [1,b] <reversed> v. ] [ length ] bi + ] bi
|
||||
[ [ dup length [1,b] <reversed> vdot ] [ length ] bi + ] bi
|
||||
[ adler-32-modulus mod ] bi@ 16 shift bitor ;
|
||||
|
||||
INSTANCE: adler-32 checksum
|
||||
|
|
|
|||
|
|
@ -238,13 +238,13 @@ M: horizontal-cpu %horizontal-add-vector-reps signed-reps ;
|
|||
M: horizontal-cpu %unpack-vector-head-reps signed-reps ;
|
||||
M: horizontal-cpu %unpack-vector-tail-reps signed-reps ;
|
||||
|
||||
! v.
|
||||
! vdot
|
||||
{ { ##dot-vector } }
|
||||
[ dot-cpu float-4-rep [ emit-simd-v. ] test-emit ]
|
||||
[ dot-cpu float-4-rep [ emit-simd-vdot ] test-emit ]
|
||||
unit-test
|
||||
|
||||
{ { ##mul-vector ##horizontal-add-vector ##horizontal-add-vector ##vector>scalar } }
|
||||
[ horizontal-cpu float-4-rep [ emit-simd-v. ] test-emit ]
|
||||
[ horizontal-cpu float-4-rep [ emit-simd-vdot ] test-emit ]
|
||||
unit-test
|
||||
|
||||
{ {
|
||||
|
|
@ -253,7 +253,7 @@ unit-test
|
|||
##merge-vector-head ##merge-vector-tail ##add-vector
|
||||
##vector>scalar
|
||||
} }
|
||||
[ simple-ops-cpu float-4-rep [ emit-simd-v. ] test-emit ]
|
||||
[ simple-ops-cpu float-4-rep [ emit-simd-vdot ] test-emit ]
|
||||
unit-test
|
||||
|
||||
! vsqrt
|
||||
|
|
|
|||
|
|
@ -417,7 +417,7 @@ PREDICATE: fixnum-vector-rep < int-vector-rep
|
|||
] }
|
||||
} emit-vv-vector-op ;
|
||||
|
||||
: emit-simd-v. ( node -- )
|
||||
: emit-simd-vdot ( node -- )
|
||||
{
|
||||
[ ^^dot-vector ]
|
||||
{ float-vector-rep [ [ ^^mul-vector ] [ ^sum-vector ] bi ] }
|
||||
|
|
@ -667,7 +667,7 @@ PREDICATE: fixnum-vector-rep < int-vector-rep
|
|||
{ (simd-vmin) [ emit-simd-vmin ] }
|
||||
{ (simd-vmax) [ emit-simd-vmax ] }
|
||||
{ (simd-vavg) [ emit-simd-vavg ] }
|
||||
{ (simd-v.) [ emit-simd-v. ] }
|
||||
{ (simd-vdot [ emit-simd-vdot ] }
|
||||
{ (simd-vsad) [ emit-simd-vsad ] }
|
||||
{ (simd-vsqrt) [ emit-simd-vsqrt ] }
|
||||
{ (simd-sum) [ emit-simd-sum ] }
|
||||
|
|
|
|||
|
|
@ -248,8 +248,8 @@ DEFER: matrix-set-nths
|
|||
: m* ( m1 m2 -- m ) [ v* ] 2map ;
|
||||
: m/ ( m1 m2 -- m ) [ v/ ] 2map ;
|
||||
|
||||
: v.m ( v m -- p ) flip [ v. ] with map ;
|
||||
: m.v ( m v -- p ) [ v. ] curry map ;
|
||||
: v.m ( v m -- p ) flip [ vdot ] with map ;
|
||||
: m.v ( m v -- p ) [ vdot ] curry map ;
|
||||
: m. ( m m -- m ) flip [ swap m.v ] curry map ;
|
||||
|
||||
: m~ ( m1 m2 epsilon -- ? ) [ v~ ] curry 2all? ;
|
||||
|
|
|
|||
|
|
@ -36,7 +36,7 @@ ALIAS: n*p n*v
|
|||
[ drop length [ <iota> ] keep ]
|
||||
[ nip <reversed> ]
|
||||
[ drop ] 2tri
|
||||
'[ _ _ <slice> _ v. ] map reverse! ;
|
||||
'[ _ _ <slice> _ vdot ] map reverse! ;
|
||||
|
||||
: p-sq ( p -- p^2 ) dup p* ; inline
|
||||
|
||||
|
|
|
|||
|
|
@ -70,7 +70,7 @@ PRIVATE>
|
|||
{ } euler-like ; inline
|
||||
|
||||
:: slerp ( q0 q1 t -- qt )
|
||||
q0 q1 v. -1.0 1.0 clamp :> dot
|
||||
q0 q1 vdot -1.0 1.0 clamp :> dot
|
||||
dot facos t * :> omega
|
||||
q1 dot q0 n*v v- normalize :> qt'
|
||||
omega fcos q0 n*v omega fsin qt' n*v v+ ; inline
|
||||
|
|
|
|||
|
|
@ -23,11 +23,11 @@ $nl
|
|||
$nl
|
||||
"SSE2 introduces double-precision SIMD (" { $snippet "double-2" } ") and integer SIMD (all types). Integer SIMD is missing a few features; in particular, the " { $link vmin } " and " { $link vmax } " operations only work on " { $snippet "uchar-16" } " and " { $snippet "short-8" } "."
|
||||
$nl
|
||||
"SSE3 introduces horizontal adds (summing all components of a single vector register), which are useful for computing dot products. Where available, SSE3 operations are used to speed up " { $link sum } ", " { $link v. } ", " { $link norm-sq } ", " { $link norm } ", and " { $link distance } "."
|
||||
"SSE3 introduces horizontal adds (summing all components of a single vector register), which are useful for computing dot products. Where available, SSE3 operations are used to speed up " { $link sum } ", " { $link vdot } ", " { $link norm-sq } ", " { $link norm } ", and " { $link distance } "."
|
||||
$nl
|
||||
"SSSE3 introduces " { $link vabs } " for " { $snippet "char-16" } ", " { $snippet "short-8" } " and " { $snippet "int-4" } "."
|
||||
$nl
|
||||
"SSE4.1 introduces " { $link vmin } " and " { $link vmax } " for all remaining integer types, a faster instruction for " { $link v. } ", and a few other things."
|
||||
"SSE4.1 introduces " { $link vmin } " and " { $link vmax } " for all remaining integer types, a faster instruction for " { $link vdot } ", and a few other things."
|
||||
$nl
|
||||
"On PowerPC, or older x86 chips without SSE, software fallbacks are used for all high-level vector operations. SIMD code can run with no loss in functionality, just decreased performance."
|
||||
$nl
|
||||
|
|
|
|||
|
|
@ -80,7 +80,7 @@ CONSTANT: vector-words
|
|||
{ vneg { +vector+ -> +vector+ } }
|
||||
{ vs- { +vector+ +vector+ -> +vector+ } }
|
||||
{ v-n { +vector+ +scalar+ -> +vector+ } }
|
||||
{ v. { +vector+ +vector+ -> +scalar+ } }
|
||||
{ vdot { +vector+ +vector+ -> +scalar+ } }
|
||||
{ vsad { +vector+ +vector+ -> +scalar+ } }
|
||||
{ v/ { +vector+ +vector+ -> +vector+ } }
|
||||
{ v/n { +vector+ +scalar+ -> +vector+ } }
|
||||
|
|
|
|||
|
|
@ -171,8 +171,8 @@ M: simd-128 vmin
|
|||
dup simd-rep [ (simd-vmin) ] [ call-next-method ] vv->v-op ; inline
|
||||
M: simd-128 vmax
|
||||
dup simd-rep [ (simd-vmax) ] [ call-next-method ] vv->v-op ; inline
|
||||
M: simd-128 v.
|
||||
dup simd-rep [ (simd-v.) ] [ call-next-method ] vv->x-op ; inline
|
||||
M: simd-128 vdot
|
||||
dup simd-rep [ (simd-vdot) ] [ call-next-method ] vv->x-op ; inline
|
||||
M: simd-128 vsad
|
||||
dup simd-rep [ (simd-vsad) ] [ call-next-method ] vv->x-op ; inline
|
||||
M: simd-128 vsqrt
|
||||
|
|
@ -253,7 +253,7 @@ M: simd-128 v+n over simd-with v+ ; inline
|
|||
M: simd-128 v-n over simd-with v- ; inline
|
||||
M: simd-128 v*n over simd-with v* ; inline
|
||||
M: simd-128 v/n over simd-with v/ ; inline
|
||||
M: simd-128 norm-sq dup v. assert-positive ; inline
|
||||
M: simd-128 norm-sq dup vdot assert-positive ; inline
|
||||
M: simd-128 distance v- norm ; inline
|
||||
|
||||
M: simd-128 >pprint-sequence ;
|
||||
|
|
|
|||
|
|
@ -43,7 +43,7 @@ ARTICLE: "math-vectors-arithmetic" "Vector arithmetic"
|
|||
}
|
||||
"Inner product and norm:"
|
||||
{ $subsections
|
||||
v.
|
||||
vdot
|
||||
norm
|
||||
norm-sq
|
||||
normalize
|
||||
|
|
@ -314,7 +314,7 @@ HELP: vclamp
|
|||
}
|
||||
} ;
|
||||
|
||||
HELP: v.
|
||||
HELP: vdot
|
||||
{ $values { "u" { $sequence real } } { "v" { $sequence real } } { "x" real } }
|
||||
{ $description "Computes the dot product of two vectors." } ;
|
||||
|
||||
|
|
@ -588,7 +588,7 @@ HELP: vnone?
|
|||
|
||||
{ 2map v+ v- v* v/ } related-words
|
||||
|
||||
{ 2reduce v. } related-words
|
||||
{ 2reduce vdot } related-words
|
||||
|
||||
{ vs+ vs- vs* } related-words
|
||||
|
||||
|
|
|
|||
|
|
@ -30,8 +30,8 @@ SPECIALIZED-ARRAY: int
|
|||
|
||||
{ { 0 3 2 5 4 } } [ { 1 2 3 4 5 } { 1 1 1 1 1 } v+- ] unit-test
|
||||
|
||||
{ 32 } [ { 1 2 3 } { 4 5 6 } v. ] unit-test
|
||||
{ -1 } [ { C{ 0 1 } } dup v. ] unit-test
|
||||
{ 32 } [ { 1 2 3 } { 4 5 6 } vdot ] unit-test
|
||||
{ -1 } [ { C{ 0 1 } } dup vdot ] unit-test
|
||||
|
||||
{ 1 } [ { C{ 0 1 } } dup h. ] unit-test
|
||||
|
||||
|
|
|
|||
|
|
@ -217,8 +217,8 @@ M: object v?
|
|||
: vsupremum ( seq -- vmax ) [ ] [ vmax ] map-reduce ; inline
|
||||
: vinfimum ( seq -- vmin ) [ ] [ vmin ] map-reduce ; inline
|
||||
|
||||
GENERIC: v. ( u v -- x )
|
||||
M: object v. [ * ] [ + ] 2map-reduce ; inline
|
||||
GENERIC: vdot ( u v -- x )
|
||||
M: object vdot [ * ] [ + ] 2map-reduce ; inline
|
||||
|
||||
GENERIC: h. ( u v -- x )
|
||||
M: object h. [ conjugate * ] [ + ] 2map-reduce ; inline
|
||||
|
|
@ -288,7 +288,7 @@ PRIVATE>
|
|||
vec2 vec1 v- vec3 vec1 v- cross normalize ; inline
|
||||
|
||||
: proj ( v u -- w )
|
||||
[ [ v. ] [ norm-sq ] bi / ] keep n*v ;
|
||||
[ [ vdot ] [ norm-sq ] bi / ] keep n*v ;
|
||||
|
||||
: perp ( v u -- w )
|
||||
dupd proj v- ;
|
||||
|
|
|
|||
|
|
@ -78,8 +78,7 @@ M: cord v* [ v* ] [ call-next-method ] cord-2map ;
|
|||
M: cord v/ [ v/ ] [ call-next-method ] cord-2map ; inline
|
||||
M: cord vmin [ vmin ] [ call-next-method ] cord-2map ; inline
|
||||
M: cord vmax [ vmax ] [ call-next-method ] cord-2map ; inline
|
||||
M: cord v.
|
||||
[ v. ] [ + ] [ call-next-method ] cord-2both ; inline
|
||||
M: cord vdot [ vdot ] [ + ] [ call-next-method ] cord-2both ; inline
|
||||
M: cord vsqrt [ vsqrt ] cord-map ; inline
|
||||
M: cord sum [ sum ] cord-both + ; inline
|
||||
M: cord vabs [ vabs ] cord-map ; inline
|
||||
|
|
@ -106,7 +105,7 @@ M: cord vunordered? [ vunordered? ] [ call-next-method ] cord-2map ;
|
|||
M: cord vany? [ vany? ] cord-both or ; inline
|
||||
M: cord vall? [ vall? ] cord-both and ; inline
|
||||
M: cord vnone? [ vnone? ] cord-both and ; inline
|
||||
M: cord vshuffle-elements
|
||||
M: cord vshuffle-elements
|
||||
[ [ head>> ] [ tail>> ] bi ] [ split-shuffle ] bi*
|
||||
[ vshuffle2-elements ] bi-curry@ 2bi cord-append ; inline
|
||||
|
||||
|
|
|
|||
|
|
@ -69,7 +69,7 @@ M: gadget children-on nip children>> ;
|
|||
children [
|
||||
[ point ] dip
|
||||
quot call( value -- loc ) v-
|
||||
axis v. 0 <=>
|
||||
axis vdot 0 <=>
|
||||
] search drop ; inline
|
||||
|
||||
PRIVATE>
|
||||
|
|
|
|||
|
|
@ -12,7 +12,7 @@ C: <grid-lines> grid-lines
|
|||
|
||||
:: (compute-grid-lines) ( grid n ns orientation -- seq )
|
||||
grid gap>> :> gap
|
||||
ns n suffix gap orientation v. '[ _ - orientation n*v ] map
|
||||
ns n suffix gap orientation vdot '[ _ - orientation n*v ] map
|
||||
dup grid dim>> gap v- orientation reverse v* '[ _ v+ ] map
|
||||
gap [ 2 /f ] map '[ [ _ v+ ] map ] bi@ zip ;
|
||||
|
||||
|
|
|
|||
|
|
@ -31,7 +31,7 @@ TUPLE: elevator < gadget direction ;
|
|||
CONSTANT: elevator-padding 4
|
||||
|
||||
: elevator-length ( slider -- n )
|
||||
[ elevator>> dim>> ] [ orientation>> ] bi v.
|
||||
[ elevator>> dim>> ] [ orientation>> ] bi vdot
|
||||
elevator-padding 2 * [-] ;
|
||||
|
||||
CONSTANT: min-thumb-dim 30
|
||||
|
|
@ -68,7 +68,7 @@ TUPLE: thumb < track ;
|
|||
|
||||
: do-drag ( thumb -- )
|
||||
find-slider {
|
||||
[ orientation>> drag-loc v. ]
|
||||
[ orientation>> drag-loc vdot ]
|
||||
[ screen>slider ]
|
||||
[ saved>> + ]
|
||||
[ model>> set-range-value ]
|
||||
|
|
@ -114,7 +114,7 @@ CONSTANT: vertical-thumb-tiles
|
|||
|
||||
: compute-direction ( elevator -- -1/1 )
|
||||
[ hand-click-rel ] [ find-slider ] bi
|
||||
[ orientation>> v. ]
|
||||
[ orientation>> vdot ]
|
||||
[ screen>slider ]
|
||||
[ slider-value - sgn ]
|
||||
tri ;
|
||||
|
|
|
|||
|
|
@ -208,10 +208,10 @@ ERROR: shaped-bounds-error seq shape ;
|
|||
|
||||
! Inefficient
|
||||
: calculate-row-major-index ( seq shape -- i )
|
||||
1 [ * ] accumulate nip reverse v. ;
|
||||
1 [ * ] accumulate nip reverse vdot ;
|
||||
|
||||
: calculate-column-major-index ( seq shape -- i )
|
||||
1 [ * ] accumulate nip v. ;
|
||||
1 [ * ] accumulate nip vdot ;
|
||||
|
||||
: set-shaped-row-major ( obj seq shaped -- )
|
||||
shaped-bounds-check [ shape calculate-row-major-index ] [ underlying>> ] bi set-nth ;
|
||||
|
|
|
|||
|
|
@ -9,7 +9,7 @@ kernel ;
|
|||
: string-iter ( -- ) 100 [ 0 100000 <range> >string [ ] map drop ] times ;
|
||||
: sbuf-iter ( -- ) 100 [ 0 100000 <range> >sbuf [ ] map drop ] times ;
|
||||
: reverse-iter ( -- ) 100 [ 0 100000 <range> >vector <reversed> [ ] map drop ] times ;
|
||||
: dot-iter ( -- ) 100 [ 0 100000 <range> dup v. drop ] times ;
|
||||
: dot-iter ( -- ) 100 [ 0 100000 <range> dup vdot drop ] times ;
|
||||
|
||||
: iteration-benchmark ( -- )
|
||||
vector-iter
|
||||
|
|
|
|||
|
|
@ -42,7 +42,7 @@ C: <sphere> sphere
|
|||
|
||||
: sphere-v ( sphere ray -- v ) [ center>> ] [ orig>> ] bi* v- ; inline no-compile
|
||||
|
||||
: sphere-b ( v ray -- b ) dir>> v. ; inline no-compile
|
||||
: sphere-b ( v ray -- b ) dir>> vdot ; inline no-compile
|
||||
|
||||
: sphere-d ( sphere b v -- d ) [ radius>> sq ] [ sq ] [ norm-sq ] tri* - + ; inline no-compile
|
||||
|
||||
|
|
@ -98,7 +98,7 @@ CONSTANT: initial-hit T{ hit f double-4{ 0.0 0.0 0.0 0.0 } 1/0. }
|
|||
: sray-intersect ( ray scene hit -- ray )
|
||||
swap [ ray-o light vneg <ray> ] dip initial-intersect ; inline no-compile
|
||||
|
||||
: ray-g ( hit -- g ) normal>> light v. ; inline no-compile
|
||||
: ray-g ( hit -- g ) normal>> light vdot ; inline no-compile
|
||||
|
||||
: cast-ray ( ray scene -- g )
|
||||
2dup initial-intersect dup lambda>> 1/0. = [
|
||||
|
|
|
|||
|
|
@ -44,7 +44,7 @@ C: <sphere> sphere
|
|||
[ center>> ] [ orig>> ] bi* v- ; inline
|
||||
|
||||
: sphere-b ( v ray -- b )
|
||||
dir>> v. ; inline
|
||||
dir>> vdot ; inline
|
||||
|
||||
: sphere-d ( sphere b v -- d )
|
||||
[ radius>> sq ] [ sq ] [ norm-sq ] tri* - + ; inline
|
||||
|
|
@ -107,7 +107,7 @@ CONSTANT: initial-hit T{ hit f double-array{ 0.0 0.0 0.0 } 1/0. }
|
|||
: sray-intersect ( ray scene hit -- ray )
|
||||
swap [ ray-o light vneg <ray> ] dip initial-intersect ; inline
|
||||
|
||||
: ray-g ( hit -- g ) normal>> light v. ; inline
|
||||
: ray-g ( hit -- g ) normal>> light vdot ; inline
|
||||
|
||||
: cast-ray ( ray scene -- g )
|
||||
2dup initial-intersect dup lambda>> 1/0. = [
|
||||
|
|
|
|||
|
|
@ -60,7 +60,7 @@ IN: benchmark.spectral-norm-simd
|
|||
] times ; inline
|
||||
|
||||
TYPED: spectral-norm ( n: fixnum -- norm )
|
||||
u/v [ double cast-array ] bi@ [ v. ] [ norm-sq ] bi /f sqrt ;
|
||||
u/v [ double cast-array ] bi@ [ vdot ] [ norm-sq ] bi /f sqrt ;
|
||||
|
||||
: spectral-norm-simd-benchmark ( -- )
|
||||
2000 spectral-norm . ;
|
||||
|
|
|
|||
|
|
@ -47,7 +47,7 @@ IN: benchmark.spectral-norm
|
|||
] times ; inline
|
||||
|
||||
TYPED: spectral-norm ( n: fixnum -- norm )
|
||||
u/v [ v. ] [ norm-sq ] bi /f sqrt ;
|
||||
u/v [ vdot ] [ norm-sq ] bi /f sqrt ;
|
||||
|
||||
: spectral-norm-benchmark ( -- )
|
||||
2000 spectral-norm number>string print ;
|
||||
|
|
|
|||
|
|
@ -29,7 +29,7 @@ C: <boid> boid
|
|||
[ [ pos>> ] bi@ distance ] dip <= ; inline
|
||||
|
||||
: angle-between ( u v -- angle )
|
||||
[ normalize ] bi@ v. ; inline
|
||||
[ normalize ] bi@ vdot ; inline
|
||||
|
||||
: relative-position ( self other -- v )
|
||||
swap [ pos>> ] bi@ v- ; inline
|
||||
|
|
|
|||
|
|
@ -108,7 +108,7 @@ ERROR: all-points-colinear ;
|
|||
[ normalize ] [ all-points-colinear ] if* ;
|
||||
|
||||
: (face-plane-dist) ( normal edge -- d )
|
||||
vertex-pos v. neg ; inline
|
||||
vertex-pos vdot neg ; inline
|
||||
|
||||
: face-plane-dist ( edge -- d )
|
||||
[ face-normal ] [ (face-plane-dist) ] bi ; inline
|
||||
|
|
|
|||
|
|
@ -65,13 +65,13 @@ sharp-continue ;
|
|||
|
||||
:: project-pt-line ( p p0 p1 -- q )
|
||||
p1 p0 v- :> vt
|
||||
p p0 v- vt v.
|
||||
p p0 v- vt vdot
|
||||
vt norm-sq /
|
||||
vt n*v p0 v+ ; inline
|
||||
|
||||
:: project-pt-plane ( line-p0 line-vt plane-n plane-d -- q )
|
||||
plane-d neg plane-n line-p0 v. -
|
||||
line-vt plane-n v. /
|
||||
plane-d neg plane-n line-p0 vdot -
|
||||
line-vt plane-n vdot /
|
||||
line-vt n*v line-p0 v+ ; inline
|
||||
|
||||
: project-poly-plane ( poly vdir plane-n plane-d -- qoly )
|
||||
|
|
|
|||
|
|
@ -71,7 +71,7 @@ FROM: generalizations => npick ;
|
|||
|
||||
GML: add ( a b -- c ) [ + ] [ v+ ] [ v+ ] gml-math-op ;
|
||||
GML: sub ( a b -- c ) [ - ] [ v- ] [ v- ] gml-math-op ;
|
||||
GML: mul ( a b -- c ) [ * ] [ v* ] [ v. ] gml-math-op ;
|
||||
GML: mul ( a b -- c ) [ * ] [ v* ] [ vdot ] gml-math-op ;
|
||||
GML: div ( a b -- c ) [ /f ] [ v/ mask-vec3d ] [ v/ mask-vec3d ] gml-math-op ;
|
||||
GML: mod ( a b -- c ) mod ;
|
||||
|
||||
|
|
@ -191,10 +191,10 @@ GML: aNormal ( x -- y )
|
|||
} cond ;
|
||||
|
||||
: det2 ( x y -- z )
|
||||
{ 1 0 } vshuffle double-2{ 1 -1 } v* v. ; inline
|
||||
{ 1 0 } vshuffle double-2{ 1 -1 } v* vdot ; inline
|
||||
|
||||
: det3 ( x y z -- w )
|
||||
[ cross ] dip v. ; inline
|
||||
[ cross ] dip vdot ; inline
|
||||
|
||||
GML: determinant ( x -- y )
|
||||
{
|
||||
|
|
|
|||
|
|
@ -24,7 +24,7 @@ CONSTANT: selected-face-color float-4{ 1 0.9 0.8 1 }
|
|||
>rgba-components float-4-boa ; inline
|
||||
|
||||
: face-color ( edge -- color )
|
||||
face-normal float-4{ 0 1 0.1 0 } v. 0.3 * 0.4 + dup dup 1.0 float-4-boa ; inline
|
||||
face-normal float-4{ 0 1 0.1 0 } vdot 0.3 * 0.4 + dup dup 1.0 float-4-boa ; inline
|
||||
|
||||
TUPLE: b-rep-vertices
|
||||
{ array byte-array read-only }
|
||||
|
|
@ -234,11 +234,11 @@ CONSTANT: edge-hitbox-radius 0.05
|
|||
:: line-nearest-t ( p0 u q0 v -- tp tq )
|
||||
p0 q0 v- :> w0
|
||||
|
||||
u u v. :> a
|
||||
u v v. :> b
|
||||
v v v. :> c
|
||||
u w0 v. :> d
|
||||
v w0 v. :> e
|
||||
u u vdot :> a
|
||||
u v vdot :> b
|
||||
v v vdot :> c
|
||||
u w0 vdot :> d
|
||||
v w0 vdot :> e
|
||||
|
||||
a c * b b * - :> denom
|
||||
|
||||
|
|
|
|||
|
|
@ -82,7 +82,7 @@ PRIVATE>
|
|||
|
||||
: scalar-projection ( v1 v2 -- n )
|
||||
! the scalar projection of v1 onto v2
|
||||
[ v. ] [ norm ] bi / ;
|
||||
[ vdot ] [ norm ] bi / ;
|
||||
|
||||
: proj-perp ( u v -- w )
|
||||
dupd proj v- ;
|
||||
|
|
@ -93,7 +93,7 @@ PRIVATE>
|
|||
|
||||
:: reflect ( v n -- v' )
|
||||
! bounce v on a surface with normal n
|
||||
v v n v. n n v. / 2 * n n*v v- ;
|
||||
v v n vdot n n vdot / 2 * n n*v v- ;
|
||||
|
||||
: half-way ( p1 p2 -- p3 )
|
||||
over v- 2 v/n v+ ;
|
||||
|
|
|
|||
|
|
@ -72,7 +72,7 @@ CONSTANT: default-segment-radius 1
|
|||
|
||||
: heading-segment ( segments current-segment heading -- segment )
|
||||
! the next segment on the given heading
|
||||
over forward>> v. 0 <=> {
|
||||
over forward>> vdot 0 <=> {
|
||||
{ +gt+ [ next-segment ] }
|
||||
{ +lt+ [ previous-segment ] }
|
||||
{ +eq+ [ nip ] } ! current segment
|
||||
|
|
@ -80,12 +80,12 @@ CONSTANT: default-segment-radius 1
|
|||
|
||||
:: distance-to-next-segment ( current next location heading -- distance )
|
||||
current forward>> :> cf
|
||||
cf next location>> v. cf location v. - cf heading v. / ;
|
||||
cf next location>> vdot cf location vdot - cf heading vdot / ;
|
||||
|
||||
:: distance-to-next-segment-area ( current next location heading -- distance )
|
||||
current forward>> :> cf
|
||||
next current half-way-between-oints :> h
|
||||
cf h v. cf location v. - cf heading v. / ;
|
||||
cf h vdot cf location vdot - cf heading vdot / ;
|
||||
|
||||
: vector-to-centre ( seg loc -- v )
|
||||
over location>> swap v- swap forward>> proj-perp ;
|
||||
|
|
@ -110,9 +110,9 @@ CONSTANT: distant 1000
|
|||
v norm 0 = [
|
||||
distant
|
||||
] [
|
||||
v dup v. :> a
|
||||
v w v. 2 * :> b
|
||||
w dup v. r sq - :> c
|
||||
v dup vdot :> a
|
||||
v w vdot 2 * :> b
|
||||
w dup vdot r sq - :> c
|
||||
c b a quadratic max-real
|
||||
] if ;
|
||||
|
||||
|
|
|
|||
|
|
@ -62,10 +62,10 @@ CONSTANT: identity-transform T{ affine-transform f
|
|||
|
||||
: a. ( a a -- a )
|
||||
{
|
||||
[ [ transpose-axes x>> ] [ x>> ] bi* v. ]
|
||||
[ [ transpose-axes y>> ] [ x>> ] bi* v. ]
|
||||
[ [ transpose-axes x>> ] [ y>> ] bi* v. ]
|
||||
[ [ transpose-axes y>> ] [ y>> ] bi* v. ]
|
||||
[ [ transpose-axes x>> ] [ x>> ] bi* vdot ]
|
||||
[ [ transpose-axes y>> ] [ x>> ] bi* vdot ]
|
||||
[ [ transpose-axes x>> ] [ y>> ] bi* vdot ]
|
||||
[ [ transpose-axes y>> ] [ y>> ] bi* vdot ]
|
||||
[ origin>> a.v ]
|
||||
} 2cleave
|
||||
[ [ 2array ] 2bi@ ] dip <affine-transform> ;
|
||||
|
|
|
|||
|
|
@ -23,7 +23,7 @@ CONSTANT: gamma-p6
|
|||
: (gamma-lanczos6) ( x -- log[gamma[x+1]] )
|
||||
! log(gamma(x+1)
|
||||
[ 0.5 + dup gamma-g6 + [ log * ] keep - ]
|
||||
[ 6 gamma-z gamma-p6 v. log ] bi + ;
|
||||
[ 6 gamma-z gamma-p6 vdot log ] bi + ;
|
||||
|
||||
: gamma-lanczos6 ( x -- gamma[x] )
|
||||
! gamma(x) = gamma(x+1) / x
|
||||
|
|
|
|||
|
|
@ -94,7 +94,7 @@ TYPED:: m4.v ( m: matrix4 v: float-4 -- v': float-4 )
|
|||
v fourth m4 n*v v+ ;
|
||||
|
||||
TYPED:: v.m4 ( v: float-4 m: matrix4 -- c: float-4 )
|
||||
m columns [ v v. ] 4 napply float-4-boa ;
|
||||
m columns [ v vdot ] 4 napply float-4-boa ;
|
||||
|
||||
CONSTANT: identity-matrix4
|
||||
S{ matrix4 f
|
||||
|
|
|
|||
|
|
@ -18,4 +18,4 @@ SYMBOL: num-steps
|
|||
: integrate-simpson ( from to quot -- x )
|
||||
[ setup-simpson-range dup ] dip
|
||||
map dup generate-simpson-weights
|
||||
v. swap [ third ] keep first - 6 / * ; inline
|
||||
vdot swap [ third ] keep first - 6 / * ; inline
|
||||
|
|
|
|||
|
|
@ -13,11 +13,11 @@ IN: math.similarity
|
|||
over length 3 < [ 2drop 1.0 ] [ population-corr 0.5 * 0.5 + ] if ;
|
||||
|
||||
: cosine-similarity ( a b -- n )
|
||||
[ v. ] [ [ norm ] bi@ * ] 2bi / ;
|
||||
[ vdot ] [ [ norm ] bi@ * ] 2bi / ;
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: weighted-v. ( w a b -- n )
|
||||
: weighted-vdot ( w a b -- n )
|
||||
[ * * ] [ + ] 3map-reduce ;
|
||||
|
||||
: weighted-norm ( w a -- n )
|
||||
|
|
@ -26,5 +26,5 @@ IN: math.similarity
|
|||
PRIVATE>
|
||||
|
||||
: weighted-cosine-similarity ( w a b -- n )
|
||||
[ weighted-v. ]
|
||||
[ weighted-vdot ]
|
||||
[ overd [ weighted-norm ] 2bi@ * ] 3bi / ;
|
||||
|
|
|
|||
|
|
@ -40,9 +40,9 @@ TUPLE: bounty amounts value weight volume ;
|
|||
: <bounty> ( items -- bounty )
|
||||
[ bounty new ] dip {
|
||||
[ >>amounts ]
|
||||
[ values v. >>value ]
|
||||
[ weights v. >>weight ]
|
||||
[ volumes v. >>volume ]
|
||||
[ values vdot >>value ]
|
||||
[ weights vdot >>weight ]
|
||||
[ volumes vdot >>volume ]
|
||||
} cleave ;
|
||||
|
||||
: valid-bounty? ( bounty -- ? )
|
||||
|
|
|
|||
|
|
@ -169,7 +169,7 @@ terrain-world H{
|
|||
segment bitmap>> 4 <groups> :> pixels
|
||||
pixel dim pixel-indices :> indices
|
||||
|
||||
indices [ pixels nth COMPONENT-SCALE v. 255.0 / ] map
|
||||
indices [ pixels nth COMPONENT-SCALE vdot 255.0 / ] map
|
||||
first4 pixel-mantissa bilerp ;
|
||||
|
||||
: (collide) ( segment location -- location' )
|
||||
|
|
|
|||
Loading…
Reference in New Issue