msakai / toysolver / 547

Committed 07 Dec 2024 02:57PM UTC coverage: 69.322% (-0.2%) from 69.513%

Build # 547

Build Type

push

github

Committed by

web-flow

Commit Message

Merge e2f74f4de into b30fce672

Run Details

3 of 5 new or added lines in 1 file covered. (60.0%)

113 existing lines in 10 files now uncovered.

10060 of 14512 relevant lines covered (69.32%)

0.69 hits per line

Source File
Press 'n' to go to next uncovered line, 'b' for previous

82.61

/src/ToySolver/Graph/Base.hs

{-# LANGUAGE FlexibleContexts #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  ToySolver.Graph.Base
-- Copyright   :  (c) Masahiro Sakai 2020
-- License     :  BSD-style
--
-- Maintainer  :  masahiro.sakai@gmail.com
-- Stability   :  provisional
-- Portability :  non-portable
--
-----------------------------------------------------------------------------
module ToySolver.Graph.Base
  ( EdgeLabeledGraph
  , Graph
  , graphToUnorderedEdges
  , graphFromUnorderedEdges
  , graphFromUnorderedEdgesWith
  , complementGraph
  , isIndependentSet
  , isIndependentSetOf
  , isCliqueOf
  ) where

import Control.Monad
import Data.Array.IArray
import Data.Array.ST
import qualified Data.IntMap.Lazy as IntMap
import Data.IntMap.Lazy (IntMap)
import qualified Data.IntSet as IntSet
import Data.IntSet (IntSet)

type EdgeLabeledGraph a = Array Int (IntMap a)

type Graph = EdgeLabeledGraph ()

graphToUnorderedEdges :: EdgeLabeledGraph a -> [(Int, Int, a)]
graphToUnorderedEdges g = do
  (node1, nodes) <- assocs g
  (node2, a) <- IntMap.toList $ snd $ IntMap.split node1 nodes
  return (node1, node2, a)

graphFromUnorderedEdges :: Int -> [(Int, Int, a)] -> EdgeLabeledGraph a
graphFromUnorderedEdges = graphFromUnorderedEdgesWith const

graphFromUnorderedEdgesWith :: (a -> a -> a) -> Int -> [(Int, Int, a)] -> EdgeLabeledGraph a
graphFromUnorderedEdgesWith f n es = runSTArray $ do
  a <- newArray (0, n-1) IntMap.empty
  let ins i x l = do
        m <- readArray a i
        writeArray a i $! IntMap.insertWith f x l m
  forM_ es $ \(node1, node2, a) -> do
    ins node1 node2 a
    ins node2 node1 a
  return a

complementGraph :: EdgeLabeledGraph a -> EdgeLabeledGraph ()
complementGraph g = array (bounds g) [(node, toAllNodes IntMap.\\ outEdges) | (node, outEdges) <- assocs g]
  where
    toAllNodes = IntMap.fromAscList [(node, ()) | node <- indices g]

{-# DEPRECATED isIndependentSet "Use isIndependentSetOf instead" #-}
isIndependentSet :: EdgeLabeledGraph a -> IntSet -> Bool
isIndependentSet = flip isIndependentSetOf

isIndependentSetOf :: IntSet -> EdgeLabeledGraph a -> Bool
isIndependentSetOf s g = null $ do
  (node1, node2, _) <- graphToUnorderedEdges g
  guard $ node1 `IntSet.member` s
  guard $ node2 `IntSet.member` s
  return ()

isCliqueOf :: IntSet -> EdgeLabeledGraph a -> Bool
isCliqueOf s g = all (\node -> IntSet.delete node s `IntSet.isSubsetOf` IntMap.keysSet (g ! node)) (IntSet.toList s)

1	{-# LANGUAGE FlexibleContexts #-}
2	-----------------------------------------------------------------------------
3	-- \|
4	-- Module : ToySolver.Graph.Base
5	-- Copyright : (c) Masahiro Sakai 2020
6	-- License : BSD-style
7	--
8	-- Maintainer : masahiro.sakai@gmail.com
9	-- Stability : provisional
10	-- Portability : non-portable
11	--
12	-----------------------------------------------------------------------------
13	module ToySolver.Graph.Base
14	( EdgeLabeledGraph
15	, Graph
16	, graphToUnorderedEdges
17	, graphFromUnorderedEdges
18	, graphFromUnorderedEdgesWith
19	, complementGraph
20	, isIndependentSet
21	, isIndependentSetOf
22	, isCliqueOf
23	) where
24
25	import Control.Monad
26	import Data.Array.IArray
27	import Data.Array.ST
28	import qualified Data.IntMap.Lazy as IntMap
29	import Data.IntMap.Lazy (IntMap)
30	import qualified Data.IntSet as IntSet
31	import Data.IntSet (IntSet)
32
33	type EdgeLabeledGraph a = Array Int (IntMap a)
34
35	type Graph = EdgeLabeledGraph ()
36
37	graphToUnorderedEdges :: EdgeLabeledGraph a -> [(Int, Int, a)]
38	graphToUnorderedEdges g = do	1✔
39	(node1, nodes) <- assocs g	1✔
40	(node2, a) <- IntMap.toList $ snd $ IntMap.split node1 nodes	1✔
41	return (node1, node2, a)	1✔
42
43	graphFromUnorderedEdges :: Int -> [(Int, Int, a)] -> EdgeLabeledGraph a
44	graphFromUnorderedEdges = graphFromUnorderedEdgesWith const	×
45
46	graphFromUnorderedEdgesWith :: (a -> a -> a) -> Int -> [(Int, Int, a)] -> EdgeLabeledGraph a
47	graphFromUnorderedEdgesWith f n es = runSTArray $ do	1✔
48	a <- newArray (0, n-1) IntMap.empty	1✔
49	let ins i x l = do	1✔
50	m <- readArray a i	1✔
51	writeArray a i $! IntMap.insertWith f x l m	1✔
52	forM_ es $ \(node1, node2, a) -> do	1✔
53	ins node1 node2 a	1✔
54	ins node2 node1 a	1✔
55	return a	1✔
56
57	complementGraph :: EdgeLabeledGraph a -> EdgeLabeledGraph ()
58	complementGraph g = array (bounds g) [(node, toAllNodes IntMap.\\ outEdges) \| (node, outEdges) <- assocs g]	1✔
59	where
NEW 60	toAllNodes = IntMap.fromAscList [(node, ()) \| node <- indices g]	×
61
62	{-# DEPRECATED isIndependentSet "Use isIndependentSetOf instead" #-}
63	isIndependentSet :: EdgeLabeledGraph a -> IntSet -> Bool
NEW 64	isIndependentSet = flip isIndependentSetOf	×
65
66	isIndependentSetOf :: IntSet -> EdgeLabeledGraph a -> Bool
67	isIndependentSetOf s g = null $ do	1✔
68	(node1, node2, _) <- graphToUnorderedEdges g	1✔
69	guard $ node1 `IntSet.member` s	1✔
70	guard $ node2 `IntSet.member` s	1✔
71	return ()	×
72
73	isCliqueOf :: IntSet -> EdgeLabeledGraph a -> Bool
74	isCliqueOf s g = all (\node -> IntSet.delete node s `IntSet.isSubsetOf` IntMap.keysSet (g ! node)) (IntSet.toList s)	1✔

msakai / toysolver / 547

Source File Press 'n' to go to next uncovered line, 'b' for previous

Source File
Press 'n' to go to next uncovered line, 'b' for previous