Merge git://projects.elasticdog.com/git/factor

extra/golden-section/golden-section.factor

@@ -1,28 +1,25 @@
-USING: kernel namespaces math math.constants math.functions
+USING: kernel namespaces math math.constants math.functions arrays sequences
-arrays sequences opengl opengl.gl opengl.glu ui ui.render
+    opengl opengl.gl opengl.glu ui ui.render ui.gadgets ui.gadgets.theme
-ui.gadgets ui.gadgets.theme ui.gadgets.slate colors ;
+    ui.gadgets.slate colors ;
 IN: golden-section
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
 ! To run:
-! 
+! "golden-section" run
-! "demos.golden-section" run
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
 : disk ( quadric radius center -- )
-glPushMatrix
+    glPushMatrix
-gl-translate
+    gl-translate
-dup 0 glScalef
+    dup 0 glScalef
-0 1 10 10 gluDisk
+    0 1 10 10 gluDisk
-glPopMatrix ;
+    glPopMatrix ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-: phi ( -- phi ) 5 sqrt 1 + 2 / 1 - ;
+: omega ( i -- omega ) phi 1- * 2 * pi * ;
-
-: omega ( i -- omega ) phi * 2 * pi * ;
 
 : x ( i -- x ) dup omega cos * 0.5 * ;
 
@@ -35,10 +32,10 @@ glPopMatrix ;
 : color ( i -- color ) 360.0 / dup 0.25 1 4array ;
 
 : rim ( quadric i -- )
-black gl-color dup radius 1.5 * swap center disk ;
+    black gl-color dup radius 1.5 * swap center disk ;
 
 : inner ( quadric i -- )
-dup color gl-color dup radius swap center disk ;
+    dup color gl-color dup radius swap center disk ;
 
 : dot ( quadric i -- ) 2dup rim inner ;
 
@@ -47,21 +44,21 @@ dup color gl-color dup radius swap center disk ;
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
 : with-quadric ( quot -- )
-gluNewQuadric [ swap call ] keep gluDeleteQuadric ; inline
+    gluNewQuadric [ swap call ] keep gluDeleteQuadric ; inline
 
 : display ( -- )
-GL_PROJECTION glMatrixMode
+    GL_PROJECTION glMatrixMode
-glLoadIdentity
+    glLoadIdentity
--400 400 -400 400 -1 1 glOrtho
+    -400 400 -400 400 -1 1 glOrtho
-GL_MODELVIEW glMatrixMode
+    GL_MODELVIEW glMatrixMode
-glLoadIdentity
+    glLoadIdentity
-[ golden-section ] with-quadric ;
+    [ golden-section ] with-quadric ;
 
 : golden-section-window ( -- )
-[
+    [
-    [ display ] <slate>
+        [ display ] <slate>
-    { 600 600 } over set-slate-dim
+        { 600 600 } over set-slate-dim
-    "Golden Section" open-window
+        "Golden Section" open-window
-] with-ui ;
+    ] with-ui ;
 
 MAIN: golden-section-window

extra/math/constants/constants-docs.factor

@@ -4,6 +4,8 @@ IN: math.constants
 ARTICLE: "math-constants" "Constants"
 "Standard mathematical constants:"
 { $subsection e }
+{ $subsection gamma }
+{ $subsection phi }
 { $subsection pi }
 "Various limits:"
 { $subsection most-positive-fixnum }
@@ -15,6 +17,13 @@ ABOUT: "math-constants"
 HELP: e
 { $values { "e" "base of natural logarithm" } } ;
 
+HELP: gamma
+{ $values { "gamma" "Euler-Mascheroni constant" } }
+{ $description "The Euler-Mascheroni constant, also called \"Euler's constant\" or \"the Euler constant\"." } ;
+
+HELP: phi
+{ $values { "phi" "golden ratio" } } ;
+
 HELP: pi
 { $values { "pi" "circumference of circle with diameter 1" } } ;
 

extra/math/constants/constants.factor

@@ -3,5 +3,7 @@
 IN: math.constants
 
 : e ( -- e ) 2.7182818284590452354 ; inline
+: gamma ( -- gamma ) 0.57721566490153286060 ; inline
 : pi ( -- pi ) 3.14159265358979323846 ; inline
+: phi ( -- phi ) 1.61803398874989484820 ; inline
 : epsilon ( -- epsilon ) 2.2204460492503131e-16 ; inline

extra/math/miller-rabin/miller-rabin-tests.factor

@@ -1,4 +1,5 @@
-USING: math.miller-rabin kernel math namespaces tools.test ;
+USING: math.miller-rabin tools.test ;
+IN: temporary
 
 [ f ] [ 473155932665450549999756893736999469773678960651272093993257221235459777950185377130233556540099119926369437865330559863 miller-rabin ] unit-test
 [ t ] [ 2 miller-rabin ] unit-test
@@ -7,4 +8,3 @@ USING: math.miller-rabin kernel math namespaces tools.test ;
 [ t ] [ 37 miller-rabin ] unit-test
 [ 101 ] [ 100 next-prime ] unit-test
 [ 100000000000031 ] [ 100000000000000 next-prime ] unit-test
-

extra/math/miller-rabin/summary.txt

@@ -0,0 +1 @@
+Miller-Rabin probabilistic primality test

extra/math/text/english/english.factor

@@ -12,10 +12,10 @@ IN: math.text.english
     "Seventeen" "Eighteen" "Nineteen" } nth ;
 
 : tens ( n -- str )
-    { "" "" "Twenty" "Thirty" "Forty" "Fifty" "Sixty" "Seventy" "Eighty" "Ninety" } nth ;
+    { f f "Twenty" "Thirty" "Forty" "Fifty" "Sixty" "Seventy" "Eighty" "Ninety" } nth ;
 
 : scale-numbers ( n -- str )  ! up to 10^99
-    { "" "Thousand" "Million" "Billion" "Trillion" "Quadrillion" "Quintillion"
+    { f "Thousand" "Million" "Billion" "Trillion" "Quadrillion" "Quintillion"
     "Sextillion" "Septillion" "Octillion" "Nonillion" "Decillion" "Undecillion"
     "Duodecillion" "Tredecillion" "Quattuordecillion" "Quindecillion"
     "Sexdecillion" "Septendecillion" "Octodecillion" "Novemdecillion"
@@ -45,7 +45,7 @@ SYMBOL: and-needed?
 
 : tens-place ( n -- str )
     100 mod dup 20 >= [
-        10 /mod >r tens r>
+        10 /mod [ tens ] dip
         dup zero? [ drop ] [ "-" swap small-numbers 3append ] if
     ] [
         dup zero? [ drop "" ] [ small-numbers ] if
@@ -97,3 +97,4 @@ PRIVATE>
     ] [
         [ (number>text) ] with-scope
     ] if ;
+

extra/math/text/summary.txt

@@ -0,0 +1 @@
+Convert integers to text in multiple languages

extra/project-euler/002/002.factor

@@ -1,6 +1,6 @@
-! Copyright (c) 2007 Aaron Schaefer.
+! Copyright (c) 2007 Aaron Schaefer, Alexander Solovyov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel math sequences ;
+USING: kernel math sequences shuffle ;
 IN: project-euler.002
 
 ! http://projecteuler.net/index.php?section=problems&id=2
@@ -22,12 +22,12 @@ IN: project-euler.002
 <PRIVATE
 
 : (fib-upto) ( seq n limit -- seq )
-    2dup <= [ >r add dup 2 tail* sum r> (fib-upto) ] [ 2drop ] if ;
+    2dup <= [ [ over push dup 2 tail* sum ] dip (fib-upto) ] [ 2drop ] if ;
 
 PRIVATE>
 
 : fib-upto ( n -- seq )
-    { 0 } 1 rot (fib-upto) ;
+    V{ 0 } clone 1 rot (fib-upto) ;
 
 : euler002 ( -- answer )
     1000000 fib-upto [ even? ] subset sum ;
@@ -35,4 +35,18 @@ PRIVATE>
 ! [ euler002 ] 100 ave-time
 ! 0 ms run / 0 ms GC ave time - 100 trials
 
-MAIN: euler002
+
+! ALTERNATE SOLUTIONS
+! -------------------
+
+: fib-upto* ( n -- seq )
+    0 1 [ pick over >= ] [ tuck + dup ] [ ] unfold 3nip
+    1 head-slice* { 0 1 } swap append ;
+
+: euler002a ( -- answer )
+    1000000 fib-upto* [ even? ] subset sum ;
+
+! [ euler002a ] 100 ave-time
+! 0 ms run / 0 ms GC ave time - 100 trials
+
+MAIN: euler002a

extra/project-euler/023/023.factor

@@ -1,4 +1,4 @@
-! Copyright (c) 2007 Aaron Schaefer.
+! Copyright (c) 2008 Aaron Schaefer.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: hashtables kernel math math.ranges project-euler.common sequences
     sorting ;

extra/project-euler/024/024.factor

@@ -1,4 +1,4 @@
-! Copyright (c) 2007 Aaron Schaefer.
+! Copyright (c) 2008 Aaron Schaefer.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel math math.parser math.ranges namespaces sequences ;
 IN: project-euler.024

extra/project-euler/025/025.factor

@@ -1,7 +1,7 @@
-! Copyright (c) 2007 Aaron Schaefer.
+! Copyright (c) 2008 Aaron Schaefer.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien.syntax kernel math math.functions math.parser math.ranges memoize
+USING: alien.syntax kernel math math.constants math.functions math.parser
-    project-euler.common sequences ;
+    math.ranges memoize project-euler.common sequences ;
 IN: project-euler.025
 
 ! http://projecteuler.net/index.php?section=problems&id=25
@@ -67,9 +67,6 @@ PRIVATE>
 
 <PRIVATE
 
-: phi ( -- phi )
-    5 sqrt 1+ 2 / ;
-
 : digit-fib* ( n -- term )
     1- 5 log10 2 / + phi log10 / ceiling >integer ;
 

extra/project-euler/026/026.factor

@@ -1,4 +1,4 @@
-! Copyright (c) 2007 Aaron Schaefer.
+! Copyright (c) 2008 Aaron Schaefer.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel math math.functions math.primes math.ranges sequences ;
 IN: project-euler.026

extra/project-euler/027/027.factor

@@ -1,4 +1,4 @@
-! Copyright (c) 2007 Aaron Schaefer.
+! Copyright (c) 2008 Aaron Schaefer.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel math math.primes project-euler.common sequences ;
 IN: project-euler.027

extra/project-euler/028/028.factor

@@ -1,4 +1,4 @@
-! Copyright (c) 2007 Aaron Schaefer.
+! Copyright (c) 2008 Aaron Schaefer.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: combinators.lib kernel math math.ranges ;
 IN: project-euler.028

extra/project-euler/029/029.factor

@@ -1,4 +1,4 @@
-! Copyright (c) 2007 Aaron Schaefer.
+! Copyright (c) 2008 Aaron Schaefer.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: hashtables kernel math.functions math.ranges project-euler.common
     sequences ;

extra/project-euler/030/030.factor

@@ -0,0 +1,46 @@
+! Copyright (c) 2008 Aaron Schaefer.
+! See http://factorcode.org/license.txt for BSD license.
+USING: combinators.lib kernel math math.functions project-euler.common sequences ;
+IN: project-euler.030
+
+! http://projecteuler.net/index.php?section=problems&id=30
+
+! DESCRIPTION
+! -----------
+
+! Surprisingly there are only three numbers that can be written as the sum of
+! fourth powers of their digits:
+
+!     1634 = 1^4 + 6^4 + 3^4 + 4^4
+!     8208 = 8^4 + 2^4 + 0^4 + 8^4
+!     9474 = 9^4 + 4^4 + 7^4 + 4^4
+
+!     As 1 = 1^4 is not a sum it is not included.
+
+! The sum of these numbers is 1634 + 8208 + 9474 = 19316.
+
+! Find the sum of all the numbers that can be written as the sum of fifth
+! powers of their digits.
+
+
+! SOLUTION
+! --------
+
+! if n is the number of digits
+! n * 9^5 = 10^n  when n ≈ 5.513
+! 10^5.513 ≈ 325537
+
+<PRIVATE
+
+: sum-fifth-powers ( n -- sum )
+    number>digits [ 5 ^ ] sigma ;
+
+PRIVATE>
+
+: euler030 ( -- answer )
+    325537 [ dup sum-fifth-powers = ] subset sum 1- ;
+
+! [ euler030 ] 100 ave-time
+! 2537 ms run / 125 ms GC ave time - 100 trials
+
+MAIN: euler030

extra/project-euler/031/031.factor

@@ -0,0 +1,63 @@
+! Copyright (c) 2008 Aaron Schaefer.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel math ;
+IN: project-euler.031
+
+! http://projecteuler.net/index.php?section=problems&id=31
+
+! DESCRIPTION
+! -----------
+
+! In England the currency is made up of pound, £, and pence, p, and there are
+! eight coins in general circulation:
+
+!     1p, 2p, 5p, 10p, 20p, 50p, £1 (100p) and £2 (200p).
+
+! It is possible to make £2 in the following way:
+
+!     1×£1 + 1×50p + 2×20p + 1×5p + 1×2p + 3×1p
+
+! How many different ways can £2 be made using any number of coins?
+
+
+
+! SOLUTION
+! --------
+
+<PRIVATE
+
+: 1p ( m -- n )
+    drop 1 ;
+
+: 2p ( m -- n )
+    dup 0 >= [ [ 2 - 2p ] keep 1p + ] [ drop 0 ] if ;
+
+: 5p ( m -- n )
+    dup 0 >= [ [ 5 - 5p ] keep 2p + ] [ drop 0 ] if ;
+
+: 10p ( m -- n )
+    dup 0 >= [ [ 10 - 10p ] keep 5p + ] [ drop 0 ] if ;
+
+: 20p ( m -- n )
+    dup 0 >= [ [ 20 - 20p ] keep 10p + ] [ drop 0 ] if ;
+
+: 50p ( m -- n )
+    dup 0 >= [ [ 50 - 50p ] keep 20p + ] [ drop 0 ] if ;
+
+: 100p ( m -- n )
+    dup 0 >= [ [ 100 - 100p ] keep 50p + ] [ drop 0 ] if ;
+
+: 200p ( m -- n )
+    dup 0 >= [ [ 200 - 200p ] keep 100p + ] [ drop 0 ] if ;
+
+PRIVATE>
+
+: euler031 ( -- answer )
+    200 200p ;
+
+! [ euler031 ] 100 ave-time
+! 4 ms run / 0 ms GC ave time - 100 trials
+
+! TODO: generalize to eliminate duplication; use a sequence to specify denominations?
+
+MAIN: euler031

extra/project-euler/032/032.factor

@@ -0,0 +1,81 @@
+! Copyright (c) 2008 Aaron Schaefer.
+! See http://factorcode.org/license.txt for BSD license.
+USING: combinators.lib hashtables kernel math math.combinatorics math.parser
+    math.ranges project-euler.common project-euler.024 sequences sorting ;
+IN: project-euler.032
+
+! http://projecteuler.net/index.php?section=problems&id=32
+
+! DESCRIPTION
+! -----------
+
+! The product 7254 is unusual, as the identity, 39 × 186 = 7254, containing
+! multiplicand, multiplier, and product is 1 through 9 pandigital.
+
+! Find the sum of all products whose multiplicand/multiplier/product identity
+! can be written as a 1 through 9 pandigital.
+
+! HINT: Some products can be obtained in more than one way so be sure to only
+! include it once in your sum.
+
+
+! SOLUTION
+! --------
+
+! Generate all pandigital numbers and then check if they fit the identity
+
+<PRIVATE
+
+: source-032 ( -- seq )
+    9 factorial [ 9 permutation [ 1+ ] map 10 swap digits>integer ] map ;
+
+: 1and4 ( n -- ? )
+    number>string 1 cut-slice 4 cut-slice
+    [ 10 string>integer ] 3apply [ * ] dip = ;
+
+: 2and3 ( n -- ? )
+    number>string 2 cut-slice 3 cut-slice
+    [ 10 string>integer ] 3apply [ * ] dip = ;
+
+: valid? ( n -- ? )
+    dup 1and4 swap 2and3 or ;
+
+: products ( seq -- m )
+    [ number>string 4 tail* 10 string>integer ] map ;
+
+PRIVATE>
+
+: euler032 ( -- answer )
+    source-032 [ valid? ] subset products prune sum ;
+
+! [ euler032 ] 10 ave-time
+! 27609 ms run / 2484 ms GC ave time - 10 trials
+
+
+! ALTERNATE SOLUTIONS
+! -------------------
+
+! Generate all reasonable multiplicand/multiplier pairs, then multiply and see
+! if the equation is pandigital
+
+<PRIVATE
+
+: source-032a ( -- seq )
+    50 [1,b] 2000 [1,b] cartesian-product ;
+
+: pandigital? ( n -- ? )
+    number>string natural-sort "123456789" = ;
+
+! multiplicand/multiplier/product
+: mmp ( pair -- n )
+    first2 2dup * [ number>string ] 3apply 3append 10 string>integer ;
+
+PRIVATE>
+
+: euler032a ( -- answer )
+    source-032a [ mmp ] map [ pandigital? ] subset products prune sum ;
+
+! [ euler032a ] 100 ave-time
+! 5978 ms run / 327 ms GC ave time - 100 trials
+
+MAIN: euler032a

extra/project-euler/common/common.factor

@@ -11,7 +11,7 @@ IN: project-euler.common
 ! collect-consecutive - #8, #11
 ! log10 - #25, #134
 ! max-path - #18, #67
-! number>digits - #16, #20
+! number>digits - #16, #20, #30
 ! propagate-all - #18, #67
 ! sum-proper-divisors - #21
 ! tau* - #12

extra/project-euler/project-euler.factor

@@ -9,8 +9,8 @@ USING: definitions io io.files kernel math.parser sequences vocabs
     project-euler.017 project-euler.018 project-euler.019 project-euler.020
     project-euler.021 project-euler.022 project-euler.023 project-euler.024
     project-euler.025 project-euler.026 project-euler.027 project-euler.028
-    project-euler.029 project-euler.067 project-euler.134 project-euler.169
+    project-euler.029 project-euler.030 project-euler.067 project-euler.134
-    project-euler.173 project-euler.175 ;
+    project-euler.169 project-euler.173 project-euler.175 ;
 IN: project-euler
 
 <PRIVATE