I have this routine,
I want to save that delta to count the days between all to and from days in the from-to pairs
I have in the 2 dimensional array, I just need the workdays.
Say for
$date_from = 2012-02-09;
$date_to = 2012-02-13;
$delta_string = 4
sub calc_usage {
use Date::Manip::Date;
my $date_from;
my $date_to;
my $delta;
my $i;
for $i (0 .. $#DATE_HOLDER) {
$date_from = new Date::Manip::Date;
$date_to = new Date::Manip::Date;
$date_from->parse($DATE_HOLDER[$i][0]);
$date_to->parse($DATE_HOLDER[$i][1]);
$delta = $date_from->calc($date_to, "business");
}
}
To retrieve the delta values, you have to use the folllowing:
my #val = $delta->value();
wich gives an array of 7 elements where:
$val[0] holds years
$val[1] holds months
$val[2] holds weeks
$val[3] holds days
$val[4] holds hours
$val[5] holds minutes
$val[6] holds seconds
you can also use it in scalar context:
my $val = $delta->value();
wich gives a string with the same 7 elements colon separated:
years:months:weeks:days:hours:minutes:seconds
Related
I need to find the next neighbor using the euklid-distance-algorithm.
Given are two hashes with each 100 elements in this format:
$hash{$i}{price}
$hash{$i}{height}
I need to compare each hash elements with each other so that my result is a 100 x 100 matrix.
After that my matrix shoul be sorted after the following rules:
$hash{$i,$j} {lowest_euklid_distance}
$hash{$i,$j+1}{lowest_euklid_distance + 1}
$hash{$i,$j+2}{lowest_euklid_distance + 2}
.
.
$hash{$i+1,$j}{lowest_euklid_distance}
$hash{$i+1,$j}{lowest_euklid_distance + 2}
.
.
$hash{$i+n,$j+n}{lowest_euklid_distance+n}
My problem is to sort these elements properly.
Any adivices?
Thanks in advance.
/edit: adding more information:
I create the distance with the following subroutine:
sub euklid_distance{
#w1 = price_testdata
#w2 = height_testdata
#h1 = price_origindata
#h2 = height_origindata
my $w1 = trim($_[0]);
my $w2 = trim($_[1]);
my $h1 = trim($_[2]);
my $h2 = trim($_[3]);
my $result = (((($w2-$w1)**2)+(($h2-$h1)**2))**(1/2));
return $result;
}
I fetch the test and the origindata from two seperate lists.
The resulthash with the 100x100 matrix is created by the following code:
my %distancehash;
my $countvar=0;
for (my $j=0;$j<100;$j++){
for (my $i=0;$i<100;$i++){
$distancehash{$countvar}{distance} = euklid_distance( $origindata{$i}{price}, $testdata{$j}{price}, $origindata{$i}{height}, $testdata{$j}{height} );
$distancehash{$countvar}{originPrice} = $origindata{$i}{price};
$distancehash{$countvar}{originHeight} = $origindata{$i}{height};
$distancehash{$countvar}{testPrice} = $testdata{$j}{price};
$distancehash{$countvar}{testHeight} = $testdata{$j}{height};
$countvar++;
}
}
where $j goes over the testdata and $i over the origindata.
My goal is to have a new hash which is sorted by the lowest distance from the current $j ascending to the highest.
I computed the difference of two ISO 8601 dates after coverting them to epoch.
How can I get the difference of them in number of days?
My code is
my $ResolvedDate = "2014-06-04T10:48:07.124Z";
my $currentDate = "2014-06-04T06:03:36-04:00"
my $resolved_epoch = &convert_time_epoch($ResolvedDate);
my $current_epoch = &convert_time_epoch($currentDate);
if (($resolvedDate - $currentDate) > $noOfDays) {
print "Difference in greater than x\n";
$built = 0;
return ($built);
} else {
print "Difference in smaller than x \n";
$built = 1;
return ($built);
}
sub convert_time_epoch {
my $time_c = str2time(#_);
my #time_l = localtime($time_c);
my $epoch = strftime("%s", #time_l);
return($epoch);
}
Here in addition to $built I also want to return exact number of days, Resolved date is greater than Current date.
"number of days" is awkward, because this is localtime and DST exists (or at least, may exist).
By simply dividing by 86400 you can easily obtain the number of 24-hour periods, which may be sufficient for your purposes.
If you want the true number of times that the mday field has changed, this may be slightly different from the value obtained by this simple division, however.
If the dates are in epoch seconds, take the difference and divide it by the number of seconds in a day (which is 86400). Like so:
my $days_difference = int(($time1 - $time2) / 86400);
If you use DateTime then
my $duration = $dt1->delta_days($dt2); #$dt1 and $dt2 are DateTime objects.
print $duration->days;
use DateTime::Format::ISO8601 qw( );
my $ResolvedDate = "2014-06-04T10:48:07.124Z";
my $currentDate = "2014-06-04T06:03:36-04:00";
my $format = DateTime::Format::ISO8601->new();
my $dt_resolved = $format->parse_datetime($ResolvedDate);
my $dt_current = $format->parse_datetime($currentDate);
my $dur = $dt_resolved->delta_days($dt_current);
my $days = $dur->in_units('days');
I wand to sort a 3-dimension array in Perl. The elements of the array are in the form:
$arr_3d[indA][indB][indC] , and each element for indC=1 is a number
What I need is, for a given value of indA, sort all the sub-arrays indexed/defined by indB, with the decreasing order of the value of $arr_3d[indA][indB][indC=1],.
e.g. for an 1x2x2 array if:
$arr_3d[1][1][1] = 1
$arr_3d[1][1][2] = 4
$arr_3d[1][2][1] = 2
$arr_3d[1][2][2] = 3
Then after sorting :
$arr_3d[1][1][1] = 2
$arr_3d[1][1][2] = 3
$arr_3d[1][2][1] = 1
$arr_3d[1][2][2] = 4
So after sorting the sub-arrays $arr_3d[1][1] and $arr_3d[1][2] are swapped.
Sorry for the messed up description.. Any ideas?
Regards,
Giorgos
This is related to the " Schwartzian transform in Perl? " . You are really just sorting a single array (#{ $arr_3d[$indA] }).
I test this and it works. You are probably using Fortran index notation (starting at 1), so I changed it to C indexing (starting at 0).
use Data::Dumper;
my #arr_3d ;
$arr_3d[0][0][0] = 1;
$arr_3d[0][1][0] = 2;
$arr_3d[0][0][1] = 4;
$arr_3d[0][1][1] = 3;
my $indA = 0;
my $indC = 0;
my #temp = #{ $arr_3d[$indA] };
#{ $arr_3d[$indA] } = sort { $b->[$indC] <=> $a->[$indC] } #temp;
print Dumper(\#arr_3d);
I have an array ref of about 50,000 users. I want to go through all those users and compare each one to all the others in order to build a weighted list of matches (if the name is an exact match it's worth x, a partial match is worth y etc).
After going through the list and doing all the checks, I then want to go get the 10 highest weighted matches. Here is sort of a example of what I'm doing to help explain:
#!/usr/bin/perl
######################################################################
# Libraries
# ---------
use strict;
use warnings;
my $users = [];
$users->[0]{'Name'} = 'xxx';
$users->[0]{'Address'} = 'yyyy';
$users->[0]{'Phone'} = 'xxx';
$users->[1]{'Name'} = 'xxx';
$users->[1]{'Address'} = 'yyyy';
$users->[1]{'Phone'} = 'xxx';
$users->[2]{'Name'} = 'xxx';
$users->[3]{'Address'} = 'yyyy';
$users->[4]{'Phone'} = 'xxx';
foreach my $user_to_check (#$users) {
my $matched_users = [];
foreach my $user (#$users) {
$user_to_check->{'Weight'} = 0;
if (lc($user_to_check->{'Name'}) eq lc($user->{'Name'})) {
$user_to_check->{'Weight'} = ($user_to_check->{'Weight'} + 10);
} elsif ((length($user_to_check->{'Name'}) > 2) && (length($user->{'Name'}) > 2) && ($user_to_check->{'Name'} =~ /\Q$user->{'Name'}\E/i)) {
$user_to_check->{'Weight'} = ($user_to_check->{'Weight'} + 5);
}
if (lc($user_to_check->{'Address'}) eq lc($user->{'Address'})) {
.....
}
if ($user_to_check->{'Weight'} > 0) {
# We have matches, add to matched users
push (#$matched_users,$user);
}
}
# Now we want to get just the top 10 highest matching users
foreach my $m_user (sort { $b->{'Weight'} <=> $a->{'Weight'} } #$matched_users ) {
last if $counter == 10;
.... # Do stuff with the 10 we want
}
}
The problem is, it's sooo slow. It takes more than a day to run (and I've tried it on multiple machines). I know that the "sort" is a killer but I did also try inserting the results into a tmp mysql table and then at the end instead of doing the Perl sort, I just did an order by select, but the difference in time was very minor.
As I'm just going through a existing data structure and comparing it I'm not sure what I could do (if anything) to speed it up. I'd appreciate any advise.
O(n²)
You compare each element in #$users against every element in there. That is 5E4² = 2.5E9 comparisions. For example, you wouldn't need to compare an element against itself. You also don't need to compare an element against one you have already compared. I.e. in this comparision table
X Y Z
X - + +
Y - - +
Z - - -
there only have to be three comparision to have compared each element against all others. The nine comparisions you are doing are 66% unneccessary (asymptotically: 50% unneccessary).
You can implement this by looping over indices:
for my $i (0 .. $#$users) {
my $userA = $users->[$i];
for my $j ($i+1 .. $#$users) {
my $userB = $users->[$j];
...;
}
}
But this means that upon match, you have to increment the weight of both matching users.
Do things once, not 100,000 times
You lowercase the name of each user 1E5 times. This is 1E5 - 1 times to much! Just do it once for each element, possibly at data input.
As a side note, you shouldn't perform lowercasing, you should do case folding. This is available since at least v16 via the fc feature. Just lowercasing will be buggy when you have non-english data.
use feature 'fc'; # needs v16
$user->[NAME] = fc $name;
or
use Unicode::CaseFold;
$user->[NAME] = fc $name;
When hashes are not fast enough
Hashes are fast, in that a lookup takes constant time. But a single hash lookup is more expensive than an array access. As you only have a small, predefined set of fields, you can use the following trick to use hash-like arrays:
Declare some constants with the names of your fields that map to indices, e.g.
use constant {
WEIGHT => 0,
NAME => 1,
ADDRESS => 2,
...;
};
And then put your data into arrays:
$users->[0][NAME] = $name; ...;
You can access the fields like
$userA->[WEIGHT] += 10;
While this looks like a hash, this is actually a safe method to access only certain fields of an array with minimal overhead.
Regexes are slow
Well, they are quite fast, but there is a better way to determine if a string is a substring of another string: use index. I.e.
$user_to_check->{'Name'} =~ /\Q$user->{'Name'}\E/i
Can be written as
(-1 != index $user_to_check->{Name}, $user->{Name})
assuming both are already lowercased case folded.
Alternative implementation
Edit: this appears to be invalidated by your edit to your question. This assumed you were trying to find some global similarities, not to obtain a set of good matches for each user
Implementing these ideas would make your loops look somewhat like
for my $i (0 .. $#$users) {
my $userA = $users->[$i];
for my $j ($i+1 .. $#$users) {
my $userB = $users->[$j];
if ($userA->[NAME] eq $userB->[NAME]) {
$userA->[WEIGHT] += 10;
$userB->[WEIGHT] += 10;
} elsif ((length($userA->[NAME]) > 2) && (length($userB->[NAME]) > 2))
$userA->[WEIGHT] += 5 if -1 != index $userA->[NAME], $userB->[NAME];
$userB->[WEIGHT] += 5 if -1 != index $userB->[NAME], $userA->[NAME];
}
if ($userA->[ADDRESS] eq $userB->[ADDRESS]) {
..... # More checks
}
}
}
my (#top_ten) = (sort { $b->[WEIGHT] <=> $a->[WEIGHT] } #$users)[0 .. 9];
Divide and conquer
The task you show is highly parallelizable. If you have the memory, using threads is easy here:
my $top10 = Thread::Queue->new;
my $users = ...; # each thread gets a copy of this data
my #threads = map threads->create(\&worker, $_), [0, int($#$users/2)], [int($#$users/2)+1, $#users];
# process output from the threads
while (defined(my $ret = $top10->dequeue)) {
my ($user, #top10) = #$ret;
...;
}
$_->join for #threads;
sub worker {
my ($from, $to) = #_;
for my $i ($from .. $to) {
my $userA = $users->[$i];
for $userB (#$users) {
...;
}
my #top10 = ...;
$top10->enqueue([ $userA, #top10 ]); # yield data to the main thread
}
}
You should probably return your output via a queue (as shown here), but do as much processing as possible inside the threads. With more advanced partitioning of the workload, should spawn as many threads as you have processors available.
But if any kind of pipelining, filtering or caching can decrease the number of iterations needed in the nested loops, you should do such optimizations (think map-reduce-style programming).
Edit: Elegantly reducing complexity through hashes for deduplication
What we are essentially doing is calculating a matrix of how good our records match, e.g.
X Y Z
X 9 4 5
Y 3 9 2
Z 5 2 9
If we assume that X is similar to Y implies Y is similar to X, then the matrix is symmetric, and we only need half of it:
X Y Z
X \ 4 5
Y \ 2
Z \
Such a matrix is equivalent to a weighted, undirected graph:
4 X 5 | X – Y: 4
/ \ | X – Z: 5
Y---Z | Y – Z: 2
2 |
Therefore, we can represent it elegantly as a hash of hashes:
my %graph;
$graph{X}{Y} = 4;
$graph{X}{Z} = 5;
$graph{Y}{Z} = 2;
However, such a hash structure implies a direction (from node X to node Y). To make querying the data easier, we might as well include the other direction too (due to the implementation of hashes, this won't lead to a large memory increase).
$graph{$x}{$y} = $graph{$y}{$x} += 2;
Because each node is now only connected to those nodes it is similar to, we don't have to sort through 50,000 records. For the 100th record, we can get the ten most similar nodes like
my $node = 100;
my #top10 = (sort { $graph{$node}{$b} <=> $graph{$node}{$a} } keys %{ $graph{$node} })[0 .. 9];
This would change the implementation to
my %graph;
# build the graph, using the array indices as node ID
for my $i (0 .. $#$users) {
my $userA = $users->[$i];
for my $j ($i+1 .. $#$users) {
my $userB = $users->[$j];
if ($userA->[NAME] eq $userB->[NAME]) {
$graph{$j}{$i} = $graph{$i}{$j} += 10;
} elsif ((length($userA->[NAME]) > 2) && (length($userB->[NAME]) > 2))
$graph{$j}{$i} = $graph{$i}{$j} += 5
if -1 != index $userA->[NAME], $userB->[NAME]
or -1 != index $userB->[NAME], $userA->[NAME];
}
if ($userA->[ADDRESS] eq $userB->[ADDRESS]) {
..... # More checks
}
}
}
# the graph is now fully populated.
# do somethething with each top10
while (my ($node_id, $similar) = each %graph) {
my #most_similar_ids = (sort { $similar->{$b} <=> $similar->{$a} } keys %$similar)[0 .. 9];
my ($user, #top10) = #$users[ $node_id, #most_similar_ids ];
...;
}
Building the graph this way should take half the time of naive iteration, and if the average number of edges for each node is low enough, going through similar nodes should be considerably faster.
Parallelizing this is a bit harder, as the graph each thread produces has to be combined before the data can be queried. For this, it would be best for each thread to perform the above code with the exception that the iteration bounds are given as parameters, and that only one edge should produced. The pair of edges will be completed in the combination phase:
THREAD A [0 .. 2/3] partial
\ graph
=====> COMBINE -> full graph -> QUERY
/ partial
THREAD B [2/3 .. 1] graph
# note bounds recognizing the triangular distribution of workload
However, this is only beneficial if there are only very few similar nodes for a given node, as combination is expensive.
After feeding few Shakespeare books to my Perl script I have a hash with 26 english letters as keys and the number of their occurences in texts - as value:
%freq = (
a => 24645246,
b => 1409459,
....
z => 807451,
);
and of course the total number of all letters - let's say in the $total variable.
Is there please a nice trick to generate a string holding 16 random letters (a letter can occur several times there) - weighted by their frequency of use?
To be used in a word game similar to Ruzzle:
Something elegant - like picking a random line from a file, as suggested by a Perl Cookbook receipt:
rand($.) < 1 && ($line = $_) while <>;
The Perl Cookbook trick for picking a random line (which can also be found in perlfaq5) can be adapted for weighted sampling too:
my $chosen;
my $sum = 0;
foreach my $item (keys %freq) {
$sum += $freq{$item};
$chosen = $item if rand($sum) < $freq{$item};
}
Here, $sum corresponds to the line counter $. and $freq{$item} to the constant 1 in the Cookbook version.
If you're going to be picking a lot of weighted random samples, you can speed this up a bit with some preparation (note that this destroys %freq, so make a copy first if you want to keep it):
# first, scale all frequencies so that the average frequency is 1:
my $avg = 0;
$avg += $_ for values %freq;
$avg /= keys %freq;
$_ /= $avg for values %freq;
# now, prepare the array we'll need for fast weighted sampling:
my #lookup;
while (keys %freq) {
my ($lo, $hi) = (sort {$freq{$a} <=> $freq{$b}} keys %freq)[0, -1];
push #lookup, [$lo, $hi, $freq{$lo} + #lookup];
$freq{$hi} -= (1 - $freq{$lo});
delete $freq{$lo};
}
Now, to draw a random weighted sample from the prepared distribution, you just do this:
my $r = rand #lookup;
my ($lo, $hi, $threshold) = #{$lookup[$r]};
my $chosen = ($r < $threshold ? $lo : $hi);
(This is basically the Square Histogram method described in Marsaglia, Tsang & Wang (2004), "Fast Generation of Discrete Random Variables", J. Stat. Soft. 11(3) and originally due to A.J. Walker (1974).)
I have no clue about Perl syntax so I'll just write pseudo-code. You can do something like that
sum <= 0
foreach (letter in {a, z})
sum <= sum + freq[letter]
pick r, a random integer in [0, sum[
letter <= 'a' - 1
do
letter <= letter + 1
r <= r - freq(letter)
while r > 0
letter is the resulting value
The idea behind this code is to make a stack of boxes for each letter. The size of each box is the frequency of the letter. Then we choose a random location on this stack and see which letter's box we landed.
Example :
freq(a) = 5
freq(b) = 3
freq(c) = 3
sum = 11
| a | b | c |
- - - - - - - - - - -
When we choose a 0 <= r < 11, we have the following probabilities
Pick a 'a' = 5 / 11
Pick a 'b' = 3 / 11
Pick a 'c' = 3 / 11
Which is exactly what we want.
You can first built a table of the running sum of the frequency. So if you have the following data:
%freq = (
a => 15,
b => 25,
c => 30,
d => 20
);
the running sum would be;
%running_sums = (
a => 0,
b => 15,
c => 40, # 15 + 25
d => 70, # 15 + 25 + 30
);
$max_sum = 90; # 15 + 25 + 30 + 20
To pick a single letter with the weighted frequency, you need to select a number between [0,90), then you can do a linear search on the running_sum table for the range that includes the letter. For example, if your random number is 20 then the appropriate range is 15-40, which is for the letter 'b'. Using linear search gives a total running time of O(m*n) where m is the number of letters we need and n is the size of the alphabet (therefore m=16, n=26). This is essentially what #default locale do.
Instead of linear search, you can also do a binary search on the running_sum table to get the closest number rounded down. This gives a total running time of O(m*log(n)).
For picking m letters though, there is a faster way than O(m*log(n)), perticularly if n < m. First you generate m random numbers in sorted order (which can be done without sorting in O(n)) then you do a linear matching for the ranges between the list of sorted random numbers and the list of running sums. This gives a total runtime of O(m+n). The code in its entirety running in Ideone.
use List::Util qw(shuffle);
my %freq = (...);
# list of letters in sorted order, i.e. "a", "b", "c", ..., "x", "y", "z"
# sorting is O(n*log(n)) but it can be avoided if you already have
# a list of letters you're interested in using
my #letters = sort keys %freq;
# compute the running_sums table in O(n)
my $sum = 0;
my %running_sum;
for(#letters) {
$running_sum{$_} = $sum;
$sum += $freq{$_};
}
# generate a string with letters in $freq frequency in O(m)
my $curmax = 1;
my $curletter = $#letters;
my $i = 16; # the number of letters we want to generate
my #result;
while ($i > 0) {
# $curmax generates a uniformly distributed decreasing random number in [0,1)
# see http://repository.cmu.edu/cgi/viewcontent.cgi?article=3483&context=compsci
$curmax = $curmax * (1-rand())**(1. / $i);
# scale the random number $curmax to [0,$sum)
my $num = int ($curmax * $sum);
# find the range that includes $num
while ($num < $running_sum{$letters[$curletter]}) {
$curletter--;
}
push(#result, $letters[$curletter]);
$i--;
}
# since $result is sorted, you may want to use shuffle it first
# Fisher-Yates shuffle is O(m)
print "", join('', shuffle(#result));