Spoiler anzeigen
;Übersetzung FORTRAN => AutoIt by Andy
;Verfahren: http://www.unet.univie.ac.at/~a8727063/Science/BBP/
;
;Beispiele in FORTRAN;
;http://www.unet.univie.ac.at/~a8727063/Science/BBP/bbp.f90 bzw.
;http://www.unet.univie.ac.at/~a8727063/Science/BBP/bbpI2R4.f90
;
;errechnet die n-te Dezimalstelle von PI als HEX-Ziffer
;vgl. Tabelle der Ziffern bis 5000
;http://books.google.de/books?id=mchJC…tabelle&f=false
;~ program bbp
;~ implicit none
;~ integer :: i, k, l, n
;~ integer, dimension(4) :: arr1, arr2, arr4
Dim $arrC[4] = [4, -2, -1, -1]
Dim $arr1[4]
Dim $arr2[4]
Dim $arr3[4]
Dim $arr4[4]
;~ real , dimension(4) :: arr3
;~ real :: log2
;log2 = log(2.0)
$log2 = Log(2.0)
$log16 = Log(2.0) * 4
;err = 5q-32
$err = 5 * 10 ^ - 32
;~ print '(a)', &
;~ "+--------------------------------------------------------------------------+",&
;~ "| 'bbp.f90': |",&
;~ "| Fortran90 program implementing the BBP algorithm |",&
;~ "| for computing hex digits of Pi according to |",&
;~ "| http://ams.astro.univie.ac.at/~nendwich/Science/BBP/ |",&
;~ "+--------------------------------------------------------------------------+"
;~ print '(a,i0,a)', " max n: ", (sqrt(real(huge(n)))-5)/8, &
$nmax = Int((Sqrt(2 ^ 63) - 5) / 
;MsgBox(262144,'Debug line ~' & @ScriptLineNumber,'Selection:' & @lf & '$nmax' & @lf & @lf & 'Return:' & @lf & $nmax) ;### Debug MSGBOX
;~ " (otherwise result might be uncorrect)"
;~ print *, "exit program with n < 0"
;do
While 1
;~ write (*,'(a)',advance='no') " n = ? : "
;~ read (*,'(i)') n
$n = InputBox("n-te Stelle von PI", "Gesuchte Ziffer eingeben max=" & $nmax)
;~ if (n<0) exit
If $n <= 0 Or $n > $nmax Then Exit
;~ arr3 = [0.,0.,0.,0.] ! ~ arr2 / arr4
Local $arr3[4] = [0, 0, 0, 0]
;~ do k = 0, n
For $k = 0 To $n
ConsoleWrite('@@ Debug(' & @ScriptLineNumber & ') : $k = ' & $k & @CRLF & '>Error code: ' & @error & @CRLF) ;### Debug Console
;~ l = n - k
$l = $n - $k
;~ arr1 = [4,4,4,4] ! 16^(2^i) mod arr4, init: i = -1
Local $arr1[4] = [4, 4, 4, 4]
;~ arr2 = [1,1,1,1] !
Local $arr2[4] = [1, 1, 1, 1]
;~ arr4 = [1,4,5,6] + 8*k ! 8k+j
Local $arr4[4] = [1 + 8 * $k, 4 + 8 * $k, 5 + 8 * $k, 6 + 8 * $k]
; _arraydisplay($arr4)
;~ if (l/=0) then
If $l <> 0 Then
;~ do i = 0, int(log(l+0.5)/log2)
For $i = 0 To Int(Log($l + 0.5) / $log2)
;~ arr1 = mod(arr1**2,arr4)
$tt0 = Mod($arr1[0] ^ 2, $arr4[0])
$tt1 = Mod($arr1[1] ^ 2, $arr4[1])
$tt2 = Mod($arr1[2] ^ 2, $arr4[2])
$tt3 = Mod($arr1[3] ^ 2, $arr4[3])
Local $arr1[4] = [$tt0, $tt1, $tt2, $tt3]
;~ if (btest(l,i)) arr2 = mod(arr2*arr1,arr4)
If _btest($l, $i) Then
; msgbox(0,"btest 1",Mod($arr2[0] * $arr1[0], $arr4[0]))
$tt0 = Mod($arr2[0] * $arr1[0], $arr4[0])
$tt1 = Mod($arr2[1] * $arr1[1], $arr4[1])
$tt2 = Mod($arr2[2] * $arr1[2], $arr4[2])
$tt3 = Mod($arr2[3] * $arr1[3], $arr4[3])
Local $arr2[4] = [$tt0, $tt1, $tt2, $tt3]
EndIf
;~ end do ! i
Next
;~ end if
EndIf
;~ arr3 = mod(arr3+real(arr2)/arr4,1.0)
$tt0 = Mod($arr3[0] + $arr2[0] / $arr4[0], 1.0)
$tt1 = Mod($arr3[1] + $arr2[1] / $arr4[1], 1.0)
$tt2 = Mod($arr3[2] + $arr2[2] / $arr4[2], 1.0)
$tt3 = Mod($arr3[3] + $arr2[3] / $arr4[3], 1.0)
Local $arr3[4] = [$tt0, $tt1, $tt2, $tt3]
;~ end do ! k
Next
;~ print '(a,i0,a,z1)', "Result: ", k, " th hex digit of pi = ", &
;~ int(16*modulo(dot_product([4.,-2.,-1.,-1.],arr3),1.0))
;~ fsum = modulo(dot_product(arrC,arr3),1.0_rk) ! final sum
$fsum = _modulo(_dot_product($arrC, $arr3), 1.0)
;~ cor = sum(arrC/(arr4+8_ik)) / 16 ! 1st correction
Dim $asum[4]
$asum[0] = $arrC[0] / ($arr4[0] +
$asum[1] = $arrC[1] / ($arr4[1] +
$asum[2] = $arrC[2] / ($arr4[2] +
$asum[3] = $arrC[3] / ($arr4[3] +
$cor = _sum($asum) / 16
;MsgBox(262144,'Debug line ~' & @ScriptLineNumber,'Selection:' & @lf & '$cor' & @lf & @lf & 'Return:' & @lf & $cor) ;### Debug MSGBOX
;~ ester = k * err ! estimated error
$ester = $k * $err
;~ print *, "Final sum = ", fsum ; fsum = 16 * fsum
;~ print *, "Est. err. = ", ester ; l = -1 - log(ester)/log16
; MsgBox(0, "geschätzter Fehler ester=", $ester)
;~ print *, "1st corr. = ", cor
; MsgBox(0, "1. corr", $cor)
;~ write (*,'(a,i0,a/8x,z1)',advance='no') &
;~ "Result: ", k, " th and following hex digits of pi = ", int(fsum)
;~ do i = 2, -log(cor)/log16 ! 16^i * cor = 1.0
$string = ""
For $i = 2 To Int(-Log($cor) / $log16)
;~ if (i==l) write (*,'(" (")',advance='no')
If $i = $l Then $string &= "( "
;~ fsum = 16 * mod(fsum,1.0)
$fsum = 16 * Mod($fsum, 1.0)
;~ write (*,'(z2)',advance='no') int(fsum)
$string &= Hex(Int($fsum), 1) & " "
;~ end do ! i
Next
;~ if (i>l) write (*,'(" )")',advance='no')
If $i > $l And StringInStr($string, "(") Then $string &= ")"
MsgBox(0, $k & " -te hex-ziffer von Pi =", Hex(Int(16 * _Modulo(_dot_product($arrC, $arr3), 1.0)), 1) & @CRLF & @CRLF & "nächste Ziffern (incl.) = " & $string)
[/autoit] [autoit][/autoit] [autoit];end do
[/autoit] [autoit][/autoit] [autoit]WEnd
[/autoit] [autoit][/autoit] [autoit];end program bbp
[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit]Func _dot_product($a, $b)
$vec = 0
For $i = 0 To UBound($a) - 1
$vec += $a[$i] * $b[$i]
Next
Return $vec
EndFunc ;==>_dot_product
Func _btest($a, $pos) ;bittest liefert TRUE, wenn das ($pos-te Bit von $a) = 1 ist
;http://gcc.gnu.org/onlinedocs/gcc-4.1.2/gfortran/BTEST.html
$bit = BitAND(2 ^ 31 - 1, 2 ^ $pos)
If BitAND($a, $bit) Then
Return True
Else
Return False
EndIf
EndFunc ;==>_btest
[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit]Func _modulo($a, $b) ;ir1 - floor(ir1/ir2)*ir2
;http://de.wikibooks.org/wiki/Fortran:_…nktionen#Modulo
Return $a - Floor($a / $b) * $b
EndFunc ;==>_modulo
Func _sum($e)
$sum = 0
For $i = 0 To UBound($e) - 1
$sum += $e[$i]
Next
Return $sum
EndFunc ;==>_sum
Wer mag, kann das Script so umschreiben, dass die fortlaufenden Ziffern von Pi errechnet werden (die nächsten Ziffern werden mitberechnet!)
