Styjun

I am trying to create a function in R to allocate a fixed amount of units based on the value those units provide. I set up the below sample dataframe.

fruit <- c("apple","orange","bannana","cherry")
units_of_mass <- c(9, 11, 16, 7)
health_pts <- c(5, 3, 6, 1)
diet_plan <- data.frame(fruit, units_of_mass, health_pts)
total_units_desired <- 32

So what I would like to do is to allocate the total units desired based on the health points assigned to each fruit, starting with the highest health points.

I tried using dplyr but got stuck

fruit_detail <- diet_plan %>%

arrange(fruit, health_pts) %>%

mutate(
 cum_units = cumsum(units_of_mass) - units_of_mass,
 can_allocate = total_units_desired - cum_units,
 allocated = ifelse(can_allocate <= 0, 0, ifelse(can_allocate >= 
 cum_units, cum_units))
 )

The simple way to do this would be to arrange by health points and subtract units until you run out of total_units_desired, which would look something like the below:

## iterate on allocations
diet_plan <- setDT(diet_plan)

max <- max(diet_plan$health_pts)

allocation_1 <- subset(diet_plan, health_pts == max)
allocation_1[, units_allocated := ifelse(total_units_desired > 
 units_of_mass, units_of_mass, total_units_desired)]

remaining_units <- ifelse(total_units_desired - allocation_1$units_allocated 
 > 0, total_units_desired - allocation_1$units_allocated, 
 0)

diet_plan <- subset(diet_plan, health_pts < max)
max <- max(diet_plan$health_pts)

allocation_2 <- subset(diet_plan, health_pts == max)
allocation_2[, units_allocated := ifelse(remaining_units > units_of_mass, 
 units_of_mass, remaining_units)]

remaining_units <- ifelse(remaining_units - allocation_2$units_allocated > 
 0, remaining_units - allocation_2$units_allocated, 0)

diet_plan <- subset(diet_plan, health_pts < max)
max <- max(diet_plan$health_pts)

allocation_3 <- subset(diet_plan, health_pts == max)
allocation_3[, units_allocated := ifelse(remaining_units > units_of_mass, 
 units_of_mass, remaining_units)]

remaining_units <- ifelse(remaining_units - allocation_3$units_allocated > 
 0, remaining_units - allocation_3$units_allocated, 0)

diet_plan <- subset(diet_plan, health_pts < max)
max <- max(diet_plan$health_pts)

allocation_4 <- subset(diet_plan, health_pts == max)
allocation_4[, units_allocated := ifelse(remaining_units > units_of_mass, 
units_of_mass, remaining_units)]

result <- rbind(allocation_1, allocation_2, allocation_3, allocation_4)

 fruit units_of_mass health_pts units_allocated
bannana 16 6 16
apple 9 5 9
orange 11 3 7
cherry 7 1 0

The way you presented your problem, we can just sort by health_pts, then find the cumulative sum of units_of_mass, which is the total units_allocated if we take that item and all items above it. Then we can just filter the items where taking them wouldn't put us over the limit of total_units_desired.

The remaining rows, then, can have the maximum amount of units allocated:

diet_plan_sum %>%
 arrange(desc(health_pts)) %>% # Sort by health_pts
 mutate(cum_sum = cumsum(units_of_mass)) %>% # Calculate total cumulative units
 filter(cum_sum < total_units_desired) %>% # Drop items over allocation limit
 mutate(units_allocated = units_of_mass) %>% # For remaining rows, allocate max
 select(-cum_sum) # Drop cum_sum variable

 fruit units_of_mass health_pts units_allocated
1 bannana 16 6 16
2 apple 9 5 9

If you want to allocate the remaining units, we can then make a few changes to the above:

First, we find the first row where we go over the threshold: this is the only row with partial values. We can then set its units_allocated value to total - the proceeding row's value, which is the remainder.

For every other row, we check if the cumulative sum is greater than the threshold: if so, set units_allocated to 0, if not, set units_allocated to the units_of_mass:

diet_plan_sum %>%
 arrange(desc(health_pts)) %>%
 mutate(cum_sum = cumsum(units_of_mass),
 # Find the first row where we go over the threshold, set it to remainder
 units_allocated = if_else(cum_sum > total_units_desired & lag(cum_sum) < total_units_desired,
 total_units_desired - lag(cum_sum),
 if_else(cum_sum > total_units_desired,
 0,
 units_of_mass))) %>%
 select(-cum_sum) # Drop cum_sum variable

 fruit units_of_mass health_pts units_allocated
1 bannana 16 6 16
2 apple 9 5 9
3 orange 11 3 7
4 cherry 7 1 0