R: Distributing an amount as evenly as possible II

问题

We have have a certain amount e.g. 300 units. This amount should be as evenly as possible distributed over 40 "slots" or "bins". 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 4. What we cannot "fill in" more than 4. Hence, we have to distribute more over the other ones.

Lets assume that there is another limitation: A general filling in limit of e.g. 5. That would mean that even if we have enough size in the slot to fill in say 12 and enough units remaining say 11, we can only fill in 5. The value that is excess after all slots are filled should be placed in a seperated remainder slot. With each filling in process we should also get a number how much of the maximum-filling in capacity in percent is used. I.e. if we fill in 4 and 5 is the general filling limit. We used 80%.

We discussed this already earlier in anohter question: Distributing an amount as evenly as possible

I have some ideas how do develop this formula further, however partially it still stucks. Thanks for your help!

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

# overall sum to distribute 
b <- 300  
# general filling in limit
c <- 8

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

  d <- rep(0, length(a))
  info <- 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)
    #maximum limitation
    add.size[add.size>c]  <- c
    #percentage info
    info[has.room] <- add.size/c
    d[has.room] <- d[has.room] + add.size 
    a[has.room] <- a[has.room] - add.size 
    b <- b - num.slots * add.size 
    } 
  return(d) 
} 
optimal.fill(a,b)

回答1:

How about this

optimal.fill <- function(a, b, generalLimit = 8){
  a <- pmax(0, pmin(a, generalLimit))
  if(sum(a) < b){
    stop("not enough room")
  }
  if(length(a) * min(a) <= b){
    result <- rep(min(a), length(a))
  } else {
    result <- rep(floor(b / length(a)), length(a))
  }
  while(floor((b - sum(result)) / sum(result < a)) >= 1){
    if(min(a[result < a]) * sum(result < a) <= b - sum(result)){
      result[result < a] <- 
        result[result < a] + rep(min(a[result < a]), sum(result < a))
    } else {
      result[result < a] <- 
        result[result < a] + 
        rep(floor((b - sum(result)) / sum(result < a)), sum(result < a))
    }
  }
  extra <- sample(which(result < a), (b - sum(result)), replace = FALSE)
  result[extra] <- result[extra] + 1
  return(cbind(result,  result / a))
}
optimal.fill(ceiling(rnorm(40,10,4)), 300, 8)

来源：https://stackoverflow.com/questions/11288900/r-distributing-an-amount-as-evenly-as-possible-ii

标签

while-loop

distribution

max

min