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)
Related
In the shiny app below I upload a dataset,so its a reactive dataset, and then I get a selectInput() with its column names. Then I should be able to select a column and change it with the textInput() after hitting the actionButton().
library(shiny)
library(shinydashboard)
library(DT)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
fileInput("file1", "Choose CSV File",
accept = c(
"text/csv",
"text/comma-separated-values,text/plain",
".csv")
),
uiOutput("column"),
textInput("text", label = "Set column name", placeholder = "Enter text..."),
actionButton("sub","submit")
),
dashboardBody(
dataTableOutput("process")
)
)
server <- function(input, output) {
raw<-reactive({
inFile <- input$file1
if (is.null(inFile))
return(NULL)
read.csv(inFile$datapath, header = T)
})
output$column<-renderUI({
selectInput("col","Pick a column to change its name",
choices = colnames(raw()))
})
mydf <- reactiveValues(df = raw(), names = names(raw()))
observeEvent(input$sub, {
req(input$text)
mydf$names[mydf$names == input$col] <- input$text
names(mydf$df) <- mydf$names
updateSelectInput(inputId = "col", choices = mydf$names)
})
output$process<-renderDataTable({
mydf$df
})
}
shinyApp(ui, server)
I took your line:
mydf <- reactiveValues(df = raw(), names = names(raw()))
And replaced it with:
mydf <- reactiveValues(df = NULL, names = NULL)
observeEvent(raw(), {
if(!is.null(raw())) {
mydf$df <- raw()
mydf$names <- names(raw())
}
})
And for me it functions as how I think you wanted it. The primary issue is it would crash for me upon start. As you wrote it, it tries to access raw() immediately and put it in the reactiveValues. Thus, by making the reactiveValues NULL by default, and then only adding it in when raw() exists, it seems to work perfectly.
Here is one possible approach. Maybe there are better options. Just replace iris with your input data. It should work.
A general advice is to avoid function names as object names for reactive objects, such as raw() which is a function, but also the name of a reactive in your example. It makes things more difficult to debug and it will throw error messages which don't make sense, if you forget that raw() is also a function.
library(shiny)
library(shinydashboard)
library(DT)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
# fileInput("file1", "Choose CSV File",
# accept = c(
# "text/csv",
# "text/comma-separated-values,text/plain",
# ".csv")
# ),
uiOutput("column"),
textInput("text", label = "Set column name", placeholder = "Enter text..."),
actionButton("sub","submit")
),
dashboardBody(
dataTableOutput("process")
)
)
server <- function(input, output) {
mydf <- reactiveValues(names = NULL)
raw_df <- reactive({
mydat <- iris # here goes the input file
iris_nms <- mydf$names
if(!is.null(iris_nms)) {
names(mydat) <- iris_nms
}
mydat
})
output$column <- renderUI({
selectInput("col","Pick a column to change its name",
choices = colnames(raw_df()))
})
observeEvent(input$sub, {
req(input$text)
org_names <- names(raw_df())
org_names[org_names == input$col] <- input$text
mydf$names <- org_names
})
output$process<-renderDataTable({
raw_df()
})
}
shinyApp(ui, server)
With the outputs I can upload a spreadsheet and use the filename as a reference for some functions in my application. However, I can't "transport" this name to the "checkboxGroupInput" function (where it says "Sheet_Name"). How could I make the sheet name auto-fill in the field after upload? Thanks.
library(shiny)
library(shinydashboard)
library(shinyWidgets)
library(readxl)
library(tidyverse)
library(readxl)
library(stringr)
ui <- fluidPage(
br(),
fileInput("archive", "Upload file", accept = c(
".xlsx")),
textOutput("my_archive"),
# Itens Selection
checkboxGroupInput("additem", "Select Items", names(BancoEA))
)
server <- function(input, output) {
# Upload Data Sheet
csv <- reactive({
inFile <- input$archive
if (is.null(inFile))
return(NULL)
df<- read.xlsx(inFile$datapath, header=T)
return(df)
})
# Remove Extension Name
output$my_archive <- renderText({
# Test if file is selected
if (!is.null(input$x$datapath)) {
return(sub(".xlsx$", "", basename(input$archive$name)))
} else {
return(NULL)
}
})
}
# App
shinyApp(ui, server)
As #arashHaratian pointed out, you can use updateChecGroupInput() inside an observer to update the choices based on the uploaded file.
library(shiny)
library(shinydashboard)
library(shinyWidgets)
library(readxl)
library(tidyverse)
library(readxl)
library(stringr)
ui <- fluidPage(
br(),
fileInput("archive", "Upload file", accept = c(
".xlsx")),
#textOutput("my_archive"),
# Itens Selection
checkboxGroupInput("additem", "Select Items", choices = NULL)
)
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)))
})
# output$my_archive <- renderText({
# reactive_my_path()
# })
observe({
input$archive
#update the choices in input$additem
updateCheckboxGroupButtons(session,
"additem",
paste('Column names in:', reactive_my_path()),
choices = names(csv()))
})
}
# App
shinyApp(ui, server)
Another solution would be to directly render the input with renderUI inside the server and uiOutput inside the ui.
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)
I have two multiple CSV files and I am comparing 2 each using a package called
Daff(https://github.com/edwindj/daff). Now I do want to select CSV from two dropdowns on the shiny app. The CSV is stored in the data folder
I have tried this code but I get an error
No file in directory
Error in file: cannot open the connection
UI.R
library("shiny")
library(daff)
library(dplyr)
ui <- fluidPage(
fluidPage(
titlePanel("Automated Data Dictionary Comparison"),
sidebarLayout(
sidebarPanel(
selectInput(inputId = 'csv1',
label = 'Choose First Data Dictionary:',
choices = list.files(path = "./data",
full.names = FALSE,
recursive = FALSE)),
selectInput(inputId = 'csv2',
label = 'Choose Second Data Dictionary:',
choices = list.files(path = "./data",
full.names = FALSE,
recursive = FALSE))
),
mainPanel(
dataTableOutput('contents')
)
)
)
)
server.R
library(shiny)
library(dplyr)
library(daff)
server <- function(input, output) {
# Parse first file
dataset1 <- reactive({
infile <- input$csv1
if (is.null(infile)){
return(NULL)
}
x <- read.csv(infile[[1]])
x
})
# Parse second file
dataset2 <- reactive({
infile <- input$csv2
if (is.null(infile)){
return(NULL)
}
x <- read.csv(infile[[1]])
x
})
# Create comparison table (reactive as both of its elements are reactive)
diff <- reactive({
x <- render_diff(diff_data(data_ref=dataset1(), data=dataset2()))
x
})
#Output
output$contents <- renderDataTable({
diff()
})
}
Expected result is html output of differences between the old and current csv
Please change your two cases of read.csv code to the below:
x <- read.csv(paste0("./data/", infile[[1]]))
Update
Full solution:
ui
library("shiny")
library(daff)
library(dplyr)
ui <- fluidPage(
fluidPage(
titlePanel("Automated Data Dictionary Comparison"),
sidebarLayout(
sidebarPanel(
selectInput(inputId = 'csv1',
label = 'Choose First Data Dictionary:',
choices = list.files(path = "./data",
full.names = FALSE,
recursive = FALSE)),
selectInput(inputId = 'csv2',
label = 'Choose Second Data Dictionary:',
choices = list.files(path = "./data",
full.names = FALSE,
recursive = FALSE))
),
mainPanel(
uiOutput('contents')
)
)
)
)
server
library(shiny)
library(dplyr)
library(daff)
server <- function(input, output) {
# Parse first file
dataset1 <- reactive({
infile <- input$csv1
if (is.null(infile)){
return(NULL)
}
x <- read.csv(paste0("./data/", infile[[1]]))
x
})
# Parse second file
dataset2 <- reactive({
infile <- input$csv2
if (is.null(infile)){
return(NULL)
}
x <- read.csv(paste0("./data/", infile[[1]]))
x
})
# Create comparison table (reactive as both of its elements are reactive)
diff <- reactive({
x <- render_diff(diff_data(data_ref=dataset1(), data=dataset2()))
x
})
#Output
output$contents <- renderUI({
HTML(diff())
})
}
Run App
shinyApp(ui, server)
I have reactive data react$data, and I have two inputs input$chosencolumn, input$chosenrows
With the reactive dataset, how would I be able to specify rows I want like a data.frame where you do data[data$chosencolumn == chosenrows,]
Reproducible example:
server.R
### Start of Shiny server
shinyServer(function(input, output, session) {
reactdata <- reactiveValues()
observe({
if(is.null(input$fileinput)){return(NULL)}
else{reactdata$inputdata <- read.xlsx(input$fileinput$datapath, header=T, sheetIndex = 1)}
})
output$selectsamples <- renderUI({
if(is.null(input$fileinput)){return(NULL)}
selectInput("selectsamples",
label = h5("Samples"), choices = colnames(reactdata$inputdata),
selected="Sample")
})
output$sampleselected <- renderUI({
if(is.null(input$fileinput)){return(NULL)}
selectInput("sampleselected",
label = h5("sampleselected"), choices = unique(as.character(reactdata$inputdata[,input$selectsamples])),
selected="B")
})
output$selectdilutions <- renderUI({
if(is.null(input$fileinput)){return(NULL)}
selectInput("selectdilutions",
label=h5("Select Dilutions"),
choices = colnames(reactdata$inputdata),
selected="Dilution")
})
reactdata1 <- reactiveValues()
observe({
reactdata1$datatable1 <- datatable(reactdata$inputdata,
rownames = TRUE,
options = list(pageLength = 100, dom = 'tip'))
})
output$datatable1 <- renderDataTable({
reactdata1$datatable1
})
})
ui.R
require(shiny)
require(devtools)
require(grDevices)
require(xlsx)
require(DT)
shinyUI(fluidPage(
navbarPage("",inverse = FALSE,
tabPanel("Analyse")),
titlePanel(""),
fluidRow(
column(3,
wellPanel(
fileInput("fileinput", label = h5("Input file")),
uiOutput("selectsamples"),
uiOutput("sampleselected"),
uiOutput("selectdilutions")
)),
column(9,
fluidRow(
wellPanel(
uiOutput("sample1"),
dataTableOutput("datatable1"))
)))
)
)
I would like to change reactdata1$datatable1 so that it only includes rows of data chosen by the sample selected (i.e. the value that input$sampleselected is chosen as).
So, something like reactdata1$datatable1[input$selectsamples == input$sampleselected,]
An example dataset is here:
Dropbox link to excel file
Here's a general example where you subset a reactive data.frame based on dynamically entered user input:
require(shiny)
ui <- shinyUI(fluidPage(
sidebarLayout(
sidebarPanel(
selectInput("dataset", "Choose a dataset:",
choices = c("rock", "pressure", "cars","DNase","iris")
),
selectizeInput(
'colName', 'Select Column: ', list(), multiple = TRUE
),
selectizeInput(
'rowName', 'Select Rows', list(), multiple = TRUE
)
),
mainPanel(
tableOutput('tbl')
)
) #end sidebar layout
))
server <- shinyServer(function(input, output, session) {
datasetInput <- reactive({
switch(input$dataset,
"rock" = rock,
"pressure" = pressure,
"cars" = cars,
"DNase"=DNase,
"iris"=iris)
})
# Update UI
observe({
updateSelectizeInput(session, "colName", choices = colnames( datasetInput() ))
updateSelectizeInput(session, "rowName", choices = rownames( datasetInput() ))
})
# Create reactive data by subseting the reactive dataset
r1 <- reactive({
v <- input$colName %in% colnames(datasetInput())
if( sum(v == FALSE) > 0) return() # Check for missmatching datasetInput names and column names
if(is.null(input$colName) || is.null(input$rowName)) return() # None selected, return empty
# Subset data
datasetInput()[as.numeric(input$rowName), input$colName, drop=FALSE]
})
output$tbl <- renderTable({
r1()
})
})
shinyApp(ui, server)