PI calc try

General FreeBASIC programming questions.
bluatigro
Posts: 517
Joined: Apr 25, 2012 10:35
Location: netherlands

PI calc try

Postby bluatigro » Jan 30, 2018 11:14

i got this out of a book for VB2005
i changed the intarray's to strings
error :
i don't get PI

Code: Select all

'' BLUATIGRO 30 JAN 2018
'' PI

dim shared as integer numdigits
const as string z10 = "0000000000"
const as string z100 = z10+z10+z10+z10+z10+z10+z10+z10+z10+z10

sub arraymulty( byref inuit as string , byref m as integer )
  dim as integer c , p , h
  dim as string uit
  for p = numdigits to 0 step -1
    h = val( mid( inuit , p , 1 ) ) * m + c
    c = int( h / 10 )
    uit = str( h mod 10 ) + uit
  next p
  inuit = uit
end sub
sub arraydiv( byref inuit as string , byref d as integer )
  dim as integer b , p , h
  dim as string uit
  for p = 0 to numdigits
    h = val( mid( inuit , p , 1 ) ) + b * 10
    b = h mod d
    uit += str( int( h / d ) )
  next p
  inuit = uit
end sub
sub arrayadd( byref inuit as string , byref ad as string )
  dim as integer c , h , p , i , a
  dim as string uit
  i = len( inuit )
  a = len( ad )
  if a < i then
    ad = right( z100 , i - a ) + ad
  end if
  if a > i then
    inuit = right( z100 , a - i ) + inuit
  end if
  for p = len( ad ) to 1 step -1
    h = val( mid( inuit , p , 1 ) ) + val( mid( ad , p , 1 ) ) + c
    c = int( h / 10 )
    uit = str( h mod 10 ) + uit
  next p
  inuit = uit
end sub
sub arraysub( byref inuit as string , byref sb as string )
  dim as integer b , p , h , i , s
  dim as string uit
  i = len( inuit )
  s = len( sb )
  if s < i then
    sb = left( z100 , i - s ) + sb
  end if
  if s > i then
    inuit = left( z100 , s - i ) + inuit
  end if
  for p = len( inuit ) to 0 step -1
    h = val( mid( inuit , p , 1 ) ) - val( mid( sb , p , 1 ) ) + 10
    b = int( h / 10 )
    uit = str( h mod 10 ) + uit
  next p
  inuit = uit
end sub
function arrayzero( byref inuit as string ) as integer
  dim as integer p
  for p = 1 to 9
    if instr( inuit , str( p ) ) then return 0
  next p
  return 1
end function
sub arctangent( byref t as string , byref s as string , d as integer )
'' arctan = x + x^3/3 + x^7/7 ...
  dim as integer w , i
  s = "1" + right( s , len( s ) - 1 )
  i = 1
  w = d
  arraydiv s , w
  arrayadd t , s
  do
    arraymulty s , i
    w = d * d
    arraydiv s , w
    i += 2
    w = i
    arraydiv s , w
    arraysub t , s
    arraymulty s , i
    w = d * d
    arraydiv s , w
    i += 2
    w = i
    arraydiv s , w
    arrayadd t , s
  loop until arrayzero( s )
end sub 

function findpi( digits as integer ) as string
  dim index as integer
  dim div as integer
  numdigits = digits + 2
  dim target as string
  dim source as string
  div = 2
  arctangent target , source , div
  div = 3
  arctangent target , source , div
  arraymulty target , 4
  return "3." + target
end function
print findpi( 60 )
sleep
end

counting_pine
Site Admin
Posts: 5902
Joined: Jul 05, 2005 17:32
Location: Manchester, Lancs

Re: PI calc try

Postby counting_pine » Jan 30, 2018 13:06

I think you need to start by taking each individual Sub and writing a test for it, to make sure it does what you expect.

I tried with arraymulty(), but it seems to have a dependency on the 'numdigits' global variable, and with a default value of 0 the sub doesn't do anything.
In the program as written, numdigits only gets set if you call it through findpi().
srvaldez
Posts: 1532
Joined: Sep 25, 2005 21:54

Re: PI calc try

Postby srvaldez » Jan 30, 2018 13:38

I adapted a similar program found in a magazine eons ago, I hope you won't mind me posting it, who knows, it may give you some insight.
did your code work before you replaced the integer array with string? if so then please post that code as it would help to diagnose the problem

Code: Select all

Declare Sub series (a() As Long, f As LongInt)
Declare Sub multiply (a() As Long, f As LongInt)
Declare Sub subtract (d() As Long, t() As Long)
Declare Sub lsqrpoly (x() As Double, y() As Double, c() As Double, e As Double)
Declare Sub Add (s() As Long, t() As Long)
Declare Sub divide (a() As Long, d As LongInt)
Dim As Double c(2), x(12), y(12), ti, sp
Dim As LongInt i, n, k=2
Dim As LongInt n1
Dim As Long j, hours, minutes, seconds
Dim As String a_string, p_string
ReDim As Long pi(0), p(0)
ReDim Shared As Long power(0),temp(0)
Dim Shared size As LongInt

Print "please wait a few seconds";
For i = 1 To 9
   k=k*2
   n = k * i
   x(i) = CDbl(n)
   ti = Timer
   n = 8 * (n \ 8) + 4
   ReDim pi(n \ 8 + 2), p(n \ 8 + 2), power(n \ 8 + 2), temp(n \ 8 + 2)
   size = n \ 8 + 1

   series(pi(), 57)
   multiply(pi(), 44)
   series(p(), 239)
   multiply(p(), 7)
   Add(pi(), p())
   series(p(), 682)
   multiply(p(), 12)
   subtract(pi(), p())
   series(p(), 12943)
   multiply(p(), 24)
   Add(pi(), p())
   multiply(pi(), 4)
   y(i) = Timer - ti
   Erase pi, p, power, temp
   Print ".";
Next i

Print

lsqrpoly(x(), y(), c(), 0)
Input "how many digits do you want ", n

sp = c(0)
n1 = 1
For i = 1 To 2
   n1 = n1 * n
   sp = sp + c(i) * n1
Next i
Print "it will take aproximately "; sp; " seconds (+/- 15%)"
a_string=""
If sp>=60 Then
   ti=sp/3600
   hours=Int(ti)
   ti=Frac(ti)*60
   minutes=Int(ti)
   seconds=Int(Frac(ti)*60)
   If hours>0 Then a_string=Str(hours)+" hours, "
   If minutes>0 Then a_string+=Str(minutes)+" minutes, "
   If seconds>0 Then a_string+=Str(seconds)+" seconds"
End If
if a_string<>"" then
   Print "or ";a_string
end if
Input "continue ?", a_string
If Len(a_string) = 0 Then a_string = "n"
a_string = UCase(a_string)
If Left(a_string, 1) <> "Y" Then End
'input "print output to printer ?", p_string
'if len(p_string) = 0 then p_string = "n"
'p_string = ucase(left(p_string, 1))
'if p_string <> "y" then p_string = "n"
ti = Timer
n = 8 * (n \ 8) + 4
'''cls
ReDim pi(n \ 8 + 2), p(n \ 8 + 2), power(n), temp(n)
size = n \ 8 + 1
/'
series(pi(), 5)
multiply(pi(), 4)
series(p(), 239)
subtract(pi(), p())
'/
/'
series(pi(), 49)
multiply(pi(), 12)
series(p(), 57)
multiply(p(), 32)
add(pi(), p())
series(p(), 239)
multiply(p(), 5)
subtract(pi(), p())
series(p(), 110443)
multiply(p(), 12)
add(pi(), p())
'/

series(pi(), 57)
multiply(pi(), 44)
series(p(), 239)
multiply(p(), 7)
Add(pi(), p())
series(p(), 682)
multiply(p(), 12)
subtract(pi(), p())
series(p(), 12943)
multiply(p(), 24)
Add(pi(), p())

multiply(pi(), 4)
ti = Timer - ti
a_string = Str(pi(size + 1))
a_string = Left(a_string, 1) + "." + Mid(a_string, 2)
Print a_string;
'if p_string = "y" then lprint a_string;
j = 1
For i = size To 3 Step -1
   a_string = Str(pi(i))
   While Len(a_string) < 8
      a_string = "0" + a_string
   Wend
   Print a_string;
   'if p_string = "y" then lprint a_string;
   j = j + 1
   If (j * 4) Mod 60 = 0 Then Print
   'if ((j * 4) mod 60 = 0) and p_string = "y" then lprint ""
Next i
Print
Print "time to compute pi, not counting printing, is: "; ti; " seconds"
'''sleep
End

Sub Add (s() As Long, t() As Long) Static
   'adds t into s
   Dim As LongInt carry, size, sum
   Dim As Long i
   carry = 0
   If s(1) < t(1) Then size = t(1) Else size = s(1)
   size = size + 1
   For i = 2 To size
      sum = t(i) + s(i) + carry
      carry = sum \ 100000000
      s(i) = sum - 100000000 * carry
      If carry And size < UBound(s) Then
         s(1) = size
         s(size + 1) = carry
      End If
   Next i
End Sub

Sub subtract (d() As Long, t() As Long) Static
   'subtract t from d
   Dim As LongInt borrow, size, tmp
   Dim As Long i
   borrow = 0
   size = d(1) + 1
   For i = 2 To size
      tmp = d(i) - t(i) + borrow
      borrow = tmp \ 100000000
      d(i) = tmp - 100000000 * borrow
      If d(i) < 0 Then
         d(i) = d(i) + 100000000
         borrow = borrow - 1
      End If
   Next i
   While (d(size) = 0) And (size > 0)
      size = size - 1
      d(1) = size
   Wend
End Sub

Sub multiply (a() As Long, f As LongInt) Static
   'multiplies large number in a by f
   Dim As LongInt size, carry, p
   Dim As Long i
   size = a(1) + 1
   carry = 0
   For i = 2 To size
      p = f * a(i) + carry
      carry = p \ 100000000
      a(i) = p - 100000000 * carry
   Next i
   If carry Then
      a(1) = size
      a(size + 1) = carry
   End If
End Sub

Sub divide (a() As Long, d As LongInt) Static
   'divides large number in a by d
   Dim As LongInt remainder, size, term
   Dim As Long i
   remainder = 0
   size = a(1) + 1
   For i = size To 2 Step -1
      term = 100000000 * remainder + a(i)
      a(i) = term \ d
      remainder = term - d * a(i)
   Next i
   If a(size) = 0 Then a(1) = size - 2
End Sub

Sub series (a() As Long, f As LongInt) Static
   'shared power(), temp(), size
   Dim As LongInt sign, d
   Dim As Long i
   For i = 2 To size + 1
      power(i) = 0
   Next i
   power(size + 1) = 10000000
   power(1) = size
   divide(power(), f)
   sign = 1
   d = 3
   For i = 1 To size + 1
      a(i) = power(i)
   Next i
   Do
      divide(power(), f * f)
      sign = -sign
      For i = 1 To size + 1
         temp(i) = power(i)
      Next i
      divide(temp(), d)
      d = d + 2
      If sign > 0 Then
         Add(a(), temp())
      Else
         subtract(a(), temp())
      End If
   Loop While temp(1) > 0
End Sub

Sub lsqrpoly (x() As Double, y() As Double, c() As Double, e As Double) Static
   Dim As Long i, n, n1, ls, m
   Dim As Double a1, a2, b1, b2, c1, d1, d2, f1, f2, l, l2, v0, v1, v2, w
   m = UBound(c)
   n = UBound(x)
   Dim As Double c0(n), v(n), a(n), b(n)
   Dim As Double d(n), c2(n), e2(n), f(n)
   l = 0
   n1 = m + 1
   v1 = 100000000000
   For i = 1 To n1
      a(i) = 0
      b(i) = 0
      f(i) = 0
   Next i
   For i = 1 To n
      v(i) = 0
      d(i) = 0
   Next i
   d1 = Sqr(CDbl(n))
   w = d1
   For i = 1 To n
      e2(i) = 1 / w
   Next i
   f1 = d1
   a1 = 0
   For i = 1 To n
      a1 = a1 + x(i) * e2(i) * e2(i)
   Next i
   c1 = 0
   For i = 1 To n
      c1 = c1 + y(i) * e2(i)
   Next i
   b(1) = 1 / f1
   f(1) = b(1) * c1
   For i = 1 To n
      v(i) = v(i) + e2(i) * c1
   Next i
   m = 1
   lup0:
   For i = 1 To l
      c2(i) = c0(i)
   Next i
   l2 = l
   v2 = v1
   f2 = f1
   a2 = a1
   f1 = 0
   For i = 1 To n
      b1 = e2(i)
      e2(i) = (x(i) - a2) * e2(i) - f2 * d(i)
      d(i) = b1
      f1 = f1 + e2(i) * e2(i)
   Next i
   f1 = Sqr(f1)
   For i = 1 To n
      e2(i) = e2(i) / f1
   Next i
   a1 = 0
   For i = 1 To n
      a1 = a1 + x(i) * e2(i) * e2(i)
   Next i
   c1 = 0
   For i = 1 To n
      c1 = c1 + e2(i) * y(i)
   Next i
   m = m + 1
   i = 0
   lup1:
   ls = m - i
   b2 = b(ls)
   d1 = 0
   If ls > 1 Then d1 = b(ls - 1)
   d1 = d1 - a2 * b(ls) - f2 * a(ls)
   b(ls) = d1 / f1
   a(ls) = b2
   i = i + 1
   If i <> m Then GoTo lup1
   For i = 1 To n
      v(i) = v(i) + e2(i) * c1
   Next i
   For i = 1 To n1
      f(i) = f(i) + b(i) * c1
      c0(i) = f(i)
   Next i
   v0 = 0
   For i = 1 To n
      v0 = v0 + (v(i) - y(i)) * (v(i) - y(i))
   Next i
   v0 = Sqr(v0 / (n - ls - 1))
   ls = m
   If e = 0 Then GoTo lup2
   If Abs(v1 - v0) / v0 < e Then GoTo lup4
   If e * v0 > e * v1 Then GoTo lup4
   v1 = v0
   lup2:
   If m = n1 Then GoTo lup3
   GoTo lup0
   lup3:
   For i = 1 To ls
      c0(i - 1) = c0(i)
   Next i
   c0(ls) = 0
   ls = ls - 1
   d2 = v0
   GoTo lup5
   lup4:
   ls = 0
   v0 = v2
   For i = 1 To ls
      c0(i) = c2(i)
   Next i
   GoTo lup3
   lup5:
   For i = 0 To ls
      c(i) = c0(i)
   Next i
End Sub
bluatigro
Posts: 517
Joined: Apr 25, 2012 10:35
Location: netherlands

Re: PI calc try

Postby bluatigro » Jan 30, 2018 14:21

the code whit intarray's
didn't work
thats why i used strings
counting_pine
Site Admin
Posts: 5902
Joined: Jul 05, 2005 17:32
Location: Manchester, Lancs

Re: PI calc try

Postby counting_pine » Feb 01, 2018 14:58

It looks like arraymulty() is multiplies the decimal portion of a number by m/10, to 'numdigits+1' decimal places.
(e.g. multy("0123", 2) with numdigits=5 gives "002460", like 0.0123 * 2/10 = 0.00246[0...])

But arrayadd() and arraysub() just seem to add/subtract two integer strings.

My math skills are a bit too rusty to easily determine how arctangent() and findpi() work..
frisian
Posts: 234
Joined: Oct 08, 2009 17:25

Re: PI calc try

Postby frisian » Feb 06, 2018 19:56

I have made bluatigro's code working.

Code: Select all

'' BLUATIGRO 30 JAN 2018
'' PI
'' Frisian 3 FEB 2018 made it work.
'' some speedups, tweaks and trimmed output from subs

Dim Shared As Integer numdigits

Sub arraymulty( ByRef inuit As String , ByRef m As Integer )
   Dim As Integer c , p , h
   Dim As String uit
   For p = Len(inuit) To 1 Step -1
      h = Val( Mid( inuit , p , 1 ) ) * m + c
      c = h \ 10
      uit = Str( h Mod 10 ) + uit
   Next p
   uit = Str( c ) + uit
   uit = LTrim (uit, "0") : If uit = "" Then uit = "0"
   inuit = uit
End Sub

Sub arraydiv( ByRef inuit As String , ByRef d As Integer )
   Dim As Integer b , p , h
   Dim As String uit

   If Len(Str(d) ) > Len(Str(inuit) ) Then
      inuit = "0"
      Exit Sub
   End If

   If Str(d) = inuit Then
      inuit = "1"
      Exit Sub
   End If

   For p = 1 To Len(inuit)
      h = Val( Mid( inuit , p , 1 ) ) + b * 10
      b = h Mod d
      uit += Str(h \ d)
   Next p
   uit = LTrim (uit, "0") : If uit = "" Then uit = "0"
   inuit = uit
End Sub

Sub arrayadd( ByRef inuit As String , ByRef ad As String )
   Dim As Integer c , h , p , i , a
   Dim As String uit
   i = Len( inuit )
   a = Len( ad )
   If a < i Then
      ad = String( i - a, "0" ) + ad
   End If
   If a > i Then
      inuit = String( a - i, "0" ) + inuit
   End If
   For p = Len(ad) To 1 Step -1
      h = Val( Mid( inuit , p , 1 ) ) + Val( Mid( ad , p , 1 ) ) + c
      c =  h \ 10
      uit = Str( h Mod 10 ) + uit
   Next p
   uit = Str( c ) + uit
   uit = LTrim (uit, "0") : If uit = "" Then uit = "0"
   inuit = uit
End Sub

Sub arraysub( ByRef inuit As String , ByRef sb As String )

   Dim As Integer b , p , h , i , s
   Dim As String uit
   i = Len( inuit )
   s = Len( sb )
   If s < i Then
      sb = String( i - s, "0" ) + sb
   End If
   If s > i Then
      inuit = "0"
      Exit Sub
   End If
   For p = Len(inuit) To 1 Step -1
      h = Val( Mid( inuit , p , 1 ) ) - Val( Mid( sb , p , 1 ) ) + 10 - b
      b = 1 - (h \ 10)
      uit = Str( h Mod 10 ) + uit
      'If b = 0 Then inuit[p -1 -1] = inuit[p -1 -1] -1
   Next p
   uit = LTrim (uit, "0") : If uit = "" Then uit = "0"
   inuit = uit
End Sub

Sub arctangent( ByRef t As String , ByRef s As String , d As Integer )
   '' arctan = x - x^3/3 + x^5/5 - x^7/7 + x^9/9 ...
   Dim As Integer i, dd = d * d      ', w
   s = "1" + String (numdigits, "0") ' Right( s , numdigits )
   i = 1
   'w = d
   arraydiv s , d
   arrayadd t , s
   Dim As String s1 = s
   Do
      'arraymulty s , i
      'w = d * d
      arraydiv s1 , dd
      i += 2
      'w = i
      s = s1
      arraydiv s , i ' w
      arraysub t , s

      'arraymulty s , i
      'w = d * d
      arraydiv s1 , dd
      i += 2
      'w = i
      s = s1
      arraydiv s , i ' w
      arrayadd t , s

   Loop Until LTrim(s, "0") = ""

End Sub

Function findpi( digits As Integer ) As String

   Dim div As Integer
   numdigits = digits + 5
   Dim As String target
   Dim As String source
   div = 2
   arctangent target , source , div
   div = 3
   arctangent target , source , div
   arraymulty target , 4
   Return Left(target, 1) + "." + Mid(target ,2, digits)
End Function

Print findpi( 314 )
Sleep
End

The code by bluatigro is based on strings and works on one digit at the time. This not very effective and slow.
So I have created a program to use uinteger array's, making it possible to process 9 digits at the same time.
The calculations are all done as unsigned integers what help to speed up things.
Works with FB 32 bit, works even slightly faster in 64 bit version.

Code: Select all

' array(0) = lsb, array(l1) = msb.
' using UInteger<32> array's (32 bit), result in UInteger<64> (64 bit).
' very little errror checking.
' the multiply routine ignores the last carry (= 3).
' the routine's work only for positive numbers.
' replaced all [U]Integer with [U]Integer<32> and all UlongInt with Uinteger<64>

Const As UInteger<32> big_base = 1000000000   ' 10^9
Dim Shared As UInteger<32> l1

Sub a_mul(arr1() As UInteger<32>, m As UInteger<32>)

   Dim As UInteger<32> c, i
   Dim As UInteger<64> tmp
   For i = 0 To l1
      tmp = CULngInt(m) * arr1(i) + c
      c = tmp \ big_base
      arr1(i) = tmp Mod big_base
   Next

End Sub

Sub a_div(arr() As UInteger<32>, d As UInteger<32>)

   Dim As UInteger<32> b, l = Len(Str(big_base) ) -1, start
   Dim As Integer<32> i
   Dim As UInteger<64> tmp

   If d = 0 Then
      Print "error: divisor = 0"
      Sleep 5000
      End
   End If

   For i = l1 To 0 Step -1
      tmp = CULngInt(arr(i) ) + CULngInt(b) * big_base
      b = tmp Mod d
      arr(i) = tmp \ d
   Next

End Sub

Sub a_add(arr1() As UInteger<32>, arr2() As UInteger<32>)

   Dim As UInteger<32> c, i
   Dim As UInteger<64> tmp

   For i = 0 To l1
      tmp = CULngInt(arr1(i) ) + arr2(i) + c
      c = tmp \ big_base
      arr1(i) = tmp Mod big_base
   Next
   ' last carry should be zero
   If c <> 0 Then
      Print "something went wrong"
      Sleep 5000
      End
   End If

End Sub

Sub a_sub(arr1() As UInteger<32>, arr2() As UInteger<32>)

   Dim As UInteger<32> b
   Dim As Integer<32> i
   Dim As UInteger<64> tmp

   For i = 0 To l1
      tmp = CULngInt(arr1(i) ) - arr2(i) + big_base - b
      b = 1 - (tmp \ big_base)
      arr1(i) = tmp Mod big_base
   Next

End Sub

Sub arc_tan(arr1() As UInteger<32>, d As UInteger<32>)
   ' if d > 65535 use arc_tan_xl
   Dim As UInteger<32> x, tmp, i = 1, dd = d * d
   Dim As UInteger<32> arr2(l1), arr_help(l1)
   arr_help(l1) = big_base

   a_div(arr_help(), d)
   a_add(arr1(), arr_help() )

   Do
      a_div(arr_help(), dd)
      i += 2
      ' copy arr_help into arr2
      For x = 0 To l1
         arr2(x) = arr_help(x)
      Next
      a_div(arr2(), i)
      a_sub(arr1(), arr2() )
      a_div(arr_help(), dd)
      i += 2
      ' copy arr_help into arr2
      For x = 0 To l1
         arr2(x) = arr_help(x)
      Next
      a_div(arr2(), i)
      a_add(arr1(), arr2() )

      For x = 0 To l1
         If arr2(x) <> 0 Then Continue Do
      Next
      ' we get here only if arr2 is filled with zero's ("0")
      Exit Do
   Loop

End Sub

Sub arc_tan_xl(arr1() As UInteger<32>, d As UInteger<32>)
   Dim As UInteger<32> x, tmp, i = 1
   Dim As UInteger<32> arr2(l1), arr_help(l1)
   arr_help(l1) = big_base

   a_div(arr_help(), d)
   a_add(arr1(), arr_help() )

   Do
      a_div(arr_help(), d)
      a_div(arr_help(), d)
      i += 2
      ' copy arr_help into arr2
      For x = 0 To l1
         arr2(x) = arr_help(x)
      Next
      a_div(arr2(), i)
      a_sub(arr1(), arr2() )
      a_div(arr_help(), d)
      a_div(arr_help(), d)
      i += 2
      ' copy arr_help into arr2
      For x = 0 To l1
         arr2(x) = arr_help(x)
      Next
      a_div(arr2(), i)
      a_add(arr1(), arr2() )

      For x = 0 To l1
         If arr2(x) <> 0 Then Continue Do
      Next
      ' we get here only if arr2 is filled with zero's ("0")
      Exit Do
   Loop

End Sub

Function find_pi_first(digits As UInteger<32>) As String
   ' pi = 4 * (arctan(1/2) + arctan(1/3) )
   Dim As UInteger<32> l = Len(Str(big_base) ) -1
   Dim As Integer<32> d
   Dim As String str_out, fill = String(l, "0")
   l1 = Int(digits / l) + 2
   Dim As UInteger<32> arr_one(l1)

   arc_tan(arr_one(), 2)
   arc_tan(arr_one(), 3)
   a_mul(arr_one(), 4)

   For d = l1 To 0 Step -1
      str_out += Right(fill + Str(arr_one(d) ), l)
   Next

   str_out = LTrim(str_out,"0")

   Return "3." + Left (str_out, digits)

End Function

Function find_pi_second(digits As UInteger<32>) As String
   ' pi = 4 * (4 * arctan(1/5) - arctan(1/239) )
   Dim As UInteger<32>  l = Len(Str(big_base) ) -1
   Dim As Integer<32> d
   Dim As String str_out, fill = String(l, "0")
   l1 = Int(digits / l) + 2
   Dim As UInteger<32> arr_one(l1), arr_two(l1)

   arc_tan(arr_two(), 239)            ' store arctan(1/239)
   arc_tan(arr_one(), 5)              ' arctan(1/5)
   ' this works because the result is smaller then 1
   a_mul(arr_one(), 4)                ' 4 * arctan(1/5)
   a_sub(arr_one(), arr_two() )       ' 4 * arctan(1/5) - arctan(1/239)
   a_mul(arr_one(), 4)                ' multiply with 4 to get pi

   For d = l1 To 0 Step -1
      str_out += Right(fill + Str(arr_one(d) ), l)
   Next

   str_out = LTrim(str_out,"0")

   Return "3." + Left (str_out, digits)

End Function

Function find_pi_third(digits As UInteger<32>) As String
   ' pi = 4 * (arctan(1/2) + arctan(1/5) + arctan(1/8) )
   Dim As UInteger<32> l = Len(Str(big_base) ) -1
   Dim As Integer<32> d
   Dim As String str_out, fill = String(l, "0")
   l1 = Int(digits / l) + 2
   Dim As UInteger<32> arr_one(l1)

   arc_tan(arr_one(), 2)
   arc_tan(arr_one(), 5)
   arc_tan(arr_one(), 8)
   a_mul(arr_one(), 4)

   For d = l1 To 0 Step -1
      str_out += Right(fill + Str(arr_one(d) ), l)
   Next

   str_out = LTrim(str_out,"0")

   Return "3." + Left (str_out, digits)

End Function


Function find_pi_fourth(digits As UInteger<32>) As String
   ' pi = 4 * (12 * arctan(1/18) + 8 * arctan(1/57) - 5 * arctan(1/239) )
   Dim As UInteger<32> l = Len(Str(big_base) ) -1
   Dim As Integer<32> d
   Dim As String str_out, fill = String(l, "0")
   l1 = Int(digits / l) + 2
   Dim As UInteger<32> arr_one(l1), arr_two(l1), arr_three(l1)

   arc_tan(arr_one(), 18)              ' arctan(1/18)
   a_mul(arr_one(), 12)                ' 12 * arctan(1/18)

   arc_tan(arr_two(), 57)              ' arctan(1/57)
   a_mul(arr_two(), 8)                 ' 8 * arctan(1/57)

   arc_tan(arr_three(), 239)           ' arctan(1/239)
   a_mul(arr_three(), 5)               ' 5 * arctan(1/239)

   a_add(arr_one(), arr_two() )        ' 12 * arctan(1/18) + 8 * arctan(1/57)
   a_sub(arr_one(), arr_three() )      ' 12 * arctan(1/18) + 8 * arctan(1/57) - 5 * arctan(1/239)
   a_mul(arr_one(), 4)                 ' multiply with 4 to get pi

   For d = l1 To 0 Step -1
      str_out += Right(fill + Str(arr_one(d) ), l)
   Next

   str_out = LTrim(str_out,"0")

   Return "3." + Left (str_out, digits)

End Function

Function find_pi_fifth(digits As UInteger<32>) As String
   'pi = 4 * (12 * arctan(1/49) + 32 * arctan(1/57) - 5 * arctan(1/239) + 12 * arctan(1/110443) )
   Dim As UInteger<32> l = Len(Str(big_base) ) -1
   Dim As Integer<32> d
   Dim As String str_out, fill = String(l, "0")
   l1 = Int(digits / l) + 2
   Dim As UInteger<32> arr_one(l1), arr_two(l1), arr_three(l1), arr_four(l1)

   arc_tan(arr_one(), 49)              ' arctan(1/49)
   a_mul(arr_one(), 12)                ' 12 * arctan(1/49)

   arc_tan(arr_two(), 57)              ' arctan(1/57)
   a_mul(arr_two(), 32)                ' 32 * arctan(1/57)

   arc_tan(arr_three(), 239)           ' arctan(1/239)
   a_mul(arr_three(), 5)               ' 5 * arctan(1/239)
   ' the number becomes to great for d * d, need to use arc_tan_xl
   arc_tan_xl(arr_four(), 110443)      ' arctan(1/110443)
   a_mul(arr_four(), 12)               ' 12 * arctan(1/110443)

   a_add(arr_one(), arr_two() )        ' 12 * arctan(1/49) + 32 * arctan(1/57)
   a_sub(arr_one(), arr_three() )      ' 12 * arctan(1/49) + 32 * arctan(1/57) - 5 * arctan(1/239)
   a_add(arr_one(), arr_four() )       ' 12 * arctan(1/49) + 32 * arctan(1/57) - 5 * arctan(1/239) + 12 * arctan(1/110443)
   a_mul(arr_one(), 4)                 ' multiply with 4 to get pi

   For d = l1 To 0 Step -1
      str_out += Right(fill + Str(arr_one(d) ), l)
   Next

   str_out = LTrim(str_out,"0")

   Return "3." + Left (str_out, digits)

End Function

'-----= MAIN =-----
Dim As UInteger<32> digit = 314

Print "pi = 4 * (arctan(1/2) + arctan(1/3) )"
Print find_pi_first(digit)
Print

Print "pi = 4 * (4 * arctan(1/5) - arctan(1/239) )"
Print find_pi_second(digit)
Print

Print "pi = 4 * (arctan(1/2) + arctan(1/5) + arctan(1/8) )"
Print find_pi_third(digit)
Print

Print "pi = 4 * (12 * arctan(1/18) + 8 * arctan(1/57) - 5 * arctan(1/239) )"
Print find_pi_fourth(digit)
Print

Print "pi = 4 * (12 * arctan(1/49) + 32 * arctan(1/57) - 5 * arctan(1/239) + 12 * arctan(1/110443) )"
Print find_pi_fifth(digit)


Print : Print "All Done"
Sleep
End


Edit: updated both the code files, small changes.
Last edited by frisian on Feb 10, 2018 22:58, edited 1 time in total.
counting_pine
Site Admin
Posts: 5902
Joined: Jul 05, 2005 17:32
Location: Manchester, Lancs

Re: PI calc try

Postby counting_pine » Feb 07, 2018 12:57

Cool! How did you fix the code? Did you find out what was wrong with it?
frisian
Posts: 234
Joined: Oct 08, 2009 17:25

Re: PI calc try

Postby frisian » Feb 10, 2018 23:12

@counting_pine
I hope this will answer the questions that you have about this program.

bluetigro listing with minimal changes, working but slow.

Code: Select all

'' BLUATIGRO 30 JAN 2018
'' PI
'' frisian 9 feb 2018 minimal changes to get program working

Dim Shared As Integer numdigits
Const As String z10 = "0000000000"
Const As String z100 = z10+z10+z10+z10+z10+z10+z10+z10+z10+z10

Sub arraymulty( ByRef inuit As String , ByRef m As Integer )
   Dim As Integer c , p , h
   Dim As String uit
   ''' for p = numdigits to 0 step -1
   For p = numdigits To 1 Step -1
      h = Val( Mid( inuit , p , 1 ) ) * m + c
      c = Int( h / 10 )
      uit = Str( h Mod 10 ) + uit
   Next p
   inuit = uit
End Sub

Sub arraydiv( ByRef inuit As String , ByRef d As Integer )
   Dim As Integer b , p , h
   Dim As String uit
   ''' for p = 0 to numdigits
   For p = 1 To numdigits
      h = Val( Mid( inuit , p , 1 ) ) + b * 10
      b = h Mod d
      uit += Str( Int( h / d ) )
   Next p
   inuit = uit
End Sub

Sub arrayadd( ByRef inuit As String , ByRef ad As String )
   Dim As Integer c , h , p , i , a
   Dim As String uit
   i = Len( inuit )
   a = Len( ad )
   If a < i Then
      ad = Right( z100 , i - a ) + ad
   End If
   If a > i Then
      inuit = Right( z100 , a - i ) + inuit
   End If
   ''' for p = len( ad ) to 1 step -1
   For p = numdigits To 1 Step -1
      h = Val( Mid( inuit , p , 1 ) ) + Val( Mid( ad , p , 1 ) ) + c
      c = Int( h / 10 )
      uit = Str( h Mod 10 ) + uit
   Next p
   inuit = uit
End Sub

Sub arraysub( ByRef inuit As String , ByRef sb As String )
   Dim As Integer b , p , h , i , s
   Dim As String uit
   i = Len( inuit )
   s = Len( sb )
   If s < i Then
      sb = Left( z100 , i - s ) + sb
   End If
   If s > i Then
      inuit = Left( z100 , s - i ) + inuit
   End If
   ''' for p = len( inuit ) to 0 step -1
   For p = numdigits To 1 Step -1
      ''' h = val( mid( inuit , p , 1 ) ) - val( mid( sb , p , 1 ) ) + 10
      h = Val( Mid( inuit , p , 1 ) ) - Val( Mid( sb , p , 1 ) ) + 10 - b
      ''' b = int( h / 10 )
      b = 1 - Int( h / 10 )
      uit = Str( h Mod 10 ) + uit
   Next p
   inuit = uit
End Sub

Function arrayzero( ByRef inuit As String ) As Integer
   Dim As Integer p
   For p = 1 To 9
      If InStr( inuit , Str( p ) ) Then Return 0
   Next p
   Return 1
End Function

Sub arctangent( ByRef t As String , ByRef s As String , d As Integer )
   '''  '' arctan = x + x^3/3 + x^7/7 ...
   ' arctan = x - x^3/3 + x^5/5 - x^7/7 + x^9/9 ...
   Dim As Integer w , i
   ''' s = "1" + right( s , len( s ) - 1 )
   s = "1" + String(numdigits -1, "0")
   i = 1
   w = d
   arraydiv s , w
   arrayadd t , s
   Do
      arraymulty s , i
      w = d * d
      arraydiv s , w
      i += 2
      w = i
      arraydiv s , w
      arraysub t , s
      arraymulty s , i
      w = d * d
      arraydiv s , w
      i += 2
      w = i
      arraydiv s , w
      arrayadd t , s
   Loop Until arrayzero( s )
End Sub

Function findpi( digits As Integer ) As String
   Dim index As Integer
   Dim div As Integer
   numdigits = digits +5 ''' + 2
   Dim target As String
   Dim source As String
   div = 2
   arctangent target , source , div
   div = 3
   arctangent target , source , div
   arraymulty target , 4
   ''' return "3." + target
   Return Left(target, 1) + "." + Mid(target, 2, digits)
End Function

Print findpi( 60 )
Sleep
End

Checking every subroutine for returning the correct result was in this case the easiest option since all the routine's are small and easy to understand what the result should be.
The for next loop should be from 1 to numdigits or from numdigits to 1 step -1 and not taking the length of the input strings.
Testing the array[mult|div|add] showed that they returned the correct results.
The arraysub routine returned the wrong answer, while checking I noticed that b was set (b = int( h / 10 )) but it result wasn't used, after some pen and paper work that showed that (7 - 5 + 10 = 12) results in b = 1 and (5 - 7 + 10 = 8) results in b = 0, in case of b = 0 we need to borrow 1 from the digit left of the digit we work on.
Ex. if b = 0 then inuit[p -1 -1]= inuit[p -1 -1] -1, what can go wrong if inuit[p -1 -1] = 0 then we get a negative number
After some tinkering and checking I found that b = 1 - Int( h / 10 ) would do the trick. b = 0 when there's no need for a borrow and b = 1 if we need to borrow.
Arrayzero is straight forward returning a 1 if there are only 0's (zero's) in input string
Running the program still gave the wrong answer.
Starting checking arctangent the first I noticed was that formula give for arctan was wrong, inserting the correct formula and checking the routine with the correct formula showed that routune was correct.
The only odd thing was that s was divived with i and later multiplied with i to get the "original" value back, the whole do loop could be optimized with out this, and be more precise.
Doing some printing of the variables while running the program revealed that the first time arctanget is called, t and s are empty resulting in s being 1 instead of being 1000...000, the second time t has a value and s contains only 0's.
Changing the way s is set by "1" + String(numdigits -1, "0") and running gave the result "3.31415...", so the returning string had to be reformatted as well.

Some remark.
The x = Int( y / 10 ) should be changed in x = y \ 10, integer division (\) instead of the floating point division (\)
Changes numdigits = digits +2 into digits +5 in some occasions +2 was not enough
Strings aren't the best way for doing calculations because the conversion that has to be done (Str <> Val),
a array of [U]byte's would be better or accesesing the string by index (string[index]).
The arctangent routine should be rewritten to get rid off the multiplying of s by i, also repeating w = d * d in the loop is not very effective.
String z10 and z100 will work but it would be better to replace them with string(x, "0")
In the arrayadd and arraysub the inout string is always bigger then [ad|sb] string, therefore padding the inout string is not needed

In the first conversion I did things a little different, I had trouble with the 0's in front of the numbers, in the above version it doesn't matter if there are 0's in front of the numbers.

I also made some small changes in the 2 programs I posted earlier in this thread.
counting_pine
Site Admin
Posts: 5902
Joined: Jul 05, 2005 17:32
Location: Manchester, Lancs

Re: PI calc try

Postby counting_pine » Feb 13, 2018 13:43

I see, thanks - a very thorough explanation!
Just a series of minor fixes..

Return to “General”

Who is online

Users browsing this forum: No registered users and 3 guests