[Genabel-commits] r1085 - in pkg/GenABEL: . R inst/unitTests man

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Wed Jan 9 20:39:12 CET 2013


Author: yurii
Date: 2013-01-09 20:39:11 +0100 (Wed, 09 Jan 2013)
New Revision: 1085

Modified:
   pkg/GenABEL/CHANGES.LOG
   pkg/GenABEL/DESCRIPTION
   pkg/GenABEL/R/GC.R
   pkg/GenABEL/R/GC_ovdom.R
   pkg/GenABEL/R/GenABEL.R
   pkg/GenABEL/R/PGC.R
   pkg/GenABEL/R/ccfast.R
   pkg/GenABEL/R/ccfast.new.R
   pkg/GenABEL/R/check.trait.R
   pkg/GenABEL/R/egscore.R
   pkg/GenABEL/R/egscore.old.R
   pkg/GenABEL/R/formetascore.R
   pkg/GenABEL/R/grammar.R
   pkg/GenABEL/R/load.gwaa.data.R
   pkg/GenABEL/R/polygenic.R
   pkg/GenABEL/R/qtscore.R
   pkg/GenABEL/R/rntransform.R
   pkg/GenABEL/R/scan.haplo.2D.R
   pkg/GenABEL/R/scan.haplo.R
   pkg/GenABEL/R/ztransform.R
   pkg/GenABEL/R/zzz.R
   pkg/GenABEL/inst/unitTests/report.html
   pkg/GenABEL/inst/unitTests/report.txt
   pkg/GenABEL/inst/unitTests/reportSummary.txt
   pkg/GenABEL/man/GC.Rd
   pkg/GenABEL/man/GC_ovdom.Rd
   pkg/GenABEL/man/GenABEL.Rd
   pkg/GenABEL/man/PGC.Rd
   pkg/GenABEL/man/Xfix.Rd
   pkg/GenABEL/man/check.marker.Rd
   pkg/GenABEL/man/grammar.Rd
   pkg/GenABEL/man/srdta.Rd
   pkg/GenABEL/man/ztransform.Rd
Log:
multiple changes related to changes in R and CRAN html layout

Modified: pkg/GenABEL/CHANGES.LOG
===================================================================
--- pkg/GenABEL/CHANGES.LOG	2013-01-08 20:54:14 UTC (rev 1084)
+++ pkg/GenABEL/CHANGES.LOG	2013-01-09 19:39:11 UTC (rev 1085)
@@ -1,5 +1,10 @@
-***  v. 1.7-3 (2013.01.07)
+***  v. 1.7-3 (2013.01.09)
 
+(2013.01.09)
+Commented the parts related to non-additive GC in qtscore
+Removed calls to 'attach' from multiple procedures
+Decrease of running time for long-running examples (GC_ovdom,GC,check.marker,Xfix,srdta)
+
 (2013.01.07)
 Fixing the problem which prevents the package from loading while checking the version on CRAN
 

Modified: pkg/GenABEL/DESCRIPTION
===================================================================
--- pkg/GenABEL/DESCRIPTION	2013-01-08 20:54:14 UTC (rev 1084)
+++ pkg/GenABEL/DESCRIPTION	2013-01-09 19:39:11 UTC (rev 1085)
@@ -2,7 +2,7 @@
 Type: Package
 Title: genome-wide SNP association analysis
 Version: 1.7-3
-Date: 2013-01-07
+Date: 2013-01-09
 Author: GenABEL project developers
 Contact: GenABEL project developers <genabel.project at gmail.com>
 Maintainer: Yurii Aulchenko <yurii at bionet.nsc.ru>

Modified: pkg/GenABEL/R/GC.R
===================================================================
--- pkg/GenABEL/R/GC.R	2013-01-08 20:54:14 UTC (rev 1084)
+++ pkg/GenABEL/R/GC.R	2013-01-09 19:39:11 UTC (rev 1085)
@@ -33,11 +33,13 @@
 #' 
 #' @examples
 #' data(ge03d2)
-#' qts=mlreg(phdata(ge03d2)$dm2~1,data=ge03d2,gtmode = "dominant")
-#' chi2.1df=results(qts)$chi2.1df
-#' s=summary(ge03d2)
-#' freq=s$Q.2
-#' result=GC(p=freq,x=1,method = "median",CA=FALSE,data=chi2.1df,n=nids(ge03d2))
+#' # truncate the data to make the example faster
+#' ge03d2 <- ge03d2[seq(from=1,to=nids(ge03d2),by=2),seq(from=1,to=nsnps(ge03d2),by=3)]
+#' qts <- mlreg(dm2~sex,data=ge03d2,gtmode = "dominant")
+#' chi2.1df <- results(qts)$chi2.1df
+#' s <- summary(ge03d2)
+#' freq <- s$Q.2
+#' result <- GC(p=freq,x=1,method = "median",CA=FALSE,data=chi2.1df,n=nids(ge03d2))
 #' 
 #' @keywords htest
 #'

Modified: pkg/GenABEL/R/GC_ovdom.R
===================================================================
--- pkg/GenABEL/R/GC_ovdom.R	2013-01-08 20:54:14 UTC (rev 1084)
+++ pkg/GenABEL/R/GC_ovdom.R	2013-01-09 19:39:11 UTC (rev 1085)
@@ -30,11 +30,13 @@
 #' 
 #' @examples
 #' data(ge03d2)
-#' qts=mlreg(phdata(ge03d2)$dm2~1,data=ge03d2,gtmode = "overdominant")
-#' chi2.1df=results(qts)$chi2.1df
-#' s=summary(ge03d2)
-#' freq=s$Q.2
-#' result=GC_ovdom(p=freq,method = "median",data=chi2.1df,n=nids(ge03d2))
+#' # truncate the data to make the example faster
+#' ge03d2 <- ge03d2[seq(from=1,to=nids(ge03d2),by=2),seq(from=1,to=nsnps(ge03d2),by=3)]
+#' qts <- mlreg(phdata(ge03d2)$dm2~1,data=ge03d2,gtmode = "overdominant")
+#' chi2.1df <- results(qts)$chi2.1df
+#' s <- summary(ge03d2)
+#' freq <- s$Q.2
+#' result <- GC_ovdom(p=freq,method = "median",data=chi2.1df,n=nids(ge03d2))
 #' 
 #' @keywords htest
 #'

Modified: pkg/GenABEL/R/GenABEL.R
===================================================================
--- pkg/GenABEL/R/GenABEL.R	2013-01-08 20:54:14 UTC (rev 1084)
+++ pkg/GenABEL/R/GenABEL.R	2013-01-09 19:39:11 UTC (rev 1085)
@@ -158,15 +158,25 @@
 #' 46, 399-413.
 #' 
 #' If you used environmental residuals from \code{\link{polygenic}} for 
-#' \code{\link{qtscore}}, used GRAMMAR and/or GRAMMAS analysis, please cite
+#' \code{\link{qtscore}}, or used \code{\link{grammar}}, please cite
 #' 
+#' for original GRAMMAR
+#' 
 #' Aulchenko YS, de Koning DJ, Haley C. Genomewide rapid association using mixed model 
 #' and regression: a fast and simple method for genome-wide pedigree-based quantitative 
 #' trait loci association analysis. Genetics. 2007 177(1):577-85.
 #' 
+#' for GRAMMAR-GC
+#' 
 #' Amin N, van Duijn CM, Aulchenko YS. A genomic background based method for 
-#' association analysis in related individuals. PLoS ONE. 2007 Dec 5;2(12):e1274. 
+#' association analysis in related individuals. PLoS ONE. 2007 Dec 5;2(12):e1274.
 #' 
+#' for GRAMMAR-Gamma
+#' 
+#' Svischeva G, Axenovich TI, Belonogova NM, van Duijn CM, Aulchenko YS. Rapid 
+#' variance components-based method for whole-genome association analysis. 
+#' Nature Genetics. 2012 44:1166-1170. doi:10.1038/ng.2410 
+#' 
 #' If you used \code{\link{mmscore}}, please cite
 #' 
 #' Chen WM, Abecasis GR. Family-based association tests for genome-wide association 

Modified: pkg/GenABEL/R/PGC.R
===================================================================
--- pkg/GenABEL/R/PGC.R	2013-01-08 20:54:14 UTC (rev 1084)
+++ pkg/GenABEL/R/PGC.R	2013-01-09 19:39:11 UTC (rev 1085)
@@ -27,7 +27,7 @@
 #' 
 #' @examples
 #' data(ge03d2)
-#' qts=qtscore(phdata(ge03d2)$dm2, ge03d2)
+#' qts=qtscore(dm2, ge03d2)
 #' chi2.1df=results(qts)$chi2.1df
 #' s=summary(ge03d2)
 #' MAF=s$Q.2

Modified: pkg/GenABEL/R/ccfast.R
===================================================================
--- pkg/GenABEL/R/ccfast.R	2013-01-08 20:54:14 UTC (rev 1084)
+++ pkg/GenABEL/R/ccfast.R	2013-01-09 19:39:11 UTC (rev 1085)
@@ -8,9 +8,10 @@
 		if (!quiet) cat("X-chromosome data dropped\n")
 	}
 
-	attach(data at phdata,warn.conflicts=FALSE,pos=2)
-	cc <- get(y,pos=2)
-	detach(data at phdata)
+#	attach(data at phdata,warn.conflicts=FALSE,pos=2)
+#	cc <- get(y,pos=2)
+#	detach(data at phdata)
+	cc <- phdata(data)[[y]]
 
         if (length(levels(as.factor(cc)))<2) stop("cc status is monomorphic!") 
         if (length(levels(as.factor(cc)))>2) stop("cc status has more then 2 levels!") 

Modified: pkg/GenABEL/R/ccfast.new.R
===================================================================
--- pkg/GenABEL/R/ccfast.new.R	2013-01-08 20:54:14 UTC (rev 1084)
+++ pkg/GenABEL/R/ccfast.new.R	2013-01-09 19:39:11 UTC (rev 1085)
@@ -8,9 +8,10 @@
 		if (!quiet) cat("X-chromosome data dropped\n")
 	}
 
-	attach(data at phdata,warn.conflicts=FALSE,pos=2)
-	cc <- get(y,pos=2)
-	detach(data at phdata)
+#	attach(data at phdata,warn.conflicts=FALSE,pos=2)
+#	cc <- get(y,pos=2)
+#	detach(data at phdata)
+	cc <- phdata(data)[[y]]
 
         if (length(levels(as.factor(cc)))<2) stop("cc status is monomorphic!") 
         if (length(levels(as.factor(cc)))>2) stop("cc status has more then 2 levels!") 

Modified: pkg/GenABEL/R/check.trait.R
===================================================================
--- pkg/GenABEL/R/check.trait.R	2013-01-08 20:54:14 UTC (rev 1084)
+++ pkg/GenABEL/R/check.trait.R	2013-01-09 19:39:11 UTC (rev 1085)
@@ -3,7 +3,8 @@
   if (!is.data.frame(data)) {
     if (is(data,"gwaa.data")) data <- data at phdata else stop("data should be a data frame or gwaa.data")
   } 
-  attach(data,warn.conflicts=FALSE)
+#  attach(data,warn.conflicts=FALSE)
+	with(data, {
   rmvec <- rep(TRUE,length(trait))
   for (i in 1:length(trait)) 
     if (!is.numeric(get(trait[i]))) {
@@ -70,6 +71,7 @@
 	}
 	par(spar)
   }
-  detach(data)
+  })
+#  detach(data)
 }
 

Modified: pkg/GenABEL/R/egscore.R
===================================================================
--- pkg/GenABEL/R/egscore.R	2013-01-08 20:54:14 UTC (rev 1084)
+++ pkg/GenABEL/R/egscore.R	2013-01-09 19:39:11 UTC (rev 1085)
@@ -13,7 +13,11 @@
 	if (length(strata)!=data at gtdata@nids) stop("Strata variable and the data do not match in length")
 	if (any(is.na(strata))) stop("Strata variable contains NAs")
 
-	if (!missing(data)) attach(data at phdata,pos=2,warn.conflicts=FALSE)
+	if ( is(try(formula,silent=TRUE),"try-error") ) { 
+		formula <- phdata(data)[[as(match.call()[["formula"]],"character")]] 
+	}
+	
+#	if (!missing(data)) attach(data at phdata,pos=2,warn.conflicts=FALSE)
 	if (is(formula,"formula")) {
 		mf <- model.frame(formula,data,na.action=na.omit,drop.unused.levels=TRUE)
 		y <- model.response(mf)
@@ -30,7 +34,7 @@
 	} else {
 		stop("formula argument must be a formula or one of (numeric, integer, double)")
 	}
-	if (!missing(data)) detach(data at phdata)
+#	if (!missing(data)) detach(data at phdata)
 	if (length(strata)!=data at gtdata@nids) stop("Strata variable and the data do not match in length")
 	if (any(is.na(strata))) stop("Strata variable contains NAs")
 	if (any(strata!=0)) {

Modified: pkg/GenABEL/R/egscore.old.R
===================================================================
--- pkg/GenABEL/R/egscore.old.R	2013-01-08 20:54:14 UTC (rev 1084)
+++ pkg/GenABEL/R/egscore.old.R	2013-01-09 19:39:11 UTC (rev 1085)
@@ -12,7 +12,11 @@
 	if (length(strata)!=data at gtdata@nids) stop("Strata variable and the data do not match in length")
 	if (any(is.na(strata))) stop("Strata variable contains NAs")
 
-	if (!missing(data)) attach(data at phdata,pos=2,warn.conflicts=FALSE)
+	if ( is(try(formula,silent=TRUE),"try-error") ) { 
+		formula <- phdata(data)[[as(match.call()[["formula"]],"character")]] 
+	}
+	
+#	if (!missing(data)) attach(data at phdata,pos=2,warn.conflicts=FALSE)
 	if (is(formula,"formula")) {
 		mf <- model.frame(formula,data,na.action=na.omit,drop.unused.levels=TRUE)
 		y <- model.response(mf)
@@ -29,7 +33,7 @@
 	} else {
 		stop("formula argument must be a formula or one of (numeric, integer, double)")
 	}
-	if (!missing(data)) detach(data at phdata)
+#	if (!missing(data)) detach(data at phdata)
 	if (length(strata)!=data at gtdata@nids) stop("Strata variable and the data do not match in length")
 	if (any(is.na(strata))) stop("Strata variable contains NAs")
 	if (any(strata!=0)) {

Modified: pkg/GenABEL/R/formetascore.R
===================================================================
--- pkg/GenABEL/R/formetascore.R	2013-01-08 20:54:14 UTC (rev 1084)
+++ pkg/GenABEL/R/formetascore.R	2013-01-09 19:39:11 UTC (rev 1085)
@@ -2,7 +2,12 @@
 		function(formula,data,stat=qtscore,transform="no",build="unknown",verbosity=1, ...) {
 	if (!is(data,"gwaa.data")) stop("data argument must have gwaa.data-class")
 	checkphengen(data)
-	if (!missing(data)) attach(data at phdata,pos=2,warn.conflicts=FALSE)
+	
+	if ( is(try(formula,silent=TRUE),"try-error") ) { 
+		formula <- phdata(data)[[as(match.call()[["formula"]],"character")]] 
+	}
+	
+	#	if (!missing(data)) attach(data at phdata,pos=2,warn.conflicts=FALSE)
 	if (is(formula,"polygenic")) {
 		pm <- pmatch("stat",names(match.call()))
 		pm <- (pm[!is.na(pm)])[1]
@@ -24,7 +29,7 @@
 	} else {
 		mids <- which(!is.na(formula))
 	}
-	if (!missing(data)) detach(data at phdata)
+#	if (!missing(data)) detach(data at phdata)
 	if (verbosity<0) stop("verbosity parameter must be positive integer")
 	res <- stat(formula,data,...)
 	sum <- summary(data at gtdata[mids,])

Modified: pkg/GenABEL/R/grammar.R
===================================================================
--- pkg/GenABEL/R/grammar.R	2013-01-08 20:54:14 UTC (rev 1084)
+++ pkg/GenABEL/R/grammar.R	2013-01-09 19:39:11 UTC (rev 1085)
@@ -33,18 +33,21 @@
 #' 
 #' @references 
 #' 
-#' GRAMMAR-Raw: Aulchenko YS, de Koning DJ, Haley C. 
+#' GRAMMAR-Raw: 
+#' Aulchenko YS, de Koning DJ, Haley C. 
 #' Genomewide rapid association using mixed model and regression: a fast and 
 #' simple method for genomewide pedigree-based quantitative trait loci 
 #' association analysis. Genetics. 2007 Sep;177(1):577-85.
 #' 
-#' GRAMMAR-GC: Amin N, van Duijn CM, Aulchenko YS. 
+#' GRAMMAR-GC: 
+#' Amin N, van Duijn CM, Aulchenko YS. 
 #' A genomic background based method for association analysis in related individuals.
 #' PLoS One. 2007 Dec 5;2(12):e1274.
 #' 
-#' GRAMMAR-Gamma: Svisheva GR, Axenovich TI, Belonogova MN, van Duijn CM, Aulchenko YS. 
-#' Rapid variance componentsÐbased method for whole-genome association analysis. 
-#' Nature Genetics. 2012 (http://dx.doi.org/10.1038/ng.2410)
+#' GRAMMAR-Gamma: 
+#' Svischeva G, Axenovich TI, Belonogova NM, van Duijn CM, Aulchenko YS. 
+#' Rapid variance components-based method for whole-genome association analysis. 
+#' Nature Genetics. 2012 44:1166-1170. doi:10.1038/ng.2410 
 #' 
 #' @examples 
 #' # Using clean ge03d2 data 

Modified: pkg/GenABEL/R/load.gwaa.data.R
===================================================================
--- pkg/GenABEL/R/load.gwaa.data.R	2013-01-08 20:54:14 UTC (rev 1084)
+++ pkg/GenABEL/R/load.gwaa.data.R	2013-01-09 19:39:11 UTC (rev 1085)
@@ -12,7 +12,7 @@
 		stop("the column named \"sex\", containing the male identifier was not found in the phenofile")
 #### 2.8.0!
 	v <- version
-	if ((as.numeric(v$major) >= 2) && (as.numeric(v$minor) >= 8.0)) {
+	if ( as.numeric(v$major) > 2 || ((as.numeric(v$major) == 2) && (as.numeric(v$minor) >= 8.0)) ) {
 		a <- table(dta$sex,useNA="ifany")
 	} else {
 		a <- table(dta$sex,exclude=NULL)

Modified: pkg/GenABEL/R/polygenic.R
===================================================================
--- pkg/GenABEL/R/polygenic.R	2013-01-08 20:54:14 UTC (rev 1084)
+++ pkg/GenABEL/R/polygenic.R	2013-01-09 19:39:11 UTC (rev 1085)
@@ -201,8 +201,12 @@
 	else if (llfun == "polylik") llFUN <- polylik
 	else stop("llfun should be 'polylik' or 'polylik_eigen'")
 	
-	if (!missing(data)) attach(data,pos=2,warn.conflicts=FALSE)
+	if ( is(try(formula,silent=TRUE),"try-error") ) { 
+		formula <- data[[as(match.call()[["formula"]],"character")]] 
+	}
 	
+#	if (!missing(data)) attach(data,pos=2,warn.conflicts=FALSE)
+	
 # beging patch bug #1322 (by Nicola Pirastu)
 	if (is(formula, "formula")){
 		mf <- model.frame(formula, data, na.action = na.omit, 
@@ -281,7 +285,7 @@
 		}
 	}
 	
-	if (!missing(data)) detach(data)
+#	if (!missing(data)) detach(data)
 	tmp <- t(relmat)
 	relmat[upper.tri(relmat)] <- tmp[upper.tri(tmp)]
 	rm(tmp);gc()

Modified: pkg/GenABEL/R/qtscore.R
===================================================================
--- pkg/GenABEL/R/qtscore.R	2013-01-08 20:54:14 UTC (rev 1084)
+++ pkg/GenABEL/R/qtscore.R	2013-01-09 19:39:11 UTC (rev 1085)
@@ -102,8 +102,13 @@
 		out <- paste("trait.type argument should be one of",ttargs,"\n")
 		stop(out)
 	}
+
+	if ( is(try(formula,silent=TRUE),"try-error") ) { 
+		formula <- phdata(data)[[as(match.call()[["formula"]],"character")]] 
+	}
+	
 	if (trait.type=="guess") {
-		if (!missing(data)) attach(data at phdata,pos=2,warn.conflicts=FALSE)
+#		if (!missing(data)) attach(data at phdata,pos=2,warn.conflicts=FALSE)
 		if (is(formula,"formula")) {
 			mf <- model.frame(formula,data,na.action=na.omit,drop.unused.levels=TRUE)
 			y <- model.response(mf)
@@ -115,12 +120,12 @@
 			stop("formula argument must be a formula or one of (numeric, integer, double)")
 		}
 		warning(paste("trait type is guessed as",trait.type))
-		if (!missing(data)) detach(data at phdata)
+#		if (!missing(data)) detach(data at phdata)
 	}
 	if (trait.type=="gaussian") fam <- gaussian()
 	if (trait.type=="binomial") fam <- binomial()
 	
-	if (!missing(data)) attach(data at phdata,pos=2,warn.conflicts=FALSE)
+#	if (!missing(data)) attach(data at phdata,pos=2,warn.conflicts=FALSE)
 	if (is(formula,"formula")) {
 		mf <- model.frame(formula,data,na.action=na.omit,drop.unused.levels=TRUE)
 		y <- model.response(mf)
@@ -146,7 +151,7 @@
 	} else {
 		stop("formula argument should be a formula or a numeric vector")
 	}
-	if (!missing(data)) detach(data at phdata)
+#	if (!missing(data)) detach(data at phdata)
 	if (length(strata)!=nids(data)) stop("Strata variable and the data do not match in length")
 	if (any(is.na(strata))) stop("Strata variable contains NAs")
 	if (any(strata!=0)) {
@@ -235,16 +240,16 @@
 			actdf[abs(actdf+999.99)<1.e-8] <- 1.e-16 #NA
 #			out$actdf <- actdf
 			###out$chi2.2df <- chi2.2df
-			z0 <- chi2[(7*lenn+1):(8*lenn)];
-			z0[abs(z0+999.99)<1.e-8] <- 0 #NA
-#			out$z0 <- z0
-			z2 <- chi2[(8*lenn+1):(9*lenn)];
-			z2[abs(z2+999.99)<1.e-8] <- 0 #NA
-#			out$z2 <- z2
-			rho <- chi2[(9*lenn+1):(10*lenn)];
-			rho[abs(rho+999.99)<1.e-8] <- 0 #NA
-#			rho <- abs(rho)
-#			out$rho <- rho
+#			z0 <- chi2[(7*lenn+1):(8*lenn)];
+#			z0[abs(z0+999.99)<1.e-8] <- 0 #NA
+##			out$z0 <- z0
+#			z2 <- chi2[(8*lenn+1):(9*lenn)];
+#			z2[abs(z2+999.99)<1.e-8] <- 0 #NA
+##			out$z2 <- z2
+#			rho <- chi2[(9*lenn+1):(10*lenn)];
+#			rho[abs(rho+999.99)<1.e-8] <- 0 #NA
+##			rho <- abs(rho)
+##			out$rho <- rho
 			
 			lambda <- list()
 			if (is.logical(clambda)) {
@@ -276,21 +281,21 @@
 			}
 			chi2.c1df <- chi2.1df/lambda$estimate
 			
-			if (is.logical(clambda)) {
-				lambda$iz0 <- estlambda(z0*z0,plot=FALSE,proportion=propPs)$estimate 
-				lambda$iz2 <- estlambda(z2*z2,plot=FALSE,proportion=propPs)$estimate
-				if (clambda && lambda$iz0<1.0) {warning("z0 lambda < 1, set to 1");lambda$iz0<-1.0}
-				if (clambda && lambda$iz2<1.0) {warning("z2 lambda < 1, set to 1");lambda$iz2<-1.0}
-				chi2.c2df <- (z0*z0/lambda$iz0 + z2*z2/lambda$iz2 - 2.*z0*z2*rho/(sqrt(lambda$iz0*lambda$iz2)))/(1.- rho*rho)
-			} else {
-				if (is.list(clambda) && !any(is.na(match(c("estimate","iz0","iz2"),names(clambda))))) {
-					chi2.c2df <- (z0*z0/lambda$iz0 + z2*z2/lambda$iz2 - 2.*z0*z2*rho/(sqrt(lambda$iz0*lambda$iz2)))/(1.- rho*rho)
-				} else {
-					lambda$iz0 <- 1.0
-					lambda$iz2 <- 1.0
-					chi2.c2df <- chi2.2df
-				}
-			}
+#			if (is.logical(clambda)) {
+#				lambda$iz0 <- estlambda(z0*z0,plot=FALSE,proportion=propPs)$estimate 
+#				lambda$iz2 <- estlambda(z2*z2,plot=FALSE,proportion=propPs)$estimate
+#				if (clambda && lambda$iz0<1.0) {warning("z0 lambda < 1, set to 1");lambda$iz0<-1.0}
+#				if (clambda && lambda$iz2<1.0) {warning("z2 lambda < 1, set to 1");lambda$iz2<-1.0}
+#				chi2.c2df <- (z0*z0/lambda$iz0 + z2*z2/lambda$iz2 - 2.*z0*z2*rho/(sqrt(lambda$iz0*lambda$iz2)))/(1.- rho*rho)
+#			} else {
+#				if (is.list(clambda) && !any(is.na(match(c("estimate","iz0","iz2"),names(clambda))))) {
+#					chi2.c2df <- (z0*z0/lambda$iz0 + z2*z2/lambda$iz2 - 2.*z0*z2*rho/(sqrt(lambda$iz0*lambda$iz2)))/(1.- rho*rho)
+#				} else {
+#					lambda$iz0 <- 1.0
+#					lambda$iz2 <- 1.0
+#					chi2.c2df <- chi2.2df
+#				}
+#			}
 			effB <- chi2[(3*lenn+1):(lenn*4)]
 			effB[abs(effB+999.99)<1.e-8] <- NA
 			effAB <- chi2[(4*lenn+1):(lenn*5)]
@@ -308,7 +313,7 @@
 			pr.1df <- pr.1df + 1*(chi2.1df < th1)
 			pr.2df <- pr.2df + 1*(chi2.2df < max(chi2[(lenn+1):(2*lenn)]))
 			pr.c1df <- pr.c1df + 1*(chi2.c1df < th1)
-			pr.c2df <- pr.c2df + 1*(chi2.c2df < th1)
+#			pr.c2df <- pr.c2df + 1*(chi2.c2df < th1)
 #			if (!quiet && ((j-1)/bcast == round((j-1)/bcast))) {
 			##				cat("\b\b\b\b\b\b",round((100*(j-1)/times),digits=2),"%",sep="")
 #				cat(" ",round((100*(j-1)/times),digits=2),"%",sep="")

Modified: pkg/GenABEL/R/rntransform.R
===================================================================
--- pkg/GenABEL/R/rntransform.R	2013-01-08 20:54:14 UTC (rev 1084)
+++ pkg/GenABEL/R/rntransform.R	2013-01-09 19:39:11 UTC (rev 1085)
@@ -1,5 +1,13 @@
 "rntransform" <-
-function(formula,data,family=gaussian) {
+		function(formula,data,family=gaussian) {
+	
+	if ( is(try(formula,silent=TRUE),"try-error") ) { 
+		if ( is(data,"gwaa.data") ) data1 <- phdata(data)
+		else if ( is(data,"data.frame") ) data1 <- data
+		else stop("'data' must have 'gwaa.data' or 'data.frame' class")
+		formula <- data1[[as(match.call()[["formula"]],"character")]] 
+	}
+	
 	var <- ztransform(formula,data,family)
 	out <- rank(var) - 0.5
 	out[is.na(var)] <- NA

Modified: pkg/GenABEL/R/scan.haplo.2D.R
===================================================================
--- pkg/GenABEL/R/scan.haplo.2D.R	2013-01-08 20:54:14 UTC (rev 1084)
+++ pkg/GenABEL/R/scan.haplo.2D.R	2013-01-09 19:39:11 UTC (rev 1085)
@@ -11,20 +11,20 @@
 	avrs <- all.vars(as.formula(formula))
 	if (!any(avrs=="CRSNP")) stop("formula must contain CRSNP variable to be replaced with the analysis SNPs")
 	avrs <- avrs[avrs!="CRSNP"]
-	attach(data at phdata,pos=2,warn.conflicts=FALSE)
+	#attach(data at phdata,pos=2,warn.conflicts=FALSE)
 	cov <- NA
 	if (length(avrs)>1) {
-		cov <- matrix(get(avrs[2],pos=2),ncol=1)
-		if (length(avrs>2)) for (i in 3:length(avrs)) cov <- cbind(cov,get(avrs[i],pos=2))
+		cov <- matrix(phdata(data)[[avrs[2]]],ncol=1)
+		if (length(avrs>2)) for (i in 3:length(avrs)) cov <- cbind(cov,phdata(data)[[avrs[i]]])
 	}
-	tra <- get(avrs[1],pos=2)
+	tra <- phdata(data)[[avrs[1]]]
 	if (missing(trait.type)) {
 		if (length(unique(tra))==2) 
 			trait.type<-"binomial" 
 		else 
 			trait.type<-"gaussian"
 	}
-	detach(data at phdata)
+	#detach(data at phdata)
 
         if (length(unique(tra))<2) stop("Trait is monomorphic!") 
 

Modified: pkg/GenABEL/R/scan.haplo.R
===================================================================
--- pkg/GenABEL/R/scan.haplo.R	2013-01-08 20:54:14 UTC (rev 1084)
+++ pkg/GenABEL/R/scan.haplo.R	2013-01-09 19:39:11 UTC (rev 1085)
@@ -11,20 +11,20 @@
 	avrs <- all.vars(as.formula(formula))
 	if (!any(avrs=="CRSNP")) stop("formula must contain CRSNP variable to be replaced with the analysis SNPs")
 	avrs <- avrs[avrs!="CRSNP"]
-	attach(data at phdata,pos=2,warn.conflicts=FALSE)
+#	attach(data at phdata,pos=2,warn.conflicts=FALSE)
 	cov <- NA
 	if (length(avrs)>1) {
-		cov <- get(avrs[2],pos=2)
-		if (length(avrs)>2) for (i in 3:length(avrs)) cov <- cbind(cov,get(avrs[i],pos=2))
+		cov <- phdata(data)[[avrs[2]]]
+		if (length(avrs)>2) for (i in 3:length(avrs)) cov <- cbind(cov,phdata(data)[[avrs[i]]])
 	}
-	tra <- get(avrs[1],pos=2)
+	tra <- phdata(data)[[avrs[1]]]
 	if (missing(trait.type)) {
 		if (length(unique(tra))==2) 
 			trait.type<-"binomial" 
 		else 
 			trait.type<-"gaussian"
 	}
-	detach(data at phdata)
+#	detach(data at phdata)
 	
 	if (length(unique(tra))<2) stop("Trait is monomorphic!") 
 	

Modified: pkg/GenABEL/R/ztransform.R
===================================================================
--- pkg/GenABEL/R/ztransform.R	2013-01-08 20:54:14 UTC (rev 1084)
+++ pkg/GenABEL/R/ztransform.R	2013-01-09 19:39:11 UTC (rev 1085)
@@ -5,7 +5,7 @@
 			data <- environment(formula)
 		else  
 			data <- environment()
-		wasdata <- 0
+#		wasdata <- 0
 	} else {
 		if (is(data,"gwaa.data")) {
 			data <- data at phdata
@@ -13,8 +13,8 @@
 		else if (!is(data,"data.frame")) {
 			stop("data argument should be of gwaa.data or data.frame class")
 		}
-		attach(data,pos=2,warn.conflicts=FALSE)
-		wasdata <- 1
+#		attach(data,pos=2,warn.conflicts=FALSE)
+#		wasdata <- 1
 	}
 	
 	if (is.character(family)) 
@@ -25,15 +25,20 @@
            print(family)
            stop("'family' not recognized")
 	}
+	
+	if ( is(try(formula,silent=TRUE),"try-error") ) { 
+		formula <- data[[as(match.call()[["formula"]],"character")]] 
+	}
+	
 	if (is(formula,"formula")) {
 		mf <- model.frame(formula,data,na.action=na.omit,drop.unused.levels=TRUE)
 		y <- model.response(mf)
 		desmat <- model.matrix(formula,mf)
 		lmf <- glm.fit(desmat,y,family=family)
-		if (wasdata) 
-			mids <- rownames(data) %in% rownames(mf)
-		else 
-			mids <- (!is.na(get(as.character(formula[2]))))
+#		if (wasdata) 
+#			mids <- rownames(data) %in% rownames(mf)
+#		else 
+		mids <- complete.cases(desmat,y)
 		resid <- lmf$resid
 #		print(formula)
 	} else if (is(formula,"numeric") || is(formula,"integer") || is(formula,"double")) {
@@ -47,7 +52,7 @@
 		stop("formula argument must be a formula or one of (numeric, integer, double)")
 	}
 	y <- (resid-mean(resid))/sd(resid)
-	if (wasdata==1) detach(data)
+#	if (wasdata==1) detach(data)
 	tmeas <- as.logical(mids)
 	out <- rep(NA,length(mids))
 	out[tmeas] <- y

Modified: pkg/GenABEL/R/zzz.R
===================================================================
--- pkg/GenABEL/R/zzz.R	2013-01-08 20:54:14 UTC (rev 1084)
+++ pkg/GenABEL/R/zzz.R	2013-01-09 19:39:11 UTC (rev 1085)
@@ -1,11 +1,11 @@
-.onLoad <- function(lib, pkg) {
+.onAttach <- function(lib, pkg) {
 	## this is something which should be fixed: both version 
 	## and date can come from DESCRIPTION!
 	#pkgDescription <- packageDescription(pkg)
 	#pkgVersion <- pkgDescription$Version
 	#pkgDate <- pkgDescription$Date
 	pkgVersion <- "1.7-3"
-	pkgDate <- "January 07, 2013"
+	pkgDate <- "January 09, 2013"
 	welcomeMessage <- paste(pkg," v. ",pkgVersion," (",pkgDate,") loaded\n",sep="")
 	# check if CRAN version is the same as loaded
 	cranVersion <- try( checkPackageVersionOnCRAN(pkg) )

Modified: pkg/GenABEL/inst/unitTests/report.html
===================================================================
--- pkg/GenABEL/inst/unitTests/report.html	2013-01-08 20:54:14 UTC (rev 1084)
+++ pkg/GenABEL/inst/unitTests/report.html	2013-01-09 19:39:11 UTC (rev 1085)
@@ -1,8 +1,8 @@
 <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN"
 "http://www.w3.org/TR/html4/transitional.dtd">
-<html><head><title>RUNIT TEST PROTOCOL--Mon Dec  3 21:50:27 2012</title>
+<html><head><title>RUNIT TEST PROTOCOL--Wed Jan  9 20:36:47 2013</title>
 </head>
-<body><h1 TRUE>RUNIT TEST PROTOCOL--Mon Dec  3 21:50:27 2012</h1>
+<body><h1 TRUE>RUNIT TEST PROTOCOL--Wed Jan  9 20:36:47 2013</h1>
 <p>Number of test functions: 18</p>
 <p style=color:red>Number of errors: 1</p>
 <p>Number of failures: 0</p>
@@ -35,9 +35,9 @@
 <hr>
 <h3 TRUE>Details</h3>
 <p><a name="GenABEL unit testing"><h5 TRUE>Test Suite: GenABEL unit testing</h5>
-</a>Test function regexp: ^test.+<br/>Test file regexp: ^runit.+\.[rR]$<br/>Involved directory:<br/>/Users/yuryaulchenko/eclipse_workspace/genabel/pkg/GenABEL/tests/../inst/unitTests<br/><ul><li><a href="/Users/yuryaulchenko/eclipse_workspace/genabel/pkg/GenABEL/tests/../inst/unitTests/runit.convert.snp.ped.R">Test file: runit.convert.snp.ped.R</a><ul><li><a name="GenABEL unit testing__Users_yuryaulchenko_eclipse_workspace_genabel_pkg_GenABEL_tests_.._inst_unitTests_runit.convert.snp.ped.R_test.convert.snp.ped">test.convert.snp.ped: (0 checks) ... OK (0.03 seconds)<br/></a></li></ul></li><li><a href="/Users/yuryaulchenko/eclipse_workspace/genabel/pkg/GenABEL/tests/../inst/unitTests/runit.convert.snp.R">Test file: runit.convert.snp.R</a><ul><li><a name="GenABEL unit testing__Users_yuryaulchenko_eclipse_workspace_genabel_pkg_GenABEL_tests_.._inst_unitTests_runit.convert.snp.R_test.convert.snp">test.convert.snp: (4 checks) ... OK (1.08 seconds)<br/></a></li></ul></li><li><a href="/Users/yuryaulchenko/eclipse_workspace/genabel/pkg/GenABEL/tests/../inst/unitTests/runit.descriptives.trait.R">Test file: runit.descriptives.trait.R</a><ul><li><a name="GenABEL unit testing__Users_yuryaulchenko_eclipse_workspace_genabel_pkg_GenABEL_tests_.._inst_unitTests_runit.descriptives.trait.R_test.descriptives.trait">test.descriptives.trait: (1 checks) ... OK (0.49 seconds)<br/></a></li></ul></li><li><a href="/Users/yuryaulchenko/eclipse_workspace/genabel/pkg/GenABEL/tests/../inst/unitTests/runit.exports.R">Test file: runit.exports.R</a><ul><li><a name="GenABEL unit testing__Users_yuryaulchenko_eclipse_workspace_genabel_pkg_GenABEL_tests_.._inst_unitTests_runit.exports.R_test.exports">test.exports: (19 checks) ... OK (0.62 seconds)<br/></a></li></ul></li><li><a href="/Users/yuryaulchenko/eclipse_workspace/genabel/pkg/GenABEL/tests/../inst/unitTests/runit.findRelatives.R">Test file: runit.findRelatives.R</a><ul><li><a name="GenABEL unit testing__Users_yuryaulchenko_eclipse_workspace_genabel_pkg_GenABEL_tests_.._inst_unitTests_runit.findRelatives.R_test.findRelatives">test.findRelatives: (10 checks) ... OK (54.73 seconds)<br/></a></li></ul></li><li><a href="/Users/yuryaulchenko/eclipse_workspace/genabel/pkg/GenABEL/tests/../inst/unitTests/runit.impute2xxx_large.R">Test file: runit.impute2xxx_large.R</a><ul><li><a name="GenABEL unit testing__Users_yuryaulchenko_eclipse_workspace_genabel_pkg_GenABEL_tests_.._inst_unitTests_runit.impute2xxx_large.R_test.impute2xxx_large">test.impute2xxx_large: (0 checks) ... OK (0 seconds)<br/></a></li></ul></li><li><a href="/Users/yuryaulchenko/eclipse_workspace/genabel/pkg/GenABEL/tests/../inst/unitTests/runit.impute2xxx.R">Test file: runit.impute2xxx.R</a><ul><li><a name="GenABEL unit testing__Users_yuryaulchenko_eclipse_workspace_genabel_pkg_GenABEL_tests_.._inst_unitTests_runit.impute2xxx.R_test.impute2databel"><u style=color:red>test.impute2databel: ERROR !!  </u></a>Error in .Call("iterator", tmp_fv at data, as.integer(0), as.integer(0),  : 
+</a>Test function regexp: ^test.+<br/>Test file regexp: ^runit.+\.[rR]$<br/>Involved directory:<br/>/Users/yuryaulchenko/eclipse_workspace/genabel/pkg/GenABEL/tests/../inst/unitTests<br/><ul><li><a href="/Users/yuryaulchenko/eclipse_workspace/genabel/pkg/GenABEL/tests/../inst/unitTests/runit.convert.snp.R">Test file: runit.convert.snp.R</a><ul><li><a name="GenABEL unit testing__Users_yuryaulchenko_eclipse_workspace_genabel_pkg_GenABEL_tests_.._inst_unitTests_runit.convert.snp.R_test.convert.snp">test.convert.snp: (4 checks) ... OK (1.02 seconds)<br/></a></li></ul></li><li><a href="/Users/yuryaulchenko/eclipse_workspace/genabel/pkg/GenABEL/tests/../inst/unitTests/runit.convert.snp.ped.R">Test file: runit.convert.snp.ped.R</a><ul><li><a name="GenABEL unit testing__Users_yuryaulchenko_eclipse_workspace_genabel_pkg_GenABEL_tests_.._inst_unitTests_runit.convert.snp.ped.R_test.convert.snp.ped">test.convert.snp.ped: (0 checks) ... OK (0.03 seconds)<br/></a></li></ul></li><li><a href="/Users/yuryaulchenko/eclipse_workspace/genabel/pkg/GenABEL/tests/../inst/unitTests/runit.descriptives.trait.R">Test file: runit.descriptives.trait.R</a><ul><li><a name="GenABEL unit testing__Users_yuryaulchenko_eclipse_workspace_genabel_pkg_GenABEL_tests_.._inst_unitTests_runit.descriptives.trait.R_test.descriptives.trait">test.descriptives.trait: (1 checks) ... OK (0.43 seconds)<br/></a></li></ul></li><li><a href="/Users/yuryaulchenko/eclipse_workspace/genabel/pkg/GenABEL/tests/../inst/unitTests/runit.exports.R">Test file: runit.exports.R</a><ul><li><a name="GenABEL unit testing__Users_yuryaulchenko_eclipse_workspace_genabel_pkg_GenABEL_tests_.._inst_unitTests_runit.exports.R_test.exports">test.exports: (15 checks) ... OK (0.5 seconds)<br/></a></li></ul></li><li><a href="/Users/yuryaulchenko/eclipse_workspace/genabel/pkg/GenABEL/tests/../inst/unitTests/runit.findRelatives.R">Test file: runit.findRelatives.R</a><ul><li><a name="GenABEL unit testing__Users_yuryaulchenko_eclipse_workspace_genabel_pkg_GenABEL_tests_.._inst_unitTests_runit.findRelatives.R_test.findRelatives">test.findRelatives: (10 checks) ... OK (46.07 seconds)<br/></a></li></ul></li><li><a href="/Users/yuryaulchenko/eclipse_workspace/genabel/pkg/GenABEL/tests/../inst/unitTests/runit.impute2xxx.R">Test file: runit.impute2xxx.R</a><ul><li><a name="GenABEL unit testing__Users_yuryaulchenko_eclipse_workspace_genabel_pkg_GenABEL_tests_.._inst_unitTests_runit.impute2xxx.R_test.impute2databel"><u style=color:red>test.impute2databel: ERROR !!  </u></a>Error in .Call("iterator", tmp_fv at data, as.integer(0), as.integer(0),  : 
   "iterator" not resolved from current namespace (GenABEL)
[TRUNCATED]

To get the complete diff run:
    svnlook diff /svnroot/genabel -r 1085


More information about the Genabel-commits mailing list