#Area of interest
wdpaid <- '-8.02_51.76_-2.63_55.79'
wdpaid <- '-2.8_44.3_-0.2_46.6'
#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])

#Libraries
library(icesDatras)
library(rworldmap)
library(rworldxtra)
library(tidyr)
library(dplyr)
library(ggplot2)
library(worms)
library(rgdal)
library(rgeos)
#library(RGeostats)
library(viridis)

library(ggplot2)
#Libraries for mask
library(rworldmap)
library(rworldxtra)

#
library(worms)

HH <- data.frame()
for (i in getSurveyList()){
  tmp <- getDATRAS(record = "HH", i, years=1998:2018,1:4)
  HH <- rbind(HH,tmp)
}

HH <- dplyr::mutate(HH, Long=((ShootLong+HaulLong)/2), Lat=((ShootLat+HaulLat)/2))

coast <- rworldmap::getMap(resolution = "high")
coast <- raster::crop(coast, raster::extent(xmin-0.1,xmax+0.1,ymin-0.1,ymax+0.1))

#Subset hauls in our area
HH.in <- HH[HH$Long<xmax & HH$Long>xmin & HH$Lat<ymax & HH$Lat>ymin,]
coast2<-st_as_sf(coast)
sp<-st_as_sf(HH.in,coords=c("Long","Lat"),crs=crs(coast2))

#Points index to keep
SeaPt<-!apply(st_intersects(sp,coast2,sparse=F),1,any)
HH.in <- HH.in[SeaPt,]

#ggplot(HH.in)+geom_point(aes(x=Long,y=Lat,col=Survey))

#Which campaign do we keep
campaign <- names(table(HH.in$Survey)[which(table(HH.in$Survey)==max(table(HH.in$Survey)))])
quarter <- as.integer(names(table(HH.in$Quarter[HH.in$Survey==campaign])[which(table(HH.in$Quarter[HH.in$Survey==campaign])==max(table(HH.in$Quarter[HH.in$Survey==campaign])))]))

#Load campaign for last 10 years
HH <- getDATRAS(record = "HH", campaign, years=2008:2018,quarter)
HL <- getDATRAS(record = "HL", campaign, years=2008:2018,quarter)

#Write NA
{
  HH==-9
  which(HH==-9, arr.ind = T)
  HH[which(HH==-9, arr.ind = T)]
  HH[which(HH==-9, arr.ind = T)]<- NA
}

{
  HL==-9
  which(HL==-9, arr.ind = T)
  HL[which(HL==-9, arr.ind = T)]
  HL[which(HL==-9, arr.ind = T)]<- NA
}

HH<- HH %>% dplyr::select(StNo ,HaulNo ,Year ,ShootLat,ShootLong ,HaulLat ,HaulLong ,Distance )
HL<- HL %>% dplyr::select(StNo ,HaulNo ,Year ,SpecCode, TotalNo)
HL<- unique(HL)

Bio <- HL %>% left_join(HH, by=c("StNo"="StNo","HaulNo"="HaulNo","Year"="Year"))

Bio<- Bio %>% mutate(meanLat= (ShootLat+HaulLat)/2,
                     meanLon= (ShootLong+HaulLong)/2) %>%
  dplyr::select(-ShootLat,-ShootLong ,-HaulLat ,-HaulLong)
Bio <- Bio[Bio$meanLon<xmax & Bio$meanLon>xmin & Bio$meanLat<ymax & Bio$meanLat>ymin,]

Bio.sp <- Bio
Bio <- Bio %>% dplyr::group_by(StNo,HaulNo,Year, meanLon, meanLat) %>% dplyr::summarise(S=length(unique(SpecCode)))

coast <- rworldmap::getMap(resolution = "high")
coast <- raster::crop(coast, raster::extent(xmin-0.1,xmax+0.1,ymin-0.1,ymax+0.1))

ggplot(Bio) + geom_polygon(data=coast, aes(x=long,y=lat,group=group),col="black",fill="grey")+
  geom_point(aes(x=meanLon, y=meanLat, size=S, col=S))+scale_color_viridis_c()+ facet_wrap(~Year)+
  xlab("Longitude")+ylab("Latitude")

#Species names
sp <- wormsbyid(unique(Bio.sp$SpecCode))
names(sp)[1] <- "SpecCode"
Bio.sp <- Bio.sp %>% dplyr::left_join(sp[,c(1,3,13,14,15,16,17,18)],by=("SpecCode"))

if(dim(Benthos <- Bio.sp[Bio.sp$phylum!="Chordata",])[1]>500){
  Benthos <- Bio.sp[Bio.sp$phylum!="Chordata",]
}else{Benthos <- data.frame(StNo=numeric(),HaulNo=numeric(),Year=numeric(),meanLon=numeric(),meanLat=numeric(),Abun=numeric(),group=numeric(), TotalNo <- numeric())}

if(dim(Bio.sp[Bio.sp$class=="Elasmobranchii",])[1]>500){
  Elasmo <- Bio.sp[Bio.sp$class=="Elasmobranchii",]
}else{Elasmo <- data.frame(StNo=numeric(),HaulNo=numeric(),Year=numeric(),meanLon=numeric(),meanLat=numeric(),Abun=numeric(),group=numeric(),class=character(), TotalNo <- numeric())}

tmp <- Bio.sp[Bio.sp$phylum=="Chordata" &Bio.sp$class!="Elasmobranchii",]
keep <- names(which(table(tmp$order)>100))

Bio.order <- Bio.sp[Bio.sp$order %in% keep,]

Bio.order <- Bio.order %>% dplyr::select(StNo ,HaulNo,Year,meanLon,meanLat,order,TotalNo) %>%
  dplyr::group_by(StNo ,HaulNo,Year,meanLon,meanLat,order) %>% dplyr::summarise(Abun=sum(TotalNo, na.rm=T))
Elasmo <- Elasmo %>% dplyr::select(StNo ,HaulNo,Year,meanLon,meanLat,class,TotalNo) %>%
  dplyr::group_by(StNo ,HaulNo,Year,meanLon,meanLat,class) %>% dplyr::summarise(Abun=sum(TotalNo, na.rm=T))
Benthos <- Benthos %>% dplyr::select(StNo ,HaulNo,Year,meanLon,meanLat,TotalNo) %>%
  dplyr::group_by(StNo ,HaulNo,Year,meanLon,meanLat) %>% dplyr::summarise(Abun=sum(TotalNo, na.rm=T))

Bio.order$group <- as.integer(as.factor(Bio.order$order))
Bio.order <- Bio.order %>% dplyr::select(-order)
Elasmo$group <- max(Bio.order$group)+1
Elasmo <- Elasmo %>% dplyr::select(-class)
Benthos$group <- max(Bio.order$group)+2

Sp <- rbind(Bio.order,Elasmo,Benthos)
keep <- c(keep,"Elasmonbranchii","Benthic fauna")

# Etendre le tableau et rajouter lignes de densite
ttsel <- Sp %>% ungroup() %>% dplyr::select(group, Year, meanLon, meanLat, Abun) %>% distinct()
codif <- ttsel %>% dplyr::select( Year, meanLon, meanLat) %>% distinct()
allstrat <- ttsel %>% tidyr::expand(group,Year)
pipo <- dplyr::left_join(allstrat, codif) %>% dplyr::left_join(ttsel) %>% dplyr::mutate(Abun = ifelse(is.finite(Abun), Abun, 0))
Sp0 <- dplyr::left_join(codif, pipo) %>% na.omit()

#Creation du polygon de krigeage

# 1st Polygon
liste <- with(Sp0, chull(meanLon, meanLat))
hull <- Sp0[liste, c("meanLon", "meanLat")]
Poly <- Polygon(hull)

# Create SpatialPolygons objects
SpPoly<- SpatialPolygons(list(Polygons(list(Poly), "SpPoly")))
buff <- raster::buffer(SpPoly, 0.2)

# Cut object along coast
coast <- rworldmap::getMap(resolution = "high")
coast <- raster::crop(coast, raster::extent(xmin-0.1,xmax+0.1,ymin-0.1,ymax+0.1))

res <- gDifference(buff, coast)
PolyCut <- fortify(res)

# Put polygon in good format for later use
toto <- PolyCut[PolyCut$piece==1,]
db.poly <- RGeostats::polygon.create(toto[,c(1,2)])

data.db <- RGeostats::db.create(Sp0)
data.db <- RGeostats::db.locate(data.db, c("meanLon","meanLat"),"x")
data.db <- RGeostats::db.locate(data.db, "Abun","z")

# Boucle vario krigeage sur tout les clusters

Longitude <- numeric()
Latitude <- numeric()
Prediction.std <- numeric()
Variance.std <- numeric()
Year <- numeric()
Cluster <- character()
Prediction <- numeric()
Variance <- numeric()

# Grille de krigeage
grid.db <- RGeostats::db.grid.init(data.db,nodes=c(100,100))
poly <- RGeostats::polygon.create(x=PolyCut[PolyCut$group=="1.1",1],y=PolyCut[PolyCut$group=="1.1",2]) #RGeostats polygon
grid.db <- RGeostats::db.polygon(grid.db, poly)

# Moving or unique neighbouhood
nei1 <- RGeostats::neigh.create(ndim=2,type=0) #unique
nei2 <- RGeostats::neigh.create(ndim=2,type=2,nmini=2,nmaxi=8,radius=1) # moving

for (j in unique(pull(Sp0[,"group"]))){

  data.db <- RGeostats::db.create(Sp0[Sp0$group==j,]) #Choix du cluster
  data.db <- RGeostats::db.locate(data.db,names=c("meanLon","meanLat"),"x")
  data.db <- RGeostats::db.locate(data.db,names=c("Abun"),"z")

  # Standartisation par an
  data.db.std <- data.db
  data.db.std <- RGeostats::db.locate(data.db.std,"Year","code")

  # Vario moyen
  vg.data.std <- RGeostats::vario.calc(data.db.std, lag=0.05, nlag=floor(max(dist(data.db@items[,c(3,4)]))/2)/0.05,opt.code=1,tolcode=0)
  #plot(vg.data.std,npairdw=T,inches=0.1,las=1,add=T,col=2,lwd=2)
  vario1 <- vg.data.std
  vg.mod <- RGeostats::model.auto(vario=vario1, struct=c(1:5), npairdw=TRUE, title= paste0("Communaute", " ", j), size=45,  col="red", inches=.05, draw=F)

  data.db.std <- RGeostats::db.locate(data.db.std,"Year",NA)

  for (i in sort(unique(data.db[,"Year"]))){

    sel <- data.db.std[,"Year"]== i

    if (all(sel==F))
    {Longitude <- c(Longitude, kres@items$x1[kres@items$Polygon==TRUE])
    Latitude <- c(Latitude, kres@items$x2[kres@items$Polygon==TRUE])
    Prediction <- c(Prediction,rep(NA, length(kres@items$x1[kres@items$Polygon==TRUE])))
    Variance <- c(Variance, rep(NA, length(kres@items$x1[kres@items$Polygon==TRUE])))
    Year <- c(Year, rep(i, length(kres@items$x1[kres@items$Polygon==TRUE])))
    Cluster <- c(Cluster, rep(j, length(kres@items$x1[kres@items$Polygon==TRUE])))}else{

      # Ordinary kriging, unique neighbourhood
      sel <- data.db.std[,"Year"]== i
      db.kriege <- RGeostats::db.create(data.db.std[sel])
      db.kriege <- RGeostats::db.locate(db.kriege,names=c("meanLon","meanLat"),"x")
      db.kriege <- RGeostats::db.locate(db.kriege,names=c("Abun"),"z")
      kres <- RGeostats::kriging(db.kriege, grid.db, model = vg.mod, neigh = nei1, uc=c("1"), mean=NA)

      Longitude <- c(Longitude, kres@items$x1[kres@items$Polygon==TRUE])
      Latitude <- c(Latitude, kres@items$x2[kres@items$Polygon==TRUE])
      Prediction <- c(Prediction, kres@items$Kriging.Abun.estim[kres@items$Polygon==TRUE])
      Variance <- c(Variance, kres@items$Kriging.Abun.stdev[kres@items$Polygon==TRUE])
      Year <- c(Year, rep(i, length(kres@items$x1[kres@items$Polygon==TRUE])))
      Cluster <- c(Cluster, rep(j, length(kres@items$x1[kres@items$Polygon==TRUE])))
    }

  }

}
Kriege.logdens<- data.frame(Longitude=Longitude, Latitude=Latitude, Prediction=Prediction, Variance=Variance, Year=Year, Cluster=factor(Cluster))
#save(Kriege.logdens, file="data/krigeage log.RData")

names(Kriege.logdens)[6]<- "Community"
Kriege.logdens$Community<- as.numeric(Kriege.logdens$Community)

Longitude<- numeric()
Latitude<- numeric()
Clust<- numeric()
Community<- numeric()

for (j in unique(data.frame(Kriege.logdens)[,"Community"])){
  Tab1<- Kriege.logdens[Kriege.logdens$Community==j,] %>% dplyr::select(-Variance, -Community)
  Tab2<- pivot_wider(Tab1, names_from = Year, values_from = Prediction)
  metaTab<- Tab2 %>% dplyr::select(Longitude, Latitude)
  Tab2<- Tab2 %>% dplyr::select(-c(Longitude, Latitude))

  #Classification

  distance<- dist(Tab2)
  tree<- fastcluster::hclust(distance, method="ward.D2")

  # Dendrogrammes
  zones<- cutree(tree, 5)

  toto<- cbind(metaTab, Clust=factor(zones))
  toto<- left_join(toto, Kriege.logdens[Kriege.logdens$Community==j,], by=c("Longitude", "Latitude"))
  toto<- toto %>% dplyr::select(Longitude, Latitude, Clust, Community)

  Longitude<- c(Longitude, toto$Longitude)
  Latitude<- c(Latitude, toto$Latitude)
  Clust<- c(Clust, toto$Clust)
  Community<- c(Community, toto$Community)

  tata <- left_join(toto, cbind(metaTab, Tab2))
  tata <- pivot_longer(tata, cols=c(5:dim(tata)[2]), names_to="Year", values_to = "Prediction")
  tata <- tata %>% dplyr::group_by(Year, Clust) %>% dplyr::summarise(Prediction=mean(Prediction))

  ggtata<-  ggplot(tata)+
    geom_point(aes(x=Year, y=Prediction, col=Clust))+
    geom_line(aes(x=Year, y=Prediction, col=Clust, group=Clust))+
    theme_minimal()+
    facet_wrap(.~Clust)

  #print(ggtata)

  tete<- tata
  names(tete)[2]<- "Zones"
  tete<- tata %>% ungroup() %>% dplyr::group_by(Clust) %>% dplyr::summarise(Prediction= mean(Prediction))

  titi<- toto %>% left_join(tete, by="Clust")

}
Tabfaunefin<- data.frame(Longitude=Longitude, Latitude=Latitude, Clust=as.factor(Clust), Community=Community)

for(i in 1:(length(keep)+2)){
  Tabfaunefin$Community[Tabfaunefin$Community==i] <- keep[i]
}

Bio.classif <- ggplot(Tabfaunefin)+
  geom_raster(aes(x=Longitude,y=Latitude,fill=Clust))+facet_wrap(~Community)+scale_fill_viridis_d()+theme_minimal()+
  geom_polygon(data=PolyCut[PolyCut$group==1.1,],aes(x=long, y=lat, group=group), col="black", fill=NA)+
  ggtitle("Classificiation of biological groups in selected area")

print(Bio.classif)


#!/usr/bin/Rscript

library(fields)
library(GGally)
library(ggplot2)
library(Hmisc)
library(igraph)
library(mapproj)
library(maps)
library(pander)
library(plyr)
library(RColorBrewer)
library(reshape2)
library(scales)
source('custom-plot-functions.r')

load(file='mantel-testing-checkpoint1.RData')

## plotting

### jflowmap
projection <- 'azequalarea'
orientation <- c(30.82,-98.57,0)
#scale of 1 does not allow good edge-bundling with this projection
scale <- 100

data('flows.matrix', package='sds')
adjmatrix <- data.matrix(flows.matrix[state.abb, state.abb])
diag(adjmatrix) <- 0
g <- graph.adjacency(adjmatrix, mode='directed', weighted='flow')
stopifnot(colnames(adjmatrix) == V(g)$name)
CC <- pop.dyn.mats$lag1
V(g)$PEDVpositive <- V(g)$name %in% colnames(CC)
key <- match(V(g)$name, state.abb)
proj <- mapproject(x=state.center$x[key], y=state.center$y[key],
                   projection=projection, orientation=orientation)
V(g)$x <- proj$x*scale
V(g)$y <- proj$y*scale
adjmatrix <- pop.dyn.mats$lag1
diag(adjmatrix) <- 0
g2 <- graph.adjacency(adjmatrix, mode='directed', weighted='crossCorrelation')
E(g2)$ccShifted <- E(g2)$crossCorrelation + 1
g3 <- graph.union(g, g2)
adjmatrix <- (adjmatrix + t(adjmatrix))/2
g2 <- graph.adjacency(adjmatrix, mode='undirected', weighted='symCC')
#g3 <- graph.union(g3, g2)
#V(g3)$name <- paste('US', V(g3)$name, sep='-')
g3 <- delete.vertices(g3, c('AK', 'HI'))
write.graph(g3, file='swine-flows-CC.xml', format='graphml')

scl <- 1.8
png(file='us-background.png', width=535*scl, height=283*scl)
par(mai=rep(0,4))
map('state', mar=rep(0,4), projection=projection, orientation=orientation,
    resolution=0, myborder=0, col='dark grey', lwd=3)
bbox <- par('usr')*scale
# uncomment to verify bbox
#do.call(rect, c(as.list(bbox[c(1,3,2,4)]/scale), lwd=30))
dev.off()

# bbox as read by jflowmap
paste(bbox[1], -bbox[4], bbox[2]-bbox[1], bbox[4]-bbox[3], sep=',')

## choropleths

theme_clean <- function (base_size=12) {
  theme_grey(base_size) %+replace% theme(
      axis.title = element_blank (),
      axis.text = element_blank (),
      panel.background = element_blank (),
      panel.grid = element_blank (),
      axis.ticks.length = unit (0,"cm"),
      axis.ticks.margin = unit (0,"cm"),
      panel.margin = unit (0,"lines"),
      plot.margin = unit(c(0,0,0,0),"lines"),
      complete =TRUE)
}

state_map <- map_data("state")

## use data from cumulative burden analysis to ensure consistency

get_map_data <- function(){
    load('pedv-cum.RData')
    key <- match(mg$State, state.abb)
    ret <- data.frame(label=mg$State, state=tolower(state.name[key]),
                           Cases=mg$cases, Inventory=mg$inventory2012,
                           x=mg$stateLong, y=mg$stateLat)
    ret$Cases <- ifelse(ret$Cases == 0, NA, ret$Cases)
    ret
}

map_data <- get_map_data()
## manually position some state labels
i <- which(map_data$label=='NH')
dy <- 1.4
map_data$x[i] <- -68.08
map_data$y[i] <- map_data$y[map_data$label=='VT'] - 1.3
ii <- which(map_data$label=='MA')
map_data$x[ii] <- map_data$x[i]
map_data$y[ii] <- map_data$y[i] - dy
ii <- which(map_data$label=='RI')
map_data$x[ii] <- map_data$x[i] - 0.3
map_data$y[ii] <- map_data$y[i] - 2*dy
i <- which(map_data$label=='DE')
map_data$x[i] <- map_data$x[i] + 2
map_data$y[i] <- map_data$y[i] - 1
ii <- which(map_data$label=='NJ')
map_data$x[ii] <- map_data$x[i] + 1.2
map_data$y[ii] <- map_data$y[ii] - 1.2
i <- which(map_data$label=='CT')
map_data$x[i] <- map_data$x[ii] + 0.5
map_data$y[i] <- map_data$y[i] - 1.7
i <- which(map_data$label=='MD')
map_data$x[i] <- map_data$x[ii] - 1.8
map_data$y[i] <- map_data$y[i] - 3

get_endpoints <- function(state){
    i1 <- which(map_data$label==state)
    i2 <- which(state.abb==state)
    data.frame(x=state.center$x[i2], y=state.center$y[i2],
               xend=map_data$x[i1] - 1.5, yend=map_data$y[i1] + 0.3)
}

g <- make_choropleth(fill_var='Cases')
ggsave(filename='cases-choropleth.pdf', plot=g, width=8.6/2.54, height=8.6/2.54)
g <- make_choropleth('Inventory')
ggsave(filename='inventory-choropleth.pdf', plot=g, width=8.6/2.54, height=8.6/2.54)

### ggPairs

mats2 <- list(shipment=pop.struct.mats$shipment, lag1=pop.dyn.mats$lag1,
              gcd=pop.struct.mats$gcd)

getData <- function(dists, sym, rankv){
    if(sym){
        dists <- (dists + t(dists))/2
    }
    ret <- as.vector(as.dist(dists))
    if(rankv){
        ret <- rank(ret)
      }
    return(ret)
}
tmpf <- function(x, ...){
  sapply(mats2, getData, sym=x, ...)
}
tmpff <- function(x) {
    lapply(c(undirected=TRUE, directed=FALSE), tmpf, rankv=x)
}
matData <- lapply(c(ranked=TRUE, original=FALSE), tmpff)

theme_set(theme_classic())
theme_update(panel.grid.major=element_blank(), panel.grid.minor=element_blank(),
             axis.ticks=element_blank(), panel.border=element_blank(),
             axis.line=element_blank())

des.data <- rbind(dyn.v.struct.tests, struct.v.struct.tests)
pm <- makePlotMat(dfl=matData, type='directed', transform='ranked',
                  des.data=des.data)
pdf(file='ggpairs-spearman-directed.pdf', width=8.6/2.54, height=8.6/2.54)
print(pm)
dev.off()

pm <- makePlotMat(dfl=matData, type='undirected', transform='ranked',
                  des.data=des.data)
pdf(file='ggpairs-spearman-undirected.pdf', width=8.6/2.54, height=8.6/2.54)
print(pm)
dev.off()

pm <- makePlotMat(dfl=matData, type='directed', transform='original',
                  labelBreaks=TRUE, gridLabelSize=2.0, des.data=des.data)
plotMatDirectedPearson <- pm
pdf(file='ggpairs-pearson-directed.pdf', width=9.5/2.54, height=6.6/2.54)
print(pm)
dev.off()

pm <- makePlotMat(dfl=matData, type='undirected', transform='original',
                  labelBreaks=TRUE, des.data=des.data)
pdf(file='ggpairs-pearson-undirected.pdf', width=11.4/2.54, height=1.2*8.6/2.54)
print(pm)
dev.off()

### diagnostics

df <- data.frame(epl=unclass(as.dist(pop.struct.mats$shipment)),
                     CC=unclass(as.dist(pop.dyn.mats$lag1)))
m <- lm(CC~epl, data=df)
pdf('diagnostics.pdf')
plot(m)
dev.off()

## image plots

pdf('cors-heatmap.pdf')
orderings <- heatmap(data.matrix(pop.struct.mats$shipment), scale='none')
dev.off()

makeImagePlot <- function(M, orderings, ...){
    x <- data.matrix(M)[orderings$rowInd, orderings$colInd]
    x <- t(x)
    col <- brewer.pal(9, 'Blues')
    nc <- ncol(x)
    nr <- nrow(x)
    xi <- 1:nr
    yi <- 1:nc
    names(xi) <- colnames(x)
    names(yi) <- rownames(x)
    image.plot.ebo(x=xi, y=yi, z=x, horizontal=FALSE,
                   col=col, graphics.reset=TRUE, ...)
}

pdf('matrices.pdf', width=8.7/2.54, height=12/2.54)
layout(matrix(1:2, ncol=1))
par(mar=c(4,4.5,.5,.5))
makeImagePlot(M=data.matrix(pop.struct.mats$shipment), orderings=orderings, xlab='Destination', ylab='Source',
              legend.args=list(text=expression(paste(Log[10], '(#swine / y)')),
                  line=2.9, side=4), panelLab='a')
par(mar=c(4,4.5,1,.5))
CCnoDiag <- pop.dyn.mats$lag1
diag(CCnoDiag) <- NA
makeImagePlot(M=data.matrix(CCnoDiag), orderings=orderings, xlab='Leading state', ylab='Lagging state',
              legend.args=list(text='Cross correlation', line=2.9, side=4), panelLab='b')
dev.off()

### time series

data('real.case.data', package='sds')
mts <- melt(real.case.data, id='week')
keepers <- c('MN', 'KS',
             'IL', 'OK',
             'IA', 'NC')
test <- mts$variable %in% keepers
mts <- mts[test, ]
mts$variable <- factor(mts$variable, levels=keepers)
mts$x <- mts$week
labdf <- ddply(mts, 'variable', summarize, minx=x[1], maxy=max(value))
labdf$minx[labdf$variable == 'OK'] <- as.Date('2013-11-01')

tmpf <- function(df){
    g <- ggplot(df, aes(x=x, y=value, group=variable))
    g <- g + geom_hline(yintercept=0, size=0.25, col='grey')
    g <- g + geom_step(direction="vh", size=0.25)
    g <- g + facet_wrap(~variable, ncol=2, scales='free_y')
    g <- g + scale_x_date()
    g <- g + scale_y_discrete(breaks=pretty_breaks(n=2))
    g <- g + xlab('2013-2014 Date') + ylab('Positive accessions')
    g <- g + theme_classic()
    g <- g + theme(strip.background = element_blank(),
                   strip.text.x = element_blank())
    g <- g + theme(plot.margin=unit(c(0,2,2,0),"mm"))
    g <- g + geom_text(data=labdf, hjust=0, vjust=1, size=10 * 0.35,
                       aes(x=minx, y=maxy, label=variable))
    g <- g + theme(axis.title.x = element_text(vjust=-0.5))
    g <- g + theme(text = element_text(size=10))
    g <- g + theme(line = element_line(size=0.25))
}
g <- tmpf(mts)

ggsave('ts.pdf', width=8.6/2.54, height=6/2.54)

### composite time series and scatterplot matrix

tmpf <- function(){
    grid.newpage()
    lay <- grid.layout(1,2, widths=unit(c(8.6,8.6), 'cm'),
                       heights=unit(c(6), 'cm'))
    pushViewport(viewport(layout=lay))
    pushViewport(viewport(layout.pos.col=1, layout.pos.row=1))
    myPrintGGpairs(plotMatDirectedPearson, newpage=FALSE)
    grid.text(label="a", x=unit(0, "npc") - unit(1.5, "lines"),
              y=unit(1, "npc"), just= "left", gp=gpar(fontsize=10))
    popViewport()
    pushViewport(viewport(layout.pos.col=2, layout.pos.row=1))
    print(g, newpage=FALSE)
    grid.text(label="b", x=unit(0, "npc"), y=unit(1, "npc"),
              just= "left",  gp=gpar(fontsize=10))
    popViewport()
}

cairo_ps(filename = 'plotMatrixWithTimeSeries.eps', width = 19/2.54, height = 6.4/2.54)
tmpf()
dev.off()

cairo_pdf(filename = 'plotMatrixWithTimeSeries.pdf', width = 19/2.54, height = 6.4/2.54)
tmpf()
dev.off()


#---
#title: "pairwise identity from VCF file function"
#author: "Tal Dahan-Meir"
#date: "18/08/2021"
#---

### Ammiad summarize identity from vcf (ammiad_summarize_vcf) ###
### This function gets a vcf and a map (with the coordinates of the sampling points), and retrieves a summarizing table into output_csv_path ###
##########################################

ammiad_summarize_vcf <- function (vcf_path = NULL,
								 map_csv_path = NULL,
								 output_csv_path = NULL,
								 identity_threshold = 0.981)
{

if (is.null(vcf_path)) { stop("please enter path to samples .vcf file")}
if (is.null(map_csv_path)) { stop("please enter path map .csv file")}
if (is.null(output_csv_path)) { stop("please define path for output table (.csv)")}

### dependencies ###
require(igraph)
require(data.table)

### load and clean vcf ###

cat("loading files..\n")
vcf = fread(vcf_path)
ammiad_map = read.csv(map_csv_path, stringsAsFactors = FALSE, row.names="name")
vcf_tab_clean = vcf[,10:ncol(vcf)]
vcf_tab_clean_0_3 = t ( apply (vcf_tab_clean,1,function(x) { as.character(substring(x,1,3)) }) )
vcf_tab_clean_0_3 = replace(vcf_tab_clean_0_3,vcf_tab_clean_0_3 == "./.","none")
colnames(vcf_tab_clean_0_3) = colnames(vcf_tab_clean)
samples = colnames(vcf_tab_clean_0_3)

### get heterozygosity ###

homoz_het = vcf_tab_clean_0_3
homoz_het[,]="het"
homoz_het[grepl("0/0|1/1|2/2|3/3",vcf_tab_clean_0_3)] = "hom"
homoz_het[grepl("none",vcf_tab_clean_0_3)] = "none"
homoz_frac = apply(homoz_het,2,function(x){100*(sum(x=="het")/length(x))})
names(homoz_frac) = colnames(homoz_het)
sort(homoz_frac)

### get alternative allele fraction ###

alternative=vcf_tab_clean_0_3
alternative[,]="alt"
alternative[grepl("0/0",vcf_tab_clean_0_3)] = "ref"
alt_frac = apply(alternative,2,function(x){100*(sum(x=="alt")/length(x))})
sort(alt_frac)

### get covered positions per plant ###

covered = vcf_tab_clean_0_3
covered[,]="cov"
covered[grepl("none",vcf_tab_clean_0_3)] = "not"
covered_frac = apply(covered,2,function(x){100*(sum(x=="cov")/length(x))})
covered_sum = apply(covered,2,function(x){sum(x=="cov")})
names(covered_frac) = colnames(covered)

#sort(covered_frac)
#sort(covered_sum)

### calculate pairwise identity ###

vcf_tab_clean_0_3 = replace(vcf_tab_clean_0_3,vcf_tab_clean_0_3 == "none",NA)
similarity.matrix<-apply(vcf_tab_clean_0_3,2,function(x)colSums(x==vcf_tab_clean_0_3, na.rm=TRUE))
Ncomparisons_matrix=apply(vcf_tab_clean_0_3,2,function(x)colSums(!is.na(x==vcf_tab_clean_0_3)))
identity.matrix=similarity.matrix/Ncomparisons_matrix

### plot pairwise identity distribution of Ammiad (removing Zavitan controls) ###

no_z=identity.matrix[!grepl(as.character("Zavitan"),rownames(identity.matrix)),!grepl("Zavitan",colnames(identity.matrix))]
#hist(no_z[lower.tri(no_z)],breaks=60,col="#a1d99b",border="#74C476")

### for every plant, find all plants that has at least X (identity_threshold) identity to it ###

require(igraph)
require(data.table)

identity_threshold=0.981
my_list=list()
for (i in 1:ncol(identity.matrix))
{
relevant_vector = rownames(identity.matrix)[identity.matrix[,i] >= identity_threshold]
my_list[[i]]=relevant_vector
}
names(my_list) = colnames(identity.matrix)

overlap <- function(u, v) length(intersect(u, v)) / min(length(u), length(v)) > 0.8
adj <- sapply(my_list, function(u) sapply(my_list, overlap, u)) + 0
g <- graph_from_adjacency_matrix(adj)
memb <- components(g)$membership
s <- split(my_list, memb)
groups <- lapply(s, function(x) unique(unlist(x)))
cat(paste0("getting info from ",length(groups), " groups\n"))
#length(groups)

### assign names to distinct genotype groups ###

names(groups) <- paste("G",1:length(groups),sep="")
lengths=as.vector(sapply(groups, length))
#sort(lengths)

### make table with groups and levels ###

m1=max(lengths(groups))
d1=as.data.frame(do.call(rbind,lapply(groups,'length<-',m1)),stringsAsFactors=FALSE)
names(d1)=paste0("Level",seq_along(d1))
csv=d1
 group_sizes = apply(csv,2,function(x){sum(!is.na(x))})

groups_vector = c()
for (i in 1:length(group_sizes)){
groups_vector = c(groups_vector,rep(i,group_sizes[i]))}
groups_list = apply(csv,2,function(x){as.character(x)[!is.na(x)]})
names(groups_vector) = unlist(groups_list,use.names=FALSE)

### get year of plant collection, excluding controls ###

cat("generating final table..\n")
year_vec = ifelse(grepl("^TTD",samples),"TTD",ifelse(grepl("Zavitan",samples),gsub("_Zavitan","",samples),substring(samples,1,4)))

### get Position (A/B/C/D or TTD or Zavitan for controls) ###

position_vec = ifelse(grepl("^TTD",samples),"TTD",ifelse(grepl("Zavitan",samples),"Zavitan",substring(samples,5)))

### get the group of the sample ###

group_vec = c()
for (i in 1:length(samples)){
for (j in 1:length(groups)) {
if (sum(samples[i] %in% groups[[j]])>0) { group_vec=c(group_vec,names(groups)[j]); next;}
}}

### get the size of groups (how many inidividulas in that group) ###

group_sizes_vec = unlist(lapply(groups,length))[group_vec]

### get Coverage (sum of covered positions, from “covered_sum”) ###

coverage_vec = covered_sum[samples]

### get Heterozygosity fraction (from “homoz_frac”) ###

homozVec = homoz_frac[samples]

### get Alternative allele count (from alt_frac) ###

alt_vec = alt_frac[samples]

### generate a unified table ###

samples_df = data.frame(Sample = samples,
						Year = year_vec,
					  Position = position_vec,
						IGG = group_vec,
						Group_size = group_sizes_vec,
						Coverage = coverage_vec,
						Heterozygosity = homozVec,
						Alternative = alt_vec,row.names=samples)

### get metadata from map.csv file ###

ammiad_map_f = ammiad_map[rownames(ammiad_map) %in% samples_df$Position,]
missing_points = setdiff(rownames(ammiad_map),rownames(ammiad_map_f))
cat(paste0("missing samples for these ",length(missing_points)," points:\n"))
cat(paste0(missing_points,"\n"))
samples_df[,c("Longitude","Latitude","Height","Habitat","Habitat_order","Transect_order","dist")] = NA
matches = match(samples_df$Position,rownames(ammiad_map_f))
valid_matches = !is.na(match(samples_df$Position,rownames(ammiad_map_f)))
samples_df[valid_matches,c("Longitude","Latitude","Height","Habitat","Habitat_order","Transect_order","dist")] = ammiad_map_f[matches[valid_matches],c("lon","lat","ele","habitat","order_habitat","order_transect","dist")]

### write into csv ###

cat(paste0("\nwriting output file: ", output_csv_path,"\n"))
write.csv(samples_df, file = output_csv_path,row.names=FALSE)
}

##################################################################################
##################################################################################

### assign colors to DGGs (ammiad_colorize_by_groups) ###
### This function gets a summarized table of samples and update it according to a colors table ###
################################

ammiad_colorize_by_groups <- function (summarized_table_path = NULL,
																			colors_table_path = NULL,
																		  output_csv_path = NULL)
{
if (is.null(summarized_table_path)) {stop ("define path to summarized .vcf !")}
if (is.null(colors_table_path)) {stop ("define path to .vcf specifying colors !")}
if (is.null(output_csv_path)) {stop ("define path for output .csv file !")}

output_tab = read.csv(summarized_table_path)
colors_tab = read.csv(colors_table_path)
output_tab$color = colors_tab$color [match(output_tab$IGG,colors_tab$IGG)]
write.csv(output_tab, file = output_csv_path)
cat(paste0("added ",length(table(colors_tab$color))," different colors to ", nrow(output_tab), " samples\n"))
cat(paste0("saved at: ", output_csv_path))
}

##################################################################################
##################################################################################


open boat.xyz
bond 1.55
model GAFF
thermostat ANDERSEN
energy
minimize 0.0001 0.00001 40000 1000 min.xyz
energy
heat 300 50 400 0.01 0.01 0.0001 0.00001 0.3 heat.xyz
temperature
energy
prod 0.0001 0.0001 300 .3 5000000 1000 prod.xyz


#!/usr/bin/env Rscript
# Reduce dimensions for a SCE
#  Combiz Khozoie <c.khozoie@imperial.ac.uk>

#   ____________________________________________________________________________
#   Initialization                                                          ####

options(mc.cores = future::availableCores())

##  ............................................................................
##  Load packages                                                           ####
library(argparse)
library(scFlow)
library(parallel)
library(SingleCellExperiment) # due to monocle3 missing namespace::
library(knitr) # due to missing knitr:: namespace in the integrate report

##  ............................................................................
##  Parse command-line arguments                                            ####

# create parser object
parser <- ArgumentParser()

# specify options
required <- parser$add_argument_group("Required", "required arguments")
optional <- parser$add_argument_group("Optional", "required arguments")

required$add_argument(
  "--sce_path",
  help = "-path to the SingleCellExperiment",
  metavar = "dir",
  required = TRUE
)

required$add_argument(
  "--cluster_method",
  help = "method to use for clustering",
  metavar = "louvain",
  required = TRUE
)

required$add_argument(
  "--reduction_method",
  help = "reduced dimension embedding to use for clustering",
  metavar = "UMAP",
  required = TRUE
)

required$add_argument(
  "--res",
  type = "double",
  default = 0.00001,
  help = "clustering resolution",
  metavar = "N",
  required = TRUE
)

required$add_argument(
  "--k",
  type = "integer",
  default = 100,
  help = "the number of kNN",
  metavar = "N",
  required = TRUE
)

required$add_argument(
  "--louvain_iter",
  type = "integer",
  default = 1,
  help = "number of iterations used for Louvain clustering",
  metavar = "N",
  required = TRUE
)

### . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . ..
### Pre-process args                                                        ####

args <- parser$parse_args()

##  ............................................................................
##  Start                                                                   ####

sce <- read_sce(args$sce_path, read_metadata = TRUE)

sce <- cluster_sce(
    sce,
    cluster_method = args$cluster_method,
    reduction_method = args$reduction_method,
    res = args$res,
    k = args$k,
    louvain_iter = args$louvain_iter
    )

##  ............................................................................
##  Save Outputs                                                            ####

# Save SingleCellExperiment
write_sce(
  sce = sce,
  folder_path = file.path(getwd(), "clustered_sce"),
  write_metadata = TRUE
  )

##  ............................................................................
##  Clean up                                                                ####

# Clear biomart cache


# v1.1 on Jul 16 2021 to predict all the tiles

# rm(list=ls(all=TRUE));

# 4-layer 0.1 sample rate
# rm(list=ls(all=TRUE)); samplerate <- 0.1; con_layer <- 2; is_shallow=TRUE ; learningrate <- 0.01; is_norm <- TRUE;  beta.coe<-1E-3;    iters <- 32000;  source("Pro.load.predict.image.CDL.v1.1.r")

# 4-layer 0.9 sample rate
# rm(list=ls(all=TRUE)); samplerate <- 0.9; con_layer <- 2; is_shallow=TRUE ; learningrate <- 0.01; is_norm <- TRUE;  beta.coe<-1E-3;    iters <- 300000; source("Pro.load.predict.image.CDL.v1.1.r")

# read hdf4 refer to
# https://stackoverflow.com/questions/36772341/reading-hdf-files-into-r-and-converting-them-to-geotiff-rasters

ptm_cnn_start <- proc.time();

# Hank on Jul 11, 2021
currentwd <- getwd();
setwd("../");
source("rf.my.r");
source("cnn.metric.batch.validation.r");
source("split.training.testing.r");
setwd(currentwd);

##***************************************************************************************************
## parameters needed to be adjusted in your own computer
## input file name
linux_folder=".";
if (R.Version()$os == "linux-gnu") linux_folder="/gpfs/data2/workspace/zhangh/dump";
if (R.Version()$os == "linux-gnu") linux_folder="/gpfs/data1/hankui/zhangh/dump"; ## changed on Dec 30 2019 to reflect the broken hardware of /gpfs/data2
filename <- paste(linux_folder, "/metric.ard.cdl.Mar01.18.40.txt", sep="");
## number of threads when running paralleling computation depending on the number of available cores
MAX_THREADS <- 24L;
# MAX_THREADS <- 36L;

##***************************************************************************************************
## load parameters
# meanx <- apply(x_input, 2, mean);
# sdx   <- apply(x_input, 2, sd);
# x_input_norm <- t((t(xtrain[train.index,])-meanx)/sdx)
# save (classes, file="parameters.rfile.data")
load(file="parameters.rfile.data")
classn = length (classes)
max_change_rate = 5
input_dim_x=13; input_dim_y=3
input_dim_stacked <- input_dim_x*input_dim_y;
permutation <- 0;
unique.file.name <- paste("DNN_type", con_layer, ".is_shallow", is_shallow, ".sample", samplerate,
	".learning", learningrate, ".is_norm", is_norm,
	".perm", permutation[1], ".beta", beta.coe,
	".iter", iters, ".max_change", max_change_rate, sep="");

modir.dir <- paste0("./model.dir/",unique.file.name);
model.file.name <- paste(modir.dir, "/model.", unique.file.name, sep="");
load(file=paste0(modir.dir,"/mean_std.rfile.data"))

## get cnn model
cat("\nLoad the prediction model....\n");
tf$reset_default_graph();
x  <- tf$placeholder(tf$float32, shape(NULL, input_dim_stacked));
bg_build_graph_test <- build_graph(con_layer, is_training=FALSE, x, input_dim_x, input_dim_y, is_norm=is_norm, is_shallow=is_shallow);
y_conv_test <- bg_build_graph_test$y_conv;
pred <- tf$argmax(y_conv_test, 1L);
session_conf <- tf$ConfigProto(intra_op_parallelism_threads=MAX_THREADS, inter_op_parallelism_threads=MAX_THREADS);
# sess <- tf$InteractiveSession();
sess <- tf$InteractiveSession(config=session_conf);
sess$run(tf$global_variables_initializer())
saver <- tf$train$Saver();
saver$restore(sess, model.file.name);

##***************************************************************************************************
## set directory
require("raster")
DIR="/gpfs/data2/workspace/zhangh/ard.Mar01.2018/metric.of.daily/"
DIR_TIF="/gpfs/data2/workspace/zhangh/ard.Mar01.2018/metric.of.daily.tif/"
CNN_TIF=paste0("/gpfs/data2/workspace/zhangh/ard.Mar01.2018/cdl.samplerate",samplerate,".is_shallow",is_shallow,"/")
if (! dir.exists(DIR_TIF)) {print(paste("Creating dir", DIR_TIF)); dir.create(DIR_TIF); }
if (! dir.exists(CNN_TIF)) {print(paste("Creating dir", CNN_TIF)); dir.create(CNN_TIF); }
h= 4; v=11
h= 4; v= 9
h=15; v= 6 ## South Dakota

# for (h in c(0:32)) {
# for (v in c(0:21)) {
for (h in c(15:15)) {
for (v in c( 6: 6)) {
	##***************************************************************************************************
	## load image
	hv_str = paste0("h", sprintf("%02d",h),"v",sprintf("%02d",v))
	bands_file = paste0(DIR,"daily.metric.",hv_str,".hdf")
	ratio_file = paste0(DIR,"daily.metric.",hv_str,".hdf.ratio.hdf")
	if (!(file.exists(bands_file) && file.exists(ratio_file) )) {
		cat("!!! file does not exists ", hv_str, "\n")
		next
	}
	library(gdalUtils)

	# Provides detailed data on hdf4 files but takes ages
	gdalinfo(bands_file)
	# Tells me what subdatasets are within my hdf4 MODIS files and makes them into a list
	sds <- get_subdatasets(bands_file)
	sds[ 8:12] ## 25% percentile bands 2-7
	sds[14:18] ## 50% percentile bands 2-7
	sds[20:24] ## 75% percentile bands 2-7
	sds[38:40] ## 25%, 50% and 75% for NDVI
	IMAGE_DIM = 5000
	x_input =  matrix(,nrow=IMAGE_DIM*IMAGE_DIM,ncol= 39 );

	## 25% percentile bands 2-7
	for (i in c(1:5)) {
		print (i+7)
		band = i+1
		if (i>=5) band = i+2
		tif_file_name = paste0(DIR_TIF,"daily.metric.",hv_str,".25percent.band", band,".tif")
		print (tif_file_name)
		if (!(file.exists(tif_file_name))) gdal_translate(sds[i+7], dst_dataset = tif_file_name)
		rast <- raster(tif_file_name)
		x_input[,i] = as.vector(rast)
	}
	## 50% percentile bands 2-7
	for (i in c(1:5)) {
		print (i+13)
		band = i+1
		if (i>=5) band = i+2
		tif_file_name = paste0(DIR_TIF,"daily.metric.",hv_str,".50percent.band", band,".tif")
		print (tif_file_name)
		if (!(file.exists(tif_file_name))) gdal_translate(sds[i+13], dst_dataset = tif_file_name)
		rast <- raster(tif_file_name)
		x_input[,i+6] = as.vector(rast)
	}
	## 50% percentile band 1
	band = 1
	tif_file_name = paste0(DIR_TIF,"daily.metric.",hv_str,".50percent.band", band,".tif")
	print (tif_file_name)
	if (!(file.exists(tif_file_name))) gdal_translate(sds[13], dst_dataset = tif_file_name)

	## 75% percentile bands 2-7
	for (i in c(1:5)) {
		print (i+19)
		band = i+1
		if (i>=5) band = i+2
		tif_file_name = paste0(DIR_TIF,"daily.metric.",hv_str,".75percent.band", band,".tif")
		print (tif_file_name)
		if (!(file.exists(tif_file_name))) gdal_translate(sds[i+19], dst_dataset = tif_file_name)
		rast <- raster(tif_file_name)
		x_input[,i+12] = as.vector(rast)
	}

	## ndvi
	for (i in c(1:3)){
		# ii = 6*i
		tif_file_name = paste0(DIR_TIF,"daily.metric.",hv_str,".",25*i,"percent.ndvi",".tif")
		print (tif_file_name)
		if (!(file.exists(tif_file_name))) gdal_translate(sds[37+i], dst_dataset = tif_file_name)
		rast <- raster(tif_file_name)
		x_input[,6*i ] = as.vector(rast)
	}

	# Provides detailed data on hdf4 files but takes ages
	gdalinfo(ratio_file)
	# Tells me what subdatasets are within my hdf4 MODIS files and makes them into a list
	sds <- get_subdatasets(ratio_file)
	# 35 = 5% * 7 bands in the order of % then band
	xi = 18
	for (i in c(1:3)){
	for (b in c(1:7)){
		sdsi = (b-1)*5+i+1
		xi = xi+1
		print (sdsi)
		tif_file_name = paste0(DIR_TIF,"daily.metric.",hv_str,".",25*i,"percent.ratio",b,".tif")
		print (tif_file_name)
		if (!(file.exists(tif_file_name))) gdal_translate(sds[sdsi], dst_dataset = tif_file_name)
		rast <- raster(tif_file_name)
		x_input[,xi ] = as.vector(rast)
	}}

	## test
	x_input[40*5000+41,]

	## ***********************************************************************************************
	## get prediction
	cat("\nStart to predict....for ", hv_str, "\n");
	temp.x = x_input
	PREDICTED <- vector(mode="integer", length=IMAGE_DIM*IMAGE_DIM);
	PREDICTED[] <- 0
	predict_index <- x_input[,6]!= -32768 & x_input[,6]!= -32768 & x_input[,6]!= -32768

	x_input <- cbind(temp.x[, 1:6], temp.x[, 19:25], temp.x[, c(1:6)+6], temp.x[, c(19:25)+7], temp.x[, c(1:6)+12], temp.x[, c(19:25)+14]);
	x_input_norm <- t((t(x_input)-meanx)/sdx)
	# cat("\tafter restore the saved model\n");
	ptm_cnn_i <- proc.time();
	total_lines = 10
	each_sub_n = IMAGE_DIM*IMAGE_DIM/total_lines
	predicted <- vector(mode="integer", length=sum(predict_index));
	subi_start = 1
	subi_end = 0
	for (i in c(1:total_lines)) {
		sub_index = c(1:each_sub_n)+(i-1)*each_sub_n
		pre_n_i = sum(predict_index[sub_index])
		cat("\nprocess line ", i, " of ", total_lines, " start at ", sub_index[1])
		if (pre_n_i>=1) {
			subi_end = pre_n_i+subi_start-1
			predicted[subi_start:subi_end]  <- pred$eval(feed_dict = dict(x = x_input_norm[sub_index,][predict_index[sub_index],]));
			subi_start = subi_end+1
		}
		# predicted  <- pred$eval(feed_dict = dict(x = x_input_norm[predict_index,]));
		# if (i>2) break
	}

	predicted2 <- predicted;
	unique_pred <- sort(unique(predicted))
	for ( i in  unique_pred) predicted2[predicted==i] <- classes[i+1];	## convert from a number from 1:n to class label
	PREDICTED[predict_index] <- predicted2
	time.test <- proc.time() - ptm_cnn_i;

	## ***********************************************************************************************
	## save prediction
	current_crs <- crs(rast);
	current_extent <- extent(rast);
	output.raster <- raster(t(matrix(PREDICTED,nrow = IMAGE_DIM,ncol = IMAGE_DIM)) );
	crs(output.raster) <- current_crs;
	extent(output.raster) <- current_extent;
	cnn_file = paste0(CNN_TIF,"cnn.samplerate",samplerate,".is_shallow",is_shallow,".",hv_str,".tif")

	writeRaster(output.raster, filename=cnn_file, format="GTiff", datatype='INT1U', overwrite=TRUE);
	# writeRaster(output.raster, filename=paste("./predicted.CNN.", ".tif", sep=""), format="GTiff", datatype='INT2S', overwrite=TRUE);

	time.total <- proc.time() - ptm_cnn_start
	cat(paste("\nTest data time ", sprintf("%.3f",time.test[1]/3600),"\t", sprintf("%.3f",time.test[2]/3600),"\t", sprintf("%.3f",time.test[3]/3600),"hours\n"));
}}

sess$close();
cat(paste("\ntotal data time", sprintf("%.3f",time.total[1]/3600),"\t", sprintf("%.3f",time.total[2]/3600),"\t", sprintf("%.3f",time.total[3]/3600),"hours\n"));

# accuracy = sum(predicted2==y_truth[predict_index])/length(predict_index)

# rast2 = t(matrix(x_input[,i],nrow = IMAGE_DIM,ncol = IMAGE_DIM))
# I'm only interested in the first subdataset and I can use gdal_translate to convert it to a .tif
# gdal_translate(sds[8], dst_dataset = "NPP2000.tif")
# Load and plot the new .tif
# rast <- raster("NPP2000.tif")

##***************************************************************************************************
	# if (metric_tile.percent50_NDVI[n] ==  -32768 ||
		# metric_tile.percent25_NDVI[n] ==  -32768 ||
		# metric_tile.percent75_NDVI[n] ==  -32768   ) is_valid = 0;


# GetServerDefLifeSeg4Data.r
source("../common/DataUtil.r")
library(ggplot2)
source("../common/PlotUtil.r")

# P A R A M S
nSegments <- 4
nCopies <- 5
# ************ Also change summarize function and ggplot(color=...) and
#               lLegendItemLabels and xaxis logs and xaxis breaks!!!

# S T A N D A R D   F O R M A T T I N G
sPlotFile <- (  "serverdeflife"
            %+% sprintf("seg%d",nSegments)
            %+% ".png"
            )
fnGroupBy <- function(dfIn) {group_by(dfIn, copies, lifem
                                    , serverdefaultlife
                                    , simlength
                                    , auditfrequency, auditsegments
                                    )}
fnSubset <- function(dfIn)  {subset(dfIn, serverdefaultlife>=10000
#                                    & shockfreq==0
                                    & copies==nCopies
                                    & auditfrequency==10000
                                    & auditsegments==nSegments
                                    )}
want.varnames <- c("copies","lifem","lost","docstotal"
                ,"serverdefaultlife","simlength"
                ,"shockfreq","shockimpact","shockspan","shockmaxlife"
                ,"auditfrequency","audittype","auditsegments"
                ,"deadserversactive","deadserversall")
fnNarrow <- function(dfIn)  {dfIn[want.varnames]}

# G E T   D A T A
# Get the data into the right form for these plots.
alldat.df <- fndfGetGiantDataRaw("")
allnewdat <- alldat.df %>% fnNarrow() %>% fnGroupBy() %>%
summarize(losspct=round(mean(lost/docstotal)*100.0, 2), n=n())
newdat1 <- fnSubset(allnewdat)
newdat2 <- subset(newdat1, serverdefaultlife<=6*10000)
newdat <- subset(newdat2, simlength!=20*10000)
trows <- newdat

sCopies <- sprintf("Copies=%.0f; ", nCopies)
sSegments <- sprintf("%d segment(s))", nSegments)
sTitleLine <-   (   ""
                %+% "Collection maintained on servers with finite lifetimes (varying, shown as half-life). "
                %+% "\n(Equivalent to random minor shocks that kill only one server) "
                %+% " "
                %+% "\n\n"
                %+% sCopies
                %+% "annual systematic auditing in "
                %+% sSegments
                )
sLegendLabel <- "  Length of\nSimulation\n   (years)"
lLegendItemLabels <- levels(factor(trows$simlength/10000))

sTimestamp <- fngettime()
sSamples <- sprintf("samples=%.0f ", mean(trows$n))     #min(trows$n)
sXLabel <- ("Server default life or shock arrival rate (half-life) in hours "
            %+% "      (one metric year = 10,000 hours) "
            %+% "                           (less frequent shocks =====>)"
            )
sXLabel <- sXLabel %+% ("\n\n                                  " # cheapo rjust.
            %+% sprintf("          %s   %s   %s", sPlotFile,sTimestamp,sSamples)
            )
sYLabel <- ("probability of losing the entire collection (%)")
# E N D   O F   S T A N D A R D   F O R M A T T I N G

# P L O T   D A T A
gp <- ggplot(data=trows
            , aes(x=serverdefaultlife,y=safe(losspct), color=factor(simlength))
            )
gp <- gp + labs(color=sLegendLabel)

gp <- fnPlotLogScales(gp, y="YES"
#                ,xbreaks=c(50,67,75,80,90,100)
                ,xbreaks=c(10000,20000,30000,40000,50000,80000,100000,200000)
                ,ybreaks=c(0.01,0.10,1.00,10,100)
                )
#gp <- gp + scale_x_reverse(breaks=c(50,67,75,80,90,100))
if(debugprint){fnhere("after LogScales")}
gp <- gp + geom_line(
                  size=3
                , show.legend=TRUE
                )
gp <- gp + geom_point(data=trows
                , size=6
                , show.legend=TRUE
                , color="black"
                )

gp <- gp + theme(legend.position=c(0.15,0.3))
gp <- gp + theme(legend.background=element_rect(fill="lightgray",
                                  size=0.5, linetype="solid"))
gp <- gp + theme(legend.key.size=unit(0.3, "in"))
gp <- gp + theme(legend.key.width=unit(0.6, "in"))
gp <- gp + theme(legend.text=element_text(size=16))
gp <- gp + theme(legend.title=element_text(size=14))
gp <- gp + scale_color_discrete(labels=lLegendItemLabels)
if(debugprint){fnhere("after scalecolor")}

gp <- fnPlotTitles(gp
            , titleline=sTitleLine
            , xlabel=sXLabel
            , ylabel=sYLabel
        )
# Label the percentage lines out on the right side.
xlabelposition <- log10(800)
gp <- fnPlotPercentLine(gp, xloc=xlabelposition)
gp <- fnPlotMilleLine(gp, xloc=xlabelposition)
gp <- fnPlotSubMilleLine(gp, xloc=xlabelposition)
if(debugprint){fnhere("after lines")}

plot(gp)
if(debugprint){fnhere("after plot")}
fnPlotMakeFile(gp, sPlotFile)
if(debugprint){fnhere("after plotfile")}

# Unwind any remaining sink()s to close output files.
while (sink.number() > 0) {sink()}


# TODO:
# Mask land surface by wetland area
# Fix the memory limit;
# Include the other predictors
# plot of minimum distance
# Appplying some clustering

# Next Wednesday:
# - Make heatmap equivalent of Kumar table 2;  Ecoregion vs time,  Ecoregion vs Wetland type
# - Make the time series plots

# EF:
#  - Upload other bioclimatic predictors.
#  - Rescale all predictors to 0-1 before distance calculation.

# import libraries
library(raster)
library(dplyr)
library(tidyr)
library(ggplot2)
library(here)
here()

#===============================================================================

# List the files in the directory
l <- list.files(path = "../data/bioclim", pattern = ".tif", full.names = TRUE)

# Create empty stack, to which we'll append
bioclim_stack <- stack()

# Read raster, and add to stack.
s <- raster::stack(l)

# Aggregate raster to coarser image resolution
s <- aggregate(s, fact=6, fun=mean)

###  Get wetland mask
Fw_max <- raster("../data/swampsglwd/Fw_max.tif")
Fw_max[Fw_max < 0.01] <- NA  # Should be greater than a %

s <- mask(s, Fw_max)

# Crop the stack, to remove antarctica
aoi = extent(c(xmin=-180, xmax=180, ymin=-58, ymax=90))
s <- crop(s, aoi)

# reformat rasters  for graph in ggplot
sdf <- as.data.frame( as(s, "SpatialPixelsDataFrame") )

#===============================================================================

# Read in towers
# towers <- read.csv("../data/towers/BAMS_site_coordinates.csv")
towers <- read.csv("../data/tower_sites/Sites_all_BAMS_15march2019_v2.csv", stringsAsFactors = F)

# FILTER
towers <- towers %>%

  filter(IGBP %in% c("WET","CRO - Rice")) %>%
  # Could turn this filtering off to see a 'what if we had all towers scenario?"
  filter(Data_acquired == "yes") %>%
  filter(SITE_ID != "--*") %>%
  # Count Nb. of data years
  mutate(FLUX_MEASUREMENTS_DATE_END = ifelse(FLUX_MEASUREMENTS_DATE_END=="Present", 2019, FLUX_MEASUREMENTS_DATE_END)) %>%
  mutate(FLUX_MEASUREMENTS_DATE_END = as.numeric(FLUX_MEASUREMENTS_DATE_END),
         FLUX_MEASUREMENTS_DATE_START= as.numeric(FLUX_MEASUREMENTS_DATE_START))

towers <- towers[,1:10]

# get coordinates
pts_coords <- cbind(towers$LOCATION_LONG, towers$LOCATION_LAT)

# make spatial object
towers_pts <- SpatialPointsDataFrame(pts_coords, towers)
crs(towers_pts) <- crs(s)

towers_pts_df <- data.frame(towers_pts)

#==============================================================================

# Extract pixel values at towers
towers_pts_df <- cbind(towers_pts_df, raster::extract(s, towers_pts))

towers_pts_df<- towers_pts_df %>% filter(!is.na(wc2.0_bio_5m_05))
#===============================================================================
#  Cumulative plot

# Randomly select rows
# sdf <- sdf[sample(nrow(sdf), 5000), ]

# Change table format from wide to long; the reason for this is to plot
sdf2 <- sdf %>% gather(key=bioclim_var, value=value, wc2.0_bio_5m_01:wc2.0_bio_5m_11)
towers_pts_df2 <- towers_pts_df %>% gather(key=bioclim_var, value=value, wc2.0_bio_5m_01:wc2.0_bio_5m_11)

ggplot() +
  stat_ecdf(data=towers_pts_df2, aes(x=value), color='red', geom="step")+
  stat_ecdf(data=sdf2, aes(x=value), color='blue',geom="step")+

  xlab("") + ylab("Cumulative frequency") +

  facet_wrap(~ bioclim_var)

ggsave("../output/figures/cumul_plot_histogram_bioclim.png",
       width=180, height=160, dpi=600, units="mm")
dev.off()

#===============================================================================
# calculate distance of one tower to the grid

library(proxy)
d <- proxy::dist(x = sdf[c(1:5)],  # the columns of bioclim in gridded
                 y = towers_pts_df[c(14:18)],   # the columns of bioclim in towers
                 method="Euclidean",
                 upper=FALSE,
                 diag=FALSE)

# Convert 'crossdist' obj to dataframe
d <- as.data.frame(as.matrix.data.frame(d))

# Add tower IDs as column names
names(d) <- towers_pts_df$ID

# Append distance column to df
sdf_wdist <- cbind(sdf, d)

#===============================================================================

# Get minimum distance at each pixel on earth, from the network of towers.
sdf_wdist$min_dist <- apply(sdf_wdist[,8:43] , 1, min, na.rm=TRUE)

# Get which tower ID has the minimum distance
sdf_wdist$closest_tower <-  (c(apply(sdf_wdist[,8:43] , 1, which.min)))

# convrt numeric back to tower ID
sdf_wdist$closest_tower <- colnames(sdf_wdist[,8:43])[sdf_wdist$closest_tower]

# Remove the unneeded columns
sdf_wdist <- sdf_wdist %>% select(x,y, min_dist, closest_tower)

#===============================================================================
# Map towers over the LST

#sdf_wdist <- sdf_wdist %>% filter(min_dist <= 10)

# /-----------------------------------------------------------------------------
#/   Map of min-dist
ggplot() +
  geom_tile(data=sdf_wdist, aes(x=x, y=y, fill=min_dist)) +

  # text labes
  geom_text(data=towers_pts_df, aes(x=LOCATION_LONG, y= LOCATION_LAT + 3 , label=SITE_ID)) +
  geom_point(data=towers_pts_df, aes(x=LOCATION_LONG, y= LOCATION_LAT),
             shape=21, size=3, stroke=1.1, color='black') +
  scale_fill_distiller(palette = 'YlOrRd')

# /----------------------------------------------------------------------------
#/     Map of closest tower
ggplot() +
  geom_tile(data=sdf_wdist, aes(x=x, y=y, fill=as.factor(closest_tower))) +

  # text labes
  geom_text(data=towers_pts_df, aes(x=LOCATION_LONG, y= LOCATION_LAT + 3 , label=SITE_ID)) +
  geom_point(data=towers_pts_df, aes(x=LOCATION_LONG, y= LOCATION_LAT, fill=SITE_ID),
             shape=21, size=3, stroke=1.1, color='black')
  #theme(legend.position = "none")

# /-----------------------------------------------------------------------------
#/    Make sorted histogram

# Calculating the pixel count for each closts-tower
sdf_wdist_summarized <- sdf_wdist %>%
                        group_by(closest_tower) %>%
                        summarize(count = n()) %>%
                        arrange(count)

# Impose an order for the bars
sdf_wdist$closest_tower <- factor(sdf_wdist$closest_tower, levels= sdf_wdist_summarized$closest_tower)

ggplot(sdf_wdist)+
  geom_histogram(aes(x=closest_tower, fill=closest_tower), stat="count") +
  coord_flip() +
  xlab("Closest Tower") +
  ylab("Number of pixels") +
  theme(legend.position = 'none') +
  scale_y_continuous(expand=c(0,0))

#===============================================================================
# K-means

k <- kmeans(sdf[, 1:5], 10, nstart = 50)

SpatialPixels()

sdf$k <- k$cluster

# Convert df back to raster format (2lines)
r <- SpatialPixelsDataFrame(sdf[c("x", "y")], data = sdf)
kr <- raster(r, layer= ncol(sdf))

# Extract the cluster ID of each tower.
towers_pts_df$k <- raster::extract(kr, towers_pts)

#-------------------------------------------
ggplot(sdf)+
  geom_point(aes(x=wc2.0_bio_5m_01, y=wc2.0_bio_5m_05, color=as.factor(k)))

# /-----------------------------------------------------------------------------
#/   Map of clusters
ggplot() +
  geom_tile(data=sdf, aes(x=x, y=y, fill=as.factor(k))) +
  # text labes
  geom_text(data=towers_pts_df, aes(x=Longitude, y= Latitude + 3 , label=ID)) +
  geom_point(data=towers_pts_df, aes(x=Longitude, y= Latitude),
             shape=21, size=3, stroke=1.1, color='black')


# Test script localy

wdpaid <- '-8.02_51.76_-2.63_55.79'
#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])

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

# EMIS-R Libraries

library("rasterVis")
library("XML")
library("RCurl")
library("bitops")
library("lattice")
library("latticeExtra")
#library("RColorBrewer")
library("maps")
library("maptools")
library("wq")
#library("xtable")
library("zoo")
#library("jsonlite")
#require(xtable)
library(dplyr)

#Libraries for environmental analysis
library(fastcluster)
library(FactoMineR)

#Libraries for mask
library(rworldmap)
library(rworldxtra)

# 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 DATA EXTRACTION
#=========================================================================

mpaextract<-function (name = "EMIS_A_CHLA", resolution = "4km", gmis_wcst_url = gmis_wcst_url, startdate = "2005-09", enddate = "2005-10", xmin = 15, xmax = 20.5, ymin = 30, ymax = 32.5)
{

  xmin <- extent(mpa)@xmin - 0.1
  xmax <- extent(mpa)@xmax + 0.1
  ymin <- extent(mpa)@ymin - 0.1
  ymax <- extent(mpa)@ymax + 0.1
  imgs <- NA

  imgs <- getgmisdataseries(name = name, resolution = resolution, gmis_wcst_url = gmis_wcst_url,
                            startdate = startdate, enddate = enddate, xmin, xmax, ymin, ymax)

  return(imgs)
}

#FUNCTION getGMISdataseries
#=========================================================================

getgmisdataseries<-function (name = "GMIS_A_CHLA", resolution = "4km", gmis_wcst_url = gmis_wcst_url, startdate = "2005-09", enddate = "2005-10", xmin = 15, xmax = 20.5, ymin = 30, ymax = 32.5)
{
  checkparameter <- data.frame(name = FALSE, resolution = FALSE,
                               startdate = FALSE, enddate = FALSE, bbox = FALSE)

  checkparameter$resolution <- TRUE

  data_gmis<-read_gmis_wcst_data(resolution, gmis_wcst_url)

  idvar <- grep(name, data_gmis$shortname)
  if (length(idvar) == 0) {
    checkparameter$name <- FALSE
    print("Variable name do not exist on GMIS")
  }
  else {
    checkparameter$name <- TRUE
  }

  n0 <- nchar(startdate) == 7
  n1 <- substr(startdate, 1, 1) %in% 1:2
  n2 <- substr(startdate, 2, 2) %in% c(9, 0)
  n3 <- substr(startdate, 3, 3) %in% 0:9
  n4 <- substr(startdate, 4, 4) %in% 0:9
  n5 <- substr(startdate, 5, 5) == "-"
  n6 <- substr(startdate, 6, 6) %in% c(0, 1)
  n7 <- substr(startdate, 7, 7) %in% 0:9
  if (!(n0 & n1 & n2 & n3 & n4 & n5 & n6 & n7)) {
    checkparameter$startdate <- FALSE
    print("Start date format is not correct (YYYY-MM)")
  }
  else {
    checkparameter$startdate <- TRUE
  }
  n0 <- nchar(enddate) == 7
  n1 <- substr(enddate, 1, 1) %in% 1:2
  n2 <- substr(enddate, 2, 2) %in% c(9, 0)
  n3 <- substr(enddate, 3, 3) %in% 0:9
  n4 <- substr(enddate, 4, 4) %in% 0:9
  n5 <- substr(enddate, 5, 5) == "-"
  n6 <- substr(enddate, 6, 6) %in% c(0, 1)
  n7 <- substr(enddate, 7, 7) %in% 0:9
  if (!(n0 & n1 & n2 & n3 & n4 & n5 & n6 & n7)) {
    checkparameter$enddate <- FALSE
    print("End date format is not correct (YYYY-MM)")
  }
  else {
    checkparameter$enddate <- TRUE
  }
  n1 <- is.numeric(xmin)
  n2 <- length(xmin) == 1
  n3 <- is.numeric(xmax)
  n4 <- length(xmax) == 1
  n5 <- is.numeric(ymin)
  n6 <- length(ymin) == 1
  n7 <- is.numeric(ymax)
  n8 <- length(ymax) == 1
  n9 <- xmin < xmax
  n10 <- ymin < ymax
  if (!(n1 & n2 & n3 & n4 & n5 & n6 & n7 & n8)) {
    checkparameter$bbox <- FALSE
    print("Spatial limits are not correct (1 numeric vector for xmin, xmax, ymin and ymax)")
  }
  else {
    checkparameter$bbox <- TRUE
  }
  if (!(n9 & n10)) {
    checkparameter$bbox <- FALSE
    print("Spatial limits are not ordered correctly (xmin<xmax AND ymin<ymax)")
  }
  if (apply(checkparameter, 1, sum) == 5) {
    mindate <- strptime(paste(data_gmis$startdate[idvar],
                              "15", sep = "-"), "%Y-%m-%d")
    maxdate <- strptime(paste(data_gmis$enddate[idvar], "15",
                              sep = "-"), "%Y-%m-%d")
    askedstartdate <- strptime(paste(startdate, "15", sep = "-"),
                               "%Y-%m-%d")
    if ((mindate <= askedstartdate) & (askedstartdate <=
                                       maxdate)) {
      checkparameter$startdate <- TRUE
    }
    else {
      checkparameter$startdate <- FALSE
      print(paste(name, "is not available on GMIS for the",
                  askedstartdate))
    }
    askedenddate <- strptime(paste(enddate, "15", sep = "-"),
                             "%Y-%m-%d")
    if ((mindate <= askedenddate) & (askedenddate <= maxdate)) {
      checkparameter$enddate <- TRUE
    }
    else {
      checkparameter$enddate <- FALSE
      print(paste(name, "is not available on GMIS for the",
                  askedenddate))
    }
    if ((askedenddate >= askedstartdate)) {
      checkparameter$enddate <- TRUE
    }
    else {
      checkparameter$enddate <- FALSE
      print(paste(startdate, "is older than", enddate))
    }
    bboxgmis <- unlist(strsplit(data_gmis$bbox[idvar], " "))
    xmingmis <- as.numeric(bboxgmis[1])
    xmaxgmis <- as.numeric(bboxgmis[3])
    ymingmis <- as.numeric(bboxgmis[2])
    ymaxgmis <- as.numeric(bboxgmis[4])
    n1 <- xmingmis <= xmin
    n2 <- xmax <= xmaxgmis
    n3 <- ymingmis <= ymin
    n4 <- ymax <= ymaxgmis
    if (n1 & n2 & n3 & n4) {
      checkparameter$bbox <- TRUE
    }
    else {
      checkparameter$bbox <- FALSE
      print(paste("The selected area is not strickly inside the spatial extent of",
                  name, "in gmis"))
    }
  }
  if (apply(checkparameter, 1, sum) == 5) {
    startyear <- as.numeric(substr(startdate, 1, 4))
    startmonth <- as.numeric(substr(startdate, 6, 7))
    endyear <- as.numeric(substr(enddate, 1, 4))
    endmonth <- as.numeric(substr(enddate, 6, 7))
    if (startyear < endyear) {
      timeindex1 <- paste(startyear, sprintf("%02d", startmonth:12),
                          sep = "-")
      timelist <- expand.grid(1:12, (startyear + 1):(endyear -
                                                       1))
      timeindex2 <- paste(timelist[, 2], sprintf("%02d",
                                                 timelist[, 1]), sep = "-")
      timeindex3 <- paste(endyear, sprintf("%02d", 1:endmonth),
                          sep = "-")
      if ((endyear - startyear) == 1) {
        timeindex <- c(timeindex1, timeindex3)
      }
      else {
        timeindex <- c(timeindex1, timeindex2, timeindex3)
      }
    }
    else {
      timeindex <- paste(startyear, sprintf("%02d", startmonth:endmonth),
                         sep = "-")
    }
    pb <- txtProgressBar(min = 0, max = length(timeindex))
    for (i in 1:length(timeindex)) {
      if (i <= 1) {
        imgs <- getgmisdata(name = name, resolution = resolution, gmis_wcst_url = gmis_wcst_url,
                            date = timeindex[i], xmin = xmin, xmax = xmax,
                            ymin = ymin, ymax = ymax)
        names(imgs) <- timeindex[i]
      }
      else {
        img <- getgmisdata(name = name, resolution = resolution, gmis_wcst_url = gmis_wcst_url,
                           date = timeindex[i], xmin = xmin, xmax = xmax,
                           ymin = ymin, ymax = ymax)
        names(img) <- timeindex[i]
        imgs <- stack(imgs, img)
      }
      setTxtProgressBar(pb, i)
    }
    close(pb)
    return(imgs)
  }
}

#FUNCTION getGMISdataseries
#=========================================================================

getgmisdataseries<-function (name = "GMIS_A_CHLA", resolution = "4km", gmis_wcst_url = gmis_wcst_url, startdate = "2005-09", enddate = "2005-10", xmin = 15, xmax = 20.5, ymin = 30, ymax = 32.5)
{
  checkparameter <- data.frame(name = FALSE, resolution = FALSE,
                               startdate = FALSE, enddate = FALSE, bbox = FALSE)

  checkparameter$resolution <- TRUE

  data_gmis<-read_gmis_wcst_data(resolution, gmis_wcst_url)

  idvar <- grep(name, data_gmis$shortname)
  if (length(idvar) == 0) {
    checkparameter$name <- FALSE
    print("Variable name do not exist on GMIS")
  }
  else {
    checkparameter$name <- TRUE
  }

  n0 <- nchar(startdate) == 7
  n1 <- substr(startdate, 1, 1) %in% 1:2
  n2 <- substr(startdate, 2, 2) %in% c(9, 0)
  n3 <- substr(startdate, 3, 3) %in% 0:9
  n4 <- substr(startdate, 4, 4) %in% 0:9
  n5 <- substr(startdate, 5, 5) == "-"
  n6 <- substr(startdate, 6, 6) %in% c(0, 1)
  n7 <- substr(startdate, 7, 7) %in% 0:9
  if (!(n0 & n1 & n2 & n3 & n4 & n5 & n6 & n7)) {
    checkparameter$startdate <- FALSE
    print("Start date format is not correct (YYYY-MM)")
  }
  else {
    checkparameter$startdate <- TRUE
  }
  n0 <- nchar(enddate) == 7
  n1 <- substr(enddate, 1, 1) %in% 1:2
  n2 <- substr(enddate, 2, 2) %in% c(9, 0)
  n3 <- substr(enddate, 3, 3) %in% 0:9
  n4 <- substr(enddate, 4, 4) %in% 0:9
  n5 <- substr(enddate, 5, 5) == "-"
  n6 <- substr(enddate, 6, 6) %in% c(0, 1)
  n7 <- substr(enddate, 7, 7) %in% 0:9
  if (!(n0 & n1 & n2 & n3 & n4 & n5 & n6 & n7)) {
    checkparameter$enddate <- FALSE
    print("End date format is not correct (YYYY-MM)")
  }
  else {
    checkparameter$enddate <- TRUE
  }
  n1 <- is.numeric(xmin)
  n2 <- length(xmin) == 1
  n3 <- is.numeric(xmax)
  n4 <- length(xmax) == 1
  n5 <- is.numeric(ymin)
  n6 <- length(ymin) == 1
  n7 <- is.numeric(ymax)
  n8 <- length(ymax) == 1
  n9 <- xmin < xmax
  n10 <- ymin < ymax
  if (!(n1 & n2 & n3 & n4 & n5 & n6 & n7 & n8)) {
    checkparameter$bbox <- FALSE
    print("Spatial limits are not correct (1 numeric vector for xmin, xmax, ymin and ymax)")
  }
  else {
    checkparameter$bbox <- TRUE
  }
  if (!(n9 & n10)) {
    checkparameter$bbox <- FALSE
    print("Spatial limits are not ordered correctly (xmin<xmax AND ymin<ymax)")
  }
  if (apply(checkparameter, 1, sum) == 5) {
    mindate <- strptime(paste(data_gmis$startdate[idvar],
                              "15", sep = "-"), "%Y-%m-%d")
    maxdate <- strptime(paste(data_gmis$enddate[idvar], "15",
                              sep = "-"), "%Y-%m-%d")
    askedstartdate <- strptime(paste(startdate, "15", sep = "-"),
                               "%Y-%m-%d")
    if ((mindate <= askedstartdate) & (askedstartdate <=
                                       maxdate)) {
      checkparameter$startdate <- TRUE
    }
    else {
      checkparameter$startdate <- FALSE
      print(paste(name, "is not available on GMIS for the",
                  askedstartdate))
    }
    askedenddate <- strptime(paste(enddate, "15", sep = "-"),
                             "%Y-%m-%d")
    if ((mindate <= askedenddate) & (askedenddate <= maxdate)) {
      checkparameter$enddate <- TRUE
    }
    else {
      checkparameter$enddate <- FALSE
      print(paste(name, "is not available on GMIS for the",
                  askedenddate))
    }
    if ((askedenddate >= askedstartdate)) {
      checkparameter$enddate <- TRUE
    }
    else {
      checkparameter$enddate <- FALSE
      print(paste(startdate, "is older than", enddate))
    }
    bboxgmis <- unlist(strsplit(data_gmis$bbox[idvar], " "))
    xmingmis <- as.numeric(bboxgmis[1])
    xmaxgmis <- as.numeric(bboxgmis[3])
    ymingmis <- as.numeric(bboxgmis[2])
    ymaxgmis <- as.numeric(bboxgmis[4])
    n1 <- xmingmis <= xmin
    n2 <- xmax <= xmaxgmis
    n3 <- ymingmis <= ymin
    n4 <- ymax <= ymaxgmis
    if (n1 & n2 & n3 & n4) {
      checkparameter$bbox <- TRUE
    }
    else {
      checkparameter$bbox <- FALSE
      print(paste("The selected area is not strickly inside the spatial extent of",
                  name, "in gmis"))
    }
  }
  if (apply(checkparameter, 1, sum) == 5) {
    startyear <- as.numeric(substr(startdate, 1, 4))
    startmonth <- as.numeric(substr(startdate, 6, 7))
    endyear <- as.numeric(substr(enddate, 1, 4))
    endmonth <- as.numeric(substr(enddate, 6, 7))
    if (startyear < endyear) {
      timeindex1 <- paste(startyear, sprintf("%02d", startmonth:12),
                          sep = "-")
      timelist <- expand.grid(1:12, (startyear + 1):(endyear -
                                                       1))
      timeindex2 <- paste(timelist[, 2], sprintf("%02d",
                                                 timelist[, 1]), sep = "-")
      timeindex3 <- paste(endyear, sprintf("%02d", 1:endmonth),
                          sep = "-")
      if ((endyear - startyear) == 1) {
        timeindex <- c(timeindex1, timeindex3)
      }
      else {
        timeindex <- c(timeindex1, timeindex2, timeindex3)
      }
    }
    else {
      timeindex <- paste(startyear, sprintf("%02d", startmonth:endmonth),
                         sep = "-")
    }
    pb <- txtProgressBar(min = 0, max = length(timeindex))
    for (i in 1:length(timeindex)) {
      if (i <= 1) {
        imgs <- getgmisdata(name = name, resolution = resolution, gmis_wcst_url = gmis_wcst_url,
                            date = timeindex[i], xmin = xmin, xmax = xmax,
                            ymin = ymin, ymax = ymax)
        names(imgs) <- timeindex[i]
      }
      else {
        img <- getgmisdata(name = name, resolution = resolution, gmis_wcst_url = gmis_wcst_url,
                           date = timeindex[i], xmin = xmin, xmax = xmax,
                           ymin = ymin, ymax = ymax)
        names(img) <- timeindex[i]
        imgs <- stack(imgs, img)
      }
      setTxtProgressBar(pb, i)
    }
    close(pb)
    return(imgs)
  }
}

#FUNCTION getGMISdata
#====================================================================

getgmisdata<-function (name = name, resolution = resolution, gmis_wcst_url = gmis_wcst_url, date = startdate, xmin = 15, xmax = 20.5, ymin = 30, ymax = 32.5)
{
  checkparameter <- data.frame(name = FALSE, resolution = FALSE,
                               date = FALSE, bbox = FALSE)

  checkparameter$resolution <- TRUE

  data_gmis<-read_gmis_wcst_data(resolution, gmis_wcst_url)

  idvar <- grep(name, data_gmis$shortname)
  if (length(idvar) == 0) {
    checkparameter$name <- FALSE
    print("Variable name do not exist on GMIS")
  }
  else {
    checkparameter$name <- TRUE
  }

  n0 <- nchar(date) == 7
  n1 <- substr(date, 1, 1) %in% 1:2
  n2 <- substr(date, 2, 2) %in% c(9, 0)
  n3 <- substr(date, 3, 3) %in% 0:9
  n4 <- substr(date, 4, 4) %in% 0:9
  n5 <- substr(date, 5, 5) == "-"
  n6 <- substr(date, 6, 6) %in% c(0, 1)
  n7 <- substr(date, 7, 7) %in% 0:9
  if (!(n0 & n1 & n2 & n3 & n4 & n5 & n6 & n7)) {
    checkparameter$date <- FALSE
    print("Date format is not correct (YYYY-MM)")
  }
  else {
    checkparameter$date <- TRUE
  }
  n1 <- is.numeric(xmin)
  n2 <- length(xmin) == 1
  n3 <- is.numeric(xmax)
  n4 <- length(xmax) == 1
  n5 <- is.numeric(ymin)
  n6 <- length(ymin) == 1
  n7 <- is.numeric(ymax)
  n8 <- length(ymax) == 1
  n9 <- xmin < xmax
  n10 <- ymin < ymax
  if (!(n1 & n2 & n3 & n4 & n5 & n6 & n7 & n8)) {
    checkparameter$bbox <- FALSE
    print("Spatial limits are not correct (1 numeric vector for xmin, xmax, ymin and ymax)")
  }
  else {
    checkparameter$bbox <- TRUE
  }
  if (!(n9 & n10)) {
    checkparameter$bbox <- FALSE
    print("Spatial limits are not ordered correctly (xmin<xmax AND ymin<ymax)")
  }
  if (apply(checkparameter, 1, sum) == 4) {
    mindate <- strptime(paste(data_gmis$startdate[idvar],
                              "15", sep = "-"), "%Y-%m-%d")
    maxdate <- strptime(paste(data_gmis$enddate[idvar], "15",
                              sep = "-"), "%Y-%m-%d")
    askeddate <- strptime(paste(date, "15", sep = "-"), "%Y-%m-%d")
    if ((mindate <= askeddate) & (askeddate <= maxdate)) {
      checkparameter$date <- TRUE
    }
    else {
      checkparameter$date <- FALSE
      print(paste(name, "is not available on GMIS for the",
                  date))
    }
    bboxgmis <- unlist(strsplit(data_gmis$bbox[idvar], " "))
    xmingmis <- as.numeric(bboxgmis[1])
    xmaxgmis <- as.numeric(bboxgmis[3])
    ymingmis <- as.numeric(bboxgmis[2])
    ymaxgmis <- as.numeric(bboxgmis[4])
    n1 <- xmingmis <= xmin
    n2 <- xmax <= xmaxgmis
    n3 <- ymingmis <= ymin
    n4 <- ymax <= ymaxgmis
    if (n1 & n2 & n3 & n4) {
      checkparameter$bbox <- TRUE
    }
    else {
      checkparameter$bbox <- FALSE
      print(paste("The selected area is not strickly inside the spatial extent of",
                  name, "in GMIS"))
    }
  }
  if (apply(checkparameter, 1, sum) == 4) {
    bbox <- paste(xmin, ymin, xmax, ymax, sep = ",")
    con <- paste(gmis_wcst_url, "?TIME=", date, "&service=wcs&version=1.0.0&request=getcoverage&coverage=", name, "&crs=EPSG:4326&BBOX=", bbox, "&format=image/tiff&interpolation=nearest",  sep = "")
    nomfich <- paste(name, date, "img.tiff", sep = "_")
    nomfich <- tempfile(nomfich)
    download(con, nomfich, quiet = TRUE, mode = "wb")
    img <- raster(nomfich)
    img[img == 0] <- NA
    if (length(grep("log", data_gmis$unit[idvar], ignore.case = TRUE)) >
        0) {
      img <- 10^img
    }
    names(img) <- paste(name, date)
    print(con)
    return(img)
  }
}

#FUNCTION read_GMIS_wcst_data
#=========================================================================

read_gmis_wcst_data<-function (resolution = resolution, gmis_wcst_url = gmis_wcst_url)
{
  if (url.exists(gmis_wcst_url)) {
    doc <- xmlTreeParse(gmis_wcst_url, isURL = TRUE, encoding = "latin1")
    r <- xmlRoot(doc)
    nbvar <- xmlSize(r[[3]])
    carac <- data.frame(source = rep(unlist(r[[1]][[2]])[3],
                                     nbvar), resolution, name = NA, shortname = NA, unit = NA,
                        bbox = NA, startdate = NA, enddate = NA)
    for (i in 1:nbvar) {
      carac$unit[i] <- unlist(r[[3]][[i]][[2]])[3]
      carac$shortname[i] <- unlist(r[[3]][[i]][[3]])[3]
      carac$name[i] <- unlist(r[[3]][[i]][[4]])[3]
      carac$bbox[i] <- gsub("\n", ",", paste(unlist(r[[3]][[i]][[5]])[5],
                                             unlist(r[[3]][[i]][[5]])[9], collapse = "\n"))
      tps <- unlist(r[[3]][[i]][[5]])
      tps <- as.vector(tps[names(tps) == "children.timePosition.children.text.value"])
      tps <- strptime(paste(tps, "15", sep = "-"), "%Y-%m-%d")
      carac$startdate[i] <- format(min(tps, na.rm = T),
                                   "%Y-%m")
      carac$enddate[i] <- format(max(tps, na.rm = T), "%Y-%m")
    }
  }
  else {
    print("no internet connection or GMIS server down")
    carac <- data.frame(source = NA, name = NA, shortname = NA,
                        unit = NA, bbox = NA, time = NA)
  }
  return(carac)
}

#EXTRACTION of the MODIST SST
#================================================================
name <- "GMIS_T_SST"
resolution <- "4km"
startdate <- "2001-01"
enddate <- "2018-12"
gmis_wcst_url <- "http://mapserver.marine-analyst.eu/webservices/4km/wcs-t"
unite <- "oC"
logscale <- FALSE

mpa_sst<-mpaextract(name = name, resolution = resolution, gmis_wcst_url = gmis_wcst_url, startdate = startdate, enddate =enddate, xmin = extent(mpa)@xmin-1, xmax = extent(mpa)@xmax+1, ymin = extent(mpa)@ymin-1, ymax = extent(mpa)@ymax+1)

#EXTRACTION of the PRIMARY PRODUCTION
#================================================================
name <- "GMIS_A_PPR"
resolution <- "4km"
startdate <- "1998-01"
enddate <- "2018-12"
gmis_wcst_url <- "http://mapserver.marine-analyst.eu/webservices/4km/wcs-t"
unite <- "mg m-2 day-1"
logscale <- FALSE

mpa_ppr<-mpaextract(name = name, resolution = resolution, gmis_wcst_url = gmis_wcst_url, startdate = startdate, enddate =enddate, xmin = extent(mpa)@xmin-1, xmax = extent(mpa)@xmax+1, ymin = extent(mpa)@ymin-1, ymax = extent(mpa)@ymax+1)

#EXTRACTION of the SALINITY
#================================================================
name <- "GMIS_C_SALI"
resolution <- "28km"
startdate <- "1998-01"
enddate <- "2018-12"
gmis_wcst_url <- "http://mapserver.marine-analyst.eu/webservices/4km/wcs-t"
unite <- ".0001"
logscale <- FALSE

mpa_salinity<-mpaextract(name = name, resolution = resolution, gmis_wcst_url = gmis_wcst_url, startdate = startdate, enddate =enddate, xmin = extent(mpa)@xmin-1, xmax = extent(mpa)@xmax+1, ymin = extent(mpa)@ymin-1, ymax = extent(mpa)@ymax+1)

#EXTRACTION of the CHLA
#================================================================
name <- "GMIS_A_CHLA"
resolution <- "4km"
startdate <- "1998-01"
enddate <- "2018-12"
gmis_wcst_url <- "http://mapserver.marine-analyst.eu/webservices/4km/wcs-t"
unite <- "mg.m-3"
logscale <- TRUE

mpa_chla<-mpaextract(name = name, resolution = resolution, gmis_wcst_url = gmis_wcst_url, startdate = startdate, enddate =enddate, xmin = extent(mpa)@xmin-1, xmax = extent(mpa)@xmax+1, ymin = extent(mpa)@ymin-1, ymax = extent(mpa)@ymax+1)

#EXTRACTION of the KD443
#================================================================
name <- "GMIS_A_K490"
resolution <- "4km"
startdate <- "1998-01"
enddate <- "2018-12"
gmis_wcst_url <- "http://mapserver.marine-analyst.eu/webservices/4km/wcs-t"
unite <- "m^-1"
logscale <- TRUE

mpa_kd443<-mpaextract(name = name, resolution = resolution, gmis_wcst_url = gmis_wcst_url, startdate = startdate, enddate =enddate, xmin = extent(mpa)@xmin-1, xmax = extent(mpa)@xmax+1, ymin = extent(mpa)@ymin-1, ymax = extent(mpa)@ymax+1)

#EXTRACTION of the Surface oxygene
#================================================================
name <- "GMIS_O_OXYG"
resolution <- "28km"
startdate <- "1998-01"
enddate <- "2018-12"
gmis_wcst_url <- "http://mapserver.marine-analyst.eu/webservices/4km/wcs-t"
unite <- "mmol m-3"
logscale <- FALSE

mpa_oxygene<-mpaextract(name = name, resolution = resolution, gmis_wcst_url = gmis_wcst_url, startdate = startdate, enddate =enddate, xmin = extent(mpa)@xmin-1, xmax = extent(mpa)@xmax+1, ymin = extent(mpa)@ymin-1, ymax = extent(mpa)@ymax+1)

#EXTRACTION of the Surface bbp
#================================================================
name <- "GMIS_A_BBP"
resolution <- "4km"
startdate <- "1998-01"
enddate <- "2018-12"
gmis_wcst_url <- "http://mapserver.marine-analyst.eu/webservices/4km/wcs-t"
unite <- "m^-1"
logscale <- FALSE

mpa_bbp<-mpaextract(name = name, resolution = resolution, gmis_wcst_url = gmis_wcst_url, startdate = startdate, enddate =enddate, xmin = extent(mpa)@xmin-1, xmax = extent(mpa)@xmax+1, ymin = extent(mpa)@ymin-1, ymax = extent(mpa)@ymax+1)

#EXTRACTION of the Surface adg
#================================================================
name <- "GMIS_A_ADG"
resolution <- "4km"
startdate <- "1998-01"
enddate <- "2018-12"
gmis_wcst_url <- "http://mapserver.marine-analyst.eu/webservices/4km/wcs-t"
unite <- "m^-1"
logscale <- FALSE

mpa_adg<-mpaextract(name = name, resolution = resolution, gmis_wcst_url = gmis_wcst_url, startdate = startdate, enddate =enddate, xmin = extent(mpa)@xmin-1, xmax = extent(mpa)@xmax+1, ymin = extent(mpa)@ymin-1, ymax = extent(mpa)@ymax+1)

#####

# CLASSIF#####
coast <- rworldmap::getMap(resolution = "high")
coast <- raster::crop(coast, raster::extent(xmin-0.1,xmax+0.1,ymin-0.1,ymax+0.1))

classif <- function(raster, method.dist="euclidean", method.classif="ward.D2", nb.clust){
  df <- raster::as.data.frame(raster, xy=T)
  df <- tidyr::pivot_longer(data=df, cols=3:dim(df)[2],names_to="Date", values_to="Values")
  df <- dplyr::mutate(df, Month=substr(Date,7,8),Year=substr(Date,2,5))
  df <- dplyr::group_by(df,Year,x,y) %>% dplyr::mutate(Values=mean(Values,na.rm=T))
  df <-  df %>% dplyr::select(-Date,-Month) %>% ungroup() %>% distinct() %>% tidyr::pivot_wider(names_from=Year, values_from=Values)
  x <- is.na(maps::map.where(coast, df$x, df$y))
  df <- df[which(x),-c(1,2)]

  for(i in 1:dim(df)[2]){
    year <- df[,i]
    year[which(is.na(year)),] <- mean(pull(year),na.rm=T)
    df[,i] <- year
  }

  d <- dist(df,method=method.dist)
  clust <-fastcluster::hclust(d, method = method.classif)

  zones <- cutree(clust ,nb.clust)
  raster.cut <- raster[[1]]
  values(raster.cut) <- NA
  raster.cut[which(x)] <- zones
  return(raster.cut)
}

#CLASSIFICATION of the MODIST SST
#================================================================
sst.classif <- classif(mpa_sst,nb.clust = 5)

#CLASSIFICATION of the PRIMARY PRODUCTION
#================================================================
ppr.classif <- classif(mpa_ppr,nb.clust = 5)

#CLASSIFICATION of the SALINITY
#================================================================
salinity.classif <- classif(mpa_salinity,nb.clust = 5)

#CLASSIFICATION of the CHLA
#================================================================
chla.classif <- classif(mpa_chla,nb.clust = 5)

#CLASSIFICATION of the KD443
#================================================================
kd443.classif <- classif(mpa_kd443,nb.clust = 5)

#CLASSIFICATION of the Surface oxygene
#================================================================
oxygene.classif <- classif(mpa_oxygene,nb.clust = 5)

#CLASSIFICATION of the Surface bbp
#================================================================
bbp.classif <- classif(mpa_bbp,nb.clust = 5)

#CLASSIFICATION of the Surface adg
#================================================================
adg.classif <- classif(mpa_adg,nb.clust = 5)

#FINAL CLASSIFICATION#####
grid <- expand.grid(Long=seq(from=xmin,to=xmax,by=round(res(mpa_adg)[1],4)),Lat=seq(from=ymin,to=ymax,by=round(res(mpa_adg)[1],4)))

env.zones <- data.frame(grid,
                        SST=raster::extract(sst.classif,grid),
                        PPR=raster::extract(ppr.classif,grid),
                        SAL=raster::extract(salinity.classif,grid),
                        CHL=raster::extract(chla.classif,grid),
                        KD=raster::extract(kd443.classif,grid),
                        OXY=raster::extract(oxygene.classif,grid),
                        BBP=raster::extract(bbp.classif,grid),
                        ADG=raster::extract(adg.classif,grid))
env.zones <- na.omit(env.zones)

for(i in 3:dim(env.zones)[2]){
  env.zones[,i] <- paste(env.zones[,i],names(env.zones)[i],sep="_")
}

#MCA
mca <- MCA(env.zones[,-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)

env.classif <- data.frame(env.zones[,c(1,2)],Clusters=factor(groups))
######

#TIME SERIES AND BOXPLOT DATA####
param <- c("SST","PPR","SAL","CHL","KD","OXY","BBP","ADG")
Env <- data.frame()
x <- is.na(maps::map.where(coast, grid$Long, grid$Lat))
marine.grid <- grid[which(x),]
t <- 0

for (i in list(mpa_sst,mpa_ppr,mpa_salinity,mpa_chla,mpa_kd443,mpa_oxygene,mpa_bbp,mpa_adg)){
  t <- t+1
  tmp <- data.frame(marine.grid,extract(i,marine.grid))
  tmp <- dplyr::left_join(env.classif,tmp,by=c("Long"="Long","Lat"="Lat"))
  tmp <- tidyr::pivot_longer(data=tmp, cols=4:dim(tmp)[2],names_to="Date", values_to="Values")
  tmp <- dplyr::mutate(tmp, Month=substr(Date,7,8),Year=substr(Date,2,5))
  tmp <- dplyr::select(tmp, -Date)
  tmp <- dplyr::mutate(tmp, Param=param[t])

  Env <- rbind(Env, tmp)
}
#####

#RETURN PLOTS#####

map <- ggplot()+
  geom_raster(data=env.classif,aes(x=Long,y=Lat,fill=Clusters))+
  geom_polygon(data=coast, aes(x=long, y=lat, group=group), fill="grey", col="black")+
  theme_minimal()+ggtitle("Final regionalization of the area with environmental parameters")+
  xlab("Longitude")+ylab("Latitude")+scale_fill_viridis_d()
print(map)

boxplots <- ggplot()+
  geom_boxplot(data=Env,aes(x=Clusters,y=Values,fill=Clusters))+
  facet_wrap(~Param,nrow=2, scale="free_y")+xlab("Clusters")+ylab("Parameters")+
  scale_fill_viridis_d()
print(boxplots)

Env$Date <- as.Date(paste(Env$Year,Env$Month,"01",sep="/"), format=c("%Y/%m/%d"))
ts.data <- Env %>% dplyr::group_by(Year,Param,Clusters) %>% dplyr::summarise(Values=mean(Values,na.rm=T))
ts <- ggplot(data=ts.data[ts.data$Param=="PPR",])+
  geom_line(aes(x=Year,y=Values,col=Clusters, group=Clusters),lwd=2)+
  scale_color_viridis_d()+facet_wrap(~Param, nrow = 8, scale="free_y")
print(ts)
#####


use.prediction.M2<-F
use.OP.prediction.M2<-T

last.y<-2060
last.y<-2035
######

if (F) {
  #  simple average tables
#  a<-Read.part.M2.data()
  a<-Read.part.M2.OP.prediction.data(dir=op.dir)

  # annual part M2
  b<-tapply(a$Part.M2,list(a$Year,a$Predator,a$Prey,a$Prey.age),sum)
  b[is.na(b)]<-0
  b[,,"Cod",'0']
  b[,,,'0']

  c<-apply(b,c(3,4,2),mean)
  #dimnames(c)[[3]]<-name[2:(npr+1)]
  print(round(c[,1:4,],digits=4), zero.print=".")
  print(round(c[,,],digits=4), zero.print=".")

  ftable(round(c,3))

  c<-apply(b,c(2,4,3),mean)
  #dimnames(c)[[1]]<-name[2:(npr+1)]
  print(round(c[,1:5,],digits=4), zero.print=".")

  c2<-apply(c,c(3,2),sum)
  print(round(c2,digits=3), zero.print = ".")
}
#########################

a<-Read.part.M2.data()
a<-subset(a, !(Prey.age==0 & Quarter<=2))

## add prediction M2
if (use.prediction.M2) {
  b<-Read.part.M2.prediction.data(dir=op.dir)
  a<-rbind(a,b)
}
#

## add prediction M2
if (use.OP.prediction.M2) {
  b<-Read.part.M2.OP.prediction.data(dir=op.dir)
  b$Area<-NULL      #  to be changed
  a<-rbind(a,b)
}
#

a<-subset(a,Year<=last.y)

# annual part M2
b<-tapply(a$Part.M2,list(a$Year,a$Predator,a$Predator.age,a$Prey,a$Prey.age),sum)
b[is.na(b)]<-0

#  print(round(b[,'Cod','1','Cod','0'],digits=3), zero.print = ".")
#print(round(b[,'Cod',,'Cod',1:3],digits=3), zero.print = ".")
#print(round(b[,'Whiting',,'Whiting',1:3],digits=3), zero.print = ".")
##########################################
#a<-subset(a,Part.M2>0 & Prey=='Sandeel' & Prey.age<=4)
a<-subset(a,Part.M2>0 &  Prey.age<=4)

cleanup()
dev<-"print"
dev<-"screen"
#dev<-'png'
#dev<-"testprint"
nox<-2
noy<-3

if (makeAllGraphs) dev<-'png'

# Special, condense of predators with annual M2 output
do.plot<-function(){
  file<-file.path(data.path,'pred_format.dat')
  s<-read.table(file,header=TRUE)
  pformat<-unique(subset(s,new.no<99,select= -Predator))
  pformat<-pformat[order(pformat$new.no),]
  pformat<-as.character(pformat$new)

  s<-merge(x=a,y=s,by='Predator',all.y=T)

  #subset(s,is.na(Part.M2))
  s<- subset(s,!is.na(Part.M2))
  a<-aggregate(s$Part.M2,list(s$new,s$Year,s$new.no,s$Prey,s$Prey.no,s$Prey.age),sum)
  names(a)<-c("Predator","Year","Predator.no","Prey","Prey.no","Prey.age","Part.M2")

  i<-0
  all.pred.col<-sort(unique(a$Predator.no),decreasing = TRUE)
  all.prey.col<-sort(unique(a$Prey.no),decreasing = TRUE)
  all.names<-rep('aaa',length(all.pred.col))
  new.names<-pformat
 for (s in (1:length(all.pred.col))) all.names[s]<-new.names[all.pred.col[s]]

  #palette(rainbow(12))
  #colours(distinct = FALSE)
  palette(c('red','green','plum','blue','cyan','yellow','coral','skyblue','purple','magenta','limegreen','pink' ))
  # palette("default")

 by(a,list(a$Prey),function(x) {
      b<- tapply(x$Part.M2,list(x$Predator.no,x$Year),sum)
      b[is.na(b)]<-0
      pred.no<-as.numeric(dimnames(b)[[1]])
      v<-pred.no
      for (l in (1:length(v))) pred.no[l]<-v[length(v)-l+1]
      pred.names<-rep('aaa',length(pred.no))
      v<-pred.names
      for (l in (1:length(v))) pred.names[l]<-v[length(v)-l+1]
      for (s in (1:length(pred.no))) pred.names[s]<-new.names[pred.no[s]]
  i<-0
  by(x,list(x$Prey.age,x$Prey),function(x) {

      b<- tapply(x$Part.M2,list(x$Predator.no,x$Year),sum)
      b[is.na(b)]<-0
      pred.no.age<-as.numeric(dimnames(b)[[1]])
      pred.names.age<-rep('aaa',length(pred.no.age))
      for (s in (1:length(pred.no.age))) pred.names.age[s]<-new.names[pred.no[s]]

      length.names<-dimnames(b)[[2]]
      if ((i %% (nox*noy-1))==0) {
        #newplot(dev,nox,noy,Portrait=TRUE);
        #newplot(dev,nox,noy,w8=12,w11=16,Portrait=F,pointsize=12);
        if (dev =='png') poi<-20 else poi<-12
        filename<-paste0("Partial_M2_annual_",x[1,'Prey'])
        if (makeAllGraphs) filename=file.path(PartialM2.dir,filename)
        newplot(dev,nox,noy,w8=12,w11=16,Portrait=F,pointsize=poi,filename=filename);

         par(mar=c(3,2,2,1))  #  c(bottom, left, top, right)
        plot.new(); legend(x=0,y=1,pred.names,fill=pred.no,cex=1.2,col=pred.no,ncol=2,title='Predators')
        }
      i<<-i+1

      barplot(b,space=0.4,names=length.names,col=pred.no.age)
      title(main=paste(x[1,]$Prey,"age:",x[1,]$Prey.age),cex=1.5)
  })
  })

}
tt<-do.plot()
if (dev %in% c('png','print')) cleanup()

# Special, condense of predators with quarterly M2 output

cleanup()
nox<-2
noy<-3

do.plot.q<-function(){

    file<-file.path(data.path,'pred_format.dat')
  s<-read.table(file,header=TRUE)
  pformat<-unique(subset(s,new.no<99,select= -Predator))
  pformat<-pformat[order(pformat$new.no),]
  pformat<-as.character(pformat$new)
  s<-merge(x=a,y=s,by='Predator',all.y=T)

  #subset(s,is.na(Part.M2))
  s<- subset(s,!is.na(Part.M2))
  a<-aggregate(s$Part.M2,list(s$new,s$Year,s$Quarter,s$new.no,s$Prey,s$Prey.no,s$Prey.age),sum)
  names(a)<-c("Predator","Year","Quarter","Predator.no","Prey","Prey.no","Prey.age","Part.M2")

  i<-0
  all.pred.col<-sort(unique(a$Predator.no),decreasing = TRUE)
  all.prey.col<-sort(unique(a$Prey.no),decreasing = TRUE)
  all.names<-rep('aaa',length(all.pred.col))
  new.names<-pformat
  for (s in (1:length(all.pred.col))) all.names[s]<-new.names[all.pred.col[s]]

  #palette(rainbow(12))
  #colours(distinct = FALSE)
  palette(c('red','green','plum','blue','cyan','yellow','coral','skyblue','purple','magenta','limegreen','pink' ))
  # palette("default")

  cleanup()
  by(a,list(a$Prey,a$Quarter),function(x) {
    b<- tapply(x$Part.M2,list(x$Predator.no,x$Year),sum)
    b[is.na(b)]<-0
    pred.no<-as.numeric(dimnames(b)[[1]])
    v<-pred.no
    for (l in (1:length(v))) pred.no[l]<-v[length(v)-l+1]
    pred.names<-rep('aaa',length(pred.no))
    v<-pred.names
    for (l in (1:length(v))) pred.names[l]<-v[length(v)-l+1]
    for (s in (1:length(pred.no))) pred.names[s]<-new.names[pred.no[s]]
    i<-0
    by(x,list(x$Prey.age,x$Prey),function(x) {

      b<- tapply(x$Part.M2,list(x$Predator.no,x$Year),sum)
      b[is.na(b)]<-0
      pred.no.age<-as.numeric(dimnames(b)[[1]])
      pred.names.age<-rep('aaa',length(pred.no.age))
      for (s in (1:length(pred.no.age))) pred.names.age[s]<-new.names[pred.no[s]]

      length.names<-dimnames(b)[[2]]
      if ((i %% (nox*noy-1))==0) {
          #newplot(dev,nox,noy,w8=12,w11=16,Portrait=F,pointsize=12);
        if (dev =='png') poi<-20 else poi<-12
        filename<-paste0("Partial_M2_Q",x[1,'Quarter'],'_',x[1,'Prey'])
        if (makeAllGraphs) filename=file.path(PartialM2.dir,filename)

        newplot(dev,nox,noy,w8=12,w11=16,Portrait=F,pointsize=poi,filename=filename);

        par(mar=c(3,2,2,1))  #  c(bottom, left, top, right)
        plot.new(); legend(x=0,y=1,pred.names,fill=pred.no,cex=1.2,col=pred.no,ncol=2,title='Predators')
      }
      i<<-i+1

      barplot(b,space=0.4,names=length.names,col=pred.no.age)
      title(main=paste(x[1,]$Prey," Quarter:",x[1,]$Quarter," age:",x[1,]$Prey.age),cex=1.5)
    })
  })

}

tt<-do.plot.q()
if (dev %in% c('png','print')) cleanup()

 ###################
if (FALSE) {
  cleanup()
  dev<-"print"
  dev<-"screen"
  nox<-3
  noy<-2

  i<-0
  all.pred.col<-sort(unique(a$Predator.no),decreasing = TRUE)
  all.prey.col<-sort(unique(a$Prey.no),decreasing = TRUE)
  all.names<-rep('aaa',length(all.pred.col))
  for (s in (1:length(all.pred.col))) all.names[s]<-sp.names[all.pred.col[s]]

  by(a,list(a$Prey.age,a$Prey),function(x) {
      b<- tapply(x$Part.M2,list(x$Predator.no,x$Year),sum)
      b[is.na(b)]<-0

      pred.no<-as.numeric(dimnames(b)[[1]])
      pred.names<-rep('aaa',length(pred.no))
      for (s in (1:length(pred.no))) pred.names[s]<-sp.names[pred.no[s]]
      print(names)
      length.names<-dimnames(b)[[2]]
      if ((i %% (nox*noy-1))==0) {
        newplot(dev,nox,noy,Portrait=TRUE);
        par(mar=c(3,5,3,2))
        plot.new(); legend(x=0,y=1,pred.names,fill=pred.no,cex=1.0,ncol=2)
      }
      i<<-i+1
      barplot(b,space=0.4,names=length.names,col=pred.no)
      title(main=paste(x[1,]$Prey,"age:",x[1,]$Prey.age))
  })

  cleanup()
  newplot(dev,nox,noy,Portrait=TRUE);

  ii<-1
  for (prey in (1:dim(c)[3])) {
   cat(paste("\nprey:",dimnames(c)[[3]][prey],'\n'))
   bb<-c[,,prey]
   bb<-rbind(bb,c2[prey,])
   dimbb<-dim(bb)[2]
   cut<-0
   for (i in (dimbb:1)) { if (c2[prey,i]==0) cut=cut+1 else break}
   out<-bb[,1:(dimbb-cut)]
   print(round(out,digits=3), zero.print = ".")

   out<-out[1:(dim(out)[1]-1),]

   psum<-apply(out,1,sum)

   d<-dim(out)[1]
   for (i in (d:1)) if (psum[i]==0) out<-out[-i,]

   if ((ii %% (nox*noy))==0) {
        newplot(dev,nox,noy,Portrait=TRUE);
   }
   barplot(out,xlab='age',ylab='M2',col=1:dim(out)[2],names=dimnames(out)[[2]])
   legend(x="topright",legend=dimnames(out)[[1]],fill=1:dim(out)[2])
   title(main=paste(dimnames(c)[[3]][prey]))
   ii<-ii+1
  }

  a<-Read.part.M2.data()
  # annual part M2
  b<-tapply(a$Part.M2,list(a$Year,a$Predator,a$Predator.age,a$Prey,a$Prey.age),sum)
  b[is.na(b)]<-0
  dimnames(b)

  c<-apply(b,c(4,5,2,3),mean)

  d<-c['Cod',,,]
  dimnames(d)

  d<-d[1:3,,]
  dimnames(d)

  e<-apply(d,c(2,3,1),sum)
  print(round(e,digits=4), zero.print=".")

  # special cod
  a<-Read.part.M2.data()
  # quarterly part M2
  b<-tapply(a$Part.M2,list(a$Year,a$Predator,a$Predator.age,a$Prey,a$Prey.age,a$Quarter.1),sum)
  b[is.na(b)]<-0
  dimnames(b)

  c<-apply(b,c(6,4,5,2,3),mean)
  dimnames(c)

  #d<-c[,'Cod',,c('Cod','Whiting'),]
  d<-c[,'Cod',,c('Cod'),]
  dimnames(d)

  d<-d[,1:3,]
  dimnames(d)

  print(round(d,digits=4), zero.print=".")

  # sandeel;
  a<-Read.part.M2.data()
  a<-subset(a,Prey=='Nor. pout' & Year>=1983)
  a$halfyear<-2
  a$halfyear[a$Quarter==1 | a$Quarter==2]<-1
  b<-tapply(a$Part.M2,list(a$Year,a$Prey.age,a$halfyear),sum)
  b[is.na(b)]<-0
  b

  cleanup()
  nox<-2
  noy<-3
  dev<-"screen"

  newplot(dev,nox,noy,Portrait=TRUE);
  par(mar=c(3,5,3,2))
  for (age in (0:3)) {
   barplot(t(b[,age+1,]),xlab='Year',ylab='M2',col=1:2 )
    title(main=paste('age ',age,':\nfirst=',formatC(mean(b[,age+1,1]),digits=2),', second=',formatC(mean(b[,age+1,2]),digits=2),sep=''))
  }

  # sandeel;
  a<-Read.part.M2.data()
  a<-subset(a,Prey=='Nor. pout' & Year>=1983)
  a$halfyear<-2
  a$halfyear[a$Quarter==1 | a$Quarter==2]<-1
  b<-tapply(a$Part.M2,list(a$Year,a$Prey.age,a$halfyear),sum)
  b[is.na(b)]<-0
  b

    palette(rainbow(9))
  cleanup()
  nox<-2
  noy<-3
  dev<-"screen"
  b<-b+0.1
  b[,1,1]<-0 # first half, age 0

  newplot(dev,nox,noy,Portrait=TRUE);
  par(mar=c(3,5,3,2))
  for (age in (0:3)) {
   barplot(t(b[,age+1,]),xlab='Year',ylab='M1+M2',col=1:2 )
    title(main=paste('age ',age,':\nfirst=',formatC(mean(b[,age+1,1]),digits=2),', second=',formatC(mean(b[,age+1,2]),digits=2),sep=''))
  }

  b<-tapply(a$Part.M2,list(a$Year,a$Prey.age,a$Quarter),sum)
  b[is.na(b)]<-0
  b

  #cleanup()
  X11()
  nox<-2
  noy<-3

  newplot(dev,nox,noy,Portrait=TRUE);
  par(mar=c(3,5,3,2))
  for (age in (0:4)) {
   barplot(t(b[,age+1,]),xlab='Year',ylab='M2',col=1:4 )
    title(main=paste('age ',age,':\nQ1=',formatC(mean(b[,age+1,1]),digits=2),
                                ', Q2=',formatC(mean(b[,age+1,2]),digits=2),
                                ', Q3=',formatC(mean(b[,age+1,3]),digits=2),
                                ', Q4=',formatC(mean(b[,age+1,4]),digits=2),sep='')
                                )
  }

  aa<-subset(a,Year>=1982)
  b<-tapply(aa$Part.M2,list(aa$Year,aa$Prey.age),sum)
  bb<-apply(b,2,mean)
}


#!/usr/bin/env/Rscript

# seurat_integration.R
# Dane Vassiliadis
# Peter MacCallum Cancer Center
# 23-6-20

# DESCRIPTION
# Pipeline to automate basic 10X sample processing and visualisation using
# Seurat CCA analysis

##------------------------ Setup Environment ------------------------##
suppressPackageStartupMessages(library("optparse"))
suppressPackageStartupMessages(library("Seurat"))
suppressPackageStartupMessages(library("sctransform"))
suppressPackageStartupMessages(library("DropletUtils"))
suppressPackageStartupMessages(library("PCAtools"))
suppressPackageStartupMessages(library("biomaRt"))
suppressPackageStartupMessages(library("stringr"))

##------------------------ Get Options ------------------------##
 option_list <- list(
    # Basic options
    make_option(c("-i", "--countsdir"), type="character", dest="countsdir", default = NULL,
        help="REQUIRED: Path to the input directory containing counts matrix, barcodes, and features files", metavar="path"),
 25   make_option(c("-o", "--outdir"), type="character", dest="outdir", default="./",
 26       help="Folder to output analysis files. Will be created if it does not exist"),
 27   make_option(c("-n", "--samplename"), type="character", dest="samplename", default="seurat_pipeline_default",
 28       help="Name of sample. Default = seurat_pipeline_default"),
 29   make_option(c("-s", "--species"), type="character", dest="species", default="human",
 30       help="Species of sample. Can be human or mouse. Default = human"),
 31   make_option(c("--project"), type="character", dest="project", default="scRNAseq",
 32       help="Project name sample belongs to. Default = scRNAseq"),
 33   make_option(c("--meta"), type="character", dest="meta",
 34       help="Metadata to add to the sample. Usually a table of cellID with metadata columns. Must contain same cell IDs as the sa    mple."),
 35   make_option(c("--norm"), type="character", dest="norm", default="sctransform",
 36       help="Normalisation method to use [default]"),
 37
 38   # Filtering options
 39   make_option(c("-m", "--mito"), type="integer", default=10, dest="mitocutoff",
 40     help="Threshold for filtering droplets based on mitochondrial read percentage. Default = 10"),
 41   make_option("--featuresup", type="integer", default=10000, dest="featuresup",
 42     help="Upper threshold for filtering droplets based on total detected features. Default = 10000"),
 43   make_option("--featuresdn", type="integer", default=100, dest="featuresdn",
 44     help="Lower threshold for filtering droplets based on total detected features. Default = 100"),
 45   make_option("--countsup", type="integer", default=100000, dest="countsup",
 46     help="Upper threshold for filtering droplets based on total read counts. Default = 100000"),
 47   make_option("--countsdn", type="integer", default=1000, dest="countsdn",
 48     help="Lower threshold for filtering droplets based on total detected features. Default = 1000"),

options(future.globals.maxSize = 16000 * 1024^2)

# make sure each sample is named for later
KRAS.T0$samplename <- "KRAS.T0"
KRAS.14$samplename <- "KRAS.14"
KRAS.17$samplename <- "KRAS.17"

# reset default assay
DefaultAssay(KRAS.T0) <- "SCT"
DefaultAssay(KRAS.14) <- "SCT"
DefaultAssay(KRAS.17) <- "SCT"

# CCA integration workflow
KRAS.list <- list(KRAS.T0, KRAS.14, KRAS.17)
KRAS.features <- SelectIntegrationFeatures(object.list = KRAS.list, nfeatures = 6000)
KRAS.list <- PrepSCTIntegration(object.list = KRAS.list, anchor.features = KRAS.features, verbose = T)
KRAS.anchors <- FindIntegrationAnchors(object.list = KRAS.list, normalization.method = "SCT", anchor.features = KRAS.features, verbose = T)
KRAS.integrated <- IntegrateData(anchorset = KRAS.anchors, normalization.method = "SCT", verbose = T)
KRAS.integrated@meta.data
KRAS.integrated <- RunPCA(object = KRAS.integrated, verbose = T)
KRAS.integrated <- RunUMAP(object = KRAS.integrated, dims = 1:50)