From 1f41a4560daff218bcbd13655ad67f8ddbbfc952 Mon Sep 17 00:00:00 2001 From: Jared Knowles Date: Thu, 13 Feb 2020 16:48:38 -0500 Subject: [PATCH] initial commit --- .Rbuildignore | 3 + .gitignore | 4 ++ DESCRIPTION | 14 ++++ NAMESPACE | 2 + R/logo.R | 107 +++++++++++++++++++++++++++++ R/theme.R | 171 +++++++++++++++++++++++++++++++++++++++++++++++ R/utils.R | 65 ++++++++++++++++++ civilytics.Rproj | 20 ++++++ man/hello.Rd | 12 ++++ tests/testthat.R | 4 ++ 10 files changed, 402 insertions(+) create mode 100644 .Rbuildignore create mode 100644 .gitignore create mode 100644 DESCRIPTION create mode 100644 NAMESPACE create mode 100644 R/logo.R create mode 100644 R/theme.R create mode 100644 R/utils.R create mode 100644 civilytics.Rproj create mode 100644 man/hello.Rd create mode 100644 tests/testthat.R diff --git a/.Rbuildignore b/.Rbuildignore new file mode 100644 index 0000000..757aefe --- /dev/null +++ b/.Rbuildignore @@ -0,0 +1,3 @@ +^.*\.Rproj$ +^\.Rproj\.user$ +^\.github$ diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..d44df33 --- /dev/null +++ b/.gitignore @@ -0,0 +1,4 @@ +.Rproj.user +.Rhistory +.RData +.Ruserdata diff --git a/DESCRIPTION b/DESCRIPTION new file mode 100644 index 0000000..7936760 --- /dev/null +++ b/DESCRIPTION @@ -0,0 +1,14 @@ +Package: civilytics +Type: Package +Title: Utilities Functions for Civilytics +Version: 0.1.0 +Author: Jared E. Knowles +Maintainer: Jared E. Knowles +Description: More about what it does (maybe more than one line) + Use four spaces when indenting paragraphs within the Description. +License: LICENSE +Encoding: UTF-8 +LazyData: true +Suggests: + testthat +RoxygenNote: 7.0.2 diff --git a/NAMESPACE b/NAMESPACE new file mode 100644 index 0000000..6ae9268 --- /dev/null +++ b/NAMESPACE @@ -0,0 +1,2 @@ +# Generated by roxygen2: do not edit by hand + diff --git a/R/logo.R b/R/logo.R new file mode 100644 index 0000000..4da5ea0 --- /dev/null +++ b/R/logo.R @@ -0,0 +1,107 @@ + + +#' Title +#' +#' @param path +#' @param add +#' @param upscale +#' +#' @return +#' @export +#' @importFrom jpeg readJPEG +#' +#' @examples +#' img <- readJPEG(system.file("img","Rlogo.jpg",package="jpeg")) +plot_jpeg <- function(path, add=FALSE, upscale = TRUE) +{ + require('jpeg') + jpg = readJPEG(path, native=T) # read the file + res = dim(jpg)[2:1] # get the resolution, [x, y] + if (upscale){ + res <- res * 3 + } + if (!add) # initialize an empty plot area if add==FALSE + plot(1,1,xlim=c(1,res[1]),ylim=c(1,res[2]),asp=1,type='n',xaxs='i',yaxs='i', + xaxt='n',yaxt='n',xlab='',ylab='',bty='n', oma=c(0,0,1,1), mar=c(0,0,1,1) + ) + rasterImage(jpg,1,1,res[1],res[2],interpolate=TRUE) +} + + +#' Title +#' +#' @param filename +#' +#' @return +#' @export +#' @importFrom png readPNG +#' @importFrom grid rasterGrob +#' +#' @examples +get_png <- function(filename) { + grid::rasterGrob(png::readPNG(filename), interpolate = TRUE) +} + + +add_logo <- function(plot, logo, margin_param = NULL) { + if(has_caption(plot)) { + # convert the caption size to a negative number and on the "pt" scale + # p1$theme$plot.caption$size * 1.1 + # Count the number of lines, which is this + 1 + # For each line, we can add a certain negative space to align the logo + cap_lines <- measure_caption(plot) + if (!is.null(margin_param)) { + plot <- plot + theme(plot.margin = unit(c(7, 7, margin_param, 7), "pt")) + } else { + plot <- plot + theme(plot.margin = unit(c(7, 7, cap_lines * -52, 7), "pt")) + } + } else { + plot <- plot + theme(plot.margin = unit(c(7, 7, -14, 7), "pt")) + } + + arrangeGrob(plot, logo, heights = c(0.93, 0.1), + padding = unit(0.1, "line")) +} + +measure_caption <- function(gg) { + if (has_caption(gg)) { + stringr::str_count(gg$labels$caption, pattern = "\n") + 1 + } else { + 1 + } +} + +has_caption <- function(gg) { + any(names(gg$labels) == "caption") +} + +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)) { + margin <- theme(plot.margin = unit(c(7, 7, margin_param, 7), "pt")) + } else if (any(unlist(lapply(plot_list, has_caption)))) { + cap_lines <- measure_caption(plot_list[[1]]) # measure caption in first plot + margin <- theme(plot.margin = unit(c(7, 7, -7 * sqrt(cap_lines), 7), "pt")) + } else { + margin <- theme(plot.margin = unit(c(7, 7, 7, 7), "pt")) + } + if (nrow > 1) { + len <- length(plot_list) + plot_list[[len]] <- plot_list[[len]] + margin + } else { + plot_list <- lapply(plot_list, "+", margin) + } + + if (nrow != 1) { + hold <- arrangeGrob(grobs = plot_list, nrow = nrow, ncol = 1, widths = widths) + } else { + hold <- arrangeGrob(grobs = plot_list, nrow = 1, ncol = 2, widths = widths) + } + + arrangeGrob(hold, logo, heights = c(0.93, .07)) +} + + +logo_grob <- ggplot(mapping = aes(x = 0:1, y = 1)) + + theme_void() + + annotation_custom(get_png("data/civilytics_logo.png"), xmin = 0.825, xmax = 1) diff --git a/R/theme.R b/R/theme.R new file mode 100644 index 0000000..164678c --- /dev/null +++ b/R/theme.R @@ -0,0 +1,171 @@ + +#' Title +#' +#' @param font_size +#' @param font_family +#' @param line_size +#' @param rel_small +#' @param rel_tiny +#' @param rel_large +#' +#' @return +#' @export +#' +#' @examples +theme_civilytics <- + function (font_size = 14, + font_family = "", + line_size = 0.5, + rel_small = 12 / 14, + rel_tiny = 11 / 14, + rel_large = 16 / 14) { + half_line <- font_size / 2 + small_size <- rel_small * font_size + theme_grey(base_size = font_size, base_family = font_family) %+replace% + theme( + line = element_line( + color = "black", + size = line_size, + linetype = 1, + lineend = "butt" + ), + rect = element_rect( + fill = NA, + color = NA, + size = line_size, + linetype = 1 + ), + text = element_text( + family = font_family, + face = "plain", + color = "black", + size = font_size, + hjust = 0.5, + vjust = 0.5, + angle = 0, + lineheight = 0.9, + margin = margin(), + debug = FALSE + ), + axis.line = element_line( + color = "black", + size = line_size, + lineend = "square" + ), + axis.line.x = NULL, + axis.line.y = NULL, + axis.text = element_text(color = "black", + size = small_size), + axis.text.x = element_text(margin = margin(t = small_size / 4), + vjust = 1), + axis.text.x.top = element_text(margin = margin(b = small_size / 4), + vjust = 0), + axis.text.y = element_text(margin = margin(r = small_size / 4), + hjust = 1), + axis.text.y.right = element_text(margin = margin(l = small_size / 4), + hjust = 0), + axis.ticks = element_line(color = "black", + size = line_size), + axis.ticks.length = unit(half_line / 2, + "pt"), + axis.title.x = element_text(margin = margin(t = half_line / 2), + vjust = 1), + axis.title.x.top = element_text(margin = margin(b = half_line / 2), + vjust = 0), + axis.title.y = element_text( + angle = 90, + margin = margin(r = half_line / + 2), + vjust = 1 + ), + axis.title.y.right = element_text( + angle = -90, + margin = margin(l = half_line / 2), + vjust = 0 + ), + legend.background = element_blank(), + legend.spacing = unit(font_size, "pt"), + legend.spacing.x = NULL, + legend.spacing.y = NULL, + legend.margin = margin(0, + 0, 0, 0), + legend.key = element_blank(), + legend.key.size = unit(1.1 * + font_size, "pt"), + legend.key.height = NULL, + legend.key.width = NULL, + legend.text = element_text(size = rel(rel_small)), + legend.text.align = NULL, + legend.title = element_text(hjust = 0), + legend.title.align = NULL, + legend.position = "right", + legend.direction = NULL, + legend.justification = c("left", + "center"), + legend.box = NULL, + legend.box.margin = margin(0, + 0, 0, 0), + legend.box.background = element_blank(), + legend.box.spacing = unit(font_size, "pt"), + panel.background = element_blank(), + panel.border = element_blank(), + panel.grid = element_blank(), + panel.grid.major = NULL, + panel.grid.minor = NULL, + panel.grid.major.x = NULL, + panel.grid.major.y = NULL, + panel.grid.minor.x = NULL, + panel.grid.minor.y = NULL, + panel.spacing = unit(half_line, + "pt"), + panel.spacing.x = NULL, + panel.spacing.y = NULL, + panel.ontop = FALSE, + strip.background = element_rect(fill = "grey80"), + strip.text = element_text( + size = rel(rel_small), + margin = margin(half_line / 2, half_line / + 2, half_line / 2, + half_line / 2) + ), + strip.text.x = NULL, + strip.text.y = element_text(angle = -90), + strip.placement = "inside", + strip.placement.x = NULL, + strip.placement.y = NULL, + strip.switch.pad.grid = unit(half_line / 2, + "pt"), + strip.switch.pad.wrap = unit(half_line / 2, + "pt"), + plot.background = element_blank(), + plot.title = element_text( + face = "bold", + size = rel(rel_large), + hjust = 0, + vjust = 1, + margin = margin(b = half_line) + ), + plot.subtitle = element_text( + size = rel(rel_small), + hjust = 0, + vjust = 1, + margin = margin(b = half_line) + ), + plot.caption = element_text( + size = rel(rel_tiny), + hjust = 0, # set hjust to 0 + vjust = 1, + lineheight = 1, + margin = margin(t = half_line) + ), + plot.tag = element_text( + face = "bold", + hjust = 0, + vjust = 0.7 + ), + plot.tag.position = c(0, 1), + plot.margin = margin(half_line, + half_line, half_line, half_line), + complete = TRUE + ) + } diff --git a/R/utils.R b/R/utils.R new file mode 100644 index 0000000..0bd1619 --- /dev/null +++ b/R/utils.R @@ -0,0 +1,65 @@ +#' Safe maximum +#' Take the max but ignore missing values +#' +#' @param x a numeric vector which may contain NA values +#' +#' @return the maximum non-missing value +#' @export +#' +#' @examples +#' safe_max(1:10) +#' safe_max(c(1:10, NA)) # 10 +safe_max <- function(x) { + 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 +#' +#' @return +#' @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) + x <- paste0(x, "%") + x[x == "NA%"] <- " - " + x <- trimws(x) + return(x) +} +options(knitr.kable.NA = "-") + + +#' Title +#' +#' @param x +#' +#' @return +#' @export +#' +#' @examples +na_zero <- function(x) { + x[is.na(x)] <- 0 + return(x) +} + + +#' Title +#' +#' @param x +#' +#' @return +#' @export +#' +#' @examples +pretty_count <- function(x) { + x <- prettyNum(x, big.mark = ",") + return(x) +} diff --git a/civilytics.Rproj b/civilytics.Rproj new file mode 100644 index 0000000..b9255bc --- /dev/null +++ b/civilytics.Rproj @@ -0,0 +1,20 @@ +Version: 1.0 + +RestoreWorkspace: Default +SaveWorkspace: Default +AlwaysSaveHistory: Default + +EnableCodeIndexing: Yes +UseSpacesForTab: Yes +NumSpacesForTab: 2 +Encoding: UTF-8 + +RnwWeave: Sweave +LaTeX: pdfLaTeX + +AutoAppendNewline: Yes +StripTrailingWhitespace: Yes + +BuildType: Package +PackageUseDevtools: Yes +PackageInstallArgs: --no-multiarch --with-keep.source diff --git a/man/hello.Rd b/man/hello.Rd new file mode 100644 index 0000000..ead5524 --- /dev/null +++ b/man/hello.Rd @@ -0,0 +1,12 @@ +\name{hello} +\alias{hello} +\title{Hello, World!} +\usage{ +hello() +} +\description{ +Prints 'Hello, world!'. +} +\examples{ +hello() +} diff --git a/tests/testthat.R b/tests/testthat.R new file mode 100644 index 0000000..736bc98 --- /dev/null +++ b/tests/testthat.R @@ -0,0 +1,4 @@ +library(testthat) +library(civilytics) + +test_check("civilytics")