Want to write an app to dynamically compare diffrent versions of xlsx-files using shiny and comparedf packages.
There was a problem with output of the comparison results in html format.
How to fix it? It is possible to output html with htmlTable package?
library(shiny)
library(compareDF)
library(htmlTable)
ui <- navbarPage("Compare_app",
tabPanel("Compare relults",
sidebarLayout(
sidebarPanel(
fileInput(inputId = "old_file",
label = "Chose old file",
accept = c(".xlsx")),
fileInput(inputId = "new_file",
label = "Chose new file",
accept = c(".xlsx")),
selectInput(inputId = "group_cols",
label = "Group by:",
choices = "",
selected = NULL,
multiple = TRUE)
),
mainPanel(
mainPanel(
htmlOutput(outputId = "compare_html")
)
)
)
)
)
server <- function(input, output, session) {
old_file <- reactive({
old_file_tmp <- read_excel(req(input$old_file$datapath), col_names = TRUE)
})
new_file <- reactive({
old_file_tmp <- read_excel(req(input$new_file$datapath), col_names = TRUE)
})
observeEvent(old_file(), {
updateSelectInput(session, "group_cols", choices = names(old_file()))
})
output$compare_html <- renderUI({
vec <- unlist(strsplit(input$group_cols, ","))
compare_result_tmp <- compareDF::compare_df(df_new = new_file(), df_old = old_file(), group_col = vec)
compare_html <- compare_result_tmp$html_output
})
)
# Run the application
shinyApp(ui = ui, server = server)
This can be trivially implemented by using the native shiny command -
compare_html <- shiny::HTML(compare_result_tmp$html_output)
This should give output in the expected format
Related
I am trying to create a Shiny app to allow the user to upload a file and select a method. I would like the output to be returned/changed only when both the file is uploaded/changed and the method is selected/changed. In other words, I want the app to be silent when only one of the input variables is changed. Below I attached a demo code that will change the output when a file is modified/uploaded. I tried req(file, method), but it does not work after the file is uploaded (e.g., upload/update another file). Any suggestions will be appreciated.
Code to create two CSV files for the shiny app demonstration.
df <- data.frame(obs = 1:11)
df2 <- data.frame(obs = 10:20)
write.csv(df, file = "uploaddf.csv", row.names = F)
write.csv(df2, file = "uploaddf2.csv", row.names = F)
Shiny app demo
library(shiny)
ui <- fluidPage(
fluidRow(
column(5, fileInput(inputId = 'file',
label = 'Upload file',
multiple = FALSE)),
column(5, selectInput(inputId = 'method',
label = 'Select method',
list(`Method` = list("Method1", "Method2"))))
),
br(),
textOutput("printoutput")
)
server <- function(input, output, session) {
file <- reactive({
req(input$file)
filestr <- input$file
file <- read.csv(filestr$datapath, header = T)
return(file)
})
method <- reactive({
req(input$method)
method <- input$method
return(method)
})
observeEvent(file(), {
op <- paste0(sum(file()), method())
output$printoutput <- renderText({ op })
})
}
shinyApp(ui, server)
I'd suggest using bindEvent along with an actionButton to wait for the user input:
df <- data.frame(obs = 1:11)
df2 <- data.frame(obs = 10:20)
write.csv(df, file = "uploaddf.csv", row.names = F)
write.csv(df2, file = "uploaddf2.csv", row.names = F)
library(shiny)
ui <- fluidPage(
fluidRow(
column(5, fileInput(inputId = 'file',
label = 'Upload file',
multiple = FALSE)),
column(5, selectInput(inputId = 'method',
label = 'Select method',
list(`Method` = list("Method1", "Method2"))))
),
fluidRow(
column(5, actionButton(inputId = 'run', label = 'Render output', icon = icon("arrows-rotate")))
),
br(),
textOutput("printoutput")
)
server <- function(input, output, session) {
file <- reactive({
req(input$file)
filestr <- input$file
read.csv(filestr$datapath, header = T)
})
output$printoutput <- renderText({paste0(sum(file()), req(input$method))}) |> bindEvent(input$run)
}
shinyApp(ui, server)
PS: please try to avoid wrapping renderXXX functions in observers - they already are reactive.
As the title describes, I'm simply trying to create a shiny application that allows the user to generate linear regression plots based on an imported csv file. After importing the file the dropdown for the variables of interest should be dynamically updated.
As the code below shows, I'm able to accomplish that with mtcars but I'm not able to do the same with an imported files that would have different dependent and independent variables .
Thank you for your help
data(mtcars)
cols <- sort(unique(names(mtcars)[names(mtcars) != 'mpg']))
ui <- fluidPage(
titlePanel("Build a Linear Model for MPG"),
sidebarPanel(
#fluidRow(
#column(4,
#tags$h3('Build a Linear Model for MPG'),
fileInput(
inputId = "filedata",
label = "Upload data. csv",
accept = c(".csv")
),
fileInput(
inputId = "filedata1",
label = "Upload data. csv",
accept = c(".csv")
),
selectInput('vars',
'Select dependent variables',
choices = cols,
selected = cols[1:2],
multiple = TRUE)
#)
), #sidebarpanel
mainPanel( column(4, verbatimTextOutput('lmSummary')),
column(4, plotOutput('diagnosticPlot')))
) #fluidpage
server <- function(input, output) {
data <- reactive({
req(input$filedata)
read.csv(input$filedata$datapath) %>% rename_all(tolower) %>%
filter(driver_name == input$driver_name & county == input$county & model == input$model)
})
lmModel <- reactive({lm(sprintf('mpg ~ %s', paste(input$vars, collapse = '+')),
data = mtcars)})
# lmModel <- reactive({lm(sprintf('mpg ~ %s', paste(input$vars, collapse = '+')),
# data = mtcars)})
output$lmSummary <- renderPrint({
summary(lmModel())
})
output$diagnosticPlot <- renderPlot({
par(mfrow = c(2,2))
plot(lmModel())
})
}
shinyApp(ui = ui, server = server)```
To dynamically select x and y axis variables, you can try the following
ui <- fluidPage(
titlePanel("Build a Linear Model"),
sidebarPanel(
fileInput(
inputId = "filedata",
label = "Upload data. csv",
multiple = FALSE,
accept = c(".csv"),
buttonLabel = "Choosing ...",
placeholder = "No files selected yet"
),
uiOutput("xvariable"),
uiOutput("yvariable")
), #sidebarpanel
mainPanel( #DTOutput("tb1"),
fluidRow(column(6, verbatimTextOutput('lmSummary')) , column(6, plotOutput('diagnosticPlot')))
)
) #fluidpage
server <- function(input, output) {
data <- reactive({
req(input$filedata)
inData <- input$filedata
if (is.null(inData)){ return(NULL) }
mydata <- read.csv(inData$datapath, header = TRUE, sep=",")
})
output$tb1 <- renderDT(data())
output$xvariable <- renderUI({
req(data())
xa<-colnames(data())
pickerInput(inputId = 'xvar',
label = 'Select x-axis variable',
choices = c(xa[1:length(xa)]), selected=xa[1],
options = list(`style` = "btn-info"))
})
output$yvariable <- renderUI({
req(data())
ya<-colnames(data())
pickerInput(inputId = 'yvar',
label = 'Select y-axis variable',
choices = c(ya[1:length(ya)]), selected=ya[2],
options = list(`style` = "btn-info"))
})
lmModel <- reactive({
req(data(),input$xvar,input$yvar)
x <- as.numeric(data()[[as.name(input$xvar)]])
y <- as.numeric(data()[[as.name(input$yvar)]])
if (length(x) == length(y)){
model <- lm(x ~ y, data = data(), na.action=na.exclude)
}else model <- NULL
return(model)
})
output$lmSummary <- renderPrint({
req(lmModel())
summary(lmModel())
})
output$diagnosticPlot <- renderPlot({
req(lmModel())
par(mfrow = c(2,2))
plot(lmModel())
})
}
shinyApp(ui = ui, server = server)
Addressing the dynamic menu:
Your selectInput element must be placed in the server section for it to be reactive. Things in the ui section are basically static. Use a uiOutput in the ui section and renderUI in the server section.
ui section (in place of selectInput block): uiOutput("var_select_ui")
server section (add):
output$var_select_ui <- renderUI({
cols <- colnames(data())
selectInput(
'vars',
'Select dependent variables',
choices = cols,
selected = cols[1:2],
multiple = TRUE
)
})
I'm not able to modify the script below to make it work with multiple independent variables. It only works when a single independent variable is selected. I've added "multiple = TRUE" in the script to allow the selection of multiple variable at the same time. But that doesn't really affect the plots and stats generated. Any suggestion of how this can be resolved?
Any csv file with numeric and non numeric data would work to test the script. Saving the iris or mtcars r datasets as csv files would work to test the script.
Thank you for your help.
library(shiny)
library(DT)
library(shinyWidgets)
ui <- fluidPage(
titlePanel("Build a Linear Model"),
sidebarPanel(
fileInput(
inputId = "filedata",
label = "Upload data. csv",
multiple = FALSE,
accept = c(".csv"),
buttonLabel = "Choosing ...",
placeholder = "No files selected yet"
),
uiOutput("xvariable"),
uiOutput("yvariable")
), #sidebarpanel
mainPanel( #DTOutput("tb1"),
fluidRow(column(6, verbatimTextOutput('lmSummary')) , column(6, plotOutput('diagnosticPlot')))
)
) #fluidpage
server <- function(input, output) {
data <- reactive({
req(input$filedata)
inData <- input$filedata
if (is.null(inData)){ return(NULL) }
mydata <- read.csv(inData$datapath, header = TRUE, sep=",")
})
output$tb1 <- renderDT(data())
output$xvariable <- renderUI({
req(data())
xa<-colnames(data())
pickerInput(inputId = 'xvar',
label = 'Select x-axis variable',
choices = c(xa[1:length(xa)]), selected=xa[1],
options = list(`style` = "btn-info"))
})
output$yvariable <- renderUI({
req(data())
ya<-colnames(data())
pickerInput(inputId = 'yvar',
label = 'Select y-axis variable',
choices = c(ya[1:length(ya)]), selected=ya[2],
options = list(`style` = "btn-info"),
multiple = TRUE)
})
lmModel <- reactive({
req(data(),input$xvar,input$yvar)
x <- as.numeric(data()[[as.name(input$xvar)]])
y <- as.numeric(data()[[as.name(input$yvar)]])
if (length(x) == length(y)){
model <- lm(x ~ y, data = data(), na.action=na.exclude)
}else model <- NULL
return(model)
})
output$lmSummary <- renderPrint({
req(lmModel())
summary(lmModel())
})
output$diagnosticPlot <- renderPlot({
req(lmModel())
par(mfrow = c(2,2))
plot(lmModel())
})
}
shinyApp(ui = ui, server = server)
You have 2 issues in your code:
the naming convention is wrong; y is usually the dependent variable and x the independent
by extracting the selected columns as vectors out of the data.frame, you loose the nice features of the non-standard evaluation of R, especially for the names of your model. I think this is also the problem that it doesn't work with multiple independent variables
Instead of extracting the data, I use the selected variables to define the formula that can be used in the lm call:
library(shiny)
library(DT)
library(shinyWidgets)
ui <- fluidPage(
titlePanel("Build a Linear Model"),
sidebarPanel(
fileInput(
inputId = "filedata",
label = "Upload data. csv",
multiple = FALSE,
accept = c(".csv"),
buttonLabel = "Choosing ...",
placeholder = "No files selected yet"
),
uiOutput("xvariable"),
uiOutput("yvariable")
), #sidebarpanel
mainPanel( #DTOutput("tb1"),
fluidRow(column(6, verbatimTextOutput('lmSummary')) , column(6, plotOutput('diagnosticPlot')))
)
) #fluidpage
server <- function(input, output) {
data <- reactive({
req(input$filedata)
inData <- input$filedata
if (is.null(inData)){ return(NULL) }
mydata <- read.csv(inData$datapath, header = TRUE, sep=",")
})
output$tb1 <- renderDT(data())
output$xvariable <- renderUI({
req(data())
xa<-colnames(data())
pickerInput(inputId = 'xvar',
label = 'Select x-axis variable',
choices = c(xa[1:length(xa)]), selected=xa[2],
options = list(`style` = "btn-info"),
multiple = TRUE)
})
output$yvariable <- renderUI({
req(data())
ya<-colnames(data())
pickerInput(inputId = 'yvar',
label = 'Select y-axis variable',
choices = c(ya[1:length(ya)]), selected=ya[1],
options = list(`style` = "btn-info"),
multiple = FALSE)
})
lmModel <- reactive({
req(data(),input$xvar,input$yvar)
x <- as.numeric(data()[[as.name(input$xvar)]])
y <- as.numeric(data()[[as.name(input$yvar)]])
current_formula <- paste0(input$yvar, " ~ ", paste0(input$xvar, collapse = " + "))
current_formula <- as.formula(current_formula)
model <- lm(current_formula, data = data(), na.action=na.exclude)
return(model)
})
output$lmSummary <- renderPrint({
req(lmModel())
summary(lmModel())
})
output$diagnosticPlot <- renderPlot({
req(lmModel())
par(mfrow = c(2,2))
plot(lmModel())
})
}
shinyApp(ui = ui, server = server)
I am new to R and R shiny, and have been working on putting together a statistics application that will allow the user to import files, and then run different statistics programs on the data. The fileData function had been working fine for me until recently, and now whenever I attempt to upload a file, nothing opens. I have tried everything I can think of to get it to run, but it appears the file won't attach to the function. Any help will be very much appreciated!
library(shiny)
library(shinyFiles)
library(dplyr)
library(shinythemes)
ui <- fluidPage(theme = shinytheme("cosmo"),
# Application title
titlePanel("Stats"),
# Sidebar
sidebarLayout(
sidebarPanel(
tabsetPanel(type = "tab",
tabPanel("SCI",
fileInput("file1", "Insert File", multiple = TRUE, accept = c("text/csv", "text/comma-separated-values, text/plain", ".csv")),
selectInput("statChoice", "Choose Stats", c("None" = "None", "ANOVA 0 w/in 1 btw" = "A1btw", "ANOVA 0 w/in 2 btw" = "A2btw")),
conditionalPanel("statChoice == 'A1btw'",
uiOutput("ind1"),
uiOutput("dep1")),
conditionalPanel("statChoice == 'A2btw'",
uiOutput("ind1"),
uiOutput("ind2"),
uiOutput("dep1")),
)
)
),
# Show a plot of the generated distribution
mainPanel(
tabsetPanel(type = "tab",
tabPanel("Data",
dataTableOutput("fileData")),
tabPanel("Summary Statistics"),
tabPanel("Graphs"))
)
)
)
server <- function(input, output) {
fileData <- eventReactive(input$file1,{
read.csv(input$file1$dataPath, header = TRUE, sep = ",", dec = ".")
})
output$fileData <- renderDataTable(
fileData()
)
vars <- reactive({
names(fileData())
})
output$ind1 <- renderUI({
selectInput("var1", "Independent 1", choices = vars())
})
output$ind2 <- renderUI({
selectInput("var2", "Independent 2", choices = vars())
})
output$dep1 <- renderUI({
selectInput("var3", "Dependent 1", choices = vars())
})
}
shinyApp(ui = ui, server = server)
Tricky because Shiny doesn't give any warning about this :
shiny app will not work if the same "output" is used two times in Ui.R.
Everything looks OK, except the double use of uiOutput("dep1") and uiOutput("ind1") :
conditionalPanel("statChoice == 'A1btw'",
uiOutput("ind1"), # Used once
uiOutput("dep1")), # Used once
conditionalPanel("statChoice == 'A2btw'",
uiOutput("ind1"), # Used twice
uiOutput("ind2"),
uiOutput("dep1")), # Used twice
You should use an output only once.
I have the shiny app below in which the user uploads a csv. Then the pickerInput gets the unique values of the first column of that csv and uses them to subset the dataframe and display it in a table. The issue is that I want to use an actionButton in order to apply changes but when the csv is uploaded for first time it should be displayed full and not displayed empty because the actionButton is not triggered yet. For the purpose of the example I have used iris dataset instead of a csv.
# app.R ##
library(shiny)
library(DT)
library(shinyWidgets)
ui <- pageWithSidebar(
headerPanel('Iris k-means clustering'),
sidebarPanel(
fileInput("file1", "Choose CSV File",
accept = c(
"text/csv",
"text/comma-separated-values,text/plain",
".csv")
),
uiOutput("id"),
actionButton("go","Go")
),
mainPanel(
uiOutput('contents')
)
)
server <- function(input, output, session) {
output$id<-renderUI({
#inFile <- input$file1
#df2<-data.frame(read.csv(inFile$datapath, header = TRUE))
pickerInput("select", "Select ID",
choices = as.character(unique(iris$Species)),
multiple = T,options = list(`actions-box` = TRUE),
selected = as.character(unique(iris$Species)))
})
output$contents <- renderUI({
input$goButton
#inFile <- input$file1
#df<-data.frame(read.csv(inFile$datapath, header = TRUE))
df<-data.frame(iris)
df<-subset(iris,Species %in% isolate(input$select))
renderDataTable({
datatable(
df,
options = list(scrollX = TRUE,pageLength=5)
)
})
})
}
shinyApp(ui = ui, server = server)
library(shiny)
library(DT)
library(shinyWidgets)
ui <- pageWithSidebar(
headerPanel('Iris k-means clustering'),
sidebarPanel(
fileInput("file1", "Choose CSV File",
accept = c(
"text/csv",
"text/comma-separated-values,text/plain",
".csv")
),
uiOutput("picker"),
actionButton("go","Go")
),
mainPanel(
DTOutput("dtable")
)
)
server <- function(input, output, session) {
filteredCSV <- reactiveVal(NULL)
CSV <- eventReactive(input[["file1"]], {
dat <- read.csv(input[["file1"]]$datapath, header = TRUE)
filteredCSV(dat)
dat
})
output[["picker"]] <- renderUI({
req(CSV())
choices <- unique(as.character(CSV()[,1]))
pickerInput("select", "Select ID",
choices = choices,
multiple = TRUE, options = list(`actions-box` = TRUE),
selected = choices)
})
observeEvent(input[["go"]], {
req(CSV())
filteredCSV(CSV()[CSV()[,1] %in% input[["select"]],])
})
output[["dtable"]] <- renderDT({
req(filteredCSV())
datatable(
filteredCSV(),
options = list(scrollX = TRUE, pageLength = 5)
)
})
}
shinyApp(ui = ui, server = server)
This is in reply to the previous version of your post, but should solve the main problem - this is how I would go about it, using reactive expressions (and data.table, but you might just as well not use it):
library(shiny)
library(shinyWidgets)
library(DT)
library(data.table)
ui <- pageWithSidebar(
headerPanel('Iris k-means clustering'),
sidebarPanel(
fileInput("file1", "Choose CSV File",
accept = c(
"text/csv",
"text/comma-separated-values,text/plain",
".csv")
),
uiOutput("id"),
#actionButton("go","Go")
),
mainPanel(
DT::dataTableOutput('contents')
)
)
server <- function(input, output, session) {
getFile <- reactive({
req(input$file1)
fread(input$file1$datapath, header = TRUE)
})
output$contents <- DT::renderDataTable({
DT::datatable(getFile()[get(colnames(getFile())[1]) %in% input$select])
})
output$id <- renderUI({
req(getFile())
df <- getFile()
pickerInput("select", "Select ID",
choices = unique(df[[1]]),
multiple = TRUE, options = list(`actions-box` = TRUE),
selected = unique(df[[1]]))
})
}
shinyApp(ui = ui, server = server)