silizium-net.de

BlitzBasic > Codearchiv > Komplettprogramme/Spiele

Aktuallisiert 26.04.2010

Stringrechenfunktionen - von Triton
Wer in BB mit größeren Zahlen rechnen will, kennt das Problem: Nur bis 2³¹ - 1 (=2147483647) liefert BB exakte Ergebnisse. Darüber hinaus wird alles gerundet. Aber auch da hört die Kapazität bei 2¹²⁷ - 1 auf.

Mit dieser Sammlung von Funktionen ist es nun möglich das alles zu umgehen und mit quasi unbegrenzt großen - oder kleinen Zahlen zu rechnen. In beliebiger Genauigkeit.

Das Prinzip dahinter ist einfach: Strings als Datentyp können in BlitzBasic unendlich groß werden (eben bis der Speicher platzt), daher kann man mit Strings rechnen, in dem man quasi das schriftliche Rechnen der Grundrechenarten wie man sie in der Grundschule lernt algorithmisch umsetzt und daraus dann auch höhere Rechenfunktionen baut.

Zudem sind der Code benutzerfreundlich aufgebaut, spuckt Fehlercodes aus, verzeiht Eiingabefehler und enthält nützliche Zusatzfunktionen wie Runden, Punktieren, Primzahl uvm.

Übersicht über die Funktionen:

Addition
Subtraktion
Multiplikation
Division
Modulo
Vergleich (größer, kleiner, gleich)
A-hoch-B (a^b)
Logarithmus
Wurzel (Schulrechnen)
Wurzel (nach Heron)
Primzahl
Fakultät (n!)
Quersumme
Runden
Pointing (z.B 1234567 -> 1'234'567)
Stellenaddition
Absolut
Signum
Cleaner (säubert Zahleneingaben)

;** Arithmetik-Rechenfuntionen auf Stringbasis
;** ermöglichen das Rechnen mit Zahlen über die übliche Grenze von 2^127 - 1 hinaus.
;** 02.12.2005 - 26.04.2010, by Triton
;** zuletzt geändert: 26.04.2010
;** http://www.silizium-net.de
;** http://www.triton.ch.vu
;** isn-interactive@web.de

AppTitle "Tritons Stringrechenbibliothek"
Const komma$ = ","
Const ttrenn$ = "'" ;Tausendertrennzeichen
Const kreiszahl$="3"+komma$+"141592653589793238462643383279502884197169399375105820974944592308"
Const eulerzahl$="2"+komma$+"718281828459045235360287471352662497757247093699959574966967627724"
;66 Nachkommastellen der Konstanten
Global cleancheck=0		;alle Zahlen werden in Function cleaner gereinigt, nicht verändern!
Global status$			;einige Functions speichern darin Statusmeldungen


;---
Function addition$(a$,b$)
; a;b element Q
; im Grunde eine Umsetzung des Stellenweisen
; addierens beim schriftlichen Rechnen

a$ = cleaner$(a$)
b$ = cleaner$(b$)
If a$="0" Or a$="" Then Return b$
If b$="0" Or b$="" Then Return a$

If Left$(a$,1) = "-" Then 
	m1=1
	a$=Mid$(a$,2)
End If
If Left$(b$,1) = "-" Then 
	m2=1
	b$=Mid$(b$,2)
End If
If m1=1 And m2=0 Then Return subtraktion$(b$,a$)
If m1=1 And m2=1 Then minus=1
If m1=0 And m2=1 Then Return subtraktion$(a$,b$)

l1=Len(a$)
l2=Len(b$)

kommaposa = Instr(a$,komma$)
kommaposb = Instr(b$,komma$)
If Sgn(kommaposa) + Sgn(kommaposb) > 0 Then k=1
If k = 1 And kommaposa = 0 Then kommaposa=l1+1
If k = 1 And kommaposb = 0 Then kommaposb=l2+1

If kommaposa > 0 Then nachkommaa=l1-kommaposa
If kommaposb > 0 Then nachkommab=l2-kommaposb

If nachkommaa < nachkommab Then 
	nachkommax=nachkommab
	a$ = a$ + String("0",Abs(nachkommab-nachkommaa))
End If
If nachkommaa = nachkommab Then nachkommax=nachkommaa
If nachkommaa > nachkommab Then
	nachkommax=nachkommaa
	b$ = b$ + String("0",Abs(nachkommaa-nachkommab))
End If
If k > 0 Then 
	rka$ = Right$(a$,nachkommax)
	rkb$ = Right$(b$,nachkommax)

	lka$ = Left$(a$, kommaposa-1)
	lkb$ = Left$(b$, kommaposb-1)

	a$ = lka$+rka$
	b$ = lkb$+rkb$
End If

l1=Len(a$)
l2=Len(b$)
If l2 < l1 Then b$ = String("0",l1-l2)+b$:l2 = l1
If l1 < l2 Then a$ = String("0",l2-l1)+a$:l1 = l2

pos=l1-8
For pos2 = 1 To (l1/9)+1
	l=9
	If pos <= 0 Then 
		l=8+pos
		pos=1
	End If
	za$=Mid(a$,pos,l)
	zb$=Mid(b$,pos,l)
	c$=Str(Int(za$)+Int(zb$)+ue)
	If c$="0" Then c$=""
	If Len(c$) = 9 Then ue=0
	If Len(c$) < 9 And pos > 1 Then
		d$=""
		d$=String("0",9-Len(c$))
		c$=d$+c$
		ue=0
	End If
	If Len(c$) > 9 Then
		ue=1
		c$=Right$(c$,9)
	End If				
	ergebn$=c$+ergebn$
	pos=pos-9
Next

If k>0 Then 
	lges=Len(ergebn$)
	ergebn$ = Left$(ergebn$,lges-nachkommax)+komma$+Right$(ergebn$, nachkommax)
End If

If minus=1 Then Return "-"+ergebn$
Return ergebn$

End Function



;---
Function subtraktion$(a$,b$) 
; a;b element Q
; im Grunde eine Umsetzung des Stellenweisen
; subtrahierens beim schriftlichen Rechnen

a$ = cleaner$(a$)
b$ = cleaner$(b$)
If a$=b$ Then Return "0"
If a$="0" Then Return "-"+b$
If b$="0" Then Return a$

If Left$(a$,1) = "-" Then 
	m1=1
	a$=Mid$(a$,2)
End If
If Left$(b$,1) = "-" Then 
	m2=1
	b$=Mid$(b$,2)
End If
If m1=1 And m2=0 Then Return "-"+addition$(a$,b$)
If m1=0 And m2=1 Then Return addition$(a$,b$)
If m1=1 And m2=1 Then minus=1

l1=Len(a$)
l2=Len(b$)

kommaposa = Instr(a$,komma$)
kommaposb = Instr(b$,komma$)
If Sgn(kommaposa) + Sgn(kommaposb) > 0 Then k=1
If k = 1 And kommaposa = 0 Then kommaposa=l1+1
If k = 1 And kommaposb = 0 Then kommaposb=l2+1

If kommaposa > 0 Then nachkommaa=l1-kommaposa
If kommaposb > 0 Then nachkommab=l2-kommaposb

If nachkommaa < nachkommab Then 
	nachkommax=nachkommab
	a$ = a$ + String("0",Abs(nachkommab-nachkommaa))
End If
If nachkommaa = nachkommab Then nachkommax=nachkommaa
If nachkommaa > nachkommab Then
	nachkommax=nachkommaa
	b$ = b$ + String("0",Abs(nachkommaa-nachkommab))
End If
If k > 0 Then 
	rka$ = Right$(a$,nachkommax)
	rkb$ = Right$(b$,nachkommax)

	lka$ = Left$(a$, kommaposa-1)
	lkb$ = Left$(b$, kommaposb-1)

	a$ = lka$+rka$
	b$ = lkb$+rkb$
End If

l1=Len(a$)
l2=Len(b$)
If l2 < l1 Then b$ = String("0",l1-l2)+b$:l2 = l1
If l1 < l2 Then a$ = String("0",l2-l1)+a$:l1 = l2

If vergleich(a$,b$) = 2 Then 
	l=l1:l1=l2:l2=l
	c$=a$:a$=b$:b$=c$
	minus=1
End If

pos=l1-8
If l1 Mod 9 = 0 Then sc=0 
If l1 Mod 9 = 1 Then sc=1
For pos2 = 1 To (l1/9)+1
	l=9
	If pos <= 0 Then
		l=pos+8
		pos=1	
	End If
	za$=Mid(a$,pos,l)
	zb$=Mid(b$,pos,l)
	If Int(za$) < Int(zb$) Then za$="1"+za$
	If Int(za$) = Int(zb$) And ue=1 Then za$="1"+za$
	c$=Str$(Int(za$)-Int(zb$)-ue)
	ue=0
	If Len(za$) > 9 Then ue=1
	If Len(c$) < 9 Then 
		d=9-Len(c$)
		c$=String("0",d)+c$
		d=0
	End If

	ergebn$=c$+ergebn$
	pos=pos-9
Next

If k>0 Then 
	lges=Len(ergebn$)
	ergebn$ = Left$(ergebn$,lges-nachkommax)+komma$+Right$(ergebn$, nachkommax)
End If

While Left(ergebn$,1) = 0 
	ergebn$ = Mid(ergebn$,2) 
Wend
If Left(ergebn$,1) = komma$ Then ergebn$ = "0"+ergebn$
If minus=1 Then Return "-"+ergebn$
Return ergebn$

End Function



;---
Function multiplikation$(a$,b$) 
; a;b element Q
; Umsetzung des schriftlichen multiplizierens

a$ = cleaner$(a$)
b$ = cleaner$(b$)
If a$="0" Then Return "0"
If b$="0" Then Return "0"
If a$="1" Then Return b$
If b$="1" Then Return a$
If b$="2" Then Return addition$(a$,a$)
If a$="2" Then Return addition$(b$,b$)

If Left$(a$,1) = "-" Then 
	minus=1
	a$=Mid$(a$,2)
End If
If Left$(b$,1) = "-" Then 
	minus=minus+1
	b$=Mid$(b$,2)
End If

l1=Len(a$)
l2=Len(b$)
If l1 > l2 Then c$=b$:b$=a$:a$=c$:l3=l2:l2=l1:l1=l3

kommaposa = Instr(a$,komma$)
kommaposb = Instr(b$,komma$)
If Sgn(kommaposa) + Sgn(kommaposb) > 0 Then k=1

If k>0 Then
	nachkommaa=l1-kommaposa
	nachkommab=l2-kommaposb

	If kommaposa = 0 Then 		;für den Fall, dass eine Zahl kein Komma hat (123 -> 123,)
		kommaposa=l1+1
		nachkommaa = 0
	End If
	If kommaposb = 0 Then 
		kommaposb=l2+1
		nachkommab = 0
	End If

	nachkommax=nachkommaa+nachkommab			;wie viele nachkommastellen im Ergebnis
	
	rka$ = Right$(a$,nachkommaa)		;entfernt das komma aus a u. b
	rkb$ = Right$(b$,nachkommab)
	lka$ = Left$(a$, kommaposa-1)
	lkb$ = Left$(b$, kommaposb-1)
	a$ = lka$+rka$
	b$ = lkb$+rkb$

End If

While Mid(a$,n1+1,1) = "0"
n1=n1+1
Wend

While Mid(b$,n2+1,1) = "0"
n2=n2+1
Wend

l1=Len(a$)
l2=Len(b$)

While l1 Mod 5 > 0 
	a$="0"+a$
	l1=l1+1
Wend

While l2 Mod 4 > 0 
	b$="0"+b$
	l2=l2+1
Wend

pos=l1-4
pos2=l2-3
For oft1 = 1 To l1 Step 5
	za=Int(Mid(a$,pos,5))
	For oft2 = 1 To l2 Step 4
		zb=Int(Mid(b$,pos2,4))
		c$ = Str(za * zb)
		wo = Len(ergebn$)-Len(c$)-(l1+l2-pos-pos2-7)
		If wo > 0 Then wo=wo+1
		ergebn$=stellenaddition$(c$,ergebn$,wo)
		pos2=pos2-4
	Next
	pos=pos-5
	pos2=l2-3
Next

ergebn$=String("0",n1+n2-1) + ergebn$
lges=Len(ergebn$)
If lges-nachkommax > 0 Then ergebn$ = Left$(ergebn$,Abs(lges-nachkommax))+komma$+Right$(ergebn$, nachkommax)
lges=lges+1

While Right(ergebn$,1) = "0" 
	lges = lges-1					;Nullen hinten wegschneiden
	ergebn$ = Left$(ergebn$,lges)
Wend
If Right(ergebn$,1) = "," Then ergebn$ = Left$(ergebn$,lges-1)

If minus=1 Then Return "-"+ergebn$
Return ergebn$
End Function


;---
Function division$(a$,b$,genauigkeit)
;a;b element Q
;genauigkeit = 0 -> Return: ganzzahliges Ergebnis
;genauigkeit = -1 -> Return: ganzzahligs Ergebnis + Rest
;genauigkeit = -2 -> Return: nur der Rest (Modulo)
;es wird nicht gerundet, sondern einfach abgeschnitten!

a$ = cleaner$(a$)
b$ = cleaner$(b$)
If a$ = "0" Then Return "0"
If b$ = "0" Then Return "Division durch 0"
If b$ = "1" Then Return a$
If b$ = "-1" Then Return "-"+a$
aback$ = a$:bback$ = b$		;für den Rest später

If Left$(a$,1) = "-" Then 
	minus=1
	a$=Mid$(a$,2)
End If
If Left$(b$,1) = "-" Then 
	minus=minus+1
	b$=Mid$(b$,2)
End If
resta=0
vgl = vergleich(a$,b$)
If genauigkeit => -1 And vgl=0 Then Return "1"
If genauigkeit = 0 And vgl = 2 Then Return "0"
If genauigkeit = -1 Then genauigkeit = 0:resta=1
If genauigkeit = -2 Then genauigkeit = 0:resta=2	;Modulo

l1=Len(a$)
l2=Len(b$)

kommaposa = Instr(a$,komma$)					;Komma vorhanden?
kommaposb = Instr(b$,komma$)
k = Sgn(kommaposa) + Sgn(kommaposb)

nachkommaa=l1-kommaposa
nachkommab=l2-kommaposb
If kommaposa = 0 Then 							;für den Fall, dass eine Zahl kein Komma hat (123 -> 123,)
	kommaposa=l1+1
	nachkommaa = 0
End If
If kommaposb = 0 Then 
	kommaposb=l2+1
	nachkommab = 0
End If

basicnul = nachkommaa-nachkommab				;wo müssen wieviele Nullen ran, damits ein gemeiner Bruch wird 

If k > 0 Then 	
	rka$ = Right$(a$,nachkommaa)				;entfernt das komma aus a u. b
	rkb$ = Right$(b$,nachkommab)
	lka$ = Left$(a$, kommaposa-1)
	lkb$ = Left$(b$, kommaposb-1)
End If
If basicnul < 0 Then 
	a$ = lka$+rka$+String$("0", Abs(basicnul)+genauigkeit)
	b$ = lkb$+rkb$
End If
If basicnul = 0 And k > 0 Then 					;bei gleicher Nachkommastellenanzahl 
	a$ = lka$+rka$+String$("0", genauigkeit)
	b$ = lkb$+rkb$
End If
If basicnul = 0 And k = 0 Then 	
	lkb$ = b$
	lka$ = a$
	a$ = a$+String$("0", genauigkeit)				;wenn keine Kommas da sind 
End If

If basicnul > 0 Then
	a$ = lka$+rka$+String$("0", genauigkeit)
	b$ = lkb$+rkb$+String$("0", basicnul)
End If


l1=Len(a$)
l2=Len(b$)
lx = l1
If l1 < l2 Then lx = l1 
If l2 < l1 Then lx = l2
lv = vergleich(Left$(a$,lx), Left$(b$,lx))
If lv = 0 Or lv = 1 Then kommaposneu = kommaposa-kommaposb+2
If lv = 2 Then kommaposneu = kommaposa-kommaposb+1

While Not KeyDown(1)
	cleanercheck = 0
	c = vergleich(Left(a$,l2),b$)
	d$=""
	If c = 1 Or c = 0 Then d$ = String$("0", Len(a$)-l2)
	If c = 2 Then d$ = String$("0", Len(a$)-l2-1)

	e$="1"+d$
	erg$=addition$(erg$,e$)
	f$=b$+d$
	a$=subtraktion$(a$,f$)
	
	If vergleich(a$,b$)=2 Then Exit
Wend


If genauigkeit <= 0 And minus=1 Then erg$="-"+erg$
If genauigkeit = 0 And resta = 0 Then Return erg$
If genauigkeit = 0 And resta = 2 Then 										;Modulo
	If k>0 Then Return subtraktion$(aback$, multiplikation$(erg$, bback$))	;..mit Komma
	Return a$																;nur Integer
End If
If genauigkeit = 0 And resta = 1 Then 
	a$ = subtraktion$(aback$, multiplikation$(erg$, bback$))
	Return erg$+" Rest "+a$
End If
If genauigkeit > 0 Then
	erg$ = Left$(erg$, kommaposneu-1)+komma$+Mid$(erg$,kommaposneu)
	If Left$(erg$, 1) = komma$ Then erg$ = "0"+erg$
	If minus = 1 Then Return "-"+erg$
	Return erg$
End If

End Function



;---
Function modulo$(a$,b$)
;a;b element Q
Return division$(a$,b$,-2)
End Function



;---
Function vergleich(a$,b$) 
; a;b element Q
; Rückgabewerte:
; 1 - a > b, b < a
; 2 - b > a; a < b
; 0 - a = b

a$ = cleaner$(a$)
b$ = cleaner$(b$)
If a$ = b$ Then Return 0
If Left$(a$,1) = "-" And Left$(b$,1) <> "-" Then Return 2
If Left$(b$,1) = "-" And Left$(a$,1) <> "-" Then Return 1
If Left$(a$,1) = "-" And Left$(b$,1) = "-" Then minus=1

l1=Len(a$)
l2=Len(b$)

kommaposa = Instr(a$,komma$)						;Komma vorhanden?
kommaposb = Instr(b$,komma$)
k = Sgn(kommaposa) + Sgn(kommaposb)

If k > 0 Then 
	nachkommaa=l1-kommaposa
	nachkommab=l2-kommaposb
	If kommaposa = 0 Then 							;für den Fall, dass eine Zahl kein Komma hat (123 -> 123,)
		kommaposa=l1+1
		nachkommaa = 0
	End If
	If kommaposb = 0 Then 
		kommaposb=l2+1
		nachkommab = 0
	End If
	basicnul = nachkommaa-nachkommab				;wo müssen wieviele Nullen ran, damits ein gemeiner Bruch wird 
	rka$ = Right$(a$,nachkommaa)					;entfernt das komma aus a u. b
	rkb$ = Right$(b$,nachkommab)
	lka$ = Left$(a$, kommaposa-1)
	lkb$ = Left$(b$, kommaposb-1)

	If basicnul < 0 Then 
		a$ = lka$+rka$+String$("0", Abs(basicnul))
		b$ = lkb$+rkb$
	End If
	If basicnul = 0 And k > 0 Then 					;bei gleicher Nachkommastellenanzahl 
		a$ = lka$+rka$
		b$ = lkb$+rkb$
	End If
	If basicnul > 0 Then
		a$ = lka$+rka$
		b$ = lkb$+rkb$+String$("0", basicnul)
	End If
End If

l1=Len(a$)
l2=Len(b$)
If minus = 0 Then 
	If l2 < l1 Then Return 1
	If l1 < l2 Then Return 2
End If
If minus = 1 Then
	If l2 < l1 Then Return 2
	If l1 < l2 Then Return 1
End If

While Int(za$) = Int(zb$)
	pos=pos+1
	za$=Mid(a$,pos,1)
	zb$=Mid(b$,pos,1)
	If Int(za$) > Int(zb$) Then ret=1:Exit
	If Int(za$) < Int(zb$) Then ret=2:Exit
Wend
If minus = 0 Then Return ret
If minus = 1 And ret = 2 Then Return 1 Else Return 2
End Function



;---
Function ahochb$(a$,b$, genauigkeit) 
;a;b element Z
;genauigkeit nur für Fälle mit negativem Exponenten
a$ = cleaner$(a$)
b$ = cleaner$(b$)
If a$ = "0" Then Return "0"
If b$ = "0" Then Return "1"
If a$ = "1" Then Return "1"
If b$ = "1" Then Return a$
If b$ = "0"+komma$+"5" Then Return wurzel$(a$,0)
If Instr(b$,komma$) > 0 Then Return "Fehler - kein ganzzahliger Exponent"
aback$=a$
If Left$(a$,1) = "-" Then 
	m1=1
	a$ = Mid$(a$,2)
End If
If Left$(b$,1) = "-" Then
	b$ = Mid$(b$,2)
	m2=1
End If
If a$="10" Then							;Spezialfall für 10^x
	a$=Left$(a$,1)
	While vergleich(c$,b$) = 2
		c$ = addition$(c$,"1")
		a$ = a$+"0"
	Wend
	Return a
End If

c$="1"
d$=a$
If a$ = "2" Then						;Spezialfall für 2^x
	While vergleich(c$,b$) = 2
		c$ = addition$(c$,"1")
		a$ = addition$(a$,a$)
	Wend
End If
If a$ = "3" Then						;Spezialfall für 3^x
	While vergleich(c$,b$) = 2
		c$ = addition$(c$,"1")
		a$ = addition$(a$,addition$(a$,a$))
	Wend
End If

While vergleich(c$,b$) = 2
	c$ = addition$(c$,"1")
	a$ = multiplikation$(a$,d$)
Wend

If m1=0 And m2=0 Then Return a$ 															;2^7 = 128
If m1=0 And m2=1 Then Return division$("1",a$,genauigkeit)									;2^-7 = 1/128
If m1=1 And m2=1 And modulo$(b$, "2") = 1 Then Return "-"+division$("1",a$,genauigkeit)		;-2^-7 = -1/128
If m1=1 And m2=1 And modulo$(b$, "2") = 0 Then Return division$("1",a$,genauigkeit)			;-2^-6 = 1/64
If m1=1 And m2=0 And modulo$(b$, "2") = 1 Then Return "-"+a$								;-2^7 = -128
If m1=1 And m2=0 And modulo$(b$, "2") = 0 Then Return a$									;-2^6 = 64

End Function



;---
Function logarithmus$(zahl$,basis$)
;löst die Gleichung zahl = basis^x
;zahl;basis element N
;gibt nur den ganzzahligen Teil des Ergebnisses aus
zahl$ = cleaner$(zahl$)
If basis$="10" Then Return Len(zahl$)-1
If basis$="1" Then Return "Nicht lösbar!"
If Left$(basis$,1)="0" Then Return "Fehler - Logarithmus von 0"
If Left$(basis$,1)="-" Then Return "Fehler - negativer Logarithmus"

b$="1"
While vergleich(zahl$,b$) = 1
	b$ = multiplikation$(b$,basis$)
	c=c+1
Wend
If vergleich(zahl$,b$) = 0 Then  Return c
Return c-1
End Function



;---
Function wurzel$(Wert1$,Nachkomma%) 
;Wurzelfunktion von Rallimen
;basiert auf dem schriftlichen Wurzelziehen
;Wert1 element Q+
;letzte Stelle wird nicht gerundet!
Wert1$ = cleaner$(Wert1$)
If Left$(Wert1$,1) = "-" Then Return "negative Wurzel"
If Wert1$ = "0" Then Return "0"
If Wert1$ = "1" Then Return "1"
    Nachkomma% = Nachkomma% - 1 
    If Left (Wert1$,1)= komma$ Then Wert1$ = "0"+Wert1 
    If Instr(Wert1$,komma$) = 0 Then Wert1$=Wert1$+komma$ 
    ;Vorm Komma und nach Komma Stellen durch 2 teilbar 
    Dummy1$ = Left (Wert1$,Instr (Wert1$,komma$) - 1) 
    If Len (Dummy1$) Mod 2 Then Dummy1$ = "0" + Dummy1$ 
    Dummy2$ = Mid (Wert1$,Instr (Wert1$,komma$) + 1) 
    If Len (Dummy2$) Mod 2 Then Dummy2$ = Dummy2$ + "0" 
    Wert1$ = Dummy1$ + komma$ + Dummy2$ 
    
    Repeat 
        .Start 
        If Len (Wert1) Then 
            VonOb$ = Left (Wert1,2) 
         Else 
            VonOb$ = "00" 
        End If 
        If Instr (VonOb$,komma$) Then 
            Kommaw = Len (erg$) 
            Wert1 = Mid (Wert1,2) 
            Goto Start 
        End If 
        Wert1 = Mid (Wert1,3) 
        If Abzieh$ = "" Then 
            Abzieh$ = "1" 
         Else 
            Abzieh$ = addition$(erg$,erg$) + "1" 
        End If 
        ReWert$ = ReWert$ + VonOb 
        While Left (ReWert$,1) = "0" : Rewert = Mid (ReWert$,2) : Wend 
        If Len (Rewert) = 0 Then Rewert = "0" 
        For t = 0 To 10 
            If vergleich(ReWert$,Abzieh$) <> 2 Then 
                ReWert$ = subtraktion$(ReWert$,Abzieh$) 
                Abzieh = addition$(Abzieh,2) 
             Else 
                erg = erg + T 
                Exit 
            End If 
        Next 
        If Len (erg) - Kommaw > Nachkomma% Then Exit 
    Forever 
    If kommaw Then 
        returnwert$ = Left (Erg$,Kommaw) + komma$ + Mid (Erg$,Kommaw + 1) 
        Return returnwert$ 
     Else 
        Return erg 
    End If 
End Function 


;---
Function wurzel2$(zahl$, genauigkeit)
;genauigkeit = 0 -> Return: ganzzahlige Wurzel
;genauigkeit = -1 -> Return: ganzzahlige Wurzel + Rest
;zahl element Q+
; n = a * b
; a = 1/2*(a+b)
; b = n/a
; usw.
; -> sehr effizentes Näherungsverfahren von Heron
;letzte Stelle wird gerundet
zahl$ = cleaner$(zahl$)
If Left$(zahl$,1) = "-" Then Return "negative Wurzel"
If zahl$ = "0" Then Return "0"
If zahl$ = "1" Then Return "1"

If genauigkeit > 0
	lz=Len(zahl$)
	kommapos = Instr(zahl$,komma$)
	If kommapos > 0 Then
		lka$ = Left$(zahl$, kommapos-1)
		rka$ = Right$(zahl$,lz-kommapos)					;entfernt das komma
		zahl$ = lka$+rka$+String$(0, genauigkeit+genauigkeit)
	End If
	If kommapos = 0 Then 
		zahl$ = zahl$+String$(0, genauigkeit+genauigkeit)
		kommapos = lz+1										;257  -> 257,
	End If
	If Len(lka$) Mod 2 = 1 Then zahl$=Left$(zahl$,Len(zahl$)-1)
	kommaposneu = (kommapos-1)/2 + 2
	If kommaposneu = 1 Then kommaposneu=2
	durchgaenge = Int(Log(genauigkeit)/0.693147)-1
End If

lz=Len(zahl$)
If lz Mod 2 = 0 Then 
	newl = (lz/2)-4
	d$=String("0",newl)
	c$=Str(Int(Sqr(Int(Left$(zahl$,8)))))+d$
End If
If lz Mod 2 > 0 Then
	newl=(lz/2)-4
	d$=String("0",newl)
	c$=Str(Int(Sqr(Int(Left$(zahl$,9)))))+d$
End If

d$ = division$(zahl$,c$,0)
While Not KeyDown(1)
	a = a + 1
	c$ = division$(addition$(c$,d$),"2",0)
	d$ = division$(zahl$,c$,0)
	
	If c$ = d$ Then Exit
	If a = durchgaenge Then c$ = d$:Exit
Wend

If genauigkeit = -1 Then
	zwprod$=multiplikation$(c$,c$)
	Return c$+" Rest "+subtraktion$(zahl$,zwprod$)
End If
If genauigkeit = 0 Then Return c$
If genauigkeit > 0 Then 
	lka$ = Left$(c$, kommaposneu-1)
	rka$ = Mid$(c$,kommaposneu)
	Return lka$+komma$+rka$
End If

End Function



;---
Function primzahl$(zahl$)
;zahl element N
;return: Teiler der Zahl, wenn keine Primzahl, 0 wenn Primzahl

zahl$ = cleaner$(zahl$)
If zahl$ = "1" Or zahl$ = "0" Then Return "0"
If zahl$ = "2" Then Return "1"
If zahl$ = "3" Then Return "1"
If zahl$ = "5" Then Return "1"
If Left$(zahl$,1) = "-" Then Return "0"
If Instr(zahl$,"/") Then Return 0
If Instr(zahl$,komma$) Then Return 0 
If Int(Right$(zahl$,1)) Mod 2 = "0" Then Return "2"
If quersumme(zahl$) Mod 3 = 0 Then Return "3"
If Right$(zahl$,1) = "5" Then Return "5"
wurzl$=wurzel$(zahl$, 0)

count$ = division$(wurzl$,"3",0)
a$="1"
n=0
While vergleich(a$,wurzl$) = "2"
	n=n+1
	If n Mod 2 = 0 Then a$=addition$(a$,"2")
	If n Mod 2 = 1 Then a$=addition$(a$,"4")
	status$ = Str(n)+"/"+count$
	If modulo$(zahl$,a$) = "0" Then 
		Color 0,0,0
		Rect 10,300,1000,300,1
		Color 255,255,255
		Return a$
	End If
	If KeyDown(1) Then Exit
Wend
If statusm=1 Then 
	Color 0,0,0
	Rect 10,300,1000,300,1
	Color 255,255,255
End If

Return "1"
End Function



;---
Function fakultaet$(n)
;z.B. 6! -> 1*2*3*4*5*6 = 720
;n Element N

If n < 0 Then Return "Fehler - negative Fakultät"
If n < 3 Then Return n
If n Mod 1 > 0 Then Return "Fehler - keine natürliche Zahl"

e$="1"
For oft = 1 To n
	If statusm=1 Then Print status$ =Str(oft)+"/"+Str(n)
 	If KeyDown(1) Then Return "Vorzeitig abgebrochen!"
	e$=multiplikation$(e$,Str(oft))
Next
Return e$
End Function



;---
Function quersumme(zahl$)
;z.B. 123456 -> 1+2+3+4+5+6 = 21
;zahl Element N

zahl$ = cleaner$(zahl$)
If Left$(zahl$,1) = "-" Then zahl$=Mid$(zahl$,2)
If Instr(zahl$,"/") Then Return 0
If Instr(zahl$,komma$) > 0 Then Return 0

l = Len(zahl$)
For x = 1 To l
	z=Mid$(zahl$,x,1)
	qs=qs+z
Next
Return qs

End Function


;---
Function runden$(zahl$,stellen)
;stellen -> Genauigkeit der Ausgabe
;z.B 123,56789 auf 5 Stellen: 1,2357 * 10^2
;zahl element Q

zahl$ = cleaner$(zahl$)
If Left$(zahl$,1)="-" Then zahl$=Mid$(zahl$,2):minus=1
l = Len(zahl$)
If l =0 Then Return "0"

kommapos = Instr(zahl$,komma$,2)
If kommapos > 0 Then
	zahla$=Left$(zahl$,kommapos-1)
	zahlb$=Mid$(zahl$,kommapos+1)
	zahl$=zahla$+zahlb$
End If
expo=kommapos-2

zahla$=Left$(zahl$,1)
zahlb$=Mid$(zahl$,2,stellen-2)
zahlc$=Mid$(zahl$,stellen,1)
zahld=Int(Mid$(zahl$,stellen+1,1))

If kommapos = 0 Then expo=l-1
If zahld => 5 Then zahlc$=Str(Int(zahlc$)+1)

erg$=zahla$+komma$+zahlb$+zahlc$+" * 10^"+Str(expo)
If Int(zahlb$)=0 And Int(zahlc$)=0 Then 
	erg$=zahla$+" * 10^"+Str(expo)
	If zahla$="1" Then erg$="10^"+Str(expo)
End If
If minus=1 Then erg$="-"+erg$
Return erg

End Function



;---
Function pointing$(zahl$)
;bereitet eine Zahl leserlich auf
;Grundfunction von rallimen, erweitert+verändert von mir
;zahl element Q
;321654987 -> 321'654'987
;9876543,21879654	->	9'876'543,21879654
;nur zur Endausgabe für den User nutzen, nicht zum Rechnen innerhalb der Functions!

zahl$ = cleaner$(zahl$)
l=Len(zahl$)
If Left$(zahl$,1)="-" Then 
	minus=1
	zahl$=Right$(zahl$,l-1)
	l=l-1
End If

bruchpos = Instr(zahl$,"/",2)
If bruchpos > 0 Then 
	zahla$=pointing$(Left$(zahl$, bruchpos-1))
	zahlb$=pointing(Mid$(zahl$,bruchpos+1))
	If minus = 1 Then Return "-"+zahla$+"/"+zahlb$
	If minus = 0 Then Return zahla$+"/"+zahlb$
End If

kommapos = Instr(zahl$,komma$,2)
If kommapos > 0 Then 
	zahlb$=zahl$
	zahl$=Left$(zahlb$,kommapos-1)
	zahlb$=Mid$(zahlb$,kommapos)
End If

While Len(zahl$) > 3 
	b$ = ttrenn$ + Right$(zahl$,3) + b$ 
	zahl$ = Left$(zahl$,Len(zahl$) - 3)
Wend
	
If minus=1 Then Return "-"+zahl$ + b$ + zahlb$
Return zahl$ + b$ + zahlb$ 

End Function


;---
Function stellenaddition$(a$,b$,c)
;a - Zahl1 element N (z.B 12)
;b - Zahl2 element N (z.B 111111)
;c - Position innerhalb von b bei der a eingefügt wird (z.B 3) (element Z)
;-> Return 112311
;funktioniert auch mit negativer Stelle:  555 in 1111 an Stelle -2 einfügen = 556111
; es gibt keine Stelle 0 (..|-2|-1| 1| 2| 3|..)
; wird benutzt von Multiplikation (um reitraubendes multiplizieren von vielen Nullen zu umgehen)

If c = 0 Then c = 1
la = Len(a$)
lb = Len(b$)
If lb < la Then
	aback$=a$:a$=b$:b$=aback$
	laback=la:la=lb:lb=laback
	c = 1-c
End If

wo = c+la
If wo < 0 And c < 0 Then Return a$+String$("0",-wo)+b$		;a liegt komplett links außerhalb von b
If wo = 0 And c < 0 Then Return a$+b$						;a liegt exakt vor b
If wo > 0 And wo <= lb Then									;a hat kontakt mit b
	If c < 1 Then									;a überlappt Stelle 1 von b
		bl$=Left$(b$,la+c)
		br$=Mid$(b$,la+c+1)
		Return addition$(a$,bl$)+br$
	End If
	If c = 1 Then									;a liegt an stelle 1 von b
		bl$ = Left$(b$,la)	
		br=Mid$(b$,la+1)
		Return addition$(a$,bl$)+br$
	End If
	If c > 1 Then									;a liegt komplett innerhalb von b				
		If c <= lb Then
			bl$ = Left$(b$, c-1)
			bm$ = Mid$(b$,c,la)
			br$ = Mid$(b$,c+la)
			bm$=addition$(a$,bm$)
			If Len(bm$) > la Then bm$=Mid$(bm$,2):bl$=addition$(bl$,"1")
			Return bl$+bm$+br$
		End If
	End If
End If
If wo > lb And c <= lb Then										;a liegt auf dem hinteren abschluss von b
	If c > 0 Then bl$=Left$(b$,c-1)
	br$=Mid$(b$,c)+String$("0",-lb+c+la-1)
	br$=addition$(a$,br$)
	If Len(br$) > la Then br$=Mid$(br$,2):bl$=addition$(bl$,"1")
	Return bl$+br$
End If
If c > lb Then													;a liegt hinter b
	br$=String$("0",c-lb-1)
	Return b$+br$+a$
End If

End Function



;---
Function absolut$(zahl$)
;gleiche Funktion wie abs()
;-6 	->		6
;0 		->		0
;6		->		6
zahl$ = cleaner$(zahl$)
If Left$(zahl$,1) = "-" Then Return Mid$(zahl$,2)
Return zahl$
End Function



;---
Function signum(zahl$)
;gleiche Funktion wie sgn()
;-6 	->		-1
;0 		->		0
;6		->		1
zahl$ = cleaner$(zahl$)
If Left$(zahl$,1) = "-" Then Return -1
If zahl$ = "0" Then Return 0
Return 1
End Function


;---
Function cleaner$(zahl$)
;korrigiert unsaubere Zahleneingaben
;00,123 	->  0,123
;123,0000	->	123
;-0123,		->	-123
;check=1 heißt, dass eine Zahl nur einmal überprüft werden soll
;z.B bei a^b, wo immer die gleichen Zahlen multipliziert werden und nicht immer aufs neue gereinigt werden müssen
;erwünscht ist es dagegen bei Functions die auf nichts anderes verweisen für ihre Funktion (Vergleich z.B.)
If cleancheck > 0 Then 
	cleancheck=cleancheck+1
	If cleancheck > 2 Then Return zahl$
End If
If Left$(zahl$,1) = " " Then zahl$ = Mid$(zahl$,2)
If Left$(zahl$,1) = "-" Then 
	minus = 1
	zahl$=Mid$(zahl$,2)
End If
If Instr(zahl$,komma$) > 0 Then k = 1
While Left$(zahl$,1) = "0"									;Nullen vorne?
	zahl$ = Mid$(zahl$,2)
Wend
If Instr(zahl$,komma$) = 1 Then zahl$ = "0"+zahl$			;Komma vorne? (1 Null wieder hin)
If k > 0 Then												;Nullen rechts neben komma?
	While Right$(zahl$,1) = "0"
		l1 = Len(zahl$)
		zahl$ = Left$(zahl$,l1-1)
	Wend
End If
l1 = Len(zahl$)
If Right$(zahl$,1) = komma$ Then zahl$=Left$(zahl$,l1-1)	;rechts nurnoch ein Komma?

If minus = 1 Then Return "-"+zahl$
Return zahl$

End Function