code 'G51'
name '利率重新定价风险情况表'
dimensions{
    rowdim G51Demension
    rpid RepriceRateDimension
}

layout{
    rows 'rowdim'
    columns 'rpid'
}

dataRequest{
    table 'glAllBranch'
    fields 'item,currency,sum(endingBalance) endingBalance,sum(debitBalance) debitBalance,sum(creditBalance) creditBalance'
	groupFields 'item,currency'
	params {
		date 'context[]'
		currency 'context[]'
	}
}

dataRequest{
        table 'repriceRate'
        fields 'item,balance,rpid'
        contextParams (['date','currency','staticModel'])
}

dataGrids{

    apply sel([rowdim:1..5,rpid:1]),{
        formula {(1..13).sum({colRel(it)})}
    }
    apply sel([rowdim:1,rpid:10000..10012]),{
        formula {rowRel(1)+rowRel(2)}
    }
    apply sel(rowdim:2,rpid:10000),{
        formula {
            v0([item:"S1011",bal:'debit',dataRequest:'glAllBranch'])+
            v0([item:"S1012",bal:'debit',dataRequest:'glAllBranch'])+
            v0([item:"S1013",bal:'debit',dataRequest:'glAllBranch'])+
            v0([item:"S1014",bal:'debit',dataRequest:'glAllBranch'])+
            v0([item:"S1031",bal:'debit',dataRequest:'glAllBranch'])+
            v0([item:"S1111",bal:'debit',dataRequest:'glAllBranch'])-
            (1..6).sum({colRel(it)})
        }
    }
    apply sel([rowdim:2,rpid:10001..10012]),{
        formula {
            v([item:'S1111',dataRequest:'repriceRate'])+
            v([item:'S1011',dataRequest:'repriceRate'])+
            v([item:'S1013',dataRequest:'repriceRate'])
        }
    }
    apply sel([rowdim:3,rpid:10000]),{
        formula{
            v0([item:"S1038",bal:'debit',dataRequest:'glAllBranch'])+
            0+                 //逾期贷款glitem 有问题
            0+                 //正常货代reRate
            v([item:'S1307',dataRequest:'repriceRate'])
        }
    }
    apply sel([rowdim:3,rpid:10001..10012]),{
        formula{
            0+                 //正常货代  有问题
            v([item:'S1307',dataRequest:'repriceRate'])
        }
    }
    apply sel([rowdim:5,rpid:10000]),{
        formula{
            sumItemsWithMinus(['S1002','S1003'],['0013'],[bal:'debit',dataRequest:'glAllBranch'])+
            mathPositive(
                v0([item:"0013",bal:'debit',dataRequest:'glAllBranch']),
                v0([item:"2006",bal:'credit',dataRequest:'glAllBranch']),0
            )
    }
    }

    apply sel([rowdim:6,rpid:1]),{
        formula{
            sumItems0(['S1001','S1004','S1131','S1132','S1221','S1431','S1441','S1521','S1522','S1532','S1601','S1604','S1606','S1701','S1801','S1811','S1901'],[bal:'debit',dataRequest:'glAllBranch'])-
            sumItems0(['S2016','S1602','S1702'],[bal:'credit',dataRequest:'glAllBranch'])+
            v0([item:"0155",bal:'debit',dataRequest:'glAllBranch'])+
            v0([item:"0153",bal:'debit',dataRequest:'glAllBranch'])+
            //培训中心投资  手工维护
            v0([dict:'pxzxkx',dataRequest:'manualData'])+
            mathLarge(
                v0([item:"S1311",bal:'debit',dataRequest:'glAllBranch'])-
                v0([item:"S2313",bal:'credit',dataRequest:'glAllBranch']),0,0
            )+
            mathLarge(
                v0([item:"S1321",bal:'debit',dataRequest:'glAllBranch'])-
                v0([item:"S2314",bal:'credit',dataRequest:'glAllBranch']),0,0
            )+
            mathLarge(
                sumItems0(['S3031','S30411','S30412','S30413','S30414','S30415','S30416','S30417','S30419','S3051','S3301'],[bal:'credit',dataRequest:'glAllBranch'])
                ,0,0
            )
        }
    }
    apply sel([rowdim:7,rpid:1]),{
        formula{
             rowRel(-1)+rowRel(-6)
        }
    }
    apply sel([rowdim:8..13,rpid:1]),{
        formula{
            (1..13).sum({colRel(it)})
        }
    }
    apply sel([rowdim:8,rpid:10000..10012]),{
        formula{
            (1..5).sum({rowRel(it)})
        }
    }
    apply sel([rowdim:9,rpid:10000]),{
        formula{
            sumItems0(['S2017','S2018','S2019','S2020','S2021','S2022','S2101','S2111'],[bal:'credit',dataRequest:'glAllBranch'])-
            (1..12).sum({colRel(it)})-
             v0([item:"1404",bal:'credit',dataRequest:'glAllBranch'])
        }
    }
    apply sel([rowdim:9,rpid:10001..10012]),{
        formula{
            //v([item:"S2111",dataRequest:'repriceRate'])
            sumItemsWithMinus(['S2111','S2017','S2019'],['1404'],[dataRequest:'repriceRate'])
        }
    }
    apply sel([rowdim:10,rpid:10000]),{
        formula{
           sumItems0(['S2001','S2003','S2005','S2011','S2012','S2014'],[bal:'credit',dataRequest:'glAllBranch'])+
             v0([item:"1404",bal:'credit',dataRequest:'glAllBranch'])-
             v0([item:"1444",bal:'balance',dataRequest:'glAllBranch'])
        }
    }
    apply sel([rowdim:11,rpid:10000..10012]),{
        formula{
            sumItems(['S2002','S2004','1444'],[dataRequest:'repriceRate'])
        }
    }
    apply sel([rowdim:12,rpid:10000..10012]),{
        formula{
            sumItems(['S2502'],[dataRequest:'repriceRate'])
        }
    }
    apply sel([rowdim:13,rpid:10000]),{
        formula{
            //sumItemsWithMinus0(['S2016','S2006'],['S1004','S0013'],[bal:'credit',dataRequest:'glAllBranch'])-
            //sumItems0(['S1004','S0013'],[bal:'debit',dataRequest:'glAllBranch'])+
            //sumItems(['S2501','S2015'],[dataRequest:'repriceRate'])
            mathPositive(v0([item:"S2016",bal:'credit',dataRequest:'glAllBranch']),v0([item:"1004",bal:'debit',dataRequest:'glAllBranch']),0)+
            mathPositive(v0([item:"S2006",bal:'credit',dataRequest:'glAllBranch']),v0([item:"0013",bal:'debit',dataRequest:'glAllBranch']),0)+
            sumItems(['S2501','S2015'],[dataRequest:'repriceRate'])
        }
    }
    apply sel([rowdim:13,rpid:10001..10012]),{
        formula{
            sumItems(['S2501','S2015'],[dataRequest:'repriceRate'])
        }
    }
    apply sel([rowdim:14,rpid:1]),{
        formula{
            sumItems0(['S1032','S1112','S1231','S1309','S1432','S1442','S1502','S1504','S1512','S1523','S1603','S1605','S1703','S2007','S2013','S2211','S2221','S2231','S2232','S2241','S2401','S2701','S2703','S2711','S2801','S2901'],[bal:'credit',dataRequest:'glAllBranch'])+
            //sumItemsWithMinus0(['S2313','S2314'],['S1311','S1321'],[bal:'credit',dataRequest:'glAllBranch'])+
            mathPositive(v0([item:"S2313",bal:'credit',dataRequest:'glAllBranch']),v0([item:"S1311",bal:'debit',dataRequest:'glAllBranch']),0)+
            mathPositive(v0([item:"S2314",bal:'credit',dataRequest:'glAllBranch']),v0([item:"S1321",bal:'debit',dataRequest:'glAllBranch']),0)+

            sumItems0(['S1311','S1321'],[bal:'credit',dataRequest:'glAllBranch'])+
            sumItems0(['S3031','S30411','S30412','S30413','S30414','S30415','S30416','S30417','S30419','S3051','S3301'],[bal:'credit',dataRequest:'glAllBranch'])
        }
    }
    apply sel([rowdim:15,rpid:1]),{
        formula{
            sumItems0(['S4001','S4002','S4101','S4102','S4103','S4104','S4201'],[bal:'credit',dataRequest:'glAllBranch'])
        }
    }
    apply sel([rowdim:16,rpid:1]),{
        formula{
           rowRel(-1)+rowRel(-2)+rowRel(-15)
        }
    }
    apply sel([rowdim:17,rpid:10000..10012]),{
        formula{
           rowRel(-16)-rowRel(-9)
        }
    }
    apply sel([rowdim:18,rpid:10000..10012]),{
        formula{
           rowRel(1)+rowRel(3)+rowRel(5)+rowRel(7)+rowRel(9)+rowRel(11)-
           rowRel(2)-rowRel(4)-rowRel(6)-rowRel(8)-rowRel(10)-rowRel(12)
        }
    }
    apply sel([rowdim:18..30,rpid:1]),{
        formula{
           (1..13).sum({colRel(it)})
        }
    }
    apply sel([rowdim:31,rpid:1]),{
        formula{
            (1..13).sum({colRel(it)})
        }
    }
    apply sel([rowdim:31,rpid:10000..10012]),{
        formula{
//           rowRel(-14)+rowRel(-1)
            [-14,-1].sum({rowRel(it)})
        }
    }
 //设置这行的文本格式 百分比
    apply sel([rowdim:32,rpid:10000..10012]),{
       // dataType new PercentType()
        dataType 'percent'
    }
    apply sel([rowdim:32,rpid:10000]),{
        formula{
            1.917/100
        }
    }
    apply sel([rowdim:32,rpid:10001]),{
        formula{
           1.667/100
        }
    }
    apply sel([rowdim:32,rpid:10002]),{
        formula{
            1.250/100
        }
    }
    apply sel([rowdim:32,rpid:10003]),{
        formula{
            0.500/100
        }
    }
    apply sel([rowdim:33,rpid:1]),{
        formula{
            (1..4).sum({colRel(it)})
        }
    }
    apply sel([rowdim:33,rpid:10000..10003]),{
        formula{
           rowRel(-2)*rowRel(-1)
        }
    }
    apply sel([rowdim:34,rpid:10000..10006]),{
        formula{
           colRel(-1)+ rowRel(-3)
        }
    }
    apply sel([rowdim:34,rpid:10007]),{
        formula{
           colRel(-1)
        }
    }
    apply sel([rowdim:34,rpid:10008]),{
        formula{
           rel(-3,-8)+rel(-3,-7)+rel(-3,-6)+rel(-3,-5)+rel(-3,-4)+rel(-3,-3)+
           rel(-3,-2)+rel(-3,-1)+rel(-3,0)
        }
    }
    apply sel([rowdim:34,rpid:10009]),{
        formula{
           rel(-3,-9)+rel(-3,-8)+rel(-3,-7)+rel(-3,-6)+rel(-3,-5)+rel(-3,-4)+rel(-3,-3)+
           rel(-3,-2)+rel(-3,-1)+rel(-3,0)
        }
    }
    apply sel([rowdim:34,rpid:10010]),{
        formula{
           rel(-3,-10)+rel(-3,-9)+rel(-3,-8)+rel(-3,-7)+rel(-3,-6)+rel(-3,-5)+rel(-3,-4)+rel(-3,-3)+
           rel(-3,-2)+rel(-3,-1)+rel(-3,0)
        }
    }
    apply sel([rowdim:34,rpid:10011]),{
        formula{
           rel(-3,-11)+rel(-3,-10)+rel(-3,-9)+rel(-3,-8)+rel(-3,-7)+rel(-3,-6)+rel(-3,-5)+rel(-3,-4)+rel(-3,-3)+
           rel(-3,-2)+rel(-3,-1)+rel(-3,0)
        }
    }
    apply sel([rowdim:34,rpid:10012]),{
        formula{
           rel(-3,-12)+rel(-3,-11)+rel(-3,-10)+rel(-3,-9)+rel(-3,-8)+rel(-3,-7)+rel(-3,-6)+rel(-3,-5)+rel(-3,-4)+rel(-3,-3)+
           rel(-3,-2)+rel(-3,-1)+rel(-3,0)
        }
    }
     //设置这行的格式 百分比
    apply sel([rowdim:35,rpid:10000..10012]),{
        dataType 'percent'
    }
    apply sel([rowdim:35,rpid:10000]),{
        formula{
            0.08/100
        }
    }
    apply sel([rowdim:35,rpid:10001]),{
        formula{
                0.32/100
        }
    }
    apply sel([rowdim:35,rpid:10002]),{
        formula{
              0.72/100
        }
    }
    apply sel([rowdim:35,rpid:10003]),{
        formula{
            1.43/100
        }
    }
    apply sel([rowdim:35,rpid:10004]),{
        formula{
            2.77/100
        }
    }
    apply sel([rowdim:35,rpid:10005]),{
        formula{
            4.49/100
        }
    }
    apply sel([rowdim:35,rpid:10006]),{
        formula{
             6.14/100
        }
    }
    apply sel([rowdim:35,rpid:10007]),{
        formula{
                7.17/100
        }
    }
    apply sel([rowdim:35,rpid:10008]),{
        formula{
            10.15/100
        }
    }
    apply sel([rowdim:35,rpid:10009]),{
        formula{
            13.26/100
        }
    }
    apply sel([rowdim:35,rpid:10010]),{
        formula{
            17.84/100
        }
    }
    apply sel([rowdim:35,rpid:10011]),{
        formula{
            22.43/100
        }
    }

    apply sel([rowdim:35,rpid:10012]),{
        formula{
                26.03/100
        }
    }
    apply sel([rowdim:36,rpid:1]),{
        formula{
            (1..13).sum({colRel(it)})
        }
    }
    apply sel([rowdim:36,rpid:10000..10012]),{
        formula{
           -rowRel(-1)*rowRel(-5)
        }
    }
    //设置这行的文本格式
    apply sel([rowdim:37,rpid:1]),{
        dataType 'percent'
    }
    apply sel([rowdim:37,rpid:1]),{
        formula{
           rowRel(-1)/rowRel(1)
        }
    }

    apply sel([rowdim:38,rpid:1]),{
        formula{
          sumItems0(['S4001','S4002','S4101','S4102','S4103','S4104','S1309','S2502'],[bal:'credit',dataRequest:'glAllBranch'])+
          0- //损益类钆差后贷方余额
          0-  //专项准备
          (
                //手工维护
              v0([dict:'xttz',dataRequest:'manualData'])+ //仙桃
              v0([dict:'jmtz',dataRequest:'manualData'])+  //即墨
              v0([dict:'nxytz',dataRequest:'manualData'])+   //农信

              v0([item:"S1521",bal:'debit',dataRequest:'glAllBranch'])-
              v0([item:"S1521",bal:'credit',dataRequest:'glAllBranch'])
          )
        }
    }
}


#!/usr/bin/env Rscript
# Integrate multiple single cell datasets (samples)
# Mahdi Moradi Marjaneh

# ____________________________________________________________________________
# Initialization ####

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

## ............................................................................
## Load packages ####
library(argparse)
library(scFlow)
library(parallel)

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

# create parser object
parser <- ArgumentParser()

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

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

required$add_argument(
"--method",
required = TRUE,
help ="The integration method to use",
metavar = "Liger"
)

required$add_argument(
"--unique_id_var",
required = TRUE,
help ="Unique id variable",
metavar = "manifest"
)

required$add_argument(
"--take_gene_union",
default = FALSE,
required = TRUE,
help ="Whether to fill out raw.data matrices with union of genes across all datasets (filling in 0 for missing data)",
metavar = "Boolean"
)

required$add_argument(
"--remove_missing",
default = TRUE,
required = TRUE,
help ="Whether to remove cells not expressing any measured genes, and genes not expressed in any cells",
metavar = "Boolean"
)

required$add_argument(
"--num_genes",
default = 3000,
type = "integer",
required = TRUE,
help ="Number of genes to find for each dataset",
metavar = "N"
)

required$add_argument(
"--combine",
default = "union",
required = TRUE,
help ="How to combine variable genes across experiments",
metavar = "union,intersect"
)

required$add_argument(
"--keep_unique",
default = FALSE,
required = TRUE,
help ="Keep genes that occur (i.e., there is a corresponding column in raw.data) only in one dataset",
metavar = "Boolean"
)

required$add_argument(
"--capitalize",
default = FALSE,
required = TRUE,
help ="Capitalize gene names to match homologous genes(ie. across species)",
metavar = "Boolean"
)

required$add_argument(
"--use_cols",
default = TRUE,
required = TRUE,
help ="Treat each column as a cell",
metavar = "Boolean"
)

required$add_argument(
"--k",
default = 30,
type = "integer",
required = TRUE,
help ="Inner dimension of factorization (number of factors)",
metavar = "N"
)

required$add_argument(
"--lambda",
default = 5.0,
type = "double",
required = TRUE,
help ="Regularization parameter. Larger values penalize dataset-specific effects more strongly (ie. alignment should increase as lambda increases)",
metavar = "N"
)

required$add_argument(
"--thresh",
default = 0.0001,
type = "double",
required = TRUE,
help ="Convergence threshold. Convergence occurs when |obj0-obj|/(mean(obj0,obj)) < thresh",
metavar = "N"
)

required$add_argument(
"--max_iters",
default = 100,
type = "integer",
required = TRUE,
help ="Maximum number of block coordinate descent iterations to perform",
metavar = "N"
)

required$add_argument(
"--nrep",
default = 1,
type = "integer",
required = TRUE,
help ="Number of restarts to perform",
metavar = "N"
)

required$add_argument(
"--rand_seed",
default = 1,
type = "integer",
required = TRUE,
help ="Random seed to allow reproducible results",
metavar = "N"
)

required$add_argument(
"--knn_k",
default = 20,
type = "integer",
required = TRUE,
help ="Number of nearest neighbors for within-dataset knn graph",
metavar = "N"
)

required$add_argument(
"--k2",
default = 500,
type = "integer",
required = TRUE,
help ="Horizon parameter for shared nearest factor graph",
metavar = "N"
)

required$add_argument(
"--prune_thresh",
default = 0.2,
type = "double",
required = TRUE,
help ="Minimum allowed edge weight. Any edges below this are removed (given weight 0)",
metavar = "N"
)

required$add_argument(
"--ref_dataset",
default = '',
required = TRUE,
help ="Name of dataset to use as a reference for normalization",
metavar = "ref"
)

required$add_argument(
"--min_cells",
default = 2,
type = "integer",
required = TRUE,
help ="Minimum number of cells to consider a cluster shared across datasets",
metavar = "N"
)

required$add_argument(
"--quantiles",
default = 50,
type = "integer",
required = TRUE,
help ="Number of quantiles to use for quantile normalization",
metavar = "N"
)

required$add_argument(
"--nstart",
default = 10,
type = "integer",
required = TRUE,
help ="Number of times to perform Louvain community detection with different random starts",
metavar = "N"
)

required$add_argument(
"--resolution",
default = 1,
type = "double",
required = TRUE,
help ="Controls the number of communities detected (Higher resolution -> more communities)",
metavar = "N"
)

required$add_argument(
"--dims_use",
default = "null",
required = TRUE,
help ="Indices of factors to use for shared nearest factor determination",
metavar = "Indices"
)

required$add_argument(
"--dist_use",
default = "CR",
required = TRUE,
help ="Distance metric to use in calculating nearest neighbors",
metavar = "CR"
)

required$add_argument(
"--center",
default = FALSE,
required = TRUE,
help ="Centers the data when scaling factors (useful for less sparse modalities like methylation data)",
metavar = "Boolean"
)

required$add_argument(
"--small_clust_thresh",
default = 0,
type = "double",
required = TRUE,
help ="Extracts small clusters loading highly on single factor with fewer cells than this before regular alignment",
metavar = "N"
)

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

args <- parser$parse_args()
args <- purrr::map(args, function(x) {
if (length(x) == 1) {
if (toupper(x) == "TRUE") {
return(TRUE)
}
if (toupper(x) == "FALSE") {
return(FALSE)
}
if (toupper(x) == "NULL") {
return(NULL)
}
}
return(x)
})

## ............................................................................
## Integrate sce ####

sce <- read_sce(args$sce_path)

sce <- integrate_sce(
sce,
method = args$method,
unique_id_var = args$unique_id_var,
take_gene_union = args$take_gene_union,
remove.missing = args$remove_missing,
make.sparse = T,
num_genes = args$num_genes,
combine = args$combine,
keep_unique = args$keep_unique,
capitalize = args$capitalize,
use_cols = args$use_cols,
k = args$k,
lambda = args$lambda,
thresh = args$thresh,
max_iters = args$max_iters,
nrep = args$nrep,
H_init = NULL,
W_init = NULL,
V_init = NULL,
rand_seed = args$rand_seed,
knn_k = args$knn_k,
k2 = args$k2,
prune_thresh = args$prune_thresh,
ref_dataset = args$ref_dataset,
min_cells = args$min_cells,
quantiles = args$quantiles,
nstart = args$nstart,
resolution = args$resolution,
dims_use = args$dims_use,
dist_use = args$dist_use,
center = args$center,
small_clust_thresh = args$small_clust_thresh,
do_plot = FALSE,
id_number = NULL,
print_obj = FALSE,
print_mod = FALSE,
print_align_summary = FALSE
)

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

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


#!/usr/bin/env Rscript
# Usage: run non-parametric test for differentiation according to metadata:
#
# run with Rscript make-beeswarm-plots.r -i taxontable -m map.txt -c column_name -o outdir
#
# Usage: plot specific taxa (must match row name exactly from taxontable)
# run with Rscript make-beeswarm-plots.r -i taxontable -w 'Bacteroides,Prevotella' -o outdir

# REQUIRED GLOBAL VARIABLES: PLEASE EDIT
#source(paste(Sys.getenv('MWAS_DIR'),'/lib/gradients.r',sep=''))
#source(paste(Sys.getenv('MWAS_DIR'),'/lib/util.r',sep=''))
#source(paste(Sys.getenv('MWAS_DIR'),'/lib/stats.r',sep=''))
#source(paste(Sys.getenv('MWAS_DIR'),'/lib/visualization.R',sep=''))

require('RColorBrewer')
require('optparse')
require('vegan')

# make option list and parse command line
option_list <- list(
    make_option(c("-i","--input_fp"), type="character",
        help="QIIME-formatted input taxon, OTU, or feature table (see --input_type) (tab-delimited text, not biom) [required]."),
    make_option(c("-I","--input_format"), type="character", default='Taxon table',
        help="Format of classic QIIME-formatted input table: \"Taxon table\" or \"OTU table\"  [default: %default]."),
    make_option(c("-m","--map_fp"), type="character",default=NULL,
        help="QIIME-formatted mapping file (optional). If provided, only samples in both taxon table and mapping file will be plotted."),
    make_option(c("-c","--column"), type="character",default=NULL,
        help="Name of metadata column to color plot by (optional). If included, does not plot gradients."),
    make_option(c("-M","--min_prevalence"), type="numeric",default=.1,
        help="Minimum fraction of samples in which taxon must be present to be included [default: %default]."),
    make_option(c("-w", "--which_taxa"), type="character", default=NULL,
        help="Comma-separated list of taxa to plot [default: plot top --nplot taxa]"),
    make_option(c("-t", "--transform_type"), type="character", default="norm-asin-sqrt",
        help="Relative abundance transform type (none, asin-sqrt, or norm-asin-sqrt) [default: norm-asin-sqrt]"),
    make_option(c("-X", "--x_axis_label"), type="character", default="",
        help="Label for x axis [default: blank]"),
    make_option(c("-s", "--shorten_taxa"),action='store_true',default=FALSE,
        help="Shorten taxonomy names to lowest defined level. [default: %default]"),
    make_option(c("-C", "--suppress_relative_abundance_conversion"),action='store_true',default=FALSE,
        help="Do not convert input to relative abundances (assumes already relative abundances). [default: %default]"),
    make_option(c("-r", "--sort_by_abundance"),action='store_true',default=FALSE,
        help="Sort resulting plots by decreasing relative abundance (instead of significance) [default: %default]"),
    make_option(c("-n", "--nplot"), type="numeric", default=NULL,
        help="Number of taxa to plot (in order of decreasing significance). Ignored if --which_taxa exists [default: %default]"),
	make_option(c("-a","--alpha"), type='numeric', default=.05,
		help='Maximum false discovery rate to report. Ignored if --which_taxa exists or --nplot exists [default: %default]'),
    make_option(c("-O","--category_order"), type="character", default=NULL,
        help="Optional ordering of categories (comma-separated) [default alphabetical]."),
    make_option(c("-o", "--outdir"), type="character", default='.',
        help="Output directory [default %default]")
)
opts <- parse_args(OptionParser(option_list=option_list),
    args=commandArgs(trailing=TRUE))

# create output directory if needed
if(opts$outdir != ".") dir.create(opts$outdir,showWarnings=FALSE, recursive=TRUE)

# LOAD DATA
if(opts$input_format == "Taxon table"){
	x <- t(read.table(opts$input_fp,sep='\t',head=T,row=1,check=F,quote='"'))
} else if(opts$input_format == "OTU table") {
	x <- t(read.table(opts$input_fp,sep='\t',head=T,row=1,check=F,quote='"',comment='',skip=1))
} else {
	stop("Unknown input format\n")
}
if(!is.null(opts$map_fp)){
	m <- read.table(opts$map_fp,sep='\t',head=T,row=1,check=F,comment='',quote='"')
    # check rownames in mapping file matrix
    missing.taxa.samples <- setdiff(rownames(x), rownames(m))
    missing.map.samples <- setdiff(rownames(m), rownames(x))
    if(length(missing.taxa.samples) > 0){
        stop(sprintf('\n\nError: one or more sample names from taxonomy table (%s, ...) not present in metadata table (%s, ...).',
            paste(sort(missing.taxa.samples)[1:5],collapse=', '),
            paste(sort(missing.map.samples)[1:5],collapse=', ')))
    }
	x <- x[intersect(rownames(x),rownames(m)),,drop=F]
	m <- droplevels(m[rownames(x),,drop=F])
}

# remove rare features (do by minimum prevalence or average prevalence)
print(dim(x))
if (dim(x)[2] > 1) x <- x[,colMeans(x > 0) >= opts$min_prevalence, drop = FALSE]

# data transform
if(opts$transform_type == 'asin-sqrt'){
	x <- asin(sqrt(x))
} else if(opts$transform_type == 'norm-asin-sqrt'){
	x <- asin(sqrt(x))/asin(sqrt(1))
} else if(opts$transform_type != 'none'){
	stop(paste('Unrecognized data transform type:',opts$transform_type))
}

# check that taxon.names are in taxon table
if(is.null(opts$which_taxa)){
	taxon.names <- colnames(x)[rev(order(colMeans(x)))]
	taxon.names <- taxon.names[1:min(opts$nplot, length(taxon.names))]
} else {
	taxon.names <- strsplit(opts$which_taxa,',')[[1]]

	if(!all(taxon.names %in% colnames(x))){
		stop(paste('The following taxa are not present in the taxon table:',
					paste(taxon.names[!(taxon.names %in% colnames(x))],collapse=', '),
					'\n'))
	}
}
if(!is.element(opts$column,colnames(m))) stop(paste(opts$column,'not in mapping file.'))

diff.tests = NULL;
# identify differentiated features
print(dim(m))
if (dim(m)[2] > 1)
	try (diff.tests <- differentiation.test(x, m[,opts$column], alpha=2, parametric=FALSE),silent=T)

#if(is.null(opts$which_taxa)){
if (!is.null(diff.tests)) {
	if(is.null(opts$nplot)){
		hit.ix <- which(diff.tests$qvalues <= opts$alpha)
	} else {
		hit.ix <- order(diff.tests$pvalues)[1:min(opts$nplot,length(diff.tests$pvalues))]
	}
} else {
	hit.ix <- match(opts$which_taxa, colnames(x))
}

if(length(hit.ix) == 0){
	print('No hits found.')
} else {
	cat("There were",length(hit.ix),"taxa significant at FDR of",opts$alpha,'\n')
}

# save hits
if (length(hit.ix)) write.differentiation.test.results(diff.tests, filename=sprintf('%s/test_results.txt',opts$outdir))

# sort by relative abundance if requested
if(opts$sort_by_abundance){
	hit.ix <- hit.ix[order(colMeans(x)[hit.ix],decreasing=TRUE)]
}

if(opts$shorten_taxa){
	colnames(x) <- shorten.taxonomy(colnames(x))
	taxon.names <- shorten.taxonomy(taxon.names)
}

# plots
env <- m[,opts$column]

# fix order if requested
if(!is.null(opts$category_order)){
	level.order <- strsplit(opts$category_order,',')[[1]]
	expected.levels <- sort(unique(as.character(env)))
	if(!identical(sort(unique(level.order)),expected.levels)){
		stop(paste("--category_order list does not contain the same categories",
				   "as the provided mapping file:",
				   paste(sort(unique(env)),collapse=', '),'\n',sep=' '))
	}
	env <- factor(env,levels=level.order)
}

#plot.beeswarm.dt <- function(cols, x_axis_label, hit.ix, env, outdir) {
#  require(beeswarm, quietly=TRUE, warn.conflicts=FALSE)

#  cols <-  #c(brewer.pal(9,'Set1'),brewer.pal(9,'Pastel1'),brewer.pal(8,'Dark2'),brewer.pal(8,'Accent'))[-6]
#  cols[1:2] <- cols[2:1]
#  cols <- sprintf('%sbb',cols)
#  if (!length(hit.ix)) hit.ix = seq(1,dim(x)[2])
#  #print(x[,1])
#  #print(env)
#  #pdf(filename.i,width=8.5,height=11)
#  #par(oma=rep(c(0,0),2),mar=c(12,8,8,3), cex.axis=.65, cex.lab=.65, cex=2)
#  for(i in hit.ix){
#    taxon <- x[,i]
#    taxon.name <- colnames(x)[i]
#    filename.i <- sprintf('%s/beeswarm-%s.pdf',outdir, taxon.name)
#    pdf(filename.i,width=8.5,height=11)
#    par(oma=rep(c(0,0),2),mar=c(12,8,8,3), cex.axis=.65, cex.lab=.65, cex=2)
#   cex.lab <- max(.45, 1 - strwidth(taxon.name, units='figure') / 4)
#    cex.lab <- .45
#  cex.axis <- .45
#    beeswarm(taxon ~ env,corral='random',las=2,
#             col='#000000bb',
#             bg=cols,
#             pch=21,ylab=taxon.name,xlab=x_axis_label,cex.lab=cex.lab,
#cex.axis=cex.axis)
#    bxplot(taxon ~ env,add=TRUE)
#    dev.off()
#  }
#}

plot.beeswarm.dt(cols, opts$x_axis_label, hit.ix, env, opts$outdir)


# Packages ----------------------------------------------------------------
#Set pkgs
pkgs = c("EAlidaR",
         "Rcpp",
         "sf",
         "raster",
         "rayshader",
         "magick",
         "osmdata",
         "av")

#Install pkgs
installed_packages = pkgs %in% rownames(installed.packages())
if (any(installed_packages == FALSE)) {
  install.packages(pkgs[!installed_packages])
}
#Load pkgs
invisible(lapply(pkgs, library, character.only = TRUE))

# Data --------------------------------------------------------------------
#Get lidar data  // XY cordinates from  https://gridreferencefinder.com/

if (file.exists("east_devon.Rds")) {
  east_devon = readRDS("east_devon.Rds")
} else {
  east_devon = get_from_xy(
    xy = c(296675, 088025),
    radius = 1000,
    resolution = 1,
    model_type = 'DSM'
  )

  saveRDS(east_devon, "east_devon.Rds")
}

#Load gpx data from kamoot
p = read_sf("Bike_Ride_14_08_2021_16_52.gpx", layer = "tracks")

p = st_transform(p$geometry,crs = crs(east_devon))

pp = read_sf("Bike_Ride_14_08_2021_16_52.gpx", layer = "track_points") # track points

# Functions ---------------------------------------------------------------

#Convert to coordinate system specified by EPSG code
convert_coords = function(lat, long, from = CRS("+init=epsg:4326"), to) {
  data = data.frame(long = long, lat = lat)
  coordinates(data) = ~ long + lat
  proj4string(data) = from
  xy = data.frame(sp::spTransform(data, to))
  colnames(xy) = c("x", "y")
  return(unlist(xy))
}
#Calculate route points as line
points2line_trajectory = function(p) {
  c = st_coordinates(p)
  i = seq(nrow(p) - 2)
  l = purrr::map(i, ~ sf::st_linestring(c[.x:(.x + 1),]))
  s = purrr::map_dbl(i, function(x) {
    geosphere::distHaversine(c[x,], c[(x + 1),]) /
      as.numeric(p$time[x + 1] - p$time[x])
  })
  lfc = sf::st_sfc(l)
  a = seq(length(lfc)) + 1 # sequence to subset
  p_data = cbind(sf::st_set_geometry(p[a,], NULL), s)
  sf::st_sf(p_data, geometry = lfc)
}

# Main --------------------------------------------------------------------

#Convert data to matrix and small matrix for testing
east_devon_mat = raster_to_matrix(east_devon)
east_devon_small = resize_matrix(east_devon_mat)

# Create Basemap based on lat long range of site --------------------------
lat_range = c(50.536222, 50.899663)
long_range = c(-3.716782, -2.756851)

utm_bbox = convert_coords(lat = lat_range,
                          long = long_range,
                          to = crs(east_devon))

extent_zoomed = extent(utm_bbox[1], utm_bbox[2], utm_bbox[3], utm_bbox[4])
east_devon_zoom = crop(east_devon, extent_zoomed)
east_devon_zoom_mat = raster_to_matrix(east_devon_zoom)

maxcolor = "#e6dbc8"
mincolor = "#b6bba5"
contour_color = "#7d4911"

if (file.exists("basemap.Rds")) {
  basemap = readRDS("basemap.Rds")
} else {
  basemap = east_devon_zoom_mat %>%
    height_shade() %>%
    add_overlay(sphere_shade(
      east_devon_zoom_mat,
      texture = "bw",
      colorintensity = 5
    ),
    alphalayer = 0.5) %>%
    add_shadow(lamb_shade(east_devon_zoom_mat), 0) %>%
    add_shadow(ambient_shade(east_devon_zoom_mat), 0) %>%
    add_shadow(texture_shade(
      east_devon_zoom_mat,
      detail = 8 / 10,
      contrast = 9,
      brightness = 11
    ),
    0.1)
}

#saveRDS(basemap, "basemap.Rds")
#Route overlay
east_devon_lines = st_transform(p, crs = crs(east_devon))

#OS roads overlay
osm_bbox = c(long_range[1], lat_range[1], long_range[2], lat_range[2])
east_devon_highway = opq(osm_bbox) %>%
  add_osm_feature("highway") %>%
  osmdata_sf()

east_devon_roads = st_transform(east_devon_highway$osm_lines, crs = crs(east_devon))

east_devon_footpaths = subset(east_devon_roads,
                       highway == "footway")

east_devon_cyclepaths = subset(east_devon_roads,
                        highway == "cycleway")

east_devon_roads = subset(
  east_devon_roads,
  highway = c(
    "unclassified",
    "secondary",
    "tertiary",
    "residential",
    "service"
  )
)

east_devon_footpaths = st_transform(east_devon_footpaths$geometry, crs = crs(east_devon))
east_devon_roads = st_transform(east_devon_roads$geometry, crs = crs(east_devon))
east_devon_cyclepaths = st_transform(east_devon_cyclepaths$geometry, crs = crs(east_devon))

# Plot map ----------------------------------------------------------------
basemap %>%
  add_overlay(
    generate_line_overlay(
      east_devon_lines,
      extent = extent_zoomed,
      linewidth = 12,
      color = "#2d8a91",
      heightmap = east_devon_zoom_mat
    )
  ) %>%
 plot_map(title_text = "Saturday bike ride", title_offset = c(15,15),
                 title_bar_color = "grey5", title_color = "white", title_bar_alpha = 1)

basemap %>%
  add_overlay(
    generate_line_overlay(
      east_devon_lines,
      extent = extent_zoomed,
      linewidth = 6,
      color = "#2d8a91",
      heightmap = east_devon_zoom_mat
    )
  ) %>%
  plot_3d(east_devon_zoom_mat, windowsize = c(1200, 800))
render_camera(
  theta = 240,
  phi = 30,
  zoom = 0.5,
  fov = 60
)


#################################################
#
# make_figure_5.r    16 FEB 2017
#
# Generates figure 5 in "Priority for the
# worse off and the Social Cost of Carbon". This
# code is meant to be sourced from make_figures.r
# and not necessarily run on its own.
#
#################################################

# Setup the subset parameters for this plot series
run.names <- c("Africa", "US", "Global", "World-Fair")
my.eta.range <- c(0,3)
my.gamma.range <- c(0,3)

# Open a plotting device
outfile <- paste(plotdir, "/figure5.pdf", sep="")
pdf(outfile, width=7, height=5)
par(mfrow=c(2,2))

# Cycle through the appropriate regions
for(i in 1:length(norm.regions)) {

  # Get the run
  this.run <- norm.regions[i]

  # Subset the data
  this.subset <- my.data[which(with(my.data, focusregion == this.run &
                                      eta <= 3.0 & eta >= 0.0 &
                                      gamma <= 3.0 & gamma >= 0.0)),]

  # Generate the OAT plot for this run
  temp.ylims <- matrix(c(0,250,1900,5200,0,1200,0,1200), ncol=2, byrow=T)
  make.oatplot(this.subset, make.legend=T, mar=c(4,4.5,1.5,1)+0.1, this.ylim = temp.ylims[i,])
  mtext(this.run, side=3, line=0.2, cex=1.0, font=2)

  # Put a figure letter on this panel
  put.fig.letter(letters[i], font=2, offset = c(0, -0.01))   # Lowercase

}

# Turn off plotting device
dev.off()


library(stream)
Rcpp::sourceCpp("SWRaster.cpp")

DSC_SWRaster <- function(p=3, m=4, t=5, window_size=3, period_size=500) {

  SWRaster <- SWRasterR$new(p, m, t, window_size, period_size)

  structure(
    list(
      description = "SW-RASTER",
      RObj = SWRaster
    ), class = c("DSC_SWRaster", "DSC_Micro", "DSC_R", "DSC")
  )
}

SWRasterR <- setRefClass("SWRaster", fields = list(
  C ="ANY"
))

SWRasterR$methods(
  initialize = function(precision, min_size, threshold, window_size, period_size){
    ## Exposed C class
    C <<- new(SWRaster, precision, min_size, threshold, window_size, period_size)
    .self
  })

SWRasterR$methods(
  cache = function(){
    stop("SaveDSC not implemented for DSC_BIRCH!")
  })

# CF-Tree insertion: All data objects of a matrix are rowwise inserted into the CF-Tree
SWRasterR$methods(
  cluster = function(newdata) {
    .self$C$cluster(as.matrix(newdata))
  })

# This function returns all micro clusters of a given CF-Tree.
SWRasterR$methods(
  get_microclusters = function() {
    .self$C$get_microclusters()
  }
)

# This function returns all micro cluster weights of a given CF-Tree.
SWRasterR$methods(
  get_microweights = function(){
    .self$C$get_microweights()
  }
)

SWRasterR$methods(
  get_macroclusters = function() {
    .self$C$get_macroclusters()
  }
)

SWRasterR$methods(
  get_macroweights = function(){
    .self$C$get_macroweights()
  }
)

SWRasterR$methods(
  microToMacro = function(micro=NULL, ...){
    .self$C$microToMacro()
  }
)


plots.advice<-
function(wk.dir, f.u, MSY.hr, stock.object, international.landings, tv_results, Exploitation_summary)
{
  f.u <- check.fu (f.u)
  #setwd(wk.dir)

  hist.land <- read.csv(paste0(wk.dir,international.landings), header=T)
  hist.tv <- read.csv(paste0(wk.dir,tv_results), header=T)
  first.disc.yr <-switch(f.u,1990,"fladen"=2000,"jura"=9999)
  first.catch.yr <- min(hist.tv$year)
  last.catch.yr <-stock.object@range["maxyear"]
  hist.land <-subset(hist.land,Year>=first.catch.yr)
  stock.object <-trim(stock.object,year=first.catch.yr:last.catch.yr); attr(stock.object,"bms.n")<- trim(attr(stock.object,"bms.n"),year=first.catch.yr:last.catch.yr)
  tot.wt <-seasonSums(quantSums(unitSums(stock.object@landings.n*stock.object@landings.wt)))
  discards.wt<- seasonSums(quantSums(unitSums(stock.object@discards.n*stock.object@discards.wt)))
  discards.wt[,hist.land$Year<first.disc.yr] <-NA
  raising.factor <-hist.land$Total/tot.wt
  raising.factor[,hist.land$Year>=2011] <-1
  hist.land$discards.tonnes <-round(c(discards.wt*raising.factor),0)

  png(paste0(wk.dir, f.u, "_advice_landings.png"), height=300, width=300/0.55, pointsize=12)
  par(mar=c(3, 4, 2, 1))
  tmp=barplot(rbind(hist.land$Total,hist.land$discards.tonnes)/1000,plot=F, space=1.5)
  with(hist.land, tmp<- barplot(rbind(Total,discards.tonnes)/1000,names=Year, col=c("#9AC2B7","#F15D2A"), axes=F, axisnames = F,
        ylim=c(0,max(hist.land$Total + hist.land$discards.tonnes,na.rm=T)*1.1/1000), space=1.5))
  legend("topright", legend=c("Discards","Landings"), fill=c("#F15D2A","#9AC2B7"),  inset=0.01, bty="n", ncol=2)
  axis(1, at=tmp[seq(1,length(tmp),by=5)], labels=hist.land$Year[seq(1,length(tmp),by=5)])
  axis(2)
  title(ylab="1000 tonnes")
  title("Catches", cex.main=0.9,line=0.5)
  box()
  dev.off()

##########################################################
#UW tv survey
##########################################################

  tv.series <-data.frame(year=hist.tv$year)
  first.ci.year <-min(tv.series$year)
  tv.series$abundance <-hist.tv$abundance
  tv.series$confidence.interval <-hist.tv$confidence.interval
 	tv.series$upper <- with(tv.series, abundance+confidence.interval)
	tv.series$lower <- with(tv.series, abundance-confidence.interval)
	trigger <-min(tv.series$abundance[tv.series$year<2010],na.rm=TRUE)
  if (f.u == "jura"){trigger <- -100}

	png(paste0(wk.dir, f.u, "_advice_tv.png"), height=300, width=300/0.55, pointsize=12)
	par(mar=c(3, 4, 2, 1))
  with(tv.series, plot(year,abundance, type="l", lty=1, lwd=3,xlab="", ylab="", axes=F,ylim=c(0,max(upper,na.rm=T)*1.05)))
  with(tv.series, lines(year,upper, type="l", lty=3, lwd=2))
  with(tv.series, lines(year,lower, type="l", lty=3, lwd=2))
  axis(1, at=tv.series$year[seq(1,length(tv.series$year),by=5)])
  axis(2)
  title(ylab="Abundance (millions)")
  title("Stock size index - abundance", cex.main=0.9,line=0.5)
  box()
	abline(h=trigger, lty=3, col="#EB6B14" ,lwd=3)
	dev.off()

##########################################################
#Harvest rates
##########################################################
	png(paste0(wk.dir, f.u, "_advice_HR.png"), height=300, width=300/0.55, pointsize=12)
	par(mar=c(3, 4, 2, 1))
  HRs <- read.csv(paste0(wk.dir, Exploitation_summary), header=T)

  with(HRs, plot(harvest.ratio~year, type="l",cex=1,bty="l",
        ylim=c(0, max(harvest.ratio,MSY.hr+1,na.rm=T)), lwd=1.5,axes=F,xlab="",ylab=""))
  axis(1, at=HRs$year[seq(1,length(HRs$year),by=5)])
  axis(2)
  title(ylab="Harvest Rate (%)")
  title("Harvest Rate", cex.main=0.9,line=0.6)
  box()
  abline(h=MSY.hr,lty=3,col="#F7A487",lwd=3)
  dev.off()
}


### class ######################################################################

validFLOPtrigger.control <- function(object){
    if (object@first.year<0 | object@last.year<0 | object@first.year > object@last.year) return(paste("value of first.year:",object@first.year, "or last.year",object@last.year, "is wrong"))
    if (object@last.year<object@first.year) return("last.year must be >= first.year")
    # Everything is fine
    return(TRUE)
}

setClass("FLOPtrigger.control",
    representation(
        first.year           ="numeric",
        last.year            ="numeric",
        first.run.no         ="numeric",
        first.iter.no        ="numeric",
        no.iter              ="numeric",
        HCR                  ="matrix",
        trigger               ="matrix",
        Ftarget              ="matrix",
        Fslope               ="matrix",
        SSB50                ="matrix",
        S1                   ="matrix",
        SSBpenalty           ="matrix",
        weighting            ="matrix",
        at.age.weighting     ="numeric"
 )
  ,
  prototype=prototype(
        first.year          =2020,
        last.year           =2030,
        first.run.no        =1,
        first.iter.no        =1,
        no.iter             =1,
        HCR                 =matrix(1,ncol=1,nrow=1,dimnames=list(c("HCR"),c("sp1"))),
        trigger             =matrix(1,ncol=1,nrow=2,dimnames=list(c("T1","T2"),c("sp1"))),
        Ftarget             =matrix(1,ncol=1,nrow=4,dimnames=list(c("lower","higher","init","phase"),c("sp1"))),
        Fslope              =matrix(1,ncol=1,nrow=4,dimnames=list(c("lower","higher","init","phase"),c("sp1"))),
        SSB50               =matrix(1,ncol=1,nrow=4,dimnames=list(c("lower","higher","init","phase"),c("sp1"))),
        S1                  =matrix(1,ncol=1,nrow=4,dimnames=list(c("lower","higher","init","phase"),c("sp1"))),
        SSBpenalty          =matrix(1,ncol=1,nrow=4,dimnames=list(c("use","SSB50","SSB75","factor"),c("sp1"))),
        weighting           =matrix(1,ncol=1,nrow=1,dimnames=list(c("weight"),c("sp1"))),
        at.age.weighting    =0)
        ,
    validity=validFLOPtrigger.control
)
setValidity("FLOPtrigger.control", validFLOPtrigger.control)

validFLOP.control <- function(object){
    valid.test.output<-c(0,1,2,3,4,11,12,13,19,51,52,53)
    if (!(object@test.output %in% valid.test.output)) return(paste("value of test.ouput must have a value in:", valid.test.output))
    if (object@first.year<0 | object@last.year<0 | object@first.year > object@last.year) return(paste("value of first.year:",object@first.year, "or last.year",object@last.year, "is wrong"))
    if (object@last.year<object@first.year) return("last.year.model must be >= first.year")

    # Everything is fine
    return(TRUE)
}

setClass("FLOP.control",
    representation(
        test.output          ="numeric",
        output               ="numeric",
        indicator            ="numeric",
        first.year           ="numeric",
        first.year.out       ="numeric",
        last.year            ="numeric",
        years.wsea           ="matrix",
        years.M              ="matrix",
        years.propmat        ="matrix",
        years.F              ="matrix",
        years.weca           ="matrix",
        years.prop.landed    ="matrix",
        years.stock.distrib  ="matrix",
        years.ration         ="matrix",
        species.names        ="vector",
        growth.model         ="matrix",
     stochastic.recruitment  ="matrix",
        rec.noise            ="matrix",
        recruit.adjust       ="matrix",
        recruit.adjust.CV    ="matrix",
        F.or.C               ="matrix",
        M2.iterations        ="numeric",
        max.M2.sum2          ="numeric",
        years.other          ="matrix",
        other.predator       ="matrix"
  )
  ,
  prototype=prototype(
        test.output         =0,
        output              =0,
        indicator           =0,
        first.year          =1900,
        first.year.out      =1900,
        last.year           =1901,
        years.wsea           =matrix(0,ncol=1,nrow=2,dimnames=list(c("first-year","last-year"),c("sp1"))),
        years.M              =matrix(0,ncol=1,nrow=2,dimnames=list(c("first-year","last-year"),c("sp1"))),
        years.propmat        =matrix(0,ncol=1,nrow=2,dimnames=list(c("first-year","last-year"),c("sp1"))),
        years.F              =matrix(0,ncol=1,nrow=2,dimnames=list(c("first-year","last-year"),c("sp1"))),
        years.weca           =matrix(0,ncol=1,nrow=2,dimnames=list(c("first-year","last-year"),c("sp1"))),
        years.prop.landed    =matrix(0,ncol=1,nrow=2,dimnames=list(c("first-year","last-year"),c("sp1"))),
        years.stock.distrib  =matrix(0,ncol=1,nrow=2,dimnames=list(c("first-year","last-year"),c("sp1"))),
        years.ration         =matrix(0,ncol=1,nrow=2,dimnames=list(c("first-year","last-year"),c("sp1"))),
        species.names        =as.vector("sp1",mode="character"),
        growth.model         =matrix(0,ncol=1,nrow=5,dimnames=list(c("Type","first.age","last.age","add.info1","add.info2"),c("sp1"))),
     stochastic.recruitment  =matrix(1,ncol=1,nrow=1,dimnames=list(" ",c("sp1"))),
        rec.noise           =matrix(rep(c(-10,10),1),ncol=1,nrow=2,dimnames=list(c("lower","upper"),c("sp1"))),
        recruit.adjust      =matrix(1,ncol=1,nrow=1,dimnames=list(" ",c("sp1"))),
        recruit.adjust.CV   =matrix(0,ncol=1,nrow=1,dimnames=list(" ",c("sp1"))),
        F.or.C              =matrix(11,ncol=1,nrow=1,dimnames=list(" ",c("sp1"))),
        M2.iterations       =5,
        max.M2.sum2         =0.0,
        years.other         =matrix(0,ncol=1,nrow=2,dimnames=list(c("first-year","last-year"),c("sp1"))),
        other.predator      =matrix(-1,ncol=1,nrow=3,dimnames=list(c("factor","first","second"),c("sp1")))
        )
        ,
    validity=validFLOP.control
)

setValidity("FLOP.control", validFLOP.control)

# in final version remove(validOP.control)  # We do not need this function any more
### End class ###########################################################

### Methods #############################################################

FLOPtrigger.control <- function(
        first.year=1900,
        last.year=first.year+1,
        first.VPA=1,
        no.species=1,
        ref=Read.reference.points())
  {
        ref<-ref[first.VPA:(first.VPA+no.species-1),]
        ref[,'Bpa']<-ref[,'Bpa']/1000
        ref[,'Blim']<-ref[,'Blim']/1000
        species.names<-dimnames(ref)[[1]]

        res <- new("FLOPtrigger.control",
            first.year          =as.integer(first.year),
            first.year.out      =as.integer(first.year),
            last.year           =as.integer(last.year),
            first.run.no        =as.integer(1),
            first.iter.no        =as.integer(1),
            no.iter             =as.integer(1),
            HCR                 =matrix(1,ncol=no.species,nrow=1,dimnames=list(c("HCR"),species.names)),
            trigger             =matrix(c(ref[,'Blim'],ref[,'Bpa']),ncol=no.species,nrow=2,byrow=T,dimnames=list(c("T1","T2"),species.names)),
            Ftarget             =matrix(c(rep(0,no.species),ref[,'Fpa'],ref[,'Fpa']*0.5,rep(1,no.species)),               ncol=no.species,nrow=4,byrow=T,dimnames=list(c("lower","higher","init","phase"),species.names)),
            Fslope              =matrix(c(rep(0,no.species),rep(1e-3,no.species),rep(0,no.species),rep(1,no.species)),    ncol=no.species,nrow=4,byrow=T,dimnames=list(c("lower","higher","init","phase"),species.names)),
            SSB50               =matrix(c(ref[,'Blim']*0.5,ref[,'Bpa'],ref[,'Blim'],rep(1,no.species)),                   ncol=no.species,nrow=4,byrow=T,dimnames=list(c("lower","higher","init","phase"),species.names)),
            S1                  =matrix(c(ref[,'Blim']/100,ref[,'Blim']/10,ref[,'Blim']/50,rep(1,no.species)),            ncol=no.species,nrow=4,byrow=T,dimnames=list(c("lower","higher","init","phase"),species.names)),
            SSBpenalty          =matrix(c(rep(1,no.species),ref[,'Blim']*1000,rep(10,no.species),rep(10000,no.species)),       ncol=no.species,nrow=4,byrow=T,dimnames=list(c("use","SSB50","SSB75","factor"),species.names)),
            weighting           =matrix(1,ncol=no.species,nrow=1,dimnames=list(c("weight"),species.names)),
            at.age.weighting    =as.integer(0)
         )

    return(res)
 }

###

FLOP.control <- function(
        FLOP=NULL,
        first.year=1900,
        first.year.out=1900,
        last.year=first.year+1,

        no.species=1,
        no.VPA.predators=0,
        no.other.predators=0,
        species.names=c("sp1"),
        first.age=0,
        max.age.all=10)
  {
    if (is.null(FLOP)){
        if (no.species == 1) {
           no.VPA.sp<-no.species
           no.predators<-0
           no.other.predators<-0
        }
        if (no.species>1) {
          if (no.other.predators>=no.species) stop("no.other.predators cannot be larger than no.species")
          no.VPA.sp<-no.species-no.other.predators
          no.predators<-no.other.predators+no.VPA.predators
        }
        #print(no.predators);  print(no.other.predators)  ; print(no.VPA.predators)

        if (species.names[1] != c("sp1") & length(species.names)!=no.species)
              stop("no.species is different from number of species names")
        VPA.species.names<-species.names[(no.other.predators+1):no.species]

        species.info<-matrix(0,ncol=5,nrow=no.species,dimnames=list(species.names,c("last-age","first-age F>0","+group","predator","prey")))
        species.info[,1]<-max.age.all
        species.info[,2]<-first.age
        species.info[,3]<-1
        species.info[,4]<-c(rep(1,no.predators),rep(0,no.VPA.sp-no.VPA.predators))
        species.info[,5]<-c(rep(0,no.other.predators),rep(1,no.VPA.sp))
        if (no.other.predators==0) oth.sp.names<-NULL
        else oth.sp.names<-species.names[1:no.other.predators]

        if (no.other.predators==0) lab.oth.sp<-'dummy' else lab.oth.sp <-oth.sp.names
        res <- new("FLOP.control",
            test.output         =as.integer(0),
            output              =as.integer(15),
            indicator           =as.integer(0),
            first.year          =as.integer(last.year+1),
            first.year.out      =as.integer(last.year+1),
            last.year           =as.integer(last.year+30),
            years.wsea          =matrix(rep(last.year-1,2*no.species),ncol=no.species,nrow=2,dimnames=list(c("first-year","last-year"),species.names)),
            years.M             =matrix(rep(last.year-1,2*no.VPA.sp),ncol=no.VPA.sp,nrow=2,dimnames=list(c("first-year","last-year"),VPA.species.names)),
            years.propmat       =matrix(rep(last.year-1,2*no.VPA.sp),ncol=no.VPA.sp,nrow=2,dimnames=list(c("first-year","last-year"),VPA.species.names)),
            years.F             =matrix(rep(last.year-1,2*no.VPA.sp),ncol=no.VPA.sp,nrow=2,dimnames=list(c("first-year","last-year"),VPA.species.names)),
            years.weca          =matrix(rep(last.year-1,2*no.VPA.sp),ncol=no.VPA.sp,nrow=2,dimnames=list(c("first-year","last-year"),VPA.species.names)),
            years.prop.landed   =matrix(rep(last.year-1,2*no.VPA.sp),ncol=no.VPA.sp,nrow=2,dimnames=list(c("first-year","last-year"),VPA.species.names)),
            years.stock.distrib =matrix(rep(last.year-1,2*no.VPA.sp),ncol=no.VPA.sp,nrow=2,dimnames=list(c("first-year","last-year"),VPA.species.names)),
            years.ration        =matrix(rep(last.year-1,2*no.predators),ncol=no.predators,nrow=2,dimnames=list(c("first-year","last-year"),species.names[1:no.predators])),
            species.names=species.names,
            growth.model         =matrix(0,ncol=no.VPA.sp,nrow=5,dimnames=list(c("Type","first.age","last.age","add.info1","add.info2"),VPA.species.names)),
        stochastic.recruitment  =matrix(1,ncol=no.VPA.sp,nrow=1,dimnames=list(" ",VPA.species.names)),
            rec.noise           =matrix(rep(c(-2 ,2),no.VPA.sp),ncol=no.VPA.sp,nrow=2,dimnames=list(c("lower","upper"),VPA.species.names)),
            recruit.adjust      =matrix(1,ncol=no.VPA.sp,nrow=1,dimnames=list(" ",c(VPA.species.names))),
            recruit.adjust.CV   =matrix(0,ncol=no.VPA.sp,nrow=1,dimnames=list(" ",c(VPA.species.names))),
            F.or.C              =matrix(11,ncol=no.VPA.sp,nrow=1,dimnames=list(" ",c(VPA.species.names))),
            M2.iterations       =as.integer(3),
            max.M2.sum2         =0.0,
            years.other         =matrix(rep(last.year-1,2*max(1,no.other.predators)),ncol=max(1,no.other.predators),nrow=2 ,dimnames=list(c("first-year","last-year"),lab.oth.sp)),
           other.predator       =matrix(rep(c(1,-1,-1),1),ncol=max(1,no.other.predators),nrow=3,dimnames=list(c("factor","first","second"),lab.oth.sp))
          )

    }
    else {  # We re-use an FLOP.control object
            if (!inherits(FLOP, "FLOP"))
                stop("FLOP must be an 'FLOP' object!")

            res <- FLOP@control

           # ... and possibly redefine some of its parameters
       if (!missing(test.output))  res@test.output <- test.output
       if (!missing(first.year))  res@first.year <- first.year
       if (!missing(last.year))  res@last.year <- last.year
         # Verify that this object is valid
        test <- validObject(res)

        if (!test) stop("Invalid object:", test)
        }

    return(res)
 }

###
write.FLOPtrigger.control<-function(control,file="op_trigger.dat",path=NULL,nice=TRUE,writeSpNames=T) {

  wr.matrix<-function(m,text){
    cat("# ",text,"\n",file=file,append=TRUE)
    for (j in (1:dim(m)[1])) cat(m[j,],"\n",file=file,append=TRUE)
  }

  wr.matrix.nice<-function(m,sp){
   cat("#",formatC(sp,width=11),"\n",file=file,append=TRUE)
    for (j in (1:dim(m)[1])) cat(formatC(m[j,],width=11),"\n",file=file,append=TRUE)
  }

  if (!inherits(control, "FLOPtrigger.control"))
        stop(paste("control" ,"must be an 'FLOPtrigger.contol' object!"))

  old.path<-getwd()
  if (!is.null(path)) setwd(path)
  sepLine<-"########################################\n"

   sp.names<-dimnames(slot(control,"HCR"))[[2]]
  cat("#options and data for optimationzation\n",file=file)
  cat('# the character "#" is used as comment character, such that all text and numbers after # are skipped\n#\n',file=file, append=TRUE)

  n.<-slotNames(control)
  for (x in n.) {
      switch(x,
        "first.year"       ={if (nice) {
                                 cat(sepLine,file=file,append=T)
                                 cat("## first year of input data (option first.year)\n",
                                    slot(control,x),"\n",file=file,append=T,sep="")
                              } else  cat(slot(control,x),"\t#",x,"\n",file=file,append=TRUE)
                             },

        "last.year"       ={if (nice) {
                                cat("## last year (option last.year)\n",
                                    slot(control,x),"\n",file=file,append=T,sep="")
                              } else  cat(slot(control,x),"\t#",x,"\n",file=file,append=TRUE)
                             },
        "first.run.no"       ={if (nice) {
                                cat(sepLine,file=file,append=T)
                                cat("## First run number (option first.run.no). Default=1\n",
                                    slot(control,x),"\n",file=file,append=T,sep="")
                              } else  cat(slot(control,x),"\t#",x,"\n",file=file,append=TRUE)
                             },
         "first.iter.no"       ={if (nice) {
                                cat(sepLine,file=file,append=T)
                                cat("## First iteration number (option first.iter.no). Default=1\n",
                                    slot(control,x),"\n",file=file,append=T,sep="")
                              } else  cat(slot(control,x),"\t#",x,"\n",file=file,append=TRUE)
                             },

        "no.iter"       ={if (nice) {
                                cat(sepLine,file=file,append=T)
                                cat("## number of iterations (option no.iter)\n",
                                    slot(control,x),"\n",file=file,append=T,sep="")
                              } else  cat(slot(control,x),"\t#",x,"\n",file=file,append=TRUE)
                             },

       "HCR"               ={if (nice) {
                                cat(sepLine,file=file,append=T)
                                cat("# HCR by species\n",
                                    "# 1: Target F\n",
                                    "#      F=Ftarget\n",
                                    "# 2: Target F, and known trigger T1 and T2\n",
                                    "#      F=0                        for     SSB<T1\n",
                                    "#      F=Ftarget*(SSB-T1)/(T2-T1) for  T1<SSB<T2\n",
                                    "#      F=Ftarget                  for  T2<SSB\n",
                                    "# 3: Target F and Fslope, and known trigger T1 and T2\n",
                                    "#      F=0                          for     SSB<T1\n",
                                    "#      F=Ftarget*(SSB-T1)/(T2-T1)   for  T1<SSB<T2\n",
                                    "#      F=Ftarget+(SSB-T2)/T2*Fslope for  T2<SSB\n",
                                    "#  4: Logistic curve\n",
                                    "#      F=Ftarget / (1+exp(S1 - S1/SSB50%*SSB)\n",
                                    "#  22, 33 and 44 is the same rule as 2,3 and 4 but TSB is used\n",file=file,append=T,sep="")
                                   wr.matrix.nice(slot(control,x),sp.names)
                                } else wr.matrix(slot(control,x),x)
                             },

       "trigger"            ={if (nice) {
                                cat(sepLine,file=file,append=T)
                                cat("# T1 and T2 trigger by species\n",file=file,append=T,sep="")
                                   wr.matrix.nice(slot(control,x),sp.names)
                                } else wr.matrix(slot(control,x),x)
                              },

       "Ftarget"            ={if (nice) {
                                cat(sepLine,file=file,append=T)
                                cat("# Values for Ftarget\n",
                                    "# 1) lower limit, 2) higher limit, 3) initialization, 4) estimation phase\n",file=file,append=T,sep="")
                                   wr.matrix.nice(slot(control,x),sp.names)
                                } else wr.matrix(slot(control,x),x)
                              },
       "Fslope"            ={if (nice) {
                                cat(sepLine,file=file,append=T)
                                cat("# Values for Fslope\n",
                                    "# 1) lower limit, 2) higher limit, 3) initialization, 4) estimation phase\n",file=file,append=T,sep="")
                                   wr.matrix.nice(slot(control,x),sp.names)
                                } else wr.matrix(slot(control,x),x)
                              },
       "SSB50"            ={if (nice) {
                                cat(sepLine,file=file,append=T)
                                cat("# Values for logistic curve, SSB50% of Ftarget (HCR=4)\n",
                                "# 1) lower limit of SSB50% in 1000 tonnes , 2) higher limit, 3) initialization, 4) estimation phase\n",file=file,append=T,sep="")
                                   wr.matrix.nice(slot(control,x),sp.names)
                                } else wr.matrix(slot(control,x),x)
                              },
       "S1"            ={if (nice) {
                                cat(sepLine,file=file,append=T)
                                cat("# Values for logistic curve, S1 (HCR=4)\n",
                                "# 1) lower limit of S1 in 1000 tonnes , 2) higher limit, 3) initialization, 4) estimation phase\n",file=file,append=T,sep="")
                                   wr.matrix.nice(slot(control,x),sp.names)
                                } else wr.matrix(slot(control,x),x)
                              },
       "SSBpenalty"     ={if (nice) {
                                cat(sepLine,file=file,append=T)
                                cat("# Values for penalty function for SSB below limit (HCR=4)\n",
                                "# 1) use penalty 0=no, 1=logistic, 2=simple power function \n# 2) limit (SSB50%), 3) steepnes (SSB75%), 4) factor\n",file=file,append=T,sep="")
                                   wr.matrix.nice(slot(control,x),sp.names)
                                } else wr.matrix(slot(control,x),x)
                              },
   "weighting"            ={if (nice) {
                                cat(sepLine,file=file,append=T)
                                cat("# relative weighting (e.g. price/kg, all sizes combined) of yield used in objective function\n",file=file,append=T,sep="")
                                   wr.matrix.nice(slot(control,x),sp.names)
                                } else wr.matrix(slot(control,x),x)
                              },

   "at.age.weighting"          ={if (nice) {
                                cat(sepLine,file=file,append=TRUE)
                                cat("# use weighting factor by age (e.g. price) from file op_price.in\n",
                                    "# 0=no use; 1=use\n",
                                slot(control,x),"\n",file=file,append=T,sep="")
                              }
                              else  cat(slot(control,x),"\t#",x,"\n",file=file,append=TRUE)
                             }
   )  #end switch
  }

 setwd(old.path)
}

#####

write.FLOP.control<-function(control,file="op.dat",path=NULL,nice=TRUE,writeSpNames=F) {

  if (!inherits(control, "FLOP.control")) stop(paste("control" ,"must be an 'FLOP.contol' object!\n"))

    wr.matrix<-function(m,text){
    cat("# ",text,"\n",file=file,append=TRUE)
    for (j in (1:dim(m)[1])) cat(m[j,],"\n",file=file,append=TRUE)
  }

  wr.matrix.nice<-function(m,sp){
   cat("#",formatC(sp,width=11),"\n",file=file,append=TRUE)
    for (j in (1:dim(m)[1])) cat(formatC(m[j,],width=11),"\n",file=file,append=TRUE)
  }

  wr.vector.nice<-function(m,sp){
    cat("# ",formatC(sp,width=11),"\n  ",formatC(m,width=11),"\n",file=file,append=TRUE)
  }

  wr.list<-function(l,text1,text2){
    for (j in 1:length(l)) cat(length(l[[j]])," ",file=file,append=TRUE)
    cat("\t#",text1,"\n# ",text2,"\n",file=file,append=TRUE)
    for (j in 1:length(l)) cat(l[[j]],"\n",file=file,append=TRUE)
   }

  wr.list.nice<-function(l,text1,text2,sp){
    cat("#",text1,"\n#",formatC(sp,width=11),"\n",file=file,append=TRUE)
    for (j in 1:length(l)) cat(formatC(length(l[[j]]),width=12),file=file,append=TRUE)
    cat("\n# ",text2,"\n",file=file,append=TRUE)
    for (j in 1:length(l)) cat(l[[j]],"\t# ",sp[j],"\n",file=file,append=TRUE)
   }

  wr.list2<-function(l,text1,text2){
    for (j in 1:length(l)) {
       ifelse(l[[j]]==0, out<-0,out<-length(l[[j]]))
       cat(out," ",file=file,append=TRUE)
    }
    cat("\t#",text1,"\n# ",text2,"\n",file=file,append=TRUE)
    for (j in 1:length(l)) cat(l[[j]],"\n",file=file,append=TRUE)
   }
  wr.list2.nice<-function(l,text1,text2,sp){
    cat("#",text1,"\n#",formatC(sp,width=11),"\n",file=file,append=TRUE)
    for (j in 1:length(l)) {
       ifelse(l[[j]]==0, out<-0,out<-length(l[[j]]))
       cat(formatC(out,width=12),file=file,append=TRUE)
    }
    cat("\n# ",text2,"\n",file=file,append=TRUE)
    for (j in 1:length(l)) cat(l[[j]],"\t# ",sp[j],"\n",file=file,append=TRUE)
   }

  old.path<-getwd()
  if (!is.null(path)) setwd(path)
  sepLine<-"########################################\n"
  last.pred<-1
  sp.names<-slot(control,"species.names")
  nsp<<-length(sp.names)
  n.VPA<-dim(control@rec.noise)[[2]]
  n.other.pred<-nsp-n.VPA

  VPA.species<-sp.names[(n.other.pred+1):nsp]

  cat("# op.dat option file\n",file=file)
  cat('# the character "#" is used as comment character, such that all text and numbers after # are skipped\n#\n',file=file, append=TRUE)
  n.<-slotNames(control)
  for (x in n.) {
      switch(x,
        "test.output"        ={ if (nice)  {
                                cat(sepLine,file=file,append=TRUE)
                                cat("# Produce TEST output (option test.output)\n",
                                    "#  0 no test output\n",
                                    "#  1 output file op.dat  as read in\n",
                                    "#  2 output op_config.in as read in\n",
                                    "#  3 output all data files as read in\n",
                                    "#  4 output file op_trigger.in as read in\n",
                                    slot(control,x),"\n",file=file,append=T,sep="")
                              }
                              else  cat(slot(control,x),"\t#",x,"\n",file=file,append=TRUE)
                            },
       "output"             ={ if (nice)  {
                                cat(sepLine,file=file,append=TRUE)
                                cat("# Produce output (option output)\n",
                                    "# 10 stock N by year and age (file op_n.out) \n",
                                    "# 11 as 10 plus output by year and age (file op_summary_anno.out) \n",
                                    "# 12 as 10 plus output by Year, quarter, areas and age (file op_summary.out)\n",
                                    "# 13 condensed output (file op_condensed.out)\n",
                                    "# 14 condensed from F-combinations (file op_Fcombinations.out)\n",
                                    "# 15 10 + 11 + 12 + 13\n",
                                    slot(control,x),"\n",file=file,append=T,sep="")
                              }
                              else  cat(slot(control,x),"\t#",x,"\n",file=file,append=TRUE)
                             },
       "indicator"             ={ if (nice)  {
                                cat(sepLine,file=file,append=TRUE)
                                cat("# Produce output MSFD indicator output, defined from file op_msfd.dat (option indicator)\n",
                                    "# 0=no, 1=yes \n",
                                    slot(control,x),"\n",file=file,append=T,sep="")
                              }
                              else  cat(slot(control,x),"\t#",x,"\n",file=file,append=TRUE)
                             },
        "first.year"       ={if (nice) {
                                 cat(sepLine,file=file,append=T)
                                 cat("## first year of input data (option first.year)\n",
                                    slot(control,x),"\n",file=file,append=T,sep="")
                              } else  cat(slot(control,x),"\t#",x,"\n",file=file,append=TRUE)
                             },
        "first.year.out"       ={if (nice) {
                                 cat(sepLine,file=file,append=T)
                                 cat("## first year for output data (option first.year.out)\n",
                                    slot(control,x),"\n",file=file,append=T,sep="")
                              } else  cat(slot(control,x),"\t#",x,"\n",file=file,append=TRUE)
                             },
        "last.year"       ={if (nice) {
                                cat(sepLine,file=file,append=T)
                                cat("## last year (option last.year)\n",
                                    slot(control,x),"\n",file=file,append=T,sep="")
                              } else  cat(slot(control,x),"\t#",x,"\n",file=file,append=TRUE)
                             },
       "years.wsea"          ={if (nice) {
                                cat(sepLine,file=file,append=T)
                                cat("# first and last year for calculation of mean weight in the sea (file op_wsea.in) \n",file=file,append=T,sep="")
                                   wr.matrix.nice(slot(control,x),sp.names)
                                } else wr.matrix(slot(control,x),x)
                             },
       "years.M"            ={if (nice) {
                                cat(sepLine,file=file,append=T)
                                cat("# first and last year for calculation of natural mortalities (file op_m.in & op_m1.in)\n",file=file,append=T,sep="")
                                   wr.matrix.nice(slot(control,x),VPA.species)
                                } else wr.matrix(slot(control,x),x)
                              },
     "years.propmat"        ={if (nice) {
                                cat(sepLine,file=file,append=T)
                                cat("# first and last year for calculation of proportion mature (file op_propmat.in)\n",file=file,append=T,sep="")
                                   wr.matrix.nice(slot(control,x),VPA.species)
                                } else wr.matrix(slot(control,x),x)
                              },
       "years.F"            ={if (nice) {
                                cat(sepLine,file=file,append=T)
                                cat("# first and last year for calculation of F at age and exploitation pattern in the catch (file op_f.in & op_exploitation.in)\n",file=file,append=T,sep="")
                                   wr.matrix.nice(slot(control,x),VPA.species)
                                } else wr.matrix(slot(control,x),x)
                              },
      "years.weca"          ={if (nice) {
                                cat(sepLine,file=file,append=T)
                                cat("# first and last year for calculation of mean weight in the catch file op_wcatch.in)\n",file=file,append=T,sep="")
                                   wr.matrix.nice(slot(control,x),VPA.species)
                                } else wr.matrix(slot(control,x),x)
                             },
      "years.prop.landed"   ={if (nice) {
                                cat(sepLine,file=file,append=T)
                                cat("# first and last year for calculation of proportion landed of the catch (file op_prop_landed.in)\n",file=file,append=T,sep="")
                                   wr.matrix.nice(slot(control,x),VPA.species)
                                } else wr.matrix(slot(control,x),x)
                             },
     "years.stock.distrib"    ={if (nice) {
                                cat(sepLine,file=file,append=T)
                                cat("# first and last year for calculation of stock distribution (file op_stock_distribution.in)\n",file=file,append=T,sep="")
                                   wr.matrix.nice(slot(control,x),VPA.species)
                                } else wr.matrix(slot(control,x),x)
                             },
     "years.ration"          ={if (nice) {
                                cat(sepLine,file=file,append=T)
                                cat("# first and last year for calculation of food ration (file op_consum.in)\n",file=file,append=T,sep="")
                                   wr.matrix.nice(slot(control,x),dimnames(slot(control,x))[[2]])
                                } else wr.matrix(slot(control,x),x)
                             },
     "species.names"      ={ cat(sepLine,file=file,append=T)
                               cat("# Species names, for information only. See file species_names.in \n# ",sp.names,"\n",file=file,append=T)
                              },
     "growth.model"          ={if (nice) {
                                cat(sepLine,file=file,append=T)
                                cat("# Growth model:\n",
                                    "#   1  : Type  0=no growth;  1=density dependent, 10=Saithe special (Xochitl Cormon)\n",
                                    "#   2-3: First and last age for growth\n",
                                    "#   4-5: Additional info1 and info2 \n",file=file,append=T,sep="")
                                   wr.matrix.nice(slot(control,x),VPA.species)
                                } else wr.matrix(slot(control,x),x)
                             },
  "stochastic.recruitment" ={if (nice) {
                                cat(sepLine,file=file,append=T)
                                cat("# Stochastic recruitment.\n",
                                    "# 0=No,   S-R parameters from op_config.dat\n",
                                    "# 1=Yes   S-R parameters and variance from op_config.dat\n",
                                    "# 2=Yes,  S-R parameters from op_config.dat and variance-covariance matrix from file covariance_Rec.in\n",
                                    "# 3=Yes,  S-R parameters from op_config.dat and residuals from op_ssb_rec_residuals.in\n",
                                    "# 20=No,  S-R parameters from EquiSim results, file op_eqsim.in\n",
                                    "# 21=Yes, S-R parameters from EquiSim results, file op_eqsim_stoch.in\n",file=file,append=T,sep="")
                                   wr.matrix.nice(slot(control,x),VPA.species)
                                } else wr.matrix(slot(control,x),x)
                             },
       "rec.noise"        ={if (nice) {
                                cat(sepLine,file=file,append=T)
                                cat("# truncation of standardised normal distribution used to produce noise on recruitment\n",
                                    "# lower and upper   (values -15.0 and 15.0 give no truncation, -2 and 2 give approximately 95% of the distribution)\n",file=file,append=T,sep="")
                                   wr.matrix.nice(slot(control,x),VPA.species)
                                } else wr.matrix(slot(control,x),x)
                             },
       "recruit.adjust"  ={if (nice) {
                                cat(sepLine,file=file,append=T)
                                cat("# factor to adjust expected recruits (option adjust.recruits)\n",file=file,append=T,sep="")
                                    wr.matrix.nice(slot(control,x),VPA.species)
                                } else wr.matrix(slot(control,x),x)
                             },
      "recruit.adjust.CV"  ={if (nice) {
                                cat(sepLine,file=file,append=T)
                                cat("# adjust recruitment with half of the variance (factor exp(-(CV^2)/2) option adjust.recruit.CV\n",
                                    "# 0=no adjustment\n",
                                    "# 1=stochastic recruitment, do adjustment such that average recruitment becomes equal to the median (downward adjustment)\n",
                                    "# 2=determenistic recruitment, do ajustment such that recruitment becomes equal to the mean of the log-normal distribution (upward adjustment)\n", file=file,append=T,sep="")
                                    wr.matrix.nice(slot(control,x),VPA.species)
                                } else wr.matrix(slot(control,x),x)
                             },
      "F.or.C"              ={if (nice) {
                                cat(sepLine,file=file,append=T)
                                cat("# Update N by:\n",
                                    "#     1=F at age or 2=Catch at age (option F.or.C)\n",
                                    "#    11=as 1 but re-use input F, 22=as 2 but re-use catch\n",
                                    "#    31= as 1 but get values from file op_mulTargetf.in\n",file=file,append=T,sep="")
                                    wr.matrix.nice(slot(control,x),VPA.species)
                                } else wr.matrix(slot(control,x),x)
                             },
        "M2.iterations"   = {if (nice)  {
                                cat(sepLine,file=file,append=TRUE)
                                cat("## Maximum M2 iterations (option M2.iterations)\n",
                                slot(control,x),"\n",file=file,append=T,sep="")
                              }
                              else  cat(slot(control,x),"\t#",x,"\n",file=file,append=TRUE)
                             },
        "max.M2.sum2"      = {if (nice)  {
                                cat(sepLine,file=file,append=TRUE)
                                cat("## convergence criteria (option max.M2.sum2)\n",
                                    "#  use max.M2.sum2=0.0 and M2.iterations=7 (or another high number) to make Hessian\n",
                                slot(control,x),"\n",file=file,append=T,sep="")
                              }
                              else  cat(slot(control,x),"\t#",x,"\n",file=file,append=TRUE)
                             },
        "years.other"          ={if (nice) {
                                cat(sepLine,file=file,append=T)
                                cat("# first and last year for calculation of mean stock numbers of other predators (file op_other_n.in) \n",file=file,append=T,sep="")
                                   wr.matrix.nice(slot(control,x),sp.names[1:(first.VPA-1)])
                                } else wr.matrix(slot(control,x),x)
                             },

        "other.predator"  ={if (nice) {
                                cat(sepLine,file=file,append=T)
                                cat("#### %%%%%%%%%%%%% various for other predators %%%%%%%%%%%%%%%%%%% ###\n",
                                    "# annual change factor for population number\n",
                                    "# first year (relative to first prediction year) year of change  (-1 is no change)\n",
                                    "# last year (relative to first prediction year) of change (-1 is no change)\n",
                                    "# other predator stock numbers  \n",file=file,append=T,sep="")
                                    wr.matrix.nice(slot(control,x),sp.names[1:(first.VPA-1)])
                                } else wr.matrix(slot(control,x),x)
                             }
        #other wise
                              # cat(slot(control,x),"\t#",x,"\n",file=file,append=TRUE)
   )  #end switch
  }

  if (writeSpNames) {
      sp.names<-slot(control,"species.names")
      sp.names<-substr(paste(sp.names,"___________",sep=''),1,11)
      sp.names<-gsub(' ','_',sp.names)
      write(sp.names,file="species_names.in")
      cat("12345678901\nPlease note. exactly 11 charaters for species names !!!!\n",file="species_names.in",append=TRUE)
  }
  setwd(old.path)
}
###

read.FLOPtrigger.control<-function(file="op_trigger.dat",n.VPA,n.other.pred) {

  n.sp<-n.VPA+n.other.pred
  species.names<-readLines("species_names.in", n=n.sp)
  species.names<-species.names[(n.other.pred+1):n.sp]
  species.names<-gsub('_',' ',species.names)
  species.names<-sub('[[:space:]]+$', '', species.names)

  opt<-scan(file, comment.char = "#",quiet=TRUE)

  n<-1
  control<-new("FLOPtrigger.control")
  n.<-slotNames(control)
  for (x in n.) {
    switch(x,
      "HCR"                   = {slot(control,x)<-matrix(opt[n:(n-1+1*n.VPA)],ncol=n.VPA,nrow=1,dimnames=list(c("HCR"),species.names),byrow=TRUE); n<-n+1*n.VPA},
      "trigger"               = {slot(control,x)<-matrix(opt[n:(n-1+2*n.VPA)],ncol=n.VPA,nrow=2,
                                   dimnames=list(c("T1","T2"),species.names),byrow=TRUE); n<-n+2*n.VPA},
      "Ftarget"               = {slot(control,x)<-matrix(opt[n:(n-1+4*n.VPA)],ncol=n.VPA,nrow=4,
                                   dimnames=list(c("lower","higher","init","phase"),species.names),byrow=TRUE); n<-n+4*n.VPA},
      "Fslope"                = {slot(control,x)<-matrix(opt[n:(n-1+4*n.VPA)],ncol=n.VPA,nrow=4,
                                   dimnames=list(c("lower","higher","init","phase"),species.names),byrow=TRUE); n<-n+4*n.VPA},
      "SSB50"                 = {slot(control,x)<-matrix(opt[n:(n-1+4*n.VPA)],ncol=n.VPA,nrow=4,
                                    dimnames=list(c("lower","higher","init","phase"),species.names),byrow=TRUE); n<-n+4*n.VPA},
      "S1"                    = {slot(control,x)<-matrix(opt[n:(n-1+4*n.VPA)],ncol=n.VPA,nrow=4,
                                   dimnames=list(c("lower","higher","init","phase"),species.names),byrow=TRUE); n<-n+4*n.VPA},
      "SSBpenalty"            = {slot(control,x)<-matrix(opt[n:(n-1+4*n.VPA)],ncol=n.VPA,nrow=4,
                                   dimnames=list(c("use","SSB50","SSB75","factor"),species.names),byrow=TRUE); n<-n+4*n.VPA},
      "weighting"             = {slot(control,x)<-matrix(opt[n:(n-1+1*n.VPA)],ncol=n.VPA,nrow=1,dimnames=list(c("weight"),species.names),byrow=TRUE); n<-n+1*n.VPA}
                               ,
         # otherwise
                              {slot(control,x)<-opt[n];n<-n+1}
      )
  }
  control
}

###

read.FLOP.control<-function(file="op.dat",n.VPA,n.other.pred,n.pred) {

  n.sp<-n.VPA+n.other.pred
  species.names<-readLines("species_names.in", n=n.sp)
  species.names<-gsub('_',' ',species.names)
  species.names<-sub('[[:space:]]+$', '', species.names)
  VPA.sp.names<-species.names[(n.other.pred+1):nsp]

  opt<-scan(file, comment.char = "#",quiet=TRUE)

  n<-1
  control<-new("FLOP.control")
  n.<-slotNames(control)
  if (n.other.pred==0) n.<-n.[1:(length(n.)-2)]
  for (x in n.) {
    switch(x,
    "species.names"            = { species.names<-readLines("species_names.in", n=n.sp)
                                   species.names<-gsub('_',' ',species.names)
                                   species.names<-sub('[[:space:]]+$', '', species.names)
                                   slot(control,x)<-species.names; },
     "years.wsea"              = {slot(control,x)<-matrix(opt[n:(n-1+2*n.sp)],ncol=n.sp,nrow=2,
                                   dimnames=list(c("first","last"),species.names),byrow=TRUE); n<-n+2*n.sp},
     "years.M"                 = {slot(control,x)<-matrix(opt[n:(n-1+2*n.VPA)],ncol=n.VPA,nrow=2,
                                   dimnames=list(c("first","last"),VPA.sp.names),byrow=TRUE); n<-n+2*n.VPA},
     "years.propmat"           = {slot(control,x)<-matrix(opt[n:(n-1+2*n.VPA)],ncol=n.VPA,nrow=2,
                                   dimnames=list(c("first","last"),VPA.sp.names),byrow=TRUE); n<-n+2*n.VPA},
     "years.F"                 = {slot(control,x)<-matrix(opt[n:(n-1+2*n.VPA)],ncol=n.VPA,nrow=2,
                                   dimnames=list(c("first","last"),VPA.sp.names),byrow=TRUE); n<-n+2*n.VPA},
     "years.weca"              = {slot(control,x)<-matrix(opt[n:(n-1+2*n.VPA)],ncol=n.VPA,nrow=2,
                                   dimnames=list(c("first","last"),VPA.sp.names),byrow=TRUE); n<-n+2*n.VPA},
     "years.prop.landed"        = {slot(control,x)<-matrix(opt[n:(n-1+2*n.VPA)],ncol=n.VPA,nrow=2,
                                   dimnames=list(c("first","last"),VPA.sp.names),byrow=TRUE); n<-n+2*n.VPA},
     "years.stock.distrib"      = {slot(control,x)<-matrix(opt[n:(n-1+2*n.VPA)],ncol=n.VPA,nrow=2,
                                   dimnames=list(c("first","last"),VPA.sp.names),byrow=TRUE); n<-n+2*n.VPA},
     "years.ration"             = {slot(control,x)<-matrix(opt[n:(n-1+2*n.pred)],ncol=n.pred,nrow=2,
                                   dimnames=list(c("first","last"),species.names[1:n.pred]),byrow=TRUE); n<-n+2*n.pred},
     "growth.model"             = {slot(control,x)<-matrix(opt[n:(n-1+5*n.VPA)],ncol=n.VPA,nrow=5,dimnames=list(c("Type","first.age","last.age","add.info1","add.info2"),VPA.sp.names),byrow=TRUE); n<-n+5*n.VPA},
     "stochastic.recruitment"   = {slot(control,x)<-matrix(opt[n:(n-1+n.VPA)],ncol=n.VPA,nrow=1,dimnames=list(" ",VPA.sp.names)); n<-n+n.VPA},
      "rec.noise"               = {slot(control,x)<-matrix(opt[n:(n-1+2*n.VPA)],ncol=n.VPA,nrow=2,
                                   dimnames=list(c("lower","upper"),VPA.sp.names),byrow=TRUE); n<-n+2*n.VPA},
     "recruit.adjust"          = {slot(control,x)<-matrix(opt[n:(n-1+n.VPA)],ncol=n.VPA,nrow=1,dimnames=list(" ",VPA.sp.names)); n<-n+n.VPA},
     "recruit.adjust.CV"       = {slot(control,x)<-matrix(opt[n:(n-1+n.VPA)],ncol=n.VPA,nrow=1,dimnames=list(" ",VPA.sp.names)); n<-n+n.VPA},
     "F.or.C"                  ={slot(control,x)<-matrix(opt[n:(n-1+n.VPA)],ncol=n.VPA,nrow=1,dimnames=list(" ",VPA.sp.names)); n<-n+n.VPA},
     "years.other"             = {slot(control,x)<-matrix(opt[n:(n-1+2*n.other.pred)],ncol=n.other.pred,nrow=2,
                                   dimnames=list(c("first","last"),species.names[1:n.other.pred]),byrow=TRUE); n<-n+2*n.other.pred},
     "other.predator"          = {if (n.other.pred>1) {
                                   slot(control,x)<-matrix(opt[n:(n-1+3*n.other.pred)],ncol=n.other.pred,nrow=3,
                                   dimnames=list(c("factor","first","second"),species.names[1:n.other.pred]),byrow=TRUE); n<-n+3*n.other.pred
                                 }
                                 },
         # otherwise
                                 {slot(control,x)<-opt[n];n<-n+1}
      )
  }
  control
}

## show (a replacement for print of S3 classes)
setMethod("show", signature(object="FLOP.control"),
    function(object){
      n.<-slotNames(object)
       for (i in 1:length(n.)) {
         cat(n.[i])
         for (j in nchar(n.[i]):25) cat(" ")

         if (is.integer(slot(object,n.[i]))) cat(slot(object,n.[i]),"\n")

         else if (is.vector(slot(object,n.[i]))) {
           if (is.list(slot(object,n.[i]))) {
              for (k in 1:length(slot(object,n.[i]))) cat("\n\t",slot(object,n.[i])[[k]])
              cat("\n")
           }
           else cat(slot(object,n.[i]),"\n")
         }
         else if (is.matrix(slot(object,n.[i]))) {
           m<-slot(object,n.[i])
           cat("\n")
           print(m)
         }
       }
    }
)

## show (a replacement for print of S3 classes)
setMethod("show", signature(object="FLOPtrigger.control"),
    function(object){
      n.<-slotNames(object)
       for (i in 1:length(n.)) {
         cat(n.[i])
         for (j in nchar(n.[i]):25) cat(" ")

         if (is.integer(slot(object,n.[i]))) cat(slot(object,n.[i]),"\n")

         else if (is.vector(slot(object,n.[i]))) {
           if (is.list(slot(object,n.[i]))) {
              for (k in 1:length(slot(object,n.[i]))) cat("\n\t",slot(object,n.[i])[[k]])
              cat("\n")
           }
           else cat(slot(object,n.[i]),"\n")
         }
         else if (is.matrix(slot(object,n.[i]))) {
           m<-slot(object,n.[i])
           cat("\n")
           print(m)
         }
       }
    }
)


  # load packages
  library(FLCore)
  library(FLEDA)
  library(FLAssess)

  # path of the folder with VPA input data
  input.path <- "C:\\mv\\FLR-kursus\\HER_incl_GR"
  setwd(input.path)

  # file names index and tuning  !!! don't forget the extensions
  index.name  <- "index.txt"
  tuning.name <- "acoustic.tun"
  stock.name  <- "Herring 25-32"
  plusgroup   <- 8 # if no plusgroup set NA
  Fbarmin     <- 3
  Fbarmax     <- 7

## 2. import data
# ---------------

  # 2.1 Catch data
  # --------------

  # read VPA file
  stock <- read.FLStock(file=index.name,name=stock.name)


#' Quality control object
#'
#' Create a quality control object for a given Infinium HumanMethylation450 BeadChip.
#'
#' @param samplesheet.row Row from the data frame containing IDAT file and sample info (see \code{\link{meffil.read.samplesheet}} or \code{\link{meffil.create.samplesheet}}).
#' @param number.quantiles Number of quantiles to compute for probe subset (Default: 500).
#' @param dye.intensity Reference intensity for scaling each color channel (Default: 5000).
#' @param verbose If \code{TRUE}, then status messages are printed during execution (Default: \code{FALSE}).
#' @param detection.threshold Default value = 0.01.
#' All probes above this detection threshold detected.
#' @param bead.threshold Default value = 3.
#' All probes with less than this number of beads detected.
#' @param sex.cutoff Sex prediction cutoff. Default value = -2.
#' @param chip Name returned by \code{\link{meffil.list.chips()}} (Default: NA).
#' @param featureset Name returned by \code{\link{meffil.list.featuresets()}} (Default: \code{chip}).
#' @param cell.type.reference Character string name of the cell type reference
#' to use for estimating cell counts. Estimates are not generated if set to NA (default).
#' See \code{\link{meffil.list.cell.type.references}()} for a list of available
#' references.  New references can be created using
#' \code{\link{meffil.create.cell.type.reference}()}.
#' @return List containing control probe information, probe summaries
#' and quantiles.  We call this a "QC object".
#'
#' @export
meffil.create.qc.object <- function(samplesheet.row,
                                    number.quantiles=500,
                                    dye.intensity=5000,
                                    verbose=F,
                                    detection.threshold=0.01,
                                    bead.threshold=3,
                                    sex.cutoff=-2,
                                    chip=NA,
                                    featureset=chip,
                                    cell.type.reference=NA) {
    stopifnot(number.quantiles >= 100)
    stopifnot(dye.intensity >= 100)
    stopifnot(samplesheet.row$Sex %in% c(NA, "F", "M"))

    rg <- read.rg(samplesheet.row$Basename, verbose=verbose)

    chip <- guess.chip(rg, chip)

    if (is.na(featureset))
        featureset <- chip

    probes <- meffil.probe.info(chip, featureset)

    detectionp <- extract.detection.pvalues(rg, probes, verbose=verbose)
    bad.probes.detectionp <- detectionp[which(detectionp > detection.threshold)]

    beadnum <- extract.beadnum(rg, probes, verbose=verbose)
    bad.probes.beadnum <- beadnum[which(beadnum < bead.threshold)]

    snp.betas <- extract.snp.betas(rg, probes, verbose=verbose)

    controls <- extract.controls(rg, probes, verbose=verbose)

    tryCatch({
        rg <- background.correct(rg, probes, verbose=verbose)
    }, error = function(e) {
        save.image(paste(samplesheet.row$Basename, "rda", sep="."))
        stop(e)
    })

    intensity.R <- calculate.intensity.R(rg, probes)
    intensity.G <- calculate.intensity.G(rg, probes)

    rg <- dye.bias.correct(rg, probes, dye.intensity, verbose=verbose)

    mu <- rg.to.mu(rg, probes)

    sites.x <- meffil.get.x.sites(featureset)
    x.signal <- median(log(mu$M[sites.x] + mu$U[sites.x], 2), na.rm=T)

    sites.y <- meffil.get.y.sites(featureset)
    y.signal <- median(log(mu$M[sites.y] + mu$U[sites.y], 2), na.rm=T)

    probs <- seq(0,1,length.out=number.quantiles)

    quantiles <- lapply(get.quantile.site.subsets(featureset), function(sets) {
        list(M=unname(quantile(mu$M[sets], probs=probs,na.rm=T)),
             U=unname(quantile(mu$U[sets], probs=probs,na.rm=T)))
    })

    msg("predicting sex", verbose=verbose)
    xy.diff <- y.signal-x.signal
    predicted.sex <- ifelse(xy.diff < sex.cutoff, "F","M")

    cell.counts <- NULL
    if (!is.na(cell.type.reference))
        cell.counts <- estimate.cell.counts.from.mu(mu, cell.type.reference, verbose)

    list(class="qc.object",
         version=packageVersion("meffil"),
         sample.name=samplesheet.row$Sample_Name,
         basename=samplesheet.row$Basename,
         controls=controls,
         featureset=featureset,
         chip=chip,
         quantiles=quantiles,
         dye.intensity=dye.intensity,
         intensity.R=intensity.R,
         intensity.G=intensity.G,
         x.signal=x.signal,
         y.signal=y.signal,
         xy.diff=xy.diff,
         sex=samplesheet.row$Sex,
         sex.cutoff=sex.cutoff,
         predicted.sex=predicted.sex,
         median.m.signal=median(mu$M,na.rm=T),
         median.u.signal=median(mu$U,na.rm=T),
         bad.probes.detectionp=bad.probes.detectionp,
         bad.probes.beadnum=bad.probes.beadnum,
         bad.probes.detectionp.threshold=detection.threshold,
         bad.probes.beadnum.threshold=bead.threshold,
         snp.betas=snp.betas,
         cell.counts=cell.counts,
         samplesheet=samplesheet.row
         )
}

is.qc.object <- function(object) {
    is.list(object) &&
        ("class" %in% names(object) && object$class %in% "qc.object"
         || "origin" %in% names(object) && object$origin == "meffil.create.qc.object") ## backward compatibility
}


#' rpdgeqsvd
#'
#' TODO
#'
#' @details
#' For advanced users only.
#'
#' @param jobu
#' TODO
#' @param jobvt
#' TODO
#' @param eigtype
#' TODO
#' @param A
#' TODO
#' @param desca,descu,descvt
#' TODO
#'
#' @return
#' TODO
#'
#' @export
rpdgeqsvd = function(jobu, jobvt, eigtype, A, desca, descu, descvt)
{
  if (jobu == 'V' || jobu == 'v')
    ldim_u = base.numroc(descu[3:4], descu[5:6], ICTXT=descu[2L])
  else
    ldim_u = c(-1L, -1L)

  if (jobvt == 'V' || jobvt == 'v')
    ldim_vt = base.numroc(descvt[3:4], descvt[5:6], ICTXT=descvt[2L])
  else
    ldim_vt = c(-1L, -1L)

  ldim_u = as.integer(ldim_u)
  ldim_vt = as.integer(ldim_vt)

  pbdBASE::set.blacs.apts()
  .Call(R_pdgeqsvd, jobu, jobvt, eigtype, A, desca, descu, descvt, ldim_u, ldim_vt)
}


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

# Marker gene exprssion (Supplementary Figure 6a)
#
#
#   description: This script vidualize expression of indicated genes as a line plot.
#===================================================================================================#
#loding the CAGE expression data
expMatrix <- read.table("iPS_DE_diff_F5.TPM.txt", header = TRUE, row.name = NULL, sep = "\t", stringsAsFactors = FALSE)
expMatrix <- expMatrix[, c(1, 3, 10, 17, 5, 12, 19, 8, 15, 22, 7, 14, 21, 2, 9, 16, 6, 13, 20)] # reorder based on time point

#Compute mean and sd of replicates
mean.expMatrix <- cbind(
    apply(expMatrix[, c(2:4)], 1, mean),
    apply(expMatrix[, c(5:7)], 1, mean),
    apply(expMatrix[, c(8:10)], 1, mean),
    apply(expMatrix[, c(11:13)], 1, mean),
    apply(expMatrix[, c(14:16)], 1, mean),
    apply(expMatrix[, c(17:19)], 1, mean)
)
colnames(mean.expMatrix) <- c(0, 48, 54, 60, 66, 72)
rownames(mean.expMatrix) <- expMatrix$prmtrID

##compute sd of replicates
sd.expMatrix <- cbind(
    apply(expMatrix[, c(2:4)], 1, sd),
    apply(expMatrix[, c(5:7)], 1, sd),
    apply(expMatrix[, c(8:10)], 1, sd),
    apply(expMatrix[, c(11:13)], 1, sd),
    apply(expMatrix[, c(14:16)], 1, sd),
    apply(expMatrix[, c(17:19)], 1, sd)
)
colnames(sd.expMatrix) <- c(0, 48, 54, 60, 66, 72)
rownames(sd.expMatrix) <- expMatrix$prmtrID

#extraction of GOI
psc_marker <- c("POU5F1", "NANOG")
ps_marker <- "T"
de_marker <- c("SOX17",  "FOXA2", "GATA6")

gois <- c(psc_marker, ps_marker,de_marker)
for(i in gois){
    goi <- i

    gene_names <- sapply(strsplit(rownames(mean.expMatrix), "@"), function(x){x[2]})

    goi.mean.expMatrix <- mean.expMatrix[gene_names %in% goi,, drop = FALSE]
    goi.sd.expMatrix <- sd.expMatrix[gene_names %in% goi,, drop = FALSE]

    ##order based on promoter number
    goi.mean.expMatrix <- goi.mean.expMatrix[order(as.numeric(gsub("p", "", sapply(strsplit(rownames(goi.mean.expMatrix), "@"), function(x){ x[1] })))),]
    goi.sd.expMatrix <- goi.sd.expMatrix[order(as.numeric(gsub("p", "", sapply(strsplit(rownames(goi.sd.expMatrix), "@"), function(x){ x[1] })))),]

    #remove low expreeesion promoters
    cutoff <- 5
    tpm_cutoff <- which((apply(goi.mean.expMatrix, 1, max) >= cutoff))
    goi.mean.expMatrix <- goi.mean.expMatrix[tpm_cutoff,, drop = FALSE]
    goi.sd.expMatrix <- goi.sd.expMatrix[tpm_cutoff,, drop = FALSE]

    if(nrow(goi.mean.expMatrix) == 0) next

    library(ggplot2)
    library(tidyverse)
    library(reshape2)
    library(ggsci)

    goi.mean.expMatrix %>%
        as.data.frame() %>%
        mutate(Gene = rownames(.)) %>%
        pivot_longer(cols = -Gene, values_to = "TPM", names_to = "Hours") -> y

    goi.sd.expMatrix %>%
        as.data.frame() %>%
        mutate(Gene = rownames(.)) %>%
        pivot_longer(cols = -Gene, values_to = "sd", names_to = "Hours") -> sd.y

    y.df <- cbind(y, sd = sd.y[, 3])
    y.df$Hours <- as.numeric(y.df$Hours, levels = c(0, 48, 54, 60, 66,72))

    theme <- theme(
        panel.background = element_blank(),
        panel.border = element_rect(fill = NA),
        panel.grid.major = element_line(colour = "gray"),
        panel.grid.minor = element_blank(),
        strip.background = element_blank(),
        axis.text = element_text(color = "black", size = 20),    # axis texit setting
        axis.ticks = element_line(color = "black", size = .5),    # Setting of scale ticks line
        axis.title = element_text(color = "black", size = 20),    # Setting of scale ticks texit
        legend.position = "bottom",
        legend.title = element_blank(),
        legend.key = element_rect(fill = NA),
        legend.text = element_text(size=20),
        plot.margin = unit(c(1, 1, 1, 1), "line")
        )

    g <- ggplot(y.df, aes(x = Hours, y = TPM, color = Gene))
    g <- g + geom_line(aes(group = Gene),size=1.0)
    g <- g + geom_errorbar(aes(ymin = TPM - sd, ymax = TPM + sd, width = 0.3))
    g <- g + theme
    g <- g + guides(color = guide_legend("Gene"), fill = guide_legend("Gene"))
    g <- g + scale_color_jama()
    plot(g)

    ggsave(g, file = paste0(goi, "_.expression.pdf"), width = 9, height = 7)
}