Форум программистов, компьютерный форум, киберфорум
VBA
Войти
Регистрация
Восстановить пароль
 
Рейтинг 5.00/6: Рейтинг темы: голосов - 6, средняя оценка - 5.00
0 / 0 / 1
Регистрация: 08.07.2014
Сообщений: 30
1

Необходимо составить программу для извлечения точного квадратного корня из n-разрядного числа (n > 40)

22.06.2015, 11:16. Просмотров 1098. Ответов 10
Метки нет (Все метки)

Прошу помощи в составлении программы для извлечения точного квадратного корня из n-разрядного числа (n > 40).
0
Лучшие ответы (1)
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
22.06.2015, 11:16
Ответы с готовыми решениями:

Составить программу извлечения точного квадратного корня из n-разрядного числа (n > 40)
Составить программу извлечения точного квадратного корня из n-разрядного числа (n > 40).

Извлечение точного квадратного корня из n-разрядного числа
Составить программу извлечения точного квадратного корня из n-разрядного числа (n > 40)

Алгоритм для извлечения квадратного корня x из вещественного числа y
Составить блок-схему алгоритма для вычисления квадратного корня x из вещественного числа y....

Написать программу, для извлечения квадратного корня из суммы трех чисел, вводимых с клавиатуры
1. Написать программу, для извлечения квадратного корня из суммы трех чисел, вводимых с клавиатуры,...

10
Ушел с CyberForum совсем!
871 / 180 / 25
Регистрация: 04.05.2011
Сообщений: 1,020
Записей в блоге: 110
22.06.2015, 12:07 2
Цитата Сообщение от Vovikus Посмотреть сообщение
Прошу помощи
чем могу ?
0
5502 / 1330 / 146
Регистрация: 08.02.2009
Сообщений: 4,051
Записей в блоге: 29
22.06.2015, 19:52 3
Очевидно, нужно запрограммировать метод вычисления столбиком (http://ru.wikipedia.org/wiki/К... 0.BE.D0.BC)?
1
14936 / 6335 / 1724
Регистрация: 24.09.2011
Сообщений: 9,977
23.06.2015, 00:23 4
Vovikus, 28 разрядов не устроит?
Получить корень из двух в формате Decimal
1
5502 / 1330 / 146
Регистрация: 08.02.2009
Сообщений: 4,051
Записей в блоге: 29
23.06.2015, 03:28 5
Не самый точный, но зато красивый код Апострофф’а: Написать программу для вычисления квадратного корня.

Теоретическая основа: ru.wikipedia.org/wiki/Итерационная_формула_Герона (Александрия, I век н. э.).

Пикантность темы в том, что тип не числовой, а строковый. Даже боюсь углубиться.
1
0 / 0 / 1
Регистрация: 08.07.2014
Сообщений: 30
23.06.2015, 12:04  [ТС] 6
Спасибо,щас под максрос подгоню только.

Добавлено через 17 минут
Так же программа должна проверять количество разрядов если n<40 то введено неверное число,если n>40 то считать.

Добавлено через 1 час 34 минуты
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Function sqrt(ByVal a As Double) As Double
sqrt = a
Dim a As Double
'a = InputBox("vvedite chislo")
'a = Split(text, ",")
Do
  sqrt = (sqrt + a / sqrt) / 2
Loop While sqrt <> (sqrt + a / sqrt) / 2
MsgBox (a)
End Function
 
Sub qwertyy()
Dim a, b As String
Dim c As Integer
a = InputBox("vvedite chislo")
b = Split(a, ".")
MsgBox Len(b)
'c = Val(Len(a))
'If c < 40 Then ActiveCell.Value = "net" Else: ActiveCell.FormulaR1C1 = "=sqrt()"
 
'MsgBox Len(a)
 
 
End Sub
Считать не хочет количество цифр после точки
0
6063 / 1307 / 194
Регистрация: 12.12.2012
Сообщений: 1,023
23.06.2015, 17:16 7
Vovikus, количество цифр после точки - это длина строки минус позиция точки.
Установив позицию точки, замените ее на пустую строку - это будет равносильно умножению числа на 10 в степени, равной количеству цифр после точки. Если эта степень не четна, умножьте число еще на 10 (справа припишите еще нолик).
После извлечения корня делим число на 10 в степени, равной половине количества цифр после точки с округлением вверх - это и будет исходный результат. Деление производится смещением точки с самой правой позиции на нужное число разрядов влево.

Аналогичный подход можно использовать, чтобы извлекать с высокой точностью корни малых чисел. Например, умножив двойку на 10 в 100 степени и извлекая корень, мы получаем значение корня, равное:

1.41421356237309504880168872420969807856967187537694

Для сравнения, результат калькулятора Windows:

1,4142135623730950488016887242097

Добавлено через 2 часа 28 минут
Мне тут в личку поступил вопрос по извлечению корня из вещественного числа 12345.6789 с точностью до 100 знаков после разделителя...

Объясняю, как я бы поступил в данной ситуации:
  1. Посчитал бы количество цифр после точки. В данном случае оно равно 4.
  2. Стер бы точку и приписал бы справа 2 * 100 - 4 = 196 нулей. Получается результат, эквивалентный тому, как если бы мы умножили число 12345,6789 на десятку, возведенную в двухсотую степень.
  3. Извлек бы квадратный корень из полученного числа, используя метод вычисления в столбик.
  4. Сдвинул бы в результате точку с самой правой позиции на 100 разрядов влево.

Вот полученный результат:

Sqrt(12345.6789) =

= 111.
11111 06055
55554 40541
66614 33534
69245 87840
98601 34351
07145 85706
75251 47147
94963 66736
57913 62863
62080 27570

С уважением,
Аксима
1
0 / 0 / 1
Регистрация: 08.07.2014
Сообщений: 30
24.06.2015, 15:24  [ТС] 8
Спасибо Аксима,но это сплошная теория,а мне надо в программном виде реализовать
0
6063 / 1307 / 194
Регистрация: 12.12.2012
Сообщений: 1,023
24.06.2015, 19:58 9
Лучший ответ Сообщение было отмечено Vovikus как решение

Решение

Vovikus, я понимаю, что это сложно, поэтому делюсь с вами своими наработками
Цитата Сообщение от Vovikus Посмотреть сообщение
в программном виде
Но вам все равно необходимо хорошо знать теорию, чтобы вы могли объяснить преподавателю, что происходит в программе, а также внести изменения в код в случае необходимости.

С уважением,
Аксима
1
Вложения
Тип файла: rar AksiMath.rar (31.6 Кб, 7 просмотров)
Заблокирован
25.06.2015, 15:20 10
Расширил свои древние заготовки по длинной арифметике до вещественных (пока положительных) чисел (в строковом формате).
Буду благодарен за найденные баги (они наверняка есть) и конструктивную критику.
Visual Basic
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
Option Explicit
 
Function sqrt(ByVal a As String) As String
Dim sq$
sqrt = a
Do
  sq = sqrt
  sqrt = div(add(sqrt, div(a, sqrt, 10)), 2, 10)
Loop While sqrt <> sq
End Function
 
'преобразование вещественных в целые с сохранением пропорций и коэффициента-степени 10
Sub Align(a As String, b As String, e As Long)
Dim aa$(), bb$(), ea$, eb$
aa = Split(Trim$(Replace(a, ",", ".")), "."): If UBound(aa) > 0 Then ea = aa(1)
bb = Split(Trim$(Replace(b, ",", ".")), "."): If UBound(bb) > 0 Then eb = bb(1)
While Len(ea) > Len(eb): eb = eb & "0": Wend: While Len(eb) > Len(ea): ea = ea & "0": Wend
e = Len(ea): a = aa(0) & ea: b = bb(0) & eb
End Sub
 
'сложение
Public Function add(ByVal m1 As String, ByVal m2 As String) As String
Dim i As Long, L1 As Long, L2 As Long, e As Long
Dim a() As Byte, b1() As Byte, b2() As Byte
Align m1, m2, e
L1 = Len(m1): L2 = Len(m2)
If L1 > L2 Then
  b1 = "0" & m1: b2 = String$(L1 - L2 + 1, "0") & m2: a = String$(L1 + 1, "0")
Else
  b2 = "0" & m2: b1 = String$(L2 - L1 + 1, "0") & m1: a = String$(L2 + 1, "0")
End If
For i = UBound(a) - 1 To 2 Step -2
  a(i) = a(i) + b1(i) + b2(i) - 96
  If a(i) > 57 Then a(i) = a(i) - 10: a(i - 2) = 49
Next i
If a(0) = 48 Then a(0) = 32
add = Trim$(a)
add = VBA.Left$(add, Len(add) - e) & "." & Mid$(add, Len(add) - e + 1)
  If Right$(add, 1) = "." Then
    add = VBA.Left$(add, Len(add) - 1)
  End If
End Function
 
'вычитание+
Function dif(ByVal m1 As String, ByVal m2 As String) As String
Dim a() As String, e As Long
Dim i1 As Long, i2 As Long, L1 As Long, L2 As Long
  Align m1, m2, e
  L1 = Len(m1): L2 = Len(m2)
  ReDim a(L1)
  For i1 = L1 To 1 Step -1
    If L2 > 0 Then
      a(i1) = Mid$(m1, i1, 1) - Mid$(m2, L2, 1) - i2: L2 = L2 - 1
    Else
      a(i1) = Mid$(m1, i1, 1) - i2
    End If
    If a(i1) < 0 Then
      a(i1) = a(i1) + 10: i2 = 1
    Else
      i2 = 0
    End If
  Next i1
  dif = Join(a, "")
  If e Then
    dif = VBA.Left$(dif, Len(dif) - e) & "." & Mid$(dif, Len(dif) - e + 1)
    While Right$(dif, 1) = "0": dif = Mid$(dif, 1, Len(dif) - 1): Wend
    If Right$(dif, 1) = "." Then dif = VBA.Left$(dif, Len(dif) - 1)
  End If
  a = Split(dif, ".")
  While Len(a(0)) > 1 And VBA.Left$(a(0), 1) = "0"
    a(0) = Mid$(a(0), 2)
  Wend
  If UBound(a) > 0 Then
    If Len(a(1)) Then
      dif = a(0) & "." & a(1)
    End If
  Else
    dif = a(0)
  End If
End Function
 
'умножение+
Function mul(ByVal m1 As String, ByVal m2 As String) As String
Dim a() As String, n As Byte, e As Long
Dim i1 As Long, i2 As Long, L1 As Long, L2 As Long
  Align m1, m2, e
  e = e + e
  L1 = Len(m1): L2 = Len(m2)
  ReDim a(L1 + L2)
  For i2 = L2 To 1 Step -1
    n = Mid$(m2, i2, 1)
    For i1 = L1 To 1 Step -1
      a(i1 + i2) = Val(a(i1 + i2)) + n * Mid$(m1, i1, 1)
      If a(i1 + i2) > 9 Then
        a(i1 + i2 - 1) = Val(a(i1 + i2 - 1)) + a(i1 + i2) \ 10
        a(i1 + i2) = a(i1 + i2) Mod 10
      End If
    Next i1
  Next i2
  mul = Join(a, "")
  If e Then
    mul = VBA.Left$(mul, Len(mul) - e) & "." & Mid$(mul, Len(mul) - e + 1)
    While Right$(mul, 1) = "0": mul = Mid$(mul, 1, Len(mul) - 1): Wend
  End If
  If VBA.Left$(mul, 1) = "." Then mul = "0" & mul
End Function
 
'деление+                                         n& - к-во значащих цифр после запятой
Function div(ByVal m1 As String, ByVal m2 As String, Optional n& = 0) As String
Dim dm As String, a$()
Dim i1 As Long, i2 As Long, L1 As Long, L2 As Long, e As Long
  Align m1, m2, e
  m1 = m1 & String$(n, "0")
  L2 = Len(m2):  L1 = Len(m1)
  dm = Mid$(m1, 1, L2)
  For i1 = 1 To L1 - L2 + 1
    i2 = 0
    While StrCompEx(dm, m2) >= 0
      dm = dif(dm, m2)
      i2 = i2 + 1
    Wend
    If dm = "0" Then dm = ""
    dm = dm & Mid$(m1, L2 + i1, 1)
    div = div & IIf(Len(div) = 0 And i2 = 0, "", i2)
  Next i1
  div = VBA.Left$(div, Len(div) - n) & "." & Mid$(div, Len(div) - n + 1)
  While Right$(div, 1) = "0"
    div = VBA.Left$(div, Len(div) - 1)
  Wend
  If Right$(div, 1) = "." Then
    div = VBA.Left$(div, Len(div) - 1)
  End If
  If VBA.Left$(div, 1) = "." Then div = "0" & div
End Function
 
'Сравнение 2-х положительных целых сверхбольших чисел в строковом формате
Function StrCompEx(m1 As String, m2 As String) As Integer
  StrCompEx = Sgn(Len(m1) - Len(m2))
  If StrCompEx = 0 Then StrCompEx = StrComp(m1, m2)
End Function
С уважением, Апострофф.

Добавлено через 1 минуту

Не по теме:

Спойлеры убраны по просьбам форумчан (не у всех они открываются).

1
0 / 0 / 1
Регистрация: 08.07.2014
Сообщений: 30
26.06.2015, 11:44  [ТС] 11
Visual Basic
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
Function SqrDec(ByVal x)
Dim x1
x1 = CDec(Sqr(x))
x = CDec(x)
Do
    SqrDec = x1
    x1 = (SqrDec + x / SqrDec) / 2
Loop Until SqrDec = x1
End Function
 
 
 
Sub qwertyy()
Dim a, b
Dim c As Integer
a = InputBox("vvedite chislo")
b = Mid(a, 3)
'MsgBox Len(a)
c = Val(a)
If b < 40 Then ActiveCell.Value = "net" Else: ActiveCell.FormulaR1C1 = SqrDec(c)
 
'MsgBox Len(b)
 
 
End Sub
0
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
26.06.2015, 11:44

Заказываю контрольные, курсовые, дипломные и любые другие студенческие работы здесь.

Написать несколько вариантов целочисленного извлечения квадратного корня из натурального числа
Написать несколько вариантов целочисленного извлечения квадратного корня из натурального числа....

Составить программу вычисления значения квадратного корня из числа
2. Скласти програму обчислення значення квадратного кореня з числа а&gt;0 з точністю ,...

Определить функцию для извлечения квадратного корня из эдементов массива
Это всё одно задание ... -.- 1)Определить функцию для извлечения квадратного корня из элементов...

Нужен алгоритм извлечения квадратного корня
Здравствуйте, уважаемые форумчане.Недавно начал изучать C++ и столкнулся с проблемой.Мне...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
11
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2020, vBulletin Solutions, Inc.