diff --git a/src/MA/Functors/Polynomial.hs b/src/MA/Functors/Polynomial.hs index 0917648c5ad1f4a29ac1ccbbd54ba3b53c9ee9d1..9f08bfbaef9bf93829809be733c304d6b4832db0 100644 --- a/src/MA/Functors/Polynomial.hs +++ b/src/MA/Functors/Polynomial.hs @@ -2,9 +2,13 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE FlexibleInstances #-} + +-- | Polynomial functor with co-products, products, exponentials and constants module MA.Functors.Polynomial - ( Polynomial(..) - , polynomial + ( -- * Functor expression parser + polynomial + -- * Types exported for easier testing + , Polynomial(..) , Sum(..) , Product(..) , Factor(..) @@ -15,11 +19,10 @@ module MA.Functors.Polynomial import Control.Monad import Data.Bifunctor -import Data.List (sortBy) +import Data.List (sort) import Data.List.NonEmpty (NonEmpty(..)) import qualified Data.List.NonEmpty as NonEmpty import Data.Maybe (fromMaybe) -import Data.Ord (comparing) import Data.Tuple (swap) import Data.Text (Text) @@ -95,8 +98,11 @@ data ProductValue a = deriving (Eq, Ord, Show, Functor) data FactorValue a - = ConstValue Int + = -- | Index of constant in vector of possible values + ConstValue Int + -- | One placeholder | IdValue a + -- | Essentially the same as a product of "IdValue"s | ExponentialValue (Vector a) deriving (Eq, Ord, Show, Functor) @@ -105,8 +111,19 @@ data Three = ToRest | ToCompound | ToSub deriving (Show, Eq, Ord, Enum) type instance H1 Polynomial = SumValue () + +-- | Tuple @(a, b)@ of +-- +-- [a]: Index of this edge in the product on the second level +-- [b]: Index of this edge in the exponential on the third level +-- +-- For "Identity"s, @b@ is 0. Also note that the top-level co-product doesn't +-- appear in the label at all. It already appears in "H1". type instance Label Polynomial = (Int, Int) -type instance Weight Polynomial = SumValue Bool -- H2 + +-- | Defined as H2 +type instance Weight Polynomial = SumValue Bool + type instance H3 Polynomial = SumValue Three instance ParseMorphism Polynomial where @@ -181,9 +198,9 @@ parseFactor (Identity inner) = do successor <- inner return (IdValue (), Just [(successor, 0)]) parseFactor (Exponential inner names) = L.braces $ do - successors <- sortBy (comparing fst) <$> ((,) <$> someName names <*> (L.colon *> inner)) `sepBy` L.comma + successors <- ((,) <$> someName names <*> (L.colon *> inner)) `sepBy` L.comma - let allIdxUsedOnce = [0..length names-1] == map fst successors + let allIdxUsedOnce = [0..length names-1] == sort (map fst successors) unless allIdxUsedOnce $ fail ("exponential: map must be well-defined on " ++ show names) @@ -202,7 +219,10 @@ instance RefinementInterface Polynomial where init :: H1 Polynomial -> [Label Polynomial] -> Weight Polynomial init h1 _ = fmap (const True) h1 - update :: [Label Polynomial] -> Weight Polynomial -> (Weight Polynomial, H3 Polynomial, Weight Polynomial) + update :: + [Label Polynomial] + -> Weight Polynomial + -> (Weight Polynomial, H3 Polynomial, Weight Polynomial) update = curry (val . up) where val :: H3 Polynomial -> (Weight Polynomial, H3 Polynomial, Weight Polynomial)