使用 lapply 和 map 遍历数据框列表中的列

Question

我想创建一个基于数据框列表datalist 的动态 HTML 列表。我的数据是一个数据框列表，每个数据框都有两列（不一定同名）。我总是希望每个数据框的第一列是列表元素，第二列是悬停时看到的文本（使用tippy）。

library(shiny)
library(tippy)



# list of dataframes
datalist <- list(data.frame(A = c("col_1", "col_2", "col_3"), B = c("val_1", "val_2", "val_3")),
                 data.frame(X = c("col_4", "col_5", "col_6"), Y = c("val_4", "val_5", "val_6")),
                 data.frame(A = c("col_7", "col_8", "col_9"), B = c("val_7", "val_8", "val_9")))



# named list
names(datalist) <- c("Group 1", "Group 2", "Group 3")

ui <-
  # rowPalette(datafile)
  # Should give me this:
  tagList(
    div(h1("Group 1"),
        tags$li(tippy("col_1", "val_1")),
        tags$li(tippy("col_2", "val_2")),
        tags$li(tippy("col_3", "val_3"))),

    div(h1("Group 2"),
        tags$li(tippy("col_4", "val_4")),
        tags$li(tippy("col_5", "val_5")),
        tags$li(tippy("col_6", "val_6"))),

    div(h1("Group 3"),
        tags$li(tippy("col_7", "val_7")),
        tags$li(tippy("col_8", "val_8")),
        tags$li(tippy("col_9", "val_9")))
  )

server <- function(input, output) {
}


shinyApp(ui = ui, server = server)

上面的代码会产生一个重复的输出，循环遍历每个数据帧中的每一行。我写了一个可以创建单个列表元素的函数：

# Create function for single li
# name will be col_ and hover with be val_
rowBlock <- function(name) {
  tags$li(tippy(name, name))
}
# rowBlock("test", "tooltip") prints test with a tooltip "tooltip"

我想我可能会使用这个函数来创建第二个函数，它将遍历列表中的每个数据帧并

1) 给它一个取自names(datalist)的标题

2) 使用带有lapply 的rowBlock 函数，但这需要两个参数：第一列是列表元素的文本，第二列是元素的悬停文本。

这不太行，但也许它很接近？？？

rowPallete <- function(data) {
  Map(function(x, y, z)
  div(h5(x),
      tags$ul(rowBlock(y, z))),
  names(data),
  data[[1]][[1]], #I'm not looping through these properly
  data[[1]][[2]]  #I'm not looping through these properly
  )
}

谁能帮助我使用 datalist 作为函数输入来动态实现所需的输出？

Answer 1

您可以使用purrr 中的map2() 来迭代两个相等长度的项目。

在rowBlock() 中，我们可以使用apply() 对来自datalist 的每个数据帧中的行进行迭代tippy()，然后使用map() 对这些尖端输出进行迭代tags$li()。

我不得不重新调整一些项目的顺序，所以这是完整的代码块。

library(shiny)
library(tippy)

# list of dataframes
datalist <- list(data.frame(A = c("col_1", "col_2", "col_3"), B = c("val_1", "val_2", "val_3")),
                 data.frame(X = c("col_4", "col_5", "col_6"), Y = c("val_4", "val_5", "val_6")),
                 data.frame(A = c("col_7", "col_8", "col_9"), B = c("val_7", "val_8", "val_9")))

# named list
names(datalist) <- c("Group 1", "Group 2", "Group 3")

library(purrr)

rowPallete <- function(data) {
  map2(names(data),
       data,
       ~div(h5(.x),
            tags$ul(rowBlock(.y)))) %>% 
    map(.,
        tagList)
}

rowBlock <- function(name) {
  apply(name,
        1,
        function(x){tippy(paste(x[1]), paste(x[2]))}) %>%
    map(.,
        ~tags$li(.x))
}



ui <-
  tagList(rowPallete(datalist))

server <- function(input, output) {
}


shinyApp(ui = ui, server = server)

这是一张图片。