从名称中识别小部件类型

Question

is.textInput("my_text")

widget.type("my_list")

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()不支持，请参见。include()在Internet Explorer中不起作用。相反，可以使用indexof()。

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

结果可以通过shiny.oninputchange('input type'，...)“发送”给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)
    "
  )
}

请注意，我为四个输入做了一个示例:numeric、text、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)