-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathProjekt.Rmd
458 lines (370 loc) · 30.1 KB
/
Projekt.Rmd
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
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
---
title: "Porządkowanie liniowe i analiza skupień"
author: "Jakub Ignatik"
date: "10 grudnia 2018"
output: html_document
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
```
#Rozdział I: Ranking obiektów
###Wprowadzenie
Celem tej części projektu będzie przedstawienie rankingu polskich miast najbardziej przyjaznych rowerzystom.
**Dane: **Dane pochodzą z magazynu rowerowego "Rowertour" (11/2018), gdzie został przedstawiony ranking miast najbardziej przyjaznych rowerzystom. Jednak ranking tam przedstawiony jest dość subiektywny, biorąc pod uwagę opinie organizacji rowerowych (np. brak takiej opinii obniża maksymalną liczbę punktów do zdobycia za kategorię o 1/3), a także stosuje dla kategorii oceniającej łączną długość DIR skalę otwartą, przez co powstaje spora różnica pomiędzy miastami, rzutująca na ranking.
Jeśli chodzi o ilość miast, dla których wykonywany będzie ranking, postanowiłem pozostawić oryginalną ich liczbę - 39, co nie odbiega sporo od wymienionej w zadaniu liczby 30.
**Metodologia: **Zmuszony jestem ograniczyć liczbę zmiennych, których w danych można naliczyć dość sporo. Analizę ograniczę do drogowej infrastruktury rowerowej (DIR), w skład której wchodzą następujące zmienne (s - stymulanta, d - destymulanta):
-*DIR.lacznie:* Łączna długość DIR (s)
-*DIR.asfalt:* Długość DIR o powierzchni asfaltowej (s)
-*DIR.kostka:* Długość DIR o powierzchni z kostki/płyt chodnikowych (d)
-*DIR.inne:* Długość DIR o innej powierzchni (d)
-*Pasy.ruchu:* Łączna długość pasów ruchu dla rowerów (s)
-*Drogi.row.lacznie:* Łączna długość dróg dla rowerów (s)
-*Drogi.row.asfalt:* Długość dróg dla rowerów o powierzchni asfaltowej (s)
-*Ciagi.lacznie:* Łączna długość ciągów pieszo-rowerowych (d)
-*Ciagi.asfalt:* Długość ciągów pieszo-rowerowych o powierzchni asfaltowej (s)
Ranking wykonam trzema metodami: metodą Hellwiga, metodą standaryzowanych sum oraz metodą sumy rang.
###Wprowadzenie danych oraz ich obróbka
Oprócz zmiennych, które będą brać udział w tworzeniu rankingu (jednostka: km), wprowadzę też liczbę mieszkańców (w tys.) oraz długość dróg publicznych(w km).
```{r}
Bialystok <- c(297.3,426,124,103.6,19.6,0.8,0,102.2,87.4,21.8,16.2)
Bielsko_Biala <- c(171.5,589.1,30.2,26.2,3,1,0.73,15.7,15.7,13.7,12)
Bydgoszcz <- c(352.3,827.5,86.7,44.7,28.3,12,0.6,31.3,20.1,53.1,24.5)
Bytom <- c(168.4,211,15.5,9.7,4.9,0.3,0,4.3,4.3,7.3,1.8)
Chorzow <- c(109,137,51,38.1,12.9,0,0,5.5,5.5,12,5)
Czestochowa <- c(224.4,653,75.6,36.9,38,0.7,5.7,26.6,24.1,43.3,7.1)
Dabrowa_Gornicza <- c(121.1,398,30.8,22.9,7.9,0,2.5,15.3,13,10,4.4)
Elblag <- c(120.9,219.1,45.1,6.5,38.6,0,1,3.8,2.8,40.3,3.2)
Gdansk <- c(464.3,818.8,168.1,127.9,40.2,0,10.2,124.3,102,19,8.1)
Gdynia <- c(246.3,399.8,63.4,46,15.2,2.2,3,33.9,28.8,26.5,14.1)
Gliwice <- c(181.3,430,40.5,18.8,14.6,7.1,0,24.2,13.5,16.3,5.3)
Gorzow_Wlkp <- c(124.3,295,50,16.4,31.7,1.9,4.2,9.7,9,32.5,3.4)
Grudziadz <- c(92.1,235,58.1,16.6,40.3,1.1,2.8,28.3,12.6,24.4,4.05)
Kalisz <- c(101.6,311.6,47.3,22.1,25.2,0,3.8,0.9,0.4,42.8,15.5)
Katowice <- c(296.3,552,68,28,40,0,7,23,16,36,3)
Kielce <- c(196.8,380,52.8,26.3,19,7.5,1.7,30.6,23.8,22.2,2.5)
Koszalin <- c(107.7,230,77.8,41,34.7,2.2,0.55,38.9,26.1,39.9,14.8)
Krakow <- c(767.3,3135.2,165.4,149,16,0,17.7,110,104.5,NA,NA)
Lublin <-c(339.8,582.7,153.8,99.8,53.1,0.9,26.6,8,6.7,117.5,64.8)
Lodz <- c(690.4,1036.9,197.2,99.1,53.5,2.3,33.3,NA,NA,NA,NA)
Olsztyn <- c(173.1,346.2,68.9,28.3,30.6,10,1.5,52.9,26.3,16.5,0.5)
Opole <- c(128.1,403,85.8,32.5,53.9,1.3,1.4,13.2,7.9,70.9,23.1)
Plock <- c(120.8,273,63.2,54.4,5.5,0,1.6,59.9,54.4,1.7,0)
Poznan <- c(538.6,1053,232.1,126,NA,NA,16,98.2,70,85.6,40)
Radom <- c(214.6,332,79.4,71.3,7.1,0,7.8,57.3,54.3,13.4,11.4)
Ruda_Slaska <- c(138.3,261,27.8,10.6,16.5,0.7,4.5,20,9.4,3.7,0.8)
Rybnik <- c(139.1,445.2,38.5,22.2,12.3,4,4.3,9.4,5.1,22.5,10.5)
Rzeszow <- c(189.7,321.1,140.5,119.9,20.6,0,1.6,85.5,85.5,51,28)
Slupsk <- c(91.5,154.8,45.1,31,24.1,9.1,2.4,22.8,15.1,20,3.5)
Sosnowiec <- c(204,367,60,45,15,0,0,45,35,10,5)
Szczecin <- c(403.9,792.5,135.3,69.7,58.2,7.4,20.4,91.9,NA)
Tarnow <- c(109.6,366,67.1,10,57.1,0,2.75,23.4,5.2,43.7,4.8)
Torun <- c(202.6,481.7,111,89.5,18.3,3.2,2,90,76,19,13.5)
Tychy <- c(128.2,300,50,20.1,29.9,0,1.35,17.4,5.1,32.8,15)
Warszawa <- c(1764.6,2433.5,522,336,185,1,34.9,416.4,266.4,70.7,35.4)
Wroclawek <- c(111.8,219.9,54,15.7,32.4,5.8,0.78,11.5,8.6,42.6,7.1)
Wroclaw <- c(638.6,2209,345.7,185,97.7,63,29.5,175.4,108.7,74.7,44.1)
Zabrze <- c(174.3,220.2,23.6,18.5,5.2,0,1.3,7.7,7.2,14.6,10)
Zielona_Gora <- c(139.8,471,62.8,21.9,33.2,7.7,3,4.7,4.7,58.1,7.2)
dane <- rbind(Bialystok,Bielsko_Biala,Bydgoszcz,Bytom, Chorzow, Czestochowa, Dabrowa_Gornicza, Elblag, Gdansk, Gdynia, Gliwice, Gorzow_Wlkp, Grudziadz, Kalisz, Katowice, Kielce, Koszalin, Krakow, Lublin, Lodz, Olsztyn, Opole, Plock, Poznan, Radom, Ruda_Slaska, Rybnik, Rzeszow, Slupsk, Sosnowiec, Szczecin, Tarnow, Torun, Tychy, Warszawa, Wroclawek, Wroclaw, Zabrze, Zielona_Gora)
dane <- as.data.frame(dane)
colnames(dane) <-c("Ludzie","Dlugosc.drog","DIR.lacznie","DIR.asfalt","DIR.kostka","DIR.inne","Pasy.ruchu","Drogi.row.lacznie","Drogi.row.asfalt","Ciagi.lacznie","Ciagi.asfalt")
```
Jeśli chodzi o uzupełnianie brakujących obserwacji, których nie ma tak dużo, wykorzystam korelację. Pokażę to na przykładzie obliczania DIR z kostki/płyt chodnikowych dla Poznania. Na początku tworzę macierz korelacji, aby zobaczyć, która ze zmiennych jest wysoko korelowana ze zmienną DIR.kostka.
```{r}
COR <- cor(dane[,1:11], use = "pairwise.complete.obs")
image(x=seq(nrow(COR)), y=seq(ncol(COR)), z=cor(dane[,1:11], use = "pairwise.complete.obs"), axes=F, xlab="", ylab="")
text(expand.grid(x=seq(dim(COR)[1]), y=seq(dim(COR)[2])), labels=round(c(COR),2))
box()
axis(1, at=seq(nrow(COR)), labels = rownames(COR), las=2)
axis(2, at=seq(ncol(COR)), labels = colnames(COR), las=1)
```
Można zauważyć wysoką korelację między zmienną DIR.kostka a DIR.lacznie (0.88). Poznań posiada tę wartość, więc tworzę wykres, na którym zestawię te dwie wartości, a następnie wyrysuję linię modelu liniowego oraz zaznaczę wartość DIR.lacznie dla Poznania.
```{r}
plot(dane$DIR.lacznie,dane$DIR.kostka)
abline(lm(dane$DIR.kostka ~ dane$DIR.lacznie), col="blue")
abline(v=126)
```
Kolejnym krokiem jest użycie funkcji locator(), po której włączeniu mam możliwość zaznaczenia punktu na wykresie. Zaznaczam punkt przecięcia dwóch linii, następnie kończę funkcję, a ta w konsoli wypisuje koordynaty punktu. Wartość "y" wpisuję jako długość DIR z kostki dla miasta Poznań. Poniżej wypisuję uzupełnione wartości:
```{r}
dane["Poznan","DIR.kostka"] <- 86.7
#Dla DIR.inne posłużyłem się średnią, gdyż zachodzi zbyt niska korelacja
dane["Poznan","DIR.inne"] <- 19.6
dane["Lodz","Drogi.row.lacznie"] <- 134.4
dane["Szczecin","Drogi.row.asfalt"] <- 65.7
dane["Lodz","Drogi.row.asfalt"] <- 71.7
#Wstawiam średnią, zmienna posiada niską korelację z innymi zmiennymi. Wyjątek to Szczecin,
#który posiada brak tylko w jednej z tych dwóch wartości (te dwie zmienne są wysoko skorelowane)
dane[is.na(dane[,"Ciagi.lacznie"]) == TRUE,"Ciagi.lacznie"] <- round(mean(dane$Ciagi.lacznie, na.rm = TRUE),1)
dane["Szczecin","Ciagi.asfalt"] <- 5.8
dane[is.na(dane[,"Ciagi.asfalt"]) == TRUE,"Ciagi.asfalt"] <- round(mean(dane$Ciagi.asfalt, na.rm = TRUE),1)
```
Teraz, gdy dane są kompletne, należy poddać je transformacji, aby nie brać do tworzenia rankingu wartości bezwzględnych i nie faworyzować dużych miast. Większość zmiennych przekształcam jako wyliczenie, ile razy więcej udziału ma w DIR niż pozostałe zmienne wchodzące w jej skład.
```{r}
#dane[,3] - łączna długość DIR, dane[,2] - długość dróg publicznych
dane[,4] <- dane[,4]/(dane[,3]-dane[,4])
dane[,5] <- dane[,5]/(dane[,3]-dane[,5])
dane[,6] <- dane[,6]/(dane[,3]-dane[,6])
dane[,7] <- dane[,7]/(dane[,3]-dane[,7])
for (i in 1:nrow(dane)){
if(dane[i,9] == dane[i,8]){
dane[i,9] <- 1
}
else{
dane[i,9] <- dane[i,9]/(dane[i,8]-dane[i,9])
}
}
dane[,8] <- dane[,8]/(dane[,3]-dane[,8])
dane[,11] <- dane[,11]/(dane[,10]-dane[,11])
dane[,10] <- dane[,10]/(dane[,3]-dane[,10])
dane[,3] <- dane[,3]/dane[,2]
```
Po uzupełnieniu danych oraz ich przekształceniu można przejść do tworzenia rankingu.
###Metoda Hellwiga
Na początku poddam dane standaryzacji i stworzę ramkę danych, która będzie zawierać obliczenia dla rankingu metodą Hellwiga.
```{r}
danee <- dane
for (i in 1:ncol(danee)){
danee[,i] <- (danee[,i] - mean(danee[,i]))/sd(danee[,i])
}
dane2 <- data.frame(matrix(NA,nrow=39,ncol=10))
```
Postanowiłem na dane nałożyć wagi. Ciężko byłoby ustalić je metodą ekspercką, gdyż zmiennych nie jest mało, a ja sam nie jestem specjalistą w zakresie infrastruktury rowerowej. Dlatego też za wagi posłużył mi współczynnik zmienności.
```{r}
wagi <- c(rep(NA, 9))
for (i in 1:9){
wagi[i] <- sd(dane[,i])/mean(dane[,i])
}
suma_wag <- sum(wagi)
```
Policzę teraz odchylenia od wzorca dla każdej ze zmiennej. W moim zbiorze są 3 destymulanty: długość DIR z kostki i długość DIR z innej nawierzchni (najlepszy materiał na DIR to asfalt) oraz łączna długość ciągów pieszo-rowerowych (jest to najgorsza dla rowerzystów możliwość zrealizowania DIR).
```{r}
for (i in 1:nrow(dane)){
dane2[i,1] <- (wagi[1]/suma_wag)*(danee[i,3] - max(danee[,3]))^2
dane2[i,2] <- (wagi[2]/suma_wag)*(danee[i,4] - max(danee[,4]))^2
dane2[i,3] <- (wagi[3]/suma_wag)*(danee[i,5] - min(danee[,5]))^2
dane2[i,4] <- (wagi[4]/suma_wag)*(danee[i,6] - min(danee[,6]))^2
dane2[i,5] <- (wagi[5]/suma_wag)*(danee[i,7] - max(danee[,7]))^2
dane2[i,6] <- (wagi[6]/suma_wag)*(danee[i,8] - max(danee[,8]))^2
dane2[i,7] <- (wagi[7]/suma_wag)*(danee[i,9] - max(danee[,9]))^2
dane2[i,8] <- (wagi[8]/suma_wag)*(danee[i,10] - min(danee[,10]))^2
dane2[i,9] <- (wagi[9]/suma_wag)*(danee[i,11] - max(danee[,11]))^2
dane2[i,10] <- sqrt(sum(dane2[i,1:9]))
}
```
W kolejnym kroku policzę współczynnik Hellwiga oraz przedstawię finalny ranking.
```{r}
d0 <- mean(dane2[,10]) + 2*sd(dane2[,10])
dane2[,10] <- 1 - dane2[,10]/d0
rownames(dane2) <- c("Bialystok", "Bielsko_Biala", "Bydgoszcz", "Bytom", "Chorzow", "Czestochowa", "Dabrowa_Gornicza", "Elblag", "Gdansk", "Gdynia", "Gliwice", "Gorzow_Wlkp", "Grudziadz", "Kalisz", "Katowice", "Kielce", "Koszalin", "Krakow", "Lublin", "Lodz", "Olsztyn", "Opole", "Plock", "Poznan", "Radom", "Ruda_Slaska", "Rybnik", "Rzeszow", "Slupsk", "Sosnowiec", "Szczecin", "Tarnow", "Torun", "Tychy", "Warszawa", "Wroclawek", "Wroclaw", "Zabrze", "Zielona_Gora")
colnames(dane2)[10] <- "Hellwig"
dane2 <- dane2[rev(order(dane2$Hellwig)),]
print(dane2[,"Hellwig", drop=FALSE])
```
Metoda Hellwiga na najlepsze miasta pod względem DIR wskazała Radom, Płock oraz Białystok. Najgorsze miasta według tej metody to Zielona Góra, Elbląg oraz Kalisz.
###Metoda standaryzowanych sum
Na początku zamieniam destymulanty na stymulanty. Do modelu wykorzystam ten sam system wag, co w metodzie Hellwiga, więc nie wprowadzam go ponownie. Dane zestandaryzuję.
```{r}
dane3 <- dane
dane3[,5] <- -dane[,5]
dane3[,6] <- -dane[,6]
dane3[,10] <- -dane[,10]
#Usuwam liczbę ludności i długość dróg publicznych
dane3 <- dane3[,-c(1,2)]
for (i in 1:ncol(dane3)){
dane3[,i] <- (dane3[,i] - mean(dane3[,i]))/sd(dane3[,i])
}
```
Sumuję rangi, a następnie je standaryzuję. Zaraz potem przedstawię ranking miast.
```{r}
for (i in 1:nrow(dane3)){
dane3[i,10] <- sum(dane3[i,1:9]*(wagi/suma_wag))
}
for (i in 1:nrow(dane3)){
dane3[i,11] <- (dane3[i,10] - min(dane3[,10]))/max(dane3[,10] - min(dane3[,10]))
}
colnames(dane3)[11] <- "Wskaznik"
dane3 <- dane3[rev(order(dane3$Wskaznik)),]
print(dane3[,"Wskaznik", drop=FALSE])
```
Można zauważyć, że nie zmienił się koniec rankingu. Miasta z najgorszą DIR to wciąż Zielona Góra, Elbląg oraz Kalisz. Zmieniła się nieco pierwsza trójka: na trzecim miejscu zamiast Białegostoku znalazł się Kraków.
###Metoda sumy rang
Na początku zamieniam stymulanty na destymulanty i standaryzuję wszystkie zmienne, tworzę także ramkę danych na rangi.
```{r}
dane5 <- dane
dane5[,c(1:4,7:9,11)] <- -dane5[,c(1:4,7:9,11)]
for (i in 1:ncol(dane5)){
dane5[,i] <- (dane5[,i] - mean(dane5[,i]))/sd(dane5[,i])
}
dane4 <- data.frame(matrix(NA,nrow=39,ncol=9))
rownames(dane4) <- c("Bialystok","Bielsko_Biala","Bydgoszcz","Bytom", "Chorzow", "Czestochowa", "Dabrowa_Gornicza", "Elblag", "Gdansk", "Gdynia", "Gliwice", "Gorzow_Wlkp", "Grudziadz", "Kalisz", "Katowice", "Kielce", "Koszalin", "Krakow", "Lublin", "Lodz", "Olsztyn", "Opole", "Plock", "Poznan", "Radom", "Ruda_Slaska", "Rybnik", "Rzeszow", "Slupsk", "Sosnowiec", "Szczecin", "Tarnow", "Torun", "Tychy", "Warszawa", "Wroclawek", "Wroclaw", "Zabrze", "Zielona_Gora")
```
Przed wyświetleniem rankingu należy jeszcze zestandaryzować zmienne oraz utworzyć zmienną pozwalającą na useregowanie miast.
```{r}
for (i in 1:ncol(dane4)){
dane4[,i] <- rank(dane5[,i+2])
}
dane4[,10] <- NULL
for (i in 1:nrow(dane4)){
dane4[i,10] <- mean(as.numeric(dane4[i,1:9]))
}
colnames(dane4)[10] <- "Suma rang"
dane4 <- dane4[order(dane4$'Suma rang'),]
print(dane4[,"Suma rang", drop=FALSE])
```
W pierwszej trójce ponownie znalazła się cała czołówka z rankingu wykonanego metodą Hellwiga, chociaż kolejność jest nieco inna. Na pierwszym miejscu znów jest Radom, ale drugie miejsce zajmuje Białystok, a trzecie Płock. Najgorsze miasta w rankingu to Zielona Góra, Tarnów (po raz pierwszy w ostatniej trójce) oraz Elbląg.
###Podsumowanie
Miastami o najlepszej DIR okazały się: **Radom**, **Płock** oraz **Białystok**. Można zauważyć, że Radom wygrał sporą przewagą. W metodzie sumy rang osiągnął wynik 5.22, podczas gdy srebrny medalista tego zestawienia, Białystok, posiadał wskaźnik na poziomie 10.22. W pozostałych metodach blisko Radomia znajdował się Płock i oba te miasta znacząco odbiegały poziomem od pozostałych miast. W metodzie Hellwiga wartości współczynników to 0.46-0.45-0.36 dla 3 pierwszych miejsc, a w metodzie standaryzowanych sum 1-0.93-0.74 (tu też najlepiej widać przewagę Radomia i Płocka). We wszystkich zestawieniach wysoko znajduje się Kraków, który osiągnąłby może lepszy wynik, gdyby nie przedostatnia lokata dla łącznej długości DIR. Ani razu nie opuścił pierwszej dziesiątki, a w metodzie standaryzowanych sum znalazł się na podium, zdobywając trzecie miejsce. Jeśli chodzi o przyczyny zwycięstwa Radomia, nie zajął on ani razu pierwszego miejsca w danej kategorii (wyjątek stanowi długość DIR z innej nawierzchni, gdzie wiele miast zdobyło ex aequo pierwsze miejsce), aczkolwiek zawsze znajdował się wysoko i nieraz zajmował drugie miejsce (np. pod względem długości DIR z kostki). Pod względem liczby zdobytych złotych medali lepiej prezentuje się Płock, który m.in. znacząco wyprzedził konkurencję przy łącznej długość dróg rowerowych (Płock - 18.15, zdobywca drugiego miejsca (Białystok) - 4.69). Nie trzymał się on jednak tak ściśle najlepszych lokat, będąc np. na ostatnim miejscu dla asfaltowych ciągów pieszo-rowerowych.
Jeśli chodzi o drugi koniec tabeli, zajęły go następujące miasta: **Zielona Góra**, **Elbląg** oraz **Kalisz**. Podczas gdy w metodzie sumy rang nie widać znaczącego odstawania w porównaniu do innych miast o najgorszej DIR, pozwala to dostrzec już metoda Hellwiga. Zielona Góra jako jedyna uzyskała współczynnik poniżej zera, odstając o ponad 0.04 od drugiego największego przegranego, Elbląga. Różnicę pozwala dostrzec też metoda standaryzowanych sum. Dwa ostatnie miejsca w rankingu (Zielona Góra oraz Elbląg) plasują się na końcu ze wskaźnikami 0 i 0.12, a trzecie od końca miejsce ma ten wskaźnik na poziomie 0.2. Czemu Zielona Góra występuje zawsze na samym końcu, osiągając najgorsze wyniki spośród wszystkich miast? Przyczyną jest z pewnością ostatnia pozycja tego miasta w łącznej długości ciągów rowerowych. Poza tą zmienną, Zielona Góra raz tylko uplasowała się w końcowej trójce. Jednak zmienna, gdzie Zielona Góra znalazła się na ostatnim miejscu, posiada największą wagę spośród wszystkich zmiennych, a samo miasto znacząco odstaje od pozostałych konkurentów. Co ciekawe, końcówka rankingu dla tej zmiennej wygląda tak samo jak końcówka ogólnego rankingu (brak podobnej zależności dla początku rankingu). Wszystkie z tych miast mocno odbiegają od reszty (Zielona Góra - 12.36, Kalisz - 9.51, Elbląg - 8.4, miasto z 4 miejsca - 4.76).
#Rozdział II: Grupowanie obiektów
###Wprowadzenie
Celem tej części projektu będzie przedstawienie rankingu polskich miast najbardziej przyjaznych rowerzystom.
**Dane: **Dane, podobnie jak w poprzedniej części, pochodzą z magazynu rowerowego "Rowertour" (11/2018), gdzie został przedstawiony ranking miast najbardziej przyjaznych rowerzystom.
Jeśli chodzi o ilość miast, dla których wykonywany będzie ranking, postanowiłem pozostawić oryginalną ich liczbę - 39, co nie odbiega sporo od wymienionej w zadaniu liczby 30. Zestaw danych został wprowadzony już w poprzedniej części projektu, tam też został poddany transformacji, dlatego w tej części projektu nie będę robił tego ponownie.
**Metodologia: **Zmuszony jestem ograniczyć liczbę zmiennych, których w danych można naliczyć dość sporo. Analizę ograniczę do drogowej infrastruktury rowerowej (DIR), w skład której wchodzą następujące zmienne (s - stymulanta, d - destymulanta):
-*DIR.lacznie:* Łączna długość DIR (s)
-*DIR.asfalt:* Długość DIR o powierzchni asfaltowej (s)
-*DIR.kostka:* Długość DIR o powierzchni z kostki/płyt chodnikowych (d)
-*DIR.inne:* Długość DIR o innej powierzchni (d)
-*Pasy.ruchu:* Łączna długość pasów ruchu dla rowerów (s)
-*Drogi.row.lacznie:* Łączna długość dróg dla rowerów (s)
-*Drogi.row.asfalt:* Długość dróg dla rowerów o powierzchni asfaltowej (s)
-*Ciagi.lacznie:* Łączna długość ciągów pieszo-rowerowych (d)
-*Ciagi.asfalt:* Długość ciągów pieszo-rowerowych o powierzchni asfaltowej (s)
###Grupowanie podziałowe
Grupowanie podziałowe pozwoli na zbadanie, które z miast mają zbliżoną do siebie drogową infrastrukturę rowerową. Może się okazać, że miasta będą się grupować wg ich wielkości, co byłoby słabym rozwiązaniem. Mam nadzieję, że przekształcenie danych, które dokonałem w poprzedniej części, wpłynie pozytywnie na rozróżnienie miast przy grupowaniu.
Zanim wykonam grupowanie podziałowe, zbadam, czy dane nadają się do analizy skupień. W tym celu jeszcze raz narysuję macierz korelacji.
Aby zobaczyć, czy nie zachodzi współliniowość, ponownie narysuję macierz korelacji.
```{r}
#Usunięcie z danych zmiennych dotyczących liczby ludności oraz długości dróg publicznych - z tymi danymi miasta przyporządkowałoby pod względem ich wielkości
dane <- dane[,-c(1,2)]
COR <- cor(dane[,1:9])
image(x=seq(nrow(COR)), y=seq(ncol(COR)), z=cor(dane[,1:9]), axes=F, xlab="", ylab="")
text(expand.grid(x=seq(dim(COR)[1]), y=seq(dim(COR)[2])), labels=round(c(COR),2))
box()
axis(1, at=seq(nrow(COR)), labels = rownames(COR), las=2)
axis(2, at=seq(ncol(COR)), labels = colnames(COR), las=1)
```
W żadnym przypadku nie zachodzi nierówność |r| > 0.9. Ma na to wpływ przetransformowanie zmiennych, gdyż dla surowych danych takich korelacji było dość sporo. Pozostaje zbadać jeszcze współczynnik zmienności.
```{r}
for (i in 1:9){
print(paste(colnames(dane)[i], ": ", (sd(dane[,i])/mean(dane[,i]))*100, sep=''))
}
```
Również i ten warunek jest spełniony, dla żadnej ze zmiennych współczynnik nie spada poniżej 10%.
Założenia są spełnione, więc poddam teraz dane normalizacji, do czego wykorzystam standaryzację.
```{r}
for (i in 1:ncol(dane)){
dane[,i] <- (dane[,i] - mean(dane[,i]))/sd(dane[,i])
}
```
Sprawdzić należy, czy nie ma wartości odstających (<-3 lub >3).
```{r}
summary(dane)
```
Okazuje się, że istnieją outliery (zmienne DIR.kostka, Drogi.row.lacznie, Drogi.row.asfalt, Ciagi.lacznie oraz Ciagi.asfalt). Postanowiłem jednak nic z nimi nie robić. Dane przedstawiają DIR w wybranych miastach i naturalnym jest, że któreś miasto może być w jednej cesze znacznie lepsze lub gorsze względem innych i daleko odstawać na tym polu (np. przypadek Zielonej Góry w I części projektu).
Wykonam teraz grupowanie podziałowe trzema metodami: metodą k-średnich, algorytmem PAM (opartym o metodę k-medoid) oraz algorytmem CLARA (oparty również o metodę k-medoid, bazujący jednak na reprezentatywnej próbie).
##Metoda k-średnich
**UWAGA!** Nie wiem dlaczego, ale podczas tworzenia pliku HTML wykres ten uległ zmianie i nie mogę go przywrócić do porządku. Za każdym razem inaczej wykonuje porządkowanie. W ostatecznym wyniku jest dokładnie ten sam kod i daje on właściwy rezultat, więc komentarz pod niżej wykonanym wykresem odnosi się do wykresu wykonanego później, przy podaniu najlepszego wyniku.
Liczbę skupień na podstawie prób ustaliłem na liczbę 4, która moim zdaniem najlepiej ukazuje różnice między miastami: grupy nie przecinają się, łatwo jest o interpretację.
```{r, warning=FALSE, message=FALSE}
library(factoextra)
```
```{r}
xx <- kmeans(dane, 4, iter.max = 10)
fviz_cluster(xx, data = dane)
```
Metoda ta dobrze komponuje się z rankingiem wykonanym przeze mnie w pierwszym rozdziale. Wykres dobrze przedstawia zróżnicowanie miast.
##Algorytm PAM
W przypadku odległości euklidesowej, za najlepszą liczbę skupień ustaliłem liczbę 5, bo przy liczbie 4 powstaje zbyt duża grupa, w której skład wchodzi grupa czerwona i zielona.
```{r, warning=FALSE, message=FALSE}
library(cluster)
xx <- pam(dane, 5, metric = "euclidean")
fviz_cluster(xx, data = dane)
```
Wykres jest mniej czytelny niż jego poprzednik, wydaje się, że grupa fioletowa oraz oliwkowa są niepotrzebne, gdyż nie wydają się być odrębne od reszty. Grupy te jednak utrzymają się bez względu na to, jaką liczbę da się liczbę do algorytmu.
W przypadku odległości miejskiej, wróciłem do liczby 4, gdyż liczba 5 jest zbyt duża, wykres jest mniej czytelny.
```{r}
xx <- pam(dane, 4, metric = "manhattan")
fviz_cluster(xx, data = dane)
```
Grupa fioletowa zawiera grupę niebieską, co nie wygląda przejrzyście. Dobrze z kolei zostały rozdzielone miasta w dolnym lewym rogu.
##Algorytm CLARA
Podobnie jak przy algorytmie PAM, tutaj też ustawiłem liczbę 5. Liczbę reprezentatywnej próby ustaliłem na 20, gdyż od 25-30 wykres dla tego algorytmu wygląda identycznie jak wykres dla algorytmu PAM.
```{r}
xx <- clara(dane, 5, metric = "euclidean", samples = 5, sampsize = 20)
fviz_cluster(xx, data = dane)
```
Niepokoi przemieszanie grup fioletowej, czerwonej oraz zielonej. Całkiem sensowne wydają się być grupa oliwkowa oraz grupa niebieska.
Dla odległości miejskiej najlepiej prezentuje się liczba 3, chociaż klastry są i tak przemieszane i trudno jest o przejrzystość wykresu.
```{r}
xx <- clara(dane, 3, metric = "manhattan", samples = 5, sampsize = 20)
fviz_cluster(xx, data = dane)
```
##Podobieństwa i różnice
Na pierwszy rzut oka widać, że dla każdej z metod ustaliłem inną liczbę grup. Wynika to stąd, że każdy algorytm bazuje na czymś innym, więc trudno o z góry określoną liczbę, która najlepiej zadziała dla wszystkich algorytmów. Problemem jest też czytelność. Są wykresy, z których ciężko jest wyczytać, do której grupy należy miasto.
Za najlepsze metody dla moich danych uważam metodę k-średnich oraz algorytm PAM z odległością euklidesową. Finalnie do analizy zdecydowałem się wziąć metodę k-średnich.
##Omówienie ostatecznego wyniku
```{r}
xx <- kmeans(dane, 4, iter.max = 10)
fviz_cluster(xx, data = dane)
```
Można zauważyć, że miasta nie są grupowane względem ich wielkości, w pojedynczym klastrze można znaleźć zarówno jedno z miast aglomeracyjnych, jak i mniejsze miasta (np. Kraków i Zabrze w pierwszej grupie).
Poniżej sprawdzę, czym charakteryzują się dane podgrupy.
```{r}
podsumowanie <- data.frame(matrix(NA, nrow = 9, ncol = 4))
for (i in 1:4){
for (j in 1:9){
podsumowanie[j,i] <- lapply(dane[names(which(xx$cluster == i)),], mean)[[j]]
}
round(podsumowanie[,i],2)
}
colnames(podsumowanie) <- c(1:4)
rownames(podsumowanie) <- colnames(dane)
print(podsumowanie)
```
**Pierwsza grupa: **Dość dobra infrastruktura, jednak najmniej rozwinięta w stosunku do wielkości całego miasta: słabo rozwinięta DIR, jeśli chodzi o jej łączną długość; duży udział pasów ruchu w ogólnej infrastrukturze rowerowej; mały udział ciągów pieszo-rowerowych w DIR.
**Druga grupa: **Najlepsza DIR, chociaż niezbyt rozwinięta wielkościowo - udział dróg z asfaltu jest tu największy, mało jest dróg z kostki i innych surowców; dużo dróg rowerowych (w tym także tych asfaltowych); mało ciągów pieszo-rowerowych (jeśli się takie pojawiają, są często wykonane z asfaltu).
**Trzecia grupa: **Najlepiej rozwinięta wielkościowo DIR, jednak o niezbyt dobrej jakości; największy udział dróg z innego surowca w DIR; najmniejszy udział pasów ruchu i dość mała długość dróg rowerowych, które zastępowane są przez ciągi pieszo-rowerowe.
**Czwarta grupa: **Obejmuje tylko 2 miasta, posiadają one najsłabszą jakościowo DIR; najmniej dróg z asfaltu i duża ilość dróg z kostki, a to zapewne z powodu największego udziału ciągów pieszo-rowerowych w DIR; najmniejsza długość dróg rowerowych
Podsumowując, grupy można opisać następująco:
**Pierwsza grupa: **Dość dobre warunki jazdy, jednak zdecydowanie za mało rozwinięta infrastruktura.
**Druga grupa: **Najlepsze warunki do jazdy, jednak nie za bardzo jest gdzie pojeździć.
**Trzecia grupa: **Niezbyt dobre warunki jazdy, za to można bezproblemowo poruszać się rowerem po całym mieście.
**Czwarta grupa: **Najgorsze warunki jazdy, jednak można rowerem zwiedzić większy kawałek miasta.
To, jaka grupa jest najlepsza, zależy od naszych preferencji, jednak najbardziej optymalne warunki jazdy panują moim zdaniem w miastach z grupy trzeciej. Należy pamiętać, że gorsza jakość infrastruktury nie oznacza, że drogi są pełne dziur, a krawężniki są bardzo wysokie - gorszą infrastrukturą z punktu widzenia całości DIR są np. ciągi pieszo-rowerowe, które jednak same w sobie nie są tak złym rozwiązaniem lda rekreacyjnej jazdy.
###Grupowanie hierarchiczne
Zajmę się teraz grupowaniem hierarchicznym, które, tak jak i grupowanie podziałowe, pozwoli na zbadanie, które z miast mają zbliżoną do siebie drogową infrastrukturę rowerową. W poprzedniej części odeszły obawy dotyczące tego, że miasta grupować się będą względem wielkości. Zostały również sprawdzone założenia dobrego grupowania, a dane zostały zestandaryzowane. Tym samym można pominąć tą część i przystąpić od razu do grupowania hierarchicznego.
Na początku wybiorę standardową funkcję odległości - odległość euklidesową, a następnie stworzę dendogramy dla kilku metod.
```{r, fig.show='hold', out.width='50%'}
plot(hclust(dist(dane),"single"), main = "Metoda najbliższego sąsiada")
plot(hclust(dist(dane),"complete"), main = "Metoda najdalszego sąsiada")
plot(hclust(dist(dane),"centroid"), main = "Metoda centroidalna")
plot(hclust(dist(dane),"ward.D"), main = "Metoda Warda")
```
Moim zdaniem, zarówno metoda najbliższego sąsiada jak i metoda centroidalna mają zbyt dużo skupisk, przez co wykres jest mało czytelny i liczba powstałych grup jest zbyt duża. Znacznie lepiej prezentuje się metoda najdalszego sąsiada oraz metoda Warda, w których łatwo jest wydzielić powstałe grupy.
Zamienię teraz funkcję odległości z euklidesowej na miejską.
```{r, fig.show='hold', out.width='50%'}
plot(hclust(dist(dane, method = "manhattan"),"single"), main = "Metoda najbliższego sąsiada")
plot(hclust(dist(dane, method = "manhattan"),"complete"), main = "Metoda najdalszego sąsiada")
plot(hclust(dist(dane, method = "manhattan"),"centroid"), main = "Metoda centroidalna")
plot(hclust(dist(dane, method = "manhattan"),"ward.D"), main = "Metoda Warda")
```
Sytuacja wygląda podobnie jak przy metodzie euklidesowej, ponownie dwie metody są czytelne, a dwie nie. Zmienia się podział jeśli chodzi o większe grupy, jednak w mniejszych grupach wygląda to podobnie.
Trzecią z miar odległości będzie odległość Minkowskiego (dla p = 3).
```{r, fig.show='hold', out.width='50%'}
plot(hclust(dist(dane, method = "minkowski", p = 3),"single"), main = "Metoda najbliższego sąsiada")
plot(hclust(dist(dane, method = "minkowski", p = 3),"complete"), main = "Metoda najdalszego sąsiada")
plot(hclust(dist(dane, method = "minkowski", p = 3),"centroid"), main = "Metoda centroidalna")
plot(hclust(dist(dane, method = "minkowski", p = 3),"ward.D"), main = "Metoda Warda")
```
Wydaje się, że odległość Minkowskiego jest najgorsza spośród wszystkich, każdy z wykresóW jest dość mocno spiętrzony, przez co trudno jest wydzielić pojedyńcze grupy.
##Podobieństwa i różnice
Jak to już zostało wspomniane, pokazane metody można podzielić na te łatwe do pogrupowania (metoda najdalszego sąsiada oraz Warda), jak i te, w których miasta są mocno spiętrzone (metoda najbliższego sąsiada i centroidalna). To są właśnie różnice i podobieństwa, które wpływają na to, którą metodę uznać za lepszą. Pod względem użytych miar odległości, poza odległością Minkowskiego, która daje spiętrzone dendogramy, nie ma sporej różnicy w klasyfikacji miast. Na potrzeby projektu zdecydowałem się na metodę Warda (częściej stosowana w praktyce niż metoda najdalszego sąsiada) oraz standardową odległość euklidesową.
##Omówienie ostatecznego wyniku
```{r}
plot(hclust(dist(dane),"ward.D"), main = "Metoda Warda")
```
Można zauważyć, że podobnie jak przy analizie podziałowej, nie ma problemu łączenia się dużych miast w jedną grupę. Mamy np. w jednej grupie Wrocław oraz Rybnik, a miasta te znacząco się od siebie różnią liczbą mieszkańców jak i długością dróg.
Jeśli chodzi o liczbę skupień, moim zdaniem odpowiednia liczba to 6, a cięcie byłoby wykonane w okolicy liczby 8, zaraz po tym, jak Płock dołączy do grupy Bielsko-Białej, Krakowa oraz Radomia. Najliczniejszą z grup byłaby wtedy grupa najbardzie po prawej, od Grudziądza do Krakowa. Zauważyć można, że najbardziej od reszty odstają Płock, Bielsko Biała, Kraków oraz Radom. Pokrywa się to z wykonanym wcześniej wykresem grupowania podziałowego, gdzie miasta te były położone najbardziej na lewo. Nie tylko w tym aspekcie przejawia się podobieństwo względem wcześniejszego wykresu. Widać, że często grupują się ze sobą miasta, które były blisko siebie przy wykresie k-means (w jednej, najmniejszej grupie są np. Elbląg oraz Tarnów, które razem stanowiły osobny klaster). Na dendogramie widać, że miastami, które najbardziej odstają od reszty, są miasta najlepsze oraz najgorsze zarówno z rankingu w I części, jak i w analizie podziałowej oraz na samym wykresie, gdzie zajmują pozycje najbardziej na lewo oraz najbardziej na prawo.
###Podsumowanie
Można zauważyć, że działając różnymi metodami można dojść do podobnych wniosków. Daje się wyłonić miasta, które są najlepsze dla rowerzystów, jak i takie, które są dla nich najgorsze. Kluczem jest jednak wybór odpowiedniej metody jak i dobór np. miary odległości, które choć zbliżone, mogą dać odmienne rezultaty.