Statistik in der Archaeologie (2020): Beispiel-Skripte fertig fuer das Arbeiten mit dem R-Commander (Teil 2/4: Fallstudien)
Frank Siegmund
2020-08-05
Technisches Vorab: Sollte es beim Ausfuehren dieser Datei zu Fehlermeldungen kommen, fuehren Sie die drei Fallsudien (zu drei unterschiedlichen Datensaetzen) bitte separat aus.
Kap. 25.3: Typologie merowingerzeitlicher Saxe
Beispiel einer Typologie, die wesentlich auf der Metrik einer archaeologischen Fundgruppe basiert, wobei die Abgrenzung zwischen den einzelnen Typen an “natuerlichen Klassen” wie auch an mitgefundenen Leittypen festgemacht wird. Ein aehnliches Vorgehen ist z.B. auch fuer Keramikformen moeglich.
Arbeitsverzeichnis setzen, Daten einlesen:
> setwd("D:/RData")
> #
> SaxeNRh <- readSPSS("D:/RData/8_SaxeNRh.sav", rownames=FALSE,
+ stringsAsFactors=TRUE, tolower=FALSE)Abb. 102, einfaches Streuungsdiagramm Gesamtlaenge vs. Klingenbreite, mit eingespiegelter Glaettungskurve:
> scatterplot(breit~lang, regLine=FALSE,
+ smooth=list(span=0.5, spread=FALSE),
+ boxplots=FALSE, data=SaxeNRh,
+ xlab="Gesamtlaenge, in mm",
+ ylab="Klingenbreite, in mm",
+ main="Saxe Niederrhein, n=156",
+ xlim=c(175,650),
+ ylim=c(20,60)
+ )
Nun zu Abb. 103, die eventuell etwas uebervoll wirkt und daher eher eine Arbeitsgrundlage ist denn eine Abbildung fuer eine Publikation. Die Hilfslinien und Pfeile spiegeln Grenzwerte wider, die fuer die typologische Gliederung verwendet wurden. Im ersten Schrifft muss aus “Gesamt-Laenge minus Griff-Laenge” die (typologisch relevante) Laenge der Klinge errechnet werden. Danach erfolgt das Zeichnen des Streuungsdiagramms, in das anschliessend die Hilfslinien eingezeichnet werden.
> SaxeNRh$klinge <- with(SaxeNRh, lang - griff)
> #
> scatterplot(SaxeNRh$breit~SaxeNRh$klinge | SaxeNRh$Guertel,
+ regLine=FALSE, smooth=FALSE, boxplots=FALSE,
+ xlab="Klingenlaenge in mm",
+ ylab="Klingenbreite in mm",
+ main="metrische Merkmalanalyse Saxe NRh",
+ xlim = c(175,650),
+ ylim = c(20,60),
+ cex=1.3, cex.axis=1.2, cex.lab=1.2,
+ by.groups=TRUE,
+ legend=list(coords="bottomright"), data=SaxeNRh)
> arrows(500, 21, 200, 45, col="blue", lty=2)
> arrows(400, 40, 600, 60)
> abline(v=350, h=41, col="red", lty=2)
> abline(v=250, h=33, col="red", lty=6)
Aus der Analyse dieses Bildes und weiteren Argumenten wurde eine metrisch definierte Typologie abgeleitet, die als Skript formuliert werden kann. Ziel des Skriptes ist es, hinreichend vermnessene Saxe anhand der Niederrhein-Typologie einem Typ zuzuweisen. Die Typzuweisung erfolgt Schritt fuer Schritt. Technisch wichtig ist die Konstruktion “ifelse”, wonach bei Erfuellen einer Bedingung das Eine geschieht, bei Nicht-Erfuellen dieser Bedingung das Andere.
> #
> # Saxtypologie nach Siegmund, F. (1998). Merowingerzeit am Niederrhein, S. 87-94.
> # Neu zusaetzlich der Typ "Kurzsax" nach Koch, U. (2001). Pleidelsheim, S. 61 "Code 5: bis 24 cm lg., bis 3,5 cm br."
> # Skript F. Siegmund, 1.8.2019
> #
> # Errechnen der Klingenlaenge:
> SaxeNRh$klinge <- (SaxeNRh$lang - SaxeNRh$griff)
> # Errechnen des Trennwerts:
> SaxeNRh$grenze <- with(SaxeNRh, 61 - (klinge*0.08))
> # Setzen "SaxTyp" auf 99 = nicht klassifiziert:
> SaxeNRh$SaxTyp <- 99
> #
> # Definition Langsaxe:
> SaxeNRh$SaxTyp <- ifelse(((SaxeNRh$klinge >=400)&(SaxeNRh$klinge/SaxeNRh$breit >=10)), 5, SaxeNRh$SaxTyp)
> #
> # nun Typzuweisung in Abhaengigkeit von den Laenge und Breite, zunaechst Schmal- vs. Breitsaxe:
> SaxeNRh$SaxTyp <- ifelse(((SaxeNRh$klinge <350)&(SaxeNRh$breit <41)), 2, SaxeNRh$SaxTyp)
> SaxeNRh$SaxTyp <- ifelse((SaxeNRh$SaxTyp !=5) & ((SaxeNRh$klinge >=350) | ((SaxeNRh$klinge >=250)&(SaxeNRh$breit >=33))), 3, SaxeNRh$SaxTyp)
> SaxeNRh$SaxTyp <- ifelse(((((SaxeNRh$klinge >=250) & (SaxeNRh$klinge <350)) & ((SaxeNRh$breit >=33) & (SaxeNRh$breit <41))) & (SaxeNRh$breit >SaxeNRh$grenze)), 3, SaxeNRh$SaxTyp)
> SaxeNRh$SaxTyp <- ifelse(((((SaxeNRh$klinge >=250) &( SaxeNRh$klinge <350)) & ((SaxeNRh$breit >33) & (SaxeNRh$breit <41))) & (SaxeNRh$breit <SaxeNRh$grenze)), 2, SaxeNRh$SaxTyp)
> SaxeNRh$SaxTyp <- ifelse(((SaxeNRh$SaxTyp !=5) & (SaxeNRh$griff >=145)), 3, SaxeNRh$SaxTyp)
> #
> # nun Kurzsaxe, Messer und schwere Breitsaxe
> SaxeNRh$SaxTyp <- ifelse(((SaxeNRh$klinge <240)&(SaxeNRh$breit <35)), 1, SaxeNRh$SaxTyp)
> SaxeNRh$SaxTyp <- ifelse((SaxeNRh$klinge <150), 0, SaxeNRh$SaxTyp)
> SaxeNRh$SaxTyp <- ifelse((SaxeNRh$SaxTyp ==3) & (SaxeNRh$SaxTyp !=5) & ((SaxeNRh$klinge >=365) | (SaxeNRh$breit >=50)), 4, SaxeNRh$SaxTyp)
> #
> # abschliessend: numerische Variable in Faktor konvertieren, und Namen vergeben:
> SaxeNRh <- within(SaxeNRh, {
+ SaxTyp <- factor(SaxTyp, labels=c('Kurzsax','Schmalsax','Breitsax','schw.Breitsax','Langsax','indet.')) })
> # finisErgebnis anschauen: wie viele Saxe wurden wie typisiert?
> local({
+ .Table <- with(SaxeNRh, table(SaxTyp))
+ cat("\ncounts:\n")
+ print(.Table)
+ cat("\npercentages:\n")
+ print(round(100*.Table/sum(.Table), 2))
+ })
counts:
SaxTyp
Kurzsax Schmalsax Breitsax schw.Breitsax Langsax
13 27 32 33 22
indet.
1
percentages:
SaxTyp
Kurzsax Schmalsax Breitsax schw.Breitsax Langsax
10.16 21.09 25.00 25.78 17.19
indet.
0.78 Kap. 25.4: Demografie Zwentendorf
Einlesen der Daten, Sichten, und Vorbereitungen, wie S. 322 f beschrieben:
> setwd("D:/RData")
> #
> Zwentendorf <- readSPSS("D:/RData/3_Zwentendorf.sav", rownames=FALSE,
+ stringsAsFactors=TRUE, tolower=FALSE)
> #
> # Variable "Sex" als Faktor verfuegbar machen, inkl. der Unbestimmten, unter dem Namen "SexAll":
> Zwentendorf <- within(Zwentendorf, {
+ SexAll <- Recode(Sex,
+ '1 = "Mann"; 2 = "Frau"; 0 = "indet."; NA = "indet."', as.factor=TRUE)
+ })
> #
> # Kreuztabelle:
> local({
+ .Table <- xtabs(~AlterKl+SexAll, data=Zwentendorf)
+ cat("\nFrequency table:\n")
+ print(.Table)
+ })
Frequency table:
SexAll
AlterKl Frau indet. Mann
erw. 7 29 9
f-ad 18 8 10
f-mat 21 2 32
foetal 0 37 0
Inf. I/1a 0 73 0
inf. I/1b 0 31 0
inf. I/2 0 69 0
inf. II 1 60 0
juvenil 9 12 9
s-ad 29 11 52
s-mat 25 9 12
sen 19 0 1> #
> Zwentendorf$SexAll <- with(Zwentendorf, factor(SexAll, levels=c('Mann',
+ 'Frau','indet.'), ordered=TRUE))
> # Kontrolle: erneut Kreuztabelle:
> local({
+ .Table <- xtabs(~AlterKl+SexAll, data=Zwentendorf)
+ cat("\nFrequency table:\n")
+ print(.Table)
+ })
Frequency table:
SexAll
AlterKl Mann Frau indet.
erw. 9 7 29
f-ad 10 18 8
f-mat 32 21 2
foetal 0 0 37
Inf. I/1a 0 0 73
inf. I/1b 0 0 31
inf. I/2 0 0 69
inf. II 0 1 60
juvenil 9 9 12
s-ad 52 29 11
s-mat 12 25 9
sen 1 19 0> # Umordnen der Altersklassen in die uebliche Reihenfolge:
> Zwentendorf$AlterKl <- with(Zwentendorf, factor(AlterKl, levels=c('foetal',
+ 'Inf. I/1a','inf. I/1b','inf. I/2','inf. II','juvenil','f-ad','s-ad',
+ 'f-mat','s-mat','sen','erw.'), ordered=TRUE))
> # Kontrolle: erneut Kreuztabelle:
> local({
+ .Table <- xtabs(~AlterKl+SexAll, data=Zwentendorf)
+ cat("\nFrequency table:\n")
+ print(.Table)
+ })
Frequency table:
SexAll
AlterKl Mann Frau indet.
foetal 0 0 37
Inf. I/1a 0 0 73
inf. I/1b 0 0 31
inf. I/2 0 0 69
inf. II 0 1 60
juvenil 9 9 12
f-ad 10 18 8
s-ad 52 29 11
f-mat 32 21 2
s-mat 12 25 9
sen 1 19 0
erw. 9 7 29Pruefen und Verstehung der Alterskodierung fuer infans I und infans II:
> Zwentendorf$Lebensmonate <- with(Zwentendorf, Jahre * 12 + Monate)
> #
> with(Zwentendorf, Hist(Lebensmonate, scale="frequency", breaks="Sturges",
+ col="darkgray"))
> #
> Zwentendorf <- within(Zwentendorf, {
+ LebensmonateF <- as.factor(Lebensmonate)
+ })
> # Kontrolle und eindeutiges Verstehen der Kodierung mit Kreuztabelle:
> local({
+ .Table <- xtabs(~LebensmonateF+AlterKl, data=Zwentendorf)
+ cat("\nFrequency table:\n")
+ print(.Table)
+ })
Frequency table:
AlterKl
LebensmonateF foetal Inf. I/1a inf. I/1b inf. I/2 inf. II juvenil f-ad s-ad
1 35 0 0 0 0 0 0 0
2 2 1 1 0 0 0 0 0
3 0 5 0 0 0 0 0 0
4 0 1 0 0 0 0 0 0
6 0 11 0 1 0 0 0 0
7 0 1 0 0 0 0 0 0
9 0 9 0 0 0 0 0 0
12 0 16 0 0 0 0 0 0
15 0 4 0 0 0 0 0 0
16 0 1 0 0 0 0 0 0
18 0 15 0 0 0 0 0 0
21 0 9 0 0 0 0 0 0
24 0 0 19 0 0 0 0 0
30 0 0 11 0 0 0 0 0
36 0 0 0 16 0 0 0 0
42 0 0 0 15 0 0 0 0
48 0 0 0 5 0 0 0 0
54 0 0 0 11 0 0 0 0
60 0 0 0 4 0 0 0 0
66 0 0 0 9 0 0 0 0
72 0 0 0 6 0 0 0 0
78 0 0 0 2 0 0 0 0
84 0 0 0 0 8 0 0 0
90 0 0 0 0 7 0 0 0
96 0 0 0 0 3 0 0 0
102 0 0 0 0 3 0 0 0
108 0 0 0 0 8 0 0 0
120 0 0 0 0 10 0 0 0
132 0 0 0 0 8 0 0 0
138 0 0 0 0 1 0 0 0
144 0 0 0 0 2 0 0 0
150 0 0 0 0 1 0 0 0
156 0 0 0 0 4 0 0 0
162 0 0 0 0 1 0 0 0
168 0 0 0 0 4 0 0 0
AlterKl
LebensmonateF f-mat s-mat sen erw.
1 0 0 0 0
2 0 0 0 0
3 0 0 0 0
4 0 0 0 0
6 0 0 0 0
7 0 0 0 0
9 0 0 0 0
12 0 0 0 0
15 0 0 0 0
16 0 0 0 0
18 0 0 0 0
21 0 0 0 0
24 0 0 0 0
30 0 0 0 0
36 0 0 0 0
42 0 0 0 0
48 0 0 0 0
54 0 0 0 0
60 0 0 0 0
66 0 0 0 0
72 0 0 0 0
78 0 0 0 0
84 0 0 0 0
90 0 0 0 0
96 0 0 0 0
102 0 0 0 0
108 0 0 0 0
120 0 0 0 0
132 0 0 0 0
138 0 0 0 0
144 0 0 0 0
150 0 0 0 0
156 0 0 0 0
162 0 0 0 0
168 0 0 0 0Naehere Analyse der Kinder infans I, d.h. bis einschliesslich 6 Jahre (Abb. 108)
Wegen der anthropologischen Altersbestimmungen und unseres 12er-Systems bei den Jahren wird die Klasseneinteilung des Histogramms und die Beschriftung des x-Achse auf das System mit 6 Monaten, 12 Monaten etc. eingestellt. Das geschieht durch Setzen der “breaks” = gezielte Steuerung der Klasseneinteilung mit Untergrenze, Obergrenze und Schrittweite (“by”), sowie mit “xaxp”, das die Beschriftung der x-Achse steuert (Minimalwert, Maximalwert, Anzahl Schritte dazwischen).
> infansI <- subset(Zwentendorf, subset=Lebensmonate < 84)
> #
> with(infansI, Hist(Lebensmonate, scale="frequency",
+ breaks=seq(0,84,by=6), # setzen der Unter- und Obergrenze des Histogramms und der Klassenweite
+ xaxp=c(0,84,7), # setzen der Beschriftung der x-Achse auf 1 Wert alle 12 Monate
+ col="darkgray", xlab="Lebensmonate (nur Infans I)", ylab="Anzahl"))
Alle weiteren Schritte im Kapitel Zwentendorf wurden schon anderweitig erlernt / erarbeitet, resp. ausserhalb von “R” durchgefuehrt.
Kap. 25.5: Soziale Fragestellung anhand des Graeberfeldes von Sandhofen (Mannheim), Kap.25.5
Einlesen und Aufbereiten der Daten. Der Eingangsdatensatz wird als “sh” bezeichnet.
Die der Publikation entnommenen anthropologischen Bestimmungen wurden als von/bis-Daten erfasst, d.h. eine Spalte enthaelt das geschaetzte Mindestalter, eine zweite Spalte das geschaetzte Hoechstalter. Die Daten werden Schritt fuer Schritt gesichtet und transformiert, am Ende werden die Erwachsenen - so moeglich - in das System mit 10-Jahres-Schritten eingeordnet, also mit fruehadult, spaetadult, fruehmatur, usw.
> sh <- readSPSS("D:/RData/10_Sandhofen.sav", rownames=FALSE,
+ stringsAsFactors=TRUE, tolower=FALSE)
> #
> sh$alterskl <- with(sh, 0) # Variable mit Null vorbesetzen
> sh$alterskl <- ((((sh$von + sh$bis)/2) %/%10) +2)
> #
> # nun Zahlen fuer die Kinder korrigieren:
> sh$alterskl <- ifelse(((sh$von >=0) & (sh$bis <=7)), 1, sh$alterskl)
> sh$alterskl <- ifelse(((sh$von >=7) & (sh$bis <=14)), 2, sh$alterskl)
> sh$alterskl <- ifelse(((sh$von >=14) & (sh$bis <=18)), 3, sh$alterskl)
> #
> # nun bei Alterspanne groesser gleich 20 korrigieren auf "erwachsen"
> sh$agespan <- (sh$bis - sh$von)
> sh$alterskl <- ifelse((sh$agespan >=20), 10, sh$alterskl)
> #
> # Variable zuseatzlich als Faktior ablegen:
> sh <- within(sh, {
+ f.Altersklasse <- factor(alterskl, labels=c('inf. I','inf. II','juv.','f-ad.','s-ad.',
+ 'f-mat.','s-mat.','f-sen.','s-sen.','erw.'))
+ })
> #
> # abschliessend zur Kontrolle eine Haeufigkeitstabelle:
> local({
+ .Table <- with(sh, table(f.Altersklasse))
+ cat("\ncounts:\n")
+ print(.Table)
+ cat("\npercentages:\n")
+ print(round(100*.Table/sum(.Table), 2))
+ })
counts:
f.Altersklasse
inf. I inf. II juv. f-ad. s-ad. f-mat. s-mat. f-sen. s-sen. erw.
19 15 8 27 34 21 23 21 1 84
percentages:
f.Altersklasse
inf. I inf. II juv. f-ad. s-ad. f-mat. s-mat. f-sen. s-sen. erw.
7.51 5.93 3.16 10.67 13.44 8.30 9.09 8.30 0.40 33.20 Ermitteln des AAT-Wertes der Graeber
> sh$aat <- 31 - (is.na(sh$Muenze) + is.na(sh$Anhaenger) + is.na(sh$Perlen) +
+ is.na(sh$Fibeln) + is.na(sh$Ringe) + is.na(sh$Guertel) + is.na(sh$GGH) +
+ is.na(sh$FussSchn) + is.na(sh$Geraet) + is.na(sh$Kamm) + is.na(sh$Spatha) +
+ is.na(sh$Spathagarn) + is.na(sh$Schild) + is.na(sh$Lanze) + is.na(sh$Sax) +
+ is.na(sh$Axt) + is.na(sh$Pfeilspitze) + is.na(sh$GGunverz) + is.na(sh$GGtausch) +
+ is.na(sh$Tasche) + is.na(sh$Pinzette) + is.na(sh$Schmied) + is.na(sh$Feuerstahl) +
+ is.na(sh$Reitgeschirr) + is.na(sh$Pferd) + is.na(sh$Messer) + is.na(sh$Feile) +
+ is.na(sh$Keramikgef) + is.na(sh$Glasgef) + is.na(sh$Holzgef) + is.na(sh$Bronzegef))
> #
> # zur Kontrolle ein Histogramm:
> with(sh, Hist(aat, scale="frequency", breaks="Sturges", col="darkgray"))
Errechnen des Grabwerts nach L. Joergensen (1978)
Dazu wurde zunaechst fuer alle vorkommenden Beigabengattungen ermittelt, wie oft sie vorkommen.
Das folgende Skript berechnet zunaechst fuer jede Fundgattung in jedem Fall ihren “Joergensenwert”, die neuen Variablen erhalten Namen des Schemas “j.Fundgattung”. Das Skript folgt bei den Wert-Zuweisung der Logik: wenn Variable “missing”, dann Werte-Variable = Null, wenn nicht “missing”, dann Werte-Variablen = Wert nach Joergensen
> sh$j.muenze <- ifelse((is.na(sh$Muenze)==TRUE), 0, (sh$Muenze*(281/9)))
> sh$j.anhaenger <- ifelse((is.na(sh$Anhaenger)==TRUE), 0, (sh$Anhaenger*(281/8)))
> sh$j.perlen <- ifelse((is.na(sh$Perlen)==TRUE), 0, (sh$Perlen*(281/423)))
> sh$j.fibeln <- ifelse((is.na(sh$Fibeln)==TRUE), 0, (sh$Fibeln*(281/12)))
> sh$j.ringe <- ifelse((is.na(sh$Ringe)==TRUE), 0, (sh$Ringe*(281/23)))
> sh$j.guertel <- ifelse((is.na(sh$Guertel)==TRUE), 0, (sh$Guertel*(281/81)))
> sh$j.ggh <- ifelse((is.na(sh$GGH)==TRUE), 0, (sh$GGH*(281/3)))
> sh$j.fussschn <- ifelse((is.na(sh$FussSchn)==TRUE), 0, (sh$FussSchn*(281/1)))
> sh$j.geraet <- ifelse((is.na(sh$Geraet)==TRUE), 0, (sh$Geraet*(281/23)))
> sh$j.kamm <- ifelse((is.na(sh$Kamm)==TRUE), 0, (sh$Kamm*(281/91)))
> sh$j.spatha <- ifelse((is.na(sh$Spatha)==TRUE), 0, (sh$Spatha*(281/9)))
> sh$j.spathagarn <- ifelse((is.na(sh$Spathagarn)==TRUE), 0, (sh$Spathagarn*(281/11)))
> sh$j.schild <- ifelse((is.na(sh$Schild)==TRUE), 0, (sh$Schild*(281/32)))
> sh$j.lanze <- ifelse((is.na(sh$Lanze)==TRUE), 0, (sh$Lanze*(281/28)))
> sh$j.sax <- ifelse((is.na(sh$Sax)==TRUE), 0, (sh$Sax*(281/20)))
> sh$j.axt <- ifelse((is.na(sh$Axt)==TRUE), 0, (sh$Axt*(281/3)))
> sh$j.pfeilspitze <- ifelse((is.na(sh$Pfeilspitze)==TRUE), 0, (sh$Pfeilspitze*(281/45)))
> sh$j.ggunverz <- ifelse((is.na(sh$GGunverz)==TRUE), 0, (sh$GGunverz*(281/22)))
> sh$j.ggtausch <- ifelse((is.na(sh$GGtausch)==TRUE), 0, (sh$GGtausch*(281/9)))
> sh$j.tasche <- ifelse((is.na(sh$Tasche)==TRUE), 0, (sh$Tasche*(281/8)))
> sh$j.pinzette <- ifelse((is.na(sh$Pinzette)==TRUE), 0, (sh$Pinzette*(281/3)))
> sh$j.schmied <- ifelse((is.na(sh$Schmied)==TRUE), 0, (sh$Schmied*(281/2)))
> sh$j.feuerstahl <- ifelse((is.na(sh$Feuerstahl)==TRUE), 0, (sh$Feuerstahl*(281/11)))
> sh$j.reitgeschirr <- ifelse((is.na(sh$Reitgeschirr)==TRUE), 0, (sh$Reitgeschirr*(281/11)))
> sh$j.pferd <- ifelse((is.na(sh$Pferd)==TRUE), 0, (sh$Pferd*(281/4)))
> sh$j.messer <- ifelse((is.na(sh$Messer)==TRUE), 0, (sh$Messer*(281/71)))
> sh$j.feile <- ifelse((is.na(sh$Feile)==TRUE), 0, (sh$Feile*(281/2)))
> sh$j.keramikgef <- ifelse((is.na(sh$Keramikgef)==TRUE), 0, (sh$Keramikgef*(281/122)))
> sh$j.glasgef <- ifelse((is.na(sh$Glasgef)==TRUE), 0, (sh$Glasgef*(281/25)))
> sh$j.holzgef <- ifelse((is.na(sh$Holzgef)==TRUE), 0, (sh$Holzgef*(281/4)))
> sh$j.bronzegef <- ifelse((is.na(sh$Bronzegef)==TRUE), 0, (sh$Bronzegef*(281/2)))
> #
> # nun alle Werte addieren:
> sh$joergensen <- with(sh, j.muenze + j.anhaenger + j.perlen +
+ j.fibeln + j.ringe +j.guertel + j.ggh + j.fussschn +j.geraet +
+ j.kamm + j.spatha + j.spathagarn + j.schild + j.lanze + j.sax +
+ j.axt + j.pfeilspitze + j.ggunverz + j.ggtausch + j.tasche + j.pinzette +
+ j.schmied + j.feuerstahl + j.reitgeschirr + j.pferd + j.messer + j.feile +
+ j.keramikgef + j.glasgef + j.holzgef + j.bronzegef)
> #
> # zur Kontrolle ein Histogramm:
> with(sh, Hist(joergensen, scale="frequency", breaks="Sturges",
+ col="darkgray", xlab="Grabwerte Sandhofen nach Joergensen", ylab="Anzahl Graeber"))
Besteht ein Zusammenhang zwischen den Einschaetzungen der Grabwerte nach dem System von L. Hedeager (AAT-Wert) und von L. Joergensen? Streuungsdiagramm zur Visualisierung, Rangkorrelationskoeffizient zur Quantifizierung:
> scatterplot(joergensen~aat, regLine=FALSE, smooth=FALSE, boxplots=FALSE, data=sh,
+ xlab="Grabwert AAT n. L. Hedeager",
+ ylab="Grabwert n. L. Joergensen"
+ )
> #
> rcorr.adjust(sh[,c("aat","joergensen")], type="spearman",
+ use="pairwise.complete")
Spearman correlations:
aat joergensen
aat 1.0000 0.9159
joergensen 0.9159 1.0000
Number of observations: 281
Pairwise two-sided p-values:
aat joergensen
aat <.0001
joergensen <.0001
Adjusted p-values (Holm's method)
aat joergensen
aat <.0001
joergensen <.0001 Der Zusammenhang ist stark (Korr.-koeffizient .91) und hochsiginifikant, d.h. beide Systeme liefen aehnliche Ergebnisse.