使用treeInput过滤字符串

o7jaxewo  于 2023-11-14  发布在  其他
关注(0)|答案(1)|浏览(97)

我试图使用treeInputs过滤一个框架,但我很难过滤后者时,检查只有孩子框。你能帮助我实现这一点,请?下面的一个例子:

library(shiny)
library(shinydashboard)
library(shinyWidgets)
library(DT)

df <- data.frame(Parent=c("A", "A", "A", "B", "B"),
                 Child = c("1", "2", "3", "1", "2"),
                 Name = c("John", "Martin", "Emma", "Charlotte", "Olivia"))

ui <- dashboardPage(
  dashboardHeader(title = "Title"),
  dashboardSidebar(
    # tree filter
    treeInput("filter", "Myfilter", choices = create_tree(df[,c("Parent","Child")]))
  ),
  dashboardBody(
    # datatable
    dataTableOutput("table")
  )
)

# Serveur
server <- function(input, output) {
  filtered_data <- reactive({
    filtered <- df
    # filtering for parent boxes
    filtered <- filtered[filtered$Parent %in% sapply(input$filter, function(x) x[1]), ]
    # filtering for children boxes
    #### struggling here
    return(filtered)
  })
  
  output$table <- renderDataTable({
    datatable(filtered_data(), options = list(pageLength = 10))
  })
  
}

shinyApp(ui, server)

字符串

rslzwgfq

rslzwgfq1#

我们的想法是从treeInput返回ids(而不是模糊的标签)。然后,我们需要做的“所有”就是在树id和原始 Dataframe 的行之间创建一个Map。
这并不是非常简单,但是我们可以使用library(data.tree)来减少树遍历的痛苦。

library(shiny)
library(shinydashboard)
library(shinyWidgets)
library(DT)
library(dplyr)
library(purrr)
library(magrittr)
library(data.tree)

df <- data.frame(Parent = c("A", "A", "A", "B", "B"),
                 Child = c("1", "2", "3", "1", "2"),
                 Name = c("John", "Martin", "Emma", "Charlotte", "Olivia"))

## more complicated data set to show that the solution generalizes to 
## arbitrary netsing levels
df2 <- expand.grid(
  x = LETTERS[1:4],
  y = letters[1:3],
  z = 1:4
) %>% 
  mutate(val = paste(x, y, z))

create_tree2 <- function(df, cols) {
  ## 1. Add id to the original data set
  df <- df %>% 
    mutate(.id = 1:n())
  ## 2. Create the tree structure
  ctree <- create_tree(df, cols)
  ## 3. Cast it to a data.tree::Node for less painful tree traversal
  tree <- FromListExplicit(list(children = ctree), nameName = "text")
  ## 4. Leaves in the tree correspond to rows in the original data frame
  leaves <- Traverse(tree, filterFun = isLeaf)
  ## 5. This function generates a list of filter criteria to be used on the original
  ##    data frame. Basically it says look in the corresponding column 
  ##    (determined by level) and return matching rows, go to the parent of the node 
  ##    and add another filter until you reach the root. Eventually we get a list
  ##    of filter criteria which identifies each row unambiguously, Then pull the
  ##    id in the original data.frame
  get_df_id <- function(leaf) {
    walk_up <- function(leaf) {
      if (!leaf$isRoot) {
        c(list(quo(as.character(!!sym(cols[leaf$level - 1L])) == !!leaf$name)), 
          Recall(leaf$parent))
      }
    }
    filter_criteria <- walk_up(leaf)
    df %>% 
      filter(!!!filter_criteria) %>% 
      pull(.id)
  }
  ## 6. Return
  ##    - the original data.frame ammended by the data frame id
  ##    - the tree to be used in treeInput
  ##    - the lookup table which matches tree ids to data frame rows
  list(df = df,
       tree = ctree,
       lkp = map_dfr(leaves, function(leaf) {
         tibble(tree_id = leaf$id, df_id = get_df_id(leaf))
       })
  )
}

tree <- create_tree2(df, c("Parent", "Child"))
# tree <- create_tree2(df2, c("x", "y", "z"))

ui <- dashboardPage(
  dashboardHeader(title = "Title"),
  dashboardSidebar(
    treeInput("filter", "Myfilter", choices = tree$tree,
              returnValue = "id")
  ),
  dashboardBody(
    dataTableOutput("table")
  )
)

server <- function(input, output) {
  filtered_data <- reactive({
    tree$lkp %>% 
      filter(tree_id %in% input$filter) %>% 
      inner_join(tree$df, c(df_id = ".id")) %>% 
      select(-df_id, -tree_id)
  })
  
  output$table <- renderDataTable({
    datatable(filtered_data(), options = list(pageLength = 10))
  })
  
}

shinyApp(ui, server)

字符串

相关问题