Commit 61868820 authored by Hans-Peter Deifel's avatar Hans-Peter Deifel 🐢

Integrate SumBag into MonoidValued implementation

This was the intention all along.
parent 29cebc6c
......@@ -23,7 +23,6 @@ import Control.Monad
import Data.Foldable
import qualified Data.Vector as V
import qualified Data.Map.Strict as M
import Text.Megaparsec
import qualified Data.Text.Prettyprint as Doc
import Data.Text.Prettyprint ((<+>))
......@@ -36,6 +35,8 @@ import Copar.FunctorExpression.Parser
import Copar.Coalgebra.Parser
import Data.Float.Utils ( MaxDouble(..) )
import Copar.Parser.Types
import Data.SumBag (SumBag)
import qualified Data.SumBag as SumBag
data SlowMonoidValued m a = SlowMonoidValued a
......@@ -121,10 +122,8 @@ realHelp =
<> Doc.annotate Doc.bold "Coalgebra syntax:"
<+> Doc.reflow "'{' X ':' real, ... '}'"
type LabelCountMap m = M.Map m Int
type instance Label (SlowMonoidValued m) = m
type instance Weight (SlowMonoidValued m) = (m, LabelCountMap m)
type instance Weight (SlowMonoidValued m) = (m, SumBag m)
type instance F1 (SlowMonoidValued m) = m
type instance F3 (SlowMonoidValued m) = (m, m, m)
......@@ -134,7 +133,7 @@ instance (Monoid m, Ord m) => RefinementInterface (SlowMonoidValued m) where
-> [Label (SlowMonoidValued m)]
-> Weight (SlowMonoidValued m)
init _ labels =
(mempty, foldl' (\m l -> M.insertWith (+) l 1 m) M.empty labels)
(mempty, foldl' (flip SumBag.insert) SumBag.empty labels)
update
:: [Label (SlowMonoidValued m)]
......@@ -144,21 +143,16 @@ instance (Monoid m, Ord m) => RefinementInterface (SlowMonoidValued m) where
, Weight (SlowMonoidValued m)
)
update labels (sumRest, counts) =
let toS = foldl' (\m l -> M.insertWith (+) l 1 m) M.empty labels
toCWithoutS = foldl' (flip (M.adjust pred)) counts labels
sumS = sumCounts toS
sumCWithoutS = sumCounts toS
let toS = foldl' (flip SumBag.insert) SumBag.empty labels
toCWithoutS = foldl' (flip SumBag.delete) counts labels
sumS = fold toS
sumCWithoutS = fold toS
f3 = (sumRest, sumCWithoutS, sumS)
w1 = (sumRest <> sumCWithoutS, toS)
w2 = (sumRest <> sumS, toCWithoutS)
in (w1, f3, w2)
sumCounts :: Monoid m => LabelCountMap m -> m
sumCounts = M.foldlWithKey' (\a x -> (<> a) . multiply x) mempty
where multiply x n = mconcat (replicate n x)
instance ParseMorphism (SlowMonoidValued (Max Int)) where
parseMorphismPoint (SlowMonoidValued inner) =
parseMorphismPointHelper inner (Max <$> (L.signed L.decimal))
......
Markdown is supported
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