R: Jak elegancko oddzielić logikę kodu od tagów UI / html?

Problem

Podczas dynamicznego tworzenia UI-elementy ( shiny.tag, shiny.tag.list...), często trudno jest oddzielić ją od mojego logiki kodu i zwykle kończy się z pokrętny bałagan zagnieżdżone tags$div(...), zmieszanej z pętli i instrukcji warunkowych. Jest denerwujący i brzydki, ale także podatny na błędy, np. Podczas wprowadzania zmian w szablonach HTML.

Powtarzalny przykład

Powiedzmy, że mam następującą strukturę danych:

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

Jeśli teraz chcę przesunąć tę strukturę do znaczników interfejsu użytkownika, zwykle uzyskuję coś takiego:

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)

Jak widać, jest to już dość bałagan i wciąż nic w porównaniu z moimi prawdziwymi przykładami.

Pożądane rozwiązanie

Miałem nadzieję znaleźć coś zbliżonego do silnika szablonów dla R, który pozwoliłby na oddzielne definiowanie szablonów i danych :

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

Poprzednie próby

Po pierwsze, pomyślałem, że to shiny::htmlTemplate()może zaoferować rozwiązanie, ale działałoby to tylko z plikami i ciągami tekstowymi, shiny.taga nie s. Przyjrzałem się również niektórym pakietom r, takim jak wąsy , ale wydaje się, że mają takie same ograniczenia i nie obsługują tagów ani struktur list.

Dziękuję Ci!

Lubię tworzyć komponowalne i wielokrotnego użytku elementy interfejsu użytkownika za pomocą funkcji, które produkują błyszczące tagi HTML (lub htmltoolstagi). W Twojej przykładowej aplikacji mogłem zidentyfikować element „page”, a następnie dwa ogólne kontenery treści, a następnie utworzyć dla nich kilka funkcji:

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

A potem mógłbym skomponować swój interfejs z czymś takim:

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)

Za każdym razem, gdy muszę poprawić styl lub HTML elementu, po prostu przejdę prosto do funkcji, która generuje ten element.

W tym przypadku właśnie wprowadziłem dane. Myślę, że struktura danych w twoim przykładzie naprawdę łączy dane z obawami dotyczącymi interfejsu użytkownika (stylizacja, znaczniki HTML), co może wyjaśniać niektóre zawiłości. Jedyne dane, które widzę, to „pomarańczowy” jako nagłówek i „impeach” / „narzędzie” jako treść.

Jeśli masz bardziej skomplikowane dane lub potrzebujesz bardziej szczegółowych składników interfejsu użytkownika, możesz ponownie użyć funkcji, takich jak bloki konstrukcyjne:

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

Mam nadzieję, że to pomaga. Jeśli szukasz lepszych przykładów, możesz sprawdzić kod źródłowy za elementami wejściowymi i wyjściowymi Shiny (np. selectInput()), Które są zasadniczo funkcjami, które wypluwają tagi HTML. Silnik szablonów może również działać, ale nie ma prawdziwej potrzeby, gdy już masz htmltools+ pełną moc R.

Może możesz rozważyć zaglądanie do glue()i get().

dostać():

get() Potrafi przekształcić ciągi w zmienne / obiekty.

Abyś mógł skrócić:

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

do

get(y$type)(y$value)

(patrz przykład poniżej).

klej():

glue()stanowi alternatywę dla paste0(). Może być bardziej czytelny, jeśli skoncentrujesz wiele ciągów i zmiennych w ciągu. Zakładam, że wygląda to również na składnię pożądanego wyniku.

Zamiast:

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

Napisałbyś:

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

Twój przykład uprościłby:

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

Za pomocą:

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

Alternatywy:

Myślę, że htmltemplate to dobry pomysł, ale innym problemem są niepożądane białe spacje: https://github.com/rstudio/htmltools/issues/19#issuecomment-252957684 .