首页 \ 问答 \ R Shiny删除按钮进入数据表不能正常工作(R Shiny delete button into data table doesn't work well)

R Shiny删除按钮进入数据表不能正常工作(R Shiny delete button into data table doesn't work well)

我已经构建了一个闪亮的应用程序,允许用户更新表格中的数据表。 我有一个功能允许用户通过在渲染的数据表中单击actionLink来删除数据中的行。

它工作正常,但我管理一些错误。 当所有数据表删除一次,并且我放入新条目时,第一个新条目是不可删除的,而不先删除另一行。

这里要清楚的是显示错误的步骤:

  1. 添加文本输入并将其添加到数据表中
  2. 删除输入
  3. 添加新的文本输入
  4. 尝试删除它
  5. 添加另一个文本输入
  6. 删除第二个新输入
  7. 删除第一个输入

我不明白为什么,我认为它来自反应值,但我把observ事件放在可能出现的唯一两个事件上。

以下是查看错误的可重现示例:

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)

I have built a shiny App which allow user to update datatable whith a form. I have some trouble with a feature which allow user to delete a row in the datable by clicking on a actionLink into the rendered datatable.

It works properly but I manage some bug. When all the datatable where deleted once, and I put new entries the first new entries is non-deletable without deleted another row first.

To be clear here is the step to show the bug:

  1. Add a text input and add it into the data table
  2. Delete the input
  3. Add a new text input
  4. Try to delete it
  5. Add another text input
  6. Delete the second new input
  7. Delete the first input

I don't understand why, I think it's come from the reactive values but I put observ event on the only two event possible to appear.

Here is a reproducible example to see the bug:

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)

原文:
更新时间:2022-06-12 08:06

最满意答案

在assignProfile函数中,您可以检查状态代码并返回一个值。 根据该值,您可以决定第二次调用该函数。

  curl_exec($curl);
  $statusCode = curl_getinfo($curl, CURLINFO_HTTP_CODE);
  curl_close($curl);

  if (200 == $statusCode)
        return true;
  else
        return false;

In your assignProfile function you can check the status code and return a value. According to that value you can decide to call the function for a second time.

  curl_exec($curl);
  $statusCode = curl_getinfo($curl, CURLINFO_HTTP_CODE);
  curl_close($curl);

  if (200 == $statusCode)
        return true;
  else
        return false;

相关问答

更多
  • 在您的页面中包含jquery。