Nothing
R/GxEScanR.R
In GxEScanR: Run GWAS/GWEIS Scans Using Binary Dosage Files
Defines functions
rungweis
gweis.mem
Documented in
gweis.mem
rungweis
#' @importFrom lsReg lsReg
#' @importFrom lsReg addcovar
#' @importFrom BinaryDosage getsnp
#' @importFrom stats binomial gaussian glm
NULL
#' Routine to allocate memory needed to perform a GWEIS.
#'
#' @param gemdl The results from glm for the gene-environment model. This model
#' contains the outcome and all covariates of interest with the last covariate
#' listed in the model being the covaraiate that the gene interaction is being
#' tested for.
#' @param subids A character vector of subject IDs that line up with the
#' data that was used in the models that are passed to this routine
#' @param tests The list of tests to perform. These can be any combination of
#' the following values "bg_go", "bg_ge", "bg_gxe", "bgxe", "joint", "bg_eg",
#' "bg_case", "bg_ctrl"
#' @param gomdl The results from glm for the gene-only model. This model
#' contains the outcome and all the covariates except the covariate that
#' the gene interaction is being tested for. Required (non-NULL) when
#' \code{"bg_go"} is included in \code{tests}; ignored otherwise.
#'
#' @return List containing allocated memory to perform the specified GWEIS.
#' This value is passed to the \code{rungweis} routine. Returns \code{1} if
#' any value in \code{tests} is not a recognised test name.
#' @examples
#' \dontrun{
#' bdinfo <- BinaryDosage::getbdinfo(system.file("extdata", "gendata.bdose",
#' package = "GxEScanR"))
#' subdata <- readRDS(system.file("extdata", "subdata.rds", package = "GxEScanR"))
#' subdata <- subdata[complete.cases(subdata), ]
#' subdata <- subdata[subdata$subid %in% bdinfo$samples$sid, ]
#'
#' linearmodel <- glm(y_linear ~ x2 + x1, data = subdata)
#' linearmem <- gweis.mem(gemdl = linearmodel,
#' subids = subdata$subid,
#' tests = c("bg_ge", "bg_gxe", "bgxe", "joint"))
#' }
#' @export
gweis.mem <- function(gemdl, subids, tests, gomdl = NULL) {
x <- match(tests, c("bg_go", "bg_ge", "bg_gxe", "bgxe", "joint", "bg_eg", "bg_case", "bg_ctrl"))
if (all(is.na(x) == FALSE) == FALSE)
return (1)
mdls <- logical(8)
mdls[x] <- TRUE
if (mdls[1] == TRUE && is.null(gomdl))
stop("gomdl must be provided when \"bg_go\" is included in tests")
if (mdls[1] == TRUE)
gomdlmem <- lsReg::lsReg(gomdl, 1, "lrt")
else
gomdlmem <- NULL
if (mdls[2] == TRUE || mdls[4] == TRUE)
gemdlmem <- lsReg::lsReg(gemdl, 1, "lrt")
else
gemdlmem <- NULL
if (mdls[3] == TRUE || mdls[4] == TRUE|| mdls[5] == TRUE)
gxemdlmem <- lsReg::lsReg(gemdl, 2, "lrt")
else
gxemdlmem <- NULL
if (mdls[3] == TRUE)
gxe0mdlmem <- lsReg::lsReg(gemdl, 1, "lrt")
else
gxe0mdlmem <- NULL
f <- deparse(gemdl$formula)
f <- gsub("\"", "", f)
f <- unlist(strsplit(f, "~"))
f <- unlist(strsplit(f, "\\+"))
f2 <- paste(f[2:(length(f) -1)], collapse = "+")
formula <- paste(f[length(f)],
f2,
sep = "~")
evalues <- sort(unique(gemdl$model[,ncol(gemdl$model)]))
if (length(evalues) == 2) {
if (all(evalues == c(0, 1)) == TRUE)
family = binomial
else
family = gaussian
} else {
family = gaussian
}
if (mdls[6] == TRUE) {
emdl <- glm(formula = formula,
data = gemdl$data,
family = family)
egmdlmem <- lsReg::lsReg(emdl, 1, "lrt")
} else {
egmdlmem <- NULL
}
if (gemdl$family$family == "binomial") {
if (mdls[7] == TRUE) {
emdl <- glm(formula = formula,
data = gemdl$data[gemdl$model[,1] == 1,],
family = family)
casemdlmem <- lsReg::lsReg(emdl, 1, "lrt")
caseids <- subids[gemdl$model[,1] == 1]
} else {
casemdlmem <- NULL
caseids <- NULL
}
if (mdls[8] == TRUE) {
emdl <- glm(formula = formula,
data = gemdl$data[gemdl$model[,1] == 0,],
family = family)
ctrlmdlmem <- lsReg::lsReg(emdl, 1, "lrt")
ctrlids <- subids[gemdl$model[,1] == 0]
} else {
ctrlmdlmem <- NULL
ctrlids <- NULL
}
} else {
mdls[7] <- FALSE
mdls[8] <- FALSE
casemdlmem <- NULL
ctrlmdlmem <- NULL
caseids <- NULL
ctrlids <- NULL
}
return (list(tests = mdls,
subids = subids,
gomdlmem = gomdlmem,
gemdlmem = gemdlmem,
gxemdlmem = gxemdlmem,
gxe0mdlmem = gxe0mdlmem,
egmdlmem = egmdlmem,
caseids = caseids,
casemdlmem = casemdlmem,
ctrlids = ctrlids,
ctrlmdlmem = ctrlmdlmem))
}
#' Routine to run a GWEIS
#'
#' @param gweismem Models and memory allocated by gweis-mem to run the GWEIS.
#' @param bdinfo Information about a Binary Dosage file that contains the
#' genetic data to run the GWEIS
#' @param snps List of SNPs in the Binary Dosage file to perform the GWEIS on.
#' @param outfilename Name of the file to contain the output
#' @param maf Minimum minor allele frequency of SNPs needed to run test on.
#'
#' @return Called for its side effect of writing tab-delimited results to
#' \code{outfilename}. Returns \code{NULL} invisibly.
#' @examples
#' \dontrun{
#' bdinfo <- BinaryDosage::getbdinfo(system.file("extdata", "gendata.bdose",
#' package = "GxEScanR"))
#' subdata <- readRDS(system.file("extdata", "subdata.rds", package = "GxEScanR"))
#' subdata <- subdata[complete.cases(subdata), ]
#' subdata <- subdata[subdata$subid %in% bdinfo$samples$sid, ]
#'
#' linearmodel <- glm(y_linear ~ x2 + x1, data = subdata)
#' linearmem <- gweis.mem(gemdl = linearmodel,
#' subids = subdata$subid,
#' tests = c("bg_ge", "bgxe", "joint"))
#' outfile <- tempfile(fileext = ".txt")
#' rungweis(gweismem = linearmem, bdinfo = bdinfo,
#' snps = 1:nrow(bdinfo$snps), outfilename = outfile)
#' }
#' @export
rungweis <- function(gweismem, bdinfo, snps, outfilename, maf = 0.01) {
minaaf <- maf
maxaaf <- 1. - maf
xr <- matrix(0, length(gweismem$subids), 1)
xr2 <- matrix(0, nrow(xr), 2)
xrgxe <- matrix(0, nrow(xr), 1)
submatch <- match(gweismem$subids, bdinfo$samples$sid)
if (length(gweismem$caseids) > 0) {
casematch <- match(gweismem$caseids, bdinfo$samples$sid)
xrcase <- matrix(0, length(gweismem$caseids))
}
if (length(gweismem$ctrlids) > 0) {
ctrlmatch <- match(gweismem$ctrlids, bdinfo$samples$sid)
xrctrl <- matrix(0, length(gweismem$ctrlids))
}
statnames <- c("aaf", "aaf_case", "aaf_ctrl",
"bg_go", "bg_go_lrt",
"bg_ge", "bg_ge_lrt",
"bg_gxe", "bg_gxe_lrt",
"bgxe", "bgxe_lrt",
"joint_lrt",
"bg_eg", "bg_eg_lrt",
"bg_case", "bg_case_lrt",
"bg_ctrl", "bg_ctrl_lrt")
statsout <- c(TRUE, FALSE, FALSE, gweismem$tests[c(1,1,2,2,3,3,4,4,5,6,6,7,7,8,8)])
if (gweismem$tests[5] == TRUE) {
statsout[8] <- TRUE
statsout[10] <- TRUE
}
snpinfo <- paste("snpid", "chr", "loc", "ref", "alt", sep = '\t')
if (gweismem$tests[8] == TRUE)
statsout[2] <- TRUE
if (gweismem$tests[7] == TRUE)
statsout[3] <- TRUE
outline <- paste(statnames[statsout], collapse = "\t")
outfile <- file(outfilename, "w")
writeLines(paste(snpinfo, outline, sep = "\t"), outfile)
numsnps <- length(snps)
# if (numsnps > 10)
# numsnps <- 10
outvalues <- numeric(18)
for (i in 1:numsnps) {
g <- BinaryDosage::getsnp(bdinfo = bdinfo,
snp = snps[i])$dosage
xr[,1] <- g[submatch]
outvalues[1] <- mean(xr) / 2
if (outvalues[1] < minaaf | outvalues[1] > maxaaf) {
next
}
if (length(gweismem$gomdlmem) > 0) {
lsReg::addcovar(gweismem$gomdlmem, xr)
}
if (length(gweismem$gemdlmem) > 0) {
lsReg::addcovar(gweismem$gemdlmem, xr)
}
if (length(gweismem$gxemdlmem) > 0) {
xr2[,1] <- xr
xr2[,2] <- xr * gweismem$gxemdlmem$fitdata$xl[,ncol(gweismem$gxemdlmem$fitdata$xl)]
lsReg::addcovar(gweismem$gxemdlmem, xr2)
}
if (length(gweismem$gxe0mdlmem) > 0) {
xrgxe[,1] <- xr2[,2]
lsReg::addcovar(gweismem$gxe0mdlmem, xrgxe)
}
if (length(gweismem$egmdlmem) > 0) {
lsReg::addcovar(gweismem$egmdlmem, xr)
}
if (length(gweismem$casemdlmem) > 0) {
xrcase[,1] <- g[casematch]
outvalues[2] <- mean(xrcase) / 2
lsReg::addcovar(gweismem$casemdlmem, xrcase)
}
if (length(gweismem$ctrlmdlmem) > 0) {
xrctrl[,1] <- g[ctrlmatch]
outvalues[3] <- mean(xrctrl) / 2
lsReg::addcovar(gweismem$ctrlmdlmem, xrctrl)
}
if (gweismem$tests[1] == TRUE) {
outvalues[4] <- gweismem$gomdlmem$fitdata$betab[1]
outvalues[5] <- gweismem$gomdlmem$testvalue
}
if (gweismem$tests[2] == TRUE) {
outvalues[6] <- gweismem$gemdlmem$fitdata$betab[1]
outvalues[7] <- gweismem$gemdlmem$testvalue
}
if (gweismem$tests[3] == TRUE) {
outvalues[8] <- gweismem$gxemdlmem$fitdata$betab[1]
outvalues[9] <- 2*(gweismem$gxemdlmem$loglike[2] - gweismem$gxe0mdlmem$loglike[2])
}
if (gweismem$tests[4] == TRUE) {
outvalues[10] <- gweismem$gxemdlmem$fitdata$betab[2]
outvalues[11] <- 2*(gweismem$gxemdlmem$loglike[2] - gweismem$gemdlmem$loglike[2])
}
if (gweismem$tests[5] == TRUE) {
outvalues[8] <- gweismem$gxemdlmem$fitdata$betab[1]
outvalues[10] <- gweismem$gxemdlmem$fitdata$betab[2]
outvalues[12] <- gweismem$gxemdlmem$testvalue
}
if (gweismem$tests[6] == TRUE) {
if (gweismem$egmdlmem$fitdata$family == "gaussian")
outvalues[13] <- gweismem$egmdlmem$fitdata$bb[1]
else
outvalues[13] <- gweismem$egmdlmem$fitdata$betab[1]
outvalues[14] <- gweismem$egmdlmem$testvalue
}
if (gweismem$tests[7] == TRUE) {
if (gweismem$casemdlmem$fitdata$family == "gaussian")
outvalues[15] <- gweismem$casemdlmem$fitdata$bb[1]
else
outvalues[15] <- gweismem$casemdlmem$fitdata$betab[1]
outvalues[16] <- gweismem$casemdlmem$testvalue
}
if (gweismem$tests[8] == TRUE) {
if (gweismem$egmdlmem$fitdata$family == "gaussian")
outvalues[17] <- gweismem$ctrlmdlmem$fitdata$bb[1]
else
outvalues[17] <- gweismem$ctrlmdlmem$fitdata$betab[1]
outvalues[18] <- gweismem$ctrlmdlmem$testvalue
}
snpinfo <- paste(bdinfo$snps[snps[i], c(3,1,2,4,5)], collapse = "\t")
writeLines(paste(snpinfo, paste(outvalues[statsout],collapse = "\t"), sep = "\t"), outfile)
}
close(outfile)
}
Try the GxEScanR package in your browser
Any scripts or data that you put into this service are public.
GxEScanR documentation built on May 1, 2026, 5:07 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Defines functions rungweis gweis.mem
Documented in gweis.mem rungweis
#' @importFrom lsReg lsReg
#' @importFrom lsReg addcovar
#' @importFrom BinaryDosage getsnp
#' @importFrom stats binomial gaussian glm
NULL
#' Routine to allocate memory needed to perform a GWEIS.
#'
#' @param gemdl The results from glm for the gene-environment model. This model
#' contains the outcome and all covariates of interest with the last covariate
#' listed in the model being the covaraiate that the gene interaction is being
#' tested for.
#' @param subids A character vector of subject IDs that line up with the
#' data that was used in the models that are passed to this routine
#' @param tests The list of tests to perform. These can be any combination of
#' the following values "bg_go", "bg_ge", "bg_gxe", "bgxe", "joint", "bg_eg",
#' "bg_case", "bg_ctrl"
#' @param gomdl The results from glm for the gene-only model. This model
#' contains the outcome and all the covariates except the covariate that
#' the gene interaction is being tested for. Required (non-NULL) when
#' \code{"bg_go"} is included in \code{tests}; ignored otherwise.
#'
#' @return List containing allocated memory to perform the specified GWEIS.
#' This value is passed to the \code{rungweis} routine. Returns \code{1} if
#' any value in \code{tests} is not a recognised test name.
#' @examples
#' \dontrun{
#' bdinfo <- BinaryDosage::getbdinfo(system.file("extdata", "gendata.bdose",
#' package = "GxEScanR"))
#' subdata <- readRDS(system.file("extdata", "subdata.rds", package = "GxEScanR"))
#' subdata <- subdata[complete.cases(subdata), ]
#' subdata <- subdata[subdata$subid %in% bdinfo$samples$sid, ]
#'
#' linearmodel <- glm(y_linear ~ x2 + x1, data = subdata)
#' linearmem <- gweis.mem(gemdl = linearmodel,
#' subids = subdata$subid,
#' tests = c("bg_ge", "bg_gxe", "bgxe", "joint"))
#' }
#' @export
gweis.mem <- function(gemdl, subids, tests, gomdl = NULL) {
x <- match(tests, c("bg_go", "bg_ge", "bg_gxe", "bgxe", "joint", "bg_eg", "bg_case", "bg_ctrl"))
if (all(is.na(x) == FALSE) == FALSE)
return (1)
mdls <- logical(8)
mdls[x] <- TRUE
if (mdls[1] == TRUE && is.null(gomdl))
stop("gomdl must be provided when \"bg_go\" is included in tests")
if (mdls[1] == TRUE)
gomdlmem <- lsReg::lsReg(gomdl, 1, "lrt")
else
gomdlmem <- NULL
if (mdls[2] == TRUE || mdls[4] == TRUE)
gemdlmem <- lsReg::lsReg(gemdl, 1, "lrt")
else
gemdlmem <- NULL
if (mdls[3] == TRUE || mdls[4] == TRUE|| mdls[5] == TRUE)
gxemdlmem <- lsReg::lsReg(gemdl, 2, "lrt")
else
gxemdlmem <- NULL
if (mdls[3] == TRUE)
gxe0mdlmem <- lsReg::lsReg(gemdl, 1, "lrt")
else
gxe0mdlmem <- NULL
f <- deparse(gemdl$formula)
f <- gsub("\"", "", f)
f <- unlist(strsplit(f, "~"))
f <- unlist(strsplit(f, "\\+"))
f2 <- paste(f[2:(length(f) -1)], collapse = "+")
formula <- paste(f[length(f)],
f2,
sep = "~")
evalues <- sort(unique(gemdl$model[,ncol(gemdl$model)]))
if (length(evalues) == 2) {
if (all(evalues == c(0, 1)) == TRUE)
family = binomial
else
family = gaussian
} else {
family = gaussian
}
if (mdls[6] == TRUE) {
emdl <- glm(formula = formula,
data = gemdl$data,
family = family)
egmdlmem <- lsReg::lsReg(emdl, 1, "lrt")
} else {
egmdlmem <- NULL
}
if (gemdl$family$family == "binomial") {
if (mdls[7] == TRUE) {
emdl <- glm(formula = formula,
data = gemdl$data[gemdl$model[,1] == 1,],
family = family)
casemdlmem <- lsReg::lsReg(emdl, 1, "lrt")
caseids <- subids[gemdl$model[,1] == 1]
} else {
casemdlmem <- NULL
caseids <- NULL
}
if (mdls[8] == TRUE) {
emdl <- glm(formula = formula,
data = gemdl$data[gemdl$model[,1] == 0,],
family = family)
ctrlmdlmem <- lsReg::lsReg(emdl, 1, "lrt")
ctrlids <- subids[gemdl$model[,1] == 0]
} else {
ctrlmdlmem <- NULL
ctrlids <- NULL
}
} else {
mdls[7] <- FALSE
mdls[8] <- FALSE
casemdlmem <- NULL
ctrlmdlmem <- NULL
caseids <- NULL
ctrlids <- NULL
}
return (list(tests = mdls,
subids = subids,
gomdlmem = gomdlmem,
gemdlmem = gemdlmem,
gxemdlmem = gxemdlmem,
gxe0mdlmem = gxe0mdlmem,
egmdlmem = egmdlmem,
caseids = caseids,
casemdlmem = casemdlmem,
ctrlids = ctrlids,
ctrlmdlmem = ctrlmdlmem))
}
#' Routine to run a GWEIS
#'
#' @param gweismem Models and memory allocated by gweis-mem to run the GWEIS.
#' @param bdinfo Information about a Binary Dosage file that contains the
#' genetic data to run the GWEIS
#' @param snps List of SNPs in the Binary Dosage file to perform the GWEIS on.
#' @param outfilename Name of the file to contain the output
#' @param maf Minimum minor allele frequency of SNPs needed to run test on.
#'
#' @return Called for its side effect of writing tab-delimited results to
#' \code{outfilename}. Returns \code{NULL} invisibly.
#' @examples
#' \dontrun{
#' bdinfo <- BinaryDosage::getbdinfo(system.file("extdata", "gendata.bdose",
#' package = "GxEScanR"))
#' subdata <- readRDS(system.file("extdata", "subdata.rds", package = "GxEScanR"))
#' subdata <- subdata[complete.cases(subdata), ]
#' subdata <- subdata[subdata$subid %in% bdinfo$samples$sid, ]
#'
#' linearmodel <- glm(y_linear ~ x2 + x1, data = subdata)
#' linearmem <- gweis.mem(gemdl = linearmodel,
#' subids = subdata$subid,
#' tests = c("bg_ge", "bgxe", "joint"))
#' outfile <- tempfile(fileext = ".txt")
#' rungweis(gweismem = linearmem, bdinfo = bdinfo,
#' snps = 1:nrow(bdinfo$snps), outfilename = outfile)
#' }
#' @export
rungweis <- function(gweismem, bdinfo, snps, outfilename, maf = 0.01) {
minaaf <- maf
maxaaf <- 1. - maf
xr <- matrix(0, length(gweismem$subids), 1)
xr2 <- matrix(0, nrow(xr), 2)
xrgxe <- matrix(0, nrow(xr), 1)
submatch <- match(gweismem$subids, bdinfo$samples$sid)
if (length(gweismem$caseids) > 0) {
casematch <- match(gweismem$caseids, bdinfo$samples$sid)
xrcase <- matrix(0, length(gweismem$caseids))
}
if (length(gweismem$ctrlids) > 0) {
ctrlmatch <- match(gweismem$ctrlids, bdinfo$samples$sid)
xrctrl <- matrix(0, length(gweismem$ctrlids))
}
statnames <- c("aaf", "aaf_case", "aaf_ctrl",
"bg_go", "bg_go_lrt",
"bg_ge", "bg_ge_lrt",
"bg_gxe", "bg_gxe_lrt",
"bgxe", "bgxe_lrt",
"joint_lrt",
"bg_eg", "bg_eg_lrt",
"bg_case", "bg_case_lrt",
"bg_ctrl", "bg_ctrl_lrt")
statsout <- c(TRUE, FALSE, FALSE, gweismem$tests[c(1,1,2,2,3,3,4,4,5,6,6,7,7,8,8)])
if (gweismem$tests[5] == TRUE) {
statsout[8] <- TRUE
statsout[10] <- TRUE
}
snpinfo <- paste("snpid", "chr", "loc", "ref", "alt", sep = '\t')
if (gweismem$tests[8] == TRUE)
statsout[2] <- TRUE
if (gweismem$tests[7] == TRUE)
statsout[3] <- TRUE
outline <- paste(statnames[statsout], collapse = "\t")
outfile <- file(outfilename, "w")
writeLines(paste(snpinfo, outline, sep = "\t"), outfile)
numsnps <- length(snps)
# if (numsnps > 10)
# numsnps <- 10
outvalues <- numeric(18)
for (i in 1:numsnps) {
g <- BinaryDosage::getsnp(bdinfo = bdinfo,
snp = snps[i])$dosage
xr[,1] <- g[submatch]
outvalues[1] <- mean(xr) / 2
if (outvalues[1] < minaaf | outvalues[1] > maxaaf) {
next
}
if (length(gweismem$gomdlmem) > 0) {
lsReg::addcovar(gweismem$gomdlmem, xr)
}
if (length(gweismem$gemdlmem) > 0) {
lsReg::addcovar(gweismem$gemdlmem, xr)
}
if (length(gweismem$gxemdlmem) > 0) {
xr2[,1] <- xr
xr2[,2] <- xr * gweismem$gxemdlmem$fitdata$xl[,ncol(gweismem$gxemdlmem$fitdata$xl)]
lsReg::addcovar(gweismem$gxemdlmem, xr2)
}
if (length(gweismem$gxe0mdlmem) > 0) {
xrgxe[,1] <- xr2[,2]
lsReg::addcovar(gweismem$gxe0mdlmem, xrgxe)
}
if (length(gweismem$egmdlmem) > 0) {
lsReg::addcovar(gweismem$egmdlmem, xr)
}
if (length(gweismem$casemdlmem) > 0) {
xrcase[,1] <- g[casematch]
outvalues[2] <- mean(xrcase) / 2
lsReg::addcovar(gweismem$casemdlmem, xrcase)
}
if (length(gweismem$ctrlmdlmem) > 0) {
xrctrl[,1] <- g[ctrlmatch]
outvalues[3] <- mean(xrctrl) / 2
lsReg::addcovar(gweismem$ctrlmdlmem, xrctrl)
}
if (gweismem$tests[1] == TRUE) {
outvalues[4] <- gweismem$gomdlmem$fitdata$betab[1]
outvalues[5] <- gweismem$gomdlmem$testvalue
}
if (gweismem$tests[2] == TRUE) {
outvalues[6] <- gweismem$gemdlmem$fitdata$betab[1]
outvalues[7] <- gweismem$gemdlmem$testvalue
}
if (gweismem$tests[3] == TRUE) {
outvalues[8] <- gweismem$gxemdlmem$fitdata$betab[1]
outvalues[9] <- 2*(gweismem$gxemdlmem$loglike[2] - gweismem$gxe0mdlmem$loglike[2])
}
if (gweismem$tests[4] == TRUE) {
outvalues[10] <- gweismem$gxemdlmem$fitdata$betab[2]
outvalues[11] <- 2*(gweismem$gxemdlmem$loglike[2] - gweismem$gemdlmem$loglike[2])
}
if (gweismem$tests[5] == TRUE) {
outvalues[8] <- gweismem$gxemdlmem$fitdata$betab[1]
outvalues[10] <- gweismem$gxemdlmem$fitdata$betab[2]
outvalues[12] <- gweismem$gxemdlmem$testvalue
}
if (gweismem$tests[6] == TRUE) {
if (gweismem$egmdlmem$fitdata$family == "gaussian")
outvalues[13] <- gweismem$egmdlmem$fitdata$bb[1]
else
outvalues[13] <- gweismem$egmdlmem$fitdata$betab[1]
outvalues[14] <- gweismem$egmdlmem$testvalue
}
if (gweismem$tests[7] == TRUE) {
if (gweismem$casemdlmem$fitdata$family == "gaussian")
outvalues[15] <- gweismem$casemdlmem$fitdata$bb[1]
else
outvalues[15] <- gweismem$casemdlmem$fitdata$betab[1]
outvalues[16] <- gweismem$casemdlmem$testvalue
}
if (gweismem$tests[8] == TRUE) {
if (gweismem$egmdlmem$fitdata$family == "gaussian")
outvalues[17] <- gweismem$ctrlmdlmem$fitdata$bb[1]
else
outvalues[17] <- gweismem$ctrlmdlmem$fitdata$betab[1]
outvalues[18] <- gweismem$ctrlmdlmem$testvalue
}
snpinfo <- paste(bdinfo$snps[snps[i], c(3,1,2,4,5)], collapse = "\t")
writeLines(paste(snpinfo, paste(outvalues[statsout],collapse = "\t"), sep = "\t"), outfile)
}
close(outfile)
}
Try the GxEScanR package in your browser
Any scripts or data that you put into this service are public.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.