Trainees and Rotas: an Assignment Problem

- 6 mins

I saw this tweet last night on Twitter:

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
Danny Wong

Danny Wong

Anaesthetist & Health Services Researcher

comments powered by Disqus
rss facebook twitter github youtube mail spotify instagram linkedin google pinterest medium