Undefined columns selected in sidebarpanel in Rshiny - r

Question

I am quite new in Shiny, so forgive me for asking a so basic question.
I am trying to develop a basic data analysis app, in order to deal with big databases. I have already been able of importing the DDBB and to visualize it as a table. However, when trying to perform a summary statistics about the variables, I have the error of: "Undefinded columns selected" and I cannot see anything. If I do not add any code in the server, I can see the output (boxplot, histogram and summary) in the app, but I cannot see variable names (only 1,2,3...). I show my code below.
I will really appreciate any help to solve this issue. Thank you very much.
shinyUI(fluidPage(
main_page <- tabPanel(
title = "Statistics",
titlePanel("Statistical Analysis"),
sidebarLayout(
sidebarPanel(
# Añado el archivo que quiero cargar
fileInput('DDBB', 'Choose file to upload',
accept = c(
'text/csv',
'text/comma-separated-values',
'.csv'
)),
#checkboxInput('header', 'Header', TRUE),
#tags$hr(),
selectInput('Variable', 'Select a variable', "",
choice=c((1:33)), multiple = FALSE,
selectize = TRUE
),
sliderInput("bins",
"Number of bins:",
min = 1,
max = 200,
value = 30)
),
mainPanel(
tabsetPanel(
tabPanel(
title = "Data Visualization",
DT::dataTableOutput("sample_table")
),
tabPanel(
title = "Summary Statistics",
verbatimTextOutput("sum"),
fluidRow(splitLayout(cellWidths = c("50%", "50%"),
plotOutput("box"),
plotOutput('hist'))
)
)
)
)
)
)
))
# Define server logic required to draw a histogram
shinyServer(function(input, output, session) {
# Output a file input (cargar archivo).
df_products_upload <- reactive({
inFile <- input$DDBB
print(inFile)
if (is.null(inFile))
return(NULL)
df <- read.csv(inFile$datapath, header = TRUE,sep = ';')
# updateSelectInput(session, "Variable", choices = names(df))
return(df)
})
output$sample_table<- DT::renderDataTable({
df <- df_products_upload()
DT::datatable(df,
filter = 'top') %>%
formatRound(columns= c(1:ncol(df)), digits = 2)
})
observeEvent(df_products_upload(), {
updateSelectInput(session, "Variable", choices = colnames(df_products_upload()))
})
output$sum <- renderPrint({
updateSelectInput(session, "Variable", choices = colnames(df)
summary(df[,as.numeric(input$Variable)])
})
output$box <- renderPlot({
updateSelectInput(session, "Variable", choices = colnames(df_products_upload))
x<-summary(df[,as.numeric(input$Variable)])
boxplot(x,col="sky blue",border="purple",main=names(df[as.numeric(input$Variable)]))
})
output$hist <- renderPlot({
updateSelectInput(session, "Variable", choices = colnames(df_products_upload))
# generate bins based on input$bins from ui.R
x<-df[,as.numeric(input$Variable)]
bins <- seq(min(x), max(x), length.out = input$bins + 1)
# draw the histogram with the specified number of bins
hist(x,
main=names(df[as.numeric(input$Variable)]) ,
breaks = bins, col = 'darkgray', border = 'black',
xlab = 'samples')
})
})

Answer 1

Welcome to Stack-Overflow, Enrique :) I added a line to save iris dataset as ';'-separated csv and used that as uploadable data example. I must say, your code had multiple errors, both shiny and also a bit basic base R data.frame manipulation. I have corrected them and added comments. All beginnings are hard. I would suggest you to go back and do some more shiny exercises and tutorials. I think you will advance faster that way.
Especially revisit reactive expressions:
https://shiny.rstudio.com/tutorial/written-tutorial/lesson6/
It matters if you pass as parameter the value of a reactive sum(my_reactive_numbers()) or the reactive it self sum(my_reactive_numbers).
Also check out scope rules for shiny reactive contexts. Basically like functions, what is defined within one reactive context, is not automatically exposed to others, hence the df issues. If you would want to (probably not) make a variable global, here is a deeper intro into that:
https://shiny.rstudio.com/articles/scoping.html
library(DT)
write.table(iris,file = "./sample_upload_data_set.csv",sep = ";") #; because assmed in code
ui <- shinyUI(fluidPage(
main_page <- tabPanel(
title = "Statistics",
titlePanel("Statistical Analysis"),
sidebarLayout(
sidebarPanel(
# Añado el archivo que quiero cargar
fileInput('DDBB', 'Choose file to upload',
accept = c(
'text/csv',
'text/comma-separated-values',
'.csv'
)),
#checkboxInput('header', 'Header', TRUE),
#tags$hr(),
selectInput('Variable', 'Select a variable', NULL,
choices = NULL, #edits start with NULL as no data set yet
multiple = FALSE,
selectize = TRUE
),
sliderInput("bins",
"Number of bins:",
min = 1,
max = 200,
value = 30)
),
mainPanel(
tabsetPanel(
tabPanel(
title = "Data Visualization",
DT::dataTableOutput("sample_table")
),
tabPanel(
title = "Summary Statistics",
verbatimTextOutput("sum"),
fluidRow(splitLayout(cellWidths = c("50%", "50%"),
plotOutput("box"),
plotOutput('hist'))
)
)
)
)
)
)
))
# Define server logic required to draw a histogram
server <- function(input, output, session) {
#expose an uplaoded csv file as a reactive data.frame
df_products_upload <- reactive({ #todo consider a shorter name e.g. r_prod_up.df
inFile <- input$DDBB #
print(inFile)
#if (!is.null(inFile))
# return(NULL) do not use return in any shiny reactive context, it is not a function
#req is practical replacement of if '(is.null(inFile)) return(NULL)'-pattern
req(inFile$datapath) #must be not null, non_empty character, or reactive will not complete
df <- read.csv(inFile$datapath, header = TRUE,sep = ';')
# updateSelectInput(session, "Variable", choices = names(df))
#return(df) ## EDIT do not use return
df
})
#let data.frame column names be choices of an input
observe({ #edit observeEvent was redundant, just use observe here
df <- df_products_upload()
#the following code expects numeric columns
the_numeric_columns <- colnames(df)[sapply(df,is.numeric)]
updateSelectInput(session, "Variable", choices = the_numeric_columns)
})
#render the data.frme with data.table
output$sample_table <- DT::renderDataTable({
df <- df_products_upload()
DT::datatable(df, filter = 'top') %>%
#formatRound will mask non numeric columns
formatRound(
columns = which(sapply(df,is.numeric)), #only format numeric columns
digits = 2
)
})
# but this render makes absolutely no sense, you should
output$sum <- renderPrint({
#edit it is bad behavior to do side effects in render scopes
# updateSelectInput(session, "Variable", choices = colnames(df_products_upload()) #edit df was not assign in scope
# summary(df[,as.numeric(input$Variable)])
# })
}) # edit missing bracket
output$box <- renderPlot({
#browser()
#edit bad behaviour, maybe you missunderstood the update functionSelectInput
#updateSelectInput(session, "Variable", choices = colnames(df_products_upload())) #edit reactive must be read not passed directly to colnames
#edit df is not assigened in this scope
df <- df_products_upload()
#x<-summary(df[,as.numeric(input$Variable)]) #edit this is no bueno, what if varaible names were ... names
# edit since plucking only one column and dropping data.frame wrap
# you may just use [[]] brackets to make it more explicit to the reader
x<-df[[input$Variable]] #this can only return the vector of one column or NULL
x<-summary(x)
boxplot(
x,
col="sky blue",
border="purple",
#comma was missing here, and why not just use Varaible
main = input$Variable
)
})
output$hist <- renderPlot({
#browser()
#edit df is not assigened in this scope
df <- df_products_upload()
#update makes no sense here
#updateSelectInput(session, "Variable", choices = colnames(df)) #edit if introducing df anyways just use that
# generate bins based on input$bins from ui.R
# edit since plucking only one column and dropping data.frame wrap
# you may just use [[]] brackets to make it more explicit to the reader
x<-df[[input$Variable]] #this can only return the vector of one column or NULL
bins <- seq(min(x), max(x), length.out = input$bins + 1)
# draw the histogram with the specified number of bins
hist(x,
#main=names(df[as.numeric(input$Variable)]) , # you're assuming columns would be named by numbers...
#...and it is quite like crossing the river to get water,
main = input$Varible,
breaks = bins, col = 'darkgray', border = 'black',
xlab = 'samples'
)
})
}
shiny::shinyApp(ui = ui, server = server)