do not use native pipe or \(...) lambdas, so we do not have to depend on >= R-4.1.

Author: lschneiderbauer

R/autoplot.R

@@ -60,7 +60,7 @@ plot_data <- function(x) {
         by(
           x,
           x$run,
-          \(y) data.frame(
+          function(y) data.frame(
             run = unique(y$run),
             order = 1 + max(y$order),
             site = 0

R/clarke_wright.R

@@ -152,7 +152,7 @@ clarke_wright_stepwise <- function(demand, distances, vehicles,
       `_heumilkr_cpp_clarke_wright_stepwise`, as.numeric(demand), distances,
       vehicles$n, vehicles$caps, restrictions$site, restrictions$vehicle
     ),
-    \(x) heumilkr_solution(
+    function(x) heumilkr_solution(
       x,
       distances = distances
     )

R/cvrplib.R

@@ -131,10 +131,16 @@ cvrplib_url <- "http://vrp.atd-lab.inf.puc-rio.br/media/com_vrp/instances/"
 cvrplib_ls <- function() {
   # reading directories first
   rel_dirs <-
-    xml2::read_html(paste0(readLines(url(cvrplib_url)), collapse = "\n")) |>
-    xml2::xml_find_all("//a[substring(@href, string-length(@href) - string-length('/') +1) = '/']") |>
-    xml2::xml_attr("href") |>
-    setdiff(c("/media/com_vrp/", "test/", "CMT/"))
+    setdiff(
+      xml2::xml_attr(
+        xml2::xml_find_all(
+          xml2::read_html(paste0(readLines(url(cvrplib_url)), collapse = "\n")),
+          "//a[substring(@href, string-length(@href) - string-length('/') +1) = '/']"
+        ),
+        "href"
+      ),
+      c("/media/com_vrp/", "test/", "CMT/")
+    )
   # CMT has buggy .sol files
 
   # iterate over all directories and collect file names
@@ -144,17 +150,21 @@ cvrplib_ls <- function() {
       unlist(
         lapply(
           rel_dirs,
-          \(rel_dir) {
+          function(rel_dir) {
             paste0(
               rel_dir,
-              xml2::read_html(
-                paste0(
-                  readLines(url(paste0(cvrplib_url, rel_dir))),
-                  collapse = "\n"
-                )
-              ) |>
-                xml2::xml_find_all("//a[substring(@href, string-length(@href) - string-length('.vrp') +1) = '.vrp']") |>
-                xml2::xml_attr("href")
+              xml2::xml_attr(
+                xml2::xml_find_all(
+                  xml2::read_html(
+                    paste0(
+                      readLines(url(paste0(cvrplib_url, rel_dir))),
+                      collapse = "\n"
+                    )
+                  ),
+                  "//a[substring(@href, string-length(@href) - string-length('.vrp') +1) = '.vrp']"
+                ),
+                "href"
+              )
             )
           }
         )
@@ -231,7 +241,7 @@ cvrplib_download <- function(qualifier) {
       demand_section <- grep("DEMAND_SECTION", content, fixed = TRUE)
       edge_content <- content[edge_weight_section:(demand_section - 1)]
 
-      lower_triang <- as.numeric(unlist(lapply(strsplit(edge_content, "\\s+"), \(x) x[x != ""])))
+      lower_triang <- as.numeric(unlist(lapply(strsplit(edge_content, "\\s+"), function(x) x[x != ""])))
       dmat <- matrix(0, nrow = dimension, ncol = dimension)
       dmat[upper.tri(dmat, diag = TRUE)] <- lower_triang
       pos <- as.data.frame(cmdscale(dist(dmat + t(dmat))))
@@ -241,7 +251,7 @@ cvrplib_download <- function(qualifier) {
       demand_section <- grep("DEMAND_SECTION", content, fixed = TRUE)
       edge_content <- content[edge_weight_section:(demand_section - 1)]
 
-      lower_triang <- as.numeric(unlist(lapply(strsplit(edge_content, "\\s+"), \(x) x[x != ""])))
+      lower_triang <- as.numeric(unlist(lapply(strsplit(edge_content, "\\s+"), function(x) x[x != ""])))
       dmat <- matrix(0, nrow = dimension, ncol = dimension)
       dmat[upper.tri(dmat)] <- lower_triang
       pos <- as.data.frame(cmdscale(dist(dmat + t(dmat))))
@@ -250,7 +260,7 @@ cvrplib_download <- function(qualifier) {
     } else if (edge_weight_format == "FULL_MATRIX") {
       edge_content <- content[edge_weight_section:(edge_weight_section + dimension - 1)]
 
-      dmat <- as.numeric(unlist(lapply(strsplit(edge_content, "\\s+"), \(x) x[x != ""])))
+      dmat <- as.numeric(unlist(lapply(strsplit(edge_content, "\\s+"), function(x) x[x != ""])))
       dim(dmat) <- c(dimension, dimension)
 
       pos <- as.data.frame(cmdscale(dist(dmat)))

R/heumilkr_solution.R

@@ -100,7 +100,7 @@ milkr_saving <- function(solution, relative = FALSE) {
     sum(
       vapply(
         1:(dim(d)[[2]] - 1),
-        \(idx) 2 * d[1, idx + 1],
+        function(idx) 2 * d[1, idx + 1],
         FUN.VALUE = 1.
       )
     )

tests/testthat/helper-hedgehog.R

@@ -7,7 +7,7 @@ gen.demand_net <- function(max_sites = 10L) {
         demand = gen.demand(n_sites),
         distances = hedgehog::gen.with(
           gen.pos(n_sites),
-          \(pos) dist(pos, method = "euclidean")
+          function(pos) dist(pos, method = "euclidean")
         )
       )
     }
@@ -62,6 +62,6 @@ gen.coords <- function(n_sites) {
       ),
       half_plane = hedgehog::gen.element(c(1, -1))
     ),
-    \(g) c(0, g$half_plane * g$positives)
+    function(g) c(0, g$half_plane * g$positives)
   )
 }