Skip to content

Instantly share code, notes, and snippets.

@haozhu233
Created January 9, 2017 16:23
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save haozhu233/dbf4cc45b5cc0e8a8397efac21e70d87 to your computer and use it in GitHub Desktop.
Save haozhu233/dbf4cc45b5cc0e8a8397efac21e70d87 to your computer and use it in GitHub Desktop.
Shiny - Create A Table whose cells can be toggled on and off with clicks
library(shiny)
library(ggplot2)
library(dplyr)
server <- function(input, output, session){
weekdays <- c("Sunday", "Monday", "Tuesday", "Wednesday",
"Thursday", "Friday", "Saturday")
rv <- reactiveValues(
dt = data.frame(
days = factor(unlist(lapply(weekdays, rep, 24)), rev(weekdays)),
hours = 0:23,
status = 0
)
)
output$plot <- renderPlot({
rv$dt %>%
mutate(status = factor(status, 0:1, c("Blocked", "Allowed"))) %>%
ggplot(aes(hours, days, fill = status)) +
geom_tile(color = "white") +
scale_x_continuous(expand = c(0, 0),
breaks = seq(-0.5, 22.5, 1),
label = 0:23) +
scale_y_discrete(expand = c(0, 0)) +
theme(axis.ticks.y = element_blank())
})
observeEvent(input$plot_click, {
plot_click_x <- round(input$plot_click$x)
plot_click_y <- factor(round(input$plot_click$y), 1:7, rev(weekdays))
rv$dt$status[rv$dt$days == plot_click_y & rv$dt$hours == plot_click_x] <-
1 - rv$dt$status[rv$dt$days == plot_click_y & rv$dt$hours == plot_click_x]
})
}
ui <- fluidPage(
plotOutput("plot", click = "plot_click")
)
shinyApp(ui, server)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment