icyrock.com
HomePureScript solution to Project Euler problem 24
2019-Sep-28 00:23
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 |