[Haskell-cafe] Strange behavior with listArray
oleg at okmij.org
oleg at okmij.org
Wed Nov 14 08:39:33 CET 2012
Alex Stangl wrote:
> To make this concrete, here is the real solve function, which computes
> a border array (Knuth-Morris-Pratt failure function) for a specified
> string, before the broken memoization modification is made:
> solve :: String -> String
> solve w = let h = length w - 1
> wa = listArray (0, h) w
> pI = 0 : solveR (tail w) 0
> solveR :: String -> Int -> [Int]
> solveR [] _ = []
> solveR cl@(c:cs) k = if k > 0 && wa!k /= c
> then solveR cl (pI!!(k-1))
> else let k' = if wa!k == c
> then k + 1
> else k
> in k' : solveR cs k'
> in (intercalate " " . map show) pI
>
> Here solveR corresponds to f in the toy program and pI is the list
> I would like to memoize since references to earlier elements could
> get expensive for high values of k.
Ok, let's apply a few program transformations. First we notice that
the list pI must have the same length as the string w. Since we have
already converted the string w to an array, wa, we could index into
that array. We obtain the following version.
> solve1 :: String -> String
> solve1 w = (intercalate " " . map show) pI
> where
> h = length w - 1
> wa = listArray (0, h) w
> pI = 0 : solveR 1 0
> solveR :: Int -> Int -> [Int]
> solveR i k | i > h = []
> solveR i k =
> let c = wa!i in
> if k > 0 && wa!k /= c
> then solveR i (pI!!(k-1))
> else let k' = if wa!k == c
> then k + 1
> else k
> in k' : solveR (i+1) k'
>
> t1s1 = solve1 "the rain in spain"
> t1s2 = solve1 "aaaaaaaaaaaa"
> t1s3 = solve1 "abbaabba"
We don't need to invent an index: it is already in the problem.
The unit tests confirm the semantics is preserved. The _general_ next
step is to use the pair of indices (i,k) as the key to the two
dimensional memo table. Luckily, our case is much less general. We do
have a very nice dynamic programming problem. The key is the
observation
k' : solveR (i+1) k'
After a new element, k', is produced, it is used as an argument to the
solveR to produce the next element. This leads to a significant
simplification:
> solve2 :: String -> Array Int Int
> solve2 w = pI
> where
> h = length w - 1
> wa = listArray (0, h) w
> pI = listArray (0,h) $ 0 : [ solveR i (pI!(i-1)) | i <- [1..] ]
> solveR :: Int -> Int -> Int
> solveR i k =
> let c = wa!i in
> if k > 0 && wa!k /= c
> then solveR i (pI!(k-1))
> else let k' = if wa!k == c
> then k + 1
> else k
> in k'
>
> t2s1 = solve2 "the rain in spain"
> t2s2 = solve2 "aaaaaaaaaaaa"
> t2s3 = solve2 "abbaabba"
The unit tests pass.
More information about the Haskell-Cafe
mailing list