I am learning to code in ggplot2. I wish to create a new geom which makes something complex – not a simple polygon. Say, a rectangle with a point in the middle.
When I am defining my new geom object, say GeomFafik, I need to specify the function draw_panel (or draw_group, or whichever) which returns a grob. Here is how it looks now (based on the extending ggplot2 vignette:
GeomFafik <- ggproto("GeomFafik",
Geom,
required_aes=c("xmin", "ymin", "xmax", "ymax"),
default_aes=aes(shape=19, colour="black"),
draw_key=draw_key_blank(),
draw_panel=function(data, panel_params, coord) {
coords <- coord$transform(data, panel_params)
# how can I combine grob1 with grob2 and
# return the result?
grob1 <- grid::rectGrob(coords$xmin, coords$ymin,
width=coords$xmax - coords$xmin,
height=coords$ymax - coords$ymin,
gp=gpar(col=coord$colour))
grob2 <- grid::pointsGrob(x=coords$xmin + (coords$xmax - coords$xmin)/2,
y=coords$ymin + (coords$ymax - coords$ymax)/2,
gp=gpar(col=coord$colour))
})
Am I right that I should build a grob using grob() or gTree() from grid? Or is there a ggplot2 way of doing that (similar to zeroGrob)? And if grid, then which of the two should I use? And where can I find examples? The manual page doesn't really say much.
OK, so that was easier than I thought. The solution is to use gTree as follows (thanks to this example):
GeomFafik <- ggproto("GeomFafik",
Geom,
required_aes=c("xmin", "ymin", "xmax", "ymax"),
default_aes=aes(shape=19, colour="black"),
draw_key=draw_key_blank(),
draw_panel=function(data, panel_params, coord) {
coords <- coord$transform(data, panel_params)
w <- coords$xmax - coords$xmin
h <- coords$ymax - coords$ymin
x <- coords$xmin + w/2
y <- coords$ymin + h/2
grob1 <- grid::rectGrob(x, y, width=w, height=h,
gp=gpar(col=coord$colour))
grob2 <- grid::pointsGrob(x=x, y=y,
gp=gpar(col=coord$colour))
grid::gTree("fafik_grob", children=grid::gList(grob1, grob2))
})
geom_fafik <- function(mapping = NULL, data = NULL, stat = "identity",
position = "identity", na.rm = FALSE, show.legend = NA,
inherit.aes = TRUE, ...) {
layer(
geom = GeomFafik, mapping = mapping, data = data, stat = stat,
position = position, show.legend = show.legend, inherit.aes = inherit.aes,
params = list(na.rm = na.rm, ...)
)
}
Result, which is what I wanted:
Related
I have a geom_foo() which will do some transformation of the input data and I have a scale transformation. My problem is that these work not as I would expect together with other geom_*s in terms of scaling.
To illustrate the behavior, consider foo() which will be used in the setup_data method of GeomFoo, defined at the end of the question.
foo <- function(x, y) {
data.frame(
x = x + 2,
y = y + 2
)
}
foo(1, 1)
The transformer is:
foo_trans <- scales::trans_new(
name = "foo",
transform = function(x) x / 5,
inverse = function(x) x * 5
)
Given this input data:
df1 <- data.frame(x = c(1, 2), y = c(1, 2))
Here is a basic plot:
library(ggplot2)
ggplot(df1, aes(x = x, y = y)) +
geom_foo()
When I apply the transformation to the vertical scale, I get this
ggplot(df1, aes(x = x, y = y)) +
geom_foo() +
scale_y_continuous(trans = foo_trans)
What I can say is that the y-axis limits are calculate as 11 = 1 + (2*5) and 12 = 2 + (2*5), where 1 and 2 are df1$y, and (2 * 5) are taken from the setup_data method and from trans_foo.
My real problem is, that I would like add a text layer with labels. These labels and their coordinates come from another dataframe, as below.
df_label <- foo(df1$x, df1$y)
df_label$label <- c("A", "B")
Label and point layers are on same x-y positions without the scale transformation
p <- ggplot(df1, aes(x = x, y = y)) +
geom_foo(color = "red", size = 6) +
geom_text(data = df_label, aes(x, y, label = label))
p
But when I apply the transformation, the coordinates do not match anymore
p +
scale_y_continuous(trans = foo_trans)
How do I get the to layer to match in x-y coordinates after the transformation? Thanks
ggproto object:
GeomFoo <- ggproto("GeomFoo", GeomPoint,
setup_data = function(data, params) {
cols_to_keep <- setdiff(names(data), c("x", "y"))
cbind(
foo(data$x, data$y),
data[, cols_to_keep]
)
}
)
geom constructor:
geom_foo <- function(mapping = NULL, data = NULL, ...,
na.rm = FALSE, show.legend = NA,
inherit.aes = TRUE) {
layer(
data = data,
mapping = mapping,
stat = "identity",
geom = GeomFoo,
position = "identity",
show.legend = show.legend,
inherit.aes = inherit.aes,
params = list(
na.rm = na.rm,
...
)
)
}
Doing data transformations isn't really the task of a geom, but a task of a stat instead. That said, the larger issue is that scale transformations are applied before the GeomFoo$setup_data() method is called. There are two ways one could accomplish this task that I could see.
Apply foo() before scale transformation. I don't think geoms or stats ever have access to the data before scale transformation. A possible place for this is in the ggplot2:::Layer$setup_layer() method. However, this isn't exported, which probably means the devs would like to discourage this even before we make an attempt.
Inverse the scale transformation, apply foo(), and transform again. For this, you need a method with access to the scales. AFAIK, no geom method has this access. However Stat$compute_panel() does have access, so we can use this.
To give an example of (2), I think you could get away with the following:
StatFoo <- ggproto(
"StatFoo", Stat,
compute_panel = function(self, data, scales) {
cols_to_keep <- setdiff(names(data), c("x", "y"))
food <- foo(scales$x$trans$inverse(data$x),
scales$y$trans$inverse(data$y))
cbind(
data.frame(x = scales$x$trans$transform(food$x),
y = scales$y$trans$transform(food$y)),
data[, cols_to_keep]
)
}
)
geom_foo <- function(mapping = NULL, data = NULL, ...,
na.rm = FALSE, show.legend = NA,
inherit.aes = TRUE) {
layer(
data = data,
mapping = mapping,
stat = StatFoo,
geom = GeomPoint,
position = "identity",
show.legend = show.legend,
inherit.aes = inherit.aes,
params = list(
na.rm = na.rm,
...
)
)
}
If someone else has brighter ideas to do this, I'd also like to know!
Consider a plot like the one on top:
I want to recreate this kind of plot (curvy scatter plot) which indicates the spread of the samples through the curves around the median. So far, my search has not been successful.
Does anyone know :
How this plot is called ?
How this plot could be created with ggplot2 ?
Can this scatter plot with equidistant points per categorical variable be done with geom_point() ?
Original source: https://www.nature.com/articles/nature12213/figures/1
Is it just ordering and spacing out the points that are otherwise discrete? You can fairly easily make your own geoms (see this guide)/ Maybe something like
StatSlide <- ggproto("StatSlide", Stat,
compute_group = function(data, scales) {
data$y <- sort(data$y)
data$x <- data$x + seq( -.4, .4, length.out = nrow(data))
data
},
required_aes = c("x", "y")
)
stat_slide <- function(mapping = NULL, data = NULL, geom = "point",
position = "identity", na.rm = FALSE, show.legend = NA,
inherit.aes = TRUE, ...) {
layer(
stat = StatSlide, data = data, mapping = mapping, geom = geom,
position = position, show.legend = show.legend, inherit.aes = inherit.aes,
params = list(na.rm = na.rm, ...)
)
}
# test it out
ggplot(mpg) +
stat_slide(aes(drv, displ, color=drv))
I'm looking for a more convenient way to get a Q-Q plot in ggplot2 where the quantiles are computed for the data set as a whole. but I can use mappings (colour/shapes) for groups in the data.
library(dplyr)
library(ggplot2)
library(broom) ## for augment()
Make up some data:
set.seed(1001)
N <- 1000
G <- 10
dd <- data_frame(x=runif(N),
f=factor(sample(1:G,size=N,replace=TRUE)),
y=rnorm(N)+2*x+as.numeric(f))
m1 <- lm(y~x,data=dd)
dda <- cbind(augment(m1),f=dd$f)
Basic plot:
ggplot(dda)+stat_qq(aes(sample=.resid))
if I try to add colour, the groups get separated for the quantile computation (which I don't want):
ggplot(dda)+stat_qq(aes(sample=y,colour=f))
If I use stat_qq(aes(sample=y,colour=f,group=1)) ggplot ignores the colour specification and I get the first plot back.
I want a plot where the points are positioned as in the first case, but coloured as in the second case. I have a qqnorm-based manual solution that I can post but am looking for something nicer ...
You could calculate the quantiles yourself and then plot using geom_point:
dda = cbind(dda, setNames(qqnorm(dda$.resid, plot.it=FALSE), c("Theoretical", "Sample")))
ggplot(dda) +
geom_point(aes(x=Theoretical, y=Sample, colour=f))
Ah, I guess I should have read to the end of your question. This is the manual solution you were referring to, right? Although you could just package it as a function:
my_stat_qq = function(data, colour.var) {
data=cbind(data, setNames(qqnorm(data$.resid, plot.it=FALSE), c("Theoretical", "Sample")))
ggplot(data) +
geom_point(aes_string(x="Theoretical", y="Sample", colour=colour.var))
}
my_stat_qq(dda, "f")
Here's a ggproto-based approach that attempts to change StatQq, since the underlying issue here (colour specification gets ignored when group is specified explicitly) is due to how its compute_group function is coded.
Define alternate version of StatQq with modified compute_group (last few lines of code):
StatQq2 <- ggproto("StatQq", Stat,
default_aes = aes(y = after_stat(sample), x = after_stat(theoretical)),
required_aes = c("sample"),
compute_group = function(data, scales, quantiles = NULL,
distribution = stats::qnorm, dparams = list(),
na.rm = FALSE) {
sample <- sort(data$sample)
n <- length(sample)
# Compute theoretical quantiles
if (is.null(quantiles)) {
quantiles <- stats::ppoints(n)
} else if (length(quantiles) != n) {
abort("length of quantiles must match length of data")
}
theoretical <- do.call(distribution, c(list(p = quote(quantiles)), dparams))
res <- ggplot2:::new_data_frame(list(sample = sample,
theoretical = theoretical))
# NEW: append remaining columns from original data
# (e.g. if there were other aesthetic variables),
# instead of returning res directly
data.new <- subset(data[rank(data$sample), ],
select = -c(sample, PANEL, group))
if(ncol(data.new) > 0) res <- cbind(res, data.new)
res
}
)
Define geom_qq2 / stat_qq2 to use modified StatQq2 instead of StatQq for their stat:
geom_qq2 <- function (mapping = NULL, data = NULL, geom = "point",
position = "identity", ..., distribution = stats::qnorm,
dparams = list(), na.rm = FALSE, show.legend = NA,
inherit.aes = TRUE) {
layer(data = data, mapping = mapping, stat = StatQq2, geom = geom,
position = position, show.legend = show.legend, inherit.aes = inherit.aes,
params = list(distribution = distribution, dparams = dparams,
na.rm = na.rm, ...))
}
stat_qq2 <- function (mapping = NULL, data = NULL, geom = "point",
position = "identity", ..., distribution = stats::qnorm,
dparams = list(), na.rm = FALSE, show.legend = NA,
inherit.aes = TRUE) {
layer(data = data, mapping = mapping, stat = StatQq2, geom = geom,
position = position, show.legend = show.legend, inherit.aes = inherit.aes,
params = list(distribution = distribution, dparams = dparams,
na.rm = na.rm, ...))
}
Usage:
cowplot::plot_grid(
ggplot(dda) + stat_qq(aes(sample = .resid)), # original
ggplot(dda) + stat_qq2(aes(sample = .resid, # new
color = f, group = 1))
)
I try to use the new functionality of ggplot2 in R that allows creating our own stat_ functions. I'm creating a simple one to compute and plot an interpolated surface between points arranged on a 2d array.
I would like to create a stat_topo() requiring x, y, and val aesthetics, plotting a simple geom_raster of interpolated val mapped to fill.
library(ggplot2)
library(dplyr)
library(akima)
cpt_grp <- function(data, scales) {
#interpolate data in 2D
itrp <- akima::interp(data$x,data$y,data$val,linear=F,extrap=T)
out <- expand.grid(x=itrp$x, y=itrp$y,KEEP.OUT.ATTRS = F)%>%
mutate(fill=as.vector(itrp$z))
# str(out)
return(out)
}
StatTopo <- ggproto("StatTopo", Stat,
compute_group = cpt_grp,
required_aes = c("x","y","val")
)
stat_topo <- function(mapping = NULL, data = NULL, geom = "raster",
position = "identity", na.rm = FALSE, show.legend = NA,
inherit.aes = TRUE, ...) {
layer(
stat = StatTopo, data = data, mapping = mapping, geom = geom,
position = position, show.legend = show.legend, inherit.aes = inherit.aes,
params = list(na.rm = na.rm, ...)
)
}
set.seed(1)
nchan <- 30
d <- data.frame(val = rnorm(nchan), # some random values to be mapped to fill color
x = 1:nchan*cos(1:nchan), # the x and y position of the points to interpolate
y = 1:nchan*sin(1:nchan))
plot(d$x,d$y)
ggplot(d,aes(x=x,y=y,val=val)) +
stat_topo() +
geom_point()
When I run this, I get the following error:
Error: numerical color values must be >= 0, found -1
I understand that this is because somehow the scale of the fill aesthetic is set to discrete.
If I enter this:
ggplot(d,aes(x=x,y=y,val=val)) +
stat_topo() +
scale_fill_continuous() +
geom_point()
I get what I wanted: the expected raster with a continuous color scale, which I want the stat_ to do by default...
So I guess the question is:
How can I prevent ggplot from setting a discrete scale here, and ideally set a default scale within the call to my new stat_ function.
Apparently, when creating a new variable inside a stat_ function, one needs to explicitly associate it to the aesthetic it will be mapped to with the parameter default_aes = aes(fill = ..fill..) within the ggproto definition.
This is telling ggplot that it is a calculated aesthetic and it will pick a scale based on the data type.
So here we need to define the stat_ as follows:
cpt_grp <- function(data, scales) {
# interpolate data in 2D
itrp <- akima::interp(data$x,data$y,data$val,linear=F,extrap=T)
out <- expand.grid(x=itrp$x, y=itrp$y,KEEP.OUT.ATTRS = F)%>%
mutate(fill=as.vector(itrp$z))
# str(out)
return(out)
}
StatTopo <- ggproto("StatTopo", Stat,
compute_group = cpt_grp,
required_aes = c("x","y","val"),
default_aes = aes(fill = ..fill..)
)
stat_topo <- function(mapping = NULL, data = NULL, geom = "raster",
position = "identity", na.rm = FALSE, show.legend = NA,
inherit.aes = TRUE, ...) {
layer(
stat = StatTopo, data = data, mapping = mapping, geom = geom,
position = position, show.legend = show.legend, inherit.aes = inherit.aes,
params = list(na.rm = na.rm, ...)
)
}
Then the following code:
set.seed(1)
nchan <- 30
d <- data.frame(val = rnorm(nchan),
x = 1:nchan*cos(1:nchan),
y = 1:nchan*sin(1:nchan))
ggplot(d,aes(x=x,y=y,val=val)) +
stat_topo() +
geom_point()
Produces as expected:
Without the need to specify a scale_ manually, but leaving the possibility to adapt the scale easily as usual with e.g. scale_fill_gradient2(low = 'blue',mid='white',high='red')
I got this answer here: https://github.com/hadley/ggplot2/issues/1481
Okay, slept on it, and had an idea, and I think this might do what you want. In your stat_topo layer function instead of the ggproto I returned a list with it as the first element and then added to that list another ggproto with a call to scale_fill_continuous().
library(ggplot2)
library(dplyr)
library(akima)
cpt_grp <- function(data, scales) {
#interpolate data in 2D
itrp <- akima::interp(data$x,data$y,data$val,linear=F,extrap=T)
out <- expand.grid(x=itrp$x, y=itrp$y,KEEP.OUT.ATTRS = F)%>%
mutate(fill=as.vector(itrp$z))
return(out)
}
StatTopo <- ggproto("StatTopo", Stat,
compute_group = cpt_grp,
required_aes = c("x","y","val")
)
stat_topo <- function(mapping = NULL, data = NULL, geom = "raster",
position = "identity", na.rm = FALSE, show.legend = NA,
inherit.aes = TRUE, ...) {
list(
layer(
stat = StatTopo, data = data, mapping = mapping, geom = geom,
position = position, show.legend = show.legend, inherit.aes = inherit.aes,
params = list(na.rm = na.rm )
),
scale_fill_continuous()
)
}
set.seed(1)
nchan <- 30
d <- data.frame(val = rnorm(nchan), # some random values to be mapped to fill color
x = 1:nchan*cos(1:nchan), # the x and y position of interp points
y = 1:nchan*sin(1:nchan))
ggplot(d,aes(x=x,y=y,val=val)) +
stat_topo() +
geom_point()
yielding the same picture as above.
This question already has answers here:
How to use an image as a point in ggplot?
(3 answers)
Closed 5 years ago.
Is it possible to display custom image (say png format) as geom_point in R ggplot?
library(png)
pic1 <- readPNG("pic1.png")
png("Heatmap.png", units="px", width=3200, height=3200, res=300)
ggplot(data_frame, aes(medium, day, fill = Transactions)) +
geom_tile(colour="white") +
facet_grid(dime3_year~dime3_month) +
scale_fill_gradient(high="blue",low="white") +
theme_bw() +
geom_point(aes(dime3_channel, day, size=Conv,alpha=Conv,image=(annotation_raster(pic1,xmin=0,ymin=0,xmax=5,ymax=5)),color="firebrick")) +
Gives error:
Don't know how to automatically pick scale for object of type
proto/environment. Defaulting to continuous Error: Aesthetics must
either be length one, or the same length as the
dataProblems:(annotation_raster(conv_pic, xmin = 0, ymin = 0, xmax =
5, ymax = 5))
The point geom is used to create scatterplots, and doesn't quite seem to be designed to do what you need, ie, display custom images. However, a similar question was answered here, which indicates that the problem can be solved in the following steps:
(1) Read the custom images you want to display,
(2) Render raster objects at the given location, size, and orientation using the rasterGrob() function,
(3) Use a plotting function such as qplot(),
(4) Use a geom such as annotation_custom() for use as static annotations specifying the crude adjustments for x and y limits as mentioned by user20650.
Using the code below, I could get two custom images img1.png and img2.png positioned at the given xmin, xmax, ymin, and ymax.
library(png)
library(ggplot2)
library(gridGraphics)
setwd("c:/MyFolder/")
img1 <- readPNG("img1.png")
img2 <- readPNG("img2.png")
g1 <- rasterGrob(img1, interpolate=FALSE)
g2 <- rasterGrob(img2, interpolate=FALSE)
qplot(1:10, 1:10, geom="blank") +
annotation_custom(g1, xmin=1, xmax=3, ymin=1, ymax=3) +
annotation_custom(g2, xmin=7, xmax=9, ymin=7, ymax=9) +
geom_point()
DL Miller provided another solution using ggproto().https://github.com/dill/emoGG
library(ggplot2)
library(grid)
library(EBImage)
img <- readImage(system.file("img", "Rlogo.png", package = "png"))
RlogoGrob <- function(x, y, size, img) {
rasterGrob(x = x, y = y, image = img, default.units = "native", height = size,
width = size)
}
GeomRlogo <- ggproto("GeomRlogo", Geom, draw_panel = function(data, panel_scales,
coord, img, na.rm = FALSE) {
coords <- coord$transform(data, panel_scales)
ggplot2:::ggname("geom_Rlogo", RlogoGrob(coords$x, coords$y, coords$size,
img))
}, non_missing_aes = c("Rlogo", "size"), required_aes = c("x", "y"), default_aes = aes(size = 0.05),
icon = function(.) {
}, desc_params = list(), seealso = list(geom_point = GeomPoint$desc),
examples = function(.) {
})
geom_Rlogo <- function(mapping = NULL, data = NULL, stat = "identity",
position = "identity", na.rm = FALSE, show.legend = NA, inherit.aes = TRUE,
...) {
layer(data = data, mapping = mapping, stat = stat, geom = GeomRlogo,
position = position, show.legend = show.legend, inherit.aes = inherit.aes,
params = list(na.rm = na.rm, img = img, ...))
}
ggplot(mtcars, aes(wt, mpg))+geom_Rlogo()