1
2
3
4
5
6
7
8
9
10
11
12
a b c d e f g h i j k
a
b 1
c 3 4
d 3 4 1
e 4 3 7 7
f 4 3 7 7 1
g 6 7 3 4 10 10
h 6 7 3 4 10 10 1
i 6 7 4 3 10 10 7 7
j 7 6 10 10 3 4 13 13 13
k 9 10 6 7 13 13 3 4 10 16
1 2 3 4 5 6 7
my %HoA = ( root=>['A', 'B'], A=>['C', 'D'], B=>['E', 'F'], C=>['G', 'H'], D=>['I'], G=>['K'], E=>['J']);
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
$VAR1 = {
'root' => {
'A' => {
'D' => {
'I' => ''
},
'C' => {
'H' => '',
'G' => {
'K' => ''
}
}
},
'B' => {
'F' => '',
'E' => {
'J' => ''
}
}
}
};
dist root <> A => 1
dist root <> C => 2
dist root <> G => 3
dist root <> K => 4
dist root <> H => 3
dist root <> D => 2
dist root <> I => 3
dist root <> B => 1
dist root <> E => 2
dist root <> J => 3
dist root <> F => 2
dist A <> C => 1
dist A <> G => 2
dist A <> K => 3
dist A <> H => 2
dist A <> D => 1
dist A <> I => 2
dist A <> B => 0
dist A <> E => 1
dist A <> J => 2
dist A <> F => 1
dist C <> G => 1
dist C <> K => 2
dist C <> H => 1
dist C <> D => 0
dist C <> I => 1
dist C <> B => 1
dist C <> E => 3
dist C <> J => 4
dist C <> F => 3
dist G <> K => 1
dist G <> H => 0
dist G <> D => 1
dist G <> I => 3
dist G <> B => 2
dist G <> E => 4
dist G <> J => 5
dist G <> F => 4
dist K <> H => 1
dist K <> D => 2
dist K <> I => 4
dist K <> B => 3
dist K <> E => 5
dist K <> J => 6
dist K <> F => 5
dist H <> D => 1
dist H <> I => 3
dist H <> B => 2
dist H <> E => 4
dist H <> J => 5
dist H <> F => 4
dist D <> I => 1
dist D <> B => 1
dist D <> E => 3
dist D <> J => 4
dist D <> F => 3
dist I <> B => 2
dist I <> E => 4
dist I <> J => 5
dist I <> F => 4
dist B <> E => 1
dist B <> J => 2
dist B <> F => 1
dist E <> J => 1
dist E <> F => 0
dist J <> F => 1
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185
#!/usr/bin/perl # Variablendeklarationen erzwingen (Bessere Fehlererkennung) use strict; # Mehr Warungen (undefinierte Variablen etc.) use warnings; # Formatierte Ausgabe von Variablen (Datenstrukturen) use Data::Dumper; # Die Ausgangsadaten my %HoA = ( root=>['A', 'B'], A=>['C', 'D'], B=>['E', 'F'], C=>['G', 'H'], D=>['I'], G=>['K'], E=>['J'], ); # Einen Baum aus den Daten Bauen # $tree : Der erzeugte Baum # $names : Eine Liste aller Namen der vorhanden Knoten my ($tree,$names)=make_tree(\%HoA,'root'); # Root hinzufügen (fehlt bei der Erzeugung) $tree={'root' => $tree}; # Testweise Ausgabe des Baumes print Dumper($tree); # Aus dem Baum eine Liste mit "Pfaden" machen # Alle Knoten von der Wurzel "root" # bis zum entsprechenden Knoten my @list=make_list($tree); # Test Ausagabe #print Dumper(\@list); # Aus der Liste mit den Knotennamen # und der Pfadliste die Abstände bestimmen # mache eine Kopie der Namen my @nn=@$names; # entferne immer den ersten Eintrag bis die Liste leer ist # teste das gegen den Rest der liste # Da A <> B == B <> A braucht jede Kombination nur einmal getestet werden # Da A <> A == 0 ist braucht man das nicht zu testen. # Allso nimm einen wert aus der liste und teste ihn mit dem Rest. # damit sind alle interessanten Kombinationen getestet while(my $name=shift(@nn)) { # gehe den Rest der Liste durch for my $nn (@nn) { # bestimme die "Distanz" my $dist=make_diff(\@list,$name,$nn); # gib das Ergebnis aus print "dist $name <> $nn => $dist\n"; } } ######################################################################## # das Erzeugen des Baumes aus den Rohdaten # ist eine rekursive Funktion # sie ruft sich selber immer wieder mit neuen Werten auf, # bis alle Elemente erfasst sind. sub make_tree { # die Rohdaten my $data=shift; # der zu erzeugende Knoten my $node=shift; # "nichts" turcükgeben wenn dieser Knoten keine Kinder hat return '',[$node] unless(exists($data->{$node})); # Der Hash der später die kinderkoten halten wird my $ref={}; # Liste aller Knotennamen my @names=($node); # gehe alle Namen der Kinder des Kotens durch for my $name (@{$data->{$node}}) { # Bestimme den Darunterliegenden Baum durch Rekursion my $nn; ($ref->{$name},$nn)=make_tree($data,$name); # Alle Namen der gefunden Knoten in die liste der Knoten eifügen push(@names,@$nn); } # die Ergebnisse zurückgeben return $ref,\@names; } # aus dem Baum eine Liste mit Pfaden machen # Dazu wird der Baum rekursiv durchgegenagen # und Zu jedem Teilbaum eine liste von Pfaden erstellt, # bis keine Teilbäume mehr vorhanden sind sub make_list { # der zu untersuchende Teilbaum (Knoten mit KindElementen) my $tree=shift; # Die Liste mit Pfaden my @lst; Gehe alle KindElemente dieses Knotens for my $node (keys(%$tree)) { #füge Dieses Kind als Pfad hinzu push(@lst,[$node]); #Wenn das Kind Kinder hat # dann ruft die Funtion sich selber auf, # um diese zu testen if(ref($tree->{$node})) { # rufe dich selber auf my @ret=make_list($tree->{$node}); # vervollstänige die Liste mit den ergänzten Pfaden push(@lst,[$node,@$_]) for(@ret); } } # gib die fertige liste zurück return @lst; } # ermittle den Abstand der Knoten # das solltest du überarbeiten # ist nur ein schneller Wurf. sub make_diff { # liste der Pfade my $list=shift; # Knoten 1 my $name1=shift; # knoten 2 my $name2=shift; # zwischen den beiden soll der Absand bestimmt werden # die zum knoten gehörigen Pfade bestimmen my $l1; my $l2; # gehe die Liste durch # und wenn das Letzte Element des Pfades der gesuchte Knoten ist, # dann übernehme den Pfad for my $elm (@list) { $l1=$elm if($elm->[-1] eq $name1); $l2=$elm if($elm->[-1] eq $name2); # höre auf wenn die Pfade zu den Knoten gefunden wurden last if($1 and $l2); } # wenn nach der suche keine Pfade gefunden wurden, # dann gibt es sie nicht im Baum # der Abstand ist unbestimmt return -1 if(!$l1 or !$l2); # die vorläufige Abstand entspricht der Schritte Vom Ersten Knoten # bis zur Wurzel und zurück zum zweiten Knoten my $size=$#$l1+$#$l2+1; # wenn zwei Pfade gleiche Teilpfade haben # dann ziehe immer zwei ab bis sich die Pfade trennen my $p=0; while($p<$#$l1 and $p<$#$l2) { if($l1->[$p] eq $l2->[$p]) { $size-=2; } else { last; } $p++; } # wenn eines ein Endpunkt ist (keine kinder) # dann verkürze den Abstand $size-- if($p==$#$l1 || $p==$#$l2); # Rückgabe des Abstandes return $size; }