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

revisions and haskellification to number-number.1

Browse Source
This commit is contained in:
queue-miscreant 2025-07-30 03:27:50 -05:00
parent 6bbcf0cfcc
commit b60bb688dd
3 changed files with 207 additions and 108 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
posts/number-number/1/MplIHaskell.hs Normal file
View File

@ -0,0 +1,46 @@
-- Implementation from
-- https://github.com/IHaskell/IHaskell/blob/master/ihaskell-display/ihaskell-matplotlib/IHaskell/Display/Matplotlib.hs
module MplIHaskell where
import qualified Data.ByteString.Char8 as Char
import qualified Data.ByteString.UTF8 as BSU
import qualified Data.Text.Encoding as T.Encoding
import System.IO.Temp
import System.FilePath ((</>))
import Graphics.Matplotlib
import IHaskell.Display
instance IHaskellDisplay Matplotlib where
display = graphDataDisplayBoth
-- Width and height
w, h :: Int
w = 300
h = 300
graphDataPNG :: Matplotlib -> IO DisplayData
graphDataPNG m = do
withSystemTempDirectory "ihaskell-matplotlib" $ \tmpdir -> do
let path = tmpdir </> "ihaskell-matplotlib.png"
-- Write the image.
res <- file path m
case res of
Left _ -> error "Matplotlib could not generate an immage"
Right _ -> do
-- Read back, and convert to base64.
imgData <- Char.readFile path
return $ png w h $ base64 imgData
graphDataSVG :: Matplotlib -> IO DisplayData
graphDataSVG m = do
res <- toSvg m
case res of
Left s -> error s
Right f -> return $ svg $ T.Encoding.decodeUtf8 $ BSU.fromString f
graphDataDisplayBoth :: Matplotlib -> IO Display
graphDataDisplayBoth fig = do
pngDisp <- graphDataPNG fig
svgDisp <- graphDataSVG fig
return $ Display [pngDisp, svgDisp]

259
posts/number-number/1/index.qmd
View File

@ -13,6 +13,25 @@ categories:
- haskell
---
```{haskell}
--| echo: false
:l MplIHaskell
import Data.Tree
import Data.Profunctor
import Colonnade
import qualified Graphics.Matplotlib as MPL
import IHaskell.Display.Blaze
import Text.Blaze.Colonnade
import qualified Text.Blaze.Html4.Strict as Html
import qualified Text.Blaze.Html4.Strict.Attributes as Attr
import qualified MplIHaskell
renderTable = encodeCellTable (Attr.class_ $ Html.toValue "")
```
The infinite is replete with paradoxes.
Some of the best come from comparing sizes of infinite collections.
@ -35,13 +54,13 @@ All even numbers are "hit" by this map (by the definition of an even number),
(again, more or less by definition, since $2m = 2n$ implies that $m = n$ over $\N$).
Therefore, the map is [one-to-one](https://en.wikipedia.org/wiki/Injective_function)
and [onto](https://en.wikipedia.org/wiki/Surjective_function),
and the map is a [bijection](https://en.wikipedia.org/wiki/Bijection).
so the map is a [bijection](https://en.wikipedia.org/wiki/Bijection).
A consequence is that the map has an inverse, namely by reversing all of the arrows in the above block
(i.e., the action of halving an even number).
Bijections with the natural numbers are easier to understand as a way to place things
into a linear sequence.
In other words, they enumerate some "sort" of item; in this case, even numbers.
In other words, they enumerate "some sort of item"; in this case, even numbers.
In the finite world, a bijection between two things implies that they have the same size.
It makes sense to extend the same logic to the infinite world, but there's a catch.
@ -81,8 +100,8 @@ Are we Positive?
The confusion continues if we look at the integers and the naturals.
Integers are the natural numbers and their negatives, so it would be intuitive to assume that
there are twice as many of them as there are naturals (more or less one to account for zero).
But that logic fails for the naturals and the even numbers, and indeed,
it fails for the integers and the naturals as well.
But since that logic fails for the naturals and the even numbers,
it fails for the naturals and integers as well.
$$
\begin{gather*}
@ -102,9 +121,12 @@ $$
\end{gather*}
$$
Or, in Haskell (if you cover your eyes and pretend that the `undefined` below will never happen):
Or, in Haskell[^1]:
```{.haskell}
[^1]: That is, if you cover your eyes and pretend that `undefined` will never happen,
and if you ignore that `Int` is bounded, unlike `Integer`.
```{haskell}
type Nat = Int
listIntegers :: Nat -> Int
@ -141,13 +163,13 @@ $$
\end{gather*}
$$
```{.haskell}
```{haskell}
intEqual :: (Nat, Nat) -> (Nat, Nat) -> Bool
intEqual (a, b) (c, d) = a + d == b + c
```
This relation is the same as saying $a - b = c - d$ (i.e., that -1 = 0 - 1, etc.),
but has the benefit of not needing to define subtraction first.
but has the benefit of not requiring subtraction to be defined.
This is all the better, since, as grade-schoolers are taught, subtracting a larger natural number
from a smaller one is impossible.
@ -167,7 +189,7 @@ $$
\end{gather*}
$$
```{.haskell}
```{haskell}
ratEqual :: (Nat, Nat) -> (Nat, Nat) -> Bool
ratEqual (a, b) (c, d) = a * d == b * c
```
@ -182,33 +204,35 @@ Effectively, this just replaces where addition appears in the integer equivalenc
Naively, to tackle both of these cases, we might consider enumerating pairs of natural numbers.
We order them by sums and break ties by sorting on the first index.
| Index | Pair (*a*, *b*) | Sum (*a* + *b*) | Integer (*a* - *b*) | Rational (*a*+1 / *b*+1) |
|-------|-----------------|-----------------|---------------------|--------------------------|
| 0 | (0, 0) | 0 | 0 | 1/1 |
| 1 | (0, 1) | 1 | -1 | 1/2 |
| 2 | (1, 0) | 1 | 1 | 2/1 |
| 3 | (0, 2) | 2 | -2 | 1/3 |
| 4 | (1, 1) | 2 | 0 | 2/2 = 1/1 |
| 5 | (2, 0) | 2 | 2 | 3/1 |
| 6 | (0, 3) | 3 | -3 | 1/4 |
| 7 | (1, 2) | 3 | -1 | 2/3 |
| 8 | (2, 1) | 3 | 1 | 3/2 |
| 9 | (3, 0) | 3 | 3 | 4/1 |
| ... | ... | ... | ... | ... |
```{.haskell}
```{haskell}
-- All pairs of natural numbers that sum to n
listPairs :: Nat -> [(Nat, Nat)]
listPairs n = [ (k, n - k) | k <- [0..n] ]
-- Use a natural number to index the enumeration of all pairs
-- "Triangular" enumeration of all pairs of positive integers
allPairs :: [(Nat, Nat)]
allPairs = concat $ map listPairs [0..]
allPairs = concatMap listPairs [0..]
-- Use a natural number to index the enumeration of all pairs
allPairsMap :: Nat -> (Nat, Nat)
allPairsMap n = allPairs !! n
```
```{haskell}
--|code-fold: true
--|classes: plain
pairEnumeration = columns (\(_, f) v -> f v) (\(l, _) -> Headed l) [
("Index", show . fst),
("Pair (a, b)", show . snd),
("Sum (a + b)", show . uncurry (+) . snd),
("Integer (a - b)", show . uncurry (-) . snd),
("Rational (a+1 / b+1)", (\(a, b) -> show (a + 1) ++ "/" ++ show (b + 1)) . snd)
]
renderTable (rmap stringCell pairEnumeration) $ take 10 $ zip [0..] allPairs
```
This certainly works to show that naturals and pairs of naturals can be put into bijection,
but it when interpreting the results as integers or rationals, we double-count several of them.
This is easy to see in the case of the integers, but it will also happen in the rationals.
@ -219,9 +243,9 @@ This function eliminates duplicates according to another function of our choosin
We can also just implement it ourselves and use it to create a naive enumeration of integers and rationals,
based on the equalities defined earlier:
```{.haskell}
```{haskell}
nubBy :: (a -> a -> Bool) -> [a] -> [a]
nubBy f xs = nubBy' [] xs where
nubBy f = nubBy' [] where
nubBy' ys [] = []
nubBy' ys (z:zs)
-- Ignore this element, something equivalent is in ys
@ -247,19 +271,26 @@ allRationalsMap n = allRationals !! n
For completeness's sake, the resulting pairs of each map are as follows
| *n* | `allIntegersMap n` | `allRationalsMap n` |
|-----|--------------------|---------------------|
| 0 | (0, 0) = 0 | (1, 1) = 1 |
| 1 | (0, 1) = -1 | (1, 2) = 1/2 |
| 2 | (1, 0) = 1 | (2, 1) = 2/1 |
| 3 | (0, 2) = -2 | (1, 3) = 1/3 |
| 4 | (2, 0) = 2 | (3, 1) = 3/1 |
| 5 | (0, 3) = -3 | (1, 4) = 1/4 |
| 6 | (3, 0) = 3 | (2, 3) = 2/3 |
| 7 | (0, 4) = -4 | (3, 2) = 3/2 |
| 8 | (4, 0) = 4 | (4, 1) = 4/1 |
| 9 | (0, 5) = -5 | (1, 5) = 1/5 |
| ... | ... | ... |
```{haskell}
--|code-fold: true
--|classes: plain
codeCell = htmlCell . Html.code . Html.string
showAsInteger p@(a,b) = show p ++ " = " ++ show (a - b)
showAsRational' p@(a,b) = show a ++ "/" ++ show b
showAsRational p@(a,b) = show p ++ " = " ++ showAsRational' p
mapEnumeration = columns (\(_, f) v -> f v) (\(l, _) -> Headed l) [
(stringCell "n", stringCell . show),
(codeCell "allIntegersMap n",
stringCell . showAsInteger . allIntegersMap),
(codeCell "allRationalsMap n",
stringCell . showAsRational . allRationalsMap)
]
renderTable mapEnumeration [0..9]
```
Note that the tuples produced by `allIntegers`, when interpreted as integers, happen to coincide
with the earlier enumeration given by `listIntegers`.
@ -352,21 +383,21 @@ We can implement this in Haskell using `Data.Tree`.
This package actually lets you describe trees with any number of child nodes,
but we only need two for the sake of the Stern-Brocot tree.
```{.haskell}
```{haskell}
import Data.Tree
-- Make a tree by applying the function `make` to each node
-- Start with the root value (1, 1), along with
-- its left and right steps, (0, 1) and (1, 0)
sternBrocot = unfoldTree make $ ((1,1), (0,1), (1,0)) where
sternBrocot = unfoldTree make ((1,1), (0,1), (1,0)) where
-- Place the first value in the tree, then describe the next
-- values for `make` in a list:
make (v@(vn, vd), l@(ln, ld), r@(rn, rd))
= (v, [
-- the left value, and its left (unchanged) and right steps...
(((ln + vn), (ld + vd)), l, v),
((ln + vn, ld + vd), l, v),
-- and the right value, and its left and right (unchanged) steps
(((vn + rn), (vd + rd)), v, r)
((vn + rn, vd + rd), v, r)
])
```
@ -377,7 +408,9 @@ We're halfway there. All that remains is to read off every value in the tree as
Perhaps the most naive way would be to read off by always following the left or right child.
Unfortunately, these give some fairly dull sequences.
```{.haskell}
```{haskell}
--| layout-ncol: 2
treePath :: [Int] -> Tree a -> [a]
treePath xs (Node y ys)
-- If we don't have any directions (xs), or the node
@ -388,14 +421,12 @@ treePath xs (Node y ys)
| otherwise = y:treePath (tail xs) (ys !! head xs)
-- Always go left (child 0)
alwaysLeft = treePath (repeat 0) sternBrocot
-- = [(1,1),(1,2),(1,3),(1,4),(1,5),(1,6),(1,7),(1,8),(1,9),(1,10),...]
-- i.e., numbers with numerator 1
mapM_ print $ take 10 $ treePath (repeat 0) sternBrocot
-- Always go right (child 1)
alwaysRight = treePath (repeat 1) sternBrocot
-- = [(1,1),(2,1),(3,1),(4,1),(5,1),(6,1),(7,1),(8,1),(9,1),(10,1),...]
-- i.e., numbers with denominator 1
mapM_ print $ take 10 $ treePath (repeat 1) sternBrocot
```
Rather than by following paths in the tree, we can instead do a breadth-first search.
@ -424,7 +455,7 @@ The enumeration could just as easily start from 0 by starting with $\N$,
We can also write a breadth-first search in Haskell, for posterity:
```{.haskell}
```{haskell}
bfs :: Tree a -> [a]
bfs (Node root children) = bfs' root children where
-- Place the current node in the list
@ -434,6 +465,8 @@ bfs (Node root children) = bfs' root children where
bfs' v ((Node y ys):xs) = v:bfs' y (xs ++ ys)
sternBrocotRationals = bfs sternBrocot
mapM_ putStrLn $ take 10 $ map showAsRational sternBrocotRationals
```
The entries in this enumeration have already been given.
@ -457,9 +490,9 @@ In terms of adding and subtracting, we just use 1/4 instead of 1/2.
We can describe this easily in Haskell:
```{.haskell}
```{haskell}
-- Start with 1/1 (i.e., (1, 1))
binFracTree = unfoldTree make $ (1,1) where
binFracTree = unfoldTree make (1,1) where
-- Place the first value in the tree, then describe the next
-- values for `make` in a list:
make v@(vn, vd)
@ -489,7 +522,7 @@ The tree of binary fractions and the Stern-Brocot tree are both infinite binary
In Haskell, we can pair up entries recursively:
```{.haskell}
```{haskell}
zipTree :: Tree a -> Tree b -> Tree (a,b)
-- Pair the values in the nodes together, then recurse with the child trees
zipTree (Node x xs) (Node y ys) = Node (x,y) $ zipWith zipTree xs ys
@ -503,16 +536,27 @@ Doing so establishes a bijection between the rationals and the binary rationals
Rationals are more continuous than integers, so it might be of some curiosity to plot this function.
We only have to look at a square over the unit interval. Doing so reveals a curious shape:
<!-- TODO: get haskell matplotlib working -->
::: {layout-ncol = "2"}
![
Binary rationals on the x-axis, rationals on the y-axis
](./left_subtree_inverse.png)
```{haskell}
--| code-fold: true
--| layout-ncol: 2
--| fig-cap:
--| - "Binary rationals on the x-axis, rationals on the y-axis"
--| - "Rationals on the x-axis, binary rationals on the y-axis"
![
Rationals on the x-axis, binary rationals on the y-axis
](./left_subtree.png)
:::
import Data.Tuple (swap)
import Data.List (sort)
import Data.Bifunctor (bimap, first)
leftSubtree (Node _ (x:_)) = x
-- Divide entries of the (zipped) trees
(</>) (a,b) = fromIntegral a / fromIntegral b :: Double
binarySBDoubles n = take n $ map (bimap (</>) (</>)) $ bfs $ leftSubtree binarySBTree
(MPL.tightLayout <>) $ uncurry MPL.plot $ unzip $ sort $ map swap $ binarySBDoubles 250
(MPL.tightLayout <>) $ uncurry MPL.plot $ unzip $ sort $ binarySBDoubles 250
```
The plot on the right which maps the rationals to the binary rationals is known as
[Minkowski's question mark function](https://en.wikipedia.org/wiki/Minkowski%27s_question-mark_function).
@ -547,36 +591,49 @@ We can persevere if we continue to interpret the binary strings as a path in the
This means that for 1/3, we go left initially, then alternate between going left and right.
As we do so, let's take note of the values we pass along the way:
```{.haskell}
-- Follow the path described by the expansion of 1/3
treePath (0:cycle [0,1]) $ zipTree sternBrocot binFracTree
```{haskell}
-- Follow the path described by the binary expansion of 1/3
oneThirdPath = treePath (0:cycle [0,1]) $ zipTree sternBrocot binFracTree
```
| | Binary fraction | Binary fraction (decimal) | Stern-Brocot rational | Stern-Brocot rational (decimal)
|-----|-------------------|---------------------------|-----------------------|--------------------------------|
| 0 | 1/1 | 1 | 1/1 | 1 |
| 1 | 1/2 | 0.5 | 1/2 | 1/2 |
| 2 | 1/4 | 0.25 | 1/3 | 0.3333333... |
| 3 | 3/8 | 0.375 | 2/5 | 0.4 |
| 4 | 5/16 | 0.3125 | 3/8 | 0.375 |
| 5 | 11/32 | 0.34375 | 5/13 | 0.38461538... |
| 6 | 21/64 | 0.328125 | 8/21 | 0.32812538... |
| 7 | 43/128 | 0.3359375 | 13/34 | 0.3823529... |
| 8 | 85/256 | 0.33203125 | 21/55 | 0.38181818... |
| ⋮ | ⋮ | ⋮ | ⋮ | ⋮ |
| 100 | (too big to show) | 0.3333333333... | (too big to show) | 0.381966011... |
| ⋮ | ⋮ | ⋮ | ⋮ | ⋮ |
```{haskell}
--| code-fold: true
--| classes: plain
<!-- TODO: get haskell matplotlib working -->
::: {layout-ncol = "2"}
![
Binary convergents of 1/3
](./one_third_binary_convergents.png)
trimTo n x = if length x > n then "(too big to show)" else x
![
¿ applied to binary convergents of 1/3, which also appear to converge
](./inverse_one_third_binary_convergents.png)
:::
treePathColumns = columns (\(_, f) v -> f v) (\(l, _) -> Headed l) [
(stringCell "n",
stringCell . fromEither . fmap show),
(stringCell "Binary fraction",
stringCell . fromEither . fmap (trimTo 10 . showAsRational' . snd . (oneThirdPath !!))),
(stringCell "Binary fraction (decimal)",
stringCell . fromEither . fmap (show . (</>) . snd . (oneThirdPath !!))),
(stringCell "Stern-Brocot rational",
stringCell . fromEither . fmap (trimTo 10 . showAsRational' . fst . (oneThirdPath !!))),
(stringCell "Stern-Brocot rational (decimal)",
stringCell . fromEither . fmap (show . (</>) . fst . (oneThirdPath !!)))
] where
fromEither = either id id
renderTable treePathColumns (map Right [0..8] ++ [Left "...", Right 100, Left "..."])
```
```{haskell}
--| code-fold: true
--| layout-ncol: 2
--| fig-cap:
--| - "Binary convergents of 1/3"
--| - "¿ applied to binary convergents of 1/3, which also appear to converge"
convergentsOneThird = map ((</>) . snd) oneThirdPath
convergentsSBNumber = map ((</>) . fst) oneThirdPath
plotSequence n = uncurry MPL.plot . unzip . take n . zip ([0..] :: [Int])
(MPL.tightLayout <>) $ plotSequence 20 convergentsOneThird
(MPL.tightLayout <>) $ plotSequence 20 convergentsSBNumber
```
Both sequences appear to converge to a number, with the binary fractions obviously converging to 1/3.
The rationals from the Stern-Brocot don't appear to be converging to a repeating decimal.
@ -605,16 +662,22 @@ According to Wikipedia's definition, the question mark function is quasi-periodi
On the other hand, according to the definition by pairing up the two trees,
rationals greater than 1 get mapped to binary fractions between 1 and 2.
<!-- TODO: get haskell matplotlib working -->
::: {#fig-question-mark-linlog layout = "[[1,1], [1]]"}
![](./question_mark_linear.png)
```{haskell}
--| code-fold: true
--| layout-ncol: 2
--| label: "fig-question-mark-linlog"
--| fig-cap: "Question mark function including right subtree"
--| fig-subcap:
--| - "linear x-axis"
--| - "(base 2)-logarithmic x-axis"
![](./question_mark_logarithmic.png)
binarySBDoublesAll n = take n $ map (bimap (</>) (</>)) $ bfs binarySBTree
Question mark function including right subtree <br>
Left: linear x-axis.
Right: (base 2)-logarithmic x-axis.
:::
(MPL.tightLayout <>) $ uncurry MPL.plot $
unzip $ sort $ binarySBDoublesAll 250
(MPL.tightLayout <>) $ uncurry MPL.plot $
unzip $ map (first log) $ sort $ binarySBDoublesAll 250
```
Here are graphs describing *our* question mark function, on linear and logarithmic plots.
Instead of repeating, the function continues its self-similar behavior
@ -653,5 +716,3 @@ I may return to some of these topics in the future, such as to show a way to ord
Diagrams created with GeoGebra (because trying to render them in LaTeX would have taken too long)
and Matplotlib.
***Note: changes to this post are currently pending on being able to use Matplotlib in Haskell (without helper scripts).***

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

@ -19,8 +19,8 @@ categories:
:l Previous
import Data.Tree
import Data.Profunctor
import IHaskell.Display.Blaze
import Text.Blaze.Colonnade
import qualified Text.Blaze.Html4.Strict as Html
@ -39,14 +39,6 @@ displayDiagRows rows = renderCells (stringCell . 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"
```