SzymonBaronQuarto

Instalacja pakietów

#options(repos = c(CRAN = "https://cran.rstudio.com"))
#install.packages("ggplot2")
#install.packages("tidyr")
#install.packages("plotly")
#install.packages("gganimate")
#install.packages("ggrepel")
#Ładowanie biblioteki ggplot2
library(ggplot2)
library(tidyr)
library(plotly)
library(gganimate)
library(ggrepel)

Wprowadzenie - zbiór danych Swiss

W tym raporcie przeanalizujemy dane demograficzne z kantonów Szwajcarii, które zawierają informacje o wskaźnikach urodzeń, edukacji, rolnictwie, religii oraz umieralności niemowląt w okolicach 1888 roku.

Podgląd danych

head(swiss)

             Fertility Agriculture Examination Education Catholic
Courtelary        80.2        17.0          15        12     9.96
Delemont          83.1        45.1           6         9    84.84
Franches-Mnt      92.5        39.7           5         5    93.40
Moutier           85.8        36.5          12         7    33.77
Neuveville        76.9        43.5          17        15     5.16
Porrentruy        76.1        35.3           9         7    90.57
             Infant.Mortality
Courtelary               22.2
Delemont                 22.2
Franches-Mnt             20.2
Moutier                  20.3
Neuveville               20.6
Porrentruy               26.6

Wyjaśnienie nazewnictwa i analiza danych

Fertility

Współczynnik urodzeń (liczba dzieci na 1000 kobiet)

print(swiss$Fertility)

 [1] 80.2 83.1 92.5 85.8 76.9 76.1 83.8 92.4 82.4 82.9 87.1 64.1 66.9 68.9 61.7
[16] 68.3 71.7 55.7 54.3 65.1 65.5 65.0 56.6 57.4 72.5 74.2 72.0 60.5 58.3 65.4
[31] 75.5 69.3 77.3 70.5 79.4 65.0 92.2 79.3 70.4 65.7 72.7 64.4 77.6 67.6 35.0
[46] 44.7 42.8

summary(swiss$Fertility)

   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
  35.00   64.70   70.40   70.14   78.45   92.50 

cat("Najmniejszą wartość urodzeń odnotowano w kanonie", rownames(swiss)[which.min(swiss$Fertility)], "i wynosiosła ona", swiss$Fertility[which.min(swiss$Fertility)])

Najmniejszą wartość urodzeń odnotowano w kanonie V. De Geneve i wynosiosła ona 35

cat("Największą wartość urodzeń odnotowano w kanonie", rownames(swiss)[which.max(swiss$Fertility)], "i wynosiosła ona", swiss$Fertility[which.max(swiss$Fertility)])

Największą wartość urodzeń odnotowano w kanonie Franches-Mnt i wynosiosła ona 92.5

cat("Średnio odnotowywano współczynnik urodzeń na poziomie", round(mean(swiss$Fertility),1), "mediana wyniosła natomiast", median(swiss$Fertility))

Średnio odnotowywano współczynnik urodzeń na poziomie 70.1 mediana wyniosła natomiast 70.4

hist((swiss$Fertility), main = "Histogram współczynnika urodzeń", xlab = "Liczba dzieci na 1000 kobiet", ylab = "Częstotliwość", col = "lightblue")

Agriculture

Procent ludności zatrudnionej w rolnictwie

print(swiss$Agriculture)

 [1] 17.0 45.1 39.7 36.5 43.5 35.3 70.2 67.8 53.3 45.2 64.5 62.0 67.5 60.7 69.3
[16] 72.6 34.0 19.4 15.2 73.0 59.8 55.1 50.9 54.1 71.2 58.1 63.5 60.8 26.8 49.5
[31] 85.9 84.9 89.7 78.2 64.9 75.9 84.6 63.1 38.4  7.7 16.7 17.6 37.6 18.7  1.2
[46] 46.6 27.7

summary(swiss$Agriculture)

   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
   1.20   35.90   54.10   50.66   67.65   89.70 

cat("Najmniejszy procent ludności zatrudnionej w rolnictwie odnotowano w kanonie", rownames(swiss)[which.min(swiss$Agriculture)], "i wyniosił on", swiss$Agriculture[which.min(swiss$Agriculture)])

Najmniejszy procent ludności zatrudnionej w rolnictwie odnotowano w kanonie V. De Geneve i wyniosił on 1.2

cat("Największy procent ludności zatrudnionej w rolnictwie odnotowano w kanonie", rownames(swiss)[which.max(swiss$Agriculture)], "i wyniosił on", swiss$Agriculture[which.max(swiss$Agriculture)])

Największy procent ludności zatrudnionej w rolnictwie odnotowano w kanonie Herens i wyniosił on 89.7

cat("Średnio odnotowywano procent ludności zatrudnionej w rolnictwie na poziomie", round(mean(swiss$Agriculture),1), "mediana wyniosła natomiast", median(swiss$Agriculture))

Średnio odnotowywano procent ludności zatrudnionej w rolnictwie na poziomie 50.7 mediana wyniosła natomiast 54.1

hist((swiss$Agriculture), main = "Histogram zatrudnienia w rolnictwie", xlab = "Procent ludności zatrudnionej w rolnictwie", ylab = "Częstotliwość", col = "yellow", xlim = c(0,100))

Examination

Procent rekrutów, którzy przeszli test sprawności fizycznej

print(swiss$Examination)

 [1] 15  6  5 12 17  9 16 14 12 16 14 21 14 19 22 18 17 26 31 19 22 14 22 20 12
[26] 14  6 16 25 15  3  7  5 12  7  9  3 13 26 29 22 35 15 25 37 16 22

summary(swiss$Examination)

   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
   3.00   12.00   16.00   16.49   22.00   37.00 

cat("Najmniejszy procent rekrutów przechodzących test odnotowano w kanonie", rownames(swiss)[which.min(swiss$Examination)], "i wyniosła ona", swiss$Examination[which.min(swiss$Examination)])

Najmniejszy procent rekrutów przechodzących test odnotowano w kanonie Conthey i wyniosła ona 3

cat("Największy procent rekrutów przechodzących test odnotowano w kanonie", rownames(swiss)[which.max(swiss$Examination)], "i wyniosła ona", swiss$Examination[which.max(swiss$Examination)])

Największy procent rekrutów przechodzących test odnotowano w kanonie V. De Geneve i wyniosła ona 37

cat("Średnio odnotowywany procent rekrutów przechodzących test na poziomie", round(mean(swiss$Examination),1), "mediana wyniosła natomiast", median(swiss$Examination))

Średnio odnotowywany procent rekrutów przechodzących test na poziomie 16.5 mediana wyniosła natomiast 16

hist((swiss$Examination), main = "Histogram wyników egzaminu wojskowego", xlab = "Ilość rekrutów", ylab = "Częstotliwość", col = "green", ylim = c(0,14))

Education

Procent mężczyzn z wykształceniem wyższym niż podstawowe

print(swiss$Education)

 [1] 12  9  5  7 15  7  7  8  7 13  6 12  7 12  5  2  8 28 20  9 10  3 12  6  1
[26]  8  3 10 19  8  2  6  2  6  3  9  3 13 12 11 13 32  7  7 53 29 29

summary(swiss$Education)

   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
   1.00    6.00    8.00   10.98   12.00   53.00 

cat("Najmniejszy procent mężczyzn z wykształceniem wyższym odnotowano w kanonie", rownames(swiss)[which.min(swiss$Education)], "i wynosiosła ona", swiss$Education[which.min(swiss$Education)])

Najmniejszy procent mężczyzn z wykształceniem wyższym odnotowano w kanonie Oron i wynosiosła ona 1

cat("Największy procent mężczyzn z wykształceniem wyższym odnotowano w kanonie", rownames(swiss)[which.max(swiss$Education)], "i wynosiosła ona", swiss$Education[which.max(swiss$Education)])

Największy procent mężczyzn z wykształceniem wyższym odnotowano w kanonie V. De Geneve i wynosiosła ona 53

cat("Średnio odnotowywano procent mężczyzn z wykształceniem wyższym na poziomie", round(mean(swiss$Education),1), "mediana wyniosła natomiast", median(swiss$Education))

Średnio odnotowywano procent mężczyzn z wykształceniem wyższym na poziomie 11 mediana wyniosła natomiast 8

hist((swiss$Education), main = "Histogram procentu mężczyzn z wykształceniem wyższym", xlab = "Procent mężczyzn z wykształceniem wyższym niż podstawowe", ylab = "Częstotliwość", col = "purple")

Catholic

Procent populacji wyznania katolickiego

print(swiss$Catholic)

 [1]   9.96  84.84  93.40  33.77   5.16  90.57  92.85  97.16  97.67  91.38
[11]  98.61   8.52   2.27   4.43   2.82  24.20   3.30  12.11   2.15   2.84
[21]   5.23   4.52  15.14   4.20   2.40   5.23   2.56   7.72  18.46   6.10
[31]  99.71  99.68 100.00  98.96  98.22  99.06  99.46  96.83   5.62  13.79
[41]  11.22  16.92   4.97   8.65  42.34  50.43  58.33

summary(swiss$Catholic)

   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
  2.150   5.195  15.140  41.144  93.125 100.000 

cat("Najmniejszy procent populacji wyznania katolickiego odnotowano w kanonie", rownames(swiss)[which.min(swiss$Catholic)], "i wynosiosła ona", swiss$Catholic[which.min(swiss$Catholic)])

Najmniejszy procent populacji wyznania katolickiego odnotowano w kanonie La Vallee i wynosiosła ona 2.15

cat("Największy procent populacji wyznania katolickiego odnotowano w kanonie", rownames(swiss)[which.max(swiss$Catholic)], "i wynosiosła ona", swiss$Catholic[which.max(swiss$Catholic)])

Największy procent populacji wyznania katolickiego odnotowano w kanonie Herens i wynosiosła ona 100

cat("Średnio odnotowywano procent populacji wyznania katolickiego na poziomie", round(mean(swiss$Catholic),1), "mediana wyniosła natomiast", median(swiss$Catholic))

Średnio odnotowywano procent populacji wyznania katolickiego na poziomie 41.1 mediana wyniosła natomiast 15.14

hist((swiss$Catholic), main = "Histogram populacji wyznania katolickiego", xlab = "Procent populacji wyznania katolickiego", ylab = "Częstotliwość", col = "gray")

Infant.Mortality

Liczba zgonów niemowląt na 1000 żywych urodzeń

print(swiss$Infant.Mortality)

 [1] 22.2 22.2 20.2 20.3 20.6 26.6 23.6 24.9 21.0 24.4 24.5 16.5 19.1 22.7 18.7
[16] 21.2 20.0 20.2 10.8 20.0 18.0 22.4 16.7 15.3 21.0 23.8 18.0 16.3 20.9 22.5
[31] 15.1 19.8 18.3 19.4 20.2 17.8 16.3 18.1 20.3 20.5 18.9 23.0 20.0 19.5 18.0
[46] 18.2 19.3

summary(swiss$Infant.Mortality)

   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
  10.80   18.15   20.00   19.94   21.70   26.60 

cat("Najmniejszą liczbę zgonów niemowląt odnotowano w kanonie", rownames(swiss)[which.min(swiss$Infant.Mortality)], "i wynosiosła ona", swiss$Infant.Mortality[which.min(swiss$Infant.Mortality)])

Najmniejszą liczbę zgonów niemowląt odnotowano w kanonie La Vallee i wynosiosła ona 10.8

cat("Największą liczbę zgonów niemowląt odnotowano w kanonie", rownames(swiss)[which.max(swiss$Infant.Mortality)], "i wynosiosła ona", swiss$Infant.Mortality[which.max(swiss$Infant.Mortality)])

Największą liczbę zgonów niemowląt odnotowano w kanonie Porrentruy i wynosiosła ona 26.6

cat("Średnio odnotowywana liczba zgonów niemowląt to", round(mean(swiss$Infant.Mortality),1), "mediana wyniosła natomiast", median(swiss$Infant.Mortality))

Średnio odnotowywana liczba zgonów niemowląt to 19.9 mediana wyniosła natomiast 20

hist((swiss$Infant.Mortality), main = "Histogram liczby zgonów", xlab = "Liczba zgonów niemowląt na 1000 żywych urodzeń", ylab = "Częstotliwość", col = "orange")

Badanie korelacji między zmiennymi

cor_matrix <- cor(swiss)

cor_matrix_melted <- as.data.frame(as.table(cor_matrix))

ggplot(cor_matrix_melted, aes(Var1, Var2, fill = Freq)) +
  geom_tile() +
  scale_fill_gradient2(low = "blue", high = "red", mid = "white", midpoint = 0) +
  labs(title = "Mapa Cieplna Korelacji w Zbiorze Danych swiss", x = "", y = "") +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1), axis.text.y = element_text(angle = 45, hjust = 1))

Silna zależność ujemna

Fertility (Ilość urodzeń na 1000 kobiet) i Examination (Procent rekrutów, którzy przeszli test sprawności fizycznej)

cov(swiss$Examination, swiss$Fertility)/((sd(swiss$Examination))*(sd(swiss$Fertility)))

[1] -0.6458827

plot(swiss$Examination, swiss$Fertility,
     main = "Zależność między % rekrutów zdających test a ilością urodzeń",
     xlab = "Examination",
     ylab = "Fertility",
     col = "blue", pch = 19)
abline(lm(swiss$Fertility ~ swiss$Examination), col = "red")

Regresja

summary(lm(Examination ~ Fertility, data = swiss))

Call:
lm(formula = Examination ~ Fertility, data = swiss)

Residuals:
     Min       1Q   Median       3Q      Max 
-11.2794  -4.4288   0.5668   3.6106  16.1419 

Coefficients:
            Estimate Std. Error t value Pr(>|t|)    
(Intercept) 45.42289    5.17670   8.774 2.65e-11 ***
Fertility   -0.41250    0.07268  -5.675 9.45e-07 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 6.158 on 45 degrees of freedom
Multiple R-squared:  0.4172,    Adjusted R-squared:  0.4042 
F-statistic: 32.21 on 1 and 45 DF,  p-value: 9.45e-07

Wnioski: Examination: -0.4125 - dla każdej jednostkowej zmiany w ilości urodzeń na 1000 kobiet, przewidywana wartość procentowa zdanych testów zmienia się o -0.4125.

Pr(>|t|): 9.45e-07 - wartość p jest znacznie mniejsza niż 0.05, możemy stwierdzić, że współczynnik ilości urodzeń jest statystycznie istotny.

Multiple R-squared: 0.4172 - model regresji wyjaśnia 41.72% zmienności w danych dla procentu zdanych testów na podstawie ilości urodzeń.

Residual standard error: 9.642 - przeciętny błąd prognozy wynosi około 9.642.

Jak więc możemy zauważyć: Występuje silna ujemna zależność liniowa między ilością urodzeń na 1000 kobiet (Fertility), a procentem rekrutów, którzy przeszli test sprawnościowy (Examination). W miarę wzrostu ilości urodzeń na 1000 kobiet w danym regionie, zmniejsza się średni procent rekrutów, którzy przeszli test sprawnościowy.

Powody Regiony z wyższym współczynnikiem urodzeń mogą być mniej rozwinięte gospodarczo i edukacyjnie, co wpływa na wyniki edukacyjne, takie jak egzaminy wojskowe.

Silna zależność dodatnia

Education (Procent mężczyzn z wykształceniem wyższym niż podstawowe) i Examination (Ilość rekrutów, którzy przeszli test sprawności fizycznej)

cov(swiss$Examination, swiss$Education)/((sd(swiss$Examination))*(sd(swiss$Education)))

[1] 0.6984153

plot(swiss$Examination, swiss$Education,
     main = "Zależność między % zdanych testów a % wykształconych mężczyzn",
     xlab = "Examination",
     ylab = "Education",
     col = "red", pch = 19,
     ylim = c(0,35),
     xlim = c(0,35))
abline(lm(swiss$Education ~ swiss$Examination), col = "purple")

Regresja

summary(lm(Examination ~ Education, data = swiss))

Call:
lm(formula = Examination ~ Education, data = swiss)

Residuals:
     Min       1Q   Median       3Q      Max 
-10.9322  -4.7633  -0.1838   3.8907  12.4983 

Coefficients:
            Estimate Std. Error t value Pr(>|t|)    
(Intercept) 10.12748    1.28589   7.876 5.23e-10 ***
Education    0.57947    0.08852   6.546 4.81e-08 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 5.773 on 45 degrees of freedom
Multiple R-squared:  0.4878,    Adjusted R-squared:  0.4764 
F-statistic: 42.85 on 1 and 45 DF,  p-value: 4.811e-08

Wnioski: Examination: 0.5795 - dla każdej jednostkowej zmiany w procentowej ilości wykształconych mężczyzn w społeczeństwie, przewidywana zmiana procentowa w ilości zdanych testów sprawnościowych wynosi 0.5795.

Pr(>|t|) dla Examination: 4.81e-08 - wartość p jest znacznie mniejsza niż 0.05, możemy stwierdzić, że współczynnik procent wykształconych mężczyzn w społeczeństwie jest statystycznie istotny.

Multiple R-squared: 0.4878 - model regresji wyjaśnia 48.78% zmienności w danych dla zmiennej procencie zdanych testów na podstawie zmiennej procentu wykształconych mężczyzn w społeczeństwie.

Residual standard error: 5.773 - przeciętny błąd prognozy wynosi około 5.773.

Jak więc możemy zauważyć: Występuje silna dodatnia zależność liniowa między wysokim procentem mężczyzn z wykształceniem wyższym niż podstawowe (Education) a ilością rekrutów, którzy przeszli test sprawnościowy (Examination). W miarę wzrostu procentu mężczyzn z wykształceniem wyższym niż podstawowe w populacji danego regionu, zwiększa się także średnia liczba rekrutów, którzy przeszli test sprawnościowy.

Powody Wyższy poziom edukacji w regionie może skutkować lepszym przygotowaniem młodych mężczyzn do egzaminu wojskowego. Wysoko wykształcone osoby mogą lepiej radzić sobie z wymaganiami testów

Brak zależności

Education (Procent mężczyzn z wykształceniem wyższym) i Infant. Mortality (Liczba zgonów niemowląt na 1000 żywych urodzeń)

cov(swiss$Education, swiss$Infant.Mortality)/((sd(swiss$Education))*(sd(swiss$Infant.Mortality)))

[1] -0.09932185

plot(swiss$Education, swiss$Infant.Mortality,
     main = "Zależność między % wykształconych mężczyzn, a liczbą zgonów niemowląt",
     xlab = "Education",
     ylab = "Infant. Mortality",
     col = "orange", pch = 19)
abline(lm(swiss$Infant.Mortality ~ swiss$Education), col = "green")

Regresja

summary(lm(Infant.Mortality ~ Education, data = swiss))

Call:
lm(formula = Infant.Mortality ~ Education, data = swiss)

Residuals:
    Min      1Q  Median      3Q     Max 
-8.8711 -1.6021 -0.0021  1.6983  6.5377 

Coefficients:
            Estimate Std. Error t value Pr(>|t|)    
(Intercept) 20.27287    0.65273   31.06   <2e-16 ***
Education   -0.03009    0.04493   -0.67    0.507    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 2.93 on 45 degrees of freedom
Multiple R-squared:  0.009865,  Adjusted R-squared:  -0.01214 
F-statistic: 0.4483 on 1 and 45 DF,  p-value: 0.5065

Wnioski: Education: - 0.03009 - dla każdej jednostkowej zmiany w procentowej ilości mężczyzn z wykształceniem w społeczeństwie, przewidywana wartość zgonów niemowląt zmienia się o - 0.03009.

Pr(>|t|) dla Education: 0.507 - wartość p jest znacznie wyższ niż 0.05, możemy stwierdzić, że procentowa ilość mężczyzn z wykształceniem w społeczeństwie nie jest statystycznie istotna.

Multiple R-squared: 0.009865 - model regresji wyjaśnia 0.99% zmienności w danych dla zmiennej śmiertelności niemowląt na podstawie procentowej ilości mężczyzn z wykształceniem wyższym w społeczeństwie.

Residual standard error: 2.93 - przeciętny błąd prognozy wynosi około 2.93.

Jak więc możemy zauważyć: Występuje bardzo słaba ujemna zależność liniowa lub jej całkowity brak między procentem mężczyzn z wykształceniem wyższym niż podstawowe (Education) a liczbą zgonów niemowląt na 1000 żywych urodzeń (Infant. Mortality).

Powody Wbrew temu co mogłoby się wydawać - wykształcenie mężczyzn w społeczeństwie nie powinno być bezpośrednio związane z poziomem śmiertelności niemowląt w tych kantonach. Inne zmienne, takie jak dostęp do opieki zdrowotnej, poziom życia, polityka zdrowotna, mogą mieć większy wpływ na ten współczynnik

Analiza z pomocą pakietu ggplot

Wykres słupkowy z linią

Wykres przedstawia zależność pomiędzy procentową ilością osób pracujących w rolnictwie (niebieskie słupki), a procentową ilością wykształconych mężczyzn w danym kanonie (czerwona linia).

ggplot(swiss) +
  geom_bar(aes(x = rownames(swiss), y = Agriculture), stat = "identity", fill = "skyblue", alpha = 0.6) +
  geom_line(aes(x = rownames(swiss), y = Education, group = 1), color = "red", size = 1) +
  geom_point(aes(x = rownames(swiss), y = Education), color = "red", size = 2) +
  labs(title = "Osoby pracujące w rolnictwie, a % wykształconych mężczyzn", 
       x = "Kanton", 
       y = "Procent (%)") +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 90, hjust = 1),  
        axis.text.y = element_text(size = 8)) 

Widzimy, że w obszarach, gdzie niebieskie słupki osiągają niższe wartości, linia osiąga wartości wyższe, co udowadnia obliczona korelacja między zmiennymi (-0,664)

cor(swiss$Fertility, swiss$Education)

[1] -0.6637889

Wykres interaktywny

Wykres pokazujący rozrzut w poszczególnych kanonach między procentem osób wykształconych, a procentem osób pracujących w rolnictwie.

p <- ggplot(swiss, aes(x = Agriculture, y = Education, color = rownames(swiss), text = rownames(swiss))) +
  geom_point(size = 3) +
  labs(title = "Osoby pracujące w rolnictwie, a procent wykształconych mężczyzn", 
       x = "Osoby pracujące w rolnictwie (%)", 
       y = "Wykształceni mężczyźni w populacji (%)") +
  theme_minimal()

ggplotly(p, tooltip = "text")

Wykres pudełkowy

Wykres przedstawiający poziom ilości śmiertelności niemowląt z podziałem na grupy w zależności od poziomu ilości urodzeń na 1000 kobiet.

ggplot(swiss, aes(x = factor(cut(Fertility, 4)), y = Infant.Mortality)) +
  geom_boxplot(fill = "skyblue", color = "darkblue") +
  labs(title = "Boxplot śmiertelności niemowląt dla grup poziomów ilości urodzeń",
       x = "Grupy ilości urodzeń",
       y = "Śmiertelność niemowląt") +
  theme_minimal()

Wykres bąbelkowy

Wykres zależności aż 4 zmiennych. Osie X i Y ukazują zależność między ilością urodzeń na 1000 kobiet, a procentem osób pracujących w rolnictwie. Rozmiar koła wskazuje na coraz większy procent wykształconych mężczyzn w społeczeństwie, natomiast kolor na procentową liczbę wierzących w społeczeństwie.

ggplot(swiss, aes(x = Agriculture, y = Fertility, size = Education, color = Catholic)) +
  geom_point(alpha = 0.7) +
  scale_color_gradient(low = "blue", high = "red") +
  labs(title = "Wykres zależności 4 zmiennych",
       x = "% osób zatrudnionych w rolnictwie",
       y = "Ilość urodzeń na 1000 kobiet",
       size = "% wykształconych mężczyzn",
       color = "% osób wierzących") +
  theme_minimal()

cor(swiss$Fertility, swiss$Agriculture)

[1] 0.3530792

Obserwujemy słabą zależność dodatnią między ilością urodzeń na 1000 kobiet, a procentem osób pracujących w rolnictwie.

cor(swiss$Education, swiss$Agriculture)

[1] -0.6395225

Obserwujemy silną zależność ujemną między procentem osób pracujących w rolnictwie, a procentem osób wykstzałconych w społeczeństwie (im bardziej w prawo, tym mniejszy rozmiar kropek).

cor(swiss$Catholic, swiss$Fertility)

[1] 0.4636847

Obserwujemy słabą zależność dodatnią między procentem osób wierzących w społeczeństwie, a ilością urodzeń na 1000 osób.

Animacja bąbelkowa

Wykres podobny do poprzedniego, jednak tym razem w formie animacji.

swiss$Canton <- rownames(swiss)

swiss_long <- swiss %>%
  pivot_longer(cols = c(Fertility, Agriculture, Examination, Education, Catholic, Infant.Mortality),
               names_to = "Variable",
               values_to = "Value")

anim_bubble <- ggplot(swiss, aes(x = Agriculture, y = Fertility, size = Catholic, color = Education)) +
  geom_point(alpha = 0.7) +
  geom_text_repel(aes(label = Canton), size = 3, show.legend = FALSE) +
  labs(title = "Animacja zależności 4 zmiennych", 
       x = "% osób zatrudnionych w rolnictwie",
       y = "Ilość urodzeń na 1000 kobiet",
       size = "% wykształconych mężczyzn",
       color = "% osób wierzących") +
  theme_minimal() +
  transition_states(Canton, transition_length = 2, state_length = 1) +
  shadow_mark()


animate(anim_bubble)