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")))
})
Related
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)
Right now I'm using shiny and Plotly in R to make graphs to visualize data.
I have this list with items and for each item I want to generate a graph with the name of this item.
Is it possible to have your graph output name based on this list item?
In the simplest terms:
What I have:
output$plot <- renderPlotly({})
What I want:
listitems <- c("graph1", "graph2")
output$listitems[1] <- renderPlotly({})
This situation would be ideal, as I want to generate multiple graphs by using a function to minimalize code.
If I understand correctly, you don't want to assign every plot manually. Accordingly we can use a for-loop or lapply like this:
library(shiny)
library(plotly)
ui <- fluidPage(
uiOutput("myPlots")
)
server <- function(input, output, session) {
listItems <- paste0("graph", 1:10)
dfList <- replicate(10, data.frame(x = 1:10, y = runif(10)), simplify = FALSE)
names(dfList) <- listItems
lapply(seq_along(dfList), function(i){
output[[listItems[i]]] <- renderPlotly({plot_ly(dfList[[i]], x = ~x, y = ~y, type = "scatter", mode = "lines+markers") %>% layout(title = listItems[i])})
})
output$myPlots <- renderUI({
lapply(listItems, plotlyOutput)
})
}
shinyApp(ui, server)
Take a look at subplots. In your example, this would have to be something like:
library(shiny)
library(plotly)
ui <- fluidPage(
plotlyOutput("plot")
)
server <- function(input, output, session) {
p1 <- plot_ly(economics, x = ~date, y = ~unemploy) %>%
add_lines(name = ~"unemploy")
p2 <- plot_ly(economics, x = ~date, y = ~uempmed) %>%
add_lines(name = ~"uempmed")
listitems <- list(p1, p2)
output$plot <- renderPlotly({
subplot(listitems)
})
}
shinyApp(ui, server)
Output:
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)
Is there any way to select or highlight data on a leaflet map in by clicking on the legend in Rshiny?
example code:
library(shiny)
library(leaflet)
library(RColorBrewer)
library(leafletGeocoderRshiny)
ui <- fluidPage(
leafletOutput("map"),
p(),
actionButton("recalc", "New points")
)
server <- function(input, output, session) {
df = data.frame(x = rnorm(100), y = rexp(100, 2), z = runif(100))
pal = colorBin('PuOr', df$z, bins = c(0, .1, .4, .9, 1))
output$map <- renderLeaflet({ leaflet(df) %>%
addCircleMarkers(~x, ~y, color = ~pal(z)) %>%
addLegend(pal = pal, values = ~z)
})
}
shinyApp(ui, server)
The recent updates (0.2) to the mapedit package may help: http://r-spatial.org/r/2017/06/09/mapedit_0-2-0.html
I got close, but ran out of time now. But i decided to share anyway, maybe someone else sees a solution to the last step.
So far it works for the first click on any of the rectangles in the legend. It doesnt work for any following clicks as the map is redrawn and with it the onclick listeners are deleted. I didnt find a way to add them again so far,...
Its a hacky aprroach: I add onclick listener to the boxes and decided to update the colors via R as i didnt see a good way in JS.
library(shiny)
library(leaflet)
library(RColorBrewer)
library(leafletGeocoderRshiny)
library(shinyjs)
colors <- c("#000000", "#222222", "#888888", "#FFFFFF")
ui <- fluidPage(
useShinyjs(),
leafletOutput("map"),
p(),
actionButton("recalc", "New points")
)
server <- function(input, output, session) {
global <- reactiveValues(colors = colors,
bins = c(0, .1, .4, .9, 1))
observe({
print(input$interval)
isolate({
if(!is.null(input$interval)){
lowerBound <- as.numeric(unlist(input$interval))
global$colors <- colors
global$colors[which(global$bins == lowerBound)] <- "#FF0000"
}
})
})
session$onFlushed(function() {
runjs("
var legendButton = document.getElementsByTagName('i')
var elem; var interval;
for (nr = 0; nr < legendButton.length; nr++) {
elem = legendButton[nr]
elem.onclick = function(e){
console.log(e.target)
interval = e.target.nextSibling.nodeValue.split(' ');
Shiny.onInputChange('interval', interval[1]);
}
}
")
})
df = data.frame(x = rnorm(100), y = rexp(100, 2), z = runif(100))
pal = reactive({
colorBin(global$colors, df$z, bins = global$bins)
})
output$map <- renderLeaflet({ leaflet(df) %>%
addCircleMarkers(~x, ~y, color = ~pal()(z)) %>%
addLegend(pal = pal(), values = ~z)
})
}
runApp(shinyApp(ui, server), launch.browser = T)