<%@ Language=VBScript %><% option explicit %>
Rainer's research on evolution, skills, and language comprehension
<%
'-- still to do: bias to growth, shrinking ---
DIM ScreenWidth, ScreenHeight
DIM timeout
DIM msg '-- for errors
DIM CS_1 'Connection String
DIM RS_0, RS_1, RS_2, RS_A, RS_X 'RecordSet
DIM Q_0, Q_1, Q_2, Q_A, Q_X 'SQL query against the db
DIM max_a, max_b, min_a, min_b, diff_a, diff_b
DIM next_URI
DIM a_plus, b_plus, a_minus, b_minus
DIM opt_A, opt_B
DIM att_a, att_b, att_a1, att_b1
DIM dist, dist_max, dist_min, dist_sum, dist_avg, dist_sel
DIM nCount
DIM copyStepCount, stepCount1, copyStepGen_x, copyStepGen_x1
DIM popCount, popCount1, popCount2, popCountLimit
DIM copyRate, distRate, randRate
DIM lowBound, upBound, lowBound1, upBound1, randNo
DIM nCopy
'' extend the timeout to allow for long files
timeout = Server.ScriptTimeout
'' Response.Write "Initial timeout=" & timeout & "
"
Server.ScriptTimeout = 3600
' ------ set up constants for the simulation --------
ScreenWidth = Request.Cookies("Humble")("ScreenWidth")
ScreenHeight = Request.Cookies("Humble")("ScreenHeight")
copyRate = Request.Cookies("Humble")("CopyRate")
distRate = CDbl(Request.Cookies("Humble")("DistRate"))
randRate = CDbl(Request.Cookies("Humble")("RandRate"))
copyStepGen_x = CInt(Request.Cookies("Humble")("CopyStepGen_x"))
copyStepGen_x1 = 0 'flag for gen_x for gen_x comparison pop
a_plus = Request.Cookies("Humble")("A_plus")
a_minus = Request.Cookies("Humble")("A_minus")
b_plus = Request.Cookies("Humble")("B_plus")
b_minus = Request.Cookies("Humble")("B_minus")
opt_A = Request.Cookies("Humble")("Opt_A")
opt_B = Request.Cookies("Humble")("Opt_B")
' -- normally nCopy = 1, each parent gets 1 offspring --
lowBound = CDbl(randRate / 200.0) 'half of % - if below, nCopy goes to 0
upBound = CDbl(1.0 - randRate / 200.0) ' if above, nCopy goes to 2
' -- add individual distance-based contribution to the boundary -- (distRate)
' ------- initialize the tables ---------------------------------------
CS_1 = "DSN=evolve"
'-- get Admin table to record stats
Q_A = "SELECT * FROM Admin"
SET RS_A = Server.CreateObject("ADODB.Recordset")
RS_A.Open Q_A, CS_1, adOpenKeySet, adLockPessimistic, adCmdText
IF RS_A.EOF THEN
RS_A.AddNew
END IF
'-- get gen_1 table (parent) to receive attribute data
Q_1 = "SELECT * FROM gen_1"
SET RS_1 = Server.CreateObject("ADODB.Recordset")
RS_1.Open Q_1, CS_1, adOpenKeySet, adLockPessimistic, adCmdText
IF RS_1.EOF THEN
msg = msg & " *** no data gen_1 *** "
END IF
'-- get gen_2 table with attribute data, child become parent
Q_2 = "SELECT * FROM gen_2"
SET RS_2 = Server.CreateObject("ADODB.Recordset")
RS_2.Open Q_2, CS_1, adOpenKeySet, adLockPessimistic, adCmdText
IF RS_2.EOF THEN
msg = msg & " *** no data gen_2 *** "
END IF
' ------ initialize parameters that vary from generation to generation ------
popCount = Request.Cookies("Humble")("urPopCount")
popCountLimit = popCount * 20 '** limit population growth **
copyStepCount = Request.Cookies("Humble")("CopyStepCount")
Response.Write "Evolution sequence with " & copyStepCount _
& " generations and a starting population of " & popCount & "
"
Response.Write "Gen_x for comparison: " & copyStepGen_x & "
"
Response.Flush
' **************************************************************************
' ------ Loop through the evolution generations with CopyStepCount ------
FOR stepCount1 = 1 TO copyStepCount
'-- copy child-generation table into the parent generation table ---
' --- the children become parents in turn ---
IF NOT (stepCount1 <> copyStepGen_x) THEN
' Response.Write "
Gen_x at " & stepCount1 & " generations
-"
' Response.Flush
'-- get gen_x table
Q_X = "SELECT * FROM gen_x"
SET RS_X = Server.CreateObject("ADODB.Recordset")
RS_X.Open Q_X, CS_1, adOpenKeySet, adLockPessimistic, adCmdText
RS_X.MoveFirst
copyStepGen_x1 = 1
ELSE
Response.Write "-"
Response.Flush
END IF
'*********************************************************************
' copy from child to parent * also collect distance info -- for selection *
dist_max = 0
dist_min = 1000
dist_sum = 0
RS_2.MoveFirst
RS_1.MoveFirst
FOR popCount1 = 1 TO popCount
IF RS_2.EOF THEN 'the population table cannot exceed popCount
msg = msg & " *** popCount exceeded table *** "
END IF
IF RS_1.EOF THEN 'the population could grow or shrink - in popCount
RS_1.AddNew
END IF
att_A = RS_2.Fields("A")
RS_1.Fields("A") = att_A
att_B = RS_2.Fields("B")
RS_1.Fields("B") = att_B
IF copyStepGen_x1 > 0 THEN
IF RS_X.EOF THEN
RS_X.AddNew
END IF
RS_X.Fields("A") = att_A
RS_X.Fields("B") = att_B
RS_X.Update
RS_X.MoveNext
END IF
dist = SQR((opt_A-att_A)^2 + (opt_B-att_B)^2)
IF dist > dist_max THEN
dist_max = dist
ELSEIF dist < dist_min THEN
dist_min = dist
END IF
dist_sum = dist_sum + dist
RS_1.Fields("dist") = dist
RS_1.Update
RS_1.MoveNext
RS_2.MoveNext
NEXT
dist_avg = dist_sum / popCount
IF copyStepGen_x1 > 0 THEN
RS_X.Close
Response.Write "X"
Response.Flush
copyStepGen_x1 = 0 'reset the flag
END IF
'*********************************************************************
' calculate distance (selection) effect on number of copies per individual
' measure is 0 at average distance, 1 at least distance, -1 at max. distance
' -- add 1 to make it 0 at max distance, 1 at avg. and 2 at min
' -- so it could function as nCopy that is neutral on population growth
' we want to limit the impact of the distance measure
' -- so it only affects some percentage of the reproduction rate
' start random number generator
RANDOMIZE
RS_1.MoveFirst
RS_2.MoveFirst
popCount2 = 0
FOR popCount1 = 1 TO popCount
dist = RS_1.Fields("dist")
' IF dist < dist_avg THEN '--lower upBound
' closer to dist_min gets a larger positive effect, higher % of nCopy=2
' (avg is neutral), further gets higher % of nCopy=0
dist_sel = (dist - dist_min) / (dist_max - dist_min)
upBound1 = upBound - (1.0 - dist_sel) * distRate / 100
lowBound1 = lowBound + (dist_sel * distRate / 100)
' ELSE
' dist_sel = (dist - dist_avg) / (dist_max - dist_min)
' lowBound1 = lowBound + (1.0 - dist_sel) * distRate / 100
' upBound1 = upBound - (dist_sel * distRate / 100)
' END IF
RS_1.Fields("dist_sel") = dist_sel
randNo = RND
IF randNoupBound1 THEN
nCopy = 2
ELSE
nCopy = 1
END IF
RS_1.Fields("nCopy") = nCopy
'-- a parent could have 0, 1, or 2 children --- copy to first child ---------
IF nCopy > 0 THEN
popCount2 = popCount2 + 1
IF RS_2.EOF THEN
RS_2.AddNew
END IF
randNo = RND
IF randNo <= 0.5 THEN
RS_2.Fields("A") = RS_1.Fields("A")-((0.5-randNo)/0.5)*a_minus
ELSE
RS_2.Fields("A") = RS_1.Fields("A")+((randNo-0.5)/0.5)*a_plus
END IF
randNo = RND
IF randNo <= 0.5 THEN
RS_2.Fields("B") = RS_1.Fields("B")-((0.5-randNo)/0.5)*b_minus
ELSE
RS_2.Fields("B") = RS_1.Fields("B")+((randNo-0.5)/0.5)*b_plus
END IF
RS_2.Update
RS_2.MoveNext
END IF
' -------------------------- copy to second child ------------
IF nCopy > 1 THEN
popCount2 = popCount2 + 1
IF RS_2.EOF THEN
RS_2.AddNew
END IF
randNo = RND
IF randNo <= 0.5 THEN
RS_2.Fields("A") = RS_1.Fields("A")-((0.5-randNo)/0.5)*a_minus
ELSE
RS_2.Fields("A") = RS_1.Fields("A")+((randNo-0.5)/0.5)*a_plus
END IF
randNo = RND
IF randNo <= 0.5 THEN
RS_2.Fields("B") = RS_1.Fields("B")-((0.5-randNo)/0.5)*b_minus
ELSE
RS_2.Fields("B") = RS_1.Fields("B")+((randNo-0.5)/0.5)*b_plus
END IF
RS_2.Update
RS_2.MoveNext
END IF
' -----------------------------------------------------------------------
RS_1.Update
RS_1.MoveNext
NEXT
' RS_1.MoveLast
'*********************************************************************
IF RS_A.EOF THEN 'the Admin table can grow
RS_A.AddNew
END IF
RS_A.Fields("popCount") = popCount
RS_A.Fields("dist_avg") = dist_avg
RS_A.Fields("third") = upBound - 0.05
RS_A.Fields("msg") = msg
RS_A.Update
RS_A.MoveNext
msg = ""
IF (stepCount1 MOD 3) = 0 THEN
Response.Write "."
Response.Flush
END IF
IF popCount2 < popCountLimit THEN
popCount = popCount2
ELSE
popCount = popCountLimit
END IF
NEXT
' Response.Cookies("Humble")("PopCount")=popCount
Response.Write "
Evolution complete after " & CopyStepCount & _
" generations and a final population of " & popCount & "
"
Response.Flush
' next_URI = "sel_copy.asp?CopyStepCount=" & copyStepCount & "&PopCount=" & popCount2
' Response.Cookies("Humble")("Test")=next_URI
' Response.Write "** copyStepCount=" & copyStepCount & "
"
' Response.Write "**" & next_URI & "**
"
' Response.Flush
' Response.Redirect( next_URI)
'' reset the timeout
Server.ScriptTimeout = timeout
Response.End '-----------------------------------------------------------%>