my @T1 = ( 'a|b', 'b|c', 'c|d', 'j|k', 'k|l', 'l|m', 'm|n' );
####
#! /opt/perl/bin/perl -w
#
# By liverpole 061030
#
use strict;
use warnings;
use Data::Dumper;
my @T1 = ( 'a|b', 'b|c', 'c|d', 'j|k', 'k|l', 'l|m', 'm|n' );
# Map each endpoint to the pair of endpoints, and create a
# doubly-linked list of left and right pointers, eg.:
#
# %endpoints = ( %pprev = ( %pnext = (
# 'n' => [ 'm', 'n' ], 'l' => 'k', 'l' => 'm',
# 'a' => [ 'a', 'b' ], 'n' => 'm', 'c' => 'd',
# 'm' => [ 'm', 'n' ], 'c' => 'b', 'k' => 'l',
# 'd' => [ 'c', 'd' ], 'k' => 'j', 'a' => 'b',
# 'j' => [ 'j', 'k' ], 'b' => 'a', 'b' => 'c',
# 'l' => [ 'l', 'm' ], 'm' => 'l', 'm' => 'n',
# 'c' => [ 'c', 'd' ], 'd' => 'c', 'j' => 'k',
# 'k' => [ 'k', 'l' ], ); );
# 'b' => [ 'b', 'c' ],
# )
#
my (%endpoints, %pprev, %pnext);
foreach my $pair (@T1) {
my ($left, $right) = split(/\|/, $pair);
$endpoints{$left} = $endpoints{$right} = [ $left, $right ];
$pprev{$right} = $left;
$pnext{$left} = $right;
}
# Now merge all trails. Each time a previous or next trail exists,
# merge the endpoints, both in the %endpoints hash, and by making
# the previous or next trail point to the same endpoint pair.
#
foreach my $pair (@T1) {
my ($left, $right) = split(/\|/, $pair);
my $pendpoints = $endpoints{$left};
my $prev = $pprev{$left};
while (defined($prev)) {
# Adjust start of link
$endpoints{$prev} = $pendpoints;
$pendpoints->[0] = $prev;
$prev = $pprev{$prev};
}
my $next = $pnext{$right};
while (defined($next)) {
# Adjust end of link
$endpoints{$next} = $pendpoints;
$pendpoints->[1] = $next;
$next = $pnext{$next};
}
}
# Now simply construct the results for each pair
my %trailsToCombine = ( );
foreach my $pair (@T1) {
my ($left, $right) = split(/\|/, $pair);
my $pendpoints = $endpoints{$left};
my ($start, $end) = @$pendpoints;
my $path = $start;
while ($start ne $end) {
$start = $pnext{$start};
$path .= "|$start";
}
$trailsToCombine{$pair} = "$path";
}
# Display results
print "\%trailsToCombine = ", Dumper(\%trailsToCombine);
####
%trailsToCombine = $VAR1 = {
'm|n' => 'j|k|l|m|n',
'j|k' => 'j|k|l|m|n',
'k|l' => 'j|k|l|m|n',
'b|c' => 'a|b|c|d',
'a|b' => 'a|b|c|d',
'l|m' => 'j|k|l|m|n',
'c|d' => 'a|b|c|d'
};