diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,5 @@ +# Revision history for number-wall + +## 0.1.0.0 -- 2022-9-3 + +* First version. Released on an unsuspecting world. diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,20 @@ +Copyright (c) 2022 Owen Bechtel + +Permission is hereby granted, free of charge, to any person obtaining +a copy of this software and associated documentation files (the +"Software"), to deal in the Software without restriction, including +without limitation the rights to use, copy, modify, merge, publish, +distribute, sublicense, and/or sell copies of the Software, and to +permit persons to whom the Software is furnished to do so, subject to +the following conditions: + +The above copyright notice and this permission notice shall be +included in all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,4 @@ +# number-wall +Create number walls and save them as images. + +Documentation is available on [Hackage](https://hackage.haskell.org/package/number-wall). diff --git a/collage.png b/collage.png new file mode 100644 Binary files /dev/null and b/collage.png differ diff --git a/number-wall.cabal b/number-wall.cabal new file mode 100644 --- /dev/null +++ b/number-wall.cabal @@ -0,0 +1,81 @@ +cabal-version: 2.4 +name: number-wall +version: 0.1.0.0 +author: Owen Bechtel +maintainer: ombspring@gmail.com + +category: Math, Algorithms, Graphics, Image +synopsis: Create number walls and save them as images + +description: + A "number wall" is an infinite grid associated to some (bi-directional) sequence. + The "numbers" in the grid are usually either integers, or integers modulo some prime. + Number walls can be defined in terms of determinants, but can also be calculated + using a recursive algorithm. + . + Formally, let \( R \) be an integral domain. The number wall of a sequence + \( S : \mathbb{Z} \to R \) is an infinite grid of numbers \( W \), defined as follows: + . + \[ + W(x, y) = \begin{cases} + 0 & y < -1 \\ + 1 & y = -1 \\ + S(x) & y = 0 \\ + D(x, y) & y > 0 + \end{cases} + \] + . + \[ + D(x, y) = \begin{vmatrix} + S(x) & S(x + 1) & \ldots & S(x + y) \\ + S(x - 1) & S(x) & \ldots & S(x + y - 1) \\ + \vdots & \vdots & \ddots & \vdots \\ + S(x - y) & S(x - y + 1) & \ldots & S(x) + \end{vmatrix} + \] + . + The values in any number wall satisfy the relation + \( W(x, y - 1) W(x, y + 1) + W(x - 1, y) W(x + 1, y) = W(x, y)^2 \), + and some other more complicated relations. You can use these to define a + recursive algorithm for generating number walls. + . + Here are some cool images created using the functions in this package: + . + ![number wall image collage](number-wall/src/collage.png) + . + See [this video](https://www.youtube.com/watch?v=NO1_-qptr6c) for more + information and fun facts. + +homepage: https://github.com/UnaryPlus/number-wall +bug-reports: https://github.com/UnaryPlus/number-wall/issues +license: MIT +license-file: LICENSE +extra-source-files: CHANGELOG.md, README.md, collage.png + +source-repository head + type: git + location: https://github.com/UnaryPlus/lambda.git + +library + hs-source-dirs: src + default-language: Haskell2010 + ghc-options: -W + exposed-modules: NumberWall + + build-depends: + base >= 4.14.1.0 && < 5, + memoize >= 0.2.0 && < 1.2, + mod >= 0.1.1.0 && < 0.2, + semirings >= 0.5.2 && < 0.8, + JuicyPixels >= 3.3 && < 3.4 + +test-suite test + type: exitcode-stdio-1.0 + hs-source-dirs: test + default-language: Haskell2010 + ghc-options: -W + main-is: Main.hs + + build-depends: + base, + number-wall diff --git a/src/NumberWall.hs b/src/NumberWall.hs new file mode 100644 --- /dev/null +++ b/src/NumberWall.hs @@ -0,0 +1,222 @@ +{-| +Module: NumberWall +Copyright: (c) Owen Bechtel, 2022 +License: MIT +-} + +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE ConstraintKinds #-} +module NumberWall + ( NumberWall, Col, Row, numberWall, pagoda, rueppel, ternary, saveImage, showSection, printSection + , module Data.Mod.Word + ) where + +import Prelude hiding (negate, (*), (+), (-), (^), quot) + +import Data.Function.Memoize (memoFix2) +import Data.Semiring (Semiring, Ring, zero, one, negate, (*), (+), (-), (^)) +import Data.Euclidean (Euclidean, quot) + +import Data.Mod.Word +import Codec.Picture (PixelRGB8(..), generateImage, writePng) +import Data.Word (Word8) + +{-| +The 'numberWall' function works for any Euclidean domain. (In other words, +there must be some sort of @div@ function, along with addition and multiplication). +Usually, this domain is either 'Integer' or @Mod p@ for some prime number p. +Although 'Int' and @Mod n@ for non-prime n also have 'Euclidean' instances, they +are not actually Euclidean domains, and using 'numberWall' with them often causes +divide-by-zero errors. +-} + +type NumberWall a = (Eq a, Ring a, Euclidean a) + +type Col = Int +type Row = Int + +sign :: Ring a => Int -> a +sign x = if even x then one else negate one + +{-| +Generate the number wall for a sequence. +-} +numberWall :: (NumberWall a, Show a) => (Int -> a) -> Col -> Row -> a +numberWall s = memoFix2 \recurse col row -> + let f a b = recurse (col + a) (row - b) in + case row of + --simple cases + _ | row < (-1) -> zero + -1 -> one + 0 -> s col + + --small cross rule + _ | f 0 2 /= zero -> + (f 0 1 ^ 2 - f (-1) 1 * f 1 1) `quot` f 0 2 + + --large cross rule + | f 0 3 /= zero -> + (f 2 2 * f (-1) 2 ^ 2 + f (-2) 2 * f 1 2 ^ 2 - f 0 4 * f 0 1 ^ 2) `quot` f 0 3 ^ 2 + + --two rows below window + | f 0 1 /= zero -> + let top = findTop f (0, 4) + size = top - 2 + right = findRight f (1, top - 1) + left = right - size - 1 + k = right + + _A = f (left + k) top + _B = f left (top - k) + _C = f right (1 + k) + _D = f 0 1 + + _E = f (left + k) (top + 1) + _F = f (left - 1) (top - k) + _G = f (right + 1) (1 + k) + + _P = f (left + k - 1) top + _Q = f left (top - k + 1) + _R = f right (2 + k) + _T = f (-1) 1 + in + (_P * _B * _B * _C * _D * _E + + sign k * _Q * _A * _A * _C * _D * _F + - sign k * _T * _P * _Q * _A * _B * _G) + `quot` (_R * _P * _Q * _A * _B) + + | otherwise -> + let top = findTop f (0, 4) + size = top - 1 + in + case searchRight f size (1, top - 1) of + --inside window + Nothing -> zero + Just right + | f (right - size - 1) (top - 1) == zero -> zero + + --one row below window + | otherwise -> + let left = right - size - 1 + k = right + in + sign (size * k) * f left (top - k) * f right k `quot` f (left + k) top + +findTop :: NumberWall a => (Col -> Row -> a) -> (Col, Row) -> Row +findTop f (col, row) + | f col row == zero = findTop f (col, row + 1) + | otherwise = row + +findRight :: NumberWall a => (Col -> Row -> a) -> (Col, Row) -> Col +findRight f (col, row) + | f col row == zero = findRight f (col + 1, row) + | otherwise = col + +searchRight :: NumberWall a => (Col -> Row -> a) -> Int -> (Col, Row) -> Maybe Col +searchRight f limit (col, row) + | limit <= 0 = Nothing + | f col row == zero = searchRight f (limit - 1) (col + 1, row) + | otherwise = Just col + +{-| +The pagoda sequence ([A301849](https://oeis.org/A301849)). +In mod 2, its number wall is a self-similar fractal. +In mod 3 and mod 7, all zeros in its number wall are isolated. +-} +pagoda :: Ring a => Int -> a +pagoda n = bit (n + 1) - bit (n - 1) + where + bit k + | k == 0 = zero + | even k = bit (k `div` 2) + | k `mod` 4 == 1 = zero + | otherwise = one + +{-| +The Fredholm-Rueppel sequence ([A036987](https://oeis.org/A036987)). +@rueppel n@ evaluates to 1 if n + 1 is a power of 2, and 0 otherwise. +Its number wall contains zero-windows of exponentially increasing size, and +an infinite diagonal line of ones. +-} +rueppel :: Semiring a => Int -> a +rueppel n + | n < 0 = zero + | otherwise = + let pow = logBase 2 (fromIntegral (n + 1)) + in if ceiling pow == floor pow then one else zero + +data Alpha = A | B | C | D | E | F + +{-| +([A039974](https://oeis.org/A039974)). The mod-3 number wall of this sequence +has an infinite central region with no zeros. +-} +ternary :: Ring a => Int -> a +ternary n + | n < 0 = negate (ternary (-n - 1)) + | otherwise = + case ternary' n of + A -> one + B -> zero + C -> one + D -> zero + E -> negate one + F -> negate one + where + ternary' 0 = A + ternary' x = + let (q, m) = x `divMod` 3 + match3 a b c = + case m of + 0 -> a + 1 -> b + _ -> c + in case ternary' q of + A -> match3 A C B + B -> match3 B C B + C -> match3 E D F + D -> match3 D D D + E -> match3 E D D + F -> match3 D D F + +{-| +RGB colors. +-} +type Color = (Word8, Word8, Word8) + +{-| +Save a number wall as a PNG file. +-} +saveImage + :: FilePath -- ^ File name + -> (a -> Color) -- ^ Function assigning each number a color + -> (Col, Col) -- ^ Column range + -> (Row, Row) -- ^ Row range + -> (Col -> Row -> a) -- ^ Number wall + -> IO () +saveImage path toColor (minC, maxC) (minR, maxR) wall = + let convert (r, g, b) = PixelRGB8 r g b + image = generateImage + (\a b -> convert $ toColor $ wall (minC + a) (minR + b)) + (maxC - minC) (maxR - minR) + in writePng path image + +loop = flip map + +maxOf measure = foldr (max . measure) minBound + +{-| +Convert a section of a number wall into a string. +-} +showSection :: (a -> String) -> (Col, Col) -> (Row, Row) -> (Col -> Row -> a) -> String +showSection toString (minC, maxC) (minR, maxR) wall = + let chunks = loop [minR..maxR-1] \r -> loop [minC..maxC-1] \c -> toString (wall c r) + len = maxOf (maxOf length) chunks + pad s = replicate (len - length s) ' ' ++ s ++ " " + in concatMap (\xs -> concatMap pad xs ++ "\n") chunks + +{-| +Print a section of a number wall. +-} +printSection :: (a -> String) -> (Col, Col) -> (Row, Row) -> (Col -> Row -> a) -> IO () +printSection toString cols rows wall = putStr (showSection toString cols rows wall) diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 --- /dev/null +++ b/test/Main.hs @@ -0,0 +1,169 @@ +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE DataKinds #-} +module Main (main) where + +import NumberWall +import Data.Foldable (foldlM) +import Control.Monad (when, unless) +import System.Exit (exitFailure) + +data Test = Test String Bool + +runTests :: [Test] -> IO () +runTests tests = do + exit <- foldlM + (\exit (Test name pass) -> + (not pass || exit) <$ + unless pass (putStrLn ("Test failed: " ++ name))) + False tests + when exit exitFailure + +match2 :: a -> a -> Mod 2 -> a +match2 x0 x1 n = + case unMod n of + 0 -> x0 + _ -> x1 + +match3 :: a -> a -> a -> Mod 3 -> a +match3 x0 x1 x2 n = + case unMod n of + 0 -> x0 + 1 -> x1 + _ -> x2 + +pagoda0 = numberWall (pagoda :: Int -> Integer) +pagoda2 = numberWall (pagoda :: Int -> Mod 2) +pagoda3 = numberWall (pagoda :: Int -> Mod 3) +pagoda5 = numberWall (pagoda :: Int -> Mod 5) + +square0 = numberWall ((^2) . fromIntegral :: Int -> Integer) +square2 = numberWall ((^2) . fromIntegral :: Int -> Mod 2) +square3 = numberWall ((^2) . fromIntegral :: Int -> Mod 3) + +cube0 = numberWall ((^3) . fromIntegral :: Int -> Integer) + +window n + | n == (-2) || n == (-1) = 2 + | n >= 0 && n < 6 = 2 ^ n + | otherwise = 1 + +window0 = numberWall (window :: Int -> Integer) +rueppel2 = numberWall (rueppel :: Int -> Mod 2) +ternary3 = numberWall (ternary :: Int -> Mod 3) + +main :: IO () +main = do + runTests testCases + + saveImage "test/pagoda.png" + (match2 (181, 118, 46) (0, 0, 0)) + (0, 200) (0, 100) pagoda2 + + saveImage "test/rueppel.png" + (match2 (255, 255, 255) (0, 0, 0)) + (14, 114) (14, 114) rueppel2 + + saveImage "test/ternary.png" + (match3 (0, 0, 0) (183, 24, 53) (207, 181, 84)) + (0, 100) (-1, 49) ternary3 + + saveImage "test/pagoda-mod3.png" + (match3 (255, 255, 255) (0, 0, 0) (53, 139, 142)) + (-12, 13) (30, 55) pagoda3 + +testCases :: [Test] +testCases = + [ Test "pagoda sequence" $ + showSection show (0, 9) (-1, 7) pagoda0 == + " 1 1 1 1 1 1 1 1 1 \n\ + \-1 0 1 0 -1 1 1 -1 -1 \n\ + \ 1 1 1 1 1 2 2 2 1 \n\ + \ 1 -1 0 1 1 2 0 -2 1 \n\ + \-2 1 1 1 -1 2 2 2 1 \n\ + \-1 -3 1 2 -1 3 1 -1 -1 \n\ + \13 10 7 5 5 5 2 1 2 \n\ + \ 1 -3 -1 -5 0 5 -1 3 1 \n" + + , Test "pagoda sequence (single value)" $ + pagoda0 7 2 == (-2) + + , Test "pagoda sequence mod 2" $ + showSection (match2 "0" ".") (0, 9) (-1, 7) pagoda2 == + ". . . . . . . . . \n\ + \. 0 . 0 . . . . . \n\ + \. . . . . 0 0 0 . \n\ + \. . 0 . . 0 0 0 . \n\ + \0 . . . . 0 0 0 . \n\ + \. . . 0 . . . . . \n\ + \. 0 . . . . 0 . 0 \n\ + \. . . . 0 . . . . \n" + + , Test "pagoda sequence mod 2 (single value)" $ + pagoda2 6 4 == 1 + + , Test "pagoda sequence mod 3" $ + showSection (show . unMod) (0, 9) (-1, 7) pagoda3 == + "1 1 1 1 1 1 1 1 1 \n\ + \2 0 1 0 2 1 1 2 2 \n\ + \1 1 1 1 1 2 2 2 1 \n\ + \1 2 0 1 1 2 0 1 1 \n\ + \1 1 1 1 2 2 2 2 1 \n\ + \2 0 1 2 2 0 1 2 2 \n\ + \1 1 1 2 2 2 2 1 2 \n\ + \1 0 2 1 0 2 2 0 1 \n" + + , Test "pagoda sequence mod 5" $ + showSection (show . unMod) (0, 9) (-1, 7) pagoda5 == + "1 1 1 1 1 1 1 1 1 \n\ + \4 0 1 0 4 1 1 4 4 \n\ + \1 1 1 1 1 2 2 2 1 \n\ + \1 4 0 1 1 2 0 3 1 \n\ + \3 1 1 1 4 2 2 2 1 \n\ + \4 2 1 2 4 3 1 4 4 \n\ + \3 0 2 0 0 0 2 1 2 \n\ + \1 2 4 0 0 0 4 3 1 \n" + + , Test "squares" $ + showSection show (-1, 9) (0, 5) square0 == + " 1 0 1 4 9 16 25 36 49 64 \n\ + \ 1 -1 1 7 17 31 49 71 97 127 \n\ + \ 8 8 8 8 8 8 8 8 8 8 \n\ + \ 0 0 0 0 0 0 0 0 0 0 \n\ + \ 0 0 0 0 0 0 0 0 0 0 \n" + + , Test "squares (single value)" $ + square0 100 2 == 8 + + , Test "squares mod 2" $ + showSection (show . unMod) (-1, 9) (0, 5) square2 == + "1 0 1 0 1 0 1 0 1 0 \n\ + \1 1 1 1 1 1 1 1 1 1 \n\ + \0 0 0 0 0 0 0 0 0 0 \n\ + \0 0 0 0 0 0 0 0 0 0 \n\ + \0 0 0 0 0 0 0 0 0 0 \n" + + , Test "squares mod 3" $ + showSection (show . unMod) (-1, 9) (0, 5) square3 == + "1 0 1 1 0 1 1 0 1 1 \n\ + \1 2 1 1 2 1 1 2 1 1 \n\ + \2 2 2 2 2 2 2 2 2 2 \n\ + \0 0 0 0 0 0 0 0 0 0 \n\ + \0 0 0 0 0 0 0 0 0 0 \n" + + , Test "cubes" $ + showSection show (1, 6) (1, 5) cube0 == + " 1 37 217 721 1801 \n\ + \ -36 144 756 2016 4140 \n\ + \1296 1296 1296 1296 1296 \n\ + \ 0 0 0 0 0 \n" + + , Test "4x4 window" $ + showSection show (-1, 7) (0, 7) window0 == + " 2 1 2 4 8 16 32 1 \n\ + \ 2 -3 0 0 0 0 1008 -31 \n\ + \ 5 9 0 0 0 0 31752 961 \n\ + \ -1 -27 0 0 0 0 1000188 -29791 \n\ + \ 11 81 0 0 0 0 31505922 923521 \n\ + \ -40 -243 5103 -107163 2250423 -47258883 992436543 -28629151 \n\ + \ 35 3249 13284 1520775 25498017 250187058 31218807378 887503681 \n" + ]