Merge pull request #237 from bockthom/thomas-updates

Fix R warnings and replace deprecated R function calls Reviewed-by: Christian Hechtl <hechtl@cs.uni-saarland.de>
se-sic · Apr 13, 2023 · a81a7f1 · a81a7f1
2 parents e977d62 + 64cb092
commit a81a7f1
Show file tree

Hide file tree

Showing 7 changed files with 94 additions and 30 deletions.
diff --git a/NEWS.md b/NEWS.md
@@ -6,18 +6,23 @@
 
 ### Added
 
-- Add function `verify.data.frame.columns` to check that a dataframe includes all required columns, optionally with a specified datatype (PR #231, d1d9a039f50480ec5b442dc7e8b518648d1f9d9d).
-- Add CI support for GitHub Actions (PR #234, fa1fc4af65751402ae6b23298dd4ed821930c6d2).
+- Add function `verify.data.frame.columns` to check that a dataframe includes all required columns, optionally with a specified datatype (PR #231, d1d9a039f50480ec5b442dc7e8b518648d1f9d9d)
+- Add helper function `is.single.na` to check whether an element is of length 1 and is `NA` (ddff2b8bbca6405f5c7c1cf4e7e97374fb1426ca, ccfc2d12a68dfa412f05159e8e3b03118694e748)
+- Add CI support for GitHub Actions (PR #234, fa1fc4af65751402ae6b23298dd4ed821930c6d2)
 
 ### Changed/Improved
 
-- Include structural verification to almost all functions that read dataframes from files or set a dataframe (setter-functions) (PR #231, b7a95881da72ccaa548c6cd5d94bd558a25caa6f).
-- Include removal of empty and deleted users in the setters of mails, commits, issues, and authors.For commits, also the "committer.name" column is now checked for deleted or empty users. (PR #235, 08fbd3e11e33d060f42cbc6f729eaf60b48a6de7)
+- Include structural verification to almost all functions that read dataframes from files or set a dataframe (setter-functions) (PR #231, b7a95881da72ccaa548c6cd5d94bd558a25caa6f)
+- Include removal of empty and deleted users in the setters of mails, commits, issues, and authors. For commits, also the `committer.name` column is now checked for deleted or empty users (PR #235, 08fbd3e11e33d060f42cbc6f729eaf60b48a6de7)
+- Check for empty values (i.e., values of length < 1) when updating configuration attributes and throw an error if a value is empty (9f36c544637ab4f4173408152d223b9b5098ce5a)
 
 ### Fixed
 
-- Fix check for empty input-files in utility read functions. Compared to unpresent files, empty files do not throw an error when reading them, a check for `nrow(commit.data) < 1` is therefore required (PR #231, ecfa643cbc15975c3062af95c50ead02730b580f).
+- Fix check for empty input files in utility read functions. Compared to unpresent files, empty files do not throw an error when reading them, a check for `nrow(commit.data) < 1` is therefore required (PR #231, ecfa643cbc15975c3062af95c50ead02730b580f)
 - Fix various problems regarding the default classes of edge attributes and vertex attributes, and also make sure that the edge attributes for bipartite edges are chosen correctly (PR #240, 4275b93867c78d20d0bd116749c1e7603cd9d473, 98a6deb1b178a1fcf799c741906e99770c46a8d0, b8232c09b91df3412f703dd26c21c685bacd0321, a9535550d93207f466b315f33ea263a50e6c8924, 820a7631093d03ac5ccb7bf9923bd498f669120a)
+- Prevent R warnings `'length(x) = 2 > 1' in coercion to 'logical(1)'` in `if` conditions for updating configuration values (PR #237, ddff2b8bbca6405f5c7c1cf4e7e97374fb1426ca)
+- Prevent R warnings `In xtfrm.data.frame(x) : cannot xtfrm data frames` (PR #237, c24aee7d8f0b6ff4b641c8922e6ee1dce6f5999c)
+- Replace deprecated R function calls (PR #237, ed433821c04711a96501887b315d1b0ea8681f5a)
 
 
 ## 4.2

diff --git a/tests/test-misc.R b/tests/test-misc.R
@@ -14,6 +14,7 @@
 ## Copyright 2017 by Felix Prasse <prassefe@fim.uni-passau.de>
 ## Copyright 2017-2018 by Claus Hunsen <hunsen@fim.uni-passau.de>
 ## Copyright 2017-2018 by Thomas Bock <bockthom@fim.uni-passau.de>
+## Copyright 2023 by Thomas Bock <bockthom@cs.uni-saarland.de>
 ## Copyright 2022-2023 by Maximilian Löffler <s8maloef@stud.uni-saarland.de>
 ## All Rights Reserved.
 
@@ -183,6 +184,34 @@ test_that("Check presence and datatype of data frame columns.", {
 
 })
 
+
+## / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / /
+## Vector misc--------------------------------------------------------------
+
+##
+## Check if a value is a single NA value.
+##
+
+test_that("Check if a value is a single NA value", {
+
+    ## 1) Tests for single NA
+    expect_true(is.single.na(NA))
+    expect_true(is.single.na(list(NA)))
+    expect_true(is.single.na(data.frame(NA)))
+
+    ## 2) Tests for values other than a single NA
+    expect_false(is.single.na(0))
+    expect_false(is.single.na("na"))
+    expect_false(is.single.na(NULL))
+    expect_false(is.single.na(logical(0)))
+    expect_false(is.single.na(FALSE))
+    expect_false(is.single.na(c(NA, NA)))
+    expect_false(is.single.na(c(3, NA)))
+    expect_false(is.single.na(list(NA, NA)))
+    expect_false(is.single.na(data.frame(NA, NA)))
+})
+
+
 ## / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / /
 ## Date handling -----------------------------------------------------------
 

diff --git a/util-conf.R b/util-conf.R
@@ -18,7 +18,7 @@
 ## Copyright 2020-2021 by Christian Hechtl <hechtl@cs.uni-saarland.de>
 ## Copyright 2017 by Felix Prasse <prassefe@fim.uni-passau.de>
 ## Copyright 2017-2019 by Thomas Bock <bockthom@fim.uni-passau.de>
-## Copyright 2021 by Thomas Bock <bockthom@cs.uni-saarland.de>
+## Copyright 2021, 2023 by Thomas Bock <bockthom@cs.uni-saarland.de>
 ## Copyright 2018 by Barbara Eckl <ecklbarb@fim.uni-passau.de>
 ## Copyright 2018-2019 by Jakob Kronawitter <kronawij@fim.uni-passau.de>
 ## Copyright 2019 by Anselm Fehnker <fehnker@fim.uni-passau.de>
@@ -100,6 +100,7 @@ Conf = R6::R6Class("Conf",
         #'
         #' @return a named vector of logical values, named:
         #'         - existing,
+        #'         - value.not.empty,
         #'         - type,
         #'         - allowed,
         #'         - allowed.number, and
@@ -109,15 +110,18 @@ Conf = R6::R6Class("Conf",
         check.value = function(value, name) {
             if (!exists(name, where = private[["attributes"]])) {
                 result = c(existing = FALSE)
+            } else if (length(value) < 1){
+                result = c(existing = TRUE, value.not.empty = FALSE)
             } else {
                 ## check all other properties
                 attribute = private[["attributes"]][[name]]
                 ## if non-updatable field, return early
                 if (!is.null(attribute[["updatable"]]) && !attribute[["updatable"]]) {
-                    result = c(existing = TRUE, updatable = FALSE)
+                    result = c(existing = TRUE, value.not.empty = TRUE, updatable = FALSE)
                 } else {
                     result = c(
                         existing = TRUE,
+                        value.not.empty = TRUE,
                         updatable = TRUE,
                         type = class(value) %in% attribute[["type"]],
                         ## if 'allowed' is not defined for this attribute, any
@@ -219,22 +223,31 @@ Conf = R6::R6Class("Conf",
                     if (!check[["existing"]]) {
 
                         message = paste(
-                            "Updating network-configuration attribute '%s' failed:",
-                            "A network-configuraton attribute with this name does not exist."
+                            "Updating configuration attribute '%s' failed:",
+                            "A configuraton attribute with this name does not exist."
+                        )
+                        error.function(sprintf(message, name))
+
+                    } else if (!check[["value.not.empty"]]) {
+
+                        message = paste(
+                            "Updating configuration attribute '%s' failed:",
+                            "The provided value is empty!"
                         )
                         error.function(sprintf(message, name))
 
                     } else if (!check[["updatable"]]) {
 
                         message = paste(
-                            "Updating network-configuration attribute '%s' failed:",
+                            "Updating configuration attribute '%s' failed:",
                             "The value is not updatable!"
                         )
                         error.function(message, name)
 
                     } else {
+
                         message = paste0(
-                            "Updating network-configuration attribute '%s' failed.\n",
+                            "Updating configuration attribute '%s' failed.\n",
                             "Allowed values (%s of type '%s'): %s\n",
                             "Given value (of type '%s'): %s"
                         )
@@ -264,22 +277,24 @@ Conf = R6::R6Class("Conf",
                     paste(names.to.update, collapse = ", ")
                 )
                 for (name in names.to.update) {
+                    default.value = private[["attributes"]][[name]][["default"]]
+                    new.value = updated.values[[name]]
+
                     ## check if the default value or the given new value are NA
                     ## if only one of both is NA that means that the value has to be changed
-                    if (is.na(private[["attributes"]][[name]][["default"]]) && !is.na(updated.values[[name]]) ||
-                        !is.na(private[["attributes"]][[name]][["default"]]) && is.na(updated.values[[name]])) {
-                        private[["attributes"]][[name]][["value"]] = updated.values[[name]]
+                    if (is.single.na(default.value) && !is.single.na(new.value) ||
+                        !is.single.na(default.value) && is.single.na(new.value)) {
+                        private[["attributes"]][[name]][["value"]] = new.value
                     } ## if the default value and the given value are the same and if the 'value' field is present
                       ## then reset the 'value' field
-                    else if (is.na(private[["attributes"]][[name]][["default"]]) && is.na(updated.values[[name]]) ||
-                               identical(sort(updated.values[[name]]),
-                                         sort(private[["attributes"]][[name]][["default"]]))) {
+                    else if (is.single.na(default.value) && is.single.na(new.value) ||
+                             identical(sort(new.value), sort(default.value))) {
                         if ("value" %in% names(private[["attributes"]][[name]])) {
                             private[["attributes"]][[name]][["value"]] = NULL
                         }
                     } ## otherwise proceed with updating the value
                     else {
-                        private[["attributes"]][[name]][["value"]] = sort(updated.values[[name]])
+                        private[["attributes"]][[name]][["value"]] = sort(new.value)
                     }
                 }
             } else {

diff --git a/util-data.R b/util-data.R
@@ -269,7 +269,7 @@ ProjectData = R6::R6Class("ProjectData",
             result = parallel::mclapply(thread.data, function(thread) {
 
                 ## ensure that all mails within the thread are ordered correctly
-                thread = thread[order(thread["date"]), ]
+                thread = thread[order(thread[["date"]]), ]
 
                 running = TRUE
                 i = 1

diff --git a/util-misc.R b/util-misc.R
@@ -16,7 +16,7 @@
 ## Copyright 2017 by Christian Hechtl <hechtl@fim.uni-passau.de>
 ## Copyright 2017 by Felix Prasse <prassefe@fim.uni-passau.de>
 ## Copyright 2017-2018 by Thomas Bock <bockthom@fim.uni-passau.de>
-## Copyright 2020-2021 by Thomas Bock <bockthom@cs.uni-saarland.de>
+## Copyright 2020-2021, 2023 by Thomas Bock <bockthom@cs.uni-saarland.de>
 ## Copyright 2018-2019 by Jakob Kronawitter <kronawij@fim.uni-passau.de>
 ## Copyright 2021 by Niklas Schneider <s8nlschn@stud.uni-saarland.de>
 ## Copyright 2022 by Jonathan Baumann <joba00002@stud.uni-saarland.de>
@@ -294,6 +294,17 @@ get.second.last.element = function(v) {
     }
 }
 
+#' Check if a value is a single \code{NA} value.
+#' (The function \code{is.na} is not capable of doing that, as it does the \code{NA} check for each element of a vector
+#' instead of checking whether vector itself is just a single \code{NA} element.)
+#'
+#' @param x an R object to be tested: atomic vectors, lists, pairlists, or ‘NULL’
+#'
+#' @return \code{TRUE} if \code{x} is of length 1 and \code{x} is \code{NA}; \code{FALSE} otherwise
+is.single.na = function(x) {
+    return(length(x) == 1 && is.na(x))
+}
+
 ## / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / /
 ## Stacktrace --------------------------------------------------------------
 

diff --git a/util-networks-metrics.R b/util-networks-metrics.R
@@ -12,7 +12,7 @@
 ## 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
 ##
 ## Copyright 2015, 2019 by Thomas Bock <bockthom@fim.uni-passau.de>
-## Copyright 2021 by Thomas Bock <bockthom@cs.uni-saarland.de>
+## Copyright 2021, 2023 by Thomas Bock <bockthom@cs.uni-saarland.de>
 ## Copyright 2017 by Raphael Nömmer <noemmer@fim.uni-passau.de>
 ## Copyright 2017-2019 by Claus Hunsen <hunsen@fim.uni-passau.de>
 ## Copyright 2017-2018 by Christian Hechtl <hechtl@fim.uni-passau.de>
@@ -26,6 +26,7 @@
 ## Libraries ---------------------------------------------------------------
 
 requireNamespace("igraph")
+requireNamespace("logging")
 
 
 ## / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / /
@@ -36,7 +37,8 @@ requireNamespace("igraph")
 #' @param network the network to be examined
 #' @param mode the mode to be used for determining the degrees [default: "total"]
 #'
-#' @return A data frame containing the name of the vertex with with maximum degree its degree.
+#' @return If the network is empty (i.e., has no vertices), \code{NA}.
+#'         Otherwise, a data frame containing the name of the vertex/vertices with maximum degree and its/their degree.
 metrics.hub.degree = function(network, mode = c("total", "in", "out")) {
     ## check whether the network is empty, i.e., if it has no vertices
     if (igraph::vcount(network) == 0) {
@@ -102,8 +104,9 @@ metrics.density = function(network) {
 #' @param directed whether to consider directed paths in directed networks [default: TRUE]
 #' @param unconnected whether there are subnetworks in the network that are not connected.
 #'                    If \code{TRUE} only the lengths of the existing paths are considered and averaged;
-#'                    if \code{FALSE} the length of the missing paths are counted having length \code{vcount(graph)}, one longer than
-#'                    the longest possible geodesic in the network (from igraph documentation) [default: TRUE]
+#'                    if \code{FALSE} the length of the missing paths are counted having length \code{vcount(graph)},
+#'                    one longer than the longest possible geodesic in the network (from igraph documentation)
+#'                    [default: TRUE]
 #'
 #' @return The average path length of the given network.
 metrics.avg.pathlength = function(network, directed = TRUE, unconnected = TRUE) {
@@ -130,7 +133,8 @@ metrics.clustering.coeff = function(network, cc.type = c("global", "local", "bar
 #'
 #' @param network the network to be examined
 #' @param community.detection.algorithm the algorithm to be used for the detection of communities
-#'            which is required for the calculation of the clustering coefficient [default: igraph::cluster_walktrap]
+#'                                      which is required for the calculation of the clustering coefficient
+#'                                      [default: igraph::cluster_walktrap]
 #'
 #' @return The modularity value for the given network.
 metrics.modularity = function(network, community.detection.algorithm = igraph::cluster_walktrap) {
@@ -211,7 +215,7 @@ metrics.is.smallworld = function(network) {
 #'
 #' @param network the network to be examined
 #' @param minimum.number.vertices the minimum number of vertices with which
-#'  a network can be scale free [default: 30]
+#'                                a network can be scale free [default: 30]
 #'
 #' @return A dataframe containing the different values, connected to scale-freeness.
 metrics.scale.freeness = function(network, minimum.number.vertices = 30) {
@@ -256,7 +260,7 @@ metrics.scale.freeness = function(network, minimum.number.vertices = 30) {
 #'
 #' @param network the network to be examined
 #' @param minimum.number.vertices the minimum number of vertices with which
-#'  a network can be scale free [default: 30]
+#'                                a network can be scale free [default: 30]
 #'
 #' @return \code{TRUE}, if the network is scale free,
 #'         \code{FALSE}, otherwise.
@@ -305,7 +309,7 @@ VERTEX.CENTRALITIES.COLUMN.NAMES = c("vertex.name", "centrality")
 #'              - "network.degree"
 #'              - "network.eigen"
 #'              - "network.hierarchy"
-#'             [defalt: "network.degree"]
+#'             [default: "network.degree"]
 #' @param restrict.classification.to.vertices a vector of vertex names. Only vertices that are contained within this
 #'                                            vector are to be classified. Vertices that appear in the vector but are
 #'                                            not part of the classification result (i.e., they are not present in the

diff --git a/util-networks.R b/util-networks.R
@@ -919,7 +919,7 @@ NetworkBuilder = R6::R6Class("NetworkBuilder",
             ## 1) merge the existing networks
             u = igraph::disjoint_union(authors.net, artifacts.net)
 
-            ## As there is a bug in 'igraph::disjoint_union' in igraph versions 1.4.0 and 1.4.1
+            ## As there is a bug in 'igraph::disjoint_union' in igraph versions 1.4.0, 1.4.1, and 1.4.2
             ## (see https://github.com/igraph/rigraph/issues/761), we need to adjust the type of the date attribute
             ## of the outcome of 'igraph::disjoint_union'.
             ## Note: The following temporary fix only considers the 'date' attribute. However, this problem could also
@@ -1023,7 +1023,7 @@ construct.edge.list.from.key.value.list = function(list, network.conf, directed
                 item.edge.attrs = item[ , network.conf$get.value("edge.attributes")[cols.which], drop = FALSE]
 
                 ## construct edges
-                combinations = expand.grid(item.vertex, vertices.processed.set, stringsAsFactors = default.stringsAsFactors())
+                combinations = expand.grid(item.vertex, vertices.processed.set, stringsAsFactors = FALSE)
                 if (nrow(combinations) > 0 & nrow(item.edge.attrs) == 1) {
                     combinations = cbind(combinations, item.edge.attrs, row.names = NULL) # add edge attributes
                 }