dijkstra Subroutine

public subroutine dijkstra(graph, source, dist, prev, err)

Single-source shortest paths with non-negative edge weights.

dist(v) is the shortest distance from source to v, or GRAPH_INFINITY when v is unreachable. prev(v) is the predecessor of v on that shortest path, or GRAPH_NO_PREDECESSOR for the source and for unreachable vertices. Both outputs are allocated to the number of vertices.

prev is deterministic: see the module documentation on reproducibility. Reports ERROR_VALIDATION for a malformed or non-square adjacency matrix, an out-of-range source, or any negative edge weight; in that case both outputs come back zero-size.

Arguments

Type IntentOptional Attributes Name
type(csr_t), intent(in) :: graph

Square weighted adjacency matrix of the graph
integer(kind=default_int), intent(in) :: source

Source vertex, in 1:n
real(kind=dp), intent(out), allocatable :: dist(:)

Shortest distance to each vertex
integer(kind=default_int), intent(out), allocatable :: prev(:)

Predecessor of each vertex on its shortest path
type(error_t), intent(out), optional :: err

Calls

proc~~dijkstra~~CallsGraph proc~dijkstra dijkstra proc~check_graph check_graph proc~dijkstra->proc~check_graph proc~check_weights check_weights proc~dijkstra->proc~check_weights proc~csr_n_rows csr_t%csr_n_rows proc~dijkstra->proc~csr_n_rows proc~distance_key distance_key proc~dijkstra->proc~distance_key proc~heap_destroy heap_t%heap_destroy proc~dijkstra->proc~heap_destroy proc~heap_init heap_t%heap_init proc~dijkstra->proc~heap_init proc~heap_is_empty heap_t%heap_is_empty proc~dijkstra->proc~heap_is_empty proc~heap_pop heap_t%heap_pop proc~dijkstra->proc~heap_pop proc~heap_push heap_t%heap_push proc~dijkstra->proc~heap_push proc~check_graph->proc~csr_n_rows proc~csr_is_valid csr_t%csr_is_valid proc~check_graph->proc~csr_is_valid proc~csr_n_cols csr_t%csr_n_cols proc~check_graph->proc~csr_n_cols proc~fail fail proc~check_graph->proc~fail proc~csr_nnz csr_t%csr_nnz proc~check_weights->proc~csr_nnz proc~check_weights->proc~fail proc~heap_reserve heap_t%heap_reserve proc~heap_init->proc~heap_reserve proc~root_entry root_entry proc~heap_pop->proc~root_entry proc~sift_down sift_down proc~heap_pop->proc~sift_down proc~heap_capacity heap_t%heap_capacity proc~heap_push->proc~heap_capacity proc~heap_push->proc~heap_reserve proc~sift_up sift_up proc~heap_push->proc~sift_up proc~fail~3 fail proc~csr_is_valid->proc~fail~3 proc~error_set error_t%error_set proc~fail->proc~error_set proc~heap_reserve->proc~heap_capacity proc~grow_int32 grow_int32 proc~heap_reserve->proc~grow_int32 proc~grow_int64 grow_int64 proc~heap_reserve->proc~grow_int64 proc~root_entry->proc~error_set proc~precedes precedes proc~sift_down->proc~precedes proc~swap_entries swap_entries proc~sift_down->proc~swap_entries proc~sift_up->proc~precedes proc~sift_up->proc~swap_entries proc~fail~3->proc~error_set

Variables

Type Visibility Attributes Name Initial
real(kind=dp), private :: candidate
real(kind=dp), private :: dist_u
integer(kind=default_int), private :: k
integer(kind=int64), private :: key
integer(kind=default_int), private :: n
integer(kind=int32), private :: payload
type(heap_t), private :: queue
logical, private, allocatable :: settled(:)
integer(kind=default_int), private :: u
integer(kind=default_int), private :: v

Source Code

   subroutine dijkstra(graph, source, dist, prev, err)
      !! Single-source shortest paths with non-negative edge weights.
      !!
      !! `dist(v)` is the shortest distance from `source` to `v`, or
      !! `GRAPH_INFINITY` when `v` is unreachable. `prev(v)` is the
      !! predecessor of `v` on that shortest path, or `GRAPH_NO_PREDECESSOR`
      !! for the source and for unreachable vertices. Both outputs are
      !! allocated to the number of vertices.
      !!
      !! `prev` is deterministic: see the module documentation on
      !! reproducibility. Reports `ERROR_VALIDATION` for a malformed or
      !! non-square adjacency matrix, an out-of-range `source`, or any
      !! negative edge weight; in that case both outputs come back zero-size.
      type(csr_t), intent(in) :: graph
         !! Square weighted adjacency matrix of the graph
      integer(default_int), intent(in) :: source
         !! Source vertex, in `1:n`
      real(dp), allocatable, intent(out) :: dist(:)
         !! Shortest distance to each vertex
      integer(default_int), allocatable, intent(out) :: prev(:)
         !! Predecessor of each vertex on its shortest path
      type(error_t), intent(out), optional :: err

      type(heap_t) :: queue
      logical, allocatable :: settled(:)
      integer(default_int) :: n, u, v, k
      integer(int64) :: key
      integer(int32) :: payload
      real(dp) :: dist_u, candidate

      if (.not. check_graph(graph, source, err)) then
         allocate (dist(0))
         allocate (prev(0))
         return
      end if
      if (.not. check_weights(graph, err)) then
         allocate (dist(0))
         allocate (prev(0))
         return
      end if

      n = graph%n_rows()
      allocate (dist(n))
      allocate (prev(n))
      allocate (settled(n))
      dist = GRAPH_INFINITY
      prev = GRAPH_NO_PREDECESSOR
      settled = .false.

      dist(source) = 0.0_dp
      call queue%init(n)
      call queue%push(distance_key(0.0_dp), int(source, int32))

      do while (.not. queue%is_empty())
         call queue%pop(key, payload)
         u = int(payload, default_int)
         if (settled(u)) cycle
         settled(u) = .true.
         dist_u = dist(u)
         do k = graph%row_ptr(u), graph%row_ptr(u + 1) - 1
            v = graph%col_idx(k)
            candidate = dist_u + graph%values(k)
            if (candidate < dist(v)) then
               dist(v) = candidate
               prev(v) = u
               call queue%push(distance_key(candidate), int(v, int32))
            end if
         end do
      end do

      call queue%destroy()
   end subroutine dijkstra