---
tags: AT_DH_2022
---

# Visualiseerimise koduülesanne (tähtaeg 17.11 südaöö)

Ülesandeks on teha üks graafik, mis vastab järgmistele tingimustele:
- andmeteks võib olla nii harjutustes kasutatud kui oma andmed
- alusena võib kasutada harjutusi, aga sel juhul tuleb muuta tuleb vähemalt nelja asja (sh nt geomid, nende parameetrid, tunnused aes'is, andmestik, theme)
- graafik tuleb teha kasutades ggplot2'te, tegemiseks kasutatud kood peab samuti olema esitatud, ja võimalusel reprodutseeritav
- graafikul peab juures olema juures seletus, mida seal on kujutatud - mis tunnustele vastavad teljed, värvid jne, ja mis on graafiku üldine "point" mida lugeja peaks sealt välja lugema; sisuliselt sama, mis akadeemilistes publikatsioonides graafiku allkiri (figure caption).

Esitada sellises vormis:

# Nimi

## Graafik

## Seletus

## Kood

library(ggplot2)

---
# Margus

## Graafik

## Seletus
Graafikul on kujutatud eeldatav eluea pikkus kontinentide lõikes, riikide keskmine musta joonega ning hall ala näitab suurima ja vähima eelatava elueaga riigi vahet. Märkimist väärib nii alumise kui ülemisi piiri trend kui ka keskmise kaugus piiridest ja alumise-ülemise vahe ning selle muut ajas.
## Kood

library(dplyr, warn.conflicts = F)
library(tidyr)
library(ggplot2)
library(gapminder)

lifeExpMinMax <- gapminder %>% 
  arrange(lifeExp) %>% 
  group_by(year,continent) %>% 
  slice(c(1,n())) %>% 
  mutate(lifeExpMinMax =if_else(rank(lifeExp) == 1, "country_min", "country_max")) %>% 
  ungroup() %>% 
  select(country, continent, year, lifeExpMinMax) %>% 
  pivot_wider(names_from = lifeExpMinMax, values_from = country)

lifeExp <- gapminder %>% 
  group_by(continent, year) %>% 
  summarise(
    lifeExp_min = min(lifeExp),
    lifeExp_max = max(lifeExp),
    lifeExp_mean = mean(lifeExp),
    ) %>% 
  ungroup() %>% 
  left_join(lifeExpMinMax)
lifeExp
#> # A tibble: 60 × 7
#>    continent  year lifeExp_min lifeExp_max lifeExp_mean country_min  country_max
#>    <fct>     <int>       <dbl>       <dbl>        <dbl> <fct>        <fct>      
#>  1 Africa     1952        30          52.7         39.1 Gambia       Reunion    
#>  2 Africa     1957        31.6        58.1         41.3 Sierra Leone Mauritius  
#>  3 Africa     1962        32.8        60.2         43.3 Sierra Leone Mauritius  
#>  4 Africa     1967        34.1        61.6         45.3 Sierra Leone Mauritius  
#>  5 Africa     1972        35.4        64.3         47.5 Sierra Leone Reunion    
#>  6 Africa     1977        36.8        67.1         49.6 Sierra Leone Reunion    
#>  7 Africa     1982        38.4        69.9         51.6 Sierra Leone Reunion    
#>  8 Africa     1987        39.9        71.9         53.3 Angola       Reunion    
#>  9 Africa     1992        23.6        73.6         53.6 Rwanda       Reunion    
#> 10 Africa     1997        36.1        74.8         53.6 Rwanda       Reunion    
#> # … with 50 more rows

lifeExp %>% 
  ggplot(aes(x=year)) +
  geom_ribbon(aes(ymin = lifeExp_min, ymax = lifeExp_max), fill = "gray90", 
              alpha = .5, outline.type = "lower", color = "red", linewidth = .1) +
  geom_line (aes(y = lifeExp_mean), alpha = 0.5) +
  geom_point(aes(y = lifeExp_max), size = .2) +
  geom_text (aes(y = lifeExp_max, label = abbreviate(country_max,8)), nudge_y = 6) +
  geom_point(aes(y = lifeExp_min), size = .2, color = "red") +
  geom_text (aes(y = lifeExp_min, label = abbreviate(country_min,8)), nudge_y = -6) +
  facet_grid(continent ~ .) +
  scale_x_continuous(breaks = seq(1952, 2007, by = 5), minor_breaks = NULL) +
  scale_y_continuous(minor_breaks = NULL) +
  labs(x = "Year", y = "Life expectancy at birth [years] ",   
       caption = "Fig1: mean life expectancy across continenets (black)
       with highest (top of the band) and lowest (red) values & contries.
       Gapminder dataset.") +
  theme_bw() +
  theme(strip.background = element_rect(fill = NA),
        panel.spacing = unit(1, "lines"),
        panel.border = element_rect(color = NA)) +
  NULL

---
# Nimi
Marti
## Graafik

## Seletus
Pildil on kujutatud USA presidentide inauguratsioonikõnedes kasutatud sõnade esinemise sageduse omavahelisi seoseid kasutades kahte sünteetilist skaalat millel otsene sisu puudub (kollased ringid, ringide suurus näitab sõna esinemissagedust kõige sagedasemal aastal) ning konkreetsete sõnade esinemist ajas (mida tumedam on sõna värv seda kaugemal minevikus paikneb selle sõna maksimaalse esinemissageduse aasta ja vastupidi, mida heledam on sõna värv seda lähemal minevikus paikneb selle sõna maksimaalse esinemissageduse aasta)
Sõnatüvede värvi varieerumine ning paiknemine koordinaatteljestikul näitab, et 2000nate paiku kõige sagedamini kasutatud sõnad erinevad 1800ndate ja 1900ndate paiku kasutatavatest sõnadest. 2000ndatel kõige sagedamini kasutatud sõnadest kõige suurem osakaal asub üleval vasakul, vähesed joonise keskkohast paremal; 1990ndatel ja 1800ndatel kõige saadamini kasutatud sõnadest enamik asub joonise keskkohast paremal ja vertikaalteljel pigem keskel.

Jooniselt punktide värv ei varieeru koos ajaga, sest selle infokihi lisamine pildile tundus tegevat pildi liiga kirjuks (subjektiivne mulje muidugi), see info on edastatud ainult sõnade värvi kaudu (ehkki konkreetsete sõnade valik joonisele on juhuslik, ei halvenda see asjaolu ajaperioodi edasiandmise funktsiooni). Kollase, halli ja sinise kasutamine on erinevate värvilahenduste katsetamise tulemus, tundus visuaalselt kõige lihtsamini hoomatav (subjektiivne kogemus muidugi). Samuti on ajavahemiku jagamine 9-aastakuteks mitte dekaadideks ning kahe sõna valimine igast 9-aastakust katsetamise ja subjektiivse eelistuse tagajärg.
Üldiselt on sellise infokoguse edastamine ühel pildil paremini saavutatav plotly kasutamisega. Sel juhul saab staatilise pildi jätta suhteliselt lihtsaks ja hoomatavaks ning iga andmepunkti üksikasjad on kättesaadavad kuvatavatel siltidel. Ja kokkuvõttes on tulemus parem st edastada soovitavast infost jõuab suurem osa suurema tõenäosusega vaatajale kohale.
## Kood
parsed_words = # andmete ettevalmistamine visualiseerimiseks, praegusel juhul 1) tokeniseerimine (1.1 numbrite eemaldamine, 1.2 punktuatsiooni eemaldamine) 2) suurtähed väiketähtedeks, 3) stem-ine, 4) stoppsõnade eemaldamine (standardnimekirjale on lisatud mõned), 5) harvaesinevate sõade eemaldamine 6) smoothing 7) dokumendi pikkuse suhtes normaliseerimine 8) sageduste log-skaalale viimine 9) transponeerimine
data_corpus_inaugural %>%
tokens(remove_numbers = T, remove_punct = T) %>%
dfm(tolower = T) %>%
dfm_wordstem() %>%
dfm_remove(c(stopwords('english'),
"can", "may", "every", "*ly"), valuetype="glob") %>%
dfm_trim(min_termfreq = 10) %>% # exclude very low frequency words
dfm_smooth() %>% # smoothing, for later log-transform
dfm_weight("prop") %>% # normalize by document (which have different lengths)
dfm_weight(scheme="logcount", force=T) %>%
t() %>% as.matrix()

coords2 = umap(parsed_words)$layout %>% as.data.frame() # kahemõõtmelisel koordinaatteljestikul väärtuste arvutamine; kuigi dimensioonidel ei ole eraldi sisulist tähendust, saab neid kasutada sõnade koos esinemise kirjeldamiseks
metadata = summary(data_corpus_inaugural) # tekstikorpuse metaandmete objekt

coord_metadata = coords2 %>%
mutate(word=rownames(.)) %>%
mutate(maxvalue = apply(parsed_words, 1, max)) %>%
mutate(maxyear = metadata$Year[ apply(parsed_words, 1, function(x) which.max(x)) ] #aasta, mil mingi sõna esines maksimaalne arv kordi
) %>%
mutate(topspeeches = apply(parsed_words, 1, function(x) metadata$Text[head(order(x, decreasing = T),3)] %>% # kõige sagedamini esinev sõna esimesena
paste(collapse=", ") )
) %>%
mutate(topspeeches = paste(word, "\n", topspeeches))

gr <- ggplot(data=coord_metadata, # andmed on coord_metadata, mis on UMAP funktsiooni kasutades leitud
aes(V1, V2, color=maxyear, label=word, size=maxvalue))+ #aesthetics kiht, mis teeb mitut asja. 1) paneb punkti koordinaatide V1 ja V2 vastavate väärtustega kohale 2) värvib seal punktis oleva punkti märgistuse (mis praegu on geom_point) kui sõnad maxyear järgi st selle aasta järgi kui sõna esines kõige suurem arv kordi
geom_point(data=coord_metadata, alpha=0.1, color = "yellow")+ #punktide kiht, läbipaistvusega 0.1, mis on suur. suur läbipaistvust on vajalik, sest pildil on palju infot koos (sõnad + ringid)
scale_radius(guide="none", range = c(1,16))+ # puntkikihi punkti suurus, raadius varieerub vahemikus 1...16 ja näitab sõna sagedust aastal mil ta esines maksimaalne arv kordi
labs(color="kõige\nsage-\ndasem\naastal...")+
geom_text(data=coord_metadata %>% group_by(round(maxyear/9)) %>% sample_n(2), size=3.5, hjust=0)+ #geom_text kiht, paneb 1) sõnad pildile. sõnade arv: 2) grupeeritud suurima esinemise aasta järgi, mis on jagatud 9-ga ja siis ümardatud (tekib 26 kategooriat, sest esimene aasta oli 1789 ja viimane 2021), igast grupist on juhuslikult võetud kaks sõna
#geom_shadowtext(data=coord_metadata %>% group_by(round(maxyear/10)) %>% sample_n(8), size=4, hjust=-0.1)+ #shadowtext tegi pildi väga kirjuks, tundub et liiga kirjuks, tavaline text on selles mõttes parem
scale_color_continuous(na.value = "gray")+ #continuous tundus parem kui viridis, pildi selguse mõttes; subjektiivne mulje muidugi
theme_void() +
theme(plot.background = element_rect("grey"),
panel.background = element_rect(fill="grey"),
legend.text = element_text(color="black") )+
theme(axis.title=element_blank(),
legend.position = "right")+
NULL
gr
ggplotly(gr)

# Rasmus

## 

### Andmestik on maailma ülikoolide järjestus, mida on mõõdetud 4 meetrika põhjal, millede võimalik skoor on 0-100 (õpetamine, rahvusvahelisus, uurimustöö, viidatus). Nendest pannakse kokku kombineeritud skoor. Lisaks on andmestikus kirjeldavaid tunnuseid, mis aitavad statistikat teha, nn riik, regioon, elanikearv, SKP inimese kohta, tudengite arv, tudengite/staffi suhe ja paar tükki veel. Uurisin seost akadeemilise staffi hõivatuse, õppekvaliteedi ja majandusliku efekti vahel. On näha, et on suured erinevused ülikoolide mudelites regiooniti. On selgelt näha negatiivne seos staffi hõivatuse ja õppekvaliteedi languse vahel. On näha ka, et USAs ja Aasias on valdavalt suured ülikoolid need, mis on väga kõrge tasemega. On veel näha, et Aasias ja USAs on ülikoolide õpetamise skoor tunduvalt paremini eristatav kui euroopas. Võib veel väita, et majanduslikult on Euroopa mudel ebaefektiivsem kui teised kaks, kuna sama lisandväärtuse tootmiseks on euroopas vaja oluliselt rohkem akadeemikuid kui teises kahes.

####
loadRData <- function(fileName){
#loads an RData file, and returns it
load("the_ranking.RDATA")
get(ls()[ls() != "fileName"])
}
rank <- loadRData("the_ranking.RData")

p3=
rank%>% mutate(academics = num_students/student_staff_ratio)%>%
ggplot(aes(x =student_staff_ratio , y = teaching, colour=academics)) +
geom_point() +
scale_colour_gradientn(name = "Total staff size", colours = c("#ffffcc", "#a1dab4", "#41b6c4","#2c7fb8","#253494"), breaks = c(1000, 2000,4000,6000))+
scale_size(name="Total staff") +
theme_bw()+
ggtitle(label = "Teaching score in relation to academic staff")+
xlab(label = "Student/staff ratio")+
ylab(label = "teaching score")+

geom_smooth(method=lm, color="red")+

facet_wrap(~ region)+
theme(strip.background =element_rect(fill="red"))

p4=
rank%>% mutate(academics = num_students/student_staff_ratio)%>%mutate(academics_per_capita=academics/income_per_capita)%>%

ggplot(aes(x =academics_per_capita, fill = region))+

geom_density(show.legend = FALSE) +
theme_bw()+
ylab(label = "academics per income")+
xlab(label = "")+
facet_wrap(~ region)

p3/p4 +plot_layout(guides="collect")

# Karel

## Graafik

## Seletus
Kasutatud on R-i sisseehitaud andmete kogumikku "mtcars".
Võrdluseks on toodud Ameerika (USA) Motor Trends ajakirja 1974 numbri autode põhjal võrdlus miile galloni kohta võrdluses hobujõuga ning näidatud on silndrite arv vastavas võrdluses. Näha on, et mida suurem on hobujõud võrdluses küsuse kuluga, seda rohkem on masinal silindreid.

## Kood

library(ggplot2)

cars <- mtcars

ggplot(cars, aes(x=hp, y=mpg)) +
    geom_point(aes(color=cyl))+
  scale_colour_viridis_c()+
    labs(x="Horse power", 
       y="Miles per gollon", 
       title="1974 Motor Trend US magazine mpg/hp with NO cylinders")+
  NULL

# Lisanna

## Graafik

## Seletus
Kasutatud Gapminderi andmestikku. Graafikul on kujutatud SKP ja oodatav eluiga võrdluses kontinendi ja populatsiooni suurusega. Graafikult on näha, mitut huvitavat fakti. Esiteks korrelatsioon GDP ja eeldatava eluea vahel. Näha on ka kuidas tekivad nö klastrid kus näiteks Aafrika riigid asuvad all vasakul, Aasia riigid keskel ja Euroopa riigid paremal üleval. Ka on huvitav näha Aafrika riikide erindeid, kus kõrgem GDP elaniku kohta ei ole toonud kõrgemat eluiga.

## Kood

llibrary(gapminder)
df = gapminder

df %>% 
  filter(year == 2007) %>% 
  ggplot(aes(x = gdpPercap, y = lifeExp, color = continent, size = pop)) +
  geom_point(alpha = 0.55) + 
  scale_x_log10() + 
  scale_size(range = c(0.5, 20), name = "Population") + 
  labs(x = 'GDP per Capita', y = 'Life Expectancy', title = "Gapminder 2007") +
  theme_bw()