modalDialog in my shiny app - Dashboard

Hello,

I would like to realize a workflow with rshiny : when a person's activity is over the shiny interface sends a message to another person in the workflow.
My data is a 10 columns table with several informations of which 4 columns represent the activities of the 4 persons.

We can imagine if we click on a line that would open a window with a workflow (4 boxes) ...

Do you have an idea how to do this on rshiny ? Is it possible ? Do you have any examples?

Thanks in advance to your help!

Hello, I'm sorry I don't have a code. I would like to know if you have ever seen the type of workflow with the rshiny application. It will be great!

Also I would like to know if you know any examples with DT packages advanced eg with javascript

I'm stuck to exploit the dataTableOutput('w.line'), valueBoxOutput("ecr"),valueBoxOutput("bem"),
In my modalDialog, I would like to have the values of the selected row in the be and SQ columns. Above these values I would like to put one the values of the valueBox if the be box is empty then red if not green and if SQ box is filled then green.
When a person enters a value in one of the boxes be or SQ (date) I would like to have the possibility to send an email.
I hope to be clear and if you have any ideas I'm interested.

Thank you in advance for your help

rrm(list = ls())
library(shiny)
library(shinydashboard)
library(data.table)
library(DT)


wf<-readRDS("dt.rds")

###########UI

ui<-dashboardPage(dashboardHeader(disable = T),
                  dashboardSidebar(disable = T),
                  dashboardBody(uiOutput("MainBody")
                )
              
)

###############SERVER

server<-function(input, output) {
  
  #vals<-reactiveValues()
  #vals$Data<-wf%>%
   # select(-.data$Description_du_defaut)
  
  
  vals<-reactiveValues()
  vals$Data<-data.table(
              pers=paste0("Brand",1:10),
              act=sample(1:20,10),
              be=c("09-11-2020","","","","","10-10-2020","","","",""),
              SQ=c("","2020-10-10"),
              Last_Year_Purchase=round(rnorm(10,1000,1000)^2),
              Contact=paste0(1:10,"@email.com")
  )
  
  
  output$MainBody<-renderUI({
    fluidPage(
      box(width=12,
          h3(strong("Actions on datatable with buttons"),align="center"),
          hr(),
           column(12,dataTableOutput("Main_table")),

          tags$script("$(document).on('click', '#Main_table button', function () {
                        Shiny.onInputChange('lastClickId',this.id);
                        Shiny.onInputChange('lastClick', Math.random())
  });")
          
      )
    )
  })
  
  output$Main_table<-renderDataTable({
    DT=vals$Data
   # DT[["Select"]]<-paste0('<input type="checkbox" name="row_selected" value="Row',1:nrow(vals$Data),'"><br>')
    
    DT[["Actions"]]<-
      paste0('
             <div class="btn-group" role="group" aria-label="Basic example">
                
                <button type="button" class="btn btn-secondary modify"id=workflow',1:nrow(vals$Data),'>Workflow</button>
             </div>
             
             ')
    datatable(DT,
              escape=F)}
  )
  

  ##Managing in row deletion
  modal_modify<-modalDialog(
                fluidPage(
                  h3(strong("WorkFLow : DT-DI-SQ"),align="center"),
                  hr(),
                  dataTableOutput('w.line'),
                  valueBoxOutput("ecr"),
                  valueBoxOutput("bem"),
                  actionButton("save_changes","Save changes"),
                  tags$script(HTML("$(document).on('click', '#save_changes', function () {
                                      var list_value=[]
                                      for (i = 0; i < $( '.new_input' ).length; i++)
                                                             {
                                                                list_value.push($( '.new_input' )[i].value)
                                                             }
                                      Shiny.onInputChange('newValue', list_value)
                                        });"))
                ),
                size="l"
              )
  
  
  observeEvent(input$lastClick,
               {
                 if (input$lastClickId%like%"workflow")
                 {
                   showModal(modal_modify)
                 }
               }
  )
  
}


shinyApp(ui, server)

Hello,
I was able to make something out of Jienagu's work (see link below).
https://github.com/jienagu/Shiny_Full_Flow
https://community.rstudio.com/t/shiny-contest-submission-capture-user-interaction-with-widget-for-reproducibility/23602
So I inserted in my main table a button that allows me to access modal() from the row selection.
In the test page the selected row is displayed. I have DT::datatable I added the option editable='cells'.
I am now blocked to save the values (that I modified in the test page for the "be" and "sq" columns) in the main table.
Another point in the test page I would like to keep the comments I put but which will not be visible in the main table.

Do you have an idea?
Thanks in advance to your help!

rm(list = ls())
library(shiny)
library(shinydashboard)
library(data.table)
library(DT)
library(dplyr)

###########UI

ui<-dashboardPage(dashboardHeader(disable = T),
                  dashboardSidebar(disable = T),
                  dashboardBody(uiOutput("MainBody")
                  )
                  
)

###############SERVER

server<-function(input, output) {
  
  #vals<-reactiveValues()
  #vals$Data<-wf%>%
  # select(-.data$Description_du_defaut)
  
  
  vals<-reactiveValues()
  #vals$Data<-wf
  vals$Data<-data.table(
              pers=paste0("Brand",1:10),
              act=sample(1:20,10),
              be=c("09-11-2020","","","","","10-10-2020","","","",""),
              SQ=c("","","2020-10-10","","","","","","","",""),
              Last_Year_Purchase=round(rnorm(10,1000,1000)^2),
              Contact=paste0(1:10,"@email.com")
   )
 
  output$MainBody<-renderUI({
    fluidPage(
      
      box(width=12,
          h3(strong("DATASET"),align="center"),
          hr(),
          column(12,dataTableOutput("Main_table")),
          tags$script("$(document).on('click', '#Main_table button', function () {
                                        Shiny.onInputChange('lastClickId',this.id);
                                        Shiny.onInputChange('lastClick', Math.random())
                                        });"),
          tags$head(tags$style(".modal-dialog{ width:1500px}")),
          tags$head(tags$style(".modal-body{ min-height:900px}")),
          tags$head(tags$style(".workflow{background-color:#230682;} .workflow{color: #e6ebef;}")),
          
      )
    )
  })
  
  output$Main_table<-renderDataTable({
                    DT=vals$Data
                    DT[["Actions"]]<-
                      paste0('
                                               <div class="btn-group" role="group" aria-label="Basic example">
                                               <button type="button" class="btn btn-secondary modify"id=workflow',1:nrow(vals$Data),'>Workflow</button>
                                               </div>
                                                ')
                    
                    datatable(DT,
                              escape=F,rownames = FALSE)}
  )
  
  
  ##Managing in row deletion
  modal_modify<-modalDialog(
    
    fluidPage(
              h3(strong("TEST"),align="center"),
              hr(),
              fluidRow(
                        box(title = "Worflow"
                            ,width = 12
                            ,valueBoxOutput("ecr")
                            ,valueBoxOutput("bem")
                        )
                        ,br()
                        ,box(title = "Value"
                             ,width = 12
                             ,dataTableOutput('row_modif')
                        )
                        ,br()
                        ,box(title = "Comments",
                             tags$textarea(id    = 'markdowninput', rows  = 3, style = 'width:100%;'))
                        ,actionButton("save_changes","Save changes")
                        ,tags$script(HTML("$(document).on('click', '#save_changes', function () {
                                                          var list_value=[]
                                                          for (i = 0; i < $( '.new_input' ).length; i++)
                                                                                 {
                                                                                    list_value.push($( '.new_input' )[i].value)
                                                                                 }
                                                          Shiny.onInputChange('newValue', list_value)
                                                            });"))
      )),
    size="l"
  )
  
  
  observeEvent(input$lastClick,
               {
                 if (input$lastClickId %like% "workflow")
                 {
                   showModal(modal_modify)
                 }
               }
  )
  ###Modification 
  output$row_modif<-renderDataTable({
                    selected_row=as.numeric(gsub("workflow","",input$lastClickId))
                    old_row=vals$Data[selected_row]
                    row_change=list()
                    
                    for (i in colnames(old_row))
                    {
                      if (is.numeric(vals$Data[[i]]))
                      {
                        row_change[[i]]<-paste0('<input class="new_input" type="number" id=new_',i,'><br>')
                      }
                      else
                        row_change[[i]]<-paste0('<input class="new_input" type="text" id=new_',i,'><br>')
                    }
                    row_change=as.data.table(row_change)
                    
                    DT=vals$Data[selected_row,]
                    DT},escape=F,options=list(dom='t',scrollX = TRUE),editable = 'cell'
  )
  
  observeEvent(input$newValue,
               {
                 newValue=lapply(input$newValue, function(col) {
                   if (suppressWarnings(all(!is.na(as.numeric(as.character(col)))))) {
                     as.numeric(as.character(col))
                   } else {
                     col
                   }
                 })
                 DF=data.frame(lapply(newValue, function(x) t(data.frame(x))))
                 colnames(DF)=colnames(vals$Data)
                 vals$Data[as.numeric(gsub("workflow","",input$lastClickId))]<-DF
                 
               }
  )
  
  
  observeEvent(input$save_changes, {
    #vals$Data=vals$Data[input$newValue]
    
    # removeModal()
  })
  
  
  #PRoposition de solution : 
  # faire comme dans le fichier exemple afficher le tableau 
  output$bem<-renderValueBox({                                    
    valueBox(
      paste0(wf[1,1], digits = 1)     
      ,"resultat"
      ,icon = icon("bar-chart-o")
    )
  })
  
  output$ecr<-renderValueBox({                                    
    valueBox(
      paste0(wf[1,1], digits = 1)     
      ,"resultat"
      #,icon = icon("bar-chart-o")
    )
  })
    
}


shinyApp(ui, server)
1 Like

thank you for the references .
But my issue is to modify only two cells in test tab and saved this value in main table.
I'm blocked at this level

1 Like

Hi @sbl_bah,

For the DT editor part, I also have a Shiny module to help users to quickly get what they want and no need handle javascript code. I have tested it using the data you provided here.

Step 1: download from the Shiny module: https://github.com/jienagu/DT_editor_shiny_module
Step 2: replace the note.rds with your data table

test_dt <- data.table(
  pers=paste0("Brand",1:10),
  act=sample(1:20,10),
  be=c("09-11-2020","","","","","10-10-2020","","","",""),
  SQ=c("","","2020-10-10","","","","","","",""),
  Last_Year_Purchase=round(rnorm(10,1000,1000)^2),
  Contact=paste0(1:10,"@email.com")
)
saveRDS(test_dt, "note.rds")
#saveRDS(test_dt, "your note.rds location")

Now run the app and you should be able to have all DT features.

Step 3: I saw you have some extra features, please add them to the current shiny app and customize as needed. :slight_smile:

This is the fastest way and you don't need to hack the JS code in R side.

Thanks to your answer I was able to move forward.

I tried to put the edit button directly in the main table but it doesn't work.

  #### render DataTable part ####
  output$Main_table_trich<-renderDataTable({
    DT=vals_trich$Data

    # DT<-DT%>%
    #    mutate(Actions = paste0(
    #                           div(style="display:inline-block;width:30%;text-align: center;",
    #                               actionButton(inputId = "mod_row_head",label = "Edit", class="butt4")),
    #                         1:nrow(vals_trich$Data),
    #                       tags$head(tags$style(".butt4{background-color:#4d1566;} .butt4{color: #e6ebef;}"))
    #                     ))
    
    datatable(DT,selection = 'single',
              escape=F) 
  })

So I left the edit button in mainbody

I would now like to do two things when I edit a line :

1 - save each comment that will be added for each edited line; this means that when I reopen the line, I always find the comment.
Do I need to create a new table (e.g tab.rds) to store the comments?
2I would like to check when the BE and SQ columns are empty or fill in a date then the valueBox turns green or red (empty).
Below is the code extract but it doesn't increment, do you have any suggestions?

 ### edit button
  observeEvent(input$mod_row_head,{
    showModal(
      if(length(input$Main_table_trich_rows_selected)>=1 ){
        modalDialog(
          fluidPage(
            h3(strong("TEST"),align="center"),
            hr(),
            fluidRow(
              tags$style(
                type = 'text/css', 
                '.bg-aqua {background-color: #005CB9!important; }'
              ),
              box(title = "Worflow"
                  ,width = 12
                  ,valueBoxOutput("bem",width = 3)
                  ,valueBoxOutput("bee",width = 3))
              ,br()
              ,box(title = "Value"
                   ,width = 12
                   ,dataTableOutput('row_modif'))
              ,br()
              ,box(title = "Comments",
                   tags$textarea(id    = 'markdowninput', rows  = 3, style = 'width:100%;'))
              ,br()
              ,box(actionButton("save_changes","Save changes"))
              ,tags$script(HTML("$(document).on('click', '#save_changes', function () {
                                                                                var list_value=[]
                                                                                for (i = 0; i < $( '.new_input' ).length; i++)
                                                                                                       {
                                                                                                          list_value.push($( '.new_input' )[i].value)
                                                                                                       }
                                                                                Shiny.onInputChange('newValue', list_value)
                                                                                  });"))
            )),size="l"
        )
      }else{
        modalDialog(
          title = "Warning",
          paste("Please select the row that you want to edit!" ),easyClose = TRUE
        )
      }
      
    )
  })
 output$bem<-renderValueBox({
    valueBox(
      paste0(vals_trich$Data[1,3])     
      ,"Avbe"
      ,icon = icon("bar-chart-o")
      ,color = ifelse(vals_trich$Data[1,3] == "", "orange", 
                      ifelse(vals_trich$Data[1,3] !="", "green","yellow"))
      ,width = 1
    )
  })
  
  output$bee<-renderValueBox({                                    
    valueBox(
      paste0(vals_trich$Data[1,4])     
      ,"AvSQ"
      ,icon = icon("bar-chart-o")
      ,color = ifelse( vals_trich$Data[1,4] == "", "orange", 
                       ifelse(vals_trich$Data[1,4] !="", "green","yellow"))
    )
  })

Thanks in advance to your help!

I don't know javascript and I would like to retrieve the value of :

<input class="new_input" value= "219/08" type="textarea"  id=new_ECR><br>

in other variable.
The output above is a output of DT value

 output$row_modif.prio<-renderDT({
                          selected_row=input$prio_rows_selected
                          old_row=vals_prio$Data[selected_row]
                          row_change=list()
                          for (i in colnames(old_row)){
                            if (is.numeric(vals_prio$Data[[i]])){
                              row_change[[i]]<-paste0('<input class="new_input" value= ','"',old_row[[i]],'"','  type="number" id=new_',i,' ><br>')} 
                              #else if( is.Date(vals_prio$Data[[i]])){
                              # row_change[[i]]<-paste0('<input class="new_input" value= ','"',old_row[[i]],'"',' type="date" id=new_  ',i,'  ><br>') 
                             #}
                            else{row_change[[i]]<-paste0('<input class="new_input" value= ','"',old_row[[i]],'"',' type="textarea"  id=new_',i,'><br>')}
                          }
                          row_change=as.data.table(row_change)
                          setnames(row_change,colnames(old_row))
                          DT=row_change
                          DT
                          },escape=F,options=list(dom='t',scrollX = TRUE),selection= list(target = 'cell'))

have you an idea?

I had made a lot of progress in my application but you are right the direction of Javascript in my code is not a good thing.
I'll look at datatable proxy.
Thanks

I personally don't like the idea of hacking directly on javascript code to achieve DT table edits in R shiny.
I would advise you to read about dataTableProxy which is a common mechanism through which to facilitate edits, and there is much content available. e.g. http://www.stencilled.me/post/2019-04-18-editable/
There is even wrapper package (though off CRAN) https://github.com/jbryer/DTedit that may be convenient

1 Like