I have a case where I need to view a data table in Shiny with dynamic user-selected columns to view. This demo in Shiny Gallery was very insightful as a start. But when I applied it to my specific code where I use a data table rather than a data frame the main panel throws an error of "'data' must be 2-dimensional (e.g. data frame or matrix)". The only reason I got figure out for this error is that the input$show_vars does not work when the input data is a data table.
I present here two samples of codes to show the problem. The first one works well when the diamonds data is a data frame. The other one is the same code but the diamonds table is converted in data table in server section.
Appreciate any assistance to fix the code such that it works well when the input data is data table class.
Scenario1:
library(shiny)
library(ggplot2) # for the diamonds dataset
ui <- fluidPage(
title = "Examples of DataTables",
sidebarLayout(
sidebarPanel(
checkboxGroupInput("show_vars", "Columns in diamonds to show:",
names(diamonds), selected = names(diamonds))
),
mainPanel(
tabsetPanel(
tabPanel("diamonds", DT::dataTableOutput("mytable1")),
)
)
)
)
server <- function(input, output) {
# choose columns to display
diamonds2 = diamonds[sample(nrow(diamonds), 1000), ]
output$mytable1 <- renderDataTable({
diamonds2[, input$show_vars]
})
}
shinyApp(ui, server)
`
Scenario2:
library(shiny)
library(ggplot2) # for the diamonds dataset
ui <- fluidPage(
title = "Examples of DataTables",
sidebarLayout(
sidebarPanel(
checkboxGroupInput("show_vars", "Columns in diamonds to show:",
names(diamonds), selected = names(diamonds))
),
mainPanel(
tabsetPanel(
tabPanel("diamonds", DT::dataTableOutput("mytable1")),
)
)
)
)
server <- function(input, output) {
# choose columns to display
diamonds2 = as.data.table(diamonds[sample(nrow(diamonds), 1000), ])
output$mytable1 <- renderDataTable({
diamonds2[, input$show_vars]
})
}
shinyApp(ui, server)
Related
I have built a Shiny app and one page has a very wide reactable table. Some users are having trouble navigating the width of the table. How can I add horizontal and vertical scroll bars they can click and drag? Here is a minimal example.
library(shiny)
library(dplyr)
library(reactable)
ui <- fluidPage(
titlePanel("reactable example"),
reactableOutput("table")
)
iris_wide <- iris %>% bind_cols(iris) %>% bind_cols(iris) %>% bind_cols(iris) %>% bind_cols(iris) %>% bind_cols(iris) %>% bind_cols(iris)
server <- function(input, output, session) {
output$table <- renderReactable({
reactable(iris_wide)
})
}
shinyApp(ui, server)
Reactivity is working everywhere else in my app, but when I try to create a summary statistic table the table returns the name of the variable selected instead of the summary statistic:
ui <- selectInput('summary_metric', 'Select Metric', choices = c('height', 'weight'))
tableOuput('summary_table')
server <- function(input, output) {
output$summary_table <- renderTable({ data %>% group_by(Age_Group) %>%
summarise(min = min(input$summary_metric),
median = median(weight))})
Returns a table that reads:
Age_Group
min
median
18-29
weight
170
30-39
weight
180
40-49
weight
190
when 'weight' is selected in the UI and toggles to 'height' in the min column when 'height' is selected in the UI. So instead of calculating the minimum, it is just returning the variable name. Any thoughts as to what I'm missing?
I'm new to figuring out reactivity in shiny. I want to use selectInput to choose the name of a row and have the table display just that row and then several columns.
For example, if my rows are people ("Anna","Tim","Larry") and my columns are variables ("A","B","C") I want the selectInput to show "Anna" and the data table to display variables A,B, and C for only Anna.
I'm stuck on how to do this.
ui <- shinyUI(
fluidPage(
fluidRow(
column(2, selectInput("name", "Select a Name:",
c("Anna"= "smith.anna",
"Tim" = "miller.tim"))),
column(6, "People Table", tableOutput("mytable")
))))
server <- function(input, output) {
output$mytable <- renderTable({
mydataset[mydataset, input$name]})
}
I'm pretty sure it's my server functionality that's messed up, but all tips are helpful! Thanks!
See my comment:
mydataset <- data.frame(A = 1:3, B = 4:6, C = 7:9)
row.names(mydataset) <- c("smith.anna", "miller.tim", "page.larry")
ui <- shinyUI(
fluidPage(
fluidRow(
column(2, selectInput("name", "Select a Name:",
c("Anna"= "smith.anna",
"Tim" = "miller.tim"))),
column(6, "People Table", tableOutput("mytable")
))))
server <- function(input, output) {
output$mytable <- renderTable({
mydataset[input$name, ]
})
}
shinyApp(ui, server)
I want to add a checkbox that toggles the layers shown in a ggvis plot in a Shiny application.
library(shiny)
library(ggvis)
ui <- shinyUI(fluidPage(sidebarLayout(
sidebarPanel(
checkboxInput('loess','loess',TRUE)
),
mainPanel(
ggvisOutput("plot")
)
)))
server <- shinyServer(function(input, output) {
mtcars %>%
ggvis(~wt, ~mpg) %>%
layer_points() %>%
# if(input$loess) layer_smooths() %>%
bind_shiny("plot", "plot_ui")
})
shinyApp(ui = ui, server = server)
Is this possible to do in the ggvis pipeline using shiny the same gist as the commented line in the code above?
I don't think you can use the pipe directly for this. You also need to be in a reactive environment to access input$loess. You could do:
observe({
plot <- mtcars %>%
ggvis(~wt, ~mpg) %>%
layer_points()
if(input$loess) plot <- plot %>% layer_smooths()
plot %>% bind_shiny("plot", "plot_ui")
})
I am trying to build a shiny application where the output will say "The current week is x" where x is the week number. The problem in this case is my year starts on 3/30/2014 and I have defined a week to be from Sunday to Saturday which I am unable code properly resulting in erroneous output. I am attaching the code below. Any help will be greatly appreciated.
ui.R
library(shiny)
shinyUI(fluidPage(
sidebarLayout(
sidebarPanel(
dateInput('Start_Date',label = "Choose Date",value = Sys.Date())
),
mainPanel(
textOutput("text1")
),
)
))
server.R
library(shiny)
shinyServer(function(input, output) {
output$text1<-renderText({
paste("The current week is",ceiling(abs(difftime(as.Date("3/30/2014","%m/%d/%y"),as.Date(input$Start_Date),by="weeks"))/7))
})
})
I think you had small problem with formatting. I have added the start the day from which the year start too (so if you want your count to start from Sunday you can specify) so you can change it if you want.
rm(list = ls())
library(shiny)
ui = fluidPage(
sidebarLayout(
sidebarPanel(
dateInput('Year_starts',label = "Count From",value = as.Date("2014/03/30")),
dateInput('Start_Date',label = "Choose Date",value = Sys.Date())
),
mainPanel(
textOutput("text1")
),
)
)
server = function(input, output) {
output$text1<-renderText({
dates <- seq(input$Year_starts, as.Date(input$Start_Date), by = "weeks")
length(dates)-1
})
}
runApp(list(ui = ui, server = server))