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

Clean up math.polynomials some

db4
Doug Coleman 2010-04-30 08:42:29 -05:00
parent c02bb4bd17
commit e15c02f308
1 changed files with 12 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1,7 +1,7 @@
! Copyright (C) 2008 Doug Coleman. ! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: arrays kernel make math math.order math.vectors sequences USING: arrays combinators fry kernel macros make math math.bits
splitting vectors macros combinators math.bits ; math.order math.vectors sequences splitting vectors ;
IN: math.polynomials IN: math.polynomials
<PRIVATE <PRIVATE
@ -26,17 +26,19 @@ PRIVATE>
: 2ptrim ( p q -- p' q' ) [ ptrim ] bi@ ; : 2ptrim ( p q -- p' q' ) [ ptrim ] bi@ ;
: p+ ( p q -- r ) pextend v+ ; : p+ ( p q -- r ) pextend v+ ;
: p- ( p q -- r ) pextend v- ; : p- ( p q -- r ) pextend v- ;
: n*p ( n p -- n*p ) n*v ; ALIAS: n*p n*v
: pextend-conv ( p q -- p' q' ) : pextend-conv ( p q -- p' q' )
2dup [ length ] bi@ + 1 - 2pad-tail [ >vector ] bi@ ; 2dup [ length ] bi@ + 1 - 2pad-tail ;
: p* ( p q -- r ) : p* ( p q -- r )
2unempty pextend-conv <reversed> dup length iota 2unempty pextend-conv
[ over length pick <slice> pick [ * ] 2map sum ] map 2nip reverse ; [ drop length [ iota ] keep ]
[ nip <reversed> ]
[ drop ] 2tri
'[ _ _ <slice> _ v* sum ] map reverse ;
: p-sq ( p -- p^2 ) : p-sq ( p -- p^2 ) dup p* ; inline
dup p* ;
ERROR: negative-power-polynomial p n ; ERROR: negative-power-polynomial p n ;
@ -56,9 +58,7 @@ ERROR: negative-power-polynomial p n ;
dup 1 < [ drop 1 ] when dup 1 < [ drop 1 ] when
[ over length + 0 pad-head pextend ] keep 1 + ; [ over length + 0 pad-head pextend ] keep 1 + ;
: /-last ( seq seq -- a ) : /-last ( seq1 seq2 -- x ) [ last ] bi@ / ;
#! divide the last two numbers in the sequences
[ last ] bi@ / ;
: (p/mod) ( p p -- p p ) : (p/mod) ( p p -- p p )
2dup /-last 2dup /-last
@ -75,7 +75,7 @@ PRIVATE>
<PRIVATE <PRIVATE
: (pgcd) ( b a y x -- a d ) : (pgcd) ( b a y x -- a d )
dup V{ 0 } clone p= [ dup V{ 0 } p= [
drop nip drop nip
] [ ] [
[ nip ] [ p/mod ] 2bi [ nip ] [ p/mod ] 2bi