Wurzel aus 2

Anfängerfragen zum Programmieren mit PureBasic.
Antworten
Little John

Beitrag von Little John »

Freut mich, dass es jemand gebrauchen kann. ;-)

Gruß, Little John
Nach oben
Benutzeravatar
Helle
Beiträge: 566
Registriert: 11.11.2004 16:13
Wohnort: Magdeburg

Beitrag von Helle »

Bei diesem Mist-Wetter (die Biergärten sind immer noch zu :( !) kommt man ja auf die schrägsten Ideen, also habe ich mal versucht, die Quadratwurzel einer Zahl binär zu berechnen:

Code: Alles auswählen

;- Binäre Ermittlung der Quadratwurzel einer (positiven) Zahl, Prinzip-Darstellung ohne Optimierungen
;- "Helle" Klaus Helbing, 22.03.2009, PB4.30
;- Hat noch grosses Geschwindigkeits-Optimierungs-Potenzial (ich denke, um mehrere Faktoren!)
;-  z.B. Shiften ersetzen durch Zeiger-Manipulationen

;diese beiden Strings einfach wegen Proceduren global gesetzt, kann natürlich geändert werden 
Global P$                    ;Produkt-String
Global S$                    ;Summe-String 
 
Procedure.s Mul2(A$)
  p_A = @A$                  ;Pointer auf A$
  l_A = Len(A$)              ;Länge von A$
  If PeekB(p_A) > 52         ;grösser 4 -> Übertrag
    l_P = l_A
   Else
    l_P = l_A - 1
  EndIf
  P$ = Space(l_P + 1)
  While l_A 
    l_A - 1  
    A = PeekB(p_A + l_A) - 48
    A + A + C
    If A > 9
      C = 1 : A - 10
     Else
      C = 0
    EndIf
    PokeB(@P$ + l_P, A + 48)
    l_P - 1
  Wend 
  If C
    PokeB(@P$ + l_P, 49)     ;(letzten) Übertrag setzen (Ziffer 1)
  EndIf
EndProcedure

Procedure.s AddStr(A$, B$)   ;A$ ist längenmässig immer grösser oder gleich B$!
  p_A = @A$                  ;Pointer
  l_A = Len(A$)              ;Länge
  p_B = @B$                  ;Pointer
  l_B = Len(B$)              ;Länge  
  S$ = Space(l_A + 1)        ;Summe, 1 Stelle mehr, Leerzeichen später weg (wenn noch da)
  p_S = @S$
  While l_A
    l_A - 1
    A = PeekB(p_A + l_A) - 48
    If l_B > 0
      l_B - 1
      B = PeekB(p_B + l_B) - 48
     Else
      B = 0
    EndIf
    A + B + C
    If A > 9
      C = 1 : A - 10
     Else
      C = 0
    EndIf
    PokeB(p_S + l_A + 1, A + 48)
  Wend 
  If C  
    PokeB(p_S + l_A, 49)     ;(letzten) Übertrag setzen (Ziffer 1)
   Else
    S$ = LTrim(S$) 
  EndIf
EndProcedure

Global Freq.q                ;4 Variablen für Zeitmessung
Global Start.q
Global Ende.q
Global Zeit.d 

;hier kein Test auf Korrektheit der Eingabe!
EingabeO$ = InputRequester("Eingabe Radikand (kann auch Float sein)", "z.B. 12345 oder 12345.6789 oder 0.00012345", "")
NachKommaO = Val(InputRequester("Anzahl Nachkomma-Stellen", "Bitte einen positiven ganzahligen Dezimalwert eingeben :", ""))

Eingabe$ = EingabeO$         ;Eingabe-Original-String für Ausgabe ungeschoren lassen 

NachKomma = Len(Eingabe$) << 3    ;wegen kurz gewählter Nachkomma-Stellen
If NachKomma < NachKommaO
  NachKomma = NachKommaO 
EndIf

;SetThreadAffinityMask_(GetCurrentThread_(), 1)   ;Thread nur von Core0 ausführen lassen
QueryPerformanceFrequency_(@Freq)
QueryPerformanceCounter_(@Start)

L = Len(Eingabe$)
For i = 1 To L
  If Mid(Eingabe$, i, 1) = "."    ;Test auf Komma/Punkt
    Eingabe$ = Mid(Eingabe$, 1, i - 1) + Mid(Eingabe$, i + 1, L - i) ;Punkt/Komma entfernen
    Korr = L - i
    L - 1
    If Korr & 1              ;ungerade Anzahl Nachkomma-Stellen
      Eingabe$ + "0"         ;noch eine Null dranhängen 
      Korr + 1
    EndIf
    Korr >> 1
    For j = i To L
      If Mid(Eingabe$, j, 1) <> "0"     ;Test auf Null
        Break 
      EndIf 
      NullNK + 1
    Next
    Break 
  EndIf
Next
NullNK >> 1 
If j = L + 1
  NullNK = 0                 ;uninteressant, nur Nullen nach dem Komma
EndIf

X0 = NachKomma << 2
X1 = (NachKomma << 2) - 1
X2 = (NachKomma << 2) - 2
   
EingabeVoll$ = Eingabe$
For i = 1 To NachKomma
  EingabeVoll$ + "00"
Next

Dec$ = EingabeVoll$
DecBin$ = Space(Len(Dec$) << 2)   ;Abschätzung der Größe des Binär-Strings: 1x Dez = 4x Bin (sichere Seite)
l_DecBin = Len(DecBin$)
p_DecBin = @DecBin$ + l_DecBin

;Phase 1: Den Eingabe-Dezimal-String in einen Binär-String umwandeln
Repeat
  Mul2(Dec$)                 ;um zeitaufwändige Divisionen durch 2 zu vermeiden wird mit 5
  Mul2(P$)                   ; multipliziert mit nachfolgender Stellenanpassung
  AddStr(P$, Dec$)           ;entspricht jetzt Multiplikation mit 5
  p_DecBin - 1
  If Mid(S$, Len(S$), 1) = "5"
    PokeB(p_DecBin, 49)    
   Else 
    PokeB(p_DecBin, 48)    
  EndIf
  Dec$ = Mid(S$, 1, Len(S$) - 1)
  If Dec$ = "1"
    p_DecBin - 1
    PokeB(p_DecBin, 49)
    Break
   ElseIf Dec$ = "0"
    p_DecBin - 1
    PokeB(p_DecBin, 48)    
    Break 
  EndIf
ForEver
DecBin$ = LTrim(DecBin$)
l_DecBin = Len(DecBin$)      ;Länge des Binär-Strings

k = 4 - L_DecBin % 4
For i = 1 To k  
  Vornullen$ + "0"
  l_DecBin + 1
Next  

DecBin$ = Vornullen$ + DecBin$   
DecBin$ = LTrim(DecBin$)
p_DecBin = @DecBin$
  
Binaer$ = Space(X0)
Binaer1$ = Space(X0)
Rest$ = Space(X0)

p_Binaer = @Binaer$
l_Binaer = Len(Binaer$)
p_Binaer1 = @Binaer1$
l_Binaer1 = Len(Binaer1$)
p_Rest = @Rest$
l_Rest = Len(Rest$)

For i = 0 To X1              ;die Strings mit "0" füllen 
  PokeB(p_Binaer + i, 48)
  PokeB(p_Rest + i, 48)
Next
       
;Phase 2: Binär die Quadratwurzel ermitteln
Iter = (l_DecBin >> 1) - 1   ;Anzahl der Iterationen
For j = 0 To Iter
  For i = 2 To X2 Step 2     ;entspricht Shift Left 2 von Rest$
    K = PeekW(p_Rest + i)
    PokeW(p_Rest + i - 2, K) 
  Next

  PokeW(p_Rest + l_Rest - 2, PeekW(p_DecBin + ZE))
  ZE + 2

  Binaer1$ = Binaer$ 
  For i = 2 To X2 Step 2     ;entspricht Shift Left 2 von Binaer1$
    K = PeekW(p_Binaer1 + i)
    PokeW(p_Binaer1 + i - 2, K) 
  Next    
  PokeW(p_Binaer1 + i - 2, $3030) ;die letzten beiden Stellen auf Null setzen
  
  l_A = j + 4                ;Länge
  p_RestX = p_Rest + l_Rest - l_A
  p_Binaer1X = p_Binaer1 + l_Binaer1 - l_A
  Signum = p_Rest + l_Rest - j - 4
  If PeekB(Signum) = 48      ;es folgt binäre Subtraktion 
    PokeB(p_Binaer1 + l_Binaer1 - 1, 49)    ;letzte Stelle auf 1
    Carry = 0
    Komp2 = 1                ;für Bildung des Zweier-Komplements
    While l_A                ;Subtraktion erfolgt durch Addition des Zweier-Komplements 
      l_A - 1
      A = PeekB(p_RestX + l_A) - 48
      If l_A > 0
        B = PeekB(p_Binaer1X + l_A) - 48
        B = (~B) & 1
        B + Komp2
        Select B
          Case 0, 1 
            Komp2 = 0
          Case 2
            B = 0 : Komp2 = 1
          Case 3
            B = 1 : Komp2 = 1    
        EndSelect      
       Else
        B = 1
      EndIf
      A + B + Carry
      Select A
        Case 0, 1 
          Carry = 0
        Case 2
          A = 0 : Carry = 1
        Case 3
          A = 1 : Carry = 1    
      EndSelect
      PokeB(p_RestX + l_A, A + 48)
    Wend 
   Else                      ;es folgt binäre Addition
    PokeW(p_Binaer1 + l_Binaer1 - 2, $3131) ;letzten beiden Stellen auf 1
    Carry = 0
    While l_A
      l_A - 1  
      A = PeekB(p_RestX + l_A) - 48
      If l_A > 0
        B = PeekB(p_Binaer1X + l_A) - 48
       Else
        B = 0
      EndIf
      A + B + Carry
      Select A
        Case 0, 1 
          Carry = 0
        Case 2
          A = 0 : Carry = 1
        Case 3
          A = 1 : Carry = 1    
      EndSelect
      PokeB(p_RestX + l_A, A + 48)
    Wend 
  EndIf
  
  For i = 1 To X1            ;entspricht Shift Left 1 von Binaer$
    K = PeekB(p_Binaer + i)
    PokeB(p_Binaer + i - 1, K) 
  Next
  PokeB(p_Binaer + i - 1, 48)     ;letzte Stelle auf Null setzen
  
  If PeekB(Signum) = 48
    PokeB(p_Binaer + l_Binaer - 1, 49)
  EndIf
Next

;Phase 3: Den binären Ergebnis-String in einen dezimalen Ausgabe-String umwandeln 
If Mid(Binaer$, Len(Binaer$), 1) = "0" ;das LSB wird von Hand gesetzt
  S$ = "0"
 Else
  S$ = "1"
EndIf

P$ = "1"                     ;Startwert für 2-er-Potenzen-Ermittlung
l_Bin = Len(Binaer$) - 1
p_Bin = @Binaer$ 

While L_Bin   
  Mul2(P$)                   ;die jeweilige 2-er-Potenz berechnen
  l_Bin - 1
  If PeekB(p_Bin + l_Bin) > 48
    AddStr(P$, S$)           ;aufaddieren, wenn Bit gesetzt
  EndIf
Wend

;Ausgabe, Komma/Punkt setzen
Vor$ = Mid(S$, 1, Len(S$) - NachKomma - Korr)
If Vor$ = ""                 ;sonst sowas wie ".123" als Ergebnis-Anzeige
  Vor$ = "0"
 Else 
  NullNK = 0                 ;es gibt also einen (Nicht-Null-) Wert vor dem Komma 
EndIf 
Erg$ = Vor$ + "."
For i = 1 To NullNK
  Erg$ + "0"
Next
Nach$ = Mid(S$, Len(S$) - NachKomma + 1 - Korr, NachKommaO - NullNK)
Erg$ + Nach$

;SetThreadAffinityMask_(GetCurrentThread_(), 1)   ;Werte wieder von Core0 auslesen lassen, nur bei Bedarf einfügen
QueryPerformanceCounter_(@Ende) 
Zeit = (Ende - Start) / Freq

MessageRequester("Quadratwurzel aus " + EingabeO$ + " mit " + Str(NachKommaO) + " Nachkomma-Stellen in " + StrD(Zeit, 3)+" s", Erg$)
Ist nur so eine Grundidee, Optimierungen möglich.

Viel Spaß und Gruß
Helle

Edit 1: 14.03.2009: Überflüssiges entfernt, Radikand kann jetzt auch Float sein
Edit 2: 14.03.2009: Nur Anzeigetext geändert
Edit 3: 22.03.2009: Kleine Optimierungen
Zuletzt geändert von Helle am 22.03.2009 12:37, insgesamt 3-mal geändert.
Nach oben
Benutzeravatar
STARGÅTE
Kommando SG1
Beiträge: 7031
Registriert: 01.11.2005 13:34
Wohnort: Glienicke
Kontaktdaten:
Kontaktdaten von STARGÅTE

Beitrag von STARGÅTE »

super :allright:

und glücklicherweise kommt auch das selbe wie bei mir (mit meinem Include für genaue unlimitierte Dezimalzahlen) raus :

300 Stellen :

Deins:

Code: Alles auswählen

1.
41421356237309504880168872420969807856967187537694
80731766797379907324784621070388503875343276415727
35013846230912297024924836055850737212644121497099
93583141322266592750559275579995050115278206057147
01095599716059702745345968620147285174186408891986
09552329230484308714321450839762603627995251407989
Meins:

Code: Alles auswählen

1.
41421356237309504880168872420969807856967187537694
80731766797379907324784621070388503875343276415727
35013846230912297024924836055850737212644121497099
93583141322266592750559275579995050115278206057147
01095599716059702745345968620147285174186408891986
09552329230484308714321450839762603627995251407989
PB 6.01 ― Win 10, 21H2 ― Ryzen 9 3900X, 32 GB ― NVIDIA GeForce RTX 3080 ― Vivaldi 6.0 ― www.unionbytes.de
Aktuelles Projekt: Lizard - Skriptsprache für symbolische Berechnungen und mehr
Nach oben
Benutzeravatar
Helle
Beiträge: 566
Registriert: 11.11.2004 16:13
Wohnort: Magdeburg

Beitrag von Helle »

Habe meinen obigen Code etwas auf Vordermann gebracht und Float-Eingabe-Möglichkeit für den Radikanden eingebaut (ich hoffe fehlerfrei :).

Gruß
Helle
Nach oben
Andesdaf
Moderator
Beiträge: 2673
Registriert: 15.06.2008 18:22
Wohnort: Dresden

Beitrag von Andesdaf »

schön. Danke.
Win11 x64 | PB 6.20
Nach oben
Pandorra
Beiträge: 124
Registriert: 10.02.2007 12:15

Beitrag von Pandorra »

jo wirklich gut.

Thx


Mit freundlichen Grüßen Pandora
Benutze PB v 4.40 Beta 3
Nach oben
Benutzeravatar
Helle
Beiträge: 566
Registriert: 11.11.2004 16:13
Wohnort: Magdeburg

Beitrag von Helle »

Danke, war mir ein Vergnügen!
Und ich dachte schon, Pandora merkt es nie, das er ein "r" zuviel drinne hat :mrgreen: !

Gruß
Helle
Nach oben
Kaeru Gaman
Beiträge: 17389
Registriert: 10.11.2004 03:22

Beitrag von Kaeru Gaman »

[ot]
jetzt müßte er sich nur trauen zu fragen, ob man das mal korrigieren könnte...
[/ot]
Der Narr denkt er sei ein weiser Mann.
Der Weise weiß, dass er ein Narr ist.
Nach oben
Pandorra
Beiträge: 124
Registriert: 10.02.2007 12:15

Beitrag von Pandorra »

mir gefällt mein 2tes r.
War zwar ausversehen aber jetzt gehört es zum Namen xD.
:lol:

Mal gucken aber bisher stört mich das zweite r nicht sonderlich, werde es aber nicht in meine Signatur packen.

Mit freundlichen Grüßen Pandorra
Benutze PB v 4.40 Beta 3
Nach oben
Antworten

Zurück zu „Anfänger“