##############  Assignment 3 - Data Cleaning, EDA, Tests #####################
##############################################################################
##############################################################################

# clear environment
rm(list = ls())

# defining libraries

library(ggplot2)
library(dplyr)
library(PerformanceAnalytics)
library(data.table)
library(sqldf)
library(nortest)
library(tidyverse)
library(MASS)
library(rpart)
library(class)
library(ISLR)
library(scales)
library(ClustOfVar)
library(GGally)
library(reticulate)
library(ggthemes)
library(RColorBrewer)
library(gridExtra)
library(kableExtra)
library(Hmisc)
library(corrplot)
library(energy)
library(nnet)
library(Hotelling)
library(car)

# reading data
data <- read.csv('/Users/mac/Downloads/heart_failure_clinical_records_dataset.csv')

# structure of data
str(data)
glimpse(data)

# summary of data
summary(data)

# Observations
# 0. 299 observations for 13 variables
# 1. Age is between 40 and 95 so not much outliers by intuition
# 2. Death_event should be converted to factor variable as they take only 2 values
# 3. Creatinine phosphokinase, platelets clearly has an outlier from max value which
# we will confirm later by univariate analysis

# Let's look for missing/ NAs
data2 <- na.omit(data)

# data2 has same rows as data so there are no missing values in data

# Correlation plot
M<-cor(data)
head(round(M,2))
corrplot(M, method="color")

# We see that age, anameia, creatinine_phosphokinase,
# high_blood_pressure, serum_creatinine have +ve correlation with death_event

# We see that ejection_fraction, platelets, serum_sodium,
# and time have -ve correlation with death_event

# But we will need deeper analysis to confirm these relationships

# Converting to factor (dependent variable)
data$DEATH_EVENT <- factor(data$DEATH_EVENT)

# Let's check how many zeros are in dataset
colSums(data==0)

# Let's check their proportion to dataset as well
round(colSums(data==0)/nrow(data)*100,2)

# Smoking, High BP, Diabetes, Anaemia are over 50% while sex is below 35%
# Also event rate of survival is ~67.9%

# Let's classify variables into -
# 1. Categorical -> Anaemia, Diabetes, High_blood_pressure, Sex, Smoking, Death_event
# 2. Numeric -> Age, Creatinine_phosphokinase, Ejection_fraction, Platelets,
# serum_creatinine, serum_sodium, time

# We also see that
# Sex - Gender of patient Male = 1, Female =0
# Diabetes - 0 = No, 1 = Yes
# Anaemia - 0 = No, 1 = Yes
# High_blood_pressure - 0 = No, 1 = Yes
# Smoking - 0 = No, 1 = Yes
# DEATH_EVENT - 0 = No, 1 = Yes

### Analysis ###

# We note the scale of few variables like creatinine_phosphokinase,platelets,
# ejection_fraction and time. We can normalize the same before modeling
# but for now we will keep them as-is for the EDA

# Since there are no missing values, let's look at outliers

# Outlier Analysis
boxplot(data$age,
        main = "Age Box Plot",
        xlab = "Age",
        ylab = "Spread",
        col = "orange",
        border = "brown",
        horizontal = TRUE,
        notch = TRUE
)
# No observed outlier in age

boxplot(data$creatinine_phosphokinase,
        main = "creatinine_phosphokinase Box Plot",
        xlab = "creatinine_phosphokinase",
        ylab = "Spread",
        col = "orange",
        border = "brown",
        horizontal = TRUE,
        notch = TRUE
)

# We notice some max outliers in creatinine_phosphokinase with data above median
# more dispersed

boxplot(data$ejection_fraction,
        main = "ejection_fraction Box Plot",
        xlab = "ejection_fraction",
        ylab = "Spread",
        col = "orange",
        border = "brown",
        horizontal = TRUE,
        notch = TRUE
)
# We notice 2 data points as outliers in ejection_fraction

boxplot(data$platelets,
        main = "platelets Box Plot",
        xlab = "platelets",
        ylab = "Spread",
        col = "orange",
        border = "brown",
        horizontal = TRUE,
        notch = TRUE
)
# We notice outliers on both spectrum (high and low) in platelets

boxplot(data$serum_creatinine,
        main = "serum_creatinine Box Plot",
        xlab = "serum_creatinine",
        ylab = "Spread",
        col = "orange",
        border = "brown",
        horizontal = TRUE,
        notch = TRUE
)
# We notice some outliers in serum_creatinine on higher end (similar to
# creatinine_phosphokinase)
# However these are in possible ranges medically

boxplot(data$serum_sodium ,
        main = "serum_sodium  Box Plot",
        xlab = "serum_sodium ",
        ylab = "Spread",
        col = "orange",
        border = "brown",
        horizontal = TRUE,
        notch = TRUE
)
# We notice some outliers in serum_sodium on lower end

boxplot(data$time ,
        main = "time  Box Plot",
        xlab = "time ",
        ylab = "Spread",
        col = "orange",
        border = "brown",
        horizontal = TRUE,
        notch = TRUE
)
# We notice no outliers in time (follow up period) however data above median is
# more dispersed
# Note: While some of these are clear outliers, others must be checked with
# possible medical range

# Data Cleaning - Let's remove these outliers
data <- data[data$ejection_fraction <70,]
data <- data[data$creatinine_phosphokinase <7000,]

# The new data now has only 295 observations - 4 observations were removed

#### Univariate analysis ###

# Age

# Let's check Age distribution and see it with death event
a<-ggplot(data,aes(x = age))+geom_histogram(binwidth = 5, color = "black",
                                            fill = "dark blue",alpha = 0.5)+
  labs(title = "Age Distribution",
       caption = "Age Distribution")+
  theme(plot.caption = element_text(hjust = 0.5,face = "italic"))+
  scale_x_continuous(breaks = seq(40,100,10))

b<-ggplot(data,aes(x = age, fill = DEATH_EVENT))+geom_histogram(binwidth = 5,
                                                                position = "identity",
                                                                alpha = 0.5,color = "black")+scale_fill_manual(values = c("#999999", "#E69F00"))+
  labs(caption = "Age Distribution with Death Event")+
  theme(plot.caption = element_text(hjust = 0.5,face = "italic"))+
  scale_x_continuous(breaks = seq(40,100,10))

gridExtra::grid.arrange(a,b)

# We see that as age increases, chances of death event go up as well

# Let's create age ranges
data$age_tr[data$age < 50 & data$age >= 40]="40-50"
data$age_tr[data$age < 60 & data$age >= 50]="50-60"
data$age_tr[data$age < 70 & data$age >= 60]="60-70"
data$age_tr[data$age < 80 & data$age >= 70]="70-80"
data$age_tr[data$age < 90 & data$age >= 80]="80-90"
data$age_tr[data$age < 100 & data$age >= 90]="90-100"

table(data$DEATH_EVENT, data$age_tr)

# Numerically, we can confirm the same observation (Higher death rate in
# higher ages)

# Creatinine_phosphokinase
# density plot of Creatinine_phosphokinase
ggplot(data,aes(x = creatinine_phosphokinase))+geom_density(fill = "dark blue",
                                                            alpha = 0.5)+
  labs(title = "Distribution of creatinine phosphokinase", caption =
         "Density distribution")+
  theme(plot.caption = element_text(hjust = 0.5, face = "italic"))

#let's create 10 splits of this variable
data$creatinine_phosphokinase_tr <- cut(data$creatinine_phosphokinase, 10)
table(data$DEATH_EVENT, data$creatinine_phosphokinase_tr)

# Numerically, we can see that for creatinine levels above 4000, death event
# seems to be higher

aggregate(data[, c('creatinine_phosphokinase')], list(data$DEATH_EVENT), mean)

# Numerically, we can see that average creatinine levels are lower in case of
# death event

# Ejection_fraction
ggplot(data,aes(x = ejection_fraction))+geom_density(fill = "dark blue",
                                                     alpha = 0.5)+
  labs(title = "Distribution of ejection_fraction",
       caption = "Density distribution")+
  theme(plot.caption = element_text(hjust = 0.5, face = "italic"))

#let's create 10 splits of this variable
data$ejection_fraction_tr <- cut(data$ejection_fraction, 10)
table(data$DEATH_EVENT, data$ejection_fraction_tr)

# Numerically, we can see that ejection fraction is low in case of death event

aggregate(data[, c('ejection_fraction')], list(data$DEATH_EVENT), mean)

# Numerically, we can see that average ejection fraction is also low in
# case of death event

# platelets
ggplot(data,aes(x = platelets ))+geom_density(fill = "dark blue", alpha = 0.5)+
  labs(title = "Distribution of platelets ", caption = "Density distribution")+
  theme(plot.caption = element_text(hjust = 0.5, face = "italic"))

#let's create 10 splits of this variable
data$platelets_tr  <- cut(data$platelets , 10)
table(data$DEATH_EVENT, data$platelets_tr)

# Numerically, we can see that platelets are low in case of death event

aggregate(data[, c('platelets')], list(data$DEATH_EVENT), mean)

# Numerically, we can see that average platelets are marginally lower in
# case of death event

# serum_creatinine
ggplot(data,aes(x = serum_creatinine ))+geom_density(fill =
                                                       "dark blue", alpha = 0.5)+
  labs(title = "Distribution of serum_creatinine ",
       caption = "Density distribution")+
  theme(plot.caption = element_text(hjust = 0.5, face = "italic"))

#let's create 10 splits of this variable
data$serum_creatinine_tr  <- cut(data$serum_creatinine , 10)
table(data$DEATH_EVENT, data$serum_creatinine_tr)

# Numerically, we can see that death event is high when serum_creatinine
# levels are above 1.39 and very high above 2.28

aggregate(data[, c('serum_creatinine')], list(data$DEATH_EVENT), mean)

# Numerically, we can see that average serum_creatinine is high in case of death event

# serum_sodium
ggplot(data,aes(x = serum_sodium ))+geom_density(fill = "dark blue",
                                                 alpha = 0.5)+
  labs(title = "Distribution of serum_sodium ",
       caption = "Density distribution")+
  theme(plot.caption = element_text(hjust = 0.5, face = "italic"))

#let's create 10 splits of this variable
data$serum_sodium_tr  <- cut(data$serum_sodium , 10)
table(data$DEATH_EVENT, data$serum_sodium_tr)

# Numerically, we can see that serum_sodium are low in case of death event

aggregate(data[, c('serum_sodium')], list(data$DEATH_EVENT), mean)

# Numerically, we can see that average serum sodium are marginally lower
# in case of death event

# time
ggplot(data,aes(x = time ))+geom_density(fill = "dark blue", alpha = 0.5)+
  labs(title = "Distribution of time ", caption = "Density distribution")+
  theme(plot.caption = element_text(hjust = 0.5, face = "italic"))

#let's create 10 splits of this variable
data$time_tr  <- cut(data$time , 10)
table(data$DEATH_EVENT, data$time_tr)

# Numerically, we can see that follow up period was small in case of death event

aggregate(data[, c('time')], list(data$DEATH_EVENT), mean)

# Numerically, we can see that average follow up period is low in case of death event
# This simply may illustrate that once deemed healthy,the patients may have stopped
# following up whereas diseased patients would undergo more checkups

# Let's do EDA for categorical variables now

# Anaemia, Diabetes, High_blood_pressure, Sex, Smoking

a <- ggplot(data, aes(x = DEATH_EVENT, fill = factor(anaemia)))+
  geom_bar(position = "fill")+
  scale_x_discrete(labels  = c("Death Event:No","Death Event:Yes"))+
  scale_fill_manual(values = c("#999999", "#E69F00"), name = "Anaemia",
                    labels = c("No","Yes"))+labs(subtitle = "Anaemia")

b<-ggplot(data, aes(x = DEATH_EVENT, fill = factor(diabetes)))+
  geom_bar(position = "fill")+
  scale_x_discrete(labels  = c("Death Event:No","Death Event:Yes"))+
  scale_fill_manual(values = c("#999999", "#E69F00"), name = "Diabetes",
                    labels = c("No","Yes"))+labs(subtitle = "Diabetes")

c<-ggplot(data, aes(x = DEATH_EVENT, fill = factor(high_blood_pressure)))+
  geom_bar(position = "fill")+
  scale_x_discrete(labels  = c("Death Event:No","Death Event:Yes"))+
  scale_fill_manual(values = c("#999999", "#E69F00"), name = "High BP",
                    labels = c("No","Yes"))+labs(subtitle = "High BP")

d<-ggplot(data, aes(x = DEATH_EVENT, fill = factor(sex)))+
  geom_bar(position = "fill")+
  scale_x_discrete(labels  = c("Death Event:No","Death Event:Yes"))+
  scale_fill_manual(values = c("#999999", "#E69F00"), name = "Sex",
                    labels = c("Female","Male"))+labs(subtitle = "Sex")

e<-ggplot(data, aes(x = DEATH_EVENT, fill = factor(smoking)))+
  geom_bar(position = "fill")+
  scale_x_discrete(labels  = c("Death Event:No","Death Event:Yes"))+
  scale_fill_manual(values = c("#999999", "#E69F00"), name = "Smoking",
                    labels = c("No","Yes"))+labs(subtitle = "Smoking")

grid.arrange(a,b,c,d,e)

# We can see that Anaemia and High BP has significant difference for death event
# whereas others not so much

# Normality tests

# univariate normality
data <- read.csv('/Users/mac/Downloads/heart_failure_clinical_records_dataset.csv')
cm <- colMeans(data)
S <- cov(data)
d <- apply(data, MARGIN = 1, function(data)t(data - cm) %*% solve(S) %*% (data - cm))

# Age
qqnorm(data[,"age"], main = "age")
qqline(data[,"age"])

# Age looks normally distributed

# Creatinine_phosphokinase
qqnorm(data[,"creatinine_phosphokinase"], main = "Creatinine_phosphokinase")
qqline(data[,"creatinine_phosphokinase"])

# Creatinine_phosphokinase doesn't looks normal but skewed

# ejection_fraction
qqnorm(data[,"ejection_fraction"], main = "ejection_fraction")
qqline(data[,"ejection_fraction"])

# ejection_fraction doeesn't look normal as well

# serum_creatinine
qqnorm(data[,"serum_creatinine"], main = "serum_creatinine")
qqline(data[,"serum_creatinine"])

# serum_creatinine doesn't look normal but skewed

# serum_sodium
qqnorm(data[,"serum_sodium"], main = "serum_sodium")
qqline(data[,"serum_sodium"])

# serum_sodium looks normal but is slightly skewed on lower end

plot(qchisq((1:nrow(data) - 1/2) / nrow(data), df = 13), sort(d),
     xlab = expression(paste(chi[13]^2, " Quantile")),
     ylab = "Ordered distances")
abline(a = 0, b = 1)

# While plotting for multivariate normality, we see that
# data is non normal and has some skewness towards positive side

# t-tests for death events vs not for each variable

# age
with(data,t.test(age[DEATH_EVENT=="1"],age[DEATH_EVENT=="0"],var.equal=TRUE))
# anaemia
with(data,t.test(anaemia[DEATH_EVENT=="1"],anaemia[DEATH_EVENT=="0"],var.equal=TRUE))
# creatinine_phosphokinase
with(data,t.test(creatinine_phosphokinase[DEATH_EVENT=="1"],
                 creatinine_phosphokinase[DEATH_EVENT=="0"],var.equal=TRUE))
# diabetes
with(data,t.test(diabetes[DEATH_EVENT=="1"],
                 diabetes[DEATH_EVENT=="0"],var.equal=TRUE))
# ejection_fraction
with(data,t.test(ejection_fraction[DEATH_EVENT=="1"],
                 ejection_fraction[DEATH_EVENT=="0"],var.equal=TRUE))
# high_blood_pressure
with(data,t.test(high_blood_pressure[DEATH_EVENT=="1"],
                 high_blood_pressure[DEATH_EVENT=="0"],var.equal=TRUE))
# platelets
with(data,t.test(platelets[DEATH_EVENT=="1"],
                 platelets[DEATH_EVENT=="0"],var.equal=TRUE))
# serum_creatinine
with(data,t.test(serum_creatinine[DEATH_EVENT=="1"],
                 serum_creatinine[DEATH_EVENT=="0"],var.equal=TRUE))
# serum_sodium
with(data,t.test(serum_sodium[DEATH_EVENT=="1"],
                 serum_sodium[DEATH_EVENT=="0"],var.equal=TRUE))
# sex
with(data,t.test(sex[DEATH_EVENT=="1"],
                 sex[DEATH_EVENT=="0"],var.equal=TRUE))
# smoking
with(data,t.test(smoking[DEATH_EVENT=="1"],
                 smoking[DEATH_EVENT=="0"],var.equal=TRUE))
# time
with(data,t.test(time[DEATH_EVENT=="1"],
                 time[DEATH_EVENT=="0"],var.equal=TRUE))

# p-value is below 0.05 for -
# 1. age
# 2. serum_sodium
# 3. serum_creatinine
# 4. ejection_fraction
# 5. time
# so we may conclude that death event does differ by these variables

# Hotelling's T2 test. Comparing multivariate means between death events and non-death event
t2testdata <- hotelling.test(age + anaemia + creatinine_phosphokinase +
                               diabetes + ejection_fraction + high_blood_pressure+
                               platelets+serum_creatinine + serum_sodium +
                               sex+smoking+time
                             ~ DEATH_EVENT, data)

cat("T2 statistic =",t2testdata$stat[[1]],"\n")
print(t2testdata)

# The difference in means in the two groups taken together is
# significant as well

# Homoskedasticity check

data$DEATH_EVENT <- factor(data$DEATH_EVENT)
leveneTest(age ~ DEATH_EVENT, data=data)
leveneTest(anaemia ~ DEATH_EVENT, data=data)
leveneTest(creatinine_phosphokinase ~ DEATH_EVENT, data=data)
leveneTest(diabetes ~ DEATH_EVENT, data=data)
leveneTest(ejection_fraction ~ DEATH_EVENT, data=data)
leveneTest(high_blood_pressure ~ DEATH_EVENT, data=data)
leveneTest(platelets ~ DEATH_EVENT, data=data)
leveneTest(serum_creatinine ~ DEATH_EVENT, data=data)
leveneTest(serum_sodium ~ DEATH_EVENT, data=data)
leveneTest(sex ~ DEATH_EVENT, data=data)
leveneTest(smoking ~ DEATH_EVENT, data=data)
leveneTest(time ~ DEATH_EVENT, data=data)

# p-value is below 0.05 for -
# 1. age
# 2. serum_creatinine
# 3. ejection_fraction
# 4. time
# 5. serum_sodium
# so we may conclude that variance between the two groups
# differ in them

# One-way ANOVA tests: comparing univariate means
aov_age <- aov(age ~ DEATH_EVENT, data)
summary(aov_age)
aov_anaemia <- aov(anaemia ~ DEATH_EVENT, data)
summary(aov_anaemia)
aov_creatinine_phosphokinase <- aov(creatinine_phosphokinase ~ DEATH_EVENT, data)
summary(aov_creatinine_phosphokinase)
aov_diabetes <- aov(diabetes ~ DEATH_EVENT, data)
summary(aov_diabetes)
aov_ejection_fraction <- aov(ejection_fraction ~ DEATH_EVENT, data)
summary(aov_ejection_fraction)
aov_high_blood_pressure <- aov(high_blood_pressure ~ DEATH_EVENT, data)
summary(aov_high_blood_pressure)
aov_platelets <- aov(platelets ~ DEATH_EVENT, data)
summary(aov_platelets)
aov_serum_creatinine <- aov(serum_creatinine ~ DEATH_EVENT, data)
summary(aov_serum_creatinine)
aov_serum_sodium <- aov(serum_sodium ~ DEATH_EVENT, data)
summary(aov_serum_sodium)
aov_sex <- aov(sex ~ DEATH_EVENT, data)
summary(aov_sex)
aov_smoking <- aov(smoking ~ DEATH_EVENT, data)
summary(aov_smoking)
aov_time <- aov(time ~ DEATH_EVENT, data)
summary(aov_time)

# p-value is below 0.05 for -
# 1. age
# 2. serum_creatinine
# 3. ejection_fraction
# 4. time
# 5. serum_sodium
# so we may conclude that means between the two groups
# differ in them

# Comparing multivariate means (One-way MANOVA)
mnv <- manova(as.matrix(data[,-13])~ DEATH_EVENT, data)
summary(mnv)

# We observe from MANOVA that estimated effects may be unbalanced
# indicating that mean between groups may be different

# Let us also look at Multicollinearity check
# Earlier we saw the correlation plot
# We will check VIF for this purpose
# In classification, although linear regression isn't to be used
# For VIF, a rudimentary model lets us know the association
# between continuous and categorical variables

data <- read.csv('/Users/mac/Downloads/heart_failure_clinical_records_dataset.csv')
mod <-  lm( DEATH_EVENT ~ age+anaemia+creatinine_phosphokinase+
              diabetes+ejection_fraction+high_blood_pressure+platelets+
              serum_creatinine+serum_sodium+sex+smoking+time, data)
summary(mod)

vif(mod)

# We see that most VIF values are below 1.5
# This incdicates absence of multi-collinearity in our data

############## This concludes our initial EDA for the data ###########
######################################################################
######################################################################


library(hflights)
library(data.table)

DT <- data.table(hflights)
DT

# i
DT[ Month==1 & DayofMonth==1  ,    ,  ]

# j
DT[  , list (Mean = mean(DepDelay , na.rm=T) , Min= min(DepDelay , na.rm=T))  ,]

# by

DT[  , list (Mean = mean(DepDelay , na.rm=T) , Min= min(DepDelay , na.rm=T))  ,
     by=c("Month" , "Year")]


#  James Rekow

##  Contains several simple functions used in the DOC analysis.

overlapSet = function(x, y){
  xPresent = x > 0
  yPresent = y > 0
  return(xPresent & yPresent)
} #  end overlapSet

normalize = function(x){
  return(x / sum(x))
} #  end normalize

#  This function does not assume the data is normalized
overlap = function(x, y){

  x = normalize(x)
  y = normalize(y)

  bothPresent = overlapSet(x, y)
  return(0.5 * sum(x[bothPresent] + y[bothPresent]))

} #  end overlap

#  This function does not assume the data is normalized
DrJSD = function(x, y){

  bothPresent = overlapSet(x, y)
  x = normalize(x[bothPresent])
  y = normalize(y[bothPresent])
  m = 0.5 * (x + y)

  if(sum(m) == 0){
    return(0)
  }

  return(sqrt(0.5 * (sum(x * log(x / m) + y * log(y / m)))))

} #  end DrJSD


# From Matthew Shun-Shin <m@shun-shin.com>  2018-01-14

require(rms)
set.seed(1)
m <- 50
d <- expand.grid(arm=c('a','b','c'), i=1 : m)
d$x <- runif(nrow(d))
d$y <- rnorm(nrow(d))
dd <- datadist(d)
options(datadist="dd")

f <- ols(y ~ x + arm, data=d)
summary(f, verbose=TRUE)
summary(f, conf.type='simult', verbose=TRUE)  # simult ignored
#Works
contrast(f, list(arm=c('c','b')), list(arm='a'))
contrast(f, list(arm=c('c','b')), list(arm="a"),
                  conf.type='simultaneous')

g <- orm(y ~ x + arm, data=d)
summary(g, verbose=TRUE)
summary(g, conf.type='simultaneous', verbose=TRUE)  # simult ignored

contrast(g, list(arm=c('b','c')), list(arm='a'))
contrast(g, list(arm=c('b','c')), list(arm='a'), conf.type='simult')


metrop_hastings<-function(x_0, iter=1, log_post_density,
                          proposal_dist = function(x, prop_sigma){
                            MASS::mvrnorm(1, mu = x, Sigma = prop_sigma )
                          },
                          lower=-Inf, upper=Inf, prop_sigma,
                          ... ){
  for(i in 1:iter){
    # draw from proposal distribution
    x_star <- proposal_dist(x_0, prop_sigma)

    # calculate ratio of conditional posterior densities
    r_num <- do.call(log_post_density, c(list(x_star), list(...)) )
    r_denom <- do.call(log_post_density, c(list(x_0), list(...)) )
    r <- exp(r_num - r_denom)
    rmin<-min(r,1)
    if(is.na(rmin)) browser()
    # accept / reject proposal
    if(rbinom(1,1,rmin)==1){
      x_0<-x_star
    }
  }

  res<-list(x_0 = x_0, accept_prob = rmin )
  return(res)
}


# 4. faza: Analiza podatkov

#Kako se količina kmetijskih pridelkov skupno skozi leta spreminja
g1 <- ggplot(skupno.pridelki.leta, aes(x=leto, y=kolicina)) + geom_point(color='dark blue')
lin1 <- lm(data = skupno.pridelki.leta, kolicina ~ leto)
graf1 = g1 + geom_smooth(method='lm',fullrange=TRUE,color='black', formula = y~x)
nova1 <- data.frame(leto=seq(2010, 2025, 1))
napoved1 <- mutate(nova1, kolicina=predict(lin1, nova1))
graf_napoved1 <- graf1 + geom_point(data=napoved1, aes(x=leto, y=kolicina), color='red', size = 2) +
  ggtitle('Napoved nadaljnega povprečja pridelkov v Sloveniji po letih') + scale_x_continuous(breaks = seq(2010, 2025, 1)) +
  ylab('Kolicina v t/ha') + xlab('Leto')

g2<- ggplot(skupno.zivina.leta, aes(x=leto, y=kolicina)) + geom_point()
lin2 <- lm(data = skupno.zivina.leta, kolicina ~ leto)
graf2 = g2 + geom_smooth(method='lm',fullrange=TRUE,color='black', formula = y~x)
nova2 <- data.frame(leto=c(2003, 2005, 2007, 2010, 2013, 2016, 2019, 2022, 2025))
napoved2 <- mutate(nova2, kolicina=predict(lin2, nova2))
graf_napoved2 <- graf2 + geom_point(data=napoved2, aes(x=leto, y=kolicina), color='red', size = 2) +
  ggtitle('Napoved nadaljnega povprečja živine v Sloveniji po letih') +
  scale_x_continuous(minor_breaks =seq(2003, 2025, 1)  , breaks = c(2003, 2005, 2007, 2010, 2013, 2016, 2019, 2022, 2025)) +
  scale_y_continuous(labels = scales::comma) + xlab('Leto') + ylab('Število živali')


#' Drift Diffusion Data Simulation
#'
#' Simulates reaction times and binary decisions (0/1) from a set of DDM parameters. This function is not likelihood
#' based, but executes all steps of the diffusion process. Can be used directly, but intended use is within the
#' wrapper function \code{\link{simulDat}}. This function has been adapted from the python package "HDDM".
#'
#' @export
#' @param params A list of parameters which should at least contain 'a', 'v', 'z' and 't'. Inter trial variabilities
#' can also be included: 'sv', 'sz' and/or 'st', in any combination.
#' @param samples Amount of decisions to be simulated. Can be conceptualized as 'trials'.
#' @param dt Function steps or 'resolution'. Should not be altered, but can.
#' @param intra_sv Intra-trial variability. When simulating data with parameters fitted via Stan, then the value of
#' \code{1} should be used. The implemented likelihood in Stan is calibrated to that value. When using parameters
#' fitted with a Ratcliff procedure, then this value should be set to \code{0.1}.
#' @return A data frame with two columns, 'rt' and 'response', as long as 'samples'.
drift_simuls <- function(params, samples = 500, dt = 1e-04, intra_sv = 1){
    params <- as.list(params)
    nn <- 1000
    a <- params[['a']]
    v <- params[['v']]

    if('st' %in% names(params)){
        start_delay <- runif2(n = samples,
                              loc = params[['t']],
                              scale = params[['st']]) -params[['st']]/2
    }else{
        start_delay <- rep(1, samples)*params[['t']]
    }

    if('sz' %in% names(params)){
        starting_points <- runif2(n = samples,
                                  loc = params[['z']],
                                  scale = params[['sz']]) -params[['sz']]/2*a
    } else {
        starting_points <- rep(1, samples)*params[['z']]*a
    }

    rts <- c()
    step_size <- sqrt(dt)*intra_sv
    drifts <- c()

    for (i_sample in 1:samples){

        drift <- c()
        crossed <- FALSE
        iter <- 0
        y_0 <- starting_points[i_sample]
        #drifting:

        if('sv' %in% names(params)){
            if(params[['sv']] != 0){
                drift_rate <- rnorm(n = 1,
                                    mean = v,
                                    sd = params[['sv']])
            } else {
                drift_rate <- v
            }
        }else {
            drift_rate <- v
        }

        prob_up = 0.5*(1+sqrt(dt)/intra_sv*drift_rate)

        while(!crossed){
            # Generate nn steps
            iter <- iter + 1

            steps <- runif(nn, min = 0, max = 1)

            position <- ((steps < prob_up)*2 - 1) * step_size

            position[1] <- position[1] + y_0

            position <- cumsum(position)

            # Find boundary crossings
            cross_idx <- position[(position < 0) | (position > a)][1]
            cross_idx <- which(cross_idx == position)
            drift <- c(drift, position)
            if(length(cross_idx) > 0){
                crossed <- TRUE
            } else {
                # If not crossed, set last position as starting point
                # for next nn steps to continue drift
                y_0 <- tail(position, n = 1)
            }

        }#end while loop for drifts

        #find the boundary interception
        y2 = position[cross_idx[1]]

        if(cross_idx[1] != 1){
            y1 <- position[cross_idx[1]-1]
        } else {
            y1 <- y_0
        }
        m <- (y2 - y1)/dt #slope
        b <- y2 - m*((iter-1)*nn+cross_idx[1])*dt # intercept
        if(y2 < 0){
            rt <- ((0 - b) / m)
        } else {
            rt <- ((a - b) / m)
        }

        rts[i_sample] <- (rt + start_delay[i_sample])*sign(y2)
        # delay <- start_delay[i_sample]/dt
        # drifts <- c(drifts, c(rep(1,as.integer(delay))*starting_points[i_sample],
        # drift[1:as.integer(abs(rt)/dt)]))
        data <- data.frame('rt' = rts)
        data$response <- 1
        data$response[data$rt<0] <- 0
        data$rt <- abs(data$rt)

    }#end i_sample
    data
}#end function


as.integer(as.roman(c("MCMXII", "LXXXVI"))


# Built in R features

# Example Vector
vector <- c(1:20)
# Creates sequestes, takes 3 arguments,
# 1. Where it starts, 2. Where it ends, 3. the "by=", how it should just foreach step
seq(0, 20, by = 10) # gives (0, 10, 20)
# Sorts vectors
sort(vector, decreasing = TRUE) # vector, decreasing = TRUE/FALSE
# Reverse the object
rev(vector) # 20 .. 1
# Show the structure of the object
str(vector) # int[1:20] 1 .. 20
# Merge lists and vectors together
append(vector, 21:25)
# is. checks the class is correct.
is.vector(vector)
# as. convert to this data-type
as.list(vector)
# Returns random numbers
sampe(x = 100, 3)

add.random <- function(x) {
    rand <- sample(1:100, 1)
    return(x+rand)
}

# Applies the function to every vector, and returns a list
lapply(vector, add.random)
# Apples the function to every vector, and returns a vector
sapply(vector, add.random)
# Anonymous functions
sapply(vector, function(num) {num * 2})

# Math functions
abs() # Computes the absolute value
sum() # returns the sum of values
mean() # computes the arithemitc mean
round() # Rounds values, more arguments for nearest, digits = 2

text <- "Hi, do you know who you are voting for?"
# Regular expressions
grepl('voting', text) # Returns logical TRUE/FALSE
grep() # Returns index of searched object

# Dates
Sys.Date() # TODAY
# Normal dates in R
date <- "1990-01-01" %>% as.Date()
# Or formating like this
my.date <- as.Date("Nov-03-90", format = "%b-%d-%y")
# Most used, includes time
as.POSTXCT()
# Should be used
strptime()

# Pipe operator
# Works like promises
result <- mtcars %>% filter(mpq > 20) %>% sample_n(size = 5) %>% arrange(desc(mpq))

# Data manipulation
library(Dplyr) # Manipulation of data
fliter(flights, month == 11, day == 3, carrier, 'AA') # Overrules the normal filter
slice(flights, 1:10) # Returns the amount of rows in a dataframe
arrange(flights, year, month, day, airtime) # Reorders the row after parameters
select(flights, carrier) # Takes out parameters with lesser syntax
rename(flights, airline_carrier = carrier) # Renames columns, replaces the old
distinct(select(flights, carrier)) # Takes all the unique values
mutate(flights, new_col = arr_delay-dep_deplay) # Creates a new column and remakes the args
transmute() # Same as mutate, but returns the "new row"
summarise(flights, avg_air_time = mean(air_time, na.rm = T)) # Works like aggregate
sample_n(flights, 10) # Returns random rows (10)
sample_frac(flights, 0.1) # Returns a fraction of rows (%)

library(tidyr) # Cleaning Data
gather(df, Quarter, Revenue, Quarter1:Quarter4) # Collapses multiple columns into fewer
spread(stocks, price) # Reverses the gather
separate(df, which.to.separate, c('col1','col2')) # separates using values thats non characters etc.
unite(df, joined.col, col1, col2) # Reverses the separate

# Layers of data visualization with GGPLOT2
library(ggplot2)
# Data - library
# Aestehtics = aes(x=, y=)
# Geometry - geom_point()
# Facets - lets us put multiple plots on the same grid
# Statistics - facets_grid() gives the extra layers
# Coordinates -coord_cartesian(xlim = vector)
ggplot(data = mtcars) # Data
pl <- ggplot(data = mtcars, aes(x = mpg, y = hp)) # Aestehtics
pl <- pl + geom_point() # Geomtry
pl <- pl + facet_grid(cyl ~ .) # Separates the plots depending on how many cylinders they have
pl2 <- pl + stat_smooth() # Smoothing out the curves
pl2 <- coord_cartesian(xlim = c(15:25))
# Theme layer - adding to the theme layer
pl2 <- pl2 + theme_bw()

# Using ggplot2movies library
install.packages('ggplot2movies')
library(ggplot2movies) # (movies)
# Histogram
# Data & Aesthetics
movpl <- ggplot(movies, aes(x=rating)) # only need x
movpl2 <- movpl + geom_histogram(binwidth = 0.1, aes(fill=..count..)) # Prints a histogram with ratings
movpl3 <- xlab('Movie Rating') + ylab('Count') # Labeling the x and y
print(movpl3 + ggtitle("Title"))

# Scatterplots
carpl <- ggplot(mtcars, aes(x=wt, y=mpg)) # DATA / AES
carpl <- carpl + geom_point(aes(size=hp)) # Bigger size depending on the hp

# Barplots - Categorical data
barpl <- ggplot(mpg, aes(x = class))
barplcolor <- barpl + geom_bar()# geom_bar specifies a barplot
barplcolor <- barpl+ geom_bar(aes(fill=drv), position = 'dodge') # Splits up positions

# Boxplot - Depicting data of numerical data
boxpl <- ggplot(mtcars, aes(x = factor(cyl), y = mpg))
boxplot <- boxpl + geom_boxplot()

# Two variable plots
twovpl <- ggplot(movies, aes(x = year, y = rating) + geom_bin2d())
twovpl <- twovpl + scale_fill_gradient(high = 'red', low = 'blue')
    # install.package('hexbin')
twovpl <- twovpl + geom_hex() / geom_density2d() # Gives a hex pattern

# Working with Coordinates and Faceting
# Coordinates - Resize the plots
# Faceting - Allows us to place more plots at the side of eachother
pl <- ggplot(mpg, aes(x = displ, y = hwy)) + geom_point()
# xlim / ylim takes vectors as arguments
pl + coord_cartesian(xlim = c(1,4), ylim = c(15, 30))
pl + coord_fixed(ratio = 1/3) # Resizes the plot
# creates multiple grids with facet_grid()
pl + facet_grid(. ~ cyl) # the . is the x axis, the cyl is the y axis

# Themes
theme_set(theme_minimal()) # Set global theme
pl <- ggplot(mtcars, aes(x = wt, y = mpg)) + geom_point()
pl + theme_dart()
# Install more themes
install.package('ggthemes')
library(ggthemes)

# Plotly - Interactive ggplots
'https://plot.ly/ggplot2'

install.packages('plotly')
library(ggplot2)
library(plotly)
gplo <- ggplot(mtcars, aes(mpg,wt)) + geom_point()
# pass in plot in ggplotly
gplot <- ggplotly(gplo)

# Any type of GGPLOT2 visualization
'http://ropensci.github.io/plotly-test-table/tables/0e3d5ca144d27d8416318824c1b6ec1421a51045/index.html'


library(stringr)
library(ggmap)

# URL to Census Population Data by City
CENSUS_URL = 'https://www2.census.gov/programs-surveys/popest/datasets/2010-2015/cities/totals/sub-est2015_all.csv'

# Load CSV
msa_pop <- read.csv(CENSUS_URL, stringsAsFactors = FALSE)

# Restrict to places (the original file contains state statistics as well)
msa_pop <- subset(msa_pop, SUMLEV == 162)

# Keep only the name of the city by restricting to Title Case
msa_pop$NAME <- sapply(str_extract_all(msa_pop$NAME,
                                       "([A-Z][^\\s]*)"),
                       paste,
                       collapse = ' ')

# Percentage change in population
msa_pop$GROWTH <- (msa_pop$POPESTIMATE2015 - msa_pop$POPESTIMATE2010) / msa_pop$POPESTIMATE2014

# Subset by relevant variables
relevant_vars <- c('SUMLEV', 'STATE', 'PLACE', 'NAME', 'STNAME',
                   'POPESTIMATE2015', 'GROWTH')
msa_pop       <- msa_pop[ , relevant_vars]

# Keep only top 1,000 cities (by population)
msa_pop <- head(msa_pop[order(msa_pop$POPESTIMATE2015, decreasing = TRUE), ], 1000)

# Geocode the cities
geo     <- geocode(location = paste(msa_pop$NAME, msa_pop$STNAME),
                   output   = 'latlon' ,
                   source   = 'google')
msa_pop <- cbind(msa_pop, geo)

# Lower case all the variables
names(msa_pop) <- tolower(names(msa_pop))

# Export data
write.csv(x         = msa_pop,
          file      = 'data/processed/msa_pop_grow.csv',
          row.names = FALSE)


#' Build a cell graph using balanced knn after normalizing over a given metacell model
#'
#' @param mat_id matrix object id
#' @param gset_id gset object id defining the gene features used for computing distances
#' @param graph_id  new graph id to create
#' @param K the guideline Knn parameter. The balanced will be constructed aiming at K edges per cell
#'
#' @export

mcell_add_cgraph_bknn_norm_mc = function(graph_id, mat_id, gset_id, K, mc_to_norm)
{
	k_alpha = get_param("scm_balance_graph_k_alpha")
	k_beta = get_param("scm_balance_graph_k_beta")

	norm_mc = scdb_mc(mc_to_norm)
	if(is.null(norm_mc)) {
		stop("missing metacell for cgraph normalization, id = ", mc_to_norm)
	}
	feat = gset_get_feat_mat(gset_id, mat_id, downsamp=F, add_non_dsamp=F)
	k_nonz_exp = get_param("scm_k_nonz_exp")
	feat = log2(1+k_nonz_exp*as.matrix(feat))

	raw_cor = tgs_cor(feat)

	raw_cor[is.na(raw_cor)] = 0

	N = ncol(feat)
	all_mc = rep(1,N)
	names(all_mc) = colnames(feat)
	all_mc[names(norm_mc@mc)] = norm_mc@mc+1

	n_out = N - length(norm_mc@mc)
	mc_size = tabulate(norm_mc@mc)
	w_cm = diag(c(1/n_out, 1/mc_size))[all_mc,]

	cor_mm = t(w_cm) %*% raw_cor %*% w_cm
	norm_cor = raw_cor - cor_mm[all_mc, all_mc]

	gr = cormat_to_balanced_knn(norm_cor, K, k_alpha, k_beta)

	cnames = colnames(feat)
	colnames(gr) = c("mc1","mc2","w")

	scdb_add_cgraph(graph_id, tgCellGraph(gr, cnames))
}

#' @export
cormat_to_balanced_knn = function(cormat, k_knn, k_alpha, k_beta)
{
	nodes = colnames(cormat)

	N = length(nodes)

	k_knn_potential = min(k_knn*k_alpha, N)

	m_knn = matrix(k_knn_potential,
			nrow = N,ncol = N,
			dimnames = list(nodes, nodes))
	message("fill m_knn with knn_ord")
	for(i in 1:N) {
		best_hits = head(order(cormat[i,]),k_knn_potential)
		m_knn[i,best_hits] = 1:k_knn_potential
	}

	message("start balancing ", N)
	M = k_knn*k_knn*10

	m_knn_io = pmax(-m_knn * t(m_knn) + M,0)

	A = nrow(m_knn_io)-k_knn*3	#no more than k_nn*3 contribs per row, or incoming neighbots
	m_knn_io_rows = t(apply(m_knn_io, 1, function(x) pmax(rank(x)-A,0)))
	message("done balance 1", N)
	A = nrow(m_knn_io)-k_knn	#no more than k_nn contribs per column, or outgoing neighbors
	m_knn_io = apply(m_knn_io_rows, 2, function(x) pmax(rank(x)-A,0))
	message("done balance 2", N)

	ij = as.data.frame(which(m_knn_io > 0, arr.ind=T))

	gr = data.frame(ij$row, ij$col, weight=m_knn_io[which(m_knn_io>0)])
	return(gr);
}


#' @title convert.degminsec2degdec
#' @description This function converts degminsec to decimal degrees
#' @param \code{z} = = dataframe to be handled, with lat and lon colnames
##' @return \code{res} = saturation percentage
#' @examples
#' @notes MMM - 2016-06-16 - marking as deprecated.  While documenting, I noticed that it makes small errors with the minutes.
#' @family coordinate converters
#' @author  unknown, \email{<unknown>@@dfo-mpo.gc.ca}
#' @export
  convert.degminsec2degdec = function (z) {
    .Deprecated()
	z = z/10000
    degrees = trunc( z )
	zm = (z - degrees )  * 100
	minutes = trunc (zm )
	seconds = (zm - minutes) * 100
	res = degrees + minutes / 60 + seconds / 60 /60
	browser()
    return (res)
  }


require(proto)

stat_qqline <- function (mapping = NULL, data = NULL, geom = "abline", position = "identity",
distribution = qnorm, dparams = list(), na.rm = FALSE, ...) {
  StatQqline$new(mapping = mapping, data = data, geom = geom, position = position,
  distribution = distribution, dparams = dparams, na.rm = na.rm, ...)
}

StatQqline <- proto(ggplot2:::Stat, {
  objname <- "qqline"

  default_geom <- function(.) GeomAbline
  default_aes <- function(.) aes(slope = ..slope.., intercept = ..int..)
  required_aes <- c("sample")

  calculate <- function(., data, scales, quantiles = NULL, distribution = qnorm, dparams = list(), na.rm = FALSE) {
    data <- remove_missing(data, na.rm, "sample", name = "stat_qqline")

    y <- quantile(data$sample, c(0.25, 0.75))
    x <- distribution(c(0.25, 0.75))
    slope <- diff(y)/diff(x)
    int <- y[1L] - slope * x[1L]
    data.frame(slope = slope, int = int)
  }

})