R Shiny - uiOutput causes numericInput to deselect when user is still typing in - shiny

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)

Related

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)
}

Save and Load user selections based on file selection - RShiny

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)

plotlyOutput shows previous plot before refresh in Shiny Apps

I have created a small Shiny Application using Plotly heatmap and intend to use withSpinner to plot Heat Map depending on user input. Currently i have two issues.
a.) WithSpinner appears only for the first time when heat map is generated. It doesn't appear if the User input is changed and replotting is done.
b.) On change of User input, the previous heatmap is shown instead of spinner and it refreshes after sometime. I intend to use spinner instead of showing old plot during redrawing of heatmap.
library(shiny)
library(shinydashboard)
library(shinycssloaders)
library(shinyjs)
library(plotly)
ui <- shinydashboard::dashboardPage(
# Dashboard header
shinydashboard::dashboardHeader(),
# Dashboard sidebar
shinydashboard::dashboardSidebar(disable = TRUE),
# Dashboard body
shinydashboard::dashboardBody(
id = "myBody",
# Tab items
shinydashboard::tabItem(tabName = "visual",
fluidRow(
shinydashboard::tabBox(id="tabBix1",
shiny::tabPanel(
"Parameters & Settings",
value = "paramsetting",
sliderInput("obs", "Number of observations:",
min = 0, max = 1000, value = 500
)),
shiny::tabPanel(
"PlotOutput",
value = "Ops",
withSpinner(plotly::plotlyOutput("plotNewExp"))
)
)
))
)
)
server <- function(input, output, session) {
p <- NULL
observeEvent(input$obs,{
p <- NULL
m <- matrix(rnorm(input$obs), nrow = 3, ncol = 3)
output$plotNewExp <- plotly::renderPlotly({
p <- plot_ly(
x = c("a", "b", "c"), y = c("d", "e", "f"),
z = m, type = "heatmap"
)
})
})
}
shinyApp(ui=ui,server=server)
If you try this you will see that the spinner is working but it is fast. So you probably don't have the time to see it when you switch from one tab to the other.
ui <- shinydashboard::dashboardPage(
# Dashboard header
shinydashboard::dashboardHeader(),
# Dashboard sidebar
shinydashboard::dashboardSidebar(disable = TRUE),
# Dashboard body
shinydashboard::dashboardBody(
id = "myBody",
# Tab items
shinydashboard::tabItem(tabName = "visual",
fluidRow(
shinydashboard::tabBox(
tabPanel(
"Parameters & Settings",
value = "paramsetting",
sliderInput("obs", "Number of observations:",
min = 0, max = 1000, value = 500
),
withSpinner(plotly::plotlyOutput("plotNewExp")))
# tabPanel(
# "PlotOutput",
# withSpinner(plotly::plotlyOutput("plotNewExp"))
# )
)
))
)
)
server <- function(input, output, session) {
# p <- NULL
# observeEvent(input$obs,{
# p <- NULL
m <- reactive({matrix(rnorm(input$obs), nrow = 3, ncol = 3)})
output$plotNewExp <- renderPlotly({
p <- plot_ly(
x = c("a", "b", "c"), y = c("d", "e", "f"),
z = m(), type = "heatmap"
)
# })
})
}
shinyApp(ui=ui,server=server)
or if you add a delay, you will see it is working.
library(shinyjs)
ui <- shinydashboard::dashboardPage(
# Dashboard header
shinydashboard::dashboardHeader(),
# Dashboard sidebar
shinydashboard::dashboardSidebar(disable = TRUE),
# Dashboard body
shinydashboard::dashboardBody(
useShinyjs(),
id = "myBody",
# Tab items
shinydashboard::tabItem(tabName = "visual",
fluidRow(
shinydashboard::tabBox(id="tabBix1",
shiny::tabPanel(
"Parameters & Settings",
value = "paramsetting",
sliderInput("obs", "Number of observations:",
min = 0, max = 1000, value = 500
)),
shiny::tabPanel(
"PlotOutput",
value = "Ops",
withSpinner(plotly::plotlyOutput("plotNewExp"))
)
)
))
)
)
server <- function(input, output, session) {
# p <- NULL
Graph <- function() {
p <- NULL
m <- matrix(rnorm(input$obs), nrow = 3, ncol = 3)
output$plotNewExp <- plotly::renderPlotly({
p <- plot_ly(
x = c("a", "b", "c"), y = c("d", "e", "f"),
z = m, type = "heatmap"
)
})
}
observeEvent(input$obs,{
delay(4000, Graph())
})
}
shinyApp(ui=ui,server=server)

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 })
})