### A Puzzle and a Solution (2)

Last post was ended with a problem: our solution exhausted the memory before it could give an answer to $N=1000$, $P=42$. 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 ```

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 ```

This way, both solutions are obtained in less than a second (and the answer to $N=1000$,$P=42$ is 836,744,980)