@ -0,0 +1,9 @@ |
|||||
|
#' Fortify contingency tables |
||||
|
#' |
||||
|
#' @param model the contingency table |
||||
|
#' @param data data (unused) |
||||
|
#' @param ... (unused) |
||||
|
#' @export |
||||
|
fortify.table <- function(model, data, ...) { |
||||
|
as_tibble(as.data.frame(model, stringsAsFactors=FALSE)) |
||||
|
} |
@ -0,0 +1,73 @@ |
|||||
|
#' @export |
||||
|
geom_twoway_bar <- function(mapping = NULL, data = NULL, |
||||
|
stat = "identity", |
||||
|
width = NULL, |
||||
|
..., |
||||
|
na.rm = FALSE, |
||||
|
show.legend = NA, |
||||
|
inherit.aes = TRUE) { |
||||
|
|
||||
|
layer( |
||||
|
data = data, |
||||
|
mapping = mapping, |
||||
|
stat = stat, |
||||
|
geom = GeomTwowayBar, |
||||
|
position = "stack", |
||||
|
show.legend = show.legend, |
||||
|
inherit.aes = inherit.aes, |
||||
|
params = list( |
||||
|
width = width, |
||||
|
na.rm = na.rm, |
||||
|
... |
||||
|
) |
||||
|
) |
||||
|
} |
||||
|
|
||||
|
#' @rdname ggalt-ggproto |
||||
|
#' @format NULL |
||||
|
#' @usage NULL |
||||
|
#' @export |
||||
|
GeomTwowayBar <- ggproto("GeomTwowayBar", GeomRect, |
||||
|
required_aes = c("x", "y"), |
||||
|
|
||||
|
do_setup_data = function(data, params) { |
||||
|
data$width <- data$width %||% |
||||
|
params$width %||% (resolution(data$x, FALSE) * 0.9) |
||||
|
|
||||
|
d_plus <- subset(data, y>=0, drop=FALSE) |
||||
|
d_minus <- subset(data, y<0, drop=FALSE) |
||||
|
|
||||
|
d_plus <- transform(d_plus, |
||||
|
ymin = pmin(y, 0), ymax = pmax(y, 0), |
||||
|
xmin = x - width / 2, xmax = x + width / 2, width = NULL, |
||||
|
is_plus = TRUE |
||||
|
) |
||||
|
|
||||
|
d_minus <- transform(d_minus, |
||||
|
ymin = pmin(y, 0), ymax = pmax(y, 0), |
||||
|
xmin = x - width / 2, xmax = x + width / 2, width = NULL, |
||||
|
y = abs(y), |
||||
|
is_plus = FALSE |
||||
|
) |
||||
|
|
||||
|
cat("setup_data() after _________\n") |
||||
|
print(rbind(d_plus, d_minus)) |
||||
|
|
||||
|
rbind(d_plus, d_minus) |
||||
|
|
||||
|
}, |
||||
|
|
||||
|
draw_panel = function(self, data, panel_scales, coord, width=NULL) { |
||||
|
|
||||
|
cat("draw_panel() _________\n") |
||||
|
print(data) |
||||
|
# |
||||
|
# d_plus <- subset(data, is_plus) |
||||
|
# d_minus <- subset(data, !is_plus) |
||||
|
# d_minus$y <- -d_minus$y |
||||
|
|
||||
|
gList( |
||||
|
ggplot2::ggproto_parent(GeomBar, self)$draw_panel(data, panel_scales, coord) |
||||
|
) |
||||
|
} |
||||
|
) |
@ -0,0 +1,87 @@ |
|||||
|
#' Step ribbon statistic |
||||
|
#' |
||||
|
#' Provides stairstep values for ribbon plots |
||||
|
#' |
||||
|
#' @inheritParams ggplot2::geom_ribbon |
||||
|
#' @param direction \code{hv} for horizontal-veritcal steps, \code{vh} for |
||||
|
#' vertical-horizontal steps |
||||
|
#' @references \url{https://groups.google.com/forum/?fromgroups=#!topic/ggplot2/9cFWHaH1CPs} |
||||
|
#' @export |
||||
|
#' @examples |
||||
|
#' x <- 1:10 |
||||
|
#' df <- data.frame(x=x, y=x+10, ymin=x+7, ymax=x+12) |
||||
|
#' |
||||
|
#' gg <- ggplot(df, aes(x, y)) |
||||
|
#' gg <- gg + geom_ribbon(aes(ymin=ymin, ymax=ymax), |
||||
|
#' stat="stepribbon", fill="#b2b2b2") |
||||
|
#' gg <- gg + geom_step(color="#2b2b2b") |
||||
|
#' gg |
||||
|
#' |
||||
|
#' gg <- ggplot(df, aes(x, y)) |
||||
|
#' gg <- gg + geom_ribbon(aes(ymin=ymin, ymax=ymax), |
||||
|
#' stat="stepribbon", fill="#b2b2b2", |
||||
|
#' direction="hv") |
||||
|
#' gg <- gg + geom_step(color="#2b2b2b") |
||||
|
#' gg |
||||
|
stat_stepribbon <- function(mapping=NULL, data=NULL, geom="ribbon", |
||||
|
position="identity", |
||||
|
na.rm=FALSE, show.legend=NA, inherit.aes=TRUE, |
||||
|
direction="hv", ...) { |
||||
|
|
||||
|
ggplot2::layer( |
||||
|
data = data, |
||||
|
mapping = mapping, |
||||
|
stat = Stepribbon, |
||||
|
geom = geom, |
||||
|
position = position, |
||||
|
show.legend = show.legend, |
||||
|
inherit.aes = inherit.aes, |
||||
|
params = list( |
||||
|
na.rm = na.rm, |
||||
|
direction = direction, |
||||
|
... |
||||
|
) |
||||
|
) |
||||
|
} |
||||
|
|
||||
|
#' @rdname ggalt-ggproto |
||||
|
#' @format NULL |
||||
|
#' @usage NULL |
||||
|
#' @references \url{https://groups.google.com/forum/?fromgroups=#!topic/ggplot2/9cFWHaH1CPs} |
||||
|
#' @export |
||||
|
StatStepribbon <- |
||||
|
ggproto( |
||||
|
"StepRibbon", Stat, |
||||
|
|
||||
|
required_aes = c("x", "ymin", "ymax"), |
||||
|
|
||||
|
compute_group = function(data, scales, direction="hv", |
||||
|
yvars=c("ymin", "ymax"), ...) { |
||||
|
stairstepn(data=data, direction=direction, yvars=yvars) |
||||
|
} |
||||
|
|
||||
|
) |
||||
|
|
||||
|
stairstepn <- function(data, direction="hv", yvars="y") { |
||||
|
|
||||
|
direction <- match.arg(direction, c("hv", "vh")) |
||||
|
|
||||
|
data <- as.data.frame(data)[order(data$x),] |
||||
|
|
||||
|
n <- nrow(data) |
||||
|
|
||||
|
if (direction == "vh") { |
||||
|
xs <- rep(1:n, each=2)[-2*n] |
||||
|
ys <- c(1, rep( 2:n, each=2)) |
||||
|
} else { |
||||
|
ys <- rep(1:n, each=2)[-2*n] |
||||
|
xs <- c(1, rep(2:n, each=2)) |
||||
|
} |
||||
|
|
||||
|
data.frame( |
||||
|
x=data$x[xs], |
||||
|
data[ys, yvars, drop=FALSE], |
||||
|
data[xs, setdiff(names(data), c("x", yvars)), drop=FALSE] |
||||
|
) |
||||
|
|
||||
|
} |
Before Width: | Height: | Size: 183 KiB After Width: | Height: | Size: 182 KiB |
Before Width: | Height: | Size: 121 KiB After Width: | Height: | Size: 121 KiB |
Before Width: | Height: | Size: 49 KiB After Width: | Height: | Size: 49 KiB |
Before Width: | Height: | Size: 58 KiB After Width: | Height: | Size: 58 KiB |
Before Width: | Height: | Size: 62 KiB After Width: | Height: | Size: 62 KiB |
Before Width: | Height: | Size: 53 KiB After Width: | Height: | Size: 54 KiB |
Before Width: | Height: | Size: 47 KiB After Width: | Height: | Size: 47 KiB |
Before Width: | Height: | Size: 83 KiB After Width: | Height: | Size: 83 KiB |
Before Width: | Height: | Size: 83 KiB After Width: | Height: | Size: 83 KiB |
After Width: | Height: | Size: 38 KiB |
After Width: | Height: | Size: 38 KiB |
@ -0,0 +1,19 @@ |
|||||
|
% Generated by roxygen2: do not edit by hand |
||||
|
% Please edit documentation in R/fortify.r |
||||
|
\name{fortify.table} |
||||
|
\alias{fortify.table} |
||||
|
\title{Fortify contingency tables} |
||||
|
\usage{ |
||||
|
\method{fortify}{table}(model, data, ...) |
||||
|
} |
||||
|
\arguments{ |
||||
|
\item{model}{the contingency table} |
||||
|
|
||||
|
\item{data}{data (unused)} |
||||
|
|
||||
|
\item{...}{(unused)} |
||||
|
} |
||||
|
\description{ |
||||
|
Fortify contingency tables |
||||
|
} |
||||
|
|
@ -0,0 +1,76 @@ |
|||||
|
% Generated by roxygen2: do not edit by hand |
||||
|
% Please edit documentation in R/stat-stepribbon.r |
||||
|
\name{stat_stepribbon} |
||||
|
\alias{stat_stepribbon} |
||||
|
\title{Step ribbon statistic} |
||||
|
\usage{ |
||||
|
stat_stepribbon(mapping = NULL, data = NULL, geom = "ribbon", |
||||
|
position = "identity", na.rm = FALSE, show.legend = NA, |
||||
|
inherit.aes = TRUE, direction = "hv", ...) |
||||
|
} |
||||
|
\arguments{ |
||||
|
\item{mapping}{Set of aesthetic mappings created by \code{\link{aes}} or |
||||
|
\code{\link{aes_}}. If specified and \code{inherit.aes = TRUE} (the |
||||
|
default), it is combined with the default mapping at the top level of the |
||||
|
plot. You must supply \code{mapping} if there is no plot mapping.} |
||||
|
|
||||
|
\item{data}{The data to be displayed in this layer. There are three |
||||
|
options: |
||||
|
|
||||
|
If \code{NULL}, the default, the data is inherited from the plot |
||||
|
data as specified in the call to \code{\link{ggplot}}. |
||||
|
|
||||
|
A \code{data.frame}, or other object, will override the plot |
||||
|
data. All objects will be fortified to produce a data frame. See |
||||
|
\code{\link{fortify}} for which variables will be created. |
||||
|
|
||||
|
A \code{function} will be called with a single argument, |
||||
|
the plot data. The return value must be a \code{data.frame.}, and |
||||
|
will be used as the layer data.} |
||||
|
|
||||
|
\item{position}{Position adjustment, either as a string, or the result of |
||||
|
a call to a position adjustment function.} |
||||
|
|
||||
|
\item{na.rm}{If \code{FALSE} (the default), removes missing values with |
||||
|
a warning. If \code{TRUE} silently removes missing values.} |
||||
|
|
||||
|
\item{show.legend}{logical. Should this layer be included in the legends? |
||||
|
\code{NA}, the default, includes if any aesthetics are mapped. |
||||
|
\code{FALSE} never includes, and \code{TRUE} always includes.} |
||||
|
|
||||
|
\item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, |
||||
|
rather than combining with them. This is most useful for helper functions |
||||
|
that define both data and aesthetics and shouldn't inherit behaviour from |
||||
|
the default plot specification, e.g. \code{\link{borders}}.} |
||||
|
|
||||
|
\item{direction}{\code{hv} for horizontal-veritcal steps, \code{vh} for |
||||
|
vertical-horizontal steps} |
||||
|
|
||||
|
\item{...}{other arguments passed on to \code{\link{layer}}. These are |
||||
|
often aesthetics, used to set an aesthetic to a fixed value, like |
||||
|
\code{color = "red"} or \code{size = 3}. They may also be parameters |
||||
|
to the paired geom/stat.} |
||||
|
} |
||||
|
\description{ |
||||
|
Provides stairstep values for ribbon plots |
||||
|
} |
||||
|
\examples{ |
||||
|
df <- data.frame(x=1:10, y=x+10, ymin=x+7, ymax=x+12) |
||||
|
|
||||
|
gg <- ggplot(df, aes(x, y)) |
||||
|
gg <- gg + geom_ribbon(aes(ymin=ymin, ymax=ymax), |
||||
|
stat="stepribbon", fill="#b2b2b2") |
||||
|
gg <- gg + geom_step(color="#2b2b2b") |
||||
|
gg |
||||
|
|
||||
|
gg <- ggplot(df, aes(x, y)) |
||||
|
gg <- gg + geom_ribbon(aes(ymin=ymin, ymax=ymax), |
||||
|
stat="stepribbon", fill="#b2b2b2", |
||||
|
direction="hv") |
||||
|
gg <- gg + geom_step(color="#2b2b2b") |
||||
|
gg |
||||
|
} |
||||
|
\references{ |
||||
|
\url{https://groups.google.com/forum/?fromgroups=#!topic/ggplot2/9cFWHaH1CPs} |
||||
|
} |
||||
|
|