使用 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) 將 rowBlock 函數與lapply一起使用，但這需要兩個參數：第一列是列表元素的文本，第二列是元素的懸停文本。

這不太有效，但也許很接近？？？

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()在rowBlock()每個數據幀中的行上迭代tippy() ，然后map() tags$li()在這些 tippy 輸出上迭代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)

這是一張圖片。