Visualization of Dissertation

Meng Zhang

Nov 2023

s1_theme <- theme(
  text = element_text(size = 14), 
  axis.title = element_text(size = 16), 
  axis.text = element_text(size = 14), 
  legend.title = element_text(size = 16), 
  legend.text = element_text(size = 14),
  legend.background = element_rect(fill="transparent", colour=NA)
)

Introduction

The Self-Assessment Manikin (Bradley and Lang, 1994)

This page documents some of the data processing and data visualization content involved in my doctoral thesis (Zhang (2023)). The data processing part used the data.table, dplyr, psych, and zoo package in R language, while the visualization part employed the ggplot2, ggsignif, ggrepel, ggridges, and ggsci package. The presentation of this RMarkdown was facilitated using template in rmdformats package.

Theory

Emotional dimensions

Dimensional emotion theories aim to provide a structural description of subjective feeling using a multidimensional space. The visualization results here are based on Fontaine et al. (2007).

emotions <- data.frame(
  emotion = c("excited", "happy", "surprised", "disgusted", "angry", "fearful", "sad", "relaxed"),
  valence =   c(62, 81, 40, -60, -51, -64, -63, 68),
  arousal =   c(75, 51, 67, 35, 59, 60, -27, -46),
  dominance = c(38, 46, -13, 11, 25, -43, -33, 6)
)

Valence x Arousal

A two-dimensional space, valence-arousal dimensional model (Russell (1980)) is widely recognized, where valence (or pleasantness) is defined in terms of positive or negative attitude, while arousal is defined in terms of mental alertness and physical activity (Mehrabian (1996)).

ggplot(emotions, aes(x = valence, y = arousal)) +
  geom_point(color = "steelblue", size = 4) +
  geom_text_repel(aes(label = emotion),size = 6)+
  geom_hline(yintercept = 0, size=1.1, linetype = "solid") +
  geom_vline(xintercept = 0, size=1.1,linetype = "solid") +
  scale_x_continuous(name = "Valence\n(unpleasant  -  pleasant)", limits = c(-100,100),labels=c()) + 
  scale_y_continuous(name = "Arousal\n (calm  -  active)", limits = c(-100,100),labels = c()) +
  labs(caption = "based on Fontaine et al. (2007)") +
  theme_minimal() +
  theme(legend.position = "none",
        axis.title.x = element_text(size = 20),
        axis.title.y = element_text(size = 20))

Power x Novelty

Fontaine et al. (2007) proposes additional dimensions (such as novelty and power) beyond valence and arousal.

emotions <- data.frame(
  emotion = c("excited", "happy", "surprised", "disgusted", "angry", "fearful", "sad", "relaxed"),
  novelty = c(10, 0, 89, 45, 5, 40, -12, 0),
  power = c(38, 46, -13, 11, 75, -43, -33, 6)
)

ggplot(emotions, aes(x = power, y = novelty)) +
  geom_point(color = "steelblue", size = 4) +
  geom_text_repel(aes(label = emotion),size = 6)+
  geom_hline(yintercept = 0, size=1.1, linetype = "solid") +
  geom_vline(xintercept = 0, size=1.1,linetype = "solid") +
  scale_x_continuous(name = "Power\n(weak  -  powerfull)", limits = c(-100,100),labels=c()) + 
  scale_y_continuous(name = "Novelty\n (unpredictable  -  predictable)", limits = c(-100,100),labels = c()) +
  labs(caption = "based on Fontaine et al. (2007)") +
  theme_minimal() +
  theme(legend.position = "none",
        axis.title.x = element_text(size = 20),
        axis.title.y = element_text(size = 20))

Survey result

The current consensus and disagreements among emotion experts regarding emotion theories can be seen in the results of the survey below (Ekman (2016)).

Is there a universality?

data <- data.table(
  category = c("Ja", "Nein"),
  value = c(88, 12)
)
#data$category <- factor(data$category,levels = c("Ja","Nein"))
data[,prob := round(value/sum(value)*100,2)]
data <- data[order(-rank(category))]
data[,lab.ypos := cumsum(prob) -0.5*prob]

ggplot(data, aes(x = "", y = prob, fill = category)) +
        geom_bar(width = 1, stat = "identity", color = "white",alpha=.7,size=2) +
        coord_polar("y", start = 0)+
        geom_label_repel(data = data,
                     aes(y = lab.ypos, label = paste0(category,": ",value,"%")),
                     size = 6, nudge_x = .5, show.legend = FALSE) +
        theme_void() + 
        theme(legend.position="none",
              title = element_text(size = 16)) +
        labs(x = "", y = "", title = "Gibt es Beweise für Universalität \nin irgendeinem Aspekt von Emotionen?",
          subtitle = "N = 248")+
        scale_fill_manual(values = c("steelblue","lightblue2"))

Which part has universality?

data <- data.frame(
  category = c("Signals (face and/or voice)", 
               "Events Triggering Emotion", 
               "Physiology", 
               "Appraisal Mechanisms"),
  percentage = c(80, 66, 51, 44)
)

ggplot(data, aes(x = reorder(category, percentage), y = percentage)) +
  geom_bar(stat = "identity", fill = "steelblue", width = .5) +
  geom_text(aes(label = paste0(percentage, "%")), position = position_dodge(width=0.9), hjust = -0.2) +
  labs(title = "Gibt es Beweise für Universalität?",
       x = "",
       y = "") +
  coord_flip() +
  ylim(0,100)+
  theme_minimal() +
  theme(
  text = element_text(size = 14), 
  axis.title = element_text(size = 16), 
  axis.text = element_text(size = 14), 
  legend.title = element_text(size = 16), 
  legend.text = element_text(size = 14),
  legend.background = element_rect(fill="transparent", colour=NA)
)+
  theme(axis.text.x = element_blank())

Experiment design

The studies were conducted using a driving simulator, which consists of three screens and a steering wheel as well as gas and brake pedals. The driving scenarios took place in an urban setting. In each of the two drives, one emotional state was triggered (in random order for participants).

Subjective rating

The first step in investigating drivers’ fear under laboratory conditions is to induce the fear. Whether fear can be successfully induced in drivers through driving-related events in a simulated driving environment remains will be validated. Here are some results based on Zhang, Ihme, and Drewitz (2019).

SAM

The Self-Assessment Manikin (SAM, Bradley and Lang (1994)) was used to represent participants’ emotional responses on valence, arousal, and power dimensions.

tt <- "SAM"
vcol <- c("Valence","Arousal","Power")
lim = c(0,9)
brk = seq(0, 9, 1)

temp <- agg.sub_1[variable %in% vcol]
temp$variable <- factor(temp$variable,levels=vcol)
temp$con <- factor(temp$con,levels = c("challenge","threat"), labels = c("challenge","threat"))

ggplot(data= temp,aes(variable,mean)) + 
  geom_bar(aes(variable,mean,fill=con),
           stat="identity",position="dodge",width = .5,alpha=.7) +
  geom_errorbar(aes(variable,ymin=mean-se, ymax=mean+se,col=con),
                    width=.2, position=position_dodge(width = .5)) +
  theme_bw() + guides(color=FALSE) +
  labs(x = "", 
       y = "Likert scale",
       caption = "NS: not significant",
       subtitle = "Error bars = Standard error",
       title = tt) +
  guides(fill=guide_legend(title = "")) +
  s1_theme+
  theme(legend.position= c(.85,.95),
        plot.caption = element_text(hjust = 0))+
  scale_fill_manual(values=c("lightblue2","steelblue")) +
  scale_color_manual(values=c("lightblue2","steelblue")) +
  scale_y_continuous(limits=lim, breaks = brk)+
  geom_signif(y_position=c(7,5.5,6.5),  ### adjusted
              xmin=seq(.85,2.85,1), 
              xmax=seq(1.15,3.15,1),
              annotation=c("NS","NS","NS"), 
              tip_length=0.02,textsize = 4,vjust=0)

PANAS

The Positive Affect and Negative Affect Scale-Extended (PANAS, Watson, Clark, and Tellegen (1988)) is a discrete scale composed of 20 adjectives describing ten positive and ten negative emotion terms.

selected items

tt <- "PANAS"
vcol <- c("scared","afraid","upset","irritable","n1","n2")
vlab <- c("scared","afraid","upset","irritable","Neg. Valence\nItems","Low Power\nItems")
lim = c(0,5)
brk = seq(0, 5, 1)

temp <- agg.sub_1[variable %in% vcol]
temp$variable <- factor(temp$variable,levels=vcol,labels = vlab)
temp$con <- factor(temp$con,levels = c("challenge","threat"), labels = c("challenge","threat"))
temp2 <- df.sub

ggplot(data= temp,aes(variable,mean)) + 
  geom_bar(aes(variable,mean,fill=con),
           stat="identity",position="dodge",width = .5,alpha=.7) +
  geom_errorbar(aes(variable,ymin=mean-se, ymax=mean+se,col=con),
                    width=.2, position=position_dodge(width = .5)) +
  theme_bw() + guides(color=FALSE) +
  labs(x = "", 
       y = "Likert scale",
       caption = "NS: not significant \n*** p < .001 significant",
       subtitle = "Error bars = Standard error",
       title = tt) +
  guides(fill=guide_legend(title = "")) +
  s1_theme+
  theme(legend.position= c(.85,.95),
        plot.caption = element_text(hjust = 0))+
  scale_fill_manual(values=c("lightblue2","steelblue")) +
  scale_color_manual(values=c("lightblue2","steelblue")) +
  scale_y_continuous(limits=lim, breaks = brk)+
  geom_signif(y_position=c(3.5,2,3.2,2.9,2.8,2.5),  ### adjusted
              xmin=seq(.85,5.85,1), 
              xmax=seq(1.15,6.15,1),
              annotation=c("***","NS" ,"NS", "NS","NS","***"), 
              tip_length=0.02,textsize = 4,vjust=0)

PA items

tt <- "PANAS - PA"
vcol <- c("active","alert", "attentive", "determined","enthusiastic","excited","inspired" ,"interested","proud", "strong")      
vlab <- c("'active'","'alert'", "'attentive'", "'determined'","'enthusiastic'","'excited'","'inspired'" ,"'interested'","'proud'", "'strong'")     
lim = c(0,5)
brk = seq(0, 5, 1)

temp <- agg.sub_1[variable %in% vcol]
temp$variable <- factor(temp$variable,levels=vcol,labels = vlab)
temp$con <- factor(temp$con,levels = c("challenge","threat"), labels = c("challenge","threat"))

ggplot(data= temp,aes(variable,mean)) + 
  geom_bar(aes(variable,mean,fill=con),
           stat="identity",position="dodge",width = .5,alpha=.7) +
  geom_errorbar(aes(variable,ymin=mean-se, ymax=mean+se,col=con),
                    width=.2, position=position_dodge(width = .5)) +
  theme_bw() + guides(color=FALSE) +
  labs(x = "", 
       y = "Likert scale",
       subtitle = "Error bars = Standard error",
       title = tt) +
  guides(fill=guide_legend(title = "")) +
  s1_theme+
  theme(legend.position = c(.85,.9),
        axis.text.x = element_text(angle = 45, hjust = 1))+
  scale_fill_manual(values=c("lightblue2","steelblue")) +
  scale_color_manual(values=c("lightblue2","steelblue")) +
  scale_y_continuous(limits=lim, breaks = brk)

NA items

tt <- "PANAS - NA"
vcol <- c("afraid","ashamed","distressed","guilty","hostile", "irritable", "jittery","nervous","scared","upset","frustrated")               
vlab <- c("'afraid'","'ashamed'","'distressed'","'guilty'","'hostile'", "'irritable'", "'jittery'","'nervous'","'scared'","'upset'","'frustrated'") 
lim = c(0,5)
brk = seq(0, 5, 1)

temp <- agg.sub_1[variable %in% vcol]
temp$variable <- factor(temp$variable,levels=vcol,labels = vlab)
temp$con <- factor(temp$con,levels = c("challenge","threat"), labels = c("challenge","threat"))

ggplot(data= temp,aes(variable,mean)) + 
  geom_bar(aes(variable,mean,fill=con),
           stat="identity",position="dodge",width = .5,alpha=.7) +
  geom_errorbar(aes(variable,ymin=mean-se, ymax=mean+se,col=con),
                    width=.2, position=position_dodge(width = .5)) +
  theme_bw() + guides(color=FALSE) +
  labs(x = "", 
       y = "Likert scale",
       subtitle = "Error bars = Standard error",
       title = tt) +
  guides(fill=guide_legend(title = "")) +
  s1_theme+
  theme(legend.position = c(.85,.9),
        axis.text.x = element_text(angle = 45, hjust = 1))+
  scale_fill_manual(values=c("lightblue2","steelblue")) +
  scale_color_manual(values=c("lightblue2","steelblue")) +
  scale_y_continuous(limits=lim, breaks = brk)

Physiological responses

Physiological indicators of the participants were collected using electrodermal activity (EDA) measurement, electrocardiogram (ECG), and thermal imaging cameras. Based on the assumption that low power appraisal results in reduced body temperatures (Gillioz et al. (2016)), Zhang, Ihme, and Drewitz (2019) aimed to investigate changes in temperature as indicators of power appraisal in the driving context.

EDA

tt <- "SC"
vcol <- c("sc")
vlab <- c("SCL")
lim = c(-.2,.8)
brk = seq(-.2, .8, .1)
temp <- agg.obj_1[variable %in% vcol]
temp$variable <- factor(temp$variable,levels=vcol,labels = vlab)
temp$con <- factor(temp$con,levels = c("challenge","threat"), labels = c("challenge","threat"))

ggplot(data= temp,aes(variable,mean)) + 
  geom_bar(aes(variable,mean,fill=con),
           stat="identity",position="dodge",width = .5,alpha=.7) +
  geom_errorbar(aes(variable,ymin=mean-se, ymax=mean+se,col=con),
                    width=.2, position=position_dodge(width = .5)) +
  geom_hline(yintercept = 0)+
  theme_bw() + guides(color=FALSE) +
  labs(x = "", 
       #y = "Changing of SCL [µS]",
       y = "skin conductance [µS]",
       caption = "*** p < .001 significant",
       subtitle = "Error bars = Standard error",
       title = "Change in skin conductance after events" ) +
  guides(fill=guide_legend(title = "")) +
  s1_theme+
  theme(legend.position= NULL,
        plot.caption = element_text(hjust = 0))+
  scale_fill_manual(values=c("lightblue2","steelblue")) +
  scale_color_manual(values=c("lightblue2","steelblue")) +
  scale_y_continuous(limits=lim, breaks = brk)+
  geom_signif(y_position=c(.7),  ### adjusted
            xmin=.85, 
            xmax=1.15,
            annotation=c("***"), 
            tip_length=0.02,textsize = 4,vjust=0)

ECG

tt <- "IBI"
vcol <- c("rrMean")
vlab <- c("IBI")
lim = c(-80,40)
brk = seq(-80, 40, 10)
temp <- agg.obj_1[variable %in% vcol]
temp$variable <- factor(temp$variable,levels=vcol,labels = vlab)
temp$con <- factor(temp$con,levels = c("challenge","threat"), labels = c("challenge","threat"))

ggplot(data= temp,aes(variable,mean)) + 
  geom_bar(aes(variable,mean,fill=con),
           stat="identity",position="dodge",width = .5,alpha=.7) +
  geom_errorbar(aes(variable,ymin=mean-se, ymax=mean+se,col=con),
                    width=.2, position=position_dodge(width = .5)) +
  geom_hline(yintercept = 0)+
  theme_bw() + guides(color=FALSE) +
  labs(x = "", 
       #y = "Changing of IBI [ms]",
       y = "IBI [ms]",
       caption = "*** p < .001 significant",
       subtitle = "Error bars = Standard error",
       title = "Change in inter-beat interval after events") +
  guides(fill=guide_legend(title = "")) +
  s1_theme+
  theme(legend.position= NULL,
        plot.caption = element_text(hjust = 0))+
  scale_fill_manual(values=c("lightblue2","steelblue")) +
  scale_color_manual(values=c("lightblue2","steelblue")) +
  scale_y_continuous(limits=lim, breaks = brk)+
  geom_signif(y_position=c(20),  ### adjusted
            xmin=.85, 
            xmax=1.15,
            annotation=c("***"), 
            tip_length=0.02,textsize = 4,vjust=0)

Temperature

Extraction of ROI from thermal image

tt <- "Temperature"
vcol <- c("tempMean","forehead.t","noset.t")
vlab <- c("finger","forehead","nosetip")
lim = c(-.13,.1)
brk = seq(-.13, .1, .05)
temp <- agg.obj_1[variable %in% vcol]
temp$variable <- factor(temp$variable,levels=vcol,labels = vlab)
temp$con <- factor(temp$con,levels = c("challenge","threat"), labels = c("challenge","threat"))

ggplot(data= temp,aes(variable,mean)) + 
  geom_bar(aes(variable,mean,fill=con),
           stat="identity",position="dodge",width = .5,alpha=.7) +
  geom_errorbar(aes(variable,ymin=mean-se, ymax=mean+se,col=con),
                    width=.2, position=position_dodge(width = .5)) +
  geom_hline(yintercept = 0)+
  theme_bw() + guides(color=FALSE) +
  labs(x = "", 
       #y = "Changing of temperature [°C]",
       y = "Temperature [°C]",
       caption = "NS: not significant \n* p < .05 significant",
       subtitle = "Error bars = Standard error",
       title = "Change in temperature after the event") +
  guides(fill=guide_legend(title = "")) +
  s1_theme+
  theme(legend.position= c(.2,.2),
        plot.caption = element_text(hjust = 0))+
  scale_fill_manual(values=c("lightblue2","steelblue")) +
  scale_color_manual(values=c("lightblue2","steelblue")) +
  scale_y_continuous(limits=lim, breaks = brk)+
  geom_signif(y_position=c(.06,.06,.03),  ### adjusted
              xmin=seq(.85,2.85,1), 
              xmax=seq(1.15,3.15,1),
              annotation=c("NS", "*","NS"), 
              tip_length=0.02,textsize = 4,vjust=0)

Facial expression

Video analysis based on the Facial Action Coding System (FACS) as well as the facial electromyography (EMG) is often applied in the field of measuring facial expressions. The Facial Action Coding System (FACS, Ekman and Friesen (1978)) was used to describe facial expressions systematically based on activity in atomic units of facial action, the action units (AUs). Zhang et al. (2021) aimed to emphasize the importance of the multidimensional and dynamic characteristics in assessing emotions. It was assumed that facial expressions, as a component affected by appraisals, would reflect these characteristics.

Example of Action Units

set.seed(123)
expressions <- c("AU 1 Inner brow raiser", "AU 2 Outer brow raiser", "AU 4 Brow lowerer", "AU 5 Upper lid raiser", "AU 7 Lid tightener", "AU 15 Lip corner depressor", "AU 20 Lip stretcher", "AU 25 Lips part", "AU 26 Jaw drop")
values <- runif(9, 0, 100)

df <- data.frame(expressions, values)
df$expressions <- factor(df$expressions,levels=rev(expressions))


 ggplot(data= df, aes(x = expressions, y = values),fill="steelblue") +
  geom_bar(stat = "identity") + 
   xlab("")+
  coord_flip() + 
  theme_classic()+
  theme(axis.title.x=element_blank(), 
        axis.text.x=element_blank(),  
        axis.ticks.x=element_blank())

Action Units (average)

tempm <- dte1[,.(Mean = mean(novelty),Std = std(novelty)),by=.(vp,emotion)]
tempm <- rbind(tempm,dte1[,.(Mean = mean(lowpower),Std = std(lowpower)),by=.(vp,emotion)])
tempm[,comb := rep(c("High novelty", "Low power"),each = nrow(tempm)/2)]
tempm <- data.table(tempm)
tempm[,.(median(Mean),IQR(Mean)),by=.(emotion,comb)]
temp <- tempm[,.(Mean = mean(Mean),Std = std(Mean)),by=.(comb,emotion)]

temp$comb <- factor(temp$comb,levels = c("High novelty", "Low power"))
temp$emotion <- factor(temp$emotion,levels = c("BL","Fear"),labels = c("Entspannung","Angst"))

ggplot(data = temp, aes(comb,Mean)) + 
  geom_bar(aes(comb,Mean,fill=emotion),stat="identity",position="dodge",width = .5,alpha=.7) +
  geom_errorbar(aes(comb,ymin=Mean-Std, ymax=Mean+Std,col=emotion),
                    width=.2, position=position_dodge(width = .5)) +
  theme_bw() + guides(color=FALSE) +
  labs(x = "", 
       y = "AU-Index",
       subtitle = "Error bars = Standard error",
       title = "Change in AU-Index after events",
       caption = "*** p < .001 significant") +
  scale_y_continuous(limits = c(-.2,.5),breaks = seq(-.2,.5,.1))+
  scale_fill_manual(name = "", values=c("lightblue2","steelblue")) +
  scale_color_manual(values=c("lightblue2","steelblue")) +
  theme(legend.position= "right",legend.text = element_text(size = 14),
        plot.caption = element_text(hjust = 0),
        legend.background = element_rect(fill="transparent", colour=NA),
        text = element_text(size = 14), 
        axis.title = element_text(size = 16), 
        axis.text = element_text(size = 14))+
  geom_signif(y_position=c(.45,.35),  ### adjusted
              xmin=seq(.85,1.85,1), 
              xmax=seq(1.15,2.15,1),
              annotation=c("***","***"), 
              tip_length=0.02,textsize = 4,vjust=0)

Action Units in time course

temp0 <- melt(daten2,1:3,variable.name = "time")
temp0[,time := as.numeric(as.character(time))/1000]
temp0[,vpnr := as.numeric(substr(vp,3,4))]
temp <- temp0[,.(m = mean(value,na.rm=T),
                se = std(value)),by=.(channel,emotion,time)]
temp$emotion <- factor(temp$emotion,levels = c("BL","Fear"),labels = c("Entspannung","Angst"))

high novelty

i <- "novelty"

# time line
  tem <- temp[channel==i]
  ggplot(data = tem)+
    geom_point(aes(time,m,col=emotion),size=2)+
    geom_line(aes(time,m,col=emotion),size=1)+
    geom_errorbar(aes(time,ymin=m-se, ymax=m+se,col=emotion),width=.05) +
    labs(title = "High novelty (average of AU 1, 2, 4, 5 and 7)",
         x = "time after event [s]", 
         y = "AU Index",
         subtitle = "Error bars = Standard error",
         caption = "rot: p < .05 significant") +
    geom_hline(yintercept = 0, linetype=2) +
    scale_x_continuous(limits=c(0, 5), breaks = seq(0, 5, .5))+
    theme_bw() + 
    theme(legend.position= c(.85,.9),legend.text = element_text(size = 14),
        plot.caption = element_text(hjust = 0),
        legend.background = element_rect(fill="transparent", colour=NA))+
    annotate("rect",xmin=0, xmax=2.65, ymin=-Inf, ymax=Inf,fill="red", alpha=.1) +
    scale_colour_manual(name="", values = c("lightblue","steelblue"))

low power

i <- "lowpower"

 # time line
  tem <- temp[channel==i]
  ggplot(data = tem)+
    geom_point(aes(time,m,col=emotion),size=2)+
    geom_line(aes(time,m,col=emotion),size=1)+
    geom_errorbar(aes(time,ymin=m-se, ymax=m+se,col=emotion),width=.05) +
    labs(title = "Low power (average of AU 15, 20, 25 and 26)",
         x = "time after event [s]", 
         y = "AU Index",
         subtitle = "Error bars = Standard error",
         caption = "rot: p < .05 significant") +
    geom_hline(yintercept = 0, linetype=2) +
     scale_x_continuous(limits=c(0, 5), breaks = seq(0, 5, .5))+
    theme_bw() +
    theme(legend.position= c(.15,.9),legend.text = element_text(size = 14),
        plot.caption = element_text(hjust = 0),
        legend.background = element_rect(fill="transparent", colour=NA))+
    annotate("rect",xmin=2.45, xmax=2.75, ymin=-Inf, ymax=Inf,fill="red", alpha=.1) +
    annotate("rect",xmin=3.25, xmax=3.75, ymin=-Inf, ymax=Inf,fill="red", alpha=.1) +
    annotate("rect",xmin=4.35, xmax=4.45, ymin=-Inf, ymax=Inf,fill="red", alpha=.1) +
    annotate("rect",xmin=4.55, xmax=4.65, ymin=-Inf, ymax=Inf,fill="red", alpha=.1) +
    scale_colour_manual(name="", values = c("lightblue","steelblue"))

Event-related analysis paradigm

Zhang, Jipp, and Ihme (2022) focused on the multimodal assessments of fear. The physiological responses component, as well as the facial expression in the expression component, were investigated with the assumption that they are associated with the novelty appraisal. As events are repeated, the familiarity with the events increases, accompanied by a decrease in novelty appraisal.

Alignment

before

temp <- dt3[vp=="vp03",.(t,SC,hrMean,PupilDiameter.f,novelty)]
temp_e <- dt3[vp=="vp03" & event_time==0 & event_c!=14,.(t)]
temp[,PupilDiameter.f:= PupilDiameter.f * 1000]
colnames(temp) <- c("time","SC [µS]", "HR [1/min]", "PD [mm]","AUs [-]")
temp <- melt(temp,id=1)
temp[,variable := factor(variable, levels = c("PD [mm]","SC [µS]","HR [1/min]","AUs [-]"))]
unicode_minus = function(x) sub('^-', '\U2212', format(x))
ggplot()+
  geom_point(data=temp,aes(time,value),alpha=.5,size=.5)+
  geom_line(data=temp,aes(time,value),alpha=.5,size=.5)+
  theme_bw()+
  theme(legend.position = "none")+
  scale_x_continuous(name = "Zeit [s]",breaks = seq(0,500,50),labels = unicode_minus)+
  scale_y_continuous(labels = unicode_minus)+
  geom_vline(xintercept = temp_e$t, linetype=2,alpha=.5,col="grey",size=1) +
  facet_wrap(.~variable,scales = "free",ncol=1)

after

temp <- dte[vp=="vp03" & event_c!=14,.(event_time,event_c,SC,hrMean,PupilDiameter.f,novelty)]
temp[,PupilDiameter.f:= PupilDiameter.f * 1000]
colnames(temp) <- c("time","event","SC [µS]", "HR [1/min]", "PD [mm]","AUs [-]")
temp <- melt(temp,id=c(1,2))
temp[,variable := factor(variable, levels = c("PD [mm]","SC [µS]","HR [1/min]","AUs [-]"))]
temp[,event := ifelse(event==11,"1",ifelse(event==12,"2",3))]
temp[,time := time/1000]
temp <- temp[,value:= value - mean(value[which(time < 0)],na.rm=T),by=.(variable,event)]

ggplot()+
  geom_point(data=temp,aes(time,value,col=event),size=1, alpha=.5)+
  geom_line(data=temp,aes(time,value,col=event),size=1,alpha=.5)+
  theme_bw()+
  theme(legend.position = "right")+
  scale_color_npg(name="Event")+
  scale_x_continuous(name = "time after event[s]",breaks = seq(-1,10,1),labels = unicode_minus)+
  scale_y_continuous(labels = unicode_minus)+
  geom_vline(xintercept = 0, linetype=2,alpha=.5,col="grey",size=1) +
  facet_wrap(.~variable,scales = "free",ncol=1)

Multimodal comparison

temp <- daten_time[!variable %in% c("Peak time of AU1", "Peak time of AU2",
                                    "Peak time of AU4","Peak time of AU5",
                                    "Peak time of AU7","Active time of SCR")]
temp[,variable:= gsub("Peak time of ","",variable)]
temp[,variable:=ifelse(variable == "pupil diameter","PD",variable)]
temp[,variable := factor(variable, levels = c("AUs","HR","SCR","PD"))]

ggplot(temp, aes(x = value, y = variable)) +
  geom_density_ridges(jittered_points = TRUE,fill = "steelblue",
    position = position_points_jitter(width = 0.05, height = 0),
    point_shape = '|', point_size = 3, point_alpha = 1, alpha = 0.7) +
  geom_vline(xintercept = 0,col="black",size=1) +
  theme_ridges() + 
  scale_fill_locuszoom()+
  scale_x_continuous(name="time after event [s]",breaks = seq(-2,12,1))+
  ylab("")+
  ggtitle("Frequency distribution of peak times")+
  theme(legend.position = "none")

References

Bradley, Margaret M, and Peter J Lang. 1994. “Measuring Emotion: The Self-Assessment Manikin and the Semantic Differential.” Journal of Behavior Therapy and Experimental Psychiatry 25 (1): 49–59.

Ekman, Paul. 2016. “What Scientists Who Study Emotion Agree About.” Perspectives on Psychological Science 11 (1): 31–34.

Ekman, Paul, and Wallace V Friesen. 1978. “Facial Action Coding System.” Environmental Psychology & Nonverbal Behavior.

Fontaine, Johnny RJ, Klaus R Scherer, Etienne B Roesch, and Phoebe C Ellsworth. 2007. “The World of Emotions Is Not Two-Dimensional.” Psychological Science 18 (12): 1050–57.

Gillioz, Christelle, Johnny RJ Fontaine, Cristina Soriano, and Klaus R Scherer. 2016. “Mapping Emotion Terms into Affective Space.” Swiss Journal of Psychology.

Mehrabian, Albert. 1996. “Pleasure-Arousal-Dominance: A General Framework for Describing and Measuring Individual Differences in Temperament.” Current Psychology 14: 261–92.

Russell, James A. 1980. “A Circumplex Model of Affect.” Journal of Personality and Social Psychology 39 (6): 1161.

Watson, David, Lee Anna Clark, and Auke Tellegen. 1988. “Development and Validation of Brief Measures of Positive and Negative Affect: The PANAS Scales.” Journal of Personality and Social Psychology 54 (6): 1063.

Zhang, Meng. 2023. “Understanding Fear in a Multimodal and Multidimensional Way: Evidence from Driving Simulator Studies.” PhD thesis, Technische Universität Braunschweig.

Zhang, Meng, Klas Ihme, and Uwe Drewitz. 2019. “Discriminating Drivers’ Emotions Through the Dimension of Power: Evidence from Facial Infrared Thermography and Peripheral Physiological Measurements.” Transportation Research Part F: Traffic Psychology and Behaviour 63: 135–43.

Zhang, Meng, Klas Ihme, Uwe Drewitz, and Meike Jipp. 2021. “Understanding the Multidimensional and Dynamic Nature of Facial Expressions Based on Indicators for Appraisal Components as Basis for Measuring Drivers’ Fear.” Frontiers in Psychology 12: 622433.

Zhang, Meng, Meike Jipp, and Klas Ihme. 2022. “The Novelty Appraisal of the Feeling of Risk in Vehicles.” International Journal of Environmental Research and Public Health 19 (21): 14259.