view release on metacpan or  search on metacpan

lib/Schedule/Activity/Attribute/Report.pm  view on Meta::CPAN

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) {