Всплывающее окно RshiningBS

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

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

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

Я прикрепляю 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

сервер.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,"');"))
    })
  })
  
}


person Sanjay Jayaraman    schedule 18.10.2016    source источник
comment
Взгляните на мой пример, который не был оценен по первоначальному вопросу stackoverflow.com/questions/38575655/   -  person Pork Chop    schedule 18.10.2016
comment
Эй, большое спасибо. Это устранило несколько проблем, но я все еще не могу передавать данные из родительского окна в модальное окно. selectedRow() отправляет только номер кнопки, на которую нажали. Есть ли способ передать данные в модальное окно?   -  person Sanjay Jayaraman    schedule 19.10.2016
comment
Ваша переменная a должна быть реактивной, в приведенном выше коде оператор observe, который пишет в БД, не знает, что такое a. Попробуйте использовать выражение reactiveValues или reactive для данных. Также не очень разумно использовать наблюдателей для больших объемов данных.   -  person Pork Chop    schedule 19.10.2016
comment
Эй, спасибо за ваш быстрый ответ. Ценить это. Я изменил свой код на модель, аналогичную предложенному вами примеру. Поэтому я не использую реактивное выражение для данных и не использую Observer. Проблема в том, что щелчок по таблице данных возвращает только кнопку_1, а не данные строки. Как я могу получить данные строки от нажатия кнопки?   -  person Sanjay Jayaraman    schedule 19.10.2016


Ответы (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)

введите описание изображения здесь

person Pork Chop    schedule 19.10.2016
comment
Эй, спасибо, как раз то, что я искал. Но ваш eventReactive для DataRow() работает не всегда. Я конвертирую это в фрейм данных, чтобы извлечь конкретное значение для моего запроса, но он генерирует вывод только иногда. Не знаю почему. Думаю, я должен понять это. В любом случае спасибо за помощь. Ценить это. - person Sanjay Jayaraman; 20.10.2016
comment
Это работает, но вам нужно каждый раз сбрасывать щелчок по этой строке. Как он это запоминает - person Pork Chop; 20.10.2016
comment
В качестве расширения вопроса я теперь создаю ввод флажка, используя ту же блестящую функцию ввода. Строка читается как Check = shiningInput(checkboxInput, label = Check, nrow(a), 'box_', value = FALSE) . Флажок создан. Есть ли способ отследить событие щелчка этого флажка?? Событие клика для кнопки действия здесь не работает. - person Sanjay Jayaraman; 01.11.2016
comment
Вероятно, вам следует задать новый вопрос и предоставить пример, как вы делали это раньше, так как это становится загроможденным. - person Pork Chop; 01.11.2016
comment
Ладно, кажется, правильно. Я разместил новый вопрос здесь. stackoverflow.com/questions/40372745/ Заранее спасибо за помогаю. - person Sanjay Jayaraman; 02.11.2016
comment
Я думаю, что это может быть полезно для меня. Однако есть небольшая ошибка. Если вы нажмете одну и ту же кнопку дважды, она не откроется, пока вы сначала не откроете другую страницу. - person Jan Stanstrup; 05.10.2017