Dane

Dane nt koloru nadwozie nowozarejestrowanych samochodów w Szwecji pobrano ze strony https://transportstyrelsen.se/sv/Nyhetsarkiv/2019/vitt-nu-vanligare-an-svart-i-sverige/

Dane ręcznie zamieniono na plik csv, który wczytujemy poleceniem:

o <- read.csv(file='szwecja_kolory_samochodow.csv', sep=';', header=T)

Plik ma 24 wierszy, co odpowiada 24 kolorom. Kolory są następujące

levels(o$kolor)
##  [1] "biały"           "brązowy"         "ciemnobrązowy"   "ciemnoczerwony" 
##  [5] "ciemnoniebieski" "ciemnoszary"     "ciemnozielony"   "czarny"         
##  [9] "czerwony"        "fioletowy"       "jasnobrÄ…zowy"    "jasnoniebieski" 
## [13] "jasnoszary"      "jasnozielony"    "jasnożółty"      "niebieski"      
## [17] "nieznany"        "pomarańczowy"    "różowy"          "srebrny"        
## [21] "szary"           "wielobarwny"     "zielony"         "żółty"

Zawartość pliku można przedstawić w postaci następującej tabeli:

library(knitr)
carsNo2019 <- sum(o$y2019)
carsNo2016 <- sum(o$y2016)
print (carsNo2019)
## [1] 6243511
o <- o %>% mutate(y2019f = y2019/carsNo2019 *100, y2016f = y2016/carsNo2016 *100 )
kable(o,  
      col.names = c('Farg', 'Kolor', '2016', '2019', 'Różnica', '2016%', '2019%'))
Farg Kolor 2016 2019 Różnica 2016% 2019%
Vit biały 791199 987073 195874 15.8095821 13.2046171
Svart czarny 835933 932864 96931 14.9413367 13.9511996
Grå szary 600007 692040 92033 11.0841480 10.0137420
Ljusgrå jasnoszary 451165 380375 -70790 6.0923253 7.5296620
Mörkgrå ciemnoszary 221661 244765 23104 3.9203102 3.6993836
Röd czerwony 662221 650194 -12027 10.4139161 11.0520548
Mörkröd ciemnoczerwony 169826 141614 -28212 2.2681789 2.8342899
Silver srebrny 533380 559892 26512 8.9675825 8.9017790
Blå niebieski 439172 433366 -5086 6.9410625 7.3295063
Ljusblå jasnoniebieski 127643 122209 -5434 1.9573762 2.1302819
Mörkblå ciemnoniebieski 307900 272688 -35212 4.3675426 5.1386587
Brun brÄ…zowy 91956 99197 7241 1.5888016 1.5346882
Ljusbrun jasnobrÄ…zowy 167352 164004 -3348 2.6267912 2.7930003
Mörkbrun ciemnobrązowy 18262 20860 2598 0.3341069 0.3047814
Grön zielony 131349 115143 -16206 1.8442027 2.1921328
Mörkgrön ciemnozielony 121162 94667 -26495 1.5162462 2.0221181
Ljusgrön jasnozielony 76711 67112 -9599 1.0749080 1.2802587
Flerfärgad wielobarwny 67089 74695 7606 1.1963621 1.1196735
Okänd nieznany 32211 52799 20488 0.8456620 0.5375815
Gul żółty 55744 51479 -4265 0.8245200 0.9303325
Ljusgul jasnożółty 28472 25583 -2889 0.4097534 0.4751799
Ljusröd różowy 33499 29045 4454 0.4652030 0.5590774
Orange pomarańczowy 16208 20416 4208 0.3269955 0.2705014
Lila fioletowy 11714 11431 -283 0.1830861 0.1954993 
##o

Redukujemy liczbę kolorów do podstawowych:

o <- o %>% mutate(kolor=recode(kolor, bialy="bialy",
    szary="szary", jasnoszary="szary",ciemnoszary="szary",
    brÄ…zowy='brÄ…zowy', jasnobrÄ…zowy='brÄ…zowy', ciemnobrÄ…zowy='brÄ…zowy',
    niebieski='niebieski', jasnoniebieski='niebieski', ciemnoniebieski='niebieski',
    zielony='zielony', jasnozielony='zielony', ciemnozielony='zielony',
    czerwony='czerwony', ciemnoczerwony='czerwony',
    żółty="żółty", jasnożółty='żółty'
    ))

Teraz kolorów jest 14:

levels(o$kolor)
##  [1] "biały"        "brązowy"      "czerwony"     "niebieski"    "szary"       
##  [6] "zielony"      "czarny"       "fioletowy"    "żółty"        "nieznany"    
## [11] "pomarańczowy" "różowy"       "srebrny"      "wielobarwny"

Usuwamy kolor nieznany:

o <- o %>% filter (kolor != 'nieznany')

Wykres słupkowy

p1 <- o %>% group_by(kolor)%>% summarise(y2019=sum(y2019)) %>%
  ggplot(aes(x = reorder(kolor, y2019 ))) +
  geom_bar(aes(y = y2019 ), stat="identity", alpha=.25, fill=default_cyan ) +
  xlab(label="kolor") +
  ylab(label="liczba") +
  ggtitle("Kolory nowych samochodów w Szwecji 2019") +
  ##
  theme(axis.text = element_text(size = 8)) +
  theme(plot.title = element_text(hjust = 0.5)) +
  coord_flip()
## `summarise()` ungrouping output (override with `.groups` argument)
p1

Dodanie etykiet z wartościami

p1t <- p1 + 
  geom_text(aes(label=sprintf("%.0f", y2019), y= y2019 ), 
            vjust=0.25, hjust=1.25, size=2, color='brown3' )
p1t

Słupki odpowiadające niskim wartościm wyglądają tak sobie. Można usunąć np etykiety dla wartości mniejszych niż 50 tys.

#qq <- o %>% group_by(kolor)%>% summarise(y2019=sum(y2019)) %>%
#  mutate(y2019t = y2019) %>% 
#  mutate ( y2019t = replace(y2019t, which( y2019t < 50000), NA))

# wartości mniejsze od 50 tys zmień na NA
p1x <- o %>% group_by(kolor)%>% summarise(y2019=sum(y2019)) %>%
  mutate(y2019t = y2019) %>% 
  mutate ( y2019t = replace(y2019t, which( y2019t < 50000), NA)) %>%
  ggplot(aes(x = reorder(kolor, y2019 ))) +
  geom_bar(aes(y = y2019 ), stat="identity", alpha=.25, fill=default_cyan ) +
  xlab(label="kolor") +
  ylab(label="liczba") +
  ggtitle("Kolory nowych samochodów w Szwecji 2019") +
  ##
  theme(axis.text = element_text(size = 8)) +
  theme(plot.title = element_text(hjust = 0.5)) +
  ##
  geom_text(aes(label=sprintf("%.0f", y2019t), y= y2019t ), 
              vjust=0.25, hjust=1.25, size=2, color='brown3' ) +
  ##
  coord_flip()
## `summarise()` ungrouping output (override with `.groups` argument)
p1x

pie chart (wykres kołowy)

Popularny ale niezalecany. Trudno nawet powiedzieć czemu używany, bo wykres słupkowy jest od niego lepszy pod każdym względem

library(RColorBrewer)
#mycols <- brewer.pal(14, "Set1")
mycolors <- c(szary='darkgray', biały='white', 
              czarny='black', niebieski='blue', czerwony='red', 
              srebrny='whitesmoke', brÄ…zowy='tan4', zielony='limegreen', 
              żółty='yellow', wielobarwny='darkturquoise', różowy='hotpink', 
              pomarańczowy='darkorange', fioletowy='darkviolet')
#mycolors = c(brewer.pal(name="Dark2", n = 8), brewer.pal(name="Paired", n = 6))

p2 <- o %>% group_by(kolor)%>% summarise(y2019=sum(y2019)) %>%
  mutate(ypos = cumsum(y2019) - 0.5*y2019) %>%
  arrange(desc(kolor)) %>%
  ggplot(aes(x = "" )) +
  geom_bar(aes(y = y2019, fill=kolor ), width=1, stat="identity", color="blue") +
  #xlab(label="kolor") +
  #ylab(label="liczba") +
  scale_fill_manual(values = mycolors) +
  geom_text(aes(y = ypos, label = y2019), color = "black", size=3) +
  ggtitle("Kolory nowych samochodów w Szwecji 2019") +
  coord_polar("y", start = 0) +
  theme_void()

p2

Przy większej od 6 liczbie kategorii w zasadzie nieczytelny (co widać)

Porównanie 2016 vs 2019

#oo <- o %>% group_by(kolor)%>% summarise(y2019=sum(y2019), y2016=sum(y2016))
## porównanie pomiędzy dwoma latami
p3 <- o %>% group_by(kolor)%>% summarise(y2019=sum(y2019), y2016=sum(y2016)) %>%
  #pivot_longer(cols = c(y2019, y2016), names_to = "rok", values_to = "value") %>%
  ggplot(aes(x = reorder(kolor, y2019 ))) +
  geom_point(aes(y = y2019, color='y2019' ), alpha=.25 ) +
  geom_point(aes(y = y2016, color='y2016' ), alpha=.25 ) +
  xlab(label="kolor") +
  ylab(label="liczba") +
  ggtitle("Kolory nowych samochodów w Szwecji 2019") +
  ## labels jest zbędne
  scale_color_manual(name="", labels =c(y2019="y2019", y2016="y2016"),
                     values = c(y2019="red", y2016="blue" ) ) +
  ##
  theme(axis.text = element_text(size = 8)) +
  theme(plot.title = element_text(hjust = 0.5)) +
  coord_flip()
## `summarise()` ungrouping output (override with `.groups` argument)
p3

Porównywanie wykresów kołowych to beznadziejna sprawa:

p2b <- o %>% group_by(kolor)%>% summarise(y2016=sum(y2016)) %>%
  mutate(ypos = cumsum(y2016) - 0.5*y2016) %>%
  arrange(desc(kolor)) %>%
  ggplot(aes(x = "" )) +
  geom_bar(aes(y = y2016, fill=kolor ), width=1, stat="identity", color="blue") +
  #xlab(label="kolor") +
  #ylab(label="liczba") +
  scale_fill_manual(values = mycolors) +
  geom_text(aes(y = ypos, label = y2016), color = "black", size=3) +
  ggtitle("Kolory nowych samochodów w Szwecji 2016") +
  coord_polar("y", start = 0) +
  theme_void()

p2ab <- ggarrange(p2, p2b, ncol= 2, nrow = 1)
p2ab

Udziały zamiast liczebności

Zamiast liczebności można używać udziałów w całości (popularnie zwanych procentami)

p4 <- o %>% group_by(kolor)%>% summarise(y2019=sum(y2019), y2016=sum(y2016)) %>%
  mutate(y2019 = y2019/carsNo2019 *100, y2016 = y2016/carsNo2016 *100 ) %>%
  #pivot_longer(cols = c(y2019, y2016), names_to = "rok", values_to = "value") %>%
  ggplot(aes(x = reorder(kolor, y2019 ))) +
  geom_point(aes(y = y2019, color='y2019' ), alpha=.25 ) +
  geom_point(aes(y = y2016, color='y2016' ), alpha=.25 ) +
  xlab(label="kolor") +
  ylab(label="%") +
  ggtitle("Kolory nowych samochodów w Szwecji 2019") +
  ## labels jest zbędne
  scale_color_manual(name="", labels =c(y2019="y2019", y2016="y2016"),
                     values = c(y2019="red", y2016="blue" ) ) +
  ##
  theme(axis.text = element_text(size = 8)) +
  theme(plot.title = element_text(hjust = 0.5)) +
  coord_flip()
p4

Wykres kołowy jeszcze raz (trochę lepiej bo liczby niższe)

p5 <- o %>% group_by(kolor)%>% summarise(y2019=sum(y2019)) %>%
  mutate(y2019 = y2019/carsNo2019 *100 ) %>%
  arrange(desc(kolor)) %>%
  mutate(ypos = cumsum(y2019) - 0.5*y2019) %>%
  ggplot(aes(x = "" )) +
  geom_bar(aes(y = y2019, fill=kolor, ), color='blue', width=.5, stat="identity") +
  #xlab(label="kolor") +
  #ylab(label="liczba") +
  scale_fill_manual( values = mycolors ) +
  geom_text(aes(y = ypos, label = sprintf("%.1f", y2019)), color = "black", size=3) +
  ggtitle("Kolory nowych samochodów w Szwecji 2019") +
  coord_polar("y", start = 0) +
  theme_void()

p5