#include <Array.au3>
#include <GuiConstantsEx.au3>
#include <GDIPlus.au3>
#region ПАРАМЕТРЫ
Global $iNumPopulation = 20
Global $iGen = 12
Global $iCalcSentence = '10*a+150*b+13*c+6*d+31*e+15*f+30*g+68*h+11*i+12*j+15*k+18*l';'3*a+6*b-8*c+9*d'
Global $iNeededResult = 41142
Global $iStartGen = 0
Global $iEndGen = 300
Global $view = 1
#endregion
#region ФУНКЦИИ
Func StartView()
Global $hGUI, $hGraphic
$hGUI = GUICreate("Обзор", 800, 800)
GUISetState()
_GDIPlus_Startup()
$hGraphic = _GDIPlus_GraphicsCreateFromHWND ($hGUI)
EndFunc
Func DrawResults(ByRef $aResults, ByRef $iNumPopulation, ByRef $iNeeded)
_GDIPlus_GraphicsClear($hGraphic, 0xFFCCCCCC)
;Вычисление цены пикселя
$iDist = Abs(_ArrayMax($aResults))-$iNeeded
$iDownDist = Abs(_ArrayMin($aResults))-$iNeeded
If $iDist < $iDownDist Then $iDist = $iDownDist
$iPixelSumm = 400/$iDist
$iXStep = 800/$iNumPopulation
_GDIPlus_GraphicsDrawLine($hGraphic, 0, 400, 800, 400)
$hPen1 = _GDIPlus_PenCreate(0xFF000000)
$hPen2 = _GDIPlus_PenCreate(0xFFFF0000)
For $p=0 To $iNumPopulation-1
$iX = $iXStep*$p
If $iX=0 Then
$iX = 2
ElseIf $iX=800 Then
$iX = 800-2
EndIf
$iY = ($aResults[$p]-$iNeeded)*$iPixelSumm+400
If $iY > 795 Then
$iY = 795
ElseIf $iY < 5 Then
$iY = 5
EndIf
_GDIPlus_GraphicsDrawRect($hGraphic, $iX-1, $iY-1, 3, 3, $hPen1)
_GDIPlus_GraphicsDrawRect($hGraphic, $iX, $iY, 1, 1, $hPen2)
_GDIPlus_GraphicsDrawString($hGraphic, $aResults[$p], $iX+2, $iY-5, 'Arial', 7)
Next
EndFunc
Func EndView()
Do
Until GUIGetMsg() = $GUI_EVENT_CLOSE
_GDIPlus_GraphicsDispose ($hGraphic)
_GDIPlus_Shutdown ()
EndFunc
Func FirstGenerate(ByRef $iNumPopulation, ByRef $iGen, ByRef $iStartGen, ByRef $iEndGen, $iN = 1)
Dim $aResult[$iNumPopulation][$iGen]
For $i = 0 To $iNumPopulation-1
For $j = 0 To $iGen-1
$aResult[$i][$j] = Random($iStartGen, $iEndGen, $iN)
Next
Next
Return $aResult
EndFunc
Func Fitness(ByRef $aPopulation, ByRef $iNumPopulation, ByRef $iGen, ByRef $iCalcSentence, ByRef $iNeededResult)
Dim $aPercent[$iNumPopulation][2] ;Массив особь:приспособленность
Dim $aResult[$iNumPopulation] ;Массив результатов
Dim $aLetters[13] = ['a', 'b', 'c', 'd', 'e', 'f', 'g', 'h', 'i', 'j', 'k', 'l', 'm']
For $i = 0 To $iNumPopulation-1 ;Берем первую особь
$iStringCalc = $iCalcSentence ;Сохраняем выражение для вычисления в отдельную строку
For $j = 0 To $iGen-1 ;Берем первый ген и заменяем на него первую букву
$iStringCalc = StringReplace($iStringCalc, $aLetters[$j], $aPopulation[$i][$j])
Next
$aResult[$i] = Execute($iStringCalc) ;Вычисляем результат выражения
If $aResult[$i] = $iNeededResult Then ;Если это тот результат который нужен
Return $i ;Сохраняем индекс особи
ExitLoop ;Выходим из цикла, остальные особи уже не интересуют
EndIf
Next
If $view Then DrawResults($aResult, $iNumPopulation, $iNeededResult)
;Если всё же не было ни одого решения, вычислим приближенность особей к решению
$iMax = _ArrayMax($aResult)
$iMin = Abs(_ArrayMin($aResult))
If $iMin > $iMax Then $iMax = $iMin
$iDiv = ($iMax-$iNeededResult)/100
For $i = 0 To $iNumPopulation-1
$aPercent[$i][0] = $i
$aPercent[$i][1] = 100-(Abs($aResult[$i]-$iNeededResult))/$iDiv
Next
Return $aPercent
EndFunc
Func Selection(ByRef $aSurvival, ByRef $aPopulation, ByRef $iNumPopulation, ByRef $iGen, ByRef $iEndGen)
Dim $aCombineArray[$iNumPopulation][$iGen+1]
;Соединяем массив в массив вида
For $i=0 To $iNumPopulation-1
For $j=0 To $iGen
If $j <> $iGen Then
$aCombineArray[$i][$j] = $aPopulation[$i][$j]
Else
$aCombineArray[$i][$j] = $aSurvival[$i][1]
EndIf
Next
Next
;Удаляем слабых
_ArraySort($aCombineArray, 1, 0, 0, $iGen)
For $i = UBound($aCombineArray)/2 To UBound($aCombineArray)-1
_ArrayDelete($aCombineArray, $i)
Next
;~ ConsoleWrite(@TAB&'лучшая особь '&$aSurvival&'[')
;~ For $i=0 To $iGen-1
;~ ConsoleWrite($aCombineArray[0][$i]&'|')
;~ Next
;~ ConsoleWrite('] '&@CRLF)
;Генерация новых особей
Dim $aEnclave[4][$iGen] ;Временное хранилище
Dim $aDiffGen[$iGen] ;Шаг отличия генома
Dim $aNewGenerate[$iNumPopulation][$iGen] ;Массив нового поколения
Dim $aPopInGenerate = 0 ;Популяция нового поколения
For $i = 0 To UBound($aCombineArray)-1 Step 2
;Сохраняем геном родителей
For $j = 0 To $iGen-1
;Сохраняем различие генома (шаг)
$aDiffGen[$j] = Round(($aCombineArray[$i][$j]-$aCombineArray[$i+1][$j])/5)
If $aDiffGen[$j] = 0 Then ;Если предыдущий ген родителя не отличается от гена второго родителя
$aDiffGen[$j] = Random(0, $iEndGen, 1) ;Будет мутация!!!111
EndIf
;ConsoleWrite(@TAB&'разница ('&$aCombineArray[$i][$j]&', '&$aCombineArray[$i+1][$j]&') генома '&@TAB&$aDiffGen[$j])
;Создаем 4 новые особи
For $k = 0 To 3
$aEnclave[$k][$j] = $aCombineArray[$i][$j] - ($k+1)*$aDiffGen[$j]
Next
;ConsoleWrite(@TAB&' записали в новую особь '&$aEnclave[0][$j]&@CRLF)
Next
;Сохраняем особей из анклава в новое поколение
$iGenerateIndex = $aPopInGenerate
For $m = 0 To 3
For $g = 0 To $iGen-1
$aNewGenerate[$iGenerateIndex][$g] = $aEnclave[$m][$g]
Next
$iGenerateIndex += 1
Next
$aPopInGenerate += 4 ;Сохраним значение популяции +4 ура ура ура
Next
Return $aNewGenerate
EndFunc
#endregion
#region КОД ПРОГРАММЫ
If $view Then StartView()
Dim $iFind = 0
Dim $iTimer = TimerInit()
Dim $iNumGenerate = 0
;Генерируем первое поколение
$aPopulation = FirstGenerate($iNumPopulation, $iGen, $iStartGen, $iEndGen)
Do
;Проверка поколения на выживаемость
$aSurvival = Fitness($aPopulation, $iNumPopulation, $iGen, $iCalcSentence, $iNeededResult)
If IsInt($aSurvival) Then ;Если в результате вычисления пришло число - результат
ConsoleWrite(Round(TimerDiff($iTimer)/1000, 4)&' - пришло число '&$aSurvival&'[')
For $i=0 To $iGen-1
ConsoleWrite($aPopulation[$aSurvival][$i]&'|')
Next
ConsoleWrite('] '&$iNumGenerate&@CRLF)
$iFind = 1
ExitLoop
EndIf
ConsoleWrite(Round(TimerDiff($iTimer)/1000, 4)&' - пришел массив '&$iNumGenerate&@CRLF)
$aPopulation = Selection($aSurvival, $aPopulation, $iNumPopulation, $iGen, $iEndGen)
$iNumGenerate += 1
Sleep(100)
Until $iFind = 1
If $view Then EndView()
#endregion