icyrock.com
HomePureScript solution to Project Euler problem 33
2020-Jun-22 22:36
Problem details at Project Euler problem 33 page.
Test
1 2 3 4 5 6 7 8 9 10 11 12 13 | module Euler033Test (euler33suite) where import Prelude import Euler033 (euler33) import Test . Unit (TestSuite, suite, test) import Test . Unit . Assert as Assert euler33suite :: TestSuite euler33suite = suite "Euler 33" do test "Real" do Assert . equal 100 (euler33 unit) |
Solution
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 | module Euler033 where import Prelude import Control . MonadZero (guard) import Data . Array ( foldl , range, reverse , zip ) import Data . Foldable ( or ) import Data . Tuple ( Tuple ( .. )) data Frac = Frac Int Int instance showFrac :: Show Frac where show (Frac j k) = "Frac " <> show j <> " " <> show k trivial :: Frac - > Boolean trivial (Frac j k) = j `mod` 10 == 0 && k `mod` 10 == 0 digits :: Int - > Array Int digits j = [j `mod` 10 , j / 10 ] cancelOne :: Frac - > Array ( Tuple Int Int ) - > Boolean cancelOne (Frac j k) [ Tuple jf kf, Tuple jg kg] = jf == kf && (j * kg == jg * k) cancelOne _ _ = false cancel :: Frac - > Boolean cancel f @ (Frac j k) = let jd = digits j kd = digits k g = [ zip jd kd , zip ( reverse jd) kd , zip jd ( reverse kd) , zip ( reverse jd) ( reverse kd) ] in or $ map (cancelOne f) g digcan :: Frac - > Boolean digcan j = not (trivial j) && cancel j digcans :: Unit - > Array Frac digcans _ = do j < - range 10 99 k < - range 10 99 guard $ j < k let f = Frac j k guard $ digcan f pure f prod :: Frac - > Frac - > Frac prod (Frac jf kf) (Frac jg kg) = Frac (jf * jg) (kf * kg) lcd :: Frac - > Frac lcd (Frac j k) = let f = gcd j k in Frac (j / f) (k / f) euler33 :: Unit - > Int euler33 _ = let (Frac j k) = lcd $ foldl prod (Frac 1 1 ) (digcans unit) in k |