How to prevent R Shiny app immediately crashing when launching locally - r

My Shiny app suddenly is behaving n a strange manner whereby it opens briefly and then closes itself. There are no errors in the console. On my Mac, the app works fine. However, on Windows, the issue arises.
My complete code can be seen below.
Subsequently, Mac, or Windows, when I am using my full dataset .csv file, (as opposed to my small dummy test dataset), I receive an error input string 1 is invalid UTF-8. I have tried all suggestions here How to identify/delete non-UTF-8 characters in R but without any success. I have also used the CLEAN() function in Excel itself, and also tried read.csv("dummyData.csv, encoding = "UTF-8"), neither of which worked. I'm out of ideas.
Any help on both these issues would be fantastic.
library(shiny)
library(tidyverse)
library(DT)
# Reading the main_data which the shiny app depends on, Please make sure that the column names are same
main_data <- read_csv("dummyData.csv")
ui <- fluidPage(
fluidRow(column(12, tags$h2("Assignment Details"))),
sidebarLayout(
sidebarPanel(
width = 3,
tags$div(
align = "center",
tags$img(src = "logo.png", width = "120", height = "120")
),
fluidRow(
column(12, align = "center", tags$br(), tags$b("Filter data")),
column(12, selectInput("sector_filter", "Sector", unique(main_data$Sector), multiple = TRUE)),
column(12, selectInput("client_filter", "Client", unique(main_data$`Client Name`), multiple = TRUE)),
column(12, selectInput("service_filter", "Service", unique(main_data$Service), multiple = TRUE)),
column(12, selectInput("cost_filter", "Cost", unique(main_data$`Cost (Ex-Vat)`), multiple = TRUE)),
column(12, align = "center", actionLink("reset_filters", "Clear Filters/Reset", style = "color: #962693"))
)
),
mainPanel(
width = 9,
tabsetPanel(
tabPanel(
"Assignment Description",
uiOutput("assignment_description")
),
tabPanel(
"Data Table",
DTOutput("data_table")
)
)
)
)
)
server <- function(input, output, session) {
# Creating a new empty tibble (which is basically a data.frame) for filtering based on the filters selected
filtered_data <- tibble()
observeEvent(input$reset_filters, {
updateSelectInput(session, "sector_filter", selected = "")
updateSelectInput(session, "client_filter", selected = "")
updateSelectInput(session, "service_filter", selected = "")
updateSelectInput(session, "cost_filter", selected = "")
})
# The observe code block will be triggered everytime any reactive object from the UI is changed (In this case out filters)
observe({
# If all the inputs are empty, We will just send the whole data without the filters. Else we filter
print(input$sector_filter)
print(input$client_filter)
print(input$service_filter)
print(input$cost_filter)
print(unique(main_data$Sector))
sector_filter_values <- input$sector_filter
client_filter_values <- input$client_filter
service_filter_values <- input$service_filter
cost_filter_values <- input$cost_filter
if (is.null(input$sector_filter)) {
sector_filter_values <- unique(main_data$Sector)
}
if (is.null(input$client_filter)) {
client_filter_values <- unique(main_data$`Client Name`)
}
if (is.null(input$service_filter)) {
service_filter_values <- unique(main_data$Service)
}
if (is.null(input$cost_filter)) {
cost_filter_values <- unique(main_data$`Cost (Ex-Vat)`)
}
filtered_data <<- main_data %>%
filter(Sector %in% sector_filter_values, `Client Name` %in% client_filter_values,
Service %in% service_filter_values, `Cost (Ex-Vat)` %in% cost_filter_values)
# This is where the assignment description will be rendered
output$assignment_description <- renderUI({
filtered_data$title <- paste0(filtered_data$`Client Name`, " - ", filtered_data$`Assignment Name`)
HTML(
paste0(
"<br><span style='color: #962693'>", filtered_data$title,
"</span><br>", filtered_data$`Assignment Description`, "<br>"
)
)
})
# This is where the table is rendered. To customise the table visit here https://rstudio.github.io/DT/
output$data_table <- renderDT({
datatable(
filtered_data %>% select(`Client Name`, `Assignment Name`, `Sector`, `Service`, `Cost (Ex-Vat)`)
)
})
})
# Whenever a row from the table is selected the Assignment Description must change regardless the filters selected
observeEvent(input$data_table_rows_selected, {
print(input$data_table_rows_selected)
filtered_data_from_table <- filtered_data[input$data_table_rows_selected, ]
print(filtered_data_from_table)
output$assignment_description <- renderUI({
filtered_data_from_table$title <- paste0(filtered_data_from_table$`Client Name`, " - ", filtered_data_from_table$`Assignment Name`)
HTML(
paste0(
"<br><span style='color: #962693'>", filtered_data_from_table$title,
"</span><br>", filtered_data_from_table$`Assignment Description`, "<br>"
)
)
})
})
}
shinyApp(ui = ui, server = server)

I took a small modification of the top answer here:
How to identify/delete non-UTF-8 characters in R
Simply converting my columns via the below code fixed my issues.
df$`Column Name`<- iconv(df$`Column Name`, to = "UTF-8")

Related

How I should create a "clear" button for eliminating rows in R shiny?

I am referring to my previous post: while updating the datatable in R shiny, how to make column inputs necessary fields using "validate" and "need" in R shiny
I'm making a R shiny app in which the user can add numerous rows by clicking the "Add" button and saving the data to a .xpt file. As of now, everything is in working order.
I just stuck below:
However, in order to expand this app, I've added the button "clear" to the server function, as well as'reactiveValues', so that when users click it, all previous rows (added rows) are removed (cleared), and the app is ready to accept new rows. I can still add rows, but the clear option doesn't work and doesn't give me any errors. Is there anyone who can assist me?
code
library(shiny)
library(stringr)
library(shinydashboard)
library(tidyverse)
library(DT)
library("SASxport")
ui <- fluidPage(
fluidRow(tabsetPanel(id='tabs',
tabPanel("Tab1",
div(id = "form",
textInput("schoolId", label="SchoolId *" ),
selectInput("userId", label="UserId", choices = c("UserA", "UserB", "UserC"),selected = "UserA"),
textInput("class", label = "class"),
selectInput("result", label="result", choices = c("PASS", "FAIL" )),
#dateInput("resultdate", value = NA, label = "Date of the result / Remarks for fail"
#, format = "yyyy-mm-dd" )
),
actionButton("add", "Add"),
actionButton("clear", "Clear")
),
tabPanel("Tab2",
tabPanel("View",
conditionalPanel("input.add != 0",
DTOutput("DT2"), hr(), downloadButton('downloadData', 'Download'))
)
)
)
)
)
server <- function(input, output, session) {
store <- reactiveValues()
observeEvent(input$add,{
new_entry <- data.frame(SCHOOLID=input$schoolId, USERID=input$userId
, CLASS= input$class
, RESULT=input$result
)
# new_entry <- data.frame(SCHOOLID=input$schoolId, USERID=input$userId
# , CLASS= input$class
#, RESULT=input$result,
#RESULT_DATE = input$resultdate)
if("value" %in% names(store)){
store$value<-bind_rows(store$value, new_entry)
} else {
store$value<-new_entry
}
# If you want to reset the field values after each entry use the following two lines
for(textInputId in c("schoolId", "class")) updateTextInput(session, textInputId, value = "")
updateSelectInput(session, "userId", selected = "UserA")
updateSelectInput(session, "result", selected = "PASS")
# updateDateInput(session, "resultdate")
})
output$DT2 <- renderDT({
store$value
})
output$downloadData <- downloadHandler(
filename = paste0("mydata", ".xpt"),
content = function(file){
write.xport(store$value, file = file)
}
)
new_frame <- reactive({
store$value
})
#function allows to clear the rows
values <- reactiveValues(df_data = new_frame)
observeEvent(input$clear,{
if (!is.null(input$table1_rows_selected)) {
values$df_data <- values$df_data[-as.character(input$table1_rows_selected),]
}
})
output$Tab2 <- renderDataTable({
values$df_data
})
}
shinyApp(ui, server)
The problem here is a slight oversight in how the selected rows are obtained for deletion. Instead of getting selected rows from the DT table, one has to get them straight from the ui element which is DT2
Also, you can work directly on the DT table created in server, instead of storing a new reactive value
Here's the revised (relevant) server code :
#xxxxxxxx this not needed
#values <- reactiveValues(df_data = new_frame)
observeEvent(input$clear,{
if (!length(input$DT2_rows_selected)==0) {
#work directly on store variable
store$value<- store$value[-as.numeric(input$DT2_rows_selected),]
}
})
I've tested this and it works. Can post the whole app code if needed.

Error in [.data.frame: undefined columns selected for worldcloud in Shiny

I'm creating a simple Shiny UI that allow users to either input text or upload file to create a word cloud, the sidebar shows normal, but main panel continues to show
Error in [.data.frame: undefined columns selected'.
Avoid initial warning with default value set in textAreaInput
Key code as below:
ui <- fluidPage(
h1("Word Cloud"),
sidebarLayout(
sidebarPanel(
# Add radio buttons input
radioButtons(
inputId = "source",
label = "Word source",
choices = c(
"Use your own words" = "own",
"Upload a file" = "file"
)
),
conditionalPanel(
condition = "input.source == 'own'",
textAreaInput("text", "Enter text",value="Paste here",rows = 7)
),
conditionalPanel(
condition = "input.source == 'file'",
fileInput("file", "Select a txt file (encoding='UTF-8')")
),
colourInput("col", "Background color", value = "white"),
# Add a "draw" button to the app
actionButton(inputId = "draw", label = "Draw!")
),
mainPanel(
wordcloud2Output("cloud")
)
)
)
library(tidyverse)
library(jiebaR)
mixseg = worker()
server <- function(input, output) {
data_source <- reactive({
if (input$source == "own") {
(data <- as.data.frame(table(mixseg <= input$text)))
} else if (input$source == "file") {
f<-read_file(input$file$datapath)
if(is.null(f)){
return(NULL)
}else{
data <- as.data.frame(table(mixseg <=f))
}
}
return(data)
})
output$cloud <- renderWordcloud2({
input$draw
isolate(
wordcloud2(data_source(), backgroundColor =input$col))
})
}
There are multiple issues with your code.
wordcloud2 requires a data.frame including word and frequency count in two columns. Currently you are providing data_source() as input which is a reactive structure that returns a single character string.
You need to properly parse the textInput server-side, which means that you need to create a wordcloud2-suitable data.frame from the input provided through textAreaInput; in fact, using textAreaInput is probably not the best element to use here, as your input text is highly structured and textAreaInput is best used for unstructured text values, see ?textAreaInput. But let's continue with your textAreaInput for pedagogical purposes.
You should also include a check that ensures that the wordcloud only gets drawn if there is actually any data to use. We can do this using validate, see code below. Not including this check will result in a Warning: Error in [.data.frame: undefined columns selected.
Less of an issue but not helping your post in terms of clarity: You are not using input_file at all; ditto for colourInput.
Following is a minimal reproducible example (where I've removed the unnecessary parts)
library(shiny)
library(shinyjs)
library(wordcloud2)
ui <- fluidPage(
h1("Word Cloud"),
sidebarLayout(
sidebarPanel(
# Add radio buttons input
radioButtons(
inputId = "source",
label = "Word source",
choices = c(
"Use your own words" = "own",
"Upload a file" = "file")
),
conditionalPanel(
condition = "input.source == 'own'",
textAreaInput("text", "Enter comma-separated text", rows = 7)
),
conditionalPanel(
condition = "input.source == 'file'",
fileInput("file", "Select a file")
)
),
mainPanel(
wordcloud2Output("cloud")
)
)
)
server <- function(input, output) {
data_source <- reactive({
if (input$text != "")
as.data.frame(table(unlist(strsplit(input$text, "[, ]"))))
else
NULL
})
output$cloud <- renderWordcloud2({
validate(need(data_source(), "Awaiting data"))
wordcloud2(data_source(), backgroundColor = "white")
})
}
This produces e.g.

R Shiny: create reactiveValues object with input$ values

I would like to create a reactiveValues object in Shiny whose contents are defined the values contained in input widgets. I managed to do it, but my implementation seems to be unnecessarily clunky:
Create an empty reactiveValues object
Monitor when the value of input widgets changes with observeEvent
Assign values to the reactiveValues object using the non-reactive values from input widgets (isolate)
Here is an example:
ui <- fluidPage(
fluidRow(
column(2, radioButtons("main", label = "Main dish", choices = list("salad", "pasta"))),
column(2, radioButtons("desert", label = "Desert", choices = list("fruit", "cake"))),
column(8, actionButton("extra", "Louder!", style="background-color: #ffdb99"))
),
verbatimTextOutput("myorder")
)
server <- function(input, output, session) {
# 1. Create reactiveValues object
menuR <- reactiveValues()
# 2. Update values whenever widgets change
observeEvent(c(input$main, input$desert),
menuR[["meal"]] <- paste(c(isolate(input$main), isolate(input$desert)), collapse = " & ")
)
# 3. Perform operations on object values
observeEvent(input$extra,
menuR[["meal"]] <- paste0(toupper(menuR[["meal"]]), "!!!")
)
output$myorder <- renderText(menuR[["meal"]])
}
shinyApp(ui, server)
I would very much like to create the reactiveValues object directly like this (greatly simplifies the code above):
# Set values upon creation
menuR <- reactiveValues(meal = paste(c(input$main, input$desert), collapse = " & "))
which does not work because input$main is reactive...
I would have guessed that defining reactiveValues objects with values obtained from widgets would be a common thing to do.
Am I missing something?
Thanks for your help,
Hugo
You can do this by using reactive() instead of reactiveValues(). menuR is a reactive object that depends on the input values of main and desert. You can use it by calling menu() in your server code once it is defined. Also, this saves you from using isolate() as you can set the value of menu as a reactive object inside observeEvent().
library(shiny)
ui <- fluidPage(
fluidRow(
column(2, radioButtons("main", label = "Main dish", choices = list("salad", "pasta"))),
column(2, radioButtons("desert", label = "Desert", choices = list("fruit", "cake"))),
column(8, actionButton("extra", "Louder!", style="background-color: #ffdb99"))
),
verbatimTextOutput("myorder")
)
server <- function(input, output, session) {
menuR <- reactive({
paste(c(input$main, input$desert), collapse = " & ")
})
observeEvent(
input$extra,
menuR <- reactive({
toupper(paste(c(input$main, input$desert), collapse = " & "))
})
)
output$myorder <- renderText(menuR())
}
shinyApp(ui, server)
Edit
I misunderstood the problem earlier. You can use eventReactive() which monitors a input and changes when the user input changes. I have also added a default value for when the action button is yet to be clicked by the user.
library(shiny)
ui <- fluidPage(
fluidRow(
column(2, radioButtons("main", label = "Main dish", choices = list("salad", "pasta"))),
column(2, radioButtons("desert", label = "Desert", choices = list("fruit", "cake"))),
column(8, actionButton("extra", "Louder!", style="background-color: #ffdb99"))
),
verbatimTextOutput("myorder")
)
server <- function(input, output, session) {
# Set a 'default' value for the output
default.menuR <- reactive({
paste(c(input$main, input$desert), collapse = " & ")
})
menuR <- eventReactive(input$extra, {
toupper(paste(c(input$main, input$desert), collapse = " & "))
})
# Initial state of the button is 0, which displays 'default' value
output$myorder <- renderText({
if (input$extra == 0) {
return(default.menuR())
}
menuR()
})
}
shinyApp(ui, server)
Hope this helps!
I have taken Vishesh's suggestion and made it work. It does not look much different than my original example, and still requires repeating several lines of code.
It works by over-writing the reactive object each time one of the widgets changes.
library(shiny)
ui <- fluidPage(
fluidRow(
column(2, radioButtons("main", label = "Main dish", choices = list("salad", "pasta"))),
column(2, radioButtons("dessert", label = "dessert", choices = list("fruit", "cake"))),
column(8, actionButton("extra", "Louder!", style="background-color: #ffdb99"))
),
verbatimTextOutput("myorder")
)
server <- function(input, output, session) {
menuR <- reactive({
paste(c(input$main, input$dessert), collapse = " & ")
})
# Render text when app loads
output$myorder <- renderText(menuR())
# Update reactive object and re-render text (button 'extra')
observeEvent(
input$extra,{
temp <- toupper(paste(c(input$main, input$dessert), collapse = " & "))
menuR <<- reactive(temp)
output$myorder <- renderText(menuR())
}
)
# Update reactive object and re-render text (button 'main' or 'dessert')
observeEvent(c(input$main, input$dessert),{
menuR <- reactive(paste(c(input$main, input$dessert), collapse = " & "))
output$myorder <- renderText(menuR())
})
}
shinyApp(ui, server)

Shiny R extract data from text file inputed by user

I am working on a simple app that is supposed to ask for 1 (or more) unstructured text files, given by the user with fileInput. These files have all the same structure.
The idea is to make the cleaning/extraction on the background and give back the clean data to the user (ideally into a table).
I am fairly new using Shiny and the examples I have found basically indicate how to proceed when the file input is already in a clean and structured way.
Here is a simplified code that illustrates what I have done so far:
library(shiny)
shinyUI(fluidPage(
titlePanel(title = h2("Title", align = "left")),
sidebarLayout(position = "left",
sidebarPanel(h3("Data management window", align = "center"),
fileInput(inputId = "file_1",
label = "Select file 1")
),
mainPanel(
uiOutput(outputId = "tb")
)
)))
And here the server side:
shinyServer(function(input, output) {
input_file_1 <- reactive({
if(is.null(input$file_1)){
return("!! No data loaded !!")
}
readLines(input$file_1$datapath)
})
output$data_1 <- renderText({
fileText_1 <- paste(input_file_1(), collapse = "\n")
})
output$tb <- renderUI({
tabsetPanel(
tabPanel("Window 1",
br(),
tags$div(
tags$p("Summary infos : "),
tags$ul(
tags$li("Date calculation : ", Sys.Date()),
tags$li("Info 1: "),
tags$li("Info 2 : "),
tags$li("Info 3 : "),
br(),
verbatimTextOutput("data_1"))
))
)
})
})
At this stage I have managed to render the text of the file into the app. What I would like to do is to show in tabPanel some results obtained from the data extracted from the text file, like in the case of Sys.Date() but using values from the input file.
Do you have any ideas on how to proceed? Hope my question makes sense.
Your question is still too general, please more specific. But here is something to get you started. Using your server file and the iris dataset to make it easier, you can use the renderText() expression to extract the summary of one of your variable. And then you just add textOutput() expression in your tags$li("Info 1: ") argument.
Following a comment from OP, you could add a selectInput() that could help you pick one variable you want to summarise or extract information from. The code work as it is. Just replace iris by the file you will be loading.
ui = fluidPage(
titlePanel(title = h2("Title", align = "left")),
sidebarLayout(position = "left",
sidebarPanel(h3("Data management window", align = "center"),
fileInput(inputId = "file_1",
label = "Select file 1"),
uiOutput("Variable")
),
mainPanel(
uiOutput(outputId = "tb")
)
))
server = function(input, output) {
input_file_1 <- reactive({
if(is.null(input$file_1)){
return("!! No data loaded !!")
}
readLines(input$file_1$datapath)
})
output$data_1 <- renderText({
fileText_1 <- paste(input_file_1(), collapse = "\n")
})
output$Variable <- renderUI({
obj2 <- iris #replace by input_file_1()
selectInput("Variable", "Choose a variable", as.list(colnames(obj2)), multiple = FALSE)
})
output$summary1 <- renderPrint({
sub <- iris %>% select(input$Variable) #replace iris
a <- max(sub)
a
})
output$tb <- renderUI({
tabsetPanel(
tabPanel("Window 1",
br(),
tags$div(
tags$p("Summary infos : "),
tags$ul(
tags$li("Date calculation : ", Sys.Date()),
tags$li("Info 1: ", textOutput("summary1")),
tags$li("Info 2 : "),
tags$li("Info 3 : "),
br(),
verbatimTextOutput("data_1"))
))
)
})
}

How can I add subsetting options as required by App user in RShiny?

I am interested in allowing the App user to drill down as far in the data as he/she wants. I made a toy example using the mtcars dataset below.
runApp(
list(
ui = fluidPage(
sidebarLayout(
sidebarPanel(
selectInput("cyl", "Select cylinders:", unique(mtcars$cyl), multiple = T, selected = unique(mtcars$cyl)),
selectInput("gear", "Select gears:", unique(mtcars$gear), multiple = T, selected = unique(mtcars$gear)),
selectInput("am", "Select am:", unique(mtcars$am), multiple = T, selected = unique(mtcars$am)),
numericInput("wt", "Select wt greater than:", value=1)
, width = 2),
mainPanel(
tabsetPanel(
tabPanel(title = "Results", dataTableOutput("tAble"))
)
)
)
)
, server = function(input, output, session){
output$tAble <- renderDataTable({subset(mtcars, cyl %in% input$cyl &
gear%in%input$gear &
am%in%input$am &
wt > input$wt)})
}
)
)
This App will show the part of the data frame that meets all criteria.
My issue here is that I have to write out all my potential subsetting criteria up front. What if my data has 200 potential variables on which to subset?
What I would like to be able to do is to have a method to add subsetting boxes as required without creating selectInputs/etc up front.
For example, when the app starts up, show all data, then have an option to adding subsetting options by clicking on a button?
To render the UI elements you need to create a tagList() of UI elements in the server, and then render them in the UI.
Then you need to be able to subset your data based on the dynamically created UI elements. Here I'm evaluating a text string, based on the names of the UI elements, to do the subsetting
library(shiny)
runApp(
list(
ui = fluidPage(
sidebarLayout(
sidebarPanel(
uiOutput("myChoices"),
numericInput("wt", "Select wt greater than:", value=1)
, width = 2),
mainPanel(
tabsetPanel(
tabPanel(title = "Results", dataTableOutput("tAble"))
)
)
)
)
, server = function(input, output, session){
myCols <- names(mtcars)[1:3]
mySelectInputs <- tagList()
for(i in myCols){
mySelectInputs[[i]] <- selectInput(i, label = i, choices = unique(mtcars[, i]),
selected = unique(mtcars[, i]), multiple = T)
}
output$myChoices <- renderUI({
mySelectInputs
})
output$tAble <- renderDataTable({
lst <- sapply(myCols, function(x){
vals <- input[[x]]
substitute(x %in% i, list(i = vals, x = x))
})
txt <- gsub("\"", "", paste0(lst, collapse = " & "))
print(txt)
subset(mtcars, eval(expr = parse(text = txt) ) )
})
}
)
)

Resources