Syntactically cool list of lists

[jettero]

You guys, I'm looking for the syntactically coolest looking way to build a list of lists from a list.

  @a = (1,5,7,9,32,197,8,4,5); # (pretend this is dynamically generate
+d)
  @b = map {[ $a[2*$_], $a[2*$_+1]||() ]} 0 .. int $#a/2;

Above is the best I'd come up with so far for generating @b, but I'm not sure it's the syntactically coolest possible way to do it. I'd also like to generalize it to a list of lists of size $l rather than always being $l=2.

This is a highly subjective problem and I'm already about responses.

[GrandFather]

push @b, [splice @a, 0, $l] while @a;

is fairly clean. Check the result with:

print "@$_\n" for @b;

[sauoq]

Clean but destructive. So, make a copy of @a if you need to keep it.

[jettero]

That is a really cool way to do it. I always forget about splice(). I wish it didn't destroy @a, but it's definitely more readable than the map mess I figured out last night...

[BrowserUk]

I dislike the splice solution because it destroys the source array unless you copy it first. I have a utility routine called mapn which lends itself to this task amongst others:

use Data::Dumper; $data::Dumper::Terse=1; $Data::Dumper::Indent=0;

sub mapn (&@) {
    my( $c, $n, $s ) = ( shift, shift, 0 );
    map{
        $s += $n;
        $c->( @_[ ( $s - $n ) .. ( $s < @_ ? $s - 1 : @_ - 1 ) ] );
    } 0 .. ( $#_ / $n );
}

my @a = (1,5,7,9,32,197,8,4,5);

for my $n ( 2 .. 7 ) {
    my $LoL = [ mapn{ [ @_ ] } $n, @a ];
    print "n=$n ",  Dumper $LoL;
}
__END__
n=2  $VAR1 = [[1,5],[7,9],[32,197],[8,4],[5]];
n=3  $VAR1 = [[1,5,7],[9,32,197],[8,4,5]];
n=4  $VAR1 = [[1,5,7,9],[32,197,8,4],[5]];
n=5  $VAR1 = [[1,5,7,9,32],[197,8,4,5]];
n=6  $VAR1 = [[1,5,7,9,32,197],[8,4,5]];
n=7  $VAR1 = [[1,5,7,9,32,197,8],[4,5]];

[Fletch]

That's not cool, that's just ugly trying to masquerade as clever.

my @a = ( [ 1, 5 ],
          [ 7. 9 ],
          [ 32, 197 ],
          [ 8, 4 ],
          [ 5 ], );

It's immediately obvious what @a contains. It's (fairly) readily maintained. Another alternative would be to store it as YAML and use YAML (or YAML::Syck) to Load it from a heredoc.

Update: Now seeing GrandFather's response I get the impression that you're asking about a general case of converting a list to an nx2 LoL and not initializing something from a static array? If that's the case, I like his reply. If you're talking about going from a static list of data, I still say go with the YAML.

[rhesa]

I thought about using the natatime function from List::MoreUtils. It returns an iterator however, which is a bit clumsy in this context, so I looked at the source for natatime. I always forget about splice, but there it was :-)

FWIW, this is what I whipped up:

#!/usr/bin/perl -l

use strict;

sub partn($@)
{
    my $n = shift;
    my @l = @_;
    my @r;
    push @r, [splice( @l, 0, $n )] while @l;
    return @r;
}

## examples
my @r = (1,5,7,9,32,197,8,4,5);

my @r2 = partn 2, @r;
my @r3 = partn 3, @r;
my @r4 = partn 4, @r;

use Data::Dumper;
$Data::Dumper::Indent = 0;

print Dumper \@r2;
print Dumper \@r3;
print Dumper \@r4;

__END__
$VAR1 = [[1,5],[7,9],[32,197],[8,4],[5]];
$VAR1 = [[1,5,7],[9,32,197],[8,4,5]];
$VAR1 = [[1,5,7,9],[32,197,8,4],[5]];

[ikegami]

Doesn't seem to be that clumsy.

use List::MoreUtils qw( natatime );

my $iter = natatime $l, @a;
while (my @row = $iter->()) { push @b, \@row; }

Update: Switched to using a while loop, since the while statement modifier doesn't work here.

[jettero]

I was hoping someone would post something that iterates.

[rir]

chunk( $subarray_length, \@array_to_partition );

sub chunk {
    my ($l, $in) = @_;
    my $arr = 0;

    my $ret;

    do {

        print( "die (Error Domain$/)") , return if $l < 1;  # XXX

        @{ $ret->[$arr] } = @$in[ $arr * $l .. (
                $arr * $l + $l - 1 >= @$in ? $#$in : $arr * $l + $l - 
+1 )
        ];
        ++$arr;
    } until ( $arr * $l > @$in - 1 );

    return $ret;
}

Be well,
rir

[sgifford]

Here are two that I like. The first fills unused subarray elements with undef.

sub groups_of_n
{
  my $n = shift;
  return map { [@_[$_*$n..$_*$n+$n-1]] } 0..$#_/$n;
}


use POSIX qw(ceil);

sub groups_of_n
{
  my $n = shift;
  my $m = ceil(@_/$n);
  my @r;
  my $i = 0;
  push(@{$r[$i++%$m]},$_) foreach @_;
  @r;
}

[johngg]

The first fills unused subarray elements with undef.

This gets rid of the undefs.

sub groups_of_n
{
  my $n = shift;
  return
     map { [ grep {defined} @$_ ] }
     map { [ @_ [$_ * $n .. $_ * $n + $n -1 ]] }
     0 .. $#_ / $n;
}

Cheers,

JohnGG

[sgifford]

True, or we can avoid generating the elements in the first place:

sub groups_of_n
{
  sub min
  {
    return $_[0] < $_[1] ? $_[0] : $_[1];
  }
  my $n = shift;
  return map { [ @_[$_*$n..min($_*$n+$n-1,$#_)]] } 0..$#_/$n;
}

[shmem]

At the cost of a temporary counter variable

my $c = -$l;
push @b, [ grep {defined $_} @a[($c+=$l)..($c+$l-1)] ] for 0 .. $#a/$l

if you don't mind extending @a to a multiple of $l ;-)

<update>
Oops - almost identical to JohnGG's solution above - and his uses $_ as counter. hrm :-/

push @b, [ grep {defined $_} @a[$_*$l .. ($_*$l+$l>$#a ? $#a : $_*$l+$
+l-1)] ]
    for 0 .. $#a/$l;

This one doesn't extend @a. But readable, well... it's the best I can contrieve in a single line (up to ";" that is).

</update>

--shmem

[johngg]

I can't claim it was my solution, just a refinement of sgifford's :)

Cheers,

JohnGG

[tsee]

Somehow, my contribution to this was lost. I quietly suspect the fault is sitting in front of the keyboard and it's all related to the preview-button.

Hence I write this again. This solution has the added benefit of trivially supporting partitions other than two per sublist. Autovivification++!

my @a = (1..21);
my @b;
push @{$b[$_/2]}, $a[$_] for 0..$#a;

Cheers,
Steffen

[druud]

$ perl -MData::Dumper -wle '
  $s = 5;
  @a = (1,5,7,9,32,197,8,4,5); $e=int $#a/$s;
  @b = map {$_*=$s; [@a[$_..($_+$s>$#a?$#a:$_+$s-1)]]} 0..$e;
  print Dumper \@b
'

$VAR1 = [
          [
            1,
            5,
            7,
            9,
            32
          ],
          [
            197,
            8,
            4,
            5
          ]
        ];


-- 
Ruud