0 / 0 / 0
Регистрация: 07.05.2012
Сообщений: 7

Программа для решения уравнений методом Ньютона: улучшить код

17.05.2012, 18:57. Показов 3399. Ответов 4
Метки нет (Все метки)

Студворк — интернет-сервис помощи студентам
Имеется программа для решения уравнений методом Ньютона в VB 6.0.Только в моей проге максимальная степень 5-я которую считает,а попросили сделать,чтобы степень была не ограниченной.Сам тыркался-что-то не получается,почему-то находит ошибку если степени большие(15,20 и т.п).
И заодно чтоб при вводе степени-появлялись окна в которые нужно вводить переменные уравнения-вроде Inputbox надо использовать,но что-то не получается.Помогите плз

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
Dim A#(6), a1#, b1#, x#
    Dim m%, n%
 
    Const eps = 0.01
 
   Private Sub Command1_Click()
   Label4 = "Результат:"
        A(0) = Val(Text2.Text)
        A(1) = Val(Text3.Text)
        A(2) = Val(Text4.Text)
        A(3) = Val(Text5.Text)
        A(4) = Val(Text6.Text)
        A(5) = Val(Text7.Text)
        a1 = Val(Text8.Text)
        b1 = Val(Text9.Text)
        n = Val(Text1.Text)
        Label5 = n & " " & a1 & " " & f(a1): Label6 = b1 & " " & f(b1)
        
        'проверяем на сходимость
        
        If f(a1) * f(b1) >= 0 Then
          MsgBox ("Условие не выполняется!")
        Else
        'ищем начальную точку
        
            If fp2(a1) > 0 Then
            ElseIf f(a1) > 0 Then
                x = a1
            ElseIf f(b1) > 0 Then
                x = b1
            End If
            If fp2(a1) < 0 Then
            ElseIf f(a1) < 0 Then
                x = a1
            ElseIf f(b1) < 0 Then
                x = b1
            End If
            
    'Метод Ньютона
           
            Dim x0#, x1#
            x0 = x
            Label4 = Label4 + Chr(13)
            Do
               'вычисляем приближение
                x1 = x0 - f(x0) / fp(x0)
                Label4 = Label4 + CStr(x1) + Chr(13)
                x0 = x1
            Loop While Abs(f(x0)) > eps Or Abs(x0 - x1) > eps
        End If
    
    
        Picture1.Scale (-150, 150)-(150, -150) 'расположение системы координат и масштаб
         Picture1.Cls
       Picture1.Line (-150, 0)-(150, 0)  'Ось Х
        Picture1.Line (0, -250)-(0, 150)   'Ось Y
        For XX = -150 To 150 Step 30 'Засечки на оси Х
            Picture1.Line (XX, -5)-(XX, 5) 'размер засечек с обеих сторон оси Х
        Next
 
        For Y = -150 To 150 Step 50 'Засечки на Y
            Picture1.Line (-5, Y)-(5, Y)
        Next
        
        nn = Val(Text1.Text)
        a11 = Val(Text3.Text)
        a2 = Val(Text4.Text)
        a3 = Val(Text5.Text)
        a4 = Val(Text6.Text)
        a5 = Val(Text7.Text)
        a0 = Val(Text2.Text)
        
        On Error Resume Next ' Откладываем перехват ошибок.
            Mashtab = 10 ' масштаб графика
           
            For XX = -1.5 * (10 / Mashtab) To 1.5 * (10 / Mashtab) Step 1 / 1000 'Шаг в знач. качества
                
                Y = a0 + a11 * XX + a2 * XX ^ 2 + a3 * XX ^ 3 + a4 * XX ^ 4 + a5 * XX ^ 5
                
               Picture1.Circle (XX * Mashtab, Y * Mashtab), 1
            Next XX
    End Sub
 
Function f(ByVal x As Double) As Double
        f = A(0)
        For i = 1 To n
            f = f + A(i) * x ^ i
            '    f = A(0) + A(1) * x + A(2) * x * x + A(3) * x * x * x + A(4) * x * x * x * x
        Next
        
    End Function
 
Function fp(ByVal x As Double) As Double
        fp = 0
        For i = 1 To n
            fp = fp + i * A(i) * x ^ (i - 1)
            ' Производная   fp = A(1) + 2 * A(2) * x + 3 * A(3) * x * x + 4 * A(4) * x * x * x
        Next
        
    End Function
 
 Function fp2(ByVal x As Double) As Double
        fp2 = 0
        For i = 1 To n
            fp2 = fp2 + (i - 1) * i * A(i) * x ^ (i - 2)
            '  fp2 = 2 * A(2) + 6 * A(3) * x + 12 * A(4) * x * x
        Next
       
    End Function
 
 
  Private Sub Text1_Change()
n = Val(Text1.Text)
        If n < 1 Or n > 5 Then
MsgBox " степень от 1 до 5"
            Text1.SetFocus
        End If
    End Sub
0
cpp_developer
Эксперт
20123 / 5690 / 1417
Регистрация: 09.04.2010
Сообщений: 22,546
Блог
17.05.2012, 18:57
Ответы с готовыми решениями:

Программа для решения квадратных уравнений
Изучаю VB не давно, решил составить прогу для решение кв. уравнений помогите что я не так делаю? Dim a As Integer =...

Программа для вычисления определенного интеграла методом ньютона-лейбница и прямоугольника
Помогите пожалуйста курсовая работа надо сделать ее до 22 мая!!! Срочно помощь!!!!

Написать код для решения транспортной задачи методом минимального элемента
Кто-нибудь помогите написать код для решения транспортной задачи методом минимального элемента. У поставщиков: A1 , A2 , A3 , A4 , A5 ,...

4
6644 / 1511 / 169
Регистрация: 09.01.2010
Сообщений: 4,298
17.05.2012, 19:34
а как коэфициенты вводить для, скажем, 20 степени
0
0 / 0 / 0
Регистрация: 07.05.2012
Сообщений: 7
17.05.2012, 19:44  [ТС]
вот как раз чтобы коэфф вводить мне говорили,что вроде с помощью функции InputBox вроде как-вроде должно всплывать сообщение-введите переменные или что-то типа того.После введения степени и на основании введённой степени
0
Эксперт Hardware
 Аватар для Linoge
3205 / 1915 / 324
Регистрация: 25.10.2011
Сообщений: 5,564
18.05.2012, 09:37
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
Dim A#(), a1#, b1#, x#
Dim m%, n%
Const eps = 0.01
 
Private Sub Command1_Click()
    On Error Resume Next
    Label4 = "Результат:"
    Do
        n = CInt(InputBox("Ââåäèòå n îò 2 äî 20", , 10))
    Loop Until n > 1 And n < 21
    ReDim A(n)
    For i = 0 To n 'èëè n-1
        A(i) = Val(InputBox("Ââåäèòå A(" & i & ")", , 1))
    Next
    
    a1 = Val(InputBox("Ââåäèòå a1"))
    b1 = Val(InputBox("Ââåäèòå b1"))
    
    Label5 = n & " " & a1 & " " & f(a1): Label6 = b1 & " " & f(b1)
        
    'проверяем на сходимость
    If f(a1) * f(b1) >= 0 Then
        MsgBox ("Условие не выполняется!")
    Else
        'ищем начальную точку
        If fp2(a1) > 0 Then
        ElseIf f(a1) > 0 Then
            x = a1
        ElseIf f(b1) > 0 Then
            x = b1
        End If
        
        If fp2(a1) < 0 Then
        ElseIf f(a1) < 0 Then
            x = a1
        ElseIf f(b1) < 0 Then
            x = b1
        End If
            
        'Метод Ньютона
        Dim x0#, x1#
        x0 = x
        Label4 = Label4 + Chr(13)
        Do
            'вычисляем приближение
            x1 = x0 - f(x0) / fp(x0)
            Label4 = Label4 + CStr(x1) + Chr(13)
            x0 = x1
        Loop While Abs(f(x0)) > eps Or Abs(x0 - x1) > eps
        MsgBox x0
    End If
 
    Picture1.Scale (-150, 150)-(150, -150) 'расположение системы координат и масштаб
    Picture1.Cls
    Picture1.Line (-150, 0)-(150, 0)  'Ось Х
    Picture1.Line (0, -250)-(0, 150)  'Ось Y
    For XX = -150 To 150 Step 30 'Засечки на оси Х
        Picture1.Line (XX, -5)-(XX, 5) 'размер засечек с обеих сторон оси Х
    Next
 
    For Y = -150 To 150 Step 50 'Засечки на оси Y
        Picture1.Line (-5, Y)-(5, Y)
    Next
 
    Mashtab = 10 ' масштаб графика
           
    For XX = -1.5 * (10 / Mashtab) To 1.5 * (10 / Mashtab) Step 1 / 1000
        Y = f(XX)
        Picture1.Circle (XX * Mashtab, Y * Mashtab), 1
    Next XX
End Sub
 
Function f(ByVal x As Double) As Double
f = 0
For i = 0 To n
    f = f + A(i) * x ^ i
Next
End Function
 
Function fp(ByVal x As Double) As Double
fp = 0
For i = 1 To n
    fp = fp + i * A(i) * x ^ (i - 1)
Next
End Function
 
Function fp2(ByVal x As Double) As Double
fp2 = 0
For i = 2 To n
    fp2 = fp2 + (i - 1) * i * A(i) * x ^ (i - 2)
Next
End Function
Правильность работы математики не проверял

Добавлено через 14 минут
По графику:
во первых цикл for на double после нескольких десятков значений станет не точным
во вторых проще подогнать размер Picture1 под график от a1 до b1 и от f(a1) до f(b1)
или может придется найти реальные мах и мин на данном отрезке
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
    Picture1.Scale (a1 - 1, f(a1))-(b1 + 1, f(b1)) 
    Picture1.Cls
    Picture1.Line (a1, 0)-(b1, 0)  '??? ?
    Picture1.Line (0, f(a1))-(0, f(b1))   '??? Y
 
           
    For i% = 0 To 10000
        XX = a1 + (b1 - a1) / 10000 * i
        Y = f(XX)
        Picture1.PSet (XX, Y)
    Next
0
0 / 0 / 0
Регистрация: 07.05.2012
Сообщений: 7
20.05.2012, 16:41  [ТС]
Cпасибо))
Кстати,а как сделать,чтобы программа вычисляла не только степенные уравнения,а вообще любого вида с синусами,экспонентой и т.п?!
0
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
raxper
Эксперт
30234 / 6612 / 1498
Регистрация: 28.12.2010
Сообщений: 21,154
Блог
20.05.2012, 16:41
Помогаю со студенческими работами здесь

Исправить код метод Ньютона для решения систем нелинейных уравнений под нужное условие
Данный код для решения системы ax+tg(xy)=0; (y^2-b^2)+lnx=0 Перепишите его,пожалуйста для системы 2x-y-10=0 5x^2-20y^2-100=0 ...

Универсальная программа для решения уравнений методом половинного деления
Для одного уравнения я знаю как это сделать,но от меня требуют сделать эту программу универсальной,т.е. уравнение должно передаваться в...

Не работает программа для решения системы уравнений методом Гаусса
Написал программу, потом решил ее немного переделать. Перекинул расчет функции в процедуру. Но программа перестала правильно работать....

Не работает код решения СНАУ методом Ньютона
Помогите понять в чем ошибка! Решение СНАУ методом ньютона. Если меняется Е, то вообще не выходит решение. При данном Е, решение...

Улучшить программу для решения уравнения методом Гаусса
В общем, есть код для обычного решения уравнения, но мне требуется улучшить, чтобы он решал матрицу произвольного размера(т.е. не , а ), а...


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

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

Новые блоги и статьи
SDL3 для Desktop (MinGW): Создаём пустое окно с нуля для 2D-графики на SDL3, Си и C++
8Observer8 10.03.2026
Содержание блога Финальные проекты на Си и на C++: hello-sdl3-c. zip hello-sdl3-cpp. zip Результат:
Установка CMake и MinGW 13.1 для сборки С и C++ приложений из консоли и из Qt Creator в EXE
8Observer8 10.03.2026
Содержание блога MinGW - это коллекция инструментов для сборки приложений в EXE. CMake - это система сборки приложений. Здесь описаны базовые шаги для старта программирования с помощью CMake и. . .
Как дизайн сайта влияет на конверсию: 7 решений, которые реально повышают заявки
Neotwalker 08.03.2026
Многие до сих пор воспринимают дизайн сайта как “красивую оболочку”. На практике всё иначе: дизайн напрямую влияет на то, оставит человек заявку или уйдёт через несколько секунд. Даже если у вас. . .
Модульная разработка через nuget packages
DevAlt 07.03.2026
Сложившийся в . Net-среде способ разработки чаще всего предполагает монорепозиторий в котором находятся все исходники. При создании нового решения, мы просто добавляем нужные проекты и имеем. . .
Модульный подход на примере F#
DevAlt 06.03.2026
В блоге дяди Боба наткнулся на такое определение: В этой книге («Подход, основанный на вариантах использования») Ивар утверждает, что архитектура программного обеспечения — это структуры,. . .
Управление камерой с помощью скрипта OrbitControls.js на Three.js: Вращение, зум и панорамирование
8Observer8 05.03.2026
Содержание блога Финальная демка в браузере работает на Desktop и мобильных браузерах. Итоговый код: orbit-controls-threejs-js. zip. Сканируйте QR-код на мобильном. Вращайте камеру одним пальцем,. . .
SDL3 для Web (WebAssembly): Синхронизация спрайтов SDL3 и тел Box2D
8Observer8 04.03.2026
Содержание блога Финальная демка в браузере. Итоговый код: finish-sync-physics-sprites-sdl3-c. zip На первой гифке отладочные линии отключены, а на второй включены:. . .
SDL3 для Web (WebAssembly): Идентификация объектов на Box2D v3 - использование userData и событий коллизий
8Observer8 02.03.2026
Содержание блога Финальная демка в браузере. Итоговый код: finish-collision-events-sdl3-c. zip Сканируйте QR-код на мобильном и вы увидите, что появится джойстик для управления главным героем. . . .
КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin
Copyright ©2000 - 2026, CyberForum.ru