60 lines
1.3 KiB
Factor
60 lines
1.3 KiB
Factor
IN: list-math
|
|
USE: lists
|
|
USE: math
|
|
USE: stack
|
|
USE: combinators
|
|
USE: kernel
|
|
USE: logic
|
|
USE: math
|
|
USE: stack
|
|
|
|
: 2uncons ( list1 list2 -- car1 car2 cdr1 cdr2 )
|
|
uncons >r >r uncons r> swap r> ;
|
|
|
|
: 2each-step ( list list quot -- cdr cdr )
|
|
>r 2uncons r> -rot 2slip ; inline interpret-only
|
|
|
|
: 2each ( list list quot -- )
|
|
#! Apply the quotation to each pair of elements from the
|
|
#! two lists in turn. The quotation must have stack effect
|
|
#! ( x y -- ).
|
|
>r 2dup and [
|
|
r> dup >r 2each-step r> 2each
|
|
] [
|
|
r> 3drop
|
|
] ifte ;
|
|
|
|
: 2map-step ( accum quot elt elt -- accum )
|
|
2swap swap slip cons ;
|
|
|
|
: <2map ( list list quot -- accum quot list list )
|
|
>r f -rot r> -rot ;
|
|
|
|
: 2map ( list list quot -- list )
|
|
#! Apply the quotation to each pair of elements from the
|
|
#! two lists in turn, collecting the return value into a
|
|
#! new list. The quotation must have stack effect
|
|
#! ( x y -- z ).
|
|
<2map [ pick >r 2map-step r> ] 2each drop reverse ;
|
|
|
|
: |+ ( list -- sum )
|
|
#! sum all elements in a list.
|
|
0 swap [ + ] each ;
|
|
|
|
: +| ( list list -- list )
|
|
[ + ] 2map ;
|
|
|
|
: |* ( list -- sum )
|
|
#! multiply all elements in a list.
|
|
1 swap [ * ] each ;
|
|
|
|
: *| ( list list -- list )
|
|
[ * ] 2map ;
|
|
|
|
: *|+ ( list list -- dot )
|
|
#! Dot product
|
|
*| |+ ;
|
|
|
|
: average ( list -- avg )
|
|
dup |+ swap length / ;
|