##### Ukazka shlukove analyzy #####
# Autor: RNDr. Eva Janousova
# Masarykova univerzita, Brno
# 30/04/2015
###################################


# nastaveni cesty k souboru - nutno si upravit!
setwd("c:/Users/janousova/Documents/Vyuka/DSAN02/2015 jaro/DSAN02_predn04_shlukovky")


### nacteni dat ###
data <- read.table(file="Data_neuro_shlukovky_R.txt", sep="\t", dec=",", header=T) # nacteni dat
dim(data)
names(data)
head(data)
is(data)

### sumarizace poctu subjektu v jednotlivych skupinach ###
sum(data$Group_3kat==1) # 8 kontrol
sum(data$Group_3kat==2) # 6 pacientu s MCI
sum(data$Group_3kat==3) # 5 pacientu s AD
# nebo: table(data[,3])

### nastaveni barevnych popisku v dendrogramu:
groupCodes <- NULL
groupCodes[data$Group_3kat==1]="CN"
groupCodes[data$Group_3kat==2]="MCI"
groupCodes[data$Group_3kat==3]="AD"
groupCodes
rownames(data) <- make.unique(groupCodes)
colorCodes <- c(CN="black", MCI="cyan", AD="blue")

### nastaveni barevne palety:
palette ("default")
#barplot(rep(1,20),col=1:20, yaxt="n")
barvy <- array(0,length(data$skupina))
barvy[data$Group_3kat==2] <-5
barvy[data$Group_3kat==3] <- 4
barvy[data$Group_3kat==1] <-1

#install.packages('dendextend') # pokud balik dendextend neni jeste nainstalovan
library(dendextend) # nacteni baliku dendextend



### Shlukovani subjektu ###

data.vyber <- data[,c(23,24,26)]
colnames(data.vyber) <- c("Hippocampus_vol","Amygdala_vol","Pallidum_vol")
head(data.vyber) 
euclid.subj <- dist(data.vyber,method="euclidean") # euklidovska vzdalenost subjektu
hclust.euclid.subj <- hclust(euclid.subj,method="complete") # shlukovani subjektu pomoci metody nejvzdalenejsiho souseda
dendr.hclust.euclid.subj <- as.dendrogram(hclust.euclid.subj) # vytvoreni dendrogramu pro subjekty
plot(hclust.euclid.subj, hang=-1) # vykresleni dendrogramu bez barevneho rozliseni prislusnosti subjektu do skupin
labels_colors(dendr.hclust.euclid.subj) <- colorCodes[groupCodes][order.dendrogram(dendr.hclust.euclid.subj)] # barevne olejblovani
plot(dendr.hclust.euclid.subj) # vykresleni dendrogramu
# je patrne, ze jeden pacient s AD je zarazen spatne

# ukazka pri pouziti metody nejblizsiho souseda:
hclust.euclid.subj <- hclust(euclid.subj,method="single") # shlukovani subjektu pomoci metody nejblizsiho souseda
dendr.hclust.euclid.subj <- as.dendrogram(hclust.euclid.subj) # vytvoreni dendrogramu pro subjekty
plot(hclust.euclid.subj, hang=-1) # vykresleni dendrogramu bez barevneho rozliseni prislusnosti subjektu do skupin
labels_colors(dendr.hclust.euclid.subj) <- colorCodes[groupCodes][order.dendrogram(dendr.hclust.euclid.subj)] # barevne olejblovani
plot(dendr.hclust.euclid.subj) # vykresleni dendrogramu
# dendrogram nelze riznout na rozumne skupiny



### Soucasne shlukovani subjektu a parametru - vytvoreni heatmapy ###

data.vyber <- data[,c(23,24,26,27,28)]
colnames(data.vyber) <- c("Hippocampus_vol","Amygdala_vol","Pallidum_vol","Putamen_vol","Nucl_caud_vol")
head(data.vyber) 

euclid.params <- dist(t(data.vyber),method="euclidean") # euklidovska vzdalenost parametru
euclid.subj <- dist(data.vyber,method="euclidean") # euklidovska vzdalenost subjektu
hclust.euclid.params <- hclust(euclid.params,method="ward.D") # shlukovani parametru pomoci Wardovy metody
hclust.euclid.subj <- hclust(euclid.subj,method="ward.D") # shlukovani subjektu pomoci Wardovy metody
dendr.hclust.euclid.params <- as.dendrogram(hclust.euclid.params) # vytvoreni dendrogramu pro parametry
dendr.hclust.euclid.subj <- as.dendrogram(hclust.euclid.subj) # vytvoreni dendrogramu pro subjekty

#jpeg(paste("heatmapa.jpg",sep=""),quality=100,height=720,width=800) # pokud bychom chteli ulozit heatmapu jako jpeg
heatmap(as.matrix(t(data.vyber)),ColSideColors=as.character(barvy),Colv=dendr.hclust.euclid.subj,Rowv=dendr.hclust.euclid.params,cexRow=1) # vykresleni heatmapy
par(xpd=TRUE) # enables to draw a legend outside a plot
legend("topright",legend=levels(as.factor(groupCodes)),fill=as.character(c(4,1,5)),cex=0.7)
#dev.off()
#coords <- locator(1) # now click on the graph where you want the legend
#legend(coords,legend=levels(as.factor(groupCodes)),fill=as.character(c(4,1,5)),cex=0.7)
#legend(-0.3788289,1.106563,legend=levels(as.factor(groupCodes)),fill=as.character(c(4,1,5)),cex=0.7)

# je patrne, ze odliseni subjektu neni dokonale
# vidime, ze pri shlukovani parametru doslo ke shluknuti objemu putamenu a objemu hipokamu, 
# pricemz kontroly maji spise vyssi hodnoty techto parametru (zluta barva), zatimco pacienti 
# nizsi hodnoty (oranzova az cervena barva)



### Soucasne shlukovani subjektu a parametru - pouziti vice shlukovacich algoritmu ###

cmethod <- c("average","ward.D","centroid","median","single","complete","mcquitty")
for (i in 1:length(cmethod)) {
  euclid.params <- dist(t(data.vyber),method="euclidean") # euklidovska vzdalenost parametru
  euclid.subj <- dist(data.vyber,method="euclidean") # euklidovska vzdalenost subjektu
  hclust.euclid.params <- hclust(euclid.params,method=cmethod[i]) # shlukovani parametru
  hclust.euclid.subj <- hclust(euclid.subj,method=cmethod[i]) # shlukovani subjektu
  dendr.hclust.euclid.params <- as.dendrogram(hclust.euclid.params) # vytvoreni dendrogramu pro parametry
  dendr.hclust.euclid.subj <- as.dendrogram(hclust.euclid.subj) # vytvoreni dendrogramu pro parametry  
  #jpeg(paste("heatmapa-",cmethod[i],".jpg",sep=""),quality=100,height=720,width=800)
  heatmap(as.matrix(t(data.vyber)),ColSideColors=as.character(barvy),Colv=dendr.hclust.euclid.subj,Rowv=dendr.hclust.euclid.params,cexRow=1.86,margins=c(5,6),main=paste("Shlukovani metodou",cmethod[i]))
  legend("topright",legend=levels(as.factor(groupCodes)),fill=as.character(c(4,1,5)),cex=0.7)
  #dev.off()
}

