updated roommate code and vignettes; changed indexing from C++ to R s…

…tyle; now accommodating square matrices as inputs for onesided()

R/RcppExports.R

@@ -64,7 +64,8 @@ stableRoommateMatching <- function(pref) {
 #' one-to-many, or many-to-one matching is stable.
 #'
 #' @param pref is a matrix with ordinal rankings of the participants
-#' @param matchings is an nx1 matrix encoding who is matched to whom
+#' @param matchings is an nx1 matrix encoding who is matched to whom using
+#' R style indexing
 #' @return true if the matching is stable, false otherwise
 checkStabilityRoommate <- function(pref, matchings) {
     .Call('matchingR_checkStabilityRoommate', PACKAGE = 'matchingR', pref, matchings)

R/galeshapley.R

@@ -292,3 +292,28 @@ validateInputs = function(proposerUtils, reviewerUtils, proposerPref, reviewerPr
         )
     )
 }
+
+
+#' Check if preference order is complete
+#'
+#' This function checks if a given preference ordering is complete. If needed
+#' it transforms the indices from R indices (starting at 1) to C++ indices
+#' (starting at zero).
+#'
+#' @param pref is a matrix with a preference ordering
+#' @return a matrix with preference orderings with proper C++ indices or NULL
+#' if the preference order is not complete.
+checkPreferenceOrder = function(pref) {
+
+    # check if pref is using R instead of C++ indexing
+    if(all(apply(pref,2,sort) == array(1:(NROW(pref)), dim = dim(pref)))) {
+        return(pref-1)
+    }
+
+    # check if pref has a complete listing otherwise given an error
+    if(all(apply(pref,2,sort) == (array(1:(NROW(pref)), dim = dim(pref)))-1)) {
+        return(pref)
+    }
+
+    return(NULL)
+}

R/roommate.R

@@ -9,18 +9,23 @@
 #' if element (4, 6) of this matrix is 2, then agent 4 ranks agent 2 6th. The
 #' matrix accepts either 0-based indexing (C++ style) or 1-based indexing (R
 #' style).
-#' @param prefUtil An n-1xn matrix, each column representing ordinal preferences
+#' @param utils An n-1xn matrix, each column representing ordinal preferences
 #' of each agent over agents 1, 2, ..., i-1, i+1, i+2, ... n. For example, if
 #' element (4, 6) of this matrix is 2, then agent 4 gets utility 2 from agent
 #' 6.
-#' @return A list of length n corresponding to the matchings being made, so that
-#' e.g. if the 4th element is 6 then agent 4 was matched with agent 6.
+#' @return A vector of length n corresponding to the matchings being made, so that
+#' e.g. if the 4th element is 6 then agent 4 was matched with agent 6. This vector
+#' uses R style indexing. If no stable matching exists, it returns NULL.
 #' @examples
-#' results = onesided(prefUtil = replicate(4, rnorm(3)))
-onesided = function(pref = NULL, prefUtil = NULL) {
-    args = validateInputsOneSided(pref = pref, prefUtil = prefUtil);
+#' results = onesided(utils = replicate(4, rnorm(3)))
+onesided = function(pref = NULL, utils = NULL) {
+    args = validateInputsOneSided(pref = pref, utils = utils);
     res = stableRoommateMatching(args);
-    return(res$matchings);
+    if (length(res$matchings) == NCOL(args)) {
+        return(res$matchings + 1)
+    } else {
+        return(NULL)
+    }
 }
 
 
@@ -31,22 +36,29 @@ onesided = function(pref = NULL, prefUtil = NULL) {
 #' 1), then it re-numbers the preference matrix to use C++ style indexing.
 #'
 #' @param pref is an n-1xn matrix, with each row representing an ordinal ranking.
-#' @param prefUtil if an n-1xn matrix, with each row representing the cardinal preferences
+#' @param utils if an n-1xn matrix, with each row representing the cardinal preferences
 #' of the agents.
 #' @return The validated inputs, ready to be sent to C++ code.
-validateInputsOneSided = function(pref = NULL, prefUtil = NULL) {
+validateInputsOneSided = function(pref = NULL, utils = NULL) {
 
     # Convert cardinal utility to ordinal, if necessary
-    if (is.null(pref) && !is.null(prefUtil)) {
-        pref = sortIndexOneSided(as.matrix(prefUtil))
-    }
+    if (is.null(pref) && !is.null(utils)) {
 
-    # check inputs
-    if (NROW(prefUtil)+1 != NCOL(prefUtil)) {
-        stop("preference matrix must be n-1xn")
+        # remove main diagonal from matrix if NROW = NCOL
+        if (NROW(utils) == NCOL(utils)) {
+            utils = matrix(
+                utils[-c(seq(from = 1, to = NROW(utils) ^ 2, length.out = NROW(utils)))],
+                nrow = NROW(utils) - 1, ncol = NCOL(utils))
+        }
+
+        if (NROW(utils) + 1 != NCOL(utils)) {
+            stop("preference matrix must be n-1xn")
+        }
+
+        pref = sortIndexOneSided(as.matrix(utils))
     }
 
-    if (NROW(pref)+1 != NCOL(pref)) {
+    if (NROW(pref) + 1 != NCOL(pref)) {
         stop("preference matrix must be n-1xn")
     }
 
@@ -59,3 +71,35 @@ validateInputsOneSided = function(pref = NULL, prefUtil = NULL) {
 
     return(pref)
 }
+
+#' Check if preference order for a one-sided market is complete.
+#'
+#' @param pref is a matrix with a preference ordering for a one-sided market.
+#' If necessary transforms the indices from R indices (starting at 1) to C++
+#' indices (starting at 0).
+#' @return a matrix with preference orderings with proper C++ indices or NULL
+#' if the preference order is not complete.
+checkPreferenceOrderOnesided = function(pref) {
+
+    # check if pref is using R instead of C++ indexing
+    if (all(apply(rbind(pref, c(1:NCOL(pref))), 2, sort) ==
+            matrix(1:NCOL(pref), nrow = NCOL(pref), ncol = NCOL(pref)))) {
+        return(pref - 1)
+    }
+
+    comp = array(1:(NROW(pref)), dim = dim(pref)) - 1
+    for (i in 1:NROW(comp)) {
+        for (j in 1:NCOL(comp)) {
+            if (i >= j) {
+                comp[i, j] = comp[i, j] + 1;
+            }
+        }
+    }
+
+    # check if pref has a complete listing otherwise given an error
+    if (all(apply(pref,2,sort) == comp)) {
+        return(pref)
+    }
+
+    return(NULL)
+}

R/utils.R

@@ -3,7 +3,7 @@
 #' Repeat each column of a matrix n times
 #'
 #' This function repeats each column of a matrix n times
-#' 
+#'
 #' @param x is the input matrix
 #' @param n is the number of repetitions
 #' @return matrix with repeated columns
@@ -15,7 +15,7 @@ repcol<-function(x,n){
 #' Repeat each row of a matrix n times
 #'
 #' This function repeats each row of a matrix n times
-#' 
+#'
 #' @param x is the input matrix
 #' @param n is the number of repetitions
 #' @return matrix with repeated rows
@@ -24,57 +24,3 @@ reprow<-function(x,n){
     matrix(x[rep(1:s, each=n),], nrow=NROW(x)*n, ncol=NCOL(x))
 }
 
-#' Check if preference order is complete
-#'
-#' This function checks if a given preference ordering is complete. If needed
-#' it transforms the indices from R indices (starting at 1) to C++ indices
-#' (starting at zero).
-#' 
-#' @param pref is a matrix with a preference ordering
-#' @return a matrix with preference orderings with proper C++ indices or NULL 
-#' if the preference order is not complete.
-checkPreferenceOrder = function(pref) {
-
-    # check if pref is using R instead of C++ indexing
-    if(all(apply(pref,2,sort) == array(1:(NROW(pref)), dim = dim(pref)))) {
-        return(pref-1)
-    }
-
-    # check if pref has a complete listing otherwise given an error
-    if(all(apply(pref,2,sort) == (array(1:(NROW(pref)), dim = dim(pref)))-1)) {
-        return(pref)
-    }  
-
-    return(NULL)
-}
-
-#' Check if preference order for a one-sided market is complete.
-#'
-#' @param pref is a matrix with a preference ordering for a one-sided market. 
-#' If necessary transforms the indices from R indices (starting at 1) to C++
-#' indices (starting at 0).
-#' @return a matrix with preference orderings with proper C++ indices or NULL 
-#' if the preference order is not complete.
-checkPreferenceOrderOnesided = function(pref) {
-
-    # check if pref is using R instead of C++ indexing
-    if(all(apply(pref,2,sort) == array(1:(NROW(pref)), dim = dim(pref)))) {
-        return(pref-1)
-    }
-
-    comp = array(1:(NROW(pref)), dim = dim(pref))-1
-    for (i in 1:NROW(comp)) {
-        for (j in 1:NCOL(comp)) {
-            if (i >= j) {
-                comp[i, j] = comp[i, j] + 1;
-            }
-        }
-    }
-
-    # check if pref has a complete listing otherwise given an error
-    if(all(apply(pref,2,sort) == comp)) {
-        return(pref)
-    }  
-
-    return(NULL)
-}

README.md

@@ -32,9 +32,9 @@ devtools::install_github("jtilly/matchingR.git")
 
 ## Documentation
 * [Reference Manual](http://jtilly.io/matchingR/matchingR-documentation.pdf "Computing Stable Matchings in R: Reference Manual for matchingR")
-* [Vignette: Matching Algorithms in R: An Introduction to matchingR](http://jtilly.io/matchingR/matchingR-intro.html "Matching Algorithms in R: An Introduction to matchingR")
-* [Vignette: Computing the Gale-Shapley Algorithm in R: Performance](http://jtilly.io/matchingR/matchingR-performance-galeshapley.html "Computing the Gale-Shapley Algorithm in R: Performance")
-* [Vignette: Solving the Stable Roommate Problem in R: Performance](http://jtilly.io/matchingR/matchingR-performance-roommate.html "Solving the Stable Roommate Problem in R: Performance")
+* [Vignette: Matching Algorithms in R: An Introduction to matchingR](http://jtilly.io/matchingR/matchingR-intro.pdf "Matching Algorithms in R: An Introduction to matchingR")
+* [Vignette: Computing the Gale-Shapley Algorithm in R: Performance](http://jtilly.io/matchingR/matchingR-performance-galeshapley.pdf "Computing the Gale-Shapley Algorithm in R: Performance")
+* [Vignette: Solving the Stable Roommate Problem in R: Performance](http://jtilly.io/matchingR/matchingR-performance-roommate.pdf "Solving the Stable Roommate Problem in R: Performance")
 
 ## Gale-Shapley Algorithm: How does it work?
 Consider a market with three men and three women. The men's preferences are given by

man/checkPreferenceOrder.Rd

@@ -1,5 +1,5 @@
 % Generated by roxygen2 (4.1.1): do not edit by hand
-% Please edit documentation in R/utils.R
+% Please edit documentation in R/galeshapley.R
 \name{checkPreferenceOrder}
 \alias{checkPreferenceOrder}
 \title{Check if preference order is complete}

man/checkPreferenceOrderOnesided.Rd

@@ -1,5 +1,5 @@
 % Generated by roxygen2 (4.1.1): do not edit by hand
-% Please edit documentation in R/utils.R
+% Please edit documentation in R/roommate.R
 \name{checkPreferenceOrderOnesided}
 \alias{checkPreferenceOrderOnesided}
 \title{Check if preference order for a one-sided market is complete.}

man/checkStabilityRoommate.Rd

@@ -9,7 +9,8 @@ checkStabilityRoommate(pref, matchings)
 \arguments{
 \item{pref}{is a matrix with ordinal rankings of the participants}
 
-\item{matchings}{is an nx1 matrix encoding who is matched to whom}
+\item{matchings}{is an nx1 matrix encoding who is matched to whom using
+R style indexing}
 }
 \value{
 true if the matching is stable, false otherwise

man/onesided.Rd

@@ -4,7 +4,7 @@
 \alias{onesided}
 \title{Compute matching for one-sided markets}
 \usage{
-onesided(pref = NULL, prefUtil = NULL)
+onesided(pref = NULL, utils = NULL)
 }
 \arguments{
 \item{pref}{An n-1xn matrix, with each column representing the cardinal
@@ -13,21 +13,22 @@ if element (4, 6) of this matrix is 2, then agent 4 ranks agent 2 6th. The
 matrix accepts either 0-based indexing (C++ style) or 1-based indexing (R
 style).}
 
-\item{prefUtil}{An n-1xn matrix, each column representing ordinal preferences
+\item{utils}{An n-1xn matrix, each column representing ordinal preferences
 of each agent over agents 1, 2, ..., i-1, i+1, i+2, ... n. For example, if
 element (4, 6) of this matrix is 2, then agent 4 gets utility 2 from agent
 6.}
 }
 \value{
-A list of length n corresponding to the matchings being made, so that
-e.g. if the 4th element is 6 then agent 4 was matched with agent 6.
+A vector of length n corresponding to the matchings being made, so that
+e.g. if the 4th element is 6 then agent 4 was matched with agent 6. This vector
+uses R style indexing. If no stable matching exists, it returns NULL.
 }
 \description{
 This function returns a stable roommate matching for a one-sided market
 using Irving (1985)'s algorithm. Stable matchings are neither guaranteed
 to exist, nor to be unique. If no stable matching exists, 0 is returned.
 }
 \examples{
-results = onesided(prefUtil = replicate(4, rnorm(3)))
+results = onesided(utils = replicate(4, rnorm(3)))
 }
 

man/validateInputsOneSided.Rd

@@ -4,12 +4,12 @@
 \alias{validateInputsOneSided}
 \title{Input validation for one-sided markets}
 \usage{
-validateInputsOneSided(pref = NULL, prefUtil = NULL)
+validateInputsOneSided(pref = NULL, utils = NULL)
 }
 \arguments{
 \item{pref}{is an n-1xn matrix, with each row representing an ordinal ranking.}
 
-\item{prefUtil}{if an n-1xn matrix, with each row representing the cardinal preferences
+\item{utils}{if an n-1xn matrix, with each row representing the cardinal preferences
 of the agents.}
 }
 \value{

src/roommate.cpp

@@ -182,11 +182,14 @@ List stableRoommateMatching(const umat pref) {
 //' one-to-many, or many-to-one matching is stable.
 //'
 //' @param pref is a matrix with ordinal rankings of the participants
-//' @param matchings is an nx1 matrix encoding who is matched to whom
+//' @param matchings is an nx1 matrix encoding who is matched to whom using
+//' R style indexing
 //' @return true if the matching is stable, false otherwise
 // [[Rcpp::export]]
 bool checkStabilityRoommate(umat& pref, umat& matchings) {
 
+    matchings = matchings - 1;
+
     // loop through everyone and check whether there's anyone else
     // who they'd rather be with
     for (uword i=0; i<pref.n_cols; i++) {

tests/testthat/test_matching.R

@@ -155,17 +155,16 @@ test_that("Assortative matching?", {
 })
 
 test_that("Stable roommate?", {
-    for (i in c(4, 8, 16, 32, 64, 128, 256, 512)) {
-        p = validateInputsOneSided(prefUtil = replicate(i, rnorm(i-1)))
+    set.seed(1)
+    for (i in c(4, 8, 16, 32, 128, 256)) {
+        p = validateInputsOneSided(utils = replicate(i, rnorm(i-1)))
         results = onesided(pref = p)
-        if (!is.integer(results)) {
-            expect_true(checkStabilityRoommate(pref = p, matchings = results))
-        }
+        expect_true(checkStabilityRoommate(pref = p, matchings = results))
     }
 })
 
 test_that("Check preference orderings for one sided matching", {
     p = as.matrix(c(0, 1, 2), nrow = 1, ncol = 3)
     expect_error(validateInputsOneSided(pref = p))
-    expect_error(validateInputsOneSided(prefUtil = p))
-})
+    expect_error(validateInputsOneSided(utils = p))
+})