Solution to the Messy Matters ubercousin Bonus Puzzle

ubercousin.R

# Solution to the Messy Matters ubercousin Bonus Puzzle
# http://messymatters.com/2011/09/30/smallworld/


library(pedantics)


fixPedigree( # automatically create entries for the granddams/grandsires
as.data.frame(matrix(
#  id            dam      sire
c('sire1',      'gdam1', 'gsire1', # <------- brothers
  'sire2',      'gdam1', 'gsire1', # <----/

  'dam1',       'gdam2', 'gsire2', # <----\
  'dam2',       'gdam2', 'gsire2', # <-------- sisters

  'offspring1', 'sire1', 'dam1', #______
  'offspring2', 'sire2', 'dam2'),#______\____ ubercousins
ncol=3, byrow=TRUE, dimnames=list(row=NULL, col=c('id', 'dam', 'sire'))))) -> ped

# quickly calculate inverse additive genetic relationship matrix
Ainv <- inverseA(ped)$Ainv
# invert the inverse
A <- round(solve(Ainv), 3)
dimnames(A) <- list(dimnames(Ainv)[[1]], dimnames(Ainv)[[1]])

A['offspring1', 'offspring2']