PureBasic Forums - English

Code: Select all

;- binary calculation of square root of (pos.) Numbers, without optimization
;- "Helle" Klaus Helbing, 06.12.2009, PB4.40

;for procedures, or another way
Global P$                         ;product-string
Global S$                         ;sum-string 
 
Procedure.s Mul2(A$)
  p_A = @A$                       ;pointer of A$
  l_A = Len(A$)                   ;length of A$ (or SSE-routine ;-) )
  If PeekB(p_A) > $34             ;greater then 4 -> carry
    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) & $F     ;or -$30
    A + A + C
    If A > 9
      C = 1 : A - 10
     Else
      C = 0
    EndIf
    PokeB(@P$ + l_P, A + $30)
    l_P - 1
  Wend 
  If C
    PokeB(@P$ + l_P, $31)         ;(last) set carry (cipher 1)
  EndIf
EndProcedure

Procedure.s AddStr(A$, B$)        ;A$ is >= B$!
  p_A = @A$                       ;pointer
  l_A = Len(A$)                   ;length
  p_B = @B$                       ;pointer
  l_B = Len(B$)                   ;length  
  S$ = Space(l_A + 1)             ;sum, with 1 place more, remove space later (if exist)
  p_S = @S$
  While l_A
    l_A - 1
    A = PeekB(p_A + l_A) & $F     ;or -$30
    If l_B > 0
      l_B - 1
      B = PeekB(p_B + l_B) & $F   ;or -$30
     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 + $30)
  Wend 
  If C  
    PokeB(p_S + l_A, $31)         ;(last) set carry (cipher 1)
   Else
    S$ = LTrim(S$) 
  EndIf
EndProcedure

Global Freq.q                     ;4 variables for time-measuring
Global Start.q
Global Ende.q
Global Time.d 

;no test of plausibility!
EingabeO$ = InputRequester("Calculation Square Root -  Input radicand", "e.g. 12345 or 12345.6789 or 0.00012345", "")
NachKommaO = Val(InputRequester("Number of places after decimal point", "pos. integer-value (e.g. 1000) :", ""))

Eingabe$ = EingabeO$              ;save the original input-string (for output) 

NachKomma = Len(Eingabe$) << 3    ;if places after decimal point too short
If NachKomma < NachKommaO
  NachKomma = NachKommaO 
EndIf

;SetThreadAffinityMask_(GetCurrentThread_(), 1)   ;for test, set the thread to Core0 and read the time from Core0
QueryPerformanceFrequency_(@Freq)
QueryPerformanceCounter_(@Start)

L = Len(Eingabe$)
For i = 1 To L
  If Mid(Eingabe$, i, 1) = "."    ;test for decimal point
    Eingabe$ = Mid(Eingabe$, 1, i - 1) + Mid(Eingabe$, i + 1, L - i) ;remove decimal point, if exist
    Korr = L - i
    L - 1
    If Korr & 1                   ;odd number of after-decimal-point-places
      Eingabe$ + "0"              ;make even with "0" 
      Korr + 1
    EndIf
    Korr >> 1
    For j = i To L
      If Mid(Eingabe$, j, 1) <> "0"    ;test for zero
        Break 
      EndIf 
      NullNK + 1
    Next
    Break 
  EndIf
Next
NullNK >> 1 
If j = L + 1
  NullNK = 0                      ;without interest, only zeros after decimal point
EndIf

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

Dec$ = EingabeVoll$
DecBin$ = Space(Len(Dec$) << 2)   ;calculate the length of the binary-string: 1x dec = 4x bin (avoid risks)
l_DecBin = Len(DecBin$)
p_DecBin = @DecBin$ + l_DecBin

;Phase 1: Convert the decimal-input-string into a binary-string
Repeat
  Mul2(Dec$)                      ;no division with 2 (time!)
  Mul2(P$)                        ;multiply with 5 with place-adaptation
  AddStr(P$, Dec$)                ;now equal like a multiplication with 5
  p_DecBin - 1
  If Mid(S$, Len(S$), 1) = "5"
    PokeB(p_DecBin, $31)    
   Else 
    PokeB(p_DecBin, $30)    
  EndIf
  Dec$ = Mid(S$, 1, Len(S$) - 1)
  If Dec$ = "1"
    p_DecBin - 1
    PokeB(p_DecBin, $31)
    Break
   ElseIf Dec$ = "0"
    p_DecBin - 1
    PokeB(p_DecBin, $30)    
    Break 
  EndIf
ForEver
DecBin$ = LTrim(DecBin$)
l_DecBin = Len(DecBin$)           ;length of binary-string

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 X4 Step 4            ;fill the strings with "0" 
  PokeL(p_Binaer + i, $30303030)
  PokeL(p_Rest + i, $30303030)
Next
       
;Phase 2: Calculate binary the square root
Iter = (l_DecBin >> 1) - 1        ;number of iterations
For j = 0 To Iter
  For i = 2 To X2 Step 2          ;equal shift left 2 of Rest$
    PokeW(p_Rest + i - 2, PeekW(p_Rest + i))
  Next

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

  l_A = j + 3
  For i = 0 To l_A                ;copy Binaer$ in Binaer1$
    PokeB(p_Binaer1 + l_Binaer1 - l_A + i, PeekB(p_Binaer + l_Binaer -l_A + i))
  Next
  
  For i = 2 To X2 Step 2          ;equal shift left 2 of Binaer1$
    PokeW(p_Binaer1 + i - 2, PeekW(p_Binaer1 + i)) 
  Next    
  PokeW(p_Binaer1 + i - 2, $3030) ;set last 2 places to "0"
  
  l_A + 1                         ;length
  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) = $30          ;now binary subtraction 
    PokeB(p_Binaer1 + l_Binaer1 - 1, $31)   ;set last place to "1"
    Carry = 0
    Komp2 = 1                     ;for the 2-complement
    While l_A                     ;subtraction =  addition of the 2-complement
      l_A - 1
      A = PeekB(p_RestX + l_A) & $F     ;or -$30
      If l_A > 0
        B = PeekB(p_Binaer1X + l_A) & $F     ;or -$30
        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 + $30)
    Wend 
   Else                           ;now binary addition
    PokeW(p_Binaer1 + l_Binaer1 - 2, $3131) ;set last 2 places to "1"
    Carry = 0
    While l_A
      l_A - 1  
      A = PeekB(p_RestX + l_A) & $F    ;or -$30
      If l_A > 0
        B = PeekB(p_Binaer1X + l_A) & $F    ;or -$30
       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 + $30)
    Wend 
  EndIf
  
  For i = 1 To X1                 ;equal shift left 1 of Binaer$
    PokeB(p_Binaer + i - 1, PeekB(p_Binaer + i)) 
  Next
  PokeB(p_Binaer + i - 1, $30)     ;set last place to zero
  
  If PeekB(Signum) = $30
    PokeB(p_Binaer + l_Binaer - 1, $31)
  EndIf
Next

;Phase 3: Convert the binary-string into the output-decimal-string 
If Mid(Binaer$, Len(Binaer$), 1) = "0" ;set LSB from hand
  S$ = "0"
 Else
  S$ = "1"
EndIf

P$ = "1"                          ;start-value for power-of-2-calculation
l_Bin = Len(Binaer$) - 1
p_Bin = @Binaer$ 

While L_Bin   
  Mul2(P$)                        ;calculate the powers of 2
  l_Bin - 1
  If PeekB(p_Bin + l_Bin) > $30
    AddStr(P$, S$)                ;add, if the bit is set
  EndIf
Wend

;Output, set decimal point
Vor$ = Mid(S$, 1, Len(S$) - NachKomma - Korr)
If Vor$ = ""                      ;without this is the output e.g. ".123"
  Vor$ = "0"
 Else 
  NullNK = 0                      ;a (non-zero) value in front of the decimal point exist 
EndIf 
Erg$ = Vor$ + "."
For i = 1 To NullNK
  Erg$ + "0"
Next
Nach$ = Mid(S$, Len(S$) - NachKomma + 1 - Korr, NachKommaO - NullNK)
Erg$ + Nach$

QueryPerformanceCounter_(@Ende) 
Time = (Ende - Start) / Freq

MessageRequester("Square Root of " + EingabeO$ + " with " + Str(NachKommaO) + " places after decimal point in " + StrD(Time, 3)+" s", Erg$)