Compare Two CSV files using Rshiny dropdown - r

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)

Related

Shiny: Use filtered datatable in further functions

How do you use the filtered output from datatables in further functions?
I am making a Shiny app where the data is uploaded and filtered by the user with a datatable. I then want to use the filtered data to perform some functions. I give one below (calcs()). I am getting the Error: invalid 'x' type in 'x && y'.
The .csv file is:
Day: 1,2,3
Subject: 1,2,3
Location: 1,1,2
ui.R
shinyUI(fluidPage(theme = shinytheme("spacelab"),
# title and subtitles
titlePanel(
h1(HTML("</b>Test App</b>"),
style="text-align:center")),
sidebarLayout(
sidebarPanel(
fileInput("file1", "Choose Input .csv File",
multiple = TRUE,
accept = c("text/csv",
"text/comma-separated-values,text/plain",
".csv")
),
downloadButton("downloadData",
"Download Results (.xlsx)")
),
mainPanel(title = "Raw Data",
DT::dataTableOutput("table"),
)
)
))
server.R
shinyServer <- function(input, output, session) {
datasetInput <- reactive({
if(is.null(input$file1)) return(NULL)
csv_data <- read.csv(input$file1$datapath)
})
output$table = DT::renderDataTable(datasetInput(),
filter = "top",
server = "FALSE")
calcs <- reactive({
remove_pos_baseline <- as.data.frame(input$table_rows_all) %>%
group_by(Location) %>%
mutate(count = first(Subject))
})
data_list <- reactive({
list(
table = calcs(),
patient_results = datasetInput()
)
})
output$downloadData <- downloadHandler(
filename = function() {
paste("Output", datasetInput()$Location[1], "-", Sys.Date(), ".xlsx", sep="")
},
content = function(file) {
write_xlsx(data_list(), path = file)
}
)
}

How to Only Show Five Rows of Data in Shiny App

I have this Shiny App, and so far it works great but the data when it is uploaded does not look as nice as I would have hoped. How do I limit it so each page only has 5 rows, and how can I get rid of the clear background of the table (right now it alternates between white and no background for the rows)
Thank you!
library(shiny)
library(dplyr) # alternatively, this also loads %>%
library(shinyWidgets)
regex_to_apply <- "\\bMASTER DATA\\b|\\bSOURCE LIST\\b|\\bVALIDITY DATES\\b|\\bMRP CONTROLLER\\b|\\bPSV\\b|\\bELIGIBILITY\\b|\\bCOST\\b|\\bMARKETING EXCLUSION\\b|\\bEFFECTIVITY\\b|\\bMISSING\\b|\bbBLANK\\b"
ui <- fluidPage(
# use a gradient in background, setting background color to blue
setBackgroundColor(
#https://rdrr.io/cran/shinyWidgets/man/setBackgroundColor.html used this website for help on background color
color = c("#F7FBFF", "#2171B5"),
gradient = "radial",
direction = c("top", "left")
),
sidebarLayout(
sidebarPanel(
fileInput("file1", "Choose CSV File",
accept = c(
"text/csv",
"text/comma-separated-values,text/plain",
".csv")
),
tags$hr(),
checkboxInput("header", "Header", TRUE),
# Button
downloadButton("downloadData", "Download"),
actionButton('apply_regex', 'Apply Regex')
),
mainPanel(
dataTableOutput("contents")
)
)
)
server <- function(input, output) {
rv <- reactiveValues()
observe({
req(input$file1)
# input$file1 will be NULL initially. After the user selects
# and uploads a file, it will be a data frame with 'name',
# 'size', 'type', and 'datapath' columns. The 'datapath'
# column will contain the local filenames where the data can
# be found.
inFile <- input$file1
if (is.null(inFile))
return(NULL)
rv$data <- read.csv(inFile$datapath, header = input$header, encoding = "UTF-8")
})
output$contents <- renderDataTable({
rv$data
})
output$downloadData <- downloadHandler(
filename = function() {
paste("myfile",Sys.Date(), ".csv", sep = "")
},
content = function(file) {
write.csv(rv$data, file, row.names = FALSE)
}
)
observeEvent(input$apply_regex, {
rv$data <- rv$data %>%
mutate(close_notes = close_notes %>% as.character() %>% toupper()) %>%
filter(grepl(regex_to_apply, close_notes))
})
}
shinyApp(ui, server)
How do I limit it so each page only has 5 rows. Set 'options' argument of renderDataTable. Here is a reproducible example:
library(shiny)
library(DT)
ui <- fluidPage(
br(),
DT::dataTableOutput(outputId = "t1")
)
server <- function(input, output, session) {
output$t1 <- DT::renderDataTable(iris, options = list(pageLength = 5))
}
shinyApp(ui, server)

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)

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

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)

Resize Html table to fit screen RSHINY

How can I resize the HTML table to fit the screen of the computer? This is how my shiny app looks currently, I have tried using fluid row columns but it not giving me the right result. I guess I am missing something here.
Here is my shiny server and ui
UI.R
library("shiny")
library(daff)
library(dplyr)
library(shinythemes)
setwd("PATH")
ui <- fluidPage(theme = shinytheme("cerulean"),
fluidPage(
titlePanel("Automated Data Dictionary Comparison"),
sidebarLayout(
sidebarPanel(
selectInput(inputId = 'Dic1',
label = 'Choose First Data Dictionary:',
choices = list.files(path = "./data",
full.names = FALSE,
recursive = FALSE)),
selectInput(inputId = 'Dic2',
label = 'Choose Second Data Dictionary:',
choices = list.files(path = "./data",
full.names = FALSE,
recursive = FALSE))
),
mainPanel(
uiOutput('contents'))
)
)
)
Html table is in the output section.
SERVER.R
library(shiny)
library(dplyr)
library(daff)
library(shinythemes)
setwd("PATH")
server <- function(input, output) {
# Parse first file
dataset1 <- reactive({
infile <- input$Dic1
if (is.null(infile)){
return(NULL)
}
x <- read.csv(paste0("./data/", infile[[1]]))
x
})
# Parse second file
dataset2 <- reactive({
infile <- input$Dic2
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()),use.DataTables=TRUE)
x
})
#Output
output$contents <- renderUI({
HTML(diff())
})
}
The expected result is my table to be fully seen on screen not extended that I have to scroll to see whole of it outside screen
Try use this
mainPanel(
HTML("<div style ='overflow:auto; ' >"),
uiOutput('contents'),
HTML("</div>")
)
or try set the height or set the width with css
mainPanel(
HTML("<div style ='overflow:auto; height:500px ' >"),
uiOutput('contents'),
HTML("</div>")
)

Resources