steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

math.vectors: rename "v." to "vdot"

master
John Benediktsson 2020-02-26 12:40:16 -08:00
parent 29054e53e8
commit 1c5d417100
36 changed files with 77 additions and 78 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
basis/checksums/adler-32/adler-32.factor
View File

@ -11,7 +11,7 @@ CONSTANT: adler-32-modulus 65521
M: adler-32 checksum-bytes ( bytes checksum -- value ) M: adler-32 checksum-bytes ( bytes checksum -- value )
drop drop
[ sum 1 + ] [ 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 ; [ adler-32-modulus mod ] bi@ 16 shift bitor ;
INSTANCE: adler-32 checksum INSTANCE: adler-32 checksum

8
basis/compiler/cfg/intrinsics/simd/simd-tests.factor
View File

@ -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-head-reps signed-reps ;
M: horizontal-cpu %unpack-vector-tail-reps signed-reps ; M: horizontal-cpu %unpack-vector-tail-reps signed-reps ;
! v. ! vdot
{ { ##dot-vector } } { { ##dot-vector } }
[ dot-cpu float-4-rep [ emit-simd-v. ] test-emit ] [ dot-cpu float-4-rep [ emit-simd-vdot ] test-emit ]
unit-test unit-test
{ { ##mul-vector ##horizontal-add-vector ##horizontal-add-vector ##vector>scalar } } { { ##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 unit-test
{ { { {
@ -253,7 +253,7 @@ unit-test
##merge-vector-head ##merge-vector-tail ##add-vector ##merge-vector-head ##merge-vector-tail ##add-vector
##vector>scalar ##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 unit-test
! vsqrt ! vsqrt

4
basis/compiler/cfg/intrinsics/simd/simd.factor
View File

@ -417,7 +417,7 @@ PREDICATE: fixnum-vector-rep < int-vector-rep
] } ] }
} emit-vv-vector-op ; } emit-vv-vector-op ;
: emit-simd-v. ( node -- ) : emit-simd-vdot ( node -- )
{ {
[ ^^dot-vector ] [ ^^dot-vector ]
{ float-vector-rep [ [ ^^mul-vector ] [ ^sum-vector ] bi ] } { 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-vmin) [ emit-simd-vmin ] }
{ (simd-vmax) [ emit-simd-vmax ] } { (simd-vmax) [ emit-simd-vmax ] }
{ (simd-vavg) [ emit-simd-vavg ] } { (simd-vavg) [ emit-simd-vavg ] }
{ (simd-v.) [ emit-simd-v. ] } { (simd-vdot [ emit-simd-vdot ] }
{ (simd-vsad) [ emit-simd-vsad ] } { (simd-vsad) [ emit-simd-vsad ] }
{ (simd-vsqrt) [ emit-simd-vsqrt ] } { (simd-vsqrt) [ emit-simd-vsqrt ] }
{ (simd-sum) [ emit-simd-sum ] } { (simd-sum) [ emit-simd-sum ] }

4
basis/math/matrices/matrices.factor
View File

@ -248,8 +248,8 @@ DEFER: matrix-set-nths
: m* ( m1 m2 -- m ) [ v* ] 2map ; : m* ( m1 m2 -- m ) [ v* ] 2map ;
: m/ ( m1 m2 -- m ) [ v/ ] 2map ; : m/ ( m1 m2 -- m ) [ v/ ] 2map ;
: v.m ( v m -- p ) flip [ v. ] with map ; : v.m ( v m -- p ) flip [ vdot ] with map ;
: m.v ( m v -- p ) [ v. ] curry map ; : m.v ( m v -- p ) [ vdot ] curry map ;
: m. ( m m -- m ) flip [ swap m.v ] curry map ; : m. ( m m -- m ) flip [ swap m.v ] curry map ;
: m~ ( m1 m2 epsilon -- ? ) [ v~ ] curry 2all? ; : m~ ( m1 m2 epsilon -- ? ) [ v~ ] curry 2all? ;

2
basis/math/polynomials/polynomials.factor
View File

@ -36,7 +36,7 @@ ALIAS: n*p n*v
[ drop length [ <iota> ] keep ] [ drop length [ <iota> ] keep ]
[ nip <reversed> ] [ nip <reversed> ]
[ drop ] 2tri [ drop ] 2tri
'[ _ _ <slice> _ v. ] map reverse! ; '[ _ _ <slice> _ vdot ] map reverse! ;
: p-sq ( p -- p^2 ) dup p* ; inline : p-sq ( p -- p^2 ) dup p* ; inline

2
basis/math/quaternions/quaternions.factor
View File

@ -70,7 +70,7 @@ PRIVATE>
{ } euler-like ; inline { } euler-like ; inline
:: slerp ( q0 q1 t -- qt ) :: 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 dot facos t * :> omega
q1 dot q0 n*v v- normalize :> qt' q1 dot q0 n*v v- normalize :> qt'
omega fcos q0 n*v omega fsin qt' n*v v+ ; inline omega fcos q0 n*v omega fsin qt' n*v v+ ; inline

4
basis/math/vectors/simd/simd-docs.factor
View File

@ -23,11 +23,11 @@ $nl
$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" } "." "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 $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 $nl
"SSSE3 introduces " { $link vabs } " for " { $snippet "char-16" } ", " { $snippet "short-8" } " and " { $snippet "int-4" } "." "SSSE3 introduces " { $link vabs } " for " { $snippet "char-16" } ", " { $snippet "short-8" } " and " { $snippet "int-4" } "."
$nl $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 $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." "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 $nl

2
basis/math/vectors/simd/simd-tests.factor
View File

@ -80,7 +80,7 @@ CONSTANT: vector-words
{ vneg { +vector+ -> +vector+ } } { vneg { +vector+ -> +vector+ } }
{ vs- { +vector+ +vector+ -> +vector+ } } { vs- { +vector+ +vector+ -> +vector+ } }
{ v-n { +vector+ +scalar+ -> +vector+ } } { v-n { +vector+ +scalar+ -> +vector+ } }
{ v. { +vector+ +vector+ -> +scalar+ } } { vdot { +vector+ +vector+ -> +scalar+ } }
{ vsad { +vector+ +vector+ -> +scalar+ } } { vsad { +vector+ +vector+ -> +scalar+ } }
{ v/ { +vector+ +vector+ -> +vector+ } } { v/ { +vector+ +vector+ -> +vector+ } }
{ v/n { +vector+ +scalar+ -> +vector+ } } { v/n { +vector+ +scalar+ -> +vector+ } }

6
basis/math/vectors/simd/simd.factor
View File

@ -171,8 +171,8 @@ M: simd-128 vmin
dup simd-rep [ (simd-vmin) ] [ call-next-method ] vv->v-op ; inline dup simd-rep [ (simd-vmin) ] [ call-next-method ] vv->v-op ; inline
M: simd-128 vmax M: simd-128 vmax
dup simd-rep [ (simd-vmax) ] [ call-next-method ] vv->v-op ; inline dup simd-rep [ (simd-vmax) ] [ call-next-method ] vv->v-op ; inline
M: simd-128 v. M: simd-128 vdot
dup simd-rep [ (simd-v.) ] [ call-next-method ] vv->x-op ; inline dup simd-rep [ (simd-vdot) ] [ call-next-method ] vv->x-op ; inline
M: simd-128 vsad M: simd-128 vsad
dup simd-rep [ (simd-vsad) ] [ call-next-method ] vv->x-op ; inline dup simd-rep [ (simd-vsad) ] [ call-next-method ] vv->x-op ; inline
M: simd-128 vsqrt 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 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 distance v- norm ; inline
M: simd-128 >pprint-sequence ; M: simd-128 >pprint-sequence ;

6
basis/math/vectors/vectors-docs.factor
View File

@ -43,7 +43,7 @@ ARTICLE: "math-vectors-arithmetic" "Vector arithmetic"
} }
"Inner product and norm:" "Inner product and norm:"
{ $subsections { $subsections
v. vdot
norm norm
norm-sq norm-sq
normalize normalize
@ -314,7 +314,7 @@ HELP: vclamp
} }
} ; } ;
HELP: v. HELP: vdot
{ $values { "u" { $sequence real } } { "v" { $sequence real } } { "x" real } } { $values { "u" { $sequence real } } { "v" { $sequence real } } { "x" real } }
{ $description "Computes the dot product of two vectors." } ; { $description "Computes the dot product of two vectors." } ;
@ -588,7 +588,7 @@ HELP: vnone?
{ 2map v+ v- v* v/ } related-words { 2map v+ v- v* v/ } related-words
{ 2reduce v. } related-words { 2reduce vdot } related-words
{ vs+ vs- vs* } related-words { vs+ vs- vs* } related-words

4
basis/math/vectors/vectors-tests.factor
View File

@ -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 { { 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 { 32 } [ { 1 2 3 } { 4 5 6 } vdot ] unit-test
{ -1 } [ { C{ 0 1 } } dup v. ] unit-test { -1 } [ { C{ 0 1 } } dup vdot ] unit-test
{ 1 } [ { C{ 0 1 } } dup h. ] unit-test { 1 } [ { C{ 0 1 } } dup h. ] unit-test

6
basis/math/vectors/vectors.factor
View File

@ -217,8 +217,8 @@ M: object v?
: vsupremum ( seq -- vmax ) [ ] [ vmax ] map-reduce ; inline : vsupremum ( seq -- vmax ) [ ] [ vmax ] map-reduce ; inline
: vinfimum ( seq -- vmin ) [ ] [ vmin ] map-reduce ; inline : vinfimum ( seq -- vmin ) [ ] [ vmin ] map-reduce ; inline
GENERIC: v. ( u v -- x ) GENERIC: vdot ( u v -- x )
M: object v. [ * ] [ + ] 2map-reduce ; inline M: object vdot [ * ] [ + ] 2map-reduce ; inline
GENERIC: h. ( u v -- x ) GENERIC: h. ( u v -- x )
M: object h. [ conjugate * ] [ + ] 2map-reduce ; inline M: object h. [ conjugate * ] [ + ] 2map-reduce ; inline
@ -288,7 +288,7 @@ PRIVATE>
vec2 vec1 v- vec3 vec1 v- cross normalize ; inline vec2 vec1 v- vec3 vec1 v- cross normalize ; inline
: proj ( v u -- w ) : proj ( v u -- w )
[ [ v. ] [ norm-sq ] bi / ] keep n*v ; [ [ vdot ] [ norm-sq ] bi / ] keep n*v ;
: perp ( v u -- w ) : perp ( v u -- w )
dupd proj v- ; dupd proj v- ;

3
basis/sequences/cords/cords.factor
View File

@ -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 v/ [ v/ ] [ call-next-method ] cord-2map ; inline
M: cord vmin [ vmin ] [ 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 vmax [ vmax ] [ call-next-method ] cord-2map ; inline
M: cord v. M: cord vdot [ vdot ] [ + ] [ call-next-method ] cord-2both ; inline
[ v. ] [ + ] [ call-next-method ] cord-2both ; inline
M: cord vsqrt [ vsqrt ] cord-map ; inline M: cord vsqrt [ vsqrt ] cord-map ; inline
M: cord sum [ sum ] cord-both + ; inline M: cord sum [ sum ] cord-both + ; inline
M: cord vabs [ vabs ] cord-map ; inline M: cord vabs [ vabs ] cord-map ; inline

2
basis/ui/gadgets/gadgets.factor
View File

@ -69,7 +69,7 @@ M: gadget children-on nip children>> ;
children [ children [
[ point ] dip [ point ] dip
quot call( value -- loc ) v- quot call( value -- loc ) v-
axis v. 0 <=> axis vdot 0 <=>
] search drop ; inline ] search drop ; inline
PRIVATE> PRIVATE>

2
basis/ui/gadgets/grid-lines/grid-lines.factor
View File

@ -12,7 +12,7 @@ C: <grid-lines> grid-lines
:: (compute-grid-lines) ( grid n ns orientation -- seq ) :: (compute-grid-lines) ( grid n ns orientation -- seq )
grid gap>> :> gap 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 dup grid dim>> gap v- orientation reverse v* '[ _ v+ ] map
gap [ 2 /f ] map '[ [ _ v+ ] map ] bi@ zip ; gap [ 2 /f ] map '[ [ _ v+ ] map ] bi@ zip ;

6
basis/ui/gadgets/sliders/sliders.factor
View File

@ -31,7 +31,7 @@ TUPLE: elevator < gadget direction ;
CONSTANT: elevator-padding 4 CONSTANT: elevator-padding 4
: elevator-length ( slider -- n ) : elevator-length ( slider -- n )
[ elevator>> dim>> ] [ orientation>> ] bi v. [ elevator>> dim>> ] [ orientation>> ] bi vdot
elevator-padding 2 * [-] ; elevator-padding 2 * [-] ;
CONSTANT: min-thumb-dim 30 CONSTANT: min-thumb-dim 30
@ -68,7 +68,7 @@ TUPLE: thumb < track ;
: do-drag ( thumb -- ) : do-drag ( thumb -- )
find-slider { find-slider {
[ orientation>> drag-loc v. ] [ orientation>> drag-loc vdot ]
[ screen>slider ] [ screen>slider ]
[ saved>> + ] [ saved>> + ]
[ model>> set-range-value ] [ model>> set-range-value ]
@ -114,7 +114,7 @@ CONSTANT: vertical-thumb-tiles
: compute-direction ( elevator -- -1/1 ) : compute-direction ( elevator -- -1/1 )
[ hand-click-rel ] [ find-slider ] bi [ hand-click-rel ] [ find-slider ] bi
[ orientation>> v. ] [ orientation>> vdot ]
[ screen>slider ] [ screen>slider ]
[ slider-value - sgn ] [ slider-value - sgn ]
tri ; tri ;

4
extra/arrays/shaped/shaped.factor
View File

@ -208,10 +208,10 @@ ERROR: shaped-bounds-error seq shape ;
! Inefficient ! Inefficient
: calculate-row-major-index ( seq shape -- i ) : calculate-row-major-index ( seq shape -- i )
1 [ * ] accumulate nip reverse v. ; 1 [ * ] accumulate nip reverse vdot ;
: calculate-column-major-index ( seq shape -- i ) : calculate-column-major-index ( seq shape -- i )
1 [ * ] accumulate nip v. ; 1 [ * ] accumulate nip vdot ;
: set-shaped-row-major ( obj seq shaped -- ) : set-shaped-row-major ( obj seq shaped -- )
shaped-bounds-check [ shape calculate-row-major-index ] [ underlying>> ] bi set-nth ; shaped-bounds-check [ shape calculate-row-major-index ] [ underlying>> ] bi set-nth ;

2
extra/benchmark/iteration/iteration.factor
View File

@ -9,7 +9,7 @@ kernel ;
: string-iter ( -- ) 100 [ 0 100000 <range> >string [ ] map drop ] times ; : string-iter ( -- ) 100 [ 0 100000 <range> >string [ ] map drop ] times ;
: sbuf-iter ( -- ) 100 [ 0 100000 <range> >sbuf [ ] map drop ] times ; : sbuf-iter ( -- ) 100 [ 0 100000 <range> >sbuf [ ] map drop ] times ;
: reverse-iter ( -- ) 100 [ 0 100000 <range> >vector <reversed> [ ] 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 ( -- ) : iteration-benchmark ( -- )
vector-iter vector-iter

4
extra/benchmark/raytracer-simd/raytracer-simd.factor
View File

@ -42,7 +42,7 @@ C: <sphere> sphere
: sphere-v ( sphere ray -- v ) [ center>> ] [ orig>> ] bi* v- ; inline no-compile : 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 : 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 ) : sray-intersect ( ray scene hit -- ray )
swap [ ray-o light vneg <ray> ] dip initial-intersect ; inline no-compile 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 ) : cast-ray ( ray scene -- g )
2dup initial-intersect dup lambda>> 1/0. = [ 2dup initial-intersect dup lambda>> 1/0. = [

4
extra/benchmark/raytracer/raytracer.factor
View File

@ -44,7 +44,7 @@ C: <sphere> sphere
[ center>> ] [ orig>> ] bi* v- ; inline [ center>> ] [ orig>> ] bi* v- ; inline
: sphere-b ( v ray -- b ) : sphere-b ( v ray -- b )
dir>> v. ; inline dir>> vdot ; inline
: sphere-d ( sphere b v -- d ) : sphere-d ( sphere b v -- d )
[ radius>> sq ] [ sq ] [ norm-sq ] tri* - + ; inline [ 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 ) : sray-intersect ( ray scene hit -- ray )
swap [ ray-o light vneg <ray> ] dip initial-intersect ; inline 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 ) : cast-ray ( ray scene -- g )
2dup initial-intersect dup lambda>> 1/0. = [ 2dup initial-intersect dup lambda>> 1/0. = [

2
extra/benchmark/spectral-norm-simd/spectral-norm-simd.factor
View File

@ -60,7 +60,7 @@ IN: benchmark.spectral-norm-simd
] times ; inline ] times ; inline
TYPED: spectral-norm ( n: fixnum -- norm ) 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 ( -- ) : spectral-norm-simd-benchmark ( -- )
2000 spectral-norm . ; 2000 spectral-norm . ;

2
extra/benchmark/spectral-norm/spectral-norm.factor
View File

@ -47,7 +47,7 @@ IN: benchmark.spectral-norm
] times ; inline ] times ; inline
TYPED: spectral-norm ( n: fixnum -- norm ) 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 ( -- ) : spectral-norm-benchmark ( -- )
2000 spectral-norm number>string print ; 2000 spectral-norm number>string print ;

2
extra/boids/simulation/simulation.factor
View File

@ -29,7 +29,7 @@ C: <boid> boid
[ [ pos>> ] bi@ distance ] dip <= ; inline [ [ pos>> ] bi@ distance ] dip <= ; inline
: angle-between ( u v -- angle ) : angle-between ( u v -- angle )
[ normalize ] bi@ v. ; inline [ normalize ] bi@ vdot ; inline
: relative-position ( self other -- v ) : relative-position ( self other -- v )
swap [ pos>> ] bi@ v- ; inline swap [ pos>> ] bi@ v- ; inline

2
extra/euler/b-rep/b-rep.factor
View File

@ -108,7 +108,7 @@ ERROR: all-points-colinear ;
[ normalize ] [ all-points-colinear ] if* ; [ normalize ] [ all-points-colinear ] if* ;
: (face-plane-dist) ( normal edge -- d ) : (face-plane-dist) ( normal edge -- d )
vertex-pos v. neg ; inline vertex-pos vdot neg ; inline
: face-plane-dist ( edge -- d ) : face-plane-dist ( edge -- d )
[ face-normal ] [ (face-plane-dist) ] bi ; inline [ face-normal ] [ (face-plane-dist) ] bi ; inline

6
extra/euler/modeling/modeling.factor
View File

@ -65,13 +65,13 @@ sharp-continue ;
:: project-pt-line ( p p0 p1 -- q ) :: project-pt-line ( p p0 p1 -- q )
p1 p0 v- :> vt p1 p0 v- :> vt
p p0 v- vt v. p p0 v- vt vdot
vt norm-sq / vt norm-sq /
vt n*v p0 v+ ; inline vt n*v p0 v+ ; inline
:: project-pt-plane ( line-p0 line-vt plane-n plane-d -- q ) :: project-pt-plane ( line-p0 line-vt plane-n plane-d -- q )
plane-d neg plane-n line-p0 v. - plane-d neg plane-n line-p0 vdot -
line-vt plane-n v. / line-vt plane-n vdot /
line-vt n*v line-p0 v+ ; inline line-vt n*v line-p0 v+ ; inline
: project-poly-plane ( poly vdir plane-n plane-d -- qoly ) : project-poly-plane ( poly vdir plane-n plane-d -- qoly )

6
extra/gml/coremath/coremath.factor
View File

@ -71,7 +71,7 @@ FROM: generalizations => npick ;
GML: add ( a b -- c ) [ + ] [ v+ ] [ v+ ] gml-math-op ; GML: add ( a b -- c ) [ + ] [ v+ ] [ v+ ] gml-math-op ;
GML: sub ( 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: div ( a b -- c ) [ /f ] [ v/ mask-vec3d ] [ v/ mask-vec3d ] gml-math-op ;
GML: mod ( a b -- c ) mod ; GML: mod ( a b -- c ) mod ;
@ -191,10 +191,10 @@ GML: aNormal ( x -- y )
} cond ; } cond ;
: det2 ( x y -- z ) : 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 ) : det3 ( x y z -- w )
[ cross ] dip v. ; inline [ cross ] dip vdot ; inline
GML: determinant ( x -- y ) GML: determinant ( x -- y )
{ {

12
extra/gml/viewer/viewer.factor
View File

@ -24,7 +24,7 @@ CONSTANT: selected-face-color float-4{ 1 0.9 0.8 1 }
>rgba-components float-4-boa ; inline >rgba-components float-4-boa ; inline
: face-color ( edge -- color ) : 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 TUPLE: b-rep-vertices
{ array byte-array read-only } { array byte-array read-only }
@ -234,11 +234,11 @@ CONSTANT: edge-hitbox-radius 0.05
:: line-nearest-t ( p0 u q0 v -- tp tq ) :: line-nearest-t ( p0 u q0 v -- tp tq )
p0 q0 v- :> w0 p0 q0 v- :> w0
u u v. :> a u u vdot :> a
u v v. :> b u v vdot :> b
v v v. :> c v v vdot :> c
u w0 v. :> d u w0 vdot :> d
v w0 v. :> e v w0 vdot :> e
a c * b b * - :> denom a c * b b * - :> denom

4
extra/jamshred/oint/oint.factor
View File

@ -82,7 +82,7 @@ PRIVATE>
: scalar-projection ( v1 v2 -- n ) : scalar-projection ( v1 v2 -- n )
! the scalar projection of v1 onto v2 ! the scalar projection of v1 onto v2
[ v. ] [ norm ] bi / ; [ vdot ] [ norm ] bi / ;
: proj-perp ( u v -- w ) : proj-perp ( u v -- w )
dupd proj v- ; dupd proj v- ;
@ -93,7 +93,7 @@ PRIVATE>
:: reflect ( v n -- v' ) :: reflect ( v n -- v' )
! bounce v on a surface with normal n ! 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 ) : half-way ( p1 p2 -- p3 )
over v- 2 v/n v+ ; over v- 2 v/n v+ ;

12
extra/jamshred/tunnel/tunnel.factor
View File

@ -72,7 +72,7 @@ CONSTANT: default-segment-radius 1
: heading-segment ( segments current-segment heading -- segment ) : heading-segment ( segments current-segment heading -- segment )
! the next segment on the given heading ! the next segment on the given heading
over forward>> v. 0 <=> { over forward>> vdot 0 <=> {
{ +gt+ [ next-segment ] } { +gt+ [ next-segment ] }
{ +lt+ [ previous-segment ] } { +lt+ [ previous-segment ] }
{ +eq+ [ nip ] } ! current segment { +eq+ [ nip ] } ! current segment
@ -80,12 +80,12 @@ CONSTANT: default-segment-radius 1
:: distance-to-next-segment ( current next location heading -- distance ) :: distance-to-next-segment ( current next location heading -- distance )
current forward>> :> cf 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 ) :: distance-to-next-segment-area ( current next location heading -- distance )
current forward>> :> cf current forward>> :> cf
next current half-way-between-oints :> h 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 ) : vector-to-centre ( seg loc -- v )
over location>> swap v- swap forward>> proj-perp ; over location>> swap v- swap forward>> proj-perp ;
@ -110,9 +110,9 @@ CONSTANT: distant 1000
v norm 0 = [ v norm 0 = [
distant distant
] [ ] [
v dup v. :> a v dup vdot :> a
v w v. 2 * :> b v w vdot 2 * :> b
w dup v. r sq - :> c w dup vdot r sq - :> c
c b a quadratic max-real c b a quadratic max-real
] if ; ] if ;

8
extra/math/affine-transforms/affine-transforms.factor
View File

@ -62,10 +62,10 @@ CONSTANT: identity-transform T{ affine-transform f
: a. ( a a -- a ) : a. ( a a -- a )
{ {
[ [ transpose-axes x>> ] [ x>> ] bi* v. ] [ [ transpose-axes x>> ] [ x>> ] bi* vdot ]
[ [ transpose-axes y>> ] [ x>> ] bi* v. ] [ [ transpose-axes y>> ] [ x>> ] bi* vdot ]
[ [ transpose-axes x>> ] [ y>> ] bi* v. ] [ [ transpose-axes x>> ] [ y>> ] bi* vdot ]
[ [ transpose-axes y>> ] [ y>> ] bi* v. ] [ [ transpose-axes y>> ] [ y>> ] bi* vdot ]
[ origin>> a.v ] [ origin>> a.v ]
} 2cleave } 2cleave
[ [ 2array ] 2bi@ ] dip <affine-transform> ; [ [ 2array ] 2bi@ ] dip <affine-transform> ;

2
extra/math/analysis/analysis.factor
View File

@ -23,7 +23,7 @@ CONSTANT: gamma-p6
: (gamma-lanczos6) ( x -- log[gamma[x+1]] ) : (gamma-lanczos6) ( x -- log[gamma[x+1]] )
! log(gamma(x+1) ! log(gamma(x+1)
[ 0.5 + dup gamma-g6 + [ log * ] keep - ] [ 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-lanczos6 ( x -- gamma[x] )
! gamma(x) = gamma(x+1) / x ! gamma(x) = gamma(x+1) / x

2
extra/math/matrices/simd/simd.factor
View File

@ -94,7 +94,7 @@ TYPED:: m4.v ( m: matrix4 v: float-4 -- v': float-4 )
v fourth m4 n*v v+ ; v fourth m4 n*v v+ ;
TYPED:: v.m4 ( v: float-4 m: matrix4 -- c: float-4 ) 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 CONSTANT: identity-matrix4
S{ matrix4 f S{ matrix4 f

2
extra/math/numerical-integration/numerical-integration.factor
View File

@ -18,4 +18,4 @@ SYMBOL: num-steps
: integrate-simpson ( from to quot -- x ) : integrate-simpson ( from to quot -- x )
[ setup-simpson-range dup ] dip [ setup-simpson-range dup ] dip
map dup generate-simpson-weights map dup generate-simpson-weights
v. swap [ third ] keep first - 6 / * ; inline vdot swap [ third ] keep first - 6 / * ; inline

6
extra/math/similarity/similarity.factor
View File

@ -13,11 +13,11 @@ IN: math.similarity
over length 3 < [ 2drop 1.0 ] [ population-corr 0.5 * 0.5 + ] if ; over length 3 < [ 2drop 1.0 ] [ population-corr 0.5 * 0.5 + ] if ;
: cosine-similarity ( a b -- n ) : cosine-similarity ( a b -- n )
[ v. ] [ [ norm ] bi@ * ] 2bi / ; [ vdot ] [ [ norm ] bi@ * ] 2bi / ;
<PRIVATE <PRIVATE
: weighted-v. ( w a b -- n ) : weighted-vdot ( w a b -- n )
[ * * ] [ + ] 3map-reduce ; [ * * ] [ + ] 3map-reduce ;
: weighted-norm ( w a -- n ) : weighted-norm ( w a -- n )
@ -26,5 +26,5 @@ IN: math.similarity
PRIVATE> PRIVATE>
: weighted-cosine-similarity ( w a b -- n ) : weighted-cosine-similarity ( w a b -- n )
[ weighted-v. ] [ weighted-vdot ]
[ overd [ weighted-norm ] 2bi@ * ] 3bi / ; [ overd [ weighted-norm ] 2bi@ * ] 3bi / ;

6
extra/rosetta-code/knapsack-unbounded/knapsack-unbounded.factor
View File

@ -40,9 +40,9 @@ TUPLE: bounty amounts value weight volume ;
: <bounty> ( items -- bounty ) : <bounty> ( items -- bounty )
[ bounty new ] dip { [ bounty new ] dip {
[ >>amounts ] [ >>amounts ]
[ values v. >>value ] [ values vdot >>value ]
[ weights v. >>weight ] [ weights vdot >>weight ]
[ volumes v. >>volume ] [ volumes vdot >>volume ]
} cleave ; } cleave ;
: valid-bounty? ( bounty -- ? ) : valid-bounty? ( bounty -- ? )

2
extra/terrain/terrain.factor
View File

@ -169,7 +169,7 @@ terrain-world H{
segment bitmap>> 4 <groups> :> pixels segment bitmap>> 4 <groups> :> pixels
pixel dim pixel-indices :> indices 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 ; first4 pixel-mantissa bilerp ;
: (collide) ( segment location -- location' ) : (collide) ( segment location -- location' )