Outputting Pascal's triangle - haskell

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.

Related

My "memoized" pascal function doesn't really work

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

Haskell print out 2d array

I'm trying to print out my 2d array in game of life, but i'm not quite sure how to go on with it. So I need some help with my printArray function I'm not quite sure how to proceed. Her is the code below, everything is working.. Except printing it out in the right manner.
module GameOfLife where
import Data.List
import System.IO
import Text.Show
import Data.Array
import System.Random
width :: Int
width = 5
height :: Int
height = 5
data State = Alive | Dead deriving (Eq, Show)
type Pos = (Int,Int)
type Board = Array Pos State
startBoard :: Pos -> Board
startBoard (width,height) =
let bounds = ((0,0),(width - 1,height - 1))
in array bounds $ zip (range bounds) (repeat Dead)
set :: Board -> [(Pos,State)] -> Board
set = (//)
get :: Board -> [Pos] -> [State]
get board pos = map (board!) pos
neighbours :: Board -> Pos -> [Pos]
neighbours board c#(x,y) =
filter (/= c) $ filter (inRange (bounds board)) [(x',y') | x' <- [x -
1..x + 1], y' <- [y - 1..y + 1]]
nextGen :: Board -> Board
nextGen board =(irrelevant code for the question..)
printArray :: Board -> String
printArray arr =
unlines [unwords [show (arr ! (x, y)) | x <- [1..5]] | y <- [1..5]]
My output:
[((0,0),Dead),((0,1),Dead),((0,2),Dead),((0,3),Dead),((1,0),Dead),
((1,1),Dead),((1,2),Dead),((1,3),Dead),((2,0),Dead),((2,1),Dead),
((2,2),Dead)2,3),Dead)]
My preferable output:
1 2 3 4 5
1 . . . . .
2 n n n . .
3 n X n . .
4 n n n . .
5 . . . . .
To start to answer your question, I suggest breaking the problem into several pieces:
Print out the numbers across the top.
Number each row as you print them.
Decide what symbol to print in each cell.
Tackle each of these pieces one at a time. If it helps, rather than think in terms of "printing" just build up a String object. Once you have a String, printing is pretty trivial.

How do I filter lines based on their first word in Haskell?

I'm having a bit of a tough time defining a function that parses a bunch of strings and filters for strings of the form:
v 3.0 2.0 3.7
where the v is the identifier. There are a bunch of identifiers (vt, f, etc.) but I am only interested in the ones starting with a v.
The function header looks like:
readOBJVerts :: [String] -> [Point]
and I have this so far:
readOBJVerts lines = [(x,y,z) | line <- lines,
let x = read (coords !! 1) :: GLDouble
y = read (coords !! 2) :: GLDouble
z = read (coords !! 3) :: GLDouble
coords = splitOn " " line
However, I receive the following error:
Main.hs: Prelude.read: no parse
Main.hs: interrupted
I believe this is because my function does not currently filter for only the v lines. So it's attempting to parse lines like:
f 1/2 2/1 3/4
which doesn't bode well for the read function.
What's the easiest way to filter for lines only beginning with a specific word?
In a haskell comprehension, you can add boolean expressions to it, so that any values that do not match the expression are not included in the final result. Eg [x | x <- [1..10], even x ] returns [2,4,5,6,10]. This allows a simple adjustment to your function so it operates like you want:
readOBJVerts lines = [(x,y,z) | line <- lines,
let x = read (coords !! 1) :: GLDouble
y = read (coords !! 2) :: GLDouble
z = read (coords !! 3) :: GLDouble
coords = splitOn " " line,
(coords !! 0) == "v"]

Project Euler #4 using Haskell

I hope this works by just pasting and running it with "runghc euler4.hs 1000". Since I am having a hard time learning Haskell, can someone perhaps tell me how I could improve here? Especially all those "fromIntegral" are a mess.
module Main where
import System.Environment
main :: IO ()
main = do
args <- getArgs
let
hBound = read (args !! 0)::Int
squarePal = pal hBound
lBound = floor $ fromIntegral squarePal /
(fromIntegral hBound / fromIntegral squarePal)
euler = maximum $ takeWhile (>squarePal) [ x | y <- [lBound..hBound],
z <- [y..hBound],
let x = y * z,
let s = show x,
s == reverse s ]
putStrLn $ show euler
pal :: Int -> Int
pal n
| show pow == reverse (show pow) = n
| otherwise = pal (n-1)
where
pow = n^2
If what you want is integer division, you should use div instead of converting back and forth to Integral in order to use ordinary /.
module Main where
import System.Environment
main :: IO ()
main = do
(arg:_) <- getArgs
let
hBound = read arg :: Int
squarePal = pal hBound
lBound = squarePal * squarePal `div` hBound
euler = maximum $ takeWhile (>squarePal) [ x | y <- [lBound..hBound],
z <- [y..hBound],
let x = y * z,
let s = show x,
s == reverse s ]
print euler
pal :: Int -> Int
pal n
| show pow == reverse (show pow) = n
| otherwise = pal (n - 1)
where
pow = n * n
(I've re-written the lbound expression, that used two /, and fixed some styling issues highlighted by hlint.)
Okay, couple of things:
First, it might be better to pass in a lower bound and an upper bound for this question, it makes it a little bit more expandable.
If you're only going to use the first two (one in your previous case) arguments from the CL, we can handle this with pattern matching easily and avoid yucky statements like (args !! 0):
(arg0:arg1:_) <- getArgs
Let's convert these to Ints:
let [a, b] = map (\x -> read x :: Int) [arg0,arg1]
Now we can reference a and b, our upper and lower bounds.
Next, let's make a function that runs through all of the numbers between an upper and lower bound and gets a list of their products:
products a b = [x*y | x <- [a..b], y <- [x..b]]
We do not have to run over each number twice, so we start x at our current y to get all of the different products.
from here, we'll want to make a method that filters out non-palindromes in some data set:
palindromes xs = filter palindrome xs
where palindrome x = show x == reverse $ show x
finally, in our main function:
print . maximum . palindromes $ products a b
Here's the full code if you would like to review it:
import System.Environment
main = do
(arg0:arg1:_) <- getArgs
let [a, b] = map (\x -> read x :: Int) [arg0,arg1]
print . maximum . palindromes $ products a b
products a b = [x*y | x <- [a..b], y <- [x..b]]
palindromes = filter palindrome
where palindrome x = (show x) == (reverse $ show x)

Haskell: problem with recursion

I am trying to format text to be in the shape of a rectangle; currently I have been able to get it properly left justified, but the last line does not extend as far as possible.
I am trying to calculate the optimum field width in order to minimise or remove this entirely.
I am totally stuck. The code below shows the relevant functions. At the moment it gets stuck in an infinite loop.
Where am I going wrong?
On a side note, what is the best way of debugging Haskell code?
(Yes, I'm very new to this.)
optimumFieldWidth is supposed to compare line lengths until the length of the top line is equal to that of the bottom line, then return the field width which causes this to be true.
module Main where
import System
import Data.List
main = do
(f:_) <- getArgs
xs <- getContents
putStr (show (bestFieldWidth maxLineLength xs))
bestFieldWidth :: Int -> String -> Int
bestFiledWidth _ [] = 0
bestFieldWidth lineLength xs
| length (last input) == length (head input) = lineLength
| otherwise = bestFieldWidth (length (head (rect (lineLength-1) xs))) xs
where input = lines xs
rect :: Int -> String -> [String]
rect _ [] = []
rect lineLength xs
| length input <= len = [input]
| otherwise = take len input : rect len (drop len input)
where input = trim xs
len = bestFieldWidth lineLength xs
maxLineLength :: Int
maxLineLength = 40
All responses are appreciated. Thank you.
I thought I'd put the actual solution here in case any other nutters wish to do this.
Please bear in mind that it was written by a moron so it probably isn't the most elegant solution.
maxFieldWidth :: Int
maxFieldWidth = 30
rect :: String -> String
rect xs = (unlines (chunk (bestFieldWidth (maxFieldWidth) (lines input)) input))
where input = itemsReplace '\n' ' ' xs
--Should be called with the point maximum desired width as n
bestFieldWidth :: Int -> [String] -> Int
bestFieldWidth _ [] = error "bestFieldWidth: Empty List"
bestFieldWidth n xs
| n == 6 = 6
| 1 == (length (last input)) = n
| otherwise = (bestFieldWidth (n-1) xs)
where input = chunk n (unlines xs)
chunk :: Int -> [a] -> [[a]]
chunk n [] = []
chunk n xs = ys : chunk n zs
where (ys,zs) = splitAt n xs
itemsReplace :: Eq a => a -> a -> [a] -> [a]
itemsReplace _ _ [] = []
itemsReplace c r (x:xs)
| c == x = r:itemsReplace c r xs
| otherwise = x:itemsReplace c r xs
It seems that the condition length (last input) == length (head input) once false never goes true in subsequent calls to area, thus making this function always take the otherwise branch and keep calling itself indefinitely with the same values of xs and thus input.
Possible cause of this is that you use the lines function, which splits a string with newline characters, in a way not dependent on lineLength and inconsistent with your line-splitting in the rect function.
In answer to your side note, here is an excellent guide to debugging Haskell: http://cgi.cse.unsw.edu.au/~dons/blog/2007/11/14
There's also Debug.Trace, which allows you to insert print statements. It should of course only be used while debugging, because it makes your function have side effects.
http://hackage.haskell.org/packages/archive/base/latest/doc/html/Debug-Trace.html

Resources