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)
Related
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 am trying to display a plot inside a tooltip. I only want the tooltip to display when I am hovering above the mpg row. I was trying to achieve something like this: https://laustep.github.io/stlahblog/posts/DTqTips.html, but was coming up short. Below is a reprex solution with the plot I want to display.
library(shiny)
library(DT)
library(tidyverse)
shinyApp(
ui = fluidPage(
selectInput('cylSelect', choices = c(4,6,8), label ="Select the # of cylinders"),
dataTableOutput('table'),
),
server = function(server, input, output) {
cars <- reactive({
mtcars %>%
filter(cyl == input$cylSelect) %>%
group_by(am) %>%
summarise(across(everything(), mean))
})
p <- renderPlot({
cars() %>%
ggplot(aes(x = am, y=mpg)) +
geom_bar(stat = 'identity')
})
output$table <- renderDataTable({
datatable(cars()
)
})
}
)
Not sure if this is what you are looking for, but one option would be to use the tippy package to create your column header.
library(shiny)
library(tippy)
tippy("Example Text",
tooltip = paste(img(src="http://tippy.john-coene.com/logo.png")),
allowHTML = TRUE,
placement = "bottom",
theme = "light"
)
Afaik it only works with static images though, but you could simply save the output plot and reference it in the tooltip.
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")))
})
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)
I use the mtcars dataset as an example.
library(tidyverse)
library(plotly)
plot <- mtcars %>%
ggplot() +
geom_histogram(aes(mpg), binwidth = 3)
ggplotly(plot)
What I would like to do is to have a filter on, e.g. the am variable so I can easily update the plots so the plot only shows the same histograms
but only for only am==1 etc. So I would like a button on the graph so I can make the filter.
Well this works:
library(plotly)
mtcars %>%
plot_ly(x = ~mpg ) %>%
add_histogram(frame=~am)
"frame" creates a slider...
Here is a solution with shiny:
library(shiny)
ui <- fluidPage(
checkboxGroupInput("cols", label = "Columns", choices = unique(mtcars$cyl), selected = unique(mtcars$cyl)[1] ),
plotOutput("plot")
)
server <- function(input, output, session) {
output$plot <- renderPlot({
data <- mtcars
data <- data[data$cyl %in% input$cols,]
hist(data$mpg)
})
}
shinyApp(ui, server)
#David I think what #marco means with a trigger in the code is something like:
plot <- mtcars %>%
filter(am == 1) %>%
ggplot() +
geom_histogram(aes(mpg), binwidth = 3) +
facet_wrap(~cyl)
you can just provide a simple dplyr:filter, before you start creating the plot , this does not give you a button though.
Does this solve your issue?