Dim pop(30, 20) As Integer ' size of population is 30. Each Koromozon has 20 gens.
Dim popvalue(30) As Double ' size of population is 30.
Dim barpop(30) As Double ' size of population is 30.
Dim cumaldistrupop(30) As Double ' size of population is 30.
Dim rmutation As Double
Dim rrollet As Double
Dim selectedpop1 As Integer
Dim selectedpop2 As Integer
Dim temppop(20) As Integer
Dim averagefucntion(1002) As Double
'setting paratmeter
rmutation = 0.1
Randomize
For i = 1 To 30
For j = 0 To 19
pop(i, j) = Math.Rnd(1)
Next
Next
Dim xp As Double
xp = 0
Dim yp As Double
yp = 0
Dim Base(10) As Integer
Base(0) = 1
For i = 1 To 9
Base(i) = Base(i - 1) * 2
Next
For j = 1 To 30
xp = 0
yp = 0
For i = 0 To 9
xp = pop(j, i) * Base(i) + xp
Next
For i = 10 To 19
yp = pop(j, i) * Base(i - 10) + yp
Next
x = 0
y = 0
x = xp / 100
y = yp / 100
popvalue(j) = (1.5 - x + x * y) * (1.5 - x + x * y) + (2.25 - x + x * y * y) * (2.25 - x + x * y * y) + (2.625 - x + x * y * y * y) * (2.625 - x + x * y * y * y)
Next
'reputation
For geneticalgorithm = 1 To 1000
'calculating Barazandegi function
Dim sumpopvalue As Double
sumpopvalue = 0
For i = 1 To 30
sumpopvalue = 1 / popvalue(i) + sumpopvalue
Next
For i = 1 To 30
barpop(i) = 1 / (popvalue(i))
barpop(i) = barpop(i) / sumpopvalue
Next
cumaldistrupop(0) = 0
For i = 1 To 30
cumaldistrupop(i) = cumaldistrupop(i - 1) + barpop(i)
Next
Randomize
rrollet = Math.Rnd
Dim counter As Integer
counter = 1
While rrollet > cumaldistrupop(counter)
counter = counter + 1
Wend
selectedpop1 = counter
counter = 1
Randomize
rrollet = Math.Rnd
counter = 1
While rrollet > cumaldistrupop(counter)
counter = counter + 1
Wend
selectedpop2 = counter
Dim crossover As Integer
crossover = Int(Math.Rnd() * 19) + 1 'generating a number between 1 and 9
Dim newpop1(20) As Integer
Dim newpop2(20) As Integer
Dim newpop1value As Double
Dim newpop2value As Double
For i = 0 To 20
newpop1(i) = pop(selectedpop1, i)
newpop2(i) = pop(selectedpop2, i)
Next
For i = 0 To crossover
temppop(i) = newpop1(i)
newpop1(i) = newpop2(i)
newpop2(i) = temppop(i)
Next
xp = 0
yp = 0
For i = 0 To 9
xp = newpop1(i) * Base(i) + xp
Next
For i = 10 To 19
yp = newpop1(i) * Base(i - 10) + yp
Next
x = xp / 100
y = yp / 100
newpop1value = (1.5 - x + x * y) * (1.5 - x + x * y) + (2.25 - x + x * y * y) * (2.25 - x + x * y * y) + (2.625 - x + x * y * y * y) * (2.625 - x + x * y * y * y)
xp = 0
yp = 0
For i = 0 To 9
xp = newpop2(i) * Base(i) + xp
Next
For i = 10 To 19
yp = newpop2(i) * Base(i - 10) + yp
Next
x = xp / 100
y = yp / 100
newpop2value = (1.5 - x + x * y) * (1.5 - x + x * y) + (2.25 - x + x * y * y) * (2.25 - x + x * y * y) + (2.625 - x + x * y * y * y) * (2.625 - x + x * y * y * y)
'sorting population
Dim arraytemp As Double
arraytemp = 0
For i = 1 To 30
For j = 1 To 29
If popvalue(j) > popvalue(j + 1) Then
    arraytemp = popvalue(j)
    popvalue(j) = popvalue(j + 1)
    popvalue(j + 1) = arraytemp
    For t = 0 To 20
     arraytemp = pop(j, t)
     pop(j, t) = pop(j + 1, t)
     pop(j + 1, t) = arraytemp
    Next ' t
   end If

Next ' j
Next  ' i
If popvalue(29) > newpop1value And popvalue(29) > newpop2value Then
If newpop1value < newpop2value Then
For t = 0 To 20
pop(29, t) = newpop1(t)
pop(30, t) = newpop2(t)
Next
popvalue(29) = newpop1value
popvalue(30) = newpop2value
End If
End If
If popvalue(29) > newpop1value And popvalue(29) < newpop2value Then
For t = 0 To 20
pop(29, t) = newpop1(t)
Next
popvalue(29) = newpop1value
End If
If popvalue(29) < newpop1value And popvalue(29) > newpop2value Then
For t = 0 To 20
pop(29, t) = newpop2(t)
Next
popvalue(29) = newpop2value
End If
If popvalue(29) < newpop1value And popvalue(29) < newpop2value Then
If popvalue(30) > newpop1value And popvalue(30) > newpop2value Then
If newpop1value < newpop2value Then
For t = 0 To 20
pop(30, t) = newpop1(t)
Next
popvalue(30) = newpop1value
Else
For t = 0 To 20
pop(30, t) = newpop2(t)
Next
popvalue(30) = newpop2value
End If
End If
End If
'sorting before mutation
'Dim arraytemp As Double
arraytemp = 0
For i = 1 To 30
For j = 1 To 29
If popvalue(j) > popvalue(j + 1) Then
    arraytemp = popvalue(j)
    popvalue(j) = popvalue(j + 1)
    popvalue(j + 1) = arraytemp
    For t = 0 To 20
     arraytemp = pop(j, t)
     pop(j, t) = pop(j + 1, t)
     pop(j + 1, t) = arraytemp
    Next ' t
    
End If
Next ' j
Next  ' i
'mutation
Dim mut As Double
If mut < rmutation Then
Dim muran As Double
Dim mutrangen As Double
muran = Int(Math.Rnd() * 30) + 1
mutrangen = Int(Math.Rnd * 20) + 1
For i = 0 To 20
newpop1(i) = pop(muran, i)
'newpop2(i) = pop(selectedpop2, i)
Next
xp = 0
yp = 0
For i = 0 To 9
xp = newpop1(i) * Base(i) + xp
Next
For i = 10 To 19
yp = newpop1(i) * Base(i - 10) + yp
Next
x = xp / 100
y = yp / 100
newpop1value = (1.5 - x + x * y) * (1.5 - x + x * y) + (2.25 - x + x * y * y) * (2.25 - x + x * y * y) + (2.625 - x + x * y * y * y) * (2.625 - x + x * y * y * y)
If popvalue(30) > newpop1value Then
For t = 0 To 20
pop(30, t) = newpop1(t)
Next
popvalue(30) = newpop1value
End If
End If
'sorting after mutation
'Dim arraytemp As Double
arraytemp = 0
For i = 1 To 30
For j = 1 To 29
If popvalue(j) > popvalue(j + 1) Then
    arraytemp = popvalue(j)
    popvalue(j) = popvalue(j + 1)
    popvalue(j + 1) = arraytemp
    For t = 0 To 20
     arraytemp = pop(j, t)
     pop(j, t) = pop(j + 1, t)
     pop(j + 1, t) = arraytemp
    Next ' t
    
End If
Next ' j
Next  ' i
Dim avera As Double
avera = 0
For t = 1 To 30
avera = avera + popvalue(t)
Next
avera = avera / 30
averagefucntion(geneticalgorithm) = avera
Next
'reporting x and y variables
Dim xvariable(30) As Double
Dim yvariable(30) As Double
Dim objectivefu(30) As Double
For t = 1 To 30
xp = 0
yp = 0
For i = 0 To 9
xp = pop(t, i) * Base(i) + xp
Next
For i = 10 To 19
yp = pop(t, i) * Base(i - 10) + yp
Next
x = xp / 100
y = yp / 100

newpop1value = (1.5 - x + x * y) * (1.5 - x + x * y) + (2.25 - x + x * y * y) * (2.25 - x + x * y * y) + (2.625 - x + x * y * y * y) * (2.625 - x + x * y * y * y)
xvariable(t) = x
yvariable(t) = y
objectivefu(t) = newpop1value
Next
For t = 1 To 1000
Cells(t, 17).Value = averagefucntion(t)
Next