my $factor = shift;
my $dotin = shift; my $dotout = shift; my (@nodes, %node_index, @graph);
for (`dot -Tplain $dotin`) {
/^node (\w+)/ and do {
push @nodes, $1;
$node_index{$1} = $ next
};
/^edge (\w+) (\w+)/ and do {
$graph[$node_index{$1}][$node_index{$2}] = 1;
$graph[$node_index{$2}][$node_index{$1}] = 1;
next
}
}
my $nodes = @nodes;
my $mclin = "dotmcl-in.tmp";
my $mclout = "dotmcl-out.tmp";
open (MCLIN, ">$mclin") or die "can't create $mclin: $!\n";
print MCLIN << "MCLHEADER";
(mclheader
mcltype matrix
dimensions $ {nodes}x$ {nodes}
)
(mclmatrix
begin
MCLHEADER
for (my $i=0; $i<$nodes; $i++) {
print MCLIN $i," ";
for (my $j=0; $j<$nodes; $j++)
{print MCLIN $j," " if $graph[$i][$j]};
print MCLIN "\$\n";
}
print MCLIN << "MCLFOOTER";
)
MCLFOOTER
close(MCLIN);
system("mcl $mclin --silent -v mcl -I $factor -o $mclout")==0 or
die "can't run 'mcl $mclin -o $mclout: $!\n";
my @cluster;
open (MCLOUT, $mclout) or die "can't open $mclout: $!\n";
my $line = '';
for (<MCLOUT>) {
/^\d+(.+)/ and $line = $1;
/^ +\d+/ and $line .= $_;
/\$$/ and do {
$line =~ s/\$$//;
my @cl = split' ', $line;
push @cluster, [@cl]
unless @cl <= 1; }
}
close(MCLOUT);
open (DOTIN, $dotin) or die "can't open $dotin: $!\n";
open (DOTOUT, ">$dotout") or die "can't create $dotout: $!\n";
for (<DOTIN>) {
/^\}$/ and last;
print DOTOUT;
}
for (my $i=0; $i<@cluster; $i++) {
print DOTOUT " subgraph cluster_$i {label=\"\" ";
for (@{$cluster[$i]}) {print DOTOUT " $nodes[$_]"};
print DOTOUT "}\n";
}
print DOTOUT "}\n";
close(DOTOUT);
close(DOTIN);