##################################################
## Project: A workflow for missing values imputation of untargeted metabolomics data
## Script purpose: Imputes missing values in metabolite data using MICE-pmm or kNN-obs-sel
## Date: 20220311
## Author:Tariq faquih
##################################################

library(docstring)

get_aux_mets <- function(data_cor ,  Met , ccm, maxN = 10) {
    #' Function that selects the 10 strongest correlated metabolites
    #'
    #' @param data_cor the data correlation matrix for the metabolites
    #' @param Met name of the metabolite column with missing value
    #' @param ccm vector with the column names of the complete cases
    #'
    cor_x = data_cor[which(colnames(data_cor) == Met) ,]
    cor_x <- abs(cor_x[names(cor_x) %in% ( ccm )])
    Preds = c(na.omit(sort(cor_x , decreasing = T)[1:maxN]))
    return(Preds)
}

getscaleval <- function(x, dat) {
    #' Scales values and stores the mean and sd
    #'
    #' @description  a function that scales the data (z-transform) and stores the values for reversing the scaling
    #'
    #'
    #' @param x the metabolite column name
    #' @param dat the main dataframe of x
    #'
    #' @return dataframe with the scale and center attributes
    #'

    y <- scale(dat[x], center = TRUE, scale = TRUE)
    return(data.frame('scale' = attr(y , 'scaled:scale') , 'center' = attr(y , 'scaled:center') ))
}

unscale <- function (x, d) {
    #' #function that unsclaes the values using the orginal mean
    #'
    #' function that uses the scale atrributes stored by getscaleval in the dataframe "scale_info" to unscale the metabolites values after the imputation is done
    #'
    #' @param x the metabolite column name
    #' @param d the main dataframe of x
    #'
    #' @details a simple functions that unscales the values of a dataframe using the orginal attributes from the scale command.
    #' This function must be run AFTER getscaleval. getscaleval creates the dataframe scale_info that is needed here.
    #'

    #d = dataframe, x = variable name

    d[x] * scale_info[x,'scale'] + scale_info[x,'center']
}

useknn2 <- function(X , dataframe , data_cor, ccm , maxN_input ) {
    #' knn imputation function
    #'
    #' function that runs the knn imputation from the VIM package
    #'
    #' @param X name of the metabolite column with missing values
    #' @param dataframe the dataframe with the missing and complete metabolites
    #' @param data_cor the data correlation matrix for the metabolites
    #' @param ccm vector with the column names of the complete cases
    #' @details requires the metabolite with missing valuesm the main data, the correlation matrix, the names of metabolites with no missing values
    #' the 10 strongest metabolites are selected and used to make a subdata with X
    #'

    require(VIM)
    Preds = get_aux_mets(data_cor , X ,ccm , maxN , maxN_input )
    mean_qual = mean(Preds , na.rm = T)
    QualSummary <<- rbind(QualSummary , data.frame('Metabolite' = X , 'Mean_Quality' = mean_qual))
    cluster = c(names(Preds) , X )
    minidf <- dataframe[cluster]

    output <- as.data.frame(kNN(data = minidf,
                               variable = X ,
                               dist_var = cluster[1:length(cluster)-1] ,
                               numFun = mean ,
                               k=10))[X]
    return(output[X])
    }

usemice2 <- function(X , dataframe , data_cor, O, co_vars, ccm, long , m , use_co_vars = FALSE ,logScale = TRUE , maxN_input) {
    #' mice imputatuion function.
    #'
    #' function that runs the mice imputation from the MICE package.
    #'
    #' @param X name of the metabolite column with missing values
    #' @param dataframe the dataframe with the missing and complete metabolites
    #' @param data_cor the data correlation matrix for the metabolites
    #' @param o the name if the outcome variable
    #' @param co_vars name of the covariables column names
    #' @param ccm vector with the column names of the complete cases
    #' @param long logical argument to specify the output format
    #' @param m number if imputations
    #' @param use_co_vars logical argument to use the covariables for the imputation
    #' @param logScale logcial. inherits the logScale option from UnMetImp
    #'
    #'
    #' @details function that runs the mice imputation, requires X, the main data, the correlation matrix, the metabolites with no missing values
    #' long to adjust the number of variables in the output of this function (TRUE only if the loop iteration is n>1)
    #'
    #' optional argumnets are the O for the outcome, co_vars for the covariants that will be needed for the analysis model(s),
    #' m is the number of imputations to be done, use_co_vars is true only if you want to use these variables as predcitors for the imputation
    #'
    #' Long is set to FALSE if this the first variable in the loop, in this case only we select the .imp (imputation number), .id (the original row number), the outcome, the covars (only if use_co_vars is TRUE), X1.
    #'
    #' For the remaining iterations in the loop we do not need these columns again so we only extract Xn

    #step 1 creating a subset for X and the predictor variables to be used to calculate the imputation values
    Preds = get_aux_mets(data_cor , X ,ccm , maxN = maxN_input )
    mean_qual = mean(Preds , na.rm = T)
    if (use_co_vars == TRUE){
        cluster = c(O, co_vars , names(Preds) , X )}
    else {cluster = c(O , names(Preds) , X )
         co_vars = NULL}
    minidf <- dataframe[cluster]
    #the mean of the correlations is added to QualSummary
    QualSummary <<- rbind(QualSummary , data.frame('Metabolite' = X , 'Mean_Quality' = mean_qual))

    #Where matrix specifies which missing values to impute, we state that only missing values in X are to be imputed (set to TRUE)
    #other values are set to FALSE
    where_matrix <- make.where(minidf)
    Dont_Impute <- cluster[!cluster %in% c(X)]
    where_matrix[, Dont_Impute] = FALSE
    #We also create a prediction matrix. Note: if the metabolite is collinear or constant it will be dropped and will not be imputed
    #please check micelog from the output or mids$loggedEvents. see mice.mids @ https://cran.r-project.org/web/packages/mice/mice.pdf
    Pred_matrix <- make.predictorMatrix(minidf)
    #The actual imputation step using the mice package
    IMP <- mice(minidf ,printFlag = FALSE , m= m , where = where_matrix , predictorMatrix =  Pred_matrix)

    #Long is set to FALSE if this the first variable in the loop, in this case only we select the .imp (imputation number), .id (the original row number), the outcome, the covars (only if use_co_vars is TRUE), X1.
    #For the remaining iterations in the loop we do not need these columns again so we only extract Xn

    if (long) {output <- complete(IMP ,  action = 'long' , include = TRUE)[X]}

    else {output <- complete(IMP ,  action = 'long' , include = TRUE)[c('.imp','.id', O , co_vars , X )]
         if (logScale) {
             output[X] <- exp(as.data.frame(do.call(cbind , lapply(X , FUN =  unscale, d = output)))) }

         }
    return(output)
}

# the main function to be used by the user
#required args are the DataFrame and imp_type (mice or knn), group1:  a vector of the variable NAMES to be imputed with mice or knn
#group2 are variables to imputed with zero (xenobiotics)
#optional args: number_m: number of multiple imputations for mice
#outcome variable to used with mice imputation
#covars: variables that will be used in the later analysis after the mice imputation
#use_covars: set to TRUE if the co variables should be used for the imputation (not required for mice, IMPORTANT: will NOT work if the co vars have any missing values)
#fileoutname: name of the output name for the knn or mice imputation as an csv sheet
#logScale:

UnMetImp <- function(DataFrame , imp_type = 'mice' , number_m = 5 , group1 , group2 = NULL , outcome=NULL,
                 covars=NULL, fileoutname = NULL , use_covars = FALSE , logScale = TRUE , covars_only_mode = FALSE , maxN_input = 10) {
    require(mice)
    require(dplyr)

    #' UnMetImp: main function to impute the metabolites
    #'
    #' Function that imputes the data with MICE-pmm or knn-obs-sel.
    #' Both methods use a correlation matrix of the metabolites and selects the best correlated completed cases to imputes the values.
    #'
    #' @param x The value to be squared
    #' @param DataFrame: The full dataframe to be used with all the metabolites, covariables and the outcome. Must numeric. Must be a dataframe.
    #' @param imp_type: String. Type of imputation to be used: mice or knn. Default is mice.
    #' @param number_m: Numeric. For __imp_type == "mice"__ only. Number of imputations to be used. Default = 5.
    #' @param group1: Vector. Required. Vector with the names of metabolite columns. Will be imputed using the provided __imp_type__.
    #' @param group2: Vector. Optional. Vector with the names of metabolite columns. Will be imputed to zero.
    #' @param outcome: String. Required. The outcome variable to be used in the future analysis.
    #' @param covars: Vector. Recommended. variables used in the future analysis. Will be returned with the imputed data.
    #' @param fileoutname: String value. Optional. Saves the imputed output to a file.
    #' @param use_covars: Logical. Optional. Whether the __covars__ will be used to impute the missing values in the metabolites. Default = FALSE.
    #' @param logScale: Logical. Optional. Whether the values need to be log and scaled for the imputation. if TRUE, the values will be log and scaled then un-log and unscaled before returning the imputed output. If FALSE, script will assume you have log the values. Default = TRUE.
    #' @param covars_only_mode: an option to only use the covariables for the imputation, ignoring all other metabolites. Useful in case of collinear/constant variables. only works with mice imputation
    #' @param maxN_input: sets the max number of ccm metabolites to be used for the imputation. Default is 10. Is overridden if covars_only_mode == TRUE. Useful in case of collinear/constant variables.
    #'
    #' @details The user provides two lists of metabolites: *group1* to be imputed using MICE-pmm or kNN-obs-sel; *group2* to be impute with zero.
    #'
    #' The user must also provide the variables t be used in the analysis after the imputation including the outcome.
    #'
    #' A correlation matrix is created for all the *group1* metabolites.
    #'
    #' The *group1* metabolites are split to complete cases metabolites(ccm) and incomplete cases metabolites(icm).
    #'
    #' For each icm, *maxN_input* number of ccm with the highest absolute R correlation are selected. These will be used to impute the missing values in icm.
    #' if the icm has more than 90% missing values OR if the number of non-missing values in less than the number of predictor variables + 20.
    #' This is done to because of two reasons:
    #' 1- to eliminate possibly mis-annotated metabolites or unannotated metabolites that are xenobiotic in nature,
    #' 2- To ensure the availability of enough cases to perform the imputation.
    #'
    #' This issue prevents the MICE package from performing the imputation all together.
    #'
    #' The invalid cases will be imputed to zero.
    #'
    #' The imputed results are returned with 3 objects; The imputed data, the summary of the imputation, the mean R of the ccm used for each icm.

    #ptm <- proc.time()
    if (logScale) {
    #Step 1 log: normal dist, outliers effect reduced
    assign(x = 'scale_info' ,value = do.call(rbind , lapply(group1 , FUN =getscaleval, dat = log( DataFrame[group1] ) )),
                        envir =.GlobalEnv)
        }
    #QualSummary will be used to store the mean correlation of each metabolite with missing values
    assign(x = 'QualSummary' ,value = data.frame() ,
                        envir =.GlobalEnv)

    #Step2: calculate number of missing values in each metabolites, split them into complete ccm and incomplete icm
    l =lapply(DataFrame[group1] , function (x) {sum(is.na(x))})
    ccm <- names(l)[l == 0]
    #If the missing is too large in the group1 metabolites then imputation becomes difficult or impossible.
    #The metabolite is most likely a xenobiotic and truly missing. These will be imputed to zero
    miss90 = nrow(DataFrame) * 0.9
    maxpreds = (20 + length(covars))
    if (miss90 > maxpreds) {cutoff = miss90} else {cutoff = maxpreds}
    icm <- l[l > 0 & l < cutoff ]
    icm_names <- names(icm)
    invalids <- names(l)[l >= cutoff ]

    #Step3: create a correlation matrix
    data_cor = cor(DataFrame[c(ccm, icm_names)] , use="p")
    #Step4: check if there is actually missing values
    if (length(icm) == 0) {return('There are no missing data in the group 1 metabolites')}

    #Step5: set group2 missing values to zero and store their names
    group2_summary = 0
    if (is.null(group2) == FALSE ) {
        group2_summary = colnames(DataFrame[group2][!complete.cases(t(DataFrame[group2]))])
        DataFrame[group2][is.na(DataFrame[group2])] <- 0
    }
    #Step 6: set the "invalid" (>90% missing etc) variables to zero
    if (length(invalids) > 0 ) {
        DataFrame[invalids][is.na(DataFrame[invalids])] <- 0
    }

    #Step 7: scale and log the ccm and icm metabolites ONLY
    if (logScale) {
    	DataFrame[c(ccm , icm_names)] <- scale(log( DataFrame[c(ccm , icm_names)] )) }

    #Summary of the imputation used for which variables
    msummary <- list('Imputed' = icm_names, 'Bad Case' = invalids, 'Zero' = group2_summary ,
                     'collinear' = mice:::find.collinear(DataFrame[c(group1,  group2 , covars)]) )

    #knn imputation option
    if (imp_type == 'knn') {
        #This calls the useknn2 function above. output is un-scaled and exponentialized and returned as object.
        #can also be saved to a csv file if fileoutname is provided
        output = do.call(cbind, lapply(icm_names, FUN = useknn2, dataframe = DataFrame , data_cor = data_cor, ccm = ccm , maxN_input = maxN_input))
        if (logScale) {
            DataFrame[ccm] <-  exp(as.data.frame(do.call(cbind , lapply(ccm ,FUN =  unscale, d = DataFrame[ccm]))) )
            output <- exp(as.data.frame(do.call(cbind,lapply(colnames(output),FUN =  unscale, d = output)))) }
        #the imputed variables replace their orginals in the main dataframe
        DataFrame[colnames(output)] <- output

        if (is.null(fileoutname)) {
            #write.csv(DataFrame , file = paste('Imputed_Data_KNN_',Sys.Date(),'.csv', sep = '') , row.names = FALSE)
        }
        else {write.csv(DataFrame , file = paste(fileoutname , '_Imputed_Data_KNN','.csv', sep = '') , row.names = FALSE)}
        return(list(mids = DataFrame , Msummary = msummary, QS = QualSummary))
    }

    #mice imputation section
    else if ( imp_type == 'mice' ){
        if (covars_only_mode) {
            logScale <- FALSE
            ccm <- NULL
            use_covars <- TRUE
            if (is.null(covars) ) {return('Please include covariables')}
        }

        #Only the first variable with missing values is imputed here (see usemice2 fucntion for details)
        firstmids <- usemice2(X = icm_names[1] , dataframe = DataFrame ,
                              data_cor = data_cor,
                              ccm = ccm ,
                              O= outcome,
                              co_vars = covars,
                              long = FALSE ,
                              use_co_vars = use_covars,
                              m= number_m,
                              logScale = logScale,
                              maxN_input = maxN_input
                             )

        #if , for whatever reason, there is only one metabolite with missingness, the next step will not be run
        #Otherwise the remaining variables will be imputed then merged with the togther and with the first variable
        if (length(icm_names) > 1) {
            allmids <- as.data.frame(do.call(cbind , lapply(icm_names[2:length(icm_names)] , FUN = usemice2 ,
                                            dataframe = DataFrame ,
                                            data_cor = data_cor,
                                            ccm = ccm ,
                                            O=outcome,
                                            co_vars = covars,
                                            long = TRUE ,
                                            use_co_vars = use_covars,
                                            m=number_m,
                                            logScale = logScale,
                                            maxN_input = maxN_input)))
            if (logScale) {
            allmids <- cbind(firstmids , exp(as.data.frame(do.call(cbind,lapply(colnames(allmids),
                                                                                FUN =  unscale, d = allmids)))) )
                } else {allmids <- cbind(firstmids , allmids) }
        }
        #only used if there is one variable with missing values
        else{allmids <- firstmids}

        #output is un-scaled and exponentialized and returned as object
        if (logScale) {
            DataFrame[ccm] <-  exp(as.data.frame(do.call(cbind , lapply(ccm ,FUN =  unscale, d = DataFrame[ccm]))) )
            }

        #the other variables from ccm and group2 must be merged with the multiple imputation data generated
        #duplicate the rows of other metabolies number_m times then bind them to the allmids data frame

        othersDF <- DataFrame[c(ccm, invalids, group2)]
        #allmids  <- cbind(allmids ,othersDF[rep(1:nrow(DataFrame) , number_m+1) , colnames(othersDF) ])
        allmids[colnames(othersDF)] = othersDF[rep(1:nrow(DataFrame) , number_m+1) , colnames(othersDF) ]

        #we also need to add the variables that will be used in the analysis model(s). if use_covars was set to TRUE, then
        #these variables would have been added in the usemice2 function. otherwise, it is done here
        if (use_covars == FALSE) {
            covarsDF <- DataFrame[covars]
            allmids[covars] = covarsDF[rep(1:nrow(DataFrame) , number_m+1) , colnames(covarsDF) ]
            }

        #can also be saved to a csv file if fileoutname is provided
        if (is.null(fileoutname)) {
            #write.csv(allmids , file = paste('Imputed_Data_MICE_',Sys.Date(),'.csv', sep = '') , row.names = FALSE)
        }
        else {write.csv(allmids , file = paste(fileoutname , '_Imputed_Data_MICE','.csv', sep = '') , row.names = FALSE)}

        #convert allmids to a "mids" object, the object format required by the mice package to run the analysis
        allmids <- as.mids(allmids)

        return(list(mids = allmids , Msummary = msummary , QS = QualSummary , micelog = allmids$loggedEvents))
        }

}


library(methods)
{{rimport}}('__init__.r', 'plot.r')

indir  = {{i.indir | R}}
outdir = {{o.outdir | R}}

plink   = {{args.plink | R}}
cutoff  = {{args.cutoff | R}}
devpars = {{args.devpars | R}}

bedfile = Sys.glob(file.path(indir, '*.bed'))
input   = tools::file_path_sans_ext(bedfile)
output  = file.path(outdir, basename(input))

params = list(
	bfile = input,
	hardy = T,
	out   = output
)
cmd = sprintf("%s %s 1>&2", plink, cmdargs(params, equal = ' '))
runcmd(cmd)

hardy = read.table(paste0(output, '.hwe'), header = T, row.names = NULL, check.names = F)
hardy.fail = hardy[which(hardy$P < cutoff), 'SNP', drop = F]
write.table(hardy.fail, paste0(output, '.hardy.fail'), col.names = F, row.names = F, sep = "\t", quote = F)

{% if args.plot %}
hardy$Pval   = -log10(hardy$P)
hardy$Status = "Pass"
hardy[which(hardy$SNP %in% hardy.fail$SNP), "Status"] = "Fail"

plot.histo(
	data     = hardy,
	x        = 'Pval',
	plotfile = paste0(output, '.hardy.png'),
	params   = list(aes(fill=Status), bins = 50),
	ggs      = list(
		xlab       = list("-log10(HWE p-value)"),
		ylab       = list("Count"),
		geom_vline = list(xintercept = -log10(cutoff), color = "red", linetype="dashed"),
		theme      = list(legend.position = "none"),
		geom_text  = list(
			aes(x = -log10(cutoff), y = Inf, label = cutoff),
			colour="red", angle=90, vjust = 1.2, hjust = 1.2
		)
	),
	devpars = devpars
)
{% endif %}


#install packages ## ** block -> ctrl+enter
install.packages("stringr")
#string data / str_length(), str_sub()
install.packages("KoNLP") #Korean
install.packages(("doBy"))
#data / summaryBy(), orderBy(), sampleBy()
install.packages(("sqldf"))
install.packages("plyr")
#data / adply(), ddply(), mdply() /merge, add, deduct
install.packages("reshape2")
#data / melt(), cast()

'''
*필수, 코드파일 실행 후 위의 package install block 설정 후, run(ctrl+enter)해주세요.
그래도 한글이 깨질 경우,
1. 파일 내의 library(package) - block 후에 ctrl+enter로 설치
2. R studio - 상단 Tools - Global Options - Code - Saving - Default text encoding - Change - (UTF-8)
'''

# =======================================================
# 01. 다음과 같은 벡터 객체를 생성하시오.
# =======================================================

#조건1. Vec1 벡터 변수를 만들고, "R" 문자가 5회 반복되도록 하시오.

#조건2. Vec2 벡터 변수에 1~10까지 3 간격으로 연속된 정수를 만드시오

#조건3. Vec3에는 1~10까지 3 간격으로 연속된 정수가 3회 반복되도록 만드시오.

#조건4. Vec4에는 Vec2 ~ Vec3가 모두 포함되는 벡터를 만드시오

#조건5. 25 ~ -15까지 5 간격으로 벡터 생성 (seq 사용)

#조건6. Vec4에서 홀수번째 값들만 선택하여 Vec5에 할당하시오

# =======================================================
# 02. 다음과 같은 벡터를 칼럼으로 갖는 데이터프레임을 생성하시오
# =======================================================

# 다음---------------------------------------------------
name	<- c('최민수', '유관수', '이순신', '김유신', '홍길동')
age		<- c(55, 45, 45, 53, 15)
gender	<- c(1, 2, 1, 1, 1)
job		<- c('연예인', '주부', '군인', '직장인', '학생')
sat		<- c(3, 4, 2, 5, 5)
grade	<- c('C', 'C', 'A', 'D', 'A')
total	<- c(44.4, 28.5, 43.5, NA, 27.1)

#조건1. 위 7개의 벡터를 칼럼으로 갖는 user 데이터 프레임 생성

#조건2. gender 변수를 이용하여 히스토그램 그리기

#조건3. user에서 짝수행만 선택해서 user2에 넣기

# =======================================================
# 03. Data를 대상으로 apply()를 적용하여 행/열 방향으로 조건에 맞게 통계량을 구하시오.
# =======================================================
# 다음---------------------------------------------------
kor	<- c(90, 85, 90)
eng	<- c(70, 85, 75)
mat	<- c(86, 92, 88)

#조건1. 3개의 과목점수를 이용하여 데이터프레임(Data)를 생성한다.

#조건2. 행/열 방향으로 max()함수를 적용하여 최댓값 구하기

#조건3. 행/열 방향으로 mean()함수를 적용하여 평균 구하기(소숫점 2자리 표현)

#조건4. 행 단위 분산과 표준편차 구하기

# =======================================================
# 04. 다음의 Data2 객체를 대상으로 정규표현식을 적용하여 문자열을 처리하시오.
# =======================================================
# 다음---------------------------------------------------
Data2 <- c('2017-02-05 수입3000원', '2017-02-06 수입4500원', '2017-02-07 수입2500원')
library(stringr)

#조건1. 일자별 수입을 다음과 같이 출력하시오.

#조건2. 위 벡터에서 연속하여 2개 이상 나오는 모든 숫자를 제거하시오

#조건3. 위 벡터에서 -를 /로 치환하시오

#조건4. 모든 원소를 쉼표(,)에 의해서 하나의 문자열로 합치시오


library(plyr)
library(knitr)
setwd("C:/GitHub/GCD_CourseProject/")
##  Unzips the downloaded file in the directory
unzip("getdata-projectfiles-UCI HAR Dataset.zip")

##  Extracting all the data from the files
##  Columns names are specified in the beginning itself using col.names argument
activity_labels <- read.table("UCI HAR Dataset/activity_labels.txt", row.names=NULL, col.names=c("ActivityID", "Activity"))
features <- read.table("UCI HAR Dataset/features.txt", row.names=NULL, col.names=c("FeatureID", "Feature"))

## Extracting data from the test folder
# Identifies the person who performed the experiment for test and training sets - range will always be within 1-30
subject_test <- read.table("UCI HAR Dataset/test/subject_test.txt", row.names=NULL, col.names="SubjectID")
subject_train <- read.table("UCI HAR Dataset/train/subject_train.txt", row.names=NULL, col.names="SubjectID")

# Identifies the activity for test and training sets - range will always be within 1-6
activity_test <- read.table("UCI HAR Dataset/test/y_test.txt", row.names=NULL, col.names="ActivityID")
activity_train <- read.table("UCI HAR Dataset/train/y_train.txt", row.names=NULL, col.names="ActivityID")

# 561-feature vector for training and test set
# **** Criteria 4 : columns names are descriptive using features dataset****
X_test <- read.table("UCI HAR Dataset/test/X_test.txt", row.names=NULL, col.names=features[,2])
X_train <- read.table("UCI HAR Dataset/train/X_train.txt", row.names=NULL, col.names=features[,2])

##  Creating a merged training and test dataset
# Final merged set combining all the observations from test and training sets
# 2947 obs. + 7352 obs. = 10299 obs. in the final set
# **** Criteria 3 : Uses descriptive activity names to name the activities in the data set
merged_activity <- rbind(activity_train, activity_test)
merged_activity <- merge(merged_activity, activity_labels, by="ActivityID")
# Merging list of activites and subjectID
merged_subject <- rbind(subject_train, subject_test)
merged_data <- rbind(X_test, X_train)
# **** Criteria 1 : Merges the training and the test sets to create one data set.
final_set <- cbind(merged_subject, merged_activity, merged_data)
rm(merged_activity, merged_subject, merged_data)

# **** Criteria 2 : Extracts only the measurements on the mean and standard deviation for each measurement.
meansCol <- colnames(final_set)[grep("mean()", colnames(final_set))]
stdCol <- colnames(final_set)[grep("std()", colnames(final_set))]
init <- colnames(final_set)[c(1:3)]
mergeCol <- c(init, meansCol, stdCol)
newset <- final_set[,mergeCol]
rm(meansCol, stdCol, init, mergeCol)

# **** Criteria 5 : Creating tidy data set with averages
## Factorizing the relevant variables in the dataset
newset$ActivityID <- as.factor(newset$ActivityID)
newset$Activity <- as.factor(newset$Activity)
newset$SubjectID <- as.factor(newset$SubjectID)

# Function takes feature names, factor and function to return a dataframe in the
# following format :
# ......     Factor1 Factor2 Factor 3...
# Feature 1
# Feature 2
# ....
stat_byfactor <- function(data, f, variableNames, stat){
  result <- data.frame(NULL)
  for(variable in variableNames){
    newrow <- tapply(data[,variable], f, stat)
    result <- rbind(result, newrow)
  }
  colnames(result) <- levels(f)
  rownames(result) <- variableNames
  result
}

# Two tables created with means of each variable by activity and subjectID
variableNames <- colnames(newset)[c(4:length(colnames(newset)))]
result_act <- stat_byfactor(newset, newset$Activity, variableNames, stat="mean")
result_subj <- stat_byfactor(newset, newset$SubjectID, variableNames, stat="mean")

# Merging two tables by feature names
tidydata <- merge(result_act, result_subj, by="row.names")

# Printing tidydata into a textfile
write.table(tidydata, file="tidydata.txt", row.name=FALSE, sep="\t\t")


pdf_file<-"pdf/timeseries_forecast_interval_1x5.pdf"
cairo_pdf(bg="grey98", pdf_file,width=11,height=7)

par(mfcol=c(1,5),omi=c(1.0,0.25,1.45,0.25),mai=c(0,0.75,0.25,0),family="Lato Light",las=1)

# Import data and prepare chart

UNPop<-read.csv("myData/UNPop.csv")
mySelection<-c("World","Northern America","China","Africa","Germany")
ymin<-c(1000,170,500,200,40)
ymax<-c(17000,800,1700,5200,110)
myTitle<-c("World","Northern America","China","Africa","Germany")

# Create charts and other elements

for (i in 1:length(mySelection)) {
source("scripts/inc_forecast_interval_05.r")
mtext(myTitle[[i]],side=3,adj=0,line=1,cex=1.1,font=3)

if (myTitle[[i]] == "World")
{
legend(1900,-1750,c("Upper prognosis ","Medium prognosis","Lower prognosis"),fill=c("grey","grey","grey"),border=F,xpd=NA,pch=15,col=c("black","white","orange"),bty="n",cex=1.6,ncol=3)
}
}

# Titling

mtext("UN Population Forecasts",3,line=7,adj=0,cex=2.25,family="Lato Black",outer=T)
mtext("values in millions, 5 year values",3,line=3.5,adj=0,cex=1.75,font=3,outer=T)
mtext("Source: UN World Population Prospects: The 2010 Revision",1,line=5,adj=1.0,cex=0.95,font=3,outer=T)
dev.off()


# R functions to plot data from a block design
#   illustrated using the schiz2 data frame

# code to create schiz2 from the raw data (schiz.txt)
#  is in schiz.r

# plot data, putting pair # on the X axis

# done in two parts: put up the frame,
#  then use text to label points with the trt
plot(schiz2$pair,schiz2$y,type='n')
text(schiz2$pair,schiz2$y,substring(schiz2$trt,1,1))

# the substring is used to truncate trt names to 1 character

# a plot using the block mean as the X axis

bmean <- tapply(schiz2$y, schiz2$pair, mean)
# easy to compute block means for each block

# the hard part is merging this info with the data
# if blocks are numbered 1, 2, ... I

schiz2$bmean <- bmean[schiz2$pair]

# If they are not sequentially numbered, have to match:
schiz2$bmean <- bmean[match(schiz2$pair,sort(unique(schiz2$pair)))]

# after the data manipulation, plotting is easy

plot(schiz2$bmean,schiz2$y,type='n')
text(schiz2$bmean,schiz2$y,substring(schiz2$trt,1,1))

RFrontEndSolution/Tests Repo/Rscripts All (163 files)/schiz2.r


subroutine qtest(h,i,j,k,shdswp,x,y,ntot,eps,nerror)

# Test whether the LOP is satisified; i.e. whether vertex j
# is outside the circumcircle of vertices h, i, and k of the
# quadrilateral.  Vertex h is the vertex being added; i and k are
# the vertices of the quadrilateral which are currently joined;
# j is the vertex which is ``opposite'' the vertex being added.
# If the LOP is not satisfied, then shdswp ("should-swap") is true,
# i.e. h and j should be joined, rather than i and k.  I.e. if j
# is outside the circumcircle of h, i, and k then all is well as-is;
# *don't* swap ik for hj.  If j is inside the circumcircle of h,
# i, and k then change is needed so swap ik for hj.
# Called by swap.

implicit double precision(a-h,o-z)
dimension x(-3:ntot), y(-3:ntot)
integer h
logical shdswp

nerror = -1

# Look for ideal points.
if(i<=0) ii = 1
else ii = 0
if(j<=0) jj = 1
else jj = 0
if(k<=0) kk = 1
else kk = 0
ijk = ii*4+jj*2+kk

# All three corners other than h (the point currently being
# added) are ideal --- so h, i, and k are co-linear; so
# i and k shouldn't be joined, and h should be joined to j.
# So swap.  (But this can't happen, anyway!!!)
# case 7:
if(ijk==7) {
	shdswp = .true.
	return
}

# If i and j are ideal, find out which of h and k is closer to the
# intersection point of the two diagonals, and choose the diagonal
# emanating from that vertex.  (I.e. if h is closer, swap.)
# Unless swapping yields a non-convex quadrilateral!!!
# case 6:
if(ijk==6) {
	xh = x(h)
	yh = y(h)
	xk = x(k)
	yk = y(k)
	ss = 1 - 2*mod(-j,2)
	test = (xh*yk+xk*yh-xh*yh-xk*yk)*ss
	if(test>0.d0) shdswp = .true.
	else shdswp = .false.
# Check for convexity:
	if(shdswp) call acchk(j,k,h,shdswp,x,y,ntot,eps)
	return
}

# Vertices i and k are ideal --- can't happen, but if it did, we'd
# increase the minimum angle ``from 0 to more than 2*0'' by swapping ...
#
# 24/7/2011 --- I now think that the forgoing comment is misleading,
# although it doesn't matter since it can't happen anyway.  The
# ``2*0'' is wrong.  The ``new minimum angle would be min{alpha,beta}
# where alpha and beta are the angles made by the line joining h
# to j with (any) line with slope = -1.  This will be greater than
# 0 unless the line from h to j has slope = - 1.  In this case h,
# i, j, and k are all co-linear, so i and k should not be joined
# (and h and j should be) so swapping is called for.  If h, i,
# j and j are not co-linear then the quadrilateral is definitely
# convex whence swapping is OK.  So let's say swap.
# case 5:
if(ijk==5) {
	shdswp = .true.
	return
}

# If i is ideal we'd increase the minimum angle ``from 0 to more than
# 2*0'' by swapping, so just check for convexity:
# case 4:
if(ijk==4) {
	call acchk(j,k,h,shdswp,x,y,ntot,eps)
	return
}

# If j and k are ideal, this is like unto case 6.
# case 3:
if(ijk==3) {
	xi = x(i)
	yi = y(i)
	xh = x(h)
	yh = y(h)
	ss = 1 - 2*mod(-j,2)
	test = (xh*yi+xi*yh-xh*yh-xi*yi)*ss
	if(test>0.d0) shdswp = .true.
	else shdswp = .false.
# Check for convexity:
	if(shdswp) call acchk(h,i,j,shdswp,x,y,ntot,eps)
	return
}

# If j is ideal we'd decrease the minimum angle ``from more than 2*0
# to 0'', by swapping; so don't swap.
# case 2:
if(ijk==2) {
	shdswp = .false.
	return
}

# If k is ideal, this is like unto case 4.
# case 1:
if(ijk==1) {
	call acchk(h,i,j,shdswp,x,y,ntot,eps) # This checks
                                              # for convexity.
                                              # (Was i,j,h,...)
	return
}

# If none of the `other' three corners are ideal, do the Lee-Schacter
# test for the LOP.
# case 0:
if(ijk==0) {
	call qtest1(h,i,j,k,x,y,ntot,eps,shdswp,nerror)
	return
}

# default:  # This CAN'T happen.
nerror = 7
return

end


 require(raster)
adjust.longitude<-function(ncdata){
	if(any(ncdata[["ncdim"]][["lon"]]>180)){
		cat("convert longitude from [0-360] deg to [-180,180] deg\n")
		ind<-ncdata$ncdim$lon>180
		ncdata$ncdim$lon<-c((ncdata$ncdim$lon[ind]-360),ncdata$ncdim$lon[!ind])
		return(ncdata)
	}else
	return(ncdata)
}

map2raster<-function(data,proj,...){
	raster<-rasterFromXYZ(data,...)
	projection(raster)<-CRS(proj)
	return(raster)
}

#=====
#input data{dataframe, missval}
#====
mapProjection<-function(data,from,to="NA",method="ngb",...){
	if(to!="NA"){
		raster<-map2raster(data$dataframe,proj=from,...)
		raster_proj<-projectRaster(raster,crs=CRS(to),method=method)
		points<-as.data.frame(rasterToPoints(raster_proj))
		names(points)<-c("lon","lat","val")
		points$val[abs(points$val)>abs(data$missval)]<-NA
		return(points)
	}
	else{
		points<-data$dataframe
		points$val[abs(points$val)>abs(data$missval)]<-NA
		return(points)
	}
}


  test.intersection = function(pfocus, hull, p.test ) {

    out = NULL
    nch = nrow(hull)
    no.segments = nch-3

    if (nch < 4)  return(  as.matrix( t( p.test[1,] )) )

    for ( i in 1:nrow( p.test ) ){

      i.test = 1

      for (ns in 1:no.segments) {

        pt1 = nch-ns
        pt2 = pt1 - 1

        p1a = hull[ pt1, ]
        p1b = hull[ pt2, ]

        xrange = range( c(p1a[1], p1b[1] ) )
        xrange2 = range( pfocus[1], p.test[i,1] )

        p.intersection = line.intersection.2d ( p1a, p1b, pfocus, p.test[i,] )

        if ( p.intersection[1] >= xrange[1] & p.intersection[1] <= xrange[2] &
             p.intersection[1] >= xrange2[1] & p.intersection[1] <= xrange2[2] ) {
          i.test = i.test * 0
        }
        if (i.test == 0) break()
     }

     if ( i.test == 1 )  {
        out =  as.matrix( t( p.test[i,] ) )
        break()
     }

    }

    return (out)
  }


#spatial forecast variance decomposition: bacterial taxonomic and functional groups.
#clear envrionment, source paths, packages and functions.
rm(list=ls())
source('paths.r')
source('NEFI_functions/ddirch_forecast_noLogMap_noLogMap.r')

#set output path.----
output.path <- NEON_ddirch_var.decomp_16S.path

#load model results.----
all.mod <- readRDS(paste0(scc_gen_16S_dir,'JAGS_output/prior_delgado/dir_delgado_8-30-19.rds'))

#get core-level covariate means and sd.----
dat <- readRDS(hierarch_filled_data.path)
dat <- lapply(dat, function(x) x[!(names(x) %in% c("pH", "conifer"))])
dat <- lapply(dat, function(x) setnames(x, old = "pH_water", new = "pH", skip_absent = TRUE))

core_mu <- dat$core.core.mu
plot_mu <- dat$plot.plot.mu
site_mu <- dat$site.site.mu
#merge together.
plot_mu$siteID <- NULL
core.preds <- merge(core_mu   , plot_mu)
core.preds <- merge(core.preds, site_mu)
core.preds$relEM <- NULL
names(core.preds)[names(core.preds)=="b.relEM"] <- "relEM"

#get core-level SD.
core_sd <- dat$core.core.sd
plot_sd <- dat$plot.plot.sd
site_sd <- dat$site.site.sd
#merge together.
plot_sd$siteID <- NULL
core.sd <- merge(core_sd   , plot_sd)
core.sd <- merge(core.sd, site_sd)
core.sd$relEM <- NULL
names(core.sd)[names(core.sd)=="b.relEM"] <- "relEM"

#take median value core means and sd.
core_median_mu <- list()
core_median_sd <- list()
for(i in 1:ncol(core.preds)){
  if(is.numeric(core.preds[,i])){
    core_median_mu[[i]] <- median(core.preds[,i])
    core_median_sd[[i]] <- median(core.sd   [,i])
    names(core_median_mu)[[i]] <- colnames(core.preds)[i]
    names(core_median_sd)[[i]] <- colnames(core.sd   )[i]
  }
}
core_median_mu <- data.frame(t(unlist(core_median_mu)))
core_median_sd <- data.frame(t(unlist(core_median_sd)))

#get plot-level covariate means and sd.----
core_mu <- dat$core.plot.mu
plot_mu <- dat$plot.plot.mu
site_mu <- dat$site.site.mu
#merge together, .
plot_mu$siteID <- NULL
plot.preds <- merge(core_mu,plot_mu)
plot.preds <- merge(plot.preds,site_mu)
plot.preds$relEM <- NULL
names(plot.preds)[names(plot.preds)=="b.relEM"] <- "relEM"

#get plot-level SD.
core_sd <- dat$core.plot.sd
plot_sd <- dat$plot.plot.sd
site_sd <- dat$site.site.sd
#merge together
plot_sd$siteID <- NULL
plot.sd <- merge(core_sd,plot_sd)
plot.sd <- merge(plot.sd,site_sd)
plot.sd$relEM <- NULL
names(plot.sd)[names(plot.sd)=='b.relEM'] <- "relEM"

#take median value core means and sd.
plot_median_mu <- list()
plot_median_sd <- list()
for(i in 1:ncol(plot.preds)){
  if(is.numeric(plot.preds[,i])){
    plot_median_mu[[i]] <- median(plot.preds[,i])
    plot_median_sd[[i]] <- median(plot.sd   [,i])
    names(plot_median_mu)[[i]] <- colnames(plot.preds)[i]
    names(plot_median_sd)[[i]] <- colnames(plot.sd   )[i]
  }
}
plot_median_mu <- data.frame(t(unlist(plot_median_mu)))
plot_median_sd <- data.frame(t(unlist(plot_median_sd)))

#get site-level covariate means and sd.----
core_mu <- dat$core.site.mu
plot_mu <- dat$plot.site.mu
site_mu <- dat$site.site.mu
#merge together
site.preds <- merge(core_mu, plot_mu)
site.preds <- merge(site.preds,site_mu)
names(site.preds)[names(site.preds)=='b.relEM'] <- "relEM"

#get site-level SD.
core_sd <- dat$core.site.sd
plot_sd <- dat$plot.site.sd
site_sd <- dat$site.site.sd
#merge together.
site.sd <- merge(core_sd,plot_sd)
site.sd <- merge(site.sd,site_sd)
names(site.sd)[names(site.sd)=='b.relEM'] <- "relEM"

#take median value core means and sd.
site_median_mu <- list()
site_median_sd <- list()
for(i in 1:ncol(site.preds)){
  if(is.numeric(site.preds[,i])){
    site_median_mu[[i]] <- median(site.preds[,i])
    site_median_sd[[i]] <- median(site.sd   [,i])
    names(site_median_mu)[[i]] <- colnames(site.preds)[i]
    names(site_median_sd)[[i]] <- colnames(site.sd   )[i]
  }
}
site_median_mu <- data.frame(t(unlist(site_median_mu)))
site_median_sd <- data.frame(t(unlist(site_median_sd)))

all_group <- list()
for (p in 1:length(all.mod)){

  mod <- all.mod[[p]]

  #core-scale variance decomposition.----
  core_ref <- ddirch_forecast_noLogMap(mod = mod, cov_mu = core_median_mu, cov_sd = core_median_sd, names = 'core_scale')
  core_cov <- ddirch_forecast_noLogMap(mod = mod, cov_mu = core_median_mu, cov_sd = core_median_sd, names = 'core_scale', zero_process_uncertainty = T, zero_parameter_uncertainty = T)
  core_par <- ddirch_forecast_noLogMap(mod = mod, cov_mu = core_median_mu, cov_sd = core_median_sd, names = 'core_scale', zero_process_uncertainty = T, zero_covariate_uncertainty = T)
  core_pro <- ddirch_forecast_noLogMap(mod = mod, cov_mu = core_median_mu, cov_sd = core_median_sd, names = 'core_scale', zero_parameter_uncertainty = T, zero_covariate_uncertainty = T)
  core_cov.par <- ddirch_forecast_noLogMap(mod = mod, cov_mu = core_median_mu, cov_sd = core_median_sd, names = 'core_scale', zero_process_uncertainty = T)
  core_cov.pro <- ddirch_forecast_noLogMap(mod = mod, cov_mu = core_median_mu, cov_sd = core_median_sd, names = 'core_scale', zero_parameter_uncertainty = T)
  core_par.pro <- ddirch_forecast_noLogMap(mod = mod, cov_mu = core_median_mu, cov_sd = core_median_sd, names = 'core_scale', zero_covariate_uncertainty = T)
  core_list <- list(core_ref, core_cov, core_par, core_pro, core_cov.par, core_cov.pro, core_par.pro)
  decomp_names <- c('All','covariate','parameter','process','covariate + parameter','covariate + process','parameter + process')
  core.decomp.list <- list()
  for(i in 1:length(core_list)){
    core.decomp.list[[i]] <- core_list[[i]]$pi_0.975 - core_list[[i]]$pi_0.025
    core.decomp.list[[i]] <- core_list[[i]]$variance
  }
  core.decomp.list <- do.call(rbind, core.decomp.list)
  rownames(core.decomp.list) <- decomp_names
  core_variance_decomp <- sweep(core.decomp.list,2, core.decomp.list[1,],'/')

  #plot-scale variance decomposition.----
  plot_ref <- ddirch_forecast_noLogMap(mod = mod, cov_mu = plot_median_mu, cov_sd = plot_median_sd, names = 'plot_scale')
  plot_cov <- ddirch_forecast_noLogMap(mod = mod, cov_mu = plot_median_mu, cov_sd = plot_median_sd, names = 'plot_scale', zero_process_uncertainty = T, zero_parameter_uncertainty = T)
  plot_par <- ddirch_forecast_noLogMap(mod = mod, cov_mu = plot_median_mu, cov_sd = plot_median_sd, names = 'plot_scale', zero_process_uncertainty = T, zero_covariate_uncertainty = T)
  plot_pro <- ddirch_forecast_noLogMap(mod = mod, cov_mu = plot_median_mu, cov_sd = plot_median_sd, names = 'plot_scale', zero_parameter_uncertainty = T, zero_covariate_uncertainty = T)
  plot_cov.par <- ddirch_forecast_noLogMap(mod = mod, cov_mu = plot_median_mu, cov_sd = plot_median_sd, names = 'plot_scale', zero_process_uncertainty = T)
  plot_cov.pro <- ddirch_forecast_noLogMap(mod = mod, cov_mu = plot_median_mu, cov_sd = plot_median_sd, names = 'plot_scale', zero_parameter_uncertainty = T)
  plot_par.pro <- ddirch_forecast_noLogMap(mod = mod, cov_mu = plot_median_mu, cov_sd = plot_median_sd, names = 'plot_scale', zero_covariate_uncertainty = T)
  plot_list <- list(plot_ref, plot_cov, plot_par, plot_pro, plot_cov.par, plot_cov.pro, plot_par.pro)
  decomp_names <- c('All','covariate','parameter','process','covariate + parameter','covariate + process','parameter + process')
  plot.decomp.list <- list()
  for(i in 1:length(plot_list)){
    plot.decomp.list[[i]] <- plot_list[[i]]$pi_0.975 - plot_list[[i]]$pi_0.025
    plot.decomp.list[[i]] <- plot_list[[i]]$variance
  }
  plot.decomp.list <- do.call(rbind, plot.decomp.list)
  rownames(plot.decomp.list) <- decomp_names
  plot_variance_decomp <- sweep(plot.decomp.list,2, plot.decomp.list[1,],'/')

  #site-scale variance decomposition.----
  site_ref <- ddirch_forecast_noLogMap(mod = mod, cov_mu = site_median_mu, cov_sd = site_median_sd, names = 'site_scale')
  site_cov <- ddirch_forecast_noLogMap(mod = mod, cov_mu = site_median_mu, cov_sd = site_median_sd, names = 'site_scale', zero_process_uncertainty = T, zero_parameter_uncertainty = T)
  site_par <- ddirch_forecast_noLogMap(mod = mod, cov_mu = site_median_mu, cov_sd = site_median_sd, names = 'site_scale', zero_process_uncertainty = T, zero_covariate_uncertainty = T)
  site_pro <- ddirch_forecast_noLogMap(mod = mod, cov_mu = site_median_mu, cov_sd = site_median_sd, names = 'site_scale', zero_parameter_uncertainty = T, zero_covariate_uncertainty = T)
  site_cov.par <- ddirch_forecast_noLogMap(mod = mod, cov_mu = site_median_mu, cov_sd = site_median_sd, names = 'site_scale', zero_process_uncertainty = T)
  site_cov.pro <- ddirch_forecast_noLogMap(mod = mod, cov_mu = site_median_mu, cov_sd = site_median_sd, names = 'site_scale', zero_parameter_uncertainty = T)
  site_par.pro <- ddirch_forecast_noLogMap(mod = mod, cov_mu = site_median_mu, cov_sd = site_median_sd, names = 'site_scale', zero_covariate_uncertainty = T)
  site_list <- list(site_ref, site_cov, site_par, site_pro, site_cov.par, site_cov.pro, site_par.pro)
  decomp_names <- c('All','covariate','parameter','process','covariate + parameter','covariate + process','parameter + process')
  site.decomp.list <- list()
  for(i in 1:length(site_list)){
    site.decomp.list[[i]] <- site_list[[i]]$pi_0.975 - site_list[[i]]$pi_0.025
    site.decomp.list[[i]] <- site_list[[i]]$variance
  }
  site.decomp.list <- do.call(rbind, site.decomp.list)
  rownames(site.decomp.list) <- decomp_names
  site_variance_decomp <- sweep(site.decomp.list,2, site.decomp.list[1,],'/')

  #wrap output and save.----
  output <- list(core_variance_decomp, plot_variance_decomp, site_variance_decomp)
  names(output) <- c('core_decomp','plot_decomp','site_decomp')
  all_group[[p]] <- output
}
saveRDS(all_group, output.path)

#end script.


#!/usr/bin/env Rscript
options(error=recover)

#this script prints out PDF pcoa plots and distance matrices, given an OTU table, phylogenetic tree, and metadata

source("UniFrac.r")
library(ape)
library(phangorn)
library(vegan)

otu.tab <- read.table("data/tongue_tongue_data/tongue_tongue_data.txt", header=T, sep="\t", row.names=1, comment.char="", check.names=FALSE)

otu.tab <- t(as.matrix(otu.tab))

#sort taxa from most to least abundant
taxaOrder <- rev(order(apply(otu.tab,2,sum)))
otu.tab <- otu.tab[,taxaOrder]

# read and root tree (rooted tree is required)
tree <- read.tree("data/tongue_tongue_data/tongue_tongue_subtree.tre")
tree <- midpoint(tree)

#filter out all OTUs which are < 1% abundance in every sample
samples.one.percent <- 0.01 * apply(otu.tab,1,sum)

otus.greater.than.one.percent <- apply(otu.tab,2,function(x) { return(length(which(x > samples.one.percent))) })

otu.tab <- otu.tab[,which(otus.greater.than.one.percent > 0)]

tree$tip.label <- gsub("'","",tree$tip.label)
absent <- tree$tip.label[!(tree$tip.label %in% colnames(otu.tab))]
if (length(absent) != 0) {
		tree <- drop.tip(tree, absent)
}

groups <- as.factor(substr(rownames(otu.tab),0,4))

#rarefy data for unweighted unifrac
otu.tab.rarefy <- rrarefy(otu.tab, min(apply(otu.tab,1,sum)))

#get rid of zero sum columns
otu.tab.rarefy.sum <- apply(otu.tab.rarefy,2,sum)
otu.tab.rarefy.notzero <- otu.tab.rarefy[, otu.tab.rarefy.sum > 0]
otu.tab.rarefy <- otu.tab.rarefy.notzero

#get rid of zero sum OTUs in tree
tree.rarefy <- tree

tree.rarefy$tip.label <- gsub("'","",tree.rarefy$tip.label)
absent <- tree.rarefy$tip.label[!(tree.rarefy$tip.label %in% colnames(otu.tab.rarefy))]
if (length(absent) != 0) {
		tree.rarefy <- drop.tip(tree.rarefy, absent)
}

#calculate distance matrix
unweighted <- getDistanceMatrix(otu.tab.rarefy,tree.rarefy,method="unweighted",verbose=TRUE)
write.table(unweighted,file="output/tongue_tongue_unweighted_distance_matrix.txt",sep="\t",quote=FALSE)
all_distance_matrices <- getDistanceMatrix(otu.tab,tree,method="all",verbose=TRUE)
weighted <- all_distance_matrices[["weighted"]]
write.table(weighted,file="output/tongue_tongue_weighted_distance_matrix.txt",sep="\t",quote=FALSE)
information <- all_distance_matrices[["information"]]
write.table(information,file="output/tongue_tongue_information_distance_matrix.txt",sep="\t",quote=FALSE)
ratio_no_log <- all_distance_matrices[["ratio_no_log"]]
write.table(ratio_no_log,file="output/tongue_tongue_ratio_no_log_distance_matrix.txt",sep="\t",quote=FALSE)

unweighted.pcoa <- pcoa(unweighted)
weighted.pcoa <- pcoa(weighted)
information.pcoa <- pcoa(information)
ratio_no_log.pcoa <- pcoa(ratio_no_log)

#function to get variance explained for the PCOA component labels
getVarExplained <- function(vector) {
	rawVarEx <- apply(vector,2,function(x) sd(x)*sd(x))
	totalVarExplained <- sum(rawVarEx)
	varEx <- rawVarEx/totalVarExplained
	return(varEx)
}

unweighted.varEx <- getVarExplained(unweighted.pcoa$vectors)
weighted.varEx <- getVarExplained(weighted.pcoa$vectors)
information.varEx <- getVarExplained(information.pcoa$vectors)
ratio_no_log.varEx <- getVarExplained(ratio_no_log.pcoa$vectors)

#get vector version of distance matrices for correlation plots below
unweighted.vector <- unlist(unweighted[lower.tri(unweighted,diag=TRUE)])
weighted.vector <- unlist(weighted[lower.tri(weighted,diag=TRUE)])
information.vector <- unlist(information[lower.tri(information,diag=TRUE)])
ratio_no_log.vector <- unlist(ratio_no_log[lower.tri(ratio_no_log,diag=TRUE)])

pdf("output/tongue_tongue_pcoa_plots.pdf")

#plot pcoa plots
plot(unweighted.pcoa$vectors[,1],unweighted.pcoa$vectors[,2], col=groups,main="Unweighted UniFrac\nprincipal coordinates analysis",xlab=paste("First Component", round(unweighted.varEx[1],digits=3),"variance explained"),ylab=paste("Second Component", round(unweighted.varEx[2],digits=3),"variance explained"),pch=19,cex.lab=1.4,cex.main=2)
plot(weighted.pcoa$vectors[,1],weighted.pcoa$vectors[,2], col=groups,main="Weighted UniFrac\nprincipal coordinates analysis",xlab=paste("First Component", round(weighted.varEx[1],digits=3),"variance explained"),ylab=paste("Second Component", round(weighted.varEx[2],digits=3),"variance explained"),pch=19,cex.lab=1.4,cex.main=2)
legend(0.2,0.32,levels(groups),col=palette(),pch=19)
plot(information.pcoa$vectors[,1],information.pcoa$vectors[,2], col=groups,main="Information UniFrac\nprincipal coordinates analysis",xlab=paste("First Component", round(information.varEx[1],digits=3),"variance explained"),ylab=paste("Second Component", round(information.varEx[2],digits=3),"variance explained"),pch=19,cex.lab=1.4,cex.main=2)
plot(ratio_no_log.pcoa$vectors[,1],ratio_no_log.pcoa$vectors[,2], col=groups,main="Ratio UniFrac\nprincipal coordinates analysis",xlab=paste("First Component", round(ratio_no_log.varEx[1],digits=3),"variance explained"),ylab=paste("Second Component", round(ratio_no_log.varEx[2],digits=3),"variance explained"),pch=19,cex.lab=1.4,cex.main=2)

#plot correlation between different UniFrac modes
plot(unweighted.vector,information.vector,main="unweighted vs. information UniFrac")
plot(weighted.vector,information.vector,main="weighted vs. information UniFrac")
plot(unweighted.vector,weighted.vector,main="unweighted vs. weighted UniFrac")
plot(ratio_no_log.vector,information.vector,main="ratio vs. information UniFrac")
plot(ratio_no_log.vector,weighted.vector,main="ratio vs. weighted UniFrac")

dev.off()


vioplotWideBars <- function (x, ..., range = 1.5, h = NULL, ylim = NULL, names = NULL,
    horizontal = FALSE, col = "magenta", border = "black", lty = 1,
    lwd = 1, rectCol = "black", colMed = "white", pchMed = 19,
    at, add = FALSE, wex = 1, drawRect = TRUE)
{
    datas <- list(x, ...)
    n <- length(datas)
    if (missing(at))
        at <- 1:n
    upper <- vector(mode = "numeric", length = n)
    lower <- vector(mode = "numeric", length = n)
    q1 <- vector(mode = "numeric", length = n)
    q3 <- vector(mode = "numeric", length = n)
    med <- vector(mode = "numeric", length = n)
    base <- vector(mode = "list", length = n)
    height <- vector(mode = "list", length = n)
    baserange <- c(Inf, -Inf)
    args <- list(display = "none")
    if (!(is.null(h)))
        args <- c(args, h = h)
    for (i in 1:n) {
        data <- datas[[i]]
        data.min <- min(data)
        data.max <- max(data)
        q1[i] <- quantile(data, 0.25)
        q3[i] <- quantile(data, 0.75)
        med[i] <- median(data)
        iqd <- q3[i] - q1[i]
        upper[i] <- min(q3[i] + range * iqd, data.max)
        lower[i] <- max(q1[i] - range * iqd, data.min)
        est.xlim <- c(min(lower[i], data.min), max(upper[i],
            data.max))
        smout <- do.call("sm.density", c(list(data, xlim = est.xlim),
            args))
        hscale <- 0.4/max(smout$estimate) * wex
        base[[i]] <- smout$eval.points
        height[[i]] <- smout$estimate * hscale
        t <- range(base[[i]])
        baserange[1] <- min(baserange[1], t[1])
        baserange[2] <- max(baserange[2], t[2])
    }
    if (!add) {
        xlim <- if (n == 1)
            at + c(-0.5, 0.5)
        else range(at) + min(diff(at))/2 * c(-1, 1)
        if (is.null(ylim)) {
            ylim <- baserange
        }
    }
    if (is.null(names)) {
        label <- 1:n
    }
    else {
        label <- names
    }
    boxwidth <- 0.3 * wex
    if (!add)
        plot.new()
    if (!horizontal) {
        if (!add) {
            plot.window(xlim = xlim, ylim = ylim)
            axis(2)
            axis(1, at = at, label = label)
        }
        box()
        for (i in 1:n) {
            polygon(c(at[i] - height[[i]], rev(at[i] + height[[i]])),
                c(base[[i]], rev(base[[i]])), col = col, border = border,
                lty = lty, lwd = lwd)
            if (drawRect) {
                lines(at[c(i, i)], c(lower[i], upper[i]), lwd = 2*lwd,
                  lty = lty)
                rect(at[i] - boxwidth/2, q1[i], at[i] + boxwidth/2,
                  q3[i], col = rectCol)
                points(at[i], med[i], pch = pchMed, col = colMed,cex =1.5)
            }
        }
    }
    else {
        if (!add) {
            plot.window(xlim = ylim, ylim = xlim)
            axis(1)
            axis(2, at = at, label = label)
        }
        box()
        for (i in 1:n) {
            polygon(c(base[[i]], rev(base[[i]])), c(at[i] - height[[i]],
                rev(at[i] + height[[i]])), col = col, border = border,
                lty = lty, lwd = lwd)
            if (drawRect) {
                lines(c(lower[i], upper[i]), at[c(i, i)], lwd = 2*lwd,
                  lty = lty)
                rect(q1[i], at[i] - boxwidth/2, q3[i], at[i] +
                  boxwidth/2, col = rectCol)
                points(med[i], at[i], pch = pchMed, col = colMed,cex =1.5)
            }
        }
    }
    invisible(list(upper = upper, lower = lower, median = med,
        q1 = q1, q3 = q3))
}


# This code estimates the individual-level
# risk-ratios for seroconversion for
# Seroprevalence of SARS-CoV-2 antibodies in Saint
# Petersburg, Russia paper (https://doi.org/10.1038/s41598-021-92206-y)
library(data.table)
library(stringi)
library(stringr)
library(stargazer)
library(Greg)
library(xtable)
library(Hmisc)
library(tableone)
library(kableExtra)
library(labelled)
library(glm)
library(sandwich)
library(lmtest)

# Declare working directory beforehand in an environment variable
# SPB_COVID_STUDY_PATH = "path_to_your_folder"
# with the aid of usethis::edit_r_environ()
# Restart R session for the changes to make effect
setwd(Sys.getenv('SPB_COVID_STUDY_PATH'))

# Load and prepare the serosurvey data for model fit
source("code/analysis/wave1/create_serosurvey_data_for_model_fit.r")

# Load paper survey data from this study
load("data/wave1/paper_survey/paper_survey_data_matched_to_phone_survey_ids.rdata")

# Add paper survey data
serosurvey_data <- merge(serosurvey_data, paper_survey_data_matched_to_phone_survey_ids, by = "ID", all.x = T, all.y = F)

# Alcohol variable
serosurvey_data[, consumes_alcohol := NA_character_]
serosurvey_data[!is.na(alcohol_frequency), consumes_alcohol := "3Weekly or more often"]
serosurvey_data[alcohol_frequency %in% c("Once over last 30 days") | alcohol_frequency %in% c("2-3 times over last 30 days"),
                consumes_alcohol := '2Monthly']
serosurvey_data[alcohol_frequency %in% c("Never"), consumes_alcohol := "1Never"]
serosurvey_data[, consumes_alcohol := factor(consumes_alcohol, ordered = F) ]

# Smoking now or earlier variable
serosurvey_data[, smoking := NA_character_]
serosurvey_data[smoking_now == 1, smoking := "3Smoking now"]
serosurvey_data[smoking_now == 0 & smoking_earlier==1, smoking := "2Smoking earlier"]
serosurvey_data[smoking_now == 0 & smoking_earlier==0, smoking := "1Never smoked"]
serosurvey_data[, smoking := factor(smoking, ordered = F) ]

# Chronic disease or medication variable
serosurvey_data[, chronic := NA_real_]
serosurvey_data[!is.na(chronic_diabetes)|!is.na(if_diabetes_insulin)|!is.na(chronic_another_lung_disease)|!is.na( chronic_asthma)|
                  !is.na(asthma_treatment_nebulizer)|
                  !is.na(asthma_treatment_oral_medication)|
                  !is.na( asthma_treatment_hand_inhalers)|!is.na(asthma_treatment_nothing)|
                  !is.na(chronic_renal_failure)|!is.na(chronic_liver_diseases)|!is.na(chronic_cardiovascular_diseases)|
                  !is.na(chronic_hematologic_disorders)|!is.na(chronic_other_diseases)|!is.na(if_other_diseases_which)|
                  !is.na( which_treatment)|!is.na(other_drugs)|!is.na(if_other_drugs_which)|
                  !is.na(oncology)|!is.na(if_oncology_treatment), chronic := 0]
serosurvey_data[chronic_diabetes ==1| if_diabetes_insulin == 1| chronic_another_lung_disease == 1|  chronic_asthma ==1|
                  asthma_treatment_nebulizer ==1| asthma_treatment_oral_medication ==1|  asthma_treatment_hand_inhalers ==1|
                  asthma_treatment_nothing ==1|  chronic_renal_failure ==1| chronic_liver_diseases ==1| chronic_cardiovascular_diseases ==1|
                  chronic_hematologic_disorders ==1| chronic_other_diseases ==1| oncology ==1, chronic := 1]

# BMI
serosurvey_data$bmi <- as.numeric(serosurvey_data$weight/(serosurvey_data$height/100)^2)

# Define basic regressors
basic_regressors <- "+agegroup + male + highereduc + higherincome + lives_alone + washing_hands_more + was_sick + selftested_covid + district + interview_week"

# Regressors from paper-based survey
papersurvey_regressors <- "+smoking + consumes_alcohol + chronic + allergy + cold_symptoms"

## Log-linear models

# CMIA
out.basic.IgG_testB <- glm(formula = as.formula(paste0("IgG_testB ~ ", basic_regressors, papersurvey_regressors)), data = serosurvey_data, family = poisson(link="log"))

# ELISA
out.basic.IgA_or_G_or_M_testC <- glm(formula = as.formula(paste0("IgA_or_G_or_M_testC ~ ", basic_regressors,papersurvey_regressors)), data = serosurvey_data, family = poisson(link="log"))

# Huber-Eicker-White-adjust variance-covariance-estimator
vcov_sandwich_out.basic.IgG_testB <- sandwich(out.basic.IgG_testB, type = "HC1")
vcov_sandwich_out.basic.IgA_or_G_or_M_testC <- sandwich(out.basic.IgA_or_G_or_M_testC, type = "HC1")

# Compare the results with and without the Huber-Eicker-White adjusted variance-covariance-matrix
## IgG test B, without adjustment
coefci(out.basic.IgG_testB)

## IgG test B, with adjustment
coefci(out.basic.IgG_testB, vcov = vcov_sandwich_out.basic.IgG_testB)

## IgA/G/M test C, without adjustment
coefci(out.basic.IgA_or_G_or_M_testC)

## IgA/G/M test C, without adjustment
coefci(out.basic.IgA_or_G_or_M_testC, vcov = vcov_sandwich_out.basic.IgA_or_G_or_M_testC)

# Labelling variables for output table
Hmisc::label(serosurvey_data$allergy) <- "Past history of allergies"
Hmisc::label(serosurvey_data$chronic) <- "Chronic diseases or medication use"
Hmisc::label(serosurvey_data$smoking) <- "Smoking status"
Hmisc::label(serosurvey_data$highereduc) <- "Higher education"
Hmisc::label(serosurvey_data$higherincome) <- "Higher income"
Hmisc::label(serosurvey_data$consumes_alcohol) <- "Alcohol consumption frequency"
Hmisc::label(serosurvey_data$cold_symptoms) <- "Cold symptoms in the last 3 months"
Hmisc::label(serosurvey_data$lives_alone) <- "Respondent lives alone"
Hmisc::label(serosurvey_data$agegroup) <- "Age group"
Hmisc::label(serosurvey_data$male) <- "Male"
Hmisc::label(serosurvey_data$washing_hands_more) <- "Respondent started to wash hands more often"
Hmisc::label(serosurvey_data$selftested_covid) <-"History of COVID-19 testing"
Hmisc::label(serosurvey_data$travelled_abroad) <-"Respondent travelled abroad in the last 3 months"

# Printing and binding crude and adjusted prevalence ratio from loglinear models
print_CMIA_PR_table <- printCrudeAndAdjustedModel(out.basic.IgG_testB,digits = 2,add_references = TRUE, sprintf_ci_str = "(%s-%s)", reference_zero_effect=1)

print_ELISA_PR_table <- printCrudeAndAdjustedModel(out.basic.IgA_or_G_or_M_testC, digits = 2, add_references = TRUE, sprintf_ci_str = "(%s-%s)", reference_zero_effect=1)

# Print LaTex table for prevalence ratios
xtable(cbind("CMIA" = print_CMIA_PR_table, "ELISA" = print_ELISA_PR_table))

## Summary statistics table
# Selecting variables for summary statistics table
vars= c( "agegroup", "male", "highereduc", "higherincome", "lives_alone","travelled_abroad",
         "washing_hands_more", "was_sick", "selftested_covid","district","interview_week","offered_taxi",
         "IgG_testB","IgA_or_G_or_M_testC",
         "smoking","allergy","chronic","cold_symptoms","consumes_alcohol")

# Labelling variables for output tabbles
labelled::var_label(serosurvey_data$allergy) <- "Past history of allergies"
labelled::var_label(serosurvey_data$chronic) <- "Chronic diseases or medication use"
labelled::var_label(serosurvey_data$smoking) <- "Smoking status"
labelled::var_label(serosurvey_data$highereduc) <- "Higher education"
labelled::var_label(serosurvey_data$higherincome) <- "Higher income"
labelled::var_label(serosurvey_data$consumes_alcohol) <- "Alcohol consumption frequency"
labelled::var_label(serosurvey_data$cold_symptoms) <- "Cold symptoms in the last 3 months"
labelled::var_label(serosurvey_data$lives_alone) <- "Respondent lives alone"
labelled::var_label(serosurvey_data$agegroup) <- "Age group"
labelled::var_label(serosurvey_data$male) <- "Male"
labelled::var_label(serosurvey_data$washing_hands_more) <- "Respondent started to wash hands more often"
labelled::var_label(serosurvey_data$selftested_covid) <-"History of COVID-19 testing"
labelled::var_label(serosurvey_data$travelled_abroad) <-"Respondent travelled abroad in the last 3 months"

# Creating and printing summary statistics table
summary_statistics_xtable<-xtable(print(CreateTableOne(data = serosurvey_data, vars=vars, strata = "agreed_and_tested",addOverall = TRUE, factorVars = vars,includeNA=TRUE),
      varLabels = TRUE,dropEqual = TRUE, test = FALSE,printToggle = FALSE,showAllLevels = TRUE))

print.xtable(summary_statistics_xtable, sanitize.colnames.function=function(x)gsub("\\."," ",x), sanitize.rownames.function=function(x)gsub("\\."," ",x))


setwd("~/work/pension-fund-performance/output")
fund <- read.csv(file="fund.csv",head=FALSE,sep=" ")

x <- fund$V1
x <- as.Date(x, "%Y-%m-%d")
y <- fund$V2
fit <- lm(y ~ x)

plot(x, y, 'l')
abline(fit)


#!/usr/bin/env Rscript

#===========================================================
# R script for plotting variation of different normalization related features
# to check their relations and mutual dependency
# The contact count is plotted as a third feature, in a variable color scale
# to depict the variation of various normalization features with respect to the color map

# We also compute mean and SAD features for each plot

#Author: Sourya Bhattacharyya
#Vijay-Ay lab, LJI
#===========================================================
suppressMessages(library(optparse))
suppressMessages(library(ggplot2))
# library(RColorBrewer)
suppressMessages(library(data.table))

options(scipen = 10)
options(datatable.fread.datatable=FALSE)

# variables depicting the dimension of plots
PlotWidth <- 14
PlotHeight <- 10
cexthr <- 0.05

#===================================================
# this function is useful for plotting X-Y distribution
# subject to a binning employed
# the number of bins are also provided as an input argument
PlotBinnedDistr <- function(var1, var2, plotfile, xlab, ylab, titlestr, nbin=100) {
	colorvec <- c("blue", "cyan", "green", "yellow", "orange", "brown", "violet", "red")
	curr_plot <- ggplot(data.frame(var1,var2), aes(x=var1,y=var2)) + geom_bin2d(bins = nbin) + scale_fill_gradientn(colours=colorvec) + labs(x = xlab, y = ylab, title = titlestr)
	ggsave(plotfile, plot = curr_plot, width=PlotWidth, height=PlotHeight)
}

# #===================================================
# # function to compute the bin specific interactions
# # where the bins are formed according to the distribution of values in the input data
# # parameters:
# # var1 and var2 are the two variables (data of two columns to be used for X and Y axis)
# # colorvar: variable which is used for coloring the heatmap
# # nbin: no of bins to be employed for each variable
# # xlab, ylab, colorlab: labels associated with individual variables
# # titlestr: title of the generated plot
# # UseLog: if 1, uses the log10 scale of the color quantity variable

# PlotBinnedCC <- function(var1, var2, colorvar, plotfile, xlab, ylab, colorlab, titlestr, UseLog=0, nbin=20) {
# 	quant_interval <- (1.0 / nbin)
# 	colorvec <- c("blue", "cyan", "green", "yellow", "orange", "brown", "violet", "red")
# 	# pointsize <- 0.01

# 	# quantile of two input variables
# 	# to place them in equal occupancy bins
# 	var1_Quant_values <- unique(quantile(var1, probs=seq(0, 1, quant_interval)))
# 	var2_Quant_values <- unique(quantile(var2, probs=seq(0, 1, quant_interval)))

# 	var1.quant <- as.integer(cut(var1, var1_Quant_values, include.lowest=TRUE))
# 	var2.quant <- as.integer(cut(var2, var2_Quant_values, include.lowest=TRUE))

# 	# create a data frame
# 	# Note: simple cbind operation does not produce the data frame object
# 	df <- data.frame(var1Q=var1.quant, var2Q=var2.quant, contact=as.numeric(colorvar))

# 	# the color variable (values) for the common bin pairs are averaged (using the FUN=mean argument)
# 	# a new data frame needs to be assigned
# 	# its column  names also need to be adjusted
# 	df1 <- aggregate(df$contact, by=list(var1Q=df$var1Q,var2Q=df$var2Q), FUN=mean)
# 	colnames(df1) <- colnames(df)

# 	# plot the generated aggregated data frame
# 	if (UseLog == 1) {
# 		# curr_plot <- ggplot(df1, aes(x=var1Q, y=var2Q)) + geom_point(aes(colour=log10(contact)),size=pointsize) + scale_colour_gradientn(colours=colorvec) + labs(colour = colorlab, x = xlab, y = ylab, title = titlestr)
# 		curr_plot <- ggplot(df1, aes(x=var1Q, y=var2Q)) + geom_tile(aes(fill=log2(contact)),color="blue") + scale_fill_gradientn(colours=colorvec) + labs(x = xlab, y = ylab, title = titlestr) + scale_x_continuous(expand = c(0, 0), breaks=1:length(var1_Quant_values), labels=paste(var1_Quant_values)) + scale_y_continuous(expand = c(0, 0), breaks=1:length(var2_Quant_values), labels=paste(var2_Quant_values)) + theme(axis.text.x = element_text(angle = 90, hjust = 1))
# 	} else {
# 		# curr_plot <- ggplot(df1, aes(x=var1Q, y=var2Q)) + geom_point(aes(colour=contact),size=pointsize) + scale_colour_gradientn(colours=colorvec) + labs(colour = colorlab, x = xlab, y = ylab, title = titlestr)
# 		curr_plot <- ggplot(df1, aes(x=var1Q, y=var2Q)) + geom_tile(aes(fill=contact),color="blue") + scale_fill_gradientn(colours=colorvec) + labs(x = xlab, y = ylab, title = titlestr) + scale_x_continuous(expand = c(0, 0), breaks=1:length(var1_Quant_values), labels=paste(var1_Quant_values)) + scale_y_continuous(expand = c(0, 0), breaks=1:length(var2_Quant_values), labels=paste(var2_Quant_values)) + theme(axis.text.x = element_text(angle = 90, hjust = 1))
# 	}
# 	ggsave(plotfile, width=PlotWidth, height=PlotHeight)
# }

#===================================================
# NEW function
# to compute the bin specific interactions
# where the bins are formed according to the distribution of values in the input data
# parameters:
# var1 and var2 are the two variables (data of two columns to be used for X and Y axis)
# colorvar: variable which is used for coloring the heatmap (generally the contact count)
# nbin: no of bins to be employed for each variable
# xlab, ylab, colorlab: labels associated with individual variables
# titlestr: title of the generated plot
# UseLog: if 1, uses the log10 scale of the color quantity variable

PlotBinnedCC <- function(var1, var2, colorvar, plotfile, xlab, ylab, colorlab, titlestr, UseLog=0, nbin=20) {
	quant_interval <- (1.0 / nbin)
	colorvec <- c("blue", "cyan", "green", "yellow", "orange", "brown", "violet", "red")
	# pointsize <- 0.01

	# the range which will be used for displaying the heatmap
	# every map should have identical range for comparison of the color map
	minrange <- 0
	maxrange <- 10

	# quantile of two input variables
	# to place them in equal occupancy bins
	var1_Quant_values <- unique(quantile(var1, probs=seq(0, 1, quant_interval)))
	var2_Quant_values <- unique(quantile(var2, probs=seq(0, 1, quant_interval)))

	var1.quant <- as.integer(cut(var1, var1_Quant_values, include.lowest=TRUE))
	var2.quant <- as.integer(cut(var2, var2_Quant_values, include.lowest=TRUE))

	# now analyze the vector depicting the heatmap
	TargetVec <- as.numeric(colorvar)

	# if log scale is used, first convert the input data into log2 scale
	if (UseLog == 1) {
		TargetVec <- log2(TargetVec)
	}

	# create a data frame
	# Note: simple cbind operation does not produce the data frame object
	df <- data.frame(var1Q=var1.quant, var2Q=var2.quant, contact=TargetVec)

	# the color variable (values) for the common bin pairs are averaged (using the FUN=mean argument)
	# a new data frame needs to be assigned
	# its column  names also need to be adjusted
	df1 <- aggregate(df$contact, by=list(var1Q=df$var1Q,var2Q=df$var2Q), FUN=mean)
	colnames(df1) <- colnames(df)

	# we shift the range of contact count distribution to set a fixed color scale
	range_mult <- (maxrange - minrange) / (max(df1$contact) - min(df1$contact))
	df1$contact <- df1$contact * range_mult
	offset <- minrange - min(df1$contact)
	df1$contact <- df1$contact + offset

	# compute the mean contact count (bin specific) and also the SAD of contact
	# with respect to all bins
	# after shifting the scale to the common color scale and range
	mean_contact <- mean(df1$contact)
	SAD_mean_contact <- sum(abs(df1$contact - mean_contact))
	titlestr <- paste0(titlestr, ' mean contact: ', mean_contact, ' SAD mean contact: ', SAD_mean_contact)

	# plot the generated aggregated data frame
	# the TargetVec is used for filling the colors
	curr_plot <- ggplot(df1, aes(x=var1Q, y=var2Q)) + geom_tile(aes(fill=contact),color="blue") + scale_fill_gradientn(colours=colorvec, limits=c(minrange, maxrange)) + labs(x = xlab, y = ylab, title = titlestr, colour = colorlab) + scale_x_continuous(expand = c(0, 0), breaks=1:length(var1_Quant_values), labels=paste(var1_Quant_values)) + scale_y_continuous(expand = c(0, 0), breaks=1:length(var2_Quant_values), labels=paste(var2_Quant_values)) + theme(axis.text.x = element_text(angle = 90, hjust = 1))

	ggsave(plotfile, plot = curr_plot, width=PlotWidth, height=PlotHeight)
}

# #===================================================
# # generic function to plot 2D histograms
# Plot2DHist <- function(var1, var2, plotfile, xlab, ylab, colorlab, titlestr, nbin=200) {
# 	# quant_interval <- (1.0 / nbin)
# 	colorvec <- c("blue", "cyan", "green", "yellow", "orange", "brown", "violet", "red")
# 	# var1_Quant_values <- unique(quantile(var1, probs=seq(0, 1, quant_interval)))
# 	# var2_Quant_values <- unique(quantile(var2, probs=seq(0, 1, quant_interval)))
# 	# var1.quant <- as.integer(cut(var1, var1_Quant_values, include.lowest=TRUE))
# 	# var2.quant <- as.integer(cut(var2, var2_Quant_values, include.lowest=TRUE))
# 	# df <- data.frame(var1Q=var1.quant, var2Q=var2.quant)
# 	df <- data.frame(var1Q=var1, var2Q=var2)
# 	curr_plot <- ggplot(df, aes(x=var1Q, y=var2Q)) + stat_bin2d(bins = nbin) + scale_fill_gradientn(colours=colorvec) + labs(x = xlab, y = ylab, title = titlestr, colour = colorlab)
# 	ggsave(plotfile, plot = curr_plot, width=PlotWidth, height=PlotHeight)
# }

#===================================================
option_list = list(
  	make_option(c("--IntFile"), type="character", default=NULL, help="Complete interaction file with normalization features between the genomic bins"),
  	make_option(c("--CommonDir"), type="character", default=NULL, help="Output directory for storing the non-bias specific plots"),
  	make_option(c("--BiasSpecificDir"), type="character", default=NULL, help="Output directory for storing the non-bias specific plots"),
	make_option(c("--MappThr"), type="numeric", default=0, help="The threshold of mappability score below which every segment (peak or non peak) is not considered for analysis. Default 0."),
	make_option(c("--GCThr"), type="numeric", default=0, help="The threshold of GC content below which every segment (peak or non peak) is not considered for analysis. Default 0."),
	make_option(c("--cccol"), type="integer", action="store", default=7, help="Column number of the file storing the contact count"),
	make_option(c("--OverWrite"), type="integer", action="store", default=0, help="if 1, overwrites the plots"),
	make_option(c("--NoMappGC"), type="logical", action="store_true", default=FALSE, help="If TRUE, there is no Mappability, GC content, or RE sites information in the feature file. Default FALSE.")
);

opt_parser = OptionParser(option_list=option_list);
opt = parse_args(opt_parser);

if (is.null(opt$IntFile)) {
	cat(sprintf("\n User did not provide any input interaction file - quit !!"))
	system('exit 1')
}

cat(sprintf("\n Input interaction file: %s Output directory: %s  ", opt$IntFile, opt$CommonDir))

if (opt$NoMappGC == FALSE) {
	cat(sprintf("\n Mappability threshold: %s  GC content threshold: %s ", opt$MappThr, opt$GCThr))
}

# create the output directory
system(paste('mkdir -p', opt$CommonDir))
system(paste('mkdir -p', opt$BiasSpecificDir))

# the interaction matrix
# first 6 columns denote two chromosome intervals
# then contact count,
# then coverage1, isPeak1, Bias1, mappability1, GC content1, and number of cut sites(1) for the first interval
# then coverage2, isPeak2, Bias2, mappability2, GC content2, and number of cut sites(2) for the second interval

# Note that the file has one header line
# Interaction_Initial <- read.table(opt$IntFile, header=T, sep="\t", stringsAsFactors=F)
Interaction_Initial <- data.table::fread(opt$IntFile, header=T, sep="\t", stringsAsFactors=F)
colnames(Interaction_Initial) <- c("chr1", "s1", "e1", "chr2", "s2", "e2", "cc", "d1", "isPeak1", "Bias1", "mapp1", "gc1", "cut1", "d2", "isPeak2", "Bias2", "mapp2", "gc2", "cut2")
cat(sprintf('\n Total interactions: %s ', nrow(Interaction_Initial)))

# filter the interactions such that every pair of segments has a mappability score >= mappability threshold
# and GC content >= GC content threshold
# Note the comma after the condition - row index
Interaction_Filt <- Interaction_Initial[Interaction_Initial[,11] >= opt$MappThr & Interaction_Initial[,17] >= opt$MappThr & Interaction_Initial[,12] >= opt$GCThr & Interaction_Initial[,18] >= opt$GCThr, ]
cat(sprintf('\n Interactions satisfying mappability and GC content thresholds: %s', nrow(Interaction_Filt)))

#====================================
# checking different interaction types
#====================================
IntList <- c("peaktopeak", "peaktononpeak", "peaktoall", "alltoall")

for (inttype in IntList) {

	# output directory storing the plots (for non bias related features)
	PlotDirCommon <- paste0(opt$CommonDir, '/', inttype)
	system(paste('mkdir -p', PlotDirCommon))

	# output directory storing the plots (for bias related features)
	PlotDirBias <- paste0(opt$BiasSpecificDir, '/', inttype)
	system(paste('mkdir -p', PlotDirBias))

	# In the following derivations
	# Interaction: filtered rows of interacion data according to the specified criterion
	# ContactCol: Data of absolute contact count
	# CoverageEnrichment: Ratio of contacts and the number of fragment pairs = contact count / (coverage1 * coverage2)
	if (inttype == "peaktopeak") {
		Interaction <- Interaction_Filt[which(Interaction_Filt[,9]==1 & Interaction_Filt[,15]==1), ]
		ContactCol <- Interaction[, opt$cccol]
		CoverageEnrichment <- (Interaction[, opt$cccol] / Interaction[, 8]) / Interaction[, 14]
	} else if (inttype == "peaktononpeak") {
		Interaction <- Interaction_Filt[which(Interaction_Filt[,9]==1 & Interaction_Filt[,15]==0), ]
		ContactCol <- Interaction[, opt$cccol]
		CoverageEnrichment <- (Interaction[, opt$cccol] / Interaction[, 8]) / Interaction[, 14]
	} else if (inttype == "peaktoall") {
		Interaction <- Interaction_Filt[which(Interaction_Filt[,9]==1), ]
		ContactCol <- Interaction[, opt$cccol]
		CoverageEnrichment <- (Interaction[, opt$cccol] / Interaction[, 8]) / Interaction[, 14]
	} else {
		Interaction <- Interaction_Filt
		ContactCol <- Interaction[, opt$cccol]
		CoverageEnrichment <- (Interaction[, opt$cccol] / Interaction[, 8]) / Interaction[, 14]
	}

	# find the indices (rows) where both intervals satisfy bias threshold
	Bias_Low_Thr <- 0.2
	Bias_High_Thr <- 5
	biasidx <- which(Interaction[,10]>=Bias_Low_Thr & Interaction[,10]<=Bias_High_Thr & Interaction[,16]>=Bias_Low_Thr & Interaction[,16]<=Bias_High_Thr)

	#====================================
	# variation of product of a measure with the contact count
	#====================================
	if (1) {
		plotfile <- paste0(PlotDirCommon, '/ContactCount_vs_IntDist.pdf')
		# absolute genomic Distance for different interactions
		gene.dist <- abs(Interaction[,2] - Interaction[,5])
		if ((file.exists(plotfile) == FALSE) | (opt$OverWrite == 1)) {
			PlotBinnedDistr(gene.dist, ContactCol, plotfile, "Genomic Distance", "Contact count", "Variation between genomic Distance and contact count")
		}

		plotfile <- paste0(PlotDirCommon, '/ProdCoverage_vs_ContactCount.pdf')
		# product of read depth values
		prod.coverage <- log10(Interaction[,8]) + log10(Interaction[,14])
		if ((file.exists(plotfile) == FALSE) | (opt$OverWrite == 1)) {
			PlotBinnedDistr(prod.coverage, log10(ContactCol), plotfile, "Prod Coverage (LOG)", "Contact count (LOG)", "Variation between product of read coverages and contact count (in log scale)", 50)
		}

		if (opt$NoMappGC == FALSE) {
			plotfile <- paste0(PlotDirCommon, '/ProdMappability_vs_ContactCount.pdf')
			# product of mappability values
			prod.mappability <- Interaction[,11] * Interaction[,17]
			if ((file.exists(plotfile) == FALSE) | (opt$OverWrite == 1)) {
				PlotBinnedDistr(prod.mappability, ContactCol, plotfile, "Prod Mappability", "Contact count", "Variation between product of Mappabilities and contact count", 20)
			}

			plotfile <- paste0(PlotDirCommon, '/ProdGCContent_vs_ContactCount.pdf')
			# product of GC content values
			prod.GC <- Interaction[,12] * Interaction[,18]
			if ((file.exists(plotfile) == FALSE) | (opt$OverWrite == 1)) {
				PlotBinnedDistr(prod.GC, ContactCol, plotfile, "Prod GCContent", "Contact count", "Variation between product of GCContent and contact count", 20)
			}

			plotfile <- paste0(PlotDirCommon, '/ProdNumCutSites_vs_ContactCount.pdf')
			# product of the number of cut sites
			prod.cut_sites <- Interaction[,13] * Interaction[,19]
			if ((file.exists(plotfile) == FALSE) | (opt$OverWrite == 1)) {
				PlotBinnedDistr(prod.cut_sites, ContactCol, plotfile, "Prod NumCutSites", "Contact count", "Variation between product of NumCutSites and contact count", 20)
			}
		}

		plotfile <- paste0(PlotDirBias, '/ProdBias_vs_ContactCount.pdf')
		# product of bias
		# first select the interactions whose bias values (both ends) are within a specified range
		prod.bias <- Interaction[biasidx,10] * Interaction[biasidx,16]
		titlestr <- paste0("Variation between product of Bias and contact count (subject to bias interval of ", Bias_Low_Thr, " - ", Bias_High_Thr, ")")
		if ((file.exists(plotfile) == FALSE) | (opt$OverWrite == 1)) {
			PlotBinnedDistr(prod.bias, Interaction[biasidx, opt$cccol], plotfile, "Prod Bias", "Contact count", titlestr, 10)
		}

		plotfile <- paste0(PlotDirBias, '/ProdBias_vs_ContactCount_Both_LOG.pdf')
		# product of bias
		# first select the interactions whose bias values (both ends) are within a specified range
		log_prod.bias <- log10(Interaction[biasidx,10]) + log10(Interaction[biasidx,16])
		cc <- log10(Interaction[biasidx, opt$cccol])
		titlestr <- paste0("Variation between product of Bias (LOG) and contact count (LOG) (subject to bias interval of ", Bias_Low_Thr, " - ", Bias_High_Thr, ")")
		if ((file.exists(plotfile) == FALSE) | (opt$OverWrite == 1)) {
			PlotBinnedDistr(log_prod.bias, cc, plotfile, "Log(Prod Bias)", "Log(Contact count)", titlestr, 10)
		}
	}

	#====================================
	# then modeling variation of individual measures with the contact count
	#====================================

	if (0) {
		plotfile <- paste0(PlotDirCommon, '/ReadDepth_vs_AbsContactCount.pdf')
		PlotBinnedCC(Interaction[,8], Interaction[,14], ContactCol, plotfile, "Read depth 1", "Read depth 2", "Contact count", "Read depth vs contact count")
		plotfile <- paste0(PlotDirCommon, '/ReadDepth_vs_LOGContactCount.pdf')
		PlotBinnedCC(Interaction[,8], Interaction[,14], ContactCol, plotfile, "Read depth 1", "Read depth 2", "Log Contact count", "Read depth vs contact count (LOG)", 1)
		plotfile <- paste0(PlotDirCommon, '/ReadDepth_vs_CoverageEnrichment.pdf')
		PlotBinnedCC(Interaction[,8], Interaction[,14], CoverageEnrichment, plotfile, "Read depth 1", "Read depth 2", "Coverage Enrichment", "Read depth vs Coverage Enrichment", 1)

		if (opt$NoMappGC == FALSE) {
			plotfile <- paste0(PlotDirCommon, '/Mappability_vs_AbsContactCount.pdf')
			PlotBinnedCC(Interaction[,11], Interaction[,17], ContactCol, plotfile, "Mappability 1", "Mappability 2", "Contact count", "Mappability vs contact count")
			plotfile <- paste0(PlotDirCommon, '/Mappability_vs_LOGContactCount.pdf')
			PlotBinnedCC(Interaction[,11], Interaction[,17], ContactCol, plotfile, "Mappability 1", "Mappability 2", "Log Contact count", "Mappability vs contact count (LOG)", 1)
			plotfile <- paste0(PlotDirCommon, '/Mappability_vs_CoverageEnrichment.pdf')
			PlotBinnedCC(Interaction[,11], Interaction[,17], CoverageEnrichment, plotfile, "Mappability 1", "Mappability 2", "Coverage Enrichment", "Mappability vs Coverage Enrichment", 1)

			plotfile <- paste0(PlotDirCommon, '/GCContent_vs_AbsContactCount.pdf')
			PlotBinnedCC(Interaction[,12], Interaction[,18], ContactCol, plotfile, "GC content 1", "GC content 2", "Contact count", "GC content vs contact count")
			plotfile <- paste0(PlotDirCommon, '/GCContent_vs_LOGContactCount.pdf')
			PlotBinnedCC(Interaction[,12], Interaction[,18], ContactCol, plotfile, "GC content 1", "GC content 2", "Log Contact count", "GC content vs contact count (LOG)", 1)
			plotfile <- paste0(PlotDirCommon, '/GCContent_vs_CoverageEnrichment.pdf')
			PlotBinnedCC(Interaction[,12], Interaction[,18], CoverageEnrichment, plotfile, "GC content 1", "GC content 2", "Coverage Enrichment", "GC content vs Coverage Enrichment", 1)

			plotfile <- paste0(PlotDirCommon, '/NumCutSites_vs_AbsContactCount.pdf')
			PlotBinnedCC(Interaction[,13], Interaction[,19], ContactCol, plotfile, "Num cut site 1", "Num cut site 2", "Contact count", "Cut site vs contact count")
			plotfile <- paste0(PlotDirCommon, '/NumCutSites_vs_LOGContactCount.pdf')
			PlotBinnedCC(Interaction[,13], Interaction[,19], ContactCol, plotfile, "Num cut site 1", "Num cut site 2", "Log Contact count", "Cut site vs contact count (LOG)", 1)
			plotfile <- paste0(PlotDirCommon, '/NumCutSites_vs_CoverageEnrichment.pdf')
			PlotBinnedCC(Interaction[,13], Interaction[,19], CoverageEnrichment, plotfile, "Num cut site 1", "Num cut site 2", "Coverage Enrichment", "Cut site vs Coverage Enrichment", 1)
		}

		# incorporating the bias specific plots
		plotfile <- paste0(PlotDirBias, '/Bias_vs_AbsContactCount.pdf')
		titlestr <- paste0("Bias vs contact count - bias interval of ", Bias_Low_Thr, " - ", Bias_High_Thr)
		PlotBinnedCC(Interaction[biasidx,10], Interaction[biasidx,16], Interaction[biasidx, opt$cccol], plotfile, "Bias 1", "Bias 2", "Contact count", titlestr)
		plotfile <- paste0(PlotDirBias, '/Bias_vs_LOGContactCount.pdf')
		titlestr <- paste0("Bias vs contact count (LOG) - bias interval of ", Bias_Low_Thr, " - ", Bias_High_Thr)
		PlotBinnedCC(Interaction[biasidx,10], Interaction[biasidx,16], Interaction[biasidx, opt$cccol], plotfile, "Bias 1", "Bias 2", "Log Contact count", titlestr, 1)
		plotfile <- paste0(PlotDirBias, '/Bias_vs_CoverageEnrichment.pdf')
		titlestr <- paste0("Bias vs Coverage Enrichment - bias interval of ", Bias_Low_Thr, " - ", Bias_High_Thr)
		PlotBinnedCC(Interaction[biasidx,10], Interaction[biasidx,16], ((Interaction[biasidx, opt$cccol] / Interaction[biasidx, 8]) / Interaction[biasidx, 14]), plotfile, "Bias 1", "Bias 2", "Coverage Enrichment", titlestr, 1)
	}

	if (inttype == "peaktoall") {
		if (0) {

			if (opt$NoMappGC == FALSE) {
				# peak part
				plotfile <- paste0(PlotDirCommon, '/ReadDepth1_Mapp1_vs_AbsContactCount.pdf')
				PlotBinnedCC(Interaction[,8], Interaction[,11], ContactCol, plotfile, "Read depth 1", "Mappability 1", "Contact count", "Read depth + Mappability (1) vs contact count")
				plotfile <- paste0(PlotDirCommon, '/ReadDepth1_Mapp1_vs_LOGContactCount.pdf')
				PlotBinnedCC(Interaction[,8], Interaction[,11], ContactCol, plotfile, "Read depth 1", "Mappability 1", "Log Contact count", "Read depth + Mappability (1) vs contact count (LOG)", 1)
				plotfile <- paste0(PlotDirCommon, '/ReadDepth1_Mapp1_vs_CoverageEnrichment.pdf')
				PlotBinnedCC(Interaction[,8], Interaction[,11], CoverageEnrichment, plotfile, "Read depth 1", "Mappability 1", "Coverage Enrichment", "Read depth + Mappability (1) vs Coverage Enrichment", 1)

				plotfile <- paste0(PlotDirCommon, '/ReadDepth1_GC1_vs_AbsContactCount.pdf')
				PlotBinnedCC(Interaction[,8], Interaction[,12], ContactCol, plotfile, "Read depth 1", "GC content 1", "Contact count", "Read depth + GC content (1) vs contact count")
				plotfile <- paste0(PlotDirCommon, '/ReadDepth1_GC1_vs_LOGContactCount.pdf')
				PlotBinnedCC(Interaction[,8], Interaction[,12], ContactCol, plotfile, "Read depth 1", "GC content 1", "Log Contact count", "Read depth + GC content (1) vs contact count (LOG)", 1)
				plotfile <- paste0(PlotDirCommon, '/ReadDepth1_GC1_vs_CoverageEnrichment.pdf')
				PlotBinnedCC(Interaction[,8], Interaction[,12], CoverageEnrichment, plotfile, "Read depth 1", "GC content 1", "Coverage Enrichment", "Read depth + GC content (1) vs Coverage Enrichment", 1)

				plotfile <- paste0(PlotDirCommon, '/ReadDepth1_CutSite1_vs_AbsContactCount.pdf')
				PlotBinnedCC(Interaction[,8], Interaction[,13], ContactCol, plotfile, "Read depth 1", "Cut Site 1", "Contact count", "Read depth + Cut Site (1) vs contact count")
				plotfile <- paste0(PlotDirCommon, '/ReadDepth1_CutSite1_vs_LOGContactCount.pdf')
				PlotBinnedCC(Interaction[,8], Interaction[,13], ContactCol, plotfile, "Read depth 1", "Cut Site 1", "Log Contact count", "Read depth + Cut Site (1) vs contact count (LOG)", 1)
				plotfile <- paste0(PlotDirCommon, '/ReadDepth1_CutSite1_vs_CoverageEnrichment.pdf')
				PlotBinnedCC(Interaction[,8], Interaction[,13], CoverageEnrichment, plotfile, "Read depth 1", "Cut Site 1", "Coverage Enrichment", "Read depth + Cut Site (1) vs Coverage Enrichment", 1)

				plotfile <- paste0(PlotDirCommon, '/Mapp1_GC1_vs_AbsContactCount.pdf')
				PlotBinnedCC(Interaction[,11], Interaction[,12], ContactCol, plotfile, "Mappability 1", "GC content 1", "Contact count", "Mappability + GC content (1) vs contact count")
				plotfile <- paste0(PlotDirCommon, '/Mapp1_GC1_vs_LOGContactCount.pdf')
				PlotBinnedCC(Interaction[,11], Interaction[,12], ContactCol, plotfile, "Mappability 1", "GC content 1", "Log Contact count", "Mappability + GC content (1) vs contact count (LOG)", 1)
				plotfile <- paste0(PlotDirCommon, '/Mapp1_GC1_vs_CoverageEnrichment.pdf')
				PlotBinnedCC(Interaction[,11], Interaction[,12], CoverageEnrichment, plotfile, "Mappability 1", "GC content 1", "Coverage Enrichment", "Mappability + GC content (1) vs Coverage Enrichment", 1)

				plotfile <- paste0(PlotDirCommon, '/Mapp1_CutSite1_vs_AbsContactCount.pdf')
				PlotBinnedCC(Interaction[,11], Interaction[,13], ContactCol, plotfile, "Mappability 1", "Cut site 1", "Contact count", "Mappability + Cut site (1) vs contact count")
				plotfile <- paste0(PlotDirCommon, '/Mapp1_CutSite1_vs_LOGContactCount.pdf')
				PlotBinnedCC(Interaction[,11], Interaction[,13], ContactCol, plotfile, "Mappability 1", "Cut site 1", "Log Contact count", "Mappability + Cut site (1) vs contact count (LOG)", 1)
				plotfile <- paste0(PlotDirCommon, '/Mapp1_CutSite1_vs_CoverageEnrichment.pdf')
				PlotBinnedCC(Interaction[,11], Interaction[,13], CoverageEnrichment, plotfile, "Mappability 1", "Cut site 1", "Coverage Enrichment", "Mappability + Cut site (1) vs Coverage Enrichment", 1)

				plotfile <- paste0(PlotDirCommon, '/GC1_CutSite1_vs_AbsContactCount.pdf')
				PlotBinnedCC(Interaction[,12], Interaction[,13], ContactCol, plotfile, "GC content 1", "Cut site 1", "Contact count", "GC content + Cut site (1) vs contact count")
				plotfile <- paste0(PlotDirCommon, '/GC1_CutSite1_vs_LOGContactCount.pdf')
				PlotBinnedCC(Interaction[,12], Interaction[,13], ContactCol, plotfile, "GC content 1", "Cut site 1", "Log Contact count", "GC content + Cut site (1) vs contact count (LOG)", 1)
				plotfile <- paste0(PlotDirCommon, '/GC1_CutSite1_vs_CoverageEnrichment.pdf')
				PlotBinnedCC(Interaction[,12], Interaction[,13], CoverageEnrichment, plotfile, "GC content 1", "Cut site 1", "Coverage Enrichment", "GC content + Cut site (1) vs Coverage Enrichment", 1)

				# all part
				plotfile <- paste0(PlotDirCommon, '/ReadDepth2_Mapp2_vs_AbsContactCount.pdf')
				PlotBinnedCC(Interaction[,14], Interaction[,17], ContactCol, plotfile, "Read depth 2", "Mappability 2", "Contact count", "Read depth + Mappability (2) vs contact count")
				plotfile <- paste0(PlotDirCommon, '/ReadDepth2_Mapp2_vs_LOGContactCount.pdf')
				PlotBinnedCC(Interaction[,14], Interaction[,17], ContactCol, plotfile, "Read depth 2", "Mappability 2", "Log Contact count", "Read depth + Mappability (2) vs contact count (LOG)", 1)
				plotfile <- paste0(PlotDirCommon, '/ReadDepth2_Mapp2_vs_CoverageEnrichment.pdf')
				PlotBinnedCC(Interaction[,14], Interaction[,17], CoverageEnrichment, plotfile, "Read depth 2", "Mappability 2", "Coverage Enrichment", "Read depth + Mappability (2) vs Coverage Enrichment", 1)

				plotfile <- paste0(PlotDirCommon, '/ReadDepth2_GC2_vs_AbsContactCount.pdf')
				PlotBinnedCC(Interaction[,14], Interaction[,18], ContactCol, plotfile, "Read depth 2", "GC content 2", "Contact count", "Read depth + GC content (2) vs contact count")
				plotfile <- paste0(PlotDirCommon, '/ReadDepth2_GC2_vs_LOGContactCount.pdf')
				PlotBinnedCC(Interaction[,14], Interaction[,18], ContactCol, plotfile, "Read depth 2", "GC content 2", "Log Contact count", "Read depth + GC content (2) vs contact count (LOG)", 1)
				plotfile <- paste0(PlotDirCommon, '/ReadDepth2_GC2_vs_CoverageEnrichment.pdf')
				PlotBinnedCC(Interaction[,14], Interaction[,18], CoverageEnrichment, plotfile, "Read depth 2", "GC content 2", "Coverage Enrichment", "Read depth + GC content (2) vs Coverage Enrichment", 1)

				plotfile <- paste0(PlotDirCommon, '/ReadDepth2_CutSite2_vs_AbsContactCount.pdf')
				PlotBinnedCC(Interaction[,14], Interaction[,19], ContactCol, plotfile, "Read depth 2", "Cut Site 2", "Contact count", "Read depth + Cut Site (2) vs contact count")
				plotfile <- paste0(PlotDirCommon, '/ReadDepth2_CutSite2_vs_LOGContactCount.pdf')
				PlotBinnedCC(Interaction[,14], Interaction[,19], ContactCol, plotfile, "Read depth 2", "Cut Site 2", "Log Contact count", "Read depth + Cut Site (2) vs contact count (LOG)", 1)
				plotfile <- paste0(PlotDirCommon, '/ReadDepth2_CutSite2_vs_CoverageEnrichment.pdf')
				PlotBinnedCC(Interaction[,14], Interaction[,19], CoverageEnrichment, plotfile, "Read depth 2", "Cut Site 2", "Coverage Enrichment", "Read depth + Cut Site (2) vs Coverage Enrichment", 1)

				plotfile <- paste0(PlotDirCommon, '/Mapp2_GC2_vs_AbsContactCount.pdf')
				PlotBinnedCC(Interaction[,17], Interaction[,18], ContactCol, plotfile, "Mappability 2", "GC content 2", "Contact count", "Mappability + GC content (2) vs contact count")
				plotfile <- paste0(PlotDirCommon, '/Mapp2_GC2_vs_LOGContactCount.pdf')
				PlotBinnedCC(Interaction[,17], Interaction[,18], ContactCol, plotfile, "Mappability 2", "GC content 2", "Log Contact count", "Mappability + GC content (2) vs contact count (LOG)", 1)
				plotfile <- paste0(PlotDirCommon, '/Mapp2_GC2_vs_CoverageEnrichment.pdf')
				PlotBinnedCC(Interaction[,17], Interaction[,18], CoverageEnrichment, plotfile, "Mappability 2", "GC content 2", "Coverage Enrichment", "Mappability + GC content (2) vs Coverage Enrichment", 1)

				plotfile <- paste0(PlotDirCommon, '/Mapp2_CutSite2_vs_AbsContactCount.pdf')
				PlotBinnedCC(Interaction[,17], Interaction[,19], ContactCol, plotfile, "Mappability 2", "Cut site 2", "Contact count", "Mappability + Cut site (2) vs contact count")
				plotfile <- paste0(PlotDirCommon, '/Mapp2_CutSite2_vs_LOGContactCount.pdf')
				PlotBinnedCC(Interaction[,17], Interaction[,19], ContactCol, plotfile, "Mappability 2", "Cut site 2", "Log Contact count", "Mappability + Cut site (2) vs contact count (LOG)", 1)
				plotfile <- paste0(PlotDirCommon, '/Mapp2_CutSite2_vs_CoverageEnrichment.pdf')
				PlotBinnedCC(Interaction[,17], Interaction[,19], CoverageEnrichment, plotfile, "Mappability 2", "Cut site 2", "Coverage Enrichment", "Mappability + Cut site (2) vs Coverage Enrichment", 1)

				plotfile <- paste0(PlotDirCommon, '/GC2_CutSite2_vs_AbsContactCount.pdf')
				PlotBinnedCC(Interaction[,18], Interaction[,19], ContactCol, plotfile, "GC content 2", "Cut site 2", "Contact count", "GC content + Cut site (2) vs contact count")
				plotfile <- paste0(PlotDirCommon, '/GC2_CutSite2_vs_LOGContactCount.pdf')
				PlotBinnedCC(Interaction[,18], Interaction[,19], ContactCol, plotfile, "GC content 2", "Cut site 2", "Log Contact count", "GC content + Cut site (2) vs contact count (LOG)", 1)
				plotfile <- paste0(PlotDirCommon, '/GC2_CutSite2_vs_CoverageEnrichment.pdf')
				PlotBinnedCC(Interaction[,18], Interaction[,19], CoverageEnrichment, plotfile, "GC content 2", "Cut site 2", "Coverage Enrichment", "GC content + Cut site (2) vs Coverage Enrichment", 1)
			}
		}
	}	# end peak to all interaction type check

}


#' Normalise z values within a gtable object
#'
#' The z values within a gtable object can be any numeric values.
#' This function will change them to integers (starting from 1),
#' preserving the original order.
#'
#' Ties are handled by the `"first"` method: the first occurrence
#' of a value wins.
#'
#' @param x A gtable object
#' @param i The z value to start counting up from (default is 1)
#'
#' @noRd
z_normalise <- function(x, i = 1) {
  layout <- unclass(x$layout)
  layout$z <- rank(layout$z, ties.method = "first") + i - 1
  x$layout <- new_data_frame(layout)
  x
}

#' Arrange the z values within gtable objects
#'
#' This is usually used before rbinding or cbinding the gtables together.
#' The resulting z values will be normalized.
#'
#' Ties are handled by the `"first"` method: the first occurrence
#' of a value wins.
#'
#' @param gtables A list of gtable objects
#' @param z A numeric vector of relative z values
#'
#' @noRd
z_arrange_gtables <- function(gtables, z) {
  if (length(gtables) != length(z)) {
    stop("'gtables' and 'z' must be the same length")
  }

  # Keep track of largest z value encountered so far
  zmax <- 0
  # Go through each gtable, in the order of z
  for (i in order(z)) {
    # max() gives a warning if zero-length input
    if (nrow(gtables[[i]]$layout) > 0) {
      gtables[[i]] <- z_normalise(gtables[[i]], zmax + 1)
      zmax <- max(.subset2(gtables[[i]]$layout, "z"))
    }
  }

  gtables
}


#' Matrix Exponentiation
#'
#' \tabular{ll}{
#'    Package: \tab memuse \cr
#'    Type: \tab Package \cr
#'    License: \tab BSD 2-Clause \cr
#'    NeedsCompilation: \tab yes
#' }
#'
#' @name libexpm-package
#' @docType package
#' @author Drew Schmidt
#' @references Project home page: \url{http://github.com/wrathematics/libexpm}
#'
#' @useDynLib libexpm, R_libexpm_normest, R_libexpm_expm_3_1, R_libexpm_expm_5_1
#'
#' @keywords Package
NULL