R Shiny & htmltools - Извлечение тега по имени - PullRequest
0 голосов
/ 28 сентября 2019

У меня есть tagList из двух блестящих входов, inputs.Я хотел бы извлечь тег label для каждого ввода.Я надеялся, что htmltools имел функцию-получатель для достижения этой цели, но в отсутствие таковой я определил функцию getLabel, которая повторяется через список ввода и извлекает подсписки, элемент имени которых равен значению label,Вот мой код:

library(htmltools)
library(shiny)

inputs = tagList(
    selectInput('first', 'FIRST', letters), 
    checkboxInput(inputId = 'second', label = 'SECOND')
)

getLabel2 <- function(children) {

  lapply(children, function(x) {

    if(inherits(x, 'shiny.tag')) {

      if(x$name == 'label') {

        return(x)

      } else {

        chldn = x$children

        if(is.list(chldn)) getLabel2(chldn)

      }

    }

  })

}


getLabel <- function(inputs) {

  lapply(inputs, function(x) {

    if(grepl('shiny-input-container', tagGetAttribute(x, 'class'))) {

      getLabel2(x$children)

    } else {

      return(x)

    }

  })
}

labels = getLabel(inputs)

Проблема в том, что результирующий список включает в себя подсписки нулевой длины.Мой желаемый вывод - это список из двух элементов (метка для каждого ввода) класса 'глянцевый-тег'.Как я могу изменить свою функцию для достижения этой цели?Кроме того, это можно сделать в htmltools?Я не могу найти подходящих получателей в руководстве к пакету.

1 Ответ

1 голос
/ 28 сентября 2019

Вы можете сделать:

inputs %>% toString %>% read_html %>% html_nodes(xpath = "//label") %>% html_text() %>% list

Объяснение:

блестящие вводы - это в основном html-код.То же самое верно для tagList().(Вы можете проверить это, запустив selectInput или вашу переменную inputs в консоли, ...).Таким образом, вы можете использовать xpath / css для синтаксического анализа получающегося XML-документа.

Возможно, с htmltools есть и другой способ, мне пришло в голову, что я думаю о том, что блестящие входные данные - это в основном HTML-код.

Воспроизводимый пример:

library(shiny)
library(rvest)
library(magrittr)

inputs = tagList(
  selectInput('first', 'FIRST', letters), 
  checkboxInput(inputId = 'second', label = 'SECOND')
)

inputs %>% toString %>% read_html %>% 
   html_nodes(xpath = "//label") %>% html_text() %>% list
...