Последовательное приближение

Еще одна стратегия заключается в том, чтобы начать со случайного решения и затем делать последовательные приближения (incremental improvements). Начав со случайно выбранного решения, программа делает случайный выбор. Если новое решение лучше предыдущего, программа закрепляет изменения и продолжает проверку других случайных изменений. Если изменение не улучшает решение, программа отбрасывает его и делает новую попытку.

Для задачи формирования портфеля особенно просто порождать случайные изменения. Программа просто выбирает случайную позицию из пробного решения, и удаляет ее из текущего решения. Она затем снова добавляет случайные позиции в решение до тех пор, пока они помещаются. Если удаленная позиция имела очень высокую стоимость, то на ее место программа может поместить несколько позиций.

Момент остановки

Есть несколько хороших способов определить момент, когда следует прекратить случайные изменения. Для проблемы с N позициями, можно выполнить N или N² случайных изменений, перед тем, как остановиться.

=====206-208

В программе Heur этот подход реализован в процедуре MakeChangesFixed. Она выполняет определенное число случайных изменений с рядом случайных пробных решений:

Public Sub MakeChangesFixed(K As Integer, num_trials As Integer, num_changes As Integer)

Dim trial As Integer

Dim change As Integer

Dim i As Integer

Dim removal As Integer

For trial = 1 To num_trials

' Найти случайное пробное решение и использовать его

' в качестве начальной точки.

Do While AddToSolution()

' All the work is done by AddToSolution.

Loop

' Начать с этого пробного решения.

trial_profit = test_profit

trial_cost = test_cost

For i = 1 To NumItems

trial_solution(i) = test_solution(i)

Next i

For change = 1 To num_changes

' Удалить K случайных позиций.

For removal = 1 To K

RemoveFromSolution

Next removal

' Добавить максимально возможное

' число позиций.

Do While AddToSolution()

' All the work is done by AddToSolution.

Loop

' Если это улучшает пробное решение, сохранить его.

' Иначе вернуть прежнее значение пробного решения.

If test_profit > trial_profit Then

' Сохранить изменения.

trial_profit = test_profit

trial_cost = test_cost

For i = 1 To NumItems

trial_solution(i) = test_solution(i)

Next i

Else

' Сбросить пробное решение.

test_profit = trial_profit

test_cost = trial_cost

For i = 1 To NumItems

test_solution(i) = trial_solution(i)

Next i

End If

Next change

' Если пробное решение лучше предыдущего

' наилучшего решения, сохранить его.

If trial_profit > best_profit Then

best_profit = trial_profit

best_cost = trial_cost

For i = 1 To NumItems

best_solution(i) = trial_solution(i)

Next i

End If

' Сбросить пробное решение для

' следующей попытки.

test_profit = 0

test_cost = 0

For i = 1 To NumItems

test_solution(i) = False

Next i

Next trial

End Sub

Private Sub RemoveFromSolution()

Dim num_in_solution As Integer

Dim j As Integer

Dim selection As Integer

' Определить число позиций в решении.

num_in_solution = 0

For j = 1 To NumItems

If test_solution(j) Then num_in_solution = num_in_solution + 1

Next j

If num_in_solution < 1 Then Exit Sub

' Выбрать случайную позицию.

selection = Int((num_in_solution) * Rnd + 1)

' Найти случайно выбранную позицию.

For j = 1 To NumItems

If test_solution(j) Then

selection = selection - 1

If selection < 1 Then Exit For

End If

Next j

' Удалить позицию из решения.

test_profit = test_profit - Items(j).Profit

test_cost = test_cost - Items(j).Cost

test_solution(j) = False

End Sub

======209-210

Другая стратегия заключается в том, чтобы вносить изменения до тех пор, пока несколько последовательных изменений не приносят улучшений. Для задачи с N позициями, программа может вносить изменения до тех пор, пока в течение N изменений подряд улучшений не будет.

Эта стратегия реализована в подпрограмме MakeChangesNoChange программы Heur. Она повторяет попытки до тех пор, пока определенное число последовательных попыток не даст никаких улучшений. Для каждой попытки она вносит случайные изменения в пробное решение до тех пор, пока после определенного числа изменений не наступит никаких улучшений.

Public Sub MakeChangesNoChange(K As Integer, _

max_bad_trials As Integer, max_non_changes As Integer)

Dim i As Integer

Dim removal As Integer

Dim bad_trials As Integer ' Неэффективных попыток подряд.

Dim non_changes As Integer ' Неэффективных изменений подряд.

' Повторять попытки, пока не встретится max_bad_trials

' попыток подряд без улучшений.

bad_trials = 0

Do

' Выбрать случайное пробное решение для

' использования в качестве начальной точки.

Do While AddToSolution()

' All the work is done by AddToSolution.

Loop

' Начать с этого пробного решения.

trial_profit = test_profit

trial_cost = test_cost

For i = 1 To NumItems

trial_solution(i) = test_solution(i)

Next i

' Повторять, пока max_non_changes изменений

' подряд не даст улучшений.

non_changes = 0

Do While non_changes < max_non_changes

' Удалить K случайных позиций.

For removal = 1 To K

RemoveFromSolution

Next removal

' Вернуть максимально возможное число позиций.

Do While AddToSolution()

' All the work is done by

' AddToSolution.

Loop

' Если это улучшает пробное значение, сохранить его.

' Иначе вернуть прежнее значение пробного решения.

If test_profit > trial_profit Then

' Сохранить улучшение.

trial_profit = test_profit

trial_cost = test_cost

For i = 1 To NumItems

trial_solution(i) = test_solution(i)

Next i

non_changes = 0 ' This was a good change.

Else

' Reset the trial.

test_profit = trial_profit

test_cost = trial_cost

For i = 1 To NumItems

test_solution(i) = trial_solution(i)

Next i

non_changes = non_changes + 1 ' Плохое изменение.

End If

Loop ' Продолжить проверку случайных изменений.

' Если эта попытка лучше, чем предыдущее наилучшее

' решение, сохранить его.

If trial_profit > best_profit Then

best_profit = trial_profit

best_cost = trial_cost

For i = 1 To NumItems

best_solution(i) = trial_solution(i)

Next i

bad_trials = 0 ' Хорошая попытка.

Else

bad_trials = bad_trials + 1 ' Плохая попытка.

End If

' Сбросить тестовое решение для следующей попытки.

test_profit = 0

test_cost = 0

For i = 1 To NumItems

test_solution(i) = False

Next i

Loop While bad_trials < max_bad_trials

End Sub