I have a shiny app in which I plot a map with plotGoogleMaps and a rChart, with values related
to some markers in the map, rendered via rPlot.
The app user can click on a marker in the map to show a tooltip.
I'd like that when he clicks on the marker, the pertinent value in the chart would be highlighted.
Anybody knows how to perform this task?
Thank you.
#jdharrison
The R-code can be like this:
suppressPackageStartupMessages(library(googleVis))
## Hurricane Andrew (1992) storm track with Google Maps
AndrewMap <- gvisMap(Andrew, "LatLong", "Tip", options = list(showTip = TRUE,
showLine = TRUE, enableScrollWheel = TRUE, mapType = "hybrid", useMapTypeControl = TRUE))
print(AndrewMap, "chart")
The example was taken from here. You can download the package here. In this example, library googleVis is used, but I think that the answer can be similar.
Shiny example
server.R
# Author: Denis Petrov
# Date: 2014-07-04
# Example is based on http://rpubs.com/gallery/googleVis
library (shiny)
suppressPackageStartupMessages (library (googleVis))
# Define server logic required to summarize and view the selected dataset
shinyServer ( function (input, output, session)
{
GetDataAndrew <- function ()
{
# Hurricane Andrew (1992) storm track with Google Maps
AndrewMap <- gvisMap (Andrew, "LatLong", "Tip",
options = list(showTip = TRUE,
showLine = TRUE,
enableScrollWheel = TRUE,
mapType = "hybrid",
useMapTypeControl = TRUE))
return (AndrewMap)
}
output$viewchart <- renderGvis({
GetDataAndrew ()
})
output$info <- renderPrint ({
cat ('Hurricane\n')
cat ('Pressure=937\n')
cat ('Speed=120')
})
}
)
ui.R
# Author: Denis Petrov
# Date: 2014-07-04
# Define UI for dataset viewer application
shinyUI(pageWithSidebar(
# Application title
headerPanel('Hurricane Andrew (1992)'),
# Sidebar with controls to provide a caption, select a dataset, and
# specify the number of observations to view. Note that changes made
# to the caption in the textInput control are updated in the output
# area immediately as you type
sidebarPanel(
p ('Hurricane Andrew (1992) storm track with Google Maps'),
p ('I would like the following output be changed based on
selected pin.'),
verbatimTextOutput ('info')
),
# Show the caption, a summary of the dataset and an HTML table with
# the requested number of observations
mainPanel(
htmlOutput ('viewchart')
)
))
Related
I have a Shiny app that allows the user to enter their project details to the database. This is achieved by clicking the Add Project Details Button that adds an empty row to the table. Now the next step is:
The app should save (via a save button) the updated table so that the next time the app is opened it shows the updated table.
The purpose of this app is to shift from MS-Excel to an online app. Moreover, I am open to both local storage and remote storage approaches.
Update Based on Limey's excellent comment:
Yes, all users/team members will see the same/current updates in the dataframe. By that I mean, if a user enters a new project number 33336 with its details and saves it, then the entire team including the manager will be able to see this new project added.
Yes, multiple users might be using the app at the same time. Some might have opened it just to view it. Some team members might be adding their respective projects in the app at the same time. So, I don't really know how to resolve state conflicts.
How can I do this?
Sample Data (df):
structure(list(Reference.Number = c("33331", "33332", "33333",
"33334", "33335"), Request.Date = c("1/6/2022", "1/6/2022", "1/19/2022",
"1/20/2021", "1/24/2022"), Requestor.Name = c("Comm Dist 3 by Kitty",
"Comm Dist 3 by Kitty", "Updated maps for David",
" Stone Cold", "Updated SOE 60 inch wall map"), Requestor.Dept.Div = c("C 3 Staff",
"C 3 Staff", "Unincorp & Comm", "Mt.Rushmore AME Church Ft. Billy",
"SOE"), Requestor.Phone = c("", "", "", "", ""), Contact.Person = c("Tommy",
"Tommy", "Bob", "Bob", "Joe"), Contact.Phone = c("1111",
"2222", "3333", "ext 1111", "3434"), Deadline = c("1/20/2022",
"1/20/2022", "1/22/2022", "", "1/24/2022"), Project.Description = c("45x36 portrait map ",
"45x36 portrait map ",
"24x24 Unincorporated areas, "Percent Females Aged 25 - 55 Below Poverty Level By Zip Code",
"SOE Wall Map 60x60 p), Project.File.Location = c("",
"", "C:\\ABC\\Tommy\\work|Map-Projects\\BD Unincororated\\#14785 Unincorporated 24x24.pdf",
"C:\\ABC\\Demographics\\Demographic_Request\\FemalesAge10-18BelowPoveryLevel\\FemalesAge10-18BelowPoveryLevel.aprx",
"C:\\ABC\\Tommy\\work|Map-Projects\\BD Unincororated\\#14786 V P 60x60.pdf"
), PDF.File.....Map.Name.... = c("", "", "", "C:\\ABC\\Demographics\\Demographic_Request\\FemalesAge10-18BelowPoveryLevel\\pdfs\\MapNo14785.pdf",
""), Assigned.To = c("", "", "", "", ""), Completion.Date = c("",
"", "", "", ""), Notes = c(NA, NA, NA, NA, NA), Year = c(2022,
2022, 2022, 2022, 2022)), class = "data.frame", row.names = c(NA, -5L))
Code:
library(shiny)
library(shinythemes)
library(DT)
library(tidyverse)
# Define UI for application
ui = navbarPage(
tags$style("table, .table {color: unset;} .dataTable th, .datatables input {color: white}"),
title = div("GIS Team Projects"),
theme = shinytheme("cyborg"),
tabPanel("GIS Projects",
icon = icon("info"),
div(p(h1("Instructions:"),style="text-align: justify;")),
p("1. The user can add their project details.", style="color:black"),
uiOutput("all"),
sidebarLayout(
sidebarPanel(
actionButton("addData", "Add Project Details"),
actionButton("Save", "Please click here to save changes")
),
mainPanel(
downloadButton("download1","Download data as csv"),
DTOutput("contents")),)
)
)
# Define server logic
server <- function(input, output) {
myData = df
# Create an 'empty' tibble
user_table =
myData %>%
slice(1) %>%
# Transpose the first row of test into two columns
gather(key = "column_name", value = "value") %>%
# Replace all values with ""
mutate(value = "") %>%
# Reshape the data from long to wide
spread(column_name, value) %>%
# Rearrange the column order to match that of test
select(colnames(myData))
# Display data as is
output$contents =
renderDT(myData,
server = FALSE,
editable = TRUE,
options = list(lengthChange = TRUE),
rownames = FALSE)
# Store a proxy of contents
proxy = dataTableProxy(outputId = "contents")
# Each time addData is pressed, add user_table to proxy
observeEvent(eventExpr = input$addData, {
proxy %>%
addRow(user_table)
})
}
# Run the application
shinyApp(ui = ui, server = server)
Background: I am creating a Donor/Sample registration application. The workflow is as such:
Users select which Vendor the Donors/Samples are from.
Users upload a file (using datamods::import_file_server()).
Run some validation against that file (ie. x number of rows, y number of columns, etc., using datamods::validation_server())
Select pre-existing or Create a new Field Mapping.
4a) a Field Mapping is a mechanism for users to map the uploaded
file columns to our database table columns.
4b) If Create New, a modalDialog window should pop up, showing a 2
column datatable, one column for File column names, one column of
selectInput()'s that are populated with our database table fields
(columns).
I have this set up in such a way that a registration_module handles 1-3, and then within that, I have a nested fieldmapping_module which takes as input:
the (validated) file data
the vendor selection
and the database columns
Problem: I cannot seem to make the dynamically generated selectInput()'s "visible" to Shiny. Below is the fieldmapping_module code.
### FieldMapping module ####
fieldmappingUI <- function(id) {
tagList(
div(
column(8,
selectInput(
inputId = NS(id, "fieldmapping_selection"),
label = "Select Field Mapping",
choices = c("Choice 1", "Choice 2", "Choice 3")
),
),
column(4,
shinyWidgets::actionBttn(
inputId = NS(id, "create_new_fieldmapping_btn"),
label = "Create New",
icon = icon("file-alt"),
size = "sm"
)
),
style = "display:inline-block",
class = "form-group shiny-input-container")
)
}
fieldmappingServer <- function(id, file_data, vendor_selection, db_cols) {
stopifnot(is.reactive(file_data))
stopifnot(is.reactive(vendor_selection))
moduleServer(id, function(input, output, session) {
ns <- session$ns
#observe for creation of new FieldMappings
observeEvent(input$create_new_fieldmapping_btn, {
fieldmapping_table <- data.frame(
"File Columns" = colnames(file_data()),
"DB Field Mapping" = rep("", ncol(file_data()))
)
#browser()
for(i in seq_len(nrow(fieldmapping_table))) {
fieldmapping_table[i,"DB.Field.Mapping"] <- as.character(selectInput(
inputId = glue::glue("fieldmap_select_{fieldmapping_table$File.Column[i]}"),
label = NULL,
choices = db_cols
))
}
#browser()
#display the table
showModal(modalDialog(
renderDataTable({
DT::datatable(fieldmapping_table,
escape = 2,
selection = "none",
filter = 'none',
options = list(
dom = 't'
),
callback = JS("table.rows().every(function(i, tab, row) {
var $this = $(this.node());
$this.attr('id', this.data()[0]);
$this.addClass('shiny-input-slider-input');
});
Shiny.unbindAll(table.table().node());
Shiny.bindAll(table.table().node());")
)
}),
title = "New Field Mapping",
footer = tagList(
actionButton(ns("submit_fieldmapping"), label = "Submit", icon = icon("paper-plane")),
modalButton(label = "Close", icon = icon("window-close"))
)
))
})
observeEvent(input$submit_fieldmapping, {
browser()
})
})
}
Excepted behavior: For example, say I have uploaded a file with 3 columns: Subject_ID, Col_A, and Col_B, and it has passed validation (done in the registration_module, not shown).
When I hit the submit button of the modalDialog, and the app is paused due to the browser() call, I am excepting to have access to input$fieldmap_select_[column name](ex: input$fieldmap_select_Subject_ID), but I don't. I thought the custom JS callback would achieve this, as it seems to have worked here (and other code/apps I've come across while Googling).
On the browser() pause, if I enter input into the console to see the list of inputs, I indeed do see the dynamically generated inputs I created (the first three), but they are all NULL, despite having "set" them in the modalDialog window.
I am not too well versed in Javascript/Shiny interaction, but would appreciate any help I could get with this! What am I doing wrong?
(cross-posted on RStudio community forum)
Figured it out. I needed to include the server-side ns function in the dynamic generation of the input fields. ie:
for(i in seq_len(nrow(fieldmapping_table))) {
fieldmapping_table[i,"DB.Field.Mapping"] <- as.character(selectInput(
inputId = ns(glue::glue("fieldmap_select_{fieldmapping_table$File.Column[i]}")),
label = NULL,
choices = db_cols
))
}
notice the ns() call around the inputId.
I want to create a Shiny App with a single tab navbar and the navbar has a logo and some download buttons. I used Shiny NavBar add additional info to create buttons using HTML, but I'd like the onClick function to be the same as the button I included as output$downloadData. Is it possible to mix and match R code and JS to have the button in the navbar be a downloadButton?
library(shiny)
# Define UI for application that draws a histogram
ui <- navbarPage(
# Application title
"Old Faithful Geyser Data",
# Sidebar with a slider input for number of bins
sidebarPanel(
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30)
),
# I included download buttons here for functionality,
# these are the buttons I'd like in the top right
# Can I use onclick=downloadData or something within my HTML?
mainPanel(
downloadButton("downloadData", "CSV"),
downloadButton("downloadData2", "TXT"),
tableOutput("dist")
),
# Can I add R code to the HTML code so that onclick
# by button uses output$Downloaddata below?
tags$script(HTML("var header = $('.navbar> .container-fluid');
header.append('<div style=\"float:right; valign:middle\"><button onClick=downloadCSV(); style=\"valign:middle;\">Download CSV</button><button>Download SAS</button></div>');
console.log(header)"))
)
# Define server logic required to draw a histogram
server <- function(input, output) {
dummy <- data.frame(x = c(1,2,3), y = c(4,5,6))
output$dist <- renderTable({
dummy
})
output$downloadData <- downloadHandler(
filename = function() {
paste(dummy, ".csv", sep = "")
},
content = function(file) {
write.csv(dummy, file, row.names = FALSE)
}
)
output$downloadData2 <- downloadHandler(
filename = function() {
paste(dummy, ".csv", sep = "")
},
content = function(file) {
write.csv(dummy, file, row.names = FALSE)
}
)
}
# Run the application
shinyApp(ui = ui, server = server)
I would like to have the address that is filled in by the autocomplete function in the javascript+html script to be added to a textInput() box in Shiny. Also, once I have submitted my form with that address I would like the autocompleted address to be reset. I have some experience in Shiny/R but none in Js. I'm fairly certain I need to add some lines in js to send information to Shiny but I'm not sure how. My script is below:
library(shiny)
library(googlesheets)
library(DT)
# Define the fields we want to save from the form
fields <- c("Title", "Description", "Order Type", "Existing", "Due Date", "Address")
gs_auth()
table <- "responses"
saveData <- function(data) {
# Grab the Google Sheet
sheet <- gs_title(table)
# Add the data as a new row
gs_add_row(sheet, input = data)
}
# Load all previous responses
# ---- This is one of the two functions we will change for every storage type ----
loadData <- function() {
# Grab the Google Sheet
sheet <- gs_title(table)
# Read the data
gs_read_csv(sheet)
}
# Shiny app with 3 fields that the user can submit data for
shinyApp(
ui = fluidPage(
titlePanel("Sign Form"),
fluidRow(
DT::dataTableOutput("responses", width = 300), tags$hr(),
column(3, textInput("Title", "Title", "")),
column(3, textInput("Description", "Description", "")),
column(3, selectInput("Order Type", label = ("Select Box"), choices = list("Installation",
"Installation/Maintenance",
"Replace Existing")))
),
fluidRow(
column(3,checkboxInput("Existing", "Is there an existing sign", FALSE)),
column(3, dateInput("Due Date", label = ('Date input'), format = "mm-dd-yyyy"))
),
fluidRow(
**column(3, textInput("Address","Address", includeHTML("www/autocomplete.html")))**
),
fluidRow(
column(3, actionButton("submit", "Submit"))
)
),
server = function(input, output, session) {
# Whenever a field is filled, aggregate all form data
formData <- reactive({
data <- sapply(fields, function(x) input[[x]])
data
})
# When the Submit button is clicked, save the form data
observeEvent(input$submit, {
saveData(formData())
})
# Show the previous responses
# (update with current response when Submit is clicked)
output$responses <- DT::renderDataTable({
input$submit
loadData()
})
}
)
The line with the autocomplete.html is where I would like some kind of textInput() that is populated when an end user fills in the address form
Here is the autocomplete.html file it is the example "Javascript + HTML"
Basically, I have a gvisCalendar Chart from the googleVis package in a Shiny app, and I want to display a dataTable underneath the chart that corresponds to a selected box.
I can add an event listener by setting the gvis.listener.jscode argument to a variable that holds a string of javascript code. For example, using this code, I can pull up the wikipedia page for a selected calendar date:
output$dates_plot <- renderGvis({
gvisCalendar(calendar.ddply,
options = list(
colorAxis = "{
minValue: 0,
colors: ['E9967A', 'A52A2A']
}",
gvis.listener.jscode = jscode2 )
)
})
jscode2<- "window.open('http://en.wikipedia.org/wiki/'
+ data.getValue(chart.getSelection()[0].row,0)); "
Using this code, I ran my program, selected the "June 16, 2015" box, and a new tab came up on my browser for this website: https://en.wikipedia.org/wiki/Tue_Jun_16_2015_00:00:00_GMT-0400_(EDT)
I don't actually want to do anything with wikipedia, I was just using that as an example.
All I want to do is save the date of the selected calendar box as an R object so that I can then display a data table of data that corresponds to that date.
I have almost no experience with javascript.
Thank you!
You can use Shiny.onInputChange to send data back to the server.
Here is an example:
library(shiny)
library(googleVis)
server <- function(input, output) {
output$dates_plot <- renderGvis({
gvisCalendar(Cairo,
options = list(
colorAxis = "{
minValue: 0,
colors: ['E9967A', 'A52A2A']
}",
gvis.listener.jscode = "
var selected_date = data.getValue(chart.getSelection()[0].row,0);
var parsed_date = selected_date.getFullYear()+'-'+(selected_date.getMonth()+1)+'-'+selected_date.getDate();
Shiny.onInputChange('selected_date',parsed_date)")
)
})
output$date <- renderText({
input$selected_date
})
}
ui <- shinyUI(fluidPage(
htmlOutput("dates_plot"),
textOutput("date")
))
shinyApp(ui = ui, server = server)
In this example I parsed the date to YYYY/M/D, if you want to keep the javascript long date format you can also return selected_date.toString() instead of parsed_date.