my @ar = grep length, flatten(@array);
print Dumper(@ar);

sub flatten{
    return unless @_;
    my ($car,@cdr) = @_;
    if(ref($car) eq 'ARRAY'){
        flatten(@$car, @cdr);
    } else {
        $car, flatten(@cdr);
    }
}
[download]

To Perl-ize this wonderful Lisp solution *grins*

sub flatten {
    return unless @_;
    my $val = shift;

    return flatten(@$val, @_) if UNIVERSAL::isa($val, 'ARRAY');

    return $val, flatten(@_);
}
[download]

------
We are the carpenters and bricklayers of the Information Age.

Don't go borrowing trouble. For programmers, this means Worry only about what you need to implement.

++abstracts -- ($car, @cdr) indeed! :-)

The Sidhekin
print "Just another Perl ${\(trickster and hacker)},"

sub flatten {
  my @result;
  while (@_) {
    my $first = shift;
    if (UNIVERSAL::isa($first, "ARRAY")) { # fixed, thanks particle
      unshift @_, @$first;
    } else {
      push @result, $first;
    }
  }
  @result;
}
[download]

-- Randal L. Schwartz, Perl hacker

that is, it works fine if you call UNIVERSAL::isa properly ;)

it should be:

if (UNIVERSAL::isa($first, "ARRAY")) {
[download]

~Particle ;̃

I said "an iterative solution". Not "this iterative solution". {grin}

Thanks for the patch. Applied.

-- Randal L. Schwartz, Perl hacker

Note that your iterative solution can be slow with a long output list on any current Perl because iteratively building an array with unshift scales quadratically. (Fixed in the current development cycle.)

Given the pattern of unshift's and shift's in your code, you might or might not hit this problem. But still for a single reverse you can use the guaranteed efficient pop/push pair instead of shift/unshift:

sub flatten {
  my @flattened; # Will be in reverse order
  while (@_) {
    my $last = pop;
    if (UNIVERSAL::isa($last, "ARRAY")) {
      push @_, @$last;
    }
    else {
      push @flattened, $last;
    }
  }
  return reverse @flattened;
}
[download]

I think you missed a reverse there:

push @_, @$last;
[download]

needs to be

push @_, reverse @$last;
[download]

since you are reversing the result. Trivial example: $last = [1,2,3,4,5] must flatten as 5, 4, 3, 2, 1 so it can be reversed in the final result to 1, 2, 3, 4, 5 again.

-- Randal L. Schwartz, Perl hacker

my @flattened_array = flatten($nested_array_ref);

sub flatten {

    my $array = shift;
    my @results = ();

    foreach my $element ( @$array ) {

        if( ref $element eq 'ARRAY' ) {
            push @results, flatten($element);
        }
        elsif( $element ) {
            push @results, $element;
        }
    }

    return @results;
}
[download]

update: I investigated per rob_au's concerns with the following code using the above subroutine:

use Data::Dumper;
use strict;

my $nested_array_ref = [
    '',
    [
        'a',
        [
            'b',
            'c'
        ],
        '',
        'd'
    ],
    'value'
];

my @flattened_array = flatten($nested_array_ref);

print Dumper(\@flattened_array);
[download]

and my output was this:

$VAR1 = [
          'a',
          'b',
          'c',
          'd',
          'value'
        ];
[download]

the example i gave explicitly passed an array_ref into the function to begin with, and @results is local to the subroutine, and does not get blown away during recursion.

This doesn't appear to work, primarily because of the clearing of the @results array with each iteration through the flatten function - In addition to this, when called with a unreferenced array, an error is generated when run under strict because of the dereferencing of a string in the foreach loop (@$array).

Update - Hrmmm, I'll dig into this a bit further and see why my tests failed - Thanks for the update AidanLee :-)

 

perl -e 's&&rob@cowsnet.com.au&&&split/[@.]/&&s&.com.&_&&&print'

use strict;
use Data::Dumper;

my $ref = [
   ['',''],
   ['',''],
   ['funct1','',''],
   ['',''],
   ['',['',['funct2a','funct2b',''],''],''],
   'funct3',
   'funct4',
   'funct5',
   'funct6',
   'funct7',
];

my @flat = Dumper($ref) =~ /'(\w+)/g;

print join("\n",@flat),"\n";
[download]

jeffa

L-LL-L--L-LL-L--L-LL-L--
-R--R-RR-R--R-RR-R--R-RR
B--B--B--B--B--B--B--B--
H---H---H---H---H---H---
(the triplet paradiddle with high-hat)

my @array = (
    [ 
        '', '' 
    ],
    [ 
        '', '' 
    ],
    [ 
        'funct1', '', '' 
    ],
    [ 
        '', '' 
    ],
    [ 
        '', 
        [ 
            '', 
            [ 
                'funct2a', 'funct2b', '' 
            ], 
            '' 
        ], 
        '' 
    ],
    'funct3',
    'funct4',
    'funct5',
    'funct6',
    'funct7',
);

print join "\n", _flatten( @array ), "\n";

{
    my @results;
    sub _flatten {
        foreach (@_) {
            if (ref $_ eq 'ARRAY') {
                _flatten( @{ $_ } );
                next;
            }
            push @results, $_ if $_;
        }
        return @results;
    }
}
[download]

If however, this code is to be used in a production environment, I would consider either rewriting the above to include depth checking and/or a shift towards a iterative rather than recursive loop, or alternatively, reevaluate the code generating this complex data structure in the first place.

perl -e 's&&rob@cowsnet.com.au&&&split/[@.]/&&s&.com.&_&&&print'

Well, heres a version that responds to a couple of your concerns, and a couple of mine. For instance all of the posted solutions break if the array is blessed, I thought monks at our level weren't supposed to fall into the 'ref' trap ;-). Also I use a variant of 'Annony's solution, but without the grep as I wanted a general solution (note that his use of map AND grep is superfluous, the whole shebang can be done in one map).

I use overload::StrVal to keep a record of seen nodes to avoid cycles. This means its not ncessary to keep a depth count. Also I cant see much benefit in writing this iteratively. You'd have to maintain your own stack and the overhead for this situation (imo) isn't worth the bother.

use overload;
use Carp;

sub flatten {
    my $ref  = shift;
    my $seen = shift || "";
    return map {
        (UNIVERSAL::isa($_,"ARRAY")) ? do {
            my $ref_str=overload::StrVal($_);
            Carp::croak "Cant flatten cyclic data structure !"
                if index($seen,$ref_str)>=0;
            flatten($_,$seen."$ref_str");
        } : $_ #change to #} : $_ ? $_ :()# to simulate grep
        } @$ref;
}

require Data::Dumper;
print Data::Dumper::Dumper([
     flatten([qw(array of elements),
              [qw(and arrays)],
              bless [qw(even blessed ones)],"FooArray"
             ])
]);
__END__
$VAR1 = [
          'array',
          'of',
          'elements',
          'and',
          'arrays',
          'even',
          'blessed',
          'ones'
        ];
[download]

Fixed spelling mistake.

Yves / DeMerphq
--
When to use Prototypes?
Advanced Sorting - GRT - Guttman Rosler Transform