diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,14 @@ +# Revision history for monoid-semiring + +## 0.1.0.0 — 2026-06-11 + +* First release. The monoid semiring `M →₀ S`: finitely supported functions + from a monoid `M` to a semiring `S` (the `Semiring` class of the + `semirings` package), multiplied by the generalized Cauchy product + `(f * g)(s) = Σ_{uv = s} f(u) · g(v)`. +* Representation invariant: no explicit zero coefficients, so derived + equality coincides with equality of functions. +* Oracle test suite: the seven semiring laws at three `(M, S)` instances + (polynomials, formal languages, tropical multivariate), differential + test against the naive definition, Fibonacci (A000045) and Catalan + (A000108) generating-function coefficients against vendored OEIS b-files. diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2026, Nicolas FP PARIS + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Nicolas FP PARIS nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/monoid-semiring.cabal b/monoid-semiring.cabal new file mode 100644 --- /dev/null +++ b/monoid-semiring.cabal @@ -0,0 +1,48 @@ +cabal-version: 2.4 +name: monoid-semiring +version: 0.1.0.0 +synopsis: The monoid semiring M ->0 S and its generalized Cauchy product +description: Finitely supported functions from a monoid M to a semiring S, + multiplied by convolution (f*g)(s) = sum over uv=s of f(u).g(v). + Polynomials, formal languages, tropical algebra are instances. +license: BSD-3-Clause +license-file: LICENSE +author: Nicolas FP PARIS +maintainer: untruth.51-room@icloud.com +homepage: https://github.com/nrolland/cauchy-haskell +bug-reports: https://github.com/nrolland/cauchy-haskell/issues +build-type: Simple +category: Math +tested-with: GHC ==9.12.4 +extra-source-files: test/data/*.txt +extra-doc-files: CHANGELOG.md + +source-repository head + type: git + location: https://github.com/nrolland/cauchy-haskell + subdir: monoid-semiring + +library + exposed-modules: Data.MonoidSemiring + hs-source-dirs: src + build-depends: base >=4.14 && <5, + containers >=0.6 && <0.8, + semirings >=0.7 && <0.8 + default-language: Haskell2010 + ghc-options: -Wall + +test-suite oracle + type: exitcode-stdio-1.0 + main-is: Oracle.hs + other-modules: OrdContract, + Snippets, + SemiringClass, + Tropical + hs-source-dirs: test + build-depends: base >=4.14 && <5, + containers >=0.6 && <0.8, + QuickCheck >=2.14 && <2.19, + semirings >=0.7 && <0.8, + monoid-semiring + default-language: Haskell2010 + ghc-options: -Wall diff --git a/src/Data/MonoidSemiring.hs b/src/Data/MonoidSemiring.hs new file mode 100644 --- /dev/null +++ b/src/Data/MonoidSemiring.hs @@ -0,0 +1,123 @@ +-- | The monoid semiring @M ->_0 S@: finitely supported functions from a +-- monoid @M@ to a semiring @S@, multiplied by the generalized Cauchy +-- product (convolution) +-- +-- > (f * g)(s) = sum over uv = s of f(u) . g(v) +-- +-- Instantiating @(M, S)@ yields polynomials @(N, +)@, formal languages +-- @(Sigma*, .)@, multivariate polynomials @(N^k, +)@, tropical algebra... +-- The convolution code never changes. +-- +-- Representation invariant: the underlying 'Map' carries no explicit +-- 'zero' coefficient. Every constructor of this module maintains it; +-- 'Eq' relies on it. +-- +-- == The role of @Ord m@ +-- +-- @Ord m@ does not belong to the implementation — it is not merely a +-- search order for the tree, observable by accident. It decides the +-- abstraction this type incarnates: 'compare' is /the/ order in which +-- terms are observed, and choosing it is part of choosing what a value +-- means. The precise statement is a failure of representation +-- independence, in one direction: re-keying a value between two orders +-- on the same carrier commutes with the algebra ('plus', 'times', +-- 'coefficient') but not with 'toList' or 'support' — so @Ord m@ does +-- not sit under the abstract type's existential, it is a free +-- parameter of the interface. Both halves are checked by the @oracle@ +-- test suite (module @OrdContract@). Three clauses: +-- +-- * /Observation./ 'toList' and 'support' enumerate in ascending +-- @Ord m@ order, and maximum-based machinery (leading terms, in a +-- multivariate layer) is entitled to read the 'Map' maximum in +-- O(log n). The semiring laws themselves never depend on the order. +-- +-- * /One order per type./ By class coherence a type carries a single +-- 'Ord' instance, so an alternative order on the same carrier enters +-- as a @newtype@ on the index (e.g. lex vs. grevlex on @N^k@) — +-- never as a comparison function passed at call sites. A passed-in +-- comparison can disagree with the tree's order and select a term +-- that 'Map' operations then fail to find: an incoherence no type +-- error reports. +-- +-- * /Laws./ This module requires only that @Ord m@ be a total order. +-- A layer that interprets 'compare' must impose its own laws on the +-- index types it admits — e.g. monomial orders must be admissible +-- (a well-order, compatible with '<>', with 'mempty' minimal). +module Data.MonoidSemiring + ( MonoidSemiring + , fromList + , toList + , dirac + , coefficient + , support + , lookupMax + , scale + , filterIndex + ) where + +import qualified Data.Map.Strict as Map +import Data.Map.Strict (Map) +import Data.Semiring (Semiring (..)) + +-- SNIPPET:m2s-type +-- | @f :: MonoidSemiring m s@ is a function @m -> s@ that is 'zero' +-- everywhere except on a finite set, its support. +newtype MonoidSemiring m s = MS (Map m s) + deriving (Eq, Ord, Show) +-- END:m2s-type + +-- SNIPPET:m2s-constructors +-- | Discard explicit zeros: the representation invariant. +normalize :: (Semiring s, Eq s) => Map m s -> Map m s +normalize = Map.filter (/= zero) + +-- | Build from index–coefficient pairs; equal indices are combined with 'plus'. +fromList :: (Ord m, Semiring s, Eq s) => [(m, s)] -> MonoidSemiring m s +fromList = MS . normalize . Map.fromListWith plus + +-- | Dirac mass: @dirac m c@ is @c@ at @m@, 'zero' elsewhere. +dirac :: (Ord m, Semiring s, Eq s) => m -> s -> MonoidSemiring m s +dirac m c = MS (normalize (Map.singleton m c)) +-- END:m2s-constructors + +-- | The support with its coefficients, in ascending index order. +toList :: MonoidSemiring m s -> [(m, s)] +toList (MS f) = Map.toList f + +-- | Total function view: 'zero' off the support. +coefficient :: (Ord m, Semiring s) => m -> MonoidSemiring m s -> s +coefficient m (MS f) = Map.findWithDefault zero m f + +-- | The indices carrying a non-'zero' coefficient, ascending. +support :: MonoidSemiring m s -> [m] +support (MS f) = Map.keys f + +-- | The maximum of the support with its coefficient, 'Nothing' for +-- zero — the O(log n) reading that the @Ord m@ contract grants to +-- maximum-based machinery (leading terms, in a multivariate layer). +lookupMax :: MonoidSemiring m s -> Maybe (m, s) +lookupMax (MS f) = Map.lookupMax f + +-- SNIPPET:convolution +instance (Ord m, Monoid m, Semiring s, Eq s) + => Semiring (MonoidSemiring m s) where + zero = MS Map.empty + one = dirac mempty one + plus (MS f) (MS g) = + MS (normalize (Map.unionWith plus f g)) + times (MS f) (MS g) = + MS (normalize (Map.fromListWith plus + [ (u <> v, a `times` b) + | (u, a) <- Map.toList f + , (v, b) <- Map.toList g ])) +-- END:convolution + +-- SNIPPET:semimodule +-- | Left semimodule action of @S@ on @M ->_0 S@, pointwise. +scale :: (Semiring s, Eq s) => s -> MonoidSemiring m s -> MonoidSemiring m s +scale c (MS f) = MS (normalize (Map.map (c `times`) f)) +-- END:semimodule + +-- | Keep the indices satisfying a predicate (used for truncation). +filterIndex :: (m -> Bool) -> MonoidSemiring m s -> MonoidSemiring m s +filterIndex p (MS f) = MS (Map.filterWithKey (\m _ -> p m) f) diff --git a/test/Oracle.hs b/test/Oracle.hs new file mode 100644 --- /dev/null +++ b/test/Oracle.hs @@ -0,0 +1,154 @@ +-- | Phase 0 oracle. +-- +-- 1. Semiring laws (QuickCheck) for @MonoidSemiring m s@ at three +-- @(M, S)@ pairs: polynomials, languages, tropical multivariate. +-- 2. Differential test: Map-based convolution vs the naive O(n^2) +-- definition on raw association lists. +-- 3. Canonical results: Fibonacci (A000045) and Catalan (A000108) +-- coefficients of generating-function fixpoints vs vendored OEIS +-- b-files. +-- 4. The Ord contract: the algebra is invariant under change of order, +-- the observations are not ("OrdContract"). +{-# LANGUAGE ScopedTypeVariables #-} +module Main (main) where + +import Control.Monad (forM, unless) +import Data.List (sort) +import Data.Monoid (Sum (..)) +import Numeric.Natural (Natural) +import System.Exit (exitFailure) +import Test.QuickCheck + +import Data.Semiring (Semiring (..)) +import Data.MonoidSemiring +import Tropical (Tropical (..)) +import qualified OrdContract +import qualified Snippets + +-- Small supports: convolution is quadratic in support size. +genMS :: (Ord m, Semiring s, Eq s) + => Gen m -> Gen s -> Gen (MonoidSemiring m s) +genMS gm gs = do + n <- choose (0, 6 :: Int) + ps <- vectorOf n ((,) <$> gm <*> gs) + return (fromList ps) + +genNat :: Gen (Sum Natural) +genNat = Sum . fromIntegral <$> choose (0, 8 :: Int) + +genWord :: Gen String +genWord = do n <- choose (0, 3 :: Int) + vectorOf n (elements "ab") + +genTrop :: Gen Tropical +genTrop = Tropical <$> frequency + [ (1, return Nothing) + , (5, Just <$> choose (-10, 10)) ] + +-- SNIPPET:laws +-- The seven semiring laws, stated once, checked at every instance. +semiringLaws :: (Semiring r, Eq r, Show r) => Gen r -> [(String, Property)] +semiringLaws g = + [ ("plus-assoc", p3 (\a b c -> (a `plus` b) `plus` c == a `plus` (b `plus` c))) + , ("plus-comm", p2 (\a b -> a `plus` b == b `plus` a)) + , ("plus-zero", p1 (\a -> a `plus` zero == a)) + , ("times-assoc", p3 (\a b c -> (a `times` b) `times` c == a `times` (b `times` c))) + , ("times-one", p1 (\a -> a `times` one == a && one `times` a == a)) + , ("distrib", p3 (\a b c -> a `times` (b `plus` c) == (a `times` b) `plus` (a `times` c) + && (b `plus` c) `times` a == (b `times` a) `plus` (c `times` a))) + , ("annihilation", p1 (\a -> zero `times` a == zero && a `times` zero == zero)) + ] + where p1 f = forAll g f + p2 f = forAll g (\a -> forAll g (f a)) + p3 f = forAll g (\a -> forAll g (\b -> forAll g (f a b))) +-- END:laws + +-- SNIPPET:naive +-- Reference implementation: the definition, term by term, on raw +-- association lists, no normalization, no Map. +naiveTimes :: (Monoid m, Semiring s) => [(m, s)] -> [(m, s)] -> [(m, s)] +naiveTimes f g = [ (u <> v, a `times` b) | (u, a) <- f, (v, b) <- g ] + +-- A raw list and a MonoidSemiring agree iff fromList equalizes them. +agreesWithNaive :: (Ord m, Monoid m, Semiring s, Eq s) + => [(m, s)] -> [(m, s)] -> Bool +agreesWithNaive f g = + fromList f `times` fromList g == fromList (naiveTimes f g) +-- END:naive + +readBFile :: FilePath -> IO [(Int, Integer)] +readBFile fp = do + s <- readFile fp + return [ (read n, read a) + | l <- lines s + , not (null l), head l /= '#' + , (n : a : _) <- [words l] ] + +checkSeq :: String -> [Integer] -> [Integer] -> IO Bool +checkSeq name got want + | got == want = putStrLn ("OK " ++ name) >> return True + | otherwise = do + putStrLn ("FAIL " ++ name) + putStrLn (" got: " ++ show got) + putStrLn (" want: " ++ show want) + return False + +runLaws :: String -> [(String, Property)] -> IO Bool +runLaws inst lws = fmap and . forM lws $ \(name, prop) -> do + r <- quickCheckWithResult stdArgs{chatty = False, maxSuccess = 300} prop + let ok = isSuccess r + putStrLn ((if ok then "OK " else "FAIL ") ++ inst ++ " / " ++ name) + unless ok (print r) + return ok + +main :: IO () +main = do + -- 1. Laws at three (M, S) pairs + ok1 <- runLaws "poly (Sum Nat, Integer)" + (semiringLaws (genMS genNat (arbitrary :: Gen Integer))) + ok2 <- runLaws "lang (Sigma*, Bool)" + (semiringLaws (genMS genWord (arbitrary :: Gen Bool))) + ok3 <- runLaws "trop (Nat^2, Tropical)" + (semiringLaws (genMS ((,) <$> genNat <*> genNat) genTrop)) + + -- 2. Differential: optimized vs naive definition + let diffProp :: Property + diffProp = forAll (listOf ((,) <$> genNat <*> (arbitrary :: Gen Integer))) + (\f -> forAll (listOf ((,) <$> genNat <*> arbitrary)) + (\g -> agreesWithNaive f g)) + diffLang :: Property + diffLang = forAll (listOf ((,) <$> genWord <*> (arbitrary :: Gen Bool))) + (\f -> forAll (listOf ((,) <$> genWord <*> arbitrary)) + (\g -> agreesWithNaive f g)) + ok4 <- runLaws "differential" [("naive-poly", diffProp), ("naive-lang", diffLang)] + + -- 3. Canonical sequences vs vendored OEIS b-files + fib <- readBFile "test/data/b000045.txt" + cat <- readBFile "test/data/b000108.txt" + -- coefficient k of 1/(1-x-x^2) is F(k+1) + let nFib = 29 :: Int + gotF = [ Snippets.fibCoefficient (fromIntegral k) | k <- [0 .. nFib] ] + wantF = [ a | (n, a) <- fib, n >= 1, n <= nFib + 1 ] + ok5 <- checkSeq ("Fibonacci 1/(1-x-x^2) vs A000045, " ++ show (nFib + 1) ++ " terms") + gotF wantF + let nCat = 20 :: Int + gotC = [ Snippets.catalanCoefficient (fromIntegral k) | k <- [0 .. nCat] ] + wantC = [ a | (n, a) <- cat, n <= nCat ] + ok6 <- checkSeq ("Catalan C = 1 + x*C^2 vs A000108, " ++ show (nCat + 1) ++ " terms") + gotC wantC + + -- sanity: sorted support after arithmetic stays canonical + let f = fromList [(Sum (3 :: Natural), 2 :: Integer), (Sum 0, 1), (Sum 3, -2)] + ok7 <- checkSeq "normalization drops zeros" + (map (fromIntegral . getSum) (sort (support f))) [0] + + -- 4. The Ord contract, both halves + ok8 <- runLaws "Ord contract (invariance)" + (OrdContract.invarianceLaws (genMS genNat arbitrary) genNat) + ok9 <- checkSeq "Ord contract (observability): support of x + x^2, both orders" + (map fromIntegral (OrdContract.observedSupport + ++ OrdContract.observedSupportRev)) + [1, 2, 2, 1] + + unless (and [ok1, ok2, ok3, ok4, ok5, ok6, ok7, ok8, ok9]) exitFailure + putStrLn "PHASE 0 ORACLE: all green" diff --git a/test/OrdContract.hs b/test/OrdContract.hs new file mode 100644 --- /dev/null +++ b/test/OrdContract.hs @@ -0,0 +1,69 @@ +-- | The @Ord m@ contract of the core, executable (haddock of +-- "Data.MonoidSemiring", section "The role of @Ord m@"). The claim +-- splits the API in two halves, each with its own witness: +-- +-- * /invariance/: re-keying a value between two orders on the same +-- carrier commutes with the algebra — QuickCheck properties; +-- * /observability/: 'toList' and 'support' reflect the order — one +-- value, two orders, two supports. +module OrdContract + ( Rev (..) + , reKey + , invarianceLaws + , witnessValue + , observedSupport + , observedSupportRev + ) where + +import Data.Monoid (Sum (..)) +import Numeric.Natural (Natural) +import Test.QuickCheck + +import Data.MonoidSemiring +import Data.Semiring (Semiring (..)) + +-- SNIPPET:rekey +-- | The same carrier under the opposite order: the monoid is unchanged, +-- only 'compare' flips. +newtype Rev = Rev { unRev :: Sum Natural } + deriving (Eq, Show) + +instance Ord Rev where compare (Rev a) (Rev b) = compare b a + +instance Semigroup Rev where Rev a <> Rev b = Rev (a <> b) +instance Monoid Rev where mempty = Rev mempty + +-- | Transport along the identity of carriers, between the two orders. +reKey :: (Semiring s, Eq s) + => MonoidSemiring (Sum Natural) s -> MonoidSemiring Rev s +reKey = fromList . map (\(m, c) -> (Rev m, c)) . toList +-- END:rekey + +-- SNIPPET:ord-invariance +-- The algebra cannot tell the two orders apart: re-keying commutes +-- with every algebraic operation. +invarianceLaws :: Gen (MonoidSemiring (Sum Natural) Integer) + -> Gen (Sum Natural) + -> [(String, Property)] +invarianceLaws g gm = + [ ("rekey-plus", p2 (\f h -> reKey (f `plus` h) == reKey f `plus` reKey h)) + , ("rekey-times", p2 (\f h -> reKey (f `times` h) == reKey f `times` reKey h)) + , ("rekey-coefficient", + forAll g (\f -> forAll gm (\m -> + coefficient (Rev m) (reKey f) == coefficient m f))) + ] + where p2 f = forAll g (\a -> forAll g (f a)) +-- END:ord-invariance + +-- SNIPPET:ord-observable +-- The observations can: the same value, x + x^2, enumerates its +-- support ascending — which list that is depends on the order. +witnessValue :: MonoidSemiring (Sum Natural) Integer +witnessValue = fromList [(Sum 1, 1), (Sum 2, 1)] + +observedSupport :: [Natural] -- [1, 2] +observedSupport = map getSum (support witnessValue) + +observedSupportRev :: [Natural] -- [2, 1] +observedSupportRev = map (getSum . unRev) (support (reKey witnessValue)) +-- END:ord-observable diff --git a/test/SemiringClass.hs b/test/SemiringClass.hs new file mode 100644 --- /dev/null +++ b/test/SemiringClass.hs @@ -0,0 +1,24 @@ +-- | Exposition only: a verbatim reproduction of the 'Semiring' class from +-- the @semirings@ package, which the library depends on ('fromNatural', +-- which has a default, is omitted). The explainer series extracts the +-- snippets below; compiling this module keeps them honest. No other +-- module imports this one. +module SemiringClass + ( Semiring(..) + ) where + +-- SNIPPET:semiring-class +class Semiring r where + zero :: r + one :: r + plus :: r -> r -> r + times :: r -> r -> r +-- END:semiring-class + +-- SNIPPET:semiring-instances +instance Semiring Integer where + zero = 0; one = 1; plus = (+); times = (*) + +instance Semiring Bool where + zero = False; one = True; plus = (||); times = (&&) +-- END:semiring-instances diff --git a/test/Snippets.hs b/test/Snippets.hs new file mode 100644 --- /dev/null +++ b/test/Snippets.hs @@ -0,0 +1,105 @@ +-- | Exposition snippets: every Haskell fragment shown in the explainer +-- series is extracted from this file or from @src/@ by +-- @explainers/extract.mjs@ — GHC compiles and the oracle runs everything +-- the reader sees. +module Snippets + ( Poly + , fibCoefficient + , fibStep + , catalanCoefficient + , catalanStep + , truncateDeg + , x + , monomial + , degrees + , word + , exponents + , pSquared + , abab + , assocL + , assocR + ) where + +import Data.Monoid (Sum (..)) +import Numeric.Natural (Natural) + +import Data.Semiring (Semiring (..)) +import Data.MonoidSemiring + +-- SNIPPET:monoides +-- Trois monoïdes, un seul geste : (<>) associatif avec neutre mempty. +degrees :: Sum Natural -- (N, +) +degrees = Sum 2 <> Sum 3 -- Sum 5 + +word :: String -- (Sigma*, ++) +word = "ab" <> "ba" -- "abba" + +exponents :: (Sum Natural, Sum Natural) -- (N^2, +) composante par composante +exponents = (Sum 1, Sum 4) <> (Sum 2, Sum 0) -- (Sum 3, Sum 4) +-- END:monoides + +-- SNIPPET:poly-basics +-- A polynomial is a finitely supported function (N, +) -> Integer. +type Poly = MonoidSemiring (Sum Natural) Integer + +-- The indeterminate: coefficient 1 at index 1. +x :: Poly +x = dirac (Sum 1) 1 + +monomial :: Natural -> Integer -> Poly +monomial k c = dirac (Sum k) c +-- END:poly-basics + +-- SNIPPET:duel +-- Le même `times` : produit de polynômes, concaténation de langages. +pSquared :: Poly +pSquared = p `times` p -- 1 + 2x + x^2 + where p = one `plus` x -- 1 + x + +type Lang = MonoidSemiring String Bool + +abab :: Lang +abab = ab `times` ab -- {"aa","ab","ba","bb"} + where ab = fromList [("a", True), ("b", True)] +-- END:duel + +-- SNIPPET:assoc-micro +-- Deux parenthésages du même produit : x + 2x^2 + x^3 des deux côtés. +assocL, assocR :: Poly +assocL = (p `times` q) `times` p where p = one `plus` x; q = x +assocR = p `times` (q `times` p) where p = one `plus` x; q = x +-- END:assoc-micro + +-- SNIPPET:truncate +-- Keep degrees <= n: the working window for series fixpoints. +truncateDeg :: Natural -> Poly -> Poly +truncateDeg n = filterIndex (\(Sum k) -> k <= n) +-- END:truncate + +-- SNIPPET:fibonacci +-- 1/(1-x-x^2) as the fixpoint F = 1 + (x + x^2) * F: +-- one step of the iteration, then the fixpoint to degree n. +-- Coefficient k is Fibonacci(k+1). +fibStep :: Natural -> Poly -> Poly +fibStep n f = truncateDeg n + (one `plus` ((x `plus` (x `times` x)) `times` f)) + +fibSeries :: Natural -> Poly +fibSeries n = iterate (fibStep n) one !! (fromIntegral n + 1) + +fibCoefficient :: Natural -> Integer +fibCoefficient k = coefficient (Sum k) (fibSeries k) +-- END:fibonacci + +-- SNIPPET:catalan +-- Catalan: the fixpoint C = 1 + x * C^2, truncated to degree n. +catalanStep :: Natural -> Poly -> Poly +catalanStep n c = truncateDeg n + (one `plus` (x `times` (c `times` c))) + +catalanSeries :: Natural -> Poly +catalanSeries n = iterate (catalanStep n) one !! (fromIntegral n + 1) + +catalanCoefficient :: Natural -> Integer +catalanCoefficient k = coefficient (Sum k) (catalanSeries k) +-- END:catalan diff --git a/test/Tropical.hs b/test/Tropical.hs new file mode 100644 --- /dev/null +++ b/test/Tropical.hs @@ -0,0 +1,21 @@ +-- | Min-plus semiring. 'Nothing' is @+oo@ (the 'zero' of the semiring). +-- Coefficient type for the oracle's third instance and the explainer. +module Tropical + ( Tropical(..) + ) where + +import Data.Semiring (Semiring (..)) + +-- SNIPPET:tropical +newtype Tropical = Tropical (Maybe Integer) + deriving (Eq, Ord, Show) + +instance Semiring Tropical where + zero = Tropical Nothing + one = Tropical (Just 0) + plus (Tropical a) (Tropical b) = Tropical (minMaybe a b) + where minMaybe Nothing y = y + minMaybe x Nothing = x + minMaybe (Just x) (Just y) = Just (min x y) + times (Tropical a) (Tropical b) = Tropical ((+) <$> a <*> b) +-- END:tropical diff --git a/test/data/b000045.txt b/test/data/b000045.txt new file mode 100644 --- /dev/null +++ b/test/data/b000045.txt @@ -0,0 +1,33 @@ +# A000045 Fibonacci numbers, F(0)=0. Source: OEIS, https://oeis.org/A000045 +# (b-file excerpt vendored 2026-06-11; network-restricted CI) +0 0 +1 1 +2 1 +3 2 +4 3 +5 5 +6 8 +7 13 +8 21 +9 34 +10 55 +11 89 +12 144 +13 233 +14 377 +15 610 +16 987 +17 1597 +18 2584 +19 4181 +20 6765 +21 10946 +22 17711 +23 28657 +24 46368 +25 75025 +26 121393 +27 196418 +28 317811 +29 514229 +30 832040 diff --git a/test/data/b000108.txt b/test/data/b000108.txt new file mode 100644 --- /dev/null +++ b/test/data/b000108.txt @@ -0,0 +1,23 @@ +# A000108 Catalan numbers. Source: OEIS, https://oeis.org/A000108 +# (b-file excerpt vendored 2026-06-11; network-restricted CI) +0 1 +1 1 +2 2 +3 5 +4 14 +5 42 +6 132 +7 429 +8 1430 +9 4862 +10 16796 +11 58786 +12 208012 +13 742900 +14 2674440 +15 9694845 +16 35357670 +17 129644790 +18 477638700 +19 1767263190 +20 6564120420