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://forum.posit.co/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)
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
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
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: GitHub - jienagu/DT_editor_shiny_module: This app utilize shiny module that can fit any data.table
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. 
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