FIRST COMMIT: bestPartition, ok

LICENSE

+Copyright Alexandre Delanoë (c) 2016
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Alexandre Delanoë nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
\ No newline at end of file

Setup.hs

+import Distribution.Simple
+main = defaultMain

app/Main.hs

+module Main where
+
+import Lib
+
+main :: IO ()
+main = someFunc

louvain.cabal

+name:                louvain
+version:             0.1.0.0
+synopsis:            Graph Clustering
+description:         Please see README.md
+homepage:            https://github.com/adelanoe/louvain#readme
+license:             BSD3
+license-file:        LICENSE
+author:              Alexandre Delanoë
+maintainer:          alexandre+dev@delanoe.org
+copyright:           Copyright: (c) 2016 Alexandre Delanoë
+category:            Data
+build-type:          Simple
+-- extra-source-files:
+cabal-version:       >=1.10
+
+library
+  hs-source-dirs:      src
+  exposed-modules:     Data.Louvain
+  build-depends:       base >= 4.7 && < 5
+                       , fgl
+  default-language:    Haskell2010
+
+-- executable louvain-exe
+--   hs-source-dirs:      app
+--   main-is:             Main.hs
+--   ghc-options:         -threaded -rtsopts -with-rtsopts=-N
+--   build-depends:       base
+--                      , louvain
+--   default-language:    Haskell2010
+-- 
+-- test-suite louvain-test
+--   type:                exitcode-stdio-1.0
+--   hs-source-dirs:      test
+--   main-is:             Spec.hs
+--   build-depends:       base
+--                      , louvain
+--   ghc-options:         -threaded -rtsopts -with-rtsopts=-N
+--   default-language:    Haskell2010
+-- 
+-- source-repository head
+--   type:     git
+--   location: https://github.com/adelanoe/louvain

src/Data/Louvain.hs

+module Data.Louvain where
+
+import Data.List (maximumBy)
+import Data.Graph.Inductive
+import qualified Data.Set as S
+
+
+label' :: (Graph gr) => gr a b -> Edge -> Maybe b
+label' gr (u,v) = lookup v (lsuc gr u)
+
+shortest_path :: (Real b, Graph gr) => gr a b -> Node -> Node -> Path
+shortest_path graph node_1 node_2= sp node_1 node_2 graph
+
+
+mkGraph' :: [LEdge b] -> Gr () b
+mkGraph' es = mkGraph ns es
+    where
+        ns :: [LNode ()]
+        ns = zip [1.. (fromIntegral . length) ns'] (repeat ())
+            where ns' = S.toList . S.fromList $ concat (Prelude.map edge2nodes es)
+
+
+
+edge2nodes :: LEdge b -> [Node]
+edge2nodes (a,b,_) = [a,b]
+
+
+eU :: [LEdge Double]
+eU = [
+     (2,1,1)
+    ,(1,2,1)
+    
+    ,(1,4,1)
+    ,(4,1,1)
+    
+    ,(2,3,1)
+    ,(3,2,1)
+    
+    ,(3,4,1)
+    ,(4,3,1)
+    
+    ,(4,5,1)
+    ,(5,4,1)
+    ]
+
+eD :: [LEdge Double]
+eD = [
+     (2,1,1)
+    
+    ,(1,4,1)
+    
+    ,(2,3,1)
+    
+    ,(3,4,1)
+    
+    ,(4,5,1)
+    ]
+
+gU :: Gr () Double
+gU = mkGraph' eU
+
+-- > prettyPrint gU
+-- 1:()->[(1,2),(1,4)]
+-- 2:()->[(1,1),(1,3)]
+-- 3:()->[(1,2),(1,4)]
+-- 4:()->[(1,1),(1,3),(1,5)]
+-- 5:()->[(1,4)]
+
+-- Visual representation:
+-- 
+--    2
+--   / \
+--  1   3
+--   \ /
+--    4
+--    |
+--    5
+-- 
+-- 
+
+gD :: Gr () Double
+gD = mkGraph' eD
+
+eD' :: [LEdge Double]
+eD' = [
+     (2,1,1)
+    
+    ,(1,4,1)
+    
+    ,(2,3,1)
+    
+    ,(3,4,1)
+    
+    ,(4,5,1)
+    ,(5,6,1)
+    ,(5,7,1)
+    ,(6,7,1)
+    ]
+gD' :: Gr () Double
+gD' = mkGraph' eD'
+
+
+type Modularity = Double
+
+rotate :: Int -> [a] -> [a]
+rotate _ [] = []
+rotate n xs = zipWith const (drop n (cycle xs)) xs
+
+takeDrop :: Int -> [a] -> [[a]]
+takeDrop n xs = [ (take n xs), drop n xs]
+
+-- http://stackoverflow.com/questions/35388734/list-partitioning-implemented-recursively
+separate :: [a] -> [[[a]]]
+separate [] = [[]]
+separate (x:xs) = let recur = separate xs
+                      split = do
+                        partition <- recur
+                        return $ [x] : partition
+                      noSplit = do
+                        (y:ys) <- recur
+                        return $ (x:y):ys
+                  in split ++ noSplit
+
+gpartition :: DynGraph gr => gr a b -> [[[Node]]]
+gpartition gr = separate (nodes gr)
+
+modularities :: DynGraph gr => gr a b -> [[Node]] -> Double
+modularities gr xs = sum $ Prelude.map (\y -> modularity gr y) xs
+
+
+compareModularity :: DynGraph gr => gr a b -> [[Node]] -> [[Node]] -> Ordering
+compareModularity gr xs ys
+    | modularities gr xs < modularities gr ys = LT
+    | modularities gr xs > modularities gr ys = GT
+    | otherwise = EQ
+
+
+bestPartition :: DynGraph gr => gr a b -> [[Node]]
+bestPartition gr = maximumBy (compareModularity gr) $ gpartition gr
+
+
+modularity :: DynGraph gr => gr a b -> [Node] -> Double
+modularity gr ns = coverage - edgeDensity
+    where
+        coverage :: Double
+        coverage  = sizeSubGraph / sizeAllGraph 
+            where
+                sizeSubGraph :: Double
+                sizeSubGraph = fromIntegral ( size $ subgraph ns gr )
+
+                sizeAllGraph :: Double
+                sizeAllGraph = fromIntegral (size gr)
+
+        edgeDensity :: Double
+        edgeDensity = (sum (Prelude.map (\node -> (degree node) / links ) ns)) ** 2
+            where
+                degree :: Node -> Double
+                degree node = fromIntegral (deg gr node)
+
+                links :: Double
+                links       = fromIntegral (2 * (size gr))
+

src/Lib.hs

+module Lib
+    ( someFunc
+    ) where
+
+someFunc :: IO ()
+someFunc = putStrLn "someFunc"

stack.yaml

+# This file was automatically generated by 'stack init'
+# 
+# Some commonly used options have been documented as comments in this file.
+# For advanced use and comprehensive documentation of the format, please see:
+# http://docs.haskellstack.org/en/stable/yaml_configuration/
+
+# Resolver to choose a 'specific' stackage snapshot or a compiler version.
+# A snapshot resolver dictates the compiler version and the set of packages
+# to be used for project dependencies. For example:
+# 
+# resolver: lts-3.5
+# resolver: nightly-2015-09-21
+# resolver: ghc-7.10.2
+# resolver: ghcjs-0.1.0_ghc-7.10.2
+# resolver:
+#  name: custom-snapshot
+#  location: "./custom-snapshot.yaml"
+resolver: lts-6.9
+
+# User packages to be built.
+# Various formats can be used as shown in the example below.
+# 
+# packages:
+# - some-directory
+# - https://example.com/foo/bar/baz-0.0.2.tar.gz
+# - location:
+#    git: https://github.com/commercialhaskell/stack.git
+#    commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
+# - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a
+#   extra-dep: true
+#  subdirs:
+#  - auto-update
+#  - wai
+# 
+# A package marked 'extra-dep: true' will only be built if demanded by a
+# non-dependency (i.e. a user package), and its test suites and benchmarks
+# will not be run. This is useful for tweaking upstream packages.
+packages:
+- '.'
+- /home/alexandre/local/logiciels/haskell/graph/fgl
+
+  # Dependency packages to be pulled from upstream that are not in the resolver
+# (e.g., acme-missiles-0.3)
+extra-deps: []
+
+# Override default flag values for local packages and extra-deps
+flags: {}
+
+# Extra package databases containing global packages
+extra-package-dbs: []
+
+# Control whether we use the GHC we find on the path
+# system-ghc: true
+# 
+# Require a specific version of stack, using version ranges
+# require-stack-version: -any # Default
+# require-stack-version: ">=1.1"
+# 
+# Override the architecture used by stack, especially useful on Windows
+# arch: i386
+# arch: x86_64
+# 
+# Extra directories used by stack for building
+# extra-include-dirs: [/path/to/dir]
+# extra-lib-dirs: [/path/to/dir]
+# 
+# Allow a newer minor version of GHC than the snapshot specifies
+# compiler-check: newer-minor

test/Spec.hs

+main :: IO ()
+main = putStrLn "Test suite not yet implemented"