javascript - 默认情况下， Shiny 的应用程序数据对于特殊输入小部件不可见

Question

我有一个 Shiny 的应用程序，我希望能够在其中编辑数据库中的数据。在我的应用程序中，我选择一个 ID 并检索相应的数据。 (在示例“记录”中)此数据被填充到不同的 Shiny 小部件中，以便能够对其进行编辑。 (在下面的“textID”和“remarksID”示例中)编辑并按下提交按钮后，数据库中的数据将更新。

这听起来并不复杂，使用普通 Shiny 小部件时也不是。但我正在使用一个特殊的手工输入小部件(灵感来自以下 SO 答案:How to create TextArea as input in a Shiny webapp in R?)。通过使用 javascript，我可以填写手工输入小部件。但是以某种方式它不会被识别为输入值，它只会在屏幕上可视化。编辑手工输入小部件时，它将被识别为输入值。

不过这似乎不是什么大问题。但是假设我不想更改手工输入值并且更改其他输入值并提交编辑。然后手工输入的值将变为空字符串。

下面 Shiny 的应用程序显示了这个问题。备注输入小部件的可视化输入默认是不可见的，只有在编辑的时候才会在结果中显示。 (这将被发送回数据库)

library(shiny)
library(shinyjs)

jsCode<-"shinyjs.FillRemarks = function(remarks){document.getElementById('remarksID').value = remarks}"

record <- structure(list(ID = "x1y2z3", 
                         Country = "Netherlands", 
                         Remarks = "Bla bla bla bla bla bla bla bla bla bla bla bla bla bla bla blabla bla bla bla bla"),
                         .Names = c("ID","Country", "Remarks"), 
                         class = "data.frame", row.names = 1L)


ui <- shinyUI(fluidPage(mainPanel(
  useShinyjs(),
  extendShinyjs(text = jsCode),
  fluidRow( 
    br(),
    column(2,
    selectInput("selectID",label = "Select ID:", choices = record$ID, selected = record$ID)
    ),
    br(),br(),br(),hr()
  ),
  fluidRow(
    column(12, 
    textInput("textID",label = "Country:")
    )
  ),
  fluidRow( 
    column(3, 
           tags$p(id="remarksLabelID","Remarks:"),
           tags$textarea(id="remarksID", rows=3, cols=40, "")
    ),
    tags$style(type='text/css', "#remarksLabelID  { 
               display: inline-block;
               max-width: 100%;
               margin-bottom: 5px;
               font-weight: 700;
               }"),
    tags$style(type='text/css', "#remarksID  { 
               resize: none;
               width: 100%;
               display: block;
               padding: 6px 12px;
               font-size: 14px;
               line-height: 1.42857143;
               color: #555;
               background-color: #fff;
               background-image: none;
               border: 1px solid #ccc;
               border-radius: 4px;
               }")


    ),
  fluidRow( 

    hr(),
    column(12,

    titlePanel("Preview"),

    tableOutput("tableID")
    )
  )

)))

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

  observeEvent(input$selectID,{
    updateTextInput(session, "textID", label = "Country:", value = record$Country)
    print(js$FillRemarks(record$Remarks))

  })


  observe({

    outputTable <- structure(list(ID = record$ID, 
                                   Country = input$textID, 
                                   Remarks = input$remarksID), 
                              row.names = 1L, class = "data.frame")

  output$tableID <- renderTable({
    outputTable
  })
  })
}

shinyApp(ui=ui, server=server)

我是接近解决方案还是我的思路错了？也想不出这个问题的好标题

Answer 1

我不完全确定我是否理解正确，但尽管我会尽力回答。

1. 关于提交按钮，您必须考虑到当 submitButton 出现在 Shiny 应用程序中时，它会导致页面上的所有输入在按下按钮之前不会向服务器发送更新。也就是说，当您按下它时，所有输入都将被发送回服务器。在您的情况下，最好不要使用 submitButton，而是使用 actionButton，因为它允许更精细地控制哪些输入将触发代码的重新执行。

2. 我已经修改了您的代码段，其中还包括一个操作按钮并附加了一行更新 remarksID 变量值的 javascript，因此它在您第一次运行时不为空。我想它现在可以如你所愿了。

你必须添加到 ui 的 JS 行是 jsCode2<-"shinyjs.updateRemarks = function(val){ Shiny.onInputChange('remarksID', val); }"它将更新服务器上的 remarksID。它需要像这样完成，因为它是一个已经以编程方式修改的输入。为此感谢 Shiny 的 react 模型。

然后:

extendShinyjs(text = jsCode),
extendShinyjs(text = jsCode2),

在 server.R 中你必须在这里使用它:

updateTextInput(session, "textID", label = "Country:", value = record$Country)
    js$updateRemarks(record$Remarks)
    js$FillRemarks(record$Remarks)

最后，您还必须将其添加到 server.R 才能使用操作按钮。

observeEvent(input$button, {
    print(input$selectID)
    print(input$textID)
    print(input$remarksID)
  })

完整的片段是:

服务器.R

library(shiny)
library(shinyjs)

record <- structure(list(ID = "x1y2z3", 
                         Country = "Netherlands", 
                         Remarks = "Bla bla bla bla bla bla bla bla bla bla bla"),
                    .Names = c("ID","Country", "Remarks"), 
                    class = "data.frame", row.names = 1L)

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

  observeEvent(input$selectID,{
    updateTextInput(session, "textID", label = "Country:", value = record$Country)
    js$updateRemarks(record$Remarks)
    js$FillRemarks(record$Remarks)
  })


  observeEvent(input$button, {
    print(input$selectID)
    print(input$textID)
    print(input$remarksID)
  })

  observe({
    outputTable <- structure(list(ID = record$ID, 
                                  Country = input$textID, 
                                  Remarks = input$remarksID), 
                             row.names = 1L, class = "data.frame")

    output$tableID <- renderTable({outputTable})
  })
}

ui.R

jsCode<-"shinyjs.FillRemarks = function(remarks){document.getElementById('remarksID').value = remarks}"
jsCode2<-"shinyjs.updateRemarks = function(val){ Shiny.onInputChange('remarksID', val); }" 

record <- structure(list(ID = "x1y2z3", 
                         Country = "Netherlands", 
                         Remarks = "Bla bla bla bla bla bla bla bla bla bla bla"),
                    .Names = c("ID","Country", "Remarks"), 
                    class = "data.frame", row.names = 1L)


ui <- shinyUI(fluidPage(mainPanel(
  useShinyjs(),
  extendShinyjs(text = jsCode),
  extendShinyjs(text = jsCode2),
  fluidRow( 
    br(),
    column(2, selectInput("selectID",label = "Select ID:", choices = record$ID, selected = record$ID)),
    br(),br(),br(),hr()
  ),
  fluidRow(   column(12, textInput("textID",label = "Country:")  )  ),
  fluidRow(   column(3,  tags$p(id="remarksLabelID","Remarks:"), tags$textarea(id="remarksID", rows=3, cols=40, "")  ),
    tags$style(type='text/css', "#remarksLabelID  { 
               display: inline-block;
               max-width: 100%;
               margin-bottom: 5px;
               font-weight: 700;
               }"),
    tags$style(type='text/css', "#remarksID  { 
               resize: none;
               width: 100%;
               display: block;
               padding: 6px 12px;
               font-size: 14px;
               line-height: 1.42857143;
               color: #555;
               background-color: #fff;
               background-image: none;
               border: 1px solid #ccc;
               border-radius: 4px;
               }")


    ),
  fluidRow( actionButton("button", "An action button")),
  fluidRow( 

    hr(),
    column(12,

           titlePanel("Preview"),

           tableOutput("tableID")
    )
  )

  )))