使用日期的shinyTree复选框

Question

我正在尝试创建一个分支复选框输入，使用与下图类似的日期。

​

​

最后的选择将是从先前选定的名称中进行的唯一观察。每个名称都可能有许多观察结果，所以我希望能够使用日期来选择特定的日期。下面是我当前代码的一个示例。我能够根据名称更新复选框输入，以显示所有名称的观察结果。

ui.r

library(shiny)
library(dplyr)

shinyUI(
    fluidPage(
        navbarPage(inverse = TRUE,
                   tabPanel("Page Title",
                            sidebarPanel(width = 4,
                                         selectizeInput("Name",
                                                        label = "Name",
                                                        choices = sort(unique(mydata$Name))
                                         ),
                                         checkboxGroupInput("Observation",
                                                            label = "Observation",
                                                            choices = sort(unique(mydata$Observation))
                                         )
                            )
                            ,
                            mainPanel(
                                tableOutput("RepDimTable")
                            ))
                   
        )))

server.r

library(shiny)
library(dplyr)

shinyServer(function(input, output, session){
    
    dat <- reactive({
        
        d <- mydata %>%
            filter(Name == input$Name)
        
        updateCheckboxGroupInput(session, "Observation", choices = unique(d$Observation))
        
        d
        
    })
    
    
    output$RepDimTable = renderTable({

        repDimReactive = dat()   %>%
            filter(Observation %in% input$Observation) %>%
            select(Observation, Date, Name, Colour, Score)
        
        repDimReactive
        
    })
})

我不知道如何从日期和观察列创建分支复选框。我尝试过shinyTree解决方案，但不知道如何将日期和观察结果嵌套到有用的列表表单中。

数据

mydata <- structure(list(Observation = 1:8, Date = c("2020-12-01", "2020-12-01", 
"2020-12-01", "2021-01-01", "2021-01-01", "2021-01-01", "2021-01-15", 
"2021-01-15"), Name = c("Bob", "Fred", "George", "Bob", "Bob", 
"George", "Fred", "George"), Score = c(1L, 4L, 1L, 2L, 2L, 3L, 
2L, 1L), Colour = c("Red", "Blue", "Blue", "Green", "Blue", "Blue", 
"Green", "Red"), Year = c(2020L, 2020L, 2020L, 2021L, 2021L, 
2021L, 2021L, 2021L), Month = c(12L, 12L, 12L, 1L, 1L, 1L, 1L, 
1L), Day = c(1L, 1L, 1L, 1L, 1L, 1L, 15L, 15L)), row.names = c(NA, 
8L), class = "data.frame", na.action = structure(9:22, .Names = c("9", 
"10", "11", "12", "13", "14", "15", "16", "17", "18", "19", "20", 
"21", "22"), class = "omit"))

Answer 1

我找到了一个从日期创建shinyTree的解决方案。下面的代码。我还没有搞清楚如何根据日期输入过滤反应df，但是代码回答了原来的问题。数据与上述相同。

mydata = mydata %>%
    mutate(Year = factor(Year),
                      Month = factor(Month),
                      Day = factor(Day))

treelist = list()

library(dplyr)
library(shiny)
library(shinyTree)

ui <- shinyUI(
    fluidPage(
        navbarPage(inverse = TRUE,
                   tabPanel("Page Title",
                            sidebarPanel(width = 4,
                                         selectizeInput("Name",
                                                        label = "Name",
                                                        choices = sort(unique(mydata$Name))
                                         ),
                                         shinyTree("tree")
                            )
                            ,
                            mainPanel(
                                tableOutput("RepDimTable")
                            ))
                   
        )))


server <- shinyServer(function(input, output, session){
    
    dat <- reactive({
        
        d <- mydata %>%
            filter(Name == input$Name)
        
        for (j in unique(d$Year)) {
            tmp <- d[d$Year == j, ]
            subtreelist <- list()
            for (i in unique(tmp$Month)) {
                childs <- as.list(rep("", length(tmp[tmp$Month == i, 1])))
                names(childs) <- tmp[tmp$Month == i, "Day"]
                subtreelist[[i]] <- childs
            }
            treelist[[j]] <- subtreelist
        }
        
        updateTree(session, treeId = ("tree"), data = treelist)
        
        d
        
    })
    
    output$tree <- renderTree({
        treelist
    })
    
    
    output$RepDimTable = renderTable({
        
        repDimReactive = dat()   %>%
            filter(Observation %in% input$Observation) %>%
            select(Observation, Date, Name, Colour, Score)
        
        repDimReactive
        
    })
    
})


shinyApp(ui = ui, server = server)