File Coverage

blib/lib/Graph/SomeUtils.pm

Criterion	Covered	Total	%
statement	29	50	58.0
branch	2	2	100.0
condition			n/a
subroutine	9	15	60.0
pod	10	10	100.0
total	50	77	64.9

package Graph::SomeUtils;

use 5.012000;
use strict;
use warnings;
use base qw(Exporter);
use Graph;

our $VERSION = '0.20';

our %EXPORT_TAGS = ( 'all' => [ qw(
	graph_delete_vertices_fast
  graph_delete_vertex_fast
  graph_all_successors_and_self
  graph_all_predecessors_and_self
  graph_vertices_between
  graph_get_vertex_label
  graph_set_vertex_label
  graph_isolate_vertex
  graph_delete_vertices_except
  graph_truncate_to_vertices_between
) ] );

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

our @EXPORT = qw(
);

sub graph_get_vertex_label {
  my ($g, $v) = @_;
  return $g->get_vertex_attribute($v, 'label');
}

sub graph_set_vertex_label {
  my ($g, $v, $label) = @_;
  $g->set_vertex_attribute($v, 'label', $label);
}

sub graph_delete_vertex_fast {
  my $g = shift;
  $g->expect_non_unionfind;
  my $V = $g->[ Graph::_V ];
  return $g unless $V->has_path( @_ );
  $g->delete_edge($_[0], $_) for $g->successors($_[0]);
  $g->delete_edge($_, $_[0]) for $g->predecessors($_[0]);
  $V->del_path( @_ );
  $g->[ Graph::_G ]++;
  return $g;
}

sub graph_delete_vertices_fast {
  my $g = shift;
  graph_delete_vertex_fast($g, $_) for @_;
}

sub graph_vertices_between {
  my ($g, $src, $dst) = @_;
  my %from_src;

  $from_src{$_}++ for graph_all_successors_and_self($g, $src);

  return grep {
    $from_src{$_}
  } graph_all_predecessors_and_self($g, $dst);
}

sub graph_all_successors_and_self {
  my ($g, $v) = @_;
  return ((grep { $_ ne $v } $g->all_successors($v)), $v);
}

sub graph_all_predecessors_and_self {
  my ($g, $v) = @_;
  return ((grep { $_ ne $v } $g->all_predecessors($v)), $v);
}

sub graph_isolate_vertex {
  my ($g, $vertex) = @_;
  $g->delete_edge($vertex, $_) for $g->successors($vertex);
  $g->delete_edge($_, $vertex) for $g->predecessors($vertex);
}

sub graph_delete_vertices_except {
  my ($g, @vertices) = @_;
  my %keep = map { $_ => 1 } @vertices;

  graph_delete_vertices_fast($g,
    grep { not $keep{$_} } $g->vertices);
}

sub graph_truncate_to_vertices_between {
  my ($g, $start, $final) = @_;
  graph_delete_vertices_except($g,
    graph_vertices_between($g, $start, $final));
}

1;

__END__