Home

PureScript solution to Project Euler problem 24

2019-Sep-28 00:23
purescriptproject-euler

Problem details at Project Euler problem 24 page.

Test

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
module Euler024Test (euler24suite) where
 
import Prelude
 
import Data.Maybe (Maybe(..))
import Euler024 (euler24)
import Test.Unit (TestSuite, suite, test)
import Test.Unit.Assert as Assert
 
euler24suite :: TestSuite
euler24suite =
  suite "Euler 24" do
    test "Warmup 1" do
      Assert.equal (Just "102") (euler24 3 "012")
    test "Warmup 2" do
      Assert.equal (Just "bdeca") (euler24 42 "abcde")
    test "Real" do
      Assert.equal (Just "2783915460") (euler24 1000000 "0123456789")

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
67
68
69
70
71
72
73
74
75
module Euler024 where
 
import Prelude
 
import Data.Array (concat, length, range, reverse, slice, (!!))
import Data.Maybe (Maybe(..))
import Data.String as S
import Data.String.CodeUnits (charAt, fromCharArray)
import Data.Traversable (traverse)
 
pivotl :: Int
       -> Array Int
       -> Maybe { pre :: Array Int
                , lef :: Int
                , res :: Array Int
                }
pivotl c a =
  let go n = do
        rig <- a !! n
        lef <- a !! (n - 1)
        if lef < rig
          then pure { pre: slice 0 (n - 1) a
                    , lef
                    , res: slice n c a
                    }
          else go (n - 1)
  in go (c - 1)
 
pivotr :: Int
       -> Int
       -> Array Int
       -> Maybe { mid :: Array Int
                , rig :: Int
                , suf :: Array Int
                }
pivotr c lef a =
  let go n = do
        rig <- a !! n
        if lef < rig
          then pure { mid: slice 0 n a
                    , rig
                    , suf: slice (n + 1) c a
                    }
          else go (n - 1)
  in go (c - 1)
 
nextPerm :: Int -> Array Int -> Maybe (Array Int)
nextPerm c a = do
  { pre, lef, res } <- pivotl c a
  { mid, rig, suf } <- pivotr (length res) lef res
  pure $ concat [ pre
                , [rig]
                , reverse suf
                , [lef]
                , reverse mid
                ]
 
nthPerm :: Int -> Int -> Array Int -> Maybe (Array Int)
nthPerm c 1 a = Just a
nthPerm c n a = case nextPerm c a of
  Nothing -> Nothing
  Just p -> nthPerm c (n - 1) p
 
strToArrInt :: String -> Array Int
strToArrInt s = range 0 (S.length s - 1)
 
arrIntToStr :: String -> Array Int -> Maybe String
arrIntToStr s a = fromCharArray <$> traverse (flip charAt s) a
 
euler24 :: Int -> String -> Maybe String
euler24 n s =
  let ai = strToArrInt s
  in do
    p <- nthPerm (length ai) n ai
    arrIntToStr s p