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

Fix { 0 } { } p* etc

cvs
Doug Coleman 2005-11-01 06:28:29 +00:00
parent 45c08997d8
commit be5c45048c
1 changed files with 8 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
contrib/math/polynomials.factor
View File

@ -3,6 +3,7 @@ USING: kernel sequences vectors math math-internals namespaces arrays ;
! Polynomials are vectors with the highest powers on the right: ! Polynomials are vectors with the highest powers on the right:
! { 1 1 0 1 } -> 1 + x + x^3 ! { 1 1 0 1 } -> 1 + x + x^3
! { } -> 0
: 2length ( seq seq -- ) [ length ] 2apply ; : 2length ( seq seq -- ) [ length ] 2apply ;
@ -30,8 +31,12 @@ USING: kernel sequences vectors math math-internals namespaces arrays ;
#! make two polynomials the same length, if empty, make length 1 #! make two polynomials the same length, if empty, make length 1
[ >vector ] 2apply 2dup 2zero-extend ; [ >vector ] 2apply 2dup 2zero-extend ;
: 2empty? ( seq seq -- ) : unempty ( seq seq -- )
[ empty? ] 2apply and ; #! turn { } into { 0 }
dup empty? [ 1 swap zero-pad ] when ;
: 2unempty ( seq seq -- )
[ unempty ] 2apply ;
IN: math-contrib IN: math-contrib
@ -66,11 +71,7 @@ IN: math-contrib
: p* ( p p -- p ) : p* ( p p -- p )
#! Multiply two polynomials. #! Multiply two polynomials.
2dup 2empty? [ 2unempty conv*a [ 3dup -rot v* sum >r pick r> -rot set-nth conv*b ] repeat nip ;
2drop { 0 } clone
] [
conv*a [ 3dup -rot v* sum >r pick r> -rot set-nth conv*b ] repeat nip
] if ;
: p-sq ( p -- p-sq ) : p-sq ( p -- p-sq )
dup p* ; dup p* ;