Shiny Selectinput for every non-numeric column of a Filteinput data - r

I would like to create a Shiny dashboard where:
1) The user selects an excel file
2) A Selectinput option is created for every non-numeric column of the obtained dataframe is created that gives users the option to select every unique value in this column. This is how my code looks so far:
library(shiny)
library(dplyr)
library(openxlsx)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
fileInput('datafile', 'Choose xlsx file',
accept = c(".xlsx")),
lapply(names("varselect"), function(i) {
selectInput(paste0(i), paste0(i),
choices = "varselect"[i],
multiple = TRUE,
selected = "")})),
mainPanel()))
server <- function(input, output,session) {
Data <- reactive({
infile <- input$datafile
if (is.null(infile)) {
return(data.frame())
}
read.xlsx(infile$datapath,
sheetIndex = 1) %>% select_if(colSums(!is.na(.)) > 0%>% select_if(~!is.numeric(.x)) %>% head())
})
output$varselect <- renderUI({
})
observe({
lapply(names(Data()), function(i) {
selectInput(paste0(i), paste0(i),
choices = Data()[i],
multiple = TRUE,
selected = "")})})
}
shinyApp(ui = ui, server = server)
I am aware of the fact that the code is not working and that there are some grave mistakes, but I hope that somebody can help me to find an approach that does work for this problem. I am rather new to Shinny and that is why i honestly have no clue how to solve this problem.
Many thanks.

In your ui, you can include a uiOutput which will contain all of the dynamically created selectInput widgets.
Then, in output$varselect you can create the selectInput based on the number of columns in Data().
library(shiny)
library(dplyr)
library(openxlsx)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
fileInput('datafile', 'Choose xlsx file',
accept = c(".xlsx")),
uiOutput("varselect")
),
mainPanel()
)
)
server <- function(input, output, session) {
Data <- reactive({
infile <- input$datafile
if (is.null(infile)) {
return(data.frame())
}
read.xlsx(infile$datapath, sheet = 1) %>%
select_if(colSums(!is.na(.)) > 0) %>%
select_if(~!is.numeric(.x)) %>%
head()
})
output$varselect <- renderUI({
if (ncol(Data() > 0)) {
lapply(1:ncol(Data()), function(i) {
selectInput(inputId = paste0("si_", i),
label = paste0("Input #", i),
choices = Data()[,i],
multiple = TRUE)
})
}
})
}
shinyApp(ui = ui, server = server)

Related

R/Shiny - Transfer checkbox labels to function field

I need the selected checkbox labels to fill in the "[,c("checkbox1","checkbox2")]" field (where both "checkbox1" and "checkbox2" are written). Thank you.
This is my code.
library(shiny)
library(shinydashboard)
library(shinyWidgets)
library(readxl)
library(tidyverse)
library(readxl)
library(stringr)
ui <- fluidPage(
br(),
fileInput("archive", "Upload file", accept = c(
".xlsx")),
# Itens Selection
checkboxGroupInput("additem", "Select Items", choices = NULL)
)
box(
width = 2000,
verbatimTextOutput("calfa")
)
server <- function(input, output, session) {
# Upload Data Sheet
csv <- reactive({
req(input$archive)
inFile <- input$archive
df <- read_xlsx(inFile$datapath)
return(df)
})
#reactive value that will hold the name of the file
reactive_my_path <- reactive({
# Test if file is selected
req(input$archive)
return(sub(".xlsx$", "", basename(input$archive$name)))
})
observe({
input$archive
# update the choices in input$additem
updateCheckboxGroupButtons(session,
"additem",
paste('Column names in:', reactive_my_path()),
choices = names(csv()))
})
# Alpha
output$calfa <-
renderPrint({
int<-csv()[,c("checkbox1","checkbox2")]
int <- na.omit(int)
psych::alpha(int, check.keys = TRUE)
})
}
# App
shinyApp(ui, server)
You can use input$additem to include all the checkbox that are selected. Also I have included another condition to run the psych::alpha code only when there is more than one column.
library(shiny)
library(shinydashboard)
library(shinyWidgets)
library(readxl)
library(tidyverse)
library(readxl)
library(stringr)
ui <- fluidPage(
br(),
fileInput("archive", "Upload file", accept = c(
".xlsx")),
# Itens Selection
checkboxGroupInput("additem", "Select Items", choices = NULL),
box(
width = 2000,
verbatimTextOutput("calfa")
)
)
server <- function(input, output, session) {
# Upload Data Sheet
csv <- reactive({
req(input$archive)
inFile <- input$archive
df <- read_xlsx(inFile$datapath)
return(df)
})
#reactive value that will hold the name of the file
reactive_my_path <- reactive({
# Test if file is selected
req(input$archive)
return(sub(".xlsx$", "", basename(input$archive$name)))
})
observe({
input$archive
# update the choices in input$additem
updateCheckboxGroupButtons(session,
"additem",
paste('Column names in:', reactive_my_path()),
choices = names(csv()))
})
# Alpha
output$calfa <-
renderPrint({
req(length(input$additem) > 1)
int<-csv()[,input$additem]
int <- na.omit(int)
psych::alpha(int, check.keys = TRUE)
})
}
# App
shinyApp(ui, server)

How to update the choices in a Shiny selectInput after loading a file? [duplicate]

I have a Shiny app that includes a number of dropdown selection boxes, the values of which are filled from reading an RDS file. The app also includes a fileInput function to upload new data. How can I change the values in the dropdown boxes to reflect the new data? Currently I can see that the data is uploaded, but the old data remains in the dropdown.
The data that should be uploaded is saved to a file using
saveRDS( data.frame(names=c("Jill","Jane","Megan")),"myDataFrame.rds")
In my app.R file, I first define the 'default' value of the data:
myDataFrame <- data.frame(names=c("Tom","Dick","Harry"))
The content of my app.R is as follows:
library(shiny)
ui <- shinyUI(
fluidPage(
fileInput('file1', 'Choose file to upload',accept = ".rds"),
selectInput("myNames","Names",myDataFrame$names),
tableOutput('contents')
)
)
server <- shinyServer(function(input, output) {
output$contents <- renderTable({
inFile <- input$file1
if (is.null(inFile)) { return(myDataFrame) }
readRDS(inFile$datapath)
})
})
The initial view of the application is as expected: both the dropdown and the table contain the 'default' names. Upon upload of my RDS file containing a new dataframe, the table changes (which is what I was looking for) but the dropdown values do not. How can I make the latter happen?
I added reactive object myData that you have to use for table contents, but more importantly to update choices in selectInput (check observe and updateSelectInput part).
library(shiny)
ui <- shinyUI(
fluidPage(
fileInput("file1", "Choose file to upload", accept = ".rds"),
selectInput("myNames","Names", ""),
tableOutput("contents")
)
)
server <- function(input, output, session) {
myData <- reactive({
inFile <- input$file1
if (is.null(inFile)) {
d <- myDataFrame
} else {
d <- readRDS(inFile$datapath)
}
d
})
output$contents <- renderTable({
myData()
})
observe({
updateSelectInput(session, "myNames",
label = "myNames",
choices = myData()$names,
selected = myData()$names[1])
})
}
shinyApp(ui, server)
to riff off of #PoGibas' answer, I needed to load multiple list values for an app, here is a similar application using reactiveValues and observeEvent :
library(shiny)
# save a dummy RDS for loading
saveRDS(list(names=LETTERS,numbers=seq(10)),'dummy.rds')
# define initial values
myDataList <- list(names=c("Tom","Dick","Harry"), numbers=seq(5))
ui <- shinyUI(
fluidPage(
fileInput("file1", "Choose file to upload", accept = ".rds"),
selectInput("myNames","Names", ""),
selectInput("myNumbers","Numbers", ""),
tableOutput("contents")
)
)
server <- function(input, output, session) {
md <- reactiveValues(
names = myDataList$names,
numbers = myDataList$numbers
)
observeEvent(input$file1,{
d <- readRDS(input$file1$datapath)
for (n in names(d)){
md[[n]] <- d[[n]]
}
})
output$contents <- renderTable({
data.frame(data = c(md$names,md$numbers))
})
observe({
updateSelectInput(session, "myNames",
label = "myNames",
choices = md$names,
selected = md$names[1])
updateSelectInput(session, "myNumbers",
label = "myNumbers",
choices = md$numbers,
selected = md$numbers[1])
})
}
shinyApp(ui, server)

Gives Error:object of type 'closure' is not subsettable after using reactive function [duplicate]

I have a Shiny app that includes a number of dropdown selection boxes, the values of which are filled from reading an RDS file. The app also includes a fileInput function to upload new data. How can I change the values in the dropdown boxes to reflect the new data? Currently I can see that the data is uploaded, but the old data remains in the dropdown.
The data that should be uploaded is saved to a file using
saveRDS( data.frame(names=c("Jill","Jane","Megan")),"myDataFrame.rds")
In my app.R file, I first define the 'default' value of the data:
myDataFrame <- data.frame(names=c("Tom","Dick","Harry"))
The content of my app.R is as follows:
library(shiny)
ui <- shinyUI(
fluidPage(
fileInput('file1', 'Choose file to upload',accept = ".rds"),
selectInput("myNames","Names",myDataFrame$names),
tableOutput('contents')
)
)
server <- shinyServer(function(input, output) {
output$contents <- renderTable({
inFile <- input$file1
if (is.null(inFile)) { return(myDataFrame) }
readRDS(inFile$datapath)
})
})
The initial view of the application is as expected: both the dropdown and the table contain the 'default' names. Upon upload of my RDS file containing a new dataframe, the table changes (which is what I was looking for) but the dropdown values do not. How can I make the latter happen?
I added reactive object myData that you have to use for table contents, but more importantly to update choices in selectInput (check observe and updateSelectInput part).
library(shiny)
ui <- shinyUI(
fluidPage(
fileInput("file1", "Choose file to upload", accept = ".rds"),
selectInput("myNames","Names", ""),
tableOutput("contents")
)
)
server <- function(input, output, session) {
myData <- reactive({
inFile <- input$file1
if (is.null(inFile)) {
d <- myDataFrame
} else {
d <- readRDS(inFile$datapath)
}
d
})
output$contents <- renderTable({
myData()
})
observe({
updateSelectInput(session, "myNames",
label = "myNames",
choices = myData()$names,
selected = myData()$names[1])
})
}
shinyApp(ui, server)
to riff off of #PoGibas' answer, I needed to load multiple list values for an app, here is a similar application using reactiveValues and observeEvent :
library(shiny)
# save a dummy RDS for loading
saveRDS(list(names=LETTERS,numbers=seq(10)),'dummy.rds')
# define initial values
myDataList <- list(names=c("Tom","Dick","Harry"), numbers=seq(5))
ui <- shinyUI(
fluidPage(
fileInput("file1", "Choose file to upload", accept = ".rds"),
selectInput("myNames","Names", ""),
selectInput("myNumbers","Numbers", ""),
tableOutput("contents")
)
)
server <- function(input, output, session) {
md <- reactiveValues(
names = myDataList$names,
numbers = myDataList$numbers
)
observeEvent(input$file1,{
d <- readRDS(input$file1$datapath)
for (n in names(d)){
md[[n]] <- d[[n]]
}
})
output$contents <- renderTable({
data.frame(data = c(md$names,md$numbers))
})
observe({
updateSelectInput(session, "myNames",
label = "myNames",
choices = md$names,
selected = md$names[1])
updateSelectInput(session, "myNumbers",
label = "myNumbers",
choices = md$numbers,
selected = md$numbers[1])
})
}
shinyApp(ui, server)

Warning in summary(as.numeric(paste(input$to, "input$to"))) : NAs introduced by coercion in Shiny with R

I am very new to Shiny web app with R. I want to generate summary according to choice from checkboxGroupInput which i generated dynamically when browsing the CSV file. My problem is that when i want to convert from String to numeric that time it prints NA.
I am uploading my two files which are ui.r and server.r. I am trying since two days. If anyone help me then it will be very beneficial for me.
If i did anything wrong in my code then please suggest me right way.
ui.r
library(shiny)
library(shinythemes)
shinyUI(fluidPage(
theme = shinytheme("cyborg"),
themeSelector(),
# Application title
titlePanel("Data Analytics and Visualization Dashboard"),
sidebarLayout(
sidebarPanel(
fileInput('datafile', 'Choose CSV file',accept=c('text/csv', 'text/comma-
separated-values,text/plain')),
h5("Max file size to upload is 5 MB."),
radioButtons("sep", "Seperator", choices = c(Comma = ',', semicolon = ';',
tab = "\t", space = " " )),
#checkboxInput("header", "Header?")
br(),
h4("Select columns from CSV"),
uiOutput("toCol"),
br(),
h4("Summary"),
textOutput("sum")
# tableOutput("disp")
),
mainPanel(
numericInput("obs", "Enter the number of rows to display:", 5),
tableOutput("input_file"),
plotOutput("p")
)
)
))
server.r
library(shiny)
shinyServer(function(input, output,session) {
#This function is repsonsible for reading a csv file
output$input_file <- renderTable({
file_to_read = input$datafile
if(is.null(file_to_read))
{
return()
}
read.csv(file_to_read$datapath, sep = input$sep, nrows = input$obs))
})
#This function is repsonsible for loading in the selected file
filedata <- reactive({
infile <- input$datafile
if (is.null(infile)) {
# User has not uploaded a file yet
return(NULL)
}
read.csv(infile$datapath,nrows = input$obs)
})
#The following set of functions populate the column selectors
output$toCol <- renderUI({
df <-filedata()
if (is.null(df)) return(NULL)
items=names(df)
names(items)=items
checkboxGroupInput("to", "Columns",items)
})
observe({
# db <- gsub(",","",input$to)
# print(db)
# paste( intToUtf8(160), input$to, intToUtf8(160))
# print(summary(as.numeric(as.character( paste( " ", input$to, "
#"))))) })
print(summary(as.numeric( input$to) ))})
# output$sum <- renderPrint({
# summary(input$data.frame[,as.numeric(input$var)])
# })
# output$disp <- renderTable({
# input$to
# })
# output$summary1 <- renderPrint({
# sum <- as.numeric(as.character(input$to))
# summary(sum)
#})
})
This could be a starting point, although I dont recommend using this for a productive app, as the login-process is not really safe nor encrypted. It is based solely on text-data.
But you will have to put the ui in the server and render the page depending on the login status. So there are 2 renderUI but just 1 server-function. I dont know if you can have 2 different server-functions and redirect them. I think it all has to be in 1 server-function.
library(shiny)
username = "joe"
password = "joe123"
ui <- fluidPage(
uiOutput("ui")
)
server <- function(input, output, session) {
LOGGED <- reactiveValues(user = FALSE)
observeEvent(input$action, {
if ((input$name == username ) & (input$pass == password)) {
LOGGED$user = TRUE
} else {
LOGGED$user = FALSE
}
})
observe({
if (LOGGED$user == FALSE) {
output$ui <- renderUI({
tagList(
p(HTML("User is joe <br> and password is joe123")),
textInput("name", "Enter your username"),
passwordInput("pass", "Enter your password"),
actionButton("action", label = "Action")
)
})
} else if (LOGGED$user == TRUE) {
output$ui <- renderUI({
tagList(
h1("You are logged in.")
)
})
}
})
}
shinyApp(ui, server)
Like #Codeer said, there is no line in your code like this one summary(as.numeric(paste(input$to, “input$to”))). I edited your code, so all the uncommented lines dont appear, as its not necessary to show them.
In your example, your loading the csv file twice, which you can definitly avoid.
I moved the csv-loading into the reactive only. Then you can access the loaded file everywhere in your shiny-app. And i think in your print(summary()) statement, you're missing the data, as your only printing out the summary of the input$tovariable, which is only text and if you convert it to numeric you create NA-values.
So i rearranged your code a bit, and I think its behaving the way you intend it to.
library(shiny)
library(shinythemes)
ui <- {shinyUI(fluidPage(
theme = shinytheme("cyborg"),
themeSelector(),
titlePanel("Data Analytics and Visualization Dashboard"),
sidebarLayout(
sidebarPanel(
fileInput('datafile', 'Choose CSV file',accept=c('text/csv', 'text/comma-
separated-values,text/plain')),
h5("Max file size to upload is 5 MB."),
radioButtons("sep", "Seperator", choices = c(Comma = ',', semicolon = ';',
tab = "\t", space = " " )),
br(),
h4("Select columns from CSV"),
uiOutput("toCol"),
br(),
h4("Summary"),
textOutput("sum")
),
mainPanel(
numericInput("obs", "Enter the number of rows to display:", 5),
tableOutput("input_file"),
verbatimTextOutput("summary"),
plotOutput("p")
)
)
))}
server <- shinyServer(function(input, output,session) {
#This function is repsonsible for loading and reading a csv file
filedata <- reactive({
req(input$datafile)
infile <- input$datafile
if (is.null(infile)) {
# User has not uploaded a file yet
return(NULL)
}
read.csv(infile$datapath,nrows = input$obs, sep = input$sep)
})
output$input_file <- renderTable({
filedata()
})
#The following set of functions populate the column selectors
output$toCol <- renderUI({
df <- filedata()
if (is.null(df)) return(NULL)
items=names(df)
names(items)=items
checkboxGroupInput("to", "Columns",items)
})
output$summary <- renderPrint({
req(input$to)
data <- filedata()
print(summary(data[,input$to]))
})
})
shinyApp(ui, server)
The csv file is loaded in the reactive (filedata). In the renderTable, you just enter the reactive variable - filedata(). And in the observe, you call again the reactive variable and only print out the summary of the data in the clicked column (input$to).

Update Shiny's 'selectInput' dropdown with new values after uploading new data using fileInput

I have a Shiny app that includes a number of dropdown selection boxes, the values of which are filled from reading an RDS file. The app also includes a fileInput function to upload new data. How can I change the values in the dropdown boxes to reflect the new data? Currently I can see that the data is uploaded, but the old data remains in the dropdown.
The data that should be uploaded is saved to a file using
saveRDS( data.frame(names=c("Jill","Jane","Megan")),"myDataFrame.rds")
In my app.R file, I first define the 'default' value of the data:
myDataFrame <- data.frame(names=c("Tom","Dick","Harry"))
The content of my app.R is as follows:
library(shiny)
ui <- shinyUI(
fluidPage(
fileInput('file1', 'Choose file to upload',accept = ".rds"),
selectInput("myNames","Names",myDataFrame$names),
tableOutput('contents')
)
)
server <- shinyServer(function(input, output) {
output$contents <- renderTable({
inFile <- input$file1
if (is.null(inFile)) { return(myDataFrame) }
readRDS(inFile$datapath)
})
})
The initial view of the application is as expected: both the dropdown and the table contain the 'default' names. Upon upload of my RDS file containing a new dataframe, the table changes (which is what I was looking for) but the dropdown values do not. How can I make the latter happen?
I added reactive object myData that you have to use for table contents, but more importantly to update choices in selectInput (check observe and updateSelectInput part).
library(shiny)
ui <- shinyUI(
fluidPage(
fileInput("file1", "Choose file to upload", accept = ".rds"),
selectInput("myNames","Names", ""),
tableOutput("contents")
)
)
server <- function(input, output, session) {
myData <- reactive({
inFile <- input$file1
if (is.null(inFile)) {
d <- myDataFrame
} else {
d <- readRDS(inFile$datapath)
}
d
})
output$contents <- renderTable({
myData()
})
observe({
updateSelectInput(session, "myNames",
label = "myNames",
choices = myData()$names,
selected = myData()$names[1])
})
}
shinyApp(ui, server)
to riff off of #PoGibas' answer, I needed to load multiple list values for an app, here is a similar application using reactiveValues and observeEvent :
library(shiny)
# save a dummy RDS for loading
saveRDS(list(names=LETTERS,numbers=seq(10)),'dummy.rds')
# define initial values
myDataList <- list(names=c("Tom","Dick","Harry"), numbers=seq(5))
ui <- shinyUI(
fluidPage(
fileInput("file1", "Choose file to upload", accept = ".rds"),
selectInput("myNames","Names", ""),
selectInput("myNumbers","Numbers", ""),
tableOutput("contents")
)
)
server <- function(input, output, session) {
md <- reactiveValues(
names = myDataList$names,
numbers = myDataList$numbers
)
observeEvent(input$file1,{
d <- readRDS(input$file1$datapath)
for (n in names(d)){
md[[n]] <- d[[n]]
}
})
output$contents <- renderTable({
data.frame(data = c(md$names,md$numbers))
})
observe({
updateSelectInput(session, "myNames",
label = "myNames",
choices = md$names,
selected = md$names[1])
updateSelectInput(session, "myNumbers",
label = "myNumbers",
choices = md$numbers,
selected = md$numbers[1])
})
}
shinyApp(ui, server)

Resources