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)
Related
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)
Need help. Below is the application. ColB is to be colored based on numbers in ColA. Below is the condition table
Just to brief : if ColB is 2, So it is lesser than 6 (12/2), it should be red and similarly for others. I tried to build the code myself and came up with below . But looks like there is some issue in the code . I have attached the output also below and the logic is not working properly.
---
title: "Untitled"
runtime: shiny
output:
flexdashboard::flex_dashboard:
orientation: columns
vertical_layout: fill
---
```{r setup, include=FALSE}
library(flexdashboard)
library(DT)
```
```{r}
tab1 <- data.frame(ColA = c(12,34,45,56), ColB = c(2,32,30,56))
```
Column {data-width=650}
-----------------------------------------------------------------------
### Chart A
```{r}
DT::DTOutput("table1")
output$table1 <- DT::renderDT(
datatable(tab1))
```
Below is the output I got
So As per the code, the highlighted arrows are showing color.
First Arrow (Supposed to be red but it is showing as Yellow)
Second Arrow (Supposed to be Yellow but it is showing as Green)
Note : ColB is randomly generated and you may not see these numbers when you run it. But you observe randomly, this issue you will find for sure when you run as well. Not sure what is wrong in the code . Below is the code for your reference
You could use formatStyle from DT (link):
---
title: "Untitled"
runtime: shiny
output:
flexdashboard::flex_dashboard:
orientation: columns
vertical_layout: fill
---
```{r setup, include=FALSE}
library(flexdashboard)
library(tidyverse)
library(DT)
```
```{r}
tab1 <- data.frame(ColA = c(12,34,45,56), ColB = c(2,32,30,56)) %>%
dplyr::mutate(backgroundColB = case_when(
ColA==ColB ~ 1,
ColA/2>ColB ~ -1,
ColA/2<ColB ~ 0
))
```
Column {data-width=650}
-----------------------------------------------------------------------
### Chart A
```{r}
DT::DTOutput("table1")
output$table1 <- DT::renderDT(
datatable(tab1, options=list(columnDefs = list(list(visible=FALSE, targets=2)))) %>%
formatStyle('ColB', "backgroundColB",
backgroundColor = styleInterval(c(-.5,.5), c("red","yellow","green") ))
)
```
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))