# Laden der notwendigen R-packages
library(basictabler)
library(cowplot)
library(data.table)
library(stringr)
library(dplyr)
library(forcats)
library(ggplot2)
library(ggpubr)
library(openxlsx)
library(plyr)
library(tidyverse)Pilotstudie Farchant - Datenkontrolle, -aufbereitung und -auswertung
Basierend auf den Daten des Bruker Tracer 5g No. 900F3980
1 Grundsätzliches
Dieses Quarto Skript (R Quarto v.1.5.55) (Allaire et al. 2024) wurde mit R v. 4.4.0 (R Core Team 2024) und RStudio v. 2024.04.2 (RStudio Team 2024) erstellt. Es werden folgende R-Packages verwendet: basictabler (Bailiss 2021) - cowplot (Wilke 2024) - data.table (Barrett et al. 2024) - dplyr (Wickham et al. 2023) - forcats (Wickham 2023b) - ggplot 2 (Wickham 2016) - ggpubr (Kassambara 2023) - openxlsx (Schauberger and Walker 2023) - plyr (Wickham 2011) - stringr (Wickham 2023a) - tidyverse (Wickham et al. 2019).
Vor Beginn der Analysen müssen sowohl alle Packages (siehe Section 2) geladen als auch die Working directory (siehe Section 3) gesetzt werden.
Der Code ist ‘lauffähig’, d.h. kann fehlerfrei gerechnet werden, so die vorgegebene Datenstruktur beibehalten wird.
Die verwendeten Daten wurden mit dem Bruker Tracer 5g (900F3980) des Departments für Kulturwissenschaften und Altertumskunde der Ludwig-Maximilians-Universität München im MudrockDual-Modus mit 300 Sekunden Messzeit (jeweils 150 Sekunden für Mudrock Major und Trace) und einem 8 mm Kollimator aufgenommen. Die Datenaufnahme erfolgte durch M. Schauer am 26. Januar 2023 (20°C; relative Luftfeuchte 40%). Da es sich um eine Pilotstudie handelt, erfolgte pro Messposition (Oberfläche, Auftrag, alter Bruch etc.) nur eine Messung. Zudem wurde keine Probenaufbereitung durchgeführt, weshalb die erzeugten Daten ausschließlich im qualitativen Sinne zum Ziehen von Vergleichen innerhalb der Messserie verwendet werden können: Sie bieten einen Einblick in das Material und können als Ausgangspunkt für weitere Analysen dienen.
Das hier abgebildete Verfahren der Datenkontrolle folgt grundsätzlich jenem nach Schauer (2/10/2023) bzw. Schauer/Amicone (2024).Da im Rahmen der Untersuchung Einzelmessungen durchgeführt wurden, wird in diesem Falle jedoch die prozentuale relative Messunsicherheit (RU) als Prüfvariable berechnet, wobei der jeweilige Messwert sowie die 2δ-Messunsicherheit als Grundlage dienten. Die angewandte Formel lautet somit RU = (Messwert/Messunsicherheit)*100 (vgl. auch Harris 2007). Dabei darf RU einen Wert von 20 % nicht überschreiten. Zudem darf die Überschreitung des Grenzwertes pro Probe und chemischem Element in maximal 20 % der Fälle erfolgen.
2 Packages
3 Set working directory
knitr::opts_knit$set(root.dir = "./")4 Datenkontrolle
4.1 Standardabweichung
4.1.1 Standardabweichung der Einzelmessungen
Messungen KF28_1, KF266_1 und KF266_2 sind auffällig häufig von zu hohen Messfehlern betroffen.
# Laden der Daten
data<- read.csv("../Daten//Farchant_Bruker_Gesamt.csv")
# Definieren der zur Berechnung zu verwendenden Spalten
variables <- c("Si", "Ti", "Al", "Fe", "Mn", "Mg", "Ca", "K", "P", "S", "V", "Cr", "Co", "Ni", "Cu", "Zn", "As", "Rb", "Sr", "Y", "Zr", "Nb", "Mo", "Ba", "Pb", "Th", "U")
# Identifizieren der Einzelmessungen deren Messwert niedriger ist als +- zugehöriger Messfehler (.Error)
for (variable in variables) {
filter <- data[data[, variable] < 2*data[, paste0(variable, ".Error")], ]
count <- nrow(filter)
assign(paste0("data", variable), filter)
assign(paste0("count", variable), count)
print(paste0("count", variable, ": ", count))}[1] "countSi: 0"
[1] "countTi: 0"
[1] "countAl: 0"
[1] "countFe: 0"
[1] "countMn: 0"
[1] "countMg: 0"
[1] "countCa: 0"
[1] "countK: 0"
[1] "countP: 0"
[1] "countS: 0"
[1] "countV: 2"
[1] "countCr: 3"
[1] "countCo: 2"
[1] "countNi: 0"
[1] "countCu: 3"
[1] "countZn: 0"
[1] "countAs: 7"
[1] "countRb: 0"
[1] "countSr: 0"
[1] "countY: 0"
[1] "countZr: 0"
[1] "countNb: 2"
[1] "countMo: 2"
[1] "countBa: 0"
[1] "countPb: 4"
[1] "countTh: 3"
[1] "countU: 14"
# Erstellen einer Liste relevanter Elemente (max. Anzahl auffällige Messungen = 4)
l = list(dataV,dataCr,dataCo,dataCu,dataNb,dataMo,dataPb,dataTh)
Tab1<-rbindlist(l, use.names=TRUE, fill=TRUE)4.2 Prozentuale relative Messunsicherheit (RU)
4.2.1 Berechnen der RU pro Probe
# Laden der Daten
data1<- read.csv("../Daten//Farchant_Bruker_Gesamt.csv")
# Berechnen des Mittelwertes pro Probe (relevant für die dreifache Standardmessung)
Mean <- data1 %>%
group_by(SAMPLE) %>%
dplyr::summarize(across(everything(), ~mean(.x, na.rm = TRUE), .names = "{.col}"))
# Auswahl der zur Berechnung zu verwendenden Spalten
variables <- colnames(Mean)[17:71]
# Erstellen der Formel zur Berechnung der RU
calculate_RU <- function(variable) {
mean_col <- variable
sd_col <- paste0(variable, ".Error")
if(mean_col %in% colnames(Mean) & sd_col %in% colnames(Mean)) {
return((Mean[[sd_col]] / Mean[[mean_col]]) * 100)
} else {
return(rep(NA, nrow(Mean)))
}
}
# Berechnen der RU für die zuvor definierten Variablen und anhängen dieser Spalten an die Datei Mean
for (variable in variables) {
Mean[[paste0(variable, "_RU")]] <- calculate_RU(variable)
}
# Ersetzen der Informationen NA, INF und RU > 99 mit dem Wert 99
data_RU <- lapply(Mean, function(x) {
x[is.na(x) |is.infinite(x) | x > 99] <- 99
return(x)
})
# Definieren von data_RU als Tabelle
data_RU <- as.data.frame(data_RU)
# Definieren der Spalte SAMPLE der Datei Mean als Variable SAMPLE
SAMPLE<-Mean$SAMPLE
# Zusammenfügen von SAMPLE und data_RU in eine gemeinsame Tabelle
data2<-cbind(SAMPLE,data_RU)
# Auswahl der weiter zu analysierenden Elemente
data_RU<-data2[,c("SAMPLE","Si_RU","Ti_RU","Al_RU","Fe_RU","Mn_RU","Mg_RU","Ca_RU","K_RU","P_RU","S_RU","As_RU","V_RU","Cr_RU","Ni_RU","Cu_RU","Zn_RU","Rb_RU","Sr_RU","Y_RU","Zr_RU","Nb_RU","Ba_RU","Pb_RU")]4.2.2 Erstellen zahlcodierte Tabelle
# Ersetzen aller Werte <=20 mit '0' und >20 mit '1'
Prüfung_RU_0 <- cbind(apply(data_RU[,2:24], 2, function(x) ifelse(x <= 20, 0, x)), data_RU[,1])
Prüfung_RU_0_1 <- cbind(apply(Prüfung_RU_0[,1:23], 2, function(x) ifelse(x > 20, 1, x)), Prüfung_RU_0[,24])
# Definieren von Prüfung_RU_2 als Tabelle, Bennen der Spalte 24 als SAMPLE und definieren aller RU-Werte als Zahl
Prüfung_RU_2 <- as.data.frame(Prüfung_RU_0_1)
names(Prüfung_RU_2)[24] <- "SAMPLE"
Prüfung_RU_2[,1:23] <- sapply(Prüfung_RU_2[,1:23],as.numeric)
# Berechnen der Summe der zu hohen RU pro Zeile (Proben) unter Ausschluß von Elemente mit zu vielen zu hohen RUs
Prüfung_RU_3<-Prüfung_RU_2%>%mutate(Zeilensumme=rowSums(.[, !(names(.) %in% c("SAMPLE","Mg_RU","As_RU","V_RU","Cr_RU","Nb_RU","Ba_RU","Pb_RU"))]))
# Berechnen der Summe zu hohen RU pro Spalte (Elemente)
spaltensummen <- colSums(Prüfung_RU_3[, !colnames(Prüfung_RU_3) %in% "SAMPLE"])
spaltensummen <- c(spaltensummen,0)
Prüfung_RU_4 <- rbind(Prüfung_RU_3,spaltensummen)
# Berechnen des prozentualen Anteils der zu hohen RUs pro Spalte (Elemente)
Zeilenanzahl<-(nrow(Prüfung_RU_4)-1)
Prozent<-(100/Zeilenanzahl*spaltensummen)
Prüfung_RU_5 <- rbind(Prüfung_RU_4,Prozent)
# Berechnen des prozentualen Anteils der zu hohen RUs pro Zeile (Proben)
Zeilensumme<-Prüfung_RU_5$Zeilensumme
Spaltenanzahl<-ncol(Prüfung_RU_5)
Zeilenprozent<-(100/(Spaltenanzahl-9)*Zeilensumme)
Prüfung_RU_6 <- cbind(Prüfung_RU_5,Zeilenprozent)
# Runden aller Zahlenwerte auf ganze Zahlen und sortieren der Tabelle
ganze_Zahlen <- function(x) {if(is.numeric(x)) {return(round(x))} else {
return(x)}}
Prüfung_RU_6 <- as.data.frame(lapply(Prüfung_RU_6,ganze_Zahlen))
Prüfung_RU_6<-Prüfung_RU_6[order(Prüfung_RU_6$Zeilenprozent, decreasing = TRUE),]
# Einfügen der Bezeichnung Spaltensumme und Spaltenprozent in die jeweilig zugehörige Zeile in Spalte SAMPLE
text<-"Spaltensumme"
Prüfung_RU_6[14,24]<-text
text<-"Spaltenprozent"
Prüfung_RU_6[15,24]<-text
# Ausgabe der Berechnungen
Prüfung_RU_6 Si_RU Ti_RU Al_RU Fe_RU Mn_RU Mg_RU Ca_RU K_RU P_RU S_RU As_RU V_RU Cr_RU
13 0 0 0 0 0 1 0 0 1 0 1 0 0
7 0 0 0 0 0 1 0 0 0 0 1 1 1
8 0 0 0 0 0 1 0 0 0 0 1 1 1
10 0 0 0 0 0 0 0 0 0 0 1 1 1
11 0 0 0 0 0 0 0 0 0 0 1 0 0
12 0 0 0 0 0 0 0 0 0 0 1 0 0
1 0 0 0 0 0 1 0 0 0 0 1 1 1
2 0 0 0 0 0 1 0 0 0 0 1 1 0
3 0 0 0 0 0 1 0 0 0 0 0 0 0
4 0 0 0 0 0 1 0 0 0 0 1 0 0
5 0 0 0 0 0 0 0 0 0 0 1 0 0
6 0 0 0 0 0 0 0 0 0 0 1 0 0
9 0 0 0 0 0 0 0 0 0 0 1 1 0
14 0 0 0 0 0 7 0 0 1 0 12 6 4
15 0 0 0 0 0 54 0 0 8 0 92 46 31
Ni_RU Cu_RU Zn_RU Rb_RU Sr_RU Y_RU Zr_RU Nb_RU Ba_RU Pb_RU SAMPLE
13 0 1 0 0 0 0 0 0 0 1 Standard
7 0 0 0 1 0 0 0 1 0 1 KF266_1
8 0 0 0 1 0 0 0 1 0 1 KF266_2
10 0 0 0 0 0 1 0 1 1 1 KF28_1
11 0 0 0 0 0 1 0 0 0 0 KF28_2
12 0 1 0 0 0 0 0 0 0 0 KF295
1 0 0 0 0 0 0 0 1 0 1 6448_1
2 0 0 0 0 0 0 0 1 0 1 6448_2
3 0 0 0 0 0 0 0 0 0 1 6465_1
4 0 0 0 0 0 0 0 0 0 0 6465_2
5 0 0 0 0 0 0 0 1 0 0 KF11
6 0 0 0 0 0 0 0 1 1 0 KF165
9 0 0 0 0 0 0 0 1 1 1 KF266_3
14 0 2 0 2 0 2 0 8 3 8 Spaltensumme
15 0 15 0 15 0 15 0 62 23 62 Spaltenprozent
Zeilensumme Zeilenprozent
13 2 12
7 1 6
8 1 6
10 1 6
11 1 6
12 1 6
1 0 0
2 0 0
3 0 0
4 0 0
5 0 0
6 0 0
9 0 0
14 0 0
15 0 0
# Export der Daten
write.csv(Prüfung_RU_6,"../Daten//Farchant_Bruker_RU_Zahlkodiert.csv")4.2.3 Erstellen farbcodierte Tabelle
# Erstellen einer Tabelle
tbl <- BasicTable$new()
# Befüllen mit den Daten aus data_RU
tbl$addData(data_RU, firstColumnAsRowHeaders=TRUE)
# Definieren der Zellen für welche eine Farbkodierung erfolgen soll
cells <- tbl$getCells(rowNumbers=2:14, columnNumbers=2:24, matchMode="combinations")
# Definieren und Anwenden des Farbkodes: rot wenn RU > 20, schwarz wenn RU <= 20
tbl$mapStyling(cells=cells, styleProperty="background-color", valueType="color",mapType="logic",mappings=list("v>20", "red", "v<=20", "black"))
tbl$renderTable()# Erstellen einer exportfähigen .xlsx-Datei
wb <- createWorkbook(creator = Sys.getenv("M. Schauer"))
addWorksheet(wb, "Data")
tbl$writeToExcelWorksheet(wb=wb, wsName="Data",topRowNumber=1, leftMostColumnNumber=1, applyStyles=TRUE)
# Export der Datei
saveWorkbook(wb, file = "../Daten//Farchant_Bruker_RU_Farbkodiert.xlsx", overwrite = TRUE)5 Datenaufbereitung
Die MudrockDual-Spektren des Bruker Tracer 5g wurden zunächst mit der Software CalToolkitEC (v. 1.57.1) in die Spektren der einzelnen Modi MudrockMajor und -Trace aufgeteilt und dann in Artax (v. 8.0.0.476) weiterverarbeitet. Es erfolgte eine Peak-Identifikation zur Modellierung der Spektren mithilfe Bayesscher Dekonvolution. Darauf basierend wurde eine Berechnung der Nettozählrate, d.h. der Anzahl von Photonen pro chemischem Element nach Abzug von Elementinterferenzen und Hintergrund, durchgeführt. Zur Verbesserung der Vergleichbarkeit wurde abschließend eine Normierung auf das Targetmaterial, im Falle des Tracers 5g Rhodium, durchgeführt. Nur dieser letzte Schritt der Datenaufbereitung erfolgte in R. Der Prozess folgt (Drake 2014).
5.1 Normierung Bruker Artax Mudrock Major Daten
# Laden der Daten
data<- read.csv("../Daten//Farchant_BrukerArtax_Major.csv")
# Erstellen der Funktion, um neue Spaltennamen zu generieren
Spaltentitel <- function(original_cols, suffix_col) {
paste0(original_cols, "_div_", suffix_col)
}
# Berechnung der neuen Spalten
data1 <- data
new_cols <- lapply(6:36, function(i) {
data[[i]] / data[[24]]
})
# Namen der neuen Spalten festlegen
new_colnames <- paste0("temp_", names(data)[6:36])
names(new_cols) <- new_colnames
# Hinzufügen der neuen Spalten zum DataFrame
data1 <- cbind(data1, new_cols)
# Neue Spaltennamen generieren
new_colnames <- Spaltentitel(names(data)[6:36], names(data)[24])
# Entfernen von '.K12' und '.L1' aus den Spaltentiteln und ersetzen von '_div_' mit '_'
new_colnames <- str_replace_all(new_colnames, "\\.(K12|L1)", "")
new_colnames <- str_replace_all(new_colnames, "_div_", "_")
# Anwenden der neuen Spaltennamen
colnames(data1)[which(startsWith(colnames(data1), "temp_"))] <- new_colnames
# Auswahl der relevanten Spalten aus data1
data2 <- data1[c(1:5, 37, 41, 44:45, 49, 53, 58, 61)]
# Export der Daten
write.csv(data2,"../Daten//Farchant_BrukerArtax_Major_norm.csv")5.2 Normierung Bruker Artax Mudrock Trace Daten
# Laden der Daten
data<- read.csv("../Daten//Farchant_BrukerArtax_Trace.csv")
# Erstellen der Funktion, um neue Spaltennamen zu generieren
Spaltentitel <- function(original_cols, suffix_col) {
paste0(original_cols, "_div_", suffix_col)
}
# Berechnung der neuen Spalten
data1 <- data
new_cols <- lapply(6:49, function(i) {
data[[i]] / data[[33]]
})
# Namen der neuen Spalten festlegen
new_colnames <- paste0("temp_", names(data)[6:49])
names(new_cols) <- new_colnames
# Hinzufügen der neuen Spalten zum DataFrame
data1 <- cbind(data1, new_cols)
# Neue Spaltennamen generieren
new_colnames <- Spaltentitel(names(data)[6:49], names(data)[33])
# Entfernen von '.K12' und '.L1' aus den Spaltentiteln und ersetzen von '_div_' mit '_'
new_colnames <- str_replace_all(new_colnames, "\\.(K12|L1)", "")
new_colnames <- str_replace_all(new_colnames, "_div_", "_")
# Anwenden der neuen Spaltennamen
colnames(data1)[which(startsWith(colnames(data1), "temp_"))] <- new_colnames
# Auswahl der relevanten Spalten aus data1
data2 <- data1[c(1:5,62,73,75,85,89,91,92)]
# Export der Daten
write.csv(data2,"../Daten//Farchant_BrukerArtax_Trace_norm.csv")6 Datenauswertung - Histogramme
6.1 Abb_Hauptelemente
# Laden der Daten
data <- read.csv("../Daten//Farchant_BrukerArtax_Major_norm.csv")
# Definieren der einzigartigen Werte zur Sortierung
unique_values <- unique(data[[3]])
# Erstellen des Sortierungsvektors
Sortierung <- unique(c("alte Ofl. Helle Ware",
"alte Ofl. Roetliche Ware",
"alte Ofl. Wandputz",
"Ofl. Auftrag",
"Ofl. Grau",
"Ofl. Schwarz",
"Ofl. Weiss Helle Ware",
"Ofl. Weiss Wandputz"))
# Durchführen der Sortierung und setzen von unbekannten Werten auf NA
data1 <- data %>%
mutate(custom_sort = factor(data[[3]], levels = Sortierung)) %>%
arrange(custom_sort) %>%
select(-custom_sort)
# Auswahl der darzustellenden Spalten
element_names <- colnames(data1)[c(7:14)]
# Definieren der Farben
meine_farben <- c("orange","firebrick","red","darkred","grey55","black","wheat","pink")
# Erstellen der Histogramme
plots <- list()
for(element in element_names) {
sorted_data <- data1 %>%
arrange(Messstelle)
hist_plot <- ggplot(data = sorted_data, aes(x = fct_reorder(SAMPLE, Messstelle), y = !!sym(element), fill = Messstelle)) +
geom_bar(stat = "identity", position = "dodge", color = "black") +
labs(x = "Probe",
y = element,
fill = "Messstelle") +
scale_fill_manual(values = meine_farben) +
theme_minimal() +
theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1))
print(hist_plot)
plots[[element]] <- hist_plot
}# Erstellen der Legende
legend <- cowplot::get_legend(plots[[1]])
# Entfernen der Legende von jedem Plot und ersetzen durch NULL
for (i in seq_along(plots)) {
plots[[i]] <- plots[[i]] + theme(legend.position = "none")
}
# Anordnen von Plots und Legende
multiplot <- cowplot::plot_grid(plotlist = plots, legend, ncol = 2)
# Exportieren der Abbildung
ggsave("../Abbildungen//Abb_Hauptelemente.eps", plot = multiplot, device = "eps", width = 15.3, height = 25, units = "cm")6.2 Abb_Spurenelemente
# Laden der Daten
data <- read.csv("../Daten//Farchant_BrukerArtax_Trace_norm.csv")
# Definieren der einzigartigen Werte zur Sortierung
unique_values <- unique(data[[3]])
# Erstellen des Sortierungsvektors
Sortierung <- unique(c("alte Ofl. Helle Ware",
"alte Ofl. Roetliche Ware",
"alte Ofl. Wandputz",
"Ofl. Auftrag",
"Ofl. Grau",
"Ofl. Schwarz",
"Ofl. Weiss Helle Ware",
"Ofl. Weiss Wandputz"))
# Durchführen der Sortierung und setzen von unbekannten Werten auf NA
data1 <- data %>%
mutate(custom_sort = factor(data[[3]], levels = Sortierung)) %>%
arrange(custom_sort) %>%
select(-custom_sort)
# Auswahl der darzustellenden Spalten
element_names <- colnames(data1)[c(7:13)]
# Definieren der Farben
meine_farben <- c("orange","firebrick","red","darkred","grey55","black","wheat","pink")
# Erstellen der Histogramme
plots <- list()
for(element in element_names) {
sorted_data <- data1 %>%
arrange(Messstelle)
hist_plot <- ggplot(data = sorted_data, aes(x = fct_reorder(SAMPLE, Messstelle), y = !!sym(element), fill = Messstelle)) +
geom_bar(stat = "identity", position = "dodge", color = "black") +
labs(x = "Probe",
y = element,
fill = "Messstelle") +
scale_fill_manual(values = meine_farben) +
theme_minimal() +
theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1))
print(hist_plot)
plots[[element]] <- hist_plot
}# Erstellen der Legende
legend <- cowplot::get_legend(plots[[1]])
# Entfernen der Legende von jedem Plot und ersetzen durch NULL
for (i in seq_along(plots)) {
plots[[i]] <- plots[[i]] + theme(legend.position = "none")
}
# Anordnen von Plots und Legende
multiplot <- cowplot::plot_grid(plotlist = plots, legend, ncol = 2)
# Exportieren der Abbildung
ggsave("../Abbildungen//Abb_Spurenelemente.eps", plot = multiplot, device = "eps", width = 15.3, height = 25, units = "cm")