
Hello, I agree that your answer is elegant, but it's not an efficient algorithm in any language. How about this, keeping the rest of your code the same? import Data.Array.Diff import Data.IArray update :: (Char -> [Int]) -> DiffArray Int ModP -> Char -> DiffArray Int ModP update lookup arr c = arr // (map calc . lookup $ c) where calc i = (i, (arr ! i) + (arr ! (i-1))) solve line sol = (foldl' (update lookup) iArray line) ! snd (bounds iArray) where iArray = listArray (0, length sol) $ 1 : map (const 0) sol lookup c = map (+1) . findIndices (== c) $ sol I would expect that at least some of the C programs would use the same algorithm. It's not the most efficient Haskell implementation, but on my computer it runs the large dataset in a little under 3 seconds, which is probably good enough. Cheers, John
Hi,
I participating in de google code jam this year and I want to try to use haskell. The following simple http://code.google.com/codejam/contest/dashboard?c=90101#s=p2 problem would have the beautiful haskell solution.
import Data.MemoTrie import Data.Char import Data.Word import Text.Printf
newtype ModP = ModP Integer deriving Eq
p=10000
instance Show ModP where show (ModP x) = printf "%04d" x
instance Num ModP where ModP x + ModP y = ModP ((x + y) `mod` p) fromInteger x = ModP (x `mod` p) ModP x * ModP y = ModP ((x * y) `mod` p) abs = undefined signum = undefined
solve _ [] = 1::ModP solve [] _ = 0::ModP solve (hs:ts) t@(ht:tt) | hs==ht = solve ts tt + solve ts t | otherwise = solve ts t
go (run, line) = "Case #"++show run++": "++show (solve line "welcome to code jam")
main = interact $ unlines . map go . zip [1..] . tail . lines
Which is unfortunately exponential.
Now in earlier thread I argued for a compiler directive in the lines of {-# Memoize function -#}, but this is not possible (it seems to be trivial to implement though). Now I used memotrie which runs hopelessly out of memory. I looked at some other haskell solutions, which were all ugly and more clumsy compared to simple and concise C code. So it seems to me that haskell is very nice and beautiful until your are solving real algorithmic problems when you want to go back to some imperative language.
How would experienced haskellers solve this problem?
Thanks -- View this message in context: http://www.nabble.com/memoization-tp25306687p25306687.html Sent from the Haskell - Haskell-Cafe mailing list archive at Nabble.com.
participants (1)
-
John Lato