! 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
[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>
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
--- /dev/null
+! 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
--- /dev/null
+USING: project-euler.255 tools.test ;
+IN: project-euler.255.tests
+
+[ 4.4474011180 ] [ euler255 ] unit-test
--- /dev/null
+! 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
+
--- /dev/null
+Jon Harper
\ No newline at end of file
projects / factor.git / commitdiff