From 3e670bfbb3806090234f10afb3c92dd6c5dec835 Mon Sep 17 00:00:00 2001 From: schochastics Date: Tue, 29 Apr 2025 16:49:39 +0200 Subject: [PATCH 1/9] replaced [x] with [[x]] --- R/netzschleuder.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/netzschleuder.R b/R/netzschleuder.R index 2033701..38a08fe 100644 --- a/R/netzschleuder.R +++ b/R/netzschleuder.R @@ -195,7 +195,7 @@ ns_df <- function(name, token = NULL, size_limit = 1) { nodes_df_raw <- utils::read.csv(unz(temp, node_file_name)) #suppress warning if no character columns found nodes_df <- suppressWarnings(minty::type_convert(nodes_df_raw)) - names(nodes_df)[1] <- "id" + names(nodes_df)[[1]] <- "id" # netzschleuder uses 0-indexing, igraph uses 1-indexing nodes_df[["id"]] <- nodes_df[["id"]] + 1L From ab13e18e596f08cbc095e0b38b5aafaccda5284a Mon Sep 17 00:00:00 2001 From: schochastics Date: Tue, 29 Apr 2025 17:30:05 +0200 Subject: [PATCH 2/9] properly close unz connections --- R/netzschleuder.R | 13 ++++++++++--- 1 file changed, 10 insertions(+), 3 deletions(-) diff --git a/R/netzschleuder.R b/R/netzschleuder.R index 38a08fe..2022f8a 100644 --- a/R/netzschleuder.R +++ b/R/netzschleuder.R @@ -182,7 +182,8 @@ ns_df <- function(name, token = NULL, size_limit = 1) { node_file_name <- grep("node", zip_contents$Name, value = TRUE) gprops_file_name <- grep("gprops", zip_contents$Name, value = TRUE) - edges_df_raw <- utils::read.csv(unz(temp, edge_file_name)) + con_edge <- unz(temp, edge_file_name) + edges_df_raw <- utils::read.csv(con_edge) edges_df <- suppressWarnings(minty::type_convert(edges_df_raw)) source_loc <- grep("source", names(edges_df)) target_loc <- grep("target", names(edges_df)) @@ -192,7 +193,9 @@ ns_df <- function(name, token = NULL, size_limit = 1) { edges_df[["from"]] <- edges_df[["from"]] + 1L edges_df[["to"]] <- edges_df[["to"]] + 1L - nodes_df_raw <- utils::read.csv(unz(temp, node_file_name)) + con_nodes <- unz(temp, node_file_name) + nodes_df_raw <- utils::read.csv(con_nodes) + #suppress warning if no character columns found nodes_df <- suppressWarnings(minty::type_convert(nodes_df_raw)) names(nodes_df)[[1]] <- "id" @@ -210,8 +213,12 @@ ns_df <- function(name, token = NULL, size_limit = 1) { nodes_df[["y"]] <- mat[2, ] } - gprops_df <- readLines(unz(temp, gprops_file_name)) + con_gprops <- unz(temp, gprops_file_name) + gprops_df <- readLines(con_gprops) + on.exit(close(con_edge)) + on.exit(close(con_nodes)) + on.exit(close(con_gprops)) on.exit(unlink(temp)) list(nodes = nodes_df, edges = edges_df, gprops = gprops_df, meta = meta) From 47fc1cf21183f06a835b510e58af257f364a327d Mon Sep 17 00:00:00 2001 From: schochastics Date: Tue, 29 Apr 2025 17:31:57 +0200 Subject: [PATCH 3/9] named return of resolve_names --- R/netzschleuder.R | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/R/netzschleuder.R b/R/netzschleuder.R index 2022f8a..5447be2 100644 --- a/R/netzschleuder.R +++ b/R/netzschleuder.R @@ -40,16 +40,17 @@ resolve_name <- function(x) { x <- sub("//", "/", x) if (grepl("/", x)) { - x_split <- strsplit(x, "/", fixed = TRUE)[[1]] - if (length(x_split) > 2) { + res_names <- strsplit(x, "/", fixed = TRUE)[[1]] + if (length(res_names) > 2) { cli::cli_abort( - "{.arg name} has {length(x_split)} components instead of 2." + "{.arg name} has {length(res_names)} components instead of 2." ) } - return(x_split) } else { - c(x, x) + res_names <- c(x, x) } + names(res_names) <- c("collection", "network") + res_names } download_file <- function(zip_url, token = NULL, file, size_limit) { From 0f9dcc43f0c9e62d95071bed45627742f73da4eb Mon Sep 17 00:00:00 2001 From: schochastics Date: Tue, 29 Apr 2025 18:33:35 +0200 Subject: [PATCH 4/9] refer to named resolved names --- R/netzschleuder.R | 24 ++++++++++++++---------- 1 file changed, 14 insertions(+), 10 deletions(-) diff --git a/R/netzschleuder.R b/R/netzschleuder.R index 5447be2..8017090 100644 --- a/R/netzschleuder.R +++ b/R/netzschleuder.R @@ -43,7 +43,7 @@ resolve_name <- function(x) { res_names <- strsplit(x, "/", fixed = TRUE)[[1]] if (length(res_names) > 2) { cli::cli_abort( - "{.arg name} has {length(res_names)} components instead of 2." + "{.arg name} is not correctly formatted." ) } } else { @@ -110,17 +110,20 @@ download_file <- function(zip_url, token = NULL, file, size_limit) { ns_metadata <- function(name, collection = FALSE) { rlang::check_installed("cli") net_ident <- resolve_name(name) - path <- sprintf("api/net/%s", net_ident[[1]]) - collection_url <- sprintf("https://networks.skewed.de/net/%s", net_ident[[1]]) + path <- sprintf("api/net/%s", net_ident[["collection"]]) + collection_url <- sprintf( + "https://networks.skewed.de/net/%s", + net_ident[["collection"]] + ) resp <- make_request(path) raw <- httr2::resp_body_json(resp) class(raw) <- c("ns_meta", class(raw)) raw[["is_collection"]] <- collection - raw[["collection_name"]] <- net_ident[[1]] + raw[["collection_name"]] <- net_ident[["collection"]] if (collection) { return(raw) } else if ( - net_ident[[1]] == net_ident[[2]] && + net_ident[["collection"]] == net_ident[["network"]] && length(unlist(raw$nets)) > 1 && !collection ) { @@ -130,10 +133,10 @@ ns_metadata <- function(name, collection = FALSE) { "i" = "see {.url {collection_url}}" ) ) - } else if (net_ident[[1]] == net_ident[[2]]) { + } else if (net_ident[["collection"]] == net_ident[["network"]]) { return(raw) } else { - idx <- which(unlist(raw[["nets"]]) == net_ident[[2]]) + idx <- which(unlist(raw[["nets"]]) == net_ident[["network"]]) if (length(idx) == 0) { cli::cli_abort( c( @@ -142,7 +145,7 @@ ns_metadata <- function(name, collection = FALSE) { ) ) } - raw[["analyses"]] <- raw[["analyses"]][[net_ident[[2]]]] + raw[["analyses"]] <- raw[["analyses"]][[net_ident[["network"]]]] raw[["nets"]] <- raw[["nets"]][idx] raw } @@ -164,14 +167,15 @@ ns_df <- function(name, token = NULL, size_limit = 1) { } meta <- name net_ident <- c(meta[["collection_name"]], meta[["nets"]]) + names(net_ident) <- c("collection", "network") } else { cli::cli_abort("{.arg name} must be a string or a `ns_meta` object.") } zip_url <- sprintf( "net/%s/files/%s.csv.zip", - net_ident[[1]], - net_ident[[2]] + net_ident[["collection"]], + net_ident[["network"]] ) temp <- tempfile(fileext = "zip") From 51c08086ab5e0c624dd5d703497a515ae66c0e0b Mon Sep 17 00:00:00 2001 From: David Schoch Date: Sat, 24 May 2025 20:54:54 +0200 Subject: [PATCH 5/9] Apply suggestions from code review MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Co-authored-by: Maëlle Salmon --- R/netzschleuder.R | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/R/netzschleuder.R b/R/netzschleuder.R index 8017090..0a3dd8f 100644 --- a/R/netzschleuder.R +++ b/R/netzschleuder.R @@ -41,7 +41,8 @@ resolve_name <- function(x) { if (grepl("/", x)) { res_names <- strsplit(x, "/", fixed = TRUE)[[1]] - if (length(res_names) > 2) { + bad_names_format <- (length(res_names) > 2) + if (bad_names_format) { cli::cli_abort( "{.arg name} is not correctly formatted." ) @@ -49,8 +50,7 @@ resolve_name <- function(x) { } else { res_names <- c(x, x) } - names(res_names) <- c("collection", "network") - res_names + rlang::set_names(res_names, c("collection", "network")) } download_file <- function(zip_url, token = NULL, file, size_limit) { From dd8bd49c6227202e507eaed7a611c7cc5c195d4e Mon Sep 17 00:00:00 2001 From: schochastics Date: Sat, 31 May 2025 20:28:55 +0200 Subject: [PATCH 6/9] review changes --- R/netzschleuder.R | 44 +++++++++++++++++++++++++++----------------- 1 file changed, 27 insertions(+), 17 deletions(-) diff --git a/R/netzschleuder.R b/R/netzschleuder.R index 0a3dd8f..c6d03c4 100644 --- a/R/netzschleuder.R +++ b/R/netzschleuder.R @@ -41,7 +41,7 @@ resolve_name <- function(x) { if (grepl("/", x)) { res_names <- strsplit(x, "/", fixed = TRUE)[[1]] - bad_names_format <- (length(res_names) > 2) + bad_names_format <- (length(res_names) > 2) if (bad_names_format) { cli::cli_abort( "{.arg name} is not correctly formatted." @@ -122,7 +122,10 @@ ns_metadata <- function(name, collection = FALSE) { raw[["collection_name"]] <- net_ident[["collection"]] if (collection) { return(raw) - } else if ( + } + + # Check if collection equals network and multiple nets exist + if ( net_ident[["collection"]] == net_ident[["network"]] && length(unlist(raw$nets)) > 1 && !collection @@ -133,22 +136,27 @@ ns_metadata <- function(name, collection = FALSE) { "i" = "see {.url {collection_url}}" ) ) - } else if (net_ident[["collection"]] == net_ident[["network"]]) { + } + + # If collection equals network + if (net_ident[["collection"]] == net_ident[["network"]]) { return(raw) - } else { - idx <- which(unlist(raw[["nets"]]) == net_ident[["network"]]) - if (length(idx) == 0) { - cli::cli_abort( - c( - "{net_ident[[2]]} is not part of the collection {net_ident[[1]]}.", - "i" = "see {.url {collection_url}}" - ) + } + + # Find matching network + idx <- which(unlist(raw[["nets"]]) == net_ident[["network"]]) + if (length(idx) == 0) { + cli::cli_abort( + c( + "{net_ident[[2]]} is not part of the collection {net_ident[[1]]}.", + "i" = "see {.url {collection_url}}" ) - } - raw[["analyses"]] <- raw[["analyses"]][[net_ident[["network"]]]] - raw[["nets"]] <- raw[["nets"]][idx] - raw + ) } + + raw[["analyses"]] <- raw[["analyses"]][[net_ident[["network"]]]] + raw[["nets"]] <- raw[["nets"]][idx] + raw } #' @rdname netzschleuder @@ -166,8 +174,10 @@ ns_df <- function(name, token = NULL, size_limit = 1) { )) } meta <- name - net_ident <- c(meta[["collection_name"]], meta[["nets"]]) - names(net_ident) <- c("collection", "network") + net_ident <- c( + collection = meta[["collection_name"]], + network = meta[["nets"]] + ) } else { cli::cli_abort("{.arg name} must be a string or a `ns_meta` object.") } From 229c7560f286db7a9b775fd9d6e3623c8b0cc177 Mon Sep 17 00:00:00 2001 From: schochastics Date: Sun, 1 Jun 2025 20:04:05 +0200 Subject: [PATCH 7/9] use path argument of req_perform --- R/netzschleuder.R | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/R/netzschleuder.R b/R/netzschleuder.R index c6d03c4..279a90e 100644 --- a/R/netzschleuder.R +++ b/R/netzschleuder.R @@ -13,7 +13,7 @@ get_base_req <- function() { .pkg_env$base_req } -make_request <- function(path, token = NULL, method = "GET") { +make_request <- function(path, token = NULL, method = "GET", file = NULL) { rlang::check_installed("httr2") req <- httr2::req_url_path(get_base_req(), path) req <- httr2::req_method(req, method) @@ -24,7 +24,7 @@ make_request <- function(path, token = NULL, method = "GET") { req <- httr2::req_headers(req, `WWW-Authenticate` = token) } - resp <- httr2::req_perform(req) + resp <- httr2::req_perform(req, path = file) if (httr2::resp_status(resp) != 200) { stop("Failed to download file. Status: ", httr2::resp_status(resp)) @@ -63,8 +63,8 @@ download_file <- function(zip_url, token = NULL, file, size_limit) { "i" = "To download the file, set {.arg size_limit} to a value greater than {gb_size}" )) } - resp <- make_request(zip_url, token, method = "GET") - writeBin(httr2::resp_body_raw(resp), file) + resp <- make_request(zip_url, token, method = "GET", file = file) + # writeBin(httr2::resp_body_raw(resp), file) invisible(NULL) } From 485eb7fdbaad09bfef03f1315dce6d05f6c52af4 Mon Sep 17 00:00:00 2001 From: schochastics Date: Sun, 1 Jun 2025 20:06:11 +0200 Subject: [PATCH 8/9] moved on.exit comands --- R/netzschleuder.R | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/R/netzschleuder.R b/R/netzschleuder.R index 279a90e..f6b07d2 100644 --- a/R/netzschleuder.R +++ b/R/netzschleuder.R @@ -189,6 +189,7 @@ ns_df <- function(name, token = NULL, size_limit = 1) { ) temp <- tempfile(fileext = "zip") + on.exit(unlink(temp)) download_file(zip_url, token = token, file = temp, size_limit = size_limit) zip_contents <- utils::unzip(temp, list = TRUE) @@ -198,6 +199,7 @@ ns_df <- function(name, token = NULL, size_limit = 1) { gprops_file_name <- grep("gprops", zip_contents$Name, value = TRUE) con_edge <- unz(temp, edge_file_name) + on.exit(close(con_edge)) edges_df_raw <- utils::read.csv(con_edge) edges_df <- suppressWarnings(minty::type_convert(edges_df_raw)) source_loc <- grep("source", names(edges_df)) @@ -209,6 +211,7 @@ ns_df <- function(name, token = NULL, size_limit = 1) { edges_df[["to"]] <- edges_df[["to"]] + 1L con_nodes <- unz(temp, node_file_name) + on.exit(close(con_nodes)) nodes_df_raw <- utils::read.csv(con_nodes) #suppress warning if no character columns found @@ -229,12 +232,8 @@ ns_df <- function(name, token = NULL, size_limit = 1) { } con_gprops <- unz(temp, gprops_file_name) - gprops_df <- readLines(con_gprops) - - on.exit(close(con_edge)) - on.exit(close(con_nodes)) on.exit(close(con_gprops)) - on.exit(unlink(temp)) + gprops_df <- readLines(con_gprops) list(nodes = nodes_df, edges = edges_df, gprops = gprops_df, meta = meta) } From f0e6378f2ff0987bebd9c4f1b9919cd682cc674c Mon Sep 17 00:00:00 2001 From: David Schoch Date: Sun, 1 Jun 2025 21:00:25 +0200 Subject: [PATCH 9/9] removed unnecessary resp MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Co-authored-by: Kirill Müller --- R/netzschleuder.R | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/R/netzschleuder.R b/R/netzschleuder.R index f6b07d2..b431457 100644 --- a/R/netzschleuder.R +++ b/R/netzschleuder.R @@ -63,8 +63,7 @@ download_file <- function(zip_url, token = NULL, file, size_limit) { "i" = "To download the file, set {.arg size_limit} to a value greater than {gb_size}" )) } - resp <- make_request(zip_url, token, method = "GET", file = file) - # writeBin(httr2::resp_body_raw(resp), file) + make_request(zip_url, token, method = "GET", file = file) invisible(NULL) }