Last data update: 2014.03.03

 R: performs the upward step of the peeling algorithm of a...
upwardR Documentation

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)

Results


R version 3.3.1 (2016-06-21) -- "Bug in Your Hair"
Copyright (C) 2016 The R Foundation for Statistical Computing
Platform: x86_64-pc-linux-gnu (64-bit)

R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
Type 'license()' or 'licence()' for distribution details.

R is a collaborative project with many contributors.
Type 'contributors()' for more information and
'citation()' on how to cite R or R packages in publications.

Type 'demo()' for some demos, 'help()' for on-line help, or
'help.start()' for an HTML browser interface to help.
Type 'q()' to quit R.

> library(LCAextend)
Loading required package: boot
Loading required package: mvtnorm
Loading required package: rms
Loading required package: Hmisc
Loading required package: lattice

Attaching package: 'lattice'

The following object is masked from 'package:boot':

    melanoma

Loading required package: survival

Attaching package: 'survival'

The following object is masked from 'package:boot':

    aml

Loading required package: Formula
Loading required package: ggplot2

Attaching package: 'Hmisc'

The following objects are masked from 'package:base':

    format.pval, round.POSIXt, trunc.POSIXt, units

Loading required package: SparseM

Attaching package: 'SparseM'

The following object is masked from 'package:base':

    backsolve

Loading required package: kinship2
Loading required package: Matrix
Loading required package: quadprog
> png(filename="/home/ddbj/snapshot/RGM3/R_CC/result/LCAextend/upward.Rd_%03d_medium.png", width=480, height=480)
> ### Name: upward
> ### Title: performs the upward step of the peeling algorithm of a pedigree
> ### Aliases: upward
> 
> ### ** 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)
$p.yF.c
              [,1]         [,2]         [,3]         [,4]
 [1,] 1.000000e+00 1.000000e+00 1.000000e+00 1.000000e+00
 [2,] 1.000000e+00 1.000000e+00 1.000000e+00 1.000000e+00
 [3,] 1.000000e+00 1.000000e+00 1.000000e+00 1.000000e+00
 [4,] 1.000000e+00 1.000000e+00 1.000000e+00 1.000000e+00
 [5,] 1.000000e+00 1.000000e+00 1.000000e+00 1.000000e+00
 [6,] 1.000000e+00 1.000000e+00 1.000000e+00 1.000000e+00
 [7,] 1.000000e+00 1.000000e+00 1.000000e+00 1.000000e+00
 [8,] 1.000000e+00 1.000000e+00 1.000000e+00 1.000000e+00
 [9,] 1.000000e+00 1.000000e+00 1.000000e+00 1.000000e+00
[10,] 1.834536e-09 1.834536e-09 1.834536e-09 9.172680e-10
[11,] 1.052273e-03 1.052273e-03 1.052273e-03 5.261366e-04
[12,] 2.183342e-05 2.183342e-05 2.183342e-05 1.637506e-05
[13,] 4.023401e-18 4.023401e-18 4.023401e-18 1.636114e-18
[14,] 1.000000e+00 1.000000e+00 1.000000e+00 1.000000e+00

$sum.child
, , 1

              [,1]         [,2]         [,3]         [,4]
 [1,] 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00
 [2,] 3.634931e-03 3.634931e-03 3.634931e-03 3.634931e-03
 [3,] 1.491785e-04 1.491785e-04 1.491785e-04 1.491785e-04
 [4,] 6.766338e-03 6.766338e-03 6.766338e-03 6.766338e-03
 [5,] 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00
 [6,] 2.104546e-03 2.104546e-03 2.104546e-03 2.104546e-03
 [7,] 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00
 [8,] 4.836159e-03 4.836159e-03 4.836159e-03 4.836159e-03
 [9,] 4.514619e-03 4.514619e-03 4.514619e-03 4.514619e-03
[10,] 9.172680e-10 9.172680e-10 9.172680e-10 6.879510e-10
[11,] 5.261366e-04 5.261366e-04 5.261366e-04 3.946025e-04
[12,] 2.183342e-05 2.183342e-05 2.183342e-05 2.046883e-05
[13,] 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00
[14,] 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00

, , 2

              [,1]         [,2]         [,3]         [,4]
 [1,] 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00
 [2,] 3.634931e-03 3.634931e-03 3.634931e-03 3.634931e-03
 [3,] 1.491785e-04 1.491785e-04 1.491785e-04 1.491785e-04
 [4,] 6.766338e-03 6.766338e-03 6.766338e-03 6.766338e-03
 [5,] 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00
 [6,] 2.104546e-03 2.104546e-03 2.104546e-03 2.104546e-03
 [7,] 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00
 [8,] 4.836159e-03 4.836159e-03 4.836159e-03 4.836159e-03
 [9,] 4.514619e-03 4.514619e-03 4.514619e-03 4.514619e-03
[10,] 9.172680e-10 9.172680e-10 9.172680e-10 6.879510e-10
[11,] 5.261366e-04 5.261366e-04 5.261366e-04 3.946025e-04
[12,] 2.183342e-05 2.183342e-05 2.183342e-05 2.046883e-05
[13,] 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00
[14,] 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00

, , 3

              [,1]         [,2]         [,3]         [,4]
 [1,] 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00
 [2,] 3.634931e-03 3.634931e-03 3.634931e-03 3.634931e-03
 [3,] 1.491785e-04 1.491785e-04 1.491785e-04 1.491785e-04
 [4,] 6.766338e-03 6.766338e-03 6.766338e-03 6.766338e-03
 [5,] 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00
 [6,] 2.104546e-03 2.104546e-03 2.104546e-03 2.104546e-03
 [7,] 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00
 [8,] 4.836159e-03 4.836159e-03 4.836159e-03 4.836159e-03
 [9,] 4.514619e-03 4.514619e-03 4.514619e-03 4.514619e-03
[10,] 9.172680e-10 9.172680e-10 9.172680e-10 6.879510e-10
[11,] 5.261366e-04 5.261366e-04 5.261366e-04 3.946025e-04
[12,] 2.183342e-05 2.183342e-05 2.183342e-05 2.046883e-05
[13,] 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00
[14,] 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00

, , 4

              [,1]         [,2]         [,3]         [,4]
 [1,] 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00
 [2,] 3.634931e-03 3.634931e-03 3.634931e-03 0.000000e+00
 [3,] 1.491785e-04 1.491785e-04 1.491785e-04 0.000000e+00
 [4,] 6.766338e-03 6.766338e-03 6.766338e-03 0.000000e+00
 [5,] 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00
 [6,] 2.104546e-03 2.104546e-03 2.104546e-03 0.000000e+00
 [7,] 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00
 [8,] 4.836159e-03 4.836159e-03 4.836159e-03 0.000000e+00
 [9,] 4.514619e-03 4.514619e-03 4.514619e-03 0.000000e+00
[10,] 6.879510e-10 6.879510e-10 6.879510e-10 4.586340e-10
[11,] 3.946025e-04 3.946025e-04 3.946025e-04 2.630683e-04
[12,] 2.046883e-05 2.046883e-05 2.046883e-05 8.187531e-06
[13,] 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00
[14,] 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00


> 
> 
> 
> 
> 
> dev.off()
null device 
          1 
>


Created & Maintained by Osamu Ogasawara (osamu.ogasawara@gmail.com) and IMSBIO