Learn R Programming

eba (version 1.10-0)

soundquality: Quality of Multichannel Reproduced Sound

Description

Paired comparison judgments of 40 selected listeners with respect to eight audio reproduction modes and four types of music: SQpreference includes judgments on overall preference; SQattributes includes judgments on specific spatial and timbral auditory attributes; SQsubjects: includes information about the listeners involved.

Usage

data("soundquality")

Arguments

Format

SQpreference A data frame containing 783 observations on 6 variables:

id

factor, listener ID.

time

factor, listening experiment before or after elicitation and scaling of more specific auditory attributes.

progmat

factor, the program material: Beethoven, Rachmaninov, Steely Dan, Sting.

repet

the repetition number.

session

the experimental session coding the presentation order of the program material.

preference

paired comparison of class paircomp; preferences for all 28 paired comparisons from 8 audio reproduction modes: Mono, Phantom Mono, Stereo, Wide-Angle Stereo, 4-channel Matrix, 5-channel Upmix 1, 5-channel Upmix 2, and 5-channel Original.

SQattributes A data frame containing 156 observations on 10 variables:

id

factor, listener ID.

progmat

factor, the program material.

width, spaciousness, envelopment, distance, clarity, brightness, elevation, naturalness

Paired comparison of class paircomp.

SQsubjects A data frame containing 78 observations on 18 variables:

id

factor, listener ID

status

factor, selection status; 40 listeners were selected.

HLmax

maximum hearing level between 250 and 8000 Hz

stereowidth

stereo-width discrimination threshold

fluency

word fluency score

age

subject age

gender

factor, subject gender

education

factor, education class

background, experience, listenmusic, concerts, instrument, critical, cinema, hifi, surround, earliertests

indicators of prior experience

Details

The data were collected within a series of experiments conducted at the Sound Quality Research Unit (SQRU), Department of Acoustics, Aalborg University, Denmark, between September 2004 and March 2005.

The results of scaling listener preference and spatial and timbral auditory attributes are reported in Choisel and Wickelmaier (2007). See examples for replication code. Details about the loudspeaker setup and calibration are given in Choisel and Wickelmaier (2006). The attribute elicitation procedure is described in Wickelmaier and Ellermeier (2007) and in Choisel and Wickelmaier (2006). The selection of listeners for the experiments is described in Wickelmaier and Choisel (2005).

Portions of these data are also available via data("SoundQuality", package = "psychotools").

References

Choisel, S., & Wickelmaier, F. (2006). Extraction of auditory features and elicitation of attributes for the assessment of multichannel reproduced sound. Journal of the Audio Engineering Society, 54(9), 815--826.

Choisel, S., & Wickelmaier, F. (2007). Evaluation of multichannel reproduced sound: Scaling auditory attributes underlying listener preference. Journal of the Acoustical Society of America, 121(1), 388--400. 10.1121/1.2385043

Wickelmaier, F., & Choisel, S. (2005). Selecting participants for listening tests of multichannel reproduced sound. Presented at the AES 118th Convention, May 28--31, Barcelona, Spain, convention paper 6483.

Wickelmaier, F., & Ellermeier, W. (2007). Deriving auditory features from triadic comparisons. Perception & Psychophysics, 69(2), 287--297. 10.3758/BF03193750

See Also

eba, strans, paircomp.

Examples

Run this code
# NOT RUN {
requireNamespace("psychotools")
data(soundquality)

######### Replication code for Choisel and Wickelmaier (2007) ######

### A. Scaling overall preference

## Participants
summary(subset(SQsubjects, status == "selected"))

## Transitivity violations
aggregate(preference ~ progmat + time,
  data = SQpreference,
  function(x) unlist(strans(summary(x, pcmatrix = TRUE))[
                       c("weak", "moderate", "strong")]))

## BTL modeling
prefdf <- aggregate(preference ~ progmat + time,
            data = SQpreference,
            function(x) uscale(eba(summary(x, pcmatrix = TRUE))))

## Preference scale
p <- t(prefdf[prefdf$time == "before", 3])
colnames(p) <- levels(prefdf$progmat)
dotchart(p, main = "Quality of multichannel reproduced sound",
         xlab = "Estimated preference (BTL model)", log = "x",
         panel.first = abline(v = 1/8, col = "gray"))
points(x = t(prefdf[prefdf$time == "after", 3]),
       y = c(31:38, 21:28, 11:18, 1:8), pch = 3)
legend("topleft", c("before", "after"), pch = c(1, 3))
mtext("(Choisel and Wickelmaier, 2007)", line = 0.5)

### B. Scaling specific auditory attributes

## Transitivity violations
aggregate(
  x = SQattributes[-(1:2)],
  by = list(progmat = SQattributes$progmat),
  FUN = function(x) strans(summary(x, pcmatrix = TRUE))[
          c("weak", "moderate", "strong")],
  simplify = FALSE
)

## BTL modeling
uscal <- aggregate(
  x = SQattributes[-(1:2)],
  by = list(progmat = SQattributes$progmat),
  FUN = function(x) uscale(eba(summary(x, pcmatrix = TRUE)))
)
uscal <- data.frame(
  progmat = rep(levels(SQattributes$progmat), each = 8),
  repmod = factor(1:8, labels = labels(SQattributes$width)),
  as.data.frame(sapply(uscal[-1], t))
)

## EBA modeling: envelopment, width
uscal$envelopment[uscal$progmat == "SteelyDan"] <-
  uscale(eba(summary(SQattributes[SQattributes$progmat == "SteelyDan",
                                  "envelopment"], pcmatrix = TRUE),
             A = list(c(1,9), c(2,9), c(3,9), c(4,9), 5, 6, c(7,9), 8)))
uscal$width[uscal$progmat == "SteelyDan"] <-
  uscale(eba(summary(SQattributes[SQattributes$progmat == "SteelyDan",
                                  "width"], pcmatrix = TRUE),
             A = list(1, 2, c(3,9), c(4,9), c(5,9), 6, 7, c(8,9))))

### C. Relating overall preference to specific attributes

## Principal components: classical music
pca1 <- princomp(
  ~ width + spaciousness + envelopment + distance +
    clarity + brightness + elevation,
  data = uscal,
  subset = progmat %in% c("Beethoven", "Rachmaninov"),
  cor = TRUE
)

## Loadings on first two components
L <- varimax(loadings(pca1) %*% diag(pca1$sdev)[, 1:2])

## Factor scores
f <- scale(predict(pca1)[, 1:2]) %*% L$rotmat
dimnames(f) <- list(
  abbreviate(rep(labels(SQattributes$width), 2), 2),
  names(pca1$sdev)[1:2]
)
biplot(f, 2*L$loadings, cex = 0.8, expand = 1.5,
       main = "Preference and auditory attributes: classical music",
       xlim = c(-1.5, 2), ylim = c(-2, 2))

## Predicting preference
classdf <- cbind(
  pref = as.vector(t(prefdf[prefdf$time == "after" &
           prefdf$progmat %in% c("Beethoven", "Rachmaninov"), 3])),
  as.data.frame(f)
)
m1 <- lm(pref ~ Comp.1 + Comp.2 + I(Comp.1^2), classdf)
c1 <- seq(-1.5, 2.0, length.out = 101)
c2 <- seq(-2.0, 2.0, length.out = 101)
z <- matrix(predict(m1, expand.grid(Comp.1 = c1, Comp.2 = c2)), 101, 101)
contour(c1, c2, z, add = TRUE, col = "darkblue")

## Principal components: pop music
pca2 <- princomp(
  ~ width + spaciousness + envelopment + distance +
    clarity + brightness + elevation,
  data = uscal,
  subset = progmat %in% c("SteelyDan", "Sting"),
  cor = TRUE
)
L <- varimax(loadings(pca2) %*% diag(pca2$sdev)[, 1:2])
f[] <- scale(predict(pca2)[, 1:2]) %*% L$rotmat
biplot(f, 2*L$loadings, cex = 0.8,
       main = "Preference and auditory attributes: pop music",
       xlim = c(-1.5, 2), ylim = c(-2.5, 1.5))

popdf <- cbind(
  pref = as.vector(t(prefdf[prefdf$time == "after" &
           prefdf$progmat %in% c("SteelyDan", "Sting"), 3])),
  as.data.frame(f)
)
m2 <- lm(pref ~ Comp.1 + Comp.2 + I(Comp.2^2), popdf)
c1 <- seq(-1.5, 2.0, length.out = 101)
c2 <- seq(-2.5, 1.5, length.out = 101)
z <- matrix(predict(m2, expand.grid(Comp.1 = c1, Comp.2 = c2)), 101, 101)
contour(c1, c2, z, add = TRUE, col = "darkblue")
# }

Run the code above in your browser using DataLab