R Блестящая кнопка удаления в таблицу данных не работает хорошо

Question

Я создал блестящее приложение, которое позволяет пользователю обновлять данные с формой. У меня есть некоторые проблемы с функцией, которая позволяет пользователю удалять строку в datable, нажимая на actionLink в обработанный datatable.

Он работает правильно, но я управляю некоторой ошибкой. Когда все данные, которые удаляются один раз, и я помещаю новые записи, первые новые записи не могут быть удалены без первой удаленной строки.

Для ясности здесь шаг, чтобы показать ошибку:

1. Добавить в режим ввода текста и добавить его в таблицу данных
2. Удалить вход
3. Добавить новый ввод текста
4. Попробуйте удалить его
5. Добавить другой текст input
6. Удалить второй новый вход
7. Удалить первый вход

Я не понимаю, почему, я думаю, что он исходит из реактивных значений, но я поставил наблюдательное событие только на два возможных события.

Вот воспроизводимый пример, чтобы увидеть ошибку:

library(shiny) 
library(DT) 
library(shinydashboard) 
library(shinyjs) 



# ----- function which create the button into the table 
shinyInput <- function(FUN, len, id, ...) { 
    inputs <- len 
    for (i in seq(len)) { 
    inputs[i] <- as.character(FUN(paste0(id, len[i]), ...)) 
    } 
    inputs 
} 

# ----- character form vector 
fields<-c("text") 


ui<-shinyUI(bootstrapPage(
    shinyjs::useShinyjs(), 
    title = "Update form", 
    fluidRow(
    sidebarPanel(width=2, 
       title = "Submit form", id = "submitTab", value = "submitTab", 
       textInput("text", "Text Input", ""), 
       actionButton("submit", "Add", class = "btn-primary",icon=icon("table")) 
       #  verbatimTextOutput("test") 
    ), 
    mainPanel(dataTableOutput("data_table"))) 

)) 

server<-shinyServer(function(input, output) { 
# ----- create the reactive value 
    v<-reactiveValues(data=NULL) 

# ----- when Add button is clicked 
    observeEvent(input$submit, { 
    dat <- sapply(fields, function(x) input[[x]]) 
    dat<-data.frame(t(dat),stringsAsFactors=F) 
    if(!(is.null(v$data)) && (input$text%in%v$data$text==F)) { 
     v$data <- rbind(v$data[,-2], dat) 
    } else if(!is.null(v$data) && (input$text%in%v$data$text==T)) { 
     indice<-which(v$data$text==input$text) 
     v$data[indice,-2] <- dat 
    } else { 
     v$data<-dat 
    } 
    v$data<-data.frame(v$data[,-2],Delete = shinyInput(actionLink, rownames(v$data), 'button_',class="btn btn-delete",icon=icon("minus-circle"),label="",onclick = 'Shiny.onInputChange(\"select_button\", this.id)')) 
    }) 

# ----- When Delete table button is clicked 
    observeEvent(input$select_button, { 
    #  dat<-v$data 
    selectedRow <- as.numeric(strsplit(input$select_button, "_")[[1]][2])  
    #  dat <- dat[rownames(dat) != selectedRow, ] 
    v$data<-v$data[rownames(v$data)!=selectedRow,] 
    v$data<-data.frame(v$data[,-2],Delete = shinyInput(actionLink, rownames(v$data), 'button_',class="btn btn-delete",icon=icon("minus-circle"),label="",onclick = 'Shiny.onInputChange(\"select_button\", this.id)')) 
    }) 

# ----- Render the data table 
    output$data_table <- renderDataTable(server = TRUE,escape=F,extensions = 'TableTools',options = list(pageLength = 10),{ 
    if (is.null(v$data)) return() 
    v$data 
    }) 
}) 

shinyApp(ui,server) 

Answer 1

Привет Я думаю, что вопрос на шаге 4 является то, что значение input$select_button не изменились, вставляя время на this.id, кажется, установил ее. Посмотрите на код ниже (я сделал некоторые другие изменения):

library(shiny) 
library(DT) 
library(shinydashboard) 
library(shinyjs) 



# ----- function which create the button into the table 
shinyInput <- function(FUN, len, id, ...) { 
    inputs <- len 
    for (i in seq(len)) { 
    inputs[i] <- as.character(FUN(paste0(id, len[i]), ...)) 
    } 
    inputs 
} 

# ----- character form vector 
fields<-c("text") 


ui<-shinyUI(bootstrapPage(
    shinyjs::useShinyjs(), 
    title = "Update form", 
    fluidRow(
    sidebarPanel(width=2, 
       title = "Submit form", id = "submitTab", value = "submitTab", 
       textInput("text", "Text Input", ""), 
       actionButton("submit", "Add", class = "btn-primary",icon=icon("table")) 
       #  verbatimTextOutput("test") 
    ), 
    mainPanel(dataTableOutput("data_table"), verbatimTextOutput("test"))) 

)) 

server<-shinyServer(function(input, output) { 
    # ----- create the reactive value 
    v<-reactiveValues(data=NULL) 

    # ----- when Add button is clicked 
    observeEvent(input$submit, { 
    dat <- sapply(fields, function(x) input[[x]]) 
    dat<-data.frame(V1 = dat,stringsAsFactors=F) 
    if(!(is.null(v$data)) && (!input$text %in% v$data$text)) { 
     v$data <- rbind(data.frame(V1 = as.character(v$data[,1])), dat) 
     rownames(v$data) <- seq_len(nrow(v$data)) 
    } else if(!is.null(v$data) && (input$text %in% v$data$text)) { 
     indice<-which(v$data$text==input$text) 
     v$data[indice,-2] <- dat 
    } else { 
     v$data<-dat 
    } 
    v$data<-data.frame(V1 = v$data[,-2], 
         Delete = shinyInput(actionLink, 
             rownames(v$data), 
             'button_', 
             class="btn btn-delete", 
             icon=icon("minus-circle"), 
             label="", 
             onclick = 'Shiny.onInputChange(\"select_button\", (this.id + \"@\" + Date()))')) 
    }) 

    # ----- When Delete table button is clicked 
    observeEvent(input$select_button, { 
    #  dat<-v$data 
    input_button <- gsub(pattern = "@.*", replacement = "", x = input$select_button) 
    selectedRow <- as.numeric(strsplit(input_button, "_")[[1]][2])  
    #  dat <- dat[rownames(dat) != selectedRow, ] 
    v$data <- v$data[!rownames(v$data) %in% selectedRow,] 
    if (nrow(v$data) > 0) { 
     v$data<-data.frame(V1 = v$data[,-2], 
         Delete = shinyInput(actionLink, 
             rownames(v$data), 
             'button_', 
             class="btn btn-delete", 
             icon=icon("minus-circle"), 
             label="", 
             onclick = 'Shiny.onInputChange(\"select_button\", (this.id + \"@\" + Date()))')) 
    } 
    }) 
    output$test <- renderPrint({input$select_button}) 
    # ----- Render the data table 
    output$data_table <- renderDataTable(server = TRUE,escape=F,extensions = 'TableTools',options = list(pageLength = 10),{ 
    if (is.null(v$data)) return() 
    v$data 
    }) 
}) 

shinyApp(ui,server)