# Solving Sierpinski Triangle in Haskell

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

• 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.
– Zeta
Apr 22, 2018 at 7:14

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


(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.

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

• 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." Nov 16, 2019 at 14:14
• 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 Nov 18, 2019 at 1:32
• 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/…
– dhu
Nov 27, 2019 at 4:00