Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
CSIRO-INRA
landsepi
Commits
b2f5c1b2
Commit
b2f5c1b2
authored
Jun 29, 2021
by
Jean-Francois Rey
☕
Browse files
bugfix when remove all genes
parent
4a08b25b
Changes
3
Hide whitespace changes
Inline
Side-by-side
R/Methods-LandsepiParams.R
View file @
b2f5c1b2
...
...
@@ -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
View file @
b2f5c1b2
...
...
@@ -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
View file @
b2f5c1b2
...
...
@@ -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
]
...
...
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