icyrock.com
HomePureScript solution to Project Euler problem 20
2019-May-27 14:00
Problem details at Project Euler problem 20 page.
Test
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 | module Euler020Test (euler20suite) where import Prelude import Euler020 (euler20) import Test . Unit (TestSuite, suite, test) import Test . Unit . Assert as Assert euler20suite :: TestSuite euler20suite = suite "Euler 20" do test "Warmup" do Assert . equal 27 (euler20 10 ) test "Real" do Assert . equal 648 (euler20 100 ) |
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 | module Euler020 where import Prelude ( mod , otherwise , ( $ ), ( * ), ( + ), ( - ), ( / ), (< $ >), (<<<), (< = )) import Data . Array ( drop , length , range, reverse , singleton, take , zip , ( : )) import Data . Array as A import Data . Foldable ( foldl , sum ) import Data . List as L import Data . Tuple ( Tuple ( .. )) toArr :: Int - > Array Int toArr n | n < = 9 = singleton n | otherwise = (n `mod` 10 ) : toArr (n / 10 ) runArr1 :: ( Int - > Int - > Int ) - > Array Int - > Array Int - > Int - > Int runArr1 f a b n = let g ( Tuple l r) = f l r xs = zip ( drop (n - length b + 1 ) a) ( reverse ( take (n + 1 ) b)) in sum $ g < $ > xs runArr :: ( Int - > Int - > Int ) - > Array Int - > Array Int - > Array Int runArr f a b = runArr1 f a b < $ > range 0 ( length a + length b - 2 ) carry :: Array Int - > Array Int carry = let go 0 L . Nil = L . Nil go n L . Nil = L . singleton n go n (L . Cons x xs) = L . Cons ((n + x) `mod` 10 ) (go ((n + x) / 10 ) xs) in A . fromFoldable <<< go 0 <<< L . fromFoldable sumArr :: Array Int - > Array Int - > Array Int sumArr a b = carry $ runArr ( + ) a b mulArr :: Array Int - > Array Int - > Array Int mulArr a b = carry $ runArr ( * ) a b euler20 :: Int - > Int euler20 n = sum $ foldl mulArr (singleton 1 ) (toArr < $ > range 2 n) |