Thread Distanzmatrix erstellen (8 answers)
Opened by Perl-Beginner at 2011-10-24 17:32

topeg
 2011-10-25 00:05
#153522 #153522
User since
2006-07-10
2611 Artikel
BenutzerIn

user image
Code (perl): (dl )
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;
}

View full thread Distanzmatrix erstellen