在 R Datatable 闪亮应用程序中单击按钮时,模态仅打开一次

2023-12-03

我有一个表,其中保存了书签 URL。截至目前,当您单击按钮时,它会打开模式。但是,一旦您有了第二条记录并单击该按钮,它就不会打开模式。此外,当模式打开时,它有一个 href。我怎样才能清理它并只显示 URL?

library(shiny)
library(RSQLite)
library(data.table)
library(DT)
library(dplyr)
library(rclipboard)
library(shinyBS)



ui <- function(request) {
  fluidPage(rclipboardSetup(),
    DT::dataTableOutput("x1"),
    column(
      12,
      column(3,tags$div(title="forecast", numericInput("budget_input", label = ("Total Forecast"), value = 2))),
      column(2, textInput(inputId = "description", label = "Bookmark description", placeholder = "Data Summary")),
      column(2, bookmarkButton(id="bookmarkBtn"))),
    column(2, actionButton("opt_run", "Run")),
    DT::dataTableOutput("urlTable", width = "100%"),
    tags$style(type='text/css', "#bookmarkBtn { width:100%; margin-top: 25px;}")
  )
}

server <- function(input, output, session) {

  con <- dbConnect(RSQLite::SQLite(), "bookmarks.db", overwrite = FALSE)
  myBookmarks <- reactiveValues(urlDF = NULL)

  observeEvent(input$bookmarkBtn, {
    session$doBookmark()
  })

  observeEvent(input$opt_run, {
    cat('HJE')
  })

  output$x1 <- DT::renderDataTable({
    input$opt_run
    isolate({
      datatable(
        df %>% mutate(Current  = as.numeric(Current)*(input$budget_input)), selection = 'none', editable = TRUE
      )
    })
  })

  if(dbExistsTable(con, "Bookmarks")){
    tmpUrlDF <- data.table(dbReadTable(con, "Bookmarks"))
    myBookmarks$urlDF <- tmpUrlDF[, Timestamp := as.POSIXct(Timestamp, origin="1970-01-01 00:00")]
  } else {
    myBookmarks$urlDF <- NULL
  }

  session$onSessionEnded(function() {
    tmpUrlDF <- isolate({myBookmarks$urlDF})
    if(!is.null(tmpUrlDF)){
      dbWriteTable(con, "Bookmarks", tmpUrlDF, overwrite = TRUE)
    }
    dbDisconnect(con)
  })

  setBookmarkExclude(c("bookmarkBtn", "description", "urlTable_cell_clicked", "urlTable_rows_all", "urlTable_rows_current", "urlTable_rows_selected", "urlTable_search", "urlTable_state", "urlTable_row_last_clicked"))

  df <- data.table(Channel = c("A", "B","C"),
                   Current = c("2000", "3000","4000"),
                   Modified = c("2500", "3500","3000"),
                   New_Membership = c("450", "650","700"))


  shinyInput <- function(FUN, len, id, ...) {
    inputs <- character(len)
    for (i in seq_len(len)) {
      inputs[i] <- as.character(FUN(paste0(id, i), ...))
    }
    inputs
  }

  onBookmarked(fun=function(url){
    if(!url %in% myBookmarks$urlDF$URL){
      if(is.null(myBookmarks$urlDF)){
        myBookmarks$urlDF <-
          unique(
            data.table(
              Description = input$description,
              URL = paste0("<a href='", url, "'>", url, "</a>"),
              Share = shinyInput(actionButton, 10, 'button_', label = "Assessment", onclick = 'Shiny.onInputChange(\"select_button\",  this.id)' ),
              Timestamp = Sys.time(),
              Session = session$token,
              User = Sys.getenv("USERNAME")
            ),
            by = "URL"
          )
      } else {
        myBookmarks$urlDF <-
          unique(rbindlist(list(
            myBookmarks$urlDF,
            data.table(
              Description = input$description,
              URL = paste0("<a href='", url, "'>", url, "</a>"),
              Share = shinyInput(actionButton, 10, 'button_', label = "Assessment", onclick = 'Shiny.onInputChange(\"select_button\",  this.id)' ),
              Timestamp = Sys.time(),
              Session = session$token,
              User = Sys.getenv("USERNAME")
            )
          )), by = "URL")
      }
    }
  })
  observeEvent(input$select_button, {
  showModal(urlModal(
   myBookmarks$urlDF[input$urlTable_rows_selected,URL],
    title = "You have selected a row!"
  ))
  })

  output$urlTable = DT::renderDataTable({
    req(myBookmarks$urlDF)
    myBookmarks$urlDF[User %in% Sys.getenv("USERNAME")] 
  }, escape=FALSE)

}
enableBookmarking(store = "url")
shinyApp(ui, server)

这就是我认为你所追求的:

library(shiny)
library(RSQLite)
library(data.table)
library(DT)
library(dplyr)
library(shinyjs)

ui <- function(request) {
  fluidPage(
    useShinyjs(),
    DT::dataTableOutput("x1"),
    column(
      12,
      column(3, tags$div(title="forecast", numericInput("budget_input", label = ("Total Forecast"), value = 2))),
      column(2, textInput(inputId = "description", label = "Bookmark description", placeholder = "Data Summary")),
      column(2, bookmarkButton(id="bookmarkBtn"))),
    column(2, actionButton("opt_run", "Run")),
    DT::dataTableOutput("urlTable", width = "100%"),
    tags$style(type='text/css', "#bookmarkBtn { width:100%; margin-top: 25px;}")
  )
}

server <- function(input, output, session) {

  con <- dbConnect(RSQLite::SQLite(), "bookmarks.db", overwrite = FALSE)
  myBookmarks <- reactiveValues(urlDF = NULL)

  observeEvent(input$bookmarkBtn, {
    session$doBookmark()
  })

  observeEvent(input$opt_run, {
    cat('HJE')
  })

  df <- data.table(Channel = c("A", "B","C"),
                   Current = c("2000", "3000","4000"),
                   Modified = c("2500", "3500","3000"),
                   New_Membership = c("450", "650","700"))

  output$x1 <- DT::renderDataTable({
    input$opt_run
    req(input$budget_input)
    isolate({
      datatable(
        df %>% mutate(Current  = as.numeric(Current)*(input$budget_input)), selection = 'none', editable = TRUE
      )
    })
  }, server = FALSE)

  if(dbExistsTable(con, "Bookmarks")){
    tmpUrlDF <- data.table(dbReadTable(con, "Bookmarks"))
    myBookmarks$urlDF <- tmpUrlDF[, Timestamp := as.POSIXct(Timestamp, origin="1970-01-01 00:00")]
  } else {
    myBookmarks$urlDF <- NULL
  }

  observe({
    toExclude <- c("bookmarkBtn", "description", "urlTable_cell_clicked", "urlTable_rows_all", "urlTable_rows_current", "urlTable_rows_selected", "urlTable_search", "urlTable_state", "urlTable_row_last_clicked")

    if(!is.null(myBookmarks$urlDF)){
      shareBtnExclude <- paste0("shareBtn", seq_len(nrow(myBookmarks$urlDF)))
      toExclude <- c(toExclude, shareBtnExclude)
    }

    delayExclude <- grep("delay", names(input), value = TRUE)
    if(length(delayExclude) > 0){
      toExclude <- c(toExclude, delayExclude)
    }

    setBookmarkExclude(toExclude)
  })

  session$onSessionEnded(function() {
    tmpUrlDF <- isolate({myBookmarks$urlDF})
    if(!is.null(tmpUrlDF)){
      dbWriteTable(con, "Bookmarks", tmpUrlDF, overwrite = TRUE)
    }
    dbDisconnect(con)
  })

  onBookmarked(fun=function(url){
    if(!url %in% myBookmarks$urlDF$Link){
      if(is.null(myBookmarks$urlDF)){
        myBookmarks$urlDF <-
          unique(
            data.table(
              Description = input$description,
              Link = paste0("<a href='", url, "'>", url, "</a>"),
              Share = as.character(actionButton(inputId=paste0("shareBtn", 1), label = "Assessment", onclick = sprintf('Shiny.setInputValue("shareBtn1", "%s", {priority: "event"});', url))),
              Timestamp = Sys.time(),
              Session = session$token,
              User = Sys.getenv("USERNAME")
            ),
            by = "Link"
          )
      } else {
        myBookmarks$urlDF <-
          unique(rbindlist(list(
            myBookmarks$urlDF,
            data.table(
              Description = input$description,
              Link = paste0("<a href='", url, "'>", url, "</a>"),
              Share = as.character(actionButton(inputId=paste0("shareBtn", nrow(myBookmarks$urlDF)+1), label = "Assessment", onclick = sprintf('Shiny.setInputValue("%s", "%s", {priority: "event"});', paste0("shareBtn", nrow(myBookmarks$urlDF)+1), url))),
              Timestamp = Sys.time(),
              Session = session$token,
              User = Sys.getenv("USERNAME")
            )
          )), by = "Link")
      }
    }
  })

  output$urlTable = DT::renderDataTable({
    req(myBookmarks$urlDF)
    myBookmarks$urlDF[User %in% Sys.getenv("USERNAME")] 
  }, escape=FALSE, selection = 'none')

  observeEvent(lapply(paste0("shareBtn", seq_len(nrow(req(myBookmarks$urlDF)))), function(x) input[[x]]), {
    req(myBookmarks$urlDF)
    delay(100, {req(input[[paste0("shareBtn", input$urlTable_cell_clicked$row)]])
      showModal(urlModal(
        input[[paste0("shareBtn", input$urlTable_cell_clicked$row)]],
        title = paste("You have selected row", input$urlTable_cell_clicked$row)
      ))}
    )
  }, ignoreInit = TRUE)

}

enableBookmarking(store = "url")
shinyApp(ui, server)

我把你的电话挂断至shinyInput,您要求函数每行创建 10 个操作按钮。我还改变了onclick参数直接传递 url。

老实说,我不认为将这些按钮添加到每个数据表行是一个不错的选择,因为您必须跟踪要通过书签排除的动态生成的输入setBookmarkExclude(这似乎效果不太好)。

编辑:将排除部分放在单独的observer代替 这onBookmark函数似乎可以解决这个问题。

尽管如此,this对于创建由动态创建的按钮触发的观察者非常有帮助。

单击链接后直接将 url 复制到剪贴板的解决方案会更优雅,但应在另一个问题中解决。

本文内容由网友自发贡献,版权归原作者所有,本站不承担相应法律责任。如您发现有涉嫌抄袭侵权的内容,请联系:hwhale#tublm.com(使用前将#替换为@)

在 R Datatable 闪亮应用程序中单击按钮时,模态仅打开一次 的相关文章

  • R 带有列和行的分面 qqplots

    我需要使用按行和列的构面创建 qqplot 我了解如何用列和行绘制分面图 但我不确定如何设置我的数据 最终 我想按列和行对数据集进行分组 然后按升序对 建模 结果和 观察到 结果进行排序 同时添加带有 行 组的列和带有 列 组的列 我一直在
  • 距数据帧中最近的非 NA 值的距离

    我有以下数据帧 df 我想添加一列 其中包含与每行最接近的非 NA 值的距离 df lt data frame x 1 20 df c 1 3 4 5 11 14 15 16 x lt NA 换句话说 我正在寻找以下值 df distanc
  • 如何更改 r 中的树状图标签

    我在 R 中有一个树形图 它基于使用 hclust 的分层聚类 我正在对不同颜色的标签进行着色 但是当我尝试使用以下命令更改树图的标签 集群所基于的数据帧的行 时dendrogram dendrogram gt set labels dat
  • mlogit:需要 TRUE/FALSE 时缺少值

    我有来自离散选择实验 DCE 的数据 该实验研究了来自不同行业的个人的招聘偏好 我已经格式化为长格式 我想使用 mlogit 进行建模 我已导出数据 并且可以使用 asclogit 命令在 Stata 中成功运行模型 但在 R 中运行时遇到
  • 如何使用 ggplot2 对曲线下的区域进行着色

    我一直在尝试使用 ggplot2 生成类似于此 R 图形的绘图 xv lt seq 0 4 0 01 yv lt dnorm xv 2 0 5 plot xv yv type l polygon c xv xv lt 1 5 1 5 c y
  • R - 通过合并和超过 2 个后缀进行减少(或者:如何合并多个数据帧并跟踪列)

    我正在尝试基于 2 列合并 4 个数据帧 但要跟踪列源自哪个数据帧 我在跟踪列时遇到问题 参见 dput dfs 帖子末尾 df example df1 Name Color Freq banana yellow 3 apple red 1
  • Angular-Datatables + Angular-xeditable:取消可编辑行

    当组合 Angular DataTables 和 Angular XEditable 时 添加新行时会取消可编辑行 这是jsfiddle https jsfiddle net faj61h5d 10 示例操作如下 1 这是初始状态 2 将第
  • 闪亮:在 downloadHandler 中使用 validate()

    我有一个闪亮的应用程序 单击按钮后会打印报告 报告创建是通过 downloadHandler 函数进行的 我希望在导出报告之前有一个强制输入字段 合适的 Shiny 函数是 validate https shiny rstudio com
  • 如何检查jquery数据表中的每个复选框?

    我有一个第一列带有复选框的表格 我使用 jQuery DataTable 插件显示我的表格 我制作了 2 个链接来选择 取消选择每个复选框 这是选择全部的一个 a href Select all a 和 JavaScript functio
  • 在 R 的替换命令中取消引用字符串

    我想知道是否可以unquote通过替换命令传递给表达式的字符串 具体来说 我使用 dplyr 从数据框中过滤和选择 gt w subject sex response 1 1 M 19 08 2 2 M 16 46 6 6 M 23 60
  • RMySQL fetch - 找不到继承的方法

    使用 RMySQL 我想将数据从数据库加载到 R 中的数据帧中 为此 我使用以下代码 R连接数据库 con lt dbConnect MySQL user root password password dbname prediction h
  • 如何将数据从长格式重塑为宽格式

    我在重新排列以下数据框时遇到问题 set seed 45 dat1 lt data frame name rep c firstName secondName each 4 numbers rep 1 4 2 value rnorm 8 d
  • 如何不显示 ggplot 轴上的所有标签?

    I m trying to using ggplot2 to plot this But as you can see on the x axis you can t read anything 那么如何在 x 轴上显示每 10 年的值呢
  • 来自大型数据帧的共现

    我有一个数据框 其中包含有关每个用户访问过哪些城市的信息 df visited lt data frame user c john john claire claire doe doe city c Antananarivo Barcelo
  • 在zooreg时间序列中查找非唯一索引条目时遇到问题

    我有几年的数据正在尝试将其转化为动物园对象 Dropbox 上的 csv https www dropbox com sh vg8w8pt16e0v3xs AABKtWqDkPu9JVKpwBXO36VOa dl 0 一旦数据被强制转换为动
  • 连接树状图和热图

    我有一个heatmap 一组样本的基因表达 set seed 10 mat lt matrix rnorm 24 10 mean 1 sd 2 nrow 24 ncol 10 dimnames list paste g 1 24 sep p
  • 基本 dyplr 函数给出错误:“check_dots_used”

    试图找出为什么我会收到此错误 以前从未见过 谷歌没有帮助 check dots used action warn 中的错误 未使用参数 action warn 我在下面的非常基本的试验中收到错误 而且在 group by count 中也收
  • 如果值大于或小于,则替换数据框中的值

    我在 R 中操作数据帧时遇到问题 这是 R 中的基本内容 但我找不到执行此类操作的最佳命令 虚拟示例 Var1 20 300 39 Var2 49 23 91 Var3 0 239 210 我怎样才能用10如果值小于 则在第 2 列中10
  • Matlab 中是否有相当于 R 的 dput() 的函数?

    Matlab 中是否有相当于 R 的 dput 的函数 dput 将 R 对象的 ASCII 文本表示形式写入文件或连接 UPDATE 1 添加了递归和对单元格的支持 UPDATE 2 添加了对结构的支持 UPDATE 3 增加了对逻辑 整
  • ggplot 按因子和梯度颜色

    我正在尝试绘制一个对两个变量 一个因子和一个强度 进行着色的图 我希望每个因素都是不同的颜色 并且我希望强度是白色和该颜色之间的渐变 到目前为止 我已经使用了诸如对因子进行分面等技术 将颜色设置为两个变量之间的相互作用 并将颜色设置为因子并

随机推荐