upward {LCAextend}

performs the upward step of the peeling algorithm of a pedigree

Description

computes the probability of observations below connectors conditionally to their classes given the model parameters. This is an internal function not meant to be called by the user.

Usage

upward(id, dad, mom, status, probs, fyc, peel)

Arguments

id

individual ID of the pedigree,

dad

dad ID,

mom

mom ID,

status

symptom status: (2: symptomatic, 1: without symptoms, 0: missing),

probs

a list of probability parameters of the model,

fyc

a matrix of n times K+1 given the density of observations of each individual if allocated to class k, where n is the number of individuals and K is the total number of latent classes in the model,

peel

a list of pedigree peeling result containing connectors by peeling order and couples of parents.

Details

This function computes the probability of observations below connectors conditionally to their classes using the function upward.connect

Value

The function returns a list of 2 elements:

sum.child

an array of dimension n times K+1 times K+1 such that sum.child[i,c_1,c_2] is the probability of individual i measurements when his parent are assigned to classes c_1 and c_2,

p.yF.c

an array of dimension n times 2 times K+1 giving the probability of all measurements below the individual, depending on his status and his class.

References

TAYEB et al.: Solving Genetic Heterogeneity in Extended Families by Identifying Sub-types of Complex Diseases. Computational Statistics, 2011, DOI: 10.1007/s00180-010-0224-2.

See Also

See also upward.connect

Examples

#data
data(ped.cont)
data(peel)
fam <- ped.cont[,1]
id <- ped.cont[fam==1,2]
dad <- ped.cont[fam==1,3]
mom <- ped.cont[fam==1,4]
status <- ped.cont[fam==1,6]
y <- ped.cont[fam==1,7:ncol(ped.cont)]
peel <- peel[[1]]
#standardize id to be 1, 2, 3, ...
id.origin <- id
standard <- function(vec) ifelse(vec%in%id.origin,which(id.origin==vec),0)
id <- apply(t(id),2,standard)
dad <- apply(t(dad),2,standard)
mom <- apply(t(mom),2,standard)
peel$couple <- cbind(apply(t(peel$couple[,1]),2,standard),
                     apply(t(peel$couple[,2]),2,standard))
for(generat in 1:peel$generation)
peel$peel.connect[generat,] <- apply(t(peel$peel.connect[generat,]),2,standard)
#probs and param
data(probs)
data(param.cont)
#densities of the observations
fyc <- matrix(1,nrow=length(id),ncol=length(probs$p)+1)
fyc[status==2,1:length(probs$p)] <- t(apply(y[status==2,],1,dens.norm,
                                      param.cont,NULL))
#the function
upward(id,dad,mom,status,probs,fyc,peel)