Matching Soulmates (JPET)


Leo, Greg and Lou, Jian and Van der Linden, Martin and Vorobeychik, Yevgeniy and Wooders, Myrna H., "Matching Soulmates." Journal of Public Economic Theory. forthcoming


Matching Soulmates

Matching Soulmates in R

#Operator "m %r% f" applies function "f" to matrix "m" by rows. 
%r% <- function(m,f){t(apply(m,1,}

#Operator "m %rm% i" removes rows and column indicies "i" from matrix "m". 
%rm% <- function(m,i){if(length(i)>0){m[-i,-i]}else{m}}

#Operator applies function "f" across list "l" with sapply. %s% <- function(l,f){sapply(l,} #Returns Hadamard product of matrix m with its transpose. hadamard <- function(m){m * t(m)} #Given preference matrix, returns vector of player indicies who are first-order soulmates. whos_a_soulmate <- function(p){which((p%r%rank%>%hadamard%r%min)==1)} #Removes first order soulmates from preference matrix p. remove_soulmates <- function(p){p %rm% whos_a_soulmate(p) %>% as.matrix} #Recursively applies remove_soulmates until there's none left to remove. ims <- function(p){if(dim(p)[1]==0 || identical(remove_soulmates(p),p)){p}else{ims(remove_soulmates(p))}} #Create a random roommates preference matrix with "dim" players. create_preference <- function(dim){ p <- matrix(runif(dim*dim),dim,dim,byrow=TRUE) diag(p)<- 1 p %r% rank } #Set up parameters. "dim" is the number of players. "n" is the number of random trials. dim <- 10 n <- 100 #Create List of "n" Preference Matricies with "dim" players. preference_list <- lapply(1:n,function(x){create_preference(dim)}) #Apply IMS to the list of preferences then count the number of players remaining. remaining <- preference_list %s% ims %s% dim #Get the number of players removed by IMS. removed <- dim - remaining[1,] #Make a table of frequencies of the number of removed players. removed %>% table/n