### Re: I need a help with this one- even don't know how to title this

by Util (Priest)
 on Nov 20, 2011 at 01:49 UTC ( #939022=note: print w/replies, xml ) Need Help??

• Your diagram is easier to work with if you print it top-to-bottom instead of left-to-right, so I made that change.
• No hashing needed, as long as it is OK to do linear scans across all your tracks.
• I used first_index() from List::MoreUtils for clarity; it will be simple to duplicate its functionality in C.
• I wrote this code with *no* understanding of what you are trying to accomplish. Whether or not I got it right, please enlighten us on the root problem you are trying to solve (or mathematical behavior your are trying to explore, etc).

Working, tested code, insofar that I grasp the problem:

```#!/usr/bin/env perl
use strict;
use warnings;
use List::MoreUtils qw(first_index);

my \$duplicate_original_post_data = 1;

my \$generation_limit = 99;
my \$r1_count_limit   =  4; # 1..4 elements
my @r1_keys = 0 .. (\$r1_count_limit-1);

sub pad { map {\$_[\$_] || ''} @r1_keys }

my ( \$R1, \$R2 );
if ( not \$duplicate_original_post_data ) {
\$R1 = sub {
my \$n =        1 + int rand \$r1_count_limit;
return   map { 1 + int rand 100 } ( (0) x \$n );
};
\$R2 = sub { return 1 + int rand  20 };
}
else {
my @fake_r1 = (
[  17,   1,  20,  12 ],
[  13,  24,  21      ],
[  19,  30,  31,  27 ],
[  22,  34           ],
);
my @fake_r2 = ( 4, 6, 3 );
\$generation_limit = @fake_r1;
\$R1 = sub { return @{ shift @fake_r1 } };
\$R2 = sub { return    shift @fake_r2   };
}

my \$template = "%5s %5s %5s %5s %5s %5s  ->  %5s %5s %5s %5s\n";
my @last_array = \$R1->();

printf \$template, qw(Gen R1.1 R1.2 R1.3 R1.4 R2 Trk1 Trk2 Trk3 Trk4);
printf \$template,      1, pad( @last_array ),

for my \$generation ( 2 .. \$generation_limit ) {
my @r1_array = \$R1->();
my \$r2       = \$R2->();

my @leftover;
my @new_array = (0) x \$r1_count_limit;
for my \$r1_num (@r1_array) {
my \$target = \$r1_num - \$r2;
my \$slot_to_use = first_index { \$_ != 0 and \$_ == \$target }
@last_array;

if ( \$slot_to_use == -1 ) {
push @leftover, \$r1_num;
}
else {
\$new_array[ \$slot_to_use] = \$r1_num;
\$last_array[\$slot_to_use] = 0;
}
}

my @empty_slots = grep { \$new_array[\$_] == 0 } @r1_keys;
while (@leftover) {
die if not @empty_slots;
\$new_array[ shift @empty_slots ] = shift @leftover;
}

printf \$template, \$generation, pad( @r1_array  ),

@last_array = @new_array;
}
Output:
```Gen  R1.1  R1.2  R1.3  R1.4    R2  ->   Trk1  Trk2  Trk3  Trk4
1    17     1    20    12  None  ->     17     1    20    12
2    13    24    21           4  ->     21    13    24
3    19    30    31    27     6  ->     27    19    30    31
4    22    34                 3  ->           22          34

Create A New User
Node Status?
node history
Node Type: note [id://939022]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others taking refuge in the Monastery: (4)
As of 2020-05-29 01:28 GMT
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?
If programming languages were movie genres, Perl would be:

Results (166 votes). Check out past polls.

Notices?