steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge branch 'master' of git://github.com/jonenst/factor

db4
Slava Pestov 2009-10-09 03:59:08 -05:00
parent a1db31402e 62ba9bc7de
commit eb0a699d02
8 changed files with 203 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
extra/project-euler/023/023.factor
View File

@ -1,6 +1,6 @@
! Copyright (c) 2008 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel math math.ranges project-euler.common sequences sets sorting ;
USING: kernel math math.ranges project-euler.common sequences sets sorting assocs fry ;
IN: project-euler.023
! http://projecteuler.net/index.php?section=problems&id=23
@ -42,10 +42,9 @@ IN: project-euler.023
[1,b] [ abundant? ] filter ;
: possible-sums ( seq -- seq )
dup { } -rot [
dupd [ + ] curry map
rot append prune swap rest
] each drop natural-sort ;
H{ } clone
[ dupd '[ _ [ + _ conjoin ] with each ] each ]
keep keys ;
PRIVATE>
@ -53,9 +52,7 @@ PRIVATE>
source-023
20161 abundants-upto possible-sums diff sum ;
! TODO: solution is still too slow, although it takes under 1 minute
! [ euler023 ] time
! 52780 ms run / 3839 ms GC
! 2.15542 seconds
SOLUTION: euler023

4
extra/project-euler/051/051-tests.factor Normal file
View File

@ -0,0 +1,4 @@
USING: project-euler.051 tools.test ;
IN: project-euler.051.tests
[ 121313 ] [ euler051 ] unit-test

84
extra/project-euler/051/051.factor Normal file
View File

@ -0,0 +1,84 @@
! Copyright (C) 2009 Jon Harper.
! See http://factorcode.org/license.txt for BSD license.
! http://projecteuler.net/index.php?section=problems&id=1
! DESCRIPTION
! -----------
! By replacing the first digit of *3, it turns out that
! six of the nine possible values:
! 13, 23, 43, 53, 73, and 83, are all prime.
! By replacing the third and fourth digits of 56**3 with the same digit,
! this 5-digit number is the first example having seven primes among
! the ten generated numbers, yielding the family:
! 56003, 56113, 56333, 56443, 56663, 56773, and 56993.
! Consequently 56003, being the first member of this family,
! is the smallest prime with this property.
!
! Find the smallest prime which, by replacing part of the number
! (not necessarily adjacent digits) with the same digit,
! is part of an eight prime value family.
! SOLUTION
! --------
! for each prime number, count the families it belongs to. When one reaches count of 8, stop, and get the smallest number by replacing * with ones.
USING: assocs kernel math math.combinatorics math.functions
math.parser math.primes namespaces project-euler.common
sequences sets strings grouping math.ranges arrays fry math.order ;
IN: project-euler.051
<PRIVATE
SYMBOL: family-count
SYMBOL: large-families
: reset-globals ( -- )
H{ } clone family-count set
H{ } clone large-families set ;
: digits-positions ( str -- positions )
H{ } clone [ '[ swap _ push-at ] each-index ] keep ;
: *-if-index ( char combination index -- char )
member? [ drop CHAR: * ] when ;
: replace-positions-with-* ( str positions -- str )
[ *-if-index ] curry map-index ;
: all-positions-combinations ( seq -- combinations )
dup length [1,b] [ all-combinations ] with map concat ;
: families ( stra -- seq )
dup digits-positions values
[ all-positions-combinations [ replace-positions-with-* ] with map ] with map concat ;
: save-family ( family -- )
dup family-count get at 8 = [ large-families get conjoin ] [ drop ] if ;
: increment-family ( family -- )
family-count get inc-at ;
: handle-family ( family -- )
[ increment-family ] [ save-family ] bi ;
! Test all primes that have length n
: n-digits-primes ( n -- primes )
[ 1 - 10^ ] [ 10^ ] bi primes-between ;
: test-n-digits-primes ( n -- seq )
reset-globals
n-digits-primes
[ number>string families [ handle-family ] each ] each
large-families get ;
: fill-*-with-ones ( str -- str )
[ dup CHAR: * = [ drop CHAR: 1 ] when ] map ;
! recursively test all primes by length until we find an answer
: (euler051) ( i -- answer )
dup test-n-digits-primes
dup assoc-size 0 >
[ nip values [ fill-*-with-ones string>number ] [ min ] map-reduce ]
[ drop 1 + (euler051) ] if ;
PRIVATE>
: euler051 ( -- answer )
2 (euler051) ;
SOLUTION: euler051

1
extra/project-euler/051/authors.txt Normal file
View File

@ -0,0 +1 @@
Jon Harper

4
extra/project-euler/255/255-tests.factor Normal file
View File

@ -0,0 +1,4 @@
USING: project-euler.255 tools.test ;
IN: project-euler.255.tests
[ 4.4474011180 ] [ euler255 ] unit-test

93
extra/project-euler/255/255.factor Normal file
View File

@ -0,0 +1,93 @@
! 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 ;
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).
!
! 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 / ;
! 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?
[ 2 - 2 / 10 swap ^ 7 * ]
[ 1 - 2 / 10 swap ^ 2 * ] if ;
: ⌈a/b⌉ ( a b -- ⌈a/b⌉ )
[ 1 - + ] keep /i ;
: xk+1 ( n xk -- xk+1 )
[ ⌈a/b⌉ ] keep + 2 /i ;
: next-multiple ( a multiple -- next )
[ [ 1 - ] dip /i 1 + ] keep * ;
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 ;
! 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 < ]
[
! 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
! deal with the last numbers
[ drop b [ i xi ] 2dip (iteration#) ] dip
+ ;
: 10^ ( a -- 10^a ) 10 swap ^ ; inline
: (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 ;
SOLUTION: euler255

1
extra/project-euler/255/authors.txt Normal file
View File

@ -0,0 +1 @@
Jon Harper

22
extra/project-euler/project-euler.factor
View File

@ -14,17 +14,17 @@ 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.052 project-euler.053 project-euler.054
project-euler.055 project-euler.056 project-euler.057 project-euler.058
project-euler.059 project-euler.063 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.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.190 project-euler.203
project-euler.215 ;
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.063 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.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.190
project-euler.203 project-euler.215 ;
IN: project-euler
<PRIVATE