#Script takes CRAFTY output files and combines with regionfile to summarise data to municipality level
#Two summary files are produced: 1) Services and Capitals, 2) Land Cover
#The script reads empirical data for corresponding CRAFTY output years and calculates various metrics of land cover comparison
#Initial code assumes years are 2005, 2010, 2015 but this could be edited

#updated by JM 2018-05-12 to include Pature (5LCs)

#LC1 = Nature
#LC2 = Other Agri
#LC3 = Agri
#LC4 = Other
#LC5 = Pasture

rm(list=ls())

#required packages
library(tidyverse)

#required functions
getServices <- function(data)
{
  #calculates services in each muni
  data %>%
    group_by(muniID) %>%
    dplyr::summarise(
      sumNatureS = sum(Service.Nature),
      sumSoyS = sum(Service.Soy),
      sumMaizeS = sum(Service.Maize),
      sumAgriS = sum(Service.Soy) + sum(Service.Maize),
      sumPastureS = sum(Service.Pasture),
      sumOtherS = sum(Service.Other),
      sumOtherAgriS = sum(Service.Other.Agriculture),
      meanNatureS = round(mean(Service.Nature),3),
      meanSoyS = round(mean(Service.Soy),3),
      meanMaizeS = round(mean(Service.Maize),3),
      meanAgriS = round((sum(Service.Soy) + sum(Service.Maize)) / (sum(Service.Soy != 0) + sum(Service.Maize != 0)),3),
      meanPastureS = round(mean(Service.Pasture),3),
      meanOtherS = round(mean(Service.Other),3),
      meanOtherAgriS = round(mean(Service.Other.Agriculture),3)
    ) -> services

  return(services)
}

getCapitals <- function(data)
{
  #calculates captials in each muni
  data %>%
    group_by(muniID) %>%
    dplyr::summarise(
      sumAgriC = sum(Capital.Agriculture),
      sumNatureC = sum(Capital.Nature),
      sumHumanC = sum(Capital.Human),
      sumDevC = sum(Capital.Development),
      sumInfraC = sum(Capital.Port.Access),
      sumEconC = sum(Capital.Economic),
      sumAcessC = sum(Capital.Nature.Access),
      sumGSeasonC = sum(Capital.Growing.Season),
      sumOtherAgriC = sum(Capital.Other.Agriculture),
      sumOtherC = sum(Capital.Other),
      sumSoyProteC = sum(Capital.Soy.Protection),
      sumMaizeProteC = sum(Capital.Maize.Protection),
      sumPasProteC = sum(Capital.Pasture.Protection),
      sumOAgriProteC = sum(Capital.OAgri.Protection),
      meanAgriC = round(mean(Capital.Agriculture),3),
      meanNatureC = round(mean(Capital.Nature),3),
      meanHumanC = round(mean(Capital.Human),3),
      meanDevC = round(mean(Capital.Development),3),
      meanInfraC = round(mean(Capital.Port.Access),3),
      meanEconC = round(mean(Capital.Economic),3),
      meanAcessC = round(mean(Capital.Nature.Access),3),
      meanGSeasonC = round(mean(Capital.Growing.Season),3),
      meanOtherAgriC = round(mean(Capital.Other.Agriculture),3),
      meanOtherC = round(mean(Capital.Other),3),
      meanSoyProteC = round(mean(Capital.Soy.Protection),3),
      meanMaizeProteC = round(mean(Capital.Maize.Protection),3),
      meanPasProteC = round(mean(Capital.Pasture.Protection),3),
      meanOAgriProteC = round(mean(Capital.OAgri.Protection),3),
      meanLandPriceC = round(mean(Capital.Land.Price),3)
    ) -> services

  return(services)
}

getFRs <- function(data)
{
  LU <- dplyr::select(data, LandUse, muniID)

  #calculates proportion of each FR in the muni
  LU %>%
    group_by(muniID) %>%
    dplyr::summarise(FR1 = round(sum(LandUse == 'FR1') / n(), 3),
                     FR2 = round(sum(LandUse == 'FR2') / n(), 3),
                     FR3 = round(sum(LandUse == 'FR3') / n(), 3),
                     FR123 = round(sum(LandUse == 'FR1' | LandUse == 'FR2' | LandUse == 'FR3') / n(), 3),
                     FR4 = round(sum(LandUse == 'FR4') / n(), 3),
                     FR5 = round(sum(LandUse == 'FR5') / n(), 3),
                     FR45 = round(sum(LandUse == 'FR4' | LandUse == 'FR5') / n(), 3),
                     FR6 = round(sum(LandUse == 'FR6') / n(), 3),
                     FR7 = round(sum(LandUse == 'FR7') / n(), 3),
                     FR8 = round(sum(LandUse == 'FR8') / n(), 3)
    ) -> FRs

  return(FRs)
}

scenario <- "Testing_2019-02-21"
runID <- "0-0"
yrs <- seq(2001, 2015, 1)

#yrs <- c(2005,2010,2015)

#specify states to plot (for all states provide empty list)
#states <- c()  #all states
states <- c(51) #MT

#output variables
SC_name <- paste0("Data/",scenario,"/",runID,"/",scenario,"_CRAFTYmunisServCap.csv")  #output file name for services and capitals
LC_name <- paste0("Data/",scenario,"/",runID,"/",scenario,"_CRAFTYmunisLC.csv")  #output file name for land cover data

#load the region file (used to match each cell to a municipality)
region <- read.csv(paste0("Data/",scenario,"/",runID,"/region.csv"))

for(i in seq_along(yrs)){

  #Load model output data
  output <- read.csv(paste0("Data/",scenario,"/",runID,"/",scenario,"-",runID,"-Cell-",yrs[i],".csv"))

  #load empirical map summary data (created using summarise_LCmaps.r)
  lc <- read.csv(paste0("Data/SummaryTables/LCs",yrs[i],"_PastureB.csv"), header = T)

  #create df containing only cell and muni data (rename columns)
  munis<-data.frame(region$X, region$Y, region$muniID)
  munis <- rename_all(munis, .funs = funs(substring(., 8)))  #string "region." prefix using substring function to retain only chars after 8 position (1 index)
  #munis <- rename_all(munis, .funs = funs(sub("^region.", "",.)))  #or same as previos line using sub with regex

  #create new column to indicate state (from first two digits of muniID)
  munis <- mutate(munis, State = substring(muniID, 1, 2))

  #join to add muniID to the CRAFTY output data
  output <- inner_join(output, munis, by = c("X", "Y"))

  ##subset to state if necessary
  if(!is.null(states)){
    output <- filter(output, State %in% states)
  }

  #***Services and Capitals
  #aggregate services and capitals to municipality
  #(from each row is cell to each row is municipality)
  services <- getServices(output)
  capitals <- getCapitals(output)

  #join mapbiomas (lc) and CRAFTY output (mapFRs) summary tables together
  sc <- left_join(lc, services, by = "muniID") %>%
    left_join(., capitals, by = "muniID")

  #add year column
  sc<- mutate(sc, Year = yrs[i])

  if(i == 1) { scDat <- sc }
  else {  scDat <- bind_rows(scDat, sc) }

  #***Land Cover
  #aggregate functional roles (indicative of lcs) to municipality
  #(from each row is cell to each row is municipality)
  FRs <- getFRs(output)

  #legend for mapbiomas
  #1. Nature (FRs 4 and 5, so use FR45)
  #2. Other Agri (FR6)
  #3. Arable FRs 1, 2 and 3, so use FR123)
  #4. Other (FR7)
  #5. PAsture (FR8)

  #subset to get only the FR combos that indicate a specific land cover for municipalities
  selectedFRs <- c("muniID","FR123", "FR45", "FR6", "FR7", "FR8") #JM! check this works
  mapFRs <- dplyr::select(FRs, selectedFRs)

  #join mapbiomas (lc) and CRAFTY output (mapFRs) summary tables together
  lcs <- left_join(mapFRs, lc, by = "muniID")

  #add year column
  lcs <- mutate(lcs, Year = yrs[i])

  if(i == 1) { lcDat <- lcs }
  else {  lcDat <- bind_rows(lcDat, lcs) }
}
  #rename columns using legend above (plus others
  lcDat <- plyr::rename(lcDat, c(
    "LC1" = "Obs1",
    "LC2" = "Obs2",
    "LC3" = "Obs3",
    "LC4" = "Obs4",
    "LC5" = "Obs5",
    "FR45" = "Mod1",
    "FR6" = "Mod2",
    "FR123" = "Mod3",
    "FR7" = "Mod4",
    "FR8" = "Mod5",
    "NonNAs" = "cellCount",
    "NAs" = "NAcellCount"))

  #code to add modal cell lc for each muncipality for modelled and predicted LC
  #mMode and oMode are characters  (the names of the column with greatest proportion)
  lcDat <- mutate(lcDat, mM = names(lcDat)[max.col(lcDat[2:6])+1L])  #from https://stackoverflow.com/a/37197584
  lcDat <- mutate(lcDat, oM = names(lcDat)[max.col(lcDat[7:11])+6L])  #edit 6L to get to right columns

  #remove letters from start of mM and oM (returning as integer)
  lcDat <- mutate(lcDat, ModMode = as.integer(substring(mM, 4)))
  lcDat <- mutate(lcDat, ObsMode = as.integer(substring(oM, 4)))

  #drop column that had letters in
  lcDat <- lcDat %>%
    dplyr::select(-c(mM,oM))

  #comparison of modelled mode vs observed mode (TRUE/FALSE)
  lcDat <- lcDat[!is.na(lcDat$ObsMode),]
  lcDat$diffcMode <- lcDat$ModMode != lcDat$ObsMode

  #calc total prop incorrectly predicted cells (in cells; need to chack ths against Pontius papers)
  #cannot use sum as that sums entire variable
  lcDat <- lcDat %>%
    mutate(cellDiffcCount = round(cellCount*(abs(Mod1-Obs1) + abs(Mod2-Obs2) + abs(Mod3-Obs3) + abs(Mod4-Obs4) + abs(Mod5-Obs5)))/2) %>%
    mutate(cellDiffcProp = round(cellDiffcCount/cellCount,3))

  #calc difference in proportion for each LC between Modelled and Observed
  lcDat <- lcDat %>%
    mutate(diffcProp1 = round(Mod1 - Obs1, digits = 3)) %>%
    mutate(diffcProp2 = round(Mod2 - Obs2, digits = 3)) %>%
    mutate(diffcProp3 = round(Mod3 - Obs3, digits = 3)) %>%
    mutate(diffcProp4 = round(Mod4 - Obs4, digits = 3)) %>%
    mutate(diffcProp5 = round(Mod5 - Obs5, digits = 3))

  #ensure Year is written as integer (see https://github.com/tidyverse/readr/issues/645)
  lcDat <- lcDat %>%
    mutate(Year = as.integer(Year))

  scDat <- scDat %>%
    mutate(Year = as.integer(Year))

#write data to file
readr::write_csv(scDat, path = SC_name)
readr::write_csv(lcDat, path = LC_name)


# RNA-seq分析

## 差异分析

library(GenomicFeatures)
library(AnnotationDbi)
library(tximport)
library(DESeq2)

### 我们直接从gtf注释文件（和基因组转录组对应版本的注释）获得基因和转录本的对应关系
hg38_txdb <- makeTxDbFromGFF("../ref/gencode.v38.annotation.gtf",
                                format="gtf",
                                organism="Homo sapiens",
                                dbxrefTag = "gene_name")

k <- keys(hg38_txdb, keytype = "TXNAME")
tx2gene <- select(hg38_txdb, k, "GENEID", "TXNAME")

head(tx2gene)
#             TXNAME            GENEID
#1 ENST00000456328.2 ENSG00000223972.5
#2 ENST00000450305.2 ENSG00000223972.5
#3 ENST00000473358.1 ENSG00000243485.5
#4 ENST00000469289.1 ENSG00000243485.5
#5 ENST00000607096.1 ENSG00000284332.1
#6 ENST00000606857.1 ENSG00000268020.3

quant.files <- list.files("../salmon_output", pattern = "quant.sf",
                          full.names = T, recursive = T)
txi <- tximport(quant.files, type = "salmon", tx2gene = tx2gene)
names(txi)
# [1] "abundance"           "counts"              "length"              "countsFromAbundance"

sampleTable <- data.frame(condition = factor(rep(c("M0", "M1"), each = 3)))
rownames(sampleTable) <- paste0("sample", 1:6)

### DESeq2提供了直接从Tximport构建数据的函数
dds <- DESeqDataSetFromTximport(txi, sampleTable, ~condition)

## 过滤一下，6个样本总counts数大于60
keep <- rowSums(counts(dds)) >= 60
dds <- dds[keep,]
PCA作图
### pca 作图
library(ggfortify)

## normalization
count.sf <-  estimateSizeFactors(dds)
normal.mtx <- counts(count.sf, normalized=T)
df_all <- cbind(t(normal.mtx), data.frame(group=c(rep('M0', 3),rep('M1', 3))))

pca_data <- prcomp(t(normal.mtx ), scale. = F)
autoplot(pca_data, data = df_all, colour = 'group', label = TRUE) + theme_bw()

## 差异基因计算

### 差异分析
deseq2.obj <- DESeq(dds)

# 获取结果
res <- results(deseq2.obj)
res.df <- as.data.frame(res)

r$> head(res.df)
                     baseMean log2FoldChange     lfcSE       stat       pvalue         padj
ENSG00000000003.15   12.78531    -1.15948975 1.0905031 -1.0632613 2.876635e-01 3.982777e-01
ENSG00000000419.14 1153.61638    -0.05190081 0.2331701 -0.2225878 8.238563e-01 8.760466e-01
ENSG00000000457.14  842.03593     2.47434389 0.3036221  8.1494188 3.656775e-16 8.626111e-15
ENSG00000000460.17  264.26436    -1.72342072 0.4529815 -3.8046160 1.420244e-04 5.627837e-04
ENSG00000000938.13 6142.70208    -2.29502017 0.3162089 -7.2579238 3.930770e-13 6.552265e-12
ENSG00000000971.16 1376.49691     4.16870903 0.5808924  7.1763881 7.157718e-13 1.156001e-11

r$> keep <- abs(res$log2FoldChange) > 1.5 & res$padj < 0.01
r$> deg <- res.df[keep, ]
r$> dim(deg)

# [1] 4083    6

## 热图绘制

## 使用 https://mp.weixin.qq.com/s/NC5mKwAsYbm1Q-PFC5IEOg 代码
library(pheatmap)

dat <- normal.mtx
FC <- res.df$log2FoldChange
names(FC) <- rownames(res.df)

# 排序差异倍数，提取前100和后100的基因名
DEG_200 <- c(names(head(sort(FC),100)),names(tail(sort(FC),100)))

# 提取基因的归一化
dat <- t(scale(t(dat[DEG_200,])))

group_list <- df_all$group
# 添加注释条
group <- data.frame(group=group_list)
rownames(group) <- colnames(dat)

# 大于2的值赋值为2
dat[dat > 2] <- 2
# 低于-2的值赋值为-2
dat[dat < -2] <- -2
pheatmap(dat, cluster_cols = T,
         show_colnames =F,show_rownames = F,
         annotation_col=group,
         color = colorRampPalette(c("navy", "white", "firebrick3"))(50))

## 富集分析

### GO富集

library(org.Hs.eg.db)
library(clusterProfiler)

## 获取上下调基因
deg.up <- res.df[res$log2FoldChange > 1.5 & res$padj < 0.01, ]
deg.down <- res.df[res$log2FoldChange < -1.5 & res$padj < 0.01, ]

## 去除ENSEMBL ID的版本号
deg.up.gene <- gsub("\\..*", "",  rownames(deg.up))
deg.down.gene <- gsub("\\..*", "",  rownames(deg.down))

deg.ls <- list(up = deg.up.gene, down = deg.down.gene)

ego.cmp <- compareCluster(deg.ls ,
                    fun          = "enrichGO",
                    qvalueCutoff = 0.01,
                    pvalueCutoff = 0.05,
                    ont          = 'BP',
                    keyType      = "ENSEMBL",
                    OrgDb        = org.Hs.eg.db,
                    )

dotplot(ego.cmp)

up.ego <- enrichGO(gene       = deg.up.gene,
                keyType       = "ENSEMBL",
                OrgDb         = org.Hs.eg.db,
                ont           = "ALL",
                pAdjustMethod = "BH",
                pvalueCutoff  = 0.05,
                qvalueCutoff  = 0.01,
                readable      = TRUE,
                pool          = TRUE)

dotplot(up.ego, split="ONTOLOGY", showCategory = 15, title = "up") +
                    facet_grid(ONTOLOGY~., scale="free")

down.ego <- enrichGO(gene     = deg.down.gene,
                keyType       = "ENSEMBL",
                OrgDb         = org.Hs.eg.db,
                ont           = "ALL",
                pAdjustMethod = "BH",
                pvalueCutoff  = 0.05,
                qvalueCutoff  = 0.01,
                readable      = TRUE,
                pool          = TRUE)

dotplot(down.ego, split="ONTOLOGY", showCategory = 15, title = "down") +
                    facet_grid(ONTOLOGY~., scale="free")

```

![GO_enrich1](GO_enrich1.png)
![GO_enrich2](GO_enrich2.png)
![GO_enrich3](GO_enrich3.png)

### KEGG富集

### KEGG富集，需要使用ENTREZID
deg.up.gene.ei <- bitr(deg.up.gene, fromType = "ENSEMBL", toType = "ENTREZID", OrgDb = org.Hs.eg.db)$ENTREZID
deg.down.gene.ei <- bitr(deg.down.gene, fromType = "ENSEMBL", toType = "ENTREZID", OrgDb = org.Hs.eg.db)$ENTREZID

deg.ei.ls <- list(up = deg.up.gene.ei, down = deg.down.gene.ei)

kegg.cmp <- compareCluster(deg.ei.ls,
                            fun = "enrichKEGG",
                            qvalueCutoff = 0.01,
                            pvalueCutoff = 0.05,
                            organism = "hsa"
                            )
dotplot(kegg.cmp)

#### 单个富集查看的话，用函数enrichKEGG


REBOL [
    Title: "Img-to-bll"
    Date: 26-Dec-2007/23:17:28+1:00
    Name: none
    Version: none
    File: none
    Home: none
    Author: "David Oliva (commercial)"
    Owner: none
    Rights: none
    Needs: none
    Tabs: none
    Usage: [
   		;img2bll/parse %opetmuzem.cz.ico
		;img2bll/parse %uchoko.ffa.vutbr.cz.ico.bmp
		img2bll/parse %png24t-13x16.png ;%testi.png ;%w01.png
	]
    Purpose: none
    Comment: none
    History: none
    Language: none
    Type: none
    Content: none
    Email: oliva.david@seznam.cz
    require: [
		rs-project 'stream-io
		rs-project 'binary-conversions
		rs-project 'zlib-decompress
		rs-project 'crc32
		;lib %gunzip.r
	]
	preprocess: true
]

ImageCore: make stream-io [
	file: pixels: header: img-type: none

	open: func["Reads image file into buffer" img-file][
		setStreamBuffer either binary? img-file [file: none img-file][read/binary file: img-file]
	]

	#include %ImageCore-ICO-BMP.r
	#include %ImageCore-PNG.r

	alignedSize: func[size /local r][
		either 0 = r: size // 2 [size][size + 2 - r]
	]
	flip-vertical: func[imgBin width /local newImg nwidth][
		newImg: copy imgBin
		imgBin: tail imgBin
		nwidth: negate width
		until [
			tail? newImg: change newImg copy/part  imgBin: skip imgBin nwidth  width
		]
		head newImg
	]

	byt16Vals: make block! [
   		     0  16 24 32 40 48 56 64
     		72 80 88 96 104 112 120 128
     		136 144 152 160 168 176 184 192
     		200 208 216 224 232 240 248 255
	]
	short-to-rgb: func[b16 "16 bits of color value"][
		r: 1 + to integer! ((b16 and 31744) / 1024) ; 31744 = 2#{0111110000000000}
		g: 1 + to integer! ((b16 and 992  ) / 32  ) ; 2016  = 2#{0000001111100000}
		b: 1 + to integer!  (b16 and 31   )         ; 31    = 2#{0000000000011111}
		;print reduce [r g b]
		to-tuple reduce [byt16Vals/:r byt16Vals/:g byt16Vals/:b]
	]

	ARGB2BLL: func[img [object!]][
		rejoin [
			#{05}
			int-to-ui16 img/size/x
			int-to-ui16 img/size/y
			head remove/part tail compress head img/bARGB -4 ;ZLIBBITMAPDATA
		]
	]
	ARGB2RGBA: func[img [object!] /local RGBA ARGB sk cols rows][
		ARGB: img/ARGB
		RGBA: copy ARGB
		sk: alignedSize img/size/width
		cols: img/size/x
		rows: img/size/y
		loop rows [
			loop cols [
				RGBA: change RGBA copy/part next ARGB 3
				RGBA: change RGBA first ARGB
				ARGB: skip ARGB 4
			]
			RGBA: skip RGBA sk
			ARGB: skip ARGB sk
		]
		head RGBA
	]

	requiredICOwidth: 16

	load: func[img-file /local icoDir FILEHEADER header palette tmp][
		open img-file
		if #{1F8B08} = copy/part inBuffer 3 [
			;compressed file
			print "compressed file"
			attempt [inBuffer: gunzip inBuffer]
		]
		case [
			#{00000100} = copy/part inBuffer 4 [
				img-type: %ICO
				;print ["ICO file" ]
				skipBytes 4
				tmp: inBuffer
				;probe index? tmp
				loop readUI16 [
					;First I get IconDir data:
					icoDir: readICONDIR
					;? icoDir
					if icoDir/width = requiredICOwidth [
						return readICOBMP icoDir
						;? icoBMP
					]
				]
				;print ["Icon is missing required width!"]
				return none
				inBuffer: tmp
				loop readUI16 [

					return readICOBMP readICONDIR
					break
				]

			]
			#{424D} = copy/part inBuffer 2 [
				img-type: %BMP
				;print ["BMP file" ]
				skipBytes 2
				FILEHEADER: readBITMAPFILEHEADER
				header:     readBITMAPINFOHEADER
				return BMP2ARGB header/biWidth header/biHeight header inBuffer
			]

			#{89504E470D0A1A0A} = copy/part inBuffer 8 [
				img-type: %PNG
				;print ["PNG file"]
				skipBytes 8
				header:  none
				return PNG2ARGB

			]
			#{474946} = copy/part inBuffer 3 [
				img-type: %GIF
				;print "!!! GIF image not supported yet"
				return none
			]
			true [
				img-type: none
				make error! reform ["Unknown image file:" mold img-file]
			]
		]
	]
	loadAsBLL: func[img-file][ARGB2BLL load img-file]
]


####################################################################
## Demonstrates the immune cell marker gene enrichment analysis and the development of gene signatures shown in "The immune contexture of hepatocellular carcinoma predicts clinical outcome"
## V 1.0
## (c) Moritz Hess 2018
#####################################################################
### Load Libraries #####
library(openxlsx)
source("functions.R")
library(gplots)
library(limma)
library(edgeR)
library(survival)
cyanmagenta <- function(x){colorpanel(x,'cyan','white','magenta')}
nrot = 999 ## Increase for improved accuracy of the Enrichment p-values

#####################################################################
#### TCGA Data ######################################################
#####################################################################
supporting.document <- "XXXX.xlsx" # Replace by filename of Supplementary table 5
data <- readWorkbook(supporting.document,sheet=5,startRow = 4,rowNames=TRUE)
samples <- readWorkbook(supporting.document,sheet=3,startRow=3,rowNames=TRUE)
immunegenes <- readWorkbook(supporting.document,sheet=6,startRow=3,rowNames=FALSE)
pheno <- read.csv("pheno.csv",stringsAsFactors=FALSE)
#####################################################################
## Variables ########################################################
#####################################################################
Age = as.numeric(samples$"Age.(in.decades)")
Gender = samples$Gender
Factor = samples$Tissue.type

Replicate=pheno$Replicate
Risk_Factor <- samples$Risk.factor
Risk_Factor[Risk_Factor=='Not applicable'] <- 'AAAA'
Survival <- samples$Survival
Survival[Survival=='Not applicable'] <- 'AAAA'
Stage <- samples$Stage

###########################################################################################
############################ immune cell marker gene enrichment analysis (Figure 2A) ######
###########################################################################################
immunelist <- sapply(unique(immunegenes[,1]),function(x) immunegenes[,2][immunegenes[,1]==x])
immunelistnumbers <- sapply(immunelist,function(x) match(x,rownames(data)))
Heatmap.Order <- c('B cell',
                   'T cell',
                   'T helper cell',
                   'CD8',
                   'Cytotoxic cells',
                   'T effector memory',
                   'T central memory',
                   'TFH',
                   'Th1',
                   'Th2',
                   'Th17',
                   'Tgamma delta',
                   'Treg',
                   'NK',
                   'NK CD56bright',
                   'NK CD56dim',
                   'DC',
                   'iDC',
                   'aDC',
                   'Macrophages',
                   'Mast cells',
                   'Neutrophils',
                   'Eosinophils',
                    'MHC Class I',
                   'Cytolytic Activity',
                   'Type I IFN Reponse',
                   'Type II IFN Reponse',
                   'Co-stimulation, T cell',
                   'Co-stimulation, APC',
                   'Co-inhibition, T cell',
                   'Co-inhibition, APC'
                   )
immunelistnumbers <- immunelistnumbers[Heatmap.Order]

NewLabels <- c(
"B cells",
"T cells",
"T helper cells",
"CD8+ T cells",
"Cytotoxic T cells",
"T effector memory cells",
"T central memory cells",
"T follicular helper cells",
"Th1 cells",
"Th2 cells",
"Th17 cells",
"Tgd cells",
"CD4+ regulatory T cells",
"NK cells",
"NK CD56bright cells",
"NK CD56dim cells",
"Dendritic cells",
"Immature dendritic cells",
"Activated dendritic cells",
"Macrophages",
"Mast cells",
"Neutrophils",
"Eosinophils",
"MHC Class I",
"Cytolytic activity",
"Type I Interferon response",
"Type II Interferon response",
"Co-stimulation, T cell",
"Co-stimulation, APC",
"Co-inhibition, T cell",
"Co-inhibition, APC"
)

## Transform count data using the voom transformation and estimate intra-individual correlation (Random=TRUE). For sake of computational speed, correlation from a previous run is provided here (0.1598).
AdjustNA <- !is.na(Age) & !is.na(Gender) & !is.na(Factor) # Remove samples with missing information
Model <- model.matrix(~Factor[AdjustNA]+Age[AdjustNA] + Gender[AdjustNA]) # specify the model
colnames(Model) <- gsub('[AdjustNA]','',colnames(Model),fixed = TRUE)
Limma <- Limma.Pipe(Counts=data[,AdjustNA],Model=Model, Voom=TRUE, Random=FALSE, Block=Replicate[AdjustNA],Correlation=0.1598) # perform the transformation and the computation of the intra-individual correlation (if Random=TRUE).

## Define the contrasts that are tested.
Contrast.List <- list('HCC-NT vs. HL' = c(0,0,1,0,0),
                      'HCC-T vs. HL' = c(0,1,0,0,0),
                      'HCC-T vs. HCC-NT' = c(0,1,-1,0,0)
                      )

## Perform enrichment analysis using rotation tests:
# Wu, D., Lim, E., Vaillant, F., Asselin-Labat, M. L., Visvader, J. E., & Smyth, G. K. (2010). ROAST: rotation gene set tests for complex microarray experiments. Bioinformatics, 26(17), 2176-2182.

expression <- Limma$Transformed
correlation <- 0.1598
block = Replicate
Contrast.Results <- list()
for (Contrast.Name in names(Contrast.List))
{
    Current.Contrast <- Contrast.List[[Contrast.Name]]
    ROAST <- mroast(y=expression,
                    index= immunelistnumbers,
                    design = Model,
                    correlation = correlation,
                    contrast= Current.Contrast,
                    nrot=nrot,
                    block = Replicate[AdjustNA]
                    )
    Contrast.Results[[Contrast.Name]] <- ROAST
}
Contrast.Results.ordered <- lapply(Contrast.Results, function(x) x[Heatmap.Order,])

## Format output of ROAST for plotting
ROAST. <- do.call(cbind,Contrast.Results.ordered)
ROAST.P <- ROAST.[,grepl('PValue$',colnames(ROAST.))]
ROAST.Dir <- ROAST.[,grepl('Direction$',colnames(ROAST.))]
ROAST.Dir <- ifelse(ROAST.Dir=='Down',yes = -1, no = 1)
ROAST.Plog <- abs(log10(ROAST.P)) * ROAST.Dir
rownames(ROAST.Plog) <- NewLabels
colnames(ROAST.Plog) <- gsub(".PValue","",colnames(ROAST.Plog))
ROAST.Plog <- ROAST.Plog[,c("HCC-T vs. HCC-NT","HCC-T vs. HL","HCC-NT vs. HL")]

pdf('Figure_2A.pdf',width=10,height=15)
heatmap.2(data.matrix(ROAST.Plog),
          col='cyanmagenta',
          margins = c(10,10),
          srtCol = 90,
          notecex=1,
          key=TRUE,
          Colv =FALSE,
          Rowv = FALSE,
          dendrogram = 'none',
          trace='none',
          density.info = 'none',
          notecol='black',
          symm=FALSE,
          cexCol = 0.8,
          lmat=rbind(c(4,3),c(2,1)), lhei=c(0.1,1),lwid=c(0.3,1),
          cexRow = 0.8,
          main='Cell Type Marker Enrichment')
dev.off()

###########################################################################################
############################# Cox Regression (Figure 4B) ##################################
###########################################################################################

## Format time to event data for cox regression.
.sel <- samples$Tissue.type=="Primary_Tumor"
tod <- as.numeric(pheno[,'death_days_to'])
dead <- ifelse(!is.na(tod),yes=1,no=0)
cens <- as.numeric(pheno[,'last_contact_days_to'])
cens[cens<=0] <- NA
boolvec <- .sel & (!is.na(tod) | !is.na(cens)) & !is.na(Age) & !is.na(Gender)
survmat = cbind(rownames(samples),Gender,Age,tod,dead,cens)
survmat = survmat[boolvec,]
survmat[is.na(survmat)] <- 0
survmat = data.frame(survmat,row.names=1,stringsAsFactors=FALSE)
survmat$tod <- as.numeric(survmat$tod)
survmat$Age <- as.numeric(survmat$Age)
survmat$cens <- as.numeric(survmat$cens)
survmat$dead <- as.numeric(survmat$dead)

survmat[['time']] <- apply(survmat[,c('cens','tod')],1,sum)
survmat[['surv']] <- Surv(survmat[['time']],survmat[['dead']])

## Voom transform expression data.
nf <- calcNormFactors(data)
expressionmat <- voom(data,lib.size = colSums(data)*nf,plot=TRUE)
expressionmat = expressionmat$E[,rownames(survmat)]

## Perform univariate time-to-event analysis using cox-regression.
Formula <- as.formula('surv ~ Expression + Age + Gender') # specify the model
cox.univariate.results <- cellcox(immunelistnumbers,expressionmat,survmat,Formula) # estimate the coefficients for each gene (univariate models)
cox.univariate.z <- lapply(cox.univariate.results, function (x) sapply(x, function(y) summary(y)[['coefficients']]['Expression',4])) # extract z-score for each gene from univariate models.
names(cox.univariate.z) <- NewLabels
cox.univariate.z <- cox.univariate.z[sapply(cox.univariate.z,length)>0]

## Calculate average z-scores per gene-set and calculate the empirical null distribution for each each gene set.
set.seed(1234)
nperm = 10000
a = permcelltest(cox.univariate.z,nperm)
a[a==0] = 1/nperm # replace an empirical p-value of zero by 1 / number of simulations.
plotzscoreenrich(rev(cox.univariate.z),rev(a),"Figure_4B") # plot the distribution of z-scores and the empirical p-values.

###########################################################################################
############################# Immune cell signature (Figure 5A) ##########################
###########################################################################################

## Infer survival in patients that differ in the expression of immune cell-type specific marker genes that were significantly associated with survival (Figure 4B).

scoregenes <- unlist(immunelist[c('T cell','Cytotoxic cells','Th2','Macrophages')]) # Fetch the immune cell-type specific marker genes that were significantly associated with survival.

## For each immune cell-type specific marker gene, determine the association with survival using cox proportional hazards models.
Formula <- as.formula('surv ~ Expression + Age + Gender')
cox.univariate.all.results <- unicoxexpression(expressionmat[scoregenes,],survmat,Formula)
cox.univariate.z.all <- unlist(lapply(cox.univariate.all.results,  function(y) summary(y)[['coefficients']]['Expression',4]))
scoregenes <- cox.univariate.z.all

## Calculate a score for each patient based on the expression of immune cell-type specific marker genes. The higher the score, the longer the expected survival.
thres <- "median"
direction <- "one"
addone <- TRUE
myscore <- score.universal(scoregenes,expressionmat,thres=thres,direction=direction,addone = addone)
## Dichotomize patients based on score.
mygroups <- ifelse(myscore>median(myscore),yes='good',no='poor')
.surv <- survmat$surv

fit <- survfit(.surv~mygroups)
fit$time <- fit$time / 365

## Plot the Kaplan - Meier curves of the two inferred patient groups.
pdf('Figure_5A.pdf')
plot(fit,col=c('blue','green'),xlim=c(0,7),xlab="Time to death (years)",ylab="Survival probability")
dev.off()


pannzer2gaf <- function(in_files,out_gaf,config){
    print("Reading the input file")
    in_files=pannzer_results
    #out_file="PANNZER/gaf/pannzer-0.0.gaf"
    gaf_date = format(Sys.time(),"%m%d%Y")
    taxon_txt=paste("taxon:",config$input$taxon,sep="")

    tmp_out = lapply(in_files,function(infile){
        tmp_data = fread(infile,sep = "\t")
        colnames(tmp_data) = gsub("#","",colnames(tmp_data))
        tmp_data
    })
    pannzer_data = do.call(rbind,tmp_out)
    #argot2_data = argot2_data[!grep("#",`SeqID`)]
    pannzer_data

    gaf_cols=fread(config$data$go$gaf_cols,header = F)$V1
    print("Converting to GAF 2.0")
    gaf_data = pannzer_data[,.(QueryId,GO_class,Score)]
    colnames(gaf_data) = c("db_object_id","term_accession","with")

    min_score=min(gaf_data$with)
    max_score=max(gaf_data$with)
    gaf_data$with = (gaf_data$with - min_score)/(max_score - min_score)

    obo_data = check_obo_data(config$data$go$obo)
    tmp_aspect=lapply(gaf_data$term_accession,function(x){
        out = obo_data$aspect[[x]]
        if(is.null(out)){
            print(x)
            "N"
        }else{
            out
        }
    })
    gaf_data[,aspect:=unlist(tmp_aspect)]

    gaf_data[,db_object_symbol:=db_object_id]
    gaf_data[,db:="maize-GAMER"]
    gaf_data[,qualifier:=""]
    gaf_data[,db_reference:="MG:0000"]
    gaf_data[,evidence_code:="IEA"]
    gaf_data[,db_object_name:=""]
    gaf_data[,db_object_synonym:=""]
    gaf_data[,db_object_type:="protein"]
    gaf_data[,taxon:=taxon_txt]
    gaf_data[,date:=gaf_date]
    gaf_data[,assigned_by:="PANNZER"]
    gaf_data[,annotation_extension:=""]
    gaf_data[,gene_product_form_id:=""]
    setcolorder(gaf_data,gaf_cols)

    print("Writing the outfile")
    write_gaf(gaf_data,out_gaf)
}


calcUmapGeneSpace <- function( seurAll, seurWT = NULL, experimentType = "allCells",
			UMAPRandSeed = 42L, Dim = 2, minDist = 0.65, myNeighbors = 20L, myMetric = "cosine",
			assay.use = "RNA", reduction.key = "UMAP", reduction.name = "umap", mySpread = 1){

# this snippet uses retuculate python interface to run umap python tool. Standard Seurat does not allow
# changing some parameter value, particularly Spread
# also it allows to perform transformation on the subset of cells ("WT")
# experimentType = c("allCells", "allCondWT", "WToutAll")
# 'allCells' performs standard UMAP of seurAll
# 'WToutAll' takes out sox- cells and performs UMAP only WT
# 'allCondWT' uses WT to fit UMAP and performs transform for all cells
#  we cannot subset to WT because WT depends on imputation on the WT cells
# written by Vsevolod Makeev 2017 - 2021

umapRes	<- list( All = list(), WT = list())

if(!require(reticulate)){install.packages("reticulate")}
library(reticulate)

#np <- import(module = "numpy")
#np$np.random.seed(42)

SetIfNull <- function(x, default) {
  if (is.null(x)) {
    return(default)
  } else {
    return(x)
  }
}

SetCalcParams <- function(object, calculation, time = TRUE, ...) {
  object@calc.params[calculation] <- list(...)
  object@calc.params[[calculation]]$object <- NULL
  object@calc.params[[calculation]]$object2 <- NULL
  if(time) {
    object@calc.params[[calculation]]$time <- Sys.time()
  }
  return(object)
}

cellsWT <- setdiff( colnames( seurAll@data), grep( "sox", colnames(seurAll@data), value = TRUE))
allData	<- GetAssayData( object = seurAll, assay.type = assay.use,
            		slot = "scale.data")
transformCells	<- colnames( x = seurAll@data)
allData		<- t(allData)

#now calculate UMAP for init data
parameters.to.store <- as.list(x = environment(), all = TRUE)[names(formals("RunUMAP"))]

#fetch UMAP
    umap_import <- import(module = "umap", delay_load = TRUE)
    umap <- umap_import$UMAP(n_neighbors = as.integer(x = myNeighbors),
        n_components = as.integer(x = Dim), metric = myMetric, spread = as.numeric( x = mySpread),
        min_dist = minDist, transform_seed = as.integer( x = UMAPRandSeed))

if( experimentType == "allCells")
{
		transformAll 	<- umap$fit_transform( as.matrix( x = allData))
    		allResObj 	<- seurAll
    		colnames(x = transformAll) <- paste0(reduction.key, 1:ncol(x = transformAll))
    		rownames(x = transformAll) <- transformCells
    		allResObj 	<- SetCalcParams(object = allResObj, calculation = "RunUMAP",
        				... = parameters.to.store)
    		allResObj 	<- SetDimReduction(object = allResObj, reduction.type = reduction.name,
        				slot = "cell.embeddings", new.data = as.matrix(x = transformAll))
    		allResObj 	<- SetDimReduction(object = allResObj, reduction.type = reduction.name,
        				slot = "key", new.data = reduction.key)
		umapRes$All <- allResObj
		return( umapRes)
	}else{
	if( experimentType == "WToutAll"){
		seurWT <- SubsetData( seurAll, cells.use = cellsWT)
		wtData <- allData[ cellsWT, ]
    		transformWT	<- umap$fit_transform( as.matrix( x = wtData))
    		wtResObj <- seurWT
    		colnames(x = transformWT) <- paste0(reduction.key, 1:ncol(x = transformWT))
    		rownames(x = transformWT) <- cellsWT
    		wtResObj <- SetCalcParams(object = wtResObj, calculation = "RunUMAP",
        		... = parameters.to.store)
    		wtResObj <- SetDimReduction(object = wtResObj, reduction.type = reduction.name,
        		slot = "cell.embeddings", new.data = as.matrix(x = transformWT))
    		wtResObj <- SetDimReduction(object = wtResObj, reduction.type = reduction.name,
        		slot = "key", new.data = reduction.key)
		umapRes$WT <- wtResObj
	return( umapRes)
}else{

#now we have "allCondWT"

if( experimentType == "allCondWT"){
#if there is a separate WT object use it to take train data

if( !is.null( seurWT)){ wtData <- GetAssayData(seurWT, slot = "scale.data"); wtData <- t(wtData)}
#otherwise take data by subsetting the allData
		       else{ wtData <- allData[ cellsWT, ]}

#we fit on the wtData and transform all data
    umap 		<- umap$fit( as.matrix( x = wtData))

#transform wt data
    transformWT		<- umap$transform( as.matrix( x = wtData))

    wtResObj <- seurWT
    colnames(x = transformWT) <- paste0(reduction.key, 1:ncol(x = transformWT))
    rownames(x = transformWT) <- cellsWT
    wtResObj <- SetCalcParams(object = wtResObj, calculation = "RunUMAP",
        ... = parameters.to.store)
    wtResObj <- SetDimReduction(object = wtResObj, reduction.type = reduction.name,
        slot = "cell.embeddings", new.data = as.matrix(x = transformWT))
    wtResObj <- SetDimReduction(object = wtResObj, reduction.type = reduction.name,
        slot = "key", new.data = reduction.key)

#transform All data
    transformAll 	<- umap$transform( as.matrix( x = allData))
    allResObj <- seurAll
    colnames(x = transformAll) <- paste0(reduction.key, 1:ncol(x = transformAll))
    rownames(x = transformAll) <- transformCells
    allResObj <- SetCalcParams(object = allResObj, calculation = "RunUMAP",
        ... = parameters.to.store)
    allResObj <- SetDimReduction(object = allResObj, reduction.type = reduction.name,
        slot = "cell.embeddings", new.data = as.matrix(x = transformAll))
    allResObj <- SetDimReduction(object = allResObj, reduction.type = reduction.name,
        slot = "key", new.data = reduction.key)

#prepare return object

    umapRes$All <- allResObj; umapRes$WT <- wtResObj
    return( umapRes)
}else{ cat("Unknown experiment type")}
}	#allCondWT
}
}


library(methods)
library(atSNP)
options(stringsAsFactors = FALSE)

snpfile  = {{i.snpfile | R}}
tffile   = {{i.tffile | R}}
outfile  = {{o.outfile | R}}
outdir   = {{o.outdir | R}}
tfmotifs = {{args.tfmotifs | R}}
fdr      = {{args.fdr | :'BH' if a is True else a | R}}
pval     = {{args.pval | R}}
nthread  = {{args.nthread | R}}
genome   = {{args.genome | R}}
doplot   = {{args.plot | R}}
devpars  = {{args.devpars | R}}
prefix   = file.path(outdir, {{o.outfile | fn2 | R}})

### load desired pwms
# load the list (or motifs)
# col1: motif
# col2: tf
tflist = read.table(tffile, header = FALSE, row.names = NULL, sep = "\t", check.names = FALSE)
# load all of 'em first
pwms = LoadMotifLibrary(tfmotifs)
pwms = pwms[unique(tflist[,1])]

### load snp information
if (endsWith(snpfile, '.bed')) {
	# suppose no head
	# must be a bed file with 7 columns
	# bed6 + alleles (A,C,G)
	# the first is reference allele and rest are mutant alleles
	# first 2 will be used (ref and minor alleles in this case)
	snps    = read.table(snpfile, header = FALSE, row.names = NULL, sep = "\t", check.names = FALSE)
	snpfile = file.path(outdir, 'snps.txt')
	# write it to snpfile for loading
	snps2 = data.frame(snpid = snps[,4], chr = snps[,1], snp = snps[,3])
	snps2 = cbind(snps2, t(sapply(snps[,7], function(x) unlist(strsplit(as.character(x), ',', fixed = T))[1:2])))
	rm(snps)
	colnames(snps2) = c('snpid', 'chr', 'snp', 'a1', 'a2')
	write.table(snps2, file = snpfile, row.names = FALSE, quote = FALSE)
}

snp_info = LoadSNPData(
	snpfile,
	genome.lib       = sprintf("BSgenome.Hsapiens.UCSC.%s", genome),
	half.window.size = max(sapply(pwms, length))/4,
	default.par      = TRUE,
	mutation         = TRUE
)

atsnp.scores = ComputeMotifScore(pwms, snp_info, ncores = nthread)
atsnp.result = ComputePValues(motif.lib = pwms, snp.info = snp_info, motif.scores = atsnp.scores$motif.scores, ncores = nthread)
atsnp.result = atsnp.result[order(pval_rank) & pval_rank <= pval, list(snpid, motif, pval_ref, pval_snp, pval_rank)]
colnames(atsnp.result) = c('Snp', 'Motif', 'Pval_Ref', 'Pval_Mut', 'Pval_Diff')
atsnp.result[, TF := paste(tflist[which(tflist[,1] == Motif), 2], collapse = ',')]
atsnp.result = atsnp.result[, list(Snp, TF, Motif, Pval_Ref, Pval_Mut, Pval_Diff)]
if (fdr != FALSE) {
	atsnp.result[, Qval_Diff := p.adjust(Pval_Diff, method = fdr)]
}
write.table(atsnp.result, outfile, col.names = TRUE, row.names = FALSE, sep = "\t", quote = FALSE)

if (doplot) {
	for (i in 1:nrow(atsnp.result)) {
		plotfile = paste(prefix, atsnp.result[i, Snp], atsnp.result[i, TF], atsnp.result[i, Motif], 'png', sep = '.')
		devpars$file = plotfile
		do.call(png, devpars)
		plotMotifMatch(
			snp.tbl      = atsnp.scores$snp.tbl,
			motif.scores = atsnp.scores$motif.scores,
			snpid        = atsnp.result[i, Snp],
			motif.lib    = pwms,
			motif        = atsnp.result[i, Motif])
		dev.off()
	}
}


  # ---------------------------------------- low-level data access

	load.seabird.rawdata = function(fn, f, set, plotdata=F) {

    out = NULL

    filename= fn[f]
    header =  readLines(filename, n=75)
    headerall = paste( header[1:12], collapse="~")

    if (length(header) < 75 )  return( out )

    data.start = grep( "start sample number", header, perl=T )
    if (grepl( "test", header[ 7 ], ignore.case=T) ) return(out)

    fileinfo = tolower(unlist(strsplit(filename, split="/")))
    seabird = as.data.frame(read.table( file=filename, sep=",", as.is=T, colClasses="character", header=F, skip= data.start, strip.white=T))

    if ( nrow(seabird) < 10 ) return( NULL )
    if(ncol(seabird)==1) {
      #AMC ADDED 2013 FOR FUNCTIONALITY AND IF SEABIRD DATA NOT SEPARAETED OUT BY COLUMNS
      seabird = as.data.frame(matrix(apply(seabird,2,function(x) unlist(strsplit(x,","))),ncol=4,byrow=T))
    }

    tz.system = "America/Halifax"
    tz.seabird = "America/Halifax"
    tz.snowcrab = "UTC"

    # if time is not correct in seabird file and is due to DST fix by BMC
    mhead = readLines(filename, n=40)
    #local time
    lt = mhead[grep("System UpLoad Time",mhead)]
    lt = unlist(strsplit(unlist(strsplit(lt,"= "))[2], " "))
    lt  = lubridate::mdy_hms( paste( paste(lt[1],lt[2],lt[3],sep="-"), lt[4]), tz=tz.system )

    #seabird time
    st = mhead[grep("SERIAL NO", mhead)]
    st = unlist(strsplit(unlist(strsplit(st,"    "))[2], "  "))
    st  = lubridate::dmy_hms( paste( st[1], st[2]), tz=tz.seabird )

    #add difference to seabird times
    colnames(seabird) = c( "temperature", "pressure", "mdate", "mtime")

    seabird$timestamp = lubridate::dmy_hms( paste( trimWhiteSpace(seabird$mdate), trimWhiteSpace(seabird$mtime) ), tz=tz.seabird )

    seabird$timestamp = with_tz( seabird$timestamp, tz.snowcrab )  # from now on, seabird is UTC

  # BC 2018 - Seabird header data not populated in single instance so comparing system time with seabird
  #           time is not accurate to get time offset betweem system and seabird. Seabird is time is synced
  #           to system time every morning and should not be more than a few seconds in difference.
  # seabird$timestamp = seabird$timestamp + difftime(lt,st)

    numerics = c("temperature", "pressure")
    seabird = factor2number(seabird, numerics)

    # check time first
    seabird.date.range = range( seabird$timestamp )

    setxi = which( set$timestamp >= seabird.date.range[1] & set$timestamp <= seabird.date.range[2] )
    if ( length( setxi ) == 0 ) return(NULL)

    yr = lubridate::year( seabird$timestamp[1] )
    if(months(seabird$timestamp[1]) %in% c("January")){
      yr = lubridate::year( seabird$timestamp[1] ) -1
    }

    # First pass:
    # break down multi-set records into separate records using a simple depth rule
    print (filename)

    seabird$pressure = adjust.depth.for.drift( seabird$pressure )
    surface = quantile( seabird$pressure, probs=0.5 ) # pressure at which it is assumed the sensor in at surface (most data will be shallow)

    # initiate new variables
    seabird$seabird_uid = NA
    seabird$depth = NA

    metadata = NULL
    for ( ssid in 1:length(setxi) ) {

	    filename2 = tolower( fileinfo[length(fileinfo)] )

      iset = setxi[ssid]
      setx =  set[iset,] # matching trip/set/station

      # find sets by running until some threshold depth is found, stating with set$chron
      istart = which.min( abs( difftime( seabird$timestamp, set$timestamp[iset] )) )

      j0 = istart
      while ( j0 > 1 ) {
        if (seabird$pressure[j0] <= surface ) break()
        j0 = j0 - 1
      }
      tdiff0 = abs( difftime( seabird$timestamp[j0], set$timestamp[iset] ))
      if ( tdiff0 > lubridate::minutes(10) ) {
        # then something went wrong .. default to a few minutes before set$chron
        j0 = which.min( abs( difftime( seabird$timestamp, (set$timestamp[iset] - lubridate::minutes(5) ) )) )
      }

      j1 = istart
      while ( j1 < nrow(seabird) ) {
        if (seabird$pressure[j1] <= surface ) break()
        j1 = j1 + 1
      }
      tdiff1 = abs( difftime( seabird$timestamp[j1], set$timestamp[iset] ))
      if ( tdiff1 > lubridate::minutes(15) ) {
        # then something went wrong .. default to a few minutes before set$chron
        j1 = which.min( abs( difftime( seabird$timestamp, (set$timestamp[iset] + lubridate::minutes(12) ) )) )
      }

      if(j0==j1){ #skip some entries and then re calculate
        j1=j1+20
          while ( j1 < nrow(seabird) ) {
        if (seabird$pressure[j1] <= surface ) break()
        j1 = j1 + 1
      }
      }

      o = j0:j1
      error = "" #dummy value
      if (length(o) < 30) {
        # no matching time range found ... use closest match and raise a flag
        # data stream did not start appropriately .. use minilogs
        ot = which.min( abs( difftime( seabird$timestamp, setx$timestamp) ) )
        o =  which( seabird$timestamp >= (seabird$timestamp[ot]- lubridate::minutes(2) ) &
                    seabird$timestamp <= (seabird$timestamp[ot] + lubridate::minutes(10) )  )  # 5 min tow + 5 min in case
        print( "No set data matched for seabird data:")
        print( filename )
        print( head( seabird[ o,] ) )
        print( "The following is the closest matching in set:")
        print( setx)
          if(plotdata){
            setinfo = set[setxi,]
            fp =  file.path( project.datadirectory("bio.snowcrab"), "data", "seabird", "mismatches", yr)
            dir.create( fp, recursive = TRUE, showWarnings = FALSE )
            pdf(file.path(fp,paste(setinfo$trip[1],'pdf',sep='.') ),12,8)
            plot(seabird$timestamp, -seabird$pressure,type='l',main=setinfo$trip[1])
            points(setinfo$timestamp, rep(0,nrow(setinfo)),pch=16,col='red')
            dev.off()
          }
        next()
      }

      zmaxi = which.max( as.numeric( seabird$pressure[o] ) )
      if (length(zmaxi)==0) stop('need depth data use esonar') #zmaxi = which.min( as.numeric( seabird$temperature[o]) ) #should use esonar depth if no depth in seabird dont do this step ever
      if (length(zmaxi)==0) zmaxi = floor( length(o) / 2 )  # take midpoint

      tstamp = seabird$timestamp[o[zmaxi]]
      uid =  paste( "seabird", setx$trip, setx$set, setx$station, lubridate::hour(tstamp), lubridate::minute(tstamp), f, sep=".")
      seabird$seabird_uid[o] = uid
      seabird$depth[o] = decibar2depth ( P=seabird$pressure[o], lat=setx$lat )
      studyid = paste( setx$trip, setx$set, setx$station, sep="." )
      out = data.frame( uid, yr, seabird$timestamp[o[zmaxi]], setx$trip, setx$set, setx$station, studyid, setx$Zx, setx$timestamp, error, filename2, headerall, stringsAsFactors=FALSE )
      names( out ) = c( "seabird_uid", "yr", "timestamp", "trip", "set", "station", "studyid", "setZx", "set_timestamp", "error", "filename", "headerall" )
      metadata = rbind( metadata, out )
    }

    basedata = seabird[ which( !is.na( seabird$seabird_uid) ) ,]

    return( list( metadata=metadata, basedata=basedata ) )
  }


# Exercise 3

# 1) Convert the following character vector to a factor:

colors <- c("Red", "Blue", "Green", "Yellow", "Black", "Red", "Blue", "Green", "Black", "Red", "Blue", "Green", "Yellow", "Black", "Red", "Blue", "Green", "Black", "Green", "Green")

# Answer:
factor_color <- factor(colors, ordered = FALSE, levels = c("Red", "Blue", "Green", "Yellow", "Black"))
factor_color

# Alternatively...
factor_color <- as.factor(colors)
factor_color

# 2) What command will print only the non-missing values in the following vector?

v <- c(1, 2, 3, NA, 5, 6, NA, NA)

# Answer:
v[!is.na(v)]

# 3) How would you permanently remove all NA's from 'v'?

# Answer:
# Remove all NA's
v <- v[!is.na(v)]


test <- function(i, j) {
    return(i*j)
}

main <- function() {
    i <- 3
    j <- 2
    k <- test(i, j)
    if (k > 5) {
        print(">5")
    } else {
        print("<=5")
    }
}

main()