File Coverage

blib/lib/Graph/Easy/Weighted.pm

Criterion	Covered	Total	%
statement	79	100	79.0
branch	25	36	69.4
condition	17	25	68.0
subroutine	11	12	91.6
pod	5	5	100.0
total	137	178	76.9

package Graph::Easy::Weighted;
our $AUTHORITY = 'cpan:GENE';

# ABSTRACT: A weighted graph implementation

our $VERSION = '0.06';

use warnings;
use strict;

use parent qw(Graph::Easy);

use Carp qw( croak );
use Readonly;
Readonly my $WEIGHT => 'weight';


sub populate {
    my ($self, $data, $attr, $format) = @_;

    # Set the default attribute.
    $attr ||= $WEIGHT;

    # What type of data are we given?
    my $data_ref = ref $data;

    if ($data_ref eq 'ARRAY' || $data_ref eq 'Math::Matrix') {
        my $vertex = 0;
        for my $neighbors (@$data) {
            $self->_from_array( $vertex, $neighbors, $attr, $format );
            $vertex++;
        }
    }
    elsif ($data_ref eq 'Math::MatrixReal') {
        my $vertex = 0;
        for my $neighbors (@{ $data->[0] }) {
            $self->_from_array( $vertex, $neighbors, $attr, $format );
            $vertex++;
        }
    }
    elsif ($data_ref eq 'HASH') {
        for my $vertex (keys %$data) {
            if ( $data->{$vertex}{attributes} ) {
                my $attributes = delete $data->{$vertex}{attributes};
                for my $attr ( keys %$attributes ) {
                    $self->set_vertex_attribute($vertex, $attr, $attributes->{$attr});
                }
            }
            $self->_from_hash( $vertex, $data->{$vertex}, $attr, $format );
        }
    }
    else {
        croak "Unknown data type: $data\n";
    }
}

sub _from_array {
    my ($self, $vertex, $neighbors, $attr, $format) = @_;

    my $vertex_weight = 0;

    for my $n (0 .. @$neighbors - 1) {
        my $w = $neighbors->[$n]; # Weight of the edge to the neighbor.
        next unless $w;

        my $edge = Graph::Easy::Edge->new();
        $edge->set_attributes(
            {
                label     => $format ? sprintf( $format, $w ) : $w,
                "x-$attr" => $w,
            }
        );

        $self->add_edge($vertex, $n, $edge);

        $vertex_weight += $w;
    }

    $self->set_vertex_attribute($vertex, "x-$attr", $vertex_weight);
}

sub _from_hash {
    my ($self, $vertex, $neighbors, $attr, $format) = @_;

    my $vertex_weight = 0;

    for my $n (keys %$neighbors) {
        my $w = $neighbors->{$n}; # Weight of the edge to the neighbor.

        my $edge = Graph::Easy::Edge->new();
        $edge->set_attributes(
            {
                label     => $format ? sprintf( $format, $w ) : $w,
                "x-$attr" => $w,
            }
        );

        $self->add_edge($vertex, $n, $edge);

        $vertex_weight += $w;
    }

    $self->set_vertex_attribute($vertex, "x-$attr", $vertex_weight);
}


sub get_cost {
    my ($self, $v, $attr) = @_;
    croak 'ERROR: No vertex given to get_cost()' unless defined $v;

    $attr ||= $WEIGHT;

    if ( ref $v eq 'Graph::Easy::Edge' ) {
        return $v->get_custom_attributes->{"x-$attr"} || 0;
    }

    return $self->get_vertex_attribute($v->name, "x-$attr") || 0;
}


sub vertex_span {
    my ($self, $attr) = @_;

    my $mass = {};
    for my $vertex ( $self->vertices ) {
        $mass->{$vertex->name} = $self->get_cost($vertex, $attr);
    }

    my ($smallest, $biggest);
    for my $vertex ( keys %$mass ) {
        my $current = $mass->{$vertex};
        if ( !defined $smallest || $smallest > $current ) {
            $smallest = $current;
        }
        if ( !defined $biggest || $biggest < $current ) {
            $biggest = $current;
        }
    }

    my ($lightest, $heaviest) = ([], []);
    for my $vertex ( keys %$mass ) {
        push @$lightest, $vertex if $mass->{$vertex} == $smallest;
        push @$heaviest, $vertex if $mass->{$vertex} == $biggest;
    }

    return $lightest, $heaviest;
}


sub edge_span {
    my ($self, $attr) = @_;

    my $mass = {};
    for my $edge ( $self->edges ) {
        $mass->{ $edge->from->name . '_' . $edge->to->name } = $self->get_cost($edge, $attr);
    }

    my ($smallest, $biggest);
    for my $edge ( keys %$mass ) {
        my $current = $mass->{$edge};
        if ( !defined $smallest || $smallest > $current ) {
            $smallest = $current;
        }
        if ( !defined $biggest || $biggest < $current ) {
            $biggest = $current;
        }
    }

    my ($lightest, $heaviest) = ([], []);
    for my $edge ( sort keys %$mass ) {
        my $arrayref = [ split /_/, $edge ];
        push @$lightest, $arrayref if $mass->{$edge} == $smallest;
        push @$heaviest, $arrayref if $mass->{$edge} == $biggest;
    }

    return $lightest, $heaviest;
}



sub path_cost {
    my ($self, $path, $attr) = @_;

    my $path_cost = 0;

    for my $i ( 0 .. @$path - 2 ) {
        my $edge = $self->edge( $path->[$i], $path->[ $i + 1 ] );
        next unless $edge;
        $path_cost += $self->get_cost( $edge, $attr );
    }

    return $path_cost;
}

1;

__END__