File Coverage

blib/lib/Schedule/Activity/Attribute/Report.pm

Criterion	Covered	Total	%
statement	110	111	99.1
branch	32	36	88.8
condition	7	12	58.3
subroutine	10	10	100.0
pod	0	6	0.0
total	159	175	90.8

package Schedule::Activity::Attribute::Report;

use strict;
use warnings;
use Scalar::Util qw/looks_like_number/;
use Ref::Util qw/is_ref/;

our $VERSION='0.3.0';

sub new {
	my ($ref,%schedule)=@_;
	my $class=is_ref($ref)||$ref;
	my %self=%schedule; # shallow
	return bless(\%self,$class);
}

sub gridreport {
	my ($self,%opt)=@_;
	$opt{steps}//=10;
	my $yidx=1; if($opt{values} eq 'avg') { $yidx=2 };
	my $tmmin=(        sort {$a<=>$b} map {$$_{xy}[0][0]} values %{$$self{attributes}})[0];
	my $tmmax=(reverse sort {$a<=>$b} map {$$_{xy}[-1][0]} values %{$$self{attributes}})[0];
	my $tmstep=($tmmax-$tmmin)/$opt{steps};
	my @times=map {$tmmin+$tmstep*$_} (0..$opt{steps});
	my @res;
	if($opt{header}) { push @res,[map {sprintf($opt{fmt},$_)} @times]; if($opt{names}) { push @{$res[-1]},'Attribute' } }
	foreach my $name (sort keys %{$$self{attributes}}) {
		my @row;
		my $attr=$$self{attributes}{$name}{xy};
		my ($i,$y)=(-1);
		foreach my $tm (@times) {
			while(($i<$#$attr)&&($tm>=$$attr[$i+1][0])) { $i++ }
			if($i<0)           { $y=0 }
			elsif($i>=$#$attr) { $y=$$attr[$i][$yidx] }
			elsif($i==0)       { $y=$$attr[0][$yidx] }
			else {
				my $p=($tm-$$attr[$i][0])/($$attr[$i+1][0]-$$attr[$i][0]);
				$y=(1-$p)*$$attr[$i][$yidx]+$p*$$attr[$i+1][$yidx];
			}
			push @row,sprintf($opt{fmt},$y);
		}
		if($opt{names}) { push @row,$name }
		push @res,\@row;
	}
	return @res;
}

sub summaryreport {
	my ($self,%opt)=@_;
	my $yidx=1; if($opt{values} eq 'avg') { $yidx=2 };
	my @res;
	if($opt{header}) { push @res,[$opt{values} eq 'avg'?'Average':'Value']; if($opt{names}) { push @{$res[-1]},'Attribute' } }
	foreach my $name (sort keys %{$$self{attributes}}) {
		push @res,[sprintf($opt{fmt},$$self{attributes}{$name}{xy}[-1][$yidx])];
		if($opt{names}) { push @{$res[-1]},$name }
	}
	return @res;
}

sub rawhash {
	my ($value,@rows)=@_;
	my %res;
	my @times=@{shift @rows}; pop(@times);
	foreach my $row (@rows) {
		my $name=pop(@$row);
		foreach my $i (0..$#times) {
			my $tm=$times[$i];
			my $v=$$row[$i];
			$res{$name}{$value}{$tm}=$v;
		}
	}
	return %res;
}

sub rawplot {
	my ($sep,@rows)=@_;
	my @times=@{shift @rows}; pop(@times);
	my $res=join($sep,'Time',map {$$_[1+$#times]//''} @rows)."\n";
	foreach my $i (0..$#times) { $res.=join($sep,$times[$i],map {$$_[$i]//''} @rows)."\n" }
	return $res;
}

sub report {
	my ($self,%opt)=@_;
	%opt=(
		type  =>'',
		values=>'avg',
		header=>1,
		names =>1,
		fmt   =>'%0.4g',
		sep   =>"\t",
		format=>'text',
		%opt
	);
	if($opt{format}=~/^hash/) { $opt{header}=$opt{names}=1 }
	#
	my @rows; # will use dispatch later
	if   ($opt{type} eq 'grid')    { @rows=$self->gridreport(%opt) }
	elsif($opt{type} eq 'summary') { @rows=$self->summaryreport(%opt) }
	#
	if   ($opt{format} eq 'hash')  { return +{rawhash($opt{values},@rows)} }
	elsif($opt{format} eq 'table') { return \@rows }
	elsif($opt{format} eq 'plot')  { return rawplot($opt{sep},@rows) }
	else                           { return join("\n",map {join($opt{sep},@$_)} @rows) }
}

1;

__END__