From b60bb688dd00062c325277616d7fd865b4647003 Mon Sep 17 00:00:00 2001 From: queue-miscreant Date: Wed, 30 Jul 2025 03:27:50 -0500 Subject: [PATCH] revisions and haskellification to number-number.1 --- posts/number-number/1/MplIHaskell.hs | 46 +++++ posts/number-number/1/index.qmd | 259 +++++++++++++++++---------- posts/number-number/2/index.qmd | 10 +- 3 files changed, 207 insertions(+), 108 deletions(-) create mode 100644 posts/number-number/1/MplIHaskell.hs diff --git a/posts/number-number/1/MplIHaskell.hs b/posts/number-number/1/MplIHaskell.hs new file mode 100644 index 0000000..1d891e6 --- /dev/null +++ b/posts/number-number/1/MplIHaskell.hs @@ -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] diff --git a/posts/number-number/1/index.qmd b/posts/number-number/1/index.qmd index 8fe5032..c6c0a7a 100644 --- a/posts/number-number/1/index.qmd +++ b/posts/number-number/1/index.qmd @@ -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: - -::: {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 - -::: {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. - -::: {#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
-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).*** diff --git a/posts/number-number/2/index.qmd b/posts/number-number/2/index.qmd index 0b0569f..46510bd 100644 --- a/posts/number-number/2/index.qmd +++ b/posts/number-number/2/index.qmd @@ -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" ```