From d1d9a039f50480ec5b442dc7e8b518648d1f9d9d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Maximilian=20L=C3=B6ffler?= Date: Sat, 24 Dec 2022 17:21:13 +0100 Subject: [PATCH 01/56] Add function 'verify.data.frame.columns' MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Add the 'verify.data.frame.column' to the miscellaneous utilities to check the existence and welltypedness of columns in a dataframe. This works towards fixing #208. Signed-off-by: Maximilian Löffler --- tests/test-misc.R | 67 +++++++++++++++++++++++++++++++++++++++++++++ util-misc.R | 70 +++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 137 insertions(+) diff --git a/tests/test-misc.R b/tests/test-misc.R index e40bde80..11d8be8b 100644 --- a/tests/test-misc.R +++ b/tests/test-misc.R @@ -107,6 +107,73 @@ test_that("Match argument or take default.", { expect_equal(actual.result, expected.result, info = "Multiple choices with ignored default, two choices") }) +## +## Check presence and datatype of column. +## + +test_that("Check presence and datatype of column.", { + + user.names = c("John", "Peter", "Maria", "Susanne") + + ## contains NaN to verify functionality does not break + age = c(42, 50, NaN, 66) + + ## contains NA to verify functionality does not break + is.male = c(TRUE, TRUE, FALSE, NA) + + ## construct simple testing dataframe + data.frame = data.frame(user.names, age, is.male) + + ## 1) Check base functionality (benign use-case) + expect_no_error(verify.data.frame.columns( + data.frame, c("user.names", "age", "is.male"), c("character", "numeric", "logical")), + message = "All columns present and well-typed.") + + ## 2) Base test with reordered columns + expect_no_error(verify.data.frame.columns( + data.frame, c("is.male", "age", "user.names"), c("logical", "numeric", "character")), + message = "Order of columns does not matter.") + + ## 3) Specify less columns than present (Allow optional columns) + expect_no_error(verify.data.frame.columns( + data.frame, c("user.names", "age"), c("character", "numeric")), + message = "Optional columns are allowed.") + + ## 4) Unequal amount of column names and datatypes + expect_error(verify.data.frame.columns( + data.frame, c("user.names", "age", "is.male"), c("character", "numeric")), + message = "More coloumn names specified than datatypes.") + expect_error(verify.data.frame.columns( + data.frame, c("user.names", "age"), c("character", "numeric", "logical")), + message = "More coloumn names specified than datatypes.") + + ## 5) Datatypes do not match column names + expect_error(verify.data.frame.columns( + data.frame, c("user.names", "age", "is.male"), c("logical", "character", "numeric")), + message = "Column names do not match datatypes.") + + ## 6) Invalid column / Column not present in dataframe (Typo) + expect_error(verify.data.frame.columns( + data.frame, c("user.name"), c("character")), + message = "Column names do not match datatypes.") + + ## 7) No datatypes specified and column names are present + expect_no_error(verify.data.frame.columns( + data.frame, c("user.names", "age", "is.male")), + message = "Column names do not match datatypes.") + + ## 8) No datatypes specified but column names are not present (Typo) + expect_error(verify.data.frame.columns( + data.frame, c("user.name")), + message = "Column names do not match datatypes.") + + ## 9) To many column names and no datatypes specified + expect_error(verify.data.frame.columns( + data.frame, c("user.names", "age", "is.male", "job.orientation")), + message = "Column names do not match datatypes.") + +}) + ## / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / ## Date handling ----------------------------------------------------------- diff --git a/util-misc.R b/util-misc.R index b161cf67..1b4dc8dc 100644 --- a/util-misc.R +++ b/util-misc.R @@ -139,6 +139,76 @@ match.arg.or.default = function(arg, choices, default = NULL, several.ok = FALSE } } +#' Check if a dataframe matches a given structure. This includes the dataframe to contain columns +#' which must match the column names in \code{columns} and the datatypes in \code{data.types} +#' +#' @param data the dataframe under investigation for structural conformity +#' @param columns a character vector containing the column names the data frame should include +#' @param data.types an ordered vector containing the data types corresponding to the columns. +#' This vector must be of same length of the vector of \code{columns} +#' [default: NULL] +verify.data.frame.columns = function(data, columns, data.types = NULL) { + + ## every column of the data frame must be one to one mapped to a datatype expected in the column + ## therefore if there aren't as many datatypes provided in \code{data.types} as column names have + ## been provided in \code{columns} we can stop here already. + if (!is.null(data.types) && length(columns) != length(data.types)) { + error.message = sprintf("If specified, the length of the two given vectors columns and data.types must match.") + logging::logerror(error.message) + stop(error.message) + } + + ## obtain vector of all column names included in the dataframe to ease further checks. + data.frame.columns = colnames(data) + + ## iterate over all columns in \code{columns} + for (i in seq_along(columns)) { + + ## obtain the column. + column = columns[i] + + ## stop verification process early if column is not present in the dataframe. + if (!(column %in% data.frame.columns)) { + error.message = sprintf("Column '%s' is missing from the dataframe", column) + logging::logerror(error.message) + stop(error.message) + } + + if (!is.null(data.types)) { + + ## obtain the datatype that should be present in the dataframe column c + ## which is currently under investigation. + expected.type = data.types[i] + + ## necessary case distinction for special case list where calling \code{base::class} + ## removes information about the listing property + if (expected.type == "list()") { + + ## column is not a list + if (!is.list(data[[column]])) { + error.message = sprintf("Column '%s' is expected to be a list but it '%s'", + column, class(received.type)) + logging::logerror(error.message) + stop(error.message) + } + + } else { + ## obtain the datatype that elements of the current column hold in the dataframe. + received.type = class(data[[column]]) + + ## stop verification process early if column type in the dataframe is not matching + ## the expected datatype. + if (!(expected.type %in% received.type)) { + error.message = sprintf("Column '%s' has type '%s' in dataframe, expected '%s'", + column, received.type, expected.type) + logging::logerror(error.message) + stop(error.message) + } + } + } + } +} + ## / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / ## Empty dataframe creation------------------------------------------------- From b7a95881da72ccaa548c6cd5d94bd558a25caa6f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Maximilian=20L=C3=B6ffler?= Date: Sat, 24 Dec 2022 17:38:07 +0100 Subject: [PATCH 02/56] Add dataframe structure verification MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Add call to 'verify.data.frame.columns' to relevant setters and read functions This works towards fixing #208. Signed-off-by: Maximilian Löffler --- util-data.R | 29 +++++++++++++++++++++++++++++ util-read.R | 30 +++++++++++++++++++++++++++++- 2 files changed, 58 insertions(+), 1 deletion(-) diff --git a/util-data.R b/util-data.R index e4025c75..abec16be 100644 --- a/util-data.R +++ b/util-data.R @@ -1064,6 +1064,9 @@ ProjectData = R6::R6Class("ProjectData", if (is.null(commit.data)) { commit.data = create.empty.commits.list() + } else { + ## check that dataframe is of correct shape + verify.data.frame.columns(commit.data, COMMITS.LIST.COLUMNS, COMMITS.LIST.DATA.TYPES) } ## store commit data @@ -1145,6 +1148,9 @@ ProjectData = R6::R6Class("ProjectData", if (is.null(data)) { data = create.empty.commit.message.list() + } else { + ## check that dataframe is of correct shape + verify.data.frame.columns(data, COMMIT.MESSAGE.LIST.COLUMNS, COMMIT.MESSAGE.LIST.DATA.TYPES) } ## set the actual data @@ -1214,6 +1220,9 @@ ProjectData = R6::R6Class("ProjectData", if (is.null(data)) { data = create.empty.synchronicity.list() + } else { + ## check that dataframe is of correct shape + verify.data.frame.columns(data, SYNCHRONICITY.LIST.COLUMNS, SYNCHRONICITY.LIST.DATA.TYPES) } ## set the actual data @@ -1287,6 +1296,9 @@ ProjectData = R6::R6Class("ProjectData", if (is.null(data)) { data = create.empty.pasta.list() + } else { + ## check that dataframe is of correct shape + verify.data.frame.columns(data, PASTA.LIST.COLUMNS, PASTA.LIST.DATA.TYPES) } ## set the actual data @@ -1368,6 +1380,9 @@ ProjectData = R6::R6Class("ProjectData", if (is.null(data)) { data = create.empty.gender.list() + } else { + ## check that dataframe is of correct shape + verify.data.frame.columns(data, GENDER.LIST.COLUMNS, GENDER.LIST.DATA.TYPES) } ## set the actual data @@ -1444,6 +1459,9 @@ ProjectData = R6::R6Class("ProjectData", if (is.null(mail.data)) { mail.data = create.empty.mails.list() + } else { + ## check that dataframe is of correct shape + verify.data.frame.columns(mail.data, MAILS.LIST.COLUMNS, MAILS.LIST.DATA.TYPES) } ## store mail data @@ -1502,6 +1520,14 @@ ProjectData = R6::R6Class("ProjectData", set.authors = function(data) { logging::loginfo("Setting author data.") private$authors = data + + if (is.null(data)) { + data = create.empty.authors.list( + } else { + ## check that dataframe is of correct shape + verify.data.frame.columns(data, AUTHORS.LIST.COLUMNS, AUTHORS.LIST.DATA.TYPES) + } + ## add gender data if wanted if (private$project.conf$get.value("gender")) { @@ -1606,6 +1632,9 @@ ProjectData = R6::R6Class("ProjectData", if (is.null(data)) { data = create.empty.issues.list() + } else { + ## check that dataframe is of correct shape + verify.data.frame.columns(data, ISSUES.LIST.COLUMNS, ISSUES.LIST.DATA.TYPES) } private$issues.unfiltered = data diff --git a/util-read.R b/util-read.R index 1f0451d0..5c3f1906 100644 --- a/util-read.R +++ b/util-read.R @@ -181,6 +181,9 @@ read.commits = function(data.path, artifact) { commit.data[["commit.id"]] = format.commit.ids(commit.data[["commit.id"]]) row.names(commit.data) = seq_len(nrow(commit.data)) + ## check that dataframe is of correct shape + verify.data.frame.columns(commit.data, COMMITS.LIST.COLUMNS, COMMITS.LIST.DATA.TYPES) + ## store the commit data logging::logdebug("read.commits: finished.") return(commit.data) @@ -264,6 +267,9 @@ read.mails = function(data.path) { } mail.data = remove.deleted.and.empty.user(mail.data) # filter deleted user + ## check that dataframe is of correct shape + verify.data.frame.columns(mail.data, MAILS.LIST.COLUMNS, MAILS.LIST.DATA.TYPES) + ## store the mail data logging::logdebug("read.mails: finished.") return(mail.data) @@ -384,6 +390,9 @@ read.issues = function(data.path, issues.sources = c("jira", "github")) { function(event) { digest::digest(event, algo="sha1", serialize = FALSE) } ) + ## check that dataframe is of correct shape + verify.data.frame.columns(issue.data, ISSUES.LIST.COLUMNS, ISSUES.LIST.DATA.TYPES) + logging::logdebug("read.issues: finished.") return(issue.data) } @@ -438,6 +447,10 @@ read.bot.info = function(data.path) { ## set column names for new data frame colnames(bot.data) = BOT.LIST.COLUMNS bot.data["is.bot"] = sapply(bot.data[["is.bot"]], function(x) switch(x, Bot = TRUE, Human = FALSE, NA)) + + ## check that dataframe is of correct shape + verify.data.frame.columns(bot.data, BOT.LIST.COLUMNS) + logging::logdebug("read.bot.info: finished.") return(bot.data) } @@ -499,6 +512,9 @@ read.authors = function(data.path) { authors.df = authors.df[, AUTHORS.LIST.COLUMNS] authors.df = remove.deleted.and.empty.user(authors.df) + ## check that dataframe is of correct shape + verify.data.frame.columns(authors.df, AUTHORS.LIST.COLUMNS, AUTHORS.LIST.DATA.TYPES) + ## store the ID--author mapping logging::logdebug("read.authors: finished.") return(authors.df) @@ -583,6 +599,9 @@ read.gender = function(data.path) { ## remove rownames rownames(gender.data) = NULL + ## check that dataframe is of correct shape + verify.data.frame.columns(gender.data, GENDER.LIST.COLUMNS, GENDER.LIST.DATA.TYPES) + logging::logdebug("read.gender: finished.") return(gender.data) @@ -691,8 +710,10 @@ read.commit.messages = function(data.path) { commit.message.data[["commit.id"]] = format.commit.ids(commit.message.data[["commit.id"]]) row.names(commit.message.data) = seq_len(nrow(commit.message.data)) - logging::logdebug("read.commit.messages: finished.") + ## check that dataframe is of correct shape + verify.data.frame.columns(commit.message.data, COMMIT.MESSAGE.LIST.COLUMNS, COMMIT.MESSAGE.LIST.DATA.TYPES) + logging::logdebug("read.commit.messages: finished.") return(commit.message.data) } @@ -775,6 +796,10 @@ read.pasta = function(data.path) { return(df) }) result.df = plyr::rbind.fill(result.list) + + ## check that dataframe is of correct shape + verify.data.frame.columns(result.df, PASTA.LIST.COLUMNS, PASTA.LIST.DATA.TYPES) + logging::logdebug("read.pasta: finished.") return(result.df) } @@ -838,6 +863,9 @@ read.synchronicity = function(data.path, artifact, time.window) { ## ensure proper column names colnames(synchronicity) = SYNCHRONICITY.LIST.COLUMNS + ## check that dataframe is of correct shape + verify.data.frame.columns(synchronicity, SYNCHRONICITY.LIST.COLUMNS, SYNCHRONICITY.LIST.DATA.TYPES) + ## store the synchronicity data logging::logdebug("read.synchronicity: finished.") return(synchronicity) From ecfa643cbc15975c3062af95c50ead02730b580f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Maximilian=20L=C3=B6ffler?= Date: Wed, 4 Jan 2023 13:57:02 +0100 Subject: [PATCH 03/56] Fix problems that arise due to the structural verification of dataframes MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Change most internal types from numeric to integer; also in related tests. Add sufficient checks for empty input-files in read functions. Close previously unlocked parenthesis in util-data. Change dummy fill of author email from NA to null-string to comply with character type of column. This fixes #208. Signed-off-by: Maximilian Löffler --- tests/test-read.R | 4 ++-- util-data.R | 2 +- util-read.R | 45 ++++++++++++++++++++++++++++++--------------- 3 files changed, 33 insertions(+), 18 deletions(-) diff --git a/tests/test-read.R b/tests/test-read.R index 48cae572..6e5e6908 100644 --- a/tests/test-read.R +++ b/tests/test-read.R @@ -129,7 +129,7 @@ test_that("Read the raw commit data with the file artifact.", { artifact = c("test.c", "test.c", "test2.c", "test3.c", UNTRACKED.FILE, UNTRACKED.FILE, "test2.c"), artifact.type = c("File", "File", "File", "File", UNTRACKED.FILE.EMPTY.ARTIFACT.TYPE, UNTRACKED.FILE.EMPTY.ARTIFACT.TYPE, "File"), - artifact.diff.size = c(1, 1, 1, 1, 0, 0, 1)) + artifact.diff.size = as.integer(c(1, 1, 1, 1, 0, 0, 1))) ## check the results expect_identical(commit.data.read, commit.data.expected, info = "Raw commit data.") @@ -243,7 +243,7 @@ test_that("Read the author data.", { ## build the expected data.frame author.data.expected = data.frame( - author.id = as.integer(c(4936, 4937, 4938, 4939, 4940, 4941, 4942, 4943, 4944)), + author.id = as.character(c(4936, 4937, 4938, 4939, 4940, 4941, 4942, 4943, 4944)), author.name = c("Thomas", "Olaf", "Björn", "udo", "Fritz fritz@example.org", "georg", "Hans", "Karl", "Max"), author.email = c("thomas@example.org", "olaf@example.org", "bjoern@example.org", "udo@example.org", "asd@sample.org", "heinz@example.org", "hans1@example.org", "karl@example.org", "max@example.org"), diff --git a/util-data.R b/util-data.R index abec16be..22a82e26 100644 --- a/util-data.R +++ b/util-data.R @@ -1522,7 +1522,7 @@ ProjectData = R6::R6Class("ProjectData", private$authors = data if (is.null(data)) { - data = create.empty.authors.list( + data = create.empty.authors.list() } else { ## check that dataframe is of correct shape verify.data.frame.columns(data, AUTHORS.LIST.COLUMNS, AUTHORS.LIST.DATA.TYPES) diff --git a/util-read.R b/util-read.R index 5c3f1906..35d84405 100644 --- a/util-read.R +++ b/util-read.R @@ -72,8 +72,8 @@ COMMITS.LIST.DATA.TYPES = c( "character", "POSIXct", "character", "character", "POSIXct", "character", "character", - "character", "numeric", "numeric", "numeric", "numeric", - "character", "character", "character", "numeric" + "character", "integer", "integer", "integer", "integer", + "character", "character", "character", "integer" ) #' Read the commits from the 'commits.list' file. @@ -92,7 +92,7 @@ read.commits = function(data.path, artifact) { encoding = "UTF-8"), silent = TRUE) ## handle the case that the list of commits is empty - if (inherits(commit.data, "try-error")) { + if (inherits(commit.data, "try-error") || nrow(commit.data) < 1) { logging::logwarn("There are no commits available for the current environment.") logging::logwarn("Datapath: %s", data.path) @@ -136,7 +136,7 @@ read.commits = function(data.path, artifact) { ORDER BY `date`, `author.name`, `commit.id`, `file`, `artifact`") ## fix column class for diffsum - commit.data["diffsum"] = as.numeric(commit.data[["diffsum"]]) + commit.data["diffsum"] = as.integer(commit.data[["diffsum"]]) ## copy columns to match proper layout for further analyses commit.data["artifact"] = commit.data[["file"]] @@ -210,7 +210,7 @@ MAILS.LIST.COLUMNS = c( ## declare the datatype for each column in the constant 'MAILS.LIST.COLUMNS' MAILS.LIST.DATA.TYPES = c( "character", "character", - "character", "POSIXct", "numeric", "character", + "character", "POSIXct", "integer", "character", "character", "character" ) @@ -231,7 +231,7 @@ read.mails = function(data.path) { encoding = "UTF-8"), silent = TRUE) ## handle the case that the list of mails is empty - if (inherits(mail.data, "try-error")) { + if (inherits(mail.data, "try-error") || nrow(mail.data) < 1) { logging::logwarn("There are no mails available for the current environment.") logging::logwarn("Datapath: %s", data.path) return(create.empty.mails.list()) @@ -332,7 +332,7 @@ read.issues = function(data.path, issues.sources = c("jira", "github")) { encoding = "UTF-8"), silent = TRUE) ## handle the case that the list of issues is empty - if (inherits(source.data, "try-error")) { + if (inherits(source.data, "try-error") || nrow(source.data) < 1) { logging::logwarn("There are no %s issue data available for the current environment.", issue.source) logging::logwarn("Datapath: %s", data.path) return(create.empty.issues.list()) @@ -351,12 +351,23 @@ read.issues = function(data.path, issues.sources = c("jira", "github")) { ## set proper column names colnames(source.data) = ISSUES.LIST.COLUMNS + ## add present flag to data + ## (this information can be used to early exit later) + source.data["present"] = TRUE return(source.data) }) ## combine issue data from all sources issue.data = do.call(rbind, issue.data) + ## if no chosen source is present exit early by returning the (combined) empty issues list + ## else remove the present flag again + if (!"present" %in% colnames(issue.data)) { + return(issue.data) + } else { + issue.data <- subset(issue.data, select = -present) + } + ## set pattern for issue ID for better recognition issue.data[["issue.id"]] = sprintf("", issue.data[["issue.source"]], issue.data[["issue.id"]]) @@ -440,7 +451,8 @@ read.bot.info = function(data.path) { logging::logwarn("There is no bot information available for the current environment.") logging::logwarn("Datapath: %s", data.path) - ## return a data frame with the correct columns but zero rows + ## return NULL. Creating an empty dataframe is not possible + ## because no type information about bot information is present return(NULL) } @@ -486,15 +498,15 @@ read.authors = function(data.path) { ## break if the list of authors is empty - if (inherits(authors.df, "try-error")) { + if (inherits(authors.df, "try-error") || nrow(authors.df) < 1) { logging::logerror("There are no authors available for the current environment.") logging::logwarn("Datapath: %s", data.path) stop("Stopped due to missing authors.") } - ## if there is no third column, we need to add e-mail-address dummy data (NAs) + ## if there is no third column, we need to add e-mail-address dummy data if (ncol(authors.df) != length(AUTHORS.LIST.COLUMNS.WITHOUT.BOTS)) { - authors.df[3] = NA + authors.df[3] = "" } colnames(authors.df) = AUTHORS.LIST.COLUMNS.WITHOUT.BOTS @@ -512,6 +524,9 @@ read.authors = function(data.path) { authors.df = authors.df[, AUTHORS.LIST.COLUMNS] authors.df = remove.deleted.and.empty.user(authors.df) + ## assure type correctness + authors.df[["author.id"]] = as.character(authors.df[["author.id"]]) + ## check that dataframe is of correct shape verify.data.frame.columns(authors.df, AUTHORS.LIST.COLUMNS, AUTHORS.LIST.DATA.TYPES) @@ -566,7 +581,7 @@ read.gender = function(data.path) { ## handle the case if the list of items is empty - if (inherits(gender.data, "try-error")) { + if (inherits(gender.data, "try-error") || nrow(gender.data) < 1) { logging::logwarn("There are no gender data available for the current environment.") logging::logwarn("Datapath: %s", data.path) return(create.empty.gender.list()) @@ -656,7 +671,7 @@ read.commit.messages = function(data.path) { encoding = "UTF-8"), silent = TRUE) ## handle the case that the list of commits is empty - if (inherits(commit.message.data, "try-error")) { + if (inherits(commit.message.data, "try-error") || nrow(commit.message.data) < 1) { logging::logwarn("There are no commit messages available for the current environment.") logging::logwarn("Datapath: %s", data.path) @@ -758,7 +773,7 @@ read.pasta = function(data.path) { lines = suppressWarnings(try(readLines(filepath), silent = TRUE)) ## handle the case if the list of PaStA items is empty - if (inherits(lines, "try-error")) { + if (inherits(lines, "try-error") || length(lines) < 1) { logging::logwarn("There are no PaStA data available for the current environment.") logging::logwarn("Datapath: %s", data.path) return(create.empty.pasta.list()) @@ -899,7 +914,7 @@ read.custom.event.timestamps = function(data.path, file.name) { encoding = "UTF-8"), silent = TRUE) ## handle the case that the list of commits is empty - if (inherits(custom.event.timestamps.table, "try-error")) { + if (inherits(custom.event.timestamps.table, "try-error") || nrow(custom.event.timestamps.table) < 1) { logging::logwarn("There are no custom timestamps available at the given path.") logging::logwarn("Datapath: %s", data.path) From 8043e90c2cbdd300cc5269633f5e8f23cf1f38e3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Maximilian=20L=C3=B6ffler?= Date: Wed, 4 Jan 2023 14:06:15 +0100 Subject: [PATCH 04/56] Add copyright header MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Add copyright header to updated utility and test files. This fixes #208. Signed-off-by: Maximilian Löffler --- tests/test-misc.R | 1 + tests/test-read.R | 1 + util-data.R | 1 + util-misc.R | 1 + util-read.R | 1 + 5 files changed, 5 insertions(+) diff --git a/tests/test-misc.R b/tests/test-misc.R index 11d8be8b..d1c4d886 100644 --- a/tests/test-misc.R +++ b/tests/test-misc.R @@ -14,6 +14,7 @@ ## Copyright 2017 by Felix Prasse ## Copyright 2017-2018 by Claus Hunsen ## Copyright 2017-2018 by Thomas Bock +## Copyright 2023 by Maximilian Löffler ## All Rights Reserved. diff --git a/tests/test-read.R b/tests/test-read.R index 6e5e6908..a1f1435f 100644 --- a/tests/test-read.R +++ b/tests/test-read.R @@ -21,6 +21,7 @@ ## Copyright 2021 by Johannes Hostert ## Copyright 2021 by Mirabdulla Yusifli ## Copyright 2022 by Jonathan Baumann +## Copyright 2023 by Maximilian Löffler ## All Rights Reserved. diff --git a/util-data.R b/util-data.R index 22a82e26..56741ffc 100644 --- a/util-data.R +++ b/util-data.R @@ -25,6 +25,7 @@ ## Copyright 2021 by Johannes Hostert ## Copyright 2021 by Mirabdulla Yusifli ## Copyright 2022 by Jonathan Baumann +## Copyright 2023 by Maximilian Löffler ## All Rights Reserved. diff --git a/util-misc.R b/util-misc.R index 1b4dc8dc..1ef1ef40 100644 --- a/util-misc.R +++ b/util-misc.R @@ -20,6 +20,7 @@ ## Copyright 2018-2019 by Jakob Kronawitter ## Copyright 2021 by Niklas Schneider ## Copyright 2022 by Jonathan Baumann +## Copyright 2023 by Maximilian Löffler ## All Rights Reserved. diff --git a/util-read.R b/util-read.R index 35d84405..d3b38e00 100644 --- a/util-read.R +++ b/util-read.R @@ -23,6 +23,7 @@ ## Copyright 2021 by Johannes Hostert ## Copyright 2021 by Mirabdulla Yusifli ## Copyright 2022 by Jonathan Baumann +## Copyright 2023 by Maximilian Löffler ## All Rights Reserved. ## Note: From de7de7a05ee823e23e9f7b4d5ca728cd899d3eee Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Maximilian=20L=C3=B6ffler?= Date: Fri, 13 Jan 2023 21:15:54 +0100 Subject: [PATCH 05/56] Validate custom event timestamps and clarify unclear comments MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Add check that input is a list in 'set.custom.event.timestamps' and verify correct input structure in 'read.custom.event.timestamps'. Concretize unclear comments, fix punctuation and spelling mistakes. Update copyright headers. This fixes feedback on #208. Signed-off-by: Maximilian Löffler --- tests/test-misc.R | 20 ++++++++++---------- tests/test-read.R | 2 +- util-data.R | 7 ++++++- util-misc.R | 32 +++++++++++++++++--------------- util-read.R | 30 +++++++++++++++++++++--------- 5 files changed, 55 insertions(+), 36 deletions(-) diff --git a/tests/test-misc.R b/tests/test-misc.R index d1c4d886..2451d25a 100644 --- a/tests/test-misc.R +++ b/tests/test-misc.R @@ -14,7 +14,7 @@ ## Copyright 2017 by Felix Prasse ## Copyright 2017-2018 by Claus Hunsen ## Copyright 2017-2018 by Thomas Bock -## Copyright 2023 by Maximilian Löffler +## Copyright 2022-2023 by Maximilian Löffler ## All Rights Reserved. @@ -109,10 +109,10 @@ test_that("Match argument or take default.", { }) ## -## Check presence and datatype of column. +## Check presence and datatype of data frame columns. ## -test_that("Check presence and datatype of column.", { +test_that("Check presence and datatype of data frame columns.", { user.names = c("John", "Peter", "Maria", "Susanne") @@ -143,10 +143,10 @@ test_that("Check presence and datatype of column.", { ## 4) Unequal amount of column names and datatypes expect_error(verify.data.frame.columns( data.frame, c("user.names", "age", "is.male"), c("character", "numeric")), - message = "More coloumn names specified than datatypes.") + message = "More column names specified than datatypes.") expect_error(verify.data.frame.columns( data.frame, c("user.names", "age"), c("character", "numeric", "logical")), - message = "More coloumn names specified than datatypes.") + message = "More column names specified than datatypes.") ## 5) Datatypes do not match column names expect_error(verify.data.frame.columns( @@ -156,22 +156,22 @@ test_that("Check presence and datatype of column.", { ## 6) Invalid column / Column not present in dataframe (Typo) expect_error(verify.data.frame.columns( data.frame, c("user.name"), c("character")), - message = "Column names do not match datatypes.") + message = "Column name 'user.name' should not be in dataframe.") ## 7) No datatypes specified and column names are present expect_no_error(verify.data.frame.columns( data.frame, c("user.names", "age", "is.male")), message = "Column names do not match datatypes.") - ## 8) No datatypes specified but column names are not present (Typo) + ## 8) No datatypes specified and column names are not specified correctly (Typo) expect_error(verify.data.frame.columns( data.frame, c("user.name")), - message = "Column names do not match datatypes.") + message = "Column name 'user.name' should not be in dataframe.") - ## 9) To many column names and no datatypes specified + ## 9) Too many column names and no datatypes specified expect_error(verify.data.frame.columns( data.frame, c("user.names", "age", "is.male", "job.orientation")), - message = "Column names do not match datatypes.") + message = "More column names specififed than present in the dataframe.") }) diff --git a/tests/test-read.R b/tests/test-read.R index a1f1435f..9a597f23 100644 --- a/tests/test-read.R +++ b/tests/test-read.R @@ -21,7 +21,7 @@ ## Copyright 2021 by Johannes Hostert ## Copyright 2021 by Mirabdulla Yusifli ## Copyright 2022 by Jonathan Baumann -## Copyright 2023 by Maximilian Löffler +## Copyright 2022-2023 by Maximilian Löffler ## All Rights Reserved. diff --git a/util-data.R b/util-data.R index 56741ffc..af6f458a 100644 --- a/util-data.R +++ b/util-data.R @@ -25,7 +25,7 @@ ## Copyright 2021 by Johannes Hostert ## Copyright 2021 by Mirabdulla Yusifli ## Copyright 2022 by Jonathan Baumann -## Copyright 2023 by Maximilian Löffler +## Copyright 2022-2023 by Maximilian Löffler ## All Rights Reserved. @@ -2159,6 +2159,11 @@ ProjectData = R6::R6Class("ProjectData", #' #' @param custom.event.timestamps the list of timestamps to set set.custom.event.timestamps = function(custom.event.timestamps) { + if (!is.list(custom.event.timestamps)) { + error.message = sprintf("set.custom.event.timestamps: Input is expected to be a list.") + logging::logerror(error.message) + stop(error.message) + } if(length(custom.event.timestamps) != 0){ private$custom.event.timestamps = custom.event.timestamps[ order(unlist(get.date.from.string(custom.event.timestamps))) diff --git a/util-misc.R b/util-misc.R index 1ef1ef40..72a1fb9d 100644 --- a/util-misc.R +++ b/util-misc.R @@ -20,7 +20,7 @@ ## Copyright 2018-2019 by Jakob Kronawitter ## Copyright 2021 by Niklas Schneider ## Copyright 2022 by Jonathan Baumann -## Copyright 2023 by Maximilian Löffler +## Copyright 2022-2023 by Maximilian Löffler ## All Rights Reserved. @@ -141,25 +141,27 @@ match.arg.or.default = function(arg, choices, default = NULL, several.ok = FALSE } #' Check if a dataframe matches a given structure. This includes the dataframe to contain columns -#' which must match the column names in \code{columns} and the datatypes in \code{data.types} +#' which must match the column names in \code{columns} and the datatypes in \code{data.types}. #' -#' @param data the dataframe under investigation for structural conformity +#' @param data the data frame under investigation for structural conformity #' @param columns a character vector containing the column names the data frame should include #' @param data.types an ordered vector containing the data types corresponding to the columns. -#' This vector must be of same length of the vector of \code{columns} +#' If this parameter is \code{NULL} only the existence of \code{columns} is checked +#' without regarding column types. Otherwise this vector must be of the +#' same length as the vector of \code{columns} #' [default: NULL] verify.data.frame.columns = function(data, columns, data.types = NULL) { ## every column of the data frame must be one to one mapped to a datatype expected in the column ## therefore if there aren't as many datatypes provided in \code{data.types} as column names have - ## been provided in \code{columns} we can stop here already. + ## been provided in \code{columns} we can stop here already if (!is.null(data.types) && length(columns) != length(data.types)) { - error.message = sprintf("If specified, the length of the two given vectors columns and data.types must match.") + error.message = sprintf("If specified, the length of the two given vectors 'columns' and 'data.types' must match.") logging::logerror(error.message) stop(error.message) } - ## obtain vector of all column names included in the dataframe to ease further checks. + ## obtain vector of all column names included in the data frame to ease further checks data.frame.columns = colnames(data) ## iterate over all columns in \code{columns} @@ -168,7 +170,7 @@ verify.data.frame.columns = function(data, columns, data.types = NULL) { ## obtain the column. column = columns[i] - ## stop verification process early if column is not present in the dataframe. + ## stop verification process early if column is not present in the data frame if (!(column %in% data.frame.columns)) { error.message = sprintf("Column '%s' is missing from the dataframe", column) logging::logerror(error.message) @@ -177,28 +179,28 @@ verify.data.frame.columns = function(data, columns, data.types = NULL) { if (!is.null(data.types)) { - ## obtain the datatype that should be present in the dataframe column c - ## which is currently under investigation. + ## obtain the datatype that should be present in the data frame column + ## which is currently under investigation expected.type = data.types[i] ## necessary case distinction for special case list where calling \code{base::class} - ## removes information about the listing property + ## removes the information whether or not \code{data[[column]]} is a list if (expected.type == "list()") { ## column is not a list if (!is.list(data[[column]])) { - error.message = sprintf("Column '%s' is expected to be a list but it '%s'", + error.message = sprintf("Column '%s' is expected to be a list but is '%s'", column, class(received.type)) logging::logerror(error.message) stop(error.message) } } else { - ## obtain the datatype that elements of the current column hold in the dataframe. + ## obtain the datatype that elements of the current column hold in the data frame received.type = class(data[[column]]) - ## stop verification process early if column type in the dataframe is not matching - ## the expected datatype. + ## stop verification process early if column type in the data frame is not matching + ## the expected datatype if (!(expected.type %in% received.type)) { error.message = sprintf("Column '%s' has type '%s' in dataframe, expected '%s'", column, received.type, expected.type) diff --git a/util-read.R b/util-read.R index d3b38e00..7e10fc8d 100644 --- a/util-read.R +++ b/util-read.R @@ -23,7 +23,7 @@ ## Copyright 2021 by Johannes Hostert ## Copyright 2021 by Mirabdulla Yusifli ## Copyright 2022 by Jonathan Baumann -## Copyright 2023 by Maximilian Löffler +## Copyright 2022-2023 by Maximilian Löffler ## All Rights Reserved. ## Note: @@ -351,10 +351,6 @@ read.issues = function(data.path, issues.sources = c("jira", "github")) { ## set proper column names colnames(source.data) = ISSUES.LIST.COLUMNS - - ## add present flag to data - ## (this information can be used to early exit later) - source.data["present"] = TRUE return(source.data) }) @@ -362,11 +358,8 @@ read.issues = function(data.path, issues.sources = c("jira", "github")) { issue.data = do.call(rbind, issue.data) ## if no chosen source is present exit early by returning the (combined) empty issues list - ## else remove the present flag again - if (!"present" %in% colnames(issue.data)) { + if (nrow(issue.data) < 1) { return(issue.data) - } else { - issue.data <- subset(issue.data, select = -present) } ## set pattern for issue ID for better recognition @@ -925,6 +918,25 @@ read.custom.event.timestamps = function(data.path, file.name) { timestamps = as.list(custom.event.timestamps.table[[2]]) names(timestamps) = custom.event.timestamps.table[[1]] + ## check if first column of input has type character + if (class(names(timestamps)) != "character") { + error.message = sprintf( + "The first column of custom event timestamps should be of type character but is '%s'", + class(names(timestamps))) + logging::logerror(error.message) + stop(error.message) + } + + ## check if second column of input is in POSIXct format by converting + ## all elements to POSIXct and catch possible errors + tryCatch(sapply(timestamps, function(time) as.POSIXct(time)), + error = function(e) { + error.message = sprintf("The second column of custom event timestamps should be in POSIXct format") + logging::logerror(error.message) + stop(error.message) + }) + + ## Sort the timestamps if (length(timestamps) != 0) { timestamps = timestamps[order(unlist(get.date.from.string(timestamps)))] From 1b2e11ac006db95167230c9827b3adf88055b1e8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Maximilian=20L=C3=B6ffler?= Date: Wed, 18 Jan 2023 13:02:17 +0100 Subject: [PATCH 06/56] Simplify stuctural checks on custom event timestamps and break long line MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Remove check on first column of timestamp data in 'read.custom.event.timestamps' as non-character fields will be cast to character anyways by call to 'names'. Simplify POSIXct format check on second column using 'get.date.from.string' function. Wrap overly long line in 'verify.data.frame.columns'. This fixes feedback on #208. Signed-off-by: Maximilian Löffler --- util-misc.R | 3 ++- util-read.R | 23 +++++++---------------- 2 files changed, 9 insertions(+), 17 deletions(-) diff --git a/util-misc.R b/util-misc.R index 72a1fb9d..72967ded 100644 --- a/util-misc.R +++ b/util-misc.R @@ -156,7 +156,8 @@ verify.data.frame.columns = function(data, columns, data.types = NULL) { ## therefore if there aren't as many datatypes provided in \code{data.types} as column names have ## been provided in \code{columns} we can stop here already if (!is.null(data.types) && length(columns) != length(data.types)) { - error.message = sprintf("If specified, the length of the two given vectors 'columns' and 'data.types' must match.") + error.message = sprintf(paste("If specified, the length of the two given vectors", + "'columns' and 'data.types' must match.")) logging::logerror(error.message) stop(error.message) } diff --git a/util-read.R b/util-read.R index 7e10fc8d..13a786ce 100644 --- a/util-read.R +++ b/util-read.R @@ -918,28 +918,19 @@ read.custom.event.timestamps = function(data.path, file.name) { timestamps = as.list(custom.event.timestamps.table[[2]]) names(timestamps) = custom.event.timestamps.table[[1]] - ## check if first column of input has type character - if (class(names(timestamps)) != "character") { - error.message = sprintf( - "The first column of custom event timestamps should be of type character but is '%s'", - class(names(timestamps))) + ## convert all timestamps to POSIXct format + posix.timestamps = get.date.from.string(timestamps) + + ## if a timestamp is malformatted get.date.from.string returns a NA + if (any(is.na(posix.timestamps))) { + error.message = sprintf("Input timestamps are not in POSIXct format (YYYY-mm-DD HH:MM:SS).") logging::logerror(error.message) stop(error.message) } - ## check if second column of input is in POSIXct format by converting - ## all elements to POSIXct and catch possible errors - tryCatch(sapply(timestamps, function(time) as.POSIXct(time)), - error = function(e) { - error.message = sprintf("The second column of custom event timestamps should be in POSIXct format") - logging::logerror(error.message) - stop(error.message) - }) - - ## Sort the timestamps if (length(timestamps) != 0) { - timestamps = timestamps[order(unlist(get.date.from.string(timestamps)))] + timestamps = timestamps[order(unlist(posix.timestamps))] } logging::logdebug("read.custom.event.timestamps: finished.") From 4ff6b53ac47e50a76c94c29cbed6306d4097c3f9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Maximilian=20L=C3=B6ffler?= Date: Wed, 18 Jan 2023 13:22:04 +0100 Subject: [PATCH 07/56] Update 'NEWS.md' MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Add changes and additions reguarding dataframe verification to 'NEWS.md'. This completes checklist on #208. Signed-off-by: Maximilian Löffler --- NEWS.md | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/NEWS.md b/NEWS.md index 7544432a..4b5e5204 100644 --- a/NEWS.md +++ b/NEWS.md @@ -2,6 +2,20 @@ # coronet – Changelog +## 4.3 + +### Added + +- Add function `verify.data.frame.columns` to check that a dataframe includes all required columns, optionally with a specified datatype (PR #208 d1d9a039f50480ec5b442dc7e8b518648d1f9d9d). + +### Changed/Improved + +- Include structural verification to almost all functions that read dataframes from files or set a dataframe (setter-functions) (PR #208 b7a95881da72ccaa548c6cd5d94bd558a25caa6f). + +### 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 #208 ecfa643cbc15975c3062af95c50ead02730b580f). + ## 4.2 ### Added From 1f10f8f674e970aedbf6f73968fa1b62240148fe Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Maximilian=20L=C3=B6ffler?= Date: Wed, 18 Jan 2023 13:38:58 +0100 Subject: [PATCH 08/56] Fix indentation MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Indent line-wrapped string according to convention. This fixes feedback on #208. Signed-off-by: Maximilian Löffler --- util-misc.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/util-misc.R b/util-misc.R index 72967ded..9cba90d7 100644 --- a/util-misc.R +++ b/util-misc.R @@ -157,7 +157,7 @@ verify.data.frame.columns = function(data, columns, data.types = NULL) { ## been provided in \code{columns} we can stop here already if (!is.null(data.types) && length(columns) != length(data.types)) { error.message = sprintf(paste("If specified, the length of the two given vectors", - "'columns' and 'data.types' must match.")) + "'columns' and 'data.types' must match.")) logging::logerror(error.message) stop(error.message) } From fc52984de89b53f31dc000ef19b6a7e168621a4c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Maximilian=20L=C3=B6ffler?= Date: Wed, 18 Jan 2023 13:45:48 +0100 Subject: [PATCH 09/56] Change issue number to pull-request number in MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit In change issue number to pull-request number and add comma after. This fixes feedback on #208. Signed-off-by: Maximilian Löffler --- NEWS.md | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/NEWS.md b/NEWS.md index 4b5e5204..2e32b110 100644 --- a/NEWS.md +++ b/NEWS.md @@ -6,15 +6,15 @@ ### Added -- Add function `verify.data.frame.columns` to check that a dataframe includes all required columns, optionally with a specified datatype (PR #208 d1d9a039f50480ec5b442dc7e8b518648d1f9d9d). +- Add function `verify.data.frame.columns` to check that a dataframe includes all required columns, optionally with a specified datatype (PR #231, d1d9a039f50480ec5b442dc7e8b518648d1f9d9d). ### Changed/Improved -- Include structural verification to almost all functions that read dataframes from files or set a dataframe (setter-functions) (PR #208 b7a95881da72ccaa548c6cd5d94bd558a25caa6f). +- Include structural verification to almost all functions that read dataframes from files or set a dataframe (setter-functions) (PR #231, b7a95881da72ccaa548c6cd5d94bd558a25caa6f). ### 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 #208 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). ## 4.2 From 38c207764d2e01b95267ba8704f076cc1aa96535 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Maximilian=20L=C3=B6ffler?= Date: Wed, 18 Jan 2023 15:00:22 +0100 Subject: [PATCH 10/56] Replace experimental 'testthat' feature MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Replace 'expect_no_error(expr, message)' by 'expect_error(expr, NA, message)'. This fixes feedback on #208. Signed-off-by: Maximilian Löffler --- tests/test-misc.R | 16 ++++++++++++---- 1 file changed, 12 insertions(+), 4 deletions(-) diff --git a/tests/test-misc.R b/tests/test-misc.R index 2451d25a..af59e469 100644 --- a/tests/test-misc.R +++ b/tests/test-misc.R @@ -126,19 +126,25 @@ test_that("Check presence and datatype of data frame columns.", { data.frame = data.frame(user.names, age, is.male) ## 1) Check base functionality (benign use-case) - expect_no_error(verify.data.frame.columns( + expect_error(verify.data.frame.columns( data.frame, c("user.names", "age", "is.male"), c("character", "numeric", "logical")), + NA, message = "All columns present and well-typed.") + ## Expect no error ## 2) Base test with reordered columns - expect_no_error(verify.data.frame.columns( + expect_error(verify.data.frame.columns( data.frame, c("is.male", "age", "user.names"), c("logical", "numeric", "character")), + NA, message = "Order of columns does not matter.") + ## Expect no error ## 3) Specify less columns than present (Allow optional columns) - expect_no_error(verify.data.frame.columns( + expect_error(verify.data.frame.columns( data.frame, c("user.names", "age"), c("character", "numeric")), + NA, message = "Optional columns are allowed.") + ## Expect no error ## 4) Unequal amount of column names and datatypes expect_error(verify.data.frame.columns( @@ -159,9 +165,11 @@ test_that("Check presence and datatype of data frame columns.", { message = "Column name 'user.name' should not be in dataframe.") ## 7) No datatypes specified and column names are present - expect_no_error(verify.data.frame.columns( + expect_error(verify.data.frame.columns( data.frame, c("user.names", "age", "is.male")), + NA, message = "Column names do not match datatypes.") + ## Expect no error ## 8) No datatypes specified and column names are not specified correctly (Typo) expect_error(verify.data.frame.columns( From 08fbd3e11e33d060f42cbc6f729eaf60b48a6de7 Mon Sep 17 00:00:00 2001 From: Niklas Schneider Date: Tue, 24 Jan 2023 15:37:27 +0100 Subject: [PATCH 11/56] Rewrite remove.deleted.and.empty.user to take multiple columns as argument and use it in setters The function in util-read.R now uses a vector containing the columns to check for deleted and ampty users. This is important for commits, because there, the column "committer.name" is also relevant. Also use the function in the setter methods of util.data for mails, issues, commits, and authors right after input validation. This addresses #213. Signed-off-by: Niklas Schneider --- util-data.R | 14 +++++++++++++- util-read.R | 20 ++++++++++++++------ 2 files changed, 27 insertions(+), 7 deletions(-) diff --git a/util-data.R b/util-data.R index af6f458a..d7105440 100644 --- a/util-data.R +++ b/util-data.R @@ -21,7 +21,7 @@ ## Copyright 2017 by Ferdinand Frank ## Copyright 2018-2019 by Jakob Kronawitter ## Copyright 2019-2020 by Anselm Fehnker -## Copyright 2020-2021 by Niklas Schneider +## Copyright 2020-2021, 2023 by Niklas Schneider ## Copyright 2021 by Johannes Hostert ## Copyright 2021 by Mirabdulla Yusifli ## Copyright 2022 by Jonathan Baumann @@ -1070,6 +1070,9 @@ ProjectData = R6::R6Class("ProjectData", verify.data.frame.columns(commit.data, COMMITS.LIST.COLUMNS, COMMITS.LIST.DATA.TYPES) } + ## remove commits that have no author or commiter + commit.data = remove.deleted.and.empty.user(commit.data, c("author.name", "committer.name")) + ## store commit data private$commits.unfiltered = commit.data @@ -1465,6 +1468,9 @@ ProjectData = R6::R6Class("ProjectData", verify.data.frame.columns(mail.data, MAILS.LIST.COLUMNS, MAILS.LIST.DATA.TYPES) } + ## remove deleted and empty users + mail.data = remove.deleted.and.empty.user(mail.data) + ## store mail data private$mails.unfiltered = mail.data private$mails = mail.data @@ -1529,6 +1535,9 @@ ProjectData = R6::R6Class("ProjectData", verify.data.frame.columns(data, AUTHORS.LIST.COLUMNS, AUTHORS.LIST.DATA.TYPES) } + ## remove deleted and empty users + data = remove.deleted.and.empty.user(data) + ## add gender data if wanted if (private$project.conf$get.value("gender")) { @@ -1638,6 +1647,9 @@ ProjectData = R6::R6Class("ProjectData", verify.data.frame.columns(data, ISSUES.LIST.COLUMNS, ISSUES.LIST.DATA.TYPES) } + ## remove deleted and empty users + data = remove.deleted.and.empty.user(data) + private$issues.unfiltered = data private$issues = create.empty.issues.list() }, diff --git a/util-read.R b/util-read.R index 13a786ce..4b6712c2 100644 --- a/util-read.R +++ b/util-read.R @@ -19,7 +19,7 @@ ## Copyright 2017-2018 by Thomas Bock ## Copyright 2018 by Jakob Kronawitter ## Copyright 2018-2019 by Anselm Fehnker -## Copyright 2020-2021 by Niklas Schneider +## Copyright 2020-2021, 2023 by Niklas Schneider ## Copyright 2021 by Johannes Hostert ## Copyright 2021 by Mirabdulla Yusifli ## Copyright 2022 by Jonathan Baumann @@ -43,15 +43,23 @@ requireNamespace("sqldf") # for SQL-selections on data.frames requireNamespace("data.table") # for faster data.frame processing ## / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / -## Helper functions --------------------------------------------------------------- +## Helper functions -------------------------------------------------------- #' Remove the "deleted user" or the author with empty name "" from a data frame. #' #' @param data the data from which to remove the "deleted user" and author with empty name -#' +#' @param columns the columns in which to search for the "deleted user" and author with empty name. +#' The default value is \code{c("author.name")}. +#' #' @return the data frame without the rows in which the author name is "deleted user" or "" -remove.deleted.and.empty.user = function(data) { - return(data[tolower(data[, "author.name"]) != "deleted user" & data["author.name"] != "", ]) +remove.deleted.and.empty.user = function(data, columns = c("author.name")) { + ## create a copy of the original data frame + df = data.frame(data) + ## loop over the given columns and remove all rows in which the author name is "deleted user" or "" + for (column in columns) { + df = df[tolower(data[, column]) != "deleted user" & data[column] != "", ] + } + return(df) } ## / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / @@ -171,7 +179,7 @@ read.commits = function(data.path, artifact) { UNTRACKED.FILE.EMPTY.ARTIFACT.TYPE, commit.data[["artifact.type"]]) - commit.data = remove.deleted.and.empty.user(commit.data) # filter deleted user + commit.data = remove.deleted.and.empty.user(commit.data, c("author.name", "committer.name")) # filter deleted user ## convert dates and sort by them commit.data[["date"]] = get.date.from.string(commit.data[["date"]]) From b035c2553b14cdd59bed03c3cabae138d5864894 Mon Sep 17 00:00:00 2001 From: Niklas Schneider Date: Tue, 24 Jan 2023 15:48:17 +0100 Subject: [PATCH 12/56] Update NEWS.md Signed-off-by: Niklas Schneider --- NEWS.md | 1 + 1 file changed, 1 insertion(+) diff --git a/NEWS.md b/NEWS.md index 2e32b110..549ad554 100644 --- a/NEWS.md +++ b/NEWS.md @@ -11,6 +11,7 @@ ### 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 (PR #235, 08fbd3e11e33d060f42cbc6f729eaf60b48a6de7) ### Fixed From 43c3bd1de4b55713281eda2259d242383bfeb783 Mon Sep 17 00:00:00 2001 From: Niklas Schneider Date: Wed, 25 Jan 2023 16:04:57 +0100 Subject: [PATCH 13/56] Add check whether columns exist to previously added function If not all columns exist, print an error message and stop the program. Also change some minor comment and documentation issues as well as update the NEWS.md Signed-off-by: Niklas Schneider --- NEWS.md | 2 +- util-read.R | 10 ++++++++-- 2 files changed, 9 insertions(+), 3 deletions(-) diff --git a/NEWS.md b/NEWS.md index 549ad554..c757a7d1 100644 --- a/NEWS.md +++ b/NEWS.md @@ -11,7 +11,7 @@ ### 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 (PR #235, 08fbd3e11e33d060f42cbc6f729eaf60b48a6de7) +- 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) ### Fixed diff --git a/util-read.R b/util-read.R index 4b6712c2..e5d6c999 100644 --- a/util-read.R +++ b/util-read.R @@ -47,14 +47,20 @@ requireNamespace("data.table") # for faster data.frame processing #' Remove the "deleted user" or the author with empty name "" from a data frame. #' -#' @param data the data from which to remove the "deleted user" and author with empty name +#' @param data the data from which to remove the "deleted user" and author with empty name. #' @param columns the columns in which to search for the "deleted user" and author with empty name. -#' The default value is \code{c("author.name")}. +#' [default: c("author.name")] #' #' @return the data frame without the rows in which the author name is "deleted user" or "" remove.deleted.and.empty.user = function(data, columns = c("author.name")) { + if (!all(columns %in% names(data))) { + logging::logerror("The given columns are not present in the data.frame.") + stop("Stopped due to invalid column names.") + } + ## create a copy of the original data frame df = data.frame(data) + ## loop over the given columns and remove all rows in which the author name is "deleted user" or "" for (column in columns) { df = df[tolower(data[, column]) != "deleted user" & data[column] != "", ] From 6ecb77a37775c72c59b5929bc6e9e8d676fb5b54 Mon Sep 17 00:00:00 2001 From: Niklas Schneider Date: Wed, 25 Jan 2023 16:17:36 +0100 Subject: [PATCH 14/56] Remove copying the data.frame in the empty user removal function Also add empty user entries into the test data of feature and proximity. Refers to #235 Signed-off-by: Niklas Schneider --- .../results/testing/test_feature/feature/commits.list | 2 ++ .../testing/test_proximity/proximity/commits.list | 2 ++ util-read.R | 9 +++------ 3 files changed, 7 insertions(+), 6 deletions(-) diff --git a/tests/codeface-data/results/testing/test_feature/feature/commits.list b/tests/codeface-data/results/testing/test_feature/feature/commits.list index 88f92a73..88bf7de7 100644 --- a/tests/codeface-data/results/testing/test_feature/feature/commits.list +++ b/tests/codeface-data/results/testing/test_feature/feature/commits.list @@ -9,3 +9,5 @@ 32716;"2016-07-12 16:06:30";"Thomas";"thomas@example.org";"2016-07-12 16:06:30";"Thomas";"thomas@example.org";"d01921773fae4bed8186b0aa411d6a2f7a6626e6";1;1;0;1;"";"";"";0 32711;"2016-07-12 16:06:32";"Thomas";"thomas@example.org";"2016-07-12 16:06:32";"Thomas";"thomas@example.org";"0a1a5c523d835459c42f33e863623138555e2526";1;1;0;1;"test2.c";"Base_Feature";"Feature";1 32711;"2016-07-12 16:06:32";"Thomas";"thomas@example.org";"2016-07-12 16:06:32";"Thomas";"thomas@example.org";"0a1a5c523d835459c42f33e863623138555e2526";1;1;0;1;"test2.c";"foo";"Feature";1 +32711;"2016-07-12 16:06:33";"Thomas";"thomas@example.org";"2016-07-12 16:06:33";"";"thomas@example.org";"0a1a5c523d835459c40f33e863623138555e2526";1;1;0;1;"test2.c";"foo";"Feature";1 +32711;"2016-07-12 16:06:34";"Thomas";"thomas@example.org";"2016-07-12 16:06:34";"deleted user";"thomas@example.org";"0a1a5c523d835459c41f33e863623138555e2526";1;1;0;1;"test2.c";"foo";"Feature";1 diff --git a/tests/codeface-data/results/testing/test_proximity/proximity/commits.list b/tests/codeface-data/results/testing/test_proximity/proximity/commits.list index e4094c63..7e60e76c 100644 --- a/tests/codeface-data/results/testing/test_proximity/proximity/commits.list +++ b/tests/codeface-data/results/testing/test_proximity/proximity/commits.list @@ -5,3 +5,5 @@ 32715;"2016-07-12 16:06:32";"Thomas";"thomas@example.org";"2016-07-12 16:06:32";"Thomas";"thomas@example.org";"0a1a5c523d835459c42f33e863623138555e2526";1;1;0;1;"test2.c";"File_Level";"Function";1 32720;"2016-07-12 16:06:20";"Karl";"karl@example.org";"2016-07-12 16:06:20";"Karl";"karl@example.org";"418d1dc4929ad1df251d2aeb833dd45757b04a6f";1;1;0;1;"";"";"";0 32721;"2016-07-12 16:06:30";"Thomas";"thomas@example.org";"2016-07-12 16:06:30";"Thomas";"thomas@example.org";"d01921773fae4bed8186b0aa411d6a2f7a6626e6";1;1;0;1;"";"";"";0 +32711;"2016-07-12 16:06:33";"Thomas";"thomas@example.org";"2016-07-12 16:06:33";"";"thomas@example.org";"0a1a5c523d835459c40f33e863623138555e2526";1;1;0;1;"test2.c";"foo";"Feature";1 +32711;"2016-07-12 16:06:34";"Thomas";"thomas@example.org";"2016-07-12 16:06:34";"deleted user";"thomas@example.org";"0a1a5c523d835459c41f33e863623138555e2526";1;1;0;1;"test2.c";"foo";"Feature";1 diff --git a/util-read.R b/util-read.R index e5d6c999..df94617f 100644 --- a/util-read.R +++ b/util-read.R @@ -53,19 +53,16 @@ requireNamespace("data.table") # for faster data.frame processing #' #' @return the data frame without the rows in which the author name is "deleted user" or "" remove.deleted.and.empty.user = function(data, columns = c("author.name")) { - if (!all(columns %in% names(data))) { + if (!all(columns %in% colnames(data))) { logging::logerror("The given columns are not present in the data.frame.") stop("Stopped due to invalid column names.") } - - ## create a copy of the original data frame - df = data.frame(data) ## loop over the given columns and remove all rows in which the author name is "deleted user" or "" for (column in columns) { - df = df[tolower(data[, column]) != "deleted user" & data[column] != "", ] + data = data[tolower(data[, column]) != "deleted user" & data[column] != "", ] } - return(df) + return(data) } ## / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / From 1d8d8daa7945b806e31ea191a336f4b195915394 Mon Sep 17 00:00:00 2001 From: Niklas Schneider Date: Thu, 26 Jan 2023 14:16:41 +0100 Subject: [PATCH 15/56] Fix invalidated test data The recently added commits now have unique ids and hashes. Refers to PR #235 Signed-off-by: Niklas Schneider --- .../results/testing/test_feature/feature/commits.list | 4 ++-- .../results/testing/test_proximity/proximity/commits.list | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/tests/codeface-data/results/testing/test_feature/feature/commits.list b/tests/codeface-data/results/testing/test_feature/feature/commits.list index 88bf7de7..d1cb4cec 100644 --- a/tests/codeface-data/results/testing/test_feature/feature/commits.list +++ b/tests/codeface-data/results/testing/test_feature/feature/commits.list @@ -9,5 +9,5 @@ 32716;"2016-07-12 16:06:30";"Thomas";"thomas@example.org";"2016-07-12 16:06:30";"Thomas";"thomas@example.org";"d01921773fae4bed8186b0aa411d6a2f7a6626e6";1;1;0;1;"";"";"";0 32711;"2016-07-12 16:06:32";"Thomas";"thomas@example.org";"2016-07-12 16:06:32";"Thomas";"thomas@example.org";"0a1a5c523d835459c42f33e863623138555e2526";1;1;0;1;"test2.c";"Base_Feature";"Feature";1 32711;"2016-07-12 16:06:32";"Thomas";"thomas@example.org";"2016-07-12 16:06:32";"Thomas";"thomas@example.org";"0a1a5c523d835459c42f33e863623138555e2526";1;1;0;1;"test2.c";"foo";"Feature";1 -32711;"2016-07-12 16:06:33";"Thomas";"thomas@example.org";"2016-07-12 16:06:33";"";"thomas@example.org";"0a1a5c523d835459c40f33e863623138555e2526";1;1;0;1;"test2.c";"foo";"Feature";1 -32711;"2016-07-12 16:06:34";"Thomas";"thomas@example.org";"2016-07-12 16:06:34";"deleted user";"thomas@example.org";"0a1a5c523d835459c41f33e863623138555e2526";1;1;0;1;"test2.c";"foo";"Feature";1 +31711;"2016-07-12 16:06:33";"Thomas";"thomas@example.org";"2016-07-12 16:06:33";"";"thomas@example.org";"0a1a5c523d835459c40f33e863623138555e2526";1;1;0;1;"test2.c";"foo";"Feature";1 +30711;"2016-07-12 16:06:34";"Thomas";"thomas@example.org";"2016-07-12 16:06:34";"deleted user";"thomas@example.org";"0a1a5c523d835459c41f33e863623138555e2526";1;1;0;1;"test2.c";"foo";"Feature";1 diff --git a/tests/codeface-data/results/testing/test_proximity/proximity/commits.list b/tests/codeface-data/results/testing/test_proximity/proximity/commits.list index 7e60e76c..e5b28199 100644 --- a/tests/codeface-data/results/testing/test_proximity/proximity/commits.list +++ b/tests/codeface-data/results/testing/test_proximity/proximity/commits.list @@ -5,5 +5,5 @@ 32715;"2016-07-12 16:06:32";"Thomas";"thomas@example.org";"2016-07-12 16:06:32";"Thomas";"thomas@example.org";"0a1a5c523d835459c42f33e863623138555e2526";1;1;0;1;"test2.c";"File_Level";"Function";1 32720;"2016-07-12 16:06:20";"Karl";"karl@example.org";"2016-07-12 16:06:20";"Karl";"karl@example.org";"418d1dc4929ad1df251d2aeb833dd45757b04a6f";1;1;0;1;"";"";"";0 32721;"2016-07-12 16:06:30";"Thomas";"thomas@example.org";"2016-07-12 16:06:30";"Thomas";"thomas@example.org";"d01921773fae4bed8186b0aa411d6a2f7a6626e6";1;1;0;1;"";"";"";0 -32711;"2016-07-12 16:06:33";"Thomas";"thomas@example.org";"2016-07-12 16:06:33";"";"thomas@example.org";"0a1a5c523d835459c40f33e863623138555e2526";1;1;0;1;"test2.c";"foo";"Feature";1 -32711;"2016-07-12 16:06:34";"Thomas";"thomas@example.org";"2016-07-12 16:06:34";"deleted user";"thomas@example.org";"0a1a5c523d835459c41f33e863623138555e2526";1;1;0;1;"test2.c";"foo";"Feature";1 +32811;"2016-07-12 16:06:33";"Thomas";"thomas@example.org";"2016-07-12 16:06:33";"";"thomas@example.org";"0a1a5c523d835459c40f33e863623138555e2526";1;1;0;1;"test2.c";"foo";"Feature";1 +32911;"2016-07-12 16:06:34";"Thomas";"thomas@example.org";"2016-07-12 16:06:34";"deleted user";"thomas@example.org";"0a1a5c523d835459c41f33e863623138555e2526";1;1;0;1;"test2.c";"foo";"Feature";1 From 9a19e8cf2f98c2d51ea5c8af8d66cc48fa614da0 Mon Sep 17 00:00:00 2001 From: Niklas Schneider Date: Thu, 26 Jan 2023 14:22:38 +0100 Subject: [PATCH 16/56] Add clarifying comments when issues are checked for empty users Only events with empty/deleted users in the author.name column are removed, irgnoring any events with deleted/empty user in the event.info.1 column, i.e. those are kept. Referencing PR #235 Signed-off-by: Niklas Schneider --- util-data.R | 3 ++- util-read.R | 4 +++- 2 files changed, 5 insertions(+), 2 deletions(-) diff --git a/util-data.R b/util-data.R index d7105440..644cefb9 100644 --- a/util-data.R +++ b/util-data.R @@ -1647,7 +1647,8 @@ ProjectData = R6::R6Class("ProjectData", verify.data.frame.columns(data, ISSUES.LIST.COLUMNS, ISSUES.LIST.DATA.TYPES) } - ## remove deleted and empty users + ## remove deleted user from the "author.name" column, + ## however, keep events where the user in the "event.info.1" column is empty or deleted data = remove.deleted.and.empty.user(data) private$issues.unfiltered = data diff --git a/util-read.R b/util-read.R index df94617f..0683f770 100644 --- a/util-read.R +++ b/util-read.R @@ -396,7 +396,9 @@ read.issues = function(data.path, issues.sources = c("jira", "github")) { commit.added.events.before.creation = commit.added.events & !is.na(issue.data["creation.date"]) & (issue.data["date"] < issue.data["creation.date"]) issue.data[commit.added.events.before.creation, "date"] = issue.data[commit.added.events.before.creation, "creation.date"] - issue.data = remove.deleted.and.empty.user(issue.data) # filter deleted user + ## filter deleted user from the "author.name" column, + ## however, keep events where the user in the "event.info.1" column is empty or deleted + issue.data = remove.deleted.and.empty.user(issue.data) issue.data = issue.data[order(issue.data[["date"]], decreasing = FALSE), ] # sort! } From 8c69de0235cc0c7ce48060afbb568d01242a851a Mon Sep 17 00:00:00 2001 From: Niklas Schneider Date: Thu, 26 Jan 2023 16:16:57 +0100 Subject: [PATCH 17/56] Make the hashes of the new test commits equal in feature and proximity This addresses PR #235 Signed-off-by: Niklas Schneider --- .../results/testing/test_feature/feature/commits.list | 4 ++-- .../results/testing/test_proximity/proximity/commits.list | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/tests/codeface-data/results/testing/test_feature/feature/commits.list b/tests/codeface-data/results/testing/test_feature/feature/commits.list index d1cb4cec..2f1476d0 100644 --- a/tests/codeface-data/results/testing/test_feature/feature/commits.list +++ b/tests/codeface-data/results/testing/test_feature/feature/commits.list @@ -9,5 +9,5 @@ 32716;"2016-07-12 16:06:30";"Thomas";"thomas@example.org";"2016-07-12 16:06:30";"Thomas";"thomas@example.org";"d01921773fae4bed8186b0aa411d6a2f7a6626e6";1;1;0;1;"";"";"";0 32711;"2016-07-12 16:06:32";"Thomas";"thomas@example.org";"2016-07-12 16:06:32";"Thomas";"thomas@example.org";"0a1a5c523d835459c42f33e863623138555e2526";1;1;0;1;"test2.c";"Base_Feature";"Feature";1 32711;"2016-07-12 16:06:32";"Thomas";"thomas@example.org";"2016-07-12 16:06:32";"Thomas";"thomas@example.org";"0a1a5c523d835459c42f33e863623138555e2526";1;1;0;1;"test2.c";"foo";"Feature";1 -31711;"2016-07-12 16:06:33";"Thomas";"thomas@example.org";"2016-07-12 16:06:33";"";"thomas@example.org";"0a1a5c523d835459c40f33e863623138555e2526";1;1;0;1;"test2.c";"foo";"Feature";1 -30711;"2016-07-12 16:06:34";"Thomas";"thomas@example.org";"2016-07-12 16:06:34";"deleted user";"thomas@example.org";"0a1a5c523d835459c41f33e863623138555e2526";1;1;0;1;"test2.c";"foo";"Feature";1 +31711;"2016-07-12 16:06:33";"Thomas";"thomas@example.org";"2016-07-12 16:06:33";"";"thomas@example.org";"2ef7bde608ce5404e97d5f042f95f89f1c232871";1;1;0;1;"test2.c";"foo";"Feature";1 +30711;"2016-07-12 16:06:34";"Thomas";"thomas@example.org";"2016-07-12 16:06:34";"deleted user";"thomas@example.org";"c6954cb75e3eeec5b827f64e97b6a4ba187c0d55";1;1;0;1;"test2.c";"foo";"Feature";1 diff --git a/tests/codeface-data/results/testing/test_proximity/proximity/commits.list b/tests/codeface-data/results/testing/test_proximity/proximity/commits.list index e5b28199..e4f136f1 100644 --- a/tests/codeface-data/results/testing/test_proximity/proximity/commits.list +++ b/tests/codeface-data/results/testing/test_proximity/proximity/commits.list @@ -5,5 +5,5 @@ 32715;"2016-07-12 16:06:32";"Thomas";"thomas@example.org";"2016-07-12 16:06:32";"Thomas";"thomas@example.org";"0a1a5c523d835459c42f33e863623138555e2526";1;1;0;1;"test2.c";"File_Level";"Function";1 32720;"2016-07-12 16:06:20";"Karl";"karl@example.org";"2016-07-12 16:06:20";"Karl";"karl@example.org";"418d1dc4929ad1df251d2aeb833dd45757b04a6f";1;1;0;1;"";"";"";0 32721;"2016-07-12 16:06:30";"Thomas";"thomas@example.org";"2016-07-12 16:06:30";"Thomas";"thomas@example.org";"d01921773fae4bed8186b0aa411d6a2f7a6626e6";1;1;0;1;"";"";"";0 -32811;"2016-07-12 16:06:33";"Thomas";"thomas@example.org";"2016-07-12 16:06:33";"";"thomas@example.org";"0a1a5c523d835459c40f33e863623138555e2526";1;1;0;1;"test2.c";"foo";"Feature";1 -32911;"2016-07-12 16:06:34";"Thomas";"thomas@example.org";"2016-07-12 16:06:34";"deleted user";"thomas@example.org";"0a1a5c523d835459c41f33e863623138555e2526";1;1;0;1;"test2.c";"foo";"Feature";1 +32811;"2016-07-12 16:06:33";"Thomas";"thomas@example.org";"2016-07-12 16:06:33";"";"thomas@example.org";"2ef7bde608ce5404e97d5f042f95f89f1c232871";1;1;0;1;"test2.c";"foo";"Feature";1 +32911;"2016-07-12 16:06:34";"Thomas";"thomas@example.org";"2016-07-12 16:06:34";"deleted user";"thomas@example.org";"c6954cb75e3eeec5b827f64e97b6a4ba187c0d55";1;1;0;1;"test2.c";"foo";"Feature";1 From fa1fc4af65751402ae6b23298dd4ed821930c6d2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Maximilian=20L=C3=B6ffler?= Date: Tue, 24 Jan 2023 15:33:52 +0100 Subject: [PATCH 18/56] Add GitHub Actions CI support MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Add 'pull_request.yml' to automatically trigger, build, run tests and run showcase file when a pull request is opened or updated against 'dev' branch. Signed-off-by: Maximilian Löffler --- .github/workflows/pull_request.yml | 72 ++++++++++++++++++++++++++++++ 1 file changed, 72 insertions(+) create mode 100644 .github/workflows/pull_request.yml diff --git a/.github/workflows/pull_request.yml b/.github/workflows/pull_request.yml new file mode 100644 index 00000000..640bde73 --- /dev/null +++ b/.github/workflows/pull_request.yml @@ -0,0 +1,72 @@ +## This file is part of coronet, which is free software: you +## can redistribute it and/or modify it under the terms of the GNU General +## Public License as published by the Free Software Foundation, version 2. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License along +## with this program; if not, write to the Free Software Foundation, Inc., +## 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. +## +## Copyright 2023 by Maximilian Löffler +## All Rights Reserved. + +on: + pull_request: + branches: [ dev ] + types: [ opened, reopened, synchronize ] + +permissions: + contents: read + +jobs: + build: + name: Build + + # change to 'runs-on: self-hosted' to run on self-hosted runners (https://docs.github.com/en/actions/using-jobs/choosing-the-runner-for-a-job) + runs-on: ubuntu-latest + + strategy: + fail-fast: false + matrix: + r-version: ['3.6', '4.0', '4.1', '4.2'] + + steps: + - name: Checkout Repo + uses: actions/checkout@v3 + + - name: Update system + run: | + sudo apt-get update -y + sudo apt-get install --assume-yes libxml2 + sudo apt-get install --assume-yes libxml2-dev + sudo apt-get install --assume-yes libglpk-dev + sudo apt-get install --assume-yes libfontconfig1-dev + sudo su -c "echo 'deb https://cloud.r-project.org/bin/linux/ubuntu focal-cran40/' >> /etc/apt/sources.list" + wget -qO- https://cloud.r-project.org/bin/linux/ubuntu/marutter_pubkey.asc | sudo tee -a /etc/apt/trusted.gpg.d/cran_ubuntu_key.asc + + - name: Set up R ${{ matrix.r-version }} + uses: r-lib/actions/setup-r@v2 + with: + r-version: ${{ matrix.r-version }} + + - name: Cache dependencies + id: cache-dependencies + uses: pat-s/always-upload-cache@v3.0.11 + with: + path: packrat + key: ${{ runner.os }}-deps-${{ hashFiles('**/install.R') }} + + - if: ${{ steps.cache-dependencies.outputs.cache-hit != 'true' }} + name: Install dependencies + run: Rscript install.R + + - name: Run Tests + run: Rscript tests.R + + - name: Run Showcase + run: Rscript showcase.R + if: always() From b42ebd46d135166d17841baa7562dc2425126d6e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Maximilian=20L=C3=B6ffler?= Date: Tue, 24 Jan 2023 16:31:39 +0100 Subject: [PATCH 19/56] Fix failing test MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Maximilian Löffler --- tests/test-core-peripheral.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/test-core-peripheral.R b/tests/test-core-peripheral.R index ae499554..07c7389c 100644 --- a/tests/test-core-peripheral.R +++ b/tests/test-core-peripheral.R @@ -79,7 +79,7 @@ test_that("Eigenvector classification", { row.names(result[["core"]]) = NULL row.names(result[["peripheral"]]) = NULL - expect_equal(expected, result, tolerance = 0.0001) + ## expect_equal(expected, result, tolerance = 0.0001) ## TODO: Find a way to directly test for equality without the need of taking care of different orders of author ## names. For the moment, we take the following workaround: From 6d3b08c9443906853a99fddb5bec294b2a53794b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Maximilian=20L=C3=B6ffler?= Date: Wed, 25 Jan 2023 18:22:04 +0100 Subject: [PATCH 20/56] Add 'latest' to R version matrix MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Maximilian Löffler --- .github/workflows/pull_request.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/pull_request.yml b/.github/workflows/pull_request.yml index 640bde73..d00891ab 100644 --- a/.github/workflows/pull_request.yml +++ b/.github/workflows/pull_request.yml @@ -32,7 +32,7 @@ jobs: strategy: fail-fast: false matrix: - r-version: ['3.6', '4.0', '4.1', '4.2'] + r-version: ['3.6', '4.0', '4.1', '4.2', 'latest'] steps: - name: Checkout Repo From eb0740333813d3b042e8ee0f7bbaa2dbd5c91769 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Maximilian=20L=C3=B6ffler?= Date: Thu, 26 Jan 2023 17:23:44 +0100 Subject: [PATCH 21/56] Remove dependency cache and add status badges to 'CONTRIBUTING.md' MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Remove dependency caching action from workflow. Include pullrequesting onto master and pushing to master and dev as triggers for workflow. Include updating badges to 'CONTRIBUTING.md' indicating build status on master and dev branch. Signed-off-by: Maximilian Löffler --- .github/workflows/pull_request.yml | 18 +++++++----------- CONTRIBUTING.md | 4 ++-- 2 files changed, 9 insertions(+), 13 deletions(-) diff --git a/.github/workflows/pull_request.yml b/.github/workflows/pull_request.yml index d00891ab..7ac45b88 100644 --- a/.github/workflows/pull_request.yml +++ b/.github/workflows/pull_request.yml @@ -14,10 +14,14 @@ ## Copyright 2023 by Maximilian Löffler ## All Rights Reserved. +name: Build Status + on: pull_request: - branches: [ dev ] + branches: [ master, dev ] types: [ opened, reopened, synchronize ] + push: + branches: [ master, dev ] permissions: contents: read @@ -45,23 +49,15 @@ jobs: sudo apt-get install --assume-yes libxml2-dev sudo apt-get install --assume-yes libglpk-dev sudo apt-get install --assume-yes libfontconfig1-dev - sudo su -c "echo 'deb https://cloud.r-project.org/bin/linux/ubuntu focal-cran40/' >> /etc/apt/sources.list" + sudo su -c "echo 'deb https://cloud.r-project.org/bin/linux/ubuntu jammy-cran40/' >> /etc/apt/sources.list" wget -qO- https://cloud.r-project.org/bin/linux/ubuntu/marutter_pubkey.asc | sudo tee -a /etc/apt/trusted.gpg.d/cran_ubuntu_key.asc - name: Set up R ${{ matrix.r-version }} uses: r-lib/actions/setup-r@v2 with: r-version: ${{ matrix.r-version }} - - - name: Cache dependencies - id: cache-dependencies - uses: pat-s/always-upload-cache@v3.0.11 - with: - path: packrat - key: ${{ runner.os }}-deps-${{ hashFiles('**/install.R') }} - - if: ${{ steps.cache-dependencies.outputs.cache-hit != 'true' }} - name: Install dependencies + - name: Install dependencies run: Rscript install.R - name: Run Tests diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md index 7119b877..0f118cd5 100644 --- a/CONTRIBUTING.md +++ b/CONTRIBUTING.md @@ -114,8 +114,8 @@ In our development process, we pursue the following idea: - The current development will be performed on the branch `dev`, i.e., all incoming pull requests are against this branch. The current build status is as follows: -- `master`: [![Build Status](https://cloud.drone.io/api/badges/se-sic/coronet/status.svg)](https://cloud.drone.io/se-sic/coronet) -- `dev`: [![Build Status](https://cloud.drone.io/api/badges/se-sic/coronet/status.svg?ref=refs/heads/dev)](https://cloud.drone.io/se-sic/coronet) +- `master`: ![Build Status](https://github.com/se-sic/coronet/actions/workflows/pull_request.yml/badge.svg?branch=master) +- `dev`: ![Build Status](https://github.com/se-sic/coronet/actions/workflows/pull_request.yml/badge.svg?branch=dev) ### Pull Requests From a4dab7fad1ca642f30b0fccc2e2d761aeb665be3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Maximilian=20L=C3=B6ffler?= Date: Tue, 31 Jan 2023 14:06:51 +0100 Subject: [PATCH 22/56] Update 'NEWS.md' to include GitHub Actions CI MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Maximilian Löffler --- NEWS.md | 1 + 1 file changed, 1 insertion(+) diff --git a/NEWS.md b/NEWS.md index c757a7d1..ea2be409 100644 --- a/NEWS.md +++ b/NEWS.md @@ -7,6 +7,7 @@ ### 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). ### Changed/Improved From 0c083c6c8e0072f32e95fcb598110db655606e80 Mon Sep 17 00:00:00 2001 From: Thomas Bock Date: Fri, 27 Jan 2023 15:40:17 +0100 Subject: [PATCH 23/56] Fix column access in `remove.deleted.and.empty.user` The column access `data[column]` is invalid (at least, in specific R versions). Therefore, use a valid way to access the column: `data[, column]` In addition, also remove some trailing white spaces. Signed-off-by: Thomas Bock --- util-read.R | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/util-read.R b/util-read.R index 0683f770..8f1b4fd9 100644 --- a/util-read.R +++ b/util-read.R @@ -17,6 +17,7 @@ ## Copyright 2020-2022 by Christian Hechtl ## Copyright 2017 by Felix Prasse ## Copyright 2017-2018 by Thomas Bock +## Copyright 2023 by Thomas Bock ## Copyright 2018 by Jakob Kronawitter ## Copyright 2018-2019 by Anselm Fehnker ## Copyright 2020-2021, 2023 by Niklas Schneider @@ -50,18 +51,18 @@ requireNamespace("data.table") # for faster data.frame processing #' @param data the data from which to remove the "deleted user" and author with empty name. #' @param columns the columns in which to search for the "deleted user" and author with empty name. #' [default: c("author.name")] -#' +#' #' @return the data frame without the rows in which the author name is "deleted user" or "" remove.deleted.and.empty.user = function(data, columns = c("author.name")) { if (!all(columns %in% colnames(data))) { logging::logerror("The given columns are not present in the data.frame.") - stop("Stopped due to invalid column names.") + stop("Stopped due to invalid column names.") } ## loop over the given columns and remove all rows in which the author name is "deleted user" or "" for (column in columns) { - data = data[tolower(data[, column]) != "deleted user" & data[column] != "", ] - } + data = data[tolower(data[, column]) != "deleted user" & data[, column] != "", ] + } return(data) } @@ -398,7 +399,7 @@ read.issues = function(data.path, issues.sources = c("jira", "github")) { issue.data[commit.added.events.before.creation, "date"] = issue.data[commit.added.events.before.creation, "creation.date"] ## filter deleted user from the "author.name" column, ## however, keep events where the user in the "event.info.1" column is empty or deleted - issue.data = remove.deleted.and.empty.user(issue.data) + issue.data = remove.deleted.and.empty.user(issue.data) issue.data = issue.data[order(issue.data[["date"]], decreasing = FALSE), ] # sort! } From 4275b93867c78d20d0bd116749c1e7603cd9d473 Mon Sep 17 00:00:00 2001 From: Thomas Bock Date: Sun, 2 Apr 2023 21:51:09 +0200 Subject: [PATCH 24/56] Fix class of date attributes author-network test As of igraph version 1.4.0, the classes of edge attributes are respected in igraph. Therefore, dates in the expected outcomes of our tests need to be of class `POSIXct`. As the `I()` operator prevents an automatic conversion, we need to manually convert the dates to the correct class. However, as `I()` adds the `AsIs` class, we need to remove this class from the affected edge attributes again, as otherwise the expected network and the built network would not be equal. To make this test succeed in both, igraph versions < 1.4.0 and igraph versions >= 1.4.0, the expected class is derived from the class of the date attribute in the built network. This way, the test is able to pass independent of the used igraph version. This fix addresses se-sic#236. Signed-off-by: Christian Hechtl Signed-off-by: Thomas Bock --- tests/test-networks-author.R | 20 ++++++++++++++++++-- 1 file changed, 18 insertions(+), 2 deletions(-) diff --git a/tests/test-networks-author.R b/tests/test-networks-author.R index 2a62b127..613c1862 100644 --- a/tests/test-networks-author.R +++ b/tests/test-networks-author.R @@ -13,9 +13,11 @@ ## ## Copyright 2017, 2019 by Claus Hunsen ## Copyright 2017 by Christian Hechtl +## Copyright 2023 by Christian Hechtl ## Copyright 2017 by Felix Prasse ## Copyright 2018 by Barbara Eckl ## Copyright 2018 by Thomas Bock +## Copyright 2023 by Thomas Bock ## Copyright 2018 by Jakob Kronawitter ## Copyright 2018-2019 by Anselm Fehnker ## Copyright 2021 by Johannes Hostert @@ -421,12 +423,19 @@ test_that("Network construction of the undirected simplified author-cochange net kind = TYPE.AUTHOR, type = TYPE.AUTHOR) + ## make test independent of igraph version + date.attr = igraph::get.edge.attribute(network.built, "date") + date.conversion.function = ifelse(all(sapply(date.attr, lubridate::is.POSIXct)), + get.date.from.unix.timestamp, identity) + ## edge attributes data = data.frame( from = c("Björn", "Olaf", "Olaf", "Karl"), to = c("Olaf", "Karl", "Thomas", "Thomas"), - date = I(list(c(1468339139, 1468339245), c(1468339541, 1468339570), c(1468339541, 1468339592), - c(1468339570, 1468339592))), + date = I(list(date.conversion.function(c(1468339139, 1468339245)), + date.conversion.function(c(1468339541, 1468339570)), + date.conversion.function(c(1468339541, 1468339592)), + date.conversion.function(c(1468339570, 1468339592)))), artifact.type = I(list(c("Feature", "Feature"), c("Feature", "Feature"), c("Feature", "Feature"), c("Feature", "Feature"))), hash = I(list( @@ -442,6 +451,13 @@ test_that("Network construction of the undirected simplified author-cochange net relation = "cochange" ) + ## remove the 'AsIs' class from the edge attributes that have been inserted via `I(...)` + data[["date"]] = unclass(data[["date"]]) + data[["artifact.type"]] = unclass(data[["artifact.type"]]) + data[["hash"]] = unclass(data[["hash"]]) + data[["file"]] = unclass(data[["file"]]) + data[["artifact"]] = unclass(data[["artifact"]]) + ## build expected network network.expected = igraph::graph.data.frame(data, directed = FALSE, vertices = authors) From 98a6deb1b178a1fcf799c741906e99770c46a8d0 Mon Sep 17 00:00:00 2001 From: Thomas Bock Date: Sun, 2 Apr 2023 21:58:58 +0200 Subject: [PATCH 25/56] Fix the classes of the default values of vertex and edge attributes As of igraph version 1.4.0, igraph respects the classes of edge and vertex attributes. Therefore, we have to make sure that we add the correct classes when we add new edge or vertex attributes to a (possibly empty) network. To do so, in function `add.attributes.to.network`, we need to set the `default.value` (for which we have already set the correct class before) instead of `NA` (which is interpreted as `logical` if no concrete class is given). In addition, if the attribute is of class `POSIXct`, an additional time zone attribute is necessary. We use the default time zone that is set in `util-init.R` in this case. This fix addresses se-sic#236. Signed-off-by: Thomas Bock --- util-networks.R | 14 +++++++++----- 1 file changed, 9 insertions(+), 5 deletions(-) diff --git a/util-networks.R b/util-networks.R index 5da3b4d5..3237e2da 100644 --- a/util-networks.R +++ b/util-networks.R @@ -15,7 +15,7 @@ ## Copyright 2017 by Raphael Nömmer ## Copyright 2017-2018 by Christian Hechtl ## Copyright 2017-2019 by Thomas Bock -## Copyright 2021 by Thomas Bock +## Copyright 2021, 2023 by Thomas Bock ## Copyright 2018 by Barbara Eckl ## Copyright 2018-2019 by Jakob Kronawitter ## Copyright 2020 by Anselm Fehnker @@ -32,6 +32,7 @@ requireNamespace("logging") # for logging requireNamespace("parallel") # for parallel computation requireNamespace("plyr") # for dlply function requireNamespace("igraph") # networks +requireNamespace("lubridate") # for date conversion ## / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / @@ -1352,7 +1353,7 @@ create.empty.edge.list = function() { #' Add the given list of \code{type} attributes to the given network. #' -#' All added attributes are set to the value \code{NA}. +#' All added attributes are set to the default value of the respective class. #' #' @param network the network to which the attributes are to be added #' @param type the type of attribute to add; either \code{"vertex"} or \code{"edge"} @@ -1379,10 +1380,13 @@ add.attributes.to.network = function(network, type = c("vertex", "edge"), attrib default.value = 0 ## set the right class for the default value class(default.value) = attributes[[attr.name]] + + ## make sure that the default value contains a tzone attribute if the attribute is of class 'POSIXct' + if (lubridate::is.POSIXct(default.value)) { + attr(default.value, "tzone") = TIMEZONE + } ## add the new attribute to the network with the proper class - network = attribute.function(network, attr.name, value = default.value) - ## fill the new attribute with NA values - network = attribute.function(network, attr.name, value = NA) + network = attribute.set.function(network, attr.name, value = default.value) } return(network) From b8232c09b91df3412f703dd26c21c685bacd0321 Mon Sep 17 00:00:00 2001 From: Thomas Bock Date: Sun, 2 Apr 2023 22:07:36 +0200 Subject: [PATCH 26/56] Fix order of edge or vertex attributes When edge or vertex attributes are added via `add.attributes.to.network`, as of igraph version 1.4.0, existing attributes are not re-added or re-ordered. That is, if attributes `name` and `type` already exist and ones adds the new attributes `kind` and `type`, then `kind` is added after `type` as `type` already existed. However, this breaks the ordering of the attributes and leads to failing tests, as the order of the attributes is also tested in some of our tests. To fix this problem, remove and re-add an attribute that was already present before. This way, we make sure that the new attributes are added in the expected order. (The only exception is the `name` attribute: This attribute is expected to be the first attribute, and it should not be removed and readded as this could lead to serious problems.) This addresses se-sic#236. Signed-off-by: Thomas Bock --- util-networks.R | 20 +++++++++++++++++--- 1 file changed, 17 insertions(+), 3 deletions(-) diff --git a/util-networks.R b/util-networks.R index 3237e2da..53278123 100644 --- a/util-networks.R +++ b/util-networks.R @@ -1367,11 +1367,15 @@ add.attributes.to.network = function(network, type = c("vertex", "edge"), attrib ## get type type = match.arg(type, several.ok = FALSE) - ## get corresponding attribute function + ## get corresponding attribute functions if (type == "vertex") { - attribute.function = igraph::set.vertex.attribute # sprintf("igraph::set.%s.attribute", type) + attribute.set.function = igraph::set.vertex.attribute # sprintf("igraph::set.%s.attribute", type) + attribute.get.function = igraph::get.vertex.attribute # sprintf("igraph::get.%s.attribute", type) + attribute.remove.function = igraph::remove.vertex.attribute # sprintf("igraph::remove.%s.attribute", type) } else { - attribute.function = igraph::set.edge.attribute # sprintf("igraph::set.%s.attribute", type) + attribute.set.function = igraph::set.edge.attribute # sprintf("igraph::set.%s.attribute", type) + attribute.get.function = igraph::get.edge.attribute # sprintf("igraph::get.%s.attribute", type) + attribute.remove.function = igraph::remove.edge.attribute # sprintf("igraph::remove.%s.attribute", type) } ## iterate over all wanted attribute names and add the attribute with the wanted class @@ -1385,6 +1389,16 @@ add.attributes.to.network = function(network, type = c("vertex", "edge"), attrib if (lubridate::is.POSIXct(default.value)) { attr(default.value, "tzone") = TIMEZONE } + + ## check if the attribute is already present. If so, remove it and re-add it (to keep the intended order). + ## only exception from this: the name attribute is not removed and re-added, as this would lead to problems. + if (!is.null(attribute.get.function(network, attr.name)) && attr.name != "name") { + logging::logwarn("Attribute %s has already been present, but is re-added now.", attr.name) + present.value = attribute.get.function(network, attr.name) + network = attribute.remove.function(network, attr.name) + default.value = present.value + } + ## add the new attribute to the network with the proper class network = attribute.set.function(network, attr.name, value = default.value) } From a9535550d93207f466b315f33ea263a50e6c8924 Mon Sep 17 00:00:00 2001 From: Thomas Bock Date: Sun, 2 Apr 2023 22:14:16 +0200 Subject: [PATCH 27/56] Fix the class of the date attribute on multi networks (due to a bug in igraph) As of igraph version 1.4.0, igraph respects the classes of edge and vertex attributes. However, the function `igraph::disjoint_union` does not respect their classes and converts `POSIXct` attributes to numeric attributes, for instance. This is a bug in igraph that is expected to be fixed in later igraph versions. For now, we temporarily fix this problem on our own by converting the `date` attribute of the union back to `POSIXct`. Note: Also other attributes could be affected! However, for convenience reasons, we only apply our temporary fix to the `date` attribute. This addresses se-sic#236. Signed-off-by: Thomas Bock --- util-networks.R | 17 +++++++++++++++++ 1 file changed, 17 insertions(+) diff --git a/util-networks.R b/util-networks.R index 53278123..48f931f3 100644 --- a/util-networks.R +++ b/util-networks.R @@ -915,6 +915,23 @@ NetworkBuilder = R6::R6Class("NetworkBuilder", ## combine the networks: ## 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 + ## (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 + ## affect several other attributes, whose classes are not adjusted in our temporary fix. + ## The following code block should be redundant as soon as igraph has fixed their bug. + u.actual.edge.attribute.date = igraph::get.edge.attribute(u, "date") + if (!is.null(u.actual.edge.attribute.date)) { + if (is.list(u.actual.edge.attribute.date)) { + u.expected.edge.attribute.date = lapply(u.actual.edge.attribute.date, get.date.from.unix.timestamp) + } else { + u.expected.edge.attribute.date = get.date.from.unix.timestamp(u.actual.edge.attribute.date) + } + u = igraph::set.edge.attribute(u, "date", value = u.expected.edge.attribute.date) + } + ## 2) add the bipartite edges u = add.edges.for.bipartite.relation(u, authors.to.artifacts, private$network.conf) From 820a7631093d03ac5ccb7bf9923bd498f669120a Mon Sep 17 00:00:00 2001 From: Thomas Bock Date: Sun, 2 Apr 2023 22:22:43 +0200 Subject: [PATCH 28/56] Fix edge attributes of bipartite edges The breaking changes of igraph version 1.4.0 regarding the classes of edge attributes revealed an actual bug in the edge attributes of bipartite edges in coronet: We need to make sure that we only add the edge attributes for the edges that are really added to the network. As, for example, edges to the untracked artifact are not added to our bipartite network, we also need to make sure to remove the attributes of the corresponding edges (otherwise this could lead to wrong attributes). Therefore, we add a (rather complex) check for which edges (i.e., vertex sequences) are present in the final bipartite network and extract the corresponding information for the edge attributes accordingly. This addresses se-sic#236. Signed-off-by: Thomas Bock --- util-networks.R | 27 ++++++++++++++++++++++++++- 1 file changed, 26 insertions(+), 1 deletion(-) diff --git a/util-networks.R b/util-networks.R index 48f931f3..59b30dce 100644 --- a/util-networks.R +++ b/util-networks.R @@ -1300,7 +1300,7 @@ add.edges.for.bipartite.relation = function(net, bipartite.relations, network.co igraph::V(net)[d, vert] # get two vertices from source network: c(author, artifact) }) return(new.edges) - }, names(net1.to.net2), net1.to.net2) + }, names(net1.to.net2), net1.to.net2, SIMPLIFY = FALSE) ## initialize edge attributes allowed.edge.attributes = network.conf$get.value("edge.attributes") @@ -1311,6 +1311,31 @@ add.edges.for.bipartite.relation = function(net, bipartite.relations, network.co extra.edge.attributes.df = parallel::mclapply(net1.to.net2, function(a.df) { cols.which = allowed.edge.attributes %in% colnames(a.df) return(a.df[, allowed.edge.attributes[cols.which], drop = FALSE]) + extra.edge.attributes.df = parallel::mcmapply(vertex.sequence = vertex.sequence.for.edges, a.df = net1.to.net2, + SIMPLIFY = FALSE, function(vertex.sequence, a.df) { + + ## return empty data.frame if vertex sequence is empty + if (length(unlist(vertex.sequence)) == 0){ + return(data.frame()) + } + + ## get the artifacts from the vertex sequence (which are the even elements of the sequence vector) + vertex.names.in.sequence = names(unlist(vertex.sequence)) + artifacts.in.sequence = vertex.names.in.sequence[seq(2, length(vertex.names.in.sequence), 2)] + + ## get the edges that will be constructed from the artifacts, + ## to get only the edge attributes for edges that will be present in the final network + ## (i.e., ignore edges to removed artifacts, such as the empty artifact that has been removed above) + constructed.edges = a.df[a.df[["data.vertices"]] %in% artifacts.in.sequence, , drop = FALSE] + + ## return empty data.frame if there will be no edges in the end + if (nrow(constructed.edges) < 1) { + return(data.frame()) + } + + ## select the allowed attributes from the edge data.frame's columns + cols.which = allowed.edge.attributes %in% colnames(constructed.edges) + return(constructed.edges[ , allowed.edge.attributes[cols.which], drop = FALSE]) }) extra.edge.attributes.df = plyr::rbind.fill(extra.edge.attributes.df) extra.edge.attributes = as.list(extra.edge.attributes.df) From 16d74e983509fb4284a125ae7d955dfda416e3d4 Mon Sep 17 00:00:00 2001 From: Thomas Bock Date: Sun, 2 Apr 2023 22:24:23 +0200 Subject: [PATCH 29/56] Fix style inconsistencies Add missing spaces and break lines that are longer than 120 characters. Signed-off-by: Thomas Bock --- util-data.R | 3 ++- util-networks.R | 19 ++++++++++--------- 2 files changed, 12 insertions(+), 10 deletions(-) diff --git a/util-data.R b/util-data.R index 644cefb9..df0cb067 100644 --- a/util-data.R +++ b/util-data.R @@ -13,7 +13,7 @@ ## ## Copyright 2016-2019 by Claus Hunsen ## Copyright 2017-2019 by Thomas Bock -## Copyright 2020-2021 by Thomas Bock +## Copyright 2020-2021, 2023 by Thomas Bock ## Copyright 2017 by Raphael Nömmer ## Copyright 2017-2018 by Christian Hechtl ## Copyright 2020 by Christian Hechtl @@ -35,6 +35,7 @@ requireNamespace("R6") # for R6 classes requireNamespace("logging") # for logging requireNamespace("parallel") # for parallel computation +requireNamespace("lubridate") # for date conversion ## / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / diff --git a/util-networks.R b/util-networks.R index 59b30dce..3953acf6 100644 --- a/util-networks.R +++ b/util-networks.R @@ -901,11 +901,14 @@ NetworkBuilder = R6::R6Class("NetworkBuilder", ## check directedness and adapt artifact network if needed if (igraph::is.directed(authors.net) && !igraph::is.directed(artifacts.net)) { - logging::logwarn("Author network is directed, but artifact network is not. Converting artifact network...") + logging::logwarn(paste0("Author network is directed, but artifact network is not.", + "Converting artifact network...")) artifacts.net = igraph::as.directed(artifacts.net, mode = "mutual") } else if (!igraph::is.directed(authors.net) && igraph::is.directed(artifacts.net)) { - logging::logwarn("Author network is undirected, but artifact network is not. Converting artifact network...") - artifacts.net = igraph::as.undirected(artifacts.net, mode = "each", edge.attr.comb = EDGE.ATTR.HANDLING) + logging::logwarn(paste0("Author network is undirected, but artifact network is not.", + "Converting artifact network...")) + artifacts.net = igraph::as.undirected(artifacts.net, mode = "each", + edge.attr.comb = EDGE.ATTR.HANDLING) } ## reduce memory consumption by removing temporary data @@ -1017,7 +1020,7 @@ construct.edge.list.from.key.value.list = function(list, network.conf, directed ## get edge attributes cols.which = network.conf$get.value("edge.attributes") %in% colnames(item) - item.edge.attrs = item[, network.conf$get.value("edge.attributes")[cols.which], drop = FALSE] + 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()) @@ -1087,7 +1090,7 @@ construct.edge.list.from.key.value.list = function(list, network.conf, directed ## get edge attibutes edge.attrs = set[set[["data.vertices"]] %in% comb.item, ] # get data for current combination item cols.which = network.conf$get.value("edge.attributes") %in% colnames(edge.attrs) - edge.attrs = edge.attrs[, network.conf$get.value("edge.attributes")[cols.which], drop = FALSE] + edge.attrs = edge.attrs[ , network.conf$get.value("edge.attributes")[cols.which], drop = FALSE] # add edge attributes to edge list edgelist = cbind(edge, edge.attrs) @@ -1304,13 +1307,11 @@ add.edges.for.bipartite.relation = function(net, bipartite.relations, network.co ## initialize edge attributes allowed.edge.attributes = network.conf$get.value("edge.attributes") - available.edge.attributes = available.edge.attributes[names(available.edge.attributes) %in% allowed.edge.attributes] + available.edge.attributes = available.edge.attributes[names(available.edge.attributes) + %in% allowed.edge.attributes] net = add.attributes.to.network(net, "edge", allowed.edge.attributes) ## get extra edge attributes - extra.edge.attributes.df = parallel::mclapply(net1.to.net2, function(a.df) { - cols.which = allowed.edge.attributes %in% colnames(a.df) - return(a.df[, allowed.edge.attributes[cols.which], drop = FALSE]) extra.edge.attributes.df = parallel::mcmapply(vertex.sequence = vertex.sequence.for.edges, a.df = net1.to.net2, SIMPLIFY = FALSE, function(vertex.sequence, a.df) { From 33c9ee4e2976ca90e5049cfcd108fae6ee067b39 Mon Sep 17 00:00:00 2001 From: Thomas Bock Date: Sun, 2 Apr 2023 22:38:13 +0200 Subject: [PATCH 30/56] Update changelog Signed-off-by: Thomas Bock --- NEWS.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/NEWS.md b/NEWS.md index ea2be409..f292b2da 100644 --- a/NEWS.md +++ b/NEWS.md @@ -17,6 +17,8 @@ ### 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 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) + ## 4.2 From ed433821c04711a96501887b315d1b0ea8681f5a Mon Sep 17 00:00:00 2001 From: Thomas Bock Date: Sat, 18 Mar 2023 23:23:30 +0100 Subject: [PATCH 31/56] Replace deprecated call `default.stringsAsFactors()` As of R version 4.2.0, the function call `default.stringsAsFactors()` is deprecated. In the near future (probably with R version 4.3.0), this call will become defunct. Therefore, we replace the single call to this function in coronet by `FALSE`, which is also the current default value of the global option `stringsAsFactors`. Signed-off-by: Thomas Bock --- util-networks.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/util-networks.R b/util-networks.R index 3953acf6..48279276 100644 --- a/util-networks.R +++ b/util-networks.R @@ -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 } From ddff2b8bbca6405f5c7c1cf4e7e97374fb1426ca Mon Sep 17 00:00:00 2001 From: Thomas Bock Date: Sat, 18 Mar 2023 23:35:12 +0100 Subject: [PATCH 32/56] Prevent R warnings in if conditions when updating configuration values Currently, we get a couple of warnings when updating configuration values that consist of more than one values, for example in the following case: The default value of the configuration option of "issues.from.source" is the following vector: `c("github", "jira")`. Then, the following statements leads to a couple of warnings: `project.configuration$update.value("issues.from.source", "github")` Warnings: 'length(x) = 2 > 1' in coercion to 'logical(1)' These warnings are caused by the default value of "issues.from.source" in several if conditions, as `if (is.na(private[["attributes"]][[name]][["default"]]))` returns more than one boolean, actually two: one for "github" and one for "jira". But this is not expected here, as the `is.na` check here should just find out whether the overall default value is `NA` and not for all elements of a vector whether they are `NA`. To fix this, we need to make sure that the `is.na` check is only performed when the length of the variable to check is exactly 1. As this check is needed multiple times, and since we also need its negated version, I have added an additional helper function `is.single.na`, that checks whether an element is of length 1, and if so, returns the result of `is.na`, otherwise returns `FALSE`. This makes sure that we always have a single boolean value in this condition, no matter whether the input is a vector of multiple elements or not. This prevents the warning being printed. As the the warning will be turned into an error in future R versions, this fix also prevents errors that could be caused by this problem. Signed-off-by: Thomas Bock --- util-conf.R | 18 ++++++++++-------- util-misc.R | 13 ++++++++++++- 2 files changed, 22 insertions(+), 9 deletions(-) diff --git a/util-conf.R b/util-conf.R index a34e24e8..816b6c91 100644 --- a/util-conf.R +++ b/util-conf.R @@ -18,7 +18,7 @@ ## Copyright 2020-2021 by Christian Hechtl ## Copyright 2017 by Felix Prasse ## Copyright 2017-2019 by Thomas Bock -## Copyright 2021 by Thomas Bock +## Copyright 2021, 2023 by Thomas Bock ## Copyright 2018 by Barbara Eckl ## Copyright 2018-2019 by Jakob Kronawitter ## Copyright 2019 by Anselm Fehnker @@ -264,22 +264,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-misc.R b/util-misc.R index 9cba90d7..152f13ca 100644 --- a/util-misc.R +++ b/util-misc.R @@ -16,7 +16,7 @@ ## Copyright 2017 by Christian Hechtl ## Copyright 2017 by Felix Prasse ## Copyright 2017-2018 by Thomas Bock -## Copyright 2020-2021 by Thomas Bock +## Copyright 2020-2021, 2023 by Thomas Bock ## Copyright 2018-2019 by Jakob Kronawitter ## Copyright 2021 by Niklas Schneider ## Copyright 2022 by Jonathan Baumann @@ -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 -------------------------------------------------------------- From ccfc2d12a68dfa412f05159e8e3b03118694e748 Mon Sep 17 00:00:00 2001 From: Thomas Bock Date: Fri, 24 Mar 2023 21:11:03 +0100 Subject: [PATCH 33/56] Add test for the new helper function `is.single.na` Signed-off-by: Thomas Bock --- tests/test-misc.R | 29 +++++++++++++++++++++++++++++ 1 file changed, 29 insertions(+) diff --git a/tests/test-misc.R b/tests/test-misc.R index af59e469..562540b5 100644 --- a/tests/test-misc.R +++ b/tests/test-misc.R @@ -14,6 +14,7 @@ ## Copyright 2017 by Felix Prasse ## Copyright 2017-2018 by Claus Hunsen ## Copyright 2017-2018 by Thomas Bock +## Copyright 2023 by Thomas Bock ## Copyright 2022-2023 by Maximilian Löffler ## 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 ----------------------------------------------------------- From c3c50a58eaaf191f2a10cba845d631661a434c49 Mon Sep 17 00:00:00 2001 From: Thomas Bock Date: Wed, 12 Apr 2023 21:24:04 +0200 Subject: [PATCH 34/56] Adjust comment regarding bug in `igraph::disjoint_union` The bug in igraph, which we describe in a comment, affects not only igraph versions 1.4.0 and 1.4.1, but also affects igraph version 1.4.2, as the bug was reported after the release of version 1.4.2. Therefore, adjust our comment accordingly. This is a follow-up commit for commit a9535550d93207f466b315f33ea263a50e6c8924. Signed-off-by: Thomas Bock --- util-networks.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/util-networks.R b/util-networks.R index 48279276..9657a9c4 100644 --- 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 From c24aee7d8f0b6ff4b641c8922e6ee1dce6f5999c Mon Sep 17 00:00:00 2001 From: Thomas Bock Date: Wed, 12 Apr 2023 23:20:43 +0200 Subject: [PATCH 35/56] Prevent R warnings during patchstack-mail filtering Due to using the wrong indexing operator for a data.frame column, the warning `In xtfrm.data.frame(x) : cannot xtfrm data frames` was printed during the filtering of patchstack mails. This is fixed by using the `[[` operator instead of the `[` operator to access the column. Signed-off-by: Thomas Bock --- util-data.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/util-data.R b/util-data.R index df0cb067..8e08b7a7 100644 --- 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 From 23d03616f992ca63abde34032e21b5a9cfd618c8 Mon Sep 17 00:00:00 2001 From: Thomas Bock Date: Wed, 12 Apr 2023 21:45:49 +0200 Subject: [PATCH 36/56] Update changelog Signed-off-by: Thomas Bock --- NEWS.md | 14 +++++++++----- 1 file changed, 9 insertions(+), 5 deletions(-) diff --git a/NEWS.md b/NEWS.md index f292b2da..93076cc2 100644 --- a/NEWS.md +++ b/NEWS.md @@ -6,18 +6,22 @@ ### 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) ### 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 From ac52407e225802cce867e33ebc946eb4687e21f1 Mon Sep 17 00:00:00 2001 From: Thomas Bock Date: Thu, 13 Apr 2023 03:18:46 +0200 Subject: [PATCH 37/56] Fix documentation of the return value of `metrics.hub.degree` There can be multiple vertices with maximum degree. This is clarified now in the documentation of the return value of `metrics.hub.degree`. In addition, also document that `NA` is returned if the network is empty (instead of a data.frame). Signed-off-by: Thomas Bock --- util-networks-metrics.R | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/util-networks-metrics.R b/util-networks-metrics.R index 092ee15c..1059f48d 100644 --- 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 -## Copyright 2021 by Thomas Bock +## Copyright 2021, 2023 by Thomas Bock ## Copyright 2017 by Raphael Nömmer ## Copyright 2017-2019 by Claus Hunsen ## Copyright 2017-2018 by Christian Hechtl @@ -36,7 +36,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) { From a6e001aa3681d363c3572a9b9a41d4d070fb0269 Mon Sep 17 00:00:00 2001 From: Thomas Bock Date: Thu, 13 Apr 2023 03:23:09 +0200 Subject: [PATCH 38/56] Fix style inconsistencies in function documentation Break comment lines that are longer than 120 characters and adjust the indentation of parameter descriptions. Signed-off-by: Thomas Bock --- util-networks-metrics.R | 15 +++++++++------ 1 file changed, 9 insertions(+), 6 deletions(-) diff --git a/util-networks-metrics.R b/util-networks-metrics.R index 1059f48d..faa7c4f6 100644 --- a/util-networks-metrics.R +++ b/util-networks-metrics.R @@ -26,6 +26,7 @@ ## Libraries --------------------------------------------------------------- requireNamespace("igraph") +requireNamespace("logging") ## / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / @@ -103,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) { @@ -131,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) { @@ -212,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) { @@ -257,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. @@ -306,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 From 9f36c544637ab4f4173408152d223b9b5098ce5a Mon Sep 17 00:00:00 2001 From: Thomas Bock Date: Thu, 13 Apr 2023 13:44:26 +0200 Subject: [PATCH 39/56] Check for empty values when updating configuration attributes If a provided value for a configuration attribute is of length < 1, throw an error. In addition, adjust wrong error messages: Error messages are used generically, independent of the concrete instance of the Conf class. Signed-off-by: Thomas Bock --- util-conf.R | 23 ++++++++++++++++++----- 1 file changed, 18 insertions(+), 5 deletions(-) diff --git a/util-conf.R b/util-conf.R index 816b6c91..f05c2b92 100644 --- a/util-conf.R +++ b/util-conf.R @@ -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" ) From 64cb09225062910a1fd5abe6504319206f82ee1b Mon Sep 17 00:00:00 2001 From: Thomas Bock Date: Thu, 13 Apr 2023 13:47:38 +0200 Subject: [PATCH 40/56] Update changelog Signed-off-by: Thomas Bock --- NEWS.md | 1 + 1 file changed, 1 insertion(+) diff --git a/NEWS.md b/NEWS.md index 93076cc2..a4a017da 100644 --- a/NEWS.md +++ b/NEWS.md @@ -14,6 +14,7 @@ - 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 From e2c9d6c39fb757c566ef4c4b18780cca247477cb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Maximilian=20L=C3=B6ffler?= Date: Thu, 23 Mar 2023 12:11:52 +0100 Subject: [PATCH 41/56] Remove 'artifact' attribute from edges of artifact networks MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit In artifact networks, artifacts should not be able to create edges, but authors should. Remove 'artifact' attribute from edges of artifact networks and append 'author.name' instead. This solves the issue of duplicate edges between two artifacts that are only differentiable by the 'artifact' attribute. This fixes #232. Signed-off-by: Maximilian Löffler --- util-networks.R | 29 ++++++++++++++++++++++------- 1 file changed, 22 insertions(+), 7 deletions(-) diff --git a/util-networks.R b/util-networks.R index 9657a9c4..c0269b33 100644 --- a/util-networks.R +++ b/util-networks.R @@ -316,7 +316,9 @@ NetworkBuilder = R6::R6Class("NetworkBuilder", artifacts.net.data = construct.edge.list.from.key.value.list( artifacts.net.data.raw, network.conf = private$network.conf, - directed = FALSE + directed = FALSE, + respect.temporal.order = TRUE, + artifact.edges = TRUE ) ## construct network from obtained data @@ -970,11 +972,14 @@ NetworkBuilder = R6::R6Class("NetworkBuilder", #' i.e., whether to only add edges from the later event to the previous one. #' If \code{NA} is passed, the default value is taken. #' [default: directed] +#' @param artifact.edges whether the key value data represents edges in an artifact network based +#' on the cochange relation +#' [default: \code{FALSE}] #' #' @return a list of two data.frames named 'vertices' and 'edges' (compatible with return value #' of \code{igraph::as.data.frame}) construct.edge.list.from.key.value.list = function(list, network.conf, directed = FALSE, - respect.temporal.order = directed) { + respect.temporal.order = directed, artifact.edges = FALSE) { logging::loginfo("Create edges.") logging::logdebug("construct.edge.list.from.key.value.list: starting.") @@ -991,7 +996,7 @@ construct.edge.list.from.key.value.list = function(list, network.conf, directed keys = names(list) keys.number = length(list) - if (respect.temporal.order) { + if (respect.temporal.order || artifact.edges) { ## for all subsets (sets), connect all items in there with the previous ones edge.list.data = parallel::mclapply(list, function(set) { @@ -1018,9 +1023,21 @@ construct.edge.list.from.key.value.list = function(list, network.conf, directed ## get vertex data item.vertex = item[["data.vertices"]] + ## if edges in an artifact network contain the \code{artifact} attribute + ## replace it with the \code{author.name} attribute as artifacts cannot cause + ## edges in artifact networks, authors can + edge.attributes = network.conf$get.value("edge.attributes") + if (artifact.edges) { + artifact.index = match("artifact", edge.attributes, nomatch = NA) + if (!is.na(artifact.index)) { + edge.attributes = edge.attributes[-artifact.index] + edge.attributes = c(edge.attributes, c("author.name")) + } + } + ## get edge attributes - cols.which = network.conf$get.value("edge.attributes") %in% colnames(item) - item.edge.attrs = item[ , network.conf$get.value("edge.attributes")[cols.which], drop = FALSE] + cols.which = edge.attributes %in% colnames(item) + item.edge.attrs = item[ , edge.attributes[cols.which], drop = FALSE] ## construct edges combinations = expand.grid(item.vertex, vertices.processed.set, stringsAsFactors = FALSE) @@ -1367,9 +1384,7 @@ create.empty.network = function(directed = TRUE, add.attributes = FALSE) { date = c("POSIXct", "POSIXt"), artifact.type = "character", weight = "numeric", type = "character", relation = "character" ) - mandatory.edge.attributes = names(mandatory.edge.attributes.classes) mandatory.vertex.attributes.classes = list(name = "character", kind = "character", type = "character") - mandatory.vertex.attributes = names(mandatory.vertex.attributes.classes) net = add.attributes.to.network(net, "vertex", mandatory.vertex.attributes.classes) net = add.attributes.to.network(net, "edge", mandatory.edge.attributes.classes) From 47596e263152a2e3b73c7393f4ad8e2fd57a6c90 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Maximilian=20L=C3=B6ffler?= Date: Thu, 23 Mar 2023 12:23:27 +0100 Subject: [PATCH 42/56] Update tests to comply to changes to artifact networks MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Remove redundant 'artifact' attribute from edges of artifact networks then remove duplicate edges and add 'author.name' attribute. This works towards #232. Signed-off-by: Maximilian Löffler --- tests/test-networks-artifact.R | 14 ++++++------ tests/test-networks-multi-relation.R | 27 ++++++++++++----------- tests/test-networks-multi.R | 32 ++++++++++++++-------------- 3 files changed, 37 insertions(+), 36 deletions(-) diff --git a/tests/test-networks-artifact.R b/tests/test-networks-artifact.R index ed9409e8..5e478aac 100644 --- a/tests/test-networks-artifact.R +++ b/tests/test-networks-artifact.R @@ -42,13 +42,13 @@ test_that("Network construction of the undirected artifact-cochange network", { type = TYPE.ARTIFACT) ## 2) edges edges = data.frame( - from = c("Base_Feature", "Base_Feature"), - to = c("foo", "foo"), - date = get.date.from.string(c("2016-07-12 16:06:32", "2016-07-12 16:06:32")), - artifact.type = c("Feature", "Feature"), - hash = c("0a1a5c523d835459c42f33e863623138555e2526", "0a1a5c523d835459c42f33e863623138555e2526"), - file = c("test2.c", "test2.c"), - artifact = c("Base_Feature", "foo"), + from = "Base_Feature", + to = "foo", + date = get.date.from.string("2016-07-12 16:06:32"), + artifact.type = "Feature", + hash = "0a1a5c523d835459c42f33e863623138555e2526", + file = "test2.c", + author.name = "Thomas", weight = 1, type = TYPE.EDGES.INTRA, relation = "cochange" diff --git a/tests/test-networks-multi-relation.R b/tests/test-networks-multi-relation.R index b264ec70..ba046670 100644 --- a/tests/test-networks-multi-relation.R +++ b/tests/test-networks-multi-relation.R @@ -235,13 +235,13 @@ test_that("Construction of the multi network for the feature artifact with autho ## 2) construct expected edge attributes (data sorted by 'author.name') edges = data.frame(from = c("Björn", "Björn", "Olaf", "Olaf", "Olaf", "Olaf", "Karl", "Karl", # author cochange "Björn", "Björn", "Olaf", "Olaf", # author mail - "Base_Feature", "Base_Feature", # artifact cochange + "Base_Feature", # artifact cochange "Björn", "Olaf", "Olaf", "Karl", "Thomas", "Thomas", # bipartite cochange "Björn", "Björn", "Björn", "Björn", "Björn", "Björn", "Björn", "Björn", "Björn", "Björn", "Björn", # bipartite issue "Olaf", "Olaf", "Olaf", "Olaf", "Olaf", "Olaf", "Karl", "Thomas", "Thomas", "Thomas"), to = c("Olaf", "Olaf", "Karl", "Karl", "Thomas", "Thomas", "Thomas", "Thomas", # author cochange "Olaf", "Olaf", "Thomas", "Thomas", # author mail - "foo", "foo", # artifact cochange + "foo", # artifact cochange "A", "A", "Base_Feature", "Base_Feature", "Base_Feature", "foo", # bipartite cochange "", "", "", "", # bipartite issue "", "", "", "", "", "", @@ -252,7 +252,7 @@ test_that("Construction of the multi network for the feature artifact with autho "2016-07-12 16:06:10", "2016-07-12 16:06:32", "2016-07-12 15:58:40", "2016-07-12 15:58:50", "2016-07-12 16:04:40", "2016-07-12 16:05:37", - "2016-07-12 16:06:32", "2016-07-12 16:06:32", # artifact cochange + "2016-07-12 16:06:32", # artifact cochange "2016-07-12 15:58:59", "2016-07-12 16:00:45", "2016-07-12 16:05:41", # bipartite cochange "2016-07-12 16:06:10", "2016-07-12 16:06:32", "2016-07-12 16:06:32", "2013-05-05 21:46:30", "2013-05-05 21:49:21", "2013-05-05 21:49:34", # bipartite issue @@ -262,48 +262,49 @@ test_that("Construction of the multi network for the feature artifact with autho "2013-06-01 06:50:26", "2016-07-12 16:01:01", "2016-07-12 16:02:02", "2016-07-12 15:59:59", "2013-04-21 23:52:09", "2016-07-12 15:59:25", "2016-07-12 16:03:59")), - artifact.type = c(rep("Feature", 8), rep("Mail", 4), rep("Feature", 2), rep("Feature", 6), + artifact.type = c(rep("Feature", 8), rep("Mail", 4), rep("Feature", 1), rep("Feature", 6), rep("IssueEvent", 21)), hash = c("72c8dd25d3dd6d18f46e2b26a5f5b1e2e8dc28d0", "5a5ec9675e98187e1e92561e1888aa6f04faa338", # author cochange "3a0ed78458b3976243db6829f63eba3eead26774", "1143db502761379c2bfcecc2007fc34282e7ee61", "3a0ed78458b3976243db6829f63eba3eead26774", "0a1a5c523d835459c42f33e863623138555e2526", "1143db502761379c2bfcecc2007fc34282e7ee61", "0a1a5c523d835459c42f33e863623138555e2526", NA, NA, NA, NA, # author mail - "0a1a5c523d835459c42f33e863623138555e2526", "0a1a5c523d835459c42f33e863623138555e2526", # artifact cochange + "0a1a5c523d835459c42f33e863623138555e2526", # artifact cochange "72c8dd25d3dd6d18f46e2b26a5f5b1e2e8dc28d0", "5a5ec9675e98187e1e92561e1888aa6f04faa338", # bipartite cochange "3a0ed78458b3976243db6829f63eba3eead26774", "1143db502761379c2bfcecc2007fc34282e7ee61", "0a1a5c523d835459c42f33e863623138555e2526", "0a1a5c523d835459c42f33e863623138555e2526", rep(NA, 21)), # bipartite issue file = c("test.c", "test.c", "test2.c", "test3.c", "test2.c", "test2.c", "test3.c", "test2.c", # author cochange NA, NA, NA, NA, - "test2.c", "test2.c", # artifact cochange + "test2.c", # artifact cochange "test.c", "test.c", "test2.c", "test3.c", "test2.c", "test2.c", # bipartite cochange rep(NA, 21)), artifact = c("A", "A", "Base_Feature", "Base_Feature", "Base_Feature", "Base_Feature", "Base_Feature", # author cochange "Base_Feature", rep(NA, 4), - "Base_Feature", "foo", # bipartite cochange + NA, # bipartite cochange "A", "A", "Base_Feature", "Base_Feature", "Base_Feature", "foo", # bipartite cochange rep(NA, 21)), weight = 1, - type = c(rep(TYPE.EDGES.INTRA, 14), rep(TYPE.EDGES.INTER, 27)), - relation = c(rep("cochange", 8), rep("mail", 4), rep("cochange", 2), rep("cochange", 6), + type = c(rep(TYPE.EDGES.INTRA, 13), rep(TYPE.EDGES.INTER, 27)), + relation = c(rep("cochange", 8), rep("mail", 4), rep("cochange", 1), rep("cochange", 6), rep("issue", 21)), message.id = c(rep(NA, 8), "<4cbaa9ef0802201124v37f1eec8g89a412dfbfc8383a@mail.gmail.com>", "<6784529b0802032245r5164f984l342f0f0dc94aa420@mail.gmail.com>", "<65a1sf31sagd684dfv31@mail.gmail.com>", "<9b06e8d20801220234h659c18a3g95c12ac38248c7e0@mail.gmail.com>", - rep(NA, 29)), + rep(NA, 28)), thread = c(rep(NA, 8), "", "", "", "", - rep(NA, 29)), - issue.id = c(rep(NA, 20), + rep(NA, 28)), + author.name = c(rep(NA, 12), "Thomas", rep(NA, 27)), + issue.id = c(rep(NA, 19), "", "", "", "", # bipartite issue "", "", "", "", "", "", "", "", "", "", "", "", "", "", "", "", ""), - event.name = c(rep(NA, 20), rep("commented", 21)) + event.name = c(rep(NA, 19), rep("commented", 21)) ) ## 3) build expected network diff --git a/tests/test-networks-multi.R b/tests/test-networks-multi.R index 9ce03817..bbe711a1 100644 --- a/tests/test-networks-multi.R +++ b/tests/test-networks-multi.R @@ -58,36 +58,36 @@ test_that("Construction of the multi network for the feature artifact with autho "Base_Feature", "foo", "A") edges = data.frame( - from = c("Björn", "Björn", "Olaf", "Olaf", "Olaf", "Olaf", "Karl", "Karl", - "Base_Feature", "Base_Feature", "Björn", "Olaf", "Olaf", "Karl", "Thomas", + from = c("Björn", "Björn", "Olaf", "Olaf", "Olaf", "Olaf", "Karl", "Karl", + "Base_Feature", "Björn", "Olaf", "Olaf", "Karl", "Thomas", "Thomas"), - to = c("Olaf", "Olaf", "Karl", "Karl", "Thomas", "Thomas", "Thomas", "Thomas", "foo", + to = c("Olaf", "Olaf", "Karl", "Karl", "Thomas", "Thomas", "Thomas", "Thomas", "foo", "A", "A", "Base_Feature", "Base_Feature", "Base_Feature", "foo"), date = get.date.from.string(c("2016-07-12 15:58:59", "2016-07-12 16:00:45", "2016-07-12 16:05:41", "2016-07-12 16:06:10", "2016-07-12 16:05:41", "2016-07-12 16:06:32", - "2016-07-12 16:06:10", "2016-07-12 16:06:32", "2016-07-12 16:06:32", - "2016-07-12 16:06:32", "2016-07-12 15:58:59", "2016-07-12 16:00:45", - "2016-07-12 16:05:41", "2016-07-12 16:06:10", "2016-07-12 16:06:32", - "2016-07-12 16:06:32")), + "2016-07-12 16:06:10", "2016-07-12 16:06:32", "2016-07-12 16:06:32", + "2016-07-12 15:58:59", "2016-07-12 16:00:45", "2016-07-12 16:05:41", + "2016-07-12 16:06:10", "2016-07-12 16:06:32", "2016-07-12 16:06:32")), artifact.type = c("Feature", "Feature", "Feature", "Feature", "Feature", "Feature", "Feature", "Feature", "Feature", "Feature", "Feature", "Feature", "Feature", "Feature", - "Feature", "Feature"), + "Feature"), hash = c("72c8dd25d3dd6d18f46e2b26a5f5b1e2e8dc28d0", "5a5ec9675e98187e1e92561e1888aa6f04faa338", "3a0ed78458b3976243db6829f63eba3eead26774", "1143db502761379c2bfcecc2007fc34282e7ee61", "3a0ed78458b3976243db6829f63eba3eead26774", "0a1a5c523d835459c42f33e863623138555e2526", "1143db502761379c2bfcecc2007fc34282e7ee61", "0a1a5c523d835459c42f33e863623138555e2526", - "0a1a5c523d835459c42f33e863623138555e2526", "0a1a5c523d835459c42f33e863623138555e2526", - "72c8dd25d3dd6d18f46e2b26a5f5b1e2e8dc28d0", "5a5ec9675e98187e1e92561e1888aa6f04faa338", - "3a0ed78458b3976243db6829f63eba3eead26774", "1143db502761379c2bfcecc2007fc34282e7ee61", - "0a1a5c523d835459c42f33e863623138555e2526", "0a1a5c523d835459c42f33e863623138555e2526"), + "0a1a5c523d835459c42f33e863623138555e2526", "72c8dd25d3dd6d18f46e2b26a5f5b1e2e8dc28d0", + "5a5ec9675e98187e1e92561e1888aa6f04faa338", "3a0ed78458b3976243db6829f63eba3eead26774", + "1143db502761379c2bfcecc2007fc34282e7ee61", "0a1a5c523d835459c42f33e863623138555e2526", + "0a1a5c523d835459c42f33e863623138555e2526"), file = c("test.c", "test.c", "test2.c", "test3.c", "test2.c", "test2.c", "test3.c", "test2.c", - "test2.c", "test2.c", "test.c", "test.c", "test2.c", "test3.c", "test2.c", "test2.c"), + "test2.c", "test.c", "test.c", "test2.c", "test3.c", "test2.c", "test2.c"), artifact = c("A", "A", "Base_Feature", "Base_Feature", "Base_Feature", "Base_Feature", "Base_Feature", - "Base_Feature", "Base_Feature", "foo", "A", "A", "Base_Feature", "Base_Feature", "Base_Feature", + "Base_Feature", NA, "A", "A", "Base_Feature", "Base_Feature", "Base_Feature", "foo"), weight = 1, - type = c(rep(TYPE.EDGES.INTRA, 10), rep(TYPE.EDGES.INTER, 6)), - relation = "cochange" + type = c(rep(TYPE.EDGES.INTRA, 9), rep(TYPE.EDGES.INTER, 6)), + relation = "cochange", + author.name = c(NA, NA, NA, NA, NA, NA, NA, NA, "Thomas", NA, NA, NA, NA, NA, NA) ) network.expected = igraph::graph.data.frame(edges, directed = FALSE, vertices = vertices) From 61cdb0274408ca7d9f44dccc65615c40c63788d2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Maximilian=20L=C3=B6ffler?= Date: Thu, 23 Mar 2023 16:34:46 +0100 Subject: [PATCH 43/56] Update copyright headers and NEWS.md MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Maximilian Löffler --- NEWS.md | 1 + tests/test-networks-artifact.R | 1 + tests/test-networks-multi-relation.R | 1 + tests/test-networks-multi.R | 1 + util-networks.R | 1 + 5 files changed, 5 insertions(+) diff --git a/NEWS.md b/NEWS.md index a4a017da..d712ee1f 100644 --- a/NEWS.md +++ b/NEWS.md @@ -20,6 +20,7 @@ - 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) +- Add argument to `construct.edge.list.from.key.value.list` function which differentiates if constructed edges are supposed to be artifact edges, in which case we check if the `artifact` attribute is present for edges and replace it by `author.name`. (PR #238, d83cfa2086b24abf467d09251c9dc9729bbf431c) - 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) diff --git a/tests/test-networks-artifact.R b/tests/test-networks-artifact.R index 5e478aac..8eaebaf8 100644 --- a/tests/test-networks-artifact.R +++ b/tests/test-networks-artifact.R @@ -15,6 +15,7 @@ ## Copyright 2017-2019 by Claus Hunsen ## Copyright 2018 by Barbara Eckl ## Copyright 2018 by Jakob Kronawitter +## Copyright 2023 by Maximilian Löffler ## All Rights Reserved. diff --git a/tests/test-networks-multi-relation.R b/tests/test-networks-multi-relation.R index ba046670..7c5009ff 100644 --- a/tests/test-networks-multi-relation.R +++ b/tests/test-networks-multi-relation.R @@ -19,6 +19,7 @@ ## Copyright 2019 by Anselm Fehnker ## Copyright 2021 by Johannes Hostert ## Copyright 2022 by Jonathan Baumann +## Copyright 2023 by Maximilian Löffler ## All Rights Reserved. diff --git a/tests/test-networks-multi.R b/tests/test-networks-multi.R index bbe711a1..5f2438fc 100644 --- a/tests/test-networks-multi.R +++ b/tests/test-networks-multi.R @@ -15,6 +15,7 @@ ## Copyright 2018 by Claus Hunsen ## Copyright 2018 by Barbara Eckl ## Copyright 2022 by Jonathan Baumann +## Copyright 2023 by Maximilian Löffler ## All Rights Reserved. diff --git a/util-networks.R b/util-networks.R index c0269b33..fce7bc9d 100644 --- a/util-networks.R +++ b/util-networks.R @@ -21,6 +21,7 @@ ## Copyright 2020 by Anselm Fehnker ## Copyright 2021 by Niklas Schneider ## Copyright 2022 by Jonathan Baumann +## Copyright 2023 by Maximilian Löffler ## All Rights Reserved. From 18a54f0241a28675dba4cdcbd433e88ec68d515a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Maximilian=20L=C3=B6ffler?= Date: Thu, 30 Mar 2023 15:03:12 +0200 Subject: [PATCH 44/56] Update 'README.md' MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Clarify that edges in issue-based artifact-networks are not available. Signed-off-by: Maximilian Löffler --- README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.md b/README.md index 2349cd95..3ebd1bf9 100644 --- a/README.md +++ b/README.md @@ -256,7 +256,7 @@ Relations determine which information is used to construct edges among the verti - `issue` * For author networks (configured via `author.relation` in the [`NetworkConf`](#networkconf)), authors who contribute to the same issue are connected with an edge. - * For artifact networks (configured via `artifact.relation` in the [`NetworkConf`](#networkconf)), issues are connected when they reference each other. + * For artifact networks (configured via `artifact.relation` in the [`NetworkConf`](#networkconf)), issues are connected when they reference each other. (**Note:** There are no edges available right now.) * For bipartite networks (configured via `artifact.relation` in the [`NetworkConf`](#networkconf)), authors get linked to all issues they have contributed to. - `callgraph` From 7f42a91d4aa84e8c28c048925190637051e358a9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Maximilian=20L=C3=B6ffler?= Date: Thu, 30 Mar 2023 15:11:22 +0200 Subject: [PATCH 45/56] Replace edge attribute independant of construction algorithm MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Replace 'artifact' edge attribute with 'author.name' edge attribute independant of edge construction algorithm. Fix minor code-style problems. This works towards fixing #232. Signed-off-by: Maximilian Löffler --- tests/test-networks-multi-relation.R | 2 +- tests/test-networks-multi.R | 1 - util-networks.R | 35 ++++++++++++++-------------- 3 files changed, 19 insertions(+), 19 deletions(-) diff --git a/tests/test-networks-multi-relation.R b/tests/test-networks-multi-relation.R index 7c5009ff..c724d155 100644 --- a/tests/test-networks-multi-relation.R +++ b/tests/test-networks-multi-relation.R @@ -283,7 +283,7 @@ test_that("Construction of the multi network for the feature artifact with autho artifact = c("A", "A", "Base_Feature", "Base_Feature", "Base_Feature", "Base_Feature", "Base_Feature", # author cochange "Base_Feature", rep(NA, 4), - NA, # bipartite cochange + NA, # artifact cochange "A", "A", "Base_Feature", "Base_Feature", "Base_Feature", "foo", # bipartite cochange rep(NA, 21)), weight = 1, diff --git a/tests/test-networks-multi.R b/tests/test-networks-multi.R index 5f2438fc..bbc93894 100644 --- a/tests/test-networks-multi.R +++ b/tests/test-networks-multi.R @@ -57,7 +57,6 @@ test_that("Construction of the multi network for the feature artifact with autho ) row.names(vertices) = c("Björn", "Olaf", "Karl", "Thomas", "Base_Feature", "foo", "A") - edges = data.frame( from = c("Björn", "Björn", "Olaf", "Olaf", "Olaf", "Olaf", "Karl", "Karl", "Base_Feature", "Björn", "Olaf", "Olaf", "Karl", "Thomas", diff --git a/util-networks.R b/util-networks.R index fce7bc9d..9f205bba 100644 --- a/util-networks.R +++ b/util-networks.R @@ -975,12 +975,12 @@ NetworkBuilder = R6::R6Class("NetworkBuilder", #' [default: directed] #' @param artifact.edges whether the key value data represents edges in an artifact network based #' on the cochange relation -#' [default: \code{FALSE}] +#' [default: FALSE] #' #' @return a list of two data.frames named 'vertices' and 'edges' (compatible with return value #' of \code{igraph::as.data.frame}) construct.edge.list.from.key.value.list = function(list, network.conf, directed = FALSE, - respect.temporal.order = directed, artifact.edges = FALSE) { + respect.temporal.order = directed, artifact.edges = FALSE) { logging::loginfo("Create edges.") logging::logdebug("construct.edge.list.from.key.value.list: starting.") @@ -997,7 +997,20 @@ construct.edge.list.from.key.value.list = function(list, network.conf, directed keys = names(list) keys.number = length(list) - if (respect.temporal.order || artifact.edges) { + + ## if edges in an artifact network contain the \code{artifact} attribute + ## replace it with the \code{author.name} attribute as artifacts cannot cause + ## edges in artifact networks, authors can + edge.attributes = network.conf$get.value("edge.attributes") + if (artifact.edges) { + artifact.index = match("artifact", edge.attributes, nomatch = NA) + if (!is.na(artifact.index)) { + edge.attributes = edge.attributes[-artifact.index] + edge.attributes = c(edge.attributes, c("author.name")) + } + } + + if (respect.temporal.order) { ## for all subsets (sets), connect all items in there with the previous ones edge.list.data = parallel::mclapply(list, function(set) { @@ -1024,18 +1037,6 @@ construct.edge.list.from.key.value.list = function(list, network.conf, directed ## get vertex data item.vertex = item[["data.vertices"]] - ## if edges in an artifact network contain the \code{artifact} attribute - ## replace it with the \code{author.name} attribute as artifacts cannot cause - ## edges in artifact networks, authors can - edge.attributes = network.conf$get.value("edge.attributes") - if (artifact.edges) { - artifact.index = match("artifact", edge.attributes, nomatch = NA) - if (!is.na(artifact.index)) { - edge.attributes = edge.attributes[-artifact.index] - edge.attributes = c(edge.attributes, c("author.name")) - } - } - ## get edge attributes cols.which = edge.attributes %in% colnames(item) item.edge.attrs = item[ , edge.attributes[cols.which], drop = FALSE] @@ -1107,8 +1108,8 @@ construct.edge.list.from.key.value.list = function(list, network.conf, directed ## get edge attibutes edge.attrs = set[set[["data.vertices"]] %in% comb.item, ] # get data for current combination item - cols.which = network.conf$get.value("edge.attributes") %in% colnames(edge.attrs) - edge.attrs = edge.attrs[ , network.conf$get.value("edge.attributes")[cols.which], drop = FALSE] + cols.which = edge.attributes %in% colnames(edge.attrs) + edge.attrs = edge.attrs[ , edge.attributes[cols.which], drop = FALSE] # add edge attributes to edge list edgelist = cbind(edge, edge.attrs) From c94656103089e6e4c9928024f9625abec5f09be3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Maximilian=20L=C3=B6ffler?= Date: Thu, 30 Mar 2023 15:50:42 +0200 Subject: [PATCH 46/56] Update 'NEWS.md' MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Maximilian Löffler --- NEWS.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/NEWS.md b/NEWS.md index d712ee1f..39fab1d7 100644 --- a/NEWS.md +++ b/NEWS.md @@ -21,6 +21,8 @@ - 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) - Add argument to `construct.edge.list.from.key.value.list` function which differentiates if constructed edges are supposed to be artifact edges, in which case we check if the `artifact` attribute is present for edges and replace it by `author.name`. (PR #238, d83cfa2086b24abf467d09251c9dc9729bbf431c) +- Change edge construction algorithm for cochange-based artifact networks to respect the temporal order of data. This avoids duplicate edges. (PR #238, d83cfa2086b24abf467d09251c9dc9729bbf431c) +- Clarify that edges is issue-based artifact-networks are not available yet in `README.md`. (PR #238, 6b0a5ba3655e8991ab4f07e07cc8c7eb19b5c67d) - 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) From cbff6cc5d8dc2caf1181b73ad160d7e1fc884d4a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Maximilian=20L=C3=B6ffler?= Date: Thu, 13 Apr 2023 23:08:10 +0200 Subject: [PATCH 47/56] Update commit hashes in 'NEWS.md' MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Maximilian Löffler --- NEWS.md | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/NEWS.md b/NEWS.md index 39fab1d7..05cd1c3e 100644 --- a/NEWS.md +++ b/NEWS.md @@ -20,9 +20,9 @@ - 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) -- Add argument to `construct.edge.list.from.key.value.list` function which differentiates if constructed edges are supposed to be artifact edges, in which case we check if the `artifact` attribute is present for edges and replace it by `author.name`. (PR #238, d83cfa2086b24abf467d09251c9dc9729bbf431c) -- Change edge construction algorithm for cochange-based artifact networks to respect the temporal order of data. This avoids duplicate edges. (PR #238, d83cfa2086b24abf467d09251c9dc9729bbf431c) -- Clarify that edges is issue-based artifact-networks are not available yet in `README.md`. (PR #238, 6b0a5ba3655e8991ab4f07e07cc8c7eb19b5c67d) +- Add argument to `construct.edge.list.from.key.value.list` function which differentiates if constructed edges are supposed to be artifact edges, in which case we check if the `artifact` attribute is present for edges and replace it by `author.name`. (PR #238, e2c9d6c39fb757c566ef4c4b18780cca247477cb) +- Change edge construction algorithm for cochange-based artifact networks to respect the temporal order of data. This avoids duplicate edges. (PR #238, e2c9d6c39fb757c566ef4c4b18780cca247477cb) +- Clarify that edges is issue-based artifact-networks are not available yet in `README.md`. (PR #238, 18a54f0241a28675dba4cdcbd433e88ec68d515a) - 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) From e1579cab9bf8cdfee4105426c144350d092fffbd Mon Sep 17 00:00:00 2001 From: Thomas Bock Date: Sat, 15 Apr 2023 17:02:24 +0200 Subject: [PATCH 48/56] Prevent further R warnings in if conditions Currently, we get a couple of warnings in `update.commit.message.data()`, `update.pasta.data()`, `update.synchronicity.data()`, and `get.first.activity.data()` of the following form (or similar): 'length(x) = 2 > 1' in coercion to 'logical(1)' As the the warning will be turned into an error in future R versions, fix this by making sure that there is only one TRUE/FALSE value used in the affected if conditions instead of a vector of TRUE/FALSE values. Signed-off-by: Thomas Bock --- util-data.R | 6 +++--- util-networks-covariates.R | 6 +++--- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/util-data.R b/util-data.R index 8e08b7a7..80470d75 100644 --- a/util-data.R +++ b/util-data.R @@ -399,7 +399,7 @@ ProjectData = R6::R6Class("ProjectData", ## only print warning if this function has not been called by 'cleanup.commit.message.data' including the ## case that it is called manually, i.e. the stack is too short. - if (is.na(caller) || caller != "cleanup.commit.message.data()") { + if (is.na(caller) || paste(caller, collapse = " ") != "cleanup.commit.message.data()") { logging::logwarn("There might be commit message data that does not appear in the commit data. To clean this up you can call the function 'cleanup.commit.message.data()'.") } @@ -641,7 +641,7 @@ ProjectData = R6::R6Class("ProjectData", ## only print warning if this function has not been called by 'cleanup.pasta.data' including the case ## that it is called manually, i.e. the stack is too short. - if (is.na(caller) || caller != "cleanup.pasta.data()") { + if (all(is.na(caller)) || paste(caller, collapse = " ") != "cleanup.pasta.data()") { logging::logwarn("There might be PaStA data that does not appear in the mail or commit data. To clean this up you can call the function 'cleanup.pasta.data()'.") } @@ -695,7 +695,7 @@ ProjectData = R6::R6Class("ProjectData", ## only print warning if this function has not been called by 'cleanup.synchronicity.data' including the case ## that it is called manually, i.e. the stack is too short. - if (is.na(caller) || caller != "cleanup.synchronicity.data()") { + if (all(is.na(caller)) || paste(caller, collapse = " ") != "cleanup.synchronicity.data()") { logging::logwarn("There might be synchronicity data that does not appear in the commit data. To clean this up you can call the function 'cleanup.synchronicity.data()'.") } diff --git a/util-networks-covariates.R b/util-networks-covariates.R index 31dd7134..88daa050 100644 --- a/util-networks-covariates.R +++ b/util-networks-covariates.R @@ -14,7 +14,7 @@ ## Copyright 2017 by Felix Prasse ## Copyright 2018-2019 by Claus Hunsen ## Copyright 2018-2019 by Thomas Bock -## Copyright 2021 by Thomas Bock +## Copyright 2021, 2023 by Thomas Bock ## Copyright 2018-2019 by Klara Schlüter ## Copyright 2018 by Jakob Kronawitter ## Copyright 2020 by Christian Hechtl @@ -1594,7 +1594,7 @@ get.first.activity.data = function(range.data, activity.types = c("commits", "ma ## check for keys whose member lists are empty or NA ## first, get a logical vector indicating all missing keys missing.keys = sapply(activity.types, function(x) { - is.na(activity.by.type[[x]]) || length(activity.by.type[[x]]) == 0 + all(is.na(activity.by.type[[x]])) || length(activity.by.type[[x]]) == 0 }) ## then apply this vector to the 'activity.types' vector in order to pick the actual keys missing.keys = activity.types[missing.keys] @@ -1604,7 +1604,7 @@ get.first.activity.data = function(range.data, activity.types = c("commits", "ma ## if there are no keys left that are present, again, print a warning and return an empty list as there is no data ## for the configured activity types - if (length(present.keys) == 0 || is.na(present.keys) || is.null(present.keys)) { + if (length(present.keys) == 0 || all(is.na(present.keys)) || is.null(present.keys)) { logging::logwarn("There were no activities in the given RangeData that were configured") return(list()) } From 50c68cb60114b49c32dc5be15014745cb8d42ded Mon Sep 17 00:00:00 2001 From: Thomas Bock Date: Sat, 15 Apr 2023 17:06:35 +0200 Subject: [PATCH 49/56] Fix wrong bracket in logging statement The 'sep' argument belongs to the 'paste' function, not to the 'logging' function. Move the wrongly placed bracket to the right place (also to prevent a warning being printed). Signed-off-by: Thomas Bock --- util-networks-covariates.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/util-networks-covariates.R b/util-networks-covariates.R index 88daa050..9d560fed 100644 --- a/util-networks-covariates.R +++ b/util-networks-covariates.R @@ -1618,7 +1618,7 @@ get.first.activity.data = function(range.data, activity.types = c("commits", "ma for (missing.key in missing.keys) { logging::logwarn(paste("The type", missing.key, "was configured but the RangeData did not contain any", - "activities of that type"), sep = " ") + "activities of that type", sep = " ")) activity.by.type[missing.key] = na.list } From 573fab22a290e826e2bdd6e1f063cd2e87ed2167 Mon Sep 17 00:00:00 2001 From: Thomas Bock Date: Sat, 15 Apr 2023 17:18:51 +0200 Subject: [PATCH 50/56] Adjust adjacency matrix to recent Matrix package versions and fix bugs The previously used statements to initiate sparse matrices are deprecated or disfunct in the recent versions of the Matrix package. Therefore, update the way of how we initiate a 'dgTMatrix' (i.e., a matrix with numeric values in triplet form). The new syntax requires, at least, Matrix version 1.3.0 (which has already been released in December 2020). Therefore, add a corresponding warning to the install script if older versions of package Matrix would be installed. In addition, fix two bugs related to our expanded adjacency matrices: - We have to call the 'which' function from the Matrix package (and not the 'which' function of the base package). - Replace '1:nrow' by 'seq_len' to corretly handle empty adjacency matrices. Signed-off-by: Thomas Bock --- install.R | 8 ++++++-- util-networks-misc.R | 17 +++++++++-------- 2 files changed, 15 insertions(+), 10 deletions(-) diff --git a/install.R b/install.R index 37565cc9..973c7a78 100644 --- a/install.R +++ b/install.R @@ -16,8 +16,7 @@ ## Copyright 2015 by Wolfgang Mauerer ## Copyright 2015-2017 by Claus Hunsen ## Copyright 2017 by Thomas Bock -## Copyright 2022 by Thomas Bock -## Copyright 2020-2021 by Thomas Bock +## Copyright 2020-2023 by Thomas Bock ## Copyright 2019 by Anselm Fehnker ## Copyright 2021 by Christian Hechtl ## All Rights Reserved. @@ -69,4 +68,9 @@ if (length(p) > 0) { if (compareVersion(igraph.version, "1.3.0") == -1) { print("WARNING: igraph version 1.3.0 or higher is recommended for using coronet.") } + + Matrix.version = installed.packages()[rownames(installed.packages()) == "Matrix", "Version"] + if (compareVersion(Matrix.version, "1.3.0") == -1) { + print("WARNING: Matrix version 1.3.0 or higher is necessary for using coronet.") + } } diff --git a/util-networks-misc.R b/util-networks-misc.R index bc5489c4..c2ebc509 100644 --- a/util-networks-misc.R +++ b/util-networks-misc.R @@ -14,7 +14,7 @@ ## Copyright 2016-2017 by Sofie Kemper ## Copyright 2016-2017 by Claus Hunsen ## Copyright 2016-2018 by Thomas Bock -## Copyright 2020 by Thomas Bock +## Copyright 2020, 2023 by Thomas Bock ## Copyright 2017 by Angelika Schmid ## Copyright 2019 by Jakob Kronawitter ## Copyright 2019-2020 by Anselm Fehnker @@ -104,7 +104,7 @@ get.author.names.from.data = function(data.ranges, data.sources = c("commits", " ## / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / ## Adjacency matrices ---------------------------------------------------- -#' Get a sparse expanded adjacency matrix for network. +#' Get a sparse expanded adjacency matrix (in triplet format) for a given network. #' #' The adjacency matrix is expanded as it may contain rows and columns for authors which are not part of the network #' but given in the \code{authors} parameter. However, this also means that authors present in the network @@ -117,9 +117,10 @@ get.author.names.from.data = function(data.ranges, data.sources = c("commits", " #' @return the sparse adjacency matrix of the network get.expanded.adjacency = function(network, authors, weighted = FALSE) { - ## create an empty sparse matrix with the right size - matrix = Matrix::sparseMatrix(i = c(), j = c(), dims = c(length(authors), length(authors)), giveCsparse = FALSE) - matrix = as(matrix, "dgTMatrix") + ## create an empty sparse matrix using the triplet form with the right size. + ## x = 0 indicates that the matrix should contain numeric values (i.e., it is a 'dgTMatrix'; + ## without setting x = 0 it would be a binary 'ngTMatrix') + matrix = Matrix::sparseMatrix(i = c(), j = c(), x = 0, dims = c(length(authors), length(authors)), repr = "T") ## add row and column names rownames(matrix) = authors @@ -225,11 +226,11 @@ convert.adjacency.matrix.list.to.array = function(adjacency.list){ colnames(array) = colnames(adjacency.list[[1]]) ## copy the activity values from the adjacency matrices in the list to the corresponding array slices - for (i in seq_along(adjacency.list)){ + for (i in seq_along(adjacency.list)) { adjacency = adjacency.list[[i]] - activity.indices = which(adjacency != 0, arr.ind = TRUE) + activity.indices = Matrix::which(adjacency != 0, arr.ind = TRUE) - for (j in 1:nrow(activity.indices)){ + for (j in seq_len(nrow(activity.indices))) { array[as.vector(activity.indices[j, 1]), as.vector(activity.indices[j, 2]), i] = adjacency[as.vector(activity.indices[j, 1]), as.vector(activity.indices[j, 2])] } From a79272f5271554ef98639e61752eb7622c34ccd2 Mon Sep 17 00:00:00 2001 From: Thomas Bock Date: Sat, 15 Apr 2023 17:46:59 +0200 Subject: [PATCH 51/56] Add empty bots list to empty test data The empty test data contain empty files for every data source, except for the bot data. To stay consistent with the other data sources and to also check in the test that empty bot data are handled correctly, add empty bot data. (This also reduces the number of warnings in the test runs.) Signed-off-by: Thomas Bock --- .../results/testing/test_empty_feature/feature/bots.list | 0 .../results/testing/test_empty_proximity/proximity/bots.list | 0 2 files changed, 0 insertions(+), 0 deletions(-) create mode 100644 tests/codeface-data/results/testing/test_empty_feature/feature/bots.list create mode 100644 tests/codeface-data/results/testing/test_empty_proximity/proximity/bots.list diff --git a/tests/codeface-data/results/testing/test_empty_feature/feature/bots.list b/tests/codeface-data/results/testing/test_empty_feature/feature/bots.list new file mode 100644 index 00000000..e69de29b diff --git a/tests/codeface-data/results/testing/test_empty_proximity/proximity/bots.list b/tests/codeface-data/results/testing/test_empty_proximity/proximity/bots.list new file mode 100644 index 00000000..e69de29b From 442a1304b526f2ada6e31f4fce456578211154b9 Mon Sep 17 00:00:00 2001 From: Thomas Bock Date: Sat, 15 Apr 2023 17:26:52 +0200 Subject: [PATCH 52/56] Adjust ggsave call in showcase.R and update example plot Since version 3.3.4 of package ggplot2, ggsave does not automatically choose a white background any more. To stay consistent with the previously provided example plot in the repo and keep this plot reproducible, manually add a white background in our showcase.R. In addition, update the example plot as there have been some slight improvements on the legend arrows in ggplot2. The content of the example plot has not changed, though. Signed-off-by: Thomas Bock --- plot-multi.png | Bin 123432 -> 122272 bytes showcase.R | 2 +- 2 files changed, 1 insertion(+), 1 deletion(-) diff --git a/plot-multi.png b/plot-multi.png index 7ac17f96461b6b09328acb96acbd0cfe6a222539..05c37f3a2bd409110c3f6f66af462e495547b597 100644 GIT binary patch literal 122272 zcmeFZbySsM_cn-)B7!2IARy8$NH<7G=b=N9PU!{}5RsDZkZz$NcoxGES5({{>cL zNV%Mym-p2ls0;xfseWp+ve-RLmF&TBL74u&3IdAM9=!&(h^k;`|)0~HT zpEgfXh$2qYDTMEw`P z|I4orzc2Nr(|POLy12kq<#DG1@VV(=nq(J)(Q>oKl|rZW(Z&^YR%5*VCdqaOLs(H- zR<=OBIJrsk5=N8>T*Sk}(~~fyV;@X*;|g5$5`7iqH75W0;oLbXI{owRtOUVZ|6Zb4 z9o+x@_Hp^=|NCEmy+VV5fyvkwLZaR1aa8NLDxb{ndc3=Azu42#+Dc7LU1^TYQ^}U6 zkPNXLDb2)TQCC#lI$BKeKHD35`0!y|TpS^bo~)Equ5O)^{~eMn*|4KU)J2|*OwUNQyP$*Px zZmyY`nGdWupOdAXo!t@37k|dCI_FKjCb-+)YA6X`bQ1cdtD*6LkdTm=I3YTE5QYxx z7yO9lkN@*phvh%xHTFZr`WGjgO^bj3vYY;XxjIdBkn{`?1d#o%|4b*A*;YS6A13wZh{~?+f?Ct(j*g zJ&A&zT9{#p=-2qySIy+lKinqe=cc3U@K-NzE5pUWP>i^QA^c7I>&tg5EQbum^~zt= zfA#bfA@ZZQKfw$MnRR}<9{XVtDyyhOWpkMi(6X>7oD?AP)g0G``_{c#NO&DI8a-;x zPuPq)@6RvuIjy}ZhspNFb1*P7%g<>|)H(P5`laevZ8O!_lf-9%Q~J6sq|Rx5+xlfG zqc^IB5N_~$Y3k+E+a$cZ)8Bn~$*v;2jt5i}mU;4Xa+VqnCN0LROZJl-@0fjidr7;} zvX3W2DP4k2LC9$>c1IhFfH6lY{X?GjV!zG8uei?r>T2%5mb9I;J8JnA#@+Fq@)9AB zmX&ZaZw;HoGj<{K5Gu)g%{W3!P5Ll3MP1dSX5~JwED}B^*^>=gWU;%Y%uz^lBY)on!Wq1B-jjd?r1Qkj_Je+KW!Z5cA=b zx$^Y~lkR)t^YEE`d4AhjG0ht(ypHCbk#sXNGouIXrtEi!IW0FQ8{Do>Pwz2O)}89g zD<}-vx763ylM1-y)LOx|%FBnGzk=-0{}K;rMk{V$Fk83Tm~YABy8YJ&M=)n+_XerU z^xuw%o&+rBjMzP>&q67TK59VM^ZASB*E3|aF{LC``bpX{$EL`0<9^B1wPvAON9 z9gW-f&Mz#OKicnC5OQ4l{c2~SyC+&*&ovWLqv>=z(CI?E%6fggX2*HTb8-3Gr%#_Y zAPL~k)?<}&b5H9g8tvvgIju&2#XW1Yu5x$77k~#1mYelId}jPe&_kma$%ii98s6cbBk7}?;*L{CY)2NH7YJ64+ z=lI&%Gi+Wa?aBg~7-oIXy{K;Ee(trcnP#p@m$}{Let~1pg45h$)#v_q5ETWwb%X1g z#9Y=6XL1)a{$%6HrX?C)=SL<+GO&v)-KsYQQMXyC!D#LO<@-A0-=x#i(=X5ct;egCMuq_!I4lM!DJc*4wV>MJpsT)O?M$=3 zLNdSR$o8cBW}#lg=z0JoTfC5WW9d9Rdt=(vinXRu7`TzLwBf+Ne2zKoFMs!Nb6aWd= zl!wY9iXd3vv{_gBdl+jU?x?UWoRlM_%=N?jhvu;yx{k7ZP zN~RX-tc6hD#UUzG=v>3~nV_H-fC1@Vs>(OP{?z`RULhfv<>{$MQd<*13p~H7$A`gt zg#p&gO>Ad&FNy=Cmr{(bUXtn*KeAV}}EV%^L-t||_A8JUAtHw-z#j;uq7Sz}C zSNYhMY8BelqgsD|c`m>!Bh}0J*YExN_i$w{Y5DH%E_xZMsgFQb`uocqK$}1UrablHjpH~^ z@}K8tCv}dil@>$H>+WCdmj7hJzL*#p@n~z6o7(ovaml3!0;+ESL>FZn8X0xRvcBFJ zuYt9wE}d{Sfc$#>`n9e?y$dR>)l)sp$Q24!5nUdo6bv=!(Tl$(f2Nhec9d_G_kONfa@BAee|!{V3A_rrzlZh&>1AT?$uY72UpZh5ql zUtFM;-;=Mw7(L$=!=P-!rI$HA;pXMs~P)hmSz)^!il+ORjlo>UNiVx~4J)H{`GEZ5mEgI)| z7-Qu6!}sQ9(}h>AfUln)09X^CqfxggI`pQRn$D}(6CHX)lj&(`tIv;Dq0|&x$|@-6 z*EunjK+!$_TgA%^J5$wJ{A}Z|R_06y-^OolJ;W7WetwUGjR_+X9Yw|8?n8Hn%d=;-i1Kgw?XtUB+bU2ZyaS_?2gR%N43YFRZlqKkwOOrIq&3IUvLlQe8huzA6^J2}|&o(txZPvWgeP5tItWRdHS%vZP2?^%ZUS5K<*I&(`}G{=If@aU;y zD-%H%&aJ%nT`F0!N?r#r5H&}=ILB6iLm88ISU%sM+AsV9z{!=j%@`{ZssN-m)z5#Q z)ws=HpW?Y6mv;e~D>28cQ|r)S$W{{~y+q4VM5Ljt9F8Gx5L>z+!nks_;yk}rt7?Es#HS4Dy`m8=DcXxy;LV2To(MA2`RHLU+l0}6UB4MsOkw?Yd zS3YlV0f1j6%X0oML^{vQa9ez&{kQejuTgP9e0YDLHV6B6Syu_caMh~xajZaM;DsHZJV|dD|CKHK}{`zT(20? zbD#e9uC!Lb^SFHVhrLudU{xw>?Dj8F-Ut-H4?slzbqPk`rf*ZxHB^L-hK8nDa(s}@ zYdJG!WvFHsx?Q_BVrGMT3#Hl7LOi?&PQuoy8DI`o& zkQEj~I6|k2$ZDwQXG4yI533jAEr2=h!BZKAbn>eSR5gKjB`4uPAyqHZ$+e8*wl&DT z#^6EqImPVvn}uHw$;Dh;4y&fT@^8x`D5cy0T6vw;axBZo)`|GckDUSUJv{2oxiHt| zxMi3!XH#{}Pk{>4Gc&7IR#T6L@^634vsBNPPl5uiy&~%FuT^30c{CrBhkeCRvk_=c z7jH|HWZ7p@fh5m8!q7ojiubwZi55^> zGLNlyYy$jte?P9Wb&Qmmkn!04bbZFj=`{1h@A~t&3rp_k20okk?uA~#lLDwC)|>9d zdJPLbN%`idLrv%N`(oME)zyT0E+Qwfnq|f{YM23`q0a8JfEY#6T4iNrd!bCMthOzm z@T~(a9oB|X5ekAz9Lze^zYR*3n$&UuP1EW%tE?y7H)^6G1#Du6hNa{S8nFf<^*3`p!wR)MCu4#IF8NFWjWi;?iCsLau* za#+?WkDcIEdOQ4xj@{+#lsw~5NKqSLTPI@pXJwx&L6ZQe=T;V4_h(_FVf&pATD4U> z1AOKZvZ8BCwTjv`0B#tzCx*K(M zMln=WT}QZWchKktcI5qRX+aiht0NDAa#PXJSfs>${+!Co%EhI=2++{Wza!fn&$0K2 z$6@I=P(XU^o)n?tQSCoi5EsgmkDk7K+k+P@@fv=LWGW(K{7o(O$DhngV`VV12-KNM zgPWsKV6uQv45MaR{RrH^uIMI`puLy98p6F0c5j&ntq1a)FLlL-obv6NsZh<8GR9Oy z<+KRCz-fTFKmX?lWIyPx(Z+|hwg)`}SpewM*>%xv@ z_U7koUi`D4vtTk2p&46hmwm55cERSWssA#rB7i7v8w1Ji@$&_&8nlni zzllekvk_SdE9|s6sXLOU)4rKh1393wG*Xs*ZqGsgV#yXLpR2M8@xtV zDIi#)w9Gx`T7%W{5hH0@Imt0GRiM9(x`1M>)s7TY2H?@q+dyTRK`YDNJqH3igpLls z)0zg->pFn^`P9X^B)UqZ{xmq&G@$sWTj*PmBo6hq_rH9t{n~Ff~=9>4_ zDC82BeU`ShMOE9*sTF8^G1o6Qy^BVUOCSGX^55a+ZW_0PjlzpsNb#Uj=CW?%1Rnb= zJCcn7m{TxO=0wMLpBo6`x(c&?iHiq`s^Zb1WI{!Yj7eQCx=~Hr1)M(Le}lKA&}&zy zSn%x1b|GLVWI@K)ufJDGiMXuSmP3K<*v+3xUpLdGP1EL*NrK= zvSQIiMMjRlX~stDI^8A?kl@92*Dx^f+k8S-!CDd%69bnFt-(6k$8+@>+(3JN8j}x! zF_`lJUC3*HOWG+~CHhh5;#8$qQ;(&raA~hbE`c*RBxHZL0EBI9xAFW3M{tbJK1$AO5SMJC-^=36c~tBT(Ir61DjsJ0~yo`wq_|{ z@~NW#GQ8JeWxxz5A-aO*O}u=HwhenpgNpV{Y-*RYwsC&>qdx1qs6PXi&(Fhi^fLgj zCmMqG#9C1lGb|yY&UI%29FbE=OSrEUIc_CK1T0VtpaRBHECdl$Dp?-_Xm+QbAN1p{xn)hO0nPc%HD|sa`FrgLP^y zzk(qw{LdKK8pc!LpV7KH4RRc*8JjtfG}2jIU9Ay4|7oel&PDh6bNrd*UvI}jpu*%f zVGg3AKL7|!y5lR}%>3w1;8GW3WUg;Gp^lJ3G?FVx_+7s=FVGzW$ZfMibsFnwj__k+wFMf5=LrNuGB zVq&uEm-h-D5EJLuyP{^r1x$`s)<2_b0w^BW)xs*(bwF@LgE$QPG!V@?T-LygatDHr z2nHti9nCKn9gvfzf~q}^hF^zblky)POnDCpGIDTKz*eF; z%MCJ*H>ZavV1!5U7DaT6nGL_u0f2pV$den#Zsj?e$7x>8t{e5ppPH7ipW^_cYZxn;79r58h}Os z52b8dn~I9c`($kD{c)Kb^mbV5DZy_}=J7s11qmQ?Hh6J1bpf7O?Yc( zP9LY)Bhnd=qN+x(^jYc;X9J7G|N7wq5`zoueTr%mI$0|NcXM%Z5!8tR)L6*JV=%c^ z06~)jqy0xL)$mo7sOEs0sjYjwpu-Qv{d*++Rn{}l&;t~H4^BuVaKSHA>=`N#+J|t&zb8`}xy`7!Y+VISwR$LHp9_xu(I)$KsfaQVQ2%x>7hVu%P zSKiysY~un8a%J_JDP=I@nPM4O1`@TH9x9k;353ShGaUtd?9TpK+9iw}HguQb?G3>* z&<}z~KVAD@KHc4%(s%vlzS&R(gIkw3A1ufha{Z;v54@C2A_3-As8txIj85)sy16B5aS6 zl2TsFbjW-9ZGA2zXt*Tvh$~7?xweQfRB1R0)bV_G1dRf(deSOQ*ESf1kxXDL9F*fJ zz>2MeNs`)Hr9dU!p14ddCNJLueyv8|95hng{&hAQEOg@*6SmyE8yP+j$9>Gwzk|RAmy;i+TNhwe!W-xsk z?ejpRc_+s~hoZbh_K$D@s&b&?c>qK|mL|s0O83_vvf#>!H$vwwizy=?wHtl(v`&`eHyYNcOemSbhQ8b#X-}BBS}0<>V_#y=6zZM*0r~XghXpRheae4Xu1QpfT~i?sxq!nH*T-fYUdc{rb}0@ z(_-ZfukVAkrp-uzOu&v*w*9TY096b;r7Y1Kc*^gMRxAJ!K$RwP?dqf^fs-~&oW1LrjvSXfVz~I zlS5RlO*LJBg>f+C0;=E&y8ZTMvptL=uaIN2dhX7A+YA`*2n6{MZ0zFvd=zpfm}@fU zA7e-Uu&+`bi-)k~uo@jmC%ya|u9*T2cGd=2rd@MSrJDaMsnVd-n=R9^T5!77N6Ok( z^J7#rG={;hi)7OGK!G%8h^&(Yx)4k%Q2WQ9;3Eiz!ku>@X7rovgmP2=QYs3Hxi9{t z^!YF)_e$#tt�^iqIv6RW&eLj&&}8RXZdTPm_9|+9s{K0);yRFMv)POgABHy-uPW}v9tdcbz^ zI-K!mFcu@HM`tVB`S%-Sv|W{vTGA~d6*m`S^u2ODdKm=-bSvDnj9P;p=EYBh3hc+) zRbgQJ`S~4;+lS_%Kt|Ga1wznmM9?axm7g~Ye!8PF!QQBh44)m(QTH*FBC{IKB-ku^N z@AhAzJ>F~IML#B3*V2)be_xdu%2!uFmKwC&5};XFSO|esfT!r`kJ4Pf^XLH?*=D^N z7=;{T8EOXwk-b*g3(zGr|7ArfuGY!yginPhe$zzJD@XNxT z9knP1YVI`24;jPQ)ssM!srtx#sHkvM@!<4m2ke`nL)`G^Qc@l07(M<7h(%J=u&=d_ z$Iwk|Q-2p9KhshZh!8p>icwJa(b@f8SzccLg91JQLA2W!$YTN2PrS}(Xkgt&`|v(f zUMK6r!y1cnn$chk>8W9lgO1DV)F9(?f{v3DgnLpei9X;xG(8Y^JD?M%t1>ZN0dNjf z)!d`gt0SBWV5bRM45h5h%+`Qj^EK9G#@#D}h543oU|5$Lb(Qy`)fkRfF^RdjNy+>Qh$ z{VR!2eW&l1AlhJeb2}C|7%y{NRa@M!hb}6a=dKd43JA|P=clenI(TfFQ}AVh)=;uy zb1*q)!QxH<>&(1Ls}Opr54fy#z<%odl;3!MY*E$4?N`(|iS40*#g^uL`kdJT zm>t>-$Lsnu02#eoFb!=pRMYt$3u3NU=wcko5>Rw~1ePh3Yc$bE>soCr9R97h5)zw) zzgi%X*8qeHkg>a z+LInT-N3-2v?41Zq-+}Y2Cb?lvc@HpqvxUMPnKNgAtxsX-3I&G>3Kg2>>T)Lnn1?O zK8RLG2oqytUTd(x!+9x@WV=C3W@rPZcu>(2X#}mE1Ka4G{m6j zNPAZL+R@>Y|AZfFo!0a6TMC9a5FG~`UU*h#tAT|vrd zzFL5y4wu+Xt9o9-crDttVUAjB^6N*tvW!0c*YdK*-F)v3PJ#~KA9_V?ZEbY~H~Une^n_;s*OZ4wCCJI5DJFV)Ubo$x)@4YZGhn3%teq=j zz(XJvIK9t3OadpYp@xrv=}6R>VsQ!M8%s_W*b>rVDJk9{Ch3Qsp&M0;X?^ek!K1$s zozXyDO+Be9Ap0Lv=l z!U1`20$e;fO#|^v{U$GHQG=c@a$48&N1vuh5%LDj=Y{i%K@`5ifdzKw4V`t~o8gq$ zaH0bi00cSeh^-lFnk_Jfe=*AI0G=tdr@=`)h4{XWg@q^j;P!`>K*AH}qy@;u$gyv? z$SI}bpT2tE)QYDFsaXq4C>22+*KNE`0fq&nWjV0 z0YeH-Hv!7Dtp`A5g5yfz;M?>esifkeJrCLfph>NbGX1+DTQJm42zXeK`Z1GgZz^i) z+Kpi-stSqRwm(=v|2#I7>bz_M<@emEY79!#_TG@b4Yaj^c57;Cf}qb)E7XF6O)z)& z-6a4rvNM^yE93BRLPm}0dLEg;#<#3HO_qATPk3nuB&A^o5|;XAT<#LhLZx)$=*R=*n0lh7K zunDPsUr0%rO*NjObH@zf0H^Khjk*XHyMZD>Y&k~RFTb<}kq;%#0iFdw*xA$52&KNm z@D>&p77otlVBr`rL|{@%Ky^AF%8H15hZxuc+%bkjAjZbf+d4cvgr$Y^U*fNurs%U~ zvl{7lw%}-y8Jti8HxKYuSPlJ(?l#Vcje+B3K>yLT)v*1uvI*E1Z%hB_$wPl9wmX|} zS2#K*e8jQ=j0oN8Xd_1-@WT{VRe`U<$dZ@eFB>tE-o48T*0)dy7zG%@FaH?^!uaG} z+W_rROu!I+7Yzduz_m&V(~`RzTD0KPM1HdX3AVU0jxtAvVJ8xT5ME z{BJmKpB?=>efzcz;=rhE1eg+oFE=m=I3ULb_7{ID`cx7~sQxAN&93sIX&lDY6e^i$ zMvbq+b8n%8kr(~}zy{joN^)QbV<5UAdT!i)Fukb+KVe|%{AYN|VA3x@?K^V6kN)*# zB6PZ9_;qrUB7#*G% zQ5fEFxYNy7aAPl6cJ%TH*OfeLjO!Jf?^}5y?*oY zo2OF_?WHSkZ|yu#-1{8l&%EG(eggyd@kcrgRkm={+g5#a+Q1W!*~nk`W2f3( zZMlE!BwvEe1KI%iPCl5*`eiyxgmg7S#StCAm?SyK&0P z&|e0DC*>;{u*99~M3E~oiu9XxjDILG#pHRERhaXwOq4d9^1A#!HNpmee<696Pe2e` z7%7Tz`CHSAR@;Xc3Fr_&wASElZv;C9UzrUTJ5Xw+UT5|W;;u<%e-l2_wCSSeP(Szh z^}2*!w86|Z%(pMw_^)5(3rBtXagvE1iYooAk*Ia$p;IGMdj7c0`#vR;dJ&7~{de|# z#&(&B6^dvaA4+@5W9Z!)X7an_dnX))F?*nq=*)*+wj|?Cq8-Zwqr6swI;vmORxQ@v z!&M`sq;zf}H9EBQix2w0Oi3FSRxHHCHD`*b1ci%WlHanM&*8RF3)z8SbLFnQACgN= zH58%cNO-O0L$Lnnom2X*jmha%wqGvmxD7UIN&J-FsJx1TO}5ZWBEimwC_*oVMRYp6 zWOW~k9jR;Owiz`XBlaiN2uB&nqaKp!Wu{$-PnGm|?H|rRpySnJH&0&`Hz+RoV9r5F zF1Bxm8sjBV;>Dm<{rM})TW02vNU(|fZR*c>l&}aTHq7ZNg(UYm%t^bnsf(F6N!Q`{ zU>ux>U1CKGk8--k#3XeHP)&j+FB@W~vH777Om$NJ&ec4bO2p5*tgn;%cGG(|eTyC( zIKfwEth#zxB$w=cF1Oc|GIwKb3^8ToC)eAUdX#gD|H%M;4w%FP6^^zc&XIkKp1dSN z&fOf=QuW|Ik zuC2m~!(Lt!DbaYDUJSi%BCch_)<^n-*<*Ht`^Ap-b-se(TP^_xnGLdEHRtjC*Mdih zd~vDEa`d!$6ExlKQA!znW6ElOK<>-!I($B+MK+*Bu5|gb?+)J6kc6ouz3SB;3PaS` zL>d-pIL?Y&C(%D%g*|z4ygkI{{q^D;YcKWfZ}BAC$oCoOdQOXsUfbk4t?_71>2f6X zF8Mo77-v)OwRP?jQ>ni6t#f(2BVV6ph~e2!8~3CVYb+^DCCj_{gd^kD_StwW!f(IL z42#UTd_N~ySQnu=Lmv3Uf`rMbC>OY}U(sw5$ z^?Kq4y^XuNbA4^247%f}Tn7V1G1CoiJ@aK~!haPMO-aX-rdKw+KbrKYeM0RCp&xPD z?N5JyQToN*Hf|eIY903d8b6w(F@G<@aDPD%!T%fW5_dzA=(Sp+Thl9teDhZv^{Zb*HE$KS zKEKHkx(}I(Qc4d<<`MiP7UMMRLDX?4(?m7ZecWnu=dN}q_?d24!|#F@`+m6LPsJXjKhmf1rOKAz{Il`5fU19Y$d`Q__tod3kTy%q z#iY0N#&aq97jO3MlWvgJmd{oA9Oxymy9jR|ZZRkn3a6XMyjqM$83fYS|Lw}h%fJxv zH+*DdfUYcW$#hHgxGi|BBMMub0&&xZ^$a6qd~pf1zc8+qT2>9;avOYvZxn=F`ui<& z9b(nAf)I=R)0&^t2(vG3`8-{yYwD49z^e*&ULK`4hh2C!F*_UOL7Sx3X&qscMRHgBfZQ~i9_7eqZuN(xz^#RBX9n=Y@Tq7i0i?!4Z3v^7mvKE zr=@?}u=&PiHi@m@ZCxU;9darZRIQ7!QDC7h)ufaXdyp2jZv4EO;#eWT^fx6Zd}_+x zJIXgh2iq!A*0{z0wt*}PwXiapr0QB)r+*bc!E(&Qx@9sj!9PRRTBR^MJ0?Fdu6sTD z2TI**jj*@mt4f;D&(=))sZ<|HhN!bP;Ifd#oL`(IixH9X~@Hn z>6Z%GG@e`ZLc1t)d2LPomw`V&yysm)Gt&5S>x1;1cJ%zd6H@f`OUc_tKYPf62;O3^ zO0pEX@NuHi4gXLp*V@$Xp}QyHCq1;%TvRLoOT^=DgK$ba_6X>B*~n?DIQ5sfg70W) zxQT>JftC1&Y&csk*N2Bs{BVN}w5o~*;RAAujU`?CZ|3wXzpF-Hk-jA(6=0b<5wOxs zU`+RmRmh#bigK}kjwOYbo4a1Q#p0c$qmUG&p6^QaP>3Pn zSDKmR^N9uJig;yFxejZ*qnhow^zFWhZL+%cNh>zl&zG;>4YzH2^&P~NFos=l_S~<4 z(M-p(K!weQ!!q4Up8mz~{0crx(RRPe)3Dqs8oz8)hf<+~p_aDuOo2+ignA9W(l4!- zYN!^yx-~N=q{8a(-@9#_rudFFF8|!9#5*tw^ZXN_9YM@rxwZ7D>R?o#1@Fg`B5L92 z_e~ihXVec~&r+d_#5`HdNp*eor!lc*!x=JbzP_l2+F&_H$64xcNc>`TY1;?77OfMD zeG=%hRbMSb2uc{aC%urK@ktf@`!*$w{&XQf)}Tv95k!SJGG`cegAFAZ}(*N>kVgb@;K8)PE)19z-xKmvPkj?mwfI&nOw zTJ;M$^%Um})Yb6A^{ezC_tmZBi(cTFU7qBS1R#Y}WcS_-4E4gd~w zcDCFydXV$YiB8ItYOeOO&Vf=XLm zog*>7vI%N!nKki{;=TK!q={^~Tg9v1OqG|7-fPl~o=FcM_c0|AGF56ve);;^d+32m z{g^yGo%^1+ck!?RMF$39KeINcHY2fL+DicmVj!WnJ^x-dKI{rTo(kG<4w|Kdb4ZV*a`hE7| zyJ$Wi*Ppoa>w8!LUxqkGO?p5A8;6&UunNVxxr@WXFj6sBcdDyHsa0^~5%UUr#DK}I zFvXpfp^iPuohX4jEJ-meiF+vS=G%7zUTJaoIjlr-e?3i-&AWJU#OGRyY@3x1FM<-b zO(OK+MR%uoPuTs@?I_kF`!+5ANK7tAPG4M-d&i?iKZ{Gh=9@din|c02PGeFW_Ks~f znJdBm_uRwgRJfxw!ZYo7Q6dtX>7mzDSK@6$uMPlaJ(-iI!Re56>Zn;<3#X*Y{6u7? z+&mbQLJ}^b;~atd<7#VZlT)9I;R{D%g)q~u&E2UVyNU63YQ#u8c`vPWzr0#`Yk(dC zfPh@gXDPZbeig4*i*3l*lfH;Cq!P=$q)_qH(c-7}iU4o|KM9&_tk535?bv7_vPoHiivqo$MkriLA$UzzP}O$JYVE0l0%B0ZF>*7 zMzawNHHWg`-IfR&J+$LAVYs^}uPfJ@6v(hz6~0nscQL-?*^G3tUUWM-?j2`zU_xLv zVz9oDK=QF$PkmJ~f6!lh`uah#oAwc3P1VS1-Xd+xRYIt7-hgNO2%`O9|Uqi?nF z3~l$~bS%qgvla7o!n4waotk6SLf+^ceeq?OqxOn_^O7-FUk}3=Tv5uQGMsv3>}STC;Jn_hZmFK88|hd0$%CYJbR{%+f8M6Px+s zd`Boxpq&mo+4NpQk?q@-UH@~7ss7bh|KxE4QI82`mn3AG#j0vruRizrK#5^ z_>v6d0+R0CkPiR&R7_v652*iBnO7m()H5G)wC?Ve^GO9-o{DwhGzTk<`kMtlquI}6 zt>qU`z1l`h4svFWtCkVlK&wMET8xgN;ELjzMMgUV>sr9`FA>S)!e-uslG(`|5>ZVN zFe+Ma8v9WX@}kqRX-mdR?L>y%JrBm0qG$d(U3;`RIrvKYbvHEIN$_rP+i0yFl`^I< za(guXEK_iz{6H1h1=VUrlWjBR;FKNo<)^4yJHEI-w4M~ln((>TN7g!~eF4+x-~S6x z&&Tlm{IBb3Mw=Wf66B#_f$4Gn3f2jt%J*bA5~7(`CwJU zPb=EPVxw_9MW#@I$rm)&sG;^|{Oj_AXZ)Hje+!>`50N4Zu}Lim#`Nqd2|?B9)ZtZK z6S$mag4FbdgPyWeqkM<^JT3N&W--?)47JB1&qYPF8e2@iS%zobG4R zBcExdUI0;cd7wb!i+mKd&lM_fYxFs2KB(o&U}~gPNYq-Hb8sK`n(1V6(jr#|&FH@^b#ES?z?dqGnhQo5sj%VdaY2`r`I-_l_vU>LRbu}ehs!qrX_s1TI531m4eI7! zOj=7~x)>oUz7FsB;c|{>S(agvk5cKVKT8XdpfO>J3k*F|(J2%tEOMgvjn%k#wXPme zLp7qG?4s>nZiVM&PBZ65@O)&PWv;M1jZAP@{Hq;-=7}Mt8?S9$JMS;tum{m=IRaLn zgF+BU2p*|hc%r_<6xctOoVc1Ywj#~2Q|^gApo&PdY)9&hJ$^`nDCD60fV6W^CN+NU z61+8F=X6=XPR6br=OYIV_u%M_M$QK8iWPl5{Wxc(^VbLZe^Od{tB>UFi)I|K?i0D! zgg5^oEbL^PpZ|`9o0?WrxI6nsp&{c;fSiXla#dGKPmC^Ku zk`2$%j%v9|(vGpri2xgd`*pg8g|Dv&A5fq=nBPaK`;Okg>TP%sV8KtaU~Og}NmmI* zibV5#8q%0Q9ZWGNn^W^;%~P5E1~KDeqS%>% zbAIS=;lAGffkMSbA<$g;==rv)EJvS}Z;2+2k9}yjkkc5BHCBO6BH?3UKlA(jSz)FW z<5Y7u?5ap=%b&ZmM11>FlKC~;uJrG5A+thQSTeGy=94RRNWN?1EA0bq^((@Pii62cYeuT3T{4*Yxeat_EoxtR-2Kw4 zB?ENU+RYIthvN8j;7upX$9nEl=X(#c_7=PHGzbX(zohNYoI#Awp};q7vqEv01> zeFuY7uktnuRw?-Bw!41B=~^w$D#&Ec7p-qzXH=JRr0tU?i+*&m-y2~flon;f^cmtv zr3hvXdD10JYk#(i`zmN7#zQ401GYyG|(QsMcR={dAPxeWR@^B;hMKt~{(}$6-ZR8EK<|DFp#_ z2mvJ}ev0_`DdPI1xq076qd{_aKaUpMM~m8O*K2z8Uip_ITka}AM=q{R7(7*gi972idjaJ_w~ZV9ks==gC!&j@~%TDe%R) zJTA>}{Ay1MJL0XT;kpy$s}EbeN^&HD>CLxiLdYNlr0-pqx_9@3DY=-PnC`lKnjFfR z-BrW|;XX>&`GBu+(uWs^IZ%Ynyy^8-;U-O{g(kZ#Yf#4bl-)#&$>~(!`eY|%+Zm+^ z0_6#U4QJ^$?fj3S=3xIC_eTfHr>7ExV}YH=*4-a@pDR;yA;-IEZwcAVTd9SlMl>98z?|o_V{^{{?i8ZztvACs(+y>VEmeEuF|NjI z*o#iZb6Iz23Ow1XoMvLz|IEPYWwv*0pM&u}i86z{f~Lv-@GinVk*CCFI~a(o`!Uah zi$9af)s6~2_I1-XlO@1~x_`#JG5X?hE*|FmMdu2|i`>zi^n3LXIX>A<S##lXVn`xI4C{oE`8+F7A`oH1HM9)Ca=n>;9dEC1aga>5UX~JHE-Yc?!ODnme}=IDS93y+@TQiVQX%q;FhJ4oo27 z>i)1*B=x*lhBW&k!bbi+fJa~drvV^+kiXp1x6mvhNQ{eE*zk9zZtJf(|7kmmr zdQMK+TQa!>YR~5!@^!W+miWa9MyD_lI z)OohOo8#&b^ZR!y=FMD5)l*ibyFusX{8m8@j820u!+#XX5#4|F@t$bx?G*uhiraml zMkELNHz%hOy2@Rrg0gjuY>T*% zA!snE=6t8C+UT7yk0@lCtGgo=S8yguhp{}ad^j$3G|MxBx^!I2lp$f2Nx>(hpcF*C zT$@nTvsK4=`1qj-X?~u@Q_=wlHJz5T4{KwVIHC6iit8yx?Sqzo+fZd%GqY~Xt4LpA zvB<`l&ln|Q?R+ptYoSO`XF2AwVFAqm>xTMzEoQr){RHlfj9sN)t3oy>Yqgw%<)znJ z6xM4r-Cz1BQ`cZ`a;9kKdJ0=hRqkJMt9;^+AgMkJ6|JnD_YE&f?kH@*Hc8eySAdCU z)-3(|-<*NI$F-SbVf?>Og=VGK&C(6+v}e=H<%1xt4|W+b-ZpKC5(!Vgz?2~cnX=w4 zQ9(f*nVs@&O4+4}0&8KSjXJafGbRJ;7q8cO)W68rL_ z&A_XS;iylDzKhKb4HKKeKE<*kO5cwmgu$Z^?ri2{^d4?$>$bFuPP*Hc(H8FSM(Nb$ zm|4~t+mf*Jf>#!UGrp`5V-;g1zOSstdQi;KsL)N!-uA@P+pT2ZRAv0EZXv;_K1zMJ zx%Gt3LwlAnIFo*^iF!VRUsxVFfNkp z%NaLGHpz>JZKFwE%=%uv-1;gKS4{?MT-5!`wNX(lCK88HwZ`w(v8Xnq`SLIKw3JK zE@>o{?rte1HjQ+5cX!=q^L^ic$Gwa*&KMpK`+ah)x#pbf-Cr=pirbHF_BYl*-JKm) zc(6XQXBlTf(<+R2hU{c85Scfk`LU8%V-A@)XDi`J=HTlvFA zLrp-dZxIykUMD<^86AAMzql?|EfO+JBi)4e61ze9R3Wp8oYPeuY9_l)lV;(wH~pM% zhS)r;##8x5@3Kt3_%ObaXpOsZXqd$#c51~~ZvK!DuCXYNB9^jC)DxnTwtZf`Pmj&@ zz5*7x!Nl>KDsO{iji~rrz_ikA+9&YIF59C4NRuT*#fB2+)%HFq)IBL#5+@Z?6%-7z zZuGkoL`KU3g?kIF{bcdX8LAQ2n6pOHtl5`$5~gm+)g$bVx_Slg*v1_ND1oNbeU*&(6Oj z{X`Z+L_w;gJT!t z9`EM;;KZuoIhQsPZ9UMSwDl?b9aco^;Hu>6rA4@>JMZ$~OpYB^udQXE zp=vvBgt!#aFYtP+o!S1RGo6!;?G1?&HuQi7*z&K#1LZ53y9U>UStV*&ddsDbZL{=o z8CcpU=>zQsj`^&O;$I48#{EWZWRjnX!515Kh}ZMoTXIPAqrHs*TxS5}!wGIw zGoG0=2kn~)RxmUD8CR#iocAI3JbHS@xX}FJNse9f)pQ?HZ%yU+AyYtNU&> zd~)BiyUb6qSvh2gJ9u*~&M?@J_k~^RHy*qoazD>kCr~&thv9(rVC>r_iW6BeO&Vgs z9!g8Wc-~WR2Mb)D28hOZzQD_tJ1{3sxqbOL4t0^p^KrmBy_`(XmmfsF>uCfYuMq2~ z`#uK`(mb%>(KEok{`);Mc7jcQ$$?IQjcx_eSS^#ij#Pd^scYqgk3I=wSyhMa-o%Y0 zbuxcpQs!#q?c{f&Vk)}*OO$8(XM2VeW`DJh0NbyU)>zE2K6>C1w#2PTMP)8&ju>U^?Lf<^+JY`j96ZqY<`5Q{1bB_LSEA4-C1i$+1 z7r6t&7tW50{Q_hzJY~<9jlm*gA!kmkfrt-=K%!dE%;^7M;(NWkMtZ=2bsMmalwcFA zcaBCzC@>kqsm!9mDt(?0>|o%BnPDaiot2({klx~_f>Jr>!Yw2W)%5WU32*ZdYX*7##p)CC z`AcN4^p>0Wo0g`C@(--L<6L2b#RMXa_1|0S2xy?wI*9)h{BXUlUw*7&Ff!+S{l3)K zc=`e1Ee_L6GgA;bIm_(StGLwaVB`P1@NZvz%y>WjQ3=s?t=dzMlA>pKm(P9?Iq3%G zpXXPFy&)8=m(mvyH$wUED4LCdr|AAHY~$W)B_#$qK>Xp$Osy^cqaI=(HQVf3w%T&9 z>lNL)tXvQlJP0JtNpF2&gXu+7ebdH`yVPDcRX8twm-_*yzGs`=-;B8@kY*IR4-k5_ zG-tE+Y;;|8({_SZ@o-cmJ-5Sz0~%XWvy_LKa zhv^6m@w*V+w`4+6)=C0HrUeOKVt;pC?dH&=%|uzIqC#|ubDkg-pzZ}Tdvh-x!LQ|h zH6=RUrCy{H>{R2M+#=ekA&?SIsrJn{iIk)Yd`ySn3&(4_oHnH9+4+%%-g!|=!B2PA z-k$DLEeSTF(7@q2$}=YgyHHI>={!d20X`4tuZBMw+K7*V7(6r;LUzzoau;5bmO1IH zVZ6p>FE)wpqt;`XK7-JItwe%csCX?3~x5Tg4)n9<8}-W{8yg$=KSr@sIGh%(3ecdg|Q z2r3>CLkCeWi-iR%U!T7jUId?a3K5RoddDh2agKI>^t^nZ*s)GyA82`6b_n^+Q9Ear zhaoIdj!1>+jCu)ONecw_29-Hf_8{hyI+pG4y-b%v1kbeBz4~S<& zbm^$g)^9cicg?@peZtcoPQG$p;(ewt5vdj}Fm7|XyH|gkJ$6>w2M)vhvwtG$Bnby< zf0)u9F8JTaBI&H|;ZyYqnLY=Pw+97LmcOrhW~#ysT_5y&R&0Hea)+<^qw&@;i-7$g zeUwKR=W9$#*vx-#^y3QMyiIG0=9A-;WZ&++b;#Y=3ZYVSg0Vu*jWFVN(btJa0=G^NvdNe*ytjAjvy9de*Lm7MJv=g zu*`XSgVbgWWzN~@I7)psRIDWTc??J6!E8jf$Jszii|=TS2WA6@g%Bz>dzJm#vUFJh zumd$0{YN>TYPvrpkoair{cG`MOcZHC*EGK|_g9;b6MdR`u;Fy$isJMd(O=Kw zU(nCAT5=Z5b3xNACrk?LaltT(9^GWbfSZ8fu~UF5cz<_3+n16{SUqX*T$Zq|yyJY< z1dvn<^B|izU1DIs673thf8w0jWV=n!SCIj>M|pXhlZE#5;G@v|^-=#J-gg3idgjdU zdN(}AaO6TS&uy0X9NaFH})5+Ob|sX6ZN?UCR2yK|Rqreiv$QMD{KF2kZC zYZ{9%dAR}|Jc8vtF&OWe&N>BQ*`_5DL=~oIwv;#(7N=CXob;FcY0-n2=U8A9FwXA7 z)%-e&bPV=+rVTQDN6OhDpQ;n4Oq!X7g>oC)V+0%KWR7-!F_%{jE(j2DYVU^8X})W-FyLf*({Sgiq5xHHpEVmMUAf zyVoD96pOt`>zb@mAjm6p2f+!gnu9Smz)un+v}p@&?qONx4{bbN$#u-f%v(>w#G~69 zr1r?oXWtA_1q*?=F->;zZ3kgW2Yb@ec{-Ci+ECTXyVTdQSK3!5+jW|_Yn34EJx+RN*Z8_yk&CfpgsQL+{1dC|Hrnu2AKET#iVyv)it|1yJ)>Qk0wb^Ua_CJ47 zq&qZ^E4ji~D2A_dr-lVi85+8_vi?0*eRzKe;`z%zT~_Q?PM`9_?2C?M12lRrn>AGZ z69m<=4)gG#LE%pqxiqHrZQVK+YlM9>L;Yo9IoOg=|tqSKZO;a_rZ2oW7KAPR<(+pTRG z$D0pkT zQUek-7ERRC2Q_prKCN#3eMczqo)u#>O~rWz_hxtpdrt019jZ?DStwG4XG<0_J_u{h z4%3Z9C+^4%0X&7abI^69zZ#vRM7;8yLDk%|iiuF|#E9jsLYg$0(`ED@JsiKaAYK=p zA1TPwBJIjTEOAP3ES`6{Fugg_9*Gr23AI{9bA9|-=OTh`1Jxss+FkD1*$R!)A30jM zCCZRubDi?J)ia0SiMi|Ig72>2%p-;n|7RlX>y(8KM|W1BiSQ=wjFL8pzSu@ej9uQ0 zi8ht$H3td9)m0RGo8;qhc5f{Vf_klpA-d$sS+JUoVPp}7zTCsdjY)raFjU7i^OrZF zx!c>{I;sB;kTmZP-10ypnoi_))8ktI+`jhzWomDKB;@1Nyzg}4q;QL!o2g74iQIDW zil{!31{<46c67|w$-{yJz3(+s&ts4j>vXk-<0zZ@dG4*%&GuAklQZX|1dJ3?F1we_ zKyzzsw+p-cHMJOI48=ha;9zNvt#-8-EprkOcqw*x#Vef--s`}dt&FC^5H9egAR{9! zx3-X`V=l@8s+(J>Ea0h{u=+szHo8v8WITgD~|)Vcwjy zdT>712^scWFKX?WjfD-AuF#Y^Er(e!bTTVH-3PfodIP0xMe56i$C?bHD?OUkMu+>;?q5jD_H)u03~LIl z=?0H{^FfiTpn`>o#WG3PS)7$l{B+D?`Pn}UtQ9Wm&qK|Yl>LoKw|&$&8gy>pd5vjt z;*FjeCvydWo&xBhdxFsI3TKbqKqhdQ#)Ega_Om-_{>NB(`A*%A^MH!sob}J1(8)xF z;fWdREAR{DYg>gfK^ibv_F-Pg*Qjl7q_B?3lY@yHdApN+b!#VU76vk%>bzk?RSq|O zCGX)`t`&yE$e}W`@6mVADA_4>GLKeW0>{xi>#wDe0g{9N!axUkp^MeKZ6h*(W*`vF zCm?EIhx@Ik#V`$BbMWh)$7D~&nbCIB7JgF3SX3<_TH~r?x8TP9A-PDCx;7yIGIbIy z>(592J=y&#<$VwEb-yZ&lu6P!g#zQa8m~v8)0YRugU=`k)}+;faphF!X zhIVx_MrCWvpkXu{$CR4JT1fa^(Z?h__`syWu}i_D*?j6CrxRz1^QQpd&Gs+S=Po@% zdRBgcCSqk3#TyMxF?R(+!{%4Ih&`E4V5<*vK#^ei(Y9IVs9$lj8lX`gOV1l_*)7n* z3?}`lK$}PiW=ZA_E>A(ZSBq&O2|q?yT>;Tq?eUZ83Ac$vMq;uH6ggR{wFRN5-6?KY zRSp3`x=|!ZhYrc1?lh|_@!Un)N_t>0JpU3^ht^};Vn8s+Mn(?@v>1a8wow|c_|XH! zZiAN)Wu^sSoXJRpcJ=1-I5gH3dL%1DeIiK*-xpdJ50%Azk#K(gXuiF2KXum&QgZAaCb^#~t}kXR;PnXVL$;5u#Ozf9l8?Qmc5 z&qH^5vNRfFF-`07$`gL31TtBkGawX^TR6UPwnC@16lX)?h%lkf*lIMoE z3Z^bsnr{b^+Bm`7#uQds=cyIV`|&x4+sy`PHF~gf`fMgqSi1nvb;R*PYELnr z*)4o1i>x^4l}ScKuy3m^$u8Dv1X6eV8e*VBW+V6DZqhHzC-Tv#jbGvZ%sD72-q!`l zR*&}x>wsw^wv$vz&S^K_NN|IYc;-VPeELFp#WRsgMXg*@dE^7EGy;i_a|V@ts>XRp zK2%*8HszR7>F>Y|zVV~;BPXp>qNsEXD5t{SZ*g35@s10+T(*wP#SkoW-gVo%gsZC1 zVV-u+>?p?4?6_%7-*~1`VdzjBF;Wl;q&~KaUb6EsCSAWo@9gr{Vw_gZ2)=Zjwgd4- ze7;160Wr3oACiZ&S)Pqb7gO&`J*U-9knsrW!rqD*8H6&<@HdD6kf+CIsJXDSQuUfL zA|P*T%I+vn6^;ank1Vd%o^U-{uBE$2!|}+Ft!4 zGBbAED7mCUjh18%xOf0&ba8sxMXKgPOd3Fd;I-1sCH(~A1IJTvHAk~Z0!%-5xKTIx zIpBYW0Fo;1%b8PniWPa?w*KQe&csLA*W<&1pUn2<^T{i}q)?pwEjySHV#R2+iLUi{ zi|uem9L_a=U0`e=wWUk;pK<6iP5LKjzjn|2xpm%J&Zj7V*?MamGv`nx(+2Cz+~M3Y z?B&9K)%u7A?vEuWZKWn;N3aDbEQPL*!Aclm%RJgji)Dnde+~Ro*_6W^=dykc7^tOf zrfp;eqMvs6vbPZYtBr~iyb?3*L+|Cn0$QS^97Y-D|GEoI9f~pf#t#BSR zNOSa}fe-QxUjXfzB2kry*T%sE-!}B>g0w*OEm2Q{M=oNGY|zYdVRBAQqqM%&0fUAy zz9ZdEN>Lwi*d+-3{%}&6@Ml1z5iOk%dFPxRsSya!0^BW=M5;u^zY{#qS(Hiw1EF zUh;dK$5wqBt<2H?#aTB@kBl_Ar`Guy#aL{|;d;gANZ6)1nE-i`@XF{M>tx;$-)M*i zL4plo76S=q@L)=da6x&Gvd7p!)J|&n#o>7HtGVJ$yZCFwnbt+O@`3Ze6&!u)vLX>y z17xB)%0pLk?G}#s(34Yijw<^I{!n?j9Hqa#iLp3xGQ~F5eZr%Fn#*G2k!?dV>8~U9 ztK@>qU7q~yh$FDgupuzDCVun#2ETXO{t6{DSw-MZh90cbr=LXrdSk{^xg!s-jVNfr z1}N7_7EW2*fraS%6$^6QC!L|INWNREdqk!w`jcb(G+@uRbpz#we?V~dxf_A#o9fNH zf;!=gb5BkC7h4QVGm*8DSYQ4MBtdlN24h7wD$Eg?)*$)e_Shi$b=vwuHc^9??Zw4G zjH1-Q{%c~+!^6adr(*Bc_aDM=PwW{?!!WxJh<<^ArI6Q!0DOrT!yc%LXZVlHP(ox9QO^5{pOyhRtri31*!1J@;uwu4RwQ<@vO%*rB74C&ZG-*E} z{U`a00qgo|3LZAdh(jJVWUgqI8v#>PoE)E>fb(ET2I@UbstIZ`-vTddZJDB0%U5$z zCMHr!b)2y``lL#_=b1}X{5rOWklWbEv|Vp_HQ)biVcNX|DK_-V%!eZ6Y6n33s5f`H z+w@;b&kxYFL_giPnL@T(@os;3Pco0bj+d*Nqq<7WN*k|puC*<(q=^kh_PXi%$O%q- zx2TN4PgKqJ7JrsKJn&DA#EJQZbME;t73;Ihx|}@S8e*NYFwC$7w+SxzP&=<^{^Z{! z{PA)M-08bTm5nJ%*}61JihahlT*P}oq0vImuKzHZ?05&?~dbn+LL)- zobKj$QvR{a^c#B{cpuxFWyOqGu>m!3<36Ki@}sruRfJ!TS6SYuyXYGMw>c3b8EFW_ zH7deto-5Lb$E|F;-9las?k%R8dyW2NDQYZ4FkbA@q*Rq-)wyQ@fYiunKvJyW3tD)P;g*|}ND?#8#Ue)8kO(v<}-EC+|NS+hv{vy>flG{ebc@Fm| zig5um*LkNSki@5|-GxCf{vOE}{BkI{jTxl4OJ7uRU$q)l+g35My!zfL=~xT$Ljn40 zau-Hy_xi0QT74r@$oOj`6^^B!8$G_nqiVW*t3w|yf191%{Sb7qsZ-aqS;o!1zBZjA zi|Hw@4ZIr^%9C0MZ!27j2l6A9led8U{fQR_HrBx?;Y%Mc-%4O zv(hlu$D}s-*DOtBXWLM%=h(irL`6>=2rJ6kj@v;j7V< zDP+d9Oj);2%$+7uPTQLs6{oLOr3lf8t07Wr5{r3KfUUINaE-g3{JA*v#IdV)1rn(%YWKT z-8ai=^!0*Xkm;_Ul6p(4iD97gQ|W$ue2sX3+F$3(h}kH~ubS4`nkvw^l$b5?!jq?T zJ&He`=Lr$+0f2->jbyVs76=4?P@b}q z7!R8a2%HqMhdw|N@fZ74!=k;H^)gNCF{-LbX{^kac0NVUxboE^uTnoy-2YRUH&gXF zl7bwt23`}7pu%+k6>fdQ_NPk5=uVuDRQIYEn-6YT>p_G~^jHc}831vE`DwCpp<8`p zNk(ZydAI|qiod$s?0!1Q<6bVw57|oAn#u2ABPTl#U!fN)scLJlEew%e#VlPHr8C7` z|Ey~Yu%tpvHXf8@e+SN!`?watB{>4>5_^4^7~K_T-AxuH+Y-!vC`-}k?P}F_d1S~B ze~51QXckex$HBn4lE`v2I)MEkL6>b1xUcm**sK2?$4K0s&=? z_RcvjH%5%^etN^GbLd3gI`Ux+BS>@1*F0^m=u;n0Wz<;7iMN-2jg|GWXjJP=`X9Ay zmw$?aKqTp!`-LuE^mW=PNsmT(<^TDOMhOU*Wv(!mVs%N_OhY^AnhWpoYKe6L<}}L& zG`*|QhaiZee~-ub>OYf=DG)xRb}0&Rl=0xYt!3r}3Hr2;%QVkoohq%y^zpcd9n4Kq z)?A+!8xT#(Q~v;W2d*vxG3R*du1mg0-(q-!8uLaK1h#njQNQOaFQ#fA@>r!K!<&BO+h8N=9>W91JXS5SyR zp$tRt)HQ?*#2grMyx?SFC(Sd0`r-5YFX8XKjY+efV{ax#Vts&#%BWO00eQ+m&xX94 zToNG~kM!}NeUNOo_!#n1qDUn_vB((y^l4OkP{GtYTAgp06^eZ(2wY5vI zFrXeEy+~^@ZC88u0}US#Qdv=zZ+!z`a+6LO0S@@xb}G*9jF-72LVGGUo2A)0WNsz} za2)0PVjF^=R#7I*9T0AlVMYhbP=2aYXZ0FU5uA}a{v~(;bRMoS<>HW+X&{1>(QV5c zE9A5>VhGBAV8s~v%|R(vh#x?E^$ux^LHQ4MHSnwWFL^e7B*;v{SxK>X__y=vp1ZFJ zE1RvitYqq>D#us^#`=W7jutJF<-InZ?j*}j%`BWR(91ECYy?Xi-#S^b;7uo*WFf)v zS&9}u5Yl4L$8S$$_6SNxXHk%2Gg&S4)gBwOjlaB$Nr9$jj_80;AO{T`K3x);DW^N@ zwqlveJy1OfY%xfGh+H|`R0c&H#v=8E?dC>^41A?i3n>ya|rLJ?sg zj0}WKVW4W3;IJ(*BOCoh1(?>p&u9siy?6%a_Ma2(?RL6NNq-U|C~`r8GElPG7H)n= z*9FDiv36Us=R`0~Sdw!GY+GYC)IthS~3{in*FlAi&Df>(s(H!;AADsH19{KEW#0x=H{f zJ@RR`?)nH#8$F#>Sj$&~>siZg_iyp_-1E#_$YXAqDpNX#wi~$YH*HJO6p*`bV^bk~X-`L74h2wS(I)eyr)Nvbl)Ga{#aH~zCdx8 zcTuj!A;ou=*Q~J@co8W5Z%QCON-irGCVHN)gi)VgFP*Pk#R~vEuYLVD2f&*gM0?Y@ zBMYsenuGgpTy$#q^b;nSwfLx?A(RCp0fUs}u2yAifMa;yY{r68$1y?uPWkrub`_I~ zs9P00T=!OUSxM*pS!oMnswAIQuf=Z2_3X*Zv(K#)0x?k=>zgW%>_|wRql5GkiUr7C1~nc+hxB`HFU4$6y?scEwEyy8AV)HI z$lk2IH`ARC1bkn^xcg>N2i%SQPeBc@(X8!qkPx1}^L`8Q3(H|Zc? z<||5z5M_RV9bo(h$Z;QQPN_RRJT;d~MO8y{HX19KW(uM!8o7vnaj`zddu3 zUa-Vfh$e(t9tM%duxQs)esIkekiK!S6N>sbetXf0EU{c8m&Ptd?Dv+P7x z?v6+ipJ4z=5WMcPe(Fj4A(i>iC_`XFcsIwa2938)AVPr$P%?O1cF3wqe)uX*{{DT+LVa96sMNx=S>H}K>-pjgDG>re0;6c|djY8-MUP41H^#6U;MC(M zy}JUCtRrw>x0B?7wZVPyv7H)hKi3Qcf-|l7^7AR{u>H?t#@dzf0h`3U;mJk1fcKkc zA=-EZjikC5Cz^hb#6<;y>SKC&sE|*6peX`Hh#8XkmjV-mkWG`;iW3=j?Nf3m5rKBQ z^RHk9y&l>eZ`Mz!w($6D5tFg(!hj-eYB9PmkTg}+Um^vPs&spvM0&f7{!dgdp$`#{ z?V4>e7$(+t*;kYP-Uyg|nTg%E1`dM2DN6Da<*WZ%Q!HZ(tG~uBMKS>I#*uF%Jjhj6 zr%XTG zX9H9?HuesWYBNu8gX&@fb*Ba1J!_^rMq06#k_m|7J-jBK;WDkr%(MKvagOCW*Folt zPfZ)USx?bV^^)8EMjL^FSi{R~ASJ98L(lHDdKDmEp+S0x01`EJ<^n=TLk@0l1(pey1`(I_*woZ-?HKuvaZAKotxkEDTp7R|M zEahH5ed!_K0_6#jTY_K!1lco@6+%_1{vvG~nJ|Y%0}y+CPOHlf9tR%|&hjqzKLJY! z#8~&vs7~@QrQPXH?Zp3OC)a@{Q%npgCkX-v%4wZIjz(T4PRCtW}k61 z&@5C!!CA8?xeL=6V3vJ*r8N6>uz4z`f7|+2cd!fgDu9172gpWp*hf*^49wr52 z7$&xgU%St676D&FSzc`U!%9R=5z?i~&L{hdhM>D0iS!xRK}-aM*x~tRw8YBXodpcq z9HaZIPcX$x9+R)G|tXFDb5t6 z+ZNzHV33LF2PW4nVA)NMX9gw|u6{c}n-`R;2A5&dU|Y5zP7#d?L$Go_3X}&h-pvC5 zS6rx;vxpF7RBq{dQ|b9E+l#yOu{~3i=4;4mI?s%xL9Gj$;zJxLu4jocOD4P+2}TOl zxi_-ir)$CFw;B`uT`osibtQ@O0vj7Zxw38(B*>L1QBkGF=1ZNg)gQEz zsn~JJ+1~h^Z&z*Z-yS~*eAAIzh2FMT1S8Q)+myz z{{WC?vv?OZ31jNKbdq@)e>)w-gMIW zp1L3l=qEp5Ktz3o|FSFoVR5IJx}8VQ0QY{@etqosuNbK7t#)x21#o;NFed4C8-fse z50BfTrr6t@PSqJpbIHSh)&bg!> zy6I;TizVl3GWW;e72@h@Jk3m z2>1N46@|!HJf92V9q=DFW5;2CKKg3Yk7C}^o`U!Z{3*-@ar;WE5VeX%y@9*^y$q2e@+~ zHK))bE4jFYItx1h%~L6fDUUT+{=L}O;<%Lm8w^RLa|$JhC=UzDxk6;CIg+gf`6UdPy#cWCWszols@+p^=P8rM{(OmJn+j^wYGQSd@1`ic6|zfou64obJ_}3DpNP(4Wqj<9Ea~3 z>d)$9^qcE{^yn*D@&e3*Qr@Re*(Hz!t3U_wquDBh>KmQ!#sY38nEJ{HyJMBZG4{Y< zn;xq+A?cF@8`bXxp|4?7orgt2K-%;~p!6IXm+ zskvou)}HgjW=r?( zkxvV=Y+K+8Fd55(*!{kOcmzN#Fo=J0vV+Y$VRk%&m)7;Sq`!vI!<2Zy3{`{LD3DHk zvcrwLeA}a}z74XdUg_-wA5v9vm;8E0L^B4;@Yc{Vh5@q?SOx!8!8be}h%QBuD*4hR zm(2gX0O`t4zZp*xt>BGfN2G=exJ3ZZo~{^p{x1$|phY>7H@l#B^UlUL0Nv;AwR1sU zF(9w5d~AVLb^Ch@KcCh{>dDuPrdf)sU~YF6y|d2ATbwN_A8z`>PcNa#%4Fn=-8{iN zUurCh=e|qA(0jE+WnvIW949V}o6JtP*!%Fyk}OvHyZV`GHX) z?8(zZ>a+%K0x9YU2h!}pPX!Yb`2CMBh%llnG=B*dQiSwN)pgC8&3Lq+uH3ynT|j|cm0Bs0Vv9w( z9cto%X}?_y-i+?2(Tff`0tXwd%_bTIEa>J20#DKSF|;!z&KBRMixJB=MjIX+wO8vf zAvm8!OoOM>@Zda@DH!;@79 zTo-_E1nsv>$;Vbgm(RdwZ4!3Hr8J?!oZWqQu$Zna{@_SfQ-IHqZ}tSi*D?YNODBtE zzd$!YR1j>racC;SYQy7^_2GH;^b#>?_eB~HbkJP!;BC>l>DKhWkgpHFF&&DDJ$aP| zsJ2PoQk4uN;90KCuct|wWjd`_y6B;CC=O$waWV?i5CZGY@GX-ZDOCT?!bmXrxWJ6M z=7!2TU)YKazi4^zG_mMH{U(oo386lkuH9ZEr31qx1OiP9u}4O5EB!hJCdm&Onho)T zyNCm6xdmVodU#1sf&J^55i+S<^y%vJ(!ND196l8fnuT!C*+I>J_C@2gJ5z>@Sj)(k zi1>dikcoS&kj#G5VIIBY_+i2$YOQ9x12U>c_&*2elwiC&R;u}l>N z>&v=7Hr+tT^YSgZp`5plwIaDn4YdYeHK;xz2?OM_Rh?MMn>ruHF(w6VKezJ_ve8k_FH@TZ8C8MH^LB9_iu7RJWK0uAiM^&I+-^KeM|1n;_z{p8@+U9lo;^4SGDCOGY_3QS9VFy-*P8 zxPkzpQ+#|L`z`%_h>GMVA**a=k|mDn3$-jXf~`PW>cP1dt!|J>$q^3&S;ej41Xghc zz}P~12!7ToJ5U++S335#P@KYQc%hA3xrcgWU12}p0bOmZqFJX}L+p4k?U_ zLh2`j1X?X#Nu>PPEQoE9t^cT6z?&8q4b2c-yMt)9ztqgZo!ii|v|2R8hYW|8l7Z$^fV` zytWYP0)xVp0~elcNqI5-Y5iZpCLE=s zd$*vW_=Cz#5+9&!;kC6Fif3OTLS6^GmW59X$_+udFc$ z14y~Q=sN;Mr7;0R7F@Zc?r?dz>4eIpHE!r+74FsN2M|}lP(X!l0@l|zY~@-V$uM%u ze>YYA`dXqpor?&d-I`6R&f*C`Ky<(#8!;@HojF&&k{ts6n~AC8lx6YX#=j7LZ<6K~ zbY>M>v#Z`3(*hzIsQUBuN`x`{Fqi~Yf&?MM{jA(5g$>VG^e|cJCO=%IEH06b4J^6I zQUJaYeEj+ULLW49;)LI-a2sK2v;CR8xx|c@&`3iYogr7x;&b8Z++>F$?stf5blM|8 zk-g1|rz$f6%p*%_CB|;!qrLRe$P6SPNR+&}8GILmIJ)2abP7~32sFAi10V)o` zWE=i)q@XiQZo}Kj@k}==aom2r(mrqg0g_8e~!_OQ%K@*o8Nh_$#ShEm6?e7iH zehBhoMd-`XPFFRzH^~v4gr=6ce0;Wl7_<4b9!UE*5wlWX{}@RF(5*WA|8hIUZu=;o zvihgB#@%ffH*WO%r(&9}GIo`W7;E`k@?8+A=S$K9UODxN4=}%ucQIaL_AOjtR=w)d zFd^zAAQ~fRWfhty*D>AcfjMPWg;k|d4y5ske_qTR~XWy*z8oukt%scFrjOZ8NM?YMAkK;e2iInj@5dKw_tweNiv$4N0U!!AUvLtaKP| zZ$UEwWhGa>$Fz?uc)Hia1-*yc{w#(`OC4Cg>`O~+Fq8sK95Gm}v(m~)A-LCG`Q0Cb zUqPeP_-v|t9Pr~A)yS>dm(sri`Fhl*IS3$#N<+&UHrW-(qdeyH1qWbey|rCFbMWEC zwrQOKtx^s1+@~zSrwp2Aa0Y&|?aS@xOrQwgUyfb?oJr{!d%g~a_@g+}U(L2~X_PC| zJ_f-Q4jf+Z+UdU9env@eClhscuy87l2#}8g_q`KrrA6SA6Rk)>aTus-?H$j`!H}ZZK0z;!gKZ}^qp7Px+mDFwS8>5LDN!#~l2QNEKg9~E+@8%@O+x!E7 z`#oVMOC=Bh-y@~KK<`MCCu9i?;+5GU+q93R1Ld*JBjrWr4LYI}YL5b;APR&6W&0Zh z0UkUE$_Rj2Hr?2~=K^j{D*xz^J6)QfTeFc^WL>ngl0Ck4JK(iex!tvgdu)O4%W?Ye zMfxqTJ^}4y!EO^yCrV9vv9G}rhb=ePj3v;F3h6P*faA!i^uO~EL*8Owrgs*u?D~TP zXtZsx+IU)t5gE#8V3=6_q7zHp-fQ1Vv!C0O2@X`bUhZ82(@Mp&QS5<;SkG?5n6v6a zEzX~P;9QS=6Mbi*#8P%cop6vlV>`og?>Q{%?@~>F3XwF*&>_x=47MC6ZMjHufuf?H zVjP|&9sHgDhj=15grk`x_f8;TbjPMrrkSkMol2(u+e1qsbYCr+f;e~{;xIMWFT6+D z4h4rPV9}uDW;MFLVY)~=@f{5G2xT)VBC3ElmJ^GgF`XE(SAG&Xp#a|sC=g)L2?26+ zeSm9LRT*uMaOXlBr}i#2j1wKaxWX@GM(S zey$cfGqH?Y^3APC4fB;UJKJ7iF`Tu}TRcv0Hc;O{BhD~a>|Jma4Y$*GIckd(8^6e# zTf~oid&2jChe#|oreB}B6~*q0F@NFm`S&)PV32h%QyDDHcQ7!TNr0(QQlw7LS{fUB zWjPkqE#jj#x;)OlrtMl!Mnk?jJpKPtNyso5VD3sslaH=ulSXA2<5AEiz)({duWf<| zI$HdJ@#YoLHRBxq?p-D57O{%8TREkl2P00tU6 z8{A#5Qn`ZtK0R?Ea?C?Xwc0mzRi9MUru%~FPIhI1-)^4=wJte{5TZ4i zwe0+>uoDTwseDvLtD`PJ9@RyYAyqcc`!<>42f2r1lf7dT+W`x^@L`0ENcEwly07rk z8_>e@BLGOFBXr&l`0x_ie-<-&Tu?d&O9ooAdsw4lU*kCrr2t;lI?YIv%21B+6c$6x zLL3}}uZUhhMC&Zp|M1#jKFK{^a{!^s*|QilI48{i9&{_#{s^%j0wQI9!5Np*XGNZR z_lg1SCZ#s1FD&Fg*xVu+6n57Z&&!#(?|conNj&7pQke6>8eKa)0H#6En($4I&aT4Y z2z6y%2!ZIbfWASdb>sUgw4l71ib_m*R!E8sWvc>_D)GVIh5~Z$f1qxJF@wkxx)CGw z$7w@J8^6cEH3u-`UNPlYnX8)%B2zPo&m`c2Bs$Oe>ml{I;^gZ;4qXg?OcMJQixy@Q zRUaz?+%OQM_zaVX6Bu`DKgxtEp7Kw|*_Aff{Zc?ef~;EZ09~59HuF7fy7b_4k-0w~aU?nwYjP@x|U4Z&ZQ$3-sCQXr3QFuqG?+1g9)T z?aD?xc4N6{AZGrx1swB(P1EtNoy^s<)bia8LVo;`yiRsnq4q%9myayk*Ni1rSwKr} zo9A9H@UKEN#}1eO6YzD1YqWS&xcCf7r>yHR@U|fHboS~eBNjN0+rMQM<|1^azei&I z<%!tZ8wl*Fz-pyG})d|T~qT{lOaVwa~DE5XL3Md%Wb=u-YH9CN`oE~Czm zEvL%YkCtYiOGlunX|%Afdr&tBJm0fa)IAQv|=hKFklFlnT zOqY-R1SZ{g^EHaFP#Cb0A&(Rvc(#?T0}m(g&aze6GojjV%NX!d7+pz)rN0XN1z5>Y z(AP56IT>GOF!vDJCGb7mIO$h*h`_A1%gLUw)3 z?7jKDkG{|IeO|x*>W@0-bMEsV*LA(G`#!;A%3yDqs!z5^(DNWl;Tnb+sWT&DuTDAV z2S1qN)pdX(YkHUd`+$cN#m1x&+++j$448uGIz9$7i74 z+lqDucIXU>H=#4ssO8#hop$--sb1~)+36bmhV#%9GaW70&{cSXW`&FckS{z(hwW)#AjV>m8lnkE%u=jR-r8 zOJnd}zc_V^H2kz$Pxu7&<#U1<>w$+&mDwS1DpL$bQNtmoD5h0Cekdn|t!2q{fR;{N zXZZd5_=wXQ(Wk>t-3auR9+4KlJW9W`FL~LkY8TVMpw8S)U%5K(JwBtk-ekwD_SEk~ zcSxqs@-`tg&!1$6b0+*Ma-2+pD!Wb_H~gJVEM=Ui8Sep(VD^1zeN6rLD|K75h=J_c z4Wr~2gL`)dHjif=YZh$zYq0UC&6-7gu~jtPb-w&;?0bI+32CpkrgG_a2#`;=%5lB- zYQ*Ea|J|VZBH;%Q28t#_#fBrel@C)+>ifwNH);e+M(J#x7!mVbw-iDW|G+6 z6Zb5A;n^Tt3TbbZv{0$S+ULtvcWG@-W3PB)9&V}2GPjm%x+4^E!gzikWGxtwS;{0e z$&86T@uxjFf?D02iK#ZUjGVq|0_y(2G9Oxc-_ah@rYW@B;#-;7FuIny zpXu}4>iB#0e%LqhW+`#sfE{XCgwAyp$#A0MT zN4nWAb?sp-WlCZ7q(^Gy@#K&=)s>w*!zn+T%6Z`@<=*Re$){Ok$Uk5|ayN}n(xHII zDQ-6Is=XJ1Q)iPLpK$%ae{%A!N}L|0wWdb6)#;v~P#L+vS6@mV zOV(%UE+o7TXij&R5y$oD%!m@9<){H^JK3?+$;@^QX}+v54EuuYk> z26Uw1X9BFrlgjp`9zQN$AOL4CF zIrbb9yToXAIGu7-%=p}#y#7Wfc68t8W18W1yAS321G$;6AsG$v$@i`^PRHEiTO;o} zj{n4u6!wO_I)(ol?r8V+N?;HH{z{wP=$38ftcWZe$e6k2Bt}4;^#^~;FZjvf2fPAG zwrgkBBi9Q_ksM-QLqIZ>}k9tERWqSQAZ&78W|<2^Il`{!tFJR~%3?TYIW+00jg zxs|NsnIA)XVWZCFkkFmk`iVT5%U|EqN~acsNVua&-HH#crc^=9I(XchmGAi-)x zeo64MU&~B zObM}Bmr9~-JB8NBwJXkZxEiv-7ie)y3H9dJez3pYsKlo&Po@q2B1L`9{ug*#XIG%*xeLvl%4M`=d+BXZFGfBl#Q{6oz5VrgEOK~aRc86wy!&>9nG?J zEaqAqk1ka%J&&r`@Fb8n{j@PU-m6!cp^#W5fzu@PCo&@ZD*4->gNhWI&j#Vr(QWMdu(e=g&iGo`}c0Ht5$gL;~VY!1_d-XS$zx{$a6)YUYYP; zeaWXbe_#Klqfbh)U$2(@`|yc(6-BR*M%Ih_Kcdnw;ZkS9Vy_q`Hc%tYK-v^F$xa!30l=UJy>W*~pIdz}m_(7T@8u9qaA7+KmbK2aQKEr{Zr_EFY$Bd<`?$3b8Pv2@8&?SQBeWXe+wcF|hcpF{i5F zdA$0so;h0nuTv5`lv!U`b}f!Su7At_8>CV@i!s#8ubh*ryhl-WG43GJ-L6?=z-~|a ze%9}`SA{+Yvq8UJeGw;azi1UG%LW&P;`Vdumn&^Td;eVg?$7rR)zioNFvDDHR{Ip z!t(m+(vQ9KJ7;FK{cMU_8KnGO8@>Ki+r6#YbMV)T%@>k1hrKUy`6WYcGpRbU-9wTG zqe0}5PK5r!WbjBzk@nen8~Mit&d#>;hKW<(%5QeRZZ`V#1GDF2ACeR`zIU#g?}g;{ z%eo{snK*XxKExjFukc*AOZu&T!?r<0_kX+qIxM8V^f)Rt z8MRL~eW%`j!V3t{Vmj~t^3#v>MZd~LJUYi7fecFGbJt8iG(tO5q2wsYyi!OfS#o`e z=1cI8%SGCA39Itf6##$UW#WEcXp9I8$6}zgHdexC6zdA zs#O){JLlp)9 zo_mspteBAflJ%e^wzQ&0^5b3a>wja*Wj~@ybXX&dn{PwP^p{li@MJAgW!5)UI|_s4 zgtziT;(kgPSTwON9>lcYb+_E|P5oGuzHfA%;HSpLELkt%G} z9@*G+v7@Wq7T41-=Od=s+eLh1w@eBY1TsGQSTyet2w^URNATcVqTsEse)Pxy+E(9w z?I+w{!kn7J6&uyQ_{Hz`0`SYy+tad5sWKu7De(p>?mw#dSy`HWUl!-2VzP&4&*8@7mHe_XTcC_CFonX+_G}5Hh|t=6 zzIaw7fxZpUHWHo^b%BJION@x19v=Lbj6t?znR}+H4e8p5djGj6nEjc_g?s_bi?9)| z+@+d(rMcU_<`OJ&imfBNUwWDRvl?_hohOM9S|wNe#4ya|yU{oJS*`w=ky8F_wcXOf z@2b}8Nw61a3omEHx+p+7jijWYJmw2Ggupc5H6Mo(PGLzQ>bekdugAi6YdyUbtlP(0 zFKhce?W?hzr3O0U2ABbc&J6H&GyB@Jp9*(Izt%#^4TDgE5vf1Oc`h-M*R z-Y>WP&|E^`&m2nLqvl#J&H69h*JbWZ90x0cZAH@ zkVoFehQpr$@AEirNHO@h%aqOxSIB%*-^Mx2KPjC`&rah@OZMZq@rm!G$jnX$^oJDzdYeED3Qs?^TO z^ZS)U?n8c+qp3f;8pxKd#X3&WEZ2tq&A)!(pAQK*w?baj8b;bz-P^9064vUQdp~OD z996$|yj?3k!)7Fj_mSdXRiM3Iy+=lfZ%%WF`uZ#<>({Wu^F&&6o_I*5RW zj}^zQPxM>UJUC<-at(HZ~+O(deoXyYbQI^2T)j ze7%cLxRY4dTIzhtQOFbbrMq@PMX=6mPY!M?b51yx`=|WC0?@M8&J=TrZnrTW8!?|( z(mpObdE{1U^8J#cbXP#yg7afEe1;w7`s=XFJ_-S05(aP2y(_Y_arC45eHf8d!En{= zxMQcW^+~M~9dotAtz-BB(a~RyH$S*+j~`lF?6W=YZ2Ekjgrr+@C!${cGNsX=i^x}V z{ZnSdY`)eZRYK6Tay|@YQR@zgs5SUUn@ccqi3s!GaH1d$hQLj}<7|eE6nd^htLK`O zBjtx<%Q%LMsFr5k=J0*e@}Fu_cHkkJ_jc)gCT$L`0Ok7koO%Zo%71x_E4}%p{O5(k zbj>XNu8EUKYksu!b~vfI;m?!aL-$9Pt{1Kt#)aAZqA{O8>x*faYwg1B;S<74y8i8; zkoEIN%EtQIw6T4davpb`u*AbwlqK>XnSN(c7(XUE9J{-^s64VKJ|K0_ENVGL$Hd5( zYs|f5eLy40Cj*Riy~y1{ADJ2|>zz7UiBjp-36PgzCJ_ATj!aYZZyBC$uH5?(r4mO~ z_c~3WTSs03z4guKFW~OjmlE|C1eF6qWxN?OwT2QeNt(x+ZTA{MXZG4A-iRm=|FTo2 zb5wc!t9yIG+GyrF+I-~`ch0y8M2lnaUPy{F83K5#aI0Y!rydSS9z^y^8n?WN4~Js>1~@Ct*Hg^9wLVUSt&1B2!6(GcpQJpoTBvFPOQxf3mwmH z@TYB~I~e>@;v~Bo5YVjpxqwCR+ORn?X~uGDZkH($NoDY}GZY~*_I9Y=eWrt!-f$=p zH)YNu|58_F^bmtQ->8T@xPU%uO*^BHmU=>bEH%zVZ|n{K7p?*a&+95ut5o75i+Z2t zbGOxxstRLTerb45E!nOz>;hJ)NRqpD;}!W?5)w-?BP=i5$0oK8?l{snh~%*@x&wg;zb8KM&2Y@d*B5kNBe zcc+lqzjWFzUr0!3&Y8UnL@=i#ag>@Fs{+!g8 zR=&pq+lC_A>|&w)1ld%K57pO0fwVg6;3IyOFj~m;a8U3c!HCbyk${%4FZ4Q~ILl&x z`<5L2T0%9gP>O5gtBM}A%?ZLQkUlg%Ta|HWeay|u6;dQMrR27awX1c$=|p{Z?(!fd zpP}Io^CSd9suUnh*u@Xd#3~Xy-zv(gNG_6H6(e!ixml67G1BX!9(kTLG~f|OJ3EV+ zf=9B5FGu1*%edsjZ*HD}7f5T?oo{>(;Rgl(O#_YZtF17)bABgs2fhwIO_F@8mziMv@OFdIQE^Mn;=xYQTO*H5 zT_>oxfkSZoqS@27rJXd7jfEEdZihaZa{jjwmoL&$F^CcF;&xE79dDW|M|^#U-!(XL zMU0T3=zsZ@K@d(r!1W>N&Tqc~)5uP8>$x-yPBMxpHb{BSw_{oZOSbJKT4zBk&6%}iCCs6)g~NX}5C#JcQ~ zrGw9okLdB=&SadFHlCep%o2ak$9)HdA>beh{|`gEIuR?e`;*x;T3*b|4mX03s~ok$wofnL-uAxFCKfvFR!u>-6nnf# zCsMWFS>@60yq&O<%AN#O7}#V%sdtgDYvW=4cCGu`Oo|g$S^uE=6HZk$k54Il1HDq} z_`S9HW9OZgPZ8E^RVF@%<^+ijLtn))lLH-EQ=FB;c4LdKmAj%GyMi5B5FTmT!UBcE z!83)F+l1~q1mrA~2(8O~IW~%0|6+EGCab6M8RuB{PboZlR!*)f+)%OBE&_bW$DMPw zt2I1p{MaNn*F)Bc+Sa7=4*W=`4XAAqBn&MC-DyQ#p;zLrU^VkemhA#fg*W_n&Bm+~ zE72kU{`erRHy{3ltV6>0_)o02+L;#l#Yk!*>n-PHX>>a4Y#X!8-{u8WjWAW2GnGf%>mV+39 zD6VNfKX(H(2|9>ftcm;j-~VY}=~4V`X_zc(>s9ThaT#)AXL14 zRhz^ABZ~cGV7fF?0?wF_s$4mE?m0&w+(6LdptIGG5OW3 zF;^1=`z#B)YvU8XFv_z}f$>?w@pUm4E6WlBoj>wVeyp0Ntrih?n26fcl=J5DS<0C` z<)>#79nPGc>AY~#ue~efVsB-t^K6x)&z;7VYx9Hq(=(aI!@=#Vcd_luM<9srpwaU3 z!Nb;qveU@+u>UO!0%Jw~s|q59(VS2TE~3Bff19xG-;*Zn#OwV-8m{R7pk(PRWoM_t zg~XR{XFyj^XOh7>IEcFHAI0zUx_O3~U`Ayc>rIjl1R$H3%Dca`)cE1a-dsXr`ViYZ zHjNy{0)26u{#5NF^>bu4j_}M?&A;ur^B)JQ+<0c%3~1ENV#My1-=&((egcH>&b%@R zt02RYS#9Ix6g#|YZM&4Bn_#4muV(m7opVC~ek?EN9sb_PhscN(<%EWL{zL91!UF>q z#-75CqXN6btuUXJN~!Yw-SAni3zvRWw!7UBS`OaNhu1XcMCuFr8;UoTMGPWnEUyu&Z6sfjEV=BR>g~&%G4(&^!x~sY zf6vP9z?pDq%Qd5L8a)k>8z#`-yR zmg9Yp$V&=Dk*NkspsrF6ASI?X3@DMzHZPPbaB+Seiv>_L4{(CjA{OfcmAgrjL|U*0 zR(MK11LjC2a%Cyw46ub6xs*-7bh3ZrqR*TCP&u{ouD-R}+P~*I@6|SBz^>;B47`x_ zEvg2nK1kk^cV}>kybq*h-wVE|?`;h;q0YETdwIy9Honu6^VvkA9W61TAX4U1UB4KM z7S+vH&2(#U9= zcC&es#KV$y2Rg2La`u{-cuf6L$4qZ!{ z1+2ld8AssF6SN)L-*pezS6veW8HC)UEuh?vuK#`cQUacu?ti8=N9YfJ%YV1Lb^dF6<)Noj1or7R2S&!l zOP`gn zvpDs=!$fSb7H@e_EGE-Ck2aSB;#!*&z5CYlwC=f#a!zT|KZ_3c)0lv)WOsoG&G;}7 z4eXP-Q_=1xS9Ml>u@s`1$p}#@Z8Pe>O?&vG{>h@ zv?ni}eTr<0SdH*2^5;dp2QIQf4Ov1@KFu;?#)6cs+duMp2m>B?dud)TVmYSj7%-Em zsS!GeSaNh?i@5JI+57>Jdr0es{HhD$wOs<5OTXPb2aODCR#2HM-zG2=vusLl9|Mk(J zsaEoik94lh`p;x#CGUA~68jEwOU-@`?D(^MyKyG&o)8ipXA1xJ2s$rrPLN&nEEJl? z50d}6@?!3IaNt?;?V3DC+b89Ht3^`!D69K=RZ z+y6@#kACjHmg0kAAgr~6!J3E%=F36AXJeRldr|+DgAQ_JZ0veyehs8_i)aQ6a%M0X zp9=_L8xTbEOlbe_9R)L8KsK_Qk&cHYTa4X$4 z{0010S>55!VXEBE)3ur(mUO%O*WP0W#&Zn~lura-L=JG&@^p;pSrZlzU02J+S+Kz7ycXQdVj;7AYD?X3O%Fe~Dn z*(ot+Us0#dIf(@=dF3DD!gA~Sk7x{!UTj^*cMjUxzk1t&eVTx%RVjol`IX^aXLpx- zx)Q!1^Tufp-X)13<{-{48(pg>N}T2L&J2=iYU7{A$ zt#2akrcWQ=DrbQw%~@?HY-0NM9II-4aLxrl;rR%w4AzE8b5;bN+qq%{(u|~(Yde7z z>%t`St5=tStNJvVC-u>D@)d6tllWS?J>6+ZniZLh2x(vRrxA*4t1dASJ~empPM_ZW z@H-hYv=PJtc3u>~%6JP6*yYH&-Ct<{yxjZb%1E%BtYn5hm62Yl>n3!(KXRW`r=bHw z`LT~aLjxh0EsF}f(4eFpYQ5Zsf1gtG$x{RP2h^4K-0~-l$#93Y@D>*Wo;U42#>M4J}Bg2_lCE}y;s z0cvHSi1I55e$zy(cTvnt%fTPzRT>L&3b~NQQKpgtceKENX+6{XAgvxLw(r}C+c=A| zHIxRcNgMO4aHbB-k9k*LsvG$>l%7Y@?Jx`VxakGa6<^@bkVWwS0U8-Y4ABd|o)>P> zL?x?@zWYQs;dEXwCWM<+jqjjDNP|0BMNBV-(AepLgVO_bCu*P65tJZLt38&ox1?idaJedElZf7UAP4C^z_0sD+h7fnERvu2(mpJb#Ph) zoV^p!_thrZrHv2GlkC(8N;5NSZ_sYCLR8qiW){g1A)!*LM0acd0MDr}t@<+Iv^I^d z&RdIIOx!RCUjvhhMhxmVSQze@#s|N_Y&raGe~|)dT=*W`C-QHJ-uXOI6um&D`JFXY z+N7YJ(;q0CcDieg`eWW%2-ThY(-h2%YaszE6Kj!92vnDk)_Q4}fC2t8e$xXHf2hmw z2s!$m>9UzoC@y{7akCQ?m-*>fKE(|Ali*qA)v<_{F`;F97%t~`+a+Q3K>sLSJ#}z) zrPL}2Yp`*8xUwAYH9W*-?=GT$b-TVvs9Wc|reCm}oZqx5E#y2l4*D!Fcba?2MG@NV z5EUgJP_8@si#^h7kErFcVYZ-%M%8=PhVQbk;3qu$DjJ{Eva(?= z`Qp>ui)-T+3zfhAf~<8}+Wi_JnoL-*p(H8I^Dst+xo{lW;X&6-a>-`9E#hq9W|9O` z!3QvmGNFZ$R&(>tLF_2hNULqgIOK8Z!Pk%zUGz(|HTot-aWH8`0ma)=wN)Yj7SGT_ z;j{h!*_dkOXsbF@>Gwi7v6fRnB>)0JH%Hrkwz=I;il&B_I6F}GhKWu*Gb$jswx+@~ z+lI72Y`+P)bawBL=a?3~Din9}3Vov->dT294Xmk|A_kAmwsh|4dcwF6_`0m@7;KBi zS8Lv{os5ThNurN=-w)$1pZ#1iBvxBU%9ip1x-@gL>J^34lQn*FA(i?|N2wf0gL?~% z(YhVjjX%R3a@gCIAahnM+uqgxCZ+M;y8gE~H_sNUtd0-^&%lT#a`gAvH;?khnZuya zp}%k8Y@UI7xhv0I6gpX-6s6Q&1&fc4Si!+OFt`W|Woit!b$R#%q~kwMP$9$7J4G_< z=Uh2qYO3{g@q4Ks?iD$LtA~+MBLpgJ_v>3|S@ioQgoB!C#Kkzv+nsV@$YY$%+U%jMRsrpfv=9?hJ@u7c(O z$VVEP!O?@5SC$B^)BTIF{ZRRlN6YSoRfPoamTaB@90FyEzpT=`D8RL`g}-%&#{Tew zxmHTE#=Qm4e!eVE_M5Vk1`)p*$TKLBioK@({>3!R=`PeR#4jj$Lb}f|Lj--fY9vAg z9>VboVek-Q)h+Ie-|-)l&}IhP4N1gBK%`vYZd?oIQ^b`91*zR_`vDNo-pwG@N|YTt z=ZKn}0vrUB>%b1jK45qj)7oFvIi1|lYma^6(AXk*@-9#cnzO4^DI%{N2s0_vn-uERWW#of;wK}GgGc}VO zQ@NIk50tb_v%rTY`>pxUg9;N~52Csj`;*lw!Z66a`yKEO{DXH<#UnB#Ol?{meB_YgvbBi2D%tIz* zq-r?-OPJDO;4t^NyT~beQHBa;DKL}3!{n>q&W4GE`wu?8%qkx4=HJFoZCm6+J_6|P z8aw>X2eJx~1GPnvz`A-qq*`dgJMRa+r*a{4oxoX)3%$$J>Lt|j2-45>zhHTktAx;? zi0#MfOXi*+BnO7q^3JT3az=oBE%;XjjEP`&J*{tiUek*(pba9c_1l0bj3 z>$%`7#48TXBGsqh%8utiM*Mx7f7|}dlggj(sjv230ICN|WPlUPVSmU<)7aIl!rx)Z zd09)(R!JckuWPWc64eKxOx(_lGW_@h3m6VvqW%S%nECsVRLgpc=Y#6(EhUKoO&wbI1!u2 zqIu)f4K$2vHA7ZFnhw8l3bjP2C#;4~&`Sp2;&}%6Wjy2mh>W^@{JhsnKjTe+6NJVB z?KXjLKJ~WtRyKgb@YbQN5cN#lP$3NMV*GYroz zlO|8Gix@0nwF&q}KG%{7hpuu)0z&EVYBJAH0P_Qhd$JbYX&*+3nPH^$FPIGWWg6Wr zk|g*g%ZtmW5O6x&S8{q&NMLE>SP+sJ9?(3@ST6%F6K8gTN>5Mw_{sWz%$2xu*Sj+Bw`y3?nN(}04}IA(yfClmQvyGac5eZ86uc1iM=6R&xKAiQxzXWBy0f3d+4${~(I`S>7`TB=V)k zW5M(|&|?LDAH+Xz4mgj5C|4&aasi^t{fA95?)mov zQ|8oA8D+s1c*a*RR;sL}iQS;R4KzShC# zk+!DG(@-mJ?LqNy&EiQ%`>+*FQn&WkJl|cziGuEOqQ1WV7`&;jD}YmVyVZ<7K*M~B zj?BOQ=9t>;TDMq>VabA0opa4NUW2HiieKfej^QYb-f+NwWXwBTyY3UlrgG_>fm&TN@t5`#l!NO0B}%E5CFuD zs{kMZEZyvy-O>h`Cy8rZv-#xnap3LppjG+{2TzL{YimhX1?BRXEoy7-Z3B@?mqDS- zspbL*A_k)=343AF_sD$TWPR3bDnkDg;~HPal#&=lMzAcsSh$(#J<&;vB1$&MzM55C zNhHeoc6`(wnE2dyIvU@qkJPJ9YgNsae)OT1zUgUdr4bB}Hw%{EPd|qziWzxivqYAB z>kv9(K{g8l&eDPT-CRGwKW0zbuJK6{=Z(Lw=hbsv3cfgLpKu1N(nI7#)Q52B%PfKN z-}ltk)7|WelOt9YuS&k3Gr6VwZN-JvG$&NVY>mZROP(Hu!h8aywJe&2FfLD^=!6z} z^MmRDX#~jdVoodHi5IxWPWQepT6wglVBR$qI&@fK(yil}W^Jq=iv?2*ZO}-IryRXd z5%aKR)Vo_pD{t-@m>*@EvmHY;YVM6 z0GI|d}_E=LQ8i_^^{Th!RTW% zNTZOoZ6yo9wEat5*_fmfwTEY~fXt*ois)B&fa7OUS(LJgPXmL1yWZsrfBDZepGU2~ z?Xj}hTVQg74W6!^B>ostkZ2H?duX~?M7aKHoX$;ufy#aebJtUzl8=_c$}N{q?jIwfDqax4G$ehv z`4(*XK>JWvY`DWyzbBb%J?Lzrs<*b}@kt*{FBD+nlQ<H6sC9~=Ysl)MynXmTOfGC3j|Wq$Kp?>~t?cCX%_7(R zRU)Ankp3T!+tX8X&aE+mZOsdlKMH3>#!P6E^>l`@)d00^v_it(=I{_%9Papl(nzhT zqW&9Gs5EdQe;J{0>P=Hy?PNB?@MHeBkSA{!!5MV=+%*J-qN#mLAO2JbNEUwgLl~JM z$ttaFiVzkDT3V*F!}%9+V6wAURnLmzo2Fkm`e5-nwhUuGzwc+V@W5PxP(JFG_U2+^3n8q$OZBR*x9ojhP=pOb*VY3+Ks^Q@bb_XPS`l=q-Iq|!u1T)l zrv^D!4xNGKn%^L@=<8E6XcZ0bQNw%EwW{2u5w=I^GT1Jtbk|@N1J6aR+ z;9`V=w~)pUu`sbs!Tw1H)uEex_$M$7}lnXm|A}&F55tBYF z|Mq=H9_@u5ZFzpF__CA4|J^WjYA1*=Vha|wKK;V0dQ5^*!-W8$OXGR_ia^!z@ zwg5>LWDd(_p?OEBXsFvybx{xlRSy45&wLHq2){V*w~HU5nEz>#cnrR=gZo3fhl;)$ zAP@NYPda7`{=4>n+u>(BahPM+l432xZ^{?5$e(3}L7tdp*m+B(sCcKAxfo~P4sEjjP| zORV>&)KxTQWq+g5R?J@z`GMhS2&;_hXvNt5vl){<|TMD+&E0LLgx6QFG6_LeQKb56DbMBhw zemfZgJ2Vn?mC=Y*gbm2lMA~`-0kd5GCBmjjP|Sh`gUPTeaqc1`kCw<1nJ2ie+Q9%4 zOT=A*pH)ohgwz>PQoqHs=eqhFt=X{EsO?H3=n_vk#;vpZ6iCbbqXMcjr~5jxR`(a5 z39DsT*HWsICBEzfwVwn@%5Dt_3qkDHAJ-0ZgAYS~NkZUC?L#0cQ0mObU4|N`u`aBF zFm2=0>?QWJiB<}QnEe5_fgo?U+2e-)`U-1Z*uuODcf_C8M3sgn}g(8$xz(;`A0jAH;I zi0cmi>`knIGUw0x&-6n?$z})LvN#>xRA*0|IRkcwRm z33VJIo1!-pBVShiI0Z@$eR6JVn^F*t{kqEW$!tOPJzi^;12`4@8dyc6QFAYv0R|92 zE+Dj07LlFo`$9$8q`Izyu21^!D%I*w zhId#08Nx3oakZT#Cd9MP=MKLe0tX->TG55@0Dzv0^HcNALSOCPFjjMlMX!HWnoYs^ zWc70Zz+s=Kql&mh2Q&rO4>YFNb7lxG;G_Hry^Ep#ewUCcA54Mx#0PA$h~t0TFOVPo zbH82*b~{M?{3%65&nm{nF9^OL4RRrj>^@95<~GIt@kRm!td-i6)~qPzQytPVZ@)T}>fwQKObl1v z3k0VTI!Ihv8QQ^uZ}3IFT>sBvH8WtG++^U=&s-bl$YD=m^hFC~=b*s(M5Sju?;Yfv*KJQ3kGqt( zN|7W_8H0?AoW=8Upj~DUk2|>!Xa;6N&4Ya!VU}PeJpS2Z?jWL%{Ou%%l?D`}2e#Jw zT@zmS=Ed0D^mSwn8eSDja$iE!cgS|+-$!yo#8fx>}~=0^fw=G6a)-U+tiNhRuLhpe!inK033-(*SQr_Vp#GY?Je zq;-avt9UV|X~(2Qy@8Ds?=sr|%!IWi`enw%^#w+r1!L(eC`Z?G)0mmKMe*t~xp7WJ z;3L=uvAa~r*+P6#mXHW8AqIld1OrISybxyw^WdR zsMH~BiUHF?;m%+{MG-FYDg6mxHz=m+b;H1eJ8SWCU=)OeGgE_`X$_Qd+0L$$QKWrx zC#Pf(NRoB0ooT$XXut{3}Isl^#>O3J7+*Rj9vGK{ASZ>b+ zb*wRtzQ7=keDH+;8F0mrLq2buo#QBI3hKdSG%y~v zzsjYjq4xbrL zOFz`ipXEBrn0uxp+6S^4h-S%VrjK0@S<&$XEE^OG=>C7#LxdHh-LdJsd#3CwK#EAK zyQgOh9msco(Ob-_%ER?=8ur3WQo(Y+<>q6Y-0Z!Lu+9gc*fo7j#$7mh;&(+~Q)WB- z>;4qr*tw$y_@5nwkueHV>W$n|73BVX-SOc=8QBfTKM%eIt!pC1&esc229w zzl-)?v_hgm&tuep(*p5O9t)Z@R(RwkGIC1rzGbT^KG^sb<&IR~vu#OM?~Cd9+1eQX zA_h02gy7HHQxpC;cPsE4%_yOHud$%(pD{3BvwHiQFMP(k1RYv_A9fLmsirQECjcUh zYCVi=-2U}uUVQlPc*B4IXu?c$7M!!DNuG1neu`7DA0Cr`JPMs-n~Lsun(p|g)Ny+4 zUiI;B3puKg0BofjDv@ie$JKHa8Gc)I29>Z|9Wu((uU(`&2%KXa{_`XC1fEB3rd}`! z!G)NEP2`s@$KRzGiJ62raJPa1^DsA%(ck^|)?&ck6%!)`E@L>{eCcpAV)d2J`ms0M zZS8osTlFzeajg4tGl#i<85wIC6;OW}Z|P^D;!3u9Rj17`93X&`>nt(>)y zS%O+uuQVu>Y4D$9ZUx1MBw`O8DEye}d^pKbBZ;(>>KUb$M_a*y&vGpy#{3zM$(=OD0hYK zzT!F{c^oso-{P}f>($jSxVAa}n?vCm_BRrBX;Ej!D+1q<3GaRI^X=ntX@X@Yyv1T#eiRTq`8_+7oN}1`oHm?#M|9WXz5}ZRnMVA?Hfc8tgZ+9$4=YC z#|Kiv*LkaDxrrW6Ff)ez)SAH>EEKPqr6o_Ex+BvV)C)GupRjzB5&z4BTe_dX42+ft zOa4wM#~-pOm~WoLkoH$t!G+8|~2|KJ)KwF>B}ai~<* z+!Ao{h*~VW(Py1!T+A?f%du8SltDN1>y2>P4Gq*S|Az^V{-B~rMj5T+O(%_;fZ5+W zLcNz@RColP3T&=F*W?e_vgESoo+*gJ#OOq<9Q}f~@ioaWr`}b)gaSAN1;YKW zhFAQW_r_Cjg>%U@aksfj(P4*2pT8TKf_7DsZgucFa^Ro5fACUy%H$6mcI5XT@c3+1 zXEk@p9DdV++oaWJ<&IHiIp!-*I@jeryEX-;3a3-(2$k19 z-a)%E;mny`E>;My?-MH!U{?p}RnIMsedaf3gXWmCv1f@fI-d16d*xr26PeU34xd#! z4I8FY8Ssz?bkXBfeBRH&N)J=~G?_AeBlJv`lX+?zNx7GgnrL4NH<+Tq!`%%0O3CT| z84s4VH@n9c%Qf{QWvz$LYWdSkbZza142yrxk9h>qWNMS1CV2Kz=L&w{sYh}eB~I< zAp1@s&Li;U+;9M`+=;Vm#$fWag1=1rLoaL|&Z*Nr2uAe2xOXzm819G}= zZwil*lx1#ZwfR%M<(E}Q=fd5)?p#6p{R|7?!8oU+Gw-&&D!rVr&sfRauppv0F32lz zLpJfA_5%YC`0x%>!Z6-~%QH1aTx^q4!dw~|S*=h4%z1Ar?Yjp@9^27zJ6Xdo#4yPD ztS@b?lXs3~mT!G{r)VG(S9L~AF}rR7eW*9qLhVt)F73~pMYd@y!-a+NZ*agjx!+v* ztK565@#9(f#;-=owm4Pvr0TeV!S$cmf85z0-Co+#(7Ba8+0#pE@kAaukI&cZOr9Ys zyV21?k(iuvh}E2-74XR9T%^OBbMlQ?*hN+fmQQnH;RAyrY=Ii@{mE`e%I=2=kg7km zVvK!>hxnGKkM%LxX;E!N&=7nNZ;YK|#7JhYV!sSj%yyeS$~E$t6?1QpxVZPpbYz17 zxpBYrQ*gist}QZWnj)XA-pyp$?+!M~?g$|f&Z%=PBGSepp`$gaegSy?Y~$B|lFt2p z*EmX>>rZ3#$7Ni zTWAu$gq*TibbL|eFgs{-QHz8nJ1;dTfb&ifnE#@HvP#ETL1vAKM~=U(_*&{zsLU4I%fUaVxTh*Z5p?6>h zA|Lr`a!I$kI6B}deq+KAp80y8BL_L7u3C(6;>@e^v#@Zyd87JwWQD|+@2B&1=s)^9 zw?xH~7V@!GT@e>Srb7vpdw-@)O=bQ+y50h+>Lz*{Jt_#&As`{$-JJr`AT2H3Ak85a z1r9CUAYB5|4bt5p-6h>!cXXOFX}s*|YbvpZ)9^$ld6;2>o!JXru$| zS8_GW-K5(A{g9H9jN){4Ge3B&FCVL1XPm`iYs_nY_HCbz_g=Ln`OOI8DDL6?Z!G}J zfGIEyKZo-!0w{miuIF0C&%QJV{pyhdoV&UiZmGMHRy2GizcrAjC?1BJ-E$H&tFatKip5828O5FrIt@G z5cc%CHw$x7pq~Hy6h})g1o@H>la^F#qZn34l!+0&)s{y|#h4nQ z0xr~I4b){l$5Jj=%o+}^L3cwW={`w*nns9&XqE=E-Us(}cPBmZ%Mlo#kovB>EJg>% zd8&QOl=HuYf-0x{T;0c8nuFttxg`)u_KkD1Xp*|A z8NlXsUme4Gg;`-Ffyq$eU1_MZq3V-?SJ@uo*5iz z2bVK$wUMwW=Ok0)5ON`0aJb>j+DD%XB+0H;d+_9G56a~9Qou|-#PU{%1;ixKFyi6F z1YMffM#`xD{VL|*jjdbayF#98(K{VCK8N~bT$*jt&8@5{1V->gs*c9`PhN*uBaf?8 zE=Is3zK(MEvb;a7cDs|t0WRuztgDsjQYgN+)f1PfG?c7UX_fQ<=fy)R@-hlE7xNh< z+0h=XY__8*$uomhz^u~ZM2XJJ)xdh5t^S$*zR@&Zj1ZBC)-=U=pvKbK;Lr7pk_;(a zuPNJkxYgqk-GQ#Y+^%lLx7it)Q0a0{Jev$30dX-i$IhZMXSj zm+%Z1=uVOFj{45`LDI{*kt4gFuu17?Ffr(#QbLb zdP{V{QCsh^BJ&uNOcO-65KDlWnX?}prvxr?D9CF^yCi*4L|T>PV#x6W zE!eCRYr9X$Nf2N-Qc9e@$H(y!+elw)+i{xlVqcrV5vY`E>t-&0TvY9K^c}ix)zKiw z4IDYCkr#%zR~nBCUawxCd%Hvu%OO^}pmNoqV~pP5Y{*jm=WL0_=D9yroPrw)0#xWR zzI1I0lgrAD=H^j9IS5L@26~k;ceSu*z-tMx9thyJlz)*e=m91pdHS4I;b3oeuqwUY z)A)1ubKO^9f$@8%@`g(LXfm^CbOPQFL=q3lH(g)ALto^8TTwri6!0kE;g@p%qY%J? zk@=BwyP;qyQ-OH@8dfOCU-p+zJpBXG7>bKW09OAty&N1$>!-MsF2;JZz zi^_CLa&-?WN(-R;JS;ynA8gnTFD}B_n*rCdN3V>fNY|Qu2jkc@%ZtG=y;<_{QD1z#Yti{|fYS!o%lk(j+$Dc) z_cLHqm`^KQ*%MtUUS*~+m%W_gDLk1rk`n0L1mzc^^xMCKtow3<0OiNGhViV7olZcb z>lLfH_t}eGVQ-~RRE^&la>#XB+Lrw216F^Lcx`ZpY2%;OK^nz@b9_E!R}jl%XWRGL}R`9#12n3B6|HKN(a z^B5({4f6QpjKYG)Y{VUKG2il9r6g3o_u&1yy-iZYbB-}uNJTXZr=A@M&iG_4f)k6G z8YyA?&mFaNg~*j^#+XUDQnI>rDC80~=C{}SAB#ywU)z6D*5cYrfTfp zbbteqkc+;turuq_)pi)a)eO_V?$ER=?x<&B)dA4x`v6z+CT8T|(4oK>0NHS6ODivB z$jN8RbLl|{0>)=Mxc^OqP)TBP15EBS3!5DZ@_>wT@&ORxFnG#p8HrfT-6!tq?3+HX zyPujjU)Y!rOZVI&BnaS6zP{Vjam%G{h`CNn;}ni2Ut_P5Ewd4e>{rb3^Sle;VJb|t z+=4uuD)S*i?rMxx_wCc5au^+{x5EpcC;h;BLL6gC)f}zkvtqz8vIBg0NgnHA^ztA4 zM0+OHPR=cZwC5cW4Drm%YUSNsaonaxKb&*3oB8}}Nw?pALz$WOPU9B-cYB zAVnAw5ILPR_q`|vRIh0@jrWbzw7BLzKQoYnZ4@B zK5u>WY0fB^GHr3n6-=fctbWKiUQu>>T<$o^hgz68T9};twZN$6eNyU3CJI%gK zW71gkd=Yovq#Gb&JD|!PGAS% z?(WLay&iN}dU#AQl&i=%FQ-kjsp4==dqga}chbVjT(*QdP#f8veIE;m-QX|wXtPeZv5Gs)u?3k5`kBozf4TK5~z4+M3>|t5%*QQ1poe4i; zOKvxeNv@{jAI27d`l6q3BO|{GiM1R4EqLe)miu9mAud;g zf>zbxw;s1b(JHO?n++r=b~dgJq_R=E8Mm@;0%ocnQ!af1x(5~sEhc2)yHETAu~yJD zloA^%ehlE(eB6s#&x($rB*BZwqzwyI;5)>Bn@sRFnY~KC(A}wB9l7}|@vZO>+$b3p z-%5ni;%!3<@r0#%KW@OUA44bblKm}iZuuTB5T8EfVdi)t$-}gIBr&`w?8)<&Npito-%JdpMLrV!@;z#1TBN~~m~U=J z1&R0`0A`WI;A${YI9-dRlAy1I^{u{{v;ebVDf7t|i1H2=d=!LPuAO%gvs84Z24$Wd z6#TW_6=FQ#F)e$%?xZMA6=&N2rq@J4Jif1(SA`&Cq(#l4H#IJ@nKL-jlO1nvS}##W zfgi8gIFTOFQ3k=(WEG255}3HfY8h!ui_bJBB&&bY z4_mF#4E&`FSr9aJQd;-cP(9u{zmf0SZ#>#b8y^z$Emu@cN!M3NP)=<=Z>?8)0*1^`VCEwO317ScEAMGogLl z!j`G5IyBTw(PlcfrfHXoFYl$hoV=*k0C-_OT>@F3IkR(W-N?rDX{5kkue}$$UTMgX zKNL^cpvHK-QKb2^bd<$bbG?OP7dnw`OpCeA`~MiA=qC`0@5s7_a<>Isy;B#N*XG1` z2Q7^8E=?Aua~fR0E_NqV1fpgkvIJQwh=1jrDk{Fqk z5L+TAH))o=&8~v2s*1%v?kp@oHzKudUrE$Wz0LV-<9wr23y?hZE6S&TmODoNnJoRe zTJAAgG~k}bRy>gJ4oE2u0Z7Vwz$9P;@qNKVgA&I^EVQc6D*^e8vAFku(sVjH74 zu~~}TR-q@<%yMQ6vQ(B zE>Ww()$-9gkI$8rsg`S%n1N{zU7wQqv9bH~)twAWZI$b@ zHiW}jh#|mav*TL=@M81#8uz#My13gb?yUUWE}12%Fx+8=KkU>X&o6DhkM>2?(>)7a zn~w4ewGvk})lyW~Qk1lGZ7R_8DXiBesbhP$$5wrY8L85Wvyu0dgQssUgC!Cj@4AoZ zG?h~1^px)kDHYu2rQ*vFO;0LSsyg*kX@zbRP14=R{2Hg+-D=g=1$R&5vuk+D2wNuPJR2N;5^>fd2$24AFb`vsK~>OU9@AfayqT1 z@?#_MsXCGXAwf=0H*k~|^Gx&#jvxekRDee3pxHF%)~AjrP&)_kjSPKqEZ}`;n6^iO zX+R-arpZ2`ZrFFP5Ph*cGs`o($vQvBDIdHSJJq@^s|Z~__byb~Uh}R6!TLG_+UI(r z+uiFlE(QhLrZISa*vCXpUs1NFo22yJ)p)9trgSeE`4gD*S1i)6nLpahKn9>cS7X?1 zUouWt7C>u-BKrTK7Cz6^SJ#(h%&n>Vk%oustnb_39jV8e$|A8B_Bj@!@TtG_mXyKu zb3C$epAh6^myw7CuycjYoF=sYE|Hs9f>BW-Z`e&yYws1o)aAvboLu_jWcT?@FKs!< z;Np4*6~RlZEPuLeT+q~dpU7(ajg2MA1fYvu$38olB1Ql{6TR8`ZYihA)nkZ814`QY?l2W@J$>wrnVa_ z>5DY7QNwY-DOaHa!n(1!G#vIZj&5i;pM71oq0V*2FY_qkwNZfajUn_YB}PPK#-$+_ zU?CEj1KCrnX^UdfUrTR