Analiza_korespondencji_smoking_wielowymiarowy
PAKIETY
library("gplots") # wizualizacja
library("ca") #pakiet do analizy korespondencji
library("readxl") #wczytywanie danych z arkusza EXCEL
library("RColorBrewer") #kolory
library("factoextra") # wizualizacji map 2 wymiarowych
library("cabootcrs") # macierz BurtaWCZYTYWANIE DANYCH
UWAGA!!!!!
Prosze podać swoją ścieżkę do pliku!
dane <- read_excel("C:/Users/majko/OneDrive/Pulpit/DOKTORAT/2 rok/Praktyki_wielowymiarowa/Smoking_wielowymiarowe.xlsx") # tutaj prosze podać swoja ściezkę do pliku
dane<-as.data.frame(dane) # dane do fromatu data frame
head(dane,10)## Grupa_wiekowa Plec Palacy Wyksztalcenie
## 1 20 - 40 Kobieta Tak zawodowe
## 2 < 20 Mężczyzna Nie średnie
## 3 > 40 Mężczyzna Nie wyższe
## 4 > 40 Mężczyzna Nie wyższe
## 5 < 20 Mężczyzna Nie średnie
## 6 20 - 40 Mężczyzna Tak średnie
## 7 > 40 Kobieta Tak średnie
## 8 20 - 40 Kobieta Nie wyższe
## 9 20 - 40 Kobieta Tak zawodowe
## 10 20 - 40 Kobieta Nie wyższePRZYGOTOWANIE DANYCH
dane$Grupa_wiekowa<-as.factor(dane$Grupa_wiekowa)
dane$Plec<-as.factor(dane$Plec)
dane$Palacy<-as.factor(dane$Palacy)
dane$Wyksztalcenie<-as.factor(dane$Wyksztalcenie)
str(dane)## 'data.frame': 100 obs. of 4 variables:
## $ Grupa_wiekowa: Factor w/ 3 levels "< 20","> 40",..: 3 1 2 2 1 3 2 3 3 3 ...
## $ Plec : Factor w/ 2 levels "Kobieta","Mężczyzna": 1 2 2 2 2 2 1 1 1 1 ...
## $ Palacy : Factor w/ 2 levels "Nie","Tak": 2 1 1 1 1 2 2 1 2 1 ...
## $ Wyksztalcenie: Factor w/ 3 levels "średnie","wyższe",..: 3 1 2 2 1 1 1 2 3 2 ...WIZUALIZACJA DANYCH
for (i in 1:4) {
plot(dane[,i], main=colnames(dane)[i],
ylab = "Liczebności", col="darkgrey", las = 2)
}
MACIERZ BURTA
Burt<-getBurt(dane)
Burt## Grupa_wiekowa:< 20 Grupa_wiekowa:> 40
## Grupa_wiekowa:< 20 28 0
## Grupa_wiekowa:> 40 0 35
## Grupa_wiekowa:20 - 40 0 0
## Plec:Kobieta 14 14
## Plec:Mężczyzna 14 21
## Palacy:Nie 22 13
## Palacy:Tak 6 22
## Wyksztalcenie:średnie 25 13
## Wyksztalcenie:wyższe 0 11
## Wyksztalcenie:zawodowe 3 11
## Grupa_wiekowa:20 - 40 Plec:Kobieta Plec:Mężczyzna
## Grupa_wiekowa:< 20 0 14 14
## Grupa_wiekowa:> 40 0 14 21
## Grupa_wiekowa:20 - 40 37 24 13
## Plec:Kobieta 24 52 0
## Plec:Mężczyzna 13 0 48
## Palacy:Nie 14 21 28
## Palacy:Tak 23 31 20
## Wyksztalcenie:średnie 14 28 24
## Wyksztalcenie:wyższe 15 12 14
## Wyksztalcenie:zawodowe 8 12 10
## Palacy:Nie Palacy:Tak Wyksztalcenie:średnie
## Grupa_wiekowa:< 20 22 6 25
## Grupa_wiekowa:> 40 13 22 13
## Grupa_wiekowa:20 - 40 14 23 14
## Plec:Kobieta 21 31 28
## Plec:Mężczyzna 28 20 24
## Palacy:Nie 49 0 23
## Palacy:Tak 0 51 29
## Wyksztalcenie:średnie 23 29 52
## Wyksztalcenie:wyższe 25 1 0
## Wyksztalcenie:zawodowe 1 21 0
## Wyksztalcenie:wyższe Wyksztalcenie:zawodowe
## Grupa_wiekowa:< 20 0 3
## Grupa_wiekowa:> 40 11 11
## Grupa_wiekowa:20 - 40 15 8
## Plec:Kobieta 12 12
## Plec:Mężczyzna 14 10
## Palacy:Nie 25 1
## Palacy:Tak 1 21
## Wyksztalcenie:średnie 0 0
## Wyksztalcenie:wyższe 26 0
## Wyksztalcenie:zawodowe 0 22TABELE KRZYŻOWE
GRUPA WIEKOWA, PŁEĆ
n<-100
tablica1<-table(dane$Grupa_wiekowa, dane$Plec)
tablica1##
## Kobieta Mężczyzna
## < 20 14 14
## > 40 14 21
## 20 - 40 24 13chi_kwadrat1<-chisq.test(tablica1)
fi_kwadrat1<-as.numeric(chi_kwadrat1$statistic)/n
c_pearson1<-(as.numeric(chi_kwadrat1$statistic)/(as.numeric(chi_kwadrat1$statistic)+n))^0.5
chi_kwadrat1##
## Pearson's Chi-squared test
##
## data: tablica1
## X-squared = 4.5175, df = 2, p-value = 0.1045fi_kwadrat1## [1] 0.04517498c_pearson1## [1] 0.2079GRUPA WIEKOWA, PALĄCY
tablica2<-table(dane$Grupa_wiekowa, dane$Palacy)
tablica2##
## Nie Tak
## < 20 22 6
## > 40 13 22
## 20 - 40 14 23chi_kwadrat2<-chisq.test(tablica2)
fi_kwadrat2<-as.numeric(chi_kwadrat2$statistic)/n
c_pearson2<-(as.numeric(chi_kwadrat2$statistic)/(as.numeric(chi_kwadrat2$statistic)+n))^0.5
chi_kwadrat2##
## Pearson's Chi-squared test
##
## data: tablica2
## X-squared = 13.612, df = 2, p-value = 0.001107fi_kwadrat2## [1] 0.1361178c_pearson2## [1] 0.3461352GRUPA WIEKOWA, WYKSZTAŁCENIE
tablica3<-table(dane$Grupa_wiekowa, dane$Wyksztalcenie)
tablica3##
## średnie wyższe zawodowe
## < 20 25 0 3
## > 40 13 11 11
## 20 - 40 14 15 8chi_kwadrat3<-chisq.test(tablica3)
fi_kwadrat3<-as.numeric(chi_kwadrat3$statistic)/n
c_pearson3<-(as.numeric(chi_kwadrat3$statistic)/(as.numeric(chi_kwadrat3$statistic)+n))^0.5
chi_kwadrat3##
## Pearson's Chi-squared test
##
## data: tablica3
## X-squared = 24.122, df = 4, p-value = 7.551e-05fi_kwadrat3## [1] 0.2412186c_pearson3## [1] 0.4408403WYKSZTAŁCENIE, PŁEĆ
tablica4<-table( dane$Wyksztalcenie, dane$Plec)
tablica4##
## Kobieta Mężczyzna
## średnie 28 24
## wyższe 12 14
## zawodowe 12 10chi_kwadrat4<-chisq.test(tablica4)
fi_kwadrat4<-as.numeric(chi_kwadrat4$statistic)/n
c_pearson4<-(as.numeric(chi_kwadrat4$statistic)/(as.numeric(chi_kwadrat4$statistic)+n))^0.5
chi_kwadrat4##
## Pearson's Chi-squared test
##
## data: tablica4
## X-squared = 0.48413, df = 2, p-value = 0.785fi_kwadrat4## [1] 0.004841313c_pearson4## [1] 0.06941172TABELA 3 ZMIENNYCH
tablica5<-table(dane$Grupa_wiekowa, dane$Plec, dane$Palacy)
tablica5## , , = Nie
##
##
## Kobieta Mężczyzna
## < 20 9 13
## > 40 1 12
## 20 - 40 11 3
##
## , , = Tak
##
##
## Kobieta Mężczyzna
## < 20 5 1
## > 40 13 9
## 20 - 40 13 10Burt<-getBurt(dane[1:3])
Burt## Grupa_wiekowa:< 20 Grupa_wiekowa:> 40
## Grupa_wiekowa:< 20 28 0
## Grupa_wiekowa:> 40 0 35
## Grupa_wiekowa:20 - 40 0 0
## Plec:Kobieta 14 14
## Plec:Mężczyzna 14 21
## Palacy:Nie 22 13
## Palacy:Tak 6 22
## Grupa_wiekowa:20 - 40 Plec:Kobieta Plec:Mężczyzna
## Grupa_wiekowa:< 20 0 14 14
## Grupa_wiekowa:> 40 0 14 21
## Grupa_wiekowa:20 - 40 37 24 13
## Plec:Kobieta 24 52 0
## Plec:Mężczyzna 13 0 48
## Palacy:Nie 14 21 28
## Palacy:Tak 23 31 20
## Palacy:Nie Palacy:Tak
## Grupa_wiekowa:< 20 22 6
## Grupa_wiekowa:> 40 13 22
## Grupa_wiekowa:20 - 40 14 23
## Plec:Kobieta 21 31
## Plec:Mężczyzna 28 20
## Palacy:Nie 49 0
## Palacy:Tak 0 51ANALIZA KORESPONDENCJI
res.mca <-mjca(dane, lambda="indicator")PODSUMOWANIE ANALIZY KORESPONDECJI
value - wartość własna wymiaru
% - procent bezwładności
cum % - skumulowany procent
Total - łączna bezwładność
mas = mass/1000
jakość = qlt/1000
względna bezwładność = inr/1000
współrzędne wymiar 1 = (k=1)/1000
cos^2 = cor/1000
bezwładność = ctr/1000
summary(res.mca) ##
## Principal inertias (eigenvalues):
##
## dim value % cum% scree plot
## 1 0.434634 29.0 29.0 *******
## 2 0.366797 24.5 53.4 ******
## 3 0.305862 20.4 73.8 *****
## 4 0.187920 12.5 86.3 ***
## 5 0.174560 11.6 98.0 ***
## 6 0.030228 2.0 100.0
## -------- -----
## Total: 1.500000 100.0
##
##
## Columns:
## name mass qlt inr k=1 cor ctr k=2 cor
## 1 | Grupa_wiekowa:< 20 | 70 813 127 | 736 210 87 | 1245 603
## 2 | Grupa_wiekowa:> 40 | 88 166 93 | -345 64 24 | -436 102
## 3 | Grupa_wiekowa:20 - 40 | 92 196 93 | -230 31 11 | -530 165
## 4 | Plec:Kobieta | 130 90 67 | -267 77 21 | 111 13
## 5 | Plec:Mężczyzna | 120 90 73 | 289 77 23 | -120 13
## 6 | Palacy:Nie | 122 877 104 | 943 854 251 | -154 23
## 7 | Palacy:Tak | 128 877 100 | -906 854 241 | 148 23
## 8 | Wyksztalcenie:średnie | 130 686 76 | 145 23 6 | 783 664
## 9 | Wyksztalcenie:wyższe | 65 925 140 | 847 252 107 | -1384 673
## 10 | Wyksztalcenie:zawodowe | 55 522 127 | -1343 509 228 | -215 13
## ctr
## 1 296 |
## 2 45 |
## 3 71 |
## 4 4 |
## 5 5 |
## 6 8 |
## 7 8 |
## 8 217 |
## 9 339 |
## 10 7 |WYKRES OSYPISKA
fviz_screeplot(res.mca, addlabels = TRUE, ylim = c(0, 30))
MAPA
plot(res.mca)
plot(res.mca, dim=c(2,3)) 
Made by:
Majkowska Agata
agata.majkowska@phdstud.ug.edu.pl