The following code allows the user to select between 2 datasets in a dropdown and displays all of the columns for the selected dataset. I would like to add a second dropdown that is dynamically cast with the names of the columns in the selected first dropdown so that the user can select to display a single column only. The goal is to be able to add any dataset to the first dropdown and have it's columns listed in the second dropdown.
library(shiny)
ui <- shinyUI(
fluidPage(
selectInput("dataset", label = NULL, choices = c("mtcars", "rock")),
tableOutput("contents")
)
)
server <- function(input, output, session) {
myData <- reactive({
switch(input$dataset,
"rock" = rock,
"mtcars" = mtcars)
})
output$contents <- renderTable({
myData()
})
observe({
updateSelectInput(session, "myNames",
label = "myNames",
choices = myData()$names,
selected = myData()$names[1])
})
}
shinyApp(ui, server)
Perhaps you are looking for this
library(shiny)
ui <- shinyUI(
fluidPage(
selectInput("dataset", label = NULL, choices = c("mtcars", "rock")),
uiOutput("selectvar"),
plotOutput("contents")
)
)
server <- function(input, output, session) {
myData <- reactive({get(input$dataset)})
output$selectvar <- renderUI({
selectInput("varsel", label=NULL, choices=names(myData()), multiple=T)
})
output$contents <- renderPlot({
req(input$varsel[1],input$varsel[2])
ggplot(myData(), aes(x=.data[[input$varsel[1]]], y=.data[[input$varsel[2]]] )) + geom_point()
})
}
shinyApp(ui, server)
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 )
in Shiny I simply want to select which variable of a dataframe shall be plotted and I do not want to have to type all the variable names in the server switch part. Here is what I do:
ui <- fluidPage(
titlePanel("Hello World!"),
sidebarLayout(
sidebarPanel(
selectInput("variable", "Choose a variable:",
# choices = c("cyl", "mpg")),
choices = names(mtcars)),
),
mainPanel(
plotOutput(outputId = "BarPlot"),
)
)
)
server <- function(input, output) {
datasetInput <- reactive({
switch(input$variable,
"cyl" = mtcars[,"cyl"],
"mpg" = mtcars[,"mpg"])
})
output$BarPlot <- renderPlot({
x <- datasetInput()
barplot(table(x))
})
}
Instead of
switch(input$variable,
"cyl" = mtcars[,"cyl"],
"mpg" = mtcars[,"mpg"])
can I do something like
choices = mtcars[,get(choices)]
to cover all choices without having to type them one by one?
One approach is to use varSelectInput and pass the data frame as data (it will include all column names as the choices). Then you can extract the selected column from mtcars through mtcars[[input$variable]] in your example:
library(shiny)
ui <- fluidPage(
titlePanel("Hello World!"),
sidebarLayout(
sidebarPanel(
varSelectInput("variable",
"Choose a variable:",
data = mtcars),
),
mainPanel(
plotOutput(outputId = "BarPlot"),
)
)
)
server <- function(input, output) {
datasetInput <- reactive({
mtcars[[input$variable]]
})
output$BarPlot <- renderPlot({
x <- datasetInput()
barplot(table(x))
})
}
shinyApp(ui, server)
I want to display selected feature of selected data in R Shiny.
To select data I use select input (with reactivity) , and to choose features of selected dataset use checkboxGroupInput.
I know there is some mistake in my code. Here is my code how can I act it?
Server- Code
Data_to_display <<- reactive({
switch(input$Data,
"dt_1" = Data1,
"dt_2" = Data2)
})
output$DisplayData <- DT::renderDataTable({
DT::datatable(Data_to_display(), filter="top")
})
UI.Code
------
sidebarLayout(
sidebarPanel(
checkboxGroupInput("show_vars", "Gösterilecek özellikler:",
names(Data), selected = names(Data)),
selectInput("Data", "Choose data:", choices = c("dt_1","dt_2"), selected = "dt_1")
),
mainPanel(
DT::dataTableOutput("DisplayData")
)
Looks like you're calling a reactive input (Data) in the ui. To build dynamic UI that reacts to user input, you can create the UI element on the server and then output the element in the ui.
However, I'm not sure of your exact goal. If you'd like to hide/show columns in the datatable there is a DT extension (colvis) for exactly that purpose.
I've added two examples below -- one with dynamically rendered checkboxes and another with the DT extension for hiding/showing columns.
1) Dynamically created checkboxes:
Data1 <- iris
Data2 <- mtcars
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectInput("Data", "Choose data:",
choices = c("dt_1","dt_2"), selected = "dt_1"),
## render dynamic checkboxes
uiOutput("show_vars")
),
mainPanel(
DT::dataTableOutput("DisplayData")
)
)
)
server <- function(input, output) {
Data_to_display <<- reactive({
switch(input$Data,
"dt_1" = Data1,
"dt_2" = Data2)
})
### create dynamic checkboxes
output$show_vars <- renderUI({
checkboxGroupInput("show_vars", "Gösterilecek özellikler:",
choices = names(Data_to_display()),
selected = names(Data_to_display()))
})
output$DisplayData <- DT::renderDataTable({
DT::datatable(Data_to_display(), filter="top")
})
}
shinyApp(ui, server)
2) DT extension colvis:
Data1 <- iris
Data2 <- mtcars
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectInput("Data", "Choose data:",
choices = c("dt_1","dt_2"), selected = "dt_1")),
mainPanel(
DT::dataTableOutput("DisplayData")
)
)
)
server <- function(input, output) {
Data_to_display <<- reactive({
switch(input$Data,
"dt_1" = Data1,
"dt_2" = Data2)
})
### hide/show columns with built-in DT extension
output$DisplayData <- DT::renderDataTable({
DT::datatable(Data_to_display(), filter = "top",
extensions = 'Buttons',
options = list(dom = 'Bfrtip', buttons = I('colvis')))
})
}
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)
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."))
}
}