Hallo in die Runde.
Ich suche eine Optimierungsmöglichkeit für meinen Code.
Gegeben ist eine sehr einfache Baumstruktur (Nummerierung nach Kekule). Hier gibt es einen Startdatensatz (1) sowie zwei Abzweigungen (2 und 3). In meinem Fall ist das eine Startperson sowie dessen beiden leiblichen Elternteile. Um diese nun nach Kekule zu nummerieren, rufe ich die Routine einfach rekursiv auf (gekürzt):
[code]Public Sub neuerProband(nr as integer)
if Person(nr).VerweisVater>0 then
Person(Person(nr).VerweisVater).Kekulenummer = Person(nr).Kekulenummer + Person(nr).Kekulenummer
neuerProband(Person(nr).VerweisVater)
end
if Person(nr).VerweisMutter>0 then
Person(Person(nr).VerweisMutter).Kekulenummer =P erson(nr).Kekulenummer + Person(nr).Kekulenummer +
neuerProband(Person(nr).VerweisMutter,Plausi)
end
End Sub
[/code]
Der Code enthält zudem noch eine Begrenzung auf maximal 63 Generationen und eine Prüfung auf Zirkelschlüsse (z. B. Urgroßvater = Urenkel).
Jetzt habe ich einen Anwender mit so vielen Generationen und Datensätzen, dass die Generierung bei ihm schon über 4 Minuten dauert.
Hat jemand eine Idee, wie man den Code optimieren kann?
Derzeit überlege ich, lediglich 6 bis 10 Generationen in der Art durchlaufen zu lassen und dann an einen Thread abzugeben. Damit teile ich dann die höheren Generationen in mehrere Prozesse auf und der Anwender kann schon weiter arbeiten. Allerdings hat er dann zu Anfang noch nicht alle Datensätze nummeriert und ich weiß nicht, ob der Zeitgewinn lohnt.
Wie ist eure Einschätzung?
Gruß, Stefan Mettenbrink.
Hier noch die komplette Routine:
[code]Public Sub neuerProband(nr as integer,Plausi as Boolean)
//der Parameter Plausi gibt an, ob bei Verweisschleifen eine Hinweismeldung ausgegeben wird
//oder für die Plausibilitätsprüfung die Hinweise gesammelt werden sollen
//Plaus=true -> Hinweise sammeln
dim i,j,k,l As integer
dim Maximum,mv,mm,null as UInt64
dim s as String
//kekulezuindexN.value auf die benötigte Anzahl Einträge erweitern
Maximum=9223372036854775809
null=0
If nr>0 then
if Person(nr).Kekulenummer<=pow(2,64) then
'TestArray.Append(str(nr))
'merke=UBound(TestArray)
//Nur zu Testzwecken
'if UBound(TestArray)>45 then
'text=join(TestArray,EndOfLine)
'exit
'else
'back=back+1
'end
if Person(nr).Kekulenummer>null then
kekulezuindexN.value(Person(nr).Kekulenummer)=nr//neuen Verweis eintragen
end
if Person(nr).VerweisVater>0 then
for i=1 to ubound(Generationsline)
if Person(nr).VerweisVater=Generationsline(i) then
for j=i to UBound(Generationsline)-1
k=Generationsline(j)
l=Generationsline(j+1)
if Person(k).VerweisVater=l then
s=s+str(k)+" Vater -> "+str(l)+EndOfLine
else
s=s+str(k)+" Mutter -> "+str(l)+EndOfLine
end
next
k=Generationsline(UBound(Generationsline))
l=Person(nr).VerweisVater
s=s+str(k)+" Vater -> "+str(l)
if Plausi then
PlausiHinweis.Append HinweisPersonIndexnummerEigenerVorfahre_1+" "+str(Person(nr).VerweisVater)+HinweisPersonIndexnummerEigenerVorfahre_2
else
hinweis(HinweisPersonIndexnummerEigenerVorfahre_1+" "+str(Person(nr).VerweisVater)+HinweisPersonIndexnummerEigenerVorfahre_2)+EndOfLine+s
end
if Keyboard.AsyncShiftKey then
Person(nr).VerweisVater=0
end
exit
end
next
if i>ubound(Generationsline) then
if Person(nr).Kekulenummer<Maximum then
if Person(Person(nr).VerweisVater).Kekulenummer>null then
mv=Person(Person(nr).VerweisVater).Kekulenummer
end
Person(Person(nr).VerweisVater).Kekulenummer=Person(nr).Kekulenummer+Person(nr).Kekulenummer
Generationsline.append Person(nr).VerweisVater
neuerProband(Person(nr).VerweisVater,Plausi)
if mv>null and mv<Person(Person(nr).VerweisVater).Kekulenummer then
Person(Person(nr).VerweisVater).Kekulenummer=mv
end
Generationsline.Remove ubound(Generationsline)
end
end
end
if Person(nr).VerweisMutter>0 then
for i=1 to ubound(Generationsline)
if Person(nr).VerweisMutter=Generationsline(i) then
for j=i to UBound(Generationsline)-1
k=Generationsline(j)
l=Generationsline(j+1)
if Person(k).VerweisVater=l then
s=s+str(k)+" Vater -> "+str(l)+EndOfLine
else
s=s+str(k)+" Mutter -> "+str(l)+EndOfLine
end
next
k=Generationsline(UBound(Generationsline))
l=Person(nr).VerweisMutter
s=s+str(k)+" Mutter -> "+str(l)
if Plausi then
PlausiHinweis.Append HinweisPersonIndexnummerEigenerVorfahre_1+" "+str(Person(nr).VerweisMutter)+HinweisPersonIndexnummerEigenerVorfahre_2
else
hinweis(HinweisPersonIndexnummerEigenerVorfahre_1+" "+str(Person(nr).VerweisMutter)+HinweisPersonIndexnummerEigenerVorfahre_2)+EndOfLine+s
end
if Keyboard.AsyncShiftKey then
Person(nr).VerweisMutter=0
end
exit
end
next
if i>ubound(Generationsline) then
if Person(nr).Kekulenummer<Maximum then
if Person(Person(nr).VerweisMutter).Kekulenummer>null then
mm=Person(Person(nr).VerweisMutter).Kekulenummer
end
Person(Person(nr).VerweisMutter).Kekulenummer=Person(nr).Kekulenummer+Person(nr).Kekulenummer+1
Generationsline.append Person(nr).VerweisMutter
neuerProband(Person(nr).VerweisMutter,Plausi)
if mm>null and mm<Person(Person(nr).VerweisMutter).Kekulenummer then
Person(Person(nr).VerweisMutter).Kekulenummer=mm
end
Generationsline.Remove ubound(Generationsline)
end
end
end
else
hinweis(HinweisZuvieleGenerationen)
end
end
//Nur zu Testzwecken
'if UBound(TestArray)>merke then
'do
'TestArray.Remove UBound(TestArray)
'if UBound(TestArray)=merke then
'TestArray.Remove merke
'exit
'end
'Loop
'elseif UBound(TestArray)<merke then
'merke=merke
'else
'TestArray.Remove merke
'end
app.MouseCursor=mauszeiger(8)
Exception err
Fehlerbehandlung(err.message,“neuerProband”,err,false)
End Sub
[/code]
