number-wall (empty) → 0.1.0.0

raw patch · 7 files changed

+501/−0 lines, 7 filesdep +JuicyPixelsdep +basedep +memoizebinary-added

Dependencies added: JuicyPixels, base, memoize, mod, number-wall, semirings

Files

• CHANGELOG.md +5/−0
• LICENSE +20/−0
• README.md +4/−0
• collage.png binary
• number-wall.cabal +81/−0
• src/NumberWall.hs +222/−0
• test/Main.hs +169/−0

@@ -0,0 +1,5 @@+# Revision history for number-wall++## 0.1.0.0 -- 2022-9-3++* First version. Released on an unsuspecting world.

@@ -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.

@@ -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).

binary file changed (absent → 8963 bytes)

@@ -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

@@ -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)

@@ -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"+  ]