count_operations from Stephanov's Efficient Programming with Components, implemented (crudely) in R

count_operations.R

## global counters
reset <- function() {
  assign("counts_lt", 0, .GlobalEnv)
  assign("counts_gt", 0, .GlobalEnv)
  assign("counts_eq", 0, .GlobalEnv)
  assign("counts_as", 0, .GlobalEnv)
}

reset()

## overwrite operations with updating counters
`<` <- function(e1, e2) {
  counts_lt <<- counts_lt + 1
  base::`<`(e1, e2)
}
`<=` <- function(e1, e2) {
  counts_lt <<- counts_lt + 1
  base::`<=`(e1, e2)
}
`>` <- function(e1, e2) {
  counts_gt <<- counts_gt + 1
  base::`>`(e1, e2)
}
`>=` <- function(e1, e2) {
  counts_gt <<- counts_gt + 1
  base::`>=`(e1, e2)
}
`==` <- function(e1, e2) {
  counts_eq <<- counts_eq + 1
  base::`==`(e1, e2)
}
`<-` <- function(e1, e2) {
  counts_as <<- counts_as + 1
  eval(substitute(base::`<-`(e1, e2)), envir = parent.frame())
}
`[<-` <- function(x, i, value) {
  counts_as <<- counts_as + 1
  eval(substitute(base::`[<-`(x, i, value)), envir = parent.frame())
}

bubble_sort <- function(x) {
  if (length(x) <= 1) {
    return(x)
  }
  sorted_x <- x
  n <- length(sorted_x)
  swapped <- TRUE
  while (swapped) {
    swapped <- FALSE
    for (i in 1:(n - 1)) {
      if (sorted_x[i] > sorted_x[i + 1]) {
        temp <- sorted_x[i]
        sorted_x[i] <- sorted_x[i + 1]
        sorted_x[i + 1] <- temp
        swapped <- TRUE
      }
    }
    n <- n - 1
  }
  sorted_x
}

quicksort <- function(x) {
  if (length(x) <= 1) {
    return(x)
  }
  pivot_index <- ceiling(length(x) / 2)
  pivot <- x[pivot_index]
  x <- x[-pivot_index]
  less <- x[x < pivot]
  equal <- x[x == pivot]
  greater <- x[x > pivot]
  c(
    quicksort(less),
    pivot,
    equal,
    quicksort(greater)
  )
}

radix_sort <- function(x) {
  if (length(x) <= 1) {
    return(x)
  }
  max_val <- max(x)
  if (max_val == 0) return(x)
  num_digits <- as.integer(log10(max_val)) + 1
  sorted_x <- x
  for (digit_place in 0:(num_digits - 1)) {
    buckets <- vector("list", 10)
    for (num in sorted_x) {
      divisor <- 10^digit_place
      divided <- num %/% divisor
      digit <- divided %% 10
      bucket_index <- digit + 1
      buckets[[bucket_index]] <- c(buckets[[bucket_index]], num)
    }
    sorted_x <- unlist(buckets)
  }
  sorted_x
}

### reset the counters, run the sort, then print the values

n <- 100
vals <- sample(1:n, replace = TRUE)

reset()
bubble_sort(c(1, 3, 1, 4, 1, 5))
#> [1] 1 1 1 3 4 5
data.frame(method = "bubble", n = 6, counts_lt, counts_gt, counts_eq, counts_as)
#>   method n counts_lt counts_gt counts_eq counts_as
#> 1 bubble 6         1        12         0        27

reset()
invisible(bubble_sort(vals))
data.frame(method = "bubble", n = n, counts_lt, counts_gt, counts_eq, counts_as)
#>   method   n counts_lt counts_gt counts_eq counts_as
#> 1 bubble 100         1      4830         0     13857

reset()
quicksort(c(1, 3, 1, 4, 1, 5))
#> [1] 1 1 1 3 4 5
data.frame(method = "quick", n = 6, counts_lt, counts_gt, counts_eq, counts_as)
#>   method n counts_lt counts_gt counts_eq counts_as
#> 1  quick 6         7         2         2        12

reset()
invisible(quicksort(vals))
data.frame(method = "quick", n = n, counts_lt, counts_gt, counts_eq, counts_as)
#>   method   n counts_lt counts_gt counts_eq counts_as
#> 1  quick 100       139        46        46       276

reset()
radix_sort(c(1, 3, 1, 4, 1, 5))
#> [1] 1 1 1 3 4 5
data.frame(method = "radix", n = 6, counts_lt, counts_gt, counts_eq, counts_as)
#>   method n counts_lt counts_gt counts_eq counts_as
#> 1  radix 6         1         0         1        35

reset()
invisible(radix_sort(vals))
data.frame(method = "radix", n = n, counts_lt, counts_gt, counts_eq, counts_as)
#>   method   n counts_lt counts_gt counts_eq counts_as
#> 1  radix 100         1         0         1      1509