Реализовать программу для апроксимации методом найменьших квадратов данной таблицы

@Olena K · Регистрация: 22.05.2013

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

Помогите реализовать программу для апроксимации методом найменьших квадратов данной таблицы:
x 0.88 1.460 2.040 2.620 3.200 3.780 4.360 4.940 5.520
y 1.338 2.172 2.921 3.645 4.350 5.041 5.72 6.389 7.048

@Sasha_Smirnov · 23.05.2013, 04:51

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
Option Explicit
Option Base 1
 
Sub OLS()
Dim x, y    'массивы значений для иксов и игреков
Dim a, b, D 'искомые коэффициенты уравнения y = ax + b и детерминант матрицы
Dim Da, Db  'детерминанты при замене столбцов*** соответственно при a и b
Dim СуммаИксов, СуммаИгрек, СуммаКвадратовИкс, СуммаПроизведений, ЧислоТочек
Dim z(), i  'переменные для вывода аппроксимирующего массива точек
 
    x = Array(0.88, 1.46, 2.04, 2.62, 3.2, 3.78, 4.36, 4.94, 5.52)
    y = Array(1.338, 2.172, 2.921, 3.645, 4.35, 5.041, 5.72, 6.389, 7.048)
    
    If UBound(y) < UBound(x) Then MsgBox "В массиве y мало элементов.": Exit Sub
    ЧислоТочек = UBound(x)
ReDim z(1 To UBound(x))
 
    With Application.WorksheetFunction
        СуммаИксов = .Sum(x)
        СуммаИгрек = .Sum(y)
        СуммаКвадратовИкс = .SumSq(x)
        СуммаПроизведений = .SumProduct(x, y)
    
    'СуммаКвадратовИкс * a + СуммаИксов * b = СуммаПроизведений
    '       СуммаИксов * a + ЧислоТочек * b = СуммаИгрек
    '***    (источник: multitest.semico.ru/mnk.htm)
 
        D = .MDeterm(Array(Array(СуммаКвадратовИкс, СуммаИксов), _
                            Array(СуммаИксов, ЧислоТочек)))
        Da = .MDeterm(Array(Array(СуммаПроизведений, СуммаИксов), _
                            Array(СуммаИгрек, ЧислоТочек)))
        Db = .MDeterm(Array(Array(СуммаКвадратовИкс, СуммаПроизведений), _
                            Array(СуммаИксов, СуммаИгрек)))
        a = Da / D
        b = Db / D
    End With
    
    'Теперь проведём прямую y = ax + b. Здесь же - просто выведу её точки:
    For i = 1 To UBound(x)
        z(i) = FormatNumber(a * x(i) + b, 3) 'сразу же форматируем для вывода
    Next
    
    MsgBox Join(x, vbTab) & vbCr & Join(y, vbTab) & vbCr & vbCr & _
        "Приближение по МНК:" & vbCr & Join(x, vbTab) & vbCr & vbCr & Join(z, vbTab)
End Sub

Провозился минут 140, но кино интересное!

@Olena K · 23.05.2013, 08:14 **[ТС]**

А можна еще такой вариант: получить аппроксимирующую функцию, избрав эмпирическую зависимость которая более точно описует исходную зависимость.

@Sasha_Smirnov · 23.05.2013, 13:19

Многочлен 8-й степени, что ли?! В принципе, конечно можно.

Но в данном случае явно просматривается линейная зависимость, и улучшать просто глупо.

@Olena K · 23.05.2013, 14:13 **[ТС]**

_____________________

Если сделать по этомому методу то зависимость будет показательной!

y=a*X^b

@Sasha_Smirnov · 23.05.2013, 16:05

Если хорошо знакомы с Excel’ем, попробуйте построить тренд по экспоненте (показательной функции).

Нашёл весёлую статейку: ru.wikipedia.org/wiki/Обсуждение%3AМетод%20наименьших%20квадра тов

@Sasha_Smirnov · 26.05.2013, 04:42

Ради интереса, всего за 2 ч, снабдил расчёт визуализацией; запуск в RSS.xls сочетанием клавиш Сtrl+й.

Также сделал (щелчком по графику) экспоненциальный тренд; как видите, он значительно хуже прямого:

@Olena K · 29.05.2013, 22:57 **[ТС]**

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
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
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
Sub aprox()
Dim x() As Single, y() As Single, eps() As Single, yNew() As Single
Dim i As Integer, j As Integer, h As Integer, m As Integer
m = 20
n = InputBox("Введіть кількість відрізків", "Кількість відрізків")
ReDim x(n) As Single
ReDim y(n) As Single
ReDim yNew(n) As Single
ReDim eps(m) As Single
mes = "Апроксимація функції за МНК:"
mes = mes & vbNewLine & vbNewLine
    For i = 1 To n
        x(i) = InputBox("Введіть " & i & "-e значення x", "Значення х")
    Next i
    For j = 1 To n
        y(j) = InputBox("Введіть " & j & "-e значення y", "Значення у")
    Next j
    For j = 1 To n
        For h = 1 To n
            If j = h Then
                yNew(h) = y(j)
            End If
        Next h
    Next j
xAr = (x(1) + x(n)) / 2
xGeom = (x(1) * x(n)) ^ 0.5
xGarm = 2 * x(1) * x(n) / (x(1) + x(n))
yAr = (y(1) + y(n)) / 2
yGeom = (y(1) * y(n)) ^ 0.5
yGarm = 2 * y(1) * y(n) / (y(1) + y(n))
minimum = 100
minimum2 = 100
minimum3 = 100
    For i = 1 To n
        j = i
            If xAr = x(i) Then
                yzAr = y(j)
            ElseIf Abs(xAr - x(i)) < minimum Then
                minimum = Abs(xAr - x(i))
                yzAr = y(j) + (y(j + 1) - y(j)) / (x(i + 1) - x(i)) * (xGeom - x(i))
            End If
            
            If xGeom = x(i) Then
                yzGeom = y(j)
            ElseIf Abs(xGeom - x(i)) < minimum2 Then
                yzGeom = y(j) + (y(j + 1) - y(j)) / (x(i + 1) - x(i)) * (xGeom - x(i))
                minimum2 = Abs(xGeom - x(i))
            End If
            
            If xGarm = x(i) Then
                yzGarm = y(j)
            ElseIf Abs(xGarm - x(i)) < minimum3 Then
                minimum3 = Abs(xGarm - x(i))
                yzGarm = y(j) + (y(j + 1) - y(j)) / (x(i + 1) - x(i)) * (xGarm - x(i))
            End If
    Next i
eps(1) = Abs(yzAr - yAr)
eps(2) = Abs(yzAr - yGeom)
eps(3) = Abs(yzAr - yGarm)
eps(4) = Abs(yzGeom - yAr)
eps(5) = Abs(yzGeom - yGeom)
eps(6) = Abs(yzGarm - yAr)
eps(7) = Abs(yzGarm - yGarm)
epsMin = eps(1)
    For m = 2 To 7
        If eps(m) < epsMin Then
            epsMin = eps(m)
        End If
    Next m
    If epsMin = eps(1) Then
        Text = "Данна залежність є лінійною"
            For j = 1 To n
                For i = 1 To n
                    If j = i Then
                        y(j) = y(j)
                        x(i) = x(i)
                    End If
                Next i
            Next j
    ElseIf epsMin = eps(2) Then
        Text = "Дана залежність є показниковою"
            For j = 1 To n
                For i = 1 To n
                    If j = i Then
                        y(j) = Log(y(j)) / Log(10)
                        x(i) = x(i)
                    End If
                Next i
            Next j
    ElseIf epsMin = eps(3) Then
        Text = "Дана залежність є дробово-раціональною"
            For j = 1 To n
                For i = 1 To n
                    If j = i Then
                        x(i) = x(i)
                        y(j) = 1 / y(j)
                    End If
                Next i
            Next j
    ElseIf epsMin = eps(4) Then
        Text = "Дана залежність є логарифмічною"
            For j = 1 To n
                For i = 1 To n
                    If j = i Then
                        x(i) = Log(x(i))
                        y(j) = y(j)
                    End If
                Next i
            Next j
    ElseIf epsMin = eps(5) Then
        Text = "Дана залежність є степеневою"
            For j = 1 To n
                For i = 1 To n
                    If j = i Then
                        y(j) = Log(y(j)) / Log(10)
                        x(i) = Log(x(i)) / Log(10)
                    End If
                Next i
            Next j
    ElseIf epsMin = eps(6) Then
        Text = "Дана залежність є гіперболічною"
            For j = 1 To n
                For i = 1 To n
                    If j = i Then
                        x(i) = 1 / x(i)
                        y(j) = y(j)
                    End If
                Next i
            Next j
    ElseIf epsMin = eps(7) Then
        Text = "Дана залежність є добово-раціональною"
            For j = 1 To n
                For i = 1 To n
                    If j = i Then
                        y(j) = 1 / y(j)
                        x(i) = 1 / x(i)
                    End If
                Next i
            Next j
    End If
mes = mes & Text & vbNewLine & vbNewLine & "y(задане)    " & "y(апроксимоване)" & vbNewLine
sumX2 = 0
sumX = 0
    For i = 1 To n
        sumX = sumX + x(i)
        sumX2 = sumX2 + x(i) ^ 2
    Next i
sumY = o
    For j = 1 To n
        sumY = sumY + y(j)
    Next j
summ = o
    For i = 1 To n
        For j = 1 To n
            If i = j Then
                summ = summ + x(i) * y(j)
            End If
        Next j
    Next i
del = n * sumX2 - (sumX * sumX)
del1 = sumY * sumX2 - (summ * sumX)
del2 = n * summ - (sumX * sumY)
b0 = del1 / del
b1 = del2 / del
    For j = 1 To n
        For i = 1 To n
            If j = i Then
                y(j) = b0 + b1 * x(i)
            End If
        Next i
    Next j
    If epsMin = eps(1) Then
        For j = 1 To n
            For i = 1 To n
                If j = i Then
                    y(j) = y(j)
                    x(i) = x(i)
                End If
            Next i
        Next j
    ElseIf epsMin = eps(2) Then
        For j = 1 To n
            For i = 1 To n
                If j = i Then
                    y(j) = Exp(y(j) * Log(10))
                    x(i) = x(i)
                End If
            Next i
        Next j
    ElseIf epsMin = eps(3) Then
        For j = 1 To n
            For i = 1 To n
                If j = i Then
                    x(i) = x(i)
                    y(j) = 1 / y(j)
                End If
            Next i
        Next j
    ElseIf epsMin = eps(4) Then
        For j = 1 To n
            For i = 1 To n
                If j = i Then
                    x(i) = Exp(x(i))
                    y(j) = y(j)
                End If
            Next i
        Next j
    ElseIf epsMin = eps(5) Then
        For j = 1 To n
            For i = 1 To n
                If j = i Then
                    y(j) = Exp(y(j) * Log(10))
                    x(i) = Exp(x(i) * Log(10))
                End If
            Next i
        Next j
    ElseIf epsMin = eps(6) Then
        For j = 1 To n
            For i = 1 To n
                If j = i Then
                    x(i) = 1 / x(i)
                    y(j) = y(j)
                End If
            Next i
        Next j
    ElseIf epsMin = eps(7) Then
        For j = 1 To n
            For i = 1 To n
                If j = i Then
                    y(j) = 1 / y(j)
                    x(i) = 1 / x(i)
                End If
            Next i
        Next j
    End If
    For h = 1 To n
        For j = 1 To n
            If h = j Then
                vseEps = vseEps + (yNew(h) - y(j)) ^ 2
                mes = mes & yNew(h) & "             " & y(j) & vbNewLine
            End If
        Next j
    Next h
poh = (vseEps / (n - 1)) ^ 0.5
mes = mes & vbNewLine & vbNewLine & "Середньоквадратична похибка: " & poh
MsgBox mes
End Sub

Добавлено через 50 секунд
Вот это програмка!!!

@Sasha_Smirnov · 30.05.2013, 02:55

Грандиозно!

На ловца и зверь бежит. Даром что украинский — всё равно, без испытаний, почти ничего не понятно.

@Olena K · 30.05.2013, 14:27 **[ТС]**

А почему не понятно?
Что не понятно?

@Sasha_Smirnov · 30.05.2013, 20:16

Что хотел сказать автор программы. Без испытаний это даже трудно вообразить!

@Sasha_Smirnov · 30.11.2013, 12:56

Потому что не по-русски! Но, прокрутив чрез «мясорубку» интерпретатора, начинаешь понимать...

Сообщение от Olena K

описует

Ah, girl, girl, girl…

Новые блоги и статьи Все статьи Все блоги /
SDL3 для Web (WebAssembly): Реализация движения на Box2D v3 - трение и коллизии с повёрнутыми стенами 8Observer8 20.02.2026 Содержание блога Box2D позволяет легко создать главного героя, который не проходит сквозь стены и перемещается с заданным трением о препятствия, которые можно располагать под углом, как верхнее. . .	Конвертировать закладки radiotray-ng в m3u-плейлист damix 19.02.2026 Это можно сделать скриптом для PowerShell. Использование . \СonvertRadiotrayToM3U. ps1 <path_to_bookmarks. json> Рядом с файлом bookmarks. json появится файл bookmarks. m3u с результатом. # Check if. . .	Семь CDC на одном интерфейсе: 5 U[S]ARTов, 1 CAN и 1 SSI Eddy_Em 18.02.2026 Постепенно допиливаю свою "многоинтерфейсную плату". Выглядит вот так: https:/ / www. cyberforum. ru/ blog_attachment. php?attachmentid=11617&stc=1&d=1771445347 Основана на STM32F303RBT6. На борту пять. . .	Камера Toupcam IUA500KMA Eddy_Em 12.02.2026 Т. к. у всяких "хикроботов" слишком уж мелкий пиксель, для подсмотра в ESPriF они вообще плохо годятся: уже 14 величину можно рассмотреть еле-еле лишь на экспозициях под 3 секунды (а то и больше),. . .
И ясному Солнцу zbw 12.02.2026 И ясному Солнцу, и светлой Луне. В мире покоя нет и люди не могут жить в тишине. А жить им немного лет.	«Знание-Сила» zbw 12.02.2026 «Знание-Сила» «Время-Деньги» «Деньги -Пуля»	SDL3 для Web (WebAssembly): Подключение Box2D v3, физика и отрисовка коллайдеров 8Observer8 12.02.2026 Содержание блога Box2D - это библиотека для 2D физики для анимаций и игр. С её помощью можно определять были ли коллизии между конкретными объектами и вызывать обработчики событий столкновения. . . .	SDL3 для Web (WebAssembly): Загрузка PNG с прозрачным фоном с помощью SDL_LoadPNG (без SDL3_image) 8Observer8 11.02.2026 Содержание блога Библиотека SDL3 содержит встроенные инструменты для базовой работы с изображениями - без использования библиотеки SDL3_image. Пошагово создадим проект для загрузки изображения. . .

@Olena K 154 / 1 / 1 Регистрация: 22.05.2013 Сообщений: 5

	Реализовать программу для апроксимации методом найменьших квадратов данной таблицы 22.05.2013, 21:46. Показов 2616. Ответов 11 Метки нет (Все метки) Помогите реализовать программу для апроксимации методом найменьших квадратов данной таблицы: x 0.88 1.460 2.040 2.620 3.200 3.780 4.360 4.940 5.520 y 1.338 2.172 2.921 3.645 4.350 5.041 5.72 6.389 7.048 0

@Olena K 154 / 1 / 1 Регистрация: 22.05.2013 Сообщений: 5
	23.05.2013, 08:14 [ТС]
	А можна еще такой вариант: получить аппроксимирующую функцию, избрав эмпирическую зависимость которая более точно описует исходную зависимость. 0

@Sasha_Smirnov 5562 / 1370 / 150 Регистрация: 08.02.2009 Сообщений: 4,109 Записей в блоге: 30
	23.05.2013, 13:19
	Многочлен 8-й степени, что ли?! В принципе, конечно можно. Но в данном случае явно просматривается линейная зависимость, и улучшать просто глупо. 0

@Olena K 154 / 1 / 1 Регистрация: 22.05.2013 Сообщений: 5
	23.05.2013, 14:13 [ТС]
	_____________________ Если сделать по этомому методу то зависимость будет показательной! y=a*X^b 0

@Sasha_Smirnov 5562 / 1370 / 150 Регистрация: 08.02.2009 Сообщений: 4,109 Записей в блоге: 30
	23.05.2013, 16:05
	Если хорошо знакомы с Excel’ем, попробуйте построить тренд по экспоненте (показательной функции). Нашёл весёлую статейку: ru.wikipedia.org/wiki/Обсуждение%3AМетод%20наименьших%20квадра тов 0

@Sasha_Smirnov 5562 / 1370 / 150 Регистрация: 08.02.2009 Сообщений: 4,109 Записей в блоге: 30
	30.05.2013, 02:55
	Грандиозно! На ловца и зверь бежит. Даром что украинский — всё равно, без испытаний, почти ничего не понятно. 0

@Olena K 154 / 1 / 1 Регистрация: 22.05.2013 Сообщений: 5
	30.05.2013, 14:27 [ТС]
	Сообщение было отмечено как решение Решение А почему не понятно? Что не понятно? 0

@Sasha_Smirnov 5562 / 1370 / 150 Регистрация: 08.02.2009 Сообщений: 4,109 Записей в блоге: 30
	30.05.2013, 20:16
	Что хотел сказать автор программы. Без испытаний это даже трудно вообразить! 0

Реализовать программу для апроксимации методом найменьших квадратов данной таблицы

Решение