diff --git a/extra/math/polynomials/polynomials-docs.factor b/extra/math/polynomials/polynomials-docs.factor new file mode 100644 index 0000000000..08b7ca7c4d --- /dev/null +++ b/extra/math/polynomials/polynomials-docs.factor @@ -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" } } ; + diff --git a/extra/math/polynomials/polynomials-tests.factor b/extra/math/polynomials/polynomials-tests.factor index cccf24fbff..cd88d19d13 100644 --- a/extra/math/polynomials/polynomials-tests.factor +++ b/extra/math/polynomials/polynomials-tests.factor @@ -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 diff --git a/extra/math/polynomials/polynomials.factor b/extra/math/polynomials/polynomials.factor index 47226114d0..13090b6486 100644 --- a/extra/math/polynomials/polynomials.factor +++ b/extra/math/polynomials/polynomials.factor @@ -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 ... } - 1 [ * ] accumulate nip ; - -: p= ( p p -- ? ) pextend = ; +: powers ( n x -- seq ) + 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 dup length [ over length pick pick [ * ] 2map sum ] map 2nip reverse ; -: p-sq ( p -- p-sq ) +: p-sq ( p -- p^2 ) dup p* ; 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 ; + 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. ;