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
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
{ {
##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
] }
} emit-vv-vector-op ;
-: emit-simd-v. ( node -- )
+: emit-simd-vdot ( node -- )
{
[ ^^dot-vector ]
{ float-vector-rep [ [ ^^mul-vector ] [ ^sum-vector ] bi ] }
{ (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 ] }
: 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? ;
[ drop length [ <iota> ] keep ]
[ nip <reversed> ]
[ drop ] 2tri
- '[ _ _ <slice> _ v. ] map reverse! ;
+ '[ _ _ <slice> _ vdot ] map reverse! ;
: p-sq ( p -- p^2 ) dup p* ; inline
{ } 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
$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
{ 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+ } }
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
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 ;
}
"Inner product and norm:"
{ $subsections
- v.
+ vdot
norm
norm-sq
normalize
}
} ;
-HELP: v.
+HELP: vdot
{ $values { "u" { $sequence real } } { "v" { $sequence real } } { "x" real } }
{ $description "Computes the dot product of two vectors." } ;
{ 2map v+ v- v* v/ } related-words
-{ 2reduce v. } related-words
+{ 2reduce vdot } related-words
{ vs+ vs- vs* } related-words
{ { 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
: 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
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- ;
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
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
children [
[ point ] dip
quot call( value -- loc ) v-
- axis v. 0 <=>
+ axis vdot 0 <=>
] search drop ; inline
PRIVATE>
:: (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 ;
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
: do-drag ( thumb -- )
find-slider {
- [ orientation>> drag-loc v. ]
+ [ orientation>> drag-loc vdot ]
[ screen>slider ]
[ saved>> + ]
[ model>> set-range-value ]
: compute-direction ( elevator -- -1/1 )
[ hand-click-rel ] [ find-slider ] bi
- [ orientation>> v. ]
+ [ orientation>> vdot ]
[ screen>slider ]
[ slider-value - sgn ]
tri ;
! 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 ;
: 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
: 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
: 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. = [
[ 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
: 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. = [
] 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 . ;
] 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 ;
[ [ 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
[ 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
:: 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 )
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 ;
} 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 )
{
>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 }
:: 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
: 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- ;
:: 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+ ;
: 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
:: 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 ;
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 ;
: 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> ;
: (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
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
: 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
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 )
PRIVATE>
: weighted-cosine-similarity ( w a b -- n )
- [ weighted-v. ]
+ [ weighted-vdot ]
[ overd [ weighted-norm ] 2bi@ * ] 3bi / ;
: <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 -- ? )
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' )
projects / factor.git / commitdiff