# Estimates mean age of families, mean phylogenetic fuse of families, and phylogenetic species variability (PSV) across three super biome categories: arid, temperate, tropical.
# The super biome categorization follows the grouping of the original biomes of Olson et al. 2001 described in the Supplementary Methods.
# Continues with R objects generated in previous steps (loads objects).
# Uses additional files.

load("~/Documents/BIOMES/super_biomeRaster.Rdata") # file in data folder
load("~/Documents/NATURE/DISTS.july19/prPAM_FAM_grid.r") # file in data folder

load(paste(ruta_write,"WeightedMAFS.RData",sep=""))
cat("Maximum number of species per grid-cell:",max(rowSums(prPAM_g[,-c(1:2)])),"species","\n")
which(rowSums(prPAM_g[,-c(1:2)]) == 0) -> iden_inf
prPAM_g2<- prPAM_g[-iden_inf,]
iden <- which(rowSums(prPAM_g2[,-c(1:2)]) > 5)
pointos <- SpatialPoints(prPAM_g2[iden,1:2])
proj4string(pointos) <- "+proj=longlat +datum=WGS84 +no_defs +ellps=WGS84 +towgs84=0,0,0"
biome_points<- cbind(prPAM_g2[iden,1:2],raster::extract(super_biomes,pointos))
colnames(biome_points)[3]<-"BIOME"
which(is.na(biome_points$BIOME)) -> iden_bim
biome_points <- biome_points[-which(is.na(biome_points$BIOME)),]
psv <- psv(samp = prPAM_g2[iden,-c(1:2)],tree = tre.pruned)
PSV <- psv$PSVs
Stem <- MDT_stem
Crown <- MDT_crown
Fuse <- MDT_fuse_non
load(paste(ruta_write," MDT_stem_NULL2.Rdata",sep=""))
load(paste(ruta_write," MDT_crown_NULL2.Rdata",sep=""))
load(paste(ruta_write," MDT_fuse_non_NULL2.Rdata",sep=""))
load(paste(ruta_write," MDT_stem_NULL1.Rdata",sep=""))
load(paste(ruta_write," MDT_crown_NULL1.Rdata",sep=""))
load(paste(ruta_write," MDT_fuse_non_NULL1.Rdata",sep=""))
SES_stem_N1 <- (MDT_stem - apply(MDT_stem_NULL1[,-c(1:2)],MARGIN=1,FUN=mean,na.rm=T))/(apply(MDT_stem_NULL1[,-c(1:2)],MARGIN=1,FUN=sd,na.rm=T))
SES_crown_N1 <- (MDT_crown - apply(MDT_crown_NULL1[,-c(1:2)],MARGIN=1,FUN=mean,na.rm=T))/(apply(MDT_crown_NULL1[,-c(1:2)],MARGIN=1,FUN=sd,na.rm=T))
SES_fuse_N1 <- (MDT_fuse_non - apply(MDT_fuse_non_NULL1[,-c(1:2)],MARGIN=1,FUN=mean,na.rm=T))/(apply(MDT_fuse_non_NULL1[,-c(1:2)],MARGIN=1,FUN=sd,na.rm=T))
SES_stem_N2 <- (MDT_stem - apply(MDT_stem_NULL2[,-c(1:2)],MARGIN=1,FUN=mean,na.rm=T))/(apply(MDT_stem_NULL2[,-c(1:2)],MARGIN=1,FUN=sd,na.rm=T))
SES_crown_N2 <- (MDT_crown - apply(MDT_crown_NULL2[,-c(1:2)],MARGIN=1,FUN=mean,na.rm=T))/(apply(MDT_crown_NULL2[,-c(1:2)],MARGIN=1,FUN=sd,na.rm=T))
SES_fuse_N2 <- (MDT_fuse_non - apply(MDT_fuse_non_NULL2[,-c(1:2)],MARGIN=1,FUN=mean,na.rm=T))/(apply(MDT_fuse_non_NULL2[,-c(1:2)],MARGIN=1,FUN=sd,na.rm=T))

load(paste(ruta_write,"PSV_random_rich.Rdata",sep=""))
load(paste(ruta_write,"PSV_random_freq.Rdata",sep=""))
SES_PSV_N1 <- (PSV - apply(PSV_random_rich[,-c(1:2)],MARGIN=1,FUN=mean,na.rm=T))/(apply(PSV_random_rich[,-c(1:2)],MARGIN=1,FUN=sd,na.rm=T))
SES_PSV_N2 <- (PSV - apply(PSV_random_freq[,-c(1:2)],MARGIN=1,FUN=mean,na.rm=T))/(apply(PSV_random_freq[,-c(1:2)],MARGIN=1,FUN=sd,na.rm=T))
SR <-  rowSums(prPAM_g2[iden,-c(1:2)]); print(min(SR))
data<-data.frame(LAT=biome_points$LAT,LON=biome_points$LON,Stem=Stem[-iden_bim],Crown=Crown[-iden_bim],
                 FUSE=Fuse[-iden_bim],
                 PSV=PSV[-iden_bim],
                 SES_crown_1 = SES_crown_N1[-iden_bim],
                 SES_stem_1 = SES_stem_N1[-iden_bim],
                 SES_PSV_1 = SES_PSV_N1[-iden_bim],
                 SES_fuse_1 = SES_fuse_N1[-iden_bim],
                 SES_crown_2 = SES_crown_N2[-iden_bim],
                 SES_stem_2 = SES_stem_N2[-iden_bim],
                 SES_PSV_2 = SES_PSV_N2[-iden_bim],
                 SES_fuse_2 = SES_fuse_N2[-iden_bim],
                 Super_biome = as.factor(biome_points$BIOME),
                 SR=SR[-iden_bim])
unique(data$Super_biome)
levels(data$Super_biome) <- c("Temperate","Temperate","Tropical","Arid"); levels(data$Super_biome)
ssp<-coordinates(data[,2:1])
iden <- clean_coordinates(as.data.frame(ssp), lon = "LON",lat = "LAT",
                       tests="seas",species=NULL,value="flagged",seas_scale=110)

stem <- data[iden,] %>%
  mutate(Super_biome = fct_reorder(Super_biome, Stem)) %>%
  ggplot(aes(x=Super_biome, y=Stem,fill=Super_biome)) +
  geom_violin(alpha=0.6) +
  theme(legend.position="none") +
  labs(title = 'Mean family stem age') +
  geom_hline(yintercept = mean(data[iden,"Stem"])) +
  geom_hline(yintercept = mean(data[iden,"Stem"][which(data$Super_biome[iden]=="Arid")]),col="red")+
  geom_hline(yintercept = mean(data[iden,"Stem"][which(data$Super_biome[iden]=="Temperate")]),col="green")+
  geom_hline(yintercept = mean(data[iden,"Stem"][which(data$Super_biome[iden]=="Tropical")]),col="blue")+
  geom_hline(yintercept = mlv(data[iden,"Stem"],method="Venter"),lty=3) +
  geom_hline(yintercept = mlv(data[iden,"Stem"][which(data$Super_biome[iden]=="Arid")],method="Venter"),col="red",lty=3) +
  geom_hline(yintercept = mlv(data[iden,"Stem"][which(data$Super_biome[iden]=="Temperate")],method="Venter"),col="green",lty=3)+
  geom_hline(yintercept = mlv(data[iden,"Stem"][which(data$Super_biome[iden]=="Tropical")],method="Venter"),col="blue",lty=3)
summary(aov(Stem ~ Super_biome,data=data[iden,]))

crown <- data[iden,] %>%
  mutate(Super_biome = fct_reorder(Super_biome, Stem)) %>%
  ggplot(aes(x=Super_biome, y=Crown,fill=Super_biome)) +
  geom_violin(alpha=0.6) +
  theme(legend.position="none") +
  labs(title = 'Mean family Crown age') +
  geom_hline(yintercept = mean(data[iden,"Crown"])) +
  geom_hline(yintercept = mean(data[iden,"Crown"][which(data$Super_biome[iden]=="Arid")]),col="red")+
  geom_hline(yintercept = mean(data[iden,"Crown"][which(data$Super_biome[iden]=="Temperate")]),col="green")+
  geom_hline(yintercept = mean(data[iden,"Crown"][which(data$Super_biome[iden]=="Tropical")]),col="blue")+
  geom_hline(yintercept = mlv(data[iden,"Crown"],method="Venter"),lty=3) +
  geom_hline(yintercept = mlv(data[iden,"Crown"][which(data$Super_biome[iden]=="Arid")],method="Venter"),col="red",lty=3) +
  geom_hline(yintercept = mlv(data[iden,"Crown"][which(data$Super_biome[iden]=="Temperate")],method="Venter"),col="green",lty=3)+
  geom_hline(yintercept = mlv(data[iden,"Crown"][which(data$Super_biome[iden]=="Tropical")],method="Venter"),col="blue",lty=3)
summary(aov(Crown ~ Super_biome,data=data[iden,]))

fuse <- data[iden,] %>%
  mutate(Super_biome = fct_reorder(Super_biome, Stem)) %>%
  ggplot(aes(x=Super_biome, y=FUSE,fill=Super_biome)) +
  geom_violin(alpha=0.6) +
  theme(legend.position="none") +
  labs(title = 'Mean Fuse of Families') +
  geom_hline(yintercept = mean(data[iden,"FUSE"])) +
  geom_hline(yintercept = mean(data[iden,"FUSE"][which(data$Super_biome[iden]=="Arid")]),col="red")+
  geom_hline(yintercept = mean(data[iden,"FUSE"][which(data$Super_biome[iden]=="Temperate")]),col="green")+
  geom_hline(yintercept = mean(data[iden,"FUSE"][which(data$Super_biome[iden]=="Tropical")]),col="blue")+
  geom_hline(yintercept = mlv(data[iden,"FUSE"],method="Venter"),lty=3) +
  geom_hline(yintercept = mlv(data[iden,"FUSE"][which(data$Super_biome[iden]=="Arid")],method="Venter"),col="red",lty=3) +
  geom_hline(yintercept = mlv(data[iden,"FUSE"][which(data$Super_biome[iden]=="Temperate")],method="Venter"),col="green",lty=3)+
  geom_hline(yintercept = mlv(data[iden,"FUSE"][which(data$Super_biome[iden]=="Tropical")],method="Venter"),col="blue",lty=3)
summary(aov(FUSE ~ Super_biome,data=data[iden,]))

psv <- data[iden,] %>%
  mutate(Super_biome = fct_reorder(Super_biome, Stem)) %>%
  ggplot(aes(x=Super_biome, y=PSV,fill=Super_biome)) +
  geom_violin(alpha=0.6) +
  theme(legend.position="none") +
  labs(title = 'PSV') +
  geom_hline(yintercept = mean(data[iden,"PSV"],na.rm=T)) +
  geom_hline(yintercept = mean(data[iden,"PSV"][which(data$Super_biome[iden]=="Arid")],na.rm=T),col="red")+
  geom_hline(yintercept = mean(data[iden,"PSV"][which(data$Super_biome[iden]=="Temperate")],na.rm=T),col="green")+
  geom_hline(yintercept = mean(data[iden,"PSV"][which(data$Super_biome[iden]=="Tropical")],na.rm=T),col="blue")+
  geom_hline(yintercept = mlv(data[iden,"PSV"],method="Venter",na.rm=T),lty=3) +
  geom_hline(yintercept = mlv(data[iden,"PSV"][which(data$Super_biome[iden]=="Arid")],method="Venter",na.rm=T),col="red",lty=3) +
  geom_hline(yintercept = mlv(data[iden,"PSV"][which(data$Super_biome[iden]=="Temperate")],method="Venter",na.rm=T),col="green",lty=3)+
  geom_hline(yintercept = mlv(data[iden,"PSV"][which(data$Super_biome[iden]=="Tropical")],method="Venter",na.rm=T),col="blue",lty=3)
summary(aov(PSV ~ Super_biome,data=data[iden,]))

ses.psv1 <- data[iden,] %>%
  mutate(Super_biome = fct_reorder(Super_biome, Stem)) %>%
  ggplot(aes(x=Super_biome, y=SES_PSV_1,fill=Super_biome)) +
  geom_violin(alpha=0.6) +
  theme(legend.position="none") +
  labs(title = 'SES_PSV_1') +
  geom_hline(yintercept = mean(data[iden,"SES_PSV_1"],na.rm=T)) +
  geom_hline(yintercept = mean(data[iden,"SES_PSV_1"][which(data$Super_biome[iden]=="Arid")],na.rm=T),col="red")+
  geom_hline(yintercept = mean(data[iden,"SES_PSV_1"][which(data$Super_biome[iden]=="Temperate")],na.rm=T),col="green")+
  geom_hline(yintercept = mean(data[iden,"SES_PSV_1"][which(data$Super_biome[iden]=="Tropical")],na.rm=T),col="blue")+
  geom_hline(yintercept = mlv(data[iden,"SES_PSV_1"],method="Venter",na.rm=T),lty=3) +
  geom_hline(yintercept = mlv(data[iden,"SES_PSV_1"][which(data$Super_biome[iden]=="Arid")],method="Venter",na.rm=T),col="red",lty=3) +
  geom_hline(yintercept = mlv(data[iden,"SES_PSV_1"][which(data$Super_biome[iden]=="Temperate")],method="Venter",na.rm=T),col="green",lty=3)+
  geom_hline(yintercept = mlv(data[iden,"SES_PSV_1"][which(data$Super_biome[iden]=="Tropical")],method="Venter",na.rm=T),col="blue",lty=3)
summary(aov(SES_PSV_1 ~ Super_biome,data=data[iden,]))

ses.psv2 <- data[iden,] %>%
  mutate(Super_biome = fct_reorder(Super_biome, Stem)) %>%
  ggplot(aes(x=Super_biome, y=SES_PSV_2,fill=Super_biome)) +
  geom_violin(alpha=0.6) +
  theme(legend.position="none") +
  labs(title = 'SES_PSV_2') +
  geom_hline(yintercept = mean(data[iden,"SES_PSV_2"],na.rm=T)) +
  geom_hline(yintercept = mean(data[iden,"SES_PSV_2"][which(data$Super_biome[iden]=="Arid")],na.rm=T),col="red")+
  geom_hline(yintercept = mean(data[iden,"SES_PSV_2"][which(data$Super_biome[iden]=="Temperate")],na.rm=T),col="green")+
  geom_hline(yintercept = mean(data[iden,"SES_PSV_2"][which(data$Super_biome[iden]=="Tropical")],na.rm=T),col="blue")+
  geom_hline(yintercept = mlv(data[iden,"SES_PSV_2"],method="Venter",na.rm=T),lty=3) +
  geom_hline(yintercept = mlv(data[iden,"SES_PSV_2"][which(data$Super_biome[iden]=="Arid")],method="Venter",na.rm=T),col="red",lty=3) +
  geom_hline(yintercept = mlv(data[iden,"SES_PSV_2"][which(data$Super_biome[iden]=="Temperate")],method="Venter",na.rm=T),col="green",lty=3)+
  geom_hline(yintercept = mlv(data[iden,"SES_PSV_2"][which(data$Super_biome[iden]=="Tropical")],method="Venter",na.rm=T),col="blue",lty=3)
summary(aov(SES_PSV_2 ~ Super_biome,data=data[iden,]))

ses.stem1 <- data[iden,] %>%
  mutate(Super_biome = fct_reorder(Super_biome, Stem)) %>%
  ggplot(aes(x=Super_biome, y=SES_stem_1,fill=Super_biome)) +
  geom_violin(alpha=0.6) +
  theme(legend.position="none") +
  labs(title = 'SES_stem_1') +
  geom_hline(yintercept = mean(data[iden,"SES_stem_1"])) +
  geom_hline(yintercept = mean(data[iden,"SES_stem_1"][which(data$Super_biome[iden]=="Arid")]),col="red")+
  geom_hline(yintercept = mean(data[iden,"SES_stem_1"][which(data$Super_biome[iden]=="Temperate")]),col="green")+
  geom_hline(yintercept = mean(data[iden,"SES_stem_1"][which(data$Super_biome[iden]=="Tropical")]),col="blue")+
  geom_hline(yintercept = mlv(data[iden,"SES_stem_1"],method="Venter"),lty=3) +
  geom_hline(yintercept = mlv(data[iden,"SES_stem_1"][which(data$Super_biome[iden]=="Arid")],method="Venter"),col="red",lty=3) +
  geom_hline(yintercept = mlv(data[iden,"SES_stem_1"][which(data$Super_biome[iden]=="Temperate")],method="Venter"),col="green",lty=3)+
  geom_hline(yintercept = mlv(data[iden,"SES_stem_1"][which(data$Super_biome[iden]=="Tropical")],method="Venter"),col="blue",lty=3)
summary(aov(SES_stem_1 ~ Super_biome,data=data[iden,]))

ses.stem2 <- data[iden,] %>%
  mutate(Super_biome = fct_reorder(Super_biome, Stem)) %>%
  ggplot(aes(x=Super_biome, y=SES_stem_2,fill=Super_biome)) +
  geom_violin(alpha=0.6) +
  theme(legend.position="none") +
  labs(title = 'SES_stem_2') +
  geom_hline(yintercept = mean(data[iden,"SES_stem_2"])) +
  geom_hline(yintercept = mean(data[iden,"SES_stem_2"][which(data$Super_biome[iden]=="Arid")]),col="red")+
  geom_hline(yintercept = mean(data[iden,"SES_stem_2"][which(data$Super_biome[iden]=="Temperate")]),col="green")+
  geom_hline(yintercept = mean(data[iden,"SES_stem_2"][which(data$Super_biome[iden]=="Tropical")]),col="blue")+
  geom_hline(yintercept = mlv(data[iden,"SES_stem_2"],method="Venter"),lty=3) +
  geom_hline(yintercept = mlv(data[iden,"SES_stem_2"][which(data$Super_biome[iden]=="Arid")],method="Venter"),col="red",lty=3) +
  geom_hline(yintercept = mlv(data[iden,"SES_stem_2"][which(data$Super_biome[iden]=="Temperate")],method="Venter"),col="green",lty=3)+
  geom_hline(yintercept = mlv(data[iden,"SES_stem_2"][which(data$Super_biome[iden]=="Tropical")],method="Venter"),col="blue",lty=3)
summary(aov(SES_stem_2 ~ Super_biome,data=data[iden,]))

ses.crown1 <- data[iden,] %>%
  mutate(Super_biome = fct_reorder(Super_biome, Stem)) %>%
  ggplot(aes(x=Super_biome, y=SES_crown_1,fill=Super_biome)) +
  geom_violin(alpha=0.6) +
  theme(legend.position="none") +
  labs(title = 'SES_crown_1') +
  geom_hline(yintercept = mean(data[iden,"SES_crown_1"])) +
  geom_hline(yintercept = mean(data[iden,"SES_crown_1"][which(data$Super_biome[iden]=="Arid")]),col="red")+
  geom_hline(yintercept = mean(data[iden,"SES_crown_1"][which(data$Super_biome[iden]=="Temperate")]),col="green")+
  geom_hline(yintercept = mean(data[iden,"SES_crown_1"][which(data$Super_biome[iden]=="Tropical")]),col="blue")+
  geom_hline(yintercept = mlv(data[iden,"SES_crown_1"],method="Venter"),lty=3) +
  geom_hline(yintercept = mlv(data[iden,"SES_crown_1"][which(data$Super_biome[iden]=="Arid")],method="Venter"),col="red",lty=3) +
  geom_hline(yintercept = mlv(data[iden,"SES_crown_1"][which(data$Super_biome[iden]=="Temperate")],method="Venter"),col="green",lty=3)+
  geom_hline(yintercept = mlv(data[iden,"SES_crown_1"][which(data$Super_biome[iden]=="Tropical")],method="Venter"),col="blue",lty=3)
summary(aov(SES_crown ~ Super_biome,data=data[iden,]))

ses.crown2 <-data[iden,] %>%
  mutate(Super_biome = fct_reorder(Super_biome, Stem)) %>%
  ggplot(aes(x=Super_biome, y=SES_crown_2,fill=Super_biome)) +
  geom_violin(alpha=0.6) +
  theme(legend.position="none") +
  labs(title = 'SES_crown_2') +
  geom_hline(yintercept = mean(data[iden,"SES_crown_2"])) +
  geom_hline(yintercept = mean(data[iden,"SES_crown_2"][which(data$Super_biome[iden]=="Arid")]),col="red")+
  geom_hline(yintercept = mean(data[iden,"SES_crown_2"][which(data$Super_biome[iden]=="Temperate")]),col="green")+
  geom_hline(yintercept = mean(data[iden,"SES_crown_2"][which(data$Super_biome[iden]=="Tropical")]),col="blue")+
  geom_hline(yintercept = mlv(data[iden,"SES_crown_2"],method="Venter"),lty=3) +
  geom_hline(yintercept = mlv(data[iden,"SES_crown_2"][which(data$Super_biome[iden]=="Arid")],method="Venter"),col="red",lty=3) +
  geom_hline(yintercept = mlv(data[iden,"SES_crown_2"][which(data$Super_biome[iden]=="Temperate")],method="Venter"),col="green",lty=3)+
  geom_hline(yintercept = mlv(data[iden,"SES_crown_2"][which(data$Super_biome[iden]=="Tropical")],method="Venter"),col="blue",lty=3)
summary(aov(SES_crown_2 ~ Super_biome,data=data[iden,]))

ses.fuse1 <- data[iden,] %>%
  mutate(Super_biome = fct_reorder(Super_biome, Stem)) %>%
  ggplot(aes(x=Super_biome, y=SES_fuse_1,fill=Super_biome)) +
  geom_violin(alpha=0.6) +
  theme(legend.position="none") +
  labs(title = 'SES_fuse_1') +
  geom_hline(yintercept = mean(data[iden,"SES_fuse_1"])) +
  geom_hline(yintercept = mean(data[iden,"SES_fuse_1"][which(data$Super_biome[iden]=="Arid")]),col="red")+
  geom_hline(yintercept = mean(data[iden,"SES_fuse_1"][which(data$Super_biome[iden]=="Temperate")]),col="green")+
  geom_hline(yintercept = mean(data[iden,"SES_fuse_1"][which(data$Super_biome[iden]=="Tropical")]),col="blue")+
  geom_hline(yintercept = mlv(data[iden,"SES_fuse_1"],method="Venter"),lty=3) +
  geom_hline(yintercept = mlv(data[iden,"SES_fuse_1"][which(data$Super_biome[iden]=="Arid")],method="Venter"),col="red",lty=3) +
  geom_hline(yintercept = mlv(data[iden,"SES_fuse_1"][which(data$Super_biome[iden]=="Temperate")],method="Venter"),col="green",lty=3)+
  geom_hline(yintercept = mlv(data[iden,"SES_fuse_1"][which(data$Super_biome[iden]=="Tropical")],method="Venter"),col="blue",lty=3)
summary(aov(SES_fuse_1 ~ Super_biome,data=data[iden,]))

ses.fuse2 <-data[iden,] %>%
  mutate(Super_biome = fct_reorder(Super_biome, Stem)) %>%
  ggplot(aes(x=Super_biome, y=SES_fuse_2,fill=Super_biome)) +
  geom_violin(alpha=0.6) +
  theme(legend.position="none") +
  labs(title = 'SES_fuse_2') +
  geom_hline(yintercept = mean(data[iden,"SES_fuse_2"])) +
  geom_hline(yintercept = mean(data[iden,"SES_fuse_2"][which(data$Super_biome[iden]=="Arid")]),col="red")+
  geom_hline(yintercept = mean(data[iden,"SES_fuse_2"][which(data$Super_biome[iden]=="Temperate")]),col="green")+
  geom_hline(yintercept = mean(data[iden,"SES_fuse_2"][which(data$Super_biome[iden]=="Tropical")]),col="blue")+
  geom_hline(yintercept = mlv(data[iden,"SES_fuse_2"],method="Venter"),lty=3) +
  geom_hline(yintercept = mlv(data[iden,"SES_fuse_2"][which(data$Super_biome[iden]=="Arid")],method="Venter"),col="red",lty=3) +
  geom_hline(yintercept = mlv(data[iden,"SES_fuse_2"][which(data$Super_biome[iden]=="Temperate")],method="Venter"),col="green",lty=3)+
  geom_hline(yintercept = mlv(data[iden,"SES_fuse_2"][which(data$Super_biome[iden]=="Tropical")],method="Venter"),col="blue",lty=3)
summary(aov(SES_fuse_2 ~ Super_biome,data=data[iden,]))

pdf(paste(ruta_write,"8.BiomeMAF_SBcomplete_20SR.pdf",sep=""))
gridExtra::grid.arrange(stem, crown, fuse, psv, nrow = 2)
gridExtra::grid.arrange(ses.stem1, ses.stem2, ses.crown1, ses.crown2, nrow = 2)
gridExtra::grid.arrange(ses.psv1, ses.psv2, ses.fuse1, ses.fuse2, nrow = 2)
dev.off()

sink(paste(ruta_write,"Superbiome_tests.txt"))
cat("STEM ----------------","\n")
summary(aov(Stem ~ Super_biome,data=data[iden,]))
cat("CROWN ----------------","\n")
summary(aov(Crown ~ Super_biome,data=data[iden,]))
cat("PSV ----------------","\n")
summary(aov(PSV ~ Super_biome,data=data[iden,]))
cat("SES CROWN ----------------","\n")
summary(aov(SES_crown ~ Super_biome,data=data[iden,]))
cat("SES STEM ----------------","\n")
summary(aov(SES_stem ~ Super_biome,data=data[iden,]))
cat("SES PSV ----------------","\n")
summary(aov(SES_PSV ~ Super_biome,data=data[iden,]))
sink()


#!/usr/bin/env Rscript
lengths <- as.integer(readLines("stdin"))
args<-commandArgs(TRUE)
output = args[1]
output = paste(output,'.pdf',sep='')
pdf(output,width=5,height=5)
hist(lengths, seq(0,10000,by=100))
dev.off()


# svmtest

## Check data: can the SVM be performed
svmMessage = ""
if (length(unique(Multi_datainput_m$groupingvar)) > 3) {
  NO_svm = TRUE
  svmMessage = paste0(svmMessage, "SVM can only be done if there no more than 3 groups.")
}

if (min(summary(
  Multi_datainput_m$groupingvar)) < 10 ) {
  NO_svm = TRUE
  svmMessage = paste0(svmMessage, " At least one group has a sample size lower than 10")
}

# choose the type of validation depending on the sample size (>15 in each group ?)
testvalidation = ifelse((min(summary(
  Multi_datainput_m$groupingvar
)) > 15), TRUE, FALSE)
Validation_type = ifelse(testvalidation, "independent test dataset", "2-out")

# check groups size difference.

if (Validation_type == "2-out" ){
  if (max(summary(Multi_datainput_m$groupingvar)) - min(summary(Multi_datainput_m$groupingvar)) != 0){
    NO_svm = TRUE
    svmMessage = paste0(svmMessage, "in 2-out validation, we need the same number of animals per group, please select animals manually.")
  }
}

  print(svmMessage)
  Accuracyreal = NA  # set Accuracyreal for the case no SVM can be performed


#' Match a specific week
#'
#' Create an indicator variable for a specific week.
#'
#' @param x_week Numeric tis object.
#' @param week_number Numeric scalar; Week of the year to match.
#' @return An indicator variable where the observation that matches the week entered = 1, 0 otherwise.
#' @examples
#' xmas_w53 <- match_week(ic_week, 53)
#' @import stats
#' @export
match_week <- function(x_week, week_number) {
    # Author: Brian C. Monsell (OEUS), Version 1.2, 3/23/2021

    # generate a vector of strings of dates associated with weekly observations.
    date_index <- tis::ymd(tis::ti(x_week))

    # set up filter with observations that match the number of the week
    week_filter <- date_index[x_week == week_number]

    # initialize indicator variable with 0
    dummy <- array(0, dim = length(x_week))

    # set observation matching the filter to 1
    dummy[date_index %in% week_filter] <- 1

    # return indicator variable
    return(dummy)
}


#Author: Josh Roll
#Date: 11/12/2020
#Subject:  Analyze FARS data to understand ped fatal injuries by RACE
#Description: This script uses data from US Census and NHTSA FARS to calculate the rate of injury per 100,000 using age-adjusted methods to determine existing disparities for
#ODOT Research Project SPR 841
#License: Apache 2.0
#Version notes:
#Version 4 - Now calcualting rates using person years instead of single years

#Load libraries
#------------------------------
	#Establish library path
	library(lubridate)
	library(tigris)
	library(dplyr)
	library(readxl)
	library(rgdal)
	library(sf)
	library(stringr)
	library(leaflet)
	library(htmlwidgets)
	library(tidyr)
	library(ggplot2)
	library(MASS)
	library(mfx)
	library(pscl)
	library(corrplot)
	library(readxl)
	library(Metrics)
	library(epitools)
	library(data.table)
	library(acs)
	library(scales)
	library(gridExtra)

#Set environmanetal
#-----------------
  options( scipen = 10 )

#Define custom scripts functions
#------------------------------
	#Function that simplifies loading .RData objects
	assignLoad <- function(filename){
       load(filename)
       get(ls()[ls() != "filename"])
    }

	#Function to create bin labels
	label_Bins <- function(Breaks.){
		Labels_ <- list()
		for(i in 1:(length(Breaks.)-1)){
			Labels_[[i]] <- paste(Breaks.[[i]], Breaks.[[i + 1]], sep="-")
		}
		#Return result
		unlist(Labels_)
	}

#Load Data
#---------------------------------------------
	########################
	#State Level population data by age/Race (5 year ACS)
	State_Census.. <- assignLoad(file = "/Data/State_Age_Sex_2009_2018_5yr.RData")

	#Load US FARS Person table
	#############################
	Load_Person.. <- assignLoad(file = "//wpdotfill09/R_VMP3_USERS/tdb069/Data/Crash/Data/FARS/Data/Processed/Person_2009-2018.RData")
	#Prepare FARS data - Aggregate data to create a composite BIPOC race category
	#Create data set classifying participants as BIPOC
	#Make a copy
	Person_Bipoc.. <- Load_Person..
	#Mutate disaggregate BIPOC races into composite BIPOC category
	Person_Bipoc.. <- filter(Person_Bipoc.. %>% mutate(Race_desc = ifelse(Race_desc%in%c("AIAN","Combined Other Asian Or Pacific Islander, Includes Data","Black","Asian","NHPI","Latino","Guamanian","Hawaiian (Includes Part-Hawaiian)",
		"Other Indian (Includes South and Central America, Since"), "BIPOC",
		ifelse(Race_desc == "White", "White",
		ifelse(Race_desc%in%c("Other", "Not A Fatality (Not Applicable)","Unknown"), "Other or Unknown",NA)))), Race_desc =="BIPOC")
	#Combine
	Load_Person.. <- rbind(Load_Person.. , Person_Bipoc..)

	#Define state of interest
	############################
	#FARS Data
	FARS_Select_State <- 41
	#Census population data state
	Population_Select_State <- "Oregon"

	#init a dataframe to store results
	Master_Rate.. <- data.frame()
	#Loop through all periods of data
	for(yr in c(2013,2018)){
		#Define Study Period
		Study_Year <- yr
		#FARS_Year. <- 2014:2018
		FARS_Period. <- c((yr -4):yr)
		#Make a copy
		Person.. <- Load_Person..
		#Select State data that are fatals (interested in another state define above)
		Select_State_Person.. <- filter(Person.., State == FARS_Select_State & Inj_sev==4)
		US_Person.. <- filter(Person.., Inj_sev==4)
		#Prepare Oregon FARS
		################
		Oregon_Fatal_Summary.. <- filter(Select_State_Person.., Year%in%FARS_Period.) %>% group_by(Race_desc,Mode,Age_Cohort) %>% summarise(Count = length(St_case))
		#Look just at pedestrians
		Select_State_Fatal.. <- filter(Oregon_Fatal_Summary..)
		#Create statewide fora all populations
		Select_State_Fatal.. <- rbind(Select_State_Fatal..,cbind(Select_State_Fatal.. %>% group_by(Mode, Age_Cohort) %>% summarise(Count = sum(Count,na.rm=T)), Race_desc = "Oregon")[,colnames(Select_State_Fatal..)])
		#Prepare US FARS
		US_Fatal_Summary.. <- filter(US_Person.., Year%in%FARS_Period.) %>% group_by(Race_desc,Mode,Age_Cohort) %>% summarise(Count = length(St_case))
		US_Fatal.. <- filter(US_Fatal_Summary..)
		#Create nationwide fora all populations
		US_Fatal.. <- rbind(US_Fatal..,cbind(US_Fatal.. %>% group_by(Mode, Age_Cohort) %>% summarise(Count = sum(Count,na.rm=T)), Race_desc = "US")[,colnames(Select_State_Fatal..)])
		#Alter study year for population
		if(yr%in%2013){Study_Year <- 2009:2013}
		if(yr%in%2018){Study_Year <- 2014:2018}

		#Summarise Oregon Population
		#####################
		#Pivote data
		Population_Summary.. <-	filter(State_Census.., State == Population_Select_State & Year%in%Study_Year) %>%
			pivot_longer(!c(State,GEOID,NAME,Year), names_to = "Age_Cohort", values_to = "Population")
		#Create new column for race
		Population_Summary.. <- mutate(Population_Summary..,
			#Age cohort
			Age_Cohort_Update = ifelse(grepl("Age_Under5", Age_Cohort, ignore.case = T), "Age_Under5",
				ifelse(grepl("Age_5_9", Age_Cohort, ignore.case = T), "Age_5_9",
				ifelse(grepl("Age_10_14", Age_Cohort, ignore.case = T),"Age_10_14",
				ifelse(grepl("Age_15_17", Age_Cohort, ignore.case = T),"Age_15_17",
				ifelse(grepl("Age_18_19", Age_Cohort, ignore.case = T),"Age_18_19",
				ifelse(grepl("Age_20_24", Age_Cohort, ignore.case = T),"Age_20_24",
				ifelse(grepl("Age_25_29", Age_Cohort, ignore.case = T),"Age_25_29",
				ifelse(grepl("Age_30_34", Age_Cohort, ignore.case = T),"Age_30_34",
				ifelse(grepl("Age_35_44", Age_Cohort, ignore.case = T),"Age_35_44",
				ifelse(grepl("Age_45_54", Age_Cohort, ignore.case = T),"Age_45_54",
				ifelse(grepl("Age_55_64", Age_Cohort, ignore.case = T),"Age_55_64",
				ifelse(grepl("Age_65_74", Age_Cohort, ignore.case = T),"Age_65_74",
				ifelse(grepl("Age_75_84", Age_Cohort, ignore.case = T),"Age_75_84",
				ifelse(grepl("Age_Over_84", Age_Cohort, ignore.case = T),"Age_Over_84","Other")))))))))))))),
			#Race
			Race_desc = ifelse(grepl("_W", Age_Cohort, ignore.case = F), "White",
				ifelse(grepl("_B", Age_Cohort, ignore.case = F), "Black",
				ifelse(grepl("_NHPI", Age_Cohort, ignore.case = F),"NHPI",
				ifelse(grepl("_AIAN", Age_Cohort, ignore.case = F),"AIAN",
				ifelse(grepl("_A", Age_Cohort, ignore.case = F),"Asian",
				ifelse(grepl("_L", Age_Cohort, ignore.case = F),"Latino","Other")))))),
			#Sex
			Sex = ifelse(grepl("_Male", Age_Cohort, ignore.case = T), "Male",
			 ifelse(grepl("_Female", Age_Cohort, ignore.case = T), "Female","Both"
		)))
		#Do again for aggregate BIPOC Category
		Population_Summary_Bipoc.. <-	filter(State_Census.., State == Population_Select_State & Year%in% Study_Year) %>%
			pivot_longer(!c(State,GEOID,NAME,Year), names_to = "Age_Cohort", values_to = "Population")
		#Create new column for race
		Population_Summary_Bipoc.. <- mutate(Population_Summary_Bipoc..,
			#Age cohort
			Age_Cohort_Update = ifelse(grepl("Age_Under5", Age_Cohort, ignore.case = T), "Age_Under5",
				ifelse(grepl("Age_5_9", Age_Cohort, ignore.case = T), "Age_5_9",
				ifelse(grepl("Age_10_14", Age_Cohort, ignore.case = T),"Age_10_14",
				ifelse(grepl("Age_15_17", Age_Cohort, ignore.case = T),"Age_15_17",
				ifelse(grepl("Age_18_19", Age_Cohort, ignore.case = T),"Age_18_19",
				ifelse(grepl("Age_20_24", Age_Cohort, ignore.case = T),"Age_20_24",
				ifelse(grepl("Age_25_29", Age_Cohort, ignore.case = T),"Age_25_29",
				ifelse(grepl("Age_30_34", Age_Cohort, ignore.case = T),"Age_30_34",
				ifelse(grepl("Age_35_44", Age_Cohort, ignore.case = T),"Age_35_44",
				ifelse(grepl("Age_45_54", Age_Cohort, ignore.case = T),"Age_45_54",
				ifelse(grepl("Age_55_64", Age_Cohort, ignore.case = T),"Age_55_64",
				ifelse(grepl("Age_65_74", Age_Cohort, ignore.case = T),"Age_65_74",
				ifelse(grepl("Age_75_84", Age_Cohort, ignore.case = T),"Age_75_84",
				ifelse(grepl("Age_Over_84", Age_Cohort, ignore.case = T),"Age_Over_84","Other")))))))))))))),
			#Race
			Race_desc = ifelse(grepl("_W", Age_Cohort, ignore.case = F), "White",
				ifelse(grepl("_B", Age_Cohort, ignore.case = F), "BIPOC",
				ifelse(grepl("_NHPI", Age_Cohort, ignore.case = F),"BIPOC",
				ifelse(grepl("_AIAN", Age_Cohort, ignore.case = F),"BIPOC",
				ifelse(grepl("_A", Age_Cohort, ignore.case = F),"BIPOC",
				ifelse(grepl("_L", Age_Cohort, ignore.case = F),"BIPOC","Other")))))),
			#Sex
			Sex = ifelse(grepl("_Male", Age_Cohort, ignore.case = T), "Male",
			 ifelse(grepl("_Female", Age_Cohort, ignore.case = T), "Female","Both"
		)))

		#Summarize
		Population_Summary_Bipoc.. <- Population_Summary_Bipoc.. %>% group_by( Race_desc, State, Age_Cohort_Update, Sex) %>% summarise(Population = sum(Population) )
		#Sum all years
		Population_Summary..  <- Population_Summary..  %>% group_by( Race_desc, State, Age_Cohort_Update, Sex) %>% summarise(Population = sum(Population) )
		#Combine
		Population_Summary.. <- rbind(Population_Summary..[,colnames(Population_Summary_Bipoc..)], filter(Population_Summary_Bipoc.., Race_desc !="White"))

		#Prepare standard population data (US)
		##########################################
		#Pivot data
		US_Population_Summary.. <-	 filter(State_Census.., Year%in%Study_Year) %>%
			pivot_longer(!c(State,GEOID,NAME,Year), names_to = "Age_Cohort", values_to = "Population") %>%
			#Update names
			mutate(
			#Age cohort
			Age_Cohort_Update = ifelse(grepl("Age_Under5", Age_Cohort, ignore.case = T), "Age_Under5",
				ifelse(grepl("Age_5_9", Age_Cohort, ignore.case = T), "Age_5_9",
				ifelse(grepl("Age_10_14", Age_Cohort, ignore.case = T),"Age_10_14",
				ifelse(grepl("Age_15_17", Age_Cohort, ignore.case = T),"Age_15_17",
				ifelse(grepl("Age_18_19", Age_Cohort, ignore.case = T),"Age_18_19",
				ifelse(grepl("Age_20_24", Age_Cohort, ignore.case = T),"Age_20_24",
				ifelse(grepl("Age_25_29", Age_Cohort, ignore.case = T),"Age_25_29",
				ifelse(grepl("Age_30_34", Age_Cohort, ignore.case = T),"Age_30_34",
				ifelse(grepl("Age_35_44", Age_Cohort, ignore.case = T),"Age_35_44",
				ifelse(grepl("Age_45_54", Age_Cohort, ignore.case = T),"Age_45_54",
				ifelse(grepl("Age_55_64", Age_Cohort, ignore.case = T),"Age_55_64",
				ifelse(grepl("Age_65_74", Age_Cohort, ignore.case = T),"Age_65_74",
				ifelse(grepl("Age_75_84", Age_Cohort, ignore.case = T),"Age_75_84",
				ifelse(grepl("Age_Over_84", Age_Cohort, ignore.case = T),"Age_Over_84","Other")))))))))))))),
			#Race
			Race_desc = ifelse(grepl("_W", Age_Cohort, ignore.case = F), "White",
				ifelse(grepl("_B", Age_Cohort, ignore.case = F), "Black",
				ifelse(grepl("_NHPI", Age_Cohort, ignore.case = F),"NHPI",
				ifelse(grepl("_AIAN", Age_Cohort, ignore.case = F),"AIAN",
				ifelse(grepl("_A", Age_Cohort, ignore.case = F),"Asian",
				ifelse(grepl("_L", Age_Cohort, ignore.case = F),"Latino","Other")))))),
			#Sex
			Sex = ifelse(grepl("_Male", Age_Cohort, ignore.case = T), "Male",
			 ifelse(grepl("_Female", Age_Cohort, ignore.case = T), "Female","Both"
			))) %>%
			#Sum all states for national figures
			group_by(Age_Cohort_Update, Race_desc, Sex) %>% summarise(Population = sum(Population,na.rm=T) ) %>%
			mutate(Age_Cohort = Age_Cohort_Update)

		#Prepare standard population data (US) - Do for aggregate BIPOC----
		##########################################
		#Pivot data
		US_Population_Summary_Bipoc.. <-	 filter(State_Census.., Year%in%Study_Year) %>%
			pivot_longer(!c(State,GEOID,NAME,Year), names_to = "Age_Cohort", values_to = "Population") %>%
			#Update names
			mutate(
			#Age cohort
			Age_Cohort_Update = ifelse(grepl("Age_Under5", Age_Cohort, ignore.case = T), "Age_Under5",
				ifelse(grepl("Age_5_9", Age_Cohort, ignore.case = T), "Age_5_9",
				ifelse(grepl("Age_10_14", Age_Cohort, ignore.case = T),"Age_10_14",
				ifelse(grepl("Age_15_17", Age_Cohort, ignore.case = T),"Age_15_17",
				ifelse(grepl("Age_18_19", Age_Cohort, ignore.case = T),"Age_18_19",
				ifelse(grepl("Age_20_24", Age_Cohort, ignore.case = T),"Age_20_24",
				ifelse(grepl("Age_25_29", Age_Cohort, ignore.case = T),"Age_25_29",
				ifelse(grepl("Age_30_34", Age_Cohort, ignore.case = T),"Age_30_34",
				ifelse(grepl("Age_35_44", Age_Cohort, ignore.case = T),"Age_35_44",
				ifelse(grepl("Age_45_54", Age_Cohort, ignore.case = T),"Age_45_54",
				ifelse(grepl("Age_55_64", Age_Cohort, ignore.case = T),"Age_55_64",
				ifelse(grepl("Age_65_74", Age_Cohort, ignore.case = T),"Age_65_74",
				ifelse(grepl("Age_75_84", Age_Cohort, ignore.case = T),"Age_75_84",
				ifelse(grepl("Age_Over_84", Age_Cohort, ignore.case = T),"Age_Over_84","Other")))))))))))))),
			#Race
			Race_desc = ifelse(grepl("_W", Age_Cohort, ignore.case = F), "White",
				ifelse(grepl("_B", Age_Cohort, ignore.case = F), "BIPOC",
				ifelse(grepl("_NHPI", Age_Cohort, ignore.case = F),"BIPOC",
				ifelse(grepl("_AIAN", Age_Cohort, ignore.case = F),"BIPOC",
				ifelse(grepl("_A", Age_Cohort, ignore.case = F),"BIPOC",
				ifelse(grepl("_L", Age_Cohort, ignore.case = F),"BIPOC","Other")))))),
			#Sex
			Sex = ifelse(grepl("_Male", Age_Cohort, ignore.case = T), "Male",
			 ifelse(grepl("_Female", Age_Cohort, ignore.case = T), "Female","Both"
			))) %>%
			#Sum all states for national figures
			group_by(Age_Cohort_Update,Race_desc,Sex) %>% summarise(Population = sum(Population,na.rm=T)) %>%
			mutate(Age_Cohort = Age_Cohort_Update)
		#Sumamrise
		US_Population_Summary_Bipoc.. <- US_Population_Summary_Bipoc.. %>% group_by(Age_Cohort_Update, Race_desc, Sex) %>% summarise(Population = sum(Population) )
		#Sum all years
		#US_Population_Summary..  <- US_Population_Summary..  %>% group_by( Race_desc,Age_Cohort_Update, Sex) %>% summarise(Population = sum(Population) / length(Study_Year))
		#Combine
		US_Population_Summary.. <- rbind(US_Population_Summary..[,colnames(US_Population_Summary_Bipoc..)], filter(US_Population_Summary_Bipoc.., Race_desc !="White")) %>%
			mutate(Age_Cohort = Age_Cohort_Update)

		#Join population and crash data Oregon
		##############################
		#Remove and replace Age cohort column
		Population_Summary.. <- dplyr::select(mutate(Population_Summary.., Age_Cohort = Age_Cohort_Update), -c(Age_Cohort_Update))
		#Create oregon average
		Population_Summary.. <- rbind(Population_Summary..,cbind(filter(Population_Summary.., Race_desc !="BIPOC") %>% group_by(State, Age_Cohort, Sex) %>%
			summarise(Population = sum(Population) ),Race_desc = "Oregon")[,c("Race_desc",  "State" ,  "Sex", "Population", "Age_Cohort")])
		#Join with fatal
		Population_Summary.. <- left_join(filter(Population_Summary..,Sex =="Both"), Select_State_Fatal.., by = c("Age_Cohort", "Race_desc"))
		#Calcuate rate
		Population_Summary.. <- mutate(Population_Summary.., Rate = Count / (Population  /100000))
		#Create oregon population summary, create weights and add to data
		Population_Summary.. <- left_join(Population_Summary..,
			#Calculate weights
			mutate(cbind(filter(US_Population_Summary..) %>% group_by(Age_Cohort) %>% summarise(US_Population = sum(Population)),
				Total_Population = US_Population_Summary.. %>% group_by() %>%
				summarise(Total_US_Population = sum(Population))),US_Wgt = US_Population / Total_US_Population)[,c("Age_Cohort","US_Population","US_Wgt")],
				by = "Age_Cohort")
		#Create population adjusted rates
		Population_Summary.. <- mutate(Population_Summary.., Adj_Rate = Rate * US_Wgt)
		#Remove age cohorts with zero traffic deaths
		Population_Summary.. <- Population_Summary..[!(is.na(Population_Summary..$Count)),]
		#Sum the weighted rates
		OR_AgeAdj_Rate.. <- cbind(mutate(Population_Summary.. %>% group_by(Race_desc,Mode) %>% summarise(Rate = sum(Adj_Rate), Count = sum(Count),SE = sum(Adj_Rate) / sum(Count),
			UB = (sum(Adj_Rate) / sum(Count)) * 1.96, LB = (sum(Adj_Rate) / sum(Count)) * -1.96, Population = sum(Population)), Rate_LB = Rate + LB, Rate_UB = Rate + UB),Geography = "Oregon")

		#Do national rate calculation
		###########################
		#US_Population_Summary.. <- ungroup(US_Population_Summary..)
		US_Population_Summary.. <- dplyr::select(mutate(ungroup(US_Population_Summary..) , Age_Cohort = Age_Cohort_Update), -c(Age_Cohort_Update))
		#US_Population_Summary.. <- mutate(US_Population_Summary.., Age_Cohort = Age_Cohort_Update)

		#Create US average
		US_Population_Summary.. <- rbind(US_Population_Summary..,cbind(US_Population_Summary.. %>% group_by( Age_Cohort, Sex) %>%
			summarise(Population = sum(Population)),Race_desc = "US")[,colnames(US_Population_Summary..)])
		#Join with fatal
		US_Population_Summary.. <- left_join(filter(US_Population_Summary..,Sex =="Both"), US_Fatal.., by = c("Age_Cohort", "Race_desc"))
		#Calcuate rate
		US_Population_Summary.. <- mutate(US_Population_Summary.., Rate = Count / (Population /100000))
		#Create US population summary, create weights and add to data
		US_Population_Summary.. <- left_join(US_Population_Summary..,
			#Calculate weights
			mutate(cbind(US_Population_Summary.. %>% group_by(Age_Cohort) %>% summarise(US_Population = sum(Population)),
				Total_Population = US_Population_Summary.. %>% group_by() %>%
				summarise(Total_US_Population = sum(Population))),US_Wgt = US_Population / Total_US_Population)[,c("Age_Cohort","US_Population","US_Wgt")],
				by = "Age_Cohort")
		#Create population adjusted rates
		US_Population_Summary.. <- mutate(US_Population_Summary.., Adj_Rate = Rate * US_Wgt)
		#Remove age cohorts with zero traffic deaths
		US_Population_Summary.. <- US_Population_Summary..[!(is.na(US_Population_Summary..$Count)),]
		#Sum the weighted rates
		US_AgeAdj_Rate.. <- cbind(mutate(US_Population_Summary.. %>% group_by(Race_desc, Mode) %>% summarise(Rate = sum(Adj_Rate), Count = sum(Count),SE = sum(Adj_Rate) / sum(Count),
			UB = (sum(Adj_Rate) / sum(Count)) * 1.96,LB = (sum(Adj_Rate) / sum(Count)) * -1.96, Population = sum(Population)), Rate_LB = Rate + LB, Rate_UB = Rate + UB),Geography = "US")

		#Store rate
		#################
		Master_Rate.. <- rbind(Master_Rate..,cbind(rbind(OR_AgeAdj_Rate..,US_AgeAdj_Rate..),Year = paste(FARS_Period.[1],"-",FARS_Period.[5],sep="")))

	}

	#Change names to better descriptions for charting
	#################################
	Master_Rate.. <- mutate(Master_Rate.., Race_desc = ifelse(Race_desc == "Oregon", "Oregon Average",
		ifelse(Race_desc == "US", "US Average",
		#Chnage to more descr. race categories
		ifelse(Race_desc == "AIAN", "American Indian &\n Alaskan Native",
		ifelse(Race_desc == "NHPI", "Native Hawaiian &\n Pacific Islander",
		ifelse(Race_desc == "Latino", "Latinx",
		ifelse(!(Race_desc%in%c("AIAN","Oregon","NHPI")), Race_desc,NA)))))),
		Race_desc = factor(Race_desc,c("American Indian &\n Alaskan Native","Asian","Black","Latinx","Native Hawaiian &\n Pacific Islander","White","BIPOC","Oregon Average","US Average")))

	#Store data
	save(Master_Rate.., file = "/Data/Injury_Rates.RData")

	#Explore results
	as.data.frame(filter(Master_Rate.. , Mode =="Pedestrian" & Geography =="Oregon")) [,c("Race_desc","Mode","Count","Population","Rate","Rate_LB","Rate_UB","SE","UB","LB","Geography","Year")]

	#Chart the results
	#-----------------------
	#Chart most current period of Fatal Pedestrian Injury Rates
	###########################
	dat <- 	mutate(filter(Master_Rate.., Year == "2014-2018" & Geography == "Oregon" & Mode == "Pedestrian" ))
	#dat <- P2
	dat$Rate_LB[dat$Rate_LB <0] <- 0
	Colors. <- colorRampPalette(c("skyblue", "lightgreen"))(nrow(dat))
	Plot1 <- ggplot(dat, aes(x = Race_desc, y = Rate)) +
		#coord_flip() +
		geom_bar(stat="identity", width=.5, position = "dodge",aes(fill = Race_desc))  +
		geom_errorbar(aes(ymin=Rate_LB, ymax=Rate_UB), width=.2, position=position_dodge(.9)) +
		#scale_y_continuous(labels=percent) +
		geom_text(aes(x = Race_desc, y = 1, label = round(Rate,1)),fontface = "bold", size = 8, position = position_dodge(width = .5)) +
		labs(y = "Fatal Pedestrian Injuries per 100,000 Person-Years" , x = "Census/NHTSA Race Categories", caption ="Source: FARS & Census/n*Age-adjusted Rates") +
		ggtitle("Pedestrian /n Traffic Injury Death Rates* by Race/nOregon/n2014-2018") +
		scale_fill_manual( values=Colors. ) +
		theme(text = element_text(size = 16)) +
		facet_wrap(~Mode, nrow = 1,scales = "free") +
		#Center plot
		theme(plot.title = element_text(hjust = 0.5)) +
		theme(legend.position = "none") +
		theme(legend.text=element_text(size=16),legend.title=element_text(size=16)) +
		theme(axis.text.y=element_text(size=20),axis.title.y=element_text(size=16)) +
		theme(axis.text.x=element_text(size=16),axis.title.x=element_text(size=16)) +
		theme(axis.title.x=element_text(size=16)) +
		theme(strip.text.x = element_text(size = 14))

	#Chart second period of Fatal Pedestrian Injury Rates
	dat <- 	mutate(filter(Master_Rate.., Year == "2009-2013" & Geography == "Oregon" & Mode == "Pedestrian" ))
	dat$Rate_LB[dat$Rate_LB <0] <- 0
	Colors. <- colorRampPalette(c("skyblue", "lightgreen"))(nrow(dat))
	Plot2 <- ggplot(dat, aes(x = Race_desc, y = Rate)) +
		#coord_flip() +
		geom_bar(stat="identity", width=.5, position = "dodge",aes(fill = Race_desc))  +
		geom_errorbar(aes(ymin=Rate_LB, ymax=Rate_UB), width=.2, position=position_dodge(.9)) +
		#scale_y_continuous(labels=percent) +
		geom_text(aes(x = Race_desc, y = 1, label = round(Rate,1)),fontface = "bold", size = 8, position = position_dodge(width = .5)) +
		labs(y = "Fatal Pedestrian Injuries per 100,000 Person-Years" , x = "Census/NHTSA Race Categories", caption ="Source: FARS & Census/n*Age-adjusted Rates") +
		ggtitle("Pedestrian /n Traffic Injury Death Rates* by Race/nOregon/n2009-2013") +
		scale_fill_manual( values=Colors. ) +
		theme(text = element_text(size = 16)) +
		facet_wrap(~Mode, nrow = 1,scales = "free") +
		#Center plot
		theme(plot.title = element_text(hjust = 0.5)) +
		theme(legend.position = "none") +
		theme(legend.text=element_text(size=16),legend.title=element_text(size=16)) +
		theme(axis.text.y=element_text(size=20),axis.title.y=element_text(size=16)) +
		theme(axis.text.x=element_text(size=16),axis.title.x=element_text(size=16)) +
		theme(axis.title.x=element_text(size=16)) +
		theme(strip.text.x = element_text(size = 14))

	#Arrange data into a single plot
	grid.arrange(Plot1, Plot2)

	#Line chart show Oregon - Shows pedestrian but select different user type for other modes
	#####################################
	#Select a user type to show
	user_type <- "Pedestrian"
	dat <- 	filter(Master_Rate.., Mode%in%user_type & Year%in%c("2009-2013","2014-2018") & Race_desc != "Native Hawaiian &\n Pacific Islander")
	dat$Rate_LB[dat$Rate_LB <0] <- 0
	dat2 <- mutate(filter(dat, Race_desc%in%c("Oregon Average","US Average")), Geography = paste(Geography, " Average"))
	dat <- filter(dat, !(Race_desc%in%c("Oregon Average","US Average")))
	for(i in 1:length(unique(dat$Race_desc))){dat2 <- rbind(dat2,mutate(dat2,Race_desc = unique(dat$Race_desc)[i]))}
	dat2 <- filter(dat2, !(Race_desc%in%c("Oregon Average","US Average")))
	user_type
	#dat2$Type <- "Average"
	dat <- rbind(dat, dat2)
	dat <- filter(dat, !(Geography%in%c("US","US  Average")))
	dat$Geography[dat$Geography%in%"Oregon"] <- "Rate for Race"
	dat$Geography[dat$Geography%in%"US"] <- "US Rate for Race"
	dat$Legend <- dat$Geography
	dat$Label <- round(dat$Rate,1)
	dat$Label[!(dat$Legend%in%"Rate for Race")] <- ""
	Colors. <- colorRampPalette(c("blue", "darkgreen"))(3)
	ggplot(dat, aes(x = Year, y = Rate, group = Legend)) +
		geom_line(aes(x = Year, y = Rate, color = Legend), size = .75)  +
		geom_point(aes(x = Year, y = Rate, color = Legend), size = 4.5)  +
		geom_ribbon(aes(ymin = Rate_LB, ymax = Rate_UB, fill = Legend),alpha=0.3) +
		geom_text(aes(x = Year, y = Rate + 1, label = Label), fontface = "bold", size = 4) +
		facet_wrap(~Race_desc) +
		scale_y_continuous( breaks=pretty_breaks(7), expand = c(0.15,0)) +
		# geom_text(aes(x = Year, y = Rate, label = round(Rate,1)),fontface = "bold", size = 4, position = position_dodge(width = .25)) +
		labs(y = "Deaths per 100,000 Person-Years" , x = "Analysis Period", caption ="*Age-adjusted Rates/nNHPI not shown due to small cell size") +
		ggtitle(paste(user_type,"\n Traffic Injury Death Rates* by Race/nOregon/nChange Over Time",sep="")) +
		scale_color_manual( values=Colors. ) +
		theme(text = element_text(size = 16)) +
		#facet_wrap(~Year, nrow = 1) +
		#Center plot
		theme(plot.title = element_text(hjust = 0.5)) +
		guides(color=guide_legend(title="Legend")) +
		theme(legend.text=element_text(size=16),legend.title=element_text(size=16)) +
		theme(axis.text.y=element_text(size=20),axis.title.y=element_text(size=16)) +
		theme(axis.text.x=element_text(size=16),axis.title.x=element_text(size=16)) +
		theme(axis.title.x=element_text(size=16)) +
		theme(strip.text.x = element_text(size = 14))

	#Cycle through select modes and construct charts for those modes
	#####################################
	for(user_type in c("Bicyclist","Motor Vehicle","Pedestrian")){
		#Show change over time
		####################################
		dat <- 	mutate(filter(Master_Rate.., Geography == "Oregon" & Mode == user_type))
		dat$Rate_LB[dat$Rate_LB <0] <- 0

		Colors. <- colorRampPalette(c("skyblue", "lightgreen"))(3)
		Plot3 <- ggplot(dat, aes(x = Race_desc, y = Rate, group = Year)) +
			#coord_flip() +
			geom_bar(stat="identity", width=.5, position = "dodge",aes(fill = Year))  +
			geom_errorbar(aes(ymin=Rate_LB, ymax=Rate_UB), width=.2,  position = position_dodge(width = 0.5))+
			geom_text(aes(x = Race_desc, y = Rate, label = round(Rate,1)),fontface = "bold", size = 5, position = position_dodge(width = .5)) +
			labs(y = "Deaths per 100,000 Person-Years" , x = "Census/NHTSA Race Categories", caption ="*Age-adjusted Rates") +
			ggtitle(paste(user_type,"\n Traffic Injury Death Rates* by Race/nOregon/nChange Over Time",sep="")) +
			scale_fill_manual( values=Colors. ) +
			theme(text = element_text(size = 16)) +
			#facet_wrap(~Year, nrow = 1) +
			#Center plot
			theme(plot.title = element_text(hjust = 0.5)) +
			#theme(legend.position = "none") +
			theme(legend.text=element_text(size=12),legend.title=element_text(size=16)) +
			theme(axis.text.y=element_text(size=20),axis.title.y=element_text(size=16)) +
			theme(axis.text.x=element_text(size=16),axis.title.x=element_text(size=16)) +
			theme(axis.title.x=element_text(size=16)) +
			theme(strip.text.x = element_text(size = 14))

		#Line chart show Oregon
		#####################################
		dat <- 	filter(Master_Rate.., Mode%in% user_type)
		dat$Rate_LB[dat$Rate_LB <0] <- 0
		dat2 <- mutate(filter(dat, Race_desc%in%c("Oregon Average","US Average")), Geography = paste(Geography, " Average"))
		dat <- filter(dat, !(Race_desc%in%c("Oregon Average","US Average")))
		for(i in 1:length(unique(dat$Race_desc))){dat2 <- rbind(dat2,mutate(dat2,Race_desc = unique(dat$Race_desc)[i]))}
		dat2 <- filter(dat2, !(Race_desc%in%c("Oregon Average","US Average")))

		#dat2$Type <- "Average"
		dat <- rbind(dat, dat2)
		dat <- filter(dat, !(Geography%in%c("US","US  Average")))
		dat$Geography[dat$Geography%in%"Oregon"] <- "Rate for Race"
		dat$Geography[dat$Geography%in%"US"] <- "US Rate for Race"
		dat$Legend <- dat$Geography
		Colors. <- colorRampPalette(c("blue", "darkgreen"))(3)
		Plot4 <- ggplot(dat, aes(x = Year, y = Rate, group = Legend)) +
		  #coord_flip() +
		  #geom_bar(stat="identity", width=.5, position = "dodge",aes(fill = Year))  +
		  geom_line(aes(x = Year, y = Rate, color = Legend), size = .75)  +
		  geom_point(aes(x = Year, y = Rate, color = Legend), size = 4.5)  +
		  geom_ribbon(aes(ymin = Rate_LB, ymax = Rate_UB, fill = Legend),alpha=0.3) +

		  facet_wrap(~Race_desc) +
		  scale_y_continuous( breaks=pretty_breaks(7), expand = c(0.15,0)) +
		 # geom_text(aes(x = Year, y = Rate, label = round(Rate,1)),fontface = "bold", size = 4, position = position_dodge(width = .25)) +
		  labs(y = "Deaths per 100,000" , x = "Analysis Period", caption ="*Age-adjusted Rates") +
		  ggtitle(paste(user_type,"\n Traffic Injury Death Rates* by Race/nOregon/nChange Over Time",sep="")) +
		  scale_color_manual( values=Colors. ) +
		  theme(text = element_text(size = 16)) +
		  #facet_wrap(~Year, nrow = 1) +
		  #Center plot
		  theme(plot.title = element_text(hjust = 0.5)) +
		  guides(color=guide_legend(title="Legend")) +
		  theme(legend.text=element_text(size=16),legend.title=element_text(size=16)) +
		  theme(axis.text.y=element_text(size=20),axis.title.y=element_text(size=16)) +
		  theme(axis.text.x=element_text(size=16),axis.title.x=element_text(size=16)) +
		  theme(axis.title.x=element_text(size=16)) +
		  theme(strip.text.x = element_text(size = 14))

		#Write out pdf
		pdf(file = paste("Reports/",user_type,"_FARS_by_Race.pdf",sep=""), height = 11, width = 18)
		print(Plot3)
		print(Plot4)
		#print(Plot5)
		dev.off()
}


  decompose.into.sets = function( x, data.series="seabird" ) {

    # determine an empirical threshold for fishing vs not fishing
    # this algorithm uses empircal CDF's and quantiles: most of the time is spent near the surface not fishing
    # set a threshold of the 0.05 quantile as the cutoff.. and make sure there is no drift either too

    ndata = length(x)
    X = data.frame( dataorder=1:ndata, X=x, fishing=1, id=NA )

    # based upon empirical observation from 2012 data, near-surface values should be ~ 0.014 decibar
    # detect any drift in the initial pressure values
    if (data.series=="seabird") {
      # error checking values to detect drift in pressure sensors at surface
      expectedValue=0.014
      PrThreshold = 0.05  # median value ~ 0.055 decibars
      fishing.threshold = 10 # 5 decibars will remove most non-fishing events
      lscale =  60  # ==60 / 5 *5, the number of pings expected for a 5 min tow at 5 pings per second == 60/5 *5)
      # for the seabird there is a ping every 5 sec ; 2min minimum = 2*60/5 = 24 pings required
    }

    threshold = quantile( X$X, probs=PrThreshold )
    if (abs (threshold - expectedValue ) > (2 * sd( X$X[ X$X <= threshold] )) ) {
      print( "----------")
      print( "A significant deviation was detected in the data stream for the data file, above" )
      print( "Assuming it was drift, but the data should be checked." )
      print( paste( "observed:", threshold) )
      print( "expected: ~ 0.1 decibar" )
      print( paste( "mean: ", mean( x[x<=threshold] ) ) )
      print( paste( "sd: ", sd( x[x<=threshold] ) ) )
      print( "----------")

      if (abs(threshold) > 1) {
        print( "In fact, the deviation was > 1 decibar" )
        print( "Stopping now as there may be something wrong with the data" )
        stop()
      }

      X$X = X$X - threshold

    }

    # flag to indicate is fishing is occurring via bottom contact
    not.fishing = which( X$X < fishing.threshold)   # 5 decibars is a safe limit given the survey
    if (length(not.fishing) > 0) X$fishing[ not.fishing ] = 0

    # by taking the sum of fishing with fishing offset by 1, we can
    # get the boundaries where fishing starts and stop by looking for 1's
    X$fishing.boundary = X$fishing + c(0, X$fishing[1:(ndata-1)] )
    intervals = which( X$fishing.boundary == 1 ) # these are the boundaries between fishing and non-fishing events

    count = 0
    for (o in 1:(length((intervals))-1)) {
      i0 = intervals[o]
      i1 = intervals[o+1]
      if ( (i1 - i0) < lscale*0.75 ) next()  # accept only if the number of pings > 75% of expected number to be safe
      # number of pings is sufficient ... now check if fishing or not
      if (mean( X$X[i0:i1], na.rm=T) < 2*fishing.threshold ) next()
      count = count + 1
      X$id [ i0:i1 ] = count
    }
    return( X$id[ order(X$dataorder) ])
  }


# function to display estimation results  2015-3-11 Thong Pham
print.PAFit_result <- function(x,...) {
  if (length(x$oneshot) > 0) {
      if (x$oneshot == TRUE)
      cat("Containing the result of the PAFit_oneshot method. \n")
  } else {
  cat("\nContaining the estimation results by the PAFit method. \n")
  if (x$only_PA == TRUE) {
      cat("Mode: Only the attachment function was estimated. \n")
  } else if (x$only_f == TRUE) {
      cat("Mode: Only node fitnesses were estimated. \n")
  }
  else {
      cat("Mode: Both the attachment function and node fitness were estimated. \n")
  }

  }
  #cat(" Form of the PA function:",x$mode_f,"\n");
  if (x$only_f == FALSE) {
      if (length(x$auto_lambda) > 0) {
          if (x$auto_lambda == TRUE) {
              cat("Selected r parameter:", x$ratio,"\n");
          } else cat("Lambda used:", x$lambda,"\n");
      }
  }

  if (x$only_PA == FALSE)
      cat("Selected s parameter: ",x$shape,"\n", sep = "")
  cat("Estimated attachment exponent:",x$alpha,"\n");
  if (x$ci[1] == "N") {
    cat("No possible confidence interval for the estimated attachment exponent.\n");
  } else if (length(x$mode_f) > 0) {
        if (x$mode_f != "Log_linear") {
            cat("Attachment exponent ","\u00B1", " 2 s.d.", ": (", x$ci[1], ",",
              x$ci[2],")\n",sep = "");
        }
    } else {
     cat("Attachment exponent ","\u00B1", " 2 s.d.", ": (", x$ci[1], ",",
         x$ci[2],")\n",sep = "");

  }
}


library(tidyverse)
library(igraph)

partes_tesis <- tibble::tribble(
                    ~codigo, ~x, ~y,                                                                                ~nodo_desc,          ~tarea,             ~origen,                                                                                ~detalle,
                       "h1",  1,  5,                                                                                "La red agregada total (desde 1996 a 2016) es de mundo pequeño puesto que es una característica presente en la mayoría de las redes de coautorías científicas.",     "hipotesis",        "Plan tesis",                                                          "mundo pequenio y libre escala",
                       "h2",  1, 10,                                                                                "La cantidad de autores aumenta en el tiempo debido al crecimiento de la disciplina en el país, lo que se refleja en un aumento en la cantidad de nodos en la red.",     "hipotesis",        "Plan tesis",                                                  "cuidado con crecimiento de disciplina",
                       "h3",  1, 15,                                                                                "Los autores fundadores se refuerzan en el tiempo, lo cual se verá reflejado en mayores medidas de grado, intermediación y fuerza de colaboración.",     "hipotesis",        "Plan tesis",                                                "verificar en diferentes T las metricas.",
                       "h4",  1, 20,                                                                                "Los componentes más grandes absorben a los más pequeños a lo largo del tiempo, dado que autores periféricos pasan a trabajar en conjunto con autores principales.",     "hipotesis",        "Plan tesis",                        "si se abosrben componentes en tiempo, los links que se generan.",
                       "t1",  3,  1,                                     "Desambiguación de nombres de autor, se considera un proceso necesario para el armado de la base de datos. Esto puede verse reflejado en el trabajo de Morel et al. (2009) [ 9 ] y una fundamentación más extensa de por qué realizar esta tarea se observa en el trabajo de Tang (2010) [ 10 ]",         "tarea",             "kumar",                                                                                "--",
                       "t2",  3,  3,                                                                                "Visualización de la red. Se plantea tener diferentes puntos de vista que pueden ayudar con el análisis de la red complementario a las métricas.",         "tarea",             "kumar",                                                                                "--",
                       "t3",  3,  5,                                                                                "Análisis de mundo pequeño y red de libre escala (Small World & scale free) para la red agregada total y para cada instante temporal, para poder comparar la red obtenida con simulaciones basadas en sus particularidades.",              NA,             "kumar",                                                                                "--",
                       "t4",  3,  7,                                                                                "El tamaño del componente gigante y su evolución en el tiempo. Este análisis brinda la posibilidad de ver qué tan cohesiva o fragmentada es la red.",         "tarea",             "kumar",                                                                                "--",
                       "t5",  3,  9,                                                                                "El componente gigante podría significar la principal actividad de investigación; mientras que los otros componentes pueden ser agrupamientos especializados o sub-comunidades. (Fatt et al., 2010) [ 8 ]",         "tarea",             "kumar",                                                                                "--",
                       "t6",  3, 11,                                                                                "Búsqueda de Comunidades.  Este análisis permite evaluar la ubicación e interacciones entre los distintos grupos de investigación dentro de la red y buscarles un sentido a las comunidades dentro del contexto de la disciplina.",         "tarea",           "koseglu",                                                                                "--",
                       "t7",  3, 13,   "Métricas generales a fin de analizar por períodos de agregación y la red completa. De las métricas que se tendrán en cuenta se destacan: (a) artículos con más de un autor, (b) autores que participan en artículos con más de un autor, (c) índice de colaboración, siendo este último una relación entre las medidas (b) / (c)",         "tarea",           "koseglu",                                                                                "--",
                       "t8",  3, 15,                "Patrones de autoría, es decir, cuántos artículos por cantidad de autores existen en los diferentes periodos, dejando expuesto cuantos participan individualmente, en colaboración de a 2 autores, o más. Este análisis es útil para evaluar si existen tendencias de mayor trabajo en equipo a lo largo del tiempo.",         "tarea",           "koseglu",                                                                                "--",
                       "t9",  3, 17, "Comparación con otras redes de coautoría realizadas en otros trabajos utilizando métricas que están presentes en todos ellos por ejemplo: (a) artículos por autor, (b) coeficiente de clustering (transitividad), (c) tamaño del componente principal, (d) componente principal representado en porcentaje, y (e) distancia media.",         "tarea",           "koseglu",                                                                                "--",
                       "s1",  5,  1,                                                                                "Capitulo 1: introduccion", "seccion tesis", "Escritura – tesis",    "Establecer contexto, plantear problema, plantear plan de solucion, pie a capitulo 2",
                       "s2",  5,  3,                                                                                "Capitulo 2: generacion Datos", "seccion tesis", "Escritura – tesis",     "intro de capitulo, materiales y metodos, resultados de procesos, resumen, pie al 3",
                       "s3",  5,  5,                                                                                "Capitulo 3: generacion herramienta", "seccion tesis", "Escritura – tesis",               "intro del capitulo, materiales y metodos, resumen del capitulo, pie al 4",
                       "s4",  5,  7,                                                                                "Capitulo 4: analisis de red de coautoria", "seccion tesis", "Escritura – tesis", "intro del capitulo contestar hipotesis. Contestar objetivos. Resumen capitulo pie al 5",
                       "s5",  5,  9,                                                                                "Capitulo 5: discucion & cierre", "seccion tesis", "Escritura – tesis",                          "Intro, discucion, cierre, trabajos futuros.  Agradecimientos.",
                       "s6",  5, 11,                                                                                "ANEXO: software y librerías utilizadas", "seccion tesis", "Escritura – tesis",                                                                   "creditos al software",
                       "s7",  5, 13,                                                                                "ANEXO: Detalle estandarización autores", "seccion tesis", "Escritura – tesis",                               "detalle de como se realizo la estandarizacion de autores",
                       "s8",  5, 15,                                                                                "ANEXO: Detalle consideraciones PDF", "seccion tesis", "Escritura – tesis",                                                                   "detalle de los pdf\\",
                       "s9",  5, 17,                                                                                "ANEXO: Detalle procesamiento bibTEX", "seccion tesis", "Escritura – tesis",                                                                  "detalle de los bibtex",
                      "s10",  5, 19,                                                                                "ANEXO: Detalle de algoritmos para búsqueda de comunidades", "seccion tesis", "Escritura – tesis",                                  "detalle de algoritmos para la busqueda de comunidades",
                       "a1",  7,  1,                                                                                "cosideraciones: generales",   "seccion app",    "desarrollo app",                                                                        "consideraciones",
                       "a2",  7,  3,                                                                                "consideraciones: EDA",   "seccion app",    "desarrollo app",                                                                  "analisis exploratorio",
                       "a3",  7,  5,                                                                                "analisis estatico: visualizacion",   "seccion app",    "desarrollo app",                                                                          "visualizacion",
                       "a4",  7,  7,                                                                                "analisis estatico: articulos asociados",   "seccion app",    "desarrollo app",                                                                           "datos crudos",
                       "a5",  7,  9,                                                                                "analisis estatico: estructura red",   "seccion app",    "desarrollo app",                                                                       "estructura grafo",
                       "a6",  7, 11,                                                                                "analisis estatico: comparacion modelos",   "seccion app",    "desarrollo app",                                                                                "modelos",
                       "a7",  7, 13,                                                                                "analisis estatico: comunidades",   "seccion app",    "desarrollo app",                                                                            "comunidades",
                       "a8",  7, 15,                                                                                "analisis temporal: visualizacion dinamica",   "seccion app",    "desarrollo app",                                                                     "temporal evolucion",
                       "a9",  7, 17,                                                                                "analisis temporal: metricas red por anio",   "seccion app",    "desarrollo app",                                                                       "metricas anuales",
                      "a10",  7, 19,                                                                                "analisis temporal: metricas red acumuladas",   "seccion app",    "desarrollo app",                                                                    "metricas acumuladas",
                      "a11",  7, 21,                                                                                "analisis temporal: metricas nodos top N tiempo",   "seccion app",    "desarrollo app",                                                                         "metricas top n",
                      "a12",  7, 23,                                                                                "analisis temporal: metricas nodos top N tiempo acumuladas",   "seccion app",    "desarrollo app",                                                                 "metricas top n totales"
                    )

grafo_vacio <- make_empty_graph(n = 0, directed = FALSE)

hipotesis <- partes_tesis %>% filter(str_detect(codigo,pattern = 'h')) %>% pull(codigo)
tareas <- partes_tesis %>% filter(str_detect(codigo,pattern = 't')) %>% pull(codigo)
secciones <- partes_tesis %>% filter(str_detect(codigo,pattern = 's')) %>% pull(codigo)

grafo_resultado <- grafo_vacio +
    igraph::vertices(hipotesis,color='red') +
    igraph::vertices(tareas,color='blue') +
    igraph::vertices(secciones,color='green')

degree(grafo_resultado)

visNetwork::visIgraph(grafo_resultado)


#' extract_pH.r
#' Supplied with latitude and longtiude, this returns pH values at 250m resolution from the SoilGrids data product.
#' http://journals.plos.org/plosone/article?id=10.1371/journal.pone.0169748
#' https://soilgrids.org/
#'
#' Depends on the following packages:
#' raster,
#'
#' @param latitude   #a vector of latitude
#' @param longitude  #a vector of longitude
#' @param folder     #path to folder with SoilGrids raster. Defaults to scc1, built in check to work on pecan2.
#'
#' @return           #returns a vector of pH values.
#' @export
#'
#' @examples
#' 4 points from very different places as (longitude, latitude).
#' points <- structure(c(-102.644235, -58.015319, 50.508187, -148.2747566, 38.816171, -7.719157, 21.754477, 64.766184), .Dim = c(4L,2L))
#' test.out <- extract_pH(points[,2], points[,1])
extract_pH <- function(latitude, longitude,folder = '/project/talbot-lab-data/spatial_raster_data/SoilGrids_uncertainty'){
  #default directory path is scc1. Check if you are pecan2. Can be modified to work on more local machines this way.
  host <- system('hostname', intern=T)
  if(host == 'pecan2'){folder <- '/fs/data3/caverill/SoilGrids_pH/'}

  #specify raster path
  raster.path <- paste0(folder,'PHIHOX_M_sl2_250m.tif')

  #get lat-long as an object.
  points <- cbind(longitude, latitude)

  #load SoilGrids 1km pH raster.
  dat <- raster::raster(raster.path)

  #extract pH values.
  output <- raster::extract(dat, points)

  #divide by ten because to transform to true pH.
  output <- output/10

  #return output
  return(output)
}


library(data.table)
library(ggplot2)
library(corrplot)

# install.packages("corrplot")
# install.packages("data.table")

setwd("D:/data")
getwd()

# test code

filename <- "1_result.csv_stat.csv"

d = read.csv(filename)

dt <- data.table(d)

plot(dt)


png("temperature_distribution.png")
data <- read.table("output_sorted")
plot(data, xlab="Temperature", ylab="Number of readings")
dev.off()