[Genabel-commits] r718 - in pkg/GenABEL: . R inst/doc inst/unitTests man tests
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed May 18 01:01:20 CEST 2011
Author: yurii
Date: 2011-05-18 01:01:19 +0200 (Wed, 18 May 2011)
New Revision: 718
Added:
pkg/GenABEL/tests/map.18
pkg/GenABEL/tests/pedin.18
Modified:
pkg/GenABEL/
pkg/GenABEL/CHANGES.LOG
pkg/GenABEL/DESCRIPTION
pkg/GenABEL/NAMESPACE
pkg/GenABEL/R/findRelatives.R
pkg/GenABEL/R/scan.glm.2D.R
pkg/GenABEL/R/scan.glm.R
pkg/GenABEL/R/zzz.R
pkg/GenABEL/generate_documentation.R
pkg/GenABEL/inst/doc/index.html
pkg/GenABEL/inst/unitTests/report.html
pkg/GenABEL/inst/unitTests/report.txt
pkg/GenABEL/inst/unitTests/reportSummary.txt
pkg/GenABEL/inst/unitTests/runit.convert.snp.ped.R
pkg/GenABEL/man/findRelatives.Rd
Log:
Preparing GenABEL v 1.6-7 for CRAN; this release fixes bugs [1398] and [1388]; see CHANGES.LOG for details.
Property changes on: pkg/GenABEL
___________________________________________________________________
Modified: svn:ignore
- .project
+ .project
working_local
Modified: pkg/GenABEL/CHANGES.LOG
===================================================================
--- pkg/GenABEL/CHANGES.LOG 2011-05-16 15:02:35 UTC (rev 717)
+++ pkg/GenABEL/CHANGES.LOG 2011-05-17 23:01:19 UTC (rev 718)
@@ -1,6 +1,15 @@
-*** v. 1.6-7 (2011.05.13)
+*** v. 1.6-7 (2011.05.17)
+Submitted 1.6-7, based on r718, to CRAN
+
+Fixed 'technical' bug [1398] (related to changes in R 2.14):
+https://r-forge.r-project.org/tracker/index.php?func=detail&aid=1398&group_id=505&atid=2058
+
+Set 'GenABEL developers' as a maintainer of the package;
+set the genabel-devel list as 'maintainer' e-mail
+
Fixing bug [1388], added regression test
+https://r-forge.r-project.org/tracker/index.php?func=detail&aid=1388&group_id=505&atid=2058
upgrade version number
@@ -8,9 +17,6 @@
*** v. 1.6-6 (2011.04.29)
-Nicola Prirastu added LiLog and LiLogCC: procedures facilitating
-analysis of binary outcomes using mixed models.
-
Added Xia Shen's procedure 'polygenic_hglm'. Features: quick
convergence, standard errors for fixed effects.
Modified: pkg/GenABEL/DESCRIPTION
===================================================================
--- pkg/GenABEL/DESCRIPTION 2011-05-16 15:02:35 UTC (rev 717)
+++ pkg/GenABEL/DESCRIPTION 2011-05-17 23:01:19 UTC (rev 718)
@@ -2,9 +2,9 @@
Type: Package
Title: genome-wide SNP association analysis
Version: 1.6-7
-Date: 2011-05-13
-Author: Yurii Aulchenko et al.
-Maintainer: Yurii Aulchenko <i.aoultchenko at erasmusmc.nl>
+Date: 2011-05-17
+Author: GenABEL developers
+Maintainer: GenABEL developers <genabel-devel at r-forge.r-project.org>
Depends: R (>= 2.10.0), methods, MASS
Suggests: qvalue, genetics, haplo.stats, DatABEL (>= 0.9-0), hglm, MetABEL, PredictABEL
Description: a package for genome-wide association analysis between
Modified: pkg/GenABEL/NAMESPACE
===================================================================
--- pkg/GenABEL/NAMESPACE 2011-05-16 15:02:35 UTC (rev 717)
+++ pkg/GenABEL/NAMESPACE 2011-05-17 23:01:19 UTC (rev 718)
@@ -64,6 +64,8 @@
ibs.old,
impute2databel,
impute2mach,
+ #LiLogCC,
+ #LiLog,
load.gwaa.data,
mach2databel,
makeTransitionMatrix,
Modified: pkg/GenABEL/R/findRelatives.R
===================================================================
--- pkg/GenABEL/R/findRelatives.R 2011-05-16 15:02:35 UTC (rev 717)
+++ pkg/GenABEL/R/findRelatives.R 2011-05-17 23:01:19 UTC (rev 718)
@@ -93,6 +93,8 @@
#' # look only for 1st and 2nd degree relatives
#' relInfo1 <- findRelatives(df[27:30],q=eaf,gkinCutOff=-1,nmeivec=c(1,2,3))
#' relInfo1
+#' relInfoVS <- findRelatives(df[27:30,],q=eaf,nmeivec=c(1:6),vsIDs=idnames(df[27:30,])[1:2])
+#' relInfoVS
#'
findRelatives <- function(gtdata,nmeivec=c(1:2),q=NULL,epsilon=0.01,
quiet=FALSE,OddsVsNull=1000,OddsVsNextBest=100,
@@ -123,18 +125,20 @@
warning('"q" is not specified; inferring from data')
}
# set vsIDs if used
- if (!is.null(vsIDs)) if (is.character(vsIDs)) {
+ if (!is.null(vsIDs)) {
+ if (is.character(vsIDs)) {
if (!all(vsIDs %in% idnam)) stop("can not find some of vsIDs")
vsIDs <- which(idnam %in% vsIDs)
if (length(vsIDs)>1) {ma <- max(vsIDs); mi <- min(vsIDs)}
else ma <- mi <- vsIDs
if (ma>dim(gtdata)[1] || mi<1) stop("vsIDs out of range")
}
-
+ notVsIDs <- c(1:dim(gtdata)[1])[which(!(c(1:dim(gtdata)[1]) %in% vsIDs))]
+ }
# get gkin if used
lengthOut <- dim(gtdata)[1]
if (is.null(vsIDs)) lengthOut <- lengthOut*(lengthOut-1)/2
- else lengthOut <- (lengthOut-1)*length(vsIDs)
+ else lengthOut <- (lengthOut-length(vsIDs))*length(vsIDs)
if (!is.null(gkinCutOff)) {
if (is.null(kinshipMatrix)) {
if (is(gtdata,"snp.data")) {
@@ -156,12 +160,21 @@
testUs <- as.vector(kinshipMatrix[lower.tri(kinshipMatrix)])
testUs <- (testUs>gkinCutOff)
} else {
- testUs <- c()
- for (jj in vsIDs) {
- testUs <- c(testUs,as.vector((kinshipMatrix[jj,])[1:(jj-1)]),
- as.vector((kinshipMatrix[,jj])[c((jj+1):dim(kinshipMatrix)[1])]))
- }
- #print(testUs)
+# testUs <- c()
+# for (jj in vsIDs) {
+# if (jj>1)
+# testUs <- c(testUs,as.vector((kinshipMatrix[jj,])[1:(jj-1)]),
+# as.vector((kinshipMatrix[,jj])[c((jj+1):dim(kinshipMatrix)[1])]))
+# else
+# testUs <- c(testUs,
+# as.vector((kinshipMatrix[,jj])[c((jj+1):dim(kinshipMatrix)[1])]))
+# testUs <-
+# print(jj)
+# print(testUs)
+# }
+ kinshipMatrix[upper.tri(kinshipMatrix)] <- t(kinshipMatrix)[upper.tri(kinshipMatrix)]
+ testUs <- kinshipMatrix[vsIDs,notVsIDs]
+# print(testUs)
testUs <- (testUs>gkinCutOff)
}
if (length(testUs) != lengthOut)
@@ -209,9 +222,10 @@
gt1 <- gtdata[id1,]
bgt1 <- blurGenotype(gt1,q=q,epsilon=epsilon)
if (is.null(vsIDs)) id2list <- (id1+1):dim(gtdata)[1]
- else id2list <- c(c(1:(id1-1)),c((id1+1):dim(gtdata)[1]))
+ else id2list <- notVsIDs #c(c(1:(id1-1)),c((id1+1):dim(gtdata)[1]))
for (id2 in id2list) {
name2 <- idnam[id2]
+ #print(id1,id2)
#print(c(outI,testUs))
if (testUs[outI]) {
if (class(gtdata) == "snp.data")
@@ -246,21 +260,33 @@
if (!quiet) cat("\n")
#print(out)
meiMtmp <- apply(out,MAR=1,FUN=function(x){return(which.max(x))})
- #print(relMtmp)
- meiM <- matrix(ncol=dim(gtdata)[1],nrow=dim(gtdata)[1])
- diag(meiM) <- 0
#print(meiMtmp)
- meiM[lower.tri(meiM)] <- names(meiTab)[meiMtmp]
- meiM[upper.tri(meiM)] <- t(meiM)[upper.tri(meiM)]
- colnames(meiM) <- rownames(meiM) <- idnam
+ if (is.null(vsIDs)) {
+ meiM <- matrix(ncol=dim(gtdata)[1],nrow=dim(gtdata)[1])
+ diag(meiM) <- 0
+ meiM[lower.tri(meiM)] <- names(meiTab)[meiMtmp]
+ meiM[upper.tri(meiM)] <- t(meiM)[upper.tri(meiM)]
+ colnames(meiM) <- rownames(meiM) <- idnam
+ } else {
+ meiM <- matrix(ncol=length(notVsIDs),nrow=length(vsIDs))
+ meiM[] <- names(meiTab)[meiMtmp]
+ rownames(meiM) <- idnam[vsIDs]
+ colnames(meiM) <- idnam[notVsIDs]
+ }
+ #print(meiM)
firstBestLik <- apply(out,MAR=1,FUN=function(x){return(max(x))})
which_firstBestLik <- apply(out,MAR=1,FUN=function(x){return(which.max(x))})
secondBestLik <- apply(out,MAR=1,FUN=function(x){x[order(x,decreasing=TRUE)[2]]})
cndX <- !(exp(firstBestLik-secondBestLik)>OddsVsNextBest
& exp(firstBestLik)>OddsVsNull & (which_firstBestLik != (length(meiTab)-1)))
- cnd <- diag(FALSE,dim(gtdata)[1],nrow=dim(gtdata)[1])
- cnd[lower.tri(cnd)] <- cndX
- cnd[upper.tri(cnd)] <- t(cnd)[upper.tri(cnd)]
+ if (is.null(vsIDs)) {
+ cnd <- diag(FALSE,dim(gtdata)[1],nrow=dim(gtdata)[1])
+ cnd[lower.tri(cnd)] <- cndX
+ cnd[upper.tri(cnd)] <- t(cnd)[upper.tri(cnd)]
+ } else {
+ cnd <- matrix(ncol=length(notVsIDs),nrow=length(vsIDs))
+ cnd[] <- cndX
+ }
guess <- meiM
guess[which(cnd==1)] <- NA
out <- data.frame(outN1,outN2,out,stringsAsFactors=FALSE)
Modified: pkg/GenABEL/R/scan.glm.2D.R
===================================================================
--- pkg/GenABEL/R/scan.glm.2D.R 2011-05-16 15:02:35 UTC (rev 717)
+++ pkg/GenABEL/R/scan.glm.2D.R 2011-05-17 23:01:19 UTC (rev 718)
@@ -1,146 +1,146 @@
"scan.glm.2D" <-
-function (formula, family = gaussian(), data, snpsubset, idsubset, bcast=50) {
- if (!is(data,"gwaa.data")) {
- stop("wrong data class: should be gwaa.data")
- }
- if (!is.character(formula)) stop("formula must be character object (apply \"s)")
- if (is.character(family))
- family <- get(family, mode = "function", envir = parent.frame())
- if (is.function(family))
- family <- family()
- if (is.null(family$family)) {
- print(family)
- stop("'family' not recognized")
- }
- if (grep("CRSNP",formula,ignore.case=TRUE)!=1) stop("formula must contain CRSNP variable to be replaced with the analysis SNPs")
- if (missing(snpsubset)) snpsubset <- data at gtdata@snpnames
- if (missing(idsubset)) idsubset <- data at gtdata@idnames
- if (is.logical(snpsubset) || is.numeric(snpsubset)) snpsubset <- data at gtdata@snpnames[snpsubset]
- gtdata <- data[idsubset,snpsubset]@gtdata
- phdata <- data[idsubset,snpsubset]@phdata
- allnams <- gtdata at snpnames
- chsize <- ceiling(length(allnams)/80)
- ch <- list()
- if(chsize != 1) {
- chunks <- ceiling(length(allnams)/chsize)-1
- for (i in 1:chunks) {
- ch[[i]] = allnams[((i-1)*chsize+1):(i*chsize)]
- }
- ch[[chunks+1]] = allnams[(chunks*chsize+1):length(allnams)]
- } else {ch[[1]] <- allnams;chunks=0}
-
- fla2 <- as.formula(sub("CRSNP","as.factor(mygt1)*as.factor(mygt2)",formula,ignore.case=TRUE))
- fla2.i0 <- as.formula(sub("CRSNP","as.factor(mygt1)+as.factor(mygt2)",formula,ignore.case=TRUE))
- fla2.1 <- as.formula(sub("CRSNP","as.factor(mygt1)*mygt2",formula,ignore.case=TRUE))
- fla2.1.i0 <- as.formula(sub("CRSNP","as.factor(mygt1)+mygt2",formula,ignore.case=TRUE))
- fla2.2 <- as.formula(sub("CRSNP","mygt1*as.factor(mygt2)",formula,ignore.case=TRUE))
- fla2.2.i0 <- as.formula(sub("CRSNP","mygt1+as.factor(mygt2)",formula,ignore.case=TRUE))
- fla1 <- as.formula(sub("CRSNP","mygt1*mygt2",formula,ignore.case=TRUE))
- fla1.i0 <- as.formula(sub("CRSNP","mygt1+mygt2",formula,ignore.case=TRUE))
- fla0 <- as.formula(sub("CRSNP","DuMmY1*DuMmY2",formula,ignore.case=TRUE))
-
- nsnps <- gtdata at nsnps
- P1df <- matrix(rep(NA,(nsnps*nsnps)),nrow=nsnps)
- P2df <- P1df
- Pint1df <- P1df
- Pint2df <- P1df
+ function (formula, family = gaussian(), data, snpsubset, idsubset, bcast=50) {
+ if (!is(data,"gwaa.data")) {
+ stop("wrong data class: should be gwaa.data")
+ }
+ if (!is.character(formula)) stop("formula must be character object (apply \"s)")
+ if (is.character(family))
+ family <- get(family, mode = "function", envir = parent.frame())
+ if (is.function(family))
+ family <- family()
+ if (is.null(family$family)) {
+ print(family)
+ stop("'family' not recognized")
+ }
+ if (grep("CRSNP",formula,ignore.case=TRUE)!=1) stop("formula must contain CRSNP variable to be replaced with the analysis SNPs")
+ if (missing(snpsubset)) snpsubset <- data at gtdata@snpnames
+ if (missing(idsubset)) idsubset <- data at gtdata@idnames
+ if (is.logical(snpsubset) || is.numeric(snpsubset)) snpsubset <- data at gtdata@snpnames[snpsubset]
+ gtdata <- data[idsubset,snpsubset]@gtdata
+ phdata <- data[idsubset,snpsubset]@phdata
+ allnams <- gtdata at snpnames
+ chsize <- ceiling(length(allnams)/80)
+ ch <- list()
+ if(chsize != 1) {
+ chunks <- ceiling(length(allnams)/chsize)-1
+ for (i in 1:chunks) {
+ ch[[i]] = allnams[((i-1)*chsize+1):(i*chsize)]
+ }
+ ch[[chunks+1]] = allnams[(chunks*chsize+1):length(allnams)]
+ } else {ch[[1]] <- allnams;chunks=0}
+
+ fla2 <- as.formula(sub("CRSNP","as.factor(mygt1)*as.factor(mygt2)",formula,ignore.case=TRUE))
+ fla2.i0 <- as.formula(sub("CRSNP","as.factor(mygt1)+as.factor(mygt2)",formula,ignore.case=TRUE))
+ fla2.1 <- as.formula(sub("CRSNP","as.factor(mygt1)*mygt2",formula,ignore.case=TRUE))
+ fla2.1.i0 <- as.formula(sub("CRSNP","as.factor(mygt1)+mygt2",formula,ignore.case=TRUE))
+ fla2.2 <- as.formula(sub("CRSNP","mygt1*as.factor(mygt2)",formula,ignore.case=TRUE))
+ fla2.2.i0 <- as.formula(sub("CRSNP","mygt1+as.factor(mygt2)",formula,ignore.case=TRUE))
+ fla1 <- as.formula(sub("CRSNP","mygt1*mygt2",formula,ignore.case=TRUE))
+ fla1.i0 <- as.formula(sub("CRSNP","mygt1+mygt2",formula,ignore.case=TRUE))
+ fla0 <- as.formula(sub("CRSNP","DuMmY1*DuMmY2",formula,ignore.case=TRUE))
+
+ nsnps <- gtdata at nsnps
+ P1df <- matrix(rep(NA,(nsnps*nsnps)),nrow=nsnps)
+ P2df <- P1df
+ Pint1df <- P1df
+ Pint2df <- P1df
# print(ch)
-
- donan<-0
- for (i1 in 1:(length(snpsubset)-1)) {
- for (i2 in (i1+1):length(snpsubset)) {
- mygt1 <- as.numeric(gtdata[,snpsubset[i1]])
- mygt2 <- as.numeric(gtdata[,snpsubset[i2]])
- polym1 <- length(levels(as.factor(mygt1)))
- polym2 <- length(levels(as.factor(mygt2)))
- if (polym1<=1 || polym2<=1) {
- cat("One of markers",snpsubset[i1],snpsubset[i2],"is (are) monomorphic; skipping in analysis\n")
- P1df[i1,i2]=1.0
- P2df[i1,i2]=1.0
- Pint1df[i1,i2]=1.0
- Pint2df[i1,i2]=1.0
- } else {
- DuMmY1 <- rep(0,length(mygt1))
- DuMmY1 <- replace(DuMmY1,is.na(mygt1),NA)
- DuMmY2 <- rep(0,length(mygt2))
- DuMmY2 <- replace(DuMmY2,is.na(mygt2),NA)
- if (family$family != "gaussian") {
- m1 <- glm(fla1,family = family,data=phdata)
- m1.i0 <- glm(fla1.i0,family = family,data=phdata)
- if (polym1>2 && polym2>2) {
- m2 <- glm(fla2,family = family,data=phdata)
- m2.i0 <- glm(fla2.i0,family = family,data=phdata)
- } else if (polym1>2) {
- m2 <- glm(fla2.1,family = family,data=phdata)
- m2.i0 <- glm(fla2.1.i0,family = family,data=phdata)
- } else if (polym2>2) {
- m2 <- glm(fla2.2,family = family,data=phdata)
- m2.i0 <- glm(fla2.2.i0,family = family,data=phdata)
- } else {
- m2 <- m1
- m2.i0 <- m1.i0
- }
- m0 <- glm(fla0,family = family,data=phdata)
- anv1 <- anova(m0,m1,test="Chisq")
- anv2 <- anova(m0,m2,test="Chisq")
- anv1.i <- anova(m1.i0,m1,test="Chisq")
- anv2.i <- anova(m2.i0,m2,test="Chisq")
- P1df[i1,i2] <- anv1$"P(>|Chi|)"[2]
- P2df[i1,i2] <- anv2$"P(>|Chi|)"[2]
- Pint1df[i1,i2] <- anv1.i$"P(>|Chi|)"[2]
- Pint2df[i1,i2] <- anv2.i$"P(>|Chi|)"[2]
- if (is.na(P1df[i1,i2])) P1df[i1,i2] = 1.0
- if (is.na(P2df[i1,i2])) P2df[i1,i2] = 1.0
- if (is.na(Pint1df[i1,i2])) Pint1df[i1,i2] = 1.0
- if (is.na(Pint2df[i1,i2])) Pint2df[i1,i2] = 1.0
- } else {
- m1 <- lm(fla1,data=phdata)
- m1.i0 <- lm(fla1.i0,data=phdata)
- if (polym1>2 && polym2>2) {
- m2 <- lm(fla2,data=phdata)
- m2.i0 <- lm(fla2.i0,data=phdata)
- } else if (polym1>2) {
- m2 <- lm(fla2.1,data=phdata)
- m2.i0 <- lm(fla2.1.i0,data=phdata)
- } else if (polym2>2) {
- m2 <- lm(fla2.2,data=phdata)
- m2.i0 <- lm(fla2.2.i0,data=phdata)
- } else {
- m2 <- m1
- m2.i0 <- m1.i0
- }
- m0 <- lm(fla0,data=phdata)
- anv1 <- anova(m0,m1,test="Chisq")
- anv2 <- anova(m0,m2,test="Chisq")
- anv1.i <- anova(m1.i0,m1,test="Chisq")
- anv2.i <- anova(m2.i0,m2,test="Chisq")
- P1df[i1,i2] <- anv1$"P(>|Chi|)"[2]
- P2df[i1,i2] <- anv2$"P(>|Chi|)"[2]
- Pint1df[i1,i2] <- anv1.i$"P(>|Chi|)"[2]
- Pint2df[i1,i2] <- anv2.i$"P(>|Chi|)"[2]
- if (is.na(P1df[i1,i2])) P1df[i1,i2] = 1.0
- if (is.na(P2df[i1,i2])) P2df[i1,i2] = 1.0
- if (is.na(Pint1df[i1,i2])) Pint1df[i1,i2] = 1.0
- if (is.na(Pint2df[i1,i2])) Pint2df[i1,i2] = 1.0
- }
- }
- donan<-donan+1
- if (bcast && round((donan)/bcast) == (donan)/bcast) {
- cat("\b\b\b\b\b\b\b\b",round(100*donan/((nsnps-1)*nsnps/2),digits=2),"%",sep="");
- flush.console();
+
+ donan<-0
+ for (i1 in 1:(length(snpsubset)-1)) {
+ for (i2 in (i1+1):length(snpsubset)) {
+ mygt1 <- as.numeric(gtdata[,snpsubset[i1]])
+ mygt2 <- as.numeric(gtdata[,snpsubset[i2]])
+ polym1 <- length(levels(as.factor(mygt1)))
+ polym2 <- length(levels(as.factor(mygt2)))
+ if (polym1<=1 || polym2<=1) {
+ cat("One of markers",snpsubset[i1],snpsubset[i2],"is (are) monomorphic; skipping in analysis\n")
+ P1df[i1,i2]=1.0
+ P2df[i1,i2]=1.0
+ Pint1df[i1,i2]=1.0
+ Pint2df[i1,i2]=1.0
+ } else {
+ DuMmY1 <- rep(0,length(mygt1))
+ DuMmY1 <- replace(DuMmY1,is.na(mygt1),NA)
+ DuMmY2 <- rep(0,length(mygt2))
+ DuMmY2 <- replace(DuMmY2,is.na(mygt2),NA)
+ if (family$family != "gaussian") {
+ m1 <- glm(fla1,family = family,data=phdata)
+ m1.i0 <- glm(fla1.i0,family = family,data=phdata)
+ if (polym1>2 && polym2>2) {
+ m2 <- glm(fla2,family = family,data=phdata)
+ m2.i0 <- glm(fla2.i0,family = family,data=phdata)
+ } else if (polym1>2) {
+ m2 <- glm(fla2.1,family = family,data=phdata)
+ m2.i0 <- glm(fla2.1.i0,family = family,data=phdata)
+ } else if (polym2>2) {
+ m2 <- glm(fla2.2,family = family,data=phdata)
+ m2.i0 <- glm(fla2.2.i0,family = family,data=phdata)
+ } else {
+ m2 <- m1
+ m2.i0 <- m1.i0
+ }
+ m0 <- glm(fla0,family = family,data=phdata)
+ anv1 <- anova(m0,m1,test="Chisq")
+ anv2 <- anova(m0,m2,test="Chisq")
+ anv1.i <- anova(m1.i0,m1,test="Chisq")
+ anv2.i <- anova(m2.i0,m2,test="Chisq")
+ P1df[i1,i2] <- anv1[2, grep("^P.*Chi",names(anv1))]
+ P2df[i1,i2] <- anv2[2, grep("^P.*Chi",names(anv2))]
+ Pint1df[i1,i2] <- anv1.i[2, grep("^P.*Chi",names(anv1.i))]
+ Pint2df[i1,i2] <- anv2.i[2, grep("^P.*Chi",names(anv2.i))]
+ if (is.na(P1df[i1,i2])) P1df[i1,i2] = 1.0
+ if (is.na(P2df[i1,i2])) P2df[i1,i2] = 1.0
+ if (is.na(Pint1df[i1,i2])) Pint1df[i1,i2] = 1.0
+ if (is.na(Pint2df[i1,i2])) Pint2df[i1,i2] = 1.0
+ } else {
+ m1 <- lm(fla1,data=phdata)
+ m1.i0 <- lm(fla1.i0,data=phdata)
+ if (polym1>2 && polym2>2) {
+ m2 <- lm(fla2,data=phdata)
+ m2.i0 <- lm(fla2.i0,data=phdata)
+ } else if (polym1>2) {
+ m2 <- lm(fla2.1,data=phdata)
+ m2.i0 <- lm(fla2.1.i0,data=phdata)
+ } else if (polym2>2) {
+ m2 <- lm(fla2.2,data=phdata)
+ m2.i0 <- lm(fla2.2.i0,data=phdata)
+ } else {
+ m2 <- m1
+ m2.i0 <- m1.i0
+ }
+ m0 <- lm(fla0,data=phdata)
+ anv1 <- anova(m0,m1,test="Chisq")
+ anv2 <- anova(m0,m2,test="Chisq")
+ anv1.i <- anova(m1.i0,m1,test="Chisq")
+ anv2.i <- anova(m2.i0,m2,test="Chisq")
+ P1df[i1,i2] <- anv1[2, grep("^P.*Chi",names(anv1))]
+ P2df[i1,i2] <- anv2[2, grep("^P.*Chi",names(anv2))]
+ Pint1df[i1,i2] <- anv1.i[2, grep("^P.*Chi",names(anv1.i))]
+ Pint2df[i1,i2] <- anv2.i[2, grep("^P.*Chi",names(anv2.i))]
+ if (is.na(P1df[i1,i2])) P1df[i1,i2] = 1.0
+ if (is.na(P2df[i1,i2])) P2df[i1,i2] = 1.0
+ if (is.na(Pint1df[i1,i2])) Pint1df[i1,i2] = 1.0
+ if (is.na(Pint2df[i1,i2])) Pint2df[i1,i2] = 1.0
+ }
+ }
+ donan<-donan+1
+ if (bcast && round((donan)/bcast) == (donan)/bcast) {
+ cat("\b\b\b\b\b\b\b\b",round(100*donan/((nsnps-1)*nsnps/2),digits=2),"%",sep="");
+ flush.console();
+ }
}
- }
- }
- if (bcast && donan>=bcast) cat("\n")
-
- map <- gtdata at map
- chromosome <- gtdata at chromosome
- med1df <- median(qchisq(1.-P1df,df=1))
- med2df <- median(qchisq(1.-P2df,df=2))
- colnames(P1df) <- snpsubset
- rownames(P1df) <- snpsubset #[length(snpsubset):1]
- out <- list(P1df = P1df, Pint1df=Pint1df, P2df=P2df, Pint2df=Pint2df, medChi1df = med1df, medChi2df = med2df, snpnames = snpsubset, idnames = idsubset, formula = match.call(), family = family, map = map, chromosome = chromosome)
- out$Pc1df <- rep(NA,length(P1df))
- class(out) <- "scan.gwaa.2D"
- out
+ }
+ if (bcast && donan>=bcast) cat("\n")
+
+ map <- gtdata at map
+ chromosome <- gtdata at chromosome
+ med1df <- median(qchisq(1.-P1df,df=1))
+ med2df <- median(qchisq(1.-P2df,df=2))
+ colnames(P1df) <- snpsubset
+ rownames(P1df) <- snpsubset #[length(snpsubset):1]
+ out <- list(P1df = P1df, Pint1df=Pint1df, P2df=P2df, Pint2df=Pint2df, medChi1df = med1df, medChi2df = med2df, snpnames = snpsubset, idnames = idsubset, formula = match.call(), family = family, map = map, chromosome = chromosome)
+ out$Pc1df <- rep(NA,length(P1df))
+ class(out) <- "scan.gwaa.2D"
+ out
}
Modified: pkg/GenABEL/R/scan.glm.R
===================================================================
--- pkg/GenABEL/R/scan.glm.R 2011-05-16 15:02:35 UTC (rev 717)
+++ pkg/GenABEL/R/scan.glm.R 2011-05-17 23:01:19 UTC (rev 718)
@@ -62,8 +62,8 @@
m0 <- glm(fla0,family = family,data=phdata)
anv1 <- anova(m0,m1,test="Chisq")
anv2 <- anova(m0,m2,test="Chisq")
- P1df[(w-1)*chsize+i] <- anv1$"P(>|Chi|)"[2]
- P2df[(w-1)*chsize+i] <- anv2$"P(>|Chi|)"[2]
+ P1df[(w-1)*chsize+i] <- anv1[2, grep("^P.*Chi",names(anv1))]
+ P2df[(w-1)*chsize+i] <- anv2[2, grep("^P.*Chi",names(anv2))]
if (polym>2) {
effB[(w-1)*chsize+i] <- m1$coeff["mygt"]
effAB[(w-1)*chsize+i] <- m1$coeff["as.factor(mygt)1"]
@@ -85,8 +85,8 @@
m0 <- lm(fla0,data=phdata)
anv1 <- anova(m0,m1,test="Chisq")
anv2 <- anova(m0,m2,test="Chisq")
- P1df[(w-1)*chsize+i] <- anv1$"P(>|Chi|)"[2]
- P2df[(w-1)*chsize+i] <- anv2$"P(>|Chi|)"[2]
+ P1df[(w-1)*chsize+i] <- anv1[2, grep("^P.*Chi",names(anv1))]
+ P2df[(w-1)*chsize+i] <- anv2[2, grep("^P.*Chi",names(anv2))]
if (polym>2) {
effB[(w-1)*chsize+i] <- m1$coeff["mygt"]
effAB[(w-1)*chsize+i] <- m1$coeff["as.factor(mygt)1"]
Modified: pkg/GenABEL/R/zzz.R
===================================================================
--- pkg/GenABEL/R/zzz.R 2011-05-16 15:02:35 UTC (rev 717)
+++ pkg/GenABEL/R/zzz.R 2011-05-17 23:01:19 UTC (rev 718)
@@ -1,6 +1,6 @@
.onLoad <- function(lib, pkg) {
GenABEL.version <- "1.6-7"
- cat("GenABEL v.",GenABEL.version,"(May 13, 2011) loaded\n")
+ cat("GenABEL v.",GenABEL.version,"(May 17, 2011) loaded\n")
# check for updates and news
address <- c(
Modified: pkg/GenABEL/generate_documentation.R
===================================================================
--- pkg/GenABEL/generate_documentation.R 2011-05-16 15:02:35 UTC (rev 717)
+++ pkg/GenABEL/generate_documentation.R 2011-05-17 23:01:19 UTC (rev 718)
@@ -13,6 +13,8 @@
"getLogLikelihoodGivenRelation.R",
"impute2databel.R",
"impute2mach.R",
+ #"LiLogCC.R",
+ #"LiLog.R",
"mach2databel.R",
"makeTransitionMatrix.R",
#"phdata.R",
Modified: pkg/GenABEL/inst/doc/index.html
===================================================================
--- pkg/GenABEL/inst/doc/index.html 2011-05-16 15:02:35 UTC (rev 717)
+++ pkg/GenABEL/inst/doc/index.html 2011-05-17 23:01:19 UTC (rev 718)
@@ -1,3 +1,3 @@
-<a href="ABEL-tutorial.pdf">ABEL tutorial</a>: Using GenABEL for genome wide association analysis
+<a href="ABEL-tutorial.pdf">GenABEL tutorial</a>: Using GenABEL for genome wide association analysis
<br>
<a href="GenABEL-manual.pdf">GenABEL manual</a>: GenABEL reference manual
Modified: pkg/GenABEL/inst/unitTests/report.html
===================================================================
--- pkg/GenABEL/inst/unitTests/report.html 2011-05-16 15:02:35 UTC (rev 717)
+++ pkg/GenABEL/inst/unitTests/report.html 2011-05-17 23:01:19 UTC (rev 718)
@@ -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--Thu Mar 31 00:50:19 2011</title>
+<html><head><title>RUNIT TEST PROTOCOL--Tue May 17 20:27:16 2011</title>
</head>
-<body><h1 TRUE>RUNIT TEST PROTOCOL--Thu Mar 31 00:50:19 2011</h1>
-<p>Number of test functions: 7</p>
+<body><h1 TRUE>RUNIT TEST PROTOCOL--Tue May 17 20:27:16 2011</h1>
+<p>Number of test functions: 9</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>7</td>
+<td>9</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.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>
+</a>Test function regexp: ^test.+<br/>Test file regexp: ^runit.+\.[rR]$<br/>Involved directory:<br/>/Users/yuriiaulchenko/eclipse_workspace/genabel/pkg/GenABEL/tests/../inst/unitTests<br/><ul><li><a href="/Users/yuriiaulchenko/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_yuriiaulchenko_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.02 seconds)<br/></a></li></ul></li><li><a href="/Users/yuriiaulchenko/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_yuriiaulchenko_eclipse_workspace_genabel_pkg_GenABEL_tests_.._inst_unitTests_runit.descriptives.trait.R_test.descriptives.trait">test.descriptives.trait: (1 checks) ... OK (0.76 seconds)<br/></a></li></ul></li><li><a href="/Users/yuriiaulchenko/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_yuriiaulchenko_eclipse_workspace_genabel_pkg_GenABEL_tests_.._inst_unitTests_runit.findRelatives.R_test.findRelatives">test.findRelatives: (10 checks) ... OK (106.44 seconds)<br/></a></li></ul></li><li><a href="/Users/yuriiaulchenko/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_yuriiaulchenko_eclipse_workspace_genabel_pkg_GenABEL_tests_.._inst_unitTests_runit.impute2xxx.R_test.impute2databel">test.impute2databel: (23 checks) ... OK (0.74 seconds)<br/></a></li></ul></li><li><a href="/Users/yuriiaulchenko/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_yuriiaulchenko_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/yuriiaulchenko/eclipse_workspace/genabel/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_genabel_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_genabel_pkg_GenABEL_tests_.._inst_unitTests_runit.iterator.R_test.summary_snp_data">test.summary_snp_data: (3 checks) ... OK (8.06 seconds)<br/></a></li></ul></li><li><a href="/Users/yuriiaulchenko/eclipse_workspace/genabel/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_genabel_pkg_GenABEL_tests_.._inst_unitTests_runit.mach2databel.R_test.mach2databel">test.mach2databel: (8 checks) ... OK (0.25 seconds)<br/></a></li></ul></li><li><a href="/Users/yuriiaulchenko/eclipse_workspace/genabel/pkg/GenABEL/tests/../inst/unitTests/runit.polylik.R">Test file: runit.polylik.R</a><ul><li><a name="GenABEL unit testing__Users_yuriiaulchenko_eclipse_workspace_genabel_pkg_GenABEL_tests_.._inst_unitTests_runit.polylik.R_test.polylik">test.polylik: (6 checks) ... OK (15.03 seconds)<br/></a></li></ul></li></ul><hr>
<table border="0" width="80%" >
<tr><th>Name</th>
<th>Value</th>
@@ -47,28 +47,28 @@
<td>2</td>
</tr>
<tr><td>minor</td>
-<td>13.0</td>
+<td>14.0</td>
</tr>
<tr><td>year</td>
<td>2011</td>
</tr>
<tr><td>month</td>
-<td>01</td>
+<td>05</td>
</tr>
<tr><td>day</td>
-<td>26</td>
+<td>16</td>
</tr>
<tr><td>svn rev</td>
-<td>54118</td>
+<td>55928</td>
</tr>
<tr><td>language</td>
<td>R</td>
</tr>
<tr><td>version.string</td>
-<td>R version 2.13.0 Under development (unstable) (2011-01-26 r54118)</td>
+<td>R version 2.14.0 Under development (unstable) (2011-05-16 r55928)</td>
</tr>
<tr><td>host</td>
-<td>new-host.home</td>
+<td>yurii-aulchenkos-macbook-2.local</td>
</tr>
<tr><td>compiler</td>
<td>g++</td>
Modified: pkg/GenABEL/inst/unitTests/report.txt
===================================================================
--- pkg/GenABEL/inst/unitTests/report.txt 2011-05-16 15:02:35 UTC (rev 717)
+++ pkg/GenABEL/inst/unitTests/report.txt 2011-05-17 23:01:19 UTC (rev 718)
@@ -1,12 +1,12 @@
-RUNIT TEST PROTOCOL -- Thu Mar 31 00:50:19 2011
+RUNIT TEST PROTOCOL -- Tue May 17 20:27:16 2011
***********************************************
-Number of test functions: 7
+Number of test functions: 9
Number of errors: 0
Number of failures: 0
1 Test Suite :
-GenABEL unit testing - 7 test functions, 0 errors, 0 failures
+GenABEL unit testing - 9 test functions, 0 errors, 0 failures
@@ -16,23 +16,29 @@
Test function regexp: ^test.+
Test file regexp: ^runit.+\.[rR]$
Involved directory:
-/Users/yuriiaulchenko/eclipse_workspace/pkg/GenABEL/tests/../inst/unitTests
+/Users/yuriiaulchenko/eclipse_workspace/genabel/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/genabel/pkg/GenABEL/tests/../inst/unitTests/runit.convert.snp.ped.R
+test.convert.snp.ped: (0 checks) ... OK (0.02 seconds)
---------------------------
-Test file: /Users/yuriiaulchenko/eclipse_workspace/pkg/GenABEL/tests/../inst/unitTests/runit.findRelatives.R
-test.findRelatives: (10 checks) ... OK (119.15 seconds)
+Test file: /Users/yuriiaulchenko/eclipse_workspace/genabel/pkg/GenABEL/tests/../inst/unitTests/runit.descriptives.trait.R
+test.descriptives.trait: (1 checks) ... OK (0.76 seconds)
---------------------------
-Test file: /Users/yuriiaulchenko/eclipse_workspace/pkg/GenABEL/tests/../inst/unitTests/runit.impute2xxx.R
-test.impute2databel: (23 checks) ... OK (0.55 seconds)
+Test file: /Users/yuriiaulchenko/eclipse_workspace/genabel/pkg/GenABEL/tests/../inst/unitTests/runit.findRelatives.R
+test.findRelatives: (10 checks) ... OK (106.44 seconds)
---------------------------
-Test file: /Users/yuriiaulchenko/eclipse_workspace/pkg/GenABEL/tests/../inst/unitTests/runit.impute2xxx_large.R
+Test file: /Users/yuriiaulchenko/eclipse_workspace/genabel/pkg/GenABEL/tests/../inst/unitTests/runit.impute2xxx.R
+test.impute2databel: (23 checks) ... OK (0.74 seconds)
+---------------------------
+Test file: /Users/yuriiaulchenko/eclipse_workspace/genabel/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 file: /Users/yuriiaulchenko/eclipse_workspace/genabel/pkg/GenABEL/tests/../inst/unitTests/runit.iterator.R
test.qtscore: (0 checks) ... OK (0 seconds)
-test.summary_snp_data: (3 checks) ... OK (8.58 seconds)
+test.summary_snp_data: (3 checks) ... OK (8.06 seconds)
---------------------------
-Test file: /Users/yuriiaulchenko/eclipse_workspace/pkg/GenABEL/tests/../inst/unitTests/runit.mach2databel.R
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/genabel -r 718
More information about the Genabel-commits
mailing list