Commit b2f5c1b2 authored by Jean-Francois Rey's avatar Jean-Francois Rey
Browse files

bugfix when remove all genes

parent 4a08b25b
......@@ -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?
......
......@@ -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) {
......
......@@ -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]
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment