Return to co-ancestry factor in the NDNAD simulations
Return to co-ancestry factor in the NDNAD simulations
From "trade" journal Forensic Science
International 95 (1998) p30.
http://tinyurl.com/cx9ms (abstract only )
Concerning data in the UK DNA database as of 04 October 1996
when there were 10 pairs of 6 loci matches in 6311 samples from the London
area. The question is how many were due to aliases and how many
due to unrelated DNA profile matches.
The Janet Chaseling reference to a 7 loci match in 9
from an Australian study is about the only source for such untainted
info. Using the straight random and >8.7 percent AF form of generator
as on dnas14.htm file and then used the following VB routine
slightly adjusted allele match count routine given below.
Changed to 9 loci and printing to file 5 (10) ,6 (12) and 7 (14)
matches. This routine is conservative in the sense that I
don't have a routine for checking all profiles against all others
for partial matches. As most matches occur with the most commom
alleles I've used the "Average Joe" profile to match against
instead of the random one used in dnas14.htm.
The true number of partial matches would be higher
than the figure given by this method.
Results
For 20,000 profile run using no co-ancestry factor
gave 3 off 13 allele matches
1 off 14 allele match.
So to get one match in 5,500 must include co-ancestry.
Using the >8.7 percent AF version
5,500 run 1 gave
14 off , 12 allele matches
4 off , 13 allele
2 off , 14 allele matches
5,500 run 2
11 off 12 allele
2 off 13 allele
1 off 14 allele
So >8 per cent would be a justifiable factor.
Which then is in agreement with something like
3 of those 10 6 loci London matches being due to
unrelated DNA profile matches and 7 for use of aliases.
I suspect it was nearer 10 out of 10 were unrelated
DNA profile matches but I have no evidence for that.
' Matching to the "Average Joe" profile
' of 4,5/1,6/5,6/3,4/2,3/3,4/1,4/3,4/1,3 of 9 loci
' number of allele matches >=10 to a given profile
Dim ps As String
Dim ph(20)
' Locus 1
temp = "mar24-d"
temp0 = "mar24-dc"
tempc = "mar24-d1c"
Open temp For Input As #1
Open temp0 For Output As #10
count0 = 0
count1 = 0
Do Until (EOF(1) = True)
count0 = 0
zz = 0
Input #1, ps
a1$ = Mid(ps, 1, 1)
ph(1) = Val(a1$)
a2$ = Mid(ps, 2, 1)
ph(2) = Val(a2$)
xx = zz
' change these 2 lines for each locus
If ph(1) = 4 Then zz = zz + 1
If ph(2) = 5 Then zz = zz + 1
If ph(1) = 5 Then zz = zz + 1
If ph(2) = 4 Then zz = zz + 1
' for homozygotic pair situation , so as
' not to count twice
If ph(1) = ph(2) And zz = xx + 2 Then zz = zz - 1
' Locus 2
a3$ = Mid(ps, 3, 1)
ph(3) = Val(a3$)
a4$ = Mid(ps, 4, 1)
ph(4) = Val(a4$)
xx = zz
' change these 2 lines for each locus
If ph(3) = 1 Then zz = zz + 1
If ph(4) = 6 Then zz = zz + 1
If ph(3) = 6 Then zz = zz + 1
If ph(4) = 1 Then zz = zz + 1
If ph(3) = ph(4) And zz = xx + 2 Then zz = zz - 1
' Locus 3
a5$ = Mid(ps, 5, 1)
ph(5) = Val(a5$)
a6$ = Mid(ps, 6, 1)
ph(6) = Val(a6$)
xx = zz
' change these 2 lines for each locus
If ph(5) = 5 Then zz = zz + 1
If ph(6) = 6 Then zz = zz + 1
If ph(5) = 6 Then zz = zz + 1
If ph(6) = 5 Then zz = zz + 1
If ph(5) = ph(6) And zz = xx + 2 Then zz = zz - 1
' Locus 4
a7$ = Mid(ps, 7, 1)
ph(7) = Val(a7$)
a8$ = Mid(ps, 8, 1)
ph(8) = Val(a8$)
xx = zz
' change these 2 lines for each locus
If ph(7) = 3 Then zz = zz + 1
If ph(8) = 4 Then zz = zz + 1
If ph(7) = 4 Then zz = zz + 1
If ph(8) = 3 Then zz = zz + 1
If ph(7) = ph(8) And zz = xx + 2 Then zz = zz - 1
' Locus 5
a9$ = Mid(ps, 9, 1)
ph(9) = Val(a9$)
a10$ = Mid(ps, 10, 1)
ph(10) = Val(a10$)
xx = zz
' change these 2 lines for each locus
If ph(9) = 2 Then zz = zz + 1
If ph(10) = 3 Then zz = zz + 1
If ph(9) = 3 Then zz = zz + 1
If ph(10) = 2 Then zz = zz + 1
If ph(9) = ph(10) And zz = xx + 2 Then zz = zz - 1
' Locus 6
a11$ = Mid(ps, 11, 1)
ph(11) = Val(a11$)
a12$ = Mid(ps, 12, 1)
ph(12) = Val(a12$)
xx = zz
' change these 2 lines for each locus
If ph(11) = 3 Then zz = zz + 1
If ph(12) = 4 Then zz = zz + 1
If ph(11) = 4 Then zz = zz + 1
If ph(12) = 3 Then zz = zz + 1
If ph(11) = ph(12) And zz = xx + 2 Then zz = zz - 1
' Locus 7
a13$ = Mid(ps, 13, 1)
ph(13) = Val(a13$)
a14$ = Mid(ps, 14, 1)
ph(14) = Val(a14$)
xx = zz
' change these 2 lines for each locus
If ph(13) = 1 Then zz = zz + 1
If ph(14) = 4 Then zz = zz + 1
If ph(13) = 4 Then zz = zz + 1
If ph(14) = 1 Then zz = zz + 1
If ph(13) = ph(14) And zz = xx + 2 Then zz = zz - 1
' Locus 8
a15$ = Mid(ps, 15, 1)
ph(15) = Val(a15$)
a16$ = Mid(ps, 16, 1)
ph(16) = Val(a16$)
xx = zz
' change these 2 lines for each locus
If ph(15) = 3 Then zz = zz + 1
If ph(16) = 4 Then zz = zz + 1
If ph(15) = 4 Then zz = zz + 1
If ph(16) = 3 Then zz = zz + 1
If ph(15) = ph(16) And zz = xx + 2 Then zz = zz - 1
' Locus 9
a17$ = Mid(ps, 17, 1)
ph(17) = Val(a17$)
a18$ = Mid(ps, 18, 1)
ph(18) = Val(a18$)
xx = zz
' change these 2 lines for each locus
If ph(17) = 1 Then zz = zz + 1
If ph(18) = 3 Then zz = zz + 1
If ph(17) = 3 Then zz = zz + 1
If ph(18) = 1 Then zz = zz + 1
If ph(17) = ph(18) And zz = xx + 2 Then zz = zz - 1
If zz >= 10 Then
Write #10, ps, zz
count1 = count1 + 1
End If
Loop
Close (1)
Close #1
Close #10
The next routine checks all 18 positions for allele matches
and counts total matches, ignores 19 and 20 .
For 440 profiles time to process was 1 minute, 24 seconds for
first 100, 18s for next 100 and 12s for next 100 then 10s for last 140
' Checking for random allele matches
' each with another
Dim ps As String
Dim pt As String
Dim ph(20)
Dim pk(20)
temp = "mar26-d"
temp2 = "mar26-d"
temp0 = "mar26-dc"
tempc = "mar26-d1c"
j = 0
k = 0
Open temp2 For Input As #2
Open temp0 For Output As #10
Do Until (EOF(2) = True) Or k = 1
' pt is the profile to be checked against for each
' other than itself
Input #2, pt
b1$ = Mid(pt, 1, 1)
pk(1) = Val(b1$)
b2$ = Mid(pt, 2, 1)
pk(2) = Val(b2$)
b3$ = Mid(pt, 3, 1)
pk(3) = Val(b3$)
b4$ = Mid(pt, 4, 1)
pk(4) = Val(b4$)
b5$ = Mid(pt, 5, 1)
pk(5) = Val(b5$)
b6$ = Mid(pt, 6, 1)
pk(6) = Val(b6$)
b7$ = Mid(pt, 7, 1)
pk(7) = Val(b7$)
b8$ = Mid(pt, 8, 1)
pk(8) = Val(b8$)
b9$ = Mid(pt, 9, 1)
pk(9) = Val(b9$)
b10$ = Mid(pt, 10, 1)
pk(10) = Val(b10$)
b11$ = Mid(pt, 11, 1)
pk(11) = Val(b11$)
b12$ = Mid(pt, 12, 1)
pk(12) = Val(b12$)
b13$ = Mid(pt, 13, 1)
pk(13) = Val(b13$)
b14$ = Mid(pt, 14, 1)
pk(14) = Val(b14$)
b15$ = Mid(pt, 15, 1)
pk(15) = Val(b15$)
b16$ = Mid(pt, 16, 1)
pk(16) = Val(b16$)
b17$ = Mid(pt, 17, 1)
pk(17) = Val(b17$)
b18$ = Mid(pt, 18, 1)
pk(18) = Val(b18$)
k = 0
count0 = 0
count1 = 0
Open temp For Input As #1
Do Until (EOF(1) = True)
Seek #1, 2 + 24 * (1 + j + k)
' pt is the profile to be checked
' 1 added to j+k above as the next line down
' to be read , 24 characters long including "" and CR
zz = 0
Input #1, ps
a1$ = Mid(ps, 1, 1)
ph(1) = Val(a1$)
a2$ = Mid(ps, 2, 1)
ph(2) = Val(a2$)
xx = zz
If ph(1) = pk(1) Then zz = zz + 1
If ph(2) = pk(2) Then zz = zz + 1
If ph(1) = pk(2) Then zz = zz + 1
If ph(2) = pk(1) Then zz = zz + 1
' for homozygotic pair situation , so as
' not to count twice
If zz = 2 And (ph(1) = ph(2) Or pk(1) = pk(2)) Then zz = 1
If zz = 4 Then zz = 2
xx = zz
zz = 0
a3$ = Mid(ps, 3, 1)
ph(3) = Val(a3$)
a4$ = Mid(ps, 4, 1)
ph(4) = Val(a4$)
If ph(3) = pk(3) Then zz = zz + 1
If ph(4) = pk(4) Then zz = zz + 1
If ph(3) = pk(4) Then zz = zz + 1
If ph(4) = pk(3) Then zz = zz + 1
If zz = 2 And (ph(3) = ph(4) Or pk(3) = pk(4)) Then zz = 1
If zz = 4 Then zz = 2
xx = xx + zz
zz = 0
a5$ = Mid(ps, 5, 1)
ph(5) = Val(a5$)
a6$ = Mid(ps, 6, 1)
ph(6) = Val(a6$)
If ph(5) = pk(5) Then zz = zz + 1
If ph(6) = pk(6) Then zz = zz + 1
If ph(5) = pk(6) Then zz = zz + 1
If ph(6) = pk(5) Then zz = zz + 1
If zz = 2 And (ph(5) = ph(6) Or pk(5) = pk(6)) Then zz = 1
If zz = 4 Then zz = 2
xx = xx + zz
zz = 0
a7$ = Mid(ps, 7, 1)
ph(7) = Val(a7$)
a8$ = Mid(ps, 8, 1)
ph(8) = Val(a8$)
If ph(7) = pk(7) Then zz = zz + 1
If ph(8) = pk(8) Then zz = zz + 1
If ph(7) = pk(8) Then zz = zz + 1
If ph(8) = pk(7) Then zz = zz + 1
If zz = 2 And (ph(7) = ph(8) Or pk(7) = pk(8)) Then zz = 1
If zz = 4 Then zz = 2
xx = xx + zz
zz = 0
a9$ = Mid(ps, 9, 1)
ph(9) = Val(a9$)
a10$ = Mid(ps, 10, 1)
ph(10) = Val(a10$)
If ph(9) = pk(9) Then zz = zz + 1
If ph(10) = pk(10) Then zz = zz + 1
If ph(9) = pk(10) Then zz = zz + 1
If ph(10) = pk(9) Then zz = zz + 1
If zz = 2 And (ph(9) = ph(10) Or pk(9) = pk(10)) Then zz = 1
If zz = 4 Then zz = 2
xx = xx + zz
zz = 0
a11$ = Mid(ps, 11, 1)
ph(11) = Val(a11$)
a12$ = Mid(ps, 12, 1)
ph(12) = Val(a12$)
If ph(11) = pk(11) Then zz = zz + 1
If ph(12) = pk(12) Then zz = zz + 1
If ph(11) = pk(12) Then zz = zz + 1
If ph(12) = pk(11) Then zz = zz + 1
If zz = 2 And (ph(11) = ph(12) Or pk(11) = pk(12)) Then zz = 1
If zz = 4 Then zz = 2
xx = xx + zz
zz = 0
a13$ = Mid(ps, 13, 1)
ph(13) = Val(a13$)
a14$ = Mid(ps, 14, 1)
ph(14) = Val(a14$)
If ph(13) = pk(13) Then zz = zz + 1
If ph(14) = pk(14) Then zz = zz + 1
If ph(13) = pk(14) Then zz = zz + 1
If ph(14) = pk(13) Then zz = zz + 1
If zz = 2 And (ph(13) = ph(14) Or pk(13) = pk(14)) Then zz = 1
If zz = 4 Then zz = 2
xx = xx + zz
zz = 0
a15$ = Mid(ps, 15, 1)
ph(15) = Val(a15$)
a16$ = Mid(ps, 16, 1)
ph(16) = Val(a16$)
If ph(15) = pk(15) Then zz = zz + 1
If ph(16) = pk(16) Then zz = zz + 1
If ph(15) = pk(16) Then zz = zz + 1
If ph(16) = pk(15) Then zz = zz + 1
If zz = 2 And (ph(15) = ph(16) Or pk(15) = pk(16)) Then zz = 1
If zz = 4 Then zz = 2
xx = xx + zz
zz = 0
a17$ = Mid(ps, 17, 1)
ph(17) = Val(a17$)
a18$ = Mid(ps, 18, 1)
ph(18) = Val(a18$)
If ph(17) = pk(17) Then zz = zz + 1
If ph(18) = pk(18) Then zz = zz + 1
If ph(17) = pk(18) Then zz = zz + 1
If ph(18) = pk(17) Then zz = zz + 1
If zz = 2 And (ph(17) = ph(18) Or pk(17) = pk(18)) Then zz = 1
If zz = 4 Then zz = 2
xx = xx + zz
' xx is the count of matching alleles in ps profile to the pt profile
If xx >= 12 Then
Write #10, j, k, ps, pt, xx
count1 = count1 + 1
End If
k = k + 1
Loop
Close (1)
j = j + 1
' Beeps after ever 100 checked
If j / 100 = Int(j / 100) Then Beep
Close #1
Loop
Close (2)
Close #10
Results
Did a high AF run of 75,000 to produce about 5,648 profiles.
Cut that down to 5,500
Then using the above VB routine the first 500
cross-checks took 29 minutes
second 500 took 26 minutes, third 500 24 minutes.
So aborted at 1,632 and checked the results
18,958 12 allele matches
494 14 allele matches
So this 7 loci in 9 match must mean as stated
7 loci pairs in 9 loci pairs rather than 14 alleles
in 18 matches.
So simplify the check routine for just the pair match case.
' Checking for random allele match pairs
' each with another, for pairs of alleles
' there is a minor bug that I've not corrected
' because val(letter)=0 regardless of what letter
' it is possible to falsely match (3A) to (3C) say
' just manually check such apparent matches that contain letters
Dim ps As String
Dim pt As String
Dim ph(20)
Dim pk(20)
temp = "apr03-d"
temp2 = "apr03-d"
temp0 = "apr03-dc"
j = 0
k = 0
Open temp2 For Input As #2
Open temp0 For Output As #10
Do Until (EOF(2) = True) Or k = 1
' pt is the profile to be checked against for each
' other than itself
Input #2, pt
b1$ = Mid(pt, 1, 1)
pk(1) = Val(b1$)
b2$ = Mid(pt, 2, 1)
pk(2) = Val(b2$)
b3$ = Mid(pt, 3, 1)
pk(3) = Val(b3$)
b4$ = Mid(pt, 4, 1)
pk(4) = Val(b4$)
b5$ = Mid(pt, 5, 1)
pk(5) = Val(b5$)
b6$ = Mid(pt, 6, 1)
pk(6) = Val(b6$)
b7$ = Mid(pt, 7, 1)
pk(7) = Val(b7$)
b8$ = Mid(pt, 8, 1)
pk(8) = Val(b8$)
b9$ = Mid(pt, 9, 1)
pk(9) = Val(b9$)
b10$ = Mid(pt, 10, 1)
pk(10) = Val(b10$)
b11$ = Mid(pt, 11, 1)
pk(11) = Val(b11$)
b12$ = Mid(pt, 12, 1)
pk(12) = Val(b12$)
b13$ = Mid(pt, 13, 1)
pk(13) = Val(b13$)
b14$ = Mid(pt, 14, 1)
pk(14) = Val(b14$)
b15$ = Mid(pt, 15, 1)
pk(15) = Val(b15$)
b16$ = Mid(pt, 16, 1)
pk(16) = Val(b16$)
b17$ = Mid(pt, 17, 1)
pk(17) = Val(b17$)
b18$ = Mid(pt, 18, 1)
pk(18) = Val(b18$)
k = 0
count0 = 0
count1 = 0
Open temp For Input As #1
Do Until (EOF(1) = True)
Seek #1, 2 + 24 * (1 + j + k)
' pt is the profile to be checked
' 1 added to j+k above as the next line down
' to be read , 24 characters long including "" and CR
zz = 0
Input #1, ps
a1$ = Mid(ps, 1, 1)
ph(1) = Val(a1$)
a2$ = Mid(ps, 2, 1)
ph(2) = Val(a2$)
xx = zz
If ph(1) = pk(1) and ph(2) = pk(2) Then zz = zz + 2
xx = zz
zz = 0
a3$ = Mid(ps, 3, 1)
ph(3) = Val(a3$)
a4$ = Mid(ps, 4, 1)
ph(4) = Val(a4$)
If ph(3) = pk(3) and ph(4) = pk(4) Then zz = zz + 2
xx = xx + zz
zz = 0
a5$ = Mid(ps, 5, 1)
ph(5) = Val(a5$)
a6$ = Mid(ps, 6, 1)
ph(6) = Val(a6$)
If ph(5) = pk(5) and ph(6) = pk(6) Then zz = zz + 2
xx = xx + zz
zz = 0
a7$ = Mid(ps, 7, 1)
ph(7) = Val(a7$)
a8$ = Mid(ps, 8, 1)
ph(8) = Val(a8$)
If ph(7) = pk(7) and ph(8) = pk(8) Then zz = zz + 2
xx = xx + zz
zz = 0
a9$ = Mid(ps, 9, 1)
ph(9) = Val(a9$)
a10$ = Mid(ps, 10, 1)
ph(10) = Val(a10$)
If ph(9) = pk(9) and ph(10) = pk(10) Then zz = zz + 2
xx = xx + zz
zz = 0
a11$ = Mid(ps, 11, 1)
ph(11) = Val(a11$)
a12$ = Mid(ps, 12, 1)
ph(12) = Val(a12$)
If ph(11) = pk(11) and ph(12) = pk(12) Then zz = zz + 2
xx = xx + zz
zz = 0
a13$ = Mid(ps, 13, 1)
ph(13) = Val(a13$)
a14$ = Mid(ps, 14, 1)
ph(14) = Val(a14$)
If ph(13) = pk(13) and ph(14) = pk(14) Then zz = zz + 2
xx = xx + zz
zz = 0
a15$ = Mid(ps, 15, 1)
ph(15) = Val(a15$)
a16$ = Mid(ps, 16, 1)
ph(16) = Val(a16$)
If ph(15) = pk(15) and ph(16) = pk(16) Then zz = zz + 2
xx = xx + zz
zz = 0
a17$ = Mid(ps, 17, 1)
ph(17) = Val(a17$)
a18$ = Mid(ps, 18, 1)
ph(18) = Val(a18$)
If ph(17) = pk(17) and ph(18) = pk(18) Then zz = zz + 2
xx = xx + zz
' xx is the count of matching alleles in ps profile to the pt profile
If xx >= 10 Then
Write #10, j, k, ps, pt, xx
count1 = count1 + 1
End If
k = k + 1
Loop
Close (1)
j = j + 1
' Beeps after ever 100 checked
If j / 100 = Int(j / 100) Then Beep
Close #1
Loop
Close (2)
Close #10
Results
for 5,500 run of >8.7% AFs produced
438, 6 loci matches (ie both alleles matching at any locus)
18, 7 Loci matches
0, 8 loci matches
For 5,500 run with no co-ancestry factor built in produced result
26, 6 loci matches
0, 7 loci matches
' Generating 10 loci x2 profiles with
' AF >= 6.9%
' directing pairs
Dim ph(20)
Dim pb(20)
' initialising Random Number Generator - RNG
count9 = 0
count8 = 0
countf = 0
Randomize
a = 214013
c = 2531011
x0 = Timer
z = 2 ^ 24
' 1 file 'feb26-g' for original, un-directed pairs, source data.
Open "feb26-g" For Output As #1
' all outputs directed
Open "feb26-d" For Output As #10
' change for different total size eg 199999 for 200,000
For x = 0 To 69999
flag = 0
For j = 0 To 1
' vWA ,first locus
' RNG random number generator
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
If ph(j) = "0" Then flag = 1
' deleted If ph(j) = "2" Then flag = 1
If ph(j) = "7" Then flag = 1
If ph(j) = "8" Then flag = 1
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
If ph(j) = "0" Then flag = 1
If ph(j) = "4" Then flag = 1
If ph(j) = "7" Then flag = 1
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
If ph(j) = "0" Then flag = 1
If ph(j) = "1" Then flag = 1
If ph(j) = "3" Then flag = 1
If ph(j) = "8" Then flag = 1
If ph(j) = "9" Then flag = 1
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
pb(j) = "Z"
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.226 And ph(j) >= 0.224 Then pb(j) = "A"
If ph(j) < 0.413 Then ph(j) = 3
If ph(j) < 0.415 And ph(j) >= 0.413 Then pb(j) = "B"
If ph(j) < 0.58 Then ph(j) = 4
If ph(j) < 0.591 And ph(j) >= 0.58 Then pb(j) = "C"
If ph(j) < 0.73 Then ph(j) = 5
If ph(j) < 0.734 And ph(j) >= 0.73 Then pb(j) = "D"
If ph(j) < 0.88 Then ph(j) = 6
If ph(j) < 0.882 And ph(j) >= 0.88 Then pb(j) = "E"
If ph(j) < 0.957 Then ph(j) = 7
If ph(j) < 0.992 Then ph(j) = 8
If ph(j) < 0.999 Then ph(j) = 9
If ph(j) < 1 And ph(j) >= 0.999 Then pb(j) = "F"
If ph(j) > 10 Then ph(j) = 0
If pb(j) <> "Z" Then ph(j) = pb(j)
If ph(j) = "0" Then flag = 1
If ph(j) = "1" Then flag = 1
' deleted If ph(j) = "7" Then flag = 1
If ph(j) = "8" Then flag = 1
If ph(j) = "9" Then flag = 1
If pb(j) = "A" Then flag = 1
If pb(j) = "B" Then flag = 1
If pb(j) = "C" Then flag = 1
If pb(j) = "D" Then flag = 1
If pb(j) = "E" Then flag = 1
If pb(j) = "F" Then flag = 1
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
pb(j) = "Z"
If ph(j) < 0.001 Then pb(j) = "A"
If ph(j) < 0.002 And ph(j) >= 0.001 Then pb(j) = "B"
If ph(j) < 0.033 Then ph(j) = 11
If ph(j) < 0.193 Then ph(j) = 1
If ph(j) < 0.419 Then ph(j) = 2
If ph(j) < 0.677 Then ph(j) = 3
If ph(j) < 0.704 Then ph(j) = 4
If ph(j) < 0.773 Then ph(j) = 5
If ph(j) < 0.866 Then ph(j) = 6
If ph(j) < 0.884 Then ph(j) = 7
If ph(j) < 0.974 Then ph(j) = 8
If ph(j) < 0.975 And ph(j) >= 0.974 Then pb(j) = "C"
If ph(j) < 0.997 Then ph(j) = 9
If ph(j) < 1 And ph(j) >= 0.997 Then pb(j) = "D"
If ph(j) > 10 Then ph(j) = 0
If pb(j) <> "Z" Then ph(j) = pb(j)
If ph(j) = "0" Then flag = 1
If ph(j) = "4" Then flag = 1
' deleted If ph(j) = "5" Then flag = 1
If ph(j) = "7" Then flag = 1
If ph(j) = "9" Then flag = 1
If pb(j) = "A" Then flag = 1
If pb(j) = "B" Then flag = 1
If pb(j) = "C" Then flag = 1
If pb(j) = "D" Then flag = 1
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
pb(j) = "Z"
If ph(j) < 0.001 Then pb(j) = "A"
If ph(j) < 0.009 And ph(j) >= 0.001 Then pb(j) = "B"
If ph(j) < 0.021 Then ph(j) = 11
If ph(j) < 0.16 Then ph(j) = 1
If ph(j) < 0.285 Then ph(j) = 2
If ph(j) < 0.449 Then ph(j) = 3
If ph(j) < 0.594 Then ph(j) = 4
If ph(j) < 0.731 Then ph(j) = 5
If ph(j) < 0.846 Then ph(j) = 6
If ph(j) < 0.926 Then ph(j) = 7
If ph(j) < 0.967 Then ph(j) = 8
If ph(j) < 0.982 Then ph(j) = 9
If ph(j) < 0.992 And ph(j) >= 0.982 Then pb(j) = "C"
If ph(j) < 0.997 And ph(j) >= 0.992 Then pb(j) = "D"
If ph(j) < 0.998 And ph(j) >= 0.997 Then pb(j) = "E"
If ph(j) < 1 And ph(j) >= 0.998 Then pb(j) = "F"
' allele 20 (C) reduced from .017 to .015 as allele
' frequencies summed to 1.002
If ph(j) > 10 Then ph(j) = 0
If pb(j) <> "Z" Then ph(j) = pb(j)
If ph(j) = "0" Then flag = 1
' deleted If ph(j) = "7" Then flag = 1
If ph(j) = "8" Then flag = 1
If ph(j) = "9" Then flag = 1
If pb(j) = "A" Then flag = 1
If pb(j) = "B" Then flag = 1
If pb(j) = "C" Then flag = 1
If pb(j) = "D" Then flag = 1
If pb(j) = "E" Then flag = 1
If pb(j) = "F" Then flag = 1
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
pb(j) = "Z"
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) < 0.997 And ph(j) >= 0.978 Then pb(j) = "A"
If ph(j) < 1 And ph(j) >= 0.997 Then pb(j) = "B"
If ph(j) > 10 Then ph(j) = 0
If pb(j) <> "Z" Then ph(j) = pb(j)
If ph(j) = "0" Then flag = 1
If ph(j) = "5" Then flag = 1
If ph(j) = "6" Then flag = 1
If pb(j) = "A" Then flag = 1
If pb(j) = "B" Then flag = 1
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
If ph(j) = "0" Then flag = 1
If ph(j) = "2" Then flag = 1
If ph(j) = "6" Then flag = 1
If ph(j) = "7" Then flag = 1
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
pb(j) = "Z"
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.719 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) < 0.999 And ph(j) >= 0.997 Then pb(j) = "A"
If ph(j) < 1 And ph(j) >= 0.999 Then pb(j) = "B"
If ph(j) > 10 Then ph(j) = 0
If pb(j) <> "Z" Then ph(j) = pb(j)
If ph(j) = "2" Then flag = 1
If ph(j) = "4" Then flag = 1
If ph(j) = "6" Then flag = 1
If ph(j) = "7" Then flag = 1
If ph(j) = "8" Then flag = 1
If ph(j) = "9" Then flag = 1
If pb(j) = "A" Then flag = 1
If pb(j) = "B" Then flag = 1
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
If ph(j) = "0" Then flag = 1
If ph(j) = "1" Then flag = 1
If ph(j) = "7" Then flag = 1
Next j
If flag = 1 Then countf = countf + 1
If flag = 0 Then
' output the original generated file
Write #1, ph(0) & ph(1) & ph(2) & ph(3) & ph(4) & ph(5) & ph(6) & ph(7) & ph(8) & ph(9) & ph(10) & ph(11) & ph(12) & ph(13) & ph(14) & ph(15) & ph(16) & ph(17) & ph(18) & ph(19)
' Because in real DNA profiles without further info ,no one
' knows which allele in each pair came from the mother or father
' by convention they are written smaller ,larger (or equal).
' The following directs each pair
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
Next j
Write #10, ph(0) & ph(1) & ph(2) & ph(3) & ph(4) & ph(5) & ph(6) & ph(7) & ph(8) & ph(9) & ph(10) & ph(11) & ph(12) & ph(13) & ph(14) & ph(15) & ph(16) & ph(17) & ph(18) & ph(19)
End If
Next x
Close #10
Close #1
Results for a 5,500 run for AFs >=6.9%
234 , 6 loci
8 , 7 loci
