Click on marker to open plot / data table - shiny

I'm working on leaflet with shiny. The tools is basic, i have a map with some markers (coming from a table with LONG and LAT).
What I want to do is to open a table or a graph when i click on the marker.
Is there a simple way to do it?
Do you have a really simple example: you have a maker on a map, you click on the marker, and there is a plot or a table or jpeg that s opening?

Here is another example, taken from here and a little bit adapted. When you click on a marker, the table below will change accordingly.
Apart from that, a good resource is this manual here:
https://rstudio.github.io/leaflet/shiny.html
library(leaflet)
library(shiny)
myData <- data.frame(
lat = c(54.406486, 53.406486),
lng = c(-2.925284, -1.925284),
id = c(1,2)
)
ui <- fluidPage(
leafletOutput("map"),
p(),
tableOutput("myTable")
)
server <- shinyServer(function(input, output) {
data <- reactiveValues(clickedMarker=NULL)
# produce the basic leaflet map with single marker
output$map <- renderLeaflet(
leaflet() %>%
addProviderTiles("CartoDB.Positron") %>%
addCircleMarkers(lat = myData$lat, lng = myData$lng, layerId = myData$id)
)
# observe the marker click info and print to console when it is changed.
observeEvent(input$map_marker_click,{
print("observed map_marker_click")
data$clickedMarker <- input$map_marker_click
print(data$clickedMarker)
output$myTable <- renderTable({
return(
subset(myData,id == data$clickedMarker$id)
)
})
})
})
shinyApp(ui, server)

There is a leaflet example file here:
https://github.com/rstudio/shiny-examples/blob/ca20e6b3a6be9d5e75cfb2fcba12dd02384d49e3/063-superzip-example/server.R
# When map is clicked, show a popup with city info
observe({
leafletProxy("map") %>% clearPopups()
event <- input$map_shape_click
if (is.null(event))
return()
isolate({
showZipcodePopup(event$id, event$lat, event$lng)
})
})
Online demo (see what happens when you click on a bubble):
http://shiny.rstudio.com/gallery/superzip-example.html
On the client side, whenever a click on a marker takes place, JavaScript takes this event and communicates with the Shiny server-side which can handle it as input$map_shape_click.

Related

Accessing RXSpreadsheet data for further manipulation?

I am making a Shiny app that should have an empty spreadsheet (like excel), where I can paste some data, which can be further processed to get some desired output.
How can I access the data from the spreadsheet for further manipulation in my app?
In the code below, I successfully load an empty spreadsheet that is editable, I can also paste whatever I want into it, but I don't know how to manipulate the data further. I tried to at least load it like a DT table just to see if I managed to convert it to data.frame.
library(shiny)
library(RXSpreadsheet)
ui <- fluidPage(
tabsetPanel(
tabPanel(
"Spreadsheet",
RXSpreadsheet("table"),
RXSpreadsheetOutput("spreadsheet")
),
tabPanel(
"Tabela",
DT::dataTableOutput("dataframe")
)
)
)
server <- function(input, output) {
data <- reactive({
input$table
})
output$spreadsheet <- renderRXSpreadsheet({
data()
})
data_2 <- reactive({
as.data.frame(data())
})
output$dataframe <- DT::renderDT({
data_2()
})
}
shinyApp(ui, server)

isolate input in a module shiny when using insert ui

I'd like to create several ui which use an input parameter. The problem is that the new UI created are still reacting to the input even when I put an isolate()
The right behaviour would give a custom UI created and isolated from the new inputs coming from the selectInput()
For instance I'd like a first UI with the year 2019 selected and second UI with the year 2020.
Here we can see that adding 2020 will change in each UI which is wrong.
library(shiny)
customplotUI <- function(id){
ns <- NS(id)
fluidPage(
sidebarPanel(id=ns("sidebarpanel"),
actionButton(ns("add"),label = "Add"),
selectInput(inputId=ns("years"),label="Year :", choices = c(2019,2020),selected = 2019, multiple = TRUE)),
mainPanel(div(id=ns("placeholder"))
)
)
}
customplot <- function(input,output,session){
ns <- session$ns
output$res <- renderPrint({
data <- data.frame(year=c(2019,2020),value=c("mtcars2019","mtcars2020"))
data[data$year %in% input$years,]})
ctn <- reactiveVal(0)
Id <- reactive({
function(id){
paste0(id, ctn())
}
})
IdNS <- reactive({
function(id){
ns(paste0(id, ctn()))
}
})
observeEvent(input$add, {
ctn(ctn() + 1)
print(Id()('div'))
insertUI(
selector = paste0('#', ns('placeholder')),
ui = div(
id = Id()('div'),
verbatimTextOutput(IdNS()('chart'))
)
)
id <- Id()('chart')
output[[id]] <- renderPrint({
data <- data.frame(year=c(2019,2020),value=c("mtcars2019","mtcars2020"))
#data[data$year %in% isolate(input$years),]
data[data$year %in% input$years,]
})
})
}
ui <- fluidPage(
customplotUI(id="customplot")
)
server <- function(input, output, session){
callModule(customplot,id="customplot",session=session)
}
shinyApp(ui, server)
Perhaps I'm misunderstanding what you're trying to accomplish, but when I run the code, using the commented line with isolate seems to work as intended.
I'm guessing that in creating the minimal reprex (thank you for doing this btw!), you might have gone a little too minimal and removed another reactive that updates data. If you are trying to have the individual UI elements update based on some other input but keep the same filtering scheme, you need to capture the current value of input$years outside of the renderPrint statement.
Here you can see the subset of rows is unchanged, but the last column updates based on input box:
...
id <- Id()('chart')
targetYears <- input$years
output[[id]] <- renderPrint({
data <- data.frame(year=c(2019,2020),
value=c("mtcars2019","mtcars2020"),
yrInput = paste(input$years, collapse =" "))
data[data$year %in% targetYears, ]
...
isolate only prevents a change in the reactive from triggering an update. If the update is triggered by something else, the current/updated value of the reactive is still used. Through the wonders of R's scoping rules, by capturing the value of input$years in non-reactive variable, targetYears, outside of the renderPrint call and then using that in the renderPrint expression it will always use the the value of the input when output[[id]] was created. The isolate is not needed as you are using observeEvent which will prevent the observer from executing when you change the input.

Select All/Deselect All Option Leaflet for R Overlay

I have a r leaflet map that has multiple layers and each layer can be checked or unchecked. I am trying to find a way to have a select all/deselect all option.
Below is my code where the overlays are reactive groups.
df() is a reactive dataframe
myLocation() is a reactive location (long,lat)
So in the map in the upper right hand corner is where I want a select all/ deselect all option
groups <- reactive({as.character(unique(df()$Folder))})
groupColors <- reactive({
colorFactor(palette = rainbow(length(groups())),
domain = df()$Folder)
})
output$mymap <- renderLeaflet({
leaflet() %>%
addTiles() %>%
leaflet::addMarkers(lng=c(myLocation()[1]), lat=c(myLocation()[2]),
popup = paste("Lat/Long: ",myLocation()[2],"/",myLocation()[1]),
popupOptions = popupOptions(maxWidth = 1000, closeOnClick = TRUE))
%>%
############more code here
#this section is where a select all/ deselect option has to be placed
addLayersControl(overlayGroups=groups(),options =
layersControlOptions(collapsed = TRUE))
})
Following shiny tutorial... try using leafletProxy to modify your existing map and use the hideGroup() function from leaflet to add/remove the entire group.

Use Shiny to display bar graph by state

I'm trying to use shiny to create a bar graph for a state that is selected via drop-down box. I'm quite new to R and I've tried a variety of examples to no avail. I have three variables (state, claim #, total $) and for each state there are five values. So something like this:
state <- c("PA", "TX", "NY")
claim_num <- c(1:15)
total <- sample(1000:5000, 15)
df <- (state, claim_num, total)
I want to have something similar to https://beta.rstudioconnect.com/jjallaire/shiny-embedding/#inline-app but I don't know if I can format my data in that was since I would have a lot of NAs.
Do you mean something like this (you can download and run the example)?
library(shiny)
ui <- shinyUI(
fluidPage(
titlePanel("Sample Shiny App"),
sidebarLayout(
sidebarPanel(
uiOutput("stateInput")
),
mainPanel(
plotOutput("statePlot")
)
)
))
server <- shinyServer(function(input, output) {
state <- sample(state.abb, 3, replace = FALSE)
total <- sample(1000:5000, 15)
claimNumber <- 1:15
data <- data.frame(state, total, claimNumber)
output$stateInput <- renderUI({
selectInput(
inputId = "state",
label = "Select a State:",
choices = levels(data$state)
)
})
output$statePlot <- renderPlot({
hist(data$total[data$state == input$state])
})
})
shinyApp(ui = ui, server = server)
What we're doing is taking the list of unique states available in our data frame and passing those to our selectInput that renders as a dropdown in the UI. From here, we can access whatever value the user has selected through the input$state object. More generally, we can access inputs based on whatever we define the inputId to be (in this particular case, we call it state).
Having grabbed the user input, we can then subset the data frame to only return values that correspond to the user-defined state and, in this case, pass those totals values to a plot that we render as output.

Highlighting only one column in a table in Shiny

I'm currently designing a Shiny app that outputs a table. I would like to highlight the cells in a particular column (e.g., make the cells blue). I've tried using the HighlightRows function from the shinyBS package, but that doesn't seem to work.
Here is a portion of my server script making up the table:
output$text1 <- renderTable({
tab1 <- as.data.frame(matrix(c(rrround(input$patha,3),PowerF()$tta,input$nxn,rrround(currentInput()$patha,3),rrround(rxyval()$rxy,3),rrround(rxyval()$rxy_p,3),rround(PowerF()$tra,3),
rrround(input$pathp,3),PowerF()$ttp,input$nxn,rrround(currentInput()$pathp,3),rrround(rxyval()$rxyp,3),rrround(rxyval()$rxyp_p,3),rround(PowerF()$trp,3))
,ncol=7, byrow=TRUE))
rownames(tab1) <- c('Actor', 'Partner')
colnames(tab1) <- c('Size', 'Power', 'N','Beta','r','partial r','ncp')
tab1.align = "r"
highlightRows(session, id='tab1', class = "info", column="Power", regex = ".")
print(tab1, type="html")
})
Any help would be greatly appreciated.
Thanks!
You can modify your datatable using tags$script. below is an example of highlighting 3 columns (1), (5) and (9) of a sample datatable. I had a small problem with a similar issue, you can view that How to change Datatable row background colour based on the condition in a column, Rshiny
rm(list = ls())
library(shiny)
options(digits.secs=3)
test_table <- cbind(rep(as.character(Sys.time()),10),rep('a',10),rep('b',10),rep('b',10),rep('c',10),rep('c',10),rep('d',10),rep('d',10),rep('e',10),rep('e',10))
colnames(test_table) <- c("Time","Test","T3","T4","T5","T6","T7","T8","T9","T10")
ui =navbarPage(inverse=TRUE,title = "Coloring datatables",
tabPanel("Logs",icon = icon("bell"),
mainPanel(htmlOutput("logs"))),
tabPanel("Extra 2",icon = icon("bell")),
tabPanel("Extra 3",icon = icon("bell")),
tags$style(type="text/css", "#logs td:nth-child(1) {text-align:center;background-color:red;color: white;text-align:center}"),
tags$style(type="text/css", "#logs td:nth-child(5) {text-align:center;background-color:blue;color: white;text-align:center}"),
tags$style(type="text/css", "#logs td:nth-child(9) {text-align:center;background-color:green;color: white;text-align:center}")
)
server <- (function(input, output, session) {
my_test_table <- reactive({
other_data <- rbind(c(as.character(Sys.time()),(sample(c("Pass","Aggr","Bad"))[1]),round(c(rnorm(1),rnorm(1),rnorm(1),rnorm(1),rnorm(1),rnorm(1),rnorm(1),rnorm(1)),2)),
(c(as.character(Sys.time()),(sample(c("Pass","Aggr","Bad"))[1]),round(c(rnorm(1),rnorm(1),rnorm(1),rnorm(1),rnorm(1),rnorm(1),rnorm(1),rnorm(1)),2))))
test_table <<- rbind(apply(other_data, 2, rev),test_table)
as.data.frame(test_table)
})
output$logs <- renderTable({my_test_table()},include.rownames=FALSE)
})
runApp(list(ui = ui, server = server))