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. 送信ボタンに関しては、submitButton が Shiny アプリケーションに存在する場合、ボタンが押されるまで、ページ上のすべての入力がサーバーに更新を送信しないことを考慮する必要があります。つまり、それを押すと、すべての入力がサーバーに送り返されます。あなたの場合、submitButton を使用するのではなく、代わりに actionButton を使用することをお勧めします。これにより、どの入力がコードの再実行をトリガーするかをより細かく制御できるようになります。

  2. アクション ボタンも含めてスニペットを変更し、remarksID 変数の値を更新する JavaScript をもう 1 行追加して、最初に実行したときに空にならないようにしました。私はそれが今あなたが望むように機能すると思います。

UI に追加する必要がある JS 行はjsCode2<-"shinyjs.updateRemarks = function(val){ Shiny.onInputChange('remarksID', val); }" 、サーバー上の remarksID を更新します。プログラムで変更された入力であるため、このようにする必要があります。これをシャイニーリアクティブモデルに感謝します。

それで：

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

  )))
于 2016-06-17T09:55:30.797 に答える