in reply to Formalizing an array type problem, looking for solution

#!/usr/bin/perl -l

# http://perlmonks.org/?node_id=1170935

use strict;
use warnings;

sub flip { join '', reverse map tr/-+/+-/r, /\w./g }

my $all = ' ' . join ' ', map { "$_," . flip() . ' ' } map tr/ :\n//dr
+, <DATA>;

my %firsts;
@firsts{ $all =~ /[, ](\w[+-])/g } = ();
my @queue = map "$_ $all", sort keys %firsts;

while( $_ = shift @queue )
  {
  if( /^(\S+)\s*$/ )
    {
    print join ' : ', $1 =~ /\w./g;
    }
  else
    {
    /^(\S*)(\w.)( .*? )\2([\w+-]*),[\w+-]*( .*)$(?{
      push @queue, "$1$2$4$3$5" })(*FAIL)/;
    /^(\S*)(\w.)( .*? )[\w+-]*,\2([\w+-]*)( .*)$(?{
      push @queue, "$1$2$4$3$5" })(*FAIL)/;
    }
  }

__DATA__
A+ : B+
C+ : D- : E-
E- : B-

[download]

Replies are listed 'Best First'.
Re^2: Formalizing an array type problem, looking for solution
by GrandFather (Saint) on Sep 02, 2016 at 01:41 UTC

    I've no idea what a "consensus path" is so the following code, while fun to write, is probably wildly wide of what you want to achieve. It may act as a starting point for discussion though.

    #!/usr/bin/perl -l
use strict;
use warnings;

my @paths;

push @paths, [map {chomp; $_} split /\s*:\s*/] while <DATA>;

my @pattern = @{pop @paths};

for my $part (@pattern) {
    my ($node, $dir) = split '', $part;

    for my $testPattern (@paths) {
        if ($dir eq '+') {
            next if $testPattern->[0] !~ $node;
            $part = $testPattern;
            last;
        } else {
            next if $testPattern->[-1] !~ $node;
            $part = [map {tr~+-~-+~; $_} reverse @$testPattern];
            last;
        }
    }
    
    die "Can't match $part in '@pattern'\n" if 'ARRAY' ne ref $part;
}

print join ' : ', map {@$_} @pattern;

__DATA__
A+ : B+
C+ : D- : E-
C+ : E-

    [download]

    Prints:

    C- : D+ : E+ : E+ : D+ : C-

    [download]
    Premature optimization is the root of all job security
[reply]
[d/l]
[select]

      I think the OP means a consensus path is a join of all the segments where the segments are joined by overlaying identical elements (thus deleting one) at the joining ends. By this rule the two valid "consensus paths" are 

      A+ : B+ : E+ : D+ : C-
C+ : D- : E- : B- : A-

      [download]

      which are the reverse (and sign change) of each other.

      I do wish the OP would speak up because I have a sneaking suspicion his real data is not all single letters, and so my solution Re: Formalizing an array type problem, looking for solution above will need "tweaking".

[reply]
[d/l]

        I replied to your code because I assumed it was the OP who'd forgotten to log on. Yes, it'd be nice if the OP would follow up some of the questions and suggestions.

        Premature optimization is the root of all job security
[reply]

In Section Seekers of Perl Wisdom