2

我有一个闪亮的应用程序，我希望能够编辑数据库中的数据。在我的应用程序中，我选择一个 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)

我是接近解决方案还是我在思考错误的方向？也想不出这个问题的好标题

4

1 回答 1

2

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

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

  2. 我已经修改了您的代码段，还包括一个操作按钮并附加了一行 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)
  })

完整的片段是：

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

用户界面

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

  )))
于 2016-06-17T09:55:30.797 回答