Sensory evaluation of concert hall acoustics

Sensory evaluation methods have been predominantly developed in food and wine industry to explore the perceptual characteristics of products, which are hard to evaluate through consumer based preference methods due to huge variation in individual tastes.

The acoustics of concert halls is also heavily influenced by a matter of taste. Therefore, sensory evaluation methods are very useful for studying auditorium acoustics due to their ability to extract information often hidden behind preference judgements.

This page shows some examples of data analysis of sensory evaluation studies. The motivation, results, and deeper background of the example data is presented in three articles:

  • Lokki, T., Pätynen, J., and Zacharov, N., "Concert hall acoustics assessment with sensory evaluation -- Tools and practices," In The Eigth International Conference On Auditorium Acoustics, Dublin, Ireland, May 20-22, 2011. [Online]
  • Lokki, T., Pätynen, J., Tervo, S., Siltanen, S., and Savioja, L. "Engaging concert hall acoustics is made up of temporal envelope preserving reflections," Journal of the Acoustical Society of America, vol. 129, no. 6, pp. EL223-EL228, June 2011. [Online (AIP) + Binaural demovideo]
  • Lokki, T. and Pätynen, J. "Lateral reflections are favorable in concert halls due to binaural loudness," Journal of the Acoustical Society of America, vol. 130, no. 5, pp. EL345-EL351, November 2011. [Online (AIP)]

The example data can be downloaded below and you can try to run example R scripts with the data.

 

First the data is uploaded to R with the following functions:

 

DS <- read.table("IVP6_2011.txt",header=TRUE)
DSharj <- read.table("IVP6_2011_first.txt",header=TRUE)
DSpref <- read.table("IVP6_2011_pref.txt",header=TRUE)

row.names(DS) <- c(
"M1_BR","M2_BR","M3_BR","M4_BR","M5_BR","M6_BR",
"M1_MA","M2_MA","M3_MA","M4_MA","M5_MA","M6_MA")
DSs <- scale(DS)

row.names(DSharj) <- c(
"M1_BR","M2_BR","M3_BR","M4_BR","M5_BR","M6_BR",
"M1_MA","M2_MA","M3_MA","M4_MA","M5_MA","M6_MA")
DSharjs <- scale(DSharj)
Then, the first step is to check the reliability of assessors by comparing the results of first and second tests. The assumption is that an assessor can reproduce the same results twice, thus the result matrices correlate well. Such correlation can be checked with RV coefficient, which is implemented in the FactoMineR package:

 

library(FactoMineR)

all_RV_p <- vector("numeric",38)
RV_coefficient_of_6x2_matrices <- vector("numeric",38)
for (ind in 1:38) {
	rv_data <- data.frame(DS[1:6,ind],DS[7:12,ind],DSharj[1:6,ind],DSharj[7:12,ind])
	res_kh_RV <-coeffRV(rv_data[,1:2],rv_data[,3:4])
	all_RV_p[ind] <- res_kh_RV$p.value
	RV_coefficient_of_6x2_matrices[ind] <- res_kh_RV$rv
}

Individually_elicited_attributes <- c(1:38)
quartz()
plot(RV_coefficient_of_6x2_matrices,Individually_elicited_attributes,main="p.values of RV coeffs of attributes",type="n")

text(RV_coefficient_of_6x2_matrices,Individually_elicited_attributes,main="p.values of RV coeffs of attributes",
labels=round(all_RV_p,3), col=c(rep("red",1),rep("magenta",1),rep("darkblue",1),rep("red",1),
rep("darkblue",1),rep("blue",1),rep("magenta",1),rep("blue",1),rep("red",1),rep("blue",1),
rep("darkblue",1),rep("blue",1),rep("magenta",3),rep("red",1),rep("darkblue",2),rep("magenta",1),
rep("red",1),rep("darkblue",1),rep("blue",3),rep("darkblue",1),rep("blue",1),rep("red",2),
rep("magenta",1),rep("blue",1),rep("darkblue",1),rep("red",1),rep("darkblue",1),rep("red",2),
rep("magenta",1),rep("red",2)))

quartz()
plot(RV_coefficient_of_6x2_matrices,Individually_elicited_attributes,main="labels of RV coeffs of attributes",type="n")

text(RV_coefficient_of_6x2_matrices,Individually_elicited_attributes,main="labels of RV coeffs of attributes",
labels=colnames(DS), col=c(rep("red",1),rep("magenta",1),rep("darkblue",1),rep("red",1),rep("darkblue",1),
rep("blue",1),rep("magenta",1),rep("blue",1),rep("red",1),rep("blue",1),rep("darkblue",1),
rep("blue",1),rep("magenta",3),rep("red",1),rep("darkblue",2),rep("magenta",1),rep("red",1),
rep("darkblue",1),rep("blue",3),rep("darkblue",1),rep("blue",1),rep("red",2),rep("magenta",1),
rep("blue",1),rep("darkblue",1),rep("red",1),rep("darkblue",1),rep("red",2),rep("magenta",1),
rep("red",2)))

The first plot shows the attributes with their RV coefficients. Another plot indicates the p-values which describe the significance of correlation. That is very useful to decide the significance of the correlation.

The next phase is to check with hierarchical clustering (AHC) which attributes are giving the similar ratings for the samples. It is an iterative process where the clustering of all attributes is the starting point. Then with the knowledge of RV coefficients and clustering results the reliable reproduced attributes are selected. With the following functions an example of attribute selection is done. First the AHC of all attributes is performed. Another cluster is obtained with only the attributes (DSbest) that has high RV (and p < 0.05). Third cluster is obtained when the most distant branch of the AHC is cut off (DSsel).

 

######
## SELECTED ATTRIBUTES
######

DSbest <- DS[,c("X5","X7","X8","X10","X12","X13","X14","X17","X18","X21","X22","X23","X24",
"X25","X26","X30","X33","X35")]
DSsel <- DS[,c("X3","X5","X6","X7","X8","X10","X11","X12","X13","X14","X16","X17","X18","X20","X21",
"X22","X23","X24","X25","X26","X27","X28","X30","X33","X34","X35","X36","X37","X39","X40")]

row.names(DSbest) <- c(
"M1_BR","M2_BR","M3_BR","M4_BR","M5_BR","M6_BR",
"M1_MA","M2_MA","M3_MA","M4_MA","M5_MA","M6_MA")

row.names(DSsel) <- c(
"M1_BR","M2_BR","M3_BR","M4_BR","M5_BR","M6_BR",
"M1_MA","M2_MA","M3_MA","M4_MA","M5_MA","M6_MA")


######
## AGGLOMERATIVE HIERARCHICAL CLUSTERING
######

library(amap)

ScD_Euclidean_distance_DS = t(scale(DS))
ScD_Euclidean_distance_DSsel = t(scale(DSsel))
ScD_Euclidean_distance_DSbest = t(scale(DSbest))

hc.e <- hcluster(ScD_Euclidean_distance_DS,link = "ward", method="euclidean")
plot(hc.e)
hc.es <- hcluster(ScD_Euclidean_distance_DSsel,link = "ward", method="euclidean")
plot(hc.es)
hc.eb <- hcluster(ScD_Euclidean_distance_DSbest,link = "ward", method="euclidean")
plot(hc.eb)

Finally, the main analysis is done with Multiple Factor Analysis (MFA) which is also implemented in the FactoMineR package. Here are the scripts for the analysis and advanced plotting of the results.

########
### Multiple factor analysis (MFA)
########

### With attribute numbers
rese2011_khbest <-MFA(DSbest, group=c(1,2,1,1,2,2,2,2,2,1,1,1), type=c(rep("s",12)), ncp=5,
axes=c(1,2),name.group=c("AS02","AS03","AS04","AS05","AS06","AS09","AS11","AS12",
"AS13","AS15","AS16","AS17"),graph=TRUE)

### With attribute names
names(DSbest) <- c(
"width", 
"distance","envelopment",
"clarity",
"clarity",
"width","bass dominance",
"openness","envelopment",
"envelopment","bass level",
"width","bassiness",
"definition","diverse",
"bassiness",
"openness",
"width")

rese2011_khbest <-MFA(DSbest, group=c(1,2,1,1,2,2,2,2,2,1,1,1), type=c(rep("s",12)), ncp=5,
axes=c(1,2),name.group=c("AS02","AS03","AS04","AS05","AS06","AS09","AS11","AS12","AS13",
"AS15","AS16","AS17"),graph=TRUE)

colorsE2011 <- c(rep(c("coral4","coral","darkgreen","darkolivegreen3","blue","deepskyblue"),2))

plot.MFA(rese2011_khbest, axes=c(1,3), choix="ind", lab.ind.moy=TRUE, lab.par=TRUE,
cex=1.4,col.hab = colorsE2011,title = "Multiple Factor Analysis (MFA) with 18 attributes")


Env_text <-  c("width","distance","width","envelopment","definition","openness","envelopment",
"openness","width")
en_col <- "darkblue"
Bass_text <- c("clarity","clarity","bass dominance","bass level","envelopment",
"width","bassiness","diverse","bassiness")
lo_col <- "blue"


text(2.8*rese2011_khbest2$quanti.var$cor[Envelopment, 1],2.8*rese2011_khbest2$quanti.var$cor[Envelopment, 2],
pos=4,col = en_col, label=Env_text,cex=0.8)
pos <- rese2011_khbest2$quanti.var$cor[Envelopment,c(1,2)]
for (idx in 1:9) {
arrows(0, 0, 2.8*pos[idx,1], 2.8*pos[idx,2], length = 0.2, angle = 10,code=2,lwd=0.5,col=en_col)
}

text(2.8*rese2011_khbest2$quanti.var$cor[Bassness, 1],2.8*rese2011_khbest2$quanti.var$cor[Bassness, 2],
pos=4,col = lo_col, label=Bass_text,cex=0.8)
pos <- rese2011_khbest2$quanti.var$cor[Bassness,c(1,2)]
for (idx in 1:9) {
arrows(0, 0, 2.8*pos[idx,1], 2.8*pos[idx,2], length = 0.2, angle = 10,code=2,lwd=0.5,col=lo_col)
}



K1_mean_1 = mean(rese2011_khbest2$quanti.var$cor[Envelopment, 1])
K1_mean_2 = mean(rese2011_khbest2$quanti.var$cor[Envelopment, 2])
arrows(0, 0, 2.8*K1_mean_1, 2.8*K1_mean_2, length = 0.2, angle = 15,col = en_col,code=2,lwd=3)
text(2.8*K1_mean_1, 2.8*K1_mean_2, pos=4,labels = "Envelopment and Openness",col = en_col,cex=1.5)

K2_mean_1 = mean(rese2011_khbest2$quanti.var$cor[Bassness, 1])
K2_mean_2 = mean(rese2011_khbest2$quanti.var$cor[Bassness, 2])
arrows(0, 0, 2.8*K2_mean_1, 2.8*K2_mean_2, length = 0.2, angle = 15,col = lo_col,code=2,lwd=3)
text(2.8*K2_mean_1, 2.8*K2_mean_2, pos=4,labels = "Quality of bass and Clarity",col = lo_col,cex=1.5)