Commit a0f70d2d authored by Bastian Kauschke's avatar Bastian Kauschke

refactor printFactor

parent b1d2a7f1
......@@ -7,9 +7,6 @@ import qualified Data.Text.Lazy.Builder as Build
import Numeric (showFFloat)
import GHC.Float (double2Float)
import Data.Vector as V
import Copar.RefinementInterface
class PrintMorphism f where
......
......@@ -25,6 +25,7 @@ import Data.Bifunctor
import Data.Foldable.Utils
import Data.Foldable (fold)
import Data.Traversable (mapAccumL)
import qualified Data.List as List
import Data.List.NonEmpty (NonEmpty(..))
import qualified Data.List.NonEmpty as NonEmpty
import Data.Word (Word8)
......@@ -37,6 +38,7 @@ import Data.Either ( lefts
import qualified Data.Vector.Utils as V
import Data.Text (Text)
import Data.Maybe (fromJust)
import Data.Vector (Vector)
import qualified Data.Vector as V
import qualified Data.Vector.Unboxed as VU
......@@ -300,25 +302,33 @@ printSumPoint (Sum sum) f1 edges =
<> printProductPoint (sum NonEmpty.!! (polyF1Summand f1)) f1 edges
printProductPoint :: Product () -> F1 Polynomial -> [(Label Polynomial, Build.Builder)] -> Build.Builder
printProductPoint (Product prod) f1 edges =
let inner = sepFold ", " id (snd (mapAccumL printFactor (0, 0) prod))
printProductPoint (Product prod) f1 edges' =
let inner = sepFold ", " id (snd (mapAccumL printFactor (0, edges') prod))
in if NonEmpty.length prod /= 1 then "(" <> inner <> ")" else inner
where
printFactor :: (Int, Int) -> Factor () -> ((Int, Int), Build.Builder)
printFactor (ct, var) (Const IntSet) = ((ct + 1, var), Build.decimal (polyF1Constants f1 VU.! ct))
printFactor (ct, var) (Const NatSet) = ((ct + 1, var), Build.decimal (polyF1Constants f1 VU.! ct))
printFactor (ct, var) (Const (FiniteNatSet _)) = ((ct + 1, var), Build.decimal (polyF1Constants f1 VU.! ct))
printFactor (ct, var) (Const (ExplicitSet elems)) = ((ct + 1, var), Build.fromText $ elems V.! (polyF1Constants f1 VU.! ct))
printFactor (ct, var) (Identity ()) = ((ct, var + 1), snd $ edges !! var)
printFactor (ct, var) (Exponential () (ExplicitExp elems)) =
let ((ct', var'), elems') = mapAccumL (printExp Build.fromText) (ct, var) elems
in ((ct', var'), "{" <> sepFold ", " id elems' <> "}")
printFactor (ct, var) (Exponential () (FiniteNatExp size)) =
let ((ct', var'), elems') = mapAccumL (printExp Build.decimal) (ct, var) (take size [(0 :: Int)..])
in ((ct', var'), "{" <> sepFold ", " id elems' <> "}")
printExp :: (a -> Build.Builder) -> (Int, Int) -> a -> ((Int, Int), Build.Builder)
printExp toBuilder (ct, var) elem = ((ct, var + 1), toBuilder elem <> ": " <> snd (edges !! var))
printFactor :: (Int, [(Label Polynomial, Build.Builder)])
-> Factor ()
-> ((Int, [(Label Polynomial, Build.Builder)]), Build.Builder)
printFactor (ct, edges) (Const IntSet) = ((ct + 1, edges), Build.decimal (polyF1Constants f1 VU.! ct))
printFactor (ct, edges) (Const NatSet) = ((ct + 1, edges), Build.decimal (polyF1Constants f1 VU.! ct))
printFactor (ct, edges) (Const (FiniteNatSet _)) = ((ct + 1, edges), Build.decimal (polyF1Constants f1 VU.! ct))
printFactor (ct, edges) (Const (ExplicitSet elems)) =
((ct + 1, edges), Build.fromText $ elems V.! (polyF1Constants f1 VU.! ct))
printFactor (ct, edges) (Identity ()) = ((ct, rest), snd var)
where (var, rest) = fromJust $ List.uncons edges
printFactor (ct, edges) (Exponential () (ExplicitExp elems)) =
let ((ct', edges'), elems') = mapAccumL (printExp Build.fromText) (ct, edges) elems
in ((ct', edges'), "{" <> sepFold ", " id elems' <> "}")
printFactor (ct, edges) (Exponential () (FiniteNatExp size)) =
let ((ct', edges'), elems') = mapAccumL (printExp Build.decimal) (ct, edges) (take size [(0 :: Int)..])
in ((ct', edges'), "{" <> sepFold ", " id elems' <> "}")
printExp :: (a -> Build.Builder)
-> (Int, [(Label Polynomial, Build.Builder)])
-> a
-> ((Int, [(Label Polynomial, Build.Builder)]), Build.Builder)
printExp toBuilder (ct, edges) elem = ((ct, rest), toBuilder elem <> ": " <> snd var)
where (var, rest) = fromJust $ List.uncons edges
instance ParseMorphism Polynomial where
parseMorphismPoint (Polynomial expr) = parseSum1 expr
......
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