Data-TimeSeries-0.50/0040755000076500007650000000000010071421202012175 5ustar tjtjData-TimeSeries-0.50/TimeSeries.pm0100644000076500007650000004616310071421075014623 0ustar tjtjpackage Data::TimeSeries; use 5.006; use strict; use warnings; use Date::Calc qw(Decode_Date_US ); use Data::TimeSeries::ChronoKey; require Exporter; our @ISA = qw(Exporter); # Items to export into callers namespace by default. Note: do not export # names by default without a very good reason. Use EXPORT_OK instead. # Do not simply export all your public functions/methods/constants. # This allows declaration use TimeSeries ':all'; # If you do not need this, moving things directly into @EXPORT or @EXPORT_OK # will save memory. our %EXPORT_TAGS = ( 'all' => [ qw( ) ] ); our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ); our @EXPORT = qw( ); our $VERSION = '0.50'; =head1 NAME Data::TimeSeries - Perl extension for Manipulation of Time Series of numbers. TimeSeries supports all the periods of ChronoKey. =head1 SYNOPSIS use TimeSeries; my $start =Data::TimeSeries::ChronoKey::new(Data::TimeSeries::ChronoKey::WEEK, "2004W48"); my $stop =Data::TimeSeries::ChronoKey::new(Data::TimeSeries::ChronoKey::WEEK, "2005W02"); my $timeSeries=Data::TimeSeries::new($start, $stop,Data::TimeSeries::ChronoKey::WEEK,'{3,4,5,6,7,8,9,10}'); $ts->addPoint(Data::TimeSeries::FIRST, 2); $ts->addPoint(Data::TimeSeries::LAST, 12); $ts->seriesOperate(sub {$total+=$_;}); $ts->removePoint(Data::TimeSeries::LAST); $ts->removePoint(Data::TimeSeries::FIRST); $ts->seriesOperate(sub {$total+=$_;}); $copy=$timeSeries->copy(); $ts->normalize(); my $rstart =Data::TimeSeries::ChronoKey::new(Data::TimeSeries::ChronoKey::WEEK, "2004W45"); my $rstop =Data::TimeSeries::ChronoKey::new(Data::TimeSeries::ChronoKey::WEEK, "2004W51"); $resized->resize($rstart, $rstop); $ts->stationize($station); $copy->remap(Data::TimeSeries::ChronoKey::DAY, Data::TimeSeries::SPREAD); =head1 LIMITATIONS/TODO TimeSeries assumes you are working with numeric data where there is a value for every target period. =cut # Preloaded methods go here. # Autoload methods go after =cut, and are processed by the autosplit program. #CONSTANTS use constant FIRST => 1; use constant LAST => 2; #Remap Spreading Types use constant SPREAD=> 4; #replicate value down use constant REPLICATE=> 5; #replicate value down use constant EVEN => 6; #divide up value evenly when spreading #Hash Mapping Methods use constant INTERPOLATE => 3; #AVERAGE when aggregating. use constant STEP => 4; #Used only in new object use Data::Dumper; ################# # Methods associated with class not object. ################## sub compare_dates($$) { my ($date1, $date2)=@_; my ($y1,$m1,$d1,$y2,$m2,$d2); unless (($y1,$m1,$d1)=Decode_Date_US($date1)) { die "Failed to parse ( $date1 ) \n"; } unless (($y2,$m2,$d2)=Decode_Date_US($date2)) { die "Failed to parse $date2\n"; } return -1 if ($y1 <$y2); return 1 if ($y1 >$y2); return -1 if ($m1 <$m2); return 1 if ($m1 >$m2); return -1 if ($d1 <$d2); return 1 if ($d1 >$d2); return 0; } sub convertDatesToKeys { #Convert all the date strings in this array to Data::TimeSeries::ChronoKeys my ($arr,$period)=@_; my @result; foreach my $key(@$arr) { push @result, Data::TimeSeries::ChronoKey::new($period,$key); } return @result; } sub buildDateList { my ($period,$sortedDatesRef)=@_; my $list=[]; foreach my $date(@$sortedDatesRef) { my $cKey=Data::TimeSeries::ChronoKey::new($period,$date); push @$list,$cKey; } return $list; } sub synchronize { my @tsList=@_; my $commonPeriod; foreach my $ts(@tsList) { die "One of the parameters is not a TimeSeries" if (ref($ts) ne 'Data::TimeSeries'); if (defined($commonPeriod)) { $commonPeriod=Data::TimeSeries::ChronoKey::commonPeriod($ts->period(), $commonPeriod); } else { $commonPeriod=$ts->period(); } } my ($start,$end); foreach my $ts(@tsList) # Find the start and end dates. { $ts->remap($commonPeriod,REPLICATE) if ($ts->period() != $commonPeriod); if (!defined($start)) #First Time Series. { $start=$ts->start(); } else { my $startRI=$start->getRelativeIndex($ts->start()); #If Current Start is earlier than ts start. $start=$ts->start() if ($startRI > 0); } if (!defined($end)) #First Time Series. { $end=$ts->end(); } else { my $endRI=$end->getRelativeIndex($ts->end()); #If Current end is later than ts end. $end=$ts->end() if ($endRI < 0); } } #Verify Start < End #Or in other words the series overlap. return 0 if ($start->getRelativeIndex($end) <= 0); foreach my $ts(@tsList) # Find the start and end dates. { $ts->clip($start,$end); $ts->stationize($start); } return 1; } ####################### # Constructor ####################### sub new { #Startdate, enddate, period and series if ((scalar(@_) == 4) ) { my ( $start, $end, $period, $series)=@_; my $self={start=>'',end=>'',period=>'',series=>[]}; bless $self; $self->start($start->copy()); $self->end($end->copy()); $self->period($period); $self->series($series); return $self; } #period and hash series in (date=>value) format. elsif ((scalar(@_)==3) && (ref($_[1]) eq "HASH") && (($_[2] == INTERPOLATE) || ($_[2] == STEP))) { my ($period, $hashSeries, $method)=@_; my @keyDates = keys %$hashSeries; my @sortedDates=sort TimeSeries::compare_dates @keyDates; my @values; #Sort values by the dates order for (my $i=0;$i{$sortedDates[$i]}; } #Loop through every list of time periods and build #an array of chronoKeys. my @sortedChronoKeys=convertDatesToKeys(\@sortedDates, $period); my @builtSeries; #Get first key. my $beginKey = shift @sortedChronoKeys; my $start=$beginKey; my $position=0; my @buildSeries; my $valuePos=0; foreach my $key(@sortedChronoKeys) { my $count=$beginKey->getRelativeIndex($key); if ($method == STEP) { for (my $i=$position;$i<$position+$count;$i++) { $buildSeries[$i]=$values[$valuePos]; } } elsif ($method == INTERPOLATE) { my $diff=$values[$valuePos+1]-$values[$valuePos]; my $ratio=$diff/$count; for (my $i=$position;$i<$position+$count;$i++) { $buildSeries[$i]=$values[$valuePos]+$ratio*($i-$position); } } #Increment to where next date starts. $position =$position + $count; $beginKey=$key; $valuePos++; } #Set Last value in series. $buildSeries[$position ]=$values[$valuePos]; my $self={start=>'',end=>'',period=>'',series=>[]}; bless $self; $self->start($sortedChronoKeys[0]->copy()); $self->end($sortedChronoKeys[scalar(@sortedChronoKeys)-1]->copy()); $self->period($period); $self->series(\@buildSeries); return $self; } else { die "Parameters for new are incorrect."; } } sub start { my ($self, $start)=@_; if ((defined $start) && (ref($start) eq "Data::TimeSeries::ChronoKey")) { $self->{start}=$start; } elsif (!defined $start) { return $self->{start}; } else { die "start object not of type ChronoKey"; } } sub end { my ($self, $end)=@_; if ((defined($end)) && (ref($end) eq "Data::TimeSeries::ChronoKey")) { $self->{end}=$end; } elsif (!defined $end) { return $self->{end}; } else { die "end object not of type ChronoKey"; } } sub period { my ($self, $period)=@_; if (defined $period) { $self->{period}=$period; } else { return $self->{period}; } } sub getCalcLen { my ($self)=@_; my $calcLen=$self->{start}->getRelativeIndex($self->{end})+1; return $calcLen; } sub getStrDateArray { my ($self)=@_; my $len=$self->getCalcLen(); my @result=(); my $curr=$self->start(); for (my $i=0;$i<=$len;$i++) { push @result, $curr->getDate(); $curr->add(1); } return \@result; } sub series { my ($self, $series)=@_; if (defined ($series)) { my $refseries=ref($series); if (!ref($series) ) { $series =~ s/[{}]//g ; my @arr=map {int($_)} split(",",$series);#Convert from strings to int. my $size=$self->{start}->getRelativeIndex($self->{end})+1; my $arrSize=scalar(@arr); if ($arrSize != $size) { die " Dates and array size does not match $arrSize, $size "; } $self->{series}=\@arr; } elsif(ref($series) eq "ARRAY") # Array { my @arr=@$series; $self->{series}=\@arr; } else { die "Unable to handle " ,ref($series), " series type"; } } else { return $self->{series}; } } sub addPoint { my ($self, $position, $value)=@_; die "Not all parameters provided for add Point " if(!defined($value)); #position[ FIRST, LAST, chronoKey] if ($position == Data::TimeSeries::FIRST) { unshift(@{$self->{series}}, $value); $self->{start}->add(-1); } elsif ($position eq Data::TimeSeries::LAST) { push(@{$self->{series}}, $value); $self->{end}->add(); } elsif ((ref($position) eq "Data::TimeSeries::ChronoKey")) { my @data=(); my $index=$self->{start}->getRelativeIndex($position); $self->{end}->add(); for (my $i=0;$i<$self->{start}->getRelativeIndex($self->{end});$i++) { if ($i == $index) { push @data, $value; } push @data, $self->{series}->[$i]; } } #chrono[ FIRST, LAST,date,datetime, mapping] } sub removePoint { my ($self, $position)=@_; die "Not all parameters provided for add Point " if(!defined($position)); if ($position == FIRST) { shift(@{$self->{series}}); $self->{start}->add(); } elsif ($position == LAST) { pop(@{$self->{series}}); $self->{end}->add(-1); } } sub getPoint { my ($self, $chronokey)=@_; #chronokey[ FIRST, LAST,date,datetime, mapping] } sub getLength { my ($self)=@_; my $len=scalar(@{$self->{series}}); return $len; } sub shift { my ($self, $period, $units)=@_; $self->{start}->add($units); $self->{stop}->add($units); } sub seasonalize { my ($self, $period)=@_; } sub stationize { my ($self, $station)=@_; my $ckStation; if (ref $station ne "Data::TimeSeries::ChronoKey") { $ckStation=Data::TimeSeries::ChronoKey::new($self->period, $station); } else { $ckStation=$station; } if (($self->start->getRelativeIndex($ckStation) < 0) || ($self->end->getRelativeIndex($ckStation) > 0)) { die "Station not within range."; } my $position=$self->start->getRelativeIndex($station); my $divisor=$self->series->[$position]; map {$_=$_/$divisor} @{$self->{series}} ; } sub normalize { my ($self)=@_; my $total=0; map {$total+=$_} @{$self->{series}} ; map {$_=$_/$total} @{$self->{series}} ; } sub resize { my ($self, $start, $end,$method)=@_; $method=INTERPOLATE if (!defined($method)); #default to interpolate method Data::TimeSeries::ChronoKey::verifyObj($start); Data::TimeSeries::ChronoKey::verifyObj($end); my @vals; my $targetLen=$start->getRelativeIndex($end)+1; $targetLen--; my $srcLen=$self->getLength(); $srcLen--; my $gcd=_getGCD($srcLen, $targetLen); my $lcm=($srcLen/$gcd) * $targetLen; my $j=0; for (my $i=0;$i<($lcm);$i+=$gcd*$targetLen) { my $k; for ($k=$i;$k<=($i + ($gcd * $targetLen));$k++) { $vals[$k]=((($self->series()->[$j+1] - $self->series()->[$j])/ ($gcd * $targetLen))*($k-$i)) + $self->series()->[$j]; } $j++; } my @result; for (my $i=0;$i<=$targetLen;$i++) { $result[$i]=$vals[$i*($lcm/$targetLen)] } my $seriesTotal=0; my $resTotal=0; if ($method == SPREAD) { for (my $i=0;$i<=$srcLen;$i++) { $seriesTotal+=$self->series()->[$i]; } for (my $i=0;$i<=$targetLen;$i++) { $resTotal+=$result[$i]; } for (my $i=0;$i<=$targetLen;$i++) { $result[$i]=($result[$i]/$resTotal)*$seriesTotal; } } $self->series(\@result); $self->start($start); $self->end($end); } sub seriesOperate { my ($self,$closure)=@_; map {&$closure()} @{$self->series()}; } sub remap { my ($self, $period,$remapType )=@_; my @result; #Remap not handling period properly. return if ($self->period() == $period); return die "Period not below or common to self's period." if (Data::TimeSeries::ChronoKey::commonPeriod($self->period(), $period) != $period); my $start=$self->start()->copy(); my $last=$self->end()->copy(); my @dataCopy=@{$self->series()}; for (my $topCurr=$start->copy();$topCurr->getRelativeIndex($last)>=0;$topCurr->add()) { my $currVal=CORE::shift(@dataCopy); my $cstart=$topCurr->keyForPeriod($period, FIRST); my $clast=$topCurr->keyForPeriod($period, LAST); my $relidx=$cstart->getRelativeIndex($clast); for (my $iCurr=0;$iCurr<=$relidx;$iCurr++) { #Assume Replicate for now. if ($remapType == REPLICATE) { push @result, $currVal; } elsif($remapType == SPREAD) { push @result, $currVal/($relidx+1); } else { die "Did not recognize remap type $remapType \n"; } } } $self->series(\@result); $self->period($period); $start=$self->start()->keyForPeriod($period, FIRST); $last=$last->keyForPeriod($period, LAST); $self->start($start); $self->end($last); } sub clip { my ($self, $start, $end)=@_; if (!defined $end) { $end=$self->end(); } my $startShift=$self->{start}->getRelativeIndex($start); die "Start before objects start" if ($startShift < 0); my $endShift=$self->{start}->getRelativeIndex($end); die "End before object's end. $endShift" if ($endShift > scalar(@{$self->{series}})); if ($endShift < $startShift) { die "End Date before Start Date"; } my @newSeries; for (my $i=$startShift;$i<=$endShift;$i++) { push(@newSeries, $self->{series}->[$i]); } $self->{start}=$start; $self->{end}=$end; $self->{series}=\@newSeries; } sub copy { my ($self)=@_; my $copy=new($self->{start}, $self->{end}, $self->{period}, $self->{series}); bless $copy; @{$copy->{series}}=@{$self->{series}}; return $copy; } sub pack { my ($self)=@_; my $count=$self->getCalcLen(); return pack "d" x $count, @{$self->series()}; } sub unpack { my ($start, $end, $period,$packed) = @_; $start=~ s/(.*?) \d\d:\d\d:\d\d/$1/g; $end=~ s/(.*?) \d\d:\d\d:\d\d/$1/g; my $ckStart=Data::TimeSeries::ChronoKey::new($period, $start); my $ckEnd=Data::TimeSeries::ChronoKey::new($period, $end); my $count=$ckStart->getRelativeIndex($ckEnd) + 1; my @arr = unpack "d" x $count, $packed; my $ts=new($ckStart,$ckEnd,$period,\@arr); return $ts; } ################################################### sub _getGCD { my ($v1, $v2)=@_; my ($largest, $smallest); if ($v1>$v2) { $largest=$v1; $smallest=$v2; } else { $largest=$v2; $smallest=$v1; } my $d=$largest; my $r=$smallest; while ($r!=0) { $largest=$d; $d=$r; $r=$largest % $d; } return $d; } 1; __END__ # Below is stub documentation for your module. You better edit it! =head1 METHODS =item C $ts = Data::TimeSeries::new($start, $end, $period, $series); Creates and initalizes TimeSeries object. C dies if parameters are not legal. $start - ChronoKey object. The position of the first element in the serines. $end - ChronoKey object. The position of the last element in the series. $period - A ChronoKey Period $series - An array or a string that has the following format {1,2,4}. Should be of integer or floating point numbers. =item C $ck = $ts->start(); $ts->start($ck); The C method is the start position accesor. It can be used to get or set the start position. Setting the start position directly is strongly discouraged. Use C or C instead. =item C $ck = $ts->end(); $ts->end($ck); The C method is the end position accesor. It can be used to get or set the end position. Setting the end position directly is strongly discouraged. Use C or C instead. =item C $period = $ts->period(); $ts->period($period); The C method is the period of the time series. It can be used to get or set the period. Setting the end period directly is strongly discouraged. =item C \@series = $ts->series(); $ts->series(\@series); $ts->series("{1,2,3}"); The C method is the series of the time series. It can be used to get or set the series. Setting the end series directly is somewhat discouraged. If you do set it, make sure it is the same length as the one you are replacing. =item C $length = $ts->getCalcLen(); The C method is used to get the number of periods from the start and end positions (inclusive). It should be the same length as the series array. =item C $ts->addPoint(TimeSeries::FIRST, 10.00); $ts->addPoint(TimeSeries::LAST, 15.00); $ts->addPoint($ck, 12.00); C Method allows you to add a new point to the beginning or end of a timeseries. Or you can add it somewhere within the series. The ChronoKey ($ck) must be within the existing range. The series will be stretched forward to accomodate the new point. =item C $ts->removePoint(TimeSeries::FIRST); $ts->removePoint(TimeSeries::LAST); $ts->removePoint($ck); The inverse of addPoint. Allows you to remove the first, last or a cnter point. =item C $ts->getPoint(TimeSeries::FIRST); $ts->getPoint(TimeSeries::LAST); $ts->removePoint($ck); C gets the point at the specified position. =item C $len=$ts->getLength(); C gets the length of the time series. =item C $ts->shift($units) C shifts the time series by $units number of periods. =item C $ts->seasonalize() =item C $ts->normalize() Takes the time series and makes it sum to 1. =item C $ts->resize($start, $end) Stretches or shrinks the time series to fit the $start and $end chronokeys. Linear Interpolation is used to build missing values. =item C $ts->seriesOperate(sub {$_*=20;}) Runs an operation on every item in the series. =item C $ts->clip($startCK,$endCK); Cuts down the time series to the specified start and end positions. =item C $ts2=$ts->copy(); Creates a copy of the time series. Runs an operation on every item in the series. TODO =item C ($slope, $constant)=$ts->regression(); Runs a regression algorithm on a time series. =head1 DESCRIPTION Data::TimeSeries allows easy manipulation of timeseries related data. =head2 EXPORT None by default. =head1 AUTHOR ts(at)atlantageek.com =head1 SEE ALSO L. =cut Data-TimeSeries-0.50/Makefile.PL0100644000076500007650000000106110060643730014154 0ustar tjtjuse 5.008; use ExtUtils::MakeMaker; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. eval {require Date::Calc;} or die "Date::Calc required"; WriteMakefile( 'NAME' => 'Data::TimeSeries', 'VERSION_FROM' => 'TimeSeries.pm', # finds $VERSION 'PREREQ_PM' => {}, # e.g., Module::Name => 1.1 ($] >= 5.005 ? ## Add these new keywords supported since 5.005 (ABSTRACT_FROM => 'TimeSeries.pm', # retrieve abstract from module AUTHOR => 'tj ') : ()), ); Data-TimeSeries-0.50/README0100644000076500007650000000205510060643525013070 0ustar tjtjData/TimeSeries version 0.01 ============================ The README is used to introduce the module and provide instructions on how to install the module, any machine dependencies it may have (for example C compilers and installed libraries) and any other information that should be provided before the module is installed. A README file is required for CPAN modules since CPAN extracts the README file from a module distribution so that people browsing the archive can use it get an idea of the modules uses. It is usually a good idea to provide version information here so that people can decide whether fixes for the module are worth downloading. INSTALLATION To install this module type the following: perl Makefile.PL make make test make install DEPENDENCIES This module requires these other modules and libraries: Date::Calc COPYRIGHT AND LICENCE Put the correct copyright and licence information here. Copyright (C) 2004 tj This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Data-TimeSeries-0.50/t/0040755000076500007650000000000010060642644012455 5ustar tjtjData-TimeSeries-0.50/t/1.t0100755000076500007650000000603710060642561013006 0ustar tjtj#!/usr/bin/perl use Test; use Data::TimeSeries; use Data::TimeSeries::ChronoKey; use strict; use Data::Dumper; use strict; BEGIN {plan test=>23} #Create A time series my $start =Data::TimeSeries::ChronoKey::new(Data::TimeSeries::ChronoKey::WEEK, "2004W48"); my $stop =Data::TimeSeries::ChronoKey::new(Data::TimeSeries::ChronoKey::WEEK, "2005W02"); my $timeSeries=Data::TimeSeries::new($start, $stop,Data::TimeSeries::ChronoKey::WEEK,'{3,4,5,6,7,8,9,10}'); ok($timeSeries->getLength(), 8); #Add a point at the very beginning $timeSeries->addPoint(Data::TimeSeries::FIRST, 2); ok($timeSeries->getLength(), 9); #Add a point at the end $timeSeries->addPoint(Data::TimeSeries::LAST, 12); ok($timeSeries->getLength(), 10); #Sum the points my $total=0; $timeSeries->seriesOperate(sub {$total+=$_;}); ok($total,66); #Remove The last Point $timeSeries->removePoint(Data::TimeSeries::LAST); ok($timeSeries->getLength(), 9); #Remove The First Point $timeSeries->removePoint(Data::TimeSeries::FIRST); ok($timeSeries->getLength(), 8); #Sum the points $total=0; $timeSeries->seriesOperate(sub {$total+=$_;}); ok($total,52); #create a copy and normalize it. my $copy=$timeSeries->copy(); $copy->normalize(); $total=0; $copy->seriesOperate(sub {$total+=$_;}); ok($total,1); #Make sure original did not change. $total=0; $timeSeries->seriesOperate(sub {$total+=$_;}); ok($total,52); #Test Resize my $resized=$timeSeries->copy(); my $rstart =Data::TimeSeries::ChronoKey::new(Data::TimeSeries::ChronoKey::WEEK, "2004W45"); my $rstop =Data::TimeSeries::ChronoKey::new(Data::TimeSeries::ChronoKey::WEEK, "2004W51"); $resized->resize($rstart, $rstop); $total=0; $timeSeries->seriesOperate(sub {$total+=$_;}); ok($total,52); ok($resized->getLength(), 7); #Test Clip $copy=$timeSeries->copy(); $rstart =Data::TimeSeries::ChronoKey::new(Data::TimeSeries::ChronoKey::WEEK, "2004W49"); $rstop =Data::TimeSeries::ChronoKey::new(Data::TimeSeries::ChronoKey::WEEK, "2005W02"); $copy->clip($rstart, $rstop); $total=0; $copy->seriesOperate(sub {$total+=$_;}); ok($total,49); ok($copy->getLength(), 7); #Test Stationize. (Index based on a certain date. my $station =Data::TimeSeries::ChronoKey::new(Data::TimeSeries::ChronoKey::WEEK, "2004W50"); $copy->stationize($station); $total=0; $copy->seriesOperate(sub {$total+=$_;}); ok($total,9.8); ok($copy->getLength(), 7); #Test getStrDateArray. my $dateArr=$copy->getStrDateArray(); ok ($dateArr->[5],'1/3/2005'); #Test Remap $copy=$timeSeries->copy(); $copy->remap(Data::TimeSeries::ChronoKey::DAY, Data::TimeSeries::SPREAD); my $copytotal=0; $copy->seriesOperate(sub {$copytotal+=$_;}); my $tstotal=0; $timeSeries->seriesOperate(sub {$tstotal+=$_;}); ok($copytotal,$tstotal); my $currlen=$copy->getCalcLen(); ok($currlen,56); #TEST synchronize $copy=$timeSeries->copy(); my $copy2=$resized->copy(); ok(Data::TimeSeries::synchronize($copy, $copy2),1); $total=0; $copy->seriesOperate(sub {$total+=$_;}); ok($total,6.0); ok($copy->getLength(), 4); $total=0; $copy2->seriesOperate(sub {$total+=$_;}); ok($total,5.07692307692308); ok($copy2->getLength(), 4); Data-TimeSeries-0.50/t/1.t~0100755000076500007650000000603710060641705013203 0ustar tjtj#!/usr/bin/perl use Test; use Data::TimeSeries; use Data::TimeSeries::ChronoKey; use strict; use Data::Dumper; use strict; BEGIN {plan test=>23} #Create A time series my $start =Data::TimeSeries::ChronoKey::new(Data::TimeSeries::ChronoKey::WEEK, "2004W48"); my $stop =Data::TimeSeries::ChronoKey::new(Data::TimeSeries::ChronoKey::WEEK, "2005W02"); my $timeSeries=Data::TimeSeries::new($start, $stop,Data::TimeSeries::ChronoKey::WEEK,'{3,4,5,6,7,8,9,10}'); ok($timeSeries->getLength(), 8); #Add a point at the very beginning $timeSeries->addPoint(Data::TimeSeries::FIRST, 2); ok($timeSeries->getLength(), 9); #Add a point at the end $timeSeries->addPoint(Data::TimeSeries::LAST, 12); ok($timeSeries->getLength(), 10); #Sum the points my $total=0; $timeSeries->seriesOperate(sub {$total+=$_;}); ok($total,66); #Remove The last Point $timeSeries->removePoint(Data::TimeSeries::LAST); ok($timeSeries->getLength(), 9); #Remove The First Point $timeSeries->removePoint(Data::TimeSeries::FIRST); ok($timeSeries->getLength(), 8); #Sum the points $total=0; $timeSeries->seriesOperate(sub {$total+=$_;}); ok($total,52); #create a copy and normalize it. my $copy=$timeSeries->copy(); $copy->normalize(); $total=0; $copy->seriesOperate(sub {$total+=$_;}); ok($total,1); #Make sure original did not change. $total=0; $timeSeries->seriesOperate(sub {$total+=$_;}); ok($total,52); #Test Resize my $resized=$timeSeries->copy(); my $rstart =Data::TimeSeries::ChronoKey::new(Data::TimeSeries::ChronoKey::WEEK, "2004W45"); my $rstop =Data::TimeSeries::ChronoKey::new(Data::TimeSeries::ChronoKey::WEEK, "2004W51"); $resized->resize($rstart, $rstop); $total=0; $timeSeries->seriesOperate(sub {$total+=$_;}); ok($total,52); ok($resized->getLength(), 7); #Test Clip $copy=$timeSeries->copy(); $rstart =Data::TimeSeries::ChronoKey::new(Data::TimeSeries::ChronoKey::WEEK, "2004W49"); $rstop =Data::TimeSeries::ChronoKey::new(Data::TimeSeries::ChronoKey::WEEK, "2005W02"); $copy->clip($rstart, $rstop); $total=0; $copy->seriesOperate(sub {$total+=$_;}); ok($total,49); ok($copy->getLength(), 7); #Test Stationize. (Index based on a certain date. my $station =Data::TimeSeries::ChronoKey::new(Data::TimeSeries::ChronoKey::WEEK, "2004W50"); $copy->stationize($station); $total=0; $copy->seriesOperate(sub {$total+=$_;}); ok($total,9.8); ok($copy->getLength(), 7); #Test getStrDateArray. my $dateArr=$copy->getStrDateArray(); ok ($dateArr->[5],'1/3/2005'); #Test Remap $copy=$timeSeries->copy(); $copy->remap(Data::TimeSeries::ChronoKey::DAY, Data::TimeSeries::SPREAD); my $copytotal=0; $copy->seriesOperate(sub {$copytotal+=$_;}); my $tstotal=0; $timeSeries->seriesOperate(sub {$tstotal+=$_;}); ok($copytotal,$tstotal); my $currlen=$copy->getCalcLen(); ok($currlen,56); #TEST synchronize $copy=$timeSeries->copy(); my $copy2=$resized->copy(); ok(Data::TimeSeries::synchronize($copy, $copy2),1); $total=0; $copy->seriesOperate(sub {$total+=$_;}); ok($total,6.0); ok($copy->getLength(), 4); $total=0; $copy2->seriesOperate(sub {$total+=$_;}); ok($total,5.07692307692308); ok($copy2->getLength(), 4); Data-TimeSeries-0.50/Changes0100644000076500007650000000024510060634705013502 0ustar tjtjRevision history for Perl extension Data::TimeSeries. 0.01 Sun Jun 6 11:35:33 2004 - original version; created by h2xs 1.22 with options -AX Data::TimeSeries Data-TimeSeries-0.50/MANIFEST0100644000076500007650000000012010060643440013324 0ustar tjtjChanges Makefile.PL MANIFEST README TimeSeries.pm TimeSeries/ChronoKey.pm t/1.t Data-TimeSeries-0.50/TimeSeries/0040755000076500007650000000000010060643516014262 5ustar tjtjData-TimeSeries-0.50/TimeSeries/ChronoKey.pm0100644000076500007650000002254710060643515016527 0ustar tjtjpackage Data::TimeSeries::ChronoKey; use strict; use Date::Calc qw(Decode_Date_US Week_Number check_date Delta_Days Days_in_Month Monday_of_Week Add_Delta_Days Add_Delta_YM); # Time Related use constant HOUR => 1; # Date Related use constant DAY => 2; #day, month, year use constant WEEK =>3; #week, year use constant MONTH => 4;#month, year use constant QUARTER=>5;#month, year use constant YEAR=>6;#year #Directions use constant LOWEST=>DAY; # Position Specification use constant FIRST => 1; use constant LAST => 2; use Data::Dumper; sub new { my ($period, $value)=@_; die "ChronoKey not defined." if (!defined($period)); die "Value not defined." if (!defined($value)); my $self={}; bless $self; $self->init( $period, $value); $self->verify(); return $self; } sub copy { my ($self)=@_; my %copy=%$self; my $self=\%copy; bless $self; return \%copy; } sub getPeriod { my ($self)=@_; return $self->{period}; } sub verify_date { my ($self)=@_; my ($year, $month, $day)= Decode_Date($self->{value}); if (!check_date(($year, $month, $day)) ) { die "Date invalid:", $self->{value}; } ($self->{year}, $self->{month}, $self->{day})=($year, $month, $day); undef $self->{week}; undef $self->{hour}; return 1; } sub verify_week { my ($self)=@_; if ($self->{value} =~ /^\s*(\d\d\d\d)W(\d\d)\s*$/) { die "Week not correct for week" if (($2 > 53) || ($2 < 01)); $self->{year}=$1; $self->{week}=$2; } elsif (my ($year, $month, $day)=Decode_Date($self->{value})) { $self->{year}=$year; $self->{week}=Week_Number($year, $month, $day); } else { die "Invalid Week:",$self->{value}; } undef $self->{month}; undef $self->{day}; undef $self->{hour}; return 1; } sub verify_quarter { my ($self)=@_; if ($self->{value} =~ /^\s*(\d\d\d\d)Q(\d)\s*$/) { die "Quarter not correct for week" if (($2 > 4) || ($2 < 1)); $self->{year}=$1; $self->{month}=($2*3)-2; } elsif (my ($year, $month, $day)=Decode_Date($self->{value})) { $self->{year}=$year; $self->{month}=int(($month-1)/3)*3+1; } else { die "Invalid Quarter"; } undef $self->{week}; undef $self->{day}; undef $self->{hour}; return 1; } sub verify_month { my ($self)=@_; if ($self->{value} =~ /^\s*(\d\d\d\d)M(\d\d)\s*$/) { die "Month not correct for month" if (($2 > 12) || ($2 < 01)); $self->{year}=$1; $self->{month}=$2; } elsif (my ($year, $month, $day)=Decode_Date($self->{value})) { my ($year, $month, $day)=Decode_Date($self->{value}); $self->{year}=$year; $self->{month}=$month; } else { die "Invalid for month"; } undef $self->{day}; undef $self->{week}; undef $self->{hour}; return 1; } sub verify_year { my ($self)=@_; if ($self->{value} =~ /^\s*(\d\d\d\d)\s*$/) { $self->{year}=$1; } elsif (my ($year, $month, $day)=Decode_Date($self->{value})) { $self->{year}=$year; } else { die "Year invalid"; } undef $self->{month}; undef $self->{day}; undef $self->{week}; undef $self->{hour}; return 1; } sub verify_hour { my ($self, $value)=@_; if ($value !~ /^\s*(\d\d\d\d)(\d\d)(\d\d)H(\d\d)\s*$/) { die "Date invalid"; } die "month not correct for Hour" if (($2 > 12) || $2<01); die "day not correct for Hour" if (($3 > 31) || $3<01); die "hour not correct for Hour" if (($3 > 24) || $3<01); $self->{year}=$1; $self->{month}=$2; $self->{day}=$3; undef $self->{week}; $self->{hour}=$4; return 1; } sub verify { my ($self)=@_; $self->verify_date() if ($self->{period} ==DAY); $self->verify_week() if ($self->{period} == WEEK); $self->verify_month() if ($self->{period} == MONTH); $self->verify_quarter() if ($self->{period} == QUARTER); $self->verify_year() if ($self->{period} == YEAR); $self->verify_hour() if ($self->{period} == HOUR); } sub init { my ($self, $period, $value)=@_; my @ptype_lookup; $self->{period}=$period; $self->{value}=$value; } sub add { my ($self,$units)=@_; if (!defined($units)) { $units=1; } if ($self->getPeriod() == DAY) { my ($year,$month,$day) = Add_Delta_Days($self->{year}, $self->{month}, $self->{day},1*$units); $self->{year}=$year; $self->{month}=$month; $self->{day}=$day; } elsif ($self->getPeriod() == WEEK) { my ($year,$month,$day)=Monday_of_Week($self->{week} , $self->{year}); ($year,$month,$day)=Add_Delta_Days($year,$month,$day,7*$units); my $date=$month.'/'.$day.'/'.$year; $self->{year}=$year; $self->{week}=Week_Number($year, $month, $day); } elsif ($self->getPeriod() == MONTH) { my ($year, $month, $day) = Add_Delta_YM($self->{year}, $self->{month}, '1',0,1*$units); $self->{year}=$year; $self->{month}=$month; } elsif ($self->getPeriod() == QUARTER) { my ($year, $month, $day) = Add_Delta_YM($self->{year}, $self->{month}, '1',0,3*$units); $self->{year}=$year; $self->{month}=$month; } elsif ($self->getPeriod() == YEAR) { my ($year, $month, $day) = Add_Delta_YM($self->{year},'1','1',1*$units,-0); $self->{year}=$year; } } sub getRelativeIndex { my ($self, $end)=@_; if (ref($end) eq ref($self)) { die "Periods do not agree" unless ($self->getPeriod() eq $end->getPeriod()); } if ($self->getPeriod() == DAY) { my $days=Delta_Days( ($self->{year}, $self->{month}, $self->{day}), ($end->{year}, $end->{month}, $end->{day})); return $days; } elsif ($self->getPeriod() == WEEK) { my $weeks=(($end->{year} - $self->{year}) *53) + ($end->{week} - $self->{week}); return $weeks; } elsif ($self->getPeriod() == MONTH) { my $months=(($end->{year} - $self->{year}) *12) + ($end->{month} - $self->{month}); return $months; } elsif ($self->getPeriod() == QUARTER) { my $quarter=(($end->{year} - $self->{year}) *4) + int(($end->{month} - $self->{month})/3); return $quarter; } elsif ($self->getPeriod() == YEAR) { my $years=(($end->{year} - $self->{year}) ) ; return $years; } die "Hour not yet supported. " if ($self->getPeriod() == HOUR); } sub getDate { my ($self, $position, $db) =@_; my $date; if (!defined($position)|| ($position == FIRST)) { if ($self->{period} == YEAR) { $date='1/1/' . $self->{year}; } elsif (($self->{period} == MONTH) || ($self->{period} == QUARTER)) { $date=$self->{month} .'/1/'.$self->{year}; } elsif ($self->{period} == DAY) { $date=$self->{month} .'/'.$self->{day}."/".$self->{year}; } elsif ($self->{period} == WEEK) { my ($year, $month, $day)=Monday_of_Week($self->{week}, $self->{year}); $date=$month.'/'.$day.'/'.$year; } else { die "Period not recognized. "; } } else { if ($self->{period} == YEAR) { $date='12/31/' . $self->{year}; } elsif ($self->{period} == MONTH) { my $day=Days_in_Month($self->{year}, $self->{month}); $date=($self->{month}) .'/'.$day.'/'.$self->{year}; } elsif ($self->{period} == DAY) { $date=$self->{month} .'/'.$self->{day}."/".$self->{year}; } elsif ($self->{period} == WEEK) { my ($year, $month, $day)=Monday_of_Week($self->{week}, $self->{year}); ($year, $month, $day)=Add_Delta_Days($year, $month, $day,6); $date=$month.'/'.$day.'/'.$year; } elsif ($self->{period} == QUARTER) { my $day=Days_in_Month($self->{year}, $self->{month}+2); $date=($self->{month}+2) .'/'.$day.'/'.$self->{year}; } else { die "Period not recognized. "; } } if ($db) { my ($mn, $day,$yr)=$date=~/(.*)\/(.*)\/(.*)/; $mn="0".$mn if ($mn < 10); $day="0".$day if ($day < 10); return "$yr-$mn-$day"; } else { return $date; } } sub keyForPeriod { my ($self, $target_period, $position)=@_; my $result; if ( ($position == FIRST)) { $result= new($target_period, $self->getDate(FIRST)); } else { $result= new($target_period, $self->getDate( LAST)); } } ################################################ #Common Methods ################################################ sub verifyObj { my ($obj)=@_; die "Not defined " if (!defined($obj) ); die "Not a ChronoKey " if (ref($obj) ne "Data::TimeSeries::ChronoKey"); } sub commonPeriod { my ($period1, $period2)=@_; my $iter1=$period1; my $iter2=$period2; while ((!defined($iter1)) || ($iter1 != $iter2)) { if (!defined($iter1)) { $iter2=neighbor($iter2); $iter1=$period1; } else { $iter1=neighbor($iter1); } } return $iter1; } sub neighbor { my ($period)=@_; if ($period eq DAY) { return undef; } elsif ($period eq WEEK) { return DAY; } elsif ($period eq MONTH) { return DAY; } elsif ($period eq QUARTER) { return MONTH; } elsif ($period eq YEAR) { return QUARTER; } } sub Decode_Date { my ($date)=shift; my ($year, $month, $day); if ($date =~ /(\d\d\d\d)-(\d\d)-(\d\d)/) { $year=$1; $month=$2; $day=$3; return ($year, $month, $day); } elsif (($year, $month, $day)=Decode_Date_US($date)) { return ($year, $month, $day); } else { return undef; } } 1; Data-TimeSeries-0.50/TimeSeries/ChronoKey.pm~0100644000076500007650000002254710060641613016722 0ustar tjtjpackage Data::TimeSeries::ChronoKey; use strict; use Date::Calc qw(Decode_Date_US Week_Number check_date Delta_Days Days_in_Month Monday_of_Week Add_Delta_Days Add_Delta_YM); # Time Related use constant HOUR => 1; # Date Related use constant DAY => 2; #day, month, year use constant WEEK =>3; #week, year use constant MONTH => 4;#month, year use constant QUARTER=>5;#month, year use constant YEAR=>6;#year #Directions use constant LOWEST=>DAY; # Position Specification use constant FIRST => 1; use constant LAST => 2; use Data::Dumper; sub new { my ($period, $value)=@_; die "ChronoKey not defined." if (!defined($period)); die "Value not defined." if (!defined($value)); my $self={}; bless $self; $self->init( $period, $value); $self->verify(); return $self; } sub copy { my ($self)=@_; my %copy=%$self; my $self=\%copy; bless $self; return \%copy; } sub getPeriod { my ($self)=@_; return $self->{period}; } sub verify_date { my ($self)=@_; my ($year, $month, $day)= Decode_Date($self->{value}); if (!check_date(($year, $month, $day)) ) { die "Date invalid:", $self->{value}; } ($self->{year}, $self->{month}, $self->{day})=($year, $month, $day); undef $self->{week}; undef $self->{hour}; return 1; } sub verify_week { my ($self)=@_; if ($self->{value} =~ /^\s*(\d\d\d\d)W(\d\d)\s*$/) { die "Week not correct for week" if (($2 > 53) || ($2 < 01)); $self->{year}=$1; $self->{week}=$2; } elsif (my ($year, $month, $day)=Decode_Date($self->{value})) { $self->{year}=$year; $self->{week}=Week_Number($year, $month, $day); } else { die "Invalid Week:",$self->{value}; } undef $self->{month}; undef $self->{day}; undef $self->{hour}; return 1; } sub verify_quarter { my ($self)=@_; if ($self->{value} =~ /^\s*(\d\d\d\d)Q(\d)\s*$/) { die "Quarter not correct for week" if (($2 > 4) || ($2 < 1)); $self->{year}=$1; $self->{month}=($2*3)-2; } elsif (my ($year, $month, $day)=Decode_Date($self->{value})) { $self->{year}=$year; $self->{month}=int(($month-1)/3)*3+1; } else { die "Invalid Quarter"; } undef $self->{week}; undef $self->{day}; undef $self->{hour}; return 1; } sub verify_month { my ($self)=@_; if ($self->{value} =~ /^\s*(\d\d\d\d)M(\d\d)\s*$/) { die "Month not correct for month" if (($2 > 12) || ($2 < 01)); $self->{year}=$1; $self->{month}=$2; } elsif (my ($year, $month, $day)=Decode_Date($self->{value})) { my ($year, $month, $day)=Decode_Date($self->{value}); $self->{year}=$year; $self->{month}=$month; } else { die "Invalid for month"; } undef $self->{day}; undef $self->{week}; undef $self->{hour}; return 1; } sub verify_year { my ($self)=@_; if ($self->{value} =~ /^\s*(\d\d\d\d)\s*$/) { $self->{year}=$1; } elsif (my ($year, $month, $day)=Decode_Date($self->{value})) { $self->{year}=$year; } else { die "Year invalid"; } undef $self->{month}; undef $self->{day}; undef $self->{week}; undef $self->{hour}; return 1; } sub verify_hour { my ($self, $value)=@_; if ($value !~ /^\s*(\d\d\d\d)(\d\d)(\d\d)H(\d\d)\s*$/) { die "Date invalid"; } die "month not correct for Hour" if (($2 > 12) || $2<01); die "day not correct for Hour" if (($3 > 31) || $3<01); die "hour not correct for Hour" if (($3 > 24) || $3<01); $self->{year}=$1; $self->{month}=$2; $self->{day}=$3; undef $self->{week}; $self->{hour}=$4; return 1; } sub verify { my ($self)=@_; $self->verify_date() if ($self->{period} ==DAY); $self->verify_week() if ($self->{period} == WEEK); $self->verify_month() if ($self->{period} == MONTH); $self->verify_quarter() if ($self->{period} == QUARTER); $self->verify_year() if ($self->{period} == YEAR); $self->verify_hour() if ($self->{period} == HOUR); } sub init { my ($self, $period, $value)=@_; my @ptype_lookup; $self->{period}=$period; $self->{value}=$value; } sub add { my ($self,$units)=@_; if (!defined($units)) { $units=1; } if ($self->getPeriod() == DAY) { my ($year,$month,$day) = Add_Delta_Days($self->{year}, $self->{month}, $self->{day},1*$units); $self->{year}=$year; $self->{month}=$month; $self->{day}=$day; } elsif ($self->getPeriod() == WEEK) { my ($year,$month,$day)=Monday_of_Week($self->{week} , $self->{year}); ($year,$month,$day)=Add_Delta_Days($year,$month,$day,7*$units); my $date=$month.'/'.$day.'/'.$year; $self->{year}=$year; $self->{week}=Week_Number($year, $month, $day); } elsif ($self->getPeriod() == MONTH) { my ($year, $month, $day) = Add_Delta_YM($self->{year}, $self->{month}, '1',0,1*$units); $self->{year}=$year; $self->{month}=$month; } elsif ($self->getPeriod() == QUARTER) { my ($year, $month, $day) = Add_Delta_YM($self->{year}, $self->{month}, '1',0,3*$units); $self->{year}=$year; $self->{month}=$month; } elsif ($self->getPeriod() == YEAR) { my ($year, $month, $day) = Add_Delta_YM($self->{year},'1','1',1*$units,-0); $self->{year}=$year; } } sub getRelativeIndex { my ($self, $end)=@_; if (ref($end) eq ref($self)) { die "Periods do not agree" unless ($self->getPeriod() eq $end->getPeriod()); } if ($self->getPeriod() == DAY) { my $days=Delta_Days( ($self->{year}, $self->{month}, $self->{day}), ($end->{year}, $end->{month}, $end->{day})); return $days; } elsif ($self->getPeriod() == WEEK) { my $weeks=(($end->{year} - $self->{year}) *53) + ($end->{week} - $self->{week}); return $weeks; } elsif ($self->getPeriod() == MONTH) { my $months=(($end->{year} - $self->{year}) *12) + ($end->{month} - $self->{month}); return $months; } elsif ($self->getPeriod() == QUARTER) { my $quarter=(($end->{year} - $self->{year}) *4) + int(($end->{month} - $self->{month})/3); return $quarter; } elsif ($self->getPeriod() == YEAR) { my $years=(($end->{year} - $self->{year}) ) ; return $years; } die "Hour not yet supported. " if ($self->getPeriod() == HOUR); } sub getDate { my ($self, $position, $db) =@_; my $date; if (!defined($position)|| ($position == FIRST)) { if ($self->{period} == YEAR) { $date='1/1/' . $self->{year}; } elsif (($self->{period} == MONTH) || ($self->{period} == QUARTER)) { $date=$self->{month} .'/1/'.$self->{year}; } elsif ($self->{period} == DAY) { $date=$self->{month} .'/'.$self->{day}."/".$self->{year}; } elsif ($self->{period} == WEEK) { my ($year, $month, $day)=Monday_of_Week($self->{week}, $self->{year}); $date=$month.'/'.$day.'/'.$year; } else { die "Period not recognized. "; } } else { if ($self->{period} == YEAR) { $date='12/31/' . $self->{year}; } elsif ($self->{period} == MONTH) { my $day=Days_in_Month($self->{year}, $self->{month}); $date=($self->{month}) .'/'.$day.'/'.$self->{year}; } elsif ($self->{period} == DAY) { $date=$self->{month} .'/'.$self->{day}."/".$self->{year}; } elsif ($self->{period} == WEEK) { my ($year, $month, $day)=Monday_of_Week($self->{week}, $self->{year}); ($year, $month, $day)=Add_Delta_Days($year, $month, $day,6); $date=$month.'/'.$day.'/'.$year; } elsif ($self->{period} == QUARTER) { my $day=Days_in_Month($self->{year}, $self->{month}+2); $date=($self->{month}+2) .'/'.$day.'/'.$self->{year}; } else { die "Period not recognized. "; } } if ($db) { my ($mn, $day,$yr)=$date=~/(.*)\/(.*)\/(.*)/; $mn="0".$mn if ($mn < 10); $day="0".$day if ($day < 10); return "$yr-$mn-$day"; } else { return $date; } } sub keyForPeriod { my ($self, $target_period, $position)=@_; my $result; if ( ($position == FIRST)) { $result= new($target_period, $self->getDate(FIRST)); } else { $result= new($target_period, $self->getDate( LAST)); } } ################################################ #Common Methods ################################################ sub verifyObj { my ($obj)=@_; die "Not defined " if (!defined($obj) ); die "Not a ChronoKey " if (ref($obj) ne "Data::TimeSeries::ChronoKey"); } sub commonPeriod { my ($period1, $period2)=@_; my $iter1=$period1; my $iter2=$period2; while ((!defined($iter1)) || ($iter1 != $iter2)) { if (!defined($iter1)) { $iter2=neighbor($iter2); $iter1=$period1; } else { $iter1=neighbor($iter1); } } return $iter1; } sub neighbor { my ($period)=@_; if ($period eq DAY) { return undef; } elsif ($period eq WEEK) { return DAY; } elsif ($period eq MONTH) { return DAY; } elsif ($period eq QUARTER) { return MONTH; } elsif ($period eq YEAR) { return QUARTER; } } sub Decode_Date { my ($date)=shift; my ($year, $month, $day); if ($date =~ /(\d\d\d\d)-(\d\d)-(\d\d)/) { $year=$1; $month=$2; $day=$3; return ($year, $month, $day); } elsif (($year, $month, $day)=Decode_Date_US($date)) { return ($year, $month, $day); } else { return undef; } } 1; Data-TimeSeries-0.50/TimeSeries.pm~0100644000076500007650000004615510060643324015023 0ustar tjtjpackage Data::TimeSeries; use 5.006; use strict; use warnings; use Date::Calc qw(Decode_Date_US ); use Data::TimeSeries::ChronoKey; require Exporter; our @ISA = qw(Exporter); # Items to export into callers namespace by default. Note: do not export # names by default without a very good reason. Use EXPORT_OK instead. # Do not simply export all your public functions/methods/constants. # This allows declaration use TimeSeries ':all'; # If you do not need this, moving things directly into @EXPORT or @EXPORT_OK # will save memory. our %EXPORT_TAGS = ( 'all' => [ qw( ) ] ); our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ); our @EXPORT = qw( ); our $VERSION = '0.50'; =head1 NAME TimeSeries - Perl extension for Manipulation of Time Series of numbers. TimeSeries supports all the periods of ChronoKey. =head1 SYNOPSIS use TimeSeries; my $start =Data::TimeSeries::ChronoKey::new(Data::TimeSeries::ChronoKey::WEEK, "2004W48"); my $stop =Data::TimeSeries::ChronoKey::new(Data::TimeSeries::ChronoKey::WEEK, "2005W02"); my $timeSeries=Data::TimeSeries::new($start, $stop,Data::TimeSeries::ChronoKey::WEEK,'{3,4,5,6,7,8,9,10}'); $ts->addPoint(Data::TimeSeries::FIRST, 2); $ts->addPoint(Data::TimeSeries::LAST, 12); $ts->seriesOperate(sub {$total+=$_;}); $ts->removePoint(Data::TimeSeries::LAST); $ts->removePoint(Data::TimeSeries::FIRST); $ts->seriesOperate(sub {$total+=$_;}); $copy=$timeSeries->copy(); $ts->normalize(); my $rstart =Data::TimeSeries::ChronoKey::new(Data::TimeSeries::ChronoKey::WEEK, "2004W45"); my $rstop =Data::TimeSeries::ChronoKey::new(Data::TimeSeries::ChronoKey::WEEK, "2004W51"); $resized->resize($rstart, $rstop); $ts->stationize($station); $copy->remap(Data::TimeSeries::ChronoKey::DAY, Data::TimeSeries::SPREAD); =head1 LIMITATIONS/TODO TimeSeries assumes you are working with numeric data where there is a value for every target period. =cut # Preloaded methods go here. # Autoload methods go after =cut, and are processed by the autosplit program. #CONSTANTS use constant FIRST => 1; use constant LAST => 2; #Remap Spreading Types use constant SPREAD=> 4; #replicate value down use constant REPLICATE=> 5; #replicate value down use constant EVEN => 6; #divide up value evenly when spreading #Hash Mapping Methods use constant INTERPOLATE => 3; #AVERAGE when aggregating. use constant STEP => 4; #Used only in new object use Data::Dumper; ################# # Methods associated with class not object. ################## sub compare_dates($$) { my ($date1, $date2)=@_; my ($y1,$m1,$d1,$y2,$m2,$d2); unless (($y1,$m1,$d1)=Decode_Date_US($date1)) { die "Failed to parse ( $date1 ) \n"; } unless (($y2,$m2,$d2)=Decode_Date_US($date2)) { die "Failed to parse $date2\n"; } return -1 if ($y1 <$y2); return 1 if ($y1 >$y2); return -1 if ($m1 <$m2); return 1 if ($m1 >$m2); return -1 if ($d1 <$d2); return 1 if ($d1 >$d2); return 0; } sub convertDatesToKeys { #Convert all the date strings in this array to Data::TimeSeries::ChronoKeys my ($arr,$period)=@_; my @result; foreach my $key(@$arr) { push @result, Data::TimeSeries::ChronoKey::new($period,$key); } return @result; } sub buildDateList { my ($period,$sortedDatesRef)=@_; my $list=[]; foreach my $date(@$sortedDatesRef) { my $cKey=Data::TimeSeries::ChronoKey::new($period,$date); push @$list,$cKey; } return $list; } sub synchronize { my @tsList=@_; my $commonPeriod; foreach my $ts(@tsList) { die "One of the parameters is not a TimeSeries" if (ref($ts) ne 'Data::TimeSeries'); if (defined($commonPeriod)) { $commonPeriod=Data::TimeSeries::ChronoKey::commonPeriod($ts->period(), $commonPeriod); } else { $commonPeriod=$ts->period(); } } my ($start,$end); foreach my $ts(@tsList) # Find the start and end dates. { $ts->remap($commonPeriod,REPLICATE) if ($ts->period() != $commonPeriod); if (!defined($start)) #First Time Series. { $start=$ts->start(); } else { my $startRI=$start->getRelativeIndex($ts->start()); #If Current Start is earlier than ts start. $start=$ts->start() if ($startRI > 0); } if (!defined($end)) #First Time Series. { $end=$ts->end(); } else { my $endRI=$end->getRelativeIndex($ts->end()); #If Current end is later than ts end. $end=$ts->end() if ($endRI < 0); } } #Verify Start < End #Or in other words the series overlap. return 0 if ($start->getRelativeIndex($end) <= 0); foreach my $ts(@tsList) # Find the start and end dates. { $ts->clip($start,$end); $ts->stationize($start); } return 1; } ####################### # Constructor ####################### sub new { #Startdate, enddate, period and series if ((scalar(@_) == 4) ) { my ( $start, $end, $period, $series)=@_; my $self={start=>'',end=>'',period=>'',series=>[]}; bless $self; $self->start($start->copy()); $self->end($end->copy()); $self->period($period); $self->series($series); return $self; } #period and hash series in (date=>value) format. elsif ((scalar(@_)==3) && (ref($_[1]) eq "HASH") && (($_[2] == INTERPOLATE) || ($_[2] == STEP))) { my ($period, $hashSeries, $method)=@_; my @keyDates = keys %$hashSeries; my @sortedDates=sort TimeSeries::compare_dates @keyDates; my @values; #Sort values by the dates order for (my $i=0;$i{$sortedDates[$i]}; } #Loop through every list of time periods and build #an array of chronoKeys. my @sortedChronoKeys=convertDatesToKeys(\@sortedDates, $period); my @builtSeries; #Get first key. my $beginKey = shift @sortedChronoKeys; my $start=$beginKey; my $position=0; my @buildSeries; my $valuePos=0; foreach my $key(@sortedChronoKeys) { my $count=$beginKey->getRelativeIndex($key); if ($method == STEP) { for (my $i=$position;$i<$position+$count;$i++) { $buildSeries[$i]=$values[$valuePos]; } } elsif ($method == INTERPOLATE) { my $diff=$values[$valuePos+1]-$values[$valuePos]; my $ratio=$diff/$count; for (my $i=$position;$i<$position+$count;$i++) { $buildSeries[$i]=$values[$valuePos]+$ratio*($i-$position); } } #Increment to where next date starts. $position =$position + $count; $beginKey=$key; $valuePos++; } #Set Last value in series. $buildSeries[$position ]=$values[$valuePos]; my $self={start=>'',end=>'',period=>'',series=>[]}; bless $self; $self->start($sortedChronoKeys[0]->copy()); $self->end($sortedChronoKeys[scalar(@sortedChronoKeys)-1]->copy()); $self->period($period); $self->series(\@buildSeries); return $self; } else { die "Parameters for new are incorrect."; } } sub start { my ($self, $start)=@_; if ((defined $start) && (ref($start) eq "Data::TimeSeries::ChronoKey")) { $self->{start}=$start; } elsif (!defined $start) { return $self->{start}; } else { die "start object not of type ChronoKey"; } } sub end { my ($self, $end)=@_; if ((defined($end)) && (ref($end) eq "Data::TimeSeries::ChronoKey")) { $self->{end}=$end; } elsif (!defined $end) { return $self->{end}; } else { die "end object not of type ChronoKey"; } } sub period { my ($self, $period)=@_; if (defined $period) { $self->{period}=$period; } else { return $self->{period}; } } sub getCalcLen { my ($self)=@_; my $calcLen=$self->{start}->getRelativeIndex($self->{end})+1; return $calcLen; } sub getStrDateArray { my ($self)=@_; my $len=$self->getCalcLen(); my @result=(); my $curr=$self->start(); for (my $i=0;$i<=$len;$i++) { push @result, $curr->getDate(); $curr->add(1); } return \@result; } sub series { my ($self, $series)=@_; if (defined ($series)) { my $refseries=ref($series); if (!ref($series) ) { $series =~ s/[{}]//g ; my @arr=map {int($_)} split(",",$series);#Convert from strings to int. my $size=$self->{start}->getRelativeIndex($self->{end})+1; my $arrSize=scalar(@arr); if ($arrSize != $size) { die " Dates and array size does not match $arrSize, $size "; } $self->{series}=\@arr; } elsif(ref($series) eq "ARRAY") # Array { my @arr=@$series; $self->{series}=\@arr; } else { die "Unable to handle " ,ref($series), " series type"; } } else { return $self->{series}; } } sub addPoint { my ($self, $position, $value)=@_; die "Not all parameters provided for add Point " if(!defined($value)); #position[ FIRST, LAST, chronoKey] if ($position == Data::TimeSeries::FIRST) { unshift(@{$self->{series}}, $value); $self->{start}->add(-1); } elsif ($position eq Data::TimeSeries::LAST) { push(@{$self->{series}}, $value); $self->{end}->add(); } elsif ((ref($position) eq "Data::TimeSeries::ChronoKey")) { my @data=(); my $index=$self->{start}->getRelativeIndex($position); $self->{end}->add(); for (my $i=0;$i<$self->{start}->getRelativeIndex($self->{end});$i++) { if ($i == $index) { push @data, $value; } push @data, $self->{series}->[$i]; } } #chrono[ FIRST, LAST,date,datetime, mapping] } sub removePoint { my ($self, $position)=@_; die "Not all parameters provided for add Point " if(!defined($position)); if ($position == FIRST) { shift(@{$self->{series}}); $self->{start}->add(); } elsif ($position == LAST) { pop(@{$self->{series}}); $self->{end}->add(-1); } } sub getPoint { my ($self, $chronokey)=@_; #chronokey[ FIRST, LAST,date,datetime, mapping] } sub getLength { my ($self)=@_; my $len=scalar(@{$self->{series}}); return $len; } sub shift { my ($self, $period, $units)=@_; $self->{start}->add($units); $self->{stop}->add($units); } sub seasonalize { my ($self, $period)=@_; } sub stationize { my ($self, $station)=@_; my $ckStation; if (ref $station ne "Data::TimeSeries::ChronoKey") { $ckStation=Data::TimeSeries::ChronoKey::new($self->period, $station); } else { $ckStation=$station; } if (($self->start->getRelativeIndex($ckStation) < 0) || ($self->end->getRelativeIndex($ckStation) > 0)) { die "Station not within range."; } my $position=$self->start->getRelativeIndex($station); my $divisor=$self->series->[$position]; map {$_=$_/$divisor} @{$self->{series}} ; } sub normalize { my ($self)=@_; my $total=0; map {$total+=$_} @{$self->{series}} ; map {$_=$_/$total} @{$self->{series}} ; } sub resize { my ($self, $start, $end,$method)=@_; $method=INTERPOLATE if (!defined($method)); #default to interpolate method Data::TimeSeries::ChronoKey::verifyObj($start); Data::TimeSeries::ChronoKey::verifyObj($end); my @vals; my $targetLen=$start->getRelativeIndex($end)+1; $targetLen--; my $srcLen=$self->getLength(); $srcLen--; my $gcd=_getGCD($srcLen, $targetLen); my $lcm=($srcLen/$gcd) * $targetLen; my $j=0; for (my $i=0;$i<($lcm);$i+=$gcd*$targetLen) { my $k; for ($k=$i;$k<=($i + ($gcd * $targetLen));$k++) { $vals[$k]=((($self->series()->[$j+1] - $self->series()->[$j])/ ($gcd * $targetLen))*($k-$i)) + $self->series()->[$j]; } $j++; } my @result; for (my $i=0;$i<=$targetLen;$i++) { $result[$i]=$vals[$i*($lcm/$targetLen)] } my $seriesTotal=0; my $resTotal=0; if ($method == SPREAD) { for (my $i=0;$i<=$srcLen;$i++) { $seriesTotal+=$self->series()->[$i]; } for (my $i=0;$i<=$targetLen;$i++) { $resTotal+=$result[$i]; } for (my $i=0;$i<=$targetLen;$i++) { $result[$i]=($result[$i]/$resTotal)*$seriesTotal; } } $self->series(\@result); $self->start($start); $self->end($end); } sub seriesOperate { my ($self,$closure)=@_; map {&$closure()} @{$self->series()}; } sub remap { my ($self, $period,$remapType )=@_; my @result; #Remap not handling period properly. return if ($self->period() == $period); return die "Period not below or common to self's period." if (Data::TimeSeries::ChronoKey::commonPeriod($self->period(), $period) != $period); my $start=$self->start()->copy(); my $last=$self->end()->copy(); my @dataCopy=@{$self->series()}; for (my $topCurr=$start->copy();$topCurr->getRelativeIndex($last)>=0;$topCurr->add()) { my $currVal=CORE::shift(@dataCopy); my $cstart=$topCurr->keyForPeriod($period, FIRST); my $clast=$topCurr->keyForPeriod($period, LAST); my $relidx=$cstart->getRelativeIndex($clast); for (my $iCurr=0;$iCurr<=$relidx;$iCurr++) { #Assume Replicate for now. if ($remapType == REPLICATE) { push @result, $currVal; } elsif($remapType == SPREAD) { push @result, $currVal/($relidx+1); } else { die "Did not recognize remap type $remapType \n"; } } } $self->series(\@result); $self->period($period); $start=$self->start()->keyForPeriod($period, FIRST); $last=$last->keyForPeriod($period, LAST); $self->start($start); $self->end($last); } sub clip { my ($self, $start, $end)=@_; if (!defined $end) { $end=$self->end(); } my $startShift=$self->{start}->getRelativeIndex($start); die "Start before objects start" if ($startShift < 0); my $endShift=$self->{start}->getRelativeIndex($end); die "End before object's end. $endShift" if ($endShift > scalar(@{$self->{series}})); if ($endShift < $startShift) { die "End Date before Start Date"; } my @newSeries; for (my $i=$startShift;$i<=$endShift;$i++) { push(@newSeries, $self->{series}->[$i]); } $self->{start}=$start; $self->{end}=$end; $self->{series}=\@newSeries; } sub copy { my ($self)=@_; my $copy=new($self->{start}, $self->{end}, $self->{period}, $self->{series}); bless $copy; @{$copy->{series}}=@{$self->{series}}; return $copy; } sub pack { my ($self)=@_; my $count=$self->getCalcLen(); return pack "d" x $count, @{$self->series()}; } sub unpack { my ($start, $end, $period,$packed) = @_; $start=~ s/(.*?) \d\d:\d\d:\d\d/$1/g; $end=~ s/(.*?) \d\d:\d\d:\d\d/$1/g; my $ckStart=Data::TimeSeries::ChronoKey::new($period, $start); my $ckEnd=Data::TimeSeries::ChronoKey::new($period, $end); my $count=$ckStart->getRelativeIndex($ckEnd) + 1; my @arr = unpack "d" x $count, $packed; my $ts=new($ckStart,$ckEnd,$period,\@arr); return $ts; } ################################################### sub _getGCD { my ($v1, $v2)=@_; my ($largest, $smallest); if ($v1>$v2) { $largest=$v1; $smallest=$v2; } else { $largest=$v2; $smallest=$v1; } my $d=$largest; my $r=$smallest; while ($r!=0) { $largest=$d; $d=$r; $r=$largest % $d; } return $d; } 1; __END__ # Below is stub documentation for your module. You better edit it! =head1 METHODS =item C $ts = Data::TimeSeries::new($start, $end, $period, $series); Creates and initalizes TimeSeries object. C dies if parameters are not legal. $start - ChronoKey object. The position of the first element in the serines. $end - ChronoKey object. The position of the last element in the series. $period - A ChronoKey Period $series - An array or a string that has the following format {1,2,4}. Should be of integer or floating point numbers. =item C $ck = $ts->start(); $ts->start($ck); The C method is the start position accesor. It can be used to get or set the start position. Setting the start position directly is strongly discouraged. Use C or C instead. =item C $ck = $ts->end(); $ts->end($ck); The C method is the end position accesor. It can be used to get or set the end position. Setting the end position directly is strongly discouraged. Use C or C instead. =item C $period = $ts->period(); $ts->period($period); The C method is the period of the time series. It can be used to get or set the period. Setting the end period directly is strongly discouraged. =item C \@series = $ts->series(); $ts->series(\@series); $ts->series("{1,2,3}"); The C method is the series of the time series. It can be used to get or set the series. Setting the end series directly is somewhat discouraged. If you do set it, make sure it is the same length as the one you are replacing. =item C $length = $ts->getCalcLen(); The C method is used to get the number of periods from the start and end positions (inclusive). It should be the same length as the series array. =item C $ts->addPoint(TimeSeries::FIRST, 10.00); $ts->addPoint(TimeSeries::LAST, 15.00); $ts->addPoint($ck, 12.00); C Method allows you to add a new point to the beginning or end of a timeseries. Or you can add it somewhere within the series. The ChronoKey ($ck) must be within the existing range. The series will be stretched forward to accomodate the new point. =item C $ts->removePoint(TimeSeries::FIRST); $ts->removePoint(TimeSeries::LAST); $ts->removePoint($ck); The inverse of addPoint. Allows you to remove the first, last or a cnter point. =item C $ts->getPoint(TimeSeries::FIRST); $ts->getPoint(TimeSeries::LAST); $ts->removePoint($ck); C gets the point at the specified position. =item C $len=$ts->getLength(); C gets the length of the time series. =item C $ts->shift($units) C shifts the time series by $units number of periods. =item C $ts->seasonalize() =item C $ts->normalize() Takes the time series and makes it sum to 1. =item C $ts->resize($start, $end) Stretches or shrinks the time series to fit the $start and $end chronokeys. Linear Interpolation is used to build missing values. =item C $ts->seriesOperate(sub {$_*=20;}) Runs an operation on every item in the series. =item C $ts->clip($startCK,$endCK); Cuts down the time series to the specified start and end positions. =item C $ts2=$ts->copy(); Creates a copy of the time series. Runs an operation on every item in the series. TODO =item C ($slope, $constant)=$ts->regression(); Runs a regression algorithm on a time series. =head1 DESCRIPTION Data::TimeSeries allows easy manipulation of timeseries related data. =head2 EXPORT None by default. =head1 AUTHOR ts(at)atlantageek.com =head1 SEE ALSO L. =cut Data-TimeSeries-0.50/Makefile.PL~0100644000076500007650000000076710060636021014361 0ustar tjtjuse 5.008; use ExtUtils::MakeMaker; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. WriteMakefile( 'NAME' => 'Data::TimeSeries', 'VERSION_FROM' => 'TimeSeries.pm', # finds $VERSION 'PREREQ_PM' => {}, # e.g., Module::Name => 1.1 ($] >= 5.005 ? ## Add these new keywords supported since 5.005 (ABSTRACT_FROM => 'TimeSeries.pm', # retrieve abstract from module AUTHOR => 'tj ') : ()), ); Data-TimeSeries-0.50/README~0100644000076500007650000000205510060643520013261 0ustar tjtjData/TimeSeries version 0.01 ============================ The README is used to introduce the module and provide instructions on how to install the module, any machine dependencies it may have (for example C compilers and installed libraries) and any other information that should be provided before the module is installed. A README file is required for CPAN modules since CPAN extracts the README file from a module distribution so that people browsing the archive can use it get an idea of the modules uses. It is usually a good idea to provide version information here so that people can decide whether fixes for the module are worth downloading. INSTALLATION To install this module type the following: perl Makefile.PL make make test make install DEPENDENCIES This module requires these other modules and libraries: Date::Calc COPYRIGHT AND LICENCE Put the correct copyright and licence information here. Copyright (C) 2004 tj This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Data-TimeSeries-0.50/pm_to_blib0100644000076500007650000000000010071421145014217 0ustar tjtjData-TimeSeries-0.50/MANIFEST~0100644000076500007650000000007010060634705013532 0ustar tjtjChanges Makefile.PL MANIFEST README TimeSeries.pm t/1.t