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

@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пасибо))
Кстати,а как сделать,чтобы программа вычисляла не только степенные уравнения,а вообще любого вида с синусами,экспонентой и т.п?!

Новые блоги и статьи Все статьи Все блоги /
http://iceja.net/ математические сервисы iceja 20.01.2026 Обновила свой сайт http:/ / iceja. net/ , приделала Fast Fourier Transform экстраполяцию сигналов. Однако предсказывает далеко не каждый сигнал (см ограничения http:/ / iceja. net/ fourier/ docs ). Также. . .	http://iceja.net/ сервер решения полиномов iceja 18.01.2026 Выкатила http:/ / iceja. net/ сервер решения полиномов (находит действительные корни полиномов методом Штурма). На сайте документация по API, но скажу прямо VPS слабенький и 200 000 полиномов. . .	Расчёт переходных процессов в цепи постоянного тока igorrr37 16.01.2026 / * Дана цепь постоянного тока с R, L, C, k(ключ), U, E, J. Программа составляет систему уравнений по 1 и 2 законам Кирхгофа, решает её и находит переходные токи и напряжения на элементах схемы. . . .	Восстановить юзерскрипты Greasemonkey из бэкапа браузера damix 15.01.2026 Если восстановить из бэкапа профиль Firefox после переустановки винды, то список юзерскриптов в Greasemonkey будет пустым. Но восстановить их можно так. Для этого понадобится консольная утилита. . .
Сукцессия микоризы: основная теория в виде двух уравнений. anaschu 11.01.2026 https:/ / rutube. ru/ video/ 7a537f578d808e67a3c6fd818a44a5c4/	WordPad для Windows 11 Jel 10.01.2026 WordPad для Windows 11 — это приложение, которое восстанавливает классический текстовый редактор WordPad в операционной системе Windows 11. После того как Microsoft исключила WordPad из. . .	Classic Notepad for Windows 11 Jel 10.01.2026 Old Classic Notepad for Windows 11 Приложение для Windows 11, позволяющее пользователям вернуть классическую версию текстового редактора «Блокнот» из Windows 10. Программа предоставляет более. . .	Почему дизайн решает? Neotwalker 09.01.2026 В современном мире, где конкуренция за внимание потребителя достигла пика, дизайн становится мощным инструментом для успеха бренда. Это не просто красивый внешний вид продукта или сайта — это. . .

@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