From 367d0d49a71a5281a7c8b731b89b131b95a72f0a Mon Sep 17 00:00:00 2001 From: Jacob Williams Date: Fri, 29 Dec 2023 21:34:49 -0600 Subject: [PATCH] added ability to remove nodes and edges Fixes #9 --- src/dag_module.f90 | 107 ++++++++++++++++++++++++++++++++++++++--- test/dag_example.f90 | 24 +++++++-- test/dag_example_3.f90 | 4 +- 3 files changed, 123 insertions(+), 12 deletions(-) diff --git a/src/dag_module.f90 b/src/dag_module.f90 index a5b6e3b..01396b3 100644 --- a/src/dag_module.f90 +++ b/src/dag_module.f90 @@ -34,6 +34,7 @@ module dag_module private generic :: set_edges => set_edge_vector_vector, add_edge procedure :: set_edge_vector_vector, add_edge + procedure :: remove_edge end type vertex type,public :: dag @@ -44,14 +45,15 @@ module dag_module !! this array if the vertex number. contains private - procedure,public :: vertex => dag_get_vertex ! not very useful for now, since all vertex attributes are private + + procedure,public :: vertex => dag_get_vertex !! not very useful for now, since + !! all vertex attributes are private procedure,public :: number_of_vertices => dag_get_number_of_vertices procedure,public :: set_vertices => dag_set_vertices - - !procedure,public :: set_edges => dag_set_edges - generic,public :: set_edges => dag_set_edges_no_atts, dag_set_edges_vector_atts - procedure :: dag_set_edges_no_atts, dag_set_edges_vector_atts - + generic,public :: set_edges => dag_set_edges_no_atts, & + dag_set_edges_vector_atts + procedure,public :: remove_edge => dag_remove_edge + procedure,public :: remove_vertex => dag_remove_node procedure,public :: set_vertex_info => dag_set_vertex_info procedure,public :: toposort => dag_toposort procedure,public :: generate_digraph => dag_generate_digraph @@ -60,7 +62,10 @@ module dag_module procedure,public :: get_edges => dag_get_edges procedure,public :: get_dependencies => dag_get_dependencies procedure,public :: destroy => dag_destroy + procedure :: init_internal_vars !! private routine to initialize some internal variables + procedure :: dag_set_edges_no_atts, dag_set_edges_vector_atts + end type dag contains @@ -150,6 +155,81 @@ subroutine add_edge(me,e,label,attributes) end subroutine add_edge !******************************************************************************* +!******************************************************************************* +!> +! remove an edge index from this vertex + + subroutine remove_edge(me,e) + + class(vertex),intent(inout) :: me + integer,intent(in) :: e + + integer,dimension(1) :: idx + type(edge),dimension(:),allocatable :: tmp + + if (allocated(me%edges)) then + idx = findloc(me%edges%ivertex, e) + if (idx(1)>0) then + ! the edge is in the list + associate (i => idx(1), n => size(me%edges)) + if (n==1) then + deallocate(me%edges) ! it's the only one there + else + allocate(tmp(n-1)) + if (i>1) tmp(1:i-1) = me%edges(1:i-1) + if (i +! Remove a node from a dag. Will also remove any edges connected to it. +! +! This will renumber the nodes and edges internally. +! Note that any default integer labels generated in +! [[dag_set_vertices]] would then be questionable. + + subroutine dag_remove_node(me,ivertex) + + class(dag),intent(inout) :: me + integer,intent(in) :: ivertex !! the node to remove + + integer :: i !! counter + type(vertex),dimension(:),allocatable :: tmp !! for resizing `me%vertices` + + if (allocated(me%vertices)) then + associate (n => size(me%vertices)) + do i = 1, n + ! first remove any edges: + call me%vertices(i)%remove_edge(ivertex) + ! next, renumber the existing edges so they will be + ! correct after ivertex is deleted + ! Example (removing 2): 1 [2] 3 4 ==> 1 2 3 + if (allocated(me%vertices(i)%edges)) then + where (me%vertices(i)%edges%ivertex>ivertex) + me%vertices(i)%edges%ivertex = me%vertices(i)%edges%ivertex - 1 + end where + end if + end do + ! now, remove the node: + allocate(tmp(n-1)) + if (ivertex>1) tmp(1:ivertex-1) = me%vertices(1:ivertex-1) + if (ivertex ! get the edges for the vertex (all of the vertices @@ -308,6 +388,21 @@ subroutine dag_set_edges_no_atts(me,ivertex,edges) end subroutine dag_set_edges_no_atts !******************************************************************************* +!******************************************************************************* +!> +! Remove an edge from a dag. + + subroutine dag_remove_edge(me,ivertex,iedge) + + class(dag),intent(inout) :: me + integer,intent(in) :: ivertex !! vertex number + integer,intent(in) :: iedge !! the edge to remove + + call me%vertices(ivertex)%remove_edge(iedge) + + end subroutine dag_remove_edge +!******************************************************************************* + !******************************************************************************* !> ! set the edges for a vertex in a dag diff --git a/test/dag_example.f90 b/test/dag_example.f90 index 2d55bda..3122291 100644 --- a/test/dag_example.f90 +++ b/test/dag_example.f90 @@ -44,10 +44,7 @@ program dag_example write(*,*) '' write(*,*) 'diagraph:' write(*,*) '' - - call d%save_digraph('test.dot','RL',300) - call execute_command_line('cat test.dot') - call execute_command_line('dot -T'//filetype//' -o test.'//filetype//' test.dot') + call save_plot('test1') write(*,*) '' write(*,*) 'dependency matrix:' @@ -64,8 +61,27 @@ program dag_example write(*,'(A)') '' end do + ! test removing a node: + call d%remove_vertex(5) + call save_plot('test1_5-removed') + + ! test removing an edge: + call d%remove_edge(5,4) ! the orignal node 6 is now 5 + call save_plot('test1_node-5-removed_6-4-edge-removed') + ! cleanup: call d%destroy() + contains + + subroutine save_plot(filename) + character(len=*),intent(in) :: filename + call d%save_digraph(filename//'.dot','RL',300) + call execute_command_line('cat '//filename//'.dot') + call execute_command_line('dot -T'//filetype//' -o '//& + filename//'.'//filetype//' '//& + filename//'.dot') + end subroutine save_plot + end program dag_example !******************************************************************************* diff --git a/test/dag_example_3.f90 b/test/dag_example_3.f90 index 7a2070a..b5ebd45 100644 --- a/test/dag_example_3.f90 +++ b/test/dag_example_3.f90 @@ -52,7 +52,7 @@ subroutine process(icase, node, dependson) integer :: i !! counter integer,dimension(1) :: idx character(len=*),parameter :: DEFAULT_EDGE = 'arrowhead=none' - character(len=*),parameter :: EDGES_TO_CUT = 'arrowhead=none,color=red' + character(len=*),parameter :: EDGES_TO_CUT = 'penwidth=2,arrowhead=none,color=red' if (icase==1) then n_nodes = n_nodes + 1 @@ -78,7 +78,7 @@ subroutine process(icase, node, dependson) edge_attributes(i) = EDGES_TO_CUT call d%set_edges(node_index(node), node_index(dependson), attributes = edge_attributes) else - call d%set_edges(node_index(node), node_index(dependson)) + call d%set_edges(node_index(node), node_index(dependson), attributes = edge_attributes) end if end if end if