Analiza korespondencji- zatrudnienie
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("dplyr")WCZYTYWANIE DANYCH
UWAGA!!!!!
Prosze podać swoją ścieżkę do pliku!
daneGUS <- read_excel("C:/Users/majko/OneDrive/Pulpit/DOKTORAT/2 rok/Podyplomowe/Zatrudnienie2.xlsx")
daneGUS<-as.data.frame(daneGUS)
head(daneGUS,5)## Kod Nazwa Sektory ekonomiczne Płeć Wartość i precyzja Rok
## 1 0000000 POLSKA sektor rolniczy ogółem wartość liczbowa 2019
## 2 0000000 POLSKA sektor przemysłowy ogółem wartość liczbowa 2019
## 3 0000000 POLSKA sektor usługowy ogółem wartość liczbowa 2019
## 4 0200000 dolnoslaskie sektor rolniczy ogółem wartość liczbowa 2019
## 5 0200000 dolnoslaskie sektor przemysłowy ogółem wartość liczbowa 2019
## Wartosc Jednostka miary Atrybut
## 1 1498 tys. osób NA
## 2 5260 tys. osób NA
## 3 9612 tys. osób NA
## 4 49 tys. osób NA
## 5 427 tys. osób NA###wybór odpowiednich kolumn do analizy####
daneGUS1<-daneGUS[,c(2,3,7)]
head(daneGUS1,3)## Nazwa Sektory ekonomiczne Wartosc
## 1 POLSKA sektor rolniczy 1498
## 2 POLSKA sektor przemysłowy 5260
## 3 POLSKA sektor usługowy 9612PRZYGOTOWANIE DANYCH
Utworzenie wektorów z danymi dla poszczególnych sektorów zatrudnienia i bezrobocia
sektor_przemyslowy<-daneGUS1%>%
filter(`Sektory ekonomiczne`=='sektor przemysłowy')%>%
group_by(Nazwa)%>%
summarize(sektor_przemyslowy=sum(Wartosc))
sektor_przemyslowy## # A tibble: 17 x 2
## Nazwa sektor_przemyslowy
## <chr> <dbl>
## 1 dolnoslaskie 427
## 2 kujawsko-pomorskie 281
## 3 lodzkie 366
## 4 lubelskie 211
## 5 lubuskie 156
## 6 malopolskie 457
## 7 mazowieckie 611
## 8 opolskie 152
## 9 podkarpackie 311
## 10 podlaskie 128
## 11 POLSKA 5260
## 12 pomorskie 321
## 13 slaskie 707
## 14 swietokrzyskie 151
## 15 warminsko-mazurskie 185
## 16 wielkopolskie 583
## 17 zachodnio-pomorskie 213sektor_rolniczy<-daneGUS1%>%
filter(`Sektory ekonomiczne`=='sektor rolniczy')%>%
group_by(Nazwa)%>%
summarize(sektor_rolniczy=sum(Wartosc))
sektor_rolniczy## # A tibble: 17 x 2
## Nazwa sektor_rolniczy
## <chr> <dbl>
## 1 dolnoslaskie 49
## 2 kujawsko-pomorskie 113
## 3 lodzkie 134
## 4 lubelskie 169
## 5 lubuskie 26
## 6 malopolskie 131
## 7 mazowieckie 207
## 8 opolskie 34
## 9 podkarpackie 80
## 10 podlaskie 94
## 11 POLSKA 1498
## 12 pomorskie 59
## 13 slaskie 43
## 14 swietokrzyskie 91
## 15 warminsko-mazurskie 62
## 16 wielkopolskie 169
## 17 zachodnio-pomorskie 37sektor_uslugowy<-daneGUS1%>%
filter(`Sektory ekonomiczne`=='sektor usługowy')%>%
group_by(Nazwa)%>%
summarize(sektor_uslugowy=sum(Wartosc))
sektor_uslugowy## # A tibble: 17 x 2
## Nazwa sektor_uslugowy
## <chr> <dbl>
## 1 dolnoslaskie 774
## 2 kujawsko-pomorskie 470
## 3 lodzkie 588
## 4 lubelskie 481
## 5 lubuskie 242
## 6 malopolskie 843
## 7 mazowieckie 1707
## 8 opolskie 204
## 9 podkarpackie 437
## 10 podlaskie 259
## 11 POLSKA 9612
## 12 pomorskie 647
## 13 slaskie 1097
## 14 swietokrzyskie 273
## 15 warminsko-mazurskie 303
## 16 wielkopolskie 844
## 17 zachodnio-pomorskie 442bezrobocie<-daneGUS1%>%
filter(`Sektory ekonomiczne`=='bezrobocie')%>%
group_by(Nazwa)%>%
summarize(bezrobocie=sum(Wartosc))
bezrobocie## # A tibble: 16 x 2
## Nazwa bezrobocie
## <chr> <dbl>
## 1 dolnoslaskie 20.5
## 2 kujawsko-pomorskie 26.5
## 3 lodzkie 23.7
## 4 lubelskie 29.3
## 5 lubuskie 5.50
## 6 malopolskie 23.6
## 7 mazowieckie 50.8
## 8 opolskie 7.21
## 9 podkarpackie 33.5
## 10 podlaskie 14.3
## 11 pomorskie 13.5
## 12 slaskie 21.2
## 13 swietokrzyskie 15.9
## 14 warminsko-mazurskie 15.6
## 15 wielkopolskie 12.7
## 16 zachodnio-pomorskie 14.9ZŁĄCZENIE WEKTORÓW W TABELE
dane1<-sektor_przemyslowy%>%
inner_join(sektor_rolniczy)%>%
inner_join(sektor_uslugowy)%>%
inner_join(bezrobocie)## Joining, by = "Nazwa"
## Joining, by = "Nazwa"
## Joining, by = "Nazwa"dane1## # A tibble: 16 x 5
## Nazwa sektor_przemysl~ sektor_rolniczy sektor_uslugowy bezrobocie
## <chr> <dbl> <dbl> <dbl> <dbl>
## 1 dolnoslaskie 427 49 774 20.5
## 2 kujawsko-po~ 281 113 470 26.5
## 3 lodzkie 366 134 588 23.7
## 4 lubelskie 211 169 481 29.3
## 5 lubuskie 156 26 242 5.50
## 6 malopolskie 457 131 843 23.6
## 7 mazowieckie 611 207 1707 50.8
## 8 opolskie 152 34 204 7.21
## 9 podkarpackie 311 80 437 33.5
## 10 podlaskie 128 94 259 14.3
## 11 pomorskie 321 59 647 13.5
## 12 slaskie 707 43 1097 21.2
## 13 swietokrzys~ 151 91 273 15.9
## 14 warminsko-m~ 185 62 303 15.6
## 15 wielkopolsk~ 583 169 844 12.7
## 16 zachodnio-p~ 213 37 442 14.9UPORZĄDKOWANIE TABELI
dane1<-as.data.frame(dane1) #utworzenie formatu data frame
dane1## Nazwa sektor_przemyslowy sektor_rolniczy sektor_uslugowy
## 1 dolnoslaskie 427 49 774
## 2 kujawsko-pomorskie 281 113 470
## 3 lodzkie 366 134 588
## 4 lubelskie 211 169 481
## 5 lubuskie 156 26 242
## 6 malopolskie 457 131 843
## 7 mazowieckie 611 207 1707
## 8 opolskie 152 34 204
## 9 podkarpackie 311 80 437
## 10 podlaskie 128 94 259
## 11 pomorskie 321 59 647
## 12 slaskie 707 43 1097
## 13 swietokrzyskie 151 91 273
## 14 warminsko-mazurskie 185 62 303
## 15 wielkopolskie 583 169 844
## 16 zachodnio-pomorskie 213 37 442
## bezrobocie
## 1 20.534
## 2 26.520
## 3 23.690
## 4 29.316
## 5 5.505
## 6 23.626
## 7 50.832
## 8 7.207
## 9 33.463
## 10 14.327
## 11 13.472
## 12 21.185
## 13 15.905
## 14 15.611
## 15 12.739
## 16 14.948wojewodztwa<-dane1[,1] #wyciagnięcie z kolumny nazw województw
row.names(dane1)<-wojewodztwa # wojweództwa jako nazwy wierszy
dane1<-dane1[,-1] #usunięcie kolumny z województwami, gdyż mamy już województwa jako nazwy wierszy
dane1## sektor_przemyslowy sektor_rolniczy sektor_uslugowy
## dolnoslaskie 427 49 774
## kujawsko-pomorskie 281 113 470
## lodzkie 366 134 588
## lubelskie 211 169 481
## lubuskie 156 26 242
## malopolskie 457 131 843
## mazowieckie 611 207 1707
## opolskie 152 34 204
## podkarpackie 311 80 437
## podlaskie 128 94 259
## pomorskie 321 59 647
## slaskie 707 43 1097
## swietokrzyskie 151 91 273
## warminsko-mazurskie 185 62 303
## wielkopolskie 583 169 844
## zachodnio-pomorskie 213 37 442
## bezrobocie
## dolnoslaskie 20.534
## kujawsko-pomorskie 26.520
## lodzkie 23.690
## lubelskie 29.316
## lubuskie 5.505
## malopolskie 23.626
## mazowieckie 50.832
## opolskie 7.207
## podkarpackie 33.463
## podlaskie 14.327
## pomorskie 13.472
## slaskie 21.185
## swietokrzyskie 15.905
## warminsko-mazurskie 15.611
## wielkopolskie 12.739
## zachodnio-pomorskie 14.948WIZUALIZACJA DANYCH W TABELI KRZYŻOWEJ
dt <- as.table(as.matrix(dane1))# dane jako tabela do narysoania wizualizacji poniżej
balloonplot(t(dt), main ="zatrudnienie", xlab ="", ylab="",
label = FALSE, show.margins = FALSE, text.size=1.5 )
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(dane1)##
## Pearson's Chi-squared test
##
## data: dane1
## X-squared = 649.82, df = 45, p-value < 2.2e-16ANALIZA KORESPONDENCJI
res.ca<-ca(dane1, graph=FALSE)
#### graph - czy wyświetlona ma zostać mapa czy niePODSUMOWANIE 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.027656 71.1 71.1 ******************
## 2 0.009211 23.7 94.7 ******
## 3 0.002050 5.3 100.0 *
## -------- -----
## Total: 0.038917 100.0
##
##
## Rows:
## name mass qlt inr k=1 cor ctr k=2 cor ctr
## 1 | dlns | 76 989 65 | -181 984 90 | -13 5 1 |
## 2 | kjws | 53 932 34 | 143 836 40 | 49 96 14 |
## 3 | ldzk | 67 992 26 | 103 695 25 | 67 296 32 |
## 4 | lbls | 53 1000 195 | 373 981 269 | -52 19 16 |
## 5 | lbsk | 26 983 13 | -120 735 13 | 70 248 14 |
## 6 | mlpl | 87 66 1 | -6 49 0 | -3 17 0 |
## 7 | mzwc | 154 1000 132 | -16 8 1 | -182 992 555 |
## 8 | opls | 24 1000 13 | -30 41 1 | 144 958 53 |
## 9 | pdkr | 52 442 44 | 40 47 3 | 115 395 74 |
## 10 | pdls | 30 996 100 | 361 996 140 | -7 0 0 |
## 11 | pmrs | 62 974 29 | -122 808 33 | -55 166 21 |
## 12 | slsk | 112 1000 190 | -250 945 253 | 60 54 44 |
## 13 | swtk | 32 1000 73 | 297 990 102 | 30 10 3 |
## 14 | wrmn | 34 846 9 | 79 583 8 | 53 262 10 |
## 15 | wlkp | 96 641 53 | 18 15 1 | 115 626 139 |
## 16 | zchd | 42 931 22 | -118 681 21 | -72 250 24 |
##
## Columns:
## name mass qlt inr k=1 cor ctr k=2 cor ctr
## 1 | sktr_p | 315 1000 195 | -78 253 69 | 134 747 615 |
## 2 | sktr_r | 90 994 595 | 505 990 829 | 31 4 9 |
## 3 | sktr_s | 576 997 120 | -46 259 44 | -77 738 374 |
## 4 | bzrb | 20 463 90 | 286 459 58 | -26 4 1 |WYKRES OSYPISKA
fviz_screeplot(res.ca, addlabels = TRUE, ylim = c(0, 80))
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)
MAPA - REZPREZENTACJA INNYCH WYMIARÓW NIŻ 1. I 2. WYMIAR
plot(res.ca, dim=c(2,3), mass=c(TRUE,TRUE)) 
#### DIM - WYBÓR WYMAIRÓW DO WIZUALIZACJI - tutaj wybrany został wymiar 2 i 3
#### mass - wektor określający, czy masa ma być reprezentowana przez pole punktów
#### (pierwsza pozycja dla wierszy, druga dla kolumn)MAPA 3D
Można mapę obracać
library(rgl)
knitr::knit_hooks$set(webgl = hook_webgl)print(plot3d.ca(res.ca,dim=c(1,2,3) ,labels=c(2,2), col=c("blue","red")))
#### dim - wybór wymiarów do wizualizacji
#### labels - Wektor o długości dwa określający, czy wykres powinien zawierać:
#### tylko symbole (0), tylko etykiety (1), czy też symbole i etykiety (2).
#### Uwaga na polskie litery. Funkcja nie wyświetli etykiet jesli będą w nich polskie litery.
#### col - kolory odpowiednio dla wierszy i kolumn
#### pch - kształty punktów na mapie - więcej znaleźc można wywołując " pchlist() " You must enable Javascript to view this page properly.
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