Question calculate inbreeding (1 Viewer)

Spam808

Registered User.
Local time
Today, 11:40
Joined
Dec 3, 2018
Messages
55
Code:
I do have a difficult project that is similar to what you are on working, that is why I approach you.
OK sounds interesting. I would just post it and people will reply. It may be an area that someone has expertise. Unless it is really COI because now I know more about that than ever wanted.

Why can't you be able to help me?
 

InFlight

User
Local time
Tomorrow, 06:40
Joined
Jun 11, 2015
Messages
130
MajP. When a egg is not hatched or a chick dies before it fledge's should i run a unmatched query and delete the records from the Pedigree table.
 

InFlight

User
Local time
Tomorrow, 06:40
Joined
Jun 11, 2015
Messages
130
@MajP: I studied it a little and like what you done. You have explained it well. I have done a new pairing and seems ok.:)

@isladogs and Uncle Gizmo: if MajP is helping some one like me that is not a expert then you shouldn't make awful remarks that you made. I am ashamed.:banghead:
 
Last edited:

InFlight

User
Local time
Tomorrow, 06:40
Joined
Jun 11, 2015
Messages
130
Is the relationship between the pairing's hard to work out. I just entered what i thought was right. One problem I just noticed is that the date i pass into GetSeason(Year(Date)) comes back as 1905. Should i format the date to YYMMDD instead of ours DDMMYYY.
 
Last edited:

isladogs

MVP / VIP
Local time
Today, 19:40
Joined
Jan 14, 2017
Messages
18,209
@InFlight
I totally agree that MajP has been extremely helpful to you and has provided you with a detailed & working solution. That's great
However if you check, you will find I didn't make any 'awful remarks' as you put it.
 

InFlight

User
Local time
Tomorrow, 06:40
Joined
Jun 11, 2015
Messages
130
One problem I just noticed is that the date i pass into GetSeason(Year(Date)) comes back as 1905. Should i format the date to YYMMDD instead of ours DDMMYYY.[/QUOTE said:
I just noticed what i did wrong should be GetSeason(Date)
Cascade deletes now work.
 

MajP

You've got your good things, and you've got mine.
Local time
Today, 14:40
Joined
May 21, 2018
Messages
8,525
In order to verify the math, I added a feature to allow you to modify the view and show potential interbred birds. I color coded those in Cayan and added the AVK and COI. Then you can do the math pretty easily to verify. Here is the math.


The trick is to find N the number of links from the parents of a given bird to the common ancestor. It is a common ancestor if you can traverse up from the father and back down through the mother. Some examples.

Single Common Grandparent

The common ancestor is 2097
The path is 5185-2097-7452
There are two links so N = 2
N+1 = 3, F = (1/2)^3 = 12.5% (correct)

Two common Great GrandParents


You have to sum up both. So need path to 2273 and path to 2097
7448-4601-2273-5186-7443 (4 connections) N+1 = 5
path to 2097
7448-4601-2097-5186-7443 N+1 = 5
(1/2)^5 + (1/2)^5 = .03125 + .03125 = 6.25% (correct)

This one is real interesting, but the math is correct

1514 has an AVK less than 1 but a COI of 0. 1514 is not interbred, but its father is. It's child however is inbred through the great great grandparents. The value of 4.69 is correct because there are three common ancestors.
(1/2)^6 + (1/2)^6 + (1/2)^6 = 4.69%
 

Attachments

  • 23.jpg
    23.jpg
    29.5 KB · Views: 467
  • 28.jpg
    28.jpg
    97.6 KB · Views: 484
  • 34.jpg
    34.jpg
    38.5 KB · Views: 157
  • 106_2.jpg
    106_2.jpg
    96.8 KB · Views: 471
  • Clipboard01.jpg
    Clipboard01.jpg
    50.5 KB · Views: 479

InFlight

User
Local time
Tomorrow, 06:40
Joined
Jun 11, 2015
Messages
130
Would it be possible to do a trial on two birds to check the AVK and Inbreeding before i pair them together.
 

Vassago

Former Staff Turned AWF Retiree
Local time
Today, 14:40
Joined
Dec 26, 2002
Messages
4,751
Let's keep it on topic.
 

InFlight

User
Local time
Tomorrow, 06:40
Joined
Jun 11, 2015
Messages
130
One of my combo box's (co_Colour) on the form frm_Allbirds doesn't display it's data when i load the form unless i requery it. Working on it now.
 

MajP

You've got your good things, and you've got mine.
Local time
Today, 14:40
Joined
May 21, 2018
Messages
8,525
Here is my formula for the distance
Code:
Private Function GetPolarDistance(decLatStart As Single, decLongStart As Single, decLatEnd As Single, decLongEnd As Single) As Single
    Const decToRad = 3.14159265358979 / 180
    Const radiusOfEarth = 3963.1
    'radiusOfEarth =3963.1 statute miles, 3443.9 nautical miles, or 6378 km
    Dim radLatStart As Single
    Dim radLongStart As Single
    Dim radLatEnd As Single
    Dim radLongEnd As Single
    radLatStart = decLatStart * decToRad
    radLongStart = decLongStart * decToRad
    radLatEnd = decLatEnd * decToRad
    radLongEnd = decLongEnd * decToRad
    GetPolarDistance = ArcCos((Cos([radLatStart]) * Cos([radLongStart]) * Cos([radLatEnd]) * Cos([radLongEnd])) + Cos([radLatStart]) * Sin([radLongStart]) * Cos([radLatEnd]) * Sin([radLongEnd]) + (Sin([radLatStart]) * Sin([radLatEnd]))) * radiusOfEarth
    '                     (cos($a1)*            cos($b1)*             cos($a2)*          cos($b2)          + cos($a1)*            sin($b1)*              cos($a2)*          sin($b2) +          sin($a1)*             sin($a2)        ) * $r
    '                 acos((cos($a) *           cos($b) *             cos($c) *          cos($d)) +          (cos($a) *           sin($b) *              cos($c) *           sin($d)) +         (sin($a) *            sin($c)) ) * $r
End Function

Private Function ArcCos(X As Single) As Single
    If Abs(X) <> 1 Then
        ArcCos = 1.5707963267949 - Atn(X / Sqr(1 - X * X))
    Else
        ArcCos = 3.14159265358979 * Sgn(X)
    End If
    'ArcCos = Atn(-X / Sqr(-X * X + 1)) + 2 * Atn(1)
End Function
 

MajP

You've got your good things, and you've got mine.
Local time
Today, 14:40
Joined
May 21, 2018
Messages
8,525
I am registered with google so can use there's. I use it to get the distance between 2 address's
Yours is a real distance. The function I posted is a very notional straight line distance. Even aircraft do no fly that, they fly a great circle route.
Thanks, I need to look at what you posted and see if I can use that on an optimization model I have.
 

MajP

You've got your good things, and you've got mine.
Local time
Today, 14:40
Joined
May 21, 2018
Messages
8,525
@InFlight
Here is the update. I am now 95% confident that COI is correct and 100% confident on AVK.
View attachment CoeffInbreeding7.accdb
I added a feature to allow you to look at the inbred birds or turn it off.
You can see the buttons.

this is what it looks like off

You can also sort the records or go to a specific pedigree.

The new db allows you to do a potential pairing. See the potential pairing form. It adds the potential pedigree and then deletes it when you assign new cocks and hen. If you import this into your db. Then you will have to create the dummy pairing and dummy bird. The pairing ID has to be -1.

I know this is not a very good solution, but unfortunately I am still waiting for Uncle Gizmo to provide something suitable since he is confident that there is a much better solution.
 

Attachments

  • FrmPed.jpg
    FrmPed.jpg
    102.7 KB · Views: 476
  • frmPed2.jpg
    frmPed2.jpg
    104.8 KB · Views: 506

MajP

You've got your good things, and you've got mine.
Local time
Today, 14:40
Joined
May 21, 2018
Messages
8,525
I also change the functions to look for genders not 1 or 2. I now have an unknown which is color coded green. I think you use 4 for an egg. Just like the real world you can have a whole lot more, so you need to add those choices. I think there is like 212 possible genders.
https://dudeasks.com/how-many-genders-are-there-in-2018/
 

InFlight

User
Local time
Tomorrow, 06:40
Joined
Jun 11, 2015
Messages
130
Yes you are right. I use 4 as unknown gender until I find out what it is.
The gender is setup for the New Zealand show class's. Some birds you can't till the difference of the genders, so in the shows we have a class for both. (1. **** 2. Hen 3. Both **** and Hen). I have used 2 fields. 1 is the gender of the bird and the other is what is required to get the class number for the show.
 

MajP

You've got your good things, and you've got mine.
Local time
Today, 14:40
Joined
May 21, 2018
Messages
8,525
Will you ever use the parent IDs in the Tbl_Birds and not also have a paring? I think the answer is no, but not sure if this is duplication or if there is a purpose. The parent information is not pulled by the parent ids in tbl_birds but always through the pairing table. In other words all parent relations has to be in the pairing table. I could think of conditions where you could know one parent, but not the other. You would have to make a fake pairing to make this work.
 

InFlight

User
Local time
Tomorrow, 06:40
Joined
Jun 11, 2015
Messages
130
No not really. It's me been lazy so when i open that table i can see who the parents are. If it is removed i will have to change some code as i use to goto record. But thats not a problem.

The same as i have a problem with some of the combo box's and to get around i enter this on open.
Private Sub Form_Open(Cancel As Integer)
If Me.Recordset.RecordCount = 0 Then Exit Sub
End Sub
 
Last edited:

MajP

You've got your good things, and you've got mine.
Local time
Today, 14:40
Joined
May 21, 2018
Messages
8,525
No not really. It's me been lazy so when i open that table i can see who the parents are. If it is removed i will have to change some code as i use to goto record. But thats not a problem.

No need to change anything now that it works. And even though you do a lot of your code with the RingNo do not get rid of the ID field in table_bird. My code uses that field.
However, technically you could get rid of the parent fields in tbl_birds. You then could open a query instead of the table. This would be a left outer join from Tbl_birds to Tbl_Partnership. That would show all birds and if they had a parent the parent RingNo. It could look just like your table.
The other thing that would be more technically correct is in the pairing table to save the bird ID and not the RingNo of the paired birds in the partnership table. That is because that is the real primary key. Again you could still use a query to see the RingNos as well. This would be a join from tbl_Partnership to an instance of tbl_bird by cockID to id and a join to another instance of tbl_bird by henID to bird id.

Again it all works so no real need to change as long as you are consistent. The reason you would consider change is that you are doubling up data which could create many more chances of an error. If you would make a change to the pairing and forget to update the parent ids in tbl_bird or make a mistake in what you enter in tbl_birds then you can create a problem. If you store it only in the partnership table any change or entry is done once.

Now to help goto a record or check if one exists you can leverage the functions
getFatherID
getMotherID
getID
getRingNo

The bottom two functions let you switch from ID to RingNo. The first two functions return 0 if the bird has no parent in the db. You can wrap them as well. Example to get the current birds father's ringno then
Code:
fatherID = getFatherID me.ID
   if fatherID <> 0 
      fatherRingNo = getRingNo(fatherID)
   end if
To go to the current birds mother
Code:
me.recordset.findfirst "id = " & getMotherID(me.id)
 

InFlight

User
Local time
Tomorrow, 06:40
Joined
Jun 11, 2015
Messages
130
Thanks. Still going through every thing to under stand it.
Which is the better way of adding to a table.

strSql = "Insert INTO tbl_Pedigree (BirdID, AncestorID, PairID, Generation, PathKey) VALUES (" & StartingBirdID & ", " & BirdID & ", " & PairID & ", " & Generation & ", '" & PathKey & "')"
CurrentDb.Execute strSql


or


Set rstBreedingProgram = dbPartnerships.OpenRecordset("SELECT * FROM tbl_Bird_Partnerships ORDER BY Pair_ID")
With rstBreedingProgram
.AddNew
rstBreedingProgram("Pair_ID").Value = varPairNo
rstBreedingProgram("Paired").Value = vDate
rstBreedingProgram("Season").Value = GetSeason(Date)
End With

rstBreedingProgram.Update
rstBreedingProgram.Requery
rstBreedingProgram.Close
Set dbPartnerships = Nothing
 
Last edited:

Users who are viewing this thread

Top Bottom