Merge branch 'master' of git://factorcode.org/git/factor

basis/unix/ffi/ffi.factor

@@ -101,6 +101,7 @@ FUNCTION: uid_t getuid ;
 FUNCTION: uint htonl ( uint n ) ;
 FUNCTION: ushort htons ( ushort n ) ;
 ! FUNCTION: int issetugid ;
+FUNCTION: int isatty ( int fildes ) ;
 FUNCTION: int ioctl ( int fd, ulong request, char* argp ) ;
 FUNCTION: int lchown ( char* path, uid_t owner, gid_t group ) ;
 FUNCTION: int listen ( int s, int backlog ) ;

extra/curses/curses-tests.factor

@@ -14,5 +14,6 @@ IN: curses.tests
         2000000 sleep
     ] with-curses ;
 
-[
+curses-ok? [
-] [ hello-curses ] unit-test
+    [ ] [ hello-curses ] unit-test
+] when

extra/curses/curses.factor

@@ -4,7 +4,7 @@ USING: accessors alien.c-types alien.strings assocs byte-arrays
 combinators continuations destructors fry io.encodings.8-bit
 io io.encodings.string io.encodings.utf8 kernel locals math
 namespaces prettyprint sequences classes.struct
-strings threads curses.ffi ;
+strings threads curses.ffi unix.ffi ;
 IN: curses
 
 SYMBOL: curses-windows
@@ -19,6 +19,7 @@ ERROR: duplicate-window window ;
 ERROR: unnamed-window window ;
 ERROR: window-not-found window ;
 ERROR: curses-failed ;
+ERROR: unsupported-curses-terminal ;
 
 : get-window ( string -- window )
     dup curses-windows get at*
@@ -28,7 +29,11 @@ ERROR: curses-failed ;
 
 : curses-error ( n -- ) ERR = [ curses-failed ] when ;
 
+: curses-ok? ( -- ? )
+    { 0 1 2 } [ isatty 0 = not ] all? ;
+
 : with-curses ( quot -- )
+    curses-ok? [ unsupported-curses-terminal ] unless
     H{ } clone curses-windows [
         initscr curses-error
         [

extra/poker/poker-tests.factor

@@ -1,5 +1,4 @@
-USING: accessors kernel math math.order poker poker.private
+USING: accessors kernel math math.order poker poker.private tools.test ;
-tools.test ;
 IN: poker.tests
 
 [ 134236965 ] [ "KD" >ckf ] unit-test

extra/poker/poker.factor

@@ -1,5 +1,4 @@
-! Copyright (c) 2009 Aaron Schaefer. All rights reserved.
+! Copyright (c) 2009 Aaron Schaefer, Doug Coleman. All rights reserved.
-! Copyright (c) 2009 Doug Coleman.
 ! The contents of this file are licensed under the Simplified BSD License
 ! A copy of the license is available at http://factorcode.org/license.txt
 USING: accessors arrays ascii assocs binary-search combinators

extra/project-euler/049/049.factor

@@ -1,7 +1,7 @@
 ! Copyright (c) 2009 Aaron Schaefer.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays byte-arrays fry hints kernel math math.combinatorics
+USING: arrays byte-arrays fry kernel math math.combinatorics math.functions
-    math.functions math.parser math.primes project-euler.common sequences sets ;
+    math.parser math.primes project-euler.common sequences sets ;
 IN: project-euler.049
 
 ! http://projecteuler.net/index.php?section=problems&id=49
@@ -25,16 +25,6 @@ IN: project-euler.049
 
 <PRIVATE
 
-: count-digits ( n -- byte-array )
-    10 <byte-array> [
-        '[ 10 /mod _ [ 1 + ] change-nth dup 0 > ] loop drop
-    ] keep ;
-
-HINTS: count-digits fixnum ;
-
-: permutations? ( n m -- ? )
-    [ count-digits ] bi@ = ;
-
 : collect-permutations ( seq -- seq )
     [ V{ } clone ] [ dup ] bi* [
         dupd '[ _ permutations? ] filter

extra/project-euler/070/070-tests.factor

@@ -0,0 +1,4 @@
+USING: project-euler.070 tools.test ;
+IN: project-euler.070.tests
+
+[ 8319823 ] [ euler070 ] unit-test

extra/project-euler/070/070.factor

@@ -0,0 +1,67 @@
+! Copyright (c) 2010 Aaron Schaefer. All rights reserved.
+! The contents of this file are licensed under the Simplified BSD License
+! A copy of the license is available at http://factorcode.org/license.txt
+USING: arrays assocs combinators.short-circuit kernel math math.combinatorics
+    math.functions math.primes math.ranges project-euler.common sequences ;
+IN: project-euler.070
+
+! http://projecteuler.net/index.php?section=problems&id=70
+
+! DESCRIPTION
+! -----------
+
+! Euler's Totient function, φ(n) [sometimes called the phi function], is used
+! to determine the number of positive numbers less than or equal to n which are
+! relatively prime to n. For example, as 1, 2, 4, 5, 7, and 8, are all less
+! than nine and relatively prime to nine, φ(9)=6. The number 1 is considered to
+! be relatively prime to every positive number, so φ(1)=1.
+
+! Interestingly, φ(87109)=79180, and it can be seen that 87109 is a permutation
+! of 79180.
+
+! Find the value of n, 1 < n < 10^(7), for which φ(n) is a permutation of n and
+! the ratio n/φ(n) produces a minimum.
+
+
+! SOLUTION
+! --------
+
+! For n/φ(n) to be minimised, φ(n) must be as close to n as possible; that is,
+! we want to maximise φ(n). The minimal solution for n/φ(n) would be if n was
+! prime giving n/(n-1) but since n-1 never is a permutation of n it cannot be
+! prime.
+
+! The next best thing would be if n only consisted of 2 prime factors close to
+! (in this case) sqrt(10000000). Hence n = p1*p2 and we only need to search
+! through a list of known prime pairs. In addition:
+
+!     φ(p1*p2) = p1*p2*(1-1/p1)(1-1/p2) = (p1-1)(p2-1)
+
+! ...so we can compute φ(n) more efficiently.
+
+<PRIVATE
+
+! NOTE: ±1000 is an arbitrary range
+: likely-prime-factors ( -- seq )
+    7 10^ sqrt >integer 1000 [ - ] [ + ] 2bi primes-between ; inline
+
+: n-and-phi ( seq -- seq' )
+    #! ( seq  = { p1, p2 } -- seq' = { n, φ(n) } )
+    [ product ] [ [ 1 - ] map product ] bi 2array ;
+
+: fit-requirements? ( seq -- ? )
+    first2 { [ drop 7 10^ < ] [ permutations? ] } 2&& ;
+
+: minimum-ratio ( seq -- n )
+    [ [ first2 / ] map [ infimum ] keep index ] keep nth first ;
+
+PRIVATE>
+
+: euler070 ( -- answer )
+   likely-prime-factors 2 all-combinations [ n-and-phi ] map
+   [ fit-requirements? ] filter minimum-ratio ;
+
+! [ euler070 ] 100 ave-time
+! 379 ms ave run time - 1.15 SD (100 trials)
+
+SOLUTION: euler070

extra/project-euler/206/206-tests.factor

@@ -0,0 +1,4 @@
+USING: project-euler.206 tools.test ;
+IN: project-euler.206.tests
+
+[ 1389019170 ] [ euler206 ] unit-test

extra/project-euler/206/206.factor

@@ -0,0 +1,46 @@
+! Copyright (c) 2010 Aaron Schaefer. All rights reserved.
+! The contents of this file are licensed under the Simplified BSD License
+! A copy of the license is available at http://factorcode.org/license.txt
+USING: grouping kernel math math.ranges project-euler.common sequences ;
+IN: project-euler.206
+
+! http://projecteuler.net/index.php?section=problems&id=206
+
+! DESCRIPTION
+! -----------
+
+! Find the unique positive integer whose square has the form
+! 1_2_3_4_5_6_7_8_9_0, where each “_” is a single digit.
+
+
+! SOLUTION
+! --------
+
+! Through mathematical analysis, we know that the number must end in 00, and
+! the only way to get the last digits to be 900, is for our answer to end in
+! 30 or 70.
+
+<PRIVATE
+
+! 1020304050607080900 sqrt, rounded up to the nearest 30 ending
+CONSTANT: lo 1010101030
+
+! 1929394959697989900 sqrt, rounded down to the nearest 70 ending
+CONSTANT: hi 1389026570
+
+: form-fitting? ( n -- ? )
+    number>digits 2 group [ first ] map
+    { 1 2 3 4 5 6 7 8 9 0 } = ;
+
+: candidates ( -- seq )
+    lo lo 40 + [ hi 100 <range> ] bi@ append ;
+
+PRIVATE>
+
+: euler206 ( -- answer )
+    candidates [ sq form-fitting? ] find-last nip ;
+
+! [ euler206 ] 100 ave-time
+! 321 ms ave run time - 8.33 SD (100 trials)
+
+SOLUTION: euler206

extra/project-euler/255/255.factor

@@ -1,49 +1,64 @@
-! Copyright (C) 2009 Jon Harper.
+! Copyright (c) 2009 Jon Harper.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: project-euler.common math kernel sequences math.functions math.ranges prettyprint io threads math.parser locals arrays namespaces ;
+USING: arrays io kernel locals math math.functions math.parser math.ranges
+    namespaces prettyprint project-euler.common sequences threads ;
 IN: project-euler.255
 
 ! http://projecteuler.net/index.php?section=problems&id=255
 
 ! DESCRIPTION
 ! -----------
-! We define the rounded-square-root of a positive integer n as the square root of n rounded to the nearest integer.
+
-! 
+! We define the rounded-square-root of a positive integer n as the square root
-! The following procedure (essentially Heron's method adapted to integer arithmetic) finds the rounded-square-root of n:
+! of n rounded to the nearest integer.
-! 
+
-! Let d be the number of digits of the number n.
+! The following procedure (essentially Heron's method adapted to integer
-! If d is odd, set x_(0) = 2×10^((d-1)⁄2).
+! arithmetic) finds the rounded-square-root of n:
-! If d is even, set x_(0) = 7×10^((d-2)⁄2).
+
-! Repeat:
+!     Let d be the number of digits of the number n.
-! 
+!     If d is odd, set x_(0) = 2×10^((d-1)⁄2).
-! until x_(k+1) = x_(k).
+!     If d is even, set x_(0) = 7×10^((d-2)⁄2).
-! 
+
+!     Repeat: [see URL for figure ]
+
+!     until x_(k+1) = x_(k).
+
 ! As an example, let us find the rounded-square-root of n = 4321.
 ! n has 4 digits, so x_(0) = 7×10^((4-2)⁄2) = 70.
-! 
-! Since x_(2) = x_(1), we stop here.
-! So, after just two iterations, we have found that the rounded-square-root of 4321 is 66 (the actual square root is 65.7343137…).
-! 
-! The number of iterations required when using this method is surprisingly low.
-! For example, we can find the rounded-square-root of a 5-digit integer (10,000 ≤ n ≤ 99,999) with an average of 3.2102888889 iterations (the average value was rounded to 10 decimal places).
-! 
-! Using the procedure described above, what is the average number of iterations required to find the rounded-square-root of a 14-digit number (10^(13) ≤ n < 10^(14))?
-! Give your answer rounded to 10 decimal places.
-! 
-! Note: The symbols ⌊x⌋ and ⌈x⌉ represent the floor function and ceiling function respectively.
-! 
-<PRIVATE
 
-: round-to-10-decimals ( a -- b ) 1.0e10 * round 1.0e10 / ;
+!     [ see URL for figure ]
+
+! Since x_(2) = x_(1), we stop here.
+
+! So, after just two iterations, we have found that the rounded-square-root of
+! 4321 is 66 (the actual square root is 65.7343137…).
+
+! The number of iterations required when using this method is surprisingly low.
+! For example, we can find the rounded-square-root of a 5-digit integer
+! (10,000 ≤ n ≤ 99,999) with an average of 3.2102888889 iterations (the average
+! value was rounded to 10 decimal places).
+
+! Using the procedure described above, what is the average number of iterations
+! required to find the rounded-square-root of a 14-digit number
+! (10^(13) ≤ n < 10^(14))? Give your answer rounded to 10 decimal places.
+
+! Note: The symbols ⌊x⌋ and ⌈x⌉ represent the floor function and ceiling
+! function respectively.
+
+! SOLUTION
+! --------
+
+<PRIVATE
 
 ! same as produce, but outputs the sum instead of the sequence of results
 : produce-sum ( id pred quot -- sum )
     [ 0 ] 2dip [ [ dip swap ] curry ] [ [ dip + ] curry ] bi* while ; inline
 
 : x0 ( i -- x0 )
-    number-length dup even? 
+    number-length dup even?
     [ 2 - 2 / 10 swap ^ 7 * ]
     [ 1 - 2 / 10 swap ^ 2 * ] if ;
+
 : ⌈a/b⌉  ( a b -- ⌈a/b⌉ )
     [ 1 - + ] keep /i ;
 
@@ -56,38 +71,37 @@ IN: project-euler.255
 DEFER: iteration#
 ! Gives the number of iterations when xk+1 has the same value for all a<=i<=n
 :: (iteration#) ( i xi a b -- # )
-    a xi xk+1 dup xi = 
+    a xi xk+1 dup xi =
-        [ drop i b a - 1 + * ] 
+    [ drop i b a - 1 + * ]
-        [ i 1 + swap a b iteration# ] if ;
+    [ i 1 + swap a b iteration# ] if ;
 
 ! Gives the number of iterations in the general case by breaking into intervals
 ! in which xk+1 is the same.
 :: iteration# ( i xi a b -- # )
-    a 
+    a
-    a xi next-multiple 
+    a xi next-multiple
-    [ dup b < ] 
+    [ dup b < ]
-    [ 
+    [
         ! set up the values for the next iteration
         [ nip [ 1 + ] [ xi + ] bi ] 2keep
         ! set up the arguments for (iteration#)
-        [ i xi ] 2dip (iteration#) 
+        [ i xi ] 2dip (iteration#)
-    ] produce-sum 
+    ] produce-sum
     ! deal with the last numbers
     [ drop b [ i xi ] 2dip (iteration#) ] dip
     + ;
 
-: 10^ ( a -- 10^a ) 10 swap ^ ; inline
+: (euler255) ( a b -- answer )
-
-: (euler255) ( a b -- answer ) 
     [ 10^ ] bi@ 1 -
     [ [ drop x0 1 swap ] 2keep iteration# ] 2keep
     swap - 1 + /f ;
 
-
 PRIVATE>
 
-: euler255 ( -- answer ) 
+: euler255 ( -- answer )
-    13 14 (euler255) round-to-10-decimals ;
+    13 14 (euler255) 10 nth-place ;
+
+! [ euler255 ] gc time
+! Running time: 37.468911341 seconds
 
 SOLUTION: euler255
-

extra/project-euler/common/common.factor

@@ -1,10 +1,11 @@
-! Copyright (c) 2007-2009 Aaron Schaefer.
+! Copyright (c) 2007-2010 Aaron Schaefer.
-! See http://factorcode.org/license.txt for BSD license.
+! The contents of this file are licensed under the Simplified BSD License
-USING: accessors arrays kernel lists make math math.functions math.matrices
+! A copy of the license is available at http://factorcode.org/license.txt
-    math.primes.miller-rabin math.order math.parser math.primes.factors
+USING: accessors arrays byte-arrays fry hints kernel lists make math
-    math.primes.lists math.ranges math.ratios namespaces parser prettyprint
+    math.functions math.matrices math.order math.parser math.primes.factors
-    quotations sequences sorting strings unicode.case vocabs vocabs.parser
+    math.primes.lists math.primes.miller-rabin math.ranges math.ratios
-    words ;
+    namespaces parser prettyprint quotations sequences sorting strings
+    unicode.case vocabs vocabs.parser words ;
 IN: project-euler.common
 
 ! A collection of words used by more than one Project Euler solution
@@ -19,12 +20,13 @@ IN: project-euler.common
 ! mediant - #71, #73
 ! nth-prime - #7, #69
 ! nth-triangle - #12, #42
-! number>digits - #16, #20, #30, #34, #35, #38, #43, #52, #55, #56, #92
+! number>digits - #16, #20, #30, #34, #35, #38, #43, #52, #55, #56, #92, #206
 ! palindrome? - #4, #36, #55
 ! pandigital? - #32, #38
 ! pentagonal? - #44, #45
 ! penultimate - #69, #71
 ! propagate-all - #18, #67
+! permutations? - #49, #70
 ! sum-proper-divisors - #21
 ! tau* - #12
 ! [uad]-transform - #39, #75
@@ -38,6 +40,13 @@ IN: project-euler.common
 
 <PRIVATE
 
+: count-digits ( n -- byte-array )
+    10 <byte-array> [
+        '[ 10 /mod _ [ 1 + ] change-nth dup 0 > ] loop drop
+    ] keep ;
+
+HINTS: count-digits fixnum ;
+
 : max-children ( seq -- seq )
     [ dup length 1 - iota [ nth-pair max , ] with each ] { } make ;
 
@@ -83,6 +92,9 @@ PRIVATE>
         [ [ 10 * ] [ 1 + ] bi* ] while 2nip
     ] if-zero ;
 
+: nth-place ( x n -- y )
+    10^ [ * round >integer ] keep /f ;
+
 : nth-prime ( n -- n )
     1 - lprimes lnth ;
 
@@ -107,6 +119,9 @@ PRIVATE>
     reverse [ first dup ] [ rest ] bi
     [ propagate dup ] map nip reverse swap suffix ;
 
+: permutations? ( n m -- ? )
+    [ count-digits ] bi@ = ;
+
 : sum-divisors ( n -- sum )
     dup 4 < [ { 0 1 3 4 } nth ] [ (sum-divisors) ] if ;
 

extra/project-euler/project-euler.factor

@@ -1,4 +1,4 @@
-! Copyright (c) 2007-2009 Aaron Schaefer, Samuel Tardieu.
+! Copyright (c) 2007-2010 Aaron Schaefer, Samuel Tardieu.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: definitions io io.files io.pathnames kernel math math.parser
     prettyprint project-euler.ave-time sequences vocabs vocabs.loader
@@ -14,18 +14,19 @@ USING: definitions io io.files io.pathnames kernel math math.parser
     project-euler.037 project-euler.038 project-euler.039 project-euler.040
     project-euler.041 project-euler.042 project-euler.043 project-euler.044
     project-euler.045 project-euler.046 project-euler.047 project-euler.048
-    project-euler.049 project-euler.051 project-euler.052 project-euler.053
+    project-euler.049 project-euler.050 project-euler.051 project-euler.052
-    project-euler.054 project-euler.055 project-euler.056 project-euler.057
+    project-euler.053 project-euler.054 project-euler.055 project-euler.056
-    project-euler.058 project-euler.059 project-euler.062 project-euler.063
+    project-euler.057 project-euler.058 project-euler.059 project-euler.062
-    project-euler.065 project-euler.067 project-euler.069 project-euler.071
+    project-euler.063 project-euler.065 project-euler.067 project-euler.069
-    project-euler.072 project-euler.073 project-euler.074 project-euler.075
+    project-euler.070 project-euler.071 project-euler.072 project-euler.073
-    project-euler.076 project-euler.079 project-euler.081 project-euler.085
+    project-euler.074 project-euler.075 project-euler.076 project-euler.079
-    project-euler.092 project-euler.097 project-euler.099 project-euler.100
+    project-euler.081 project-euler.085 project-euler.089 project-euler.092
-    project-euler.102 project-euler.112 project-euler.116 project-euler.117
+    project-euler.097 project-euler.099 project-euler.100 project-euler.102
-    project-euler.124 project-euler.134 project-euler.148 project-euler.150
+    project-euler.112 project-euler.116 project-euler.117 project-euler.124
-    project-euler.151 project-euler.164 project-euler.169 project-euler.173
+    project-euler.134 project-euler.148 project-euler.150 project-euler.151
-    project-euler.175 project-euler.186 project-euler.188 project-euler.190
+    project-euler.164 project-euler.169 project-euler.173 project-euler.175
-    project-euler.203 project-euler.215 ;
+    project-euler.186 project-euler.188 project-euler.190 project-euler.203
+    project-euler.206 project-euler.215 project-euler.255 ;
 IN: project-euler
 
 <PRIVATE