When dealing with several such Likert variable’s, a clear presentation of all the pairwise relation’s between our variable can be achieved by inspecting the (Spearman) correlation matrix (easily achieved in R by using the “cor.test” command on a matrix of variables).
Yet, a challenge appears once we wish to plot this correlation matrix. The challenge stems from the fact that the classic presentation for a correlation matrix is a scatter plot matrix – but scatter plots don’t (usually) work well for ordered categorical vectors since the dots on the scatter plot often overlap each other.

There are four solution for the point-overlap problem that I know of:

1. Jitter the data a bit to give a sense of the “density” of the points
2. Use a color spectrum to represent when a point actually represent “many points”
3. Use different points sizes to represent when there are “many points” in the location of that point
4. Add a LOWESS (or LOESS) line to the scatter plot – to show the trend of the data

In this post I will offer the code for the  a solution that uses solution 3-4 (and possibly 2, please read this post comments). Here is the output (click to see a larger image):

And here is the code to produce this plot:

R code for producing a Correlation scatter-plot matrix – for ordered-categorical data

Note that this code will work fine for continues data points (although I might suggest to enlarge the “point.size.rescale” parameter to something bigger then 1.5 in the “panel.smooth.ordered.categorical” function)

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94

# -----------------
# Functions
# -----------------
 
panel.cor.ordered.categorical <- function(x, y, digits=2, prefix="", cex.cor) 
{
 
    usr <- par("usr"); on.exit(par(usr)) 
    par(usr = c(0, 1, 0, 1)) 
 
    r <- abs(cor(x, y, method = "spearman")) # notive we use spearman, non parametric correlation here
    r.no.abs <- cor(x, y, method = "spearman")
 
 
    txt <- format(c(r.no.abs , 0.123456789), digits=digits)[1] 
    txt <- paste(prefix, txt, sep="") 
    if(missing(cex.cor)) cex <- 0.8/strwidth(txt) 
 
    test <- cor.test(x,y, method = "spearman") 
    # borrowed from printCoefmat
    Signif <- symnum(test$p.value, corr = FALSE, na = FALSE, 
                  cutpoints = c(0, 0.001, 0.01, 0.05, 0.1, 1),
                  symbols = c("***", "**", "*", ".", " ")) 
 
    text(0.5, 0.5, txt, cex = cex * r) 
    text(.8, .8, Signif, cex=cex, col=2) 
}
 
 
 
 
panel.smooth.ordered.categorical <- function (x, y, col = par("col"), bg = NA, pch = par("pch"), 
												cex = 1, col.smooth = "red", span = 2/3, iter = 3, 
												point.size.rescale = 1.5, ...) 
{
	#require(colorspace)
    require(reshape)
    z <- merge(data.frame(x,y), melt(table(x ,y)),sort =F)$value
    #the.col <- heat_hcl(length(x))[z]
    z <- point.size.rescale*z/ (length(x)) # notice how we rescale the dots accourding to the maximum z could have gotten
 
    symbols( x, y,  circles = z,#rep(0.1, length(x)), #sample(1:2, length(x), replace = T) ,
			inches=F, bg= "grey",#the.col ,
			fg = bg, add = T)
 
    # points(x, y, pch = pch, col = col, bg = bg, cex = cex)
    ok <- is.finite(x) & is.finite(y)
    if (any(ok)) 
        lines(stats::lowess(x[ok], y[ok], f = span, iter = iter), 
            col = col.smooth, ...)
}
 
 
panel.hist <- function(x, ...)
{
    usr <- par("usr"); on.exit(par(usr))
    par(usr = c(usr[1:2], 0, 1.5) )
    h <- hist(x, plot = FALSE, br = 20)
    breaks <- h$breaks; nB <- length(breaks)
    y <- h$counts; y <- y/max(y)
    rect(breaks[-nB], 0, breaks[-1], y, col="orange", ...)
}
 
 
pairs.ordered.categorical <- function(xx,...)
		{
			pairs(xx , 
					diag.panel = panel.hist ,
					lower.panel=panel.smooth.ordered.categorical,
					upper.panel=panel.cor.ordered.categorical,
					cex.labels = 1.5, ...) 
		}
 
 
 
 
# -----------------
# Example
# -----------------
 
set.seed(666)
a1 <- sample(1:5, 100, replace = T)
a2 <- sample(1:5, 100, replace = T)
a3 <- round(jitter(a2, 7) )
	a3[a3 < 1 | a3 > 5] <- 3
a4 <- 6-round(jitter(a1, 7) )
	a4[a4 < 1 | a4 > 5] <- 3
 
aa <- data.frame(a1,a2,a3, a4)
 
require(reshape)
 
# plotting :)		
pairs.ordered.categorical(aa)

Credits:

• The original R code for the correlation matrix plot was taken from R Graph Gallery (The differences are: 1) The use of spearman correlation; 2) The adding of hist panel and; 3) The changing of points sizes
• The idea to use symbols for changing the point sizes was offered by Doug Y’barbo.
  And also to Dirk Eddelbuettel for offering to use cex (although I ended up not using that)

If you got ideas on how to improve this code (or reproducing it with ggplot2 or lattice), please do so in the comments (or on your own blog, but be sure to let me know )

p.s: (The R function can be downloaded from here)

* * * *

Hi, I recently ran into the problem that I needed a Siegel-Tukey test for equal variability based on ranks. Maybe there is a package that has it implemented, but I could not find it. So I programmed an R function to do it. The Siegel-Tukey test requires to recode the ranks so that they express variability rather than ascending order. This is essentially what the code further below does. After the rank transformation, a regular Mann-Whitney U test is applied. The “manual” and code are pasted below.

Description:  Non-parametric Siegel-Tukey test for equality in variability. The null hypothesis is that the variability of x is equal between two groups. A rejection of the null indicates that variability differs between
the two groups.

Usage:

1

siegel.tukey(x,y,id.col=FALSE,adjust.median=FALSE,rnd=8, ...)

Arguments:

x: a vector of data

y: Data of the second group (if id.col=FALSE) or group indicator (if id.col=TRUE). In the latter case, y MUST take 1 or 2 to indicate observations of group 1 and 2, respectively, and x must contain the data for both groups.

id.col: If FALSE (default), then x and y are the data columns for group 1 and 2, respectively. If TRUE, the y is the group indicator.

adjust.median: Should between-group differences in medians be leveled before performing the test? In certain cases, the Siegel-Tukey test is susceptible to median differences and may indicate significant differences in variability that, in reality, stem from differences in medians.

rnd: Should the data be rounded and, if so, to which decimal? The default (-1) uses the data as is. Otherwise, rnd must be a non-negative integer. Typically, this option is not needed. However, occasionally, differences in
the precision with which certain functions return values cause the merging of two data frames to fail within the siegel.tukey function. Only then  rounding is necessary. This operation should not be performed if it affects
the ranks of observations.

… arguments passed on to the Wilcoxon test. See ?wilcox.test

Value: Among other output, the function returns rank sums for the two groups, the associated Wilcoxon’s W, and the p-value for a Wilcoxon test on tie-adjusted Siegel-Tukey ranks (i.e., it performs and returns a
Siegel-Tukey test). If significant, the group with the smaller rank sum has greater variability.

References: Sidney Siegel and John Wilder Tukey (1960) “A nonparametric sum of ranks procedure for relative spread in unpaired samples.” Journal of the
American Statistical Association. See also, David J. Sheskin (2004) ”Handbook of parametric and nonparametric statistical procedures.” 3rd
edition. Chapman and Hall/CRC. Boca Raton, FL.

Notes: The Siegel-Tukey test has relatively low power and may, under certain conditions, indicate significance due to differences in medians rather than
differences in variabilities (consider using the argument adjust.median).

Output (in this order)

1. Group medians
2. Wilcoxon-test for between-group differences in median (after the median
adjustment if specified)
3. Unique values of x and their tie-adjusted Siegel-Tukey ranks
4. Xs of group 1 and their tie-adjusted Siegel-Tukey ranks
5. Xs of group 2 and their tie-adjusted Siegel-Tukey ranks
6. Siegel-Tukey test (Wilcoxon test on tie-adjusted Siegel-Tukey ranks)

And here is the code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63

siegel.tukey=function(x,y,id.col=FALSE,adjust.median=F,rnd=-1,alternative="two.sided",mu=0,paired=FALSE,exact=FALSE,correct=TRUE,conf.int=FALSE,conf.level=0.95){
 if(id.col==FALSE){
   data=data.frame(c(x,y),rep(c(1,2),c(length(x),length(y))))
   } else {
	data=data.frame(x,y)
   }
 names(data)=c("x","y")
 data=data[order(data$x),]
 if(rnd>-1){data$x=round(data$x,rnd)}
 
 if(adjust.median==T){
	data$x[data$y==1]=data$x[data$y==1]-(median(data$x[data$y==1])-median(data$x[data$y==2]))/2
	data$x[data$y==2]=data$x[data$y==2]-(median(data$x[data$y==2])-median(data$x[data$y==1]))/2
 }
 cat("Median of group 1 = ",median(data$x[data$y==1]),"\n")
 cat("Median of group 2 = ",median(data$x[data$y==2]),"\n","\n")
 cat("Test of median differences","\n")
 print(wilcox.test(data$x[data$y==1],data$x[data$y==y]))
 
 a=rep(seq(ceiling(length(data$x)/4)),each=2)
 b=rep(c(0,1),ceiling(length(data$x)/4))
 rk.up=c(1,(a*4+b))[1:ceiling(length(data$x)/2)]
 rk.down=rev(c(a*4+b-2)[1:floor(length(data$x)/2)])
 
 cat("Performing Siegel-Tukey rank transformation...","\n","\n")
 
 rks=c(rk.up,rk.down)
 unqs=unique(sort(data$x))
 corr.rks=tapply(rks,data$x,mean)
 cbind(unqs,corr.rks)
 rks.data=data.frame(unqs,corr.rks)
 names(rks.data)=c("unique values of x","tie-adjusted Siegel-Tukey rank")
 print(rks.data,row.names=F)
 names(rks.data)=c("unqs","corr.rks")
 data=merge(data,rks.data,by.x="x",by.y="unqs")
 
 rk1=data$corr.rks[data$y==1]
 rk2=data$corr.rks[data$y==2]
 cat("\n","Tie-adjusted Siegel-Tukey ranks of group 1","\n")
 group1=data.frame(data$x[data$y==1],rk1)
 names(group1)=c("x","rank")
 print(group1,row.names=F)
 cat("\n","Tie-adjusted Siegel-Tukey ranks of group 2","\n")
 group2=data.frame(data$x[data$y==2],rk2)
 names(group2)=c("x","rank")
 print(group2,row.names=F)
 cat("\n")
 
 cat("Siegel-Tukey test","\n")
 cat("Siegel-Tukey rank transformation performed.","Tie adjusted ranks computed.","\n")
 if(adjust.median==T) {cat("Medians adjusted to equality.","\n")} else {cat("Medians not adjusted.","\n")}
 cat("Rank sum of group 1 =", sum(rk1),"    Rank sum of group 2 =",sum(rk2),"\n")
 
 
 print(wilcox.test(rk1,rk2,alternative=alternative,mu=mu,paired=paired,exact=exact,correct=correct,conf.int=conf.int,conf.level=conf.level))
}
 
#Example:
 
x=c(4,4,5,5,6,6)
y=c(0,0,1,9,10,10)
 
siegel.tukey(x,y)

Here is the code output:
Median of group 1 =  5
Median of group 2 =  5
Test of median differences
Wilcoxon rank sum test with continuity correction
data:  data$x[data$y == 1] and data$x[data$y == y]
W = 1, p-value = 0.4274
alternative hypothesis: true location shift is not equal to 0
Performing Siegel-Tukey rank transformation...
unique values of x tie-adjusted Siegel-Tukey rank
0                            2.5
1                            5.0
4                            8.5
5                           11.5
6                            8.5
9                            6.0
10                            2.5
Tie-adjusted Siegel-Tukey ranks of group 1
x rank
4  8.5
4  8.5
5 11.5
5 11.5
6  8.5
6  8.5
Tie-adjusted Siegel-Tukey ranks of group 2
x rank
0  2.5
0  2.5
1  5.0
9  6.0
10  2.5
10  2.5
Siegel-Tukey test
Siegel-Tukey rank transformation performed. Tie adjusted ranks computed.
Medians not adjusted.
Rank sum of group 1 = 57     Rank sum of group 2 = 21
Wilcoxon rank sum test with continuity correction
data:  rk1 and rk2
W = 36, p-value = 0.003601
alternative hypothesis: true location shift is not equal to 0
Warning message:
In wilcox.test.default(data$x[data$y == 1], data$x[data$y == y]) :
cannot compute exact p-value with ties
Median of group 1 =  5 Median of group 2 =  5  Test of median differences
Wilcoxon rank sum test with continuity correction
data:  data$x[data$y == 1] and data$x[data$y == y] W = 1, p-value = 0.4274alternative hypothesis: true location shift is not equal to 0
Performing Siegel-Tukey rank transformation...   unique values of x tie-adjusted Siegel-Tukey rank                  0                            2.5                  1                            5.0                  4                            8.5                  5                           11.5                  6                            8.5                  9                            6.0                 10                            2.5
Tie-adjusted Siegel-Tukey ranks of group 1  x rank 4  8.5 4  8.5 5 11.5 5 11.5 6  8.5 6  8.5
Tie-adjusted Siegel-Tukey ranks of group 2   x rank  0  2.5  0  2.5  1  5.0  9  6.0 10  2.5 10  2.5
Siegel-Tukey test Siegel-Tukey rank transformation performed. Tie adjusted ranks computed. Medians not adjusted. Rank sum of group 1 = 57     Rank sum of group 2 = 21
Wilcoxon rank sum test with continuity correction
data:  rk1 and rk2 W = 36, p-value = 0.003601alternative hypothesis: true location shift is not equal to 0
Warning message:In wilcox.test.default(data$x[data$y == 1], data$x[data$y == y]) :  cannot compute exact p-value with ties

(The R function can be downloaded from here)

Preface: What is Friedman’s Test

Friedman test is a non-parametric randomized block analysis of variance. Which is to say it is a non-parametric version of a one way ANOVA with repeated measures. That means that while a simple ANOVA test requires the assumptions of a normal distribution and equal variances (of the residuals), the Friedman test is free from those restriction. The price of this parametric freedom is the loss of power (of Friedman’s test compared to the parametric ANOVa versions).

The hypotheses for the comparison across repeated measures are:

• H0: The distributions (whatever they are) are the same across repeated measures
• H1: The distributions across repeated measures are different

The test statistic for the Friedman’s test is a Chi-square with [(number of repeated measures)-1] degrees of freedom. A detailed explanation of the method for computing the Friedman test is available on Wikipedia.

Performing Friedman’s Test in R is very simple, and is by using the “friedman.test” command.

Post hoc analysis for the Friedman’s Test

Assuming you performed Friedman’s Test and found a significant P value, that means that some of the groups in your data have different distribution from one another, but you don’t (yet) know which. Therefor, our next step will be to try and find out which pairs of our groups are significantly different then each other. But when we have N groups, checking all of their pairs will be to perform [n over 2] comparisons, thus the need to correct for multiple comparisons arise.
The tasks:
Our first task will be to perform a post hoc analysis of our results (using R) – in the hope of finding out which of our groups are responsible that we found that the null hypothesis was rejected. While in the simple case of ANOVA, an R command is readily available (“TukeyHSD”), in the case of friedman’s test (until now) the code to perform the post hoc test was not as easily accessible.
Our second task will be to visualize our results. While in the case of simple ANOVA, a boxplot of each group is sufficient, in the case of a repeated measures – a boxplot approach will be misleading to the viewer. Instead, we will offer two plots: one of parallel coordinates, and the other will be boxplots of the differences between all pairs of groups (in this respect, the post hoc analysis can be thought of as performing paired wilcox.test with correction for multiplicity).

R code for Post hoc analysis for the Friedman’s Test

The analysis will be performed using the function (I wrote) called “friedman.test.with.post.hoc”, based on the packages “coin” and “multcomp”. Just a few words about it’s arguments:

• formu – is a formula object of the shape: Y ~ X | block (where Y is the ordered (numeric) responce, X is a group indicator (factor), and block is the block (or subject) indicator (factor)
• data – is a data frame with columns of Y, X and block (the names could be different, of course, as long as the formula given in “formu” represent that)
• All the other parameters are to allow or suppress plotting of the results.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147

friedman.test.with.post.hoc <- function(formu, data, to.print.friedman = T, to.post.hoc.if.signif = T,  to.plot.parallel = T, to.plot.boxplot = T, signif.P = .05, color.blocks.in.cor.plot = T, jitter.Y.in.cor.plot =F)
{
	# formu is a formula of the shape: 	Y ~ X | block
	# data is a long data.frame with three columns:    [[ Y (numeric), X (factor), block (factor) ]]
 
	# Note: This function doesn't handle NA's! In case of NA in Y in one of the blocks, then that entire block should be removed.
 
 
	# Loading needed packages
	if(!require(coin))
	{
		print("You are missing the package 'coin', we will now try to install it...")
		install.packages("coin")		
		library(coin)
	}
 
	if(!require(multcomp))
	{
		print("You are missing the package 'multcomp', we will now try to install it...")
		install.packages("multcomp")
		library(multcomp)
	}
 
	if(!require(colorspace))
	{
		print("You are missing the package 'colorspace', we will now try to install it...")
		install.packages("colorspace")
		library(colorspace)
	}
 
 
	# get the names out of the formula
	formu.names <- all.vars(formu)
	Y.name <- formu.names[1]
	X.name <- formu.names[2]
	block.name <- formu.names[3]
 
	if(dim(data)[2] >3) data <- data[,c(Y.name,X.name,block.name)]	# In case we have a "data" data frame with more then the three columns we need. This code will clean it from them...
 
	# Note: the function doesn't handle NA's. In case of NA in one of the block T outcomes, that entire block should be removed.
 
	# stopping in case there is NA in the Y vector
	if(sum(is.na(data[,Y.name])) > 0) stop("Function stopped: This function doesn't handle NA's. In case of NA in Y in one of the blocks, then that entire block should be removed.")
 
	# make sure that the number of factors goes with the actual values present in the data:
	data[,X.name ] <- factor(data[,X.name ])
	data[,block.name ] <- factor(data[,block.name ])
	number.of.X.levels <- length(levels(data[,X.name ]))
	if(number.of.X.levels == 2) { warning(paste("'",X.name,"'", "has only two levels. Consider using paired wilcox.test instead of friedman test"))}
 
	# making the object that will hold the friedman test and the other.
	the.sym.test <- symmetry_test(formu, data = data,	### all pairwise comparisons	
						   teststat = "max",
						   xtrafo = function(Y.data) { trafo( Y.data, factor_trafo = function(x) { model.matrix(~ x - 1) %*% t(contrMat(table(x), "Tukey")) } ) },
						   ytrafo = function(Y.data){ trafo(Y.data, numeric_trafo = rank, block = data[,block.name] ) }
						)
	# if(to.print.friedman) { print(the.sym.test) }
 
 
	if(to.post.hoc.if.signif)
		{
			if(pvalue(the.sym.test) < signif.P)
			{
				# the post hoc test
				The.post.hoc.P.values <- pvalue(the.sym.test, method = "single-step")	# this is the post hoc of the friedman test
 
 
				# plotting
				if(to.plot.parallel & to.plot.boxplot)	par(mfrow = c(1,2)) # if we are plotting two plots, let's make sure we'll be able to see both
 
				if(to.plot.parallel)
				{
					X.names <- levels(data[, X.name])
					X.for.plot <- seq_along(X.names)
					plot.xlim <- c(.7 , length(X.for.plot)+.3)	# adding some spacing from both sides of the plot
 
					if(color.blocks.in.cor.plot) 
					{
						blocks.col <- rainbow_hcl(length(levels(data[,block.name])))
					} else {
						blocks.col <- 1 # black
					}					
 
					data2 <- data
					if(jitter.Y.in.cor.plot) {
						data2[,Y.name] <- jitter(data2[,Y.name])
						par.cor.plot.text <- "Parallel coordinates plot (with Jitter)"				
					} else {
						par.cor.plot.text <- "Parallel coordinates plot"
					}				
 
					# adding a Parallel coordinates plot
					matplot(as.matrix(reshape(data2,  idvar=X.name, timevar=block.name,
									 direction="wide")[,-1])  , 
							type = "l",  lty = 1, axes = FALSE, ylab = Y.name, 
							xlim = plot.xlim,
							col = blocks.col,
							main = par.cor.plot.text)
					axis(1, at = X.for.plot , labels = X.names) # plot X axis
					axis(2) # plot Y axis
					points(tapply(data[,Y.name], data[,X.name], median) ~ X.for.plot, col = "red",pch = 4, cex = 2, lwd = 5)
				}
 
				if(to.plot.boxplot)
				{
					# first we create a function to create a new Y, by substracting different combinations of X levels from each other.
					subtract.a.from.b <- function(a.b , the.data)
					{
						the.data[,a.b[2]] - the.data[,a.b[1]]
					}
 
					temp.wide <- reshape(data,  idvar=X.name, timevar=block.name,
									 direction="wide") 	#[,-1]
					wide.data <- as.matrix(t(temp.wide[,-1]))
					colnames(wide.data) <- temp.wide[,1]
 
					Y.b.minus.a.combos <- apply(with(data,combn(levels(data[,X.name]), 2)), 2, subtract.a.from.b, the.data =wide.data)
					names.b.minus.a.combos <- apply(with(data,combn(levels(data[,X.name]), 2)), 2, function(a.b) {paste(a.b[2],a.b[1],sep=" - ")})
 
					the.ylim <- range(Y.b.minus.a.combos)
					the.ylim[2] <- the.ylim[2] + max(sd(Y.b.minus.a.combos))	# adding some space for the labels
					is.signif.color <- ifelse(The.post.hoc.P.values < .05 , "green", "grey")
 
					boxplot(Y.b.minus.a.combos,
						names = names.b.minus.a.combos ,
						col = is.signif.color,
						main = "Boxplots (of the differences)",
						ylim = the.ylim
						)
					legend("topright", legend = paste(names.b.minus.a.combos, rep(" ; PostHoc P.value:", number.of.X.levels),round(The.post.hoc.P.values,5)) , fill =  is.signif.color )
					abline(h = 0, col = "blue")
 
				}
 
				list.to.return <- list(Friedman.Test = the.sym.test, PostHoc.Test = The.post.hoc.P.values)
				if(to.print.friedman) {print(list.to.return)}				
				return(list.to.return)
 
			}	else {
					print("The results where not significant, There is no need for a post hoc test")
					return(the.sym.test)
				}					
	}
 
# Original credit (for linking online, to the package that performs the post hoc test) goes to "David Winsemius", see:
# http://tolstoy.newcastle.edu.au/R/e8/help/09/10/1416.html
}

Example

(The code for the example is given at the end of the post)

Let’s make up a little story: let’s say we have three types of wine (A, B and C), and we would like to know which one is the best one (in a scale of 1 to 7). We asked 22 friends to taste each of the three wines (in a blind fold fashion), and then to give a grade of 1 till 7 (for example sake, let’s say we asked them to rate the wines 5 times each, and then averaged their results to give a number for a persons preference for each wine. This number which is now an average of several numbers, will not necessarily be an integer).

After getting the results, we started by performing a simple boxplot of the ratings each wine got. Here it is:

The plot shows us two things: 1) that the assumption of equal variances here might not hold. 2) That if we are to ignore the “within subjects” data that we have, we have no chance of finding any difference between the wines.

So we move to using the function “friedman.test.with.post.hoc” on our data, and we get the following output:

$Friedman.Test

Asymptotic General Independence Test

data:  Taste by

Wine (Wine A, Wine B, Wine C)

stratified by Taster

maxT = 3.2404, p-value = 0.003421

$PostHoc.Test

Wine B – Wine A 0.623935139

Wine C – Wine A 0.003325929

Wine C – Wine B 0.053772757

The conclusion is that once we take into account the within subject variable, we discover that there is a significant difference between our three wines (significant P value of about  0.0034). And the posthoc analysis shows us that the difference is due to the difference in tastes between Wine C and Wine A (P value 0.003). and maybe also with the difference between Wine C and Wine B (the P value is 0.053, which is just borderline significant).

Plotting our analysis will also show us the direction of the results, and the connected answers of each of our friends answers:

Here is the code for the example:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33

 
source("http://www.r-statistics.com/wp-content/uploads/2010/02/Friedman-Test-with-Post-Hoc.r.txt")  # loading the friedman.test.with.post.hoc function from the internet
 
	### Comparison of three Wine ("Wine A", "Wine B", and
	###  "Wine C") for rounding first base. 
	WineTasting <- data.frame(
		  Taste = c(5.40, 5.50, 5.55,
					5.85, 5.70, 5.75,
					5.20, 5.60, 5.50,
					5.55, 5.50, 5.40,
					5.90, 5.85, 5.70,
					5.45, 5.55, 5.60,
					5.40, 5.40, 5.35,
					5.45, 5.50, 5.35,
					5.25, 5.15, 5.00,
					5.85, 5.80, 5.70,
					5.25, 5.20, 5.10,
					5.65, 5.55, 5.45,
					5.60, 5.35, 5.45,
					5.05, 5.00, 4.95,
					5.50, 5.50, 5.40,
					5.45, 5.55, 5.50,
					5.55, 5.55, 5.35,
					5.45, 5.50, 5.55,
					5.50, 5.45, 5.25,
					5.65, 5.60, 5.40,
					5.70, 5.65, 5.55,
					6.30, 6.30, 6.25),
					Wine = factor(rep(c("Wine A", "Wine B", "Wine C"), 22)),
					Taster = factor(rep(1:22, rep(3, 22))))
 
	with(WineTasting , boxplot( Taste  ~ Wine )) # boxploting 
	friedman.test.with.post.hoc(Taste ~ Wine | Taster ,WineTasting)	# the same with our function. With post hoc, and cool plots

If you find this code useful, please let me know (in the comments) so I will know there is a point in publishing more such code snippets…