R shinyBS всплывающее окно

Question

Я работаю над проектом, где мне нужно создать форму в блестящей форме. В настоящее время у меня есть данные в пользовательском интерфейсе, который имеет электронную почту в виде гиперссылки. После нажатия гиперссылки открывается модальное окно, где у меня есть другой пользовательский интерфейс, который показывает различные поля, которые необходимо заполнить. У меня есть кнопка сохранения здесь, которая должна обновлять мою БД в бэкэнд после нажатия кнопки.

Проблема, с которой я столкнулась, заключается в том, что я не могу ссылаться на каждое письмо в этом конкретном модальном окне, и мой запрос обновления обновляет все записи в БД. Есть ли способ передать все данные записи, которые были нажаты в модальное окно?

Мне нужно знать, как обновить запись, на которую я нажал, и для которой открывается всплывающее окно?

У меня есть UI.R и server.R для использования.

enter code here 

ui.R

library(shiny) 
 
library(DT) 
 
library(shinyBS) 
 
fluidPage(
 
     fluidRow(
 
        actionButton(inputId = "view",label = "Hi")), 
 
        #actionButton(inputId = "savepage1", label = "Save"), 
 
        DT::dataTableOutput('my_table'), 
 
        bsModal("FormModal", "My Modal", "",textOutput('mytext'),uiOutput("form1"), 
 
          actionButton("savepage2","Save"),DT::dataTableOutput("table1"),size = "large") 
 

 
     )

enter code here 

server.R

library(shinyBS) 
 
server <- function(session, input, output){ 
 
    
 
uedata<-c("","Prime","Optimus") ##add source data here 
 
    
 
    output$form1<-renderUI({ 
 
    tagList(
 
     column(width=6,selectInput("samplevalue","Select Custom Source*",choices=c("Please select",samplevaluedata))), 
 
     column(width=6,textInput("sampletext",label = "Enter Text",value = NULL,placeholder = NULL))) 
 
    }) 
 

 
    on_click_js = "Shiny.onInputChange('mydata', '%s'); 
 
    $('#FormModal').modal('show')" 
 
    
 
    convert_to_link = function(x) { 
 
    as.character(tags$a(href = "#", onclick = sprintf(on_click_js,x), x)) 
 
    } 
 
    
 
    observeEvent(input$view,{ 
 
    session$sendCustomMessage(type = "unbinding_table_elements", "my_table") 
 
    output$my_table <- DT::renderDataTable({ 
 
     a=dbGetQuery(hcltcprod,paste0("select name,mobile,email,assignedto from public.tempnew order by 3;")) 
 
     a <- data.frame(a,row.names = NULL) 
 
     a$email <- sapply(a$email,convert_to_link) 
 
     a1 <- datatable(a, 
 
        escape = F, 
 
        options = list(paging = FALSE, ordering = FALSE, searching = FALSE, rownames = FALSE, 
 
            preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node());}'), 
 
            drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); } '))) 
 
            
 
     a1 
 
    }) 
 
    }) 
 
    
 
    observeEvent(input$my_table_cell_clicked, { 
 
    print(Sys.time()) 
 
    }) 
 

 
    observe({ 
 
    if(input$savepage2==0) 
 
     return() 
 
    isolate({ 
 
     for(i in 1:nrow(a)) 
 
    dbGetQuery(hcltcprod,paste0("update public.tempnew set s_text='",input$samplevalue,"',s_value='",input$sampletext,"' where mobile in ('",a$email,"');")) 
 
    }) 
 
    }) 
 
    
 
}

Answer 1

Как ваш пример подключен к базе данных, и вы не предоставили данные примера, я отправлю с mtcars набором данных. Основываясь на примере в ссылке вы можете просмотреть выбранные данные, используя следующие:

rm(list = ls()) 
library(DT) 
library(shiny) 
library(shinyBS) 
library(shinyjs) 
library(shinydashboard) 

# This function will create the buttons for the datatable, they will be unique 
shinyInput <- function(FUN, len, id, ...) {inputs <- character(len) 
              for (i in seq_len(len)) { 
              inputs[i] <- as.character(FUN(paste0(id, i), ...))} 
              inputs 
} 

ui <- dashboardPage(
    dashboardHeader(title = "Simple App"), 
    dashboardSidebar(
    sidebarMenu(id = "tabs", 
       menuItem("Menu Item 1", tabName = "one", icon = icon("dashboard")) 
    ) 
), 
    dashboardBody(
    tabItems(
     tabItem(tabName = "one",h2("Datatable Modal Popup"), 
       DT::dataTableOutput('my_table'),uiOutput("popup") 
    ) 
    ) 
) 
) 

server <- function(input, output, session) { 
    my_data <- reactive({ 
    testdata <- mtcars 
    as.data.frame(cbind(View = shinyInput(actionButton, nrow(testdata),'button_', label = "View", onclick = 'Shiny.onInputChange(\"select_button\", this.id)'),testdata)) 
    }) 
    output$my_table <- DT::renderDataTable(my_data(),selection = 'single',options = list(searching = FALSE,pageLength = 10),server = FALSE, escape = FALSE,rownames= FALSE) 

    # Here I created a reactive to save which row was clicked which can be stored for further analysis 
    SelectedRow <- eventReactive(input$select_button,{ 
    as.numeric(strsplit(input$select_button, "_")[[1]][2]) 
    }) 

    # This is needed so that the button is clicked once for modal to show, a bug reported here 
    # https://github.com/ebailey78/shinyBS/issues/57 
    observeEvent(input$select_button, { 
    toggleModal(session, "modalExample", "open") 
    }) 

    DataRow <- eventReactive(input$select_button,{ 
    my_data()[SelectedRow(),2:ncol(my_data())] 
    }) 

    output$popup <- renderUI({ 
    bsModal("modalExample", paste0("Data for Row Number: ",SelectedRow()), "", size = "large", 
      column(12,     
        DT::renderDataTable(DataRow()) 

      ) 
    ) 
    }) 

} 

shinyApp(ui, server)