1

データフレームを含むリストがあり、shinydashboard と rhandsontable を使用してデータフレームをループしたいと考えています。変更後にデータフレームを受け入れると、次のリスト項目 (データフレーム) を表示する必要があります。これが私のコードです：

EDIT 追加されたモック データとライブラリ

うい

library(shinydashboard)
library(dplyr)
library(rhandsontable)
library(shiny)

ui <- dashboardPage(
  skin = "purple",
  dashboardHeader(title = "Sneakerscraper"),

  dashboardSidebar(
    sidebarMenu(
      menuItem("Products", tabName = "Products", icon = icon("glyphicon glyphicon-list-alt", lib = "glyphicon")),
      menuItem("Comparison", tabName = "Comparison", icon = icon("sitemap"))
    )
  ),

  dashboardBody(
    tabItems(
      tabItem(tabName = "Products"

      ),
      tabItem(tabName = "Comparison",
              fluidRow(
                valueBoxOutput("skuMatches"),
                valueBoxOutput("fuzzyMatches")
              ),
              fluidRow(
                column(3, 
                       selectizeInput(inputId = "matchType",
                                      label = "Select type matches:",
                                      choices = c("Select match type" = "",
                                                  "SKU matches" = "sku",
                                                  "Fuzzy matches" = "fuzzy"))
                ),
                column(3, 
                       selectizeInput(inputId = "matchID",
                                      label = "Select id match:", 
                                      choices = c("Select id match" = ""))
                )
              ),
              fluidRow(
                column(12,
                       rHandsontableOutput('matchTable')
                )
              ),
              fluidRow(
                column(12,
                       tags$hr(),
                       uiOutput('actionSelectInput')
                )
              )
      )
    )

  )
)

以下はサーバーコードです。

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

  #create list for all matching sku rows
  sku_match_list <- structure(list(`item: 1` = structure(list(id = c(13, 785, 897, 1882), 
                                                         brand = c(NA, NA, NA, "adidas"), 
                                                         model = c("adidas gazelle", "adidas gazelle (clear onix/white-gold metalli", "adidas gazelle (clear onix/white-gold metalli", "gazelle clonix/white"), 
                                                         price = c("€ 110.00", "€110.00", "€110.00", NA), 
                                                         url = c("http://www.woei-webshop.nl/catalog/product/adidas-gazelle/26289/s76221/30688/6065/1167/", "https://www.patta.nl/footwear/adidas-gazelle-clear-onix-white-gold-metallic", "https://www.patta.nl/men/adidas-gazelle-clear-onix-white-gold-metallic", "http://epicstore.nl/shop/sneakers/gazelle-clonix-white-401/"), 
                                                         categorie = c("adidas", " footwear ", " men ", "sneakers"), 
                                                         sku = c("s76221", "s76221", "s76221", "s76221"), 
                                                         store = c("woei", "patta", "patta", "epic")),
                                                    .Names = c("id", "brand", "model", "price", "url", "categorie", "sku", "store"), 
                                                    row.names = c(1L, 773L, 885L, 1870L), 
                                                    class = "data.frame"), 
                              `item: 5` = structure(list(id = c(17, 404, 1155), 
                                                         brand = c(NA_character_, NA_character_, NA_character_), 
                                                         model = c("adidas equipment support adv", "adidas equipment support adv", "equipment support adv"), 
                                                         price = c("€ 150.00", "€ 149.95", "€149.95"), 
                                                         url = c("http://www.woei-webshop.nl/catalog/product/adidas-equipment-support-adv/29174/ba8322/30074/5985/1167/",  "http://www.seventyfive.com/product/adidas-equipment-support-adv/",  "http://www.sneakerbaas.com/nl/equipment-support-adv-triple-white.html"), 
                                                         categorie = c("adidas", "adidas", "men"), 
                                                         sku = c("ba8322", "ba8322", "ba8322"), 
                                                         store = c("woei", "seventyfive", "sneakerbaas")), 
                                                    .Names = c("id", "brand", "model", "price", "url", "categorie", "sku", "store"), 
                                                    row.names = c(5L, 392L, 1143L), 
                                                    class = "data.frame")), 
                         .Names = c("item: 1", "item: 5"))

  #create list for all fuzzy matching rows
  fuzzy_match_list <- structure(list(bb5493 = structure(list(id = c(14, 15), 
                                                             brand = c(NA_character_, NA_character_), 
                                                             model = c("adidas gazelle", "adidas gazelle"), 
                                                             price = c("€ 100.00", "€ 100.00"), 
                                                             url = c("http://www.woei-webshop.nl/catalog/product/adidas-gazelle/26289/bb5494/30687/6050/1167/", "http://www.woei-webshop.nl/catalog/product/adidas-gazelle/26289/bb5493/30597/6025/1167/"), 
                                                             categorie = c("adidas", "adidas"), 
                                                             sku = c("bb5494", "bb5493"), 
                                                             store = c("woei", "woei")), 
                                                        .Names = c("id", "brand", "model", "price", "url", "categorie", "sku", "store"), 
                                                        row.names = 1:2, 
                                                        class = "data.frame"), 
                                     bb5492 = structure(list(id = c(15, 22), 
                                                             brand = c(NA_character_, NA_character_), 
                                                             model = c("adidas gazelle", "adidas gazelle"), 
                                                             price = c("€ 100.00", "€ 100.00"), 
                                                             url = c("http://www.woei-webshop.nl/catalog/product/adidas-gazelle/26289/bb5493/30597/6025/1167/", "http://www.woei-webshop.nl/catalog/product/adidas-gazelle/26289/bb5492/28904/5628/1167/"), 
                                                             categorie = c("adidas", "adidas"), 
                                                             sku = c("bb5493", "bb5492"), 
                                                             store = c("woei", "woei")), 
                                                        .Names = c("id", "brand", "model", "price", "url", "categorie", "sku", "store"), 
                                                        row.names = c(2L, 6L), 
                                                        class = "data.frame")), 
                                .Names = c("bb5493", "bb5492"))

  rv <- reactiveValues()
  rv[["sku"]] <- sku_match_list
  rv[["fuzzy"]] <- fuzzy_match_list

  matchType <- reactive({
    input$matchType
  })

  matchID <- reactive({
    as.numeric(gsub("[^0-9]", "", input$matchID))
  })

  ID_choices <- reactive({
    selected_match <- switch (input$matchType,
                              sku = {
                                match <- 1:length(rv[["sku"]])
                                sapply(match, function(x) paste0("SKU match: ", x))
                              },
                              fuzzy = {
                                match <- 1:length(rv[["fuzzy"]])
                                sapply(match, function(x) paste0("Fuzzy match: ", x))
                              }
    )
    selected_match
  })

  table <- reactive({
    if (matchType() == "sku") {
      rv[["sku"]][[matchID()]]
    } else if(matchType() == "fuzzy") {
      rv[["fuzzy"]][[matchID()]]
    } else {
      NA
    }
  })

  #observe event 
  observeEvent(input$matchType, {
    updateSelectInput(session, "matchID", choices = ID_choices())
  })

  #shows buttons when clicked on an ID
  observeEvent(input$matchID, {
    output$actionSelectInput <- renderUI({
      if(nchar(matchID()) == 0 || is.na(matchID())){return()}
      list(
        # cancel button
        actionButton(inputId = 'cancel', label = 'Cancel', icon = icon("ban")),
        # accept button
        actionButton(inputId = 'accept', label = 'Accept', icon = icon("check"))
      )
    })
  })

  observe({
    if (!is.null(input$matchTable)) {
      temp <- hot_to_r(input$matchTable)
      if(matchType() == "sku"){
        rv[["sku"]][[matchID()]] <- temp
      } else if(matchType() == "fuzzy"){x
        rv[["fuzzy"]][[matchID()]] <- temp
      }
    }
  })

  output$matchTable <- renderRHandsontable({
    rhandsontable(table()) %>%
      hot_context_menu(allowRowEdit = TRUE, allowColEdit = FALSE)
  })

  # obserevent of the accept button
  observeEvent(input$accept, {
    save_product_mysql(table())
    if(matchType() == "sku"){
      # set the listitem to null doesn't show me the next listitem 
      rv[["sku"]][[matchID()]] <- NULL

    } else if(matchType() == "fuzzy"){
      rv[["fuzzy"]][[matchID()]] <- NULL
    }
  })

  #render SKUmatches valuebox
  output$skuMatches <- renderValueBox({
    valueBox(
      length(rv[["sku"]]), "SKU matches", icon = icon("thumbs-up", lib = "glyphicon"),
      color = "green"
    )
  })

  #render fuzzyMatches valuebox
  output$fuzzyMatches <- renderValueBox({
    valueBox(
      length(rv[["fuzzy"]]), "Fuzzy matches", icon = icon("search"),
      color = "yellow"
    )
  })

}

sku_match_list と fuzzy_match_list は、特定の製品に一致するデータフレームを含むリストです。

同意ボタンを押した後、現在のデータフレームを次のデータフレームに置き換える方法がわかりません。受け入れるボタンは、データフレームをデータベースに保存し、データフレーム/リスト項目を NULL に置き換えます。ただし、値ボックスやselectInputなどの他のすべては更新されます...

4

1 に答える 1

1

オブザーバーが常に現在のデータテーブルを返す rhandsontable の更新を常にチェックしていることを知りました。オブザーバーを削除しました：

  observe({
    if (!is.null(input$matchTable)) {
      temp <- hot_to_r(input$matchTable)
      if(matchType() == "sku"){
        rv[["sku"]][[matchID()]] <- temp
      } else if(matchType() == "fuzzy"){x
        rv[["fuzzy"]][[matchID()]] <- temp
      }
    }
  })

hot_to_r(input$matchTable)次のように、accept-button オブザーバーに次の行を追加しました。

# obserevent of the accept button
observeEvent(input$accept, {
  save_product_mysql(hot_to_r(input$matchTable))
  if(matchType() == "sku"){
    rv[["sku"]][[matchID()]] <- NULL
  } else if(matchType() == "fuzzy"){
    rv[["fuzzy"]][[matchID()]] <- NULL
  }
})
于 2016-08-18T09:32:05.020 に答える