hrbrmstr
/
statebins
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity
Browse Source

cleanup to pass CRAN checks

master
boB Rudis 4 years ago
parent
96add2849f
commit
da22fb7a95
No known key found for this signature in database GPG Key ID: 1D7529BE14E2BBA9
4 changed files with 217 additions and 216 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Unified View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 1
      .Rbuildignore
  2. 198
      R/geom-oscar.R
  3. 138
      R/geom-otile.R
  4. 96
      R/oscar-grob.R

1
.Rbuildignore
View File

@ -16,3 +16,4 @@
^appveyor\.yml$ ^appveyor\.yml$
^codecov\.yml$ ^codecov\.yml$
^data-raw$ ^data-raw$
^\.github$

198
R/geom-oscar.R
View File

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

138
R/geom-otile.R
View File

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

96
R/oscar-grob.R
View File

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

Write Preview
Loading…
Cancel
Save