fork download
copy 
  1.  
  2. type Triangle = (Int, Int, Int)
  3. type Segment = (Int, Int, Int)
  4.  
  5. startTriangle :: Triangle
  6. startTriangle = (1, 32, 32)
  7.  
  8. splitOneTriangle :: Triangle -> [Triangle]
  9. splitOneTriangle (row, column, height) = 
  10.   [ (row, column, halfHeight)
  11.   , (row + halfHeight, column - halfHeight, halfHeight)
  12.   , (row + halfHeight, column + halfHeight, halfHeight)
  13.   ]
  14.   where halfHeight = height `div` 2
  15.  
  16. splitTriangles :: [Triangle] -> [Triangle]
  17. splitTriangles ts = ts >>= splitOneTriangle
  18.  
  19. triangleSegments :: Triangle -> [Segment]
  20. triangleSegments (row, column, height) =
  21.   [(row + i, column - i, column + i) | i <- [0 .. height - 1]]
  22.  
  23. inSegment :: (Int, Int) -> Segment -> Bool
  24. inSegment (cellRow, cellColumn) (segmentRow, leftSegmentColumn, rightSegmentColumn) =
  25.   segmentRow == cellRow && 
  26.   leftSegmentColumn <= cellColumn && 
  27.   cellColumn <= rightSegmentColumn
  28.  
  29. inTriangle :: (Int, Int) -> Triangle -> Bool
  30. inTriangle cell triangle = 
  31.   not $ null $ filter (inSegment cell) $ triangleSegments triangle
  32.  
  33. inAnyTriangle :: (Int, Int) -> [Triangle] -> Bool
  34. inAnyTriangle cell triangles = any (inTriangle cell) triangles
  35.  
  36. getCellChar :: (Int, Int) -> [Triangle] -> Char
  37. getCellChar cell triangles
  38.   | inAnyTriangle cell triangles = '1'
  39.   | otherwise                    = '_'
  40.  
  41. renderSierpinski :: Int -> String
  42. renderSierpinski n = unlines $ map (\row -> [getCellChar (row, column) triangles | column <- [1 .. 63]]) [1 .. 32]
  43.   where triangles = head $ drop n $ iterate splitTriangles [startTriangle]
  44.  
  45. main = interact $ renderSierpinski . read
  46.  
Success #stdin #stdout 0.01s 4772KB
comments (?)
stdin
copy 
3
stdout
copy 
_______________________________1_______________________________
______________________________111______________________________
_____________________________11111_____________________________
____________________________1111111____________________________
___________________________1_______1___________________________
__________________________111_____111__________________________
_________________________11111___11111_________________________
________________________1111111_1111111________________________
_______________________1_______________1_______________________
______________________111_____________111______________________
_____________________11111___________11111_____________________
____________________1111111_________1111111____________________
___________________1_______1_______1_______1___________________
__________________111_____111_____111_____111__________________
_________________11111___11111___11111___11111_________________
________________1111111_1111111_1111111_1111111________________
_______________1_______________________________1_______________
______________111_____________________________111______________
_____________11111___________________________11111_____________
____________1111111_________________________1111111____________
___________1_______1_______________________1_______1___________
__________111_____111_____________________111_____111__________
_________11111___11111___________________11111___11111_________
________1111111_1111111_________________1111111_1111111________
_______1_______________1_______________1_______________1_______
______111_____________111_____________111_____________111______
_____11111___________11111___________11111___________11111_____
____1111111_________1111111_________1111111_________1111111____
___1_______1_______1_______1_______1_______1_______1_______1___
__111_____111_____111_____111_____111_____111_____111_____111__
_11111___11111___11111___11111___11111___11111___11111___11111_
1111111_1111111_1111111_1111111_1111111_1111111_1111111_1111111
https://ideone.com/3BwUZD
language:
Haskell (ghc 8.4.4)
created:
8 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!