Intro

Na dzisiejszych zajęciach będziemy poznawać dalsze funckje biblioteki matchingMarkets. Zakładam, że jest zainstalowana, ładujemy ją poleceniem:

library(matchingMarkets)
rm(list=ls())

Przetestujemy dziś dwa algorytmy stanowiące uogólnienie prostego mechanizmu rekrutacji, tj. funkcje hri oraz hri2.

help(hri)

Składnia hri jest bardzo podobna do zeszłotygodniowej funkcji iaa. Funkcja ma również możliwość generowania losowych preferencji, co przyda nam się w prostych przykładach.

Deferred-acceptance z niepełymi listami

Ważną cechą algorytmu hri jest to, że produkuje wszystkie dopasowania stabline. Dla prostego modelu rekrutacji algorytmy hri i iaa(.,acceptance=“deferred”) działają tak samo, z tym, że iaa zaraportuje tylko dopasowanie optymalne dla studentóe, a hri - wszystkie dopasowania stabline.

Sprawdźmy to!

daResults <- iaa(nStudents=14, nSlots=c(4,4,4), acceptance = "deferred", seed=10)
hriResults <- hri(nStudents=14, nSlots=c(4,4,4), seed=10)
print(daResults$matchings)
##    college student
## 1        1       6
## 4        1       8
## 2        1      12
## 3        1      14
## 7        2       1
## 8        2       2
## 6        2       5
## 5        2       9
## 9        3       3
## 11       3       7
## 12       3      10
## 10       3      13
print(hriResults$matchings)
##    matching college slots student sOptimal cOptimal sRank cRank
## 1         1       1     4      12        1        0     4     7
## 2         1       1     3      14        1        0     7     6
## 3         1       1     2       6        1        0     2     5
## 4         1       1     1       8        1        0     5     3
## 5         1       2     5       1        1        0     9     2
## 6         1       2     8       2        1        0     8     7
## 7         1       2     7       5        1        0     7     6
## 8         1       2     6       9        1        0     2     3
## 9         1       3    10      10        1        0     6     2
## 10        1       3    11      13        1        0     3     3
## 11        1       3     9       3        1        0     1     1
## 12        1       3    12       7        1        0    12     5
## 13        2       1     4      14        0        1     8     6
## 14        2       1     1       2        0        1     9     2
## 15        2       1     3       6        0        1     3     5
## 16        2       1     2       8        0        1     6     3
## 17        2       2     5       1        0        1     9     2
## 18        2       2     7      12        0        1     7     4
## 19        2       2     8       5        0        1     8     6
## 20        2       2     6       9        0        1     2     3
## 21        2       3    10      10        0        1     6     2
## 22        2       3    11      13        0        1     3     3
## 23        2       3     9       3        0        1     1     1
## 24        2       3    12       7        0        1    12     5

Zobaczmy, że kolumny sOptimal i cOptimal pokazują optymalne dopasowanie z punktu widzenia studenta i uczelni. To oznaczone jako optymalne dla studentów rzeczywiście pokrywa się z wynikami iaa(.,acceptance=“deferred”).

Kolejnym zastosowaniem hri są niepełne listy. Przyjmijmy, że niektórzy studenci dopuszczają tylko 2 uczelnie z 3 i wolą nie być nigdzie przypisani niż być przypisani do uczelni spoza listy. Podobnie uczelnie mogą woleć nie przyjąć nikogo niż przyjąć kogoś niespełniającego ich wymogów.

Zmodyfikujmy nieco preferencje, żeby zobaczyć, jak to działa

sPrefs <- hriResults$s.prefs.hri
cPrefs <- hriResults$c.prefs.hri
print(sPrefs[1:3,1:3])
##      1 2 3
## [1,] 3 3 3
## [2,] 1 2 1
## [3,] 2 1 2
print(cPrefs[11:14,1])
## [1]  4  7  5 10
sPrefs[3,1:3] <- NA  # trzech pierwszych studentów usuwa swoją ostatnią uczelnię
cPrefs[11:14,1]<-NA  # pierwsza uczelnia usuwa 4 najmniej preferowanych studentów

hriIncomplete <- hri(s.prefs = sPrefs, c.prefs = cPrefs, nSlots = c(4,4,4))
hriMatch <- hriResults$matchings[,c("sOptimal","college","student")]
hriIncMatch <- hriIncomplete$matchings[,c("sOptimal","college","student")] 

dif <- data.frame(CP = hriMatch[order(hriMatch$sOptimal,hriMatch$student),],
                 IP = hriIncMatch[order(hriIncMatch$sOptimal,hriIncMatch$student),])
print(dif)
##    CP.sOptimal CP.college CP.student IP.sOptimal IP.college IP.student
## 17           0          2          1           0          3         10
## 21           0          3         10           0          1         11
## 18           0          2         12           0          1         12
## 22           0          3         13           0          3         13
## 13           0          1         14           0          2         14
## 14           0          1          2           0          2          2
## 23           0          3          3           0          3          3
## 19           0          2          5           0          2          5
## 15           0          1          6           0          1          6
## 24           0          3          7           0          3          7
## 16           0          1          8           0          1          8
## 20           0          2          9           0          2          9
## 5            1          2          1           1          3         10
## 9            1          3         10           1          1         11
## 1            1          1         12           1          1         12
## 10           1          3         13           1          3         13
## 2            1          1         14           1          2         14
## 6            1          2          2           1          2          2
## 11           1          3          3           1          3          3
## 7            1          2          5           1          3          5
## 3            1          1          6           1          1          6
## 12           1          3          7           1          2          7
## 4            1          1          8           1          1          8
## 8            1          2          9           1          2          9

Jak widać, student 1 ‘wyleciał’ na skutek zmiany preferencji – na własne życzenie zresztą, skoro usunął ją z listy! Ciekawsze jest to, że w jednym ze stabilnych dopasowań zmienia się również sytuacja studenta 2.

Deferred acceptance z parami

Kolejną funkcją, którą dziś zbadamy, jest hri2, czyli kolejna modyfikacja DA, tym razem zezwalająca na preferencje par (niekompletne preferencje również). Uwaga: preferencje par podawane są w osobnej liście co.prefs (tj. par nie dokładamy do jednostkowych studentów) zapisywanej następująco: w każdym wierszy podane są 4 liczby: (partner1, partner2, (dwudymiarowe preferencje)).

sPrefs <- matrix(c(4,2,3,5, 2,1,3,NA, 1,2,3,4), 4,3) # tu są 3 studenci
coPrefs <- matrix(c(rep(4,3), rep(5,3), 3,3,NA, 3,NA,3), 3,4) # a tu jest jedna para - łącznie 5 chętnych
print(sPrefs)   # preferencje singli
##      [,1] [,2] [,3]
## [1,]    4    2    1
## [2,]    2    1    2
## [3,]    3    3    3
## [4,]    5   NA    4
print(coPrefs)  # preferencje par - zob. sposósb zapisu
##      [,1] [,2] [,3] [,4]
## [1,]    4    5    3    3
## [2,]    4    5    3   NA
## [3,]    4    5   NA    3
cPrefs <- matrix(rep(1:5,5), 5,5) # uczelnie są nudne, wszystkie chcą 1,2,3,4,5
hriWithCouples <- hri2(s.prefs = sPrefs, c.prefs = cPrefs, co.prefs = coPrefs)
print(hriWithCouples$matching)
##      student college
## [1,]       1       4
## [2,]       2       2
## [3,]       3       1
## [4,]       4       3

Wygląda niepozornie, ale to jest ten algorytm Rotha z wykładu, który – między innymi – dał mu Nobla!

Bonus - Top trading cycles

Ostatni algorytm, o którym tylko wspomnę to dwustronny top trading cycles, również obecny w paczce matchingMarkets. Realizuje go funkcja ttc2. Przetestujmy ją na naszym jedynym poznanym przykładzie:

sPrefs <- matrix(c(2,1,3,1,2,3,1,2,3),byrow = FALSE, ncol=3)
cPrefs <- matrix(c(1,3,2,2,1,3,2,1,3),byrow = FALSE, ncol=3)
topTC <- ttc2(s.prefs = sPrefs, c.prefs = cPrefs, nSlots =c(1,1,1))
colnames(topTC) <- c("student","college")
da <- hri(s.prefs = sPrefs, c.prefs = cPrefs, nSlots =c(1,1,1))
print(data.frame(da=da$matchings[,c("college","student")],topTC[,c("college","student")]))
##   da.college da.student college student
## 1          1          1       2       1
## 2          2          2       1       2
## 3          3          3       3       3