# this script makes multispecies projections using the OP model given
#   a range of F targets by species

OP.simulate<-function(
          scenario="my-scenario",
          my.area=c('North Sea','Baltic Sea')[1],
          my.last.year=2061, years.in.average=50,

          HCR=NA,
          FBlim.adjust=1,

          stochastic.recruitment=0,
          recruit.adjust.CV=0,        #adjust recruitment with half of the variance (factor exp(-(CV^2)/2).  0=no adjustment, 1=do adjustment
          recruit.adjust.factor=rep(1,nsp.VPA), # factor for adjutment of recruitment

          first.run.no=1,         # first run number (within the present iteration)
          first.no.iter.stoch=1,  # iteration number
          no.iter.stoch=10,  # default for stochastic recruitment

          do.indicators=T,

          do.simulation=T,     # do the simulations and create data files for plots
          just.batch.file=F,   # make a batch file for a later run

          combine.scenario.run=F,    # special for combining scenarios
          scenario.dirs='a',         # name of scenarios to be combined
          scenario.dirs.out='Samlet',   # directory name for output R data set

          adjustBaltic=F,
          OP.output=14,  # 14 for combinations of F
          change.Other.pred.N=F,
          adjust.ini.N=F,     # adjust inital population size  (NS cod)

          read.condense=T,
          read.indicators=T,

          do.plot.indicators=T,
          do.plot.condense=T,
          ReduceTable=F,      # stepwise selection table of F from given criteria
          ReduceTableDetails=F,   # output full (detalied results after each reduction)
          ReduceOption='default', #
          saveOutput=F,   # save output from reduction of tables
          riskLevels=rep(5,nsp.VPA), # Risk levels for SSB below Blim
          keepPro=0.95,  # keep F values which is factor keepPro of  MSY, used in stepwise reduction

          subset.out=FALSE,       # make a subset of data set used to make plots
          justAboveBlim=FALSE,    # make plot for Fcombinations where the risk to Blim <5%
          justAboveBpa=F,
          subset.species=matrix(c(rep(0,nsp.VPA),rep(2,nsp.VPA)),ncol=nsp.VPA,byrow=T),  # min and max F for inclusion in plots
          ask.me=F,
          targetFs=NA,   # combinations of F

          fac.other=1,  # factor to adjust other predator stock size
          fac.other.first.year=-1,  # first year for change
          lab.other='',            #scenario label for other
          fac.other.last.year=-1,  # last year for change

          singleSp=F,      # Mak single species plot

           my.dev='png'
){

first.year.output<-my.last.year-years.in.average+1
cat("first year used in output and in average values:",first.year.output,"\nlast year:",my.last.year,"\n")

no.iter<-1  # for determenistic recruitment
if (stochastic.recruitment>0) no.iter<-no.iter.stoch

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

#  runs are made in a separate directory

scenario<-paste(scenario,paste("HCR",HCR[1],sep=''),FBlim.adjust[1],paste("Rec",stochastic.recruitment,sep=''),ifelse(recruit.adjust.CV[1]==1 | recruit.adjust.CV[1]==2,"Recadj",""),my.last.year,sep='_')

scenario.gem<<-scenario
scenario.dir<-file.path(data.path,scenario)

ref<-Read.reference.points.OP(dir=data.path)
Blim<-as.vector(ref[,'Blim'])
Bpa<-as.vector(ref[,'Bpa'])
Fpa<-as.vector(ref[,'Fpa'])

if (my.area=='North Sea') {
 if (KeyRunYear==2014) {
  #             Cod     Whiting     Haddock      Saithe     Herring     NorthSandeel  southSan       Nor. pout       Sprat      Plaice        Sole
  TSBBlim<- c(    1,          1,          1,          1,          1,    Blim[6]*3.1,  Blim[7]*3.2,  Blim[8]*2.4,     Blim[9]*2.3,          1,          1)
  TSBBpa<-  c(    1,          1,          1,          1,          1,    Bpa[6]*3.1,   Bpa[7]*3.2,   Bpa[8]*2.4,      Bpa[9]*2.3,          1,          1)
 }
# if (!NS.Key.2014) {
#   #             Cod     Whiting     Haddock      Saithe     Herring     Sandeel   Nor. pout       Sprat      Plaice        Sole
#   TSBBlim<- c(    1,          1,          1,          1,          1,     787000,     263000,      157000,          1,          1)
#   TSBBpa<-  c(    1,          1,          1,          1,          1,    1098000,     440000,      213000,          1,          1)
# }
if (KeyRunYear==2017) {
     #             Cod     Whiting     Haddock      Saithe     Herring    Mackerel,  Sandeel   Nor. pout       Sprat      Plaice        Sole
     TSBBlim<- c(    1,          1,          1,          1,          1,      1,         787000,     263000,      157000,          1,          1)
     TSBBpa<-  c(    1,          1,          1,          1,          1,     1,         1098000,     440000,      213000,          1,          1)
 }
} else {  # Baltic
   TSBBlim<- c(1,1,1)
   TSBBpa<-  c(1,1,1)
}

# Make an OP control object. File='OP.dat'
setwd(data.path)
source(file=file.path(prog.path.func,'hcr_op_batch_common.r'))

res<-make.OP.dat(my.area=my.area,my.last.year=my.last.year,first.year.output=first.year.output,
                 do.indicators=do.indicators,
                 stochastic.recruitment=stochastic.recruitment)
OP<-res[["OP"]]
SMS<-res[["SMS"]]

sp.name<-SMS@species.names

 OP@recruit.adjust.CV[1,]<-recruit.adjust.CV

 OP@recruit.adjust[1,]<-recruit.adjust.factor

if (my.area=='Baltic Sea' & adjustBaltic) {# adjustment was done when environmental S-R were used
 OP@recruit.adjust.CV[1,1]<-0     #adjust recruitment with half of the variance (factor exp(-(CV^2)/2).  0=no adjustment, 1=do adjustment
 OP@recruit.adjust.CV[1,2]<-1     #adjust recruitment with half of the variance (factor exp(-(CV^2)/2).  0=no adjustment, 1=do adjustment
 OP@recruit.adjust.CV[1,3]<-1     #adjust recruitment with half of the variance (factor exp(-(CV^2)/2).  0=no adjustment, 1=do adjustment
}

OP@F.or.C[]<-31
OP@output<-OP.output

if (!all(fac.other == 1)) {
  OP@other.predator[2,]<-fac.other.first.year;
  OP@other.predator[3,]<-fac.other.last.year;
  OP@other.predator[1,]<- fac.other;
}

write.FLOP.control(OP,file='op.dat',nice=T)

if (length(FBlim.adjust)==1) FBlim.adjust<-rep(1,length(Fpa))

### op_trigger file
  nsp<-SMS@no.species
  n.other.pred<-sum(SMS@species.info[,'predator']==2)
  n.pred<-n.other.pred+sum(SMS@species.info[,'predator']==1)
  n.vpa<-nsp-n.other.pred
  n.vpa.pred<-sum(SMS@species.info[,'predator']==1)

OPT<-read.FLOPtrigger.control(file="op_trigger.dat",n.VPA=n.vpa,n.other.pred=n.other.pred)
OPT@last.year<-my.last.year
OPT@first.year<-first.year.output
OPT@HCR[]<-HCR
OPT@first.run.no<-first.run.no
OPT@first.iter.no<-first.no.iter.stoch
OPT@no.iter<-no.iter

OPT@trigger['T1',]<-Blim* FBlim.adjust
OPT@trigger['T2',]<-Bpa
OPT@at.age.weighting<-1
for (s in(1:n.vpa)) if (HCR[s]==22) {
  OPT@trigger['T1',s]<-TSBBlim[s]* FBlim.adjust[s]
  OPT@trigger['T2',s]<-TSBBpa[s];
}
write.FLOPtrigger.control(OPT,file="op_trigger.dat")

# MSFD and other options
if (do.indicators) {
 MSFD<-FLOP.MSFD.control()

 if (my.area=='Baltic Sea') {
   MSFD@do.community.biomass.demersal<-1
   MSFD@community.biomass.demersal.ages[ ,2:3]<- -1     # cod (species 1) is a demersal species

   MSFD@do.community.biomass.small<-1
   MSFD@community.biomass.small.ages['last.age',1]<- 1     # fish below 25 cm is small, that includes all herring and sprat, cod age 0-1 is small species

   MSFD@do.community.biomass.pelagic<-1
   MSFD@community.biomass.pelagic.ages[,1]<- -1     # herring and sprat (species 2, 3) are pelagic species

   MSFD@do.community.biomass.forage<-1
   MSFD@community.biomass.forage.ages[,1]<- -1     # herring and sprat (species 2, 3) are forage species

   MSFD@do.M2.bar<-1
   MSFD@M2.bar.ages['last.age',1]<- 1     # cod age 0 and 1, and all ages for herring and sprat (species 2, 3)

   MSFD@do.community.F<-1
   MSFD@community.F.sp[]<-1   #include all species
   MSFD@do.community.M<-1
   MSFD@community.M.sp[]<-1   #include all species

   MSFD@do.life.expectancy <-1
   MSFD@life.expectancy.first.age[]<-0

   MSFD@do.community.life.expectancy<-1
   MSFD@community.life.expectancy.options["first.age",]<-0
   MSFD@community.life.expectancy.options["weighting",]<-1

   MSFD@do.LFI<-1
   MSFD@LFI.sp[]<-1
   MSFD@LFI.age[]<-c(3,99,99) # only cod age 3+ is greather than 40 cm
 }

 if (my.area=='North Sea' & KeyRunYear==2014) {
    # 1 Fulmar
    # 2 Guillemot
    # 3 Her. Gull
    # 4 Kittiwake
    # 5 GBB. Gull
    # 6 Gannet
    # 7 Puffin
    # 8 Razorbill
    # 9 R. radiata
    # 10 G. gurnards
    # 11 W. mackerel
    # 12 N. mackerel
    # 13 W.horse mac
    # 14 N.horse mac
    # 15 Grey seal
    # 16 H. porpoise
    # 17 Cod
    # 18 Whiting
    # 19 Haddock
    # 20 Saithe
    # 21 Herring
    # 22 Sandeel
    # 23 Nor. pout
    # 24 Sprat
    # 25 Plaice
    # 26 Sole

# 2017 key run
  # 1 Fulmar
  # 2 Guillemot
  # 3 Her. Gull
  # 4 Kittiwake
  # 5 GBB. Gull
  # 6 Gannet
  # 7 Puffin
  # 8 Razorbill
  # 9 R. radiata
  # 10 G. gurnards
  # 11 W.horse mac
  # 12 N.horse mac
  # 13 Grey seal
  # 14 H. porpoise
  # 15 Hake
  # 16 Cod
  # 17 Whiting
  # 18 Haddock
  # 19 Saithe
  # 20 Mackerel
  # 21 Herring
  # 22 N. sandeel
  # 23 S. sandeel
  # 24 Nor. pout
  # 25 Sprat
  # 26 Plaice
  # 27 Sole

   # THIS IS NOT UPDATED WITH 2017 key RUN SPECIES

   MSFD@do.community.biomass.demersal<-1
   MSFD@community.biomass.demersal.ages['first.age' ,c(1:8,11:16,21,24)]<-  99  # exclude
   MSFD@community.biomass.demersal.ages['last.age'  ,c(1:8,11:16,21,24)]<-  -1  # exclude

   MSFD@do.community.biomass.small<-0  # not ready yet!!!!!!!!!!!!!!!!!!!!!!!
   MSFD@community.biomass.small.ages['last.age',c(1:8,11:16,21,24)]<- -1     # exclude    NEEDS UPDATE

   MSFD@do.community.biomass.pelagic<-1
   MSFD@community.biomass.pelagic.ages['first.age',c(1:20,22:23,25:26)]<- 99     # exclude
   MSFD@community.biomass.pelagic.ages['last.age',c(1:20,22:23,25:26)]<- -1     # exclude

   MSFD@do.community.biomass.forage<-1
   MSFD@community.biomass.forage.ages['first.age',c(1:20,25:26)]<- 99     # exclude
   MSFD@community.biomass.forage.ages['last.age',c(1:20,25:26)]<- -1     # exclude

#Average M2      age 0  age 1  age 2  age 3  age 4  age 5  age 6  age 7  age 8  age 9  age 10
#Cod             1.541  0.986  0.553  0.076  0.000  0.000  0.000  0.000  0.000  0.000  0.000
#Whiting         1.195  1.042  0.457  0.378  0.371  0.345  0.324  0.271  0.236
#Haddock         1.104  1.116  0.355  0.166  0.111  0.062  0.034  0.018  0.007  0.003  0.000
#Saithe          0.000  0.000  0.000  0.000  0.000  0.000  0.000  0.000  0.000  0.000  0.000
#Herring         0.551  0.463  0.248  0.212  0.187  0.169  0.159  0.134
#Sandeel         0.782  0.822  0.678  0.520  0.516
#Nor. pout       1.130  1.728  1.428  1.250
#Sprat           0.647  1.165  0.891  0.625

   MSFD@do.M2.bar<-1
   MSFD@M2.bar.ages['first.age',]<- c(0,0,0,-1,0,0,0,0,-1,-1)     # all ages for forage species, and >0.2 for other species
   MSFD@M2.bar.ages['last.age',] <- c(2,8,2,-1,3,4,3,3,-1,-1)     # all ages for forage species, and >0.2 for other species

   MSFD@do.community.mean.weight <-1
   MSFD@community.mean.weight.sp[]<-1  #include all species

   MSFD@do.community.mean.weight.C <-1
   MSFD@community.mean.weight.C.sp[]<-1  #include all species

   MSFD@do.mean.weight.C <-0
   MSFD@mean.weight.C.sp[]<-1    #include all species

   MSFD@do.community.F<-1
   MSFD@community.F.sp[]<-1   #include all species
   MSFD@do.community.M<-1
   MSFD@community.M.sp[]<-1   #include all species

   MSFD@do.life.expectancy <-1
   MSFD@life.expectancy.first.age[]<-0

   MSFD@do.community.life.expectancy<-1
   MSFD@community.life.expectancy.options["first.age",]<-0
   MSFD@community.life.expectancy.options["weighting",]<-1

   MSFD@do.LFI<-1
   MSFD@LFI.sp[ ,c(1:16,18,21:24)]<- 0  # exclude
   MSFD@LFI.age[]<-c(rep(99,16),2,99,5,2,99,99,99,99,10,8)  # first age considered as large fish (greather than 40 cm)
 }

if (my.area=='North Sea' & KeyRunYear==2014) {
  # 1 Fulmar
  # 2 Guillemot
  # 3 Her. Gull
  # 4 Kittiwake
  # 5 GBB. Gull
  # 6 Gannet
  # 7 Puffin
  # 8 Razorbill
  # 9 R. radiata
  # 10 G. gurnards
  # 11 W. mackerel
  # 12 N. mackerel
  # 13 W.horse mac
  # 14 N.horse mac
  # 15 Grey seal
  # 16 H. porpoise
  # 17 Hake
  # 18 Cod  (17)
  # 19 Whiting (18)
  # 20 Haddock (19)
  # 21 Saithe  (20)
  # 22 Herring (21)
  # 23 Northern Sandeel
  # 24 Southern Sandeel
  # 25 Nor. pout (23)
  # 26 Sprat (24)
  # 27 Plaice (25)
  # 28 Sole  (26)

  MSFD@do.community.biomass.demersal<-1
  MSFD@community.biomass.demersal.ages['first.age' ,c(1:8,11:16,22,26)]<-  99  # exclude
  MSFD@community.biomass.demersal.ages['last.age'  ,c(1:8,11:16,22,26)]<-  -1  # exclude

  MSFD@do.community.biomass.small<-0  # not ready yet!!!!!!!!!!!!!!!!!!!!!!!
  MSFD@community.biomass.small.ages['last.age',c(1:8,11:17,22,26)]<- -1     # exclude    NEEDS UPDATE

  MSFD@do.community.biomass.pelagic<-1
  MSFD@community.biomass.pelagic.ages['first.age',c(1:20,22:23,22:28)]<- 99     # exclude
  MSFD@community.biomass.pelagic.ages['last.age',c(1:20,22:23,25:26)]<- -1     # exclude

  MSFD@do.community.biomass.forage<-1
  MSFD@community.biomass.forage.ages['first.age',c(1:21,23:25,27:28)]<- 99     # exclude
  MSFD@community.biomass.forage.ages['last.age',c(1:21,23:25,27:28)]<- -1     # exclude

  MSFD@do.M2.bar<-1
  MSFD@M2.bar.ages['first.age',]<- c(0,0,0,-1,0,0,0,0,0,-1,-1)     # all ages for forage species, and >0.2 for other species
  MSFD@M2.bar.ages['last.age',] <- c(2,8,2,-1,3,4,4,3,3,-1,-1)     # all ages for forage species, and >0.2 for other species

  MSFD@do.community.mean.weight <-1
  MSFD@community.mean.weight.sp[]<-1  #include all species

  MSFD@do.community.mean.weight.C <-1
  MSFD@community.mean.weight.C.sp[]<-1  #include all species

  MSFD@do.mean.weight.C <-0
  MSFD@mean.weight.C.sp[]<-1    #include all species

  MSFD@do.community.F<-1
  MSFD@community.F.sp[]<-1   #include all species
  MSFD@do.community.M<-1
  MSFD@community.M.sp[]<-1   #include all species

  MSFD@do.life.expectancy <-1
  MSFD@life.expectancy.first.age[]<-0

  MSFD@do.community.life.expectancy<-1
  MSFD@community.life.expectancy.options["first.age",]<-0
  MSFD@community.life.expectancy.options["weighting",]<-1

  MSFD@do.LFI<-1
  # 1 Fulmar
  # 2 Guillemot
  # 3 Her. Gull
  # 4 Kittiwake
  # 5 GBB. Gull
  # 6 Gannet
  # 7 Puffin
  # 8 Razorbill
  # 9 R. radiata
  # 10 G. gurnards
  # 11 W. mackerel
  # 12 N. mackerel
  # 13 W.horse mac
  # 14 N.horse mac
  # 15 Grey seal
  # 16 H. porpoise
  # 17 Hake
  # 18 Cod  (17)
  # 19 Whiting (18)
  # 20 Haddock (19)
  # 21 Saithe  (20)
  # 22 Herring (21)
  # 23 Northern Sandeel
  # 24 Southern Sandeel
  # 25 Nor. pout (23)
  # 26 Sprat (24)
  # 27 Plaice (25)
  # 28 Sole  (26)

  MSFD@LFI.sp[ ,c(1:17,19,22:26)]<- 0  # exclude
  MSFD@LFI.age[]<-c(rep(99,17),2,99,5,2,99,99,99,99,99,10,8)  # first age considered as large fish (greather than 40 cm)
}
 write.FLOP.MSFD.control(MSFD,file="op_msfd.dat")
}

if (change.Other.pred.N) {
    othN<-scan(file=file.path(data.path,'op_other_n.in'),comment.char = "#",quiet = T )
    dim(othN)<-c(SMS@max.age.all+1,n.other.pred,SMS@last.season)
    dimnames(othN)=list( paste('a_',(0:SMS@max.age.all),sep=''),
                     sp.names[1:n.other.pred],
                     paste('q_',(1:SMS@last.season),sep=''))
}

######### end user options #########

if (do.simulation) {

   if (file.exists(scenario.dir) & ask.me) {
       cat("Are you sure you want to make new simultaion for scenario\n ",scenario,"\n The directory exist and will be overwritten!\n Do you want to continue? (Y/N):")
       a<-readLines(n=1)
       if(a=='N' || a=='n') stop("Script stopped'")
   }

  if (file.exists(scenario.dir)) unlink(scenario.dir,recursive = T)
  dir.create(scenario.dir,showWarnings = FALSE)

  cat(first.no.iter.stoch,'\n', file=file.path(scenario.dir,"op_seed.in"))

  n.runs<-dim(targetFs)[[1]]
  cat(n.runs,'\n', file=file.path(scenario.dir,"op_multargetf.in"))
  write.table(targetFs,row.names=F,col.names=F,file=file.path(scenario.dir,"op_multargetf.in"),append=T)

  OP.files<-c(op.command,"area_names.in","species_names.in","op.dat","op_trigger.dat","op_config.dat","op_msfd.dat","just_one.in",
      "op_consum.in","op_f.in","op_m1.in","op_m.in","op_n.in","op_propmat.in","op_prop_landed.in","op_size.in","op_wcatch.in","op_wsea.in",
      "op_growth_type1.in","op_consum_ab.in","op_other_n.in","op_exploitation.in","op_reference_points.in","covariance_rec.in","op_price.in",
      "op_ssb_rec_residuals.in","op_length_weight_relations.in",'op_eqsim.in','op_eqsim_stoch.in','op_n_proportion_m2.in')

  if (SMS@no.areas>1)  OP.files<-c(OP.files,"op_Stock_distribution.in")

  for (from.file in OP.files) {
    to.file<-file.path(scenario.dir,from.file)
    file.copy(from.file, to.file, overwrite = TRUE)
  }

  sp.name<-SMS.control@species.names

  setwd(scenario.dir)

  if (adjust.ini.N) {
   ini.N<-matrix( scan(file="op_n.in",comment.char="#",quiet = T),nrow=n.vpa,byrow=T)
   #ini.N[1,]<-ini.N[1,]*2  # cod
   write.matrix(ini.N,file="op_n.in")
  }

  tot.run<-dim(targetFs)[[1]]
  fsp<-dim(targetFs)[[2]]  # number of species with variable F target

  if (ask.me) {
    cat("You have asked for",tot.run," runs with",no.iter,"iterations.\nDo you want to continue? (Y/N):")
    a<-readLines(n=1)
    if(a=='N') stop("Script stopped'")
    cat('OK\n')
  }
  MAMsp<-c("Grey seal","H. porpoise")
  MACsp<-c("W. mackerel","N. mackerel")
  BIRsp<-c("Fulmar","Guillemot","Her. Gull","Kittiwake","GBB. Gull","Gannet","Puffin","Razorbill")

  #run OP command
  comm.sms<-paste( file.path(scenario.dir,op.command),"-maxfn 0 -nohess ",sep=" ")

  if (just.batch.file) {
    if (OS=='windows') bat.file<-"run_OP.bat"  else if (OS=='unix') bat.file<-"run_OP.sh"
    if (OS=='windows') {
       cat("cd ",scenario.dir,"\n",comm.sms,' >ud.dat\n',file=file.path(scenario.dir,bat.file))
        #stop(paste("go to directory",scenario.dir,"and run script ",bat.file,"\n"))
       system(command=file.path(scenario.dir,bat.file), wait = F)
    }
    if (OS=='unix' & HPC ) {
      #run OP command
      comm.sms<-paste( op.command,"-maxfn 0 -nohess ",sep=" ")

      cat(paste(
      "#!/bin/sh",
      "# embedded options to qsub - start with #PBS",
      "# -- Name of the job ---",
      "#PBS -N SMS",
      "# –- specify queue --",
      "#PBS -q hpc",
      "# -- estimated wall clock time (execution time): hh:mm:ss --",
      paste("#PBS -l walltime=",formatC(round((n.runs/8000)+1), format="f",digits=0,w=2,flag='0'),":00:00",sep=''),
      "# –- number of processors/cores/nodes --",
      "#PBS -l nodes=1:ppn=1",
      "# –- user email address --",
      "# - PBS -M mv@aqua.dtu.dk",
      "# –- mail notification –-",
      "# - PBS -m abe",
      paste("cd ",scenario.dir,sep=''),
      paste(comm.sms," > ud.dat","\n"),
      sep='\n'),file=file.path(scenario.dir,bat.file))
    }

  } else  {
    if (OS=='windows') shell(comm.sms, invisible = TRUE)
    cat("\ncommand: ",comm.sms,'\n')
    if (OS=='unix') system(comm.sms)
  }
}   # end do.simulations

setwd(data.path)

if (!just.batch.file) {
  if (my.area=='North Sea' & KeyRunYear==2000)  spNames<-c('COD', 'WHG', 'HAD', 'POK', 'HER', 'SAN', 'NOR', 'SPR', 'PLE', 'SOL')
  if (my.area=='North Sea' & KeyRunYear==2014)  spNames<-c('COD', 'WHG', 'HAD', 'POK', 'HER', 'NSA','SSA', 'NOR', 'SPR', 'PLE', 'SOL')
  if (my.area=='North Sea' & KeyRunYear==2017)  spNames<-c('COD', 'WHG', 'HAD', 'POK', 'MAC', 'HER', 'NSA','SSA', 'NOR', 'SPR', 'PLE', 'SOL')

    if (my.area=='Baltic Sea') spNames<-c('COD', 'HER', 'SPR')

  n.run<-dim(targetFs)[[1]]

  if (n.run >1) {
    if (read.condense) {
      cat('reading condensed data from directory:  ', scenario.dir,'\n')
      setwd(scenario.dir)
      condensed<-read.table('op_average_val.out',header=F)
      allnames<-c(c('value','yield', 'CWsum', 'Fcomb','Fbar', 'SSB', 'TSB', 'recruit','belowBlim','belowBpa', 'Species.n', 'run','iteration'),spNames)
      dimnames(condensed)[[2]]<-allnames
      save(condensed, file =file.path(scenario.dir, "condensed.RData"))
      setwd(data.path)
    } else load(file =file.path(scenario.dir, "condensed.RData"),verbose=T)

   if (read.condense) {     # f mult combinations
      setwd(scenario.dir)
      nr<-scan( "op_multargetf.in", nmax = 1,quiet = T)
      Fcomb<-data.frame(matrix(scan( "op_multargetf.in",skip=1),nrow=nr,ncol=length(spNames),byrow=T))
      dimnames(Fcomb)[[2]]<-spNames
      Fcomb$run=first.run.no:(nr+first.run.no-1)
      save(Fcomb, file =file.path(scenario.dir, "Fcomb.RData"))
      setwd(data.path)
    } else load(file =file.path(scenario.dir, "Fcomb.RData"))

   if (read.indicators ) {
      setwd(scenario.dir)
      indi<-read.table( "op_indicator_system_avg.out",header=T)

      load(file =file.path(scenario.dir, "Fcomb.RData"),verbose=T)
       indi<-merge(indi,Fcomb)

      if  (my.area=='North Sea') {
        if (KeyRunYear==2014) indi$unique.id<-paste(indi$run,indi$iter,round(indi$COD,3),round(indi$WHG,3),round(indi$HAD,3),round(indi$POK,3),round(indi$HER,3),round(indi$NSA,3),round(indi$SSA,3),round(indi$NOR,3),round(indi$SPR,3),round(indi$PLE,3),round(indi$SOL,3),sep='')
        if (KeyRunYear==2017) indi$unique.id<-paste(indi$run,indi$iter,round(indi$COD,3),round(indi$WHG,3),round(indi$HAD,3),round(indi$POK,3),round(indi$MAC,3),round(indi$HER,3),round(indi$NSA,3),round(indi$SSA,3),round(indi$NOR,3),round(indi$SPR,3),round(indi$PLE,3),round(indi$SOL,3),sep='')

        } else if  (my.area=='Baltic Sea') {
        indi$unique.id<-paste(indi$run,indi$iter,round(indi$COD,3),round(indi$HER,3),round(indi$SPR,3),sep='')
      }

      # get SSB and yield from the condensed data set
      if  (my.area=='North Sea') {
        if (KeyRunYear==2014) b<-aggregate(cbind(value,yield,CWsum,SSB,TSB)~  run+iteration+COD+WHG+HAD+POK+HER+NSA+SSA+NOR+SPR+PLE+SOL,data=condensed,sum)
        if (KeyRunYear==2017) b<-aggregate(cbind(value,yield,CWsum,SSB,TSB)~  run+iteration+COD+WHG+HAD+POK+MAC+HER+NSA+SSA+NOR+SPR+PLE+SOL,data=condensed,sum)
        if (KeyRunYear==2014) b$unique.id<-paste(b$run,b$iteration,round(b$COD,3),round(b$WHG,3),round(b$HAD,3),round(b$POK,3),round(b$HER,3),round(b$NSA,3),round(b$SSA,3),round(b$NOR,3),round(b$SPR,3),round(b$PLE,3),round(b$SOL,3),sep='')
        if (KeyRunYear==2017) b$unique.id<-paste(b$run,b$iteration,round(b$COD,3),round(b$WHG,3),round(b$HAD,3),round(b$POK,3),round(b$MAC,3),round(b$HER,3),round(b$NSA,3),round(b$SSA,3),round(b$NOR,3),round(b$SPR,3),round(b$PLE,3),round(b$SOL,3),sep='')
        b<-subset(b,select=c(unique.id,value,yield,CWsum,SSB,TSB))
        indi<-merge(indi,b,by="unique.id")
        indi$unique.id<-NULL
      }  else if  (my.area=='Baltic Sea') {
        b<-aggregate(cbind(value,yield,CWsum,SSB,TSB)~  run+iteration+COD+HER+SPR,data=condensed,sum)
        b$unique.id<-paste(b$run,b$iteration,round(b$COD,3),round(b$HER,3),round(b$SPR,3),sep='')
        b<-subset(b,select=c(unique.id,value,yield,CWsum,SSB,TSB))
        indi<-merge(indi,b,by="unique.id")
        indi$unique.id<-NULL
      }
      save(indi, file =file.path(scenario.dir, "indicators.RData"))
      setwd(data.path)
    } else load(file =file.path(scenario.dir, "indicators.RData"),verbose=T)

    if (combine.scenario.run) {
      all.condensed<-NULL
      for (sc in scenario.dirs) {
        load(file =file.path(data.path,sc, "condensed.RData"))  #load condensed data set
        cat(sc,dim(condensed),"\n")
        all.condensed<-rbind(all.condensed,condensed)
        rm(condensed)
      }
      condensed<-all.condensed
      rm(all.condensed)
      save(condensed, file =file.path(data.path,scenario.dirs.out, "condensed.RData"))

      # F combinations
      all.Fcomb<-NULL
      for (sc in scenario.dirs) {
        load(file =file.path(data.path,sc, "Fcomb.RData"))  #load condensed data set
        cat(sc,dim(Fcomb),"\n")
        all.Fcomb<-rbind(all.Fcomb,Fcomb)
        rm(Fcomb)
      }
      Fcomb<-all.Fcomb
      rm(all.Fcomb)
      save(Fcomb, file =file.path(data.path,scenario.dirs.out, "Fcomb.RData"))

      # indicators
      all.indi<-NULL
      for (sc in scenario.dirs) {
        load(file =file.path(data.path,sc, "indicators.RData"))  #load indi data set
        cat(sc,dim(indi),"\n")
        all.indi<-rbind(all.indi,indi)
        rm(indi)
      }
      indi<-all.indi
      rm(all.indi)
      save(indi, file =file.path(data.path,scenario.dirs.out, "indicators.RData"))
    }

    if (read.condense | combine.scenario.run) {
      source(file.path(prog.path.func,"hcr_op_condense_function.r"))
      a<-transform.condensed(a=condensed,my.area=my.area)

      save(a, file =file.path(scenario.dir, "a.RData"));
    } else load(file =file.path(scenario.dir, "a.RData"))

  }  # end combine.scenario.run

  if ((do.plot.condense | ReduceTable ) & n.run >1) {

    if (my.area=='North Sea') {
        if (subset.out) { # make a subset of data set used to make plots
         if (KeyRunYear==2014) {
           #COD WHG HAD POK HER NSA SSA NOR SPR PLE SOL
           bb<-subset.species
           a<-droplevels(subset(a, COD>=bb[1,1] &  COD<=bb[2,1] &
                                  WHG>=bb[1,2] &  WHG<=bb[2,2] &
                                  HAD>=bb[1,3] &  HAD<=bb[2,3] &
                                  POK>=bb[1,4] &  POK<=bb[2,4] &
                                  HER>=bb[1,5] &  HER<=bb[2,5] &
                                  NSA>=bb[1,6] &  NSA<=bb[2,6] &
                                  SSA>=bb[1,7] &  SSA<=bb[2,7] &
                                  NOR>=bb[1,8] &  NOR<=bb[2,8] &
                                  SPR>=bb[1,9] &  SPR<=bb[2,9] &
                                  PLE>=bb[1,10] &  PLE<=bb[2,10] &
                                  SOL>=bb[1,11] & SOL<=bb[2,11] ))
         }
          if (KeyRunYear==2017) {
            #COD WHG HAD POK MAC HER NSA SSA NOR SPR PLE SOL
            bb<-subset.species
            a<-droplevels(subset(a, COD>=bb[1,1] &  COD<=bb[2,1] &
                                   WHG>=bb[1,2] &  WHG<=bb[2,2] &
                                   HAD>=bb[1,3] &  HAD<=bb[2,3] &
                                   POK>=bb[1,4] &  POK<=bb[2,4] &
                                   MAC>=bb[1,5] &  MAC<=bb[2,5] &
                                   HER>=bb[1,6] &  HER<=bb[2,6] &
                                   NSA>=bb[1,7] &  NSA<=bb[2,7] &
                                   SSA>=bb[1,8] &  SSA<=bb[2,8] &
                                   NOR>=bb[1,9] &  NOR<=bb[2,9] &
                                   SPR>=bb[1,10] &  SPR<=bb[2,10] &
                                   PLE>=bb[1,11] &  PLE<=bb[2,11] &
                                   SOL>=bb[1,12] & SOL<=bb[2,12] ))
          }

        }

        if (singleSp) {
            png(filename =file.path(used.scenario.dir,paste('single','.png',sep='')), width = 1600, height = 1200,units = "px", pointsize = 18, bg="white")
          par(mfcol=c(6,9))
          par(mar=c(2,4,3,2)) # c(bottom, left, top, right)
          a<-subset(a,Species.n %in% (18:26))

          ref<-Read.reference.points.OP(dir=data.path)
          boxs <- defmacro(a, varsp, spname,spno,
                           expr={
                             boxplot(yield/1000~varsp ,data=a,show.names = T,ylab='Yield (1000t)',subset=Species.n==spno,main=spname)
                             boxplot(SSB/1000~varsp ,data=a,show.names = T,ylab='SSB (1000t)',subset=Species.n==spno)
                             abline(h=ref[spno-17,'Bpa']/1000,col='blue',lwd=2)
                             abline(h=ref[spno-17,'Blim']/1000,col='red',lwd=2)

                             boxplot(Fbar~varsp ,data=a,show.names = T,ylab='Realized F',xlab='F',subset=Species.n==spno)
                             boxplot(belowBlim~varsp ,data=a,show.names = T,ylab='prob(SSB<Blim) %',xlab='F',subset=Species.n==spno)
                             boxplot(belowBpa~varsp ,data=a,show.names = T,ylab='prob(SSB<Bpa) %',xlab='F',subset=Species.n==spno)
                             boxplot(recruit/1E6~varsp ,data=a,show.names = T,ylab='recruits (10^9)',xlab='F',subset=Species.n==spno)
                           })

          if (KeyRunYear==2014) {
            boxs(a, COD, 'Cod',18)
            boxs(a, WHG, 'Whiting',19)
            boxs(a, HAD, 'Haddock',20)
            boxs(a, POK, 'Saithe',21)
            boxs(a, HER, 'Herring',22)
            boxs(a, NSA, 'Northern sandeel',23)
            boxs(a, SSA, 'Southern sandeel',24)
            boxs(a, NOR, 'Norway pout',25)
            boxs(a, SPR, 'Sprat',26)
            cleanup()
          } else  if (KeyRunYear==2014) {
            boxs(a, COD, 'Cod',16)
            boxs(a, WHG, 'Whiting',17)
            boxs(a, HAD, 'Haddock',18)
            boxs(a, POK, 'Saithe',19)
            boxs(a, MAC, 'Mackerel',20)
            boxs(a, HER, 'Herring',21)
            boxs(a, NSA, 'Northern sandeel',22)
            boxs(a, SSA, 'Southern sandeel',23)
            boxs(a, NOR, 'Norway pout',24)
            boxs(a, SPR, 'Sprat',25)
            cleanup()
          }
          trellis.device(device = png,filename =file.path(used.scenario.dir,paste('single_rec','.png',sep='')),
                         width = 1600, height = 1200,units = "px", pointsize = 25)

          print(xyplot(recruit/1000000~SSB/1000 |Species,data=a,
                 scales=list(relation='free'),
                 ylab='Recruits (billions)',xlab="SSB (1000 t)",
                 panel = function(x, y) {
                   panel.xyplot(x, y)
                   panel.loess(x, y, span=0.01,lwd=5,col='red')
                 }))

          cleanup()
        }

        do.plot.condense<-!singleSp  # do not make the ususl plots if single species

        out.file<-'all'
        out.types<-c('Yield','SSB','Recruit','Fbar','belowBlim', 'belowBpa','riskBlim')

        source(file.path(prog.path.func,"fmsy_matrix_functions_plots.r"))
        if (do.plot.condense) {
          spNames<-sp.names[(nsp-nsp.VPA+1):(nsp-2)]  # all vpa species except PLE and Sole
          spNames<-gsub('N. sandeel','NSa',spNames)
          spNames<-gsub('S. sandeel','SSa',spNames)
          spNames<-gsub('Nor. pout','NPo',spNames)
          if (subset.out) add.fn<-'_Reduc' else add.fn<-''
          plot.matrix(tit='Yield',type=out.types[1],spNames=spNames,my.dev='png',out.file=out.file,add.to.file.name=add.fn, scenario.dir=scenario.dir,a=a)
          plot.matrix(tit='SSB',  type=out.types[2],spNames=spNames,my.dev='png',out.file=out.file,add.to.file.name=add.fn,scenario.dir=scenario.dir,a=a)
          plot.matrix(tit='SSB',  type=out.types[2],spNames=spNames,my.dev='png',out.file=out.file,add.to.file.name=add.fn,scenario.dir=scenario.dir,a=a,plot.ref=T)
          plot.matrix(tit='Recruits', type=out.types[3],spNames=spNames,my.dev='png',out.file=out.file,add.to.file.name=add.fn,scenario.dir=scenario.dir,a=a)
          #plot.matrix(tit='Average F', type=out.types[4],spNames=spNames,my.dev='png',out.file=out.file,add.to.file.name=add.fn,scenario.dir=scenario.dir,a=a)
          #plot.matrix(tit='Probability (%) of SSB below Blim', type=out.types[5],spNames=spNames,my.dev='png',out.file=out.file,add.to.file.name=add.fn,scenario.dir=scenario.dir,a=a)
          plot.matrix(tit='Probability (%) of SSB below Bpa', type=out.types[6],spNames=spNames,my.dev='png',out.file=out.file,add.to.file.name=add.fn,scenario.dir=scenario.dir,a=a)
          #plot.matrix(tit='Proportion (%) of scenarios with prob(SSB<Blim) > 5%', type=out.types[7],spNames=spNames,my.dev='png',out.file=out.file,add.to.file.name=add.fn,scenario.dir=scenario.dir,a=a)

          cat("\n\nRelative MSY:\n")
        }
        table.MSY(a,out.file=out.file,scenario.dir=scenario.dir)
        cat('\ntable 01 done\n')
        cat('justAboveBlim:');
        cat(justAboveBlim,'\n')
        if (justAboveBlim & do.plot.condense) {
           cat('\nPlots, justAboveBlim\n')
           cat("\njustAboveBlim\n")

           dropKombBlim<-subset(a,probBelowBlim>riskLevels,select=c(run,iteration))

           if (dim(dropKombBlim)[[1]]>0) {
             dropKombBlim$drop<-T
             dropKombBlim<-unique(dropKombBlim)
             MV.dropKombBlim<<-dropKombBlim

             a<-merge(x=a,y=dropKombBlim,all.x=T)
             a[is.na(a$drop),'drop']<-F
             a<-droplevels(subset(a,drop==F,select=c(-drop)))
             if (dim(a)[[1]]>1)  {
               out.file='aboveBlim'
               out.types<-c('Yield','SSB','Recruit','Fbar','belowBlim', 'belowBpa')
              source(file.path(prog.path.func,"FMSY_matrix_functions.r"))
              plot.matrix(tit='Yield',type=out.types[1],spNames=sp.names[17:24],my.dev='png',out.file=out.file,scenario.dir=scenario.dir,a=a)
              plot.matrix(tit='SSB',  type=out.types[2],spNames=sp.names[17:24],my.dev='png',out.file=out.file,scenario.dir=scenario.dir,a=a)
              plot.matrix(tit='Recruits', type=out.types[3],spNames=sp.names[17:24],my.dev='png',out.file=out.file,scenario.dir=scenario.dir,a=a)
              plot.matrix(tit='Average F', type=out.types[4],spNames=sp.names[17:24],my.dev='png',out.file=out.file,scenario.dir=scenario.dir,a=a)
              plot.matrix(tit='Probability (%) of SSB below Blim', type=out.types[5],spNames=sp.names[17:24],my.dev='png',out.file=out.file,scenario.dir=scenario.dir,a=a)
              cat("\n\nRelative MSY:\n")
              table.MSY(a,out.file=out.file,scenario.dir=scenario.dir)
             } else cat("\n\nAll combinations below Blim, no plotting done\n\n")
           }
         }

        if (justAboveBpa & do.plot.condense) {
           cat('\nPlots, justAboveBlpa\n')
           a$probBelowBpa<-a$belowBpa/years.in.average
           dropKomb<-subset(a,probBelowBpa>0.05,select=c(run,iteration))

           if (dim(dropKomb)[[1]]>0) {
             dropKomb$drop<-T
             dropKomb<-unique(dropKomb)

             a<-merge(x=a,y=dropKomb,all.x=T)
             a[is.na(a$drop),'drop']<-F
             a<-droplevels(subset(a,drop==F,select=c(-drop)))
            if (dim(a)[[1]]>1)  {
               out.file='aboveBpa'
               out.types<-c('Yield','SSB','Recruit','Fbar','belowBlim', 'belowBpa')

              source(file.path(prog.path.func,"fmsy_matrix_functions.r"))
              plot.matrix(tit='Yield',type=out.types[1],spNames=sp.names[17:24],my.dev='png',out.file=out.file,scenario.dir=scenario.dir,a=a)
              plot.matrix(tit='SSB',  type=out.types[2],spNames=sp.names[17:24],my.dev='png',out.file=out.file,scenario.dir=scenario.dir,a=a)
              plot.matrix(tit='Recruits', type=out.types[3],spNames=sp.names[17:24],my.dev='png',out.file=out.file,scenario.dir=scenario.dir,a=a)
              plot.matrix(tit='Average F', type=out.types[4],spNames=sp.names[17:24],my.dev='png',out.file=out.file,scenario.dir=scenario.dir,a=a)
              plot.matrix(tit='Probability (%) of SSB below Blim', type=out.types[5],spNames=sp.names[17:24],my.dev='png',out.file=out.file,scenario.dir=scenario.dir,a=a)
              cat("\n\nRelative MSY:\n")
              table.MSY(a,out.file=out.file,scenario.dir=scenario.dir)
             } else cat("\n\nAll combinations below Bpa, no plotting done\n\n")
           }
         }

    }  # end North Sea

    if (my.area=='Baltic Sea') {
       source(file.path(prog.path.func,"fmsy-matrix-baltic.r"))
    } # end Baltic Sea

    if (ReduceTable & ReduceOption=="default") {
           source(file.path(prog.path.func,"fmsy_matrix_functions_tables.r"))
           cat('\nStart to reduce Table\n')

          load(file =file.path(scenario.dir, "a.RData"))  # to get a fresh, non reduced version
           aa<-a
           goOn<<-T;
           ii<-0
           while (goOn) {
             a2<-reduceCombMSYfinal(aa,out.file='redu_MSY.out',app=(ii!=0),scenario.dir=scenario.dir,keepPro=keepPro);
             if (goOn) aa<-a2
             ii<-ii+1
             if (goOn & ReduceTableDetails) table.MSY(aa,out.file='redu_MSY_detail',scenario.dir=scenario.dir,app=(ii!=1))
           }
           cat("\n",dim(aa),"\n")
           table.MSY(aa,out.file="redu_MSY_final",scenario.dir=scenario.dir)
           rm(a2)
           #rm(aa)

           # risk to Blim
           # aa<-a          Do not start with the full datat set
           goOn<<-T;
           ii<-0
           while (goOn) {
             a2<-reduceCombRiskfinal(aa,out.file='redu_MSY_and_Blim_continue.out',app=(ii!=0),scenario.dir=scenario.dir,riskLevels=riskLevels);
             if (goOn) aa<-a2
             ii<-ii+1
             if (goOn & ReduceTableDetails) table.MSY(aa,out.file='redu_MSY_and_Blim_continue_details',scenario.dir=scenario.dir,app=(ii!=1))
           }
           table.MSY(aa,out.file='redu_MSY_and_Blim_continue_final',scenario.dir=scenario.dir)
           rm(a2)
           rm(aa)

           # risk to Blim
           aa<-a          # start with the full datat set
           goOn<<-T;
           ii<-0
           while (goOn) {
             a2<-reduceCombRiskfinal(aa,out.file='redu_Blim_all.out',app=(ii!=0),scenario.dir=scenario.dir,riskLevels=riskLevels);
             if (goOn) aa<-a2
             ii<-ii+1
             if (goOn & ReduceTableDetails) table.MSY(aa,out.file='redu_Blim_all_details',scenario.dir=scenario.dir,app=(ii!=1))
           }
           table.MSY(aa,out.file='redu_Blim_all_final',scenario.dir=scenario.dir)
           rm(a2)
           rm(aa)

           # risk to Blim , using the
           aa<-a          # start with the full datat set
           goOn<<-T;
           ii<-0
           while (goOn) {
             a2<-reduceCombRiskfinal(aa,out.file='redu_Blim_v2_all.out',app=(ii!=0),scenario.dir=scenario.dir,riskLevels=riskLevels,type=2);
             if (goOn) aa<-a2
             ii<-ii+1
             if (goOn & ReduceTableDetails) table.MSY(aa,out.file='redu_Blim_v2_all_details',scenario.dir=scenario.dir,app=(ii!=1))
           }
           table.MSY(aa,out.file='redu_Blim_v2_all_final',scenario.dir=scenario.dir)
           rm(a2)
           rm(aa)
        }

   }

   if (ReduceTable & ReduceOption=="option12") {
    source(file.path(prog.path.func,"fmsy_matrix_functions_tables.r"))
    cat('\nStart to reduce Table Option12 \n')

    load(file =file.path(scenario.dir, "a.RData"))  # to get a fresh, non reduced version
    aa<-a # start with the full datat set

    # risk to Blim, preys

    goOn<<-T;
    ii<-0
    preys<-seq(1:nsp)[SMS.control@species.info[,'prey']==1 & SMS.control@species.info[,'predator']==0]-(nsp-nsp.VPA)
    predators<-seq(1:nsp)[SMS.control@species.info[,'predator']==1 ] -(nsp-nsp.VPA)
    while (goOn) {
      a2<-reduceCombRiskfinal(aa,out.file='option1_A1.out',app=(ii!=0),scenario.dir=scenario.dir,riskLevels=riskLevels,excludeSp=predators);
      if (goOn) aa<-a2
      ii<-ii+1
      if (goOn & ReduceTableDetails) table.MSY(aa,out.file='option1_details_1',scenario.dir=scenario.dir,app=(ii!=1))
    }
    table.MSY(aa,out.file='option1_B1',scenario.dir=scenario.dir)

    goOn<<-T;
    ii<-0
    while (goOn) {
      a2<-reduceCombRiskfinal(aa,out.file='option1_A2.out',app=(ii!=0),scenario.dir=scenario.dir,riskLevels=riskLevels,excludeSp=0);
      if (goOn) aa<-a2
      ii<-ii+1
      if (goOn & ReduceTableDetails) table.MSY(aa,out.file='option1_details2',scenario.dir=scenario.dir,app=(ii!=1))
    }
    table.MSY(aa,out.file='option1_B2',scenario.dir=scenario.dir)

    if (saveOutput) {
      load(file =file.path(scenario.dir, "indicators.RData"),verbose=T)
      key1<-unique(data.frame(run=aa$run))
      indiNew<-merge(key1,indi,by='run')
      save(aa, file =file.path(scenario.dir, "option1.RData"))
      save(indiNew, file =file.path(scenario.dir, "indi1.RData"))
     }

    a3<-aa # save the set for option 3

    # option 2, reduce to 95% MSY
    goOn<<-T;
    ii<-0
    while (goOn) {
      a2<-reduceCombMSYfinal(aa,out.file='option2_A1.out',app=(ii!=0),scenario.dir=scenario.dir,keepPro=keepPro);
      if (goOn) aa<-a2
      ii<-ii+1
      if (goOn & ReduceTableDetails) table.MSY(aa,out.file='option2_detail',scenario.dir=scenario.dir,app=(ii!=1))
    }
    cat("\n",dim(aa),"\n")
    table.MSY(aa,out.file="option2_B1",scenario.dir=scenario.dir)

    # Option2, and remove SSB below Blim
    goOn<<-T;
    ii<-0
    while (goOn) {
      a2<-reduceCombRiskfinal(aa,out.file='option2_A2.out',app=(ii!=0),scenario.dir=scenario.dir,riskLevels=riskLevels,excludeSp=0);
      if (goOn) aa<-a2
      ii<-ii+1
      if (goOn & ReduceTableDetails) table.MSY(aa,out.file='option2_details2',scenario.dir=scenario.dir,app=(ii!=1))
    }
    table.MSY(aa,out.file='option2_B2',scenario.dir=scenario.dir)
    if (saveOutput) {
      key1<-unique(data.frame(run=aa$run))
      indiNew<-merge(key1,indi,by='run')
      save(aa, file =file.path(scenario.dir, "option2.RData"))
      save(indiNew, file =file.path(scenario.dir, "indi2.RData"))
    }

    # option 3, reduce to 50% MSY
    aa<-a3; rm(a3)  # use data from option 1
    goOn<<-T;
    ii<-0
    while (goOn) {
      a2<-reduceCombMSYfinal(aa,out.file='option3_A1.out',app=(ii!=0),scenario.dir=scenario.dir,keepPro=0.50);
      if (goOn) aa<-a2
      ii<-ii+1
      if (goOn & ReduceTableDetails) table.MSY(aa,out.file='option3_details1',scenario.dir=scenario.dir,app=(ii!=1))
    }
    cat("\n",dim(aa),"\n")
    table.MSY(aa,out.file="option3_B1",scenario.dir=scenario.dir)

    # Option3, and remove SSB below Bpa (begn with preys)
    goOn<<-T;
    ii<-0
    while (goOn) {
      a2<-reduceCombRiskfinal(aa,out.file='option3_A2.out',app=(ii!=0),scenario.dir=scenario.dir,riskLevels=riskLevels,excludeSp=predators,type=3);
      if (goOn) aa<-a2
      ii<-ii+1
      if (goOn & ReduceTableDetails) table.MSY(aa,out.file='option3_details2',scenario.dir=scenario.dir,app=(ii!=1))
    }
    table.MSY(aa,out.file='option3_B2',scenario.dir=scenario.dir)

    # Options3, and remove SSB below Bpa (for all species now)
    goOn<<-T;
    ii<-0
    while (goOn) {
      a2<-reduceCombRiskfinal(aa,out.file='option3_A3.out',app=(ii!=0),scenario.dir=scenario.dir,riskLevels=riskLevels,excludeSp=0,type=3);
      if (goOn) aa<-a2
      ii<-ii+1
      if (goOn & ReduceTableDetails) table.MSY(aa,out.file='option3_details3',scenario.dir=scenario.dir,app=(ii!=1))
    }
    table.MSY(aa,out.file='option3_B3',scenario.dir=scenario.dir)

    # option 3, and reduce to 95% MSY
    goOn<<-T;
    ii<-0
    while (goOn) {
      a2<-reduceCombMSYfinal(aa,out.file='option3_A4.out',app=(ii!=0),scenario.dir=scenario.dir,keepPro=0.95);
      if (goOn) aa<-a2
      ii<-ii+1
      if (goOn & ReduceTableDetails) table.MSY(aa,out.file='option3_details4',scenario.dir=scenario.dir,app=(ii!=1))
    }
    cat("\n",dim(aa),"\n")
    table.MSY(aa,out.file="option3_B4",scenario.dir=scenario.dir)
    if (saveOutput) {
      key1<-unique(data.frame(run=aa$run))
      indiNew<-merge(key1,indi,by='run')
      save(aa, file =file.path(scenario.dir, "option3.RData"))
      save(indiNew, file =file.path(scenario.dir, "indi3.RData"))
    }

    # option 4, and reduce to 99.9% MSY
    goOn<<-T;
    ii<-0
    while (goOn) {
      a2<-reduceCombMSYfinal(aa,out.file='option4_A1.out',app=(ii!=0),scenario.dir=scenario.dir,keepPro=0.99999);
      if (goOn) aa<-a2
      ii<-ii+1
      if (goOn & ReduceTableDetails) table.MSY(aa,out.file='option4_details1',scenario.dir=scenario.dir,app=(ii!=1))
    }
    cat("\n",dim(aa),"\n")
    table.MSY(aa,out.file="option4_B1",scenario.dir=scenario.dir)
    if (saveOutput) {
      key1<-unique(data.frame(run=aa$run))
      indiNew<-merge(key1,indi,by='run')
      save(aa, file =file.path(scenario.dir, "option4.RData"))
      save(indiNew, file =file.path(scenario.dir, "indi4.RData"))
    }

    rm(a2)
    rm(aa)

} # end option12

  if (do.plot.indicators & n.run>1) {
      if (my.area=='North Sea') {

        if (subset.out) { # make a subset of data set used to make plots
          if (KeyRunYear==2014) {
            #COD WHG HAD POK HER NSA SSA NOR SPR PLE SOL
            bb<-subset.species
            indi<-droplevels(subset(indi, COD>=bb[1,1] &  COD<=bb[2,1] &
                                   WHG>=bb[1,2] &  WHG<=bb[2,2] &
                                   HAD>=bb[1,3] &  HAD<=bb[2,3] &
                                   POK>=bb[1,4] &  POK<=bb[2,4] &
                                   HER>=bb[1,5] &  HER<=bb[2,5] &
                                   NSA>=bb[1,6] &  NSA<=bb[2,6] &
                                   SSA>=bb[1,7] &  SSA<=bb[2,7] &
                                   NOR>=bb[1,8] &  NOR<=bb[2,8] &
                                   SPR>=bb[1,9] &  SPR<=bb[2,9] &
                                   PLE>=bb[1,10] &  PLE<=bb[2,10] &
                                   SOL>=bb[1,11] & SOL<=bb[2,11] ))
          }
          if (KeyRunYear==2017) {
            #COD WHG HAD POK MAC HER NSA SSA NOR SPR PLE SOL
            bb<-subset.species
            indi<-droplevels(subset(indi, COD>=bb[1,1] &  COD<=bb[2,1] &
                                      WHG>=bb[1,2] &  WHG<=bb[2,2] &
                                      HAD>=bb[1,3] &  HAD<=bb[2,3] &
                                      POK>=bb[1,4] &  POK<=bb[2,4] &
                                      MAC>=bb[1,5] &  MAC<=bb[2,5] &
                                      HER>=bb[1,6] &  HER<=bb[2,6] &
                                      NSA>=bb[1,7] &  NSA<=bb[2,7] &
                                      SSA>=bb[1,8] &  SSA<=bb[2,8] &
                                      NOR>=bb[1,9] &  NOR<=bb[2,9] &
                                      SPR>=bb[1,10] &  SPR<=bb[2,10] &
                                      PLE>=bb[1,11] &  PLE<=bb[2,11] &
                                      SOL>=bb[1,12] & SOL<=bb[2,12] ))
          }
        }

         source(file.path(prog.path.func,"plot_op_community_indicators_average_northsea.r"))
          if (KeyRunYear==2014) {
            n.species<-9
            my.sp.names<-sp.names[18:26]
          } else if (KeyRunYear==2017) {
            n.species<-10
            my.sp.names<-sp.names[16:27]
          }
          #a<-droplevels(subset(a,(COD<=0.4 & POK<=0.4) & SPR<0.6))
          out.file='all_'
          if (subset.out) out.file<-paste(out.file,'Reduc_',sep='')
          print(summary(indi))
          plot.matrix(tit='System indicators',spNames=my.sp.names,my.dev='png',out.file=out.file,scenario.dir=scenario.dir,a=indi)

         if (justAboveBlim) {
           cat("\njustAboveBlim Indicators\n")
           if (dim(dropKombBlim)[[1]]>0) {
             dropKombBlim$iter<-dropKombBlim$iteration
             indi<-merge(x=indi,y=dropKombBlim,all.x=T)
             MV.indi1<<-indi
             indi[is.na(indi$drop),'drop']<-F
             indi<-droplevels(subset(indi,drop==F,select=c(-drop)))
             MV.indi2<<-indi
             if (dim(indi)[[1]]>1)  {
               out.file='aboveBlim_'
               plot.matrix(tit='System indicators',spNames=my.sp.names,my.dev='png',out.file=out.file,scenario.dir=scenario.dir,a=indi)
             }  else cat("\n\nAll combinations below Blim, no plotting done\n\n")
           }
         }
      }    # end North Sea

      if (my.area=='Baltic Sea') source(file.path(prog.path.func,"plot_op_community_indicators_average_baltic.r"))
  }
 } # end just batch

  used.scenario.dir<<-scenario.dir
  scenario.dir<<-used.scenario.dir
  scenario.dir.simul<<-used.scenario.dir

  return(scenario.gem)
}  # end function

###################################
# function for fixing POK, PLE and SOL F
POK.PL.SOL<-function(HCR=HCR1,FBlim.adjust=1,stochastic.recruitment=1,recruit.adjust.CV=0,my.last.year=2061, years.in.average=5) {
    # find F-values for POK, PLE and Sole
    if (KeyRunYear==2014) OP.simulate(scenario="POK",HCR=HCR,FBlim.adjust=FBlim.adjust,targetFs=expand.grid(COD=seq(0.45,0.45,0.05),WHG=seq(0.30,0.30,0.05),HAD=seq(0.35,0.35,0.05),POK=seq(0.20,0.45,0.01),HER=seq(0.30,0.30,0.05),NSA=seq(0.25,0.25,0.05),SSA=seq(0.25,0.25,0.05),NOR=seq(0.25,0.25,0.05),SPR=seq(0.30,0.30,0.05),PLE=seq(0.50,0.50,0.05),SOL=seq(0.50,0.50,0.05)),ask.me=ask.me,my.area=my.area,my.last.year=my.last.year, years.in.average= years.in.average,stochastic.recruitment=stochastic.recruitment,no.iter.stoch=no.iter.stoch,recruit.adjust.CV=recruit.adjust.CV, do.plot.indicators=F)
    if (KeyRunYear==2017) OP.simulate(scenario="POK",HCR=HCR,FBlim.adjust=FBlim.adjust,targetFs=expand.grid(COD=seq(0.45,0.45,0.05),WHG=seq(0.30,0.30,0.05),HAD=seq(0.35,0.35,0.05),POK=seq(0.20,0.45,0.01),MAC=seq(0.20,0.20,0.05),HER=seq(0.30,0.30,0.05),NSA=seq(0.25,0.25,0.05),SSA=seq(0.25,0.25,0.05),NOR=seq(0.25,0.25,0.05),SPR=seq(0.30,0.30,0.05),PLE=seq(0.50,0.50,0.05),SOL=seq(0.50,0.50,0.05)),ask.me=ask.me,my.area=my.area,my.last.year=my.last.year, years.in.average= years.in.average,stochastic.recruitment=stochastic.recruitment,no.iter.stoch=no.iter.stoch,recruit.adjust.CV=recruit.adjust.CV, do.plot.indicators=F)

    load(file =file.path(used.scenario.dir, "condensed.RData"))
    if (KeyRunYear==2014)  POK<-subset(condensed,Species.n==21)  else POK<-subset(condensed,Species.n==19)
    POK2<<-POK
    if (KeyRunYear==2014) OP.simulate(scenario="PLE",HCR=HCR,FBlim.adjust=FBlim.adjust, targetFs=expand.grid(COD=seq(0.45,0.45,0.05),WHG=seq(0.30,0.30,0.05),HAD=seq(0.35,0.35,0.05),POK=seq(0.30,0.30,0.05),HER=seq(0.30,0.30,0.05),NSA=seq(0.25,0.25,0.05),SSA=seq(0.25,0.25,0.05),NOR=seq(0.25,0.25,0.05),SPR=seq(0.30,0.30,0.05),PLE=seq(0.10,0.60,0.025),SOL=seq(0.50,0.50,0.05)),ask.me=ask.me,my.area=my.area,my.last.year=my.last.year, years.in.average= years.in.average,stochastic.recruitment=stochastic.recruitment,no.iter.stoch=no.iter.stoch,recruit.adjust.CV=recruit.adjust.CV, do.plot.indicators=F)
    if (KeyRunYear==2017) OP.simulate(scenario="PLE",HCR=HCR,FBlim.adjust=FBlim.adjust, targetFs=expand.grid(COD=seq(0.45,0.45,0.05),WHG=seq(0.30,0.30,0.05),HAD=seq(0.35,0.35,0.05),POK=seq(0.30,0.30,0.05),MAC=seq(0.20,0.20,0.05),HER=seq(0.30,0.30,0.05),NSA=seq(0.25,0.25,0.05),SSA=seq(0.25,0.25,0.05),NOR=seq(0.25,0.25,0.05),SPR=seq(0.30,0.30,0.05),PLE=seq(0.10,0.60,0.025),SOL=seq(0.50,0.50,0.05)),ask.me=ask.me,my.area=my.area,my.last.year=my.last.year, years.in.average= years.in.average,stochastic.recruitment=stochastic.recruitment,no.iter.stoch=no.iter.stoch,recruit.adjust.CV=recruit.adjust.CV, do.plot.indicators=F)

    load(file =file.path(used.scenario.dir, "condensed.RData"))
    if (KeyRunYear==2014) PLE<-subset(condensed,Species.n==27) else PLE<-subset(condensed,Species.n==25)

    if (KeyRunYear==2014) OP.simulate(scenario="SOL",HCR=HCR,FBlim.adjust=FBlim.adjust, targetFs=expand.grid(COD=seq(0.45,0.45,0.05),WHG=seq(0.30,0.30,0.05),HAD=seq(0.35,0.35,0.05),POK=seq(0.30,0.30,0.05),HER=seq(0.30,0.30,0.05),NSA=seq(0.25,0.25,0.05),SSA=seq(0.25,0.25,0.05),NOR=seq(0.25,0.25,0.05),SPR=seq(0.30,0.30,0.05),PLE=seq(0.50,0.50,0.025),SOL=seq(0.10,0.60,0.025)),ask.me=ask.me,my.area=my.area,my.last.year=my.last.year, years.in.average= years.in.average,stochastic.recruitment=stochastic.recruitment,no.iter.stoch=no.iter.stoch,recruit.adjust.CV=recruit.adjust.CV, do.plot.indicators=F)
    if (KeyRunYear==2017) OP.simulate(scenario="SOL",HCR=HCR,FBlim.adjust=FBlim.adjust, targetFs=expand.grid(COD=seq(0.45,0.45,0.05),WHG=seq(0.30,0.30,0.05),HAD=seq(0.35,0.35,0.05),POK=seq(0.30,0.30,0.05),MAC=seq(0.20,0.20,0.05),HER=seq(0.30,0.30,0.05),NSA=seq(0.25,0.25,0.05),SSA=seq(0.25,0.25,0.05),NOR=seq(0.25,0.25,0.05),SPR=seq(0.30,0.30,0.05),PLE=seq(0.50,0.50,0.025),SOL=seq(0.10,0.60,0.025)),ask.me=ask.me,my.area=my.area,my.last.year=my.last.year, years.in.average= years.in.average,stochastic.recruitment=stochastic.recruitment,no.iter.stoch=no.iter.stoch,recruit.adjust.CV=recruit.adjust.CV, do.plot.indicators=F)

    load(file =file.path(used.scenario.dir, "condensed.RData"))
    if (KeyRunYear==2014) SOL<-subset(condensed,Species.n==28)
    if (KeyRunYear==2017) SOL<-subset(condensed,Species.n==27)

    allSp<-rbind(POK,PLE,SOL)

    if (stochastic.recruitment==0  | stochastic.recruitment==2 ) {
      allSp[allSp$belowBlim>0,'belowBlim']<-100
      allSp[allSp$belowBpa>0,'belowBpa']<-100
    }
    png(filename =file.path(used.scenario.dir,paste('POK_PLE_SOL','.png',sep='')), width = 700, height = 1100,units = "px", pointsize = 18, bg="white")
    par(mfcol=c(6,3))
    par(mar=c(2,4,3,2)) # c(bottom, left, top, right)

    if (KeyRunYear==2014) POK.PLE.SOL<-c(21,27,28)
    if (KeyRunYear==2017) POK.PLE.SOL<-c(19,26,27)

    a<-subset(allSp,Species.n %in% POK.PLE.SOL)
    boxs <- defmacro(a, varsp, spname,spno,
      expr={
          boxplot(yield/1000~varsp ,data=a,show.names = T,ylab='Yield (1000t)',subset=Species.n==spno,main=spname)
          boxplot(SSB/1000~varsp ,data=a,show.names = T,ylab='SSB (1000t)',subset=Species.n==spno)
          boxplot(Fbar~varsp ,data=a,show.names = T,ylab='Realized F',xlab='F',subset=Species.n==spno)
          boxplot(belowBlim~varsp ,data=a,show.names = T,ylab='prob(SSB<Blim) %',xlab='F',subset=Species.n==spno)
          boxplot(belowBpa~varsp ,data=a,show.names = T,ylab='prob(SSB<Bpa) %',xlab='F',subset=Species.n==spno)
          boxplot(recruit/1E6~varsp ,data=a,show.names = T,ylab='recruits (10^9)',xlab='F',subset=Species.n==spno)
        })
     boxs(a, POK, 'Saithe',POK.PLE.SOL[1])
     boxs(a, PLE,'Plaice',POK.PLE.SOL[2])
     boxs(a, SOL,'Sole',POK.PLE.SOL[3])

    cleanup()
}


library(dplyr)
library(stringr)
library(readxl)

markerb<-read.csv('../script4paper/differential_marker_b.csv')
marker_mono<-read.csv('../script4paper/differential_marker_mono.csv')
genea<-markerb%>%  group_by(cluster) %>%
    slice_max(n = 5, order_by = avg_log2FC)
geneb<-marker_mono%>%  group_by(cluster) %>%
    slice_max(n = 5, order_by = avg_log2FC)

geneset2<-read_excel('./CELLCHAT_GENE_hd_specific.xlsx')

gene_int<-unique(c(genea$gene,geneb$gene))

genec<-geneset2[geneset2$count>=3,]$`...1`

length(c(gene_int,genec))
length(unique(gene_int,genec))

gene<-c(genea$gene,geneb$gene,genec)

write.csv(unique(genec),'./combined_gene_for_machine_learning_cellchat.csv')


# Set up and run Prioritizr with zones to simulate CMSP in one region
# set up to source from within R 3.5.3: source('code/5.1_prioritizr.r')
# May need to set R_MAX_VSIZE=60000000 or larger in .Renviron to avoid hitting memory limits (Sys.getenv('R_MAX_VSIZE') to query)

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

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

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

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

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

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

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

# folders
prioritizrfolder <- 'output/prioritizr_runs/'

# optimality gap for gurobi solver
gap <- 0.01

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

############################
# Run prioritizr
# Do hist-only and 2-period
#############################

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

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

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

    ############################################
    ## Run prioritizr just on 2007-2020
    ############################################

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

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

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

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

    		sppstokeep[ , length(unique(spp))]

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

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

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

    	# write out the species for this region
    	write.csv(spps, file = paste0(prioritizrfolder, 'spp_', myregs[i], '.csv'))

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

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

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

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

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

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

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

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

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

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

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

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

    # Define the problem in prioritzr format
    # rij may need a zone column
    p1 <- problem(pus, spps, cost_column = c('dummycost', 'dummycost', 'dummycost'), rij = puvsp, zones = zones) %>%
        add_min_set_objective() %>%
        add_relative_targets(zonetarget) %>%
        add_binary_decisions() %>%
        add_gurobi_solver(gap = gap)

    # solve it
    cat('\tSolving hist\n')
    if(presolve_check(p1)){
        s1 <- solve(p1)
    } else {
        stop(paste0('region:', myregs[i], '. Failed presolve check (hist).'))
    }

    # force solution (e.g., if fails presolve checks)
    # but beware: solution may be meaningless
    # s1 <- p1 %>%
    #     add_gurobi_solver(numeric_focus = TRUE) %>%
    #     solve(force = TRUE)

    # examine solution in various ways
    s1[,.(navail = sum(solution_1_conservation == 0 & solution_1_fishery == 0 & solution_1_energy == 0),
          ncons = sum(solution_1_conservation),
          nfish = sum(solution_1_fishery),
          nenergy = sum(solution_1_energy))]  # number of cells in each zone
    r1 <- feature_representation(p1, s1[, .(solution_1_conservation, solution_1_fishery, solution_1_energy)]) # representation of each feature in each zone
    r1dt <- as.data.table(r1)
    r1dt[zone=='conservation',] # meeting conservation targets?
    r1dt[zone=='conservation' & !grepl('fishery|energy', feature), .(summary(absolute_held), summary(relative_held))] # meeting conservation targets?
    r1dt[zone=='fishery' & grepl('fishery', feature),] # fishery targets
    r1dt[zone=='energy',]

    # write out
    write.csv(s1, file = paste0(prioritizrfolder, 'solution_', runname1s[i], '.csv'))

    ##################################################################
    ## Set up a prioritizr run on 2006-2020 and half an ensemble mean 2081-2100
    ## This assumes that the historical-only code (previous section) has been run and is loaded in memory
    ##################################################################

    # spps2
    # document every species present
    # add future species to include
    	spps2 <- spps #  use the same species as in the historical-only run

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

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

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

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

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

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

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

    	# Add historical data
    	temp1 <- puvsp # start from the same data as in the historical run
    	temp1[!grepl('energy', name), name := paste0(name, gsub('-', '', planningperiods[1]))] # append time period (except energy)
    	puvsp2 <- rbind(temp1, puvsp2)

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

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

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

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

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

	nrow(zonetarget2)
	zonetarget2 <- zonetarget2[rownames(zonetarget2) %in% puvsp2$name,]
	nrow(zonetarget2)

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

    # Define the problem in prioritzr format
    # rij may need a zone column
    p2 <- problem(pus, spps2, cost_column = c('dummycost', 'dummycost', 'dummycost'),
                  rij = puvsp2, zones = zones) %>%
        add_min_set_objective() %>%
        add_relative_targets(zonetarget2) %>%
        add_binary_decisions() %>%
        add_gurobi_solver(gap = gap)

    # solve it
    cat('\tSolving 2per\n')
    if(presolve_check(p2)){
        s2 <- solve(p2)
    } else {
        stop(paste0('region:', myregs[i], '. Failed presolve check (2per).'))
    }

    # force solution (e.g., if fails presolve checks)
    # but beware: solution may be meaningless
    # s2 <- p2 %>%
    #     add_gurobi_solver(numeric_focus = TRUE) %>%
    #     solve(force = TRUE)

    # examine solution in various ways
    s2[,.(navail = sum(solution_1_conservation == 0 & solution_1_fishery == 0 & solution_1_energy == 0),
          ncons = sum(solution_1_conservation),
          nfish = sum(solution_1_fishery),
          nenergy = sum(solution_1_energy))]  # number of cells in each zone
    r2 <- feature_representation(p2, s2[, .(solution_1_conservation, solution_1_fishery, solution_1_energy)]) # representation of each feature in each zone
    r1dt <- as.data.table(r2)
    r1dt[zone=='conservation',] # meeting conservation targets?
    r1dt[zone=='conservation' & !grepl('fishery|energy', feature), .(summary(absolute_held), summary(relative_held))] # meeting conservation targets?
    r1dt[zone=='fishery' & grepl('fishery', feature),] # fishery targets
    r1dt[zone=='energy' & grepl('energy', feature),]

    # write out
    write.csv(s2, file = paste0(prioritizrfolder, 'solution_', runname2s[i], '.csv'))

}


# Define server logic
server <- function(input, output) {

    cat(getwd())

    ######################### Map panel
    # Define the palette
    bins <- c(0, 10, 20, 50, 100, 200, 500, 1000, Inf)
    pal <- colorBin("YlOrRd", domain = shape_eco$Shape_Area, bins = bins)

    # Define the interactive labels
    labels <- sprintf(
        "%s Ecoregion
%g Shape Area ",
        shape_eco$Ecoregion, shape_eco$Shape_Area
    ) %>% lapply(htmltools::HTML)

    output$map <- renderLeaflet({

        leaflet() %>%
            #addProviderTiles("Stamen.Toner") %>%
            addPolygons(data = shape_eco,
                color = "#444444",
                weight = 1,
                smoothFactor = 0.5,
                opacity = 0.7,
                fillOpacity = 0.5,
                fillColor = ~ pal(shape_eco$Shape_Area),
                layerId = ~uid, # unique id for polygons
                highlightOptions = highlightOptions(
                    color = "white", weight = 2,
                    bringToFront = TRUE
                ),
                label = labels,
                labelOptions = labelOptions(
                    style = list("font-weight" = "normal", padding = "3px 8px"),
                    textsize = "15px",
                    direction = "auto"
                )) %>%
            addPolygons(
                data = eu_shape, color = "black", weight = 1,
                smoothFactor = 0.5,
                opacity = 0.7, fillOpacity = 0.5,
                fillColor = "grey") %>%
             setView(lng = 25.783660, lat = 71.170953, zoom = 3) # nordKap coordinates
    })

    # click on polygon
    observe({

        event <- input$map_shape_click

        # message <- paste("Ecoregion name is:", shape_eco$Ecoregion[shape_eco$uid == event$id])

        # output$Ecoregion <- renderText(message)

        key_subset <- as.character(shape_eco$Ecoregion[shape_eco$uid == event$id])
        print(key_subset)

        #stock_list_all <- read.csv("./Shiny/FilteredStocklist_all.csv")
        stock_list_all <- jsonlite::fromJSON(
            URLencode(
                "http://sd.ices.dk/services/odata4/StockListDWs4?$filter=ActiveYear eq 2021&$select=StockKey, StockKeyLabel, EcoRegion, SpeciesScientificName,  SpeciesCommonName, DataCategory"
            )
        )$value
        #### I'm adding this next line just to check what happens if I subset for only cat1 stocks
        stock_list_all <- stock_list_all  %>% filter(DataCategory == "1")

        ### if no polygon is clicked, just show all stocks in the table
        if (identical(key_subset, character(0))) {
            output$tbl <- renderDT(stock_list_all,
            extensions = 'Buttons',
            options = list(dom = 'Bfrtip', pageLength = 300,#lengthChange = TRUE,
            buttons = c('csv')
            )
            )
        } else {
            # Subset based on polygon click
            subset <- stock_list_all %>% filter(str_detect(EcoRegion, key_subset))

            # reactive data frame which creates the number of actionButtons needed
            df <- reactiveVal(
                tibble(
                    subset,
                    Actions = shinyInput(
                        FUN = actionButton,
                        n = nrow(subset),
                        id = "button_",
                        label = "Advice",
                        onclick = 'Shiny.setInputValue(\"select_button\", this.id, {priority: \"event\"})'
                    )
                )
            )

            output$tbl <- DT::renderDT({

                df()
                #extensions = 'Buttons',
                #options = list(dom = 'Bfrtip', pageLength = 300,buttons = c('csv')
            },
            # Don't escape any HTML in the table (i.e. the actionButton)
            escape = FALSE,

            # turn off row selection otherwise you'll also select that row when you
            # click on the actionButton
            selection = 'none',

            # add buttons to download csv
            extensions = 'Buttons',
            options = list(dom = 'Bfrtip', pageLength = 300,buttons = c('csv'))
            )
        }

            # When a button is clicked, employee is set to the employee name
            #  associated with the clicked row
    advice_action <- eventReactive(input$select_button, {
    # take the value of input$select_button, e.g. "button_1"
    # get the button number (1) and assign to selectedRow
    selectedRow <- as.numeric(strsplit(input$select_button, "_")[[1]][2])

    # get the value of the "Name" column in the data.frame for that row

    stock_name <- as.character(df()[selectedRow, "StockKeyLabel"])

    #   # Dowload the data
    data_sag <- access_sag_data(stock_name, 2020)

    catches <- data_sag %>% select(Year, catches, landings, discards)#,#,
    R <- data_sag %>% select(Year, low_recruitment, recruitment, high_recruitment) #%>% na.omit()
    f <- data_sag %>% select(Year, low_F, F, high_F, FLim, Fpa, FMSY)
    SSB <- data_sag %>% select(Year, low_SSB, SSB, high_SSB, Blim, Bpa, MSYBtrigger)
    list_df <- quality_assessment_data(stock_name)
    SAG_summary <- data_sag %>% select(Year,
                    recruitment, high_recruitment, low_recruitment,
                    SSB, high_SSB, low_SSB,
                    catches, landings,
                    F, high_F, low_F)

#     big_data <- list_df[[1]]
# big_data_last_year <- list_df[[2]]

    list(catches = catches, R = R, f = f, SSB = SSB, big_data = list_df[[1]], big_data_last_year = list_df[[2]], SAG_summary = SAG_summary)

    })

    ######################### Advice panel

    #### Plot 1 Landings and discards
    output$catches <- renderPlotly({

        data_list = advice_action()

         rv <- reactiveValues(
             catches_df = data_list$catches
         )

        figure_1_catches(rv$catches_df, rv$catches_df$Year, rv$catches_df$catches ,rv$catches_df$landings, rv$catches_df$discards)
    })
    #### Plot 2 Recruitment
    output$R <- renderPlotly({

        data_list = advice_action()

         rv <- reactiveValues(
             r_df = data_list$R
         )

        figure_2_recruitment(rv$r_df, rv$r_df$Year, rv$r_df$recruitment,rv$r_df$low_recruitment,rv$r_df$high_recruitment)
    })
    #### Plot 3 fish mortality
    output$f <- renderPlotly({
        data_list = advice_action()

         rv <- reactiveValues(
             f_df = data_list$f
         )

        #### third plot
        figure_3_fish_mortality(rv$f_df, rv$f_df$Year, rv$f_df$low_F, rv$f_df$F, rv$f_df$high_F, rv$f_df$FLim, rv$f_df$Fpa, rv$f_df$FMSY)
    })
    #### Plot 4 SSB
    output$SSB <- renderPlotly({

        data_list = advice_action()

         rv <- reactiveValues(
             SSB_df = data_list$SSB
         )

        ### forth plot
        figure_4_SSB(rv$SSB_df, rv$SSB_df$Year, rv$SSB_df$low_SSB, rv$SSB_df$SSB, rv$SSB_df$high_SSB, rv$SSB_df$Blim, rv$SSB_df$Bpa, rv$SSB_df$MSYBtrigger)
    })
    #### Plot 5 quality of assessment
    output$Q_Ass <- renderPlotly({

        data_list = advice_action()

         rv <- reactiveValues(
             Q_Ass_df1 = data_list$big_data,
             Q_Ass_df2 = data_list$big_data_last_year
         )

        ### forth plot
        quality_assessment_plots(rv$Q_Ass_df1, rv$Q_Ass_df2)
        # figure_4_SSB(rv$SSB_df, rv$SSB_df$Year, rv$SSB_df$low_SSB, rv$SSB_df$SSB, rv$SSB_df$high_SSB, rv$SSB_df$Blim, rv$SSB_df$Bpa, rv$SSB_df$MSYBtrigger)
    })

    output$tbl_summary <- DT::renderDT({
        data_list = advice_action()
        rv <- reactiveValues(
             data_SAG = data_list$SAG_summary
         )
         rv$data_SAG},
         extensions = 'Buttons',
            options = list(dom = 'Bfrtip', pageLength = 10,#lengthChange = TRUE,
            buttons = c('csv')
            )

    )
})

}


# This wrapper is designed to work with any single sample data
# The two main requirements are:
# a mutation table (in the format described below) which was originally obtained from https://confluence.broadinstitute.org/display/GDAC/DCC+MAFs
# but has been modified to fit description below
# ASCAT copy number data (a segmented matrix)
# source("~/Work/GD.functions.R")
# source("~/Work/STM_final_scripts/main.functions.r")

suppressPackageStartupMessages(library(gdata))
suppressPackageStartupMessages(library(limma))
suppressPackageStartupMessages(library(sequenza))
clonality.estimation <- function(mutation.table.loc,
                                 seg.mat.loc,
                                 data.type,
                                 TCGA.barcode,
                                 ANALYSIS.DIR,
                                 sub.clonal.cut.off = 1,
                                 min.var.prop = 0.05,
                                 min.alt.reads = 5,
                                 min.depth = 30,
                                 plotting = TRUE) {
  # The following function is the main wrapper for clonality estimation
  # The input required is as follows
  # mutation.table.loc # mutation tables as in ../input
  # seg.mat.loc # segmented matrices in list format as in ../input
  # data type # e.g. TCGA_BRCA
  # ANALYSIS.DIR #what directory do you want to create as a base directory, e.g. example/

  # create the root directory
  data.folder <- paste(ANALYSIS.DIR, data.type, sep = "")

  if (!file.exists(data.folder)) {
    if (!dir.create(data.folder, recursive = TRUE)) {
      stop("Unable to create root directory.\n")
    }
  }

  # create a folder for the specific patient
  patient.folder <- paste(data.folder, "/", TCGA.barcode, sep = "")

  if (!file.exists(patient.folder)) {
    if (!dir.create(patient.folder, recursive = TRUE)) {
      stop("Unable to create tmp directory.\n")
    }
  }

  # load somatic mutations ####
  if (!file.exists(mutation.table.loc)) {
    stop(paste("\nUnable to locate:\n", mutation.table.loc, " .\n"))
  }

  mutation.table <- read.table(mutation.table.loc,
    header = TRUE,
    stringsAsFactors = FALSE,
    sep = "\t",
    fill = TRUE,
    quote = '"'
  )

  req.mut.colnames <- c(
    "Patient",
    "Chr",
    "Start_position",
    "End_position",
    "Reference",
    "Alternate",
    "Variant_freq",
    "Ref_freq",
    "Hugo_Symbol",
    "Variant_Classification"
  )

  if (!all(req.mut.colnames %in% colnames(mutation.table))) {
    stop(paste("Mutation table not in correct format\nThe following columns are required:\n",
      PasteVector(req.mut.colnames, sep = "\n"),
      sep = ""
    ))
  }

  # load somatic copy numbers ####
  if (!file.exists(seg.mat.loc)) {
    stop(paste("\nUnable to locate:\n", seg.mat.loc, " .\n"))
  }

  seg.mat.copy <- load(seg.mat.loc)
  seg.mat.copy.list <- get(seg.mat.copy)
  seg.mat.copy <- seg.mat.copy.list$segments

  # combine copy number and mutation data #####
  # first of all, select only samples where both available
  barcodes <- intersect(unique(seg.mat.copy$SampleID), unique(mutation.table[, 1]))
  cat(paste("\n\nThere are ", length(barcodes), " patients with both copy number and mutation data. \nOnly these will be used "))

  if (!TCGA.barcode %in% barcodes) {
    stop("TCGA barcode not found in either mutation table or seg.mat.copy")
  }

  # remove sex chromosomes
  seg.mat.copy <- seg.mat.copy[seg.mat.copy$SampleID %in% barcodes, ]
  seg.mat.copy <- seg.mat.copy[seg.mat.copy$Chr %in% c(1:22), ]
  mutation.table <- mutation.table[mutation.table[, 1] %in% barcodes, ]
  mutation.table <- mutation.table[mutation.table$Chr %in% c(1:22), ]
  mutation.table$Chr <- as.numeric(mutation.table$Chr)

  # select patient specific data
  sub.mat.copy <- seg.mat.copy[seg.mat.copy$SampleID == TCGA.barcode, , drop = FALSE]
  sub.mat.mut <- mutation.table[mutation.table[, 1] == TCGA.barcode, , drop = FALSE]

  # check whether there is only one copy number profile
  if (length(unique(as.character(sub.mat.copy$ChipNames))) > 1) {
    stop("You have more than one copy number profile")
  }

  if (length(unique(as.character(sub.mat.copy$NormalFile))) > 1) {
    stop("You have more than one normal copy number profile")
  }

  sub.mat.copy <- unique(sub.mat.copy)

  # combine mutation and copy number
  mut.table <- data.frame(t(sapply(1:nrow(sub.mat.mut), identify.mut.copy.number.ascat, sub.mat.mut, sub.mat.copy)),
    stringsAsFactors = FALSE
  )
  mut.table <- mut.table[!is.na(mut.table$minor_cn), ]
  mut.table <- mut.table[!is.na(mut.table$ref_counts), ]
  mut.table <- mut.table[!duplicated(mut.table$mutation_id), ]

  ### APPLY filters ####

  # min.alt.reads.cut.off
  mut.table <- mut.table[as.numeric(mut.table$var_counts) >= min.alt.reads, ]

  # min.cov.at.site
  mut.table <- mut.table[as.numeric(mut.table$var_counts) + as.numeric(mut.table$ref_counts) >= min.depth, ]

  # min variant proportion
  mut.table <- mut.table[(as.numeric(mut.table$var_counts) / (as.numeric(mut.table$var_counts) + as.numeric(mut.table$ref_counts))) >= min.var.prop, ]

  # calculating genome doubling estimates
  sub.mat.copy.arm <- get.seg.mat.arm(sub.mat.copy)
  # seg.mat.minor    - segmented matrix with minor allele (e.g. seg.mat.LOH)
  #                  - columns should be as follows: c("Sample","Chrom","Start","End","Num.probes","val")
  # seg.mat.copy     - segmented total copy number matrix (columns as above)
  sub.mat.minor <- cbind(
    sub.mat.copy.arm$SampleID,
    sub.mat.copy.arm$Chr,
    sub.mat.copy.arm$Start,
    sub.mat.copy.arm$End,
    sub.mat.copy.arm$nProbes,
    apply(cbind(sub.mat.copy.arm$nA, sub.mat.copy.arm$nB), 1, min)
  )
  colnames(sub.mat.minor) <- c("Sample", "Chrom", "Start", "End", "Num.probes", "val")

  sub.mat.cn <- cbind(
    sub.mat.copy.arm$SampleID,
    sub.mat.copy.arm$Chr,
    sub.mat.copy.arm$Start,
    sub.mat.copy.arm$End,
    sub.mat.copy.arm$nProbes,
    sub.mat.copy.arm$cn
  )

  colnames(sub.mat.cn) <- c("Sample", "Chrom", "Start", "End", "Num.probes", "val")

  GD.pval <- genome.doub.sig(
    sample = TCGA.barcode, seg.mat.minor = sub.mat.minor,
    seg.mat.copy = sub.mat.cn, number.of.sim = 10000
  )
  GD.status <- fun.GD.status(
    GD.pval = GD.pval,
    ploidy.val = round(sub.mat.copy$Ploidy[1])
  )

  TCGA.purity <- as.character(unique(sub.mat.copy[, grep("Aberrant", colnames(sub.mat.copy))]))

  if (TCGA.purity > 1) {
    stop("\nYour tumour content is greater than 1! \nYou probably don't have an ASCAT estimate. \nThere is an alernative script for this scenario.")
  }

  #### EarlyorLate implementation #####

  TCGA.earlyLate <- earlyORlate(patient = TCGA.barcode, complete.mutation.table = mut.table, purity = TCGA.purity)
  TCGA.earlyLate <- cbind(TCGA.earlyLate, GD.pval, GD.status, TCGA.purity)

  # Let's choose the columns of interest
  TCGA.earlyLate.out <- TCGA.earlyLate
  TCGA.earlyLate.out$comb.timing <- NA
  TCGA.earlyLate.out[TCGA.earlyLate.out$absolute.ccf.0.95 >= sub.clonal.cut.off & !TCGA.earlyLate.out$timing %in% c("late"), "comb.timing"] <- "Early"
  TCGA.earlyLate.out[TCGA.earlyLate.out$absolute.ccf.0.95 < sub.clonal.cut.off | TCGA.earlyLate.out$timing %in% c("late"), "comb.timing"] <- "Late"
  col.names <- c("patient", "TCGA.purity", "mutation_id", "Reference_Base", "Alternate_Base", "ref_counts", "var_counts", "obs.VAF", "normal_cn", "minor_cn", "major_cn", "mut.multi", "absolute.ccf", "absolute.ccf.0.05", "absolute.ccf.0.95", "prob.clonal", "prob.subclonal", "GD.status", "timing", "comb.timing")

  TCGA.earlyLate.out <- TCGA.earlyLate.out[, col.names]

  # let's write the file to a location

  earlylate.tsv <- paste(patient.folder, "/", TCGA.barcode, ".earlylate.tsv", sep = "")
  earlylate.out <- apply(TCGA.earlyLate.out, 2, as.character)
  write.table(earlylate.out,
    sep = "\t",
    quote = FALSE,
    col.names = TRUE,
    row.names = FALSE,
    file = earlylate.tsv
  )

  # plot what you've just found for the given patient

  early.late.pdf <- paste(patient.folder, "/", TCGA.barcode, ".earlylate.pdf", sep = "")

  TCGA.earlyLate <- TCGA.earlyLate[!is.na(TCGA.earlyLate$absolute.ccf.0.95), ]

  # add extra column to

  sub.mat.copy <- cbind(sub.mat.copy, sub.mat.copy$nA + sub.mat.copy$nB)
  colnames(sub.mat.copy)[ncol(sub.mat.copy)] <- "Copy.Number"
  sub.mat.copy <- cbind(sub.mat.copy, apply(cbind(sub.mat.copy$nA, sub.mat.copy$nB), 1, min))
  colnames(sub.mat.copy)[ncol(sub.mat.copy)] <- "min.allele"

  colnames(sub.mat.copy)[2] <- "Chromosome"
  colnames(sub.mat.copy)[3] <- "StartPosition"
  colnames(sub.mat.copy)[4] <- "EndPosition"
  colnames(sub.mat.copy)[5] <- "nr.probes"

  if (plotting) {
    pdf(early.late.pdf)
    par(mar = c(13, 4, 13, 4))
    par(lend = 1)
    plot.EarlyOrLate(
      seg.mat.patient = sub.mat.copy,
      TCGA.earlyLate = TCGA.earlyLate,
      TCGA.purity = TCGA.purity,
      TCGA.barcode = TCGA.barcode,
      sub.clonal = sub.clonal.cut.off
    )

    dev.off()

    ccf.plot <- paste(patient.folder, "/", TCGA.barcode, ".ccfplot.pdf", sep = "")

    pdf(ccf.plot)
    plot.TCGA.sample.ccfs(TCGA.earlyLate = TCGA.earlyLate, clonal.cut.off = 1)
    dev.off()
  }
}