Home

PureScript solution to Project Euler problem 20

2019-May-27 14:00
purescriptproject-euler

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)