Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
C
clustering-louvain
Project
Project
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
1
Issues
1
List
Board
Labels
Milestones
Merge Requests
0
Merge Requests
0
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Charts
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
gargantext
clustering-louvain
Commits
2659cf0e
Commit
2659cf0e
authored
Mar 25, 2020
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[HyperGraph] mv almost done.
parent
51c26d2a
Changes
1
Show whitespace changes
Inline
Side-by-side
Showing
1 changed file
with
33 additions
and
16 deletions
+33
-16
ILouvain.hs
src/Data/Graph/Clustering/ILouvain.hs
+33
-16
No files found.
src/Data/Graph/Clustering/ILouvain.hs
View file @
2659cf0e
...
...
@@ -29,6 +29,13 @@ import Data.Graph.Inductive
type
HyperGraph
a
b
=
Gr
(
Gr
()
a
)
b
type
HyperContext
a
b
=
Context
(
Gr
()
a
)
b
toInfra
::
Gr
(
Gr
()
a
)
b
->
Gr
()
a
toInfra
=
undefined
toSupra
::
Gr
()
a
->
Gr
(
Gr
()
a
)
b
toSupra
=
undefined
-- TODO Later (hypothesis still)
-- type StreamGraph a b = Gr a (Gr () b)
------------------------------------------------------------------------
...
...
@@ -69,30 +76,40 @@ spoon = mkGraph ns es
-- mv (mv spoon [1] [4]) [4,1] [] = identity
-- Move target type
mv'
::
HyperGraph
a
a
-- let's start simple: path lenght <= 2 max
mv
::
HyperGraph
a
a
->
[
Node
]
->
[
Node
]
->
HyperGraph
a
a
mv'
g
[]
[]
=
g
mv'
g
[
_
]
[]
=
g
mv'
g
(
x
:
xs
)
[]
=
undefined
mv
g
[]
[]
=
g
mv
g
[
_
]
[]
=
g
mv
g
[]
[
_
]
=
g
mv
g
[
a
]
[
b
]
=
mv'
g
a
b
mv
g
[
a
,
b
]
[]
=
undefined
mv
g
(
x
:
xs
)
(
y
:
ys
)
=
panic
"mv path too long"
-- | Start simple (without path)
mv
::
HyperGraph
a
a
mv
'
::
HyperGraph
a
a
->
Node
->
Node
->
HyperGraph
a
a
mv
g
n1
n2
=
(
mv
Context
c1
c2
)
&
g2
mv
'
g
n1
n2
=
(
mvM
Context
c1
c2
)
&
g2
where
(
c1
,
g1
)
=
match
n1
g
(
c2
,
g2
)
=
match
n2
g1
mvContext
::
Maybe
(
HyperContext
a
b
)
->
Maybe
(
HyperContext
a
b
)
->
HyperContext
a
b
mvContext
(
Just
(
a1
,
n
,
l
,
a2
))
(
Just
(
a1'
,
n'
,
l'
,
a2'
))
=
undefined
-- (a1,n,l&l',a2)
mvContext
_
(
Just
_
)
=
panic
"First Node does not exist"
mvContext
(
Just
_
)
_
=
panic
"Snd Node does not exist"
mvContext
_
_
=
panic
"Both nodes do not exist"
mvMContext
::
Maybe
(
HyperContext
a
a
)
->
Maybe
(
HyperContext
a
a
)
->
HyperContext
a
a
mvMContext
(
Just
(
a1
,
n
,
l
,
a2
))
(
Just
(
a1'
,
n'
,
l'
,
a2'
))
=
(
a1'
,
n'
,
c'
&
l
,
a2'
)
where
c'
=
(
a1
,
n
,
()
,
a2
)
mvMContext
_
(
Just
_
)
=
panic
"First Node does not exist"
mvMContext
(
Just
_
)
_
=
panic
"Snd Node does not exist"
mvMContext
_
_
=
panic
"Both Nodes do not exist"
------------------------------------------------------------------------
-- | Recursive Node of Graph
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
Attach a 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