Sierpinski

sierpinksi.hs

-- https://www.hackerrank.com/challenges/functions-and-fractals-sierpinski-triangles

import Data.List
import Data.Monoid

data Pixel = Pixel | Blank deriving (Show)

instance Monoid Pixel where
  mempty = Blank
  mappend Blank Blank = Blank
  mappend _ _ = Pixel

type Height = Int

data Canvas = Canvas Height [[Pixel]]

instance Show Canvas where
  show = toLines 

data Coord = Coord Int Int deriving (Show)
data Triangle = Triangle Height Coord deriving (Show)

triangleHeight (Triangle h _) = h

toChar :: Pixel -> Char
toChar Pixel = '1'
toChar Blank = '_'

toLine :: [Pixel] -> String
toLine ps = map toChar ps

blank :: Int -> Canvas
blank h = Canvas h $ replicate h $ replicate ((h*2)+1) Blank

blankRow h = replicate (h*2)+1 Blank

toLines :: Canvas -> String
toLines (Canvas h ps) = intercalate "\n" $ map toLine ps

--toPixels :: Int -> Triangle -> [[Pixel]]
--toPixels ch (Triangle h (Coord x y)) = undefined

pixelRow :: Int -> Triangle -> Int -> [Pixel]
pixelRow h (Triangle th (Coord x y)) row = foldr pixelAt [] [0..(width h)]
  where
    pixelAt col ps = currentPixel col : ps
    currentPixel col = if isPixel col then Pixel else Blank
    isPixel col = (abs (col - x)) <= rowOffset && rowOffset < th
    rowOffset = (row - y)


width h = ((h-1)*2)

-- this is totally wrong.
-- the algorithm = if y == m, then firstPixelRow, if y < m then blank, y > m, use previous row
triangleMask :: Int -> Triangle -> Canvas
triangleMask ch t@(Triangle th (Coord x y)) = Canvas ch $ map (pixelRow ch t) [0..ch]
  

drawTriangle :: Canvas -> Triangle -> Canvas
drawTriangle c@(Canvas ch _) t = turnRows c (triangleMask ch t)

turnRows :: Canvas -> Canvas -> Canvas
turnRows (Canvas h rows) (Canvas _ mask) = Canvas h $ map (uncurry turnRow) (zip rows mask)

turnRow :: [Pixel] -> [Pixel] -> [Pixel]
turnRow row mask = map turn (zip row mask)
  where turn (rp, mp) = rp <> mp

drawTriangles :: Canvas -> [Triangle] -> Canvas
drawTriangles c ts = foldl drawTriangle c ts

blah = Triangle 16 (Coord 31 0)

-- ALGORITHM ----------------------------------------------------------------

firstTriangle = Triangle 32 (Coord 31 0)

sierpinksi :: Triangle -> [Triangle]
sierpinksi (Triangle h (Coord x y)) = [topTriangle, leftTriangle, rightTriangle]
  where
    halfHeight = (h `div` 2)
    topTriangle   = Triangle halfHeight $ Coord x y
    leftTriangle  = Triangle halfHeight $ Coord (x - halfHeight) (y + halfHeight)
    rightTriangle = Triangle halfHeight $ Coord (x + halfHeight) (y + halfHeight)

fractal :: Int -> [Triangle]
fractal n = fractals !! n

fractals :: [[Triangle]]
fractals = iterate once [firstTriangle]
  where once = (concat . map sierpinksi)



main = do
  n <- readLn :: IO Int
  putStrLn $ show $ drawTriangles (blank 32) $ fractal n
  return ()