Re: Finding subgraphs induced by a set of given vertices.

[Anonymous Monk]

induced? You mean included

#!/usr/bin/perl --
use strict; use warnings; use Data::Dump;

my @S = do {
    open my($data), '<', \q{b c a
a c d
d e b};
    map { [ split ] } readline $data;
};

dd \@S;

for my $QT ( [qw[ a b c d ]], [qw[ b e d ]] ){
    dd $QT;
    for my $triplet ( @S ){
        my %Pie;
        undef @Pie{@$QT};
        delete @Pie{ @$triplet };
#~         warn scalar keys %Pie ;
#~         warn scalar @$QT;
        print "@$triplet\n" if keys(%Pie) <= ( @$QT - @$triplet ) ;
    }
}
__END__
[["b", "c", "a"], ["a", "c", "d"], ["d", "e", "b"]]
["a" .. "d"]
b c a
a c d
["b", "e", "d"]
d e b

[remiah]

I just wanted to use Graph module.

#!/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.

[zing]

Thanks Anon,

How do i modify this code to take in input from command line i.e. instead of this line

for my $QT ( [qw[ a b c d ]], [qw[ b e d ]] )

How do i feed it with input vertices from command line