R Graphical Manual

Browse All

Last data update: 2014.03.03

R: performs the upward step for a connector

upward.connect

R Documentation

performs the upward step for a connector

Description

computes the probability of the measurements below a connector conditionally to the connector latent class given the model parameters. This is an internal function not meant to be called by the user.

Usage

upward.connect(connect, spouse.connect, children.connect, status,
probs, p.yF.c, fyc, sum.child)

Arguments

`connect`	a connector in the pedigree,
`spouse.connect`	spouse of the connector,
`children.connect`	children of the connector,
`status`	a vector of symptom status of the whole pedigree,
`probs`	a list of probability parameters of the model,
`p.yF.c`	an array of dimension `n` times 2 times `K+1` giving the probability of measurements below the individual, depending on his status and his class, where `n` is the number of individuals and `K` is the total number of latent classes in the model,
`fyc`	a matrix of `n` times `K+1` given the density of measurements of each individual if allocated to class `k`,
`sum.child`	an array of dimension `nber.indiv` 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_1`.

Details

If Y_above(i) is the observations below connector i and C_i is his class, the functions computes P(Y_below(i)|C_i).

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` observations when his parent are assigned to classes `c_1` and `c_2`,
`p.yF.c`	a array of dimension `n` times 2 times `K+1` giving the probability of measurements below the individual, depending on his status and his class, updated for the current connector.

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.

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)
#a nuclear family
#connector in the pedigree 1
connect <- peel$peel.connect[1,1]
#soupse of connector connect
spouse.connect <- peel$couple[peel$couple[,1]==connect,2]
#children of connector connect
children.connect <- union(id[dad==connect],id[mom==connect])
#probs and param
data(probs)
data(param.cont)
#probabilitiy of observations above
p.yF.c <- matrix(1,nrow=length(id),ncol=length(probs$p)+1)
#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))
#sums over childs
sum.child <- array(0,c(length(id),length(probs$p)+1,length(probs$p)+1))
#the function
upward.connect(connect,spouse.connect,children.connect,status,probs,
               p.yF.c,fyc,sum.child)

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.connect.Rd_%03d_medium.png", width=480, height=480)
> ### Name: upward.connect
> ### Title: performs the upward step for a connector
> ### Aliases: 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)
> #a nuclear family
> #connector in the pedigree 1
> connect <- peel$peel.connect[1,1]
> #soupse of connector connect
> spouse.connect <- peel$couple[peel$couple[,1]==connect,2]
> #children of connector connect
> children.connect <- union(id[dad==connect],id[mom==connect])
> #probs and param
> data(probs)
> data(param.cont)
> #probabilitiy of observations above
> p.yF.c <- matrix(1,nrow=length(id),ncol=length(probs$p)+1)
> #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))
> #sums over childs
> sum.child <- array(0,c(length(id),length(probs$p)+1,length(probs$p)+1))
> #the function
> upward.connect(connect,spouse.connect,children.connect,status,probs,
+                p.yF.c,fyc,sum.child)
$sum.child
, , 1

              [,1]         [,2]         [,3]         [,4]
 [1,] 0.0000000000 0.0000000000 0.0000000000 0.0000000000
 [2,] 0.0036349312 0.0036349312 0.0036349312 0.0036349312
 [3,] 0.0001491785 0.0001491785 0.0001491785 0.0001491785
 [4,] 0.0067663382 0.0067663382 0.0067663382 0.0067663382
 [5,] 0.0000000000 0.0000000000 0.0000000000 0.0000000000
 [6,] 0.0000000000 0.0000000000 0.0000000000 0.0000000000
 [7,] 0.0000000000 0.0000000000 0.0000000000 0.0000000000
 [8,] 0.0000000000 0.0000000000 0.0000000000 0.0000000000
 [9,] 0.0000000000 0.0000000000 0.0000000000 0.0000000000
[10,] 0.0000000000 0.0000000000 0.0000000000 0.0000000000
[11,] 0.0000000000 0.0000000000 0.0000000000 0.0000000000
[12,] 0.0000000000 0.0000000000 0.0000000000 0.0000000000
[13,] 0.0000000000 0.0000000000 0.0000000000 0.0000000000
[14,] 0.0000000000 0.0000000000 0.0000000000 0.0000000000

, , 2

              [,1]         [,2]         [,3]         [,4]
 [1,] 0.0000000000 0.0000000000 0.0000000000 0.0000000000
 [2,] 0.0036349312 0.0036349312 0.0036349312 0.0036349312
 [3,] 0.0001491785 0.0001491785 0.0001491785 0.0001491785
 [4,] 0.0067663382 0.0067663382 0.0067663382 0.0067663382
 [5,] 0.0000000000 0.0000000000 0.0000000000 0.0000000000
 [6,] 0.0000000000 0.0000000000 0.0000000000 0.0000000000
 [7,] 0.0000000000 0.0000000000 0.0000000000 0.0000000000
 [8,] 0.0000000000 0.0000000000 0.0000000000 0.0000000000
 [9,] 0.0000000000 0.0000000000 0.0000000000 0.0000000000
[10,] 0.0000000000 0.0000000000 0.0000000000 0.0000000000
[11,] 0.0000000000 0.0000000000 0.0000000000 0.0000000000
[12,] 0.0000000000 0.0000000000 0.0000000000 0.0000000000
[13,] 0.0000000000 0.0000000000 0.0000000000 0.0000000000
[14,] 0.0000000000 0.0000000000 0.0000000000 0.0000000000

, , 3

              [,1]         [,2]         [,3]         [,4]
 [1,] 0.0000000000 0.0000000000 0.0000000000 0.0000000000
 [2,] 0.0036349312 0.0036349312 0.0036349312 0.0036349312
 [3,] 0.0001491785 0.0001491785 0.0001491785 0.0001491785
 [4,] 0.0067663382 0.0067663382 0.0067663382 0.0067663382
 [5,] 0.0000000000 0.0000000000 0.0000000000 0.0000000000
 [6,] 0.0000000000 0.0000000000 0.0000000000 0.0000000000
 [7,] 0.0000000000 0.0000000000 0.0000000000 0.0000000000
 [8,] 0.0000000000 0.0000000000 0.0000000000 0.0000000000
 [9,] 0.0000000000 0.0000000000 0.0000000000 0.0000000000
[10,] 0.0000000000 0.0000000000 0.0000000000 0.0000000000
[11,] 0.0000000000 0.0000000000 0.0000000000 0.0000000000
[12,] 0.0000000000 0.0000000000 0.0000000000 0.0000000000
[13,] 0.0000000000 0.0000000000 0.0000000000 0.0000000000
[14,] 0.0000000000 0.0000000000 0.0000000000 0.0000000000

, , 4

              [,1]         [,2]         [,3] [,4]
 [1,] 0.0000000000 0.0000000000 0.0000000000    0
 [2,] 0.0036349312 0.0036349312 0.0036349312    0
 [3,] 0.0001491785 0.0001491785 0.0001491785    0
 [4,] 0.0067663382 0.0067663382 0.0067663382    0
 [5,] 0.0000000000 0.0000000000 0.0000000000    0
 [6,] 0.0000000000 0.0000000000 0.0000000000    0
 [7,] 0.0000000000 0.0000000000 0.0000000000    0
 [8,] 0.0000000000 0.0000000000 0.0000000000    0
 [9,] 0.0000000000 0.0000000000 0.0000000000    0
[10,] 0.0000000000 0.0000000000 0.0000000000    0
[11,] 0.0000000000 0.0000000000 0.0000000000    0
[12,] 0.0000000000 0.0000000000 0.0000000000    0
[13,] 0.0000000000 0.0000000000 0.0000000000    0
[14,] 0.0000000000 0.0000000000 0.0000000000    0


$p.yF.c
              [,1]         [,2]         [,3]        [,4]
 [1,] 1.000000e+00 1.000000e+00 1.000000e+00 1.00000e+00
 [2,] 1.000000e+00 1.000000e+00 1.000000e+00 1.00000e+00
 [3,] 1.000000e+00 1.000000e+00 1.000000e+00 1.00000e+00
 [4,] 1.000000e+00 1.000000e+00 1.000000e+00 1.00000e+00
 [5,] 1.000000e+00 1.000000e+00 1.000000e+00 1.00000e+00
 [6,] 1.000000e+00 1.000000e+00 1.000000e+00 1.00000e+00
 [7,] 1.000000e+00 1.000000e+00 1.000000e+00 1.00000e+00
 [8,] 1.000000e+00 1.000000e+00 1.000000e+00 1.00000e+00
 [9,] 1.000000e+00 1.000000e+00 1.000000e+00 1.00000e+00
[10,] 1.834536e-09 1.834536e-09 1.834536e-09 9.17268e-10
[11,] 1.000000e+00 1.000000e+00 1.000000e+00 1.00000e+00
[12,] 1.000000e+00 1.000000e+00 1.000000e+00 1.00000e+00
[13,] 1.000000e+00 1.000000e+00 1.000000e+00 1.00000e+00
[14,] 1.000000e+00 1.000000e+00 1.000000e+00 1.00000e+00

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