Home

PureScript solution to Project Euler problem 50

2021-Nov-14 17:25
purescriptproject-euler

Problem details at Project Euler problem 50 page.

Test

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
module Euler050Test (euler50suite) where
 
import Prelude
 
import Data.Maybe (Maybe(..))
import Euler050 (euler50)
import Test.Unit (TestSuite, suite, test)
import Test.Unit.Assert as Assert
 
euler50suite :: TestSuite
euler50suite =
  suite "Euler 50" do
    test "Warmup" do
      Assert.equal (Just 41)  (euler50 100)
      Assert.equal (Just 953) (euler50 1000)
 
    test "Real" do
      Assert.equal (Just 997651)  (euler50 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
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
module Euler050 where
 
import Prelude
 
import Control.Monad.Rec.Class (Step(..), tailRec)
import Data.Array (filter, range)
import Data.List.Lazy as LL
import Data.Maybe (Maybe)
import Data.Set as S
import Data.Traversable (maximumBy)
import Data.Tuple (Tuple(..), fst, snd)
 
isPrime :: Int -> Boolean
isPrime n =
  let go j
        | j * j > n      = true
        | n `mod` j == 0 = false
        | otherwise      = go (j + 1)
  in go 2
 
primes :: Int -> Array Int
primes n = filter isPrime $ range 2 n
 
maxConPri :: LL.List Int -> S.Set Int -> Int -> Tuple Int Int
maxConPri psl pss n =
  let go { c, m, rem } = case LL.step rem of
        LL.Nil      -> Done (Tuple m.v m.l)
        LL.Cons u i ->
          let vn = c.v + u
              ln = c.l + 1
          in if vn > n then Done (Tuple m.v m.l)
             else if vn `S.member` pss
             then Loop { c: {v: vn, l: ln}, m: {v: vn, l: ln}, rem: i }
             else Loop { c: {v: vn, l: ln}, m: {v: m.v, l: m.l}, rem: i }
  in tailRec go { c: {v: 0, l: 0}, m: {v: 0, l: 0}, rem: psl }
 
tails :: forall a. LL.List a -> LL.List (LL.List a)
tails xs =
  let go { acc, rem } = case LL.step rem of
        LL.Nil      -> Done acc
        LL.Cons j k -> Loop { acc: LL.cons (LL.cons j k) acc, rem: k }
  in tailRec go { acc: LL.nil, rem: xs }
 
maxConPris :: LL.List Int -> S.Set Int -> Int -> Maybe Int
maxConPris psl pss n =
  let pslt = tails psl
      mcp j = maxConPri j pss n
      go { acc, rem } = case LL.step rem of
        LL.Nil      -> Done acc
        LL.Cons j k -> Loop { acc: LL.cons (mcp j) acc, rem: k}
      l = tailRec go { acc: LL.nil, rem: pslt }
      m = maximumBy (comparing snd) l
  in fst <$> m
 
euler50 :: Int -> Maybe Int
euler50 n =
  let ps = primes n
      psl = LL.fromFoldable ps
      pss = S.fromFoldable ps
  in maxConPris psl pss n