How can I get the x and y coordinates of an interactive map created with ggplot and plotly in R shiny? I want to get the x axis values and based on that display other data. Here is some dummy code.
library(shiny)
library(plotly)
library(ggplot2)
ui <- fluidPage(
plotlyOutput("distPlot")
)
server <- function(input, output) {
output$distPlot <- renderPlotly({
gg1 = iris %>% ggplot(aes(x = Petal.Length, y = Petal.Width)) + geom_point()
ggplotly(gg1)
})
}
shinyApp(ui = ui, server = server)
Maybe this is what your are looking for. The plotly package offers a function event_data() to get e.g. the coordinates of click events inside of a shiny app. See here. If you have multiple plots you could use the source argument to set an id and to get the event data for a specific plot:
library(shiny)
library(plotly)
library(ggplot2)
ui <- fluidPage(
plotlyOutput("distPlot"),
verbatimTextOutput("info")
)
server <- function(input, output) {
output$distPlot <- renderPlotly({
gg1 = iris %>% ggplot(aes(x = Petal.Length, y = Petal.Width)) + geom_point()
ggplotly(gg1, source = "Plot1")
})
output$info <- renderPrint({
d <- event_data("plotly_click", source = "Plot1")
if (is.null(d)) {
"Click events appear here (double-click to clear)"
} else {
x <- round(d$x, 2)
y <- round(d$y, 2)
cat("[", x, ", ", y, "]", sep = "")
}
})
}
shinyApp(ui = ui, server = server)
Related
I am using R Shiny and I am plotting some 3D point cloud with plot_ly from the library plotly. I can move and zoom on the points.
When I click on some point, some information about the point is stored in a variable, but then this resets the visualization.
It is possible to prevent this reinitialization? E.g. I would like to zoom on some part of the data, and then successively click on the points without any reset..
Here is a reproducible example :
library(shiny)
library(plotly)
df=iris
ui <- fluidPage(
plotlyOutput("plot3D"),
textOutput("selection")
)
server <- function(input, output, session) {
react <- reactiveValues(value = 0)
output$plot3D <- renderPlotly({
click_data <- event_data("plotly_click", priority = "event")
if (!is.null(click_data)) {
react$value<-click_data$customdata
}
fig<-plot_ly(df,
x=~Sepal.Length,y=~Sepal.Width,z=~Petal.Length,
type="scatter3d",
mode = 'markers',
customdata = ~Species
)
fig
})
output$selection <- renderPrint({
react$value
})
}
shinyApp(ui = ui, server = server)
And here is a gif about what happens :
The issue is, that you are collecting the event_data inside your renderPlotly call. Accordingly your plot is re-rendered with each click event (reactive dependency).
Please check the following:
library(shiny)
library(plotly)
library(datasets)
DF <- iris
ui <- fluidPage(plotlyOutput("plot3D"),
textOutput("selection"))
server <- function(input, output, session) {
output$plot3D <- renderPlotly({
plot_ly(
DF,
x = ~ Sepal.Length,
y = ~ Sepal.Width,
z = ~ Petal.Length,
type = "scatter3d",
mode = 'markers',
customdata = ~ Species,
source = "myscatter3d"
)
})
click_data <- reactive({
event_data("plotly_click", source = "myscatter3d", priority = "event")
})
output$selection <- renderPrint({
click_data()
})
}
shinyApp(ui = ui, server = server)
Desired Outcome
I would like to be able to click a point in my plotly::ggplotly() graph within my {shiny} app and then display some info about that point in a separate output below.
MRE
In this simple example I can make it display the curveNumber, pointNumber, x, y, but it's not easy to unambiguously retrieve a particular data point from my original data from these values. I've read about using key within the plotly::renderPlotly() call although I'm not sure how I'd access that in a separate part of the app.
library(tidyverse)
library(plotly)
library(shiny)
# UI ----
ui <- fluidPage(plotlyOutput("plot"),
verbatimTextOutput("click"))
# server ----
server <- function(input, output) {
output$plot <- renderPlotly({
p <- mtcars %>%
rownames_to_column("car") %>%
ggplot(aes(x = disp, y = mpg, color = factor(cyl),
label = car)) +
geom_point(size = 4, alpha = 0.7)
ggplotly(p) %>%
event_register("plotly_click")
})
output$click <- renderPrint({
point <- event_data(event = "plotly_click", priority = "event")
if (is.null(point)) "No Point Selected" else point
})
}
# app ----
shinyApp(ui = ui, server = server)
Using code from here I figured out how to use key to identify the points and then retrieve that elsewhere from the event_data().
library(tidyverse)
library(plotly)
library(shiny)
d <- mtcars %>%
rownames_to_column("car")
# UI ----
ui <- fluidPage(plotlyOutput("plot"),
tableOutput("click"))
# server ----
server <- function(input, output) {
output$plot <- renderPlotly({
key <- d$car
p <- d %>%
ggplot(aes(x = disp, y = mpg, color = factor(cyl),
key = key)) +
geom_point(size = 4, alpha = 0.7)
ggplotly(p) %>%
event_register("plotly_click")
})
output$click <- renderTable({
point <- event_data(event = "plotly_click", priority = "event")
req(point) # to avoid error if no point is clicked
filter(d, car == point$key) # use the key to find selected point
})
}
# app ----
shinyApp(ui = ui, server = server)
For the first time I really can't find this answer here already, so I hope you all can help me, I'm sure there is a pretty easy fix.
I am making a Shiny volcano plot with clickable points to give me a table with the data about that point. If I use a trans function (that I found here, thank you helpful stranger) within scale_y_continuous() in my plot, points in the scaled region are no longer clickable. How can I scale the axis this way and still be able to have the clickable points?
My code, with some fake data that has the same problem:
## Read in necessary libraries, function, and data
library(shiny)
library(ggplot2)
library(dplyr)
library(scales)
reverselog_trans <- function(base = exp(1)) {
trans <- function(x) -log(x, base)
inv <- function(x) base^(-x)
trans_new(paste0("reverselog-", format(base)), trans, inv,
log_breaks(base = base),
domain = c(1e-100, Inf))
}
pretend_data <- tibble(data=1:5, estimate = runif(5, min = -1, max = 2), plot = c(1e-50, 2e-35, 5e-1, 1, 50))
# Define UI for application that draws a volcano plot
ui <- fluidPage(
# Application title
titlePanel("Pretend Plot"),
plotOutput("plot", click = "plot_click"),
tableOutput("data")
)
# Define server logic required to draw a volcano plot
server <- function(input, output, session) {
output$plot <- renderPlot({
ggplot(data = pretend_data, aes(x=estimate, y=plot)) +
geom_vline(xintercept=c(-1, 1), linetype=3) +
geom_hline(yintercept=0.01, linetype=3) +
geom_point() +
scale_y_continuous(trans = reverselog_trans(10))
}, res = 96)
output$data <- renderTable({
req(input$plot_click)
nearPoints(pretend_data, input$plot_click)
})
}
# Run the application
shinyApp(ui = ui, server = server)
The problem is that input$plot_click returns the coordinates on the transformed scale. nearPoints tries then to match those to the original scale which does not work.
You have a couple of options though:
Transform the data yourself and adapt y axis ticks via scale_y_continuous
Adapt pretend_data in the nearPoints call.
Option 1
This requires that you control y axis tick marks yourself and would need some more fiddling to get the exact same reuslts as in your example.
pretend_data_traf <- pretend_data %>%
mutate(plot = reverselog_trans(10)$transform(plot))
# Define UI for application that draws a volcano plot
ui <- fluidPage(
# Application title
titlePanel("Pretend Plot"),
plotOutput("plot", click = "plot_click"),
tableOutput("data")
)
# Define server logic required to draw a volcano plot
server <- function(input, output, session) {
output$plot <- renderPlot({
ggplot(data = pretend_data_traf, aes(x=estimate, y=plot)) +
geom_vline(xintercept=c(-1, 1), linetype=3) +
geom_hline(yintercept=0.01, linetype=3) +
geom_point() +
## would need to define breaks = to get same tick mark positions
scale_y_continuous(labels = reverselog_trans(10)$inverse)
}, res = 96)
output$data <- renderTable({
req(input$plot_click)
nearPoints(pretend_data_traf, input$plot_click)
})
}
# Run the application
shinyApp(ui = ui, server = server)
Option 2
pretend_data_traf <- pretend_data %>%
mutate(plot = reverselog_trans(10)$transform(plot))
# Define UI for application that draws a volcano plot
ui <- fluidPage(
# Application title
titlePanel("Pretend Plot"),
plotOutput("plot", click = "plot_click"),
tableOutput("data")
)
# Define server logic required to draw a volcano plot
server <- function(input, output, session) {
output$plot <- renderPlot({
ggplot(data = pretend_data, aes(x=estimate, y=plot)) +
geom_vline(xintercept=c(-1, 1), linetype=3) +
geom_hline(yintercept=0.01, linetype=3) +
geom_point() +
scale_y_continuous(trans = reverselog_trans(10))
}, res = 96)
output$data <- renderTable({
req(input$plot_click)
nearPoints(pretend_data_traf, input$plot_click) %>%
mutate(plot = reverselog_trans(10)$inverse(plot))
})
}
# Run the application
shinyApp(ui = ui, server = server)
I want to change chart type from e_line to e_bar based on a condition. What I tried to do was using some reactive expression or if else inside plot, but neither of them works. Any ideas how to tackle this?
So, I need to change dynamically e_line, I tried this:
newChartType <- reactive({
df = switch(
someCondition,
'1' = echarts4r::e_line(ColumnName2),
'2' = echarts4r::e_bar(ColumnName2)
)
})
output$plot <- echarts4r::renderEcharts4r({
dataChartStats() %>%
echarts4r::e_charts(ColumnName1) %>%
newChartType() %>%
echarts4r::e_legend(show = FALSE)
})
but it doesn't work. I'm interested in general rule on how to change dynamically building elements of plot code (can be ggplot as well etc, here I used echarts4r).
I couldn't find a way of obtaining the chart type directly from an input element, but here's one way of doing it:
library(shiny)
library(tidyverse)
ui <- fluidPage(
selectInput(
"type",
"Select a chart type:",
c("point", "line")),
plotOutput("plot")
)
server <- function(input, output) {
output$plot <- renderPlot({
if (input$type == "line") {
mtcars %>% ggplot() + geom_line(aes(x=mpg, y=disp))
} else {
mtcars %>% ggplot() + geom_point(aes(x=mpg, y=disp))
}
})
}
# Run the application
shinyApp(ui = ui, server = server)
Next time, please provide a minimum working example.
EDIT in response to OP's request for a solution based on a button click:
library(shiny)
library(tidyverse)
ui <- fluidPage(
actionButton("go", "Click me!"),
textOutput("type"),
# selectInput(
# "type",
# "Select a chart type:",
# c("point", "line")),
plotOutput("plot")
)
server <- function(input, output) {
v <- reactiveValues(type="line")
observeEvent(input$go, {
if (v$type == "line") v$type <- "point"
else v$type <- "line"
})
output$type <- renderText({ v$type })
output$plot <- renderPlot({
if (v$type == "line") {
mtcars %>% ggplot() + geom_line(aes(x=mpg, y=disp))
} else {
mtcars %>% ggplot() + geom_point(aes(x=mpg, y=disp))
}
})
}
# Run the application
shinyApp(ui = ui, server = server)
Using R Shiny and plotly I created a interactive scatter plot.
How can I modify my code to interactively label only the points which were selected by the user?
Example plot
Thank you so much for your help!
All the best,
Christian
library(plotly)
library(shiny)
library(dplyr)
data <- data.frame(matrix(runif(500,0,1000), ncol = 2, nrow = 100)) %>%
mutate(ID = row_number())
ui <- fluidPage(
plotlyOutput("plot"),
verbatimTextOutput("hover"),
verbatimTextOutput("click"),
verbatimTextOutput("brush"),
verbatimTextOutput("zoom"))
server <- function(input, output, session) {
output$plot <- renderPlotly({
p <- ggplot(data, aes(x = X1, y = X2, key = ID)) +
geom_point()
ggplotly(p) %>% layout(dragmode = "select")
})
}
shinyApp(ui, server)
Below is a possible solution. I use a reactive function to "label" selected points. I wasn't sure how exactly you want to display the IDs for selected points. The code adds the ID as text when a point is selected. Also, I add some jitter to move the IDs away from the points.
library(plotly)
library(shiny)
library(dplyr)
data <- data.frame(matrix(runif(500,0,1000), ncol = 2, nrow = 100)) %>%
mutate(ID = row_number())
ui <- fluidPage(
plotlyOutput("plot"),
verbatimTextOutput("hover"),
verbatimTextOutput("click"),
verbatimTextOutput("brush"),
verbatimTextOutput("zoom"))
server <- function(input, output, session) {
output$plot <- renderPlotly({
data <- get_data()
p <- ggplot(data, aes(x = X1, y = X2, key = ID)) +
geom_point() + geom_text(data=subset(data, show_id),aes(X1,X2,label=ID), position = position_jitter(width = 20,height = 20))
ggplotly(p, source = "subset") %>% layout(dragmode = "select")
})
get_data <- reactive({
event.data <- event_data("plotly_selected", source = "subset")
data <- data %>% mutate(show_id = FALSE)
if (!is.null(event.data)) {
data$show_id[event.data$pointNumber + 1] <- TRUE
}
data
})
}
shinyApp(ui, server)