Browse Source

suppress warnings

master
boB Rudis 6 years ago
parent
commit
93446dfce4
No known key found for this signature in database GPG Key ID: 1D7529BE14E2BBA9
  1. 4
      DESCRIPTION
  2. 99
      R/geom-oscar.R
  3. 69
      R/geom-otile.R
  4. 7
      R/geom-statebins.r
  5. 48
      R/oscar-grob.R
  6. 6
      R/util.R
  7. 8
      man/geom_statebins.Rd

4
DESCRIPTION

@ -27,6 +27,7 @@ Description: Cartogram heatmaps are an alternative to choropleth maps for 'USA'
URL: https://github.com/hrbrmstr/statebins
BugReports: https://github.com/hrbrmstr/statebins/issues
License: MIT + file LICENSE
Encoding: UTF-8
Suggests:
testthat,
viridis,
@ -41,6 +42,9 @@ Imports:
RoxygenNote: 6.0.1.9000
Collate:
'aaa.R'
'geom-oscar.R'
'geom-otile.R'
'oscar-grob.R'
'geom-rrect.r'
'geom-rtile.R'
'geom-statebins.r'

99
R/geom-oscar.R

@ -0,0 +1,99 @@
geom_oscar <- function(mapping = NULL, data = NULL,
...,
na.rm = FALSE,
show.legend = NA,
inherit.aes = TRUE) {
stat = "oscar"
position = "identity"
layer(
data = data,
mapping = mapping,
stat = stat,
geom = GeomOscar,
position = position,
show.legend = show.legend,
inherit.aes = inherit.aes,
params = list(
na.rm = na.rm,
...
)
)
}
StatOscar<- ggplot2::ggproto("StatOscar", Stat,
required_aes = c("xmin", "xmax", "ymin", "ymax"),
default_aes = ggplot2::aes(
l_fill = "blue", r_fill = "red", colour = NA, size = 0.1, linetype = 1, alpha = NA
),
required_aes = c("x", "y"),
compute_panel = function(data, scales) {
data
}
)
stat_oscar <- function(mapping = NULL, data = NULL, geom = "oscar",
position = "identity", na.rm = FALSE, n = 500, revolutions = NULL,
show.legend = NA, inherit.aes = TRUE, ...) {
layer(
stat = StatOscar, data = data, mapping = mapping, geom = geom,
position = position, show.legend = show.legend, inherit.aes = inherit.aes,
params = list(na.rm = na.rm, ...)
)
}
GeomOscar <- ggplot2::ggproto("GeomOscar", ggplot2::Geom,
default_aes = ggplot2::aes(
l_fill = "blue", r_fill = "red", colour = NA, size = 0.1, linetype = 1, alpha = NA
),
draw_panel = function(self, data, panel_params, coord) {
coords <- coord$transform(data, panel_params)
lapply(1:length(coords$xmin), function(i) {
oscarGrob(
name = as.character(i),
coords$xmin[i], coords$ymax[i],
width = (coords$xmax[i] - coords$xmin[i]),
height = (coords$ymax[i] - coords$ymin)[i],
default.units = "native",
gpbl = grid::gpar(
col = coords$colour[i],
fill = alpha(coords$l_fill[i], coords$alpha[i]),
lwd = coords$size[i] * .pt,
lty = coords$linetype[i],
lineend = "butt"
),
gptr = grid::gpar(
col = coords$colour[i],
fill = alpha(coords$r_fill[i], coords$alpha[i]),
lwd = coords$size[i] * .pt,
lty = coords$linetype[i],
lineend = "butt"
)
)
}) -> gl
grobs <- do.call(grid::gList, gl)
ggname("geom_oscar", grid::grobTree(children = grobs))
},
draw_key = ggplot2::draw_key_polygon
)

69
R/geom-otile.R

@ -0,0 +1,69 @@
geom_otile <- function(mapping = NULL, data = NULL, ...,
na.rm = FALSE,
show.legend = NA,
inherit.aes = TRUE) {
stat <- "otile"
position <- "identity"
ggplot2::layer(
data = data,
mapping = mapping,
stat = stat,
geom = GeomOtile,
position = position,
show.legend = show.legend,
inherit.aes = inherit.aes,
params = list(
na.rm = na.rm,
...
)
)
}
StatOtile <- ggplot2::ggproto("StatOtile", Stat,
default_aes = ggplot2::aes(
colour = NA, size = 0.1, linetype = 1, alpha = NA, l_fill="blue", r_fill="red"
),
required_aes = c("x", "y"),
compute_panel = function(data, scales) {
data
}
)
stat_otile <- function(mapping = NULL, data = NULL, geom = "otile",
position = "identity", na.rm = FALSE,
show.legend = NA, inherit.aes = TRUE, ...) {
layer(
stat = StatOtile, data = data, mapping = mapping, geom = geom,
position = position, show.legend = show.legend, inherit.aes = inherit.aes,
params = list(na.rm = na.rm, ...)
)
}
GeomOtile <- ggplot2::ggproto("GeomOtile", GeomOscar,
default_aes = ggplot2::aes(
l_fill = "blue", r_fill = "red", colour = NA, size = 0.1, linetype = 1, alpha = NA
),
setup_data = function(data, params) {
data$width <- data$width %||% params$width %||% ggplot2::resolution(data$x, FALSE)
data$height <- data$height %||% params$height %||% ggplot2::resolution(data$y, FALSE)
transform(data,
xmin = x - width / 2, xmax = x + width / 2, width = NULL,
ymin = y - height / 2, ymax = y + height / 2, height = NULL
)
},
draw_key = ggplot2::draw_key_polygon
)

7
R/geom-statebins.r

@ -30,7 +30,7 @@
#' @param border_col border color of the state squares, default "`white`"
#' @param border_size thickness of the square state borders
#' @param lbl_size font size (relative) of the label text
#' @param dark_lbl,light_lbl,na_lbl colors to be uses when the label should be dark, light, or NA.
#' @param dark_lbl,light_lbl colrs to be uses when the label should be dark or light.
#' The function automagically computes when this should be.
#' @param radius the corner radius
#' @param na.rm If `FALSE`, the default, missing values are removed with
@ -72,7 +72,7 @@
geom_statebins <- function(
mapping = NULL, data = NULL,
border_col = "white", border_size = 2,
lbl_size = 3, dark_lbl = "black", light_lbl = "white", na_lbl = "white",
lbl_size = 3, dark_lbl = "black", light_lbl = "white",
radius = grid::unit(6, "pt"),
...,
na.rm = FALSE, show.legend = NA, inherit.aes = TRUE) {
@ -147,7 +147,6 @@ GeomStatebins <- ggplot2::ggproto("GeomStatebins", ggplot2::Geom,
draw_panel = function(self, data, panel_params, coord,
border_col = "white", border_size = 2,
lbl_size = 3, dark_lbl = "black", light_lbl = "white",
na_lbl = "white",
radius = grid::unit(6, "pt")) {
tile_data <- data
@ -159,7 +158,7 @@ GeomStatebins <- ggplot2::ggproto("GeomStatebins", ggplot2::Geom,
text_data$label <- data$abbrev
text_data$fill <- NA
text_data$size <- lbl_size
text_data$colour <- .sb_invert(data$fill, dark_lbl, light_lbl, na_lbl)
text_data$colour <- .sb_invert(data$fill, dark_lbl, light_lbl)
coord <- coord_equal()

48
R/oscar-grob.R

@ -0,0 +1,48 @@
oscarGrob <- function(x=unit(0.5, "npc"), y=unit(0.5, "npc"),
width=unit(1, "npc"), height=unit(1, "npc"),
default.units="npc",
name=NULL, gpbl=gpar(), gptr=gpar(), vp=NULL) {
if (!is.unit(x))
x <- unit(x, default.units)
if (!is.unit(y))
y <- unit(y, default.units)
if (!is.unit(width))
width <- unit(width, default.units)
if (!is.unit(height))
height <- unit(height, default.units)
if (length(name) == 0) name <- "oscar"
ggname(
name,
grid::grobTree(
grob(x=unit.c(x, x+width, x, x),
y=unit.c(y, y, y+height, y),
name=sprintf("%s_bl", name), gp=gpbl, vp=vp, cl="polygon"),
grob(x=unit.c(x+width, x, x+width, x+width),
y=unit.c(y+height, y+height, y, y+height),
name=sprintf("%s_tr", name), gp=gptr, vp=vp, cl="polygon")
)
)
}
grid.oscar <- function(x=unit(0.5, "npc"), y=unit(0.5, "npc"),
width=unit(1, "npc"), height=unit(1, "npc"),
default.units="npc",
name=NULL, gpbl=gpar(), gptr=gpar(),
draw=TRUE, vp=NULL) {
rg <- oscarGrob(x=x, y=y, width=width, height=height,
default.units=default.units,
name=name, gpbl=gpbl, gptr=gptr, vp=vp)
if (draw)
grid.draw(rg)
invisible(rg)
}

6
R/util.R

@ -3,9 +3,9 @@
hex_color <- gsub("#", "", hex_color)
R <- as.integer(paste("0x", substr(hex_color,1,2), sep=""))
G <- as.integer(paste("0x", substr(hex_color,3,4), sep=""))
B <- as.integer(paste("0x", substr(hex_color,5,6), sep=""))
R <- suppressWarnings(as.integer(paste("0x", substr(hex_color,1,2), sep="")))
G <- suppressWarnings(as.integer(paste("0x", substr(hex_color,3,4), sep="")))
B <- suppressWarnings(as.integer(paste("0x", substr(hex_color,5,6), sep="")))
YIQ <- ((R*299) + (G*587) + (B*114)) / 1000

8
man/geom_statebins.Rd

@ -5,12 +5,12 @@
\alias{geom_statebins}
\alias{GeomStatebins}
\title{A statebins Geom}
\format{An object of class \code{GeomStatebins} (inherits from \code{Geom}, \code{ggproto}) of length 7.}
\format{An object of class \code{GeomStatebins} (inherits from \code{Geom}, \code{ggproto}, \code{gg}) of length 7.}
\usage{
geom_statebins(mapping = NULL, data = NULL, border_col = "white",
border_size = 2, lbl_size = 3, dark_lbl = "black",
light_lbl = "white", na_lbl = "white", radius = grid::unit(6, "pt"),
..., na.rm = FALSE, show.legend = NA, inherit.aes = TRUE)
light_lbl = "white", radius = grid::unit(6, "pt"), ..., na.rm = FALSE,
show.legend = NA, inherit.aes = TRUE)
GeomStatebins
}
@ -40,7 +40,7 @@ will be used as the layer data.}
\item{lbl_size}{font size (relative) of the label text}
\item{dark_lbl, light_lbl, na_lbl}{colors to be uses when the label should be dark, light, or NA.
\item{dark_lbl, light_lbl}{colrs to be uses when the label should be dark or light.
The function automagically computes when this should be.}
\item{radius}{the corner radius}

Loading…
Cancel
Save