Home

PureScript solution to Project Euler problem 51

2021-Dec-20 21:51
purescriptproject-euler

Problem details at Project Euler problem 51 page.

Test

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
module Euler051Test (euler51suite) where
 
import Prelude
 
import Data.Maybe (Maybe(..))
import Euler051 (cands, euler51, masked, masks)
import Test.Unit (TestSuite, suite, test)
import Test.Unit.Assert as Assert
 
euler51suite :: TestSuite
euler51suite =
  suite "Euler 51" do
    test "Warmup" do
      Assert.equal [10] (masks 1 2)
      Assert.equal [110, 1010, 10010, 1100, 10100, 11000] (masks 2 5)
      Assert.equal [1110, 10110, 11010, 11100] (masks 3 5)
      Assert.equal [   1110, 10110, 10011011010, 101010
                   , 110010, 11100, 101100, 110100, 111000
                   ] (masks 3 6)
 
      Assert.equal 80    (masked 1     83)
      Assert.equal 3     (masked 10    83)
      Assert.equal 56003 (masked 110   56993)
      Assert.equal  6302 (masked 10010 56382)
 
      Assert.equal [ 56003, 56113, 56223, 56333, 56443
                   , 56553, 56663, 56773, 56883, 56993
                   ] (cands 110 56993)
 
      Assert.equal (Just 13)     (euler51 1 2 6)
      Assert.equal (Just 56003)  (euler51 2 5 7)
 
    test "Real" do
      Assert.equal (Just 121313) (euler51 3 6 8)

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
61
62
63
64
65
66
module Euler051 where
 
import Prelude
 
import Data.Array (catMaybes, elem, filter, length, range, scanl)
import Data.Maybe (Maybe)
import Data.Set (Set)
import Data.Set as S
import Data.Traversable (minimum)
 
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
 
masks :: Int -> Int -> Array Int
masks ri li =
  let go r l b
        | r > l     = []
        | l == 1    = [b]
        | r == 1    = [b] <> scanl (\j k -> 10 * j) b (range 2 l)
        | otherwise = map (b + _) (go (r - 1) (l - 1) (b * 10))
                   <> go r (l - 1) (b * 10)
  in map (10 * _) $ go ri (li - 1) 1
 
masked :: Int -> Int -> Int
masked 0 n = n
masked _ 0 = 0
masked m n = (if m `mod` 10 == 1 then 0 else n `mod` 10)
  + 10 * masked (m `div` 10) (n `div` 10)
 
cands :: Int -> Int -> Array Int
cands m n =
  let z = masked m n
      f j = j * m + z
      l = numLen n
      nl j = l == numLen j
  in filter nl $ map f (range 0 9)
 
cond :: Int -> Set Int -> Int -> Int -> Boolean
cond d pss m n =
  let cs = cands m n
      ds = filter (_ `S.member` pss) cs
  in n `elem` cs && d <= length ds
 
numLen :: Int -> Int
numLen n
  | n < 10    = 1
  | otherwise = 1 + numLen (n `div` 10)
 
euler51 :: Int -> Int -> Int -> Maybe Int
euler51 r l d =
  let n = 1_000_000
      nl j = l == numLen j
      ps = filter nl (primes n)
      pss = S.fromFoldable ps
      f m = minimum $ filter (cond d pss m) ps
      ms = masks r l
      mss = f <$> ms
  in minimum $ catMaybes mss