Merge pull request #4 from nhejazi/develop

Develop

DESCRIPTION

@@ -1,30 +1,30 @@
 Package: nima
-Title: Nima Hejazi's Miscellaneous R Code
-Version: 0.3.0
-Authors@R: person("Nima", "Hejazi", email = "nhejazi@berkeley.edu",
-		  role = c("aut", "cre"))
+Title: Nima Hejazi's Miscellaneous R Tools
+Version: 0.4.0
+Authors@R: as.person(c(
+  "Nima Hejazi <nhejazi@berkeley.edu> [aut, cre]"))
 Description: Miscellaneous R functions developed over the course of statistical
-	     research. These include utilities that supplement the existing
-	     idiosyncrasies of R; extend plotting functionality and aesthetics; 
-	     provide alternative presentations of matrix decompositions; extend 
-	     types of random variables supported for simulation; extend access
-	     to command line tools and system information, making work on remote
-	     systems easier.
+  research. These include utilities that supplement the existing idiosyncrasies
+  of R; extend existing (and provide customized) plotting functionality and
+  aesthetics; provide alternative presentations of matrix decompositions; extend
+  access to command line tools and system information.
 Depends:
-    R (>= 3.2.3)
+  R (>= 3.2.3)
 Imports:
-    plyr,
-    utils,
-    stats,
-    survival,
-    gridExtra,
-    assertthat,
-    ggplot2,
-    grid
+  plyr,
+  utils,
+  stats,
+  survival,
+  gridExtra,
+  assertthat,
+  ggthemes,
+  ggplot2,
+  scales,
+  grid
 Suggests:
-    devtools,
-    roxygen2,
-    testthat
+  devtools,
+  roxygen2,
+  testthat
 License: MIT + file LICENSE
 URL: https://github.com/nhejazi/nima
 LazyData: true

NAMESPACE

@@ -2,23 +2,31 @@
 
 export(absmax)
 export(attrnames)
+export(clear)
 export(commas)
 export(compFun)
 export(exit)
 export(factornum)
 export(hweb)
 export(lmPlots_gg)
+export(miss_ind)
 export(nima_theme)
 export(objsizes)
 export(openfile)
 export(qqPlot_gg)
 export(qrD)
-export(rmvn)
+export(scale_color_nima)
+export(scale_fill_nima)
 export(survPlot_gg)
 export(theme_nima)
 export(uniqlen)
 importFrom(assertthat,assert_that)
 importFrom(ggplot2,aes)
+importFrom(ggplot2,discrete_scale)
+importFrom(ggplot2,element_blank)
+importFrom(ggplot2,element_line)
+importFrom(ggplot2,element_rect)
+importFrom(ggplot2,element_text)
 importFrom(ggplot2,geom_abline)
 importFrom(ggplot2,geom_bar)
 importFrom(ggplot2,geom_hline)
@@ -28,6 +36,7 @@ importFrom(ggplot2,geom_step)
 importFrom(ggplot2,geom_text)
 importFrom(ggplot2,ggplot)
 importFrom(ggplot2,ggtitle)
+importFrom(ggplot2,rel)
 importFrom(ggplot2,scale_colour_discrete)
 importFrom(ggplot2,scale_colour_manual)
 importFrom(ggplot2,scale_linetype_manual)
@@ -37,12 +46,14 @@ importFrom(ggplot2,theme)
 importFrom(ggplot2,theme_bw)
 importFrom(ggplot2,xlab)
 importFrom(ggplot2,ylab)
+importFrom(ggthemes,theme_foundation)
+importFrom(grid,unit)
 importFrom(gridExtra,grid.arrange)
 importFrom(plyr,arrange)
+importFrom(scales,manual_pal)
 importFrom(stats,na.omit)
 importFrom(stats,ppoints)
 importFrom(stats,qnorm)
 importFrom(stats,quantile)
-importFrom(stats,rnorm)
 importFrom(survival,Surv)
 importFrom(survival,survfit)

NEWS.md

@@ -1,2 +1,10 @@
-March 21, 2016:
-* The first (working) release of package `nima` is submitted to CRAN.
+September 20, 2016:
+* Addition of several functions, re-written DESCRIPTION file. Update of package
+    version to v. 0.4.0. This version update to be released on CRAN.
+
+July 5, 2016:
+* Major changes, including addition of unit tests and Travis-CI coverage, added
+    to the package for v. 0.3.5. This version update not to be released on CRAN.
+
+March 25, 2016:
+* The first public release of this package (v. 0.3.0) is made available on CRAN.

R/ggPlots.R

@@ -145,13 +145,13 @@ utils::globalVariables(c("time", "cens", "surv", "low", "up", "group"))
 #' @param ylab A label for the y-axis, defaults to "Survival".
 #' @param main A main label for the survival plot, no default.
 #' @param pltcens Should the plot include the censored values?
-#' @param lty The number of survival curves to be generated from the model. 
-#' @param ltci The number of lines to be generated for confidence intervals. 
+#' @param lty The number of survival curves to be generated from the model.
+#' @param ltci The number of lines to be generated for confidence intervals.
 #' @param shape The shapes of points plotted, passed to \code{geom_point}
 #'
 #' @importFrom ggplot2 ggplot aes geom_point geom_hline xlab ylab ggtitle
-#' @importFrom ggplot2 stat_smooth geom_abline geom_bar geom_step theme 
-#' @importFrom ggplot2 scale_size_continuous scale_colour_discrete theme_bw 
+#' @importFrom ggplot2 stat_smooth geom_abline geom_bar geom_step theme
+#' @importFrom ggplot2 scale_size_continuous scale_colour_discrete theme_bw
 #' @importFrom ggplot2 scale_linetype_manual scale_colour_manual
 #' @importFrom survival survfit Surv
 #'
@@ -168,7 +168,7 @@ utils::globalVariables(c("time", "cens", "surv", "low", "up", "group"))
 #' survPlot_gg(s)
 
 survPlot_gg <- function(s, CI = "def", pltcens = TRUE, survcl = "gg.def",
-                        censcl = "red", lty = 1, ltci = 2, shape = 3, 
+                        censcl = "red", lty = 1, ltci = 2, shape = 3,
                         bw = FALSE, xlab = "Time", ylab = "Survival",
                         main = "") {
 
@@ -177,7 +177,7 @@ survPlot_gg <- function(s, CI = "def", pltcens = TRUE, survcl = "gg.def",
   stopifnot(length(lty) == 1 | length(lty) == strata)
 
   ggsurv.s <- function(s, CI = "def", pltcens = TRUE, survcl = "gg.def",
-                       censcl = "red", lty = 1, ltci = 2, shape = 3, bw = FALSE, 
+                       censcl = "red", lty = 1, ltci = 2, shape = 3, bw = FALSE,
                        xlab = "Time", ylab = "Survival", main = ""){
 
     dat <- data.frame(time = c(0, s$time), surv = c(1, s$surv),
@@ -209,7 +209,7 @@ survPlot_gg <- function(s, CI = "def", pltcens = TRUE, survcl = "gg.def",
   }
 
   ggsurv.m <- function(s, CI = "def", pltcens = TRUE, survcl = "gg.def",
-                       censcl = "red", lty = 1, ltci = 2, shape = 3, bw = FALSE, 
+                       censcl = "red", lty = 1, ltci = 2, shape = 3, bw = FALSE,
                        xlab = "Time", ylab = "Survival Prob.", main = "") {
     n <- s$strata
     groups <- factor(unlist(strsplit(names(s$strata), "="))[seq(2, 2 * strata,

R/missing_ind.R

@@ -0,0 +1,24 @@
+#' Add missingness indicators to existing data.frame
+#'
+#' Add indicator columns to a data.frame showing the pattern of missingness.
+#'
+#' @param data A numeric vector or array.
+#' @param prefix A string used to name the indicator variables..
+#'
+#' @return An augmented data.frame with indicators for missingness patterns.
+#'
+#' @export
+#'
+#' @examples
+#' data <- data.frame(cbind(rnorm(10), runif(10)))
+#' data[sample(nrow(data), 3), 1] <- NA
+#' data[sample(nrow(data), 4), 2] <- NA
+#' data <- miss_ind(data)
+
+miss_ind <- function(data, prefix = "miss_") {
+  indicators = sapply(data, FUN = function(col) as.numeric(is.na(col)))
+  colnames(indicators) = paste0(prefix, colnames(data))
+  indicators = indicators[, !colMeans(indicators) %in% c(0, 1)]
+  out <- cbind(data, indicators)
+  return(out)
+}

R/qrDecomp.R

@@ -20,8 +20,6 @@
 #'
 #' @seealso
 #' \code{\link[base]{qr}}
-#'
-#' @keywords linear algebra
 
 qrD <- function(x, tol = 1e-7) {
 

R/theme_nima.R

@@ -1,39 +1,100 @@
 #' Nima's ggplot2 theme
 #'
-#' Nima's ggplot2 theme: black border and no ticks
+#' Nima's ggplot2 theme: white background, colors optimized
 #'
 #' @param base_size Base font size
 #' @param base_family Base font family
 #' @param ... Passed to \code{\link[ggplot2]{theme}}
 #'
-#' @importFrom ggplot2 ggplot
+#' @importFrom ggplot2 ggplot rel element_text element_rect element_line
+#' @importFrom ggplot2 element_blank
+#' @importFrom grid unit
+#' @importFrom ggthemes theme_foundation
 #'
 #' @export
 #'
 #' @return An object as returned by \code{\link[ggplot2]{theme}}
 #'
 #' @examples
 #' library(ggplot2)
-#' mtcars$cyl <- factor(mtcars$cyl)
-#' p <- ggplot(mtcars, aes(y=mpg, x = disp, color = cyl)) 
-#' p <- p + geom_point() + theme_nima()
+#' p <- ggplot(mtcars, aes(y = mpg, x = disp, color = factor(cyl))) 
+#' p <- p + geom_point() + scale_fill_nima() + scale_color_nima() + theme_nima()
 #' p
 #'
 #' @seealso
 #' \code{\link[ggplot2]{theme}}
 
 
-theme_nima <- function(base_size = 12, base_family = "", ...) {
-    ggplot2::"%+replace%"(
-      ggplot2::theme_grey(base_size = base_size, base_family = base_family),
-      ggplot2::theme(axis.ticks.length = grid::unit(0, "cm"),
-                     panel.border = ggplot2::element_rect(fill = NA,
-                                                          color = "black"),
-                     strip.background=ggplot2::element_rect(fill="gray80",
-                                                            color="black"), ...)
-      )
+theme_nima <- function(base_size = 14, base_family = "Helvetica") {
+      (theme_foundation(base_size = base_size, base_family = base_family)
+       + theme(plot.title = element_text(face = "bold",
+                                         size = rel(1.2), hjust = 0.5),
+               text = element_text(),
+               panel.background = element_rect(colour = NA),
+               plot.background = element_rect(colour = NA),
+               panel.border = element_rect(colour = NA),
+               axis.title = element_text(face = "bold", size = rel(1)),
+               axis.title.y = element_text(angle = 90, vjust = 2),
+               axis.title.x = element_text(vjust = -0.2),
+               axis.text = element_text(), 
+               axis.line = element_line(colour = "black"),
+               axis.ticks = element_line(),
+               axis.ticks.length = unit(0, "cm"),
+               panel.grid.major = element_line(colour = "#f0f0f0"),
+               panel.grid.minor = element_blank(),
+               legend.key = element_rect(colour = NA),
+               legend.position = "bottom",
+               legend.direction = "horizontal",
+               legend.key.size= unit(0.2, "cm"),
+               legend.margin = unit(0, "cm"),
+               legend.title = element_text(face = "italic"),
+               plot.margin = unit(c(10, 5, 5, 5), "mm"),
+               strip.background = element_rect(colour = "#f0f0f0", 
+                                               fill = "#f0f0f0"),
+               strip.text = element_text(face = "bold")
+          ))     
 }
 
 #' @rdname theme_nima
 #' @export
 nima_theme <- theme_nima
+
+
+#' Nima's ggplot2 theme - supplement: scale_fill
+#'
+#' Nima's ggplot2 theme scale_fill supplement: colors optimized via ColorBrewer
+#'
+#' @param ... Passed to \code{\link[ggplot2]{ggplot}}
+#'
+#' @importFrom ggplot2 discrete_scale
+#' @importFrom scales manual_pal
+#'
+#' @export
+#'
+
+scale_fill_nima <- function(...){
+      discrete_scale("fill","nima",
+                     manual_pal(values = c("#386cb0","#fdb462","#7fc97f",
+                                           "#ef3b2c","#662506","#a6cee3",
+                                           "#fb9a99","#984ea3","#ffff33")), ...)
+}
+
+
+#' Nima's ggplot2 theme - supplement: scale_color
+#'
+#' Nima's ggplot2 theme scale_color supplement: colors optimized via ColorBrewer
+#'
+#' @param ... Passed to \code{\link[ggplot2]{ggplot}}
+#'
+#' @importFrom ggplot2 discrete_scale
+#' @importFrom scales manual_pal
+#'
+#' @export
+#'
+
+scale_color_nima <- function(...){
+      discrete_scale("colour","nima",
+                     manual_pal(values = c("#386cb0","#fdb462","#7fc97f",
+                                           "#ef3b2c","#662506","#a6cee3",
+                                           "#fb9a99","#984ea3","#ffff33")), ...)
+}

R/utilities.R

@@ -25,15 +25,26 @@ exit <- function() q("no")
 #'
 #' @seealso
 #' \code{\link[utils]{help}}, \code{\link[utils]{help.start}}
-#'
-#' @keywords
-#' documentation
 
 hweb <- function(...) {
     utils::help(..., help_type = "html")
 }
 
 
+#' Clear the Current Screen/Buffer
+#'
+#' Clear the screen with a call to \code{\link[base]{system}} and \code{clear}.
+#'
+#' @details This function is merely a call to \code{system("clear")}
+#'
+#' @export
+#'
+#' @examples
+#' \dontrun{system("clear")}
+
+clear <- function() system("clear")
+
+
 #' Open a File
 #'
 #' Open a file using \code{\link[base]{system}} and \code{open}.

R/zzz.R

@@ -0,0 +1,4 @@
+.onAttach <- function(...) {
+  packageStartupMessage("nima: Nima Hejazi's Miscellaneous R Tools")
+  packageStartupMessage("Version: ", utils::packageDescription("nima")$Version)
+}