Converting Bracketted String (Newick's) into Array of Array

[neversaint]

Dear Masters,
How can I convert the following string

my $str = "((mouse,rat),(human,chimp))";
my $str2 = "(mouse,(human,chimp))";

into this data structure

my $aoa = [['mouse','rat'],['human','chimp']];
my $aoa2 = ['mouse',['human','chimp']];

The following code of mine doesn't work:

my $str = "((mouse,rat),(human,chimp))";
$str =~ s/\(/\[/g;
$str =~ s/\)/]/g;
print "$str\n";

my $aoa = eval($str);

[ikegami]

Didn't you check $@ to see what error eval found? You forgot about quoting.

for ($str) {
   s/\\/\\\\/g;
   s/'/\\'/g;
   s/\(/['/g;
   s/\)/']/g;
   s/,/','/g;
}

Update: Bah, that's buggy, but you get the idea. I'm not gonna fix it, cause it's more effort making this work with eval EXPR than developing a safer solution (i.e. one that doesn't use eval EXPR).

[psini]

Try using this:

use strict;
use warnings;
use Data::Dumper;

my $string="((mouse,rat),(human,chimp))";
my $tree=[];

die "Invalid char in input string" if $string !~ /^[(),\w]+$/;
my @tokens=$string=~/(\(|\)|,|\w+)/g;
my @stack=($tree);

foreach (@tokens) {
  if ($_ eq '(') {
    my $new=[];
    push(@{$stack[@stack-1]},$new);
    push(@stack,$new);
  } elsif ($_ eq ')') {
    die "Mismatched ')'" if @stack < 2;
    pop(@stack);
  } elsif ($_ ne ',') {
    push(@{$stack[@stack-1]},$_);
  }
}
die "Mismatched '('" if @stack != 1;

$tree=$tree->[0];

print Dumper($tree);

Updated: added validity check on input string.

[busunsl]

I'd go for something like this (untested):

# convert parens to brackets
$str =~ tr/()/[]/;

# quotes
$str =~ s/(\w+)/'$1'/g;

# eval
my $aoa;
$eval = '$aoa = ' . $str;
eval $eval;

[betterworld]

Sometimes you think "this looks like a perfect task to use these cool RE features," but then you end up with something that does not look as beautiful as planned:

use strict;
use warnings;
use 5.010;

my $str = '((mouse,rat),(human,chimp))';
my $str2 = '(mouse,(human,chimp))';

my @buffers;

for ($str, $str2) {

    @buffers = ([]);

    m[
        ^
            (
                (?:

                    (\w+)

                    # This serves only to get out fast if we parse
                    # something bad (e.g. where closing parens are
                    # missing)
                    (*PRUNE)

                    (?{
                        push @{$buffers[-1]}, $2;
                    })
                |

                    \(
                        (?{
                            push @{$buffers[-1]}, my $new = [];
                            push @buffers, $new;
                        })

                        (?1)
                        (?{ pop @buffers; })
                    \)
                )

                (?:
                    ,
                    (?1)
                )?

            )
        \z
    ]x ? do {
        use Data::Dumper;
        print Dumper $buffers[0];
    } : do {
        warn "no match: $_\n";
    };
}

I look forward to suggestions on how to simplify this code ;)