Stringrechner + - / * und Sqr für sehr grosse Zahlen

Übersicht BlitzBasic Codearchiv

Gehe zu Seite 1, 2  Weiter

Neue Antwort erstellen

Rallimen

Sieger des 30-EUR-Wettbewerbs

Betreff: Stringrechner + - / * und Sqr für sehr grosse Zahlen

BeitragSa, März 05, 2005 14:59
Antworten mit Zitat
Benutzer-Profile anzeigen
Habe mal meine String Rechnen Functionen ausgegraben
nur für Ganzzahlen
Und auch nur für spezielle Anwendungen gedacht wenn die BB 4Byte nicht ausreichen, da die Speed nicht mithalten kann!
Sicherheitsabfragen in Bezug auf Negativen Zahlen sind hierbei nicht berücksichtigt und werden nicht abgefangen, obwohl es ein leichtes ist das zu impletieren!
Speed der Functionen kann zum Teil bestimmt noch erhöht werden!

Code: [AUSKLAPPEN]
Function Subtrahieren$ (Wert1$,Wert2$)
    If Len (wert1$) > Len (wert2$) Then
        wert2$ = RSet (wert2$,Len (wert1$) )
     Else
        wert1$ = RSet (wert1$,Len (wert2$) )
    End If
   
    While Len (wert1$) > 8
        zw = (Int (Right (wert1$,8) ) - Int (Right (wert2$,8) ) - c%)
        wert1$ = Left (wert1$ , Len (wert1$) - 8)
        wert2$ = Left (wert2$ , Len (wert2$) - 8)
        If zw < 0 Then
            zw = 100000000 + zw
            c% = 1
         Else
            c% = 0
        End If
        If Len (Str (zw) ) < 8 Then
            zwS$ = Replace (RSet (zw,8) ," ","0")
            returnWert$ = Right (zwS$,8) + returnWert$
         Else
            returnWert$ = zw + returnWert$
        End If
    Wend
   
    zw = (Int (Right (wert1$,8) ) - Int (Right (wert2$,8) ) - c%)
    returnWert$ = zw + returnWert$
   
    While Left (returnWert$,1) = "0"
        returnWert$ = Mid (returnWert$,2)
    Wend
   
    Return returnWert$
End Function

Function Multiplizieren$ (Wert1$,Wert2$)
   
    For i = 1 To Len (wert1$)
        Multipli% = Mid (wert1$,i ,1)
        dummy2$ = Wert2$
       
        While Len (dummy2$) > 7
            Akwert = Right (dummy2$,7)
            dummy2$ = Left (wert2$,Len (dummy2$) - 7)
            erg = Multipli% * Akwert + rest%
            If erg > 9999999 Then
                rest% = Left (erg ,1)
                erg = Right (erg ,7)
             Else
                rest = 0
            End If
            If Len (Str (erg) ) < 7 Then
                ZwWert$ = Replace (RSet (erg,7) ," ","0") + ZwWert$
             Else
                ZwWert$ = Replace (RSet (erg,7) ," ","0") + ZwWert$
            End If
        Wend
       
        ;###############
        rest% = Multipli% * Int (dummy2$) + rest%
        ZwWert$ = rest% + ZwWert$
        rest = 0
        If len(dummy$) Then
            dummy$ = Addieren$ (ZwWert$ ,Dummy$ + "0")
         Else
            dummy$ = ZwWert$
        End If
        ZwWert$ = ""
    Next
   
    Return dummy$
End Function

Function Addieren$ (Wert1$,Wert2$)
    If Len (wert1$) > Len (wert2$) Then
        wert2$ = RSet (wert2$,Len (wert1$) )
     Else
        wert1$ = RSet (wert1$,Len (wert2$) )
    End If
   
    While Len (wert1$) > 8
        zw$ = (Int (Right (wert1$,8) ) + Int (Right (wert2$,8) ) + c%)
        If Len (zw) < 9 Then zw = Replace (RSet (zw,8) ," ","0")
        If Len (zw$) > 8 Then
            c% = 1
            zw$ = Mid (zw$,2)
         Else
            c% = 0
        End If
        returnWert$ = Right (zw$,8) + returnWert$
        wert1$ = Left (wert1$ , Len (wert1$) - 8)
        wert2$ = Left (wert2$ , Len (wert2$) - 8)
    Wend
   
    Return (Int (wert1$) + Int (wert2$) + c) + returnWert$
End Function

Function Dividieren$ (Wert1$,Wert2$)
   
    While Len (wert1)
        ReWert$ = ReWert + Mid (wert1,1,1)
        wert1 = Mid (wert1,2)
       
        For i = 0 To 10
            If Dividieren_Vergleichen (ReWert$,wert2$) = 2 Then
                ergebnis$ = ergebnis$ + i
                Exit
             Else
                ZwWert$ = Subtrahieren$ (ReWert$,wert2)
                ReWert$ = ZwWert$
            End If
        Next
       
    Wend
   
    While Left (ergebnis$,1) = "0"
        ergebnis$ = Mid (ergebnis$,2)
    Wend
   
    If Len (ergebnis$) = 0 Then ergebnis$ = "0"
    Return ergebnis$
End Function

Function Dividieren_Vergleichen (wert1$,wert2$)
    If Left (wert1$,1) = "0" Then
        While Left (wert1$,1) = "0" : wert1$ = Mid (wert1$,2) : Wend
        If Len (wert1$) = 0 Then wert1$ = "0"
    End If
    If Left (wert2$,1) = "0" Then
        While Left (wert2,1) = "0" : wert2 = Mid (wert2,2) : Wend
        If Len (wert2) = 0 Then wert2 = "0"
    End If
    a1 = Len (wert1$)
    a2 = Len (wert2$)
    If a1 > a2 Then Return 1
    If a1 < a2 Then Return 2
    If wert1$ > wert2$ Then Return 1 ; wert1  ist größer
    If wert1$ < wert2 $ Then Return 2 ; wert1  ist kleiner
    Return 0
End Function

Function Square_Root$ (Wert1$)
    If Len (Wert1$) Mod 2 Then Wert1$ = " " + Wert1$
    While Len (wert1)
        VonOb$ = Left (wert1,2)
        wert1 = Mid (wert1,3)
        If Abzieh$ = "" Then
            Abzieh$ = "1"
         Else
            Abzieh$ = Addieren$ (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 Dividieren_Vergleichen (ReWert$,Abzieh$) <> 2 Then
                ReWert$ = Subtrahieren$ (ReWert$,Abzieh$)
                Abzieh = Addieren$ (Abzieh,2)
             Else
                erg = erg + T
                Exit
            End If
        Next
    Wend
    Return erg
End Function[/syntax]
Die Handhabung ist sehr einfach
[syntax="bb"]Ergebnis$ = Addieren$ (Wert1$,Wert2$)      ;= wert1 + wert2
Ergebnis$ = Subtrahieren$ (Wert1$,Wert2$)  ;= wert1 - wert2
Ergebnis$ = Multiplizieren$ (Wert1$,Wert2$);= wert1 * wert2
Ergebnis$ = Dividieren$ (Wert1$,Wert2$)    ;= wert1 / wert2
;neu
Ergebnis$ = Square_Root$ (Wert1$)    ;= Sqr(wert1)[/syntax]

Dieses Programm arbeitet zB mit 2 der Functionen
http://people.freenet.de/rallimen/Basic/TvHanoi.exe
berechnet die Mindestanzahl der Züge "Türme von Hanoi"

Hier noch ein einfaches TestProggi[syntax="bb"]Graphics 1000,500,16,2
A$ = "6534523456456345634565345234564563456345"

Print A$:
A$ = String(a$,5)
Print A$: Print""
Print "Die StartZahl hat nun "+Len(A$)+ " Stellen"

Print"Jetzt wird diese Zahl mit sich selbst Multipliziert" : Print
Time1 = MilliSecs ()
b$ = Multiplizieren$ (a$,a$)
Print "Dauer: " + (MilliSecs () - time1) + " Millisec" : Print
Print "Das Ergebnis hat nun " + Len (b$) + " Stellen" : Print
Print"Nun wird die Wurzel gezogen" : Print
Time1 = MilliSecs ()
b$ = Square_Root$ (b$)
Print "Dauer: " + (MilliSecs () - time1) + " Millisec" : Print
    Print"und diese mit dem Startwert verglichen " : Print
If a$ = b$ Then
    Print"Die Zahlen stimmen überein" : Print""
 Else
    Print"Die Zahlen stimmen nicht überein" : Print""
End If
Print "Taste"
WaitKey
  • Zuletzt bearbeitet von Rallimen am Sa, Okt 30, 2010 15:40, insgesamt 3-mal bearbeitet

Artemis

BeitragDo, März 17, 2005 18:46
Antworten mit Zitat
Benutzer-Profile anzeigen
cool.
hier mal die anzahl der züge, die man bei 9999 scheiben braucht, wo man wohl sieht, dass er mit riesigen zahlen rechnen kann : Code: [AUSKLAPPEN]
9975315584403791924418710813417925419117484159430962274260044
7492647194151109733159599808420180972989496655647116045621357
7824567470689055879689296604816197892786502339689726338262327
5633029947760275043459096655771254304230309052342754537433044
8124440452449474190046269708166289253107841547369512784561940
3261254832193722052337993581349272661143426908084715788781482
0381418440380366114267545820738091978190729484731949705420480
2681339105323107136666970182627828247653015713401174847001679
6715832572964888663983288780308629101570399709908980368912284
1881140018651442743625950417232290727325278964800707416960807
8672940696285476898845596389004134788678372220615310093789181
6275136416189463535518690143319651571406662070081209783584528
7030709827171162319400624428073652603715996129805898125065496
4301208541704038029661600806342461442481279206564220307683694
7574355712815755554487275710165691010146582047879823237800520
2922920783036022481433508257530960315502093211137954335450287
3032089284759557280275341256252030037599211309490296185590272
2239403645319762127416961099135370223658118838042330651688935
3019901706598566746827311350281584968727754120890486405491645
6572017859387623842549286384689632166107996999384433304041844
1891901382164138758613682878637239205614719486690543080371162
6645987406560098802089140982848737949082265629217067979931392
0650640927031417383245443452605237904413079119809928850612035
2216529153793451965980230170248657829160433605295665045187641
1707769872697198857628727645255106155473660805376737412870387
6369931741492491703784689778233193109372847496395082860518506
8221656790860715589569911149192292366722013548209142550253646
3874182275289317250550426493906194736964349770417173079403521
9795594929075728895885718098493640657297418916010407374910859
2900569453561412545291340871811028873796070882685784386280745
2291452496230514315040767791654065050993837928117171769477704
5878117004224437630813217843244167597318601886466200472281234
6162717520033901363691887768820336344931812051874570548335927
8525379549050123394940089135962976690641210977014151379704224
4775073383341948489984431208181566881969516867279007038183709
3885552769211286974955509323410984829082574256524711118497385
7381534577734108841438100181388628861890682665805598405640396
3347409436006493218303842758199302673011489357787589736926231
8472346154394713297410850402556016118274814408451786956068416
9196795878209366925255485135806957719795495799077327208668155
8284680155611249689849996133908661790115559313222876495678790
8750409991961814230762494054448011612218108688580904317850773
4242029311164896426937811743278220268481311009481785514406180
7837562716691516350145488343252842785787527583637594495970648
5566884507495809065758577200386432528659477872546016509265242
3556909157703662026659519231042018210881851955775319894500371
4268360981404517389872666602341843979342901189761093145600403
7140977565897407881222414925923075485244401363736078734406579
7375204866057540249095227901708413474893570658031605343195755
840887152396298354687
 

TOONY

BeitragFr, März 18, 2005 16:23
Antworten mit Zitat
Benutzer-Profile anzeigen
was da fehlt sind die zahlen nach dem komma!!

regaa

BeitragFr, März 18, 2005 16:55
Antworten mit Zitat
Benutzer-Profile anzeigen
kewle Sache. Macht fun. Hab dem Computer 2 2000Stellige Multiplikatoren gegeben. Hat mehrere Sekunden gedauert.
UltraMixer Professional 3 - Download
QB,HTML,CSS,JS,PHP,SQL,>>B2D,B3D,BP,BlitzMax,C,C++,Java,C#,VB6 , C#, VB.Net

Mooch

BeitragFr, März 18, 2005 17:00
Antworten mit Zitat
Benutzer-Profile anzeigen
Voll 8)

Thx dafür Razz
Pentium IV 3.0Ghz; nVidia Geforce 6800;
Microsoft Windows XP Home SP2; BlitzBasic 3D

.:: Sites ::.
.:: http://www.fl4sh-clan.de/ ::.


frigi

BeitragFr, Apr 08, 2005 19:33
Antworten mit Zitat
Benutzer-Profile anzeigen
Ich hab mal ein bisschen damit rumprobiert und musste leider feststellen, dass noch ein bug vorhanden ist:

Code: [AUSKLAPPEN]
Multiplizieren$ ("100000000000000000","100000000000000000")


ergibt "000000000000000" statt einem richtigen Ergebnis...

Die Geschwindikeit lässt sich zumindest für Sonderfälle leicht erhöhen.
Also mei Multiplikation z.B. noch

Code: [AUSKLAPPEN]
If Wert2$ = "1" Then Return Wert1$


einfügen.
Oder bei Diviosion auf Wert1$ = Wert2$ prüfen (wers nicht weis: da kommt dann immer 1 raus Wink ) etc.

Ansonsten aber sehr genial.

Rallimen

Sieger des 30-EUR-Wettbewerbs

BeitragFr, Apr 08, 2005 20:51
Antworten mit Zitat
Benutzer-Profile anzeigen
Danke frigi !

So, hab das Problem gelöst!

War nur ein kleines Problem mit dem ich nicht gerechnet habe!

und zwar dieses:


Code: [AUSKLAPPEN]
;Beispielcode
Test ("10000000000000000000000000000000")
Test ("100000000000000000000000000000000")
WaitKey

Function Test (A$)
    If a$ Then ; <<<<<< ab 33 Zeichen gehts nicht mehr!!!
        Print "Die geht!    " +a$
        Print Len (A$)
    Else
        Print "die nicht!   " +a$
        Print Len (A$)
    End If
End Function

wer konnte das ahnen!
Habe den Code abgeändert!
  • Zuletzt bearbeitet von Rallimen am Fr, Dez 08, 2006 22:29, insgesamt einmal bearbeitet

frigi

BeitragSa, Apr 09, 2005 12:42
Antworten mit Zitat
Benutzer-Profile anzeigen
ok, danke.

Rallimen

Sieger des 30-EUR-Wettbewerbs

BeitragSa, Sep 17, 2005 15:23
Antworten mit Zitat
Benutzer-Profile anzeigen
Hier sind die Functionen die auch mit Kommas klar kommen!
Code: [AUSKLAPPEN]

Function Subtrahieren$ (Wert1$,Wert2$)
    If Len (wert1$) > Len (wert2$) Then
        wert2$ = RSet (wert2$,Len (wert1$) )
     Else
        wert1$ = RSet (wert1$,Len (wert2$) )
    End If
   
    While Len (wert1$) > 8
        zw = (Int (Right (wert1$,8) ) - Int (Right (wert2$,8) ) - c%)
        wert1$ = Left (wert1$ , Len (wert1$) - 8)
        wert2$ = Left (wert2$ , Len (wert2$) - 8)
        If zw < 0 Then
            zw = 100000000 + zw
            c% = 1
         Else
            c% = 0
        End If
        If Len (Str (zw) ) < 8 Then
            zwS$ = Replace (RSet (zw,8) ," ","0")
            returnWert$ = Right (zwS$,8) + returnWert$
         Else
            returnWert$ = zw + returnWert$
        End If
    Wend
    zw = (Int (Right (wert1$,8) ) - Int (Right (wert2$,8) ) - c%)
    returnWert$ = zw + returnWert$
   
    While Left (returnWert$,1) = "0"
        returnWert$ = Mid (returnWert$,2)
    Wend
    Return returnWert$
End Function

Function Multiplizieren$ (Wert1$,Wert2$)
   
    For i = 1 To Len (wert1$)
        Multipli% = Mid (wert1$,i ,1)
        dummy2$ = Wert2$
       
        While Len (dummy2$) > 7
            Akwert = Right (dummy2$,7)
            dummy2$ = Left (wert2$,Len (dummy2$) - 7)
            erg = Multipli% * Akwert + rest%
            If erg > 9999999 Then
                rest% = Left (erg ,1)
                erg = Right (erg ,7)
             Else
                rest = 0
            End If
            If Len (Str (erg) ) < 7 Then
                ZwWert$ = Replace (RSet (erg,7) ," ","0") + ZwWert$
             Else
                ZwWert$ = Replace (RSet (erg,7) ," ","0") + ZwWert$
            End If
        Wend
       
        ;###############
        rest% = Multipli% * Int (dummy2$) + rest%
        ZwWert$ = rest% + ZwWert$
        rest = 0
        If Len(dummy$) Then
            dummy$ = Addieren$ (ZwWert$ ,Dummy$ + "0")
         Else
            dummy$ = ZwWert$
        End If
        ZwWert$ = ""
    Next
   
    Return dummy$
End Function

Function Addieren$ (Wert1$,Wert2$)
    If Len (wert1$) > Len (wert2$) Then
        wert2$ = RSet (wert2$,Len (wert1$) )
     Else
        wert1$ = RSet (wert1$,Len (wert2$) )
    End If
    While Len (wert1$) > 8
        zw$ = (Int (Right (wert1$,8) ) + Int (Right (wert2$,8) ) + c%)
        If Len (zw) < 9 Then zw = Replace (RSet (zw,8) ," ","0")
        If Len (zw$) > 8 Then
            c% = 1
            zw$ = Mid (zw$,2)
         Else
            c% = 0
        End If
        returnWert$ = Right (zw$,8) + returnWert$
        wert1$ = Left (wert1$ , Len (wert1$) - 8)
        wert2$ = Left (wert2$ , Len (wert2$) - 8)
    Wend
   
    Return (Int (wert1$) + Int (wert2$) + c) + returnWert$
End Function

Function Dividieren_Komma$ (Wert1$,Wert2$,Nachkomma% = 50)

    If Instr(Wert1$,".") Or Instr(Wert2$,".")
        If Instr(Wert1$,".") Then
            w1_VorKomma$ = Left (Wert1$,Instr(Wert1$,".")-1)
            W1_Rest$= Mid (Wert1$,Instr(Wert1$,".")+1)
          Else
            w1_VorKomma$ = Wert1$
        End If
        If Instr(Wert2$,".")
            w2_VorKomma$ = Left (Wert2$,Instr(Wert2$,".")-1)
            W2_Rest$= Mid (Wert2$,Instr(Wert2$,".")+1)
            Else
            w2_VorKomma$ = Wert2$
        End If
        If Len(W1_Rest$) < Len(W2_Rest$)
           W1_Rest$= LSet (W1_Rest$,Len(W2_Rest$))
           W1_Rest$= Replace (W1_Rest$," ","0")
        Else
            W2_Rest$= LSet(W2_Rest$,Len(W1_Rest$))
            W2_Rest$= Replace (W2_Rest$," ","0")
        End If
        Wert1$ = w1_VorKomma$  + W1_Rest$
        Wert2$ = w2_VorKomma$  + W2_Rest$
    End If

    While Nachkomma%
        If Len(Wert1) = 0 Then
            If Kommagesetzt Then
                ReWert$ = ReWert +"0"
                Nachkomma%=Nachkomma%-1
            Else
                Kommagesetzt = 1
                ergebnis$ = ergebnis$ +"."
                ReWert$ = ReWert +"0"
                If Len(Replace (ReWert$,"0","")) = 0 Then Exit
            End If
        Else
            ReWert$ = ReWert + Mid (wert1,1,1)
            wert1 = Mid (wert1,2)
        End If
       
        For i = 0 To 10
            If Dividieren_Vergleichen (ReWert$,wert2$) = 2 Then
                ergebnis$ = ergebnis$ + i
                Exit
             Else
                ZwWert$ = Subtrahieren$ (ReWert$,wert2)
                ReWert$ = ZwWert$
            End If
        Next
    Wend 
   
    While Left (ergebnis$,1) = "0"
        ergebnis$ = Mid (ergebnis$,2)
    Wend
    If Left (ergebnis$,1) = "." Then ergebnis$="0"+ergebnis$
    If Right(ergebnis$,1) = "." Then ergebnis$= Left (ergebnis$,Len(ergebnis$)-1)
    If Len (ergebnis$) = 0 Then ergebnis$ = "0"
    Return ergebnis$
End Function
Function Dividieren$ (Wert1$,Wert2$)
    While Len (wert1)
        ReWert$ = ReWert + Mid (wert1,1,1)
        wert1 = Mid (wert1,2)
        For i = 0 To 10
            If Dividieren_Vergleichen (ReWert$,wert2$) = 2 Then
                ergebnis$ = ergebnis$ + i
                Exit
             Else
                ZwWert$ = Subtrahieren$ (ReWert$,wert2)
                ReWert$ = ZwWert$
            End If
        Next
    Wend
    While Left (ergebnis$,1) = "0"
        ergebnis$ = Mid (ergebnis$,2)
    Wend
    If Len (ergebnis$) = 0 Then ergebnis$ = "0"
    Return ergebnis$
End Function
Function Dividieren_Vergleichen(wert1$,wert2$)
    If Left (wert1$,1) = "0" Then
        While Left (wert1$,1) = "0" : wert1$ = Mid (wert1$,2) : Wend
        If Len (wert1$) = 0 Then wert1$ = "0"
    End If
    If Left (wert2$,1) = "0" Then
        While Left (wert2,1) = "0" : wert2 = Mid (wert2,2) : Wend
        If Len (wert2) = 0 Then wert2 = "0"
    End If
    a1 = Len (wert1$)
    a2 = Len (wert2$)
    If a1 > a2 Then Return 1
    If a1 < a2 Then Return 2
    If wert1$ > wert2$ Then Return 1 ; wert1  ist größer
    If wert1$ < wert2 $ Then Return 2 ; wert1  ist kleiner
    Return 0
End Function

Function Square_Root$ (Wert1$)
    If Len (Wert1$) Mod 2 Then Wert1$ = " " + Wert1$
    While Len (wert1)
        VonOb$ = Left (wert1,2)
        wert1 = Mid (wert1,3)
        If Abzieh$ = "" Then
            Abzieh$ = "1"
         Else
            Abzieh$ = Addieren$ (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 Dividieren_Vergleichen (ReWert$,Abzieh$) <> 2 Then
                ReWert$ = Subtrahieren$ (ReWert$,Abzieh$)
                Abzieh = Addieren$ (Abzieh,2)
             Else
                erg = erg + T
                Exit
            End If
        Next
    Wend
    Return erg
End Function

Function Square_Root_KOMMA$ (Wert1$,Nachkomma% = 50)
    Nachkomma% = Nachkomma% - 1
    If Left (Wert1$,1)="."Then Wert1$ = "0"+wert1
    If Instr(Wert1$,".") = 0 Then Wert1$=Wert1$+"."
    ;Vorm Komma und nach Komma Stellen durch 2 teilbar
    Dummy1$ = Left (Wert1$,Instr (Wert1$,".") - 1)
    If Len (Dummy1$) Mod 2 Then Dummy1$ = "0" + Dummy1$
    Dummy2$ = Mid (Wert1$,Instr (Wert1$,".") + 1)
    If Len (Dummy2$) Mod 2 Then Dummy2$ = Dummy2$ + "0"
    Wert1$ = Dummy1$ + "." + Dummy2$
   
    Repeat
        .Start
        If Len (Wert1) Then
            VonOb$ = Left (wert1,2)
         Else
            VonOb$ = "00"
        End If
        If Instr (VonOb$,".") Then
            Komma = Len (erg$)
            wert1 = Mid (wert1,2)
            Goto Start
        End If
        wert1 = Mid (wert1,3)
        If Abzieh$ = "" Then
            Abzieh$ = "1"
         Else
            Abzieh$ = Addieren$ (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 Dividieren_Vergleichen (ReWert$,Abzieh$) <> 2 Then
                ReWert$ = Subtrahieren$ (ReWert$,Abzieh$)
                Abzieh = Addieren$ (Abzieh,2)
             Else
                erg = erg + T
                Exit
            End If
        Next
        If Len (erg) - Komma > Nachkomma% Then Exit
    Forever
    If komma Then
        returnwert$ = Left (Erg$,Komma) + "." + Mid (Erg$,Komma + 1)
        Return returnwert$
     Else
        Return erg
    End If
End Function

Function Addieren_Komma$ (Wert1$,Wert2$)
    If Instr(Wert1$,".") Or Instr(Wert2$,".")
        KommaZahl=1
        If Instr(Wert1$,".") Then
            w1_VorKomma$ = Left (Wert1$,Instr(Wert1$,".")-1)
            W1_Rest$= Mid (Wert1$,Instr(Wert1$,".")+1)
            Else
            w1_VorKomma$ = Wert1$
        End If
        If Instr(Wert2$,".")
            w2_VorKomma$ = Left (Wert2$,Instr(Wert2$,".")-1)
            W2_Rest$= Mid (Wert2$,Instr(Wert2$,".")+1)
            Else
            w2_VorKomma$ = Wert2$
        End If
        If Len(W1_Rest$) < Len(W2_Rest$)
           W1_Rest$= LSet (W1_Rest$,Len(W2_Rest$))
           W1_Rest$= Replace (W1_Rest$," ","0")
        Else
            W2_Rest$= LSet(W2_Rest$,Len(W1_Rest$))
            W2_Rest$= Replace (W2_Rest$," ","0")
        End If
        KommaStelle = Len(W2_Rest$)
        Wert1$ = w1_VorKomma$  + W1_Rest$
        Wert2$ = w2_VorKomma$  + W2_Rest$
    End If
   
    If Len (wert1$) > Len (wert2$) Then
        wert2$ = RSet (wert2$,Len (wert1$) )
     Else
        wert1$ = RSet (wert1$,Len (wert2$) )
    End If
    While Len (wert1$) > 8
        zw$ = (Int (Right (wert1$,8) ) + Int (Right (wert2$,8) ) + c%)
        If Len (zw) < 9 Then zw = Replace (RSet (zw,8) ," ","0")
        If Len (zw$) > 8 Then
            c% = 1
            zw$ = Mid (zw$,2)
         Else
            c% = 0
        End If
       
        returnWert$ = Right (zw$,8) + returnWert$
        wert1$ = Left (wert1$ , Len (wert1$) - 8)
        wert2$ = Left (wert2$ , Len (wert2$) - 8)
    Wend
    If KommaZahl=1
        ZWSumme$=(Int (wert1$) + Int (wert2$) + c) + returnWert$
        If Len (ZWSumme$) < KommaStelle Then
            ZWSumme$="0."+Replace (RSet (ZWSumme$,kommastelle)," ","0")
        Else
            ZWSumme$= Left (ZWSumme$, Len(ZWSumme$)-KommaStelle) + "." + Right(ZWSumme$, KommaStelle)
        End If
        While Right(ZWSumme$,1)=0
            ZWSumme$=Left(ZWSumme$,Len(ZWSumme$)-1)
        Wend
        If Right(ZWSumme$,1)="." Then ZWSumme$=Left(ZWSumme$,Len(ZWSumme$)-1)
        Return ZWSumme$
    Else
        Return (Int (wert1$) + Int (wert2$) + c) + returnWert$
    End If
End Function

Function Subtrahieren_Komma$ (Wert1$,Wert2$)

    If Instr(Wert1$,".") Or Instr(Wert2$,".")
        KommaZahl=1
        If Instr(Wert1$,".") Then
            w1_VorKomma$ = Left (Wert1$,Instr(Wert1$,".")-1)
            W1_Rest$= Mid (Wert1$,Instr(Wert1$,".")+1)
            Else
            w1_VorKomma$ = Wert1$
        End If
        If Instr(Wert2$,".")
            w2_VorKomma$ = Left (Wert2$,Instr(Wert2$,".")-1)
            W2_Rest$= Mid (Wert2$,Instr(Wert2$,".")+1)
            Else
            w2_VorKomma$ = Wert2$
        End If
        If Len(W1_Rest$) < Len(W2_Rest$)
           W1_Rest$= LSet (W1_Rest$,Len(W2_Rest$))
           W1_Rest$= Replace (W1_Rest$," ","0")
        Else
            W2_Rest$= LSet(W2_Rest$,Len(W1_Rest$))
            W2_Rest$= Replace (W2_Rest$," ","0")
        End If
        KommaStelle = Len(W2_Rest$)
        Wert1$ = w1_VorKomma$  + W1_Rest$
        Wert2$ = w2_VorKomma$  + W2_Rest$
    End If

    If Len (wert1$) > Len (wert2$) Then
        wert2$ = RSet (wert2$,Len (wert1$) )
     Else
        wert1$ = RSet (wert1$,Len (wert2$) )
    End If
    While Len (wert1$) > 8
        zw = (Int (Right (wert1$,8) ) - Int (Right (wert2$,8) ) - c%)
        wert1$ = Left (wert1$ , Len (wert1$) - 8)
        wert2$ = Left (wert2$ , Len (wert2$) - 8)
        If zw < 0 Then
            zw = 100000000 + zw
            c% = 1
         Else
            c% = 0
        End If
        If Len (Str (zw) ) < 8 Then
            zwS$ = Replace (RSet (zw,8) ," ","0")
            returnWert$ = Right (zwS$,8) + returnWert$
         Else
            returnWert$ = zw + returnWert$
        End If
    Wend
    zw = (Int (Right (wert1$,8) ) - Int (Right (wert2$,8) ) - c%)
    returnWert$ = Replace (RSet (zw,8) ," ","0")  + returnWert$

    If KommaZahl=1
        returnWert$= Left (returnWert$, Len(returnWert$)-KommaStelle) + "." + Right(returnWert$, KommaStelle)
        While Right(returnWert$,1)=0
            returnWert$=Left(returnWert$,Len(returnWert$)-1)
        Wend
        If Right(returnWert$,1)="." Then returnWert$=Left(returnWert$,Len(returnWert$)-1)
       
        While Left (returnWert$,1) = "0"
            returnWert$ = Mid (returnWert$,2)
        Wend
        If Left (returnWert$,1) = "." Then  returnWert$="0"+returnWert$
    Else
        While Left (returnWert$,1) = "0"
            returnWert$ = Mid (returnWert$,2)
        Wend
    End If
;
    Return returnWert$
End Function

Function Multiplizieren_Komma$ (Wert1$,Wert2$)

    If Instr(Wert1$,".") Or Instr(Wert2$,".")
        KommaZahl=1
        If Instr(Wert1$,".") Then
            w1_VorKomma$ = Left (Wert1$,Instr(Wert1$,".")-1)
            W1_Rest$= Mid (Wert1$,Instr(Wert1$,".")+1)
            Else
            w1_VorKomma$ = Wert1$
        End If
        If Instr(Wert2$,".")
            w2_VorKomma$ = Left (Wert2$,Instr(Wert2$,".")-1)
            W2_Rest$= Mid (Wert2$,Instr(Wert2$,".")+1)
            Else
            w2_VorKomma$ = Wert2$
        End If
        If Len(W1_Rest$) < Len(W2_Rest$)
           W1_Rest$= LSet (W1_Rest$,Len(W2_Rest$))
           W1_Rest$= Replace (W1_Rest$," ","0")
        Else
            W2_Rest$= LSet(W2_Rest$,Len(W1_Rest$))
            W2_Rest$= Replace (W2_Rest$," ","0")
        End If
        KommaStelle = Len(W2_Rest$)
        Wert1$ = w1_VorKomma$  + W1_Rest$
        Wert2$ = w2_VorKomma$  + W2_Rest$
    End If

    For i = 1 To Len (wert1$)
        Multipli% = Mid (wert1$,i ,1)
        dummy2$ = Wert2$
        While Len (dummy2$) > 7
            Akwert = Right (dummy2$,7)
            dummy2$ = Left (wert2$,Len (dummy2$) - 7)
            erg = Multipli% * Akwert + rest%
            If erg > 9999999 Then
                rest% = Left (erg ,1)
                erg = Right (erg ,7)
             Else
                rest = 0
            End If
            ZwWert$ = Replace (RSet (erg,7) ," ","0") + ZwWert$
        Wend
        ;###############
        rest% = Multipli% * Int (dummy2$) + rest%
        ZwWert$ = rest% + ZwWert$
        rest = 0
        If Len(dummy$) Then
            dummy$ = Addieren$ (ZwWert$ ,Dummy$ + "0")
         Else
            dummy$ = ZwWert$
        End If
        ZwWert$ = ""
    Next
;Einbau der Kommas
    If KommaZahl=1 Then
        If Len(dummy$)< KommaStelle*2 Then
            dummy = "0."+Replace (RSet(dummy,KommaStelle*2)," ","0")
        Else
            dummy$= Left (dummy$, Len(dummy$)-KommaStelle*2) + "." + Right(dummy$, KommaStelle*2)
        End If
        While Right(dummy$,1)=0
            dummy$=Left(dummy$,Len(dummy$)-1)
        Wend
        If Right(dummy$,1)="." Then dummy$=Left(dummy$,Len(dummy$)-1)
    End If
    Return dummy$
End Function


;Integer Versionen
;-Addieren$ (Wert1$,Wert2$)
;-Subtrahieren$ (Wert1$,Wert2$)
;-Multiplizieren$ (Wert1$,Wert2$)
;-Dividieren$ (Wert1$,Wert2$)
;-Square_Root$ (Wert1$)


;Float Versionen
;-Addieren_Komma$ (Wert1$,Wert2$)
;-Subtrahieren_Komma$ (Wert1$,Wert2$)
;-Multiplizieren_Komma$ (Wert1$,Wert2$)
;-Square_Root_Komma$ (Wert1$,Nachkomma% = 50)
;-Dividieren_Komma$ (Wert1$,Wert2$,Nachkomma% = 50)

;wird von einigen der Functionen benötigt
;-Dividieren_Vergleichen(wert1$,wert2$)

;TEST ;TEST ;TEST ;TEST ;TEST ;TEST ;TEST ;TEST ;TEST ;TEST
a$ = "0.0123456789"

Graphics 1200,200,16,2
Print "Startwert"
Print a
Time1 = MilliSecs ()
For t = 0 To 50
    a$ = Addieren_Komma$ (A$ ,"122348966435.546413")
    a$ = Multiplizieren_Komma$ (a$ , 2.45)
Next
Print "Zwischesumme"
Print a
For t = 0 To 50
    a$ = Dividieren_Komma$ (a$ , 2.45 ,120)
    a$ = Subtrahieren_Komma$ (A$ ,"122348966435.546413")
Next
time1 = MilliSecs () - time1
Print a
Print time1 + "  Dauer"
WaitKey


Der miniTest dauert bei mir ca 2.650 Millisekunden
  • Zuletzt bearbeitet von Rallimen am Fr, Dez 08, 2006 22:30, insgesamt einmal bearbeitet
 

Shaggy82

Betreff: problem mit der Subtrahieren_Komma$ function

BeitragFr, Dez 08, 2006 3:07
Antworten mit Zitat
Benutzer-Profile anzeigen
hallo rallimen,

bin hier auf deine string rechenfunktionen gestossen. diese könnten mir bei meinem aktuellen projekt weiterhelfen. bin aber glaube ich auf einen bug gestossen.

führe ich folgenden code aus:
For t = 1 To 50000
a$ = subtrahieren_Komma$ (A$ ,"4.65")
Next

spring a$ bei einem 6 stelligen betrag vom negativen ins positive um.
könntest du mal nachgucken woran es liegt ?

mfg
shaggy
 

#Reaper

Newsposter

BeitragFr, Dez 08, 2006 21:27
Antworten mit Zitat
Benutzer-Profile anzeigen
hey, echt nice Very Happy
könnte man damit nicht auch eine Mod-Funktion machen? Smile
AMD Athlon 64 3500+, ATI AX800 Pro/TD, 2048 MB DRR 400 von Infineon, ♥RIP♥ (2005 - Juli 2015 -> sic!)
Blitz3D, BlitzMax, MaxGUI, Monkey X; Win7

PowerProgrammer

BeitragFr, Dez 08, 2006 21:49
Antworten mit Zitat
Benutzer-Profile anzeigen
Ist jetzt mal was offtopiges: Kannst du nicht die doofen Syntax-Tags rausnehmen, das Teil benötigt ja Stunden zum laden Wink Dankeschön^^
www.xairro.com Alles für Webmaster und Programmierer! Es gibt mehr als bloß einen Counter!

Rallimen

Sieger des 30-EUR-Wettbewerbs

BeitragFr, Dez 08, 2006 22:58
Antworten mit Zitat
Benutzer-Profile anzeigen
Zitat:
Kannst du nicht die doofen Syntax-Tags rausnehmen

gerade geschehen

Zitat:
bin aber glaube ich auf einen bug gestossen.


Nein, kein Bug!
Zitat:
Sicherheitsabfragen in Bezug auf Negativen Zahlen sind hierbei nicht berücksichtigt und werden nicht abgefangen


Die Functionen für negative Zahlen sind auf meiner Festplatte, werd sie bei gelegenheit raussuchen und posten!
[BB2D | BB3D | BB+]
 

Shaggy82

BeitragSa, Dez 16, 2006 19:15
Antworten mit Zitat
Benutzer-Profile anzeigen
hi Rallimen, hast du die funktionen schon auf deiner festpallte gefunden ?

mfg shaggy82

Rallimen

Sieger des 30-EUR-Wettbewerbs

BeitragSa, Dez 16, 2006 20:18
Antworten mit Zitat
Benutzer-Profile anzeigen
Bis jetzt noch nicht, sind wohl noch auf meiner alten HDD
Leider ist diese defekt!
Werd aber diese Funktionen erweitern, sobald ich zeit habe!!
[BB2D | BB3D | BB+]
 

Shaggy82

BeitragSa, Dez 16, 2006 22:29
Antworten mit Zitat
Benutzer-Profile anzeigen
schade das mit deiner platte. aber danke schonmal für deine hilfe. meinste das das dieses jahr noch fertig wird ?

mfg shaggy82

BladeRunner

Moderator

BeitragSa, Dez 16, 2006 22:53
Antworten mit Zitat
Benutzer-Profile anzeigen
Wenn es Dir so eilig ist, Shaggie, wie wäre es dann wenn Du das graue Zeug in deinem Schädel benutzt und den Code selbst verbesserst/ erweiterst ?
Du hast eine fantastische Basis zur Verfügung. Lern sie verstehen und machs selbst besser. Wird Dir auch einiges an Erfahrung bringen.
Zu Diensten, Bürger.
Intel T2300, 2.5GB DDR 533, Mobility Radeon X1600 Win XP Home SP3
Intel T8400, 4GB DDR3, Nvidia GF9700M GTS Win 7/64
B3D BMax MaxGUI

Stolzer Gewinner des BAC#48, #52 & #92

Rallimen

Sieger des 30-EUR-Wettbewerbs

BeitragMo, Dez 18, 2006 1:08
Antworten mit Zitat
Benutzer-Profile anzeigen
Hallo, hier sind die fertigen Functionen komplett!
Negative Zahlen werden jetzt berücksichtigt!Code: [AUSKLAPPEN]

Function Subtrahieren$ (Wert1$,Wert2$)
    If Left (Wert1$ ,1) = "-" Then wert1$ = Mid (wert1$,2) : w1% = 1
    If Left (Wert2$ ,1) = "-" Then wert2$ = Mid (wert2$,2) : w2% = 1
   
    If (w1% + w2%) Then
       
        If W1% Then
           
            If W2% Then
               
                Select Dividieren_Vergleichen (wert1$,wert2$)
                   
                 Case 0 Return "0"
                   
                 Case 1 Return "-" + Subtrahieren$ (Wert1$,Wert2$)
                   
                 Case 2 Return Subtrahieren$ (Wert2$,Wert1$)
                End Select
               
             Else
                Return "-" + Addieren$ (Wert1$,Wert2$)
            End If
           
         Else
           
            If w2 Then Addieren$ (Wert1$,Wert2$)
           
        End If
       
    End If
   
    Select Dividieren_Vergleichen (wert1$,wert2$)
       
     Case 0 Return 0
       
     Case 2 Return "-" + Subtrahieren$ (Wert2$,Wert1$)
    End Select
   
    If Len (wert1$) > Len (wert2$) Then
        wert2$ = RSet (wert2$,Len (wert1$) )
     Else
        wert1$ = RSet (wert1$,Len (wert2$) )
    End If
   
    While Len (wert1$) > 8
        zw = (Int (Right (wert1$,8) ) - Int (Right (wert2$,8) ) - c%)
        wert1$ = Left (wert1$ , Len (wert1$) - 8)
        wert2$ = Left (wert2$ , Len (wert2$) - 8)
       
        If zw < 0 Then
            zw = 100000000 + zw
            c% = 1
         Else
            c% = 0
        End If
       
        If Len (Str (zw) ) < 8 Then
            zwS$ = Replace (RSet (zw,8) ," ","0")
            returnWert$ = Right (zwS$,8) + returnWert$
         Else
            returnWert$ = zw + returnWert$
        End If
       
    Wend
   
    zw = (Int (Right (wert1$,8) ) - Int (Right (wert2$,8) ) - c%)
    returnWert$ = zw + returnWert$
   
    While Left (returnWert$,1) = "0"
        returnWert$ = Mid (returnWert$,2)
    Wend
   
    Return returnWert$
End Function

Function Addieren$ (Wert1$,Wert2$)
    If Left (Wert1$ ,1) = "-" Then wert1$ = Mid (wert1$,2) : w1% = 1
    If Left (Wert2$ ,1) = "-" Then wert2$ = Mid (wert2$,2) : w2% = 1
   
    If (w1% + w2%) Then
       
        If w1% Then
           
            If w2% Then
                Return "-" + Addieren$ (Wert1$,Wert2$)
             Else
               
                Select Dividieren_Vergleichen (wert1$,wert2$)
                   
                 Case 0 Return "0"
                   
                 Case 1 Return "-" + Subtrahieren$ (Wert1$,Wert2$)
                   
                 Case 2 Return Subtrahieren$ (Wert2$,Wert1$)
                End Select
               
            End If
           
         Else
           
            Select Dividieren_Vergleichen (wert1$,wert2$)
               
             Case 0 Return "0"
               
             Case 1 Return Subtrahieren$ (Wert1$,Wert2$)
               
             Case 2 Return "-" + Subtrahieren$ (Wert2$,Wert1$)
            End Select
           
        End If
       
    End If
   
    If Len (wert1$) > Len (wert2$) Then
        wert2$ = RSet (wert2$,Len (wert1$) )
     Else
        wert1$ = RSet (wert1$,Len (wert2$) )
    End If
   
    While Len (wert1$) > 8
        zw$ = (Int (Right (wert1$,8) ) + Int (Right (wert2$,8) ) + c%)
        If Len (zw) < 9 Then zw = Replace (RSet (zw,8) ," ","0")
       
        If Len (zw$) > 8 Then
            c% = 1
            zw$ = Mid (zw$,2)
         Else
            c% = 0
        End If
       
        returnWert$ = Right (zw$,8) + returnWert$
        wert1$ = Left (wert1$ , Len (wert1$) - 8)
        wert2$ = Left (wert2$ , Len (wert2$) - 8)
    Wend
   
    Return (Int (wert1$) + Int (wert2$) + c) + returnWert$
End Function

Function Addieren_Komma$ (Wert1$,Wert2$)
   
    If Left (Wert1$ ,1) = "-" Then wert1$ = Mid (wert1$,2) : w1% = 1
    If Left (Wert2$ ,1) = "-" Then wert2$ = Mid (wert2$,2) : w2% = 1
   
    If (w1% + w2%) Then
       
        If w1% Then
           
            If w2% Then
                Return "-" + Addieren_Komma$ (Wert1$,Wert2$)
             Else
               
                Select WertVergleichenKomma% (Wert1$,Wert2$)
                   
                 Case 0 Return "0"
                   
                 Case 1 Return "-" + Subtrahieren_Komma$ (Wert1$,Wert2$)
                   
                 Case 2 Return Subtrahieren_Komma$ (Wert2$,Wert1$)
                End Select
               
            End If
           
         Else
           
            Select WertVergleichenKomma% (Wert1$,Wert2$)
               
             Case 0 Return "0"
               
             Case 1 Return Subtrahieren_Komma$ (Wert1$,Wert2$)
               
             Case 2 Return "-" + Subtrahieren_Komma$ (Wert2$,Wert1$)
            End Select
           
        End If
       
    End If
   
    If Instr (Wert1$,".") Or Instr (Wert2$,".") Then
        KommaZahl = 1
       
        If Instr (Wert1$,".") Then
            w1_VorKomma$ = Left (Wert1$,Instr (Wert1$,".") - 1)
            W1_Rest$ = Mid (Wert1$,Instr (Wert1$,".") + 1)
         Else
            w1_VorKomma$ = Wert1$
        End If
       
        If Instr (Wert2$,".") Then
            w2_VorKomma$ = Left (Wert2$,Instr (Wert2$,".") - 1)
            W2_Rest$ = Mid (Wert2$,Instr (Wert2$,".") + 1)
         Else
            w2_VorKomma$ = Wert2$
        End If
       
        If Len (W1_Rest$) < Len (W2_Rest$) Then
            W1_Rest$ = LSet (W1_Rest$,Len (W2_Rest$) )
            W1_Rest$ = Replace (W1_Rest$," ","0")
         Else
            W2_Rest$ = LSet (W2_Rest$,Len (W1_Rest$) )
            W2_Rest$ = Replace (W2_Rest$," ","0")
        End If
       
        KommaStelle = Len (W2_Rest$)
        Wert1$ = w1_VorKomma$ + W1_Rest$
        Wert2$ = w2_VorKomma$ + W2_Rest$
    End If
   
    If Len (wert1$) > Len (wert2$) Then
        wert2$ = RSet (wert2$,Len (wert1$) )
     Else
        wert1$ = RSet (wert1$,Len (wert2$) )
    End If
   
    While Len (wert1$) > 8
        zw$ = (Int (Right (wert1$,8) ) + Int (Right (wert2$,8) ) + c%)
        If Len (zw) < 9 Then zw = Replace (RSet (zw,8) ," ","0")
       
        If Len (zw$) > 8 Then
            c% = 1
            zw$ = Mid (zw$,2)
         Else
            c% = 0
        End If
       
        returnWert$ = Right (zw$,8) + returnWert$
        wert1$ = Left (wert1$ , Len (wert1$) - 8)
        wert2$ = Left (wert2$ , Len (wert2$) - 8)
    Wend
   
    If KommaZahl = 1 Then
        ZWSumme$ = (Int (wert1$) + Int (wert2$) + c) + returnWert$
       
        If Len (ZWSumme$) < KommaStelle Then
            ZWSumme$ = "0." + Replace (RSet (ZWSumme$,kommastelle) ," ","0")
         Else
            ZWSumme$ = Left (ZWSumme$, Len (ZWSumme$) - KommaStelle) + "." + Right (ZWSumme$, KommaStelle)
        End If
       
        While Right (ZWSumme$,1) = 0
            ZWSumme$ = Left (ZWSumme$,Len (ZWSumme$) - 1)
        Wend
       
        If Right (ZWSumme$,1) = "." Then ZWSumme$ = Left (ZWSumme$,Len (ZWSumme$) - 1)
        Return ZWSumme$
     Else
        Return (Int (wert1$) + Int (wert2$) + c) + returnWert$
    End If
   
End Function

Function Subtrahieren_Komma$ (Wert1$,Wert2$)
   
    If Left (Wert1$ ,1) = "-" Then wert1$ = Mid (wert1$,2) : w1% = 1
    If Left (Wert2$ ,1) = "-" Then wert2$ = Mid (wert2$,2) : w2% = 1
   
    If (w1% + w2%) Then
       
        If W1% Then
           
            If W2% Then
               
                Select WertVergleichenKomma% (Wert1$,Wert2$)
                   
                 Case 0 Return "0"
                   
                 Case 1 Return "-" + Subtrahieren_Komma$ (Wert1$,Wert2$)
                   
                 Case 2 Return Subtrahieren_Komma$ (Wert2$,Wert1$)
                End Select
               
             Else
                Return "-" + Addieren_Komma$ (Wert1$,Wert2$)
            End If
           
         Else
           
            If w2 Then Return Addieren_Komma$ (Wert1$,Wert2$)
           
        End If
       
    End If
   
    Select WertVergleichenKomma% (Wert1$,Wert2$)
       
     Case 0 Return 0
       
     Case 2 Return "-" + Subtrahieren_Komma$ (Wert2$,Wert1$)
    End Select
   
    If Instr (Wert1$,".") Or Instr (Wert2$,".") Then
        KommaZahl = 1
       
        If Instr (Wert1$,".") Then
            w1_VorKomma$ = Left (Wert1$,Instr (Wert1$,".") - 1)
            W1_Rest$ = Mid (Wert1$,Instr (Wert1$,".") + 1)
         Else
            w1_VorKomma$ = Wert1$
        End If
       
        If Instr (Wert2$,".") Then
            w2_VorKomma$ = Left (Wert2$,Instr (Wert2$,".") - 1)
            W2_Rest$ = Mid (Wert2$,Instr (Wert2$,".") + 1)
         Else
            w2_VorKomma$ = Wert2$
        End If
       
        If Len (W1_Rest$) < Len (W2_Rest$) Then
            W1_Rest$ = LSet (W1_Rest$,Len (W2_Rest$) )
            W1_Rest$ = Replace (W1_Rest$," ","0")
         Else
            W2_Rest$ = LSet (W2_Rest$,Len (W1_Rest$) )
            W2_Rest$ = Replace (W2_Rest$," ","0")
        End If
       
        KommaStelle = Len (W2_Rest$)
        Wert1$ = w1_VorKomma$ + W1_Rest$
        Wert2$ = w2_VorKomma$ + W2_Rest$
    End If
   
    If Len (wert1$) > Len (wert2$) Then
        wert2$ = RSet (wert2$,Len (wert1$) )
     Else
        wert1$ = RSet (wert1$,Len (wert2$) )
    End If
   
    While Len (wert1$) > 8
        zw = (Int (Right (wert1$,8) ) - Int (Right (wert2$,8) ) - c%)
        wert1$ = Left (wert1$ , Len (wert1$) - 8)
        wert2$ = Left (wert2$ , Len (wert2$) - 8)
       
        If zw < 0 Then
            zw = 100000000 + zw
            c% = 1
         Else
            c% = 0
        End If
       
        If Len (Str (zw) ) < 8 Then
            zwS$ = Replace (RSet (zw,8) ," ","0")
            returnWert$ = Right (zwS$,8) + returnWert$
         Else
            returnWert$ = zw + returnWert$
        End If
       
    Wend
   
    zw = (Int (Right (wert1$,8) ) - Int (Right (wert2$,8) ) - c%)
    returnWert$ = Replace (RSet (zw,8) ," ","0") + returnWert$
   
    If KommaZahl = 1 Then
        returnWert$ = Left (returnWert$, Len (returnWert$) - KommaStelle) + "." + Right (returnWert$, KommaStelle)
       
        While Right (returnWert$,1) = 0
            returnWert$ = Left (returnWert$,Len (returnWert$) - 1)
        Wend
       
        If Right (returnWert$,1) = "." Then returnWert$ = Left (returnWert$,Len (returnWert$) - 1)
       
        While Left (returnWert$,1) = "0"
            returnWert$ = Mid (returnWert$,2)
        Wend
       
        If Left (returnWert$,1) = "." Then returnWert$ = "0" + returnWert$
     Else
       
        While Left (returnWert$,1) = "0"
            returnWert$ = Mid (returnWert$,2)
        Wend
       
    End If
   
    Return returnWert$
End Function

Function Dividieren_Komma$ (Wert1$,Wert2$,Nachkomma% = 50)
    If Left (Wert1$ ,1) = "-" Then wert1$ = Mid (wert1$,2) : w1% = 1
    If Left (Wert2$ ,1) = "-" Then wert2$ = Mid (wert2$,2) : w2% = 1
    If w1 + w2 = 1 Then Vorzeichen$ = "-"
   
    If Instr (Wert1$,".") Or Instr (Wert2$,".") Then
       
        If Instr (Wert1$,".") Then
            w1_VorKomma$ = Left (Wert1$,Instr (Wert1$,".") - 1)
            W1_Rest$ = Mid (Wert1$,Instr (Wert1$,".") + 1)
         Else
            w1_VorKomma$ = Wert1$
        End If
       
        If Instr (Wert2$,".") Then
            w2_VorKomma$ = Left (Wert2$,Instr (Wert2$,".") - 1)
            W2_Rest$ = Mid (Wert2$,Instr (Wert2$,".") + 1)
         Else
            w2_VorKomma$ = Wert2$
        End If
       
        If Len (W1_Rest$) < Len (W2_Rest$) Then
            W1_Rest$ = LSet (W1_Rest$,Len (W2_Rest$) )
            W1_Rest$ = Replace (W1_Rest$," ","0")
         Else
            W2_Rest$ = LSet (W2_Rest$,Len (W1_Rest$) )
            W2_Rest$ = Replace (W2_Rest$," ","0")
        End If
       
        Wert1$ = w1_VorKomma$ + W1_Rest$
        Wert2$ = w2_VorKomma$ + W2_Rest$
    End If
   
    While Nachkomma%
       
        If Len (Wert1) = 0 Then
           
            If Kommagesetzt Then
                ReWert$ = ReWert + "0"
                Nachkomma% = Nachkomma% - 1
             Else
                Kommagesetzt = 1
                ergebnis$ = ergebnis$ + "."
                ReWert$ = ReWert + "0"
                If Len (Replace (ReWert$,"0","") ) = 0 Then Exit
            End If
           
         Else
            ReWert$ = ReWert + Mid (wert1,1,1)
            wert1 = Mid (wert1,2)
        End If
       
        For i = 0 To 10
           
            If Dividieren_Vergleichen (ReWert$,wert2$) = 2 Then
                ergebnis$ = ergebnis$ + i
                Exit
             Else
                ZwWert$ = Subtrahieren$ (ReWert$,wert2)
                ReWert$ = ZwWert$
            End If
           
        Next
       
    Wend
   
    While Left (ergebnis$,1) = "0"
        ergebnis$ = Mid (ergebnis$,2)
    Wend
   
    If Left (ergebnis$,1) = "." Then ergebnis$ = "0" + ergebnis$
    If Right (ergebnis$,1) = "." Then ergebnis$ = Left (ergebnis$,Len (ergebnis$) - 1)
    If Len (ergebnis$) = 0 Then ergebnis$ = "0"
    Return Vorzeichen$ + ergebnis$
End Function

Function Dividieren$ (Wert1$,Wert2$)
    If Left (Wert1$ ,1) = "-" Then wert1$ = Mid (wert1$,2) : w1% = 1
    If Left (Wert2$ ,1) = "-" Then wert2$ = Mid (wert2$,2) : w2% = 1
    If w1 + w2 = 1 Then Vorzeichen$ = "-"
   
    While Len (wert1)
        ReWert$ = ReWert + Mid (wert1,1,1)
        wert1 = Mid (wert1,2)
       
        For i = 0 To 10
           
            If Dividieren_Vergleichen (ReWert$,wert2$) = 2 Then
                ergebnis$ = ergebnis$ + i
                Exit
             Else
                ZwWert$ = Subtrahieren$ (ReWert$,wert2)
                ReWert$ = ZwWert$
            End If
           
        Next
       
    Wend
   
    While Left (ergebnis$,1) = "0"
        ergebnis$ = Mid (ergebnis$,2)
    Wend
   
    If Len (ergebnis$) = 0 Then ergebnis$ = "0"
    Return Vorzeichen$ + ergebnis$
End Function

Function Dividieren_Vergleichen (wert1$,wert2$)
   
    If Left (wert1$,1) = "0" Then
        While Left (wert1$,1) = "0" : wert1$ = Mid (wert1$,2) : Wend
        If Len (wert1$) = 0 Then wert1$ = "0"
    End If
   
    If Left (wert2$,1) = "0" Then
        While Left (wert2,1) = "0" : wert2 = Mid (wert2,2) : Wend
        If Len (wert2) = 0 Then wert2 = "0"
    End If
   
    a1 = Len (wert1$)
    a2 = Len (wert2$)
    If a1 > a2 Then Return 1
    If a1 < a2 Then Return 2
    If wert1$ > wert2$ Then Return 1
    If wert1$ < wert2$ Then Return 2
    Return 0
End Function

Function Multiplizieren$ (Wert1$,Wert2$)
    If Left (Wert1$ ,1) = "-" Then wert1$ = Mid (wert1$,2) : w1% = 1
    If Left (Wert2$ ,1) = "-" Then wert2$ = Mid (wert2$,2) : w2% = 1
    If w1 + w2 = 1 Then Vorzeichen$ = "-"
   
    For i = 1 To Len (wert1$)
        Multipli% = Mid (wert1$,i ,1)
        dummy2$ = Wert2$
       
        While Len (dummy2$) > 7
            Akwert = Right (dummy2$,7)
            dummy2$ = Left (wert2$,Len (dummy2$) - 7)
            erg = Multipli% * Akwert + rest%
           
            If erg > 9999999 Then
                rest% = Left (erg ,1)
                erg = Right (erg ,7)
             Else
                rest = 0
            End If
           
            If Len (Str (erg) ) < 7 Then
                ZwWert$ = Replace (RSet (erg,7) ," ","0") + ZwWert$
             Else
                ZwWert$ = Replace (RSet (erg,7) ," ","0") + ZwWert$
            End If
           
        Wend
       
        rest% = Multipli% * Int (dummy2$) + rest%
        ZwWert$ = rest% + ZwWert$
        rest = 0
       
        If Len (dummy$) Then
            dummy$ = Addieren$ (ZwWert$ ,Dummy$ + "0")
         Else
            dummy$ = ZwWert$
        End If
       
        ZwWert$ = ""
    Next
   
    Return Vorzeichen$ + dummy$
End Function

Function Multiplizieren_Komma$ (Wert1$,Wert2$)
    If Left (Wert1$ ,1) = "-" Then wert1$ = Mid (wert1$,2) : w1% = 1
    If Left (Wert2$ ,1) = "-" Then wert2$ = Mid (wert2$,2) : w2% = 1
    If w1 + w2 = 1 Then Vorzeichen$ = "-"
   
    If Instr (Wert1$,".") Or Instr (Wert2$,".") Then
        KommaZahl = 1
       
        If Instr (Wert1$,".") Then
            w1_VorKomma$ = Left (Wert1$,Instr (Wert1$,".") - 1)
            W1_Rest$ = Mid (Wert1$,Instr (Wert1$,".") + 1)
         Else
            w1_VorKomma$ = Wert1$
        End If
       
        If Instr (Wert2$,".") Then
            w2_VorKomma$ = Left (Wert2$,Instr (Wert2$,".") - 1)
            W2_Rest$ = Mid (Wert2$,Instr (Wert2$,".") + 1)
         Else
            w2_VorKomma$ = Wert2$
        End If
       
        If Len (W1_Rest$) < Len (W2_Rest$) Then
            W1_Rest$ = LSet (W1_Rest$,Len (W2_Rest$) )
            W1_Rest$ = Replace (W1_Rest$," ","0")
         Else
            W2_Rest$ = LSet (W2_Rest$,Len (W1_Rest$) )
            W2_Rest$ = Replace (W2_Rest$," ","0")
        End If
       
        KommaStelle = Len (W2_Rest$)
        Wert1$ = w1_VorKomma$ + W1_Rest$
        Wert2$ = w2_VorKomma$ + W2_Rest$
    End If
   
    For i = 1 To Len (wert1$)
        Multipli% = Mid (wert1$,i ,1)
        dummy2$ = Wert2$
       
        While Len (dummy2$) > 7
            Akwert = Right (dummy2$,7)
            dummy2$ = Left (wert2$,Len (dummy2$) - 7)
            erg = Multipli% * Akwert + rest%
           
            If erg > 9999999 Then
                rest% = Left (erg ,1)
                erg = Right (erg ,7)
             Else
                rest = 0
            End If
           
            ZwWert$ = Replace (RSet (erg,7) ," ","0") + ZwWert$
        Wend
       
        rest% = Multipli% * Int (dummy2$) + rest%
        ZwWert$ = rest% + ZwWert$
        rest = 0
       
        If Len (dummy$) Then
            dummy$ = Addieren$ (ZwWert$ ,Dummy$ + "0")
         Else
            dummy$ = ZwWert$
        End If
       
        ZwWert$ = ""
    Next
   
    If KommaZahl = 1 Then
       
        If Len (dummy$) < KommaStelle * 2 Then
            dummy = "0." + Replace (RSet (dummy,KommaStelle * 2) ," ","0")
         Else
            dummy$ = Left (dummy$, Len (dummy$) - KommaStelle * 2) + "." + Right (dummy$, KommaStelle * 2)
        End If
       
        While Right (dummy$,1) = 0
            dummy$ = Left (dummy$,Len (dummy$) - 1)
        Wend
       
        If Right (dummy$,1) = "." Then dummy$ = Left (dummy$,Len (dummy$) - 1)
    End If
   
    Return Vorzeichen$ + dummy$
End Function

Function Square_Root$ (Wert1$)
    If Left (Wert1$ ,1) = "-" Then wert1$ = Mid (wert1$,2)
    If Len (Wert1$) Mod 2 Then Wert1$ = " " + Wert1$
   
    While Len (wert1)
        VonOb$ = Left (wert1,2)
        wert1 = Mid (wert1,3)
       
        If Abzieh$ = "" Then
            Abzieh$ = "1"
         Else
            Abzieh$ = Addieren$ (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 Dividieren_Vergleichen (ReWert$,Abzieh$) <> 2 Then
                ReWert$ = Subtrahieren$ (ReWert$,Abzieh$)
                Abzieh = Addieren$ (Abzieh,2)
             Else
                erg = erg + T
                Exit
            End If
           
        Next
       
    Wend
   
    Return erg
End Function

Function Square_Root_KOMMA$ (Wert1$,Nachkomma% = 50)
    If Left (Wert1$ ,1) = "-" Then wert1$ = Mid (wert1$,2)
    Nachkomma% = Nachkomma% - 1
    If Left (Wert1$,1) = "."Then Wert1$ = "0" + wert1
    If Instr (Wert1$,".") = 0 Then Wert1$ = Wert1$ + "."
    ;Vorm Komma und nach Komma Stellen durch 2 teilbar
    Dummy1$ = Left (Wert1$,Instr (Wert1$,".") - 1)
    If Len (Dummy1$) Mod 2 Then Dummy1$ = "0" + Dummy1$
    Dummy2$ = Mid (Wert1$,Instr (Wert1$,".") + 1)
    If Len (Dummy2$) Mod 2 Then Dummy2$ = Dummy2$ + "0"
    Wert1$ = Dummy1$ + "." + Dummy2$
   
    Repeat
       
        .Start
       
        If Len (Wert1) Then
            VonOb$ = Left (wert1,2)
         Else
            VonOb$ = "00"
        End If
       
        If Instr (VonOb$,".") Then
            Komma = Len (erg$)
            wert1 = Mid (wert1,2)
            Goto Start
        End If
       
        wert1 = Mid (wert1,3)
       
        If Abzieh$ = "" Then
            Abzieh$ = "1"
         Else
            Abzieh$ = Addieren$ (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 Dividieren_Vergleichen (ReWert$,Abzieh$) <> 2 Then
                ReWert$ = Subtrahieren$ (ReWert$,Abzieh$)
                Abzieh = Addieren$ (Abzieh,2)
             Else
                erg = erg + T
                Exit
            End If
           
        Next
       
        If Len (erg) - Komma > Nachkomma% Then Exit
    Forever
   
    If komma Then
        returnwert$ = Left (Erg$,Komma) + "." + Mid (Erg$,Komma + 1)
        Return returnwert$
     Else
        Return erg
    End If
   
End Function

Function WertVergleichenKomma% (Wert1$,Wert2$)
   
    While Left (wert1$,1) = "0"
        Wert1 = Mid (wert1,2)
    Wend
   
    While Left (wert2$,1) = "0"
        Wert2 = Mid (wert2,2)
    Wend
   
    w1% = Instr (wert1$,".")
    w2% = Instr (wert2$,".")

 
      If w1% = 0 Then
         Wert1$ = Wert1$ +"."
         w1% = Instr (wert1$,".")
      End If
      If w2% = 0 Then
         Wert2$ = Wert2$ +"."
         w2% = Instr (wert2$,".")
      End If

   
    If w1 > w2 Then Return 1
    If w1 < w2 Then Return 2
   
    If Wert1$ > Wert2$ Then Return 1
    If Wert1$ < Wert2$ Then Return 2
    Return 0
End Function

;Integer Versionen
;-Addieren$ (Wert1$,Wert2$)
;-Subtrahieren$ (Wert1$,Wert2$)
;-Multiplizieren$ (Wert1$,Wert2$)
;-Dividieren$ (Wert1$,Wert2$)
;-Square_Root$ (Wert1$)

;Float Versionen
;-Addieren_Komma$ (Wert1$,Wert2$)
;-Subtrahieren_Komma$ (Wert1$,Wert2$)
;-Multiplizieren_Komma$ (Wert1$,Wert2$)
;-Square_Root_Komma$ (Wert1$,Nachkomma% = 50)
;-Dividieren_Komma$ (Wert1$,Wert2$,Nachkomma% = 50)

;wird von einigen der Functionen benötigt
;-Dividieren_Vergleichen(wert1$,wert2$)
;-WertVergleichenKomma%(Wert1$,Wert2$) ;nur für Floats
;
;;TEST ;TEST ;TEST ;TEST ;TEST ;TEST ;TEST ;TEST ;TEST ;TEST
a$ = "0.0123456789"

Graphics 1200 ,200,16,2

Print "Startwert"
Print a
Time1 = MilliSecs ()

For t = 0 To 50
    a$ = Addieren_Komma$ (A$ ,"122348966435.546413")
    a$ = Multiplizieren_Komma$ (a$ , 2.45)
Next

Print "Zwischesumme"
Print a

For t = 0 To 50
    a$ = Dividieren_Komma$ (a$ , 2.45 ,120)
    a$ = Subtrahieren_Komma$ (A$ ,"122348966435.546413")
Next

time1 = MilliSecs () - time1
Print a
Print time1 + "  Dauer"

WaitKey

Exclamation
Achtung, es können noch einige Bugs enthalten sein,
da ich das noch nicht bis ins letzte Detail überprüft habe!

Aber dazu habe ich ja EUCH Wink
[BB2D | BB3D | BB+]
  • Zuletzt bearbeitet von Rallimen am Fr, Mai 18, 2012 17:36, insgesamt 2-mal bearbeitet
 

Shaggy82

BeitragSo, Dez 24, 2006 1:59
Antworten mit Zitat
Benutzer-Profile anzeigen
vielen dank für deine schnelle hilfe. wünsch dir und deiner familie noch schöne feiertage. mfg shaggy

Nescio

BeitragDi, Dez 04, 2007 0:42
Antworten mit Zitat
Benutzer-Profile anzeigen
Hi,
ziemlich coole Sache!! Hatte mir sowas mal in C++ gemacht, war aber zu faul es nach BlitzBasic zu übertragen.

Aber mal theoretische Frage:
Würde es das Programm beschleunigen, wenn man die Zahlen nicht in Strings sondern in Banks speichert?
Da man pro Ziffer (0-9) ja eigentlich nur 4 bit bräuchte, würde zumindest der Speicherbedarf halbiert...

Aber danke für die Funktionen Smile großes Lob!!
Quod est faciendum? Nescio!

Gehe zu Seite 1, 2  Weiter

Neue Antwort erstellen


Übersicht BlitzBasic Codearchiv

Gehe zu:

Powered by phpBB © 2001 - 2006, phpBB Group