Beefy Boxes and Bandwidth Generously Provided by pair Networks Frank
The stupid question is the question not asked
 
PerlMonks  

dynamic map "quadrant" indexing

by Anonymous Monk
on Aug 14, 2005 at 09:35 UTC ( #483673=perlquestion: print w/ replies, xml ) Need Help??
Anonymous Monk has asked for the wisdom of the Perl Monks concerning the following question:

Hello Monks,

this is so embarassing. I feel this is easy, but somehow I'm too stupid to achieve it. Needed is a subroutine, that will print letter/number indices of map quadrants. Depending on the level (zoom):

&idx(1); # will spill out: A1 B1 C1 D1 &idx(2); # will spill out A1A1 A1B1 A1C1 A1D1 # B1A1 B1B1 B1C1 B1D1 # C1A1 C1B1 C1C1 C1D1 # D1A1 D1B1 D1C1 D1D1 &idx(3); # should do A1A1A1 A1A1B1 A1A1C1 A1A1D1 # A1B1A1 A1B1B1 A1B1C1 A1B1D1 # etc.

Any means of doing this iteratively failed miserably, probably a recursive solution would be best, but somehow I'm failing to get a grip on the numbers:

$lvl can be anything from 1 to n, which results in 4**$lvl return values, each value consisting of $lvl <char><digit> numbers. As you probably figured out, chars are always [A-D] and digits [1-4].

This probably wouldn't be used for $lvl > 6, but you never know so I wanted to go for a generic solution.

Do you have any idea HowTo?

Thanks a lot,
Marcel

Comment on dynamic map "quadrant" indexing
Select or Download Code
Re: dynamic map "quadrant" indexing
by Anonymous Monk on Aug 14, 2005 at 10:20 UTC
    Ok - I did it. Wasn't that hard after all, and now I'll make the code more elegant.
    use strict; my $lvl ="@ARGV"; my $out = &idx($lvl); print "@$out\n"; sub idx { my $lvl = shift; my @out = qw(a1 b1 c1 d1); if($lvl == 1) { return \@out; } else { my @tmp = (); for my $o (@out) { push @tmp, "$o$_" for(@{&idx($lvl-1)}); } @out = @tmp; } return \@out; }
    Marcel
      Uhm... well forget it, the code is crap. This one does the right thing:
      sub idx { my $lvl = shift; # ARG1: get level my @out = qw(a1 b1 c1 d1 a2 b2 c2 d2 a3 b3 c3 d3 a4 b4 c4 d4); # init OUT array return \@out if($lvl == 1); # bail out if lvl = 1 my @tmp; for my $o (@out) { push @tmp, map { "$o$_" } @{&idx($lvl-1)}; } return \@tmp; }
      Probably I should not do my coding sunday morning. Marcel
Re: dynamic map "quadrant" indexing
by tlm (Prior) on Aug 14, 2005 at 14:46 UTC

    Update: I think the glob-based solution in my other reply is the way to go; I wish I'd thought of it first. Ignore this one.


    Here's a recursive solution:

    the lowliest monk

Re: dynamic map "quadrant" indexing
by tlm (Prior) on Aug 14, 2005 at 15:35 UTC

    Here's an iterative solution, similar in spirit to the algorithm discussed in HOP, flip, and swap:

    But it's much easier to do this with globs:

    my $glob_string = ( '{' . join( ',', 'A'..'D' ) . '}1' ) x $level; my @indices; while ( < $glob_string > ) { push @indices, $_ }

    the lowliest monk

      Or with Algorithm::Loops:
      use Algorithm::Loops qw( NestedLoops ); my $level = 3; my @indices = NestedLoops( [ (['A'..'D']) x $level ], sub { join '', map { "${_}1" } @_ } ); foreach my $val (@indices) { print($val\n") ]
      or as an interator:
      use Algorithm::Loops qw( NestedLoops ); my $level = 3; my $iter = NestedLoops( [ (['A'..'D']) x $level ] ); while (my @values = $iter->()) { my $val = join '', map { "${_}1" } @values; print("$val\n"); }
      Very nice ++

      I did not know about this glob behavior. I had to change it a little to make it work exaktly like the op wanted though.
      my $level = 2; my $l = 'A'; for (2 .. $level){ $l++; } my $glob_string = ( '{' . join( ',', 'A'.. $l ) . '}1' ) x $level; my @indices = glob $glob_string; print "@indices\n";

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://483673]
Approved by neniro
Front-paged by planetscape
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others drinking their drinks and smoking their pipes about the Monastery: (14)
As of 2014-04-24 11:40 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    April first is:







    Results (565 votes), past polls