msakai / toysolver / 548

Committed 08 Dec 2024 05:09AM UTC coverage: 69.381% (-0.1%) from 69.513%

Build # 548

Build Type

push

github

Committed by

web-flow

Commit Message

Merge f4d04f4be into b30fce672

Run Details

3 of 7 new or added lines in 1 file covered. (42.86%)

98 existing lines in 11 files now uncovered.

10070 of 14514 relevant lines covered (69.38%)

0.69 hits per line

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

76.0

/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
  , complementSimpleGraph
  , 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

-- | Complement of a graph
--
-- Note that applying it to a graph with no self-loops result in a graph with self-loops on all vertices.
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]

-- | Complement of a simple graph
--
-- It ignores self-loops in the input graph and also does not add self-loops to the output graph.
complementSimpleGraph :: EdgeLabeledGraph a -> EdgeLabeledGraph ()
complementSimpleGraph g = array (bounds g) [(node, IntMap.delete node toAllNodes IntMap.\\ outEdges) | (node, outEdges) <- assocs g]
  where
    toAllNodes = IntMap.fromAscList [(node, ()) | node <- indices g]

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

-- | An independent set of a graph is is a set of vertices such that no two vertices in the set are adjacent.
--
-- This function ignores self-loops in the input graph.
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 ()

-- | A clique of a graph is a subset of vertices such that every two distinct vertices in the clique are adjacent.
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	, complementSimpleGraph
21	, isIndependentSet
22	, isIndependentSetOf
23	, isCliqueOf
24	) where
25
26	import Control.Monad
27	import Data.Array.IArray
28	import Data.Array.ST
29	import qualified Data.IntMap.Lazy as IntMap
30	import Data.IntMap.Lazy (IntMap)
31	import qualified Data.IntSet as IntSet
32	import Data.IntSet (IntSet)
33
34	type EdgeLabeledGraph a = Array Int (IntMap a)
35
36	type Graph = EdgeLabeledGraph ()
37
38	graphToUnorderedEdges :: EdgeLabeledGraph a -> [(Int, Int, a)]
39	graphToUnorderedEdges g = do	1✔
40	(node1, nodes) <- assocs g	1✔
41	(node2, a) <- IntMap.toList $ snd $ IntMap.split node1 nodes	1✔
42	return (node1, node2, a)	1✔
43
44	graphFromUnorderedEdges :: Int -> [(Int, Int, a)] -> EdgeLabeledGraph a
45	graphFromUnorderedEdges = graphFromUnorderedEdgesWith const	×
46
47	graphFromUnorderedEdgesWith :: (a -> a -> a) -> Int -> [(Int, Int, a)] -> EdgeLabeledGraph a
48	graphFromUnorderedEdgesWith f n es = runSTArray $ do	1✔
49	a <- newArray (0, n-1) IntMap.empty	1✔
50	let ins i x l = do	1✔
51	m <- readArray a i	1✔
52	writeArray a i $! IntMap.insertWith f x l m	1✔
53	forM_ es $ \(node1, node2, a) -> do	1✔
54	ins node1 node2 a	1✔
55	ins node2 node1 a	1✔
56	return a	1✔
57
58	-- \| Complement of a graph
59	--
60	-- Note that applying it to a graph with no self-loops result in a graph with self-loops on all vertices.
61	complementGraph :: EdgeLabeledGraph a -> EdgeLabeledGraph ()
NEW 62	complementGraph g = array (bounds g) [(node, toAllNodes IntMap.\\ outEdges) \| (node, outEdges) <- assocs g]	×
63	where
NEW 64	toAllNodes = IntMap.fromAscList [(node, ()) \| node <- indices g]	×
65
66	-- \| Complement of a simple graph
67	--
68	-- It ignores self-loops in the input graph and also does not add self-loops to the output graph.
69	complementSimpleGraph :: EdgeLabeledGraph a -> EdgeLabeledGraph ()
70	complementSimpleGraph g = array (bounds g) [(node, IntMap.delete node toAllNodes IntMap.\\ outEdges) \| (node, outEdges) <- assocs g]	1✔
71	where
NEW 72	toAllNodes = IntMap.fromAscList [(node, ()) \| node <- indices g]	×
73
74	-- \| Alias of 'isIndependentSetOf'
75	{-# DEPRECATED isIndependentSet "Use isIndependentSetOf instead" #-}
76	isIndependentSet :: EdgeLabeledGraph a -> IntSet -> Bool
NEW 77	isIndependentSet = flip isIndependentSetOf	×
78
79	-- \| An independent set of a graph is is a set of vertices such that no two vertices in the set are adjacent.
80	--
81	-- This function ignores self-loops in the input graph.
82	isIndependentSetOf :: IntSet -> EdgeLabeledGraph a -> Bool
83	isIndependentSetOf s g = null $ do	1✔
84	(node1, node2, _) <- graphToUnorderedEdges g	1✔
85	guard $ node1 `IntSet.member` s	1✔
86	guard $ node2 `IntSet.member` s	1✔
87	return ()	×
88
89	-- \| A clique of a graph is a subset of vertices such that every two distinct vertices in the clique are adjacent.
90	isCliqueOf :: IntSet -> EdgeLabeledGraph a -> Bool
91	isCliqueOf s g = all (\node -> IntSet.delete node s `IntSet.isSubsetOf` IntMap.keysSet (g ! node)) (IntSet.toList s)	1✔

msakai / toysolver / 548

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