Status Quo
library(tidyverse)
normal_transformer <- function(x) {
function(x) {(x - min(x))/(max(x)-min(x))}
}
PositionWrap <- ggproto('PositionWrap', Position,
# We need an x and y position aesthetic
required_aes = c('x', 'y', 'wrap'),
# By using the "self" argument we can access parameters that the
# user has passed to the position, and add them as layer parameters
setup_params = function(self, data) {
list(
# sd_x = self$sd_x,
# sd_y = self$sd_y
)
},
# When computing the layer, we can read the standard deviation
# parameters off the param list, and use them to transform the
# position aesthetics
compute_layer = function(data, params, panel) {
wrap <- as.numeric(as.factor(data$wrap))
wrapping_x <- (wrap %% 3)
wrapping_y <- ((wrap-1) %/% 3)
range_x <- (max(data$x)-min(data$x))
range_y <- (max(data$y)-min(data$y))
if(range_x == 0){range_x <- 1}
if(range_y == 0){range_y <- 1}
# return the transformed data
transform_position(
df = data,
trans_x = function(x) {(x - min(x))/(range_x) + wrapping_x},
trans_y = function(y) {(y - max(y))/(range_y) - wrapping_y}
)
}
)
position_wrap <- function(sd_x = .15, sd_y = .15) {
ggproto(NULL, PositionWrap, sd_x = sd_x, sd_y = sd_y)
}
df <- data.frame(
x = rnorm(50),
y = rnorm(50),
index = 1:50
)
ggplot(mtcars, aes(wt, mpg, color = factor(cyl))) + geom_point()
ggplot(mtcars) +
aes(wt, mpg,
color = factor(cyl),
wrap = interaction(gear, cyl)) +
geom_point(position = position_wrap()) +
geom_vline(xintercept = 0:3, linetype = "dashed") +
geom_hline(yintercept = 0:-3, linetype = "dashed")
last_plot() +
aes(wrap = interaction(cyl, gear))
StatMidrange <- ggproto("StatMidrange", Stat,
compute_panel = function(data, scales){
data |> mutate(x = .5,
y = .5) %>%
distinct()
},
default_aes = aes(label = after_stat(wrap)))
mtcars %>%
select(x = wt, y = mpg, color = cyl, wrap = cyl) %>%
StatMidrange$compute_panel()
## x y color wrap
## Mazda RX4 0.5 0.5 6 6
## Datsun 710 0.5 0.5 4 4
## Hornet Sportabout 0.5 0.5 8 8
ggplot(cars) +
aes(speed, dist) +
geom_point() +
geom_label(stat = StatMidrange,
aes(wrap = "hi"), size = 3)
## Warning in geom_label(stat = StatMidrange, aes(wrap = "hi"), size = 3):
## Ignoring unknown aesthetics: wrap
ggplot(mtcars) +
aes(wt, mpg, color = factor(cyl), wrap = interaction(gear, cyl)) +
geom_point(position = position_wrap()) +
geom_vline(xintercept = 0:3, linetype = "dashed") +
geom_hline(yintercept = 0:-3, linetype = "dashed")
last_plot() +
geom_label(stat = StatMidrange,
position = position_wrap(),
size = 7,
vjust = 1,
hjust = 0
)
