Kiedy dogonimy zachód… od podszewki

September 13, 2012
By

This post was kindly contributed by SmarterPoland » R - go there to comment and to read the full post.

Dzisiaj pokażę jak powstawały wyniki przedstawione we wtorkowym wpisie Kiedy dogonimy zachód?. Będzie trochę o motywacji, dlaczego akurat taki temat, o tym jak ściągnąć dane automatycznie z internetu, o zaletach analizy ,,opóźnienia” i przede wszystkim będzie o robieniu wykresów w programie R.

Zacznę od motywacji. Na wielu serwisach można można znaleźć wykresy pokazujące jak wybrane charakterystyki zmieniają się w czasie dla różnych krajów. Przykładowo kursy walut, ceny akcji, produkt krajowy brutto, oczekiwana długość życia, wszystko jako funkcja czasu. Technicznie temat oklepany, na osi x czas, na osi y charakterystyka.

Jakiś czas temu otrzymałem od Michała R. list z sugestią zrobienia analizy, np. dla oczekiwanej długości życia, z informacją jak bardzo Polska jest ..opóźniona” w stosunku do zachodu i czy to opóźnienie się zwiększa czy zmniejsza.
To było to!
Nie widziałem jeszcze takich wykresów badających jak zmienia ,,dystans” Polski do światowej czołówki. Czy badanie takiego dystansu jest lepsze niż standardowe podejście to inna sprawa. W każdym razie pojawiła się okazja do zrobienia czegoś nowego.
A to tygrysy lubią najbardziej.

Zostawmy w spokoju nawiązania do Kubusia Puchatka i wróćmy do analizy opóźnienia. Na poniższym przykładzie postaram się nie tylko pokazać jak zrobić analizę opóźnienia, ale też uzasadnić, że jest ona lepszym narzędziem, pozwalającym zobaczyć więcej, niż klasyczne wykresy rok vs. charakterystyka.

Zacznijmy od wczytania danych.
Na stronie o adresie http://www.indexmundi.com/poland/internet-users.html przedstawiono jak zwiększała się liczba użytkowników Internetu z roku na rok. Pierwsza tabela przedstawia szacunkową liczbę, druga tabela procent. Zmieniając nazwę państwa w linku, możemy odczytać dane z innych krajów.
Zabawę zacznijmy więc od automatycznego wczytania danych. Użyjemy do tego funkcji readHTMLTable{XML}, która odczyta dane prosto ze strony HTML. Funkcją lapply() powtarzam ściąganie danych dla każdego z krajów z listy o nazwie ‘kraje’.

1
2
3
4
5
6
7
8
library(XML)
kraj <- c("poland", "united_kingdom", "greece", "hungary")
# lista czterech tabel z danymi
dane <- lapply(kraj, function(k) readHTMLTable(paste("http://www.indexmundi.com/", 
    k, "/internet-users.html", sep = ""), which = 3, colClasses = "numeric"))
# wyciągamy lata i procenty użytkowników
lata     <- dane[[1]][, 1]
procenty <- as.data.frame(sapply(dane, `[`, 2))

Ciekawostką, która bardzo mnie cieszy za każdym razem gdy ją używam, jest ostatnia linia kodu. Funkcją sapply() na każdym elemencie listy ‘dane’ wykonuję funkcję ‘[‘ z argumentem 2, co oznacza wyciągnięcie drugiej kolumny z tabeli, czyli kolumny z procentem użytkowników z dostępem do Internetu.
Jako wynik otrzymujemy ‘procenty’, czyli tabelę, w której kolejne kolumny odpowiadają krajom, a w wierszach jest % użytkowników z Internetem.

Rysujemy wykres klasyczny
Użyjemy do tego funkcji matplot(), wykorzystamy kolory z pakietu RColorBrewer (kolory znacznie ładniejsze niż standardowe). Dorysujemy jeszcze poziome pomocnicze linie i legendę.

8
9
10
11
12
13
14
library(RColorBrewer)
kolory <- brewer.pal(9, "Set1")
matplot(lata, procenty, type = "o", pch = 19, las = 1, xlab = "", 
    ylab = "", col = kolory, main = "% osób z dostępem do Internetu", bty = "n")
abline(h = (0:7) * 10, col = "grey", lty = 3)
legend("topleft", kraj, ncol = 2, col = kolory, pch = 19, lwd = 2, 
    bty = "n", cex = 1)

plot of chunk podsumowanie

Pierwsze podejście do tematu opóźnień
Zacznijmy od pytania jak policzyć rok odniesienia/opóźnienia. W Polsce w roku 2010 procent użytkowników Internetu wynosił zgodnie z naszym źródłem 62,32%. Chcemy teraz policzyć np. w UK w którym roku był zaobserwowany taki % użytkowników. Dokładnie takiego procentu nie ma co jednak się spodziewać, więc to co liczę to średnia z dwóch dat. Z ostatniego roku w którym w UK % internautów był niższy niż 62,32% (w roku 2002 było w UK 56,48%) i z pierwszego roku w którym w UK % internautów był wyższy niż 62,32% (w roku 2003 było 64,82%). W tym przypadku % internautów stale rośnie, więc te dwa lata to zawsze są dwa kolejne lata, ale w ogólności tak być nie musi. Można dyskutować czy to najlepsza definicja, ta ma wady i zalety, jakoś ,,opóźnienie” trzeba liczyć.

W poniższym przykładzie funkcja rysuj() liczy te średnie i dorysowuje je na wykresie.

15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
# dat1 to wartości współczynnika w kraju bazowym
# dat2 to wartości współczynnika w kraju odniesienia
# funkcja liczy który rok w kraju odniesienia odpowiada danemu rocznikowi w kraju bazowym
rysuj <- function(dat1, dat2, rok, kol = "red") {
    lata <- sapply(dat1, function(tmp) c(rok[min(which(dat2 >= tmp))], rok[max(which(dat2 <= tmp))]))
    lata <- colMeans(lata)
    points(rok, lata, type = "o", pch = 19, las = 1, col = kol, cex = 1.2)
}
# przygotowujemy pusty wykres wraz z liniami pomocniczymi
plot(c(1995, 2010), c(1995, 2010), type = "n", pch = 19, las = 1, 
    main = "", xlab = "rok w Polsce", ylab = "rok na zachodzie", bty = "n")
abline(h = seq(1900, 2010, 5), col = "grey90", lty = 3)
abline(v = seq(1900, 2010, 5), col = "grey90", lty = 3)
abline(0, 1, col = "grey90", lty = 3)
# rysujemy krzywe opóźnień dla kolejnych krajów
for (i in 2:4) 
   rysuj(procenty[, 1], procenty[, i], lata, kolory[i])
legend("topleft", kraj[-1], ncol = 1, col = kolory[-1], pch = 19, lwd = 2, bty = "n", cex = 1.1)

Co ciekawe, na tym wykresie widać coś, czego nie było widać na poprzednim wykresie (choć i tutaj nie jest to jeszcze super widoczne). Mianowicie opóźnienie Polski w stosunku do UK jeżeli chodzi o % Internautów rośnie. W roku 2005 wynosiło 3.5 roku a w roku 2010 wynosi już 7.5 roku.
Patrząc na % z pierwszego wykresu różnica w procentach wygląda zupełnie inaczej.
W roku 2005 różnica wynosiła 31% (39% w PL i 70% w UK) a w roku 2010 różnica wynosiła 23% (62% w PL i 85% w UK).
Czyli różnica w % się zmniejsza, ale dystans w latach się zwiększa.
Interesujące prawda?
Podobnie może być z każdym ,,wysycającym się” współczynnikiem. Koniec końców bez względu na zaawansowanie nie można mieć więcej niż 100% obywateli z dostępem do Internetu.

plot of chunk podsumowanie

Drugie podejście do tematu opóźnień
Problem z poprzednim wykresem jest taki, że nie jest on zbyt czytelny. Rysując go wydawał mi się intuicyjny, ale próbując go komukolwiek opisać widziałem, że jest zbyt wiele kresek pod różnymi kątami. Odkrywanie ciekawych zależności na nim, polega na ocenie czy krzywa jest nachylona pod większym czy mniejszym kątem niż 45%. Nie jest to dobre.

Zmieńmy więc oś y tak by był na nim prezentowany dystans Polski do porównywanego kraju. Intuicyjnie będzie można go czytać, jeżeli na wykresie im wyżej tym lepiej. Dlatego wartości dodatnie będą pokazywały o ile lat Polska jest spóźniona, a wartości ujemne o ile lat wyprzedza kraj porównywany. Kraj najbardziej ,,rozwinięty” będzie najwyżej.

Aby uzyskać taki efekt, w powyższym kodzie wystarczy jedynie zmienić ostatnią linię funkcji rysuj().

18
19
20
21
22
23
24
25
26
27
28
rysuj <- function(dat1, dat2, rok, kol = "red") {
    lata <- sapply(dat1, function(tmp) c(rok[min(which(dat2 >= tmp))], rok[max(which(dat2 <= tmp))]))
    lata <- colMeans(lata)
    points(rok, rok - lata, type = "o", pch = 19, las = 1, col = kol, cex = 1.2)
}
plot(c(1995, 2010), c(-5, 10), type = "n", pch = 19, las = 1, main = "Procent osób z dostępem do Internetu", 
    xlab = "rok w Polsce", ylab = "liczba lat o ile wyprzedzają Polskę", bty = "n")
abline(h = seq(-10, 9, 2.5), col = "grey90", lty = 3)
for (i in 2:4) 
       rysuj(procenty[, 1], procenty[, i], lata, kolory[i])
legend("topleft", kraj[-1], ncol = 1, col = kolory[-1], pch = 19, lwd = 2, bty = "n", cex = 1.1)

Teraz wyraźnie widać jak zmienia się dystans pomiędzy Polską, UK, Węgrami a Grecją.

plot of chunk podsumowanie

I jak widzicie tę analizę opóźnienia?
Użyteczne narzędzie czy wydmuszka?

Tags: , , , ,

Comments are closed.