Beefy Boxes and Bandwidth Generously Provided by pair Networks
XP is just a number
 
PerlMonks  

How to get this not the usual round robin looping

by fidda (Initiate)
on Oct 13, 2015 at 04:40 UTC ( #1144618=perlquestion: print w/replies, xml ) Need Help??
fidda has asked for the wisdom of the Perl Monks concerning the following question:

Hi,

I have 2 sets of Arrays,

@A = qw ( H1 H2 H3 H4); @B = qw (1 2 3 4 5 6 7 8 9 10);

I need a way to return a hash with @A elemets as keys and @B elements as values, with one condition that hash should look like this.

H1-> 1,8,9 H2-> 2,7,10 H3-> 3,6 H4-> 4,5

TIA

Replies are listed 'Best First'.
Re: How to get this not the usual round robin looping
by kcott (Chancellor) on Oct 13, 2015 at 05:59 UTC

    G'day fidda,

    This does what you want:

    #!/usr/bin/env perl use strict; use warnings; use Data::Dump; my @A = qw{H1 H2 H3 H4}; my @B = 1 .. 10; my %result; my $reverse = 0; while (@B) { build_hash(\%result, \@A, \@B, $reverse); $reverse ^= 1; } dd \%result; sub build_hash { my ($result, $A, $B, $reverse) = @_; my @keys = @$B >= @$A ? @$A : @$A[0 .. $#$B]; my @values; if ($reverse) { unshift @values, shift @$B for (0 .. $#keys); } else { push @values, shift @$B for (0 .. $#keys); } push @{$result->{$keys[$_]}}, $values[$_] for 0 .. $#keys; }

    Output:

    { H1 => [1, 8, 9], H2 => [2, 7, 10], H3 => [3, 6], H4 => [4, 5] }

    Note that this code destroys @B. If you need to keep it, make a copy and use that in the while condition and when calling &build_hash:

    my @B_copy = @B; ... while (@B_copy) { build_hash(\%result, \@A, \@B_copy, $reverse); ...

    Furthermore, the subroutine &build_hash has no reliance on the initial values of either @A or @B. For example, these initial values:

    my @A = qw{H1 H2 H3 H4 H5}; my @B = 1 .. 23;

    produce this output:

    { H1 => [1, 10, 11, 20, 21], H2 => [2, 9, 12, 19, 22], H3 => [3, 8, 13, 18, 23], H4 => [4, 7, 14, 17], H5 => [5, 6, 15, 16], }

    — Ken

      Hello kcott,

      This is good, but can be considerably simplified:

      #! perl use strict; use warnings; use Data::Dump; my @A = qw{H1 H2 H3 H4 H5}; my @B = 1 .. 23; my %h; while (@B) { push @{ $h{$_} }, shift @B // () for @A, reverse @A; } dd \%h;

      Output:

      16:10 >perl 1404_SoPW.pl { H1 => [1, 10, 11, 20, 21], H2 => [2, 9, 12, 19, 22], H3 => [3, 8, 13, 18, 23], H4 => [4, 7, 14, 17], H5 => [5, 6, 15, 16], } 16:12 >

      :-)

      Athanasius <°(((><contra mundum Iustus alius egestas vitae, eros Piratica,

        "This is good, ..."

        Thanks.

        "... but can be considerably simplified"

        Agreed.

        I normally check an OP's home node before replying. If it's a first post, I add a welcome greeting. In this case, it was a second post. The first post was stated to be homework.

        On that basis, I intentionally went with a longer piece of code than I might do normally. I had meant to add a comment that the code could be simplified: clearly, I forgot to do that.

        Perhaps, fidda will tell us which was the more useful.

        — Ken

        You can also complicate it to avoid the loop (in fact, disguise it as a repetition) and the // operator:
        push @{ $h{$_} }, shift @B for (@A, reverse @A) x (@B / @A / 2), (@A, reverse @A)[ 0 .. @B % (2 * @A) - +1 ];

        Update: Another idea:

        for my $i (0 .. $#A) { $h{ $A[$i] } = [ @B[ grep { my $m = $_ % (2 * @A); grep $_ == $m, $i, 2 * @A - $i - 1 } 0 .. $#B ] ]; }

        TIMTOWTDI, an iterator:

        my $iter = do { my ($pos, $step) = ('0E0', 1); sub { my $r = $H{ $A[$pos] } ||= []; if ($pos % $#A || $pos =~ /E/) { $pos += $step; } else { $pos .= 'E0'; $step *= -1; } return $r } }; push @{ $iter->() }, $_ for @B;
        لսႽ† ᥲᥒ⚪⟊Ⴙᘓᖇ Ꮅᘓᖇ⎱ Ⴙᥲ𝇋ƙᘓᖇ
        As already said in chat congratulation Athanasius for your Boustrophedon distribution function.I thought your crucial line was difficult to read and my hubris lead me think i could semplify it by playing with the index of @A..

        ..as always i endend with a hyper complicated and cryptic solution, even if my hubrys is partially satisfied: anyway TIMTOWTDI!!
        #! perl use strict; use warnings; use Data::Dump; my @A = qw ( H1 H2 H3 H4); # original set my @B = qw (1 2 3 4 5 6 7 8 9 10); # as per OP my %h; my $i = 0; while (@B) { push @{$h{$A[$i]}},shift @B; $i == $#A ? $i = -1 : $i == -$#A-1 ? $i = 0 : $i < 0 ? $i-- : $i+ ++; } dd %h;


        L*
        There are no rules, there are no thumbs..
        Reinvent the wheel, then learn The Wheel; may be one day you reinvent one of THE WHEELS.
        oh yes the reverse if for sure the best trick, but you can eliminate entirely the while loop using map instead.

        #! perl use strict; use warnings; use Data::Dump; my @A = qw ( H1 H2 H3 H4); my @B = qw (1 2 3 4 5 6 7 8 9 10); my %h; map {push @{$h{ $_ }},grep {defined} shift @B} (@A, reverse @A) x int +($#B / $#A) ; dd %h;


        L*
        UPDATE: with help of choroba i realized i had no need of int nor of so much repetitons:
        map {push @{$h{ $_ }}, shift @B} (@A, reverse @A) x ($#B / $#A /2) +; ##No it is still not good..

        L*
        There are no rules, there are no thumbs..
        Reinvent the wheel, then learn The Wheel; may be one day you reinvent one of THE WHEELS.

        This is good, but can be considerably simplified:  H1 => [1, 10, 11, 20, 21],

        hmm, OP has  H1-> 1,8,9

        Weird question :)( i need this sequence ... imagine the equation which I won't tell you )

Re: How to get this not the usual round robin looping
by hdb (Monsignor) on Oct 13, 2015 at 08:22 UTC

    My humble solution:

    use strict; use warnings; use Data::Dumper; my @K = qw (H1 H2 H3 H4); my @V = qw (1 2 3 4 5 6 7 8 9 10); my %hash; my $i = -1; push @{ $hash{ $K[ ++$i&4 ? 3-$i%4 : $i%4 ] } }, $_ for @V; print Dumper \%hash;

    UPDATE: ...or...

    push @{ $hash{ $K[ int 3.5*abs sin (0.19634954085+0.39269908170*++$i) +] } }, $_ for @V;
      chapeau for your solutions, but while i was reading them to appreciate how bad i was to not studied math (quite at all), i realized that your two push lines work only for 0 to 3. has your math solution the possibility to abstract this and using the index of a variable @K?

      thanks
      L*


      There are no rules, there are no thumbs..
      Reinvent the wheel, then learn The Wheel; may be one day you reinvent one of THE WHEELS.

        Well spotted! Right now I cannot think of something as terse as this for the general solution. The $i&4 basically tells the ups and downs and would need to be replaced by something like int($i/@K)&1 (not tested). The line based on sin will not work for large arrays @K as sin is not linear enough for that...

        Update: This should work:

        push @{ $hash{ $K[ int(++$i/@K)&1 ? @K-1-$i%@K : $i%@K ] } }, $_ for @ +V;
      "My humble solution"

      I guess this a typical case of total underestimation.

      Update: What a cool solution!

      Best regards, Karl

      «The Crux of the Biscuit is the Apostrophe»

        You are exaggerating!

Re: How to get this not the usual round robin looping
by Anonymous Monk on Oct 13, 2015 at 12:21 UTC
    Wow... homework never had it so easy.
      Wow... homework never had it so easy.

      if the OP understand half of given solutions is valid homework.
      L*


      There are no rules, there are no thumbs..
      Reinvent the wheel, then learn The Wheel; may be one day you reinvent one of THE WHEELS.
Re: How to get this not the usual round robin looping
by AnomalousMonk (Chancellor) on Oct 16, 2015 at 12:44 UTC

    Here's a variation on hdb's (nice++) approach that uses List::MoreUtils::part():

    c:\@Work\Perl\monks\fidda>perl -wMstrict -le "use List::MoreUtils qw(part); ;; use constant KEYS => qw(H1 H2 H3 H4); use constant ITEMS => 'A' .. 'O'; ;; my @steps = map { @$_, reverse @$_ } [ 0 .. KEYS-1 ]; ;; my $i = 0; my @parts = part { $steps[ $i++ % @steps ] } ITEMS; ;; my %h; @h{ KEYS() } = @parts; for my $k (KEYS) { printf qq{$k }; printf qq{'$_' } for @{ $h{$k} }; print ''; } " H1 'A' 'H' 'I' H2 'B' 'G' 'J' 'O' H3 'C' 'F' 'K' 'N' H4 'D' 'E' 'L' 'M'
    If you don't like part(), you can use
        my @parts;
        push @{ $parts[ $steps[ $i++ % @steps ] ] }, $_ for ITEMS;

    I kinda don't like the stray  $i variable wandering through the code, but if you wrap this all up in a distributor function, this is no longer an issue.


    Give a man a fish:  <%-{-{-{-<

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://1144618]
Approved by kcott
Front-paged by kcott
help
Chatterbox?
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others cooling their heels in the Monastery: (8)
As of 2017-12-18 18:48 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    What programming language do you hate the most?




















    Results (495 votes). Check out past polls.

    Notices?