Problem 70

70.hs

@@ -0,0 +1,27 @@
+import Math.NumberTheory.Primes.Factorisation
+import Data.List
+import Data.Ratio
+import Data.Numbers.Primes
+
+-- 4000 chosen through trial and error (sorry)
+-- sqrt(10000000) is a bit more than 2000 so I tried using 1000 increments from 2000 onwards until the pair stopped changing
+-- for 2000: (2239261, 2236192)
+-- for 3000: (7026037, 7020736)
+-- for 4000: (8319823, 8313928)
+-- for 5000: ditto
+primePairs :: Integer -> [(Integer, Integer)]
+primePairs bound = [(x, y) | let bounded = takeWhile (< 4000) primes, x <- bounded, y <- bounded, x*y < bound]
+
+totient :: (Integer, Integer) -> (Integer, Integer)
+totient (p1, p2) = ((p1 * p2), ((p1-1) * (p2-1)))
+
+arePermutations :: (Integer, Integer) -> Bool
+arePermutations (n, t) = sort (show n) == sort (show t)
+
+comparePairs :: (Integer, Integer) -> (Integer, Integer) -> Ordering
+comparePairs (n1, t1) (n2, t2) = compare (n1 % t1) (n2 % t2)
+
+minPermTote :: Integer -> (Integer, Integer)
+minPermTote bound = minimumBy comparePairs $ filter arePermutations $ map totient $ primePairs bound
+
+main = do print $ minPermTote 9999999