ReSQL.ru
     
powered by simpleCommunicator - 2.0.53     © 2025 Programmizd 02
Мобильная версия    Контакт    Правила    FAQ    Помощь
Доб. в избранное | Игнор. тему | Прикреп. тему | Пометить прочит. / непрочит. | Фильтр
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Число ПИ
13 сообщений из 88, страница 4 из 4
  4  все
Число ПИ
    #38519260
Alibek B
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Alibek B
Участник
Shocker.ProVariant не есть тип сам по себе, переменная, которая хранится в Variant все равно имеет какой-то конкретный тип
Например Decimal.
...
Рейтинг: 0 / 0
07.01.2014, 23:18
| Ответить | Цитировать | Написать  
Число ПИ
    #38519332
Volodbka
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Volodbka
Участник
Погуглил немного, я то думал что эта программа считает само число ПИ, а она оказывается считает какой-то маленький его отрезок, видимо с помощью id задаётся начальная координата этого отрезка.
...
Рейтинг: 0 / 0
08.01.2014, 01:50
| Ответить | Цитировать | Написать  
Число ПИ
    #38519341
Фотография AndreTM
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
AndreTM
Участник
Ну вы и настрадали тут все

Volodbkaя то думал что эта программа считает само число ПИ, а она оказывается считает...То есть ты стал адаптировать алгоритм, даже не прочитав материал? Даже по-русски? Падаю просто...
http://ru.wikipedia.org/wiki/Формула_Бэйли_—_Боруэйна_—_Плаффа
http://habrahabr.ru/post/179829/

Считает же алгоритм указанную (id) шестнадцатиричную цифру в последовательности числа пи.

Наслаждайтесь, адаптаторы:
 
VBA
Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
112.
113.
114.
115.
116.
117.
118.
119.
120.
121.
122.
123.
124.
125.
126.
127.
128.
129.
130.
131.
132.
133.
134.
135.
136.
137.
138.
139.
140.
141.
142.
143.
144.
145.
' Adapted for VBA
' AndreTM, 2014-01-08

Const NHX = 16
Const eps = 1E-17
Const ntp = 25

Dim tp#(ntp)

'/*
'    This program implements the BBP algorithm to generate a few hexadecimal
'    digits beginning immediately after a given position id, or in other words
'    beginning at position id + 1.  On most systems using IEEE 64-bit floating-
'    point arithmetic, this code works correctly so long as d is less than
'    approximately 1.18 x 10^7.  If 80-bit arithmetic can be employed, this limit
'    is significantly higher.  Whatever arithmetic is used, results for a given
'    position id can be checked by repeating with id-1 or id+1, and verifying
'    that the hex digits perfectly overlap with an offset of one, except possibly
'    for a few trailing digits.  The resulting fractions are typically accurate
'    to at least 11 decimal digits, and to at least 9 hex digits.
'*/

'/*  David H. Bailey     2006-09-08 */

Sub main()

    Dim pid#, s1#, s2#, s3#, s4#
    Dim chx As String * NHX
    Dim id&
    id = 10000

'/*  id is the digit position.  Digits generated follow immediately after id. */
    
    tp_init
    
    s1 = series(1, id)
    s2 = series(4, id)
    s3 = series(5, id)
    s4 = series(6, id)
    pid = 4# * s1 - 2# * s2 - s3 - s4
    pid = pid - CLng(pid) + 1#
    ihex pid, NHX, chx

'    printf (" position = %i\n fraction = %.15f \n hex digits =  %10.10s\n", id, pid, chx);
    MsgBox " position = " & id & vbCrLf & _
        " fraction = " & pid & vbCrLf & _
        " hex digits = " & chx
    
End Sub

Sub tp_init()
'/*  If this is the first call to expm, fill the power of two table tp. */

    tp(0) = 1
    For i = 1 To ntp - 1: tp(i) = 2# * tp(i - 1): Next

End Sub

Sub ihex(x#, NHX&, ByRef chx)
'/*  This returns, in chx, the first nhx hex digits of the fraction of x. */

    Dim i&
    Dim y#
    Const hx = "0123456789ABCDEF"

    y = Abs(x)

    chx = ""
    For i = 0 To NHX - 1
        y = 16# * (y - Fix(y))
        chx = chx & Mid(hx, CLng(y) + 1, 1)
    Next

End Sub

Function series(m&, id&) As Double
'/*  This routine evaluates the series  sum_k 16^(id-k)/(8*k+m)
'    using the modular exponentiation technique. */
    
    Dim k&
    Dim ak#, eps#, p#, s#, t#

    s = 0#

'/*  Sum the series up to id. */

    For k = 0 To id - 1
        ak = 8 * k + m
        p = id - k
        t = expm(p, ak)
        s = s + t / ak
        s = s - CLng(s)
    Next

'/*  Compute a few terms where k >= id. */

    For k = id To id + 100
        ak = 8 * k + m
        t = (16# ^ CDbl(id - k)) / ak
        If t < eps Then Exit For
        s = s + t
        s = s - CLng(s)
    Next
  
    series = s

End Function

Function expm(p As Double, ak As Double) As Double
'/*  expm = 16^p mod ak.  This routine uses the left-to-right binary
'    exponentiation scheme. */
    
    If ak = 1# Then expm = 0#: Exit Function
    
    Dim i&, j&
    Dim p1#, pt#, r#

'/*  Find the greatest power of two less than or equal to p. */

    For i = 0 To ntp - 1
        If tp(i) > p Then Exit For
    Next

    pt = tp(i - 1)
    p1 = p
    r = 1#

'/*  Perform binary exponentiation algorithm modulo ak. */

    For j = 1 To i
        If (p1 >= pt) Then
            r = 16# * r
            r = r - CLng((r / ak) * ak)
            p1 = p1 - pt
        End If
        pt = pt / 2
        If (pt >= 1#) Then
            r = r * r
            r = r - CLng((r / ak) * ak)
        End If
    Next

    expm = r

End Function

...
Рейтинг: 0 / 0
08.01.2014, 02:20
| Ответить | Цитировать | Написать  
Число ПИ
    #38519352
Volodbka
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Volodbka
Участник
Где тут какой id совпадает?
...
Рейтинг: 0 / 0
08.01.2014, 04:04
| Ответить | Цитировать | Написать  
Число ПИ
    #38519422
Volodbka
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Volodbka
Участник
Работает для id =0,1,2

Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
112.
113.
114.
115.
116.
117.
118.
119.
120.
121.
122.
123.
124.
125.
126.
127.
128.
129.
130.
131.
132.
133.
134.
135.
136.
137.
138.
139.
140.
141.
142.
143.
144.
145.
146.
147.
148.
149.
150.
151.
152.
153.
154.
155.
156.
157.
158.
159.
160.
161.
162.
163.
164.
Const NHX = 16
Const eps = 1E-17
Const ntp = 25

Dim tp#(0 To 25)

'/*
'    This program implements the BBP algorithm to generate a few hexadecimal
'    digits beginning immediately after a given position id, or in other words
'    beginning at position id + 1.  On most systems using IEEE 64-bit floating-
'    point arithmetic, this code works correctly so long as d is less than
'    approximately 1.18 x 10^7.  If 80-bit arithmetic can be employed, this limit
'    is significantly higher.  Whatever arithmetic is used, results for a given
'    position id can be checked by repeating with id-1 or id+1, and verifying
'    that the hex digits perfectly overlap with an offset of one, except possibly
'    for a few trailing digits.  The resulting fractions are typically accurate
'    to at least 11 decimal digits, and to at least 9 hex digits.
'*/

'/*  David H. Bailey     2006-09-08 */

Sub main()

    Dim pid As Double, s1 As Double, s2 As Double, s3 As Double, s4 As Double
    Dim chx As String * 16
    Dim id As Integer
 
    id = 2 'работает при id = 0, 1, 2
'/*  id is the digit position.  Digits generated follow immediately after id. */
    
 
    
    s1 = series(1, id)
    s2 = series(4, id)
    s3 = series(5, id)
    s4 = series(6, id)
    pid = 4# * s1 - 2# * s2 - s3 - s4
    pid = pid - Int(pid) + 1#
    ihex pid, NHX, chx

'    printf (" position = %i\n fraction = %.15f \n hex digits =  %10.10s\n", id, pid, chx);
   MsgBox " position = " & id & vbCrLf & _
       " fraction = " & pid & vbCrLf & _
      " hex digits = " & chx & vbCrLf & _
    " Pi = 3,243F6A8885A308D31319"
    
 
End Sub



Sub ihex(x As Double, NHX As Integer, ByRef chx)
'/*  This returns, in chx, the first nhx hex digits of the fraction of x. */

    Dim i As Integer
    Dim y As Double
    'Const hx = "0123456789ABCDEF"
    hx = Array("0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "A", "B", "C", "D", "E", "F")
    y = Abs(x)

    chx = ""
    For i = 0 To NHX Step 1
        y = 16# * (y - Fix(y))
        chx = chx & hx(Int(y))
    Next

End Sub

   Public Function series(ByVal m As Integer, ByVal id As Integer)
    'Эта процедура оценивает серию sum_k 16 ^ (ID-K) / (8 * K + M)
    'используя модульную технику возведения в степень.
    Dim k As Integer
    Dim ak As Double
    Dim eps As Double
    Dim p As Double
    Dim s As Double
    Dim t As Double
    
    s = 0

    'Суммирует ряд до идентификатора
 
    For k = 0 To id Step 1
        ak = 8 * k + m
        p = id - k
        t = expm(p, ak)
        s = s + t / ak
        s = s - Int(s)
    Next k

    'Вычисляет несколько терминов, где к> = ID.

    For k = id To id + 100 Step 1
            ak = 8 * k + m
            
           't = pow (16., (double) (id - k)) / ak;
            t = 16 ^ (id - k) / ak
            
        If t < eps Then Exit For
        
            s = s + t
            s = s - Int(s)
    Next k
 
    series = s

    End Function


    Public Function expm(ByVal p As Double, ByVal ak As Double)
    'expm = 16 ^ р мод ak. Эта процедура использует бинарную схему
    'возведения в степень слева-направо.

    Dim i As Integer
    Dim j As Integer
    Dim p1 As Double
    Dim pt As Double
    Dim r As Double
    Dim ntp As Double
    
     
    'Если это первый вызов expm, то заполнить массив tp.
    If tp1 <> 1 Then
        tp1 = 1
        tp(0) = 1

            For i = 1 To ntp Step 1
            tp(i) = 2 * tp(i - 1)
            Next i
    End If

    If ak = 1 Then expm = 0

    'Найти наибольшую степень двойки меньше или равной р.
        For i = 0 To ntp Step 1
            If tp(i) > p Then
            i = 1
            Exit Function
            End If
        Next i
            
            pt = tp(i - 1)
            p1 = p
            r = 1
    
    'Выполняет бинарный алгоритм возведения в степень по модулю ак.
    For j = 1 To i Step 1
        If p1 >= pt Then
            r = 16 * r
            r = r - Int(r / ak) * ak
            p1 = p1 - pt
        End If
 
    pt = 0.5 * pt
  
        If pt >= 1 Then
            r = r * r
            r = r - Int(r / ak) * ak
        End If
    Next j

    expm = r

End Function
...
Рейтинг: 0 / 0
08.01.2014, 11:34
| Ответить | Цитировать | Написать  
Число ПИ
    #38535303
Vova Melnikov 888
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Vova Melnikov 888
Гость
Volodbka,
Эти две строки заставляют считовать из файлов в скобках код и встальять код программы
...
Рейтинг: 0 / 0
23.01.2014, 11:02
| Ответить | Цитировать | Написать  
Число ПИ
    #38536056
Volodbka
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Volodbka
Участник
Вот что есть на сегодняшний день, это следующий код. Он конечно не рабочий, но есть небольшие зацепки и возникает понимание как он работает. Закрыл часть кода в комментарии. И исправил одну строчку в функции series#
For k = 0 To id + 100 Step 1
а должно быть что-то типа
For k = id To id + 100 Step 1
Благодаря этому стало понятно, что первый цикл формирует базисный результат, а вот второй цикл формирует текущий результат. Кажется, что они похожи, только первый цикл видимо более тщательно считает.
Следовательно надо научить работать первый цикл, он ссылается на функцию, то есть вполне вероятно что ошибка может находится и там.
Полагаю, удастся не заморачиваясь на специальных функциях заставить код работать.
Данный код будет выдавать при введение числа id результат верный для первых чисел.

Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
112.
113.
114.
115.
116.
117.
118.
119.
120.
121.
122.
123.
124.
125.
126.
127.
128.
129.
130.
131.
132.
133.
134.
135.
136.
137.
138.
139.
140.
141.
142.
143.
144.
145.
146.
147.
148.
149.
150.
151.
152.
153.
154.
155.
156.
157.
158.
159.
160.
161.
162.
163.
164.
165.
166.
167.
168.
169.
170.
171.
172.
173.
174.
175.
Option Explicit

Const NHX = 16
Const eps = 1E-17
Const ntp = 25 '

Dim tp#(0 To 25)
Const id = 5

'Dim ak As Double


'/*
'    This program implements the BBP algorithm to generate a few hexadecimal
'    digits beginning immediately after a given position id, or in other words
'    beginning at position id + 1.  On most systems using IEEE 64-bit floating-
'    point arithmetic, this code works correctly so long as d is less than
'    approximately 1.18 x 10^7.  If 80-bit arithmetic can be employed, this limit
'    is significantly higher.  Whatever arithmetic is used, results for a given
'    position id can be checked by repeating with id-1 or id+1, and verifying
'    that the hex digits perfectly overlap with an offset of one, except possibly
'    for a few trailing digits.  The resulting fractions are typically accurate
'    to at least 11 decimal digits, and to at least 9 hex digits.
'*/

'/*  David H. Bailey     2006-09-08 */

Sub main()
'DoEvents
    Dim pid As Double, s1 As Double, s2 As Double, s3 As Double, s4 As Double
    Dim chx As String * 16
  '  Dim id As Integer
 
 '   id = 3 '&#240;&#224;&#225;&#238;&#242;&#224;&#229;&#242; &#239;&#240;&#232; id = 0, 1, 2
'/*  id is the digit position.  Digits generated follow immediately after id. */
    
 
    
    s1 = series(1, id)
    s2 = series(4, id)
    s3 = series(5, id)
    s4 = series(6, id)
    pid = 4# * s1 - 2# * s2 - s3 - s4
    pid = pid - Int(pid) + 1#
    ihex pid, NHX, chx

'    printf (" position = %i\n fraction = %.15f \n hex digits =  %10.10s\n", id, pid, chx);
   MsgBox " position = " & id & vbCrLf & _
       " fraction = " & pid & vbCrLf & _
      " hex digits = " & chx & vbCrLf & _
    " Pi = 3,243F6A8885A308D31319"
 
End Sub



Sub ihex(x As Double, NHX As Integer, ByRef chx)
'/*  This returns, in chx, the first nhx hex digits of the fraction of x. */

    Dim i As Integer
    Dim y As Double
    Dim hx
    'Const hx = "0123456789ABCDEF"
   hx = Array("0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "A", "B", "C", "D", "E", "F")
    y = Abs(x)

    chx = ""
    For i = 0 To NHX - 1 Step 1
        y = 16# * (y - Fix(y))
        chx = chx & hx(Int(y))
    Next

End Sub

   Public Function series#(ByVal m As Integer, ByVal id As Integer)
    '&#221;&#242;&#224; &#239;&#240;&#238;&#246;&#229;&#228;&#243;&#240;&#224; &#238;&#246;&#229;&#237;&#232;&#226;&#224;&#229;&#242; &#241;&#229;&#240;&#232;&#254; sum_k 16 ^ (ID-K) / (8 * K + M)
    '&#232;&#241;&#239;&#238;&#235;&#252;&#231;&#243;&#255; &#236;&#238;&#228;&#243;&#235;&#252;&#237;&#243;&#254; &#242;&#229;&#245;&#237;&#232;&#234;&#243; &#226;&#238;&#231;&#226;&#229;&#228;&#229;&#237;&#232;&#255; &#226; &#241;&#242;&#229;&#239;&#229;&#237;&#252;.
    Dim k As Integer
    Dim ak As Double
    'Dim eps As Double
    Dim p As Double
    Dim s As Double
    Dim t As Double
  
    s = 0

    '&#209;&#243;&#236;&#236;&#232;&#240;&#243;&#229;&#242; &#240;&#255;&#228; &#228;&#238; &#232;&#228;&#229;&#237;&#242;&#232;&#244;&#232;&#234;&#224;&#242;&#238;&#240;&#224;
 
   'For k = 0 To id - 1 Step 1
   '    ak = 8 * k + m
    '    p = id - k
   '     t = expm(p, ak)
   '     s = s + t / ak
   '     s = s - Int(s)
   ' Next k

    '&#194;&#251;&#247;&#232;&#241;&#235;&#255;&#229;&#242; &#237;&#229;&#241;&#234;&#238;&#235;&#252;&#234;&#238; &#242;&#229;&#240;&#236;&#232;&#237;&#238;&#226;, &#227;&#228;&#229; &#234;> = ID.

    For k = 0 To id + 100 Step 1
            ak = 8 * k + m
            p = id - k
           't = pow (16., (double) (id - k)) / ak;
        't = Format(CVar(power(id - k)), "0.000000000E+00") / ak
            
            t = (16 ^ (id - k)) / ak
           
        If t < eps Then Exit For
        
            s = s + t
            s = s - Int(s)
   
    Next k
 
    series = s

    End Function


    Public Function expm(ByVal p As Double, ByVal ak As Double)
    'expm = 16 ^ &#240; &#236;&#238;&#228; ak. &#221;&#242;&#224; &#239;&#240;&#238;&#246;&#229;&#228;&#243;&#240;&#224; &#232;&#241;&#239;&#238;&#235;&#252;&#231;&#243;&#229;&#242; &#225;&#232;&#237;&#224;&#240;&#237;&#243;&#254; &#241;&#245;&#229;&#236;&#243;
    '&#226;&#238;&#231;&#226;&#229;&#228;&#229;&#237;&#232;&#255; &#226; &#241;&#242;&#229;&#239;&#229;&#237;&#252; &#241;&#235;&#229;&#226;&#224;-&#237;&#224;&#239;&#240;&#224;&#226;&#238;.

    Dim i As Integer
    Dim j As Integer
    Dim tp1 As Double
    Dim pt As Double
    Dim p1 As Double
    Dim r As Double
    'Dim ntp As Double
    
     
    '&#197;&#241;&#235;&#232; &#253;&#242;&#238; &#239;&#229;&#240;&#226;&#251;&#233; &#226;&#251;&#231;&#238;&#226; expm, &#242;&#238; &#231;&#224;&#239;&#238;&#235;&#237;&#232;&#242;&#252; &#236;&#224;&#241;&#241;&#232;&#226; tp.
    If Val(tp1) = 0 Then
        tp1 = 1
        tp(0) = 1

            For i = 1 To ntp - 1 Step 1
            tp(i) = 2 * tp(i - 1)
            Next i
    End If

    If ak = 1 Then expm = 0

    '&#205;&#224;&#233;&#242;&#232; &#237;&#224;&#232;&#225;&#238;&#235;&#252;&#248;&#243;&#254; &#241;&#242;&#229;&#239;&#229;&#237;&#252; &#228;&#226;&#238;&#233;&#234;&#232; &#236;&#229;&#237;&#252;&#248;&#229; &#232;&#235;&#232; &#240;&#224;&#226;&#237;&#238;&#233; &#240;.
        For i = 0 To ntp - 1 Step 1
            If tp(i) > p Then
            'i = 1
            Exit Function
        
            End If
        Next i
            
            pt = tp(i - 1)
            p1 = p
            r = 1
    
    '&#194;&#251;&#239;&#238;&#235;&#237;&#255;&#229;&#242; &#225;&#232;&#237;&#224;&#240;&#237;&#251;&#233; &#224;&#235;&#227;&#238;&#240;&#232;&#242;&#236; &#226;&#238;&#231;&#226;&#229;&#228;&#229;&#237;&#232;&#255; &#226; &#241;&#242;&#229;&#239;&#229;&#237;&#252; &#239;&#238; &#236;&#238;&#228;&#243;&#235;&#254; &#224;&#234;.
    For j = 1 To i Step 1
        If p1 >= pt Then
            r = 16 * r
            r = r - Int(r / ak) * ak
            p1 = p1 - pt
        End If
 
    pt = 0.5 * pt
  
        If pt >= 1 Then
            r = r * r
            r = r - Int(r / ak) * ak
        End If
    Next j

    expm = r

End Function
...
Рейтинг: 0 / 0
23.01.2014, 20:37
| Ответить | Цитировать | Написать  
Число ПИ
    #38536057
Volodbka
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Volodbka
Участник
Увы, не смог вставить в русской кодировке, сгодится пока и так
...
Рейтинг: 0 / 0
23.01.2014, 20:40
| Ответить | Цитировать | Написать  
Число ПИ
    #38551170
Volodbka
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Volodbka
Участник
Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
112.
113.
114.
115.
116.
117.
118.
119.
120.
121.
122.
123.
124.
125.
126.
127.
128.
129.
130.
131.
132.
133.
134.
135.
136.
137.
138.
139.
140.
141.
142.
143.
144.
145.
146.
147.
Option Explicit

Const NHX = 16
Const eps = 1E-17
Const ntp = 25

Dim tp#(0 To 25)

'Идентификатор положения цифры. Цифры генерируются сразу за идентификатором.
Const id = 5


'Эта программа реализует алгоритм BBP генерирует несколько шестнадцатеричных цифр,
'начиная сразу после заданной позиции ID, или, другими словами, начиная с позиции ID + 1.

'Исходный код: David H. Bailey     2006-09-08

'Адаптировал под семейство "VB" Vladimir-Vladimirko@rambler.ru  05.02.2014

Sub main()

    Dim pid As Double, s1 As Double, s2 As Double, s3 As Double, s4 As Double
    Dim chx As String * 16
    s1 = series(1, id)
    s2 = series(4, id)
    s3 = series(5, id)
    s4 = series(6, id)
    pid = 4# * s1 - 2# * s2 - s3 - s4
    pid = pid - Int(pid) + 1#
    ihex pid, NHX, chx

   MsgBox " position = " & id & vbCrLf & _
      " hex digits = " & chx & vbCrLf & _
      " Pi = 3,243F6A8885A308D31319"
 
End Sub

Sub ihex(x As Double, NHX As Double, ByRef chx)
'Возвращает, в СНХ, первые NHX шестнадцатеричных цифры фракции х
    Dim i As Double
    Dim y As Double

    y = Abs(x)

    chx = ""
    For i = 0 To NHX - 1 Step 1
        y = 16# * (y - Fix(y))
        chx = chx & Hex(Int(y))
    Next

End Sub

   Public Function series#(ByVal m As Double, ByVal id As Double)
    'Эта процедура оценивает серию sum_k 16 ^ (ID-K) / (8 * K + M)
    'используя модульную технику возведения в степень.
    Dim k As Double
    Dim ak As Double
    Dim p As Double
    Dim s As Double
    Dim t As Double
  
    s = 0
    'Суммирует ряд до идентификатора
   
   For k = 0 To id - 1 Step 1
       ak = 8 * k + m
        p = id - k
        t = expm(p, ak)
        s = s + t / ak
        s = s - Int(s)
    Next k

    'Вычисляет несколько терминов, где к> = ID.

    For k = id To id + 100 Step 1
            ak = 8 * k + m
            p = id - k
            t = (16 ^ (id - k)) / ak
           
        If t < eps Then Exit For
            s = s + t
            s = s - Int(s)
    Next k
 
    series = s

    End Function


    Public Function expm(ByVal p As Double, ByVal ak As Double)
    'expm = 16 ^ р мод ak. Эта процедура использует бинарную схему
    'возведения в степень слева-направо.

    Dim i As Double
    Dim j As Double
    Dim tp1 As Double
    Dim pt As Double
    Dim p1 As Double
    Dim r As Double
    
    'Если это первый вызов expm, то заполнить массив tp.
    If Val(tp1) = 0 Then
        tp1 = 1
        tp(0) = 1

            For i = 1 To ntp - 1 Step 1
            tp(i) = 2 * tp(i - 1)
            Next i
    End If

    If ak = 1 Then
    expm = 0
    Exit Function
    End If
    
    'Найти наибольшую степень двойки меньше или равной р.
        For i = 0 To ntp - 1 Step 1
            If tp(i) >= p Then
            i = i + 1
            Exit For
        
            End If
        Next i
            
            pt = tp(i - 1)
            p1 = p
            r = 1
    
    'Выполняет бинарный алгоритм возведения в степень по модулю ак.
    For j = 1 To i Step 1
        If p1 >= pt Then
            r = 16 * r
            r = r - Int(r / ak) * ak
            p1 = p1 - pt
        End If
 
    pt = 0.5 * pt
  
        If pt >= 1 Then
            r = r * r
            r = r - Int(r / ak) * ak
        End If
    Next j
    
    expm = r

End Function
...
Рейтинг: 0 / 0
05.02.2014, 22:26
| Ответить | Цитировать | Написать  
Число ПИ
    #38552684
Volodbka
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Volodbka
Участник
Есть два числа ПИ, взятых из википедии:

- десятичное 3,1415926535897932384626433832795;

- шестнадцатеричное 3,243F6A8885A308D31319.

Как перевести из одной системы счисления в другую и получить корректный результат? Пытался с помощью функций экселя, калькулятора виндовс, вручную не получилось.

Брешут янки!
...
Рейтинг: 0 / 0
07.02.2014, 00:47
| Ответить | Цитировать | Написать  
Число ПИ
    #38552721
Фотография AndreTM
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
AndreTM
Участник
Онлайн-калькулятором не пробовал воспользоваться?
...
Рейтинг: 0 / 0
07.02.2014, 02:12
| Ответить | Цитировать | Написать  
Число ПИ
    #38552727
Казанский
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Казанский
Гость
Формула Excel для перевода ДРОБНОЙ ЧАСТИ 16-ричной дроби в десятичную

=СУММПРОИЗВ(ШЕСТН.В.ДЕС(ПСТР(A1;СТРОКА(1:15);1));16^-СТРОКА(1:15))

"243F6A8885A308D31319" -> 0,141592653589793
...
Рейтинг: 0 / 0
07.02.2014, 02:30
| Ответить | Цитировать | Написать  
Число ПИ
    #38554045
Volodbka
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Volodbka
Участник
Спасибо всё работает!
От десятичной запятой я такого не ожидал, буду потихоньку разбираться :)
...
Рейтинг: 0 / 0
07.02.2014, 19:38
| Ответить | Цитировать | Написать  
13 сообщений из 88, страница 4 из 4
  4  все
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Число ПИ
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
Польз. соглашение
NoSQL.ru       Новости, Чат       Фотоальбом: Участники, Встречи
Закрыть
start [/forum/topic.php?fid=60&msg=38536056&tid=2156529]:
 0ms
get settings:
 8ms
get forum list:
 11ms
check forum access:
 2ms
check topic access:
 2ms
track hit:
 41ms
get topic data:
 10ms
get forum data:
 3ms
get page messages:
 52ms
get tp. blocked users:
 1ms
others: 19ms
total:  149ms
созд. / загр.: 149ms
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]