finish haskellification to number-number.2

2025-07-29 05:59:53 -05:00 · 2025-07-29 05:59:53 -05:00 · 3fe47b2af3
commit 3fe47b2af3
parent fe213401dd
1 changed files with 75 additions and 74 deletions
--- a/posts/number-number/2/index.qmd
+++ b/posts/number-number/2/index.qmd
@ -27,17 +27,27 @@ import Text.Blaze.Colonnade
 import qualified Text.Blaze.Html4.Strict as Html
 import qualified Text.Blaze.Html4.Strict.Attributes as Attr

-import Diagonal hiding (displayDiagTable)
+import Diagonal -- hiding (displayDiagTable)
 import Previous

-redSpan = (Html.span Html.! Attr.style (Html.toValue "color: red")) . Html.string
-greenSpan = (Html.span Html.! Attr.style (Html.toValue "color: green")) . Html.string
+redCell = htmlCell . (Html.span Html.! Attr.style (Html.toValue "color: red")) . Html.string
+greenCell = htmlCell . (Html.span Html.! Attr.style (Html.toValue "color: green")) . Html.string

-displayDiagTable ps n = ect $ rmap style diagBox' where
-  diagBox' = diagBox n
-  ect      = encodeCellTable (Attr.class_ $ Html.toValue "")
-  -- style the diagonal as red and rows numbered as `ps` as green
-  style    = either (stringCell . show) htmlCell . displayRows (redSpan . show) (map (, greenSpan . show) ps)
+displayDiagRows rows = renderCells (stringCell . showCell) [
+    markDiagonal 0 (redCell . show),
+    markRows rows (greenCell . showCell)
+  ]
+
+
+renderTable = encodeCellTable (Attr.class_ $ Html.toValue "")
+
+-- displayDiagTable ps n = ect $ rmap style diagBox' where
+--   diagBox' = diagBox n
+--   ect      = encodeCellTable (Attr.class_ $ Html.toValue "")
+--   -- style the diagonal as red and rows numbered as `ps` as green
+--   style    = either (stringCell . show) htmlCell . displayRows (redSpan . show) (map (, greenSpan . show) ps)
+
+displayDiagTable ps n _ = putStrLn "TODO"
 ```


@ -128,7 +138,8 @@ diagData = rowsOmega [
  ]
  [2, 3, 9, 4, 0, 0]

-displayDiagTable [Just Omega, Just $ RN 3] 5 diagData
+renderTable (displayDiagRows [Omega, RN 3]
+  (numberColumn <> diagBox' 5 <> ellipsisColumn)) diagData
 ```

 In the above table, sequence 3 is assumed to continue with 9's forever.
@ -242,16 +253,30 @@ Using the tree of binary fractions from the last post, we use a breadth-first se
 ](../1/binary_expansion_tree.png)

 ```{haskell}
--| classes: plain
+-- Data class for a labelled sequence
+data LabelledSeq a b = LS a [b] deriving Functor
+-- Create a labelled binary sequence by dividing n into d and tagging it with "n/d"
+binSeqLabelled (n, d) = LS (show n ++ "/" ++ show d) (tail $ binDiv n d)
+-- Build a new diagonalize function to work over labelled sequences
+lsify diagonalize = diagonalize . map (\(LS _ y) -> y)

 -- Extract the left subtree (i.e., the first child subtree)
-badDiag diagonalize = let (Node _ (tree:__)) = binFracTree in
-          diagonalize $ map (tail . uncurry binDiv) $ bfs tree
+badDiag diagonalizeLS = let (Node _ (tree:__)) = binFracTree in
+          diagonalizeLS $ map binSeqLabelled $ bfs tree
+```

-buildDiagTable n = (rowsOmega . take n) <*> diagonalize
+```{haskell}
+--| code-fold: true
+--| classes: plain

-- TODO: show fraction
-displayDiagTable [] 7 $ badDiag (buildDiagTable 8)
+-- Helper functions for drawing tables
+buildDiagTable m = (rowsOmegaLabelled "Fraction" . take m . map (\(LS s y) -> (s, y))) <*> lsify diagonalize
+renderDiagTable diagf n = renderTable
+  (displayDiagRows []
+    (numberColumn <> labelColumn "Fraction" <> diagBox' (n - 1) <> ellipsisColumn)) $
+  diagf (buildDiagTable n)
+
+renderDiagTable badDiag 8
 ```

 Computing the diagonal sequence, it quickly becomes apparent that we're going
@ -281,11 +306,10 @@ We end up with the following enumeration:
 --| classes: plain

 -- Extract the left subtree (i.e., the first child subtree)
-sbDiag diagonalize = let (Node _ (tree:__)) = sternBrocot in
-          diagonalize $ map (tail . uncurry binDiv) $ bfs tree
+sbDiag diagonalizeLS = let (Node _ (tree:__)) = sternBrocot in
+          diagonalizeLS $ map binSeqLabelled $ bfs tree

-- TODO: show fraction
-displayDiagTable [] 7 $ sbDiag (buildDiagTable 8)
+renderDiagTable sbDiag 8
 ```

 When expressed as a decimal, the new sequence corresponds to the value 0.12059395276... .
@ -303,11 +327,10 @@ We'll need to filter out the numbers greater than 1 from this sequence, but that
 --| classes: plain

 -- Only focus on the rationals whose denominator is bigger
-arDiag diagonalize = let rationals01 = filter (uncurry (<)) allRationals in
-         diagonalize $ map (tail . uncurry binDiv) rationals01
+arDiag diagonalizeLS = let rationals01 = filter (uncurry (<)) allRationals in
+         diagonalizeLS $ map binSeqLabelled rationals01

-- TODO: show fraction
-displayDiagTable [] 7 $ arDiag (buildDiagTable 8)
+renderDiagTable arDiag 8
 ```

 This new sequence has a decimal expansion equivalent to 0.24005574958...
@ -323,61 +346,39 @@ This new number can just be tacked onto the beginning of the list.
 Then, we re-apply the diagonal argument to obtain a new number.
 And so on ad infinitum.

-```python
-#| echo: false
-#| classes: plain
+```{haskell}
+--| code-fold: true
+--| classes: plain
+--| fig-cap: "Using the Stern-Brocot enumeration ~~because I like it better~~"

-diag2 = lambda d, yss: [
-  [
-    d.get(i - j, lambda x: x)(y)
-    for j, y in enumerate(ys)
-  ]
-  for i, ys in enumerate(yss)
-]
+transformLS :: [LabelledSeq String Int] -> [LabelledSeq String Int]
+-- Emit the new diagonal sequence, then recurse with the new sequence
+-- prepended to the original enumeration
+transformLS xs = let ds = lsify diagonalize xs in LS "" ds:transformLS (LS "" ds:xs)

-Markdown(tabulate(
-  [["...", "", *(["..."]*9)]]
-  + zipconcat(
-    [
-      [green("-2"), ""],
-      [red("-1"), ""],
-      [0, "1/2"],
-      [1, "1/3"],
-      [2, "2/3"],
-      [3, "1/4"],
-      [4, "2/5"],
-      [5, "3/5"],
-      [6, "3/4"],
-      [7, "1/5"],
-      ["...", "..."],
-    ],
-    diag2(
-      {
-        1: green,
-        2: red,
-      },
-      [
-        [1, 1, 1, 1, 1, 0, 1, 1],
-        [0, 0, 0, 1, 1, 1, 1, 0],
-        [1, 0, 0, 0, 0, 0, 0, 0],
-        [0, 1, 0, 1, 0, 1, 0, 1],
-        [1, 0, 1, 0, 1, 0, 1, 0],
-        [0, 0, 1, 0, 0, 0, 0, 0],
-        [0, 1, 1, 0, 0, 1, 1, 0],
-        [1, 0, 0, 1, 1, 0, 0, 1],
-        [1, 1, 0, 0, 0, 0, 0, 0],
-        [0, 0, 1, 1, 0, 0, 1, 1],
-        ["...", "...", "...", "...", "...", "...", "...", "..."],
-      ]
-    ),
-    [["..."]]*12,
-  ),
-  headers=["*n*", "Number", *range(8), "..."],
-))
+-- Prepend and append ellipses, then join the reversed transform sequence to the original
+buildTransformTable labelName m xs = DR Ellipsis [] []:table where
+  table     = concat [reverse prepended, mainTable, [DR Ellipsis [] []]]
+  xs'       = transformLS xs
+  prepended = take m $ zipWith (\(LS l x) n -> DR (RN $ -n) [] x) xs' [1..]
+  mainTable = zipWith (\(LS l x) n -> DR (RN n) [(labelName, l)] x) xs [0..]
+
+-- Render certain diagonals and rows in the same way
+displayTransformRows ns = renderCells (stringCell . showCell) $ ns >>= formatDiag where
+  formatDiag (n, f) = [
+      markDiagonal n (f . show),
+      markRows [RN $ n-1] (f . showCell)
+    ]
+
+-- Render diagonal 0 (row -1) as red and diagonal -1 (row -2) as green
+renderTransformTable n = renderTable
+  (displayTransformRows [(0, redCell), (-1, greenCell)]
+    (numberColumn <> labelColumn "Fraction" <> diagBox' (n - 1) <> ellipsisColumn)) .
+  buildTransformTable "Fraction" 2
+
+renderTransformTable 8 $ take 8 $ sbDiag id
 ```

-<!-- TODO: caption -->
-Using the Stern-Brocot enumeration ~~because I like it better~~

 ```{haskell}
 transform :: [[Int]] -> [[Int]]