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

server.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链接都会更改,因此在这种情况下静态链接不起作用.

---

第二个问题是传递要在URL中编辑的记录的ID,但如果需要,可以留下后续问题.我将尝试通过使用此SO问题的答案来实现这一目标:

闪亮的保存URL状态子页面和选项卡

提前致谢.

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)

代码可能需要稍微清理一下，但希望这至少能给您一个开始。