
##################################################################################################################
########################### Estimate of the statistical distribution for the NI ##################################
##################################################################################################################

library(gamlss)
library(gamlss.dist)
library(msm)
library(truncnorm)

############################# Fitting Continuous distribution ####################################################

###
### Note: the following function fit a statistical distribution by using 2 quantile, usually 50% quantile (but any can be used), and 1 expected mean
###

### Normal
qdev.NO <- function(par,obs,prob) {
q1<-qNO(p=prob[1],mu=par[1],sigma=par[2])
q2<-qNO(p=0.5,mu=par[1],sigma=par[2])
q3<-qNO(p=prob[2],mu=par[1],sigma=par[2])
qqq<-c(q1,q2,q3)
sum((qqq-obs)^2)}

### Truncated Normal
qdev.TNO <- function(par,obs,prob) {
q1<-qtnorm(p=prob[1], mean=par[1], sd=par[2], lower=0)
q2<-etruncnorm(a=0, b=1e11, mean=par[1], sd=par[2])
q3<-qtnorm(p=prob[2], mean=par[1], sd=par[2], lower=0)
qqq<-c(q1,q2,q3)
sum((qqq-obs)^2)}

#### LogNormal
qdev.LOGNO <- function(par,obs,prob) {
q1<-qLOGNO(p=prob[1],mu=par[1],sigma=par[2])
m<-(exp(par[2]^2))^0.5*exp(par[1])
q3<-qLOGNO(p=prob[2],mu=par[1],sigma=par[2])
qmq<-c(q1,m,q3)
sum((qmq-obs)^2)}

#### WEIBULL
qdev.WEI <- function(par,obs,prob) {
q1<-qWEI(p=prob[1],mu=par[1],sigma=par[2])
m<-par[1]*gamma(1/par[2]+1)
q3<-qWEI(p=prob[2],mu=par[1],sigma=par[2])
qmq<-c(q1,m,q3)
sum((qmq-obs)^2)}

### GUMBEL
qdev.GU <- function(par,obs,prob) {
q1<-qGU(p=prob[1],mu=par[1],sigma=par[2])
m<-par[1]-0.57722*par[2]
q3<-qGU(p=prob[2],mu=par[1],sigma=par[2])
qmq<-c(q1,m,q3)
sum((qmq-obs)^2)}

### GAMMA
qdev.GA <- function(par,obs,prob) {
q1<-qGA(p=prob[1],mu=par[1],sigma=par[2])
m<-par[1]
q3<-qGA(p=prob[2],mu=par[1],sigma=par[2])
qmq<-c(q1,m,q3)
sum((qmq-obs)^2)}

################################# Fitting Discrete Distribution ########################################

### POISSON
qdev.PO <- function(par,obs,prob) {
q1<-qPO(p=prob[1],mu=par[1])
m<-par[1]
q3<-qPO(p=prob[2],mu=par[1])
qmq<-c(q1,m,q3)
sum((qmq-obs)^2)}

### Negative Binomial
qdev.NBII <- function(par,obs,prob) {
q1<-qNBII(p=prob[1],mu=par[1],sigma=par[2])
m<-par[1]
q3<-qNBII(p=prob[2],mu=par[1],sigma=par[2])
qmq<-c(q1,m,q3)
sum((qmq-obs)^2)}

### Zero-Inflated Poisson
qdev.ZIP <- function(par,obs,prob) {
q1<-qZIP(p=prob[1],mu=par[1],sigma=par[2])
m<-(1-par[2])*par[1]
q3<-qZIP(p=prob[2],mu=par[1],sigma=par[2])
qmq<-c(q1,m,q3)
sum((qmq-obs)^2)}

#####################################################################################################################
##### To fit the appropriate statistical law to NI data: complete version ###########################################
#####################################################################################################################

estim.fct<-function(obsval=c(0.3,0.6,0.8),proba=c(0.25,0.75),type="continuous"){

if(obsval[2]==0){obsval[2]<-0.0001}

if (type=="continuous"){
mini1=nlminb(start=c(0.5, 1), objective=qdev.TNO,lower=c(-1e6,0.001),prob=proba,obs=obsval)
mini2=nlminb(start=c(0.5, 1), objective=qdev.LOGNO,lower=c(-1e6,0.001),prob=proba,obs=obsval)
mini3=nlminb(start=c(0.5, 1), objective=qdev.GU,lower=c(0.001,0.001),prob=proba,obs=obsval)
if(min(rGU(99,mini3$par[1],mini3$par[2]))<0){mini3$objective<-10e10}
mini4=nlminb(start=c(0.5, 1), objective=qdev.WEI,lower=c(0.001,0.001),prob=proba,obs=obsval)
mini5=nlminb(start=c(0.5, 1), objective=qdev.GA,lower=c(0.001,0.001),prob=proba,obs=obsval)
mini<-list(mini1,mini2,mini3,mini4,mini5)
critlist<-c(mini1$objective, mini2$objective, mini3$objective, mini4$objective, mini5$objective)
distrib<-c("TruncNormal","LogNormal","Gumbel","Weibull","Gamma")
mu<-c(mini1$par[1],mini2$par[1],mini3$par[1],mini4$par[1],mini5$par[1])
sig<-c(mini1$par[2],mini2$par[2],mini3$par[2],mini4$par[2],mini5$par[2])
sel<-critlist==min(critlist)
res<-data.frame(distrib=distrib[sel],mu=mu[sel],sig=sig[sel],crit=critlist[sel])}

if (type=="discrete"){
mini1=nlminb(start=c(0.5), objective=qdev.PO,lower=c(0.001,0.001),prob=proba,obs=obsval)
mini2=nlminb(start=c(0.5, 1), objective=qdev.NBII,lower=c(0.001,0.001),prob=proba,obs=obsval)
mini3=nlminb(start=c(0.5, 1), objective=qdev.ZIP,lower=c(0.001,0.001),upper=c(10000,0.999),prob=proba,obs=obsval)
mini<-list(mini1,mini2,mini3)
critlist<-c(mini1$objective, mini2$objective, mini3$objective)
distrib<-c("Poisson","NegBinom","ZIP")
mu<-c(mini1$par[1],mini2$par[1],mini3$par[1])
sig<-c(NA,mini2$par[2],mini3$par[2])
sel<-critlist==min(critlist)
res<-data.frame(distrib=distrib[sel],mu=mu[sel],sig=sig[sel],crit=critlist[sel])}

if(nrow(res)>1){res<-res[1,]}

return(res)
}


#####################################################################################################################
##### To fit the appropriate statistical law to NI data: simple version #############################################
#####################################################################################################################

estimlight.fct<-function(obsval=c(0.3,0.6,0.8),proba=c(0.25,0.75),type="continuous"){

if(obsval[2]==0){obsval[2]<-0.0001}

if (type=="continuous"){
mini1=nlminb(start=c(0.5, 1), objective=qdev.NO,lower=c(-1e6,0.001),prob=proba,obs=obsval)
if(min(rNO(99,mini1$par[1],mini1$par[2]))<0){mini1$objective<-10e10}
mini2=nlminb(start=c(0.5, 1), objective=qdev.LOGNO,lower=c(-1e6,0.001),prob=proba,obs=obsval)
mini<-list(mini1,mini2)
critlist<-c(mini1$objective, mini2$objective)
distrib<-c("Normal","LogNormal")
mu<-c(mini1$par[1],mini2$par[1])
sig<-c(mini1$par[2],mini2$par[2])
sel<-critlist==min(critlist)
res<-data.frame(distrib=distrib[sel],mu=mu[sel],sig=sig[sel],crit=critlist[sel])}

if (type=="discrete"){
mini1=nlminb(start=c(0.5), objective=qdev.PO,lower=c(0.001,0.001),prob=proba,obs=obsval)
mini2=nlminb(start=c(0.5, 1), objective=qdev.NBII,lower=c(0.001,0.001),prob=proba,obs=obsval)
mini<-list(mini1,mini2)
critlist<-c(mini1$objective, mini2$objective)
distrib<-c("Poisson","NegBinom")
mu<-c(mini1$par[1],mini2$par[1])
sig<-c(NA,mini2$par[2])
sel<-critlist==min(critlist)
res<-data.frame(distrib=distrib[sel],mu=mu[sel],sig=sig[sel],crit=critlist[sel])}

if(nrow(res)>1){res<-res[1,]}

return(res)
}

#########################################################
############# Simulation of NI data : ###################
#########################################################

simulNI.fct<-function(nsim=99,distrib,mu,sig,obs){

if (distrib=="Gamma"){
vec<-rGA(nsim,mu=mu,sigma=sig)
while(NaN%in%vec){vec[is.na(vec)]<-rGA(length(vec[is.na(vec)]),mu=mu,sigma=sig)}
}

if (distrib=="Gumbel")       {vec<-rGU(nsim,mu=mu,sigma=sig)}
if (distrib=="LogNormal")    {vec<-rLOGNO(nsim,mu=mu,sigma=sig)}
if (distrib=="TruncNormal")  {vec<-rtnorm(nsim,mean=mu,sd=sig,lower=0)}
if (distrib=="Normal")       {vec<-rNO(nsim,mu=mu,sigma=sig)}
if (distrib=="Weibull")      {vec<-rWEI(nsim,mu=mu,sigma=sig)}
if (distrib=="Poisson")      {vec<-rPO(nsim,mu=mu)}
if (distrib=="NegBinom")     {vec<-rNBII(nsim,mu=mu,sigma=sig)}
if (distrib=="ZIP")          {vec<-rZIP(nsim,mu=mu,sigma=sig)}
if (distrib=="NoBoot")       {vec<-rep(obs,nsim)}

return(vec)

}

###################################################################################
#### To extract 95% confidence intervals and median values of a simulation set ####
###################################################################################

qinf.fct<-function(vec){
return(as.numeric(quantile(na.omit(vec),0.025)))}

qmed.fct<-function(vec){
return(as.numeric(quantile(na.omit(vec),0.5)))}

qsup.fct<-function(vec){
return(as.numeric(quantile(na.omit(vec),0.975)))}

pval.fct<-function(vec){
return(length(vec[vec<0])/length(vec))}

########################################################################################################
#### Calculation of weights for the Nature Index #######################################################
########################################################################################################

###
### Note: this function estimate the weight for one municipality. Its rely on the organisation of data files 
###

calweight.kommune<-function(municipality){
### 3 cases: or there is at least one Ext, or no Ext but others ,or only Ext.
### selection of the case:

other<-unique(municipality$troph[municipality$troph!="Ext"])
pres.ext<-0
pres.oth<-0
if (any("Ext" %in% municipality$troph[municipality$pres==1])){pres.ext<-1}
if (any(other %in% municipality$troph[municipality$pres==1])){pres.oth<-1}

###
if(pres.ext==1 & pres.oth==1){
                               for (i in 1:nrow(municipality)){
                               if(municipality$pres[i]==1){
                               if(municipality$troph[i]=="Ext"){
                               nind<-length(municipality$troph[municipality$troph=="Ext" & municipality$pres==1])
                               spetot<-sum(municipality$spe[municipality$troph=="Ext" & municipality$pres==1])
                               spei<-municipality$spe[i]
                               wgrp<-0.5
                               wind<-spei/spetot
                               municipality$w[i]<-wgrp*wind}

                               if(municipality$troph[i]!="Ext"){
                               nind<-length(municipality$troph[municipality$troph==municipality$troph[i] & municipality$pres==1])
                               ngrp<-length(unique(municipality$troph[municipality$troph!="Ext" & municipality$pres==1]))
                               spetot<-sum(municipality$spe[municipality$troph==municipality$troph[i] & municipality$pres==1])
                               spei<-municipality$spe[i]
                               wgrp<-0.5/ngrp
                               wind<-spei/spetot
                               municipality$w[i]<-wgrp*wind}}}}

if(pres.ext==0 & pres.oth==1){
                               for (i in 1:nrow(municipality)){
                               if(municipality$pres[i]==1){
                               nind<-length(municipality$troph[municipality$troph==municipality$troph[i] & municipality$pres==1])
                               ngrp<-length(unique(municipality$troph[municipality$troph!="Ext" & municipality$pres==1]))
                               spetot<-sum(municipality$spe[municipality$troph==municipality$troph[i] & municipality$pres==1])
                               spei<-municipality$spe[i]
                               wgrp<-1/ngrp
                               wind<-spei/spetot
                               municipality$w[i]<-wgrp*wind}}}


if(pres.ext==1 & pres.oth==0){
                               for (i in 1:nrow(municipality)){
                               if(municipality$pres[i]==1){
                               nind<-length(municipality$troph[municipality$troph=="Ext" & municipality$pres==1])
                               spetot<-sum(municipality$spe[municipality$troph=="Ext" & municipality$pres==1])
                               spei<-municipality$spe[i]
                               wgrp<-0.5
                               wind<-spei/spetot
                               municipality$w[i]<-wgrp*wind}}}
return(municipality$w)}



#########################################################################################################################################
################### Calculation of NI trends & Maps #####################################################################################
#########################################################################################################################################

###
### Note: The argument wstockboot is a Nindicator*N municipality * Ndate * Nsimulated values array containing weighted NI data. StockbootT2 is the same but with unweighted NI values. In these arrays, (-1) indicates missing knowledge, while NA indicates that the indicator is absent. Both codes are treated similarly when mapping, as "no values"
### The argument Nsim is the number of simulations. selko is a vector to select municipalities (see areastat$kom). years is a vector of dates for which calculation is desired. areaweight is the vector of weight attributed to each locality (e.g. municipality area: see areastat$terrestrial or areastat$marine)
###

### Weighted NI over a region ##########################################################################################################################################################################################################
calc.natureindex.fct<-function(wstockboot,nsim=99,selko,years=yearest,areaweight=majhab){
stockres<-matrix(NA,ncol=length(years),nrow=nsim)
for (i in 1:nsim) {
wstockTsim<-wstockboot[,,,i]
trend<-NULL
for (y in years){
val<-apply(wstockTsim[,selko,yearest==y],c(2),sum,na.rm=T)
maj<-areaweight[selko]
maj<-maj[!is.na(val)]
val<-na.omit(val)
tr<-sum((val*maj)/sum(maj))
trend<-c(trend,tr)
}
stockres[i,]<-trend
}
return(stockres)}

#### Weighted NI in a unique spatial unit ##########################################################################################################################################################################################################
calc.NIoneregion.fct<-function(wstockboot,nsim=999,selko,main,years=yearest,areaweight=majhab){
stockres<-matrix(NA,ncol=length(years),nrow=nsim)
for (i in 1:nsim) {
wstockTsim<-wstockboot[,,,i]
trend<-NULL
for (y in years){
tr<-sum(wstockTsim[,selko,yearest==y],na.rm=T)
trend<-c(trend,tr)
}
stockres[i,]<-trend
}
return(stockres)}


### plot of the trend and 95% confidence intervals ##########################################################################################################################################################################################################
display.natureindex.fct<-function(nitrend,years=yearest,main="NI Fjell",limy=c(0,1)){
trend<-apply(nitrend,c(2),qmed.fct)
trinf<-apply(nitrend,c(2),qinf.fct)
trsup<-apply(nitrend,c(2),qsup.fct)
plot(years,trend,pch=16,type="b",lwd=2,main=main,axes=F,ylim=limy)
lines(years,trsup,col="grey",lty=2)
lines(years,trinf,col="grey",lty=2)
axis(side=1,at=c(1950,1990,2000,2010))
axis(side=2,at=seq(limy[1],limy[2],0.1))
write.table(data.frame(val=round(trend,2),inf=round(trinf,2),sup=round(trsup,2),year=years),paste(main,".txt"),row.names=F,sep=",")
return(data.frame(val=round(trend,2),inf=round(trinf,2),sup=round(trsup,2),year=years))
}

### Maps of the weighted NI #################################################################################################################################################################################################################################
calc.NIkom.fct<-function(an=1950,terre=T,nsim=99,ws=wstockboot){
stockres<-matrix(NA,nrow=434,ncol=nsim)
for (i in 1:nsim) {
stockres[,i]<-apply(ws[,,yearest==an,i],c(2),sum,na.rm=T)
}
valkom<-apply(stockres,c(1),qmed.fct)
if(terre==T){valkom[seq(431,434)]<-0}
return(valkom)}

### Maps of the average change in NI ########################################################################################################################################################################################################################
calc.NIkomdiff.fct<-function(an1=1990,an2=2010,terre=T,nsim=99,ws=wstockboot){
stockres<-matrix(NA,nrow=434,ncol=nsim)
for (i in 1:nsim) {
stockres[,i]<-apply(ws[,,yearest==an2,i],c(2),sum,na.rm=T)-apply(ws[,,yearest==an1,i],c(2),sum,na.rm=T)
}
valkom<-apply(stockres,c(1),mean)
pval<-apply(stockres,c(1),pval.fct)
if(terre==T){valkom[seq(431,434)]<-pval[seq(431,434)]<-NA}
res<-data.frame(valkom,pval)
return(res)}

### Maps of each indicator separately #######################################################################################################################################################################################################################
calc.NIindkom.fct<-function(an=1950,nsim=99,sT2=stockbootT2){
indkom<-matrix(NA,nrow=434,ncol=length(indicator))    
for (i in 1:length(indicator)){
print(indicator[i])
stockres<-matrix(NA,nrow=434,ncol=nsim)
for (s in 1:nsim) {
stockres[,s]<-sT2[i,,yearest==an,s]
}
indkom[,i]<-apply(stockres,c(1),qmed.fct)}
return(indkom)
}

### calcul thematic NI for each municipality #################################################################################################################################################################################################################
calc.NIkom.thema.fct<-function(an=1950,terre=T,thema,nsim=99,sT2=stockbootT2){
stockres<-matrix(NA,nrow=434,ncol=nsim)
for (i in 1:nsim) {
if(length(thema)==1){stockres[,i]<-sT2[indicator==thema,,yearest==an,i]}
if(length(thema)>1){stockres[,i]<-apply(sT2[indicator%in%thema,,yearest==an,i],c(2),mean,na.rm=T)}
}
valkom<-apply(stockres,c(1),mean)
if(terre==T){valkom[seq(431,434)]<-0}
return(valkom)}

###
### Note: thema is a vector of names of the selected indicator to build a thematic index. see: indiclist$ind
###

######## Trend for thematic index #############################################################################################################################################################################################################################
calc.themaindex.fct<-function(stockbootT2,nsim=99,selko,years=yearest,areaweight=majhab,thema){
stockres<-matrix(NA,ncol=length(years),nrow=nsim)
if (length(thema)>1 & length(selko[selko==T])>1){
for (i in 1:nsim) {
stockTsim<-stockbootT2[,,,i]
trend<-NULL
for (y in years){
val<-apply(stockTsim[indicator%in%thema,selko,yearest==y],c(2),mean,na.rm=T)
maj<-areaweight[selko]
maj<-maj[!is.na(val)]
val<-na.omit(val)
tr<-sum((val*maj)/sum(maj))
trend<-c(trend,tr)
}
stockres[i,]<-trend
}
}

if (length(thema)>1 & length(selko[selko==T])==1){
for (i in 1:nsim) {
stockTsim<-stockbootT2[,,,i]
trend<-NULL
for (y in years){
tr<-mean(stockTsim[indicator%in%thema,selko,yearest==y],na.rm=T)
trend<-c(trend,tr)
}
stockres[i,]<-trend
}
}

if (length(thema)==1 & length(selko[selko==T])>1){
for (i in 1:nsim) {
stockTsim<-stockbootT2[,,,i]
trend<-NULL
for (y in years){
val<-stockTsim[indicator%in%thema,selko,yearest==y]
maj<-areaweight[selko]
maj<-maj[!is.na(val)]
val<-na.omit(val)
tr<-sum((val*maj)/sum(maj))
trend<-c(trend,tr)
}
stockres[i,]<-trend
}
}


if (length(thema)==1 & length(selko[selko==T])==1){
for (i in 1:nsim) {
stockTsim<-stockbootT2[,,,i]
trend<-NULL
for (y in years){
tr<-stockTsim[indicator%in%thema,selko,yearest==y]
trend<-c(trend,tr)
}
stockres[i,]<-trend
}
}

return(stockres)
}

########################################################################################################################################
#################### Mapping the Nature Index ##########################################################################################
########################################################################################################################################


### add a legend ##########################################################################################################################################################

legend.fct<-function(n,colour,value,xpos=800000,yrange=c(6500000,7000000),ygrey=100000,xtext=150000,cexnum=1,cexval=1){
x<-rep(xpos,n)
y<-seq(yrange[1],yrange[2],length=n)
for (i in 1:n){
points(x[i],y[i],pch=16,col=colour[i])
text(x[i]+xtext,y[i],value[i],cex=cexnum)}
points(xpos,yrange[2]+ygrey,pch=16,col="grey")
text(xpos+xtext,yrange[2]+ygrey,"No Value",cex=cexval)
}

legend.krige<-function (x.leg, y.leg, values, scale.vals, vertical = FALSE,
    offset.leg = 1, ...)
{
    values <- values[!is.na(values)]
    if (length(x.leg) != 2 | length(y.leg) != 2)
        stop("x.leg and y.leg require a vector with 2 elements")
    v.r <- range(values[is.finite(values)], na.rm = TRUE)
    lags.x <- function(xs, nl) {
        xs.r <- 0.5 * diff(xs/(nl - 1))
        return(seq(xs[1] + xs.r, xs[2] - xs.r, l = nl))
    }
    leg.l <- list(...)
    if (is.null(leg.l$br))
        nc <- ifelse(is.null(leg.l$col), 12, length(leg.l$col))
    else nc <- length(leg.l$breaks) - 1
    if (is.null(leg.l$col))
        leg.l$col <- heat.colors(nc)
    if (is.null(leg.l$zl))
        leg.l$zlim <- c(v.r[1], v.r[2])
    if (vertical) {
        xy <- list(x = x.leg, y = lags.x(xs = y.leg, nl = nc))
        if (is.null(leg.l$br))
            image(x = xy$x, y = xy$y, z = matrix(seq(leg.l$zlim[1],
                leg.l$zlim[2], l = nc), nrow = 1), add = TRUE,
                xaxs = "i", yaxs = "i", xlab = "", ylab = "",
                zlim = leg.l$zlim, col = leg.l$col)
        else image(x = xy$x, y = xy$y, z = matrix(seq(leg.l$zlim[1],
            leg.l$zlim[2], l = nc), nrow = 1), add = TRUE, xaxs = "i",
            yaxs = "i", xlab = "", ylab = "", zlim = leg.l$zlim,
            col = leg.l$col, breaks = leg.l$br)
    }
    else {
        xy <- list(x = lags.x(xs = x.leg, nl = nc), y = y.leg)
        if (is.null(leg.l$br))
            image(x = xy$x, y = xy$y, z = matrix(seq(leg.l$zlim[1],
                leg.l$zlim[2], l = nc), ncol = 1), add = TRUE,
                xaxs = "i", yaxs = "i", xlab = "", ylab = "",
                zlim = leg.l$zlim, col = leg.l$col)
        else image(x = xy$x, y = xy$y, z = matrix(seq(leg.l$zlim[1],
            leg.l$zlim[2], l = nc), ncol = 1), add = TRUE, xaxs = "i",
            yaxs = "i", xlab = "", ylab = "", zlim = leg.l$zlim,
            col = leg.l$col, breaks = leg.l$br)
    }
    leg.poly <- rbind(c(x.leg[1], y.leg[1]), c(x.leg[2], y.leg[1]),
        c(x.leg[2], y.leg[2]), c(x.leg[1], y.leg[2]), c(x.leg[1],
            y.leg[1]))
    polygon(leg.poly)
    if (is.null(leg.l$cex))
        leg.l$cex <- 0.8
    if (missing(scale.vals))
        scale.vals <- pretty(c(values, leg.l$zlim), n = 5, min.n = 4)
    scale.vals <- scale.vals[scale.vals > leg.l$zlim[1] & scale.vals <
        leg.l$zlim[2]]
    if (vertical) {
        y.r <- range(lags.x(xs = y.leg, nl = nc))
        y.text <- y.r[1] + ((scale.vals - leg.l$zlim[1]) * diff(y.r))/diff(leg.l$zlim)
        text((max(x.leg) + offset.leg * diff(x.leg)), y.text,
            lab = scale.vals, col = 1, cex = leg.l$cex)
    }
    else {
        x.r <- range(lags.x(xs = x.leg, nl = nc))
        x.text <- x.r[1] + ((scale.vals - leg.l$zlim[1]) * diff(x.r))/diff(leg.l$zlim)
        text(x.text, (max(y.leg) + offset.leg * (diff(y.leg)/2)),
            lab = scale.vals, col = 1, cex = leg.l$cex)
    }
    return(invisible())
}


### plot kriging ##########################################################################################################################################################################################################


show.krigeNI<-function(krigeage=z,nrow=25,ncol=45,main="Gannets, dec 2001",limcol=c(0,1),NB=F,levelb=c(1,2,3),levelw=c(4,5,6),isoligne=F,seuil=NA,ncolor=512,whichcontour="terrestrial",revcolor=F,limxy=NA,couleur=NA){
a<-rep(0,100)
b<-seq(0,1,by=0.01)
c<-rep(0,100)
color<-tim.colors(ncolor)
if (revcolor==T){color<-rev(tim.colors(ncolor))}
if (!is.na(couleur)){color<-couleur}
if (NB==T){color<-rev(hsv(h=a,s=c,v=b))}
if (!is.na(seuil)){
ia<-(seuil-min(krigeage$var1.pred))/(max(krigeage$var1.pred)-min(krigeage$var1.pred))
h<-rep(1,100)
s1<-seq(0.7,0.5,length=(ceiling(ia*100)))
s1<-as.vector(s1)
s2<-seq(0.18,0.05,length=(100-ceiling(ia*100)))
s2<-as.vector(s2)
s<-c(s1,s2)
v<-c(seq(0.75,1,length=50),seq(1,0.95,length=50))
color<-hsv(s,h,v)
}
x<-krigeage$x
y<-krigeage$y
z1<-krigeage$var1.pred
grid<-data.frame(x,y)
az<-as.image(z1,x=grid,ncol=ncol,nrow=nrow)
if (length(limxy)<4) {plot(polynor,col="white",xlab="",ylab="",main=main,col.axis="black",axes=F)}
if (length(limxy)==4){plot(polynor,col="white",xlab="",ylab="",main=main,col.axis="black",axes=F,xlim=limxy[c(1,2)],ylim=limxy[c(3,4)])}
image2(x=az$x,y=az$y,z=az$z,col=rev(color),add=T,zlim=limcol,axes=F)

if (isoligne==T){
contour(x=az$x,y=az$y,z=az$z,level=levelb,add=T,lty=1,labcex=0.75,cex=1,drawlabels=T)
contour(x=az$x,y=az$y,z=az$z,level=levelw,,add=T,lty=1,labcex=0.75,cex=1,col="white",drawlabels=T)}
legend.krige(x.leg=c(800000,850000),y.leg=c(6500000,7000000),values=seq(limcol[1],limcol[2],length=512),scale.vals=pretty(x=limcol,n=5),col=rev(color),vertical=T,cex.lab=0.5)

if (whichcontour=="terrestrial"){
polymap(polynor,add=T,col="transparent",lwd=2)}

if (whichcontour=="coastal"){
polymap(coastlim,add=T,col="transparent",lwd=2)}
}

### add a polygon to a map ##########################################################################################################################################################################################################
addapoly.fct<-function(num,color="pink",bord="black"){
sel<-maskkomnum==num
id<-seq(1:length(maskkomnum))
whichkom<-id[sel]
for (w in whichkom){polymap(polymask[[w]],col=color,border=bord,add=T)}
}

### add a polygon using the simple polygon maps ##########################################################################################################################################################################################################
addapolysimple.fct<-function(num,color="pink",bord="black"){
sel<-shapekomnum==num
id<-seq(1:length(shapekomnum))
whichkom<-id[sel]
for (w in whichkom){polymap(polykom[[w]],col=color,border=bord,add=T)}
}


#### Mapping the Nature Index (either polygons or interpolation) ##########################################################################################################################################################################################################

###
### Note: Lots or arguments here can be used to refine the locality where NI are plotted. They have not been used in our study, but may be relevant in some cases. nind is a vector of number, usually the number of indicator per locality. Minind is a minimum number. If nind and minind are specified, 
### NI values are plotted only when nind>minind. idem with majhab and minhab. breakcol, namecol and valcol are used to specify the colors and legend of non interpolated maps. ncolor, minleg and maxleg are used to calibrate the color scale of interpolated maps.
### the argument interp takes values "no" or "yes", to choose between interpolated NI map or non-interpolated NI map. Liminx and Liminy are used to select the area to be represented in the plotting window, default corresponding to whole norway. ndic should be true when 
### plotting or interpolating the number of indicators per municipality. negval should be true if negative values are to be plotted.  other arguments can be used to calibrate the legend position, change the colors etc.. A careful examination of the code of the function is requirred to use it properly.
### Anyway, numerous examples of the use of this function are provided in the file "NI_commands.R".
###

show.NI.fct<-function(valkom,nind=NA,minind=NA,majhab,minhab,main,year,breakcol,namecol,valcol,showborder="yes",interp="no",ncolor=512,minleg=0,maxleg=1,isoligne=T,levelb=0.75,levelw=0.5,liminx=c(-200000,1200000),liminy=c(6400000,8000000),ndoc=F,revcolor=F,xpos=800000,yrange=c(6500000,7300000),ygrey=100000,xtext=150000,negval=F,interprow=118,interpcol=150,couleur=NA,cexnum=1,cexval=1,krige=T){

if (interp=="no"){
valkom[majhab<=minhab]<-(-1)
if(!is.na(minind)) {valkom[nind<minind]<-(-1)}
valkom[is.na(valkom)]<-(-1)
res<-data.frame(num=areastat$kom_num,val=valkom)
res<-res[seq(1,length(res$val)-4,1),]
plot(areastat$x,areastat$y,main=main,xlim=liminx,ylim=liminy,col="white",xlab="",ylab="",axes=F)
for (i in 1:nrow(res)){
if (res$val[i]==(-1)) {addapoly.fct(num=res$num[i],color="grey")}
if (negval==F & res$val[i]>=0 & res$val[i]<=breakcol[1]) {addapoly.fct(num=res$num[i],color=namecol[1])}
if (negval==T & res$val[i]!=(-1) & res$val[i]<=breakcol[1]) {addapoly.fct(num=res$num[i],color=namecol[1])}
for (j in 2:length(breakcol)){
if (res$val[i]>breakcol[j-1] & res$val[i]<=breakcol[j]) {addapoly.fct(num=res$num[i],color=namecol[j])}}
if (res$val[i]>breakcol[length(breakcol)]){addapoly.fct(num=res$num[i],color=namecol[length(namecol)])}
}
legend.fct(length(namecol),colour=namecol,value=valcol,xpos=xpos,yrange=yrange,ygrey=ygrey,xtext=xtext)
}

if (interp=="yes"){
res<-data.frame(x=areastat$x,y=areastat$y,z=valkom)
res<-res[seq(1,length(res$x)-4,1),]
res<-res[res$z>(-1),]
res<-na.omit(res)

if (krige==T){
gmod<-gstat(id="carto",formula=z~1,loc=~x+y,data=res)
vgmod<-variogram(gmod,width=30000,cutoff=300000)
model1<-vgm(psill=(var(res$z))-vgmod$gamma[1], model="Pow", range=1, nugget=vgmod$gamma[1])
model2<-vgm(psill=(var(res$z))-vgmod$gamma[1], model="Sph", range=vgmod$dist[c(1000000,abs(diff(vgmod$gamma)))==min(c(1000000,abs(diff(vgmod$gamma))))], nugget=vgmod$gamma[1])
model3<-vgm(psill=(var(res$z))-vgmod$gamma[1], model="Exp", range=vgmod$dist[c(1000000,abs(diff(vgmod$gamma)))==min(c(1000000,abs(diff(vgmod$gamma))))], nugget=vgmod$gamma[1])
model4<-vgm(psill=(var(res$z))-vgmod$gamma[1], model="Gau", range=vgmod$dist[c(1000000,abs(diff(vgmod$gamma)))==min(c(1000000,abs(diff(vgmod$gamma))))], nugget=vgmod$gamma[1])
model5<-vgm(psill=(var(res$z))-vgmod$gamma[1], model="Log", range=vgmod$dist[c(1000000,abs(diff(vgmod$gamma)))==min(c(1000000,abs(diff(vgmod$gamma))))], nugget=vgmod$gamma[1])
vgmod.fit1<-fit.variogram(vgmod,model1,fit.method=7)
vgmod.fit2<-fit.variogram(vgmod,model2,fit.method=7)
vgmod.fit3<-fit.variogram(vgmod,model3,fit.method=7)
vgmod.fit4<-fit.variogram(vgmod,model4,fit.method=7)
vgmod.fit5<-fit.variogram(vgmod,model5,fit.method=7)
whichmod<-seq(1,5,1)
SSE<-c(attr(vgmod.fit1,"SSErr"),attr(vgmod.fit2,"SSErr"),attr(vgmod.fit3,"SSErr"),attr(vgmod.fit4,"SSErr"),attr(vgmod.fit5,"SSErr"))
choicemod<-whichmod[SSE==min(SSE)]
modellist<-list(vgmod.fit1,vgmod.fit2,vgmod.fit3,vgmod.fit4,vgmod.fit5)
predi<-krige(formula=z~1, locations=~x+y, data=res, newdata=grid, model=modellist[[choicemod]])
typemodel<-c("power","sph","Exp","Gau","Log")
print(typemodel[choicemod])
if (length(unique(predi$var1.pred)==1)){
predi<-krige(formula=z~1, locations=~x+y, data=res, newdata=grid, model=vgmod.fit2)}
}

if (krige==F){
predi<-idw(formula=z~1, locations=~x+y, data=res, newdata=grid)}

if (negval==F){predi$var1.pred[predi$var1.pred<0]<-0}
if (ndoc==F){predi$var1.pred[predi$var1.pred>1]<-1}
show.krigeNI(krigeage=predi,nrow=interprow,ncol=interpcol,main=main,limcol=c(minleg,maxleg),NB=F,levelb=levelb,levelw=levelw,isoligne=isoligne,seuil=NA,ncolor=ncolor,revcolor=revcolor,limxy=c(liminx,liminy),couleur=couleur)
}
}

########################################################################################################################################
### function to explore the data########################################################################################################
########################################################################################################################################


### to extract the NI value of a subset of communes ##########################################################################################################################################################################################################

NIdetail.fct<-function(year){
pol<-getpoly()
coord<-data.frame(x=areastat$x,y=areastat$y)
coord<-coord[seq(1,nrow(coord)-4,1),]
sel<-inout(coord,pol)
sel<-c(sel,c(F,F,F,F))
data.frame(kom=kommune[sel],NI=apply(wstockT2[,sel,yearest==year],c(2),sum,na.rm=T))}


### to see the scaled indicator value of a subset of communes ##########################################################################################################################################################################################################

whichindicator.fct<-function(year){
pol<-getpoly()
coord<-data.frame(x=areastat$x,y=areastat$y)
coord<-coord[seq(1,nrow(coord)-4,1),]
sel<-inout(coord,pol)
sel<-c(sel,c(F,F,F,F))
essai<-round(stockT2[,sel,yearest==year],2)
essai<-as.data.frame(essai)
rownames(essai)<-indicator
colnames(essai)<-kommune[sel]

anyval<-function(vec){
nval<-F
if(length(na.omit(vec))>0){nval<-T}
return(nval)}

sel2<-apply(essai,1,anyval)
essai[sel2,]
}

### to see the weight attributed to each indicator per municipality ##########################################################################################################################################################################################################

whichweight.fct<-function(year){
pol<-getpoly()
coord<-data.frame(x=areastat$x,y=areastat$y)
coord<-coord[seq(1,nrow(coord)-4,1),]
sel<-inout(coord,pol)
sel<-c(sel,c(F,F,F,F))
essai<-round(weight[,sel,yearest==year],2)
rownames(essai)<-indicator
colnames(essai)<-kommune[sel]

anyval<-function(vec){
nval<-F
if(length(na.omit(vec))>0){nval<-T}
return(nval)}

sel2<-apply(essai,1,anyval)
essai[sel2,]
}

### for zooming into the current plot: ##########################################################################################################################################################################################################

zoomNI.fct<-function(valkomzoom){
popol<-getpoly()
newlimx<-c(min(popol[,1]),max(popol[,1]))
newlimy<-c(min(popol[,2]),max(popol[,2]))
x11()
show.NI.fct(valkom=valkomzoom,liminx=newlimx,liminy=newlimy,nind=NA,minind=NA,majhab=majhab,minhab=NA,main="ZOOM",breakcol=c(0.1,0.2,0.3,0.4,0.5,0.6,0.7,0.8,0.9),namecol=rev(tim.colors(10)),valcol=c("<0.1","0.1-0.2","0.2-0.3","0.3-0.4","0.4-0.5","0.5-0.6","0.6-0.7","0.7-0.8","0.8-0.9",">0.9"),showborder="yes",interp="no")
}
