Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
jlopez
sagJL
Commits
3c7c7084
Commit
3c7c7084
authored
Mar 20, 2019
by
mmassaviol
Browse files
Add compare_params, force rerun when params change
parent
dcd655a6
Changes
1
Hide whitespace changes
Inline
Side-by-side
main.R
View file @
3c7c7084
...
@@ -26,25 +26,31 @@ generate_page_input <- function(res, cnt) {
...
@@ -26,25 +26,31 @@ generate_page_input <- function(res, cnt) {
res
<-
res
+
'\t\tactionButton("'
+
cnt
$
name
+
'", "'
+
cnt
$
label
+
'", icon("'
+
cnt
$
icon
+
'"), class="'
+
cnt
$
class
+
'")'
res
<-
res
+
'\t\tactionButton("'
+
cnt
$
name
+
'", "'
+
cnt
$
label
+
'", icon("'
+
cnt
$
icon
+
'"), class="'
+
cnt
$
class
+
'")'
}
}
}
else
if
(
cnt
$
type
==
"text"
)
{
}
if
(
cnt
$
type
==
"text"
)
{
res
<-
res
+
'\t\ttextInput("'
+
cnt
$
name
+
'", label = "'
+
cnt
$
label
+
'", value = "'
+
cnt
$
value
+
'", width = "'
+
'auto'
+
'")'
res
<-
res
+
'\t\ttextInput("'
+
cnt
$
name
+
'", label = "'
+
cnt
$
label
+
'", value = "'
+
cnt
$
value
+
'", width = "'
+
'auto'
+
'")'
}
else
if
(
cnt
$
type
==
"numeric"
)
{
}
if
(
cnt
$
type
==
"numeric"
)
{
res
<-
res
+
'\t\tnumericInput("'
+
cnt
$
name
+
'", label = "'
+
cnt
$
label
+
'", min = '
+
cnt
$
min
+
', max = '
+
cnt
$
max
+
', step = '
+
cnt
$
step
+
', width = "'
+
'auto'
+
'", value = '
+
cnt
$
value
+
')'
res
<-
res
+
'\t\tnumericInput("'
+
cnt
$
name
+
'", label = "'
+
cnt
$
label
+
'", min = '
+
cnt
$
min
+
', max = '
+
cnt
$
max
+
', step = '
+
cnt
$
step
+
', width = "'
+
'auto'
+
'", value = '
+
cnt
$
value
+
')'
}
else
if
(
cnt
$
type
==
"slider"
)
{
}
if
(
cnt
$
type
==
"slider"
)
{
if
(
length
(
cnt
$
value
)
==
1
)
{
if
(
length
(
cnt
$
value
)
==
1
)
{
res
<-
res
+
'\t\tsliderInput("'
+
cnt
$
name
+
'", label = "'
+
cnt
$
label
+
'", min = '
+
cnt
$
min
+
', max = '
+
cnt
$
max
+
', step = '
+
cnt
$
step
+
', width = "'
+
'auto'
+
'", value = '
+
cnt
$
value
+
')'
res
<-
res
+
'\t\tsliderInput("'
+
cnt
$
name
+
'", label = "'
+
cnt
$
label
+
'", min = '
+
cnt
$
min
+
', max = '
+
cnt
$
max
+
', step = '
+
cnt
$
step
+
', width = "'
+
'auto'
+
'", value = '
+
cnt
$
value
+
')'
}
else
{
}
else
{
res
<-
res
+
'\t\tsliderInput("'
+
cnt
$
name
+
'", label = "'
+
cnt
$
label
+
'", min = '
+
cnt
$
min
+
', max = '
+
cnt
$
max
+
', step = '
+
cnt
$
step
+
', width = "'
+
'auto'
+
'", value = c('
+
cnt
$
value
[
1
]
+
','
+
cnt
$
value
[
2
]
+
'))'
res
<-
res
+
'\t\tsliderInput("'
+
cnt
$
name
+
'", label = "'
+
cnt
$
label
+
'", min = '
+
cnt
$
min
+
', max = '
+
cnt
$
max
+
', step = '
+
cnt
$
step
+
', width = "'
+
'auto'
+
'", value = c('
+
cnt
$
value
[
1
]
+
','
+
cnt
$
value
[
2
]
+
'))'
}
}
}
else
if
(
cnt
$
type
==
"help"
)
{
}
if
(
cnt
$
type
==
"help"
)
{
res
<-
res
+
'\t\tp("'
+
cnt
$
label
+
'")'
res
<-
res
+
'\t\tp("'
+
cnt
$
label
+
'")'
}
else
if
(
cnt
$
type
==
"link"
)
{
}
if
(
cnt
$
type
==
"link"
)
{
res
<-
res
+
'\t\tp("'
+
cnt
$
label
+
'",a(href="'
+
cnt
$
href
+
'","'
+
cnt
$
href
+
'"))'
res
<-
res
+
'\t\tp("'
+
cnt
$
label
+
'",a(href="'
+
cnt
$
href
+
'","'
+
cnt
$
href
+
'"))'
}
else
if
(
cnt
$
type
==
"select"
)
{
}
if
(
cnt
$
type
==
"select"
)
{
res
<-
res
+
'\t\tselectInput("'
+
cnt
$
name
+
'", label = "'
+
cnt
$
label
+
'", choices = list('
res
<-
res
+
'\t\tselectInput("'
+
cnt
$
name
+
'", label = "'
+
cnt
$
label
+
'", choices = list('
...
@@ -64,7 +70,8 @@ generate_page_input <- function(res, cnt) {
...
@@ -64,7 +70,8 @@ generate_page_input <- function(res, cnt) {
res
<-
res
+
' selected = "'
+
cnt
$
value
+
'"'
+
', width = "'
+
'auto'
+
'")'
res
<-
res
+
' selected = "'
+
cnt
$
value
+
'"'
+
', width = "'
+
'auto'
+
'")'
}
else
if
(
cnt
$
type
==
"radio"
)
{
}
if
(
cnt
$
type
==
"radio"
)
{
res
<-
res
+
'\t\tradioButtons("'
+
cnt
$
name
+
'", label = "'
+
cnt
$
label
+
'", choices = list('
res
<-
res
+
'\t\tradioButtons("'
+
cnt
$
name
+
'", label = "'
+
cnt
$
label
+
'", choices = list('
...
@@ -83,11 +90,13 @@ generate_page_input <- function(res, cnt) {
...
@@ -83,11 +90,13 @@ generate_page_input <- function(res, cnt) {
res
<-
res
+
' selected = "'
+
cnt
$
value
+
'"'
+
', width = "'
+
'auto'
+
'")'
res
<-
res
+
' selected = "'
+
cnt
$
value
+
'"'
+
', width = "'
+
'auto'
+
'")'
}
else
if
(
cnt
$
type
==
"checkbox"
)
{
}
if
(
cnt
$
type
==
"checkbox"
)
{
res
<-
res
+
'\t\tcheckboxInput("'
+
cnt
$
name
+
'", label = "'
+
cnt
$
label
+
'", value = '
+
cnt
$
value
+
')'
res
<-
res
+
'\t\tcheckboxInput("'
+
cnt
$
name
+
'", label = "'
+
cnt
$
label
+
'", value = '
+
cnt
$
value
+
')'
}
else
if
(
cnt
$
type
==
"chooser"
)
{
}
if
(
cnt
$
type
==
"chooser"
)
{
vl
<-
'c('
vl
<-
'c('
vr
<-
'c('
vr
<-
'c('
...
@@ -117,7 +126,8 @@ generate_page_input <- function(res, cnt) {
...
@@ -117,7 +126,8 @@ generate_page_input <- function(res, cnt) {
res
<-
res
+
'\t\tchooserInput("'
+
cnt
$
name
+
'", "Available", "Selected", '
+
vl
+
', '
+
vr
+
', size = '
+
cnt
$
size
+
', multiple = '
+
cnt
$
multiple
+
')'
res
<-
res
+
'\t\tchooserInput("'
+
cnt
$
name
+
'", "Available", "Selected", '
+
vl
+
', '
+
vr
+
', size = '
+
cnt
$
size
+
', multiple = '
+
cnt
$
multiple
+
')'
}
else
if
(
cnt
$
type
==
"checkboxGroupInput"
)
{
}
if
(
cnt
$
type
==
"checkboxGroupInput"
)
{
res
<-
res
+
'\t\tcheckboxGroupInput("'
+
cnt
$
name
+
'",label = "'
+
cnt
$
label
+
'", choices = list('
res
<-
res
+
'\t\tcheckboxGroupInput("'
+
cnt
$
name
+
'",label = "'
+
cnt
$
label
+
'", choices = list('
...
@@ -142,7 +152,8 @@ generate_page_input <- function(res, cnt) {
...
@@ -142,7 +152,8 @@ generate_page_input <- function(res, cnt) {
res
<-
res
+
'), selected = "'
+
cnt
$
value
+
'"'
+
', width = "'
+
'auto'
+
'")'
res
<-
res
+
'), selected = "'
+
cnt
$
value
+
'"'
+
', width = "'
+
'auto'
+
'")'
}
else
if
(
cnt
$
type
==
"file"
)
{
}
if
(
cnt
$
type
==
"file"
)
{
res
<-
res
+
'\t\tfileInput("'
+
cnt
$
name
+
'", label = "'
+
cnt
$
label
+
'"'
res
<-
res
+
'\t\tfileInput("'
+
cnt
$
name
+
'", label = "'
+
cnt
$
label
+
'"'
...
@@ -488,11 +499,31 @@ generate_pages_server <- function() {
...
@@ -488,11 +499,31 @@ generate_pages_server <- function() {
save_params
<-
save_params
+
'\tnames(samples) = NULL\n'
save_params
<-
save_params
+
'\tnames(samples) = NULL\n'
save_params
<-
save_params
+
'\tc$groups = unlist(samples)\n'
save_params
<-
save_params
+
'\tc$groups = unlist(samples)\n'
save_params
<-
save_params
+
'\twrite_yaml(c,path_param,handlers=list(logical = logical))\n'
save_params
<-
save_params
+
'\twrite_yaml(c,path_param,handlers=list(logical = logical))\n'
save_params
<-
save_params
+
'\treturn(c)\n'
save_params
<-
save_params
+
'\t}\n\n'
save_params
<-
save_params
+
'\t}\n\n'
res
<-
save_params
res
<-
save_params
# Compare parameters (give rules that need to be re-runned)
res
<-
res
+
'compare_params = function(dossierAnalyse){\n'
res
<-
res
+
'\tif (!file.exists(paste0(dossierAnalyse,"/lastrun/params.yml"))){\n'
res
<-
res
+
'\t\treturn(c())\n'
res
<-
res
+
'\t}\n'
res
<-
res
+
'\telse{\n'
res
<-
res
+
'\t\tnew_params = yaml.load_file(paste0(dossierAnalyse,"/params.yml"))\n'
res
<-
res
+
'\t\told_params = yaml.load_file(paste0(dossierAnalyse,"/workflow/params.yml"))\n'
res
<-
res
+
'\t\tchanged = new_params[!(new_params %in% old_params)]\n'
res
<-
res
+
'\t\trules = c()\n'
res
<-
res
+
'\t\tif (length(changed)>=1){\n'
res
<-
res
+
'\t\t\tfor (param in names(changed)){\n'
res
<-
res
+
'\t\t\t\tif (!grepl("_threads$",param)){\n'
res
<-
res
+
'\t\t\t\t\trules = c(rules, new_params$params_info[[param]]$rule)\n'
res
<-
res
+
'\t\t\t\t}\n'
res
<-
res
+
'\t\t\t}\n'
res
<-
res
+
'\t\t}\n'
res
<-
res
+
'\t\treturn(unique(rules))\n'
res
<-
res
+
'\t}\n'
res
<-
res
+
'}\n'
file.replace
(
APP
$
project
+
"/server/opt_global.R"
)
file.replace
(
APP
$
project
+
"/server/opt_global.R"
)
#res <- ""
#res <- ""
# Event RULEGRAPH
# Event RULEGRAPH
...
@@ -504,7 +535,7 @@ generate_pages_server <- function() {
...
@@ -504,7 +535,7 @@ generate_pages_server <- function() {
res
<-
res
+
'\t\ttoggle_inputs(input_list,F,F)\n'
res
<-
res
+
'\t\ttoggle_inputs(input_list,F,F)\n'
res
<-
res
+
'\t\tpath_param <- paste0(input$results_dir,"/params.yml")\n\n'
res
<-
res
+
'\t\tpath_param <- paste0(input$results_dir,"/params.yml")\n\n'
res
<-
res
+
'\t\t
params <-
save_params(path_param)\n'
res
<-
res
+
'\t\tsave_params(path_param)\n'
res
<-
res
+
'\t\ti = sample.int(1000,size = 1)\n\n'
res
<-
res
+
'\t\ti = sample.int(1000,size = 1)\n\n'
res
<-
res
+
'\t\tsystem(paste0("rm ",input$results_dir,"/rulegraph*"))\n\n'
res
<-
res
+
'\t\tsystem(paste0("rm ",input$results_dir,"/rulegraph*"))\n\n'
...
@@ -538,7 +569,7 @@ generate_pages_server <- function() {
...
@@ -538,7 +569,7 @@ generate_pages_server <- function() {
#panel_path <- APP$project + '/params/' + 'params_' + APP$pages[[x]]$name + '.yml'
#panel_path <- APP$project + '/params/' + 'params_' + APP$pages[[x]]$name + '.yml'
res
<-
res
+
'\tpath_param <- paste0(input$results_dir,"/params.yml")\n\n'
res
<-
res
+
'\tpath_param <- paste0(input$results_dir,"/params.yml")\n\n'
res
<-
res
+
'\t\t
params <-
save_params(path_param)\n'
res
<-
res
+
'\t\tsave_params(path_param)\n'
res
<-
res
+
'\n\n'
res
<-
res
+
'\n\n'
res
<-
res
+
'\toutUI = tryCatch({\n'
res
<-
res
+
'\toutUI = tryCatch({\n'
...
@@ -548,8 +579,22 @@ generate_pages_server <- function() {
...
@@ -548,8 +579,22 @@ generate_pages_server <- function() {
res
<-
res
+
'\t\tif (!file.exists(paste0(input$results_dir,"/logs/runlog.txt"))){\n'
res
<-
res
+
'\t\tif (!file.exists(paste0(input$results_dir,"/logs/runlog.txt"))){\n'
res
<-
res
+
'\t\t\tfile.create(paste0(input$results_dir,"/logs/runlog.txt"))\n'
res
<-
res
+
'\t\t\tfile.create(paste0(input$results_dir,"/logs/runlog.txt"))\n'
res
<-
res
+
'\t\t}\n'
res
<-
res
+
'\t\t}\n'
res
<-
res
+
'\t\tforcerun = compare_params(input$results_dir)\n'
res
<-
res
+
'\t\tif (length(forcerun>1)){\n'
res
<-
res
+
'\t\t\trules = paste(forcerun, collapse=" ")\n'
res
<-
res
+
'\t\t\tforcerun = paste(" --forcerun ",rules)\n'
res
<-
res
+
'\t\t\tshowModal(modalDialog(\n'
res
<-
res
+
'\t\t\t\ttitle = "Params have changed since the last run",\n'
res
<-
res
+
'\t\t\t\tforcerun\n'
res
<-
res
+
'\t\t\t))\n'
res
<-
res
+
'\t\t}\n'
res
<-
res
+
'\t\telse{\n'
res
<-
res
+
'\t\t\tforcerun = ""\n'
res
<-
res
+
'\t\t}\n'
res
<-
res
+
'\t\tsystem(paste0("touch ",input$results_dir,"/logs/workflow.running"),wait = T)\n'
res
<-
res
+
'\t\tsystem(paste0("touch ",input$results_dir,"/logs/workflow.running"),wait = T)\n'
res
<-
res
+
'\t\tsystem2("python3",paste0("-u -m snakemake -s /workflow/Snakefile --configfile ", paste0(input$results_dir,"/params.yml") ,\t" -d ", input$results_dir ,\t" --cores ", input$cores, " all
"
),wait = FALSE, stdout = paste0(input$results_dir,"/logs/runlog.txt"), stderr = paste0(input$results_dir,"/logs/runlog.txt"))\n'
res
<-
res
+
'\t\tsystem2("python3",paste0("-u -m snakemake -s /workflow/Snakefile --configfile ", paste0(input$results_dir,"/params.yml") ,\t" -d ", input$results_dir ,\t" --cores ", input$cores, " all
", forcerun
),wait = FALSE, stdout = paste0(input$results_dir,"/logs/runlog.txt"), stderr = paste0(input$results_dir,"/logs/runlog.txt"))\n'
res
<-
res
+
'\t\ttags$iframe(src="results/multiqc_report.html",width="100%", height="900px")},\n'
res
<-
res
+
'\t\ttags$iframe(src="results/multiqc_report.html",width="100%", height="900px")},\n'
res
<-
res
+
'\t\terror = function(e){\n'
res
<-
res
+
'\t\terror = function(e){\n'
res
<-
res
+
'\t\t\tsystem(paste0("touch ",input$results_dir,"/logs/workflow_end.error"),wait = T)\n'
res
<-
res
+
'\t\t\tsystem(paste0("touch ",input$results_dir,"/logs/workflow_end.error"),wait = T)\n'
...
@@ -805,17 +850,17 @@ generate_app <- function() {
...
@@ -805,17 +850,17 @@ generate_app <- function() {
res
<-
res
+
'\t# if params exists reload them\n'
res
<-
res
+
'\t# if params exists reload them\n'
res
<-
res
+
'\tif (file.exists(paste0(dossierAnalyse,"/params.yml"))){\n'
res
<-
res
+
'\tif (file.exists(paste0(dossierAnalyse,"/params.yml"))){\n'
res
<-
res
+
'\t\tparams = read_yaml(paste0(dossierAnalyse,"/params.yml"))\n'
res
<-
res
+
'\t\tparams = read_yaml(paste0(dossierAnalyse,"/params.yml"))\n'
res
<-
res
+
'\t\tfor (param in names(params$params_
types
)){\n'
res
<-
res
+
'\t\tfor (param in names(params$params_
info
)){\n'
res
<-
res
+
'\t\t\tif (params$params_
types
[[param]] == "text"){\n'
res
<-
res
+
'\t\t\tif (params$params_
info
[[param]]
$type
== "text"){\n'
res
<-
res
+
'\t\t\t\tupdateTextInput(session, param, value = params[[param]])\n'
res
<-
res
+
'\t\t\t\tupdateTextInput(session, param, value = params[[param]])\n'
res
<-
res
+
'\t\t\t}\n'
res
<-
res
+
'\t\t\t}\n'
res
<-
res
+
'\t\t\t
else
if (params$params_
types
[[param]] == "numeric"){\n'
res
<-
res
+
'\t\t\tif (params$params_
info
[[param]]
$type
== "numeric"){\n'
res
<-
res
+
'\t\t\t\tupdateNumericInput(session, param, value = params[[param]])\n'
res
<-
res
+
'\t\t\t\tupdateNumericInput(session, param, value = params[[param]])\n'
res
<-
res
+
'\t\t\t}\n'
res
<-
res
+
'\t\t\t}\n'
res
<-
res
+
'\t\t\t
else
if (params$params_
types
[[param]] == "radio"){\n'
res
<-
res
+
'\t\t\tif (params$params_
info
[[param]]
$type
== "radio"){\n'
res
<-
res
+
'\t\t\t\tupdateRadioButtons(session, param, selected = params[[param]])\n'
res
<-
res
+
'\t\t\t\tupdateRadioButtons(session, param, selected = params[[param]])\n'
res
<-
res
+
'\t\t\t}\n'
res
<-
res
+
'\t\t\t}\n'
res
<-
res
+
'\t\t\t
else
if (params$params_
types
[[param]] == "select"){\n'
res
<-
res
+
'\t\t\tif (params$params_
info
[[param]]
$type
== "select"){\n'
res
<-
res
+
'\t\t\t\tupdateSelectInput(session, param, selected = params[[param]])\n'
res
<-
res
+
'\t\t\t\tupdateSelectInput(session, param, selected = params[[param]])\n'
res
<-
res
+
'\t\t\t}\n'
res
<-
res
+
'\t\t\t}\n'
res
<-
res
+
'\t\t}\n'
res
<-
res
+
'\t\t}\n'
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment