program kruskal_example

implicit none

integer, parameter :: pr = selected_real_kind(15,3)
integer, parameter :: n = 7 ! Number of Vertice
integer, parameter :: nr = int( ( n * n - n ) / 2 )

integer :: i,i1,j,j1,k

real(pr) :: tmp_01, tmp_02, tmp_03
real(pr), dimension(n,n) :: EdgesArray 
real(pr), dimension(nr,3) :: ReducedEdgesArray 
real(pr), dimension(n-1,3) :: MST

integer :: NbEdges
integer, dimension(n,n) :: LV

logical :: FormACycle, FoundVertice_01, FoundVertice_02
logical :: FindNewEdge

data EdgesArray / 0.0, 7.0, 0.0, 5.0, 0.0, 0.0, 0.0, &
				& 7.0, 0.0, 8.0, 9.0, 7.0, 0.0, 0.0, &
				& 0.0, 8.0, 0.0, 0.0, 5.0, 0.0, 0.0, &
				& 5.0, 9.0, 0.0, 0.0, 15.0, 6.0, 0.0, &
				& 0.0, 7.0, 5.0, 15.0, 0.0, 8.0, 9.0, &
				& 0.0, 0.0, 0.0, 6.0, 8.0, 0.0, 11.0, &
				& 0.0, 0.0, 0.0, 0.0, 9.0, 11.0, 0.0 /

!do i=1,n
!write(6,*) (EdgesArray(i,j),j=1,n)
!end do

!----------------------------------------------------------------------------------------!
! (Step 1) Data preparartion

ReducedEdgesArray = 0

k = 0
do i=2,n
do j=1,i-1
if( EdgesArray(i,j) > 0 )then
k=k+1
ReducedEdgesArray(k,1) = i
ReducedEdgesArray(k,2) = j
ReducedEdgesArray(k,3) = EdgesArray(i,j)
end if
end do
end do

!write(6,*) "Number of edges: ", k

!----------------------------------------------------------------------------------------!
! (Step2) Sort the edges in order of increasing weight 

do i=1,k
do j=1,k
if( ReducedEdgesArray(i,3) < ReducedEdgesArray(j,3) )then
tmp_01 = ReducedEdgesArray(i,1)
tmp_02 = ReducedEdgesArray(i,2)
tmp_03 = ReducedEdgesArray(i,3)
ReducedEdgesArray(i,1) = ReducedEdgesArray(j,1)
ReducedEdgesArray(i,2) = ReducedEdgesArray(j,2)
ReducedEdgesArray(i,3) = ReducedEdgesArray(j,3)
ReducedEdgesArray(j,1) = tmp_01
ReducedEdgesArray(j,2) = tmp_02
ReducedEdgesArray(j,3) = tmp_03
end if
end do
end do

!do i=1,k
!write(6,*) i, ReducedEdgesArray(i,1),ReducedEdgesArray(i,2),ReducedEdgesArray(i,3)
!end do

!----------------------------------------------------------------------------------------!
! (Step3) Kruskal's algorithm 

MST = 0 ! Initialization
NbEdges = 1
k = 1
MST(NbEdges,1) = ReducedEdgesArray(k,1) ! Min. Spanning Tree MST (First Edge)
MST(NbEdges,2) = ReducedEdgesArray(k,2) ! Min. Spanning Tree MST (First Edge)
MST(NbEdges,3) = ReducedEdgesArray(k,3) ! Min. Spanning Tree MST (First Edge)

LV = 0 ! Initialization
LV( int(MST(NbEdges,1)), int(MST(NbEdges,2)) ) = 1 ! Edges added in first passe
LV( int(MST(NbEdges,2)), int(MST(NbEdges,1)) ) = 1 ! Edges added in first passe
do i = 1, n
LV(i,i) = 1
end do

do while ( NbEdges < (n-1) ) 

k = k + 1

!write(6,*) 'k',k

!----- Check if Vertices are already connected 

FormACycle = .FALSE.
i1 = int( ReducedEdgesArray(k,1) )
j1 = int( ReducedEdgesArray(k,2) )
if( LV(i1,j1) == 1 ) FormACycle = .TRUE.

!----- Add an edge to the MST as long as 
!----- it does not form a cycle with edges added in previous passes

!write(6,*) FormACycle, ReducedEdgesArray(k,1), ReducedEdgesArray(k,2)

if( FormACycle .eqv. .FALSE. )then

  NbEdges = NbEdges + 1

  !----- Min. Spanning tree (Add an Edge)
  
  MST(NbEdges,1) = ReducedEdgesArray(k,1)
  MST(NbEdges,2) = ReducedEdgesArray(k,2)
  MST(NbEdges,3) = ReducedEdgesArray(k,3)
  
  !----- Edges added in previous passes
  
  LV( int(MST(NbEdges,1)), int(MST(NbEdges,2)) ) = 1 ! Edges added in previous passes
  LV( int(MST(NbEdges,2)), int(MST(NbEdges,1)) ) = 1 ! Edges added in previous passes

  FindNewEdge = .TRUE.
  do while ( FindNewEdge )
  FindNewEdge = .FALSE.
  do i = 1, n
	do j = 1, n
	if ( j .ne. i )then
	if ( LV(i,j) .eq. 1 )then
	  do j1 = 1, n
	  if( j1 .ne. j )then
	  if( LV(j,j1) .eq. 1 )then
	  if( LV(i,j1) .eq. 0 )then
	  LV(i,j1) = 1
	  FindNewEdge = .TRUE.
	  end if 
	  end if
	  end if
	  end do   
	end if
	end if
	end do
  end do
  end do

!do i = 1, n
!write(6,*) (LV(i,j),j=1,n)
!end do

end if

end do

write(6,*) "Minimum Spanning Tree (MST) Found: "

do i=1, n-1
write(6,*) i, MST(i,1), MST(i,2), MST(i,3)
end do

end program kruskal_example

About / Au sujet de

Created:
21 octobre 2016 03:45:27

Updated:
21 octobre 2016 03:45:27

License / Licence

MIT License

Abstract / Résumé