### Clean up and document exponential implementation

parent 1491d322
 ... ... @@ -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) ... ...
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment