Distribute value to zones using population ratio and min/max criteria in R

Question

I have the following data:

require("data.table")
dt1 <- data.table(ZONE = c("A34","G345","H62","D563","T63","P983","S24","J54","W953","L97","V56","R99"), POPULATION = c(40,110,80,70,90,90,130,140,80,30,80,50), MIN = c(1,0,0,1,0,1,0,1,1,0,1,1), MAX = c(10,9,2,11,12,8,5,3,2,0,8,8))

I would like to distribute 50, let's say hats, to these zones weighted on the population. However, some of these zones require at least 1 hat while others can receive only a very small number or no hats at all.

Is there a way of allocating the 50 hats based on the population (so as an exact proportional allocation as possible) but taking into account the minimum and maximum criteria and redistributing the hat allocation to other zones when a zone can't receive any/anymore? e.g. if a Zone should, based on exact proportional allocation, be assigned 20 hats but can only accept 10, then the other 10 should be assigned to other zones weighted on their populations.

Answer 1

I'm not sure about this. It sounds like an optimization or linear programming task

Here's the function:

allocate <- function(dt, N){
  if(N>dt[,sum(MAX)])
    stop("Too many hats to go around")

  if(N<dt[,sum(MIN)])
    stop("Not enough hats to go around")

# Allocate hats initially based on proportion but use clamping
  dt[, HATS := pmax(MIN, pmin(MAX, round(N * +(MAX>0) * POPULATION / sum(POPULATION[MAX>0]))))]

  n <- N - dt[,sum(HATS)]      
  if(n==0)  # All hats accouted for
    return(dt)

  if(n>0){  # Allocate the extra hats, again proportional to pop with clamping
    dt[HATS<MAX, HATS := HATS + pmax(MIN, pmin(MAX, 
              round(n * +(MAX>0) * POPULATION / sum(POPULATION[MAX>0]))))]
  } else {  # Or subtract the superfluous hats, according to pop
    dt[HATS>MIN, HATS := HATS - pmax(MIN, pmin(MAX, 
              round(abs(n) * +(MAX>0) * POPULATION / sum(POPULATION[MAX>0]))))]
  }

  n <- N - dt[,sum(HATS)]  # Check again
  if(n==0)  # All hats accouted for
    return(dt)

  if(n>0){  # This time, just add 1 hat to those that require them
    dt[HATS<MAX, i:=.I][i<=n, HATS := HATS + 1]
  } else {  # Or reduce the number of hats by one
    dt[HATS>MIN, i:=.I][i<=abs(n), HATS := HATS - 1]
  }

  dt[, i:=NULL]  # Remove this guy
  return(dt)
}

Test it for 50:

dt2 <- allocate(dt1, 50)
dt2
    ZONE POPULATION MIN MAX HATS
 1:  A34         40   1  10    2
 2: G345        110   0   9    8
 3:  H62         80   0   2    2
 4: D563         70   1  11    5
 5:  T63         90   0  12    7
 6: P983         90   1   8    7
 7:  S24        130   0   5    5
 8:  J54        140   1   3    3
 9: W953         80   1   2    2
10:  L97         30   0   0    0
11:  V56         80   1   8    5
12:  R99         50   1   8    4

50 hats were allocated.

It may not be elegant or mathematically sound, but that was my attempt for what it's worth. Hope it can be of some use.