\section{Checks}
Last are various helper routines and data checks.
\subsection{kindepth}
One helper function used throughout computes the depth of
each subject in the pedigree.  
For each subject this is defined as the maximal number of
generations of ancestors: how far to the farthest
founder.  
This can be called with a pedigree object, or with the 
full argument list.  In the former case we can simply
skip a step.
<<kindepth>>=
kindepth <- function(id, dad.id, mom.id, align=FALSE) {
    if (class(id)=='pedigree' || class(id)=='pedigreeList') {
        didx <- id$findex
        midx <- id$mindex
        n <- length(didx)
        } 
    else {
        n <- length(id)
        if (missing(dad.id) || length(dad.id) !=n)
            stop("Invalid father id")
        if (missing(mom.id) || length(mom.id) !=n)
            stop("Invalid mother id")
        midx <- match(mom.id, id, nomatch=0) # row number of my mom
        didx <- match(dad.id, id, nomatch=0) # row number of my dad
        }
    if (n==1) return (0)  # special case of a single subject 
    parents <- which(midx==0 & didx==0)  #founders

    depth <- rep(0,n)
    # At each iteration below, all children of the current "parents" are
    #    labeled with depth 'i', and become the parents of the next iteration
    for (i in 1:n) {
	child  <- match(midx, parents, nomatch=0) +
		  match(didx, parents, nomatch=0)

	if (all(child==0)) break
	if (i==n) 
	    stop("Impossible pedegree: someone is their own ancestor")

	parents <- which(child>0) #next generation of parents
	depth[parents] <- i
	}
    if (!align) return(depth)
    <<kindepth-align>>
}
@ 

The align argument is used only by the plotting routines.  
It makes the plotted result prettier in the following (fairly common)
case. 
Assume that subjects A and B marry, we have some ancestry information for
both, and that A's ancestors go back 3 generations, B's for only two.
If we add +1 to the depth of B and all her ancestors, then A and B
will be the same depth, and will plot on the same line.
Founders who marry in are also aligned.
However, if we have an inbred pedigree, there may not be a simple fix
of this sort.

The algorithm is
\begin{enumerate}
  \item First deal with founders.  If a particular founder marries in
    multiple times at multiple deaths (animal pedigrees), given that
    subject the min(depth of spouses).  These subjects cause trouble
    for the general algorithm below: the result would depend on the
    data set order.  Say A has offspring at level 2 and 0.  If ``2'' came
    first then a later step would pull the spouse at 0 down.
  \item Find any remaining mother-father pairs that are mismatched in depth.
    Deal with them one at a time.
    We think that aligning the top of a pedigree is more important
    than aligning at the bottom, so start with a mismatch pair of minimal
    depth.
  \item The children's depth is max(father, mother) +1.  Call the
    parent closest to the children ``good'' and the other ``bad''.
  \item  Chase up the good side, and get a list of all subjects connected
    to "good", including in-laws (spouse connections) and sibs that are
    at this level or above.  Call this agood (ancestors of good).
    We do not follow any connections at a depth lower than the 
    marriage in question, to get the highest marriages right.
    For the bad side, just get ancestors.
  \item Avoid pedigree loops!  If the agood list contains anyone in abad,
    then don't try to fix the alignment, otherwise:
    Push abad down, then run the pushdown algorithm to
    repair any descendents --- you may have pulled down a grandparent but
    not the sibs of that grandparent.
\end{enumerate}
    
It may be possible to do better alignment when the pedigree has loops,
but it is definitely beyond this program's abilities.  This could be
an addition to authint one day.
One particular case that we've seen was a pair of brothers that married
a pair of sisters.  Pulling one brother down fixes the other at the
same time.
The code below, however, says "loop! stay away!".
<<kindepth-align>>=
chaseup <- function(x, midx, didx) {
    new <- c(midx[x], didx[x])  # mother and father
    new <- new[new>0]
    while (length(new) >1) {
        x <- unique(c(x, new))
        new <- c(midx[new], didx[new])
        new <- new[new>0]
    }
    x
}
    	
# First deal with any parents who are founders
#  They all start with depth 0
dads <- didx[midx>0 & didx>0]   # the father side of all spouse pairs
moms <- midx[midx>0 & didx>0]
founder <- (midx==0 & didx==0)
if (any(founder[dads])) {
    drow <- which(founder[dads])  # which pairs
    id  <- unique(dads[drow])     # id
    depth[id] <- tapply(depth[moms[drow]], dads[drow], min)
    dads <- dads[-drow]
    moms <- moms[-drow]
}
if (any(founder[moms])) {
    mrow <- which(founder[moms])  # which pairs
    id  <- unique(moms[mrow])     # id
    depth[id] <- tapply(depth[dads[mrow]], moms[mrow], min)
    dads <- dads[-mrow]
    moms <- moms[-mrow]
}

# Get rid of duplicate pairs, which occur for any spouse with
#  multiple offspring
dups <- duplicated(dads + moms*n)
if (any(dups)) {
  dads <- dads[!dups]
  moms <- moms[!dups]
}

npair<- length(dads)
done <- rep(FALSE, npair)  #couples that are taken care of
while (TRUE) {
  pairs.to.fix <- which((depth[dads] != depth[moms]) & !done)
  if (length(pairs.to.fix) ==0) break
  temp <- pmax(depth[dads], depth[moms])[pairs.to.fix]
  who <- min(pairs.to.fix[temp==min(temp)])  # the chosen couple
  
  good <- moms[who]; bad <- dads[who]
  if (depth[dads[who]] > depth[moms[who]]) {
    good <- dads[who]; bad <- moms[who]
  }
  abad  <- chaseup(bad,  midx, didx)
  if (length(abad) ==1 && sum(c(dads,moms)==bad)==1) {
    # simple case, a solitary marry-in
    depth[bad] <- depth[good]
  }
  else {
    agood <- chaseup(good, midx, didx)  #ancestors of the "good" side
    # For spouse chasing, I need to exclude the given pair
    tdad <- dads[-who]
    tmom <- moms[-who]
    while (1) {
      # spouses of any on agood list
      spouse <- c(tmom[!is.na(match(tdad, agood))],
      tdad[!is.na(match(tmom, agood))])
      temp <- unique(c(agood, spouse))
      temp <- unique(chaseup(temp, midx, didx)) #parents
      kids <- (!is.na(match(midx, temp)) | !is.na(match(didx, temp)))
      temp <- unique(c(temp, (1:n)[kids & depth <= depth[good]]))
      if (length(temp) == length(agood)) break
      else agood <- temp
    }

    if (all(match(abad, agood, nomatch=0) ==0)) {
      # shift it down
      depth[abad] <- depth[abad] + (depth[good] - depth[bad])
      #
      # Siblings may have had children: make sure all kids are
      #   below their parents.  It's easiest to run through the
      #   whole tree
      for (i in 0:n) {
        parents <- which(depth==i)
        child <- match(midx, parents, nomatch=0) +
            match(didx, parents, nomatch=0)
        if (all(child==0)) break
        depth[child>0] <- pmax(i+1, depth[child>0])
      }
    }
  }
  # Once a subject has been shifted, we don't allow them to instigate
  #  yet another shift, possibly on another level
  done[dads==bad | moms==bad] <- TRUE
}
if (all(depth>0)) stop("You found a bug in kindepth's alignment code!")
depth
@ 

\subsection{familycheck}
The familycheck routine checks out a family id, by trying to construct its own
and comparing the results.
The input argument "newfam" is optional: if you've already created this
vector for other reasons, then putting the arg in saves time.


  If there are any joins, then an attribute "join" is attached.  It will be
   a matrix with famid as row labels, new-family-id as the columns, and
   the number of subjects as entries.  

<<familycheck>>=
# This routine checks out a family id, by trying to construct its own
#  and comparing the results
#
# The input argument "newfam" is optional: if you've already created this
#   vector for other reasons, then putting the arg in saves time.
#
# Output is a dataframe with columns:
#   famid: the family id, as entered into the data set
#   n    : number of subjects in the family
#   unrelated: number of them that appear to be unrelated to anyone else 
#          in the entire pedigree set.  This is usually marry-ins with no 
#          children (in the pedigree), and if so are not a problem.
#   split : number of unique "new" family ids.
#            if this is 0, it means that no one in this "family" is related to
#                   anyone else (not good)
#            1 = everythings is fine
#            2+= the family appears to be a set of disjoint trees.  Are you
#                 missing some of the people?
#   join : number of other families that had a unique famid, but are actually
#            joined to this one.  0 is the hope.
#
#  If there are any joins, then an attribute "join" is attached.  It will be
#   a matrix with famid as row labels, new-family-id as the columns, and
#   the number of subjects as entries.  
#
familycheck <- function(famid, id, father.id, mother.id, newfam) {
    if (is.numeric(famid) && any(is.na(famid)))
        stop ("Family id of missing not allowed")
    nfam <- length(unique(famid))

    if (missing(newfam)) newfam <- makefamid(id, father.id, mother.id)
    else if (length(newfam) != length(famid))
        stop("Invalid length for newfam")

    xtab <- table(famid, newfam)
    if (any(newfam==0)) {
        unrelated <- xtab[,1]
        xtab <- xtab[,-1, drop=FALSE] 
        ## bug fix suggested by Amanda Blackford 6/2011
      }
    else unrelated <-  rep(0, nfam)

    splits <- apply(xtab>0, 1, sum)
    joins  <- apply(xtab>0, 2, sum)

    temp <- apply((xtab>0) * outer(rep(1,nfam), joins-1), 1, sum)

    out <- data.frame(famid = dimnames(xtab)[[1]],
                      n = as.vector(table(famid)),
                      unrelated = as.vector(unrelated),
                      split = as.vector(splits),
                      join = temp,
                      row.names=1:nfam)
    if (any(joins >1)) {
      tab1 <- xtab[temp>0,]  #families with multiple outcomes
      tab1 <- tab1[,apply(tab1>0,2,sum) >0] #only keep non-zero columns
      dimnames(tab1) <- list(dimnames(tab1)[[1]], NULL)
      attr(out, 'join') <- tab1
    }
    
    out
  }


@ 


\subsection{check.hint}
This routine tries to remove inconsistencies in spousal hints.
These and arise in autohint with complex pedigrees.
One can have ABA (subject A is on both the
left and the right of B), cycles, etc. 
Actually, these used to arise in autohint, I don't know if it's so
after the recent rewrite.
Users can introduce problems as well if they modify the hints.

<<check.hint>>=
check.hint <- function(hints, sex) {
    if (is.null(hints$order)) stop("Missing order component")
    if (!is.numeric(hints$order)) stop("Invalid order component")
    n <- length(sex)
    if (length(hints$order) != n) stop("Wrong length for order component")
    
    spouse <- hints$spouse
    if (is.null(spouse)) hints
    else {
        lspouse <- spouse[,1]
        rspouse <- spouse[,2]
        if (any(lspouse <1 | lspouse >n | rspouse <1 | rspouse > n))
            stop("Invalid spouse value")
        
        temp1 <- (sex[lspouse]== 'female' & sex[rspouse]=='male')
        temp2 <- (sex[rspouse]== 'female' & sex[lspouse]=='male')
        if (!all(temp1 | temp2))
            stop("A marriage is not male/female")
        
        hash <- n*pmax(lspouse, rspouse) + pmin(lspouse, rspouse)
        #Turn off this check for now - is set off if someone is married to two siblings
        #if (any(duplicated(hash))) stop("Duplicate marriage")

        # Break any loops: A left of B, B left of C, C left of A.
        #  Not yet done 
      }
    hints
  }
@ 
