Skip to content

Improve performance of graphFromEdges #1151

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 1 commit into from
Jul 5, 2025
+17 −11
Merged

Improve performance of graphFromEdges #1151

Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
28 changes: 17 additions & 11 deletions containers/src/Data/Graph.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -126,7 +126,6 @@ import Data.Foldable as F
import qualified Data.Foldable1 as F1
#endif
import Control.DeepSeq (NFData(rnf),NFData1(liftRnf))
import Data.Maybe
import Data.Array
#if USE_UNBOXED_ARRAYS
import qualified Data.Array.Unboxed as UA
Expand Down Expand Up @@ -523,23 +522,30 @@ graphFromEdges edges0
max_v = length edges0 - 1
bounds0 = (0,max_v) :: (Vertex, Vertex)
sorted_edges = L.sortBy lt edges0
edges1 = zipWith (,) [0..] sorted_edges

graph = array bounds0 [(,) v (mapMaybe key_vertex ks) | (,) v (_, _, ks) <- edges1]
key_map = array bounds0 [(,) v k | (,) v (_, k, _ ) <- edges1]
vertex_map = array bounds0 edges1
graph = listArray bounds0 [keysToVertices ks | (_, _, ks) <- sorted_edges]
key_map = listArray bounds0 [k | (_, k, _) <- sorted_edges]
vertex_map = listArray bounds0 sorted_edges

(_,k1,_) `lt` (_,k2,_) = k1 `compare` k2

-- key_vertex :: key -> Maybe Vertex
-- returns Nothing for non-interesting vertices
key_vertex k = findVertex 0 max_v
keysToVertices = foldr f []
where
f k vs =
let v = keyVertexGo k
in if v < 0 then vs else v:vs

key_vertex k =
let v = keyVertexGo k
in if v < 0 then Nothing else Just v

-- Binary search. Returns -1 when not found.
keyVertexGo k = findVertex 0 max_v
where
findVertex a b | a > b
= Nothing
findVertex a b | a > b = -1
findVertex a b = case compare k (key_map ! mid) of
LT -> findVertex a (mid-1)
EQ -> Just mid
EQ -> mid
GT -> findVertex (mid+1) b
where
mid = a + (b - a) `div` 2
Expand Down