Initial data commit

Task/Cantor-set/Haskell/cantor-set-1.hs

@@ -0,0 +1,27 @@
+-------------------------- CANTOR ------------------------
+
+cantor :: [(Bool, Int)] -> [(Bool, Int)]
+cantor = concatMap go
+  where
+    go (bln, n)
+      | bln && 1 < n =
+          let m = quot n 3
+           in [(True, m), (False, m), (True, m)]
+      | otherwise = [(bln, n)]
+
+--------------------------- TEST -------------------------
+main :: IO ()
+main = putStrLn $ cantorLines 5
+
+------------------------- DISPLAY ------------------------
+cantorLines :: Int -> String
+cantorLines n =
+  unlines $
+    showCantor
+      <$> take n (iterate cantor [(True, 3 ^ pred n)])
+
+showCantor :: [(Bool, Int)] -> String
+showCantor = concatMap $ uncurry (flip replicate . c)
+  where
+    c True = '*'
+    c False = ' '

Task/Cantor-set/Haskell/cantor-set-2.hs

@@ -0,0 +1,30 @@
+-------------------------- CANTOR ------------------------
+
+cantor :: [String] -> [String]
+cantor = (go =<<)
+  where
+    go x
+      | '█' == head x = [block, replicate m ' ', block]
+      | otherwise = [x]
+      where
+        m = quot (length x) 3
+        block = take m x
+
+
+--------------------------- TEST -------------------------
+main :: IO ()
+main = putStrLn $ cantorLines 5
+
+
+------------------------- DISPLAY ------------------------
+cantorLines :: Int -> String
+cantorLines =
+  unlines . (concat <$>)
+    . ( take
+          <*> ( iterate cantor
+                  . return
+                  . flip replicate '█'
+                  . (3 ^)
+                  . pred
+              )
+      )

Task/Cantor-set/Haskell/cantor-set-3.hs

@@ -0,0 +1,59 @@
+import Control.Monad (join)
+import Data.Bifunctor (bimap)
+import Data.List (intercalate, mapAccumL, maximumBy)
+import Data.Ratio (Ratio, denominator, numerator, (%))
+
+-------------------------- CANTOR ------------------------
+
+cantor :: (Rational, Rational) -> [[(Rational, Rational)]]
+cantor = iterate (go =<<) . pure
+  where
+    go (x, y) = [(x, x + r), (y - r, y)]
+      where
+        r = (y - x) / 3
+
+--------------------------- TEST -------------------------
+
+main :: IO ()
+main =
+  ( ( (>>)
+        . putStrLn
+        . unlines
+        . fmap intervalRatios
+    )
+      <*> (putStrLn . intervalBars)
+  )
+    $ take 4 $ cantor (0, 1)
+
+------------------------- DISPLAY ------------------------
+
+intervalBars :: [[(Rational, Rational)]] -> String
+intervalBars xs = unlines $ go (d % 1) <$> xs
+  where
+    d = maximum $ denominator . fst <$> last xs
+    go w xs =
+      concat . snd $
+        mapAccumL
+          ( \a (rx, ry) ->
+              let (wy, wx) = (w * ry, w * rx)
+               in ( wy,
+                    replicate (floor (wx - a)) ' '
+                      <> replicate (floor (wy - wx)) '█'
+                  )
+          )
+          0
+          xs
+
+intervalRatios :: [(Rational, Rational)] -> String
+intervalRatios =
+  ('(' :) . (<> ")")
+    . intercalate ") ("
+    . fmap
+      (uncurry ((<>) . (<> ", ")) . join bimap showRatio)
+
+showRatio :: Rational -> String
+showRatio = ((<>) . show . numerator) <*> (go . denominator)
+  where
+    go x
+      | 1 /= x = '/' : show x
+      | otherwise = []