Carneige Hall Rachmaninoff Experiments Analysis
Tristin Yun
This exported R Markdown file demonstrating the complete pipeline for processing and visualizing heart-rate data from Yuja Wang’s Rachmaninoff Marathon performances at Carnegie Hall. The document includes annotated R code, intermediate computations, and detailed figures generated from reconstructed heartbeat time-series, illustrating the quantitative methods used to analyze performer–audience physiological synchrony.
Import data and create functions:
# Function to calculate RR intervals
calculate_rr_intervals <- function(bpm_data) {
return(as.numeric(60000 / bpm_data))
}
# Function to calculate SDRR
calculate_sdrr <- function(rr_intervals) {
return(sd(rr_intervals))
}
# Function to calculate RMSSD
calculate_rmssd <- function(rr_intervals) {
diffs <- diff(rr_intervals)
squared_diffs <- diffs^2
mean_squared_diffs <- mean(squared_diffs)
return(sqrt(mean_squared_diffs))
}
# Calculate RR intervals and mean heart beat
R2M1_yuja_rr <- calculate_rr_intervals(R2M1_both_Yuja_data$y);R2M1_yuja_rr<-data.frame(RR=R2M1_yuja_rr,Piece="R2M1");
R2M1_yannick_rr <- calculate_rr_intervals(R2M1_both_Yannick_data$y);R2M1_yannick_rr<-data.frame(RR=R2M1_yannick_rr,Piece="R2M1")
R2M1_yuja_mean <-mean(R2M1_both_Yuja_data$y);
R2M1_both_Yuja_data<-as.data.frame(R2M1_both_Yuja_data); R2M1_both_Yuja_data$Piece<-"R2M1"
R2M1_yannick_mean <-mean(R2M1_both_Yannick_data$y);
R2M1_both_Yannick_data<-as.data.frame(R2M1_both_Yannick_data); R2M1_both_Yannick_data$Piece<-"R2M1"
# Calculate SDRR
R2M1_yuja_sdrr <- calculate_sdrr(R2M1_yuja_rr[,1])
R2M1_yannick_sdrr <- calculate_sdrr(R2M1_yannick_rr[,1])
# Calculate RMSSD
R2M1_yuja_rmssd <- calculate_rmssd(as.numeric(R2M1_yuja_rr[,1]))
R2M1_yannick_rmssd <- calculate_rmssd(as.numeric(R2M1_yannick_rr[,1]))
# Calculate RR intervals for R1M2
R1M2_yuja_rr <- calculate_rr_intervals(R1M2_both_Yuja_data$y); R1M2_yuja_rr<-data.frame(RR=R1M2_yuja_rr,Piece="R1M2")
R1M2_yannick_rr <- calculate_rr_intervals(R1M2_both_Yannick_data$y); R1M2_yannick_rr<-data.frame(RR=R1M2_yannick_rr,Piece="R1M2")
R1M2_yuja_mean <-mean(R1M2_both_Yuja_data$y); R1M2_both_Yuja_data<-as.data.frame(R1M2_both_Yuja_data); R1M2_both_Yuja_data$Piece<-"R1M2"
R1M2_yannick_mean <-mean(R1M2_both_Yannick_data$y)
R1M2_both_Yannick_data<-as.data.frame(R1M2_both_Yannick_data); R1M2_both_Yannick_data$Piece<-"R1M2"
# Calculate SDRR for R1M2
R1M2_yuja_sdrr <- calculate_sdrr(R1M2_yuja_rr[,1])
R1M2_yannick_sdrr <- calculate_sdrr(R1M2_yannick_rr[,1])
# Calculate RMSSD for R1M2
R1M2_yuja_rmssd <- calculate_rmssd(as.numeric(R1M2_yuja_rr[,1]))
R1M2_yannick_rmssd <- calculate_rmssd(as.numeric(R1M2_yannick_rr[,1]))
# Calculate RR intervals for R4M1
R4M1_yuja_rr <- calculate_rr_intervals(R4M1_both_Yuja_data$y); R4M1_yuja_rr<-data.frame(RR=R4M1_yuja_rr,Piece="R4M1")
R4M1_yannick_rr <- calculate_rr_intervals(R4M1_both_Yannick_data$y); R4M1_yannick_rr<-data.frame(RR=R4M1_yannick_rr,Piece="R4M1")
R4M1_yuja_mean <-mean(R4M1_both_Yuja_data$y)
R4M1_both_Yuja_data<-as.data.frame(R4M1_both_Yuja_data); R4M1_both_Yuja_data$Piece<-"R4M1"
R4M1_yannick_mean <-mean(R4M1_both_Yannick_data$y)
R4M1_both_Yannick_data<-as.data.frame(R4M1_both_Yannick_data); R4M1_both_Yannick_data$Piece<-"R4M1"
# Calculate SDRR for R4M1
R4M1_yuja_sdrr <- calculate_sdrr(R4M1_yuja_rr[,1])
R4M1_yannick_sdrr <- calculate_sdrr(R4M1_yannick_rr[,1])
# Calculate RMSSD for R4M1
R4M1_yuja_rmssd <- calculate_rmssd(as.numeric(R4M1_yuja_rr[,1]))
R4M1_yannick_rmssd <- calculate_rmssd(as.numeric(R4M1_yannick_rr[,1]))
# Calculate RR intervals for RH
RH_yuja_rr <- calculate_rr_intervals(RH_both_Yuja_data$y); RH_yuja_rr<-data.frame(RR=RH_yuja_rr, Piece="Rhapsody")
RH_yannick_rr <- calculate_rr_intervals(RH_both_Yannick_data$y); RH_yannick_rr <- data.frame(RR=RH_yannick_rr, Piece="Rhapsody")
RH_yuja_mean <-mean(RH_both_Yuja_data$y)
RH_both_Yuja_data<-as.data.frame(RH_both_Yuja_data); RH_both_Yuja_data$Piece<-"Rhapsody"
RH_yannick_mean <-mean(RH_both_Yannick_data$y)
RH_both_Yannick_data<-as.data.frame(RH_both_Yannick_data); RH_both_Yannick_data$Piece<-"Rhapsody"
# Calculate SDRR for RH
RH_yuja_sdrr <- calculate_sdrr(RH_yuja_rr[,1])
RH_yannick_sdrr <- calculate_sdrr(RH_yannick_rr[,1])
# Calculate RMSSD for RH
RH_yuja_rmssd <- calculate_rmssd(as.numeric(RH_yuja_rr[,1]))
RH_yannick_rmssd <- calculate_rmssd(as.numeric(RH_yannick_rr[,1]))
# Calculate RR intervals for R3
R3_yuja_rr <- calculate_rr_intervals(R3_both_Yuja_data$y); R3_yuja_rr<-data.frame(RR=R3_yuja_rr, Piece= "R3M3")
R3_yannick_rr <- calculate_rr_intervals(R3_both_Yannick_data$y); R3_yannick_rr<-data.frame(RR=R3_yannick_rr, Piece="R3M3")
R3_yuja_mean <-mean(R3_both_Yuja_data$y)
R3_both_Yuja_data<-as.data.frame(R3_both_Yuja_data); R3_both_Yuja_data$Piece<-"R3M3"
R3_yannick_mean <-mean(R3_both_Yannick_data$y)
R3_both_Yannick_data<-as.data.frame(R3_both_Yannick_data); R3_both_Yannick_data$Piece<-"R3M3"
# Calculate SDRR for R3
R3_yuja_sdrr <- calculate_sdrr(R3_yuja_rr[,1])
R3_yannick_sdrr <- calculate_sdrr(R3_yannick_rr[,1])
# Calculate RMSSD for R3
R3_yuja_rmssd <- calculate_rmssd(as.numeric(R3_yuja_rr[,1]))
R3_yannick_rmssd <- calculate_rmssd(as.numeric(R3_yannick_rr[,1]))1 Visualize Heartbeat Data:
Yuja interview: Less familiar with R4 (practice 1-1.5 hours before concerts) and R1. Experienced with R3 (practice 10 minutes). ‘Bored’ by R2.
Yuja2<-rbind(R2M1_both_Yuja_data,R1M2_both_Yuja_data,R3_both_Yuja_data,R4M1_both_Yuja_data,RH_both_Yuja_data); Yuja2$Performer="Pianist"
Yannick2<-rbind(R2M1_both_Yannick_data,R1M2_both_Yannick_data,R3_both_Yannick_data,R4M1_both_Yannick_data,RH_both_Yannick_data); Yannick2$Performer="Conductor"
all2<-rbind(Yuja2,Yannick2)
# pirateplot(y~Piece+Performer,data=all2,ylab="Beats Per Minute (BPM)", main ="Heartbeat by Pieces",xlab="Piece",theme=2,bean.b.o = .2,avg.line.o = 0,
# point.col = "black", bar.f.o = .5, bean.f.o = .4, point.o = .2,
# point.cex = .2,inf.f.col = "white",
# inf.b.o = .8)Interpretation of findings:
For concertos No. 1 and 3, the pianist exhibits a higher average heart rate than the conductor. This suggests that playing Rachmaninoff’s piano concertos is more physically and emotionally demanding for the pianist than it is for the conductor. Pianists often engage in rapid, powerful movements across the keyboard, which likely contributes to a higher heart rate.
Concerto No. 1, movement 2 is a slower piece. On average, conductor’s heart beat is slower similar to a warm up state before doing exercise. However, Yuja’s heart beat is still similar to moderate level of work out (110 BPM) due to unfamiliarity and emotional demand on the pianist.
For concerto No. 2, Yuja’s interview mentioned that she was very familiar with this piece and only spends 10 minutes practicing before concerts, while she might spend 1.5 hours for Rach 1 or Rach 4. Thus, Yuja’s heart beat is even slower than the conductor.
Concerto No. 3 is the most technical demanding. Both Yuja and conductor’s heart beats are fast (similar to moderate physical activity). This could be due to the intense technical demands particularly in this piece’s compositions, which are known for their complex passages and emotional depth.
Concerto No. 4 is intense and melancholic. Both Yuja and conductor’s heart beats are close to engaging in moderate physical activities.
Interpretation of average BPM:
80-100: moderate physical activity (brisk walking, light exercise)
100-130: more intense physical activity (jogging, steady cycling)
suppressWarnings(all3<-all2[all2$Piece==c("R1M2","R2M1","R3M3", "R4M1"),])
#all3<-mutate(all3, Piece= recode(Piece, "R1M2"="1","R2M1"="2", "R3M3"="3"))
all3<-mutate(all3, Piece= recode(Piece, "R1M2"="Concerto 1, Movement 2", "R2M1"="Concerto 2, Movement 1", "R3M3"="Concerto 3, Movement 3", "R4M1"="Concerto 4, Movement 1"))
all3<- all3 %>%
rename(
"Person" = "Performer",
)
#temp<-c(80,110,100,92,103,112,105,107)
#my_gradient <- colorRampPalette(c("lightblue","blue" ,"yellow","red"))
#colors_vector <- my_gradient(200)[as.numeric(cut(temp, breaks = 200))]
rose <- rgb(255, 80, 100, maxColorValue = 255);darker_red <- rgb(230, 0, 0, maxColorValue = 255);lighter_blue <- rgb(70, 130, 255, maxColorValue = 255);lighter_blue2 <- rgb(50, 110, 240, maxColorValue = 255)
colors_vector=c("skyblue","red", lighter_blue,"pink" , lighter_blue2, darker_red , "blue",rose )
png("Heartbeat_by_Piece_pirate.png", width = 2400, height = 1400, res = 300)
pirateplot(y~Person+Piece,data=all3,ylab="BPM (beats per minute)", main ="Heartbeat by Rachmaninoff Pieces", xlab="Piece",theme=2,bean.b.o = .2,avg.line.o = 0,point.col = "black", bar.f.o = 0.9, bean.f.o = .4, point.o = .2, point.cex = .3, inf.f.col = "gray", inf.b.o = .8, pal = colors_vector,quant = c(.25, .75),quant.lwd=2)
dev.off()## quartz_off_screen
## 2#xmen
#axis(2, at = c(60, 80), labels = c("High", "Low"))
Music for each piece
2 Heart Rate Variability Analysis:
Heart rate variability (HRV): the fluctuation in the time intervals between adjacent heartbeats.
Interpreation of HRV: “HRV reflects regulation of autonomic balance, blood pressure (BP), gas exchange, gut, heart, and vascular tone, which refers to the diameter of the blood vessels that regulate BP, and possibly facial muscles.”
Statistics measuring HRV:
RR intervals: time intervals between adjacent heart beats; RR=60000/BPM in milliseconds.
SDRR: the standard deviation of RR intervals. SDRR measures the variability of IBIs.
Higher SDRR indicates lower stress levels.
Reference: https://www.ncbi.nlm.nih.gov/pmc/articles/PMC5624990/pdf/fpubh-05-00258.pdf
2.1 Visualize R-R Interval Data:
Yuja1<-rbind(R2M1_yuja_rr,R1M2_yuja_rr,R3_yuja_rr,R4M1_yuja_rr); Yuja1$Performer="Pianist"
Yannick1<-rbind(R2M1_yannick_rr,R1M2_yannick_rr,R3_yannick_rr,R4M1_yannick_rr); Yannick1$Performer="Conductor"
all1<-rbind(Yuja1,Yannick1)
all1$Person<-all1$Performer
all1<-mutate(all1, Piece= recode(Piece, "R1M2"="Concerto 1, Movement 2", "R2M1"="Concerto 2, Movement 1", "R3M3"="Concerto 3, Movement 3", "R4M1"="Concerto 4, Movement 1"))
darker_skyblue <- rgb(100, 180, 210, maxColorValue = 255); darker_skyblue2 <- rgb(80, 160, 190, maxColorValue = 255)
colors_vector=c("blue","pink", darker_skyblue2,"red" , darker_skyblue,"pink" , "skyblue",rose )
pirateplot(RR~Person+Piece,data=all1,ylab="R-R intervals", main ="RR Intervals by Pieces",xlab="Piece",theme=2,bean.b.o = .2,avg.line.o = 0,
point.col = "black", bar.f.o = .9, bean.f.o = .4, point.o = .2,
point.cex = .2,inf.f.col = "white", pal=colors_vector,
inf.b.o = .8)
2.2 HRV Analysis Results:
Yuja interview: Less familiar with R4 (practice 1-1.5 hours before concerts) and R1. Experienced with R3 (practice 10 minutes). ‘Bored’ by R2.
# # rmssd <- data.frame(
# # Piece = c(rep("R1M2", 2), rep("R2M1", 2), rep("R3M3", 2), rep("R4M1", 2), rep("Rhapsody", 2)),
# # Performer = rep(c("Pianist", "Conductor"), 5),
# # rmssd = c(
# # R1M2_yuja_rmssd, R1M2_yannick_rmssd,
# # R2M1_yuja_rmssd, R2M1_yannick_rmssd,
# # R3_yuja_rmssd, R3_yannick_rmssd,
# # R4M1_yuja_rmssd, R4M1_yannick_rmssd,
# # RH_yuja_rmssd, RH_yannick_rmssd
# # )
# # )
# # rmssd$stat<-"RMSSD"
#
# # ggplot(rmssd, aes(x = Performer, y = rmssd, fill = Piece)) +
# # geom_bar(stat = "identity", position = position_dodge(width = 0.7), width = 0.7) +
# # geom_text(aes(label = round(rmssd, 1)),
# # position = position_dodge(width = 0.7), vjust = -0.3,
# # color = "black", size = 3.5) +
# # labs(title = "Root Mean Square of Successive RR Intervals (RMSSD)",
# # x = "Performer",
# # y = "RMSSD",
# # fill = "Piece") +theme_minimal()+theme(plot.title = element_text(hjust = 0.5))+
# # theme(legend.position = "bottom")+
# # scale_fill_brewer(palette = "Pastel1")3 Correlation Analysis of Rach3 Cadenza
We are interested in this to examine whether the pianist can move the audience without the orchestra.
3.1 Visualize Heartbeat Data for All Individuals
**Original data from the Carnegie experiment:
Rach 3 Cadenza music
Rach 3 Cadenza original data
Extracted data: cadenza starts at around \(t=0.35\).
R3_all_Yuja_data <- read_csv("detailed/data/R3 cadenza_Yuja_data.csv",show_col_types = FALSE)
R3_all_Yannick_data <- read_csv("detailed/data/R3 cadenza_Yannick_data.csv",show_col_types = FALSE)
R3_all_Audience_data <- read_csv("detailed/data/R3 cadenza_Audience_data.csv",show_col_types = FALSE)
R3_all_Orchestra_data <- read_csv("detailed/data/R3 cadenza_Orchestra_data.csv",show_col_types = FALSE)
R3_all_Yuja_data$x <- round(R3_all_Yuja_data$x, 4)
R3_all_Yannick_data$x <- round(R3_all_Yannick_data$x, 4)
R3_all_Audience_data$x <- round(R3_all_Audience_data$x, 4)
R3_all_Orchestra_data$x <- round(R3_all_Orchestra_data$x, 4)
suppressWarnings(aligned_data <- reduce(list(R3_all_Yuja_data, R3_all_Yannick_data, R3_all_Audience_data, R3_all_Orchestra_data),
~ full_join(.x, .y, by = "x", suffix = c("_left", "_right"))))
# If you want to avoid adding suffixes repeatedly for similar column names (like 'y'), consider renaming them beforehand or handling them after merging
# For instance, renaming 'y' to be unique per dataset before merging might look like this:
names(R3_all_Yuja_data)[names(R3_all_Yuja_data) == "y"] <- "y_yuja"
names(R3_all_Yannick_data)[names(R3_all_Yannick_data) == "y"] <- "y_yannick"
names(R3_all_Audience_data)[names(R3_all_Audience_data) == "y"] <- "y_audience"
names(R3_all_Orchestra_data)[names(R3_all_Orchestra_data) == "y"] <- "y_orchestra"
# Re-attempting the merge with renamed columns
suppressWarnings(aligned_data <- reduce(list(R3_all_Yuja_data, R3_all_Yannick_data, R3_all_Audience_data, R3_all_Orchestra_data),
~ full_join(.x, .y, by = "x")))
#png("Project1_ReconstructedHeartbeat.png", width = 1600, height = 1200, res = 200)
plot(R3_all_Yuja_data$x,R3_all_Yuja_data$y_yuja,type="S",ylim=c(60,130),xlab="Time", ylab="BPM (Beats Per Minute)", main="Extracted Heartbeat Data in Concerto No. 3 Candenza",lwd=1.5,col="red3")
legend(x = "top",c("Yuja","Conductor","Orchestra","Audience"),col=c("red3","blue","green3","yellow3"),lty=1,horiz=TRUE,bty = "n",cex=0.75,lwd=1.5,bg="lightyellow")
lines(R3_all_Yannick_data$x,R3_all_Yannick_data$y_yannick,type="S",col="blue",lwd=1.5)
lines(R3_all_Orchestra_data$x,R3_all_Orchestra_data$y_orchestra,type="S",col="green3",lwd=1.5)
lines(R3_all_Audience_data$x,R3_all_Audience_data$y_audience,type="S",col="yellow3",lwd=1.5)
abline(lty=2,v=0.35); abline(lty=2,v=0.675)
#dev.off()
## ---- styling choices ----------------------------------------------------
# Colorblind-safe Okabe–Ito palette
col_yuja <- "red3" # reddish
col_cond <- "blue" # blue
col_orch <- "green3" # green
col_aud <- "yellow3" # yellow (darker than base 'yellow3')
cad_line_col <- "#7F7F7F"
# Export (optional): crisp PNG for SlideRoom
png("P1_04_ReconstructedHeartbeat.png", width = 1800, height = 1200, res = 220)
par(mar = c(4.8, 5.2, 5.2, 1.2), cex.axis = 1.1, cex.lab = 1.25, cex.main = 1.4, family = "sans")
## ---- main plot ----------------------------------------------------------
plot(R3_all_Yuja_data$x, R3_all_Yuja_data$y_yuja,
type = "s", lwd = 2.2, col = col_yuja, xlim = c(0, 1.01),
ylim = c(60, 130), xaxs = "i", yaxs = "i",
xlab = "Time (normalized within cadenza)",
ylab = "BPM (beats per minute)",
main = "Reconstructed Heartbeat in Concerto No. 3 – Cadenza")
grid(col = "#E6E6E6", lty = 1) # light grid for readability (drawn under lines)
# Add the other series
lines(R3_all_Yannick_data$x, R3_all_Yannick_data$y_yannick, type = "s", col = col_cond, lwd = 2.2)
lines(R3_all_Orchestra_data$x, R3_all_Orchestra_data$y_orchestra, type = "s", col = col_orch, lwd = 2.2)
lines(R3_all_Audience_data$x, R3_all_Audience_data$y_audience, type = "s", col = col_aud, lwd = 2.2)
## ---- legend -------------------------------------------------------------
legend("top", inset = 0.01,
legend = c("Yuja (pianist)", "Conductor", "Orchestra", "Audience"),
col = c(col_yuja, col_cond, col_orch, col_aud),
lty = 1, lwd = 2.2, bty = "n", horiz = TRUE, xpd = TRUE, cex = 1.05)
## ---- subtitle / caption (optional) --------------------------------------
mtext("Time series reconstructed from video",
side = 3, line = 0.1, adj = 0, cex = 1.05, col = "#666666")
dev.off() # remove if you didn't open the PNG device## quartz_off_screen
## 2par(mfrow=c(2,2),oma=c(0,0,1,0),mar = c(2, 5, 2, 2))
hist(R3_all_Yuja_data$y_yuja,breaks=20,xlim=c(60,130),main="Pianist",xlab="bpm",cex.main=1,col="red",freq=T,border=F)
hist(R3_all_Yannick_data$y_yannick,breaks=35,xlim=c(60,130),main="Conductor",xlab="bpm",cex.main=1,col="blue",freq=T,border=F)
hist(R3_all_Orchestra_data$y_orchestra,breaks=10,xlim=c(60,130),main="Orchestra",xlab="bpm",cex.main=1,col="orange",border=F,freq=T)
hist(R3_all_Audience_data$y_audience,breaks=10,xlim=c(60,130),main="Audience",xlab="bpm",cex.main=1,col="green",border=F,freq=T)
title("Distribution of Heartbeat Data (BPM)",line=0, outer=TRUE, cex=2)
3.2 Correlation Matrix for the Candenza
At the initial Cadenza, the pianist’s heart rate goes up and the conductor’s heart rate decreases since the orchestra does not play. Start correlation analysis from when the conductor’s heart rate stabilizes.
#aligned data from row 574 to 1916 is the real cadenza
aligned_data<-aligned_data[1:1916,]
colnames(aligned_data)<-c("Time","Pianist","Conductor","Audience","Orchestra")
pre_caden<-aligned_data[1:573,2:5]
caden1<-aligned_data[574:1245,2:5];caden2<-aligned_data[1246:1916,2:5]
#plot(caden2$y_yuja,ylim=c(60,130),type="l",col="red");lines(caden2$y_yannick,type="l")
#selected_data <- aligned_data[243:1296, c("y_yuja", "y_yannick", "y_audience", "y_orchestra")]
corr_pre<- cor(pre_caden, use = "pairwise.complete.obs")
corr_cad1<- cor(caden1[,], use = "pairwise.complete.obs")
corr_cad2<- cor(caden2[,], use = "pairwise.complete.obs")
# corrplot(corr_pre, method = "square", type = "full", order = "original",
# tl.col = "black", tl.srt = 45,
# addCoef.col = "black", # Add correlation coefficients
# col = colorRampPalette(c("#6D9EC1", "white", "#E46726"))(200)) # Color
suppressWarnings(p1<-ggcorrplot(corr_pre[,4:1],
hc.order = F, # Order variables by hierarchical clustering
type = "full", # Show only the lower triangle
lab = TRUE, # Show correlation coefficients
lab_size = 4, # Adjust label size
method = "square",# Use circles to represent correlations
#colors = c( "#D4F3B7", "white", "#FFB6C1"),
title = " Before Candenza", # Add a title
ggtheme = theme_minimal())
+scale_fill_gradient2(
low = "#D4F3B7", mid = "white", high = "#ff8096", midpoint = 0.3, #FFB6C1
limits = c(-1, 1) # Set color scale limits to actual correlation range
))## Scale for fill is already present.
## Adding another scale for fill, which will replace the existing scale.suppressWarnings(p2<-ggcorrplot(corr_cad1[,4:1],
hc.order = F, # Order variables by hierarchical clustering
type = "full", # Show only the lower triangle
lab = TRUE, # Show correlation coefficients
lab_size = 4, # Adjust label size
method = "square",# Use circles to represent correlations
title = " Cadenza: first half", # Add a title
ggtheme = theme_minimal())
+scale_fill_gradient2(
low = "#D4F3B7", mid = "white", high = "#ff8096", midpoint = 0.3,
limits = c(-1, 1) # Set color scale limits to actual correlation range
))## Scale for fill is already present.
## Adding another scale for fill, which will replace the existing scale.suppressWarnings(p3<-ggcorrplot(corr_cad2[,4:1],
hc.order = F, # Order variables by hierarchical clustering
type = "full", # Show only the lower triangle
lab = TRUE, # Show correlation coefficients
lab_size = 4, # Adjust label size
method = "square",# Use circles to represent correlations
#colors = c( "#D4F3B7", "white", "#FFB6C1"),
title = " Cadenza: second half", # Add a title
ggtheme = theme_minimal())
+scale_fill_gradient2(
low = "#D4F3B7", mid = "white", high = "#ff8096", midpoint = 0.3,
limits = c(-1, 1) # Set color scale limits to actual correlation range
))## Scale for fill is already present.
## Adding another scale for fill, which will replace the existing scale.title <- ggdraw() + draw_label("Correlation Between All Individuals", fontface = 'bold');
suppressWarnings(legend <- get_legend(p1))
combined_plot <- plot_grid(
plot_grid(p1 + theme(legend.position = "none"),
p2 + theme(legend.position = "none"),
p3 + theme(legend.position = "none"),
ncol = 3),
legend,
rel_widths = c(3, 0.25), align = "v"
)
combined_plot
# par(mfrow=c(1,3))
# colors <- colorRampPalette(c("lightblue", "white", "blue"))(200)
# corrplot(corr_pre, method = 'color', col = colors, cl.length = 21, order = 'original',addCoef.col = 'black',number.cex=1,tl.srt = 45)
# corrplot(corr_cad1, method = 'color', col = colors, cl.length = 21, order = 'original',addCoef.col = 'black',number.cex=1,tl.srt = 45)
# corrplot(corr_cad2, method = 'color', col = colors, cl.length = 21, order = 'original',addCoef.col = 'black',number.cex=1,tl.srt = 45)
#+ scale_fill_gradientn(colors=c("red","Orange","white","lightgreen","skyblue") # Apply a minimal theme
variable_pairs <- list(c("Pianist", "Conductor"), c("Pianist", "Audience"), c("Pianist", "Orchestra"))
# Function to calculate and print correlation and confidence interval
print_correlation <- function(var1, var2, data) {
test_result <- cor.test(data[[var1]], data[[var2]])
cat("Correlation between", var1, "and", var2, ":")
cat(" r=", test_result$estimate, ", ")
cat(" 95% Confidence Interval:", test_result$conf.int[1], "-", test_result$conf.int[2], ", ")
cat(" p-value:", test_result$p.value, "\n")
}
# print("Pre-cadenze")
# for (pair in variable_pairs) {
# print_correlation(pair[1], pair[2], caden2)
# }Correlation by time:
| Pair | Time | Correlation (95% CI) |
|---|---|---|
| Pianist and Conductor | Pre-cadenza | 0.18 (0.09, 0.26) |
| Cadenza 1 | -0.74 (-0.77, -0.70) | |
| Cadenza 2 | 0.80 (0.77, 0.83) | |
| Pianist and Audience | Pre-cadenza | 0.43 (0.35, 0.49) |
| Cadenza 1 | 0.88 (0.86, 0.90) | |
| Cadenza 2 | 0.91 (0.89, 0.92) | |
| Pianist and Orchestra | Pre-cadenza | 0.74 (0.69, 0.79) |
| Cadenza 1 | 0.78 (0.75, 0.81) | |
| Cadenza 2 | 0.76 (0.72, 0.79) |
#Hierarchical clustering of all time points data on all subjects:
temp<-cbind(pre_caden[,],caden1[1:573,],caden2[1:573,])
colnames(temp)<-c("Pianist1","Conductor1","Audience1","Orchestra1","Pianist2","Conductor2","Audience2","Orchestra2","Pianist3","Conductor3","Audience3","Orchestra3")
corr_temp<-cor(temp,use="complete.obs");
corrplot(corr_temp)
ggcorrplot(corr_temp,
hc.order = F, # Order variables by hierarchical clustering
type = "full", # Show only the lower triangle
lab = TRUE, # Show correlation coefficients
lab_size = 2, # Adjust label size
method = "square",# Use circles to represent correlations
colors = viridis(3), # Custom color scale
title = "Correlation between individuals and three time points (Pre-cadenza, Cadenza first-half, Cadenza second-half)") # Apply a minimal theme
colors <- colorRampPalette(c("lightblue", "white", "darkblue"))(200)
corrplot(corr_temp, method = 'color', col = colors, cl.length = 21, order = 'original',addCoef.col = 'black',number.cex=0.6,tl.srt = 45)3.3 Correlation for Other Movements
R2M1_both_Yuja_data$x <- round(R2M1_both_Yuja_data$x, 4)
R2M1_both_Yannick_data$x <- round(R2M1_both_Yannick_data$x, 4)
R2M1_data <- full_join(R2M1_both_Yuja_data, R2M1_both_Yannick_data, by = "x", suffix = c("_yuja", "_yannick"))
correlation_R2M1 <- cor(R2M1_data$y_yuja, R2M1_data$y_yannick, use = "complete.obs")Correlation between Yuja and Yannick in R2M1: 0.8190755
R1M2_both_Yuja_data$x <- round(R1M2_both_Yuja_data$x, 4)
R1M2_both_Yannick_data$x <- round(R1M2_both_Yannick_data$x, 4)
R1M2_data <- full_join(R1M2_both_Yuja_data, R1M2_both_Yannick_data, by = "x", suffix = c("_yuja", "_yannick"))
correlation_R1M2 <- cor(R1M2_data$y_yuja, R1M2_data$y_yannick, use = "complete.obs")Correlation between Yuja and Yannick in R1M2: 0.4054068
R4M1_both_Yuja_data$x <- round(R4M1_both_Yuja_data$x, 4)
R4M1_both_Yannick_data$x <- round(R4M1_both_Yannick_data$x, 4)
R4M1_data <- full_join(R4M1_both_Yuja_data, R4M1_both_Yannick_data, by = "x", suffix = c("_yuja", "_yannick"))
correlation_R4M1 <- cor(R4M1_data$y_yuja, R4M1_data$y_yannick, use = "complete.obs")Correlation between Yuja and Yannick in R4M1: 0.1863587
RH_both_Yuja_data$x <- round(RH_both_Yuja_data$x, 4)
RH_both_Yannick_data$x <- round(RH_both_Yannick_data$x, 4)
RH_data <- full_join(RH_both_Yuja_data, RH_both_Yannick_data, by = "x", suffix = c("_yuja", "_yannick"))
correlation_RH <- cor(RH_data$y_yuja, RH_data$y_yannick, use = "complete.obs")Correlation between Yuja and Yannick in RH Var19-24: 0.3639269
R3_both_Yuja_data$x <- round(R3_both_Yuja_data$x, 4)
R3_both_Yannick_data$x <- round(R3_both_Yannick_data$x, 4)
R3_data <- full_join(R3_both_Yuja_data, R3_both_Yannick_data, by = "x", suffix = c("_yuja", "_yannick"))
correlation_R3 <- cor(R3_data$y_yuja, R3_data$y_yannick, use = "complete.obs")