Demographische Zusammensetzung der Stichprobe

In einem ersten Schritt wollen wir analysieren, wie unsere Srichprobe im Hinblick auf demographische Aspekte beschaffen ist. Wir vergleichen die erhobenen Daten dazu mit der österreichweiten Alters- und Geschlechtsverteilung. Demographische Daten Österreichs sind beispielsweise auf der Website der Statistik Austria erhältlich: www.statistik.at. Standardmäßig erhält man diese Daten als Excel-Datei. Um sie effizient in R einzulesen, greifen wir auf das Paket openxlsx zurück. Anschließend können wir die vierte Zeile (Bevölkerungsverteilung für ganz Österreich) der Excel-Datei einlesen.

R> library("openxlsx")
R> alle <- read.xlsx("bevoelkerung_2016.xlsx", sheet=1, startRow=4)[1,]

Zur leichteren Handhabung wandeln wir die Matrix alle in einen Vektor um und löschen die überflüssigen Einträge.

R> alle <- as.matrix(alle)[1,]
R> alle <- alle[3:21]
R> storage.mode(alle) <- "numeric"
R> alle

         Insgesamt      0.bis.4.Jahre      5.bis.9.Jahre 
           8700471             416123             411101 
   10.bis.14.Jahre    15.bis.19.Jahre    20.bis.24.Jahre 
            419623             462738             556773 
   25.bis.29.Jahre    30.bis.34.Jahre    35.bis.39.Jahre 
            587787             596287             556815 
   40.bis.44.Jahre    45.bis.49.Jahre    50.bis.54.Jahre 
            598003             697343             705366 
   55.bis.59.Jahre    60.bis.64.Jahre    65.bis.69.Jahre 
            603249             484296             446948 
   70.bis.74.Jahre    75.bis.79.Jahre    80.bis.84.Jahre 
            388551             339353             211412 
85.Jahre.und.älter 
            218703 

In analoger Weise extrahieren wir die beiden Vektoren mann und frau aus den weiteren Seiten der Excel-Datei.

R> mann <- read.xlsx("bevoelkerung_2016.xlsx", sheet=2, startRow=4)[1,]
R> mann <- as.matrix(mann)[1,3:21]
R> storage.mode(mann) <- "numeric"
R> mann

          Zusammen      0.bis.4.Jahre      5.bis.9.Jahre 
           4272553             214886             210666 
   10.bis.14.Jahre    15.bis.19.Jahre    20.bis.24.Jahre 
            215643             240845             286751 
   25.bis.29.Jahre    30.bis.34.Jahre    35.bis.39.Jahre 
            299605             301553             281015 
   40.bis.44.Jahre    45.bis.49.Jahre    50.bis.54.Jahre 
            297157             350308             354455 
   55.bis.59.Jahre    60.bis.64.Jahre    65.bis.69.Jahre 
            298349             233768             211306 
   70.bis.74.Jahre    75.bis.79.Jahre    80.bis.84.Jahre 
            176970             149322              83394 
85.Jahre.und.älter 
             66560 

R> frau <- read.xlsx("bevoelkerung_2016.xlsx", sheet=3, startRow=4)[1,]
R> frau <- as.matrix(frau)[1,3:21]
R> storage.mode(frau) <- "numeric"
R> frau

          Zusammen      0.bis.4.Jahre      5.bis.9.Jahre 
           4427918             201237             200435 
   10.bis.14.Jahre    15.bis.19.Jahre    20.bis.24.Jahre 
            203980             221893             270022 
   25.bis.29.Jahre    30.bis.34.Jahre    35.bis.39.Jahre 
            288182             294734             275800 
   40.bis.44.Jahre    45.bis.49.Jahre    50.bis.54.Jahre 
            300846             347035             350911 
   55.bis.59.Jahre    60.bis.64.Jahre    65.bis.69.Jahre 
            304900             250528             235642 
   70.bis.74.Jahre    75.bis.79.Jahre    80.bis.84.Jahre 
            211581             190031             128018 
85.Jahre.und.älter 
            152143 

Durch Division mit dem ersten Eintrag der jeweiligen Vektoren erhalten wir prozentuelle Werte für jede Altersklasse. Diese prozentuellen Werte nutzen wir dann zur Erstellung eines Histogramms um einen ersten Überblick über die benötigte Altersverteilung der Stichprobe zu erhalten. Der erste Eintrag des Vektors darf dabei nicht in das Histogramm mit aufgenommen werden, da er die gesamte Bevölkerungszahl, also keine Altersgruppe, darstellt.

R> pa <- alle/alle[1]
R> pm <- mann/mann[1]
R> pf <- frau/frau[1]
R> 
R> barplot(pa[-1])

In unserem Datensatz ist das Alter nicht in Kategorien unterteilt, sondern als ganzzahliger Wert angegeben. Um unsere Daten mit der österreichweiten Bevölkerungsverteilung zu vergleichen, müssen wir somit unsere Daten in analoge Kategorien einteilen. Mithilfe der Funktion seq() können wir einfach und schnell einen Vektor erstellen, der die Grenzen der Altersklassen enthält. Anschließend erstellen wir mit der Funktion cut() eine neue Variable alterskat in unserem Datensatz.

R> intervall.breaks <- c(seq(0, 85, by=5), Inf)
R> wegwerf$alterskat <- cut(wegwerf$F12.alter, breaks=intervall.breaks, right=FALSE)
R> table(wegwerf$alterskat)

   [0,5)   [5,10)  [10,15)  [15,20)  [20,25)  [25,30)  [30,35)  [35,40) 
       0        0        0        8      103       76       42       17 
 [40,45)  [45,50)  [50,55)  [55,60)  [60,65)  [65,70)  [70,75)  [75,80) 
      16       26       24       32       17        2        3       11 
 [80,85) [85,Inf) 
       3        1 

Um unsere Stichprobe mit der österreichweiten Altersverteilung vergleichen zu können, greifen wir wieder auf die prozentuellen Werte zurück. Wir dividieren alle Einträge in alterskat also mit der Gesamtanzahl aller Personen, die an der Umfrage teilgenommen haben. Anschließend vergleichen wir die Histogramme der österreichweiten Verteilung und der unserer Stichprobe.

R> paw <- table(wegwerf$alterskat)/nrow(wegwerf)
R> par(mfrow=c(2,1))
R> barplot(pa[-1])
R> barplot(paw)

Wir erkennen, dass ein deutlicher Unterschied in den Verteilungen zu bestehen scheint. Die Unterschiede sind jedoch einfach zu erklären und ergeben bei näherer Betrachtung Sinn. Beispielsweise fehlt bei uns die Gruppe der unter 15 Jährigen komplett. Egal in welcher Form die Befragung durchgeführt wurde, ist es unwahrscheinlich, dass Jugendliche unter 15 Jahren Auskunft über das Wegwerfverhalten im Haushalt geben können bzw. wollen. Außerdem ist davon auszugehen, dass viele der Befragten aus dem Umfeld der Studenten/innen der Lehrveranstaltung kommen. Somit lässt sich auch der Modus (= Kategorie \(\left[ 20, 25 \right)\)) und die höheren Häufigkeiten in den darauffolgenden Kategorien erklären.

Zusammenfassend lässt sich sagen, dass durch unserer Stichprobe vermutlich nicht auf das österreichweite Wegwerfverhalten geschlossen werden kann. Um tiefergehende Aussagen zu treffen, müsste der Fragebogen beispielsweise noch die Anzahl und das Alter der übrigen Personen im Haushalt abfragen und die Befragungen in einem unverfälschteren Umfeld durchgeführt werden.

Als nächstes widmen wir uns der Fragestellung nach der Geschlechterverteilung in unserer Stichprobe.

R> gtab <- table(wegwerf$F13.geschlecht)
R> gtab

  m   w 
174 207 

R> gtab[1]/sum(gtab) # Anteil an Männern in unserer Stichprobe

        m 
0.4566929 

R> mann[1]/alle[1] # Anteil an Männern in der gesamten Bevölkerung

 Zusammen 
0.4910715 

Wir erkennen, dass der Anteil an Männern in unserer Stichprobe etwas geringer ist als in der gesamten Bevölkerung. Wir wollen nun testen, ob dieser Unterschied auch signifikant ist und verwenden dazu die Funktion prop.test().

R> prop.test(x=gtab[1], n=sum(gtab), p=mann[1]/alle[1])

    1-sample proportions test with continuity correction

data:  gtab[1] out of sum(gtab), null probability mann[1]/alle[1]
X-squared = 1.6668, df = 1, p-value = 0.1967
alternative hypothesis: true p is not equal to 0.4910715
95 percent confidence interval:
 0.4060685 0.5082045
sample estimates:
        p 
0.4566929 

Da der p-Wert weit über \(\alpha = 0.05\) liegt, ist dieser Unterschied als nicht signifikant einzustufen und wir behalten die Nullhypothese (der Anteil an Männern bzw. Frauen ist gleich) bei.

Was wird wie häufig weggeworfen und warum?

Zunächst wollen wir uns der Analyse der Antworten auf Frage 1 (“Welche Lebensmittel werden bei Ihnen am häufigsten weggeworfen?”) widmen.

R> was <- sapply(wegwerf[,1:5], table)
R> was

  F1a.obst F1b.milch F1c.suesswaren F1d.brot F1e.fleisch
j      252       138             12      161          28
n      129       243            369      220         353

Wir erkennen, dass beispielsweise Süßwaren oder Fleisch scheinbar viel seltener weggeworfen werden als Obst. Wie relevant diese Unterschiede sind, wollen wir mithilfe eines Mosaikdiagramms beurteilen.

R> par(mfrow=c(1,1))
R> mosaicplot(t(was), shade=TRUE)

Ein betragsmäßig hoher Wert der standardisierten Residuen entspricht hier einer Relevanz für diese Kategorie. Also scheinen Süßwaren und Fleisch tatsächlich weniger oft weggeworfen zu werden als zum Beispiel Obst.

Wir möchten nun rein deskriptiv betrachten, wieviel der eingekauften Lebensmittel tatsächich konsumiert wird. Dazu erstellen wir ein Histogramm der Antworten auf Frage zwei. Man beachte hier die Codierung: 1=100%, 2=75%, 3=50% und 4=25%.

R> barplot(table(wegwerf$F2.wieviel))

Es lässt sich sagen, dass in etwa die Hälfte aller Personen angaben 100% bzw. 75% des Gekauften zu konsumieren. Man sollte hier jedoch beachten, dass nur diese 4 Prozentsätze mögliche Antworten waren und keine Option auf einen selbst gewählten Prozentsatz bestand. Daher ist Antwortmöglichkeit 1 (100%) vermutlich eher als “annähernd 100%” zu verstehen. Hier gäbe es die Möglichkeit, am Fragebogen nach einem konkreten Prozentsatz oder einer anderen Visualisierung zu fragen anstatt Antworten vorzugeben.

Analog zu Frage eins möchten wir nun Frage drei analysieren (“warum wird etwas weggeworfen?”). Dazu erstellen wir wieder ein Mosaikdiagramm. Die Antworten auf diese Frage wurden folgendermaßen codiert: 1=“trifft voll zu”, 2=“trifft zu”, 3=“trifft eher nicht zu” und 4=“trifft überhaupt nicht zu”.

R> warum <- sapply(wegwerf[,8:11], table)
R> warum

  F3a.ablauf F3b.geschmack F3c.aussehenanders F3d.keineverwendung
1         58           203                 51                  16
2         94           128                113                  40
3        116            36                152                  80
4        113            14                 65                 245

R> mosaicplot(t(warum), shade=TRUE)

Für das Ablaufsdatum oder das veränderte Aussehen der Produkte lässt sich keine deutliche Tendenz für oder gegen die Aussage ablesen. Ganz anders verhält es sich mit der Rechtfertigung des Wegwerfens durch veränderten Geschmack. Hier ist eine Tendenz zur Zustimmung abzulesen. Außerdem scheint “keine weitere Verwendung” kein vorherrschender Grund für das Wegwerfen zu sein, da sich hier eine Tendenz zu Ablehnung feststellen lässt.

Welche Merkmale sind beim Kauf von Lebensmitteln entscheidend?

Eine etwas genauere Analyse wollen wir nun mit den Antworten auf Frage sechs (“Wie wichtig sind Ihnen die folgenden Merkmale beim Kauf von Lebensmitteln?”) durchführen. Die Codierung der einzelnen Antwortmöglichkeiten lautet wie folgt: 1=“sehr wichtig”, 2=“wichtig”, 3=“weniger wichtig” und 4=“unbedeutend”. Niedrige Werte entsprechen also einer höheren Zustimmung.

R> merkmale <- as.matrix(wegwerf[,14:20])
R> summary(merkmale)

  F6a.aussehen      F6b.bio       F6c.frische     F6d.herkunft  
 Min.   :1.000   Min.   :1.000   Min.   :1.000   Min.   :1.000  
 1st Qu.:2.000   1st Qu.:2.000   1st Qu.:1.000   1st Qu.:1.000  
 Median :2.000   Median :2.000   Median :1.000   Median :2.000  
 Mean   :2.047   Mean   :2.144   Mean   :1.499   Mean   :1.882  
 3rd Qu.:2.000   3rd Qu.:3.000   3rd Qu.:2.000   3rd Qu.:2.000  
 Max.   :4.000   Max.   :4.000   Max.   :4.000   Max.   :4.000  
   F6e.preis     F6f.qualitaet    F6g.vielfalt  
 Min.   :1.000   Min.   :1.000   Min.   :1.000  
 1st Qu.:1.000   1st Qu.:1.000   1st Qu.:2.000  
 Median :2.000   Median :1.000   Median :3.000  
 Mean   :1.992   Mean   :1.501   Mean   :2.507  
 3rd Qu.:3.000   3rd Qu.:2.000   3rd Qu.:3.000  
 Max.   :4.000   Max.   :3.000   Max.   :4.000  

Zunächst führen wir eine Hauptkomponentenanalyse (Principal Component Analysis - PCA) der 7 Variablen durch.

R> merkmal.pca <- prcomp(merkmale)
R> summary(merkmal.pca)

Importance of components:
                          PC1    PC2    PC3    PC4     PC5     PC6     PC7
Standard deviation     1.1500 0.9054 0.7067 0.6852 0.59623 0.56830 0.43696
Proportion of Variance 0.3322 0.2059 0.1255 0.1180 0.08931 0.08114 0.04797
Cumulative Proportion  0.3322 0.5382 0.6636 0.7816 0.87090 0.95203 1.00000

Die ersten beiden Hauptkomponenten beschreiben bereits 53,82% der Varianz. Mittels eines Biplots dieser beiden Hauptkomponenten können wir visualisieren, was diese beiden Hauptkomponenten in etwa repräsentieren.

R> biplot(merkmal.pca, col=c("grey","darkred"), choices=c(1,2))

Die grauen Zahlen im Hintrgrund markieren lediglich die einzelnen Beobachtungen und sind für uns daher nicht von Interesse. Die Hauptkomponente PC1 (horizontale Richtung) zeigt einen (betragsmäßig) hohen Anteil von “Herkunft” und “BIO-Produkte” als Merkmale. Hohe Zustimmung zum einen Merkmal korreliert also scheinbar mit Zustimmung im anderen Merkmal und somit macht es Sinn diese beiden Merkmale in einer Hauptkomponente zusammenzufassen.

Nun wollen wir die Merkmale mithilfe einer Clusteranalyse in Gruppen einteilen. Dazu benötigen wir die Funktion stepcclust() aus dem Paket flexclust. Da es sich um eine stochastische Prozedur handelt, setzen wir einen beliebigen seed um unsere Analyse leicht reproduzierbar zu halten.

R> library("flexclust")

Warning: package 'flexclust' was built under R version 3.5.3

Loading required package: grid

Loading required package: lattice

Loading required package: modeltools

Loading required package: stats4

R> set.seed(2401)
R> merkmal.k28 <- stepcclust(merkmale, k=2:8, nrep=10)

2 : * * * * * * * * * *
3 : * * * * * * * * * *
4 : * * * * * * * * * *
5 : * * * * * * * * * *
6 : * * * * * * * * * *
7 : * * * * * * * * * *
8 : * * * * * * * * * *

R> plot(merkmal.k28)

Im Plot sehen wir die Summe der Abstände vom Clusterzentrum innerhalb jedes Clusters für eine Einteilung in 1 bis 8 Cluster. Es ist klar, dass die Einteilung in mehr Cluster zu einer kleineren Summe der Abstände zum jeweiligen Clusterzuentrum führt. Es gibt keine Clusteranzahl, die zu einer auffällig hohen Reduktion der Summe führt, daher wählen wir eine Einteilung in 4 Cluster.

R> merkmal.k4 <- merkmal.k28[["4"]]
R> barchart(merkmal.k4, shade=TRUE)

In obigem Balkendiagramm können wir ablesen, welche Merkmale in den einzelnen Clustern eine tendenziell hohe Zustimmung haben. So findet sich im vierten Cluster eine hohe Zustimmung in den Merkmalen “BIO-Produkte” und “Herkunft”, was in etwa der ersten Hauptkomponente in vorhergehender Analyse entspricht. Diese Zugehörigkeit werden wir im folgenden Plot visualisieren.

R> plot(merkmal.k4, data=merkmale, project=merkmal.pca); projAxes(merkmal.pca)

Hier zeigt sich ein, für Umfragen häufiges Bild. Die 4 Cluster entsprechen in etwa den 4 Bereichen, die durch die Vorzeichen der beiden ersten Hauptkomponenten gebildet werden. Cluster 1 entspricht einem negativen Vorzeichen von PC2, Cluster 2 entspricht einem positiven Vorzeichen von PC1, Cluster 3 entspricht einem positiven Vorzeichen von PC2 und Cluster 4 entspricht einem negativen Vorzeichen von PC1.

Gibt es Unterschiede in den soziodemographischen Daten?

Wir wollen nun die soziodemographischen Unterschiede (Fragen 10 - 13 ) betrachten. Dazu betrachten wir einmal mehr die Zusammenfassung der erhobenen Daten zu dieser Frage.

R> summary(wegwerf[,27:30])

  F10.haushalt     F11.schule      F12.alter     F13.geschlecht
 Min.   :1.000   Min.   :1.000   Min.   :16.00   m:174         
 1st Qu.:2.000   1st Qu.:5.000   1st Qu.:24.00   w:207         
 Median :2.000   Median :5.000   Median :30.00                 
 Mean   :2.394   Mean   :5.446   Mean   :36.72                 
 3rd Qu.:3.000   3rd Qu.:7.000   3rd Qu.:49.00                 
 Max.   :6.000   Max.   :7.000   Max.   :88.00                 

Durch die Codierung wird die Variable F11.schule wie eine numerische variable behandelt. Es handelt sich aber eigentlich um Faktoren, deshalb wandeln wir diese Daten, gemäß der Codierung (1=“Pflichtschule”, 2=“Poly”, 3=“Lehre”, 4=“Meister”, 5=“AHS/BHS”, 6=“Kolleg”, 7=“Uni”), um.

R> wegwerf$F11.schule <- factor(wegwerf$F11.schule, 
+                              labels=c("Pflichtschule", "Poly", "Lehre", 
+                                       "Meister", "AHS/BHS", "Kolleg", "Uni"))
R> summary(wegwerf[,27:30])

  F10.haushalt           F11.schule    F12.alter     F13.geschlecht
 Min.   :1.000   Pflichtschule: 17   Min.   :16.00   m:174         
 1st Qu.:2.000   Poly         :  4   1st Qu.:24.00   w:207         
 Median :2.000   Lehre        : 54   Median :30.00                 
 Mean   :2.394   Meister      : 11   Mean   :36.72                 
 3rd Qu.:3.000   AHS/BHS      :106   3rd Qu.:49.00                 
 Max.   :6.000   Kolleg       :  9   Max.   :88.00                 
                 Uni          :180                                 

Nun haben unsere Daten eine passende Formatierung und wir starten mit der Frage, ob die Haushaltsgröße einen Einfluss auf die Gruppenzugehörigkeit hat.

R> clus4 <- clusters(merkmal.k4)
R> boxplot(wegwerf$F10.haushalt~clus4)

Im Boxplot können wir keine wirkliche Tendenz feststellen, da der Median und das dritte Quartil für alle 4 Cluster übereinstimmen.

Wir benützen nun wieder ein Mosaikdiagramm um Clusterzugehörigkeiten in den Antworten zu Frage elf (höchste abgeschlossene Bildungseinrichtung) zu identifizieren.

R> mosaicplot(table(wegwerf$F11.schule, clus4), shade=TRUE)

Auch hier fällt es sehr schwer Tendenzen zu erkennen. Lediglich “Poly” hätte eine starke Tendenz zu Cluster 3 und 4, ist aber aufgrund der geringen Stichprobenzahl (nur 4 Personen) nicht sehr aussagekräftig.

Doch wie sieht die Verteilung der Cluster im Bezug auf das Alter aus?

R> boxplot(wegwerf$F12.alter~clus4)

Im Boxplot fällt auf, dass Cluster 4 einer tendenziell jüngeren Zielgruppe entspricht. Daraus können wir schließen, dass junge Menschen Kaufentscheidungen tendenziell eher an die Herkunft und an biologische Erzeugung der Waren knüpfen.

R> mosaicplot(table(wegwerf$F13.geschlecht, clus4), shade=TRUE)

Aus dem Mosaikdiagramm der Clustereinteilung nach Geschlechtern lassen sich keine aussagekräftigen Schlüsse ziehen. Hier scheint ungefähr eine Gleichverteilung der Geschlechter auf die 4 Cluster zu bestehen.