PureBoard

Code: Alles auswählen

Wurzel.d = 200
Zahl.d = 14
Mal.d = 1
Stellen = 2

Repeat

   Stellen+1
   Zahl*10
   Wurzel*100
   
   Repeat
     Zahl+1
     
     If Zahl*Zahl > Wurzel
        Zahl-1
        Break
     EndIf
     
     If Zahl*Zahl = Wurzel
        Break
     EndIf
     
   ForEver
   
Until Zahl*Zahl = Wurzel Or Stellen = 82

Debug Zahl

Code: Alles auswählen

Procedure.s Zeros (count) 
   Protected ret.s, i 

   ret = "" 
   For i = 1 To count 
      ret + "0" 
   Next 
   ProcedureReturn ret 
EndProcedure 

Procedure.s LTrimZeros (str.s) 
   ; -- entfernt führende Nullen 
   Protected p 

   p = 1 
   While p < Len(str) And Mid(str,p,1) = "0" 
      p + 1 
   Wend 
   ProcedureReturn Mid(str, p) 
EndProcedure 

#Signs = "+-" 
#SignPos = 0 
#SignNeg = 2 

Procedure.s Prepare (x.s, *y.Integer) 
   ; -- entfernt ein vorhandenes Vorzeichen sowie führende Nullen 
   ; in : x repräsentiert eine ganze Zahl, 
   ;      das erste Zeichen kann "+" oder "-" sein 
   ; out: *y\i        : Vorzeichen als Zahl (#SignPos oder #SignNeg) 
   ;      Rückgabewert: String ohne Vorzeichen und führende Nullen 

   *y\i = FindString(#Signs, Left(x, 1), 1) 
   If *y\i > 0 
      x = Mid(x, 2) 
   EndIf 
   *y\i & 2 
   ProcedureReturn LTrimZeros(x) 
EndProcedure 

Procedure.i AbsCmp (a.s, b.s) 
   ; -- vergleicht die Größen von a und b 
   ; in : a und b repräsentieren ganze Zahlen ohne Vorzeichen 
   ; out: -1: a < b 
   ;       0: a = b 
   ;      +1: a > b 

   If Len(a) < Len(b) 
      ProcedureReturn -1 
   ElseIf Len(a) > Len(b) 
      ProcedureReturn 1 
   ElseIf a < b 
      ProcedureReturn -1 
   ElseIf a > b 
      ProcedureReturn 1 
   Else 
      ProcedureReturn 0 
   EndIf 
EndProcedure 

Procedure.s AbsAdd (a.s, b.s) 
   ; -- ahmt die schriftliche Addition nach 
   ; in : a und b repräsentieren ganze Zahlen ohne Vorzeichen 
   ; out: a + b 
   Protected ret.s 
   Protected n, d, i, u, d_a, d_b, r 

   n = Len(a) 
   d = n - Len(b) 
   If d > 0 
      b = Zeros(d) + b 
   ElseIf d < 0 
      n = Len(b) 
      a = Zeros(-d) + a 
   EndIf 

   u = 0 
   ret = "" 
   For i = n To 1 Step -1 
      d_a = Val(Mid(a, i, 1)) 
      d_b = Val(Mid(b, i, 1)) 
      r = d_a + d_b + u 
      u = Int(r/10) 
      r = r % 10 
      ret = Str(r) + ret 
   Next 
   If u > 0 
      ret = Str(u) + ret 
   EndIf 
   ProcedureReturn ret 
EndProcedure 


Procedure.s AbsSub (a.s, b.s) 
   ; -- ahmt die schriftliche Subtraktion nach 
   ; in : a und b repräsentieren ganze Zahlen ohne Vorzeichen, 
   ;      a muss >= b sein 
   ; out: a - b 
   Protected ret.s 
   Protected n, d, i, u, d_a, d_b, r 

   n = Len(a) 
   d = n - Len(b) 
   If d > 0 
      b = Zeros(d) + b 
   ElseIf d < 0 
      n = Len(b) 
      a = Zeros(-d) + a 
   EndIf 

   u = 0 
   ret = "" 
   For i = n To 1 Step -1 
      d_a = Val(Mid(a, i, 1)) 
      d_b = Val(Mid(b, i, 1)) 
      r = d_a - d_b - u 
      If r < 0 
         r + 10 
         u = 1 
      Else 
         u = 0 
      EndIf 
      ret = Str(r) + ret 
   Next 
   ProcedureReturn LTrimZeros(ret) 
EndProcedure 

Procedure.s AbsMul(a.s, b.s) 
   ; -- ahmt die schriftliche Multiplikation nach 
   ; in : a und b repräsentieren ganze Zahlen ohne Vorzeichen 
   ; out: a * b 
   Protected x.s, ret.s 
   Protected p_a, p_b, u, d_a, d_b, r 

   ret = "" 
   For p_b = 1 To Len(b) 
      d_b = Val(Mid(b, p_b, 1)) 
      u = 0 
      x = "" 
      For p_a = Len(a) To 1 Step -1 
         d_a = Val(Mid(a, p_a, 1)) 
         r = d_a * d_b + u 
         u = Int(r/10) 
         r = r % 10 
         x = Str(r) + x 
      Next 
      If u > 0 
         x = Str(u) + x 
      EndIf 
      ret = AbsAdd(ret + "0", x) 
   Next 
   ProcedureReturn ret 
EndProcedure 

Global Wurzel.s = "2"
Global Zahl.s = ""
Global Mal.d = 1
Global Stellen.d = 0
Global maxStellen.d = 800

OpenConsole()

Global Zeitspanne
Global MaxZeitspanne = 20000
Global Start


PrintN("Wurzelberechnung von 2")
PrintN("Die Zahl angeben dessen Wurzel berechnet werden soll (ohne Eingabe ist es 2)")
Input.s = Input()
If Not Input = ""
Wurzel = Input
EndIf
PrintN("Ziehe die Wurzel von " + Wurzel)

PrintN("Anzahl an Stellen nach dem Komma angeben( bei keiner Angabe 800)")
Input.s = Input()
If Not Input = ""
maxStellen = Val(Input)
EndIf
PrintN("Suche bis zu " + Str(maxStellen) + " Stellen nach dem Komma")

Repeat

   Stellen+1
   
   
   Repeat
     Zahl = AbsAdd (Zahl,"1")
     
     If AbsCmp (AbsMul(Zahl,Zahl),Wurzel) = 1
        Zahl = AbsSub (Zahl,"1")
        Break
     EndIf
     
     If AbsCmp (AbsMul(Zahl,Zahl),Wurzel) = 0
        Break 2
     EndIf
   ForEver


If Zeitspanne => MaxZeitspanne
Start = ElapsedMilliseconds()
PrintN("Stellen nach dem Komma " + Str(Stellen))
PrintN("Zahl " + Zahl)
PrintN("Bei " + StrD((Stellen/maxStellen)*100,2)+"%")
If CreateFile(0, "Wurzel.txt")
  WriteStringN(0, "(Nicht ernst nehmen ist) " + Wurzel)
  WriteStringN(0, Str(Stellen) + " Stellen nach dem Komma")
  WriteStringN(0, Zahl)
  CloseFile(0)
EndIf
EndIf

Zeitspanne = ElapsedMilliseconds() - Start
   
 
   Zahl = AbsMul(Zahl,"10")
   Wurzel = AbsMul(Wurzel,"100")
   
Until Stellen = maxStellen


PrintN("Stellen nach dem Komma " + Str(Stellen))
PrintN("Zahl " + Zahl)
PrintN("Bei " + StrD((Stellen/maxStellen)*100,2)+"%")

If CreateFile(0, "Wurzel.txt")
  WriteStringN(0, "(Nicht ernst nehmen ist) " + Wurzel)
  WriteStringN(0, Str(Stellen) + " Stellen nach dem Komma")
  WriteStringN(0, Zahl)
  CloseFile(0)
  If Stellen > 1
  MessageRequester("Wurzelberechnung Erfolgreich", "Fertig "+Str(Stellen)+" Stellen nach dem Komma", 0)
  ElseIf Stellen = 1
  MessageRequester("Wurzelberechnung Erfolgreich", "Fertig "+Str(Stellen)+" Stelle nach dem Komma", 0)
  EndIf
Else
  MessageRequester("PureBasic", "Error: can't write the file (Datas will be removed)", 0)
  End
EndIf

End