packages feed

hgraph-1.10.0.0: tests/Digraph/Generator.hs

module Main where

import HGraph.Directed
import HGraph.Directed.Generator.Hereditary
import HGraph.Utils
import qualified HGraph.Directed.AdjacencyMap as AM
import qualified Data.Set as S
import qualified Data.Map as M
import Data.Maybe
import Data.List

import Test.HUnit hiding (Node)
import System.Exit (exitFailure, exitSuccess)

tests = TestList 
  [ TestLabel "One arc, two vertices" $ TestCase
    ( do
      ds <- do
        gen <- enumerateParallel' 
                 (\d v -> let d1 = addVertex v d
                          in
                          if v == 0 then
                             [d1]
                          else
                             [ addArc a d1
                             | u <- vertices d
                             , a <- [(v,u), (u,v)]
                             ]
                 )
                 [AM.emptyDigraph]
                 [0, 1]
        let loop = do
                   md <- gen
                   case md of
                     Just d -> do
                       ds <- loop
                       return $ d : ds
                     Nothing -> return []
        loop
      assertEqual "one arc"
        [0, 1]
        (map numArcs ds)
    )
  , TestLabel "9" $ TestCase
    ( do
      ds <- do
        gen <- enumerateParallel' 
                 (\d v -> let d1 = addVertex v d
                          in
                          case v of 
                            0 -> [d1]
                            1 ->
                              let [u] = vertices d
                              in
                              [ addArc (u,v) d1
                              --, addArc (v,u) d1
                              , d1
                              ]
                            2 ->
                              case arcs d of
                                [(u,w)] ->
                                  [-- addArc (w, v) d1
                                  --, addArc (v, w) d1
                                  --, addArc (u, v) d1
                                  --, addArc (v, u) d1
                                   addArc (u, v) $ addArc (w, v) d1
                                  --, addArc (v, u) $ addArc (v, w) d1
                                  , addArc (v, u) $ addArc (w, v) d1
                                  --, addArc (v, w) $ addArc (u, v) d1
                                  --, addArc (v, u) $ addArc (w, v) d1
                                  ]
                                [] ->
                                  let [u,w] = vertices d
                                  in
                                  [ addArc (w, v) d1
                                  --, addArc (v, w) d1
                                  --, addArc (u, v) d1
                                  --, addArc (v, u) d1
                                  , addArc (u, v) $ addArc (w, v) d1
                                  , addArc (v, u) $ addArc (v, w) d1
                                  , addArc (u, v) $ addArc (v, w) d1
                                  , addArc (v, u) $ addArc (w, v) d1
                                  , addArc (v, w) $ addArc (u, v) d1
                                  ]
                 )
                 [AM.emptyDigraph]
                 [0, 1, 2]
        let loop = do
                   md <- gen
                   case md of
                     Just d -> do
                       ds <- loop
                       return $ d : ds
                     Nothing -> return []
        loop
      assertEqual "count"
        9
        (length ds)
    )
  , TestLabel "oriented digraphs with at most 3 vertices" $ TestCase
    ( do
      ds <- do
        gen <- enumerateParallel'
                 (\d v -> let d1 = addVertex v d
                          in
                          if v == 0 then
                             [d1]
                          else
                             [ foldr addArc d1 as'
                             | k <- [0.. numVertices d]
                             , neighbors <- choose k $ vertices d
                             , as' <- orientations $ map (\u -> (v, u)) neighbors
                             ]
                 )
                 [AM.emptyDigraph]
                 [0, 1, 2]
        let loop = do
                   md <- gen
                   case md of
                     Just d -> do
                       ds <- loop
                       return $ d : ds
                     Nothing -> return []
        loop
      assertEqual "count"
        10
        (length ds)
    )
  , TestLabel "max indegree and outdegree 1" $ TestCase
    ( do
      ds <- do
        gen <- enumerateParallel'
                 (\d v -> let d1 = addVertex v d
                              possibleInneighbors  = filter (\u -> outdegree d u == 0) $ vertices d
                              possibleOutneighbors = filter (\u -> indegree  d u == 0) $ vertices d
                              ds' = [ foldr addArc d1 as'
                                    | k <- [0.. length possibleInneighbors]
                                    , neighbors <- choose k $ possibleInneighbors
                                    , let as' = map (\u -> (u, v)) neighbors
                                    ]
                          in
                          if v == 0 then
                             [d1]
                          else
                             ds'
                             ++
                             [ addArc (v, outNeighbor) d'
                             | outNeighbor <- possibleOutneighbors
                             , d' <- ds'
                             ]
                 )
                 [AM.emptyDigraph]
                 [0, 1, 2]
        exhaust gen
      assertEqual "arcs"
        [0, 0, 0, 1, 1, 2, 2, 2, 2, 3, 3]
        (sort $ map numArcs ds)
      assertEqual "count"
        11
        (length ds)
    )
    , TestLabel "empty" $ TestCase
    ( do
      ds <- do
        gen <- enumerateParallel 
                 (\d v -> let d1 = addVertex v d
                          in 
                          if v == 0 then
                             [d1]
                          else if v == 1 then
                             let [u] = vertices d
                             in [ -- addArc (v,u) $ addArc (u,v) $ d1
                                 addArc (u,v) $ d1
                                --, addArc (v, u) $ d1
                                ]
                          else if v == 2 then
                            if numArcs d == 1 then
                               let [u] = filter (\u -> outdegree d u == 0) $ vertices d
                                   [w] = filter (\u -> indegree d u == 0)  $ vertices d
                               in [ addArc (u, v) d1
                                  , addArc (v, w) $ addArc (u, v) d1
                                  ]
                            else
                               []
                          else
                             []
                 )
                 [AM.emptyDigraph :: AM.Digraph Int]
                 [0, 1, 2]
        let loop = do
                   md <- gen
                   case md of
                     Just d -> do
                       ds <- loop
                       return $ d : ds
                     Nothing -> return []
        loop
      assertEqual "count"
        4
        (length ds)
    )
  ]

orientations :: [(a,a)] -> [[(a,a)]]
orientations [] = [[]]
orientations ((v,u) : es) = 
  let orientations' = orientations es
  in ( map ((v,u) : ) orientations') ++ ( map ((u,v) : ) orientations')

main = do 
  count <- runTestTT tests
  if errors count + failures count > 0 then exitFailure else exitSuccess