Я пытаюсь создать цикл для создания настраиваемой таблицы HTML. У меня проблема с вложенным слоем.

Код

library(htmltools)
dataframe <- iris[1:5,]
tags$tbody(
  apply(dataframe,1, function(x) { tags$tr(list('class = "Row"',
                                                lapply(colnames(dataframe), function(x1) glue::glue("data-{x1}="))),
                                           lapply(x, function(y) tags$td(y)))})
)

Desired Output

 <tr class = "Row"
    data-Sepal.Length=5.1
    data-Sepal.Width="3.5"
    data-Petal.Length="1.4"
    data-Petal.Width="0.2"
    data-Species= "setosa">
    <td>5.1</td>
    <td>3.5</td>
    <td>1.4</td>
    <td>0.2</td>
    <td>setosa</td>
  </tr>

Что я получаю сейчас -

 <tr>
    class = "Row"
    data-Sepal.Length=
    data-Sepal.Width=
    data-Petal.Length=
    data-Petal.Width=
    data-Species=
    <td>5.1</td>
    <td>3.5</td>
    <td>1.4</td>
    <td>0.2</td>
    <td>setosa</td>
  </tr>
1
john 9 Окт 2021 в 10:54

3 ответа

Лучший ответ
library(htmltools)
dataframe <- iris[1:5,]
tags$tbody(
  apply(dataframe,1, function(x){
    attributesNames <-
      c("class", paste0("data-", colnames(dataframe)))
    attributes <- setNames(c("rovv", as.character(x)), attributesNames)
    cells <- unname(lapply(x, function(y) tags$td(y)))
    args <- c(attributes, cells)
    do.call(tags$tr, args)
  })
)
2
Stéphane Laurent 9 Окт 2021 в 09:18

Вот возможное решение с использованием paste0 и sprtinf.

dataframe <- iris[1:5,]

htmltools::HTML(apply(dataframe, 1, function(x) {
  sprintf('\n<tr class = "Row" \n %s \n </tr>', 
         paste0(c(paste0(
           sprintf('\tdata-%s="%s"', names(dataframe), x), collapse = '\n'),
         paste0(
           sprintf('<td>%s</td>', x), collapse = '\n')), collapse = '\n'))
  
}))

#<tr class = "Row" 
#   data-Sepal.Length="5.1"
#   data-Sepal.Width="3.5"
#   data-Petal.Length="1.4"
#   data-Petal.Width="0.2"
#   data-Species="setosa"
#<td>5.1</td>
#<td>3.5</td>
#<td>1.4</td>
#<td>0.2</td>
#<td>setosa</td> 
# </tr> 
#<tr class = "Row" 
#  data-Sepal.Length="4.9"
#...
#...
2
Ronak Shah 9 Окт 2021 в 08:52

Атрибут тегов должен быть дополнительным аргументом, пока вы указали их, как если бы они должны были быть новым тегом. Решение попыталось изолировать разные части, чтобы можно было увидеть, как это работает.

Решение добавляет все эти аргументы в список, который мы хотим передать tags$tr и использует do.call.

library(htmltools)

GenerateAttributes <- function(xNames, x) {
  names(x) <- paste("data", xNames, sep = "-")
  x
}

GenerateRow <- function(x, xNames) {
  Args <- list(lapply(x, function(y) tags$td(y)))
  Args <- c(Args, class = "Row")
  Args <- c(Args, GenerateAttributes(xNames, x))
  do.call(tags$tr, Args)
}

dataframe <- iris[1:5,]
tags$tbody(
  apply(dataframe, 1, GenerateRow, names(dataframe))
)
<tbody>
<tr class="Row" data-Sepal.Length="5.1" data-Sepal.Width="3.5" data-Petal.Length="1.4" data-Petal.Width="0.2" data-Species="setosa">
<td>5.1</td>
<td>3.5</td>
<td>1.4</td>
<td>0.2</td>
<td>setosa</td>
</tr>
...
</tbody>

Создано 2021-10-09 пакетом REPEX (v2.0.1)

1
Jan 9 Окт 2021 в 09:18