###Analysis manuscript "Insight into the dynamics of a long run-out mass movement using single-grain feldspar luminescence in the Pokhara valley, Nepal"###
### by Anna-Maartje de Boer, Wageningen University & Research, 22/05/2023###

###Preparation: clear environment and set working directory
rm(list = ls())
#Replace XXX with the path to your working directory throughout the script; make sure that the excel file
#called "deboer_etal_luminescence_data.xlsx" is located in that particular map on your computer drive.
setwd("XXX") 

###load and check necessary packages
install.packages("Luminescence")
library("Luminescence")
install.packages("ggplot2")
library("ggplot2")
install.packages("ggrepel")
library("ggrepel")
install.packages("ggpmisc")
library("ggpmisc")
install.packages("xlsx")
library("xlsx")
install.packages("dplyr")
library("dplyr")
install.packages("writexl")
library("writexl")

###Data upload and preparation
library("readxl")
DE_IR50 <- read_excel("XXX/deboer_etal_luminescence_data.xlsx", sheet=5)
DE_pIRIR150 <- read_excel("XXX/deboer_etal_luminescence_data.xlsx", sheet=6)
DE <- rbind(DE_IR50, DE_pIRIR150)
sat <- read_excel("XXX/deboer_etal_luminescence_data.xlsx", sheet=8)
mamrange <- read_excel("XXX/deboer_etal_luminescence_data.xlsx", sheet=9)
overdispersion <- read_excel("XXX/deboer_etal_luminescence_data.xlsx", sheet=7)
othergrains <- read_excel("XXX/deboer_etal_luminescence_data.xlsx", sheet=10)
proxies <- read_excel("XXX/deboer_etal_luminescence_data.xlsx", sheet = 12)
burialages <- read_excel("XXX/deboer_etal_luminescence_data.xlsx", sheet=11)
sample_names <- c("NCL-7619124", "NCL-7619122", " NCL-7619109", "NCL-7619123", "NCL-7619111", "NCL-7619125", "NCL-7619112", "NCL-7619110", "NCL-7619121", "NCL-7619120")
LabelMat <- matrix(sample_names)

###Run the bootstrapped Minimum Age Model (bootMAM) for the IRSL50 data; save the results in a .csv file
MAM_sum_IR50 <- data.frame()
for (i in 1:10) {
  data_subset <- subset(DE_IR50, DE_IR50$Pos == i)
  MAM_IR50 <- calc_MinDose(cbind(data_subset[,13], data_subset[,14]), sigmab=0.3, bootstrap = TRUE)
  MAM_sum_IR50 <- rbind(MAM_sum_IR50, data.frame(MAM_IR50$summary))}
MAM_sum_IR50 <- cbind(MAM_sum_IR50, sample_names)
write.csv(MAM_sum_IR50,"MAM_IR50.csv", row.names=TRUE)

###Run the bootstrapped Minimum Age Model (bootMAM) for the IRSL50 data; save the results in a .csv file
MAM_sum_pIRIR150 <- data.frame()
for (i in 1:10) {
  data_subset <- subset(DE_pIRIR150, DE_pIRIR150$Pos == i)
  MAM_pIRIR150 <- calc_MinDose(cbind(data_subset[,13], data_subset[,14]), sigmab=0.3, bootstrap = TRUE)
  MAM_sum_pIRIR150 <- rbind(MAM_sum_pIRIR150, data.frame(MAM_pIRIR150$summary))}
MAM_sum_pIRIR150 <- cbind(MAM_sum_pIRIR150, sample_names)
write.csv(MAM_sum_pIRIR150,"MAM_pIRIR150.csv", row.names=TRUE)

###Radial plots
#Plot radial plots for MAM-model - IR50
dev.new()
pdf(file = "MAM_radialplot_IR50.pdf",
    paper = "a4", height = 7.5)
par(mfrow=c(2, 1))
for (i in 1:10) {
  data_subset <- subset(DE_IR50, DE_IR50$Pos == i)
  plot_RadialPlot(cbind(data_subset[,13], data_subset[,14]),
                  line = MAM_sum_IR50[i, 1],
                  line.col = "firebrick2",
                  line.label = paste0(round(MAM_sum_IR50[i, 1]), "\U00B1",
                                      round(MAM_sum_IR50[i, 2]), " Gy"),
                  summary = c("n"),
                  summary.pos = "top",
                  central.value = MAM_sum_IR50[i, 1],
                  zlab = expression(paste(D[e], "[Gy]")),
                  mtext = LabelMat[i], mgp=c(2.5,1,0),
                  plot.ratio=1,
                  rug=TRUE)
  
} 
dev.off()
#Plot radial plots for MAM-model - pIRIR150
dev.new()
pdf(file = "MAM_radialplot_pIRIR150.pdf",
    paper = "a4", height = 7.5)
par(mfrow=c(2, 1))
for (i in 1:10) {
  data_subset <- subset(DE_pIRIR150, DE_pIRIR150$Pos == i)
  plot_RadialPlot(cbind(data_subset[,13], data_subset[,14]),
                  line = MAM_sum_pIRIR150[i, 1],
                  line.col = "firebrick2",
                  line.label = paste0(round(MAM_sum_pIRIR150[i, 1]), "\U00B1",
                                      round(MAM_sum_pIRIR150[i, 2]), " Gy"),
                  summary = c("n"),
                  summary.pos = "top",
                  central.value = MAM_sum_pIRIR150[i, 1],
                  zlab = expression(paste(D[e], "[Gy]")),
                  mtext = LabelMat[i], mgp=c(2.5,1,0),
                  plot.ratio=0.5,
                  rug = TRUE)
  
} 
dev.off()

###Kernel Density Estimation plots
#Plot KDE plots for MAM-model - IR50
dev.new()
pdf(file = "MAM_KDEplot_IR50.pdf",
    paper = "a4", height = 7.5)
par(mfrow=c(1, 1), cex.axis = 1, cex.lab = 1)
for (i in 1:10) {
  data_subset <- subset(DE_IR50, DE_IR50$Pos == i)
  plot_KDE(cbind(data_subset[,13], data_subset[,14]),
           summary = c("n", "mean", "sd.rel", "se.abs"),
           summary.pos = "bottomright",
           #xlim = c(0, 10),
           xlab = NULL,
           cex.axis = 1.5,
           cex.lab = 1.5,
           mean = MAM_sum_IR50[i, 1],
           mtext = LabelMat[i], mgp=c(2.5,1,0))
  mtext(expression('D'['e']*'[Gy]'), side = 1, line = 0.2, at = -12, cex = 1)
}
dev.off()
#Plot KDE plots for MAM-model - pIRIR150
dev.new()
pdf(file = "MAM_KDEplot_pIRIR150.pdf",
    paper = "a4", height = 7.5)
par(mfrow=c(1, 1), cex.axis = 1, cex.lab = 1)
for (i in 1:10) {
  data_subset <- subset(DE_pIRIR150, DE_pIRIR150$Pos == i)
  plot_KDE(cbind(data_subset[,13], data_subset[,14]),
           summary = c("n", "mean", "sd.rel", "se.abs"),
           summary.pos = "bottomright",
           #xlim = c(0, 15),
           xlab = NULL,
           cex.axis = 1.5,
           cex.lab = 1.5,
           mean = MAM_sum_pIRIR150[i, 1],
           mtext = LabelMat[i], mgp=c(2.5,1,0))
  mtext(expression('D'['e']*'[Gy]'), side = 1, line = 0.2, at = -12, cex = 1)
}
dev.off()

### Run the Central age model for the IRSL50 signal
dev.new()
par(mfrow=c(2,1))
pdf(file = "CAM_OD_IR50",
    paper = "a4", height = 7.5)
CAM_sum_all_IR50 <- data.frame()
for (i in 1:10) {
  data_subset <- subset(DE_IR50, DE_IR50$Pos == i)
  CAM_IR50 <- calc_CentralDose(cbind(data_subset[,13], data_subset[,14]),
                               plot=TRUE)
  CAM_sum_all_IR50 <- rbind(CAM_sum_all_IR50, data.frame(CAM_IR50$summary))
} 
CAM_sum_all_IR50 <- cbind(CAM_sum_all_IR50, sample_names)
write.csv(CAM_sum_all_IR50,"CAM_IR50.csv", row.names=TRUE)
dev.off()

### Run the Central age model for the pIRIR150 signal
dev.new()
par(mfrow=c(2,1))
pdf(file = "CAM_OD_pIRIR150",
    paper = "a4", height = 7.5)
CAM_sum_all_pIRIR150 <- data.frame()
for (i in 1:10) {
  data_subset <- subset(DE_pIRIR150, DE_pIRIR150$Pos == i)
  CAM_pIRIR150 <- calc_CentralDose(cbind(data_subset[,13], data_subset[,14]),
                               plot=TRUE)
  CAM_sum_all_pIRIR150 <- rbind(CAM_sum_all_pIRIR150, data.frame(CAM_pIRIR150$summary))
} 
CAM_sum_all_pIRIR150 <- cbind(CAM_sum_all_pIRIR150, sample_names)
write.csv(CAM_sum_all_pIRIR150,"CAM_pIRIR150.csv", row.names=TRUE)
dev.off()

###Bleaching proxies: create bleaching proxy graphs as shown in the manuscript
#Overdispersion vs distance between sample location and apex
par(mfrow=c(1,3))
colors <- c("IRSL-50" = " indianred4", "pIRIR-150" = "burlywood3")
gg1 <- ggplot(overdispersion, aes(x = distance)) +
  geom_point(aes(y = OD_IR50, color = "IRSL-50"), size=4, shape =19, color = "indianred4") +
  geom_pointrange(data=overdispersion, aes(x = distance, y = OD_IR50, ymin=OD_err_IR50_min, ymax=OD_err_IR50_max, color="IRSL-50")) +
  geom_point(aes(y = OD_pIRIR150 , color = "pIRIR-150"), size=4, shape = 17, color = "burlywood3") +
  geom_pointrange(data=overdispersion, aes(x = distance, y = OD_pIRIR150, ymin=OD_err_pIRIR150_min, ymax=OD_err_pIRIR150_max, color="pIRIR-150")) +
  scale_y_continuous(name="Overdispersion [%]", sec.axis = sec_axis(~.*1)) +
  labs(x="Distance between sample location and apex [m]", color="OSL signal") +
  scale_color_manual(values=colors) +
  theme_bw() +
  theme(plot.title=element_text(size=10, face="italic"), 
        axis.text.x=element_text(size=10), 
        axis.text.y=element_text(size=10),
        axis.title.x=element_text(size=11),
        axis.title.y=element_text(size=11),
        legend.position=c(0.9, 0.15),
        legend.title = element_text(face = "italic"),
        legend.background = element_blank(),
        legend.key = element_blank())
plot(gg1)
ggsave("deboer_etal_fig07a.png", plot=gg1)
#Overdispersion vs Equivalent Dose
par(mfrow=c(2,1))
colors <- c("IRSL-50" = " indianred4", "pIRIR-150" = "burlywood3")
gg1 <- ggplot(overdispersion) +
  geom_point(aes(x = de_IR50, y = OD_IR50, color = "IRSL-50"), shape = 19, size=4) +
  geom_pointrange(data=overdispersion, aes(x = de_IR50, y = OD_IR50, ymin=OD_err_IR50_min, ymax=OD_err_IR50_max, color="IRSL-50")) +
  geom_point(aes(x = de_pIRIR150 ,y = OD_pIRIR150, color="pIRIR-150"), shape = 17, size = 4) +
  geom_pointrange(data=overdispersion, aes(x = de_pIRIR150, y = OD_pIRIR150, ymin=OD_err_pIRIR150_min, ymax=OD_err_pIRIR150_max, color="pIRIR-150")) +
  scale_y_continuous(name="Overdispersion [%]") +
  labs(x="Equivalent Dose [Gy]", color="OSL signal") +
  scale_color_manual(values=colors) +
  theme_bw() +
  theme(plot.title=element_text(size=10, face="italic"), 
        axis.text.x=element_text(size=10), 
        axis.text.y=element_text(size=10),
        axis.title.x=element_text(size=11),
        axis.title.y=element_text(size=11),
        legend.position=c(0.9, 0.8),
        legend.title = element_text(face = "italic"),
        legend.background = element_blank(),
        legend.key = element_blank())
plot(gg1)
ggsave("deboer_etal_fig07b.png", plot=gg1)
#Stacked area graph bleaching proxies - IR50 signal
par(mfrow=c(1,3))
gg1 <- ggplot(proxies, aes(x = distance, y = IR50, fill = grains)) +
  geom_area() +
  theme_bw() +
  scale_fill_manual(values = c("indianred4", "burlywood3", "burlywood4")) +
  theme(plot.title=element_text(size=10, face="italic"), 
        axis.text.x=element_text(size=10), 
        axis.text.y=element_text(size=10),
        axis.title.x=element_text(size=12),
        axis.title.y=element_text(size=12),
        legend.position=c(0.83, 0.20),
        legend.title = element_blank(),
        legend.background = element_blank(),
        legend.key = element_rect(fill = "white")) +
  labs(x = "Distance between sample location and apex [m]", y = "Percentage of grains [%]") +
  annotate("text", x = 40000, y = 28, label = "IRSL-50", size = 4)
plot(gg1)
ggsave("deboer_etal_fig08a.png", plot=gg1)
#Stacked area graph bleaching proxies - pIRIR150 signal
par(mfrow=c(1,3))
gg1 <- ggplot(proxies, aes(x = distance, y = pIR150, fill = grains)) +
  geom_area() +
  theme_bw() +
  scale_fill_manual(values = c("indianred4", "burlywood3", "burlywood4")) +
  theme(plot.title=element_text(size=10, face="italic"), 
        axis.text.x=element_text(size=10), 
        axis.text.y=element_text(size=10),
        axis.title.x=element_text(size=12),
        axis.title.y=element_text(size=12),
        legend.position=c(0.83, 0.20),
        legend.title = element_blank(),
        legend.background = element_blank(),
        legend.key = element_rect(fill = "white")) +
  labs(x = "Distance between sample location and apex [m]", y = "Percentage of grains [%]") +
  annotate("text", x = 40500, y = 28, label = "pIRIR-150", size = 4)
plot(gg1)
ggsave("deboer_etal_fig08b.png", plot=gg1)

###Burial ages 
colors <- c("age_IRSL-50" = " indianred4", "age_pIRIR-150" = "burlywood4", "fadingcorr_age_IRSL-50" ="indianred3", "fadingcorr_age_pIRIR-150" = "burlywood3")
gg1 <- ggplot() +
  geom_point(data = burialages, aes(x=distance, y=age_IR50...6, color="age_IRSL-50"), size=3.5, shape = 19) +
  geom_pointrange(data = burialages, aes(x = distance, y = age_IR50...6, ymin = age_err_IR50_min, ymax = age_err_IR50_max, color="age_IRSL-50")) +
  geom_point(data = burialages, aes(x=distance, y=fadingcorr_age_IR50, color="fadingcorr_age_IRSL-50"), shape = 19, size=3.5) +
  geom_pointrange(data = burialages, aes(x = distance, y = fadingcorr_age_IR50, ymin = fadingcorr_age_error_IR50_min, ymax = fadingcorr_age_error_IR50_max, color="fadingcorr_age_IRSL-50")) +
  geom_point(data = burialages, aes(x=distance, y=age_pIRIR150...18, color="age_pIRIR-150"), size=3.5, shape = 17) +
  geom_pointrange(data = burialages, aes(x = distance, y = age_pIRIR150...18, ymin = age_err_pIRIR150_min, ymax = age_err_pIRIR150_max, color="age_pIRIR-150")) +
  geom_point(data = burialages, aes(x=distance, y=fadingcorr_age_pIRIR150, color="fadingcorr_age_pIRIR-150"), shape = 17, size=3.5) +
  geom_pointrange(data = burialages, aes(x = distance, y = fadingcorr_age_pIRIR150, ymin = fadingcorr_age_error_pIRIR150_min, ymax = fadingcorr_age_error_pIRIR150_max, color="fadingcorr_age_pIRIR-150")) +
  scale_y_continuous(sec.axis = sec_axis(~.*1), trans="log10") +
  geom_hline(yintercept=0.893, linetype="dashed", color="grey30", size=0.8) +
  annotate("text", x=41000, y=0.6, label="Radiocarbon age: 0.90 [ka]", size = 3) +
  scale_color_manual(values=colors, labels=c("IRSL-50", "pIRIR-150", "IRSL-50 fading corrected", "pIRIR-150 fading corrected" )) +
  labs(x="Distance between sample location and apex [m]", y = "Burial age [ka]")+
  theme_bw() +
  theme(legend.position="top",
        legend.text=element_text(size=10),
        legend.title = element_blank())
plot(gg1)
ggsave(filename="deboer_etal_fig05.png", plot=gg1, dpi = 300, width = 9, height = 4)

###Calculate faded age for the IRSL50 signal
#NCL-7619109
fading_109 <- calc_FadingCorr(age.faded = c(2.36, 0.42), g_value = c(7.195,0.886666667),
                              tc = 255, tc.g_value = 172800, n.MC = 100)
get_RLum(fading_109)
#NCL-7619110
fading_110 <- calc_FadingCorr(age.faded = c(17.07, 1.35), g_value = c(7.195,0.886666667),
                              tc = 255, tc.g_value = 172800, n.MC = 100)
get_RLum(fading_110)
#NCL-7619111
fading_111 <- calc_FadingCorr(age.faded = c(23.76, NA), g_value = c(7.195,0.886666667),
                              tc = 255, tc.g_value = 172800, n.MC = 100)
get_RLum(fading_111)
#NCL-7619112
fading_112 <- calc_FadingCorr(age.faded = c(20.52, 2.62), g_value = c(7.195,0.886666667),
                              tc = 255, tc.g_value = 172800, n.MC = 100)
get_RLum(fading_112)
#NCL-7619120
fading_120 <- calc_FadingCorr(age.faded = c(6.26, 2.28), g_value = c(7.195,0.886666667),
                              tc = 255, tc.g_value = 172800, n.MC = 100)
get_RLum(fading_120)
#NCL-7619121
fading_121 <- calc_FadingCorr(age.faded = c(18.31, 2.12), g_value = c(7.195,0.886666667),
                              tc = 255, tc.g_value = 172800, n.MC = 100)
get_RLum(fading_121)
#NCL-7619122
fading_122 <- calc_FadingCorr(age.faded = c(9.91, 1.75), g_value = c(7.195,0.886666667),
                              tc = 255, tc.g_value = 172800, n.MC = 100)
get_RLum(fading_122)
#NCL-7619123
fading_123 <- calc_FadingCorr(age.faded = c(1.35, 0.18), g_value = c(7.195,0.886666667),
                              tc = 255, tc.g_value = 172800, n.MC = 100)
get_RLum(fading_123)
#NCL-7619124
fading_124 <- calc_FadingCorr(age.faded = c(82.62, 5.83), g_value = c(7.195,0.886666667),
                              tc = 255, tc.g_value = 172800, n.MC = 100)
get_RLum(fading_124)
#NCL-7619125
fading_125 <- calc_FadingCorr(age.faded = c(4.54, 0.48), g_value = c(7.195,0.886666667),
                              tc = 255, tc.g_value = 172800, n.MC = 100)
get_RLum(fading_125)

###Calculate faded age for the pIRIR150 signal
#NCL-7619109
fading_109 <- calc_FadingCorr(age.faded = c(50.27, 9.28), g_value = c(0.890833333,0.865),
                              tc = 255, tc.g_value = 172800, n.MC = 100)
get_RLum(fading_109)
#NCL-7619110
fading_110 <- calc_FadingCorr(age.faded = c(41.53, 5.47), g_value = c(0.890833333,0.865),
                              tc = 255, tc.g_value = 172800, n.MC = 100)
get_RLum(fading_110)
#NCL-7619111
fading_111 <- calc_FadingCorr(age.faded = c(66.58, 11.30), g_value = c(0.890833333,0.865),
                              tc = 255, tc.g_value = 172800, n.MC = 100)
get_RLum(fading_111)
#NCL-7619112
fading_112 <- calc_FadingCorr(age.faded = c(90.18, 14.42), g_value = c(0.890833333,0.865),
                              tc = 255, tc.g_value = 172800, n.MC = 100)
get_RLum(fading_112)
#NCL-7619120
fading_120 <- calc_FadingCorr(age.faded = c(39.31, 25.63), g_value = c(0.890833333,0.865),
                              tc = 255, tc.g_value = 172800, n.MC = 100)
get_RLum(fading_120)
#NCL-7619121
fading_121 <- calc_FadingCorr(age.faded = c(30.60, 7.82), g_value = c(0.890833333,0.865),
                              tc = 255, tc.g_value = 172800, n.MC = 100)
get_RLum(fading_121)
#NCL-7619122
fading_122 <- calc_FadingCorr(age.faded = c(94.48, 12.77), g_value = c(0.890833333,0.865),
                              tc = 255, tc.g_value = 172800, n.MC = 100)
get_RLum(fading_122)
#NCL-7619123
fading_123 <- calc_FadingCorr(age.faded = c(9.26, 1.72), g_value = c(0.890833333,0.865),
                              tc = 255, tc.g_value = 172800, n.MC = 100)
get_RLum(fading_123)
#NCL-7619124
fading_124 <- calc_FadingCorr(age.faded = c(123.97, 5.87), g_value = c(0.890833333,0.865),
                              tc = 255, tc.g_value = 172800, n.MC = 100)
get_RLum(fading_124)
#NCL-7619125
fading_125 <- calc_FadingCorr(age.faded = c(29.39, 3.70), g_value = c(0.890833333,0.865),
                              tc = 255, tc.g_value = 172800, n.MC = 100)
