[Genabel-commits] r1758 - pkg/ProbABEL/checks/R-tests
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Jun 25 07:57:28 CEST 2014
Author: lckarssen
Date: 2014-06-25 07:57:28 +0200 (Wed, 25 Jun 2014)
New Revision: 1758
Modified:
pkg/ProbABEL/checks/R-tests/initial_checks.R
pkg/ProbABEL/checks/R-tests/run_models_in_R_pacox.R
pkg/ProbABEL/checks/R-tests/run_models_in_R_palinear.R
pkg/ProbABEL/checks/R-tests/run_models_in_R_palogist.R
Log:
Changed formatting of the output of the R test scripts of ProbABEL. Now each test is listed on a separate line with its own OK message.
Modified: pkg/ProbABEL/checks/R-tests/initial_checks.R
===================================================================
--- pkg/ProbABEL/checks/R-tests/initial_checks.R 2014-06-24 15:36:51 UTC (rev 1757)
+++ pkg/ProbABEL/checks/R-tests/initial_checks.R 2014-06-25 05:57:28 UTC (rev 1758)
@@ -11,6 +11,13 @@
## look for the variables freq and poly.
rsq.thresh <- 1e-16
+## A function that prints text with empty space following it. Used to
+## print what is tested (to be followed with an OK if all is OK).
+prnt <- function(string) {
+ cat(sprintf("%-50s", string))
+}
+
+
####
## load the data
####
@@ -28,7 +35,7 @@
idNames <- dose[, 1]
idNames <- sub("[0-9]+->", "", idNames)
dose[, 1] <- idNames
-cat("Dose: check consistency of names\t\t")
+prnt("Dose: check consistency of names")
stopifnot( all.equal(dose[, 1], pheno[, 1], tol) )
cat("OK\n")
@@ -39,7 +46,7 @@
idNames <- prob[, 1]
idNames <- sub("[0-9]+->", "", idNames)
prob[, 1] <- idNames
-cat("Prob: check consistency of names\t\t")
+prnt("Prob: check consistency of names")
stopifnot( all.equal(prob[, 1], pheno[, 1], tol) )
cat("OK\n")
@@ -50,7 +57,7 @@
indexHet <- indexHom + 1
doseFromProb[, i] <- prob[, indexHom] * 2 + prob[, indexHet]
}
-cat("Check consistency dose <-> prob gtdata\t\t")
+prnt("Check consistency dose <-> prob gtdata")
stopifnot( all.equal(dose[, 3:ncol(dose)],
as.data.frame(doseFromProb)[,3:ncol(doseFromProb)],
tol=tol )
Modified: pkg/ProbABEL/checks/R-tests/run_models_in_R_pacox.R
===================================================================
--- pkg/ProbABEL/checks/R-tests/run_models_in_R_pacox.R 2014-06-24 15:36:51 UTC (rev 1757)
+++ pkg/ProbABEL/checks/R-tests/run_models_in_R_pacox.R 2014-06-25 05:57:28 UTC (rev 1758)
@@ -25,7 +25,7 @@
####
## Run ProbABEL to get the output data we want to compare/verify
####
-cat("Running ProbABEL...\t\t\t\t")
+prnt("Running ProbABEL...")
tmp <- system(paste0("bash ", tests.path, "test_cox.sh 2> /dev/null"),
intern=TRUE)
cat("OK\n")
@@ -48,7 +48,7 @@
####
attach(pheno)
-cat("Comparing R output with ProbABEL output\t\t")
+cat("Comparing R output with ProbABEL output:\n")
source(paste0(srcdir, "run_model_coxph.R"))
@@ -57,48 +57,52 @@
model.fn <- "coxph( Surv(fupt_chd, chd) ~ sex + age + othercov + snp1 )"
## Additive model, dosages
+prnt(" additive (dosages)")
snpdose <- "dose[, i]"
dose.add.R <- run.model(model.fn.0, model.fn, snpdose)
colnames(dose.add.R) <- colsAdd
rownames(dose.add.R) <- NULL
stopifnot( all.equal(dose.add.PA, dose.add.R, tol=tol) )
-cat("additive ")
+cat("OK\n")
-
## Additive model, probabilities
+prnt(" additive (probabilities)")
snpprob <- "doseFromProb[, i]"
prob.add.R <- run.model(model.fn.0, model.fn, snpprob)
colnames(prob.add.R) <- colsAdd
rownames(prob.add.R) <- NULL
stopifnot( all.equal(prob.add.PA, prob.add.R, tol=tol) )
-cat("additive ")
+cat("OK\n")
## dominant model
+prnt(" dominant")
snpprob <- "prob[, indexHom] + prob[, indexHet]"
prob.dom.R <- run.model(model.fn.0, model.fn, snpprob)
colnames(prob.dom.R) <- colsDom
rownames(prob.dom.R) <- NULL
stopifnot( all.equal(prob.dom.PA, prob.dom.R, tol=tol) )
-cat("dominant ")
+cat("OK\n")
## recessive model
+prnt(" recessive")
snpprob <- "prob[, indexHom]"
prob.rec.R <- run.model(model.fn.0, model.fn, snpprob)
colnames(prob.rec.R) <- colsRec
rownames(prob.rec.R) <- NULL
stopifnot( all.equal(prob.rec.PA, prob.rec.R, tol=tol) )
-cat("recessive ")
+cat("OK\n")
## over-dominant model
+prnt(" overdominant")
snpprob <- "prob[, indexHet]"
prob.odom.R <- run.model(model.fn.0, model.fn, snpprob)
colnames(prob.odom.R) <- colsOdom
rownames(prob.odom.R) <- NULL
stopifnot( all.equal(prob.odom.PA, prob.odom.R, tol=tol) )
-cat("overdominant ")
+cat("OK\n")
-
## 2df model
+prnt(" 2df")
model.fn <-
"coxph( Surv(fupt_chd, chd) ~ sex + age + othercov + snp1 + snp2 )"
snpd1 <- "prob[, indexHet]"
@@ -107,6 +111,4 @@
colnames(prob.2df.R) <- cols2df
rownames(prob.2df.R) <- NULL
stopifnot( all.equal(prob.2df.PA, prob.2df.R, tol=tol) )
-cat("2df\n")
-
-cat("\t\t\t\t\t\tOK\n")
+cat("OK\n")
Modified: pkg/ProbABEL/checks/R-tests/run_models_in_R_palinear.R
===================================================================
--- pkg/ProbABEL/checks/R-tests/run_models_in_R_palinear.R 2014-06-24 15:36:51 UTC (rev 1757)
+++ pkg/ProbABEL/checks/R-tests/run_models_in_R_palinear.R 2014-06-25 05:57:28 UTC (rev 1758)
@@ -14,7 +14,7 @@
####
## Run ProbABEL to get the output data we want to compare/verify
####
-cat("Running ProbABEL...\t\t\t\t")
+prnt("Running ProbABEL...")
tmp <- system(paste0("bash ", tests.path, "test_qt.sh"),
intern=TRUE)
cat("OK\n")
@@ -51,7 +51,7 @@
####
attach(pheno)
-cat("Comparing R output with ProbABEL output\t\t")
+cat("Comparing R output with ProbABEL output:\n")
source(paste0(srcdir, "run_model_linear.R"))
@@ -59,47 +59,53 @@
model.fn <- "lm( height ~ sex + age + snp )"
## Additive model, dosages
+prnt(" additive (dosages)")
snpdose <- "dose[, i]"
dose.add.R <- run.model(model.fn.0, model.fn, snpdose)
colnames(dose.add.R) <- colsAdd
rownames(dose.add.R) <- NULL
stopifnot( all.equal(dose.add.PA, dose.add.R, tol=tol) )
-cat("additive ")
+cat("OK\n")
-
## Additive model, probabilities
+prnt(" additive (probabilities)")
snpprob <- "doseFromProb[, i]"
prob.add.R <- run.model(model.fn.0, model.fn, snpprob)
colnames(prob.add.R) <- colsAdd
rownames(prob.add.R) <- NULL
stopifnot( all.equal(prob.add.PA, prob.add.R, tol=tol) )
-cat("additive ")
+cat("OK\n")
## dominant model
+prnt(" dominant")
snpprob <- "prob[, indexHom] + prob[, indexHet]"
prob.dom.R <- run.model(model.fn.0, model.fn, snpprob)
colnames(prob.dom.R) <- colsDom
rownames(prob.dom.R) <- NULL
stopifnot( all.equal(prob.dom.PA, prob.dom.R, tol=tol) )
-cat("dominant ")
+cat("OK\n")
## recessive model
+prnt(" recessive")
snpprob <- "prob[, indexHom]"
prob.rec.R <- run.model(model.fn.0, model.fn, snpprob)
colnames(prob.rec.R) <- colsRec
rownames(prob.rec.R) <- NULL
stopifnot( all.equal(prob.rec.PA, prob.rec.R, tol=tol) )
-cat("recessive ")
+#print("OK", justify="right")
+cat("OK\n")
## over-dominant model
+prnt(" overdominant")
snpprob <- "prob[, indexHet]"
prob.odom.R <- run.model(model.fn.0, model.fn, snpprob)
colnames(prob.odom.R) <- colsOdom
rownames(prob.odom.R) <- NULL
stopifnot( all.equal(prob.odom.PA, prob.odom.R, tol=tol) )
-cat("overdominant ")
+cat("OK\n")
## 2df model
+prnt(" 2df")
prob.2df.R <- data.frame()
for (i in 3:dim(dose)[2]) {
indexHom <- 3 + ( i - 3 ) * 2
@@ -132,6 +138,4 @@
colnames(prob.2df.R) <- cols2df
rownames(prob.2df.R) <- NULL
stopifnot( all.equal(prob.2df.PA, prob.2df.R, tol=tol) )
-cat("2df\n")
-
-cat("\t\t\t\t\t\tOK\n")
+cat("OK\n")
Modified: pkg/ProbABEL/checks/R-tests/run_models_in_R_palogist.R
===================================================================
--- pkg/ProbABEL/checks/R-tests/run_models_in_R_palogist.R 2014-06-24 15:36:51 UTC (rev 1757)
+++ pkg/ProbABEL/checks/R-tests/run_models_in_R_palogist.R 2014-06-25 05:57:28 UTC (rev 1758)
@@ -14,7 +14,7 @@
####
## Run ProbABEL to get the output data we want to compare/verify
####
-cat("Running ProbABEL...\t\t\t\t")
+prnt("Running ProbABEL...")
tmp <- system(paste0("bash ", tests.path, "test_bt.sh"),
intern=TRUE)
cat("OK\n")
@@ -41,7 +41,7 @@
####
attach(pheno)
-cat("Comparing R output with ProbABEL output\t\t")
+cat("Comparing R output with ProbABEL output\n")
source(paste0(srcdir, "run_model_logist.R"))
@@ -50,47 +50,52 @@
model.fn <- "glm( chd ~ sex + age + othercov + snp, family=binomial )"
## Additive model, dosages
+prnt(" additive (dosages)")
snpdose <- "dose[, i]"
dose.add.R <- run.model(model.fn.0, model.fn, snpdose)
colnames(dose.add.R) <- colsAdd
rownames(dose.add.R) <- NULL
stopifnot( all.equal(dose.add.PA, dose.add.R, tol=tol) )
-cat("additive ")
+cat("OK\n")
## Additive model, probabilities
+prnt(" additive (probabilities)")
snpprob <- "doseFromProb[, i]"
prob.add.R <- run.model(model.fn.0, model.fn, snpprob)
colnames(prob.add.R) <- colsAdd
rownames(prob.add.R) <- NULL
stopifnot( all.equal(prob.add.PA, prob.add.R, tol=tol) )
-cat("additive ")
+cat("OK\n")
## dominant model
+prnt(" dominant")
snpprob <- "prob[, indexHom] + prob[, indexHet]"
prob.dom.R <- run.model(model.fn.0, model.fn, snpprob)
colnames(prob.dom.R) <- colsDom
rownames(prob.dom.R) <- NULL
stopifnot( all.equal(prob.dom.PA, prob.dom.R, tol=tol) )
-cat("dominant ")
+cat("OK\n")
## recessive model
+prnt(" recessive")
snpprob <- "prob[, indexHom]"
prob.rec.R <- run.model(model.fn.0, model.fn, snpprob)
colnames(prob.rec.R) <- colsRec
rownames(prob.rec.R) <- NULL
stopifnot( all.equal(prob.rec.PA, prob.rec.R, tol=tol) )
-cat("recessive ")
+cat("OK\n")
## over-dominant model
+prnt(" overdominant")
snpprob <- "prob[, indexHet]"
prob.odom.R <- run.model(model.fn.0, model.fn, snpprob)
colnames(prob.odom.R) <- colsOdom
rownames(prob.odom.R) <- NULL
stopifnot( all.equal(prob.odom.PA, prob.odom.R, tol=tol) )
-cat("overdominant ")
+cat("OK\n")
-
## 2df model
+prnt(" 2df")
prob.2df.R <- data.frame()
for (i in 3:dim(dose)[2]) {
indexHom <- 3 + ( i - 3 ) * 2
@@ -124,6 +129,4 @@
colnames(prob.2df.R) <- cols2df
rownames(prob.2df.R) <- NULL
stopifnot( all.equal(prob.2df.PA, prob.2df.R, tol=tol) )
-cat("2df\n")
-
-cat("\t\t\t\t\t\tOK\n")
+cat("OK\n")
More information about the Genabel-commits
mailing list