library(cowplot)
library(data.table)
library(dplyr)
library(factoextra)
library(ggfortify)
library(ggplot2)
library(ggpubr)
library(MASS)
library(moments)
library(PCAtest)
library(pivottabler)
library(plyr)
library(Rcmdr)
library(RcmdrPlugin.NMBU)
library(rstatix)
library(tidyverse)1 Einleitung
1.1 Inhalt
Dieses Skript dokumentiert die zu Kapitel 6.2.4.c - Schauer (2025) gehörenden Abbildungen und Statistiken:
Kapitel 6.2.4.c.i - Definition: Abb. 6-40 - Skript-Kapitel 4.
Kapitel 6.2.4.c.i.1/d.i.1 - Multivariater Normabstand: Berechnung des multivariaten Normabstands für Modell 1 (Skript-Kapitel 5) für Haupt- (Kapitel 6.2.4.c.i.1) und Spurenelemente (Kapitel 6.2.4.d.i.1). Zusätzlich Berechnung des multivariaten Normabstands für Modell 3 der Hauptelemente (Skript-Kapitel 10). Abb. 6-41 – Skript-Kapitel 6 veranschaulicht Modell 1, Abb. 6-42 – Skript-Kapitel 7 das zugehörige Streudiagramm. Modell 2 wird in Abb. 6-43 – Skript-Kapitel 8 bzw. Abb. 6-44 – Skript-Kapitel 9 dargestellt. Das Streudiagramm für Modell 3 ist ausschließlich in Skript-Kapitel 11 hinterlegt. Streudiagramme und multivariater Normabstand für Modell 4 finden sich in Abb. 6-45 – 12 und Abb. 6-46 – 13. Das Histogramm Abb. 6-47 – 14 zeigt den Zusammenhang zwischen Rezeptur und Probenanzahl. Das Ergebnis von Dunns Test ist in Skript-Kapitel 15 hinterlegt.
Kapitel 6.2.4.c.i.2 - MANOVA: Die Berechnung der MANOVA findet sich in Skript-Kapitel 16.
Kapitel 6.2.4.c.i.3 - Hauptkomponentenanalyse: Die Berechnung der Hauptkomponentenanalyse findet sich in Skript-Kapitel 17, inklusive der Darstellung der Ladungen (Abb. 6-48 – 18), Scorewerte (Abb. 6-49 – 19) und Streudiagramme (Abb. 6-50 – 20).
Kapitel 6.2.4.c.i.4 - Diskriminanzanalyse: Die Berechnung der Diskriminanzanalyse findet sich in Skript-Kapitel 21, einschließlich der Darstellung der Ladungen (Abb. 6-51 – 22), Scorewerte (Abb. 6-52 – 23) und des Streudiagramms (Abb. 6-53 – 24). Abb. 6-54 – 26 zeigt das Streudiagramm von Modell 4 mit Hervorhebung auffälliger Gefäßeinheiten. Eine alternative Diskriminanzanalyse ohne die Rezepturen 3a, 3b und 4 ist in Skript-Kapitel 25 dokumentiert.
Kapitel 6.2.4.c.i.5 - Clusteranalyse: Die Berechnung der Clusteranalyse findet sich in Skript-Kapitel 27, inklusive einer tabellarischen Darstellung der Zuordnung von Clustern zu Probenanzahlen (Abb. 6-55 – 28) sowie Streudiagrammen (Abb. 6-56 – 29 und Abb. 6-57 – 30).
Kapitel 6.2.4.c.i.6 - Kennwerte: Abb. 6-58 - Skript-Kapitel 31.
Kapitel 6.2.4.c.i.7 - Interpretation: Die Ergebnisse der MANOVA und Hauptkomponentenanalyse für Keramik-, Boden- und Tonproben finden sich in Skript-Kapitel 32; für Keramik- und Tonproben in Kapitel 33. Visualisierungen: Ladungen (Abb. 6-59 – 32.3 / Abb. 6-62 – 33.3), Scorewerte (Abb. 6-60 – 32.4 / Abb. 6-63 – 33.4) und Streudiagramme (Abb. 6-61 – 32.5 / Abb. 6-64 – 33.5). Weitere ausgewählte Streudiagramme zur Interpretation finden sich in Abb. 6-65 – 33.6.
Kapitel 6.2.4.c.ii.1 - Keramiktechnologie, Datierung, Kontexte: Zusammenspiel von Rezepturen mit – Keramiktechnologie: Abb. 6-66 – 34 – Datierung: Abb. 6-67 – 35 – Kontexten: Abb. 6-68 – 36, Abb. 6-70 – 37. Zusammengänge zwischen Rezepturen, Technologien und Kontexten sind zudem in Abb. 6-71 – 38 dargestellt. Streudiagramme mit Darstellung der makroskopischen Warenarten: Skript-Kapitel 39.
Kapitel 6.2.4.c.ii.2 - Magerung, Gefäßform, Zierweise: Zusammenspiel von Rezepturen mit – Warenarten: Abb. 6-72 – 40 – Gefäßtypen: Abb. 6-74 – 42 – Zierweisen: Abb. 6-75 – 43, Abb. 6-76 – 44. Zusammenhänge zwischen Rezepturen, Technologien und Warenarten: Abb. 6-73 – 41.
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 bietet 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. RStudio hingegen verfügt über eine Benutzeroberfläche und greift auf R zu.
Dieses R-Skript wurde in RStudio 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 zusätzliche 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. Werden die Quarto-Dateien in RStudio geöffnet, sind die Code-Blöcke grau hinterlegt und können automatisch ausgeführt werden. Weitere Informationen zu Quarto und Quarto-Code finden sich hier.
Um mit diesem Skript zu arbeiten, wird empfohlen, R und RStudio, sowie 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-Projektdatei (.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 beliebig gespeichert werden kann – vorausgesetzt, die Daten befinden sich in den vorgegebenen Ordnern. Die einzige Voraussetzung ist, dass der unter Skript-Kapitel Kapitel 3 hinterlegte Code-Schnipsel beim ersten Arbeiten mit diesem Skript ausgeführt wird.
Ein weiterer Vorteil von R-Projekten ist, dass alle Quarto-Dateien, die beim letzten Schließen geöffnet waren, direkt beim Öffnen des Projekts wieder geladen werden – es muss also nicht manuell nach der Dateistruktur gesucht werden.
1.2.4 R Pakete
R-Pakete müssen zunächst installiert und anschließend in jeder Sitzung erneut geladen werden siehe auch Skript-Kapitel 2, um die Berechnungen auszuführen. Sie enthalten Funktionen, die für bestimmte Analysen erforderlich sind. Zum Installieren kann der folgende Code verwendet werden:
- install.packages(“Paket-Name”)
Die Pakete werden mit folgendem Befehl geladen:
- library(Paket-Name)
Eine kurze Einführung in grundlegende 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-Pakete 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 Pakete (siehe Skript-Kapitel Kapitel 2) geladen als auch das Working Directory gesetzt werden (siehe Skript-Kapitel Kapitel 3).
Der Code ist lauffähig, d. h. er kann fehlerfrei ausgeführt werden, sofern die vorgegebene Datenstruktur beibehalten wird.
In jedem Code-Block wird der Code zur Erstellung der jeweils ersten Abbildung erläutert – nachfolgende Grafiken mit vergleichbarem Code erhalten keine eigene Beschreibung.
1.4 Gerät und Messparameter
Die Messdaten wurden mit dem Niton XL3t (Nr. 97390) des Departments für Kulturwissenschaften der Universität München im TestAllGeo-Modus ermittelt (60 Sekunden Standard, Niedrig, Hoch sowie 120 Sekunden Leicht-Modus) und mit einem 8 mm Messspot von M. Schauer durchgeführt. Die Messungen fanden von September bis Dezember 2018 sowie von September 2019 bis Juli 2020 statt. Weitere Informationen finden sich in Kapitel 6.1.1 – Schauer (2025).
2 Notwendige R Pakete
3 Working directory
knitr::opts_knit$set(root.dir = "./")4 Abb. 6-40
# Daten einlesen und filtern
data2<- read.csv("../Daten//Kap_6//Kap_6.2//Grundlagen//Datengrundlage//Daten_BB_vollständigMW_bearb.csv")
data3<-subset(data2, Messstelle %in% c("frischer Bruch"))
data<-subset(data3, Kultur %in% c("LBK","La Hoguette"))
# Darstellungsreihenfolge definieren
data$Kultur<-factor(data$Kultur,levels=c("LBK","La Hoguette"))
# Diagramme erstellen
P2O5_Ba<-ggplot(data, aes(x=P2O5,y=Ba, color=Kultur, shape=Kultur))+
scale_color_manual(name="Kultur",values=c("grey30","grey90"))+ # Manuelle Definition der Farbe der Symbole
geom_point(aes(shape=Kultur),size=2)+scale_shape_manual(values=c(19,17))+ # Manuelle Definition von Größe und Form der Symbole
xlab("P2O5 in %")+ylab("Ba 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
CaO_Ba<-ggplot(data, aes(x=CaO,y=Ba, color=Kultur, shape=Kultur))+
scale_color_manual(name="Kultur",values=c("grey30","grey90"))+
geom_point(aes(shape=Kultur),size=2)+scale_shape_manual(values=c(19,17))+
xlab("CaO in %")+ylab("Ba 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"))
CaO_P2O5<-ggplot(data, aes(x=CaO,y=P2O5, color=Kultur, shape=Kultur))+
scale_color_manual(name="Kultur",values=c("grey30","grey90"))+
geom_point(aes(shape=Kultur),size=2)+scale_shape_manual(values=c(19,17))+
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"))
# Kombination der Diagramme
ggarrange(P2O5_Ba,CaO_Ba,CaO_P2O5,ncol=2,nrow=2,align = "hv",common.legend=TRUE)+theme(legend.position="bottom")
# Export des kombinierten Diagramms
ggsave("Abb.6-40.eps",path=("../Daten//Kap_6//Kap_6.2//Abbildungen//Rezeptur//"),plot=last_plot(),device="eps",height=10,width=12,unit=c("cm"),dpi=1200)5 Modell 1 - Normabstand berechnen
5.1 Zusammenstellen der Daten
# Daten einlesen und filtern
data1<- read.csv("../Daten//Kap_6//Kap_6.2//Grundlagen//Datengrundlage//Daten_BB_vollständigMW_bearb.csv")
data2<-subset(data1, Messstelle %in% c("frischer Bruch"))
data3<-subset(data2, Kultur %in% c("LBK"))
data<-data3[,2:23]
data4<-subset(data2, Kultur %in% c("LBK","La Hoguette"))
# Definieren relevanter Variablen
Probennummer<-data4$Probennummer
Kultur<-data4$Kultur
# Berechnung des Medians der LBK-Keramik
MedianLBK<-(data) %>% dplyr::summarise(across(everything(),list(median=median)))
# Entfernen von "_median" aus den Spaltennamen
colnames(MedianLBK) <- gsub("_median", "", colnames(MedianLBK))5.2 Normabstand der Keramik zum Median der LBK 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_V<-MedianLBK$V
data_V<-data4$V
V<-sqrt((data_V-MedianLBK_V)^2)/MedianLBK_V
MedianLBK_Cr<-MedianLBK$Cr
data_Cr<-data4$Cr
Cr<-sqrt((data_Cr-MedianLBK_Cr)^2)/MedianLBK_Cr
MedianLBK_Ni<-MedianLBK$Ni
data_Ni<-data4$Ni
Ni<-sqrt((data_Ni-MedianLBK_Ni)^2)/MedianLBK_Ni
MedianLBK_Cu<-MedianLBK$Cu
data_Cu<-data4$Cu
Cu<-sqrt((data_Cu-MedianLBK_Cu)^2)/MedianLBK_Cu
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
MedianLBK_Nb<-MedianLBK$Nb
data_Nb<-data4$Nb
Nb<-sqrt((data_Nb-MedianLBK_Nb)^2)/MedianLBK_Nb
MedianLBK_Ba<-MedianLBK$Ba
data_Ba<-data4$Ba
Ba<-sqrt((data_Ba-MedianLBK_Ba)^2)/MedianLBK_Ba
MedianLBK_Pb<-MedianLBK$Pb
data_Pb<-data4$Pb
Pb<-sqrt((data_Pb-MedianLBK_Pb)^2)/MedianLBK_Pb5.3 Normabstand Rezepturen
# Kombinieren mehrerer Dataframes
Normabstand_HE<-data.frame(Probennummer,Kultur,SiO2,TiO2,Al2O3,Fe2O3,MnO,CaO,K2O,P2O5)
# Berechnen des Normabstandes pro Probe basierend auf den Hauptelementen
Normabstand_HE<-Normabstand_HE %>% rowwise() %>% mutate(Summe = sum(c(SiO2,TiO2,Al2O3,Fe2O3,MnO,CaO,K2O,P2O5)))
# Speichern als CSV
write.csv(Normabstand_HE,"../Daten//Kap_6//Kap_6.2//Grundlagen//Datengrundlage//Normabstand_BB_HE.csv",row.names=FALSE)5.4 Normabstand Herkunft
# Kombinieren mehrerer Dataframes
Normabstand_SE<-data.frame(Probennummer,Kultur,Cu,Zn,Rb,Sr,Y,Zr,Nb,Pb)
# Berechnen des Normabstandes pro Probe basierend auf den Spurenelementen
Normabstand_SE<-Normabstand_SE %>% rowwise() %>% mutate(Summe = sum(c(Cu,Zn,Rb,Sr,Y,Zr,Nb,Pb)))
# Speichern als CSV
write.csv(Normabstand_SE,"../Daten//Kap_6//Kap_6.2//Grundlagen//Datengrundlage//Normabstand_BB_SE.csv",row.names=FALSE)6 Abb. 6-41
6.1 Zusammenstellen der Daten
# Daten einlesen und filtern
data1<-read.csv("../Daten//Kap_6//Kap_6.2//Grundlagen//Datengrundlage//Normabstand_BB_HE.csv")
data2<- read.csv("../Daten//Kap_6//Kap_6.2//Grundlagen//Datengrundlage//Daten_BB_vollständigMW_bearb.csv")
data3<-subset(data2, Messstelle %in% c("frischer Bruch"))
data4<-subset(data3, Kultur %in% c("LBK","La Hoguette"))
data5<-data4[,1:22]
# Kombinieren mehrerer Dataframes basierend auf der Probennummer
data<-merge(data1,data5, by="Probennummer", all=TRUE)
# Entfernen von ".y" aus den Spaltennamen
colnames(data) <- gsub(".y", "", colnames(data))
# Spaltennamen "Summe" durch "Normabst" ersetzen
colnames(data) <- gsub("Summe", "Normabst", colnames(data))
# Speichern als CSV
write.csv(data,"../Daten//Kap_6//Kap_6.2//Grundlagen//Rezeptur//Normabstand_HE_BB_mitMesswerten.csv",row.names=FALSE)Die weitere Einteilung der Proben in die chemischen Rezepturen beginnend mit Modell 2 erfolgte in Excel.
6.2 Histogramm
# Daten einlesen
data<-read.csv("../Daten//Kap_6//Kap_6.2//Grundlagen//Rezeptur//Normabstand_HE_BB_mitMesswerten.csv")
# 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_NormHE_Keramik_LBKI<-ggplot(data,aes(x=Normabst))+
geom_histogram(fill="lightgrey",color="black",binwidth=0.5,bins=NULL)+ # Manuelle Definition der Farbe der Balken
ylab("Häufigkeit")+ # Manuelle Achsenbeschriftung
theme_classic()+ # Klassisches Design
scale_x_continuous(breaks=seq(-1,16,1))+
scale_y_continuous(breaks=seq(0,100,20))+ # Manuelle Definition der Achsen
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(aes(xintercept=median(Normabst)),color="blue", linetype="dashed", linewidth=1)+theme(axis.title.x=element_blank())+ # Vertikale Markierung des Medians
geom_vline(data=Normabst0, aes(xintercept=lower), color="red", linetype="dotted", linewidth=1)+ # Vertikale Markierung des 25%-Quartils
geom_vline(data=Normabst0, aes(xintercept=upper), color="red", linetype="dotted", linewidth=1) # Vertikale Markierung des 75%-Quartils
# Berechnung der unteren (25%) und oberen (75%) Quartile für die Spalte "Normabst" nach Kultur
Normabst1 <- (data) %>%
group_by(Kultur) %>%
dplyr::summarise(lower = quantile(Normabst, probs = .25),
upper = quantile(Normabst, probs = .75))
# Diagramm erstellen
Hist_NormHE_Keramik_nKultur_LBKI<-ggplot(subset(data,Kultur %in% c("La Hoguette","LBK")),aes(x=Normabst))+
geom_histogram(fill="lightgrey", color="black",binwidth=0.5,bins=NULL)+ # Manuelle Definition der Farbe der Balken
xlab("Distanz zur typisch bandkeramischen Rezeptur von Friedberg-Bruchenbrücken")+ylab("Häufigkeit")+ # Manuelle Achsenbeschriftung
theme_classic()+ # Klassisches Design
scale_x_continuous(breaks=seq(-1,16,1))+ # Manuelle Definition der Achsen
scale_y_continuous(breaks=seq(0,70,20))+
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(Kultur~.)+theme(strip.text.y = element_text(angle = 0),strip.background = element_rect(colour="white", fill="white"))+ # Facettierung nach Kategorien
geom_vline(data=ddply(subset(data,Kultur %in% c("La Hoguette","LBK")), "Kultur", dplyr::summarise, grp.median=median(Normabst)), aes(xintercept=grp.median),color="blue", linetype="dashed", linewidth=1)+ # Vertikale Markierung des Medians nach Kategorien
geom_vline(data=Normabst1, aes(xintercept=lower), color="red", linetype="dotted", linewidth=1)+ # Vertikale Markierung des 25%-Quartils nach Kategorien
geom_vline(data=Normabst1, aes(xintercept=upper), color="red", linetype="dotted", linewidth=1)+ # Vertikale Markierung des 75%-Quartils nach Kategorien
labs(subtitle=paste("Kruskal-Wallis, p=",round(({compare_means(Normabst ~ Kultur,aes(x=Normabst), data=subset(data,Kultur %in% c("La Hoguette","LBK")),method="kruskal.test")$p}),6))) # Berechnen des Kruskal-Wallis-Tests inkl. p-Wert und anzeigen als Unterüberschrift
# Kombination der Diagramme
plot_grid(Hist_NormHE_Keramik_LBKI,Hist_NormHE_Keramik_nKultur_LBKI,ncol=1,nrow=2,align = "v",axis = "lr",rel_heights=c(1,3))
# Export des kombinierten Diagramms
ggsave("Abb.6-41.eps",path=("../Daten//Kap_6//Kap_6.2//Abbildungen//Rezeptur//"),plot=last_plot(),device="eps",height=9,width=15.3,unit=c("cm"),dpi=1200)6.3 Kennwerte
# Berechnen von Mittelwert und Standardabweichung für den gesamten Datensatz
data %>% dplyr::summarise(m = mean(Normabst),sd=sd(Normabst)) m sd
1 2.467804 2.043407# Berechnen von Mittelwert und Standardabweichung nach Kategorien
group_by(data, Kultur) %>% dplyr::summarise(m = mean(Normabst),sd=sd(Normabst))# A tibble: 2 × 3
Kultur m sd
<chr> <dbl> <dbl>
1 LBK 2.13 1.63
2 La Hoguette 3.56 2.76# Anzahl der Gesamtbeobachtungen
data %>% dplyr::summarise(count=n()) count
1 283# Anzahl der Beobachtungen pro Kategorie
data %>% group_by(Kultur) %>% dplyr::summarise(count=n())# A tibble: 2 × 2
Kultur count
<chr> <int>
1 LBK 216
2 La Hoguette 677 Abb. 6-42
Die Einteilung der Proben in die chemischen Rezepturen erfolgte in Excel.
# Daten einlesen
data<-read.csv("../Daten//Kap_6//Kap_6.2//Grundlagen//Rezeptur//Normabstand_HE_BB_mitMesswerten_bearb.csv")
# Daten nach ausgewählter Spalte sortieren
data<-data[order(data$Modell1),]
# Diagramme erstellen
Modell1_HE_CaO_Fe2O3<-ggplot(data, aes(x=CaO,y=Fe2O3, color=Modell1, shape=Kultur))+
geom_point(aes(shape=Kultur),size=2)+scale_shape_manual(values=c(17,19))+ # Manuelle Definition von Größe und Form der Symbole
scale_color_manual(name="Modell1",values=c("cyan4","grey","brown"))+ # Manuelle Definition der Farbe der Symbole
xlab("CaO in %")+ylab("Fe2O3 in %")+ # 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
Modell1_HE_CaO_P2O5<-ggplot(data, aes(x=CaO,y=P2O5, color=Modell1, shape=Kultur))+
geom_point(aes(shape=Kultur),size=2)+scale_shape_manual(values=c(17,19))+
scale_color_manual(name="Modell1",values=c("cyan4","grey","brown"))+
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"))
Modell1_HE_Al2O3_SiO2<-ggplot(data, aes(x=Al2O3,y=SiO2, color=Modell1, shape=Kultur))+
geom_point(aes(shape=Kultur),size=2)+scale_shape_manual(values=c(17,19))+
scale_color_manual(name="Modell1",values=c("cyan4","grey","brown"))+
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"))
Modell1_HE_TiO2_K2O<-ggplot(data, aes(x=TiO2,y=K2O, color=Modell1, shape=Kultur))+
geom_point(aes(shape=Kultur),size=2)+scale_shape_manual(values=c(17,19))+
scale_color_manual(name="Modell1",values=c("cyan4","grey","brown"))+
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"))
# Kombination der Diagramme
ggarrange(Modell1_HE_Al2O3_SiO2,Modell1_HE_CaO_P2O5,Modell1_HE_CaO_Fe2O3,Modell1_HE_TiO2_K2O,ncol=2,nrow=2,align = "hv",common.legend=TRUE)+theme(legend.position="bottom")
# Export des kombinierten Diagramms
ggsave("Abb.6-42.eps",path=("../Daten//Kap_6//Kap_6.2//Abbildungen//Rezeptur//"),plot=last_plot(),device="eps",height=11,width=15.3,unit=c("cm"),dpi=1200)8 Abb. 6-43
Die Datei Normabstand_HE_BB_mitMesswerten wurde in Excel um die beschriebenen Veränderungen für Modell 2 erweitert.
# Daten einlesen
data<-read.csv("../Daten//Kap_6//Kap_6.2//Grundlagen//Rezeptur//Normabstand_HE_BB_mitMesswerten_bearb.csv")
# Daten nach ausgewählter Spalte sortieren
data<-data[order(data$Modell2),]
# Diagramme erstellen
Modell2_HE_CaO_Fe2O3<-ggplot(data, aes(x=CaO,y=Fe2O3, color=Modell2, shape=Kultur))+
geom_point(aes(shape=Kultur),size=2)+scale_shape_manual(values=c(17,19))+ # Manuelle Definition von Größe und Form der Symbole
scale_color_manual(name="Modell2",values=c("cyan4","grey","burlywood","brown","red","black"))+ # Manuelle Definition der Farbe der Symbole
xlab("CaO in %")+ylab("Fe2O3 in %")+ # 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
Modell2_HE_CaO_P2O5<-ggplot(data, aes(x=CaO,y=P2O5, color=Modell2, shape=Kultur))+
geom_point(aes(shape=Kultur),size=2)+scale_shape_manual(values=c(17,19))+
scale_color_manual(name="Modell2",values=c("cyan4","grey","burlywood","brown","red","black"))+
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"))
Modell2_HE_Al2O3_SiO2<-ggplot(data, aes(x=Al2O3,y=SiO2, color=Modell2, shape=Kultur))+
geom_point(aes(shape=Kultur),size=2)+scale_shape_manual(values=c(17,19))+
scale_color_manual(name="Modell2",values=c("cyan4","grey","burlywood","brown","red","black"))+
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"))
Modell2_HE_TiO2_K2O<-ggplot(data, aes(x=TiO2,y=K2O, color=Modell2, shape=Kultur))+
geom_point(aes(shape=Kultur),size=2)+scale_shape_manual(values=c(17,19))+
scale_color_manual(name="Modell2",values=c("cyan4","grey","burlywood","brown","red","black"))+
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"))
# Kombination der Diagramme
ggarrange(Modell2_HE_Al2O3_SiO2,Modell2_HE_CaO_P2O5,Modell2_HE_CaO_Fe2O3,Modell2_HE_TiO2_K2O,ncol=2,nrow=2,align = "hv",common.legend=TRUE)+theme(legend.position="bottom")
# Export des kombinierten Diagramms
ggsave("Abb.6-43.eps",path=("../Daten//Kap_6//Kap_6.2//Abbildungen//Rezeptur//"),plot=last_plot(),device="eps",height=11,width=15.3,unit=c("cm"),dpi=1200)9 Abb. 6-44
Die Einteilung der Proben in die chemischen Rezepturen erfolgte in Excel.
9.1 Histogramm
# Daten einlesen
data<-read.csv("../Daten//Kap_6//Kap_6.2//Grundlagen//Rezeptur//Normabstand_HE_BB_mitMesswerten_bearb.csv")
# 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_NormHE_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
ylab("Häufigkeit")+ # Manuelle Achsenbeschriftung
theme_classic()+ # Klassisches Design
scale_x_continuous(breaks=seq(-1,16,1))+scale_y_continuous(breaks=seq(0,100,20))+ # Manuelle Definition der Achsen
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(aes(xintercept=median(Normabst)),color="blue", linetype="dashed", linewidth=1)+theme(axis.title.x=element_blank())+ # Vertikale Markierung des Medians
geom_vline(data=Normabst0, aes(xintercept=lower), color="red", linetype="dotted", linewidth=1)+ # Vertikale Markierung des 25%-Quartils
geom_vline(data=Normabst0, aes(xintercept=upper), color="red", linetype="dotted", linewidth=1) # Vertikale Markierung des 75%-Quartils
# Berechnung der unteren (25%) und oberen (75%) Quartile für die Spalte "Normabst" nach Modell 2
Normabst10 <- (data) %>%
group_by(Modell2) %>%
dplyr::summarise(lower = quantile(Normabst, probs = .25),
upper = quantile(Normabst, probs = .75))
# Diagramm erstellen
Hist_Modell2<-ggplot(data,aes(x=Normabst))+
geom_histogram(fill="lightgrey", color="black",binwidth=0.5,bins=NULL)+ # Manuelle Definition der Farbe der Balken
xlab("Distanz zur typisch bandkeramischen Rezeptur von Friedberg-Bruchenbrücken")+ylab("Häufigkeit")+ # Manuelle Achsenbeschriftung
theme_classic()+ # Klassisches Design
scale_x_continuous(breaks=seq(-1,16,1))+ # Manuelle Definition der Achsen
scale_y_continuous(breaks=seq(0,100,20))+
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(Modell2~.)+theme(strip.text.y = element_text(angle = 0),strip.background = element_rect(colour="white", fill="white"))+ # Facettierung nach Kategorien
geom_vline(data=ddply(data,"Modell2", dplyr::summarise, grp.median=median(Normabst)), aes(xintercept=grp.median),color="blue", linetype="dashed", linewidth=1)+ # Vertikale Markierung des Medians nach Kategorien
geom_vline(data=Normabst10, aes(xintercept=lower), color="red", linetype="dotted", linewidth=1)+ # Vertikale Markierung des 25%-Quartils nach Kategorien
geom_vline(data=Normabst10, aes(xintercept=upper), color="red", linetype="dotted", linewidth=1) # Vertikale Markierung des 75%-Quartils nach Kategorien
# Kombination der Diagramme
plot_grid(Hist_NormHE_Keramik_LBKI,Hist_Modell2,ncol=1,nrow=2,align = "v",axis = "lr",rel_heights=c(1,4))
# Export des kombinierten Diagramms
ggsave("Abb.6-44.eps",path=("../Daten//Kap_6//Kap_6.2//Abbildungen//Rezeptur//"),plot=last_plot(),device="eps",height=17,width=15.3,unit=c("cm"),dpi=1200)9.2 Kennwerte
# Berechnen von Mittelwert und Standardabweichung für den gesamten Datensatz
data %>% dplyr::summarise(m = mean(Normabst),sd=sd(Normabst)) m sd
1 2.467804 2.043407# Berechnen von Mittelwert und Standardabweichung nach Kategorien
group_by(data, Modell2) %>% dplyr::summarise(m = mean(Normabst),sd=sd(Normabst))# A tibble: 6 × 3
Modell2 m sd
<chr> <dbl> <dbl>
1 Rezeptur 1 1.73 0.666
2 Rezeptur 2a 5.76 0.645
3 Rezeptur 2b 6.65 1.16
4 Rezeptur 3a 9.45 NA
5 Rezeptur 3b 9.81 0.278
6 Rezeptur 4 15.8 NA # Anzahl der Gesamtbeobachtungen
data %>% dplyr::summarise(count=n()) count
1 283# Anzahl der Beobachtungen pro Kategorie
data %>% group_by(Modell2) %>% dplyr::summarise(count=n())# A tibble: 6 × 2
Modell2 count
<chr> <int>
1 Rezeptur 1 242
2 Rezeptur 2a 12
3 Rezeptur 2b 25
4 Rezeptur 3a 1
5 Rezeptur 3b 2
6 Rezeptur 4 110 Berechnen des Test für Modell 2 (Modell 3)
10.1 Zusammenstellen der Daten
# Daten einlesen und filtern
data1<-read.csv("../Daten//Kap_6//Kap_6.2//Grundlagen//Rezeptur//Normabstand_HE_BB_mitMesswerten_bearb.csv")
data<-data1[,c(3:10,33),]
# Umbennennen der Spaltenköpfe
data<-data %>% dplyr::rename(Si=1,Al=2,Ti=3,Fe=4,Mn=5,Ca=6,K=7,P=8)
# Definieren relevanter Variablen
Probennummer<-data1$Probennummer
Kultur<-data1$Kultur
# Berechnung des Medians der Gruppen nach Modell 2
MedianGruppenMod3<-(data) %>%
group_by(Modell2) %>%
dplyr::summarise(across(everything(),list(median=median)))
# Entfernen von "_median" aus den Spaltennamen
colnames(MedianGruppenMod3) <- gsub("_median", "", colnames(MedianGruppenMod3))10.2 Normabstand zum Median von Rezeptur 1
# Filtern nach den Daten von Rezeptur 1
MedianRezeptur1Mod3<-filter(MedianGruppenMod3, Modell2=="Rezeptur 1")
# Extrahieren des Medians von Rezepetur 1 für SiO2
MedianRezeptur1Mod3_Si<-MedianRezeptur1Mod3$Si
# Extrahieren der Messwerte für SiO2
data_Si<-data$Si
# Berechnen des Multivariaten Normabstandes für jede Probe zum Median von Rezeptur 1 von SiO2
Si<-sqrt((data_Si-MedianRezeptur1Mod3_Si)^2)
MedianRezeptur1Mod3_Ti<-MedianRezeptur1Mod3$Ti
data_Ti<-data$Ti
Ti<-sqrt((data_Ti-MedianRezeptur1Mod3_Ti)^2)
MedianRezeptur1Mod3_Al<-MedianRezeptur1Mod3$Al
data_Al<-data$Al
Al<-sqrt((data_Al-MedianRezeptur1Mod3_Al)^2)
MedianRezeptur1Mod3_Fe<-MedianRezeptur1Mod3$Fe
data_Fe<-data$Fe
Fe<-sqrt((data_Fe-MedianRezeptur1Mod3_Fe)^2)
MedianRezeptur1Mod3_Mn<-MedianRezeptur1Mod3$Mn
data_Mn<-data$Mn
Mn<-sqrt((data_Mn-MedianRezeptur1Mod3_Mn)^2)
MedianRezeptur1Mod3_Ca<-MedianRezeptur1Mod3$Ca
data_Ca<-data$Ca
Ca<-sqrt((data_Ca-MedianRezeptur1Mod3_Ca)^2)
MedianRezeptur1Mod3_K<-MedianRezeptur1Mod3$K
data_K<-data$K
K<-sqrt((data_K-MedianRezeptur1Mod3_K)^2)
MedianRezeptur1Mod3_P<-MedianRezeptur1Mod3$P
data_P<-data$P
P<-sqrt((data_P-MedianRezeptur1Mod3_P)^2)
# Kombinieren mehrerer Dataframes
Normabstand_HE<-data.frame(Probennummer,Kultur,Si,Ti,Al,Fe,Mn,Ca,K,P)
# Berechnen des Normabstandes zum Median von Rezeptur 1 pro Probe basierend auf den Hauptelementen
Normabstand_Rez1Tabelle<-Normabstand_HE %>% rowwise() %>% mutate(Summe = sum(c(Si,Ti,Al,Fe,Mn,Ca,K,P)))
# Definieren der Summe als Variablen
Normabstand_Rez1<-Normabstand_Rez1Tabelle$Summe10.3 Normabstand zum Median von Rezeptur 2a
MedianRezeptur2aMod3<-filter(MedianGruppenMod3, Modell2=="Rezeptur 2a")
MedianRezeptur2aMod3_Si<-MedianRezeptur2aMod3$Si
data_Si<-data$Si
Si<-sqrt((data_Si-MedianRezeptur2aMod3_Si)^2)
MedianRezeptur2aMod3_Ti<-MedianRezeptur2aMod3$Ti
data_Ti<-data$Ti
Ti<-sqrt((data_Ti-MedianRezeptur2aMod3_Ti)^2)
MedianRezeptur2aMod3_Al<-MedianRezeptur2aMod3$Al
data_Al<-data$Al
Al<-sqrt((data_Al-MedianRezeptur2aMod3_Al)^2)
MedianRezeptur2aMod3_Fe<-MedianRezeptur2aMod3$Fe
data_Fe<-data$Fe
Fe<-sqrt((data_Fe-MedianRezeptur2aMod3_Fe)^2)
MedianRezeptur2aMod3_Mn<-MedianRezeptur2aMod3$Mn
data_Mn<-data$Mn
Mn<-sqrt((data_Mn-MedianRezeptur2aMod3_Mn)^2)
MedianRezeptur2aMod3_Ca<-MedianRezeptur2aMod3$Ca
data_Ca<-data$Ca
Ca<-sqrt((data_Ca-MedianRezeptur2aMod3_Ca)^2)
MedianRezeptur2aMod3_K<-MedianRezeptur2aMod3$K
data_K<-data$K
K<-sqrt((data_K-MedianRezeptur2aMod3_K)^2)
MedianRezeptur2aMod3_P<-MedianRezeptur2aMod3$P
data_P<-data$P
P<-sqrt((data_P-MedianRezeptur2aMod3_P)^2)
Normabstand_HE<-data.frame(Probennummer,Kultur,Si,Ti,Al,Fe,Mn,Ca,K,P)
Normabstand_Rez2a_Tabelle<-Normabstand_HE %>% rowwise() %>% mutate(Summe = sum(c(Si,Ti,Al,Fe,Mn,Ca,K,P)))
Normabstand_Rez2a<-Normabstand_Rez2a_Tabelle$Summe10.4 Normabstand zum Median von Rezeptur 2b
MedianRezeptur2bMod3<-filter(MedianGruppenMod3, Modell2=="Rezeptur 2b")
MedianRezeptur2bMod3_Si<-MedianRezeptur2bMod3$Si
data_Si<-data$Si
Si<-sqrt((data_Si-MedianRezeptur2bMod3_Si)^2)
MedianRezeptur2bMod3_Ti<-MedianRezeptur2bMod3$Ti
data_Ti<-data$Ti
Ti<-sqrt((data_Ti-MedianRezeptur2bMod3_Ti)^2)
MedianRezeptur2bMod3_Al<-MedianRezeptur2bMod3$Al
data_Al<-data$Al
Al<-sqrt((data_Al-MedianRezeptur2bMod3_Al)^2)
MedianRezeptur2bMod3_Fe<-MedianRezeptur2bMod3$Fe
data_Fe<-data$Fe
Fe<-sqrt((data_Fe-MedianRezeptur2bMod3_Fe)^2)
MedianRezeptur2bMod3_Mn<-MedianRezeptur2bMod3$Mn
data_Mn<-data$Mn
Mn<-sqrt((data_Mn-MedianRezeptur2bMod3_Mn)^2)
MedianRezeptur2bMod3_Ca<-MedianRezeptur2bMod3$Ca
data_Ca<-data$Ca
Ca<-sqrt((data_Ca-MedianRezeptur2bMod3_Ca)^2)
MedianRezeptur2bMod3_K<-MedianRezeptur2bMod3$K
data_K<-data$K
K<-sqrt((data_K-MedianRezeptur2bMod3_K)^2)
MedianRezeptur2bMod3_P<-MedianRezeptur2bMod3$P
data_P<-data$P
P<-sqrt((data_P-MedianRezeptur2bMod3_P)^2)
Normabstand_HE<-data.frame(Probennummer,Kultur,Si,Ti,Al,Fe,Mn,Ca,K,P)
Normabstand_Rez2b_Tabelle<-Normabstand_HE %>% rowwise() %>% mutate(Summe = sum(c(Si,Ti,Al,Fe,Mn,Ca,K,P)))
Normabstand_Rez2b<-Normabstand_Rez2b_Tabelle$Summe10.5 Normabstand zum Median von Rezeptur 3a
MedianRezeptur3aMod3<-filter(MedianGruppenMod3, Modell2=="Rezeptur 3a")
MedianRezeptur3aMod3_Si<-MedianRezeptur3aMod3$Si
data_Si<-data$Si
Si<-sqrt((data_Si-MedianRezeptur3aMod3_Si)^2)
MedianRezeptur3aMod3_Ti<-MedianRezeptur3aMod3$Ti
data_Ti<-data$Ti
Ti<-sqrt((data_Ti-MedianRezeptur3aMod3_Ti)^2)
MedianRezeptur3aMod3_Al<-MedianRezeptur3aMod3$Al
data_Al<-data$Al
Al<-sqrt((data_Al-MedianRezeptur3aMod3_Al)^2)
MedianRezeptur3aMod3_Fe<-MedianRezeptur3aMod3$Fe
data_Fe<-data$Fe
Fe<-sqrt((data_Fe-MedianRezeptur3aMod3_Fe)^2)
MedianRezeptur3aMod3_Mn<-MedianRezeptur3aMod3$Mn
data_Mn<-data$Mn
Mn<-sqrt((data_Mn-MedianRezeptur3aMod3_Mn)^2)
MedianRezeptur3aMod3_Ca<-MedianRezeptur3aMod3$Ca
data_Ca<-data$Ca
Ca<-sqrt((data_Ca-MedianRezeptur3aMod3_Ca)^2)
MedianRezeptur3aMod3_K<-MedianRezeptur3aMod3$K
data_K<-data$K
K<-sqrt((data_K-MedianRezeptur3aMod3_K)^2)
MedianRezeptur3aMod3_P<-MedianRezeptur3aMod3$P
data_P<-data$P
P<-sqrt((data_P-MedianRezeptur3aMod3_P)^2)
Normabstand_HE<-data.frame(Probennummer,Kultur,Si,Ti,Al,Fe,Mn,Ca,K,P)
Normabstand_Rez3a_Tabelle<-Normabstand_HE %>% rowwise() %>% mutate(Summe = sum(c(Si,Ti,Al,Fe,Mn,Ca,K,P)))
Normabstand_Rez3a<-Normabstand_Rez3a_Tabelle$Summe10.6 Normabstand zum Median von Rezeptur 3b
MedianRezeptur3bMod3<-filter(MedianGruppenMod3, Modell2=="Rezeptur 3b")
MedianRezeptur3bMod3_Si<-MedianRezeptur3bMod3$Si
data_Si<-data$Si
Si<-sqrt((data_Si-MedianRezeptur3bMod3_Si)^2)
MedianRezeptur3bMod3_Ti<-MedianRezeptur3bMod3$Ti
data_Ti<-data$Ti
Ti<-sqrt((data_Ti-MedianRezeptur3bMod3_Ti)^2)
MedianRezeptur3bMod3_Al<-MedianRezeptur3bMod3$Al
data_Al<-data$Al
Al<-sqrt((data_Al-MedianRezeptur3bMod3_Al)^2)
MedianRezeptur3bMod3_Fe<-MedianRezeptur3bMod3$Fe
data_Fe<-data$Fe
Fe<-sqrt((data_Fe-MedianRezeptur3bMod3_Fe)^2)
MedianRezeptur3bMod3_Mn<-MedianRezeptur3bMod3$Mn
data_Mn<-data$Mn
Mn<-sqrt((data_Mn-MedianRezeptur3bMod3_Mn)^2)
MedianRezeptur3bMod3_Ca<-MedianRezeptur3bMod3$Ca
data_Ca<-data$Ca
Ca<-sqrt((data_Ca-MedianRezeptur3bMod3_Ca)^2)
MedianRezeptur3bMod3_K<-MedianRezeptur3bMod3$K
data_K<-data$K
K<-sqrt((data_K-MedianRezeptur3bMod3_K)^2)
MedianRezeptur3bMod3_P<-MedianRezeptur3bMod3$P
data_P<-data$P
P<-sqrt((data_P-MedianRezeptur3bMod3_P)^2)
Normabstand_HE<-data.frame(Probennummer,Kultur,Si,Ti,Al,Fe,Mn,Ca,K,P)
Normabstand_Rez3b_Tabelle<-Normabstand_HE %>% rowwise() %>% mutate(Summe = sum(c(Si,Ti,Al,Fe,Mn,Ca,K,P)))
Normabstand_Rez3b<-Normabstand_Rez3b_Tabelle$Summe10.7 Normabstand zum Median von Rezeptur 4
MedianRezeptur4Mod3<-filter(MedianGruppenMod3, Modell2=="Rezeptur 4")
MedianRezeptur4Mod3_Si<-MedianRezeptur4Mod3$Si
data_Si<-data$Si
Si<-sqrt((data_Si-MedianRezeptur4Mod3_Si)^2)
MedianRezeptur4Mod3_Ti<-MedianRezeptur4Mod3$Ti
data_Ti<-data$Ti
Ti<-sqrt((data_Ti-MedianRezeptur4Mod3_Ti)^2)
MedianRezeptur4Mod3_Al<-MedianRezeptur4Mod3$Al
data_Al<-data$Al
Al<-sqrt((data_Al-MedianRezeptur4Mod3_Al)^2)
MedianRezeptur4Mod3_Fe<-MedianRezeptur4Mod3$Fe
data_Fe<-data$Fe
Fe<-sqrt((data_Fe-MedianRezeptur4Mod3_Fe)^2)
MedianRezeptur4Mod3_Mn<-MedianRezeptur4Mod3$Mn
data_Mn<-data$Mn
Mn<-sqrt((data_Mn-MedianRezeptur4Mod3_Mn)^2)
MedianRezeptur4Mod3_Ca<-MedianRezeptur4Mod3$Ca
data_Ca<-data$Ca
Ca<-sqrt((data_Ca-MedianRezeptur4Mod3_Ca)^2)
MedianRezeptur4Mod3_K<-MedianRezeptur4Mod3$K
data_K<-data$K
K<-sqrt((data_K-MedianRezeptur4Mod3_K)^2)
MedianRezeptur4Mod3_P<-MedianRezeptur4Mod3$P
data_P<-data$P
P<-sqrt((data_P-MedianRezeptur4Mod3_P)^2)
Normabstand_HE<-data.frame(Probennummer,Kultur,Si,Ti,Al,Fe,Mn,Ca,K,P)
Normabstand_Rez4_Tabelle<-Normabstand_HE %>% rowwise() %>% mutate(Summe = sum(c(Si,Ti,Al,Fe,Mn,Ca,K,P)))
Normabstand_Rez4<-Normabstand_Rez4_Tabelle$Summe10.8 Zusammenführen der Variablen
# Kombinieren mehrerer Dataframes
NormabstandGruppenMod3<-data.frame(Normabstand_Rez1,Normabstand_Rez2a,Normabstand_Rez2b,Normabstand_Rez3a,Normabstand_Rez3b,Normabstand_Rez4)10.9 Zuweisen der Funde zum geringsten Normabstand
# Bestimmen der Rezeptur mit dem kleinsten Normabstand für jede Probe
Min<-colnames(NormabstandGruppenMod3)[apply(NormabstandGruppenMod3,1,which.min)]
# Definieren der Summe als Variablen
data1$Modell3<-Min
# Spaltennamen "Normabstand_Rez" durch "Rezeptur" ersetzen
data1$Modell3<-gsub("Normabstand_Rez","Rezeptur ",data1$Modell3)
# Speichern als CSV
write.csv(data1,"../Daten//Kap_6//Kap_6.2//Grundlagen//Rezeptur//TestRezepturen_Abstmaß.csv",row.names=FALSE)11 Streudiagramme zu Modell 3
# Daten einlesen
data<-read.csv("../Daten//Kap_6//Kap_6.2//Grundlagen//Rezeptur//TestRezepturen_Abstmaß_bearb.csv")
# Daten nach ausgewählter Spalte sortieren
data<-data[order(data$Modell3),]
# Diagramme erstellen
Modell3_HE_CaO_Fe2O3<-ggplot(data, aes(x=CaO,y=Fe2O3, color=Modell3, shape=Kultur))+
geom_point(aes(shape=Kultur),size=2)+scale_shape_manual(values=c(17,19))+ # Manuelle Definition von Größe und Form der Symbole
scale_color_manual(name="Modell3",values=c("cyan4","grey","burlywood","brown","red","black"))+ # Manuelle Definition der Farbe der Symbole
geom_text(aes(label=Label_M3),hjust=-0.3, vjust=-0.3,size=2.75)+ # Manuelle Definition der Beschriftung der Symbole
xlab("CaO in %")+ylab("Fe2O3 in %")+ # 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
Modell3_HE_CaO_P2O5<-ggplot(data, aes(x=CaO,y=P2O5, color=Modell3, shape=Kultur))+
geom_point(aes(shape=Kultur),size=2)+scale_shape_manual(values=c(17,19))+
scale_color_manual(name="Modell3",values=c("cyan4","grey","burlywood","brown","red","black"))+
geom_text(aes(label=Label_M3),hjust=-0.3, vjust=-0.3,size=2.75)+
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"))
Modell3_HE_Al2O3_SiO2<-ggplot(data, aes(x=Al2O3,y=SiO2, color=Modell3, shape=Kultur))+
geom_point(aes(shape=Kultur),size=2)+scale_shape_manual(values=c(17,19))+
scale_color_manual(name="Modell3",values=c("cyan4","grey","burlywood","brown","red","black"))+
geom_text(aes(label=Label_M3),hjust=-0.3, vjust=-0.3,size=2.75)+
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"))
Modell3_HE_TiO2_K2O<-ggplot(data, aes(x=TiO2,y=K2O, color=Modell3, shape=Kultur))+
geom_point(aes(shape=Kultur),size=2)+scale_shape_manual(values=c(17,19))+
scale_color_manual(name="Modell3",values=c("cyan4","grey","burlywood","brown","red","black"))+
geom_text(aes(label=Label_M3),hjust=-0.3, vjust=-0.3,size=2.75)+
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"))
# Kombination der Diagramme
ggarrange(Modell3_HE_Al2O3_SiO2,Modell3_HE_CaO_P2O5,Modell3_HE_CaO_Fe2O3,Modell3_HE_TiO2_K2O,ncol=2,nrow=2,align = "hv",common.legend=TRUE)+theme(legend.position="bottom")
12 Abb. 6-45
Die Einteilung der Proben in die chemischen Rezepturen erfolgte in Excel. Die Datei TestRezepturen_Abstmaß wurde händisch um Modell 4 ergänzt
12.1 Histogramm
# Daten einlesen
data<-read.csv("../Daten//Kap_6//Kap_6.2//Grundlagen//Rezeptur//TestRezepturen_Abstmaß_bearb.csv")
# 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_NormHE_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
ylab("Häufigkeit")+ # Manuelle Achsenbeschriftung
theme_classic()+ # Klassisches Design
scale_x_continuous(breaks=seq(-1,16,1))+ # Manuelle Definition der Achsen
scale_y_continuous(breaks=seq(0,100,20))+
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(aes(xintercept=median(Normabst)),color="blue", linetype="dashed", linewidth=1)+theme(axis.title.x=element_blank())+ # Vertikale Markierung des Medians
geom_vline(data=Normabst0, aes(xintercept=lower), color="red", linetype="dotted", linewidth=1)+ # Vertikale Markierung des 25%-Quartils
geom_vline(data=Normabst0, aes(xintercept=upper), color="red", linetype="dotted", linewidth=1) # Vertikale Markierung des 75%-Quartils
# Berechnung der unteren (25%) und oberen (75%) Quartile für die Spalte "Normabst" nach Kultur
Normabst10 <- (data) %>%
group_by(Modell4) %>%
dplyr::summarise(lower = quantile(Normabst, probs = .25),
upper = quantile(Normabst, probs = .75))
# Diagramm erstellen
Hist_Modell4<-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 typisch bandkeramischen Rezeptur von Friedberg-Bruchenbrücken")+ylab("Häufigkeit")+ # Manuelle Achsenbeschriftung
theme_classic()+ # Klassisches Design
scale_x_continuous(breaks=seq(-1,16,1))+ # Manuelle Definition der Achsen
scale_y_continuous(breaks=seq(0,100,20))+
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(Modell4~.)+theme(strip.text.y = element_text(angle = 0),strip.background = element_rect(colour="white", fill="white"))+ # Facettierung nach Kategorien
geom_vline(data=ddply(data,"Modell4", dplyr::summarise, grp.median=median(Normabst)), aes(xintercept=grp.median),color="blue", linetype="dashed", linewidth=1)+ # Vertikale Markierung des Medians nach Kategorie
geom_vline(data=Normabst10, aes(xintercept=lower), color="red", linetype="dotted", linewidth=1)+ # Vertikale Markierung des 25%-Quartils nach Kategorien
geom_vline(data=Normabst10, aes(xintercept=upper), color="red", linetype="dotted", linewidth=1) # Vertikale Markierung des 75%-Quartils nach Kategorien
# Kombination der Diagramme
plot_grid(Hist_NormHE_Keramik_LBKI,Hist_Modell4,ncol=1,nrow=2,align = "v",axis = "lr",rel_heights=c(1,4))
# Export des kombinierten Diagramms
ggsave("Abb.6-45.eps",path=("../Daten//Kap_6//Kap_6.2//Abbildungen//Rezeptur//"),plot=last_plot(),device="eps",height=17,width=15.3,unit=c("cm"),dpi=1200)12.2 Kennwerte
# Berechnen von Mittelwert und Standardabweichung für den gesamten Datensatz
data %>% dplyr::summarise(m = mean(Normabst),sd=sd(Normabst)) m sd
1 2.467804 2.043407# Berechnen von Mittelwert und Standardabweichung nach Kategorien
group_by(data, Modell4) %>% dplyr::summarise(m = mean(Normabst),sd=sd(Normabst))# A tibble: 6 × 3
Modell4 m sd
<chr> <dbl> <dbl>
1 Rezeptur 1 1.72 0.668
2 Rezeptur 2a 5.48 0.997
3 Rezeptur 2b 6.66 1.37
4 Rezeptur 3a 9.45 NA
5 Rezeptur 3b 10.0 NA
6 Rezeptur 4 15.8 NA # Anzahl der Gesamtbeobachtungen
data %>% dplyr::summarise(count=n()) count
1 283# Anzahl der Beobachtungen pro Kategorie
data %>% group_by(Modell4) %>% dplyr::summarise(count=n())# A tibble: 6 × 2
Modell4 count
<chr> <int>
1 Rezeptur 1 240
2 Rezeptur 2a 13
3 Rezeptur 2b 27
4 Rezeptur 3a 1
5 Rezeptur 3b 1
6 Rezeptur 4 113 Abb. 6-46
TestRezepturen_Abstmaß_bearb wurde händisch um eine Spalte zur Beschriftung der im Hinblick auf den Normabstand auffälligen Funde ergänzt
# Daten einlesen
data<-read.csv("../Daten//Kap_6//Kap_6.2//Grundlagen//Rezeptur//TestRezepturen_Abstmaß_bearb.csv")
# Daten nach ausgewählter Spalte sortieren
data<-data[order(data$Modell4),]
# Diagramme erstellen
Modell4_HE_CaO_Fe2O3<-ggplot(data, aes(x=CaO,y=Fe2O3, color=Modell4, shape=Kultur))+
geom_point(aes(shape=Kultur),size=2)+scale_shape_manual(values=c(17,19))+ # Manuelle Definition von Größe und Form der Symbole
scale_color_manual(name="Modell4",values=c("cyan4","grey","burlywood","brown","red","black"))+ # Manuelle Definition der Farbe der Symbole
geom_text(aes(label=Label),hjust=-0.3, vjust=-0.3,size=2.75)+ # Manuelle Definition der Beschriftung der Symbole
xlab("CaO in %")+ylab("Fe2O3 in %")+ # 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
Modell4_HE_CaO_P2O5<-ggplot(data, aes(x=CaO,y=P2O5, color=Modell4, shape=Kultur))+
geom_point(aes(shape=Kultur),size=2)+scale_shape_manual(values=c(17,19))+
scale_color_manual(name="Modell4",values=c("cyan4","grey","burlywood","brown","red","black"))+
geom_text(aes(label=Label),hjust=-0.3, vjust=-0.3,size=2.75)+
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"))
Modell4_HE_Al2O3_SiO2<-ggplot(data, aes(x=Al2O3,y=SiO2, color=Modell4, shape=Kultur))+
geom_point(aes(shape=Kultur),size=2)+scale_shape_manual(values=c(17,19))+
scale_color_manual(name="Modell4",values=c("cyan4","grey","burlywood","brown","red","black"))+
geom_text(aes(label=Label),hjust=-0.3, vjust=-0.3,size=2.75)+
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"))
Modell4_HE_TiO2_K2O<-ggplot(data, aes(x=TiO2,y=K2O, color=Modell4, shape=Kultur))+
geom_point(aes(shape=Kultur),size=2)+scale_shape_manual(values=c(17,19))+
scale_color_manual(name="Modell4",values=c("cyan4","grey","burlywood","brown","red","black"))+
geom_text(aes(label=Label),hjust=-0.3, vjust=-0.3,size=2.75)+
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"))
# Kombination der Diagramme
ggarrange(Modell4_HE_Al2O3_SiO2,Modell4_HE_CaO_P2O5,Modell4_HE_CaO_Fe2O3,Modell4_HE_TiO2_K2O,ncol=2,nrow=2,align = "hv",common.legend=TRUE)+theme(legend.position="bottom")
# Export des kombinierten Diagramms
ggsave("Abb.6-46.eps",path=("../Daten//Kap_6//Kap_6.2//Abbildungen//Rezeptur//"),plot=last_plot(),device="eps",height=11,width=15.3,unit=c("cm"),dpi=1200)14 Abb. 6-47
# Daten einlesen
data<-read.csv("../Daten//Kap_6//Kap_6.2//Grundlagen//Rezeptur//TestRezepturen_Abstmaß_bearb.csv")
# Diagramm erstellen
ggplot(data)+
geom_bar(aes(x=Modell4),fill="lightgrey",color="black")+ # Manuelle Definition der Farbe der Balken
xlab("Chemische Rezepturen")+ylab("Probenanzahl")+ # Manuelle Achsenbeschriftung
theme_classic()+ # Klassisches Design
scale_y_continuous(breaks=seq(0,300,20),expand=c(0,0), limits=c(0,245))+ # Manuelle Definition der Achsen
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_text(aes(x=Modell4,label=after_stat(..count..)),stat='count',position=position_dodge(1),vjust=-0.3,size=2.75)+ # Manuelles Hinzufügen der Zahlenwerte als Text oberhalb der Balken
theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1)) # Axenbeschriftung vertikal
# Export des Diagramms
ggsave("Abb.6-47.eps",path=("../Daten//Kap_6//Kap_6.2//Abbildungen//Rezeptur//"),plot=last_plot(),device="eps",height=6,width=6,unit=c("cm"),dpi=1200)15 Dunns Test für Modell 4
# Daten einlesen und filtern
data1<-read.csv("../Daten//Kap_6//Kap_6.2//Grundlagen//Rezeptur//TestRezepturen_Abstmaß_bearb.csv")
data2<-data1[,c(13,37),]
# Berechnung der deskriptiven Statistik für Modell 4
data2 %>%
group_by(Modell4) %>%
get_summary_stats(Normabst, type = "common")# A tibble: 6 × 11
Modell4 variable n min max median iqr mean sd se ci
<chr> <fct> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 Rezeptur… Normabst 240 0.478 5.21 1.62 0.805 1.72 0.668 0.043 0.085
2 Rezeptur… Normabst 13 3.60 6.74 5.50 1.16 5.48 0.997 0.276 0.602
3 Rezeptur… Normabst 27 3.92 9.61 6.51 1.96 6.66 1.37 0.263 0.541
4 Rezeptur… Normabst 1 9.45 9.45 9.45 0 9.45 NA NA NaN
5 Rezeptur… Normabst 1 10.0 10.0 10.0 0 10.0 NA NA NaN
6 Rezeptur… Normabst 1 15.8 15.8 15.8 0 15.8 NA NA NaN # Durchführung des Kruskal-Wallis-Tests
res.kruskal<-data2%>%kruskal_test(Normabst~Modell4)
res.kruskal# A tibble: 1 × 6
.y. n statistic df p method
* <chr> <int> <dbl> <int> <dbl> <chr>
1 Normabst 283 109. 5 6.91e-22 Kruskal-Wallis# Berechnung der Effektgröße
data2%>%kruskal_effsize(Normabst~Modell4)# A tibble: 1 × 5
.y. n effsize method magnitude
* <chr> <int> <dbl> <chr> <ord>
1 Normabst 283 0.375 eta2[H] large # Durchführung des Dunn-Tests für paarweise Vergleiche mit Bonferroni-Korrektur
pwc<-data2%>%dunn_test(Normabst~Modell4,p.adjust.method="bonferroni")
pwc# A tibble: 15 × 9
.y. group1 group2 n1 n2 statistic p p.adj p.adj.signif
* <chr> <chr> <chr> <int> <int> <dbl> <dbl> <dbl> <chr>
1 Normabst Rezeptu… Rezep… 240 13 5.69 1.24e- 8 1.87e- 7 ****
2 Normabst Rezeptu… Rezep… 240 27 8.62 6.96e-18 1.04e-16 ****
3 Normabst Rezeptu… Rezep… 240 1 1.94 5.18e- 2 7.78e- 1 ns
4 Normabst Rezeptu… Rezep… 240 1 1.97 4.90e- 2 7.35e- 1 ns
5 Normabst Rezeptu… Rezep… 240 1 1.98 4.76e- 2 7.14e- 1 ns
6 Normabst Rezeptu… Rezep… 13 27 0.378 7.06e- 1 1 e+ 0 ns
7 Normabst Rezeptu… Rezep… 13 1 0.315 7.53e- 1 1 e+ 0 ns
8 Normabst Rezeptu… Rezep… 13 1 0.339 7.35e- 1 1 e+ 0 ns
9 Normabst Rezeptu… Rezep… 13 1 0.351 7.26e- 1 1 e+ 0 ns
10 Normabst Rezeptu… Rezep… 27 1 0.196 8.45e- 1 1 e+ 0 ns
11 Normabst Rezeptu… Rezep… 27 1 0.220 8.26e- 1 1 e+ 0 ns
12 Normabst Rezeptu… Rezep… 27 1 0.232 8.17e- 1 1 e+ 0 ns
13 Normabst Rezeptu… Rezep… 1 1 0.0173 9.86e- 1 1 e+ 0 ns
14 Normabst Rezeptu… Rezep… 1 1 0.0259 9.79e- 1 1 e+ 0 ns
15 Normabst Rezeptu… Rezep… 1 1 0.00864 9.93e- 1 1 e+ 0 ns # Speichern als CSV
write.csv(pwc,"../Daten//Kap_6//Kap_6.2//Grundlagen//Rezeptur//TestRezepturen_Dunn.csv",row.names=FALSE)16 Berechnen der MANOVA
16.1 Zusammenstellen der Daten
# Daten einlesen und filtern
data1<- read.csv("../Daten//Kap_6//Kap_6.2//Grundlagen//Datengrundlage//Daten_BB_vollständigMW_bearb.csv")
data2<-subset(data1, Messstelle %in% c("frischer Bruch"))
data3<-subset(data2, Kultur %in% c("LBK","La Hoguette"))
# Speichern als CSV
write.csv(data3,"../Daten//Kap_6//Kap_6.2//Grundlagen//Datengrundlage//Daten_BB_Ker_vollständigMW.csv",row.names=FALSE)Aus der Datei Daten_BB_Ker_vollständigMW wurden händig unnötige Spalten entfernt, die während der Bearbeitung aufgetretenen Uneinheitlichkeiten in der archäologischen Ansprache beseitigt.
# Daten einlesen und filtern
data1<-read.csv("../Daten//Kap_6//Kap_6.2//Grundlagen//Datengrundlage//Daten_BB_Ker_vollständigMW_bearb.csv")
data1<-data1[,c(1:76),]
# Daten einlesen und filtern
data2<-read.csv("../Daten//Kap_6//Kap_6.2//Grundlagen//Rezeptur//TestRezepturen_Abstmaß_bearb.csv")
data10<-data2[,c(1,37),]
# Kombinieren mehrerer Dataframes basierend auf der Probennummer
data<-merge(data1,data10, by="Probennummer", all=TRUE)
# Speichern als CSV
write.csv(data,"../Daten//Kap_6//Kap_6.2//Grundlagen//Datengrundlage//Daten_BB_Ker_vollständigMW_chemGruppen.csv",row.names=FALSE)16.2 Berechnen der log10-transformation aller Daten und Export
# Daten einlesen und filtern
data1<-read.csv("../Daten//Kap_6//Kap_6.2//Grundlagen//Datengrundlage//Daten_BB_vollständigMW_bearb.csv")
data2<-data1[,c(3:23),]
# Definieren relevanter Variablen
Probennummer<-data1$Probennummer
Messstelle<-data1$Messstelle
Kultur<-data1$Kultur
# Anwenden des log10
data3<-log10(data2)
# Spaltenweise Kombination von Dataframes
data4<- cbind(data3,Probennummer,Kultur,Messstelle)
# Speichern als CSV
write.csv(data4,"../Daten//Kap_6//Kap_6.2//Grundlagen//Datengrundlage//Daten_log10_MW.csv",row.names=TRUE)16.3 Zusammenstellen der log-Daten für die Rezepturen der Keramik
In der Datei Daten_BB_Ker_vollständigMW_chemGruppen wurden sämtliche Umlaute sowie ‘ß’ ersetzt.
# Daten einlesen und filtern
data1<-read.csv("../Daten//Kap_6//Kap_6.2//Grundlagen//Datengrundlage//Daten_BB_Ker_vollständigMW_chemGruppen_bearb.csv")
data7<-data1[,c(1,77),]
# Daten einlesen und filtern
data2<-read.csv("../Daten//Kap_6//Kap_6.2//Grundlagen//Datengrundlage//Daten_log10_MW.csv")
data3<-subset(data2, Messstelle %in% c("frischer Bruch"))
data4<-subset(data3, Kultur %in% c("LBK","La Hoguette"))
data4<-data4[,c(2:25),]
# Kombinieren mehrerer Dataframes basierend auf der Probennummer
data8<-merge(data4,data7, by="Probennummer", all=TRUE)
# Speichern als CSV
write.csv(data8,"../Daten//Kap_6//Kap_6.2//Grundlagen//Rezeptur//Daten_Rez_log10_MW.csv",row.names=FALSE)16.4 Durchführen der MANOVA
# Daten einlesen
data<-read.csv("../Daten//Kap_6//Kap_6.2//Grundlagen//Rezeptur//Daten_Rez_log10_MW.csv")
# Durchführen der MANOVA für ausgewählte Spalten im Hinblick auf Modell 4
manova<-manova(cbind(Al2O3,CaO,Fe2O3,K2O,MnO,P2O5,SiO2,TiO2) ~ Modell4, data)
# Zusammenfassung der MANOVA mit Intercept
summary(manova,intercept=TRUE) Df Pillai approx F num Df den Df Pr(>F)
(Intercept) 1 0.99998 2210887 8 270 < 2.2e-16 ***
Modell4 5 1.55477 15 40 1370 < 2.2e-16 ***
Residuals 277
---
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.000015 2210886 8 270.0 < 2.2e-16 ***
Modell4 5 0.062267 26 40 1179.7 < 2.2e-16 ***
Residuals 277
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 117 Hauptkomponentenanalyse
Achtung! Hauptkomponenten- und Clusteranalysen für die Rezepturen müssen in derselben Sitzung durchgeführt werden da nur so die in den folgenden Schritten berechneten Variablen konsistent genutzt werden können.
17.1 Durchführen der PCA
# Daten einlesen
data<-read.csv("../Daten//Kap_6//Kap_6.2//Grundlagen//Rezeptur//Daten_Rez_log10_MW.csv")
# Durchführen der PCA für ausgewählte Spalten
myPr <- prcomp(~ SiO2+TiO2+Al2O3+Fe2O3+MnO+CaO+K2O+P2O5,data=data,scale = TRUE)
myPrStandard deviations (1, .., p=8):
[1] 1.7504371 1.3872756 1.0596967 0.9053550 0.6681681 0.5724140 0.4817409
[8] 0.2502618
Rotation (n x k) = (8 x 8):
PC1 PC2 PC3 PC4 PC5 PC6
SiO2 0.5036911 0.2777036 0.019020693 0.16096273 0.10342394 0.15767156
TiO2 -0.3324797 0.3861989 -0.319437029 0.08096284 -0.64794842 0.43502310
Al2O3 -0.3601162 0.1988850 0.063759088 -0.76124169 0.08579056 -0.25654517
Fe2O3 -0.4287449 0.3133902 0.278221619 0.14404985 0.16826034 0.04370177
MnO -0.3522240 0.1147524 0.548804845 0.45366979 0.15350531 -0.01110238
CaO -0.2327239 -0.5791572 -0.005502967 0.21511862 -0.43914189 -0.38997042
K2O 0.2377649 -0.1983589 0.694538899 -0.33112656 -0.39713773 0.37659668
P2O5 -0.2957911 -0.4980211 -0.180345184 -0.07456306 0.39958342 0.65126344
PC7 PC8
SiO2 0.09776417 0.77316916
TiO2 0.14227925 0.04885730
Al2O3 0.25727986 0.32838783
Fe2O3 -0.74332651 0.19248669
MnO 0.57616206 -0.01082717
CaO -0.07288888 0.46246611
K2O -0.10370402 -0.04236216
P2O5 0.05866451 0.19785359# Eigenwerte der Hauptkomponenten
summary(myPr)Importance of components:
PC1 PC2 PC3 PC4 PC5 PC6 PC7
Standard deviation 1.750 1.3873 1.0597 0.9054 0.66817 0.57241 0.48174
Proportion of Variance 0.383 0.2406 0.1404 0.1025 0.05581 0.04096 0.02901
Cumulative Proportion 0.383 0.6236 0.7639 0.8664 0.92220 0.96316 0.99217
PC8
Standard deviation 0.25026
Proportion of Variance 0.00783
Cumulative Proportion 1.00000# Screeplot der Eigenwerte
plot(myPr, type="l")
# Kombinieren der ursprünglichen Daten mit den ersten beiden Hauptkomponenten
PCdata1 <- cbind(data,myPr$x[,1:2])
# Speichern als CSV
write.csv(PCdata1,"../Daten//Kap_6//Kap_6.2//Grundlagen//Rezeptur//PCA_HE.csv",row.names=FALSE)17.2 Berechnen der Camargo-Teststatistik
# Daten einlesen und filtern
data<-read.csv("../Daten//Kap_6//Kap_6.2//Grundlagen//Rezeptur//Daten_Rez_log10_MW.csv")
data10<-data[,c(2:6,8:10),]
# Berechnung der Varianz für alle numerischen Spalten
data10 %>% dplyr::summarise_if(is.numeric, var) SiO2 TiO2 Al2O3 Fe2O3 MnO CaO
1 0.001725977 0.01355061 0.002277563 0.01321703 0.07837116 0.07532948
K2O P2O5
1 0.008879045 0.06195557# 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: 8 variables, 283 observations
1000 bootstrap replicates, 1000 random permutations
========================================================
Empirical Psi = 7.3895, Max null Psi = 0.3970, Min null Psi = 0.0913, p-value = 0
Empirical Phi = 0.3633, Max null Phi = 0.0842, Min null Phi = 0.0404, p-value = 0
Empirical eigenvalue #1 = 3.06403, Max null eigenvalue = 1.4384, p-value = 0
Empirical eigenvalue #2 = 1.92453, Max null eigenvalue = 1.26582, p-value = 0
Empirical eigenvalue #3 = 1.12296, Max null eigenvalue = 1.17369, p-value = 0.087
Empirical eigenvalue #4 = 0.81967, Max null eigenvalue = 1.104, p-value = 1
Empirical eigenvalue #5 = 0.44645, Max null eigenvalue = 1.04047, p-value = 1
Empirical eigenvalue #6 = 0.32766, Max null eigenvalue = 0.97224, p-value = 1
Empirical eigenvalue #7 = 0.23207, Max null eigenvalue = 0.93138, p-value = 1
Empirical eigenvalue #8 = 0.06263, Max null eigenvalue = 0.86347, p-value = 1
PC 1 is significant and accounts for 38.3% (95%-CI:33.5-43.1) of the total variation
PC 2 is significant and accounts for 24.1% (95%-CI:21-27.3) of the total variation
The first 2 PC axes are significant and account for 62.4% of the total variation
Variables 1, 2, 3, 4, 5, 7, and 8 have significant loadings on PC 1
Variables 2, 6, and 8 have significant loadings on PC 218 Abb. 6-48
# Erstellung einer EPS-Datei
setEPS()
postscript("../Daten//Kap_6//Kap_6.2///Abbildungen//Rezeptur//Abb.6-48.eps", width = 2.9527952, height = 6.50)
# Erstellen eines 2x1 Plots
par(mfrow = c(2, 1))
# 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)
# Schließen der EPS-Datei
dev.off()png
2 
19 Abb. 6-49
# Daten einlesen
data1<-read.csv("../Daten//Kap_6//Kap_6.2//Grundlagen//Rezeptur//PCA_HE.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=Modell4, shape=Kultur))+
geom_point(aes(shape=Kultur),size=2)+scale_shape_manual(values=c(17,19))+ # Manuelle Definition von Größe und Form der Symbole
scale_color_manual(name="Modell4",values=c("cyan4","grey","burlywood","brown","red","black"))+ # Manuelle Definition der Farbe der Symbole
xlab("Zeilennummer")+ylab("Scorewert 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=Modell4, shape=Kultur))+
geom_point(aes(shape=Kultur),size=2)+scale_shape_manual(values=c(17,19))+
scale_color_manual(name="Modell4",values=c("cyan4","grey","burlywood","brown","red","black"))+
xlab("Zeilennummer")+ylab("Scorewert 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)
# Kombination der Diagramme
ggarrange(Score_PC1,Score_PC2,ncol=2,nrow=1,common.legend = TRUE)+theme(legend.position="bottom")
# Export des kombinierten Diagramms
ggsave("Abb.6-49.eps",path=("../Daten//Kap_6//Kap_6.2//Abbildungen//Rezeptur//"),plot=last_plot(),device="eps",height=8,width=15.3,unit=c("cm"),dpi=1200)20 Abb. 6-50
In der Datei Daten_Rez_log10_MW wurde händisch eine Spalte für die Kodierung der in der PCA auffälligen Proben ergänzt.
# Daten einlesen
data<-read.csv("../Daten//Kap_6//Kap_6.2//Grundlagen//Rezeptur//Daten_Rez_log10_MW_bearb.csv")
# Diagramm erstellen
autoplot(myPr, data = data, colour = 'Modell4',loadings.colour = 'black', loadings.label = TRUE, loadings.label.size = 3,loadings = TRUE)+
geom_point(aes(shape=Kultur),size=2)+scale_shape_manual(values=c(2,1))+ # Manuelle Definition von Größe und Form der Symbole
scale_color_manual(name="Modell4",values=c("cyan4","grey","burlywood","brown","red","black"))+ # Manuelle Definition der Farbe der Symbole
geom_text(aes(label=Label),hjust=-0.3, vjust=-0.3,size=2.75)+ # Manuelle Definition der Beschriftung 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_hline(yintercept=0, color="black", size=0.25)+geom_vline(xintercept=0, color="black", size=0.25) # Horizontale und vertikale 0-Linie einfügen
# Export des Diagramms
ggsave("Abb.6-50.eps",path=("../Daten//Kap_6//Kap_6.2//Abbildungen//Rezeptur//"),plot=last_plot(),device="eps",height=11,width=15.3,unit=c("cm"),dpi=1200)21 Diskriminanzanalyse
21.1 Berechnen und Zusammenstellen der DA-DAten
# Daten einlesen
data<-read.csv("../Daten//Kap_6//Kap_6.2//Grundlagen//Rezeptur//Daten_Rez_log10_MW.csv")
# Durchführen der Diskriminanzanalyse für ausgewählte Spalten
DAModel.1 <- lda(Modell4~SiO2+TiO2+Al2O3+Fe2O3+MnO+CaO+K2O+P2O5, data=data)
# Visualisierung der LDA-Ergebnisse
DAModel.1Call:
lda(Modell4 ~ SiO2 + TiO2 + Al2O3 + Fe2O3 + MnO + CaO + K2O +
P2O5, data = data)
Prior probabilities of groups:
Rezeptur 1 Rezeptur 2a Rezeptur 2b Rezeptur 3a Rezeptur 3b Rezeptur 4
0.848056537 0.045936396 0.095406360 0.003533569 0.003533569 0.003533569
Group means:
SiO2 TiO2 Al2O3 Fe2O3 MnO CaO
Rezeptur 1 1.805368 0.05863107 1.274523 0.7857134 -1.26978109 0.2389245
Rezeptur 2a 1.718362 0.38051221 1.343138 1.0457163 -0.79544263 0.4341261
Rezeptur 2b 1.728109 -0.03002381 1.253531 0.7166540 -1.32848698 0.9609128
Rezeptur 3a 1.653757 0.49890629 1.365509 1.0705920 -0.58191552 0.6317174
Rezeptur 3b 1.659330 0.41256116 1.261479 0.9369375 -0.74807860 0.9454604
Rezeptur 4 1.765645 0.05148968 1.231930 1.1614463 -0.06447258 0.2994912
K2O P2O5
Rezeptur 1 0.248048629 0.6011931
Rezeptur 2a 0.056373380 0.7528021
Rezeptur 2b 0.244652951 0.9600358
Rezeptur 3a -0.003765657 0.9892054
Rezeptur 3b 0.107137669 1.1161207
Rezeptur 4 0.305972781 0.2971225
Coefficients of linear discriminants:
LD1 LD2 LD3 LD4 LD5
SiO2 84.116310 -10.6271080 29.595348 -32.1293957 -28.946539
TiO2 3.089687 8.2878560 4.299947 6.4557765 -4.731011
Al2O3 28.211190 -3.4153496 20.650387 -20.6744082 8.307523
Fe2O3 6.045921 0.8282884 -2.022168 -8.7447854 -9.740095
MnO 1.186148 1.7110506 -1.811270 0.7345936 2.457974
CaO -1.256319 -1.0980056 2.806371 -4.6968990 -3.669921
K2O 2.173762 -2.9182325 -2.905632 5.9286304 -3.161327
P2O5 4.644391 -0.4140624 2.397403 1.0990248 -1.030754
Proportion of trace:
LD1 LD2 LD3 LD4 LD5
0.7617 0.2118 0.0199 0.0060 0.0006 plot(DAModel.1)
# Erstellen einer Konfusionsmatrix zur Bewertung der Klassifikationsgüte
confusion(data$Modell4[], predict(DAModel.1)$class) True
Predicted Rezeptur 1 Rezeptur 2a Rezeptur 2b Rezeptur 3a Rezeptur 3b
Rezeptur 1 238 2 1 0 0
Rezeptur 2a 2 11 0 0 0
Rezeptur 2b 0 0 26 0 0
Rezeptur 3a 0 0 0 1 0
Rezeptur 3b 0 0 0 0 1
Rezeptur 4 0 0 0 0 0
Total 240 13 27 1 1
Correct 238 11 26 1 1
True
Predicted Rezeptur 4
Rezeptur 1 0
Rezeptur 2a 0
Rezeptur 2b 0
Rezeptur 3a 0
Rezeptur 3b 0
Rezeptur 4 1
Total 1
Correct 1
Proportions correct
Rezeptur 1 Rezeptur 2a Rezeptur 2b Rezeptur 3a Rezeptur 3b Rezeptur 4
0.9916667 0.8461538 0.9629630 1.0000000 1.0000000 1.0000000
N correct/N total = 278/283 = 0.9823322# 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.2//Grundlagen//Rezeptur//DA_HE.csv",row.names=FALSE)21.2 Jackknifing
# Vergleich der vorhergesagten Zuordnung mit der tatsächlichen Zuordnung nach Modell4
confusion(data$Modell4, lda(Modell4~Al2O3+CaO+Fe2O3+K2O+MnO+P2O5+SiO2+TiO2, data=data,CV=TRUE)$class) True
Predicted Rezeptur 1 Rezeptur 2a Rezeptur 2b Rezeptur 3a Rezeptur 3b
Rezeptur 1 238 2 1 0 0
Rezeptur 2a 2 11 0 0 0
Rezeptur 2b 0 0 26 0 0
Rezeptur 3a 0 0 0 0 0
Rezeptur 3b 0 0 0 0 0
Rezeptur 4 0 0 0 0 0
Total 240 13 27 0 0
Correct 238 11 26 0 0
True
Predicted Rezeptur 4
Rezeptur 1 0
Rezeptur 2a 0
Rezeptur 2b 0
Rezeptur 3a 0
Rezeptur 3b 0
Rezeptur 4 0
Total 0
Correct 0
Proportions correct
Rezeptur 1 Rezeptur 2a Rezeptur 2b Rezeptur 3a Rezeptur 3b Rezeptur 4
0.9916667 0.8461538 0.9629630 NaN NaN NaN
N correct/N total = 275/280 = 0.982142921.3 PressQ-Statistik
# Berechnen der PressQ-Statistisk
# 283: Gesamtanzahl der Beobachtungen oder ein Gesamtwert
# 278: Durch Diskriminanzanalyse korrekt zugewiesene Objekte
# 6: Anzahl der Gruppen in der Analyse
PressQ<-((283-(278*6))^2)/(283*(6-1))
PressQ[1] 1355.63622 Abb. 6-51
# Erstellung einer EPS-Datei
setEPS()
postscript("../Daten//Kap_6//Kap_6.2///Abbildungen//Rezeptur//Abb.6-51.eps", width = 2.9527952, height = 6.50)
# Erstellen eines 2x1 Plots
par(mfrow = c(2, 1))
# 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)
# Schließen der EPS-Datei
dev.off()png
2 
23 Abb. 6-52
# Daten einlesen
data1<-read.csv("../Daten//Kap_6//Kap_6.2//Grundlagen//Rezeptur//DA_HE.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_DA1<-ggplot(data3, aes(x=ID_LD1,y=LD1, color=Modell4, shape=Kultur))+
geom_point(aes(shape=Kultur),size=2)+scale_shape_manual(values=c(17,19))+ # Manuelle Definition von Größe und Form der Symbole
scale_color_manual(name="Modell4",values=c("cyan4","grey","burlywood","brown","red","black"))+ # 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_DA2<-ggplot(data3, aes(x=ID_LD2,y=LD2, color=Modell4, shape=Kultur))+
geom_point(aes(shape=Kultur),size=2)+scale_shape_manual(values=c(17,19))+
scale_color_manual(name="Modell4",values=c("cyan4","grey","burlywood","brown","red","black"))+
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_DA1,Score_DA2,ncol=2,nrow=1,common.legend = TRUE)+theme(legend.position="bottom")
# Export des kombinierten Diagramms
ggsave("Abb.6-52.eps",path=("../Daten//Kap_6//Kap_6.2//Abbildungen//Rezeptur//"),plot=last_plot(),device="eps",height=8,width=15.3,unit=c("cm"),dpi=1200)24 Abb. 6-53
In der Datei Daten_Rez_log10_MW_bearb wurde händisch eine Spalte für die Kodierung der in der Diskriminanzanalyse auffälligen Proben ergänzt.
# Daten einlesen
data <- read.csv("../Daten//Kap_6//Kap_6.2//Grundlagen//Rezeptur//Daten_Rez_log10_MW_bearb.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.53<-ggplot(cbind(data, da_prediction$x), aes(y = LD2, x = LD1, colour = Modell4))+
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(17,19))+ # Manuelle Definition von Größe und Form der Symbole
scale_color_manual(name="Modell4",values=c("cyan4", "grey", "burlywood", "brown", "red", "black"))+ # Manuelle Definition der Farbe der Symbole
geom_text(aes(label = LabelDA), hjust = -0.3, vjust = -0.3, size = 2.75)+ # Objektlabel anzeigen
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=0.25)+geom_hline(yintercept = 0, size = .2)+ geom_vline(xintercept = 0, size = .2) # Horizontale und vertikale 0-Linie einfügen
# Diagramm darstellen
Abb.6.53
# Export des Diagramms
ggsave("Abb.6-53.eps",path=("../Daten//Kap_6//Kap_6.2//Abbildungen//Rezeptur//"),plot=last_plot(),device="eps",height=11,width=17.5,unit=c("cm"),dpi=1200)25 Diskriminanzanalyse ohne Rezepturen 3a, 3b und 4
25.1 Berechnen und Zusammenstellen der DA-DAten ohne Rezepturen 3a, 3b und 4
# Daten einlesen und filtern
data<-read.csv("../Daten//Kap_6//Kap_6.2//Grundlagen//Rezeptur//Daten_Rez_log10_MW.csv")
data<-subset(data, Modell4 %in% c("Rezeptur 1","Rezeptur 2a","Rezeptur 2b"))
# Durchführen der Diskriminanzanalyse für ausgewählte Spalten
DAModel.1 <- lda(Modell4~SiO2+TiO2+Al2O3+Fe2O3+MnO+CaO+K2O+P2O5, data=data)
# Visualisierung der LDA-Ergebnisse
DAModel.1Call:
lda(Modell4 ~ SiO2 + TiO2 + Al2O3 + Fe2O3 + MnO + CaO + K2O +
P2O5, data = data)
Prior probabilities of groups:
Rezeptur 1 Rezeptur 2a Rezeptur 2b
0.85714286 0.04642857 0.09642857
Group means:
SiO2 TiO2 Al2O3 Fe2O3 MnO CaO
Rezeptur 1 1.805368 0.05863107 1.274523 0.7857134 -1.2697811 0.2389245
Rezeptur 2a 1.718362 0.38051221 1.343138 1.0457163 -0.7954426 0.4341261
Rezeptur 2b 1.728109 -0.03002381 1.253531 0.7166540 -1.3284870 0.9609128
K2O P2O5
Rezeptur 1 0.24804863 0.6011931
Rezeptur 2a 0.05637338 0.7528021
Rezeptur 2b 0.24465295 0.9600358
Coefficients of linear discriminants:
LD1 LD2
SiO2 -82.154555 12.3639593
TiO2 -3.784175 -7.9033251
Al2O3 -27.286260 2.9419035
Fe2O3 -5.932578 -0.9736146
MnO -1.342990 -1.4213023
CaO 1.453571 0.4679402
K2O -2.087817 3.5818201
P2O5 -4.598059 0.6632528
Proportion of trace:
LD1 LD2
0.8078 0.1922 plot(DAModel.1)
# Erstellen einer Konfusionsmatrix zur Bewertung der Klassifikationsgüte
confusion(data$Modell4[], predict(DAModel.1)$class) True
Predicted Rezeptur 1 Rezeptur 2a Rezeptur 2b
Rezeptur 1 238 2 1
Rezeptur 2a 2 11 0
Rezeptur 2b 0 0 26
Total 240 13 27
Correct 238 11 26
Proportions correct
Rezeptur 1 Rezeptur 2a Rezeptur 2b
0.9916667 0.8461538 0.9629630
N correct/N total = 275/280 = 0.9821429# 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.2//Grundlagen//Rezeptur//DA_HE_o3a3b4.csv",row.names=FALSE)25.2 Jackknifing
# Vergleich der vorhergesagten Zuordnung mit der tatsächlichen Zuordnung nach Modell4
confusion(data$Modell4, lda(Modell4~Al2O3+CaO+Fe2O3+K2O+MnO+P2O5+SiO2+TiO2, data=data,CV=TRUE)$class) True
Predicted Rezeptur 1 Rezeptur 2a Rezeptur 2b
Rezeptur 1 238 2 1
Rezeptur 2a 2 11 0
Rezeptur 2b 0 0 26
Total 240 13 27
Correct 238 11 26
Proportions correct
Rezeptur 1 Rezeptur 2a Rezeptur 2b
0.9916667 0.8461538 0.9629630
N correct/N total = 275/280 = 0.982142925.3 PressQ-Statistik
# Berechnen der PressQ-Statistisk
# 283: Gesamtanzahl der Beobachtungen oder ein Gesamtwert
# 275: Durch Diskriminanzanalyse korrekt zugewiesene Objekte
# 3: Anzahl der Gruppen in der Analyse
PressQ<-((280-(275*3))^2)/(280*(3-1))
PressQ[1] 530.401825.4 Ladungen ohne Rezepturen 3a, 3b und 4
# 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)
25.5 Scorewerte ohne Rezepturen 3a, 3b und 4
# Daten einlesen
data1<-read.csv("../Daten//Kap_6//Kap_6.2//Grundlagen//Rezeptur//DA_HE_o3a3b4.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_DA1<-ggplot(data3, aes(x=ID_LD1,y=LD1, color=Modell4, shape=Kultur))+
geom_point(aes(shape=Kultur),size=2)+scale_shape_manual(values=c(17,19))+ # Manuelle Definition von Größe und Form der Symbole
scale_color_manual(name="Modell4",values=c("cyan4","grey","burlywood"))+ # 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_DA2<-ggplot(data3, aes(x=ID_LD2,y=LD2, color=Modell4, shape=Kultur))+
geom_point(aes(shape=Kultur),size=2)+scale_shape_manual(values=c(17,19))+
scale_color_manual(name="Modell4",values=c("cyan4","grey","burlywood"))+
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_DA1,Score_DA2,ncol=2,nrow=1,common.legend = TRUE)+theme(legend.position="bottom")
25.6 Abbildung ohne Rezepturen 3a, 3b und 4
# Daten einlesen und filtern
data<-read.csv("../Daten//Kap_6//Kap_6.2//Grundlagen//Rezeptur//Daten_Rez_log10_MW_bearb.csv")
data<-subset(data, Modell4 %in% c("Rezeptur 1","Rezeptur 2a","Rezeptur 2b"))
# 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 <-ggplot(cbind(data, da_prediction$x), aes(y = LD2, x = LD1, colour = Modell4))+
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(17,19))+ # Manuelle Definition von Größe und Form der Symbole
scale_color_manual(name="Modell4",values=c("cyan4", "grey", "burlywood", "brown", "red", "black"))+ # 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=0.25)+geom_hline(yintercept = 0, size = .2)+ geom_vline(xintercept = 0, size = .2) # Horizontale und vertikale 0-Linie einfügen
# Diagramm darstellen
Abb
26 Abb. 6-54
# Daten einlesen
data<-read.csv("../Daten//Kap_6//Kap_6.2//Grundlagen//Rezeptur//TestRezepturen_Abstmaß_bearb.csv")
# Daten nach ausgewählter Spalte sortieren
data<-data[order(data$Modell4),]
# Diagramme erstellen
Modell4_HE_CaO_Fe2O3<-ggplot(data, aes(x=CaO,y=Fe2O3, color=Modell4, shape=Kultur))+
geom_point(aes(shape=Kultur),size=2)+scale_shape_manual(values=c(17,19))+ # Manuelle Definition von Größe und Form der Symbole
scale_color_manual(name="Modell4",values=c("cyan4","grey","burlywood","brown","red","black"))+ # Manuelle Definition der Farbe der Symbole
geom_text(aes(label=Label),hjust=-0.3, vjust=-0.3,size=2.75)+ # Manuelle Definition der Beschriftung der Symbole
xlab("CaO in %")+ylab("Fe2O3 in %")+ # 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
Modell4_HE_CaO_P2O5<-ggplot(data, aes(x=CaO,y=P2O5, color=Modell4, shape=Kultur))+
geom_point(aes(shape=Kultur),size=2)+scale_shape_manual(values=c(17,19))+
scale_color_manual(name="Modell4",values=c("cyan4","grey","burlywood","brown","red","black"))+
geom_text(aes(label=LabelDA),hjust=-0.3, vjust=-0.3,size=2.75)+
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"))
Modell4_HE_Al2O3_SiO2<-ggplot(data, aes(x=Al2O3,y=SiO2, color=Modell4, shape=Kultur))+
geom_point(aes(shape=Kultur),size=2)+scale_shape_manual(values=c(17,19))+
scale_color_manual(name="Modell4",values=c("cyan4","grey","burlywood","brown","red","black"))+
geom_text(aes(label=LabelDA),hjust=-0.3, vjust=-0.3,size=2.75)+
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"))
Modell4_HE_TiO2_K2O<-ggplot(data, aes(x=TiO2,y=K2O, color=Modell4, shape=Kultur))+
geom_point(aes(shape=Kultur),size=2)+scale_shape_manual(values=c(17,19))+
scale_color_manual(name="Modell4",values=c("cyan4","grey","burlywood","brown","red","black"))+
geom_text(aes(label=LabelDA),hjust=-0.3, vjust=-0.3,size=2.75)+
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"))
# Kombination der Diagramme
ggarrange(Modell4_HE_Al2O3_SiO2,Modell4_HE_CaO_P2O5,Modell4_HE_CaO_Fe2O3,Modell4_HE_TiO2_K2O,ncol=2,nrow=2,align = "hv",common.legend=TRUE)+theme(legend.position="bottom")
# Export des kombinierten Diagramms
ggsave("Abb.6-54.eps",path=("../Daten//Kap_6//Kap_6.2//Abbildungen//Rezeptur//"),plot=last_plot(),device="eps",height=11,width=15.3,unit=c("cm"),dpi=1200)27 Clusteranalyse
27.1 Berechnung der Kmean-Clusteranalyse
# Daten einlesen und filtern
data1<-read.csv("../Daten//Kap_6//Kap_6.2//Grundlagen//Rezeptur//Daten_Rez_log10_MW.csv")
data2<-data1[,c(2:6,8:10),]
# 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")
27.2 Berechnung unter Vorgabe von 4 Clustern
# Zufallszahlengenerator initialisieren
set.seed(123)
# K-Means Clustering mit 4 Clustern und maximal 100 Iterationen
km.res4<-kmeans(data2,4,100)
# Clustering-Ergebnis in Scatterplot darstellen
fviz_cluster(km.res4, data = data2)
# Cluster-Labels zuweisen und Mittelwerte je Cluster berechnen
data2 %>%
mutate(Cluster = km.res4$cluster) %>% # Cluster-Labels hinzufügen
group_by(Cluster) %>% # Nach Cluster gruppieren
dplyr::summarise_all("mean") # Mittelwert berechnen# A tibble: 4 × 9
Cluster SiO2 TiO2 Al2O3 Fe2O3 MnO CaO K2O P2O5
<int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 1 1.77 0.107 1.29 0.884 -0.949 0.353 0.226 0.710
2 2 1.81 0.0510 1.27 0.745 -1.43 0.264 0.240 0.687
3 3 1.72 -0.00727 1.25 0.720 -1.35 0.962 0.232 0.999
4 4 1.83 0.0688 1.27 0.771 -1.35 0.0652 0.257 0.26628 Abb. 6-55
# Spalten zu data2 hinzufügen
data3 <- cbind(data2,
cluster = km.res4$cluster, # Cluster-Zuordnung aus der K-Means-Analyse
Kultur = data1$Kultur, # Kultur, Probennummer und Modell4 aus data1
Probennummer = data1$Probennummer,
Modell4 = data1$Modell4)
# Pivot-Tabelle erstellen: Anzahl der Beobachtungen pro Kombination von "Modell4" und "cluster"
Tab_objekt<-qhpvt(data=data3, "Modell4", "cluster", "n()")
# Tabelle exportieren
setwd("../Daten//Kap_6//Kap_6.2///Abbildungen//Rezeptur")
htmlwidgets::saveWidget(Tab_objekt, file = "Abb.6-55.html")29 Abb. 6-56
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(2,1))+ # Manuelle Definition von Größe und Form der Symbole
scale_color_manual(name="cluster",values=c("darkblue","turquoise1","orangered","magenta"))+ # 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
# Export des Diagramms
ggsave("Abb.6-56.eps",path=("../Daten//Kap_6//Kap_6.2//Abbildungen//Rezeptur//"),plot=last_plot(),device="eps",height=11,width=15.3,unit=c("cm"),dpi=1200)30 Abb. 6-57
30.1 Zusammenstellen der Daten
# Daten einlesen und filtern
data5<-read.csv("../Daten//Kap_6//Kap_6.2//Grundlagen//Datengrundlage//Daten_BB_Ker_vollständigMW_chemGruppen_bearb.csv")
data4<-data3[,c(9,11),]
# Kombinieren mehrerer Dataframes basierend auf der Probennummer
data6<-merge(data5,data4, by="Probennummer", all=TRUE)
# Umbenennen von cluster_HE zu cluster
data6<-data6 %>% dplyr::rename(cluster_HE=cluster)
# Speichern als CSV
write.csv(data6,"../Daten//Kap_6//Kap_6.2//Grundlagen//Datengrundlage//Daten_BB_Ker_vollständigMW_chemGruppen_HE_CL.csv",row.names=FALSE)30.2 Erstellen der Abb. 6-57
# Daten einlesen
data<-read.csv("../Daten//Kap_6//Kap_6.2//Grundlagen//Datengrundlage//Daten_BB_Ker_vollständigMW_chemGruppen_HE_CL_bearb.csv")
# Definieren von Spalte cluster_HE_split als Zeichenvektor
data$cluster_HE_split <- as.character(data$cluster_HE_split)
# Daten nach ausgewählter Spalte sortieren
data<-data[order(data$cluster_HE_split),]
# Diagramme erstellen
cluster_HE_split_CaO_Fe2O3<-ggplot(data, aes(x=CaO,y=Fe2O3, color=cluster_HE_split, shape=Kultur))+
geom_point(aes(shape=Kultur),size=2)+scale_shape_manual(values=c(17,19))+ # Manuelle Definition von Größe und Form der Symbole
scale_color_manual(name="cluster_HE_split",values=c("lightblue","darkblue","turquoise1","orangered","magenta"))+ # Manuelle Definition der Farbe der Symbole
xlab("CaO in %")+ylab("Fe2O3 in %")+ # 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
cluster_HE_split_CaO_P2O5<-ggplot(data, aes(x=CaO,y=P2O5, color=cluster_HE_split, shape=Kultur))+
geom_point(aes(shape=Kultur),size=2)+scale_shape_manual(values=c(17,19))+
scale_color_manual(name="cluster_HE_split",values=c("lightblue","darkblue","turquoise1","orangered","magenta"))+
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"))
cluster_HE_split_Al2O3_SiO2<-ggplot(data, aes(x=Al2O3,y=SiO2, color=cluster_HE_split, shape=Kultur))+
geom_point(aes(shape=Kultur),size=2)+scale_shape_manual(values=c(17,19))+
scale_color_manual(name="cluster_HE_split",values=c("lightblue","darkblue","turquoise1","orangered","magenta"))+
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"))
cluster_HE_split_TiO2_K2O<-ggplot(data, aes(x=TiO2,y=K2O, color=cluster_HE_split, shape=Kultur))+
geom_point(aes(shape=Kultur),size=2)+scale_shape_manual(values=c(17,19))+
scale_color_manual(name="cluster_HE_split",values=c("lightblue","darkblue","turquoise1","orangered","magenta"))+
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"))
# Kombination der Diagramme
ggarrange(cluster_HE_split_Al2O3_SiO2,cluster_HE_split_CaO_P2O5,cluster_HE_split_CaO_Fe2O3,cluster_HE_split_TiO2_K2O,ncol=2,nrow=2,align = "hv",common.legend=TRUE)+theme(legend.position="bottom")
# Export des kombinierten Diagramms
ggsave("Abb.6-57.eps",path=("../Daten//Kap_6//Kap_6.2//Abbildungen//Rezeptur//"),plot=last_plot(),device="eps",height=11,width=15.3,unit=c("cm"),dpi=1200)31 Abb. 6-58
31.1 Zusammenstellen der Daten
# Daten einlesen und filtern
data<-read.csv("../Daten//Kap_6//Kap_6.2//Grundlagen//Datengrundlage//Daten_BB_Ker_vollständigMW_chemGruppen_bearb.csv")
data2<-data[,c(2:6,8:10,77),]
# Variationskoeffizient-Funktion mit Fehlerbehandlung
Varkoef <- function(x) { (sd(x, na.rm = TRUE) / mean(x, na.rm = TRUE)) * 100 }
# Berechnung der Kennwerte
KennwerteRezeptur<-(data2) %>%
group_by(Modell4) %>%
dplyr::summarise(across(everything(),list(Varkoef=Varkoef,Mittelwert=mean,stabw=sd, Median=median)))
# Erste Zeilen der Tabelle anziegen
head(KennwerteRezeptur)# A tibble: 6 × 33
Modell4 SiO2_Varkoef SiO2_Mittelwert SiO2_stabw SiO2_Median TiO2_Varkoef
<chr> <dbl> <dbl> <dbl> <dbl> <dbl>
1 Rezeptur 1 6.43 64.0 4.12 63.8 18.9
2 Rezeptur 2a 7.07 52.4 3.71 51.5 31.6
3 Rezeptur 2b 7.01 53.6 3.76 53.2 19.8
4 Rezeptur 3a NA 45.1 NA 45.1 NA
5 Rezeptur 3b NA 45.6 NA 45.6 NA
6 Rezeptur 4 NA 58.3 NA 58.3 NA
# ℹ 27 more variables: TiO2_Mittelwert <dbl>, TiO2_stabw <dbl>,
# TiO2_Median <dbl>, Al2O3_Varkoef <dbl>, Al2O3_Mittelwert <dbl>,
# Al2O3_stabw <dbl>, Al2O3_Median <dbl>, Fe2O3_Varkoef <dbl>,
# Fe2O3_Mittelwert <dbl>, Fe2O3_stabw <dbl>, Fe2O3_Median <dbl>,
# MnO_Varkoef <dbl>, MnO_Mittelwert <dbl>, MnO_stabw <dbl>, MnO_Median <dbl>,
# CaO_Varkoef <dbl>, CaO_Mittelwert <dbl>, CaO_stabw <dbl>, CaO_Median <dbl>,
# K2O_Varkoef <dbl>, K2O_Mittelwert <dbl>, K2O_stabw <dbl>, …# Speichern als CSV
write.csv(KennwerteRezeptur,"../Daten//Kap_6//Kap_6.2//Grundlagen//Rezeptur//KennwerteRezeptur.csv",row.names=FALSE)31.2 Erstellen Abb. 6-58
# Daten einlesen
data<-read.csv("../Daten//Kap_6//Kap_6.2//Grundlagen//Rezeptur//KennwerteRezeptur.csv")
# Diagramme erstellen
Rezeptur_Errorplot_TiO2_K2O<-ggplot(data, aes(x=TiO2_Mittelwert,y=K2O_Mittelwert, color=Modell4,
xmin = TiO2_Mittelwert-TiO2_stabw, xmax = TiO2_Mittelwert+TiO2_stabw, # Fehlerbalken links und rechts
ymin=K2O_Mittelwert-K2O_stabw, ymax=K2O_Mittelwert+K2O_stabw))+ # Fehlerbalken unten und oben
geom_errorbar(width=.1)+geom_errorbarh(height=.1)+ # Länge der Fehlerbalken
scale_x_continuous(breaks=seq(1,3,1))+ # Manuelle Definition der Achsen
scale_y_continuous(breaks=seq(1,3,1))+
geom_point()+ # Hinzufügen der Symbole
scale_color_manual(name="Modell4",values=c("cyan4","grey","burlywood","brown","red","black"))+ # Manuelle Definition der Farbe der Symbole
geom_text(aes(label=Modell4),hjust=-0.1, vjust=-0.3,size=2.75)+ # Manuelle Beschriftung der Symbole
xlab("TiO2 in %")+ylab("K2O in %")+ # Manuelle Achsenbeschriftung
theme_classic()+ # Klassisches Design
theme(axis.line=element_line(colour="black",size=0.25))+theme(legend.position = "none")+theme(axis.ticks=element_line(size=0.25,colour="black")) # Manuelle Formatierung von Achsen- und Legendendarstellung
Rezeptur_Errorplot_Al2O3_SiO2<-ggplot(data, aes(x=Al2O3_Mittelwert,y=SiO2_Mittelwert, color=Modell4,
xmin = Al2O3_Mittelwert-Al2O3_stabw, xmax = Al2O3_Mittelwert+Al2O3_stabw,
ymin=SiO2_Mittelwert-SiO2_stabw,ymax=SiO2_Mittelwert+SiO2_stabw))+
geom_errorbar(width=.1)+geom_errorbarh(height=.9)+
scale_x_continuous(breaks=seq(15,27,3))+
scale_y_continuous(breaks=seq(45,75,5))+
geom_point()+
scale_color_manual(name="Modell4",values=c("cyan4","grey","burlywood","brown","red","black"))+
geom_text(aes(label=Modell4),hjust=-0.1, vjust=-0.3,size=2.75)+
xlab("Al2O3 in %")+ylab("SiO2 in %")+
theme_classic()+
theme(axis.line=element_line(colour="black",size=0.25))+theme(legend.position = "none")+theme(axis.ticks=element_line(size=0.25,colour="black"))
Rezeptur_Errorplot_CaO_Fe2O3<-ggplot(data, aes(x=CaO_Mittelwert,y=Fe2O3_Mittelwert, color=Modell4,
xmin = CaO_Mittelwert-CaO_stabw, xmax = CaO_Mittelwert+CaO_stabw,
ymin=Fe2O3_Mittelwert-Fe2O3_stabw,ymax=Fe2O3_Mittelwert+Fe2O3_stabw))+
geom_errorbar(width=.1)+geom_errorbarh(height=.3)+
scale_x_continuous(breaks=seq(0,10,5))+
scale_y_continuous(breaks=seq(2.5,12.5,2.5))+
geom_point()+
scale_color_manual(name="Modell4",values=c("cyan4","grey","burlywood","brown","red","black"))+
geom_text(aes(label=Modell4),hjust=-0.1, vjust=-0.3,size=2.75)+
xlab("CaO in %")+ylab("Fe2O3 in %")+
theme_classic()+
theme(axis.line=element_line(colour="black",size=0.25))+theme(legend.position = "none")+ theme(axis.ticks=element_line(size=0.25,colour="black"))
# Kombination der Diagramme
ggarrange(Rezeptur_Errorplot_Al2O3_SiO2,Rezeptur_Errorplot_CaO_Fe2O3,Rezeptur_Errorplot_TiO2_K2O,ncol=2,nrow=2,align = "hv",common.legend=TRUE)+theme(legend.position="bottom")
# Export des kombinierten Diagramms
ggsave("Abb.6-58.eps",path=("../Daten//Kap_6//Kap_6.2//Abbildungen//Rezeptur//"),plot=last_plot(),device="eps",height=11,width=15.3,unit=c("cm"),dpi=1200)32 Bodenproben und Keramik
###Zusammenstellen der Daten
# Daten einlesen und filtern
data1<-read.csv("../Daten//Kap_6//Kap_6.2//Grundlagen//Datengrundlage//Daten_BB_Ker_vollständigMW_chemGruppen_bearb.csv")
data7<-data1[,c(1,77),]
# Daten einlesen und filtern
data2<-read.csv("../Daten//Kap_6//Kap_6.2//Grundlagen//Datengrundlage//Daten_log10_MW.csv")
data3<-subset(data2, Messstelle %in% c("frischer Bruch"))
data4<-subset(data3, Kultur %in% c("LBK","La Hoguette","Bodenprobe"))
data5<-data4[,-c(1),]
# Kombinieren mehrerer Dataframes basierend auf der Probennummer
data8<-merge(data5,data7, by="Probennummer", all=TRUE)
# Speichern als CSV
write.csv(data8,"../Daten//Kap_6//Kap_6.2//Grundlagen//Rezeptur//Daten_Rez_BP_log10_MW.csv",row.names=FALSE)Die Datei Daten_Rez_BP_log10_MW wurde händisch um Informationen zur optischen Klassifizierung der Bodenproben ergänzt. Zudem wurden die Spalte Modell4 im Bereich der Bodenproben um ebendiese Information erweitert.
32.1 Berechnen der MANOVA
# Daten einlesen
data<-read.csv("../Daten//Kap_6//Kap_6.2//Grundlagen//Rezeptur//Daten_Rez_BP_log10_MW_bearb.csv")
# Durchführen der MANOVA für ausgewählte Spalten im Hinblick auf Modell 4
manova<-manova(cbind(SiO2,TiO2,Al2O3,Fe2O3,MnO,CaO,K2O,P2O5,Zn,Rb,Sr,Y,Zr) ~ Modell4, data)
# Zusammenfassung der MANOVA mit Intercept
summary(manova) Df Pillai approx F num Df den Df Pr(>F)
Modell4 6 2.4517 15.733 78 1776 < 2.2e-16 ***
Residuals 303
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# Anzeige der MANOVA-Ergebnisse mit Wilks-Lambda-Tests
summary(manova,test="Wilks") Df Wilks approx F num Df den Df Pr(>F)
Modell4 6 0.0086143 28.259 78 1610.6 < 2.2e-16 ***
Residuals 303
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 132.2 Hauptkomponentenanalyse
32.2.1 Berechnen und Zusammenstellen der PCA-DAten
# Daten einlesen
data<-read.csv("../Daten//Kap_6//Kap_6.2//Grundlagen//Rezeptur//Daten_Rez_BP_log10_MW.csv")
# Durchführen der PCA für ausgewählte Spalten
myPr <- prcomp(~ SiO2+TiO2+Al2O3+MnO+Fe2O3+CaO+K2O+P2O5+Zn+Rb+Sr+Y+Zr,data=data,scale = TRUE)
myPrStandard deviations (1, .., p=13):
[1] 1.9720113 1.5646578 1.3121779 1.1436084 1.1106765 0.8482720 0.6794422
[8] 0.6104015 0.5150305 0.4673225 0.4117278 0.3740261 0.2300110
Rotation (n x k) = (13 x 13):
PC1 PC2 PC3 PC4 PC5 PC6
SiO2 0.47865593 0.06715686 0.004419462 0.03089384 0.05626917 -0.05946449
TiO2 -0.19025254 0.39623897 -0.246194557 0.22075606 -0.08289629 -0.39581890
Al2O3 -0.36468105 0.04569477 0.026031748 0.32276860 -0.24356711 0.51740160
MnO -0.09568676 0.18710235 -0.374824866 -0.57077811 -0.28551143 -0.14907685
Fe2O3 -0.28272793 0.32488652 -0.337179345 -0.15580555 -0.18906922 0.30392604
CaO -0.34248288 -0.34790021 -0.005636247 -0.16705103 0.18885421 -0.28815511
K2O 0.26600239 -0.36429576 -0.149571746 -0.22272731 -0.36764411 0.13255604
P2O5 -0.32622364 -0.15878566 0.456113629 -0.13884448 -0.05749894 -0.01178562
Zn -0.11404104 -0.19678447 -0.207325986 0.55155304 -0.34176616 -0.44809966
Rb 0.17136821 -0.43766348 -0.180731071 0.04012909 -0.42080451 0.08130146
Sr -0.35176685 -0.18503185 0.227496916 -0.24914401 -0.17304931 -0.21183510
Y 0.06075240 0.23219782 0.456462755 0.08708990 -0.46933284 0.08128907
Zr 0.21984612 0.31377249 0.343952715 -0.15427240 -0.30844601 -0.31283124
PC7 PC8 PC9 PC10 PC11 PC12
SiO2 0.10370226 0.100625775 0.37176845 0.04880185 -0.068382916 -0.37434883
TiO2 0.36768309 0.473010899 -0.35417377 -0.06910491 0.161391547 -0.02651783
Al2O3 0.17114457 -0.129952881 0.17507336 0.17954630 0.397671585 0.21193134
MnO -0.26424664 -0.214601409 0.06718944 0.06781902 0.459146068 -0.21919330
Fe2O3 0.01511793 -0.048973822 0.04028031 -0.09028718 -0.722326488 -0.05488299
CaO -0.28653145 0.091885661 -0.18108762 0.35000262 -0.169889267 0.30053633
K2O 0.06362816 0.247099037 -0.08896013 -0.54482610 0.044234870 0.41113190
P2O5 0.17450896 -0.255285342 -0.33872148 -0.40220352 0.004059226 -0.46331559
Zn -0.24995733 -0.315361614 0.23132283 -0.23283019 -0.102902626 -0.05687827
Rb 0.28343571 0.009129584 -0.29916643 0.51615220 -0.116447713 -0.30487981
Sr 0.30309337 0.353431299 0.62318448 0.04947621 -0.057412032 -0.04129650
Y -0.55730116 0.395148812 -0.10471041 0.10769465 -0.045781530 -0.09032416
Zr 0.30470125 -0.430733228 -0.04229315 0.17911117 -0.134857385 0.42792928
PC13
SiO2 -0.672618673
TiO2 -0.134216695
Al2O3 -0.347720857
MnO -0.044272316
Fe2O3 -0.106118848
CaO -0.500011572
K2O -0.176002401
P2O5 -0.225390948
Zn 0.001556644
Rb 0.135198460
Sr 0.201960208
Y 0.005022323
Zr -0.067492703# Eigenwerte der Hauptkomponenten
summary(myPr)Importance of components:
PC1 PC2 PC3 PC4 PC5 PC6 PC7
Standard deviation 1.9720 1.5647 1.3122 1.1436 1.11068 0.84827 0.67944
Proportion of Variance 0.2991 0.1883 0.1325 0.1006 0.09489 0.05535 0.03551
Cumulative Proportion 0.2991 0.4875 0.6199 0.7205 0.81540 0.87075 0.90626
PC8 PC9 PC10 PC11 PC12 PC13
Standard deviation 0.61040 0.5150 0.4673 0.41173 0.37403 0.23001
Proportion of Variance 0.02866 0.0204 0.0168 0.01304 0.01076 0.00407
Cumulative Proportion 0.93493 0.9553 0.9721 0.98517 0.99593 1.00000# Screeplot der Eigenwerte
plot(myPr, type="l")
# Kombinieren der ursprünglichen Daten mit den ersten vier Hauptkomponenten
PCdata1 <- cbind(data,myPr$x[,1:4])
# Speichern als CSV
write.csv(PCdata1,"../Daten//Kap_6//Kap_6.2//Grundlagen//Rezeptur//PCA_Ker_BP_HE.csv",row.names=FALSE)32.2.2 Berechnen der Camargo-Teststatistik
# Daten einlesen und filtern
data<-read.csv("../Daten//Kap_6//Kap_6.2//Grundlagen//Rezeptur//Daten_Rez_BP_log10_MW.csv")
data10<-data[,c(2:6,8:10,15:19),]
# Berechnung der Varianz für alle numerischen Spalten
data10 %>% dplyr::summarise_if(is.numeric, var) SiO2 TiO2 Al2O3 Fe2O3 MnO CaO
1 0.002112078 0.01335836 0.005050631 0.01360683 0.07939414 0.07957009
K2O P2O5 Zn Rb Sr Y Zr
1 0.01083684 0.1313864 0.05172004 0.01446275 0.03131577 0.003731585 0.01048453# 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: 13 variables, 310 observations
1000 bootstrap replicates, 1000 random permutations
========================================================
Empirical Psi = 15.3522, Max null Psi = 0.8169, Min null Psi = 0.2827, p-value = 0
Empirical Phi = 0.3137, Max null Phi = 0.0724, Min null Phi = 0.0426, p-value = 0
Empirical eigenvalue #1 = 3.88883, Max null eigenvalue = 1.54153, p-value = 0
Empirical eigenvalue #2 = 2.44815, Max null eigenvalue = 1.39791, p-value = 0
Empirical eigenvalue #3 = 1.72181, Max null eigenvalue = 1.30338, p-value = 0
Empirical eigenvalue #4 = 1.30784, Max null eigenvalue = 1.22685, p-value = 0
Empirical eigenvalue #5 = 1.2336, Max null eigenvalue = 1.15688, p-value = 0
Empirical eigenvalue #6 = 0.71957, Max null eigenvalue = 1.10806, p-value = 1
Empirical eigenvalue #7 = 0.46164, Max null eigenvalue = 1.05398, p-value = 1
Empirical eigenvalue #8 = 0.37259, Max null eigenvalue = 1.01791, p-value = 1
Empirical eigenvalue #9 = 0.26526, Max null eigenvalue = 0.97177, p-value = 1
Empirical eigenvalue #10 = 0.21839, Max null eigenvalue = 0.92736, p-value = 1
Empirical eigenvalue #11 = 0.16952, Max null eigenvalue = 0.87168, p-value = 1
Empirical eigenvalue #12 = 0.1399, Max null eigenvalue = 0.83968, p-value = 1
Empirical eigenvalue #13 = 0.05291, Max null eigenvalue = 0.78064, p-value = 1
PC 1 is significant and accounts for 29.9% (95%-CI:27.1-33.4) of the total variation
PC 2 is significant and accounts for 18.8% (95%-CI:17-21.3) of the total variation
PC 3 is significant and accounts for 13.2% (95%-CI:11.8-15.2) of the total variation
PC 4 is significant and accounts for 10.1% (95%-CI:9.1-11.6) of the total variation
PC 5 is significant and accounts for 9.5% (95%-CI:7.6-10.2) of the total variation
The first 5 PC axes are significant and account for 81.5% of the total variation
Variables 1, 2, 3, 4, 6, 7, 8, 10, 11, and 13 have significant loadings on PC 1
Variables 2, 4, 6, 7, 10, and 13 have significant loadings on PC 2
Variables 5, 8, and 12 have significant loadings on PC 3
Variables 5, and 9 have significant loadings on PC 4
Variables , and 12 have significant loadings on PC 532.3 Abb. 6-59
# Erstellung einer EPS-Datei
setEPS()
postscript("../Daten//Kap_6//Kap_6.2///Abbildungen//Rezeptur//Abb.6-59.eps", width = 6.5, height = 6.5)
# Erstellen eines 2x2 Plots
par(mfrow = c(2, 2))
# 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)
# Schließen der EPS-Datei
dev.off()png
2 
32.4 Abb. 6-60
Die Datei PCA_Ker_BP_HE wurde händisch um Informationen zur optischen Klassifizierung der Bodenproben ergänzt. Zudem wurden die Spalte Modell4 im Bereich der Bodenproben um ebendiese Information erweitert.
# Daten einlesen
data1<-read.csv("../Daten//Kap_6//Kap_6.2//Grundlagen//Rezeptur//PCA_Ker_BP_HE_bearb.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=Modell4, shape=Shape))+
geom_point(aes(shape=Shape),size=2)+scale_shape_manual(values=c(18,1,2,3,4,5,6,7,8,15,17,19))+ # Manuelle Definition von Größe und Form der Symbole
scale_color_manual(name="Modell4",values=c("black","cyan4","grey","burlywood","brown","red","black"))+ # 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=Modell4, shape=Shape))+
geom_point(aes(shape=Shape),size=2)+scale_shape_manual(values=c(18,1,2,3,4,5,6,7,8,15,17,19))+
scale_color_manual(name="Modell4",values=c("black","cyan4","grey","burlywood","brown","red","black"))+
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=Modell4, shape=Shape))+
geom_point(aes(shape=Shape),size=2)+scale_shape_manual(values=c(18,1,2,3,4,5,6,7,8,15,17,19))+
scale_color_manual(name="Modell4",values=c("black","cyan4","grey","burlywood","brown","red","black"))+
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")
# Export des kombinierten Diagramms
ggsave("Abb.6-60.eps",path=("../Daten//Kap_6//Kap_6.2//Abbildungen//Rezeptur//"),plot=last_plot(),device="eps",height=15,width=15.3,unit=c("cm"),dpi=1200)32.5 Abb. 6-61
# Daten einlesen
data<-read.csv("../Daten//Kap_6//Kap_6.2//Grundlagen//Rezeptur//PCA_Ker_BP_HE_bearb.csv")
# Diagramme erstellen
PCA1_2<-autoplot(myPr, data = data, colour = 'Modell4', shape='Shape',loadings.colour = 'black', loadings.label = TRUE, loadings.label.size = 3,loadings = TRUE)+
scale_shape_manual(values=c(18,1,2,3,4,5,6,7,8,15,17,19))+ # Manuelle Definition der Form der Symbole
scale_color_manual(name="Modell4",values=c("black","cyan4","grey","burlywood","brown","red","black"))+ # 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 = 'Modell4', shape='Shape',loadings.colour = 'black',loadings.label = TRUE, loadings.label.size = 3,loadings = TRUE)+
scale_shape_manual(values=c(18,1,2,3,4,5,6,7,8,15,17,19))+
scale_color_manual(name="Modell4",values=c("black","cyan4","grey","burlywood","brown","red","black"))+
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 = 'Modell4', shape='Shape',loadings.colour = 'black',loadings.label = TRUE, loadings.label.size = 3,loadings = TRUE)+
scale_shape_manual(values=c(18,1,2,3,4,5,6,7,8,15,17,19))+
scale_color_manual(name="Modell4",values=c("black","cyan4","grey","burlywood","brown","red","black"))+
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")
# Export des kombinierten Diagramms
ggsave("Abb.6-61.eps",path=("../Daten//Kap_6//Kap_6.2//Abbildungen//Rezeptur//"),plot=last_plot(),device="eps",height=20,width=15.3,unit=c("cm"),dpi=1200)33 Tonproben und Keramik
Es wurde in Datei Daten_Rez_BP_log10_MW_bearb händisch die Spalte ‘Material’ ergänzt um nach Keramik und Ton filtern zu können.
33.1 Berechnen der MANOVA
# Daten einlesen und filtern
data1<-read.csv("../Daten//Kap_6//Kap_6.2//Grundlagen//Rezeptur//Daten_Rez_BP_log10_MW_bearb.csv")
data<-subset(data1, Material %in% c("LBK","La Hoguette","Ton"))
# Durchführen der MANOVA für ausgewählte Spalten im Hinblick auf Modell 4
manova<-manova(cbind(SiO2,TiO2,Al2O3,Fe2O3,MnO,CaO,K2O,P2O5,Zn,Rb,Sr,Y,Zr) ~ Modell4, data)
# Zusammenfassung der MANOVA mit Intercept
summary(manova) Df Pillai approx F num Df den Df Pr(>F)
Modell4 6 2.3265 13.445 78 1656 < 2.2e-16 ***
Residuals 283
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# Anzeige der MANOVA-Ergebnisse mit Wilks-Lambda-Tests
summary(manova,test="Wilks") Df Wilks approx F num Df den Df Pr(>F)
Modell4 6 0.015529 21.706 78 1500.3 < 2.2e-16 ***
Residuals 283
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 133.2 Hauptkomponentenanalyse
33.2.1 Berechnen und Zusammenstellen der PCA-DAten
# Daten einlesen und filtern
data1<-read.csv("../Daten//Kap_6//Kap_6.2//Grundlagen//Rezeptur//Daten_Rez_BP_log10_MW_bearb.csv")
data<-subset(data1, Material %in% c("LBK","La Hoguette","Ton"))
# Durchführen der PCA für ausgewählte Spalten
myPr <- prcomp(~ SiO2+TiO2+Al2O3+MnO+Fe2O3+CaO+K2O+P2O5+Zn+Rb+Sr+Y+Zr,data=data,scale = TRUE)
myPrStandard deviations (1, .., p=13):
[1] 1.8413818 1.6419084 1.3252092 1.1979075 1.1136210 0.8485251 0.6975619
[8] 0.6332347 0.5359861 0.4576755 0.4228144 0.3807686 0.2325041
Rotation (n x k) = (13 x 13):
PC1 PC2 PC3 PC4 PC5 PC6
SiO2 0.50412357 0.10996501 0.02071690 -0.03688935 0.070706489 -0.13267368
TiO2 -0.23081911 0.36673875 0.22716518 0.09682344 -0.189246220 -0.39939354
Al2O3 -0.30901061 0.09885056 0.03876616 0.47996158 -0.177507433 0.53867371
MnO -0.27101301 0.13919210 0.19578357 0.05117540 0.619780029 -0.21453106
Fe2O3 -0.32548648 0.30488268 0.25945924 0.09223874 0.320120515 0.13820343
CaO -0.32145970 -0.39012333 -0.01820414 -0.26662437 -0.043257298 -0.24859557
K2O 0.20222162 -0.37879010 0.09138435 0.32624043 0.386273412 0.10465188
P2O5 -0.30651359 -0.21759932 -0.49111858 0.01794661 -0.034487117 0.12530898
Zn -0.07736754 -0.17083172 0.26862909 0.45357845 -0.453629032 -0.41432580
Rb 0.18382037 -0.39661358 0.16593064 0.40261073 0.178157558 -0.09222555
Sr -0.33664751 -0.23529589 -0.30751330 0.04150778 0.163088254 -0.29910406
Y 0.07607201 0.22074639 -0.46199124 0.38537462 -0.001485012 -0.04423545
Zr 0.14363234 0.31257721 -0.42806404 0.22774022 0.157117921 -0.32793874
PC7 PC8 PC9 PC10 PC11 PC12
SiO2 -0.12411002 0.08451738 0.31901931 0.050523927 0.12236735 -0.34177976
TiO2 -0.33356026 0.45334499 -0.37948270 -0.121981791 -0.23731453 -0.10607322
Al2O3 -0.18693127 -0.07145085 0.20269082 -0.382517696 0.02626518 0.10220785
MnO 0.26411848 -0.27130760 0.12461343 -0.365025669 -0.20670389 -0.31812094
Fe2O3 0.03546191 0.02990939 -0.04972505 0.661200272 0.35648919 0.10827020
CaO 0.25917104 -0.02230077 -0.20116122 -0.152533399 0.13389550 0.37007752
K2O -0.03876783 0.29961460 -0.02495792 0.201746219 -0.56085392 0.28706468
P2O5 -0.13836685 -0.18075206 -0.26361351 0.305301151 -0.24348271 -0.54304734
Zn 0.23161512 -0.28531852 0.27479475 0.280497126 -0.11780576 -0.07673447
Rb -0.20178428 -0.05746879 -0.42871685 -0.161506693 0.52567166 -0.19561339
Sr -0.32464687 0.35720340 0.54965729 -0.004842544 0.23216675 0.01829503
Y 0.62695320 0.38744830 -0.10916021 -0.059603306 0.14509318 -0.04226061
Zr -0.29449705 -0.47156146 -0.10585228 0.017396189 -0.03571926 0.43362183
PC13
SiO2 0.671353670
TiO2 0.112590312
Al2O3 0.320325821
MnO -0.003233177
Fe2O3 0.151931593
CaO 0.568411781
K2O 0.105460244
P2O5 0.177727040
Zn -0.021936988
Rb -0.102646439
Sr -0.171998272
Y 0.009088317
Zr 0.066491614# Eigenwerte der Hauptkomponenten
summary(myPr)Importance of components:
PC1 PC2 PC3 PC4 PC5 PC6 PC7
Standard deviation 1.8414 1.6419 1.3252 1.1979 1.1136 0.84853 0.69756
Proportion of Variance 0.2608 0.2074 0.1351 0.1104 0.0954 0.05538 0.03743
Cumulative Proportion 0.2608 0.4682 0.6033 0.7137 0.8091 0.86445 0.90188
PC8 PC9 PC10 PC11 PC12 PC13
Standard deviation 0.63323 0.5360 0.45768 0.42281 0.38077 0.23250
Proportion of Variance 0.03085 0.0221 0.01611 0.01375 0.01115 0.00416
Cumulative Proportion 0.93273 0.9548 0.97094 0.98469 0.99584 1.00000# Screeplot der Eigenwerte
plot(myPr, type="l")
# Kombinieren der ursprünglichen Daten mit den ersten vier Hauptkomponenten
PCdata1 <- cbind(data,myPr$x[,1:4])
# Speichern als CSV
write.csv(PCdata1,"../Daten//Kap_6//Kap_6.2//Grundlagen//Rezeptur//PCA_Ker_Ton_HE.csv",row.names=FALSE)33.2.2 Berechnen der Camargo-Teststatistik
# Daten einlesen und filtern
data1<-read.csv("../Daten//Kap_6//Kap_6.2//Grundlagen//Rezeptur//Daten_Rez_BP_log10_MW_bearb.csv")
data<-subset(data1, Material %in% c("LBK","La Hoguette","Ton"))
data10<-data[,c(2:6,8:10,15:19),]
# Berechnung der Varianz für alle numerischen Spalten
data10 %>% dplyr::summarise_if(is.numeric, var) SiO2 TiO2 Al2O3 Fe2O3 MnO CaO
1 0.001756522 0.0141127 0.002462802 0.01331892 0.07937189 0.07519701
K2O P2O5 Zn Rb Sr Y
1 0.009483348 0.1067304 0.05203025 0.01485286 0.02866333 0.003957478
Zr
1 0.009575696# 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: 13 variables, 290 observations
1000 bootstrap replicates, 1000 random permutations
========================================================
Empirical Psi = 13.5440, Max null Psi = 0.8920, Min null Psi = 0.2948, p-value = 0
Empirical Phi = 0.2947, Max null Phi = 0.0756, Min null Phi = 0.0435, p-value = 0
Empirical eigenvalue #1 = 3.39069, Max null eigenvalue = 1.54051, p-value = 0
Empirical eigenvalue #2 = 2.69586, Max null eigenvalue = 1.40862, p-value = 0
Empirical eigenvalue #3 = 1.75618, Max null eigenvalue = 1.31401, p-value = 0
Empirical eigenvalue #4 = 1.43498, Max null eigenvalue = 1.22463, p-value = 0
Empirical eigenvalue #5 = 1.24015, Max null eigenvalue = 1.15728, p-value = 0
Empirical eigenvalue #6 = 0.71999, Max null eigenvalue = 1.10926, p-value = 1
Empirical eigenvalue #7 = 0.48659, Max null eigenvalue = 1.06789, p-value = 1
Empirical eigenvalue #8 = 0.40099, Max null eigenvalue = 1.01899, p-value = 1
Empirical eigenvalue #9 = 0.28728, Max null eigenvalue = 0.96941, p-value = 1
Empirical eigenvalue #10 = 0.20947, Max null eigenvalue = 0.93476, p-value = 1
Empirical eigenvalue #11 = 0.17877, Max null eigenvalue = 0.8673, p-value = 1
Empirical eigenvalue #12 = 0.14498, Max null eigenvalue = 0.81848, p-value = 1
Empirical eigenvalue #13 = 0.05406, Max null eigenvalue = 0.76152, p-value = 1
PC 1 is significant and accounts for 26.1% (95%-CI:23.8-30) of the total variation
PC 2 is significant and accounts for 20.7% (95%-CI:18.4-23.1) of the total variation
PC 3 is significant and accounts for 13.5% (95%-CI:12.2-15.7) of the total variation
PC 4 is significant and accounts for 11% (95%-CI:9.6-12.5) of the total variation
PC 5 is significant and accounts for 9.5% (95%-CI:8-10.4) of the total variation
The first 5 PC axes are significant and account for 80.9% of the total variation
Variables 1, 2, 3, 4, 5, 6, 7, 8, and 11 have significant loadings on PC 1
Variables 2, 4, 6, 7, 10, 11, and 13 have significant loadings on PC 2
Variables 8, 12, and 13 have significant loadings on PC 3
Variables 3, and 9 have significant loadings on PC 4
Variables 5, and 9 have significant loadings on PC 533.3 Abb. 6-62
# Erstellung einer EPS-Datei
setEPS()
postscript("../Daten//Kap_6//Kap_6.2///Abbildungen//Rezeptur//Abb.6-62.eps", width = 6.5, height = 6.5)
# Erstellen eines 2x2 Plots
par(mfrow = c(2, 2))
# 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)
# Schließen der EPS-Datei
dev.off()png
2 
33.4 Abb. 6-63
# Daten einlesen
data1<-read.csv("../Daten//Kap_6//Kap_6.2//Grundlagen//Rezeptur//PCA_Ker_Ton_HE.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=Modell4, shape=Shape))+
geom_point(aes(shape=Shape),size=2)+scale_shape_manual(values=c(18,15,17,19))+ # Manuelle Definition von Größe und Form der Symbole
scale_color_manual(name="Modell4",values=c("black","cyan4","grey","burlywood","brown","red","black"))+ # 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=Modell4, shape=Shape))+
geom_point(aes(shape=Shape),size=2)+scale_shape_manual(values=c(18,15,17,19))+
scale_color_manual(name="Modell4",values=c("black","cyan4","grey","burlywood","brown","red","black"))+
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=Modell4, shape=Shape))+
geom_point(aes(shape=Shape),size=2)+scale_shape_manual(values=c(18,15,17,19))+
scale_color_manual(name="Modell4",values=c("black","cyan4","grey","burlywood","brown","red","black"))+
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")
# Export des kombinierten Diagramms
ggsave("Abb.6-63.eps",path=("../Daten//Kap_6//Kap_6.2//Abbildungen//Rezeptur//"),plot=last_plot(),device="eps",height=15,width=15.3,unit=c("cm"),dpi=1200)33.5 Abb. 6-64
# Daten einlesen
data<-read.csv("../Daten//Kap_6//Kap_6.2//Grundlagen//Rezeptur//PCA_Ker_Ton_HE.csv")
# Diagramme erstellen
PCA1_2<-autoplot(myPr, data = data, colour = 'Modell4', shape='Shape',loadings.colour = 'black', loadings.label = TRUE, loadings.label.size = 3,loadings = TRUE)+
scale_shape_manual(values=c(18,15,17,19))+ # Manuelle Definition der Form der Symbole
scale_color_manual(name="Modell4",values=c("black","cyan4","grey","burlywood","brown","red","black"))+ # 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 = 'Modell4', shape='Shape',loadings.colour = 'black',loadings.label = TRUE, loadings.label.size = 3,loadings = TRUE)+
scale_shape_manual(values=c(18,15,17,19))+
scale_color_manual(name="Modell4",values=c("black","cyan4","grey","burlywood","brown","red","black"))+
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 = 'Modell4', shape='Shape',loadings.colour = 'black',loadings.label = TRUE, loadings.label.size = 3,loadings = TRUE)+
scale_shape_manual(values=c(18,15,17,19))+
scale_color_manual(name="Modell4",values=c("black","cyan4","grey","burlywood","brown","red","black"))+
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")
# Export des kombinierten Diagramms
ggsave("Abb.6-64.eps",path=("../Daten//Kap_6//Kap_6.2//Abbildungen//Rezeptur//"),plot=last_plot(),device="eps",height=20,width=15.3,unit=c("cm"),dpi=1200)33.6 Abb. 6-65
33.6.1 Mittel- und Extremwerte der Tone berechnen
# Daten einlesen und filtern
data1<-read.csv("../Daten//Kap_6//Kap_6.2//Grundlagen//Bodenproben//Daten_BB_BP_vollständig_bearb.csv")
data2<-subset(data1, Label %in% c("Ton"))
data3<-data2[,c(2:23),]
# Berechnung von Mittel-, Minimal- und Maximialwert
MinMaxMeanTon<-(data3) %>%
group_by(Probennr.) %>%
dplyr::summarise(across(everything(),list(Max=max,Mittelwert=mean,Min=min)))
# Speichern als CSV
write.csv(MinMaxMeanTon,"../Daten//Kap_6//Kap_6.2//Grundlagen//Bodenproben//MinMaxMeanBP.csv",row.names=FALSE)33.6.2 Zusammenstellen der Daten von Tonen und Keramik (Messwerte+chem. Gruppen)
# Daten einlesen und filtern
data<-read.csv("../Daten//Kap_6//Kap_6.2//Grundlagen//Datengrundlage//Daten_BB_vollständigMW_bearb.csv")
data1<-subset(data, Messstelle %in% c("frischer Bruch"))
data2<-subset(data1, Kultur %in% c("LBK","La Hoguette"))
data3<-data2[,c(1,3:23),]
# Daten einlesen und filtern
data4<-read.csv("../Daten//Kap_6//Kap_6.2//Grundlagen//Bodenproben//Daten_BB_BP_vollständig_bearb.csv")
data5<-subset(data4, Label %in% c("Ton"))
data6<-data5[,c(2:23),]
# Berechnung des Mittelwerts der Tone
MeanTon<-(data6) %>%
group_by(Probennr.) %>%
dplyr::summarise(across(everything(),list(Mittelwert=mean)))
# Entfernen von "_Mittelwert" aus den Spaltennamen
colnames(MeanTon) <- gsub("_Mittelwert", "", colnames(MeanTon))
# Umbenennen der ersten Spalte zu "Probennummer"
data7<-MeanTon %>% dplyr::rename(Probennummer=1)
# Zeilenweise Kombination mehrerer Dataframes
data8<-rbind(data3,data7)
# Daten einlesen und filtern
data9<-read.csv("../Daten//Kap_6//Kap_6.2//Grundlagen//Rezeptur//PCA_Ker_Ton_HE.csv")
data10<-subset(data9, Kultur %in% c("LBK","La Hoguette"))
data11<-data10[,c(1,23,26),]
# Kombinieren mehrerer Dataframes basierend auf der Probennummer
data12<-merge(data8,data11, by="Probennummer", all=TRUE)
# Speichern als CSV
write.csv(data12,"../Daten//Kap_6//Kap_6.2//Grundlagen//Datengrundlage//Daten_BB_Ker_Ton_Messwerte_chemGruppen.csv",row.names=FALSE)33.6.3 Erstellen Abb. 6-65
In Datei Daten_BB_Ker_Ton_Messwerte_chemGruppen wurden händisch in Spalte Modell 4 und Kultur die Probennr. spezifiziert.
# Daten einlesen
data<-read.csv("../Daten//Kap_6//Kap_6.2//Grundlagen//Datengrundlage//Daten_BB_Ker_Ton_Messwerte_chemGruppen_bearb.csv")
data2<-read.csv("../Daten//Kap_6//Kap_6.2//Grundlagen//Bodenproben//MinMaxMeanBP.csv")
# Darstellungsreihenfolge definieren
data$Modell4<-factor(data$Modell4,levels=c("Rezeptur 1", "Rezeptur 2a", "Rezeptur 2b", "Rezeptur 3a", "Rezeptur 3b", "Rezeptur 4", "BP 08", "BP 09", "BP 10"))
# Diagramme erstellen
Scatter_Herkunft_Ton_Rb_Sr<-ggplot(data, aes(x=Rb,y=Sr, color=Modell4, shape=Kultur))+
geom_point(aes(shape=Kultur),size=2)+scale_shape_manual(values=c(5, 15, 6,17,19))+ # Manuelle Definition der Form der Symbole
scale_color_manual(name="Modell4",values=c("cyan4","grey","burlywood","brown","red","black","black","black","black"))+ # 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
geom_errorbar(data = data2,mapping = aes(x=Rb_Mittelwert,y=Sr_Mittelwert, shape=NULL,color=NULL,xmin = Rb_Min, xmax = Rb_Max,ymin=Sr_Min, ymax=Sr_Max),width =2,position = position_dodge(0.05))+ # Hinzufügen von vertikalen Fehlerbalken für die Mittelwerte der Tone
geom_errorbarh(data = data2, mapping = aes(x=Rb_Mittelwert,y=Sr_Mittelwert, shape=NULL,color=NULL,xmin = Rb_Min, xmax = Rb_Max,ymin=Sr_Min, ymax=Sr_Max),position = position_dodge(0.05),height=12) # Hinzufügen von horizontalen Fehlerbalken für die Mittelwerte der Tone
Scatter_Herkunft_Ton_Sr_Zr<-ggplot(data, aes(x=Sr,y=Zr, color=Modell4, shape=Kultur))+
geom_point(aes(shape=Kultur),size=2)+scale_shape_manual(values=c(5, 15, 6,17,19))+
scale_color_manual(name="Modell4",values=c("cyan4","grey","burlywood","brown","red","black","black","black","black"))+
xlab("Sr 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"))+
geom_errorbar(data = data2,mapping = aes(x=Sr_Mittelwert,y=Zr_Mittelwert, shape=NULL,color=NULL,xmin = Sr_Min, xmax = Sr_Max,ymin=Zr_Min, ymax=Zr_Max),width =0.5,position = position_dodge(0.05))+
geom_errorbarh(data = data2, mapping = aes(x=Zr_Mittelwert,y=Zr_Mittelwert, shape=NULL,color=NULL,xmin = Sr_Min, xmax = Sr_Max,ymin=Zr_Min, ymax=Zr_Max),position = position_dodge(0.05),height=12)
Scatter_Herkunft_Ton_Y_Zr<-ggplot(data, aes(x=Y,y=Zr, color=Modell4, shape=Kultur))+
geom_point(aes(shape=Kultur),size=2)+scale_shape_manual(values=c(5, 15, 6,17,19))+
scale_color_manual(name="Modell4",values=c("cyan4","grey","burlywood","brown","red","black","black","black","black"))+
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"))+
geom_errorbar(data = data2,mapping = aes(x=Y_Mittelwert,y=Zr_Mittelwert, shape=NULL,color=NULL,xmin = Y_Min, xmax = Y_Max,ymin=Zr_Min, ymax=Zr_Max),width =0.3,position = position_dodge(0.05))+
geom_errorbarh(data = data2, mapping = aes(x=Y_Mittelwert,y=Zr_Mittelwert, shape=NULL,color=NULL,xmin = Y_Min, xmax = Y_Max,ymin=Zr_Min, ymax=Zr_Max),position = position_dodge(0.05),height=10)
Scatter_Herkunft_Ton_Cu_Zn<-ggplot(data, aes(x=Cu,y=Zn, color=Modell4, shape=Kultur))+
geom_point(aes(shape=Kultur),size=2)+scale_shape_manual(values=c(5, 15, 6,17,19))+
scale_color_manual(name="Modell4",values=c("cyan4","grey","burlywood","brown","red","black","black","black","black"))+
xlab("Cu in ppm")+ylab("Zn 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"))+
geom_errorbar(data = data2,mapping = aes(x=Cu_Mittelwert,y=Zn_Mittelwert, shape=NULL,color=NULL,xmin = Cu_Min, xmax = Cu_Max,ymin=Zn_Min, ymax=Zn_Max),width =0.5,position = position_dodge(0.05))+
geom_errorbarh(data = data2, mapping = aes(x=Cu_Mittelwert,y=Zn_Mittelwert, shape=NULL,color=NULL,xmin = Cu_Min, xmax = Cu_Max,ymin=Zn_Min, ymax=Zn_Max),position = position_dodge(0.05),height=1)
Scatter_Herkunft_Ton_Cu_Nb<-ggplot(data, aes(x=Cu,y=Nb, color=Modell4, shape=Kultur))+
geom_point(aes(shape=Kultur),size=2)+scale_shape_manual(values=c(5, 15, 6,17,19))+
scale_color_manual(name="Modell4",values=c("cyan4","grey","burlywood","brown","red","black","black","black","black"))+
xlab("Cu in ppm")+ylab("Nb 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"))+
geom_errorbar(data = data2,mapping = aes(x=Cu_Mittelwert,y=Nb_Mittelwert, shape=NULL,color=NULL,xmin = Cu_Min, xmax = Cu_Max,ymin=Nb_Min, ymax=Nb_Max),width =0.5,position = position_dodge(0.05))+
geom_errorbarh(data = data2, mapping = aes(x=Cu_Mittelwert,y=Nb_Mittelwert, shape=NULL,color=NULL,xmin = Cu_Min, xmax = Cu_Max,ymin=Nb_Min, ymax=Nb_Max),position = position_dodge(0.05),height=1)
Scatter_Herkunft_Ton_Cu_Pb<-ggplot(data, aes(x=Cu,y=Pb, color=Modell4, shape=Kultur))+
geom_point(aes(shape=Kultur),size=2)+scale_shape_manual(values=c(5, 15, 6,17,19))+
scale_color_manual(name="Modell4",values=c("cyan4","grey","burlywood","brown","red","black","black","black","black"))+
xlab("Cu in ppm")+ylab("Pb 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"))+
geom_errorbar(data = data2,mapping = aes(x=Cu_Mittelwert,y=Pb_Mittelwert, shape=NULL,color=NULL,xmin = Cu_Min, xmax = Cu_Max,ymin=Pb_Min, ymax=Pb_Max),width =0.5,position = position_dodge(0.05))+
geom_errorbarh(data = data2, mapping = aes(x=Cu_Mittelwert,y=Pb_Mittelwert, shape=NULL,color=NULL,xmin = Cu_Min, xmax = Cu_Max,ymin=Pb_Min, ymax=Pb_Max),position = position_dodge(0.05),height=1)
Scatter_Herkunft_Ton_Nb_Pb<-ggplot(data, aes(x=Nb,y=Pb, color=Modell4, shape=Kultur))+
geom_point(aes(shape=Kultur),size=2)+scale_shape_manual(values=c(5, 15, 6,17,19))+
scale_color_manual(name="Modell4",values=c("cyan4","grey","burlywood","brown","red","black","black","black","black"))+
xlab("Nb in ppm")+ylab("Pb 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"))+
geom_errorbar(data = data2,mapping = aes(x=Nb_Mittelwert,y=Pb_Mittelwert, shape=NULL,color=NULL,xmin = Nb_Min, xmax = Nb_Max,ymin=Pb_Min, ymax=Pb_Max),width =0.5,position = position_dodge(0.05))+
geom_errorbarh(data = data2, mapping = aes(x=Nb_Mittelwert,y=Pb_Mittelwert, shape=NULL,color=NULL,xmin = Nb_Min, xmax = Nb_Max,ymin=Pb_Min, ymax=Pb_Max),position = position_dodge(0.05),height=1)
Scatter_Herkunft_Ton_CaO_Sr<-ggplot(data, aes(x=CaO,y=Sr, color=Modell4, shape=Kultur))+
geom_point(aes(shape=Kultur),size=2)+scale_shape_manual(values=c(5, 15, 6,17,19))+
scale_color_manual(name="Modell4",values=c("cyan4","grey","burlywood","brown","red","black","black","black","black"))+
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"))+
geom_errorbar(data = data2,mapping = aes(x=CaO_Mittelwert,y=Sr_Mittelwert, shape=NULL,color=NULL,xmin = CaO_Min, xmax = CaO_Max,ymin=Sr_Min, ymax=Sr_Max),width =0.1,position = position_dodge(0.05))+
geom_errorbarh(data = data2, mapping = aes(x=CaO_Mittelwert,y=Sr_Mittelwert, shape=NULL,color=NULL,xmin = CaO_Min, xmax = CaO_Max,ymin=Sr_Min, ymax=Sr_Max),position = position_dodge(0.05),height=10)
Scatter_Herkunft_Ton_Rb_K2O<-ggplot(data, aes(x=Rb,y=K2O, color=Modell4, shape=Kultur))+
geom_point(aes(shape=Kultur),size=2)+scale_shape_manual(values=c(5, 15, 6,17,19))+
scale_color_manual(name="Modell4",values=c("cyan4","grey","burlywood","brown","red","black","black","black","black"))+
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"))+
geom_errorbar(data = data2,mapping = aes(x=Rb_Mittelwert,y=K2O_Mittelwert, shape=NULL,color=NULL,xmin = Rb_Min, xmax = Rb_Max,ymin=K2O_Min, ymax=K2O_Max),width =2,position = position_dodge(0.05))+
geom_errorbarh(data = data2, mapping = aes(x=Rb_Mittelwert,y=K2O_Mittelwert, shape=NULL,color=NULL,xmin = Rb_Min, xmax = Rb_Max,ymin=K2O_Min, ymax=K2O_Max),position = position_dodge(0.05),height=0.04)
Scatter_Herkunft_Ton_Al2O3_SiO2<-ggplot(data, aes(x=Al2O3,y=SiO2, color=Modell4, shape=Kultur))+
geom_point(aes(shape=Kultur),size=2)+scale_shape_manual(values=c(5, 15, 6,17,19))+
scale_color_manual(name="Modell4",values=c("cyan4","grey","burlywood","brown","red","black","black","black","black"))+
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"))+
geom_errorbar(data = data2,mapping = aes(x=Al2O3_Mittelwert,y=SiO2_Mittelwert, shape=NULL,color=NULL,xmin = Al2O3_Min, xmax = Al2O3_Max,ymin=SiO2_Min, ymax=SiO2_Max),width =0.2,position = position_dodge(0.05))+
geom_errorbarh(data = data2, mapping = aes(x=Al2O3_Mittelwert,y=SiO2_Mittelwert, shape=NULL,color=NULL,xmin = Al2O3_Min, xmax = Al2O3_Max,ymin=SiO2_Min, ymax=SiO2_Max),position = position_dodge(0.05),height=0.5)
Scatter_Herkunft_Ton_CaO_P2O5<-ggplot(data, aes(x=CaO,y=P2O5, color=Modell4, shape=Kultur))+
geom_point(aes(shape=Kultur),size=2)+scale_shape_manual(values=c(5, 15, 6,17,19))+
scale_color_manual(name="Modell4",values=c("cyan4","grey","burlywood","brown","red","black","black","black","black"))+
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"))+
geom_errorbar(data = data2,mapping = aes(x=CaO_Mittelwert,y=P2O5_Mittelwert, shape=NULL,color=NULL,xmin = CaO_Min, xmax = CaO_Max,ymin=P2O5_Min, ymax=P2O5_Max),width =0.2,position = position_dodge(0.05))+
geom_errorbarh(data = data2, mapping = aes(x=CaO_Mittelwert,y=P2O5_Mittelwert, shape=NULL,color=NULL,xmin = CaO_Min, xmax = CaO_Max,ymin=P2O5_Min, ymax=P2O5_Max),position = position_dodge(0.05),height=0.1)
Scatter_Herkunft_Ton_CaO_Fe2O3<-ggplot(data, aes(x=CaO,y=Fe2O3, color=Modell4, shape=Kultur))+
geom_point(aes(shape=Kultur),size=2)+scale_shape_manual(values=c(5, 15, 6,17,19))+
scale_color_manual(name="Modell4",values=c("cyan4","grey","burlywood","brown","red","black","black","black","black"))+
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"))+
geom_errorbar(data = data2,mapping = aes(x=CaO_Mittelwert,y=Fe2O3_Mittelwert, shape=NULL,color=NULL,xmin = CaO_Min, xmax = CaO_Max,ymin=Fe2O3_Min, ymax=Fe2O3_Max),width =0.2,position = position_dodge(0.05))+
geom_errorbarh(data = data2, mapping = aes(x=CaO_Mittelwert,y=Fe2O3_Mittelwert, shape=NULL,color=NULL,xmin = CaO_Min, xmax = CaO_Max,ymin=Fe2O3_Min, ymax=Fe2O3_Max),position = position_dodge(0.05),height=0.2)
Scatter_Herkunft_Ton_MnO_Fe2O3<-ggplot(data, aes(x=MnO,y=Fe2O3, color=Modell4, shape=Kultur))+
geom_point(aes(shape=Kultur),size=2)+scale_shape_manual(values=c(5, 15, 6,17,19))+
scale_color_manual(name="Modell4",values=c("cyan4","grey","burlywood","brown","red","black","black","black","black"))+
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"))+
geom_errorbar(data = data2,mapping = aes(x=MnO_Mittelwert,y=Fe2O3_Mittelwert, shape=NULL,color=NULL,xmin = MnO_Min, xmax = MnO_Max,ymin=Fe2O3_Min, ymax=Fe2O3_Max),width =0.01,position = position_dodge(0.05))+
geom_errorbarh(data = data2, mapping = aes(x=MnO_Mittelwert,y=Fe2O3_Mittelwert, shape=NULL,color=NULL,xmin = MnO_Min, xmax = MnO_Max,ymin=Fe2O3_Min, ymax=Fe2O3_Max),position = position_dodge(0.05),height=0.2)
Scatter_Herkunft_Ton_TiO2_K2O<-ggplot(data, aes(x=TiO2,y=K2O, color=Modell4, shape=Kultur))+
geom_point(aes(shape=Kultur),size=2)+scale_shape_manual(values=c(5, 15, 6,17,19))+
scale_color_manual(name="Modell4",values=c("cyan4","grey","burlywood","brown","red","black","black","black","black"))+
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"))+
geom_errorbar(data = data2,mapping = aes(x=TiO2_Mittelwert,y=K2O_Mittelwert, shape=NULL,color=NULL,xmin = TiO2_Min, xmax = TiO2_Max,ymin=K2O_Min, ymax=K2O_Max),width =0.04,position = position_dodge(0.05))+
geom_errorbarh(data = data2, mapping = aes(x=TiO2_Mittelwert,y=K2O_Mittelwert, shape=NULL,color=NULL,xmin = TiO2_Min, xmax = TiO2_Max,ymin=K2O_Min, ymax=K2O_Max),position = position_dodge(0.05),height=0.05)
Scatter_Herkunft_Ton_TiO2_Zr<-ggplot(data, aes(x=TiO2,y=Zr, color=Modell4, shape=Kultur))+
geom_point(aes(shape=Kultur),size=2)+scale_shape_manual(values=c(5, 15, 6,17,19))+
scale_color_manual(name="Modell4",values=c("cyan4","grey","burlywood","brown","red","black","black","black","black"))+
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"))+
geom_errorbar(data = data2,mapping = aes(x=TiO2_Mittelwert,y=Zr_Mittelwert, shape=NULL,color=NULL,xmin = TiO2_Min, xmax = TiO2_Max,ymin=Zr_Min, ymax=Zr_Max),width =0.04,position = position_dodge(0.05))+
geom_errorbarh(data = data2, mapping = aes(x=TiO2_Mittelwert,y=Zr_Mittelwert, shape=NULL,color=NULL,xmin = TiO2_Min, xmax = TiO2_Max,ymin=Zr_Min, ymax=Zr_Max),position = position_dodge(0.05),height=10)
# Kombination der Diagramme
ggarrange(Scatter_Herkunft_Ton_Al2O3_SiO2,Scatter_Herkunft_Ton_CaO_P2O5,Scatter_Herkunft_Ton_CaO_Fe2O3,Scatter_Herkunft_Ton_MnO_Fe2O3,Scatter_Herkunft_Ton_TiO2_K2O,Scatter_Herkunft_Ton_TiO2_Zr,Scatter_Herkunft_Ton_CaO_Sr,Scatter_Herkunft_Ton_Rb_K2O,Scatter_Herkunft_Ton_Rb_Sr,Scatter_Herkunft_Ton_Sr_Zr, Scatter_Herkunft_Ton_Y_Zr,Scatter_Herkunft_Ton_Cu_Zn,Scatter_Herkunft_Ton_Nb_Pb,Scatter_Herkunft_Ton_Cu_Nb,Scatter_Herkunft_Ton_Cu_Pb,ncol=3,nrow=6,align = "hv",common.legend=TRUE)+theme(legend.position="bottom")
# Export des kombinierten Diagramms
ggsave("Abb.6-65.eps",path=("../Daten//Kap_6//Kap_6.2//Abbildungen//Rezeptur//"),plot=last_plot(),device="eps",height=26,width=15.3,unit=c("cm"),dpi=1200)34 Abb. 6-66
# Daten einlesen
data<-read.csv("../Daten//Kap_6//Kap_6.2//Grundlagen//Datengrundlage//Daten_BB_Ker_vollständigMW_chemGruppen_bearb.csv")
# Diagramm erstellen
ggplot(data)+geom_bar(aes(fill=Kultur, x=Modell4),position = position_dodge2(preserve = 'single',padding = 0.0),color="black")+
scale_fill_manual(values = c("La Hoguette" = "grey20", "LBK" = "lightgrey"))+ # Manuelle Definition der Farbe der Balken
geom_text(aes(mapping=Kultur, x=Modell4,label=..count..),stat='count',position=position_dodge(1),vjust=-0.3,size=2.75)+ # Manuelles Hinzufügen der Zahlenwerte als Text oberhalb der Balken
xlab("Chemische Rezepturen")+ylab("Probenanzahl")+ # Manuelle Achsenbeschriftung
scale_y_continuous(breaks=seq(0,300,20),expand=c(0,0),limits=c(0,205))+ # Manuelle Definition der Y-Achse
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
theme(axis.text.x = element_text(angle = 90, vjust = 0.3,hjust=0.3)) # Vertikale Darstellung der X-Achsenbeschriftung
# Export des Diagramms
ggsave("Abb.6-66.eps",path=("../Daten//Kap_6//Kap_6.2//Abbildungen//Rezeptur//"),plot=last_plot(),device="eps",height=10,width=5.5,unit=c("cm"),dpi=1200)35 Abb. 6-67
Zur besseren Sichtbarkeit im Druck wurde der längste Balken (Dat. I/Rezeptur 1 = 219) nicht vollständig abgebildet und den Abbildungen händisch ergänzt
# Daten einlesen
data<-read.csv("../Daten//Kap_6//Kap_6.2//Grundlagen//Datengrundlage//Daten_BB_Ker_vollständigMW_chemGruppen_bearb.csv")
# Diagramm erstellen
ggplot(data)+geom_bar(aes(fill=Modell4, x=Datierung),position = position_dodge2(preserve = 'single',padding =0.0),color="black")+
scale_fill_manual(values = c("Rezeptur 1" = "cyan4", "Rezeptur 2a" = "grey","Rezeptur 2b"="burlywood","Rezeptur 3a"="brown","Rezeptur 3b"="red", "Rezeptur 4"="black"))+ # Manuelle Definition der Farbe der Balken
geom_text(aes(mapping=Modell4,x=Datierung,label=..count..),stat='count',position=position_dodge(1),vjust=-0.3,size=2.75)+ # Manuelles Hinzufügen der Zahlenwerte als Text oberhalb der Balken
xlab("Datierung")+ylab("Probenanzahl")+ # Manuelle Achsenbeschriftung
scale_y_continuous(breaks=seq(0,300,5),expand=c(0,0),limits=c(0,40))+ # Manuelle Definition der Y-Achse
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
# Export des Diagramms
ggsave("Abb.6-67.eps",path=("../Daten//Kap_6//Kap_6.2//Abbildungen//Rezeptur//"),plot=last_plot(),device="eps",height=8,width=9.5,unit=c("cm"),dpi=1200)36 Abb. 6-68
# Daten einlesen
data<-read.csv("../Daten//Kap_6//Kap_6.2//Grundlagen//Datengrundlage//Daten_BB_Ker_vollständigMW_chemGruppen_bearb.csv")
# Diagramm erstellen
ggplot(data)+geom_bar(aes(fill=Modell4, x=Haus),position = position_dodge2(preserve = 'single',padding = 0.0),color="black")+
scale_fill_manual(values = c("Rezeptur 1" = "cyan4", "Rezeptur 2a" = "grey","Rezeptur 2b"="burlywood","Rezeptur 3a"="brown","Rezeptur 3b"="red", "Rezeptur 4"="black"))+ # Manuelle Definition der Farbe der Balken
geom_text(aes(mapping=Modell4,x=Haus,label=..count..),stat='count',position=position_dodge(1),vjust=-0.3,size=2.75)+theme(axis.text.x =element_text(angle = 90, vjust = 0.5, hjust=1))+ # Manuelles Hinzufügen der Zahlenwerte als Text oberhalb der Balken
xlab("Kontexte - Fokus Häuser")+ylab("Probenanzahl")+ # Manuelle Achsenbeschriftung
scale_y_continuous(breaks=seq(0,300,10),expand=c(0,0),limits=c(0,65))+ # Manuelle Definition der Y-Achse
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
theme(axis.text.x = element_text(angle = 90, vjust = 0.3,hjust=0.3)) # Vertikale Darstellung der X-Achsenbeschriftung
# Export des Diagramms
ggsave("Abb.6-68.eps",path=("../Daten//Kap_6//Kap_6.2//Abbildungen//Rezeptur//"),plot=last_plot(),device="eps",height=10,width=15.3,unit=c("cm"),dpi=1200)37 Abb. 6-70
# Daten einlesen und filtern
data<-read.csv("../Daten//Kap_6//Kap_6.2//Grundlagen//Datengrundlage//Daten_BB_Ker_vollständigMW_chemGruppen_bearb.csv")
data<-filter(data, Haus=="Gruben")
# Formatieren der Kontextnummern
data$Gruben <- ifelse(data$Gruben %in% c("2","12", "17", "29","45", "48", "79"),
sprintf("%03d", as.numeric(data$Gruben)),
data$Gruben)
# Diagramm erstellen
ggplot(data)+geom_bar(aes(fill=Modell4, x=Gruben),position = position_dodge2(preserve = 'single',padding = 0.0),color="black")+
scale_fill_manual(values = c("Rezeptur 1" = "cyan4", "Rezeptur 2a" = "grey","Rezeptur 2b"="burlywood","Rezeptur 3a"="brown","Rezeptur 3b"="red", "Rezeptur 4"="black"))+ # Manuelle Definition der Farbe der Balken
geom_text(aes(mapping=Modell4, x=Gruben,label=..count..),stat='count',position=position_dodge(1),vjust=-0.3,size=2.75)+ # Manuelles Hinzufügen der Zahlenwerte als Text oberhalb der Balken
xlab("Kontexte - Fokus Gruben")+ylab("Probenanzahl")+ # Manuelle Achsenbeschriftung
scale_y_continuous(breaks=seq(0,300,5),expand=c(0,0), limits=c(0,20))+ # Manuelle Definition der Y-Achse
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
theme(axis.text.x = element_text(angle = 90, vjust = 0.3,hjust=0.3)) # Vertikale Darstellung der X-Achsenbeschriftung
# Export des Diagramms
ggsave("Abb.6-70.eps",path=("../Daten//Kap_6//Kap_6.2//Abbildungen//Rezeptur//"),plot=last_plot(),device="eps",height=8,width=9,unit=c("cm"),dpi=1200)38 Abb. 6-71
# Daten einlesen und filtern
data3<-read.csv("../Daten//Kap_6//Kap_6.2//Grundlagen//Datengrundlage//Daten_BB_Ker_vollständigMW_chemGruppen_bearb.csv")
data2<-data3[,c(24,29,30,34,77),]
# Formatieren der Kontextnummern
data2$HausuGruben <- ifelse(grepl("^\\d+$", data2$HausuGruben ) & as.numeric(data2$HausuGruben ) %in% c(2, 12,17, 29,45, 48, 79),
sprintf("%03d", as.numeric(data2$HausuGruben )),
data2$HausuGruben )
# Gruppieren nach Kategorien und zählen der Häufigkeiten
data<-data2 %>% dplyr::count(HausuGruben,Modell4,Kultur,Knochen)
# Definieren der Darstellungsreihenfolge
data$HausuGruben<-factor(data$HausuGruben,levels=c("Haus 01","Haus 02","Haus 03","Haus 06","Haus 08","Haus 08/16","Haus 10","Haus 11","Haus 12","Haus 15","Haus 16","Haus 17", "002","012","029","045","048","079","575","579","715","801","807","Unbekannt"))
# Diagramm erstellen
ggplot(data,aes(x=Modell4,y=HausuGruben,color=Knochen,shape=Kultur))+
geom_point(aes(shape=Kultur),size=2)+scale_shape_manual(values=c(17,1))+ # Manuelle Definition der Form der Symbole
scale_color_manual(name="Knochen",values=c("black","wheat4"))+ # Manuelle Definition der Farbe der Symbole
xlab("Chemische Rezepturen")+ylab("Kontexte")+ # 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.3,hjust=0.3)) # Vertikale Darstellung der X-Achsenbeschriftung
# Export des Diagramms
ggsave("Abb.6-71.eps",path=("../Daten//Kap_6//Kap_6.2//Abbildungen//Rezeptur//"),plot=last_plot(),device="eps",height=14,width=7,unit=c("cm"),dpi=1200)39 Streudiagramme makroskopischer Warengruppen
# Daten einlesen
data<-read.csv("../Daten//Kap_6//Kap_6.2//Grundlagen//Datengrundlage//Daten_BB_Ker_vollständigMW_chemGruppen_bearb.csv")
# Diagramme erstellen
Gruppe.Magerung_HE_CaO_Fe2O3<-ggplot(data, aes(x=CaO,y=Fe2O3, color=Gruppe.Magerung, shape=Kultur))+
geom_point(aes(shape=Kultur),size=2)+scale_shape_manual(values=c(17,19))+ # Manuelle Definition der Form der Symbole
scale_color_manual(name="Gruppe.Magerung",values=c("black","black","black","black","black","black","orange","orange","orange","orange","orange","orange","orange","orange","orange","orange","orange","orange","orange","orange","orange","orange","orange","orange","orange","orange","blue","blue","blue","cyan4","grey","brown","brown","brown","red","yellowgreen","yellowgreen","yellowgreen","yellowgreen","yellowgreen","purple","purple","purple","purple"))+ # Manuelle Definition der Farbe der Symbole
xlab("CaO in %")+ylab("Fe2O3 in %")+ # 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
Gruppe.Magerung_HE_CaO_P2O5<-ggplot(data, aes(x=CaO,y=P2O5, color=Gruppe.Magerung, shape=Kultur))+
geom_point(aes(shape=Kultur),size=2)+scale_shape_manual(values=c(17,19))+
scale_color_manual(name="Gruppe.Magerung",values=c("black","black","black","black","black","black","orange","orange","orange","orange","orange","orange","orange","orange","orange","orange","orange","orange","orange","orange","orange","orange","orange","orange","orange","orange","blue","blue","blue","cyan4","grey","brown","brown","brown","red","yellowgreen","yellowgreen","yellowgreen","yellowgreen","yellowgreen","purple","purple","purple","purple"))+
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"))
Gruppe.Magerung_HE_Al2O3_SiO2<-ggplot(data, aes(x=Al2O3,y=SiO2, color=Gruppe.Magerung, shape=Kultur))+
geom_point(aes(shape=Kultur),size=2)+scale_shape_manual(values=c(17,19))+
scale_color_manual(name="Gruppe.Magerung",values=c("black","black","black","black","black","black","orange","orange","orange","orange","orange","orange","orange","orange","orange","orange","orange","orange","orange","orange","orange","orange","orange","orange","orange","orange","blue","blue","blue","cyan4","grey","brown","brown","brown","red","yellowgreen","yellowgreen","yellowgreen","yellowgreen","yellowgreen","purple","purple","purple","purple"))+
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"))
Gruppe.Magerung_HE_TiO2_K2O<-ggplot(data, aes(x=TiO2,y=K2O, color=Gruppe.Magerung, shape=Kultur))+
geom_point(aes(shape=Kultur),size=2)+scale_shape_manual(values=c(17,19))+
scale_color_manual(name="Gruppe.Magerung",values=c("black","black","black","black","black","black","orange","orange","orange","orange","orange","orange","orange","orange","orange","orange","orange","orange","orange","orange","orange","orange","orange","orange","orange","orange","blue","blue","blue","cyan4","grey","brown","brown","brown","red","yellowgreen","yellowgreen","yellowgreen","yellowgreen","yellowgreen","purple","purple","purple","purple"))+
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"))
# Kombination der Diagramme
ggarrange(Gruppe.Magerung_HE_Al2O3_SiO2,Gruppe.Magerung_HE_CaO_P2O5,Gruppe.Magerung_HE_CaO_Fe2O3,Gruppe.Magerung_HE_TiO2_K2O,ncol=2,nrow=2,align = "hv",common.legend=TRUE)+theme(legend.position="bottom")
40 Abb. 6-72
# Daten einlesen
data<-read.csv("../Daten//Kap_6//Kap_6.2//Grundlagen//Datengrundlage//Daten_BB_Ker_vollständigMW_chemGruppen_bearb.csv")
# Diagramm erstellen
ggplot(data)+geom_bar(aes(fill=Modell4, x=Gruppe.Magerung),position = position_dodge2(preserve = 'single',padding = 0.0),color="black")+
scale_fill_manual(values = c("Rezeptur 1" = "cyan4", "Rezeptur 2a" = "grey","Rezeptur 2b"="burlywood","Rezeptur 3a"="brown","Rezeptur 3b"="red", "Rezeptur 4"="black"))+ # Manuelle Definition der Farbe der Balken
geom_text(aes(mapping=Modell4, x=Gruppe.Magerung,label=..count..),stat='count',position=position_dodge(1),vjust=-0.3,size=2.75)+ # Manuelles Hinzufügen der Zahlenwerte als Text oberhalb der Balken
xlab("Warenart")+ylab("Probenanzahl")+ # Manuelle Achsenbeschriftung
scale_y_continuous(breaks=seq(0,32,5),expand=c(0,0), limits=c(0,32))+ # Manuelle Definition der Y-Achse
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
theme(axis.text.x = element_text(angle = 90, vjust = 0.3,hjust=0.3)) # Vertikale Darstellung der X-Achsenbeschriftung
# Export des Diagramms
ggsave("Abb.6-72.eps",path=("../Daten//Kap_6//Kap_6.2//Abbildungen//Rezeptur//"),plot=last_plot(),device="eps",height=11,width=15.3,unit=c("cm"),dpi=1200)41 Abb. 6-73
# Daten einlesen und filtern
data3<-read.csv("../Daten//Kap_6//Kap_6.2//Grundlagen//Datengrundlage//Daten_BB_Ker_vollständigMW_chemGruppen_bearb.csv")
data2<-data3[,c(24,34,53,77),]
# Gruppieren nach Kategorien und zählen der Häufigkeiten
data<-data2 %>% dplyr::count(Gruppe.Magerung, Modell4,Kultur,Knochen)
# Diagramm erstellen
ggplot(data, aes(x=Modell4,y=Gruppe.Magerung, color=Knochen, shape=Kultur))+
geom_point(aes(shape=Kultur),size=2)+scale_shape_manual(values=c(17,1))+ # Manuelle Definition der Form der Symbole
scale_color_manual(name="Knochen",values=c("black","wheat4"))+ # Manuelle Definition der Farbe der Symbole
xlab("Chemische Rezeptur")+ylab("Warenart")+ # 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.3,hjust=0.3)) # Vertikale Darstellung der X-Achsenbeschriftung
# Export des Diagramms
ggsave("Abb.6-73.eps",path=("../Daten//Kap_6//Kap_6.2//Abbildungen//Rezeptur//"),plot=last_plot(),device="eps",height=19,width=7,unit=c("cm"),dpi=1200)42 Abb. 6-74
Zur besseren Sichtbarkeit im Druck wurde der längste Balken (Unbestimmt/Rezeptur 1 = 84) nicht vollständig abgebildet und den Abbildungen händisch ergänzt
# Daten einlesen
data<-read.csv("../Daten//Kap_6//Kap_6.2//Grundlagen//Datengrundlage//Daten_BB_Ker_vollständigMW_chemGruppen_bearb.csv")
# Definieren der Darstellungsreihenfolge
data$Typ<-factor(data$Typ,levels=c("Eifoermiger Topf","Schale","Kumpfartiges Gefaess","Becherartiges Gefaess","Becher","Flasche","Schuessel", "Feinkeramischer Kumpf","Grobkeramischer Kumpf","Fussgefaess", "Unbestimmt"))
# Diagramm erstellen
ggplot(data)+geom_bar(aes(fill=Modell4, x=Typ),position = position_dodge2(preserve = 'single',padding = 0.0),color="black")+
scale_fill_manual(values = c("Rezeptur 1" = "cyan4", "Rezeptur 2a" = "grey","Rezeptur 2b"="burlywood","Rezeptur 3a"="brown","Rezeptur 3b"="red", "Rezeptur 4"="black"))+ # Manuelle Definition der Farbe der Balken
geom_text(aes(mapping=Modell4, x=Typ,label=..count..),stat='count',position=position_dodge(1),vjust=-0.3,hjust=-0.3,size=2.75)+ # Manuelles Hinzufügen der Zahlenwerte als Text oberhalb der Balken
xlab("Gefäßtyp")+ylab("Probenanzahl")+ # Manuelle Achsenbeschriftung
scale_y_continuous(breaks=seq(0,130,10),expand=c(0,0), limits=c(0,60))+ # Manuelle Definition der Y-Achse
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
theme(axis.text.x = element_text(angle = 90, vjust = 0.3,hjust=0.3)) # Vertikale Darstellung der X-Achsenbeschriftung
# Export des Diagramms
ggsave("Abb.6-74.eps",path=("../Daten//Kap_6//Kap_6.2//Abbildungen//Rezeptur//"),plot=last_plot(),device="eps",height=13,width=10,unit=c("cm"),dpi=1200)43 Abb. 6-75
# Daten einlesen
data<-read.csv("../Daten//Kap_6//Kap_6.2//Grundlagen//Datengrundlage//Daten_BB_Ker_vollständigMW_chemGruppen_bearb.csv")
# Definieren der Darstellungsreihenfolge
data$ZierDetail<-factor(data$ZierDetail,levels=c("21.1","21.4","21.5","21.4/5","21.5/Leiste","22.1","22.1/58.1","22.1/58.6/Leiste","58.1","58.2","58.5","58.6","58.1/2","58.1/2/Leiste","58.1/7","Leiste","19.1","21.2","21.6","21.7","21.8","21.9","21.2/29.1","21.2/29.22","21.6/29.2","21.7/29.2","21.9/29.1","21.9/29.3/29.22.1","22.1/29.20","22.1/29.20/30.3","22.1/29.20/30.31/58.1","22.1/29.23","22.1/29.27","22.2","29.1","29.2","29.22","29.23","29.27","29.31","29.38","29.55","29.1/2","29.1/3","29.2/22","Eckiges Band gefuellt mit 29.22","29.20/22","29.20/30.1/58.1","29.3/58.2","29.20/Notenkopfzier","30.1/51.1/Linien in Winkelbaendern/Notenkopfzier","Doppelt perforiert","Fingerkniffe als Winkelband","Miniaturgefaess","Unverziert"))
# Daten filtern
data1<-subset(data,Kultur %in% c("La Hoguette"))
# Diagramm erstellen
ggplot(data1)+geom_bar(aes(fill=Modell4, x=ZierDetail),position = position_dodge2(preserve = 'single',padding = 0.0),color="black")+
scale_fill_manual(values = c("Rezeptur 1" = "cyan4", "Rezeptur 2a" = "grey","Rezeptur 2b"="burlywood","Rezeptur 3a"="brown","Rezeptur 3b"="red", "Rezeptur 4"="black"))+ # Manuelle Definition der Farbe der Balken
geom_text(aes(mapping=Modell4, x=ZierDetail,label=..count..),stat='count',position=position_dodge(1),vjust=-0.3,hjust=-0.3,size=2.75)+ # Manuelles Hinzufügen der Zahlenwerte als Text oberhalb der Balken
xlab("Zier - La Hoguette")+ylab("Probenanzahl")+ # Manuelle Achsenbeschriftung
scale_y_continuous(breaks=seq(0,60,2),expand=c(0,0),limits=c(0,27))+ # Manuelle Definition der Y-Achse
scale_x_discrete(limits=rev)+ # Inverse Darstellung der Y-Achse
coord_flip()+ # Invertieren der Achsen
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 
# Export des Diagramms
ggsave("Abb.6-75.eps",path=("../Daten//Kap_6//Kap_6.2//Abbildungen//Rezeptur//"),plot=last_plot(),device="eps",height=9,width=15.3,unit=c("cm"),dpi=1200)44 Abb. 6-76
# Daten einlesen
data<-read.csv("../Daten//Kap_6//Kap_6.2//Grundlagen//Datengrundlage//Daten_BB_Ker_vollständigMW_chemGruppen_bearb.csv")
# Definieren der Darstellungsreihenfolge
data$ZierDetail<-factor(data$ZierDetail,levels=c("21.1","21.4","21.5","21.4/5","21.5/Leiste","22.1","22.1/58.1","22.1/58.6/Leiste","58.1","58.2","58.5","58.6","58.1/2","58.1/2/Leiste","58.1/7","Leiste","19.1","21.2","21.6","21.7","21.8","21.9","21.2/29.1","21.2/29.22","21.6/29.2","21.7/29.2","21.9/29.1","21.9/29.3/29.22.1","22.1/29.20","22.1/29.20/30.3","22.1/29.20/30.31/58.1","22.1/29.23","22.1/29.27","22.2","29.1","29.2","29.22","29.23","29.27","29.31","29.38","29.55","29.1/2","29.1/3","29.2/22","Eckiges Band gefuellt mit 29.22","29.20/22","29.20/30.1/58.1","29.3/58.2","29.20/Notenkopfzier","30.1/51.1/Linien in Winkelbaendern/Notenkopfzier","Doppelt perforiert","Fingerkniffe als Winkelband","Miniaturgefaess","Unverziert"))
# Daten filtern
data1<-subset(data,Kultur %in% c("LBK"))
# Diagramm erstellen
ggplot(data1)+geom_bar(aes(fill=Modell4, x=ZierDetail),position = position_dodge2(preserve = 'single',padding = 0.0),color="black")+
scale_fill_manual(values = c("Rezeptur 1" = "cyan4", "Rezeptur 2a" = "grey","Rezeptur 2b"="burlywood","Rezeptur 3a"="brown","Rezeptur 3b"="red", "Rezeptur 4"="black"))+ # Manuelle Definition der Farbe der Balken
geom_text(aes(mapping=Modell4, x=ZierDetail,label=..count..),stat='count',position=position_dodge(1),vjust=-0.3,size=2.75)+ # Manuelles Hinzufügen der Zahlenwerte als Text oberhalb der Balken
xlab("Keramikzier - Bandkeramik")+ylab("Probenanzahl")+ # Manuelle Achsenbeschriftung
scale_y_continuous(breaks=seq(0,60,2),expand=c(0,0),limits=c(0,36))+ # Manuelle Definition der Y-Achse
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
theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1)) # Vertikale Darstellung der X-Achsenbeschriftung
# Export des Diagramms
ggsave("Abb.6-76.eps",path=("../Daten//Kap_6//Kap_6.2//Abbildungen//Rezeptur//"),plot=last_plot(),device="eps",height=9,width=15.3,unit=c("cm"),dpi=1200)45 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.