Merge branch 'master' of git://projects.elasticdog.com/git/factor

db4
Slava Pestov 2010-02-22 14:49:55 +13:00
commit 50e300c080
10 changed files with 220 additions and 81 deletions

View File

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

View File

@ -1,5 +1,4 @@
! Copyright (c) 2009 Aaron Schaefer. All rights reserved.
! Copyright (c) 2009 Doug Coleman.
! Copyright (c) 2009 Aaron Schaefer, Doug Coleman. 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: accessors arrays ascii assocs binary-search combinators

View File

@ -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
math.functions math.parser math.primes project-euler.common sequences sets ;
USING: arrays byte-arrays fry kernel math math.combinatorics math.functions
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

View File

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

View File

@ -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

View File

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

View File

@ -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

View File

@ -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.
!
! The following procedure (essentially Heron's method adapted to integer arithmetic) finds the rounded-square-root of n:
!
! Let d be the number of digits of the number n.
! If d is odd, set x_(0) = 2×10^((d-1)2).
! If d is even, set x_(0) = 7×10^((d-2)2).
! Repeat:
!
! until x_(k+1) = x_(k).
!
! We define the rounded-square-root of a positive integer n as the square root
! of n rounded to the nearest integer.
! The following procedure (essentially Heron's method adapted to integer
! arithmetic) finds the rounded-square-root of n:
! Let d be the number of digits of the number n.
! If d is odd, set x_(0) = 2×10^((d-1)2).
! 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 =
[ drop i b a - 1 + * ]
[ i 1 + swap a b iteration# ] if ;
a xi xk+1 dup xi =
[ drop i b a - 1 + * ]
[ 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 xi next-multiple
[ dup b < ]
[
a
a xi next-multiple
[ 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#)
] produce-sum
[ i xi ] 2dip (iteration#)
] 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 )
13 14 (euler255) round-to-10-decimals ;
: euler255 ( -- answer )
13 14 (euler255) 10 nth-place ;
! [ euler255 ] gc time
! Running time: 37.468911341 seconds
SOLUTION: euler255

View File

@ -1,10 +1,11 @@
! Copyright (c) 2007-2009 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays kernel lists make math math.functions math.matrices
math.primes.miller-rabin math.order math.parser math.primes.factors
math.primes.lists math.ranges math.ratios namespaces parser prettyprint
quotations sequences sorting strings unicode.case vocabs vocabs.parser
words ;
! Copyright (c) 2007-2010 Aaron Schaefer.
! 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 byte-arrays fry hints kernel lists make math
math.functions math.matrices math.order math.parser math.primes.factors
math.primes.lists math.primes.miller-rabin math.ranges math.ratios
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 ;

View File

@ -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.054 project-euler.055 project-euler.056 project-euler.057
project-euler.058 project-euler.059 project-euler.062 project-euler.063
project-euler.065 project-euler.067 project-euler.069 project-euler.071
project-euler.072 project-euler.073 project-euler.074 project-euler.075
project-euler.076 project-euler.079 project-euler.081 project-euler.085
project-euler.092 project-euler.097 project-euler.099 project-euler.100
project-euler.102 project-euler.112 project-euler.116 project-euler.117
project-euler.124 project-euler.134 project-euler.148 project-euler.150
project-euler.151 project-euler.164 project-euler.169 project-euler.173
project-euler.175 project-euler.186 project-euler.188 project-euler.190
project-euler.203 project-euler.215 ;
project-euler.049 project-euler.050 project-euler.051 project-euler.052
project-euler.053 project-euler.054 project-euler.055 project-euler.056
project-euler.057 project-euler.058 project-euler.059 project-euler.062
project-euler.063 project-euler.065 project-euler.067 project-euler.069
project-euler.070 project-euler.071 project-euler.072 project-euler.073
project-euler.074 project-euler.075 project-euler.076 project-euler.079
project-euler.081 project-euler.085 project-euler.089 project-euler.092
project-euler.097 project-euler.099 project-euler.100 project-euler.102
project-euler.112 project-euler.116 project-euler.117 project-euler.124
project-euler.134 project-euler.148 project-euler.150 project-euler.151
project-euler.164 project-euler.169 project-euler.173 project-euler.175
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