fix p/mod

contrib/math/TODO.txt

@@ -1,6 +1,6 @@
 Nice to have:
 
-- Permutations -- composition and inverse (trivial; use sort and map-with)
+- Permutations -- composition (trivial; use sort and map-with)
 - Analysis:
   - error function, cosine integral, sine integral, fresnel functions
   - logarithm integral, zeta function

contrib/math/analysis.factor

@@ -37,7 +37,7 @@ USING: kernel sequences errors namespaces math ;
 
 IN: math-contrib
 
-: gamma ( x -- gamma[x] )
+: gamma ( x -- y )
     #! gamma(x) = integral 0..inf [ t^(x-1) exp(-t) ] dt
     #! gamma(n+1) = n! for n > 0
     dup Z:(-inf,0]? [

contrib/math/combinatorics.factor

@@ -1,5 +1,5 @@
 IN: math-contrib
-USING: kernel sequences errors namespaces math ;
+USING: arrays kernel sequences errors namespaces math ;
 
 : <range> ( from to -- seq ) dup <slice> ; inline
 : (0..n] ( n -- (0..n] ) 1+ 1 swap <range> ; inline
@@ -35,3 +35,7 @@ USING: kernel sequences errors namespaces math ;
     ] [
         2dup - nip [ factorial ] keep rot pick >r factorial-part r> /
     ] if ;
+
+: inverse-permutation ( seq -- seq )
+    dup length dup 0 <array> -rot swap [ pick set-nth ] 2each ;
+

contrib/math/polynomials.factor

@@ -1,12 +1,14 @@
 IN: polynomials-internals
-USING: kernel sequences vectors math math-internals namespaces arrays ;
+USING: arrays kernel sequences vectors math math-internals namespaces arrays ;
 
 ! Polynomials are vectors with the highest powers on the right:
 ! { 1 1 0 1 } -> 1 + x + x^3
 ! { } -> 0
 
-: pextend* ( p p n -- p p ) 0 [ pad-right swap ] 2keep pad-right swap ;
-: pextend ( p p -- p p ) 2dup [ length ] 2apply max pextend* ;
+: 2pad-left ( p p n -- p p ) 0 [ pad-left swap ] 2keep pad-left swap ;
+: 2pad-right ( p p n -- p p ) 0 [ pad-right swap ] 2keep pad-right swap ;
+: pextend ( p p -- p p ) 2dup [ length ] 2apply max 2pad-right ;
+: pextend-left ( p p -- p p ) 2dup [ length ] 2apply max 2pad-left ;
 : unempty ( seq -- seq ) dup empty? [ drop { 0 } ] when ;
 : 2unempty ( seq seq -- seq seq ) [ unempty ] 2apply ;
 
@@ -26,7 +28,7 @@ IN: math-contrib
 ! convolution
 : pextend-conv ( p p -- p p )
     #! extend to: p_m + p_n - 1 
-    2dup [ length ] 2apply + 1- pextend* [ >vector ] 2apply ;
+    2dup [ length ] 2apply + 1- 2pad-right [ >vector ] 2apply ;
 
 : p* ( p p -- p )
     #! Multiply two polynomials.
@@ -43,15 +45,18 @@ IN: polynomials-internals
 
 : /-last ( seq seq -- a )
     #! divide the last two numbers in the sequences
-    [ peek ] 2apply /i ;
+    [ peek ] 2apply / ;
+
+: p/mod-setup ( p p -- p p n )
+    2ptrim 2dup [ length ] 2apply - dup 1 < [ drop 1 ] when
+    dup >r over length + 0 pad-left pextend r> 1+ ;
 
 : (p/mod)
-    2dup /-last 2dup , n*p swapd p- dup pop drop swap pop-front ;
+    2dup /-last 2dup , n*p swapd p- >vector dup pop drop swap pop-front ;
 
 IN: math-contrib
-
 : p/mod
-    pextend dup length 1- [ [ (p/mod) ] times ] V{ } make
+    p/mod-setup [ [ (p/mod) ] times ] V{ } make
     reverse nip swap 2ptrim pextend ;
 
 : (pgcd) ( b a y x -- a d )
@@ -61,8 +66,8 @@ IN: math-contrib
         tuck p/mod >r pick p* swap >r swapd p- r> r> (pgcd)
     ] if ;
 
-: pgcd ( p p -- p )
-    swap V{ 0 } clone V{ 1 } clone 2swap (pgcd) ;
+: pgcd ( p p -- p q )
+    swap V{ 0 } clone V{ 1 } clone 2swap (pgcd) [ >array ] 2apply ;
 
 : pdiff ( p -- p' )
     #! Polynomial derivative.

contrib/math/test.factor

@@ -22,15 +22,17 @@ USING: kernel math test sequences math-contrib ;
 [ V{ 1 0 1 } V{ 0 0 0 } ] [ { 1 1 1 1 } { 1 1 } p/mod ] unit-test
 [ V{ 1 0 1 } V{ 0 0 0 } ] [ { 1 1 1 1 } { 1 1 0 0 0 0 0 0 } p/mod ] unit-test
 [ V{ 1 0 1 } V{ 0 0 0 } ] [ { 1 1 1 1 0 0 0 0 } { 1 1 0 0 } p/mod ] unit-test
-! [ { 5.0 } { 0.0 } ] [ { 10.0 } { 2.0 } p/mod ] unit-test
-! [ { 15/16 } { 0 } ] [ { 3/4 } { 4/5 } p/mod ] unit-test
+[ V{ 5.0 } V{ 0.0 } ] [ { 10.0 } { 2.0 } p/mod ] unit-test
+[ V{ 15/16 } V{ 0 } ] [ { 3/4 } { 4/5 } p/mod ] unit-test
 [ t ] [ { 0 1 } { 0 1 0 } p= ] unit-test
 [ f ] [ { 0 0 1 } { 0 1 0 } p= ] unit-test
 [ t ] [ { 1 1 1 } { 1 1 1 } p= ] unit-test
-[ V{ 0 0 } V{ 1 1 } ] [ { 1 1 1 1 } { 1 1 } pgcd ] unit-test
+[ { 0 0 } { 1 1 } ] [ { 1 1 1 1 } { 1 1 } pgcd ] unit-test
 
 [ t ] [ 10 3 nPk 10 factorial 7 factorial / = ] unit-test
 [ t ] [ 10 3 nCk 10 factorial 3 factorial 7 factorial * / = ] unit-test
+[ { 3 7 9 0 5 2 6 8 1 4 } ] [ { 3 8 5 0 9 4 6 1 7 2 } inverse-permutation ] unit-test
+[ { } ] [ { } inverse-permutation ] unit-test
 [ 1 ] [ 0 factorial ] unit-test
 [ 1 ] [ 1 factorial ] unit-test
 [ 2 ] [ 2 factorial ] unit-test

contrib/math/utils.factor

@@ -108,18 +108,5 @@ SYMBOL: step-size .01 step-size set  ! base on arguments
 : limit ( quot -- x )
     .1 step-size set [ call ] keep step-size [ 2 / ] change 0 -rot (limit) 2drop ;
 
-! take elements n at a time and apply the quotation, forming a new seq
-: group-map ( seq n quot -- seq )
-    >r group r> map ;
-
-: nths ( start n seq -- seq )
-    -rot pick length <frange-no-endpt> [ over nth ] map nip ;
-
-! take a set of every nth element and apply the quotation, forming a new seq
-! { 1 2 3 4 5 6 } 3 [ sum ] skip-map ->  { 1 4 } { 2 5 } { 3 6 } -> { 5 7 9 }
-! : skip-map ( seq n quot -- seq )
-    ! >r 
-
-: nth-rand ( seq -- elem )
-    [ length random-int ] keep nth ;
+: nth-rand ( seq -- elem ) [ length random-int ] keep nth ;