在R Shiny中实现CRUD工作流的最清晰方法是什么？

Question

我正在尝试在Shiny中实现CRUD工作流程（创建/读取/更新/删除）以管理数据库记录。看起来Shiny默认不支持这种工作流程，所以我想知道是否有一种简洁的方法可以实现。

为了缩小问题的范围，我很难向记录表中添加静态链接，指向特定的tabPanel以编辑相应的记录。

以下是一个模拟示例，以便更容易地解决此问题。

ui.R

library(shiny)

shinyUI(navbarPage("Example",
 tabPanel("Event List",
          sidebarLayout(
            sidebarPanel(list(
              p("If you click the link, it should go to the edit event panel."),
              p("But it's not...")
            ), align="left"),
            mainPanel(
              h3("Event List"),
              tableOutput('testTable'),
              dataTableOutput('events_table'),
              align="center"))),
 tabPanel("Edit Event", id='edit',
          sidebarLayout(
            sidebarPanel(
              uiOutput("choose_event_id"),
              align="center"),
            mainPanel()
          )),
 id='top'
))

服务器.R

library(shiny)

shinyServer(function(input, output, session) {

  output$choose_event_id  <- renderUI({
    selectizeInput("event_id", "Event", width='100%',
                   choices=c(1,2,3), selected=1)
  })

  output$testTable <- renderTable({
    require(xtable)
    table <- xtable(data.frame(A=1,B='<a href="LINK-HERE">test</a>'))
    table
  }, sanitize.text.function = function(x) x)

})

我需要弄清楚的是LINK-HERE部分。tabPanels链接在每次重新启动应用程序时都会更改，因此静态链接在这种情况下不起作用。

---

第二个问题是将要编辑记录的id传递到URL中，但如果需要可以留待跟进问题。 我将尝试使用来自此SO问题答案的方法：

Shiny saving URL state subpages and tabs

提前致谢。

- JAponte

---

我希望有更多人回答这个问题。如果没有这样的工作流程，我发现很难让用户掌握新数据分析的驱动位置。我知道有一些优秀的Shiny开发者存在，也许这个问题并没有简单的答案。 - JAponte

Answer 1

试试这个。它使用了DT和shinyjs。"最初的回答"。

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

ui<- tagList(useShinyjs(),
tags$script(HTML("$(document).on('shiny:sessioninitialized', function(){
  var idz = [];
  var tags = document.getElementsByTagName('a');
 console.log(tags);
for (var i = 0; i < tags.length; i++) {
    idz.push(tags[i].hash);
    console.log(tags[i].hash); //console output for in browser debuggin'
                              }
 console.log(idz); // just checking again..
 Shiny.onInputChange('mydata', idz);
                          })")),

             navbarPage(title = "Example",

                   tabPanel("Event List",
                            sidebarLayout(
                              sidebarPanel(list(
                                p("If you click the link, it should go to the edit event panel."),
                                p("And now it does...")
                              ), align="left"),
                              mainPanel(
                                h3("Event List"),
                                DT::dataTableOutput('table'),
                                dataTableOutput('events_table'),
                                shiny::textOutput("mydata"),
                                align="center"))),
                   tabPanel("Edit Event", value='edit',
                            sidebarLayout(
                              sidebarPanel(
                                uiOutput("choose_event_id"),
                                align="center"),
                              mainPanel()
                            )),
                   id='top'
))




server<- shinyServer(function(input, output, session) {
  my_choices_list<- c("Dog", "Cat", "Fish")

  output$choose_event_id  <- renderUI({
    selectizeInput("event_id", "Event", width='100%',
                   choices=my_choices_list, selected=my_choices_list[1])
  })
  output$mydata<- renderPrint({
    tmp<- input$mydata
    tmp<- tmp[2:length(tmp)]
    tmp<- unlist(tmp)
    paste0("HREF value of other tab(s).... ",  tmp, collapse = ", ")
  })
  mylinks<- reactive({
    if(!is.null(input$mydata)){
      tmp<- input$mydata
      tmp<- tmp[2:length(tmp)] # All tabs except the first tab
      tmp
    }
  })

  output$table <- DT::renderDataTable({
    if(is.null(mylinks())){
      table<- data.frame(A=1, B=2)
    }
    if(!is.null(mylinks())){
      links_list<- paste0('<a href="', mylinks(),'" data-toggle="tab">test</a>')
      table<- DT::datatable(data.frame(A=my_choices_list, B=rep(links_list, length(my_choices_list))),rownames = FALSE, escape = FALSE,  selection = 'single', options = list(dom = 't'))
    }
    table

  })
 table_proxy = dataTableProxy('table')

  observeEvent(input$table_rows_selected, {
    cat("The selected Row is...", input$table_rows_selected, "\n")
    updateNavbarPage(session = session, inputId = "top", selected = "edit")
    shiny::updateSelectizeInput(session, inputId = "event_id", selected = my_choices_list[input$table_rows_selected])
    table_proxy %>% selectRows(NULL)
  })

})


shinyApp(ui = ui, server=server)

最初的回答可能需要进行一些清理，但希望这至少能给你一个开端。

- nate