r - 日付を使用した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
        
    })
})

Date 列と Observation 列から分岐チェックボックスを作成する方法がわかりません。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

Dates から 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)