Save and Load user selections based on file selection - RShiny - shiny
I am trying to create simple app that acts as a GUI for studying different files having same variables but with different version and content. I am unable to give an app where every time the user opens the app they dont have to enter in their parameters again where they left off. I'd like them to be able to save their parameters and bring them up again when they go back to the app.
I am giving my sample code here, however the number of inputs and plots are far more in the actual app. I want to know if there is any solution to save these dependent inputs and outputs.
library(shiny)
library(pryr)
ui = shinyUI(fluidPage(
# Application title
titlePanel("Example Title"),
# Sidebar structure
sidebarLayout(
sidebarPanel(
textInput("save_file", "Save to file:", value="sample.RData"),
actionButton("save", "Save input value to file"),
uiOutput("load"),
uiOutput("file"),
uiOutput("mytype"),
uiOutput("mysubtype")
),
# Show a plot of the generated distribution
mainPanel(
tabsetPanel(id="tab",
tabPanel(
"Plot",
plotOutput("distPlot"),
checkboxInput(inputId = "density",
label = strong("Show Adjustment Factors"),
value = FALSE),
conditionalPanel(condition = "input.density == true",
sliderInput(inputId = "bandwidth",
label = "Width adjustment: ",
min = 0.5, max = 4, value = 1, step = 0.1),
radioButtons("mycolor", "Color Adjustment: ",
choices = c(Red = "red", Black = "black", Blue = "blue"),selected = "black", inline = TRUE)
)),
tabPanel("Summary",
h3(textOutput("label")),
verbatimTextOutput("summary")
)
))
)
)
)
server = function(input, output, session) {
# render a selectInput with all RData files in the specified folder
output$load <- renderUI({
choices <- list.files("/home/user/Documents/Shiny/", pattern="*.RData")
selectInput("input_file", "Select input file", choices)
})
# render a selectInput with all csv files in the specified folder so that user can choose the version
output$file <- renderUI({
choices.1 <- list.files("/home/user/Documents/Shiny/", pattern="*.csv")
selectInput("input_csv", "Select csv file", choices.1)
})
# Load a csv file and update input
data = eventReactive(input$input_csv, {
req(input$input_csv)
read.csv(paste0("/home/user/Documents/Shiny/",input$input_csv),
header = TRUE,
sep = ",")
})
#Display Type - Types may differ based on file selection
output$mytype <- renderUI({
selectInput("var1", "Select a type of drink: ", choices = levels(data()$Type))
})
#Display SubType - This would be dependent on Type Selection
output$mysubtype <- renderUI({
selectInput("var2", "Select the SubType: ", choices = as.character(data()[data()$Type==input$var1,"Subtype"]))
})
# Save input when click the button
observeEvent(input$save, {
validate(
need(input$save_file != "", message="Please enter a valid filename")
)
mycolor <- input$mycolor
mytype = input$var1
mysubtype = input$var2
density <- input$density
bandwidth <- input$bandwidth
save(bandwidth, density, mycolor, mytype, mysubtype,
file=paste0("/home/user/Documents/Shiny/", input$save_file))
choices <- list.files("/home/user/Documents/Shiny/", pattern="*.RData")
updateSelectInput(session, "input_file", choices=choices)
choices.1 <- list.files("/home/user/Documents/Shiny/", pattern="*.csv")
updateSelectInput(session, "input_csv", choices=choices.1)
})
# Load an RData file and update input
# input$var1, input$var2, input$density, input$bandwidth, input$mycolor),
observeEvent(c(input$input_file),
{
load(paste0("/home/user/Documents/Shiny/",input$input_file))
updateSelectInput(session, "var1", choices = levels(data()$Type), selected = mytype)
updateSelectInput(session, "var2", choices = as.character(data()[data()$Type==mytype,"Subtype"]), selected = mysubtype)
updateCheckboxInput(session, "density", value = density)
updateSliderInput(session, inputId = "bandwidth", value=bandwidth)
updateRadioButtons(session, "mycolor", choices = c(Red = "red", Black = "black", Blue = "blue"), selected = mycolor, inline = TRUE)
})
output$distPlot <- renderPlot({
# generate plot
x = data()[data()$Type == input$var1 & data()$Subtype == input$var2, c("Alcohol_Content","Price")]
plot(x$Alcohol_Content, x$Price, type = "l", xlab = "Alcohol content", ylab = "Price",
main = "Sample Plot",
col="red",
lwd=1.5)
if (input$density)
plot(x$Alcohol_Content, x$Price, type = "p", xlab = "Alcohol content", ylab = "Price",
main = "Sample Plot",
col=input$mycolor,
lwd=input$bandwidth)
})
output$summary <- renderText(summary(data()))
}
shinyApp(ui, server)
The Input csv files would be always stored in
"/home/user/Documents/Shiny/"
The User could just click "Save to
file:" and it should save the user selections inside "sample.RData"
located in same "/home/user/Documents/Shiny/". Hence I want to give a selectinput where user can choose the .RData file also.
The user should also be able to save the inputs on Mainpanel which they would use to modify the chart
Questions:-
Most of the code works fine given above but how can I save #Display Subtype.
What happens if I add one more dependent list like Type and Subtype?
And also if I can get some help on whether the solution would work for multiple select inputs?.
Any help on the code would be really be appreciated.
Dummy Data:-
x = data.frame(Type=rep(c("WINE"), 9), Subtype=rep(c("TABLE WINE RED", "TABLE WINE WHITE", "MONTILLA"), each=3), Alcohol_content= c(14, 11.5, 12, 11, 13.5, 11, 12.5, 12, 11.5), Price = c(30.99, 32.99, 29.99, 33.99, 36.99, 34.99, 119, 32.99, 13.99))
y = data.frame(Type=rep(c("REFRESHMENT"), 9), Subtype=rep(c("CIDER ALL", "SPIRIT", "BEER"), each=3), Alcohol_content= c(5, 5.2, 7, 5.3, 6.9, 5, 5, 6, 5), Price = c(9.99, 9.99, 8.99, 9.95, 3.49, 9.99, 12.99, 13.49, 21.99))
bcl_data1 = rbind(x, y)
write.csv(bcl_data1, "bcl_data1.csv")
There are many more Subtypes under each Type (Wine , Refreshment). I am somehow not able to retrieve the Subtype value through above code, However when I load Sample.RData I can see var2 = my selected value.
I would like to know how save these values please.
Here is a working version of your code. Your problem was the concurrent use of renderUI and updateSelectInput. Everytime you tried to update your selectInput it was re-rendered right away so that the change wasn't visible.
I'd recommend to render the selectInput's in the UI (which I did for "var2") and use updateSelectInput only. (If you really want to continue building your own bookmarks.)
Best regards
library(shiny)
library(pryr)
if(!file.exists("bcl_data1.csv")){
x = data.frame(Type=rep(c("WINE"), 9), Subtype=rep(c("TABLE WINE RED", "TABLE WINE WHITE", "MONTILLA"), each=3), Alcohol_content= c(14, 11.5, 12, 11, 13.5, 11, 12.5, 12, 11.5), Price = c(30.99, 32.99, 29.99, 33.99, 36.99, 34.99, 119, 32.99, 13.99))
y = data.frame(Type=rep(c("REFRESHMENT"), 9), Subtype=rep(c("CIDER ALL", "SPIRIT", "BEER"), each=3), Alcohol_content= c(5, 5.2, 7, 5.3, 6.9, 5, 5, 6, 5), Price = c(9.99, 9.99, 8.99, 9.95, 3.49, 9.99, 12.99, 13.49, 21.99))
bcl_data1 = rbind(x, y)
write.csv(bcl_data1, "bcl_data1.csv")
}
settings_path <- getwd()
# settings_path <- "/home/user/Documents/Shiny/"
ui = shinyUI(fluidPage(
# Application title
titlePanel("Example Title"),
# Sidebar structure
sidebarLayout(
sidebarPanel(
textInput("save_file", "Save to file:", value="sample.RData"),
actionButton("save", "Save input value to file"),
p(),
p(),
uiOutput("load"),
uiOutput("file"),
uiOutput("mytype"),
selectInput("var2", "Select the SubType: ", choices = NULL)
),
# Show a plot of the generated distribution
mainPanel(
tabsetPanel(id="tab",
tabPanel(
"Plot",
plotOutput("distPlot"),
checkboxInput(inputId = "density",
label = strong("Show Adjustment Factors"),
value = FALSE),
conditionalPanel(condition = "input.density == true",
sliderInput(inputId = "bandwidth",
label = "Width adjustment: ",
min = 0.5, max = 4, value = 1, step = 0.1),
radioButtons("mycolor", "Color Adjustment: ",
choices = c(Red = "red", Black = "black", Blue = "blue"),selected = "black", inline = TRUE)
)),
tabPanel("Summary",
h3(textOutput("label")),
verbatimTextOutput("summary")
)
))
)
)
)
server = function(input, output, session) {
# render a selectInput with all RData files in the specified folder
last_save_path <- file.path(settings_path, "last_input.backup")
if(file.exists(last_save_path)){
load(last_save_path)
if(!exists("last_save_file")){
last_save_file <- NULL
}
} else {
last_save_file <- NULL
}
if(!is.null(last_save_file)){
updateTextInput(session, "save_file", "Save to file:", value=last_save_file)
}
output$load <- renderUI({
choices <- list.files(settings_path, pattern="*.RData")
selectInput("input_file", "Select input file", choices, selected = last_save_file)
})
# render a selectInput with all csv files in the specified folder so that user can choose the version
output$file <- renderUI({
choices.1 <- list.files(settings_path, pattern="*.csv")
selectInput("input_csv", "Select csv file", choices.1)
})
# Load a csv file and update input
csv_data = eventReactive(input$input_csv, {
req(input$input_csv)
read.csv(file.path(settings_path,input$input_csv),
header = TRUE,
sep = ",")
})
#Display Type - Types may differ based on file selection
output$mytype <- renderUI({
req(csv_data())
selectInput("var1", "Select a type of drink: ", choices = unique(csv_data()$Type))
})
#Display SubType - This would be dependent on Type Selection
observeEvent(input$var1, {
req(csv_data())
req(input$var1)
updateSelectInput(session, "var2", "Select the SubType: ", choices = as.character(csv_data()[csv_data()$Type==input$var1,"Subtype"]), selected = isolate(input$var2))
})
# Save input when click the button
observeEvent(input$save, {
validate(
need(input$save_file != "", message="Please enter a valid filename")
)
last_save_file <- input$save_file
save(last_save_file, file=last_save_path)
mycolor <- input$mycolor
mytype = input$var1
mysubtype = input$var2
density <- input$density
bandwidth <- input$bandwidth
save(bandwidth, density, mycolor, mytype, mysubtype,
file=file.path(settings_path, input$save_file))
})
# Load an RData file and update input
observeEvent(input$input_file, {
req(input$input_file)
load(file.path(settings_path, input$input_file))
updateSelectInput(session, "var1", choices = unique(csv_data()$Type), selected = mytype)
updateSelectInput(session, "var2", choices = mysubtype, selected = mysubtype)
updateCheckboxInput(session, "density", value = density)
updateSliderInput(session, "bandwidth", value = bandwidth)
updateRadioButtons(session, "mycolor", choices = c(Red = "red", Black = "black", Blue = "blue"), selected = input$mycolor)
})
output$distPlot <- renderPlot({
req(csv_data())
req(input$var1)
req(input$var2)
# generate plot
x = csv_data()[csv_data()$Type == input$var1 & csv_data()$Subtype == input$var2, c("Alcohol_content", "Price")]
if(nrow(x) > 0){
x <- x[order(x$Alcohol_content), ]
plot(x$Alcohol_content, x$Price, type = "l", xlab = "Alcohol content", ylab = "Price",
main = "Sample Plot",
col="red",
lwd=1.5)
if (input$density)
plot(x$Alcohol_content, x$Price, type = "p", xlab = "Alcohol content", ylab = "Price",
main = "Sample Plot",
col=input$mycolor,
lwd=input$bandwidth)
}
})
output$summary <- renderText(summary(csv_data()))
}
shinyApp(ui, server)
Related
R Shiny - uiOutput causes numericInput to deselect when user is still typing in
I'm trying to create a data collection tool on R Shiny where the user can select as many categories as apply to them and then enter values for each. I've used uiOutput to allow the user to add a new category choice after clicking an action button. For some reason, the numericInput that is created after clicking the action button will deselect after a split-second when the user is typing in a number, so it only catches one digit and you have to click it repeatedly to type in a full number. I've tried changing the numericInput to a textInput and the same thing happens, so it's something to do with how I'm generating the uiOutput in the server, does it continually refresh and is there any way to stop it? Example code given below, click on the new row button then try typing in the numericInput and you'll see. I have been stuck on this for ages and can't find any other questions similar so any help massively appreciated, thanks library(tidyverse) library(shiny) library(shinyjs) ui <- fluidPage( fluidRow(wellPanel(h3("Category and quantity input"))), wellPanel(fluidRow(column(width=4,selectInput("type0",label = h4("type"), choices= list("choice1" = 1,"choice2" = 2, "choice3"=3))), column(width=4,numericInput("quantity0", label = h4("quantity"), value = 0, min=0)), column(width=4,actionButton("New_row",label="Add new row"))), uiOutput("new_row_added") )) server <- function(input, output) { ids <<- NULL observeEvent(input$New_row,{ if (is.null(ids)){ ids <<- 1 }else{ ids <<- c(ids, max(ids)+1) } output$new_row_added <- renderUI({ tagList( lapply(1:length(ids),function(i){ check_input_type <- paste0("type", ids[i]) check_input_quantity <- paste0("quantity", ids[i]) if(is.null(input[[check_input_type]])){ # Create a div that contains 3 new sub divs div(fluidRow(column(width=4, div(selectInput(paste0("type",ids[i]),label = "", choices= list("choice1" = 1,"choice2" = 2, "choice3"=3)))), column(width=4,div(numericInput(paste0("quantity",ids[i]), label = "", value = 00, min=0)))) ) } else { # Create a div that contains 3 existing sub divs div(fluidRow(column(width=4, div(selectInput(paste0("type",ids[i]),label = "", choices= list("choice1" = 1,"choice2" = 2, "choice3"=3), selected = input[[check_input_type]]))), column(width=4,div(numericInput(paste0("quantity",ids[i]), label = "", min=0, value = input[[check_input_quantity]])))) ) } }) ) }) }) } shinyApp(ui = ui, server = server)
You need to isolate input[[check_input_type]]. By doing isolate(input[[check_input_type]]). If not, every time a new number is inserted inside that input, the ui will re render and cause the deselection. App: library(tidyverse) library(shiny) library(shinyjs) ui <- fluidPage( fluidRow(wellPanel(h3("Category and quantity input"))), wellPanel( fluidRow( column(width = 4, selectInput("type0", label = h4("type"), choices = list("choice1" = 1, "choice2" = 2, "choice3" = 3))), column(width = 4, numericInput("quantity0", label = h4("quantity"), value = 0, min = 0)), column(width = 4, actionButton("New_row", label = "Add new row")) ), uiOutput("new_row_added") ) ) server <- function(input, output) { ids <<- NULL observeEvent(input$New_row, { if (is.null(ids)) { ids <<- 1 } else { ids <<- c(ids, max(ids) + 1) } output$new_row_added <- renderUI({ tagList( lapply(1:length(ids), function(i) { check_input_type <- paste0("type", ids[i]) check_input_quantity <- paste0("quantity", ids[i]) if (is.null(isolate(input[[check_input_type]]))) { # Create a div that contains 3 new sub divs div(fluidRow( column( width = 4, div(selectInput(paste0("type", ids[i]), label = "", choices = list("choice1" = 1, "choice2" = 2, "choice3" = 3))) ), column(width = 4, div(numericInput(paste0("quantity", ids[i]), label = "", value = 00, min = 0))) )) } else { # Create a div that contains 3 existing sub divs div(fluidRow( column( width = 4, div(selectInput(paste0("type", ids[i]), label = "", choices = list("choice1" = 1, "choice2" = 2, "choice3" = 3), selected = isolate(input[[check_input_type]]))) ), column(width = 4, div(numericInput(paste0("quantity", ids[i]), label = "", min = 0, value = input[[check_input_quantity]]))) )) } }) ) }) }) } shinyApp(ui = ui, server = server)
Is there a way to track user activity on the shiny application
Below is the shiny application. Is there a way to track how the user interacts with the application, for example, from three inputs there, what all he selects Can we capture point 1 in a table To be very specific, the user selects below combinations, so I need to capture this in a table . Is this possible? if (interactive()) { # Classic Iris clustering with Shiny ui <- fluidPage( headerPanel("Iris k-means clustering"), sidebarLayout( sidebarPanel( selectInput( inputId = "xcol", label = "X Variable", choices = names(iris) ), selectInput( inputId = "ycol", label = "Y Variable", choices = names(iris), selected = names(iris)[[2]] ), numericInput( inputId = "clusters", label = "Cluster count", value = 3, min = 1, max = 9 ) ), mainPanel( plotOutput("plot1") ) ) ) server <- function(input, output, session) { # classic server logic selectedData <- reactive({ iris[, c(input$xcol, input$ycol)] }) clusters <- reactive({ kmeans(selectedData(), input$clusters) }) output$plot1 <- renderPlot({ palette(c("#E41A1C", "#377EB8", "#4DAF4A", "#984EA3", "#FF7F00", "#FFFF33", "#A65628", "#F781BF", "#999999")) par(mar = c(5.1, 4.1, 0, 1)) plot(selectedData(), col = clusters()$cluster, pch = 20, cex = 3) points(clusters()$centers, pch = 4, cex = 4, lwd = 4) }) } shinyApp(ui, server) }
Shiny selectInput doesn't react to tab selection
Here is my problem, I have a couple of tabs and I'm trying to update a map according to a choice in the selectInput() function. The select option in inputSelect() is activated and points to Los Angeles which should activate the ObserveEvent() or Observe() function but it doesn't when clicking on the Map tab for the first time. However, I realized that the setView() function doesn't update itself when clicking on the second tab even if I have the selected option set in selectInput(). I want a setView() that reacts to the selected option on the first click on the tab. The selectize option doesn't bring any difference. Here is an example of what I would like to replicate. library(shiny) library(leaflet) ui = bs4DashPage( h1('Exemple'), br(), bs4TabSetPanel(id = 'tabs', side = 'left', bs4TabPanel(tabName = 'First tab', active = TRUE, 'Here is some text'), bs4TabPanel(tabName = 'Second tab', active = FALSE, fluidRow(bs4Card(title = 'Inputs', solidHeader = TRUE, width = 2, closable = FALSE, selectInput(inputId = 'city', label = 'Select a city', choices = c('New York','Los Angeles','Seattle'), selected = 'Los Angeles', selectize = TRUE)), bs4Card(title = "Map", width = 10, leafletOutput('map')) ))) ) server <- function(input, output, session) { output$map <- renderLeaflet({ leaflet() %>% addTiles() %>% setView(lng = -95.7129,lat = 37.0902, zoom = 3) }) observeEvent(input$city, { if(input$city == 'New York'){ lon <- -74.0060 lat <- 40.7128 } else if(input$city == 'Los Angeles'){ lon <- -118.2437 lat <- 34.0522 } else{ lon <- -122.3321 lat <- 47.6062 } leafletProxy('map') %>% setView(lng = lon, lat = lat, zoom = 5) }) } shinyApp(ui, server) Thank you for your help.
R Shiny App working locally but not on shinyapps.io
I have seen that this problem has happened to other people, but their solutions have not worked for me. I have my app.R file and a .RData file with the required inputs in the same ECWA_Strategic_Planning_Tool directory. When I run: library(rsconnect) rsconnect::deployApp('C:/Users/mikialynn/Documents/Duke/Spring2017/MP/GISTool/Final/ECWA_Strategic_Planning_Tool') I get the following error on the web page that opens up: ERROR: An error has occurred. Check your logs or contact the app author for clarification. However, I cannot find anything wrong. I install all of my packages, I use relative pathways etc. I am pasting all of the code from my app below. If anyone can spot what I'm doing wrong, I would greatly appreciate it! library(shiny) library(leaflet) library(sp) library(rgdal) library(rstudioapi) # For working directory library(raster) library(RColorBrewer) library(rgeos) #Maybe use gSimplify to simplify polygon library(DT) #To make interactive DataTable library(plotly) #For pie chart library(ggplot2) # for layout # Set Working Directory setwd(dirname(rstudioapi::getActiveDocumentContext()$path)) # Load R Workspace load('Shiny.Strategies.RData') # UI variables neigh.names <- levels(merge.proj$View) neigh.default <- c("Urban7") dt.names <- c('PARCEL_ID', 'PIN', 'OWNER_NAME', 'SITE_ADDRE', 'OWNER_ADDR', 'SUM_ACRE', 'LANDUSE_DE', 'LAND_VALUE', 'TOTAL_VALU', 'SALE_PRICE', 'Pluvial_WtScore', 'Rest_WtScore', 'GI_WtScore', 'SC_WtScore', 'UNCWI_WtScore', 'Total_Score', 'View') dt.default <- c('PARCEL_ID', 'Pluvial_WtScore', 'Rest_WtScore', 'GI_WtScore', 'SC_WtScore', 'UNCWI_WtScore', 'Total_Score', 'View') # Build UI ui <- fluidPage( titlePanel("ECWA Strategic Planning Tool"), HTML('<br>'), column(2, HTML("<strong>Instructions:</strong><br/><br/>"), HTML("<p>1) Select weights for parameters and click 'Run' to initiate tool.<br/><br/> 2) Use rightside panel to adjust Table and Map Settings.<br/> <br/> 3) Use search/sort functions of Table to identify parcels. Select row to display Total Score Chart.<br/><br/> 4) Input View and Parcel ID from Table to Map settings to identify parcel in Map.<br/><br/> 5) When satisfied with weights, click 'Export Shapefile' to save shapefile of all parcels.<p/><br/>"), HTML("<strong>Calculate Parcel Scores: </strong><br/>"), helpText('The sum of the weights must equal to 1.'), sliderInput(inputId = "weightPluvial", label = "Weight for Pluvial Flooding", value = 0.20, min = 0, max = 1), sliderInput(inputId = "weightRest", label = "Weight for Restoration", value = 0.20, min = 0, max = 1), sliderInput(inputId = "weightGI", label = "Weight for Green Infrastructure", value = 0.20, min = 0, max = 1), sliderInput(inputId = "weightSC", label = "Weight for City Stormwater Controls", value = 0.20, min = 0, max = 1), sliderInput(inputId = "weightUNCWI", label = "Weight for UNCWI", value = 0.20, min = 0, max = 1), actionButton("run", "Run"), actionButton("export", "Export Shapefile")), column(8, HTML("<h3><strong>Table Summary</strong></h3>"), HTML("<br>"), dataTableOutput("table")), column(2, HTML("<p><br><br></p>"), HTML("<h4>Table Settings:</h4>"), checkboxGroupInput(inputId = 'show_vars', label = 'Select column(s) to display in Table:', choices = dt.names, selected = dt.default), HTML("<strong>Total Score Chart:</strong>"), helpText("Please select Table row to display pie chart."), plotlyOutput("pie") ), fluidRow( column(8, offset = 2, HTML("<br>"), HTML("<h3><strong>Map Display</strong></h3>"), leafletOutput("map", height = 800), HTML("<br><br>")), column(2, HTML("<p><br><br><br></p>"), HTML("<h4>Map Settings:</h4>"), checkboxGroupInput(inputId = 'show_neigh', label = 'Select View(s) to display in Map:', choices = neigh.names, selected = neigh.default), HTML("<br>"), sliderInput("range", "Select score range to display in Map:", min = 0.0, max= 10.0, value = as.numeric(c("0.0", "10.0")), step = 0.1), HTML("<br>"), HTML("<strong>Parcel Zoom:</strong>"), helpText("The View and Score Range must contain the parcel of interest to execute zoom."), numericInput('parcel','Enter Parcel ID',0) ) )) # SERVER server <- function(input, output) { defaultData <- eventReactive(input$run, { # Multiply by Weights merge.proj#data$Pluvial_WtScore <- round(merge.proj#data$Pluvial_Score*input$weightPluvial, digits = 1) merge.proj#data$Rest_WtScore <- round(merge.proj#data$Rest_Score*input$weightRest, digits = 1) merge.proj#data$GI_WtScore <- round(merge.proj#data$GI_Score*input$weightGI, digits = 1) merge.proj#data$SC_WtScore <- round(merge.proj#data$SC_Score*input$weightSC, digits = 1) merge.proj#data$UNCWI_WtScore <- round(merge.proj#data$UNCWI_Score*input$weightUNCWI, digits = 1) # Find Total Score merge.proj#data$Total_Score <- merge.proj#data$Pluvial_WtScore + merge.proj#data$Rest_WtScore + merge.proj#data$GI_WtScore + merge.proj#data$SC_WtScore + merge.proj#data$UNCWI_WtScore return(merge.proj) }) # Subset by neighborhood neighData <- reactive ({ merge.proj <- defaultData() merge.proj[merge.proj$View%in%input$show_neigh,] }) # Plot with leaflet # Palette for map colorpal <- reactive({ merge.proj <- neighData() colorNumeric(palette = "YlOrRd", domain = merge.proj$Total_Score) }) # Pop Up Option for map # popup <- paste0("<strong>Parcel ID: </strong>", # merge.proj#data$PARCEL_ID, # "<br><strong>Total Score: </strong>", # merge.proj#data$Total_Score) # Label Option for map labels <- reactive({ merge.proj <- neighData() sprintf("<strong>Parcel ID: </strong>%s<br/><strong>Total Score: </strong>%g", merge.proj$PARCEL_ID, merge.proj$Total_Score) %>% lapply(htmltools::HTML) }) # Render Default Map output$map <- renderLeaflet ({ merge.proj <- neighData() pal <- colorpal() lab <- labels() leaflet() %>% #addProviderTiles(provider='Esri.WorldImagery') %>% # setView(zoom =) %>% addTiles() %>% addPolygons( #data = merge.proj[input$show_neigh,, drop = FALSE], data=merge.proj, fillColor = ~pal(Total_Score), weight = 1, opacity = 1, color = "white", dashArray = "3", fillOpacity = 0.7, highlight = highlightOptions( weight = 3, color = "#666", dashArray = "", fillOpacity = 0.7, bringToFront = TRUE), # popup= popup) %>% label = lab, labelOptions = labelOptions( style = list("font-weight" = "normal", padding = "3px 8px"), textsize = "15px", direction = "auto")) %>% addLegend(position = "bottomleft",pal = pal, opacity = 0.7, values = merge.proj$Total_Score, title = "<strong>Total Score</strong>") }) # Build Data Table output$table <- renderDataTable({ merge.proj <- defaultData() table.dat <- merge.proj[, c('PARCEL_ID', 'PIN', 'OWNER_NAME', 'SITE_ADDRE', 'OWNER_ADDR', 'SUM_ACRE', 'LANDUSE_DE', 'LAND_VALUE', 'TOTAL_VALU', 'SALE_PRICE', 'Pluvial_WtScore', 'Rest_WtScore', 'GI_WtScore', 'SC_WtScore', 'UNCWI_WtScore', 'Total_Score', 'View')] datatable(data = table.dat#data[, input$show_vars, drop = FALSE], options = list(lengthMenu = c(5, 10, 20, 30), pageLength = 20), rownames = FALSE) }) # Plot-ly output$pie <- renderPlotly({ merge.proj <- defaultData() names <- c('Pluvial', 'Rest', 'GI', 'SC', 'UNCWI') colors <- c('rgb(128,133,133)', 'rgb(211,94,96)', 'rgb(144,103,167)', 'rgb(114,147,203)', 'rgb(171,104,87)') selectedrowindex <- input$table_rows_selected[length(input$table_rows_selected)] selectedrowindex <- as.numeric(selectedrowindex) df <- data.frame(merge.proj[selectedrowindex, c('Pluvial_WtScore', 'Rest_WtScore', 'GI_WtScore', 'SC_WtScore', 'UNCWI_WtScore')]) vector <- unname(unlist(df[1,])) if (!is.null(input$table_rows_selected)) { par(mar = c(4, 4, 1, .1)) plot_ly(labels = names, values = vector, type = 'pie', textposition = 'inside', textinfo = 'label+percent', insidetextfont = list(color = '#FFFFFF'), hoverinfo = 'text', text = ~paste('Score:', vector), marker = list(colors = colors, line = list(color = '#FFFFFF', width = 1)), #The 'pull' attribute can also be used to create space between the sectors showlegend = FALSE) %>% layout(#title = '% Total Score', xaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE), yaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE)) } else {return(NULL)} }) # Update map to parcel score slider # Subset data filteredData <- reactive({ merge.proj <- neighData() merge.proj[merge.proj#data$Total_Score >= input$range[1] & merge.proj#data$Total_Score <= input$range[2],] }) # New Palette colorpal2 <- reactive({ merge.proj <- filteredData() colorNumeric(palette = "YlOrRd", domain = merge.proj$Total_Score) }) # Pop Up Option # popup <- paste0("<strong>Parcel ID: </strong>", # merge.proj#data$PARCEL_ID, # "<br><strong>Total Score: </strong>", # merge.proj#data$Total_Score) # Label Option labels2 <- reactive({ merge.proj <- filteredData() sprintf("<strong>Parcel ID: </strong>%s<br/><strong>Total Score: </strong>%g", merge.proj$PARCEL_ID, merge.proj$Total_Score) %>% lapply(htmltools::HTML) }) #Leaflet Proxy observe({ merge.proj <- filteredData() pal2 <- colorpal2() lab2 <- labels2() leaf <- leafletProxy("map", data = filteredData()) %>% clearShapes() %>% addPolygons( fillColor = ~pal2(Total_Score), weight = 1, opacity = 1, color = "white", dashArray = "3", fillOpacity = 0.7, highlight = highlightOptions( weight = 3, color = "#666", dashArray = "", fillOpacity = 0.7, bringToFront = TRUE), # popup= popup) %>% label = lab2, labelOptions = labelOptions( style = list("font-weight" = "normal", padding = "3px 8px"), textsize = "15px", direction = "auto")) if(input$parcel>0){ sub.dat <- merge.proj[merge.proj$PARCEL_ID==input$parcel,] zx <- mean(extent(sub.dat)[1:2]) zy <- mean(extent(sub.dat)[3:4]) leaf <- leaf %>% setView(lng=zx,lat=zy,zoom=16) } leaf }) #Update Legend observe({ proxy <- leafletProxy("map", data = filteredData()) pal2 <- colorpal2() proxy %>% clearControls() proxy %>% addLegend(position = "bottomleft",pal = pal2, opacity = 0.7, values = ~Total_Score, title = "<strong>Total Score</strong>") }) # Export new shapefile #make so that user can choose name and allow overwrite observeEvent(input$export, { merge.proj <- defaultData() writeOGR(merge.proj, dsn = "Data", layer = "Strategies_Output", driver = "ESRI Shapefile") }) } shinyApp(ui = ui, server = server)
Issue resolved! My initial suspicion was correct; it had to do with the .rdata file. It also relates to shinyapp.io's servers which run on a Linux based server. From my reading, Linux only handles lowercase file paths and extensions. The reason why it worked for the .csv file is because it's pretty common to have the file extension saved in all lowercase. This was not the case for the .RData file. Using the RStudio IDE and the physical "Save Workspace" button, the default file extension is .RData (case sensitive). I couldn't rename the file extension (for some reason, I'm not the most tech-savvy person). Similar to the load() function, there's the save() function. Previously, I used the save() file as follows (note the capitalized .RData at the end): save(df_training_separated_with_models, file = "sample_data_with_models.RData") However, using the same function in all lowercase fixes the issue: save(df_training_separated_with_models, file = "sample_data_with_models.rdata") Hope this helps any other poor soul with the same issue that is scouring the internet and other forums. Cheers!
In RShiny ui, how to dynamic show several numericInput based on what you choose
My code is here: ui.R shinyUI(fluidPage( # Copy the line below to make a select box selectInput("select", label = h3("Select box"), choices = list("Choice 1" = 1, "Choice 2" = 2, "Choice 3" = 3), selected = 1), numericInput("value",label="value", value=100), hr(), fluidRow(column(3, verbatimTextOutput("value"))) )) server.R server=shinyServer(function(input, output) { output$inputs=renderUI({ if(input$select =="1"){ numericInput(inputId = paste0("value",1),"1",100) } else if(input$select=="2"){ numericInput(inputId ="value","value",100), numericInput(inputId ="value","value",200), numericInput(inputId ="value","value",300) } }) # You can access the value of the widget with input$select, e.g. output$value <- renderPrint({ input$select }) }) This is a very simple case and the ui is like: What I expect is that if I select "Choice 2", ui would give me this: So how I can achieve my expectation?
You have to render it on server side Example Show 1 ,2 and 3 input based on select library(shiny) ui=shinyUI(fluidPage( # Copy the line below to make a select box selectInput("select", label = h3("Select box"), choices = list("Choice 1" = 1, "Choice 2" = 2, "Choice 3" = 3), selected = 1), uiOutput("inputs"), hr(), fluidRow(column(3, verbatimTextOutput("value"))) )) server=shinyServer(function(input, output) { output$inputs=renderUI({ lapply(1:input$select,function(i){ numericInput(inputId = paste0("value",i),paste0("value",i),100) }) }) # You can access the value of the widget with input$select, e.g. output$value <- renderPrint({ input$select }) }) shinyApp(ui,server) There i use simple logic : if your choise 1 so one input redered, 2-- two inputs e.t.c Update Hard code example server=shinyServer(function(input, output) { output$inputs=renderUI({ if(input$select==1){ numericInput(inputId = paste0("value1"),paste0("value1"),100) }else if( input$select==2){ list( numericInput(inputId = paste0("value1"),paste0("value1"),100), numericInput(inputId = paste0("value2"),paste0("value2"),200), numericInput(inputId = paste0("value3"),paste0("value3"),500) ) }else if (input$select==3){ numericInput(inputId = paste0("value1"),paste0("value1"),100) } }) # You can access the value of the widget with input$select, e.g. output$value <- renderPrint({ input$select }) })