Commit 44672224 authored by Bastian Kauschke's avatar Bastian Kauschke
Browse files

fix AbsorbingPolynomial innerFunctors

parent 0dd884dc
(R^X)^{a,b}
s1: {a: {s1: 0.3}, b: {s1: 0.8}}
\ No newline at end of file
R^(X)^{a, b}
s0_s1: {a: {s0_s1: 0.3}, b: {s0_s1: 0.8}}
\ No newline at end of file
...@@ -59,7 +59,7 @@ import Copar.Parser.Types ...@@ -59,7 +59,7 @@ import Copar.Parser.Types
import qualified Data.Vector.Utils as V import qualified Data.Vector.Utils as V
import Data.Primitive.SmallArray import Data.Primitive.SmallArray
import Data.Function (on) import Data.Function (on)
data Inner f a = Direct a | Absorbed (f a) data Inner f a = Direct a | Absorbed (f a)
...@@ -268,7 +268,7 @@ instance MinimizationInterface f => MinimizationInterface (AbsorbingPolynomial f ...@@ -268,7 +268,7 @@ instance MinimizationInterface f => MinimizationInterface (AbsorbingPolynomial f
updateInner ((PolyLabel i Nothing):|ll) = (PolyLabel i Nothing):ll updateInner ((PolyLabel i Nothing):|ll) = (PolyLabel i Nothing):ll
innerLbls = map $ \(PolyLabel _ lbl) -> fromJust lbl innerLbls = map $ \(PolyLabel _ lbl) -> fromJust lbl
innerFunctors = V.fromList $ toList poly innerFunctors = computeInnerFunctors poly
innerFunctor :: Int -> f () innerFunctor :: Int -> f ()
innerFunctor i = case innerFunctors V.! i of innerFunctor i = case innerFunctors V.! i of
...@@ -297,21 +297,19 @@ parseInner (Direct inner) = do ...@@ -297,21 +297,19 @@ parseInner (Direct inner) = do
instance (PrintMorphism f, Show1 f, Show (Label f), Show (F1 f)) => PrintMorphism (AbsorbingPolynomial f) where instance (PrintMorphism f, Show1 f, Show (Label f), Show (F1 f)) => PrintMorphism (AbsorbingPolynomial f) where
-- TODO: This currently has a runtime of O(n^2), which can still be improved -- TODO: This currently has a runtime of O(n^2), which can still be improved
printMorphismPoint (AbsorbingPolynomial poly) f1 edges = printMorphismPoint (AbsorbingPolynomial poly) f1 edges =
let let f1' = Poly.PolyF1
innerFunctors = toList poly (polyF1Summand f1)
f1' = Poly.PolyF1 (foldr (\v total -> ((maybe 0 (const 1)) v) + total) 0 (polyF1Variables f1))
(polyF1Summand f1) (polyF1Constants f1)
(foldr (\v total -> ((maybe 0 (const 1)) v) + total) 0 (polyF1Variables f1))
(polyF1Constants f1)
in in
printMorphismPoint printMorphismPoint
(() <$ poly) (() <$ poly)
f1' f1'
(fmap convertFunctor (zip innerFunctors [0..])) (V.toList $ V.imap convertFunctor (computeInnerFunctors poly))
where where
convertFunctor :: (Inner f (), Int) -> (Label Polynomial, Build.Builder) convertFunctor :: Int -> Inner f () -> (Label Polynomial, Build.Builder)
convertFunctor (Direct (), v) = (v, snd $ fromJust (find (\(PolyLabel n _, _) -> n == v) (edges))) convertFunctor v (Direct ()) = (v, snd $ fromJust (find (\(PolyLabel n _, _) -> n == v) (edges)))
convertFunctor (Absorbed inner, v) = (v, convertFunctor v (Absorbed inner) = (v,
printMorphismPoint printMorphismPoint
inner inner
(fromJust $ indexSmallArray (polyF1Variables f1) v) (fromJust $ indexSmallArray (polyF1Variables f1) v)
......
...@@ -9,7 +9,8 @@ ...@@ -9,7 +9,8 @@
-- | Polynomial functor with co-products, products, exponentials and constants -- | Polynomial functor with co-products, products, exponentials and constants
module Copar.Functors.Polynomial module Copar.Functors.Polynomial
( printPolynomial ( computeInnerFunctors
, printPolynomial
-- * Types exported for easier testing -- * Types exported for easier testing
, Polynomial(..) , Polynomial(..)
, Sum(..) , Sum(..)
...@@ -97,6 +98,18 @@ $(deriveEq1 ''Polynomial) ...@@ -97,6 +98,18 @@ $(deriveEq1 ''Polynomial)
$(deriveShow1 ''Factor) $(deriveShow1 ''Factor)
$(deriveShow1 ''Polynomial) $(deriveShow1 ''Polynomial)
computeInnerFunctors :: Polynomial a -> V.Vector a
computeInnerFunctors (Polynomial (Sum (prods))) = foldMap products prods
where
products (Product (fact)) = foldMap factors fact
factors (Const _) = V.empty
factors (Identity x) = V.singleton x
factors (Exponential a kind) = V.replicate (expSize kind) a
expSize (FiniteNatExp n) = n
expSize (ExplicitExp exp) = V.length exp
printPolynomial :: PrintConfig -> Polynomial Build.Builder -> Build.Builder printPolynomial :: PrintConfig -> Polynomial Build.Builder -> Build.Builder
printPolynomial _ (Polynomial (Sum (prods))) = fold (NonEmpty.intersperse " + " (fmap printProduct prods)) printPolynomial _ (Polynomial (Sum (prods))) = fold (NonEmpty.intersperse " + " (fmap printProduct prods))
......
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