advice on a solution attempt: interrater reliability of time-point data [duplicate]

Question

In my data, two coders annotated subjectively (but independently), when certain time-point phenomena (a specific turn in a movement pattern) occurred.

The data for the first 14 seconds looks something like this:

rater1: 
(1) 00:028
(2) 01:385
(3) 04:987
(4) 10:728 

rater2: 
(1) 00:022
(2) 05:100
(3) 10:602

Objective: Find an interrater-reliability index for this data. Note that the number of observations differ and, accordingly, rater1(3) is not close to rater2(3) but rather to rater2(2).

What I've done in R so far:

1. I put forth a tolerance offset (120ms), and calculated the number of matches: 2. Annotations (1) and (3) of rater1 have a match in rater2 (tolerating 120ms offset). This is the first value for a contingency table.

2. From the overall number of annotations, I subtracted the number of matches to obtain the mismatching annotations for rater1 (2 mismatches) and rater2 (1 mismatch).

3. The last field in the contingency table is the number of time units that both raters agree that the phenomenon is not present. If one time-point annotation of any rater accepts a matching annotation of the other rater within a time interval of 120ms in the future and 120ms in the past, then one time unit could be defined as an interval of 240ms. When I divide my data into these time intervals and subtract the time intervals already 'occupied', I get:

   14seconds/240ms - (all matches and mismatches) = 58 - 5 = 53

   Kappa.test(matrix(c(2,2,1,53),2,2))
   

Since Cohen's kappa is not very susceptible to the prevalence of the last cell of the contingency table, I'm happy with the results I get.

But I don't know whether there are much more sophisticated and flawless solutions out there.

Could you give me advice on this and direct me to literature that deals with these kinds of problems? I'm not finding work comparable to this data and this problem.

Answer 1

Sounds like the first step is solving the optimal assignment problem https://en.wikipedia.org/wiki/Hungarian_algorithm

This can be done using the function solve_LSAP from the package "clue"

R code:

rater1<-c(.028,1.385,4.987,10.728)
rater2<-c(.022,5.1,10.602)

diffs=NULL
for(i in 1:length(rater1)){
  diffs<-cbind(diffs,abs(rater1[i]-rater2))
}
colnames(diffs)<-paste0("rater1","(",1:length(rater1),")")
rownames(diffs)<-paste0("rater2","(",1:length(rater2),")")


require(clue)
y<-solve_LSAP(diffs, maximum=F)
matchIDs<-cbind(y,seq_along(y))
colnames(matchIDs)<-c("Rater1","Rater2")

matchData<-cbind(rater1[matchIDs[,1]],rater2[matchIDs[,2]])
matchData<-cbind(matchData, abs(matchData[,1]-matchData[,2]))
colnames(matchData)<-c("Rater1","Rater2", "Abs(Difference)")

Results:

> matchData
     Rater1 Rater2 Abs(Difference)
[1,]  0.028  0.022           0.006
[2,]  4.987  5.100           0.113
[3,] 10.728 10.602           0.126
> matchIDs
     Rater1 Rater2
[1,]      1      1
[2,]      3      2
[3,]      4      3

Once assignments are made you can filter out any differences greater than a threshold (e.g. 0.120) and call those "mismatches" along with whatever index is left out from the rater with more observations. I'm confused by what you are doing in step 3.

Perhaps also make a plot like this:

plot(rater1, rep(1,length(rater1)), pch=16, type="b", col="Blue", 
     ylim=c(1,2), ylab="Rater", xlim=c(0,14), xlab="Time", yaxt="n")
points(rater2, rep(2,length(rater2)), pch=16, type="b", col="Red")
axis(side=2, at=c(1,2),labels=c(1,2))
segments(x0=matchData[,1],x1=matchData[,2], 
         y0=rep(1,nrow(matchData)), y1=rep(2,nrow(matchData)),
         lwd=2, lty=2)

text(x=rowMeans(matchData[,1:2]), y=rep(1.5, nrow(matchData)),
     labels=round(matchData[,3],3), pos=4)

From that it looks like your threshold of 120 ms may be too stringent.