PI calc try

[bluatigro]

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]

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]

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]

the code whit intarray's
didn't work
thats why i used strings

[counting_pine]

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]

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.

[counting_pine]

Cool! How did you fix the code? Did you find out what was wrong with it?

[frisian]

@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 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]

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