I am trying to create a sidebar that outputs the columns of a datatable and the number of unique values in each column. The code below works for the names but when it comes to the unique values I can only get it to display if the list variable is unlist()ed. I could not find any articles that talk about getting a textOutput or equivalent that would handle a list variable across multiple rows.
library(shiny)
data(mtcars)
if (interactive()) {
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
fluidRow(
column(6, checkboxGroupInput("dsnamesGrp","Variable name")),
column(6, uiOutput("dsordsGrp"), inline= FALSE)
)
),
mainPanel(
dataTableOutput('contents'))
)
)
server <- function(input, output, session) {
output$contents <- renderDataTable({mtcars})
dsnames <- list()
dsnames <- names(mtcars)
cb_options <- list()
cb_options[dsnames] <- dsnames
updateCheckboxGroupInput(session, "dsnamesGrp",
label = "Column name",
choices = cb_options,
selected = "")
ord_values <- list()
ord_values <- lapply(mtcars, function(x)length(unique(x)))
output$dsordsGrp <- renderText({unlist(ord_values)})
}
}
shinyApp(ui, server)
We can use the lengths on the unique elements on the list
ord_values <- lengths(lapply(mtcars, unique))
output$dsordsGrp <- renderText({ord_values})
-full code
library(shiny)
data(mtcars)
if (interactive()) {
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
fluidRow(
column(6, checkboxGroupInput("dsnamesGrp","Variable name")),
column(6, htmlOutput("dsordsGrp"), inline= FALSE)
)
),
mainPanel(
dataTableOutput('contents'))
)
)
server <- function(input, output, session) {
output$contents <- renderDataTable({mtcars})
dsnames <- names(mtcars)
cb_options <- list()
cb_options[dsnames] <- dsnames
updateCheckboxGroupInput(session, "dsnamesGrp",
label = "Column name",
choices = cb_options,
selected = "")
output$dsordsGrp <- renderUI({
HTML(paste(lengths(lapply(mtcars, unique)), collapse="<br/>"))
})
}
}
shinyApp(ui, server)
Or if we are using the same code as in the OP, instead of lapply (always returns a list output) use sapply which returns a vector because the default argument is simplify = TRUE and with that it uses the simplify2array
ord_values <- sapply(mtcars, function(x)length(unique(x)))
output$dsordsGrp <- renderText({ord_values})
EDIT: changed renderText to renderUI
Related
I'm exploring shiny and I'm trying to do some app that does the following:
Let the user choose between two (or more) different data.frames (in my example I use mtcars and iris but I'm planning to use some self-made data.frames.
Select some X and Y variables according to the data.frame selected
Plot a simple x-y scatterplot
Code below:
df_list <- list(cars= mtcars, iris= iris)
ui <- fluidPage(
titlePanel("Simple app"),
sidebarLayout(
sidebarPanel(
selectInput("data", "Choose a database",
choices=ls(df_list), selected=ls(df_list[1])),
selectInput("xcol", "Variable X", names(data)),
selectInput("ycol", "Variable Y", names(data))),
mainPanel(
plotOutput(outputId = "plot")
)
)
)
server <- function(input, output) {
selectedData <- reactive( {
data[, c(data$xcol, data$ycol)]
})
output$plot <- renderPlot({plot(selectedData())})
}
shinyApp(ui, server)
I feel I have two problems. The first one is pretty obvious since I can't make the app displays variables according to the data.frame selected. Second one is that I feel I'm missing something in my server function (I guess that's related with my first problem) so no plot is displayed.
Any help will be much appreciated.
You had a few issues. The following should work.
df_list <- list("mtcars", "iris")
ui <- fluidPage(
titlePanel("Simple app"),
useShinyjs(),
sidebarLayout(
sidebarPanel(
selectInput("data", "Choose a database",
choices=df_list, selected=df_list[[1]]),
selectInput("xcol", "Variable X", c()),
selectInput("ycol", "Variable Y", c())),
mainPanel(
plotOutput(outputId = "plot")
,DTOutput("t1")
)
)
)
server <- function(input, output, session) {
mydata <- eventReactive(input$data, {
get(input$data)
})
observeEvent(input$data, {
req(mydata())
choices <- names(mydata())
updateSelectInput(session,"xcol",choices = choices, selected=choices[1])
updateSelectInput(session,"ycol",choices = choices, selected=choices[2])
}, ignoreNULL = FALSE)
output$t1 <- renderDT({mydata()})
output$plot <- renderPlot({
req(mydata(),input$xcol,input$ycol)
if (is.null(mydata()) | !(input$xcol %in% colnames(mydata())) | !(input$ycol %in% colnames(mydata())) ) {
return(NULL)
} else{
selected_df <- mydata() %>% select(input$xcol, input$ycol)
plot(selected_df)
}
})
}
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 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 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."))
}
}