add_self_loops Module Subroutine

module subroutine add_self_loops(this, indices, weight, features)

Interface for adding self-loops to the graph.

Arguments

Type IntentOptional Attributes Name
class(graph_type), intent(inout) :: this

Parent. Instance of the graph structure.

integer, intent(in), optional, dimension(:) :: indices

Indices of the vertices to which self-loops are added.

real(kind=real32), intent(in), optional :: weight

Weight of the self-loop. Default is 1.0.

real(kind=real32), intent(in), optional, dimension(:) :: features

Feature vector of the self-loop. Default is empty.


Source Code

  module subroutine add_self_loops(this, indices, weight, features)
    !! Interface for adding self-loops to the graph.
    implicit none

    ! Arguments
    class(graph_type), intent(inout) :: this
    !! Parent. Instance of the graph structure.
    integer, dimension(:), intent(in), optional :: indices
    !! Indices of the vertices to which self-loops are added.
    real(real32), intent(in), optional :: weight
    !! Weight of the self-loop. Default is 1.0.
    real(real32), dimension(:), intent(in), optional :: features
    !! Feature vector of the self-loop. Default is empty.

    ! Local variables
    integer :: i
    !! Loop index.
    real(real32) :: weight_
    !! Weight of the self-loop.
    real(real32), dimension(:), allocatable :: features_
    !! Feature vector of the self-loop.

    ! Validate graph has vertices
    if(.not. allocated(this%vertex) .and. .not. allocated(this%vertex_features))then
       call stop_program('Cannot add self-loops to graph with no vertices')
    end if
    
    ! Handle feature vector
    if(present(features))then
       if(size(features) .ne. 1 .and. size(features) .ne. this%num_edge_features)then
          call stop_program('Feature vector size does not match edge features')
       end if
       features_ = features
    else
       allocate(features_(this%num_edge_features), source=0._real32)
    end if

    weight_ = 1._real32
    if(present(weight)) weight_ = weight

    ! Add self-loops to specified vertices
    if(present(indices))then
       do i = 1, size(indices)
          if(indices(i) .le. 0 .or. indices(i) .gt. this%num_vertices)then
             call stop_program('Vertex index out of bounds for self-loop')
          end if
          
          ! Check if self-loop already exists
          if(this%is_sparse .and. allocated(this%adj_ja))then
             if( any( &
                  this%adj_ja( &
                       1, this%adj_ia(indices(i)):this%adj_ia(indices(i)+1)-1 &
                  ) .eq. indices(i) &
             ) )then
                write(0,*) 'Self-loop already exists for vertex', indices(i)
                cycle
             end if
          elseif(allocated(this%adjacency))then
             if(this%adjacency(indices(i), indices(i)) /= 0)then
                write(0,*) 'Self-loop already exists for vertex', indices(i)
                cycle
             end if
          end if
          
          call this%add_edge(index=[indices(i), indices(i)], &
                             weight=weight_, feature=features_, &
                             update_adjacency=.false.)
       end do
    else
       do i = 1, this%num_vertices
          if(this%is_sparse.and.allocated(this%adj_ja))then
             if(any(this%adj_ja(1,this%adj_ia(i):this%adj_ia(i+1)-1) .eq. i))then
                write(0,*) 'Self-loop already exists for vertex', i
                cycle
             end if
          elseif(allocated(this%adjacency))then
             if(this%adjacency(i, i) .ne. 0)then
                write(0,*) 'Self-loop already exists for vertex', indices(i)
                cycle
             end if
          end if
          call this%add_edge( &
               index=[i, i], &
               weight=weight_, &
               feature=features_, &
               update_adjacency=.false. &
          )
       end do
    end if
    
    this%has_self_loops = .true.
    if( (this%is_sparse .and. allocated(this%adj_ja)) .or. &
         allocated(this%adjacency) &
    )then
       call this%generate_adjacency()
    end if

  end subroutine add_self_loops