l oop через столбцы в списке данных, используя lapply и map - PullRequest
Новая
       32

l oop через столбцы в списке данных, используя lapply и map

0 голосов
/ 11 февраля 2020

Я хотел бы создать динамический список c HTML на основе списка фреймов данных datalist. Мои данные - это список фреймов данных, каждый из которых имеет два столбца (не обязательно с тем же именем). Я всегда хочу, чтобы первый столбец каждого фрейма данных был элементом списка, а второй столбец - текстом, отображаемым при наведении курсора (используя 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"

Я подумал, что мог бы использовать эту функцию, чтобы создать вторую функцию, которая будет l oop на каждом кадре данных в списке и

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
  )
}

Может ли кто-нибудь помочь мне динамически достичь желаемого результата, используя список данных в качестве функции ввода?

1 Ответ

1 голос
/ 11 февраля 2020

Вы можете использовать map2() из purrr для итерации по двум элементам одинаковой длины.

В rowBlock() мы можем использовать apply() для итерации 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)

А вот изображение.

enter image description here

...