The Floyd–Warshall algorithm is an algorithm for finding shortest paths in a weighted graph with positive or negative edge weights.




Task
Find the lengths of the shortest paths between all pairs of vertices of the given directed graph. Your code may assume that the input has already been checked for loops, parallel edges and negative cycles.


Print the pair, the distance and (optionally) the path.




Example
pair     dist    path
1 -> 2    -1     1 -> 3 -> 4 -> 2
1 -> 3    -2     1 -> 3
1 -> 4     0     1 -> 3 -> 4
2 -> 1     4     2 -> 1
2 -> 3     2     2 -> 1 -> 3
2 -> 4     4     2 -> 1 -> 3 -> 4
3 -> 1     5     3 -> 4 -> 2 -> 1
3 -> 2     1     3 -> 4 -> 2
3 -> 4     2     3 -> 4
4 -> 1     3     4 -> 2 -> 1
4 -> 2    -1     4 -> 2
4 -> 3     1     4 -> 2 -> 1 -> 3


See also
 Floyd-Warshall Algorithm - step by step guide (youtube)


module floyd_warshall_algorithm
 
  use, intrinsic :: ieee_arithmetic
 
  implicit none
 
  integer, parameter :: floating_point_kind = &
       & ieee_selected_real_kind (6, 37)
  integer, parameter :: fpk = floating_point_kind
 
  integer, parameter :: nil_vertex = 0
 
  type :: edge
     integer :: u
     real(kind = fpk) :: weight
     integer :: v
  end type edge
 
  type :: edge_list
     type(edge), allocatable :: element(:)
  end type edge_list
 
contains
 
  subroutine make_example_graph (edges)
    type(edge_list), intent(out) :: edges
 
    allocate (edges%element(1:5))
    edges%element(1) = edge (1, -2.0, 3)
    edges%element(2) = edge (3, +2.0, 4)
    edges%element(3) = edge (4, -1.0, 2)
    edges%element(4) = edge (2, +4.0, 1)
    edges%element(5) = edge (2, +3.0, 3)
  end subroutine make_example_graph
 
  function find_max_vertex (edges) result (n)
    type(edge_list), intent(in) :: edges
    integer n
 
    integer i
 
    n = 1
    do i = lbound (edges%element, 1), ubound (edges%element, 1)
       n = max (n, edges%element(i)%u)
       n = max (n, edges%element(i)%v)
    end do
  end function find_max_vertex
 
  subroutine floyd_warshall (edges, max_vertex, distance, next_vertex)
 
    type(edge_list), intent(in) :: edges
    integer, intent(out) :: max_vertex
    real(kind = fpk), allocatable, intent(out) :: distance(:,:)
    integer, allocatable, intent(out) :: next_vertex(:,:)
 
    integer :: n
    integer :: i, j, k
    integer :: u, v
    real(kind = fpk) :: dist_ikj
    real(kind = fpk) :: infinity
 
    n = find_max_vertex (edges)
    max_vertex = n
 
    allocate (distance(1:n, 1:n))
    allocate (next_vertex(1:n, 1:n))
 
    infinity = ieee_value (1.0_fpk,  ieee_positive_inf)
 
    ! Initialize.
 
    do i = 1, n
       do j = 1, n
          distance(i, j) = infinity
          next_vertex (i, j) = nil_vertex
       end do
    end do
    do i = lbound (edges%element, 1), ubound (edges%element, 1)
       u = edges%element(i)%u
       v = edges%element(i)%v
       distance(u, v) = edges%element(i)%weight
       next_vertex(u, v) = v
    end do
    do i = 1, n
       distance(i, i) = 0.0_fpk ! Distance from a vertex to itself.
       next_vertex(i, i) = i
    end do
 
    ! Perform the algorithm.
 
    do k = 1, n
       do i = 1, n
          do j = 1, n
             dist_ikj = distance(i, k) + distance(k, j)
             if (dist_ikj < distance(i, j)) then
                distance(i, j) = dist_ikj
                next_vertex(i, j) = next_vertex(i, k)
             end if
          end do
       end do
    end do
 
  end subroutine floyd_warshall
 
  subroutine print_path (next_vertex, u, v)
    integer, intent(in) :: next_vertex(:,:)
    integer, intent(in) :: u, v
 
    integer i
 
    if (next_vertex(u, v) /= nil_vertex) then
       i = u
       write (*, '(I0)', advance = 'no') i
       do while (i /= v)
          i = next_vertex(i, v)
          write (*, '('' -> '', I0)', advance = 'no') i
       end do
    end if
  end subroutine print_path
 
end module floyd_warshall_algorithm
 
program floyd_warshall_task
 
  use, non_intrinsic :: floyd_warshall_algorithm
 
  implicit none
 
  type(edge_list) :: example_graph
  integer :: max_vertex
  real(kind = fpk), allocatable :: distance(:,:)
  integer, allocatable :: next_vertex(:,:)
  integer :: u, v
 
  call make_example_graph (example_graph)
  call floyd_warshall (example_graph, max_vertex, distance, &
       &               next_vertex)
 
1000 format (1X, I0, ' -> ', I0, 5X, F4.1, 6X)
 
  write (*, '(''  pair     distance    path'')')
  write (*, '(''---------------------------------------'')')
  do u = 1, max_vertex
     do v = 1, max_vertex
        if (u /= v) then
           write (*, 1000, advance = 'no') u, v, distance(u, v)
           call print_path (next_vertex, u, v)
           write (*, '()', advance = 'yes')
        end if
     end do
  end do
 
end program floyd_warshall_task