Ostatnio moi magistranci na mini-seminarium prezentowali jednowymiarową analizę gradacyjną. Służyć może ona między innymi do porównania czy pomiędzy dwoma wektorami obserwacji zmieniła się struktura odpowiedzi. Wygląda to na ciekawą metodę, więc warto ją zaimplementować w R i zobaczyć jak dziala.
Kilka dni temu pisaliśmy o zbiorze Diagnoza Społeczna (http://smarterpoland.pl/index.php/2011/10/diagnoza-spoleczna-2011/), już dołączony do repozytorium. Wykorzystamy go na potrzeby badania analizy gradacyjnej.
W latach 2005 i 2009 w Diagnozie Społecznej ankieterzy pytali respondentów o wskazanie wartości ważnych w ich życiu (zmienne cp2.1-cp2.14 i ep2.1-ep2.14) . Badany mógł wybrać maksymalnie trzy odpowiedzi ze zbioru 14 możliwych (PIENIADZE, DZIECI, UDANE MALZENSTWO, PRACA, PRZYJACIELE, OPATRZNOSC, BOG, POGODA DUCHA, OPTYMIZM, UCZCIWOŚĆ, ŻYCZLIWOŚĆ I SZACUNEK OTOCZENIA, WOLNOSC, SWOBODA, ZDROWIE, WYKSZTALCENIE, SILNY CHARAKTER, INNE). Wykorzystamy analizę gradacyjną by sprawdzić czy zmieniła się struktura wartości w badanej grupie respondentów w przeciągu czterech lat.
Zaczniemy od analizy dwóch czternastoelementowych wektorów. Każdy wektor określi jaka frakcja osób uznała daną wartość za ważną w ich życiu. Porównamy oba wektory, by sprawdzić które wartości zyskały, a które straciły na znaczeniu pomiędzy rokiem 2009 a 2005.
Kod generujący powyższy rysunek znajduje się poniżej. Po lewej prezentowane są wyniki analizy gradacyjnej, po prawej zwykły wykres rozrzutu. Oba wykresy prezentują te same dane.
Zacznijmy od prawego wykresu. Frakcje osób uznających daną wartośc za ważną unormowano tak, by po zsumowaniu wszystkich wartości otrzymać 1. Osobno dla roku 2005 osobno dla 2009. Każdy punkt opisuje jedną wartość. Współrzędne punktu odpowiadają unormowanej frakcji osób uznających tą wartość za ważną w roku 2005 i 2009. Dorysowano przekątną, dzięki temu punkty pod przekątną odpowiadają wartościom których znaczenie spadło do roku 2009, punkty nad odpowiadają wartosciom których znaczenie wzrosło.
Po lewej stronie przedstawiono te frakcje w sposób skumulowany. Kolejność odpowiada procentowej zmianie ważności w stosunku do roku 2009. Na początku wykresu, przy punkcie 0,0 znajdują się wartości, które zyskały na znaczeniu. Pod koniec wartości, ktore stracily na znaczeniu. Długość kroku odpowiada frakcji osob uznających daną wartość za ważną. Odległość wyrysowanej łamanej od przekątnej obrazuje jak bardzo zmieniła się struktura wartości. W tym przypadku łamana jest blisko przekątnej, więc ludzie nie zmienili istotnie swojego systemu wartości. Dzieci i zdrowie zyskały na ważności. Pieniądze i praca straciły, choć w obu przypadkach nie są to duże zmiany.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 | plotGradeStat <- function(zmienna1, zmienna2, uporzadkujMalejaco = TRUE, osX = "", osY = "", skala=c(0.005,0.5), cex.text=0.8, cutoff = 0.01) { # normalizacja obu cech zm1r <- zmienna1/sum(zmienna1) zm2r <- zmienna2/sum(zmienna2) iloraz <- zm1r/zm2r # jezeli zachodzi taka potrzeba to zmienna sa porzadkowane w kolejn if (uporzadkujMalejaco) { zm1r <- zm1r[order(iloraz, decreasing=FALSE), 1, drop=FALSE] zm2r <- zm2r[order(iloraz, decreasing=FALSE), 1, drop=FALSE] iloraz <- zm1r/zm2r } # dwa wykresy w poziomie par(mfrow=c(1,2)) par(xpd=F) # pierwszy wykres to analiza gradacyjna # dla jednowymiarowych danych plot(c(0,cumsum(zm1r[,1])),c(0,cumsum(zm2r[,1])),type="b",pch=19,xlab=osX,ylab=osY) abline(0,1,col="grey") par(xpd=NA) # korekta na zachodzace etykiety odleglosci <- sqrt(diff(c(0,cumsum(zm1r[,1])))^2+diff(c(0,cumsum(zm2r[,1])))^2) korekta <- numeric(length(odleglosci)) for (i in seq_along(korekta)) { if (odleglosci[i] < cutoff) korekta[i] <- cutoff + korekta[i-1] } text(cumsum(zm1r[,1])+korekta+2*cutoff,cumsum(zm2r[,1])+korekta-2*cutoff,rownames(zm1r), srt=-45, adj=c(0,0),cex=cex.text) text(cumsum(zm1r[,1])+korekta-2*cutoff,cumsum(zm2r[,1])+korekta+2*cutoff,paste(round((1/iloraz[,1]-1)*1000)/10," %",sep=""), srt=-45, adj=c(1,1),cex=cex.text) par(xpd=F) # drugi wykres to klasyczny wykres rozrzutu plot(1,type="n",log="xy",xlim=skala,ylim=skala, las=1, cex.axis=0.8, xlab=osX, ylab=osY) abline(0,1,col="grey") abline(h=c(0.0001*c(1,2,5),0.001*c(1,2,5),0.01*c(1,2,5),0.1*c(1,2,5)),col="grey95") abline(v=c(0.0001*c(1,2,5),0.001*c(1,2,5),0.01*c(1,2,5),0.1*c(1,2,5)),col="grey95") points(zm1r[,1],zm2r[,1],pch=19) par(xpd=NA) text(zm1r[,1],zm2r[,1],rownames(zm1r), srt=-45, adj=c(-0.1,-0.1),cex=cex.text) par(xpd=F) } # zbieramy dane kto co uwazal za istotne w zyciu w roku 2005 i 2009 zb1 <- colSums(diagnozaOsoby2011[,paste("cp2_",1:14,sep="")]=="TAK",na.rm=T) zb2 <- colSums(diagnozaOsoby2011[,paste("cp2_",1:14,sep="")]=="NIE",na.rm=T) zb3 <- colSums(diagnozaOsoby2011[,paste("ep2_",1:14,sep="")]=="TAK",na.rm=T) zb4 <- colSums(diagnozaOsoby2011[,paste("ep2_",1:14,sep="")]=="NIE",na.rm=T) # etykiety, co jest wazne w zyciu etykiety <- c("PIENIADZE", "DZIECI", "UDANE MALZENSTWO", "PRACA", "PRZYJACIELE", "OPATRZNOSC, BOG", "POGODA DUCHA, OPTYMIZM", "UCZCIWOSC", "ZYCZLIWOSC I SZACUNEK OTOCZENIA", "WOLNOSC, SWOBODA", "ZDROWIE", "WYKSZTALCENIE", "SILNY CHARAKTER", "INNE") # tabela opisujaca ktora wartosc ile osob zaznaczylo lub nie w wymienionych powyzej latach dane <- data.frame(TAK2005 = zb1, NIE2005 = zb2, TAK2009=zb3, NIE2009=zb4) rownames(dane) <- etykiety zm1 <- dane[,1,drop=F]/dane[,2] zm2 <- dane[,3,drop=F]/dane[,4] plotGradeStat(zm1, zm2, osX="rok 2005", osY="rok 2009", skala=c(0.001,0.5),cutoff=0.01) |
2 thoughts on “Co jest w życiu ważne?”