;Binärer Suchbaum, BB-Vorlage
;von Christoph Mach, April 2010
;Lizenz: WTFPL (http://sam.zoy.org/wtfpl/)

Type node ;Umbenennen wäre möglich durch die Funktion "Alle ersetzen" deines jeweils verwendeten Programmeditors
	Field parent.node
	Field Left.node
	Field Right.node
	Field key$ ;ACHTUNG: Will man wirklich nur Zahlen verwenden, so ist key% deutlich schneller! (Faktor ~100 in meinem Schnellversuch)
	Field all_your_base_are_belong_to_us$ ;Also hier alle Daten rein die du sonst noch brauchst
End Type

Global binary_root.node

;Suche nach einem Schlüssel
Function Search.node(key#)
	Local p.node=binary_root
	While p<>Null
		If key=p\key Then Exit
		If key<p\key Then
			p=p\Left
		Else
			p=p\Right
		EndIf
	Wend
	Return p
End Function

;Minimalster Wert im gesamten Baum
Function Minimum.node() 
	Local q.node=binary_root
	While q\Left<>Null
		q=q\Left
	Wend
	Return q
End Function

;Maximalster Wert im gesamten Baum
Function Maximum.node()
	Local q.node=binary_root
	While q\Right<>Null
		q=q\Right
	Wend
	Return q
End Function

;Minimalster Wert im durch q gegebenen Unterbaum
Function MinimumFrom.node(q.node) 
	If q=Null Then Return Null
	While q\Left<>Null
		q=q\Left
	Wend
	Return q
End Function

;Maximalster Wert im durch q gegebenen Unterbaum
Function MaximumFrom.node(q.node)
	If q=Null Then Return Null
	While q\Right<>Null
		q=q\Right
	Wend
	Return q
End Function

;Nächster Nachfolger von q (nach Schlüssel geordnet)
Function Successor.node(q.node)
	If q\Right<>Null Then
		Return MinimumFrom(q\Right)
	Else
		Local p.node=q\parent
		While p<>Null
			If q<>p\Right Then Exit
			q=p
			p=p\parent
		Wend
		Return p
	EndIf
End Function

;Nächster Vorgänger von q
Function Predecessor.node(q.node)
	If q\Left<>Null Then
		Return MaximumFrom(q\Left)
	Else
		Local p.node=q\parent
		While p<>Null
			If q<>p\Left Then Exit
			q=p
			p=p\parent
		Wend
		Return p
	EndIf
End Function

;Neues Element einfügen
Function InsertNode(q.node)
	Local r.node=Null
	Local p.node=binary_root
	While p<>Null
		r=p
		If q\key<p\key Then
			p=p\Left
		Else
			p=p\Right
		EndIf
	Wend
	q\parent=r
	q\Left=Null
	q\Right=Null
	If r=Null Then
		binary_root=q
	Else
		If q\key<r\key Then
			r\Left=q
		Else
			r\Right=q
		EndIf
	EndIf
End Function

;Element entfernen
Function DeleteNode(q.node)
	If q=Null Then Return
	;Fall 1 - keine Nachfolger
	If q\Right=Null And q\Left=Null Then
		Delete q
		Return
	EndIf
	Local r.node
	If q\Right=Null Or q\Left=Null Then
		;Fall 2 - genau 1 Nachfolger
		r=q
		Local p.node=r\parent
		If r\Left<>Null Then
			r=r\Left
		Else
			r=r\Right
		EndIf
		If p=Null Then
			binary_root=r
		Else
			If q=p\Right Then
				p\Right=r
			Else
				p\Left=r
			EndIf
		EndIf
	Else
		;Fall 3 - 2 Nachfolger
		r=Successor(q)
		r\parent\Left=r\Right
		r\Left=q\Left
		r\Right=q\Right
		r\parent=q\parent
	EndIf
	Delete q
End Function

;Frei erfundenes Anwendungsbeispiel des binären Suchbaumes:
;Man nehme an es gibt Personen (Hier mal nur Name) die durch eine Kennzahl identifiziert werden

Include "binarytree.bb"

SeedRnd MilliSecs()

Global entries=10000 ;Anzahl der Einträge mit denen getestet wird

Dim ids(entries-1) ;Zwischenspeicher der generierten Personennummern - damit man nachher nach ihnen suchen kann
;Anmerkung: Der ganze Umstand dass die Nummern generiert und nicht einfach fortlaufend gezählt werden ist der,
;dass bei einer fortlaufenden Zählen der Sinn der binären Bäume verloren geht - da könnte man ja gleich n Array nehmen...


Local n.node
Local time=MilliSecs()
For i=0 To entries-1 ;1000 Einträge
	n=New node
	n\key=Rand(1,1000000) ;Irgendeine Zahl generiern, event. doppelt vorkommende Zahlen werden einfach mal ignoriert
	ids(i)=n\key
	n\all_your_base_are_belong_to_us$="x"
	InsertNode(n)
Next
Print "Erstellen von "+entries+" Elementen: "+(MilliSecs()-time)+"ms"

;Eigentliche Demo: Zufällige Einträge suchen
Local searches=10000
time=MilliSecs()
For i=1 To searches
	num=ids(Rand(0,entries-1))
	n=Search(num)
	;DebugLog "Person Nr. "+num+" ist "+n\all_your_base_are_belong_to_us$
Next
Print searches+" Suchen in "+entries+" Elementen dauerten "+(MilliSecs()-time)+"ms"
;Debugmodus: 26ms, ohne Debug 6

time=MilliSecs()
For i=0 To entries-1
	n=Search(ids(i))
	DeleteNode(n)
Next
Print "In "+(MilliSecs()-time)+"ms wurden alle wieder gesucht & gelöscht"

WaitKey()
End