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

Posted 2023-04-18

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

【英文标题】：Shiny application data by default not visible for special input widget

【发布时间】：2016-10-13 23:34:50

【问题描述】：

我有一个闪亮的应用程序，我希望能够编辑数据库中的数据。在我的应用程序中，我选择一个 ID 并检索相应的数据。 （在示例“记录”中）这些数据被填充到不同的闪亮小部件中，以便能够编辑它们。 （在下面的“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)

我是接近解决方案还是我的想法有误？ 也想不出这个问题的好标题

【问题讨论】：

我见过其他例子，其中 javascript 修改的输入值（即使是标准输入类型）没有被 Shiny 服务器端拾取。我认为您需要使用ryouready.wordpress.com/2013/11/20/… 此处的技术将值显式发送到服务器。

【参考方案1】：

我不完全确定我是否理解正确，但即使我会尝试回答。

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

我已经修改了您的 sn-p，还包括一个操作按钮并附加了一行 javascript，该行更新了 commentsID 变量值，因此在您第一次运行它时它不为空。我认为它现在可以如你所愿。

你必须添加到 ui 的 JS 行是 jsCode2<-"shinyjs.updateRemarks = function(val) Shiny.onInputChange('remarksID', val); " 它将更新服务器上的备注 ID。它需要像这样完成，因为它是一个以编程方式修改的输入。感谢 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)
  )

完整的sn-ps是：

服务器.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")
    )
  )

  )))