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

WCZYTYWANIE DANYCH

UWAGA!!!!!

Prosze podać swoją ścieżkę do pliku!

dane <- read_excel("C:/Users/majko/OneDrive/Pulpit/DOKTORAT/2 rok/Podyplomowe/SMOKING.xlsx") # tutaj prosze podać swoja ściezkę do pliku
dane<-as.data.frame(dane) # dane do fromatu data frame
dane

PRZYGOTOWANIE DANYCH

####Wyciagnięcie nazwy stanowsik z pierwszej kolumny
Stanowisko<-dane[,1]
#Stanowisko<-c("ST.KIEROWNIK", "MŁ.KIEROWNI","ST.PERSONEL","MŁ.PERSONEL","SEKRETARKI")
row.names(dane)<-Stanowisko # nazwy stanowisk jako nazwy wierszy
dane
dane<-dane[,-1] #usunięcie pierwszej kolumny z nazwami stanowsik, gdyz nazwy stanowisk są juz jako nazwy wierszy
dane

WIZUALIZACJA DANYCH W TABELI KRZYŻOWEJ

dt <- as.table(as.matrix(dane))# dane jako tabela do narysoania wizualizacji poniżej

balloonplot(t(dt), main ="palenie", xlab ="", ylab="",
            label = FALSE, show.margins = FALSE)

HEATMAPA

kolory = (brewer.pal(8,"Greens"))
heatmap(dt,scale="col",Colv=NA, col= kolory,cexRow = 0.8, cexCol = 0.8)

TEST CHI-KWADRAT

Czy występuje zależnośc między kolumnami i wierszami?

chisq.test(dane)
## Warning in chisq.test(dane): Chi-squared approximation may be incorrect
## 
##  Pearson's Chi-squared test
## 
## data:  dane
## X-squared = 16.442, df = 12, p-value = 0.1718

ANALIZA KORESPONDENCJI

res.ca<-ca(dane, graph=FALSE)
#### graph - czy wyświetlona ma zostać mapa czy nie

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.ca) 
## 
## Principal inertias (eigenvalues):
## 
##  dim    value      %   cum%   scree plot               
##  1      0.074759  87.8  87.8  **********************   
##  2      0.010017  11.8  99.5  ***                      
##  3      0.000414   0.5 100.0                           
##         -------- -----                                 
##  Total: 0.085190 100.0                                 
## 
## 
## Rows:
##     name   mass  qlt  inr    k=1 cor ctr    k=2 cor ctr  
## 1 | STKI |   57  893   31 |  -66  92   3 | -194 800 214 |
## 2 | MKIE |   93  991  139 |  259 526  84 | -243 465 551 |
## 3 | STPE |  264 1000  450 | -381 999 512 |  -11   1   3 |
## 4 | MPER |  456 1000  308 |  233 942 331 |   58  58 152 |
## 5 | SEKR |  130  999   71 | -201 865  70 |   79 133  81 |
## 
## Columns:
##     name   mass  qlt  inr    k=1 cor ctr    k=2 cor ctr  
## 1 |  NIE |  316 1000  577 | -393 994 654 |  -30   6  29 |
## 2 |  MAO |  233  984   83 |   99 327  31 |  141 657 463 |
## 3 | REDN |  321  983  148 |  196 982 166 |    7   1   2 |
## 4 |  DUO |  130  995  192 |  294 684 150 | -198 310 506 |

WYKRES OSYPISKA

fviz_screeplot(res.ca, addlabels = TRUE, ylim = c(0, 90))

MAPA REPREZENTUJĄCA WIERSZE

fviz_ca_row(res.ca, repel = TRUE)

fviz_ca_row(res.ca, col.row="steelblue", shape.row = 15)

MAPA REPREZENTUJĄCA KOLUMNY

fviz_ca_col(res.ca, repel = TRUE)

fviz_ca_col(res.ca, col.col="steelblue", shape.row = 15)

MAPA REPREZENTUJĄCA KOLUMNY I WIERSZE

fviz_ca_biplot(res.ca, repel = TRUE)

Więcej na temat analizy korespondencji w R : https://cran.r-project.org/web/packages/ca/ca.pdf

                                                                  Made by: 
                                                                  Majkowska Agata
                                                                  agata.majkowska@phdstud.ug.edu.pl