version 0.7.2

DESCRIPTION

@@ -1,17 +1,17 @@
 Package: qtlhot
-Version: 0.7.0
-Date: 2012-10-23
+Version: 0.7.2
+Date: 2012-11-07
 Author: Elias Chaibub Neto <echaibub@hotmail.com> and Brian S Yandell
         <byandell@wisc.edu>
 Title: Inference for QTL Hotspots
 Description: Functions to infer co-mapping trait hotspots and causal
         models
 Maintainer: Brian S. Yandell <yandell@stat.wisc.edu>
-Depends: R (>= 2.10), stats, qtl, lattice, corpcor, mnormt
+Depends: stats,qtl,lattice,corpcor,mnormt
 LazyLoad: yes
 LazyData: yes
 License: GPL (>= 2)
 URL: http://www.stat.wisc.edu/~yandell/statgen
-Packaged: 2012-10-24 16:59:33 UTC; yandell
+Packaged: 2012-11-06 16:29:33 UTC; yandell
 Repository: CRAN
-Date/Publication: 2012-10-25 06:13:39
+Date/Publication: 2012-11-06 17:42:50

MD5

@@ -1,12 +1,12 @@
-3dbc7f983d11607cc2026ced6e1ebe41 *DESCRIPTION
+114503a11e436867f5dbb4a2b15d6a69 *DESCRIPTION
 812ed604c58795ede2862ce6a4e54dba *NAMESPACE
 b933207ad0c19257762b995ec2ac4730 *R/add.phenos.R
 103b12e46d558b8b37c3eb8136e76d69 *R/big.R
 f54f9f8469db96ab8b56d680fb53edf9 *R/cmst.R
 e81baa5d1bd526eecfcf013267ca42c9 *R/highlod.R
-dec7898ba84d5b27de5d678f82e07fb7 *R/hotperm.R
-6e75c18121af3d2e3b1c133b06de311e *R/hotsize.R
-9d957d0691daafd8c8c3cae7d42c84be *R/max.R
+9584459fcdfb011f530531906c471f75 *R/hotperm.R
+73b943edab9b9185223ede00f7dfd087 *R/hotsize.R
+6729dcaeace449eefc9840f1211c393b *R/max.R
 8afdc7d138adfa1284bd90cf63b8e605 *R/multiple_testing_sim_functions.R
 2691e0df2e1c4ad991982cee548e06db *R/neqtl.R
 5a0221e370e2ec06215b5901605af28d *R/parallel.R
@@ -17,18 +17,19 @@ caa27fc5b3a369254761fa583adb8588 *R/roc.R
 697902bf598d08d4cdaea474ca5d0d20 *R/runningmean.R
 0f64e9122ec2af5bd8d4dfa17ff65802 *R/simcmst.R
 e0ce999b19ba4c54273d23a8b8b06636 *R/simhot.R
-0ce011177fadd2f28774f5d4ff602c8a *R/sliding.R
+c257d055fa368c3a8bd05cff67791451 *R/sliding.R
 257b8e3a4afd0d1a435ad68c26f1fcf7 *R/study.R
 dc2f482c9166cfc488dd0c0de6ee1642 *R/utilcmst.R
 39bf135b5eb185681d74d06c18549a1c *R/utilhot.R
 d41c35875c29eff957f88d263399c6ad *R/westwu.R
 d41d8cd98f00b204e9800998ecf8427e *README
-c11d97bf0278ba75468f817255c876a2 *data/CMSTCross.RData
+d9012f4bb4cc97d0cd07cf3bea96ca85 *data/CMSTCross.RData
+23f0def7ffc42f2388ec6a0f8fa72527 *data/hotperm1.RData
 89bff8163dbfdb0b2e5fe28276ecd4fa *inst/deprecated.R
-943c1e1b217fe117dbda5b3d3c3d25d0 *inst/doc/cmst.Rnw
-08bb08edf47ab37382014645dc142020 *inst/doc/cmst.pdf
-3b4ae999433e50910389135b1d7eb850 *inst/doc/qtlhot.Rnw
-ec212dfbe450a33ef66678ba277636c9 *inst/doc/qtlhot.pdf
+24564426040a80f5998c28e64b7ee028 *inst/doc/cmst.Rnw
+cca62c739da14ca330c89aa38eec256b *inst/doc/cmst.pdf
+254decd3e1def2abcb7cb891c742f46f *inst/doc/qtlhot.Rnw
+be5c6274ef38d9e9d53e8f4540d06158 *inst/doc/qtlhot.pdf
 11704113157929b53b0e2c5ba015ad3e *inst/notes/cmst.txt
 52d8cbf0da7b5bdc67b82665b7e8c4c1 *inst/notes/code.txt
 c15b74d7121a2ddbe21306b65ccd3b64 *inst/notes/perm.txt
@@ -51,8 +52,8 @@ aafb4a629861f7a577b99518b7d4be12 *man/PrecTpFpMatrix.Rd
 efb799895e471cdd70bc2d2f30545c7a *man/SimCrossCausal.Rd
 692111bb7328f17b403106ab8dde4907 *man/add.phenos.Rd
 e8cdb877d98ca4a5f27ad7fd42cd79e1 *man/filter.threshold.Rd
-fb6907ded1db3d56c14d94389360759b *man/highlod.Rd
-2f25cffd80841479c6b010ec9eeb2145 *man/hotperm.Rd
+04da9aa72c61c2dfe1efe5bac7ced679 *man/highlod.Rd
+52e69bca1f5593072389751647687c0f *man/hotperm.Rd
 7780b3bf6da7bac3831b7dbdb600f72b *man/hotsize.Rd
 c7ca914d7fc9cf321a7e07750fcf1f32 *man/parallel.qtlhot.Rd
 3da742be31fe06f70772508c1a51a2d6 *man/sim.hotspot.Rd
@@ -61,6 +62,6 @@ c7ca914d7fc9cf321a7e07750fcf1f32 *man/parallel.qtlhot.Rd
 038436d92771c38855a79685ab12df23 *src/runningmean.c
 22acf45d7a3bbdf3f9a177f9987bd1a6 *src/runningmean.h
 de1aeda81e8c8ab6ded25df5ae2dbfab *vignettes/Sweave.sty
-943c1e1b217fe117dbda5b3d3c3d25d0 *vignettes/cmst.Rnw
-3b4ae999433e50910389135b1d7eb850 *vignettes/qtlhot.Rnw
+24564426040a80f5998c28e64b7ee028 *vignettes/cmst.Rnw
+254decd3e1def2abcb7cb891c742f46f *vignettes/qtlhot.Rnw
 eb8b95adf890e0b10c31054ee13a2467 *vignettes/savedperms.RData

R/hotperm.R

@@ -120,21 +120,21 @@ summary.hotperm <- function(object, quant.levels, ...)
   quant.levels <- quant.levels[quant.levels <= n.quant]
   if(max(quant.levels) < n.quant)
     quant.levels <- c(quant.levels, n.quant)
-  out$max.lod.quant <- apply(object$max.lod.quant[, quant.levels, drop = FALSE],
-                             2, quantile, probs = alpha.levels, na.rm = TRUE)
+  out$max.lod.quant <- t(apply(object$max.lod.quant[, quant.levels, drop = FALSE],
+                               2, quantile, probs = alpha.levels, na.rm = TRUE))
 
   class(out) <- c("summary.hotperm", class(out))
   out
 }
 print.summary.hotperm <- function(x, ...)
 {
   cat("max.N: hotspot threshold by single-trait LOD threshold and significance level\n")
-  print(x$max.N)
+  print(ceiling(x$max.N))
   window <- attr(x, "window")
   if(!is.null(window)) {
     cat(paste("\nmax.N.window: smoothed hotspot threshold by single-trait LOD threshold and significance level ",
               "(window = ", window, ")\n", sep = ""))
-    print(x$max.N.window)
+    print(ceiling(x$max.N.window))
   }
   cat("\nmax.lod.quant: LOD threshold by hotspot size quantile and significance level\n")
   print(round(x$max.lod.quant, 2))

R/hotsize.R

@@ -114,7 +114,7 @@ summary.hotsize <- function(object, ...)
   quant.level <- attr(object, "quant.level")
   if(!is.null(quant.level)) {
     cat("quantile level summary:\n")
-    summary(quant.level)
+    print(summary(quant.level))
   }
   cat("\n")
   format <- ifelse(ncol(object ==3), "onepheno", "allpeaks")
@@ -173,7 +173,7 @@ plot.hotsize <- function(x, ylab = "counts", quant.axis = pretty(x$max.N),
     ## Add right axis for quantile LOD level.
     if(length(quant.axis)) {
       quant.axis <- pmax(1, quant.axis)
-      axis(4, at = quant.axis, labels = round(quant.level[quant.axis], 1), las = 1, cex = 0.35)
+      axis(4, at = quant.axis, labels = round(quant.level[quant.axis], 2), las = 1, cex.axis = 0.9)
       ## mtext("sliding LOD thresholds", 4, 1, cex = 1.5)
     }
   }

R/max.R

@@ -40,17 +40,31 @@ max.hotsize <- function(x, ...)
   }
   out
 }
-max.highlod <- function(x, lod.thr = NULL, ...)
+max.highlod <- function(x, lod.thr = NULL, window = NULL, quant.level = NULL, ...)
 {
+  if(is.null(window))
+    window <- attr(x, "window")
+  if(is.null(quant.level))
+    window <- attr(x, "quant.level")
+  mymax <- function(x, window = NULL, quant.level = NULL) {
+    if(is.null(x)) {
+      out <- data.frame(chr = NA, pos = NA, max.N = 0)
+      if(!is.null(window))
+        out$max.N.window <- 0
+      if(!is.null(quant.level))
+        out$max.lod.quant <- 0
+      out
+    }
+    else
+      max(x)
+  }
   if(length(lod.thr) > 1) {
     out <- NULL
     out.thr <- NULL
     for(lod in lod.thr) {
       tmp <- hotsize(x, lod, ...)
-      if(!is.null(tmp)) {
-        out <- rbind(out, max(tmp))
-        out.thr <- c(out.thr, lod)
-      }
+      out <- rbind(out, mymax(tmp, window, quant.level))
+      out.thr <- c(out.thr, lod)
     }
     if(!is.null(out))
       out$lod.thr <- out.thr
@@ -59,7 +73,7 @@ max.highlod <- function(x, lod.thr = NULL, ...)
     out
   }
   else
-    max(hotsize(x, lod.thr, ...))
+    mymax(hotsize(x, lod.thr, window, quant.level, ...), window, quant.level)
 }
 ################################################################################
 quantile.highlod <- function(x, probs = NULL, lod.thr = NULL, n.quant, n.pheno,
@@ -135,23 +149,23 @@ quantile.hotperm <- function(x, probs = attr(x, "alpha.levels"),
   }
 
   out <- list()
-  prob.names <- as.character(signif(probs, 3))
+  prob.names <- paste(100 * signif(probs, 3), "%", sep = "")
 
   ## max.N
   out$max.N <- myquant(x$max.N, probs)
   dimnames(out$max.N) <- list(signif(attr(x, "lod.thrs"), 3), prob.names)
 
   ## max.N.window
   if(!is.null(x$max.N.window)) {
-    out$max.N.window <- myquant(x$max.N.window, probs)
+    out$max.N.window <- t(myquant(x$max.N.window, probs))
     dimnames(out$max.N.Window) <- dimnames(out$max.N)
   }
 
   ## max.lod.quant
   if(!is.null(x$max.lod.quant)) {
     quant <- myquant(x$max.lod.quant, probs)
     if(!is.null(lod.thr)) {
-      tmp <- quant <= lod.thr & quant > 0
+      tmp <- quant <= min(lod.thr) & quant > 0
       if(any(tmp))
         quant[tmp] <- 0
       first.zero <- apply(quant, 2,
@@ -163,8 +177,8 @@ quantile.hotperm <- function(x, probs = attr(x, "alpha.levels"),
                               0
                           })
       offset <- nrow(quant) * (seq(ncol(quant)) - 1)
-      first.zero <- first.zero[first.zero>0] + offset[first.zero>0]
-      quant[first.zero] <- lod.thr
+      first.zero <- first.zero[first.zero > 0] + offset[first.zero > 0]
+      quant[first.zero] <- min(lod.thr)
     }
     dimnames(quant) <- list(as.character(dimnames(x$max.lod.quant)[[2]]), prob.names)
     quant <- quant[apply(quant, 1, function(x) any(x > 0)),, drop = FALSE]

R/sliding.R

@@ -59,7 +59,10 @@ slidingbar.create <- function(highobj, quant.level = NULL,
   expand[rows,] <- t(quant)
 
   ## probably want to make this into some kind of object?
-  data.frame(chr.pos, expand)
+  out <- data.frame(chr.pos, expand)
+  attr(out, "quant.level") <- quant.level
+
+  out
 }
 slidingbar.plot <- function(x, ...)
 {
@@ -84,6 +87,9 @@ slidingbar.plot <- function(x, ...)
   for (i in 1:length(n.mar))
     axis(side = 1, at = mean(wh[i + c(0, 1)]), labels = chr[i])
 
+  y.axes <- pmax(1, pretty(seq(ncol(x) - 2)))
+  quant.level <- round(attr(x, "quant.level"), 2)
+  axis(side=4, labels = quant.level[y.axes], at = y.axes, cex.axis = 0.9, las=1)
   invisible()
 }
 ## Generates the sliding bar figure (not an image anymore)

inst/doc/cmst.Rnw

@@ -282,7 +282,7 @@ annot
 targets <- list(y1 = c("y2","y3"))
 @ 
 
-Now we used the scans (via \texttt{CMSThigh}) and the annotation to identify candidate regions, the subset of cis-acting candidate regions, and co-mapping targets.
+Now we used the scans (via \texttt{CMSThigh}) and the annotation to identify candidate regulators, the subset of cis-acting candidate regulators, and co-mapping targets.
 
 <<>>=
 cand.reg <- GetCandReg(CMSThigh, annot, traits)