! !----------------------------------------------------! ! Module library for pairwise disjoint sets. ! !----------------------------------------------------! ! (c) 1998 - 2010, A. Migdalas @ MSCC ! ! version 0.5 @ 1999/10/25 ! !----------------------------------------------------! ! MODULE DisjointSets ! ! Implements tree representation of pairwise disjoint sets. ! The elements of the sets are integers 1,2,3,4,... ! The representation of the sets is done using an integer ! array PARENT, where PARENT(I) is the parent of the ! element I in the tree where I belongs. If I is the ! root of the tree, then PARENT(I) is .LE. 0. There are ! two cases here. If we use WEIGHTS, then PARENT(root) ! is the negative of the size of the tree. ! The module implements both versions, with WEIGHTS ! and without. However, the two versions should not ! be intermixed! ! CONTAINS !------------------------------------------------------------- ! INIT_SET ! Initialize disjoint sets, each of one element, ! and total number of elemnts equal to size. By ! setting PARENT(ROOT) = -1, it can be used to ! initialize sets that can be used both with ! WEIGHTED_FIND and SIMPLE_FIND. ! Complexity: O(n) ! SUBROUTINE init_set(parent,size) IMPLICIT NONE INTEGER :: size INTEGER, DIMENSION(size) :: parent parent = -1 END SUBROUTINE init_set !--------------------------------------------! ! SIMPLE_FIND_SET ! Returns the root of the set to which element ! belongs. Can be used both for WEIGHTED and ! UNWEIGHTED representations of the sets. ! Complexity: O(n) for the UNWEIGHTED case ! O(log(n)) for the WEIGHTED case. ! This difference on the complexity is based ! on the maximum tree depth that may result ! when using SIMPLE respectively WEIGHTED UNION. ! INTEGER FUNCTION simple_find_set(element,parent) IMPLICIT NONE INTEGER, DIMENSION(:) :: parent INTEGER :: element, i ! Search for the root following a path of parents i = element DO IF(parent(i).LE.0)THEN ! is root simple_find_set = i EXIT ELSE i = parent(i) ! move up in the tree ENDIF ENDDO END FUNCTION simple_find_set !--------------------------------------------! ! SIMPLE_UNION ! Joins two disjoint sets with ROOT1 and ROOT2 ! by making the first set a subtree of the second. ! Does not use weights. Should not be intermixed ! with weighted versions! Results in trees that ! in worst case have a depth of n. ! Complexity: O(1) ! SUBROUTINE simple_union(root1,root2,parent) IMPLICIT NONE INTEGER, DIMENSION(:) :: parent INTEGER :: root1, root2 parent(root1) = root2 END SUBROUTINE simple_union !--------------------------------------------! ! WEIGHTED_UNION ! Joins two disjoint sets with ROOT1 and ROOT2 ! by making the smallest set a subtree of the second. ! The resulting tree has a depth that is never ! more than log(n). The result is that the corresponding ! WEIGHTED_FIND has a complexity O(log(n)). ! Uses weights. Should not be intermixed ! with unweighted versions! ! Complexity: O(1) ! SUBROUTINE weighted_union(root1,root2,parent) INTEGER, DIMENSION(:) :: parent INTEGER :: root1, root2 INTEGER :: total_nodes total_nodes = parent(root1) + parent(root2) IF (parent(root1).GE.parent(root2)) THEN parent(root1) = root2 ! root2 belongs to largest set parent(root2) = total_nodes ! becomes global root ELSE parent(root2) = root1 ! root1 becomes global root parent(root1) = total_nodes ENDIF END SUBROUTINE weighted_union !--------------------------------------------! ! COLLAPSING_FIND_SET ! Returns the root of the set to which element ! bolongs. At the same time collapses the tree ! in order to reduce the longest path in it, ! giving thus a better amortized complexity for ! a sequence of FINDs. The idea is that if ! I belongs to a set with root R and ! then all Js on the path from I to R, including ! I but excluding R, get R as a PARENT, that is, ! they are hanged directly under the root R. ! COLLAPSING_FIND can be intermixed with ! SIMPLE_FIND and WEIGHTED_FIND. ! Especially usefull for the case where ! SIMPLE_UNIONs are used, since then a sequence ! of m operations result in an amortized ! complexity of O(mlogn) and not O(mn) that is ! required by SIMPLE_FINDs. ! The combination of COLLAPSING_FINDs with the ! smart WEIGHTED_UNIONs gives for m operations ! an amortized complexity that is almost linear ! in m. ! INTEGER FUNCTION collapsing_find_set(element,parent) IMPLICIT NONE INTEGER, DIMENSION(:) :: parent INTEGER :: element INTEGER :: item, root_of_set, item2 ! Search for the root following a path of parents item = element DO IF(parent(item).GT.0)THEN ! Parent is not the root item=parent(item) !Move up in the tree ELSE root_of_set = item ! Root is found EXIT ENDIF ENDDO ! Collaps the tree before return item=element ! Start with element DO WHILE(item.NE.root_of_set) ! and follow the path to the root: item2 = parent(item) ! Remember item's parent parent(item) = root_of_set ! Hang item directly under the root item = item2 ! Try next with its parent ENDDO collapsing_find_set = root_of_set END FUNCTION collapsing_find_set END MODULE DisjointSets