← Back to branch summary

~ubuntu-branches/ubuntu/lucid/graphviz/lucid-security

« back to all changes in this revision

Viewing changes to contrib/dotmcl.pl

  • Committer: Bazaar Package Importer
  • Author(s): Stephen M Moraco
  • Date: 2002-02-05 18:52:12 UTC
  • Revision ID: james.westby@ubuntu.com-20020205185212-8i04c70te00rc40y
Tags: upstream-1.7.16
Import upstream version 1.7.16

Show diffs side-by-side

added added

removed removed

Lines of Context:
contrib/dotmcl.pl
 
1
#!perl -w
 
2
 
 
3
# dotmcl.pl <factor> <in.dot> <out.dot>
 
4
#   <factor>  the bigger, the more clusters (values from 1.2 to 3.0)
 
5
#   <in.dot>  dot in file to clusterize
 
6
#   <out.dot> dot out file with clusters added
 
7
# Vladimir Alexiev <vladimir@worklogic.com>
 
8
 
 
9
# This quick hack takes a dot graph description file, adds clusters using the
 
10
# mcl utility, and writes to stdout a dot graph amended with "subgraph
 
11
# cluster_n" declarations that put the nodes in clusters.
 
12
# dot: http://www.research.att.com/sw/tools/graphviz
 
13
# mcl: http://members.ams.chello.nl/svandong/thesis/
 
14
 
 
15
# It passes the input file through "dot -Tplain" so it can parse it more
 
16
# easily. Restrictions on the input file:
 
17
# - node names must be plain \w+
 
18
# - the closing "}" must be on the last line, in first position, and 
 
19
#   MUST be the only closing brace in first position in the whole file
 
20
 
 
21
my $factor = shift;
 
22
my $dotin = shift; # why not stdin: because need to read twice
 
23
my $dotout = shift; # why not stdout: because DOS commingles mcl's stderr into
 
24
                    # dotmcl's stdout
 
25
my (@nodes, %node_index, @graph);
 
26
for (`dot -Tplain $dotin`) {
 
27
  /^node (\w+)/ and do {
 
28
    push @nodes, $1;
 
29
    $node_index{$1} = $#nodes;
 
30
    next
 
31
  };
 
32
  /^edge (\w+) (\w+)/ and do {
 
33
    $graph[$node_index{$1}][$node_index{$2}] = 1;
 
34
    $graph[$node_index{$2}][$node_index{$1}] = 1; 
 
35
    # dot handles digraphs but mcl handles undirected graphs
 
36
    next
 
37
  }
 
38
}
 
39
my $nodes = @nodes;
 
40
my $mclin = "dotmcl-in.tmp";
 
41
my $mclout = "dotmcl-out.tmp";
 
42
 
 
43
open (MCLIN, ">$mclin") or die "can't create $mclin: $!\n";
 
44
# mcl is a nice program but its input format sucks!
 
45
print MCLIN << "MCLHEADER"; 
 
46
(mclheader
 
47
mcltype matrix
 
48
dimensions $ {nodes}x$ {nodes}
 
49
)
 
50
 
 
51
(mclmatrix
 
52
begin
 
53
MCLHEADER
 
54
 
 
55
for (my $i=0; $i<$nodes; $i++) {
 
56
  print MCLIN $i," ";
 
57
  for (my $j=0; $j<$nodes; $j++)
 
58
    {print MCLIN $j," " if $graph[$i][$j]};
 
59
  print MCLIN "\$\n";
 
60
}
 
61
print MCLIN << "MCLFOOTER";
 
62
)
 
63
MCLFOOTER
 
64
close(MCLIN);
 
65
 
 
66
system("mcl $mclin --silent -v mcl -I $factor -o $mclout")==0 or 
 
67
  die "can't run 'mcl $mclin -o $mclout: $!\n";
 
68
 
 
69
# read in clusters
 
70
my @cluster; 
 
71
# mcl output format sucks even worse because it can have "continuation lines"
 
72
# like this:
 
73
# (mclmatrix
 
74
# begin
 
75
# 0      0   1   2   3   4   5   6   7   8   9  12  13  14  15  16  18  19  20
 
76
#       86  87  88  89  90  91  92  94  95  96  98 105 106 107 109 110 112 113
 
77
#      115 116 117 118 121 125 127 128 131 132 133 137 138 145 $
 
78
# 1     28  29  31  32  33  34  35  36  78  93 129 130 134 135 136 $
 
79
# )
 
80
open (MCLOUT, $mclout) or die "can't open $mclout: $!\n";
 
81
my $line = '';
 
82
for (<MCLOUT>) {
 
83
  /^\d+(.+)/ and $line = $1;
 
84
  /^ +\d+/ and $line .= $_;
 
85
  /\$$/ and do {
 
86
    $line =~ s/\$$//;
 
87
    my @cl = split' ', $line;
 
88
    push @cluster, [@cl] 
 
89
      unless @cl <= 1;          # don't want trivial clusters
 
90
  }
 
91
}
 
92
close(MCLOUT);
 
93
 
 
94
open (DOTIN, $dotin) or die "can't open $dotin: $!\n";
 
95
open (DOTOUT, ">$dotout") or die "can't create $dotout: $!\n";
 
96
for (<DOTIN>) {
 
97
  /^\}$/ and last;
 
98
  print DOTOUT;
 
99
}
 
100
for (my $i=0; $i<@cluster; $i++) {
 
101
  print DOTOUT "  subgraph cluster_$i {label=\"\" ";
 
102
  for (@{$cluster[$i]}) {print DOTOUT " $nodes[$_]"};
 
103
  print DOTOUT "}\n";
 
104
}
 
105
print DOTOUT "}\n";
 
106
close(DOTOUT);
 
107
close(DOTIN);