Cleanup polynomials and add documentation
Aaron Schaefer
parent
e17f519480
commit
fd95e64125
extra/math/polynomials
|
|
@ -0,0 +1,94 @@
|
|||
USING: help.markup help.syntax math sequences ;
|
||||
IN: math.polynomials
|
||||
|
||||
ARTICLE: "polynomials" "Polynomials"
|
||||
"A polynomial is a vector with the highest powers on the right:"
|
||||
{ $code "{ 1 1 0 1 } -> 1 + x + x^3" "{ } -> 0" }
|
||||
"Numerous words are defined to help with polynomial arithmetic:"
|
||||
{ $subsection p= }
|
||||
{ $subsection p+ }
|
||||
{ $subsection p- }
|
||||
{ $subsection p* }
|
||||
{ $subsection p-sq }
|
||||
{ $subsection powers }
|
||||
{ $subsection n*p }
|
||||
{ $subsection p/mod }
|
||||
{ $subsection pgcd }
|
||||
{ $subsection polyval }
|
||||
{ $subsection pdiff }
|
||||
{ $subsection pextend-conv }
|
||||
{ $subsection ptrim }
|
||||
{ $subsection 2ptrim } ;
|
||||
|
||||
ABOUT: "polynomials"
|
||||
|
||||
HELP: powers
|
||||
{ $values { "n" integer } { "x" number } { "seq" sequence } }
|
||||
{ $description "Output a sequence having " { $snippet "n" } " elements in the format: " { $snippet "{ 1 x x^2 x^3 ... }" } "." }
|
||||
{ $examples { $example "USING: math.polynomials prettyprint ;" "4 2 powers ." "{ 1 2 4 8 }" } } ;
|
||||
|
||||
HELP: p=
|
||||
{ $values { "p" "a polynomial" } { "q" "a polynomial" } { "?" "a boolean" } }
|
||||
{ $description "Tests if two polynomials are equal." }
|
||||
{ $examples { $example "USING: math.polynomials prettyprint ;" "{ 0 1 } { 0 1 0 } p= ." "t" } } ;
|
||||
|
||||
HELP: ptrim
|
||||
{ $values { "p" "a polynomial" } { "p" "a polynomial" } }
|
||||
{ $description "Trims excess zeros from a polynomial." }
|
||||
{ $examples { $example "USING: math.polynomials prettyprint ;" "{ 0 1 0 0 } ptrim ." "{ 0 1 }" } } ;
|
||||
|
||||
HELP: 2ptrim
|
||||
{ $values { "p" "a polynomial" } { "q" "a polynomial" } { "p" "a polynomial" } { "q" "a polynomial" } }
|
||||
{ $description "Trims excess zeros from two polynomials." }
|
||||
{ $examples { $example "USING: math.polynomials prettyprint ;" "{ 0 1 0 0 } { 1 0 0 } 2ptrim swap . ." "{ 0 1 }\n{ 1 }" } } ;
|
||||
|
||||
HELP: p+
|
||||
{ $values { "p" "a polynomial" } { "q" "a polynomial" } { "r" "a polynomial" } }
|
||||
{ $description "Adds " { $snippet "p" } " and " { $snippet "q" } " component-wise." }
|
||||
{ $examples { $example "USING: math.polynomials prettyprint ;" "{ 1 0 1 } { 0 1 } p+ ." "{ 1 1 1 }" } } ;
|
||||
|
||||
HELP: p-
|
||||
{ $values { "p" "a polynomial" } { "q" "a polynomial" } { "r" "a polynomial" } }
|
||||
{ $description "Subtracts " { $snippet "q" } " from " { $snippet "p" } " component-wise." }
|
||||
{ $examples { $example "USING: math.polynomials prettyprint ;" "{ 1 1 1 } { 0 1 } p- ." "{ 1 0 1 }" } } ;
|
||||
|
||||
HELP: n*p
|
||||
{ $values { "n" number } { "p" "a polynomial" } { "n*p" "a polynomial" } }
|
||||
{ $description "Multiplies each element of " { $snippet "p" } " by " { $snippet "n" } "." }
|
||||
{ $examples { $example "USING: math.polynomials prettyprint ;" "4 { 3 0 1 } n*p ." "{ 12 0 4 }" } } ;
|
||||
|
||||
HELP: pextend-conv
|
||||
{ $values { "p" "a polynomial" } { "q" "a polynomial" } { "p" "a polynomial" } { "q" "a polynomial" } }
|
||||
{ $description "Convulution, extending to " { $snippet "p_m + q_n - 1" } "." }
|
||||
{ $examples { $example "USING: math.polynomials prettyprint ;" "{ 1 0 1 } { 0 1 } pextend-conv swap . ." "V{ 1 0 1 0 }\nV{ 0 1 0 0 }" } } ;
|
||||
|
||||
HELP: p*
|
||||
{ $values { "p" "a polynomial" } { "q" "a polynomial" } { "r" "a polynomial" } }
|
||||
{ $description "Multiplies two polynomials." }
|
||||
{ $examples { $example "USING: math.polynomials prettyprint ;" "{ 1 2 3 0 0 0 } { 1 2 0 0 } p* ." "{ 1 4 7 6 0 0 0 0 0 }" } } ;
|
||||
|
||||
HELP: p-sq
|
||||
{ $values { "p" "a polynomial" } { "p^2" "a polynomial" } }
|
||||
{ $description "Squares a polynomial." }
|
||||
{ $examples { $example "USING: math.polynomials prettyprint ;" "{ 1 2 0 } p-sq ." "{ 1 4 4 0 0 }" } } ;
|
||||
|
||||
HELP: p/mod
|
||||
{ $values { "p" "a polynomial" } { "q" "a polynomial" } { "z" "a polynomial" } { "w" "a polynomial" } }
|
||||
{ $description "Computes to quotient " { $snippet "z" } " and remainder " { $snippet "w" } " of dividing " { $snippet "p" } " by " { $snippet "q" } "." }
|
||||
{ $examples { $example "USING: math.polynomials prettyprint ;" "{ 1 1 1 1 } { 3 1 } p/mod swap . ." "V{ 7 -2 1 }\nV{ -20 0 0 }" } } ;
|
||||
|
||||
HELP: pgcd
|
||||
{ $values { "p" "a polynomial" } { "q" "a polynomial" } { "a" "a polynomial" } { "d" "a polynomial" } }
|
||||
{ $description "Computes the greatest common divisor " { $snippet "d" } " of " { $snippet "p" } " and " { $snippet "q" } ", and another value " { $snippet "a" } " satisfying:" { $code "a*q = d mod p" } }
|
||||
{ $notes "GCD in the case of polynomials is a monic polynomial of the highest possible degree that divides into both " { $snippet "p" } " and " { $snippet "q" } "." }
|
||||
{ $examples { $example "USING: math.polynomials prettyprint ;" "{ 1 1 1 1} { 1 1 } pgcd swap . ." "{ 0 0 }\n{ 1 1 }" } } ;
|
||||
|
||||
HELP: pdiff
|
||||
{ $values { "p" "a polynomial" } { "p'" "a polynomial" } }
|
||||
{ $description "Finds the derivative of " { $snippet "p" } "." } ;
|
||||
|
||||
HELP: polyval
|
||||
{ $values { "p" "a polynomial" } { "x" number } { "p[x]" number } }
|
||||
{ $description "Evaluate " { $snippet "p" } " with the input " { $snippet "x" } "." }
|
||||
{ $examples { $example "USING: math.polynomials prettyprint ;" "{ 1 0 1 } 2 polyval ." "5" } } ;
|
||||
|
||||
|
|
@ -1,7 +1,6 @@
|
|||
IN: math.polynomials.tests
|
||||
USING: kernel math math.polynomials tools.test ;
|
||||
IN: math.polynomials.tests
|
||||
|
||||
! Tests
|
||||
[ { 0 1 } ] [ { 0 1 0 0 } ptrim ] unit-test
|
||||
[ { 1 } ] [ { 1 0 0 } ptrim ] unit-test
|
||||
[ { 0 } ] [ { 0 } ptrim ] unit-test
|
||||
|
|
|
|||
|
|
@ -4,46 +4,38 @@ USING: arrays kernel make math math.order math.vectors sequences shuffle
|
|||
splitting vectors ;
|
||||
IN: math.polynomials
|
||||
|
||||
! Polynomials are vectors with the highest powers on the right:
|
||||
! { 1 1 0 1 } -> 1 + x + x^3
|
||||
! { } -> 0
|
||||
|
||||
: powers ( n x -- seq )
|
||||
#! Output sequence has n elements, { 1 x x^2 x^3 ... }
|
||||
<array> 1 [ * ] accumulate nip ;
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: 2pad-left ( p p n -- p p ) [ 0 pad-left ] curry bi@ ;
|
||||
: 2pad-right ( p p n -- p p ) [ 0 pad-right ] curry bi@ ;
|
||||
: pextend ( p p -- p p ) 2dup [ length ] bi@ max 2pad-right ;
|
||||
: pextend-left ( p p -- p p ) 2dup [ length ] bi@ max 2pad-left ;
|
||||
: 2pad-left ( p q n -- p q ) [ 0 pad-left ] curry bi@ ;
|
||||
: 2pad-right ( p q n -- p q ) [ 0 pad-right ] curry bi@ ;
|
||||
: pextend ( p q -- p q ) 2dup [ length ] bi@ max 2pad-right ;
|
||||
: pextend-left ( p q -- p q ) 2dup [ length ] bi@ max 2pad-left ;
|
||||
: unempty ( seq -- seq ) [ { 0 } ] when-empty ;
|
||||
: 2unempty ( seq seq -- seq seq ) [ unempty ] bi@ ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: p= ( p p -- ? ) pextend = ;
|
||||
: powers ( n x -- seq )
|
||||
<array> 1 [ * ] accumulate nip ;
|
||||
|
||||
: p= ( p q -- ? ) pextend = ;
|
||||
|
||||
: ptrim ( p -- p )
|
||||
dup length 1 = [ [ zero? ] trim-right ] unless ;
|
||||
|
||||
: 2ptrim ( p p -- p p ) [ ptrim ] bi@ ;
|
||||
: p+ ( p p -- p ) pextend v+ ;
|
||||
: p- ( p p -- p ) pextend v- ;
|
||||
: 2ptrim ( p q -- p q ) [ ptrim ] bi@ ;
|
||||
: p+ ( p q -- r ) pextend v+ ;
|
||||
: p- ( p q -- r ) pextend v- ;
|
||||
: n*p ( n p -- n*p ) n*v ;
|
||||
|
||||
! convolution
|
||||
: pextend-conv ( p p -- p p )
|
||||
#! extend to: p_m + p_n - 1
|
||||
: pextend-conv ( p q -- p q )
|
||||
2dup [ length ] bi@ + 1- 2pad-right [ >vector ] bi@ ;
|
||||
|
||||
: p* ( p p -- p )
|
||||
#! Multiply two polynomials.
|
||||
: p* ( p q -- r )
|
||||
2unempty pextend-conv <reversed> dup length
|
||||
[ over length pick <slice> pick [ * ] 2map sum ] map 2nip reverse ;
|
||||
|
||||
: p-sq ( p -- p-sq )
|
||||
: p-sq ( p -- p^2 )
|
||||
dup p* ;
|
||||
|
||||
<PRIVATE
|
||||
|
|
@ -66,10 +58,12 @@ PRIVATE>
|
|||
|
||||
PRIVATE>
|
||||
|
||||
: p/mod ( a b -- / mod )
|
||||
: p/mod ( p q -- z w )
|
||||
p/mod-setup [ [ (p/mod) ] times ] V{ } make
|
||||
reverse nip swap 2ptrim pextend ;
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: (pgcd) ( b a y x -- a d )
|
||||
dup V{ 0 } clone p= [
|
||||
drop nip
|
||||
|
|
@ -77,14 +71,14 @@ PRIVATE>
|
|||
tuck p/mod [ pick p* swap [ swapd p- ] dip ] dip (pgcd)
|
||||
] if ;
|
||||
|
||||
: pgcd ( p p -- p q )
|
||||
PRIVATE>
|
||||
|
||||
: pgcd ( p q -- a d )
|
||||
swap V{ 0 } clone V{ 1 } clone 2swap (pgcd) [ >array ] bi@ ;
|
||||
|
||||
: pdiff ( p -- p' )
|
||||
#! Polynomial derivative.
|
||||
dup length v* { 0 } ?head drop ;
|
||||
|
||||
: polyval ( p x -- p[x] )
|
||||
#! Evaluate a polynomial.
|
||||
[ dup length ] dip powers v. ;
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue