September 2017 Update

Task/Sierpinski-triangle/Haskell/sierpinski-triangle-2.hs

@@ -1,9 +1,13 @@
-import Data.Bits ((.&.))
+import Data.List (intercalate)
 
-sierpinski n = map row [m, m-1 .. 0] where
-	m = 2^n - 1
-	row y = replicate y ' ' ++ concatMap cell [0..m - y] where
-		cell x	| y .&. x == 0 = " *"
-			| otherwise = "  "
+sierpinski :: Int -> [String]
+sierpinski 0 = ["▲"]
+sierpinski n =
+  concat $
+  (<$> sierpinski (n - 1)) <$>                  -- Previous triangle,
+  [ flip intercalate ([replicate (2 ^ (n - 1))] <*> " -") -- centred,
+  , (++) <*> ('+' :)               -- above singly spaced duplicates.
+  ]
 
+main :: IO ()
 main = mapM_ putStrLn $ sierpinski 4

Task/Sierpinski-triangle/Haskell/sierpinski-triangle-3.hs

@@ -1,16 +1,9 @@
-import Data.List (intersperse)
+import Data.Bits ((.&.))
 
-sierpinski :: Int -> String
-sierpinski n = let
+sierpinski n = map row [m, m-1 .. 0] where
+	m = 2^n - 1
+	row y = replicate y ' ' ++ concatMap cell [0..m - y] where
+		cell x	| y .&. x == 0 = " *"
+			| otherwise = "  "
 
-    -- Top down, each row after the first is an XOR rewrite
-    rule90 n = (scanl next ['*'] [1..n-1]) where
-        next line _ = zipWith xor (" " ++ line) (line ++ " ")
-        xor l r | l == r = ' ' | otherwise = '*'
-
-    -- Bottom up, each line above the base is indented 1 more space
-    in fst (foldr spacing ("", "") (rule90 (2^n))) where
-        spacing x (s, w) =
-            (concat [w, intersperse ' ' x, "\n", s], w ++ " ")
-
-main = putStr $ sierpinski 4
+main = mapM_ putStrLn $ sierpinski 4

Task/Sierpinski-triangle/Haskell/sierpinski-triangle-4.hs

@@ -0,0 +1,17 @@
+import Data.List (intersperse)
+
+-- Top down, each row after the first is an XOR / Rule90 rewrite.
+-- Bottom up, each line above the base is indented 1 more space.
+sierpinski :: Int -> String
+sierpinski = fst . foldr spacing ([], []) . rule90 . (2 ^)
+  where
+    rule90 = scanl next "*" . enumFromTo 1 . subtract 1
+      where
+        next = const . ((zipWith xor . (' ' :)) <*> (++ " "))
+        xor l r
+          | l == r = ' '
+          | otherwise = '*'
+    spacing x (s, w) = (concat [w, intersperse ' ' x, "\n", s], w ++ " ")
+
+main :: IO ()
+main = putStr $ sierpinski 4