Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > IT форум > Помощь студентам
Регистрация

Восстановить пароль

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 18.05.2014, 10:12   #1
meco
Новичок
Джуниор
 
Регистрация: 18.05.2014
Сообщений: 1
По умолчанию Метод наискорейшего спуска VBA Excel

Всем, привет. Нужна помощь в написании программы, а точнее в её корриктировке. Нужно найти минимумы с помощью метода наискорейшего спуска и с поиском на основе аппроксимации квадратичной функции. Вот код, но он почему-то не работает.. Пожалуйста помогите найти, в чём ошибки.
Код:
Sub градиент(x() As Double, G() As Double)
G(1) = -400 * x(2) * x(1) + 400 * x(1) ^ 3 - 2 + 2 * x(1)
G(2) = 200 * x(2) - 200 * x(1) ^ 2
End Sub
Function сходимость(G() As Double, n As Integer, e As Double) As Double
Dim i As Integer
G(0) = 0
For i = 1 To n
    G(0) = G(0) + G(i) ^ 2
    Next i
    G(0) = Sqr(G(0))
If G(0) > e Then сходимость = True
End Function
Function fn(x() As Double) As Double
fn = 100 * (x(2) - x(1) ^ 2) ^ 2 + (1 - x(1)) ^ 2
End Function
Sub метод_наискорейшего_спуска()
Const n = 2, e = 0.0000001, e1 = 0.1
Dim lm As Double, x(1 To n) As Double, y(1 To n) As Double, _
i As Integer, d(n) As Double, L(4) As Double, f(4) As Double, _
g2 As Double, G(n) As Double
lm = 1
For i = 1 To n
    x(i) = -5
    y(i) = x(i)
Next i
градиент x, G
While сходимость(G, n, e)
    For i = 1 To n
        d(i) = -G(i) / G(0)
    Next i
    L(1) = 0: f(1) = fn(y)
    lm = lm / 2
    Do
        lm = lm * 2
        L(3) = lm + L(1)
        For i = 1 To n
            x(i) = y(i) + L(3) * d(i)
        Next i
        f(3) = fn(x)
        градиент x, G
        g2 = 0
        For i = 1 To n
            g2 = g2 + G(i) * d(i)
        Next i
    Loop While f(3) < f(1) And g2 < 0
    поиск_аппроксимация x, y, d, f, L, n, lm, e1
    For i = 1 To n
    x(i) = y(i) + L(0) * d(i)
    y(i) = x(i)
    Next i
    lm = lm / 2
    градиент x, G
Wend
    For i = 1 To n
    Debug.Print x(i);: Next i: Debug.Print fn(x)
End Sub
Sub поиск_аппроксимация(x() As Double, y() As Double, d() As Double, f() As Double, L() As Double, n As Integer, lm As Double, e1 As Double)
Const e = 0.00001
Dim  h As Double, j As Integer, k As Integer
x(1) = - 1.1
h = 0.4
f(1) = fn(x)
Do
    x(2) = x(1) + h: f(2) = fn(x)
    If f(1) < f(2) Then x(3) = x(1) - h Else x(3) = x(1) + 2 * h
    f(3) = fn(x): h = 2 * h
    Loop While f(3) < f(1) And f(3) < f(2)
Do
    x(4) = (x(1) + x(2)) / 2 + 0.5 * (f(1) - f(2)) * (x(2) - x(3)) * (x(3) - x(1)) / ((x(2) - x(3)) * f(1) + (x(3) - x(1)) * f(2) + (x(1) - x(2)) * f(3))
    f(4) = fn(x)
    For j = 1 To 3
        For k = j + 1 To 4
            If f(j) > f(k) Then x(k) = x(j) + x(k): x(j) = x(k) - x(j): x(k) = x(k) - x(j): f(k) = f(j) + f(k): f(j) = f(k) - f(j): f(k) = f(k) - f(j)
        Next k
    Next j
    If (x(4) < x(1) And x(1) < x(2) And x(1) < x(3)) Or (x(4) > x(1) And x(1) > x(2) And x(1) > x(3)) _
    Then x(3) = x(4): f(3) = f(4)
Loop While f(2) - f(1) > e


End Sub
Отет должен быть таким 0,999999900488498 0,999999800578864 9,91839069612902E-15

Последний раз редактировалось meco; 18.05.2014 в 10:54.
meco вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Метод наискорейшего спуска в 3D(виснет программа) .FROST. Мультимедиа в Delphi 10 23.04.2013 13:57
Метод наискорейшего спуска RocBoy-D Помощь студентам 0 26.03.2013 18:05
Метод наискорейшего спуска Михаил77 Помощь студентам 0 17.12.2012 18:36
Методы оптимизации: метод Ньютона и метод наискорейшего спуска ruslanGacurap Помощь студентам 0 30.01.2012 13:54
Метод наискорейшего спуска Михаил1800 Помощь студентам 1 19.07.2011 13:30