diff --git a/posts/number-number/2/index.qmd b/posts/number-number/2/index.qmd index 462f227..9943089 100644 --- 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 ``` - -Using the Stern-Brocot enumeration ~~because I like it better~~ ```{haskell} transform :: [[Int]] -> [[Int]]