Extracting the exact coordinates of a mouse click in an interactive plot - r

In short: I'm looking for a way to get the exact coordinates of a series of mouse positions (on-clicks) in an interactive x/y scatter plot rendered by ggplot2 and ggplotly.
I'm aware that plotly (and several other interactive plotting packages for R) can be combined with Shiny, where a box- or lazzo select can return a list of all data points within the selected subspace. This list will be HUGE in most of the datasets I'm analysing, however, and I need to be able to do the analysis reproducibly in an R markdown format (writing a few, mostly less than 5-6, point coordinates is much more readable). Furthermore, I have to know the exact positions of the clicks to be able to extract points within the same polygon of points in a different dataset, so a list of points within the selection in one dataset is not useful.
The grid.locator() function from the grid package does almost what I'm looking for (the one wrapped in fx gglocator), however I hope there is a way to do the same within an interactive plot rendered by plotly (or maybe something else that I don't know of?) as the data sets are often HUGE (see the plot below) and thus being able to zoom in and out interactively is very much appreciated during several iterations of analysis.
Normally I have to rescale the axes several times to simulate zooming in and out which is exhausting when doing it MANY times. As you can see in the plot above, there is a LOT of information in the plots to explore (the plot is about 300MB in memory).
Below is a small reprex of how I'm currently doing it using grid.locator on a static plot:
library(ggplot2)
library(grid)
p <- ggplot(mtcars, aes(wt, mpg)) +
geom_point()
locator <- function(p) {
# Build ggplot object
ggobj <- ggplot_build(p)
# Extract coordinates
xr <- ggobj$layout$panel_ranges[[1]]$x.range
yr <- ggobj$layout$panel_ranges[[1]]$y.range
# Variable for selected points
selection <- data.frame(x = as.numeric(), y = as.numeric())
colnames(selection) <- c(ggobj$plot$mapping$x, ggobj$plot$mapping$y)
# Detect and move to plot area viewport
suppressWarnings(print(ggobj$plot))
panels <- unlist(current.vpTree()) %>%
grep("panel", ., fixed = TRUE, value = TRUE)
p_n <- length(panels)
seekViewport(panels, recording=TRUE)
pushViewport(viewport(width=1, height=1))
# Select point, plot, store and repeat
for (i in 1:10){
tmp <- grid.locator('native')
if (is.null(tmp)) break
grid.points(tmp$x,tmp$y, pch = 16, gp=gpar(cex=0.5, col="darkred"))
selection[i, ] <- as.numeric(tmp)
}
grid.polygon(x= unit(selection[,1], "native"), y= unit(selection[,2], "native"), gp=gpar(fill=NA))
#return a data frame with the coordinates of the selection
return(selection)
}
locator(p)
and from here use the point.in.polygon function to subset the data based on the selection.
A possible solution could be to add, say 100x100, invisible points to the plot and then use the plotly_click feature of event_data() in a Shiny app, but this is not at all ideal.
Thanks in advance for your ideas or solutions, I hope my question was clear enough.
-- Kasper

I used ggplot2. Besides the materials at https://shiny.rstudio.com/articles/plot-interaction.html, I'd like to mention the following:
Firstly, when you create the plot, don't use "print( )" within "renderPlot( )", or the coordinates would be wrong. For instance, if you have the following in UI:
plotOutput("myplot", click = "myclick")
The following in the Server would work:
output$myplot <- renderPlot({
p = ggplot(data = mtcars, aes(x=mpg, y=hp)) + geom_point()
p
})
But the clicking coordinates would be wrong if you do:
output$myplot <- renderPlot({
p = ggplot(data = mtcars, aes(x=mpg, y=hp)) + geom_point()
print(p)
})
Then, you could store the coordinates by adding to the Server:
mydata = reactiveValues(x_values = c(), y_values = c())
observeEvent(input$myclick, {
mydata$x_values = c(mydata$x_values, input$myclick$x)
mydata$y_values = c(mydata$y_values, input$myclick$y)
})
In addition to X-Y coordinates, when you use facet with ggplot2, you refer to the clicked facet panel by
input$myclick$panelvar1

Related

How to plot 3D scatter diagram using ggplot?

I tried to use the plotly package, but it is not working in my case at all. The ggplot package is working for 2D plots but it is giving an error when adding one more axis. How to solve this issue?
ggplot(data,aes(x=D1,y=D2,z=D3,color=Sample)) +
geom_point()
How to add one more axis and get the 3D plot in this?
Since you tagged your question with plotly and said that you've tried to use it with plotly, I think it would be helpful to give you a working code solution in plotly:
Creating some data to plot with:
set.seed(417)
library(plotly)
temp <- rnorm(100, mean=30, sd=5)
pressure <- rnorm(100)
dtime <- 1:100
Graphing your 3d scatterplot using plotly's scatter3d type:
plot_ly(x=temp, y=pressure, z=dtime, type="scatter3d", mode="markers", color=temp)
Renders the following:
ggplot as others have note, by itself does not support 3d graphics rendering.
A possible solutions is gg3D.
gg3D is a package created to extend ggplot2 to produce 3D plots. It does exactly what you are asking for: it adds a third axis to a ggplot. I find it quite good and easy to use and that is what I use for my limited needs.
An example taken from the vignette to produce a basic plot
devtools::install_github("AckerDWM/gg3D")
library("gg3D")
## An empty plot with 3 axes
qplot(x=0, y=0, z=0, geom="blank") +
theme_void() +
axes_3D()
## Axes can be populated with points using the function stat_3D.
data(iris)
ggplot(iris, aes(x=Petal.Width, y=Sepal.Width, z=Petal.Length, color=Species)) +
theme_void() +
axes_3D() +
stat_3D()
There are other options not involving ggplot. For example the excellent plot3D package with its extension plot3Drgl to plot in openGL.
In your question, you refer to the plotly package and to the ggplot2 package. Both plotly and ggplot2 are great packages: plotly is good at creating dynamic plots that users can interact with, while ggplot2 is good at creating static plots for extreme customization and scientific publication. It is also possible to send ggplot2 output to plotly. Unfortunately, at the time of writing (April 2021), ggplot2 does not natively support 3d plots. However, there are other packages that can be used to produce 3d plots and some ways to get pretty close to ggplot2 quality. Below I review several options. These suggestions are by no means exhaustive.
plotly
See onlyphantom's answer in this thread.
gg3D
See Marco Stamazza's answer in this thread. See also my effort below.
scatterplot3d
See Seth's answer in a related thread.
lattice
See Backlin's answer in a related thread.
rgl
See this overview in the wiki guide.
rayshader
See this overview of this package's wonderful capabilities.
trans3d
See data-imaginist use trans3d to get a cube into ggplot2.
ggrgl
See this cool and useful coolbutuseless introduction.
Now let me review some of my efforts with the Lorenz attractor trajectories. While customization remains limited, I've had best results for PDF output with gg3D. I also include a ggrgl example.
gg3D
# Packages
library(deSolve)
library(ggplot2)
library(gg3D) # remotes::install_github("AckerDWM/gg3D")
# Directory
setwd("~/R/workspace/")
# Parameters
parms <- c(a=10, b=8/3, c=28)
# Initial state
state <- c(x=0.01, y=0.0, z=0.0)
# Time span
times <- seq(0, 50, by=1/200)
# Lorenz system
lorenz <- function(times, state, parms) {
with(as.list(c(state, parms)), {
dxdt <- a*(y-x)
dydt <- x*(c-z)-y
dzdt <- x*y-b*z
return(list(c(dxdt, dydt, dzdt)))
})
}
# Make dataframe
df <- as.data.frame(ode(func=lorenz, y=state, parms=parms, times=times))
# Make plot
make_plot <- function(theta=0, phi=0){
ggplot(df, aes(x=x, y=y, z=z, colour=time)) +
axes_3D(theta=theta, phi=phi) +
stat_3D(theta=theta, phi=phi, geom="path") +
labs_3D(theta=theta, phi=phi,
labs=c("x", "y", "z"),
angle=c(0,0,0),
hjust=c(0,2,2),
vjust=c(2,2,-2)) +
ggtitle("Lorenz butterfly") +
theme_void() +
theme(legend.position = "none")
}
make_plot()
make_plot(theta=180,phi=0)
# Save plot as PDF
ggsave(last_plot(), filename="lorenz-gg3d.pdf")
Pros: Outputs high-quality PDF:
Cons: Still limited customization. But for my specific needs, currently the best option.
ggrgl
# Packages
library(deSolve)
library(ggplot2)
library(rgl)
#remotes::install_github("dmurdoch/rgl")
library(ggrgl)
# remotes::install_github('coolbutuseless/ggrgl', ref='main')
library(devout)
library(devoutrgl)
# remotes::install_github('coolbutuseless/devoutrgl', ref='main')
library(webshot2)
# remotes::install_github("rstudio/webshot2")
library(ggthemes)
# Directory
setwd("~/R/workspace/")
# Parameters
parms <- c(a=10, b=8/3, c=26.48)
# Initial state
state <- c(x=0.01, y=0.0, z=0.0)
# Time span
times <- seq(0, 100, by=1/500)
# Lorenz system
lorenz <- function(times, state, parms) {
with(as.list(c(state, parms)), {
dxdt <- a*(y-x)
dydt <- x*(c-z)-y
dzdt <- x*y-b*z
return(list(c(dxdt, dydt, dzdt)))
})
}
# Make dataframe
df <- as.data.frame(ode(func=lorenz, y=state, parms=parms, times=times))
# Make plot
ggplot(df, aes(x=x, y=y, z=z)) +
geom_path_3d() +
ggtitle("Lorenz butterfly") -> p
# Render Plot in window
rgldev(fov=30, view_angle=-10, zoom=0.7)
p + theme_ggrgl(16)
# Save plot as PNG
rgldev(fov=30, view_angle=-10, zoom=0.7,
file = "~/R/Work/plots/lorenz-attractor/ggrgl/lorenz-ggrgl.png",
close_window = TRUE, dpi = 300)
p + theme_ggrgl(16)
dev.off()
Pros: The plot can be rotated in a way similar to plotly. It is possible to 'theme' a basic plot:
Cons: The figure is missing a third axis with labels. Cannot output high-quality plots. While I've been able to view and save a low-quality black trajectory in PNG, I could view a colored trajectory like the above, but could not save it, except with a low-quality screenshot:
Related threads: plot-3d-data-in-r, ploting-3d-graphics-with-r.

how to use apply on a list of text to loop through plots in r

I intended to generate multi-plot per page using something like this:
d=data.frame(label=c(rep('a',3),rep('b',3)) )
d$x = sample(6,nrow(d))
d$y = sample(10,nrow(d))
plotList <- lapply(c("a","b"), function(i) {
plot(df[i,2],df[i,3])
})
library(gridExtra)
do.call(grid.arrange, c(plotList, nrow=2))
Intended effect is one point plot of label a data by the side ne point plot of label b data. I know ggplot panel can work here
d %>% ggplot(aes(x, y)) + geom_point() + facet_grid(.~label)
but the specific case I need to plot which i don't have a good way to share raw data here I'll need to use apply to plot it and grid.arrange to put on same page. I saw grid.arrange example here. Wondering how can i make apply function work? thanks

Setting equal xlim and ylim in plot function

Is there a way to get the plot function to generate equal xlimand ylimautomatically?
I do not want to define a fix range beforehand, but I want the plot function to decide about the range itself. However, I expect it to pick the same range for x and y.
A possible solution is to define a wrapper to the plot function:
plot.Custom <- function(x, y, ...) {
.limits <- range(x, y)
plot(x, y, xlim = .limits, ylim = .limits, ...)
}
One way is to manipulate interactively and then choose the right one. A slider will appear once you run the following code.
library(manipulate)
manipulate(
plot(cars, xlim=c(x.min,x.max)),
x.min=slider(0,15),
x.max=slider(15,30))
I'm not aware of anyway to do this using plot(doesn't mean there isn't one). ggplot might be the way to go; it lends itself more to be being retroactively changed since it is designed around a layer system.
library(ggplot2)
#Creating our ggplot object
loop_plot <- ggplot(cars, aes(x = speed, y = dist)) +
geom_point()
#pulling out the 'auto' x & y axis limits
rangepull <- t(cbind(
ggplot_build(loop_plot)$panel$ranges[[1]]$x.range,
ggplot_build(loop_plot)$panel$ranges[[1]]$y.range))
#taking the max and min(so we don't cut out data points)
newrange <- list(cor.min = min(rangepull[,1]), cor.max = max(rangepull[,2]))
#changing our plot size to be nice and symmetric
loop_plot <- loop_plot +
xlim(newrange$cor.min, newrange$cor.max) +
ylim(newrange$cor.min, newrange$cor.max)
Note that the loop_plot object is of ggplot class, and wont actually print until its called.
I used the cars dataset in the code above to show whats going on, but just sub in your data set[s] and then do whatever postmortem your end goal is.
You'll also be able to add in titles and the like based off of the dataset name et cetera which will likely end up producing a clearer visualization out of your loop.
Hopefully this works for your needs.

Assigning "beanplot" object to variable in R

I have found that the beanplot is the best way to represent my data. I want to look at multiple beanplots together to visualize my data. Each of my plots contains 3 variables, so each one looks something like what would be generated by this code:
library(beanplot)
a <- rnorm(100)
b <- rnorm(100)
c <- rnorm(100)
beanplot(a, b ,c ,ylim = c(-4, 4), main = "Beanplot",
col = c("#CAB2D6", "#33A02C", "#B2DF8A"), border = "#CAB2D6")
(Would have just included an image but my reputation score is not high enough, sorry)
I have 421 of these that I want to put into one long PDF (EDIT: One plot per page is fine, this was just poor wording on my part). The approach I have taken was to first generate the beanplots in a for loop and store them in a list at each iteration. Then I will use the multiplot function (from the R Cookbook page on multiplot) to display all of my plots on one long column so I can begin my analysis.
The problem is that the beanplot function does not appear to be set up to assign plot objects as a variable. Example:
library(beanplot)
a <- rnorm(100)
b <- rnorm(100)
plot1 <- beanplot(a, b, ylim = c(-5,5), main = "Beanplot",
col = c("#CAB2D6", "#33A02C", "#B2DF8A"), border = "#CAB2D6")
plot1
If you then type plot1 into the R console, you will get back two of the plot parameters but not the plot itself. This means that when I store the plots in the list, I am unable to graph them with multiplot. It will simply return the plot parameters and a blank plot.
This behavior does not seem to be the case with qplot for example which will return a plot when you recall the stored plot. Example:
library(ggplot2)
a <- rnorm(100)
b <- rnorm(100)
plot2 <- qplot(a,b)
plot2
There is no equivalent to the beanplot that I know of in ggplot. Is there some sort of workaround I can use for this issue?
Thank you.
You can simply open a PDF device with pdf() and keep the default parameter onefile=TRUE. Then call all your beanplot()s, one after the other. They will all be in one PDF document, each one on a separate page. See here.

How to plot a violin scatter boxplot (in R)?

I just came by the following plot:
And wondered how can it be done in R? (or other softwares)
Update 10.03.11: Thank you everyone who participated in answering this question - you gave wonderful solutions! I've compiled all the solution presented here (as well as some others I've came by online) in a post on my blog.
Make.Funny.Plot does more or less what I think it should do. To be adapted according to your own needs, and might be optimized a bit, but this should be a nice start.
Make.Funny.Plot <- function(x){
unique.vals <- length(unique(x))
N <- length(x)
N.val <- min(N/20,unique.vals)
if(unique.vals>N.val){
x <- ave(x,cut(x,N.val),FUN=min)
x <- signif(x,4)
}
# construct the outline of the plot
outline <- as.vector(table(x))
outline <- outline/max(outline)
# determine some correction to make the V shape,
# based on the range
y.corr <- diff(range(x))*0.05
# Get the unique values
yval <- sort(unique(x))
plot(c(-1,1),c(min(yval),max(yval)),
type="n",xaxt="n",xlab="")
for(i in 1:length(yval)){
n <- sum(x==yval[i])
x.plot <- seq(-outline[i],outline[i],length=n)
y.plot <- yval[i]+abs(x.plot)*y.corr
points(x.plot,y.plot,pch=19,cex=0.5)
}
}
N <- 500
x <- rpois(N,4)+abs(rnorm(N))
Make.Funny.Plot(x)
EDIT : corrected so it always works.
I recently came upon the beeswarm package, that bears some similarity.
The bee swarm plot is a
one-dimensional scatter plot like
"stripchart", but with closely-packed,
non-overlapping points.
Here's an example:
library(beeswarm)
beeswarm(time_survival ~ event_survival, data = breast,
method = 'smile',
pch = 16, pwcol = as.numeric(ER),
xlab = '', ylab = 'Follow-up time (months)',
labels = c('Censored', 'Metastasis'))
legend('topright', legend = levels(breast$ER),
title = 'ER', pch = 16, col = 1:2)
(source: eklund at www.cbs.dtu.dk)
I have come up with the code similar to Joris, still I think this is more than a stem plot; here I mean that they y value in each series is a absolute value of a distance to the in-bin mean, and x value is more about whether the value is lower or higher than mean.
Example code (sometimes throws warnings but works):
px<-function(x,N=40,...){
x<-sort(x);
#Cutting in bins
cut(x,N)->p;
#Calculate the means over bins
sapply(levels(p),function(i) mean(x[p==i]))->meansl;
means<-meansl[p];
#Calculate the mins over bins
sapply(levels(p),function(i) min(x[p==i]))->minl;
mins<-minl[p];
#Each dot is one value.
#X is an order of a value inside bin, moved so that the values lower than bin mean go below 0
X<-rep(0,length(x));
for(e in levels(p)) X[p==e]<-(1:sum(p==e))-1-sum((x-means)[p==e]<0);
#Y is a bin minum + absolute value of a difference between value and its bin mean
plot(X,mins+abs(x-means),pch=19,cex=0.5,...);
}
Try the vioplot package:
library(vioplot)
vioplot(rnorm(100))
(with awful default color ;-)
There is also wvioplot() in the wvioplot package, for weighted violin plot, and beanplot, which combines violin and rug plots. They are also available through the lattice package, see ?panel.violin.
Since this hasn't been mentioned yet, there is also ggbeeswarm as a relatively new R package based on ggplot2.
Which adds another geom to ggplot to be used instead of geom_jitter or the like.
In particular geom_quasirandom (see second example below) produces really good results and I have in fact adapted it as default plot.
Noteworthy is also the package vipor (VIolin POints in R) which produces plots using the standard R graphics and is in fact also used by ggbeeswarm behind the scenes.
set.seed(12345)
install.packages('ggbeeswarm')
library(ggplot2)
library(ggbeeswarm)
ggplot(iris,aes(Species, Sepal.Length)) + geom_beeswarm()
ggplot(iris,aes(Species, Sepal.Length)) + geom_quasirandom()
#compare to jitter
ggplot(iris,aes(Species, Sepal.Length)) + geom_jitter()

Resources