R : shinydashboard에서 데이터 테이블을 삭제할 때 다음 데이터 테이블로 이동

Question

데이터 프레임이 포함 된 목록이 있습니다. shinydashboard 및 rhandsontable을 사용하여 데이터 프레임을 반복하고 싶습니다. 수정 한 후 데이터 프레임을 수락하면 다음 listitem (데이터 프레임)을 표시합니다. 여기 내 코드는 다음과 같습니다

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가의 일치와 dataframes를 포함하는 목록입니다 :

편집 모의 데이터 및 라이브러리

UI

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

) 
) 

그리고 아래의 서버 코드가 추가 특정 제품.

동의 버튼을 누른 후 현재 데이터 프레임을 다음 데이터 프레임으로 대체하는 방법을 알아낼 수 없습니다. accept 버튼은 데이터 프레임을 데이터베이스에 저장하고 dataframe/listitem을 NULL로 대체합니다. valuebox 및 selectInput과 같은 다른 모든 요소는 업데이트됩니다.

Answer 1

저는 관찰자가 항상 현재 데이터 테이블을 반환하는 중재에서 업데이트를 확인하고 있음을 알았습니다. 나는 관찰자 제거 :

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)을 수용 버튼 관찰자에,과 같이 :

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