#!/usr/bin/perl
use strict; use warnings;
use Graph;
my @path_sets = ( [ "b", "c", "a" ], [ "a", "c", "d" ], [ "d", "e", "b
+" ] );
my @vertex_sets = ( [qw[ a b c d ]], [qw[ b e d ]] );
#convert [b,c,d] to "[b-c,c-d]"
sub to_pathstr {
my @path_set =@_;
my $pre='';my @ret=();
for (@path_set) {
for( @{$_} ){
push @ret, "$pre-$_" if ($pre);
$pre=$_;
}
}
return @ret;
}
#if edges of path[b,c,d] shares 2 edges of complete graph[a,b,c,d]
#this path go through 3 vertices of graph, maybe.
for my $vertex_set (@vertex_sets){
my($g, $c);
$g=new Graph(directed=>1);
$g->add_vertices( @$vertex_set );
$c=$g->complete; #ex. [a,b,c,d] =>a-b,a-c,a-d,b-a,b-c,b-d,c-a,c-b,
+c-d,d-a,d-b,d-c
print "target vertex=$g\n";
#convert array [b,c,d] to "b-c,c-d", Graph module's edge represent
+ation
for my $pathstr( map{ [ to_pathstr($_)] } @path_sets ){
my $regex=join('|', map{"\Q$_\E"} @{$pathstr});
my (@matched)= "$c" =~ /($regex)/g; #check how may egdes match
if( @matched >= 2 ){
print "matched path=".join(',',@$pathstr)."\n";
}
}
print "\n";
}
Your one with hash operation is nicer than mine.
|