! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: arrays combinators fry kernel macros make math math.bits
-math.order math.vectors sequences splitting vectors ;
+USING: arrays combinators kernel make math math.bits
+math.vectors sequences vectors ;
IN: math.polynomials
<PRIVATE
: 2pad-head ( p q n -- p q ) [ 0 pad-head ] curry bi@ ;
: 2pad-tail ( p q n -- p q ) [ 0 pad-tail ] curry bi@ ;
-: pextend ( p q -- p q ) 2dup [ length ] bi@ max 2pad-tail ;
-: pextend-left ( p q -- p q ) 2dup [ length ] bi@ max 2pad-head ;
+: pextend ( p q -- p q ) 2dup max-length 2pad-tail ;
+: pextend-left ( p q -- p q ) 2dup max-length 2pad-head ;
: unempty ( seq -- seq ) [ { 0 } ] when-empty ;
: 2unempty ( seq seq -- seq seq ) [ unempty ] bi@ ;
2dup [ length ] bi@ + 1 - 2pad-tail ;
: p* ( p q -- r )
- 2unempty pextend-conv
- [ drop length [ iota ] keep ]
+ 2unempty pextend-conv
+ [ drop length [ <iota> ] keep ]
[ nip <reversed> ]
[ drop ] 2tri
- '[ _ _ <slice> _ v* sum ] map reverse ;
+ '[ _ _ <slice> _ vdot ] map reverse! ;
: p-sq ( p -- p^2 ) dup p* ; inline
make-bits { 1 } [ [ over p* ] when [ p-sq ] dip ] reduce nip ;
: p^ ( p n -- p^n )
- dup 0 >=
- [ (p^) ]
- [ negative-power-polynomial ] if ;
+ dup 0 >= [ (p^) ] [ negative-power-polynomial ] if ;
<PRIVATE
[ V{ 0 } clone V{ 1 } clone ] 2dip swap (pgcd) [ >array ] bi@ ;
: pdiff ( p -- p' )
- dup length iota v* rest ;
+ dup length <iota> v* rest ;
: polyval ( x p -- p[x] )
! Horner scheme
[ drop ] 2bi
'[ [ _ * ] dip + ] each ;
-MACRO: polyval* ( p -- )
+MACRO: polyval* ( p -- quot )
reverse
- [ 1 tail [ \ * swap \ + [ ] 3sequence ] map ]
+ [ rest [ \ * swap \ + [ ] 3sequence ] map ]
[ first \ drop swap [ ] 2sequence ] bi
prefix \ cleave [ ] 2sequence ;
-