I user renderTable to show some data. However, sometimes the data table is empty, in which case I'd like to print "No data to show" or something similar. the default by renderTable is to show nothing for empty data. can this be changed? how?
You can use a condition into a renderUi to render either a message or a "tableOutput" (you can't render directly the table)
datas <- data.frame()
shiny::runApp(list(
ui = pageWithSidebar(
headerPanel("Example"),
sidebarPanel(
selectInput("dataset", "Dataset", choices = c("iris", "datas"))
),
mainPanel(
uiOutput("ui")
)
),
server = function(input, output, session) {
datasetInput <- reactive({
switch(input$dataset,
"iris" = iris,
"datas" = datas)
})
output$ui <- renderUI({
if(nrow(datasetInput()) == 0)
return("No data to show")
tableOutput("table")
})
output$table <- renderTable({
head(datasetInput())
})
}
))
I think you are looking for something like validate function.
Using example code provided by Julien:
datas <- data.frame()
shiny::runApp(list(
ui = pageWithSidebar(
headerPanel("Example"),
sidebarPanel(
selectInput("dataset", "Dataset", choices = c("iris", "datas"))
),
mainPanel(
tableOutput('table')
)
),
server = function(input, output, session) {
datasetInput <- reactive({
switch(input$dataset,
"iris" = iris,
"datas" = datas)
})
output$table <- renderTable({
y <- head(datasetInput())
validate(
need(nrow(y) > 0, "No Data to show")
)
y
})
}
))
If you still want to show a "table" within the UI, do this:
output$table_output <- renderTable {
data <- data.frame(a = c(1,2),
b = c(8,9)) #example data.frame
if (nrow(data) > 0) {
data
} else {
datatable(data.frame(Nachricht = "Die ausgewählte Schnittstelle enthält hierfür keine Daten."))
}
}
Related
I am trying to build a shiny App that uses several modules which communicate between them and share data. I have tried to create a simpler example that could be replicated to show the problem I'm facing.
The first module allows the user to select a dataset and a column from the selected dataset and then display the column in a table. The server part of the first module returns a list of statistics about the selected column (min,mean, max and sd).
The idea is to use these statistics to display them in a second module which creates textOutputs. The problem is that there is no reactivity in the app. Even when changing the dataset and columns the values in the textOutputs is the same.
### Module 1
mod_selectVar_ui <- function(id){
ns <- NS(id)
tagList(
selectInput(ns("dataset"), "Choose a dataset:",choices = c("rock", "pressure", "cars")),
selectInput(ns("colonnes"),label = "Choose some columns", choices = NULL, multiple = FALSE),
tableOutput(ns("table"))
)
}
#'
#'
mod_selectVar_server <- function(id){
moduleServer(id, function(input, output, session){
datasetInput <- reactive({
switch(input$dataset,
"rock" = rock,
"pressure" = pressure,
"cars" = cars)
})
observe({
colonnes <- names(datasetInput())
updateSelectInput( session, "colonnes", choices = colonnes)
})
data <- reactive({
req(input$colonnes)
datasetInput()[, input$colonnes]
})
output$table <- renderTable({
head(data())
})
values <- reactive({
list(
meanVar = mean(data()),
maxVar = max(data()),
minVar = min(data()),
sdVar = sd(data())
)
})
return(values)
})
}
### Module 2
mod_textOu_ui <- function(id){
ns <- shiny::NS(id)
shiny::tagList(
shiny::textOutput(ns("txt"))
)
}
mod_textOu_server <- function(id, texte){
moduleServer(id,
function(input, output, session){
output$txt <- renderText({
texte
})
}
)
}
### Main App
ui <- fluidPage(
fluidRow(
column(3,
mod_textOu_ui("1")
),
column(3,
mod_textOu_ui("2")
),
column(3,
mod_textOu_ui("3")
),
column(3,
mod_textOu_ui("4")
)
),
fluidRow(
mod_selectVar_ui("1")
)
)
server <- function(input, output, session){
values <- mod_selectVar_server("1")
mod_textOu_server("1",values()$meanVar)
mod_textOu_server("2",values()$maxVar)
mod_textOu_server("3",values()$minVar)
mod_textOu_server("4",values()$sdVar)
}
shinyApp(ui ,server )
You have a duplicated ID 1 for you modules mod_selectVar_server("1") and mod_textOu_server("1",values()$meanVar). All IDs must be unique and using a number is not recommended.
Like #Limey said, you can't directly access the reactive value directly on the top level of your server. Reactive values must be accessed inside a reactive context. Pass the reactive directly to the function and access its value later inside your module.
When you change dataset, data will be invalid and it needs to wait for column names to update, so I added req(all(input$colonnes %in% names(datasetInput()))) to prevent the ugly red warnings that will briefly show up.
### Module 1
mod_selectVar_ui <- function(id){
ns <- NS(id)
tagList(
selectInput(ns("dataset"), "Choose a dataset:",choices = c("rock", "pressure", "cars")),
selectInput(ns("colonnes"),label = "Choose some columns", choices = NULL, multiple = FALSE),
tableOutput(ns("table"))
)
}
#'
#'
mod_selectVar_server <- function(id){
moduleServer(id, function(input, output, session){
datasetInput <- reactive({
switch(input$dataset,
"rock" = rock,
"pressure" = pressure,
"cars" = cars)
})
observe({
colonnes <- names(datasetInput())
updateSelectInput(session, "colonnes", choices = colonnes)
})
data <- reactive({
req(input$colonnes)
req(all(input$colonnes %in% names(datasetInput())))
datasetInput()[, input$colonnes]
})
output$table <- renderTable({
head(data())
})
values <- reactive({
list(
meanVar = mean(data()),
maxVar = max(data()),
minVar = min(data()),
sdVar = sd(data())
)
})
return(values)
})
}
### Module 2
mod_textOu_ui <- function(id){
ns <- shiny::NS(id)
shiny::tagList(
shiny::textOutput(ns("txt"))
)
}
mod_textOu_server <- function(id, texte, item){
moduleServer(id,
function(input, output, session){
output$txt <- renderText({
texte()[[item]]
})
}
)
}
### Main App
ui <- fluidPage(
fluidRow(
column(3,
mod_textOu_ui("m1")
),
column(3,
mod_textOu_ui("m2")
),
column(3,
mod_textOu_ui("m3")
),
column(3,
mod_textOu_ui("m4")
)
),
fluidRow(
mod_selectVar_ui("s1")
)
)
server <- function(input, output, session){
values <- mod_selectVar_server("s1")
mod_textOu_server("m1",values, "meanVar")
mod_textOu_server("m2",values, "maxVar")
mod_textOu_server("m3",values, "minVar")
mod_textOu_server("m4",values, "sdVar")
}
shinyApp(ui ,server )
I want to select a variable from the data and show the correlation between the selected variable and the variable that selected before. Happiness is my data and score is my selected variable that I choose. I have an error "invalid argument type" Thank you.
shinyApp(
ui = fluidPage(
titlePanel(),
varSelectInput("variable", "Variable:", happiness),
mainPanel(
p(),
p(),
fluidRow(
column(6,plotOutput(outputId="plotgraph1", width="300px",height="300px")),
column(6,plotOutput(outputId="plotgraph2", width="300px",height="300px")),
column(6,tableOutput(outputId="correl.out"))
)
)
),
server = function(input, output) {
output$plotgraph1 <- renderPlot({
ggplot(happiness, aes(x=!!input$variable,y=Score)) + geom_smooth()
})
output$plotgraph2 <- renderPlot({
ggplot(happiness, aes(x=!!input$variable)) + geom_histogram()
})
output$correl.out <- renderTable({
cor(x=!!input$variable,y=happiness$Score)
})
}
)
# We want to use multiple variables to select.
if (FALSE) {
shinyApp(
ui = fluidPage(
varSelectInput("variables", "Variable:", happiness, multiple = TRUE),
tableOutput("data")
),
server = function(input, output) {
output$data <- renderTable({
if (length(input$variables) == 0) return(happiness)
happiness %>% dplyr::select(!!!input$variables)
}, rownames = TRUE)
}
)}
}
)
I have a function Identify_IP() that returns a list of 1- dataframe
2-ggplot. I need to renderTable and renderPlot in ShinyApp. This shinyApp code renders only the dataframe. But I can't render the plot. Any help?
library(shiny)
source('InflectionP2.R', local = TRUE)
runApp(
list(
ui = fluidPage(
titlePanel("Upload your file"),
sidebarLayout(
sidebarPanel(
fileInput('file1', 'Choose xls file',
accept = c(".XLS")),
actionButton("btn", "Update Table"),
actionButton("btn1", "Display Plot"),
downloadButton('downloadData', 'Download')
),
mainPanel(
tableOutput('what'),
plotOutput('pl'))
)
)
,
server = function(input, output, session){
dataOP <- reactive({
inFile <- input$file1
if (is.null(input$file1))
return(NULL)
Identify_IP(read.table(inFile$datapath))
list(tble = df1, txt = inflection_points, plt = p )
})
observeEvent(input$btn, output$what <- renderTable({dataOP()$tble}))
observeEvent(input$btn1, output$pl <- renderPlot({
plot(dataOP()$plt)
}))
}
))
Using the following server worked for me:
server = function(input, output, session){
dataOP <- reactive({
inFile <- input$file1
if(is.null(input$file1)){
return(NULL)
}
#Identify_IP(read.table(inFile$datapath))
list(tble = c(1:20), txt = c(1:10), plt = rnorm(100))
})
observeEvent(input$btn,{
output$what <- renderTable({
dataOP()$tble
})
})
observeEvent(input$btn1,{
output$pl <- renderPlot({
plot(dataOP()$plt)
})
})
}
Note that I commented out your function Identify_IP and replaced the results with arbitrary values.
If this still doesn't work your problem probably is probably related to this function or with the values returned by the function, respectively.
I have a shiny app that a user can check whether they want the data table displayed in the main panel. Depending on the numericinput, if they select 1, only 1 datatable be displayed or if they select 2 it will display 2 datatables I am not so sure how to code this in shiny R since I am new to this. Thank you for looking into this.
Here is my code
library("shiny")
df1 <- data.frame("2010-01"=double(),
"2010-02"=double(),
"2010-03"=double(),
"2010-04"=double()
)
df1<-rbind(df1,setNames(as.list(c(10,20,30,40)), names(df2)))
df2 <- data.frame("2010-01"=double(),
"2010-02"=double(),
"2010-03"=double(),
"2010-04"=double()
)
df2<-rbind(df2,setNames(as.list(c(100,200,300,400)), names(df2)))
df3 <- data.frame("2010-01"=double(),
"2010-02"=double(),
"2010-03"=double(),
"2010-04"=double()
)
df3<-rbind(df3,setNames(as.list(c(1000,2000,3000,4000)), names(df2)))
ui <-fluidPage(
sidebarPanel(
checkboxInput("add_data", "Add Data Table(s)"),
conditionalPanel(condition="input.add_data === true",
numericInput("numofdata",
label="Number of Data Table(s):",
min = 1,
max = 3,
value = 1,
step = 1),
uiOutput("num_of_data"),
textOutput("see_ranges")
),
actionButton("submit", "Submit")
),
mainPanel(
titlePanel("Output Data Table"),
DT::dataTableOutput("datatable.view", width = "95%")
) # end of main panel
)
server <- function(input, output, session) {
output$num_of_data <- renderUI({
lapply(1:input$numofdata, function(i) {
print(trend_list())
})
})
output$see_ranges <- renderPrint({
print(trend_list())
})
data.filter <- reactive({
df(i)
})
output$datatable.view <- DT::renderDataTable(
{
input$submit
if (input$submit==0) return()
isolate({
for(i in 1:input$numoftrends) {
datatable(data.filter(i),
rownames=FALSE,
extensions = c("FixedColumns", "FixedHeader", "Scroller"),
options = list(searching=FALSE,
autoWidth=TRUE,
rownames=FALSE,
scroller=TRUE,
scrollX=TRUE,
pagelength=1,
fixedHeader=TRUE,
class='cell-border stripe',
fixedColumns =
list(leftColumns=2,heightMatch='none')
)
)
}
})
})
}
shinyApp(ui = ui, server = server)
You should look at this article:
http://shiny.rstudio.com/gallery/creating-a-ui-from-a-loop.html
You will seen then that one has to create multiple renderDataTable instead of muliple datatable within one renderDataTable().
Also in your code you call df like a function df() but it is only defined as a variable.
See a generic running example below.
EDIT: Changed dynamic part of UI.
library(DT)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectInput("amountTable", "Amount Tables", 1:10, 3)
),
mainPanel(
# UI output
uiOutput("dt")
)
)
)
server <- function(input, output, session) {
observe({
lapply(1:input$amountTable, function(amtTable) {
output[[paste0('T', amtTable)]] <- DT::renderDataTable({
iris[1:amtTable, ]
})
})
})
output$dt <- renderUI({
tagList(lapply(1:input$amountTable, function(i) {
dataTableOutput(paste0('T', i))
}))
})
}
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)