Add compare_params, force rerun when params change

main.R

@@ -26,25 +26,31 @@ generate_page_input <- function(res, cnt) {
       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 +')'
 
-  } else if(cnt$type == "slider") {
+  }
+  if(cnt$type == "slider") {
     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 +')'
     } 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] + '))'
     }
-  } else if(cnt$type == "help") {
+  }
+  if(cnt$type == "help") {
     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+'"))'
-  } else if(cnt$type == "select") {
+  }
+  if(cnt$type == "select") {
     
     
     res <- res + '\t\tselectInput("'+ cnt$name +'", label = "'+ cnt$label +'", choices = list('
@@ -64,7 +70,8 @@ generate_page_input <- function(res, cnt) {
     
     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('
     
@@ -83,11 +90,13 @@ generate_page_input <- function(res, cnt) {
     
     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 + ')'  
     
-  } else if(cnt$type == "chooser") {
+  }
+  if(cnt$type == "chooser") {
     
     vl <- 'c('
     vr <- 'c('
@@ -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 + ')'
 
-  } else if(cnt$type == "checkboxGroupInput") {
+  }
+  if(cnt$type == "checkboxGroupInput") {
     
     res <- res + '\t\tcheckboxGroupInput("'+ cnt$name +'",label = "'+ cnt$label +'", choices = list('
     
@@ -142,7 +152,8 @@ generate_page_input <- function(res, cnt) {
     
     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 + '"'
     
@@ -488,11 +499,31 @@ generate_pages_server <- function() {
   save_params <- save_params + '\tnames(samples) = NULL\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 + '\treturn(c)\n'
   save_params <- save_params + '\t}\n\n'
 
   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")
   #res <- ""
   # Event RULEGRAPH
@@ -504,7 +535,7 @@ generate_pages_server <- function() {
     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\tparams <- 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\tsystem(paste0("rm ",input$results_dir,"/rulegraph*"))\n\n'
@@ -538,7 +569,7 @@ generate_pages_server <- function() {
   #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 + '\t\tparams <- save_params(path_param)\n'
+  res <- res + '\t\tsave_params(path_param)\n'
   res <- res + '\n\n'
 
   res <- res + '\toutUI = tryCatch({\n'
@@ -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\t\tfile.create(paste0(input$results_dir,"/logs/runlog.txt"))\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\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\terror = function(e){\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() {
   res <- res + '\t# if params exists reload them\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\tfor (param in names(params$params_types)){\n'
-  res <- res + '\t\t\tif (params$params_types[[param]] == "text"){\n'
+  res <- res + '\t\tfor (param in names(params$params_info)){\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}\n'
-  res <- res + '\t\t\telse 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}\n'
-  res <- res + '\t\t\telse 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}\n'
-  res <- res + '\t\t\telse 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}\n'
   res <- res + '\t\t}\n'