# Skript slouzi k:
# 1. Nacteni souboru s daty (Data_kardio_100subj.xlsx nebo Data_neuro.xlsx).
# 2. Uprave hodnot kategorialnich promennych.
# 3. Vizualizaci dat:
#    a) Teckovy graf podle kategorialni promenne
#    b) Maticovy graf
#    c) Maticovy graf podle kategorialni promenne
#    d) Krabicove grafy pro vice spojitych promennych
#    e) Vicenasobne krabicove grafy (pro vice kategorialnich promennych a jednu spojitou promennou)
#    f) Ikonove grafy 
# Vytvoreno 21.9.2018; EK


##### Nacteni knihoven pro praci s daty #####
library(readxl)   # nacteni knihovny s funkci read_excel
library(plyr)     # nacteni knihovny s funkci mapvalues
library(aplpack)  # nacteni knihovny s funkci faces


##### Nacteni datoveho souboru #####

wd <- "c:/Users/koritakova/Documents/Vyuka/Vicerozmerky a AKD/Vicerozmerky - vyuka/2018/cv_01_grafy" # cesta ke slozce, ve ktere je datovy soubor

data1 <- read_excel(file.path(wd,"Data_kardio_100subj.xlsx"),sheet="Data_kardio_100subj") # nacteni dat kardio
#data1 <- read_excel(file.path(wd,"Data_neuro.xlsx"),sheet="data") # nacteni dat neuro

dim(data1) # pocet pacientu a pocet promennych
names(data1) # nazvy promennych


##### Uprava hodnot kategorialnich promennych #####

data1$pohlavi <- as.factor(data1$pohlavi)
data1$pohlavi_12 <- mapvalues(data1$pohlavi,from=c("M","Z"),to=c(1,2)) # vytvoreni nove kategorialni promenne s hodnotami 1 (M) a 2 (Z)
table(data1$pohlavi_12) # pocet subjektu v kazde kategorii

data1$vzdelani_rek <- mapvalues(data1$vzdelani,from=levels(as.factor(data1$vzdelani)),to=c("VS","VOS","SS mat","SS","ZS")) # vytvoreni nove promenne s textovymi hodnotami kategorii
data1$vzdelani_rek <- factor(data1$vzdelani_rek, levels=c("VS","VOS","SS mat","SS","ZS")) # prerazeni poradi kategorii
table(data1$vzdelani_rek) # pocet subjektu v kazde kategorii

data1$koureni_rek <- mapvalues(data1$koureni,from=levels(as.factor(data1$koureni)),to=c("aktivni kurak","byvaly kurak","nekurak")) # vytvoreni nove promenne s textovymi hodnotami kategorii
data1$koureni_rek <- factor(data1$koureni_rek, levels=c("aktivni kurak","byvaly kurak","nekurak")) # prerazeni poradi kategorii
table(data1$koureni_rek) # pocet subjektu v kazde kategorii

data1$koureni_rek2 <- mapvalues(data1$koureni,from=levels(as.factor(data1$koureni)),to=c("kurak","kurak","nekurak")) # vytvoreni nove promenne, kde kategorie "aktivni kurak" a "byvaly kurak" budou sloucene do "kurak"
data1$koureni_rek2 <- factor(data1$koureni_rek2, levels=c("kurak","nekurak")) # prerazeni poradi kategorii
table(data1$koureni_rek2) # pocet subjektu v kazde kategorii


##### Vizualizace dat #####

## a) Teckovy graf podle kategorialni promenne

barvy = c('blue','red') # nadefinovani barev pro kategorialni promennou
plot(data1$vyska, data1$vaha, pch=20, col=barvy[as.numeric(data1$pohlavi_12)], xlab="Vyska", ylab="Vaha") # vykresleni grafu (pch - typ symbolu, col - barva, xlab - popisek na ose x, ylab - popisek na ose y)
legend("bottomright", c("M","Z"), pch=20, col=barvy, cex=0.9, bty="n") # pridani legendy (pch - typ symbolu, col - barva, cex - velikost popisku, bty - zobrazeni obdelniku kolem legendy ("n" = ne))


## b) Maticovy graf

pairs(~vek+vyska+vaha+sys_tlak, col="black", data=data1) # vykresleni grafu

pairs(~vek+vyska+vaha+sys_tlak, panel= function(x,y,...) {
  points(x, y,...)
  abline(lm(y~x),col="grey")}, col="black", data=data1) # vykresleni grafu vcetne pridani primky linearni regrese


## c) Maticovy graf podle kategorialni promenne

barvy = c('blue','red') # nadefinovani barev pro kategorialni promennou
pairs(~vek+vyska+vaha+sys_tlak,col=barvy[as.numeric(data1$pohlavi_12)], data=data1) # vykresleni grafu


## d) Krabicove grafy pro vice spojitych promennych

boxplot(data1[,c("cel_cholesterol","vyska","vaha","obvod_pasu","obvod_boku","BMI","sys_tlak","dia_tlak")])


## e) Vicenasobne krabicove grafy (pro vice kategorialnich promennych a jednu spojitou promennou)

table(data1$koureni_rek2,data1$pohlavi) # pomocna kontingencni tabulka pro predstavu, kolik bude subjektu v jednotlivych grafech
n_radku <- length(levels(data1$koureni_rek2)) # pocet radku s grafy
n_sloupcu <- length(levels(data1$pohlavi)) # pocet radku s grafy
n_boxu <- length(levels(data1$vzdelani_rek)) # pocet krabicovych grafu v 1 grafu

par(mfrow=c(n_radku,n_sloupcu)) # nastaveni "gridu" grafu
par(oma=c(3,3,3,3))     # nastaveni "outer margin area"
par(mar=c(1,1,1,1))     # nastaveni "margin" u jednotlivych grafu 
par(mgp = c(0, 0.5, 0)) # nastaveni popisku blize "tickmarks"
for (j in 1:n_radku) {
  for (i in 1:n_sloupcu) {
    data1_sel <- data1[data1$koureni_rek2==levels(data1$koureni_rek2)[j] & data1$pohlavi==levels(data1$pohlavi)[i],] # vyber dat podle j-te kategorie 1. promenne a i-te kategorie 2. promenne
    if (nrow(data1_sel)>0) {
      bstat=boxplot(data1_sel$cel_cholesterol ~ data1_sel$vzdelani_rek, range=0, plot=FALSE) # vypocet charakteristik (minima, 1.kvartilu, medianu, 2.kvartilu, maxima)
      plot(1:n_boxu, bstat$stats[3,], col="blue", pch=18, cex=2, xaxt="n", xlim=c(0.5,n_boxu+0.5), ylim=c(0,11), ann=FALSE, cex.axis=0.9) # vykresleni medianu (xaxt="n" zabrani vykresleni osy x) 
      arrows(1:n_boxu, bstat$stats[1,], 1:n_boxu, bstat$stats[5,], code = 3, col = "blue", angle = 90, length = .1) # vykresleni minima a maxima
      axis(1,at=c(1:n_boxu),labels=levels(data1$vzdelani_rek),cex.axis=0.9) # vykresleni osy x
      for (k in 1:n_boxu) {
        text(k,11,paste("n=",length(data1_sel$cel_cholesterol[data1_sel$vzdelani_rek==levels(data1_sel$vzdelani_rek)[k]]),sep=""),cex=0.9) # pridani textovych popisku "n=XX"
      }
    } else {
      plot(1,1,col="white",xaxt="n",yaxt="n",axes=F,frame.plot=FALSE,ann=FALSE) # v pripade, ze pro danou kombinaci kategorii nejsou data zadneho pacienta, vykresli se prazdny graf
    }
  }
}
for (j in 1:n_radku) {
  mtext(levels(data1$koureni_rek2)[j],side=2,line=1,outer=TRUE,at=1.25-j/n_radku,cex=0.8) # popisky pro kategorialni promennou v radcich
}
for (i in 1:n_sloupcu) {
  mtext(levels(data1$pohlavi)[i],side=3,line=1,outer=TRUE,at=i/n_sloupcu-0.25,cex=0.75) # popisky pro kategorialni promennou ve sloupeccich
}

dev.off() # zavreni grafickeho okna


## f) Ikonove grafy 

data1_sel=data1[1:20,] # vyber prvnich 20 pacientu

stars(data1_sel[,c("vek","cel_cholesterol","vaha","sys_tlak","dia_tlak")], labels=data1_sel$id, ncol=5) # parskove (hvezdicove) grafy
stars(data1_sel[,c("vek","cel_cholesterol","vaha","sys_tlak","dia_tlak")], labels=data1_sel$id, ncol=5, radius=F, col.stars=rep("blue",length(data1_sel$id))) # polygony

faces(data1_sel[,c("vek","cel_cholesterol","vaha","sys_tlak","dia_tlak")], face.type=0) # Chernoffovy tvare - typ 0
faces(data1_sel[,c("vek","cel_cholesterol","vaha","sys_tlak","dia_tlak")], face.type=1) # Chernoffovy tvare - typ 1
faces(data1_sel[,c("vek","cel_cholesterol","vaha","sys_tlak","dia_tlak")], face.type=2) # Chernoffovy tvare - typ 2