library(ggplot2)
library(plyr)
library(dplyr)
library(ggpubr)
library(cowplot)
library(moments)
library(Rcmdr)
library(data.table)
library(PCAtest)
library(ggfortify)
library(tidyverse)
library(rstatix)
library(MASS)
library(RcmdrPlugin.NMBU)
library(factoextra)
library(pivottabler)1 Einleitung
1.1 Inhalt
Dieses Skript umfasst die Dokumentation der zu Kapitel 6.3.2.d - Schauer (2025) gehörigen Abbildungen und Statistiken:
Kapitel 6.3.2.d - Berechnung der Koeffizientenkorrekturen für Friedberg-Bruchenbrücken: Die notwendigen Neuberechnungen von Konzentrationswerten und Datenzusammenführung findet sich in (Skript Kapitel 4): Um alle Messwerte dieser Arbeit gemeinsam abbilden zu können, wurden die l-Drift-korrigierten Messwerte von Friedberg-Bruchenbrücken des Jahres 2018 durch Koefkor. IIaufIII auf die Rohdaten von 2020 angepasst (Skript Kapitel 4.1), dann mit Koefkor. III gemeinschaftlich neu berechnet (Skript Kapitel 4.2). So kann sicher gestellt werden, dass die Berechnung der Konzentrationen mit jener der Daten für das Obere Gäu überein stimmt. Die Anwendung der Koeffizientenkorrekturen auf die Daten des Oberen Gäus finden sich in R-Skript “Digitale Dokumentation in R zu Schauer 2025 ‘La Hoguette - Kultur, Phänomen, Subkultur?’. Abbildungen und Statistiken zu Kapitel 6.3.2/.a - Fallstudie Oberes Gäu Datenprüfung” - Kapitel 9 . Diese Daten werden in Skript Kapitel 5 mit den neu berechneten Friedberg-Bruchenbrücken-Daten zusammengeführt.
Kapitel 6.3.2.d - Streudiagramme: Elementbasierte Streudiagramme des gesamten Datensatzes finden sich in Abb. 6-165 - Skript Kapitel 6.
Kapitel 6.3.2.d - MANOVA, Hauptkomponenten-, Diskriminanz- und Clusteranalyse: In diesem Skript sind alle relevanten Schritte der multivariaten Verfahren hinterlegt. Hierzu gehören , Hauptkompotenten- (Skript Kapitel 7.2) und Clusteranalyse (Skript Kapitel 7.3) des gesamten Datensatzes (Skript Kapitel 7). MANOVA und Diskriminanazanalyse sind für den gesamten Datensatz (Skript Kapitel 7.1 und Skript Kapitel 8.1) sowie gefilter nach Bandkeramik (Skript Kapitel 8.2.4 und Skript Kapitel 8.2) bzw. La Hoguette (Skript Kapitel 8.3.4 und Skript Kapitel 8.3). Abb. 6-166_1 - Skript Kapitel 8.1.6 veranschaulicht das Streudiagramm der vollständigen Diskriminanzanalyse, Abb. 6-166_2 - Skript Kapitel 8.2.7 jenes der bandkeramischen Objekte und Abb. 6-166_3 - Skript Kapitel 8.3.7 die Ergebnisse basierend auf den La Hoguette Funden. Die vollständige Abbildung findet sich in Abb. 6-166 - Skript Kapitel 8.4.
Kapitel 6.3.2.d - Multivariater Normabstand: Zur Berechnung des Multivariaten Normabstands wurden die Daten in Bandkeramik (Skript Kapitel 9.1) und La Hoguette (Skript Kapitel 9.2) aufgeteilt und der Normabstand für beide gefilteren Datensätze basierend auf den für Friedberg-Bruchenbrücken und das Obere Gäu belastbaren chemischen Elementen ermittelt. Die Ergebnisse der Dunn Tests sind hinterlegt (Skript Kapitel 9.1.4 und Skript Kapitel 9.2.4). Die zugehörigen Histogramme finden sich in Abb. 6-167 - Skript Kapitel 9.3.
Kapitel 6.3.3 - Diskussion der Modelle A bis C: Abb. 6-171 - Skript Kapitel 10 zeigt für das Obere Gäu das Zusammenspiel von Rezepturen, Kontexten und Zierstilen nach LeFranc.
1.2 Praktische Hinweise
1.2.1 Einführende Literatur
Um mit dem bereitgestellten R-Skript arbeiten zu können, werden die wichtigsten praktischen Schritte, die für den Einstieg erforderlich sind, kurz erklärt. Dies ersetzt jedoch nicht das Studium des Programms selbst und der Inhalte der Skripte. Siegmund (2020) wird als Grundlage in deutscher Sprache empfohlen, als Einführung in das R-Plugin Quarto seine Anleitung Siegmund (2023). Auf Englisch ist die R Quarto-Website besonders zu empfehlen. Field, A. u. a. (2013) ist lesenswert, unterhaltsam und enthält alle relevanten Informationen für den Einstieg. Das R Core Team bieten eine regelmäßig aktualisierte Einführung an; die aktuelle Version ist hier zu finden.
1.2.2 R, R Studio und R Quarto
R, auch R Console oder RGUI, ist das ‘reine’ R, d.h. es arbeitet ausschließlich mit Code. R Studio hingegen hat eine Benutzeroberfläche, und greift auf R zugreift. Dieses R-Skript wurde R Studio in Verbindung mit Quarto erstellt, einer R-spezifischen Schreibumgebung, die die Handhabung von Code sowohl bei der Entwicklung als auch bei der Veröffentlichung erheblich vereinfacht. Quarto ermöglicht es, einzelne R-Skripte in Form von Quarto-Dateien (.qmd) zu erstellen und in verschiedene andere Formate (.html, .pdf) zu exportieren. Neben dem ‘reinen’ R-Code können auch weitere Informationen zu den Code-Modulen bereitgestellt werden.
Quarto-Dokumente enthalten ‘ausführbaren’ R-Code, d.h. sie wurden entwickelt und umfangreich getestet, um die gewünschten Berechnungen fehlerfrei durchzuführen. Wenn die Quarto-Dateien in R Studio geöffnet werden, sind die Code-Blöcke grau hinterlegt und können automatisch gerechnet werden. Weitere Informationen zu Quarto und Quarto-Code finden sich hier.
Um mit diesem Skript zu arbeiten, wird empfohlen, R und RStudio, ggf. auch R Quarto zu installieren.
1.2.3 R Projekte
Um sicherzustellen, dass die Berechnungen reibungslos ablaufen, wurde das Skript in ein R-Projekt eingebettet. Die R Projekt-Datei (.Rproj) befindet sich im übergeordneten Ordner der Berechnungen und kann durch Doppelklicken geöffnet werden. Der Dateipfad wird über die Position dieser Datei definiert, sodass das gesamte Projekt überall gespeichert werden kann, solange die Daten in den vorgegebenen Ordner hinterlegt sind. Die einzige Voraussetzung ist, dass der unter Skript Kapitel 3 hinterlegte Code-Schnipsel beim ersten Arbeiten mit diesem Skript ausgeführt wird.
Ein weiterer Vorteil von RProjects ist, dass alle Quarto-Dateien, die beim Erstellen des Projekts geöffnet wurden, direkt beim Öffnen des Projekts geladen werden – es muss nicht nach der Dateistruktur gesucht werden.
1.2.4 R Pakete
R Pakete müssen zunächst installiert und dann bei jeder Sitzung neu geladen werden (siehe auch Skript Kapitel 2), um die Berechnungen auszuführen. Sie enthalten die Funktionen, die für die Berechnung bestimmter Analysen erforderlich sind. Zum Installieren kann der folgende Code verwendet werden:
- install.packages(“Paket-Name”)
Die Pakete werden mit dem Code geladen:
- library(Paket-Name)
Eine kurze Einführung in die grundlegenden R Befehle findet sich beispielsweise auch hier.
1.3 Skript & Packages
Dieses Quarto Skript (R Quarto v.1.5.55) (Allaire u. a. 2024) wurde mit R v. 4.4.1 (R Core Team 2024) und RStudio v. 2024.04.2 (RStudio Team 2024) erstellt. Es werden folgende R-Packages verwendet:
- cowplot (Barrett u. a. 2024)
- data.table (Wilke 2024)
- dplyr (Wickham 2023)
- factoextra (Kassambara/Mundt 2020)
- ggfortify (Yuan Tang/Wenxuan 2016)
- ggplot2 (Wickham 2016)
- ggpubr (Kassambara 2023a)
- MASS (Venables/Ripley 2007)
- moments (Komsta/Novomestky 2022)
- PCAtest (Camargo 2024)
- pivottabler (Bailiss 2023)
- plyr (Wickham 2011)
- Rcmdr (Fox u. a. 2024)
- RcmdrPlugin.NMBU (Liland/Sæbø 2024)
- rstatix (Kassambara 2023b)
- tidyverse (Wickham u. a. 2019)
Vor Beginn der Analysen müssen sowohl alle Packages (siehe Skript Kapitel 2) geladen als auch die Working directory (siehe Skript Kapitel 3) gesetzt werden.
Der Code ist ‘lauffähig’, d.h. kann fehlerfrei gerechnet werden, so die vorgegebene Datenstruktur beibehalten wird.
In jedem Code-Block wird der Code für die erste zu erstellende Abbildung erklärt - darauf folgende Grafiken mit vergleichbarem Code erhalten keine eigene Beschreibung.
1.4 Gerät und Messparameter
Die Messdaten wurden mit dem Niton XL3t No. 97390 des Departments für Kulturwissenschaften der Universität München im TestAllGeo Modus (60 Sekunden Standard, Niedrig, Hoch und 120 Sekunden Leicht-Modus) und einem 8mm Messspot ermittelt. Die Messungen fanden von September bis Dezember 2018 sowie September 2019 bis Juli 2020 statt. Weitere Informationen finden sich bei Kapitel 6.1.1 - Schauer (2025).
2 Notwendige R Pakete
3 Working directory
knitr::opts_knit$set(root.dir = "./")4 Koeffizientenkorrekturen (coefcors) für Friedberg-Bruchenbrücken
4.1 Koeffizientenkorrektur Koefkor(coecor) IIaufIII für 2018
4.1.1 Zusammenstellen der Daten und Variablen
# Daten einlesen und filtern
data1<- read.csv("../Daten//Kap_6//Kap_6.2//Grundlagen//Datengrundlage//Daten_BB_lDrift_Kor_gesamt.csv")
data<-subset(data1, data1$Datum != "3.3.2020" & data1$Datum != "4.3.2020")
# Daten einlesen
coefcor<- read.csv("../Daten//Kap_6//Kap_6.3//Grundlagen//Coefcor//coefcorIItoIII_factors.csv")
# Definieren relevanter Variablen
Probennummer<-data$Probennummer
Datum<-data$Datum4.1.2 Durchführen der Berechnungen
# Extrahieren der Messwerte für Si
Si<-data$Si
# Extrahieren des Koeffizienten der Steigung für Si
Si_a<-coefcor$Si_a
# Extrahieren des Koeffizienten des Y-Achsenabschnitts für Si
Si_b<-coefcor$Si_b
# Durchführen der Koeffizientenkorrektur
Si<-Si_a*Si+Si_b
Ti<-data$Ti
Ti_a<-coefcor$Ti_a
Ti_b<-coefcor$Ti_b
Ti<-Ti_a*Ti+Ti_b
Al<-data$Al
Al_a<-coefcor$Al_a
Al_b<-coefcor$Al_b
Al<-Al_a*Al+Al_b
Fe<-data$Fe
Fe_a<-coefcor$Fe_a
Fe_b<-coefcor$Fe_b
Fe<-Fe_a*Fe+Fe_b
Mn<-data$Mn
Mn_a<-coefcor$Mn_a
Mn_b<-coefcor$Mn_b
Mn<-Mn_a*Mn+Mn_b
Mg<-data$Mg
Mg_a<-coefcor$Mg_a
Mg_b<-coefcor$Mg_b
Mg<-Mg_a*Mg+Mg_b
Ca<-data$Ca
Ca_a<-coefcor$Ca_a
Ca_b<-coefcor$Ca_b
Ca<-Ca_a*Ca+Ca_b
K<-data$K
K_a<-coefcor$K_a
K_b<-coefcor$K_b
K<-K_a*K+K_b
P<-data$P
P_a<-coefcor$P_a
P_b<-coefcor$P_b
P<-P_a*P+P_b
Cl<-data$Cl
Cl_a<-coefcor$Cl_a
Cl_b<-coefcor$Cl_b
Cl<-Cl_a*Cl+Cl_b
V<-data$V
V_a<-coefcor$V_a
V_b<-coefcor$V_b
V<-V_a*V+V_b
Cr<-data$Cr
Cr_a<-coefcor$Cr_a
Cr_b<-coefcor$Cr_b
Cr<-Cr_a*Cr+Cr_b
Zn<-data$Zn
Zn_a<-coefcor$Zn_a
Zn_b<-coefcor$Zn_b
Zn<-Zn_a*Zn+Zn_b
As<-data$As
As_a<-coefcor$As_a
As_b<-coefcor$As_b
As<-As_a*As+As_b
Rb<-data$Rb
Rb_a<-coefcor$Rb_a
Rb_b<-coefcor$Rb_b
Rb<-Rb_a*Rb+Rb_b
Sr<-data$Sr
Sr_a<-coefcor$Sr_a
Sr_b<-coefcor$Sr_b
Sr<-Sr_a*Sr+Sr_b
Y<-data$Y
Y_a<-coefcor$Y_a
Y_b<-coefcor$Y_b
Y<-Y_a*Y+Y_b
Zr<-data$Zr
Zr_a<-coefcor$Zr_a
Zr_b<-coefcor$Zr_b
Zr<-Zr_a*Zr+Zr_b
Nb<-data$Nb
Nb_a<-coefcor$Nb_a
Nb_b<-coefcor$Nb_b
Nb<-Nb_a*Nb+Nb_b
Ba<-data$Ba
Ba_a<-coefcor$Ba_a
Ba_b<-coefcor$Ba_b
Ba<-Ba_a*Ba+Ba_b
Pb<-data$Pb
Pb_a<-coefcor$Pb_a
Pb_b<-coefcor$Pb_b
Pb<-Pb_a*Pb+Pb_b4.1.3 Zusammenführen und Exportieren der Variablen in einer Tabelle
# Kombinieren mehrerer Dataframes
coefcorIItoIII_cor_data<-data.frame(Probennummer,Datum,Si,Ti,Al,Fe,Mn,Mg,Ca,K,P,Cl,V,Cr,Zn,As,Rb,Sr,Y,Zr,Nb,Ba,Pb)
# Speichern als CSV
write.csv(coefcorIItoIII_cor_data,"../Daten//Kap_6//Kap_6.3//Grundlagen//Zusammenschau//Daten_BB_KoefkorIIaufIII_2018.csv",row.names=TRUE)4.2 Koeffizientenkorrektur Koefkor(coefcor) III für 2018 & 2020
4.2.1 Zusammenstellen der Daten und Variablen
# Daten 2018 einlesen und filtern
dataset2<- read.csv("../Daten//Kap_6//Kap_6.3//Grundlagen//Zusammenschau//Daten_BB_KoefkorIIaufIII_2018.csv")
dataset2<-dataset2[,-c(1)]
# Daten 2020 einlesen und filtern
dataset1<- read.csv("../Daten//Kap_6//Kap_6.2//Grundlagen//Datengrundlage//Daten_BB_lDrift_Kor_gesamt.csv")
dataset1<-dataset1 %>% filter((Datum=="3.3.2020"|Datum=="4.3.2020"))
dataset1<-dataset1[,c(1:11,13:15,18,19,21:25,33,35)]
# Zeilenweise Kombination mehrerer Dataframes
data<-rbind(dataset1,dataset2)
# Daten Koefkor III einlesen
coefcor<- read.csv("../Daten//Kap_6//Kap_6.3//Grundlagen//Coefcor//coefcorIII_factors.csv")
# Definieren relevanter Variablen
Probennummer<-data$Probennummer
Datum<-data$Datum4.2.2 Durchführen der Berechnungen
# Extrahieren der Messwerte für Si
Si<-data$Si
# Extrahieren des Koeffizienten der Steigung für Si
Si_a<-coefcor$Si_a
# Extrahieren des Koeffizienten des Y-Achsenabschnitts für Si
Si_b<-coefcor$Si_b
# Durchführen der Koeffizientenkorrektur und Umrechnung in Oxidprozente (letztes nur Hauptelemente)
SiO2<-(Si_a*Si+Si_b)*0.00021393
Ti<-data$Ti
Ti_a<-coefcor$Ti_a
Ti_b<-coefcor$Ti_b
TiO2<-(Ti_a*Ti+Ti_b)*0.0001668
Al<-data$Al
Al_a<-coefcor$Al_a
Al_b<-coefcor$Al_b
Al2O3<-(Al_a*Al+Al_b)*0.00018895
Fe<-data$Fe
Fe_a<-coefcor$Fe_a
Fe_b<-coefcor$Fe_b
Fe2O3<-(Fe_a*Fe+Fe_b)*0.000143
Mn<-data$Mn
Mn_a<-coefcor$Mn_a
Mn_b<-coefcor$Mn_b
MnO<-(Mn_a*Mn+Mn_b)*0.00012912
Mg<-data$Mg
Mg_a<-coefcor$Mg_a
Mg_b<-coefcor$Mg_b
MgO<-(Mg_a*Mg+Mg_b)*0.00016583
Ca<-data$Ca
Ca_a<-coefcor$Ca_a
Ca_b<-coefcor$Ca_b
CaO<-(Ca_a*Ca+Ca_b)*0.00013992
K<-data$K
K_a<-coefcor$K_a
K_b<-coefcor$K_b
K2O<-(K_a*K+K_b)*0.00012046
P<-data$P
P_a<-coefcor$P_a
P_b<-coefcor$P_b
P2O5<-(P_a*P+P_b)*0.00022914
# Kombinieren mehrerer Dataframes
data_norm<-data.frame(SiO2,TiO2,Al2O3,Fe2O3,MnO,MgO,CaO,K2O,P2O5)
# Berechen der Summe pro Zeile
data_norm_withsum<-data_norm %>% rowwise() %>% mutate(sum = sum(c(SiO2,TiO2,Al2O3,
Fe2O3,MnO,MgO,CaO,K2O,P2O5)))
# Berechnung des Normierungsfaktors
sumpct<-100/data_norm_withsum$sum
# Durchführen der Normierung
SiO2<-SiO2*sumpct
TiO2<-TiO2*sumpct
Al2O3<-Al2O3*sumpct
Fe2O3<-Fe2O3*sumpct
MnO<-MnO*sumpct
MgO<-MgO*sumpct
CaO<-CaO*sumpct
K2O<-K2O*sumpct
P2O5<-P2O5*sumpct
V<-data$V
V_a<-coefcor$V_a
V_b<-coefcor$V_b
V<-V_a*V+V_b
Cr<-data$Cr
Cr_a<-coefcor$Cr_a
Cr_b<-coefcor$Cr_b
Cr<-Cr_a*Cr+Cr_b
Zn<-data$Zn
Zn_a<-coefcor$Zn_a
Zn_b<-coefcor$Zn_b
Zn<-Zn_a*Zn+Zn_b
Rb<-data$Rb
Rb_a<-coefcor$Rb_a
Rb_b<-coefcor$Rb_b
Rb<-Rb_a*Rb+Rb_b
Sr<-data$Sr
Sr_a<-coefcor$Sr_a
Sr_b<-coefcor$Sr_b
Sr<-Sr_a*Sr+Sr_b
Y<-data$Y
Y_a<-coefcor$Y_a
Y_b<-coefcor$Y_b
Y<-Y_a*Y+Y_b
Zr<-data$Zr
Zr_a<-coefcor$Zr_a
Zr_b<-coefcor$Zr_b
Zr<-Zr_a*Zr+Zr_b
Nb<-data$Nb
Nb_a<-coefcor$Nb_a
Nb_b<-coefcor$Nb_b
Nb<-Nb_a*Nb+Nb_b
Ba<-data$Ba
Ba_a<-coefcor$Ba_a
Ba_b<-coefcor$Ba_b
Ba<-Ba_a*Ba+Ba_b
Pb<-data$Pb
Pb_a<-coefcor$Pb_a
Pb_b<-coefcor$Pb_b
Pb<-Pb_a*Pb+Pb_b4.2.3 Zusammenführen und Exportieren der Variablen in einer Tabelle
# Kombinieren mehrerer Dataframes
data3<-data.frame(Probennummer,SiO2,TiO2,Al2O3,Fe2O3,MnO,MgO,CaO,K2O,P2O5,V,Cr,Zn,Rb,Sr,Y,Zr,Nb,Ba,Pb)
# Speichern als CSV
write.csv(data3,"../Daten//Kap_6//Kap_6.3//Grundlagen//Zusammenschau//Daten_BB_KoefkorIIIfinal.csv",row.names=FALSE)4.2.4 Zusammenführen mit archäologischen Daten
# Daten einlesen
data1<- read.csv("../Daten//Kap_6//Kap_6.3//Grundlagen//Zusammenschau//Daten_BB_KoefkorIIIfinal.csv")
data2<- read.csv("../Daten//Kap_6//Kap_6.2//Grundlagen//Datengrundlage//Daten_BB_ArchDaten.csv")
# Berechnen der Mittelwerte pro Probe
data3<-(data1) %>%
group_by(Probennummer) %>%
dplyr::summarise(across(everything(),list(mean=mean)))
# Entfernen von "_mean" aus den Spaltennamen
colnames(data3) <- gsub("_mean", "", colnames(data3))
# Kombinieren mehrerer Dataframes basierend auf der Probennummer
data4<-merge(data3,data2, by="Probennummer", all=TRUE)
# Daten filtern - Entfernen der nicht belastbar gemessenen Proben
data<-data4[!(data4$Probennummer=="50" | data4$Probennummer=="76-33"| data4$Probennummer=="76-135"| data4$Probennummer=="219-142"| data4$Probennummer=="244"| data4$Probennummer=="437"| data4$Probennummer=="442"| data4$Probennummer=="610"| data4$Probennummer=="782"| data4$Probennummer=="851"| data4$Probennummer=="978"| data4$Probennummer=="980"| data4$Probennummer=="1024"| data4$Probennummer=="1043"| data4$Probennummer=="1205"| data4$Probennummer=="1244"| data4$Probennummer=="1302"| data4$Probennummer=="1317"| data4$Probennummer=="1343"| data4$Probennummer=="1347"| data4$Probennummer=="1348"| data4$Probennummer=="1574-n"| data4$Probennummer=="18-55A"| data4$Probennummer=="94A"| data4$Probennummer=="408A"| data4$Probennummer=="623-14A"| data4$Probennummer=="980A"| data4$Probennummer=="1674A"| data4$Probennummer=="2966A"| data4$Probennummer=="460-2B"| data4$Probennummer=="703B"| data4$Probennummer=="1205B"| data4$Probennummer=="1868B"| data4$Probennummer=="3099B"| data4$Probennummer=="3104B"| data4$Probennummer=="3110B"| data4$Probennummer=="699-2AH"| data4$Probennummer=="Standard"),]
# Speichern als CSV
write.csv(data,"../Daten//Kap_6//Kap_6.3//Grundlagen//Zusammenschau//Daten_BB_KoeffkorIIIfinal_MWsort.csv",
row.names=TRUE)Händische Aufbereitung: Für alle Funde 1507/3107 wird je der Mittelwert für frischer Bruch, alte Oberfläche und alter Bruch gebildet. Bei 437V sowie 394-n handelt es sich um die erneute Messung von 437 respektive 394 da diese fehlerhaft war. Der Wert von 394-n wird behalten, 437v in 437 umbennant und die zugehörigen archäologischen Informationen händisch aus Daten_BB_ArchDaten übernommen. Die Probe GA-1 wurde entfernt da sie nicht aus Friedberg-Bruchenbrücken stammt.Bei der Probe 76-33 handelt es sich um einen Stein.
5 Zusammenstellen der Grundlagendaten der Auswertung
# Daten einlesen und filtern
data1<- read.csv("../Daten//Kap_6//Kap_6.3//Grundlagen//Zusammenschau//Daten_BB_KoeffkorIIIfinal_MWsort_bearb.csv")
data2<-data1[,c(2:21,23:25),]
data3<-subset(data2, Messstelle %in% c("frischer Bruch"))
# Erstellen einer neuen Spalte "Fundort" und einfügen der Fundorbezeichnung
data4 <- cbind(data3, Fundort = rep('Friedberg-Bruchenbruecken', 355))
# Daten einlesen und filtern
data5<- read.csv("../Daten//Kap_6//Kap_6.3//Grundlagen//Datengrundlage//Daten_OG_vollständigMW.csv")
data6<-data5[,c(1,3:13,16:27),]
# Zeilenweise Kombination mehrerer Dataframes
data7<-rbind(data4,data6)
# Speichern als CSV
write.csv(data7,"../Daten//Kap_6//Kap_6.3//Grundlagen//Zusammenschau//Daten_BB_OG_KoeffkorIII.csv",row.names=FALSE)6 Abb. 6-165
Spalten in Daten_BB_OG_KoeffkorIII wurden von Hand umsortiert.
# Daten einlesen und filtern
data1<-read.csv("../Daten//Kap_6//Kap_6.3//Grundlagen//Zusammenschau//Daten_BB_OG_KoeffkorIII_bearb.csv")
data<-subset(data1, Kultur %in% c("La Hoguette","LBK","Huettenlehm"))
data<-subset(data, Fundort %in% c("Friedberg-Bruchenbruecken","Rottenburg-Hailfingen 'Unter dem Tuebinger Weg'","Rottenburg 'Froebelweg'"))
# Definieren der Darstellungsreihenfolge
data$Fundort<-factor(data$Fundort,levels=c("Friedberg-Bruchenbruecken","Rottenburg-Hailfingen 'Unter dem Tuebinger Weg'","Rottenburg 'Froebelweg'"))
# Diagramme erstellen
Scatter_Fundort_KerHL_Rb_Sr<-ggplot(data, aes(x=Rb,y=Sr, color=Fundort, shape=Kultur))+
geom_point(aes(shape=Kultur),size=2)+scale_shape_manual(values=c(0,2,1))+ # Manuelle Definition von Größe und Form der Symbole
scale_color_manual(name="Fundort",values=c("cyan4","paleturquoise","grey70"))+ # Manuelle Definition der Farbe der Symbole
xlab("Rb in ppm")+ylab("Sr in ppm")+ # Manuelle Achsenbeschriftung
theme_classic()+ # Klassisches Design
theme(axis.line=element_line(colour="black",size=0.25))+theme(legend.title=element_blank(),legend.text=element_text(size=8),axis.title=element_text(size=9),axis.text=element_text(size=8,color="black"))+theme(legend.position="bottom")+theme(axis.ticks=element_line(size=0.25,colour="black")) # Manuelle Formatierung von Achsen- und Legendendarstellung
Scatter_Fundort_KerHL_Y_Zr<-ggplot(data, aes(x=Y,y=Zr, color=Fundort, shape=Kultur))+
geom_point(aes(shape=Kultur),size=2)+scale_shape_manual(values=c(0,2,1))+
scale_color_manual(name="Fundort",values=c("cyan4","paleturquoise","grey70"))+
xlab("Y in ppm")+ylab("Zr in ppm")+
theme_classic()+
theme(axis.line=element_line(colour="black",size=0.25))+
theme(legend.title=element_blank(),legend.text=element_text(size=8),axis.title=element_text(size=9),axis.text=element_text(size=8,color="black"))+theme(legend.position="bottom")+theme(axis.ticks=element_line(size=0.25,colour="black"))
Scatter_Fundort_KerHL_Zn_Zr<-ggplot(data, aes(x=Zn,y=Zr, color=Fundort, shape=Kultur))+
geom_point(aes(shape=Kultur),size=2)+scale_shape_manual(values=c(0,2,1))+
scale_color_manual(name="Fundort",values=c("cyan4","paleturquoise","grey70"))+
xlab("Zn in ppm")+ylab("Zr in ppm")+
theme_classic()+
theme(axis.line=element_line(colour="black",size=0.25))+theme(legend.title=element_blank(),legend.text=element_text(size=8),axis.title=element_text(size=9),axis.text=element_text(size=8,color="black"))+theme(legend.position="bottom")+theme(axis.ticks=element_line(size=0.25,colour="black"))
Scatter_Fundort_KerHL_CaO_Sr<-ggplot(data, aes(x=CaO,y=Sr, color=Fundort, shape=Kultur))+
geom_point(aes(shape=Kultur),size=2)+scale_shape_manual(values=c(0,2,1))+
scale_color_manual(name="Fundort",values=c("cyan4","paleturquoise","grey70"))+
xlab("CaO in %")+ylab("Sr in ppm")+
theme_classic()+
theme(axis.line=element_line(colour="black",size=0.25))+theme(legend.title=element_blank(),legend.text=element_text(size=8),axis.title=element_text(size=9),axis.text=element_text(size=8,color="black"))+theme(legend.position="bottom")+theme(axis.ticks=element_line(size=0.25,colour="black"))
Scatter_Fundort_KerHL_Rb_K2O<-ggplot(data, aes(x=Rb,y=K2O, color=Fundort, shape=Kultur))+
geom_point(aes(shape=Kultur),size=2)+scale_shape_manual(values=c(0,2,1))+
scale_color_manual(name="Fundort",values=c("cyan4","paleturquoise","grey70"))+
xlab("Rb in ppm")+ylab("K2O in %")+
theme_classic()+
theme(axis.line=element_line(colour="black",size=0.25))+theme(legend.title=element_blank(),legend.text=element_text(size=8),axis.title=element_text(size=9),axis.text=element_text(size=8,color="black"))+theme(legend.position="bottom")+theme(axis.ticks=element_line(size=0.25,colour="black"))
Scatter_Fundort_KerHL_Al2O3_SiO2<-ggplot(data, aes(x=Al2O3,y=SiO2, color=Fundort, shape=Kultur))+
geom_point(aes(shape=Kultur),size=2)+scale_shape_manual(values=c(0,2,1))+
scale_color_manual(name="Fundort",values=c("cyan4","paleturquoise","grey70"))+
xlab("Al2O3 in %")+ylab("SiO2 in %")+
theme_classic()+
theme(axis.line=element_line(colour="black",size=0.25))+theme(legend.title=element_blank(),legend.text=element_text(size=8),axis.title=element_text(size=9),axis.text=element_text(size=8,color="black"))+theme(legend.position="bottom")+theme(axis.ticks=element_line(size=0.25,colour="black"))
Scatter_Fundort_KerHL_CaO_P2O5<-ggplot(data, aes(x=CaO,y=P2O5, color=Fundort, shape=Kultur))+
geom_point(aes(shape=Kultur),size=2)+scale_shape_manual(values=c(0,2,1))+
scale_color_manual(name="Fundort",values=c("cyan4","paleturquoise","grey70"))+
xlab("CaO in %")+ylab("P2O5 in %")+
theme_classic()+
theme(axis.line=element_line(colour="black",size=0.25))+theme(legend.title=element_blank(),legend.text=element_text(size=8),axis.title=element_text(size=9),axis.text=element_text(size=8,color="black"))+theme(legend.position="bottom")+theme(axis.ticks=element_line(size=0.25,colour="black"))
Scatter_Fundort_KerHL_CaO_Fe2O3<-ggplot(data, aes(x=CaO,y=Fe2O3, color=Fundort, shape=Kultur))+
geom_point(aes(shape=Kultur),size=2)+scale_shape_manual(values=c(0,2,1))+
scale_color_manual(name="Fundort",values=c("cyan4","paleturquoise","grey70"))+
xlab("CaO in %")+ylab("Fe2O3 in %")+
theme_classic()+
theme(axis.line=element_line(colour="black",size=0.25))+theme(legend.title=element_blank(),legend.text=element_text(size=8),axis.title=element_text(size=9),axis.text=element_text(size=8,color="black"))+theme(legend.position="bottom")+theme(axis.ticks=element_line(size=0.25,colour="black"))
Scatter_Fundort_KerHL_MnO_Fe2O3<-ggplot(data, aes(x=MnO,y=Fe2O3, color=Fundort, shape=Kultur))+
geom_point(aes(shape=Kultur),size=2)+scale_shape_manual(values=c(0,2,1))+
scale_color_manual(name="Fundort",values=c("cyan4","paleturquoise","grey70"))+
xlab("MnO in %")+ylab("Fe2O3 in %")+
theme_classic()+
theme(axis.line=element_line(colour="black",size=0.25))+theme(legend.title=element_blank(),legend.text=element_text(size=8),axis.title=element_text(size=9),axis.text=element_text(size=8,color="black"))+theme(legend.position="bottom")+theme(axis.ticks=element_line(size=0.25,colour="black"))
Scatter_Fundort_KerHL_TiO2_K2O<-ggplot(data, aes(x=TiO2,y=K2O, color=Fundort, shape=Kultur))+
geom_point(aes(shape=Kultur),size=2)+scale_shape_manual(values=c(0,2,1))+
scale_color_manual(name="Fundort",values=c("cyan4","paleturquoise","grey70"))+
xlab("TiO2 in %")+ylab("K2O in %")+
theme_classic()+
theme(axis.line=element_line(colour="black",size=0.25))+theme(legend.title=element_blank(),legend.text=element_text(size=8),axis.title=element_text(size=9),axis.text=element_text(size=8,color="black"))+theme(legend.position="bottom")+theme(axis.ticks=element_line(size=0.25,colour="black"))
Scatter_Fundort_KerHL_TiO2_Zr<-ggplot(data, aes(x=TiO2,y=Zr, color=Fundort, shape=Kultur))+
geom_point(aes(shape=Kultur),size=2)+scale_shape_manual(values=c(0,2,1))+
scale_color_manual(name="Fundort",values=c("cyan4","paleturquoise","grey70"))+
xlab("TiO2 in %")+ylab("Zr in ppm")+
theme_classic()+
theme(axis.line=element_line(colour="black",size=0.25))+theme(legend.title=element_blank(),legend.text=element_text(size=8),axis.title=element_text(size=9),axis.text=element_text(size=8,color="black"))+theme(legend.position="bottom")+theme(axis.ticks=element_line(size=0.25,colour="black"))
# Kombination der Diagramme
ggarrange(Scatter_Fundort_KerHL_Al2O3_SiO2,Scatter_Fundort_KerHL_CaO_P2O5,Scatter_Fundort_KerHL_CaO_Fe2O3,Scatter_Fundort_KerHL_MnO_Fe2O3,Scatter_Fundort_KerHL_TiO2_K2O,Scatter_Fundort_KerHL_CaO_Sr,Scatter_Fundort_KerHL_Rb_K2O,Scatter_Fundort_KerHL_TiO2_Zr,Scatter_Fundort_KerHL_Rb_Sr,Scatter_Fundort_KerHL_Y_Zr,Scatter_Fundort_KerHL_Zn_Zr,ncol=3,nrow=4,align = "hv",common.legend=TRUE)+theme(legend.position="bottom")
# Export des kombinierten Diagramms
ggsave("Abb.6-165.eps",path=("../Daten//Kap_6//Kap_6.3//Abbildungen//Zusammenschau"),plot=last_plot(),device="eps",height=18,width=15.3,unit=c("cm"),dpi=1200)7 Analyse aller Daten
7.1 Berechnen der MANOVA
7.1.1 Berechnen der log10-transformation aller Daten und Export
# Daten einlesen und filtern
data1<-read.csv("../Daten//Kap_6//Kap_6.3//Grundlagen//Zusammenschau//Daten_BB_OG_KoeffkorIII_bearb.csv")
data1<-subset(data1, Kultur %in% c("La Hoguette","LBK","Huettenlehm"))
data1<-subset(data1, Fundort %in% c("Friedberg-Bruchenbruecken","Rottenburg-Hailfingen 'Unter dem Tuebinger Weg'","Rottenburg 'Froebelweg'"))
data2<-data1[,c(2:20),]
# Definieren relevanter Variablen
Probennummer<-data1$Probennummer
Fundort<-data1$Fundort
Kultur<-data1$Kultur
# Anwenden des log10
data3<-log10(data2)
# Spaltenweise Kombination von Dataframes
data4<- cbind(data3,Probennummer,Kultur,Fundort)
# Speichern als CSV
write.csv(data4,"../Daten//Kap_6//Kap_6.3//Grundlagen//Zusammenschau//Daten_log10_MW.csv",row.names=TRUE)7.1.2 Durchführen der MANOVA
# Daten einlesen
data<-read.csv("../Daten//Kap_6//Kap_6.3//Grundlagen//Zusammenschau//Daten_log10_MW.csv")
# Durchführen der MANOVA für ausgewählte Spalten im Hinblick auf Fundort
manova<-manova(cbind(Al2O3,CaO,Fe2O3,K2O,MnO,P2O5,SiO2,TiO2,Zn,Rb,Sr,Y,Zr) ~ Fundort, data)
# Zusammenfassung der MANOVA mit Intercept
summary(manova,intercept=TRUE) Df Pillai approx F num Df den Df Pr(>F)
(Intercept) 1 0.99993 810617 13 723 < 2.2e-16 ***
Fundort 2 1.24108 91 26 1448 < 2.2e-16 ***
Residuals 735
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# Anzeige der MANOVA-Ergebnisse mit Wilks-Lambda-Tests
summary(manova,test="Wilks",intercept=TRUE) Df Wilks approx F num Df den Df Pr(>F)
(Intercept) 1 0.000069 810617 13 723 < 2.2e-16 ***
Fundort 2 0.072348 151 26 1446 < 2.2e-16 ***
Residuals 735
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 17.2 Hauptkomponentenanalyse
7.2.1 Berechnen und Zusammenstellen der PCA-Daten
# Daten einlesen
data<-read.csv("../Daten//Kap_6//Kap_6.3//Grundlagen//Zusammenschau//Daten_log10_MW.csv")
# Durchführen der PCA für ausgewählte Spalten
myPr <- prcomp(~ SiO2+TiO2+Al2O3+Fe2O3+MnO+CaO+K2O+P2O5+Zn+Rb+Sr+Y+Zr,data=data,scale = TRUE)
myPrStandard deviations (1, .., p=13):
[1] 1.9442915 1.6052668 1.3854960 1.0772542 1.0549952 0.9524688 0.7513468
[8] 0.5217611 0.4313721 0.4177854 0.4098980 0.3417985 0.2456343
Rotation (n x k) = (13 x 13):
PC1 PC2 PC3 PC4 PC5
SiO2 -0.284246746 0.47725435 0.095027930 0.10771492 0.07676863
TiO2 -0.082993697 -0.02196090 -0.535717909 0.41267728 0.23606030
Al2O3 0.421188900 -0.07565293 -0.246849194 0.21698234 -0.02343739
Fe2O3 0.390695514 -0.08056159 -0.379459808 -0.01217779 0.01781972
MnO 0.202968915 0.02530627 -0.197563947 -0.45320605 0.08589399
CaO -0.007617152 -0.53592501 0.129453681 -0.30247140 0.02393190
K2O 0.380210637 0.11425399 0.362676533 0.09717752 -0.09117453
P2O5 -0.251698455 -0.43083317 0.042113664 0.02944146 -0.27069275
Zn -0.117681184 -0.29689598 -0.003297506 0.55025721 0.13528714
Rb 0.223455139 0.05723993 0.503231513 0.35139347 0.07007795
Sr -0.387294000 -0.26498558 0.070630126 0.02562327 0.09071156
Y 0.034089459 0.01091164 -0.116833215 0.17264412 -0.88704064
Zr -0.343753287 0.33353440 -0.195096651 -0.08335144 -0.17231994
PC6 PC7 PC8 PC9 PC10
SiO2 0.113308932 -0.04470476 -0.05073008 -0.37041761 4.963361e-02
TiO2 0.003060016 -0.36272570 -0.52581223 0.14521765 -2.137489e-01
Al2O3 -0.216861397 0.05138924 0.39194745 0.29773929 1.332253e-01
Fe2O3 0.112567053 -0.15868051 0.15920163 -0.23636872 2.970910e-01
MnO 0.734978594 -0.12043571 0.05187283 -0.04502846 -2.081833e-01
CaO 0.021301671 0.22014955 -0.47240375 0.25690336 8.055958e-02
K2O 0.068108005 -0.32142176 -0.12069563 0.19304751 3.643707e-05
P2O5 -0.059937121 -0.41420899 0.37702165 -0.09661436 -5.397738e-01
Zn 0.451446500 0.50410447 0.17117728 -0.07916747 -3.302114e-02
Rb 0.287773893 -0.20166923 -0.04071785 0.21816160 -6.915016e-02
Sr 0.171795951 -0.44400405 0.13094718 0.05455825 6.881066e-01
Y 0.176424242 0.04871076 -0.26495218 -0.12192334 1.586272e-01
Zr 0.176963116 0.08034573 0.20274297 0.71473864 -1.115799e-02
PC11 PC12 PC13
SiO2 -0.02998345 -0.04081993 0.7108142486
TiO2 0.05332852 0.04393760 -0.0003082342
Al2O3 0.21781602 0.36878497 0.4638696164
Fe2O3 -0.52144017 -0.46312884 0.0519020184
MnO 0.20721097 0.24257349 0.0426961389
CaO -0.15516321 -0.09445859 0.4757460457
K2O 0.47881441 -0.54672576 0.0716773212
P2O5 -0.07928737 -0.11187194 0.1957473021
Zn 0.16882206 -0.23126235 -0.0184246274
Rb -0.53099878 0.32420980 -0.0238954116
Sr 0.16654029 0.12349806 -0.0515445260
Y 0.02370491 0.15440161 -0.0171509064
Zr -0.18866235 -0.26275072 0.0374274510# Eigenwerte der Hauptkomponenten
summary(myPr)Importance of components:
PC1 PC2 PC3 PC4 PC5 PC6 PC7
Standard deviation 1.9443 1.6053 1.3855 1.07725 1.05500 0.95247 0.75135
Proportion of Variance 0.2908 0.1982 0.1477 0.08927 0.08562 0.06978 0.04342
Cumulative Proportion 0.2908 0.4890 0.6367 0.72594 0.81156 0.88134 0.92477
PC8 PC9 PC10 PC11 PC12 PC13
Standard deviation 0.52176 0.43137 0.41779 0.40990 0.34180 0.24563
Proportion of Variance 0.02094 0.01431 0.01343 0.01292 0.00899 0.00464
Cumulative Proportion 0.94571 0.96002 0.97345 0.98637 0.99536 1.00000# Screeplot der Eigenwerte
plot(myPr, type="l")
# Kombinieren der ursprünglichen Daten mit den ersten drei Hauptkomponenten
PCdata1 <- cbind(data,myPr$x[,1:3])
# Speichern als CSV
write.csv(PCdata1,"../Daten//Kap_6//Kap_6.3//Grundlagen//Zusammenschau//PCA_All.csv",row.names=FALSE)7.2.2 Berechnen der Camargo-Teststatistik
# Daten einlesen und filtern
data<-read.csv("../Daten//Kap_6//Kap_6.3//Grundlagen//Zusammenschau//Daten_log10_MW.csv")
data10<-data[,c(2:6,8:10,13,17),]
# Berechnung der Varianz für alle numerischen Spalten
data10 %>% summarise_if(is.numeric, var) SiO2 TiO2 Al2O3 Fe2O3 MnO CaO K2O
1 0.004470855 0.00926577 0.008087703 0.01653196 0.09551657 0.1114913 0.02279685
P2O5 Zn Zr
1 0.1921297 0.02827962 0.0152504# Durchführen des Camargo-Tests mit Hauptkomponentenanalyse (PCA)
result <- PCAtest(
data10, # Eingabedaten
1000, # Anzahl der Permutationen
1000, # Anzahl der Bootstrap-Resamples
0.05, # Signifikanzniveau
varcorr = FALSE, # Keine Korrektur für Variablenkorrelationen anwenden
counter = FALSE, # Keine Zählvariable für Iterationen anzeigen
plot = TRUE # Ergebnisse grafisch darstellen
)
Sampling bootstrap replicates... Please wait
Calculating confidence intervals of empirical statistics... Please wait
Sampling random permutations... Please wait
Comparing empirical statistics with their null distributions... Please wait
========================================================
Test of PCA significance: 10 variables, 738 observations
1000 bootstrap replicates, 1000 random permutations
========================================================
Empirical Psi = 10.0630, Max null Psi = 0.2224, Min null Psi = 0.0577, p-value = 0
Empirical Phi = 0.3344, Max null Phi = 0.0497, Min null Phi = 0.0253, p-value = 0
Empirical eigenvalue #1 = 3.23027, Max null eigenvalue = 1.31117, p-value = 0
Empirical eigenvalue #2 = 2.28856, Max null eigenvalue = 1.21532, p-value = 0
Empirical eigenvalue #3 = 1.56685, Max null eigenvalue = 1.14391, p-value = 0
Empirical eigenvalue #4 = 1.01784, Max null eigenvalue = 1.11085, p-value = 0.971
Empirical eigenvalue #5 = 0.7389, Max null eigenvalue = 1.06644, p-value = 1
Empirical eigenvalue #6 = 0.41475, Max null eigenvalue = 1.02572, p-value = 1
Empirical eigenvalue #7 = 0.34791, Max null eigenvalue = 0.98796, p-value = 1
Empirical eigenvalue #8 = 0.19319, Max null eigenvalue = 0.95469, p-value = 1
Empirical eigenvalue #9 = 0.14076, Max null eigenvalue = 0.93229, p-value = 1
Empirical eigenvalue #10 = 0.06097, Max null eigenvalue = 0.895, p-value = 1
PC 1 is significant and accounts for 32.3% (95%-CI:31.1-33.8) of the total variation
PC 2 is significant and accounts for 22.9% (95%-CI:21.5-24.4) of the total variation
PC 3 is significant and accounts for 15.7% (95%-CI:14.6-16.8) of the total variation
The first 3 PC axes are significant and account for 70.9% of the total variation
Variables 1, 3, 4, 5, 7, and 10 have significant loadings on PC 1
Variables 1, 6, 8, and 9 have significant loadings on PC 2
Variables 2, and 7 have significant loadings on PC 37.2.3 Abbildung Loadings
# Diagramme erstellen
barplot(myPr$rotation[,1], main="PC 1 Loadings Plot", las=2) # Loadings der spezifizierten Hauptkomponente
barplot(myPr$rotation[,2], main="PC 2 Loadings Plot", las=2)
barplot(myPr$rotation[,3], main="PC 3 Loadings Plot", las=2)
7.2.4 Abbildung Scorewerte
# Daten einlesen
data1<-read.csv("../Daten//Kap_6//Kap_6.3//Grundlagen//Zusammenschau//PCA_All.csv")
# Daten nach ausgewählter Spalte sortieren und in data.table umwandeln
data2 <- setDT(data1)[order(-PC1)]
# Berechnung der Zeilenanzahl
num_rows = nrow(data2)
# Erstellen einer ID-Spalte mit aufsteigenden Werten
ID_PC1 <- c(1:num_rows)
# Spaltenweise Kombination von Dataframes
data3 <- cbind(ID_PC1, data2)
# Diagramme erstellen
Score_PC1<-ggplot(data3, aes(x=ID_PC1,y=PC1, color=Fundort, shape=Kultur))+
geom_point(aes(shape=Kultur),size=2)+scale_shape_manual(values=c(0,2,1))+ # Manuelle Definition von Größe und Form der Symbole
scale_color_manual(name="Fundort",values=c("cyan4","paleturquoise","grey70"))+ # Manuelle Definition der Farbe der Symbole
xlab("Zeilennummer")+ylab("Scorewerte der ersten Hauptkomponente")+ # Manuelle Achsenbeschriftung
theme_classic()+ # Klassisches Design
theme(axis.line=element_line(colour="black",size=0.25))+theme(legend.title=element_blank(),legend.text=element_text(size=8),axis.title=element_text(size=9),axis.text=element_text(size=8,color="black"))+theme(legend.position="bottom")+theme(axis.ticks=element_line(size=0.25,colour="black"))+ # Manuelle Formatierung von Achsen- und Legendendarstellung
geom_hline(yintercept=0,size=0.25) # Horizontale 0-Linie einfügen
data2 <- setDT(data1)[order(-PC2)]
num_rows = nrow(data2)
ID_PC2 <- c(1:num_rows)
data3 <- cbind(ID_PC2, data2)
Score_PC2<-ggplot(data3, aes(x=ID_PC2,y=PC2, color=Fundort, shape=Kultur))+
geom_point(aes(shape=Kultur),size=2)+scale_shape_manual(values=c(0,2,1))+
scale_color_manual(name="Fundort",values=c("cyan4","paleturquoise","grey70"))+
xlab("Zeilennummer")+ylab("Scorewerte der zweiten Hauptkomponente")+
theme_classic()+
theme(axis.line=element_line(colour="black",size=0.25))+theme(legend.title=element_blank(),legend.text=element_text(size=8),axis.title=element_text(size=9),axis.text=element_text(size=8,color="black"))+theme(legend.position="bottom")+theme(axis.ticks=element_line(size=0.25,colour="black"))+
geom_hline(yintercept=0,size=0.25)
data2 <- setDT(data1)[order(-PC3)]
num_rows = nrow(data2)
ID_PC3 <- c(1:num_rows)
data3 <- cbind(ID_PC3, data2)
Score_PC3<-ggplot(data3, aes(x=ID_PC3,y=PC3, color=Fundort, shape=Kultur))+
geom_point(aes(shape=Kultur),size=2)+scale_shape_manual(values=c(0,2,1))+
scale_color_manual(name="Fundort",values=c("cyan4","paleturquoise","grey70"))+
xlab("Zeilennummer")+ylab("Scorewerte der dritten Hauptkomponente")+
theme_classic()+
theme(axis.line=element_line(colour="black",size=0.25))+theme(legend.title=element_blank(),legend.text=element_text(size=8),axis.title=element_text(size=9),axis.text=element_text(size=8,color="black"))+theme(legend.position="bottom")+theme(axis.ticks=element_line(size=0.25,colour="black"))+
geom_hline(yintercept=0,size=0.25)
# Kombination der Diagramme
ggarrange(Score_PC1,Score_PC2,Score_PC3,ncol=2,nrow=2,align = "v",common.legend = TRUE)+theme(legend.position="bottom")
7.2.5 Abbildung Streudiagramm
# Daten einlesen
data<-read.csv("../Daten//Kap_6//Kap_6.3//Grundlagen//Zusammenschau//PCA_All.csv")
# Diagramme erstellen
PCA1_2<-autoplot(myPr, data = data, colour = 'Fundort', shape='Kultur',loadings.colour = 'black', loadings.label = TRUE, loadings.label.size = 3,loadings = TRUE)+
scale_shape_manual(values=c(0,2,1))+ # Manuelle Definition der Form der Symbole
scale_color_manual(name="Fundort",values=c("cyan4","paleturquoise","grey70"))+ # Manuelle Definition der Farbe der Symbole
theme_classic()+ # Klassisches Design
theme(axis.line=element_line(colour="black",size=0.25))+theme(legend.title=element_blank(),legend.text=element_text(size=8),axis.title=element_text(size=9),axis.text=element_text(size=8,color="black"))+theme(legend.position="bottom")+theme(axis.ticks=element_line(size=0.25,colour="black"))+ # Manuelle Formatierung von Achsen- und Legendendarstellung
geom_vline(xintercept=0, color="black", size=0.25)+geom_hline(yintercept=0, color="black", size=0.25) # Horizontale und vertikale 0-Linie einfügen
PCA1_3<-autoplot(myPr, x=1, y=3,data = data, colour = 'Fundort', shape='Kultur',loadings.colour = 'black',loadings.label = TRUE, loadings.label.size = 3,loadings = TRUE)+
scale_shape_manual(values=c(0,2,1))+
scale_color_manual(name="Fundort",values=c("cyan4","paleturquoise","grey70"))+
theme_classic()+
theme(axis.line=element_line(colour="black",size=0.25))+theme(legend.title=element_blank(),legend.text=element_text(size=8),axis.title=element_text(size=9),axis.text=element_text(size=8,color="black"))+theme(legend.position="bottom")+theme(axis.ticks=element_line(size=0.25,colour="black"))+
geom_vline(xintercept=0, color="black", size=0.25)+geom_hline(yintercept=0, color="black", size=0.25)
PCA2_3<-autoplot(myPr, x=2, y=3,data = data, colour = 'Fundort', shape='Kultur',loadings.colour = 'black',loadings.label = TRUE, loadings.label.size = 3,loadings = TRUE)+
scale_shape_manual(values=c(0,2,1))+
scale_color_manual(name="Fundort",values=c("cyan4","paleturquoise","grey70"))+
theme_classic()+
theme(axis.line=element_line(colour="black",size=0.25))+theme(legend.title=element_blank(),legend.text=element_text(size=8),axis.title=element_text(size=9),axis.text=element_text(size=8,color="black"))+theme(legend.position="bottom")+theme(axis.ticks=element_line(size=0.25,colour="black"))+
geom_vline(xintercept=0, color="black", size=0.25)+geom_hline(yintercept=0, color="black", size=0.25)
# Kombination der Diagramme
ggarrange(PCA1_2,PCA1_3,PCA2_3,ncol=1,nrow=3,align="v",common.legend=TRUE)+theme(legend.position="bottom")
7.3 Clusteranalyse
7.3.1 Berechnung der Kmean-Clusteranalyse
# Daten einlesen und filtern
data1<-read.csv("../Daten//Kap_6//Kap_6.3//Grundlagen//Zusammenschau//Daten_log10_MW.csv")
data2<-data1[,c(2:6,8:10,13:17),]
# Zeilennamen der neuen Datenmenge mit den Probennummern aus der Originaldatei setzen
rownames(data2) <- data1$Probennummer
# Berechnung der Zeilenanzahl
n<-nrow(data2)
# Zufallszahlengenerator initialisieren
set.seed(123)
# Distanzmatrix berechnen
distance <- get_dist(data2)
# Distanzmatrix mit Farbverlauf visualisieren
fviz_dist(distance, gradient = list(low = "#00AFBB", mid = "white", high = "#FC4E07"))
# Optimale Anzahl an Clustern mit der "Within Sum of Squares" (WSS)-Methode bestimmen
fviz_nbclust(data2, kmeans, method = "wss")
7.3.2 Berechnung unter Vorgabe von 3 Clustern
# Zufallszahlengenerator initialisieren
set.seed(123)
# K-Means Clustering mit 3 Clustern und maximal 100 Iterationen
km.res3<-kmeans(data2,3,100)
# Clustering-Ergebnis in Scatterplot darstellen
fviz_cluster(km.res3, data = data2)
# Cluster-Labels zuweisen und Mittelwerte je Cluster berechnen
data2 %>%
mutate(Cluster = km.res3$cluster) %>% # Cluster-Labels hinzufügen
group_by(Cluster) %>% # Nach Cluster gruppieren
summarise_all("mean") # Mittelwert berechnen# A tibble: 3 × 14
Cluster SiO2 TiO2 Al2O3 Fe2O3 MnO CaO K2O P2O5 Zn Rb Sr
<int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 1 1.67 -0.0736 1.30 0.853 -1.07 0.973 0.361 0.872 2.02 1.89 2.15
2 2 1.77 -0.0127 1.35 0.910 -0.989 0.191 0.455 0.0989 1.92 1.93 1.83
3 3 1.79 0.0219 1.25 0.782 -1.21 0.334 0.299 0.820 2.01 1.87 2.32
# ℹ 2 more variables: Y <dbl>, Zr <dbl>7.3.3 Zusammenstellen Tabelle
# Spalten zu data2 hinzufügen
data3 <- cbind(data2,
cluster = km.res3$cluster, # Cluster-Zuordnung aus der K-Means-Analyse
Kultur = data1$Kultur, # Kultur, Probennummer und Fundort aus data1
Probennummer = data1$Probennummer,
Fundort = data1$Fundort)
# Pivot-Tabelle erstellen: Anzahl der Beobachtungen pro Kombination von "Fundort" und "cluster"
Tab_objekt<-qhpvt(data=data3, "Fundort", "cluster", "n()")
# Tabelle anzeigen
Tab_objekt7.3.4 Grafik Cluster der Clusteranalyse
Die Variable myPr stammt aus der Berechnung der Hauptkomponentenanalyse.
# Definieren von Spalte cluster als Zeichenvektor
data3$cluster <- as.character(data3$cluster)
# Diagramm erstellen
autoplot(myPr, data = data3, colour = 'cluster',loadings.colour = 'black', loadings.label = TRUE, loadings.label.size = 3,loadings = TRUE)+
geom_point(aes(shape=Kultur),size=2)+ scale_shape_manual(values=c(0,2,1))+ # Manuelle Definition von Größe und Form der Symbole
scale_color_manual(name="cluster",values=c("orange","#FCCDE5","purple2","darkred","#CCEBC5"))+ # Manuelle Definition der Farbe der Symbole
theme_classic()+ # Klassisches Design
theme(axis.line=element_line(colour="black",size=0.25))+theme(legend.title=element_blank(),legend.text=element_text(size=8),axis.title=element_text(size=9),axis.text=element_text(size=8,color="black"))+theme(legend.position="bottom")+theme(axis.ticks=element_line(size=0.25,colour="black"))+ # Manuelle Formatierung von Achsen- und Legendendarstellung
geom_vline(xintercept=0, color="black", size=0.25)+geom_hline(yintercept=0, color="black", size=0.25) # Horizontale und vertikale 0-Linie einfügen
7.3.5 Grafik Fundorte basierend auf Clusteranalyse
# Daten einlesen und filtern
data1<-read.csv("../Daten//Kap_6//Kap_6.3//Grundlagen//Zusammenschau//PCA_All.csv")
data1<-subset(data1, Kultur %in% c("La Hoguette","LBK","Huettenlehm"))
data1<-subset(data1, Fundort %in% c("Friedberg-Bruchenbruecken","Rottenburg-Hailfingen 'Unter dem Tuebinger Weg'","Rottenburg 'Froebelweg'"))
data4<-data3[,c(14,16),]
# Kombinieren mehrerer Dataframes basierend auf der Probennummer
data<-merge(data1,data4, by="Probennummer", all=TRUE)
# Diagramm erstellen
autoplot(myPr, data = data, colour = 'Fundort',loadings.colour = 'black', loadings.label = TRUE, loadings.label.size = 3,loadings = TRUE)+
geom_point(aes(shape=Kultur),size=2)+ scale_shape_manual(values=c(0,2,1))+ # Manuelle Definition von Größe und Form der Symbole
scale_color_manual(name="Fundort",values=c("cyan4","paleturquoise","grey70"))+ # Manuelle Definition der Farbe der Symbole
theme_classic()+ # Klassisches Design
theme(axis.line=element_line(colour="black",size=0.25))+theme(legend.title=element_blank(),legend.text=element_text(size=8),axis.title=element_text(size=9),axis.text=element_text(size=8,color="black"))+theme(legend.position="bottom")+theme(axis.ticks=element_line(size=0.25,colour="black"))+ # Manuelle Formatierung von Achsen- und Legendendarstellung
geom_vline(xintercept=0, color="black", size=0.25)+geom_hline(yintercept=0, color="black", size=0.25) # Horizontale und vertikale 0-Linie einfügen
8 Abb. 6-166 - Diskriminanzanalyse
8.1 Abb. 6-166_1 - Alle Daten
8.1.1 Berechnen und Zusammenstellen der DA-Daten
# Daten einlesen
data<-read.csv("../Daten//Kap_6//Kap_6.3//Grundlagen//Zusammenschau//Daten_log10_MW.csv")
# Durchführen der Diskriminanzanalyse für ausgewählte Spalten
DAModel.1 <- lda(Fundort~SiO2+TiO2+Al2O3+Fe2O3+MnO+CaO+K2O+P2O5+Zn+Rb+Sr+Y+Zr, data=data)
# Visualisierung der LDA-Ergebnisse
DAModel.1Call:
lda(Fundort ~ SiO2 + TiO2 + Al2O3 + Fe2O3 + MnO + CaO + K2O +
P2O5 + Zn + Rb + Sr + Y + Zr, data = data)
Prior probabilities of groups:
Friedberg-Bruchenbruecken
0.4444444
Rottenburg-Hailfingen 'Unter dem Tuebinger Weg'
0.1517615
Rottenburg 'Froebelweg'
0.4037940
Group means:
SiO2 TiO2 Al2O3
Friedberg-Bruchenbruecken 1.795328 0.02732530 1.230594
Rottenburg-Hailfingen 'Unter dem Tuebinger Weg' 1.730948 -0.06515613 1.318664
Rottenburg 'Froebelweg' 1.735337 -0.02821724 1.360097
Fe2O3 MnO CaO
Friedberg-Bruchenbruecken 0.7607140 -1.2120386 0.3956924
Rottenburg-Hailfingen 'Unter dem Tuebinger Weg' 0.8634984 -1.1660714 0.4525822
Rottenburg 'Froebelweg' 0.9211605 -0.9701821 0.4097738
K2O P2O5 Zn
Friedberg-Bruchenbruecken 0.2676947 0.8040267 2.053487
Rottenburg-Hailfingen 'Unter dem Tuebinger Weg' 0.4662326 0.8074849 1.896257
Rottenburg 'Froebelweg' 0.4369602 0.2411274 1.926600
Rb Sr Y
Friedberg-Bruchenbruecken 1.868872 2.343508 1.552607
Rottenburg-Hailfingen 'Unter dem Tuebinger Weg' 1.934449 2.146041 1.564920
Rottenburg 'Froebelweg' 1.913870 1.847012 1.559380
Zr
Friedberg-Bruchenbruecken 2.523050
Rottenburg-Hailfingen 'Unter dem Tuebinger Weg' 2.372113
Rottenburg 'Froebelweg' 2.420520
Coefficients of linear discriminants:
LD1 LD2
SiO2 -1.93848051 2.8496503
TiO2 -4.62613215 6.1128757
Al2O3 12.56287875 1.0343451
Fe2O3 0.76533830 -2.9775085
MnO 0.65878810 0.6369239
CaO 3.66665395 2.4306872
K2O 1.60563780 -3.1175062
P2O5 -1.88379452 -1.5673930
Zn -2.16532221 2.4538712
Rb -0.01756994 2.3463984
Sr -5.35316650 -2.2018173
Y -0.84518898 -0.3257855
Zr 4.65204084 5.4738371
Proportion of trace:
LD1 LD2
0.9358 0.0642 plot(DAModel.1)
# Erstellen einer Konfusionsmatrix zur Bewertung der Klassifikationsgüte
confusion(data$Fundort[], predict(DAModel.1)$class) True
Predicted Friedberg-Bruchenbruecken
Friedberg-Bruchenbruecken 322
Rottenburg-Hailfingen 'Unter dem Tuebinger Weg' 4
Rottenburg 'Froebelweg' 2
Total 328
Correct 322
True
Predicted Rottenburg-Hailfingen 'Unter dem Tuebinger Weg'
Friedberg-Bruchenbruecken 10
Rottenburg-Hailfingen 'Unter dem Tuebinger Weg' 98
Rottenburg 'Froebelweg' 4
Total 112
Correct 98
True
Predicted Rottenburg 'Froebelweg'
Friedberg-Bruchenbruecken 0
Rottenburg-Hailfingen 'Unter dem Tuebinger Weg' 3
Rottenburg 'Froebelweg' 295
Total 298
Correct 295
Proportions correct
Friedberg-Bruchenbruecken
0.9817073
Rottenburg-Hailfingen 'Unter dem Tuebinger Weg'
0.8750000
Rottenburg 'Froebelweg'
0.9899329
N correct/N total = 715/738 = 0.9688347# Vorhersage der Zuordnung zu den chemischen Rezepturen basierend auf der DA
da_prediction <- predict(DAModel.1)
# Kombinieren der ursprünglichen Daten mit den ersten beiden Diskriminanzfunktionen
DAdata1 <- cbind(data,da_prediction$x[,1:2])
# Speichern als CSV
write.csv(DAdata1,"../Daten//Kap_6//Kap_6.3//Grundlagen//Zusammenschau//DA_All.csv",row.names=FALSE)8.1.2 Jackknifing
# Vergleich der vorhergesagten Zuordnung mit der tatsächlichen Zuordnung nach Fundort
confusion(data$Fundort, lda(Fundort~SiO2+TiO2+Al2O3+Fe2O3+MnO+CaO+K2O+P2O5+Zn+Rb+Sr+Y+Zr, data=data,CV=TRUE)$class) True
Predicted Friedberg-Bruchenbruecken
Friedberg-Bruchenbruecken 322
Rottenburg-Hailfingen 'Unter dem Tuebinger Weg' 4
Rottenburg 'Froebelweg' 2
Total 328
Correct 322
True
Predicted Rottenburg-Hailfingen 'Unter dem Tuebinger Weg'
Friedberg-Bruchenbruecken 12
Rottenburg-Hailfingen 'Unter dem Tuebinger Weg' 96
Rottenburg 'Froebelweg' 4
Total 112
Correct 96
True
Predicted Rottenburg 'Froebelweg'
Friedberg-Bruchenbruecken 0
Rottenburg-Hailfingen 'Unter dem Tuebinger Weg' 3
Rottenburg 'Froebelweg' 295
Total 298
Correct 295
Proportions correct
Friedberg-Bruchenbruecken
0.9817073
Rottenburg-Hailfingen 'Unter dem Tuebinger Weg'
0.8571429
Rottenburg 'Froebelweg'
0.9899329
N correct/N total = 713/738 = 0.96612478.1.3 PressQ-Statistik
# Berechnen der PressQ-Statistisk
# 737: Gesamtanzahl der Beobachtungen oder ein Gesamtwert
# 373: Durch Diskriminanzanalyse korrekt zugewiesene Objekte
# 3: Anzahl der Gruppen in der Analyse
PressQ<-((373-(714*3))^2)/(737*(3-1))
PressQ[1] 2123.048.1.4 Abbildung Loadings
barplot(DAModel.1$scaling[,1], main="LDA 1 Loadings Plot", las=2)
barplot(DAModel.1$scaling[,2], main="LDA 2 Loadings Plot", las=2)
8.1.5 Abbildung Scorewerte
# Daten einlesen
data1<-read.csv("../Daten//Kap_6//Kap_6.3//Grundlagen//Zusammenschau//DA_All.csv")
# Daten nach ausgewählter Spalte sortieren und in data.table umwandeln
data2 <- setDT(data1)[order(-LD1)]
# Berechnung der Zeilenanzahl
num_rows = nrow(data2)
# Erstellen einer ID-Spalte mit aufsteigenden Werten
ID_LD1 <- c(1:num_rows)
# Spaltenweise Kombination von Dataframes
data3 <- cbind(ID_LD1, data2)
# Diagramme erstellen
Score_LD1<-ggplot(data3, aes(x=ID_LD1,y=LD1, color=Fundort, shape=Kultur))+
geom_point(aes(shape=Kultur),size=2)+scale_shape_manual(values=c(0,2,1))+ # Manuelle Definition von Größe und Form der Symbole
scale_color_manual(name="Fundort",values=c("cyan4","paleturquoise","grey70"))+ # Manuelle Definition der Farbe der Symbole
xlab("Zeilennummer")+ylab("Scorewerte der ersten Diskriminanzfunktion")+ # Manuelle Achsenbeschriftung
theme_classic()+ # Klassisches Design
theme(axis.line=element_line(colour="black",size=0.25))+theme(legend.title=element_blank(),legend.text=element_text(size=8),axis.title=element_text(size=9),axis.text=element_text(size=8,color="black"))+theme(legend.position="bottom")+theme(axis.ticks=element_line(size=0.25,colour="black"))+ # Manuelle Formatierung von Achsen- und Legendendarstellung
geom_hline(yintercept=0,size=0.25) # Horizontale 0-Linie einfügen
data2 <- setDT(data1)[order(-LD2)]
num_rows = nrow(data2)
ID_LD2 <- c(1:num_rows)
data3 <- cbind(ID_LD2, data2)
Score_LD2<-ggplot(data3, aes(x=ID_LD2,y=LD2, color=Fundort, shape=Kultur))+
geom_point(aes(shape=Kultur),size=2)+scale_shape_manual(values=c(0,2,1))+
scale_color_manual(name="Fundort",values=c("cyan4","paleturquoise","grey70"))+
xlab("Zeilennummer")+ylab("Scorewerte der zweiten Diskriminanzfunktion")+
theme_classic()+
theme(axis.line=element_line(colour="black",size=0.25))+
theme(legend.title=element_blank(),legend.text=element_text(size=8),axis.title=element_text(size=9),axis.text=element_text(size=8,color="black"))+theme(legend.position="bottom")+theme(axis.ticks=element_line(size=0.25,colour="black"))+
geom_hline(yintercept=0,size=0.25)
# Kombination der Diagramme
ggarrange(Score_LD1,Score_LD2,ncol=2,nrow=1,common.legend = TRUE)+theme(legend.position="bottom")
8.1.6 Erstellen Abb. 6-166_1
# Daten einlesen
data<-read.csv("../Daten//Kap_6//Kap_6.3//Grundlagen//Zusammenschau//Daten_log10_MW.csv")
# Erstellen eines Dataframes mit Variablennamen und Koeffizienten des Diskriminanzanalyse-Modells
data.da <- data.frame(varnames=rownames(coef(DAModel.1)), coef(DAModel.1))
# Setzen der Vektorlänge für die spätere Skalierung
rad <- 3.5
# Berechnung der Länge der Vektoren basierend auf LD1 und LD2
data.da$length <- with(data.da, sqrt(LD1^2+LD2^2))
# Berechnung des Winkels der Vektoren im 2D-Raum
data.da$angle <- atan2(data.da$LD1, data.da$LD2)
# Setzen der Startpunkte aller Vektoren auf (0,0)
data.da$x_start <- data.da$y_start <- 0
# Berechnung der Endpunkte der Vektoren mit der Länge 'rad'
data.da$x_end <- cos(data.da$angle) * rad
data.da$y_end <- sin(data.da$angle) * rad
# Diagramm erstellen
Abb.6.166_1<-ggplot(cbind(data, da_prediction$x), aes(y = LD2, x = LD1, colour = Fundort))+
geom_text(aes(y = y_end, x = x_end, label = varnames),data.da, size = 4, vjust = .5, hjust = 0, colour = "black")+ # Beschriftung der Endpunkte der Vektoren (Variablennamen)
geom_spoke(aes(x_start, y_start, angle = angle),data.da, color = "black",radius = rad) + # Zeichnen der Vektoren
geom_point(aes(shape=Kultur),size=2)+scale_shape_manual(values=c(0,2,1))+ # Manuelle Definition von Größe und Form der Symbole
scale_color_manual(name="Fundort",values=c("cyan4","paleturquoise","grey70"))+ # Manuelle Definition der Farbe der Symbole
xlab("LD 1")+ylab("LD 2")+ # Manuelle Achsenbeschriftung
theme_classic()+ # Klassisches Design
theme(axis.line=element_line(colour="black",size=0.25))+theme(legend.title=element_blank(),legend.text=element_text(size=8),axis.title=element_text(size=9),axis.text=element_text(size=8,color="black"))+theme(legend.position="bottom")+theme(axis.ticks=element_line(size=0.25,colour="black"))+geom_hline(yintercept=0,size=0.25)+# Manuelle Formatierung von Achsen- und Legendendarstellung
geom_hline(yintercept = 0, size = .2)+geom_vline(xintercept = 0, size = .2) # Horizontale und vertikale 0-Linie einfügen
# Diagramm dRstellen
Abb.6.166_1
# Export des Diagramms
ggsave("Abb.6-166_1.eps",path=("../Daten//Kap_6//Kap_6.3//Abbildungen//Zusammenschau//"),plot=last_plot(),device="eps",height=11,width=17.5,unit=c("cm"),dpi=1200)8.2 Abb. 6-166_2 - Bandkeramik
8.2.1 Berechnen und Zusammenstellen der DA-Daten
# Daten einlesen und filtern
data1<-read.csv("../Daten//Kap_6//Kap_6.3//Grundlagen//Zusammenschau//Daten_log10_MW.csv")
data<-subset(data1, Kultur %in% c("LBK"))
# Durchführen der Diskriminanzanalyse für ausgewählte Spalten
DAModel.1 <- lda(Fundort~SiO2+TiO2+Al2O3+Fe2O3+MnO+CaO+K2O+P2O5+Zn+Rb+Sr+Y+Zr, data=data)
# Visualisierung der LDA-Ergebnisse
DAModel.1Call:
lda(Fundort ~ SiO2 + TiO2 + Al2O3 + Fe2O3 + MnO + CaO + K2O +
P2O5 + Zn + Rb + Sr + Y + Zr, data = data)
Prior probabilities of groups:
Friedberg-Bruchenbruecken
0.5142857
Rottenburg-Hailfingen 'Unter dem Tuebinger Weg'
0.1119048
Rottenburg 'Froebelweg'
0.3738095
Group means:
SiO2 TiO2 Al2O3
Friedberg-Bruchenbruecken 1.797569 0.05207473 1.245850
Rottenburg-Hailfingen 'Unter dem Tuebinger Weg' 1.745710 -0.04693486 1.336518
Rottenburg 'Froebelweg' 1.774430 -0.01156085 1.351736
Fe2O3 MnO CaO
Friedberg-Bruchenbruecken 0.7882222 -1.2265560 0.3264114
Rottenburg-Hailfingen 'Unter dem Tuebinger Weg' 0.8463939 -1.2436755 0.1927346
Rottenburg 'Froebelweg' 0.9157390 -0.9242048 0.1657230
K2O P2O5 Zn
Friedberg-Bruchenbruecken 0.2476306 0.7962987 2.034831
Rottenburg-Hailfingen 'Unter dem Tuebinger Weg' 0.5136518 0.7673848 1.829343
Rottenburg 'Froebelweg' 0.4250095 -0.0178310 1.869192
Rb Sr Y
Friedberg-Bruchenbruecken 1.853178 2.341734 1.560104
Rottenburg-Hailfingen 'Unter dem Tuebinger Weg' 1.940371 2.094051 1.576405
Rottenburg 'Froebelweg' 1.893747 1.805864 1.544167
Zr
Friedberg-Bruchenbruecken 2.530327
Rottenburg-Hailfingen 'Unter dem Tuebinger Weg' 2.411314
Rottenburg 'Froebelweg' 2.485311
Coefficients of linear discriminants:
LD1 LD2
SiO2 -8.7658477 21.1499052
TiO2 -3.8906846 2.5798116
Al2O3 8.2824305 6.5515495
Fe2O3 -0.5528075 0.4383785
MnO 0.7431668 0.5606392
CaO 3.8839737 3.4472826
K2O 4.3807397 -3.3137937
P2O5 -2.4436647 -1.8839046
Zn -1.7736175 1.6779993
Rb -2.0409733 -0.3011277
Sr -5.8179454 0.4371747
Y -2.4961723 -3.4442761
Zr 7.7742278 3.5851216
Proportion of trace:
LD1 LD2
0.9142 0.0858 plot(DAModel.1)
# Erstellen einer Konfusionsmatrix zur Bewertung der Klassifikationsgüte
confusion(data$Fundort[], predict(DAModel.1)$class) True
Predicted Friedberg-Bruchenbruecken
Friedberg-Bruchenbruecken 215
Rottenburg-Hailfingen 'Unter dem Tuebinger Weg' 0
Rottenburg 'Froebelweg' 1
Total 216
Correct 215
True
Predicted Rottenburg-Hailfingen 'Unter dem Tuebinger Weg'
Friedberg-Bruchenbruecken 10
Rottenburg-Hailfingen 'Unter dem Tuebinger Weg' 37
Rottenburg 'Froebelweg' 0
Total 47
Correct 37
True
Predicted Rottenburg 'Froebelweg'
Friedberg-Bruchenbruecken 0
Rottenburg-Hailfingen 'Unter dem Tuebinger Weg' 1
Rottenburg 'Froebelweg' 156
Total 157
Correct 156
Proportions correct
Friedberg-Bruchenbruecken
0.9953704
Rottenburg-Hailfingen 'Unter dem Tuebinger Weg'
0.7872340
Rottenburg 'Froebelweg'
0.9936306
N correct/N total = 408/420 = 0.9714286# Vorhersage der Zuordnung zu den chemischen Rezepturen basierend auf der DA
da_prediction <- predict(DAModel.1)
# Kombinieren der ursprünglichen Daten mit den ersten beiden Diskriminanzfunktionen
DAdata1 <- cbind(data,da_prediction$x[,1:2])
# Speichern als CSV
write.csv(DAdata1,"../Daten//Kap_6//Kap_6.3//Grundlagen//Zusammenschau//DA_LBK.csv",row.names=FALSE)8.2.2 Jackknifing
# Vergleich der vorhergesagten Zuordnung mit der tatsächlichen Zuordnung nach Fundort
confusion(data$Fundort, lda(Fundort~SiO2+TiO2+Al2O3+Fe2O3+MnO+CaO+K2O+P2O5+Zn+Rb+Sr+Y+Zr, data=data,CV=TRUE)$class) True
Predicted Friedberg-Bruchenbruecken
Friedberg-Bruchenbruecken 215
Rottenburg-Hailfingen 'Unter dem Tuebinger Weg' 0
Rottenburg 'Froebelweg' 1
Total 216
Correct 215
True
Predicted Rottenburg-Hailfingen 'Unter dem Tuebinger Weg'
Friedberg-Bruchenbruecken 10
Rottenburg-Hailfingen 'Unter dem Tuebinger Weg' 37
Rottenburg 'Froebelweg' 0
Total 47
Correct 37
True
Predicted Rottenburg 'Froebelweg'
Friedberg-Bruchenbruecken 0
Rottenburg-Hailfingen 'Unter dem Tuebinger Weg' 1
Rottenburg 'Froebelweg' 156
Total 157
Correct 156
Proportions correct
Friedberg-Bruchenbruecken
0.9953704
Rottenburg-Hailfingen 'Unter dem Tuebinger Weg'
0.7872340
Rottenburg 'Froebelweg'
0.9936306
N correct/N total = 408/420 = 0.97142868.2.3 PressQ-Statistik
# Berechnen der PressQ-Statistisk
# 420: Gesamtanzahl der Beobachtungen oder ein Gesamtwert
# 408: Durch Diskriminanzanalyse korrekt zugewiesene Objekte
# 3: Anzahl der Gruppen in der Analyse
PressQ<-((420-(408*3))^2)/(420*(3-1))
PressQ[1] 769.54298.2.4 MANOVA
# Daten einlesen und filtern
data1<-read.csv("../Daten//Kap_6//Kap_6.3//Grundlagen//Zusammenschau//Daten_log10_MW.csv")
data<-subset(data1, Kultur %in% c("LBK"))
# Durchführen der MANOVA für ausgewählte Spalten im Hinblick auf Fundort
manova<-manova(cbind(Al2O3,CaO,Fe2O3,K2O,MnO,P2O5,SiO2,TiO2,Zn,Rb,Sr,Y,Zr) ~ Fundort, data)
# Zusammenfassung der MANOVA mit Intercept
summary(manova,intercept=TRUE) Df Pillai approx F num Df den Df Pr(>F)
(Intercept) 1 0.99996 830944 13 405 < 2.2e-16 ***
Fundort 2 1.38042 70 26 812 < 2.2e-16 ***
Residuals 417
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# Anzeige der MANOVA-Ergebnisse mit Wilks-Lambda-Tests
summary(manova,test="Wilks",intercept=TRUE) Df Wilks approx F num Df den Df Pr(>F)
(Intercept) 1 0.000037 830944 13 405 < 2.2e-16 ***
Fundort 2 0.049469 109 26 810 < 2.2e-16 ***
Residuals 417
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 18.2.5 Abbildung Loadings
# Diagramme erstellen
barplot(DAModel.1$scaling[,1], main="LDA 1 Loadings Plot", las=2)
barplot(DAModel.1$scaling[,2], main="LDA 2 Loadings Plot", las=2)
8.2.6 Abbildung Scorewerte
# Daten einlesen
data1<-read.csv("../Daten//Kap_6//Kap_6.3//Grundlagen//Zusammenschau//DA_LBK.csv")
# Daten nach ausgewählter Spalte sortieren und in data.table umwandeln
data2 <- setDT(data1)[order(-LD1)]
# Berechnung der Zeilenanzahl
num_rows = nrow(data2)
# Erstellen einer ID-Spalte mit aufsteigenden Werten
ID_LD1 <- c(1:num_rows)
# Spaltenweise Kombination von Dataframes
data3 <- cbind(ID_LD1, data2)
# Diagramme erstellen
Score_LD1<-ggplot(data3, aes(x=ID_LD1,y=LD1, color=Fundort, shape=Kultur))+
geom_point(aes(shape=Kultur),size=2)+scale_shape_manual(values=c(1))+ # Manuelle Definition von Größe und Form der Symbole
scale_color_manual(name="Fundort",values=c("cyan4","paleturquoise","grey70"))+ # Manuelle Definition der Farbe der Symbole
xlab("Zeilennummer")+ylab("Scorewerte der ersten Diskriminanzfunktion")+ # Manuelle Achsenbeschriftung
theme_classic()+ # Klassisches Design
theme(axis.line=element_line(colour="black",size=0.25))+theme(legend.title=element_blank(),legend.text=element_text(size=8),axis.title=element_text(size=9),axis.text=element_text(size=8,color="black"))+theme(legend.position="bottom")+theme(axis.ticks=element_line(size=0.25,colour="black"))+ # Manuelle Formatierung von Achsen- und Legendendarstellung
geom_hline(yintercept=0,size=0.25) # Horizontale 0-Linie einfügen
data2 <- setDT(data1)[order(-LD2)]
num_rows = nrow(data2)
ID_LD2 <- c(1:num_rows)
data3 <- cbind(ID_LD2, data2)
Score_LD2<-ggplot(data3, aes(x=ID_LD2,y=LD2, color=Fundort, shape=Kultur))+
geom_point(aes(shape=Kultur),size=2)+scale_shape_manual(values=c(1))+
scale_color_manual(name="Fundort",values=c("cyan4","paleturquoise","grey70"))+
xlab("Zeilennummer")+ylab("Scorewerte der zweiten Diskriminanzfunktion")+
theme_classic()+
theme(axis.line=element_line(colour="black",size=0.25))+
theme(legend.title=element_blank(),legend.text=element_text(size=8),axis.title=element_text(size=9),axis.text=element_text(size=8,color="black"))+theme(legend.position="bottom")+theme(axis.ticks=element_line(size=0.25,colour="black"))+
geom_hline(yintercept=0,size=0.25)
# Kombination der Diagramme
ggarrange(Score_LD1,Score_LD2,ncol=2,nrow=1,common.legend = TRUE)+theme(legend.position="bottom")
8.2.7 Erstellen Abb. 6-166_2
# Daten einlesen und filtern
data1<-read.csv("../Daten//Kap_6//Kap_6.3//Grundlagen//Zusammenschau//Daten_log10_MW.csv")
data<-subset(data1, Kultur %in% c("LBK"))
# Erstellen eines Dataframes mit Variablennamen und Koeffizienten des Diskriminanzanalyse-Modells
data.da <- data.frame(varnames=rownames(coef(DAModel.1)), coef(DAModel.1))
# Setzen der Vektorlänge für die spätere Skalierung
rad <- 3.5
# Berechnung der Länge der Vektoren basierend auf LD1 und LD2
data.da$length <- with(data.da, sqrt(LD1^2+LD2^2))
# Berechnung des Winkels der Vektoren im 2D-Raum
data.da$angle <- atan2(data.da$LD1, data.da$LD2)
# Setzen der Startpunkte aller Vektoren auf (0,0)
data.da$x_start <- data.da$y_start <- 0
# Berechnung der Endpunkte der Vektoren mit der Länge 'rad'
data.da$x_end <- cos(data.da$angle) * rad
data.da$y_end <- sin(data.da$angle) * rad
# Diagramm erstellen
Abb.6.166_2<-ggplot(cbind(data, da_prediction$x), aes(y = LD2, x = LD1, colour = Fundort))+
geom_text(aes(y = y_end, x = x_end, label = varnames),data.da, size = 4, vjust = .5, hjust = 0, colour = "black")+ # Beschriftung der Endpunkte der Vektoren (Variablennamen)
geom_spoke(aes(x_start, y_start, angle = angle),data.da, color = "black",radius = rad) + # Zeichnen der Vektoren
geom_point(aes(shape=Kultur),size=2)+ scale_shape_manual(values=c(1))+ # Manuelle Definition von Größe und Form der Symbole
scale_color_manual(name="Fundort",values=c("cyan4","paleturquoise","grey70"))+ # Manuelle Definition der Farbe der Symbole
xlab("LD 1")+ylab("LD 2")+ # Manuelle Achsenbeschriftung
theme_classic()+ # Klassisches Design
theme(axis.line=element_line(colour="black",size=0.25))+theme(legend.title=element_blank(),legend.text=element_text(size=8),axis.title=element_text(size=9),axis.text=element_text(size=8,color="black"))+theme(legend.position="bottom")+theme(axis.ticks=element_line(size=0.25,colour="black"))+ # Manuelle Formatierung von Achsen- und Legendendarstellung
geom_hline(yintercept = 0, size = .2)+geom_vline(xintercept = 0, size = .2) # Horizontale und vertikale 0-Linie einfügen
# Diagramm darstellen
Abb.6.166_2
# Export des Diagramms
ggsave("Abb.6-166_2.eps",path=("../Daten//Kap_6//Kap_6.3//Abbildungen//Zusammenschau//"),plot=last_plot(),device="eps",height=11,width=17.5,unit=c("cm"),dpi=1200)8.3 Abb. 6-166_3 - La Hoguette
8.3.1 Berechnen und Zusammenstellen der DA-Daten
# Daten einlesen und filtern
data1<-read.csv("../Daten//Kap_6//Kap_6.3//Grundlagen//Zusammenschau//Daten_log10_MW.csv")
data<-subset(data1, Kultur %in% c("La Hoguette"))
# Durchführen der Diskriminanzanalyse für ausgewählte Spalten
DAModel.1 <- lda(Fundort~SiO2+TiO2+Al2O3+Fe2O3+MnO+CaO+K2O+P2O5+Zn+Rb+Sr+Y+Zr, data=data)
# Visualisierung der LDA-Ergebnisse
DAModel.1Call:
lda(Fundort ~ SiO2 + TiO2 + Al2O3 + Fe2O3 + MnO + CaO + K2O +
P2O5 + Zn + Rb + Sr + Y + Zr, data = data)
Prior probabilities of groups:
Friedberg-Bruchenbruecken
0.2875536
Rottenburg-Hailfingen 'Unter dem Tuebinger Weg'
0.2360515
Rottenburg 'Froebelweg'
0.4763948
Group means:
SiO2 TiO2 Al2O3
Friedberg-Bruchenbruecken 1.765773 0.01381928 1.234841
Rottenburg-Hailfingen 'Unter dem Tuebinger Weg' 1.707332 -0.08170366 1.317475
Rottenburg 'Froebelweg' 1.684796 -0.04617556 1.385087
Fe2O3 MnO CaO
Friedberg-Bruchenbruecken 0.7394310 -1.311570 0.6501444
Rottenburg-Hailfingen 'Unter dem Tuebinger Weg' 0.8796159 -1.162717 0.7280732
Rottenburg 'Froebelweg' 0.9367286 -1.081719 0.6631054
K2O P2O5 Zn
Friedberg-Bruchenbruecken 0.2755071 0.9249578 2.190035
Rottenburg-Hailfingen 'Unter dem Tuebinger Weg' 0.4253020 0.8902144 1.964169
Rottenburg 'Froebelweg' 0.4699881 0.5954059 1.989922
Rb Sr Y
Friedberg-Bruchenbruecken 1.923945 2.385071 1.514871
Rottenburg-Hailfingen 'Unter dem Tuebinger Weg' 1.928991 2.216966 1.547595
Rottenburg 'Froebelweg' 1.959376 1.838634 1.588051
Zr
Friedberg-Bruchenbruecken 2.441177
Rottenburg-Hailfingen 'Unter dem Tuebinger Weg' 2.313480
Rottenburg 'Froebelweg' 2.326059
Coefficients of linear discriminants:
LD1 LD2
SiO2 -0.9595480 -5.0055045
TiO2 -4.6445003 9.8758051
Al2O3 13.7859292 -1.3091963
Fe2O3 -0.9473706 -7.0600040
MnO 0.9089528 0.8191109
CaO 3.2788172 0.4645834
K2O 0.5073119 -2.8897825
P2O5 -1.2510286 -0.4861622
Zn -3.8393016 3.4530653
Rb 2.0567851 5.0364797
Sr -7.3368700 -5.2520227
Y 1.3843915 -0.6915676
Zr 2.2551433 5.2888631
Proportion of trace:
LD1 LD2
0.9111 0.0889 plot(DAModel.1)
# Erstellen einer Konfusionsmatrix zur Bewertung der Klassifikationsgüte
confusion(data$Fundort[], predict(DAModel.1)$class) True
Predicted Friedberg-Bruchenbruecken
Friedberg-Bruchenbruecken 64
Rottenburg-Hailfingen 'Unter dem Tuebinger Weg' 3
Rottenburg 'Froebelweg' 0
Total 67
Correct 64
True
Predicted Rottenburg-Hailfingen 'Unter dem Tuebinger Weg'
Friedberg-Bruchenbruecken 1
Rottenburg-Hailfingen 'Unter dem Tuebinger Weg' 54
Rottenburg 'Froebelweg' 0
Total 55
Correct 54
True
Predicted Rottenburg 'Froebelweg'
Friedberg-Bruchenbruecken 0
Rottenburg-Hailfingen 'Unter dem Tuebinger Weg' 0
Rottenburg 'Froebelweg' 111
Total 111
Correct 111
Proportions correct
Friedberg-Bruchenbruecken
0.9552239
Rottenburg-Hailfingen 'Unter dem Tuebinger Weg'
0.9818182
Rottenburg 'Froebelweg'
1.0000000
N correct/N total = 229/233 = 0.9828326# Vorhersage der Zuordnung zu den chemischen Rezepturen basierend auf der DA
da_prediction <- predict(DAModel.1)
# Kombinieren der ursprünglichen Daten mit den ersten beiden Diskriminanzfunktionen
DAdata1 <- cbind(data,da_prediction$x[,1:2])
# Speichern als CSV
write.csv(DAdata1,"../Daten//Kap_6//Kap_6.3//Grundlagen//Zusammenschau//DA_LH.csv",row.names=FALSE)8.3.2 Jackknifing
# Vergleich der vorhergesagten Zuordnung mit der tatsächlichen Zuordnung nach Fundort
confusion(data$Fundort, lda(Fundort~SiO2+TiO2+Al2O3+Fe2O3+MnO+CaO+K2O+P2O5+Zn+Rb+Sr+Y+Zr, data=data,CV=TRUE)$class) True
Predicted Friedberg-Bruchenbruecken
Friedberg-Bruchenbruecken 64
Rottenburg-Hailfingen 'Unter dem Tuebinger Weg' 3
Rottenburg 'Froebelweg' 0
Total 67
Correct 64
True
Predicted Rottenburg-Hailfingen 'Unter dem Tuebinger Weg'
Friedberg-Bruchenbruecken 1
Rottenburg-Hailfingen 'Unter dem Tuebinger Weg' 53
Rottenburg 'Froebelweg' 1
Total 55
Correct 53
True
Predicted Rottenburg 'Froebelweg'
Friedberg-Bruchenbruecken 0
Rottenburg-Hailfingen 'Unter dem Tuebinger Weg' 2
Rottenburg 'Froebelweg' 109
Total 111
Correct 109
Proportions correct
Friedberg-Bruchenbruecken
0.9552239
Rottenburg-Hailfingen 'Unter dem Tuebinger Weg'
0.9636364
Rottenburg 'Froebelweg'
0.9819820
N correct/N total = 226/233 = 0.96995718.3.3 PressQ-Statistik
# Berechnen der PressQ-Statistisk
# 232: Gesamtanzahl der Beobachtungen oder ein Gesamtwert
# 228: Durch Diskriminanzanalyse korrekt zugewiesene Objekte
# 3: Anzahl der Gruppen in der Analyse
PressQ<-((232-(228*3))^2)/(232*(3-1))
PressQ[1] 440.31038.3.4 MANOVA
# Daten einlesen und filtern
data1<-read.csv("../Daten//Kap_6//Kap_6.3//Grundlagen//Zusammenschau//Daten_log10_MW.csv")
data<-subset(data1, Kultur %in% c("La Hoguette"))
# Durchführen der MANOVA für ausgewählte Spalten im Hinblick auf Fundort
manova<-manova(cbind(Al2O3,CaO,Fe2O3,K2O,MnO,P2O5,SiO2,TiO2,Zn,Rb,Sr,Y,Zr) ~ Fundort, data)
# Zusammenfassung der MANOVA mit Intercept
summary(manova,intercept=TRUE) Df Pillai approx F num Df den Df Pr(>F)
(Intercept) 1 0.99993 249166 13 218 < 2.2e-16 ***
Fundort 2 1.43178 42 26 438 < 2.2e-16 ***
Residuals 230
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# Anzeige der MANOVA-Ergebnisse mit Wilks-Lambda-Tests
summary(manova,test="Wilks",intercept=TRUE) Df Wilks approx F num Df den Df Pr(>F)
(Intercept) 1 0.000067 249166 13 218 < 2.2e-16 ***
Fundort 2 0.040661 66 26 436 < 2.2e-16 ***
Residuals 230
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 18.3.5 Abbildung Loadings
# Diagramme erstellen
barplot(DAModel.1$scaling[,1], main="LDA 1 Loadings Plot", las=2)
barplot(DAModel.1$scaling[,2], main="LDA 2 Loadings Plot", las=2)
8.3.6 Abbildung Scorewerte
# Daten einlesen
data1<-read.csv("../Daten//Kap_6//Kap_6.3//Grundlagen//Zusammenschau//DA_LH.csv")
# Daten nach ausgewählter Spalte sortieren und in data.table umwandeln
data2 <- setDT(data1)[order(-LD1)]
# Berechnung der Zeilenanzahl
num_rows = nrow(data2)
# Erstellen einer ID-Spalte mit aufsteigenden Werten
ID_LD1 <- c(1:num_rows)
# Spaltenweise Kombination von Dataframes
data3 <- cbind(ID_LD1, data2)
# Diagramme erstellen
Score_LD1<-ggplot(data3, aes(x=ID_LD1,y=LD1, color=Fundort, shape=Kultur))+
geom_point(aes(shape=Kultur),size=2)+scale_shape_manual(values=c(1))+ # Manuelle Definition von Größe und Form der Symbole
scale_color_manual(name="Fundort",values=c("cyan4","paleturquoise","grey70"))+ # Manuelle Definition der Farbe der Symbole
xlab("Zeilennummer")+ylab("Scorewerte der ersten Diskriminanzfunktion")+ # Manuelle Achsenbeschriftung
theme_classic()+ # Klassisches Design
theme(axis.line=element_line(colour="black",size=0.25))+theme(legend.title=element_blank(),legend.text=element_text(size=8),axis.title=element_text(size=9),axis.text=element_text(size=8,color="black"))+theme(legend.position="bottom")+theme(axis.ticks=element_line(size=0.25,colour="black"))+ # Manuelle Formatierung von Achsen- und Legendendarstellung
geom_hline(yintercept=0,size=0.25) # Horizontale 0-Linie einfügen
data2 <- setDT(data1)[order(-LD2)]
num_rows = nrow(data2)
ID_LD2 <- c(1:num_rows)
data3 <- cbind(ID_LD2, data2)
Score_LD2<-ggplot(data3, aes(x=ID_LD2,y=LD2, color=Fundort, shape=Kultur))+
geom_point(aes(shape=Kultur),size=2)+scale_shape_manual(values=c(1))+
scale_color_manual(name="Fundort",values=c("cyan4","paleturquoise","grey70"))+
xlab("Zeilennummer")+ylab("Scorewerte der zweiten Diskriminanzfunktion")+
theme_classic()+
theme(axis.line=element_line(colour="black",size=0.25))+
theme(legend.title=element_blank(),legend.text=element_text(size=8),axis.title=element_text(size=9),axis.text=element_text(size=8,color="black"))+theme(legend.position="bottom")+theme(axis.ticks=element_line(size=0.25,colour="black"))+
geom_hline(yintercept=0,size=0.25)
# Kombination der Diagramme
ggarrange(Score_LD1,Score_LD2,ncol=2,nrow=1,common.legend = TRUE)+theme(legend.position="bottom")
8.3.7 Erstellen Abb. 6-166_3
# Daten einlesen und filtern
data1<-read.csv("../Daten//Kap_6//Kap_6.3//Grundlagen//Zusammenschau//Daten_log10_MW.csv")
data<-subset(data1, Kultur %in% c("La Hoguette"))
# Erstellen eines Dataframes mit Variablennamen und Koeffizienten des Diskriminanzanalyse-Modells
data.da <- data.frame(varnames=rownames(coef(DAModel.1)), coef(DAModel.1))
# Setzen der Vektorlänge für die spätere Skalierung
rad <- 3.5
# Berechnung der Länge der Vektoren basierend auf LD1 und LD2
data.da$length <- with(data.da, sqrt(LD1^2+LD2^2))
# Berechnung des Winkels der Vektoren im 2D-Raum
data.da$angle <- atan2(data.da$LD1, data.da$LD2)
# Setzen der Startpunkte aller Vektoren auf (0,0)
data.da$x_start <- data.da$y_start <- 0
# Berechnung der Endpunkte der Vektoren mit der Länge 'rad'
data.da$x_end <- cos(data.da$angle) * rad
data.da$y_end <- sin(data.da$angle) * rad
# Diagramm erstellen
Abb.6.166_3<-ggplot(cbind(data, da_prediction$x), aes(y = LD2, x = LD1, colour = Fundort))+
geom_text(aes(y = y_end, x = x_end, label = varnames),data.da, size = 4, vjust = .5, hjust = 0, colour = "black")+ # Beschriftung der Endpunkte der Vektoren (Variablennamen)
geom_spoke(aes(x_start, y_start, angle = angle),data.da, color = "black",radius = rad) + # Zeichnen der Vektoren
geom_point(aes(shape=Kultur),size=2)+ scale_shape_manual(values=c(2))+ # Manuelle Definition von Größe und Form der Symbole
scale_color_manual(name="Fundort",values=c("cyan4","paleturquoise","grey70"))+ # Manuelle Definition der Farbe der Symbole
xlab("LD 1")+ylab("LD 2")+ # Manuelle Achsenbeschriftung
theme_classic()+ # Klassisches Design
theme(axis.line=element_line(colour="black",size=0.25))+theme(legend.title=element_blank(),legend.text=element_text(size=8),axis.title=element_text(size=9),axis.text=element_text(size=8,color="black"))+theme(legend.position="bottom")+theme(axis.ticks=element_line(size=0.25,colour="black"))+ # Manuelle Formatierung von Achsen- und Legendendarstellung
geom_hline(yintercept = 0, size = .2)+geom_vline(xintercept = 0, size = .2) # Horizontale und vertikale 0-Linie einfügen
# Diagramm darstellen
Abb.6.166_3
# Export des Diagramms
ggsave("Abb.6-166_3.eps",path=("../Daten//Kap_6//Kap_6.3//Abbildungen//Zusammenschau//"),plot=last_plot(),device="eps",height=11,width=17.5,unit=c("cm"),dpi=1200)8.4 Erstellen Abb. 6-166
# Kombination der Diagramme
ggarrange(Abb.6.166_1,Abb.6.166_2,Abb.6.166_3,ncol=1,nrow=3,align = "hv",common.legend = TRUE)+theme(legend.position="bottom")
# Export des Diagramms
ggsave("Abb.6-166.eps",path=("../Daten//Kap_6//Kap_6.3//Abbildungen//Zusammenschau//"),plot=last_plot(),device="eps",height=25,width=15.3,unit=c("cm"),dpi=1200)9 Abb. 6-167
9.1 Normabstand zur typisch bandkeramische Gefäßeinheit von Friedberg-Bruchenbrücken
9.1.1 Zusammenstellen der Daten
# Daten einlesen und filtern
data2<-read.csv("../Daten//Kap_6//Kap_6.3//Grundlagen//Zusammenschau//Daten_BB_OG_KoeffkorIII_bearb.csv")
data3<-subset(data2, Fundort %in% c("Friedberg-Bruchenbruecken"))
data4<-subset(data3, Kultur %in% c("LBK"))
data<-data4[,c(2:20),]
# Definieren relevanter Variablen
data4<-subset(data2, Kultur %in% c("LBK"))
Probennummer<-data4$Probennummer
Kultur<-data4$Kultur
# Berechnung des Medians der LBK-Keramik von Friedberg-Bruchenbrücken
MedianLBK<-(data) %>% dplyr::summarise(across(everything(),list(median=median)))
# Entfernen von "_median" aus den Spaltennamen
colnames(MedianLBK) <- gsub("_median", "", colnames(MedianLBK))9.1.2 Normabstand der Keramik zum Median der LBK-Keramik berechnen
# Extrahieren des Medians der LBK-Keramik für SiO2
MedianLBK_SiO2<-MedianLBK$SiO2
# Extrahieren der Messwerte für SiO2
data_SiO2<-data4$SiO2
# Berechnen des Multivariaten Normabstandes für jede Probe zum Median von SiO2
SiO2<-sqrt((data_SiO2-MedianLBK_SiO2)^2)/MedianLBK_SiO2
MedianLBK_TiO2<-MedianLBK$TiO2
data_TiO2<-data4$TiO2
TiO2<-sqrt((data_TiO2-MedianLBK_TiO2)^2)/MedianLBK_TiO2
MedianLBK_Al2O3<-MedianLBK$Al2O3
data_Al2O3<-data4$Al2O3
Al2O3<-sqrt((data_Al2O3-MedianLBK_Al2O3)^2)/MedianLBK_Al2O3
MedianLBK_Fe2O3<-MedianLBK$Fe2O3
data_Fe2O3<-data4$Fe2O3
Fe2O3<-sqrt((data_Fe2O3-MedianLBK_Fe2O3)^2)/MedianLBK_Fe2O3
MedianLBK_MnO<-MedianLBK$MnO
data_MnO<-data4$MnO
MnO<-sqrt((data_MnO-MedianLBK_MnO)^2)/MedianLBK_MnO
MedianLBK_MgO<-MedianLBK$MgO
data_MgO<-data4$MgO
MgO<-sqrt((data_MgO-MedianLBK_MgO)^2)/MedianLBK_MgO
MedianLBK_CaO<-MedianLBK$CaO
data_CaO<-data4$CaO
CaO<-sqrt((data_CaO-MedianLBK_CaO)^2)/MedianLBK_CaO
MedianLBK_K2O<-MedianLBK$K2O
data_K2O<-data4$K2O
K2O<-sqrt((data_K2O-MedianLBK_K2O)^2)/MedianLBK_K2O
MedianLBK_P2O5<-MedianLBK$P2O5
data_P2O5<-data4$P2O5
P2O5<-sqrt((data_P2O5-MedianLBK_P2O5)^2)/MedianLBK_P2O5
MedianLBK_Zn<-MedianLBK$Zn
data_Zn<-data4$Zn
Zn<-sqrt((data_Zn-MedianLBK_Zn)^2)/MedianLBK_Zn
MedianLBK_Rb<-MedianLBK$Rb
data_Rb<-data4$Rb
Rb<-sqrt((data_Rb-MedianLBK_Rb)^2)/MedianLBK_Rb
MedianLBK_Sr<-MedianLBK$Sr
data_Sr<-data4$Sr
Sr<-sqrt((data_Sr-MedianLBK_Sr)^2)/MedianLBK_Sr
MedianLBK_Y<-MedianLBK$Y
data_Y<-data4$Y
Y<-sqrt((data_Y-MedianLBK_Y)^2)/MedianLBK_Y
MedianLBK_Zr<-MedianLBK$Zr
data_Zr<-data4$Zr
Zr<-sqrt((data_Zr-MedianLBK_Zr)^2)/MedianLBK_Zr
# Kombinieren mehrerer Dataframes
Normabstand_HEuSE<-data.frame(Probennummer,SiO2,TiO2,Al2O3,Fe2O3,MnO,CaO,K2O,P2O5,Zn,Rb,Sr,Y,Zr)
# Berechnen des Normabstandes pro Probe
Normabstand_HEuSE_BB_OG_LBKI<-Normabstand_HEuSE %>% rowwise() %>% mutate(Summe = sum(c(SiO2,TiO2,Al2O3,Fe2O3,MnO,CaO,K2O,P2O5,Zn,Rb,Sr,Y,Zr)))
# Speichern als CSV
write.csv(Normabstand_HEuSE_BB_OG_LBKI,"../Daten//Kap_6//Kap_6.3//Grundlagen//Zusammenschau//Normabstand_HEuSE_BB_OG_LBK.csv",row.names=FALSE)9.1.3 Daten zusammenstellen Bandkeramik
# Daten einlesen und filtern
data1<-read.csv("../Daten//Kap_6//Kap_6.3//Grundlagen//Zusammenschau//Normabstand_HEuSE_BB_OG_LBK.csv")
data2<-data1[,c(1,15),]
# Daten einlesen und filtern
data3<-read.csv("../Daten//Kap_6//Kap_6.3//Grundlagen//Zusammenschau//Daten_BB_OG_KoeffkorIII_bearb.csv")
data4<-subset(data3, Kultur %in% c("LBK"))
# Kombinieren mehrerer Dataframes basierend auf der Probennummer
data<-merge(data2,data4, by="Probennummer", all=TRUE)
# Spaltennamen "Summe" durch "Normabst" ersetzen
colnames(data) <- gsub("Summe", "Normabst", colnames(data))
# Speichern als CSV
write.csv(data,"../Daten//Kap_6//Kap_6.3//Grundlagen//Zusammenschau//Normabstand_HEuSE_BB_OG_LBK_mitMesswerten.csv",row.names=FALSE)9.1.4 Dunns Test Bandkeramik
# Daten einlesen und filtern
data1<-read.csv("../Daten//Kap_6//Kap_6.3//Grundlagen//Zusammenschau//Normabstand_HEuSE_BB_OG_LBK_mitMesswerten.csv")
data2<-subset(data1, Kultur %in% c("La Hoguette","LBK","Huettenlehm"))
data3<-data2[,c(2,25),]
data2<-subset(data3, Fundort %in% c("Friedberg-Bruchenbruecken","Rottenburg-Hailfingen 'Unter dem Tuebinger Weg'","Rottenburg 'Froebelweg'"))
# Berechnung der deskriptiven Statistik basierend auf Fundort
data2 %>%
group_by(Fundort) %>%
get_summary_stats(Normabst, type = "common")# A tibble: 3 × 11
Fundort variable n min max median iqr mean sd se ci
<chr> <fct> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 Friedberg-Bru… Normabst 216 0.835 18.7 2.56 1.70 3.15 2.05 0.139 0.275
2 Rottenburg 'F… Normabst 157 2.13 15.6 5.37 1.82 5.88 2.39 0.191 0.377
3 Rottenburg-Ha… Normabst 47 1.43 9.41 4.05 3.15 4.29 1.82 0.265 0.534# Durchführung des Kruskal-Wallis-Tests
res.kruskal<-data2%>%kruskal_test(Normabst~Fundort)
res.kruskal# A tibble: 1 × 6
.y. n statistic df p method
* <chr> <int> <dbl> <int> <dbl> <chr>
1 Normabst 420 162. 2 6.91e-36 Kruskal-Wallis# Berechnung der Effektgröße
data2%>%kruskal_effsize(Normabst~Fundort)# A tibble: 1 × 5
.y. n effsize method magnitude
* <chr> <int> <dbl> <chr> <ord>
1 Normabst 420 0.383 eta2[H] large # Durchführung des Dunn-Tests für paarweise Vergleiche mit Bonferroni-Korrektur
pwc<-data2%>%dunn_test(Normabst~Fundort,p.adjust.method="bonferroni")
pwc# A tibble: 3 × 9
.y. group1 group2 n1 n2 statistic p p.adj p.adj.signif
* <chr> <chr> <chr> <int> <int> <dbl> <dbl> <dbl> <chr>
1 Normabst Friedber… Rotte… 216 47 4.36 1.30e- 5 3.91e- 5 ****
2 Normabst Friedber… Rotte… 216 157 12.7 6.56e-37 1.97e-36 ****
3 Normabst Rottenbu… Rotte… 47 157 3.79 1.53e- 4 4.60e- 4 *** # Speichern als CSV
write.csv(pwc,"../Daten//Kap_6//Kap_6.3//Grundlagen//Zusammenschau//Modell_HEuSE_LBK_Abstmaß_Kruskal.csv",row.names=FALSE)9.2 Normabstand zur typischen La Hoguette Gefäßeinheit von Friedberg-Bruchenbrücken
9.2.1 Zusammenstellen der Daten
# Daten einlesen und filtern
data2<-read.csv("../Daten//Kap_6//Kap_6.3//Grundlagen//Zusammenschau//Daten_BB_OG_KoeffkorIII_bearb.csv")
data3<-subset(data2, Fundort %in% c("Friedberg-Bruchenbruecken"))
data4<-subset(data3, Kultur %in% c("La Hoguette"))
data<-data4[,c(2:20),]
# Definieren relevanter Variablen
data4<-subset(data2, Kultur %in% c("La Hoguette"))
Probennummer<-data4$Probennummer
Kultur<-data4$Kultur
# Berechnung des Medians der LH-Keramik von Friedberg-Bruchenbrücken
MedianLH<-(data) %>%dplyr::summarise(across(everything(),list(median=median)))
# Entfernen von "_median" aus den Spaltennamen
colnames(MedianLH) <- gsub("_median", "", colnames(MedianLH))9.2.2 Normabstand der Keramik zum Median der LH-Keramik berechnen
# Extrahieren des Medians der LH-Keramik für SiO2
MedianLBK_SiO2<-MedianLBK$SiO2
# Extrahieren der Messwerte für SiO2
data_SiO2<-data4$SiO2
# Berechnen des Multivariaten Normabstandes für jede Probe zum Median von SiO2
SiO2<-sqrt((data_SiO2-MedianLBK_SiO2)^2)/MedianLBK_SiO2
MedianLH_TiO2<-MedianLH$TiO2
data_TiO2<-data4$TiO2
TiO2<-sqrt((data_TiO2-MedianLH_TiO2)^2)/MedianLH_TiO2
MedianLH_Al2O3<-MedianLH$Al2O3
data_Al2O3<-data4$Al2O3
Al2O3<-sqrt((data_Al2O3-MedianLH_Al2O3)^2)/MedianLH_Al2O3
MedianLH_Fe2O3<-MedianLH$Fe2O3
data_Fe2O3<-data4$Fe2O3
Fe2O3<-sqrt((data_Fe2O3-MedianLH_Fe2O3)^2)/MedianLH_Fe2O3
MedianLH_MnO<-MedianLH$MnO
data_MnO<-data4$MnO
MnO<-sqrt((data_MnO-MedianLH_MnO)^2)/MedianLH_MnO
MedianLH_MgO<-MedianLH$MgO
data_MgO<-data4$MgO
MgO<-sqrt((data_MgO-MedianLH_MgO)^2)/MedianLH_MgO
MedianLH_CaO<-MedianLH$CaO
data_CaO<-data4$CaO
CaO<-sqrt((data_CaO-MedianLH_CaO)^2)/MedianLH_CaO
MedianLH_K2O<-MedianLH$K2O
data_K2O<-data4$K2O
K2O<-sqrt((data_K2O-MedianLH_K2O)^2)/MedianLH_K2O
MedianLH_P2O5<-MedianLH$P2O5
data_P2O5<-data4$P2O5
P2O5<-sqrt((data_P2O5-MedianLH_P2O5)^2)/MedianLH_P2O5
MedianLH_Zn<-MedianLH$Zn
data_Zn<-data4$Zn
Zn<-sqrt((data_Zn-MedianLH_Zn)^2)/MedianLH_Zn
MedianLH_Rb<-MedianLH$Rb
data_Rb<-data4$Rb
Rb<-sqrt((data_Rb-MedianLH_Rb)^2)/MedianLH_Rb
MedianLH_Sr<-MedianLH$Sr
data_Sr<-data4$Sr
Sr<-sqrt((data_Sr-MedianLH_Sr)^2)/MedianLH_Sr
MedianLH_Y<-MedianLH$Y
data_Y<-data4$Y
Y<-sqrt((data_Y-MedianLH_Y)^2)/MedianLH_Y
MedianLH_Zr<-MedianLH$Zr
data_Zr<-data4$Zr
Zr<-sqrt((data_Zr-MedianLH_Zr)^2)/MedianLH_Zr
# Kombinieren mehrerer Dataframes
Normabstand_HEuSE<-data.frame(Probennummer,SiO2,TiO2,Al2O3,Fe2O3,MnO,CaO,K2O,P2O5,Zn,Rb,Sr,Y,Zr)
# Berechnen des Normabstandes pro Probe
Normabstand_HEuSE_BB_OG_LH<-Normabstand_HEuSE %>% rowwise() %>% mutate(Summe = sum(c(SiO2,TiO2,Al2O3,Fe2O3,MnO,CaO,K2O,P2O5,Zn,Rb,Sr,Y,Zr)))
# Speichern als CSV
write.csv(Normabstand_HEuSE_BB_OG_LH,"../Daten//Kap_6//Kap_6.3//Grundlagen//Zusammenschau//Normabstand_HEuSE_BB_OG_LH.csv",row.names=FALSE)9.2.3 Daten zusammenstellen Bandkeramik
# Daten einlesen und filtern
data1<-read.csv("../Daten//Kap_6//Kap_6.3//Grundlagen//Zusammenschau//Normabstand_HEuSE_BB_OG_LH.csv")
data2<-data1[,c(1,15),]
# Daten einlesen und filtern
data3<-read.csv("../Daten//Kap_6//Kap_6.3//Grundlagen//Zusammenschau//Daten_BB_OG_KoeffkorIII_bearb.csv")
data4<-subset(data3, Kultur %in% c("La Hoguette"))
# Kombinieren mehrerer Dataframes basierend auf der Probennummer
data<-merge(data2,data4, by="Probennummer", all=TRUE)
# Spaltennamen "Summe" durch "Normabst" ersetzen
colnames(data) <- gsub("Summe", "Normabst", colnames(data))
# Speichern als CSV
write.csv(data,"../Daten//Kap_6//Kap_6.3//Grundlagen//Zusammenschau//Normabstand_HEuSE_BB_OG_LH_mitMesswerten.csv",row.names=FALSE)9.2.4 Dunns Test La Hoguette
# Daten einlesen und filtern
data1<-read.csv("../Daten//Kap_6//Kap_6.3//Grundlagen//Zusammenschau//Normabstand_HEuSE_BB_OG_LH_mitMesswerten.csv")
data2<-subset(data1, Kultur %in% c("La Hoguette","LBK","Huettenlehm"))
data3<-data2[,c(2,25),]
data2<-subset(data3, Fundort %in% c("Friedberg-Bruchenbruecken","Rottenburg-Hailfingen 'Unter dem Tuebinger Weg'","Rottenburg 'Froebelweg'"))
# Berechnung der deskriptiven Statistik basierend auf Fundort
data2 %>%
group_by(Fundort) %>%
get_summary_stats(Normabst, type = "common")# A tibble: 3 × 11
Fundort variable n min max median iqr mean sd se ci
<chr> <fct> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 Friedberg-Bru… Normabst 67 0.916 9.44 2.72 2.72 3.21 1.72 0.21 0.418
2 Rottenburg 'F… Normabst 111 3.69 30.1 6.42 1.51 6.75 2.65 0.252 0.499
3 Rottenburg-Ha… Normabst 55 2.51 9.08 5.12 1.94 5.36 1.54 0.207 0.416# Durchführung des Kruskal-Wallis-Tests
res.kruskal<-data2%>%kruskal_test(Normabst~Fundort)
res.kruskal# A tibble: 1 × 6
.y. n statistic df p method
* <chr> <int> <dbl> <int> <dbl> <chr>
1 Normabst 233 106. 2 9.22e-24 Kruskal-Wallis# Berechnung der Effektgröße
data2%>%kruskal_effsize(Normabst~Fundort)# A tibble: 1 × 5
.y. n effsize method magnitude
* <chr> <int> <dbl> <chr> <ord>
1 Normabst 233 0.453 eta2[H] large # Durchführung des Dunn-Tests für paarweise Vergleiche mit Bonferroni-Korrektur
pwc<-data2%>%dunn_test(Normabst~Fundort,p.adjust.method="bonferroni")
pwc# A tibble: 3 × 9
.y. group1 group2 n1 n2 statistic p p.adj p.adj.signif
* <chr> <chr> <chr> <int> <int> <dbl> <dbl> <dbl> <chr>
1 Normabst Friedber… Rotte… 67 55 5.15 2.67e- 7 8.02e- 7 ****
2 Normabst Friedber… Rotte… 67 111 10.3 7.58e-25 2.27e-24 ****
3 Normabst Rottenbu… Rotte… 55 111 3.98 6.90e- 5 2.07e- 4 *** # Speichern als CSV
write.csv(pwc,"../Daten//Kap_6//Kap_6.3//Grundlagen//Zusammenschau//Modell_HEuSE_LH_Abstmaß_Kruskal.csv",row.names=FALSE)9.3 Erstellen Abb. 6-167
9.3.1 La Hoguette
9.3.1.1 Histogramm
# Daten einlesen und filtern
data1<-read.csv("../Daten//Kap_6//Kap_6.3//Grundlagen//Zusammenschau//Normabstand_HEuSE_BB_OG_LH_mitMesswerten.csv")
data<-subset(data1, Fundort %in% c("Friedberg-Bruchenbruecken","Rottenburg-Hailfingen 'Unter dem Tuebinger Weg'","Rottenburg 'Froebelweg'"))
# Berechnung der unteren (25%) und oberen (75%) Quartile für die Spalte "Normabst"
Normabst0 <- (data) %>%
dplyr::summarise(lower = quantile(Normabst, probs = .25),
upper = quantile(Normabst, probs = .75))
# Diagramm erstellen
Hist_Keramik_LH<-ggplot(data,aes(x=Normabst))+
geom_histogram(fill="lightgrey", color="black",binwidth=0.5,bins=NULL)+ # Manuelle Definition der Farbe und Breite der Balken
ylab("Häufigkeit")+ # Manuelle Achsenbeschriftung
theme_classic()+ # Klassisches Design
scale_x_continuous(breaks=seq(0,36,1))+ # Manuelle Definition der Achsen
scale_y_continuous(breaks=seq(0,150,5))+
theme(axis.line=element_line(colour="black",size=0.25))+theme(legend.title=element_blank(),legend.text=element_text(size=8),axis.title=element_text(size=9),axis.text=element_text(size=8,color="black"))+theme(legend.position="bottom")+theme(axis.ticks=element_line(size=0.25,colour="black"))+ theme(axis.title.x=element_blank())+ # Manuelle Formatierung von Achsen- und Legendendarstellung
geom_vline(aes(xintercept=median(Normabst)),color="blue", linetype="dashed", size=1)+ # Vertikale Markierung des Medians
geom_vline(data=Normabst0, aes(xintercept=lower), color="red", linetype="dotted", size=1)+ # Vertikale Markierung des 25%-Quartils
geom_vline(data=Normabst0, aes(xintercept=upper), color="red", linetype="dotted", size=1) # Vertikale Markierung des 75%-Quartils
# Berechnung der unteren (25%) und oberen (75%) Quartile für die Spalte "Normabst" nach Fundort
Normabst10 <- (data) %>%
group_by(Fundort) %>%
dplyr::summarise(lower = quantile(Normabst, probs = .25),
upper = quantile(Normabst, probs = .75))
# Diagramm erstellen
Hist_Fundort<-ggplot(data,aes(x=Normabst))+
geom_histogram(fill="lightgrey", color="black",binwidth=0.5,bins=NULL)+ # Manuelle Definition der Farbe und Breite der Balken
xlab("Distanz zur lokalen La Hoguette Gefäßeinheit von Friedberg-Bruchenbrücken")+ylab("Häufigkeit")+ # Manuelle Achsenbeschriftung
theme_classic()+ # Klassisches Design
scale_x_continuous(breaks=seq(0,36,1))+ # Manuelle Definition der Achsen
scale_y_continuous(breaks=seq(0,150,5))+
theme(axis.line=element_line(colour="black",size=0.25))+theme(legend.title=element_blank(),legend.text=element_text(size=8),axis.title=element_text(size=9),axis.text=element_text(size=8,color="black"))+ theme(legend.position="bottom")+theme(axis.ticks=element_line(size=0.25,colour="black"))+ # Manuelle Formatierung von Achsen- und Legendendarstellung
facet_grid(Fundort~.)+ theme(strip.text.y = element_text(angle = 0),strip.background = element_rect(colour="white", fill="white"))+ # Facettierung nach Kategorien
geom_vline(data=ddply(data,"Fundort", summarise, grp.median=median(Normabst)), aes(xintercept=grp.median),color="blue", linetype="dashed", size=0.75)+ # Vertikale Markierung des Medians nach Kategorie
geom_vline(data=Normabst10, aes(xintercept=lower), color="red", linetype="dotted", size=1)+ # Vertikale Markierung des 25%-Quartils nach Kategorien
geom_vline(data=Normabst10, aes(xintercept=upper), color="red", linetype="dotted", size=1) # Vertikale Markierung des 75%-Quartils nach Kategorien
# Kombination der Diagramme
Part1<-plot_grid(Hist_Keramik_LH,Hist_Fundort,ncol=1,nrow=2,align = "v",axis = "lr",rel_heights=c(1,3))9.3.1.2 Kennwerte
# Daten einlesen und filtern
data1<-read.csv("../Daten//Kap_6//Kap_6.3//Grundlagen//Zusammenschau//Normabstand_HEuSE_BB_OG_LH_mitMesswerten.csv")
data<-subset(data1, Fundort %in% c("Friedberg-Bruchenbruecken","Rottenburg-Hailfingen 'Unter dem Tuebinger Weg'","Rottenburg 'Froebelweg'"))
# Berechnen von Mittelwert und Standardabweichung für den gesamten Datensatz
data %>% dplyr::summarise(m = mean(Normabst),sd=sd(Normabst)) m sd
1 5.403852 2.64033# Berechnen von Mittelwert und Standardabweichung nach Kategorien
group_by(data, Fundort) %>% dplyr::summarise(m = mean(Normabst),sd=sd(Normabst))# A tibble: 3 × 3
Fundort m sd
<chr> <dbl> <dbl>
1 Friedberg-Bruchenbruecken 3.21 1.72
2 Rottenburg 'Froebelweg' 6.75 2.65
3 Rottenburg-Hailfingen 'Unter dem Tuebinger Weg' 5.36 1.54# Anzahl der Gesamtbeobachtungen
data %>% dplyr::summarise(count=n()) count
1 233# Anzahl der Beobachtungen pro Kategorie
data %>% group_by(Fundort) %>% dplyr::summarise(count=n())# A tibble: 3 × 2
Fundort count
<chr> <int>
1 Friedberg-Bruchenbruecken 67
2 Rottenburg 'Froebelweg' 111
3 Rottenburg-Hailfingen 'Unter dem Tuebinger Weg' 559.3.2 Bandkeramik
9.3.2.1 Histogramm
# Daten einlesen und filtern
data1<-read.csv("../Daten//Kap_6//Kap_6.3//Grundlagen//Zusammenschau//Normabstand_HEuSE_BB_OG_LBK_mitMesswerten.csv")
data<-subset(data1, Fundort %in% c("Friedberg-Bruchenbruecken","Rottenburg-Hailfingen 'Unter dem Tuebinger Weg'","Rottenburg 'Froebelweg'"))
# Berechnung der unteren (25%) und oberen (75%) Quartile für die Spalte "Normabst"
Normabst0 <- (data) %>%
dplyr::summarise(lower = quantile(Normabst, probs = .25),
upper = quantile(Normabst, probs = .75))
# Diagramm erstellen
Hist_Norm_Keramik_LBKI<-ggplot(data,aes(x=Normabst))+
geom_histogram(fill="lightgrey", color="black",binwidth=0.5,bins=NULL)+ # Manuelle Definition der Farbe und Breite der Balken
theme(axis.title.x=element_blank())+ylab("Häufigkeit")+ # Manuelle Achsenbeschriftung
theme_classic()+ # Klassisches Design
scale_x_continuous(breaks=seq(0,36,1))+ # Manuelle Definition der Achsen
scale_y_continuous(breaks=seq(0,150,10))+
theme(axis.line=element_line(colour="black",size=0.25))+theme(legend.title=element_blank(),legend.text=element_text(size=8),axis.title=element_text(size=9),axis.text=element_text(size=8,color="black"))+theme(legend.position="bottom")+theme(axis.ticks=element_line(size=0.25,colour="black"))+ theme(axis.title.x=element_blank())+ # Manuelle Formatierung von Achsen- und Legendendarstellung
geom_vline(aes(xintercept=median(Normabst)),color="blue", linetype="dashed", size=1)+ # Vertikale Markierung des Medians
geom_vline(data=Normabst0, aes(xintercept=lower), color="red", linetype="dotted", size=1)+ # Vertikale Markierung des 25%-Quartils
geom_vline(data=Normabst0, aes(xintercept=upper), color="red", linetype="dotted", size=1) # Vertikale Markierung des 75%-Quartils
# Berechnung der unteren (25%) und oberen (75%) Quartile für die Spalte "Normabst" nach Fundort
Normabst10 <- (data) %>%
group_by(Fundort) %>%
dplyr::summarise(lower = quantile(Normabst, probs = .25),
upper = quantile(Normabst, probs = .75))
# Diagramm erstellen
Hist_Fundort<-ggplot(data,aes(x=Normabst))+
geom_histogram(fill="lightgrey", color="black",binwidth=0.5,bins=NULL)+ # Manuelle Definition der Farbe und Breite der Balken
xlab("Distanz zur lokalen bandkeramischen Gefäßeinheit von Friedberg-Bruchenbrücken")+ylab("Häufigkeit")+ # Manuelle Achsenbeschriftung
theme_classic()+ # Klassisches Design
scale_x_continuous(breaks=seq(0,36,1))+ # Manuelle Definition der Achsen
scale_y_continuous(breaks=seq(0,150,10))+
theme(axis.line=element_line(colour="black",size=0.25))+theme(legend.title=element_blank(),legend.text=element_text(size=8),axis.title=element_text(size=9),axis.text=element_text(size=8,color="black"))+theme(legend.position="bottom")+theme(axis.ticks=element_line(size=0.25,colour="black"))+ # Manuelle Formatierung von Achsen- und Legendendarstellung
facet_grid(Fundort~.)+ theme(strip.text.y = element_text(angle = 0),strip.background = element_rect(colour="white", fill="white"))+ # Facettierung nach Kategorien
geom_vline(data=ddply(data,"Fundort", summarise, grp.median=median(Normabst)), aes(xintercept=grp.median),color="blue", linetype="dashed", size=1)+ # Vertikale Markierung des Medians
geom_vline(data=Normabst10, aes(xintercept=lower), color="red", linetype="dotted", size=1)+ # Vertikale Markierung des 25%-Quartils
geom_vline(data=Normabst10, aes(xintercept=upper), color="red", linetype="dotted", size=1) # Vertikale Markierung des 75%-Quartils
# Kombination der Diagramme
Part2<-plot_grid(Hist_Norm_Keramik_LBKI,Hist_Fundort,ncol=1,nrow=2,align = "v",axis = "lr",rel_heights=c(1,3))9.3.2.2 Kennwerte
# Daten einlesen und filtern
data1<-read.csv("../Daten//Kap_6//Kap_6.3//Grundlagen//Zusammenschau//Normabstand_HEuSE_BB_OG_LBK_mitMesswerten.csv")
data<-subset(data1, Fundort %in% c("Friedberg-Bruchenbruecken","Rottenburg-Hailfingen 'Unter dem Tuebinger Weg'","Rottenburg 'Froebelweg'"))
# Berechnen von Mittelwert und Standardabweichung für den gesamten Datensatz
data %>% dplyr::summarise(m = mean(Normabst),sd=sd(Normabst)) m sd
1 4.297697 2.499861# Berechnen von Mittelwert und Standardabweichung nach Kategorien
group_by(data, Fundort) %>% dplyr::summarise(m = mean(Normabst),sd=sd(Normabst))# A tibble: 3 × 3
Fundort m sd
<chr> <dbl> <dbl>
1 Friedberg-Bruchenbruecken 3.15 2.05
2 Rottenburg 'Froebelweg' 5.87 2.39
3 Rottenburg-Hailfingen 'Unter dem Tuebinger Weg' 4.29 1.82# Anzahl der Gesamtbeobachtungen
data %>% dplyr::summarise(count=n()) count
1 420# Anzahl der Beobachtungen pro Kategorie
data %>% group_by(Fundort) %>% dplyr::summarise(count=n())# A tibble: 3 × 2
Fundort count
<chr> <int>
1 Friedberg-Bruchenbruecken 216
2 Rottenburg 'Froebelweg' 157
3 Rottenburg-Hailfingen 'Unter dem Tuebinger Weg' 479.3.3 Finale Abb. 6-167
# Kombination der Diagramme
plot_grid(Part2,Part1,ncol=1,nrow=2,align = "v",axis = "lr",rel_heights=c(1,1))
# Export des kombinierten Diagramms
ggsave("Abb.6-167.eps",path=("../Daten//Kap_6//Kap_6.3//Abbildungen//Zusammenschau"),plot=last_plot(),device="eps",height=21,width=22,unit=c("cm"),dpi=1200)10 Abb. 6-171
# Daten einlesen
data3<- read.csv("../Daten//Kap_6//Kap_6.3//Grundlagen//Datengrundlage/Daten_RB_Ker_vollständigMW_chemGruppen.csv")
# Formatieren der Kontextnummern
data3$HausKontext <- ifelse(data3$HausKontext %in% c("26","27","51"),
sprintf("%03d", as.numeric(data3$HausKontext)),
data3$HausKontext)
# Daten filtern
data3<-subset(data3, Kultur %in% c("La Hoguette"))
data3<-subset(data3, LeFranc %in% c("Stil A","Stil B"))
data2<-data3[,c(29,74,84),]
# Gruppieren nach Kategorien und zählen der Häufigkeiten
data<-data2 %>% count(LeFranc, Modell2,HausKontext)
# Diagramm erstellen
Part1<-ggplot(data, aes(x=HausKontext,y=Modell2, shape=LeFranc))+
geom_point(aes(shape=LeFranc),size=2)+ scale_shape_manual(values=c(5,6,4))+ # Manuelle Definition der Form der Symbole
xlab("Kontext - Rottenburg 'Fröbelweg'")+ ylab("Chemische Rezeptur")+ # Manuelle Achsenbeschriftung
scale_y_discrete(limits=rev)+ # Inverse Darstellung der Y-Achse
theme_light()+ # Schlichtes Design
theme(axis.line=element_line(colour="black",size=0.25))+theme(legend.title=element_blank(),legend.text=element_text(size=8),axis.title=element_text(size=9),axis.text=element_text(size=8,color="black"))+theme(legend.position="bottom")+theme(axis.ticks=element_line(size=0.25,colour="black"))+ # Manuelle Formatierung von Achsen- und Legendendarstellung
theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1)) # Vertikale Darstellung der X-Achsenbeschriftung
# Daten einlesen und filtern
data3<- read.csv("../Daten//Kap_6//Kap_6.3//Grundlagen//Datengrundlage/Daten_RHI_Ker_vollständigMW_chemGruppen.csv")
data3<-subset(data3, Kultur %in% c("La Hoguette"))
data3<-subset(data3, LeFranc %in% c("Stil A","Stil B"))
data2<-data3[,c(28,74,84),]
# Gruppieren nach Kategorien und zählen der Häufigkeiten
data<-data2 %>% count(LeFranc, Modell2,Befund)
# Diagramm erstellen
Part2<-ggplot(data, aes(x=Befund,y=Modell2, shape=LeFranc))+
geom_point(aes(shape=LeFranc),size=2)+ scale_shape_manual(values=c(5,6,4))+ # Manuelle Definition der Form der Symbole
xlab("Kontext - Rottenburg-Hailfingen 'Unter dem Tübinger Weg'")+ ylab("Chemische Rezeptur")+
scale_y_discrete(limits=rev)+ # Inverse Darstellung der Y-Achse
theme_light()+ # Schlichtes Design
theme(axis.line=element_line(colour="black",size=0.25))+theme(legend.title=element_blank(),legend.text=element_text(size=8),axis.title=element_text(size=9),axis.text=element_text(size=8,color="black"))+ theme(legend.position="bottom")+ theme(axis.ticks=element_line(size=0.25,colour="black"))+ # Manuelle Formatierung von Achsen- und Legendendarstellung
theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1)) # Vertikale Darstellung der X-Achsenbeschriftung
# Kombination der Diagramme
plot_grid(Part1,Part2,ncol=1,nrow=2,align = "v",axis = "lr",rel_heights=c(1,1))
# Export des kombinierten Diagramms
ggsave("Abb.6-171.eps",path=("../Daten//Kap_6//Kap_6.3//Abbildungen//Zusammenschau"),plot=last_plot(),device="eps",height=15,width=9,unit=c("cm"),dpi=1200)11 Literatur
Allaire u. a. 2024: J. J. Allaire/C. Teague/C. Scheidegger/Y. Xie/C. Dervieux, Quarto v.1.5.55. https://quarto.org.
Bailiss 2023: C. Bailiss, pivottabler: Create Pivot Tables: R package version 1.5.5. https://cran.r-project.org/package=pivottabler.
Barrett u. a. 2024: T. Barrett/M. Dowle/A. Srinivasan/J. Gorecki/M. Chirico/T. Hocking, data.table: Extension of ‘data.frame‘: R package version 1.15.4. https://cran.r-project.org/package=data.table.
Camargo 2024: A. Camargo, PCAtest: Statistical significance of PCA: R package version 0.0.1. https://github.com/arleyc/pcatest.
Field, A. u. a. 2013: A. Field/J. Miles/Z. Field, Discovering Statistics using R (Los Angeles 2013).
Fox u. a. 2024: J. Fox/M. Marquez/M. Bouchet-Valat, Rcmdr: R Commander: R package version 2.9-2. https://socialsciences.mcmaster.ca/jfox/misc/rcmdr/.
Kassambara 2023a: A. Kassambara, ggpubr: ’ggplot2’ Based Publication Ready Plots: R package version 0.6.0. https://cran.r-project.org/package=ggpubr.
Kassambara 2023b: A. Kassambara, rstatix: Pipe-Friendly Framework for Basic Statistical Tests: R package version 0.7.2. https://cran.r-project.org/package=rstatix.
Kassambara/Mundt 2020: A. Kassambara/F. Mundt, factoextra: Extract and Visualize the Results of Multivariate Data Analyses: R package version 1.0.7. https://cran.r-project.org/package=factoextra.
Komsta/Novomestky 2022: L. Komsta/F. Novomestky, moments: Moments, Cumulants, Skewness, Kurtosis and Related Tests: R package version 0.14.1. https://cran.r-project.org/package=moments.
Liland/Sæbø 2024: K. H. Liland/S. Sæbø, RcmdrPlugin.NMBU: R Commander Plug-in for University Level Applied Statistics: R package version 1.8.15. https://cran.r-project.org/package=rcmdrplugin.nmbu.
R Core Team 2024: R Core Team, R v.4.4.1: A Language and Environment for Statistical Computing: Race for Your Life. https://www.r-project.org/.
RStudio Team 2024: RStudio Team, RStudio v. 2024.04.2: Integrated Development Environment for R. https://www.rstudio.com/.
Schauer 2025: M. Schauer, La Hoguette – Kultur, Phänomen, Subkultur? Archäologische Studien und portable, energiedispersive Röntgenfluoreszenzanalysen (p-ED-RFA) an Keramik zu einer altbekannten Frage 183. Philippika 183 (Wiesbaden 2025).
Siegmund 2020: F. Siegmund, Statistik in der Archäologie: eine anwendungsorientierte Einführung auf Basis freier Software (Norderstedt 2020). https://frank-siegmund.de/images/opendata/2020-archaeostatistik/siegmund_2020_daten.zip.
Siegmund 2023: F. Siegmund, Einführung Quarto. https://www.frank-siegmund.de/images/opendata/einfuehrungquarto.zip.
Venables/Ripley 2007: W. N. Venables/B. D. Ripley, Modern applied statistics with S. Statistics and computing 4(New York 2007).
Wickham 2011: H. Wickham, The Split-Apply-Combine Strategy for Data Analysis. Journal of Statistical Software, 40/1, 2011, 1–29. https://www.jstatsoft.org/v40/i01/.
Wickham 2016: H. Wickham, ggplot2: Elegant graphics for data analysis. Use R! 2(Cham 2016). https://ebookcentral.proquest.com/lib/kxp/detail.action?docid=4546676.
Wickham u. a. 2019: H. Wickham/M. Averick/J. Bryan/W. Chang/L. D’Agostino McGowan/R. François/G. Grolemund/A. Hayes/L. Henry/J. Henster/M. Kuhn/T. L. Pedersen/E. Miller/S. M. Bache/K. Müller/J. Ooms/D. Robinson/D. P. Seidel/V. Spinu/K. Takahashi/D. Vaughan/C. Wilke/K. Woo/H. Yutani, Welcome to the tidyverse. Journal of Open Source Software, 43/4, 2019, 1686. DOI: https://doi.org/10.21105/joss.01686.
Wickham 2023: H. Wickham, stringr: Simple, Consistent Wrappers for Common String Operations: R package version 1.5.1. https://cran.r-project.org/package=stringr.
Wilke 2024: C. Wilke, cowplot: Streamlined Plot Theme and Plot Annotations for ’ggplot2’: R package version 1.1.3. https://cran.r-project.org/package=cowplot.
Yuan Tang/Wenxuan 2016: M. H. Yuan Tang/L. Wenxuan, ggfortify: Unified Interface to Visualize Statistical Result of Popular R Packages. The R Journal, 8/2, 2016, 478–489. https://cran.r-project.org/package=ggfortify.