Euler Solution 128

From ProgSoc Wiki

Jump to: navigation, search

Solutions for Problem 128

If you arrange the natural numbers in a hexagonal grid as follows:

p_128.gif

define f(n) to be the number of adjacent hexs whose difference is a prime number. (E.g. f(8) = 3 and f(17) = 2.) Find the 2000th "n" to have exactly f(n) = 3.

Haskell by SanguineV

Runtime: 75.299 seconds

{- Prime numbers using a pretty big wheel. -}
primes :: [Integer]
primes = 2:3:5:7:11:primes'
  where
    1:p:candidates  = [2310*k+r | k <- [0..], r <- [1,13,17,19,23,29,31,37,41,
43,47,53,59,61,67,71,73,79,83,89,97,101,103,107,109,113,127,131,137,139,149,
151,157,163,167,169,173,179,181,191,193,197,199,211,221,223,227,229,233,239,
241,247,251,257,263,269,271,277,281,283,289,293,299,307,311,313,317,323,331,
337,347,349,353,359,361,367,373,377,379,383,389,391,397,401,403,409,419,421,
431,433,437,439,443,449,457,461,463,467,479,481,487,491,493,499,503,509,521,
523,527,529,533,541,547,551,557,559,563,569,571,577,587,589,593,599,601,607,
611,613,617,619,629,631,641,643,647,653,659,661,667,673,677,683,689,691,697,
701,703,709,713,719,727,731,733,739,743,751,757,761,767,769,773,779,787,793,
797,799,809,811,817,821,823,827,829,839,841,851,853,857,859,863,871,877,881,
883,887,893,899,901,907,911,919,923,929,937,941,943,947,949,953,961,967,971,
977,983,989,991,997,1003,1007,1009,1013,1019,1021,1027,1031,1033,1037,1039,
1049,1051,1061,1063,1069,1073,1079,1081,1087,1091,1093,1097,1103,1109,1117,
1121,1123,1129,1139,1147,1151,1153,1157,1159,1163,1171,1181,1187,1189,1193,
1201,1207,1213,1217,1219,1223,1229,1231,1237,1241,1247,1249,1259,1261,1271,
1273,1277,1279,1283,1289,1291,1297,1301,1303,1307,1313,1319,1321,1327,1333,
1339,1343,1349,1357,1361,1363,1367,1369,1373,1381,1387,1391,1399,1403,1409,
1411,1417,1423,1427,1429,1433,1439,1447,1451,1453,1457,1459,1469,1471,1481,
1483,1487,1489,1493,1499,1501,1511,1513,1517,1523,1531,1537,1541,1543,1549,
1553,1559,1567,1571,1577,1579,1583,1591,1597,1601,1607,1609,1613,1619,1621,
1627,1633,1637,1643,1649,1651,1657,1663,1667,1669,1679,1681,1691,1693,1697,
1699,1703,1709,1711,1717,1721,1723,1733,1739,1741,1747,1751,1753,1759,1763,
1769,1777,1781,1783,1787,1789,1801,1807,1811,1817,1819,1823,1829,1831,1843,
1847,1849,1853,1861,1867,1871,1873,1877,1879,1889,1891,1901,1907,1909,1913,
1919,1921,1927,1931,1933,1937,1943,1949,1951,1957,1961,1963,1973,1979,1987,
1993,1997,1999,2003,2011,2017,2021,2027,2029,2033,2039,2041,2047,2053,2059,
2063,2069,2071,2077,2081,2083,2087,2089,2099,2111,2113,2117,2119,2129,2131,
2137,2141,2143,2147,2153,2159,2161,2171,2173,2179,2183,2197,2201,2203,2207,
2209,2213,2221,2227,2231,2237,2239,2243,2249,2251,2257,2263,2267,2269,2273,
2279,2281,2287,2291,2293,2297,2309]]
    primes'         = p : filter isPrime candidates
    isPrime n       = all (\x -> mod n x > 0) $ takeWhile (\p -> p*p <= n) primes'

{- Are all the elements of a sorted list in another sorted list. -}
elemAll :: [Integer] -> [Integer] -> Bool
elemAll [] _ = True
elemAll xxs@(x:xs) yys@(y:ys) =
  case compare x y of
    LT -> False
    EQ -> elemAll xs yys
    GT -> elemAll xxs ys

{- Generate the numbers with three neighbours with prime differences -}
pds = inner (filter (\x -> elemAll [11 +  6 * x] primes) [0..])
  where
    inner (x:xs)
      | c1 && c2 = n1 : n2 : inner xs
      | c1 = n1 : inner xs
      | c2 = n2 : inner xs
      | otherwise = inner xs
        where
          c1  = elemAll [13 + 6 * x, 29 + 12 * x] primes
          c2  = elemAll [17 + 6 * x, 17 + 12 * x] primes
          n1  = 3 * (x + 1) * (x + 2) + 2
          n2  = 3 * (x + 2) * (x + 3) + 1

{- Find the one we want -}
main = print (pds !! 1997)
Personal tools