public
Created

Gale-Shapley Algorithm

  • Download Gist
gale_shapley.R
R
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30
# Gale-Shapley matching
# From http://plausibel.blogspot.com/2012/01/illustrating-deferred-acceptance.html
 
doInstall <- TRUE # Change to FALSE if you don't want packages installed.
toInstall <- c("devtools", "animation")
if(doInstall){install.packages(toInstall, repos = "http://cran.r-project.org")}
lapply(toInstall, library, character.only = TRUE)
 
# Source the daa() function:
source_gist("1628636")
 
nOptions <- 15 # Although these matrices don't have to have the same dims
mPrefs <- t(replicate(nOptions, sample(1:nOptions, nOptions)))
wPrefs <- replicate(nOptions, sample(1:nOptions, nOptions))
 
heatmap(mPrefs, Rowv = NA, Colv = NA)
heatmap(wPrefs, Rowv = NA, Colv = NA)
 
galeShapleyResult <- daa(nMen = nOptions,
nWomen = nOptions,
m.prefs = mPrefs,
w.prefs = wPrefs)
print(galeShapleyResult)
 
matchMatrix <- 1*(matrix(rep(galeShapleyResult$matches, each=nOptions),
nrow=nOptions,
ncol=nOptions)==matrix(data=1:nOptions,
nrow=nOptions,ncol=nOptions,byrow=F))
 
heatmap(1-matchMatrix, Rowv = NA, Colv = NA)

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.