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)
Related
I'm new in programming language especially R.
I have data frame and want to show top 3 of my data and sort from the biggest value using bar chart. I have tried some codes but failed to create proper chart. Here is my latest code :
library(shiny)
library(plotly)
my_data <- data.frame(x1 = c("a","b", "c","d","e","f","g","h"),
x2 = c(200, 200, 100,200,200,100,200,100),
x3 = c(100,400,500,50,100,300,100,50))
df1 <- my_data[order(my_data$x3),] #order by x3 value, to create rank
ui <- tabPanel("Test",
sidebarLayout(
sidebarPanel(
selectInput(inputId = "why",
label = "1. Select",
choices = df1$x2),
),
mainPanel(plotlyOutput("test"))
))
server <- function(input, output, session) {
output$test <- renderPlotly({
df2 <- df1 %>%
filter(x2 ==input$why) #filter by x2
p <-ggplot(df2,
aes(x = x1, y=x3)) +
geom_bar(stat = "identity")
fig <- ggplotly(p)
fig
})}
shinyApp(ui = ui, server = server)
the bar chart I created was not ordered correctly (based on x3 values), and I also only want to show top 3 of my data
To filter for the top 3 rows you could use dplyr::slice_max and to reorder your bars use e.g. reorder. Simply reordering the dataset will not work.
library(shiny)
library(dplyr)
library(plotly)
ui <- tabPanel(
"Test",
sidebarLayout(
sidebarPanel(
selectInput(
inputId = "why",
label = "1. Select",
choices = unique(df1$x2),
selected = 200
),
),
mainPanel(plotlyOutput("test"))
)
)
server <- function(input, output, session) {
output$test <- renderPlotly({
df2 <- df1 %>%
filter(x2 == input$why) %>%
slice_max(x3, n = 3, with_ties = FALSE)
p <- ggplot(
df2,
aes(x = reorder(x1, -x3), y = x3)
) +
geom_bar(stat = "identity")
fig <- ggplotly(p)
fig
})
}
shinyApp(ui = ui, server = server)
#>
#> Listening on http://127.0.0.1:8022
I know the question is already answered, but I encourage you to keep your server function as small as possible and try to wrap long series of code into functions.
Here is an example of what I mean
library(tidyverse)
library(shiny)
library(plotly)
my_data <- data.frame(x1 = c("a","b", "c","d","e","f","g","h"),
x2 = c(200, 200, 100,200,200,100,200,100),
x3 = c(100,400,500,50,100,300,100,50))
df1 <- my_data[order(my_data$x3),] #order by x3 value, to create rank
myPlot <- function(data, input) {
df <- data |>
filter(x2 == input) #filter by x2
p <-ggplot(df, aes(x = reorder(x1, -x3), y=x3)) +
geom_bar(stat = "identity")
return(ggplotly(p))
}
ui <- tabPanel("Test",
sidebarLayout(
sidebarPanel(
selectInput(inputId = "why",
label = "1. Select",
choices = df1$x2),
),
mainPanel(plotlyOutput("test"))
))
server <- function(input, output, session) {
output$test <- renderPlotly({
myPlot(df1, input$why)
})
}
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)
I have a shiny which has tooltips which show the full text of a long string. I am able to show all this text in a manageable way using str_wrap function in the text argument field for the tooltip.
library(shiny)
library(tidyverse)
library(plotly)
library(stringi)
dat <- mtcars %>%
rownames_to_column(var = "model")
dat[["lorem"]] <- rep(stri_rand_lipsum(n_paragraphs = 1), 32)
ui <- fluidPage(
plotlyOutput("plot1")
)
server <- function(input, output, session) {
output$plot1 <- renderPlotly({
p1 <- dat %>%
ggplot(aes(x = wt, y = mpg,
text = str_wrap(lorem, width = 80))) +
geom_point()
ggplotly(p1, tooltip = "text")
})
}
shinyApp(ui, server)
However, I would like to also include some other labels, for instance model and mpg, with some custom styling (i.e. bolding the column titles), along the lines of:
Cany anyone provide a solution of how to do this - I know how to do it w/o the str_wrap function, but can't figure out how to accomplish this w/ it.
Try this:
library(shiny)
library(tidyverse)
library(plotly)
library(stringi)
dat <- mtcars %>%
rownames_to_column(var = "model")
dat[["lorem"]] <- rep(stri_rand_lipsum(n_paragraphs = 1), 32)
ui <- fluidPage(
plotlyOutput("plot1")
)
server <- function(input, output, session) {
output$plot1 <- renderPlotly({
p1 <- dat %>%
ggplot(aes(x = wt, y = mpg,
text = paste0("<b>Model:</b> ", model, "<br>",
"<b>MPG:</b> ", mpg, "<br>",
str_wrap(paste0("<b>Text:</b> ", lorem), width = 80)
))) +
geom_point()
ggplotly(p1, tooltip = "text")
})
}
shinyApp(ui, server)
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)
I'm using leaflet in my shiny app and I want the app to open a window including a plot once the user clicks on the map. I have written the below code:
library(shiny)
library(leaflet)
library(plotly)
library(dplyr)
ui <- fluidPage(
leafletOutput("mymap"),
)
server <- function(input, output, session) {
points <- eventReactive(input$recalc, {
cbind(rnorm(40) * 2 + 13, rnorm(40) + 48)
}, ignoreNULL = FALSE)
output$mymap <- renderLeaflet({
leaflet() %>%
addProviderTiles(providers$Stamen.TonerLite,
options = providerTileOptions(noWrap = TRUE)
) %>%
addMarkers(data = points())
})
observeEvent(input$mymap_marker_click,{
df <- data.frame(x = 1:10, y = 1:10)
plt <- ggplot(df, aes(x,y)) + geom_line()
pltly <- ggplotly(plt)
showModal(modalDialog(
title = "Important message", size = "l",
pltly ))
})
}
shinyApp(ui, server)
This code kind of does the job but it shows the plot very compressed! and if you slightly drag the boundaries of the window to the left or right then it will be fixed but I want it to work without the need to do that for fixing the plot! Does anyone know a better way for doing it?
You can use renderPlotly and plotlyOutput to make and display the plot.
output$my_plotly <- renderPlotly({
df <- data.frame(x = 1:10, y = 1:10)
plt <- ggplot(df, aes(x,y)) + geom_line()
ggplotly(plt)
})
observeEvent(input$mymap_marker_click,{
showModal(modalDialog(plotlyOutput("my_plotly")))
})