bugfix when remove all genes

R/Methods-LandsepiParams.R

@@ -560,11 +560,13 @@ runSimul <- function(params, graphic=TRUE, writeTXT=TRUE, videoMP4=FALSE, keepRa
   setwd(params@OutputDir)
 
   ## remove genes not used from CultivarsGenes and Genes
-  drop_genes <- lapply(1:ncol(params@CultivarsGenes), FUN = function(c) {
-    if(sum(params@CultivarsGenes[,c]) == 0) return(c);
-  })
-  drop_genes <- which(!sapply(drop_genes,is.null))
-  
+  if(ncol(params@CultivarsGenes) >= 1) {
+    drop_genes <- lapply(1:ncol(params@CultivarsGenes), FUN = function(c) {
+      if(sum(params@CultivarsGenes[,c]) == 0) return(c);
+    })
+    drop_genes <- which(!sapply(drop_genes,is.null))
+  } else { drop_genes <- NULL }
+
   if( !is.null(drop_genes) && length(drop_genes) > 0){
     print(paste0("Genes not affected ",params@Genes[drop_genes,1]))
     cultivarsGenes_tmp <- params@CultivarsGenes[,-drop_genes]  
@@ -573,11 +575,10 @@ runSimul <- function(params, graphic=TRUE, writeTXT=TRUE, videoMP4=FALSE, keepRa
     cultivarsGenes_tmp <- params@CultivarsGenes
     Genes_tmp <- params@Genes 
   }
-  
   cultivars_genes_list <- lapply(1:nrow(params@Cultivars), FUN = function(i) {
     return(which(cultivarsGenes_tmp[i, ] == 1) - 1)
   })
-  
+
   cdf <- as.data.frame(params@Landscape)
   ncol <- length(grep("^year_", colnames(cdf)) %in% colnames(cdf))
   ## TODO: use value of Nyears in previous line?

inst/shiny-landsepi/global.R

@@ -218,6 +218,7 @@ checkCultivarsGenesTable <- function(data){
 #  2:ncol : Genes parameters
 checkGenesTable <- function(data){
   isok <- TRUE
+  #if(nrow(data) == 0 || sum(is.na(data) > 0)) return(invisible(isok))
   
   shiny::removeUI(selector = "#GenesNameError")
   if( sum(as.character(data[,1]) == "") != 0 | sum(grepl("^\\s*$",as.character(data[,1]))) != 0) {

inst/shiny-landsepi/server.R

@@ -1022,7 +1022,7 @@ server <- function(input, output, session) {
         }
         else {
           simul_params@CultivarsGenes <<- cultivars_genesTable$data
-          print(simul_params@CultivarsGenes)
+          #print(simul_params@CultivarsGenes)
           simul_params_cultivarsgenes(simul_params@CultivarsGenes)
           can_run_simul$cultivarsgenes <<- TRUE
         }
@@ -1074,11 +1074,13 @@ server <- function(input, output, session) {
           # rename genes in cultivars genes table
           # remove line -> remove genes in cultivars genes
           if (genesTable$col == 0 && nrow(simul_params@Genes) > nrow(genesTable$data)) {
+            #print("remove here")
             simul_params@CultivarsGenes <<- simul_params@CultivarsGenes[, -c(genesTable$row), drop = FALSE]
             printVerbose(paste0("set Cultivars Genes ",simul_params@CultivarsGenes))
           }
           # add line -> add a genes in cultivars genes
           if (nrow(simul_params@Genes) < nrow(genesTable$data)) {
+            #print("add here")
             simul_params@CultivarsGenes <<- cbind(simul_params@CultivarsGenes, rep(0, nrow(simul_params@CultivarsGenes)))
           }
           colnames(simul_params@CultivarsGenes) <<- genesTable$data[, 1]