Merge branch 'cleaning_shiny_app'

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: antaresWaterValues
 Title: Generating water values for Antares
-Version: 0.3.1
+Version: 0.3.2
 Author: Dhia Gharsallaoui
 Maintainer: The package maintainer <safedhia@gmail.com>
 Description: This package aims at generating water values for Antares.

NEWS.md

@@ -1,3 +1,10 @@
+# antaresWaterValues 0.3.2
+
+## Minor changes
+
+* Adding new data saved at the end of the simulation in order to simplify Shiny interface
+* Separate Shiny code in modules
+
 # antaresWaterValues v0.3.1
 
 ## Minor changes

R/runWaterValuesSimulation.R

@@ -231,7 +231,11 @@ runWaterValuesSimulation <- function(area,
 
   simulation_res <- list(
     simulation_names = simulation_names,
-    simulation_values = constraint_values
+    simulation_values = constraint_values,
+    area = area,
+    mc_years = nb_mcyears,
+    pumping = pumping,
+    eff = efficiency
   )
 
   if(!is.null(otp_dest)){

R/shiny_bellman.R

@@ -0,0 +1,63 @@
+bellmanUI <- function(id,opts) {
+  shiny::sidebarLayout(
+    shiny::sidebarPanel(
+      shiny::h1("Bellman plot"),
+      shiny::sliderInput(
+        NS(id,"week_id"),
+        "Week to show",
+        value = c(2, 2),
+        min = 1,
+        max = 52
+      ),
+
+      shinyBS::bsTooltip(
+        NS(id,"week_id"),
+        "The number of the week you want to plot (Bellman values are plotted for the end of the week and watervalues for the beginning of the week)",
+        "bottom"
+      ),
+
+
+    ),
+    #siderbarpanel
+    shiny::mainPanel(
+      shiny::plotOutput(NS(id,"plot_Bellman")),
+      shinyWidgets::downloadBttn(
+        outputId = NS(id,"download_Bellman_plot"),
+        style = "unite",
+        color = "primary",
+        block = T
+      ),
+
+    )
+  )
+  # Siderbar
+
+}
+
+bellmanServer <- function(id, opts, watervalues, pen_high, pen_low) {
+  moduleServer(id, function(input, output, session) {
+    plot <- reactive(plot_Bellman(
+      watervalues(),
+      input$week_id[1]:input$week_id[2],
+      pen_low(),
+      pen_high()
+    ))
+
+    output$plot_Bellman <-
+      shiny::renderPlot(plot())
+
+    output$download_Bellman_plot <- shiny::downloadHandler(
+      filename = function() {
+        paste('Bellman-', Sys.Date(), '.png', sep = '')
+      },
+      content = function(con) {
+        grDevices::png(con , width = 1200,
+                       height = 766)
+        print(
+          plot()
+        )
+        grDevices::dev.off()
+      }
+    )
+  })
+}

R/shiny_post_process.R

@@ -0,0 +1,201 @@
+postProcessUI <- function(id,opts) {
+  shiny::sidebarLayout(
+    fluid = TRUE,
+
+    shiny::sidebarPanel(
+      shiny::h1("Post process"),
+      shiny::h3("Remove extreme values"),
+      shinyWidgets::switchInput(
+        NS(id,"Run_remove_out"),
+        value = F,
+        offStatus = "danger",
+        onStatus = "success"
+      ) %>%
+        bsplus::shinyInput_label_embed(
+          bsplus::shiny_iconlink() %>%
+            bsplus::bs_embed_popover(title = "Activate filter to remove extreme values")
+        ),
+
+
+
+
+
+      shiny::conditionalPanel(
+        ns = NS(id),
+        condition = "input.Run_remove_out",
+        shiny::numericInput(
+          inputId = NS(id,"min_rm"),
+          label = "Minimum value to keep",
+          value = 0,
+          step = 1,
+          width = '100%'
+        ),
+        shiny::numericInput(
+          inputId = NS(id,"max_rm"),
+          label = "Maximum value to keep",
+          value = 200,
+          step = 1,
+          width = '100%'
+        ),
+
+        shiny::h3("Replace not defined values"),
+
+        shinyWidgets::radioGroupButtons(
+          inputId = NS(id,"replace_na_method"),
+          label = "Method to replace NaN values",
+          choices = c("Constant values", "Extreme values"),
+          individual = TRUE,
+          justified = TRUE
+        ),
+
+        shiny::conditionalPanel(
+          ns = NS(id),
+          condition = "input.replace_na_method=='Constant values'",
+          shiny::numericInput(NS(id,"max_vu"), "Max Water value", value =
+                                200),
+          shinyBS::bsTooltip(
+            NS(id,"max_vu"),
+            "The highest water value that you want to affect",
+            "bottom"
+          ),
+          shiny::numericInput(NS(id,"min_vu"), "Min Water value", value =
+                                0),
+          shinyBS::bsTooltip(
+            NS(id,"min_vu"),
+            "The smallest water value that you want to affect",
+            "bottom"
+          ),
+        ),
+      ),
+      shinyBS::bsTooltip(
+        NS(id,"min_rm"),
+        "Delete all water values that are under this value",
+        "bottom"
+      ),
+      shinyBS::bsTooltip(
+        NS(id,"max_rm"),
+        "Delete all water values that are bigger then this value",
+        "bottom"
+      ),
+
+
+
+
+
+      shiny::tags$button(
+        id = NS(id,"to_antares"),
+        type = "button",
+        class = "btn action-button btn-large btn-primary",
+        shiny::img(
+          src = "https://antares-simulator.org/static/img/antares-256.png",
+          height = "50px",
+          shiny::HTML('<i class="icon-star"></i>To Antares')
+        )
+      ),
+      shinyBS::bsTooltip(
+        NS(id,"to_antares"),
+        "convert the water values to antares format than implemented in the desired area",
+        "bottom"
+      ),
+
+      shinyWidgets::downloadBttn(
+        outputId = NS(id,"download_vu"),
+        style = "unite",
+        color = "primary",
+        block = T
+      )
+
+    ),
+    #sidebarPanel
+
+
+
+
+    shiny::mainPanel(
+      shinycustomloader::withLoader(
+        shiny::plotOutput(NS(id,"post_process")),
+        type = "html",
+        loader = "dnaspin"
+      ),
+      shinyWidgets::downloadBttn(
+        outputId = NS(id,"download_pp_plot"),
+        style = "unite",
+        color = "primary",
+        block = T
+      ),
+
+    )
+  ) #sidebarLayout
+
+
+}
+
+postProcessServer <- function(id, opts, watervalues, pen_high, pen_low, area) {
+  moduleServer(id, function(input, output, session) {
+
+    final_result <- shiny::reactive({
+      if (input$Run_remove_out) {
+        remove_out(
+          watervalues(),
+          min = input$min_rm,
+          max = input$max_rm,
+          replace_na_method = input$replace_na_method,
+          max_vu = input$max_vu,
+          min_vu = input$min_vu,
+          penalty_level_high = pen_high(),
+          penalty_level_low = pen_low()
+        )
+      } else{
+        watervalues()
+      }
+    })
+
+
+
+    output$post_process <-
+      shiny::renderPlot(waterValuesViz(final_result()))
+
+    output$download_pp_plot <- shiny::downloadHandler(
+      filename = function() {
+        paste('full water values-', Sys.Date(), '.png', sep = '')
+      },
+      content = function(con) {
+        grDevices::png(con , width = 1200,
+                       height = 766)
+        print(waterValuesViz(final_result()))
+        grDevices::dev.off()
+      }
+    )
+
+    shiny::observeEvent(input$to_antares, {
+      results <- final_result()
+      results <- results[results$weeks != 53,]
+      browser()
+      reshaped_values <- to_Antares_Format(results,
+                                           pen_low(),
+                                           pen_high())
+      antaresEditObject::writeWaterValues(area = area(),
+                                          data = reshaped_values)
+      shinyWidgets::show_alert(title = "Implement water values in Antares",
+                               text = " Done !!",
+                               type = "success")
+    })
+
+    vu <- shiny::reactiveValues()
+    shiny::observe({
+      if (!is.null(final_result()))
+        shiny::isolate(vu <<- final_result())
+    })
+
+    output$download_vu <- shiny::downloadHandler(
+      filename <- function() {
+        paste('Watervalues-', Sys.Date(), '.Rdata', sep = '')
+      },
+
+      content = function(file) {
+        save(vu, file = file)
+      }
+    )
+
+  })
+}

R/shiny_reward_plot.R

@@ -0,0 +1,153 @@
+rewardUI <- function(id,opts) {
+  shiny::sidebarLayout(
+    shiny::sidebarPanel(
+      shiny::h1("Rewards plot"),
+
+      shiny::sliderInput(
+        NS(id,"week_id_rew"),
+        "Week to show",
+        value = c(2, 2),
+        min = 1,
+        max = 52
+      ),
+
+      shinyBS::bsTooltip(NS(id,"week_id_rew"), "The weeks you want to plot",
+                         "bottom"),
+
+      shiny::selectInput(
+        NS(id,"param_rew"),
+        "Type",
+        c(
+          "Reward" = "r",
+          "Reward 1 MC" = "r1",
+          "Reward variation" = "rv",
+          "reward variation 1Mc" =
+            "rv1"
+        )
+      ),
+
+      shiny::conditionalPanel(
+        ns = NS(id),
+        condition = "['rv1','r1'].includes(input.param_rew)",
+        shiny::sliderInput(
+          NS(id,"Mc_year"),
+          label = "Monte-Carlo year",
+          min = 1,
+          max = opts$parameters$general$nbyears,
+          value = c(1, 1)
+          ,
+          step = 1
+        )
+      ),
+
+
+      shinyBS::bsTooltip(NS(id,"Mc_year"), "The scenarios that you want to plot",
+                         "bottom"),
+
+      shinyWidgets::downloadBttn(
+        outputId = NS(id,"download_reward_base"),
+        style = "unite",
+        color = "primary",
+        block = T
+      )
+    ),
+
+    shiny::mainPanel(
+      shiny::plotOutput(NS(id,"rewardplot")),
+      shinyWidgets::downloadBttn(
+        outputId = NS(id,"download_reward_plot"),
+        style = "unite",
+        color = "primary",
+        block = T
+      ),
+
+      DT::dataTableOutput(NS(id,"reward_table"))
+    )
+  )
+}
+
+rewardServer <- function(id, opts, reward_db) {
+  moduleServer(id, function(input, output, session) {
+
+
+    rewardplot <- shiny::reactive({
+
+      week_id_rew <- input$week_id_rew[1]:input$week_id_rew[2]
+      Mc_year <- input$Mc_year[1]:input$Mc_year[2]
+      if (input$param_rew == "r")
+      {
+        plot_reward(reward_db()$reward, week_id_rew)
+      } else{
+        if (input$param_rew == "rv")
+        {
+          plot_reward_variation(reward_db()$reward, week_id_rew)
+        } else{
+          if (input$param_rew == "r1")
+          {
+            plot_reward_mc(reward_db()$reward, week_id_rew,
+                           Mc_year)
+          } else{
+            if (input$param_rew == "rv1")
+            {
+              plot_reward_variation_mc(reward_db()$reward, week_id_rew,
+                                       Mc_year)
+            }
+          }
+        }
+      }
+    })
+
+    reward_var_plot <- shiny::reactive({
+      week_id_rew <- input$week_id_rew[1]:input$week_id_rew[2]
+      Mc_year <- input$Mc_year[1]:input$Mc_year[2]
+
+      if (input$param_rew == "r1")
+      {
+        plot_reward_variation_mc(reward_db()$reward, week_id_rew,
+                                 Mc_year)
+      } else{
+        plot_reward_variation(reward_db()$reward, week_id_rew)
+      }
+
+
+    })
+
+
+
+
+    output$rewardplot <- shiny::renderPlot(rewardplot()$graph)
+    # output$reward_second_plot <- shiny::renderPlot(reward_var_plot()$graph)
+    output$reward_table <- DT::renderDataTable(rewardplot()$table)
+    output$download_reward_plot <- shiny::downloadHandler(
+      filename = function() {
+        paste('Reward-', Sys.Date(), '.png', sep = '')
+      },
+      content = function(con) {
+        grDevices::png(con , width = 1200, height = 766)
+        print(rewardplot()$graph)
+        grDevices::dev.off()
+      }
+    )
+
+    reward_base <- shiny::reactiveValues()
+    shiny::observe({
+      if (!is.null(reward_db()))
+        shiny::isolate(reward_base <<- reward_db()$reward)
+    })
+
+    output$download_reward_base <- shiny::downloadHandler(
+      filename <- function() {
+        paste('Reward-Base-', Sys.Date(), '.Rdata', sep = '')
+      },
+
+      content = function(file) {
+        save(reward_base, file = file)
+      }
+    )
+
+
+
+
+  })
+}
+

R/shiny_simulations.R

@@ -0,0 +1,216 @@
+simulationUI <- function(id,opts) {
+  shiny::tagList(shiny::sidebarLayout(
+    shiny::sidebarPanel(
+      shiny::h2("Study parameters"),
+      shinyWidgets::pickerInput(
+        NS(id,"sim_area"),
+        "Choose the area",
+        opts$areaList,
+        options = list(`live-search` = TRUE)
+      ) %>%
+        bsplus::shinyInput_label_embed(
+          bsplus::shiny_iconlink() %>%
+            bsplus::bs_embed_popover(title = "The area concerned by the simulation.")
+        ),
+
+      shiny::textInput(NS(id,"solver_path"), "Solver path "
+                       , value = "xxxxxxx/bin/antares-8.0-solver.exe"),
+
+      shinyBS::bsTooltip(
+        NS(id,"solver_path"),
+        "The path of the Antares solver you found in your Antares installation directory.",
+        "bottom"
+      ),
+
+      shiny::h2("Simulation parameters"),
+
+      shinyWidgets::materialSwitch(
+        NS(id,"pumping"),
+        "Activate Pumping",
+        value = F,
+        status = "success"
+      ) %>%
+        bsplus::shinyInput_label_embed(
+          bsplus::shiny_iconlink() %>%
+            bsplus::bs_embed_popover(title = "Take into account the pumping in the area.")
+        ),
+
+      shiny::textOutput(
+        NS(id,"pumping_eff")),
+
+      shiny::numericInput(
+        NS(id,"sim_nb_disc_stock"),
+        "Number of reservoir discretization",
+        value = 2,
+        min = 1
+      ),
+      shinyBS::bsTooltip(
+        NS(id,"sim_nb_disc_stock"),
+        " Number of simulation to launch, a vector of energy constraint will be created from 0 to the hydro storage maximum and of length this parameter.",
+        "bottom"
+      ),
+
+      shiny::uiOutput(NS(id,"choose_simulation")),
+
+      shiny::sliderInput(
+        NS(id,"sim_mcyears"),
+        label = "choose the number of MC years to simulate",
+        min = 1,
+        max = opts$parameters$general$nbyears,
+        value = c(1, opts$parameters$general$nbyears),
+        step = 1
+      ),
+      shinyBS::bsTooltip(
+        NS(id,"sim_mcyears"),
+        " Number of Monte Carlo years to simulate.",
+        "bottom"
+      ),
+
+
+      shiny::h2("Saving parameters"),
+
+      shiny::uiOutput(NS(id,"dir")),
+      shinyBS::bsTooltip(
+        NS(id,"dir"),
+        " the path where the simulation results Rdata file will be saved. ",
+        "bottom"
+      ),
+
+
+      shiny::textInput(NS(id,"file_name"), "File name", value =
+                         "simulation results"),
+
+      shinyBS::bsTooltip(
+        NS(id,"file_name"),
+        " Name of Rdata file containing simulation results",
+        "bottom"
+      ),
+
+
+      shiny::actionButton(NS(id,"simulate"), "Launch simulations"),
+      shinyBS::bsTooltip(
+        "simulate",
+        " launch simulations with the selected parameters. You can close the web browser after launching but keep the R server.",
+        "top"
+      ),
+
+      shiny::actionButton(NS(id,"reset_sim"), "Reset"),
+      shinyBS::bsTooltip(
+        NS(id,"reset_sim"),
+        "Reset a Antares study in case something went wrong, please check your study before running an other simulation",
+        "top"
+      )
+
+
+    ),
+    #end sidebarPanel
+
+    shiny::mainPanel(
+      shiny::h2(
+        "Controls (u) in MWh per week evaluated for each week and for each simulation (sim)"
+      ),
+      DT::dataTableOutput(NS(id,"simulation_constraint"))
+    )
+  ))# end sidebar layout
+
+}
+
+simulationServer <- function(id,opts,silent) {
+  moduleServer(id, function(input, output, session) {
+
+    eff <- shiny::reactive({
+      if (input$pumping){
+        if (!is.null(input$sim_area))getPumpEfficiency(area = input$sim_area, opts = opts)
+        else 1
+      } else {1}
+
+    })
+
+    output$pumping_eff <- shiny::renderText({
+      if(input$pumping) {
+        paste0("Efficiency : ", eff())}
+    })
+
+    output$dir <- shiny::renderUI({
+      shiny::textInput(NS(id,"sim_output_dir"),
+                       "Saving directory",
+                       value = paste0(opts$studyPath, "/user"))
+
+    })
+
+    simulation_constraint <- shiny::reactive({
+      constraint_generator(
+        area = input$sim_area,
+        opts = opts,
+        pumping = input$pumping,
+        nb_disc_stock = input$sim_nb_disc_stock,
+        pumping_efficiency = eff()
+      )
+    })
+
+    output$simulation_constraint <- DT::renderDataTable({
+      dplyr::filter(simulation_constraint(),
+                    .data$sim %in% input$subset_simulation)
+    })
+
+    output$choose_simulation <- shiny::renderUI({
+      shiny::checkboxGroupInput(
+        NS(id,"subset_simulation"),
+        "Choose which simulations you want to run",
+        unique(simulation_constraint()$sim),
+        selected = unique(simulation_constraint()$sim)
+      )
+    })
+
+    shiny::observeEvent(input$simulate,
+
+                        spsUtil::quiet({
+                          spsComps::shinyCatch({
+                            simulation_res <-    runWaterValuesSimulation(
+                              area = input$sim_area,
+                              simulation_name = paste0(input$sim_area, "_wv_sim_%s"),
+                              nb_disc_stock = input$sim_nb_disc_stock,
+                              nb_mcyears = seq(
+                                from = input$sim_mcyears[1],
+                                to = input$sim_mcyears[2]
+                              ),
+                              path_solver = input$solver_path,
+                              binding_constraint = "WeeklyWaterAmount_",
+                              fictive_area = "fictive_watervalues",
+                              thermal_cluster = "WaterValueCluster",
+                              overwrite = T,
+                              link_from = input$sim_area,
+                              opts = opts,
+                              shiny = T,
+                              otp_dest = input$sim_output_dir,
+                              file_name = input$file_name,
+                              pumping = input$pumping,
+                              efficiency = eff(),
+                              constraint_values = dplyr::filter(
+                                simulation_constraint(),
+                                .data$sim %in% input$subset_simulation
+                              )
+                            )
+                          },
+                          prefix = "")
+                          shinyWidgets::show_alert(title = "Run simulations",
+                                                   text = "Done !!",
+                                                   type = "success")
+                        }, print_cat = F,
+                        message = F, warning = silent))
+
+    shiny::observeEvent(input$reset_sim,
+
+                        spsUtil::quiet({
+                          opts_temp <- antaresRead::setSimulationPath(opts$studyPath, "input")
+                          resetStudy(
+                            opts = opts_temp,
+                            area = input$sim_area,
+                            pumping = input$pumping,
+                            fictive_area = "fictive_watervalues"
+                          )
+                        }, print_cat = F,
+                        message = F, warning = silent))
+  })
+}
+