icyrock.com

Home

PureScript solutions to Project Euler problem 14

2018-Nov-01 20:31
purescriptproject-euler

Problem details at Project Euler problem 14 page.

Test

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
module Euler014Test (euler14suite) where
 
import Prelude
 
import Euler014 (euler14)
import Test.Unit (TestSuite, suite, test)
import Test.Unit.Assert as Assert
 
euler14suite :: forall e. TestSuite e
euler14suite =
  suite "Euler 14" do
    test "Warmup" do
      Assert.equal 27 (euler14 28)
    test "Real" do
      Assert.equal 837799 (euler14 1000000)

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
module Euler014 (euler14) where
 
import Prelude
 
import Data.BigInt (BigInt, fromInt)
import Data.Map (Map, empty, insert, lookup, member, singleton)
import Data.Maybe (fromMaybe)
 
bi0 :: BigInt
bi0 = fromInt 0
 
bi1 :: BigInt
bi1 = fromInt 1
 
bi2 :: BigInt
bi2 = fromInt 2
 
bi3 :: BigInt
bi3 = fromInt 3
 
chainLen :: Map BigInt Int -> BigInt -> Map BigInt Int
chainLen m n
  | n == bi1 = singleton bi1 1
  | member n m = m
  | otherwise  = insert n v nm
    where nn = if n `mod` bi2 == bi0 then n / bi2 else bi3 * n + bi1
          nm = chainLen m nn
          v = 1 + fromMaybe 0 (lookup nn nm)
 
foldli :: forall a. (a -> Int -> a) -> a -> Int -> Int -> a
foldli f z a b = go a z
  where go i c
          | i == b    = c
          | otherwise = go (i + 1) (f c i)
 
euler14 :: Int -> Int
euler14 n = r.k
  where f {k, v, m} i = {k: nk, v: nv, m: nm}
          where bii = fromInt i
                nm = chainLen m bii
                cl = fromMaybe 0 (lookup bii nm)
                nv = max v cl
                nk = if nv > v then i else k
        r = foldli f {k: 0, v: 0, m: empty} 1 n