Solving Sierpinski Triangle in Haskell

Question

I am a Haskell beginner with a background in C++ and Python. I have been teaching myself Haskell for about half a year on and off and recently I started doing Hackerrank problems to improve my Haskell muscle. Sometimes I found myself struggling with problems that would be solved fairly easily with an imperative language. Sierpinski triangle is one of them.

My solution ends up much longer than I would have written in Python. Some of the submissions I read at Hackerrank took advantage of the fact that it is a 32 by 63 image to print out while I took a more general approach that should work for any 2^n by 2^(n+1)-1 image. First there is probably a much better general solution to the problem and further more, even with the general solution I have, I still believe that there should be a much more compact way of writing it in Haskell.

Here is my wall of text solution:

import Data.List (groupBy, sortBy, intercalate)
-- a triangle is defined by its vertices. (Int, Int) 
type Point = (Int, Int)
data Triangle = Triangle
 { upper :: Point
 , left :: Point
 , right :: Point
 , height :: Int } deriving (Show)
-- make a triangle from its upper vertex and its height
makeTriangle :: Point -> Int -> Triangle
makeTriangle upperVertex@(ux, uy) h
 | h > 1 && h `mod` 2 /= 0 = error ("no triangle with height " ++ show h)
 | otherwise = Triangle { upper=upperVertex
 , left=leftVertex
 , right=rightVertex
 , height=h }
 where leftVertex = (ux-h+1, uy-h+1)
 rightVertex = (ux+h-1, uy-h+1)
getSection :: Int -> Triangle -> (Int, Int)
getSection h t
 | h < 1 || h > height t = error ("section out side of triangle:" ++ show h)
 | otherwise = let (ux, uy) = upper t
 in (ux-h+1, ux+h-1)
-- returned triangles are sorted by their position from upper to bottom, 
-- and left to right
split :: Triangle -> [Triangle]
split t
 | h < 2 = error ("cannot split triangle with height less then 2")
 | h `mod` 2 /= 0 = error ("triangle height not multiplier of 2")
 | otherwise = [ upperOne
 , (makeTriangle lUpperVertex h')
 , (makeTriangle rUpperVertex h') ]
 where h = height t
 h' = h `div` 2
 upperOne = makeTriangle (upper t) h'
 lUpperVertex = let (x, y) = left upperOne in (x-1, y-1)
 rUpperVertex = let (x, y) = right upperOne in (x+1, y-1)
toWidth h = 2*h-1
triangleOrder :: Triangle -> Triangle -> Ordering
triangleOrder t1 t2
 | height t1 < height t2 = LT
 | height t2 > height t2 = GT
 | otherwise = if uy1 /= uy2 
 then flip compare uy1 uy2 
 else ux1 `compare` ux2
 where (ux1, uy1) = upper t1
 (ux2, uy2) = upper t2
-- total height -> iteration -> triangles 
sierpinski :: Int -> Int -> [Triangle]
sierpinski h 0 = [makeTriangle (h, h) h] 
sierpinski h n = concat $ map split $ sierpinski h (n-1)
groupTriangles ts = groupBy f $ sortBy triangleOrder ts
 where f t1 t2 = let (_, y1) = upper t1
 (_, y2) = upper t2
 in y1 == y2
type Picture = [[Char]]
makeCanvas :: Int -> Picture
makeCanvas h = replicate h $ replicate w '_'
 where w = toWidth h
drawPicture :: Picture -> IO ()
drawPicture picture = putStrLn $ intercalate "\n" picture
makeAscii :: Int -> [Triangle] -> Picture
makeAscii h ts = concat $ map drawGroup ts' 
 where ts' = groupTriangles ts
 w = toWidth h
 --tGroup is a group of triangles at the same height
 drawGroup tGroup = map draw [1..groupH]
 where groupH = height $ head tGroup
 drawLine 0 _ = []
 drawLine col [] = '_' : (drawLine (col-1) []) 
 drawLine col intervals@((start, end):(ints))
 | pos < start = '_' : (drawLine (col-1) intervals)
 | pos > end = drawLine col ints
 | otherwise = '1' : (drawLine (col-1) intervals) 
 where pos = w - col + 1
 draw l = drawLine w $ map (getSection l) tGroup
main = do
 n <- readLn :: IO Int
 drawPicture $ makeAscii 32 $ sierpinski 32 n

• Zeta: Welcome to Code Review. Since you're a beginner, you might want to exchange one of the given tags with beginner. I'll hope you get some nice feedback.

Answer 1

Just some details that can make your code shorter:

I'd keep just one of the points and the height in Triangle. And instead of the height, I'd keep its logarithm, which makes operations on triangles much easier. In general, it's better to keep just the data you need in your data types with as little additional constraints as possible.

type Point = (Int, Int)
data Triangle = Triangle
 { upper :: Point
 , heightLog :: Int
 } deriving (Eq, Show)

For comparing them, you can define an Ord instance to simplify your code. Instead of describing all the possible comparison states explicitly, you can take advantage of the Ord instance for tuples. So if you want to compare first by height, then by the Y axis and then by the X axis, you can write:

instance Ord Triangle where
 compare (Triangle (x1, y1) hl1) (Triangle (x2, y2) hl2) =
 compare (hl1, y1, x1) (hl2, y2, x2)

If you want to compare by Y in the opposite order, you can write compare (hl1, y2, x1) (hl2, y1, x2).

Now you don't need makeTriangle at all, and splitting them becomes simpler:

-- | Splits a triangle into its 3 components.
-- Returned triangles are sorted by their position from upper to bottom, 
-- and left to right
split :: Triangle -> [Triangle]
split (Triangle _ 0) = error "Cannot split singleton triangle"
split (Triangle u@(x, y) hl) =
 [ Triangle u hl'
 , Triangle (x - shift, y + shift) hl'
 , Triangle (x + shift, y + shift) hl'
 ]
 where
 hl' = hl - 1
 shift = 2^hl'

For iteration inside serpinski you can benefit from iterate and take the n-th element of the output. Note that thanks to laziness, you don't have to care that further elements in the list are not defined.

-- total height -> iteration -> triangles 
sierpinski :: Int -> Int -> [Triangle]
sierpinski h = (iterate (concatMap split) [Triangle (0, 0) h] !!)

For grouping, sorting etc. according to some property there are two very useful combinators: on, which we use here:

groupTriangles :: [Triangle] -> [[Triangle]]
groupTriangles = groupBy (on (==) (snd . upper)) . sort

and comparing.

(Unfortunately I don't have more time to review the rest, maybe later or someone else can continue.)

---

And I recommend reading various ways of constructing Serpinski triangle, it's quite likely that it's possible to build one straight from the top very easily.

Answer 2

I am also on my way to dive deeper into Haskell and it turns out that I am going through the same learning path in Hackerank. If you'd like to, I made a much shorter solution that still requires minor fixes but works with any height, width (2*height-1) and depth level. I still didn't figure out where does reside the problem yet in my code (works fine with depth <= 3), but maybe you can be inspired for a much shorter solution:

import Data.List (intercalate)
data Triangle = Triangle { up :: Int
 , height :: Int }
 deriving (Show, Eq)
fill :: Int -> Int -> Int -> [String]
fill h w s = let fillLn n = replicate (s-n) '_' ++
 replicate (1+2*n) '1' ++
 replicate (w-s-n-1) '_'
 in map fillLn [0..h-1]
sierpinski :: Int -> Int -> [String]
sierpinski hgt n =
 let initt :: Int -> Int -> Int -> Int -> Int -> [String]
 initt h w s 0 _ = fill h w s
 initt h w s l d =
 let lvl1 = initt (div h 2) w s (l-1) (d+1)
 lvl2_1 = initt (div h 2) s (s-1-div w (2^(d+1))) (l-1) d
 lvl2_2 = initt (div h 2) (w-s-1) (div w (2^(d+1))) (l-1) d
 lvl2 = zipWith (++) lvl2_1 $ zipWith (++) (replicate (div h 2) "_") lvl2_2
 in lvl1 ++ lvl2
 in initt hgt (2*hgt-1) (hgt-1) n 1
draw :: [String] -> IO ()
draw mat = putStrLn $ intercalate "\n" mat
main :: IO ()
main = do
 n <- readLn :: IO Int
 draw $ sierpinski 32 n

• Sᴀᴍ Onᴇᴌᴀ: Welcome to Code Review! Please (re-) read The help center page How do I write a good answer?. Note it states: "Every answer must make at least one insightful observation about the code in the question. Answers that merely provide an alternate solution with no explanation or justification do not constitute valid Code Review answers and may be deleted."
• Ramy Kader: Oh sorry, my bad. Actually, my code was inspired by his solution in the first place, that's why I posted it but didn't explain myself that much. I'll try to write better answers the next time. Thanks
• dhu: nice solution. It is much short than my other solution. At first it looked a little intimidating but after I actually sat down and read through, the recursive pattern was easy to understand. The coincidence is that I recently came back to this problem and attempted another solution. I just posted it in the forum too: codereview.stackexchange.com/questions/233045/…