Problem

Here is an earlier attempt to solve the original problem:

Solving Sierpinski Triangle in Haskell

I was never satisfied with my solution and found it was awkward and twisty. Here is another attempt to solve the same problem using Data.Array and I found that by using mutable arrays the solution becomes much shorter and easy to read.

```
import qualified Data.Array as DA (Array, listArray, (//), assocs)
import qualified Data.List as DL (groupBy, intercalate)
import qualified Data.Function as DF (on)
type Point = (Int, Int)
data Triangle = Triangle { up :: Point, height :: Int } deriving Show
type Canvas = DA.Array Point Char
emptyCanvas maxLevel = DA.listArray ((0, 1-h), (h-1, h-1)) $ repeat '_'
where
h = 2^maxLevel -- 1*(2^maxLevel)
drawTriangle :: Triangle -> Canvas -> Canvas
drawTriangle (Triangle (r, c) h) canvas = foldr drawLine canvas $ map line [1..h]
where
line h = let h' = h-1 in [(r+h', j) | j <- [c-h'..c+h']]
drawLine l c = c DA.// map (p -> (p, '1')) l
drawCanvas :: Canvas -> IO ()
drawCanvas canvas = putStrLn pic
where
rows = DL.groupBy ((==) `DF.on` (fst . fst)) . DA.assocs
pic = DL.intercalate "n" $ map (map snd) (rows canvas)
split hLvl (r, c) = let w = 2^(hLvl-1) in [(r, c), (r+w, c-w), (r+w, c+w)]
splitSier maxLevel (sierLevel, ts) = (sierLevel+1, ts')
where
ts' = ts >>= (split (maxLevel-sierLevel))
mkSierpinski :: Int -> Int -> Canvas
mkSierpinski maxLevel sierLevel
| maxLevel >= sierLevel = foldr drawTriangle c $ allTriangles
| otherwise = c
where
c = emptyCanvas maxLevel
(l', ts') = head $ drop sierLevel $ iterate (splitSier maxLevel) (0, [(0, 0)])
allTriangles = map (p -> Triangle p (2^(maxLevel-l'))) ts'
main = do
sierLevel <- readLn
drawCanvas $ mkSierpinski 5 sierLevel
```

The idea is to model the canvas by a 2-D array of Characters and attempt to draw easy individual triangles on top of the empty canvas. In this solution it starts with one big triangle and keep splitting to generate Sierpinski pattern. Another solution that I didn’t post here attempts to solve it by starting with the smallest triangle at the top, and repeatedly copy what is current on canvas to its lower left corner and lower right corner. Both solutions look very similar at the end.

Please let me know if you have suggestions. Thank you in advance.

Solution

`//`

is best called with one bulk list because each call incurs one O(n) array copy.

Folds over iterates when you need an index and know its range, it’s like for vs. while.

```
drawCanvas :: Canvas -> IO ()
drawCanvas = putStrLn . unlines . map (map snd)
. DL.groupBy ((==) `DF.on` fst . fst) . DA.assocs
mkSierpinski :: Int -> Int -> Canvas
mkSierpinski maxLevel sierLevel = emptyCanvas maxLevel DA.//
[ ((r+h, j), '1')
| maxLevel >= sierLevel
, (r, c) <- DF.foldrM split (0, 0) [maxLevel-sierLevel+1..maxLevel]
, h <- [0..2^(maxLevel-sierLevel)-1]
, j <- [c-h..c+h]
]
```