My "memoized" pascal function doesn't really work - haskell

import Data.List (intercalate)
import Control.Concurrent (threadDelay)
import Data.Maybe (fromJust)
import System.IO
-- I love how amazingly concise Haskell code can be. This same program in C, C++ or Java
-- would be at least twice as long.
pascal :: Int -> Int -> Int
pascal row col | col >= 0 && col <= row =
if row == 0 || col == 0 || row == col
then 1
else pascal (row - 1) (col - 1) + pascal (row - 1) col
pascal _ _ = 0
pascalFast' :: [((Int, Int), Int)] -> Int -> Int -> Int
pascalFast' dict row col | col > row = 0
pascalFast' dict row col | row == 0 || col == 0 || row == col = 1
pascalFast' dict row col =
let value1 = lookup (row - 1, col - 1) dict
value2 = lookup (row - 1, col) dict
in if not(value1 == Nothing || value2 == Nothing)
then (fromJust value1) + (fromJust value2)
else let dict' = ((row - 1, col), pascalFast' dict (row - 1) col) : dict
dict'' = ((row - 1, col - 1), pascalFast' dict' (row - 1) (col - 1)) : dict'
in (pascalFast' dict'' (row - 1) col) + (pascalFast' dict'' (row - 1) (col - 1))
pascalFast = pascalFast' []
pascalsTriangle :: Int -> [[Int]]
pascalsTriangle rows =
[[pascal row col | col <- [0..row]] | row <- [0..rows]]
main :: IO ()
main = do
putStrLn ""
putStr "Starting at row #0, how many rows of Pascal's Triangle do you want to print out? "
hFlush stdout
numRows <- (\s -> read s :: Int) <$> getLine
let triangle = pascalsTriangle numRows
longestStringLength = (length . show) $ foldl1 max $ flatten triangle
triangleOfStrings = map (intercalate ", ") $ map (map (pad longestStringLength)) triangle
lengthOfLastDiv2 = div ((length . last) triangleOfStrings) 2
putStrLn ""
mapM_ (\s -> let spaces = [' ' | x <- [1 .. lengthOfLastDiv2 - div (length s) 2]]
in (putStrLn $ spaces ++ s) >> threadDelay 200000) triangleOfStrings
putStrLn ""
flatten :: [[a]] -> [a]
flatten xs =
[xss | ys <- xs, xss <- ys]
pad :: Int -> Int -> String
pad i k =
[' ' | _ <- [1..n]] ++ m
where m = show k
n = i - length m
For the life of me I do not understand why pascalFast isn't FAST!!! It type checks and mathematically it is correct, but my "pascalFast" function is just as slow as my "pascal" function. Any ideas? And no, this is not a homework assignment. It's something I just want to try for myself. Thanks for the feedback.
Best,
Douglas Lewit

Your main doesn't actually call pascalFast at all, so it's not clear to me exactly what you were doing that caused you to conclude it is slow - with some effort, I can tell it is slow from looking at it, but some evidence in the question would be nice.
As to why, two problems leap out at me. It seems to me that, because you pass the dictionary "upwards" to the base case but never pass it downwards or sideways, you are only caching results that you will never look at again. Try evaluating pascalFast [] 2 1 by hand, on paper, and see if you ever get a cache hit.
Secondly, even if you were caching correctly, using lookup will take time linear in the size of the list, so your runtime is at least quadratic in the number of entries generated: for each item you generate, you look at all the other items at least once. To cache efficiently you need a real data structure, like one from Data.Map.
But separate from the question of how to memoize effectively, it is often better to not memoize at all, by starting from the base cases and building up, rather than reaching down from the final result. Something like this is pretty classic for Pascal's Triangle:
triangle :: [[Int]]
triangle = iterate nextRow [1]
where nextRow xs = 1 : zipWith (+) xs (tail xs) ++ [1]
main :: IO ()
main = print $ take 5 triangle

Related

Outputting Pascal's triangle

import Data.List (intercalate)
import Control.Concurrent (threadDelay)
import System.IO
-- I love how amazingly concise Haskell code can be. This same program in C, C++ or Java
-- would be at least twice as long.
pascal :: Int -> Int -> Int
pascal row col | col >= 0 && col <= row =
if row == 0 || col == 0 || row == col
then 1
else pascal (row - 1) (col - 1) + pascal (row - 1) col
pascal _ _ = 0
pascalsTriangle :: Int -> [[Int]]
pascalsTriangle rows =
[[pascal row col | col <- [0..row]] | row <- [0..rows]]
main :: IO ()
main = do
putStrLn ""
putStr "Starting at row #0, how many rows of Pascal's Triangle do you want to print out? "
hFlush stdout
numRows <- (\s -> read s :: Int) <$> getLine
let triangle = pascalsTriangle numRows
triangleOfStrings = map (intercalate ", ") $ map (map show) triangle
lengthOfLastDiv2 = div ((length . last) triangleOfStrings) 2
putStrLn ""
mapM_ (\s -> let spaces = [' ' | x <- [1 .. lengthOfLastDiv2 - div (length s) 2]]
in (putStrLn $ spaces ++ s) >> threadDelay 200000) triangleOfStrings
putStrLn ""
My little program above finds the values of Pascal's Triangle. But if you compile it and use it you'll see that the "triangle" looks more like a Christmas tree than a triangle! Ouch!
I'm just taking half the length of the last line and subtracting from that half the length of each preceding line, and creating that many blank spaces to add to the beginning of each string. It ALMOST works, but I'm looking for an equilateral triangle type of effect, but to me it resembles a sloping Christmas tree! Is there a better way to do this. What am I missing besides some programming talent?! Thanks for the help. THIS IS NOT A HOMEWORK ASSIGNMENT. I'm just doing this for fun and recreation. I appreciate the help.
Best.
Douglas Lewit.
Here's a straightforward implementation:
space n = replicate n ' '
pad n s | n < length s = take n s
pad n s = space (n - length s) ++ s
triangle = iterate (\ xs -> zipWith (+) (xs ++ [0]) (0:xs)) [1]
rowPrint n hw xs = space (n * hw) ++ concatMap (pad (2*hw) . show) xs
triRows n hw = [rowPrint (n-i) hw row | (i,row) <- zip [1..n] triangle]
main = do
s <- getLine
mapM_ putStrLn (triRows (read s) 2)
Note that triangle is an infinite Pascal's triangle, generated by the recurrence relation. Also, hw stands for "half-width": half the width allocated for printing a number, and pad is a strict left-pad that truncates the output rather than disrupt the formatting.

Haskell ways to the 3n+1 challenge

Here is a simple programming problem from SPOJ: http://www.spoj.com/problems/PROBTRES/.
Basically, you are asked to output the biggest Collatz cycle for numbers between i and j. (Collatz cycle of a number $n$ is the number of steps to eventually get from $n$ to 1.)
I have been looking for a Haskell way to solve the problem with comparative performance than that of Java or C++ (so as to fits in the allowed run-time limit). Although a simple Java solution that memoizes the cycle length of any already computed cycles will work. I haven't been successful at applying the idea to obtain a Haskell solution.
I have tried the Data.Function.Memoize, as well as home-brewed log time memoization technique using the idea from this post: Memoization in Haskell?. Unfortunately, memoization actually makes the computation of cycle(n) even slower. I believe the slow down comes from the overhead of haskell way. (I tried running with the compiled binary code, instead of interpreting.)
I also suspect that simply iterating numbers from i to j can be costly ($i,j\le10^6$). So I even tried precompute everything for the range query, using idea from http://blog.openendings.net/2013/10/range-trees-and-profiling-in-haskell.html. However, this still gives "Time Limit Exceeding" error.
Can you help to inform a neat competitive Haskell program for this?
Thanks!
>>> using the approach bellow, I could submit an accepted answer to SPOJ. You may check the entire code from here.
The problem has bounds 0 < n < 1,000,000. Pre-calculate all of them and store them inside an array; then freeze the array. The array can be used as its own cache / memoization space.
The problem would then reduce to a range query problem over an array, which can be done very efficiently using trees.
With the code bellow I can get Collatz of 1..1,000,000 in a fraction of a second:
$ time echo 1000000 | ./collatz
525
real 0m0.177s
user 0m0.173s
sys 0m0.003s
Note that collatz function below, uses mutable STUArray internally, but itself is a pure function:
import Control.Monad.ST (ST)
import Control.Monad (mapM_)
import Control.Applicative ((<$>))
import Data.Array.Unboxed (UArray, elems)
import Data.Array.ST (STUArray, readArray, writeArray, runSTUArray, newArray)
collatz :: Int -> UArray Int Int
collatz size = out
where
next i = if odd i then 3 * i + 1 else i `div` 2
loop :: STUArray s Int Int -> Int -> ST s Int
loop arr k
| size < k = succ <$> loop arr (next k)
| otherwise = do
out <- readArray arr k
if out /= 0 then return out
else do
out <- succ <$> loop arr (next k)
writeArray arr k out
return out
out = runSTUArray $ do
arr <- newArray (1, size) 0
writeArray arr 1 1
mapM_ (loop arr) [2..size]
return arr
main = do
size <- read <$> getLine
print . maximum . elems $ collatz size
In order to perform range queries on this array, you may build a balanced tree as simple as below:
type Range = (Int, Int)
data Tree = Leaf Int | Node Tree Tree Range Int
build_tree :: Int -> Tree
build_tree size = loop 1 cnt
where
ctz = collatz size
cnt = head . dropWhile (< size) $ iterate (*2) 1
(Leaf a) +: (Leaf b) = max a b
(Node _ _ _ a) +: (Node _ _ _ b) = max a b
loop lo hi
| lo == hi = Leaf $ if size < lo then minBound else ctz ! lo
| otherwise = Node left right (lo, hi) (left +: right)
where
i = (lo + hi) `div` 2
left = loop lo i
right = loop (i + 1) hi
query_tree :: Tree -> Int -> Int -> Int
query_tree (Leaf x) _ _ = x
query_tree (Node l r (lo, hi) x) i j
| i <= lo && hi <= j = x
| mid < i = query_tree r i j
| j < 1 + mid = query_tree l i j
| otherwise = max (query_tree l i j) (query_tree r i j)
where mid = (lo + hi) `div` 2
Here is the same as in the other answer, but with an immutable recursively defined array (and it also leaks slightly (can someone say why?) and so two times slower):
import Data.Array
upper = 10^6
step :: Integer -> Int
step i = 1 + colAt (if odd i then 3 * i + 1 else i `div` 2)
colAt :: Integer -> Int
colAt i | i > upper = step i
colAt i = col!i
col :: Array Integer Int
col = array (1, upper) $ (1, 1) : [(i, step i) | i <- [2..upper]]
main = print $ maximum $ elems col

Getting an element from a matrix in Haskell [duplicate]

Can anybody help me with this function?
getCell :: [[Int]] -> Int -> Int -> Int
Where m i j are the indexes of the lines and the columns of the list of lists m.
the indexes start from zero and every line is the same size.
The function should return -1 if i or j are not valid.
I'm having an exam on Haskell, and despite the fact that this might show up, i still want to know how can i do it, and because i've never worked with lists of lists in Haskell, i have no idea how to start solving this problem. Can you give me a hand ?
here's what i've done so far:
getCell :: [[Int]] -> Int -> Int -> Int
getCell [] _ _ = "the list is empty!"
getCell zs x y =
if x > length zs || y > length (z:zs) then -1 else
let row = [x| x == !! head z <- zs]
column = ...
I don't know how to find the rows and the columns
This should work using the (!!) operator. First check if index is in the list, then access the element at that index using (!!).
getCell m i j = if i >= length m then -1
else let
m0 = m !! i
in if j >= length m0 then -1
else m0 !! j
Just for fun - one liner
getCell l i j = (((l ++ repeat []) !! i) ++ repeat (-1)) !! j

Struggling with lists of lists in Haskell

Can anybody help me with this function?
getCell :: [[Int]] -> Int -> Int -> Int
Where m i j are the indexes of the lines and the columns of the list of lists m.
the indexes start from zero and every line is the same size.
The function should return -1 if i or j are not valid.
I'm having an exam on Haskell, and despite the fact that this might show up, i still want to know how can i do it, and because i've never worked with lists of lists in Haskell, i have no idea how to start solving this problem. Can you give me a hand ?
here's what i've done so far:
getCell :: [[Int]] -> Int -> Int -> Int
getCell [] _ _ = "the list is empty!"
getCell zs x y =
if x > length zs || y > length (z:zs) then -1 else
let row = [x| x == !! head z <- zs]
column = ...
I don't know how to find the rows and the columns
This should work using the (!!) operator. First check if index is in the list, then access the element at that index using (!!).
getCell m i j = if i >= length m then -1
else let
m0 = m !! i
in if j >= length m0 then -1
else m0 !! j
Just for fun - one liner
getCell l i j = (((l ++ repeat []) !! i) ++ repeat (-1)) !! j

Retrieve strings from Matrix

I'm stuck with my homework task, somebody help, please..
Here is the task:
Find all possible partitions of string into words of some dictionary
And here is how I'm trying to do it:
I use dynamical programming concept to fill matrix and then I'm stuck with how to retrieve data from it
-- Task5_2
retrieve :: [[Int]] -> [String] -> Int -> Int -> Int -> [[String]]
retrieve matrix dict i j size
| i >= size || j >= size = []
| index /= 0 = [(dict !! index)]:(retrieve matrix dict (i + sizeOfWord) (i + sizeOfWord) size) ++ retrieve matrix dict i (next matrix i j) size
where index = (matrix !! i !! j) - 1; sizeOfWord = length (dict !! index)
next matrix i j
| j >= (length matrix) = j
| matrix !! i !! j > 0 = j
| otherwise = next matrix i (j + 1)
getPartitionMatrix :: String -> [String] -> [[Int]]
getPartitionMatrix text dict = [[ indiceOfWord (getWord text i j) dict 1 | j <- [1..(length text)]] | i <- [1..(length text)]]
--------------------------
getWord :: String -> Int -> Int -> String
getWord text from to = map fst $ filter (\a -> (snd a) >= from && (snd a) <= to) $ zip text [1..]
indiceOfWord :: String -> [String] -> Int -> Int
indiceOfWord _ [] _ = 0
indiceOfWord word (x:xs) n
| word == x = n
| otherwise = indiceOfWord word xs (n + 1)
-- TESTS
dictionary = ["la", "a", "laa", "l"]
string = "laa"
matr = getPartitionMatrix string dictionary
test = retrieve matr dictionary 0 0 (length string)
Here is a code that do what you ask for. It doesn't work exactly like your solution but should work as fast if (and only if) both our dictionary lookup were improved to use tries as would be reasonable. As it is I think it may be a bit faster than your solution :
module Partitions (partitions) where
import Data.Array
import Data.List
data Branches a = Empty | B [([a],Branches a)] deriving (Show)
isEmpty Empty = True
isEmpty _ = False
flatten :: Branches a -> [ [ [a] ] ]
flatten Empty = []
flatten (B []) = [[]]
flatten (B ps) = concatMap (\(word, bs) -> ...) ps
type Dictionary a = [[a]]
partitions :: (Ord a) => Dictionary a -> [a] -> [ [ [a] ] ]
partitions dict xs = flatten (parts ! 0)
where
parts = listArray (0,length xs) $ zipWith (\i ys -> starting i ys) [0..] (tails xs)
starting _ [] = B []
starting i ys
| null words = ...
| otherwise = ...
where
words = filter (`isPrefixOf` ys) $ dict
go word = (word, parts ! (i + length word))
It works like this : At each position of the string, it search all possible words starting from there in the dictionary and evaluates to a Branches, that is either a dead-end (Empty) or a list of pairs of a word and all possible continuations after it, discarding those words that can't be continued.
Dynamic programming enter the picture to record every possibilities starting from a given index in a lazy array. Note that the knot is tied : we compute parts by using starting, which uses parts to lookup which continuations are possible from a given index. This only works because we only lookup indices after the one starting is computing and starting don't use parts for the last index.
To retrieve the list of partitions from this Branches datatype is analogous to the listing of all path in a tree.
EDIT : I removed some crucial parts of the solution in order to let the questioner search for himself. Though that shouldn't be too hard to complete with some thinking. I'll probably put them back with a somewhat cleaned up version later.

Resources