fix AbsorbingPolynomial innerFunctors

examples/ui-tests/tbeg-dist-paper-mvce

+(R^X)^{a,b}
+
+s1: {a: {s1: 0.3}, b: {s1: 0.8}}
\ No newline at end of file

examples/ui-tests/tbeg-dist-paper-mvce.mini

+R^(X)^{a, b}
+
+s0_s1: {a: {s0_s1: 0.3}, b: {s0_s1: 0.8}}
\ No newline at end of file

src/Copar/Functors/AbsorbingPolynomial.hs

@@ -59,7 +59,7 @@ import           Copar.Parser.Types
 
 import qualified Data.Vector.Utils             as V
 import           Data.Primitive.SmallArray
-import Data.Function (on)
+import           Data.Function (on)
 
 
 data Inner f a = Direct a | Absorbed (f a)
@@ -268,7 +268,7 @@ instance MinimizationInterface f => MinimizationInterface (AbsorbingPolynomial f
       updateInner ((PolyLabel i Nothing):|ll) = (PolyLabel i Nothing):ll
 
       innerLbls = map $ \(PolyLabel _ lbl) -> fromJust lbl
-      innerFunctors = V.fromList $ toList poly
+      innerFunctors = computeInnerFunctors poly
 
       innerFunctor :: Int  -> f ()
       innerFunctor i = case innerFunctors V.! i of
@@ -297,21 +297,19 @@ parseInner (Direct inner) = do
 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
   printMorphismPoint (AbsorbingPolynomial poly) f1 edges =
-    let
-      innerFunctors = toList poly
-      f1' = Poly.PolyF1 
-        (polyF1Summand f1)
-        (foldr (\v total -> ((maybe 0 (const 1)) v) + total) 0 (polyF1Variables f1))
-        (polyF1Constants f1)
+    let f1' = Poly.PolyF1 
+          (polyF1Summand f1)
+          (foldr (\v total -> ((maybe 0 (const 1)) v) + total) 0 (polyF1Variables f1))
+          (polyF1Constants f1)
     in 
       printMorphismPoint
         (() <$ poly)
         f1'
-        (fmap convertFunctor (zip innerFunctors [0..]))
+        (V.toList $ V.imap convertFunctor (computeInnerFunctors poly))
     where
-      convertFunctor :: (Inner f (), Int) -> (Label Polynomial, Build.Builder)
-      convertFunctor (Direct (), v) = (v, snd $ fromJust (find (\(PolyLabel n _, _) -> n == v) (edges)))
-      convertFunctor (Absorbed inner, v) = (v, 
+      convertFunctor :: Int -> Inner f () -> (Label Polynomial, Build.Builder)
+      convertFunctor v (Direct ()) = (v, snd $ fromJust (find (\(PolyLabel n _, _) -> n == v) (edges)))
+      convertFunctor v (Absorbed inner) = (v, 
           printMorphismPoint 
             inner
             (fromJust $ indexSmallArray (polyF1Variables f1) v)

src/Copar/Functors/Polynomial.hs

@@ -9,7 +9,8 @@
 
 -- | Polynomial functor with co-products, products, exponentials and constants
 module Copar.Functors.Polynomial
-  ( printPolynomial
+  ( computeInnerFunctors
+  , printPolynomial
     -- * Types exported for easier testing
   , Polynomial(..)
   , Sum(..)
@@ -97,6 +98,18 @@ $(deriveEq1 ''Polynomial)
 $(deriveShow1 ''Factor)
 $(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 _ (Polynomial (Sum (prods))) = fold (NonEmpty.intersperse " + " (fmap printProduct prods))