Question

是否可以通过单击并返回包含所选单元格和行数的数据结构来创建可以打开和关闭单元格的表格？

类似于Windows 7中的家长控制界面，可以在一天的特定时间启用和禁用帐户。

Answer 1

正如评论中所提到的，这是DT的解决方案：

library(shiny)
library(dplyr)
library(DT)

toggleTable <- matrix(" ", nrow = 7, ncol = 24, 
                      dimnames = list(
                        c("Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday"), 
                        seq.int(1, 24, 1)))

server <- function(input, output, session){

  output$userChoiceTbl <- DT::renderDataTable({

    datatable(toggleTable,
              options = list(dom = 't',
                             ordering = F),
              selection = list(target = 'cell'),
              class = 'cell-border compact') %>%
      formatStyle(1:24, cursor = 'pointer')

  })

  output$selectedInfo <- renderPrint({
    input$userChoiceTbl_cells_selected
  })
}

ui <- fluidPage(
  DT::dataTableOutput("userChoiceTbl", width = "50%"),
  tags$b("Cells Selected:"),
  verbatimTextOutput("selectedInfo")
)

shinyApp(ui = ui, server = server)

Answer 2

查看这个要点：https://gist.github.com/haozhu233/dbf4cc45b5cc0e8a8397efac21e70d87

我在这里使用ggplot但你可以尝试使用htmlwidget，比如d3heatmap，所以颜色变化可能发生在前端。

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)

闪亮 - 创建一个表格，其单元格可以通过点击切换打开和关闭

2 个答案: