rm(list = ls())

library(karyoploteR)
library(VariantAnnotation)
library("viridis")

#generate custom genome
custom.genome <- toGRanges("chrom_list.ls")

#set graphical parameters
pp <- getDefaultPlotParams(plot.type=2)
pp$ideogramheight<-60
pp$data2height<-300
pp$data1inmargin<-20
pp$data2inmargin<-140
pp$data1outmargin<-10
pp$data1height<-1200
kp <- plotKaryotype(plot.type=2, genome = custom.genome, plot.params=pp, cex=1.8)

#add bases to chromosomes
kpAddBaseNumbers(kp, tick.dist = 10000000, tick.len = 6, tick.col="black", cex=1.5,
                 minor.tick.dist = 1000000, minor.tick.len = 4, minor.tick.col = "black")

#chr_1
#read Hifi data
snps_Hifi <- read.table("chr_1_snp_pos_def_Hifi20X", sep="", header=FALSE)

#create GRange object
snps_Hifi <- toGRanges(snps_Hifi[,c(1,2,2)])

#kpPlotDensity
kp <- kpPlotDensity(kp, data.panel=1, data=snps_Hifi, r0=0, r1=0.25, window.size=40000, border="#85C0F9", col="#85C0F9")
kpAxis(kp, data.panel=1, chr="chr1", ymax=kp$latest.plot$computed.values$max.density, r0=0, r1=0.25, cex=1.8)

#read WGS data
snps_WGS <- read.table("chr_1_snp_pos_def_WGS", sep="", header=FALSE)

#create GRange object
snps_WGS <- toGRanges(snps_WGS[,c(1,2,2)])

#kpPlotDensity
kp <- kpPlotDensity(kp, data.panel=1, data=snps_WGS, r0=0.35, r1=0.6, window.size=40000, border="#005AB5", col="#005AB5")
kpAxis(kp, data.panel=1, chr="chr1", ymax=kp$latest.plot$computed.values$max.density, r0=0.35, r1=0.6, cex=1.8)

#read ddRAD data
snps_ddRAD <- read.table("chr_1_snp_pos_def_ddRAD", sep="", header=FALSE)

#create GRange object
snps_ddRAD <- toGRanges(snps_ddRAD[,c(1,2,2)])

#kpPlotDensity
kp <- kpPlotDensity(kp, data.panel=1, data=snps_ddRAD, r0=0.7, r1=0.95, window.size=40000, border= "#DC3220", col= "#DC3220")
kpAxis(kp, data.panel=1, chr="chr1", ymax=kp$latest.plot$computed.values$max.density, r0=0.7, r1=0.95, cex=1.8)

#plot repeated regions as regions
repeats <- toGRanges("chr_1_masked_3000bp.bed")
kpPlotRegions(kp, data.panel=2, r0=autotrack(1,3), data=repeats, col="darkviolet")

#plot GC content as heatmaps
gc.cont <- toGRanges("chr_1_GC.txt")
kpHeatmap(kp, data.panel=2, r0=autotrack(2,3), data=gc.cont, y=gc.cont$V4, col=c("black","orange","#ed21ff"))

#plot Pacbiocoverage as heatmap using the viridis palette
Pacbio_cov <- toGRanges("chr_1_genomecov_500bp")
kpHeatmap(kp, data.panel=2, data=Pacbio_cov, y=Pacbio_cov$V4, r0=autotrack(3,3), col=viridis(5))

#plot gaps on ideogram as regions
gaps<-toGRanges("chr_1_gaps.bed")
kpPlotRegions(kp, data.panel="ideogram", data=gaps, col="black")

#chr_2
#read Hifi data
snps_Hifi <- read.table("chr_2_snp_pos_def_Hifi20X", sep="", header=FALSE)

#create GRange object
snps_Hifi <- toGRanges(snps_Hifi[,c(1,2,2)])

#kpPlotDensity
kp <- kpPlotDensity(kp, data.panel=1, data=snps_Hifi, r0=0, r1=0.25, window.size=40000, border="#85C0F9", col="#85C0F9")
kpAxis(kp, data.panel=1, chr="chr2", ymax=kp$latest.plot$computed.values$max.density, r0=0, r1=0.25, cex=1.8)

#read WGS data
snps_WGS <- read.table("chr_2_snp_pos_def_WGS", sep="", header=FALSE)

#create GRange object
snps_WGS <- toGRanges(snps_WGS[,c(1,2,2)])

#kpPlotDensity
kp <- kpPlotDensity(kp, data.panel=1, data=snps_WGS, r0=0.35, r1=0.6, window.size=40000, border="#005AB5", col="#005AB5")
kpAxis(kp, data.panel=1, chr="chr2", ymax=kp$latest.plot$computed.values$max.density, r0=0.35, r1=0.6, cex=1.8)

#read ddRAD data
snps_ddRAD <- read.table("chr_2_snp_pos_def_ddRAD", sep="", header=FALSE)

#create GRange object
snps_ddRAD <- toGRanges(snps_ddRAD[,c(1,2,2)])

#kpPlotDensity
kp <- kpPlotDensity(kp, data.panel=1, data=snps_ddRAD, r0=0.7, r1=0.95, window.size=40000, border= "#DC3220", col= "#DC3220")
kpAxis(kp, data.panel=1, chr="chr2", ymax=kp$latest.plot$computed.values$max.density, r0=0.7, r1=0.95, cex=1.8)

#plot repeated regions as regions
repeats <- toGRanges("chr_2_masked_3000bp.bed")
kpPlotRegions(kp, data.panel=2, r0=autotrack(1,3), data=repeats, col="darkviolet")

#plot GC content as heatmaps
gc.cont <- toGRanges("chr_2_GC.txt")
kpHeatmap(kp, data.panel=2, r0=autotrack(2,3), data=gc.cont, y=gc.cont$V4, col=c("black","orange","#ed21ff"))

#plot Pacbiocoverage as heatmap using the viridis palette
Pacbio_cov <- toGRanges("chr_2_genomecov_500bp")
kpHeatmap(kp, data.panel=2, data=Pacbio_cov, y=Pacbio_cov$V4, r0=autotrack(3,3), col=viridis(5))

#plot gaps on ideogram as regions
gaps<-toGRanges("chr_2_gaps.bed")
kpPlotRegions(kp, data.panel="ideogram", data=gaps, col="black")

#chr_3
#read Hifi data
snps_Hifi <- read.table("chr_3_snp_pos_def_Hifi20X", sep="", header=FALSE)

#create GRange object
snps_Hifi <- toGRanges(snps_Hifi[,c(1,2,2)])

#kpPlotDensity
kp <- kpPlotDensity(kp, data.panel=1, data=snps_Hifi, r0=0, r1=0.25, window.size=40000, border="#85C0F9", col="#85C0F9")
kpAxis(kp, data.panel=1, chr="chr3", ymax=kp$latest.plot$computed.values$max.density, r0=0, r1=0.25, cex=1.8)

#read WGS data
snps_WGS <- read.table("chr_3_snp_pos_def_WGS", sep="", header=FALSE)

#create GRange object
snps_WGS <- toGRanges(snps_WGS[,c(1,2,2)])

#kpPlotDensity
kp <- kpPlotDensity(kp, data.panel=1, data=snps_WGS, r0=0.35, r1=0.6, window.size=40000, border="#005AB5", col="#005AB5")
kpAxis(kp, data.panel=1, chr="chr3", ymax=kp$latest.plot$computed.values$max.density, r0=0.35, r1=0.6, cex=1.8)

#read ddRAD data
snps_ddRAD <- read.table("chr_3_snp_pos_def_ddRAD", sep="", header=FALSE)

#create GRange object
snps_ddRAD <- toGRanges(snps_ddRAD[,c(1,2,2)])

#kpPlotDensity
kp <- kpPlotDensity(kp, data.panel=1, data=snps_ddRAD, r0=0.7, r1=0.95, window.size=40000, border= "#DC3220", col= "#DC3220")
kpAxis(kp, data.panel=1, chr="chr3", ymax=kp$latest.plot$computed.values$max.density, r0=0.7, r1=0.95, cex=1.8)

#plot repeated regions as regions
repeats <- toGRanges("chr_3_masked_3000bp.bed")
kpPlotRegions(kp, data.panel=2, r0=autotrack(1,3), data=repeats, col="darkviolet")

#plot GC content as heatmaps
gc.cont <- toGRanges("chr_3_GC.txt")
kpHeatmap(kp, data.panel=2, r0=autotrack(2,3), data=gc.cont, y=gc.cont$V4, col=c("black","orange","#ed21ff"))

#plot Pacbiocoverage as heatmap using the viridis palette
Pacbio_cov <- toGRanges("chr_3_genomecov_500bp")
kpHeatmap(kp, data.panel=2, data=Pacbio_cov, y=Pacbio_cov$V4, r0=autotrack(3,3), col=viridis(5))

#plot gaps on ideogram as regions
gaps<-toGRanges("chr_3_gaps.bed")
kpPlotRegions(kp, data.panel="ideogram", data=gaps, col="black")

#chr_Z
#read Hifi data
snps_Hifi <- read.table("chr_Z_snp_pos_def_Hifi20X", sep="", header=FALSE)

#create GRange object
snps_Hifi <- toGRanges(snps_Hifi[,c(1,2,2)])

#kpPlotDensity
kp <- kpPlotDensity(kp, data.panel=1, data=snps_Hifi, r0=0, r1=0.25, window.size=40000, border="#85C0F9", col="#85C0F9")
kpAxis(kp, data.panel=1, chr="chrZ", ymax=kp$latest.plot$computed.values$max.density, r0=0, r1=0.25, cex=1.8)

#read WGS data
snps_WGS <- read.table("chr_Z_snp_pos_def_WGS", sep="", header=FALSE)

#create GRange object
snps_WGS <- toGRanges(snps_WGS[,c(1,2,2)])

#kpPlotDensity
kp <- kpPlotDensity(kp, data.panel=1, data=snps_WGS, r0=0.35, r1=0.6, window.size=40000, border="#005AB5", col="#005AB5")
kpAxis(kp, data.panel=1, chr="chrZ", ymax=kp$latest.plot$computed.values$max.density, r0=0.35, r1=0.6, cex=1.8)

#read ddRAD data
snps_ddRAD <- read.table("chr_Z_snp_pos_def_ddRAD", sep="", header=FALSE)

#create GRange object
snps_ddRAD <- toGRanges(snps_ddRAD[,c(1,2,2)])

#kpPlotDensity
kp <- kpPlotDensity(kp, data.panel=1, data=snps_ddRAD, r0=0.7, r1=0.95, window.size=40000, border= "#DC3220", col= "#DC3220")
kpAxis(kp, data.panel=1, chr="chrZ", ymax=kp$latest.plot$computed.values$max.density, r0=0.7, r1=0.95, cex=1.8)

#plot repeated regions as regions
repeats <- toGRanges("chr_Z_masked_3000bp.bed")
kpPlotRegions(kp, data.panel=2, r0=autotrack(1,3), data=repeats, col="darkviolet")

#plot GC content as heatmaps
gc.cont <- toGRanges("chr_Z_GC.txt")
kpHeatmap(kp, data.panel=2, r0=autotrack(2,3), data=gc.cont, y=gc.cont$V4, col=c("black","orange","#ed21ff"))

#plot Pacbiocoverage as heatmap using the viridis palette
Pacbio_cov <- toGRanges("chr_Z_genomecov_500bp")
kpHeatmap(kp, data.panel=2, data=Pacbio_cov, y=Pacbio_cov$V4, r0=autotrack(3,3), col=viridis(5))

#plot gaps on ideogram as regions
gaps<-toGRanges("chr_Z_gaps.bed")
kpPlotRegions(kp, data.panel="ideogram", data=gaps, col="black")

#chr_4
#read Hifi data
snps_Hifi <- read.table("chr_4_snp_pos_def_Hifi20X", sep="", header=FALSE)

#create GRange object
snps_Hifi <- toGRanges(snps_Hifi[,c(1,2,2)])

#kpPlotDensity
kp <- kpPlotDensity(kp, data.panel=1, data=snps_Hifi, r0=0, r1=0.25, window.size=40000, border="#85C0F9", col="#85C0F9")
kpAxis(kp, data.panel=1, chr="chr4", ymax=kp$latest.plot$computed.values$max.density, r0=0, r1=0.25, cex=1.8)

#read WGS data
snps_WGS <- read.table("chr_4_snp_pos_def_WGS", sep="", header=FALSE)

#create GRange object
snps_WGS <- toGRanges(snps_WGS[,c(1,2,2)])

#kpPlotDensity
kp <- kpPlotDensity(kp, data.panel=1, data=snps_WGS, r0=0.35, r1=0.6, window.size=40000, border="#005AB5", col="#005AB5")
kpAxis(kp, data.panel=1, chr="chr4", ymax=kp$latest.plot$computed.values$max.density, r0=0.35, r1=0.6, cex=1.8)

#read ddRAD data
snps_ddRAD <- read.table("chr_4_snp_pos_def_ddRAD", sep="", header=FALSE)

#create GRange object
snps_ddRAD <- toGRanges(snps_ddRAD[,c(1,2,2)])

#kpPlotDensity
kp <- kpPlotDensity(kp, data.panel=1, data=snps_ddRAD, r0=0.7, r1=0.95, window.size=40000, border= "#DC3220", col= "#DC3220")
kpAxis(kp, data.panel=1, chr="chr4", ymax=kp$latest.plot$computed.values$max.density, r0=0.7, r1=0.95, cex=1.8)

#plot repeated regions as regions
repeats <- toGRanges("chr_4_masked_3000bp.bed")
kpPlotRegions(kp, data.panel=2, r0=autotrack(1,3), data=repeats, col="darkviolet")

#plot GC content as heatmaps
gc.cont <- toGRanges("chr_4_GC.txt")
kpHeatmap(kp, data.panel=2, r0=autotrack(2,3), data=gc.cont, y=gc.cont$V4, col=c("black","orange","#ed21ff"))

#plot Pacbiocoverage as heatmap using the viridis palette
Pacbio_cov <- toGRanges("chr_4_genomecov_500bp")
kpHeatmap(kp, data.panel=2, data=Pacbio_cov, y=Pacbio_cov$V4, r0=autotrack(3,3), col=viridis(5))

#plot gaps on ideogram as regions
gaps<-toGRanges("chr_4_gaps.bed")
kpPlotRegions(kp, data.panel="ideogram", data=gaps, col="black")

#chr_5
#read Hifi data
snps_Hifi <- read.table("chr_5_snp_pos_def_Hifi20X", sep="", header=FALSE)

#create GRange object
snps_Hifi <- toGRanges(snps_Hifi[,c(1,2,2)])

#kpPlotDensity
kp <- kpPlotDensity(kp, data.panel=1, data=snps_Hifi, r0=0, r1=0.25, window.size=40000, border="#85C0F9", col="#85C0F9")
kpAxis(kp, data.panel=1, chr="chr5", ymax=kp$latest.plot$computed.values$max.density, r0=0, r1=0.25, cex=1.8)

#read WGS data
snps_WGS <- read.table("chr_5_snp_pos_def_WGS", sep="", header=FALSE)

#create GRange object
snps_WGS <- toGRanges(snps_WGS[,c(1,2,2)])

#kpPlotDensity
kp <- kpPlotDensity(kp, data.panel=1, data=snps_WGS, r0=0.35, r1=0.6, window.size=40000, border="#005AB5", col="#005AB5")
kpAxis(kp, data.panel=1, chr="chr5", ymax=kp$latest.plot$computed.values$max.density, r0=0.35, r1=0.6, cex=1.8)

#read ddRAD data
snps_ddRAD <- read.table("chr_5_snp_pos_def_ddRAD", sep="", header=FALSE)

#create GRange object
snps_ddRAD <- toGRanges(snps_ddRAD[,c(1,2,2)])

#kpPlotDensity
kp <- kpPlotDensity(kp, data.panel=1, data=snps_ddRAD, r0=0.7, r1=0.95, window.size=40000, border= "#DC3220", col= "#DC3220")
kpAxis(kp, data.panel=1, chr="chr5", ymax=kp$latest.plot$computed.values$max.density, r0=0.7, r1=0.95, cex=1.8)

#plot repeated regions as regions
repeats <- toGRanges("chr_5_masked_3000bp.bed")
kpPlotRegions(kp, data.panel=2, r0=autotrack(1,3), data=repeats, col="darkviolet")

#plot GC content as heatmaps
gc.cont <- toGRanges("chr_5_GC.txt")
kpHeatmap(kp, data.panel=2, r0=autotrack(2,3), data=gc.cont, y=gc.cont$V4, col=c("black","orange","#ed21ff"))

#plot Pacbiocoverage as heatmap using the viridis palette
Pacbio_cov <- toGRanges("chr_5_genomecov_500bp")
kpHeatmap(kp, data.panel=2, data=Pacbio_cov, y=Pacbio_cov$V4, r0=autotrack(3,3), col=viridis(5))

#plot gaps on ideogram as regions
gaps<-toGRanges("chr_5_gaps.bed")
kpPlotRegions(kp, data.panel="ideogram", data=gaps, col="black")

#chr_6
#read Hifi data
snps_Hifi <- read.table("chr_6_snp_pos_def_Hifi20X", sep="", header=FALSE)

#create GRange object
snps_Hifi <- toGRanges(snps_Hifi[,c(1,2,2)])

#kpPlotDensity
kp <- kpPlotDensity(kp, data.panel=1, data=snps_Hifi, r0=0, r1=0.25, window.size=40000, border="#85C0F9", col="#85C0F9")
kpAxis(kp, data.panel=1, chr="chr6", ymax=kp$latest.plot$computed.values$max.density, r0=0, r1=0.25, cex=1.8)

#read WGS data
snps_WGS <- read.table("chr_6_snp_pos_def_WGS", sep="", header=FALSE)

#create GRange object
snps_WGS <- toGRanges(snps_WGS[,c(1,2,2)])

#kpPlotDensity
kp <- kpPlotDensity(kp, data.panel=1, data=snps_WGS, r0=0.35, r1=0.6, window.size=40000, border="#005AB5", col="#005AB5")
kpAxis(kp, data.panel=1, chr="chr6", ymax=kp$latest.plot$computed.values$max.density, r0=0.35, r1=0.6, cex=1.8)

#read ddRAD data
snps_ddRAD <- read.table("chr_6_snp_pos_def_ddRAD", sep="", header=FALSE)

#create GRange object
snps_ddRAD <- toGRanges(snps_ddRAD[,c(1,2,2)])

#kpPlotDensity
kp <- kpPlotDensity(kp, data.panel=1, data=snps_ddRAD, r0=0.7, r1=0.95, window.size=40000, border= "#DC3220", col= "#DC3220")
kpAxis(kp, data.panel=1, chr="chr6", ymax=kp$latest.plot$computed.values$max.density, r0=0.7, r1=0.95, cex=1.8)

#plot repeated regions as regions
repeats <- toGRanges("chr_6_masked_3000bp.bed")
kpPlotRegions(kp, data.panel=2, r0=autotrack(1,3), data=repeats, col="darkviolet")

#plot GC content as heatmaps
gc.cont <- toGRanges("chr_6_GC.txt")
kpHeatmap(kp, data.panel=2, r0=autotrack(2,3), data=gc.cont, y=gc.cont$V4, col=c("black","orange","#ed21ff"))

#plot Pacbiocoverage as heatmap using the viridis palette
Pacbio_cov <- toGRanges("chr_6_genomecov_500bp")
kpHeatmap(kp, data.panel=2, data=Pacbio_cov, y=Pacbio_cov$V4, r0=autotrack(3,3), col=viridis(5))

#plot gaps on ideogram as regions
gaps<-toGRanges("chr_6_gaps.bed")
kpPlotRegions(kp, data.panel="ideogram", data=gaps, col="black")

#chr_7
#read Hifi data
snps_Hifi <- read.table("chr_7_snp_pos_def_Hifi20X", sep="", header=FALSE)

#create GRange object
snps_Hifi <- toGRanges(snps_Hifi[,c(1,2,2)])

#kpPlotDensity
kp <- kpPlotDensity(kp, data.panel=1, data=snps_Hifi, r0=0, r1=0.25, window.size=40000, border="#85C0F9", col="#85C0F9")
kpAxis(kp, data.panel=1, chr="chr7", ymax=kp$latest.plot$computed.values$max.density, r0=0, r1=0.25, cex=1.8)

#read WGS data
snps_WGS <- read.table("chr_7_snp_pos_def_WGS", sep="", header=FALSE)

#create GRange object
snps_WGS <- toGRanges(snps_WGS[,c(1,2,2)])

#kpPlotDensity
kp <- kpPlotDensity(kp, data.panel=1, data=snps_WGS, r0=0.35, r1=0.6, window.size=40000, border="#005AB5", col="#005AB5")
kpAxis(kp, data.panel=1, chr="chr7", ymax=kp$latest.plot$computed.values$max.density, r0=0.35, r1=0.6, cex=1.8)

#read ddRAD data
snps_ddRAD <- read.table("chr_7_snp_pos_def_ddRAD", sep="", header=FALSE)

#create GRange object
snps_ddRAD <- toGRanges(snps_ddRAD[,c(1,2,2)])

#kpPlotDensity
kp <- kpPlotDensity(kp, data.panel=1, data=snps_ddRAD, r0=0.7, r1=0.95, window.size=40000, border= "#DC3220", col= "#DC3220")
kpAxis(kp, data.panel=1, chr="chr7", ymax=kp$latest.plot$computed.values$max.density, r0=0.7, r1=0.95, cex=1.8)

#plot repeated regions as regions
repeats <- toGRanges("chr_7_masked_3000bp.bed")
kpPlotRegions(kp, data.panel=2, r0=autotrack(1,3), data=repeats, col="darkviolet")

#plot GC content as heatmaps
gc.cont <- toGRanges("chr_7_GC.txt")
kpHeatmap(kp, data.panel=2, r0=autotrack(2,3), data=gc.cont, y=gc.cont$V4, col=c("black","orange","#ed21ff"))

#plot Pacbiocoverage as heatmap using the viridis palette
Pacbio_cov <- toGRanges("chr_7_genomecov_500bp")
kpHeatmap(kp, data.panel=2, data=Pacbio_cov, y=Pacbio_cov$V4, r0=autotrack(3,3), col=viridis(5))

#plot gaps on ideogram as regions
gaps<-toGRanges("chr_7_gaps.bed")
kpPlotRegions(kp, data.panel="ideogram", data=gaps, col="black")

#chr_8
#read Hifi data
snps_Hifi <- read.table("chr_8_snp_pos_def_Hifi20X", sep="", header=FALSE)

#create GRange object
snps_Hifi <- toGRanges(snps_Hifi[,c(1,2,2)])

#kpPlotDensity
kp <- kpPlotDensity(kp, data.panel=1, data=snps_Hifi, r0=0, r1=0.25, window.size=40000, border="#85C0F9", col="#85C0F9")
kpAxis(kp, data.panel=1, chr="chr8", ymax=kp$latest.plot$computed.values$max.density, r0=0, r1=0.25, cex=1.8)

#read WGS data
snps_WGS <- read.table("chr_8_snp_pos_def_WGS", sep="", header=FALSE)

#create GRange object
snps_WGS <- toGRanges(snps_WGS[,c(1,2,2)])

#kpPlotDensity
kp <- kpPlotDensity(kp, data.panel=1, data=snps_WGS, r0=0.35, r1=0.6, window.size=40000, border="#005AB5", col="#005AB5")
kpAxis(kp, data.panel=1, chr="chr8", ymax=kp$latest.plot$computed.values$max.density, r0=0.35, r1=0.6, cex=1.8)

#read ddRAD data
snps_ddRAD <- read.table("chr_8_snp_pos_def_ddRAD", sep="", header=FALSE)

#create GRange object
snps_ddRAD <- toGRanges(snps_ddRAD[,c(1,2,2)])

#kpPlotDensity
kp <- kpPlotDensity(kp, data.panel=1, data=snps_ddRAD, r0=0.7, r1=0.95, window.size=40000, border= "#DC3220", col= "#DC3220")
kpAxis(kp, data.panel=1, chr="chr8", ymax=kp$latest.plot$computed.values$max.density, r0=0.7, r1=0.95, cex=1.8)

#plot repeated regions as regions
repeats <- toGRanges("chr_8_masked_3000bp.bed")
kpPlotRegions(kp, data.panel=2, r0=autotrack(1,3), data=repeats, col="darkviolet")

#plot GC content as heatmaps
gc.cont <- toGRanges("chr_8_GC.txt")
kpHeatmap(kp, data.panel=2, r0=autotrack(2,3), data=gc.cont, y=gc.cont$V4, col=c("black","orange","#ed21ff"))

#plot Pacbiocoverage as heatmap using the viridis palette
Pacbio_cov <- toGRanges("chr_8_genomecov_500bp")
kpHeatmap(kp, data.panel=2, data=Pacbio_cov, y=Pacbio_cov$V4, r0=autotrack(3,3), col=viridis(5))

#plot gaps on ideogram as regions
gaps<-toGRanges("chr_8_gaps.bed")
kpPlotRegions(kp, data.panel="ideogram", data=gaps, col="black")

#chr_W
#read Hifi data
snps_Hifi <- read.table("chr_W_snp_pos_def_Hifi20X", sep="", header=FALSE)

#create GRange object
snps_Hifi <- toGRanges(snps_Hifi[,c(1,2,2)])

#kpPlotDensity
kp <- kpPlotDensity(kp, data.panel=1, data=snps_Hifi, r0=0, r1=0.25, window.size=40000, border="#85C0F9", col="#85C0F9")
kpAxis(kp, data.panel=1, chr="chrW", ymax=kp$latest.plot$computed.values$max.density, r0=0, r1=0.25, cex=1.8)

#read WGS data
snps_WGS <- read.table("chr_W_snp_pos_def_WGS", sep="", header=FALSE)

#create GRange object
snps_WGS <- toGRanges(snps_WGS[,c(1,2,2)])

#kpPlotDensity
kp <- kpPlotDensity(kp, data.panel=1, data=snps_WGS, r0=0.35, r1=0.6, window.size=40000, border="#005AB5", col="#005AB5")
kpAxis(kp, data.panel=1, chr="chrW", ymax=kp$latest.plot$computed.values$max.density, r0=0.35, r1=0.6, cex=1.8)

#read ddRAD data
snps_ddRAD <- read.table("chr_W_snp_pos_def_ddRAD", sep="", header=FALSE)

#create GRange object
snps_ddRAD <- toGRanges(snps_ddRAD[,c(1,2,2)])

#kpPlotDensity
kp <- kpPlotDensity(kp, data.panel=1, data=snps_ddRAD, r0=0.7, r1=0.95, window.size=40000, border= "#DC3220", col= "#DC3220")
kpAxis(kp, data.panel=1, chr="chrW", ymax=kp$latest.plot$computed.values$max.density, r0=0.7, r1=0.95, cex=1.8)

#plot repeated regions as regions
repeats <- toGRanges("chr_W_masked_3000bp.bed")
kpPlotRegions(kp, data.panel=2, r0=autotrack(1,3), data=repeats, col="darkviolet")

#plot GC content as heatmaps
gc.cont <- toGRanges("chr_W_GC.txt")
kpHeatmap(kp, data.panel=2, r0=autotrack(2,3), data=gc.cont, y=gc.cont$V4, col=c("black","orange","#ed21ff"))

#plot Pacbiocoverage as heatmap using the viridis palette
Pacbio_cov <- toGRanges("chr_W_genomecov_500bp")
kpHeatmap(kp, data.panel=2, data=Pacbio_cov, y=Pacbio_cov$V4, r0=autotrack(3,3), col=viridis(5))

#plot gaps on ideogram as regions
gaps<-toGRanges("chr_W_gaps.bed")
kpPlotRegions(kp, data.panel="ideogram", data=gaps, col="black")

#chr_9
#read Hifi data
snps_Hifi <- read.table("chr_9_snp_pos_def_Hifi20X", sep="", header=FALSE)

#create GRange object
snps_Hifi <- toGRanges(snps_Hifi[,c(1,2,2)])

#kpPlotDensity
kp <- kpPlotDensity(kp, data.panel=1, data=snps_Hifi, r0=0, r1=0.25, window.size=40000, border="#85C0F9", col="#85C0F9")
kpAxis(kp, data.panel=1, chr="chr9", ymax=kp$latest.plot$computed.values$max.density, r0=0, r1=0.25, cex=1.8)

#read WGS data
snps_WGS <- read.table("chr_9_snp_pos_def_WGS", sep="", header=FALSE)

#create GRange object
snps_WGS <- toGRanges(snps_WGS[,c(1,2,2)])

#kpPlotDensity
kp <- kpPlotDensity(kp, data.panel=1, data=snps_WGS, r0=0.35, r1=0.6, window.size=40000, border="#005AB5", col="#005AB5")
kpAxis(kp, data.panel=1, chr="chr9", ymax=kp$latest.plot$computed.values$max.density, r0=0.35, r1=0.6, cex=1.8)

#read ddRAD data
snps_ddRAD <- read.table("chr_9_snp_pos_def_ddRAD", sep="", header=FALSE)

#create GRange object
snps_ddRAD <- toGRanges(snps_ddRAD[,c(1,2,2)])

#kpPlotDensity
kp <- kpPlotDensity(kp, data.panel=1, data=snps_ddRAD, r0=0.7, r1=0.95, window.size=40000, border= "#DC3220", col= "#DC3220")
kpAxis(kp, data.panel=1, chr="chr9", ymax=kp$latest.plot$computed.values$max.density, r0=0.7, r1=0.95, cex=1.8)

#plot repeated regions as regions
repeats <- toGRanges("chr_9_masked_3000bp.bed")
kpPlotRegions(kp, data.panel=2, r0=autotrack(1,3), data=repeats, col="darkviolet")

#plot GC content as heatmaps
gc.cont <- toGRanges("chr_9_GC.txt")
kpHeatmap(kp, data.panel=2, r0=autotrack(2,3), data=gc.cont, y=gc.cont$V4, col=c("black","orange","#ed21ff"))

#plot Pacbiocoverage as heatmap using the viridis palette
Pacbio_cov <- toGRanges("chr_9_genomecov_500bp")
kpHeatmap(kp, data.panel=2, data=Pacbio_cov, y=Pacbio_cov$V4, r0=autotrack(3,3), col=viridis(5))

#plot gaps on ideogram as regions
gaps<-toGRanges("chr_9_gaps.bed")
kpPlotRegions(kp, data.panel="ideogram", data=gaps, col="black")

#chr_10
#read Hifi data
snps_Hifi <- read.table("chr_10_snp_pos_def_Hifi20X", sep="", header=FALSE)

#create GRange object
snps_Hifi <- toGRanges(snps_Hifi[,c(1,2,2)])

#kpPlotDensity
kp <- kpPlotDensity(kp, data.panel=1, data=snps_Hifi, r0=0, r1=0.25, window.size=40000, border="#85C0F9", col="#85C0F9")
kpAxis(kp, data.panel=1, chr="chr10", ymax=kp$latest.plot$computed.values$max.density, r0=0, r1=0.25, cex=1.8)

#read WGS data
snps_WGS <- read.table("chr_10_snp_pos_def_WGS", sep="", header=FALSE)

#create GRange object
snps_WGS <- toGRanges(snps_WGS[,c(1,2,2)])

#kpPlotDensity
kp <- kpPlotDensity(kp, data.panel=1, data=snps_WGS, r0=0.35, r1=0.6, window.size=40000, border="#005AB5", col="#005AB5")
kpAxis(kp, data.panel=1, chr="chr10", ymax=kp$latest.plot$computed.values$max.density, r0=0.35, r1=0.6, cex=1.8)

#read ddRAD data
snps_ddRAD <- read.table("chr_10_snp_pos_def_ddRAD", sep="", header=FALSE)

#create GRange object
snps_ddRAD <- toGRanges(snps_ddRAD[,c(1,2,2)])

#kpPlotDensity
kp <- kpPlotDensity(kp, data.panel=1, data=snps_ddRAD, r0=0.7, r1=0.95, window.size=40000, border= "#DC3220", col= "#DC3220")
kpAxis(kp, data.panel=1, chr="chr10", ymax=kp$latest.plot$computed.values$max.density, r0=0.7, r1=0.95, cex=1.8)

#plot repeated regions as regions
repeats <- toGRanges("chr_10_masked_3000bp.bed")
kpPlotRegions(kp, data.panel=2, r0=autotrack(1,3), data=repeats, col="darkviolet")

#plot GC content as heatmaps
gc.cont <- toGRanges("chr_10_GC.txt")
kpHeatmap(kp, data.panel=2, r0=autotrack(2,3), data=gc.cont, y=gc.cont$V4, col=c("black","orange","#ed21ff"))

#plot Pacbiocoverage as heatmap using the viridis palette
Pacbio_cov <- toGRanges("chr_10_genomecov_500bp")
kpHeatmap(kp, data.panel=2, data=Pacbio_cov, y=Pacbio_cov$V4, r0=autotrack(3,3), col=viridis(5))

#plot gaps on ideogram as regions
gaps<-toGRanges("chr_10_gaps.bed")
kpPlotRegions(kp, data.panel="ideogram", data=gaps, col="black")

#chr_11
#read Hifi data
snps_Hifi <- read.table("chr_11_snp_pos_def_Hifi20X", sep="", header=FALSE)

#create GRange object
snps_Hifi <- toGRanges(snps_Hifi[,c(1,2,2)])

#kpPlotDensity
kp <- kpPlotDensity(kp, data.panel=1, data=snps_Hifi, r0=0, r1=0.25, window.size=40000, border="#85C0F9", col="#85C0F9")
kpAxis(kp, data.panel=1, chr="chr11", ymax=kp$latest.plot$computed.values$max.density, r0=0, r1=0.25, cex=1.8)

#read WGS data
snps_WGS <- read.table("chr_11_snp_pos_def_WGS", sep="", header=FALSE)

#create GRange object
snps_WGS <- toGRanges(snps_WGS[,c(1,2,2)])

#kpPlotDensity
kp <- kpPlotDensity(kp, data.panel=1, data=snps_WGS, r0=0.35, r1=0.6, window.size=40000, border="#005AB5", col="#005AB5")
kpAxis(kp, data.panel=1, chr="chr11", ymax=kp$latest.plot$computed.values$max.density, r0=0.35, r1=0.6, cex=1.8)

#read ddRAD data
snps_ddRAD <- read.table("chr_11_snp_pos_def_ddRAD", sep="", header=FALSE)

#create GRange object
snps_ddRAD <- toGRanges(snps_ddRAD[,c(1,2,2)])

#kpPlotDensity
kp <- kpPlotDensity(kp, data.panel=1, data=snps_ddRAD, r0=0.7, r1=0.95, window.size=40000, border= "#DC3220", col= "#DC3220")
kpAxis(kp, data.panel=1, chr="chr11", ymax=kp$latest.plot$computed.values$max.density, r0=0.7, r1=0.95, cex=1.8)

#plot repeated regions as regions
repeats <- toGRanges("chr_11_masked_3000bp.bed")
kpPlotRegions(kp, data.panel=2, r0=autotrack(1,3), data=repeats, col="darkviolet")

#plot GC content as heatmaps
gc.cont <- toGRanges("chr_11_GC.txt")
kpHeatmap(kp, data.panel=2, r0=autotrack(2,3), data=gc.cont, y=gc.cont$V4, col=c("black","orange","#ed21ff"))

#plot Pacbiocoverage as heatmap using the viridis palette
Pacbio_cov <- toGRanges("chr_11_genomecov_500bp")
kpHeatmap(kp, data.panel=2, data=Pacbio_cov, y=Pacbio_cov$V4, r0=autotrack(3,3), col=viridis(5))

#plot gaps on ideogram as regions
gaps<-toGRanges("chr_11_gaps.bed")
kpPlotRegions(kp, data.panel="ideogram", data=gaps, col="black")

#chr_12
#read Hifi data
snps_Hifi <- read.table("chr_12_snp_pos_def_Hifi20X", sep="", header=FALSE)

#create GRange object
snps_Hifi <- toGRanges(snps_Hifi[,c(1,2,2)])

#kpPlotDensity
kp <- kpPlotDensity(kp, data.panel=1, data=snps_Hifi, r0=0, r1=0.25, window.size=40000, border="#85C0F9", col="#85C0F9")
kpAxis(kp, data.panel=1, chr="chr12", ymax=kp$latest.plot$computed.values$max.density, r0=0, r1=0.25, cex=1.8)

#read WGS data
snps_WGS <- read.table("chr_12_snp_pos_def_WGS", sep="", header=FALSE)

#create GRange object
snps_WGS <- toGRanges(snps_WGS[,c(1,2,2)])

#kpPlotDensity
kp <- kpPlotDensity(kp, data.panel=1, data=snps_WGS, r0=0.35, r1=0.6, window.size=40000, border="#005AB5", col="#005AB5")
kpAxis(kp, data.panel=1, chr="chr12", ymax=kp$latest.plot$computed.values$max.density, r0=0.35, r1=0.6, cex=1.8)

#read ddRAD data
snps_ddRAD <- read.table("chr_12_snp_pos_def_ddRAD", sep="", header=FALSE)

#create GRange object
snps_ddRAD <- toGRanges(snps_ddRAD[,c(1,2,2)])

#kpPlotDensity
kp <- kpPlotDensity(kp, data.panel=1, data=snps_ddRAD, r0=0.7, r1=0.95, window.size=40000, border= "#DC3220", col= "#DC3220")
kpAxis(kp, data.panel=1, chr="chr12", ymax=kp$latest.plot$computed.values$max.density, r0=0.7, r1=0.95, cex=1.8)

#plot repeated regions as regions
repeats <- toGRanges("chr_12_masked_3000bp.bed")
kpPlotRegions(kp, data.panel=2, r0=autotrack(1,3), data=repeats, col="darkviolet")

#plot GC content as heatmaps
gc.cont <- toGRanges("chr_12_GC.txt")
kpHeatmap(kp, data.panel=2, r0=autotrack(2,3), data=gc.cont, y=gc.cont$V4, col=c("black","orange","#ed21ff"))

#plot Pacbiocoverage as heatmap using the viridis palette
Pacbio_cov <- toGRanges("chr_12_genomecov_500bp")
kpHeatmap(kp, data.panel=2, data=Pacbio_cov, y=Pacbio_cov$V4, r0=autotrack(3,3), col=viridis(5))

#plot gaps on ideogram as regions
gaps<-toGRanges("chr_12_gaps.bed")
kpPlotRegions(kp, data.panel="ideogram", data=gaps, col="black")

#chr_13
#read Hifi data
snps_Hifi <- read.table("chr_13_snp_pos_def_Hifi20X", sep="", header=FALSE)

#create GRange object
snps_Hifi <- toGRanges(snps_Hifi[,c(1,2,2)])

#kpPlotDensity
kp <- kpPlotDensity(kp, data.panel=1, data=snps_Hifi, r0=0, r1=0.25, window.size=40000, border="#85C0F9", col="#85C0F9")
kpAxis(kp, data.panel=1, chr="chr13", ymax=kp$latest.plot$computed.values$max.density, r0=0, r1=0.25, cex=1.8)

#read WGS data
snps_WGS <- read.table("chr_13_snp_pos_def_WGS", sep="", header=FALSE)

#create GRange object
snps_WGS <- toGRanges(snps_WGS[,c(1,2,2)])

#kpPlotDensity
kp <- kpPlotDensity(kp, data.panel=1, data=snps_WGS, r0=0.35, r1=0.6, window.size=40000, border="#005AB5", col="#005AB5")
kpAxis(kp, data.panel=1, chr="chr13", ymax=kp$latest.plot$computed.values$max.density, r0=0.35, r1=0.6, cex=1.8)

#read ddRAD data
snps_ddRAD <- read.table("chr_13_snp_pos_def_ddRAD", sep="", header=FALSE)

#create GRange object
snps_ddRAD <- toGRanges(snps_ddRAD[,c(1,2,2)])

#kpPlotDensity
kp <- kpPlotDensity(kp, data.panel=1, data=snps_ddRAD, r0=0.7, r1=0.95, window.size=40000, border= "#DC3220", col= "#DC3220")
kpAxis(kp, data.panel=1, chr="chr13", ymax=kp$latest.plot$computed.values$max.density, r0=0.7, r1=0.95, cex=1.8)

#plot repeated regions as regions
repeats <- toGRanges("chr_13_masked_3000bp.bed")
kpPlotRegions(kp, data.panel=2, r0=autotrack(1,3), data=repeats, col="darkviolet")

#plot GC content as heatmaps
gc.cont <- toGRanges("chr_13_GC.txt")
kpHeatmap(kp, data.panel=2, r0=autotrack(2,3), data=gc.cont, y=gc.cont$V4, col=c("black","orange","#ed21ff"))

#plot Pacbiocoverage as heatmap using the viridis palette
Pacbio_cov <- toGRanges("chr_13_genomecov_500bp")
kpHeatmap(kp, data.panel=2, data=Pacbio_cov, y=Pacbio_cov$V4, r0=autotrack(3,3), col=viridis(5))

#plot gaps on ideogram as regions
gaps<-toGRanges("chr_13_gaps.bed")
kpPlotRegions(kp, data.panel="ideogram", data=gaps, col="black")


# Set up and run Prioritizr with zones to simulate CMSP
# Fixed budget across a range of weight present vs. future to get an efficiency frontier
# set up to source from within R 3.5.3: source('code/5.1_prioritizr.r')
# May need to set R_MAX_VSIZE=60000000 or larger in .Renviron to avoid hitting memory limits (Sys.getenv('R_MAX_VSIZE') to query)

#############
## Parameters
#############

# choose the rcps
# will use both for first planning period
# will use only the second for the second planning period
rcps <- c(26, 85)

# choose the climate models to use for future planning
#bcc-csm1-1-m, bcc-csm1-1, CanESM2, CCSM4, CESM1-CAM5, CNRM-CM5, GFDL-CM3, GFDL-ESM2M, GFDL-ESM2G, GISS-E2-R, GISS-E2-H, IPSL-CM5A-LR, IPSL-CM5A-MR, MIROC-ESM, MPI-ESM-LR, NorESM1-ME
gcminds <- c(1, 2, 3, 4, 8, 9, 10, 14) # from running sample(1:16, 8)

# CMSP goals
consgoal <- 0.1 # proportion of presences to capture in conservation
energygoal <- 0.2 # proportion of NPV
fishgoal <- 0.5 # proportion of biomass
cost <- 0.01 # basic cost of including each planning unit in a given zone

# oceans to read in
oceans <- c('Atl', 'Pac')

# choose region and name these runs
myregs <- c('ebs', 'goa', 'bc', 'wc', 'gmex', 'seus', 'neus', 'maritime', 'newf')

# which time periods to use in the multi-period planning
# contemporary time period must be in first slot, second time period must be the future
planningperiods <- c('2007-2020', '2081-2100')

# how many budget levels to examine
nbudget <- 2
minbudget <- 0.75
maxbudget <- 0.90

# how many weights to examine (linear scale)
nweight <- 91
minweight <- 0
maxweight <- 100

# set output name
outname <- paste0('temp/frontierall_', format(Sys.time(), "%Y-%m-%d_%H%M%S"), '.csv')

# optimality gap, number of threads, and time limit for gurobi solver
gap <- 0.01
nthread <- 2
timelimit <- 1200 # seconds

######################
# Functions
######################
require(data.table)
library(prioritizr) # only runs in R 3.5.3 for now (Gurobi 8.1.1)

#####################
## Load data
#####################

# loads presence/absence and biomass data
if(!(length(rcps) %in% c(1,2))){
	stop('rcp must be length 1 or 2')
}
for (i in 1:length(rcps)){
    print(paste0('Loading rcp', rcps[i]))

    for(j in 1:length(oceans)){
        for(k in 1:length(planningperiods)){
            # do both RCPs for first planning period. Do only 2nd rcp for 2nd planning period.
            if(k == 1 | (k == 2 & i == 2)){
                print(paste(oceans[j], planningperiods[k]))
                prestemp <- fread(cmd = paste0('gunzip -c temp/presmap_', oceans[j], '_rcp', rcps[i], '_', planningperiods[k], '.csv.gz'), drop = 1)
                biotemp <- fread(cmd = paste0('gunzip -c temp/biomassmap_', oceans[j], '_rcp', rcps[i], '_', planningperiods[k], '.csv.gz'), drop = 1)

                # calculate ensemble mean across training GCMs and remaining RCPs
                prestemp <- prestemp[model %in% c(1:16)[gcminds], .(poccur = mean(poccur)), by = c('latgrid', 'longrid', 'year_range', 'rcp', 'spp')]
                biotemp <- biotemp[model %in% c(1:16)[gcminds], .(biomass = mean(biomass)), by = c('latgrid', 'longrid', 'year_range', 'rcp', 'spp')]

                if(i == 1 & j == 1 & k == 1){
                    presmap <- prestemp
                    biomassmap <- biotemp
                } else {
                    presmap <- rbind(presmap, prestemp)
                    biomassmap <- rbind(biomassmap, biotemp)
                }
            }
        }
    }
}
rm(prestemp, biotemp)

# average across the rcps
presmap <- presmap[, .(poccur = mean(poccur)), by = c('latgrid', 'longrid', 'year_range', 'spp')]
biomassmap <- biomassmap[, .(biomass = mean(biomass)), by = c('latgrid', 'longrid', 'year_range', 'spp')]

# poccur threshold: how high does the probability of occurrence in the projections need to be to consider the species "present"?
# use the thresholds calculated during model fitting from Morley et al. 2018 PLOS ONE
poccurthresh <- fread('https://raw.githubusercontent.com/pinskylab/project_velocity/master/output/modeldiag_Nov2017_fitallreg_2017.csv', drop = 1)[, .(sppocean, thresh.kappa)]

# load NatCap calculations
windnpv <- fread(cmd = 'gunzip -c output/wind_npv.csv.gz', drop = 1)
wavenpv <- fread(cmd = 'gunzip -c output/wave_npv.csv.gz', drop = 1)

setnames(windnpv, c('lat', 'lon', 'npv'), c('latgrid', 'longrid', 'wind_npv'))
setnames(wavenpv, c('lat', 'lon', 'npv'), c('latgrid', 'longrid', 'wave_npv'))

# definition of fishery species by region
fisheryspps <- fread('output/fishery_spps.csv', drop = 1) # which spp to include in fishery goal in each region

# region definitions
regiongrid <- fread(cmd = 'gunzip -c output/region_grid.csv.gz', drop = 1)

################################
## Set up data for any region
################################

# Fix lon in regiongrid to match presmap (-360 to 0)
regiongrid[longrid > 0, longrid := longrid - 360]

# Add region information to presmap
setkey(presmap, latgrid, longrid)
setkey(regiongrid, latgrid, longrid)
presmap <- merge(presmap, regiongrid[, .(latgrid, longrid, region)], all.x = TRUE) # add region information
if(presmap[is.na(region) & !duplicated(presmap[,.(latgrid, longrid)]), .N] != 0){ # 0 missing region: good!
	stop('presmap is missing >0 regions')
}
    # presmap[is.na(region) & !duplicated(presmap[,.(latgrid, longrid)]), ]
    # presmap[is.na(region) & !duplicated(presmap[,.(latgrid, longrid)]), plot(longrid, latgrid)]

# Add region information to biomassmap
setkey(biomassmap, latgrid, longrid)
setkey(regiongrid, latgrid, longrid)
biomassmap <- merge(biomassmap, regiongrid[, .(latgrid, longrid, region)], all.x = TRUE) # add region information
if(biomassmap[is.na(region) & !duplicated(biomassmap[,.(latgrid, longrid)]), .N] != 0){ # 0 missing region: good!
	stop('biomassmap is missing >0 regions')
}

# Add poccur threshold to presmap
poccurthresh[, ocean := gsub('.*_', '', sppocean)]
poccurthresh[, spp := gsub('_Atl|_Pac', '', sppocean)]
presmapPac <- merge(presmap[region %in% c('ebs', 'goa', 'bc', 'wc'), ], poccurthresh[ocean == 'Pac', .(spp, thresh.kappa)], by = 'spp') # have to do Atl and Pac separately since some species are in both regions but use different models
presmapAtl <- merge(presmap[region %in% c('gmex', 'seus', 'neus', 'maritime', 'newf'), ], poccurthresh[ocean == 'Atl', .(spp, thresh.kappa)], by = 'spp')
if(nrow(presmap) == nrow(presmapPac) + nrow(presmapAtl)){
    presmap <- rbind(presmapPac, presmapAtl)
    rm(presmapPac, presmapAtl)
} else {
    stop('merge of poccurthesh and presmap did not work')
}

# Fix a species name
# ALSO DORYTEUTHIS/LOLIGO PEALEII?
presmap[spp == 'theragra chalcogramma', spp := 'gadus chalcogrammus']

# zones
# id and names for each zone
zones <- data.frame(id = 1:3, name = c('conservation', 'fishery', 'energy'))

############################
# Run prioritizr
# Fixed budget
#############################

for (i in 1:length(myregs)) {
    print(paste0('Starting region ', myregs[i]))
	print(Sys.time())

    ###############################
    # Set up data for this region
    ###############################

    # pus
    # planning features are each 1/4 deg square
    pus <- presmap[region == myregs[i], c('latgrid', 'longrid')]
    pus <- pus[!duplicated(pus),]
    	dim(pus) # 2195 (ebs), 795 (goa), (bc), (wc), 651 (gomex), (seus), (neus), (maritime), (newf)
    if(nrow(pus) == 0) stop('pus has length zero')
    pus <- pus[order(pus$latgrid, pus$longrid),]
    pus$id <- 1:nrow(pus)
    pus$dummycost <- rep(cost, nrow(pus)) # set the same cost in each planning unit. can add separate costs for each zone.

    ############################################
    ## Run prioritizr on 2007-2020 and 2081-2100
    ############################################

    # spps
    # id and name for each species
    # fishery features entered separately from conservation features, even if same species
    # plan on ensemble mean of all climate models for the current time-period
    	sppstokeep <- presmap[region == myregs[i] & year_range == planningperiods[1], .(poccur = mean(poccur)), by = c('latgrid', 'longrid', 'spp', 'thresh.kappa')] # average across models
    		dim(sppstokeep)
    	sppstokeep <- sppstokeep[poccur >= thresh.kappa, ]
    	sppstokeep <- merge(sppstokeep, pus[, .(latgrid, longrid, id)], by = c('latgrid', 'longrid')) # add pu id (and trim to focal pus)
    		setnames(sppstokeep, 'id', 'pu')
    		dim(sppstokeep)

    		ngrid <- sppstokeep[ , .(ngrid = length(unique(pu))), by = 'spp']
    		sppstokeep <- merge(sppstokeep, ngrid, by = 'spp')
    		sppstokeep[ , summary(ngrid)] #

    		nspps <- sppstokeep[ , .(nspp = length(unique(spp))), by = 'pu']
    		sppstokeep <- merge(sppstokeep, nspps, by = 'pu')
    		sppstokeep[, summary(nspp)] #

    		sppstokeep <- sppstokeep[ngrid >= (nrow(pus)*0.05),] # trim to species found at poccur > poccurthresh in at least 5% of grids

    		sppstokeep[ , length(unique(spp))]

    	spps <- data.table(id = 1:length(unique(sppstokeep$spp)), name = gsub(' |_', '', sort(unique(sppstokeep$spp))), spp = sort(unique(sppstokeep$spp))) #  fill spaces in species names.

    	# add fishery features
    	spps <- rbind(spps, data.table(id = max(spps$id) + 1:fisheryspps[region == myregs[i], length(projname)],
    	                               name = paste0(gsub(' |_', '', fisheryspps[region == myregs[i], projname]), '_fishery'),
    	                               spp = fisheryspps[region == myregs[i], projname]))

    	# add wind and wave energy feature
    	spps <- rbind(spps, data.table(id = max(spps$id) + 1, name = c('energy'), spp = c(NA)))

	    # add future species (2081-2100)
    	sppinds <- !grepl('energy', spps$name) # don't include energy in each time period
    	temp1 <- spps[sppinds,]
    	spps$name[sppinds] <- paste0(spps$name[sppinds], gsub('-', '', planningperiods[1]))
    	temp1$name <- paste0(temp1$name, gsub('-', '', planningperiods[2]))
    	temp1$id = temp1$id + max(spps$id) # make sure the ids don't overlap
    	spps <- rbind(spps, temp1)

    # puvsp
    # which features are in each planning unit
    	# Format conservation data
    	puvsppa <- presmap[region == myregs[i] & year_range == planningperiods[1], .(poccur = mean(poccur)), by = c('latgrid', 'longrid', 'spp', 'thresh.kappa')] # pres/abs data.
    		dim(puvsppa)
    	puvsppa[, amount := as.numeric(poccur >= thresh.kappa)] # use pres/abs as conservation amount.
    	    puvsppa[, summary(amount)]
    	    puvsppa[, sort(unique(amount))]
    	puvsppa[, poccur := NULL]
    	puvsppa[ , name := paste0(gsub(' |_', '', spp), gsub('-', '', planningperiods[1]))] # trim out spaces from species names and append time period

        # Format fishery data
        puvspbio <- biomassmap[region == myregs[i] & year_range == planningperiods[1] & spp %in% fisheryspps[region == myregs[i], projname], .(biomass = mean(biomass)), by = c('latgrid', 'longrid', 'spp')] # biomass data.
            dim(puvspbio)
            puvspbio[, length(unique(spp))] # should be 10
        puvspbio[, amount := biomass] # use biomass as amount for fishery targets
        puvspbio[ , name := paste0(gsub(' |_', '', spp), '_fishery', gsub('-', '', planningperiods[1]))] # trim out spaces from species names, append fishery

    	# Format wind and wave data
    	puvenergy <- merge(windnpv, wavenpv, by = c('latgrid', 'longrid'), all = TRUE)
    		head(puvenergy)
    		dim(windnpv)
    		dim(wavenpv)
    		dim(puvenergy)
    	puvenergy[wind_npv < 0 | is.na(wind_npv), wind_npv := 0] # set negative or NA NPV to 0
    	puvenergy[wave_npv < 0 | is.na(wave_npv), wave_npv := 0]
    	puvenergy[, amount := (wind_npv + wave_npv)/10000] # scale down to pass presolve checks
    	puvenergy[, name := 'energy']

    	# combine
    	puvsp <- rbind(puvsppa[, .(name, latgrid, longrid, amount, zone = 1)],
    	               puvspbio[, .(name, latgrid, longrid, amount, zone = 2)],
    	               puvenergy[, .(name, latgrid, longrid, amount, zone = 3)])

    	# Add species ids
    	nrow(puvsp)
    	puvsp <- merge(puvsp, spps[, .(id, name)], by = 'name') # merge in species IDs and trim to focal species
    	nrow(puvsp)
    	setnames(puvsp, 'id', 'species')

        # Add planning units
        puvsp <- merge(puvsp, pus[, .(latgrid, longrid, id)], by = c('latgrid', 'longrid')) # add pu id (and trim to focal pus)
    	nrow(puvsp)
    	setnames(puvsp, 'id', 'pu')

    	# Check fishery species for adequate biomass and scale up if needed
    	# Makes sure that no fishery species are eliminated by the next section checking for amount < 1e6
        fishtotals <- puvsp[grepl('fishery', name), .(total = sum(amount), name = unique(name)), by = 'species']
    	for(j in which(fishtotals[, total != 1])){
    	    scalar <- 1/fishtotals[j, total] # scale up so sum would be 1
    	    puvsp[species == fishtotals[j, species], amount := amount * scalar]
    	}

    	# Trim out values < 1e-6 (will throw error in prioritizr)
    	# Use 5e-6 to leave some buffer
    	puvsp[amount < 5e-6, amount := 0]

    	# Sort and trim columns and rows
    	setkey(puvsp, pu, species) # order by pu then species
    	puvsp <- puvsp[amount > 0, ] # trim only to presences

        # checks on the historical data
    	if(length(unique(puvsp$pu)) != nrow(pus)) stop(paste0('region: ', myregs[i], '. puvsp planning units do not match pus.')) # planning units for species + NatCap: 2195 (ebs), 661 (goa), 549 (neus), 1342 (newf)
    	if(!all(unique(puvsp$species) %in% spps$id)) stop(paste0('region: ', myregs[i], '. Some puvsp features are not in spps.')) # features that are species + fishery + NatCap
    	if(min(sort(unique(table(puvsp$species)))) < 1) stop(paste0('region: ', myregs[i], '. Some species are not in a planning unit (hist).')) # make sure all species show up in some planning units (shouldn't see any 0s)
    	if(min(sort(unique(table(puvsp$pu))) < 1)) stop(paste0('region: ', myregs[i], '. Some planning units do not have a species (hist).')) # make sure all planning units have some species (shouldn't see any 0s)
    	if(!all(sort(unique(table(puvsp$pu, puvsp$species))) %in% c(0,1))) stop(paste0('region: ', myregs[i], '. Some planning unit-species combinations appear more than once (hist).')) # should be all 0s and 1s
        if(puvsp[, max(amount) > 1e6]) stop(paste0('region:', myregs[i], '. Amount > 1e6 (hist).'))

		# add future data
    	puvsppa2 <- presmap[region == myregs[i] & year_range == planningperiods[2], .(poccur = mean(poccur)), by = c('latgrid', 'longrid', 'spp', 'thresh.kappa')] # pres/abs data. trim to focal models
    		dim(puvsppa2)
    	puvsppa2[, amount := as.numeric(poccur >= thresh.kappa)] # use pres/abs as conservation amount. should this instead be left as poccur?
    	    puvsppa2[, summary(amount)]
    	    puvsppa2[, sort(unique(amount))]
    	puvsppa2[ , name := gsub(' |_', '', spp)] # trim out spaces from species names and add future
    	puvsppa2[!grepl('energy', name), name := paste0(name, gsub('-', '', planningperiods[2]))] # append time period

        # Format future fishery data
        puvspbio2 <- biomassmap[region == myregs[i] & year_range == planningperiods[2] & spp %in% fisheryspps[region == myregs[i], projname], .(biomass = mean(biomass)), by = c('latgrid', 'longrid', 'spp')] # biomass data
            dim(puvspbio2)
            puvspbio2[, length(unique(spp))] # should be 10
        puvspbio2[, amount := biomass] # use biomass as amount for fishery targets.
        puvspbio2[ , name := paste0(gsub(' |_', '', spp), '_fishery')] # trim out spaces from species names
    	puvspbio2[!grepl('energy', name), name := paste0(name, gsub('-', '', planningperiods[2]))] # append time period

    	# combine future data
    	puvsp2 <- rbind(puvsppa2[, .(name, latgrid, longrid, amount, zone = 1)],
    	               puvspbio2[, .(name, latgrid, longrid, amount, zone = 2)])

    	# Add species ids to future
    	nrow(puvsp2)
    	puvsp2 <- merge(puvsp2, spps[, .(id, name)], by = 'name') # merge in species IDs and trim to focal species
    	nrow(puvsp2)
    	setnames(puvsp2, 'id', 'species')

        # Add planning units to future
        puvsp2 <- merge(puvsp2, pus[, .(latgrid, longrid, id)], by = c('latgrid', 'longrid')) # add pu id (and trim to focal pus)
    	nrow(puvsp2)
    	setnames(puvsp2, 'id', 'pu')

    	# Check fishery species for adequate biomass and scale up if needed
    	# Makes sure that no fishery species are eliminated by the next section checking for amount < 1e6
        fishtotals2 <- puvsp2[grepl('fishery', name), .(total = sum(amount), name = unique(name)), by = 'species']
    	for(j in which(fishtotals2[, total != 1])){
    	    scalar <- 1/fishtotals2[j, total] # scale up so sum would be 1
    	    puvsp2[species == fishtotals2[j, species], amount := amount * scalar]
    	}

    	# Add historical and future data
    	puvsp <- rbind(puvsp, puvsp2)

    	# Trim out values < 1e-6 (will throw error in prioritizr)
    	# Use 5e-6 to leave some buffer
    	puvsp[amount < 5e-6, amount := 0]

    	# Sort and trim columns and rows
    	setkey(puvsp, pu, species) # order by pu then species
    	puvsp <- puvsp[amount > 0, ] # trim only to presences

    	# checks
    	if(length(unique(puvsp$pu)) != nrow(pus)) stop(paste0('region: ', myregs[i], '. puvsp planning units do not match pus.')) # planning units for species + NatCap
    	if(!all(unique(puvsp$species) %in% spps$id)) stop(paste0('region: ', myregs[i], '. Some puvsp features are not in spps.')) # features that are species + fishery + NatCap
    	if(min(sort(unique(table(puvsp$species)))) < 1) stop(paste0('region: ', myregs[i], '. Some species are not in a planning unit.')) # make sure all species show up in some planning units (shouldn't see any 0s)
    	if(min(sort(unique(table(puvsp$pu))) < 1)) stop(paste0('region: ', myregs[i], '. Some planning units do not have a species.')) # make sure all planning units have some species (shouldn't see any 0s)
    	if(!all(sort(unique(table(puvsp$pu, puvsp$species))) %in% c(0,1))) stop(paste0('region: ', myregs[i], '. Some planning unit-species combinations appear more than once.')) # should be all 0s and 1s
    	if(puvsp[, max(amount) > 1e6]) stop(paste0('region:', myregs[i], '. Amount > 1e6.'))

    #zone target
    # set zone-specific targets: rows are features, columns are zones
	zonetarget <- matrix(0, nrow = nrow(spps), ncol = nrow(zones), dimnames = list(spps$name, zones$name))
	zonetarget[!grepl('energy|fishery', rownames(zonetarget)), 'conservation'] <- consgoal # set conservation zone target
    zonetarget[grepl('fishery', rownames(zonetarget)), 'fishery'] <- fishgoal # set fishing zone target
	zonetarget[grepl('energy', rownames(zonetarget)), 'energy'] <- energygoal # set energy goal target

     # trim out species that aren't present
	nrow(spps)
	spps <- spps[name %in% puvsp$name,]
	nrow(spps)

	nrow(zonetarget)
	zonetarget <- zonetarget[rownames(zonetarget) %in% puvsp$name,]
	nrow(zonetarget)

    # basic checks (automated)
    if(!all(colSums(zonetarget) > 0)) stop(paste0('region:', myregs[i], '. Some zone targets are 0.')) # reasonable targets?
    if(nrow(zonetarget) != nrow(spps)) stop(paste0('region: ', myregs[i], '. Zonetargets do not match spps.'))
    if(!all(rownames(zonetarget) == spps$name))  stop(paste0('region: ', myregs[i], '. Zonetargets order does not match spps order.'))
    if(sum(!(puvsp$pu %in% pus$id)) > 0) stop(paste0('region: ', myregs[i], '. Some planning units not in pus.'))
    if(sum(!(puvsp$species %in% spps$id)) > 0) stop(paste0('region: ', myregs[i], '. Some species units not in spps.'))
    if(sum(!(pus$id %in% puvsp$pu)) > 0) stop(paste0('region: ', myregs[i], '. Some pus units not in puvsp.'))
    if(sum(!(spps$id %in% puvsp$species)) > 0) stop(paste0('region: ', myregs[i], '. Some species units not in puvsp.'))

    # First solve the min cost problem
    cat('\tSolving min cost\n')
    p1 <- problem(pus, spps, cost_column = c('dummycost', 'dummycost', 'dummycost'), rij = puvsp, zones = zones) %>%
        add_min_set_objective() %>%
        add_relative_targets(zonetarget) %>%
        add_binary_decisions() %>%
        add_gurobi_solver(gap = gap)
    if(presolve_check(p1)){
        s1 <- solve(p1)
    } else {
        stop(paste0('region:', myregs[i], '. Failed presolve check (min set).'))
    }

	# Loop through a range of budgets and relative weights on future vs. present
	frontier <- expand.grid(budget = seq(minbudget, maxbudget, length.out = nbudget), presweight = seq(minweight, maxweight, length.out = nweight))
	frontier$region <- myregs[i]
	frontier$status <- NA
	frontier$presgoals <- NA
	frontier$futgoals <- NA

	for(j in 1:nrow(frontier)){
		print(paste(myregs[i], frontier$budget[j], frontier$presweight[j]))

		# Set up a budget as fraction of min cost
		budget <- frontier$budget[j]*cost*s1[, sum(solution_1_conservation) + sum(solution_1_fishery) + sum(solution_1_energy)] # or with 0.9*attr(s1, 'objective')

		# Set up feature weights
		# Anything less than 0.01 will favor not adding a planning unit over meeting a feature target
		prewght <- frontier$presweight[j]
		futwght <- maxweight + minweight - frontier$presweight[j]
		wghts <- zonetarget
		wghts[grepl(gsub('-', '', planningperiods[1]), rownames(wghts)), ] <- prewght # historical
		wghts[grepl(gsub('-', '', planningperiods[2]), rownames(wghts)), ] <- futwght # future
		wghts[grepl('energy', rownames(wghts)), ] <- 0 # no attempt to meet energy goal
		wghts[zonetarget == 0] <- 0 # set zeros back to zero

		# Now solve the max representation problem for a limited budget
		cat('\tSolving min budget\n')
		p2 <- problem(pus, spps, cost_column = c('dummycost', 'dummycost', 'dummycost'), rij = puvsp, zones = zones) %>%
			add_max_features_objective(budget) %>%
			add_relative_targets(zonetarget) %>%
			add_feature_weights(wghts) %>%
			add_binary_decisions() %>%
			add_gurobi_solver(gap = gap, threads = nthread, time_limit = timelimit)   # 10 minute time limit

		if(presolve_check(p2)){
			s2 <- solve(p2)
		} else {
			stop(paste0('region:', myregs[i], '. Failed presolve check (min budget).'))
		}

		# save status
		frontier$status[j] <- attr(s2, 'status')

		# calculate goals met
		r2 <- feature_representation(p2, s2[, 5:7])
		r2 <- r2[(!grepl('fishery|energy', r2$feature) & r2$zone == 'conservation') | (grepl('fishery', r2$feature) & r2$zone == 'fishery') | (grepl('energy', r2$feature) & r2$zone == 'energy'), ] # trim to feature/zone combinations we care about
		if(nrow(r2) != nrow(zonetarget)) stop('r2 and zonetargets do not match')
		r2$goal <- NA
		r2$goal[r2$zone == 'conservation'] <- consgoal
		r2$goal[r2$zone == 'fishery'] <- fishgoal
		r2$goal[r2$zone == 'energy'] <- energygoal
		r2$met <- r2$relative_held >= r2$goal
		frontier$presgoals[j] <- sum(r2$met[grepl(gsub('-', '', planningperiods[1]), r2$feature)]) # contemporary period goals met
		frontier$futgoals[j] <- sum(r2$met[grepl(gsub('-', '', planningperiods[2]), r2$feature)]) # future

	}

	if(i == 1){
		frontierall <- frontier
	} else {
		frontierall <- rbind(frontierall, frontier)
	}

	write.csv(frontierall, file = outname)
}
print(Sys.time())

########################
# Make a simple plot
########################

require(data.table)
require(ggplot2)

frontierall <- fread(outname, drop = 1)
setkey(frontierall, region, budget, presweight)
frontierall[, region := factor(region, levels = c('ebs', 'goa', 'bc', 'wc', 'gmex', 'seus', 'neus', 'maritime', 'newf'))] # set order

# how many not optimal?
print(frontierall[, .(notopt = sum(status != 'OPTIMAL'), total = .N)])
print(frontierall[, .(notopt = sum(status != 'OPTIMAL'), total = .N), by = region])

pdf('temp_figures/prioritizr_frontiers.pdf', height = 6, width = 6)
ggplot(frontierall, aes(x = presgoals, y = futgoals, group = budget, color = budget)) +
    geom_path(size = 0.4) +
    geom_point(size = 0.3) +
    facet_wrap(~ region, nrow = 3, scales = 'free')
dev.off()


# Test script localy
wdpaid <- '18_54_22_56'

#wdpaid <- 'minlon_minlat_maxlon_maxlat'
wdpaidsplit <- unlist(strsplit(wdpaid, "[_]"))
xmin <- as.numeric(wdpaidsplit[1])
ymin <- as.numeric(wdpaidsplit[2])
xmax <- as.numeric(wdpaidsplit[3])
ymax <- as.numeric(wdpaidsplit[4])
temp_path<- "c:/temp"

library(knitr)
library(kableExtra)

library(rgdal)
library(downloader)
library(ggplot2)
library(mapdata)
library(geojsonio)
library(ggmap)
library(ggrepel)

library("rgdal")
library("rasterVis")
library("downloader")
library("ggplot2")

library("XML")
library("RCurl")
library("bitops")
library("lattice")
library("latticeExtra")
library("RColorBrewer")
library("mapdata")
library("maps")
library("maptools")
library("wq")
library("xtable")
library("zoo")
library("jsonlite")
library(ncdf4)

require(xtable)

library(lattice)

library(dplyr)
library(raster)
library(rworldmap)
library(rworldxtra)
library(NbClust)
library(tidyr)
library(dplyr)
library(ggplot2)
library(fastcluster)
library(FactoMineR)
library(sf)

# Script for Wekeo environment
sr=SpatialPolygons(list(Polygons(list(Polygon(cbind(c(xmin, xmin, xmax, xmax),c(ymax, ymin, ymin, ymax)))),"1")))
mpa=SpatialPolygonsDataFrame(sr, data.frame(cbind(1:1), row.names=c("1")))
proj4string(mpa)<-CRS("+proj=longlat +datum=WGS84")

bbox<-paste(xmin,ymin,xmax,ymax,sep=",")

#FUNCTION GET VESSELDENSITY
#=================================================

getvesseldensityLite<-function (name = "emodnet:2017_01_st_All", resolution = "30 arcsec / 900m", xmin = 15, xmax = 20.5, ymin = 30, ymax = 32.5)
{
bbox <- paste(xmin, ymin, xmax, ymax, sep = ",")
con <- paste(ogc_url,"/wcs?service=wcs&version=1.0.0&request=getcoverage&coverage=",name,"&crs=EPSG:4326&BBOX=", bbox, "&format=image/tiff&interpolation=nearest&resx=0.00833333&resy=0.00833333", sep = "")
#con <- paste("http://77.246.172.208/geoserver/emodnet/wcs?service=wcs&version=1.0.0&request=getcoverage&coverage=",name,"&crs=EPSG:3035&BBOX=", bbox, "&format=image/tiff&interpolation=nearest&resx=0.00833333&resy=0.00833333", sep = "")
nomfich <- paste(name, "img.tiff", sep = "_")
nomfich <- tempfile(nomfich)
download(con, nomfich, quiet = TRUE, mode = "wb")
img <- raster(nomfich)
img[img == 0] <- NA
#img[img < 0] <- 0
#img[img > 100] <- 0
names(img) <- paste(name)
return(img)
}

getvesseldensity_byvesseltype<-function (name = "emodnet:2017_01_st_All", vessel_type= "st_09" ,resolution = "30 arcsec / 900m", xmin = 15, xmax = 20.5, ymin = 30, ymax = 32.5)
{
##################### getvesseldensityLite2017
for (month in c('01','02','03','04','05','06','07','08','09','10','11','12')){
	print(paste("The month is", month))
	img<-getvesseldensityLite(name = paste("emodnet:2017_",month,"_",vessel_type, sep=""), resolution = "30 arcsec", xmin, xmax, ymin, ymax)
	names(img) <- paste("2017-",month, sep="")
	if (month == '01') {imgs <- img
} else {
 	imgs <- stack(imgs, img)
	}
}
mpa_vesselAll2017<-imgs
##################### getvesseldensityLite2018
for (month in c('01','02','03','04','05','06','07','08','09','10','11','12')){
	print(paste("The month is", month))
	img<-getvesseldensityLite(name = paste("emodnet:2018_",month,"_",vessel_type, sep=""), resolution = "30 arcsec", xmin, xmax, ymin, ymax)
	names(img) <- paste("2018-",month, sep="")
	if (month == '01') {imgs <- img
} else {
 	imgs <- stack(imgs, img)
	}
}
mpa_vesselAll2018<-imgs
##################### getvesseldensityLite2019
for (month in c('01','02','03','04','05','06','07','08','09','10','11','12')){
	print(paste("The month is", month))
	img<-getvesseldensityLite(name = paste("emodnet:2019_",month,"_",vessel_type, sep=""), resolution = "30 arcsec", xmin, xmax, ymin, ymax)
	names(img) <- paste("2019-",month, sep="")
	if (month == '01') {imgs <- img
} else {
 	imgs <- stack(imgs, img)
	}
}
mpa_vesselAll2019<-imgs

mpa<-stack(mpa_vesselAll2017,mpa_vesselAll2018,mpa_vesselAll2019)

return(mpa)
}

#####################
layer_title<-"Vessel density (Cargo) 2017-2019"
ogc_url <- "https://ows.emodnet-humanactivities.eu"
vessel_type <- "st_09"

mpa_cargo<-getvesseldensity_byvesseltype(name, vessel_type, resolution = "30 arcsec/900m", xmin, xmax, ymin, ymax)

#####################
layer_title<-"Vessel density (dredging or underwater ops) 2017-2019"
ogc_url <- "https://ows.emodnet-humanactivities.eu"
vessel_type <- "st_03"

mpa_dredging<-getvesseldensity_byvesseltype(name, vessel_type, resolution = "30 arcsec/900m", xmin, xmax, ymin, ymax)

#####################
layer_title<-"Vessel density (High Speed Craft) 2017-2019"
ogc_url <- "https://ows.emodnet-humanactivities.eu"
vessel_type <- "st_06"

mpa_speedcraft<-getvesseldensity_byvesseltype(name, vessel_type, resolution = "30 arcsec/900m", xmin, xmax, ymin, ymax)

#####################
layer_title<-"Vessel density (Fishing) 2017-2019"
ogc_url <- "https://ows.emodnet-humanactivities.eu"
vessel_type <- "st_01"

mpa_fishing<-getvesseldensity_byvesseltype(name, vessel_type, resolution = "30 arcsec/900m", xmin, xmax, ymin, ymax)

#####################
layer_title<-"Vessel density (Military and Law Enforcement) 2017-2019"
ogc_url <- "https://ows.emodnet-humanactivities.eu"
vessel_type <- "st_11"

mpa_military<-getvesseldensity_byvesseltype(name, vessel_type, resolution = "30 arcsec/900m", xmin, xmax, ymin, ymax)

#####################
layer_title<-"Vessel density (Passenger) 2017-2019"
ogc_url <- "https://ows.emodnet-humanactivities.eu"
vessel_type <- "st_08"

mpa_passenger<-getvesseldensity_byvesseltype(name, vessel_type, resolution = "30 arcsec/900m", xmin, xmax, ymin, ymax)

#####################
layer_title<-"Vessel density (Pleasure Craft) 2017-2019"
ogc_url <- "https://ows.emodnet-humanactivities.eu"
vessel_type <- "st_05"

mpa_pleasure<-getvesseldensity_byvesseltype(name, vessel_type, resolution = "30 arcsec/900m", xmin, xmax, ymin, ymax)

#####################
layer_title<-"Vessel density (Sailing) 2017-2019"
ogc_url <- "https://ows.emodnet-humanactivities.eu"
vessel_type <- "st_04"

mpa_sailing<-getvesseldensity_byvesseltype(name, vessel_type, resolution = "30 arcsec/900m", xmin, xmax, ymin, ymax)

#####################
layer_title<-"Vessel density (Service) 2017-2019"
ogc_url <- "https://ows.emodnet-humanactivities.eu"
vessel_type <- "st_02"

mpa_service<-getvesseldensity_byvesseltype(name, vessel_type, resolution = "30 arcsec/900m", xmin, xmax, ymin, ymax)

#####################
layer_title<-"Vessel density (Tanker) 2017-2019"
ogc_url <- "https://ows.emodnet-humanactivities.eu"
vessel_type <- "st_10"

mpa_tanker<-getvesseldensity_byvesseltype(name, vessel_type, resolution = "30 arcsec/900m", xmin, xmax, ymin, ymax)

#####################
layer_title<-"Vessel density (Tug and Towing) 2017-2019"
ogc_url <- "https://ows.emodnet-humanactivities.eu"
vessel_type <- "st_07"

mpa_tug<-getvesseldensity_byvesseltype(name, vessel_type, resolution = "30 arcsec/900m", xmin, xmax, ymin, ymax)

#####################
layer_title<-"Vessel density (Unknown) 2017-2019"
ogc_url <- "https://ows.emodnet-humanactivities.eu"
vessel_type <- "st_12"

mpa_unknown<-getvesseldensity_byvesseltype(name, vessel_type, resolution = "30 arcsec/900m", xmin, xmax, ymin, ymax)

#nomobj<-ls(patt="mpa_")
#save(list=nomobj,file="envais.rdata")

###########PROCESSING

#land data to mask data
landmask <- rworldmap::getMap(resolution = "high")

#load data
# Test script localy
#wdpaid <- '18_54_22_56'
load("../../Data/baltic/envais.rdata")

#raster 2 datafram
r2df<-function(r){
	tmp<-raster::as.data.frame(r,xy=T)%>%
		tidyr::pivot_longer(3:(2+dim(r)[3]))
	return(tmp)
}
#group vessel cat + reduce spatial resolution + mask to avoid onland info
aggfac<-4 # reduction factor
#allmpa
allmpa<-list(mpa_fishing,mpa_dredging,mpa_sailing,mpa_pleasure,mpa_speedcraft,mpa_passenger,mpa_cargo,mpa_tanker,mpa_service,mpa_tug,mpa_military)
#aggregate
allmpa<-lapply(allmpa,aggregate,fact=aggfac)
#mask
allmpa<-lapply(allmpa,mask,mask=landmask,inverse=T)
#yearly
fsapply<-function(a){return(stackApply(a,indices=substr(names(a),2,5),fun=mean,na.rm=T))}
fsapply(mpa_fishing)
allmpa<-lapply(allmpa,fsapply)

#individual group or sum
#fishing
fishAIS<-r2df(allmpa[[1]])
#dredging
dredAIS<-r2df(allmpa[[2]])
#sailing
tmp1<-r2df(allmpa[[3]])%>%mutate(value1=value)%>%dplyr::select(-value)
tmp2<-r2df(allmpa[[4]])%>%mutate(value2=value)%>%dplyr::select(-value)
tmp<-full_join(tmp1,tmp2)
tmp$sum<-apply(tmp[,4:5],1,sum,na.rm=T)
sailAIS<-tmp%>%transmute(x,y,name,value=sum)
#transport
tmp1<-r2df(allmpa[[5]])%>%mutate(value1=value)%>%dplyr::select(-value)
tmp2<-r2df(allmpa[[6]])%>%mutate(value2=value)%>%dplyr::select(-value)
tmp3<-r2df(allmpa[[7]])%>%mutate(value3=value)%>%dplyr::select(-value)
tmp4<-r2df(allmpa[[8]])%>%mutate(value4=value)%>%dplyr::select(-value)
tmp<-full_join(full_join(full_join(tmp1,tmp2),tmp3),tmp4)
tmp$sum<-apply(tmp[,4:7],1,sum,na.rm=T)
tranAIS<-tmp%>%transmute(x,y,name,value=sum)
#service
tmp1<-r2df(allmpa[[8]])%>%mutate(value1=value)%>%dplyr::select(-value)
tmp2<-r2df(allmpa[[9]])%>%mutate(value2=value)%>%dplyr::select(-value)
tmp3<-r2df(allmpa[[10]])%>%mutate(value3=value)%>%dplyr::select(-value)
tmp<-full_join(full_join(tmp1,tmp2),tmp3)
tmp$sum<-apply(tmp[,4:6],1,sum,na.rm=T)
servAIS<-tmp%>%transmute(x,y,name,value=sum)
#eliminate pt at land
landmask2<-st_as_sf(landmask)
pt2<-st_as_sf(fishAIS,coords=c("x","y"),crs=crs(landmask2))
landmask2<-st_crop(st_as_sf(landmask),extent(pt2))
#pt at sea
ptin<-!apply(st_intersects(pt2,landmask2,sparse=F),1,any)
#plot(alldf[[1]][ptin,1:2])
#list of all stuff
alldf<-list(fishAIS[ptin,],dredAIS[ptin,],sailAIS[ptin,],tranAIS[ptin,],servAIS[ptin,])
#fct to add a name
fname<-function(a,nom){a$type<-nom;return(a)}
maptmp<-do.call("rbind",Map(fname,alldf,c("fish","dred","sail","tran","serv")))
ggplot(maptmp,aes(x=x,y=y,fill=value))+geom_raster()+
	scale_fill_distiller(palette="Spectral",name="Zone",trans="log10")+
	facet_grid(type~name)+
	borders("world",fill="grey",colour=NA)+
	coord_sf(xlim=range(maptmp$x),ylim=range(maptmp$y))+
	xlab("Longitude")+ylab("Latitude")+
	theme_bw()#+
	#theme(legend.position="bottom")

#classif
classif<-function(tmp){
	#tmp<-alldf[[4]]%>%group_by(name)%>%
	tmp<-tmp%>%group_by(name)%>%
		mutate(m=min(value,na.rm=T),
		       q=quantile(value,.95,na.rm=T))%>%
		ungroup()%>%
		mutate(value=ifelse(is.na(value),0,value))%>%
		dplyr::select(-m,-q)
	#tmp<-alldf[[1]]
	#tmp$value<-log10(tmp$value+1)
	tmp$value<-log10(tmp$value+1)
	mat0<-tmp%>%tidyr::pivot_wider(values_from=value,names_from=name,values_fill=0)
	idptNA<-is.finite(apply(mat0[,-c(1:2)],1,sum))
	#str(mat0[,-c(1:2)])
	d<-stats::dist((mat0[,-c(1:2)]))
	clust <-fastcluster::hclust(d, method = "ward.D2")
	pipo<-data.frame(x=mat0$x,y=mat0$y,zone=cutree(clust,6))
	return(pipo)
}
allzone<-lapply(alldf,classif)
maptmp<-do.call("rbind",Map(fname,allzone,c("fish","dred","sail","tran","serv")))
ggplot(maptmp,
       aes(x=x,y=y,fill=as.factor(zone)))+geom_raster()+
	scale_fill_brewer(palette="Set3",name="Cluster")+#,trans="log10")+
	#de\n navires\n(h.km^2)",trans="log10")+
	facet_wrap(~type,ncol=2)+
	borders("world",fill="grey",colour=NA)+
	coord_sf(xlim=range(maptmp$x),ylim=range(maptmp$y))+
	xlab("Longitude")+ylab("Latitude")+
	theme_bw()#+

#MCA
uu<-do.call("rbind",Map(fname,allzone,c("fish","dred","sail","tran","serv")))%>%
	mutate(zonetype=paste0(type,"-",zone))%>%
	dplyr::select(-zone)%>%
	pivot_wider(values_from=zonetype,names_from=type)
mca <- MCA(uu[,-c(1,2)], ncp=999, method="Burt", graph=F)
#
#plotellipses(mca, axes = c(1,2))
#plotellipses(mca, axes = c(1,3))

#final classif
d <- dist(mca$ind$coord)
clust <- fastcluster::hclust(d, method="ward.D2")
groups <- cutree(clust,6)

finalzone <- data.frame(uu[,c(1,2)],Cluster=factor(groups))

ggplot(finalzone,
       aes(x=x,y=y,fill=Cluster))+geom_raster()+
	scale_fill_brewer(palette="Set3",name="Cluster")+
	borders("world",fill="grey",colour=NA)+
	coord_sf(xlim=range(finalzone$x),ylim=range(finalzone$y))+
	xlab("Longitude")+ylab("Latitude")+
	theme_bw()#+

#add stuff
allrez<-do.call("rbind",Map(fname,alldf,c("fish","dred","sail","tran","serv")))%>%
	left_join(finalzone)

ggplot()+
	  geom_boxplot(data=allrez,aes(x=type,y=value,fill=type))+
	    facet_wrap(~Cluster,nrow=2)+xlab("type")+ylab("Parameters")+
	    scale_y_log10()+
	      scale_fill_brewer(palette="Set3")


#t_pulse是单次射出所需的时间
#t_pulse，随着电压频率fv的上升而改变；随着流量而改变；

#以流量为划分

#设定工作目录
setwd("D:/data")
library(xlsx)

#读取数据
#sink15<-read.xlsx("t_pulse.xls", sheetName = "single_q_15", header = TRUE)
#sink27<-read.xlsx("t_pulse.xls", sheetName = "single_q27", header = TRUE)
#sink54<-read.xlsx("t_pulse.xls", sheetName = "single_q54", header = TRUE)
sink180<-read.xlsx("t_pulse.xls", sheetName = "single_q180", header = TRUE)

#保存数据
pdf("t_pulse_q180.pdf")

#设定空间位置
par(fig=c(0,1,0,1), new = F)

##################################画图--占空比k为180nl/min#######################
plot(sink180$fv, sink180$X0.2, xaxs = "i", col = 0, xlab = "Voltage frequency (Hz)", ylab = "Pulse time t_pulse (ms)", main = "Pulse time in Q = 180nl/min", cex.lab = 1.2, cex.main = 1.5, xlim = c(0, 3550), ylim = c(0, 5))

#model1 = loess(sink180$X0.2 ~ sink180$fv, span = 0.8 , degree = 2)
lines(sink180$fv, sink180$X0.2,  col="#458B74", pch=21, lwd=2.5, type="b", lty=2)

#model2 = loess(sink180$X0.3 ~ sink180$fv, span = 0.8, degree = 2)
lines(sink180$fv, sink180$X0.3, col="#FF00FF", pch=22, lwd=2.5, type="b", lty=2)

#model3 = loess(sink180$X0.4 ~ sink180$fv, span = 0.8, degree = 2)
lines(sink180$fv, sink180$X0.4, col="#EE0000", pch=23, lwd=2.5, type="b", lty=2)

#model4 = loess(sink180$X0.5 ~ sink180$fv, span = 0.8, degree =2)
lines(sink180$fv, sink180$X0.5, col="#27408B", pch=24, lwd=2.5, type="b", lty=2)

#区域划线

legend("topleft", c("k = 0.2", "k = 0.3", "k = 0.4", "k = 0.5"), col = c("#458B74", "#FF00FF", "#EE0000", "#27408B"), pch = c(21, 22, 23, 24), lwd = 2, lty = 2, cex = 1.2, inset = .03, bty = "n")

###############画小图########
#par(fig = c(0.3,0.98,0.15,0.98), new  = TRUE)

#plot(sink180$fv, sink180$X0.2, xaxs = "i", col = 0, xlab = "0 ~ 250 Hz", ylab = "t_pulse (ms)", main = "", cex.lab = 1.2, cex.main = 1.5, xlim = c(0, 250), ylim = c(0, 1.05))

#model1 = loess(sink180$X0.2 ~ sink180$fv, span = 0.8 , degree = 2)
#lines(sink180$fv, sink180$X0.2,  col="#458B74", lwd=2.5, type="o", lty=2)

#model2 = loess(sink180$X0.3 ~ sink180$fv, span = 0.8, degree = 2)
#lines(sink180$fv, sink180$X0.3, col="#FF00FF", lwd=2.5, type="o", lty=2)

#model3 = loess(sink180$X0.4 ~ sink180$fv, span = 0.8, degree = 2)
#lines(sink180$fv, sink180$X0.4, col="#EE0000", lwd=2.5, type="o", lty=2)

#model4 = loess(sink180$X0.5 ~ sink180$fv, span = 0.8, degree =2)
#lines(sink180$fv, sink180$X0.5, col="#27408B", lwd=2.5, type="o", lty=2)

#legend("topleft", c("1.5nl/min", "27nl/min", "54nl/min", "180nl/min"), col = c("#458B74", "#FF00FF", "#EE0000", "#27408B"), pch = c(21, 22, 23, 24), lwd = 2, lty = 2, cex = 1.2, bty = "n", inset = .03)

#画小小图
par(fig = c(0.25,0.95,0.25,0.95), new  = TRUE)

plot(sink180$fv, sink180$X0.2, xaxs = "i", col = 0, xlab = "0 ~ 250 Hz", ylab = "t_pulse (ms)", main = "", cex.lab = 1.2, cex.main = 1.5, xlim = c(0, 500), ylim = c(0, 1.6))

text(250, 1.2, "射出时间在[0.3ms, 0.8ms]内", font = 2, col = "blue", cex = 1.3)
#text(250, 1.8, "180nl/min时突然增大", font = 2, col = "blue", cex = 1.3)
#text(120, 1, "低频电压区间[0 ~ 250Hz]", font = 2, col = "red", cex = 1.3)

#model1 = loess(sink180$X0.2 ~ sink180$fv, span = 1.6 , degree = 2)
lines(sink180$fv, sink180$X0.2, col="#458B74", lwd=2, type="l")

#model2 = loess(sink180$X0.3 ~ sink180$fv, span = 1.6, degree = 2)
lines(sink180$fv,  sink180$X0.3, col="#FF00FF", lwd=2, type="l")

#model3 = loess(sink180$X0.4 ~ sink180$fv, span = 1.6, degree = 2)
lines(sink180$fv, sink180$X0.4, col="#EE0000", lwd=2, type="l")

#model4 = loess(sink180$X0.5 ~ sink180$fv, span = 1.6, degree =2)
lines(sink180$fv, sink180$X0.5, col="#27408B", lwd=2, type="l")

abline(h=0.8, lty = 3, col = "red", lwd = 2)
abline(h=0.3, lty = 3, col = "red", lwd = 2)
abline(h=0.7, lty = 3, col = "blue", lwd = 2)

#legend("topleft", c("1.5nl/min", "27nl/min", "54nl/min", "180nl/min"), col = c("#458B74", "#FF00FF", "#EE0000", "#27408B"), pch = c(21, 22, 23, 24), lwd = 2, lty = 2, cex = 1.2, bty = "n", inset = .03)

dev.off()


# summ-shock.r
# R script to summarize PreservationSimulation/shelf data.
# All the grouping and aggregation dependent code should go in here.
#  And there will be one of these files for various combinations of
#  grouping and aggregation.
#
# 20141214 RBLandau original version.
# . . . revised many times . . .
# 20170310  RBL Extract summarize function from larger script.
# 20170312  RBL Also extract table calcs and detailed stats printer.
# 20170316  RBL Produce this new audit-only version from old
#                docsize-glitchimpact one.
# 20170318  RBL Add percentage loss table for midmeans.
#               Finally do detailed stats for shocks.
# 20170320  RBL Special version that starts copies at 2!!!!!!
#
#

# f n S e l e c t C o l u m n s
# What data items are we going to be analyzing by grouping and aggregation?
# Return a new data frame containing only those.  They will be used in
#  all the summarization and detailed stats functions below.
fnSelectColumns <- function(dat)
{
    datn <- data.frame(dat$shockfreq, dat$shockimpact,
        dat$shockspan, dat$shockmaxlife,
        dat$lifem, dat$copies, dat$lost)
    return(datn)
}

# s u m m a r i z e
# There will be different version of this function for each of
#  several sets of groupings.
#  This one is glitch-docsize.
#
summarize <- function(myframe,mysummaryout,mysummaryfunction)
{
    # NOTE: colnames and newrow lists must be in the same order!
    colnames(mysummaryout) <- c("shockfreq","impact","span","maxlife","lifem",
        "c2","c3","c4","c5","c8","c1")

    for (sf in levels(factor(myframe$dat.shockfreq)))
    {   tmp1 <- data.frame(myframe[myframe$dat.shockfreq==sf,]);

        for (si in levels(factor(tmp1$dat.shockimpact)))
        {   tmp2 <- data.frame(tmp1[tmp1$dat.shockimpact==si,]);

            for (ss in levels(factor(tmp2$dat.shockspan)))
            {   tmp3 <- data.frame(tmp2[tmp2$dat.shockspan==ss,])

                for (sm in levels(factor(tmp3$dat.shockmaxlife)))
                {   tmp4 <- data.frame(tmp3[tmp3$dat.shockmaxlife==sm,])

                    for (lfm in levels(factor(tmp4$dat.lifem)))
                    {   tmp10 <- tmp4[tmp4$dat.lifem==lfm,]

                        tmp11 <- aggregate(tmp10, by=list(tmp10$dat.copies),
                            FUN=mysummaryfunction)
                        # NOTE: The columns will print in this order.
                        newrow <- c(sf,si,ss,sm,lfm,round(tmp11$dat.lost,2))

                        if (length(newrow) < length(colnames(mysummaryout)))
                        {
                            filler <- rep(0,length(colnames(mysummaryout))
                                - length(newrow))
                            #print(c(length(filler),"=>",filler))
                            #print(c(length(newrow),"=>",newrow))
                            newrow <- c(newrow,filler)
                        }
                        #print(newrow)

                        # Absurd hack in here to make lifem print reasonably.
                        #  Increase the penalty for printing in scientific
                        #  (exponential) format, and limit the number of digits
                        #  so that there are no places after the radix point.
                        options("scipen"=100, "digits"=1)
                        # End of absurd hack.

                        mysummaryout <- rbind(mysummaryout,as.numeric(newrow))
                    }
                }
            }
        }
    }
    mysummaryout <- mysummaryout[-1,]
    rownames(mysummaryout) <- NULL
    rownames(mysummaryout, do.NULL = TRUE, prefix = "row")
    return(mysummaryout)
}#ENDFN summarize

# T A B L E S

# f n T a b l e M i d
fnTableMid <- function(dat)
{
    if(TRUE){
        # Summary table with midmeans.
        xsummid <- data.frame(rbind(numeric(11)))
        dat2 <- fnSelectColumns(dat)
        datn <- dat2[dat2$dat.copies<=8,]
        tsummid <- summarize(datn,xsummid,midmean)
        return(tsummid)
    }#ENDIFFALSE
}#ENDFN fnTableMid

# f n T a b l e M i d P c t
fnTableMidPct <- function(dat)
{
    if(TRUE){
        # Summary table with midmeans.
        tsummid <- fnTableMid(dat)
        for (col in c('c1','c2','c3','c4','c5','c8'))
        {
            # Convert loss numberss to percentages of collection size.
            tsummid[,col] <- tsummid[,col] / nDocs * 100.0
        }
        return(tsummid)
    }#ENDIFFALSE
}#ENDFN fnTableMid

# f n T a b l e M e d
fnTableMed <- function(dat)
{
    if(1){
        # Summary table with medians.
        xsummed <- data.frame(rbind(numeric(11)))
        dat2 <- fnSelectColumns(dat)
        datn <- dat2[dat2$dat.copies<=8,]
        tsummed <- summarize(datn,xsummed,median)
        return(tsummed)
    }#ENDIFFALSE
}#ENDFN fnTableMed

# f n T a b l e T r i
fnTableTri <- function(dat){
    if(1){
        # Summary table with trimeans.
        xsumtri <- data.frame(rbind(numeric(11)))
        dat2 <- fnSelectColumns(dat)
        datn <- dat2[dat2$dat.copies<=8,]
        tsumtri <- summarize(datn,xsumtri,trimean)
        return(tsumtri)
    }#ENDIFFALSE
}#ENDFN fnTableTri

# f n D e t a i l e d S a m p l e S t a t s
fnDetailedSampleStats <- function(myframe)
{
    # The order of nesting here is a frigging mess.  For the detailed stats,
    #  this determines the order of printing, not any aggregation.
    for (f1 in levels(factor(myframe$dat.shockfreq)))
    {   tmp1 <- data.frame(myframe[myframe$dat.shockfreq==f1,]);

        for (f2 in levels(factor(tmp1$dat.shockimpact)))
        {   tmp2 <- tmp1[tmp1$dat.shockimpact==f2,]

            for (f3 in levels(factor(tmp2$dat.shockmaxlife)))
            {   tmp3 <- tmp2[tmp2$dat.shockmaxlife==f3,]

                for (f4 in levels(factor(tmp3$dat.shockspan)))
                {   tmp4 <- tmp3[tmp3$dat.shockspan==f4,]

                    tmp10 <- tmp4
                    for (f11 in levels(factor(tmp10$dat.lifem)))
                    {   tmp11 <- tmp10[tmp10$dat.lifem==f11,]

                        for (f12 in levels(factor(tmp11$dat.copies)))
                        {   tmp12 <- tmp11[tmp11$dat.copies==f12,]

                            header <- paste('shockfreq',f1, 'impact',f2,
                                        'duration',f3, 'span',f4,
                                        'lifem',f11, 'copies',f12
                                        )
                            WhateverSampleSadisticsYouWant(header, tmp12$dat.lost)
                        }
                    }
                }
            }
        }
    }
}#ENDFN fnDetailedSampleStats

#END


# Differential gene expression analysis

.deseq = modules::import_package('DESeq2')
.base = modules::import('ebits/base')
modules::import_package('dplyr', attach = TRUE)

untidy = function (tidy_data, rownames = 1)
    `rownames<-`(as.data.frame(tidy_data[-rownames]), tidy_data[[rownames]])

.deseq_test = function (data, col_data, contrast) {
    cols = col_data[[1]] %in% contrast
    col_data = col_data[cols, , drop = FALSE]
    data = data[, cols]
    design = eval(bquote(~ .(as.name(colnames(col_data)[1]))))
    dds = .deseq$DESeqDataSetFromMatrix(data, col_data, design)
    .deseq$DESeq(dds, quiet = TRUE)
}

de_genes = function (counts, design, contrasts, alpha = 0.001) {
    dds_data = untidy(select(counts, Gene, starts_with('do')))
    dds_col_data = untidy(design)
    dds_col_data = dds_col_data[colnames(dds_data), , drop = FALSE]
    # Ensure Liver-Adult is condition A in the contrast, or, if not present,
    # then E15.5 is.
    healthy_celltypes = intersect(unique(design$Celltype),
                                  c('Liver-Adult', 'E15.5'))
    dds_col_data$Celltype = Reduce(relevel, rev(healthy_celltypes),
                                   factor(dds_col_data$Celltype))
    parallel = import_package('parallel')
    dds = parallel$mclapply(contrasts, .deseq_test,
                            data = dds_data, col_data = dds_col_data,
                            mc.cores = parallel$detectCores())
    lapply(dds, dds -> as.data.frame(.deseq$results(dds)) %>%
                       subset(! is.na(padj) & padj < alpha) %>%
                       add_rownames('Gene')) %>%
        setNames(vapply(contrasts, paste, character(1), collapse = '/'))
}


findStatLetters <- function(file, otus, graphGroups){

  statLetter <- NULL
  statLetter <- matrix(c("NA"),nrow=3, ncol=length(otus))

  ind <- NULL
  for(a in 1:(length(graphGroups))){
    ind <- c(ind, which(file$expgroup==graphGroups[a]))
  }
  file <- file[ind,]

  for (i in 1:(length(otus))) {
    results.wilcox <- pairwise.wilcox.test(file[,which(names(file)==otus[i])], file$expgroup, p.adj="BH")
    #results.wilcox <- pairwise.t.test(file[,which(names(file)==otus[i])], file$expgroup, p.adj="BH")

    #double check that all values were calculated, if not put as n.s.
    if(results.wilcox$p.value[1] == "NaN"){
      results.wilcox$p.value[1] <- 10 #a value greater than 0.05
    }
    if(results.wilcox$p.value[2] == "NaN"){
      results.wilcox$p.value[2] <- 10
    }
    if(results.wilcox$p.value[4] == "NaN"){
      results.wilcox$p.value[4] <- 10
    }

    if( results.wilcox$p.value[1] >= 0.05 ){
      if( results.wilcox$p.value[2] >= 0.05 ){
        if( results.wilcox$p.value[4] >= 0.05 ){
          statLetter[1, i] <- "a"
          statLetter[2, i] <- "a"
          statLetter[3, i] <- "a"
        } else{
          statLetter[1, i] <- "ab"
          statLetter[2, i] <- "a"
          statLetter[3, i] <- "b"
        }
      } else{
        if( results.wilcox$p.value[4] >= 0.05 ){
          statLetter[1, i] <- "a"
          statLetter[2, i] <- "ab"
          statLetter[3, i] <- "b"
        } else{
          statLetter[1, i] <- "a"
          statLetter[2, i] <- "a"
          statLetter[3, i] <- "b"
        }
      }
    } else{
      if( results.wilcox$p.value[2] >= 0.05 ){
        if( results.wilcox$p.value[4] >= 0.05 ){
          statLetter[1, i] <- "a"
          statLetter[2, i] <- "b"
          statLetter[3, i] <- "ab"
        } else{
          statLetter[1, i] <- "a"
          statLetter[2, i] <- "b"
          statLetter[3, i] <- "a"
        }
      } else{
        if( results.wilcox$p.value[4] >= 0.05 ){
          statLetter[1, i] <- "a"
          statLetter[2, i] <- "b"
          statLetter[3, i] <- "b"
        } else{
          statLetter[1, i] <- "a"
          statLetter[2, i] <- "b"
          statLetter[3, i] <- "c"
        }
      }
    }
  } # for (i in 1:(length(otus))) {

  return(statLetter)
}


#!/usr/bin/env Rscript

options(stringAsfactors = FALSE, useFancyQuotes = FALSE)
# This script is used to map MS2 information to CAMERA features
# Taking the command line arguments
args <- commandArgs(trailingOnly = TRUE)

if(length(args)==0)stop("No parameters are given!\n")
rDataFilesMS2<-NA
inputCamera<-NA
output<-NA
ppm<-10
rt<-10

###

preprocess_ms2<-FALSE
preprocess_msms_centroid<-FALSE
preprocess_msms_merge<-TRUE
preprocess_msms_centroid_after_merge<-FALSE
preprocess_msms_ppm<-10
preprocess_msms_ppm_precursor<-10
preprocess_msms_abs_mz<-0.01
preprocess_msms_abs_mz_precursor<-0.01
preprocess_msms_rt<-10
preprocess_msms_centroid_onlymapped<-FALSE
preprocess_msms_merge_onlymapped<-FALSE
preprocess_msms_int_threshold<-0

for(arg in args)
{
  argCase<-strsplit(x = arg,split = "=")[[1]][1]
  value<-strsplit(x = arg,split = "=")[[1]][2]

  if(argCase=="inputMS2")
  {
    input=as.character(value)
    if(file.info(input)$isdir & !is.na(file.info(input)$isdir))
    {
      rDataFilesMS2<-list.files(input,full.names = T)

    }else
    {

      rDataFilesMS2<-sapply(strsplit(x = input,split = "\\;|,| |\\||\\t"),function(x){x})

    }
  }
  if(argCase=="inputCAMERA")
  {

    inputCamera=as.character(value)

  }
  if(argCase=="ppm")
  {

    ppm=as.numeric(value)

  }
  if(argCase=="rt")
  {

    rt=as.numeric(value)

  }

  if(argCase=="output")
  {
    output=as.character(value)
  }

  if(argCase=="preprocess_ms2")
  {
    preprocess_ms2=as.logical(value)
    if(!is.logical(preprocess_ms2)){
      stop("preprocess_ms2 must be TRUE or FALSE!")
    }
  }

  if(argCase=="preprocess_msms_centroid")
  {
    preprocess_msms_centroid=as.logical(value)
  }

  if(argCase=="preprocess_msms_merge")
  {
    preprocess_msms_merge=as.logical(value)
  }

  if(argCase=="preprocess_msms_centroid_after_merge")
  {
    preprocess_msms_centroid_after_merge=as.logical(value)
  }

  if(argCase=="preprocess_msms_ppm")
  {

    preprocess_msms_ppm=as.numeric(value)

  }

  if(argCase=="preprocess_msms_ppm_precursor")
  {

    preprocess_msms_ppm_precursor=as.numeric(value)

  }

  if(argCase=="preprocess_msms_abs_mz")
  {

    preprocess_msms_abs_mz=as.numeric(value)

  }

  if(argCase=="preprocess_msms_abs_mz_precursor")
  {

    preprocess_msms_abs_mz_precursor=as.numeric(value)

  }

  if(argCase=="preprocess_msms_rt")
  {

    preprocess_msms_rt=as.numeric(value)

  }

  if(argCase=="preprocess_msms_int_threshold")
  {

    preprocess_msms_int_threshold=as.numeric(value)

  }

  if(argCase=="preprocess_msms_centroid_onlymapped")
  {
    preprocess_msms_centroid_onlymapped=as.logical(value)
  }

  if(argCase=="preprocess_msms_merge_onlymapped")
  {
    preprocess_msms_merge_onlymapped=as.logical(value)
  }

}

if(is.na(rDataFilesMS2) | is.na(inputCamera) | is.na(output)) stop("Both input (CAMERA and MS2 ) and output need to be specified!\n")

require(intervals)
ppmCal<-function(run,ppm)
{
  return((run*ppm)/1000000)
}
IntervalMerge<-function(cameraObject,MSMSdata, PlusTime,MinusTime,ppm,listOfMS2Mapped=list(),listOfUnMapped=list()){

  listofPrecursorsmz<-c()
  for(i in seq(1,length(MSMSdata)))
  {
    listofPrecursorsmz<-c(listofPrecursorsmz,MSMSdata[[i]]@precursorMz)
  }

  listofPrecursorsrt<-c()
  for(i in seq(1,length(MSMSdata)))
  {
    listofPrecursorsrt<-c(listofPrecursorsrt,MSMSdata[[i]]@rt)
  }

  CameramzColumnIndex<-which(colnames(cameraObject@groupInfo)=="mz")

  MassRun1<-Intervals_full(cbind(listofPrecursorsmz,listofPrecursorsmz))

  MassRun2<-Intervals_full(cbind(cameraObject@groupInfo[,CameramzColumnIndex]-
                                   ppmCal(cameraObject@groupInfo[,CameramzColumnIndex],ppm),
                                 cameraObject@groupInfo[,CameramzColumnIndex]+
                                   ppmCal(cameraObject@groupInfo[,CameramzColumnIndex],ppm)))

  Mass_iii <- interval_overlap(MassRun1,MassRun2)

  CamerartLowColumnIndex<-which(colnames(cameraObject@groupInfo)=="rtmin")
  CamerartHighColumnIndex<-which(colnames(cameraObject@groupInfo)=="rtmax")

  TimeRun1<-Intervals_full(cbind(listofPrecursorsrt,listofPrecursorsrt))

  TimeRun2<-Intervals_full(cbind(cameraObject@groupInfo[,CamerartLowColumnIndex]-MinusTime,
                                 cameraObject@groupInfo[,CamerartHighColumnIndex]+PlusTime))
  Time_ii <- interval_overlap(TimeRun1,TimeRun2)

  imatch = mapply(intersect,Time_ii,Mass_iii)

  for (i in 1:length(imatch)) {
    for(j in imatch[[i]])
    {
      MSMStmpObject<-MSMSdata[[i]]
      attributes(MSMStmpObject)$fileName<-attributes(MSMSdata)$fileName
      listOfMS2Mapped[[as.character(j)]]<-
        c(listOfMS2Mapped[[as.character(j)]],MSMStmpObject)
    }
  }
  for (i in 1:length(imatch)) {

    if(length(imatch[[i]])==0)
    {
      MSMStmpObject<-MSMSdata[[i]]
      attributes(MSMStmpObject)$fileName<-attributes(MSMSdata)$fileName
      listOfUnMapped<-c(listOfUnMapped,MSMStmpObject)
    }
  }
  return(list(mapped=listOfMS2Mapped,unmapped=listOfUnMapped))
}

load(file = inputCamera)

CameraObject<-get(varNameForNextStep)
preprocessingStepsTMP<-preprocessingSteps
mappingResult<-list(mapped=list(),unmapped=list())
for(MS2 in rDataFilesMS2)
{
  load(file = MS2)
  MSMSdata<-get(varNameForNextStep)
  mappingResult<-IntervalMerge(cameraObject = CameraObject,MSMSdata = MSMSdata,PlusTime = rt,
                     MinusTime = rt,ppm = ppm,listOfMS2Mapped = mappingResult$mapped,
                     listOfUnMapped = mappingResult$unmapped)
}

# preprocess MS2s

if(preprocess_ms2==T)
{
source("/usr/bin/preprocessMS2.r")

mappingResult<-preprocess_msms(mapped_msms=mappingResult,
centroid=preprocess_msms_centroid,
merge=preprocess_msms_merge,
centroid_after_merge=preprocess_msms_centroid_after_merge,
ppm=preprocess_msms_ppm,
ppm_precursor=preprocess_msms_ppm_precursor,
abs_mz=preprocess_msms_abs_mz,
abs_mz_precursor=preprocess_msms_abs_mz_precursor,
rt=preprocess_msms_rt,
centroid_onlymapped=preprocess_msms_centroid_onlymapped,
merge_onlymapped=preprocess_msms_merge_onlymapped,
int_threshold=preprocess_msms_int_threshold,
verbose=FALSE)

}

preprocessingSteps<-preprocessingStepsTMP
preprocessingSteps<-c(preprocessingSteps,"mappedMS2")

varNameForNextStep<-as.character("mappingResult")

save(list = c("mappingResult","preprocessingSteps","varNameForNextStep"),file = output)


source('2020-08-31-jsa-type-v2/00-init/main.r')

# See raw files

list.files(v2_dir_data_raw_raw, pattern = "^Apoidea*.*.\\.xlsb")

# Read files

file <- paste0(v2_dir_data_raw, v2_basefile, "_2.csv")
df <- read_escaped_data_v2(file)

dim(df)

# Tables to asssess:
# Species [type locality]
# Global mapper
# Publications
# Authors
# Collectors

# Species ----------------------------------------------------------------------

########### Species status
# Identify which rows to exclude e.g. duplicates, species to exclude,
# odd characters

# CHECK: identify odd characters
# With "z" or numbers only
sum(df$genus == "z")
sum(grepl("[0-9]", df$genus))

# CHECK: identify species status
# Taxonomic levels:
# * Species level: Nominate subspecies (as species), Valid species
# * Below species: Valid subspecies
# * Invalid species: Synonym
# * To exclude: Morphospecies, Unknown
table(df$status)

# STEP: Remove "z"
df <- df[!(genus == "z" | status == "z"), ]

# STEP: Remove numbers
df <- df[!grepl("[0-9]", genus)]

# STEP: Remove duplicated valid species
is_dup <- duplicated(
    df[, c("genus", "species", "author", "date", "status")]
)

df <- df[!is_dup]

# STEP: Remove morphospecies and unknown status
df <- df[!status %in% c("Morphospecies", "Unknown")]

# Notes:
# **Are the species names duplicated?
# Yes they are duplicated between lists, these need to be removed
# Yes there are duplicates within lists as well (but few)
# They need to be combined by global mapper (to identify distribution of sp.)
# or use merged global mapper field.
#
# **How blank synonyms can be resolved?
# Through valid.genus.species.subspecies

########### Dates
# Identify missing dates, date discrepancies

# CHECK: Are date fields missing?
df$date <- as.integer(gsub("\\[[^\\]]*\\]", "", df$date, perl = TRUE))

output <- paste0(v2_dir_data_raw_check, "1-missing-date.csv")

fwrite(
    df[is.na(date)][
        , c("idx", "file",  "genus", "species",
            "author", "date", "author.date")
], output
)

# CHECK: Are date and date.n same?
df$author.date_date <- gsub(".*?([0-9]+).*", "\\1",
    gsub("\\[[^\\]]*\\]", "", df$author.date, perl = TRUE)
)

df$author.date_date.n <- as.integer(df$author.date_date)

df[is.na(author.date_date.n) & date != "z" & author.date != "",
   c("idx", "file", "genus", "species",
     "date", "author.date", "author.date_date")]

fwrite(
    df[!is.na(author.date_date.n) & date != "z" & author.date != ""][
    date != author.date_date.n][,
    c("idx", "file", "genus", "species", "date",
      "author.date_date.n", "author.date")
],
    paste0(v2_dir_data_raw_check, "2-date-discrepancy.csv")
)

########### Locality

# CHECK: Are lat/ lon with non-standard characters?
df$lat_n <- as.numeric(df$lat)
df$lon_n <- as.numeric(df$lon)

fwrite(
    df[(is.na(lat_n) & lat != "") |
        (is.na(lon_n) & lon != ""),
        c("idx", "file", "genus", "species", "lat", "lon")],
    paste0(v2_dir_data_raw_check, "3-lat-lon-non-standard.csv")
)

# ACTION: Replace commas with full stop (without space),
# split text for those with comma, remove equal signs

# CHECK: Are lat/ lon within min and max range?
write.csv(
    df[(abs(lat_n) > 90 | abs(lon_n) > 180),
          c("file", "genus", "species", "lat_n", "lon_n") ],
    paste0(v2_dir_data_raw_check, "4-lat-lon-out-of-range.csv")
)

# CHECK: How many lat/ lon are missing?
table(is.na(df$lat_n) | is.na(df$lon_n))

# CHECK: Are lat/ lon in land based on Ecoregion layer?
df_geo <- df[!(is.na(lat_n) | is.na(lon_n) )]
df_geo <- df_geo[!(abs(lat_n) > 90 | abs(lon_n) > 180)]
v_df <- st_as_sf(df_geo, coords = c("lon_n", "lat_n"), crs = wgs84)
v_df <- st_join(v_df, v_ecoregions, join = st_intersects)

fwrite(
    data.table(
        v_df[is.na(v_df$REALM) | v_df$REALM == "N/A",
        c("idx", "file", "genus", "species", "author", "date", "status")]
    ),
    paste0(v2_dir_data_raw_check, "8-lat-lon-water-ecoregion.csv")
)

# CHECK: Are lat/ lon in land based on Country layer?
v_df <- st_join(v_df, v_continent, join = st_intersects)

table(is.na(v_df$NAME_0))

fwrite(
    data.table(
        v_df[is.na(v_df$NAME_0) &
             !(is.na(v_df$REALM) | v_df$REALM == "N/A"),
            c("idx", "file", "genus", "species", "author", "date", "status",
              "type.country",
              "NAME_0")]),
    paste0(v2_dir_data_raw_check, "9-lat-lon-water-country.csv")
)

# CHECK: Are lat/lon in type country?
df_country <- data.table(v_df)

df_country$type.country_n <- gsub("\\:", "", df_country$type.country)

df_country <- merge(
    df_country, lp_country[, c("DL", "A-3")],
    by.x = "type.country_n", by.y = "DL",
    all.x = T, all.y = F
)

df_country <- merge(
    df_country, lp_dl[, c("DL", "GID_0_owner")],
    by.x = "type.country_n", by.y = "DL",
    all.x = T, all.y = F
)

df_country[!is.na(type.country_n) & !is.na(GID_0_owner),
    c("idx", "type.country_n", "A-3", "GID_0_owner", "GID_0")]

df_country[!is.na(type.country_n) & !is.na(GID_0_owner), ]$`A-3` <-
    df_country[!is.na(type.country_n) & !is.na(GID_0_owner), ]$`GID_0_owner`

# notes:
# type.country_n = type country from dataset in "DL" format
# A-3 = 3 letter code from "type.country_n"
# GID_0_owner = based on type.country_n
# GID_0 = spatially joined based on lat/ lon

# No country assigned to lat/lon
check <- data.table(
    df_country[is.na(GID_0) & !is.na(`A-3`) &
         !(is.na(REALM) | REALM == "N/A"), ]
)

# With country
check <- data.table(
    df_country[!is.na(GID_0) &
         !(is.na(REALM) | REALM == "N/A"), ]
)

table(check$`A-3` == check$`GID_0`)

fwrite(
    check[`A-3` != GID_0,
      c("idx", "file", "genus", "species",
        "author", "date", "status",
        "lat", "lon", "type.country",
        "GID_0")],
      paste0(v2_dir_data_raw_check, "10-lat-lon-type-country-mismatch.csv")
)

# Global distribution ----------------------------------------------------------

names(df)[grepl("global", names(df))]
df$merged.global.mapper[1:10]
df$global.mapper[1:10]

table(is.na(df$global.mapper))
table(is.na(df$merged.global.mapper))

# ACTION: remove words in sq brackets
df$global.mapper_n <-
    gsub("\\[[^\\]]*\\];|\\[[^\\]]*\\]","", df$global.mapper, perl = T)

df_global <- separate_rows(
    df[, c("idx", "global.mapper_n")],
    global.mapper_n,
    sep = " "
)

df_global$global.mapper2 <-
    gsub( ":.*$", "", df_global$global.mapper)

dim(df_global)
df_global <- df_global[!(is.na(global.mapper2) | global.mapper2 == "")]
dim(df_global)

df_global <- merge(
    df_global, lp_country[, c("DL", "A-3", "Country")],
    by.x = "global.mapper2", by.y = "DL",
    all.x = T, all.y = F)

df_global <- merge(
    df_global, lp_dl[, c("DL", "location_long", "GID_0_owner")],
    by.x = "global.mapper2", by.y = "DL",
    all.x = T, all.y = F
)

df_global$cty <- ""

df_global[!is.na(Country)]$cty <- df_global[!is.na(Country)]$`A-3`

df_global[is.na(Country) & !is.na(GID_0_owner)]$cty <-
    df_global[is.na(Country) & !is.na(GID_0_owner)]$GID_0_owner

table(df_global$cty == "")

fwrite(
    df_global[cty==""],
    paste0(v2_dir_data_raw_check, "11c-distribution-format-odd-TO-CHECK.csv")
)

# manually checked

# Others
idxes <- c()

fwrite(
    df[idx %in% idxes,
    c("idx", "file", "genus", "species",
      "author", "date", "status", "global.mapper")],
    paste0(v2_dir_data_raw_check, "11c-distribution-format-odd-CHECKED.csv")
)

# Square brackets not closed
fwrite(
    df[idx %in% c(20694, 16058, 9862, 9342, 22842, 22843, 11449),
     c("idx", "file", "genus", "species",
      "author", "date", "status", "global.mapper")],
    paste0(v2_dir_data_raw_check, "11d-distribution-brackets-odd.csv")
)

df[idx == 1280, c("idx", "file", "genus", "species", "global.mapper")]

# Publication ------------------------------------------------------------------

# CHECK: Are publications unique?
# names(df)
df_pub <- df[, c(2, 28, 36:47)]

df_pubs <- df_pub[, list(
    N = .N,
    idxes = paste0(idx, collapse=", ")
), by = c("date", "paper.authors", "paper.editors",
          "title", "journal", "volume", "issue", "country.of.publication",
          "city.of.publication", "paper.type")][
    order(date, journal, title, paper.authors, volume, issue)
          ]

df_pubs$issue <- paste0("'", df_pubs$issue)
df_pubs$volume <- paste0("'", df_pubs$volume)
df_pubs$page.numbers.publication <- paste0("", df_pubs$page.numbers.publication)

fwrite(
    df_pubs,
    paste0(v2_dir_data_raw_check, "12-pub.csv")
)

# Collector  -------------------------------------------------------------------

# Repository -------------------------------------------------------------------

# Taxonomic ranks

# CHECK: are taxonomic ranks present?
df[grepl("\\?", tolower(genus)), c("idx", "file", "genus", "species",
     "date", "author.date", "status")]

df[, .N, family][order(family)]
df[, .N, tribe][order(tribe)]
df[, .N, genus][order(genus)],

# Date of collection

# CHECK: Are date of description > date of collection?
df$date.of.type.yyyy <- as.numeric(sub('.*(\\d{4}).*', '\\1', df$date.of.type))

df$date.of.type.n <- paste0("''", df$date.of.type)

fwrite(
    df[date.of.type.yyyy > date, c("idx", "file", "genus", "species",
     "date", "author.date", "date.of.type.n", "date.of.type.yyyy")],
    paste0(v2_dir_data_raw_check, "19-date-of-coll.csv")
)

# CHECK: is date of collection erroneous?

# Create a string data field
df$date.of.type.string <- paste0("'", df$date.of.type)
df$date.of.type.dd <- as.numeric(sub("\\D*(\\d+).*", "\\1", df$date.of.type))
df[df$date.of.type.dd>31,]$date.of.type.dd <- NA

# Create month field
df$date.of.type.mm <-
    gsub(
        ".*(Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec).*", "\\1",
        df$date.of.type
    )

df[
    !df$date.of.type.mm %in% c("Jan", "Feb", "Mar", "Apr", "May", "Jun",
                               "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"),
    ]$date.of.type.mm <- ""

# Create year field
df$date.of.type.yyyy <- as.integer(sub('.*(\\d{4}).*', '\\1', df$date.of.type))

# CHECK: is the year of the type collection date < 1700?
fwrite(
    df[as.numeric(df$date.of.type.yyyy) <1700,
        c("idx", "file", "genus", "species",
          "date", "author.date", "status", "date.of.type")],
    paste0(v2_dir_data_raw_check, "20-date-of-coll-1700.csv")
)

# CHECK: is the type collection date month missing?
fwrite(
    df[date.of.type.mm == "" & date.of.type.string != "'NA" &
    grepl("[A-z]", date.of.type.string),
    c("idx", "file", "genus", "species", "date", "author.date", "status",
    "date.of.type.string", "date.of.type.mm")],
    paste0(v2_dir_data_raw_check, "21-date-of-coll-month.csv")
)

# CHECK: is the year of the type collection date missing?
fwrite(
    df[is.na(date.of.type.yyyy) &
    grepl("[0-9]", date.of.type.string),
    c("idx", "file", "genus", "species", "date", "author.date", "status",
    "date.of.type.string", "date.of.type.yyyy")],
    paste0(v2_dir_data_raw_check, "22-date-of-coll-year.csv")
)

# CHECK: Is the valid species field in trinomial form?

valid_species <- gsub("  ", " ", gsub(
    "\\([^\\]]*\\)", "", gsub("\\[[^\\]]*\\]", "",
    df$valid.genus.species.subspecies, perl = TRUE), perl = TRUE
))

valid_species <- lapply(
    valid_species,
    strsplit,
    split = " "
)

df$valid_genus <- unlist(lapply(
    valid_species,
    function(x) gsub("'|=|^-", "", x[[1]][1])
))

df$valid_species <- unlist(lapply(
    valid_species,
    function(x) {
        if(length(x[[1]]) <=3) {
            gsub("'|=|^-", "", x[[1]][2])
        } else {
            NA
        }
    }
))

df$valid_subspecies <- unlist(lapply(
    valid_species,
    function(x) {
        if(length(x[[1]]) <=3) {
            gsub("'|=|^-", "", x[[1]][3])
        } else {
            NA
        }
    }
))

valid_species_len <- unlist(lapply(
    valid_species,
    function(x) length(x[[1]])
))

fwrite(
    df[valid_species_len > 3 ,
    c("idx", "file", "genus", "species", "date", "author.date", "status",
      "valid.genus.species.subspecies", "valid_genus",
      "valid_species", "valid_subspecies")],
      paste0(v2_dir_data_raw_check, "23-valid-species.csv")
)

# Do synonyms have a valid species associated?
df$corrected_valid_species <- ""
df[status=="Synonym", ]$corrected_valid_species <-
    paste0(
        df[status=="Synonym", ]$valid_genus, " ",
        df[status=="Synonym", ]$valid_species
    )

li_valid_species <- unique(paste0(
    df[tolower(status) == "valid species"]$genus, " ",
    df[tolower(status) == "valid species"]$species
))

df$binomial <- paste0(df$genus, " ", df$species)

df$check_binomial <- ifelse(df$binomial == df$corrected_valid_species,
    "Same", "Different")

# CHECK: Is the valid species name same as the synonym name?
fwrite(
    df[check_binomial == "Same" &
        tolower(status) == "synonym" &
       !(corrected_valid_species %in% li_valid_species),
       c("idx", "file", "genus", "species", "date", "author.date", "status",
        "valid.genus.species.subspecies", "valid_genus", "valid_species",
        "check_binomial")],
    paste0(v2_dir_data_raw_check, "24-valid-species-same.csv")
)

# CHECK: Can the valid species name of synonym be matched to a valid species?
fwrite(
    df[check_binomial == "Different" &
        tolower(status) == "synonym" &
       !(corrected_valid_species %in% li_valid_species),
       c("idx", "file", "genus", "species", "date", "author.date", "status",
         "valid.genus.species.subspecies", "valid_genus", "valid_species",
         "check_binomial")],
    paste0(v2_dir_data_raw_check, "25-valid-species-not-in-li.csv")
)