Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
Informatik 8
CoPaR
Commits
997f2047
Commit
997f2047
authored
Jul 17, 2018
by
Hans-Peter Deifel
Browse files
Clean up polynomial implementation
parent
21be6587
Changes
1
Hide whitespace changes
Inline
Side-by-side
src/MA/Functors/Polynomial.hs
View file @
997f2047
...
...
@@ -28,10 +28,10 @@ import MA.Parser.Types
newtype
Polynomial
a
=
Polynomial
(
Sum
a
)
deriving
(
Functor
)
data
Sum
a
=
Sum
(
NonEmpty
(
Product
a
))
newtype
Sum
a
=
Sum
(
NonEmpty
(
Product
a
))
deriving
(
Functor
)
data
Product
a
=
Product
(
NonEmpty
(
Factor
a
))
newtype
Product
a
=
Product
(
NonEmpty
(
Factor
a
))
deriving
(
Functor
)
data
Factor
a
...
...
@@ -39,9 +39,7 @@ data Factor a
|
Identity
a
deriving
(
Functor
)
data
Three
=
ToRest
|
ToCompound
|
ToSub
deriving
(
Show
,
Eq
,
Ord
,
Enum
)
-- Index into coproduct and corresponding product value
data
SumValue
a
=
SumValue
Int
(
ProductValue
a
)
deriving
(
Eq
,
Show
)
...
...
@@ -54,14 +52,20 @@ data FactorValue a
|
IdValue
a
deriving
(
Eq
,
Show
)
data
Three
=
ToRest
|
ToCompound
|
ToSub
deriving
(
Show
,
Eq
,
Ord
,
Enum
)
type
instance
H1
Polynomial
=
SumValue
()
type
instance
Label
Polynomial
=
Int
type
instance
Weight
Polynomial
=
SumValue
Bool
type
instance
Label
Polynomial
=
Int
-- Index of edge product (independent of
-- toplevel-sum)
type
instance
Weight
Polynomial
=
SumValue
Bool
-- H2
type
instance
H3
Polynomial
=
SumValue
Three
instance
ParseMorphism
Polynomial
where
parseMorphismPoint
(
Polynomial
expr
)
=
parseSum
expr
where
-- Coproducts
parseSum
::
MonadParser
m
=>
Sum
(
m
a
)
->
m
(
SumValue
()
,
[(
a
,
Label
Polynomial
)])
parseSum
(
Sum
summands
)
=
do
...
...
@@ -75,16 +79,20 @@ instance ParseMorphism Polynomial where
return
(
SumValue
i
h1
,
successors
)
-- Products
parseProduct
::
MonadParser
m
=>
Product
(
m
a
)
->
m
(
ProductValue
()
,
[(
a
,
Int
)])
parseProduct
(
Product
(
f
:|
fs
))
=
L
.
parens
$
do
factors
<-
(
:
)
<$>
parseFactor
f
<*>
traverse
(
\
x
->
L
.
comma
*>
parseFactor
x
)
fs
factors
<-
(
:
)
<$>
parseFactor
f
<*>
traverse
(
\
x
->
L
.
comma
*>
parseFactor
x
)
fs
let
(
h1
,
successors
)
=
unzip
factors
return
(
ProductValue
(
V
.
fromList
h1
)
,
catMaybes
(
map
(
\
(
i
,
s
)
->
fmap
(,
i
)
s
)
(
zip
[
0
..
]
s
uccessors
)
))
labeledSuccessors
=
zipWith
(
\
a
i
->
fmap
(,
i
)
a
)
successors
[
0
..
]
return
(
ProductValue
(
V
.
fromList
h1
)
,
catMaybes
labeledS
uccessors
)
-- Factors
parseFactor
::
MonadParser
m
=>
Factor
(
m
a
)
->
m
(
FactorValue
()
,
Maybe
a
)
parseFactor
(
Const
names
)
=
do
h1
<-
ConstValue
<$>
someName
names
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment