我有一个包含数据框的列表，我想使用 shinydashboard 和 rhandsontable 遍历数据框。当我在修改后接受数据框时，我希望它显示下一个列表项（数据框）。这是我的代码：
编辑添加了模拟数据和库
用户界面
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 和 blur_match_list 是包含与某些产品匹配的数据框的列表。
按下接受按钮后，我似乎无法弄清楚如何用下一个数据框替换当前数据框。接受按钮将数据框保存在数据库中，并将数据框/列表项替换为 NULL。像 valuebox 和 selectInput 之类的其他所有内容都已更新...