[Haskell-cafe] (Newbie) Dynamic Programming, Memoizing Etc.
Bryce Bockman
bryce at jfet.net
Wed Mar 16 15:14:11 EST 2005
How would you guys memoize the following code.
simpleCalc :: (Int,Int) -> (Int,Int)
simpleCalc (1,l) = (1,l+1)
simpleCalc (x,l) | (odd x) = simpleCalc (((3*x) + 1), 1 + l)
| otherwise = simpleCalc ((x `div` 2), 1 + l)
sCalc x = simpleCalc (x,0)
sCalcListRange a b = map sCalc [a..b]
sCalcListLengthRange a b = map snd (sCalcListRange a b)
The key is I need to calculate maximum (sCalcListLengthRange 1 1000000).
This is a common programming contest problem that I'm playing with for
fun. My first attempt fails miserably. It begins to thrash much more
quickly then simple version above:
calcListLengthRange a b = map snd (calcListRange a b)
calcListRange a b = map calcList [a .. b]
where
calcList = ((map calc' [0 ..]) !!)
where
calc' :: Int -> (Int,Int)
calc' i = calcList' (i,0)
calcList' :: (Int,Int) -> (Int,Int)
calcList' (1,l) = (1,l+1)
calcList' (x,l) | (odd x) = ((fst((calcList ((3*x) + 1))), snd(calcLi\
st((3*x) + 1)) + 1 + l))
| otherwise = ((fst((calcList (x `div` 2))), snd(calcLi\
st((x `div` 2))) + 1 + l))
I tried to associate a table entry with a particular solution to the
problem, so taht calcList would just be a lookup for those we had finished
calculating.
Sorry this code is ugly I know, but I'm just learning.
Cheers,
Bryce
More information about the Haskell-Cafe
mailing list