Skip to content

Commit

Permalink
added the ability to call a user-defined function in a bfs of the dag
Browse files Browse the repository at this point in the history
Fixes #12
  • Loading branch information
jacobwilliams committed Dec 31, 2023
1 parent 966eef8 commit 6b49fa7
Show file tree
Hide file tree
Showing 2 changed files with 105 additions and 2 deletions.
81 changes: 81 additions & 0 deletions src/dag_module.F90
Original file line number Diff line number Diff line change
Expand Up @@ -83,6 +83,7 @@ module dag_module
procedure,public :: remove_edge => dag_remove_edge
procedure,public :: remove_vertex => dag_remove_node
procedure,public :: toposort => dag_toposort
procedure,public :: traverse => dag_traverse
procedure,public :: generate_digraph => dag_generate_digraph
procedure,public :: generate_dependency_matrix => dag_generate_dependency_matrix
procedure,public :: save_digraph => dag_save_digraph
Expand All @@ -94,6 +95,20 @@ module dag_module

end type dag

abstract interface
subroutine traverse_func(ivertex,stop,iedge)
!! user-provided function for traversing a dag.
import :: ip
implicit none
integer(ip),intent(in) :: ivertex !! vertex number
logical,intent(out) :: stop !! set to true to stop the process
integer(ip),intent(in),optional :: iedge !! edge index for this vertex
!! (note: not the vertex number,
!! the index in the array of edge vertices)
!! [not present if this is the starting node]
end subroutine traverse_func
end interface

contains
!*******************************************************************************

Expand Down Expand Up @@ -625,6 +640,72 @@ end subroutine dfs
end subroutine dag_toposort
!*******************************************************************************

!*******************************************************************************
!>
! depth-first graph traversal of the dag.
!
! This will visit each node in the graph once, and call the `userfunc`.
! If some nodes are not connected to `ivertex`, then they will not be visited.
!
!@todo Should also add a bfs option.

subroutine dag_traverse(me,ivertex,userfunc)

class(dag),intent(inout) :: me
integer(ip),intent(in) :: ivertex !! the vertex number to start on
procedure(traverse_func) :: userfunc !! a user-provided function that will
!! be called for each vertex/edge combination

if (me%n==0) return ! nothing to do
if (ivertex<0 .or. ivertex>me%n) error stop 'invalid vertex number in dag_traverse'

! initialize internal variables, in case
! we have called this routine before.
call me%init_internal_vars()

call dfs(ivertex)

contains

recursive subroutine dfs(ivertex,iedge)
!! depth-first graph traversal
integer(ip),intent(in) :: ivertex !! the vertex
integer(ip),intent(in),optional :: iedge !! the edge index for this vertex
if (present(iedge)) then ! visiting an edge
associate ( v => me%vertices(me%vertices(ivertex)%edges(iedge)%ivertex) )
if (done(v,ivertex,iedge)) return
end associate
else ! the starting node, no edge
associate ( v => me%vertices(ivertex) )
if (done(v,ivertex,iedge)) return
end associate
end if
end subroutine dfs

recursive function done(v,iv,ie) result(user_stop)
!! process this vertex in the [[dfs]] and return true if done.
type(vertex),intent(inout) :: v !! vertex to process
logical :: user_stop !! if the user has signaled to stop
integer(ip),intent(in) :: iv !! the vertex number
integer(ip),intent(in),optional :: ie !! the edge index for this vertex (if this is an edge)
integer(ip) :: jedge !! edge counter
if (v%marked) return ! this one has already been visited
v%marked = .true. !
! call the user's function for this node/edge combo:
call userfunc(iv,user_stop,ie)
if (.not. user_stop) then ! continue traversing
if (allocated(v%edges)) then
do jedge = 1,size(v%edges)
call dfs(v%ivertex,jedge)
if (user_stop) return
end do
end if
end if
end function done

end subroutine dag_traverse
!*******************************************************************************

!*******************************************************************************
!>
! Generate a Graphviz digraph structure for the DAG.
Expand Down
26 changes: 24 additions & 2 deletions test/dag_example.f90
Original file line number Diff line number Diff line change
Expand Up @@ -17,8 +17,6 @@ program dag_example
integer(ip),parameter :: n_nodes = 7
character(len=*),parameter :: filetype = 'pdf' !! filetype for output plot ('pdf', png', etc.)

! TODO combine set_edges and set_vertex_info into one routine maybe.

call d%set_vertices(n_nodes)
call d%set_edges(2_ip,[1_ip]) !2 depends on 1
call d%set_edges(3_ip,[5_ip,1_ip]) !3 depends on 5 and 1
Expand Down Expand Up @@ -61,15 +59,23 @@ program dag_example
write(*,'(A)') ''
end do

! traverse the dag and print something:
write(*,*) ''
write(*,*) 'Traverse the DAG starting with node 3:'
call d%traverse(3_ip, traverse)

! test removing a node:
write(*,*) ''
call d%remove_vertex(5_ip)
call save_plot('test1_5-removed')

! test removing an edge:
write(*,*) ''
call d%remove_edge(5_ip,4_ip) ! the orignal node 6 is now 5
call save_plot('test1_node-5-removed_6-4-edge-removed')

! test adding an edge:
write(*,*) ''
call d%add_edge(ivertex=5_ip,iedge=1_ip, &
label='added',&
attributes='penwidth=2,arrowhead=none,color=red')
Expand All @@ -81,6 +87,7 @@ program dag_example
contains

subroutine save_plot(filename)
!! save the plot of the dag
character(len=*),intent(in) :: filename
call d%save_digraph(filename//'.dot','RL',300_ip)
call execute_command_line('cat '//filename//'.dot')
Expand All @@ -89,5 +96,20 @@ subroutine save_plot(filename)
filename//'.dot')
end subroutine save_plot

subroutine traverse(ivertex,stop,iedge)
!! a function to call for each node of the dag
integer(ip),intent(in) :: ivertex !! vertex number
logical,intent(out) :: stop !! set to true to stop the process
integer(ip),intent(in),optional :: iedge !! edge index for this vertex
if (present(iedge)) then
associate( edges => d%get_edges(ivertex))
write(*,'(a,1x,i2,1x,a,i2)') 'edge: ', ivertex, '->', edges(iedge)
end associate
else
write(*,'(a,1x,i2)') 'node: ', ivertex
end if
stop = .false.
end subroutine traverse

end program dag_example
!*******************************************************************************

0 comments on commit 6b49fa7

Please sign in to comment.