icyrock.com

Home

PureScript solution to Project Euler problem 41

2021-Feb-28 17:14
purescriptproject-euler

Problem details at Project Euler problem 41 page.

Test

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
module Euler041Test (euler41suite) where
 
import Prelude
 
import Data.Maybe (Maybe(..))
import Euler041 (euler41)
import Test.Unit (TestSuite, suite, test)
import Test.Unit.Assert as Assert
 
euler41suite :: TestSuite
euler41suite =
  suite "Euler 41" do
    test "Real" do
      pure unit -- Do not evaluate the below if not active
      Assert.equal (Just 7652413) (euler41 unit)

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
module Euler041 where
 
import Prelude
 
import Data.Array (concatMap, filter, foldl, range, uncons, (:))
import Data.Foldable (maximum)
import Data.Maybe (Maybe(..))
 
select ::
     Array Int
  -> Array {f :: Int, r :: Array Int}
select js =
  case uncons js of
    Nothing           -> []
    Just {head, tail} -> {f: head, r: tail} : do
      {f, r} <- select tail
      pure {f, r: head : r}
 
perms :: Array Int -> Array (Array Int)
perms [] = [[]]
perms js = do
  {f, r} <- select js
  ks <- perms r
  pure $ f : ks
 
int2arr :: Array Int -> Int
int2arr = foldl (\j k -> j * 10 + k) 0
 
isPrime :: Int -> Boolean
isPrime n =
  let go j
        | j * j > n      = true
        | n `mod` j == 0 = false
        | otherwise      = go (j + 1)
  in go 2
 
euler41 :: Unit -> Maybe Int
euler41 _ =
  let f j = filter isPrime $ int2arr <$> perms (range 1 j)
  in maximum $ concatMap f $ range 1 9