feat: remove visualization, show objective function of each variable

Author: nguyenta

R/displayOutput.R

@@ -459,3 +459,54 @@ findSoilGroupSWATPlus <- function(TxtInOut){
 
   return(soilGroup)
 }
+
+
+# ------------------------------------------------------------------------------
+# Display objective function value for each variable
+# ------------------------------------------------------------------------------
+objFunctionEachVar <- function(perCriteria, caliOrValid){
+  pc <- list()
+  # Convert list of vector to list of data frame
+  for (i in 1:length(perCriteria)){
+    for (j in 1:length(perCriteria[[1]])){
+      if (j == 1){
+        pc[[i]] <- perCriteria[[i]][[j]]
+      } else {
+        pc[[i]] <- rbind(pc[[i]],perCriteria[[i]][[j]] )
+      }
+    }
+    
+    colnames(pc[[i]]) <- paste0(caliOrValid, "var_", i, "_", colnames(pc[[i]]))
+  }
+  
+  # Convert list of data frame to data frame
+  if (length(pc) > 1){
+    
+    pcDataFrame <- pc[[1]]
+    for (i in 2:length(pc)){
+      pcDataFrame <- cbind(pcDataFrame, pc[[i]])
+    }
+  } else {
+    pcDataFrame <- pc[[1]]
+  }
+  
+  # round up to 3 digits
+  pcDataFrame <- round(pcDataFrame, digits = 3)
+  
+  # Return result
+  return(pcDataFrame)
+}
+
+# ------------------------------------------------------------------------------
+# Display objective function value for each variable
+# ------------------------------------------------------------------------------
+objFunctionEachVarCaliValid <- function(perCriteriaCali, perCriteriaValid){
+  
+  pcDataFrameCali <- objFunctionEachVar(perCriteriaCali, "cali_")
+  pcDataFrameValid <- objFunctionEachVar(perCriteriaValid, "valid_")
+  simNr <- data.frame(SimNr = c(1:nrow(pcDataFrameCali)))
+  
+  # Return result
+  return(cbind(simNr, pcDataFrameCali, pcDataFrameValid))
+  
+}

R/hruFunctions.R

@@ -1,14 +1,3 @@
-
-# Install and load required packages
-# install.packages("raster") 
-# install.packages("rgdal") 
-
-library(raster)
-library(rgdal)
-library(plotly)
-library(shinydashboard)
-library(shinyFiles)
-
 # ------------------------------------------------------------------------------
 getDate <- function(TxtInOut){
   file_cio <- readLines(paste(TxtInOut, "/file.cio", sep = ""), 60)

R/hruUI.R

@@ -10,9 +10,7 @@ requiredPackages <- c('foreach',         # version >= 1.5.2
                       'doParallel',      # version >= 1.0.17     
                       'lhs',             # version >= 1.1.4
                       'plotly',          # version >= 4.10.0
-                      'ggplot2',         # version >= 3.3.5
-                      'rgdal',           # version >= 1.5-28
-                      'raster',          # version >= 3.5-15 
+                      'ggplot2',         # version >= 3.5-15 
                       'shiny',           # version >= 1.7.1
                       'shinyjs',
                       'shinydashboard',  # version >= 0.7.2
@@ -24,11 +22,10 @@ requiredPackages <- c('foreach',         # version >= 1.5.2
                       'optimization',    # version >= 1.0-9  
                       'hydroPSO',        # version >= 0.5-1
                       'nloptr',          # version >= 2.0.0
-                      'spsComps'         # version >= 0.3.2.1
-                      )
+                      'spsComps')        # version >= 0.3.2.1)
 
 # Check and install only missing packages
-install.packages(setdiff(requiredPackages,rownames(installed.packages())), dependencies = TRUE) 
+install.packages(setdiff(requiredPackages, rownames(installed.packages())), dependencies = TRUE) 
 
 # Update these packages if it has not been updated
 update.packages(requiredPackages, ask = FALSE)

R/loadPackages.R

@@ -312,7 +312,6 @@ calObjFunction <- function(parameterValue, ncores,
             output$objValueValid[counter[j]] <- output$objValueValid[counter[j]] + 
               output$perCriteriaValid[[j]][[counter[j]]][perIndex]
           }
-          
         }        
       }
     }
@@ -324,23 +323,34 @@ calObjFunction <- function(parameterValue, ncores,
 
         # Select calibration data with flag "C" or "c"
         flag <- c("C", "c")
-        output$objValueCali[count] <- userObjFunction(observedToList(observedData, flag), 
-                                                  simToList(simData, count, flag))
-
+        temp  <- userObjFunction(observedToList(observedData, flag),
+                                 simToList(simData, count, observedData, flag))
+        output$objValueCali[count] <- temp$overalPerCriteria
+        
+        for (j in 1:nOutputVar){
+          output$perCriteriaCali[[j]][[count]] <- temp$perCriteria[[j]]
+        }
+        
+        
         # Select validation data with flag "V" or "v"
-        flag <- c("V", "v")        
-        output$objValueCali[count] <- userObjFunction(observedToList(observedData, flag), 
-                                                      simToList(simData, count, observedData, flag))
+        flag <- c("V", "v") 
+        temp  <- userObjFunction(observedToList(observedData, flag),
+                                 simToList(simData, count, observedData, flag))
+        output$objValueValid[count] <- temp$overalPerCriteria
+        for (j in 1:nOutputVar){
+          output$perCriteriaValid[[j]][[count]] <- temp$perCriteria[[j]]
+        }
       }
-    }      
-    
+    }
   }
 
   if (index != 'userObjFunction'){
     output$objValueCali <- output$objValueCali/nOutputVar
     output$objValueValid <- output$objValueValid/nOutputVar
   }
 
+
+  
   return(output) 
 }