# Module for graph based algorithms

# Graph representation:
#  - An edges frame is a data frame with columns 'source.id', 'target.id' and 'weight',
#    where 'source' and 'target' each reference a vertex v_i in V (indexed from 1 to |V|),
#    and 'weight' gives the edge weight (often just 1 to measure degree).
#  - An edges representation is an object with a get_edges() method.
#  - A graph representation is an edges representation with the following methods:
#     * get_node_ids()           - returns a vector of all vertex identifiers.
#     * get_out_edges(source.id) - returns an edges frame of all edges directed from the source vertex.
#     * get_in_edges(target.id)  - returns an edges frame of all edges directed to the target vertex.

# Description:
#   Wraps an edges frame into an edges representation.
# Input:
#   edges - The edges frame.
# Output:
#   edges.repr - The edges representation.
graph.get_edges_repr = function(edges) {
    edges.repr = list()
    edges.repr$get_edges = function() {
        return(edges)
    }
    return(edges.repr)
}

# Description:
#   Wraps an edges edges representation into a graph representation.
# Input:
#   edges.repr - The edges representation.
# Output:
#   graph.repr - The graph representation.
graph.from_edges_repr = function(edges.repr) {
    edges = edges.repr$get_edges()
    graph.repr = list()
    graph.repr$get_edges = function() {
        return(edges)
    }
    graph.repr$get_node_ids = function() {
        return(sort(unique(c(edges$source.id, edges$target.id))))
    }
    graph.repr$get_out_edges = function(source.id) {
        return(edges[edges$source.id == source.id,])
    }
    graph.repr$get_in_edges = function(target.id) {
        return(edges[edges$target.id == target.id,])
    }
    return(graph.repr)
}

# Description:
#   Internal function to encapsulate all clustering information into a single object.
# Input:
#   num.nodes - The total number |V| of vertices in the graph, on the assumption that
#               every vertex id has been uniquely mapped to an integer from 1 to num.nodes.
#   trace     - An optional flag indicating whether (TRUE) or not (FALSE) to
#               track incremental score changes; defaults to FALSE.
# Output:
#   clusters - An object representing the internal cluster functions.
graph.init_clusters = function(num.nodes, trace=FALSE) {
    # Information about all nodes:
    # Sum of all edge weights (half of total vertex weight)
    total_edge_weights = 0
    # Map node index to cluster id
    node_cluster_map = 1:num.nodes
    # Count weight of internal edges in each cluster (both nodes in cluster)
    internal_cluster_edges_map = rep(0, num.nodes)
    # Count weight of external edges pointing into our out of each cluster (only one node in cluster)
    external_cluster_edges_map = rep(0, num.nodes)
    # Initial modularity score
    initial_score = 0
    # Cummulative change in modularity score
    change_score = 0
    if (trace) {
        change_scores = NULL
    }
    # Control initial score computation
    score_counter = 0

    # Information about about current (pivot) node:
    # Total edge weight of a node
    node_weight = 0
    # Weight of self edge to and from node
    self_weight = 0
    # Weights of edges from node to each cluster
    local_cluster_edges_map = rep(0, num.nodes)

    # Create object
    obj = list()
    # Add node v_i to new cluster if not already clustered
    obj$add_cluster_node = function(i) {
        # No action needed as nodes already indexed.
    }
    # Put node v_i into existing cluster c_i
    obj$set_cluster_node = function(i, c_i) {
        node_cluster_map[i] <<- c_i
    }
    # Add directed edge between node clusters
    obj$add_cluster_edge = function(i, j, w_ij) {
        if (i == j) w_ij = 0.5 * w_ij
        total_edge_weights <<- total_edge_weights + w_ij
        c_i = node_cluster_map[[i]]
        c_j = node_cluster_map[[j]]
        if (c_i == c_j) {
            internal_cluster_edges_map[c_i] <<- internal_cluster_edges_map[c_i] + w_ij
        } else {
            external_cluster_edges_map[c_i] <<- external_cluster_edges_map[c_i] + w_ij
            external_cluster_edges_map[c_j] <<- external_cluster_edges_map[c_j] + w_ij
        }
    }
    # Initialise local cluster edge counts for a single node
    obj$init_local_cluster_edges = function() {
        node_weight <<- 0
        self_weight <<- 0
        local_cluster_edges_map <<- rep(0, num.nodes)
    }
    # Add undirected edge between pivot node i and node j
    obj$add_local_cluster_edge = function(i, j, w_ij) {
        if (i == j) {
            self_weight <<- w_ij
            w_ij = 0.5 * w_ij
        }
        node_weight <<- node_weight + w_ij
        c_j = node_cluster_map[[j]]
        local_cluster_edges_map[c_j] <<- local_cluster_edges_map[c_j] + w_ij
    }
    # If possible, move pivot node to another cluster with highest positive change of score
    obj$move_to_best_cluster = function(i) {
        c_i = node_cluster_map[[i]]
        A_dd = 2 * total_edge_weights # A..
        A_id = node_weight # A_i.
        score_counter <<- score_counter + 1
        if (score_counter <= num.nodes) {
            # Continue computing initial score
            Q_i = (self_weight - A_id * A_id / A_dd) / A_dd
            initial_score <<- initial_score + Q_i
        }
        # Compute score change in removing node i from its cluster
        A_i_gpi = internal_cluster_edges_map[[c_i]] # A_i,g+i
        A_ig =  A_i_gpi - self_weight # A_i,g
        sigma_gpi_tot = 2 * internal_cluster_edges_map[[c_i]] + external_cluster_edges_map[[c_i]] # Sigma_g+i^tot
        sigma_tot = sigma_gpi_tot - A_id # Sigma_g^tot
        delta_Q_gpimi = -2 * (A_ig  - sigma_tot * A_id / A_dd) / A_dd # Delta Q_(g+i)-i
        max_delta_Q = -Inf
        max_cluster_id = 0
        local_cluster_edges_map[c_i] = 0 # Ignore current cluster
        for (c_j in which(local_cluster_edges_map > 0)) {
            sigma_tot = 2 * internal_cluster_edges_map[[c_j]] + external_cluster_edges_map[[c_j]] # Sigma_g'^tot
            A_igd = local_cluster_edges_map[[c_j]] # A_i,g'
            delta_Q_gdpi = 2 * (A_igd - sigma_tot * A_id / A_dd) / A_dd # Delta Q_g'+i
            delta_Q = delta_Q_gpimi + delta_Q_gdpi
            if (delta_Q > 1e-8 && delta_Q > max_delta_Q) {
                max_delta_Q = delta_Q
                max_cluster_id = c_j
                #print(paste0("DEBUG: Best delta-score=", delta_Q, ". Suggest move node from cluster ", c_i, " to cluster ", c_j))
            }
        }
        if (max_cluster_id > 0) {
            c_j = max_cluster_id
            change_score <<- change_score + max_delta_Q
            if (trace) {
                change_scores <<- c(change_scores, max_delta_Q)
            }
            # Remove node i from cluster c_i
            internal_cluster_edges_map[[c_i]] <<- internal_cluster_edges_map[[c_i]] - A_ig - 0.5 * self_weight
            external_cluster_edges_map[[c_i]] <<- external_cluster_edges_map[[c_i]] - A_id + 2 * A_ig + self_weight
            # Add node i to cluster c_j
            A_igd = local_cluster_edges_map[[c_j]] # A_i,g'
            internal_cluster_edges_map[[c_j]] <<- internal_cluster_edges_map[[c_j]] + A_igd + 0.5 * self_weight
            external_cluster_edges_map[[c_j]] <<- external_cluster_edges_map[[c_j]] + A_id - 2 * A_igd - self_weight
            node_cluster_map[i] <<- c_j
            return(TRUE)
        } else {
            return(FALSE)
        }
    }
    # Provide initial score for singleton clusters
    obj$get_inital_score = function() {
        return(initial_score)
    }
    # Provide final score for clustered graph
    obj$get_final_score = function() {
        return(initial_score + change_score)
    }
    # Provide incremental score changes
    obj$get_score_changes = function() {
        if (trace) return(change_scores)
        return(c())
    }
    # Remap the remaining clusters to indices in 1, 2, ..., K for smallest K
    obj$get_cluster_map = function() {
        cluster.nums = sort(unique(node_cluster_map))
        K = length(cluster.nums)
        new_cluster_map = rep(0, K)
        for (k in 1:K) {
            idx = which(node_cluster_map == cluster.nums[[k]])
            new_cluster_map[idx] = k
        }
        return(new_cluster_map)
    }
    # Expose object
    return(obj)
}

# Description:
#   An implementation of phase 1 of the Louvain modularity community detection (i.e. node clustering).
# Input:
#   graph.repr - A graph representation.
#   trace      - An optional flag indicating whether (TRUE) or not (FALSE) to
#                track incremental score changes; defaults to FALSE.
# Output:
#   clusters - A |V| length vector giving the cluster index c_i for each vertex v_i.
graph.cluster = function(graph.repr, trace=FALSE) {
    node.ids = graph.repr$get_node_ids()
    num.nodes = length(node.ids)
    # Initialisation:
    clusters = graph.init_clusters(num.nodes, trace)
    for (i in 1:num.nodes) {
        v_i = node.ids[i]
        clusters$add_cluster_node(i)
        # To avoid double counting, only traverse edges in source -> target direction.
        out_edges = graph.repr$get_out_edges(v_i)
        num.out_edges = nrow(out_edges)
        if (num.out_edges > 0) {
            for (edge.idx in 1:num.out_edges) {
                edge = out_edges[edge.idx,]
                v_j = edge$target.id
                j = which(node.ids == v_j)
                clusters$add_cluster_node(j)
                w_ij = edge$weight
                clusters$add_cluster_edge(i, j, w_ij)
            }
        }
    }

    # Cluster reassignments:
    while (TRUE) {
        changed = FALSE
        for (i in 1:num.nodes) {
            v_i = node.ids[i]
            clusters$init_local_cluster_edges()
            out_edges = graph.repr$get_out_edges(v_i)
            num.out_edges = nrow(out_edges)
            if (num.out_edges > 0) {
                for (edge.idx in 1:num.out_edges) {
                    edge = out_edges[edge.idx,]
                    v_j = edge$target.id
                    j = which(node.ids == v_j)
                    w_ij = edge$weight
                    clusters$add_local_cluster_edge(i, j, w_ij) # i -> j becomes i -- j.
                }
            }
            in_edges = graph.repr$get_in_edges(v_i)
            num.in_edges = nrow(in_edges)
            if (num.in_edges > 0) {
                for (edge.idx in 1:num.in_edges) {
                    edge = in_edges[edge.idx,]
                    v_j = edge$source.id
                    j = which(node.ids == v_j)
                    w_ji = edge$weight
                    clusters$add_local_cluster_edge(i, j, w_ji) # Yes, i <- j becomes i -- j.
                }
            }
            moved = clusters$move_to_best_cluster(i)
            changed = changed || moved
        }
        if (!changed) break
    }
    # Map node id to cluster id
    cluster.ids = clusters$get_cluster_map()
    names(cluster.ids) = node.ids
    if (trace) {
        scores = cumsum(c(clusters$get_inital_score(), clusters$get_score_changes()))
    } else {
        scores = c(clusters$get_inital_score(), clusters$get_final_score())
    }
    return(list(
        cluster.ids = cluster.ids,
        initial.score = clusters$get_inital_score(),
        final.score = clusters$get_final_score(),
        incremental.scores = scores
    ))
}

graph.matrix = function(graph.repr) {
    node.ids = graph.repr$get_node_ids()
    num.nodes = length(node.ids)
    D = matrix(data=0, nrow=num.nodes, ncol=num.nodes)
    for (i in 1:num.nodes) {
        v_i = node.ids[[i]]
        out.edges = graph.repr$get_out_edges(v_i)
        num.out.edges = nrow(out.edges)
        if (num.out.edges > 0) {
            for (edge.idx in 1:num.out.edges) {
                edge = out.edges[edge.idx,]
                v_j = edge$target.id
                j = which(node.ids == v_j)
                w_ij = edge$weight
                D[i, j] = D[i, j] + w_ij
            }
        }
    }
    rownames(D) = node.ids
    colnames(D) = node.ids
    return(D)
}

test.graph.cluster = function() {
    edges = data.frame(source.id=c("X", "Y", "Z"), target.id=c("Z", "X", "Y"), weight=1, stringsAsFactors=FALSE)
    edges.repr = graph.get_edges_repr(edges)
    graph.repr = graph.from_edges_repr(edges.repr)
    D = graph.matrix(graph.repr)
    A = D + t(D)
    diag(A) = diag(D)
    A_id = rowSums(A)
    A_dd = sum(A_id)
    Q_mat = (A - A_id %*% t(A_id) / A_dd) / A_dd
    # Step 0 clusters: 1, 2, 3
    delta0 = matrix(0, nrow=3, ncol=3)
    diag(delta0) = 1
    step0.score = sum(Q_mat * delta0)
    # Step 1 clusters: 2, 2, 3
    delta1 = delta0
    delta1[1, 2] = 1; delta1[2, 1] = 1
    step1.score = sum(Q_mat * delta1)
    # Step 2 clusters: 2, 2, 2
    delta2 = delta1
    delta2[1, 3] = 1; delta2[2, 3] = 1; delta2[3, 1] = 1; delta2[3, 2] = 1
    step2.score = sum(Q_mat * delta2)
    scores = c(step0.score, step1.score, step2.score)
    # Step 3 clusters: 1, 1, 1 (remapped)
    res = graph.cluster(graph.repr, trace=TRUE)
    print(paste0("Expected incremental scores: ", paste(scores, collapse=", ")))
    print(paste0("Observed incremental scores: ", paste(res$incremental.scores, collapse=", ")))
    print(paste0("Expected clusters: ", paste(rep(1, 3), collapse=", ")))
    print(paste0("Observed clusters: ", paste(res$cluster.ids, collapse=", ")))
}


#!/usr/bin/env R

#!R
#Usage: Rscript Code1.NullModel.Figure.r
Args <- commandArgs()
NullModel=Args[6]
outputname=Args[7]
boxcolor=Args[8]
outputname2=Args[9]
outputFileType=strsplit(outputname,'[.]')[[1]][length(strsplit(outputname,'[.]')[[1]])]
dataNull=read.table(file=NullModel,header=F)
dataNull=dataNull[order(dataNull[,1],decreasing=F),]

datatotal=c(rep(dataNull[1,1],dataNull[1,2]))
if(nrow(dataNull)>1){
for(i in 2:nrow(dataNull)){
datatotal=c(datatotal, c(rep(dataNull[i,1],dataNull[i,2])))
}}

#datatotal2=c(rep(dataNull[2,1],dataNull[2,2]))
#if(nrow(dataNull)>2){
#for(i in 3:nrow(dataNull)){
#datatotal2=c(datatotal2, c(rep(dataNull[i,1],dataNull[i,2])))
#}}

if(strsplit(strsplit(NullModel,'/')[[1]][length(strsplit(NullModel,'/')[[1]])],'[.]')[[1]][1]=="InsertLenNull"){
xlabn='Number of Read Pairs with Aberrant Insert Length'
ylabn='frequency'
}

if(strsplit(strsplit(NullModel,'/')[[1]][length(strsplit(NullModel,'/')[[1]])],'[.]')[[1]][1]=="DirectionNull"){
xlabn='Number of Read Pairs with Aberrant Direction'
ylabn='frequency'
}

if(strsplit(strsplit(NullModel,'/')[[1]][length(strsplit(NullModel,'/')[[1]])],'[.]')[[1]][1]=="SplitNull"){
xlabn='Number of Split Reads'
ylabn='frequency'
}

if(outputFileType=='pdf'){
pdf(file=outputname)
hist(datatotal,col=boxcolor,xlim=range(dataNull[,1]),xlab=xlabn,ylab=ylabn,freq=T, main='histogram')
dev.off()
#pdf(file=outputname2)
#hist(datatotal2,col=boxcolor,xlim=range(dataNull[,1]),xlab=xlabn,ylab=ylabn,freq=T, main='histogram')
#dev.off()
}

if(outputFileType=='jpg'){
jpeg(file=outputname)
hist(datatotal,col=boxcolor,xlim=range(dataNull[,1]),xlab=xlabn,ylab=ylabn,freq=T, main='histogram')
dev.off()
#jpeg(file=outputname2)
#hist(datatotal2,col=boxcolor,xlim=range(dataNull[,1]),xlab=xlabn,ylab=ylabn,freq=T, main='histogram')
#dev.off()
}

if(outputFileType=='png'){
png(file=outputname)
hist(datatotal,col=boxcolor,xlim=range(dataNull[,1]),xlab=xlabn,ylab=ylabn,freq=T, main='histogram')
dev.off()
#png(file=outputname2)
#hist(datatotal2,col=boxcolor,xlim=range(dataNull[,1]),xlab=xlabn,ylab=ylabn,freq=T, main='histogram')
#dev.off()
}


context("finemapr")
library(ieugwasr)

test_that("ieugwasr_to_finemapr", {
	v <- ieugwasr::variants_rsid("rs7528419")
	r <- paste0(v[["chr"]], ":", v[["pos"]]-100000, "-", v[["pos"]]+100000)
	a <- ieugwasr_to_finemapr(r, c("ieu-a-7", "ieu-a-2"))
	expect_true(length(a) == 2)
	expect_true(class(a) == "FinemaprList")

	# options(finemapr_caviar = "/Users/gh13047/bin/caviar")
	# library(dplyr)
	# finemapr::run_caviar(a[["IEU-a-7"]]$z, a[["IEU-a-7"]]$ld, args = "-c 3")
})


# This is the main function to calculate the combined likelihood values for each measurement and
# each treatment.

LikelihoodCalculation<-function(WD, OD, CropName, ParameterNames, RoundOfGLUE)
{

# Step 1. Calculate the likelihood values for the integrated measurements.
if(RoundOfGLUE==1)
{
eval(parse(text=paste('source ("',WD,'/IntegratedLikelihoodCalculation1.r")',sep = '')));
TreatmentNumber<-IntegratedLikelihoodCalculation1(WD, OD, CropName);
} else
{
eval(parse(text=paste('source ("',WD,'/IntegratedLikelihoodCalculation2.r")',sep = '')));
TreatmentNumber<-IntegratedLikelihoodCalculation2(WD, OD, CropName);
}
#Treatment number was returned from the function of integrated likelhood calculation.

# Step 2. Calculate the probability or normalized likelihood values for each treatment.
for (i in 1:TreatmentNumber)
{
eval(parse(text = paste('IntegratedLikelihoodTreatment',i,
'<-read.table("',OD,'/IntegratedLikelihoodTreatment_',RoundOfGLUE,'_',i,
'.txt",header=TRUE,comment.char="")',sep="")));
##Read the integrated likelihood values.

ColumnNumber<-dim(IntegratedLikelihoodTreatment1);

eval(parse(text = paste('ProbabilityTreatment',i,'<-IntegratedLikelihoodTreatment',i,sep="")));

for (j in 2:ColumnNumber[2])
{
eval(parse(text = paste('ProbabilityTreatment',i,'[,j]<-IntegratedLikelihoodTreatment',i,
'[,j]/sum(IntegratedLikelihoodTreatment',i,'[,j])',sep="")));
}
##Calculate the probability or normalized likelihood values for each observation.

}

# Step 3. Calculate the combined probability or normalized likelihood values for all treatments.

for (i in 1:TreatmentNumber)
{
 if(i==1)
  {
  CombinedProbability<-ProbabilityTreatment1[,"IntegratedCombinedLikelihood"];#For the first treatment.
  } else
  {
  eval(parse(text = paste('CombinedProbability<-CombinedProbability*ProbabilityTreatment',i, #For other treatments.
  '[,"IntegratedCombinedLikelihood"]',sep="")));
##Calculate the combined probability values for all of the treatments.
  }
}

Probability<-CombinedProbability/sum(CombinedProbability);
#Calculate the normalized probability values for each of the random parameter sets.

# Step 4. Combine the generated random parameter sets and the final normalized probability together.
if(RoundOfGLUE==1)
{
eval(parse(text=paste('RandomParameterSets<-read.table("',OD,
'/RealRandomSets_1.txt", header=FALSE,comment.char="")',sep="")));

colnames(RandomParameterSets)<-ParameterNames;

RandomParameterSets<-cbind(RandomParameterSets,Probability);
#Read the generated radom parameter sets and assign names to them.

#library ('MASS');
#eval(parse(text=paste('write.matrix(RandomParameterSets,file ="',OD,
#'/RandomParameterSetsAndProbability_1.txt")',sep="")));

eval(parse(text=paste('write.table(as.matrix(RandomParameterSets), file ="',OD,
'/RandomParameterSetsAndProbability_1.txt", row.names = F, col.names = T, append = F)',sep="")));
#Save the random parameter sets with their probabilities in a file for future procedure.
} else
{
eval(parse(text=paste('RandomParameterSets<-read.table("',OD,
'/RealRandomSets_2.txt", header=FALSE, comment.char="")',sep="")));
colnames(RandomParameterSets)<-ParameterNames;
RandomParameterSets<-cbind(RandomParameterSets,Probability);
#Read the generated radom parameter sets and assign names to them.

#library ('MASS');
#eval(parse(text=paste('write.matrix(RandomParameterSets,file ="',OD,
#'/RandomParameterSetsAndProbability_2.txt")',sep="")));

eval(parse(text=paste('write.table(as.matrix(RandomParameterSets), file ="',OD,
'/RandomParameterSetsAndProbability_2.txt", row.names = F, col.names = T, append = F)',sep="")));
#Save the random parameter sets with their probabilities in a file for future procedure.
}

}


#       Copyright (c) 2020 Roland Bruderer, Biognosys AG, Switzerland
#
#         Permission is hereby granted, free of charge, to any person obtaining a copy
#       of this software and associated documentation files (the "Software"), to deal
#       in the Software without restriction, including without limitation the rights
#       to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
#       copies of the Software, and to permit persons to whom the Software is
#       furnished to do so, subject to the following conditions:
#
#         The above copyright notice and this permission notice shall be included in all
#       copies or substantial portions of the Software.
#
#       THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
#       IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
#       FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
#       AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
#       LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
#       OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
#       SOFTWARE.
#
#       Title:  Limited proteolysis dose-response based drug deconvolution data analysis algorithm based on machine learning scores
#
#                                                                         by Roland Bruderer
#
#       Function: This algorithm performs dose-response fit correlation and testing.
#       The ranking of the peptide and protein candidates is achieve based on by multi score machine learning (ML) using LDA.
#       This was performed based on a training set. The ranking of LIP dose response experiments can be executed.
#
#       Required input:
#
#       1.)Spectronaut Report: RnD Report Schema, required column headers column names: EG.ModifiedSequence,  R.Condition, R.FileName, R.Replicate, PG.Coverage, PG.ProteinAccessions, PG.ProteinNames,
#       EG.PrecursorId,  EG.StrippedSequence, EG.Qvalue, FG.NormalizedMS2PeakArea and PEP.Quantity
#       2.)Spectronaut t-test report (unfiltered, remove default fold change and q-value filters), required column headers: (Comparison (group1/group2),	Group,	ProteinGroups,	AVG Log2 Ratio,	Absolute AVG Log2, Qvalue,	UniProtIds,	Genes,	ProteinDescriptions,	ProteinNames,	# Unique Total Peptides)
#       3.)Optionally, a know drug target list file (for training set required) with two columns: ProteinNames (Uniport name, e.g. FPKB1_HUMAN) and Target, for machine learning to generate a weightned scores based on mulitple experiments,
#       add a third column to the known targets file named: ExpName and a column called priorEC50 for calculation of delta EC50 values
#       This column should contain the file names of the experiments (with file extension) e.g. RapaDoseResp.txt
#       4.)Optionally, a concentration sheet (will be generated based on conditions present in the experiment)
#       ML based on Qvalue and FC filtered list (background drawn from there)
#       5.) for human experiments a LIP-Protein-Frequency library can be used (by default OFF), columnn headers: PFL.PG and PLFrequency
#       Requirements for training sets:
#
#       Concentrations (normal, not log scale) either filled by defaults or externally defined via lookup table,  required column headers: R.Condition, Concentrations
#       Automated default condition to concentration annotation or with lookup file ( normal, not log concentrations)
#       Random set drawn on protein level
#       Normalized intensities are optionally log transformed and then averaged per run for modified peptides
#       A dose-response correlation (DRC) test is performed and the pvalues are corrected by qvalue. The pvalue from the correlation test will be used for the ML.
#
#
#
# Intro End

#_____________________________________________________________________________________________
#
#Part 0: Initilalization
#_____________________________________________________________________________________________
## section0-package loading, clearing ----
#check for required packages
list.of.packages <- c("curl","kernlab","caret", "drc", "dplyr", "ggplot2", "data.table", "plyr", "plotrix", "RColorBrewer",
                      "stringr", "tools", "reshape2", "zoo", "scales", "devtools", "emdbook", "Hmisc", "zoo", "yaml", "glue",
                      "rlang", "digest", "stringi", "ModelMetrics", "robustbase", "ipred", "e1071", "rpart", "DataCombine")
new.packages <- list.of.packages[!(list.of.packages %in% installed.packages()[,"Package"])]
if(length(new.packages)) install.packages(new.packages)

#load necessary libraries
library(data.table)
library(plyr)
library(ggplot2)
library(plotrix)
library(RColorBrewer)
library(stringr)
library(tools)
library(reshape2)
library(zoo)
library(scales)
library(dplyr)
library(drc)
library(caret)
library(devtools)
library(emdbook)
library(Hmisc)
#source("https://bioconductor.org/biocLite.R")
#biocLite("qvalue")
#biocLite("svm")
library("qvalue")
library(e1071)
library(rpart)
library(DataCombine)

#clear work space
rm(list = ls(all = TRUE))

cat( "   \n" )
cat( "   Script Title:  Limited proteolysis dose-response based drug deconvolution data analysis algorithm based on machine learning scores.\n
Written and tested in R V.3.5.0 (2018-04-23) / Rstudio V.1.1.423 by R.Bruderer\n
" )
cat( "   \n" )

#manual parameters to set:

#Qvalue cutoff cansdidate list
Qcutoff <- 0.01
#foldchange cutoff (log2) candidate list
FCcutoff <- 0.46
#LDA background set
ldaBGsize <- 400
#optional: concentration to be excluded from analysis
#RemConc <- c(200000000)

#_____________________________________________________________________________________________

#setting of pre-calculated score weights based on Rapamycin and Calyculin A and Staurosporine
scoreweights.v <- c(1.317320, 9.191420, 1.332628, 1.452496)

#_____________________________________________________________________________________________
#Question if score weighting should be performed
answeropt <- c("YES", "NO", "_____________________________________________________")

# selection default
cat("Please state, if adjusted score weighting is to be applied based upon machine leaning with a training set (default: NO).\n" )
MLtraining <- select.list( answeropt, multiple=T, title="Please state, if adjusted score weighting is to be applied based upon machine leaning with a training set (default: NO)." )
if ( length(MLtraining) == 0 ) {
  MLtraining <- "NO"
  cat("No adjusted score weighting will be executed, weights from rapamycin (exp 18), calyculin A (exp 20) and staurosporine (exp 36) will be applied.\n" )
} else { cat("Your answer was  ", paste( MLtraining, collapse=", "), "\n", sep="" )
}
if (  MLtraining == "NO" ) {
  cat("No score weightning will be executed, weights from rapamycin (exp 18), calyculin A (exp 20) and staurosporine (exp 36) will be applied.\n" )
}

answercoropt <- c("pearson", "kendall", "spearman", "_____________________________________________________")
# selection default
cat("Please state, what correlation should be applied (default: pearson).\n" )
answercor <- select.list( answercoropt, multiple=T, title="Please state, what correlation should be applied (default: pearson)." )
if ( length(answercor) == 0 ) {
  answercor <- "pearson"
  cat("Pearson correlation will be executed.\n" )
} else { cat("The selected correlation method was ", paste( answercor, collapse=", "), "\n", sep="" )
}

answerlogopt <- c("Normal", "Log", "_____________________________________________________")
# selection default
cat("Please select what intensity value transformation should be applied (default: normal).\n" )
answerlog <- select.list( answerlogopt, multiple=T, title="Please select what intensity value transformation should be applied (default: normal)." )
if ( length(answerlog) == 0 ) {
  answerlog <- "Normal"
  cat("Normal intensities will be used.\n" )
} else { cat("The transformation was method was ", paste( answerlog, collapse=", "), "\n", sep="" )
}

#_____________________________________________________________________________________________
#Question if dose response correlation testing should performed
# selection default
cat("Please state, if dose response correlation testing should performed (default: YES).\n" )
DRCtesting <- select.list( answeropt, multiple=T, title="Please state, if dose response correlation testing should performed (default: YES)." )
if ( length(DRCtesting) == 0 ) {
  DRCtesting <- "YES"
  cat("Dose response correlation will be performed.\n" )
} else { cat("Your answer was  ", paste( DRCtesting, collapse=", "), "\n", sep="" )
}
if (  DRCtesting == "NO" ) {
  cat("No dose response correlation testing will performed.\n" )
}

#_____________________________________________________________________________________________
#load LIP-PFL

#preparation
answeroptPFL <- c("Automatic","YES", "NO", "_____________________________________________________")

cat("Please select, if you select a LIP-Protein-Frequency-library/Crapome.\n" )
PFLselection <- select.list( answeroptPFL, multiple=T, title="Please select, if you select a LIP-Protein-Frequency-library/Crapome..Default is auto)" )
if ( length(PFLselection) == 0 || (PFLselection) == "Automatic") {
  cat("Auto import from file .\n" )
  pfl.df  <- read.delim("S:/Big_Temp/Roland/LIP Resource/LIP-Protein-Frequency-list v1 (18.11.07) -final.txt", header=T, sep="\t", stringsAsFactors=F, na.strings=c( "n. def." ) )
  setnames(pfl.df,"Frequency","PLFrequency")
  PFLselection <- "Automatic"
} else { cat("Your answer was  ", paste( PFLselection, collapse=", "), " .\n", sep="" )
}

if ( (PFLselection) == "YES" ) {
  #import and merge
  cat( "Select LIP-Protein-Frequency-library/Crapome  \n" )
  temp <- choose.files(default="", caption="Select LIP-Protein-Frequency-library/Crapome", multi = TRUE)
  temp1 <- sub("", "", basename(temp))
  for (i in 1:length(temp)) assign(temp1[i], read.delim(temp[i]))

  #list names of data frames to merge
  file_namesPFL=(temp1)
  #preprocessing of loaded data frames
  #Name the files in a new column
  names(file_namesPFL) <- file_namesPFL
  pfl.df = ldply(file_namesPFL, get)

}

if ( (PFLselection) != "NO" ) {
  #annotation of LIP PFL
  setnames(pfl.df,"UniProtIds","PFL.PG")}

#generated an empty data frame, if no PFL selected
if ( (PFLselection) == "NO" ) {
  pfl.df <- data.frame(c(1),c(1))
  setnames(pfl.df,"c.1.","PFL.PG")
  setnames(pfl.df,"c.1..1","PLFrequency")
}

#_____________________________________________________________________________________________
#Perform score weighting based on training set(s)
if (  MLtraining == "YES" ) {
  #data loading
  #import and merge
  cat( "Select unfiltered candidate list for ML training set  \n" )
  temp <- choose.files(default="", caption="Select unfiltered candidate list for ML training set", multi = TRUE)
  temp1 <- sub("", "", basename(temp))
  for (i in 1:length(temp)) assign(temp1[i], read.delim(temp[i]))

  #list names of data frames to merge
  file_names1=(temp1)
  #preprocessing of loaded data frames
  #Name the files in a new column
  names(file_names1) <- file_names1
  t.df = ldply(file_names1, get)

  #set working directory
  tempwd <- temp[1]
  workingDir <- sub("", "", dirname(tempwd))
  setwd(workingDir)

  #comparison filtering
  cat( "   Comparison filtering\n" )
  setnames(t.df,"Comparison..group1.group2.","Filter")

  #merge file-name and comparison for multiple candidate lists
  if(length(unique(t.df$Filter)) != 1) {
    t.df$Filter <-
      do.call(paste, c(t.df[c(".id", "Filter")], sep = ""))
  }

  #qvalue cutoff filtering
  t.df <- subset(t.df, t.df$Qvalue <= Qcutoff)
  #optional FC cutoff filtering
  t.df <- subset(t.df, t.df$Absolute.AVG.Log2.Ratio >= FCcutoff)

  #check if correlation pvalues not out off range for stable scores
  if(-log(t.df$Qvalue,10) > 60) {
    cat("Qvalues out of range (-log(pvalue)) > 60, redefine Q-value score range, stopping")
    stop()
  }

  #_____________________________________________________________________________________________
  # selection conditions column to retain
  cat( " Selection of the comparison to retain (e.g. 10 to 100x IC50).\n" )
  #get comparison column levels
  filter.v <- unique(t.df$Filter)
  filter.v <- as.character(filter.v)
  filter.v <- append(filter.v, "_____________")

  cond.true.v <- select.list( filter.v, multiple=T, title="Selection of the comparison to retain (e.g. 10 to 100x IC50)" )
  if ( length( cond.true.v ) == 0 ) {
    cat( " No conditions selected Stopping.\n" )
    stop()
  }
  cat( " conditions selected: ", paste( cond.true.v, collapse=", " ), "\n", sep="" )
  cat( "   \n" )

  #Filtering based on condition
  #true
  t1.df <- t.df[(t.df$Filter %in% cond.true.v), ]
  t1.df$Qvalue <- as.numeric(t1.df$Qvalue)
  t1.df <- subset(t1.df,!is.na(t1.df$Qvalue))
  t1.df <- t1.df[with(t1.df, order(Qvalue)), ]

  #check if protein names exist, otherwise take acessions
  if(length(unique(t1.df$ProteinNames)) == 1) {
    t1.df$ProteinNames <- NULL
    setnames(t1.df,"ProteinGroups","ProteinNames")
  }

  #Protein annotation LIP_PFL
  t1.df$PFL.PG <- gsub("\\;.*","",t1.df$ProteinGroups)

  #comparison table protein name
  t1.df$Comp.PG <-
    do.call(paste, c(t1.df[c(".id", "ProteinNames")], sep = ""))

  #saving candidate list file name
  filename <- str_sub(file_names1, end=-5)

  #_____________________________________________________________________________________________
  #load lookup table with know drug candidates
  cat( "  Select lookup table with known drug targets for ML training set (two columns called: ProteinNames and Target) \n" )
  #data loading
  #import and merge
  temp <- choose.files(default="", caption="Selection of table with know drug targets for ML training set (Uniprot Protein Names)", multi = TRUE)
  temp2 <- sub("", "", basename(temp))
  for (i in 1:length(temp)) assign(temp2[i], read.delim(temp[i]))

  #list names of data frames to merge
  file_names2=(temp2)
  #preprocessing of loaded data frames
  #Name the files in a new column
  names(file_names2) <- file_names2
  lookup.df = ldply(file_names2, get)

  lookup.df$.id <- NULL
  lookup.df$Target <- as.character(lookup.df$Target)

  #merge file-name and comparison for multiple candidate lists
  if("ExpNameComp" %in% colnames(lookup.df)) {
    #comparison table protein name
    lookup.df$Comp.PG <-
      do.call(paste, c(lookup.df[c("ExpNameComp", "ProteinNames")], sep = ""))

    lookup.df$SNRep.PG <-
      do.call(paste, c(lookup.df[c("ExpNameSN", "ProteinNames")], sep = ""))
  }
  lookup.df$ProteinNames <- NULL
  lookup.df$ExpNameComp <- NULL
  lookup.df$ExpNameSN <- NULL

  #________________________________________________________________________________________________
  #annotate protein frequency library in comparison table
  t1.df <- merge(t1.df, pfl.df, by=c("PFL.PG"), all.x=TRUE, all.y=FALSE)
  t1.df$PFL.PG <- NULL
  t1.df$PLFrequency[is.na(t1.df$PLFrequency)] <- 0

  #_____________________________________________________________________________________________
  #load SN report
  cat( "  Select Spectronaut quantitative Report (SN12 - long format) for ML training set \n" )

  temp <- choose.files(default="", caption="Select Spectronaut Quantitative Report (SN12 - long format) for ML training set", multi = TRUE)
  temp3 <- sub("", "", basename(temp))
  for (i in 1:length(temp)) assign(temp3[i], read.delim(temp[i]))

  #list names of data frames to merge
  file_names3=(temp3)
  #preprocessing of loaded data frames
  #Name the files in a new column
  names(file_names3) <- file_names3
  r.df = ldply(file_names3, get)

  #saving SN report file name
  filename1 <- str_sub(file_names3, end=-5)

  #check if external format loaded
  if ("EG.ModifiedPeptide" %in% colnames(r.df)) {
    setnames(r.df,"EG.ModifiedPeptide","EG.ModifiedSequence") }

  #check if protein names exist, otherwise take accessions
  if(length(unique(t1.df$PG.ProteinNames))== 1) {
    setnames(r.df,"PG.ProteinAccessions","ProteinNames")
  } else {
    setnames(r.df,"PG.ProteinNames","ProteinNames")
  }
  #merge experiment and protein accession for multiple candidate lists
  if(length(unique(r.df$.id)) != 1) {
    #sn report protein
    r.df$SNRep.PG <-
      do.call(paste, c(r.df[c(".id", "ProteinNames")], sep = ""))
  }

  #getting protein coverages and proteotypicity
  if ("PG.Coverage" %in% colnames(r.df) && "EG.IsProteotypic" %in% colnames(r.df)) {
    rc.df <- subset(r.df, !duplicated(r.df$EG.ModifiedSequence))
    rc.df <- subset(rc.df, select= c(EG.ModifiedSequence, PG.Coverage, EG.IsProteotypic))}

  if ("PG.Coverage" %in% colnames(r.df) && !("EG.IsProteotypic" %in% colnames(r.df))) {
    rc.df <- subset(r.df, !duplicated(r.df$EG.ModifiedSequence))
    rc.df <- subset(rc.df, select= c(EG.ModifiedSequence, PG.Coverage))}

  if (!("PG.Coverage" %in% colnames(r.df)) && "EG.IsProteotypic" %in% colnames(r.df)) {
    rc.df <- subset(r.df, !duplicated(r.df$EG.ModifiedSequence))
    rc.df <- subset(rc.df, select= c(EG.ModifiedSequence, EG.IsProteotypic))}

  #candidate list processing (ranking, annotation)
  ## section2 ----
  #_____________________________________________________________________________________________
  #candidate list processing (ranking, annotation)
  cat("Annotating sequences of unfilterd candidate list (target/protein coverage).\n" )

  #annotating drug targets and background experiment wise in comparison candidate list
  t1.df <- merge(t1.df, lookup.df, by=c("Comp.PG"), all.x=TRUE, all.y=FALSE)
  t1.df$Target[is.na(t1.df$Target)] <- "BG"

  #add protein coverage (and peptides per protein, Proteotypic?) (in case of multiple not solved)
  t1.df$EG.ModifiedSequence <- t1.df$Group
  t1.df <- merge(t1.df, rc.df, by=c("EG.ModifiedSequence"), all.x=TRUE, all.y=FALSE)

  #write.table(t1.df, "CompReport.txt", sep="\t", row.names = FALSE, quote = FALSE)

  # Preparing SN report and performing dose response analysis
  ## section3-DR anlysis training set----
  #_____________________________________________________________________________________________
  #Dose response analysis training set
  # Preparing SN report and performing dose response analysis
  cat("Preparing SN report and performing dose response analysis.\n" )
  #combine experiments, runs, conditions and proteins
  r.df$RunModseq <-
    do.call(paste, c(r.df[c(".id","R.FileName", "EG.ModifiedSequence")], sep = ""))
  r.df$CondMOdseq <-
    do.call(paste, c(r.df[c(".id","R.Condition", "EG.ModifiedSequence")], sep = ""))
  r.df$ProtModSeq <-
    do.call(paste, c(r.df[c("SNRep.PG", "EG.ModifiedSequence")], sep = ""))
  r.df$ExpCond <-
    do.call(paste, c(r.df[c(".id","R.Condition")], sep = ""))

  #annotate known candidates for training set true and false separation
  r2a.dt <- merge(r.df,lookup.df, by=c("SNRep.PG"), all.x= T)
  r2a.dt$Target[is.na(r2a.dt$Target)] <- "BG"
  r2aTARG.dt <- subset(r2a.dt, r2a.dt$Target == "YES")
  r2aBG.dt <- subset(r2a.dt, r2a.dt$Target == "BG")

  #get training set
  #get know targets significantly enriched
  ttrg.df <- subset(t1.df, t1.df$Target == "YES")
  ttrg.df <- subset(ttrg.df, ttrg.df$Qvalue < (Qcutoff/100))
  ttrg.df <- data.frame(ttrg.df$Group)
  setnames(ttrg.df, "ttrg.df.Group", "EG.ModifiedSequence")
  #get known candidates for DRC
  r2at.dt <- merge(r2aTARG.dt,ttrg.df, by="EG.ModifiedSequence", all.x=FALSE, all.y= T)

  #get random background set form candidate list for SN report extraction
  r2ab.dt <- subset(t1.df, t1.df$Target == "BG")

  setnames(r2ab.dt, "Group", "EG.ModifiedSequence")
  #sampling X random modified sequences from background spectronaut report
  r2arpart.dt <-
    data.frame(sample(unique(
      r2ab.dt$EG.ModifiedSequence),
      ldaBGsize,
      replace = FALSE,
      prob = NULL
    ))
  setnames(r2arpart.dt, "sample.unique.r2ab.dt.EG.ModifiedSequence...ldaBGsize..replace...FALSE..","EG.ModifiedSequence")
  r2arpart.dt <- data.frame(subset(r2arpart.dt, select=("EG.ModifiedSequence")))
  #select samples mod sequences from bg in spectronaut report
  r3atb.dt <- merge(r2aBG.dt, r2arpart.dt, by="EG.ModifiedSequence",all.x=F,all.y=T)
  #combine targets and background
  r3a.dt <- rbind(r3atb.dt, r2at.dt)
  #reconvert to data.frame containing only targets and random background
  r3.df <- data.frame(r3a.dt)
  #remove missing values
  r3.df <- subset(r3.df,!is.na(r3.df$ProtModSeq))

  #calculate run means for modified sequences and remove sparse modified sequences from data set
  # set as numeric
  r3.dt <- data.table(r3.df)
  r3.dt$FG.NormalizedMS2PeakArea <- as.numeric(r3.dt$FG.NormalizedMS2PeakArea)

  if (  answerlog == "Log" ) {
    #log transform intensities
    r3.dt$log.FG.NormalizedMS2PeakArea <- log10(r3.dt$FG.NormalizedMS2PeakArea)
    #Modified sequences averaged per run
    r3.dt[, Runmean := mean(log.FG.NormalizedMS2PeakArea, na.rm = TRUE), by =
            list(RunModseq)]
  } else {
    #Modified sequences averaged per run
    r3.dt[, Runmean := mean(FG.NormalizedMS2PeakArea, na.rm = TRUE), by =
            list(RunModseq)]
  }
  r3.dt <- subset(r3.dt, !duplicated(r3.dt$RunModseq))

  #________________________________________________________________________________________________
  #standardize data from 0 to 1
  r3.dt[, Runmeanstd := rescale(Runmean,c(0,1)), by =
          list(EG.ModifiedSequence)]

  r3.dt <- data.frame(r3.dt)
  #rename for plots
  setnames(r3.dt, "Runmean", "Intensity")
  #r3.dt$R.Condition[r2.dt$R.Condition == 0] <- 0.0001

  #remove scarse modified sequences
  r3a.dt <- data.table(r3.dt)
  #first peptides with not all enough replicates
  r3a.dt[, Repoccurence := length(unique(R.FileName)), by =
           list(CondMOdseq)]
  r3a.dt <- subset(r3a.dt,r3a.dt$Repoccurence >= (max(r3a.dt$Repoccurence))/2)
  #second peptides with not all conditions
  r3a.dt[, Occurence := length(unique(ExpCond)), by =
           list(ProtModSeq)]
  r3a.dt <- subset(r3a.dt,r3a.dt$Occurence >= (max(r3a.dt$Occurence))*0.66)

  r3.df <- data.frame(r3a.dt)

  #_____________________________________________________________________________________________
  # Dose response fitting and correlation measurement
  #get your runs/samples/proteins of interest in a vector
  #prepare correlation data frame
  correlation.df <- subset(r3.df, select=c("EG.ModifiedSequence", "ProtModSeq"))
  correlation.df <- subset(correlation.df, !duplicated(correlation.df$ProtModSeq))
  ProtModSeq.v <- unique(correlation.df$ProtModSeq)
  setnames(correlation.df, "EG.ModifiedSequence", "Group")
  correlation.df$DRC <- 0
  correlation.df$ED50 <- 0
  correlation.df$corpvalue <- 0
  #reset state counter
  state <- c(0)

  #perform dose response analysis and correlation for selected modified sequences
  for (k in 1:(length(ProtModSeq.v))) {
    #get current variable
    modSeq <-  ProtModSeq.v[k]

    #get current iteration
    state <- state + 1

    #take valid subset of the whole data set
    r1.dt.temp <- subset(r3.df, r3.df$ProtModSeq == modSeq)

    tryCatch(r1fit.dt.temp <-
               drm(
                 Intensity ~ R.Condition,
                 ProtModSeq,
                 data = r1.dt.temp,
                 fct = LL.4(),
                 #logDose=10,
                 na.action = na.omit
               ), error=function(e) print("Correlation LL.4 failed, LL3.4 backup performed"))
    if(exists("r1fit.dt.temp") == TRUE) {
      cat(round((100*state/length(ProtModSeq.v)), digits = 0), "%\n")} else {
        tryCatch(r1fit.dt.temp <-
                   drm(
                     Intensity ~ R.Condition,
                     ProtModSeq,
                     data = r1.dt.temp,
                     fct = LL.3(),
                     #logDose=10,
                     na.action = na.omit
                   ), error=function(e) print("Correlation LL.3 failed, L.4 backup performed"))
      }
    if(exists("r1fit.dt.temp") == TRUE) {
      cat(" ")} else {
        tryCatch(r1fit.dt.temp <-
                   drm(
                     Intensity ~ R.Condition,
                     ProtModSeq,
                     data = r1.dt.temp,
                     fct = L.4(),
                     #logDose=10,
                     na.action = na.omit
                   ), error=function(e) print("No correlation performed"))
      }

    correlations <- cor(r1.dt.temp$Intensity, fitted(r1fit.dt.temp), method = answercor) # , use = "complete.obs"
    corrtest <- cor.test(r1.dt.temp$Intensity, fitted(r1fit.dt.temp), method = answercor)$p.value
    correlation.df[state, 3] <- correlations
    ED50est <- data.frame(ED(r1fit.dt.temp, 50, display = FALSE))
    correlation.df[state, 4] <- ED50est$Estimate
    correlation.df[state, 5] <- corrtest
    try(rm(r1fit.dt.temp))
    try(rm(correlations))
    try(rm(corrtest))
    try(rm(ED50est))
  }

  ##add dose response correlations to candidate list
  t1c.dt <-
    merge(
      t1.df,
      correlation.df,
      by = c("Group"),
      all.x = F,
      all.y = T
    )

  #check if correlation pvalues not out off range for stable scores
  if(-log(t1c.dt$corpvalue,10) > 32) {
    cat("Correlation test p-values out of range (-log(pvalue)) > 32, stopping")
    stop()
  }

  #_____________________________________________________________________________________________
  #Preparation for Machine learning
  t1c.dt$corpvalue[is.na(t1c.dt$corpvalue)] <- 1
  t1c.dt$PG.Coverage <- as.numeric(str_sub(t1c.dt$PG.Coverage, end=-2))
  t1c.dt$PG.Coverage[is.na(t1c.dt$PG.Coverage)] <- 0.01
  t2c.dt <- t1c.dt
  t2c.dt$DRCNorml <- -log10(t2c.dt$corpvalue) / 32
  t2c.dt <- subset(t2c.dt,!is.na(t2c.dt$Target))
  t2c.dt$PG.Coverage <- as.numeric(str_sub(t2c.dt$PG.Coverage, end=-2))

  #calculate normalized Qvalue
  t2c.dt$logQvalue <- -log(t2c.dt$Qvalue,10)
  #divide trough defined max 40
  t2c.dt$logQvalueNorml <- t2c.dt$logQvalue / 50
  #calculate normalized FC
  t2c.dt$FCNorml <- abs(t2c.dt$AVG.Log2.Ratio / max(t2c.dt$AVG.Log2.Ratio))

  #Prepare LIP frequency library
  t2c.dt$normPFL <-   1-t2c.dt$PLFrequency
  t2c.dt$normPFL[is.na(t2c.dt$normPFL)] <- 1

  #rank all candidates per comparison
  t2c.dt <- data.table(t2c.dt)
  t2c.dt[,Rank:=rank(Qvalue),by=list(Filter)]
  t2c.dt[,Freq:=length(Filter),by=list(ProteinNames)]
  #remove potential off targets from ranking
  ##subset first bg data set
  #t2c.dt <- filter(t2c.dt, Rank > 20 | DRC < 0.75 & Target == "BG")  #or use , instead of |
  #t2c.dt$Rank <- "NULL"

  #calculate top10% occurence
  t1cTop10perc.dt <- subset(t2c.dt, t2c.dt$Rank <= (0.1*nrow(t2c.dt)))
  t1cRest.dt <- subset(t2c.dt, t2c.dt$Rank > (0.1*nrow(t2c.dt)))
  t1cTop10perc.dt[,Freq:=length(Filter),by=list(ProteinNames)]
  t1cTop10perc.dt$FreqNorml <- t1cTop10perc.dt$Freq / max(t1cTop10perc.dt$Freq)
  #t1cRest.dt$Freq <- 0.001
  t1cRest.dt$FreqNorml <- 1/nrow(t2c.dt)
  t2c.dt <- rbind(t1cTop10perc.dt,t1cRest.dt)
  t2c.dt <- data.frame(t2c.dt)

  #select relevant columns

  t2c.dt <- subset(t2c.dt, select=c("Target", "logQvalueNorml", "DRCNorml", "FreqNorml", "normPFL"))

  #Machine learning
  ## section4-ML training set ----

  #LDA analysis of the training set
  ml.df <- lda(formula = Target ~ .,
               data = t2c.dt)
  #SVM
  #mlsvm.df <- svm(Target ~ ., data = t2c.dt)

  #get score weights
  scoreweights.v <- ml.df$scaling

  #summary ML analysis
  cat("Calculated score weights: \n")
  print(ml.df$scaling)
  cat("Score weight trainnig executed.")

}
#_____________________________________________________________________________________________
#predict true candidates in new data set
## section5-ML-based-ranking ----
#second drug to apply weighted scores on
#data loading
#import and merge
cat( "Selection unfiltered candidate list   \n" )
tp <- choose.files(default="", caption="Select a unfiltered candidate list from Spectronaut for the main analysis", multi = TRUE)
tp1 <- sub("", "", basename(tp))
for (i in 1:length(tp)) assign(tp1[i], read.delim(tp[i]))

#list names of data frames to merge
file_names6=(tp1)
#preprocessing of loaded data frames
#Name the files in a new column
names(file_names6) <- file_names6
n.df = ldply(file_names6, get)
#saving candidate list file name
filenameCL <- str_sub(file_names6, end=-5)
n.df$.id <- NULL

#set working directory
tempwd <- tp[1]
workingDir <- sub("", "", dirname(tempwd))
setwd(workingDir)

#comparison filtering
cat( "   Comparison filtering\n" )
#check if already renamed
if("Comparison..group1.group2." %in% colnames(n.df))
{setnames(n.df,"Comparison..group1.group2.","Filter")}
#get comparison column levels
filter.v <- unique(n.df$Filter)
filter.v <- as.character(filter.v)
filter.v <- c(filter.v, c("_____________"))

# selection conditions column to retain
cat( " Selection of the comparison to retain (e.g. 10 to 100x IC50).\n" )
cond1.true.v <- select.list( filter.v, multiple=T, title="Selection of a statistical comparison to be used ineh analysis (e.g. 10 to 100x IC50)" )
if ( length( cond1.true.v ) == 0 ) {
  cat( " No conditions selected Stopping.\n" )
  stop()
}
cat( " conditions selected: ", paste( cond1.true.v, collapse=", " ), "\n", sep="" )
cat( "   \n" )

#Filtering based on condition
#true
n.df <- n.df[(n.df$Filter %in% cond1.true.v), ]

#qvalue cutoff filtering
n.df <- subset(n.df, n.df$Qvalue <= Qcutoff)
#optional FC cutoff filtering
n.df <- subset(n.df, n.df$Absolute.AVG.Log2.Ratio >= FCcutoff)

#check if correlation pvalues not out off range for stable scores
if(max(-log(n.df$Qvalue,10)) > 50) {
  cat("Qvalues out of range (-log(pvalue)) > 50, stopping")
  #stop()
}

#generating sub data frame
n1.df <- n.df

#ensure Qvalues are numbers and there is no NA
n1.df$Qvalue <- as.numeric(n1.df$Qvalue)
n1.df <- subset(n1.df,!is.na(n1.df$Qvalue))
n1.df <- n1.df[with(n1.df, order(Qvalue)), ]

#remove duplicated mod sequences from candidates keeping the best qvalue
n1.df <- subset(n1.df,!duplicated(n1.df$Group))

#check if protein names exist, otherwise take accessions
if(length(unique(n1.df$ProteinNames)) == 1) {
  n1.df$ProteinNames <- NULL
  n1.df$ProteinNames <- n1.df$ProteinGroups
}

#check if protein names exist, otherwise take accessions
if (!("ProteinGroups" %in% colnames(n1.df))) {
  n1.df$ProteinGroups <- n1.df$ProteinNames
}

#Protein annotation LIP_PFL
if(length(unique(n1.df$ProteinGroups)) != 1) {
  n1.df$PFL.PG <- gsub("\\;.*","",n1.df$ProteinGroups)}

#________________________________________________________________________________________________
#annotate protein frequency library in comparison table
n1.df <- merge(n1.df, pfl.df, by=c("PFL.PG"), all.x=TRUE, all.y=FALSE)
n1.df$PFL.PG <- NULL
n1.df$PLFrequency[is.na(n1.df$PLFrequency)] <- 0

#_____________________________________________________________________________________________
# selection
cat("Please select, if you want to use a list of known drug targets.\n" )
knowntargets <- select.list( answeropt, multiple=T, title="Use of a list with know drug targets (Uniprot Protein Names), default NO" )
if ( ( length(knowntargets) == 0 ) ) {
  cat("No table with konwn drug targets will be imported.\n" )
  knowntargets <- "NO"
} else { cat("Your answer was  ", paste( knowntargets, collapse=", "), "\n", sep="" )
}

if ( knowntargets == "YES" ) {
  #load known targets
  #import and merge
  cat( "Select list of known drug targets   \n" )
  tempr <- choose.files(default="", caption="Select list of known drug targets for main analysis", multi = TRUE)
  tempr1 <- sub("", "", basename(tempr))
  for (i in 1:length(tempr)) assign(tempr1[i], read.delim(tempr[i]))

  #list names of data frames to merge
  file_names5=(tempr1)
  #preprocessing of loaded data frames
  #Name the files in a new column
  names(file_names5) <- file_names5
  lookupntargets.df = ldply(file_names5, get)

  lookupntargets.df$.id <- NULL
  #annotate know targets in candidates
  n1.df <- merge(n1.df, lookupntargets.df, by="ProteinNames", all.x= TRUE)
  n1.df$Target <- as.character(n1.df$Target)
  n1.df$Target[is.na(n1.df$Target)] <- "BG"
}

#prefilter candidate list by qvalue and FC cutoff user defined
n1s.df <- subset(n1.df, n1.df$Qvalue <= Qcutoff)
n1s.df <- subset(n1s.df, n1s.df$Absolute.AVG.Log2.Ratio >= FCcutoff)
n1s.df$Prefilter <- "Pass"
n1s.df <- subset(n1s.df, select=c("Group", "Prefilter"))
setnames(n1s.df,"Group","EG.ModifiedSequence")

#________________________________________________________________________________________________
#annotate tryptic, semitryptic peptides in comparison table
#change folder to directory where PFL file is located or select manually, during running of the script
try(ISdigest.df  <- read.delim("S:/Big_Temp/Roland/LIP Resource/uniprot_sprot_2018-07-01_HUMAN_ISOFORMS_digest.tsv", header=T, sep="\t", stringsAsFactors=F, na.strings=c( "n. def." ) ))
if (exists("ISdigest.df") == TRUE) {
  ISdigest.df$Semitryptic <- "NO"
  ISdigest.df$ProteinId <- NULL
  ISdigest.df$PeptideLength <- NULL
  ISdigest.df$NrDigestPeptides <- NULL
  setnames(ISdigest.df,"PeptideSequence","EG.StrippedSequence")
  #generate stripped sequence in comparison table
  #saving candidate list file name
  n1.df$EG.StrippedSequence <- n1.df$Group
  #remove underscores
  n1.df$EG.StrippedSequence <- str_sub(n1.df$EG.StrippedSequence, end=-2)
  n1.df$EG.StrippedSequence <- str_sub(n1.df$EG.StrippedSequence, start=2)
  #remove cmids
  n1.df$EG.StrippedSequence <-str_replace_all(n1.df$EG.StrippedSequence, "\\[\\+C2\\+H3\\+N\\+O\\]", "")
  n1.df$EG.StrippedSequence <-str_replace_all(n1.df$EG.StrippedSequence, "\\[\\+C2\\+H2\\+O\\]", "")
  n1.df$EG.StrippedSequence <-str_replace_all(n1.df$EG.StrippedSequence, "\\[\\+O\\]", "")
  n1.df$EG.StrippedSequence <-str_replace_all(n1.df$EG.StrippedSequence, "\\[\\+O\\-H\\-N\\]", "")
  n1.df$EG.StrippedSequence <-str_replace_all(n1.df$EG.StrippedSequence, "\\[\\+C6\\+H10\\+O5\\]", "")
  n1.df$EG.StrippedSequence <-str_replace_all(n1.df$EG.StrippedSequence, "\\[\\+H\\+O3\\+P\\]", "")
  #[+C6+H10+O5]
  #[+H+O3+P]
  #convert precursors into stripped sequences alternative approch
  #t.df$Sequence <-str_replace_all(t.df$Precursor, "\\[.*?\\]", "")
  #t.df$Sequence <-str_replace_all(t.df$Sequence, "\\_", "")
  #t.df$Sequence <-str_replace_all(t.df$Sequence, "\\..*", "")

  #annotate candidate list
  n1.df <- merge(n1.df, ISdigest.df, by = c("EG.StrippedSequence"), all.x=TRUE, all.y=FALSE)
  n1.df$Semitryptic[is.na(n1.df$Semitryptic)] <- "YES"
}

#_____________________________________________________________________________________________
#load SN report for data set where the ML should be applied to
#data loading
#import and merge
cat( "Select SN report for ML based ranking  \n" )
tmp <- choose.files(default="", caption="Select Spectronaut Report for ML based ranking", multi = TRUE)
tmp1 <- sub("", "", basename(tmp))
for (i in 1:length(tmp)) assign(tmp1[i], read.delim(tmp[i]))

#list names of data frames to merge
file_names4=(tmp1)
#preprocessing of loaded data frames
#Name the files in a new column
names(file_names4) <- file_names4
nSN.df = ldply(file_names4, get)
#remove unnecessary column
nSN.df$.id <- NULL

#check if external format
if ("EG.ModifiedPeptide" %in% colnames(nSN.df)) {
  setnames(nSN.df,"EG.ModifiedPeptide","EG.ModifiedSequence") }

#check if protein names exist, otherwise take accessions
if(length(unique(nSN.df$PG.ProteinNames)) == 3) {
  nSN.df$PG.ProteinNames <- NULL
  setnames(nSN.df,"PG.ProteinAccessions","ProteinNames")
} else {
  setnames(nSN.df,"PG.ProteinNames","ProteinNames")
}

#________________________________________________________________________________________________
#annotate SN report semitryptic peptides
if (exists("ISdigest.df") == TRUE) {
  nSN.df <- merge(nSN.df, ISdigest.df, by = c("EG.StrippedSequence"), all.x=TRUE, all.y=FALSE)
  nSN.df$Semitryptic[is.na(nSN.df$Semitryptic)] <- "YES"
  nSN.df$Count <- 1

  tryp.df <- table(nSN.df$Semitryptic)
  NO.df <- as.vector(tryp.df[names(tryp.df)=="NO"])

  #test if more than 5% tryptic peptides, otherwise do not annotate
  if ((nrow(nSN.df)*0.05 < NO.df) == TRUE) {

    #tryptic semitryptic plots
    nSNplot.dt<- data.table(nSN.df)
    nSNplot.dt$Count <- 1
    #count semi/tryptic per run
    STrypticplot.df <- nSNplot.dt[ , .(Totalcount = sum(Count)), by = .(R.FileName, Semitryptic)]
    #shorten RAW file names
    STrypticplot.df$R.FileName <- str_sub(STrypticplot.df$R.FileName, start=20)
    STrypticplot.df$R.FileName <- str_sub(STrypticplot.df$R.FileName, end=-13)

    #order truns
    #STrypticplot.df$R.FileName <- as.numeric(STrypticplot.df$R.FileName)
    STrypticplot.df <- STrypticplot.df[with(STrypticplot.df, order(R.FileName)), ]

    #write semi trypric table
    write.table(STrypticplot.df, "Semitryptic-analysis-summary.txt", sep="\t", row.names = FALSE, quote = FALSE)

    #plot semi/trypric
    #with colorbrewer
    s.tryp.plot <- ggplot(STrypticplot.df, aes(x = R.FileName, fill= Semitryptic, y = Totalcount)) +
      geom_bar(colour="black", position="stack", stat = "identity") +
      theme(text = element_text(size=20)) +
      theme(axis.text.x = element_text(colour="black",size=16)) +
      theme(axis.text.y = element_text(colour="black",size=16)) +
      theme(axis.line = element_line(colour = "black"),
            panel.grid.major = element_blank(),
            panel.grid.minor = element_blank(),
            panel.border = element_blank(),
            panel.background = element_blank())

    pdf(paste(filenameCL, "-semitrypic-ana.pdf", sep=""))
    plot(s.tryp.plot)
    dev.off()
    rm(s.tryp.plot)

  }} else {n1.df$Semitryptic <- NULL}
#_________________________________________________________________________________________________

#________________________________________________________________________________________________
#getting protein coverages from Spectronaut report file
if ("PG.Coverage" %in% colnames(nSN.df) && "EG.IsProteotypic" %in% colnames(nSN.df)) {
  nc.df <- subset(nSN.df, !duplicated(nSN.df$EG.ModifiedSequence))
  nc.df <- subset(nc.df, select= c(EG.ModifiedSequence, PG.Coverage, EG.IsProteotypic))
  #add protein coverage to 2nd candidate file
  n1.df$EG.ModifiedSequence <- n1.df$Group
  n1a.df <- merge(n1.df, nc.df, by=c("EG.ModifiedSequence"), all.x=TRUE, all.y=FALSE)
  n1.df <- subset(n1a.df, !duplicated(n1a.df$Group))}

if ("PG.Coverage" %in% colnames(nSN.df) && !("EG.IsProteotypic" %in% colnames(nSN.df))) {
  nc.df <- subset(nSN.df, !duplicated(nSN.df$EG.ModifiedSequence))
  nc.df <- subset(nc.df, select= c(EG.ModifiedSequence, PG.Coverage))
  #add protein coverage to 2nd candidate file
  n1.df$EG.ModifiedSequence <- n1.df$Group
  n1a.df <- merge(n1.df, nc.df, by=c("EG.ModifiedSequence"), all.x=TRUE, all.y=FALSE)
  n1.df <- subset(n1a.df, !duplicated(n1a.df$Group))}

if (!("PG.Coverage" %in% colnames(nSN.df)) && "EG.IsProteotypic" %in% colnames(nSN.df)) {
  nc.df <- subset(nSN.df, !duplicated(nSN.df$EG.ModifiedSequence))
  nc.df <- subset(nc.df, select= c(EG.ModifiedSequence, EG.IsProteotypic))
  #add protein coverage to 2nd candidate file
  n1.df$EG.ModifiedSequence <- n1.df$Group
  n1a.df <- merge(n1.df, nc.df, by=c("EG.ModifiedSequence"), all.x=TRUE, all.y=FALSE)
  n1.df <- subset(n1a.df, !duplicated(n1a.df$Group))}

#____________________________________________________________________________________________

if (  DRCtesting == "YES" ) {
#extract protein candidates with qvalue (and FC) prefiltered from SN report for DRC analysis
nSN.df <- merge(nSN.df, n1s.df, by="EG.ModifiedSequence", all.x=FALSE, all.y= TRUE)
#prepare combined columns

nSN.df$ProteinNamestrm <- strtrim(nSN.df$ProteinNames, 25)

nSN.df$ProtModSeqtrm <-
  do.call(paste, c(nSN.df[c("ProteinNamestrm", "EG.ModifiedSequence")], sep = ""))
nSN.df$ProtModSeq <-
  do.call(paste, c(nSN.df[c("ProteinNames", "EG.ModifiedSequence")], sep = ""))
nSN.df$RunModseq <-
  do.call(paste, c(nSN.df[c("R.FileName", "EG.ModifiedSequence")], sep = ""))
nSN.df$CondModseq <-
  do.call(paste, c(nSN.df[c("R.Condition", "EG.ModifiedSequence")], sep = ""))

#________________________________________________________________________________________________
# selection annotation of conditions as concentrations
#conditions
#remove runs with no condition
nSN.df <- nSN.df[complete.cases(nSN.df$R.Condition), ]

answeropt1 <- c("YES", "NO","Retain from SN report", "_____________________________________________________")

cat("Please select, if you want to use a concentration table.\n" )
knownconc <- select.list( answeropt1, multiple=T, title="Please select, if you want to import a concentration table (YES) or generate standard concentrations (NO).Default is retain)" )
if ( length(knownconc) == 0 ) {
  cat("No concentration file import, Spectronaut report conditions/concentrations will be taken .\n" )
  knownconc <- "Retain from SN report"
} else { cat("Your answer was  ", paste( knownconc, collapse=", "), ". A concentration table as txt was generated in the analysis directory.\n", sep="" )
  condsimport.df <- data.frame(unique(nSN.df$R.Condition))
  setnames(condsimport.df, "unique.nSN.df.R.Condition." , "R.Condition")
  condsimport.df <- data.frame(condsimport.df[with(condsimport.df, order(R.Condition)), ])
  condsimport.df$Concentrations <- "fill-in"
  setnames(condsimport.df, "condsimport.df.with.condsimport.df..order.R.Condition....." , "R.Condition")
  write.table(condsimport.df, "Concentration-table.txt", sep="\t", row.names = FALSE, quote = FALSE)
}

if ( knownconc == "YES" ) {
  #lookup table (columns R.Condition, Concentrations)
  cat( "Please provide a conditions concentration table\n" )
  tempc <- choose.files(default="", caption="Please provide a conditions concentration table", multi = TRUE)
  tempc1 <- sub("", "", basename(tempc))
  for (i in 1:length(tempc)) assign(tempc1[i], read.delim(tempc[i]))

  #list names of data frames to merge
  file_names7=(tempc1)
  #preprocessing of loaded data frames
  #Name the files in a new column
  names(file_names7) <- file_names7
  conds1.v = ldply(file_names7, get)
  conds1.v$.id <- NULL
  conds1.v$Concentrations <- as.numeric(conds1.v$Concentrations)

}

if ( knownconc == "NO" ) {
  ##specific for experiments without conc annotation in conditions but plain numbering /letters
  if (exists("PosContrl") == TRUE) {
    nSN.df <- subset(nSN.df, nSN.df$R.Condition != PosContrl )}
  conds1.v <- data.frame(unique(nSN.df$R.Condition))
  conds1.v$a <- "a"
  setnames(conds1.v, "unique.nSN.df.R.Condition." , "R.Condition")
  conds1.v <- conds1.v[with(conds1.v, order(R.Condition)), ]
  ncond <- length(unique(nSN.df$R.Condition)) -1
  conds1.v$Concentrations <- c(0, lseq(1,10^(ncond-1), length = ncond))
  conds1.v$a <- NULL
}

#replace condition annotation
if ( knownconc != "Retain from SN report" ) {
  nSN.df <- merge(nSN.df, conds1.v, by=c("R.Condition"), all.x=FALSE, all.y=TRUE)
  nSN.df$R.Condition <- NULL
  setnames(nSN.df,"Concentrations","R.Condition")
}

#________________________________________________________________________________________________
answeropt2 <- c("nM", "pM","fM", "aM", "_____________________________________________________")

cat("Please select the concentration unit (default fM).\n" )
concUnit <- select.list( answeropt2, multiple=T, title="Please select the concentration unit (default nM)" )
if ( length(concUnit) == 0 ) {
  cat("No concentration file import, Spectronaut report conditions/concentrations will be taken .\n" )
  concUnit <- "nM"
} else { cat("Your answer was  ", paste( concUnit, collapse=", "), ".\n", sep="" )
}

#________________________________________________________________________________________________
# calculate means
nSN1.dt <- data.table(nSN.df)
# set as numeric
#check if PEP.Quantity exists, otherwise use NormalizedMS2PearArea
if ("PEP.Quantity" %in% colnames(nSN.df)) {
  nSN1.dt$PEP.Quantity <- as.numeric(nSN1.dt$PEP.Quantity)
} else {
  nSN1.dt$PEP.Quantity <- as.numeric(nSN1.dt$FG.NormalizedMS2PeakArea)
}
if (  answerlog == "Log" ) {
  #log transform intensities
  nSN1.dt$log.PEP.Quantity <- log10(nSN1.dt$PEP.Quantity)
  #calculate means based on the log10 intensities
  nSN1.dt[, Runmean := mean(log.PEP.Quantity, na.rm = TRUE), by =
            list(RunModseq)]
} else {
  #calculate means for modified peptides per run based  (charge states)
  nSN1.dt[, Runmean := mean(PEP.Quantity, na.rm = TRUE), by =
            list(RunModseq)]
}

#remove duplicated mod sequences per run
nSN2.dt <- subset(nSN1.dt,!duplicated(nSN1.dt$RunModseq))

#standardize data from 0 to 1
nSN2.dt[, Runmeanstd := rescale(Runmean,c(0,1)), by =
          list(EG.ModifiedSequence)]

setnames(nSN2.dt, "Runmeanstd", "Intensity")

#__________________________________________________________________________________________________
#remove scarse modified sequences
#first peptides with not all enough replicates
nSN2.dt[, Repoccurence := length(unique(R.FileName)), by =
          list(CondModseq)]
nSN2.dt <- subset(nSN2.dt,nSN2.dt$Repoccurence >= (max(nSN2.dt$Repoccurence)*0.25))
#second peptides with not all conditions
nSN2.dt[, Occurence := length(unique(R.Condition)), by =
          list(EG.ModifiedSequence)]
nSN2.dt <- subset(nSN2.dt,nSN2.dt$Occurence >= (max(nSN2.dt$Occurence)-2))

#remove excluded concentrations
if (exists("RemConc") == TRUE) {
  nSN2.dt <- subset(nSN2.dt, nSN2.dt$R.Condition != RemConc )}

#__________________________________________________________________________________________________
#Correlation analysis
#get your runs/samples/proteins of interest in a vector
modSeq1.v <- unique(nSN2.dt$EG.ModifiedSequence)
ProtModSeq2.v <- unique(nSN2.dt$ProtModSeq)
ProtModSeq1.v <- unique(nSN2.dt$ProtModSeqtrm)
NumbCond <- length(unique(nSN2.dt$R.Condition))-1

#prepare correlation data frame
correlation1.df <- data.frame(modSeq1.v, ProtModSeq2.v)
setnames(correlation1.df, "modSeq1.v", "Group")
correlation1.df$DRC <- 0
correlation1.df$ED50 <- 0
correlation1.df$corpvalue <- 0
#reset correlation iteration counter
state <- c(0)

#generate subdirectory for plots
dir.create("DRCplots")

#perform dose response analysis and correlation for selected modified sequences
for (k in 1:(length(ProtModSeq1.v))) {
  #get current variable
  modSeq <-  ProtModSeq1.v[k]
  #get current iteration
  state <- state + 1

  #take valid subset of the whole data set
  r1.dt.temp <- subset(nSN2.dt, nSN2.dt$ProtModSeqtrm == modSeq)

  #perform dose response fit
  tryCatch(r1fit.dt.temp <-
             drm(
               Intensity ~ R.Condition,
               ProtModSeq,
               data = r1.dt.temp,
               fct = LL.4(),
               #logDose=10,
               na.action = na.omit
             ), error=function(e) print("Correlation LL.4 failed, LL.3 backup performed"))
  if(exists("r1fit.dt.temp") == TRUE) {
    cat("Progres: ")
    cat(round((100*state/length(ProtModSeq1.v)), digits = 0), "%\n")} else {
      tryCatch(r1fit.dt.temp <-
                 drm(
                   Intensity ~ R.Condition,
                   ProtModSeq,
                   data = r1.dt.temp,
                   fct = LL.3(),
                   #logDose=10,
                   na.action = na.omit
                 ), error=function(e) print("Correlation LL.3 failed, L.4 backup performed"))
    }
  if(exists("r1fit.dt.temp") == TRUE) {
    cat(" ")} else {
      tryCatch(r1fit.dt.temp <-
                 drm(
                   Intensity ~ R.Condition,
                   ProtModSeq,
                   data = r1.dt.temp,
                   fct = L.4(),
                   #logDose=10,
                   na.action = na.omit
                 ), error=function(e) print("No correlation performed"))
    }
  #perform correlation analysis data to fit (pearson)
  correlations <- cor(r1.dt.temp$Intensity, fitted(r1fit.dt.temp), method = answercor) # , use = "complete.obs"
  corrtest <- cor.test(r1.dt.temp$Intensity, fitted(r1fit.dt.temp), method = answercor)$p.value

  correlation1.df[state, 3] <- correlations

  # Calculate ED50 (IC50)
  ED50est <- data.frame(ED(r1fit.dt.temp, 50, display = FALSE))
  correlation1.df[state, 4] <- ED50est$Estimate
  correlation1.df[state, 5] <- corrtest

  #Plot the data
  pdf(paste("DRCplots/Cent-Plot-",modSeq,".pdf", sep=""))
  par(mar = c(7, 7, 7, 5))
  plot <- plot( r1fit.dt.temp,  broken = TRUE, ylab= " ", xlab= paste("Concentration (", concUnit, ")", sep = ""))
  title(ylab=paste(answerlog, "-response (scaled)", sep = ""), line=5)
  title(main = paste(modSeq," corr=", round(correlations,digits = 3), sep=" "))
  dev.off()

  #Plot the data
  pdf(paste("DRCplots/Reps-Plot-",modSeq,".pdf", sep=""))
  par(mar = c(7, 7, 7, 5))
  plot <- plot( r1fit.dt.temp,  broken = TRUE, type = "all", ylab= " ", xlab= paste("Concentration (", concUnit, ")", sep = ""))
  title(ylab=paste(answerlog, "-response (scaled)", sep = ""), line=5)
  title(main = paste(modSeq," corr=", round(correlations,digits = 3), sep=" "))
  dev.off()

  #remove temporary objects
  try(rm(ED50est))
  try(rm(r1fit.dt.temp))
  try(rm(correlations))
  try(rm(corrtest))
  try(rm(plot))
}

#add dose response correlations to candidate list
#prepare for application of weights to scores

n1c.df <-
  merge(
    n1.df,
    correlation1.df,
    by = c("Group"),
    all.x = F,
    all.y = T
  )

n1c.df$corpvalue[is.na(n1c.df$corpvalue)] <- 1
#check if correlation pvalues not out off range for stable scores
if(max(-log(n1c.df$corpvalue,10)) > 30) {
  cat("Correlation p-values out of range (-log(pvalue)) > 32, stopping")
  #stop()
}

#qvalue of correlation test
qvalues <- qvalue(p =  n1c.df$corpvalue)
n1c.df <- cbind( n1c.df, qvalues$qvalues)
setnames(n1c.df, "qvalues$qvalues", "DRCqvalue")
#prepare for application of weights to scores
n1c.df <- n1c.df[with(n1c.df, order(corpvalue)), ]

#normalize DRC
n1c.df$logcorpval <- -log(n1c.df$corpvalue,10)
#stabilization of LIP score to max of 30 for logcorpval (never observed higher pvalue)
n1c.df$DRCNorml <- n1c.df$logcorpval / 30
#ensure not larger than 1
n1c.df$DRCNorml[n1c.df$DRCNorml > 1] <- 1

} else{
  #subset data frame
  n1c.df <- n1.df
  #generate empty DFC score
  n1c.df$DRCNorml <- 0
    #order by qvalue
  n1c.df <- n1c.df[with(n1c.df, order(Qvalue)), ]
}

#qvalue of t-test
n1c.df$logQvalue <- -log(n1c.df$Qvalue,10)
#pvalue stabilization to max 40 (above highest detected)
n1c.df$logQvalueNorml <- n1c.df$logQvalue / 40
#ensure not larger than 1
n1c.df$logQvalueNorml[n1c.df$logQvalueNorml > 1] <- 1

n1c.dt <- data.table(n1c.df)
n1c.dt[,QvalueRank:=rank(Qvalue),by=list(Filter)]

#calculate Top10% occurence
n1cTop10perc.dt <- subset(n1c.dt, n1c.dt$QvalueRank <= (0.1*nrow(n1c.dt)))
n1cRest.dt <- subset(n1c.dt, n1c.dt$QvalueRank > (0.1*nrow(n1c.dt)))
n1cTop10perc.dt[,Freq:=length(Filter),by=list(ProteinNames)]
n1cTop10perc.dt$FreqNorml <- n1cTop10perc.dt$Freq / max(n1cTop10perc.dt$Freq)
n1cTop10perc.dt$Freq <- NULL
#n1cRest.dt$Freq <- 0
n1cRest.dt$FreqNorml <- 1/nrow(n1c.dt)
n1c.dt <- rbind(n1cTop10perc.dt,n1cRest.dt)
n1c.dt <- data.frame(n1c.dt)

#Prepare LIP frequency library score
if (  (PFLselection) != "NO" ) {
n1c.dt$normPFL <-   1-n1c.dt$PLFrequency
n1c.dt$normPFL[is.na(n1c.dt$normPFL)] <- 1
} else {
  n1c.dt$normPFL <- 1
}

if ( (PFLselection) == "NO" ) {
  scoreweights.v[4] <- 0}
if (  DRCtesting == "NO" ) {
  scoreweights.v[2] <- 0}

#normalize result of total LIP-score to six
#initoal total lip score sum
ini.sum.LIPscore.v <- sum(scoreweights.v)
#adapt score to a combined max of 6
scoreweightsmax6.v <- scoreweights.v/ini.sum.LIPscore.v*6
#check back if 6 is the max now
final.sum.LIPscore.v <- sum(scoreweightsmax6.v)

#calculate combined score
n1c.dt$LIPscore <- n1c.dt$logQvalueNorml*scoreweightsmax6.v[1] + n1c.dt$DRCNorml*scoreweightsmax6.v[2] + n1c.dt$FreqNorml*scoreweightsmax6.v[3] + n1c.dt$normPFL*scoreweightsmax6.v[4]
#prevent NAs
n1c.dt$LIPscore[is.na(n1c.dt$LIPscore)] <- 0
#order by LipScore
n1c.dt <- n1c.dt[with(n1c.dt, order(LIPscore)), ]

#ranking by combined score
#convert to data.table
n1c.dt <- data.table(n1c.dt)
#generate constant column
n1c.dt$c <- "a"
#rank all candidates
n1c.dt[,LIPRank:=(length(LIPscore)-rank(LIPscore)+1),by=list(c)]
n1c.dt[,QvalueRank:=rank(Qvalue),by=list(c)]
#remove constant column again
n1c.dt$c <- NULL

#for protein level ranking calculate max LIPscore
n1c.dt[,ProteinLipScore:=max(LIPscore),by=list(ProteinNames)]

n1c.df <- data.frame(n1c.dt)
n1c.df <- n1c.df[with(n1c.df, order(-LIPscore)), ]

#write final table
write.table(n1c.df, paste(filenameCL , "-ModSeq-ranked.txt", sep = ""), sep="\t", row.names = FALSE, quote = FALSE)

#generate constant column
n1c.df$c <- "a"
#retain best LIP scoring peptide per protein
n2c.df <- subset(n1c.df,!duplicated(n1c.df$ProteinNames))
#rank all candidates on protein level
n2c.dt <- data.table(n2c.df)
n2c.dt[,LIPRank:=(length(LIPscore)-rank(LIPscore)+1),by=list(c)]
n2c.df <- data.frame(n2c.dt)
#remove constant column again
n2c.df$c <- NULL

#write final table colapsed to protein
write.table(n2c.df, paste(filenameCL , "-Protein-ranked.txt", sep = ""), sep="\t", row.names = FALSE, quote = FALSE)

if ( knowntargets == "YES" ) {
  #plot LIP-score histogram modified peptides
  LIPScore.plot <- ggplot(n1c.df, aes(x = LIPscore, fill= Target)) +
    scale_fill_brewer(palette = "Paired")+
    xlim(c(0), 6) +
    geom_rect(aes(xmin=0, xmax=2, ymin=-10, ymax=Inf), fill="Red") +
    geom_rect(aes(xmin=2, xmax=2.5, ymin=-10, ymax=Inf), fill="Orange") +
    geom_rect(aes(xmin=2.5, xmax=4, ymin=-10, ymax=Inf), fill="Yellow") +
    geom_rect(aes(xmin=4, xmax=6, ymin=-10, ymax=Inf), fill="Green") +
    geom_histogram(aes(fill=Target)) +
    theme(text = element_text(size=20)) +
    theme(axis.text.x = element_text(colour="black",size=16)) +
    theme(axis.text.y = element_text(colour="black",size=16)) +
    theme(axis.line = element_line(colour = "black"),
          panel.grid.major = element_blank(),
          panel.grid.minor = element_blank(),
          panel.border = element_blank(),
          panel.background = element_blank())

  pdf(paste(filenameCL, "-ModSeq-Hist.pdf", sep=""))
  plot(LIPScore.plot)
  dev.off()
  rm(LIPScore.plot)

  #plot LIP-score histogram protein
  LIPScore.plot <- ggplot(n2c.df, aes(x = LIPscore, fill= Target)) +
    scale_fill_brewer(palette = "Paired")+
    xlim(c(0), 6) +
    geom_rect(aes(xmin=0, xmax=2, ymin=-10, ymax=Inf), fill="Red") +
    geom_rect(aes(xmin=2, xmax=2.5, ymin=-10, ymax=Inf), fill="Orange") +
    geom_rect(aes(xmin=2.5, xmax=4, ymin=-10, ymax=Inf), fill="Yellow") +
    geom_rect(aes(xmin=4, xmax=6, ymin=-10, ymax=Inf), fill="Green") +
    geom_histogram() +
    theme(text = element_text(size=20)) +
    theme(axis.text.x = element_text(colour="black",size=16)) +
    theme(axis.text.y = element_text(colour="black",size=16)) +
    theme(axis.line = element_line(colour = "black"),
          panel.grid.major = element_blank(),
          panel.grid.minor = element_blank(),
          panel.border = element_blank(),
          panel.background = element_blank())

  pdf(paste(filenameCL, "-Protein-Hist.pdf", sep=""))
  plot(LIPScore.plot)
  dev.off()
  rm(LIPScore.plot)
} else {
  #plot LIP-score histogram modified peptides
  LIPScore.plot <- ggplot(n1c.df, aes(x = LIPscore)) +
    scale_fill_brewer(palette = "Paired")+
    xlim(c(0), 6) +
    geom_rect(aes(xmin=0, xmax=2, ymin=-10, ymax=Inf), fill="Red") +
    geom_rect(aes(xmin=2, xmax=2.5, ymin=-10, ymax=Inf), fill="Orange") +
    geom_rect(aes(xmin=2.5, xmax=4, ymin=-10, ymax=Inf), fill="Yellow") +
    geom_rect(aes(xmin=4, xmax=6, ymin=-10, ymax=Inf), fill="Green") +
    geom_histogram() +
    theme(text = element_text(size=20)) +
    theme(axis.text.x = element_text(colour="black",size=16)) +
    theme(axis.text.y = element_text(colour="black",size=16)) +
    theme(axis.line = element_line(colour = "black"),
          panel.grid.major = element_blank(),
          panel.grid.minor = element_blank(),
          panel.border = element_blank(),
          panel.background = element_blank())

  pdf(paste(filenameCL, "-ModSeq-Hist.pdf", sep=""))
  plot(LIPScore.plot)
  dev.off()
  rm(LIPScore.plot)

  #plot LIP-score histogram protein
  LIPScore.plot <- ggplot(n2c.df, aes(x = LIPscore)) +
    scale_fill_brewer(palette = "Paired")+
    xlim(c(0), 6) +
    geom_rect(aes(xmin=0, xmax=2, ymin=-10, ymax=Inf), fill="Red") +
    geom_rect(aes(xmin=2, xmax=2.5, ymin=-10, ymax=Inf), fill="Orange") +
    geom_rect(aes(xmin=2.5, xmax=4, ymin=-10, ymax=Inf), fill="Yellow") +
    geom_rect(aes(xmin=4, xmax=6, ymin=-10, ymax=Inf), fill="Green") +
    geom_histogram() +
    theme(text = element_text(size=20)) +
    theme(axis.text.x = element_text(colour="black",size=16)) +
    theme(axis.text.y = element_text(colour="black",size=16)) +
    theme(axis.line = element_line(colour = "black"),
          panel.grid.major = element_blank(),
          panel.grid.minor = element_blank(),
          panel.border = element_blank(),
          panel.background = element_blank())

  pdf(paste(filenameCL, "-Protein-Hist.pdf", sep=""))
  plot(LIPScore.plot)
  dev.off()
  rm(LIPScore.plot)
}

#clear work space
rm(list = ls(all = TRUE))

cat(" Dose response plots saved in sub-folder.   \n")
cat(" Script has concluded.   \n")
cat("   \n")

LIP-Scoring GLobal analysis V3.1 MIT Licence.r


####################################################################################################
#                                                                                #
# (c) 2018, 2019 Quantstamp, Inc. This content and its use are governed by the license terms at    #
# <https://raw.githubusercontent.com/quantstamp/qsp-staking-protocol/master/LICENSE>               #
#                                                                                #
####################################################################################################

library(dplyr)
library(readr)
library(RColorBrewer)
library(rlist)

## Analysis script inputs
run_index = 24;
plot_ticks = 25;

## Fixed constants
NUMBER_OF_POOLS_INDEX = 3;

## Turn warnings off
options(warn = -1)

## Read input and output files for the simulation run
run_in = read_table2(paste("input/run", run_index, ".txt", sep = ""));
run_out = read_csv(paste("output/run", run_index, ".csv", sep = ""));
df = tbl_df(run_out);
number_of_pools = max(run_in[NUMBER_OF_POOLS_INDEX,1]);

## Save plot to PNG, don't display it
png(paste("assurance-simulation-pool-analysis-full-run", run_index, ".png", sep = ""), width = 810, height = 530);

## Set the canvas
par(mar=c(4, 4, 1, 2))
layout(matrix(c(1, 2, 3), 3, 1, byrow = TRUE));
plot(1, type="n",
     xlab="Simulation iterations",
     ylab="Deposit QSPWei",
     ylim=c(0, 2.1e+22),
     xlim=c(0, length(df$Tick)),
     xaxt='n');
title(main = paste("Pool Dynamics in Assurance Simulation Run#", run_index, sep = ""));
## Draw vertical grid lines
for (i in seq(0, max(df$Tick), plot_ticks)) {
  abline(v = i, col = "#cccccc");
}
axis(side = 1, at = seq(0, max(df$Tick), plot_ticks));
legend_list = list();
## Plot pool deposit
for (i in seq(0, number_of_pools-1)) {
  label = paste("DepositQspWei", i, sep = "");
  legend_list = list.append(legend_list, label);
  deposit = unlist(df[, label]);

  lines(y=deposit, x=df$Tick, type="l", lty=i+1, col=i+1);
}
legend("topright", legend=legend_list, col=1:number_of_pools, lty=1:number_of_pools);

## Plot pool stakes size
plot(1, type="n",
     xlab="Simulation iterations",
     ylab="Pool Size QSPWei (Log)",
     ylim=c(1e+20, 2.1e+25),
     xlim=c(0, length(df$Tick)),
     xaxt='n',
     log='y');
## Draw vertical grid lines
for (i in seq(0, max(df$Tick), plot_ticks)) {
  abline(v = i, col = "#cccccc");
}
axis(side = 1, at = seq(0, max(df$Tick), plot_ticks));
legend_list = list();
for (i in seq(0, number_of_pools-1)) {
  label = paste("PoolSizeQspWei", i, sep = "");
  legend_list = list.append(legend_list, label);
  pool_size = unlist(df[, label]);

  lines(y=pool_size, x=df$Tick, type="l", lty=i+1, col=i+1);
}
legend("topright", legend=legend_list, col=1:number_of_pools, lty=1:number_of_pools);

## plot stake count
par(mar=c(2, 4, 0, 2));
legend_list = list();
plot(1, type="n",
     xlab="",
     ylab="Stake Count",
     ylim=c(0, 50),
     xlim=c(0, length(df$Tick)));
## Draw vertical grid lines
for (i in seq(0, max(df$Tick), plot_ticks)) {
  abline(v = i, col = "#cccccc");
}
for (i in seq(0, 50, 10)) {
  abline(h = i, col = "#cccccc");
}
for (i in seq(0, number_of_pools-1)) {
  label = paste("StakeCount", i, sep = "");
  legend_list = list.append(legend_list, label);
  stake_count = unlist(df[, label]);
  method = factor(unlist(df[, paste("PoolState", i, sep = "")]));

  lines(y=stake_count, x=df$Tick, type="l", lty=i+1, col=i+1);
}
axis(side = 1, at = seq(0, max(df$Tick), plot_ticks));
axis(side = 2, at = seq(0, 50, 10));
legend("topright", legend=legend_list, col=1:number_of_pools, lty=1:number_of_pools);

# Plot pool states
for (i in seq(0, number_of_pools-1)) {
  pool_state = unlist(df[, paste("PoolState", i, sep="")]);
  pool_labels = c(pool_state[[1]]);
  pool_ticks = c(1);
  for (j in 2:length(df$Tick)) {
    if (pool_state[[j]] != pool_state[[j-1]]) {
      pool_labels = append(pool_labels, c(pool_state[[j]]));
      pool_ticks = append(pool_ticks, c(j));
    }
  }
  text(pool_ticks, rep_len(i*4, length(pool_state)), labels=pool_labels, cex= 1.2, col=i+1);
}
## Save to png file
dev.off()


dyn.load('/Library/Java/JavaVirtualMachines/jdk1.8.0_131.jdk/Contents/Home/jre/lib/server/libjvm.dylib')

setwd("/Users/mengmengjiang/all datas/voltage")

#对单个内容进行画图分析，尝试记录单个内容的pdf图片格式
#文件名：voltage_stable , OV电压与BV电压之差，即stable 稳定电压与三种液体之间随流量、极间距离、针头直径变化的影响

library(xlsx)

#读取v~Q的数据
eq<-read.xlsx("voltage.xls",sheetName="ethanol_d",header=TRUE)
aq<-read.xlsx("voltage.xls",sheetName="acetone_d",header=TRUE)
iq<-read.xlsx("voltage.xls",sheetName="iso_d",header=TRUE)

plot(eq$d, eq$va,  col=0, xaxs="i", xlim=c(0.5,4.5), ylim=c(1, 3.3),xlab=expression(italic(Distance)(mm)),mgp=c(1, 0,0),tck=0.01,cex.lab=1.1,ylab=expression(italic(V)(kv)))

mtext("Distance",col="black",3,line=-1,font=2,cex=1)

###error bar####
error.bar <- function(x, y, upper, coll,lower=upper, length=0.05,...){
  if(length(x) != length(y) | length(y) !=length(lower) | length(lower) != length(upper))
    stop("vectors must be same length")
  arrows(x,y+upper, x, y-lower,col=coll, angle=90, code=3, length=length, ...)
}

###lines##
yan<-c("red","red","blue","blue","green3","green3")
pch<-c(1,2,1,2,1,2)

lines(eq$d,eq$vaeva,col=yan[1],pch=1,lwd=2,lty=4,type="b")
lines(eq$d,eq$vbeva,col=yan[2],pch=2,lwd=2,lty=4,type="b")
lines(aq$d,aq$vaeva,col=yan[3],pch=1,lwd=2,lty=4,type="b")
lines(aq$d,aq$vbeva,col=yan[4],pch=2,lwd=2,lty=4,type="b")
lines(iq$d,iq$vaeva,col=yan[5],pch=1,lwd=2,lty=4,type="b")
lines(iq$d,iq$vbeva,col=yan[6],pch=2,lwd=2,lty=4,type="b")

error.bar(eq$d,eq$vaeva,eq$vastd/2,col=yan[1])
error.bar(eq$d,eq$vbeva,eq$vbstd/2,col=yan[2])

error.bar(aq$d,aq$vaeva,aq$vastd/2,col=yan[3])
error.bar(aq$d,aq$vbeva,aq$vbstd/2,col=yan[4])

error.bar(iq$d,iq$vaeva,iq$vastd/2,col=yan[5])
error.bar(iq$d,iq$vbeva,iq$vbstd/2,col=yan[6])

leg<-c("ethanol-Von","ethanol-Vbr","acetone-Von","acetone-Vbr","iso-Von","iso-Vbr")

legend("bottomright",legend=leg, col=yan, pch=c(1,2,1,2,1,2),bty="n",lwd=2,lty=2,inset=.01,cex=0.8)


  figure.timeseries.interpolated = function( p, outdir ) {

    p$runindex = list(y=p$yrs, v=p$vars.to.model )

    K = interpolation.db( DS="interpolation.simulation", p=p  )

    for (v in p$vars.to.model) {
    for (r in p$regions.to.model) {
      print (paste(v,r))
      i = which(K$vars==v & K$region==r )
      if (length(i) == 0) next()
      XX=K[,]
      xx = XX$yr
      yy = XX$total
      lbound = XX$lbound
      ubound = XX$ubound
      surfacearea = XX$surfacearea

      dir.create( outdir, recursive=T, showWarnings=F  )
      ts.plotandsave(xx, yy, lbound, ubound, surfacearea, action="save", title="", filename=paste(v,r,sep="."), outdir=outdir )
    }}
    return("Done")
  }


#!/bin/env Rscript --no-save

# Genotype imputation protocol v3 - post-imputation QA plots
# Written by Kalle Pärn, Marita A. Isokallio, Paavo Häppölä, Javier Nunez Fontarnau and Priit Palta

# Required packages
library(data.table) # for fast fread()
library(sm)  # for density plotting

# Input variables
args <- commandArgs(TRUE)
indataset <- args[1]
paneldata <- args[2]

# Reference panel frequency file
panel <- fread(paneldata, header = T)

# Generate plots and save as a png file per chromosome
for (chr in 1:23) {
         print(paste("Working on chr ", chr, " now..."))

         # Creates the filename as <dataset>_chr#_postimputation_summary_plots.png
         png(filename = paste(indataset, "_chr", chr, "_postimputation_summary_plots.png", sep = ""), width = 1200, height = 1200, unit = "px")

         # Set the plots as two rows and columns
         par(mfrow = c(2,2))
         par(cex.axis = 1.6, cex.lab = 1.5, cex.main = 1.6)

         # Read in data for a file <dataset>_chr#_varID_AF_INFO_GROUP.txt
         imp_vars <- fread(paste(indataset, "_chr", chr, "_varID_AF_INFO_GROUP.txt", sep = ""), header = TRUE)

         # Create random sample for INFO score plot instead of plotting all values
         rand1 <- sample(1:dim(imp_vars)[1], 100000, replace = FALSE)
         temp1 <- imp_vars[rand1,]

         # Merge by common variants, SNP column in format CHR_POS_REF_ALT
         isec <- merge(panel, imp_vars, by="SNP")

         # Plot INFO score distributions
         sm.density.compare(temp1$INFO, temp1$AF_GROUP, xlab = "Impute2-like INFO score", ylab = "Density", col = col, lty = rep(1,3), lwd = 3, xlim = c(0,1), cex = 1.4, h = 0.05)
         title(paste("Imputation of chr", chr, " variants", sep = ""))
         legend("topleft", legend = c("MAF > 5%", "MAF 0.5-5%", "MAF < 0.5%"), lty = c(1, 1, 1), lwd = c(2.5, 2.5, 2.5), col = c("red", "green3", "blue"))

         # Plot AF of panel vs. imputed variants
         plot(isec$AF.x, isec$AF.y, col = 1, pch = 20, main = "Imputed AF vs. reference panel AF", xlab = "Reference panel AF", ylab = "Imputed AF", xlim = c(0,1), ylim = c(0,1))

         # Imputed data AF histogram for intersecting variants
         hist(isec$AF.y, breaks = 200, main = "AF distribution of imputed variants", xlab = "Imputed AF")

         # Plot absolute AF difference as imputed AF - panel AF
         isec$POS <- as.numeric(as.character(data.frame(do.call('rbind', strsplit(as.character(isec$SNP),'_',fixed=TRUE)))[,2]))
         # Order the variants by position
         sisec <- isec[order(isec$POS),]
         plot(sisec$POS, sisec$AF.y - sisec$AF.x, main = "Absolute AF differences along the chromosome", col = rgb(0,100,0,50, maxColorValue=255), ylim = c(-0.1, 0.1), pch = 16, xlab = "Chromosome position", ylab = "AF difference (imputed - panel)")

         # Close the png
         dev.off()
}


# set number of genes for empirical control for removing unwanted variation
EC = 100
# set working directory
setwd("/home/j/BIOINFORMATICA/NRGSC_old/")
## install packages
# install.packages(c("BiocManager","readr","dplyr", "magrittr","ggplot2"),
# lib = "./libraries",
# repos = 'http://cran.us.r-project.org')
# BiocManager::install("tximport", lib = "./libraries")
# BiocManager::install("DESeq2", lib = "./libraries")
# BiocManager::install("RUVSeq", lib = "./libraries")
# BiocManager::install("EDASeq", lib = "./libraries")
# BiocManager::install("edgeR", lib = "./libraries")
library(readr, lib.loc =  "./libraries")
library(dplyr, lib.loc =  "./libraries/")
library(magrittr,  lib.loc = "./libraries")
library(tximport, lib.loc = "./libraries")
library(DESeq2, lib.loc = "./libraries")
library(ggplot2, lib.loc =  "./libraries")
library(hexbin, lib.loc =  "./libraries")
library(EDASeq, lib.loc =  "./libraries")
library(RUVSeq, lib.loc =  "./libraries")
library(edgeR, lib.loc = "./libraries")
### function plot pca from deseq object
plot_pca_deseq <- function(data, shape, title, name, path) {
a <- plotPCA(data, intgroup ='Group') +
theme_bw() +
geom_point(size=4.5, aes( shape = shape))+
scale_shape_manual(values = seq(0,8)) +
labs(title = title, col="Group", shape = name) +
theme( text = element_text(size=22),
panel.border = element_blank(),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
plot.title = element_text(hjust = 0.5),
axis.line = element_line(colour = "black") )
ggsave( a, filename = path ,units = "cm",width = 15*1.3, height = 15,dpi = 320)
return(a)
}
plot_pca <- function(data, shape, title, percentage, path, legend, color) {
r <- ggplot(data, aes(x=PC1, y=PC2, colour=color, shape=shape))
r <- r + geom_point(size=4.5)
r <- r + theme_bw()
r <- r + labs(title = title, col="Group", shape= legend)
r <- r + xlab((paste0("PC1 : ",round(100 * (percentage[1]^2/sum(percentage^2)),2),"%")))
r <- r + ylab((paste0("PC2 : ",round(100 * (percentage[2]^2/sum(percentage^2)),2),"%")))
r <- r + theme( text = element_text(size=22),
panel.border = element_blank(),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
axis.line = element_line(colour = "black"))
ggsave( r, filename = path ,units = "cm",width = 15*1.3, height = 15,dpi = 320)
return(r)
}
sample_table <-read.table("metadata_complete.csv", sep = ",", header = T)
# load files paths
sample_files = paste0(pull(sample_table , "Sample_file"), "/quant.sf")
# name table columns
names(sample_files) = pull(sample_table, "Sample_file")
# relate genes to transcripts
tx2gene = read.table("txgen2.txt", sep = ",", col.names =c("genid","transid"))
# import count data to tximport
count_data = tximport( files = sample_files,
type = "salmon",
tx2gene =  tx2gene,
ignoreTxVersion = T)
sample_table$Condition <- as.factor((sample_table$Condition))
sample_table$Genotype <- as.factor((sample_table$Genotype))
sample_table$DevStage <- as.factor((sample_table$DevStage))
sample_table$Individual <- as.factor((sample_table$Individual))
sample_table$Group <- paste(sample_table$Genotype,'_',
sample_table$Condition,'_',
sample_table$DevStage, sep='')
sample_table$Group<-as.factor(sample_table$Group)
raw <- DESeqDataSetFromTximport(txi = count_data,
colData = sample_table,
design = ~ Group)
dim(raw)
keep<- rowSums(counts(raw))>0
table(keep)
raw <- raw[keep,]
dim(raw)
data <- estimateSizeFactors(raw)
vst <- varianceStabilizingTransformation(data)
## pca raw
raw_pca <-assay(data)
pca_raw <- prcomp(raw_pca,
center = T,
scale. = T)
pca_raw_data <- as.data.frame(pca_raw$rotation)
## plot raw by devstage
plot_pca(pca_raw_data, sample_table$DevStage, "RAW DATA BY DEVSTAGE", pca_raw$sdev,  "./raw_by_devstage.png", "DevStage", sample_table$Group)
## plot raw Genotype
plot_pca(pca_raw_data, sample_table$Genotype, "RAW DATA BY GENOTYPE", pca_raw$sdev,  "./raw_by_genotype.png", "Genotype", sample_table$Group)
## plot raw condition
plot_pca(pca_raw_data, sample_table$Condition, "RAW DATA BY CONDITION", pca_raw$sdev, "./raw_by_condition.png", "Condition", sample_table$Group)

## plot vst Devstage
plot_pca_deseq(vst, vst$DevStage, "VST BY DEVSTAGE", "Devstage",  "./vst/vst_devstage.png")
## plot vst Genotype
plot_pca_deseq(vst, vst$Genotype, "VST BY GENOTYPE", "Genotype",  "./vst/vst_genotype.png")
## plot vst Condition
plot_pca_deseq(vst, vst$Condition, "VST BY CONDITION", "Condition",  "./vst/vst_condition.png")

# vst R condition
vst_R <- vst[ ,vst$Genotype ==  "R" ]
plot_pca_deseq(vst_R, vst_R$Condition, "VST R BY CONDITION", "Condition",  "./vst/vst_R_condition.png")
# vst R devstage
plot_pca_deseq(vst_R, vst_R$DevStage, "VST R BY DEVSTAGE", "Devstage",  "./vst/vst_R_devstage.png")
# vst NR condition
vst_NR <- vst[ ,vst$Genotype ==  "NR" ]
plot_pca_deseq(vst_NR, vst_NR$Condition, "VST NR BY CONDITION", "Condition",  "./vst/vst_NR_condition.png")
# vst NR devstage
plot_pca_deseq(vst_NR, vst_R$DevStage, "VST NR BY DEVSTAGE", "Devstage",  "./vst/vst_NR_devstage.png")

### RUVs
differences <- makeGroups(sample_table$Group)
genes <- row.names(raw)
setRUVs <- RUVs(as.matrix(assay(raw)), genes, k=1, differences)
dataRUVs <- DESeqDataSetFromMatrix(countData = setRUVs$normalizedCounts,
colData = sample_table,
design = ~ Group)
RUVs_counts<-t(assay(dataRUVs))
pca_ruvs <- prcomp(RUVs_counts,
center = F,
scale. = F)
pca_data_ruvs <- as.data.frame(pca_ruvs$x)
## RUVs condition
plot_pca(pca_data_ruvs, sample_table$Condition, "RUVs BY CONDITION", pca_ruvs$sdev, "./RUVs/RUVs_by_condition.png", "Condition", sample_table$Group)
# RUVs devstage
plot_pca(pca_data_ruvs, sample_table$DevStage, "RUVs BY DEVSTAGE", pca_ruvs$sdev, "./RUVs/RUVs_by_devstage.png", "Devstage", sample_table$Group)
# RUVs genotype
plot_pca(pca_data_ruvs, sample_table$Genotype, "RUVs BY GENOTYPE", pca_ruvs$sdev, "./RUVs/RUVs_by_genotype.png", "Genotype", sample_table$Group)

## RUVs NR condition
RUVs_NR <- dataRUVs[ ,dataRUVs$Genotype ==  "NR" ]
RUVs_NR_counts<-t(assay(RUVs_NR))
pca_ruvs_NR <- prcomp(RUVs_NR_counts,
center = FALSE,
scale. = FALSE)
pca_data_ruvs_NR <- as.data.frame(pca_ruvs_NR$x)
plot_pca(pca_data_ruvs_NR, RUVs_NR$Condition, "RUVs NR BY CONDITION", pca_ruvs_NR$sdev, "./RUVs/RUVs_NR_condition.png", "Condition", RUVs_NR$Group)
## RUVs NR Devstage
plot_pca(pca_data_ruvs_NR, RUVs_NR$DevStage, "RUVs NR BY DEVSTAGE", pca_ruvs_NR$sdev, "./RUVs/RUVs_NR_devstage.png", "Devstage", RUVs_NR$Group)
## RUVs R devstage
RUVs_R <- dataRUVs[ ,dataRUVs$Genotype ==  "R" ]
RUVs_R_counts<-t(assay(RUVs_R))
pca_ruvs_R <- prcomp(RUVs_R_counts,
center = FALSE,
scale. = FALSE)
pca_data_ruvs_R <- as.data.frame(pca_ruvs_R$x)
plot_pca(pca_data_ruvs_R, RUVs_R$DevStage, "RUVs R BY DEVSTAGE", pca_ruvs_R$sdev, "./RUVs/RUVs_R_devstage.png", "Devstage", RUVs_R$Group)
## RUVs R condition
plot_pca(pca_data_ruvs_R, RUVs_R$Condition, "RUVs R BY CONDITION", pca_ruvs_R$sdev, "./RUVs/RUVs_R_condition.png", "Condition", RUVs_R$Group)

## RUVg
dea <- DESeq(raw)
results_table <- as.data.frame(results(dea))
empirical_control <- rownames(tail(arrange(results_table, pvalue),EC))
RUVgSet <- RUVg(as.matrix(assay(raw)), empirical_control, k = 1)
dataRUVg<- DESeqDataSetFromMatrix(countData = RUVgSet$normalizedCounts,
colData = sample_table,
design = ~ Group)
RUVg_counts<-t(assay(dataRUVg))
pca_ruvg <- prcomp(RUVg_counts,
center = FALSE,
scale. = FALSE)
pca_data_ruvg <- as.data.frame(pca_ruvg$x)
## RUVg devstage
plot_pca(pca_data_ruvg, dataRUVg$DevStage, "RUVg BY DEVSTAGE", pca_ruvg$sdev, "./RUVg/RUVg_devstage.png", "Devstage", dataRUVg$Group)
## RUVg genotype
plot_pca(pca_data_ruvg, dataRUVg$Genotype, "RUVg BY GENOTYPE", pca_ruvg$sdev, "./RUVg/RUVg_genotype.png", "Genotype", dataRUVg$Group)
## RUVg Condition
plot_pca(pca_data_ruvg, dataRUVg$Condition, "RUVg BY CONDITION", pca_ruvg$sdev, "./RUVg/RUVg_condition.png", "Condition", dataRUVg$Group)
## RUVg R condition
RUVg_R <- dataRUVg[ ,dataRUVg$Genotype ==  "R" ]
RUVg_R_counts<-t(assay(RUVg_R))
pca_ruvg_R <- prcomp(RUVg_R_counts,
center = FALSE,
scale. = FALSE)
pca_data_ruvg_R <- as.data.frame(pca_ruvg_R$x)
plot_pca(pca_data_ruvg_R, RUVg_R$Condition, "RUVg R BY CONDITION", pca_ruvg_R$sdev, "./RUVg/RUVg_R_condition.png", "Condition", RUVg_R$Group)
## RUVg R devstage
plot_pca(pca_data_ruvg_R, RUVg_R$DevStage, "RUVg R BY DEVSTAGE", pca_ruvg_R$sdev, "./RUVg/RUVg_R_devstage.png", "Devstage", RUVg_R$Group)
## RUVg NR condition
RUVg_NR <- dataRUVg[ ,dataRUVg$Genotype ==  "NR" ]
RUVg_NR_counts<-t(assay(RUVg_NR))
pca_ruvg_NR <- prcomp(RUVg_NR_counts,
center = FALSE,
scale. = FALSE)
pca_data_ruvg_NR <- as.data.frame(pca_ruvg_NR$x)
plot_pca(pca_data_ruvg_NR, RUVg_NR$Condition, "RUVg NR BY CONDITION", pca_ruvg_NR$sdev, "./RUVg/RUVg_NR_condition.png", "Condition", RUVg_NR$Group)
## RUVg NR devstage
plot_pca(pca_data_ruvg_NR, RUVg_NR$DevStage, "RUVg NR BY DEVSTAGE", pca_ruvg_NR$sdev, "./RUVg/RUVg_NR_devstage.png", "Devstage", RUVg_NR$Group)

## RUVr
design <- model.matrix(~sample_table$Group)
y <- DGEList(counts=counts(raw), group=sample_table$Group)
keep <- filterByExpr(y)
y <- y[keep, , keep.lib.sizes=FALSE]
y <- calcNormFactors(y, method="upperquartile")
y <- estimateGLMCommonDisp(y, design)
y <- estimateGLMTagwiseDisp(y, design)
fit <- glmFit(y, design)
res <- residuals(fit, type="deviance")
set_RUVr <- RUVr(y$counts,rownames(y), k=1, res)
dataRUVr <- DESeqDataSetFromMatrix(countData = set_RUVr$normalizedCounts,
colData = sample_table,
design = ~ Group)
RUVr_counts<-t(assay(dataRUVr))
pca_ruvr <- prcomp(RUVr_counts,
center = FALSE,
scale. = FALSE)
pca_data_ruvr <- as.data.frame(pca_ruvr$x)
## RUVr condition
plot_pca(pca_data_ruvr, dataRUVr$Condition, "RUVr BY CONDITION", pca_ruvr$sdev, "./RUVr/RUVr_condition.png", "Condition", dataRUVr$Group)
## RUVr genotype
plot_pca(pca_data_ruvr, dataRUVr$Genotype, "RUVr BY GENOTYPE", pca_ruvr$sdev, "./RUVr/RUVr_genotype.png", "Genotype", dataRUVr$Group)
## RUVr Devstage
plot_pca(pca_data_ruvr, dataRUVr$DevStage, "RUVr BY DEVSTAGE", pca_ruvr$sdev, "./RUVr/RUVr_devstage.png", "Devstagee", dataRUVr$DevStage)

## RUVr R condition
RUVr_R <- dataRUVr[ ,dataRUVr$Genotype ==  "R" ]
RUVr_R_counts<-t(assay(RUVr_R))
pca_ruvr_R <- prcomp(RUVr_R_counts,
center = FALSE,
scale. = FALSE)
pca_data_ruvr_R <- as.data.frame(pca_ruvr_R$x)
plot_pca(pca_data_ruvr_R, RUVr_R$Condition, "RUVr R BY CONDITION", pca_ruvr_R$sdev, "./RUVr/RUVr_R_condition.png", "Condition", RUVr_R$Group)
## RUVr R devstage
plot_pca(pca_data_ruvr_R, RUVr_R$DevStage, "RUVr R BY DEVSTAGE", pca_ruvr_R$sdev, "./RUVr/RUVr_R_devstage.png", "Devstage", RUVr_R$Group)
## RUVr NR condition
RUVr_NR <- dataRUVr[ ,dataRUVr$Genotype ==  "NR" ]
RUVr_NR_counts<-t(assay(RUVr_NR))
pca_ruvr_NR <- prcomp(RUVr_NR_counts,
center = FALSE,
scale. = FALSE)
pca_data_ruvr_NR <- as.data.frame(pca_ruvr_NR$x)
plot_pca(pca_data_ruvr_NR, RUVr_NR$Condition, "RUVr NR BY CONDITION", pca_ruvr_NR$sdev, "./RUVr/RUVr_NR_condition.png", "Condition", RUVr_NR$Group)
## RUVr NR devstage
plot_pca(pca_data_ruvr_NR, RUVr_NR$DevStage, "RUVr NR BY DEVSTAGE", pca_ruvr_NR$sdev, "./RUVr/RUVr_NR_devstage.png", "Devstage", RUVr_NR$Group)

save.image(file='session.Rdata')