# 3. faza: Vizualizacija podatkov
library(jcolors)
library(dplyr)
library(ggrepel)
#uvozimo zemljevid Evrope

zemljevid <- uvozi.zemljevid(
  "http://www.naturalearthdata.com/http//www.naturalearthdata.com/download/50m/cultural/ne_50m_admin_0_countries.zip", "ne_50m_admin_0_countries", encoding="UTF-8")
zemljevid <- zemljevid[zemljevid$CONTINENT == "Europe",]

cols1 <- c("#9fffe7",
           "#78e343",
           "#64bc8b",
           "#b7c172",
           "#c390b6",
           "#c9416d",
           "#cb4bab",
           "#de0004",
           "#02b0dd",
           "#67d564",
           "#025ecc",
           "#e7ff68",
           "#070043",
           "#ffdf41",
           "#f379ff",
           "#81a500",
           "#8e92ff",
           "#6d388a",
           "#32282f",
           "#c74d35",
           "#4c3560",
           "#086000",
           "#b9a192",
           "#ffaa44",
           "#004c4f",
           "#5d6994",
           "#53653b",
           "#ecffe2",
           "#4b0029",
           "#d0e0ff",
           "#7d4336",
           "#ff9096",
           "#b68247")

#-----------------------------------------------------------------------------------------------------------------------------------------------------
#Grafi o skupnem priseljevanju v Slovenijo

skupnopriseljevanje <- tabela1
skupno_leta <- skupnopriseljevanje %>% group_by(Leto) %>% summarise(Vsota=sum(Priseljeni_iz_tujine))
skupno_leta_mz <- skupnopriseljevanje %>% group_by(Leto,Spol) %>% summarise(Stevilo_priseljenih=sum(Priseljeni_iz_tujine))

graf1 <- ggplot(data=skupno_leta, aes(x=Leto, y=Vsota)) +
  geom_point(color=rgb(0.8,0.4,0.1,0.7))+
  geom_line(color=rgb(0.8,0.4,0.1,0.7)) +
  ylab('Skupno število priseljencev') +
  xlab('Leto') +
  ggtitle('Število priseljenih tujcev v Slovenijo skozi leta') +
  scale_x_continuous(breaks = 1*2011:2020) +
  theme(axis.text.x=element_text(angle=0))

# graf 2: število priseljenih po spolu__________________________-

graf2 <- skupno_leta_mz %>%  ggplot(aes(x=Leto, y=Stevilo_priseljenih, col=Spol, palette="Pastel1")) +
  geom_line() +
  ylab('Število priseljenih') +
  xlab('Leto') +
  labs(col = "Spol")+
  ggtitle('Število priseljenih ljudi v Slovenijo') +
  scale_x_continuous(breaks = 1*2011:2020) +
  theme(axis.text.x=element_text(vjust=0.5, hjust=0.5))

# graf 3: število priseljenih po državi:

graf3 <- skupnopriseljevanje %>%  ggplot(aes(x=Leto, y=Priseljeni_iz_tujine,col=Drzava, palette = "default")) +
  geom_point() +
  ylab('Število priseljenih') +
  xlab('Leto') +
  ggtitle('Število priseljenih ljudi v Slovenijo') +
  scale_x_continuous(breaks = 1*2011:2020) +
  theme(axis.text.x=element_text(vjust=0.5, hjust=0.5))
graf3 <- graf3 + scale_color_manual(values=cols1)

#še en graf števila priseljenih po državi, skupno leta
pris_kolac <- ggplot(tabela1, aes(x = factor(1), y = Priseljeni_iz_tujine, fill = Drzava)) +
  xlab("") + ylab("") +
  geom_bar(width = 1, stat = "identity") + ggtitle("Države, iz katerih \n prihajajo priseljenci") + theme(legend.title=element_blank(), text = element_text(size=10))

pris_kolac <- pris_kolac + coord_polar("y", start=0)
pris_kolac <- pris_kolac + scale_fill_manual(values=cols1)

#_____________________________________________________________________
#naredila graf skupaj s podatki z izseljenimi in priseljenimi, število, letno

priseljeniinizseljeni <- inner_join(tabela1, tabela2, by=NULL) %>% mutate(Selitveni_prirast=Priseljeni_iz_tujine-Odseljeni_v_tujino)
skupnopi_leta <- priseljeniinizseljeni %>% group_by(Leto) %>% summarise(Priseljeni_iz_tujine=sum(Priseljeni_iz_tujine), Odseljeni_v_tujino=sum(Odseljeni_v_tujino), Selitveni_prirast=sum(Selitveni_prirast))
skupnopi_leta <- pivot_longer(skupnopi_leta,2:4, names_to="Vrsta", values_to="Stevilo")
skupnopi_leta$Vrsta[skupnopi_leta$Vrsta == "Odseljeni_v_tujino"] <- "Izseljeni"
skupnopi_leta$Vrsta[skupnopi_leta$Vrsta == "Priseljeni_iz_tujine"] <- "Priseljeni"
skupnopi_leta$Vrsta[skupnopi_leta$Vrsta == "Selitveni_prirast"] <- "Selitveni prirast"

graf4 <- skupnopi_leta %>%  ggplot(aes(x=Leto, y=Stevilo, col=Vrsta, palette="Pastel1")) +
  geom_line() +
  geom_point()+
  ylab('Število ljudi') +
  xlab('Leto') +
  labs(col = "Legenda:")+
  ggtitle('Število priseljenih in izseljenih ljudi v Sloveniji') +
  scale_x_continuous(breaks = 1*2011:2020) +
  theme(axis.text.x=element_text(vjust=0.5, hjust=0.5))

# graf 5: število izseljenih po spolu
skupno_leta_mz2 <- tabela2 %>% group_by(Leto,Spol) %>% summarise(Stevilo_izseljenih=sum(Odseljeni_v_tujino))
graf5 <- skupno_leta_mz2 %>%  ggplot(aes(x=Leto, y=Stevilo_izseljenih, col=Spol, palette="Pastel1")) +
  geom_line() +
  ylab('Število ljudi') +
  xlab('Leto') +
  labs(col = "Spol")+
  ggtitle('Število odseljenih ljudi iz Slovenije') +
  scale_x_continuous(breaks = 1*2011:2020) +
  theme(axis.text.x=element_text(vjust=0.5, hjust=0.5))

#_______________________________________________________
#združiti priseljevanje in izseljevanje po spolu - facet grid
skupno_leta_mz_oboje <- inner_join(skupno_leta_mz,skupno_leta_mz2) %>% pivot_longer(3:4,names_to="Vrsta",values_to="Stevilo")
skupno_leta_mz_oboje$Vrsta[skupno_leta_mz_oboje$Vrsta == "Stevilo_priseljenih"] <- "Priseljeni"
skupno_leta_mz_oboje$Vrsta[skupno_leta_mz_oboje$Vrsta == "Stevilo_izseljenih"] <- "Izseljeni"
spol_graf <- ggplot(data=skupno_leta_mz_oboje, aes(x=Leto, y=Stevilo, col=Spol)) +
  geom_line() +
  ylab('Število ljudi') +
  xlab('Leto') +
  labs(col = "Spol")+
  facet_wrap(.~Vrsta) +
  ggtitle('Število priseljenih in izseljenih ljudi glede na spol') +
  scale_x_continuous(breaks = 1*2011:2020) +
  theme(axis.text.x=element_text(vjust=0.5, hjust=0.5, angle=90))

#____________________________________________________

#graf 6: število izseljenih po državi
tabelanova2 <- tabela2 %>% group_by(Leto, Drzava) %>% summarise(Odseljeni_v_tujino=sum(Odseljeni_v_tujino))
tabelanova2 <- tabelanova2 %>% rename("Država"="Drzava")
graf6 <- tabelanova2 %>%  ggplot(aes(x=Leto, y=Odseljeni_v_tujino, col=Država, palette = "default")) +
  geom_point() +
  ylab('Število izseljenih') +
  xlab('Leto') +
  ggtitle('Izseljevanje iz Slovenije') +
  scale_x_continuous(breaks = 1*2011:2020) +
  theme(axis.text.x=element_text(vjust=0.5, hjust=0.5, angle=90))
graf6 <- graf6 + scale_color_manual(values=cols1)

#še en graf števila izseljenih po državi, skupno leta
drzava_izs_kolac <- ggplot(tabela2, aes(x = factor(1), y = Odseljeni_v_tujino, fill = Drzava)) +
  xlab("") + ylab("") +
  geom_bar(width = 1, stat = "identity") + ggtitle("Države, kamor odhajajo Slovenci (2011-19)") + theme(legend.title=element_blank())
drzava_izs_kolac <- drzava_izs_kolac + coord_polar("y", start=0)
drzava_izs_kolac <- drzava_izs_kolac + scale_fill_manual(values=cols1)

# STAROST
#Starost izseljencev
starosti <- c(seq(15, 65, 5) %>% paste0(., "-", .+4), "65 +")
starost_graf1 <- ggplot(data=tabela3, aes(x=Leto, y=Stevilo_odseljenih, fill=factor(Starost, starosti))) +
  geom_bar(stat="identity") + scale_x_continuous(breaks = 1*2011:2020) + ggtitle("Starost pri izselitvi iz Slovenije") +
  xlab("Leto") + ylab("Število") + labs(fill='Starost') + theme(axis.text.x=element_text(angle=0))
#Starost priseljencev
starosti2 <- c("0-14", seq(15, 65, 5) %>% paste0(., "-", .+4), "65 +")
starost_graf2 <- ggplot(data=tabela4, aes(x=Leto, y=Stevilo_priseljenih, fill=factor(Starost, starosti2))) +
  geom_bar(stat="identity") + scale_x_continuous(breaks = 1*2011:2020) + ggtitle("Starost pri priselitvi v Slovenijo") +
  xlab("Leto") + ylab("Število") + labs(fill='Starost') + theme(axis.text.x=element_text(angle=0))

# IZOBRAZBA
tabela5nova <- tabela5 %>% rename("Drzava"="Drzava_prihodnjega_bivalisca")
tabela6nova <- tabela6 %>% rename("Stevilo_priseljenih"="Stevilo")
tabela_izobrazba <- inner_join(tabela5nova, tabela6nova, by=NULL) %>%
  pivot_longer(5:6, names_to="Vrsta", values_to="Stevilo")
tabela_izobrazba$Vrsta[tabela_izobrazba$Vrsta == "Stevilo_priseljenih"] <- "Priseljeni"
tabela_izobrazba$Vrsta[tabela_izobrazba$Vrsta == "Stevilo_odseljenih"] <- "Izseljeni"

Stopnja <- c("Osnovnošolska ali manj",	"Srednješolska","Višješolska, visokošolska")
izobrazba_graf <- ggplot(data=tabela_izobrazba, aes(x=Leto, y=Stevilo, fill=factor(Izobrazba, Stopnja))) +
  geom_bar(stat="identity") + facet_wrap(.~Vrsta) + scale_x_continuous(breaks = 1*2011:2020) + ggtitle("Izobrazba ljudi, ki so se preselili in izselili") +
  xlab("Leto") + ylab("Število") + labs(fill='Stopnja izobrazbe') + theme(axis.text.x=element_text(angle=90))

#NAMEN PRISELITVE

namen_priselitve <- ggplot(tabela7, aes(x = factor(1), y = Stevilo, fill = Namen)) + xlab("") + ylab("") +
  geom_bar(width = 1, stat = "identity") + ggtitle("Namen preselitve v Slovenijo za priseljence v letih od 2011 do 2019") + theme(legend.title=element_blank())

namen_priselitve <- namen_priselitve + coord_polar("y", start=0)

#DEJAVNOST

#Priseljeni prebivalci po dejavnosti
skupno_dejavnost <- tabela8 %>% group_by(Dejavnost) %>% summarise(Vsota=sum(Stevilo)) %>% mutate(Povprečje=round(Vsota/9,1))
skupno_dejavnost <- skupno_dejavnost %>% filter(Dejavnost %in% c("Gradbeništvo","Predelovalne dejavnosti","Promet in skladiščenje","Druge raznovrstne poslovne dejavnosti", "Trgovina, vzdrževanje in popravila motornih vozil", "Gostinstvo", "Strokovne, znanstvene in tehnične dejavnosti", "Informacijske in komunikacijske dejavnosti", "Izobraževanje", "Zdravstvo in socialno varstvo"))
dejavnost <- skupno_dejavnost %>% ggplot(aes(x=reorder(Dejavnost,-Povprečje), y=Povprečje,fill=Povprečje)) +
  geom_bar(position="dodge", stat="identity") +
  ylab('Povrečje') +
  xlab("Dejavnost")+
  ggtitle('Povprečno število priseljencev glede na dejavnost v letih 2011-19') +
  theme(text = element_text(size=8), axis.text.x=element_text(vjust=0.5, hjust=0.5, angle=90))

#Izseljeni prebivalci po dejavnosti
skupno_dejavnost2 <- tabela9 %>% group_by(Dejavnost) %>% summarise(Vsota=sum(Stevilo)) %>% mutate(Povprečje=round(Vsota/9,1))
skupno_dejavnost2 <- skupno_dejavnost2 %>% filter(Dejavnost %in% c("Gradbeništvo","Predelovalne dejavnosti","Promet in skladiščenje","Druge raznovrstne poslovne dejavnosti", "Trgovina, vzdrževanje in popravila motornih vozil", "Gostinstvo", "Strokovne, znanstvene in tehnične dejavnosti", "Informacijske in komunikacijske dejavnosti", "Izobraževanje", "Zdravstvo in socialno varstvo",
                                                                   "Dejavnosti javne uprave in obrambe, dejavnost obvezne socialne varnosti","Kmetijstvo in lov, gozdarstvo, ribištvo"))
dejavnost2 <- skupno_dejavnost2 %>% ggplot(aes(x=reorder(Dejavnost,-Povprečje), y=Povprečje,fill=Povprečje)) +
  geom_bar(position="dodge", stat="identity") +
  ylab('Povprečje') +
  xlab("Dejavnost")+
  ggtitle('Povprečno število izseljencev glede na dejavnost v letih 2011-19') +
  theme(text = element_text(size=8), axis.text.x=element_text(vjust=0.5, hjust=0.5, angle=90))

#priseljevanje po državah - povprečno število priseljenih letno v letih 2011-19
skupno_drzave <- tabela1 %>% group_by(Drzava) %>% summarise(Vsotadrzave=sum(Priseljeni_iz_tujine)) %>%
  mutate(Povprečje=round(Vsotadrzave/9,1))

drzave_priseljevanje <- skupno_drzave %>% ggplot(aes(x=reorder(Drzava,-Povprečje), y=Povprečje,fill=Povprečje)) +
  geom_bar(position="dodge", stat="identity") +
  ylab('Povrečje') +
  xlab("Država")
  ggtitle('Povprečno število priseljencev letno glede na državo iz katere prihajajo za leta 2011-19') +
  theme(text = element_text(size=5), axis.text.x=element_text(vjust=0.5, hjust=0.5, angle=90))

#izseljevanje po državah - povprečno število izseljenih letno v letih 2011-19
skupno_drzave_izseljevanje <- tabela2 %>% group_by(Drzava) %>% summarise(Vsotadrzave2=sum(Odseljeni_v_tujino)) %>%
  mutate(Povprečje=round(Vsotadrzave2/9,1))

drzave_izseljevanje <- skupno_drzave_izseljevanje %>% ggplot(aes(x=reorder(Drzava,-Povprečje), y=Povprečje,fill=Povprečje)) +
  geom_bar(position="dodge", stat="identity") +
  ylab('Povrečje') +
  xlab("Država") +
  ggtitle('Povprečno število izseljencev letno glede na državo v katero odhajajo za leta 2011-19') +
  theme(text = element_text(size=5), axis.text.x=element_text(vjust=0.5, hjust=0.5, angle=90))

#primerjava BDP in kamor se Slovenci največ izseljujejo
#zares je vizualizacija neuporabna...

izbrane <- c("Avstrija", "Nemčija", "Italija", "Švica", "Hrvaška")
BDPizbrane <- tabela10 %>%
  filter(Drzava %in% izbrane) %>% filter(between(Leto,2016,2019))
izseljevanjeizbrane <- tabela2 %>% group_by(Leto, Drzava) %>%
  summarise(Odseljeni_v_tujino=sum(Odseljeni_v_tujino)) %>%
  filter(Drzava %in% izbrane) %>% filter(between(Leto,2016,2019))
izbraneskupno <- inner_join(BDPizbrane, izseljevanjeizbrane) %>% pivot_longer(3:4, names_to="Vrsta", values_to="Stevilo")

primerjava <- izbraneskupno %>% ggplot(aes(x=Leto, y=Stevilo, col=Vrsta)) +  geom_line() +
  ylab('Stevilo') +
  xlab('Leto') +
  facet_wrap(.~Drzava,ncol=3)+
  labs(col = "Vrsta")+
  ggtitle('Primerjava') +
 theme(axis.text.x=element_text(angle=90))

#za priseljevanje podobno
#isto neuporabno...
izbrane2 <- c("Bosna in Hercegovina", "Srbija", "Kosovo", "Severna Makedonija", "Hrvaška")
BDPizbrane2 <- tabela10 %>%
  filter(Drzava %in% izbrane2) %>% filter(between(Leto,2016,2019))
priseljevanjeizbrane <- tabela1 %>% group_by(Leto, Drzava) %>%
  summarise(Priseljeni_iz_tujine=sum(Priseljeni_iz_tujine)) %>%
  filter(Drzava %in% izbrane2) %>% filter(between(Leto,2016,2019))
izbraneskupno2 <- inner_join(BDPizbrane2, priseljevanjeizbrane) %>% pivot_longer(3:4, names_to="Vrsta", values_to="Stevilo")

primerjava2 <- izbraneskupno2 %>% ggplot(aes(x=Leto, y=Stevilo, col=Vrsta)) +  geom_line() +
  ylab('Stevilo') +
  xlab('Leto') +
  facet_wrap(.~Drzava,ncol=3)+
  labs(col = "Vrsta")+
  ggtitle('Primerjava') +
  theme(axis.text.x=element_text(angle=90))

#ZEMLJEVIDI---------------------------------------------------------------------------

#povprečne priselitve v državi za leta 2011-19 na 100k - ZEMLJEVID

evropa_priseljevanje_leta <- tabela11 %>% group_by(Leto, Drzava) %>% summarise(Priseljeni=sum(Stevilo))
prebpriseljevanje <- inner_join(evropa_priseljevanje_leta,tabela15)
novo <- prebpriseljevanje %>% mutate(Sprem=(100000/Prebivalstvo)) %>% mutate(Stevilo_pris_na100k = round(Sprem * Priseljeni,0))
povprecje2 <- novo %>% group_by(Drzava) %>% summarise(Povprečje=mean(Stevilo_pris_na100k)) %>% mutate(Povprečje=round(Povprečje,0))

zemljevid1 <- tm_shape(merge(zemljevid,
                            povprecje2,duplicateGeoms = TRUE,
                             by.x="SOVEREIGNT", by.y="Drzava"), xlim=c(-20,32), ylim=c(32,72)) +
  tm_polygons("Povprečje", title = "Povp št. priseljenih ljudi na 100k", breaks=c(0,500,800,1000,1500,2000,3000,4000,5000)) +
  tm_layout(bg.color = "skyblue") +
  tm_layout(main.title = "Povprečno št. priseljenih ljudi \n v državo 2011-19 na 100k", main.title.size = 1, legend.title.size = 1)

#________________________________________________________________________
# histogram povprečnega priseljevanja na 100.000 prebivalcev

povprecjepravapris <- povprecje2 %>% mutate(Drzava=slovar[Drzava]) %>% subset(Drzava!="Bolgarija")
eu_priseljevanje <- povprecjepravapris %>% ggplot(aes(x=reorder(Drzava,-Povprečje), y=Povprečje,fill=Povprečje)) +
  geom_bar(position="dodge", stat="identity") +
  xlab("Država")+
  ylab('Povrečje') +
  ggtitle('Povprečno število priseljencev na 100.000 prebivalcev 2011-19') +
  theme(text = element_text(size=5), axis.text.x=element_text(vjust=0.5, hjust=0.5, angle=90))

#povprečne izselitve v državi v letih 2011-19 na 100k - ZEMLJEVID
evropa_izseljevanje_leta <- tabela12 %>% group_by(Leto, Drzava) %>% summarise(Izseljeni=sum(Stevilo)) %>% filter(between(Leto,2011,2018))
prebizseljevanje <- inner_join(evropa_izseljevanje_leta,tabela15)
novo2 <- prebizseljevanje %>% mutate(Sprem=(100000/Prebivalstvo)) %>% mutate(Stevilo_izs_na100k = round(Sprem * Izseljeni,0))
povprecje3 <- novo2 %>% group_by(Drzava) %>% summarise(Povprečje=mean(Stevilo_izs_na100k)) %>% mutate(Povprečje=round(Povprečje,0))

zemljevid2 <- tm_shape(merge(zemljevid,
                             povprecje3,duplicateGeoms = TRUE,
                             by.x="SOVEREIGNT", by.y="Drzava"), xlim=c(-25,32), ylim=c(32,72)) +
  tm_polygons("Povprečje", title = "Povpr. št. izseljenih na 100k", breaks=c(0,250,500,750,1000,1500,2000,2500)) +
  tm_layout(bg.color = "skyblue") +
  tm_layout(main.title = "Povprečno števolo izseljenih \n ljudi v državo 2011-19 na 100k", main.title.size = 1, legend.title.size = 1)

#________________________________________________________________________
# histogram povprečnega izseljevanja na 100.000 prebivalcev

povprecjeprava <- povprecje3 %>% mutate(Drzava=slovar[Drzava]) %>% subset(Drzava!="Bolgarija")
eu_izseljevanje <- povprecjeprava %>% ggplot(aes(x=reorder(Drzava,-Povprečje), y=Povprečje,fill=Povprečje)) +
  geom_bar(position="dodge", stat="identity") +
  xlab("Država")+
  ylab('Povrečje') +
  ggtitle('Povprečno število izseljencev na 100.000 prebivalcev 2011-19') +
  theme(text = element_text(size=5), axis.text.x=element_text(vjust=0.5, hjust=0.5, angle=90))

#___________________________________________________________________________________
#zemljevid izseljevanja iz slovenskih regij
slovenija_izseljevanje_leta <- tabela13 %>% group_by(Leto, Regija) %>% summarise(Izseljeni=sum(Stevilo_odseljenih_v_tujino))
regijeizseljevanje <- inner_join(slovenija_izseljevanje_leta,tabela16)
zdruzeno <- regijeizseljevanje %>% mutate(Sprem=(10000/Prebivalstvo)) %>% mutate(Stevilo_izs_na10000 = round(Sprem * Izseljeni,0))
povprecje_sloi <- zdruzeno %>% group_by(Regija) %>% summarise(Povprečje=mean(Stevilo_izs_na10000)) %>% mutate(Povprečje=round(Povprečje,0))

Slovenija <- uvozi.zemljevid("http://baza.fmf.uni-lj.si/SVN_adm_shp.zip",
                             "SVN_adm1", encoding = "UTF-8")

Slovenija$NAME_1[Slovenija$NAME_1 == "GoriĹˇka"] <- "Goriška"
Slovenija$NAME_1[Slovenija$NAME_1 == "KoroĹˇka"] <- "Koroška"
Slovenija$NAME_1[Slovenija$NAME_1 == "Notranjsko-kraĹˇka"] <- "Notranjsko-kraška"
Slovenija$NAME_1[Slovenija$NAME_1 == "Obalno-kraĹˇka"] <- "Obalno-kraška"

Slovenija$NAME_1 <- Slovenija$NAME_1 %>%
  str_replace("Spodnjeposavska", "Posavska") %>%
  str_replace("Notranjsko-kraška", "Primorsko-notranjska")

zemljevid_slo1 <- tm_shape(merge(Slovenija, povprecje_sloi, by.x="NAME_1", by.y="Regija")) +
  tm_polygons("Povprečje",palette="Purples")+
  tm_style("grey") +
  tm_layout(main.title="Povprečno število izseljenih ljudi na \n 10.000 prebivalcev", legend.position = c(0.75,0.1)) + tm_text(text='NAME_1', size=0.6)

#zemljevid povprečnega priseljevanja v slovenske regije na 10.000 prebivalcev
slovenija_priseljevanje_leta <- tabela14 %>% group_by(Leto, Regija) %>% summarise(Priseljeni=sum(Stevilo_priseljenih_iz_tujine))
regijepriseljevanje <- inner_join(slovenija_priseljevanje_leta,tabela16)
zdruzeno2 <- regijepriseljevanje %>% mutate(Sprem=(10000/Prebivalstvo)) %>% mutate(Stevilo_pris_na10000 = round(Sprem * Priseljeni,0))
povprecje_slop <- zdruzeno2 %>% group_by(Regija) %>% summarise(Povprečje=mean(Stevilo_pris_na10000)) %>% mutate(Povprečje=round(Povprečje,0))

zemljevid_slo2 <- tm_shape(merge(Slovenija, povprecje_slop, by.x="NAME_1", by.y="Regija")) +
  tm_polygons("Povprečje",palette="Greens")+
  tm_style("grey") +
  tm_layout(main.title="Povprečno število priseljenih ljudi \n na 10.000 prebivalcev", legend.position = c(0.75,0.1)) + tm_text(text='NAME_1', size=0.6)

#________________________________________

#Opcijsko:
#5. Zemljevid iz kje se največ preseljujejo v Slovenijo - glede na tabeli 1/2 (2 zemljevida...)

#62. video glej geom text, kako dodati text na graf za nek graf


############################################
# R - script to collect all moobench results
############################################

# these values are here only as documentation. The parameters are set by benchmark.sh
#rm(list=ls(all=TRUE))
#data_fn="data/"
#folder_fn="results-benchmark-binary"
#results_fn=paste(data_fn,folder_fn,"/raw",sep="")
#outtxt_fn=paste(data_fn,folder_fn,"/results-text.txt",sep="")
#results_fn="raw"
#outtxt_fn="results-text.txt"

#########
# These are configuration parameters which are automatically prepended to this file by the benchmark.sh script.
# Therefore, they must not be set here. The following lines only serve as documentation.
#configs.loop=10
#configs.recursion=c(10)
#configs.labels=c("No Probe","Inactive Probe","Collecting Data","Writing Data (ASCII)", "Writing Data (Bin)")
#results.count=2000000
#results.skip=1000000

#bars.minval=500
#bars.maxval=600

##########
# Process configuration

# divisor 1 = nano, 1000 = micro, 1000000 = milli seconds
timeUnit <- 1000

# number of Kieker writer configurations
numberOfWriters <- length(configs.labels)
recursion_depth <- configs.recursion

numberOfValues <- configs.loop*(results.count-results.skip)
numbers <- c(1:(numberOfValues))
resultDimensionNames <- list(configs.labels, numbers)

# result values
resultsBIG <- array(dim=c(numberOfWriters, numberOfValues), dimnames=resultDimensionNames)

##########
# Create result

## "[ recursion , config , loop ]"

numOfRowsToRead <- results.count-results.skip

for (writer_idx in (1:numberOfWriters)) {
   recordsPerSecond = c()
   rpsLastDuration = 0
   rpsCount = 0
   file_idx <- writer_idx - 1

   # loop
   for (loop_counter in (1:configs.loop)) {
      results_fn_filepath <- paste(results_fn, "-", loop_counter, "-", recursion_depth, "-", file_idx, ".csv", sep="")
      message(results_fn_filepath)
      results <- read.csv2(results_fn_filepath, nrows=numOfRowsToRead, skip=results.skip, quote="", colClasses=c("NULL","numeric", "numeric", "numeric"), comment.char="", col.names=c("thread_id", "duration_nsec", "gc", "t"), header=FALSE)
      trx_idx <- c(1:numOfRowsToRead)
      resultsBIG[writer_idx,trx_idx] <- results[["duration_nsec"]]
   }
}

qnorm_value <- qnorm(0.975)

# print results
printDimensionNames <- list(c("mean","ci95%","md25%","md50%","md75%","max","min"), c(1:numberOfWriters))
# row number == number of computed result values, e.g., mean, min, max
printvalues <- matrix(nrow=7, ncol=numberOfWriters, dimnames=printDimensionNames)

for (writer_idx in (1:numberOfWriters)) {
   idx_mult <- c(1:numOfRowsToRead)

   valuesBIG <- resultsBIG[writer_idx,idx_mult]/timeUnit

   printvalues["mean",writer_idx] <- mean(valuesBIG)
   printvalues["ci95%",writer_idx] <- qnorm_value*sd(valuesBIG)/sqrt(length(valuesBIG))
   printvalues[c("md25%","md50%","md75%"),writer_idx] <- quantile(valuesBIG, probs=c(0.25, 0.5, 0.75))
   printvalues["max",writer_idx] <- max(valuesBIG)
   printvalues["min",writer_idx] <- min(valuesBIG)
}
resultstext <- formatC(printvalues,format="f",digits=4,width=8)

print(resultstext)

write(paste("Recursion Depth: ", recursion_depth),file=outtxt_fn,append=TRUE)
write("response time",file=outtxt_fn,append=TRUE)
write.table(resultstext,file=outtxt_fn,append=TRUE,quote=FALSE,sep="\t",col.names=FALSE)

concResult <- ""
headResult <- ""
# write the first n-1 elements preceded by a comma (,)
for (writer_idx in (1:(numberOfWriters-1))) {
   headResult <- paste(headResult, configs.labels[writer_idx], ",")
   concResult <- paste(concResult, printvalues["mean",writer_idx], ",")
}
# write the last without a comma
headResult <- paste(headResult, configs.labels[numberOfWriters])
concResult <- paste(concResult, printvalues["mean", numberOfWriters])

write(headResult,file=outcsv_fn,append=TRUE)
write(concResult,file=outcsv_fn,append=TRUE)

# end


library(readr)
numlines_data <- read_table2("linespercell.txt",
                            col_names = FALSE)
numlines <- numlines_data$X1
numreads <- numlines/4
avg <- mean(as.numeric(numreads))
stdev <- sd(numreads)
numreads_data <- data.frame(numreads, avg, stdev)
colnames(numreads_data) <- c("reads", "avg", "stdev")

library(ggplot2)
# Basic violin plot
p <- ggplot(numreads_data, aes(x="Cells", y=reads)) +
  geom_violin()
p + geom_jitter(shape=16, position=position_jitter(0.2))

ggsave("reads_violin.pdf", width=5, height=5)

# Basic violin plot
numreads_data["log_reads"] <- log(numreads_data$reads)
p <- ggplot(numreads_data, aes(x="Cells", y=log_reads)) +
  geom_violin()
p + geom_jitter(shape=16, position=position_jitter(0.2))

ggsave("log_reads_violin.pdf", width=5, height=5)


library('igraph')

NFDI_edges <- read.table(header=TRUE,
                         sep=",",
                         text="
from,to
BERD@NFDI,KonsortSWD
BERD@NFDI,MaRDI
BERD@NFDI,NFDI4Memory
BERD@NFDI,Text+
DAPHNE4NFDI,FAIRmat
DAPHNE4NFDI,NFDI-MatWerk
DAPHNE4NFDI,NFDI4Cat
DAPHNE4NFDI,NFDI4Chem
DAPHNE4NFDI,NFDI4Health
DAPHNE4NFDI,NFDI4Ing
DAPHNE4NFDI,NFDI4Objects
DAPHNE4NFDI,PUNCH4NFDI
FAIRmat,DAPHNE4NFDI
FAIRmat,DataPLANT
FAIRmat,MaRDI
FAIRmat,NFDI-MatWerk
FAIRmat,NFDI4Cat
FAIRmat,NFDI4Chem
FAIRmat,NFDI4DataScience
FAIRmat,NFDI4Ing
FAIRmat,NFDIxCS
FAIRmat,PUNCH4NFDI
MaRDI,BERD@NFDI
MaRDI,FAIRmat
MaRDI,NFDI-MatWerk
MaRDI,NFDI-Neuro
MaRDI,NFDI4Cat
MaRDI,NFDI4Chem
MaRDI,NFDI4Ing
MaRDI,PUNCH4NFDI
NFDI-MatWerk,DAPHNE4NFDI
NFDI-MatWerk,DataPLANT
NFDI-MatWerk,FAIRmat
NFDI-MatWerk,MaRDI
NFDI-MatWerk,NFDI4Chem
NFDI-MatWerk,NFDI4DataScience
NFDI-MatWerk,NFDI4Ing
NFDI-MatWerk,NFDIxCS
NFDI-Neuro,DataPLANT
NFDI-Neuro,GHGA
NFDI-Neuro,NFDI4BioDiversity
NFDI-Neuro,NFDI4Culture
NFDI-Neuro,NFDI4Earth
NFDI-Neuro,NFDI4Health
NFDI-Neuro,NFDI4Ing
NFDI-Neuro,NFDI4Microbiota
NFDI4Agri,DataPLANT
NFDI4Agri,KonsortSWD
NFDI4Agri,NFDI4BioDiversity
NFDI4Agri,NFDI4Earth
NFDI4Agri,NFDI4Health
NFDI4Agri,NFDI4Immuno
NFDI4Agri,NFDI4Microbiota
NFDI4DataScience,KonsortSWD
NFDI4DataScience,MaRDI
NFDI4DataScience,NFDI-MatWerk
NFDI4DataScience,NFDI4BioDiversity
NFDI4DataScience,NFDI4Cat
NFDI4DataScience,NFDI4Chem
NFDI4DataScience,NFDI4Culture
NFDI4DataScience,NFDI4Health
NFDI4DataScience,NFDI4Ing
NFDI4DataScience,NFDI4Microbiota
NFDI4DataScience,NFDIxCS
NFDI4Earth,DataPLANT
NFDI4Earth,GHGA
NFDI4Earth,KonsortSWD
NFDI4Earth,NFDI4Agri
NFDI4Earth,NFDI4BioDiversity
NFDI4Earth,NFDI4Cat
NFDI4Earth,NFDI4Chem
NFDI4Earth,NFDI4Culture
NFDI4Earth,NFDI4Health
NFDI4Earth,NFDI4Ing
NFDI4Earth,NFDI4Objects
NFDI4Immuno,GHGA
NFDI4Immuno,NFDI4Agri
NFDI4Immuno,NFDI4Health
NFDI4Immuno,NFDI4Microbiota
NFDI4Memory,BERD@NFDI
NFDI4Memory,KonsortSWD
NFDI4Memory,MaRDI
NFDI4Memory,NFDI4Culture
NFDI4Memory,NFDI4Objects
NFDI4Memory,Text+
NFDI4Microbiota,DataPLANT
NFDI4Microbiota,GHGA
NFDI4Microbiota,NFDI4Agri
NFDI4Microbiota,NFDI4BioDiversity
NFDI4Microbiota,NFDI4Chem
NFDI4Microbiota,NFDI4DataScience
NFDI4Microbiota,NFDI4Health
NFDI4Microbiota,NFDI4Immuno
NFDI4Microbiota,NFDI4Ing
NFDI4Objects,KonsortSWD
NFDI4Objects,NFDI4Agri
NFDI4Objects,NFDI4BioDiversity
NFDI4Objects,NFDI4Culture
NFDI4Objects,NFDI4Earth
NFDI4Objects,NFDI4Memory
NFDI4Objects,Text+
NFDI4SD,NFDI4Culture
NFDI4SD,NFDI4DataScience
NFDI4SD,NFDI4Memory
NFDI4SD,NFDI4Objects
NFDIxCS,FAIRmat
NFDIxCS,MaRDI
NFDIxCS,NFDI4Chem
NFDIxCS,NFDI4DataScience
NFDIxCS,NFDI4Earth
NFDIxCS,NFDI4Ing
PUNCH4NFDI,DAPHNE4NFDI
PUNCH4NFDI,FAIRmat
PUNCH4NFDI,GHGA
PUNCH4NFDI,MaRDI
PUNCH4NFDI,NFDI4Earth
PUNCH4NFDI,NFDI4Ing
PUNCH4NFDI,NFDIxCS
Text+,KonsortSWD
Text+,NFDI4BioDiversity
Text+,NFDI4Culture
Text+,NFDI4Earth
Text+,NFDI4Ing
Text+,NFDI4Memory
Text+,NFDI4Objects
")

NFDI_network <- graph_from_data_frame(NFDI_edges,
                                      directed=FALSE
                                     )

set.seed(1234)

plot(NFDI_network,                    # loading data frame
     main  = "NFDI-Netzwerk",         # adding a title
     frame = TRUE                     # making a frame
     )

set.seed(1234)

plot(NFDI_network,                     # loading data frame
     main   = "NFDI-Netzwerk",         # adding a title
     frame  = TRUE,                    # making a frame
     layout = layout.graphopt,         #* better layout options
     )

set.seed(1234)

plot(NFDI_network,                     # loading data frame
     main   = "NFDI-Netzwerk",         # adding a title
     frame  = TRUE,                    # making a frame
     layout = layout.graphopt,         # better layout options
     vertex.color       = "#ffcc66",   #* color of nodes
     vertex.frame.color = "#ffcc66",   #* color of the frame of nodes
     vertex.label.cex   = 0.5,         #* size of the description of the labels
     vertex.label.color = "black",     #* color of the description
     edge.color         = "#808080",   #* color of edges
     edge.curved        = 0.1,         #* factor of "curvity"
     )

degree(NFDI_network)                   #* calculate number of edges

set.seed(1234)

plot(NFDI_network,                     # loading data frame
     main   = "NFDI-Netzwerk",         # adding a title
     frame  = TRUE,                    # making a frame
     layout = layout.graphopt,         # better layout options
     vertex.color       = "#ffcc66",   # color of nodes
     vertex.frame.color = "#ffcc66",   # color of the frame of nodes
     vertex.label.cex   = 0.5,         # size of the description of the labels
     vertex.label.color = "black",     # color of the description
                                       # color: https://www.w3schools.com/colors/colors_picker.asp
     edge.color         = "#808080",   # color of edges
     edge.curved        = 0.1,         # factor of "curvity"
     vertex.size        = degree(NFDI_network), #* size of nodes depends on amount of edges
     )

NFDI_network_directed <- graph_from_data_frame(NFDI_edges,
                                          directed = TRUE
                                         )

set.seed(1234)

plot(NFDI_network_directed,            #<<<<<<< loading data frame
     main   = "NFDI-Netzwerk",         # adding a title
     frame  = TRUE,                    # making a frame
     layout = layout.graphopt,         # better layout options
     vertex.color       = "#ffcc66",   # color of nodes
     vertex.frame.color = "#ffcc66",   # color of the frame of nodes
     vertex.label.cex   = 0.5,         # size of the description of the labels
     vertex.label.color = "black",     # color of the description
                                       # color: https://www.w3schools.com/colors/colors_picker.asp
     edge.color         = "#808080",   # color of edges
     edge.curved        = 0,           #<<<<<<<<< factor of "curvity"
     vertex.size        = degree(NFDI_network_directed), #<<<<<< size of nodes depends on amount of edges
     edge.arrow.size    = .5,          #* arrow size,  defaults to 1
    )

degree(NFDI_network_directed,
       mode = "in")

set.seed(1234)

plot(NFDI_network_directed,            # loading data frame
     main   = "NFDI-Netzwerk (<in>)",  #<<<<<<<< adding a title
     frame  = TRUE,                    # making a frame
     layout = layout.graphopt,         # better layout options
     vertex.color       = "#ffcc66",   # color of nodes
     vertex.frame.color = "#ffcc66",   # color of the frame of nodes
     vertex.label.cex   = 0.5,         # size of the description of the labels
     vertex.label.color = "black",     # color of the description
                                       # color: https://www.w3schools.com/colors/colors_picker.asp
     edge.color         = "#808080",   # color of edges
     edge.curved        = 0,           # factor of "curvity"
     vertex.size        = degree(NFDI_network_directed,
                                 mode = "in"), #<<<<<< size of nodes depends on amount of edges
     edge.arrow.size    = .5,          # arrow size,  defaults to 1
    )

degree(NFDI_network_directed,
       mode = "out")

set.seed(1234)

plot(NFDI_network_directed,            # loading data frame
     main   = "NFDI-Netzwerk (<out>)",  #<<<<<<<< adding a title
     frame  = TRUE,                    # making a frame
     layout = layout.graphopt,         # better layout options
     vertex.color       = "#ffcc66",   # color of nodes
     vertex.frame.color = "#ffcc66",   # color of the frame of nodes
     vertex.label.cex   = 0.5,         # size of the description of the labels
     vertex.label.color = "black",     # color of the description
                                       # color: https://www.w3schools.com/colors/colors_picker.asp
     edge.color         = "#808080",   # color of edges
     edge.curved        = 0,           # factor of "curvity"
     vertex.size        = degree(NFDI_network_directed,
                                 mode = "out"), #<<<<<< size of nodes depends on amount of edges
     edge.arrow.size    = .5,          # arrow size,  defaults to 1
    )

NFDI_network_directed_filter <- delete_vertices(NFDI_network_directed,
            V(NFDI_network_directed)[ degree(NFDI_network_directed, mode = "out") == 0 ])

degree(NFDI_network_directed_filter,
       mode = "total")

set.seed(1234)

plot(NFDI_network_directed_filter,           #<<<<<<<< loading data frame
     main   = "NFDI-Netzwerk (<filtered>)",  #<<<<<<<< adding a title
     frame  = TRUE,                    # making a frame
     layout = layout.graphopt,         # better layout options
     vertex.color       = "#ffcc66",   # color of nodes
     vertex.frame.color = "#ffcc66",   # color of the frame of nodes
     vertex.label.cex   = 0.5,         # size of the description of the labels
     vertex.label.color = "black",     # color of the description
                                       # color: https://www.w3schools.com/colors/colors_picker.asp
     edge.color         = "#808080",   # color of edges
     edge.curved        = 0,           # factor of "curvity"
     vertex.size        = degree(NFDI_network_directed_filter,
                                 mode = "total"), #<<<<<< size of nodes depends on amount of edges
     edge.arrow.size    = .5,          # arrow size,  defaults to 1
    )

NFDI_nodes <- read.table(header=TRUE,
                         sep=",",
                         text="
name,group
BERD@NFDI,3
DAPHNE4NFDI,5
DataPLANT,2
FAIRmat,5
GHGA,1
KonsortSWD,3
MaRDI,4
NFDI-MatWerk,4
NFDI-Neuro,1
NFDI4Agri,2
NFDI4BioDiversity,2
NFDI4Cat,5
NFDI4Chem,5
NFDI4Culture,3
NFDI4DataScience,4
NFDI4Earth,2
NFDI4Health,1
NFDI4Immuno,1
NFDI4Ing,4
NFDI4Memory,3
NFDI4Microbiota,2
NFDI4Objects,3
NFDI4SD,3
NFDIxCS,4
PUNCH4NFDI,5
Text+,3
")

NFDI_network_directed <- graph_from_data_frame(d = NFDI_edges,        # d = data frame =~ edges
                                               vertices = NFDI_nodes, #nodes
                                               directed = TRUE)       #directed

NFDI_color_code <- c("#f5ac9f", # Medizin
                     "#e43516", # Lebenswissenschaften
                     "#f9b900", # Geisteswissenschaften
                     "#007aaf", # Ingenieurwissenschaften
                     "#6ca11d"  # Chemie/Physik
                    )
NFDI_color_groups <- NFDI_color_code[as.numeric(as.factor(V(NFDI_network_directed)$group))]

set.seed(1234)

plot(NFDI_network_directed,            # loading data frame
     main   = "NFDI-Netzwerk (<Konferenzsystematik>)",  #<<<<<<<< adding a title
     frame  = TRUE,                    # making a frame
     layout = layout.graphopt,         # better layout options
     vertex.color       = NFDI_color_groups,   #<<<<<<<<<<  color of nodes
     vertex.frame.color = NFDI_color_groups,   #<<<<<<<<<< color of the frame of nodes
     vertex.label.cex   = 0.5,         # size of the description of the labels
     vertex.label.color = "black",     # color of the description
                                       # color: https://www.w3schools.com/colors/colors_picker.asp
     edge.color         = "#808080",   # color of edges
     edge.curved        = 0,           # factor of "curvity"
     vertex.size        = degree(NFDI_network_directed,
                                 mode = "total"), #<<<<<<<<<<< size of nodes depends on amount of edges
     edge.arrow.size    = .5,          # arrow size,  defaults to 1
    )

legend("bottomright",   # x-position
       title  = "NFDI-Konferenzsystematik", # title
       legend = c(
           "(1) Medizin",
           "(2) Lebenswissenschaften",
           "(3) Geisteswissenschaften",
           "(4) Ingenieurwissenschaften",
           "(5) Chemie/Physik"
       ),  # the text of the legend
       col    = NFDI_color_code ,  # colors of lines and points beside the legend text
       pch    = 20,     # the plotting symbols appearing in the legend
       bty    = "n",    # no frame, the type of box to be drawn around the legend (n=no frame)
       cex    = .75,    # character expansion factor relative to current par("cex").
       pt.cex = 2       # expansion factor(s) for the points
)

set.seed(1234)

NFDI_network_directed_cluster <- cluster_optimal(NFDI_network_directed)

plot(NFDI_network_directed_cluster,    #<<<<<<<<<<< clustered network data
     NFDI_network_directed,            # loading data frame
     main   = "NFDI-Netzwerk (<Konferenzsystematik>)",  # adding a title
     frame  = TRUE,                    # making a frame
     layout = layout.graphopt,         # better layout options
     #vertex.color       = NFDI_color_groups,   #<<<<<<<<<<  color of nodes
     vertex.frame.color = NFDI_color_groups,   #<<<<<<<<<< color of the frame of nodes
     vertex.label.cex   = 0.5,         # size of the description of the labels
     vertex.label.color = "black",     # color of the description
                                       # color: https://www.w3schools.com/colors/colors_picker.asp
     edge.color         = NA,          #<<<<<<<<<<<<<< color of edges
     edge.curved        = 0,           # factor of "curvity"
     vertex.size        = degree(NFDI_network_directed,
                                 mode = "total"), #<<<<<<<<<<< size of nodes depends on amount of edges
     edge.arrow.size    = .5,          # arrow size,  defaults to 1
     col    = NFDI_color_groups,       #<<<<<<<<<<<<<  color of nodes
     mark.col           = "grey",      #<<<<<<<<<< color groups
     mark.border        = NA,          #<<<<<<<<<< no border color
    )

legend("bottomright",   # x-position
       title  = "NFDI-Konferenzsystematik", # title
       legend = c(
           "(1) Medizin",
           "(2) Lebenswissenschaften",
           "(3) Geisteswissenschaften",
           "(4) Ingenieurwissenschaften",
           "(5) Chemie/Physik"
       ),  # the text of the legend
       col    = NFDI_color_code ,  # colors of lines and points beside the legend text
       pch    = 20,     # the plotting symbols appearing in the legend
       bty    = "n",    # no frame, the type of box to be drawn around the legend (n=no frame)
       cex    = .75,    # character expansion factor relative to current par("cex").
       pt.cex = 2       # expansion factor(s) for the points
)

set.seed(1234)

plot(NFDI_network_directed_cluster,    # clustered network data
     NFDI_network_directed,            # loading data frame
     main   = "NFDI-Netzwerk (<Konferenzsystematik>)",  # adding a title
     frame  = TRUE,                    # making a frame
     layout = layout.graphopt,         # better layout options
     vertex.frame.color = NFDI_color_groups,   # color of the frame of nodes
     vertex.label.cex   = 0.5,         # size of the description of the labels
     vertex.label.color = "black",     # color of the description
                                       # color: https://www.w3schools.com/colors/colors_picker.asp
     edge.color = c(NA, "#bf4040")[crossing(NFDI_network_directed_cluster, NFDI_network_directed) + 1],
                                       #<<<<<<<<<<<<<<<<< show only edges if they go to another group
     edge.curved        = 0,           # factor of "curvity"
     vertex.size        = degree(NFDI_network_directed,
                                 mode = "total"), #<<<<<<<<<<< size of nodes depends on amount of edges
     edge.arrow.size    = .5,          # arrow size,  defaults to 1
     col    = NFDI_color_groups,       #  color of nodes
     mark.col           = "grey",      # color groups
     mark.border        = NA,          # no border color
    )

legend("bottomright",   # x-position
       title  = "NFDI-Konferenzsystematik", # title
       legend = c(
           "(1) Medizin",
           "(2) Lebenswissenschaften",
           "(3) Geisteswissenschaften",
           "(4) Ingenieurwissenschaften",
           "(5) Chemie/Physik"
       ),  # the text of the legend
       col    = NFDI_color_code ,  # colors of lines and points beside the legend text
       pch    = 20,     # the plotting symbols appearing in the legend
       bty    = "n",    # no frame, the type of box to be drawn around the legend (n=no frame)
       cex    = .75,    # character expansion factor relative to current par("cex").
       pt.cex = 2       # expansion factor(s) for the points
)


Pairs.Explore<-function(num.plots=5,min.cor=.7,input.file,output.file,response.col="ResponseBinary",cors.w.highest=FALSE,pres=TRUE,absn=TRUE,bgd=TRUE,Debug=FALSE){

      #num.plots=plots per page of display
      #min.cor=the minimum correlation to be included in determining which set of predictors to display
      #input.file=a csv assumed to have the new vistrails form with the first several rows specifiying where to find tiffs
      #   and which columns to include in analysis
      #output.file=...
      #response.col=name of response column to be removed and used elsewhere
    #modifications
      #5/10/2011 altered to handle count data as well presence absence.
      #any counts higher than or equal to 1 are set to be presence though I might consider
      #adding the option to have a threshold set instead of using just presence/absence

      absn<-as.logical(absn)
      pres<-as.logical(pres)
      bgd<-as.logical(bgd)
      cors.w.highest<-as.logical(cors.w.highest)

   #Read input data and remove any columns to be excluded
    dat<-read.csv(input.file,skip=3,header=FALSE)

          hl<-readLines(input.file,1)
          hl=strsplit(hl,',')
          colnames(dat) = hl[[1]]

          tif.info<-readLines(input.file,3)
          tif.info<-strsplit(tif.info,',')
          include<-(as.numeric(tif.info[[2]]))

  #Remove coordinates, response column, site.weights
  #before exploring predictor relationship
    rm.cols <- as.vector(na.omit(c(match("x",tolower(names(dat))),match("y",tolower(names(dat))),
    match("site.weights",tolower(names(dat))),match(tolower(response.col),tolower(names(dat))),match("Split",names(dat)))))

     #remove testing split
    if(!is.na(match("Split",names(dat)))) dat<-dat[-c(which(dat$Split=="test"),arr.ind=TRUE),]

    include[is.na(include)]<-0
    rm.cols<-unique(c(rm.cols,which(include==0,arr.ind=TRUE)))
    response<-dat[,match(tolower(response.col),tolower(names(dat)))]

       dat<-dat[order(response),]
       response<-response[order(response)]

       #for the purpose of the pairs plot, taking all counts greater than 1 and setting them equal to presence
       #this is never exported
      if(response.col=="responseCount") {response[response>=1]<-1
      }

    #remove any of pres absn or bgd that aren't desired
     temp<-c(0,1,-9999)
     temp<-temp[c(absn,pres,bgd)]
     dat<-dat[response%in%temp,]
     response<-response[response%in%temp]

     if(sum(response==-9999)>1000){
      s<-sample(which(response==-9999,arr.ind=TRUE),size=(sum(response==-9999)-1000))
      dat<-dat[-c(s),]
      response<-response[-c(s)]
    }

   if (response.col=="responseCount") {
    TrueResponse<-dat[,match(tolower(response.col),tolower(names(dat)))]
    } else TrueResponse<-response

    #now remove all columns except predictors
    dat<-dat[-rm.cols]
     dat[dat==-9999]<-NA
      response<-response[complete.cases(dat)]
      TrueResponse<-TrueResponse[complete.cases(dat)]
     dat<-dat[complete.cases(dat),]

    #dat<-dat[1:2000,]
  #Remove columns with only one unique value
      varr <- function(x) var(x,na.rm=TRUE)

    dat<-try(dat[,as.vector(apply(dat,2,varr)==0)!=1],silent=TRUE)
    if(class(dat)=="try-error") stop("mds file contains nonnumeric columns please remove and continue")
  #record correlations for later plots

    cmat<-cor(dat,use="pairwise.complete.obs")
    smat<-cor(dat,method="spearman",use="pairwise.complete.obs")
    if(dim(dat)[1]<2000){
    kmat<-cor(dat,method="kendall",use="pairwise.complete.obs")}
    else {s<-sample(seq(1:dim(dat)[1]),size=2000,replace=FALSE)
     kmat<-cor(dat[s,],method="kendall",use="pairwise.complete.obs")
    }

    cmat=pmax(abs(cmat),abs(smat),abs(kmat),na.rm=TRUE)

    High.cor<-sort(apply(abs(cmat)>min.cor,2,sum)-1,decreasing=TRUE)

  #take the top num.plots to put in the pairs plot or if the looking at a single
  #predictor and other predictors it's correlated with, take the top num.plots-1
  #of those with which it is correlated
    {if(cors.w.highest==FALSE){
    HighToPlot<-dat[,match(names(High.cor),names(dat))[1:min(num.plots,length(High.cor))]]
      }else{
          #take the column of the correlation matrix corresponding to the
          #predictor with the higest number of total correlations record the names
          #of the predictors that are correlated with this one predictor
          temp<-cmat[rownames(cmat)==names(High.cor[1]),]
          CorWHigh<-temp[abs(cmat[,colnames(cmat)==names(High.cor[1])])>min.cor]

          #record counts of total number of correlations with all predictors for those
          #predictors that are highly correlated with the Highest predictor
          High.cor<-sort(High.cor[names(CorWHigh)],decreasing=TRUE)
          HighToPlot<-dat[,match(names(High.cor),names(dat))[1:min(num.plots,length(High.cor))]]
          }}
              cor.hightoplot<-abs(cor(HighToPlot,use="pairwise.complete.obs"))
              diag(cor.hightoplot)<-0
    cor.range<-c(quantile(as.vector(cor.hightoplot),probs=c(0,.5,.7,.85)),1)

  ## put histograms on the diagonal
    panel.hist <- function(x, ...)
    {
        usr <- par("usr"); on.exit(par(usr))
        par(usr = c(usr[1:2], 0, 1.5) )
        h <- hist(x, plot = FALSE)
        breaks <- h$breaks; nB <- length(breaks)
        y <- h$counts; y <- y/max(y)
        rect(breaks[-nB], 0, breaks[-1], y, col="steelblue", ...)

    }

  ## put (absolute) correlations on the upper panels,
  ## with size proportional to the correlations.
      panel.cor <- function(x, y, digits=2, prefix="", cor.range,cex.cor, ...)
      {
      a<-colors()
          usr <- par("usr"); on.exit(par(usr))
          par(usr = c(0, 1, 0, 1))
          r <- abs(cor(x, y,use="pairwise.complete.obs"))
          spear<-abs(cor(x,y,method="spearman",use="pairwise.complete.obs"))
          ken<- abs(cor(x,y,method="kendall",use="pairwise.complete.obs"))
          all.cor<-max(r,spear,ken)
          #range.seq<-seq(from=cor.range[1],to=cor.range[2],length=20)
          if(all.cor>=cor.range[4]){
            rect(par("usr")[1], par("usr")[3], par("usr")[2], par("usr")[4], col =
            a[59])} else if(all.cor>=cor.range[3]){
            rect(par("usr")[1], par("usr")[3], par("usr")[2], par("usr")[4], col =
            a[76])} else if(all.cor>=cor.range[2]){
            rect(par("usr")[1], par("usr")[3], par("usr")[2], par("usr")[4], col =
            a[382])}
          r<-max(all.cor)
               cex.cor=3
         txt <- format(c(r, 0.123456789), digits=digits)[1]
          txt <- paste(prefix, txt, sep="")
           #if(missing(cex.cor)) cex.cor <- 1.2/strwidth(txt)

              txt2=""
            if(max(all.cor)>cor.range[2]){
            if(spear==max(all.cor) && spear!=cor(x,y,use="pairwise.complete.obs")) {txt2 <- " s"
              } else if(ken==max(all.cor) && ken!=cor(x,y,use="pairwise.complete.obs")){
              txt2 <-" k"
              }

         }
          text(0.5, 0.5, txt, cex = .7+cex.cor * (r-min(cor.range))/(max(cor.range)-min(cor.range)))
          text(.9,.1,txt2,cex=1.5)
         }

#   #Find a new unique file name (one in the desired directory that hasn't yet been used)
#   outfile <- paste(output.dir,"Predictor_Correlation.pdf",sep="\\")
#             while(file.access(outfile)==0) outfile<-paste(output.dir,"Predictor_Correlation.pdf",sep="\\")
#
#  options(warn=-1)
#   pdf(outfile,width=11,height=9,onefile=T)
#     MyPairs(HighToPlot,cor.range=cor.range,my.labels=(as.vector(High.cor)[1:num.plots]),
#     lower.panel=panel.smooth,diag.panel=panel.hist, upper.panel=panel.cor,pch=21,bg = c("red","steelblue")[as.factor(response)],col.smooth = "red")
#   graphics.off()
#  options(warn=0)
#
#   }

  #Find a new unique file name (one in the desired directory that hasn't yet been used)

 options(warn=-1)
 if(Debug==FALSE) jpeg(output.file,width=1000,height=1000,pointsize=13)
    MyPairs(cbind(TrueResponse,HighToPlot),cor.range=cor.range,my.labels=(as.vector(High.cor)[1:num.plots]),
    lower.panel=panel.smooth,diag.panel=panel.hist, upper.panel=panel.cor,pch=21,bg = c("green","red","yellow")[factor(response,levels=c(0,1,-9999))],col.smooth = "red")

 if(Debug==FALSE) graphics.off()
 options(warn=0)

  }

MyPairs<-function (x,my.labels,labels, panel = points, ..., lower.panel = panel,
    upper.panel = panel, diag.panel = NULL, text.panel = textPanel,
    label.pos = 0.5 + has.diag/3, cex.labels = NULL, font.labels = 1,
    row1attop = TRUE, gap = 1,Toplabs=NULL)
{
    response<-x[,1]
    response[response==-9999]<-0
    x<-x[,2:dim(x)[2]]

    textPanel <- function(x = 0.5, y = 0.5, txt, cex, font) text(x,
        y, txt, cex = cex, font = font)
    localAxis <- function(side, x, y, xpd, bg, col = NULL, main,
        oma, ...) {
        if (side%%2 == 1)
            Axis(x, side = side, xpd = NA, ...)
        else Axis(y, side = side, xpd = NA, ...)
    }
    localPlot <- function(..., main, oma, font.main, cex.main) plot(...)
    localLowerPanel <- function(..., main, oma, font.main, cex.main) lower.panel(...)
    localUpperPanel <- function(..., main, oma, font.main, cex.main) upper.panel(...)
    localDiagPanel <- function(..., main, oma, font.main, cex.main) diag.panel(...)
    dots <- list(...)
    nmdots <- names(dots)
    if (!is.matrix(x)) {
        x <- as.data.frame(x)
        for (i in seq_along(names(x))) {
            if (is.factor(x[[i]]) || is.logical(x[[i]]))
                x[[i]] <- as.numeric(x[[i]])
            if (!is.numeric(unclass(x[[i]])))
                stop("non-numeric argument to 'pairs'")
        }
    } else if (!is.numeric(x))
        stop("non-numeric argument to 'pairs'")
    panel <- match.fun(panel)
    if ((has.lower <- !is.null(lower.panel)) && !missing(lower.panel))
        lower.panel <- match.fun(lower.panel)
    if ((has.upper <- !is.null(upper.panel)) && !missing(upper.panel))
        upper.panel <- match.fun(upper.panel)
    if ((has.diag <- !is.null(diag.panel)) && !missing(diag.panel))
        diag.panel <- match.fun(diag.panel)
    if (row1attop) {
        tmp <- lower.panel
        lower.panel <- upper.panel
        upper.panel <- tmp
        tmp <- has.lower
        has.lower <- has.upper
        has.upper <- tmp
    }
    nc <- ncol(x)
    if (nc < 2)
        stop("only one column in the argument to 'pairs'")
    has.labs <- TRUE
    if (missing(labels)) {
        labels <- colnames(x)
        if (is.null(labels))
            labels <- paste("var", 1L:nc)
    }
    else if (is.null(labels))
        has.labs <- FALSE
    oma <- if ("oma" %in% nmdots)
        dots$oma
    else NULL
    main <- if ("main" %in% nmdots)
        dots$main
    else NULL
    if (is.null(oma)) {
        oma <- c(4, 4, 4, 4)
        if (!is.null(main))
            oma[3L] <- 6
    }

    nCol<-ifelse(length(unique(response))>1,nc+1,nc)
    j.start<-ifelse(length(unique(response))>1,0,1)
    opar <- par(mfrow = c(nc, nCol), mar = rep.int(gap/2, 4), oma = oma)
    on.exit(par(opar))
    for (i in if (row1attop)
        1L:(nc)
    else nc:1L) for (j in j.start:(nc)) {

        if(i==1){ par(mar = c(gap/2,gap/2,gap,gap/2)) #top row add extra room at top
          if(j==0){
                par(mar = c(gap/2,gap,gap,gap)) #top left corner room at top and on right
          localPlot(x[, i],response, xlab = "", ylab = "", axes = FALSE,
                type="n",...)
                }else if(j==1) {par(mar = c(gap/2,gap,gap,gap/2)) #extra room on left and topfor second plot top row
                    localPlot(x[, j], x[, i], xlab = "", ylab = "", axes = FALSE,
           type="n",...)} else  {
           par(mar = c(gap/2,gap/2,gap,gap/2)) #all other top row plots need extra room at top only
           localPlot(x[, j], x[, i], xlab = "", ylab = "", axes = FALSE,
           type="n",...)
           }}else { par(mar = rep.int(gap/2, 4))
               if(j==0){ par(mar = c(gap/2,gap,gap/2,gap))  #left column needs extra room on right only
               localPlot(x[, i],response, xlab = "", ylab = "", axes = FALSE,
                type="n",...)
                }else if(j==1){ par(mar = c(gap/2,gap,gap/2,gap/2)) #second column needs extra room on left so labels fit
                localPlot(x[, j], x[, i], xlab = "", ylab = "", axes = FALSE,
           type="n",...)
        }else localPlot(x[, j], x[, i], xlab = "", ylab = "", axes = FALSE,
           type="n",...)}
         if(j==0) {
             if(i==1) par(mar=c(gap/2,gap,gap,gap))
                else par(mar = c(gap/2,gap,gap/2,gap))

                  if(i==1) title(main="Response",line=.04,cex.main=1.5)

                  box()
                     my.lab<-paste("cor=",round(max(abs(cor(x[,(i)],response,use="pairwise.complete.obs")),abs(cor(x[,(i)],response,method="spearman",use="pairwise.complete.obs")),
                     abs(cor(x[,(i)],response,method="kendall",use="pairwise.complete.obs"))),digits=2),sep="")

                  #panel smooth doesn't work for two reasons: one, the response is binary and it requires more than two unique values
                  #second I don't think it can use weights which is necessary with an overwhelming amount of background points so that presnce points
                  #can't be viewed
                  #panel.smooth(as.vector(x[, (i)]), as.vector(jitter(response,factor=.1)),weights=
                  #        c(rep(table(response)[2]/table(response)[1],times=table(response)[1]),rep(1,times=table(response)[2])),...)

                   if(length(unique(response))>2) panel.smooth(as.vector(x[, (i)]), as.vector(response),...)
                   else my.panel.smooth(as.vector(x[, (i)]), as.vector(response),weights=
                          c(rep(table(response)[2]/table(response)[1],times=table(response)[1]),rep(1,times=table(response)[2])),...)

                          title(ylab=paste("cor=",round(max(abs(cor(x[,(i)],response,use="pairwise.complete.obs")),
                          abs(cor(x[,(i)],response,method="spearman",use="pairwise.complete.obs")),abs(cor(x[,(i)],response,method="kendall",use="pairwise.complete.obs"))),digits=2),
                          sep=""),line=.02,cex.lab=1.5)
                          #,y=.85,x=max(x[,(i)])-.2*diff(range(x[,(i)])),cex=1.5)

                 } else{
        if (i == j || (i < j && has.lower) || (i > j && has.upper)) {
            box()
            if(i==1) title(main=paste("Total Cor=",my.labels[j],sep=""),line=.04,cex.main=1.5)
            #if (i == 1 && (!(j%%2) || !has.upper || !has.lower))
             #   localAxis(1 + 2 * row1attop, x[, j], x[, i],
             #   ...)
            if (i == nc)
                localAxis(3 - 2 * row1attop, x[, j], x[, i],
                  ...)
            if (j == 1 && (i!=1 || !has.upper || !has.lower))
                localAxis(2, x[, j], x[, i], ...)
            #if (j == nc && (i%%2 || !has.upper || !has.lower))
            #    localAxis(4, x[, j], x[, i], ...)
            mfg <- par("mfg")
            if (i == j) {
                if (has.diag)
                  localDiagPanel(as.vector(x[, i]),...)
                if (has.labs) {
                  par(usr = c(0, 1, 0, 1))
                  if (is.null(cex.labels)) {
                    l.wid <- strwidth(labels, "user")
                    cex.labels <- max(0.8, min(2, 0.9/max(l.wid)))
                  }

                  text.panel(0.5, label.pos, labels[i], cex = cex.labels,
                    font = font.labels)
                }
            }

            else if (i < j)
                  if(length(unique(x[,i])>2)){
                  localLowerPanel(as.vector(x[, j]), as.vector(x[,
                    i]), ...) } else {
                      my.panel.smooth(as.vector(x[, j]),as.vector(x[,i]))
                    }

            else localUpperPanel(as.vector(x[, j]), as.vector(x[,
                i]), ...)
            if (any(par("mfg") != mfg))
                stop("the 'panel' function made a new plot")
        }
        else par(new = FALSE)
    }}
    if (!is.null(main)) {
        font.main <- if ("font.main" %in% nmdots)
            dots$font.main
        else par("font.main")
        cex.main <- if ("cex.main" %in% nmdots)
            dots$cex.main
        else par("cex.main")
        mtext(main, 3, 3, TRUE, 0.5, cex = cex.main, font = font.main)
    }
    invisible(NULL)
}

my.panel.smooth<-function (x, y, col = par("col"), bg = NA, pch = par("pch"),
    cex = 1, col.smooth = "red", span = 2/3, iter = 3, weights=rep(1,times=length(y)), ...)
{
    o<-order(x)
    points(x, y, pch = pch, col = col, bg = bg, cex = cex)
    ok <- is.finite(x) & is.finite(y)
    if (any(ok) && length(unique(x))>3)
    lines(lowess(x[o],y[o],iter=0),col="red")
        #lines(smooth.spline(x,w=weights,jitter(y,amount=(max(y)-min(y))/100),nknots=min(length(unique(x)),4)),col="red")

}

Args <- commandArgs(T)
    print(Args)
    #assign default values
    num.plots <- 10
    min.cor <- .7
    responseCol <- "ResponseBinary"
    cors.w.highest <- FALSE
    pres=TRUE
    absn=TRUE
    bgd=TRUE
    #replace the defaults with passed values
    for (arg in Args) {
    	argSplit <- strsplit(arg, "=")
    	argSplit[[1]][1]
    	argSplit[[1]][2]
    	if(argSplit[[1]][1]=="p") num.plots <- argSplit[[1]][2]
    	if(argSplit[[1]][1]=="m") min.cor <- argSplit[[1]][2]
    	if(argSplit[[1]][1]=="o") output.file <- argSplit[[1]][2]
    	if(argSplit[[1]][1]=="i") infile <- argSplit[[1]][2]
    	if(argSplit[[1]][1]=="rc") responseCol <- argSplit[[1]][2]
    	if(argSplit[[1]][1]=="core") cors.w.highest <- argSplit[[1]][2]
      if(argSplit[[1]][1]=="pres") pres <- argSplit[[1]][2]
      if(argSplit[[1]][1]=="absn") absn <- argSplit[[1]][2]
      if(argSplit[[1]][1]=="bgd") bgd <- argSplit[[1]][2]
    }

    print(num.plots)
    print(min.cor)
    print(output.file)
    print (infile)
    print(responseCol)
    print(cors.w.highest)
    print(pres)
    print(absn)
    print(bgd)

	#Run the Pairs Explore function with these parameters
    Pairs.Explore(num.plots=num.plots,
    min.cor=min.cor,
    input.file=infile,
		output.file=output.file,
		response.col=responseCol,
		cors.w.highest=cors.w.highest,
		pres,
		absn,
		bgd)


#' Plot SSB and F time series
#'
#' Two measures of F plotted (max F and Freport) and plotted separately below SSB time series.
#' @param asap name of the variable that read in the asap.rdat file
#' @param save.plots save individual plots
#' @param od output directory for plots and csv files
#' @param plotf type of plot to save
#' @export

PlotSSBFtrend<-function(asap,save.plots,od,plotf){
  par(mfrow=c(2,1), mar=c(4,4,2,2) )

  ssb <- asap$SSB
  fmult <- apply(asap$F.age,1, max)
  f.report <- asap$F.report
  years<-  seq(asap$parms$styr, asap$parms$endyr)

  plot(years, ssb, type='l', lwd=2, col='blue', xlab="Year", ylab="SSB",
       ylim=c(0,1.05*max(ssb)) )

  plot(years, f.report, type='l', lwd=2, col='black', xlab="Year", ylab="Fishing Mortality",
       ylim=c(0,1.25*max(fmult, f.report)) )
  lines(years, fmult, col='red', lty=2, lwd=2)

  legend('topleft', horiz=T, legend=c('F.report', 'F.full'), col=c('black', 'red'),
         lwd=c(2,2), lty=c(1,2), cex=0.85)

  if (save.plots==T) savePlot(paste0(od, "SSB.F.Timeseries.Line.",plotf), type=plotf)
  return()
}  #end function


library("dplyr")
library("sf")
library("assertthat")

# Ensure 01-prep-crime-data.r has been run first
crimes = readRDS("data/interim/crimes.rds")
crimes = st_as_sf(crimes, coords = c("Longitude", "Latitude"))
crimes = st_set_crs(crimes, 4326)

# Open Geography Portal - last updated 2017-10-09
# https://www.arcgis.com/sharing/rest/content/items/c86cdd7f86264f369789752121f0a1c4/info/metadata/metadata.xml?format=default&output=html
if (!file.exists("data/external/boundaries.geojson"))
{
    url = "https://opendata.arcgis.com/datasets/c86cdd7f86264f369789752121f0a1c4_0.geojson"
    download.file(url, destfile = "data/external/boundaries.geojson")
}

boundaries = sf::read_sf("data/external/boundaries.geojson")
boundaries =
    boundaries %>%
    rename(
        id   = OBJECTID,
        code = PFA16CD,
        name = PFA16NM
    ) %>%
    select(id, code, name)

assert_that(all(st_is_valid(boundaries)))

# NB this is lengthS not length
boundaries$num_burglaries = lengths(st_intersects(boundaries, crimes))
boundaries = st_transform(boundaries, crs = 27700)

if (!all(st_is_valid(boundaries)))
{
    boundaries = st_make_valid(boundaries)
}

assert_that(all(st_is_valid(boundaries)))

boundaries = rmapshaper::ms_simplify(boundaries)

dir.create("data/processed", showWarnings = FALSE, recursive = TRUE)
sf::st_write(boundaries, "data/processed/boundaries.gpkg", delete_layer = TRUE)


#=========================================================
#
# Judas detection probability - discrete survival analysis
#
# Dave Ramsey (22/11/2021)
#=========================================================

library(tidyverse)
library(lubridate)
library(sf)
library(purrr)
library(cmdstanr)
library(posterior)
source("R/judas functions.r")

#==================================================
# Santiago Judas goats
#==================================================

goat_dyads<- read_csv("data/Santiago_judas_dyads.csv")
goat_dyads<- goat_dyads %>% mutate(id1 = factor(as.character(id1)), id2 = factor(as.character(id2)))
goat_ids<- read_csv("data/Santiago_judas_ID.csv")
goat_ids<- goat_ids %>% mutate(ID = factor(as.character(ID)))

id1<- as.vector(unclass(goat_dyads$id1))
id2<- as.vector(unclass(goat_dyads$id2))

dyad<- as.vector(unclass(factor(goat_dyads$Dyad)))
ndyads<- max(dyad)
N<- nrow(goat_dyads)
M<- nrow(goat_ids)
X<- model.matrix(~ distance + Sex1 + Trans1, data=goat_dyads)[,-1]
K<- ncol(X)
sex<- model.matrix(~Sex + Trans, goat_ids)[,-1]

#---- Calculate home range scale (sigma) from Judas locations ----

goat_locs<- read_csv("data/santiago_judas_locs.csv")
goat_locs<- goat_locs %>% mutate(ID = factor(as.character(ID)))
goat_locs<- goat_locs %>% group_by(ID) %>% nest() %>% arrange(ID)

goat_chr<- goat_locs %>% mutate(CNorm=map(data, calc_hr))
goat_chr<- goat_chr %>% unnest(CNorm) %>% select(-data)

maxD<- goat_chr$sigma * 2.45

#---- Discrete survival analysis -----

set.seed(123)

mod<- cmdstan_model("stan/discrete_survival.stan")

data<- list(N=N,M=M,K=K,X=X,id1=id1,id2=id2,
            time=as.integer(goat_dyads$time),
            ev=as.integer(goat_dyads$event),sex=sex,maxD=maxD)

## MCMC settings (for illustration - increase for serious inference)
ni <- 500
nt <- 1
nb <- 500
nc <- 2

inits <- lapply(1:nc, function(i)
  list(b1= -3, beta=c(-0.5,1,1,1), sigma_id1=runif(1), sigma_id2=runif(1), q=runif(N, 0, 0.1)))

out<- mod$sample(
  data=data,
  init = inits,
  iter_warmup = nb,
  iter_sampling = ni,
  chains=nc,
  parallel_chains = nc,
  refresh = 50)

out$summary(c("b1","beta","sigma_id1","sigma_id2"))

out$summary("pave")

out$save_object(file="out/goat_surv.rds")

#==================================================
# Santa Cruz Island Judas pigs
#==================================================

pig_dyads<- read_csv("data/Santacruz_judas_dyads.csv")
pig_dyads<- pig_dyads %>% mutate(id1 = factor(as.character(id1)), id2 = factor(as.character(id2)))
pig_ids<- pig_dyads %>% select(ID=id1,Sex=Sex1) %>% distinct() %>% arrange(ID)

id1<- as.vector(unclass(pig_dyads$id1))
id2<- as.vector(unclass(pig_dyads$id2))

dyad<- as.vector(unclass(factor(pig_dyads$Dyad)))
ndyads<- max(dyad)
N<- nrow(pig_dyads)
M<- nrow(pig_ids)
X<- model.matrix(~ distance + Sex1, data=pig_dyads)[,-1]
K<- ncol(X)
sex<- as.matrix(ifelse(pig_ids$Sex=="B", 0, 1))

#--- Calculate home range scale (sigma) from Judas locations
pig_locs<- read_csv("data/santacruz_judas_locs.csv")
# rescale coordinates to km
pig_locs<- pig_locs %>% mutate(ID = factor(as.character(ID)),East=East/1000, North=North/1000)
pig_locs<- pig_locs %>% group_by(ID) %>% nest() %>% arrange(ID)

pig_chr<- pig_locs %>% mutate(CNorm=map(data, calc_hr))
pig_chr<- pig_chr %>% unnest(CNorm) %>% select(-data)

maxD<- pig_chr$sigma * 2.45

#------------------------------------------------------
# Discrete survival analysis
#-----------------------------------------------------------

mod<- cmdstan_model("stan/discrete_survival.stan")

data<- list(N=N,M=M,K=K,X=X,id1=id1,id2=id2,
            time=as.integer(pig_dyads$time),
            ev=as.integer(pig_dyads$event),sex=sex,maxD=maxD)

## MCMC settings
ni <- 500
nt <- 1
nb <- 500
nc <- 2

inits <- lapply(1:nc, function(i)
  list(b1= -3, beta=c(-0.5,1), sigma_id1=runif(1), sigma_id2=runif(1), q=runif(N, 0, 0.1)))

out<- mod$sample(
  data=data,
  init = inits,
  iter_warmup = nb,
  iter_sampling = ni,
  chains=nc,
  parallel_chains = nc,
  refresh = 50)

out$summary(c("b1","beta","sigma_id1","sigma_id2"))

out$summary("pave")

out$save_object(file="out/pig_surv.rds")

#---------------------------------------------------
# Plots
#---------------------------------------------------

# Predicted probability of detection at activity centres (i.e. distance = 0)

out<- readRDS("out/goat_surv.rds")

fit<- as_draws_rvars(out$draws(c("beta0","beta")))

beta0<- draws_of(fit$beta0)
beta<- draws_of(fit$beta)
beta1<- beta[,1]
beta2<- beta[,-1]

n<- nrow(goat_ids)
XX<- model.matrix(~Sex + Trans, goat_ids)[,-1]

plam<- matrix(NA,nrow=dim(beta)[1],ncol=n)
for(i in 1:n){
  plam[,i]<- 1-exp(-exp(beta0[,i] + beta2 %*% XX[i,]))
}

plam<- as.data.frame(plam)
names(plam)<- goat_ids$ID
plam$samp<- 1:nrow(plam)

plam<- plam %>% pivot_longer(-samp, names_to = "ID", values_to = "p")
plam<- left_join(plam, goat_ids)
plam<- plam %>% mutate(Sex = factor(Sex, levels=c("Female","Super","Male")),
                       Trans = factor(Trans, labels = c("Not Translocated","Translocated")))

win.graph(10,5)
plam %>% ggplot(aes(ID, p, color=interaction(Sex,Trans))) +
  geom_boxplot(fill="grey90",outlier.color = NA) +
  labs(x="Judas ID", y="Detection probability at centre of UD") +
  theme_bw() +
  theme(axis.text.x = element_blank(),
        legend.position = "bottom",
        legend.title = element_blank())

#--------------------------------------------------------
# Predicted detection curves with distance from activity centre
#--------------------------------------------------------
fit<- as_draws_rvars(out$draws(c("beta0","beta")))

beta0<- E(fit$beta0)
beta<- E(fit$beta)
beta1<- beta[1]
beta2<- beta[-1]

n<- nrow(goat_ids)
distance<- seq(0,20,0.1)
XX<- model.matrix(~Sex + Trans, goat_ids)[,-1]

plam<- matrix(NA,nrow=length(distance), ncol=n)

for(i in 1:n){
  plam[,i]<- 1-exp(-exp(beta0[i] + beta1*distance + as.vector(XX[i,] %*% beta2)))
}
plam<- as.data.frame(plam)
names(plam)<- goat_ids$ID
plam<- plam %>% mutate(Distance=distance)

plam<- plam %>% pivot_longer(-Distance, names_to = "ID", values_to = "p")
plam<- left_join(plam, goat_ids)
plam<- plam %>% mutate(Sex = factor(Sex, levels=c("Female","Super","Male")),
                       Trans = factor(Trans, labels = c("Not Translocated","Translocated")))

win.graph(8,7)
plam %>% ggplot(aes(Distance, p, group=ID)) +
  geom_line(color="grey50") +
  facet_grid(rows=vars(Sex), cols=vars(Trans)) +
  labs(x="Distance (km)",y="Probability of association") +
  theme_bw() +
  theme(legend.position = "none",
        strip.text = element_text(face="bold"))

 #--------------------------------------------------------------------
 # Unconditional detection probability (Eqn. 2)
 #--------------------------------------------------------------------

fit<- summarise_draws(out$draws("pave"), mean, ~quantile(.x, c(0.05,0.95)))

plam<- goat_ids %>% mutate(pave= fit$mean, lcl = fit$`5%`, ucl=fit$`95%`)
plam<- plam %>% mutate(Sex = factor(Sex, levels=c("Female","Super","Male")),
                       Trans = factor(Trans, labels = c("Not Translocated","Translocated")))

win.graph(10,5)
 plam<- plam %>% arrange(pave)
 plam %>%  mutate(ID = fct_reorder(ID, pave), Sex) %>%
   ggplot(aes(x=Trans, y=pave, color=Sex)) +
   geom_pointrange(aes(ymin=lcl,ymax=ucl), position=position_dodge2(width=0.5)) +
   facet_wrap(~Sex) +
   labs(x="",y="Probability of association",color="Status") +
   theme_bw() +
   theme(legend.position = "none",
         strip.text = element_text(face="bold"),
         axis.title = element_text(face="bold", size=12),
         axis.text.x = element_text(size=11))


library(geobr)
library(sf)
Brasil <- geobr::read_country(year = 2018)
Estados <- geobr::read_state(code_state = "all", year=2018)
Municipios <- geobr::read_municipality(code_muni = "all", year=2018)
geoInfo <- list(brasil = Brasil, estados = Estados, municipios = Municipios)

#teste de plotagem do mapa do Brasil
plot(st_geometry(Brasil))

02_ dados/01_ IBGE/scripts/shapefiles Brasil 2019_08_12.r


# R script for plotting ROC curve for different tableau search methods
# Alex Stivala
# July 2008
# $Id: plotsearchroc.r 1946 2008-10-04 05:14:43Z astivala $

#
# globals
#

colorvec=c('deepskyblue4','brown','red','turquoise','blue','purple','green','cyan','gray20','magenta','darkolivegreen2','midnightblue','magenta3','darkseagreen','violetred3','darkslategray3')
ltyvec=c(1,2,4,5,6,1,2,1,5,6,1,2,4,5,6,1,2)
namevec=c('QP numeric', 'QP numeric SSE type', 'QP numeric ordering SSE type', 'QP discrete','QP discrete SSE type', 'QP discrete ordering SSE type')

#
# main
#

qp_numeric <- read.table('d1ubia_.tsrchn.ff.rtab',header=TRUE)
qp_numeric_penalizessetype<-read.table('d1ubia_.tsrchn.tf.rtab',header=TRUE)
qp_numeric_ordering_penalizessetype <- read.table('d1ubia_.tsrchn.tt.rtab', header=TRUE)

qp_discrete <- read.table('d1ubia_.tsrchd.ff.rtab',header=TRUE)
qp_discrete_penalizessetype<-read.table('d1ubia_.tsrchd.tf.rtab',header=TRUE)
qp_discrete_ordering_penalizessetype <- read.table('d1ubia_.tsrchd.tt.rtab', header=TRUE)

# EPS suitable for inserting into LaTeX
postscript('searchroc.eps',onefile=FALSE,paper="special",horizontal=FALSE,
           width = 9, height = 6)

plot(c(0,1),c(0,1),type='l',xlim=c(0,1),ylim=c(0,1),xlab="False Positive Rate",ylab="True Positive Rate",lty=3,main='ROC curves for query d1ubia_ against ASTRAL 95% seq id SCOP as truth')

lines(qp_numeric$fpr, qp_numeric$tpr, col=colorvec[1], lty=ltyvec[1])
lines(qp_numeric_penalizessetype$fpr, qp_numeric_penalizessetype$tpr, col=colorvec[2], lty=ltyvec[2])
lines(qp_numeric_ordering_penalizessetype$fpr, qp_numeric_ordering_penalizessetype$tpr, col=colorvec[3], lty=ltyvec[3])
lines(qp_discrete$fpr, qp_discrete$tpr, col=colorvec[4], lty=ltyvec[4])
lines(qp_discrete_penalizessetype$fpr, qp_discrete_penalizessetype$tpr, col=colorvec[5], lty=ltyvec[5])
lines(qp_discrete_ordering_penalizessetype$fpr, qp_discrete_ordering_penalizessetype$tpr, col=colorvec[6], lty=ltyvec[6])

legend('bottomright', col=colorvec, lty=ltyvec, legend=namevec)

dev.off()


hummingage <- function(path,infile,segments,DiscardOutliers,EstimateNullRate,token,plot_format) {
    ##
    ## usage:
    ## hummingage("/home/user/data/","myfile.csv",c(NaN),TRUE,"estimate","KJmpmGgQ","png,pdf")
    ## hummingage("/home/user/data/","myfile.csv",c(124),FALSE,"estimate","KJmpmGgQ","png")
    ## hummingage("/home/user/data/","myfile.csv",c(334,856,1223),TRUE,"estimate","KJmpmGgQ","pdf")
    ## segments in cm

    ## path: (string): is the path to the infile
    ## infile: (string): is the data file according to a certain format
    ## segments: (integer array): is an array indicating roughly the positions of the segments, use c(NaN) for no segments
    ## DiscardOutliers: (boolean): can be TRUE or FALSE. If true, a simple algorithm is applied to identify outliers
    ## EstimateNullRate: (string or integer): possible values are
    ##                   "estimate": the x-axis offset is estimated from the data
    ##                   "null": the x-axis offset is set to 0
    ##                   negative or positive integer: x-axis offset is set to the inserted value, e.g. -42, 14, ... (in cm)
    ## token: (string): this is a random string, which can be choosen arbitrarily
    ## plot_format (string): this can be "png,pdf", "png" or "pdf" and defines what kinds of images are written to disk
    ##                       both, png and pdf or only png or pdf
    ##

    ## full file-path
    xfile <- paste(path,infile,sep="");

    ## transform plot_format to array
    plot_format_tmp <- strsplit(plot_format,",")
    plot_format <- plot_format_tmp[[1]]

    ## load the infile and save as ageDataOrig
    ageDataOrig <- read.table(xfile, header = TRUE,sep=",")

    ## if no segment will be used set it to empty
    if (is.nan(segments)){
        segments = c()
    }

    ## calculate length and estimate rates
    lengthData <- length(ageDataOrig$depth)
    diffDepths <- diff(ageDataOrig$depth)
    accRatesOrig <- diff(ageDataOrig$age)/diffDepths

    ##--------------------------------------------------------------------------------------------##
    ## this block is only executed if DiscardOutliers == TRUE
    ## identify negative rates, i.e. outliers
    ## the difficulty is to identify the outlier
    ## i.e. which age is the outlier, because the rate is calculated from two ages
    ## thus we take the ages left and right to the two ages which make the negative rate
    ## and then we calculate which age is further away from the mean of the two left
    ## and rights
    if (DiscardOutliers==TRUE){
        ## find negative rates
        negRatesIndex <- which(accRatesOrig < 0)
    } else {
        ## set this to empty
        negRatesIndex <- integer(0)
    }
    ## make a copy of the indices of the negative rates
    negRatesIndexCopy <- negRatesIndex

    ## go through the negative rates and decide which age is the outlier, left or right
    m <- 1
    for (i in negRatesIndexCopy) {
        ## skip the first
        if (i==1){
            next
        }
        ## calculate the mean between the left and right age next to the two
        ## ages, which where used to calculate the rate
        TheMean <- (ageDataOrig$age[(i-1)]+ageDataOrig$age[(i+2)])/2
        ## distance of the left age to the mean
        dist1 <- abs(ageDataOrig$age[(i)]-TheMean)
        ## distance of the right age to the mean
        dist2 <- abs(ageDataOrig$age[(i+1)]-TheMean)
        ## if the right is further away then this is the outlier
        ## so increment the index
        ## otherwise it's the left and leave the index
        if (dist2>dist1){
            negRatesIndex[m] <- negRatesIndex[m]+1
        }
        m <- m+1
    }
    ##--------------------------------------------------------------------------------------------##

    ## remove extreme rates and exclude the first
    ## because the first must be estimated later below
    ## remove outliers from original data
    ## or copy data as they are, if there are no outliers
    LnegRatesIndex <- length(negRatesIndex)
    if (LnegRatesIndex>0){
        ## remove data
        ageData <- ageDataOrig[-negRatesIndex,]
    } else {
        ## leave data as they are
        ageData <- ageDataOrig
    }

    ## now, outliers have been removed calculate again length, rates etc.
    lengthData <- length(ageData$depth)
    diffDepths <- diff(ageData$depth)
    accRates <- diff(ageData$age)/diffDepths
    sigmaRates <- sqrt((ageData$error[2:lengthData]^2+ageData$error[1:(lengthData-1)]^2))/diffDepths

    ## convert segments from depth to point number
    ## find the position, i.e. between the two closest points
    Lsegments <- length(segments)
    if (Lsegments == 0) {
        segPos = c()
    } else {
        segPos <- rep(0,Lsegments)
        for (i in seq(1,Lsegments)){
            ## difference between depth variable and a sequence position (in cm)
            Xdiff <- ageData$depth-segments[i]
            ## find the indices smaller than the segment position
            a <- which(Xdiff<0)
            ## set the position at the last negative
            segPos[i] <- max(a)
        }
    }

    ## copy of segPos
    segPosPlot <- segPos
    ## add left and right boundaries to segPos
    segPos <- c(0,segPos,lengthData)
    segPosLength <- length(segPos)

    ##--------------------------------------------------------------------------------------------##
    ##  estimate the x-axis crossing to estimate the first rate
    ##  if we would take the origin 0,0 than the first rate will be wrong
    ##  because there is an offset
    ##
    ##  so, we fit the first segment and estimate the x-crossing
    ##  cut out first segment
    xcrossing <- 0
    if (EstimateNullRate == "estimate"){
        N <- 3
        Lu <- length(1:N)
        u <- ageData$age[1:N]
        X <- replicate(2,rep(1,Lu))
        X[,2] <- ageData$depth[1:N]
        ##  print(X)
        beta <- solve(t(X) %*% X) %*% t(X) %*% u
        ##  print(beta)
        ##  only if slope is positive
        if (beta[2]>0){
            xcrossing <- beta[1]/beta[2]*(-1)
            ##  print(xcrossing)
        } else {
            xcrossing <- 0
        }
    }
    if (EstimateNullRate == "null"){
        xcrossing <- 0
    }
    if (is.numeric(EstimateNullRate) == TRUE){
        ##  then this is xcrossing
        xcrossing <- EstimateNullRate
    }
    NullDiff <- ageData$depth[1]-xcrossing
    NullRate <- ageData$age[1]/NullDiff
    NullError <- ageData$error[1]/NullDiff
    ##--------------------------------------------------------------------------------------------##

    ## now we have the first rate and add it to the rates
    accRates <- c(NullRate,accRates)
    ## print(accRates)
    ## add also a std for the first
    sigmaRates <- c(NullError,sigmaRates)

    ## initialise arrays for the fits
    fittedRates <- rep(0,lengthData)
    fittedError <- rep(0,lengthData)

    ##--------------------------------------------------------------------------------------------##
    ## fitting the segments
    for (i in seq(2,segPosLength)) {
        ##  least square
        Xsegment <- (segPos[i-1]+1):segPos[i]
        Lsegment <- length(Xsegment)
        ##  create X matrix
        X <- replicate(2,rep(1,Lsegment))
        X[,2] <- ageData$depth[Xsegment]
        ##  create error matrix
        g <- solve(t(X) %*% X)
        ##  print(g)
        beta <- g %*% t(X) %*% accRates[Xsegment]
        ##  print(beta)
        fittedRates[Xsegment] <- X %*% beta
        ##  res
        fittedError[Xsegment] <- sqrt(1/(Lsegment-1) * sum((fittedRates[Xsegment]-accRates[Xsegment])^2))
        ##  print(fittedError[Xsegment])
    }
    ##--------------------------------------------------------------------------------------------##

    ##--------------------------------------------------------------------------------------------##
    ##  BIC
    ##  BIC for Gaussian approx. is BIC=N*ln(epsilon^2)+k*ln(N)
    ##  for fitting a linear regression one need k=q+2 parameters to be estimated
    ##  one for the intercept, q for the slopes and one for the rmse
    ##  thus in the case of fitting the mean I need k=2 (intercept, rmse)
    ##  BIC[segments] <- N * log(rmse^2) + 2*segments * log(N)
    mse <- 1/lengthData * sum((fittedRates-accRates)^2)
    BIC <- lengthData * log(mse) + (2*(segPosLength-1)+1) * log(lengthData)
    ## (segPosLength-1) because above I have added 0,segPos,N to segPos
    ## thus (segPosLength-1) is exactly the number of segments
    ## write out the BIC
    write(BIC,file=paste(path,token,"_BIC.txt",sep=""),ncolumns=1)
    ##--------------------------------------------------------------------------------------------##

    ##--------------------------------------------------------------------------------------------##
    ## apply the Bayesian approach, i.e. for the Gaussian assumption the weighted mean
    BayesFittedRates <- (fittedRates * sigmaRates^2 + accRates * fittedError^2)/(fittedError^2 + sigmaRates^2)
    ## disable Bayes
    ##BayesFittedRates <- fittedRates

    ## and the weighted std
    BayesSigmaRates <- sqrt((fittedError^2 * sigmaRates^2)/(fittedError^2 + sigmaRates^2))
    ## disable Bayes
    ##BayesSigmaRates <- fittedError

    ## calculate the ages from the rates
    ageFit <- cumsum(BayesFittedRates * c(NullDiff,diffDepths))
    ##  print("sum1")
    ##  print(sum((ageFit-ageData$age)^2))

    ##  and the errors
    ageFitError <- rep(0,lengthData)
    ageFitError[1] <- BayesSigmaRates[1]*NullDiff
    for (i in seq(1,(lengthData-1))) {
        ageFitError[i+1] <- sqrt(ageFitError[i]^2+(BayesSigmaRates[i+1]*diffDepths[i])^2)
    }
    ##--------------------------------------------------------------------------------------------##

    ##--------------------------------------------------------------------------------------------##
    ## plotting the intermediate result of fitted segments
    for (k in plot <- format){
        if (k == "jupyter"){
            Ascale <- 1 #4
            Bscale <- 1 #6
            Cscale <- 2 #8
            Dscale <- 4 #12
        } else {
            Ascale <- 4
            Bscale <- 6
            Cscale <- 8
            Dscale <- 12

            par(mar=c(14,14,4,2),mgp=c(10,4,0),bg=rgb(248/255,250/255,252/255))
            if (k == "png"){
                png(filename=paste(path,token,"_intermediate.png",sep=""),width=2000,height=1400,pointsize=10)#,width=11,height=8)
            }
            if (k == "pdf"){
                pdf(file=paste(path,token,"_intermediate.pdf",sep=""),width=40,height=28)#,width=11,height=8)
            }
        }

        ymin <- min(c(accRates-sigmaRates),na.rm=TRUE)
        ymax <- max(c(accRates+sigmaRates),na.rm=TRUE)
        xmin <- 0 ##min(ageDataOrig$depth)
        xmax <- max(ageDataOrig$depth)
        plot(ageData$depth,accRates,ylim=c(ymin,ymax),xlim=c(xmin,xmax),xlab="Depth [cm]",ylab="Rates [ka/cm]",cex.lab=Ascale,cex.axis=Ascale)
        if (Lsegments > 0) {
            for (i in seq(1,length(segPosPlot))) {
                par(new=TRUE)
                segPosDepth <- (ageData$depth[segPosPlot[i]]+ageData$depth[segPosPlot[i]+1])/2
                plot(c(segPosDepth,segPosDepth),c(ymin,ymax),ylim=c(ymin,ymax),xlim=c(xmin,xmax),col=rgb(200/255,200/255,200/255),type="l",lwd=Dscale,lty=2,xlab="",ylab="",xaxt="n",yaxt="n",cex=Cscale)
            }
        }
        par(new=TRUE)
        polygon(c(ageData$depth, rev(ageData$depth)), c(fittedRates-fittedError,
                                                        rev(fittedRates+fittedError)), col=rgb(0.8,0.8,0.8),border=NA)
        par(new=TRUE)
        plot(ageData$depth,accRates,ylim=c(ymin,ymax),xlim=c(xmin,xmax),col=rgb(42/255,190/255,230/255),pch=19,xlab="",ylab="",xaxt="n",yaxt="n",cex=Cscale)
        par(new=TRUE)
        plot(ageData$depth,fittedRates,ylim=c(ymin,ymax),xlim=c(xmin,xmax),xlab="",pch=19,ylab="",xaxt="n",yaxt="n",col="red",cex=Ascale)
        par(new=TRUE)
        plot(ageData$depth,fittedRates,ylim=c(ymin,ymax),xlim=c(xmin,xmax),lwd=Cscale,xlab="",ylab="",xaxt="n",yaxt="n",type="l",col="red",cex=Cscale)

        arrows(ageData$depth, accRates-sigmaRates, ageData$depth,
               accRates+sigmaRates, length=0.2, angle=90, code=3,col="black",lwd=Bscale,cex=Cscale)

        legend(xmax, ymax, xjust=1,legend=c("data","fit","sequences"),
               col=c(rgb(42/255,190/255,230/255),"red",rgb(200/255,200/255,200/255)), lwd=c(NaN,Cscale,Dscale), lty=c(1,1,2), pch=c(19,19,NaN), cex=c(Bscale), pt.cex=c(Cscale,Ascale,Cscale))
        if (k != "jupyter"){
            dev.off()
        }
    }
    ##--------------------------------------------------------------------------------------------##

    ##--------------------------------------------------------------------------------------------##
    ## plotting ages
    for (k in plot_format){
        if (k == "jupyter"){
            Ascale <- 1 #4
            Bscale <- 1 #6
            Cscale <- 2 #8
            Dscale <- 4 #12
        } else {
            Ascale <- 4
            Bscale <- 6
            Cscale <- 8
            Dscale <- 12

            par(mar=c(14,14,4,2),mgp=c(10,4,0),bg=rgb(248/255,250/255,252/255))
            if (k == "png"){
                png(filename=paste(path,token,"_ages.png",sep=""),width=2000,height=1400,pointsize=10)#,width=11,height=8)
            }
            if (k == "pdf"){
                pdf(file=paste(path,token,"_ages.pdf",sep=""),width=40,height=28)#,width=11,height=8)
            }
        }

        ymin <- min(c(ageData$age-ageData$error,ageDataOrig$age),na.rm=TRUE)
        ymax <- max(c(ageData$age+ageData$error,ageDataOrig$age,ageFit+ageFitError),na.rm=TRUE)
        xmin <- 0 ##min(ageDataOrig$depth)
        xmax <- max(ageDataOrig$depth)
        plot(ageData$depth,ageData$age,ylim=c(ymin,ymax),xlim=c(xmin,xmax),xlab="Depth [cm]",ylab="Age [ka]",cex.lab=Ascale,cex.axis=Ascale)
        if (Lsegments > 0) {
            for (i in seq(1,length(segPosPlot))) {
                par(new=TRUE)
                segPosDepth <- (ageData$depth[segPosPlot[i]]+ageData$depth[segPosPlot[i]+1])/2
                plot(c(segPosDepth,segPosDepth),c(ymin,ymax),ylim=c(ymin,ymax),xlim=c(xmin,xmax),col=rgb(200/255,200/255,200/255),type="l",lwd=Dscale,lty=2,xlab="",ylab="",xaxt="n",yaxt="n",cex=Cscale)
            }
        }
        par(new=TRUE)
        polygon(c(ageData$depth, rev(ageData$depth)), c(ageFit-ageFitError,
                                                        rev(ageFit+ageFitError)), col=rgb(0.8,0.8,0.8),border=NA,xlim=c(xmin,xmax),)
        par(new=TRUE)
        plot(ageData$depth,ageData$age,ylim=c(ymin,ymax),xlim=c(xmin,xmax),col=rgb(42/255,190/255,230/255),pch=19,xlab="",ylab="",xaxt="n",yaxt="n",cex=Cscale)
        par(new=TRUE)
        plot(ageDataOrig$depth[negRatesIndex],ageDataOrig$age[negRatesIndex],ylim=c(ymin,ymax),xlim=c(xmin,xmax),col=rgb(230/255,190/255,42/255),pch=19,xlab="",ylab="",xaxt="n",yaxt="n",cex=Cscale)
        par(new=TRUE)
        plot(ageData$depth,ageFit,ylim=c(ymin,ymax),xlim=c(xmin,xmax),xlab="",pch=19,ylab="",xaxt="n",yaxt="n",col="red",cex=Ascale)
        par(new=TRUE)
        plot(ageData$depth,ageFit,ylim=c(ymin,ymax),xlim=c(xmin,xmax),lwd=Cscale,xlab="",ylab="",xaxt="n",yaxt="n",type="l",col="red",cex=Cscale)

        arrows(ageDataOrig$depth, ageDataOrig$age-ageDataOrig$error, ageDataOrig$depth,
               ageDataOrig$age+ageDataOrig$error, length=0.2, angle=90, code=3,col="black",lwd=Bscale,cex=Cscale)

        legend(xmax, ymin, xjust=1,yjust=0,legend=c("data","outliers","fit","sequences"),
               col=c(rgb(42/255,190/255,230/255),rgb(230/255,190/255,42/255),"red",rgb(200/255,200/255,200/255)), lwd=c(NaN,NaN,Cscale,Dscale), lty=c(1,1,1,2), pch=c(19,19,19,NaN), cex=c(Bscale), pt.cex=c(Cscale,Cscale,Ascale,NaN))

        if (k != "jupyter"){
            dev.off()
        }
    }
    ##--------------------------------------------------------------------------------------------##

    ##--------------------------------------------------------------------------------------------##
    ## plotting rates
    for (k in plot_format){
        if (k == "jupyter"){
            Ascale <- 1 #4
            Bscale <- 1 #6
            Cscale <- 2 #8
            Dscale <- 4 #12
        } else {
            Ascale <- 4
            Bscale <- 6
            Cscale <- 8
            Dscale <- 12

            par(mar=c(14,14,4,2),mgp=c(10,4,0),bg=rgb(248/255,250/255,252/255))
            if (k == "png"){
                png(filename=paste(path,token,"_rates.png",sep=""),width=2000,height=1400,pointsize=10)#,width=11,height=8)
            }
            if (k == "pdf"){
                pdf(file=paste(path,token,"_rates.pdf",sep=""),width=40,height=28)#,width=11,height=8)
            }
        }

        ymin <- min(c(accRates-sigmaRates),na.rm=TRUE)
        ymax <- max(c(accRates+sigmaRates),na.rm=TRUE)

        xmin <- 0 ##min(ageDataOrig$depth)
        xmax <- max(ageDataOrig$depth)
        plot(ageData$depth,accRates,ylim=c(ymin,ymax),xlim=c(xmin,xmax),xlab="Depth [cm]",ylab="Rates [ka/cm]",cex.lab=Ascale,cex.axis=Ascale)
        if (Lsegments > 0) {
            for (i in seq(1,length(segPosPlot))) {
                par(new=TRUE)
                segPosDepth <- (ageData$depth[segPosPlot[i]]+ageData$depth[segPosPlot[i]+1])/2
                plot(c(segPosDepth,segPosDepth),c(ymin,ymax),ylim=c(ymin,ymax),xlim=c(xmin,xmax),col=rgb(200/255,200/255,200/255),type="l",lwd=Dscale,lty=2,xlab="",ylab="",xaxt="n",yaxt="n",cex=Cscale)
            }
        }
        par(new=TRUE)
        polygon(c(ageData$depth, rev(ageData$depth)), c(BayesFittedRates-BayesSigmaRates,
                                                        rev(BayesFittedRates+BayesSigmaRates)), col=rgb(0.8,0.8,0.8),border=NA)
        par(new=TRUE)
        plot(ageData$depth,accRates,ylim=c(ymin,ymax),xlim=c(xmin,xmax),col=rgb(42/255,190/255,230/255),pch=19,xlab="",ylab="",xaxt="n",yaxt="n",cex=Cscale)
        par(new=TRUE)
        plot(ageData$depth,BayesFittedRates,ylim=c(ymin,ymax),xlim=c(xmin,xmax),xlab="",pch=19,ylab="",xaxt="n",yaxt="n",col="red",cex=Ascale)
        par(new=TRUE)
        plot(ageData$depth,BayesFittedRates,ylim=c(ymin,ymax),xlim=c(xmin,xmax),lwd=Cscale,xlab="",ylab="",xaxt="n",yaxt="n",type="l",col="red",cex=Cscale)

        arrows(ageData$depth, accRates-sigmaRates, ageData$depth,
               accRates+sigmaRates, length=0.2, angle=90, code=3,col="black",lwd=Bscale,cex=Cscale)

        legend(xmax, ymax, xjust=1,legend=c("data","fit","sequences"),
               col=c(rgb(42/255,190/255,230/255),"red",rgb(200/255,200/255,200/255)), lwd=c(NaN,Cscale,Dscale), lty=c(1,1,2), pch=c(19,19,NaN), cex=c(Bscale), pt.cex=c(Cscale,Ascale,Cscale))

        if (k != "jupyter"){
            dev.off()
        }
    }
    ##--------------------------------------------------------------------------------------------##

    ##--------------------------------------------------------------------------------------------##
    ## interpolate ages
    depthInterp <- seq(ageData$depth[1],ageData$depth[lengthData])
    lengthInterp <- length(depthInterp)
    ageFitInterp <- approx(x=ageData$depth,y=ageFit,xout=depthInterp,method="linear")
    ageFitErrorInterp <- approx(x=ageData$depth,y=ageFitError,xout=depthInterp,method="linear")

    ## interpolate rates
    ratesInterp <- approx(x=ageData$depth,y=BayesFittedRates,xout=depthInterp,method="linear")
    ratesErrorInterp <- approx(x=ageData$depth,y=BayesSigmaRates,xout=depthInterp,method="linear")

    ## write to disk
    out <- replicate(5,rep(0,lengthInterp))
    out[,1] <- ageFitInterp$x
    out[,2] <- ageFitInterp$y
    out[,3] <- ageFitErrorInterp$y
    out[,4] <- ratesInterp$y
    out[,5] <- ratesErrorInterp$y

    write("#depths ages sigma_ages rates sigma_rates",file=paste(path,token,"_interp.txt",sep=""),ncolumns=5)
    write(t(out),file=paste(path,token,"_interp.txt",sep=""),ncolumns=5,append=TRUE)

    ##fitted data
    out <- replicate(5,rep(0,lengthData))
    out[,1] <- ageData$depth
    out[,2] <- ageFit
    out[,3] <- ageFitError
    out[,4] <- BayesFittedRates
    out[,5] <- BayesSigmaRates

    write("#depths ages sigma_ages rates sigma_rates",file=paste(path,token,"_fit.txt",sep=""),ncolumns=5)
    write(t(out),file=paste(path,token,"_fit.txt",sep=""),ncolumns=5,append=TRUE)
    ##--------------------------------------------------------------------------------------------##

}