简体   繁体   中英

Modal opens up only once on button click in R Datatable shiny app

I have a table in which I am saving the bookmark URL. As of now when you click on the button it opens the modal. But as soon as you have the second record and click on that button it doesn't open up the modal. Also when the modal opens as of now it has a href. How can I clean it up and just show the 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)

Here is what I think you are after:

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)

I dropped your call to shinyInput , you asked the function to create 10 action buttons per row. Also I changed the onclick argument to directly pass the url.

To be honest I don't think adding those buttons to every datatable row is a good choice, because you have to keep track of the dynamically generated inputs which you want to exclude from bookmarking via setBookmarkExclude (This doesn't seem to work very well).

EDIT: putting the exclude part in a separate observer instead of the onBookmark function seems to fix the situation.

Nevertheless, this was very helpful to create an observer which is triggered by the dynamically created buttons.

A solution which directly copies the url to the clipboard after clicking the link would be more elegant, but should be adressed in another question.

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM