File Coverage

blib/lib/Schedule/Activity/Attribute.pm

Criterion	Covered	Total	%
statement	140	146	95.8
branch	38	44	86.3
condition	24	39	61.5
subroutine	18	18	100.0
pod	8	10	80.0
total	228	257	88.7

package Schedule::Activity::Attribute;

use strict;
use warnings;
use Ref::Util qw/is_hashref is_ref/;

our $VERSION='0.3.0';

my %types=(
	int=>{
		change =>\&_changeInt,
		average=>\&_avgInt,
		changes=>{map {$_=>undef} qw/type value set incr decr tm note/},
	},
	bool=>{
		change =>\&_changeBool,
		average=>\&_avgBool,
		changes=>{map {$_=>undef} qw/type value set tm note/},
	},
);

sub new {
	my ($ref,%opt)=@_;
	my $class=is_ref($ref)||$ref;
	my ($tm,$y)=($opt{tm}//0,$opt{value}//0);
	my %self=(
		type =>$opt{type}//'int',
		value=>$y,
		log  =>{$tm=>$y},
		aog  =>{$tm=>$y},
		tmmax=>$tm,
		avg  =>$y,
		tmsum=>0,
	);
	if(!defined($types{$self{type}})) { die "Attribute invalid type:  $self{type}" }
	return bless(\%self,$class);
}

sub validateConfig {
	my ($self,%opt)=@_;
	my $C=$types{$$self{type}}{changes};
	my @errors=grep {!exists($$C{$_})} keys %opt;
	if(@errors) { return "Invalid attribute options/commands:  ".join(' ',@errors) }
	return;
}

sub log {
	my ($self,$tm)=@_;
	if(defined($tm)&&($tm>=$$self{tmmax})) { $$self{log}{$tm}=$$self{value}; $$self{aog}{$tm}=$$self{avg}//$$self{value}; $$self{tmmax}=$tm }
	# historic entry is not currently supported
	return $self;
}

sub change {
	my ($self,%opt)=@_;
	my $tm=$opt{tm}//$$self{tmmax};
	if($tm<$$self{tmmax}) { return $self } # historic entry is not currently supported
	#
	&{$types{$$self{type}}{change}}($self,%opt);
	$self->log($tm); # updates tmmax
	if(!defined($$self{avg})) { $self->average() }
	return $self;
}

sub report {
	my ($self)=@_;
	return (
		y  =>$$self{value},
		xy =>[$self->_xy()],
		avg=>$self->average(),
	);
}

sub value {
	my ($self)=@_;
	if($$self{type} eq 'int')  { return 0+$$self{value} }
	if($$self{type} eq 'bool') { return !!$$self{value} }
}

sub average {
	my ($self)=@_;
	if(defined($$self{avg})) { return $$self{avg} }
	($$self{avg},$$self{tmsum})=&{$types{$$self{type}}{average}}($$self{log});
	return $$self{avg};
}

sub reset {
	my ($self)=@_;
	foreach my $tm (sort {$a<=>$b} keys %{$$self{log}}) { $$self{tmmax}=$tm; $$self{value}=$$self{log}{$tm}; last }
	my ($y,$tm)=@$self{qw/value tmmax/};
	%{$$self{log}}=($tm=>$y);
	%{$$self{aog}}=($tm=>$y);
	$$self{avg}=$y;
	$$self{tmsum}=0;
	return $self;
}

sub dump {
	my ($self)=@_;
	my %res=(
		log=>{ %{$$self{log}} },
		aog=>{ %{$$self{aog}} },
		(map {$_=>$$self{$_}} qw/type value tmmax avg tmsum/),
	);
	return %res;
}

sub restore {
	my ($ref,%opt)=@_;
	if(is_hashref($ref)) {
		foreach my $k (keys %opt) { $$ref{$k}=$opt{$k} }
		return $ref;
	}
	my $y=$opt{value}//0;
	my %self=(
		type =>$opt{type}//'int',
		value=>$y,
		log  =>$opt{log}//{},
		aog  =>$opt{aog}//{},
		tmmax=>$opt{tmmax}//0,
		avg  =>$opt{avg}//$y,
		tmsum=>$opt{tmsum}//0,
	);
	return bless(\%self,$ref);
}

sub _xy {
	my ($self)=@_;
	return map {[$_,$$self{log}{$_},$$self{aog}{$_}]} sort {$a<=>$b} keys %{$$self{log}};
}

# set=>value
# incr=>value
# decr=>value
# tm=>tm # optional, will create a log entry
sub _changeInt {
	my ($self,%opt)=@_;
	my $ya=$$self{value};
	if(defined($opt{set})) { $$self{value}=$opt{set} }
	if($opt{incr})         { $$self{value}+=$opt{incr} }
	if($opt{decr})         { $$self{value}-=$opt{decr} }
	if($opt{_log})         { }
	#
	my $dt=($opt{tm}//$$self{tmmax})-$$self{tmmax};
	if($dt==0) { $$self{avg}=$$self{tmsum}=undef; $self->log($$self{tmmax})->average() }
	elsif(defined($$self{avg})) {
		$$self{avg}=$$self{avg}*($$self{tmsum}/($$self{tmsum}+$dt))+0.5*($ya+$$self{value})*($dt/($$self{tmsum}+$dt));
		$$self{tmsum}+=$dt;
	}
	else { $$self{avg}=0.5*($ya+$$self{value}); $$self{tmsum}+=$dt }
	return $self;
}

# set=>value
# tm=>tm # optional, will create a log entry
sub _changeBool {
	my ($self,%opt)=@_;
	my $ya=$$self{value};
	if(defined($opt{set})) { $$self{value}=$opt{set} }
	if($opt{_log})         { }
	#
	my $dt=($opt{tm}//$$self{tmmax})-$$self{tmmax};
	if($dt==0) { $$self{avg}=$$self{tmsum}=undef; $self->log($$self{tmmax})->average() }
	elsif(defined($$self{avg})) {
		$$self{avg}=$$self{avg}*$$self{tmsum}/($$self{tmsum}+$dt)+$dt*$ya/($$self{tmsum}+$dt);
		$$self{tmsum}+=$dt;
	}
	else { $$self{avg}=$ya; $$self{tmsum}+=$dt }
	return $self;
}

sub _avgInt {
	my ($log)=@_;
	my ($avg,$weight,$lasttm,$lasty)=(0,0);
	foreach my $tm (sort {$a<=>$b} keys(%$log)) {
		if(!defined($lasttm)) { ($lasttm,$lasty,$avg,$weight)=($tm,$$log{$tm},$$log{$tm},0); next }
		my $dt=$tm-$lasttm;
		$avg=$weight/($weight+$dt)*$avg+0.5*$dt/($weight+$dt)*($lasty+$$log{$tm});
		$weight+=$dt;
		$lasttm=$tm;
		$lasty=$$log{$tm};
	}
	return ($avg,$weight);
}

sub _avgBool {
	my ($log)=@_;
	my ($sum,$weight,$lasttm,$lasty)=(0,0);
	foreach my $tm (sort {$a<=>$b} keys(%$log)) {
		if(!defined($lasttm)) { ($lasttm,$lasty,$sum,$weight)=($tm,$$log{$tm},$$log{$tm},0); next }
		my $dt=$tm-$lasttm;
		$sum+=$lasty*($tm-$lasttm);
		$weight+=$dt;
		$lasttm=$tm;
		$lasty=$$log{$tm};
	}
	if($weight==0) { return ($sum,$weight) }
	return ($sum/$weight,$weight);
}

1;

__END__