Distributing an amount as evenly as possible

问题:

We have have a certain amount e.g. 300 units. This amount should be as evenly as possible distributed over 40 "slots". It would be easy if each slot would be the same - so it would be 7,5 at each slot. However, the slots vary in size and we cannot "fill in" there more than its "size" allows for e.g. if its only 5. What we cannot "fill in" we have to distribute more over the other ones.

I have some basic ideas but I am far away from being an expeRt and hope there is an easy way to solve this. As an example how this could look like. In array "a" the values stand for the maxima the slots can take. a[i] is the maximum of the i-th slot. "b" is what we have to distribute overall e.g. 300.

 # developing slots and their "size"
 a <- rnorm(40,10,4)
 sum(a)

 # overall sum to distribute
 b <- 300 

Maybe it is possible to sort the values in a increasing order and then one could use it by a double for loop. a[,2] becomes the column for the "filled in" amount.

 for i in 1:40
 {a[i,2] <- a[1,2]*40
 b <- a [1,2]*40}

 for i in 2:40
 {a[i,2] <- a[1,2]*39
 b <- a[1,2]*39}

etc.

I am not sure how I can put the both for loops together and if this is an adequate solution overall. Happy to hear your ideas. Thanks!

回答1:

First version, using a while loop:

optimal.fill <- function(a, b) {
  stopifnot(sum(a) >= b)

  d <- rep(0, length(a))
  while(b > 0) {
    has.room  <- a > 0
    num.slots <- sum(has.room)
    min.size  <- min(a[has.room])
    add.size  <- min(b / num.slots, min.size)
    d[has.room] <- d[has.room] + add.size
    a[has.room] <- a[has.room] - add.size
    b <- b - num.slots * add.size
  }
  return(d)
}

This second version is a little harder to understand, but more elegant I feel:

optimal.fill <- function(a, b) {
  stopifnot(sum(a) >= b)

  slot.order   <- order(a)
  sorted.sizes <- a[slot.order]
  can.fill     <- sorted.sizes * rev(seq_along(a))
  full.slots   <- slot.order[which(cumsum(can.fill) <= b)]

  d <- rep(0, length(a))
  d[ full.slots] <- a[full.slots]
  d[!full.slots] <- (b - sum(a[full.slots])) /
                    (length(a) - length(full.slots))

  return(d)
}

回答2:

Here's another option:

optimal.fill2 <- function(a,b) {
  o <- rank(a)
  a <- sort(a)
  ca <- cumsum(a)
  foo <- (b-ca)/((length(a)-1):0)
  ok <- foo >= a
  a[!ok] <- foo[max(which(ok))]
  a[o]
}