Find a sparse set of payments to settle expenses

expense_split.R

# vector of net paid/owed, i.e., positive means owed money
b = c(Alice=-15, Bob=130, Charlie=-125, Diane=150, Ed=20, Frank=-160)

stopifnot(sum(b) == 0)
n = length(b)
m = n * (n - 1) / 2
A = combn(n, 2, function(x) {
    out = numeric(n)
    out[x] = c(1, -1)
    out
})

# basis pursuit
rlang::check_installed("lpSolve")
res = lpSolve::lp(
    objective.in = rep(1, 2*m),
    const.mat = rbind(cbind(A, -A), diag(2*m)),
    const.dir = c(rep("==", n), rep(">=", 2*m)),
    const.rhs = c(b, rep(0, 2*m)),
    transpose.constraints = TRUE
)

x = res$solution
payers = c(max.col(t(A) < 0)[x[1:m] > 0], max.col(t(A) > 0)[x[m + 1:m] > 0])
payees = c(max.col(t(A) > 0)[x[1:m] > 0], max.col(t(A) < 0)[x[m + 1:m] > 0])
ord = order(payers, payees)
nm = names(b) %||% seq_along(b)
data.frame(payer = nm[payers[ord]], payee = nm[payees[ord]], amount = x[x > 0][ord])
#>     payer payee amount
#> 1   Alice   Bob      5
#> 2   Alice Diane     10
#> 3 Charlie   Bob    125
#> 4   Frank Diane    140
#> 5   Frank    Ed     20