Question calculate inbreeding

[MajP]

Which is the better way of adding to a table

I do not know if you can see either method is better. Isladog does a lot of speed comparisons and could answer what is faster, but I am pretty sure the sql method is faster. Better code is code that is understandable, reusable, accurate, less likely to error out, debugable, etc. So would be situation dependent.

The sql string method I used requires you to make sure that the literals are formatted correctly that means a date needs to be "#MM/DD/YYYY#" and strings have to be enclosed in quotes. That requires another step.

rstBreedingProgram("Birthdate").Value = Date()
would work without problem independent of regional settings

Using a Sql string would have to do something like
strSql = "Insert INTO tbl_Pedigree (Birthdate) VALUES (#" & Format(date(),"mm/dd/yyyy") & "#)"

Also if you have nulls in the mix you have to worry about handling them. The recordset method does not require you to do anything different.

There is a third method using a parameter query that may be even better. Gives you the speed of the insert query but the flexibility of the record set to handle nulls, dates, and strings.

 

[isladogs]

Thought I'd reply as my name was mentioned.

The SQL INSERT statement is simpler and much easier to read.
I would also expect that to be faster as there is less code to be interpreted.
In general recordsets are slower but I doubt the difference would be noticeable just adding one new record with 3 values.

If you do decide to use a recordset, also set that to Nothing after use

 

[MajP]

Here is an example of the third method using a parameterized query. It uses a temp query def with the proper amount of parameters. You can see with this method I can pass in a null and unformatted date without having to specially handle them in the sql string.

Public Function ParamInsert(TableName As String, TheFields As String, ParamArray TheValues() As Variant) As String
  Dim qdf As QueryDef
  Dim i As Integer
  Dim MyParams As New Collection
  Dim strMyParams As String
  Dim strSql As String
  For i = 0 To UBound(TheValues)
    MyParams.Add "Param" & i, "Param" & i
    If strMyParams = "" Then
      strMyParams = "[" & MyParams(i + 1) & "]"
    Else
      strMyParams = strMyParams & ", " & "[" & MyParams(i + 1) & "]"
    End If
  Next i
  strSql = "INSERT INTO " & TableName & " " & TheFields & " VALUES ( " & strMyParams & ")"
  ParamInsert = strSql
  Set qdf = CurrentDb.CreateQueryDef("TempQuery", strSql)
   For i = 0 To UBound(TheValues)
    qdf.Parameters(i) = TheValues(i)
  Next i
  qdf.Execute
  CurrentDb.QueryDefs.Delete ("tempquery")
End Function

Public Sub TestParamInsert()
  Dim TheFields As String
  Dim FirstName As Variant
  Dim LastName As Variant
  FirstName = Null  'demo null field
  LastName = "Smith"
  TheFields = InsertFields("FirstName", "LastName", "OrderID", "OrderDate")
  ParamInsert "MyTable", TheFields, FirstName, LastName, 1, Date
End Sub

If you are using a lot of variables, this can be more forgiving.

 

[InFlight]

Very interesting, I will look at them.
@MajP: did you have a look at the distance code.

 

[MajP]

What do you mean by figuring out the relationship? Are you saying, have a way to pick two birds and determine what how one bird is related to another? It would be easy from the pedigree table to determine Parent / child, Grand Parent / Child, Great Grand Parent / Child, and Great Great GrandParent / Child. You just look at each pedigree and see at what level the bird other bird appears.

If you mean cousins, nieces, nephews, 2nd cousins twice removed, etc. it would be way more complicated. I have to think hard about it. Obviously Ancestry.com does this because they tell you this.
http://www.searchforancestors.com/utility/cousincalculator.html
I would think what you could is use the pedigree table. Go to the highest level and then create a new tree spanning down. This would capture all of the children in the Family tree. (The pedigree table only captures parents). Now you would have to span this tree to see if there is a match and then at what levels. Then you have to determine how each related to a common relative. Making this more difficult is the inbreeding, because you get multiple relationships.

 

[MajP]

Public Function GetRelation(bird1ID As Long, bird2ID As Long) As String
  Dim strSql As String
  Dim rs As DAO.Recordset
  
  If GetPairID(bird1ID) = GetPairID(bird2ID) Then
    GetRelation = GetRingNo(bird2ID) & " AND " & (GetRingNo(bird1ID)) & " are siblings."
    Exit Function
  End If
  'Check to see if a parent or higher
  strSql = "Select birdID, AncestorID, Generation from tbl_Pedigree where BirdID = " & bird1ID & " AND ancestorID = " & bird2ID
  Set rs = CurrentDb.OpenRecordset(strSql)
  
  If Not (rs.EOF And rs.BOF) Then
    Select Case rs!Generation
      Case 2
        GetRelation = GetRingNo(bird2ID) & " is the Parent of " & (GetRingNo(bird1ID))
      Case 3
        GetRelation = GetRingNo(bird2ID) & " is the Grand Parent of " & (GetRingNo(bird1ID))
      Case 4
        GetRelation = GetRingNo(bird2ID) & " is the Great Grand Parent of " & (GetRingNo(bird1ID))
      Case 5
        GetRelation = GetRingNo(bird2ID) & " is the Great Great GrandParent of " & (GetRingNo(bird1ID))
    End Select
  Else
   strSql = "Select birdID, AncestorID, Generation from tbl_Pedigree where BirdID = " & bird2ID & " AND ancestorID = " & bird1ID
   Set rs = CurrentDb.OpenRecordset(strSql)
   If Not (rs.EOF And rs.BOF) Then
    Select Case rs!Generation
      Case 2
        GetRelation = GetRingNo(bird1ID) & " is the Parent of " & (GetRingNo(bird2ID))
      Case 3
        GetRelation = GetRingNo(bird1ID) & " is the Grand Parent of " & (GetRingNo(bird2ID))
      Case 4
        GetRelation = GetRingNo(bird1ID) & " is the Great Grand Parent of " & (GetRingNo(bird2ID))
      Case 5
        GetRelation = GetRingNo(bird1ID) & " is the Great Great GrandParent of " & (GetRingNo(bird2ID))
    End Select
   End If
  End If
  
End Function

This will do siblings and do parents, grand parents ... Great Great Grand Parents. If this is what you are asking it can be beefed up for those birds that appear multiple times in the other birds tree (inbreeding) to report multiple relations.

results look like

?getRelation(63,63)
5188 AND 5188 are siblings.

?GetRelation(105,106)
Not directly related.

?getRelation(32,145)
2273 KG is the Great Grand Parent of 4925-H

 

[MajP]

Oops that test should have been
?getRelation(63,64)
5189 AND 5188 are siblings.

not 63 and 63 which is the same bird.

 

[MajP]

Maybe not as hard as I thought. If you took 2 pedigrees and linked them by ancestorID you would have the commons ancestors. Really only need the closest. You then would know the relationship of bird1 to the common ancestor and bird2 to the common ancestor by the generation field. Then simply build the select case provided from ancestory

So using ancestory it will make a table showing all relations. For your 5 gernerations, it is a 4x4. So you just need to have 16 select cases. Example
If bird 1 and bird 2 are grandchildren of common ancestor then bird1 and bird2 are first cousins.
if bird 1 is a child of common ancestor and bird2 is a grand child then bird1 is niece/nephew bird 2

Going beyond your 5 would be hard, but this is doable if that is what is needed.

 

[InFlight]

That works a treat and will i use it.

2273 KG and 4925 H
What would the % be (The relationship = 12.5% i think)
Brother sister is that 100%
Brother Mother 50%
Also Check out 137 and 107. Both these birds were bought this year with out any breeding data.

 

[MajP]

So you want to determine the Coefficient of Relationship? I think that can be read from the same matrix as the COI matrix, with some math.

 

[InFlight]

Yes as well

When adding a bird do i still use

CreatePedigree BirdID, BirdID, BirdID
or
AddUpdatePedigree BirdId

 

[MajP]

AddUpdatePedigree BirdId

This will ensure that it deletes any old pedigree for that bird. This is especially important for the simulated pairing. You want to make sure to delete the old pedigree for the dummy bird.

I think from what I read you can get the CoR from the same matrix as the CoI.

 

[MajP]

I added the ability to calculate the Coefficient of Relationship (Coefficient of Kinship) to the potential Pairing form. I assume that is the two you wanted to check. So you can pick two birds and calculate. I cheated and saved some values into a temp table. If I was being efficient this would all be done in memory. This simplified the problem
So I am now a lot smarter in genetics and genetic calculations. More than I ever wanted to know. The thing I was calling the Coefficient of Inbreeding matrix is actually called the Additive Relationship or Numerator Relationship matrix. So unfortunately my naming of the class is bad. Anyways, I was able to use this class to do the CoR with minor updates. The math and matrix is the same the only difference was which birds to put in the matrix. When doing the CoI I only needed to put in the birds in a given birds pedigree. When doing the CoR I needed to put in all the birds from both pedigrees. In the CoI you return the cell on the diagonal for a given bird and subtract one from the value. For the CoR you return the cell where both birds intersect. The matrix is symmetrical so i,j equal j,i.
If I knew what I know now the solution would be cleaner, but it works and the answers appear correct.

If interested in the math and how this works see pages 420 and 421.
https://hal.archives-ouvertes.fr/hal-00893856/document

The math is pretty simple since it is all just binary (you get half the alleles from mom and half from dad, quarter from gran parents, 8th from ...), however the implementation is a bit tricky. From the literature, I think this is the proper solution but could be implemented far more efficient if needed. You could obviously use a sparse matrix since there are so many zero values, and you only need to calculate the upper or lower half of the matrix since it is symmetric. However, that is a couple hundred more lines of code. Since we are only talking 5 generations it is no big deal. If you had 500 animals in your pedigree (500 X 500 matrix) you would start having a problem.
Most of the literature tends to deal with efficient solutions for these larger problems.

 

[InFlight]

I agree with you I have learned so much, Not just the matrix of it all, but coding as well. I have done a lot of re-writing of code similar to what you have done. One problem i was getting was stack over flow, until i worked out it was the -1 pair. I put that pair's season at 1900 then in the query's used > 1900.

 

[MajP]

once thing that is not clear in the reference I posted is that you have to order your pedigrees. Simply sorted by descending birthdate may not work. The matrix will fail if a child appears before the parent. This reference explains how to do this, and I employ this in the code.

Pedigrees of animals need to be arranged in chronological order. Parents must appear in a list before (ahead of) their progeny. Ordering a pedigree is most easily accomplished by sorting animals by birthdate. Birthdates can be incorrectly recorded or entered, or for many individuals may not be available. One approach is to assume that all birthdates are incorrect. Animals can be arranged by assigning generation numbers to animals, then iterate through the pedigrees modifying the generation numbers of the sire and dam to be at least one greater than the generation number of the offspring. The number of iterations depends on the number of generations of animals in the list. Probably 20 or less iterations are needed for most situations.

All animals begin with generation number 1. Proceed through the pedigrees one animal at a time.
1. Take the value of the current generation number of the animal and increase it by one (1), call it m.
2. Compare m to the generation numbers of the animal’s sire and dam. If parents have a generation number less than m increase their generation number to m

Repeat for each animal in the pedigree list. Keep modifying the generation numbers until no more need to be changed. The animal with the highest generation number is the oldest animal.

This is reference is a little clearer.
http://animalbiosciences.uoguelph.ca/~lrs/ABModels/NOTES/genetrel.pdf

 

[InFlight]

Had to read it a few times to fully under stand it. Thanks so much for all the work you have done. Very grateful.

 

[InFlight]

Distance between 2 address's

For those that want is. I use it in New Zealand and works even between islands.
From memory I think you can get the travel time as well.

Private Sub Update_Distance_Click()
    On Error GoTo Update_Distance_Click_Error
    
    Dim vTown
    Dim VarD As String
    Dim Response As Integer
    

'====================================================
    If MsgBox("Do you have Internet Access ", vbYesNo, "You Need Internet Access") = vbYes Then
        Response = DATA_ERRADDED
    
        VarD = Me.Street & " " & Me.Suburb & " " & Me.Town & " " & Me.PostalCode & " " & DLookup("[CoCountry]", "CompanyName")
        Me.ZoneAway = Replace(get_dis_and_time2(DLookup("[Origin]", "CompanyName"), VarD), " Km", "")
    End If

    
    On Error GoTo 0
    Exit Sub

Update_Distance_Click_Error:

    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Update_Distance_Click, line " & Erl & "."

End Sub

'====================================================

Public Function get_dis_and_time2(origin_address As String, destination_address As String) As String

'key=************************
I have a Registration with Google and have my own key.
It is free to get.



    Dim surl                As String
    Dim oXH                 As Object
    Dim Bodytxt             As String
    Dim tim_e               As String
    Dim distanc_e           As String
    Dim InFlight            As String
    Dim varStatus           As String

    surl = "https://maps.googleapis.com/maps/api/distancematrix/xml?key=************************&origins=" & _
    Replace(Replace(Replace(origin_address, " ", "+"), ",", "+"), "++", "+") & _
    "&destinations=" & _
    Replace(Replace(Replace(destination_address, " ", "+"), ",", "+"), "++", "+") & _
    "&mode=driving&sensor=false&units=metric"
    ' Debug.Print surl
    ' units=imperial

    Set oXH = CreateObject("msxml2.xmlhttp")

        With oXH
            .Open "get", surl, False
            .send
            Bodytxt = .responseText
            ' Debug.Print (.responseText)
        End With
        
    varStatus = Right(Bodytxt, Len(Bodytxt) - InStr(1, Bodytxt, "<status>") - 7)
    varStatus = Right(varStatus, Len(varStatus) - InStr(1, varStatus, "<status>") - 7)
    varStatus = Left(varStatus, InStr(1, varStatus, "</status>") - 1)
    
    If UCase(varStatus) <> "OK" Then
        MsgBox " There is no Street or town called : " & destination_address
        get_dis_and_time2 = 0
    Else
        Bodytxt = Right(Bodytxt, Len(Bodytxt) - InStr(1, Bodytxt, "<text>") - 5)
        tim_e = Left(Bodytxt, InStr(1, Bodytxt, "</text>") - 1)
        Bodytxt = Right(Bodytxt, Len(Bodytxt) - InStr(1, Bodytxt, "<value>") - 6)
        distanc_e = Round(Left(Bodytxt, InStr(1, Bodytxt, "</value>") - 1) / 1000, 2) & " Km"
    get_dis_and_time2 = distanc_e
    End If

    Set oXH = Nothing

End Function

 

[InFlight]

What i am trying to do is color code the ring numbers.
I tried to use a class module but didn't know what i was doing, so tried this

Private Sub Form_Current()
   
    Dim DadColor, MumColor
    DadColor = DLookup("[RingColour]", "tbl_Birds", "RingNo = " & "'" & Me.**** & "'" ) 
    MumColor = DLookup("[RingColour]", "tbl_Birds", "RingNo = " & "'" & Me.Hen & "'" ) 
    ****.ForeColor = DadColor
    Hen.ForeColor = MumColor


End Sub

But it changes the field font color in all rows.
Note: I have changed the field name of StatusColour to RingColour

The Colors.jpg is what i am trying to achive
The query.jpg and QueryOpen are is one way i tried
The Form.jpg is what is happening

 

[InFlight]

i have added a table tbl_Season. as you can see the federation have set the season colors until 2025

 

[MajP]

Since it is a continuous form that is the behavior you would get. You can try moving this code to the details onpaint event. It may work but you may get strange behavior once you enter the form. You will probably have to do this using conditional formatting. If that is the case you could simply store the names of the colors since I cannot think of a way to do it with the code. Then in conditional formatting you use a where expression
expression is: [mumColor] = SomeValue
Then pick your color to show. The problem with that though is the data is not stored in a table so if you get need to change you have to update the form instead of the data.
There may be a way to do this with a rich textbox and be able to use the data. Let me try.