R: Як елегантно відокремити логіку коду від UI / html-тегів?

Проблема

При динамічному створенні UI-елементів ( shiny.tag, shiny.tag.list, ...), я часто важко відокремити його від моєї логіки коди і зазвичай закінчуються згорнутим місивом вкладеного tags$div(...), змішане з петлями і умовними операторами. Хоча це дратує і некрасиво дивитися, але воно також схильне до помилок, наприклад, при внесенні змін у HTML-шаблони.

Відтворюваний приклад

Скажімо, у мене є така структура даних:

my_data <- list(
  container_a = list(
    color = "orange",
    height = 100,
    content = list(
      vec_a = c(type = "p", value = "impeach"),
      vec_b = c(type = "h1", value = "orange")
    )
  ),
  container_b = list(
    color = "yellow",
    height = 50,
    content = list(
      vec_a = c(type = "p", value = "tool")
    )
  )  
)

Якщо я зараз хочу пересувати цю структуру в ui-теги, я зазвичай закінчуюсь чимось на зразок:

library(shiny)

my_ui <- tagList(
  tags$div(
    style = "height: 400px; background-color: lightblue;",
    lapply(my_data, function(x){
      tags$div(
        style = paste0("height: ", x$height, "px; background-color: ", x$color, ";"),
        lapply(x$content, function(y){
          if (y[["type"]] == "h1") {
            tags$h1(y[["value"]])
          } else if (y[["type"]] == "p") {
            tags$p(y[["value"]])
          }
        }) 
      )
    })
  )
)

server <- function(input, output) {}
shinyApp(my_ui, server)

Як бачите, це вже досить безладно і досі нічого в порівнянні з моїми реальними подібними прикладами.

Бажане рішення

Я сподівався знайти щось близьке до двигуна шаблонів для R, що дозволить окремо визначати шаблони та дані :

# syntax, borrowed from handlebars.js
my_template <- tagList(
  tags$div(
    style = "height: 400px; background-color: lightblue;",
    "{{#each my_data}}",
    tags$div(
      style = "height: {{this.height}}px; background-color: {{this.color}};",
      "{{#each this.content}}",
      "{{#if this.content.type.h1}}",
      tags$h1("this.content.type.h1.value"),
      "{{else}}",
      tags$p(("this.content.type.p.value")),
      "{{/if}}",      
      "{{/each}}"
    ),
    "{{/each}}"
  )
)

Попередні спроби

По-перше, я думав, що shiny::htmlTemplate()може запропонувати рішення, але це буде працювати лише з файлами та текстовими рядками, а не shiny.tags. Я також переглянув деякі r-пакети, такі як віскі , але, схоже, вони мають таке ж обмеження і не підтримують теги чи структури списків.

Дякую!

Мені подобається створювати користувальницькі та багаторазові користувальницькі інтерфейси за допомогою функцій, які створюють блискучі теги HTML (або htmltoolsтеги). З вашого прикладу програми я міг визначити елемент "сторінка", а потім два контейнери із загальним вмістом, а потім створити для них деякі функції:

library(shiny)

my_page <- function(...) {
  div(style = "height: 400px; background-color: lightblue;", ...)
}

my_content <- function(..., height = NULL, color = NULL) {
  style <- paste(c(
    sprintf("height: %spx", height),
    sprintf("background-color: %s", color)
  ), collapse = "; ")

  div(style = style, ...)
}

І тоді я міг би скласти свій інтерфейс з подібним чином:

my_ui <- my_page(
  my_content(
    p("impeach"),
    h1("orange"),
    color = "orange",
    height = 100
  ),
  my_content(
    p("tool"),
    color = "yellow",
    height = 50
  )
)

server <- function(input, output) {}
shinyApp(my_ui, server)

Кожного разу, коли мені потрібно підправити стилізацію чи HTML елемента, я б просто перейшов до функції, яка генерує цей елемент.

Крім того, я щойно накреслив дані в цьому випадку. Я думаю, що структура даних у вашому прикладі дійсно змішує дані з проблемами інтерфейсу (стилі, теги HTML), що може пояснити деякі складові. Єдині дані, які я бачу, - це "помаранчевий" як заголовок, а "імпіч" / "інструмент" як вміст.

Якщо у вас є складніші дані або потрібні більш конкретні компоненти інтерфейсу, ви можете знову використовувати функції, такі як будівельні блоки:

my_content_card <- function(title = "", content = "") {
  my_content(
    h1(title),
    p(content),
    color = "orange",
    height = 100
  )
}

my_ui <- my_page(
  my_content_card(title = "impeach", content = "orange"),
  my_content(
    p("tool"),
    color = "yellow",
    height = 50
  )
)

Сподіваюся, що це допомагає. Якщо ви шукаєте кращі приклади, ви можете перевірити вихідний код, що знаходиться за елементами введення та виведення Shiny (наприклад selectInput()), які по суті є функціями, які виплескують HTML-теги. Двигун-шаблон також може працювати, але реальної потреби немає, коли у вас вже є htmltools+ повна потужність R.

Можливо, ви могли б розглянути питання про пошук glue()та get().

get ():

get() може перетворити рядки в змінні / об'єкти.

Таким чином, ви можете скоротити:

if (y[["type"]] == "h1") {
    tags$h1(y[["value"]])
} else if (y[["type"]] == "p") {
    tags$p(y[["value"]])
}

до

get(y$type)(y$value)

(див. приклад нижче).

клей ():

glue()надає альтернативу paste0(). Це може бути зручніше для читання, якщо ви об'єднаєте багато рядків і змінних у рядок. Я припускаю, що він також близький до синтаксису бажаного результату.

Замість:

paste0("height: ", x$height, "px; background-color: ", x$color, ";")

Ви б написали:

glue("height:{x$height}px; background-color:{x$color};")

Ваш приклад спростить:

tagList(
  tags$div(style = "height: 400px; background-color: lightblue;",
    lapply(my_data, function(x){
      tags$div(style = glue("height:{x$height}px; background-color:{x$color};"),
        lapply(x$content, function(y){get(y$type)(y$value)}) 
      )
    })
  )
)

Використання:

library(glue)
my_data <- list(
  container_a = list(
    color = "orange",
    height = 100,
    content = list(
      vec_a = list(type = "p", value = "impeach"),
      vec_b = list(type = "h1", value = "orange")
    )
  ),
  container_b = list(
    color = "yellow",
    height = 50,
    content = list(
      vec_a = list(type = "p", value = "tool")
    )
  )  
)

Альтернативи:

Я думаю, що htmltemplate є гарною ідеєю, але ще одна проблема - це небажані пробіли: https://github.com/rstudio/htmltools/isissue/19#issuecomment-252957684 .