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

triangle.hs

type Point = (Double,Double)
type Triangle = (Point,Point,Point)
type Sierpinski = [Triangle]

midpoint :: Point -> Point -> Point
-- ^point between two points
midpoint (x1,y1) (x2,y2) = ((x1 + x2) / 2, (y1 + y2) / 2)

vec :: Point -> Point -> Point
-- ^two points into a vector
vec (x1,y1) (x2,y2) = (x2 - x1, y2 - y1)

dot :: Point -> Point -> Double
-- ^dot product
dot (x1,y1) (x2,y2) = x1 * x2 + y1 * y2

contains :: Point -> Triangle -> Bool
-- ^does a triangle contain a point
contains p (a, b, c) = (u >= 0) && (v >= 0) && (u + v < 1)
  where
    v0 = vec a c
    v1 = vec a b
    v2 = vec a p
    dot00 = dot v0 v0
    dot01 = dot v0 v1
    dot02 = dot v0 v2
    dot11 = dot v1 v1
    dot12 = dot v1 v2
    invDenom = 1 / (dot00 * dot11 - dot01 * dot01)
    u = (dot11 * dot02 - dot01 * dot12) * invDenom
    v = (dot00 * dot12 - dot01 * dot02) * invDenom

subdivideTri :: Triangle -> [Triangle]
-- ^hollow out a triangle based on its sides' midpoints
subdivideTri (t,l,r) = [top, right, left]
  where
    top = (t, midpoint t r, midpoint t l)
    right = (midpoint t r, r, midpoint l r)
    left = (midpoint t l, midpoint l r, l)

initial :: Sierpinski
-- ^The initial state of a sierpinski triangle
initial = [((0.5,1),(1,0),(0,0))]

subdivide :: Sierpinski -> Sierpinski
-- ^Break down a sierpinski triangle by one stage
subdivide = concatMap subdivideTri

toString :: (Int,Int) -> Sierpinski -> String
-- ^Pretty-print a sierpinski triangle
toString (w,h) tris = result
  where
    xunit = 1 / fromIntegral w
    yunit = 1 / fromIntegral h
    xs = map (\i -> fromIntegral i * xunit - (xunit / 2)) [1..w]
    ys = map (\i -> fromIntegral i * yunit - (yunit / 2)) [1..h]
    result = unlines $ reverse $ map (\y -> map (\x -> if any (contains (x,y)) tris then '1' else '_') xs) ys

main = interact $ toString (63,32) . (!!) (iterate subdivide initial) . read