Data generation and analysis modules for standardized questionnaire AttrakDiff2 (M. Hassenzahl, M. Burmester, F. Koller, 2004).

Made by amat-design.com.

Licence for AttrakDiff2 (free to use): check licencing

Sources for items and calculations: La Grande Ourse

Items

Scales from -3 to 3 with a 0 step. Themes are:

QP = Qualités pragmatiques ;
QHS = Qualités hédoniques stimulation,
QHI = Qualité hédonique identification,
ATT = Attractivité globale.

In the passation order:

QP_1: Humain, Technique
QHI_1: M’isole, Me sociabilise
ATT_1: Plaisant, Déplaisant
QHS_1: Original, Convientionnel
QP_2: Simple, Compliqué
QHI_2: Professionnel, Amateur
ATT_2: Laid, Beau
QP_3: Pratique, Pas pratique
ATT_3: Agréable, Désagréable
QP_4: Fastidieux, Efficace
QHI_3: De bon goût, De mauvais goût
QP_5: Prévisible, Imprévisible
QHI_4: Bas de gamme, Haut de gamme
QHI_5: M’exclut, M’intègre
QHI_6: Me rapproche des autres, Me sépare des autres
QHI_7: Non-présentable, Présentable
ATT_4: Rebutant, Attirant
QHS_2: Sans imagination, Créatif
ATT_5: Bon, Mauvais
QP_6: Confus, Clair
ATT_6: Repoussant, Attrayant
QHS_3: Audacieux, Prudent
QHS_4: Novateur, Conservateur
QHS_5: Ennuyeux, Captivant
QHS_6: Peu exigeant, Exigeant
ATT_7: Motivant, Décourageant
QHS_7: Nouveau, Commun
QP_7: Incontrôlable, Maîtrisable

Inverted items:

QP_1
ATT_1
QHS_1
QP_2
QHI_2
QP_3
ATT_3
QHI_3
QP_5
QHI_6
ATT_5
QHS_3
QHS_4
ATT_7
QHS_7

Generate

# initialize data frame
AttrakDiff <- list()

# list themes
theme <- c("QP", "QHI", "ATT", "QHS")

# generate 7 named empty columns for each themes
for (i in 1:4){
  for (j in 1:7){
    len <- length(AttrakDiff)
    AttrakDiff[[len+1]] <- NA
    names(AttrakDiff)[len+1] <- paste(theme[i], j, sep = "_")
  }
}

# set number of participants
n <- 200

# populate with generated data
for (i in 1:length(AttrakDiff)){
  if (i %in% c(1:7)){
      AttrakDiff[[i]] <- sample(-3:3, n, replace = T, prob = c(1, 1, 1, 2, 3, 6, 4)) #QP
    } else if (i %in% c(8:14)){
      AttrakDiff[[i]] <- sample(-3:3, n, replace = T, prob = c(1, 3, 6, 2, 2, 1, 1)) #QHI
    } else if (i %in% c(9:21)){
      AttrakDiff[[i]] <- sample(-3:3, n, replace = T, prob = c(1, 1, 4, 6, 3, 2, 1)) #ATT
    } else if (i %in% c(22:28)){
      AttrakDiff[[i]] <- sample(-3:3, n, replace = T, prob = c(1, 2, 4, 6, 2, 1, 1)) #QHS
    }
}

# list inverted items by name
inverted <- c("QP_1", "ATT_1", "QHS_1", "QP_1", "ATT_1", "QHS_1", "QP_2", "QHI_2", 
              "QP_3", "ATT_3", "QHI_3", "QP_5", "QHI_6", "ATT_5", "QHS_3", "QHS_4", 
              "ATT_7", "QHS_7")

# invert items
for (i in 1:length(inverted)){
  AttrakDiff[[inverted[i]]] <- AttrakDiff[[inverted[i]]] * -1
}

# make it a data frame
AttrakDiff <- as.data.frame(AttrakDiff)

# reorder columns as the default passation order
AttrakDiff <- AttrakDiff[ , c(
  "QP_1", "QHI_1", "ATT_1", "QHS_1", "QP_2", "QHI_2", "ATT_2", "QP_3", "ATT_3", "QP_4", "QHI_3", "QP_5", "QHI_4", "QHI_5", "QHI_6", "QHI_7", "ATT_4", "QHS_2", "ATT_5", "QP_6", "ATT_6", "QHS_3", "QHS_4", "QHS_5", "QHS_6", "ATT_7", "QHS_7", "QP_7"
  )]

# display 6 first rows
head(AttrakDiff)

##   QP_1 QHI_1 ATT_1 QHS_1 QP_2 QHI_2 ATT_2 QP_3 ATT_3 QP_4 QHI_3 QP_5 QHI_4
## 1    0     3    -3    -1    0     1    -1    2     1    0     1   -3    -2
## 2    2     3    -1    -1    3     0     0    0     0   -1     2   -3    -2
## 3   -3    -1     1     0    0    -1     0   -1     0    2     1   -2     0
## 4    2    -1     1    -1   -2    -1     1   -3     0    2     1   -1     0
## 5    2    -2    -3    -2   -3    -3     2    0    -1    0    -1    3    -1
## 6    2     3     0     3    0     0     0   -2     0    2    -1    3     0
##   QHI_5 QHI_6 QHI_7 ATT_4 QHS_2 ATT_5 QP_6 ATT_6 QHS_3 QHS_4 QHS_5 QHS_6 ATT_7
## 1     2     0    -1     0    -2     0    1    -1     0    -3     0     0     0
## 2    -1    -1     0     0     1    -2    3    -3     1     1     0     0     1
## 3    -1     0    -1     1    -2     0    2     2     0    -1     0    -2     2
## 4     3     2    -2     0    -1     0    2     0    -2    -2    -1    -1    -1
## 5     1    -2    -3     2     1    -2    3     1     2     0    -2    -1    -3
## 6     2    -1     1     0     2    -1   -3     0     0    -1    -1     0    -2
##   QHS_7 QP_7
## 1     0    2
## 2     1    2
## 3     0    2
## 4    -2    2
## 5     0    2
## 6     1    2

Transform

attention aux items inversés
regrouper les items par dimension (7 items dans chacune) ;
calculer la moyenne obtenue pour chaque dimension.

# duplicate raw data to transform without lost
AttrakDiff.tr <- AttrakDiff

# transform inverted items
for (i in 1:length(inverted)){
  AttrakDiff.tr[[inverted[i]]] <- AttrakDiff.tr[[inverted[i]]] * -1
}

AttrakDiff.tr.margins <- data.frame()

# add a column by themes and compute themes means by row
for (i in 1:length(theme)) {
  for (j in 1:nrow(AttrakDiff.tr)) {
    AttrakDiff.tr.margins[j, paste("mean", theme[i], sep = "_")] <- mean(
    as.numeric(
      #select(AttrakDiff.tr, starts_with(theme[i]))[j, ]
      AttrakDiff.tr[j, grepl(theme[i], names(AttrakDiff.tr))]
      )
    )
  }
}

# compute QH means by row
for (j in 1:nrow(AttrakDiff.tr.margins)) {
  AttrakDiff.tr.margins[j, paste("mean", "QH", sep = "_")] <- mean(
    as.numeric(
      AttrakDiff.tr[j, grepl("QH", names(AttrakDiff.tr))]
      )
  )
}

# display 6 first rows
head(AttrakDiff.tr.margins)

##     mean_QP   mean_QHI   mean_ATT   mean_QHS    mean_QH
## 1 0.5714286  0.0000000 -0.8571429  0.0000000  0.0000000
## 2 0.8571429 -0.1428571 -0.4285714 -0.4285714 -0.2857143
## 3 0.8571429 -0.4285714  0.2857143 -0.4285714 -0.4285714
## 4 2.0000000 -0.2857143  0.4285714  0.2857143  0.0000000
## 5 1.0000000  0.1428571  1.1428571 -0.8571429 -0.3571429
## 6 0.2857143  1.1428571  0.4285714  0.5714286  0.8571429

Infere

Note: normality of distribution may not be assumed for both QP and QH simultaneously. For that reason, I chose the bootstrap method to compute confidence intervals.

# initializing bootstrap for QP
table.QP <- numeric(1000)

# loop to generate means from original data
for(i in 1:1000) {
  table.QP[i] <- mean(sample(AttrakDiff.tr.margins$mean_QP, 10, replace=T))
}

# sort generated means
table.QP.sorted <- sort(table.QP)

# catch conf int by selecting heads and tails
QP.ci <- c(table.QP.sorted[25], table.QP.sorted[975])

print(paste("Total mean of QP:", round(mean(AttrakDiff.tr.margins$mean_QP), 1)))

## [1] "Total mean of QP: 1.2"

print(paste("95% CI for QP mean (bootstrap):", round(QP.ci, 1)[1], round(QP.ci, 1)[2]))

## [1] "95% CI for QP mean (bootstrap): 0.8 1.5"

# initializing bootstrap for QH
table.QH <- numeric(1000)

# loop to generate means from original data
for(i in 1:1000) {
  table.QH[i] <- mean(sample(AttrakDiff.tr.margins$mean_QH, 10, replace=T))
}

# sort generated means
table.QH.sorted <- sort(table.QH)

# catch conf int by selecting heads and tails
QH.ci <- c(table.QH.sorted[25], table.QH.sorted[975])

print(paste("Total mean of QH:", round(mean(AttrakDiff.tr.margins$mean_QH), 1)))

## [1] "Total mean of QH: -0.4"

print(paste("95% CI for QH mean (bootstrap):", round(QH.ci, 1)[1], round(QH.ci, 1)[2]))

## [1] "95% CI for QH mean (bootstrap): -0.6 -0.1"

Visualize

# plotting mean values

y <- c(
  mean(AttrakDiff.tr.margins$mean_QP),
  mean(AttrakDiff.tr.margins$mean_QHI),
  mean(AttrakDiff.tr.margins$mean_ATT),
  mean(AttrakDiff.tr.margins$mean_QHS)
)

path <- y

x <- c("Pragmatic qual.", "Identification qual.", "Attractivity", "Stimulation qual.")

meanplot <- data.frame(x, y)

if (!require(ggplot2)) install.packages("ggplot2")

## Loading required package: ggplot2

library(ggplot2)

limits <- c(-3, 3)

ggplot(meanplot, aes(x, y, fill = y)) +
  geom_hline(aes(yintercept = 0), size = 1.5, colour = "white") +
  geom_dotplot(binaxis = "y", stackdir = "center", binwidth = 0.75, color = "white") +
  scale_fill_gradient(name = "Score", low = "red", high = "green", limits = limits) +
  coord_cartesian(ylim = limits) +
  labs(title ="AttrakDiff mean scores", subtitle = "by themes", x = "Themes", y = "Mean scores")

# plotting word pairs

itemMean <- c()
itemName <- c()
itemTheme <- c()

for (i in 1:ncol(AttrakDiff.tr)) {
  itemMean[i] <- mean(as.numeric(AttrakDiff.tr[, i]))
  itemName[i] <- colnames(AttrakDiff.tr)[i]
  itemTheme[i] <- sub("_.", "", colnames(AttrakDiff.tr)[i])
}

itemName <- as.factor(itemName)
itemTheme <- as.factor(itemTheme)

AttrakDiff.items <- data.frame(mean = itemMean, name = itemName, theme = itemTheme)

AttrakDiff.items <- AttrakDiff.items[order(AttrakDiff.items$name), ]

ggplot(AttrakDiff.items, aes(mean, name, fill = theme)) +
  geom_col(alpha = 0.2) +
  geom_dotplot(binaxis = "y", stackdir = "center", binwidth = 0.75, color = "white") +
  coord_cartesian(xlim = limits) +
  scale_fill_brewer(palette = "Set2") +
  geom_vline(aes(xintercept = 0), linetype = "dotted", colour = "firebrick") +
  labs(title ="AttrakDiff mean scores", subtitle = "by item and theme", x = "Means", y = "Items")

AttrakDiff Notebook

Paul Amat

June 25, 2022

Items

Generate

Transform

Infere

Visualize