cube/zenzicubi.co
cube/zenzicubi.co
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

finish haskellification to number-number.2

Browse Source
This commit is contained in:
queue-miscreant 2025-07-29 05:59:53 -05:00
parent fe213401dd
commit 3fe47b2af3
1 changed files with 75 additions and 74 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

147
posts/number-number/2/index.qmd
View File

@ -27,17 +27,27 @@ import Text.Blaze.Colonnade
import qualified Text.Blaze.Html4.Strict as Html import qualified Text.Blaze.Html4.Strict as Html
import qualified Text.Blaze.Html4.Strict.Attributes as Attr import qualified Text.Blaze.Html4.Strict.Attributes as Attr
import Diagonal hiding (displayDiagTable) import Diagonal -- hiding (displayDiagTable)
import Previous import Previous
redSpan = (Html.span Html.! Attr.style (Html.toValue "color: red")) . Html.string redCell = htmlCell . (Html.span Html.! Attr.style (Html.toValue "color: red")) . Html.string
greenSpan = (Html.span Html.! Attr.style (Html.toValue "color: green")) . Html.string greenCell = htmlCell . (Html.span Html.! Attr.style (Html.toValue "color: green")) . Html.string
displayDiagTable ps n = ect $ rmap style diagBox' where displayDiagRows rows = renderCells (stringCell . showCell) [
diagBox' = diagBox n markDiagonal 0 (redCell . show),
ect = encodeCellTable (Attr.class_ $ Html.toValue "") markRows rows (greenCell . showCell)
-- style the diagonal as red and rows numbered as `ps` as green ]
style = either (stringCell . show) htmlCell . displayRows (redSpan . show) (map (, greenSpan . show) ps)
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] [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. 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) ](../1/binary_expansion_tree.png)
```{haskell} ```{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) -- Extract the left subtree (i.e., the first child subtree)
badDiag diagonalize = let (Node _ (tree:__)) = binFracTree in badDiag diagonalizeLS = let (Node _ (tree:__)) = binFracTree in
diagonalize $ map (tail . uncurry binDiv) $ bfs tree diagonalizeLS $ map binSeqLabelled $ bfs tree
```
buildDiagTable n = (rowsOmega . take n) <*> diagonalize ```{haskell}
--| code-fold: true
--| classes: plain
-- TODO: show fraction -- Helper functions for drawing tables
displayDiagTable [] 7 $ badDiag (buildDiagTable 8) 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 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 --| classes: plain
-- Extract the left subtree (i.e., the first child subtree) -- Extract the left subtree (i.e., the first child subtree)
sbDiag diagonalize = let (Node _ (tree:__)) = sternBrocot in sbDiag diagonalizeLS = let (Node _ (tree:__)) = sternBrocot in
diagonalize $ map (tail . uncurry binDiv) $ bfs tree diagonalizeLS $ map binSeqLabelled $ bfs tree
-- TODO: show fraction renderDiagTable sbDiag 8
displayDiagTable [] 7 $ sbDiag (buildDiagTable 8)
``` ```
When expressed as a decimal, the new sequence corresponds to the value 0.12059395276... . 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 --| classes: plain
-- Only focus on the rationals whose denominator is bigger -- Only focus on the rationals whose denominator is bigger
arDiag diagonalize = let rationals01 = filter (uncurry (<)) allRationals in arDiag diagonalizeLS = let rationals01 = filter (uncurry (<)) allRationals in
diagonalize $ map (tail . uncurry binDiv) rationals01 diagonalizeLS $ map binSeqLabelled rationals01
-- TODO: show fraction renderDiagTable arDiag 8
displayDiagTable [] 7 $ arDiag (buildDiagTable 8)
``` ```
This new sequence has a decimal expansion equivalent to 0.24005574958... 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. Then, we re-apply the diagonal argument to obtain a new number.
And so on ad infinitum. And so on ad infinitum.
```python ```{haskell}
#| echo: false --| code-fold: true
#| classes: plain --| classes: plain
--| fig-cap: "Using the Stern-Brocot enumeration ~~because I like it better~~"
diag2 = lambda d, yss: [ transformLS :: [LabelledSeq String Int] -> [LabelledSeq String Int]
[ -- Emit the new diagonal sequence, then recurse with the new sequence
d.get(i - j, lambda x: x)(y) -- prepended to the original enumeration
for j, y in enumerate(ys) transformLS xs = let ds = lsify diagonalize xs in LS "" ds:transformLS (LS "" ds:xs)
]
for i, ys in enumerate(yss)
]
Markdown(tabulate( -- Prepend and append ellipses, then join the reversed transform sequence to the original
[["...", "", *(["..."]*9)]] buildTransformTable labelName m xs = DR Ellipsis [] []:table where
+ zipconcat( table = concat [reverse prepended, mainTable, [DR Ellipsis [] []]]
[ xs' = transformLS xs
[green("-2"), ""], prepended = take m $ zipWith (\(LS l x) n -> DR (RN $ -n) [] x) xs' [1..]
[red("-1"), ""], mainTable = zipWith (\(LS l x) n -> DR (RN n) [(labelName, l)] x) xs [0..]
[0, "1/2"],
[1, "1/3"], -- Render certain diagonals and rows in the same way
[2, "2/3"], displayTransformRows ns = renderCells (stringCell . showCell) $ ns >>= formatDiag where
[3, "1/4"], formatDiag (n, f) = [
[4, "2/5"], markDiagonal n (f . show),
[5, "3/5"], markRows [RN $ n-1] (f . showCell)
[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, -- Render diagonal 0 (row -1) as red and diagonal -1 (row -2) as green
), renderTransformTable n = renderTable
headers=["*n*", "Number", *range(8), "..."], (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} ```{haskell}
transform :: [[Int]] -> [[Int]] transform :: [[Int]] -> [[Int]]