### A Puzzle and a Solution (2)

#### by Mithrandir

Last post was ended with a problem: our solution exhausted the memory before it could give an answer to , . There were three comments trying to solve them and the last two of them are working. However, the solution involving the lcm of cycles is faster and I will post it here (the other one is posted as a comment there).

My solution uses arrays for constant time access, though a good running time can be obtained if using the standard lists functions.

`import Data.Array`

To obtain the array is simple, as shown by the following code:

`constructPairs :: [Int] -> [(Int, Int)]`

constructPairs perm = zip [0..l] perm

where

l = length perm

toArray :: [(Int, Int)] -> Array Int Int

toArray pair = array (0, l) pair

where

l = length pair - 1

constructPairs perm = zip [0..l] perm

where

l = length perm

toArray :: [(Int, Int)] -> Array Int Int

toArray pair = array (0, l) pair

where

l = length pair - 1

Now, we can obtain the solution

`getCycle :: Array Int Int -> Int -> [Int]`

getCycle a x = (x:) $ takeWhile (\e -> e /= x) $ iterate (a!) $ (a!) x

getCycleLengths :: [Int] -> [Int]

getCycleLengths perm = map (\i -> length $ getCycle a i) perm

where

a = toArray $ constructPairs perm

computeOrder' :: [Int] -> Int

computeOrder' perm = foldl lcm 1 $ getCycleLengths perm

solution :: Int -> Int -> Int

solution n p = computeOrder' $ getAllKicks n p

getCycle a x = (x:) $ takeWhile (\e -> e /= x) $ iterate (a!) $ (a!) x

getCycleLengths :: [Int] -> [Int]

getCycleLengths perm = map (\i -> length $ getCycle a i) perm

where

a = toArray $ constructPairs perm

computeOrder' :: [Int] -> Int

computeOrder' perm = foldl lcm 1 $ getCycleLengths perm

solution :: Int -> Int -> Int

solution n p = computeOrder' $ getAllKicks n p

This way, both solutions are obtained in less than a second (and the answer to , is 836,744,980)