# importing all the libraries used in this project
library('readxl')
library(psych)
library(tidyverse)
library(sqldf) # <- make sure you have this install, inatall.packages('sqldf')
library(ggplot2)
library(gridExtra)
library(cowplot)
library(e1071)
library(car)
library(semTools)
library(pastecs)
library(sjstats)
library(userfriendlyscience)
library(generalhoslem)
library(regclass)
library(lm.beta)
library(stargazer)
library(broom)
library(Epi)
library(arm)
library(DescTools)
library(foreign)
library(olsrr)
library('dvmisc')

# make sure the data is in local directory to this script
data <- read_excel('data_academic_performance.xlsx')
# make copy of original dataset
df<-data
names(df)
# to summarise the data properally, convert characters to factors
# df[] <- lapply( df, factor)
col_names <- c('GENDER','EDU_FATHER','EDU_MOTHER','OCC_FATHER','OCC_MOTHER','STRATUM','SISBEN','PEOPLE_HOUSE','INTERNET','TV','COMPUTER','WASHING_MCH','MIC_OVEN','CAR','DVD','FRESH','PHONE','MOBILE','REVENUE','JOB','SCHOOL_NAME','SCHOOL_NAT','SCHOOL_TYPE','Cod_SPro','UNIVERSITY','ACADEMIC_PROGRAM')
# convert  character to factors using lapply
df[col_names] <- lapply(df[col_names] , factor)
df
# to get statistical measures of the data
summary(df)

# selecting only the variables of interest only using sql syntax, make sure to install sqldf
filter_data <- sqldf('select GENDER, STRATUM ,EDU_FATHER,EDU_MOTHER,OCC_FATHER,OCC_MOTHER,SISBEN,PEOPLE_HOUSE,INTERNET,TV,COMPUTER,WASHING_MCH,MIC_OVEN,CAR,DVD,PHONE,MOBILE,REVENUE,JOB,
                        SCHOOL_NAT,SCHOOL_TYPE,MAT_S11,CR_S11,BIO_S11,ENG_S11,G_SC,CC_S11 FROM df')

filter_data
summary(filter_data)
# only categorical data
cat_data <- sqldf('select GENDER, EDU_FATHER,EDU_MOTHER,OCC_FATHER,OCC_MOTHER,SISBEN,PEOPLE_HOUSE,INTERNET,TV,COMPUTER,WASHING_MCH,MIC_OVEN,CAR,DVD,PHONE,MOBILE,REVENUE,JOB,
                        SCHOOL_NAT,SCHOOL_TYPE from df')

cat_data

# Categorical data barcharts
bar_cat_plot_list <- list()
col_names <- colnames(cat_data)
for(i in col_names){
  #     print(i)
  gg <- ggplot(cat_data, aes_string(x = i)) + geom_bar() + theme(axis.text.x = element_text(angle = 45, hjust = 1, size=5))
  bar_cat_plot_list[[i]] <- gg
} # end of loop

plot_grid(plotlist = bar_cat_plot_list)

# find null data, will remove later using dummy variables to isolate these
sqldf('select count(JOB) from cat_data where JOB == 0')
sqldf('select count(people_house) from cat_data where people_house == 0')

# continous data only
cont_data <- sqldf('select MAT_S11,CR_S11,BIO_S11,ENG_S11,CC_S11,G_SC from df')
# get statistical measure
describe(cont_data)

# find missing value
sqldf('select count(MAT_S11) from cont_data where MAT_S11 is null')
sqldf('select count(CR_S11) from cont_data where CR_S11 is null')
sqldf('select count(BIO_S11) from cont_data where BIO_S11 is null')
sqldf('select count(ENG_S11) from cont_data where ENG_S11 is null')
sqldf('select count(G_SC) from cont_data where G_SC is null')

# create normal plot
col_names <- colnames(cont_data)
col_names
# hold all the plots created in the loop
plot_list <- list()
col_names <- colnames(cont_data)
for(i in col_names){
  print(i)
  print(mean(cont_data[,i]))
  gg <- ggplot(cont_data , aes_string(i))
  gg <- gg + geom_histogram(binwidth=1, colour="black", aes(y=..density.., fill=..count..))
  gg<-gg+scale_fill_gradient("Count", low="#DCDCDC", high="#7C7C7C")
  gg<-gg+stat_function(fun=dnorm, color="red",args=list(mean=mean(cont_data[,i], na.rm=TRUE), sd=sd(cont_data[,i], na.rm=TRUE)))
  plot_list[[i]] <- gg
} # end of loop
plot_grid(plotlist = plot_list)

#Create boxplots
# hold all theplots created in the loop
box_plot_list <- list()
for(i in col_names){
  print(i)
  gg <- ggplot(cont_data, aes_string(y=i)) + geom_boxplot() + theme(text = element_text(size=20))
  box_plot_list[[i]] <- gg
} # end of loop

plot_grid(plotlist = box_plot_list)
# qq plot for each numerical data above
qqnorm(cont_data$MAT_S11 ,main='MAT_S11')+qqline(cont_data$MAT_S11, col=2) #show a line on theplot
qqnorm(cont_data$CR_S11 ,main='CR_S11')+qqline(cont_data$CR_S11, col=2) #show a line on theplot
qqnorm(cont_data$BIO_S11 ,main='BIO_S11')+qqline(cont_data$BIO_S11, col=2) #show a line on theplot
qqnorm(cont_data$ENG_S11 ,main='ENG_S11')+qqline(cont_data$ENG_S11, col=2) #show a line on theplot
qqnorm(cont_data$CC_S11 ,main='CC_S11')+qqline(cont_data$CC_S11, col=2) #show a line on theplot
qqnorm(cont_data$G_SC ,main='G_SC')+qqline(cont_data$G_SC, col=2) #show a line on theplot

# removig data that is NA,using complete.cases in case i missed finding data with Null values
head(filter_data)
filter_data<-filter_data[complete.cases(filter_data),]
filter_data

######################################################################################################### handling missing values #####################################################3
# make copy
#clean_data <- filter_data
#clean_data <- clean_data[!(clean_data$JOB == "0"),]
#clean_data <- clean_data[!(clean_data$PEOPLE_HOUSE == "0"),]
#clean_data <- clean_data[!(clean_data$EDU_FATHER == "0"),]
clean_data

# removing outliers
# removing outliers from maths, first find ranges, i use
lowerbound <- 56-1.5 * IQR(cont_data$MAT_S11)
upperbound = 72+1.5 * IQR(cont_data$MAT_S11)

# found a total of 137 outliers, these need to be removed
fn$sqldf("select count(MAT_S11) from clean_data where MAT_S11 <$lowerbound or MAT_S11 > $upperbound")
clean_data_v2<-clean_data[!(clean_data$MAT_S11 > upperbound | clean_data$MAT_S11 < lowerbound),]

# removing outliers from critical, first find ranges
lowerbound <- 54-1.5 * IQR(cont_data$CR_S11)
upperbound = 67+1.5 * IQR(cont_data$CR_S11)
fn$sqldf("select count(CR_S11) from clean_data_v2 where CR_S11 <$lowerbound or CR_S11 > $upperbound")
# found 146 in remaining set outliers
clean_data_v2<-clean_data_v2[!(clean_data_v2$CR_S11 > upperbound | clean_data_v2$CR_S11 < lowerbound),]

# removing outliers from biology, first find ranges
lowerbound <- 56-1.5 * IQR(cont_data$BIO_S11)
upperbound = 71+1.5 * IQR(cont_data$BIO_S11)
lowerbound
upperbound
fn$sqldf("select count(BIO_S11) from clean_data_v2 where BIO_S11 <$lowerbound or BIO_S11 > $upperbound")
# found 121 in remaining set outliers
clean_data_v2<-clean_data_v2[!(clean_data_v2$BIO_S11 > upperbound | clean_data_v2$BIO_S11 < lowerbound),]

# removing outliers from english, first find ranges
lowerbound <- 50-1.5 * IQR(cont_data$ENG_S11)
upperbound = 72+1.5 * IQR(cont_data$ENG_S11)
lowerbound
upperbound
fn$sqldf("select count(ENG_S11) from t where ENG_S11 <$lowerbound or ENG_S11 > $upperbound")
# found 0 in remaining set outliers
clean_data_v2<-clean_data_v2[!(clean_data_v2$ENG_S11 > upperbound | clean_data_v2$ENG_S11 < lowerbound),]

# removing outliers from CC, first find ranges
lowerbound <- 54-1.5 * IQR(cont_data$CC_S11)
upperbound = 67+1.5 * IQR(cont_data$CC_S11)
lowerbound
upperbound
fn$sqldf("select count(CC_S11) from t where CC_S11 <$lowerbound or CC_S11 > $upperbound")
# found 151 in remaining set outliers
clean_data_v2<-clean_data_v2[!(clean_data_v2$CC_S11 > upperbound | clean_data_v2$CC_S11 < lowerbound),]

# removing outliers from G_SC, first find ranges
lowerbound <- 147-1.5 * IQR(cont_data$CC_S11)
upperbound = 179+1.5 * IQR(cont_data$CC_S11)
lowerbound
upperbound
fn$sqldf("select count(G_SC) from t where G_SC <$lowerbound or G_SC > $upperbound")
# found 1258 in remaining set outliers
clean_data_v2<-clean_data_v2[!(clean_data_v2$G_SC > upperbound | clean_data_v2$G_SC < lowerbound),]

##################################################################################################### Normality testing ################################################33
# use this to help you pick the numbers
summary(cont_data)
# Getting Kurtosis and skew values of Maths, also standardised score:
math_skew <- semTools::skew(clean_data$MAT_S11)
math_kurt <- semTools::kurtosis(clean_data$MAT_S11)

# standardise the values
math_skew[1]/math_skew[2]
math_kurt[1]/math_kurt[2]

math_score_range<- abs(scale(clean_data$MAT_S11))

FSA::perc(as.numeric(math_score_range), 1.96, "gt")
FSA::perc(as.numeric(math_score_range), 3.29, "gt") #0%

# trimming maths to see if it reduces skew
y <- trim(clean_data$MAT_S11, p = 0.05)

# Getting Kurtosis and skew values of Maths, also standardised score:
math_skew <- semTools::skew(y)
math_kurt <- semTools::kurtosis(y)

# standardise the values
math_skew[1]/math_skew[2]
math_kurt[1]/math_kurt[2]

math_score_range<- abs(scale(y))

FSA::perc(as.numeric(math_score_range), 1.96, "gt")
FSA::perc(as.numeric(math_score_range), 3.29, "gt") #0%

# reduced by 8

# performing same but this time with the removed outliers
y <- trim(clean_data_v2$MAT_S11, p = 0.05)
# Getting Kurtosis and skew values of Maths, also standardised score:
math_skew <- semTools::skew(y)
math_kurt <- semTools::kurtosis(y)

# standardise the values
math_skew[1]/math_skew[2]
math_kurt[1]/math_kurt[2]

math_score_range<- abs(scale(y))

FSA::perc(as.numeric(math_score_range), 1.96, "gt")
FSA::perc(as.numeric(math_score_range), 3.29, "gt") #0%

# Getting Kurtosis and skew values of Maths, also standardised score:
math_skew <- semTools::skew(clean_data$MAT_S11)
math_kurt <- semTools::kurtosis(clean_data$MAT_S11)

# standardise the values
math_skew[1]/math_skew[2]
math_kurt[1]/math_kurt[2]

math_score_range<- abs(scale(clean_data$MAT_S11))

FSA::perc(as.numeric(math_score_range), 1.96, "gt")
FSA::perc(as.numeric(math_score_range), 3.29, "gt") #0%
# reduced by another 2

# Getting Kurtosis and skew values of Critical reading, also standardised score:
reading_skew <- semTools::skew(clean_data$CR_S11)
reading_kurt <- semTools::kurtosis(clean_data$CR_S11)

# standardise the values
reading_skew[1]/reading_skew[2]
reading_kurt[1]/reading_kurt[2]

reading_score_range<- abs(scale(clean_data$CR_S11))

FSA::perc(as.numeric(reading_score_range), 1.96, "gt")
FSA::perc(as.numeric(reading_score_range), 3.29, "gt") #0%

# Getting Kurtosis and skew values of Critical reading, also standardised score:
# This time removing outliers
reading_skew <- semTools::skew(clean_data_v2$CR_S11)
reading_kurt <- semTools::kurtosis(clean_data_v2$CR_S11)

# standardise the values
reading_skew[1]/reading_skew[2]
reading_kurt[1]/reading_kurt[2]

reading_score_range<- abs(scale(clean_data_v2$CR_S11))

FSA::perc(as.numeric(reading_score_range), 1.96, "gt")
FSA::perc(as.numeric(reading_score_range), 3.29, "gt") #0%
# reduces skew by 7

# Getting Kurtosis and skew values of Biology, also standardised score:
biology_skew <- semTools::skew(clean_data$BIO_S11)
biology_kurt <- semTools::kurtosis(clean_data$BIO_S11)

# standardise the values
biology_skew[1]/biology_skew[2]
biology_kurt[1]/biology_kurt[2]

biology_score_range<- abs(scale(clean_data$BIO_S11))

FSA::perc(as.numeric(biology_score_range), 1.96, "gt")
FSA::perc(as.numeric(biology_score_range), 3.29, "gt") #0%

# same as above but this time trimming the values
y <- trim(clean_data$BIO_S11, p = 0.05)
# Getting Kurtosis and skew values of Biology, also standardised score:
biology_skew <- semTools::skew(y)
biology_kurt <- semTools::kurtosis(y)

# standardise the values
biology_skew[1]/biology_skew[2]
biology_kurt[1]/biology_kurt[2]

biology_score_range<- abs(scale(y))

FSA::perc(as.numeric(biology_score_range), 1.96, "gt")
FSA::perc(as.numeric(biology_score_range), 3.29, "gt") #0%
# reduced skew by 10

# Getting Kurtosis and skew values of English, also standardised score:
english_skew <- semTools::skew(clean_data$ENG_S11)
english_kurt <- semTools::kurtosis(clean_data$ENG_S11)

# standardise the values
english_skew[1]/english_skew[2]
english_kurt[1]/english_kurt[2]

english_score_range<- abs(scale(clean_data$ENG_S11))

FSA::perc(as.numeric(english_score_range), 1.96, "gt")
FSA::perc(as.numeric(english_score_range), 3.29, "gt") #0%

# performing trim on above
y <- trim(clean_data$ENG_S11, p = 0.05)

# Getting Kurtosis and skew values of English, also standardised score:
english_skew <- semTools::skew(y)
english_kurt <- semTools::kurtosis(y)

# standardise the values
english_skew[1]/english_skew[2]
english_kurt[1]/english_kurt[2]

english_score_range<- abs(scale(y))

FSA::perc(as.numeric(english_score_range), 1.96, "gt")
FSA::perc(as.numeric(english_score_range), 3.29, "gt") #0%

#reduced by 5

# Getting Kurtosis and skew values of Global score, also standardised score:
global_skew <- semTools::skew(clean_data$G_SC)
global_kurt <- semTools::kurtosis(clean_data$G_SC)

# standardise the values
global_skew[1]/global_skew[2]
global_kurt[1]/global_kurt[2]

global_score_range<- abs(scale(clean_data$G_SC))

FSA::perc(as.numeric(global_score_range), 1.96, "gt")
FSA::perc(as.numeric(global_score_range), 3.29, "gt") #0%

# performing trim
y <- trim(clean_data$G_SC, p = 0.05)
# Getting Kurtosis and skew values of Global score, also standardised score:
global_skew <- semTools::skew(y)
global_kurt <- semTools::kurtosis(y)

# standardise the values
global_skew[1]/global_skew[2]
global_kurt[1]/global_kurt[2]

global_score_range<- abs(scale(y))

FSA::perc(as.numeric(global_score_range), 1.96, "gt")
FSA::perc(as.numeric(global_score_range), 3.29, "gt") #0%

# reduced by 2

################################################################################Correlation testing#############################################################333

#Scatterplot relationship, G_SC and MAT_S11
scatter <- ggplot(clean_data, aes(clean_data$MAT_S11, clean_data$G_SC))

#Add a regression line
scatter + geom_point() + geom_smooth(method = "lm", colour = "Red", se = F) + labs(x = "Maths scores(MAT_S11)", y = "Global score(G_SC)")
# Pearson Maths
stats::cor.test(clean_data$G_SC, clean_data$MAT_S11, method='pearson')

#Scatterplot relationship, G_SC and CR_S11
scatter <- ggplot(clean_data, aes(clean_data$CR_S11, clean_data$G_SC))

#Add a regression line
scatter + geom_point() + geom_smooth(method = "lm", colour = "Red", se = F) + labs(x = "Creative Reading scores(CR_S11)", y = "Global score(G_SC)")
# Pearson test Creative reading
stats::cor.test(clean_data$G_SC, clean_data$CR_S11, method='pearson')
# statistically significant result

#Scatterplot relationship, G_SC and BIO_S11
scatter <- ggplot(clean_data, aes(clean_data$BIO_S11, clean_data$G_SC))

#Add a regression line
scatter + geom_point() + geom_smooth(method = "lm", colour = "Red", se = F) + labs(x = "Biology scores(BIO_S11)", y = "Global score(G_SC)")

# Pearson test Biology
stats::cor.test(clean_data$G_SC, clean_data$BIO_S11, method='pearson')

#Scatterplot relationship, G_SC and ENG_S11
scatter <- ggplot(clean_data, aes(clean_data$ENG_S11, clean_data$G_SC))

#Add a regression line
scatter + geom_point() + geom_smooth(method = "lm", colour = "Red", se = F) + labs(x = "English(ENG_S11)", y = "Global score(G_SC)")
# Pearsons Test
stats::cor.test(clean_data$G_SC, clean_data$ENG_S11, method='pearson')

############################################################################ T-test ############################################################################
# global grade and gender
# Describe the variables
psych::describeBy(clean_data$G_SC, clean_data$GENDER, mat=TRUE)

# Using levene's test to test variance, pvalue needs to be greater than 0.05
car::leveneTest(G_SC ~ GENDER, data=clean_data)

# Levene's test showed unequal variance, therefore need to perform welsh modification to the t-test (will be rejected)
# therefore set var.equal to false
# Perfomring the T-test
stats::t.test(G_SC~GENDER,var.equal=FALSE,data=clean_data)

# Performing Cohen's d
res <- stats::t.test(G_SC~GENDER,var.equal=FALSE,data=clean_data)
effcd=round((2*res$statistic)/sqrt(res$parameter),2)
effectsize::t_to_d(t = res$statistic, res$parameter)

# global grade and Internet
# Describe the variables
psych::describeBy(clean_data$G_SC, clean_data$INTERNET, mat=TRUE)

# Using levene's test to test variance, pvalue needs to be greater than 0.05
car::leveneTest(G_SC ~ INTERNET, data=clean_data)

# Levene's test showed unequal variance, therefore need to perform welsh modification to the t-test (wull be rejected)
# therefore set var.equal to false
# Perfomring the T-test
stats::t.test(G_SC~INTERNET,var.equal=FALSE,data=clean_data)

# Performing Cohen's d
res <- stats::t.test(G_SC~INTERNET,var.equal=FALSE,data=clean_data)
effcd=round((2*res$statistic)/sqrt(res$parameter),2)
effectsize::t_to_d(t = res$statistic, res$parameter)

# global grade and tv
# Describe the variables
psych::describeBy(clean_data$G_SC, clean_data$TV, mat=TRUE)

# Using levene's test to test variance, pvalue needs to be greater than 0.05
car::leveneTest(G_SC ~ TV, data=clean_data)

# Levene's
# therefore set var.equal to true
# Perfomring the T-test
stats::t.test(G_SC~TV,var.equal=TRUE,data=clean_data)

# Performing Cohen's d
res <- stats::t.test(G_SC~TV,var.equal=TRUE,data=clean_data)
effcd=round((2*res$statistic)/sqrt(res$parameter),2)
effectsize::t_to_d(t = res$statistic, res$parameter)

# global grade and computer (will be rejected, failed levene test)
# Describe the variables
psych::describeBy(clean_data$G_SC, clean_data$COMPUTER, mat=TRUE)

# Using levene's test to test variance, pvalue needs to be greater than 0.05
car::leveneTest(G_SC ~ COMPUTER, data=clean_data)

stats::t.test(G_SC~COMPUTER,var.equal=FALSE,data=clean_data)

# Performing Cohen's d
res <- stats::t.test(G_SC~COMPUTER,var.equal=FALSE,data=clean_data)
effcd=round((2*res$statistic)/sqrt(res$parameter),2)
effectsize::t_to_d(t = res$statistic, res$parameter)

# global grade and washing machine
# Describe the variables
psych::describeBy(clean_data$G_SC, clean_data$WASHING_MCH, mat=TRUE)

# Using levene's test to test variance, pvalue needs to be greater than 0.05
car::leveneTest(G_SC ~ WASHING_MCH, data=clean_data)

stats::t.test(G_SC~WASHING_MCH,var.equal=TRUE,data=clean_data)

# Performing Cohen's d
res <- stats::t.test(G_SC~WASHING_MCH,var.equal=TRUE,data=clean_data)
effcd=round((2*res$statistic)/sqrt(res$parameter),2)
effectsize::t_to_d(t = res$statistic, res$parameter)

# global grade and car
# Describe the variables
psych::describeBy(clean_data$G_SC, clean_data$CAR, mat=TRUE)

# Using levene's test to test variance, pvalue needs to be greater than 0.05
car::leveneTest(G_SC ~ CAR, data=clean_data)

stats::t.test(G_SC~CAR,var.equal=TRUE,data=clean_data)

# Performing Cohen's d
res <- stats::t.test(G_SC~CAR,var.equal=TRUE,data=clean_data)
effcd=round((2*res$statistic)/sqrt(res$parameter),2)
effectsize::t_to_d(t = res$statistic, res$parameter)

# global grade and PHONE
# Describe the variables
psych::describeBy(clean_data$G_SC, clean_data$PHONE, mat=TRUE)

# Using levene's test to test variance, pvalue needs to be greater than 0.05
car::leveneTest(G_SC ~ PHONE, data=clean_data)

stats::t.test(G_SC~PHONE,var.equal=TRUE,data=clean_data)

# Performing Cohen's d
res <- stats::t.test(G_SC~PHONE,var.equal=TRUE,data=clean_data)
effcd=round((2*res$statistic)/sqrt(res$parameter),2)
effectsize::t_to_d(t = res$statistic, res$parameter)

# global grade and MOBILE
# Describe the variables
psych::describeBy(clean_data$G_SC, clean_data$MOBILE, mat=TRUE)

# Using levene's test to test variance, pvalue needs to be greater than 0.05
car::leveneTest(G_SC ~ MOBILE, data=clean_data)

stats::t.test(G_SC~MOBILE,var.equal=TRUE,data=clean_data)

# Performing Cohen's d
res <- stats::t.test(G_SC~MOBILE,var.equal=TRUE,data=clean_data)
effcd=round((2*res$statistic)/sqrt(res$parameter),2)
effectsize::t_to_d(t = res$statistic, res$parameter)

# testing on school nature
# Describe the variables
psych::describeBy(clean_data$G_SC, clean_data$SCHOOL_NAT, mat=TRUE)

car::leveneTest(G_SC ~ SCHOOL_NAT, data=clean_data)

stats::t.test(G_SC~SCHOOL_NAT,var.equal=FALSE,data=clean_data)

# Performing Cohen's d
res <- stats::t.test(G_SC~SCHOOL_NAT,var.equal=FALSE,data=clean_data)
effcd=round((2*res$statistic)/sqrt(res$parameter),2)
effectsize::t_to_d(t = res$statistic, res$parameter)

#################################################################################### Anova tests# ################################################33

colnames(clean_data)

clean_data

# Anova test for fathers education and global grade
# Check the statistical description of variable of interest
psych::describeBy(clean_data$G_SC, clean_data$EDU_FATHER, mat=TRUE)
# performing Barrets test for homogenity of variance
stats::bartlett.test(G_SC~ EDU_FATHER, data=clean_data)

# One-way Anova test
anova_result<-userfriendlyscience::oneway(as.factor(clean_data$EDU_FATHER),y=clean_data$G_SC,posthoc='games-howell')
anova_result
# access values in order to get f-statisitc on nect step
res2<-stats::aov(G_SC~ EDU_FATHER, data = clean_data)
fstat<-summary(res2)[[1]][["F value"]][[1]]
fstat
# Get the p-value
anova_p_value<-summary(res2)[[1]][["Pr(>F)"]][[1]]
anova_p_value
# Calculating the effect
aoveta<-sjstats::eta_sq(res2)[2]
aoveta

# Anova test for mothers education and global grade
# Check the statistical description of variable of interest
psych::describeBy(clean_data$G_SC, clean_data$EDU_MOTHER, mat=TRUE)
# performing Barrets test for homogenity of variance
stats::bartlett.test(G_SC~ EDU_MOTHER, data=clean_data)

# One-way Anova test
anova_result<-userfriendlyscience::oneway(as.factor(clean_data$EDU_MOTHER),y=clean_data$G_SC,posthoc='games-howell')
anova_result
# access values in order to get f-statisitc on nect step
res2<-stats::aov(G_SC~ EDU_MOTHER, data = clean_data)
fstat<-summary(res2)[[1]][["F value"]][[1]]
fstat
# Get the p-value
anova_p_value<-summary(res2)[[1]][["Pr(>F)"]][[1]]
anova_p_value
# Calculating the effect
aoveta<-sjstats::eta_sq(res2)[2]
aoveta

# Anova test for mothers education and global grade
# Check the statistical description of variable of interest
psych::describeBy(clean_data$G_SC, clean_data$OCC_FATHER, mat=TRUE)
# performing Barrets test for homogenity of variance
stats::bartlett.test(G_SC~ OCC_FATHER, data=clean_data)

# One-way Anova test
anova_result<-userfriendlyscience::oneway(as.factor(clean_data$OCC_FATHER),y=clean_data$G_SC,posthoc='games-howell')
anova_result
# access values in order to get f-statisitc on nect step
res2<-stats::aov(G_SC~ OCC_FATHER, data = clean_data)
fstat<-summary(res2)[[1]][["F value"]][[1]]
fstat
# Get the p-value
anova_p_value<-summary(res2)[[1]][["Pr(>F)"]][[1]]
anova_p_value
# Calculating the effect
aoveta<-sjstats::eta_sq(res2)[2]
aoveta

# Anova test for mothers education and global grade
# Check the statistical description of variable of interest
psych::describeBy(clean_data$G_SC, clean_data$OCC_MOTHER, mat=TRUE)
# performing Barrets test for homogenity of variance
stats::bartlett.test(G_SC~ OCC_MOTHER, data=clean_data)

# One-way Anova test
anova_result<-userfriendlyscience::oneway(as.factor(clean_data$OCC_MOTHER),y=clean_data$G_SC,posthoc='games-howell')
anova_result
# access values in order to get f-statisitc on nect step
res2<-stats::aov(G_SC~ OCC_MOTHER, data = clean_data)
fstat<-summary(res2)[[1]][["F value"]][[1]]
fstat
# Get the p-value
anova_p_value<-summary(res2)[[1]][["Pr(>F)"]][[1]]
anova_p_value
# Calculating the effect
aoveta<-sjstats::eta_sq(res2)[2]
aoveta

# Anova test for mothers education and global grade
# Check the statistical description of variable of interest
psych::describeBy(clean_data$G_SC, clean_data$PEOPLE_HOUSE, mat=TRUE)
# performing Barrets test for homogenity of variance
stats::bartlett.test(G_SC~ PEOPLE_HOUSE, data=clean_data)

# One-way Anova test
anova_result<-userfriendlyscience::oneway(as.factor(clean_data$PEOPLE_HOUSE),y=clean_data$G_SC,posthoc='Tukey')
anova_result
# access values in order to get f-statisitc on nect step
res2<-stats::aov(G_SC~ PEOPLE_HOUSE, data = clean_data)
fstat<-summary(res2)[[1]][["F value"]][[1]]
fstat
# Get the p-value
anova_p_value<-summary(res2)[[1]][["Pr(>F)"]][[1]]
anova_p_value
# Calculating the effect
aoveta<-sjstats::eta_sq(res2)[2]
aoveta

# Anova test for mothers education and global grade
# Check the statistical description of variable of interest
psych::describeBy(clean_data$G_SC, clean_data$REVENUE, mat=TRUE)
# performing Barrets test for homogenity of variance
stats::bartlett.test(G_SC~ REVENUE, data=clean_data)

# One-way Anova test
anova_result<-userfriendlyscience::oneway(as.factor(clean_data$REVENUE),y=clean_data$G_SC,posthoc='Tukey')
anova_result
# access values in order to get f-statisitc on nect step
res2<-stats::aov(G_SC~ REVENUE, data = clean_data)
fstat<-summary(res2)[[1]][["F value"]][[1]]
fstat
# Get the p-value
anova_p_value<-summary(res2)[[1]][["Pr(>F)"]][[1]]
anova_p_value
# Calculating the effect
aoveta<-sjstats::eta_sq(res2)[2]
aoveta

# Anova test for mothers education and global grade
# Check the statistical description of variable of interest
psych::describeBy(clean_data$G_SC, clean_data$SCHOOL_NAT, mat=TRUE)
# performing Barrets test for homogenity of variance
stats::bartlett.test(G_SC~ SCHOOL_NAT, data=clean_data)

# One-way Anova test
anova_result<-userfriendlyscience::oneway(as.factor(clean_data$SCHOOL_NAT),y=clean_data$G_SC,posthoc='Tukey')
anova_result
# access values in order to get f-statisitc on nect step
res2<-stats::aov(G_SC~ SCHOOL_NAT, data = clean_data)
fstat<-summary(res2)[[1]][["F value"]][[1]]
fstat
# Get the p-value
anova_p_value<-summary(res2)[[1]][["Pr(>F)"]][[1]]
anova_p_value
# Calculating the effect
aoveta<-sjstats::eta_sq(res2)[2]
aoveta

# Anova test for mothers education and global grade
# Check the statistical description of variable of interest
psych::describeBy(clean_data$G_SC, clean_data$SCHOOL_TYPE, mat=TRUE)
# performing Barrets test for homogenity of variance
stats::bartlett.test(G_SC~ SCHOOL_TYPE, data=clean_data)

# One-way Anova test
anova_result<-userfriendlyscience::oneway(as.factor(clean_data$SCHOOL_TYPE),y=clean_data$G_SC,posthoc='games-howell')
anova_result
# access values in order to get f-statisitc on nect step
res2<-stats::aov(G_SC~ SCHOOL_TYPE, data = clean_data)
fstat<-summary(res2)[[1]][["F value"]][[1]]
fstat
# Get the p-value
anova_p_value<-summary(res2)[[1]][["Pr(>F)"]][[1]]
anova_p_value
# Calculating the effect
aoveta<-sjstats::eta_sq(res2)[2]
aoveta

####################################################################Building MLR#############################################################

# making dummy variables to represent the categorical values. Starting with the simple 2 group variables
# Gender
clean_data_v2$dummyGender = ifelse(clean_data_v2$GENDER == "M", 0, ifelse(clean_data_v2$GENDER == "F", 1, NA))
# internet
clean_data_v2$dummyInternet = ifelse(clean_data_v2$INTERNET == "Yes", 0, ifelse(clean_data_v2$INTERNET == "No", 1, NA))
# TV
clean_data_v2$dummyTV = ifelse(clean_data_v2$TV == "Yes", 0, ifelse(clean_data_v2$TV == "No", 1, NA))
# COMPUTER
clean_data_v2$dummyComputer = ifelse(clean_data_v2$COMPUTER == "Yes", 0, ifelse(clean_data_v2$COMPUTER == "No", 1, NA))
# WASHING_MACHINE
clean_data_v2$dummyWmachine = ifelse(clean_data_v2$WASHING_MCH== "Yes", 0, ifelse(clean_data_v2$WASHING_MCH == "No", 1, NA))
# MIC_OVEN
clean_data_v2$dummyMicOven = ifelse(clean_data_v2$MIC_OVEN == "Yes", 0, ifelse(clean_data_v2$MIC_OVEN == "No", 1, NA))
# Car
clean_data_v2$dummyCar = ifelse(clean_data_v2$CAR == "Yes", 0, ifelse(clean_data_v2$CAR == "No", 1, NA))
# DVD
clean_data_v2$dummyDvd = ifelse(clean_data_v2$DVD == "Yes", 0, ifelse(clean_data_v2$DVD == "No", 1, NA))
# PHONE
clean_data_v2$dummyPhone = ifelse(clean_data_v2$PHONE == "Yes", 0, ifelse(clean_data_v2$PHONE == "No", 1, NA))
# MOBILE
clean_data_v2$dummyMobile = ifelse(clean_data_v2$MOBILE == "Yes", 0, ifelse(clean_data_v2$MOBILE == "No", 1, NA))
# SCHOOL_NAT
clean_data_v2$dummySchoolN = ifelse(clean_data_v2$SCHOOL_NAT == "PRIVATE", 0, ifelse(clean_data_v2$SCHOOL_NAT == "PUBLIC", 1, NA))

# dummy data for school type
clean_data_v2$dummySchoolAca= ifelse(clean_data_v2$SCHOOL_TYPE == "ACADEMIC", 1,0)
clean_data_v2$dummySchoolTech= ifelse(clean_data_v2$SCHOOL_TYPE == "TECHNICAL", 1,0)
clean_data_v2$dummySchoolTechAca = ifelse(clean_data_v2$SCHOOL_TYPE == "TECHNICAL/ACADEMIC", 1,0)

#dummy data for job
clean_data_v2$dummyJobNo= ifelse(clean_data_v2$JOB == "No", 1,0)
clean_data_v2$dummyJobPT= ifelse(clean_data_v2$JOB == "Yes, less than 20 hours per week", 1,0)
clean_data_v2$dummyJobFT= ifelse(clean_data_v2$JOB == "Yes, 20 hours or more per week", 1,0)

# dummy data for revenue
clean_data_v2$dummyRevenue1 = ifelse(clean_data_v2$REVENUE == "less than 1 LMMW", 1,
                                  ifelse(clean_data$REVENUE == "Between 1 and less than 2 LMMW", 1,0))

clean_data_v2$dummyRevenue2 = ifelse(clean_data_v2$REVENUE == "Between 2 and less than 3 LMMW", 1,
                                  ifelse(clean_data$REVENUE == "Between 3 and less than 5 LMMW", 1,0))

clean_data_v2$dummyRevenue3 = ifelse(clean_data_v2$REVENUE == "Between 5 and less than 7 LMMW", 1,
                                  ifelse(clean_data_v2$REVENUE == "Between 7 and less than 10 LMMW", 1,0))

# adding extra dummy variables
clean_data_v2$dummyFatherOCSmallEnt = ifelse(clean_data_v2$OCC_FATHER == "Small entrepreneur", 1,0)
clean_data_v2$dummyFatherOCTechOrProf = ifelse(clean_data_v2$OCC_FATHER == "Technical or professional level employee", 1,0)
clean_data_v2$dummyFatherOCOperator = ifelse(clean_data_v2$OCC_FATHER == "Operator", 1,0)
clean_data_v2$dummyFatherOCOther = ifelse(clean_data_v2$OCC_FATHER == "Other occupation", 1,0)
clean_data_v2$dummyFatherOCIndi = ifelse(clean_data_v2$OCC_FATHER == "Independent", 1,0)
clean_data_v2$dummyFatherOCENT = ifelse(clean_data_v2$OCC_FATHER == "Entrepreneur", 1,0)

# adding extra dummies
clean_data_v2$dummyEDUMotherIncProfEdu = ifelse(clean_data_v2$EDU_MOTHER == "Incomplete Professional Education", 1,0)
clean_data_v2$dummyEDUMotherPostGrad = ifelse(clean_data_v2$EDU_MOTHER == "Postgraduate education", 1,0)
clean_data_v2$dummyEDUMotherINCtech = ifelse(clean_data_v2$EDU_MOTHER == "Incomplete technical or technological", 1,0)
clean_data_v2$dummyEDUMotherCompProfEdu = ifelse(clean_data_v2$EDU_MOTHER == "Complete professional education", 1,0)

# adding extra dummies
clean_data_v2$dummySTtech = ifelse(clean_data_v2$SCHOOL_TYPE == "TECHNICAL", 1,0)
clean_data_v2$dummySTtechAca = ifelse(clean_data_v2$SCHOOL_TYPE == "TECHNICAL/ACADEMIC", 1,0)

# dummy variable for Father significant job
clean_data_v2$dummyFather = ifelse(clean_data_v2$OCC_FATHER == "Entrepreneur", 1,0)

# dummy variable for mother significant job
clean_data_v2$dummyMOTHER = ifelse(clean_data_v2$EDU_MOTHER == "Ninguno", 1,0)

# dummy data for more than one group
# people house
clean_data_v2$dummyPhouseOne = ifelse(clean_data_v2$PEOPLE_HOUSE == "One", 1,ifelse(clean_data_v2$PEOPLE_HOUSE == "Once", 1,0) )
clean_data_v2$dummyPhouse2t3 = ifelse(clean_data_v2$PEOPLE_HOUSE == "Two", 1,ifelse(clean_data_v2$PEOPLE_HOUSE == "Three", 1,0))
clean_data_v2$dummyPhouseAbove3 = ifelse(clean_data_v2$PEOPLE_HOUSE == "Four", 1,
                                      ifelse(clean_data_v2$PEOPLE_HOUSE == "Five", 1,
                                            ifelse(clean_data_v2$PEOPLE_HOUSE == "Six", 1,
                                                  ifelse(clean_data_v2$PEOPLE_HOUSE == "Seven",1,
                                                        ifelse(clean_data_v2$PEOPLE_HOUSE == "Eight",1,
                                                              ifelse(clean_data_v2$PEOPLE_HOUSE == "Nueve",1,
                                                                    ifelse(clean_data_v2$PEOPLE_HOUSE == "Ten",1,
                                                                          ifelse(clean_data_v2$PEOPLE_HOUSE == "Twelve or more",1,0))))))))
#
# building the model baseline with all the variables of interest
colnames(clean_data_v2)

############################################### model 1 ################################################
baseline_model1<-lm(formula = G_SC ~ MAT_S11 + CR_S11+BIO_S11+ENG_S11+CC_S11+OCC_FATHER+OCC_MOTHER+EDU_FATHER+EDU_MOTHER+dummyJobNo+dummyJobPT+dummyJobFT+SCHOOL_TYPE+
                    dummyGender+dummyInternet+dummyTV+dummyComputer+dummyWmachine+dummyMicOven+
                    dummyCar+dummyDvd+dummyPhone+dummyMobile+dummySchoolN, data= clean_data_v2)

print("Anova test")
anova(baseline_model1)
print("Summary of model")
summary(baseline_model1)
print("model Info comparison")
stargazer(baseline_model1, type="text") #Tidy output of all the required stats
print("Beta values of the model")
lm.beta(baseline_model1)

# check for influencial outliers
cooksd<-sort(cooks.distance(baseline_model1))
# plotting the cooks model
plot(cooksd, pch="*", cex=2, main="Influential Obs by Cooks distance")
abline(h = 4*mean(cooksd, na.rm=T), col="red")  # add cutoff line
text(x=1:length(cooksd)+1, y=cooksd, labels=ifelse(cooksd>4*mean(cooksd, na.rm=T),names(cooksd),""), col="red")  # add labels

# find the rows that are influential to observation
influential <- as.numeric(names(cooksd)[(cooksd > 4*mean(cooksd, na.rm=T))])  # influential row numbers
stem(influential)

# Bonferonni p-value for most extreme obs
car::outlierTest(baseline_model1)

#Assess homocedasticity
plot(baseline_model1,1)
plot(baseline_model1, 3)

#Create histogram and  density plot of the residuals
plot(density(resid(baseline_model1)))

#Create a QQ plotqqPlot(model, main="QQ Plot") #qq plot for studentized resid
car::qqPlot(baseline_model1, main="QQ Plot") #qq plot for studentized resid

# #Calculate Collinearity, will not run as you have na's in summary
vifmodel<-car::vif(baseline_model1)
vifmodel
#Calculate tolerance
1/vifmodel

#  better way of getting standardized residuals
max(stdres(baseline_model1))
min(stdres(baseline_model1))

####################################################################################### Model 2 #############################################################

baseline_model12<-lm(formula = G_SC ~ MAT_S11 + CR_S11+BIO_S11+ENG_S11+CC_S11
                    +dummyInternet+dummyWmachine+dummyMicOven+dummyCar+dummyMobile, data= clean_data_v2)

print("Anova test")
anova(baseline_model2)
print("Summary of model")
summary(baseline_model2)
print("model Info comparison")
stargazer(baseline_model2, type="text") #Tidy output of all the required stats
print("Beta values of the model")
lm.beta(baseline_model2)

# get residuals
max(stdres(baseline_model2))
min(stdres(baseline_model2))

# check for influencial outliers
cooksd<-sort(cooks.distance(baseline_model2))
# plotting the cooks model
plot(cooksd, pch="*", cex=2, main="Influential Obs by Cooks distance")
abline(h = 4*mean(cooksd, na.rm=T), col="red")  # add cutoff line
text(x=1:length(cooksd)+1, y=cooksd, labels=ifelse(cooksd>4*mean(cooksd, na.rm=T),names(cooksd),""), col="red")  # add labels

#Create a QQ plotqqPlot(model, main="QQ Plot") #qq plot for studentized resid
car::qqPlot(baseline_model2, main="QQ Plot") #qq plot for studentized resid

#Assess homocedasticity
plot(baseline_model2,1)
plot(baseline_model2, 3)

#Create histogram and  density plot of the residuals
plot(density(resid(baseline_model2)))

# #Calculate Collinearity, will not run as you have na's in summary
vifmodel<-car::vif(baseline_model2)
vifmodel
#Calculate tolerance
1/vifmodel

############################################################ model 3, selected model #################################################
baseline_model7<-lm(formula = G_SC ~ dummyFatherOCSmallEnt+dummyFatherOCTechOrProf+dummyFatherOCOperator
                    +dummyFatherOCOther+dummyFatherOCIndi+dummyFatherOCENT+dummyEDUMotherIncProfEdu
                    +dummyEDUMotherPostGrad+dummyEDUMotherINCtech+dummyEDUMotherCompProfEdu
                    +dummySTtech+dummySTtechAca+dummyMicOven+dummyMobile+dummySchoolN
                    +dummyGender+dummyInternet, data= clean_data_v2)

#  get residuals
max(stdres(baseline_model7))
min(stdres(baseline_model7))

print("Anova test")
anova(baseline_model7)
print("Summary of model")
summary(baseline_model7)
print("model Info comparison")
stargazer(baseline_model7, type="text") #Tidy output of all the required stats
print("Beta values of the model")
lm.beta(baseline_model7)

# check for influencial outliers
cooksd<-sort(cooks.distance(baseline_model7))
# plotting the cooks model
plot(cooksd, pch="*", cex=2, main="Influential Obs by Cooks distance")
abline(h = 4*mean(cooksd, na.rm=T), col="red")  # add cutoff line
text(x=1:length(cooksd)+1, y=cooksd, labels=ifelse(cooksd>4*mean(cooksd, na.rm=T),names(cooksd),""), col="red")  # add labels

plot(baseline_model7,1)
plot(baseline_model7, 3)

car::qqPlot(baseline_model7, main="QQ Plot")

plot(density(resid(baseline_model7)))

# #Calculate Collinearity, will not run as you have na's in summary
vifmodel<-car::vif(baseline_model7)
vifmodel
#Calculate tolerance
1/vifmodel


setwd("/Users/erhv/Data_Sets/Fuel Economy/1985-1997")
library(reshape)
options(stringsAsFactors = FALSE)

#FWF reported in data formats----------------------------------------------------------------------
widths <- c(4,1,2,3,28,4,2,6,2,12,6,3,5,5,32,1,6,5,5,5,5,4,6,8,10,10,10,10,10,10,1,4,3,2,15)
paths <- dir(pattern = "\\.DAT$")
paths <- paths[paths != "95MFGUI.DAT"]

#read in data files--------------------------------------------------------------------------------
d1995 <- read.fwf(file="95MFGUI.DAT", widths=c(12,4,1,2,3,28,4,2,6,2,12,6,3,5,5,32,1,6,5,5,5,5,4,6,8,10,10,10,10,10,10,1,4,3,2,15))
str(d1995)
d1995$V1<- NULL
write.table(d1995, file="1995.CSV",sep=",", col.names=FALSE, row.names=FALSE)
d1995 <- read.csv(file="1995.csv")
files <- lapply(paths, read.fwf, width=widths, as.is = TRUE)

# rbind(files[[1]], files[[2]], files[[3]],    )---------------------------------------------------
data <- do.call(rbind, files)

#Rename names of d1995  to match names of files----------------------------------------------------
datanames<- names(data)
names(d1995) <- datanames

# Combine d1995 and data---------------------------------------------------------------------------
mpg <- rbind(data, d1995)
colmap<- read.csv(file="col-map.csv", header=TRUE)

# Rename the names of mpg to match names of data frame create by Hadley for the years 1998-2007 ---
colmap<- read.csv(file="col-map.csv", header=TRUE)
names(mpg) <- colmap$ABBR

# Strip out extra whitespace on character columns--------------------------------------------------
nakedmpg<- lapply(mpg, function(x) gsub("^ +| +$", "", x))
nakedmpg<- as.data.frame(nakedmpg)

#Create Guzzler Vector-----------------------------------------------------------------------------
nakedmpg$G  <- F
nakedmpg$G[grep("GUZZLER", nakedmpg$eng.dscr.1)] <- T
nakedmpg$G[grep("GUZZLER", nakedmpg$eng.dscr.2)] <- T
nakedmpg$G[grep("GUZZLER", nakedmpg$eng.dscr.3)] <- T
table(nakedmpg$G, exclude=NULL)

#Create TURBO Vector: for different years turbocharged was entered as TRBO, TURBO, and TC*--------
nakedmpg$T  <- F
nakedmpg$T[grep("TRBO", nakedmpg$eng.dscr.1)] <- T
nakedmpg$T[grep("TRBO", nakedmpg$eng.dscr.2)] <- T
nakedmpg$T[grep("TRBO", nakedmpg$eng.dscr.3)] <- T

nakedmpg$T[grep("TURBO", nakedmpg$eng.dscr.1)] <- T
nakedmpg$T[grep("TURBO", nakedmpg$eng.dscr.2)] <- T
nakedmpg$T[grep("TURBO", nakedmpg$eng.dscr.3)] <- T

nakedmpg$T[grep("TC*", nakedmpg$eng.dscr.1)] <- T
nakedmpg$T[grep("TC*", nakedmpg$eng.dscr.2)] <- T
nakedmpg$T[grep("TC*", nakedmpg$eng.dscr.3)] <- T
table(nakedmpg$T, exclude=NULL)

#Clean up and recreate class variable--------------------------------------------------------------
table(nakedmpg$year, nakedmpg$class)
classname <- read.csv(file="classname.csv")
names(nakedmpg)[3] <- "cls"
nakedmpg <- merge(nakedmpg, classname,by="cls")

# Convert old mpg to new (post-2008) mpg ----------------------------------------------------------
nakedmpg$year <- as.numeric(nakedmpg$year)
nakedmpg$cty <- as.numeric(nakedmpg$cty)
nakedmpg$hwy <- as.numeric(nakedmpg$hwy)

new_city <- function(mpg, year) {
  ifelse(year < 2008, round(1 / (0.003259 + (1.1805 / round(mpg / 0.9)))), mpg)
}
new_highway <- function(mpg, year) {
  ifelse(year < 2008, round(1 / (0.001376 + (1.3466 / round(mpg / 0.78)))), mpg)
}

nakedmpg <- transform(nakedmpg,
  cty = new_city(cty, year),
  hwy = new_highway(hwy, year)
)

#remove uneeded and inconsistent variables---------------------------------------------------------
nakedmpg$cmb <- NULL
nakedmpg$cls <- NULL
nakedmpg$ucty <- NULL
nakedmpg$uhwy <- NULL
nakedmpg$ucmb <- NULL
nakedmpg$carline.Manufacturer.code <- NULL
nakedmpg$state.code <- NULL
nakedmpg$vi.Manufacturer.code <- NULL
nakedmpg$date <- NULL
nakedmpg$r.date <- NULL
nakedmpg$pr <- NULL
nakedmpg$b.eng.id <- NULL
nakedmpg$sc <- NULL
nakedmpg$c <- NULL
nakedmpg$fl.system <- NULL
nakedmpg$fcost<- NULL
nakedmpg$opt.disp <- NULL
nakedmpg$od <- NULL

nakedmpg$S <- NA
nakedmpg$bidx <- NA
nakedmpg$x5c <- NA
nakedmpg$vpc <- NA
nakedmpg$trans.code.1 <- NA
nakedmpg$trans.code.2 <- NA
nakedmpg$sale.mtot <- NA

#Rename m.trans into trans new format
nakedmpg$m.trans<- gsub("A3", "auto(3)",nakedmpg$m.trans)
nakedmpg$m.trans<- gsub("A4", "auto(4)",nakedmpg$m.trans)
nakedmpg$m.trans<- gsub("A5", "auto(5)",nakedmpg$m.trans)
nakedmpg$m.trans<- gsub("AV", "auto(V)",nakedmpg$m.trans)
nakedmpg$m.trans<- gsub("M3", "manual(m3)",nakedmpg$m.trans)
nakedmpg$m.trans<- gsub("M3/M4C", "manual(m3/m4C)",nakedmpg$m.trans)
nakedmpg$m.trans<- gsub("M4", "manual(m4)",nakedmpg$m.trans)
nakedmpg$m.trans<- gsub("M4C", "manual(m4C)",nakedmpg$m.trans)
nakedmpg$m.trans<- gsub("M5", "manual(m5)",nakedmpg$m.trans)
nakedmpg$m.trans<- gsub("M5C", "manual(m5C)",nakedmpg$m.trans)
nakedmpg$m.trans<- gsub("M6", "manual(m6)",nakedmpg$m.trans)
nakedmpg$m.trans<- gsub("S4", "semi-automatic(s4)",nakedmpg$m.trans)
nakedmpg$m.trans<- gsub("S5", "semi-automatic(s5)",nakedmpg$m.trans)
nakedmpg$m.trans<- gsub("C5", "creeper(C5)",nakedmpg$m.trans)
nakedmpg$m.trans<- gsub("L3", "lock-up(s3)",nakedmpg$m.trans)
nakedmpg$m.trans<- gsub("L4", "lock-up(s4)",nakedmpg$m.trans)
nakedmpg$m.trans<- gsub("L5", "lock-up(s5)",nakedmpg$m.trans)
names(nakedmpg) [4] <- "trans"
names(nakedmpg) [9] <- "eng.dscr"
names(nakedmpg) [10] <- "eng.dscr.1"
names(nakedmpg) [11] <- "eng.dscr.2"

nakedmpg$bt.2 <- as.character(nakedmpg$bt.2)
nakedmpg$bt.4 <- as.character(nakedmpg$bt.4)
nakedmpg$bt.hbk <- as.character(nakedmpg$bt.hbk)

nakedmpg$twodhpv <- substr(nakedmpg$bt.2,6,7)
nakedmpg$twolpv <- substr(nakedmpg$bt.2,9,10)
nakedmpg$fourhpv<- substr(nakedmpg$bt.4,6,7)
nakedmpg$fourlpv<- substr(nakedmpg$bt.4,9,10)
nakedmpg$hbkhpv<- substr(nakedmpg$bt.hbk,6,7)
nakedmpg$hbklpv<- substr(nakedmpg$bt.hbk,9,10)

names(nakedmpg) [25] <- "twodoor.p"
names(nakedmpg) [26] <- "twodoor.l"
names(nakedmpg) [27] <- "fourdoor.p"
names(nakedmpg) [28] <- "fourdoor.l"
names(nakedmpg) [29] <- "hatch.p"
names(nakedmpg) [30] <- "hatch.l"

nakedmpg$bt.2 <- NULL
nakedmpg$bt.4 <- NULL
nakedmpg$bt.hbk <- NULL

names(nakedmpg) [2]  <- "model"
nakedmpg$hbkhpv <- NULL
nakedmpg$hbklpv <- NULL
nakedmpg$fourlpv <- NULL

#Re-order the variables by year, ------------------------------------------------------------------
nakedmpg <- nakedmpg[order(nakedmpg[,"manufacturer"]),]
nakedmpg <- nakedmpg[order(nakedmpg[,"carline.name"]),]
nakedmpg <- nakedmpg[order(nakedmpg[,"class"]),]
nakedmpg <- nakedmpg[order(nakedmpg[,"year"]),]

# Save as csv--------------------------------------------------------------------------------------
write.table(nakedmpg, file="clean85-97.csv",sep=",", col.names=TRUE, row.names=FALSE)

#other code fit it in later to tell the story


library(tidyverse)

d <- read_csv("data.csv")
d2 <- read_csv("data2.csv")
d3 <- read_csv("data3.csv")

d4 <- inner_join(d, d2, by = "sp") %>%
  inner_join(., d3)

res <- lm(a ~ d, d4)

p <- ggplot(d4, aes(x = a, y = d)) +
  geom_point()

ggsave("fig1.png", p)

save.image("fit.rda")


a<-read.table("diag-gene.txt",header=F)
b<-t(a)
class(b)
b1<-as.vector(b)
class(b1)
c<-diag(b1)
dim(c)
write.table(c,"D-gene.txt",sep="\t",row.names=F,col.names=F)

n<-read.table("diag-mRNA.txt",header=F)
m<-t(n)
class(m)
m1<-as.vector(m)
class(m1)
y<-diag(m1)
dim(y)
write.table(y,"D-mRNA.txt",sep="\t",row.names=F,col.names=F)

n<-read.table("diag-STRING.txt",header=F)
m<-t(n)
class(m)
m1<-as.vector(m)
class(m1)
y<-diag(m1)
dim(y)
write.table(y,"D-STRING.txt",sep="\t",row.names=F,col.names=F)

a<-read.table("diag-pearson.txt",header=F)
b<-t(a)
class(b)
b1<-as.vector(b)
class(b1)
c<-diag(b1)
dim(c)
write.table(c,"D-pearson.txt",sep="\t",row.names=F,col.names=F)


library(tidyverse)

##############################################################################
# Experiment 1 data

noise_exp <- read.csv("./outputs/simuls_nips/individual_spatial/scores.csv",
                      nrows = 6, header = F)
for  (ii in c(2, 3, 4, 5, 6, 1)){
  noise_exp[ii,] <- noise_exp[ii,] / noise_exp[1,]
}
noise_exp <- noise_exp[2:6,] %>%
  gather(key = "estimator", value = "score")

# Identity + logDiag
# Supervised + Logdiag
# Identity + Wasserstein
# Unsupervised + Geom
# Supervised + Geom

estimator_levels <- c("log-diag", "sup. log-diag", "Wasserstein", "geometric",
                      "sup. geometric")
estimator <- estimator_levels %>% factor(levels = estimator_levels)
noise_exp$estimator <- rep(estimator, times = 10)

noises <- read.csv("./outputs/simuls_nips/individual_spatial/noises_A.csv", header = F)
noise_exp$xaxis <- rep(noises[["V1"]], each = 5)
is_supervised <- noise_exp$estimator %>% grepl("sup", .)
noise_exp$supervised <- ifelse(is_supervised, "sup", "unsup") %>%
    as.factor()

color_cats <- c(
  "#009D79",# blueish green
  "#009D79",# blueish green
  "#E36C2F",  #vermillon
  "#EEA535", # orange
  "#EEA535"  # orange
  # "#56B4E9",# sky blue
  # "#F0E442", #yellow
  # "#0072B2", #blue
  # "#CC79A7" #violet
)

ggplot(
  data = noise_exp,
  mapping = aes(y = score, x = xaxis, group = estimator,
                color = estimator, fill = estimator, linetype=supervised)) +
  geom_hline(yintercept = 1., color = "black", linetype = "dotted",
             size = 1) +
  geom_line(size = 1.5, alpha = 0.8) +
  geom_point(fill = "white", size = 3, shape = 21) +
  theme_minimal() +
  scale_x_log10() +
  scale_y_continuous(limits = c(0, 1.05)) +
  scale_color_manual(values = color_cats, name = NULL) +
  scale_fill_manual(values = color_cats, name = NULL) +
  scale_linetype_manual(values=c("dotdash", "solid"), name = NULL) +
  annotate(geom = "text", x = 0.0045, y = 1.04, label = "chance level") +
  labs(x = expression(sigma),
       y = "Normalized MAE") +
  guides(
      color = guide_legend(
          nrow = 2,
          override.aes = list(linetype = c("solid", "dotdash", "solid", "solid", "dotdash")))) +
  guides(linetype = F) +
  theme(text = element_text(family = "Helvetica", size = 16),
        legend.position = "top",
        legend.margin = margin(t = 0, r = 0, b = -.4, l = -1, unit="cm"),
        legend.title = element_text(size = 14))

ggsave("./outputs/fig_1c_individual_noise.png", width = 5, height = 3.5, dpi = 300)
ggsave("./outputs/fig_1c_individual_noise.pdf", width = 5, height = 3.5, dpi = 300)


# Experimental and Statistical Methods in Biological Sciences I
# Demo 2: Descriptive statistics and plotting the data

# Heini Saarimäki 25.9.2014

# -----

# 1. Load in data

setwd('Z:/Desktop/Demo2')
ageweight <- read.csv("http://becs.aalto.fi/~heikkih3/age_weight2.csv")

# Examine your data

head(ageweight)
summary(ageweight)

# Save the original data into a new dataframe

ageweight.orig <- ageweight

# Change MALE into a factor

ageweight$MALE <- factor(ageweight$MALE)

# Change weird (< 0 ) WEIGHT values to NA

which(ageweight$WEIGHT <= 0)
ageweight[which(ageweight$WEIGHT <= 0), "WEIGHT"] <- NA

summary(ageweight)

# Attach the ageweight data

attach(ageweight)

# -----

# 2. Basics in plotting

# --

# 2.1 Basic structure of plotting functions

# Using plot function...

# For a numeric variable: scatterplot
plot(WEIGHT)

# For a factor (i.e., categorical variable): bar chart
plot(MALE)

# For 2 numeric variables: scatterplot
plot(AGE, WEIGHT)
plot(WEIGHT~AGE)		# equivalents!

# For a factor and a numeric variable: box plot
plot(MALE, WEIGHT)

# For 2 factors: bar chart
plot(MALE, SMOKE1)

# Other plotting functions..

# Histograms:
hist(WEIGHT)

# Box plots:
boxplot(WEIGHT)

# --

# 2.2 Modifying your plots

# Build up a nice scatterplot by adding named arguments:

plot(WEIGHT~AGE, main="Weight by Age",		# add main title
	xlab="Age (yrs)", ylab="Weight (kg)",	# add axis labels
	pch=16, col="blue",				# modify points
	xlim=c(0,70), ylim=c(0,140))			# scale axes

abline(lm(WEIGHT~AGE),					# draw regression line
	lty="dashed",					# modify line
	lwd=2,
	col="red")

# Make a nice histogram:

hist(WEIGHT, main="Weight", xlab="Weight", ylab="")

# Set total area size of histogram to 1:

hist(WEIGHT, main="Weight", xlab="Weight", ylab="", freq=F)

# Change the bin size

hist(WEIGHT)			# automatic binning

hist(WEIGHT, breaks=15)		# suggest the number of bins

bins=seq(20,140,by=20)		# suggest the size of a bin
hist(WEIGHT, breaks=bins)

# Advanced graphics:

# Sometimes you want to add a normal curve approximation to the plot.

# First, create the histogram object:
h <- hist(WEIGHT, freq=F, main="Distribution of Weights",
	xlab="Weight (kg)", ylab="")

# Second, find highest and lowest values and create a sequence of them:
x <- min(h$breaks):max(h$breaks)

# Third, create vector y from normal distribution with same mean and sd as WEIGHT:
y <- dnorm(x,
	mean=mean(WEIGHT, na.rm=T),
	sd=sd(WEIGHT, na.rm=T))

# Finally, add the normal curve:
lines(x,y,col="red", lty="dashed", lwd=3)

# --

# 2.3 Opening several plots in the same display

# E.g., put 4 plots in the same display:

layout(matrix(c(1,2,3,4),2,2))
hist(WEIGHT, main="Weight")
hist(HEIGHT, main="Height")
plot(SMOKE1, main="Smoking at time point 1")
plot(SMOKE2, main="Smoking at time point 2")

# --

# 2.4 Saving your plots

# First, open a device, then draw your plot, then close the device:

pdf(file="hist_weight.pdf")
hist(WEIGHT, main="Weight", xlab="Weight (kg)", ylab="")
dev.off()

# --

# 2.5 Exercises

# Question 1:

hist(WEIGHT,
	xlim=c(0,150), 			# scales x axis
	breaks=6, 				# sets number of bins
	col="red", 				# sets bar colour
	xlab="Weight (kg)", 		# sets x label
	bg="grey")				# OUGHT TO set background colour?

# Note: bg looks like it should set the background colour,
# BUT it does not actually work this way (see the arguments 'hist' approves of by
# checking ?hist.
# If you want to do it, you should use this instead:

par(bg="grey")
hist(WEIGHT, xlim=c(0,150), breaks=6, col="red", xlab="Weight (kg)")

# Here, we define the parameter background with function 'par'
# The background will stay grey until we change it, so run this next:
par(bg="white")

# NOTE: If you want to change the 'par' arguments, the defaults are somewhat tricky
# to restore. If you are using 'par' arguments, it is good to save the defaults first
# in an object:
opar <- par()   # stores whatever parameters you have currently
#  Now, you can change what ever you want:
par(bg="green")
plot(WEIGHT, AGE)  # see what changed
# And restore the default values this way:
par(opar)

# -

# Question 2:

hist(WEIGHT,
	xlim=c(0,150),
	breaks=6,
	col="red",
	xlab="Weight (kg)",
	main="")				# sets title to none

# -

# Question 3:

# Hmm.. Maybe weight increases with age?

plot(AGE, WEIGHT)

# So it seems.

# -

# Question 4:

plot(AGE, WEIGHT,
	pch=10,				# set plot character type
	col="green")			# set plot character colour

abline(lm(WEIGHT~AGE))			# add regression line

# -

# Question 5:

plot(MALE, WEIGHT)

# Weight seems to depend on gender too.

# -

# Question 6:

# In question 3 both variables are numeric, so a scatterplot is produced.
# In question 5 there is one factor and one numeric variable, so a boxplot is produced.
# Output of plot function depends on input!

# -

# Question 7:

# An example plot:
plot(AGE, WEIGHT, pch=20,
	main="Weight by Age", xlab="Age (yrs)", ylab="Weight (kg)")

# Changing font size larger for main title:

plot(AGE, WEIGHT, pch=20,
	main="Weight by Age", xlab="Age (yrs)", ylab="Weight (kg)",
	cex.main=2)

# Changing font style to bold-italic for axes labels:

plot(AGE, WEIGHT, pch=20,
	main="Weight by Age", xlab="Age (yrs)", ylab="Weight (kg)",
	font.lab=4)

# Changing font type for the whole graph:

plot(AGE, WEIGHT, pch=20,
	main="Weight by Age", xlab="Age (yrs)", ylab="Weight (kg)",
	family="mono")

# -----

# 3. Descriptive statistics & plotting of categorical variables

# -

# 3.1 Contingency tables

# One categorical variable (same information as with summary...)

table(MALE)

# Two categorical variables:

table(MALE, SMOKE1)

# Or even more...

table(MALE, SMOKE1, SMOKE2)

# Express frequencies as percentages:

round(prop.table(table(MALE, SMOKE1), margin=1)*100, 1)

# -

# 3.2 Plotting

# A simple bar chart:

plot(MALE)

# A boosted bar chart:

plot(MALE, col=c("red", "blue"), xlab="Gender")

# A simple bar chart for displaying two categorical variables:

plot(MALE, SMOKE1)

# Again then same one boosted:

plot(SMOKE1, MALE, col=c("red", "blue"),
	xlab="Smoking", ylab="Gender")

# -

# 3.3 Exercises

# Question 8:

table(SMOKE1, SMOKE2)

# 26 people quit smoking (smoked at time 1 but not at time 2)

# -

# Question 9

plot(SMOKE1, SMOKE2,
	main="Smoking",
	xlab="Smoking, time 1", ylab="Smoking, time 2",
	col=c("green", "red"))

# Example: how to add frequency values to the plot:

smoke.table <- table(SMOKE1,SMOKE2)		# save contingency table

text(0.25,0.2,smoke.table[1,1], cex=2)
text(0.25,0.8,smoke.table[1,2], cex=2)
text(0.77,0.2,smoke.table[2,1], cex=2)
text(0.77,0.8,smoke.table[2,2], cex=2)

# -----

# 4. Descriptive statistics & plotting of continuous variables

# --

# 4.1 Descriptive statistics

# Summary:

summary(ageweight)

# Use describe function from 'psych' package:

install.packages('psych')		# install if necessary
library('psych')				# load for the use of this session
describe(ageweight)

# You can also take each descriptive statistic separately:

mean(WEIGHT, na.rm=T)			# na.rm=T removes missing values
var(WEIGHT, na.rm=T)

# Take average weight for men and women separately:

tapply(WEIGHT, MALE, mean, na.rm=T)

# Take average weight for female and male non-smokers and smokers separately:

tapply(WEIGHT, list(MALE, SMOKE1), mean, na.rm=T)

# Save your table in .csv format:

my.table <- tapply(WEIGHT, list(MALE, SMOKE1), mean, na.rm=T)
write.csv(my.table, "my_table.csv")

# --

# 4.2 Plotting

# Box plot of a numeric variable:

boxplot(WEIGHT)		# remember to modify boxplots too! (add labels etc.)

# Use box plot

layout(matrix(c(1,2)))
boxplot(ageweight$WEIGHT, main="Missing values removed")
boxplot(ageweight.orig$WEIGHT, main="Original data")

# Box plots can be taken for categories separately:

plot(MALE, WEIGHT, main="Weight by Gender", ylab="Weight (kg)")

# Histogram shows the shape of the distribution efficiently:

hist(WEIGHT)
hist(WEIGHT, breaks=20)		# adjust e.g. number of bins

# --

# 4.3 Exercises

# Question 10

mean(HEIGHT)
sd(HEIGHT)

#

# -

# Question 11

height_mean <- tapply(HEIGHT, MALE, mean, na.rm=T)	# save table of means
height_sd <- tapply(HEIGHT, MALE, sd, na.rm=T)		# save table of sd's

height_table <- rbind(height_mean, height_sd)		# combine tables
height_table

# (a) women: mean height 1.66 (sd 0.07)
# (b) men: mean height 1.80 (sd 0.07)

# Save final table:

write.csv(height_table, "Height_by_gender.csv")

# -

# Question 12

hist(HEIGHT)

# -

# Question 13

h <- hist(HEIGHT, freq=F)
x <- seq(min(h$breaks),max(h$breaks), by=0.025)
y <- dnorm(x, mean=mean(HEIGHT, na.rm=T), sd=sd(HEIGHT, na.rm=T))
lines(x,y,col="red", lty="dashed", lwd=2)

# -

# Question 14

h <- hist(HEIGHT, freq=F,
	ylim=c(0,5), 					# change y axis
	main="Distribution of Height", 		# add main title
	xlab="Height (m)", ylab="",			# add axis labels
	col="grey")						# change colour
x <- seq(min(h$breaks),max(h$breaks), by=0.025)
y <- dnorm(x, mean=mean(HEIGHT, na.rm=T), sd=sd(HEIGHT, na.rm=T))
lines(x,y,col="red", lty="dashed", lwd=2)

# -

# Question 15

pdf(file="Height_distribution.pdf")
h <- hist(HEIGHT, freq=F,
	ylim=c(0,5),
	main="Distribution of Height",
	xlab="Height (m)", ylab="",
	col="grey")
x <- seq(min(h$breaks),max(h$breaks), by=0.025)
y <- dnorm(x, mean=mean(HEIGHT, na.rm=T), sd=sd(HEIGHT, na.rm=T))
lines(x,y,col="red", lty="dashed", lwd=2)
dev.off()

# -

# Question 16

boxplot(HEIGHT)

# (a) median is a bit over 1.7 m
# (b) distribution looks quite normal, maybe a bit more higher values than lower

# -

# Question 17

boxplot(HEIGHT~MALE, main="Height by Gender", ylab="Height (m)", xlab="Gender")

# men seem to be taller than women

# -

# Question 18

layout(matrix(c(1,2)))
boxplot(WEIGHT, main="Box plot of Weight", ylab="Weight (kg)", col="grey")
hist(WEIGHT, main="Histogram of Weight", xlab="Weight (kg)", ylab="", col="grey")

# -----

# 5. Exercises

# Load in naming data

naming <- read.csv("http://becs.aalto.fi/~heikkih3/naming_new.csv")

# Check for missing values and that factors are factors

summary(naming)

# Everything looks ok!
# We have 2 factors (word.type, sex) already coded as factors
# ... and 3 numeric variables (iq, hrs, ms)
# Missing values in iq already coded as NA's
# Other values look fine too.

# Detach ageweight and attach naming:
detach(ageweight)
attach(naming)

# -

# Question 20

plot(word.type,ms)

# Reading times for regular words seem to be faster than for exceptional words.

layout(matrix(c(1,2)))
plot(word.type, ms, data=naming[which(sex=="female"),],
	main="Female")
plot(word.type, ms, data=naming[which(sex=="male"),],
	main="Male")

# Effect of word type on reading types seems similar in men and women.
# I.e., no gender effects on differences in reading times between different word types.

# -

# Question 21

# Take a subset of the data:

naming_subset <- naming[1:1000, c("iq", "hrs", "sex")]

# Check this new subset:

head(naming_subset)
summary(naming_subset)

# Detach whole data and attach just the subset:

detach(naming)
attach(naming_subset)

# -

# Question 22

# Create factor reading group:

naming_subset$reading.group <- 'low'
naming_subset$reading.group[which(hrs>3.5)] <- 'medium'
naming_subset$reading.group[which(hrs>4.5)] <- 'high'
naming_subset$reading.group <- factor(naming_subset$reading.group)

# Check out the data now:

head(naming_subset)
summary(naming_subset)

# Need to attach the data again (cause we added a variable!)
# Previously added variables will be masked automatically

attach(naming_subset)

# -

# Question 23

table(sex,reading.group)		# contingency table
plot(table(sex,reading.group))	# bar charts

# No differences between men and women in how many participants are in which reading group.

# -

# Question 24

# Plot reading hours by gender:

boxplot(hrs~sex, main="Reading hours by gender", ylab="Reading hours")

# Shows similar lack of differences as question 23.

# -

# Question 25

# Plot intelligence by gender:

boxplot(iq~sex, main="Intelligence by gender", ylab="IQ")

# No differences in intelligence between men and women.

# -

# Question 26

# Plot histogram of intelligence with a normal curve approximation:

h <- hist(iq, freq=F, main="Distribution of IQ", xlab="IQ", ylab="", col="grey")
x <- min(h$breaks):max(h$breaks)
y <- dnorm(x, mean=mean(iq, na.rm=T), sd=sd(iq, na.rm=T))
lines(x,y,col="red", lty="dashed", lwd=2)

# Other ways to check for normality (see Section 6):
qqnorm(iq)					# QQ-plot
qqline(iq, col="red", lwd=2)
shapiro.test(iq)

# Both histogram, qq-plot and Shapiro-Wilk test for normality suggest the same:
# intelligence in this data set follows normal distribution.

# -

# Question 27

# Descriptive statistics for experimental manipulation (reading times by word type):

mean <- tapply(naming$ms, naming$word.type, mean, na.rm=T)
sd <- tapply(naming$ms, naming$word.type, sd, na.rm=T)

reading_times <- rbind(mean, sd)
reading_times

write.csv(reading_times, "reading_times.csv")

# Descriptive statistics for background variables:

bg_variables <- describe(naming_subset)
bg_variables

write.csv(bg_variables, "background_variables.csv")

# -----

# 6. Basic tools for testing for normality

# 6.1 Histogram

# Resets the seed for randomization:

set.seed(111)

# Take a sample of 20 from normal distribution:

data_normal <- rnorm(20)

# And a sample of 20 from exponential distribution:

data_exp <- rexp(20)

# Look at the histograms:

layout(matrix(c(1,2), nrow=1))
hist(data_normal)
hist(data_exp)

# -

# 6.2 Q-Q plot

?qqnorm
layout(matrix(c(1,2), nrow=1))
qqnorm(data_normal)
qqline(data_normal)
qqnorm(data_exp)
qqline(data_exp)

# data_normal is relatively normally distributed,
# but data_exp is clearly not

# -

# 6.3 Statistical tests for normality

# Shapiro-Wilk test:

shapiro.test(data_normal)
shapiro.test(data_exp)

# Kolmogorov-Smirnov test:
ks.test(data_normal, "pnorm", mean=mean(data_normal), sd=sd(data_normal))
ks.test(data_exp, "pnorm", mean=mean(data_exp), sd=sd(data_exp))

# Normality tests confirm the observation from the Q-Q plots:
# data_normal is normally distributed, data_exp is not.

# ------


context('hi')

test_that('full_st histograms', {

    # ~.05 every 10ms, so 50ms = 25% change in activation
    setwd('/Users/Olive/Documents/GitHub/bc/stfeasibility')

    speeds <- sample(seq(0.05,1,length.out=100)) # this is the one that produced 100 speeds, unseeded with lipschitz constraints.
    speeds <- sample(seq(0.05,1,length.out=3))
    loop_update(1.0)
    destination <- "/Volumes/GoogleDrive/My\ Drive/outputs/apr18_outputs" #don't include trailing slash
    destinations <- pblapply(seq(1,100),function(i){
        message(sprintf('CURRENT I: %s',1))
        out_filepath <- "%s/ste_1e5_speed_%s_timefin_%s.rds"%--%c(destination, i,format(Sys.time(), "%H:%M:%OS3"))
        message('Saving to %s' %--% out_filepath)
        my_H_matrix <- read.csv("data/fvc_hentz_2002.csv", row.names=1) %>% as.matrix
        saveRDS(st_with_vel(my_H_matrix, speeds[i], har_n=1e5),out_filepath)
        # on MSI
        # system("rclone copy outputs remote:outputs", wait=TRUE)
        system(sprintf("rm %s",out_filepath), wait=TRUE)
        gc()
        return(out_filepath)
    })

test_that("we can plot things about the many tasks", {
    library(data.table)
    six_speed_spatiotemporal_evaluations <- readRDS("/Volumes/GoogleDrive/My\ Drive/outputs/100kvals_task_A_10N_mat_A.rds")
    runplots(six_speed_spatiotemporal_evaluations)
    run_step_speed_distributions_plot(six_speed_spatiotemporal_evaluations)
})

skip('not today ')
test_that('minitest', {
    vector_out <- c(10,0,0,0)
    profvis({smallest_feasible_speedlimit <- bisection_method(1e-8, 0.25, 1e-5, f = force_cos_ramp_is_feasible, vector_out=vector_out)})
    velocity_constraint_options <- seq(smallest_feasible_speedlimit, 1.0, length.out = 1)
    har_n <- 1e3
    n_task_values <- 3
    pbmclapply(velocity_constraint_options, function(speed_limit){
        my_filename <- paste0("max_force_is_submaximal_10.0N_in_fx__n_task_values_", n_task_values, "_speed_limit_",speed_limit, "har_n_",har_n, ".csv")
        tall_segment <- har_dataframe_force_cos(H_matrix, bounds_tuple_of_numeric, speed_limit,speed_limit,n_task_values, har_n, vector_out)
        write.csv(tall_segment, my_filename)
        print('wrote to csv:')
        print(my_filename)
    }, mc.cores=detectCores(all.tests = FALSE, logical = TRUE))
})

library(pracma)
skip('not today ')
test_that('very submaximal forces', {
    profvis({vector_out <- c(10,0,0,0)
    smallest_feasible_speedlimit <- bisection_method(1e-9, 0.10, 1e-5, f = force_cos_ramp_is_feasible, vector_out=vector_out)
    velocity_constraint_options <- c(logseq(smallest_feasible_speedlimit, 1.0, length.out = 8),1)
    har_n <- 1e5
    n_task_values <- 20
    pbmclapply(velocity_constraint_options, function(speed_limit){
        my_filename <- paste0("max_force_is_submaximal_10.0N_in_fx__n_task_values_", n_task_values, "_speed_limit_",speed_limit, "har_n_",har_n, ".csv")
        print('starting')
        print(my_filename)
        tall_segment <- har_dataframe_force_cos(H_matrix, bounds_tuple_of_numeric, speed_limit,speed_limit,n_task_values, har_n, vector_out)
        print('wroteCSV')
        write.csv(tall_segment, my_filename)
        print('wrote to csv:')
        print(my_filename)
    }, mc.cores=detectCores(all.tests = FALSE, logical = TRUE))}, interval=300)
})

context('fullst 20')
skip('not today ')
test_that('full_ st histograms_20', {
    profvis({vector_out <- c(28.8,0,0,0)
    smallest_feasible_speedlimit <- bisection_method(1e-9, 10, 1e-5, f = force_cos_ramp_is_feasible, vector_out=vector_out)
    velocity_constraint_options <- c(logseq(smallest_feasible_speedlimit, 1.0, length.out = 8),1.0)
    har_n <- 1e5
    n_task_values <- 20
    pbmclapply(velocity_constraint_options, function(speed_limit){
        my_filename <- paste0("ramp_to_full_mvc_fx_28.8N_n_task_values_", n_task_values, "_speed_limit_",speed_limit, "har_n_",har_n, ".csv")
        print(my_filename)
        tall_segment <- har_dataframe_force_cos(H_matrix, bounds_tuple_of_numeric, speed_limit,speed_limit,n_task_values, har_n, vector_out)
        print('wroteCSV')
        write.csv(tall_segment, my_filename)
    }, mc.cores=detectCores(all.tests = FALSE, logical = TRUE))}, interval=300)
})

skip('not today ')
test_that('tailor visualization', {

    p <- ggplot(tall_df_st_and_no_st, aes(fill=st,frame=as.factor(task_index))) +  geom_density(aes(activation), alpha=0.25) + facet_grid(~muscle, space="free")
    p <- p + theme_classic() + xlab("Task Index") + ylab("Number of Trajectories") + ggtitle("ST of 0.5 max delta activation per 10ms vs degenerate case")
    p <- p + scale_y_continuous(labels = scales::percent)
    gganimate::gganimate(p, output_subfolder_path("st_animation2", "st_animation2.html"))

    site <- ggplotly(p)
    htmlwidgets::saveWidget(site, output_subfolder_path("st_histograms", "st_histograms.html"))
})

skip('not today ')
test_that('tailor animation', {
p <- ggplot(tall_df_st_and_no_st, aes(fill=st, frame=as.factor(task_index))) +  geom_histogram(aes(activation)) + facet_grid(~muscle, space="free")
    p <- p + theme_classic() + xlab("Task Index") + ylab("Number of Trajectories") + ggtitle("ST of 0.5 max delta activation per 10ms vs degenerate case")
    p <- p + scale_y_continuous(labels = scales::percent)
    p <- p + geom_segment(aes(x =max(activation), y = 0, xend = max(activation), yend = 1, group=muscle), linetype="dashed",  color="red")
    gganimate::gganimate(p, output_subfolder_path("st_animation", "st_animation.html"))
    show(p)
})

skip('not today ')
test_that('logical binary newton bisection_method works', {
    x_is_at_least_67 <- function(x) x>=67.98095181
    bisection_method(1.0,100.0,tol=1e-9,x_is_at_least_67)
})

skip('not today ')
test_that('boxplot significance testing', {
p <- ggplot(tall_df_st_and_no_st, aes(task_index,activation,fill=st, group=task_index)) +  geom_boxplot() + facet_grid(st~muscle, space="free")
skip('not today')
    p <- p + theme_classic() + xlab("Task Index") + ylab("Number of Trajectories") + ggtitle("ST of 0.5 max delta activation per 10ms vs degenerate case")
    p <- p + scale_y_continuous(labels = scales::percent)
    p <- p + geom_segment(aes(x =max(activation), y = 0, xend = max(activation), yend = 1, group=muscle), linetype="dashed",  color="red")
    gganimate::gganimate(p, output_subfolder_path("st_animation", "st_animation.html"))
    show(p)
})

skip('not today ')
test_that('animate sample trajectories', {

p <- ggplot(tall_df_st_and_no_st, aes(task_index,activation,fill=st, group=task_index)) +  geom_boxplot() + facet_grid(st~muscle, space="free")
    p <- p + theme_classic() + xlab("Task Index") + ylab("Number of Trajectories") + ggtitle("ST of 0.5 max delta activation per 10ms vs degenerate case")
    p <- p + scale_y_continuous(labels = scales::percent)
    p <- p + geom_segment(aes(x =max(activation), y = 0, xend = max(activation), yend = 1, group=muscle), linetype="dashed",  color="red")
    gganimate::gganimate(p, output_subfolder_path("st_animation", "st_animation.html"))
    show(p)
})


a <- c(1,2,3)
a

b <- c(1,2,3)

a+b


# @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
# Section - In-text figures
# @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
print(paste0(Sys.time(), " --- in-text figures"))

# Methods

# % of valid species
dim(df_all) # includes subspecies
dim(df_all[status %in% c("Valid species", "Synonym")])
round(prop.table(table(df_all$status))*100, 1)

# Number of PTEs
dim(df_describers)
dim(df_describers[spp_N_1st_auth_s>=1])

# Date of birth
dim(df_describers[spp_N_1st_auth_s>=1 & !is.na(dob.describer)])


setwd("~/scratch")
library(dplyr)

# create dataset of Hypertension, Obesity, Diabetes for COVID patients 2020

# import CDC data
df_raw <- read.csv("CDC_Conditions_Contributing_to_COVID-19_Deaths__by_State_and_Age.csv", na.strings = c("","NA"))

# select variables
df_of_interest <- df_raw %>% select("Group","Year","State","Condition","Age.Group","COVID.19.Deaths","Number.of.Mentions")

# filter for [Year, 2020, Conditions]
df_filtered <- df_of_interest %>% filter(Year == "2,020",
                          Condition %in% c("Diabetes","Hypertensive diseases","Obesity"),
                          Group == "By Year",
                          State != "United States"
                          )
# convert to numbers
df_filtered$COVID.19.Deaths <- as.numeric(df_filtered$COVID.19.Deaths)
df_filtered$Number.of.Mentions <- as.numeric(df_filtered$Number.of.Mentions)

# remove commas
df_filtered$Year <- as.numeric(gsub(",","",df_filtered$Year))

# spread / pivot
library(tidyr)
df_spread <- df_filtered %>% spread(Condition, COVID.19.Deaths)
df_spread <- df_filtered %>% pivot_wider(
  names_from = c(Condition),
  values_from = c(COVID.19.Deaths, Number.of.Mentions)
)

write.csv(df_spread, "Comorbidities_Mortality_CDC_2020.csv")

# explore
df_spread %>% summary()

# amount of NA's for 0-24
df_spread %>%
  select(Age.Group
         ,`COVID.19.Deaths_Hypertensive diseases`
         ,COVID.19.Deaths_Diabetes
         ,COVID.19.Deaths_Obesity
         ,`Number.of.Mentions_Hypertensive diseases`
         ,Number.of.Mentions_Diabetes
         ,Number.of.Mentions_Obesity) %>%
  filter(Age.Group == "0-24") %>% summary()

df_spread_selected <- df_spread %>%
  select(
         `COVID.19.Deaths_Hypertensive diseases`
         ,COVID.19.Deaths_Diabetes
         ,COVID.19.Deaths_Obesity
         ,`Number.of.Mentions_Hypertensive diseases`
         ,Number.of.Mentions_Diabetes
         ,Number.of.Mentions_Obesity)

# create a template for compare_summary_table
sum1 <- do.call(cbind, lapply(df_spread_selected, summary))
compare_summary_table <- cbind(sum1)

# loop for each one testing
# create list for each
listOfAgeGroups <- unique(df_spread$Age.Group)
listOfAgeGroupsDFs <- paste0("df_",listOfAgeGroups)

# loop
for (i in 1:10) {
  print(i)
  DF <- df_spread %>%
    filter(Age.Group == listOfAgeGroups[i]) %>%
    select(`COVID.19.Deaths_Hypertensive diseases`
           ,COVID.19.Deaths_Diabetes
           ,COVID.19.Deaths_Obesity
           ,`Number.of.Mentions_Hypertensive diseases`
           ,Number.of.Mentions_Diabetes
           ,Number.of.Mentions_Obesity)
  print(paste0("df_",listOfAgeGroups[i]))
  assign(listOfAgeGroupsDFs[i], do.call(cbind, lapply(DF, summary)))
  print(listOfAgeGroupsDFs[i])
  # use get to call variable from string
  summaryDF <- as.data.frame(get(listOfAgeGroupsDFs[i]))
  names(summaryDF) <- paste(names(summaryDF), listOfAgeGroups[i],sep=".")
  compare_summary_table <- cbind(compare_summary_table,summaryDF)
}

write.csv(compare_summary_table,"compare_summary_table.csv")

# impute
df_spread_selected

install.packages("devtools")
library(devtools)
install_github( "decisionpatterns/tidyimport")
impute(df_spread_selected)

## scratch below

install.packages("mlr")
library(mlr)
install.packages('tidyimpute')

df_spread %>%
  select(Age.Group
         ,`COVID.19.Deaths_Hypertensive diseases`
         ,COVID.19.Deaths_Diabetes
         ,COVID.19.Deaths_Obesity
         ,`Number.of.Mentions_Hypertensive diseases`
         ,Number.of.Mentions_Diabetes
         ,Number.of.Mentions_Obesity) %>%
  filter(Age.Group == "0-24") %>% summary()

assign("sum1",do.call(cbind, lapply(df_24, summary)))
sum1 <- as.data.frame(sum1)
names(sum1) <- paste(names(sum1),"0-24",sep=".")

assign("sum2",do.call(cbind, lapply(df_spread, summary)))

sum1 <- do.call(cbind, lapply(df_spread, summary))
compare_summary_table <- cbind(sum1)

# loop each one
listOfAgeGroups <- unique(df_spread$Age.Group)
for (i in listOfAgeGroups) {
  DF <- df_spread %>%
    select(Age.Group
           ,`COVID.19.Deaths_Hypertensive diseases`
           ,COVID.19.Deaths_Diabetes
           ,COVID.19.Deaths_Obesity
           ,`Number.of.Mentions_Hypertensive diseases`
           ,Number.of.Mentions_Diabetes
           ,Number.of.Mentions_Obesity) %>%
    filter(Age.Group == i) %>% summary()

  assign(paste("",i,sep=""),data.frame(DF=matrix(DF),row.names=names(DF)))
  do.call(cbind, i)
}
typeof(do.call(cbind, lapply(df_spread, summary)))

DF <- data.frame(var=matrix(var),row.names=names(var))

Data_Process/VincentLa/DATACODE/Comorbidities Cleanup and Exploration.r


require(Hmisc)
x <- 1:10
y <- (11:20) + .1
label(y) <- 'Y'
attributes(y)
d <- data.frame(x, y)
attributes(d$y)
m <- model.frame(y ~ x, data=d)
m$y
attributes(m$y)
mr <- model.response(m)
attributes(mr)
mr


8 * .Machine$sizeof.long # e.g. 32
Endianness
<lang R>.Platform$endian         # e.g. "little"


get_close_stations <- function()
{
  bigf <- readOGR("./data", "BIGF_UK_Locs")
  uaplt <- readOGR("./data", "UAPLT")
  uatmp <- readOGR("./data", "UATMP")
  radiosonde <- rbind(uaplt, uatmp)

  df_bigf <- as.data.frame(bigf)
  df_bigf <- df_bigf[,c(4,1,3)]

  df_radiosonde <- as.data.frame(radiosonde)
  df_radiosonde <- df_radiosonde[,c(11,12,7)]

  df_bigf$name <- as.character(df_bigf$name)

  #browser()

  results <- data.frame(bigf=rep(NA,nrow(df_bigf)), radiosonde=rep(NA,nrow(df_bigf)),dist=rep(NA,nrow(df_bigf)))

  for (i in 1:nrow(df_bigf))
  {
    bigf_bit <- as.numeric(df_bigf[i,1:2])
    r <- spDistsN1(as.matrix(df_radiosonde[,1:2]), bigf_bit, longlat=TRUE)
    index <- which(r == min(r))[1]

    bigf_id <- df_bigf[i,]$name
    #print(df_bigf[i,])
    radiosonde_id <- df_radiosonde[index,]$Snippet
    dist <- r[index]

    if (dist < 25)  print(paste(bigf_id, "and", radiosonde_id, ":", dist, "km"))
    results[i,]$bigf <- bigf_id
    results[i,]$radiosonde <- as.character(radiosonde_id)
    results[i,]$dist <- dist
  }

  return(results)
}


rm(list=ls())
library(viridis)
library(dplyr)
library(ggplot2)
library(tidyr)
library(scales)
library(gridExtra)
library(ggpubr)

# The palette with grey:
cbPalette <- c("#999999", "#E69F00", "#56B4E9", "#009E73", "#F0E442", "#0072B2", "#D55E00", "#CC79A7")

# The palette with black:
cbbPalette <- c("#000000", "#E69F00", "#56B4E9", "#009E73", "#F0E442", "#0072B2", "#D55E00", "#CC79A7")

# To use for fills, add
#scale_fill_manual(values=cbPalette)
# To use for line and point colors, add
#scale_colour_manual(values=cbPalette)

#scale_color_viridis(discrete=TRUE)

dGLSofAvgToxNum <- function(numeratorConstraint,maxLikes){
  # Rename column name for numberator in calculation.
  colnames(maxLikes)[colnames(maxLikes)==numeratorConstraint] <- "numeratorConstraint"

  # Start a list of dGLS values for all loci in dataset
  numLoci <- length(maxLikes$numeratorConstraint)
  x <- "ToxAll"
  # Make lists and add to data frame with locus names, constraint name, and 0 values
  numeratorList <- rep(c(x), times=numLoci)
  outdGLSList <- vector(mode="numeric",length=numLoci)

  # Make dataframe
  outdGLSdf <- subset(maxLikes, select = c('Locus'))
  outdGLSdf$Hypothesis <- numeratorList
  outdGLSdf$dGLSavg <- outdGLSList
  outdGLSdf$dGLSmax <- outdGLSList

  # create a dataset of alternate constraints only to average over
  drops <- c("Locus","numeratorConstraint")
  df <- maxLikes[,!(names(maxLikes) %in% drops)]

  # for locus in dataset
  for (i in 1:nrow(outdGLSdf)){

    # Get all alternate maxinal likehoods
    othermaxLikes <- as.numeric(df[i,])

    # Maximum of alternate maxLH
    a <- max(othermaxLikes)

    # Calculate average across alternate constraints
    avgOthermaxLikes <- mean(othermaxLikes)
    # Calculate average across alternate constraints
    avgOtherMargLikes <- a+log(sum(exp(othermaxLikes-a)))-log(length(names(df)))

    # Calculate dGLS based on average of other LH values
    outdGLSdf[i,3] <- avgOthermaxLikes-maxLikes$numeratorConstraint[i]
    # Calculate dGLS based on maximum of other LH values
    outdGLSdf[i,4] <- a-maxLikes$numeratorConstraint[i]}

  return(outdGLSdf)
}

dGLSofAvg <- function(numeratorConstraint,maxLikes){

  # Rename column name for numberator in calculation.
  colnames(maxLikes)[colnames(maxLikes)==numeratorConstraint] <- "numeratorConstraint"

  # Start a list of dGLS values for all loci in dataset
  numLoci <- length(maxLikes$numeratorConstraint)

  # Make lists and add to data frame with locus names, constraint name, and 0 values
  numeratorList <- rep(c(numeratorConstraint), times=numLoci)
  outdGLSList <- vector(mode="numeric",length=numLoci)

  # Make dataframe
  outdGLSdf <- subset(maxLikes, select = c('Locus'))
  outdGLSdf$Hypothesis <- numeratorList
  outdGLSdf$dGLSavg <- outdGLSList
  outdGLSdf$dGLSmax <- outdGLSList

  # create a dataset of alternate constraints only to average over
  drops <- c("Locus","numeratorConstraint")
  df <- maxLikes[,!(names(maxLikes) %in% drops)]

  # for locus in dataset
  for (i in 1:nrow(outdGLSdf)){

    # Get all alternate maxinal likehoods
    othermaxLikes <- as.numeric(df[i,])

    # Maximum of alternate maxLH
    a <- max(othermaxLikes)

    # Calculate average across alternate constraints
    avgOthermaxLikes <- mean(othermaxLikes)
    # Calculate average across alternate constraints
    avgOtherMargLikes <- a+log(sum(exp(othermaxLikes-a)))-log(length(names(df)))

    # Calculate dGLS based on average of other LH values
    outdGLSdf[i,3] <- maxLikes$numeratorConstraint[i]-avgOthermaxLikes
   # Calculate dGLS based on maximum of other LH values
    outdGLSdf[i,4] <- maxLikes$numeratorConstraint[i]-a}

  return(outdGLSdf)
}

writeCSV <- function (outData,outFile){
  write.csv(outData, file=outFile, row.names=FALSE)
}

setwd("/Users/ChatNoir/Projects/Squam/Graphs/dGLS")
mLdGLS <- read.table("SquamNTGdGLSSummary.txt",header=TRUE)

# Read in table of marginal Likelihoods
mL <- read.table("SquamNTGdGLSSummary.txt",header=TRUE)
mLTox <- mL[,!(names(mL) %in% c("Sclero"))]
names(mL)
mLaiS <- mL[,!(names(mL) %in% c("ToxAngIg"))]
mLsaS <- mL[,!(names(mL) %in% c("ToxSnIg"))]
mLsiS <- mL[,!(names(mL) %in% c("ToxSnAng"))]

# Get list of dGLS for each relationship, using an average of all other constraints as a composite hypothesis.

SclerodGLS <- dGLSofAvg("Sclero",mL)
SaidGLS <- dGLSofAvg("Sclero",mLaiS)
SsadGLS <- dGLSofAvg("Sclero",mLsaS)
SsidGLS <- dGLSofAvg("Sclero",mLsiS)
# differences only within tox constraints
ToxAngIgdGLStx  <- dGLSofAvg("ToxAngIg",mLTox)
ToxSnAngdGLStx  <- dGLSofAvg("ToxSnAng",mLTox)
ToxSnIgdGLStx <- dGLSofAvg("ToxSnIg",mLTox)
# all
ToxAngIgdGLS  <- dGLSofAvg("ToxAngIg",mL)
ToxSnAngdGLS  <- dGLSofAvg("ToxSnAng",mL)
ToxSnIgdGLS <- dGLSofAvg("ToxSnIg",mL)

# Combine and factor
alldGLS <- bind_rows(SclerodGLS,ToxAngIgdGLS,ToxSnAngdGLS,ToxSnIgdGLS)
toxdGLS <- bind_rows(ToxAngIgdGLStx,ToxSnAngdGLStx,ToxSnIgdGLStx)
alldGLS$Hypothesis <- factor(alldGLS$Hypothesis, levels=c("Sclero","ToxAngIg","ToxSnAng","ToxSnIg"))
toxdGLS$Hypothesis <- factor(toxdGLS$Hypothesis, levels=c("ToxAngIg","ToxSnAng","ToxSnIg"))
toxdGLS <- toxdGLS %>% separate(Locus, c("LocusType","LocusNumber"), "-", remove = FALSE)

# Absolute values, averages of differences

mLablsAve <- mL %>% mutate(absAvg=(abs(Sclero-ToxAngIg)+
                        abs(Sclero-ToxSnAng)+
                        abs(Sclero-ToxSnIg)+
                        abs(ToxAngIg-ToxSnAng)+
                        abs(ToxAngIg-ToxSnIg)+
                        abs(ToxSnAng-ToxSnIg))/6) %>% select(Locus,absAvg)

# Support counts

# SAve HERE

#writeCSV(tvsSupport,"tvsdGLSavg_support_avg.csv")
#writeCSV(toxSupport,"toxdGLSavg_support_avg.csv")
#writeCSV(allSupport,"alldGLSavg_support.csv")

# Loci Lists

# Loci sig support for Sclero over Tox
# Loci sig support for Tox over Sclero
# Loci sig support for AI over other Tox
# Loci sig support for SA over other Tox
# Loci sig support for SI over other Tox

alldGLS.SC.loci <- alldGLS %>% select(Locus, dGLSavg, Hypothesis, Percentile, locusRank) %>%
  filter(Hypothesis=="Sclero") %>%
  filter(dGLSavg >= 0.5) %>% select(-Hypothesis)
alldGLS.AI.loci <- alldGLS %>% select(Locus, dGLSavg,Hypothesis,Percentile, locusRank) %>%
  filter(Hypothesis=="ToxAngIg") %>%
  filter(dGLSavg >= 0.5) %>% select(-Hypothesis)
alldGLS.SA.loci <- alldGLS %>% select(Locus, dGLSavg,Hypothesis,Percentile, locusRank) %>%
  filter(Hypothesis=="ToxSnAng") %>%
  filter(dGLSavg >= 0.5) %>% select(-Hypothesis)
alldGLS.SI.loci <- alldGLS %>% select(Locus, dGLSavg,Hypothesis,Percentile, locusRank) %>%
  filter(Hypothesis=="ToxSnIg") %>%
  filter(dGLSavg >= 0.5) %>% select(-Hypothesis)

toxdGLS.AI.loci <- toxdGLS %>% select(Locus, dGLSavg,Hypothesis,Percentile) %>%
  filter(Hypothesis=="ToxAngIg") %>%
  filter(dGLSavg >= 0.5) %>% select(-Hypothesis)
toxdGLS.SA.loci <- toxdGLS %>% select(Locus, dGLSavg,Hypothesis,Percentile) %>%
  filter(Hypothesis=="ToxSnAng") %>%
  filter(dGLSavg >= 0.5) %>% select(-Hypothesis)
toxdGLS.SI.loci <- toxdGLS %>% select(Locus, dGLSavg,Hypothesis,Percentile) %>%
  filter(Hypothesis=="ToxSnIg") %>%
  filter(dGLSavg >= 0.5) %>% select(-Hypothesis)

#writeCSV(tvsdGLS.SC.loci,"tvsdGLS.SC.loci.avg.csv")
#writeCSV(tvsdGLS.TX.loci,"tvsdGLS.TX.loci.avg.csv")
#writeCSV(toxdGLS.AI.loci,"tvsdGLS.AI.loci.avg.csv")
#writeCSV(toxdGLS.SA.loci,"tvsdGLS.SA.loci.avg.csv")
#writeCSV(toxdGLS.SI.loci,"tvsdGLS.SI.loci.avg.csv")

############# Bar graphs Pair dGLS
dGLSpairSupport <- pairdGLS %>% group_by(Hypothesis,Support) %>% dplyr::summarise(dGLSpairCounts=n())
dGLSpairSupport$Support <- factor(dGLSpairSupport$Support, levels=c("Strong_Against","Ambiguous","Strong"))

############## Plots ############## ############## ############## ############## ##############

quartz()

max <- ggplot(data=ToxSnIgdGLStx) +
  geom_bar(stat = "identity", position = position_dodge(), width = 1) +
  aes(x=reorder(Locus,-dGLSmax,sum),y=dGLSmax,color = dGLSmax < 0, fill = dGLSmax < 0) +
  scale_color_manual(values=c("#990000","#482173FF")) +
  scale_fill_manual(values=c("#990000","#482173FF"))+
  labs(x="",y="Support Value",size=24) +
  theme_classic() +
  theme(
    axis.line=element_blank(),
    axis.title.x=element_blank(),
    axis.text.x= element_blank(),
    axis.ticks.x=element_blank(),
    axis.text.y = element_text(size=24, color="black"),
    text = element_text(size=30),
    legend.position = "none",
    panel.border = element_blank(),
    panel.background = element_rect(fill = "transparent"), # bg of the panel
    plot.background = element_rect(fill = "transparent", color = NA), # bg of the plot
    panel.grid.major = element_blank(), # get rid of major grid
    panel.grid.minor = element_blank(), # get rid of minor grid
    legend.background = element_rect(fill = "transparent"), # get rid of legend bg
    legend.box.background = element_rect(fill = "transparent") # get rid of legend panel bg
  )
max + scale_y_continuous(breaks=seq(20,20, 5))
ggsave("ToyExample_dGLSPlot2.pdf", plot=max,
       width = 11, height = 4, units = "in", device = 'pdf',
       bg = "transparent")

############## Saved Plots ############## ############## ############## ############## ##############
tvsList <- c("orange","#482173FF")
myList <- c("orange","#38598CFF","#2BB07FFF","#C2DF23FF")
#show_col(myList)

# Singhal_dGLS_Histogram_TvS

myList <- c("orange","#482173FF")
avg <- ggplot(tvsdGLS, aes(x=dGLSavg, fill=Hypothesis, color=Hypothesis)) +
  geom_histogram(binwidth = 0.5, alpha=1, position="dodge") +
  geom_vline(xintercept=c(0.5),color=c("black"), linetype="dashed", size=0.5) +
  scale_color_manual(values=myList) + scale_fill_manual(values=myList) +
  labs(x="dGLS Hypoth vs average")
max <- ggplot(tvsdGLS, aes(x=dGLSmax, fill=Hypothesis, color=Hypothesis)) +
  geom_histogram(binwidth = 0.5, alpha=1, position="dodge") +
  geom_vline(xintercept=c(0.5),color=c("black"), linetype="dashed", size=0.5) +
  scale_color_manual(values=myList) + scale_fill_manual(values=myList) +
  labs(x="dGLS Hypoth vs maximum")
all <- ggarrange(avg,max, ncol=2, nrow=1, common.legend = TRUE, legend="right")
all
ggsave("Singhal_dGLS_Histogram_TvS_avg.jpg", plot=avg, width = 20, height = 20, units = "cm")

# Singhal_dGLS_Histogram_All

myList <- c("orange","#38598CFF","#2BB07FFF","#C2DF23FF")
avg <- ggplot(alldGLS, aes(x=dGLSavg, fill=Hypothesis, color=Hypothesis)) +
  geom_histogram(binwidth = 0.5, alpha=1, position="dodge") +
  geom_vline(xintercept=c(0.5),color=c("black"), linetype="dashed", size=0.5) +
  scale_color_manual(values=myList) + scale_fill_manual(values=myList) +
  labs(x="dGLS Hypoth vs average")
max <- ggplot(alldGLS, aes(x=dGLSmax, fill=Hypothesis, color=Hypothesis)) +
  geom_histogram(binwidth = 0.5, alpha=1, position="dodge") +
  geom_vline(xintercept=c(0.5),color=c("black"), linetype="dashed", size=0.5) +
  scale_color_manual(values=myList) + scale_fill_manual(values=myList) +
  labs(x="dGLS Hypoth vs maximum")
all <- ggarrange(avg,max, ncol=2, nrow=1, common.legend = TRUE, legend="right")
all
ggsave("Singhal_dGLS_Histogram_All_avgvmax.jpg", plot=all, width = 30, height = 20, units = "cm")

all <- ggplot(alldGLS, aes(x=dGLSavg, fill=Hypothesis, color=Hypothesis)) +
  geom_histogram(binwidth = 0.5, alpha=1, position="dodge") +
  geom_vline(xintercept=c(0.5),color=c("black"), linetype="dashed", size=0.5) +
  scale_color_manual(values=myList)+scale_fill_manual(values=myList)
all
ggsave("Singhal_dGLS_Histo_all.jpg", plot=all, width = 40, height = 20, units = "cm")

# Singhal_dGLS_Violin_avg

tvs <- ggplot(tvsdGLS, aes(x=Hypothesis, y=dGLSavg, color=Hypothesis)) +
  geom_violin(trim=TRUE) + scale_color_manual(values=tvsList) + stat_summary(fun.data=data_summary)
tox <- ggplot(toxdGLS, aes(x=Hypothesis, y=dGLSavg, color=Hypothesis)) +
  geom_violin(trim=TRUE) + scale_color_manual(values=myList) + stat_summary(fun.data=data_summary)
tox.trunc <- ggplot(toxdGLS, aes(x=Hypothesis, y=dGLSavg, color=Hypothesis)) +
  geom_violin(trim=TRUE) + scale_color_manual(values=myList) + stat_summary(fun.data=data_summary) +
  ylim(-2,2)
tox.trunc

ggsave("Singhal_dGLS_Violin_TvS_avg.jpg", plot=tvs, width = 20, height = 20, units = "cm")
ggsave("Singhal_dGLS_Violin_Tox_avg.jpg", plot=tox, width = 20, height = 20, units = "cm")
ggsave("Singhal_dGLS_Violin_Tox_avgtrunc.jpg", plot=tox.trunc, width = 20, height = 20, units = "cm")

# Singhal_dGLS_Classic_avg

tvsList <- c("orange","#482173FF")

max <- ggplot(data=SclerodGLS) +
  geom_bar(stat = "identity", position = position_dodge()) +
  theme(axis.title.x=element_blank(),
        axis.text.x=element_blank(),
        axis.ticks.x=element_blank()) +
  aes(x=reorder(Locus,-dGLSmax,sum),y=dGLSmax,color = dGLSmax < 0, fill = dGLSmax < 0) +
  scale_color_manual(values=c("orange","#482173FF")) + scale_fill_manual(values=c("orange","#482173FF"))+
  labs(y="dGLS Hypoth vs maximum")
avg <- ggplot(data=SclerodGLS) +
  geom_bar(stat = "identity", position = position_dodge()) +
  theme(axis.title.x=element_blank(),
        axis.text.x=element_blank(),
        axis.ticks.x=element_blank()) +
  aes(x=reorder(Locus,-dGLSavg,sum),y=dGLSavg,color = dGLSavg < 0, fill = dGLSavg < 0) +
  scale_color_manual(values=c("orange","#482173FF")) + scale_fill_manual(values=c("orange","#482173FF"))+
  labs(y="dGLS Hypoth vs average")
avg

all <- ggarrange(avg,max, ncol=1, nrow=2, common.legend = TRUE, legend=FALSE)
all
ggsave("Singhal_dGLS_Classic_TvS_avg.jpg", plot=avg, width = 30, height = 20, units = "cm")

toxList <- c("#38598CFF","#2BB07FFF","#C2DF23FF")

avgAI <- ggplot(data=ToxAngIgdGLStx) +
  geom_bar(stat = "identity", position = position_dodge()) +
  theme(axis.title.x=element_blank(),
        axis.text.x=element_blank(),
        axis.ticks.x=element_blank()) +
  aes(x=reorder(Locus,-dGLSavg,sum),y=dGLSavg,color = dGLSavg < 0, fill = dGLSavg < 0) +
  scale_color_manual(values=c("#38598CFF","grey40")) + scale_fill_manual(values=c("#38598CFF","grey40"))+
  labs(y="dGLS Hypoth vs Average", title="(Anguimorph,Iguania)")  + scale_y_continuous(breaks=seq(-17,17, 2), limits=c(-17,17))
#avgAI
avgSA <- ggplot(data=ToxSnAngdGLStx) +
  geom_bar(stat = "identity", position = position_dodge()) +
  theme(axis.title.x=element_blank(),
        axis.text.x=element_blank(),
        axis.ticks.x=element_blank()) +
  aes(x=reorder(Locus,-dGLSavg,sum),y=dGLSavg,color = dGLSavg < 0, fill = dGLSavg < 0) +
  scale_color_manual(values=c("#2BB07FFF","grey40")) + scale_fill_manual(values=c("#2BB07FFF","grey40"))+
  labs(y="dGLS Hypoth vs Average", title="(Snakes,Anguimorph)")  + scale_y_continuous(breaks=seq(-17,17, 2), limits=c(-17,17))
#maxSA
avgSI <- ggplot(data=ToxSnIgdGLStx) +
  geom_bar(stat = "identity", position = position_dodge()) +
  theme(axis.title.x=element_blank(),
        axis.text.x=element_blank(),
        axis.ticks.x=element_blank()) +
  aes(x=reorder(Locus,-dGLSavg,sum),y=dGLSavg,color = dGLSavg < 0, fill = dGLSavg < 0) +
  scale_color_manual(values=c("#C2DF23FF","grey40")) + scale_fill_manual(values=c("#C2DF23FF","grey40"))+
  labs(y="dGLS Hypoth vs Average", title="(Snakes,Iguania)")  + scale_y_continuous(breaks=seq(-17,17, 2), limits=c(-17,17))
#avgSI

all <- ggarrange(avgAI, avgSA, avgSI, ncol=1, nrow=3, common.legend = TRUE, legend=FALSE)
all
ggsave("Singhal_dGLS_Classic_Tox_avg.jpg", plot=all, width = 20, height = 40, units = "cm")


# preamble
library('mrgsolve')

# load model
mm_model <- mrgsolve::mread(model = 'mm', file = 'model.cpp')

# run model
sim <- mm_model %>%
  mrgsim(
    delta = 1,
    hmax = 0,
    maxsteps = 1e9,
    atol = 1e-7,
    rtol = 1e-4,
    end = 120
  )

# plot results
plot <- sim %>%
    plot(type='l')

# show
plot