install logo correctly

2020-07-06 11:48:10 -04:00
parent f5f288974f
commit 20f65a7126
32 changed files with 582 additions and 95 deletions
@@ -0,0 +1,122 @@
+# Functions for connecting to Civilytics' data sources
+
+
+
+# postgresCon <- function(myip){
+#   require("RPostgreSQL")
+#   require("pool")
+#   drv <- dbDriver("PostgreSQL")
+#   con <- dbPool(drv, dbname = "crime", host = myip,
+#                 port = 5432, user="admin", password = "betterplacemakeworld")
+#   return(con)
+# }
+
+
+#' Clean unreported data counts in UCR data
+#'
+#' @param x a column of data, if character, substitute and conver to numeric
+#'
+#' @return a numeric column of data
+#' @export
+countCleanr <- function(x){
+  if(class(x) == "character"){
+    x[x == "None not reported"] <- "0"
+    x[x == "Not applicable"] <- NA
+    x <- as.numeric(x)
+    return(x)
+  } else{
+    return(x)
+  }
+}
+
+
+
+#' Find columns in a dataframe that have values with a "."
+#'
+#' @param data a dataframe
+#'
+#' @return the names of columns in the dataframe with one or more entries equal to "."
+#' @export
+#'
+#' @examples
+findDots <- function(data){
+  return(names(data)[lapply(data, countDots) > 0])
+
+}
+
+#' Count the number of single period entries in a vector
+#'
+#' @param x a character vector
+#'
+#' @return
+#' @export
+#'
+#' @examples
+countDots <- function(x){
+  len <- length(x[x == "." & !is.na(x)])
+  totlen <- length(x)
+  return(len)
+}
+
+
+#' Make names safe for inclusion in a database
+#'
+#' @param names a character vector of possible column or table names
+#'
+#' @return a vector the same length as the input vector with clean names
+#' @export
+#'
+#' @examples
+dbSafeNames <- function(names) {
+  names = gsub('[^a-z0-9]+','_',tolower(names))
+  names = make.names(names, unique = TRUE, allow_ = TRUE)
+  names = gsub('.','_',names, fixed = TRUE)
+  names
+}
+
+#' Count number of missing values in a vector
+#'
+#' @param x a vector of values
+#'
+#' @return an integer equal to the number of NA entries in the vector
+#' @export
+#'
+#' @examples
+#' countNA(letters) # = 0
+#' countNA(c(letters, NA)) # = 1
+countNA <- function(x){
+  length(x[is.na(x)])
+}
+
+
+#' Count the number of unique values in a vector
+#'
+#' @param x a vector of values
+#'
+#' @return an integer equal to the number of unique values in a vector
+#' @export
+#'
+#' @examples
+#' nvals(letters) # = 26
+#' nvals(state.abb) # = 50
+nvals <- function(x){
+  length(unique(x))
+}
+
+
+#' Capitalize a character string after each space
+#'
+#' @param x a character string
+#'
+#' @return a vector of characters with all values after a space capitalized
+#' @export
+#'
+#' @examples
+#' my_string <- c("Happy school", "Easy school", "cool School", "big school")
+#' simpleCap(my_string)
+simpleCap <- function(x) {
+  stopifnot(class(x) == "character")
+  s <- strsplit(x, " ")[[1]]
+  paste(toupper(substring(s, 1,1)), substring(s, 2),
+        sep = "", collapse = " ")
+}
@@ -1,19 +1,19 @@
-#' Title
+#' Plot a jpeg image as a raster
 #'
-#' @param path
-#' @param add
-#' @param upscale
-#'
-#' @return
+#' @param path a character representing the relative or absolute path to the image
+#' @param add a logical, TRUE to add the image to an existing plot, FALSE creates a new plot
+#' @param upscale a logical, TRUE upscales the resolution of the graphic by a factor of 3, FALSE
+#' preserves the resolution
+#' @return a rasterImage
 #' @export
 #' @importFrom jpeg readJPEG
 #' @importFrom graphics rasterImage
 #' @examples
-#' img <- readJPEG(system.file("img","Rlogo.jpg",package="jpeg"))
+#' img <- system.file("img","Civilytics Consulting Logo.jpg",package="civilytics")
+#' plot_jpeg(img)
 plot_jpeg <- function(path, add=FALSE, upscale = TRUE)
 {
-  require('jpeg')
-  jpg = readJPEG(path, native=T) # read the file
+  jpg = readJPEG(path, native = T) # read the file
  res = dim(jpg)[2:1] # get the resolution, [x, y]
  if (upscale){
    res <- res * 3
@@ -26,9 +26,9 @@ plot_jpeg <- function(path, add=FALSE, upscale = TRUE)
 }


-#' Title
+#' Plot a PNG file as a rasterGrob for inclusion in ggplot2
 #'
-#' @param filename
+#' @param filename a character with file path to a png file
 #'
 #' @return
 #' @export
@@ -36,16 +36,17 @@ plot_jpeg <- function(path, add=FALSE, upscale = TRUE)
 #' @importFrom grid rasterGrob
 #'
 #' @examples
+#'
 get_png <- function(filename) {
  grid::rasterGrob(png::readPNG(filename), interpolate = TRUE)
 }


-#' Title
+#' Add a logo to a ggplot2 object
 #'
-#' @param plot
-#' @param logo
-#' @param margin_param
+#' @param plot a ggplot2 grob
+#' @param logo a logo grob created by make_logo_grob()
+#' @param margin_param a numeric specifying what margin to add or subtract to align the logo
 #'
 #' @return
 #' @importFrom ggplot2 theme
@@ -73,15 +74,18 @@ add_logo <- function(plot, logo, margin_param = NULL) {
              padding = unit(0.1, "line"))
 }

-#' Title
+#' Measure a ggplot2 object caption
 #'
-#' @param gg
+#' @param gg a ggplot object
 #'
-#' @return
+#' @return a numeric value stating the number of lines to be added or subtracted to align a logo with
+#' the caption
 #' @importFrom stringr str_count
 #' @export
 #'
 #' @examples
+#' p1 <- qplot(mpg, wt, data = mtcars)
+#' measure_caption(p1) # Should equal 1 since no caption is required
 measure_caption <- function(gg) {
  if (has_caption(gg)) {
    stringr::str_count(gg$labels$caption, pattern = "\n") + 1
@@ -91,32 +95,43 @@ measure_caption <- function(gg) {
 }


-#' Title
+#' Test whether a ggplot2 object has a caption
 #'
-#' @param gg
+#' @param gg a gg object from ggplot2
 #'
-#' @return
+#' @return a logical, TRUE if a caption exists and FALSE if it does not
+#' @import ggplot2
 #' @export
 #'
 #' @examples
+#' p1 <- ggplot2::qplot(mpg, wt, data = mtcars)
+#' has_caption(p1) # FALSE
 has_caption <- function(gg) {
  any(names(gg$labels) == "caption")
 }

-#' Title
+#' Add a logo to a ggplot2 object
 #'
-#' @param plot_list
-#' @param logo
-#' @param nrow
-#' @param widths
-#' @param margin_param
+#' @param plot_list a list containing ggplot2 objects
+#' @param logo a grob containing the logo created with `make_logo_grob`
+#' @param nrow an integer, default = 1, for the number of rows to align the plots in
+#' @param widths an optional vector the same length as plot_list with the widths for each plot
+#' @param margin_param a number giving the adjustment up or down to help manually align logo and captions
 #'
 #' @return
+#' @note The resulting object needs to be drawn to the screen using grid.draw()
 #' @importFrom gridExtra arrangeGrob
 #' @importFrom ggplot2 theme
+#' @importFrom grid grid.draw
 #' @export
 #'
 #' @examples
+#' library(ggplot2); library(grid)
+#' tmp_plot <- ggplot(mtcars) + aes(x = hp, y = disp) + geom_point() + theme_civilytics()
+#' tmp_logo <- make_logo_grob()
+#' plot_and_logo <- add_logo(tmp_plot, tmp_logo)
+#' grid.draw(plot_and_logo)
+#' dev.off()
 add_logo_ga <- function(plot_list, logo, nrow = 1, widths = NULL, margin_param = NULL) {
  # Change position of logo depending on if plot has a caption
  if (!is.null(margin_param)) {
@@ -146,14 +161,18 @@ add_logo_ga <- function(plot_list, logo, nrow = 1, widths = NULL, margin_param =

 #' Get a Civilytics Logo grob
 #'
-#' @return
+#' @return a gg object which contains the logo file stored as a Grob suitable for manipulating in
+#' grid
 #' @export
-#'
+#' @import ggplot2
 #' @examples
+#' logo <- make_logo_grob()
+#' class(logo) # gg
 make_logo_grob <- function() {
  logo_grob <- ggplot(mapping = aes(x = 0:1, y = 1)) +
    theme_void() +
    annotation_custom(get_png(system.file("img", "civilytics_logo.png",
-                                          package="civilytics")), xmin = 0.825, xmax = 1)
+                                          package="civilytics")), xmin= 0.7, xmax = 1)
  logo_grob
 }
+
@@ -1,17 +1,14 @@
-
-#' Title
+#' Make the Civilytics plot theme
 #'
-#' @param font_size
-#' @param font_family
-#' @param line_size
-#' @param rel_small
-#' @param rel_tiny
-#' @param rel_large
-#'
-#' @return
+#' @param font_size default 14, a number representing the base font for the theme
+#' @param font_family default "", a character for the font family to use in the theme
+#' @param line_size default 0.5, the line size to use for the theme
+#' @param rel_small default 12/14, the scale factor to create a small font from the base font_size
+#' @param rel_tiny default 11/14, the scale factor to create a tiny font from the base font_size
+#' @param rel_large default 16/14, the scale factor to create a large font from the base font_size
+#' @importFrom graphics plot
+#' @return a ggplot2 theme object suitable for combining with ggplot objects to theme them
 #' @export
-#'
-#' @examples
 theme_civilytics <-
  function (font_size = 14,
            font_family = "",
@@ -8,33 +8,38 @@
 #'
 #' @examples
 #' safe_max(1:10)
-#' safe_max(c(1:10, NA)) # 10
+#' safe_max(c(1:10, NA))# 10
 safe_max <- function(x) {
-  max(x, na.rm = TRUE)
+  if (all(is.na(x))) {
+    return(NA)
+  } else {
+    max(x, na.rm = TRUE)
+  }
 }

-
-
 #' Prettify proportion data
 #' Make data expresed as proportions print out as prettily formatted characters with percentages
 #'
 #' @param x a numeric vector of proportions to convert to percentages
-#' @param ndigit a vector of length 1 indicating the number of digits to display in the percent
+#' @param ndigit a vector of length 1 indicating the number of digits to display in the percent, by
+#' default it represents the digits after the decimal point in the percentage form
 #'
-#' @return
+#' @return a character vector with a % attached
 #' @export
 #'
 #' @examples
 #' pretty_per(0.2, ndigit = 1)
 #' pretty_per(c(0.2, 0.332423, 0.4, 0.342342), ndigit = 2)
 pretty_per <- function(x, ndigit = 1) {
-  x <- format(round(x, digits = 3) * 100, nsmall = ndigit)
+  if (any(x >= 100) & !all(is.na(x))) {
+    message("Values over 100 found, did you mean to use proportions?")
+  }
+  x <- format(round(x, digits = ndigit + 2) * 100, nsmall = ndigit)
  x <- paste0(x, "%")
  x[x == "NA%"] <- " - "
  x <- trimws(x)
  return(x)
 }
-options(knitr.kable.NA = "-")


 #' Zero out missing values