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)
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)
From the code, renderUI in server is disconnected to the main variable selection, so as print textOutput() to main pannel.
I'm trying to build a shiny app has three inputs at the sidebar of
selecting a main variable
the levels of the selected main variable to choose(multiple)
options of adding columns, and then print selected data at the main panel
for example, with iris,
I choose Species
level should show options of "setosa" "versicolor" "virginica" but which is not showing
I can add other columns
But the selected rows and columns are not printed at the main panel
data <- iris
ui <- fluidPage(
titlePanel("Data selection"),
sidebarLayout(
sidebarPanel(
selectizeInput("show_vars", "Main column:",
choices = colnames(data), multiple = FALSE),
uiOutput("category1"),
selectInput("add_col", "Add columns to display", names(data), multiple = TRUE)
),
mainPanel(
textOutput("selected")
)
)
)
server <- function(input, output,session) {
output$category1 <- renderUI({
selectizeInput('cat1', 'Levels from main column', choices = levels(input$show_vars), multiple = TRUE)
})
df_subset <- eventReactive(input$cat1,{
columns = names(data)
if(input$cat1=="All") {df_subset <- data}
else{df_subset <- data[data$Category1 == input$cat1, columns]}
})
output$selected <- renderText({ df_subset() })
}
shinyApp(ui, server)
Perhaps you are looking for this
data <- iris
ui <- fluidPage(
titlePanel("Data selection"),
sidebarLayout(
sidebarPanel(
selectInput("show_vars", "Main column:",
choices = colnames(data), multiple = FALSE),
uiOutput("category1"),
selectInput("add_col", "Add columns to display", names(data), multiple = TRUE)
),
mainPanel(
DTOutput("selected")
)
)
)
server <- function(input, output,session) {
output$category1 <- renderUI({
req(input$show_vars)
selectInput('cat1', 'Levels from main column', choices = c('All',levels(data[,input$show_vars])), multiple = TRUE)
})
df_subset <- reactive({
req(input$cat1,input$add_col)
columns <- names(data) %in% input$add_col
if(input$cat1=="All") {dfsubset <- data[,columns]}
else {dfsubset <- data[data[,input$show_vars] == input$cat1, columns]}
dfsubset <- as.data.frame(dfsubset)
})
output$selected <- renderDT({ df_subset() })
}
shinyApp(ui, server)
I am using R shiny to develop a interactive analysis tool. Now I want to do classification tree based on variables check in checkboxGroupInput. How can I select that subset of data? THX!
UI:
dateInput("date","Enter date:",value = date),
checkboxGroupInput("variable", "Variable:",
choices = names ,selected = names
)
server I tried, but doesn't work:
dataall <- reactive({
filename <- paste0("dataall_'", input$date, "'.RData")
load(filename)
feature.test[,names(feature.test) %in% input$variable]
})
feature.test is data in loaded file.
Hard to understand what you want since you don't subset the file you load. What is feature.test ?
Here is a simple example to how to subset a data frame using an input and shiny reactivity :
shiny::runApp(list(
ui = basicPage(
selectInput("specy", "Specy", choices = levels(iris$Species)),
tableOutput("content")
),
server = function(input, output, session) {
output$content <- renderTable({
iris[iris$Species == input$specy, ]
})
}
))
EDIT ## :
Subset by column :
shiny::runApp(list(
ui = pageWithSidebar(
headerPanel("Example"),
sidebarPanel(
checkboxGroupInput("variable", "Variable:", choices = names(iris))
),
mainPanel(
tableOutput("content")
)
),
server = function(input, output, session) {
output$content <- renderTable({
if(is.null(input$variable))
return()
iris[input$variable]
})
}
))
"variable" is supposed to be "date" since this is the control that you are referencing in the UI part, as in:
checkboxGroupInput( "date", "Variable:",
choices = names ,selected = names
)
For data.table you need to add a ,with=FALSE or use a temporary variable in the server code:
# Load libraries
library(shiny)
library(data.table)
# Copy dataset
irisDT=copy(iris)
setDT(irisDT)
# Shiny app
shiny::runApp(list(
# UI
ui = pageWithSidebar(
headerPanel("Example"),
sidebarPanel(
checkboxGroupInput("variable", "Variable:", choices = names(iris))
),
mainPanel(
tableOutput("content")
)
),
# Server
server = function(input, output, session) {
output$content <- renderTable({
if(is.null(input$variable))
return()
# iris[input$variable] # data.frame
irisDT[, input$variable, with=FALSE] # data.table
# Alternatively:
# tmp <- input$variable
# irisDT[, ..tmp]
})
}
))
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."))
}
}