Last updated on 2020-02-19 10:48:56 CET.
Flavor | Version | Tinstall | Tcheck | Ttotal | Status | Flags |
---|---|---|---|---|---|---|
r-devel-linux-x86_64-debian-clang | 1.0 | 9.99 | 83.25 | 93.24 | ERROR | |
r-devel-linux-x86_64-debian-gcc | 1.0 | 8.00 | 65.63 | 73.63 | ERROR | |
r-devel-linux-x86_64-fedora-clang | 1.0 | 112.41 | ERROR | |||
r-devel-linux-x86_64-fedora-gcc | 1.0 | 112.41 | ERROR | |||
r-devel-windows-ix86+x86_64 | 1.0 | 19.00 | 94.00 | 113.00 | OK | |
r-devel-windows-ix86+x86_64-gcc8 | 1.0 | 26.00 | 113.00 | 139.00 | OK | |
r-patched-linux-x86_64 | 1.0 | 7.46 | 75.79 | 83.25 | OK | |
r-patched-solaris-x86 | 1.0 | 163.30 | OK | |||
r-release-linux-x86_64 | 1.0 | 9.20 | 76.50 | 85.70 | OK | |
r-release-windows-ix86+x86_64 | 1.0 | 16.00 | 81.00 | 97.00 | OK | |
r-release-osx-x86_64 | 1.0 | OK | ||||
r-oldrel-windows-ix86+x86_64 | 1.0 | 9.00 | 80.00 | 89.00 | OK | |
r-oldrel-osx-x86_64 | 1.0 | OK |
Version: 1.0
Check: examples
Result: ERROR
Running examples in 'iNOTE-Ex.R' failed
The error most likely occurred in:
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: itegs
> ### Title: Integrative Total Effect of a Gene Set Test
> ### Aliases: itegs
> ### Keywords: multivariate
>
> ### ** Examples
>
> data(X); data(Y); data(CPG); data(GE)
> itegs(iCPG=CPG, iGE=GE, iY=Y, iX=X, imodel='mgc', iapprox='pert', gsp.emp=FALSE);
----------- FAILURE REPORT --------------
--- failure: the condition has length > 1 ---
--- srcref ---
:
--- package (from environment) ---
iNOTE
--- call from context ---
my.TEtest(M = as.matrix(iCPG[[g]]), G = as.matrix(iGE[, g]),
Y = iY, fam = ifam, X = iX, method = iapprox, n.pert = no.pert,
consider.gene = TRUE, consider.intx = TRUE)
--- call from argument ---
if (class(X) == "logical") X <- rep(1, n)
--- R stacktrace ---
where 1: my.TEtest(M = as.matrix(iCPG[[g]]), G = as.matrix(iGE[, g]),
Y = iY, fam = ifam, X = iX, method = iapprox, n.pert = no.pert,
consider.gene = TRUE, consider.intx = TRUE)
where 2: itegs(iCPG = CPG, iGE = GE, iY = Y, iX = X, imodel = "mgc", iapprox = "pert",
gsp.emp = FALSE)
--- value of length: 2 type: logical ---
[1] FALSE FALSE
--- function from context ---
function (M, G, Y, X = NA, consider.gene = FALSE, consider.intx = FALSE,
weight = "lambda", a = c(1, 1, 1), R.star = NA, fam = NA,
method = "pert", n.pert = 1000, pert.app = TRUE, seed = NA)
{
n <- length(Y)
p <- dim(M)[2]
if (class(X) == "logical")
X <- rep(1, n)
C <- matrix(NA, nrow = n, ncol = p)
if (consider.intx)
for (i in 1:n) {
C[i, ] <- G[i, ] * M[i, ]
}
G <- 1 * (G - mean(G))/sd(G)
s.sd <- apply(M, 2, sd)
s.m <- apply(M, 2, mean)
M <- t((t(M) - s.m)/s.sd)
c.sd <- apply(C, 2, sd)
c.m <- apply(C, 2, mean)
C <- t((t(C) - c.m)/c.sd)
if (weight != "specify") {
a <- weight1(M, G, C, Y, X, consider.gene, consider.intx)
}
fit0 <- glm(Y ~ X, family = binomial)
eta0 <- predict(fit0)
mu.0 <- exp(eta0)/(1 + exp(eta0))
if (!consider.gene & !consider.intx)
A.cent <- a[1] * M %*% t(M)
if (consider.gene & !consider.intx)
A.cent <- a[1] * M %*% t(M) + a[2] * G %*% t(G)
if (consider.intx & consider.gene)
A.cent <- a[1] * M %*% t(M) + a[2] * G %*% t(G) + a[3] *
C %*% t(C)
p <- dim(M)[2]
offd <- 0
ff <- fam
mat <- matrix(0, nrow = length(ff), ncol = length(ff))
mat2 <- matrix(0, nrow = length(ff), ncol = length(ff))
for (i in 1:length(ff)) {
for (j in 1:length(ff)) {
if (ff[i] == ff[j]) {
mat[i, j] <- offd
mat2[i, j] <- offd
}
}
}
diag(mat) <- 1
diag(mat2) <- 1
R.star <- mat
R <- mat2
R.inv <- solve(R)
W0.5 <- diag(exp(eta0 * 0.5)/(1 + exp(eta0)))
if (method == "davies") {
m <- length(unique(fam))
Q.hat <- (1/m) * t(Y - mu.0) %*% R.inv %*% A.cent %*%
R.inv %*% (Y - mu.0)
svdr <- svd(R.inv)
R.inv.5 <- svdr$u %*% diag(sqrt(svdr$d))
DD <- eigen(W0.5 %*% R.inv.5 %*% A.cent %*% R.inv.5 %*%
W0.5/m, symmetric = TRUE)$value
pval <- list(davies.p = davies(Q.hat, lambda = DD[DD >
1e-06])$Qq, Qhat = Q.hat, A.cent = A.cent)
}
if (method == "pert") {
m <- length(unique(fam))
Q.hat <- (1/m) * t(Y - mu.0) %*% R.inv %*% A.cent %*%
R.inv %*% (Y - mu.0)
if (!consider.gene & !consider.intx)
V <- sqrt(a[1]) * M
if (consider.gene & !consider.intx)
V <- cbind(sqrt(a[1]) * M, sqrt(a[2]) * G)
if (consider.gene & consider.intx)
V <- cbind(sqrt(a[1]) * M, sqrt(a[2]) * G, sqrt(a[3]) *
C)
U <- cbind(X, V)
CC <- 1/m * t(U) %*% W0.5 %*% R.inv %*% W0.5 %*% U
if (!is.null(dim(X))) {
q <- dim(X)[2]
}
else {
q <- 1
}
Cvx <- CC[(q + 1):(dim(U)[2]), 1:q]
Cxx <- CC[1:q, 1:q]
Av <- cbind(-Cvx %*% solve(Cxx), diag(1, dim(V)[2]))
ehalf <- (1/sqrt(m)) * t(U)
QQ.0 <- rep(0, n.pert)
if (!is.na(seed)) {
set.seed(seed)
}
N.m <- rnorm(m * n.pert)
N.m <- matrix(N.m, ncol = m)
epsilon <- ehalf %*% ((Y - mu.0) * t(N.m))
for (r in 1:dim(Av)[1]) QQ.0 <- QQ.0 + (Av[r, ] %*% epsilon)^2
QQ.0 <- as.numeric(QQ.0)
pval.qq0 <- (n.pert - rank(QQ.0) + 1)/n.pert
pval.qq0[which.max(pval.qq0)] <- 1 - 0.5/n.pert
if (!pert.app)
pval <- mean(QQ.0 > Q.hat[1])
if (pert.app) {
EQ.p <- mean(QQ.0)
VQ.p <- var(QQ.0)
kappa.p <- VQ.p/(2 * EQ.p)
nu.p <- 2 * (EQ.p)^2/VQ.p
pval <- pchisq(Q.hat[1]/kappa.p, df = nu.p, lower.tail = FALSE)
}
svdr <- svd(R.inv)
R.inv.5 <- svdr$u %*% diag(sqrt(svdr$d))
h <- R.inv.5 %*% W0.5 %*% X
H <- h %*% solve(t(h) %*% h) %*% t(h)
A <- (diag(1, n) - H) %*% R.inv %*% W0.5 %*% A.cent %*%
W0.5 %*% R.inv %*% (diag(1, n) - H)
SVQ <- 2 * sum(diag(A %*% R.star %*% A %*% R.star))
pval <- list(pval, pval.qq0, Qhat = Q.hat, Q.pert.var = var(QQ.0),
QQ.0 = QQ.0, lambdaWts = a)
}
return(pval)
}
<bytecode: 0x4876770>
<environment: namespace:iNOTE>
--- function search by body ---
Function my.TEtest in namespace iNOTE has this body.
----------- END OF FAILURE REPORT --------------
Error in if (class(X) == "logical") X <- rep(1, n) :
the condition has length > 1
Calls: itegs -> my.TEtest
Execution halted
Flavor: r-devel-linux-x86_64-debian-clang
Version: 1.0
Check: examples
Result: ERROR
Running examples in ‘iNOTE-Ex.R’ failed
The error most likely occurred in:
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: itegs
> ### Title: Integrative Total Effect of a Gene Set Test
> ### Aliases: itegs
> ### Keywords: multivariate
>
> ### ** Examples
>
> data(X); data(Y); data(CPG); data(GE)
> itegs(iCPG=CPG, iGE=GE, iY=Y, iX=X, imodel='mgc', iapprox='pert', gsp.emp=FALSE);
----------- FAILURE REPORT --------------
--- failure: the condition has length > 1 ---
--- srcref ---
:
--- package (from environment) ---
iNOTE
--- call from context ---
my.TEtest(M = as.matrix(iCPG[[g]]), G = as.matrix(iGE[, g]),
Y = iY, fam = ifam, X = iX, method = iapprox, n.pert = no.pert,
consider.gene = TRUE, consider.intx = TRUE)
--- call from argument ---
if (class(X) == "logical") X <- rep(1, n)
--- R stacktrace ---
where 1: my.TEtest(M = as.matrix(iCPG[[g]]), G = as.matrix(iGE[, g]),
Y = iY, fam = ifam, X = iX, method = iapprox, n.pert = no.pert,
consider.gene = TRUE, consider.intx = TRUE)
where 2: itegs(iCPG = CPG, iGE = GE, iY = Y, iX = X, imodel = "mgc", iapprox = "pert",
gsp.emp = FALSE)
--- value of length: 2 type: logical ---
[1] FALSE FALSE
--- function from context ---
function (M, G, Y, X = NA, consider.gene = FALSE, consider.intx = FALSE,
weight = "lambda", a = c(1, 1, 1), R.star = NA, fam = NA,
method = "pert", n.pert = 1000, pert.app = TRUE, seed = NA)
{
n <- length(Y)
p <- dim(M)[2]
if (class(X) == "logical")
X <- rep(1, n)
C <- matrix(NA, nrow = n, ncol = p)
if (consider.intx)
for (i in 1:n) {
C[i, ] <- G[i, ] * M[i, ]
}
G <- 1 * (G - mean(G))/sd(G)
s.sd <- apply(M, 2, sd)
s.m <- apply(M, 2, mean)
M <- t((t(M) - s.m)/s.sd)
c.sd <- apply(C, 2, sd)
c.m <- apply(C, 2, mean)
C <- t((t(C) - c.m)/c.sd)
if (weight != "specify") {
a <- weight1(M, G, C, Y, X, consider.gene, consider.intx)
}
fit0 <- glm(Y ~ X, family = binomial)
eta0 <- predict(fit0)
mu.0 <- exp(eta0)/(1 + exp(eta0))
if (!consider.gene & !consider.intx)
A.cent <- a[1] * M %*% t(M)
if (consider.gene & !consider.intx)
A.cent <- a[1] * M %*% t(M) + a[2] * G %*% t(G)
if (consider.intx & consider.gene)
A.cent <- a[1] * M %*% t(M) + a[2] * G %*% t(G) + a[3] *
C %*% t(C)
p <- dim(M)[2]
offd <- 0
ff <- fam
mat <- matrix(0, nrow = length(ff), ncol = length(ff))
mat2 <- matrix(0, nrow = length(ff), ncol = length(ff))
for (i in 1:length(ff)) {
for (j in 1:length(ff)) {
if (ff[i] == ff[j]) {
mat[i, j] <- offd
mat2[i, j] <- offd
}
}
}
diag(mat) <- 1
diag(mat2) <- 1
R.star <- mat
R <- mat2
R.inv <- solve(R)
W0.5 <- diag(exp(eta0 * 0.5)/(1 + exp(eta0)))
if (method == "davies") {
m <- length(unique(fam))
Q.hat <- (1/m) * t(Y - mu.0) %*% R.inv %*% A.cent %*%
R.inv %*% (Y - mu.0)
svdr <- svd(R.inv)
R.inv.5 <- svdr$u %*% diag(sqrt(svdr$d))
DD <- eigen(W0.5 %*% R.inv.5 %*% A.cent %*% R.inv.5 %*%
W0.5/m, symmetric = TRUE)$value
pval <- list(davies.p = davies(Q.hat, lambda = DD[DD >
1e-06])$Qq, Qhat = Q.hat, A.cent = A.cent)
}
if (method == "pert") {
m <- length(unique(fam))
Q.hat <- (1/m) * t(Y - mu.0) %*% R.inv %*% A.cent %*%
R.inv %*% (Y - mu.0)
if (!consider.gene & !consider.intx)
V <- sqrt(a[1]) * M
if (consider.gene & !consider.intx)
V <- cbind(sqrt(a[1]) * M, sqrt(a[2]) * G)
if (consider.gene & consider.intx)
V <- cbind(sqrt(a[1]) * M, sqrt(a[2]) * G, sqrt(a[3]) *
C)
U <- cbind(X, V)
CC <- 1/m * t(U) %*% W0.5 %*% R.inv %*% W0.5 %*% U
if (!is.null(dim(X))) {
q <- dim(X)[2]
}
else {
q <- 1
}
Cvx <- CC[(q + 1):(dim(U)[2]), 1:q]
Cxx <- CC[1:q, 1:q]
Av <- cbind(-Cvx %*% solve(Cxx), diag(1, dim(V)[2]))
ehalf <- (1/sqrt(m)) * t(U)
QQ.0 <- rep(0, n.pert)
if (!is.na(seed)) {
set.seed(seed)
}
N.m <- rnorm(m * n.pert)
N.m <- matrix(N.m, ncol = m)
epsilon <- ehalf %*% ((Y - mu.0) * t(N.m))
for (r in 1:dim(Av)[1]) QQ.0 <- QQ.0 + (Av[r, ] %*% epsilon)^2
QQ.0 <- as.numeric(QQ.0)
pval.qq0 <- (n.pert - rank(QQ.0) + 1)/n.pert
pval.qq0[which.max(pval.qq0)] <- 1 - 0.5/n.pert
if (!pert.app)
pval <- mean(QQ.0 > Q.hat[1])
if (pert.app) {
EQ.p <- mean(QQ.0)
VQ.p <- var(QQ.0)
kappa.p <- VQ.p/(2 * EQ.p)
nu.p <- 2 * (EQ.p)^2/VQ.p
pval <- pchisq(Q.hat[1]/kappa.p, df = nu.p, lower.tail = FALSE)
}
svdr <- svd(R.inv)
R.inv.5 <- svdr$u %*% diag(sqrt(svdr$d))
h <- R.inv.5 %*% W0.5 %*% X
H <- h %*% solve(t(h) %*% h) %*% t(h)
A <- (diag(1, n) - H) %*% R.inv %*% W0.5 %*% A.cent %*%
W0.5 %*% R.inv %*% (diag(1, n) - H)
SVQ <- 2 * sum(diag(A %*% R.star %*% A %*% R.star))
pval <- list(pval, pval.qq0, Qhat = Q.hat, Q.pert.var = var(QQ.0),
QQ.0 = QQ.0, lambdaWts = a)
}
return(pval)
}
<bytecode: 0x563a3cff01b8>
<environment: namespace:iNOTE>
--- function search by body ---
Function my.TEtest in namespace iNOTE has this body.
----------- END OF FAILURE REPORT --------------
Error in if (class(X) == "logical") X <- rep(1, n) :
the condition has length > 1
Calls: itegs -> my.TEtest
Execution halted
Flavor: r-devel-linux-x86_64-debian-gcc
Version: 1.0
Check: examples
Result: ERROR
Running examples in ‘iNOTE-Ex.R’ failed
The error most likely occurred in:
> ### Name: itegs
> ### Title: Integrative Total Effect of a Gene Set Test
> ### Aliases: itegs
> ### Keywords: multivariate
>
> ### ** Examples
>
> data(X); data(Y); data(CPG); data(GE)
> itegs(iCPG=CPG, iGE=GE, iY=Y, iX=X, imodel='mgc', iapprox='pert', gsp.emp=FALSE);
----------- FAILURE REPORT --------------
--- failure: the condition has length > 1 ---
--- srcref ---
:
--- package (from environment) ---
iNOTE
--- call from context ---
my.TEtest(M = as.matrix(iCPG[[g]]), G = as.matrix(iGE[, g]),
Y = iY, fam = ifam, X = iX, method = iapprox, n.pert = no.pert,
consider.gene = TRUE, consider.intx = TRUE)
--- call from argument ---
if (class(X) == "logical") X <- rep(1, n)
--- R stacktrace ---
where 1: my.TEtest(M = as.matrix(iCPG[[g]]), G = as.matrix(iGE[, g]),
Y = iY, fam = ifam, X = iX, method = iapprox, n.pert = no.pert,
consider.gene = TRUE, consider.intx = TRUE)
where 2: itegs(iCPG = CPG, iGE = GE, iY = Y, iX = X, imodel = "mgc", iapprox = "pert",
gsp.emp = FALSE)
--- value of length: 2 type: logical ---
[1] FALSE FALSE
--- function from context ---
function (M, G, Y, X = NA, consider.gene = FALSE, consider.intx = FALSE,
weight = "lambda", a = c(1, 1, 1), R.star = NA, fam = NA,
method = "pert", n.pert = 1000, pert.app = TRUE, seed = NA)
{
n <- length(Y)
p <- dim(M)[2]
if (class(X) == "logical")
X <- rep(1, n)
C <- matrix(NA, nrow = n, ncol = p)
if (consider.intx)
for (i in 1:n) {
C[i, ] <- G[i, ] * M[i, ]
}
G <- 1 * (G - mean(G))/sd(G)
s.sd <- apply(M, 2, sd)
s.m <- apply(M, 2, mean)
M <- t((t(M) - s.m)/s.sd)
c.sd <- apply(C, 2, sd)
c.m <- apply(C, 2, mean)
C <- t((t(C) - c.m)/c.sd)
if (weight != "specify") {
a <- weight1(M, G, C, Y, X, consider.gene, consider.intx)
}
fit0 <- glm(Y ~ X, family = binomial)
eta0 <- predict(fit0)
mu.0 <- exp(eta0)/(1 + exp(eta0))
if (!consider.gene & !consider.intx)
A.cent <- a[1] * M %*% t(M)
if (consider.gene & !consider.intx)
A.cent <- a[1] * M %*% t(M) + a[2] * G %*% t(G)
if (consider.intx & consider.gene)
A.cent <- a[1] * M %*% t(M) + a[2] * G %*% t(G) + a[3] *
C %*% t(C)
p <- dim(M)[2]
offd <- 0
ff <- fam
mat <- matrix(0, nrow = length(ff), ncol = length(ff))
mat2 <- matrix(0, nrow = length(ff), ncol = length(ff))
for (i in 1:length(ff)) {
for (j in 1:length(ff)) {
if (ff[i] == ff[j]) {
mat[i, j] <- offd
mat2[i, j] <- offd
}
}
}
diag(mat) <- 1
diag(mat2) <- 1
R.star <- mat
R <- mat2
R.inv <- solve(R)
W0.5 <- diag(exp(eta0 * 0.5)/(1 + exp(eta0)))
if (method == "davies") {
m <- length(unique(fam))
Q.hat <- (1/m) * t(Y - mu.0) %*% R.inv %*% A.cent %*%
R.inv %*% (Y - mu.0)
svdr <- svd(R.inv)
R.inv.5 <- svdr$u %*% diag(sqrt(svdr$d))
DD <- eigen(W0.5 %*% R.inv.5 %*% A.cent %*% R.inv.5 %*%
W0.5/m, symmetric = TRUE)$value
pval <- list(davies.p = davies(Q.hat, lambda = DD[DD >
1e-06])$Qq, Qhat = Q.hat, A.cent = A.cent)
}
if (method == "pert") {
m <- length(unique(fam))
Q.hat <- (1/m) * t(Y - mu.0) %*% R.inv %*% A.cent %*%
R.inv %*% (Y - mu.0)
if (!consider.gene & !consider.intx)
V <- sqrt(a[1]) * M
if (consider.gene & !consider.intx)
V <- cbind(sqrt(a[1]) * M, sqrt(a[2]) * G)
if (consider.gene & consider.intx)
V <- cbind(sqrt(a[1]) * M, sqrt(a[2]) * G, sqrt(a[3]) *
C)
U <- cbind(X, V)
CC <- 1/m * t(U) %*% W0.5 %*% R.inv %*% W0.5 %*% U
if (!is.null(dim(X))) {
q <- dim(X)[2]
}
else {
q <- 1
}
Cvx <- CC[(q + 1):(dim(U)[2]), 1:q]
Cxx <- CC[1:q, 1:q]
Av <- cbind(-Cvx %*% solve(Cxx), diag(1, dim(V)[2]))
ehalf <- (1/sqrt(m)) * t(U)
QQ.0 <- rep(0, n.pert)
if (!is.na(seed)) {
set.seed(seed)
}
N.m <- rnorm(m * n.pert)
N.m <- matrix(N.m, ncol = m)
epsilon <- ehalf %*% ((Y - mu.0) * t(N.m))
for (r in 1:dim(Av)[1]) QQ.0 <- QQ.0 + (Av[r, ] %*% epsilon)^2
QQ.0 <- as.numeric(QQ.0)
pval.qq0 <- (n.pert - rank(QQ.0) + 1)/n.pert
pval.qq0[which.max(pval.qq0)] <- 1 - 0.5/n.pert
if (!pert.app)
pval <- mean(QQ.0 > Q.hat[1])
if (pert.app) {
EQ.p <- mean(QQ.0)
VQ.p <- var(QQ.0)
kappa.p <- VQ.p/(2 * EQ.p)
nu.p <- 2 * (EQ.p)^2/VQ.p
pval <- pchisq(Q.hat[1]/kappa.p, df = nu.p, lower.tail = FALSE)
}
svdr <- svd(R.inv)
R.inv.5 <- svdr$u %*% diag(sqrt(svdr$d))
h <- R.inv.5 %*% W0.5 %*% X
H <- h %*% solve(t(h) %*% h) %*% t(h)
A <- (diag(1, n) - H) %*% R.inv %*% W0.5 %*% A.cent %*%
W0.5 %*% R.inv %*% (diag(1, n) - H)
SVQ <- 2 * sum(diag(A %*% R.star %*% A %*% R.star))
pval <- list(pval, pval.qq0, Qhat = Q.hat, Q.pert.var = var(QQ.0),
QQ.0 = QQ.0, lambdaWts = a)
}
return(pval)
}
<bytecode: 0x6e214d0>
<environment: namespace:iNOTE>
--- function search by body ---
Function my.TEtest in namespace iNOTE has this body.
----------- END OF FAILURE REPORT --------------
Error in if (class(X) == "logical") X <- rep(1, n) :
the condition has length > 1
Calls: itegs -> my.TEtest
Execution halted
Flavor: r-devel-linux-x86_64-fedora-clang
Version: 1.0
Check: examples
Result: ERROR
Running examples in ‘iNOTE-Ex.R’ failed
The error most likely occurred in:
> ### Name: itegs
> ### Title: Integrative Total Effect of a Gene Set Test
> ### Aliases: itegs
> ### Keywords: multivariate
>
> ### ** Examples
>
> data(X); data(Y); data(CPG); data(GE)
> itegs(iCPG=CPG, iGE=GE, iY=Y, iX=X, imodel='mgc', iapprox='pert', gsp.emp=FALSE);
----------- FAILURE REPORT --------------
--- failure: the condition has length > 1 ---
--- srcref ---
:
--- package (from environment) ---
iNOTE
--- call from context ---
my.TEtest(M = as.matrix(iCPG[[g]]), G = as.matrix(iGE[, g]),
Y = iY, fam = ifam, X = iX, method = iapprox, n.pert = no.pert,
consider.gene = TRUE, consider.intx = TRUE)
--- call from argument ---
if (class(X) == "logical") X <- rep(1, n)
--- R stacktrace ---
where 1: my.TEtest(M = as.matrix(iCPG[[g]]), G = as.matrix(iGE[, g]),
Y = iY, fam = ifam, X = iX, method = iapprox, n.pert = no.pert,
consider.gene = TRUE, consider.intx = TRUE)
where 2: itegs(iCPG = CPG, iGE = GE, iY = Y, iX = X, imodel = "mgc", iapprox = "pert",
gsp.emp = FALSE)
--- value of length: 2 type: logical ---
[1] FALSE FALSE
--- function from context ---
function (M, G, Y, X = NA, consider.gene = FALSE, consider.intx = FALSE,
weight = "lambda", a = c(1, 1, 1), R.star = NA, fam = NA,
method = "pert", n.pert = 1000, pert.app = TRUE, seed = NA)
{
n <- length(Y)
p <- dim(M)[2]
if (class(X) == "logical")
X <- rep(1, n)
C <- matrix(NA, nrow = n, ncol = p)
if (consider.intx)
for (i in 1:n) {
C[i, ] <- G[i, ] * M[i, ]
}
G <- 1 * (G - mean(G))/sd(G)
s.sd <- apply(M, 2, sd)
s.m <- apply(M, 2, mean)
M <- t((t(M) - s.m)/s.sd)
c.sd <- apply(C, 2, sd)
c.m <- apply(C, 2, mean)
C <- t((t(C) - c.m)/c.sd)
if (weight != "specify") {
a <- weight1(M, G, C, Y, X, consider.gene, consider.intx)
}
fit0 <- glm(Y ~ X, family = binomial)
eta0 <- predict(fit0)
mu.0 <- exp(eta0)/(1 + exp(eta0))
if (!consider.gene & !consider.intx)
A.cent <- a[1] * M %*% t(M)
if (consider.gene & !consider.intx)
A.cent <- a[1] * M %*% t(M) + a[2] * G %*% t(G)
if (consider.intx & consider.gene)
A.cent <- a[1] * M %*% t(M) + a[2] * G %*% t(G) + a[3] *
C %*% t(C)
p <- dim(M)[2]
offd <- 0
ff <- fam
mat <- matrix(0, nrow = length(ff), ncol = length(ff))
mat2 <- matrix(0, nrow = length(ff), ncol = length(ff))
for (i in 1:length(ff)) {
for (j in 1:length(ff)) {
if (ff[i] == ff[j]) {
mat[i, j] <- offd
mat2[i, j] <- offd
}
}
}
diag(mat) <- 1
diag(mat2) <- 1
R.star <- mat
R <- mat2
R.inv <- solve(R)
W0.5 <- diag(exp(eta0 * 0.5)/(1 + exp(eta0)))
if (method == "davies") {
m <- length(unique(fam))
Q.hat <- (1/m) * t(Y - mu.0) %*% R.inv %*% A.cent %*%
R.inv %*% (Y - mu.0)
svdr <- svd(R.inv)
R.inv.5 <- svdr$u %*% diag(sqrt(svdr$d))
DD <- eigen(W0.5 %*% R.inv.5 %*% A.cent %*% R.inv.5 %*%
W0.5/m, symmetric = TRUE)$value
pval <- list(davies.p = davies(Q.hat, lambda = DD[DD >
1e-06])$Qq, Qhat = Q.hat, A.cent = A.cent)
}
if (method == "pert") {
m <- length(unique(fam))
Q.hat <- (1/m) * t(Y - mu.0) %*% R.inv %*% A.cent %*%
R.inv %*% (Y - mu.0)
if (!consider.gene & !consider.intx)
V <- sqrt(a[1]) * M
if (consider.gene & !consider.intx)
V <- cbind(sqrt(a[1]) * M, sqrt(a[2]) * G)
if (consider.gene & consider.intx)
V <- cbind(sqrt(a[1]) * M, sqrt(a[2]) * G, sqrt(a[3]) *
C)
U <- cbind(X, V)
CC <- 1/m * t(U) %*% W0.5 %*% R.inv %*% W0.5 %*% U
if (!is.null(dim(X))) {
q <- dim(X)[2]
}
else {
q <- 1
}
Cvx <- CC[(q + 1):(dim(U)[2]), 1:q]
Cxx <- CC[1:q, 1:q]
Av <- cbind(-Cvx %*% solve(Cxx), diag(1, dim(V)[2]))
ehalf <- (1/sqrt(m)) * t(U)
QQ.0 <- rep(0, n.pert)
if (!is.na(seed)) {
set.seed(seed)
}
N.m <- rnorm(m * n.pert)
N.m <- matrix(N.m, ncol = m)
epsilon <- ehalf %*% ((Y - mu.0) * t(N.m))
for (r in 1:dim(Av)[1]) QQ.0 <- QQ.0 + (Av[r, ] %*% epsilon)^2
QQ.0 <- as.numeric(QQ.0)
pval.qq0 <- (n.pert - rank(QQ.0) + 1)/n.pert
pval.qq0[which.max(pval.qq0)] <- 1 - 0.5/n.pert
if (!pert.app)
pval <- mean(QQ.0 > Q.hat[1])
if (pert.app) {
EQ.p <- mean(QQ.0)
VQ.p <- var(QQ.0)
kappa.p <- VQ.p/(2 * EQ.p)
nu.p <- 2 * (EQ.p)^2/VQ.p
pval <- pchisq(Q.hat[1]/kappa.p, df = nu.p, lower.tail = FALSE)
}
svdr <- svd(R.inv)
R.inv.5 <- svdr$u %*% diag(sqrt(svdr$d))
h <- R.inv.5 %*% W0.5 %*% X
H <- h %*% solve(t(h) %*% h) %*% t(h)
A <- (diag(1, n) - H) %*% R.inv %*% W0.5 %*% A.cent %*%
W0.5 %*% R.inv %*% (diag(1, n) - H)
SVQ <- 2 * sum(diag(A %*% R.star %*% A %*% R.star))
pval <- list(pval, pval.qq0, Qhat = Q.hat, Q.pert.var = var(QQ.0),
QQ.0 = QQ.0, lambdaWts = a)
}
return(pval)
}
<bytecode: 0x7815e28>
<environment: namespace:iNOTE>
--- function search by body ---
Function my.TEtest in namespace iNOTE has this body.
----------- END OF FAILURE REPORT --------------
Error in if (class(X) == "logical") X <- rep(1, n) :
the condition has length > 1
Calls: itegs -> my.TEtest
Execution halted
Flavor: r-devel-linux-x86_64-fedora-gcc