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

Question

我有一个闪亮的应用程序，我希望能够在其中编辑数据库中的数据。在我的应用程序中，我 select 一个 ID 并检索相应的数据。（在示例 "record" 中）此数据被填充到不同的闪亮小部件中，以便能够对其进行编辑。（在下面的示例中 "textID" 和 "remarksID"）编辑并按下提交按钮后，数据库中的数据将被更新。

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

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

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

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

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

关于提交按钮，你必须考虑到当 submitButton 出现在 Shiny 应用程序中时，它会导致页面上的所有输入在按钮出现之前不会向服务器发送更新按下。也就是说，当您按下它时，所有输入都将被发送回服务器。在您的情况下，最好不要使用 submitButton，而是使用 actionButton，因为它允许更细粒度地控制哪些输入将触发代码的重新执行。
我已经修改了你的代码片段，包括一个操作按钮并附加了一行 javascript 来更新 remarksID 变量值，所以它在你第一次运行它。我想它现在可以如你所愿了。

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

然后：

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

完整的片段是：

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

  )))

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

Shiny application data by default not visible for special input widget

javascript

r

shiny

shinyjs