1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88
| Function UPDT_GeneticParameters()
'Updates individual genetic paramaters from KinInbCoef's output file
'Requires the tables:
' - list with the fields ID (long), ID_ECWP (text), F (single), N (long) and Mk (single)
' - Out (as provided by KinInbCoef, the family is not requested)
Dim mydbs As Database
Dim rstSource1 As Recordset
Dim rstSource2 As Recordset
Dim rstSource3 As Recordset
Dim rstSource4 As Recordset
Dim rstResult As Recordset
Dim strN1 As Long
Dim strID As Long
Dim strID_ECWP As String
Dim strF As Single
Dim strN As Long
Dim strMk As Single
Dim strSQL1 As String
Dim strSQL2 As String
Dim strSQL3 As String
Dim strSQL4 As String
' Count the remaining number of individuals to update
strSQL1 = "SELECT Count(ID) as N1 from List where N is null"
'Provides the local ID (ID_ECWP) corresponding to the pedigree ID
strSQL2 = "SELECT First([List].[ID]) AS ID, First([Pedigree].[Stud_ID]) AS [Stud_ID]"
strSQL2 = strSQL2 & "FROM List INNER JOIN [Pedigree] ON [List].[ID] = [Pedigree].[ID]"
strSQL2 = strSQL2 & "WHERE ((([List].[N]) Is Null))"
' Provides the inbreeding for the first individual to update
strSQL3 = "SELECT First([Out].[Kinship]) AS [F]"
strSQL3 = strSQL3 & "FROM [List] INNER JOIN [Out] ON ([List].[ID] = [Out].[IDb]) AND ([List].[ID] = [Out].[IDa])"
strSQL3 = strSQL3 & "WHERE ((([List].[F]) Is Null))"
' Provides N (number of related individuals in the analysis, including itself)
' and Mk (the mean kinship of the individual with the rest of the population, including itself
strSQL4 = "SELECT [temp2].[ID], Count([temp2].[IDb]) AS [N], Avg([temp2].[Kinship]) AS [Mk]"
strSQL4 = strSQL4 & "FROM (SELECT [temp].[ID], [Out].[IDb], [Out].[Kinship]"
strSQL4 = strSQL4 & "FROM (SELECT First([List].[ID]) AS [ID]"
strSQL4 = strSQL4 & "FROM [List]"
strSQL4 = strSQL4 & "WHERE ((([List].[N]) Is Null))) AS [temp] INNER JOIN [Out] ON [temp].[ID] = [Out].[IDa]"
strSQL4 = strSQL4 & "Union SELECT [temp].[ID], [Out].[IDa], [Out].[Kinship]"
strSQL4 = strSQL4 & "FROM (SELECT First([List].[ID]) AS [ID]"
strSQL4 = strSQL4 & "FROM [List]"
strSQL4 = strSQL4 & "WHERE ((([List].[N]) Is Null))) AS [temp] INNER JOIN [Out] ON [temp].[ID] = [Out].[IDb]) AS [temp2]"
strSQL4 = strSQL4 & "GROUP BY [temp2].[ID]"
Set mydbs = CurrentDb
Set rstSource1 = mydbs.OpenRecordset(strSQL1, dbOpenDynaset)
strN1 = rstSource1("N1").Value
While strN1 > 0
Set rstSource2 = mydbs.OpenRecordset(strSQL2, dbOpenDynaset)
strID = rstSource2("ID").Value
strID_ECWP = rstSource2("Stud_ID").Value
Set rstSource3 = mydbs.OpenRecordset(strSQL3, dbOpenDynaset)
strF = rstSource3("F").Value
Set rstSource4 = mydbs.OpenRecordset(strSQL4, dbOpenDynaset)
strN = rstSource4("N").Value
strMk = rstSource4("Mk").Value
Set rstResult = mydbs.OpenRecordset("List", dbOpenTable)
rstResult.Index = "ID"
rstResult.Seek "=", strID
rstResult.Edit
If rstResult("ID") = strID Then
rstResult("ID_ECWP") = strID_ECWP
rstResult("F") = strF
rstResult("N") = strN
rstResult("Mk") = strMk
rstResult.Update
End If
Wend
rstSource1.Close
rstSource2.Close
rstSource3.Close
rstSource4.Close
rstResult.Close
Set mydbs = Nothing
End Function |
Partager