This notebook is based on R code in a blog post by Erwin Kalvelagen: “Arranging points on a line”. The problem considered in that post involves placing points on a line so as to maximize the minimum difference between any pair of consecutive points. Our focus here is not on the problem itself, but on the objective function for a GA coded in R.

We will compare two computational approaches, looking for differences in execution time. The first approach, using Erwin’s code, is to compute absolute values of all pairwise differences using nested loops. The second is to sort the candidate solution and then compute differences only for consecutive values.

To time the methods, we will use the tictoc package.

library(tictoc)

The argument to each of the following functions consists of an unsorted vector of values on the real number line. The nested loop approach uses code from Erwin’s post.

obj <- function(x) {
  smallest <- Inf
  n <- length(x)
  for(i in 1:n)
    if (i<n)
      for(j in (i+1):n) {
        smallest <- min(abs(x[i]-x[j]),smallest)
      }
  smallest
}

The alternative approach is as follows. (Note that the |> pipe operator is new in R 4.1.0. It can be replaced by the pipe operator %>% from the magrittr package, ), or by nesting the various function calls.

obj2 <- function(x) {
  x |> sort() |> diff() |> min()
}

As a sanity check, we compare the result using a random vector of dimension 50.

x <- runif(n = 50, min = -10, max = 10)
obj(x)
[1] 0.02013424
obj2(x)
[1] 0.02013424

The results agree.

We now define a function that generates a random vector of given dimension, computes the objective value using both functions, and prints their respective execution times. We assign the result to a dummy variable to avoid having the time taken to print it count toward the method.

test <- function(n) {
  x <- runif(n, min = -10, max = 10)
  tic("Looping")
  y1 <- obj(x)
  toc()
  tic("Sorting")
  y2 <- obj2(x)
  toc()
  # Make sure the results agree.
  if (y1 != y2) {
    cat("Oops: different results ", y1, " and ", y2, "!\n")
  }
}

We try vectors of various dimensions.

for (n in c(50, 500, 5000, 10000)) {
  cat("\nVector dimension = ", n, ":\n")
  test(n)
}

Vector dimension =  50 :
Looping: 0.001 sec elapsed
Sorting: 0.003 sec elapsed

Vector dimension =  500 :
Looping: 0.065 sec elapsed
Sorting: 0 sec elapsed

Vector dimension =  5000 :
Looping: 5.966 sec elapsed
Sorting: 0 sec elapsed

Vector dimension =  10000 :
Looping: 23.268 sec elapsed
Sorting: 0.001 sec elapsed

The time required for the looping approach is quadratic in the vector dimension. The time for the sorting approach is so short it’s hard to believe. We can try higher dimensions with just the sorting approach to get a bit better idea of its speed.

test2 <- function(n) {
  x <- runif(n, min = -10, max = 10)
  tic("Sorting")
  y2 <- obj2(x)
  toc()
}
for (n in c(50000, 100000, 500000, 1000000, 2000000)) {
  test2(n)
}
Sorting: 0.003 sec elapsed
Sorting: 0.007 sec elapsed
Sorting: 0.046 sec elapsed
Sorting: 0.113 sec elapsed
Sorting: 0.332 sec elapsed

With a vector of 2,000,000 observations, evaluation time is still well under one second.

There is one remaining question. The biggest difference in execution time stems from the looping approach being \(O(n^2)\) and the sorting approach being \(O(n \log n)\). That said, some people contend that explicit loops in R are significantly less efficient that using vectorized functions (which will still loop, but with loops presumably coded in C or C++ in the function definitions). We can test that to some extent using yet another version of the objective function, which does not sort and computes all pairwise differences, but using vectorized methods.

obj3 <- function(x) {
  # Compute all pairwise absolute differences.
  d <- outer(x, x, FUN = function(y, z) abs(y - z))
  # Eliminate the zero diagonal entries.
  diag(d) <- Inf
  # Return the minimum value.
  min(d)
}

Before proceeding, we confirm on our test vector that the result is correct.

obj(x)
[1] 0.02013424
obj2(x)
[1] 0.02013424
obj3(x)
[1] 0.02013424

We can now time all three methods on random test vectors.

test3 <- function(n) {
  x <- runif(n, min = -10, max = 10)
  tic("Looping")
  y1 <- obj(x)
  toc()
  tic("Sorting")
  y2 <- obj2(x)
  toc()
  tic("Outer product")
  y3 <- obj3(x)
  toc()
  # Make sure the results agree.
  if (y1 != y3 || y2 != y3) {
    cat("Oops: different results ", y1, ", ", y2, " and ", y3, "!\n")
  }
}
for (n in c(50, 500, 5000, 10000)) {
  cat("\nVector dimension = ", n, ":\n")
  test3(n)
}

Vector dimension =  50 :
Looping: 0.002 sec elapsed
Sorting: 0.001 sec elapsed
Outer product: 0 sec elapsed

Vector dimension =  500 :
Looping: 0.062 sec elapsed
Sorting: 0.001 sec elapsed
Outer product: 0.002 sec elapsed

Vector dimension =  5000 :
Looping: 5.525 sec elapsed
Sorting: 0 sec elapsed
Outer product: 0.667 sec elapsed

Vector dimension =  10000 :
Looping: 21.413 sec elapsed
Sorting: 0.001 sec elapsed
Outer product: 2.149 sec elapsed

The outer product approach is about a factor of 10 faster than the nested loops (perhaps less if we go to higher dimensions), even though the outer product calculates every difference twice (and the difference of each observation with itself), doing slightly more than double the work of the nested loop. So there is some merit to the claim that for loops in R are inefficient.

LS0tCnRpdGxlOiAiUGFpcndpc2UgRGlmZmVyZW5jZXMiCm91dHB1dDogaHRtbF9ub3RlYm9vawotLS0KClRoaXMgbm90ZWJvb2sgaXMgYmFzZWQgb24gUiBjb2RlIGluIGEgYmxvZyBwb3N0IGJ5IEVyd2luIEthbHZlbGFnZW46IFsiQXJyYW5naW5nIHBvaW50cyBvbiBhIGxpbmUiXShodHRwczovL3lldGFub3RoZXJtYXRocHJvZ3JhbW1pbmdjb25zdWx0YW50LmJsb2dzcG90LmNvbS8yMDIxLzA2L2FycmFuZ2luZy1wb2ludHMtb24tbGluZS5odG1sKS4gVGhlIHByb2JsZW0gY29uc2lkZXJlZCBpbiB0aGF0IHBvc3QgaW52b2x2ZXMgcGxhY2luZyBwb2ludHMgb24gYSBsaW5lIHNvIGFzIHRvIG1heGltaXplIHRoZSBtaW5pbXVtIGRpZmZlcmVuY2UgYmV0d2VlbiBhbnkgcGFpciBvZiBjb25zZWN1dGl2ZSBwb2ludHMuIE91ciBmb2N1cyBoZXJlIGlzIG5vdCBvbiB0aGUgcHJvYmxlbSBpdHNlbGYsIGJ1dCBvbiB0aGUgb2JqZWN0aXZlIGZ1bmN0aW9uIGZvciBhIEdBIGNvZGVkIGluIFIuCgpXZSB3aWxsIGNvbXBhcmUgdHdvIGNvbXB1dGF0aW9uYWwgYXBwcm9hY2hlcywgbG9va2luZyBmb3IgZGlmZmVyZW5jZXMgaW4gZXhlY3V0aW9uIHRpbWUuIFRoZSBmaXJzdCBhcHByb2FjaCwgdXNpbmcgRXJ3aW4ncyBjb2RlLCBpcyB0byBjb21wdXRlIGFic29sdXRlIHZhbHVlcyBvZiBhbGwgcGFpcndpc2UgZGlmZmVyZW5jZXMgdXNpbmcgbmVzdGVkIGxvb3BzLiBUaGUgc2Vjb25kIGlzIHRvIHNvcnQgdGhlIGNhbmRpZGF0ZSBzb2x1dGlvbiBhbmQgdGhlbiBjb21wdXRlIGRpZmZlcmVuY2VzIG9ubHkgZm9yIGNvbnNlY3V0aXZlIHZhbHVlcy4KClRvIHRpbWUgdGhlIG1ldGhvZHMsIHdlIHdpbGwgdXNlIHRoZSBgdGljdG9jYCBwYWNrYWdlLgoKYGBge3J9CmxpYnJhcnkodGljdG9jKQpgYGAKClRoZSBhcmd1bWVudCB0byBlYWNoIG9mIHRoZSBmb2xsb3dpbmcgZnVuY3Rpb25zIGNvbnNpc3RzIG9mIGFuIHVuc29ydGVkIHZlY3RvciBvZiB2YWx1ZXMgb24gdGhlIHJlYWwgbnVtYmVyIGxpbmUuIFRoZSBuZXN0ZWQgbG9vcCBhcHByb2FjaCB1c2VzIGNvZGUgZnJvbSBFcndpbidzIHBvc3QuCgpgYGB7cn0Kb2JqIDwtIGZ1bmN0aW9uKHgpIHsKICBzbWFsbGVzdCA8LSBJbmYKICBuIDwtIGxlbmd0aCh4KQogIGZvcihpIGluIDE6bikKICAgIGlmIChpPG4pCiAgICAgIGZvcihqIGluIChpKzEpOm4pIHsKICAgICAgICBzbWFsbGVzdCA8LSBtaW4oYWJzKHhbaV0teFtqXSksc21hbGxlc3QpCiAgICAgIH0KICBzbWFsbGVzdAp9CmBgYAoKVGhlIGFsdGVybmF0aXZlIGFwcHJvYWNoIGlzIGFzIGZvbGxvd3MuIChOb3RlIHRoYXQgdGhlIGB8PmAgcGlwZSBvcGVyYXRvciBpcyBuZXcgaW4gUiA0LjEuMC4gSXQgY2FuIGJlIHJlcGxhY2VkIGJ5IHRoZSBwaXBlIG9wZXJhdG9yIGAlPiVgIGZyb20gdGhlIGBtYWdyaXR0cmAgcGFja2FnZSwgKSwgb3IgYnkgbmVzdGluZyB0aGUgdmFyaW91cyBmdW5jdGlvbiBjYWxscy4KCmBgYHtyfQpvYmoyIDwtIGZ1bmN0aW9uKHgpIHsKICB4IHw+IHNvcnQoKSB8PiBkaWZmKCkgfD4gbWluKCkKfQpgYGAKCkFzIGEgc2FuaXR5IGNoZWNrLCB3ZSBjb21wYXJlIHRoZSByZXN1bHQgdXNpbmcgYSByYW5kb20gdmVjdG9yIG9mIGRpbWVuc2lvbiA1MC4KCmBgYHtyfQp4IDwtIHJ1bmlmKG4gPSA1MCwgbWluID0gLTEwLCBtYXggPSAxMCkKb2JqKHgpCm9iajIoeCkKYGBgClRoZSByZXN1bHRzIGFncmVlLgoKV2Ugbm93IGRlZmluZSBhIGZ1bmN0aW9uIHRoYXQgZ2VuZXJhdGVzIGEgcmFuZG9tIHZlY3RvciBvZiBnaXZlbiBkaW1lbnNpb24sIGNvbXB1dGVzIHRoZSBvYmplY3RpdmUgdmFsdWUgdXNpbmcgYm90aCBmdW5jdGlvbnMsIGFuZCBwcmludHMgdGhlaXIgcmVzcGVjdGl2ZSBleGVjdXRpb24gdGltZXMuIFdlIGFzc2lnbiB0aGUgcmVzdWx0IHRvIGEgZHVtbXkgdmFyaWFibGUgdG8gYXZvaWQgaGF2aW5nIHRoZSB0aW1lIHRha2VuIHRvIHByaW50IGl0IGNvdW50IHRvd2FyZCB0aGUgbWV0aG9kLgoKYGBge3J9CnRlc3QgPC0gZnVuY3Rpb24obikgewogIHggPC0gcnVuaWYobiwgbWluID0gLTEwLCBtYXggPSAxMCkKICB0aWMoIkxvb3BpbmciKQogIHkxIDwtIG9iaih4KQogIHRvYygpCiAgdGljKCJTb3J0aW5nIikKICB5MiA8LSBvYmoyKHgpCiAgdG9jKCkKICAjIE1ha2Ugc3VyZSB0aGUgcmVzdWx0cyBhZ3JlZS4KICBpZiAoeTEgIT0geTIpIHsKICAgIGNhdCgiT29wczogZGlmZmVyZW50IHJlc3VsdHMgIiwgeTEsICIgYW5kICIsIHkyLCAiIVxuIikKICB9Cn0KYGBgCgpXZSB0cnkgdmVjdG9ycyBvZiB2YXJpb3VzIGRpbWVuc2lvbnMuCgpgYGB7cn0KZm9yIChuIGluIGMoNTAsIDUwMCwgNTAwMCwgMTAwMDApKSB7CiAgY2F0KCJcblZlY3RvciBkaW1lbnNpb24gPSAiLCBuLCAiOlxuIikKICB0ZXN0KG4pCn0KYGBgClRoZSB0aW1lIHJlcXVpcmVkIGZvciB0aGUgbG9vcGluZyBhcHByb2FjaCBpcyBxdWFkcmF0aWMgaW4gdGhlIHZlY3RvciBkaW1lbnNpb24uIFRoZSB0aW1lIGZvciB0aGUgc29ydGluZyBhcHByb2FjaCBpcyBzbyBzaG9ydCBpdCdzIGhhcmQgdG8gYmVsaWV2ZS4gV2UgY2FuIHRyeSBoaWdoZXIgZGltZW5zaW9ucyB3aXRoIGp1c3QgdGhlIHNvcnRpbmcgYXBwcm9hY2ggdG8gZ2V0IGEgYml0IGJldHRlciBpZGVhIG9mIGl0cyBzcGVlZC4KCmBgYHtyfQp0ZXN0MiA8LSBmdW5jdGlvbihuKSB7CiAgeCA8LSBydW5pZihuLCBtaW4gPSAtMTAsIG1heCA9IDEwKQogIHRpYygiU29ydGluZyIpCiAgeTIgPC0gb2JqMih4KQogIHRvYygpCn0KYGBgCgpgYGB7cn0KZm9yIChuIGluIGMoNTAwMDAsIDEwMDAwMCwgNTAwMDAwLCAxMDAwMDAwLCAyMDAwMDAwKSkgewogIHRlc3QyKG4pCn0KYGBgCldpdGggYSB2ZWN0b3Igb2YgMiwwMDAsMDAwIG9ic2VydmF0aW9ucywgZXZhbHVhdGlvbiB0aW1lIGlzIHN0aWxsIHdlbGwgdW5kZXIgb25lIHNlY29uZC4KClRoZXJlIGlzIG9uZSByZW1haW5pbmcgcXVlc3Rpb24uIFRoZSBiaWdnZXN0IGRpZmZlcmVuY2UgaW4gZXhlY3V0aW9uIHRpbWUgc3RlbXMgZnJvbSB0aGUgbG9vcGluZyBhcHByb2FjaCBiZWluZyAkTyhuXjIpJCBhbmQgdGhlIHNvcnRpbmcgYXBwcm9hY2ggYmVpbmcgJE8obiBcbG9nIG4pJC4gVGhhdCBzYWlkLCBzb21lIHBlb3BsZSBjb250ZW5kIHRoYXQgZXhwbGljaXQgbG9vcHMgaW4gUiBhcmUgc2lnbmlmaWNhbnRseSBsZXNzIGVmZmljaWVudCB0aGF0IHVzaW5nIHZlY3Rvcml6ZWQgZnVuY3Rpb25zICh3aGljaCB3aWxsIHN0aWxsIGxvb3AsIGJ1dCB3aXRoIGxvb3BzIHByZXN1bWFibHkgY29kZWQgaW4gQyBvciBDKysgaW4gdGhlIGZ1bmN0aW9uIGRlZmluaXRpb25zKS4gV2UgY2FuIHRlc3QgdGhhdCB0byBzb21lIGV4dGVudCB1c2luZyB5ZXQgYW5vdGhlciB2ZXJzaW9uIG9mIHRoZSBvYmplY3RpdmUgZnVuY3Rpb24sIHdoaWNoIGRvZXMgbm90IHNvcnQgYW5kIGNvbXB1dGVzIGFsbCBwYWlyd2lzZSBkaWZmZXJlbmNlcywgYnV0IHVzaW5nIHZlY3Rvcml6ZWQgbWV0aG9kcy4KCmBgYHtyfQpvYmozIDwtIGZ1bmN0aW9uKHgpIHsKICAjIENvbXB1dGUgYWxsIHBhaXJ3aXNlIGFic29sdXRlIGRpZmZlcmVuY2VzLgogIGQgPC0gb3V0ZXIoeCwgeCwgRlVOID0gZnVuY3Rpb24oeSwgeikgYWJzKHkgLSB6KSkKICAjIEVsaW1pbmF0ZSB0aGUgemVybyBkaWFnb25hbCBlbnRyaWVzLgogIGRpYWcoZCkgPC0gSW5mCiAgIyBSZXR1cm4gdGhlIG1pbmltdW0gdmFsdWUuCiAgbWluKGQpCn0KYGBgCgpCZWZvcmUgcHJvY2VlZGluZywgd2UgY29uZmlybSBvbiBvdXIgdGVzdCB2ZWN0b3IgdGhhdCB0aGUgcmVzdWx0IGlzIGNvcnJlY3QuCgpgYGB7cn0Kb2JqKHgpCm9iajIoeCkKb2JqMyh4KQpgYGAKCldlIGNhbiBub3cgdGltZSBhbGwgdGhyZWUgbWV0aG9kcyBvbiByYW5kb20gdGVzdCB2ZWN0b3JzLgoKYGBge3J9CnRlc3QzIDwtIGZ1bmN0aW9uKG4pIHsKICB4IDwtIHJ1bmlmKG4sIG1pbiA9IC0xMCwgbWF4ID0gMTApCiAgdGljKCJMb29waW5nIikKICB5MSA8LSBvYmooeCkKICB0b2MoKQogIHRpYygiU29ydGluZyIpCiAgeTIgPC0gb2JqMih4KQogIHRvYygpCiAgdGljKCJPdXRlciBwcm9kdWN0IikKICB5MyA8LSBvYmozKHgpCiAgdG9jKCkKICAjIE1ha2Ugc3VyZSB0aGUgcmVzdWx0cyBhZ3JlZS4KICBpZiAoeTEgIT0geTMgfHwgeTIgIT0geTMpIHsKICAgIGNhdCgiT29wczogZGlmZmVyZW50IHJlc3VsdHMgIiwgeTEsICIsICIsIHkyLCAiIGFuZCAiLCB5MywgIiFcbiIpCiAgfQp9CmBgYAoKYGBge3J9CmZvciAobiBpbiBjKDUwLCA1MDAsIDUwMDAsIDEwMDAwKSkgewogIGNhdCgiXG5WZWN0b3IgZGltZW5zaW9uID0gIiwgbiwgIjpcbiIpCiAgdGVzdDMobikKfQpgYGAKClRoZSBvdXRlciBwcm9kdWN0IGFwcHJvYWNoIGlzIGFib3V0IGEgZmFjdG9yIG9mIDEwIGZhc3RlciB0aGFuIHRoZSBuZXN0ZWQgbG9vcHMgKHBlcmhhcHMgbGVzcyBpZiB3ZSBnbyB0byBoaWdoZXIgZGltZW5zaW9ucyksIGV2ZW4gdGhvdWdoIHRoZSBvdXRlciBwcm9kdWN0IGNhbGN1bGF0ZXMgZXZlcnkgZGlmZmVyZW5jZSB0d2ljZSAoYW5kIHRoZSBkaWZmZXJlbmNlIG9mIGVhY2ggb2JzZXJ2YXRpb24gd2l0aCBpdHNlbGYpLCBkb2luZyBzbGlnaHRseSBtb3JlIHRoYW4gZG91YmxlIHRoZSB3b3JrIG9mIHRoZSBuZXN0ZWQgbG9vcC4gU28gdGhlcmUgaXMgc29tZSBtZXJpdCB0byB0aGUgY2xhaW0gdGhhdCBmb3IgbG9vcHMgaW4gUiBhcmUgaW5lZmZpY2llbnQuCg==