Removing stub code for ch6; see comment for code path

Author: pbreheny

.project.url

@@ -0,0 +1 @@
+https://github.com/users/pbreheny/projects/4

R/bc-tcga.R

@@ -9,7 +9,6 @@
 #' attachData(bcTCGA)
 #' cvfit <- cv.glmnet(X, y)
 #' Fig2.10(cvfit)
-#'
 #' @export
 
 Fig2.10 <- function(cvfit, parlist=list(mfrow=c(1,2), mar=c(5,5,5,0.5))) {

R/mfdr-corr.R

@@ -1,42 +1,24 @@
-#' Reproduce Example 6.2 and Figure 6.3
+#' Reproduce Example 6.3 and Figure 6.5
 #'
-#' Reproduces Example 6.2 and Figure 6.3 from the book.  If you specify any options, your results may look different.
+#' Reproduces Example 6.3 and Figure 6.5 from the book.  If you specify any options, your results may look different.
 #'
 #' @examples
 #' \dontrun{
-#' out <- Ex6.2()
-#' Fig6.3(out)
+#' out <- Ex6.3()
+#' Fig6.5(out)
 #' }
 #' @export
 
 Ex6.3 <- function() {
+  # ~/res/lassoFDR/corr/*
   stop('Ex6.3 not implemented yet')
-
-  # NEED TO ADD
 }
 
 #' @rdname Ex6.3
-#'
 #' @param out   Output of `Ex6.3()`
-#'
 #' @export
 
 Fig6.5 <- function(out) {
-
-  ## Read in data
-  df <- array2df(apply(out[,,-1], 2:3, sum), vars=c("lambda", "Type", "Avg"))
-  S <- apply(out[,,1], 2, sum)
-  df$mFDR <- df$Avg/S
-  df$Avg <- df$Avg/dim(out)[1]
-  df$lam <- factor2num(df$lambda)
-  df$ll <- log(df$lam)
-
-  xlim <- rev(range(df$ll))
-  p1 <- qplot(ll, Avg, data=df, color=Type, geom="line", xlab=expression(log(lambda)), ylab="False inclusions", xlim=xlim) +
-    geom_line(size=2) + scale_color_manual(values=pal(2, alpha=0.5)) + theme(legend.position="top")
-  p2 <- qplot(ll, mFDR, data=df, color=Type, geom="line", xlab=expression(log(lambda)), ylab="False inclusions", xlim=xlim) +
-    geom_line(size=2) + scale_color_manual(values=pal(2, alpha=0.5)) + theme(legend.position="top")
-
-  #subset(df, ll == ll[14])
-  gridExtra::grid.arrange(p1, p2, widths=c(1,1))
+  if (missing(out)) stop("You need to run the code in Ex6.3() first and pass it to Fig6.5()")
+  # /man/Breheny2019/fig/sim-corr.R
 }

R/mfdr-ind.R

@@ -10,32 +10,15 @@
 #' @export
 
 Ex6.2 <- function() {
+  # ~/res/lassoFDR/uncorr/sim1.R
   stop('Ex6.2 not implemented yet')
-  #subset(df, loglambda == loglambda[20])
 }
 
 #' @rdname Ex6.2
-#'
 #' @param out   Output of `Ex6.2()`
-#'
 #' @export
 
 Fig6.3 <- function(out) {
   if (missing(out)) stop("You need to run the code in Ex6.2() first and pass it to Fig6.3()")
-
-  out[,,1,4] <- out[,,1,4]*42/60
-  out[,,2,4] <- out[,,2,4]*540/600
-  dimnames(out)[[4]][3:4] <- c("Actual", "Estimated")
-  df <- data.frame(array2df(apply(out[,,,3:4],2:4,mean), vars=c("lambda","p","Type", "Avg")))
-  df$lambda <- factor2num(df$lambda)
-  df$loglambda <- log(df$lambda)
-  df$S <- as.numeric(apply(apply(out[,,,1:3], 1:3, sum), 2:3, mean))
-  df$FDR <- df$Avg/df$S
-
-  p1 <- qplot(loglambda, Avg, data=df, color=Type, geom="line", xlab=expression(log(lambda)), ylab="False inclusions", xlim=c(0.4, -4.2)) +
-    geom_line(size=2) + scale_color_manual(values=pal(2, alpha=0.5)) + facet_grid(~p, labeller=label_both) + theme(legend.position="top") + theme(panel.background=element_rect(fill = "gray90"))
-  p2 <- qplot(loglambda, FDR, data=df, color=Type, geom="line", xlab=expression(log(lambda)), ylab="FIR", xlim=c(0.4, -4.2)) +
-    geom_line(size=2) + scale_color_manual(values=pal(2, alpha=0.5)) + facet_grid(~p, labeller=label_both) + theme(legend.position="none") + theme(panel.background=element_rect(fill = "gray90"))
-
-  gridExtra::grid.arrange(p1, p2, heights=c(1.2, 1))
+  # /man/Breheny2019/fig/sim-ind.R
 }

R/mfdr-power.R

@@ -1,33 +1,15 @@
+#' Reproduce Figure 6.4
+#'
+#' Reproduces Example Figure 6.4 from the book.  If you specify any options, your results may look different.
+#'
+#' @examples
+#' \dontrun{
+#' out <- Ex6.2()
+#' Fig6.4(out)
+#' }
 #' @export
 
 Fig6.4 <- function(out) {
-  dimnames(out)[[3]][1:2] <- c("Univariate", "LassoFIR")
-  dimnames(out)[[4]] <- c("Causative (A)", "Correlated (B)", "Noise (C)")
-  df <- array2df(apply(out, 2:4, mean, na.rm=TRUE), vars=c("p","Method", "Group", "Avg"))
-
-  # Subsets / reordering factors
-  ggdf1 <- subset(df, p==60 & Method != "LassoBIC")
-  #ggdf2 <- subset(df, p==600 & !(Method %in% c("LassoBIC", "LassoCV")))
-  ggdf2 <- subset(df, p==600 & Method != "LassoBIC")
-  ggdf1$Method <- revlevel(relevel(droplevels(ggdf1$Method), 'LassoFIR'))
-  ggdf2$Method <- revlevel(relevel(droplevels(ggdf2$Method), 'LassoFIR'))
-
-  # Plot
-  p1 <- ggplot(data=ggdf1) + aes(Method, Avg, fill=Group) + geom_bar(stat='identity') +
-    scale_fill_grey(start=0,end=1) + coord_flip() + theme(panel.background=element_rect(fill = "gray90")) +
-    facet_grid(p~., labeller=label_both) + theme(legend.position="top", legend.background=element_rect(fill = "gray90"))
-  p2 <- ggplot(data=ggdf2) + aes(Method, Avg, fill=Group) + geom_bar(stat='identity') +
-    scale_fill_grey(start=0,end=1) + coord_flip() + theme(panel.background=element_rect(fill = "gray90")) +
-    facet_grid(p~., labeller=label_both) + theme(legend.position="none")
-
-  gridExtra::grid.arrange(p1, p2, heights=c(1.3, 1))
-
-  # Summaries
-#   T1 <- apply(out[,1,,],2:3,mean)
-#   T1[,3]/apply(T1,1,sum)
-#   (T1[,2]+T1[,3])/apply(T1,1,sum)
-#   T2 <- apply(out[,2,,],2:3,mean)
-#   T2[,3]/apply(T2,1,sum)
-#   (T2[,2]+T2[,3])/apply(T2,1,sum)
-
+  if (missing(out)) stop("You need to run the code in Ex6.2() first and pass it to Fig6.4()")
+  # /man/Breheny2019/fig/sim-power.R
 }

R/utils.R

@@ -1,9 +1,3 @@
-array2df <- function(X,vars=paste("V",1:ncol(df),sep="")) {
-  df <- cbind(do.call("expand.grid",dimnames(X)),as.numeric(X))
-  names(df) <- vars
-  df
-}
-
 #' Make a log-scale axis
 #'
 #' @param side    1=bottom, 2=left, 3=top, 4=right