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
61868820
Commit
61868820
authored
Mar 09, 2019
by
Hans-Peter Deifel
Browse files
Integrate SumBag into MonoidValued implementation
This was the intention all along.
parent
29cebc6c
Changes
1
Pipelines
1
Hide whitespace changes
Inline
Side-by-side
src/Copar/Functors/MonoidValued.hs
View file @
61868820
...
...
@@ -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
))
...
...
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