Number of unique compatible rank orders with missing data

Question

I have a series of individuals who have ranked items in particular orders. For example, 6 individuals ranking 4 items (individuals are rows, items are columns, values are their rank, e.g. individual 2 ranked item 4 2nd best).

set.seed(2109)
d= t(replicate(6,sample(1:4)))
d[sample(1:prod(dim(d)),3)] = NA
d[1,3] = 3
d[1,2] = NA
d[4,3] = 1
d[5,4] = 1
d
     [,1] [,2] [,3] [,4]
[1,]    1   NA    3    2
[2,]    1    3    4    2
[3,]    2    3    4    1
[4,]    2    3    1   NA
[5,]   NA    2    3    1
[6,]    1    3    2    4

I'd like to know how many unique compatible orders there are. However, some of the individuals have not ranked some of the items (missing data). For example, individual 1 and 2 above have a compatible order (being anti-conservative), and the same for individuals 3 and 4. So there are 4 unique compatible orders. Looking for unique orders does not work:

> length(unique(apply(d,1,paste,collapse='')))
[1] 6

I could go through each row and see if there is a compatible order using a regular expression, but that would only count 2 unique rows. Is there some formula or algorithm that will return the correct number of unique compatible orders?

Edit:

We can identify compatible pairs with the functions below. uniqueCompatibleOrders creates a matrix of compatibility between each pair of individuals, and returns the sum in the lower triangle.

matchCompatibleij = function(i,j,data){
  # Take two row indices and check if the 
  # ranks of the vectors of the rows in data
  # are in a compatible order.
  # Rows can include missing data.
  ix = data[i,]
  jx = data[j,]
  complete = !(is.na(ix)|is.na(jx))
  all(order(ix[complete])==order(jx[complete]))
}
matchCompatible <- Vectorize(matchCompatibleij, vectorize.args=list("i","j"))

uniqueCompatibleOrders = function(data){
  # Compare all individuals to all others,
  # checking if each is compatible
  matches = outer(1:nrow(data),1:nrow(data),matchCompatible,data=data)
  numCompatiblePairs = sum(matches[lower.tri(matches,diag = F)])
  return(numCompatiblePairs)
}

Then calculate the difference between the maximum number of unique pairs and the number of compatible individuals.

> numCompatiblePairs = uniqueCompatibleOrders(d)
> numCompatiblePairs
[1] 4
> # Maximum number of unique individuals
> numIndividuals = nrow(d)
> uniqueCompatibleIndividuals = numIndividuals - numCompatiblePairs
> uniqueCompatibleIndividuals
[1] 2

However, this does not work in many cases:

> d2 = matrix(rep(1:4,6),ncol=4, byrow = T)
> uniqueCompatibleOrders(d2)
[1] 15
> numCompatiblePairs2 = uniqueCompatibleOrders(d2)
> numCompatiblePairs2
[1] 15
> # Maximum number of unique individuals
> numIndividuals2 = nrow(d2)
> uniqueCompatibleIndividuals2 = numIndividuals2 - numCompatiblePairs2
> uniqueCompatibleIndividuals2
[1] -9

What am I doing wrong?

Answer 1

This is a hack, using hierarchical clustering on the binary dissimilarity matrix to calculate the number of unique ranks (unique cluster levels)

matchCompatibleij = function(i,j,data){
  # Take two row indices and check if the 
  # ranks of the vectors of the rows in data
  # are in a compatible order.
  # Rows can include missing data.
  ix = data[i,]
  jx = data[j,]
  complete = !(is.na(ix)|is.na(jx))
  all(order(ix[complete])==order(jx[complete]))
}
matchCompatible <- Vectorize(matchCompatibleij, vectorize.args=list("i","j"))

compatibleMatches = function(data){
  # Compare all individuals to all others,
  # checking if each is compatible
  m = outer(1:nrow(data),1:nrow(data),matchCompatible,data=data)
  rownames(m) = rownames(data)
  colnames(m) = rownames(data)
  return(m)
}

countNumberOfUniqueRanks = function(data){
  matches = compatibleMatches(data)
  # Use hierarchical clustering
  # identical individuals should fall in the same cluster
  hc = hclust(as.dist(1-matches),method = "average")
  length(unique(cutree(hc,h = 0)))
}

Run examples:

> set.seed(2109)
> d= t(replicate(6,sample(1:4)))
> d[sample(1:prod(dim(d)),3)] = NA
> d[1,3] = 3
> d[1,2] = NA
> d[4,3] = 1
> d[5,4] = 1
> d
     [,1] [,2] [,3] [,4]
[1,]    1   NA    3    2
[2,]    1    3    4    2
[3,]    2    3    4    1
[4,]    2    3    1   NA
[5,]   NA    2    3    1
[6,]    1    3    2    4
> countNumberOfUniqueRanks(d)
[1] 4
> 
> # Example 2
> d2 = matrix(rep(1:4,6),ncol=4, byrow = T)
> d2
     [,1] [,2] [,3] [,4]
[1,]    1    2    3    4
[2,]    1    2    3    4
[3,]    1    2    3    4
[4,]    1    2    3    4
[5,]    1    2    3    4
[6,]    1    2    3    4
> countNumberOfUniqueRanks(d2)
[1] 1