Related
I am a beginer of shiny, and I am building a shiny app using win10 system, rstudio, and shiny version 1.7.1. I would like to make it more user oriented. It means that other parts of the application will be hid unless user uploads correct data. After many attempts, I decided to use session$userData and shinyjs::toggle to develop this app. But I am confused by session$userData. In the beginning, by reading the official documentation, I think it just like the global environment of r. But obviously not. So I just want to know how to use it correctly, or how to realize the features I want. There are three examples I had tried, they are for your reference.
Please note that the third example is almost what I want, but I don't think it's elegant since the continue button is somewhat redundant.
Examples 1:
I would like to check whether there is data input or whether the input data is a csv format, if true, show the data, and if not, the rest part of the app will be hid. In this case you can see, although you data have passed the check, the tablepanel b will still show nothing, unless before input data you have clicked tablepanel b, or unless after data checking you clicked button go again.
##### 1. packages #####
library(shiny)
library(shinyjs)
##### 2. ui #####
ui <- fluidPage(
useShinyjs(),
tabsetPanel(
tabPanel("a",
sidebarLayout(
sidebarPanel(uiOutput("ui_p1_sidebar1"), uiOutput("ui_p1_sidebar2")),
mainPanel(uiOutput("ui_p1_main"))
)),
tabPanel("b",
sidebarLayout(
sidebarPanel(uiOutput("ui_p2_sidebar")),
mainPanel(uiOutput("ui_p2_main"))
))
)
)
##### 3. server #####
server <- function(input, output, session) {
output$ui_p1_sidebar1 <- renderUI({
fileInput(inputId = "p1s_inputdata",
label = "Input data",
multiple = FALSE,
accept = ".csv")
})
output$ui_p1_sidebar2 <- renderUI({
shiny::actionButton(inputId = "p1s_go",
label = "go",
icon = icon("play"))
})
observeEvent(input$p1s_go,{
isolate({
data <- input$p1s_inputdata
})
output$ui_p1_main <- renderUI({
tagList(
h3("Data check: "),
verbatimTextOutput(outputId = "p1m_datacheck", placeholder = T),
h3("Data show: "),
verbatimTextOutput(outputId = "p1m_datashow", placeholder = T),
)
})
output$p1m_datacheck <- renderPrint({
# data check part, the result of checking is stored by session$userData$sig
if(is.null(data)){
cat("There is no data input! \n")
session$userData$sig <- F
} else{
dataExt <- tools::file_ext(data$name)
if(dataExt != "csv"){
cat("Please input csv data! \n")
session$userData$sig <- F
} else{
cat("Data have passed the check!")
session$userData$data <- read.csv(data$datapath)
session$userData$sig <- T
}
}
})
output$p1m_datashow <- renderPrint({
if(session$userData$sig){
print(session$userData$data)
} else{
cat("Please check the data!")
}
})
output$ui_p2_sidebar <- renderUI({
radioButtons("aaa", "aaa", choices = c("a", "b", "c"))
})
output$ui_p2_main <- renderUI({
verbatimTextOutput(outputId = "p2m_print", placeholder = T)
})
output$p2m_print <- renderPrint({print(letters[1:10])})
observe({
toggle(id = "ui_p2_sidebar", condition = session$userData$sig)
toggle(id = "ui_p2_main", condition = session$userData$sig)
})
})
}
##### 4. app #####
shinyApp(ui = ui, server = server)
Example 2:
In this small case you can see, in a samle module, session$userData$... changed timely, but in another module, it will not change unless you click the button again. It that means session$userData$... could have different values at the same time?
##### 1. packages #####
library(shiny)
##### 2. ui #####
ui <- fluidPage(
sidebarLayout(
sidebarPanel(uiOutput("ui_sidebar")),
mainPanel(uiOutput("ui_main1"), uiOutput("ui_main2"))
)
)
##### 3. server #####
server <- function(input, output, session) {
output$ui_sidebar <- renderUI({
tagList(
radioButtons("s_letter", "letters", choices = c("a", "b", "c")),
shiny::actionButton(inputId = "go1",
label = "GO1",
icon = icon("play"))
)
})
observeEvent(input$go1, {
output$ui_main1 <- renderUI({
tagList(
h3("module 1: shared value changes timely."),
verbatimTextOutput(outputId = "m1", placeholder = T),
h3("module 2: shared value changes by button."),
verbatimTextOutput(outputId = "m2", placeholder = T)
)
})
output$m1 <- renderPrint({
out <- switch (input$s_letter,
"a" = "choose a",
"b" = "choose b",
"c" = "choose c")
session$userData$sharedout <- out
cat("out: \n")
print(out)
cat("sharedout: \n")
print(session$userData$sharedout)
})
output$m2 <- renderPrint({
cat("sharedout: \n")
print(session$userData$sharedout)
})
})
}
##### 4. app #####
shinyApp(ui = ui, server = server)
Example 3: I also tried other solutions. There is a modification of example 1, I have added a continue button to realize my thought. It works well, but I hope the hidden action is based on conditions rather than events. So how to remove the button and let the rest part displayed automatically if data passed checking?
##### 1. packages #####
library(shiny)
##### 2. ui #####
ui <- fluidPage(
tabsetPanel(
tabPanel("a",
sidebarLayout(
sidebarPanel(uiOutput("ui_p1_sidebar1"), uiOutput("ui_p1_sidebar2")),
mainPanel(uiOutput("ui_p1_main"))
)),
tabPanel("b",
sidebarLayout(
sidebarPanel(uiOutput("ui_p2_sidebar")),
mainPanel(uiOutput("ui_p2_main"))
))
)
)
##### 3. server #####
server <- function(input, output, session) {
output$ui_p1_sidebar1 <- renderUI({
fileInput(inputId = "p1s_inputdata",
label = "Input data",
multiple = FALSE,
accept = ".csv")
})
output$ui_p1_sidebar2 <- renderUI({
shiny::actionButton(inputId = "p1s_go",
label = "go",
icon = icon("play"))
})
observeEvent(input$p1s_go,{
isolate({
data <- input$p1s_inputdata
})
output$ui_p1_main <- renderUI({
tagList(
h3("Data check: "),
verbatimTextOutput(outputId = "p1m_datacheck", placeholder = T),
uiOutput("ispass"),
h3("Data show: "),
verbatimTextOutput(outputId = "p1m_datashow", placeholder = T)
)
})
output$p1m_datacheck <- renderPrint({
if(is.null(data)){
cat("There is no data input! \n")
session$userData$sig <- F
} else{
dataExt <- tools::file_ext(data$name)
if(dataExt != "csv"){
cat("Please input csv data! \n")
session$userData$sig <- F
} else{
cat("Data have passed the check!")
session$userData$data <- read.csv(data$datapath)
session$userData$sig <- T
}
}
})
output$ispass <- renderUI({
if(isFALSE(session$userData$sig)){
return()
} else{
shiny::actionButton(inputId = "ispass",
label = "continue",
icon = icon("play"))
}
})
})
observeEvent(input$ispass,{
output$p1m_datashow <- renderPrint({
if(session$userData$sig){
print(session$userData$data)
} else{
cat("Please check the data!")
}
})
output$ui_p2_sidebar <- renderUI({
radioButtons("aaa", "aaa", choices = c("a", "b", "c"))
})
output$ui_p2_main <- renderUI({
verbatimTextOutput(outputId = "p2m_print", placeholder = T)
})
output$p2m_print <- renderPrint({print(letters[1:10])})
})
}
##### 4. app #####
shinyApp(ui = ui, server = server)
I hope the following refactoring will help and does what you want.
An essential tool for hiding,showing and updating UI elements can be the renderUI, but often this is overkill because of rerenderings.
But I would suggest using the shinyjs-package which gives you functions like shinyjs::show and shinyjs::hide for showing and hiding. For updating UI-elements, there are functions like shiny::updateActionButton,shiny::updateCheckboxInput, shiny::updateRadioButtons, ....
It is (always) useful to give your UI-elements IDs, like the tabsetPanel.
Moreover, a nice tool too is shiny::conditionalPanel, but you will dive into all this stuff when programming more apps. :)
##### 1. packages #####
library(shiny)
myapp <- function() {
##### 2. ui #####
ui <- fluidPage(
tabsetPanel(
tabPanel("a",
sidebarLayout(
sidebarPanel(
fileInput(inputId = "p1s_inputdata", label = "Input data", multiple = FALSE, accept = ".csv")
),
mainPanel(uiOutput("ui_p1_main"))
)),
tabPanel("b",
sidebarLayout(
sidebarPanel(radioButtons("aaa", "aaa", choices = c("some", "placeholder", "stuff"))),
mainPanel(verbatimTextOutput(outputId = "p2m_print", placeholder = T))
)),
id = "TABSETPANEL"
)
)
##### 3. server #####
server <- function(input, output, session) {
shiny::hideTab(inputId = "TABSETPANEL", target = "b", session = session)
observeEvent(input$p1s_inputdata, {
data <- input$p1s_inputdata
dataCheckText <- NULL
if(is.null(data)){
dataCheckText <- "There is no data input!"
session$userData$sig <- F
} else{
dataExt <- tools::file_ext(data$name)
if(dataExt != "csv"){
dataCheckText <- "Please input csv data!"
session$userData$sig <- F
} else{
dataCheckText <- "Data have passed the check!"
session$userData$data <- read.csv(data$datapath)
session$userData$sig <- T
}
}
output$p1m_datacheck <- renderPrint(dataCheckText)
if(session$userData$sig) shiny::showTab(inputId = "TABSETPANEL", target = "b", session = session)
else shiny::hideTab(inputId = "TABSETPANEL", target = "b", session = session)
main1Taglist <- tagList(
h3("Data check: "),
verbatimTextOutput(outputId = "p1m_datacheck", placeholder = T)
)
if(session$userData$sig) {
shiny::showTab(inputId = "TABSETPANEL", target = "b", session = session)
output$p1m_datashow <- renderPrint({
print(session$userData$data)
})
main1Taglist <- c(main1Taglist, tagList(
h3("Data show: "),
verbatimTextOutput(outputId = "p1m_datashow", placeholder = T)
))
#Update stuff in panel b according to the new data
updateRadioButtons(session = session, inputId = "aaa", choices = names(session$userData$data))
output$p2m_print <- renderPrint({print(letters[1:10])})
}
output$ui_p1_main <- renderUI(main1Taglist)
})
}
##### 4. app #####
shinyApp(ui = ui, server = server)
}
myapp()
You're somewhat on the right track. Try something like this:
observeEvent(input$go1, {
# Perform data validation here.
# This would look similar to what you have inside output$p1m_datacheck <- renderPrint({})
# If data file is no good, do nothing, exit this function: return()
# Else, data file is good, continue
# Do your output$* <- render*() functions here
})
You don't need to isolate() inside the handlerExpr of observeEvent(). It will already be executed in an isolate() scope.
I want to upload two csv files and print both tables out.
Here is the code I wrote:
library(shiny)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
fileInput(inputId = "files", label = "Choose CSV File", multiple = TRUE,accept = c(".csv")
)
),
mainPanel(
fluidRow(tableOutput("Policy1")),
fluidRow(tableOutput("Policy2")),
)
)
)
server <- function(input, output) {
data <- reactiveValues(file1 = NULL,
file2 = NULL)
output$Policy1 <- renderTable({
if(!is.null(input$files$datapath[1]))
data$file1 <- read.csv(input$files$datapath[1], header = TRUE)
data$file1
})
output$Policy2 <- renderTable({
if(is.null(input$files$datapath[2])) {return(1)}
else{return(NULL)}
})
}
shinyApp(ui, server)
and for the output$Policy2 part, I want to test when the is.null(input$files$datapath[2]) is true. I thought it should be true when I only upload one file or don't upload anything but
if I only upload one csv file, it didn't print out the table 1, which means is.null(input$files$datapath[2]) is false in this case.I don't know why this is the case.
And as a result, if I change the code to ask shiny print two tables for me and only upload one file, there will be an error, here is the code:
library(shiny)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
fileInput(inputId = "files", label = "Choose CSV File", multiple = TRUE,accept = c(".csv")
)
),
mainPanel(
fluidRow(tableOutput("Policy1")),
fluidRow(tableOutput("Policy2")),
)
)
)
server <- function(input, output) {
data <- reactiveValues(file1 = NULL,
file2 = NULL)
output$Policy1 <- renderTable({
if(!is.null(input$files$datapath[1]))
data$file1 <- read.csv(input$files$datapath[1], header = TRUE)
data$file1
})
output$Policy2 <- renderTable({
if(!is.null(input$files$datapath[2]))
data$file2 <- read.csv(input$files$datapath[2], header = TRUE)
data$file2
})
}
shinyApp(ui, server)
where I only change a little part and here is the error :
which I assume is because I should return NULL when only one file inputed in, how can I fix this problem, thanks for any help
The value won't be NULL if it's missing. It's better to check that there are enough values checking the length of the vector or something. For example
output$Policy2 <- renderTable({
if(!is.null(input$files) && length(input$files$datapath)>=2)
data$file2 <- read.csv(input$files$datapath[2], header = TRUE)
data$file2
})
I am trying to build a shiny app to retrieve data from an Oracle table based on user specified ID. I want to create one file with data for each ID and download it to the default downloads folder. I would also like to zip the files and provide the user with that one file. Also, the app is just to download the data and I really don't want a main Panel hence the width of the mainPanel is zero. If that's not the way to do it, please let me know.The app is going to reside on a server and hence the need for a download Handler. Below is my code. Any help is greatly appreciated.
library(shiny)
library(ROracle)
library(shinyjs)
library(shinyalert)
library(shinyWidgets)
ui <- fluidPage(
useShinyjs(),
useShinyalert(),
# Application title
titlePanel(fluidRow(
column(10, "RAINFALL AND ET DATA RETRIEVAL",align="center"),
column(2, offset = 0,img(height =90,width=250,src="logo.png",align="left"))
)),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(width = 12,
helpText("Please enter IDs separated by commas. You can enter up to 25 IDs."),
textInput("PixelID", "Pixel ID(s)", value = ""),
helpText("OR"),
fileInput('datafile','Choose csv file to upload Pixel IDs.The csv file should have Pixel IDs in the first column WITHOUT ANY HEADER.',accept = c('csv','comma-separated-values','.csv')),
helpText("Please select a parameter you would like to retrieve."),
radioButtons("ParameterType", "Parameters",
choices = c("Rainfall Estimates","Evapotranspiration Estimates"),
selected = "None"),
dateInput("startdate","Data From", format = "yyyy-mm-dd",max = Sys.Date()),
dateInput("enddate","Data To", format = "yyyy-mm-dd",max = Sys.Date()),
br(), br(),
actionBttn("goButton","Go!",color = "default",style = "fill",size = "lg"),
br(),br(),
uiOutput("download"),
mainPanel(width=0)
)
)
server <- function(input, output, session) {
data<-eventReactive(input$goButton,{
if(is.null(input$PixelID) || input$PixelID == ""){
req(input$datafile)
infile<-input$datafile
PixelList<-read.table(infile$datapath, header = FALSE, sep = ",", stringsAsFactors = FALSE)
colnames(PixelList)<-"PixelNum"
PixelList_comma<-paste(PixelList$PixelNum, collapse = ",")} else{
if(input$PixelID != ""){
PixelList<-data.frame(strsplit(input$PixelID,","))
colnames(PixelList)<-"PixelNum"
PixelList_comma<-input$PixelID
}}
drv <- dbDriver("Oracle")
connection <- dbConnect(drv, username = "xxxx", password = "xxxxx", dbname = "xxxx")
if(input$ParameterType=="Rainfall Estimates"){
for(i in 1:nrow(PixelList)){
raindata<-dbGetQuery(connection, paste("select PIXEL, TO_CHAR(tsdatetime_dt, 'MM/DD/YYYY HH24:MI') as DATE_TIME, tsvalue_ms as RAINFALL from xxxx
where feature_id =",PixelList[i,1]," order by tsdatetime_dt", sep=""))
}
dbDisconnect(conn = connection)
}
return(raindata)
})
output$download <- renderUI({
downloadButton("downloadData", "Download")
})
output$downloadData <- downloadHandler(
filename = function() {
paste("testnexrad",".zip",sep = "")
},
content = function(file) {
for(i in 1:nrow(PixelList)){
#No idea what to do here
}
}
)
}
# Run the application
shinyApp(ui = ui, server = server)
I'm pretty new to shiny (being playing around for about a week). And I'm trying to create an app that takes and input tab-separated text file and perform several exploratory functions. In this case I'm presenting a very simplified version of that app just to highlight what I want to do in a specific case:
Problem:
If you try the app with the sample data (or any data in the same format) you can notice that the app effectively performs the default summary table (if selectInput="summarize", then output$sumfile), but when you try to select "explore", the previous table gets removed from the mainPanel, and outputs the full file (selectInput="explore",then output$gridfile) in the place where it would be as if selectInput="summarize" was still selected.
If you re-select "summarize", excelOutput("sumfile") gets duplicated on the mainPanel.
My goal is simple:
excelOutput("sumfile") when selectInput="summarize" ONLY and
excelOutput("gridfile") when selectInput="explore" ONLY
without placement issues or duplications on the mainPanel
So far I've tried:
inFile=input$df
if(is.null(inFile))
return(NULL)
if(input$show=="summarize")
return(NULL)
or
inFile=input$df
if(is.null(inFile))
return(NULL)
if(input$show=="explore")
return(NULL)
To control what shows up on the mainPanel, but with placement and duplication issues.
sample data:
#Build test data
testdat<-data.frame(W=c(rep("A",3),
rep("B",3),
rep("C",3)),
X=c(letters[1:9]),
Y=c(11:19),
Z=c(letters[1:7],"",NA),
stringsAsFactors = FALSE)
#Export test data
write.table(testdat,
"your/path/file.txt",
row.names = FALSE,
sep = "\t",
quote = FALSE,
na="")
shiny app (app.R):
library(shiny)
library(excelR)
#function to summarize tables
Pivot<-function(df){
cclass<-as.character(sapply(df,
class))
df.1<-apply(df,
2,
function(x) unlist(list(nrows = as.numeric(NROW(x)),
nrows.unique = length(unique(x))-(sum(is.na(x))+length(which(x==""))),
nrows.empty = (sum(is.na(x))+length(which(x==""))))))
df.2<-data.frame(df.1,
stringsAsFactors = FALSE)
df.3<-data.frame(t(df.2),
stringsAsFactors = FALSE)
df.3$col.class<-cclass
df.3$col.name<-row.names(df.3)
row.names(df.3)<-NULL
df.3<-df.3[c(5,4,1,2,3)]
return(df.3)
}
ui <- fluidPage(
ui <- fluidPage(titlePanel(title=h1("Summary generator",
align="center")),
sidebarLayout(
sidebarPanel(
h3("Loading panel",
align="center"),
fileInput("df",
"Choose file (format: file.txt)",
accept = c("plain/text",
".txt")),
selectInput("show",
"Choose what to do with file",
choices=c("summarize","explore")),
p("**'summarize' will output a summary of the selected table"),
p("**'explore' will output the full selected editable table"),
tags$hr()
),
mainPanel(
excelOutput("gridfile"),
excelOutput("sumfile")
))))
server <- function(input, output) {
dat<-reactive({
fp<-input$df$datapath
read.delim(fp,
quote="",
na.strings="\"\"",
stringsAsFactors=FALSE)
})
#get summary
output$sumfile<-renderExcel({
inFile=input$df
if(is.null(inFile)) #if fileInput is empty return nothing
return(NULL)
if(input$show=="explore") #if selectInput = "explore" return nothing
return(NULL)
dat.1<-data.frame(dat())
dat.2<-Pivot(dat.1)
excelTable(dat.2,
defaultColWidth = 100,
search = TRUE)
})
#get full file
output$gridfile<-renderExcel({
inFile=input$df
if(is.null(inFile)) #if fileInput is empty return nothing
return(NULL)
if(input$show=="summarize") #if selectInput = "summarize" return nothing
return(NULL)
dat.1<-data.frame(dat())
excelTable(dat.1,
defaultColWidth = 100,
search = TRUE)
})
}
shinyApp(ui = ui, server = server)
One way to do what you want is to use observeEvent for your inputs input$show and input$df and renderExcel based on your selection of `input$show. Here is an updated version for your code:
library(shiny)
library(excelR)
#function to summarize tables
Pivot<-function(df){
cclass<-as.character(sapply(df,
class))
df.1<-apply(df,
2,
function(x) unlist(list(nrows = as.numeric(NROW(x)),
nrows.unique = length(unique(x))-(sum(is.na(x))+length(which(x==""))),
nrows.empty = (sum(is.na(x))+length(which(x==""))))))
df.2<-data.frame(df.1,
stringsAsFactors = FALSE)
df.3<-data.frame(t(df.2),
stringsAsFactors = FALSE)
df.3$col.class<-cclass
df.3$col.name<-row.names(df.3)
row.names(df.3)<-NULL
df.3<-df.3[c(5,4,1,2,3)]
return(df.3)
}
ui <- fluidPage(
ui <- fluidPage(titlePanel(title=h1("Summary generator",
align="center")),
sidebarLayout(
sidebarPanel(
h3("Loading panel",
align="center"),
fileInput("df",
"Choose file (format: file.txt)",
accept = c("plain/text",
".txt")),
selectInput("show",
"Choose what to do with file",
choices=c("summarize","explore")),
p("**'summarize' will output a summary of the selected table"),
p("**'explore' will output the full selected editable table"),
tags$hr()
),
mainPanel(
excelOutput("gridfile"),
excelOutput("sumfile")
))))
server <- function(input, output) {
dat<-reactive({
fp<-input$df$datapath
read.delim(fp,
quote="",
na.strings="\"\"",
stringsAsFactors=FALSE)
})
observeEvent({
input$show
input$df
}, {
inFile=input$df
if(is.null(inFile)) #if fileInput is empty return nothing
return(NULL)
if(input$show=="explore") {
output$gridfile<-renderExcel({
dat.1<-data.frame(dat())
excelTable(dat.1,
defaultColWidth = 100,
search = TRUE)
})
}
if(input$show=="summarize") {
output$sumfile<-renderExcel({
dat.1<-data.frame(dat())
dat.2<-Pivot(dat.1)
excelTable(dat.2,
defaultColWidth = 100,
search = TRUE)
})
}
})
}
shinyApp(ui = ui, server = server)
Hope it helps!
I am new to R and i am using shiny package to build a shiny app that can take different type of queries and those queries takes dynamic user id provided by users on ui level and also i want to show the demo of result of query on ui.
So, my problem is that i am not able to store the query results into an data frame also on clicking on Download button csv is not storing in my system. my code is below. thanks.
###server
library(shiny)
library(RMySQL)
shinyServer(function(input, output) {
datasetInput <- reactive({
switch(input$queryset,
"CDR" = cdr,
"ASSET" = ast,
"USAGE" = usg)
})
output$tbl <- renderTable({
conn <- dbConnect(drv = RMySQL::MySQL(),dbname = "xxxx",
host = "xxxxxx",
username = "xxxxx",
password = "xxxxx"),
q<-dbSendQuery(conn,paste0("select * from table where user_id='",input$user_id,"' and start_time >= '2016-07-16' and start_time < '2016-07-28' order by start_time limit 10 ;",sep = ""
))
dat<- dbFetch(q,n=-1)
on.exit(dbDisconnect(conn), add = TRUE)
})
output$view <- renderTable({
head({dat}, n = input$nrows)
})
output$downloadData <- downloadHandler(
filename = function() { paste(input$user_id, '.csv', sep='') },
content = function(file) {
write.csv({dat}, file)
})
}
)
###ui
library(shiny)
shinyUI(fluidPage(
titlePanel("My App"),
sidebarLayout(
sidebarPanel(
selectInput("queryset", "Choose the type of query:",
choices = c("CDR", "ASSET", "USAGE")),
numericInput("nrows", "Enter the no. of observations:", 10),
numericInput("user_id", "Enter user_id:", 0),
downloadButton('downloadData', 'Download',class = NULL)
),
mainPanel(
tableOutput("view")
)
)
))