使用日期的闪亮树复选框

如何解决使用日期的闪亮树复选框

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

最终选择将是来自先前选择的名称的独特观察结果。每个名称都可以有很多观察结果，因此我希望能够使用日期来选择特定的观察结果。我当前代码的示例如下。我可以根据名称更新复选框输入以显示名称的所有观察结果。

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","2021-01-01","2021-01-15","2021-01-15"),Name = c("Bob","Fred","George","Bob","George"),score = c(1L,4L,1L,2L,3L,1L),Colour = c("Red","Blue","Green","Red"),Year = c(2020L,2020L,2021L,2021L),Month = c(12L,12L,Day = c(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"))

解决方法

我找到了从日期创建闪亮树的解决方案。代码如下。我还没有弄清楚如何根据日期输入过滤反应式 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)