在 R Shiny 中实现 CRUD 工作流的最简洁方法是啥？

Posted 2023-02-16

【中文标题】在 R Shiny 中实现 CRUD 工作流的最简洁方法是啥？

【英文标题】：What's the cleanest way to implement a CRUD workflow in R Shiny?在 R Shiny 中实现 CRUD 工作流的最简洁方法是什么？

【发布时间】：2015-04-27 17:55:13

【问题描述】：

我正在尝试在 Shiny 管理数据库记录。好像 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 链接会在每次应用重新启动时发生变化，因此静态链接在这种情况下不起作用。

---

第二个问题是将记录的 id 传递给 在 URL 中进行了编辑，但这可能留给后续问题，如果 必要的。我将尝试通过使用 这个 SO 问题的答案：

Shiny saving URL state subpages and tabs

提前致谢。

【问题讨论】：

我希望有更多的人回答这个问题。如果没有这样的工作流程，我发现很难让我的用户成为新数据分析的主导者。我知道那里有很棒的 Shiny 开发人员。也许这个问题没有简单的答案。

【参考方案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)

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