Реферат: VB, MS Access, VC++, Delphi, Builder C++ принципы(технология), алгоритмы программирования
Dim selection As Integer
' Определить, сколько осталось позиций, которые
' удовлетворяют ограничению максимальной стоимости.
num_left = 0
For j = 1 To NumItems
If (Not test_solution(j)) And _
(test_cost + Items(j).Cost <= ToSpend) _
Then num_left = num_left + 1
Next j
' Остановиться, если нельзя найти новую позицию.
If num_left < 1 Then
AddToSolution = False
Exit Function
End If
' Выбрать случайную позицию.
selection = Int((num_left) * Rnd + 1)
' Найти случайно выбранную позицию.
For j = 1 To NumItems
If (Not test_solution(j)) And _
(test_cost + Items(j).Cost <= ToSpend) _
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) = True
AddToSolution = True
End Function
Последовательное приближение
Еще одна стратегия заключается в том, чтобы начать со случайного решения и затем делать последовательные приближения (incremental improvements). Начав со случайно выбранного решения, программа делает случайный выбор. Если новое решение лучше предыдущего, программа закрепляет изменения и продолжает проверку других случайных изменений. Если изменение не улучшает решение, программа отбрасывает его и делает новую попытку.
Для задачи формирования портфеля особенно просто порождать случайные изменения. Программа просто выбирает случайную позицию из пробного решения, и удаляет ее из текущего решения. Она затем снова добавляет случайные позиции в решение до тех пор, пока они помещаются. Если удаленная позиция имела очень высокую стоимость, то на ее место программа может поместить несколько позиций.
Момент остановки
Есть несколько хороших способов определить момент, когда следует прекратить случайные изменения. Для проблемы с N позициями, можно выполнить N или N2 случайных изменений, перед тем, как остановиться.
=====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
Страницы: 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
