Related
I am quite new to R shiny and I am trying to build a small shiny app but I don't know where I went wrong.
I am trying to get multiple user input via text area to filter my table output. Moreover, i want to control the columns to show in the table as well. Code is running fine for showing the columns but it is working only with one input value in the text area, it is not working with multiple user inputs.
I want to filter the table output with multiple user inputs as well.
For example for this code snippet it should return table when I write "honda,audi,bmw" in the text area input.
library(shiny)
library(shinyWidgets)
library(DT)
df <-mtcars
#ui
shinyApp(
ui = fluidPage(
titlePanel("Trial 1"),
sidebarLayout(
sidebarPanel(
#to take multiple user input
textAreaInput(
"text_input",
label = "Write multiple input separated by comma"
),
#to slect the columns to be added
pickerInput(
inputId = "somevalue",
label = "Columns to add",
choices = colnames(df),
options = list(`actions-box` = TRUE),
multiple = TRUE
),
#action button tot show the table
actionBttn(
"show_table",
label = "Show",
size = "sm",
color = "default",
block = TRUE
),
),
mainPanel(
tabsetPanel(type = "tabs",
tabPanel("Table", DT::dataTableOutput("table")),
tabPanel("Summary", verbatimTextOutput("summary"))
)
)
)
),
server = function(input, output,session) {
data <- observeEvent(input$show_table,{
text_input <- trimws(strsplit(input$text_input, ",")[[1]])
output$summary <- renderPrint({
summary(data())
})
output$table <- DT::renderDT({
df_sub <- df[df$make %chin% input$text_input, input$somevalue]
#df_sub = df[ ,input$somevalue]
datatable(df_sub,
caption = "PLease enter the changes by double clicking the cell",
editable = 'cell')
})
})
}
)
There isn't a 'make' variable in the data. I guess you refer to the first word of the row name as the make of the car. Then the strings you entered could be matched with the make of the car.
server = function(input, output,session) {
data <- observeEvent(input$show_table,{
brand <- word(rownames(df), 1)
text_input <- strsplit(input$text_input, ",")[[1]]
df_sub <- df[brand %in% text_input, input$somevalue]
output$summary <- renderPrint({
summary(df_sub)
})
output$table <- DT::renderDT({
datatable(df_sub,
caption = "PLease enter the changes by double clicking the cell",
editable = 'cell')
})
output$test <- renderText({
text_input
})
})}
I was wondering if it is possible to save DT table content together with some additional information which is not part of the data frame/table like app version number, date of execution, sliderInput value etc.
Thank you!
Reprex below:
library(shiny)
library(DT)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
sliderInput(inputId = "range", "Set range", 1, 10, 5, 1)
),
mainPanel(
DT::dataTableOutput("table")
)
)
)
server <- function(input, output) {
dfr <- data.frame(var1 <- c(1,2,3),
var2 <- c(11, 22, 33))
output$table <- DT::renderDataTable(
datatable(dfr, extensions = 'Buttons',
class="cell-border stripe",
rownames = FALSE, colnames = c("var1", "var2"),
options = list(dom = "Blfrtip",
buttond = list("copy", list(extend = "collection",
buttons = c("csv", "excel", "pdf"),
text = "Download")), pageLength=10, autoWidth = TRUE,
searchHighlight = TRUE, filter = "top"))
)
}
shinyApp(ui = ui, server = server)
You could save the contents of the data frame and the other information in a list and then save the list.
Or, any R object can have attributes which are completely arbitrary and under your control. You could set attributes of the data frame to record the information you want.
Personally, I'd use the list approach, purely because I don't like attributes.
Here's a suggestion in response to OP's request below.
library(shiny)
library(DT)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
sliderInput(inputId = "range", "Set range", 1, 10, 5, 1),
actionButton("saveRds", "Save to Rds"),
actionButton("loadRds", "Load from Rds")
),
mainPanel(
DT::dataTableOutput("table"),
wellPanel(h4("Current data"), verbatimTextOutput("text")),
wellPanel(h4("File data"), verbatimTextOutput("loadedData"))
)
)
)
server <- function(input, output) {
dfr <- data.frame(var1 <- c(1,2,3),
var2 <- c(11, 22, 33))
output$table <- DT::renderDataTable(
datatable(dfr, extensions = 'Buttons',
class="cell-border stripe",
rownames = FALSE, colnames = c("var1", "var2"),
options = list(dom = "Blfrtip",
buttond = list("copy", list(extend = "collection",
buttons = c("csv", "excel", "pdf"),
text = "Download")), pageLength=10, autoWidth = TRUE,
searchHighlight = TRUE, filter = "top"))
)
listInfo <- reactive({
list("data"=dfr, "version"="WebApp Version 1.0", "runDate"=date(), "sliderValue"=input$range)
})
output$text <- renderPrint({
listInfo()
})
observeEvent(input$saveRds, {
saveRDS(listInfo(), "data.Rds")
})
fileData <- reactive({
req(input$loadRds)
readRDS("data.Rds")
})
output$loadedData <- renderPrint({
fileData()
})
}
shinyApp(ui = ui, server = server)
The way you implement "save to file" will depend on the file format: Excel files will clearly have different requirements to PDF files, for example. As a minimum effort demonstation, I've created "Save to Rds" and "Load from RDS" buttons in the sidebar and added a verbatimTextOutput to display the contents of the file when it's loaded. [I'm not sufficiently familiar with DT to know how to add the buttons in the table toolbar.]
OP's effort was pretty close: it's just that writing a list to CSV file takes a little more effort than just calling write.csv...
I want to download the output of this App which I made but there is an error and when I open the downloaded data it is empty.I make a data set by output$other_val_show and I want to download it. Any advice?
The following code in for the UI section.
library(shiny)
library(quantreg)
library(quantregGrowth)
library(plotly)
library(rsconnect)
library(ggplot2)
library(lattice)
ui = tagList(
tags$head(tags$style(HTML("body{ background: aliceblue; }"))),
navbarPage(title="",
tabPanel("Data Import",
sidebarLayout(sidebarPanel( fileInput("file","Upload your CSV",multiple = FALSE),
tags$hr(),
h5(helpText("Select the read.table parameters below")),
checkboxInput(inputId = 'header', label = 'Header', value = FALSE),
checkboxInput(inputId = "stringAsFactors", "StringAsFactors", FALSE),
radioButtons (inputId = 'sep', label = 'Separator',
choices = c(Comma=',',Semicolon=';',Tab='\t', Space=''), selected = ',')
),
mainPanel(uiOutput("tb1"))
)),
tabPanel("Interval",
sidebarLayout(sidebarPanel(
uiOutput("model_select"),
uiOutput("var1_select"),
uiOutput("rest_var_select"),
#uiOutput("testText1"), br(),
#textInput("Smooting Parameter min value", "Smooting Parameter max value", value = "")
sliderInput("range", "Smooth Parameter range:",min = 0, max = 1000, value = c(0,100)),
downloadButton('downloadData', 'Download')
),
mainPanel(helpText("Selected variables and Fitted values"),
verbatimTextOutput("other_val_show")))),
tabPanel("Model Summary", verbatimTextOutput("summary")),
tabPanel("Scatterplot", plotOutput("scatterplot"))#, # Plot
#tabPanel("Distribution", # Plots of distributions
#fluidRow(
#column(6, plotOutput("distribution1")),
#column(6, plotOutput("distribution2")))
#)
,inverse = TRUE,position="static-top",theme ="bootstrap.css"))
The following code in for the Server section. (I want to download the output which is "gr" and I want to download it by downloadHandler function.
server<-function(input,output) {
data <- reactive({
lower <- input$range[1]
upper <- input$range[2]
file1 <- input$file
if(is.null(file1)){return()}
read.table(file=file1$datapath, sep=input$sep, header = input$header, stringsAsFactors = input$stringAsFactors)
})
output$table <- renderTable({
if(is.null(data())){return ()}
data()
})
output$tb1 <- renderUI({
tableOutput("table")
})
#output$model_select<-renderUI({
#selectInput("modelselect","Select Algo",choices = c("Reference Interval"="Model"))
#})
output$var1_select<-renderUI({
selectInput("ind_var_select","Select Independent Variable", choices =as.list(names(data())),multiple = FALSE)
})
output$rest_var_select<-renderUI({
checkboxGroupInput("other_var_select","Select Dependent Variable",choices =as.list(names(data()))) #Select other Var
})
output$other_val_show<-renderPrint({
input$other_var_select
input$ind_var_select
f<-data()
lower <- input$range[1]
upper <- input$range[2]
library(caret)
library(quantregGrowth)
dep_vars <- paste0(input$ind_var_select, collapse = "+")
after_tilde <- paste0("ps(", dep_vars, ", lambda = seq(",lower,",",upper,",l=100))")
dyn_string <- paste0(input$other_var_select, " ~ ", after_tilde)
Model<-quantregGrowth::gcrq(as.formula(dyn_string),tau=c(0.025,0.975), data=f)
temp <- data.frame(Model$fitted)
gr <- cbind(f, temp)
print(gr)
})
output$downloadData <- downloadHandler(
write.csv(gr, file, row.names = FALSE)
)
}
shinyApp(ui=ui,server=server)
It's hard to fully answer this without a minimal reproducibile example, but here's what I would try:
Create gr outside of renderPrint
Use gr() in downloadHandler
Rewrite downloadHandler to include content and filename arguments
Here's a minimal example with the same logic as your app, i.e. create a reactive dataframe which is both printed (renderPrint) and downloadable (downloadHandler).
library(shiny)
ui <- navbarPage(title = "Example",
tabPanel("First",
selectInput("fruit", "Fruit", c("apple", "orange", "pear")),
h4("Output from renderPrint:"),
textOutput("other_val_show"),
h4("Download Button: "),
downloadButton("downloadData")))
server <- function(input, output) {
gr <- reactive({
data.frame(fruit = input$fruit)
})
output$other_val_show <- renderPrint({
print(gr())
})
output$downloadData <- downloadHandler(
filename = "example.csv",
content = function(file) {
write.csv(gr(), file)
})
}
shinyApp(ui, server)
You define gr inside the scope of that renderPrint function so it isn't available to downloadHandler. You should define gr as a reactive value somewhere outside that function. That way, when you assign it in the renderPrint function, it will be accessible to the entire scope of your program.
In the future, it would be helpful to provide the text of any error messages you get - they are often quite helpful to solving problems.
I am trying to use progress bars (via the command 'withProgress') to monitor the completion of a pipeline that I am running in shiny.
There are 6 progress bars. The pipeline is initiated by the uploading of a file and subsequent clicking of an "actionButton" (inputId=action). However, 3 of the progress bars appear temporarily before I have even uploaded the file. And then when I run the pipeline they appear in the wrong order i.e. the one that should be first comes second etc.
Can anyone tell me why this might be happening and how I can rectify it?
Below is a sample of what the pipeline looks like:
#ui.R
shinyUI(fluidPage(
titlePanel("Uploading Files"),
sidebarLayout(
sidebarPanel(
fileInput('file1', 'Choose CSV File',
accept=c('text/csv',
'text/comma-separated-values,text/plain',
'.csv')),
tags$hr(),
checkboxInput('header', 'Header', TRUE),
radioButtons('sep', 'Separator',
c(Comma=',',
Semicolon=';',
Tab='\t'),
','),
radioButtons('quote', 'Quote',
c(None='',
'Double Quote'='"',
'Single Quote'="'"),
'"')
),
mainPanel(
plotOutput('plot')
)
)
))
#server.R
server <- function(input, output, session) {
read <- reactive({
dataInput <- eventReactive(input$action{
inFile <- input$file1
if (is.null(inFile))
return(NULL)
isolate(file<-read.csv(inFile$datapath, header = input$header,
sep = input$sep))
file
})
file_data_manipulated<-reactive({
withProgress(message = 'Please Wait',
detail = 'This may take a while...', value = 0, {
for (i in 1:15) {
incProgress(1/15)
Sys.sleep(0.25)
}
as.numeric(dataInput())
})
})
output$plot<-renderPlot({
withProgress(message = 'Please Wait',
detail = 'This may take a while...', value = 0, {
for (i in 1:15) {
incProgress(1/15)
Sys.sleep(0.25)
}
plot(file_data_manipulated(), main = "Sample clustering to detect outliers", sub="", xlab="", cex.lab = 1.5, cex.axis = 1.5, cex.main = 2)
abline(h = input$cutoff_filter, col = "red")
#legend("bottomleft", scc$csize>1, pt.bg=unique(node_colors), pch=21)
})
})
I think that your code is incomplete. The progress bars appear before because as soon as the server function is called, all the code inside the reactive function will be executed, you need to provide mechanism to control when to show the progress bars. In this case just checking that the file was correctly uploaded with a if would be enough.
I modified your code to show how to control the reactive functions. Since I don't know how your input file is, I just plot some basic data. Also, I don't know how are you using the read <- reactive({, so just removed it.
library(shiny)
ui <- shinyUI(fluidPage(
titlePanel("Uploading Files"),
sidebarLayout(
sidebarPanel(
fileInput('file1', 'Choose CSV File',
accept=c('text/csv',
'text/comma-separated-values,text/plain',
'.csv')),
tags$hr(),
checkboxInput('header', 'Header', TRUE),
radioButtons('sep', 'Separator',
c(Comma=',',
Semicolon=';',
Tab='\t'),
','),
radioButtons('quote', 'Quote',
c(None='',
'Double Quote'='"',
'Single Quote'="'"),
'"'),
br(),
actionButton('action', 'action')
),
mainPanel(
plotOutput('plot')
)
)
))
server <- function(input, output, session) {
dataInput <- eventReactive(input$action, {
inFile <- input$file1
if (is.null(inFile))
return(NULL)
isolate({
file <- read.csv(inFile$datapath, header = input$header,
sep = input$sep)
})
file
})
file_data_manipulated <- reactive({
input$action
if (is.null(dataInput()))
return(NULL)
withProgress(message = 'Please Wait 1',
detail = 'This may take a while...', value = 0, {
for (i in 1:15) {
incProgress(1/15)
Sys.sleep(0.25)
}
as.numeric(dataInput())
})
})
output$plot <- renderPlot({
input$action
if (is.null(dataInput()))
return(NULL)
withProgress(message = 'Please Wait 2',
detail = 'This may take a while...', value = 0, {
for (i in 1:15) {
incProgress(1/15)
Sys.sleep(0.25)
}
# plot(file_data_manipulated(), main = "Sample clustering to detect outliers",
# sub="", xlab="", cex.lab = 1.5, cex.axis = 1.5, cex.main = 2)
# abline(h = input$cutoff_filter, col = "red")
#legend("bottomleft", scc$csize>1, pt.bg=unique(node_colors), pch=21)
plot(sin, -pi, 2*pi)
})
})
}
runApp(list(ui = ui, server = server))
I am trying to develop a shiny app where there are data inputs on multiple tabs. The content under each tab works fine on its own however when i attempt to combine them into one app I continue to get this error. Error in match.arg(position) : 'arg' must be NULL or a character vector. My code is as follows:
library(shiny)
library(shinydashboard)
library(ggvis)
sidebar <- dashboardSidebar(
hr(),
sidebarMenu(id="tabs",
menuItem("Import Data", tabName = "Import", icon=icon("list-alt")),
menuItem("Bivariate Regression", tabName="Bivariate Regression", icon=icon("line-chart")),
menuItem("Contingency", tabName = "Contingency", icon = icon("table"))
))
body <- dashboardBody(
tabItems(
tabItem(tabName= "Import",
sidebarLayout(
sidebarPanel(
fileInput("file","Upload the file"),
tags$hr(),
h5(helpText("Select the table parameters below")),
checkboxInput(inputId = 'header', label= 'Header', value= TRUE),
checkboxInput(inputId = "stringsAsFactors", "stringsAsFactors", FALSE),
br(),
radioButtons(inputId = 'sep', label = 'Seperator', choices = c(Comma=',', Semicolon=';', Tab='\t', Space= ' '), selected= ',')
),
mainPanel(
uiOutput("tb")
)
)),
tabItem(tabName= "Bivariate Regression",
sidebarLayout(
div(),
sidebarPanel(
fileInput('datfile', ''),
selectInput('x', 'x:' ,'x'),
selectInput('y', 'y:', 'y'),
uiOutput("plot_ui")
),
mainPanel(
titlePanel("Plot Output"),
ggvisOutput("plot")
)
))
))
dashboardPage(
dashboardHeader(title = "COBE Dashboard"),
sidebar,
body)
and server
library(shiny)
library(dplyr)
library(ggvis)
shinyServer(function(input, output){
#read the data and give import prefrences
data <- reactive({
file1 <- input$file
if(is.null(file1)){return()}
read.table(file=file1$datapath, sep= input$sep, header= input$header, stringsAsFactors= input$stringsAsFactors)
})
# display summary of table output
output$filledf <-renderTable({
if(is.null(data())){return ()}
input$file
})
output$sum <- renderTable({
if(is.null(data())){return ()}
summary(data())
})
output$table <- renderTable({
if(is.null(data())){return ()}
data()
})
#generate tabsets when the file is loaded.
output$tb <- renderUI({
if(is.null(data()))
h2("App powered by", tags$img(src='Blue.png', height= 100, width=250))
else
tabsetPanel(tabPanel("About file", tableOutput("filledf")), tabPanel("Data", tableOutput("table")), tabPanel("Summary", tableOutput("sum")))
})
########## Data import end #########
########## Bivariate regression begin ###########
#load the data when the user inputs a file
theData <- reactive({
infile <- input$datfile
if(is.null(infile))
return(NULL)
d <- read.csv(infile$datapath, header = T)
d
})
# dynamic variable names
observe({
data<-theData()
updateSelectInput(session, 'x', choices = names(data))
updateSelectInput(session, 'y', choices = names(data))
}) # end observe
#gets the y variable name, will be used to change the plot legends
yVarName<-reactive({
input$y
})
#gets the x variable name, will be used to change the plot legends
xVarName<-reactive({
input$x
})
#make the filteredData frame
filteredData<-reactive({
data<-isolate(theData())
#if there is no input, make a dummy dataframe
if(input$x=="x" && input$y=="y"){
if(is.null(data)){
data<-data.frame(x=0,y=0)
}
}else{
data<-data[,c(input$x,input$y)]
names(data)<-c("x","y")
}
data
})
#plot the ggvis plot in a reactive block so that it changes with filteredData
vis<-reactive({
plotData<-filteredData()
plotData %>%
ggvis(~x, ~y) %>%
layer_points() %>%
add_axis("y", title = yVarName()) %>%
add_axis("x", title = xVarName()) %>%
add_tooltip(function(df) format(sqrt(df$x),digits=2))
})
vis%>%bind_shiny("plot", "plot_ui")
##### add contingency table ########
# display contingcy table output
output$foo <- renderTable({
if(is.null(data())){return ()}
as.data.frame.matrix(table((data())))
})
})
There is an extra div() element in the second tabItem in tabItems in ui.R. Either provide an argument you implied to or remove that div() element. Also, I have added session argument to the shinyServer() function in server.R. After these changes app is running without any errors.
EDIT :
You forgot to add one more tabItem for Contingency in tabItems() function. Also, it is always better to differentiate between tabName and the title for that tab. And there should be no spaces in the tab name as per my experience, that is the reason why Bivariate Regression tab was not working before. It should work fine now.
Updated code:
ui.R
library(shiny)
library(shinydashboard)
library(ggvis)
sidebar <- dashboardSidebar(
br(),
sidebarMenu(id="tabs",
menuItem("Import Data", tabName = "import", icon=icon("list-alt")),
menuItem("Bivariate Regression", tabName="bivariate_regression", icon=icon("line-chart")),
menuItem("Contingency", tabName = "contingency", icon = icon("table"))
))
body <- dashboardBody(
tabItems(
tabItem(tabName= "import",
sidebarLayout(
sidebarPanel(
fileInput("file","Upload the file"),
tags$hr(),
h5(helpText("Select the table parameters below")),
checkboxInput(inputId = 'header', label= 'Header', value= TRUE),
checkboxInput(inputId = "stringsAsFactors", "stringsAsFactors", FALSE),
br(),
radioButtons(inputId = 'sep', label = 'Seperator', choices = c(Comma=',', Semicolon=';', Tab='\t', Space= ' '), selected= ',')
),
mainPanel(
uiOutput("tb")
)
)),
tabItem(tabName= "bivariate_regression",
sidebarLayout(
#div(),
sidebarPanel(
fileInput('datfile', ''),
selectInput('x', 'x:' ,'x'),
selectInput('y', 'y:', 'y'),
uiOutput("plot_ui")
),
mainPanel(
titlePanel("Plot Output"),
ggvisOutput("plot")
)
)),
tabItem(tabName="contingency", h2("Contigency Tab content"))
))
dashboardPage(
dashboardHeader(title = "COBE Dashboard"),
sidebar,
body)
server.R
library(shiny)
library(dplyr)
library(ggvis)
shinyServer(function(input, output,session){
#read the data and give import prefrences
data <- reactive({
file1 <- input$file
if(is.null(file1)){return()}
read.table(file=file1$datapath, sep= input$sep, header= input$header, stringsAsFactors= input$stringsAsFactors)
})
# display summary of table output
output$filledf <-renderTable({
if(is.null(data())){return ()}
input$file
})
output$sum <- renderTable({
if(is.null(data())){return ()}
summary(data())
})
output$table <- renderTable({
if(is.null(data())){return ()}
data()
})
#generate tabsets when the file is loaded.
output$tb <- renderUI({
if(is.null(data()))
h2("App powered by", tags$img(src='Blue.png', height= 100, width=250))
else
tabsetPanel(tabPanel("About file", tableOutput("filledf")), tabPanel("Data", tableOutput("table")), tabPanel("Summary", tableOutput("sum")))
})
########## Data import end #########
########## Bivariate regression begin ###########
#load the data when the user inputs a file
theData <- reactive({
infile <- input$datfile
if(is.null(infile))
return(NULL)
d <- read.csv(infile$datapath, header = T)
d
})
# dynamic variable names
observe({
data<-theData()
updateSelectInput(session, 'x', choices = names(data))
updateSelectInput(session, 'y', choices = names(data))
}) # end observe
#gets the y variable name, will be used to change the plot legends
yVarName<-reactive({
input$y
})
#gets the x variable name, will be used to change the plot legends
xVarName<-reactive({
input$x
})
#make the filteredData frame
filteredData<-reactive({
data<-isolate(theData())
#if there is no input, make a dummy dataframe
if(input$x=="x" && input$y=="y"){
if(is.null(data)){
data<-data.frame(x=0,y=0)
}
}else{
data<-data[,c(input$x,input$y)]
names(data)<-c("x","y")
}
data
})
#plot the ggvis plot in a reactive block so that it changes with filteredData
vis<-reactive({
plotData<-filteredData()
plotData %>%
ggvis(~x, ~y) %>%
layer_points() %>%
add_axis("y", title = yVarName()) %>%
add_axis("x", title = xVarName()) %>%
add_tooltip(function(df) format(sqrt(df$x),digits=2))
})
vis%>%bind_shiny("plot", "plot_ui")
##### add contingency table ########
# display contingcy table output
output$foo <- renderTable({
if(is.null(data())){return ()}
as.data.frame.matrix(table((data())))
})
})