Rearrange observations to add up to desired value - data.table? - r

Question

I have a data table with a number of observations - each has a non unique ID and integer X value.
grouped by ID. I want the sum of X for each group to be larger than 10. To achieve this, each observation is allowed to change its ID as long as the sum of X for the original group does not go below 10.
Below is an example of what I mean and a very manual solution:
# sample data
input <-data.table(ID = c("A", "A", "A", "B", "B", "B" ,
"C", "C", "C", "D", "D", "D"),
X = c(1, 3, 1, 5, 1, 5,
6, 10, 2, 3, 3, 4))
# summarise X by ID
input[, .(X = sum(X)), by = ID]
ID X
A 5
B 11
C 18
D 10
# what the output should look like
output <- data.table(ID = c("A", "A", "A", "B", "B", "B" ,
"A", "C", "C", "D", "D", "D"),
X = c(1, 3, 1, 5, 1, 5,
6, 10, 2, 3, 3, 4))
output[, .(X = sum(X)), by = ID]
ID X
A 11
B 11
C 12
D 10
output
ID X
A 1
A 3
A 1
B 5
B 1
B 5
A 6 - this observation changed ID from C to A to get group A to 11
C 10
C 2
This is obviously a very simple example as only group C has enough spare capacity to donate observations. In reality there might be cases when multiple groups are able to give away observations and when more than one observation has to be modified, however there will only ever be up to 4 groups between which movement can happen.
Is it possible to automate this process in R?

Answer 1

Here is a possible heuristic approach. First, subset to those IDs with less than or greater than 10 (say, there are N of these IDs). Then, distribute the values from these IDs in descending order into smallest of these N buckets.
b <- 10
input <- data.table(ID = c("A", "A", "A", "B", "B", "B", "C", "C", "C", "D", "D", "D"),
X = c(1, 3, 1, 5, 1, 5, 6, 10, 2, 3, 3, 4))
#find the IDs that need redistribution
scramID <- input[, sum(X), by = ID][V1!=b, ID]
#extract the values for those IDs
x <- input[ID %in% scramID, sort(X, decreasing=TRUE)]
#create list of empty vectors as buckets
l <- replicate(length(scramID), vector('integer'))
#assign the values starting with largest to the bucket with the smallest sum
for (k in x) {
i <- which.min(lapply(l, sum))
l[[i]] <- c(l[[i]], k)
}
#rbind to original dataset to get result
names(l) <- scramID
ans <- rbindlist(list(
setnames(setDT(stack(l)), c("X","ID")),
input[!ID %in% scramID]
), use.names=TRUE)
output:
X ID
1: 10 A
2: 1 A
3: 1 A
4: 6 B
5: 3 B
6: 2 B
7: 5 C
8: 5 C
9: 1 C
10: 3 D
11: 3 D
12: 4 D
and the distribution of values:
> ans[, sum(X), by = ID]
ID V1
1: A 12
2: B 11
3: C 11
4: D 10
For this example, the IDs chosen for redistribution are A, B and C. There are three buckets. The values for these IDs in descending order is 10, 6, 5, 5, 3, 2, 1, 1 and 1.
In the first 3 iterations, 10, 6 and 5 are assigned to first, second and third buckets respectively.
The next number is 5 and this is assigned to the third bucket with the number 5 since it has the smallest sum (5) of the three buckets.
The next number, 3, is assigned to the second bucket since it has the smallest sum (6) of the three buckets.
And so on for the rest of the numbers.