my.friedman <- function(x)
{
r <- nrow(x)
df <- (c <- ncol(x))-1
R <- apply(o <- t(apply(x, 1, rank)), 2, sum)
chi <- 12*sum(R^2)/(r*c*(c+1))-3*r*(c+1)
p <- pchisq(chi, df, lower=F)
res <- c(chi, df, p)
names(res) <- c("Statistics", "d.f.", "P value")
R.m = R/r
V <- sum((o-(c+1)/2)^2)
S <- outer(R.m, R.m, function(r1, r2) { r^2*df*(r1-r2)^2/(2*V) })
p <- pchisq(S, df, lower=F)
colnames(p) <- rownames(p) <- colnames(S) <- rownames(S) <- paste("Group", 1:c)
list(Result=res, Statistics=S, "P value"=p)
}
# 使用例
x <- matrix(c(
5,60,35,62,76,
24,44,74,63,76,
56,57,70,74,79,
44,51,55,23,84,
8,68,50,24,64,
32,66,45,63,46,
25,38,70,58,77,
48,24,40,80,72
), byrow=TRUE, ncol=5)
my.friedman(x)
# 結果
# $Result
# Statistics d.f. P value
# 15.900000000 4.000000000 0.003156326
# $Statistics
# Group 1 Group 2 Group 3 Group 4 Group 5
# Group 1 0.000 3.600 4.225 5.625 15.625
# Group 2 3.600 0.000 0.025 0.225 4.225
# Group 3 4.225 0.025 0.000 0.100 3.600
# Group 4 5.625 0.225 0.100 0.000 2.500
# Group 5 15.625 4.225 3.600 2.500 0.000
# $"P value"
# Group 1 Group 2 Group 3 Group 4 Group 5
# Group 1 1.000000000 0.4628369 0.3764110 0.2289584 0.003565936
# Group 2 0.462836887 1.0000000 0.9999225 0.9941270 0.376410966
# Group 3 0.376410966 0.9999225 1.0000000 0.9987909 0.462836887
# Group 4 0.228958421 0.9941270 0.9987909 1.0000000 0.644635793
# Group 5 0.003565936 0.3764110 0.4628369 0.6446358 1.000000000