Trainees and Rotas: an Assignment Problem
- 6 minsI saw this tweet last night on Twitter:
The worst solution is:
— Graham McCracken (@grahamccracken) January 30, 2020
Line A - Person 1
B - 2
C - 8
D - 6
E - 4
F - 3
G - 7
H - 5
This has a mean choice of 6.5 out of 8.
What's the best combination? https://t.co/HKPrn5MizT pic.twitter.com/ZeWnCVmHhC
Graham McCracken raised a problem that is frequently encountered by hospital consultants and junior doctors who are in charge of the rota: fairly assigning rota slots to trainees according to their preferences. Of course this is essentially an example of the Assignment Problem.
So I decided to have a go at solving this problem using the lpSolve
package in R
.
# Load library
library(lpSolve)
# Set up the Trainees' preferences
prefT <- matrix(c(1, 1, 1, 1, 1, 1, 1, 1,
2, 6, 2, 2, 2, 2, 2, 2,
3, 8, 8, 6, 5, 6, 7, 8,
4, 5, 7, 3, 7, 8, 6, 3,
5, 4, 3, 7, 3, 4, 5, 6,
6, 3, 6, 5, 4, 3, 4, 5,
7, 2, 4, 8, 6, 5, 8, 7,
8, 7, 5, 4, 8, 7, 3, 4),
nrow = 8, ncol = 8, byrow = TRUE,
dimnames = list(LETTERS[1:8],
1:8))
prefT
## 1 2 3 4 5 6 7 8
## A 1 1 1 1 1 1 1 1
## B 2 6 2 2 2 2 2 2
## C 3 8 8 6 5 6 7 8
## D 4 5 7 3 7 8 6 3
## E 5 4 3 7 3 4 5 6
## F 6 3 6 5 4 3 4 5
## G 7 2 4 8 6 5 8 7
## H 8 7 5 4 8 7 3 4
After loading up the lpSolve
package, we set up the Trainees’ (numbered 1 to 8) preferences (prefT
) for particular rota lines (A to H) in a matrix. After we have set up the preferences, we can use the lp.assign()
function to perform the match.
# Run the assignment
matching <- lp.assign(prefT)
matching$solution
## [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8]
## [1,] 0 0 0 0 0 0 0 1
## [2,] 0 0 0 0 1 0 0 0
## [3,] 1 0 0 0 0 0 0 0
## [4,] 0 0 0 1 0 0 0 0
## [5,] 0 0 1 0 0 0 0 0
## [6,] 0 0 0 0 0 1 0 0
## [7,] 0 1 0 0 0 0 0 0
## [8,] 0 0 0 0 0 0 1 0
The lp.assign()
returns the solution of the match as a matrix. There should be more than 1 permutation of the solution available but in this instance, the function only returns one permutation. We can then view the result.
# Make a dataframe of the results in a human interpretable format
Rota <- rownames(prefT)
ix <- round(matching$solution %*% seq_len(ncol(prefT)))
Trainee <- colnames(prefT)[ifelse(ix == 0, NA, ix)]
Preference <- t(prefT)[as.logical(t(matching$solution))]
results <- data.frame(Rota, Trainee, Preference)
# Print the results dataframe
knitr::kable(results)
Rota | Trainee | Preference |
---|---|---|
A | 8 | 1 |
B | 5 | 2 |
C | 1 | 3 |
D | 4 | 3 |
E | 3 | 3 |
F | 6 | 3 |
G | 2 | 2 |
H | 7 | 3 |
As you can see, 1 Trainee received their 1st choice, 2 received their 2nd choices, and the remaining 5 received their 3rd choices. This gives a mean preference ranking of 2.5 for this solution, which is the best result if you were to try every single permutation of Rota and Trainee there is available. For 8 Rota lines and 8 Trainees, the number of possible permutations would be 8! = 40320.
Also, in this example we have 8 trainees for 8 rota lines, but we could presumably also reformulate it for fewer trainees if there are rota gaps.
sessionInfo()
## R version 3.5.2 (2018-12-20)
## Platform: x86_64-w64-mingw32/x64 (64-bit)
## Running under: Windows 10 x64 (build 17763)
##
## Matrix products: default
##
## locale:
## [1] LC_COLLATE=English_United Kingdom.1252
## [2] LC_CTYPE=English_United Kingdom.1252
## [3] LC_MONETARY=English_United Kingdom.1252
## [4] LC_NUMERIC=C
## [5] LC_TIME=English_United Kingdom.1252
##
## attached base packages:
## [1] stats graphics grDevices utils datasets methods base
##
## other attached packages:
## [1] lpSolve_5.6.15 knitr_1.25
##
## loaded via a namespace (and not attached):
## [1] compiler_3.5.2 magrittr_1.5 htmltools_0.3.6 tools_3.5.2
## [5] Rcpp_1.0.1 rmarkdown_1.16 stringi_1.1.7 highr_0.7
## [9] digest_0.6.16 stringr_1.3.1 xfun_0.10 packrat_0.4.9-3
## [13] evaluate_0.14