Algorithm to reformat hash

B

Bart Van der Donck

Hello,

I have an array of dates. I don't know the number of dates it contains,
nor where they start or end. But I know they are following each other
(no missing dates in between), e.g.

my @days = ("20051230","20051231",
"20060101","20060102","20060103");

Then I have a hash that holds price periods valid for named weekdays,
e.g.

my %prices = ( "20051010-20051031|SUN-FRI" => 12.45,
"20051010-20051031|FRI-SUN" => 18.45,
"20051101-20060115|TUE-THU" => 11.24,
"20051101-20060115|THU-MON" => 12.11
);

Meaning, eg the first element: during 20051010-20051031, the price is
12.45 from Sunday-Friday. The elements of %prices are always in this
fixed format.

The weekday notation excludes the last day, e.g. FRI-SUN is valid for
FRI and SAT, but not for SUN. If a price/weekday combination is not in
the hash, it means they are not available and perl should return an
error 'no price available'. From the example above: no price available
on MON during 20051101-20060115. Also, no price available for Aug 10,
2006 in the example above.

All dates are in YYYYMMDD format, weekdays are MON TUE WED THU FRI SAT
SUN.

Background: @days are the days that a user wants to book a hotel room.
%prices are my delivered price periods.

Each date in @array is the startdate of an overnight, e.g. 20051230
means "the night that starts on Dec 30, 2005 and ends on Dec 31, 2005".
The price is the room price for 1 night.

Each date pair in %prices is the start date and the end date, including
the last day. From the example above: the price for an overnight from
Oct 31, 2005 to Nov 01, 2006 (1 night) is 12.45 (Oct 31, 2005 is on a
Monday).

I moved earth to heaven trying to get a new simple hash like this:

%newpriceformat = ("20050529" => 40.42,
"20050530" => 40.42,
"20050531" => 40.42,
"20050601" => 38.62,
"20050602" => 38.62
);

Basically, I think the problem can be narrowed down to a reformatting
of %prices into %newpriceformat. Once that far, it's not that hard to
link this to @days. But I couldn't get it working with Date::Calc,
Date::Manip, assign numbers to days... but I believe it should be
somewhere in that direction (I wouldn't know where else).

Thanks,
 
U

usenet

Bart said:
[a long question about reformatting info: http://tinyurl.com/e4x34]

Hmmm, an interesting question and a fun little diversion while I eat my
lunch. Here's what I cobbled up - it won't win any prizes for the most
efficient code in the world, but it works:

#!/usr/bin/perl
use strict; use warnings;
use Date::Manip;

sub DayRange($) {
#Return a list of days in a range
my $days = "SUN_MON_TUE_WED_THU_FRI_SAT_" x 2;
$_[0] =~ /(.*)-(.*)/;
my ($range) = ($days =~ /($1.*?)_$2/i);
return split (/_/, $range);
}

my %prices = (
"20051010-20051031|SUN-FRI" => 12.45,
"20051010-20051031|FRI-SUN" => 18.45,
"20051101-20060115|TUE-THU" => 11.24,
"20051101-20060115|THU-MON" => 12.11
);

my %newprice;
foreach my $key (sort keys %prices) {
my ($start, $end, $range) = ($key =~ /(.*?)-(.*)\|(.*)/);
foreach my $weekday(DayRange($range)) {
foreach my $date(ParseRecur("Every $weekday", 0, $start, $end)){
$newprice{UnixDate($date, "%Q")} = $prices{$key};
}
}
}

my @days = qw/20051230 20051231 20060101 20060102 20060103/;

foreach my $day(@days) {
printf("Day: %s\tPrice: %s\n",$day, $newprice{$day} || "UNKNOWN");
}

__END__

##### OUTPUT #######

Day: 20051230 Price: 12.11
Day: 20051231 Price: 12.11
Day: 20060101 Price: 12.11
Day: 20060102 Price: UNKNOWN
Day: 20060103 Price: 11.24
 
B

Bart Van der Donck

(e-mail address removed) wrote:

[...]
Hope this helps,

It does. I prefer Date::Calc rather than the slower Date::Manip (that
is, if I have the choice).

Thanks!
 
R

robic0

Hello,

I have an array of dates. I don't know the number of dates it contains,
nor where they start or end. But I know they are following each other
(no missing dates in between), e.g.

my @days = ("20051230","20051231",
"20060101","20060102","20060103");

Then I have a hash that holds price periods valid for named weekdays,
e.g.

You know what bud, your so precise in stating your problem I find it
hard to believe you don't already know the answer for something you
made up.

Why in holy **** would submit a slice of real world economics
business software question to a Perl group? Know any real world
business software written in Perl? Perl is for tools, not for
business applications. So don't come here and quote a real world
slice of business application with a Perl accent, rudamentarry
EDU bullshit. What a fuckin asshole !!!
 
B

Bart Van der Donck

robic0 said:
You know what bud, your so precise in stating your problem I find it
hard to believe you don't already know the answer for something you
made up.

Defining a problem in a precise way is not the same as finding a
solution for it.
Why in holy **** would submit a slice of real world economics
business software question to a Perl group? Know any real world
business software written in Perl? Perl is for tools, not for
business applications.

Or you are total ignorant, or you are making a fool of yourself saying
such nonsense.
 
B

Bart Lateur

robic0 said:
Why would you prefer anything, aren't you the dumb mother fucker who
posted the question?

Welcome to my plonk filter. Make yourself at home, you are never going
to come out of it, again.
 
R

robic0

Defining a problem in a precise way is not the same as finding a
solution for it.
Except if you already know the answer.......
Or you are total ignorant, or you are making a fool of yourself saying
such nonsense.
I called you an fuckin asshole. What I really menat was a fuckin
EDU asshole! Hey you got me back, calling me a jerk..... good one!
This aint a EDU forum, this is now as far as I'm concerned a
neo-proffesional forum. Take your EDU bullshit back to class, boy!!
 
B

Bart Van der Donck

robic0 said:
I called you an fuckin asshole. What I really menat was a fuckin
EDU asshole! Hey you got me back, calling me a jerk..... good one!
This aint a EDU forum, this is now as far as I'm concerned a
neo-proffesional forum. Take your EDU bullshit back to class, boy!!

Huh ? But... what about Henry Law's post then ?
(http://tinyurl.com/8uyyt) Am I right to conclude that
comp.lang.perl.misc is a 'non-EDU' and 'neo-proffesional' 'forum' on a
'site' in some way related to Google and 'owned by the USA' ?

Are you still available for payet proffesionel worc ?
 
R

robic0

On 29 Nov 2005 02:11:35 -0800, "Bart Van der Donck" <[email protected]>
wrote:
[snip>
Huh ? But... what about Henry Law's post then ?
(http://tinyurl.com/8uyyt) Am I right to conclude that
comp.lang.perl.misc is a 'non-EDU' and 'neo-proffesional' 'forum' on a

Where did you get the preconception that a miscellaneous perl
group was in someway related to the World Education Foundation?
Most of the post's here are from desperate IT yakkoffs, dumb at
Perl, looking for a quick code fix to keep thier jobs for
another week. Thier the least answered. The most answered
by the regulars are the questions that no paid professional
would ask, that can't be put in relationship to Perl project
work. These are the Perl basics. Beyond basics are large scale,
complex programming. I guess it reflects, both questions and
answers as to where you came from or where you are right now.
I know there's browsers here who are paid pro's that scan for
tid bits. But dude, your as obvious as a 4 dolla bill.
You insult me to the nth degree. I know your "fishing" for
an ego massage on a piece of code you've written and muddle
it for results you already know. I don't consider you from
EDU environment. I consider you a mother-raper and a
father-fucker, and a serialized jackoff, an insult to intelligence
and worst of all...... obvious!!!!!!
 
R

robic0

Huh ? But... what about Henry Law's post then ?
(http://tinyurl.com/8uyyt) Am I right to conclude that
comp.lang.perl.misc is a 'non-EDU' and 'neo-proffesional' 'forum' on a
'site' in some way related to Google and 'owned by the USA' ?
^^^^^^^^^^^^^^^^
Look Van Der Dick, its not Google or the good o'l USA who owns any
usenet forum. Your a fallacy, that can't address comment based on
you posted content. thats all. The unique USA emphasis shouldn't
intimidate you in defending your position that you don't have.
How insulting you are to anybody in the USA. Ever think of that?
 
R

robic0

Huh ? But... what about Henry Law's post then ?
(http://tinyurl.com/8uyyt) Am I right to conclude that
comp.lang.perl.misc is a 'non-EDU' and 'neo-proffesional' 'forum' on a
'site' in some way related to Google and 'owned by the USA' ?

Are you still available for payet proffesionel worc ?
After I agree to the work (by your estimated program size), you wire
the money to my account in the Bahamas with a return address, a
delivery time and software specs. After that, you'll get the software
when it and I'm ready (could be 10 years, depends on how much you
piss me off). Sound good ?
 
A

Andrew

Bart said:
(e-mail address removed) wrote:
It does. I prefer Date::Calc rather than the slower Date::Manip (that
is, if I have the choice).

Here is a variation I wrote - most of it mine, except for the
outsourced Day_Of_Week function from Date::Calc . It could use some
optimization perhaps (like looping over price/[date ranges] first, to
eliminate some redundant calculations in "InRange" ). Some of the
variables exist only for human legibility. Not sure how it compares to
the previous ones, in terms of efficiency (would be interested in
comments on that, or on anything else).

andrew

#!/usr/bin/perl

use strict;
use Date::Calc qw(Day_of_Week);

my @wdaynames=qw(sun mon tue wed thu fri sat);
my %a2n_wd=map { $wdaynames[$_], $_ } (0..$#wdaynames);

my @ss_specs=([0,4], [4,2], [6,2]); # substring specs
my (%prices, %newprices);

sub InRange {
my ($date,$range)=@_;
my ($smd,$emd,$swd_name,$ewd_name)=
($range=~/(\d{8})\-(\d{8})\|([a-z]{3})\-([a-z]{3})/i);
my ($swd,$ewd) = map { $a2n_wd{lc $_} } ($swd_name,$ewd_name);
my %applicable_weekdays=map {$_%7, 1} ($swd..( $ewd+($ewd>$swd ? 0
: 7)-1));
my $dow=&Day_of_Week(map {substr($date, $ss_specs[$_][0],
$ss_specs[$_][1])} (0..2));
return 0 unless ($applicable_weekdays{$dow % 7});
( ( $date >= $smd ) && ( $date <= $emd ) );
}
#---------------- data --------------------
my @dates = qw(20051230 20051231 20060101 20060102 20060103);

%prices = (
'20051010-20051031|SUN-FRI' => 12.45,
'20051010-20051031|FRI-SUN' => 18.45,
'20051101-20060115|TUE-THU' => 11.24,
'20051101-20060115|THU-MON' => 12.11
);
#--------------- end data ------------------

foreach my $date (@dates) {
foreach my $range (keys %prices) {
$newprices{$date}=$prices{$range} if &InRange($date,$range);
}
}

print "\n\nResults, assuming no redundancy or overlap in data: \n",
(map { my $np=$newprices{$_}; ("\nDay $_ :", ($np ? "\$$np" :
'UNKNOWN' )) } @dates),
"\n\n";
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Members online

Forum statistics

Threads
473,774
Messages
2,569,596
Members
45,142
Latest member
arinsharma
Top