Beefy Boxes and Bandwidth Generously Provided by pair Networks
There's more than one way to do things
 
PerlMonks  

comment on

( [id://3333]=superdoc: print w/replies, xml ) Need Help??
Have I got a solution for you, and some benchmarking to back it up. Since we know that any given Ai,j (where Ai,j = Ni + Mj) will be larger than Ai-1,j or Ai,j-1, we can establish a queue of values to be output that is the length of the shorter of the two lists and perform a sorted insertion on that list for each new value. This solution meets the 2N+M criterion and, unless I'm missing something, should run in N^2*M (worst case), where an initial test guarantees N is the smaller list. What follows is a benchmarking script, including both of Limbic~Region's and blokhead's posted solutions, a naive baseline sort with N + M + N*M memory, and a terrible solution that works only on integers I cobbled together yesterday, similar in many ways to blockhead's but with terrible performance when max(output) - min(output) is large.

#!/usr/bin/perl use strict; use warnings; use Benchmark qw(:all :hireswallclock); my @list1 = qw( 1 3 5 7 ); my @list2 = qw( 2 4 6 8 ); #my @list1 = (1 .. 100); #my @list2 = (1 .. 100); my $count = 10000; my $routines = { Baseline => sub { baseline(\@list1, \@list2) }, Integers => sub { solution_0(\@list1, \@list2) }, Queue => sub { solution_1(\@list1, \@list2) }, LR_1 => sub { LR_solution_1(\@list1, \@list2) } +, LR_2 => sub { LR_solution_2(\@list1, \@list2) } +, blokhead => sub { print_sums(\@list1, \@list2) }, }; my $buffer; open OUT, '>', \$buffer or die "Can't open STDOUT: $!"; my $results = timethese($count, $routines); cmpthese($results); sub baseline { # Simple solution # O(N*M) memory, O(N*M) time my @list1 = @{shift()}; my @list2 = @{shift()}; my @result = (); for my $val1 (@list1) { for my $val2 (@list2) { push @result, $val1+$val2; } } print OUT join "\n", (sort {$a <=> $b} @result); } sub solution_0 { # Integer solution # O(N+M) memory, O(N*M*len()) time my @list1 = @{shift()}; my @list2 = @{shift()}; my $value = $list1[0]+$list2[0]; while ($value <= $list1[-1]+$list2[-1]) { for my $scalar1 (@list1) { for my $scalar2 (@list2) { print OUT "$value\n" if $value == $scalar1 + $scalar2; } } $value++; } } sub solution_1 { # queue solution # O(2*N+M) memory, O(N^2*M) time my ($list_ref1, $list_ref2) = @_; my @list1; my @list2; if (@$list_ref1 <= @$list_ref2) { @list1 = @$list_ref1; @list2 = @$list_ref2; } else { @list1 = @$list_ref2; @list2 = @$list_ref1; } my @queue = map $_+$list2[0], @list1; push @queue, $list1[-1]+$list2[-1]; shift @list1; for my $element1 (@list1) { for (@list2) { print OUT shift(@queue), "\n"; my $sum = $_+$element1; my $count = 0; $count++ until $sum <= $queue[$count]; splice @queue, $count, 0, $sum; } } pop @queue; print OUT join "\n", @queue; } sub LR_solution_1 { #Limbic~Region's first posted solution use constant VAL => 0; use constant IDX => 1; use constant SUM => 2; my ($list_ref1, $list_ref2) = @_; my @list1; my @list2; if (@$list_ref1 <= @$list_ref2) { @list1 = @$list_ref1; @list2 = @$list_ref2; } else { @list1 = @$list_ref2; @list2 = @$list_ref1; } my @merge_list = map {[$_, 0, $_ + $list2[0]]} @list1; # Map over +smaller list if known while (@merge_list) { my ($min, $index) = ($merge_list[0][SUM], 0); for (1 .. $#merge_list) { ($min, $index) = ($merge_list[$_][SUM], $_) if $merge_list +[$_][SUM] < $min; } print OUT "$min\n"; $merge_list[$index][IDX]++; if ($merge_list[$index][IDX] > $#list2) { splice(@merge_list, $index, 1); } else { $merge_list[$index][SUM] = $merge_list[$index][VAL] + $lis +t2[$merge_list[$index][IDX]]; } } } sub LR_solution_2 { #Limbic~Region's second posted solution my ($list_ref1, $list_ref2) = @_; my @list1; my @list2; if (@$list_ref1 <= @$list_ref2) { @list1 = @$list_ref1; @list2 = @$list_ref2; } else { @list1 = @$list_ref2; @list2 = @$list_ref1; } my @merge_list = ((0) x scalar @list1); # use smaller of 2 lists while (1) { my ($min, $idx); for (my $i = 0; $i < @merge_list; ++$i) { next if $merge_list[$i] > $#list2; my $sum = $list1[$i] + $list2[$merge_list[$i]]; ($min, $idx) = ($sum, $i) if ! defined $min || $sum < $min +; } last if ! defined $min; print OUT "$min\n"; $merge_list[$idx]++; } } sub print_sums { # blokhead's solution my ($listA, $listB) = @_; my $min = $listA->[0] + $listB->[0] - 1; while ($min < $listA->[-1] + $listB->[-1]) { my $nextmin = undef; my $multiplicity = 0; no warnings; # Throws warnings on uninitialized value comparis +ons for my $i (0 .. $#$listA) { for my $j (0 .. $#$listB) { my $sum = $listA->[$i] + $listB->[$j]; if ($sum > $min and ($sum < $nextmin or not defined $n +extmin)) { ($nextmin, $multiplicity) = ($sum, 1); } elsif ($sum == $nextmin) { $multiplicity++; } } } print OUT ( ($nextmin) x $multiplicity); $min = $nextmin; } }

For 100-element lists, I got:

Benchmark: timing 100 iterations of Baseline, Integers, LR_1, LR_2, Qu +eue, blokhead... Baseline: 0.554613 wallclock secs ( 0.54 usr + 0.01 sys = 0.55 CPU +) @ 181.82/s (n=100) (warning: too few iterations for a reliable count) Integers: 32.3786 wallclock secs (32.37 usr + 0.00 sys = 32.37 CPU) + @ 3.09/s (n=100) LR_1: 18.7755 wallclock secs (18.77 usr + 0.00 sys = 18.77 CPU) + @ 5.33/s (n=100) LR_2: 69.7311 wallclock secs (69.73 usr + 0.00 sys = 69.73 CPU) + @ 1.43/s (n=100) Queue: 2.55908 wallclock secs ( 2.55 usr + 0.00 sys = 2.55 CPU) + @ 39.22/s (n=100) blokhead: 95.6313 wallclock secs (95.62 usr + 0.01 sys = 95.63 CPU) + @ 1.05/s (n=100) Rate blokhead LR_2 Integers LR_1 Queue Baseline blokhead 1.05/s -- -27% -66% -80% -97% -99% LR_2 1.43/s 37% -- -54% -73% -96% -99% Integers 3.09/s 195% 115% -- -42% -92% -98% LR_1 5.33/s 409% 271% 72% -- -86% -97% Queue 39.2/s 3650% 2635% 1169% 636% -- -78% Baseline 182/s 17287% 12578% 5785% 3313% 364% --

And for the 4 element lists in the original post:

Benchmark: timing 100000 iterations of Baseline, Integers, LR_1, LR_2, + Queue, blokhead... Baseline: 1.62766 wallclock secs ( 1.63 usr + 0.00 sys = 1.63 CPU) + @ 61349.69/s (n=100000) Integers: 7.29155 wallclock secs ( 7.28 usr + 0.01 sys = 7.29 CPU) + @ 13717.42/s (n=100000) LR_1: 7.017 wallclock secs ( 7.02 usr + 0.00 sys = 7.02 CPU) @ + 14245.01/s (n=100000) LR_2: 7.79621 wallclock secs ( 7.80 usr + 0.00 sys = 7.80 CPU) + @ 12820.51/s (n=100000) Queue: 3.60201 wallclock secs ( 3.60 usr + 0.00 sys = 3.60 CPU) + @ 27777.78/s (n=100000) blokhead: 9.88667 wallclock secs ( 9.89 usr + 0.00 sys = 9.89 CPU) + @ 10111.22/s (n=100000) Rate blokhead LR_2 Integers LR_1 Queue Baseline blokhead 10111/s -- -21% -26% -29% -64% -84% LR_2 12821/s 27% -- -7% -10% -54% -79% Integers 13717/s 36% 7% -- -4% -51% -78% LR_1 14245/s 41% 11% 4% -- -49% -77% Queue 27778/s 175% 117% 103% 95% -- -55% Baseline 61350/s 507% 379% 347% 331% 121% --

Update: Found and fixed bug with queue method - I swear I tested it. Following that, I updated the benchmarking results with the correct values - queue down a little, but it still well better than other options.

Update: Gah, found bug in algorithm - essentially as the array of results grows large, order was upset because @queue was not large enough. After a little effort, I determined the minimum safe value for @queue, assuming the same transit order as I have been using, is 1/2*N*M-N - for the pathological case, you must store almost the entire lower triangle. While this does meet the specified criteria in a literal sense, I assume the intent was to avoid O(N*M) scaling and thus this fails. I tried a couple of different traversal directions, but came up with zilch. Maybe something will come to me in my dreams...


In reply to Re: Challenge: Sorting Sums Of Sorted Series by kennethk
in thread Challenge: Sorting Sums Of Sorted Series by Limbic~Region

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Are you posting in the right place? Check out Where do I post X? to know for sure.
  • Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
    <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
  • Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
  • Want more info? How to link or How to display code and escape characters are good places to start.
Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others having an uproarious good time at the Monastery: (5)
As of 2024-03-28 08:20 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found