extra/project-euler/058/058.factor

   1 ! Copyright (c) 2009 Aaron Schaefer.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: kernel math math.primes project-euler.common ranges
   4 sequences ;
   5 IN: project-euler.058
   6
   7 ! http://projecteuler.net/index.php?section=problems&id=58
   8
   9 ! DESCRIPTION
  10 ! -----------
  11
  12 ! Starting with 1 and solveling anticlockwise in the following way, a square
  13 ! solve with side length 7 is formed.
  14
  15 !     37 36 35 34 33 32 31
  16 !     38 17 16 15 14 13 30
  17 !     39 18  5  4  3 12 29
  18 !     40 19  6  1  2 11 28
  19 !     41 20  7  8  9 10 27
  20 !     42 21 22 23 24 25 26
  21 !     43 44 45 46 47 48 49
  22
  23 ! It is interesting to note that the odd squares lie along the bottom right
  24 ! diagonal, but what is more interesting is that 8 out of the 13 numbers lying
  25 ! along both diagonals are prime; that is, a ratio of 8/13 ≈ 62%.
  26
  27 ! If one complete new layer is wrapped around the solve above, a square solve
  28 ! with side length 9 will be formed. If this process is continued, what is the
  29 ! side length of the square solve for which the ratio of primes along both
  30 ! diagonals first falls below 10%?
  31
  32
  33 ! SOLUTION
  34 ! --------
  35
  36 <PRIVATE
  37
  38 CONSTANT: PERCENT_PRIME 0.1
  39
  40 ! The corners of a square of side length n are:
  41 !    (n-2)² + 1(n-1)
  42 !    (n-2)² + 2(n-1)
  43 !    (n-2)² + 3(n-1)
  44 !    (n-2)² + 4(n-1) = odd squares, no need to calculate
  45
  46 : prime-corners ( n -- m )
  47     3 [1..b] swap '[ _ [ 1 - * ] keep 2 - sq + prime? ] count ;
  48
  49 : total-corners ( n -- m )
  50     1 - 2 * ; foldable
  51
  52 : ratio-below? ( count length -- ? )
  53     total-corners 1 + / PERCENT_PRIME < ;
  54
  55 : next-layer ( count length -- count' length' )
  56     2 + [ prime-corners + ] keep ;
  57
  58 : solve ( count length -- length )
  59     2dup ratio-below? [ nip ] [ next-layer solve ] if ;
  60
  61 PRIVATE>
  62
  63 : euler058 ( -- answer )
  64     8 7 solve ;
  65
  66 ! [ euler058 ] 10 ave-time
  67 ! 12974 ms ave run time - 284.46 SD (10 trials)
  68
  69 SOLUTION: euler058