Many edits

.Rbuildignore

@@ -1,5 +1,2 @@
 ^.*\.Rproj$
 ^\.Rproj\.user$
-^README\.Rmd$
-^README-.*\.png$
-^\.travis\.yml$

.gitignore

@@ -1,4 +1,4 @@
 .Rproj.user
 .Rhistory
 .RData
-create_umn_palette.R
+.Ruserdata

DESCRIPTION

@@ -1,11 +1,11 @@
-Package: neyhart
-Title: My collection of useful R functions.
-Version: 0.0.0.9000
-Authors@R: person("Jeff", "Neyhart", email = "[email protected]", role = c("aut", "cre"))
-Description: A package of miscellaneous R functions that I use frequently in projects or leisure (nerd!). Functions are for a variety of purposes, including generating colors for plotting, file conversion, etc.
-Depends:
-    R (>= 3.3.0)
-License: MIT
-Encoding: UTF-8
-LazyData: true
-RoxygenNote: 6.0.1
+Package: neyhart
+Title: My collection of useful R functions.
+Version: 0.0.0.9000
+Authors@R: person("Jeff", "Neyhart", email = "[email protected]", role = c("aut", "cre"))
+Description: A package of miscellaneous R functions that I use frequently in projects or leisure (nerd!). Functions are for a variety of purposes, including generating colors for plotting, file conversion, etc.
+Depends:
+    R (>= 3.3.0)
+License: MIT
+Encoding: UTF-8
+LazyData: true
+RoxygenNote: 6.0.1

LICENSE

@@ -1,21 +1,21 @@
-The MIT License (MIT)
-
-Copyright (c) 2016 Jeff Neyhart
-
-Permission is hereby granted, free of charge, to any person obtaining a copy
-of this software and associated documentation files (the "Software"), to deal
-in the Software without restriction, including without limitation the rights
-to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
-copies of the Software, and to permit persons to whom the Software is
-furnished to do so, subject to the following conditions:
-
-The above copyright notice and this permission notice shall be included in all
-copies or substantial portions of the Software.
-
-THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
-IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
-FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
-AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
-LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
-SOFTWARE.
+The MIT License (MIT)
+
+Copyright (c) 2016 Jeff Neyhart
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+SOFTWARE.

NAMESPACE

@@ -1,11 +1,14 @@
 # Generated by roxygen2: do not edit by hand
 
 S3method(print,palette)
+export(bootstrap)
 export(cfind)
 export(rpospois)
 export(save_append)
 export(theme_acs)
 export(theme_manhattan)
+export(theme_pnas)
 export(theme_poster)
 export(umn_palette)
+import(boot)
 import(ggplot2)

R/bootstrap.R

@@ -0,0 +1,91 @@
+#' Generalized bootstrapper
+#' 
+#' @description Computes bootstrap resamples of a statistic
+#' 
+#' @param x A numeric vector.
+#' @param y NULL (default) or a numeric vector for statistics that require a second
+#' numeric vector
+#' @param fun A character vector of the desired statistic function. For instance,
+#' to calculate the variance of values in the numeric vector, pass "var".
+#' @param boot.reps The number of bootstrapping replications.
+#' @param alpha The significance level for calculating a confidence interval.
+#' 
+#' @import boot
+#' 
+#' @export
+#' 
+bootstrap <- function(x, y = NULL, fun, boot.reps = 1000, alpha = 0.05) {
+
+  # Error handling
+  boot.reps <- as.integer(boot.reps)
+
+  # Error if the function does not exist
+  stopifnot(exists(fun))
+  # Otherwise get the function
+  fun_torun <- get(fun)
+
+  # Prob must be between 0 and 1
+  alpha_check <- alpha > 0 | alpha < 1
+
+  if (!alpha_check)
+    stop("'alpha' must be between 0 and 1.")
+
+  # Combine the data
+  mat <- cbind(x, y)
+  # How many columns
+  n_col <- ncol(mat)
+
+
+  ## Define a function for bootstrapping a single vector
+  boot_fun_vec <- function(data, i) {
+    # Use the index i to sample the data
+    data_i <- data[i,,drop = FALSE]
+    # Execute the function
+    fun_torun(data_i[,1])
+
+  }
+
+  ## Define a function for bootstrapping a two vectors
+  boot_fun_mat <- function(data, i) {
+    # Use the index i to sample the data
+    data_i <- data[i,]
+    # Execute the function
+    fun_torun(data_i[,1], data_i[,2])
+
+  }
+
+  # Calculate the base statistic
+  base_stat <- if (n_col > 1) fun_torun(mat[,1], mat[,2]) else fun_torun(mat[,1])
+
+  # If the base is not NA, proceed
+  if (!is.na(base_stat)) {
+
+    # Perform the bootstrapping
+    if (n_col > 1) {
+      boot_results <- boot(data = mat, statistic = boot_fun_mat, R = boot.reps)
+
+    } else {
+      boot_results <- boot(data = mat, statistic = boot_fun_vec, R = boot.reps)
+
+    }
+
+    # Standard error
+    se <- sd(boot_results$t)
+    # Bias
+    bias <- mean(boot_results$t) - base_stat
+
+
+    # Confidence interval
+    ci_upper <- quantile(boot_results$t, 1 - (alpha / 2))
+    ci_lower <- quantile(boot_results$t, (alpha / 2))
+
+  } else {
+
+    se <- bias <- ci_lower <- ci_upper <- NA
+
+  }
+
+  # Assemble list and return
+  data.frame(statistic = fun, base = base_stat, se = se, bias = bias,
+             ci_lower = ci_lower, ci_upper = ci_upper, row.names = NULL)
+}

R/cfind.R

@@ -1,38 +1,38 @@
-#' Find objects by name and class
-#' 
-#' @description 
-#' Wrapper of the \code{\link[utils]{apropos}} function for finding objects, but
-#' includes the ability to find objects based on class. "c"find for "class" find.
-#' 
-#' @param what See \code{\link[utils]{apropos}}
-#' @param ignore.case See \code{\link[utils]{apropos}}
-#' @param class character string with a class. Objects of class \code{class} will
-#' be returned.
-#' 
-#' @export
-#' 
-cfind <- function(what, ignore.case = TRUE, class = "any") {
-
-  # Error handling
-  if (!is.logical(ignore.case)) stop("'ignore.case' must be logical.")
-  if (!is.character(class)) stop("'class' must be character.")
-
-  # Wrap around the 'apropos' function
-  objects <- apropos(what = what, ignore.case = ignore.case, mode = "any")
-
-  # Determine the classes of those objects
-  object.class <- sapply(X = objects, FUN = function(obj)
-    class(get(obj)) )
-
-  # If 'any' class is desired, return all objects
-  if (class == "any") {
-    return(objects)
-
-    # Else subset the objects by the desired class
-  } else {
-    desired.objects <- objects[sapply(object.class, FUN = function(classes) class %in% classes)]
-    return(desired.objects)
-
-  }
-
+#' Find objects by name and class
+#' 
+#' @description 
+#' Wrapper of the \code{\link[utils]{apropos}} function for finding objects, but
+#' includes the ability to find objects based on class. "c"find for "class" find.
+#' 
+#' @param what See \code{\link[utils]{apropos}}
+#' @param ignore.case See \code{\link[utils]{apropos}}
+#' @param class character string with a class. Objects of class \code{class} will
+#' be returned.
+#' 
+#' @export
+#' 
+cfind <- function(what, ignore.case = TRUE, class = "any") {
+
+  # Error handling
+  if (!is.logical(ignore.case)) stop("'ignore.case' must be logical.")
+  if (!is.character(class)) stop("'class' must be character.")
+
+  # Wrap around the 'apropos' function
+  objects <- apropos(what = what, ignore.case = ignore.case, mode = "any")
+
+  # Determine the classes of those objects
+  object.class <- sapply(X = objects, FUN = function(obj)
+    class(get(obj)) )
+
+  # If 'any' class is desired, return all objects
+  if (class == "any") {
+    return(objects)
+
+    # Else subset the objects by the desired class
+  } else {
+    desired.objects <- objects[sapply(object.class, FUN = function(classes) class %in% classes)]
+    return(desired.objects)
+
+  }
+
 } # Close the function

R/gwas_themes.R

@@ -1,19 +1,19 @@
-#' Plotting theme for GWAS results
-#' 
-#' @description 
-#' Themes for ggplot2 designed for GWAS results.
-#' 
-#' @import ggplot2
-#' 
-#' @export
-#' 
-theme_manhattan <- function() {
-
-  theme_bw() +
-    theme(panel.spacing.x = unit(x = 0, units = "cm"),
-          panel.grid = element_blank(),
-          panel.border = element_rect(color = "grey75"),
-          axis.text.x = element_text(angle = 45, hjust = 1))
-
-}
-
+#' Plotting theme for GWAS results
+#' 
+#' @description 
+#' Themes for ggplot2 designed for GWAS results.
+#' 
+#' @import ggplot2
+#' 
+#' @export
+#' 
+theme_manhattan <- function() {
+
+  theme_bw() +
+    theme(panel.spacing.x = unit(x = 0, units = "cm"),
+          panel.grid = element_blank(),
+          panel.border = element_rect(color = "grey75"),
+          axis.text.x = element_text(angle = 45, hjust = 1))
+
+}
+

R/publication_themes.R

@@ -25,11 +25,14 @@ theme_poster <- function() {
 #' @description 
 #' Themes for ggplot2 designed for compliance with variance scientific journals.
 #' 
+#' @rdname themes
+#' 
 #' @details 
 #' 
 #' \describe{
-#'   \item{theme_acs}{Theme for the American Society of Agronomy (ASA), Crop Science Society of America (CSSA), and
-#'   Soil Science Society of America (SSSA).}
+#'   \item{\code{theme_acs}}{Theme for the American Society of Agronomy (ASA), 
+#'   Crop Science Society of America (CSSA), and Soil Science Society of America (SSSA).}
+#'   \item{\code{theme_pnas}}{Theme for the Proceedings of the National Academy of Sciences.}
 #' }
 #' 
 #' @import ggplot2
@@ -43,3 +46,24 @@ theme_acs <- function(base_size = 8) {
     theme(panel.grid = element_blank())
 
 }
+
+
+#'
+#' @rdname themes
+#' 
+#' @export
+#' 
+theme_pnas <- function(base_size = 6) {
+
+  theme_classic(base_size = base_size) %+replace%
+  theme(panel.grid = element_blank(),
+        strip.background = element_rect(fill = "grey85", size = 0),
+        axis.title = element_text(size = 6),
+        legend.text = element_text(size = 6))
+
+}
+
+
+
+
+

R/repo_tools.R

@@ -1,5 +1,5 @@
-#' Create a repository README
-#' 
-#' 
-#' 
-#' 
+#' Create a repository README
+#' 
+#' 
+#' 
+#' 

R/rpospois.R

@@ -1,19 +1,19 @@
-#' Sample from a positive Poisson distribution
-#'
-#' @description
-#' Generates random samples from a positive Poisson distribution. This distribution
-#' ensures non-zero counts for every random sample.
-#'
-#' @param n The number of independent samples to draw from the distribution
-#' @param lambda The mean parameter for a Poisson Distribution.
-#'
-#' @return A numeric vector with counts given a mean parameter \code{lambda}.
-#'
-#' @export
-#'
-#' @examples
-#' rpospois(n = 10, lambda = 1)
-#'
-rpospois <- function(n, lambda) {
-  qpois(runif(n, min = dpois(0, lambda), max = 1), lambda)
-}
+#' Sample from a positive Poisson distribution
+#'
+#' @description
+#' Generates random samples from a positive Poisson distribution. This distribution
+#' ensures non-zero counts for every random sample.
+#'
+#' @param n The number of independent samples to draw from the distribution
+#' @param lambda The mean parameter for a Poisson Distribution.
+#'
+#' @return A numeric vector with counts given a mean parameter \code{lambda}.
+#'
+#' @export
+#'
+#' @examples
+#' rpospois(n = 10, lambda = 1)
+#'
+rpospois <- function(n, lambda) {
+  qpois(runif(n, min = dpois(0, lambda), max = 1), lambda)
+}