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

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Thu Mar 31 01:54:08 CEST 2011


Author: yurii
Date: 2011-03-31 01:54:07 +0200 (Thu, 31 Mar 2011)
New Revision: 704

Added:
   pkg/GenABEL/inst/unitTests/runit.descriptives.trait.R
   pkg/GenABEL/tests/test_markers
   pkg/GenABEL/tests/test_phenos
Modified:
   pkg/GenABEL/CHANGES.LOG
   pkg/GenABEL/DESCRIPTION
   pkg/GenABEL/R/GenABEL-package.R
   pkg/GenABEL/R/descriptives.trait.R
   pkg/GenABEL/R/ibs.R
   pkg/GenABEL/R/reconstructNPs.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/inst/unitTests/runit.findRelatives.R
   pkg/GenABEL/man/GenABEL-package.Rd
   pkg/GenABEL/man/descriptives.trait.Rd
   pkg/GenABEL/man/grammar.Rd
   pkg/GenABEL/man/mmscore.Rd
   pkg/GenABEL/man/reconstructNPs.Rd
   pkg/GenABEL/tests/
Log:
patch of Nicola Pirastu + regression tests + few accumulated changes

Modified: pkg/GenABEL/CHANGES.LOG
===================================================================
--- pkg/GenABEL/CHANGES.LOG	2011-03-30 16:33:24 UTC (rev 703)
+++ pkg/GenABEL/CHANGES.LOG	2011-03-30 23:54:07 UTC (rev 704)
@@ -1,5 +1,13 @@
-*** v. 1.6-6 (2011.03.22)
+*** v. 1.6-6 (2011.03.31)
 
+Applied the patch of Nicola Pirastu 
+http://lists.r-forge.r-project.org/pipermail/genabel-devel/2011-March/000182.html
+to descriptives.trait. Added RUnit regression tests, updated 
+documentation. Bugs fixed: [#1184], [#1185], [#1259]
+
+Added 'reconstructNPs' function; added extra options 
+to 'findRelatives'. 
+
 Added a number of functions facilitating relationship checks. 
 The core function is 'findRelatives'. Compared 
 to guessing relations from genomic kinship matrix, this 

Modified: pkg/GenABEL/DESCRIPTION
===================================================================
--- pkg/GenABEL/DESCRIPTION	2011-03-30 16:33:24 UTC (rev 703)
+++ pkg/GenABEL/DESCRIPTION	2011-03-30 23:54:07 UTC (rev 704)
@@ -2,7 +2,7 @@
 Type: Package
 Title: genome-wide SNP association analysis
 Version: 1.6-6
-Date: 2011-02-24
+Date: 2011-03-31
 Author: Yurii Aulchenko et al.
 Maintainer: Yurii Aulchenko <i.aoultchenko at erasmusmc.nl>
 Depends: R (>= 2.10.0), methods, MASS

Modified: pkg/GenABEL/R/GenABEL-package.R
===================================================================
--- pkg/GenABEL/R/GenABEL-package.R	2011-03-30 16:33:24 UTC (rev 703)
+++ pkg/GenABEL/R/GenABEL-package.R	2011-03-30 23:54:07 UTC (rev 704)
@@ -94,9 +94,9 @@
 #' \code{\link{mmscore}},
 #' \code{\link{egscore}},
 #' \code{\link{ibs}},
-#' \code{\link{r2fast}},
-#' \code{\link{dprfast}},
-#' \code{\link{rhofast}}
+#' \code{\link{r2fast}} (estimate linkage disequilibrium using R2),
+#' \code{\link{dprfast}} (estimate linkage disequilibrium using D'),
+#' \code{\link{rhofast}}  (estimate linkage disequilibrium using 'rho')
 #' 
 #' For specific tools facilitating analysis of the data with stratification
 #' (population stratification or (possibly unknown) pedigree structure), see
@@ -113,6 +113,10 @@
 #' \code{\link{descriptives.trait}},
 #' \code{\link{descriptives.scan}}.
 #' 
+#' For functions recunstructing relationships from genomic data, 
+#' see 
+#' \code{\link{findRelatives}}, \code{\link{reconstructNPs}}. 
+#' 
 #' For meta-analysis and related, see help on
 #' \code{\link{formetascore}}.
 #' 

Modified: pkg/GenABEL/R/descriptives.trait.R
===================================================================
--- pkg/GenABEL/R/descriptives.trait.R	2011-03-30 16:33:24 UTC (rev 703)
+++ pkg/GenABEL/R/descriptives.trait.R	2011-03-30 23:54:07 UTC (rev 704)
@@ -1,60 +1,96 @@
-"descriptives.trait" <-
-function (data,subset,file,by.var=NULL,digits=3) {
-	if (missing(data)) stop("data argument must be provided")
-	if (is(data,"gwaa.data")) data <- data at phdata
-	if (!is(data,"data.frame")) stop("data argument must be of gwaa.data or data.frame-class")
-	len <- dim(data)[1]
-	ntra <- dim(data)[2]
-	if (!missing(subset)) data <- data[subset,]
-	if (!is.null(by.var)) {
-		svar <- by.var
-		if (length(levels(factor(svar)))!=2) stop("The by.var argument should contain a binary variable")
-		out <- matrix(data=NA,nrow=ntra,ncol=9)
-		lvls <- levels(factor(svar))
-		for (i in (1:ntra)) {
-			ctrao <- data[,i]
-			if (!is.numeric(ctrao) | all(ctrao==svar)) {
-				ctra <- ctrao[which(svar == lvls[1])]
-				out[i,1] <- length(ctra) - sum(is.na(ctra))
-				ctra <- ctrao[which(svar == lvls[2])]
-				out[i,4] <- length(ctra) - sum(is.na(ctra))
-			} else {
-				ctra <- ctrao[which(svar == lvls[1])]
-				out[i,1] <- length(ctra) - sum(is.na(ctra))
-				out[i,2] <- mean(ctra,na.rm=TRUE)
-				out[i,3] <- sd(ctra,na.rm=TRUE)
-				ctra <- ctrao[which(svar == lvls[2])]
-				out[i,4] <- length(ctra) - sum(is.na(ctra))
-				out[i,5] <- mean(ctra,na.rm=TRUE)
-				out[i,6] <- sd(ctra,na.rm=TRUE)
-				out[i,7] <- t.test(ctrao ~ svar)$p.value
-				out[i,8] <- kruskal.test(ctrao ~ svar)$p.value
-				clv <- length(unique(ctrao))
-				if (clv>1 & clv<5) out[i,9] <- fisher.test(ctrao,svar)$p.value
-			}
-		}
-	} else {
-		out <- matrix(data=NA,nrow=ntra,ncol=3)
-		for (i in (1:ntra)) {
-			ctra <- data[,i]
-			out[i,1] <- length(ctra) - sum(is.na(ctra))
-			if (!is.numeric(ctra)) next;
-			out[i,2] <- mean(ctra,na.rm=TRUE)
-			out[i,3] <- sd(ctra,na.rm=TRUE)
-		}
-	}
-	out <- round(out,digits=digits)
-	out <- data.frame(out)
-	rownames(out) <- colnames(data)
-	if (is.null(by.var)) 
-		colnames(out) <- c("No","Mean","SD")
-	else 
-		colnames(out) <- c(paste("No(by.var=",lvls[1],")",sep=""),"Mean","SD",paste("No(by.var=",lvls[2],")",sep=""),"Mean","SD","Ptt","Pkw","Pexact")
-	if (!missing(file)) {
-		cat("\t",file=file,sep="")
-		cat(colnames(out),file=file,sep="\t",append=TRUE)
-		cat("\n",file=file,sep="",append=TRUE)
-		write.table(out,file=file,sep="\t",append=T,col.names=FALSE)
-	}
-	out
+descriptives.trait <- function (data, subset, file, by.var = NULL, digits = 3) 
+{
+    if (missing(data)) 
+        stop("data argument must be provided")
+    if (is(data, "gwaa.data")) 
+        data <- data at phdata
+    if (!is(data, "data.frame")) 
+        stop("data argument must be of gwaa.data or data.frame-class")
+    len <- dim(data)[1]
+    ntra <- dim(data)[2]
+    if (!missing(subset)) 
+        data <- data[subset, ]
+    if (!is.null(by.var)) {
+    	svar <- by.var
+        if(class(by.var)=="formula"){
+           svar<-data[,as.character(by.var)[2]]
+        }
+    	if(is.character(by.var) & length(by.var==1)){
+    	   svar<-data[,by.var]
+    	}
+        if (length(levels(factor(svar))) != 2) 
+            stop("The by.var argument should contain a binary variable")
+        out <- matrix(data = NA, nrow = ntra, ncol = 9)
+        lvls <- levels(factor(svar))
+        for (i in (1:ntra)) {
+            ctrao <- data[, i]
+            if (!is.numeric(ctrao) | all(ctrao == svar,na.rm=T)) {
+                ctra <- ctrao[svar == lvls[1]]
+                out[i, 1] <- length(ctra) - sum(is.na(ctra))
+                ctra <- ctrao[svar == lvls[2]]
+                out[i, 4] <- length(ctra) - sum(is.na(ctra))
+            }
+            else {
+                ctra <- ctrao[svar == lvls[1]]
+                out[i, 1] <- length(ctra) - sum(is.na(ctra))
+                out[i, 2] <- mean(ctra, na.rm = TRUE)
+                out[i, 3] <- sd(ctra, na.rm = TRUE)
+                ctra <- ctrao[svar == lvls[2]]
+                out[i, 4] <- length(ctra) - sum(is.na(ctra))
+                out[i, 5] <- mean(ctra, na.rm = TRUE)
+                out[i, 6] <- sd(ctra, na.rm = TRUE)
+                tmp<-try(t.test(ctrao ~ svar)$p.value)
+                if(class(tmp)=="numeric"){
+                   out[i, 7] <- tmp
+                }
+                tmp<-try(kruskal.test(ctrao ~ svar)$p.value)
+                if(class(tmp)=="numeric"){
+                   out[i, 8] <- tmp
+                }
+                clv <- length(unique(ctrao))
+                if (clv > 1 & clv < 5) 
+                  out[i, 9] <- fisher.test(ctrao, svar)$p.value
+            }
+        }
+    }
+    else {
+        out <- matrix(data = NA, nrow = ntra, ncol = 3)
+        for (i in (1:ntra)) {
+            ctra <- data[, i]
+            out[i, 1] <- length(ctra) - sum(is.na(ctra))
+            if (!is.numeric(ctra)) 
+                next
+            out[i, 2] <- mean(ctra, na.rm = TRUE)
+            out[i, 3] <- sd(ctra, na.rm = TRUE)
+        }
+    }
+    out <- round(out, digits = digits)
+    out <- data.frame(out)
+    rownames(out) <- colnames(data)
+    if (is.null(by.var)) 
+        colnames(out) <- c("No", "Mean", "SD")
+    else colnames(out) <- c(paste("No(by.var=", lvls[1], ")", 
+        sep = ""), "Mean", "SD", paste("No(by.var=", lvls[2], 
+        ")", sep = ""), "Mean", "SD", "Ptt", "Pkw", "Pexact")
+    if (!missing(file)) {
+        cat("\t", file = file, sep = "")
+        cat(colnames(out), file = file, sep = "\t", append = TRUE)
+        cat("\n", file = file, sep = "", append = TRUE)
+        write.table(out, file = file, sep = "\t", append = T, 
+            col.names = FALSE)
+    }
+    out
 }
+
+
+
+
+
+
+
+
+
+
+
+
+

Modified: pkg/GenABEL/R/ibs.R
===================================================================
--- pkg/GenABEL/R/ibs.R	2011-03-30 16:33:24 UTC (rev 703)
+++ pkg/GenABEL/R/ibs.R	2011-03-30 23:54:07 UTC (rev 704)
@@ -1,11 +1,11 @@
 "ibs" <- 
-function (data,snpsubset,idsubset,cross.idsubset,weight="no",snpfreq) {
+function (data,snpsubset,idsubset=NULL,cross.idsubset=NULL,weight="no",snpfreq=NULL) {
 # idsubset, cross.idsubset: should be real names, not indexes!
 	if (is(data,"gwaa.data")) data <- data at gtdata
 	if (!is(data,"snp.data")) stop("The data argument must be of snp.data-class or gwaa.data-class")
 	if (!missing(snpsubset)) data <- data[,snpsubset]
-	if (missing(idsubset) && !missing(cross.idsubset)) stop("cross.idsubset arg cannot be used (idsubset missing)",immediate. = TRUE)
-	if (!missing(snpfreq)) {
+	if (is.null(idsubset) && !is.null(cross.idsubset)) stop("cross.idsubset arg cannot be used (idsubset missing)",immediate. = TRUE)
+	if (!is.null(snpfreq)) {
 		if (length(snpfreq) != data at nsnps) stop("snpfreq argument not equal in length to the number of SNPs in data")
 		if (any(snpfreq<0.) || any(snpfreq>1.)) stop("snpfreq argument: frequencies out of [0,1]")
 		if (!is(snpfreq,"numeric")) stop("snpfreq argument: non-numeric class")
@@ -19,11 +19,11 @@
 	}
 	varidiag <- hom(data)[,"Var"]
 	ibs.C.option <- 0
-	if (!missing(idsubset) && !(is.numeric(idsubset) || is.logical(idsubset) || is.character(idsubset))) stop("idsubset must be numeric, logical, or character")
-	if (!missing(cross.idsubset) && !(is.numeric(cross.idsubset) || is.logical(cross.idsubset) || is.character(cross.idsubset))) stop("cross.idsubset must be numeric, logical, or character")
-	if (!missing(idsubset) && (is.numeric(idsubset) || is.logical(idsubset))) idsubset <- data at idnames[idsubset]
-	if (!missing(cross.idsubset) && (is.numeric(cross.idsubset) || is.logical(cross.idsubset))) cross.idsubset <- data at idnames[cross.idsubset]
-	if (!missing(idsubset) && !missing(cross.idsubset)) {
+	if (!is.null(idsubset) && !(is.numeric(idsubset) || is.logical(idsubset) || is.character(idsubset))) stop("idsubset must be numeric, logical, or character")
+	if (!is.null(cross.idsubset) && !(is.numeric(cross.idsubset) || is.logical(cross.idsubset) || is.character(cross.idsubset))) stop("cross.idsubset must be numeric, logical, or character")
+	if (!is.null(idsubset) && (is.numeric(idsubset) || is.logical(idsubset))) idsubset <- data at idnames[idsubset]
+	if (!is.null(cross.idsubset) && (is.numeric(cross.idsubset) || is.logical(cross.idsubset))) cross.idsubset <- data at idnames[cross.idsubset]
+	if (!is.null(idsubset) && !is.null(cross.idsubset)) {
 		idset1 <- idsubset
 		idset2 <- cross.idsubset
 		if (any(idset1 %in% idset2)) stop("idsubset and cross.idsubset should not overlap!")
@@ -33,14 +33,14 @@
 		if (length(idsorder) != data at nids) data <- data[idsorder,]
 		if (any(idsorder!=data at idnames)) data <- data[idsorder,]
 		ibs.C.option <- 1
-	} else if (!missing(idsubset) & missing(cross.idsubset)) {
+	} else if (!is.null(idsubset) & is.null(cross.idsubset)) {
 		idset1 <- idsubset
 		idset2 <- idsubset
 		idsorder <- idsubset
 		homodiag <- homodiag[match(idsorder,data at idnames)]
 		varidiag <- varidiag[match(idsorder,data at idnames)]
 		data <- data[idsorder,]
-	} else if (missing(idsubset) & missing(cross.idsubset)) {
+	} else if (is.null(idsubset) & is.null(cross.idsubset)) {
 		idset1 <- data at idnames
 		idset2 <- data at idnames
 	} else {

Modified: pkg/GenABEL/R/reconstructNPs.R
===================================================================
--- pkg/GenABEL/R/reconstructNPs.R	2011-03-30 16:33:24 UTC (rev 703)
+++ pkg/GenABEL/R/reconstructNPs.R	2011-03-30 23:54:07 UTC (rev 704)
@@ -37,7 +37,7 @@
 #' sex <- c(1,0,0,1,0,0,0,0)
 #' names(sex) <- paste("g",c(7:14),sep="")
 #' gt <- matrix(ncol=nloci,nrow=nids)
-#' rownames(gt) <- c(7:14)
+#' rownames(gt) <- paste("g",c(7:14),sep="")
 #' gt["g7",] <- rbinom(nloci,2,q)
 #' gt["g8",] <- rbinom(nloci,2,q)
 #' gt["g11",] <- rbinom(nloci,2,q)

Modified: pkg/GenABEL/R/zzz.R
===================================================================
--- pkg/GenABEL/R/zzz.R	2011-03-30 16:33:24 UTC (rev 703)
+++ pkg/GenABEL/R/zzz.R	2011-03-30 23:54:07 UTC (rev 704)
@@ -1,6 +1,6 @@
 .onLoad <- function(lib, pkg) {
 	GenABEL.version <- "1.6-6"
-	cat("GenABEL v.",GenABEL.version,"(February 24, 2011) loaded\n")
+	cat("GenABEL v.",GenABEL.version,"(March 31, 2011) loaded\n")
 	
 	# check for updates and news
 	address <- c(

Modified: pkg/GenABEL/inst/unitTests/report.html
===================================================================
--- pkg/GenABEL/inst/unitTests/report.html	2011-03-30 16:33:24 UTC (rev 703)
+++ pkg/GenABEL/inst/unitTests/report.html	2011-03-30 23:54:07 UTC (rev 704)
@@ -1,9 +1,9 @@
 <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN"
 "http://www.w3.org/TR/html4/transitional.dtd">
-<html><head><title>RUNIT TEST PROTOCOL--Tue Mar 22 01:41:46 2011</title>
+<html><head><title>RUNIT TEST PROTOCOL--Thu Mar 31 00:50:19 2011</title>
 </head>
-<body><h1 TRUE>RUNIT TEST PROTOCOL--Tue Mar 22 01:41:46 2011</h1>
-<p>Number of test functions: 6</p>
+<body><h1 TRUE>RUNIT TEST PROTOCOL--Thu Mar 31 00:50:19 2011</h1>
+<p>Number of test functions: 7</p>
 <p>Number of errors: 0</p>
 <p>Number of failures: 0</p>
 <hr>
@@ -15,7 +15,7 @@
 <th width="20%">Failures</th>
 </tr>
 <tr><td><a href="#GenABEL unit testing">GenABEL unit testing</a></td>
-<td>6</td>
+<td>7</td>
 <td>0</td>
 <td>0</td>
 </tr>
@@ -23,7 +23,7 @@
 <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/yuriiaulchenko/eclipse_workspace/pkg/GenABEL/tests/../inst/unitTests<br/><ul><li><a href="/Users/yuriiaulchenko/eclipse_workspace/pkg/GenABEL/tests/../inst/unitTests/runit.findRelatives.R">Test file: runit.findRelatives.R</a><ul><li><a name="GenABEL unit testing__Users_yuriiaulchenko_eclipse_workspace_pkg_GenABEL_tests_.._inst_unitTests_runit.findRelatives.R_test.findRelatives">test.findRelatives: (7 checks) ... OK (68.51 seconds)<br/></a></li></ul></li><li><a href="/Users/yuriiaulchenko/eclipse_workspace/pkg/GenABEL/tests/../inst/unitTests/runit.impute2xxx.R">Test file: runit.impute2xxx.R</a><ul><li><a name="GenABEL unit testing__Users_yuriiaulchenko_eclipse_workspace_pkg_GenABEL_tests_.._inst_unitTests_runit.impute2xxx.R_test.impute2databel">test.impute2databel: (23 checks) ... OK (0.83 seconds)<br/></a></li></ul></li><li><a href="/Users/yuriiaulchenko/eclipse_workspace/pkg/GenABEL/tests/../inst/unitTests/runit.impute2xxx_large.R">Test file: runit.impute2xxx_large.R</a><ul><li><a name="GenABEL unit testing__Users_yuriiaulchenko_eclipse_workspace_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/yuriiaulchenko/eclipse_workspace/pkg/GenABEL/tests/../inst/unitTests/runit.iterator.R">Test file: runit.iterator.R</a><ul><li><a name="GenABEL unit testing__Users_yuriiaulchenko_eclipse_workspace_pkg_GenABEL_tests_.._inst_unitTests_runit.iterator.R_test.qtscore">test.qtscore: (0 checks) ... OK (0 seconds)<br/></a></li><li><a name="GenABEL unit testing__Users_yuriiaulchenko_eclipse_workspace_pkg_GenABEL_tests_.._inst_unitTests_runit.iterator.R_test.summary_snp_data">test.summary_snp_data: (3 checks) ... OK (12.39 seconds)<br/></a></li></ul></li><li><a href="/Users/yuriiaulchenko/eclipse_workspace/pkg/GenABEL/tests/../inst/unitTests/runit.mach2databel.R">Test file: runit.mach2databel.R</a><ul><li><a name="GenABEL unit testing__Users_yuriiaulchenko_eclipse_workspace_pkg_GenABEL_tests_.._inst_unitTests_runit.mach2databel.R_test.mach2databel">test.mach2databel: (8 checks) ... OK (0.53 seconds)<br/></a></li></ul></li></ul><hr>
+</a>Test function regexp: ^test.+<br/>Test file regexp: ^runit.+\.[rR]$<br/>Involved directory:<br/>/Users/yuriiaulchenko/eclipse_workspace/pkg/GenABEL/tests/../inst/unitTests<br/><ul><li><a href="/Users/yuriiaulchenko/eclipse_workspace/pkg/GenABEL/tests/../inst/unitTests/runit.descriptives.trait.R">Test file: runit.descriptives.trait.R</a><ul><li><a name="GenABEL unit testing__Users_yuriiaulchenko_eclipse_workspace_pkg_GenABEL_tests_.._inst_unitTests_runit.descriptives.trait.R_test.descriptives.trait">test.descriptives.trait: (1 checks) ... OK (0.74 seconds)<br/></a></li></ul></li><li><a href="/Users/yuriiaulchenko/eclipse_workspace/pkg/GenABEL/tests/../inst/unitTests/runit.findRelatives.R">Test file: runit.findRelatives.R</a><ul><li><a name="GenABEL unit testing__Users_yuriiaulchenko_eclipse_workspace_pkg_GenABEL_tests_.._inst_unitTests_runit.findRelatives.R_test.findRelatives">test.findRelatives: (10 checks) ... OK (119.15 seconds)<br/></a></li></ul></li><li><a href="/Users/yuriiaulchenko/eclipse_workspace/pkg/GenABEL/tests/../inst/unitTests/runit.impute2xxx.R">Test file: runit.impute2xxx.R</a><ul><li><a name="GenABEL unit testing__Users_yuriiaulchenko_eclipse_workspace_pkg_GenABEL_tests_.._inst_unitTests_runit.impute2xxx.R_test.impute2databel">test.impute2databel: (23 checks) ... OK (0.55 seconds)<br/></a></li></ul></li><li><a href="/Users/yuriiaulchenko/eclipse_workspace/pkg/GenABEL/tests/../inst/unitTests/runit.impute2xxx_large.R">Test file: runit.impute2xxx_large.R</a><ul><li><a name="GenABEL unit testing__Users_yuriiaulchenko_eclipse_workspace_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/yuriiaulchenko/eclipse_workspace/pkg/GenABEL/tests/../inst/unitTests/runit.iterator.R">Test file: runit.iterator.R</a><ul><li><a name="GenABEL unit testing__Users_yuriiaulchenko_eclipse_workspace_pkg_GenABEL_tests_.._inst_unitTests_runit.iterator.R_test.qtscore">test.qtscore: (0 checks) ... OK (0 seconds)<br/></a></li><li><a name="GenABEL unit testing__Users_yuriiaulchenko_eclipse_workspace_pkg_GenABEL_tests_.._inst_unitTests_runit.iterator.R_test.summary_snp_data">test.summary_snp_data: (3 checks) ... OK (8.58 seconds)<br/></a></li></ul></li><li><a href="/Users/yuriiaulchenko/eclipse_workspace/pkg/GenABEL/tests/../inst/unitTests/runit.mach2databel.R">Test file: runit.mach2databel.R</a><ul><li><a name="GenABEL unit testing__Users_yuriiaulchenko_eclipse_workspace_pkg_GenABEL_tests_.._inst_unitTests_runit.mach2databel.R_test.mach2databel">test.mach2databel: (8 checks) ... OK (0.25 seconds)<br/></a></li></ul></li></ul><hr>
 <table border="0" width="80%" >
 <tr><th>Name</th>
 <th>Value</th>

Modified: pkg/GenABEL/inst/unitTests/report.txt
===================================================================
--- pkg/GenABEL/inst/unitTests/report.txt	2011-03-30 16:33:24 UTC (rev 703)
+++ pkg/GenABEL/inst/unitTests/report.txt	2011-03-30 23:54:07 UTC (rev 704)
@@ -1,12 +1,12 @@
-RUNIT TEST PROTOCOL -- Tue Mar 22 01:41:46 2011 
+RUNIT TEST PROTOCOL -- Thu Mar 31 00:50:19 2011 
 *********************************************** 
-Number of test functions: 6 
+Number of test functions: 7 
 Number of errors: 0 
 Number of failures: 0 
 
  
 1 Test Suite : 
-GenABEL unit testing - 6 test functions, 0 errors, 0 failures
+GenABEL unit testing - 7 test functions, 0 errors, 0 failures
 
 
 
@@ -18,18 +18,21 @@
 Involved directory: 
 /Users/yuriiaulchenko/eclipse_workspace/pkg/GenABEL/tests/../inst/unitTests 
 --------------------------- 
+Test file: /Users/yuriiaulchenko/eclipse_workspace/pkg/GenABEL/tests/../inst/unitTests/runit.descriptives.trait.R 
+test.descriptives.trait: (1 checks) ... OK (0.74 seconds)
+--------------------------- 
 Test file: /Users/yuriiaulchenko/eclipse_workspace/pkg/GenABEL/tests/../inst/unitTests/runit.findRelatives.R 
-test.findRelatives: (7 checks) ... OK (68.51 seconds)
+test.findRelatives: (10 checks) ... OK (119.15 seconds)
 --------------------------- 
 Test file: /Users/yuriiaulchenko/eclipse_workspace/pkg/GenABEL/tests/../inst/unitTests/runit.impute2xxx.R 
-test.impute2databel: (23 checks) ... OK (0.83 seconds)
+test.impute2databel: (23 checks) ... OK (0.55 seconds)
 --------------------------- 
 Test file: /Users/yuriiaulchenko/eclipse_workspace/pkg/GenABEL/tests/../inst/unitTests/runit.impute2xxx_large.R 
 test.impute2xxx_large: (0 checks) ... OK (0 seconds)
 --------------------------- 
 Test file: /Users/yuriiaulchenko/eclipse_workspace/pkg/GenABEL/tests/../inst/unitTests/runit.iterator.R 
 test.qtscore: (0 checks) ... OK (0 seconds)
-test.summary_snp_data: (3 checks) ... OK (12.39 seconds)
+test.summary_snp_data: (3 checks) ... OK (8.58 seconds)
 --------------------------- 
 Test file: /Users/yuriiaulchenko/eclipse_workspace/pkg/GenABEL/tests/../inst/unitTests/runit.mach2databel.R 
-test.mach2databel: (8 checks) ... OK (0.53 seconds)
+test.mach2databel: (8 checks) ... OK (0.25 seconds)

Modified: pkg/GenABEL/inst/unitTests/reportSummary.txt
===================================================================
--- pkg/GenABEL/inst/unitTests/reportSummary.txt	2011-03-30 16:33:24 UTC (rev 703)
+++ pkg/GenABEL/inst/unitTests/reportSummary.txt	2011-03-30 23:54:07 UTC (rev 704)
@@ -1,9 +1,9 @@
-RUNIT TEST PROTOCOL -- Tue Mar 22 01:41:46 2011 
+RUNIT TEST PROTOCOL -- Thu Mar 31 00:50:19 2011 
 *********************************************** 
-Number of test functions: 6 
+Number of test functions: 7 
 Number of errors: 0 
 Number of failures: 0 
 
  
 1 Test Suite : 
-GenABEL unit testing - 6 test functions, 0 errors, 0 failures
+GenABEL unit testing - 7 test functions, 0 errors, 0 failures

Added: pkg/GenABEL/inst/unitTests/runit.descriptives.trait.R
===================================================================
--- pkg/GenABEL/inst/unitTests/runit.descriptives.trait.R	                        (rev 0)
+++ pkg/GenABEL/inst/unitTests/runit.descriptives.trait.R	2011-03-30 23:54:07 UTC (rev 704)
@@ -0,0 +1,46 @@
+### --- Test setup ---
+#
+# regression tests
+#
+
+if(FALSE) {
+    ## Not really needed, but can be handy when writing tests
+    library(RUnit)
+    library(GenABEL)
+}
+
+### do not run
+#stop("SKIP THIS TEST")
+###
+
+### ---- common functions and data -----
+
+#source(paste("../inst/unitTests/shared_functions.R"))
+#source(paste(path,"/shared_functions.R",sep=""))
+
+### --- Test functions ---
+
+test.descriptives.trait <- function()
+{
+    data(ge03d2ex)
+# this works
+    descriptives.trait(ge03d2ex,by.var=phdata(ge03d2ex)$sex)
+# bug [#1184]
+# and this does not!
+    checkException(descriptives.trait(ge03d2ex,by.var=sex))
+    attach(phdata(ge03d2ex))
+    descriptives.trait(ge03d2ex,by.var=sex)
+    detach(phdata(ge03d2ex))
+    descriptives.trait(ge03d2ex,by.var="sex")
+    phdata(ge03d2ex)$sex[2] <- NA
+# bug [#1185]
+# and this does not!
+    descriptives.trait(ge03d2ex,by.var=phdata(ge03d2ex)$sex)
+    descriptives.trait(ge03d2ex,by.var="sex")
+# bug [#1259]
+    convert.snp.illumina(infile="test_markers", outfile="test.raw")
+    test = load.gwaa.data(pheno="test_phenos", geno="test.raw", force=T)
+    attach(phdata(test))
+    descriptives.trait(data=test, by = bt)
+    detach(phdata(test))
+}
\ No newline at end of file

Modified: pkg/GenABEL/inst/unitTests/runit.findRelatives.R
===================================================================
--- pkg/GenABEL/inst/unitTests/runit.findRelatives.R	2011-03-30 16:33:24 UTC (rev 703)
+++ pkg/GenABEL/inst/unitTests/runit.findRelatives.R	2011-03-30 23:54:07 UTC (rev 704)
@@ -20,40 +20,56 @@
 
 test.findRelatives <- function()
 {
-    data(ge03d2.clean)
     nloci <- 2000
     set.seed(1)
-    df <- ge03d2.clean[,sort(sample(autosomal(ge03d2.clean),nloci))]
-    q <- summary(gtdata(df))$"Q.2"
+    q <- runif(nloci,min=0.05,max=0.95)
 #
 # g1---g2
 #    |
 #    g3----g4
-#       /\
-#     g5  g6---g7
-#            |
-#            g8---g9
-#               |
-#               g10
-    nids <- 10
-    founders <- sample(idnames(df),5)
+#      __|__
+#     |  |  |
+#    g5 g6 g7---g8
+#            _|_
+#           |   |
+#          g9  g10---g11
+#                __|_
+#               |   /\
+#             g12 g13 g14
+#
+    nids <- 14
+    sex <- c(1,0,1,0,0,0,1,0,0,1,0,0,0,0)
+    names(sex) <- 1:14
     gt <- matrix(ncol=nloci,nrow=nids)
     gt[1,] <- rbinom(nloci,2,q)
     gt[2,] <- rbinom(nloci,2,q)
     gt[4,] <- rbinom(nloci,2,q)
-    gt[7,] <- rbinom(nloci,2,q)
-    gt[9,] <- rbinom(nloci,2,q)
+    gt[8,] <- rbinom(nloci,2,q)
+    gt[11,] <- rbinom(nloci,2,q)
     gt[3,] <- generateOffspring(gt[1,],gt[2,],q=q)
     gt[5,] <- generateOffspring(gt[3,],gt[4,],q=q)
     gt[6,] <- generateOffspring(gt[3,],gt[4,],q=q)
-    gt[8,] <- generateOffspring(gt[6,],gt[7,],q=q)
-    gt[10,] <- generateOffspring(gt[8,],gt[9,],q=q)
-    a<-findRelatives(gt,q=q,nmei=c(1:2))
-	checkIdentical(a$compressedGuess[1,3],"1")
-	checkIdentical(a$compressedGuess[2,3],"1")
-	checkIdentical(a$compressedGuess[1,5],"2")
-	checkIdentical(a$compressedGuess[1,6],"2")
-	checkIdentical(a$compressedGuess[2,5],"2")
-	checkIdentical(a$compressedGuess[2,6],"2")
-	checkIdentical(a$compressedGuess[5,6],"2+2")
+    gt[7,] <- generateOffspring(gt[3,],gt[4,],q=q)
+    gt[9,] <- generateOffspring(gt[7,],gt[8,],q=q)
+    gt[10,] <- generateOffspring(gt[7,],gt[8,],q=q)
+    gt[12,] <- generateOffspring(gt[10,],gt[11,],q=q)
+    gt[13,] <- generateOffspring(gt[10,],gt[11,],q=q)
+    gt[14,] <- gt[13,]
+    aa<-findRelatives(gt,q=q,nmei=c(1:2))
+    checkIdentical(aa$compressedGuess[1,3],"1")
+    checkIdentical(aa$compressedGuess[2,3],"1")
+    checkIdentical(aa$compressedGuess[1,5],"2")
+    checkIdentical(aa$compressedGuess[1,6],"2")
+    checkIdentical(aa$compressedGuess[2,5],"2")
+    checkIdentical(aa$compressedGuess[2,6],"2")
+    checkIdentical(aa$compressedGuess[5,6],"2+2")
+    checkIdentical(aa$compressedGuess[9,10],"2+2")
+    checkIdentical(aa$compressedGuess[13,14],"0")
+	aaPed <- reconstructNPs(aa$guess,sex)
+    realPed <- matrix(c(rep("1",14),1:14,
+                    0,0,1,0,3,3,3,0,7,7,0,10,10,10,
+                    0,0,2,0,4,4,4,0,8,8,0,11,11,11),ncol=4)
+    rownames(realPed) <- c(1:nids)
+    colnames(realPed) <- c("fid","id","father","mother")
+	checkIdentical(aaPed[,colnames(realPed)],realPed)
 }
\ No newline at end of file

Modified: pkg/GenABEL/man/GenABEL-package.Rd
===================================================================
--- pkg/GenABEL/man/GenABEL-package.Rd	2011-03-30 16:33:24 UTC (rev 703)
+++ pkg/GenABEL/man/GenABEL-package.Rd	2011-03-30 23:54:07 UTC (rev 704)
@@ -95,9 +95,9 @@
 \code{\link{mmscore}},
 \code{\link{egscore}},
 \code{\link{ibs}},
-\code{\link{r2fast}},
-\code{\link{dprfast}},
-\code{\link{rhofast}}
+\code{\link{r2fast}} (estimate linkage disequilibrium using R2),
+\code{\link{dprfast}} (estimate linkage disequilibrium using D'),
+\code{\link{rhofast}}  (estimate linkage disequilibrium using 'rho')
 
 For specific tools facilitating analysis of the data with stratification
 (population stratification or (possibly unknown) pedigree structure), see
@@ -114,6 +114,10 @@
 \code{\link{descriptives.trait}},
 \code{\link{descriptives.scan}}.
 
+For functions recunstructing relationships from genomic data, 
+see 
+\code{\link{findRelatives}}, \code{\link{reconstructNPs}}. 
+
 For meta-analysis and related, see help on
 \code{\link{formetascore}}.
 

Modified: pkg/GenABEL/man/descriptives.trait.Rd
===================================================================
--- pkg/GenABEL/man/descriptives.trait.Rd	2011-03-30 16:33:24 UTC (rev 703)
+++ pkg/GenABEL/man/descriptives.trait.Rd	2011-03-30 23:54:07 UTC (rev 704)
@@ -12,7 +12,9 @@
   \item{subset}{Subset of people to run analysis on. 
 		If missing, all people from \code{data} are used for analysis.}
   \item{file}{A string specifying the name of a file to write the tables to (default is no file otput).}
-  \item{by.var}{a binary trait; statistics will be produced seprately for the groups and compared}
+  \item{by.var}{a binary variable or a character scalar specifying the name 
+  of a binary trait in data; statistics will be produced separately for the 
+  groups and compared}
   \item{digits}{number of digits to be printed}
 }
 %\details{
@@ -31,5 +33,9 @@
 	data(srdta)
 	descriptives.trait(srdta)
 	descriptives.trait(srdta,by.var=srdta at phdata$sex)
+	descriptives.trait(srdta,by.var="sex")
+	attach(phdata(srdta))
+	descriptives.trait(srdta,by.var=sex)
+	detach(phdata(srdta))
 }
 \keyword{distribution}

Modified: pkg/GenABEL/man/grammar.Rd
===================================================================
--- pkg/GenABEL/man/grammar.Rd	2011-03-30 16:33:24 UTC (rev 703)
+++ pkg/GenABEL/man/grammar.Rd	2011-03-30 23:54:07 UTC (rev 704)
@@ -88,7 +88,7 @@
 # because this is a population-based study
 data(ge03d2.clean)
 #take half for speed
-ge03d2.clean <- ge03d2.clean[1:450,]
+ge03d2.clean <- ge03d2.clean[1:100,]
 gkin <- ibs(ge03d2.clean,w="freq")
 h2ht <- polygenic(height ~ sex + age,kin=gkin,ge03d2.clean)
 h2ht$est

Modified: pkg/GenABEL/man/mmscore.Rd
===================================================================
--- pkg/GenABEL/man/mmscore.Rd	2011-03-30 16:33:24 UTC (rev 703)
+++ pkg/GenABEL/man/mmscore.Rd	2011-03-30 23:54:07 UTC (rev 704)
@@ -73,7 +73,7 @@
 # because this is a population-based study
 data(ge03d2.clean)
 #take half for speed
-ge03d2.clean <- ge03d2.clean[1:450,]
+ge03d2.clean <- ge03d2.clean[1:100,]
 gkin <- ibs(ge03d2.clean,w="freq")
 h2ht <- polygenic(height ~ sex + age,kin=gkin,ge03d2.clean)
 h2ht$est

Modified: pkg/GenABEL/man/reconstructNPs.Rd
===================================================================
--- pkg/GenABEL/man/reconstructNPs.Rd	2011-03-30 16:33:24 UTC (rev 703)
+++ pkg/GenABEL/man/reconstructNPs.Rd	2011-03-30 23:54:07 UTC (rev 704)
@@ -34,7 +34,7 @@
 sex <- c(1,0,0,1,0,0,0,0)
 names(sex) <- paste("g",c(7:14),sep="")
 gt <- matrix(ncol=nloci,nrow=nids)
-rownames(gt) <- c(7:14)
+rownames(gt) <- paste("g",c(7:14),sep="")
 gt["g7",] <- rbinom(nloci,2,q)
 gt["g8",] <- rbinom(nloci,2,q)
 gt["g11",] <- rbinom(nloci,2,q)


Property changes on: pkg/GenABEL/tests
___________________________________________________________________
Added: svn:ignore
   + test.raw


Added: pkg/GenABEL/tests/test_markers
===================================================================
--- pkg/GenABEL/tests/test_markers	                        (rev 0)
+++ pkg/GenABEL/tests/test_markers	2011-03-30 23:54:07 UTC (rev 704)
@@ -0,0 +1,10 @@
+id chr pos 108313 108410 108480 108661 108681 108696 108702 108714 108720 12160 209287
+200003 9 139906359 AA AG GG AA AA AG AA AG GG AA AG
+200006 9 139926402 GG AG AG GG GG AG GG AG AG GG AG
+200047 2 220084902 AA AA AA AA AA AA AA AA AA AA AA
+200050 2 220089685 GG GG GG GG GG GG GG GG GG GG GG
+200052 2 220074793 TT TT TT TT TT TT TT TT TT TT TT
+200053 2 220075045 AA AA AA AA AA AA AA AA AA AA AA
+200070 0 0 CG CC GG CG GG CC CC CC CG GG CG
+200078 16 16286614 GG GG GG CG CC GG CG GG CG CG CG
+200087 16 16246164 AA AC AA AA AA AC AA AC AA AA AA

Added: pkg/GenABEL/tests/test_phenos
===================================================================
--- pkg/GenABEL/tests/test_phenos	                        (rev 0)
+++ pkg/GenABEL/tests/test_phenos	2011-03-30 23:54:07 UTC (rev 704)
@@ -0,0 +1,12 @@
+id sex age bt
+108313 0 NA 0
+108410 0 NA 0
+108480 0 NA 0
+108661 1 NA 0
+108681 0 6 1
+108696 0 32 1
+108702 0 35 1
+108714 0 33 1
+108720 1 52 1
+12160 0 NA 0
+209287 1 25 1



More information about the Genabel-commits mailing list