initial commit
This commit is contained in:
Jared Knowles
@@ -0,0 +1,3 @@
|
||||
^.*\.Rproj$
|
||||
^\.Rproj\.user$
|
||||
^\.github$
|
||||
@@ -0,0 +1,4 @@
|
||||
.Rproj.user
|
||||
.Rhistory
|
||||
.RData
|
||||
.Ruserdata
|
||||
+14
@@ -0,0 +1,14 @@
|
||||
Package: civilytics
|
||||
Type: Package
|
||||
Title: Utilities Functions for Civilytics
|
||||
Version: 0.1.0
|
||||
Author: Jared E. Knowles <jared@civilytics.com>
|
||||
Maintainer: Jared E. Knowles <jared@civilytics.com>
|
||||
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
|
||||
@@ -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)
|
||||
@@ -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
|
||||
)
|
||||
}
|
||||
@@ -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)
|
||||
}
|
||||
@@ -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
|
||||
@@ -0,0 +1,12 @@
|
||||
\name{hello}
|
||||
\alias{hello}
|
||||
\title{Hello, World!}
|
||||
\usage{
|
||||
hello()
|
||||
}
|
||||
\description{
|
||||
Prints 'Hello, world!'.
|
||||
}
|
||||
\examples{
|
||||
hello()
|
||||
}
|
||||
@@ -0,0 +1,4 @@
|
||||
library(testthat)
|
||||
library(civilytics)
|
||||
|
||||
test_check("civilytics")
|
||||
Reference in New Issue
Block a user