]> gitweb.factorcode.org Git - factor.git/commitdiff
clean up PE solution 255
authorAaron Schaefer <aaron@elasticdog.com>
Sat, 20 Feb 2010 17:20:21 +0000 (11:20 -0600)
committerAaron Schaefer <aaron@elasticdog.com>
Sat, 20 Feb 2010 17:20:21 +0000 (11:20 -0600)
extra/project-euler/255/255.factor
extra/project-euler/common/common.factor

index 57a5c5fec72e42a0185ac09ce3443e2e122642f4..40bcce4b90dc2675bf535526ec80b9f3acffa75d 100644 (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.
-! 
+
+!     [ 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…).
-! 
+
+! 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
+! 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.
 
-: round-to-10-decimals ( a -- b ) 1.0e10 * round 1.0e10 / ;
+! 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 ;
 
-SOLUTION: euler255
+! [ euler255 ] gc time
+! Running time: 37.468911341 seconds
 
+SOLUTION: euler255
index 1f29ca0af529308cee1c4cd9b6f84dc7a8b1574e..48520ef56528f4dd17e5f45925f0a00ac461d876 100644 (file)
@@ -92,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 ;