Beefy Boxes and Bandwidth Generously Provided by pair Networks
Think about Loose Coupling
 
PerlMonks  

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??


in reply to I need a help with this one- even don't know how to title this

  • 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 ), 'None', 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 ), $r2, pad( @new_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

Log In?
Username:
Password:

What's my password?
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?