Skip to content
GitLab
Commit ad7a3b1b authored by Jean-Francois Rey's avatar Jean-Francois Rey ☕
Browse files

update shiny apps 

advanced mode keep memory of modification when switching
parent 00eb78c5
Hide whitespace changes
Inline Side-by-side
inst/shiny-landsepi/global.R
View file @ ad7a3b1b
......@@ -37,7 +37,7 @@ cleanDir(paste0(ROOT_PATH,"/www/tmp/"))
advanced_mode <- reactiveVal(FALSE)
## Croptypes proportions in landscape
croptypes_proportions <- c(1)
croptypes_proportions <- shiny::reactiveVal(c(1))
## simul params reactive for view
## use to update view
......@@ -96,7 +96,7 @@ checkCroptypesTable <- function(data) {
## no cultivars
if( ncol(data) <= 2) {
showErrorMessage( id = "croptypeError", selectorafter = "#generateLandscape",
message = paste0("There is no cultivars defined"))
message = paste0("There is no cultivars defined in croptypes"))
isok <- FALSE
}
else{
......@@ -129,6 +129,7 @@ checkCroptypesTable <- function(data) {
checkCultivarsTable <- function(data) {
isok <- TRUE
shiny::removeUI(selector = "#cultivarsNameError")
if( sum(as.character(data[,1]) == "") != 0 | sum(grepl("^\\s*$",as.character(data[,1]))) != 0) {
showErrorMessage(id = "cultivarsNameError", selectorafter= "#generateLandscape",
......@@ -160,6 +161,8 @@ checkCultivarsGenesTable <- function(data){
checkGenesTable <- function(data){
isok <- TRUE
shiny::removeUI(selector = "#GenesNameError")
if( sum(as.character(data[,1]) == "") != 0 | sum(grepl("^\\s*$",as.character(data[,1]))) != 0) {
showErrorMessage(id = "GenesNameError", selectorafter= "#generateLandscape",
......@@ -311,101 +314,3 @@ PercentageInput <- function(inputId, label, value) {
)
}
genCroptypesTable <- function(dt, proportions, mode = FALSE) {
#proportions <- rep(round(1/nrow(dt), 2),nrow(dt))
sum_prop <- sum(proportions)
if (!isTRUE(all.equal(sum_prop,1)) || is.na(sum_prop)) {
proportions[1] <- proportions[1] + 0.01
}
if( mode == 0 ) {
disableCols = names(dt)
}
else disablesCols = c()
croptypesTable <- editableDTServer(
id = "croptypes",
DTdata = shiny::reactive(cbind(dt, data.frame(Proportions=proportions))),
disableCol = disableCols,
canRm = mode
)
shiny::observeEvent(croptypesTable$value,
{
message("Croptypes update")
if (sum(is.na(croptypesTable$value))) {
return(1)
}
message("i ",croptypesTable$data)
message("i ",croptypesTable$value)
message("i ",croptypesTable$row)
message("j", croptypesTable$col)
# Proportions col
if(croptypesTable$col == 6 ) {
message("prop inda ", croptypesTable$data[,"Proportions"])
croptypes_proportions <<- croptypesTable$data[,"Proportions"]
ProportionValidation()
}
# shinyalert::shinyalert(
# title = "Erreur",
# text = error$message,
# closeOnEsc = TRUE)
},
ignoreNULL = TRUE,
ignoreInit = TRUE
)
return(croptypesTable)
}
# Take a table of 3 croptype with 3 cultivars and render it
RenderCroptypesold <- function(dt) {
DT::renderDT(
dt,
editable = list(target = "row", disable = list(columns = c(0, 10))),
rownames = FALSE,
options = list(
paging = FALSE,
searching = FALSE,
bInfo = FALSE,
ordering = FALSE,
columnDefs = list(list(
className = "dt-center", targets = 0:(length(colnames(dt))-1)
))
),
selection = "none",
colnames = c(colnames(dt)),
class = "cell-border stripe"
)
}
# Take a table of 3 cultivars with 8 genes and render it
RenderCultivars <- function(dt) {
DT::renderDT(
dt,
options = list(
paging = FALSE,
searching = FALSE,
bInfo = FALSE,
ordering = FALSE,
select = list(info = FALSE),
columnDefs = list(list(
className = "dt-center gene", targets = 0:length(colnames(dt))
))
),
rownames = TRUE,
selection = "none",
colnames = c(colnames(dt)),
class = "cell-border stripe"
)
}
inst/shiny-landsepi/server.R
View file @ ad7a3b1b
......@@ -106,12 +106,12 @@ server <- function(input, output, session) {
# Test if the croptypes proportion sum is 1
## TODO remove input$ and move to global.R
ProportionValidation <- function() {
if (input$demo == "RO") {
if (input$demo == "RO" || (advanced_mode() && !is.na(input$rotationPeriod) && input$rotationPeriod > 0) ) {
sum_prop <-
((croptypes_proportions[1] + croptypes_proportions[2]) + (croptypes_proportions[1] + croptypes_proportions[3])) / 2
((croptypes_proportions()[1] + croptypes_proportions()[2]) + (croptypes_proportions()[1] + croptypes_proportions()[3])) / 2
}
else {
sum_prop <- sum(as.numeric(croptypes_proportions))
sum_prop <- sum(as.numeric(croptypes_proportions()))
}
shiny::removeUI(selector = "#propError")
......@@ -220,7 +220,7 @@ server <- function(input, output, session) {
can_gen_landscape$rotation <<- TRUE
can_run_simul$landscape <<- FALSE
shiny::removeUI(selector = "#rotationPeriodError")
if (input$demo == "RO") {
if (input$demo == "RO" && advanced_mode() == FALSE) {
if (input$rotationPeriod < 1 ||
input$rotationPeriod >= input$nYear ||
is.na(input$rotationPeriod)) {
......@@ -231,6 +231,8 @@ server <- function(input, output, session) {
can_gen_landscape$rotation <<- FALSE
}
}
can_gen_landscape$proportions <<- ProportionValidation()
can_run_simul$landscape <<- FALSE
})
######################################################################################
# nYear validation
......@@ -511,43 +513,35 @@ server <- function(input, output, session) {
# Remove old files
cleanDir(simul_params@OutputDir)
print(simul_params@Croptypes)
print(simul_params@Cultivars)
print(simul_params@CultivarsGenes)
print(simul_params@Genes)
switch(input$demo,
MO = {
rotation_period <- 0
rotation_sequence <- list(c(simul_params@Croptypes$croptypeID))
prop <- list(croptypes_proportions)
# aggregLevel = strtoi(input$aggregLevel)
},
MI = {
rotation_period <- 0
rotation_sequence <- simul_params@Croptypes$croptypeID
prop <- list(croptypes_proportions)
# aggregLevel = strtoi(input$aggregLevel)
},
RO = {
rotation_period <- input$rotationPeriod
prop <- list(
c(croptypes_proportions[1], croptypes_proportions[2]),
c(croptypes_proportions[1], croptypes_proportions[3])
)
# aggregLevel = strtoi(input$aggregLevel)
rotation_sequence <- list(
c(simul_params@Croptypes$croptypeID[1], simul_params@Croptypes$croptypeID[2]),
c(simul_params@Croptypes$croptypeID[1], simul_params@Croptypes$croptypeID[3])
)
},
PY = {
rotation_sequence <- simul_params@Croptypes$croptypeID
rotation_period <- 0
prop <- list(croptypes_proportions[1:2])
# aggregLevel = strtoi(input$aggregLevel)
},
{
# Default case
print("input$generateLandscape : Unknown input$demo")
}
)
# Croptypes Rotation
if( input$demo == "RO" || (advanced_mode() && input$rotationPeriod > 0)) {
rotation_period <- input$rotationPeriod
prop <- list(
c(croptypes_proportions()[1], croptypes_proportions()[2]),
c(croptypes_proportions()[1], croptypes_proportions()[3])
)
# aggregLevel = strtoi(input$aggregLevel)
rotation_sequence <- list(
c(simul_params@Croptypes$croptypeID[1], simul_params@Croptypes$croptypeID[2]),
c(simul_params@Croptypes$croptypeID[1], simul_params@Croptypes$croptypeID[3])
)
}
else {
rotation_period <- 0
rotation_sequence <- list(c(simul_params@Croptypes$croptypeID))
if( input$demo == "PY")
prop <- list(croptypes_proportions()[1:2])
else
prop <- list(croptypes_proportions())
}
simul_params <<- setSeed(simul_params, input$seed)
incProgress(0.4)
......@@ -707,6 +701,7 @@ server <- function(input, output, session) {
######################################################################################
# Handle the demo list
shiny::observeEvent(input$demo, {
print(input$demo)
# Cultivar tab
switch(input$demo,
MO = {
......@@ -731,6 +726,7 @@ server <- function(input, output, session) {
simul_params_cultivars(simul_params@Cultivars)
simul_params_cultivarsgenes(simul_params@CultivarsGenes)
simul_params_genes(simul_params@Genes)
checkAllTables()
can_gen_landscape$proportions <<- TRUE
can_gen_landscape$croptypeID <<- TRUE
......@@ -755,15 +751,15 @@ server <- function(input, output, session) {
shiny::updateNumericInput(session, "rotationPeriod", value = 0)
if (input$demo == "MO") {
croptypes_proportions <<- c(0.33, 0.33, 0.34)
croptypes_proportions(c(0.33, 0.33, 0.34))
shiny::updateSelectInput(session, "aggregLevel", selected = "high")
}
else if (input$demo == "MI" || input$demo == "PY") {
croptypes_proportions <<- c(0.5, 0.5)
croptypes_proportions(c(0.5, 0.5))
shiny::updateSelectInput(session, "aggregLevel", selected = "high")
}
else if (input$demo == "RO") {
croptypes_proportions <<- c(0.5, 0.5, 0.5)
croptypes_proportions(c(0.5, 0.5, 0.5))
shinyjs::enable(id = "rotationPeriod")
shiny::updateNumericInput(session, "rotationPeriod", value = 2)
shiny::updateSelectInput(session, "aggregLevel", selected = "medium")
......@@ -771,6 +767,7 @@ server <- function(input, output, session) {
else if (input$demo == "PY") {
shiny::updateSelectInput(session, "aggregLevel", selected = "low")
}
})
###################
### TABS TABLES ###
......@@ -780,7 +777,7 @@ server <- function(input, output, session) {
simul_params_croptypes(simul_params@Croptypes)
croptypesTable <- editableDTServer(
id = "croptypes",
DTdata = reactive({return(cbind(simul_params_croptypes(), data.frame(Proportions = croptypes_proportions)))}),
DTdata = reactive({return(cbind(simul_params_croptypes(), data.frame(Proportions = croptypes_proportions())))}),
disableCol = shiny::reactive({if (isTRUE(advanced_mode())) {
c()
} else {
......@@ -805,11 +802,12 @@ server <- function(input, output, session) {
#message("i ", croptypesTable$row)
#message("j ", croptypesTable$col)
croptypes_proportions <<- croptypesTable$data[, "Proportions"]
croptypes_proportions(croptypesTable$data[, "Proportions"])
can_gen_landscape$proportions <<- ProportionValidation()
if(can_gen_landscape$proportions == FALSE) can_run_simul$landscape <<- FALSE
if(isTRUE(advanced_mode())) {
shiny::isolate(simul_params_croptypes(croptypesTable$data[,1:(ncol(croptypesTable$data)-2)]))
if( checkCroptypesTable(croptypesTable$data[,- which(colnames(croptypesTable$data) %in% c("Proportions","delete"))]) == FALSE) {
can_run_simul$croptypes <<- FALSE
can_gen_landscape$croptypeID <<- FALSE
......@@ -875,6 +873,7 @@ server <- function(input, output, session) {
# rename a cultivars in croptypes
crop <- simul_params_croptypes()
colnames(crop) <- c(colnames(simul_params_croptypes())[1:2],cultivarsTable$data[,1])
colnames(simul_params@Croptypes) <<- colnames(crop)
simul_params_croptypes(crop)
colnames(simul_params@CultivarsGenes) <<- genesTable$data[,1]
......@@ -1062,5 +1061,5 @@ server <- function(input, output, session) {
shinyjs::hideElement(id= "outputside")
}
})
})
#})
}
Supports Markdown
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

Mentions Légales et CGU