javascript - 从名称中识别小部件类型

Question

有没有人有办法根据其名称/ID 确定小部件的类型？例如，如果 "my_text" 是一个 textInput 小部件，那么我希望能够调用:

is.textInput("my_text")

并返回 TRUE。或者打电话

widget.type("my_list")

并返回“textInput”。但是这两个功能都不存在。

我查看了 shiny 和 shinyWidgets 包中的所有函数，但没有看到任何到这种程度的东西。有一些后端函数，例如 session$sendInputMessage()，它们不是为用户设计的，但可能会有所帮助。

我天真的解决方案是尝试类似下面的方法(如果我的 tryCatch() 语法不太正确，我很抱歉，我不经常使用它):

is.textInput <- function(widget_id){
    out <- tryCatch(
        {
        # attempt to treat it as a textInput, change it and change it back
        tmp <- input[[widget_id]]
        updateTextInput(session, widget_id, value = character(0))
        updateTextInput(session, widget_id, value = tmp)
        },
        error=function(cond) { return("NO") },
        warning=function(cond) { return("NO") },
        finally={}
    )
    # if error message happens then not textInput
    if(out == "NO")
        return("FALSE")
    # if no error message then is textInput
    return("TRUE")
}

但我宁愿不要故意制造错误/异常。而且我不希望通过逻辑检查来更改应用程序的状态。

关于我如何完成此任务的其他建议？

Answer 1

更新:我修改了 javascript 代码中的一行，使其与 IE/Rstudio Viewer 兼容。 IE/Viewer 抛出错误，因为它们不支持函数 include()，参见 .includes() not working in Internet Explorer .可以使用 indexOf() 代替。

您可以使用 javascript 通过 id 检查输入元素。该元素可以通过找到document.getElementById() 然后你可以通过 getAttribute('class') 和 getAttribute('type') 识别类型。

结果可以通过 Shiny.onInputChange('inputType', ...);“发送”到 R，并通过 input$inputType 在 R 中使用。

该函数的第一个示例是:

getWidgetType <- function(widgetId){
  paste0(
    "elem = document.getElementById('", widgetId,"');
    var message;
    if(elem == null){
      message = 'No input with id = ", widgetId," exists.'
    }else{
      // RStudio Viewer + IE workaround (dont have .include())
      if(elem.getAttribute('class').indexOf('js-range-slider') > -1){ 
        message = 'slider'
      }else if (elem.nodeName == 'SELECT'){
        message = 'select'
      }else{
        message = elem.getAttribute('type');
      }
    }
    Shiny.onInputChange('inputType', message)
    "
  )
}

请注意，我为四个输入做了一个示例:数字、文本、selectInput 和 sliderInput。如果您添加额外的输入，您可能还需要检查其他属性。

可重现的例子:

library(shiny)
library(shinyjs)

ui <- fluidPage(
  useShinyjs(),
  textInput("textInput", "id = textInput", "text"),
  numericInput("numInput", "id = numInput", 10),
  sliderInput("slideInput", "id = slideInput", 1, 10, 5),

  hr(style = "height:1px;border:none;color:#333;background-color:#333;"),
  textInput("widgetType", "widget type by id", "textInput"),
  textOutput("widgetId")
)

server <- function(input, output, session) {

  output$widgetId <- renderText({
    runjs(getWidgetType(input$widgetType))
    input$inputType
  })

}

shinyApp(ui, server)