[8da99d]: / R / calc.llk.tree.R

Download this file

51 lines (47 with data), 1.7 kB

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
#' Function to calculate integrated likelihood for set of variants up tree
#'
#' @param pars A list object as returned by the function set.parameters
#' @param data.sub A 3-dimension array (N. SNPs x N. phenotypes x 3) with state likelihoods.
#' @param returnForwardMatrix Boolean
#' @param returnGMatrix Boolean
#'
#' @return Either a numeric object with the Tree likelihood or a list with FWD and G matrices
calc.llk.tree <- function(
pars,
data.sub,
returnForwardMatrix = FALSE,
returnGMatrix = FALSE
) {
## Get integrated likelihood at nodes - will be overwritten for internal nodes
mx <- apply(data.sub, 1, max);
d <- exp(data.sub-mx);
llk.integrated <- log(d %*% pars$stat.dist)+mx;
if (returnGMatrix) g <- array(0, dim(d));
for (i in pars$t.path) {
## Emissions at node
emiss.node<-data.sub[i,];
data.sub[i,]<-0;
for (j in pars$ontology[[i]]) {
tmp1 <- cbind(
data.sub[j,]-pars$theta.tree,
llk.integrated[j]+pars$lp.switch
);
mx1 <- apply(tmp1, 1, max);
tmp2 <- mx1+log(rowSums(exp(tmp1-mx1)));
data.sub[i,] <- data.sub[i,]+tmp2;
if (returnGMatrix) g[j,] <- tmp2;
}
data.sub[i,] <- data.sub[i,]+emiss.node;
mx <- max(data.sub[i,]);
llk.integrated[i] <- mx+log(sum(exp(data.sub[i,]-mx)*pars$stat.dist));
}
if (returnForwardMatrix) {
if (!returnGMatrix) {
return(data.sub);
} else {
return(list(f=data.sub, g=g));
}
} else {
return(llk.integrated[i]);
}
}