Commit c41fa7c7 authored by Hans-Peter Deifel's avatar Hans-Peter Deifel
Browse files

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