First the macro for generating adam & Eve
then 3 children
9 gchildren
27 ggrandchildren only, so far
With the pg0 file of randomly generated
profiles then the sets of generations.
I could not find any errors in the profiles
Print off both data files and rule-off every 4
columns and 3 rows on the children file ,and
every 4th column 2 rows, then every 3 rows
for the pg0 file
Each profile is an amalgum of the relevant profile in
pg0 and the previous generation. Each pair is of numbers
is a random one from one of 2 in one profile and one from
2 of the other .
Further generations should be just matter of
changing pg0 dimensions ,x limit and m and mm limits
' Generating 10 loci x2 profiles
' to be called on later
' 2 +3 +9 +27 +81 +243 = 365 = profiles
zz = 0
Dim ph(20)
Dim ps As String
Dim pg0(365, 20)
Dim pg1(1, 20)
Dim pg2(2, 20)
' initialising RNG
Randomize
a = 214013
c = 2531011
x0 = Timer
z = 2 ^ 24
Dim pg3(8, 20)
Dim pg4(26, 20)
Dim pg5(80, 20)
Dim pg6(242, 20)
Dim pg7(728, 20)
Open "sept29-7m.txt" For Output As #2
Open "sept29-7mb.txt" For Output As #3
Open "sept29-24" For Output As #24
Open "sept29-25" For Output As #25
Open "sept29-26" For Output As #26
Open "sept29-27" For Output As #27
For xx = 0 To 9
count9 = 0
count8 = 0
Open "sept29-0" For Output As #10
Open "sept29-1" For Output As #11
Open "sept29-2" For Output As #12
Open "sept29-3" For Output As #13
Open "sept29-4" For Output As #14
Open "sept29-5" For Output As #15
Open "sept29-6" For Output As #16
Open "sept29-7" For Output As #17
Open "sept29-7b" For Output As #18
For x = 0 To 364
For j = 0 To 1
' vWA
' RNG
temp = x0 * a + c
temp = temp / z
x1 = (temp - Fix(temp)) * z
x0 = x1
phj = x1 / z
ph(j) = phj
If ph(j) < 0.001 Then ph(j) = 11
If ph(j) < 0.106 Then ph(j) = 1
If ph(j) < 0.186 Then ph(j) = 2
If ph(j) < 0.402 Then ph(j) = 3
If ph(j) < 0.672 Then ph(j) = 4
If ph(j) < 0.891 Then ph(j) = 5
If ph(j) < 0.984 Then ph(j) = 6
If ph(j) < 0.998 Then ph(j) = 7
If ph(j) < 1 Then ph(j) = 8
If ph(j) > 10 Then ph(j) = 0
Next j
For j = 2 To 3
' THO1
' RNG
temp = x0 * a + c
temp = temp / z
x1 = (temp - Fix(temp)) * z
x0 = x1
phj = x1 / z
ph(j) = phj
If ph(j) < 0.002 Then ph(j) = 11
If ph(j) < 0.243 Then ph(j) = 1
If ph(j) < 0.437 Then ph(j) = 2
If ph(j) < 0.545 Then ph(j) = 3
If ph(j) < 0.546 Then ph(j) = 4
If ph(j) < 0.686 Then ph(j) = 5
If ph(j) < 0.99 Then ph(j) = 6
If ph(j) < 1 Then ph(j) = 7
If ph(j) > 10 Then ph(j) = 0
Next j
For j = 4 To 5
' D8
' RNG
temp = x0 * a + c
temp = temp / z
x1 = (temp - Fix(temp)) * z
x0 = x1
phj = x1 / z
ph(j) = phj
If ph(j) < 0.018 Then ph(j) = 11
If ph(j) < 0.031 Then ph(j) = 1
If ph(j) < 0.125 Then ph(j) = 2
If ph(j) < 0.191 Then ph(j) = 3
If ph(j) < 0.334 Then ph(j) = 4
If ph(j) < 0.667 Then ph(j) = 5
If ph(j) < 0.876 Then ph(j) = 6
If ph(j) < 0.964 Then ph(j) = 7
If ph(j) < 0.995 Then ph(j) = 8
If ph(j) < 1 Then ph(j) = 9
If ph(j) > 10 Then ph(j) = 0
Next j
For j = 6 To 7
' FGA
' RNG
temp = x0 * a + c
temp = temp / z
x1 = (temp - Fix(temp)) * z
x0 = x1
phj = x1 / z
ph(j) = phj
If ph(j) < 0.025 Then ph(j) = 11
If ph(j) < 0.081 Then ph(j) = 1
If ph(j) < 0.224 Then ph(j) = 2
If ph(j) < 0.411 Then ph(j) = 3
If ph(j) < 0.576 Then ph(j) = 4
If ph(j) < 0.587 Then ph(j) = 5
If ph(j) < 0.726 Then ph(j) = 6
If ph(j) < 0.872 Then ph(j) = 7
If ph(j) < 0.947 Then ph(j) = 8
If ph(j) < 0.982 Then ph(j) = 9
If ph(j) < 1 Then ph(j) = 0
' 1.8% not generated
If ph(j) > 10 Then ph(j) = 0
Next j
For j = 8 To 9
' D21
' RNG
temp = x0 * a + c
temp = temp / z
x1 = (temp - Fix(temp)) * z
x0 = x1
phj = x1 / z
ph(j) = phj
If ph(j) < 0.031 Then ph(j) = 11
If ph(j) < 0.191 Then ph(j) = 1
If ph(j) < 0.417 Then ph(j) = 2
If ph(j) < 0.675 Then ph(j) = 3
If ph(j) < 0.702 Then ph(j) = 4
If ph(j) < 0.771 Then ph(j) = 5
If ph(j) < 0.864 Then ph(j) = 6
If ph(j) < 0.882 Then ph(j) = 7
If ph(j) < 0.972 Then ph(j) = 8
If ph(j) < 0.994 Then ph(j) = 9
If ph(j) < 1 Then ph(j) = 0
' 0.5% not generated
If ph(j) > 10 Then ph(j) = 0
Next j
For j = 10 To 11
' D18
' RNG
temp = x0 * a + c
temp = temp / z
x1 = (temp - Fix(temp)) * z
x0 = x1
phj = x1 / z
ph(j) = phj
If ph(j) < 0.012 Then ph(j) = 11
If ph(j) < 0.151 Then ph(j) = 1
If ph(j) < 0.276 Then ph(j) = 2
If ph(j) < 0.44 Then ph(j) = 3
If ph(j) < 0.585 Then ph(j) = 4
If ph(j) < 0.722 Then ph(j) = 5
If ph(j) < 0.837 Then ph(j) = 6
If ph(j) < 0.917 Then ph(j) = 7
If ph(j) < 0.958 Then ph(j) = 8
If ph(j) < 0.975 Then ph(j) = 9
If ph(j) < 1 Then ph(j) = 0
' 2.5% not generated
If ph(j) > 10 Then ph(j) = 0
Next j
For j = 12 To 13
' D2S1338
' RNG
temp = x0 * a + c
temp = temp / z
x1 = (temp - Fix(temp)) * z
x0 = x1
phj = x1 / z
ph(j) = phj
If ph(j) < 0.037 Then ph(j) = 11
If ph(j) < 0.222 Then ph(j) = 1
If ph(j) < 0.309 Then ph(j) = 2
If ph(j) < 0.419 Then ph(j) = 3
If ph(j) < 0.557 Then ph(j) = 4
If ph(j) < 0.589 Then ph(j) = 5
If ph(j) < 0.613 Then ph(j) = 6
If ph(j) < 0.725 Then ph(j) = 7
If ph(j) < 0.867 Then ph(j) = 8
If ph(j) < 0.978 Then ph(j) = 9
If ph(j) < 1 Then ph(j) = 0
' 2.2% not generated
If ph(j) > 10 Then ph(j) = 0
Next j
For j = 14 To 15
' D16
' RNG
temp = x0 * a + c
temp = temp / z
x1 = (temp - Fix(temp)) * z
x0 = x1
phj = x1 / z
ph(j) = phj
If ph(j) < 0.019 Then ph(j) = 11
If ph(j) < 0.148 Then ph(j) = 1
If ph(j) < 0.202 Then ph(j) = 2
If ph(j) < 0.491 Then ph(j) = 3
If ph(j) < 0.779 Then ph(j) = 4
If ph(j) < 0.965 Then ph(j) = 5
If ph(j) < 0.994 Then ph(j) = 6
If ph(j) < 1 Then ph(j) = 7
If ph(j) > 10 Then ph(j) = 0
Next j
For j = 16 To 17
' D19
' RNG
temp = x0 * a + c
temp = temp / z
x1 = (temp - Fix(temp)) * z
x0 = x1
phj = x1 / z
ph(j) = phj
If ph(j) < 0.087 Then ph(j) = 11
If ph(j) < 0.309 Then ph(j) = 1
If ph(j) < 0.322 Then ph(j) = 2
If ph(j) < 0.704 Then ph(j) = 3
If ph(j) < 0.713 Then ph(j) = 4
If ph(j) < 0.896 Then ph(j) = 5
If ph(j) < 0.934 Then ph(j) = 6
If ph(j) < 0.975 Then ph(j) = 7
If ph(j) < 0.992 Then ph(j) = 8
If ph(j) < 0.997 Then ph(j) = 9
If ph(j) < 1 Then ph(j) = 0
If ph(j) > 10 Then ph(j) = 0
' 0.3% not generated
Next j
For j = 18 To 19
' D3
' RNG
temp = x0 * a + c
temp = temp / z
x1 = (temp - Fix(temp)) * z
x0 = x1
phj = x1 / z
ph(j) = phj
If ph(j) < 0.001 Then ph(j) = 11
If ph(j) < 0.007 Then ph(j) = 1
If ph(j) < 0.139 Then ph(j) = 2
If ph(j) < 0.404 Then ph(j) = 3
If ph(j) < 0.651 Then ph(j) = 4
If ph(j) < 0.846 Then ph(j) = 5
If ph(j) < 0.987 Then ph(j) = 6
If ph(j) < 1 Then ph(j) = 7
If ph(j) > 10 Then ph(j) = 0
Next j
' directing pairs
For j = 0 To 18 Step 2
If ph(j + 1) < ph(j) Then
jjj = ph(j)
ph(j) = ph(j + 1)
ph(j + 1) = jjj
End If
pg0(x, j) = ph(j)
pg0(x, j + 1) = ph(j + 1)
Next j
Write #10, pg0(x, 0) & pg0(x, 1) & pg0(x, 2) & pg0(x, 3) & pg0(x, 4) & pg0(x, 5) & pg0(x, 6) & pg0(x, 7) & pg0(x, 8) & pg0(x, 9) & pg0(x, 10) & pg0(x, 11) & pg0(x, 12) & pg0(x, 13) & pg0(x, 14) & pg0(x, 15) & pg0(x, 16) & pg0(x, 17) & pg0(x, 18) & pg0(x, 19)
Next x
' generating adam and eve
For m = 0 To 1
For k = 0 To 19
pg1(m, k) = pg0(m, k)
Next k
Write #11, pg1(m, 0) & pg1(m, 1) & pg1(m, 2) & pg1(m, 3) & pg1(m, 4) & pg1(m, 5) & pg1(m, 6) & pg1(m, 7) & pg1(m, 8) & pg1(m, 9) & pg1(m, 10) & pg1(m, 11) & pg1(m, 12) & pg1(m, 13) & pg1(m, 14) & pg1(m, 15) & pg1(m, 16) & pg1(m, 17) & pg1(m, 18) & pg1(m, 19)
Next m
' first generation of 3 offspring
' 4 way random to select one of
' 2 alleles from adam and one of 2 from eve
' 3 times over
For m = 0 To 2
For k = 0 To 18 Step 2
rr = Rnd
pg2(m, k) = pg1(0, k)
pg2(m, k + 1) = pg1(1, k)
If rr < 0.75 Then
pg2(m, k) = pg1(0, k)
pg2(m, k + 1) = pg1(1, k + 1)
End If
If rr < 0.5 Then
pg2(m, k) = pg1(0, k + 1)
pg2(m, k + 1) = pg1(1, k)
End If
If rr < 0.25 Then
pg2(m, k) = pg1(0, k + 1)
pg2(m, k + 1) = pg1(1, k + 1)
End If
Next k
' directing pairs
For j = 0 To 18 Step 2
If pg2(m, j + 1) < pg2(m, j) Then
jjj = pg2(m, j)
pg2(m, j) = pg2(m, j + 1)
pg2(m, j + 1) = jjj
End If
Next j
Write #12, pg2(m, 0) & pg2(m, 1) & pg2(m, 2) & pg2(m, 3) & pg2(m, 4) & pg2(m, 5) & pg2(m, 6) & pg2(m, 7) & pg2(m, 8) & pg2(m, 9) & pg2(m, 10) & pg2(m, 11) & pg2(m, 12) & pg2(m, 13) & pg2(m, 14) & pg2(m, 15) & pg2(m, 16) & pg2(m, 17) & pg2(m, 18) & pg2(m, 19)
Next m
' second generation of 3 offspring of each pg2 parent
' 4 way random to select one of
' 2 alleles from each offsping and
' one of 2 from a random parent
For mm = 0 To 6 Step 3
' mm 1,2 or3 rd child
For m = 0 To 2
' m parent
For k = 0 To 18 Step 2
rr = Rnd
' mm+m+2 (2 as 2 called up previously in pg0)
pg3(mm + m, k) = pg0(m + 2, k)
pg3(mm + m, k + 1) = pg2(m, k)
If rr < 0.75 Then
pg3(mm + m, k) = pg0(m + 2, k)
pg3(mm + m, k + 1) = pg2(m, k + 1)
End If
If rr < 0.5 Then
pg3(mm + m, k) = pg0(m + 2, k + 1)
pg3(mm + m, k + 1) = pg2(m, k)
End If
If rr < 0.25 Then
pg3(mm + m, k) = pg0(m + 2, k + 1)
pg3(mm + m, k + 1) = pg2(m, k + 1)
End If
Next k
' directing pairs
For j = 0 To 18 Step 2
If pg3(mm + m, j + 1) < pg3(mm + m, j) Then
jjj = pg3(mm + m, j)
pg3(mm + m, j) = pg3(mm + m, j + 1)
pg3(mm + m, j + 1) = jjj
End If
Next j
Write #13, pg3(mm + m, 0) & pg3(mm + m, 1) & pg3(mm + m, 2) & pg3(mm + m, 3) & pg3(mm + m, 4) & pg3(mm + m, 5) & pg3(mm + m, 6) & pg3(mm + m, 7) & pg3(mm + m, 8) & pg3(mm + m, 9) & pg3(mm + m, 10) & pg3(mm + m, 11) & pg3(mm + m, 12) & pg3(mm + m, 13) & pg3(mm + m, 14) & pg3(mm + m, 15) & pg3(mm + m, 16) & pg3(mm + m, 17) & pg3(mm + m, 18) & pg3(mm + m, 19)
Next m
Next mm
' third generation of 3 offspring of each pg3 parent
' 4 way random to select one of
' 2 alleles from each parent and
' 2 from a random parent
For mm = 0 To 18 Step 9
For m = 0 To 8
For k = 0 To 18 Step 2
rr = Rnd
' the + as first 2 + 3used previously
pg4(mm + m, k) = pg0(m + 5, k)
pg4(mm + m, k + 1) = pg3(m, k)
If rr < 0.75 Then
pg4(mm + m, k) = pg0(m + 5, k)
pg4(mm + m, k + 1) = pg3(m, k + 1)
End If
If rr < 0.5 Then
pg4(mm + m, k) = pg0(m + 5, k + 1)
pg4(mm + m, k + 1) = pg3(m, k)
End If
If rr < 0.25 Then
pg4(mm + m, k) = pg0(m + 5, k + 1)
pg4(mm + m, k + 1) = pg3(m, k + 1)
End If
Next k
' cousin marriage on 27th mating
rrr = Rnd * 6
If mm + m = 26 Then
Write #24, mm + m, pg4(mm + m, 0) & pg4(mm + m, 1) & pg4(mm + m, 2) & pg4(mm + m, 3) & pg4(mm + m, 4) & pg4(mm + m, 5) & pg4(mm + m, 6) & pg4(mm + m, 7) & pg4(mm + m, 8) & pg4(mm + m, 9) & pg4(mm + m, 10) & pg4(mm + m, 11) & pg4(mm + m, 12) & pg4(mm + m, 13) & pg4(mm + m, 14) & pg4(mm + m, 15) & pg4(mm + m, 16) & pg4(mm + m, 17) & pg4(mm + m, 18) & pg4(mm + m, 19)
For k = 0 To 18 Step 2
rr = Rnd
yy = 7
If rrr < 5 Then yy = 6
If rrr < 4 Then yy = 4
If rrr < 3 Then yy = 3
If rrr < 2 Then yy = 1
If rrr < 1 Then yy = 0
pg4(mm + m, k) = pg3(yy, k)
pg4(mm + m, k + 1) = pg3(m, k)
If rr < 0.75 Then
pg4(mm + m, k) = pg3(yy, k)
pg4(mm + m, k + 1) = pg3(m, k + 1)
End If
If rr < 0.5 Then
pg4(mm + m, k) = pg3(yy, k + 1)
pg4(mm + m, k + 1) = pg3(m, k)
End If
If rr < 0.25 Then
pg4(mm + m, k) = pg3(yy, k + 1)
pg4(mm + m, k + 1) = pg3(m, k + 1)
End If
Next k
Write #24, mm + m, pg4(mm + m, 0) & pg4(mm + m, 1) & pg4(mm + m, 2) & pg4(mm + m, 3) & pg4(mm + m, 4) & pg4(mm + m, 5) & pg4(mm + m, 6) & pg4(mm + m, 7) & pg4(mm + m, 8) & pg4(mm + m, 9) & pg4(mm + m, 10) & pg4(mm + m, 11) & pg4(mm + m, 12) & pg4(mm + m, 13) & pg4(mm + m, 14) & pg4(mm + m, 15) & pg4(mm + m, 16) & pg4(mm + m, 17) & pg4(mm + m, 18) & pg4(mm + m, 19)
End If
' directing pairs
For j = 0 To 18 Step 2
If pg4(mm + m, j + 1) < pg4(mm + m, j) Then
jjj = pg4(mm + m, j)
pg4(mm + m, j) = pg4(mm + m, j + 1)
pg4(mm + m, j + 1) = jjj
End If
Next j
Write #14, pg4(mm + m, 0) & pg4(mm + m, 1) & pg4(mm + m, 2) & pg4(mm + m, 3) & pg4(mm + m, 4) & pg4(mm + m, 5) & pg4(mm + m, 6) & pg4(mm + m, 7) & pg4(mm + m, 8) & pg4(mm + m, 9) & pg4(mm + m, 10) & pg4(mm + m, 11) & pg4(mm + m, 12) & pg4(mm + m, 13) & pg4(mm + m, 14) & pg4(mm + m, 15) & pg4(mm + m, 16) & pg4(mm + m, 17) & pg4(mm + m, 18) & pg4(mm + m, 19)
Next m
Next mm
' fourth generation of 3 offspring of each pg4 parent
' 4 way random to select one of
' 2 alleles from each parent and
' 2 from a random parent
For mm = 0 To 54 Step 27
For m = 0 To 26
For k = 0 To 18 Step 2
rr = Rnd
' the +14 as first 2 +3+ 9 used previously
pg5(mm + m, k) = pg0(m + 14, k)
pg5(mm + m, k + 1) = pg4(m, k)
If rr < 0.75 Then
pg5(mm + m, k) = pg0(m + 14, k)
pg5(mm + m, k + 1) = pg4(m, k + 1)
End If
If rr < 0.5 Then
pg5(mm + m, k) = pg0(m + 14, k + 1)
pg5(mm + m, k + 1) = pg4(m, k)
End If
If rr < 0.25 Then
pg5(mm + m, k) = pg0(m + 14, k + 1)
pg5(mm + m, k + 1) = pg4(m, k + 1)
End If
Next k
' cousin marriage on 40th mating
rrr1 = Rnd * 6
rrr2 = Rnd * 6
If mm + m = 40 Or mm + m = 80 Then
Write #25, mm + m, pg5(mm + m, 0) & pg5(mm + m, 1) & pg5(mm + m, 2) & pg5(mm + m, 3) & pg5(mm + m, 4) & pg5(mm + m, 5) & pg5(mm + m, 6) & pg5(mm + m, 7) & pg5(mm + m, 8) & pg5(mm + m, 9) & pg5(mm + m, 10) & pg5(mm + m, 11) & pg5(mm + m, 12) & pg5(mm + m, 13) & pg5(mm + m, 14) & pg5(mm + m, 15) & pg5(mm + m, 16) & pg5(mm + m, 17) & pg5(mm + m, 18) & pg5(mm + m, 19)
If mm + m = 40 Then rrr = rrr1
If mm + m = 40 Then rrr = rrr2
For k = 0 To 18 Step 2
rr = Rnd
yy = 19
If rrr < 5 Then yy = 25
If rrr < 4 Then yy = 24
If rrr < 3 Then yy = 23
If rrr < 2 Then yy = 21
If rrr < 1 Then yy = 20
pg5(mm + m, k) = pg4(yy, k)
pg5(mm + m, k + 1) = pg4(m, k)
If rr < 0.75 Then
pg5(mm + m, k) = pg4(yy, k)
pg5(mm + m, k + 1) = pg4(m, k + 1)
End If
If rr < 0.5 Then
pg5(mm + m, k) = pg4(yy, k + 1)
pg5(mm + m, k + 1) = pg4(m, k)
End If
If rr < 0.25 Then
pg5(mm + m, k) = pg4(yy, k + 1)
pg5(mm + m, k + 1) = pg4(m, k + 1)
End If
Next k
Write #25, mm + m, pg5(mm + m, 0) & pg5(mm + m, 1) & pg5(mm + m, 2) & pg5(mm + m, 3) & pg5(mm + m, 4) & pg5(mm + m, 5) & pg5(mm + m, 6) & pg5(mm + m, 7) & pg5(mm + m, 8) & pg5(mm + m, 9) & pg5(mm + m, 10) & pg5(mm + m, 11) & pg5(mm + m, 12) & pg5(mm + m, 13) & pg5(mm + m, 14) & pg5(mm + m, 15) & pg5(mm + m, 16) & pg5(mm + m, 17) & pg5(mm + m, 18) & pg5(mm + m, 19)
End If
' directing pairs
For j = 0 To 18 Step 2
If pg5(mm + m, j + 1) < pg5(mm + m, j) Then
jjj = pg5(mm + m, j)
pg5(mm + m, j) = pg5(mm + m, j + 1)
pg5(mm + m, j + 1) = jjj
End If
Next j
Write #15, pg5(mm + m, 0) & pg5(mm + m, 1) & pg5(mm + m, 2) & pg5(mm + m, 3) & pg5(mm + m, 4) & pg5(mm + m, 5) & pg5(mm + m, 6) & pg5(mm + m, 7) & pg5(mm + m, 8) & pg5(mm + m, 9) & pg5(mm + m, 10) & pg5(mm + m, 11) & pg5(mm + m, 12) & pg5(mm + m, 13) & pg5(mm + m, 14) & pg5(mm + m, 15) & pg5(mm + m, 16) & pg5(mm + m, 17) & pg5(mm + m, 18) & pg5(mm + m, 19)
Next m
Next mm
' fifth generation of 3 offspring of each pg5 parent
' 4 way random to select one of
' 2 alleles from each parent and
' 2 from a random parent
For mm = 0 To 162 Step 81
For m = 0 To 80
For k = 0 To 18 Step 2
rr = Rnd
pg6(mm + m, k) = pg0(m + 41, k)
pg6(mm + m, k + 1) = pg5(m, k)
If rr < 0.75 Then
pg6(mm + m, k) = pg0(m + 41, k)
pg6(mm + m, k + 1) = pg5(m, k + 1)
End If
If rr < 0.5 Then
pg6(mm + m, k) = pg0(m + 41, k + 1)
pg6(mm + m, k + 1) = pg5(m, k)
End If
If rr < 0.25 Then
pg6(mm + m, k) = pg0(m + 41, k + 1)
pg6(mm + m, k + 1) = pg5(m, k + 1)
End If
Next k
' cousin marriage on 79th mating
rrr = Rnd * 6
If m = 79 Then
Write #26, mm + m, pg6(mm + m, 0) & pg6(mm + m, 1) & pg6(mm + m, 2) & pg6(mm + m, 3) & pg6(mm + m, 4) & pg6(mm + m, 5) & pg6(mm + m, 6) & pg6(mm + m, 7) & pg6(mm + m, 8) & pg6(mm + m, 9) & pg6(mm + m, 10) & pg6(mm + m, 11) & pg6(mm + m, 12) & pg6(mm + m, 13) & pg6(mm + m, 14) & pg6(mm + m, 15) & pg6(mm + m, 16) & pg6(mm + m, 17) & pg6(mm + m, 18) & pg6(mm + m, 19)
For k = 0 To 18 Step 2
rr = Rnd
yy = 77
If rrr < 5 Then yy = 75
If rrr < 4 Then yy = 73
If rrr < 3 Then yy = 71
If rrr < 2 Then yy = 69
If rrr < 1 Then yy = 67
pg6(mm + m, k) = pg5(yy, k)
pg6(mm + m, k + 1) = pg5(m, k)
If rr < 0.75 Then
pg6(mm + m, k) = pg5(yy, k)
pg6(mm + m, k + 1) = pg5(m, k + 1)
End If
If rr < 0.5 Then
pg6(mm + m, k) = pg5(yy, k + 1)
pg6(mm + m, k + 1) = pg5(m, k)
End If
If rr < 0.25 Then
pg6(mm + m, k) = pg5(yy, k + 1)
pg6(mm + m, k + 1) = pg5(m, k + 1)
End If
Next k
Write #26, mm + m, pg6(mm + m, 0) & pg6(mm + m, 1) & pg6(mm + m, 2) & pg6(mm + m, 3) & pg6(mm + m, 4) & pg6(mm + m, 5) & pg6(mm + m, 6) & pg6(mm + m, 7) & pg6(mm + m, 8) & pg6(mm + m, 9) & pg6(mm + m, 10) & pg6(mm + m, 11) & pg6(mm + m, 12) & pg6(mm + m, 13) & pg6(mm + m, 14) & pg6(mm + m, 15) & pg6(mm + m, 16) & pg6(mm + m, 17) & pg6(mm + m, 18) & pg6(mm + m, 19)
End If
' directing pairs
For j = 0 To 18 Step 2
If pg6(mm + m, j + 1) < pg6(mm + m, j) Then
jjj = pg6(mm + m, j)
pg6(mm + m, j) = pg6(mm + m, j + 1)
pg6(mm + m, j + 1) = jjj
End If
Next j
Write #16, pg6(mm + m, 0) & pg6(mm + m, 1) & pg6(mm + m, 2) & pg6(mm + m, 3) & pg6(mm + m, 4) & pg6(mm + m, 5) & pg6(mm + m, 6) & pg6(mm + m, 7) & pg6(mm + m, 8) & pg6(mm + m, 9) & pg6(mm + m, 10) & pg6(mm + m, 11) & pg6(mm + m, 12) & pg6(mm + m, 13) & pg6(mm + m, 14) & pg6(mm + m, 15) & pg6(mm + m, 16) & pg6(mm + m, 17) & pg6(mm + m, 18) & pg6(mm + m, 19)
Next m
Next mm
' sixth generation of 3 offspring of each pg6 parent
' 4 way random to select one of
' 2 alleles from each parent and
' 2 from a random parent
For mm = 0 To 486 Step 243
For m = 0 To 242
For k = 0 To 18 Step 2
rr = Rnd
pg7(mm + m, k) = pg0(m + 122, k)
pg7(mm + m, k + 1) = pg6(m, k)
If rr < 0.75 Then
pg7(mm + m, k) = pg0(m + 122, k)
pg7(mm + m, k + 1) = pg6(m, k + 1)
End If
If rr < 0.5 Then
pg7(mm + m, k) = pg0(m + 122, k + 1)
pg7(mm + m, k + 1) = pg6(m, k)
End If
If rr < 0.25 Then
pg7(mm + m, k) = pg0(m + 122, k + 1)
pg7(mm + m, k + 1) = pg6(m, k + 1)
End If
Next k
' cousin marriage on 79th mating
rrr = Rnd * 6
If m = 79 Then
Write #27, mm + m, pg7(mm + m, 0) & pg7(mm + m, 1) & pg7(mm + m, 2) & pg7(mm + m, 3) & pg7(mm + m, 4) & pg7(mm + m, 5) & pg7(mm + m, 6) & pg7(mm + m, 7) & pg7(mm + m, 8) & pg7(mm + m, 9) & pg7(mm + m, 10) & pg7(mm + m, 11) & pg7(mm + m, 12) & pg7(mm + m, 13) & pg7(mm + m, 14) & pg7(mm + m, 15) & pg7(mm + m, 16) & pg7(mm + m, 17) & pg7(mm + m, 18) & pg7(mm + m, 19)
For k = 0 To 18 Step 2
rr = Rnd
yy = 76
If rrr < 5 Then yy = 74
If rrr < 4 Then yy = 72
If rrr < 3 Then yy = 70
If rrr < 2 Then yy = 69
If rrr < 1 Then yy = 68
pg7(mm + m, k) = pg6(yy, k)
pg7(mm + m, k + 1) = pg6(m, k)
If rr < 0.75 Then
pg7(mm + m, k) = pg6(yy, k)
pg7(mm + m, k + 1) = pg6(m, k + 1)
End If
If rr < 0.5 Then
pg7(mm + m, k) = pg6(yy, k + 1)
pg7(mm + m, k + 1) = pg6(m, k)
End If
If rr < 0.25 Then
pg7(mm + m, k) = pg6(yy, k + 1)
pg7(mm + m, k + 1) = pg6(m, k + 1)
End If
Next k
Write #27, mm + m, pg7(mm + m, 0) & pg7(mm + m, 1) & pg7(mm + m, 2) & pg7(mm + m, 3) & pg7(mm + m, 4) & pg7(mm + m, 5) & pg7(mm + m, 6) & pg7(mm + m, 7) & pg7(mm + m, 8) & pg7(mm + m, 9) & pg7(mm + m, 10) & pg7(mm + m, 11) & pg7(mm + m, 12) & pg7(mm + m, 13) & pg7(mm + m, 14) & pg7(mm + m, 15) & pg7(mm + m, 16) & pg7(mm + m, 17) & pg7(mm + m, 18) & pg7(mm + m, 19)
End If
' directing pairs
For j = 0 To 18 Step 2
If pg7(mm + m, j + 1) < pg7(mm + m, j) Then
jjj = pg7(mm + m, j)
pg7(mm + m, j) = pg7(mm + m, j + 1)
pg7(mm + m, j + 1) = jjj
End If
Next j
Write #17, pg7(mm + m, 0) & pg7(mm + m, 1) & pg7(mm + m, 2) & pg7(mm + m, 3) & pg7(mm + m, 4) & pg7(mm + m, 5) & pg7(mm + m, 6) & pg7(mm + m, 7) & pg7(mm + m, 8) & pg7(mm + m, 9) & pg7(mm + m, 10) & pg7(mm + m, 11) & pg7(mm + m, 12) & pg7(mm + m, 13) & pg7(mm + m, 14) & pg7(mm + m, 15) & pg7(mm + m, 16) & pg7(mm + m, 17) & pg7(mm + m, 18) & pg7(mm + m, 19) & zz & xx & zz & mm & zz & m
' the clutter at the end is to check the final result for sibling or other matches
' remove the ends of these #17 and #18 writes for clean 20 digit profiles
Write #18, pg7(mm + m, 10) & pg7(mm + m, 11) & pg7(mm + m, 12) & pg7(mm + m, 13) & pg7(mm + m, 14) & pg7(mm + m, 15) & pg7(mm + m, 16) & pg7(mm + m, 17) & pg7(mm + m, 18) & pg7(mm + m, 19) & pg7(mm + m, 0) & pg7(mm + m, 1) & pg7(mm + m, 2) & pg7(mm + m, 3) & pg7(mm + m, 4) & pg7(mm + m, 5) & pg7(mm + m, 6) & pg7(mm + m, 7) & pg7(mm + m, 8) & pg7(mm + m, 9) & zz & xx & zz & mm & zz & m
Next m
Next mm
Close #10
Close #11
Close #12
Close #13
Close #14
Close #15
Close #16
Close #17
Close #18
Close #2
Close #3
Close #24
Close #25
Close #26
pg0
"35556637122538151136"
"47262636361214335645"
"34165624194649351535"
"15124624381417373522"
"23664534671688343355"
"44372236192328363356"
"44164537061349341125"
"45662226264837363357"
"15166634131602440333"
"56153626455678343836"
"45355626281128353325"
"45134678672418133324"
"44125636383515110123"
"46115734232524330334"
"45225623286814441523"
"44122522384969113312"
"45116647234513141745"
"45265829563412043326"
"13155634583601355626"
"34352534153501451333"
"34163679151303143535"
"45024647264512451524"
"45662427133489141335"
"25233516170627343534"
"24126628483327333656"
"11663323332239230336"
"34112614565503563526"
"44152444150149151524"
"15265513121389451356"
"14362513553712341334"
"46262478021614351356"
"46363767224734143546"
========
pg1
"17164802682378460536"
"14264618191278031725"
pg2
"17164408891378361523"
"47124812691377065723"
"14664408181378361526"
pg3
"17172478393667345534"
"77124511263727361535"
"44662404283428331124"
"16674606393667461534"
"46125812263727461524"
"45564507123418361146"
"17162478083668341335"
"46257811293627035734"
"44564504123317461124"
pg4
"67572668391367353545"
"77124616263423365635"
"44664624583448331345"
"13565607992367361434"
"45163513563417455525"
"56355637254888161156"
"47112568063436241325"
"56225713261324017734"
"45364548233712451346"
"67574667393677343536"
"17164616262727331635"
"46264607253424331325"
"36664567992667340133"
"46233516563412361534"
"46354637153818131345"
"11132568033436343525"
"56222713694679057733"
"45254508231327451126"
"14152668693377343536"
"17264613663423331635"
"46664747583428230125"
"36563607292677440133"
"56133823061322451334"
"45664637153888341156"
"14362568684636443334"
"45225813233447357734"
"46154524123317461124"
pg5
"56252816693647453346"
"47164614364826343534"
"24562622384434333335"
"34355602391227261434"
"55665514351427455724"
"25156727236848141325"
"45155667461439453323"
"45261513023427023736"
"45234634122318451556"
"37676868352377343533"
"47265617262707331656"
"56124827223449333323"
"56662436192467330336"
"46123611163323341334"
"66252434153419333335"
"12361536013546343324"
"46260214393678047736"
"55155604283778441523"
"11566669393437343537"
"14266634064528331325"
"44164647351427240725"
"34566603592417440735"
"35365812033729041346"
"45566667353848451345"
"15265526366923343734"
"15223816233677355724"
"66154428123557341334"
"57172736691327353635"
"47134446663802363534"
"24666747284434331615"
"34155567393646261434"
"45665534163517573524"
"45355633226848141355"
"57162558161413261323"
"36265613021447025736"
"45235634332328453556"
"36375668393477343533"
"14124517223777330134"
"46265627254449330135"
"46364536292617340134"
"44235518563623343533"
"46254447013589131334"
"14132616134536453545"
"46262334293478040736"
"34154607283778441625"
"14165669363378453367"
"15265623163413331634"
"34166747381429131125"
"34666637592417440635"
"45163737031129051136"
"45366636358848351345"
"34365548682626341334"
"45223814233677550734"
"66114514233515451345"
"57156818891646333535"
"37166646363802343645"
"45662422284448341634"
"34355606391227231434"
"55163511161411445712"
"46135637226878141326"
"57155678161469253323"
"45121513681427015746"
"45130534131728341556"
"36374578393477333336"
"47164516223727331656"
"46124507224424341323"
"34664536294667331134"
"44125516163423334533"
"46332667153489143345"
"12131236133933443345"
"45120234363678250736"
"35355604361428451636"
"44552589393437453426"
"14665634063412333625"
"36164627483589240725"
"46663603254617441735"
"36357837361112043546"
"46364537128889351336"
"45235526882423453734"
"45225736354577555733"
"46135526183613461323"
The sequencing of the last 27 in pg4 is
1 - 'mating' first pg3 with first random in pg0 ,9 block (+2 +3)
..
9- 9th pg3 with 9th in pg0,9 block(+2 +3)
10 - 1 pg3 with 0 th in pg0
..
18 - 9th pg3 with 9th in pg0
...
