Subtract months from given date - perl

I have a date in the future, from which I have to subtract 3 months at a time until the current date is reached.
The reached date after subtracting the months must be closest to the current date, but has to be in the future.
The day of the month is always the 23rd
i.e.:
future date = 2015/01/23
current date = 2014/06/05
result = 2014/07/23
I'm running Solaris, so don't have access to GNU date.
I tried to do this in Perl, but unfortunately I can only use the Time::Local module:
#!/bin/ksh
m_date="2019/05/23"
m_year=$(echo $m_date|cut -d/ -f1)
m_month=$(echo $m_date|cut -d/ -f2)
m_day=$(echo $m_date|cut -d/ -f3)
export m_year m_month m_day
perl -MTime::Local -le '
$time = timelocal(localtime);
$i = 3;
while (timelocal(0, 0, 0, $ENV{'m_day'}, $ENV{'m_month'} - $i, $ENV{'m_year'}) > $time) {
print scalar(localtime(timelocal(0, 0, 0, $ENV{'m_day'}, $ENV{'m_month'} - $i, $ENV{'m_year'})));
$i += 3;
}
'
This only works for months within one year. Is there any other way I can do this?

It is simple enough to just split the date strings and do the arithmetic on the fields.
use strict;
use warnings;
use 5.010;
my $future = '2015/01/23';
my $current = do {
my #current = localtime;
$current[3] += 1;
$current[5] += 1900;
sprintf '%04d/%02d/%02d', #current[5,4,3];
};
my $result;
for (my $test = $future; $test gt $current; ) {
$result = $test;
my #test = split /\//, $test;
if (($test[1] -= 3) < 1) {
--$test[0];
$test[1] += 12;
}
$test = sprintf '%04d/%02d/%02d', #test;
}
say $result;
output
2014/07/23
Alternatively you could just do the division to calculate how many whole quarters to subtract, like this
use strict;
use warnings;
use 5.010;
my $future = '2015/01/23';
my #current = (localtime)[5,4,3];
$current[1] += 1;
$current[0] += 1900;
my #future = split /\//, $future;
my $months = ($future[0] - $current[0]) * 12 + $future[1] - $current[1];
$months -= 1 if $current[2] >= 23;
my #result = #current;
$result[2] = 23;
$result[1] += $months % 3;
$result[0] += int(($result[1] - 1) / 12);
$result[1] = ($result[1] - 1) % 12 + 1;
my $result = sprintf '%04d/%02d/%02d', #result;
say $result;
The output is identical to that of the previous code

This is your script changed so it should work across multiple years,
perl -MTime::Local -le'
sub nextm {
$ENV{m_year}--, $ENV{m_month} +=12 if ($ENV{m_month} -= 3) <1;
timelocal(0, 0, 0, $ENV{m_day}, $ENV{m_month}, $ENV{m_year});
}
my $time = timelocal(localtime);
while ((my $c=nextm()) > $time) {
print scalar localtime($c);
}
'

Try something like:
#!/usr/bin/perl -w
# just convert the real date that you have to epoch
my $torig = 1558569600;
my $tnow = time;
# 3 months in seconds to use the epoch everywhere
my $estep = 3 * 30 * 24 * 3600;
while(($torig - $estep) > $tnow){
$torig -= $estep;
}
print $torig,"\n";
print scalar localtime($torig),"\n";
The only problem here is that a months is an approximation, if you need the very same day but minus 3 months, you could use DateCalc

I ended up scripting it all in KSH instead of perl, thanks to Borodin's logic.
#!/bin/ksh
set -A c_date $(date '+%Y %m %d')
IFS=/ d="2019/05/23"
set -A m_date $d
[[ ${c_date[2]} -gt ${m_date[2]} ]] && ((c_date[1]+=1))
c_date[2]=${m_date[2]}
c_date[1]=$(( (((${m_date[0]} - ${c_date[0]}) * 12) + (${m_date[1]} - ${c_date[1]})) % 3 + ${c_date[1]} ))
if [[ ${c_date[1]} -gt 12 ]] ; then
((c_date[0]+=1))
((c_date[1]-=12))
fi
echo ${c_date[#]}

Related

Perl : Getting last Friday of the month

I am trying to get the last Friday of the month. I found out the awesome awk script that could to do this job. I try to port it perl but facing some issues. Any insight would be a great help. I can't use any perl modules apart from the inbuilt one, thats why I have to go through building this stuff.
Thanks for your help.
AWK script :
BEGIN {
split("31,28,31,30,31,30,31,31,30,31,30,31",daynum_array,",") # days per month in non leap year
year = ARGV[1]
if (year % 400 == 0 || (year % 4 == 0 && year % 100 != 0)) {
daynum_array[2] = 29
}
y = year - 1
k = 44 + y + int(y/4) + int(6*(y/100)) + int(y/400)
for (m=1; m<=12; m++) {
k += daynum_array[m]
d = daynum_array[m] - (k%7)
printf("%04d-%02d-%02d\n",year,m,d)
}
exit(0)
}
My Perl script :
my #time = localtime;
my ($month, $year) = #time[4, 5];
$year += 1900;
#months = qw( 31 28 31 30 31 30 31 31 30 31 30 31 );
$months[1] = check_leap_year($year) ? 29 : 28;
$y = $year - 1;
$k = 44 + $y + int($y / 4) + int(6 * ($y / 100)) + int($y / 400);
$k += $months[$month];
$d = $months[$month] - ($k % 7);
$month += 1;
printf "%04d-%02d-%02d\n", $year, $month, $d;
sub check_leap_year {
my $year = shift;
return 0 if $year % 4;
return 1 if $year % 100;
return 0 if $year % 400;
return 1;
}
There's a few ways to do this. Using Time::Piece isn't the simplest, it isn't designed for date math, but you don't have to install additional software.
use v5.10;
use strict;
use warnings;
use Time::Piece;
sub get_last_dow_in_month {
my($year, $month, $dow) = #_;
# Get a Time::Piece object at the last day of the month.
my $first_of_the_month = Time::Piece->strptime("$year $month", "%Y %m");
my $last_day = $first_of_the_month->month_last_day;
my $last_of_the_month = Time::Piece->strptime("$year $month $last_day", "%Y %m %d");
# Figure out how many days you need to go back.
my $days_offset = -(($last_of_the_month->day_of_week + (7 - $dow)) % 7);
return $last_of_the_month->mday + $days_offset;
}
say get_last_dow_in_month(2014, 3, 5);
If you need to do more date processing, DateTime is the most comprehensive.
Modules are made to be used. Calc last friday of month on PerlMonks contains some examples.
E.g.
$ perl -MDate::Manip -E 'say UnixDate(ParseDate("last Friday in March 2015"),"Last Friday of the month is %B %E, %Y.")
Last Friday of the month is March 27th, 2015.
Rather than working around the technical limitation, you need to work around the social limitation that is hampering the technical side of your job.
If you are constrained by using core modules only, this is the way to compute it:
use strict;
use warnings;
use Time::Local qw[];
# Computes the last day in the given month which occurs on the given
# day of the week. Returns the day of the month [22, 31].
# 1 <= $month <= 12
# 0 <= $dow <= 6 (0=Sunday)
sub last_dow_in_month {
my ($year, $month, $dow) = #_;
$year += int($month / 12);
$month %= 12;
my $time = Time::Local::timegm(0, 0, 0, 1, $month, $year) - 86400;
my ($mday, $wday) = (gmtime($time))[3,6];
return $mday - ($wday - $dow) % 7;
}
my $year = 2015;
foreach my $month (1..12) {
printf "%.4d-%.2d-%.2d\n",
$year, $month, last_dow_in_month($year, $month, 5);
}
Output:
2015-01-30
2015-02-27
2015-03-27
2015-04-24
2015-05-29
2015-06-26
2015-07-31
2015-08-28
2015-09-25
2015-10-30
2015-11-27
2015-12-25
Using DateTime the code becomes more readable:
use DateTime;
# Computes the last day in the given month which occurs on the given
# day of the week. Returns the day of the month [22, 31].
# 1 <= $month <= 12
# 1 <= $dow <= 7 (1=Monday)
sub last_dow_in_month {
my ($year, $month, $dow) = #_;
my $dt = DateTime->last_day_of_month(year => $year, month => $month);
$dt->subtract(days => ($dt->day_of_week - $dow) % 7);
return $dt->day_of_month;
}
If performance is of essence, Time::Moment can be used to compute it:
use Time::Moment qw[];
# Computes the last day in the given month which occurs on the given
# day of the week. Returns the day of the month [22, 31].
# 1 <= $month <= 12
# 1 <= $dow <= 7 (1=Monday)
sub last_dow_in_month {
my ($year, $month, $dow) = #_;
my $tm = Time::Moment->new(year => $year, month => $month)
->plus_months(1)
->minus_days(1);
return $tm->minus_days(($tm->day_of_week - $dow) % 7)
->day_of_month;
}
A correct implementation of your intended algorithm:
# Computes the last friday in the given month. Returns the day of the
# month [22, 31].
# 1 <= $month <= 12
sub last_friday_in_month {
my ($year, $month) = #_;
my $days = (
[0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334, 365],
[0, 31, 60, 91, 121, 152, 182, 213, 244, 274, 305, 335, 366],
)[($year % 4) == 0 && ($year % 100 != 0 || $year % 400 == 0)];
my $y = $year - 1;
my $k = 44 + $y + int($y/4) + int(6 * ($y/100)) + int($y/400);
$k += $days->[$month];
return $days->[$month] - $days->[$month - 1] - ($k % 7);
}
This is just for variety. As #Schwern notes, "cal is a clever hack, but it's a crutch that lets the OP avoid learning to use a good date library. Calendaring is hard, use a library."
Assuming you have cal on your system
#!/usr/bin/env perl
use strict;
use warnings;
local $ENV{LC_ALL} = 'C';
my #cal = `cal`;
my $last_friday;
for (my $i = $#cal; $i >= 0; $i -= 1) {
my #dates = split ' ', $cal[$i];
next unless #dates > 5;
$last_friday = $dates[5];
last;
}
print "$last_friday\n";
Or, more succinctly, but somewhat less efficiently:
#!/usr/bin/env perl
use strict;
use warnings;
local $ENV{LC_ALL} = 'C';
my ($last_friday) = grep defined, map +(split)[5], reverse `cal`;
print "$last_friday\n";
Or, even,
#!/usr/bin/env perl
use strict;
use warnings;
use List::Util qw( first );
local $ENV{LC_ALL} = 'C';
my $last_friday = first { defined } map +(split)[5], reverse `cal`;
print "$last_friday\n";

List of days between start and end dates

Im trying to get each individual date between a start and an end date in Perl. I had initially done it for 7 days using the code below :
use Time::ParseDate;
my $newdate;
my $newtime;
my #dates = ();
my $newtime->[0] = parsedate($start_datetime);
my $newdate->[0] = strftime("%Y-%m-%d",localtime($newtime->[0]));
push(#dates, $newdate->[0]);
my $newtime->[1] = parsedate($newdate->[0]) + (1 * 24 * 60 * 60);
my $newdate->[1] = strftime("%Y-%m-%d",localtime($newtime->[1]));
push(#dates, $newdate->[1]);
my $newtime->[2] = parsedate($newdate->[1]) + (1 * 24 * 60 * 60);
my $newdate->[2] = strftime("%Y-%m-%d",localtime($newtime->[2]));
push(#dates, $newdate->[2]);
my $newtime->[3] = parsedate($newdate->[2]) + (1 * 24 * 60 * 60);
my $newdate->[3] = strftime("%Y-%m-%d",localtime($newtime->[3]));
push(#dates, $newdate->[3]);
my $newtime->[4] = parsedate($newdate->[3]) + (1 * 24 * 60 * 60);
my $newdate->[4] = strftime("%Y-%m-%d",localtime($newtime->[4]));
push(#dates, $newdate->[4]);
my $newtime->[5] = parsedate($newdate->[4]) + (1 * 24 * 60 * 60);
my $newdate->[5] = strftime("%Y-%m-%d",localtime($newtime->[5]));
push(#dates, $newdate->[5]);
my $newtime->[6] = parsedate($newdate->[5]) + (1 * 24 * 60 * 60);
my $newdate->[6] = strftime("%Y-%m-%d",localtime($newtime->[6]));
push(#dates, $newdate->[6]);
my $newtime->[7] = parsedate($newdate->[6]) + (1 * 24 * 60 * 60);
my $newdate->[7] = strftime("%Y-%m-%d",localtime($newtime->[7]));
push(#dates, $newdate->[7]);
but realized that it should be able to work for any number of days.
so I tried the loop below but it didnt quite work for me
my $newdate;
my $newtime;
my #dates = ();
my $start_date = substr($start_datetime, 0, 10) ;
$start_date =~ s/-//gi;
my $end_date = substr($end_datetime, 0, 10) ;
$end_date =~ s/-//gi;
my $days = yyyymmdd_to_rata_die($end_date) - yyyymmdd_to_rata_die($start_date);
my $newtime->[0] = parsedate($xml->{action_content}->{start_date});
my $newdate->[0] = strftime("%Y-%m-%d",localtime($newtime->[0]));
push(#dates, $newdate->[0]);
for(my $x=1;$x<$days;$x++)
{
my $newtime->[$x] = parsedate($newdate->[$x-1]) + (1 * 24 * 60 * 60);
my $newdate->[$x] = strftime("%Y-%m-%d",localtime($newtime->[$x]));
push(#dates, $newdate->[$x]);
}
I got the function below from a question here on Stackoverflow
sub yyyymmdd_to_rata_die
{
use integer;
my ( $y, $m, $d ) = $_[0] =~ /\A([0-9]{4})([0-9]{2})([0-9]{2})\z/
or return;
my $adj;
if ( $m <= 2 )
{
$y -= ( $adj = ( 14 - $m ) / 12 );
$m += 12 * $adj;
}
elsif ( $m > 14 )
{
$y += ( $adj = ( $m - 3 ) / 12 );
$m -= 12 * $adj;
}
$d += ( $m * 367 - 1094 ) / 12 + $y % 100 * 1461 / 4 + ( $y / 100 * 36524 + $y / 400 ) - 306;
}
any assistance will be greatly apreciated
EDIT:
$start_datetime = "2014-09-01 00:00:00";
$end_datetime = "2014-09-07 23:59:59";
I need all the days in between the start and end date ie.
2014-09-01
2014-09-02
2014-09-03
2014-09-04
2014-09-05
2014-09-06
2014-09-07
I recommend that you use the Time::Piece module. It shouldn't need installing as it has been a core module since version 10 of Perl 5.
It would look like this
use strict;
use warnings;
use Time::Piece;
print days_between('2014-01-01', '2014-12-01'), "\n";
sub days_between {
my ($start, $end) = map Time::Piece->strptime($_, '%Y-%m-%d'), #_;
($end - $start)->days;
}
output
334
Update
I apologize. I misunderstood your requirements and thought you wanted the number of days between the two dates. This program prints a list of all the dates between and including the two limits. If called in scalar context it will provide the number of days in the list, as before.
use strict;
use warnings;
use Time::Piece;
use Time::Seconds qw/ ONE_DAY /;
printf "%d days:\n", scalar days_from_to('2014-09-01 00:00:00', '2014-09-07 23:59:59');
print "$_\n" for days_from_to('2014-09-01 00:00:00', '2014-09-07 23:59:59');
sub days_from_to {
my #limits = map /(\d\d\d\d-\d\d-\d\d)/, #_;
#limits = map Time::Piece->strptime($_, '%Y-%m-%d'), #limits;
my #dates = ( $limits[0] );
push #dates, $dates[-1] + ONE_DAY while $dates[-1] < $limits[-1];
map $_->ymd, #dates;
}
output
7 days:
2014-09-01
2014-09-02
2014-09-03
2014-09-04
2014-09-05
2014-09-06
2014-09-07
Update
If a more critical regex is required that will reject strings like 0123-45-67 then you can use this
my $date_re = qr/(?:
(?: (?:19|20)[0-9][0-9] ) -
(?:
(?: 0?[469] | 11 ) -
(?: 0?[1-9] | [12][0-9] | 30 )
|
(?: 0?[13578] | 1[02] ) -
(?: 0?[1-9] | [12][0-9] | 3[01] )
|
(?: 0?2 ) -
(?: 0?[1-9] | [12][0-9] )
)
)/x;
which will accept dates between 1900 and 2099, and makes sure that the day of the month is valid for that month. The only proviso is that it will allow 29 February in any year.
Or you may prefer to use Regexp::Common::time like this
use Regexp::Common qw/ time /;
my $date_re = $RE{time}{strftime}{-pat => '%Y-%m-%d'};
but this has the same issue with 29 February.
The subroutine will look like this
sub days_from_to {
my #limits = map /($date_re)/, #_;
#limits = map Time::Piece->strptime($_, '%Y-%m-%d'), #limits;
my #dates = ( $limits[0] );
push #dates, $dates[-1] + ONE_DAY while $dates[-1] < $limits[-1];
map $_->ymd, #dates;
}
You can make your life a lot easier by using something like Time::Piece;
#!/usr/bin/perl
use strict;
use warnings;
use 5.010;
use Time::Piece;
use Time::Seconds;
my $fmt = '%Y-%m-%d';
my $start_date = '2014-09-08';
my $days = 30;
my #dates;
my $date = Time::Piece->strptime($start_date, $fmt);
foreach (1 .. $days) {
push #dates, $date;
$date += ONE_DAY;
}
say $_ for #dates;
Update: Looks like Borodin's answer uses a very similar approach and deals with the inputs and required outputs that you have added to your question.

Perl to count current value based on next value

Currently I'm learning Perl and gnuplot. I would like to know how to count certain value based on the next value. For example I have a text file consist of:
#ID(X) Y
1 1
3 9
5 11
The output should show the value of the unknown ID as well. So, the output should show:
#ID(X) Y
1 1
2 5
3 9
4 10
5 11
The Y of ID#2 is based on the following:
((2-3)/(1-3))*1 + ((2-1)/(3-1))*9 which is linear algebra
Y2=((X2-X3)/(X1-X3))*Y1 + ((X2-X1)/(X3-X1)) * Y3
Same goes to ID#5
Currently I have this code,
#! /usr/bin/perl -w
use strict;
my $prev_id = 0;
my $prev_val = 0;
my $next_id;
my $next_val;
while (<>)
{
my ($id, $val) = split;
for (my $i = $prev_id + 1; $i < $next_id; $i++)
{
$val = (($id - $next_id) / ($prev_id - $next_id)) * $prev_val + (($id - $prev_id) / ($next_id - $prev_id)) * $next_val;
printf ("%d %s\n", $i, $val);
}
printf ("%d %s\n", $id, $val);
($prev_val, $prev_id) = ($val, $id);
($next_val, $next_id) = ($prev_val, $prev_id);
}
Your formula seems more complicated than I would expect, given that you are always dealing with integer spacings of 1.
You did not say whether you want to fill gaps for multiple consecutive missing values, but let's assume you want to.
What you do is read in the first line, and say that's the current one and you output it. Now you read the next line, and if its ID is not the expected one, you fill the gaps with simple linear interpolation...
Pseudocode
(currID, currY) = readline()
outputvals( currID, currY )
while lines remain do
(nextID, nextY) = readline()
gap = nextID - currID
for i = 1 to gap
id = currID + i
y = currY + (nextY - currY) * i / gap
outputvals( id, y )
end
(currID, currY) = (nextID, nextY)
end
Sorry for the non-Perl code. It's just that I haven't been using Perl for ages, and can't remember half of the syntax. =) The concepts here are pretty easy to translate into code though.
Using an array may be the way to go. This will also make your data available for further manipulation.
** Caveat: will not work for multiple consecutive missing values of y; see #paddy's answer.
#!/usr/bin/perl
use strict;
use warnings;
my #coordinates;
while (<DATA>) {
my ($x, $y) = split;
$coordinates[$x] = $y;
}
# note that the for loop starts on index 1 here ...
for my $x (1 .. $#coordinates) {
if (! $coordinates[$x]) {
$coordinates[$x] = (($x - ($x + 1)) / (($x - 1) - ($x + 1)))
* $coordinates[$x - 1]
+ (($x - ($x - 1)) / (($x + 1) - ($x - 1)))
* $coordinates[$x + 1];
}
print "$x - $coordinates[$x]\n";
}
__DATA__
1 1
3 9
5 11
You indicated your problem is getting the next value. The key isn't to look ahead, it's to look behind.
my $prev = get first value;
my ($prev_a, $prev_b) = parse($prev);
my $this = get second value;
my ($this_a, $this_b) = parse($this);
while ($next = get next value) {
my ($next_a, $next_b) = parse($next);
...
$prev = $this; $prev_a = $this_a; $prev_b = $this_b;
$this = $next; $this_a = $next_a; $this_b = $next_b;
}
#! /usr/bin/perl -w
use strict;
my #in = (1,9,11);
my #out;
for (my $i = 0; $i<$#in; $i++) {
my $j = $i*2;
my $X1 = $i;
my $X2 = $i+1;
my $X3 = $i+2;
my $Y1 = $in[$i];
my $Y3 = $in[$i+1];
my $Y2 = $Y1*(($X2-$X3)/($X1-$X3))
+ $Y3*(($X2-$X1)/($X3-$X1));
$out[$j] = $in[$i];
$out[$j+1] = $Y2;
}
$out[$#in*2] = $in[$#in];
print (join " ",#out);

What's the best way to get the UTC offset in Perl? [duplicate]

This question already has answers here:
strftime does not return abbreviated time zone
(3 answers)
Closed last year.
I need to get the UTC offset of the current time zone in Perl in a cross platform (Windows and various flavors of Unix) way. It should meet this format:
zzzzzz, which represents ±hh:mm in relation to UTC
It looks like I should be able to get it via strftime(), but it doesn't appear to be consistent.
Unix:
Input: perl -MPOSIX -e "print strftime(\"%z\", localtime());"
Output: -0700
Windows:
Input: perl -MPOSIX -e "print strftime(\"%z\", localtime());"
Output: Mountain Standard Time
While it appears that Unix is giving me what I want (or at least something close), Windows is not. I'm pretty sure I can do it with Date::Time or similar, but I'd really like to not have any dependencies that I can't guarantee a user will have due to our wide install base.
Am I missing something obvious here? Thanks in advance.
Time::Local should do the trick
use Time::Local;
#t = localtime(time);
$gmt_offset_in_seconds = timegm(#t) - timelocal(#t);
Here is a portable solution using only the core POSIX module:
perl -MPOSIX -e 'my $tz = (localtime time)[8] * 60 - mktime(gmtime 0) / 60; printf "%+03d:%02d\n", $tz / 60, abs($tz) % 60;'
Bonus: The following subroutine will return a full timestamp with time zone offset and microseconds, as in "YYYY-MM-DD HH:MM:SS.nnnnnn [+-]HHMM":
use POSIX qw[mktime strftime];
use Time::HiRes qw[gettimeofday];
sub timestamp () {
my #now = gettimeofday;
my $tz = (localtime $now[0])[8] * 60 - mktime(gmtime 0) / 60;
my $ts = strftime("%Y-%m-%d %H:%M:%S", localtime $now[0]);
return sprintf "%s.%06d %+03d%02d", $ts, $now[1], $tz / 60, abs($tz) % 60;
}
You can compute the difference between localtime($t) and gmtime($t). Here is my version inspired by mob's answer:
use strict;
use warnings;
sub tz_offset
{
my $t = shift;
my #l = localtime($t);
my #g = gmtime($t);
my $minutes = ($l[2] - $g[2] + ((($l[5]<<9)|$l[7]) <=> (($g[5]<<9)|$g[7])) * 24) * 60 + $l[1] - $g[1];
return $minutes unless wantarray;
return (int($minutes / 60), $minutes % 60);
}
push #ARGV, time;
foreach my $t (#ARGV) {
printf "%s (%d): %+03d%02u\n", scalar localtime($t), $t, tz_offset($t);
}
An alternative is to use Time::Piece like below, docs here
my $offsetinsecs = localtime(time)->tzoffset;
my $datetimetz = sprintf("%+2d:%02d", $datetimetz, $offsetinsecs/3600, abs($offsetinsecs/60%60));
One way to manually test is by changing the tz
use POSIX qw(tzset);
$ENV{TZ} = 'America/Los_Angeles';
related stackoverflow anser: https://stackoverflow.com/a/56396873/11337921
A portable way is to compare the output of localtime with gmtime
$t = time;
#a = localtime($t);
#b = gmtime($t);
$hh = $a[2] - $b[2];
$mm = $a[1] - $b[1];
# in the unlikely event that localtime and gmtime are in different years
if ($a[5]*366+$a[4]*31+$a[3] > $b[5]*366+$b[4]*31+$b[3]) {
$hh += 24;
} elsif ($a[5]*366+$a[4]*31+$a[3] < $b[5]*366+$b[4]*31+$b[3]) {
$hh -= 24;
}
if ($hh < 0 && $mm > 0) {
$hh++;
$mm = 60-$mm;
}
printf "%+03d:%02d\n", $hh, $mm;
Someone pointing out that this is already implemented in a module somewhere in 5, 4, 3, ...

How can I sum data over five minute time intervals in Perl?

I have a file in below format.
DATE Time, v1,v2,v3
05:33:25,n1,n2,n3
05:34:25,n4,n5,n5
05:35:24,n6,n7,n8
and so on upto 05:42:25.
I want calculate the values v1, v2 and v3 for every 5 min interval. I have written the below sample code.
while (<STDIN>) {
my ($dateTime, $v1, $v2, $v3) = split /,/, $_;
my ($date, $time) = split / /, $dateTime;
}
I can read all the values but need help to sum all the values for every 5 min interval. Can anyone please suggest me the code to add the time and values for every 5 min.
Required output
05:33 v1(sum 05:33 to 05:37) v2(sum 05:33 to 05:33) v3(sum 05:33 to 05:33)
05:38 v1(sum 05:38 to 05:42) v2(sum 05:38 to 05:42) v3(sum 05:38 to 05:42)
and so on..
The code is a variation the previous answer by Sinan Ünür below, except:
(1) Function timelocal will allow you to read in Day,Month,Year -- so you can sum any five minute gap.
(2) Should deal with case where final time gap is < 5 minutes.
#!/usr/bin/perl -w
use strict;
use warnings;
use Time::Local;
use POSIX qw(strftime);
my ( $start_time, $end_time, $current_time );
my ( $totV1, $totV2, $totV3 ); #totals in time bands
while (<DATA>) {
my ( $hour, $min, $sec, $v1, $v2, $v3 ) =
( $_ =~ /(\d+)\:(\d+)\:(\d+)\,(\d+),(\d+),(\d+)/ );
#convert time to epoch seconds
$current_time =
timelocal( $sec, $min, $hour, (localtime)[ 3, 4, 5 ] ); #sec,min,hr
if ( !$end_time ) {
$start_time = $current_time;
$end_time = $start_time + 5 * 60; #plus 5 min
}
if ( $current_time <= $end_time ) {
$totV1 += $v1;
$totV2 += $v2;
$totV3 += $v3;
}
else {
print strftime( "%H:%M:%S", localtime($start_time) ),
" $totV1,$totV2,$totV3\n";
$start_time = $current_time;
$end_time = $start_time + 5 * 60; #plus 5 min
( $totV1, $totV2, $totV3 ) = ( $v1, $v2, $v3 );
}
}
#Print results of final loop (if required)
if ( $current_time <= $end_time ) {
print strftime( "%H:%M:%S", localtime($start_time) ),
" $totV1,$totV2,$totV3\n";
}
__DATA__
05:33:25,29,74,96
05:34:25,41,69,95
05:35:25,24,38,55
05:36:25,96,63,70
05:37:25,84,65,74
05:38:25,78,58,93
05:39:25,51,38,19
05:40:25,86,40,64
05:41:25,80,68,65
05:42:25,4,93,81
Output:
05:33:25 352,367,483
05:39:25 221,239,229
Obviously, not tested much, for lack of sample data. For parsing the CSV, use either Text::CSV_XS or Text::xSV rather than the naive split below.
Note:
This code does not make sure the output has all consecutive five minute blocks if the input data has gaps.
You will have problems if there are time stamps from multiple days. In fact, if the time stamps are not in 24-hour format, you will have problems even if the data are from a single day.
With those caveats, it should still give you a starting point.
#!/usr/bin/perl
use strict;
use warnings;
my $split_re = qr/ ?, ?/;
my #header = split $split_re, scalar <DATA>;
my #data;
my $time_block = 0;
while ( my $data = <DATA> ) {
last unless $data =~ /\S/;
chomp $data;
my ($ts, #vals) = split $split_re, $data;
my ($hr, $min, $sec) = split /:/, $ts;
my $secs = 3600*$hr + 60*$min + $sec;
if ( $secs > $time_block + 300 ) {
$time_block = $secs;
push #data, [ $time_block ];
}
for my $i (1 .. #vals) {
$data[-1]->[$i] += $vals[$i - 1];
}
}
print join(', ', #header);
for my $row ( #data ) {
my $ts = shift #$row;
print join(', ',
sprintf('%02d:%02d', (localtime($ts))[2,1])
, #$row
), "\n";
}
__DATA__
DATE Time, v1,v2,v3
05:33:25,1,3,5
05:34:25,2,4,6
05:35:24,7,8,9
05:55:24,7,8,9
05:57:24,7,8,9
Output:
DATE Time, v1, v2, v3
05:33, 10, 15, 20
05:55, 14, 16, 18
This is a good problem for Perl to solve. The hardest part is taking the value from the datetime field and identifying which 5 minute bucket it belongs to. The rest is just hashes.
my (%v1,%v2,%v3);
while (<STDIN>) {
my ($datetime,$v1,$v2,$v3) = split /,/, $_;
my ($date,$time) = split / /, $datetime;
my $bucket = &get_bucket_for($time);
$v1{$bucket} += $v1;
$v2{$bucket} += $v2;
$v3{$bucket} += $v3;
}
foreach my $bucket (sort keys %v1) {
print "$bucket $v1{$bucket} $v2{$bucket} $v3{$bucket}\n";
}
Here's one way you could implement &get_bucket_for:
my $first_hhmm;
sub get_bucket_for {
my ($time) = #_;
my ($hh,$mm) = split /:/, $time; # looks like seconds are not important
# buckets are five minutes apart, but not necessarily at multiples of 5 min
# (i.e., buckets could go 05:33,05:38,... instead of 05:30,05:35,...)
# Use the value from the first time this function is called to decide
# what the starting point of the buckets is.
if (!defined $first_hhmm) {
$first_hhmm = $hh * 60 + $mm;
}
my $bucket_index = int(($hh * 60 + $mm - $first_hhmm) / 5);
my $bucket_start = $first_hhmm + 5 * $bucket_index;
return sprintf "%02d:%02d", $bucket_start / 60, $bucket_start % 60;
}
I'm not sure why you would use the times starting from the first time, instead of round 5 minute intervals (00 - 05, 05 - 10, etc), but this is a quick and dirty way to do it your way:
my %output;
my $last_min = -10; # -10 + 5 is less than any positive int.
while (<STDIN>) {
my ($dt, $v1, $v2, $v3) = split(/,/, $_);
my ($h, $m, $s) = split(/:/, $dt);
my $ts = $m + ($h * 60);
if (($last_min + 5) < $ts) {
$last_min = $ts;
}
$output{$last_min}{1} += $v1;
$output{$last_min}{2} += $v2;
$output{$last_min}{3} += $v3;
}
foreach my $ts (sort {$a <=> $b} keys %output) {
my $hour = int($ts / 60);
my $minute = $ts % 60;
printf("%01d:%02d v1(%i) v2(%i) v3(%i)\n", (
$hour,
$minute,
$output{$ts}{1},
$output{$ts}{2},
$output{$ts}{3},
));
}
Not sure why you would do it this way, but there you go in procedural Perl, as example. If you need more on the printf formatting, go here.