Ekonomia stosowana - matching markets

Published:

```{r setup, include=FALSE} knitr::opts_chunk$set(echo = TRUE, cache=TRUE) ``` ## Intro Na dzisiejszych zajęciach będziemy testować bibliotekę [matchingMarkets](https://cran.r-project.org/web/packages/matchingMarkets/index.html ). Jeśli nie mamy biblioteki, należy ją oczywiście najpierw zainstalować z pomocą komendy. ```{r eval=FALSE} install.packages("matchingMarkets") ``` Jeśli biblioteka jest już zainstalowana, ładujemy ją poleceniem: ```{r} library(matchingMarkets) rm(list=ls()) ``` Zaczniemy od podstawowej funkcji *iaa.R* ktora pozwoli nam porównać algorytm bostoński (tj. *immediate-acceptance*) z algorytmem Gale-Shapley'a. Podejrzyjmy najpierw funkcję *iaa*. ```{r eval=FALSE} help(iaa) ``` Pokazuje nam się pełny plik pomocy. Na razie najciekawsza dla nas jest składnia, która wygląda tak: ```{r eval=FALSE} iaa( nStudents = ncol(s.prefs), nColleges = ncol(c.prefs), nSlots = rep(1, nColleges), s.prefs = NULL, c.prefs = NULL, acceptance = "immediate", short_match = TRUE, seed = NULL ) ``` Resztę pomocy i przykłady możemy sobie pooglądać w [oficjalnym podręczniku biblioteki **matchingMarkets**](https://cran.r-project.org/web/packages/matchingMarkets/matchingMarkets.pdf) ### Boston mechanism Zacznijmy od najprostszego przykładu z losowymi preferencjami studentów. Funkcja *set.seed* pozwala na ustalenie ziarna generatora, a zatem pozwala, by losowe preferencje były te same dla obu algorytmów, które chcemy porównać. Przyjmijmy, że chcemy dopasować 24 studentów do 3 uczelni, na każdej jest 6 miejsc. Dla ustalenia uwagi przyjmijmy, że każdy student woli być przypisany do \emph{jakiejś uczelni} niż nieprzypisany. Preferencje ustawią się losowo, ale wydrukujmy je. ```{r} set.seed(20) boston <- iaa(nStudents=24, nSlots=c(6,6,6)) print(boston$s.prefs) print(boston$c.prefs) ``` Ostateczne dopasowanie ```{r} print(boston$matchings) ``` Kto się nie dostał do żadnej szkoły? ```{r} print(boston$singles) ``` A ilu studentów - z tych, którzy się dostali - dostało się do szkoły pierwszego wyboru? ```{r} matchBoston <- data.frame(students=boston$matchings$student,college=boston$matchings$college) boston$s.prefs[1,matchBoston$students]==matchBoston$college ``` ### Student-propose Deferred Acceptance Porównajmy wyniki z algorytmem DA ```{r} set.seed(20) deferredAcceptance <- iaa(nStudents=24, nSlots=c(6,6,6),acceptance = "deferred") print(deferredAcceptance$s.prefs) print(deferredAcceptance$c.prefs) ``` Ostateczne dopasowanie ```{r} print(deferredAcceptance$matchings) ``` Kto się nie dostał do żadnej szkoły? Porównajmy: ```{r} # DA print(deferredAcceptance$singles) # Boston print(boston$singles) ``` Teraz porównamy oba dopasowania. Żeby obraz porównania był pełen, dołączymy do tablicy dopasowań maturzystów, którzy nie dostali się na żadną uczelnię. Dla ustalenia uwagi, przypiszemy im numer uczelni 0. ```{r} matchBoston <- rbind(matchBoston, data.frame(students=boston$singles, college=rep(0,length(boston$singles))) ) matchDA <- data.frame(students = c(deferredAcceptance$matchings$student, deferredAcceptance$singles), college = c(deferredAcceptance$matchings$college, rep(0,length(deferredAcceptance$singles))) ) matchDif <- data.frame(student=c(1:24), colBoston = matchBoston[order(matchBoston$students),2], colDA = matchDA[order(matchDA$students),2], isSame = (matchDA[order(matchDA$students),2]==matchBoston[order(matchBoston$students),2]) ) print(matchDif) ``` ### Analiza - niestabilne dopasowanie Przyjrzyjmy się bliżej dopasowaniu bostońskiemu. Zauważmy, że agent 11 nie został nigdzie zrekrutowany. Ale jest on wysoko na liście preferencji uczelni 2 oraz 3. W szczególności, uczelnia 2 chętnie by wymieniła jednego ze swoich 'ostatnich' przyjętych studentów (np. 7, 10, 22) na studenta 11 i on również wolałby być przyjęty na uczelnię 2 niż nieprzyjęty. Również uczelnia 3 chętnie by wymieniła któregoś ze swoich przyjętych na ucznia nr 11. Jest to jeden z przykładów niestabilności mechanizmu bostońskiego. Co więcej, zauważmy, że agent 11 (i nie tylko...) ma bodźce do strategicznego "kłamstwa" na temat swoich preferencji. Jego prawdziwe preferencje to $1,2,3$. Sprawdźmy co by się stało, gdyby - wiedząc, że na uczelni 3 ma bardzo duże szanse przyjęcia - przedstawił je jako $3,1,2$. ```{r} s.prefsNew <- boston$s.prefs s.prefsNew[,11] <- c(3,1,2) c.prefsNew <- boston$c.prefs nSlotsNew <- c(6,6,6) ``` Przy okazji przetestujemy podstawową funkcjonalność biblioteki, czyli konstrukcję dopasowań dla **zadanych** preferencji. W zastosowaniach jest to oczywiście 'standardowe' zastosowanie algorytmu. Porównajmy, jak wygląda teraz dopasowanie według obu algorytmów. ```{r, results="hide"} bostonNew <- iaa(s.prefs=s.prefsNew, c.prefs=c.prefsNew, nSlots = nSlotsNew, acceptance="immediate") deferredAcceptanceNew <- iaa(s.prefs=s.prefsNew, c.prefs=c.prefsNew, nSlots = nSlotsNew, acceptance="deferred") ``` ```{r} print(data.frame(boston=bostonNew$matching,DA=deferredAcceptanceNew$matching)) ``` Zauważmy, że kłamstwo nt. swoich preferencji poprawiło sytuację gracza 11 przy mechanizmie bostońskim, ale pogorszyło przy deferred--aceptance. Dlaczego? Przy DA gracz 11 był *wystarczająco dobry* by dostać się do uczelni numer 2, która jest wyżej w jego prawdziwych preferencjach. Zgodnie z działaniem algorytmu DA uczeń dostaje się do najlepszej uczelni, do jakiej może, a więc kłamstwo nt. preferencji w najepszym wypadku nie zmieni dopasowania, a w niektórych przypadkach -- jak tu - pogorszy sytuację.