The code tests for strict dominance in a zero-sum game.

strict_dominance.R

# packages ----------------------------------------------------------------

packages <- c("glue", "purrr", "rlang")

# install.packages(packages)

invisible(lapply(packages, require, character.only = TRUE))

# variables ---------------------------------------------------------------

a <- matrix(
  c(4, 6, 3, 5, 5,
    -2, 8, -3, 8, -2,
    3, -5, 3, -6, 4),
  ncol = 3,
  nrow = 5
)

# functions ---------------------------------------------------------------

dominance_p_1 <- function(comb, a) {
  purrr::map(
    seq_len(ncol(comb$cols)),
    function(i) {
      x <- comb$cols[, i][1]
      y <- comb$cols[, i][2]
      
      cat(glue::glue("\n\nComparing C{x} with C{y}...\n\n"))
      
      z <- sum(a[, x] > a[, y])
      
      if(z == length(a[, x])) cat(glue::glue("\n\n**C{x} dominates C{y} for player I**\n\n"))
      
      
      if(z == length(a[, x])) {
        cat(glue::glue("\n\nC{x} dominates C{y} for player I\n\n"))
        a <- a[, -y]
        
        return(a)
      }
    }
  )
}

dominance_p_2 <- function(comb, a) {
  purrr::map(
    seq_len(ncol(comb$rows)),
    function(i) {
      x <- comb$rows[, i][1]
      y <- comb$rows[, i][2]
      
      cat(glue::glue("\n\nComparing R{x} with R{y}...\n\n"))
      
      z <- sum(a[x, ] < a[y, ])
      
      if(z == length(a[x, ])) {
        cat(glue::glue("\n\nR{x} dominates R{y} for player II\n\n"))
        a <- a[-y, ]
        
        return(a)
      }
    }
  )
}

# dominance - player 1 ----------------------------------------------------

repeat{
  comb <- list(
    cols = combn(ncol(a), 2),
    rows = combn(nrow(a), 2)
  )
  
  b <- dominance_p_1(comb, a) |> 
    purrr::discard(is.null)
  
  if(!rlang::is_empty(b)){
    a <- b[[1]]
  } else {
    print(a)
    break
  }
}

# dominance - player 2 ----------------------------------------------------

repeat{
  comb <- list(
    cols = combn(ncol(a), 2),
    rows = combn(nrow(a), 2)
  )
  
  b <- dominance_p_2(comb, a) |> 
    purrr::discard(is.null)
  
  if(!rlang::is_empty(b)){
    a <- b[[1]]
  } else {
    print(a)
    break
  }
}