Merge pull request #106 from IOHprofiler/v1.7.4

V1.7.4

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: IOHanalyzer
 Type: Package
 Title: Data Analysis Part of 'IOHprofiler'
-Version: 0.1.7.1
+Version: 0.1.7.4
 Maintainer: Diederick Vermetten <d.l.vermetten@liacs.leidenuniv.nl>
 Authors@R: c(
     person("Hao", "Wang", email = "h.wang@liacs.leidenuniv.nl", role = "aut", comment = c(ORCID = "0000-0002-4933-5181")),

R/DataSet.R

@@ -178,6 +178,9 @@ DataSet <- function(info, verbose = F, maximization = NULL, format = IOHprofiler
     else {
       attr(temp, 'contains_full_FV') <- FALSE
     }
+    if (getOption('IOHanalyzer.function_representation', 'funcId') == 'funcName') {
+      attr(temp, 'funcId') <- attr(temp, 'funcName')
+    }
     return(temp)
   }
   else

R/DataSetList.R

@@ -113,7 +113,7 @@ DataSetList <- function(path = NULL, verbose = T, print_fun = NULL, maximization
         }
 
         copy_flag <- TRUE
-        if (isTRUE(info$version >= "0.3.3")) {
+        if (ifelse(is.null(info$version), F, (compareVersion(info$version, "0.3.3") >= 0))) {
           tryCatch(
           data <- read_IOH_v1plus(info),
           error = function(e) {
@@ -125,7 +125,7 @@ DataSetList <- function(path = NULL, verbose = T, print_fun = NULL, maximization
                           format = format, subsampling = subsampling)
         }
         DIM[i] <- attr(data, 'DIM')
-        funcId[i] <- attr(data, 'funcId')
+        funcId[i] <- attr(data, getOption('IOHanalyzer.function_representation', 'funcId'))
         algId[i] <- attr(data, 'algId')
 
         # TODO: double-check the following treatment on `instance`!!!

R/readFiles.R

@@ -429,7 +429,9 @@ check_format <- function(path) {
     return(SOS)
 
   info <- unlist(lapply(index_files, read_index_file), recursive = F)
-  if (all(unlist(lapply(info, function(x) isTRUE(x$version >="0.3.3"))))) {
+  if (all(unlist(lapply(info, function(x) {
+      return (ifelse(is.null(x$version), F, (compareVersion(x$version, "0.3.3") >= 0)))
+    })))) {
     return(IOHprofiler)
   }
 
@@ -1341,7 +1343,7 @@ read_IOH_v1plus <- function(info, full_sampling = FALSE){
 
   algId <- info$algId
   DIM <- info$dim
-  funcId <- info$funcId
+  funcId <- attr(info, getOption('IOHanalyzer.function_representation', 'funcId'))
 
   if (impute_evalnrs) {
     data$evaluations <-  ave(data$raw_y, data$runnr, FUN = seq_along)
@@ -1389,6 +1391,9 @@ read_IOH_v1plus <- function(info, full_sampling = FALSE){
     c(info, list(maxRT = max(runtimes), finalFV = min(FV), format = IOHprofiler,
                  ID = info$algId))
   )
+    if (getOption('IOHanalyzer.function_representation', 'funcId') == 'funcName') {
+      attr(ds, 'funcId') <- attr(ds, 'funcName')
+    }
 
 
   if (full_sampling || 'violation' %in% info$attributes) {

R/stats.R

@@ -202,8 +202,8 @@ seq_FV <- function(FV, from = NULL, to = NULL, by = NULL, length.out = NULL, sca
     rev_trans <- function(x) 10 ^ x
     # TODO: Better way to deal with negative values
     #       set lowest possible target globally instead of arbitrary 1e-12
-    from <- max(1e-12, from)
-    to <- max(1e-12 ,to)
+    from <- max(1e-12, from[from>0])
+    to <- max(1e-12 ,to[to>0])
     from <- trans(from)
     to <- trans(to)
   }

inst/shiny-server/server/settings_page.R

@@ -204,13 +204,9 @@ observe({
 
 observe({
   if (input$Settings.Use_Funcname) {
-    shinyjs::show(id = "overall_funcname_box")
-    shinyjs::hide(id = "overall_funcid_box")
-    options('IOHanalyzer.function_representation' = 'funcname')
+    options('IOHanalyzer.function_representation' = 'funcName')
   }
   else {
-    shinyjs::hide(id = "overall_funcname_box")
-    shinyjs::show(id = "overall_funcid_box")
     options('IOHanalyzer.function_representation' = 'funcId')
   }
 })

inst/shiny-server/server/upload.R

@@ -99,6 +99,13 @@ observeEvent(input$repository.load_button, {
   } else {
     temp_data <- change_id(data, 'algId')
   }
+
+  if (getOption('IOHanalyzer.function_representation', 'funcId') == 'funcName') {
+    for (ds in temp_data){
+      attr(ds, 'funcId') <- attr(ds, 'funcName')
+    }
+  }
+
   # DataList$data <- change_id(DataList$data, getOption("IOHanalyzer.ID_vars", c("algId")))
   update_menu_visibility(attr(temp_data, 'suite'))
   # set_format_func(attr(DataList$data, 'suite'))
@@ -383,10 +390,6 @@ update_menu_visibility <- function(suite){
   else {
     session$sendCustomMessage(type = "manipulateMenuItem", message = list(action = "hide", tabName = "Positions"))
   }
-  if (!is.null(get_funcName(DataList$data)))
-    shinyjs::enable("Settings.Use_Funcname")
-  else
-    shinyjs::disable("Settings.Use_Funcname")
 }
 
 observeEvent(input$Upload.Add_to_repo, {
@@ -420,7 +423,6 @@ observeEvent(input$upload.remove_data, {
 
     updateSelectInput(session, 'Overall.Dim', choices = c(), selected = '')
     updateSelectInput(session, 'Overall.Funcid', choices = c(), selected = '')
-    updateSelectInput(session, 'Overall.Funcname', choices = c(), selected = '')
     updateSelectInput(session, 'Overall.ID', choices = c(), selected = '')
 
     print_html('<p style="color:red;">all data are removed!</p>')
@@ -465,8 +467,6 @@ observe({
 
   updateSelectInput(session, 'Overall.Dim', choices = DIMs, selected = selected_dim)
   updateSelectInput(session, 'Overall.Funcid', choices = funcIds, selected = selected_f)
-  if (input$Settings.Use_Funcname)
-    updateSelectInput(session, 'Overall.Funcname', choices = get_funcName(data), selected = get_funcName(data[1]))
 
   if ('algId' %in% input$Settings.ID.Variables)
     updateSelectInput(session, 'Overall.ID', choices = NULL, selected = NULL)
@@ -608,14 +608,10 @@ DATA <- reactive({
     if (!is.null(algid)) d <- subset(d, algId == algid)
   }
 
-  if (input$Settings.Use_Funcname) {
-    fname <- input$Overall.Funcname
-    if (!is.null(fname)) d <- subset(d, funcname == fname)
-  }
-  else {
+
     fid <- input$Overall.Funcid
     if (!is.null(fid)) d <- subset(d, funcId == fid)
-  }
+
 
   if (length(DataList$data) == 0) return(NULL)
 
@@ -630,20 +626,6 @@ DATA_RAW <- reactive({
   DataList$data
 })
 
-# This observe statement tries to match funcid and funcname seletions so funcId can still be used internally.
-# TODO: think of a better solution to ensure this matching doesn't break.
-observe({
-  req(length(DATA_RAW()) > 0)
-  fname <- input$Overall.Funcname
-  req(fname)
-  req(getOption('IOHanalyzer.function_representation', 'funcId') == 'funcname')
-  dsl_sub <- subset(DATA_RAW(), funcName == fname)
-  fids <- get_funcId(dsl_sub)
-  if (length(fids) == 1) {
-    updateSelectInput(session, 'Overall.Funcid', selected = fids)
-  }
-})
-
 MAX_ERTS_FUNC <- reactive({
   dim <- input$Overall.Dim
   data <- subset(DataList$data, DIM == dim)

inst/shiny-server/ui/DIM_fID_panel.R

@@ -15,18 +15,6 @@ DIM_fID_panel <- function() {
           )
         )
       ),
-      div(id = 'overall_funcname_box',
-        # style = "padding: 0px 0px; margin-top:-5em; margin:0%", 
-        fluidRow(
-          column(
-            width = 11,
-            selectInput(
-              "Overall.Funcname",
-              label = HTML('<p style="font-size:90%;">Function Name:</p>'),
-              choices = NULL, selected = NULL)
-          )
-        )
-      ),
       div(
         # style = "padding: 0px 0px; margin-top:-50em;", 
         fluidRow(