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

@koba/ · Регистрация: 07.05.2012

Студворк — интернет-сервис помощи студентам

Имеется программа для решения уравнений методом Ньютона в 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

@gaw · 17.05.2012, 19:34

а как коэфициенты вводить для, скажем, 20 степени

@koba/ · 17.05.2012, 19:44 **[ТС]**

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

@Linoge · 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

@koba/ · 20.05.2012, 16:41 **[ТС]**

Cпасибо))
Кстати,а как сделать,чтобы программа вычисляла не только степенные уравнения,а вообще любого вида с синусами,экспонентой и т.п?!

Новые блоги и статьи Все статьи Все блоги /
Автозаполнение реквизита при выборе элемента справочника Maks 27.03.2026 Программный код из решения ниже на примере нетипового документа "ЗаявкаНаРемонтСпецтехники" разработанного в конфигурации КА2. При выборе "Спецтехники" (Тип Справочник. Спецтехника), заполняется. . .	Сумматор с применением элементов трёх состояний. Hrethgir 26.03.2026 Тут. https:/ / fips. ru/ EGD/ ab3c85c8-836d-4866-871b-c2f0c5d77fbc Первый документ красиво выглядит, но без схемы. Это конечно не даёт никаких плюсов автору, но тем не менее. . . всё может быть. . .	Автозаполнение реквизитов при создании документа Maks 26.03.2026 Программный код из решения ниже размещается в модуле объекта документа, в процедуре "ПриСозданииНаСервере". Алгоритм проверки заполнения реализован для исключения перезаписи значения реквизита,. . .	Команды формы и диалоговое окно Maks 26.03.2026 1. Команда формы "ЗаполнитьЗапчасти". Программный код из решения ниже на примере нетипового документа "ЗаявкаНаРемонтСпецтехники" разработанного в конфигурации КА2. В качестве источника данных. . .
Кому нужен AOT? DevAlt 26.03.2026 Решил сделать простой ланчер Написал заготовку: dotnet new console --aot -o UrlHandler var items = args. Split(":"); var tag = items; var id = items; var executable = args;. . .	Отправка уведомления на почту при создании или изменении элементов справочника Maks 24.03.2026 Программная отправка письма электронной почты на примере типового справочника "Склады" в конфигурации БП3. Перед реализацией необходимо выполнить настройку системной учетной записи электронной. . .	модель ЗдравоСохранения 5. Меньше увольнений- больше дохода! anaschu 24.03.2026 Теперь система здравосохранения уменьшает количество увольнений. 9TO2GP2bpX4 a42b81fb172ffc12ca589c7898261ccb/ https:/ / rutube. ru/ video/ a42b81fb172ffc12ca589c7898261ccb/ Слева синяя линия -. . .	Midnight Chicago Blues kumehtar 24.03.2026 Такой Midnight Chicago Blues, знаешь?. . Когда вечерние улицы становятся ночными, а ты не можешь уснуть. Ты идёшь в любимый старый бар, и бармен наливает тебе виски. Ты смотришь на пролетающие. . .

@gaw 6644 / 1511 / 169 Регистрация: 09.01.2010 Сообщений: 4,298
	17.05.2012, 19:34
	а как коэфициенты вводить для, скажем, 20 степени 0

@koba/ 0 / 0 / 0 Регистрация: 07.05.2012 Сообщений: 7
	17.05.2012, 19:44 [ТС]
	вот как раз чтобы коэфф вводить мне говорили,что вроде с помощью функции InputBox вроде как-вроде должно всплывать сообщение-введите переменные или что-то типа того.После введения степени и на основании введённой степени 0

@koba/ 0 / 0 / 0 Регистрация: 07.05.2012 Сообщений: 7
	20.05.2012, 16:41 [ТС]
	Cпасибо)) Кстати,а как сделать,чтобы программа вычисляла не только степенные уравнения,а вообще любого вида с синусами,экспонентой и т.п?! 0