File Coverage

blib/lib/SVG/Graph/Kit.pm

Criterion	Covered	Total	%
statement	78	94	82.9
branch	14	26	53.8
condition	18	50	36.0
subroutine	10	12	83.3
pod	1	1	100.0
total	121	183	66.1

package SVG::Graph::Kit;
our $AUTHORITY = 'cpan:GENE';

# ABSTRACT: Simplified SVG data plotting

use strict;
use warnings;

our $VERSION = '0.0403';

use parent qw(SVG::Graph);

use SVG::Graph::Data;
use SVG::Graph::Data::Datum;
use Math::Trig;


sub new {
    my $class = shift;
    my %args = @_;

    # Move non-parent arguments to the kit.
    my %kit = ();
    for my $arg (qw(axis data plot polar)) {
        next unless exists $args{$arg};
        $kit{$arg} = $args{$arg};
        delete $args{$arg};
    }

    # Construct the SVG::Graph object with the remaining arguments.
    $args{width}  ||= 600;
    $args{height} ||= 600;
    $args{margin} ||= 35;
    my $self = $class->SUPER::new(%args);

    # Re-bless as a Graph::Kit object.
    bless $self, $class;
    $self->_setup(%kit);
    return $self;
}

sub _setup {
    my $self = shift;
    my %args = @_;

    # Start with an initial frame...
    my $frame = $self->add_frame;

    # Plot the data.
    if ($args{data}) {
        # Load the graph data and use the SVG::Graph::Data object for label making.
        $self->{graph_data} = _load_data($args{data}, $frame, $args{polar});
        # Add the data to the graph.
        my %plot = (
            stroke         => $args{plot}{stroke}         || 'red',
            fill           => $args{plot}{fill}           || 'red',
            'fill-opacity' => $args{plot}{'fill-opacity'} || 0.5,
        );
        $args{plot}{type} ||= 'scatter';
        $frame->add_glyph($args{plot}{type}, %plot);
    }

    # Handle the axis unless it's set to 0.
    if (!exists $args{axis} || (exists $args{axis} && $args{axis})) {
        my %axis = $self->_load_axis($args{data}, $args{axis});
        $frame->add_glyph('axis', %axis);
    }
}

sub _load_axis {
    my($self, $data, $axis) = @_;

    # Initialize an empty axis unless given a hashref.
    $axis = {} unless ref $axis eq 'HASH';

    # Set the default properties and user override.
    my %axis = (
        x_intercept    => 0,
        y_intercept    => 0,
        stroke         => 'gray',
        'stroke-width' => 2,
        ticks          => 30, # Max data per axis
        %$axis, # User override
    );

    # Set the number of ticks to show on each axis.
    $axis{xticks} ||= $axis{ticks};
    $axis{yticks} ||= $axis{ticks};

    # Compute scale factors.
    my ($xscale, $yscale) = (1, 1);
    if ($data && ($self->{graph_data}->xmax - $self->{graph_data}->xmin) > $axis{xticks}) {
        # Round to the integer, i.e. 0 decimal places.
        $xscale = sprintf '%.0f', $self->{graph_data}->xmax / $axis{xticks};
    }
    if ($data && ($self->{graph_data}->ymax - $self->{graph_data}->ymin) > $axis{yticks}) {
        # Round to the integer, i.e. 0 decimal places.
        $yscale = sprintf '%.0f', $self->{graph_data}->ymax / $axis{yticks};
    }

    # Use absolute_ticks if no tick mark setting is provided.
    unless (defined $axis{x_absolute_ticks} || defined $axis{x_fractional_ticks}) {
        $axis{x_absolute_ticks} = $xscale;
    }
    unless (defined $axis{y_absolute_ticks} || defined $axis{y_fractional_ticks}) {
        $axis{y_absolute_ticks} = $yscale;
    }

    # Use increments of 1 to data-max for ticks if none are provided.
    if ($data && !defined $axis{x_tick_labels} && !defined $axis{x_intertick_labels}) {
        if ($xscale > 1) {
            $axis{x_tick_labels} = [ $self->{graph_data}->xmin ];
            push @{ $axis{x_tick_labels} }, $_ * $xscale for 1 .. $axis{ticks};
        }
        else {
            $axis{x_tick_labels} = [ $self->{graph_data}->xmin .. $self->{graph_data}->xmax ];
        }
        # XXX This is a lame hack
        $axis{x_intertick_labels} = [ map { '' } $self->{graph_data}->ymin .. $self->{graph_data}->ymax ];
    }
    if ($data && !defined $axis{y_tick_labels} && !defined $axis{y_intertick_labels}) {
        if ($yscale > 1) {
            $axis{y_tick_labels} = [ $self->{graph_data}->ymin ];
            push @{ $axis{y_tick_labels} }, $_ * $yscale for 1 .. $axis{ticks};
        }
        else {
            $axis{y_tick_labels} = [ $self->{graph_data}->ymin .. $self->{graph_data}->ymax ];
        }
        # XXX This is also a lame hack
        $axis{y_intertick_labels} = [ map { '' } $self->{graph_data}->ymin .. $self->{graph_data}->ymax ];
    }

    # Remove keys not used by parent module.
    delete $axis{ticks};
    delete $axis{xticks};
    delete $axis{yticks};

    return %axis;
}

sub _load_data {
    my ($data, $frame, $polar) = @_;

    # Create individual data points.
    my @data = ();
    for my $datum (@$data) {
        # Set the coordinate.
        my @coord = @$datum;
        @coord = _to_polar($datum) if $polar;

        # Add our 3D data point.
        push @data, SVG::Graph::Data::Datum->new(
            x => $coord[0],
            y => $coord[1],
            z => $coord[2],
        );
    }

    # Instantiate a new SVG::Graph::Data object;
    my $obj = SVG::Graph::Data->new(data => \@data);

    # Populate our graph with data.
    $frame->add_data($obj);
    return $obj;
}

sub _theta {
    my $point = shift;
#    return int(rand 359);
    return atan2($point->[1], $point->[0]);
}

sub _to_polar {
    my $point = shift;
    my $r = 0;
    $r += $_ ** 2 for @$point;
    $r = sqrt $r;
    my $t = _theta($point);
    return $r, $t;
}

__END__