How to get percentage agreement between a group of factor columns?

Question

I have a data.frame with 18 columns all of which are categorical variables containing the same factors e.g. "a", "b", "c". What I would like to produce is a matrix which is 18x18 and contains the proportion/percentage agreement between each column and the rest of the others.

For example:- Input:

yoda <- data.frame(one=c("a","a","a","a"), two=c("a","b","a","a"), three=c("a","a","b","b"))

Output:

structure(c(1, 0.75, 0.5, 0.75, 1, 0.25, 0.5, 0.25, 1), .Dim = c(3L, 
3L), .Dimnames = list(c("one", "two", "three"), c("one", "two", 
"three")))

I could loop over the column names twice but I am sure that there must be a better way. I have looked into creating a distance matrix and correlation but none of the methods seem to fit the bill.

-- EDIT -- Here is what I am doing currently:

library(plyr)
result <- aaply(data, 2, function(col) {
  aaply(data, 2, function(col2) {
    sum(col==col2)/length(col)
  })
})

Answer 1

This would be a one-liner in a more complete and elegant functional programming language like APL or Mathematica. But we can emulate what they do, recognizing that no matter what, there must be a double loop lurking somewhere: it's just a matter of choosing how to package it. Of greatest importance will be optimizing the operations within the loop: the actual looping takes negligible overhead.

First we have to work around a subtle potential problem: in the example, the columns do not have the same factors. We make them compatible and at the same time convert yoda into an array:

y <- apply(yoda, 2, function(x) factor(x, levels=c("a","b")))

The "one-liner" I refer to relies on a generalized inner product. The usual inner (or "dot") product $\left<\ ,\right>$ of two commensurable vectors $\mathbf{x}=(x_1,\ldots,x_n)$ and $\mathbf{y}=(y_1,\ldots,y_n)$ is a sum of products:

$$\left<\mathbf{x}, \mathbf{y}\right> = \sum_{k=1}^n x_k y_k.$$

Generalizing this, let $f$ be any binary function (replacing multiplication) and $g$ be any function of $n$-vectors (replacing the sum). Define the $f,g$ inner product to be $g$ applied to the $n$-vector obtained from componentwise application of $f$:

$$\left<\mathbf{x}, \mathbf{y}\right>_{f,g} = g \left(f(x_k, y_k), k=1,2,\ldots,n \right).$$

This generalizes matrix multiplication of two arrays $\mathbb{X} = (x_{ik})$ (whose rows have dimension $n$) and $\mathbb{Y} = (y_{kj})$ (whose columns have the same dimension $n$), which can be viewed as systematically forming all inner products of rows of $\mathbb{X}$ with columns of $\mathbb{Y}$:

$$\left(\mathbb{X} \times_{f,g} \mathbb{Y}\right)_{ij} = \left<\mathbb{x}_{i*}, \mathbb{y}_{*j}\right>_{f,g} = \left( g\left(f(x_{ik}, y_{kj}), k=1,2,\ldots,n\right) \right).$$

Here is an implementation of generalized matrix multiplication in R (defaulting to the usual multiplication):

mmult <- function(f=`*`, g=sum) 
    function(x, y) apply(y, 2, function(a) apply(x, 1, function(b) g(f(a,b))))

The double loop is evident in the double appearance of apply. Its efficiency depends principally on the efficiency of g and f.

The question asks for a generalized matrix product of the transpose of y (whose rows are, by definition, columns of y) and y itself, where $g$ is the average and $f$ is the indicator of equality: $f(a,b) = 1$ if and only if $a == b$; otherwise, $f$ is $0$. Let's create it in R:

`%**%` <- mmult(`==`, mean)

In these terms the solution finally is a one-liner:

> t(y) %**% y 
       one  two three
one   1.00 0.75  0.50
two   0.75 1.00  0.25
three 0.50 0.25  1.00