From bcbe0703d05b4aa5016f5e3c38b49cda9725f987 Mon Sep 17 00:00:00 2001 From: Jason Kunisaki Date: Wed, 25 Oct 2017 17:53:07 -0500 Subject: [PATCH 01/21] JHK; lohSpec S4 scripts --- R/AllGenerics.R | 105 ++++++- R/MutationAnnotationFormat-class.R | 1 + R/VarScanFormat-class.R | 121 ++++++++ R/VarScanFormat_Virtual-class.R | 39 +++ R/lohSpec-class.R | 470 +++++++++++++++++++++++++++++ R/lohSpec-methods.R | 16 + R/multi_chrBound.R | 2 +- 7 files changed, 752 insertions(+), 2 deletions(-) create mode 100644 R/VarScanFormat-class.R create mode 100644 R/VarScanFormat_Virtual-class.R create mode 100644 R/lohSpec-class.R create mode 100644 R/lohSpec-methods.R diff --git a/R/AllGenerics.R b/R/AllGenerics.R index 36df394..8b3e6e0 100644 --- a/R/AllGenerics.R +++ b/R/AllGenerics.R @@ -500,4 +500,107 @@ setGeneric( setGeneric( name="getHeader", def=function(object, ...){standardGeneric("getHeader")} -) \ No newline at end of file +) + +################################################################################ +##### Functions used for lohSpec ############################################### +################################################################################ +#' Method getVarScan +#' +#' @name getVarScan +#' @rdname getVarScan-methods +#' @param object Object of class VarScanFormat +#' @param ... additional arguments to passed +#' @exportMethod getVarScan +setGeneric( + name="getVarScan", + def=function(object, ...){standardGeneric("getVarScan")} +) + +#' Method getLohData +#' +#' @name getLohData +#' @rdname getLohData-methods +#' @param object Object of class VarScanFormat +#' @param ... additional arguments to passed +#' @exportMethod getLohData +setGeneric( + name="getLohData", + def=function(object, ...){standardGeneric("getLohData")} +) + +#' Method lohSpec_qual +#' +#' @name lohSpec_qual +#' @rdname lohSpec_qual-methods +#' @param object Object of class VarScanFormat +#' @param ... additional arguments to passed +#' @exportMethod lohSpec_qual +setGeneric( + name="lohSpec_qual", + def=function(object, ...){standardGeneric("lohSpec_qual")} +) + +#' Method getChrBoundaries +#' +#' @name getChrBoundaries +#' @rdname getChrBoundaries-methods +#' @param object Object of class VarScanFormat +#' @param ... additional arguments to passed +#' @exportMethod getChrBoundaries +setGeneric( + name="getChrBoundaries", + def=function(object, ...){standardGeneric("getChrBoundaries")} +) + +#' Method getLohSlidingWindow +#' +#' @name getLohSlidingWindow +#' @rdname getLohSlidingWindow-methods +#' @param object Object of class VarScanFormat +#' @param ... additional arguments to passed +#' @exportMethod getLohSlidingWindow +setGeneric( + name="getLohSlidingWindow", + def=function(object, ...){standardGeneric("getLohSlidingWindow")} +) + +#' Method getLohCalculation +#' +#' @name getLohCalculation +#' @rdname getLohCalculation-methods +#' @param object Object of class VarScanFormat +#' @param ... additional arguments to passed +#' @exportMethod getLohSlidingWindow +setGeneric( + name="getLohCalculation", + def=function(object, ...){standardGeneric("getLohCalculation")} +) + +#' Method getLohStepCalculation +#' +#' @name getLohStepCalculation +#' @rdname getLohStepCalculation-methods +#' @param object Object of class VarScanFormat +#' @param ... additional arguments to passed +#' @exportMethod getLohSlidingWindow +setGeneric( + name="getLohStepCalculation", + def=function(object, ...){standardGeneric("getLohStepCalculation")} +) + +#' Method lohSpec_buildMainPlot +#' +#' @name lohSpec_buildMainPlot +#' @rdname lohSpec_buildMainPlot-methods +#' @param object Object of class VarScanFormat +#' @param ... additional arguments to passed +#' @exportMethod getLohSlidingWindow +setGeneric( + name="lohSpec_buildMainPlot", + def=function(object, ...){standardGeneric("lohSpec_buildMainPlot")} +) + + + + diff --git a/R/MutationAnnotationFormat-class.R b/R/MutationAnnotationFormat-class.R index ab460ff..f289b8a 100644 --- a/R/MutationAnnotationFormat-class.R +++ b/R/MutationAnnotationFormat-class.R @@ -35,6 +35,7 @@ setClass("MutationAnnotationFormat", #' @importFrom data.table fread #' @export MutationAnnotationFormat <- function(path, version="auto", verbose=FALSE){ + browser() mafData <- suppressWarnings(data.table::fread(input=path, stringsAsFactors=TRUE, verbose=verbose)) diff --git a/R/VarScanFormat-class.R b/R/VarScanFormat-class.R new file mode 100644 index 0000000..737af06 --- /dev/null +++ b/R/VarScanFormat-class.R @@ -0,0 +1,121 @@ +################################################################################ +##################### Public/Private Class Definitions ######################### + +#!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Public Class !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!# + +#' Class VarScanFormat +#' +#' An S4 class acting as a container for VarScanFormat. +#' @name VarScanFormat-class +#' @rdname VarScanFormat-class +#' @slot path Character string specifying the path of the VarScan file read in. +#' @exportClass VarScanFormat +#' @include VarScanFormat_Virtual-class.R +#' @import methods +setClass("VarScanFormat", + representation=representation(path="character"), + contains="VarScanFormat_Virtual", + validity = function(object) { + head(object) + ## Expected varscan column names + cnames <- c("chrom", "position", "ref", "var", + "normal_reads1", "normal_reads2", "normal_var_freq", + "normal_gt", "tumor_reads1", "tumor_reads2", "tumor_var_freq", + "tumor_gt", "somatic_status", "variant_p_value", + "somatic_p_value", "tumor_reads1_plus", "tumor_reads1_minus", + "tumor_reads2_plus", "tumor_reads2_minus", + "normal_reads1_plus", "normal_reads1_minus", + "normal_reads2_plus", "normal_reads2_minus", "sample") + + ## Check the column names to see if there is the appropriate input + varscan_column_names <- colnames(object@varscanData) + num <- which(!varscan_column_names%in%cnames) + if (length(num) > 0 & length(varscan_column_names) == length(cnames)) { + stop("Column names of varscan input are not what is expected. Please + refer to + http://varscan.sourceforge.net/somatic-calling.html#somatic-output + for appropriate column names.") + } + if (length(num) > 0 & length(varscan_column_names) != length(cnames)) { + stop("Number of columns in varscan input are not what is expected. 23 + columns are expected. Please refer to + http://varscan.sourceforge.net/somatic-calling.html#somatic-output + for appropriate columns and column names.") + } + return(TRUE) + } +) + +#' Constructor for the VarScanFormat container class. +#' +#' @name VarScanFormat +#' @rdname VarScanFormat-class +#' @param path String specifying the path to a VarScan file. +#' @param verbose Boolean specifying if progress should be reported while reading +#' in the VarScan. file. +#' @seealso \code{\link{lohSpec}} +#' @importFrom data.table fread +#' @export +VarScanFormat <- function(path, verbose=FALSE) { + browser() + ## Read in VarScan data + varscanData <- suppressWarnings(data.table::fread(input=path, + stringsAsFactors=FALSE, + verbose=verbose)) + ## Put in sample name for now + varscanData$sample <- "HCC1395" + ## Get the sample names + sample <- varscanData[,which(colnames(varscanData)=="sample"), with=FALSE] + + ## Create the varscan object + varscanObject <- new("VarScanFormat", path=path, varscan=varscanData, sample=sample) + return(varscanObject) + +} + +################################################################################ +####################### Method function definitions ############################ + +#' @rdname getLohData-methods +#' @aliases getLohData +#' @noRd +#' @importFrom data.table data.table +setMethod(f="getLohData", + signature="VarScanFormat", + definition=function(object, chr, verbose, ...) { + ## Get the necessary columns from varscan output + primaryData <- object@varscan[,c("chrom", "position", "tumor_var_freq", + "normal_var_freq", "sample"), + with=FALSE] + + ## Convert percentages to proportion + primaryData$tumor_var_freq <- gsub("%", "", + primaryData$tumor_var_freq) + primaryData$normal_var_freq <- gsub("%", "", + primaryData$normal_var_freq) + primaryData$tumor_var_freq <- round(as.numeric(as.character( + primaryData$tumor_var_freq))/100, + digits = 3) + primaryData$normal_var_freq <- round(as.numeric(as.character( + primaryData$normal_var_freq))/100, + digits = 3) + + ## Remove contigs, MT, and other unnecessary chromosomes + if (is.null(chr)) { + chr <- c(as.character(seq(1:22))) + } + if (is.null(chr) == FALSE) { + primaryData <- primaryData[chrom %in% chr] + } + + ## Print status message + if (verbose) { + message("Generating LOH dataset.") + } + return(primaryData) + + }) + + + + diff --git a/R/VarScanFormat_Virtual-class.R b/R/VarScanFormat_Virtual-class.R new file mode 100644 index 0000000..af5c6c4 --- /dev/null +++ b/R/VarScanFormat_Virtual-class.R @@ -0,0 +1,39 @@ +################################################################################ +##################### Virutal Class Definition ################################# + +#' Class VarScanFormat_Virtual +#' +#' An S4 class to act as a virtual class for MutationAnnotationFormat version sub-classes. +#' @name VarScanFormat_Virtual-class +#' @rdname VarScanFormat_Virtual-class +#' @slot varscan data.table object holding varscan data. +#' @slot sample data.table object holding sample data. +#' @importClassesFrom data.table data.table +#' @import methods +setClass( + Class="VarScanFormat_Virtual", + representation=representation(varscan="data.table", + sample="data.table", + "VIRTUAL") +) + +################################################################################ +###################### Accessor function definitions ########################### + +#' @rdname getVarScan-methods +#' @aliases getVarScan +setMethod(f="getVarScan", + signature="VarScanFormat_Virtual", + definition=function(object, ...){ + varscan <- object@varscan + return(varscan) + }) + +#' @rdname getSample-methods +#' @aliases getSample +setMethod(f="getSample", + signature="VarScanFormat_Virtual", + definition=function(object, ...){ + sample <- object@sample + return(sample) + }) \ No newline at end of file diff --git a/R/lohSpec-class.R b/R/lohSpec-class.R new file mode 100644 index 0000000..29188c6 --- /dev/null +++ b/R/lohSpec-class.R @@ -0,0 +1,470 @@ +################################################################################ +##################### Public/Private Class Definitions ######################### + +#!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Public Class !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!# +#' Class LOH +#' +#' An S4 class for the lohSpec plot object +#' @name lohSpec-class +#' @rdname lohSpec-class +#' @slot lohFreq_plot gtable object for the lohFreq plot +#' @slot lohSpec_plot gtable object for the lohSpec plot +#' @slot lohData data.table object soring loh data with column names: sample, +#' chromosome, position, t_vaf, n_vaf. +#' @exportClass lohSpec +#' @importFrom data.table data.table +#' @importFrom gtable gtable +#' @importFrom GenVisR multi_cytobandRet +#' @importFrom GenVisR multi_chrBound +#' @importFrom GenVisR cytoGeno +#' @import methods +methods::setOldClass("gtable") +setClass( + Class="lohSpec", + representation=representation(lohFreq_plot="gtable", + lohSpec_plot="gtable", + lohData="data.table"), + validity = function(object) { + + } +) + +#' Constructor for the lohSpec class +#' +#' @name lohSpec +#' @rdname lohSpec-class +#' @param input Object of class VarScan. +#' @param Character vector specifying the chromosomes of interest. If NULL, +#' will use autosomes for human (chr1-22). +#' @param samples Character vector specifying samples to plot. If not NULL +#' all samples in "input" not specified with this parameter are removed. +#' @param boundaries Object of class data frame with rows representing chromosome +#' boundaries for a genome assembly. The data frame must contain columns with +#' the following names "chromosome", "start", "end". If let null, will determine +#' chr boundaries using preloaded/specified genome. +#' @param genome Character string specifying a valid UCSC genome (see details). +#' @param gender Character vector of length equal to the number of samples, +#' consisting of elements from the set {"M", "F"}. Used to suppress the plotting +#' of allosomes where appropriate. +#' @param step Integer value specifying the step size (i.e. the number of base +#' pairs to move the window). required when method is set to slide +#' (see details). +#' @param window_size Integer value specifying the size of the window in base +#' pairs in which to calculate the mean Loss of Heterozygosity (see details). +#' @param normal Numeric value within the range 0-1 specifying the expected +#' normal variant allele frequency to be used in Loss of Heterozygosity +#' calculations. defaults to .50\% + +path <- "~/Google Drive/varscan.example.tsv" +varscanObject <- VarScanFormat(path = path) +input <- varscanObject +lohSpec <- function(input, chr=NULL, samples=NULL, y=NULL, genome='hg19', + gender=NULL, step=1000000, window_size=2500000, + normal=.50, gradient_midpoint=.2, gradient_low="#ffffff", + gradient_mid="#b2b2ff", gradient_high="#000000", + theme_layer=NULL, verbose){ + ## Calculate all data for plots + loh_data <- lohData(input, chr=chr, samples=samples, y=y, genome=genome, + step=step, window_size=window_size, + normal=normal, verbose) + + ## Use the lohData to generate lohSpec plots + lohSpec_plot <- lohSpec_buildMainPlot(object=loh_data) + + +} +#!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Private Classes !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!# + +#' Private Class lohData +#' +#' An S4 class for the Data of the loh plot object +#' @name lohData-class +#' @name lohData-class +setClass("lohData", + representation=representation(primaryData="data.table", + windowData="data.table", + windowCalcData="data.table", + chrData="data.table"), + validity = function(object){ + + } + ) + +#' Constructor for the lohData class. +#' +#' @name lohData +#' @rdname lohData-class +#' @param object Object of class VarScan +lohData <- function(object, chr, samples, y, genome, step, window_size, + normal, verbose) { + ## Get the primary loh data + primaryData <- getLohData(object=object, chr=chr, verbose = verbose) + + ## Quality check on the primary data + primaryData <- lohSpec_qual(object=primaryData) + + ## Get the chromosome data + if(is.null(y)) { + y <- data.table() + } + ## Check that y is a data.table + if (!is.data.table(y)) { + message("y is not a data.table, attempting to coerce") + y <- data.table(y) + } + chrData <- getChrBoundaries(object=y, genome=genome) + + ## Produce data.table with window position data + window_data <- getLohSlidingWindow(object = primaryData, step = step, + window_size = window_size) + + ## Perform loh calculations on each chromosome and sample within each window + loh_abs_diff <- getLohCalculation(object=primaryData, + window_data=window_data, normal=normal) + + ## Calculate avg loh for overlapping regions + loh_abs_diff_overlap <- rbindlist(getLohStepCalculation(object=loh_abs_diff, step=step)) + + ## Initialize the object + new("lohData", primaryData=primaryData, windowData=rbindlist(window_data), + windowCalcData=loh_abs_diff_overlap, chrData=chrData) +} + + +################################################################################ +###################### Accessor function definitions ########################### + +######################################################### +##### Function to perform quality check on loh data ##### +#' @rdname lohSpec_qual-methods +#' @param object of class lohData +#' @aliases lohSpec_qual +#' @return Data.table with quality check +setMethod(f="lohSpec_qual", + signature="data.table", + definition=function(object){ + primaryData <- object + ## Check that values supplied in vaf columns are in the expected range + if (any(primaryData$tumor_var_freq>1 | primaryData$normal_var_freq>1)) { + stop("Detected values in either the normal or tumor variant ", + "allele fraction columns above 1. Values supplied should ", + "be a proportion between 0-1!") + } + if (any(primaryData$normal_var_freq<0.4 | primaryData$normal_var_freq>0.6)){ + message("Detected values with a variant allele fraction either ", + "above .6 or below .4 in the normal. Please ensure ", + "variants supplied are heterozygous in the normal!") + message("Removing coordinates with normal VAF > 0.6 or < 0.4") + primaryData <- primaryData[normal_var_freq<=0.6 & + normal_var_freq>=0.4] + } + + ## Check the chromosome column - see if it has "chr" as the prefix + if(!all(grepl("^chr", primaryData$chrom))) { + memo <- paste0("Did not detect the prefix chr in the chromosome column", + " of x... adding prefix") + message(memo) + primaryData$chrom <- paste0("chr", primaryData$chrom) + } else if (all(grepl("^chr", primaryData$chrom))) { + message(paste0("detected chr in the chromosome column of x...", + "proceeding")) + } else { + stop("Detected unknown or mixed prefixes in the chromosome", + " column of x... should either be chr or none i.e. ", + "chr1 or 1") + } + + ## Change column names + colnames(primaryData) <- c("chromosome", "position", "t_vaf", + "n_vaf", "sample") + return(primaryData) + }) + +##### FIX THIS TO USE DATA.TABLES ##### +##################################################### +##### Function to get the chromosome boundaries ##### +#' @rdname getChrBoundaries-methods +#' @param object of class lohData +#' @param genome character specifying which genome to use +#' @return Data.table with chr and start/stop positions +#' @aliases getChrBoundaries +setMethod(f="getChrBoundaries", + signature="data.table", + definition=function(object, genome){ + ## Preloaded genome options + preloaded <- c('hg38', 'hg19', 'mm10', 'mm9', 'rn5') + if (nrow(object) == 0 ) { + ## Check that genome specified is not the ensembl name + if(!any(genome == preloaded)) + { + if(grepl("NCBI|GRC|RGSC|BROAD|BAYLOR|WUGSC", + genome, ignore.case=TRUE)) + { + memo <- paste0("Detected a genome that does not appear to be,", + "in UCSC terms, please specify a genome in UCSC", + " terms to attempt query to UCSC mySQL databae.", + "Alternativly supply a value to y.") + warning(memo) + } + message("attempting to query UCSC sql database for chromosome + positions") + cyto_data <- suppressWarnings(multi_cytobandRet(genome)) + chr_pos <- multi_chrBound(cyto_data) + } + if (any(genome == preloaded)) { + message("genome specified is preloaded, retrieving data...") + chr_pos <- GenVisR::cytoGeno[GenVisR::cytoGeno$genome == genome,] + chr_pos <- multi_chrBound(chr_pos) + } + } + if (nrow(object) != 0){ + if(!all(c('chromosome', 'start', 'end') %in% colnames(y))) + { + memo <- paste0("Did not detect correct column names in y, missing", + "one of \"chromosome\", \"start\", \"end\"") + stop(memo) + } + # Ensure that columns in data frame are of proper type + object$chromosome <- as.character(object$chromosome) + object$start <- as.integer(as.character(object$start)) + object$end <- as.integer(as.character(object$end)) + message("detected input to y, using supplied positions for chromosome + boundaries") + chr_pos <- object + } + + # Quality check for dummy data + if(nrow(chr_pos) < 1) + { + memo <- paste0("Could not retrieve chromosome boundaries from", + " UCSC, please specify this information via ", + "the y paramter") + stop(memo) + } + return(data.table(chr_pos)) + }) + +########################################################################## +##### Function to generate window position data for loh calculations ##### +#' @rdname getLohSlidingWindow-methods +#' @param object of class lohData +#' @param step integer specifying the step size between the start position of +#' each window +#' @param window_size integer specifying the window size for loh calcuations +#' @return Data.table with window start/stop positions +#' @aliases getLohSlidingWindow +setMethod(f="getLohSlidingWindow", + signature="data.table", + definition=function(object, step, window_size, ...){ + object <- primaryData + ## Obtain lists for each sample and chromosome + out <- split(object, list(as.character(object$chromosome), + as.character(object$sample))) + + ## Obtain the window position values + window <- lapply(out, function(x, step, window_size) { + ## Get the min and max position on the chromosome + min <- integer() + max <- integer() + window_stop_1 <- integer() + window_num <- integer() + min <- as.integer(min(as.numeric(as.character(x$position)))) + max <- as.integer(max(as.numeric(as.character(x$position)))) + ## Get the end of the first window position + window_stop_1 <- min+window_size + ## Calculate the number of windows necessary + num <- as.integer((max-min)/step) + num <- as.vector(1:num) + window_data_start <- vector() + window_data_stop <- vector() + + ## Calculate exact window positions + window_data <- lapply(num, function(x){ + window_data_start[x] <- as.integer(min+(step*(x-1))) + window_data_stop[x] <- as.integer(window_stop_1+(step*(x-1))) + window_data <- data.table(cbind(window_data_start[x], window_data_stop[x])) + return(window_data) + }) + window_data <- rbindlist(window_data) + # Get window positions whose values are below max & set max as the + # final window position (end of the chromosome) + colnames(window_data) <- c("window_start", "window_stop") + window_final <- window_data[window_data$window_stop <= max,] + window_final[nrow(window_final), 2] <- max + ## Put in the chromosome + window_final$chromosome <- as.character(x$chromosome[1]) + return(window_final) + }, + step = step, window_size = window_size) + + return(window) + }) + +############################################################### +##### Function to perform loh calcluations in each window ##### +#' @rdname getLohCalculation-methods +#' @param object of class lohData +#' @param window_data of class data.table +#' @param normal integer specifying normal vaf +#' @aliases getLohCalculation +setMethod(f="getLohCalculation", + signature="data.table", + definition=function(object, window_data, normal, ...) { + object <- split(object, list(as.character(object$chromosome), + as.character(object$sample))) + window_data <- window_data + ## Separate out sample and window data by chromosome name + df <- lapply(object, function(sample_data, window, + normal) { + chromosome <- as.character(sample_data[1,1]) + sample <- as.character(sample_data[1,5]) + chromosome.sample <- paste(chromosome, sample, sep = ".") + window <- window_data[[grep(chromosome.sample, names(window_data))]] + ## For each window position, get the vaf data that falls + ## within that window + dataset <- rbindlist(apply(window, 1, function(x, + sample_data, normal){ + if (x[3] != as.character(sample_data[1,1])) { + stop("Chromosomes in window and sample vaf data do not match") + } + w_start <- as.numeric(as.character(x[1])) + w_stop <- as.numeric(as.character(x[2])) + ## Filter out vaf data outside the window + filtered_data <- sample_data[position >= w_start & + position <= w_stop] + + ## Peroform loh calclulation to obtain avg loh in the + ## window's frame + loh_calc_avg <- mean(abs(as.numeric(as.character( + filtered_data$t_vaf)) - normal)) + if (is.na(loh_calc_avg)) { + loh_calc_avg <- NA + w_start <- NA + w_stop <- NA + } + filtered_data$loh_diff_avg <- loh_calc_avg + filtered_data$window_start <- w_start + filtered_data$window_stop <- w_stop + return(filtered_data) + }, + sample_data=sample_data, normal=normal)) + dataset <- na.omit(dataset, cols = c("loh_diff_avg", + "window_start", + "window_stop")) + return(dataset) + }, window=window_data, normal=normal) + return(df) + }) + +####################################################################### +##### Function to perform loh calcluations in overlapping windows ##### +#' @rdname getLohStepCalculation-methods +#' @param object of class lohData +#' @param step integer +#' @aliases getLohStepCalculation +setMethod(f = "getLohStepCalculation", + signature="list", + definition=function(object, step, ...) { + object <- loh_abs_diff + step_loh_calc <- lapply(object, function(x, step) { + ## Get the sample and chromosome information + sample <- unique(x$sample) + chromosome <- unique(x$chromosome) + + ## Obtain boundaries for each step-sized window + start <- unique(x$window_start) + stop <- c(start[-1], max(x$window_stop)) + step_boundaries <- data.table(chromosome=chromosome, start=start, stop=stop) + step_boundaries$sample <- sample + + ## Get the average loh within each step-sized window + loh_step_avg <- apply(step_boundaries, 1, function(x, loh_df_data) { + start <- as.numeric(as.character(x[2])) + stop <- as.numeric(as.character(x[3])) + step_df <- loh_df_data[position >= start & + position < stop] + if (nrow(step_df) == 0) { + loh_step_avg <- 0 + } + if (nrow(step_df) > 0) { + loh_step_avg <- mean(step_df$loh_diff_avg) + } + return(loh_step_avg) + }, loh_df_data=loh_df) + step_boundaries$loh_step_avg <- loh_step_avg + return(step_boundaries) + }, step=step) + return(step_loh_calc) + }) + +####################################################################### +##### Function to perform loh calcluations in overlapping windows ##### +#' @rdname lohSpec_buildMainPlot-methods +#' @param object of class lohData +#' @param step integer +#' @aliases lohSpec_buildMainPlot +setMethod(f = "lohSpec_buildMainPlot", + signature="lohData", + definition=function(object, ...) { + object=loh_data + x <- object@windowCalcData + x <- x[loh_step_avg > 0] + + ## Set the order of the chromosomes + chr <- gtools::mixedsort((unique(x$chromosome))) + sample <- gtools:mixedsort((unique(x$sample))) + x$chromosome <- factor(x$chromosome, levels=chr, labels=chr) + x$sample <- factor(x$sample, levels=sample, labels=sample) + + dummyData <- object@chrData + # define dummy data which will be chromosome boundaries, these are plotted + # but are transparent and will not appear in the plot + dummy_data <- geom_rect(data=dummyData, aes_string(xmin='start', xmax='end', + ymin=-1, ymax=1),alpha=0) + + # Define the main plot + data <- geom_rect(data=x, aes_string(xmin='start', + xmax='stop', + ymin=-1, + ymax=1, fill='loh_step_avg')) + + # Define additional plot parameters + facet <- facet_grid(sample ~ chromosome, scales="free", space="free") + + x_scale <- scale_x_continuous(expand = c(0, 0)) + y_scale <- scale_y_continuous(expand = c(0,0)) + + lab_x <- xlab("Chromosome") + lab_y <- ylab("Sample") + + # Define plot aesthetics + BWscheme <- theme_bw() + plotTheme <- theme(axis.ticks.x=element_blank(), + axis.text.x=element_blank(), + axis.ticks.y=element_blank(), + axis.text.y=element_blank(), + panel.grid.major=element_blank(), + panel.grid.minor=element_blank()) + + # plot an additional layer if specified + if(!is.null(plotLayer)) + { + plotLayer <- plotLayer + } else { + plotLayer <- geom_blank() + } + + LOHgradient <- scale_fill_gradient2(midpoint = gradient_midpoint, + guide="colourbar", + high=gradient_high, + mid=gradient_mid, + low=gradient_low, + space='Lab') + + # Build the plot + tmp <- data.frame(x=0, y=0) + p1 <- ggplot(data=tmp, aes(y=0)) + dummy_data + data + facet + x_scale + y_scale + + lab_x + lab_y + BWscheme + LOHgradient + plotTheme + plotLayer + return(p1) + }) + diff --git a/R/lohSpec-methods.R b/R/lohSpec-methods.R new file mode 100644 index 0000000..f713759 --- /dev/null +++ b/R/lohSpec-methods.R @@ -0,0 +1,16 @@ +#' Method toLOH +#' +#' @name toLOH +#' @rdname toLOH-methods +#' @param ... additional arguments to passed +#' @noRd +setGeneric( + name="toLOH", + def=function(object, verbose, ...){standardGeneric("toLOH")} +) + +#' @rdname toLOH-methods +#' @aliases toLOH +#' @noRd +setMethod(f="toLOH", + signature="") \ No newline at end of file diff --git a/R/multi_chrBound.R b/R/multi_chrBound.R index d097a36..003844b 100644 --- a/R/multi_chrBound.R +++ b/R/multi_chrBound.R @@ -21,7 +21,7 @@ multi_chrBound <- function(x) data <- x[,c('chrom' ,'chromStart' , 'chromEnd')] # Obtain max for each chromosome - maxChrom <- stats::aggregate(chromEnd ~ chrom, data=data, max) + maxChrom <- aggregate(chromEnd ~ chrom, data=data, max) maxChrom <- cbind(maxChrom, maxChrom[,2]) colnames(maxChrom) <- c('chromosome', 'start', 'end') From 60c795798ce02453d755021625635040b60548bf Mon Sep 17 00:00:00 2001 From: Jason Kunisaki Date: Fri, 27 Oct 2017 16:15:08 -0500 Subject: [PATCH 02/21] lohSpec functions --- R/VarScanFormat-class.R | 10 ++++------ R/Waterfall-class.R | 1 + R/lohSpec-class.R | 11 ++++++----- 3 files changed, 11 insertions(+), 11 deletions(-) diff --git a/R/VarScanFormat-class.R b/R/VarScanFormat-class.R index 737af06..830766e 100644 --- a/R/VarScanFormat-class.R +++ b/R/VarScanFormat-class.R @@ -16,7 +16,7 @@ setClass("VarScanFormat", representation=representation(path="character"), contains="VarScanFormat_Virtual", validity = function(object) { - head(object) + head(object@varscan) ## Expected varscan column names cnames <- c("chrom", "position", "ref", "var", "normal_reads1", "normal_reads2", "normal_var_freq", @@ -28,7 +28,7 @@ setClass("VarScanFormat", "normal_reads2_plus", "normal_reads2_minus", "sample") ## Check the column names to see if there is the appropriate input - varscan_column_names <- colnames(object@varscanData) + varscan_column_names <- colnames(object@varscan) num <- which(!varscan_column_names%in%cnames) if (length(num) > 0 & length(varscan_column_names) == length(cnames)) { stop("Column names of varscan input are not what is expected. Please @@ -57,10 +57,8 @@ setClass("VarScanFormat", #' @importFrom data.table fread #' @export VarScanFormat <- function(path, verbose=FALSE) { - browser() ## Read in VarScan data - varscanData <- suppressWarnings(data.table::fread(input=path, - stringsAsFactors=FALSE, + varscanData <- suppressWarnings(fread(input=path, stringsAsFactors=FALSE, verbose=verbose)) ## Put in sample name for now varscanData$sample <- "HCC1395" @@ -68,7 +66,7 @@ VarScanFormat <- function(path, verbose=FALSE) { sample <- varscanData[,which(colnames(varscanData)=="sample"), with=FALSE] ## Create the varscan object - varscanObject <- new("VarScanFormat", path=path, varscan=varscanData, sample=sample) + varscanObject <- new(Class="VarScanFormat", path=path, varscan=varscanData, sample=sample) return(varscanObject) } diff --git a/R/Waterfall-class.R b/R/Waterfall-class.R index a62ad6f..9236a0c 100644 --- a/R/Waterfall-class.R +++ b/R/Waterfall-class.R @@ -113,6 +113,7 @@ Waterfall <- function(input, labelColumn=NULL, samples=NULL, coverage=NULL, gridOverlay=FALSE, drop=TRUE, labelSize=5, labelAngle=0, sampleNames=TRUE, clinical=NULL, sectionHeights=NULL, sectionWidths=NULL, verbose=FALSE, plotCLayers=NULL){ + browser() # calculate all data for plots data <- WaterfallData(input, labelColumn=labelColumn, mutationHierarchy=mutationHierarchy, diff --git a/R/lohSpec-class.R b/R/lohSpec-class.R index 29188c6..2d996ba 100644 --- a/R/lohSpec-class.R +++ b/R/lohSpec-class.R @@ -69,7 +69,7 @@ lohSpec <- function(input, chr=NULL, samples=NULL, y=NULL, genome='hg19', normal=normal, verbose) ## Use the lohData to generate lohSpec plots - lohSpec_plot <- lohSpec_buildMainPlot(object=loh_data) + lohSpec_plot <- lohSpec_buildMainPlot(object=loh_data, plotLayer=NULL) } @@ -378,6 +378,7 @@ setMethod(f = "getLohStepCalculation", step_boundaries$sample <- sample ## Get the average loh within each step-sized window + loh_df <- x loh_step_avg <- apply(step_boundaries, 1, function(x, loh_df_data) { start <- as.numeric(as.character(x[2])) stop <- as.numeric(as.character(x[3])) @@ -406,14 +407,13 @@ setMethod(f = "getLohStepCalculation", setMethod(f = "lohSpec_buildMainPlot", signature="lohData", definition=function(object, ...) { - object=loh_data x <- object@windowCalcData x <- x[loh_step_avg > 0] ## Set the order of the chromosomes chr <- gtools::mixedsort((unique(x$chromosome))) - sample <- gtools:mixedsort((unique(x$sample))) - x$chromosome <- factor(x$chromosome, levels=chr, labels=chr) + sample <- gtools::mixedsort((unique(x$sample))) + x$chromosome_f <- factor(x$chromosome, levels=chr) x$sample <- factor(x$sample, levels=sample, labels=sample) dummyData <- object@chrData @@ -429,7 +429,7 @@ setMethod(f = "lohSpec_buildMainPlot", ymax=1, fill='loh_step_avg')) # Define additional plot parameters - facet <- facet_grid(sample ~ chromosome, scales="free", space="free") + facet <- facet_grid(sample ~ chromosome_f, scales="free", space="free") x_scale <- scale_x_continuous(expand = c(0, 0)) y_scale <- scale_y_continuous(expand = c(0,0)) @@ -465,6 +465,7 @@ setMethod(f = "lohSpec_buildMainPlot", tmp <- data.frame(x=0, y=0) p1 <- ggplot(data=tmp, aes(y=0)) + dummy_data + data + facet + x_scale + y_scale + lab_x + lab_y + BWscheme + LOHgradient + plotTheme + plotLayer + print(p1) return(p1) }) From 5b6a7b24a3c8f720877a8c9438c2e169d354c4bb Mon Sep 17 00:00:00 2001 From: Jason Kunisaki Date: Wed, 20 Dec 2017 10:39:11 -0600 Subject: [PATCH 03/21] lohspec 12/19 --- DESCRIPTION | 4 ++ NAMESPACE | 7 ++++ R/AllGenerics.R | 1 - R/MutationAnnotationFormat-class.R | 1 - R/VarScanFormat-class.R | 12 ++++++ R/VarScanFormat_Virtual-class.R | 1 + R/lohSpec-class.R | 14 +++---- R/lohSpec-methods.R | 16 -------- man/VarScanFormat-class.Rd | 30 ++++++++++++++ man/VarScanFormat_Virtual-class.Rd | 17 ++++++++ man/getChrBoundaries-methods.Rd | 28 +++++++++++++ man/getLohCalculation-methods.Rd | 27 +++++++++++++ man/getLohData-methods.Rd | 16 ++++++++ man/getLohSlidingWindow-methods.Rd | 31 +++++++++++++++ man/getLohStepCalculation-methods.Rd | 25 ++++++++++++ man/getSample-methods.Rd | 7 +++- man/getVarScan-methods.Rd | 21 ++++++++++ man/lohData-class.Rd | 18 +++++++++ man/lohSpec-class.Rd | 59 ++++++++++++++++++++++++++++ man/lohSpec_buildMainPlot-methods.Rd | 25 ++++++++++++ man/lohSpec_qual-methods.Rd | 26 ++++++++++++ 21 files changed, 360 insertions(+), 26 deletions(-) delete mode 100644 R/lohSpec-methods.R create mode 100644 man/VarScanFormat-class.Rd create mode 100644 man/VarScanFormat_Virtual-class.Rd create mode 100644 man/getChrBoundaries-methods.Rd create mode 100644 man/getLohCalculation-methods.Rd create mode 100644 man/getLohData-methods.Rd create mode 100644 man/getLohSlidingWindow-methods.Rd create mode 100644 man/getLohStepCalculation-methods.Rd create mode 100644 man/getVarScan-methods.Rd create mode 100644 man/lohData-class.Rd create mode 100644 man/lohSpec-class.Rd create mode 100644 man/lohSpec_buildMainPlot-methods.Rd create mode 100644 man/lohSpec_qual-methods.Rd diff --git a/DESCRIPTION b/DESCRIPTION index 5374d20..47854f5 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -47,6 +47,8 @@ Collate: 'VEP_Virtual-class.R' 'VEP-class.R' 'VEP_v88-class.R' + 'VarScanFormat_Virtual-class.R' + 'VarScanFormat-class.R' 'Waterfall-class.R' 'cnFreq.R' 'cnFreq_buildMain.R' @@ -95,6 +97,8 @@ Collate: 'ideoView_buildMain.R' 'ideoView_formatCytobands.R' 'ideoView_qual.R' + 'lohSpec-class.R' + 'lohSpec-methods.R' 'lohSpec.R' 'lohSpec_buildMain.R' 'lohSpec_fileGlob.R' diff --git a/NAMESPACE b/NAMESPACE index b476a3c..dfc3c70 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -6,6 +6,7 @@ export(MutSpectra) export(MutationAnnotationFormat) export(TvTi) export(VEP) +export(VarScanFormat) export(Waterfall) export(cnFreq) export(cnSpec) @@ -24,17 +25,23 @@ exportClasses(GMS) exportClasses(MutSpectra) exportClasses(MutationAnnotationFormat) exportClasses(VEP) +exportClasses(VarScanFormat) exportClasses(Waterfall) +exportClasses(lohSpec) exportMethods(drawPlot) +exportMethods(getChrBoundaries) exportMethods(getData) exportMethods(getDescription) exportMethods(getGrob) exportMethods(getHeader) +exportMethods(getLohData) +exportMethods(getLohSlidingWindow) exportMethods(getMeta) exportMethods(getMutation) exportMethods(getPath) exportMethods(getPosition) exportMethods(getSample) +exportMethods(getVarScan) exportMethods(getVersion) exportMethods(writeData) import(data.table) diff --git a/R/AllGenerics.R b/R/AllGenerics.R index 8b3e6e0..f005eaa 100644 --- a/R/AllGenerics.R +++ b/R/AllGenerics.R @@ -535,7 +535,6 @@ setGeneric( #' @rdname lohSpec_qual-methods #' @param object Object of class VarScanFormat #' @param ... additional arguments to passed -#' @exportMethod lohSpec_qual setGeneric( name="lohSpec_qual", def=function(object, ...){standardGeneric("lohSpec_qual")} diff --git a/R/MutationAnnotationFormat-class.R b/R/MutationAnnotationFormat-class.R index f289b8a..ab460ff 100644 --- a/R/MutationAnnotationFormat-class.R +++ b/R/MutationAnnotationFormat-class.R @@ -35,7 +35,6 @@ setClass("MutationAnnotationFormat", #' @importFrom data.table fread #' @export MutationAnnotationFormat <- function(path, version="auto", verbose=FALSE){ - browser() mafData <- suppressWarnings(data.table::fread(input=path, stringsAsFactors=TRUE, verbose=verbose)) diff --git a/R/VarScanFormat-class.R b/R/VarScanFormat-class.R index 830766e..d45adca 100644 --- a/R/VarScanFormat-class.R +++ b/R/VarScanFormat-class.R @@ -42,6 +42,17 @@ setClass("VarScanFormat", http://varscan.sourceforge.net/somatic-calling.html#somatic-output for appropriate columns and column names.") } + + ## Check to see if the VAF columns are percentages as opposed to proportions + tumor_false <- any(grepl("%", object@varscan$tumor_var_freq) == FALSE) + normal_false <- any(grepl("%", object@varscan$normal_var_freq) == FALSE) + if (tumor_false == TRUE | normal_false == TRUE) { + stop("Make sure the tumor/normal VAF column is in percentages and not proportion. + (i.e. 75.00% as opposed to 0.75)") + } + + ## Check to see if the VAF provided are somatic or not + return(TRUE) } ) @@ -64,6 +75,7 @@ VarScanFormat <- function(path, verbose=FALSE) { varscanData$sample <- "HCC1395" ## Get the sample names sample <- varscanData[,which(colnames(varscanData)=="sample"), with=FALSE] + length(colnames(varscanData)) ## Create the varscan object varscanObject <- new(Class="VarScanFormat", path=path, varscan=varscanData, sample=sample) diff --git a/R/VarScanFormat_Virtual-class.R b/R/VarScanFormat_Virtual-class.R index af5c6c4..77dc9bc 100644 --- a/R/VarScanFormat_Virtual-class.R +++ b/R/VarScanFormat_Virtual-class.R @@ -10,6 +10,7 @@ #' @slot sample data.table object holding sample data. #' @importClassesFrom data.table data.table #' @import methods +#' setClass( Class="VarScanFormat_Virtual", representation=representation(varscan="data.table", diff --git a/R/lohSpec-class.R b/R/lohSpec-class.R index 2d996ba..a018976 100644 --- a/R/lohSpec-class.R +++ b/R/lohSpec-class.R @@ -14,10 +14,6 @@ #' @exportClass lohSpec #' @importFrom data.table data.table #' @importFrom gtable gtable -#' @importFrom GenVisR multi_cytobandRet -#' @importFrom GenVisR multi_chrBound -#' @importFrom GenVisR cytoGeno -#' @import methods methods::setOldClass("gtable") setClass( Class="lohSpec", @@ -55,9 +51,7 @@ setClass( #' normal variant allele frequency to be used in Loss of Heterozygosity #' calculations. defaults to .50\% -path <- "~/Google Drive/varscan.example.tsv" -varscanObject <- VarScanFormat(path = path) -input <- varscanObject + lohSpec <- function(input, chr=NULL, samples=NULL, y=NULL, genome='hg19', gender=NULL, step=1000000, window_size=2500000, normal=.50, gradient_midpoint=.2, gradient_low="#ffffff", @@ -98,11 +92,17 @@ setClass("lohData", lohData <- function(object, chr, samples, y, genome, step, window_size, normal, verbose) { ## Get the primary loh data + object <- VarScanFormat(path = "~/Google Drive/HCC1395.varscan.tsv") primaryData <- getLohData(object=object, chr=chr, verbose = verbose) ## Quality check on the primary data + ## To-Do: Put the quality check in the validity check primaryData <- lohSpec_qual(object=primaryData) + library(BiocInstaller) + biocLite("BSgenome.Hsapiens.UCSC.hg19") + BSgenome <- getBSgenome(genome = "BSgenome.Hsapiens.UCSC.hg19") + ## Get the chromosome data if(is.null(y)) { y <- data.table() diff --git a/R/lohSpec-methods.R b/R/lohSpec-methods.R deleted file mode 100644 index f713759..0000000 --- a/R/lohSpec-methods.R +++ /dev/null @@ -1,16 +0,0 @@ -#' Method toLOH -#' -#' @name toLOH -#' @rdname toLOH-methods -#' @param ... additional arguments to passed -#' @noRd -setGeneric( - name="toLOH", - def=function(object, verbose, ...){standardGeneric("toLOH")} -) - -#' @rdname toLOH-methods -#' @aliases toLOH -#' @noRd -setMethod(f="toLOH", - signature="") \ No newline at end of file diff --git a/man/VarScanFormat-class.Rd b/man/VarScanFormat-class.Rd new file mode 100644 index 0000000..068a583 --- /dev/null +++ b/man/VarScanFormat-class.Rd @@ -0,0 +1,30 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/VarScanFormat-class.R +\docType{class} +\name{VarScanFormat-class} +\alias{VarScanFormat-class} +\alias{VarScanFormat} +\title{Class VarScanFormat} +\usage{ +VarScanFormat(path, verbose = FALSE) +} +\arguments{ +\item{path}{String specifying the path to a VarScan file.} + +\item{verbose}{Boolean specifying if progress should be reported while reading +in the VarScan. file.} +} +\description{ +An S4 class acting as a container for VarScanFormat. + +Constructor for the VarScanFormat container class. +} +\section{Slots}{ + +\describe{ +\item{\code{path}}{Character string specifying the path of the VarScan file read in.} +}} + +\seealso{ +\code{\link{lohSpec}} +} diff --git a/man/VarScanFormat_Virtual-class.Rd b/man/VarScanFormat_Virtual-class.Rd new file mode 100644 index 0000000..25337f0 --- /dev/null +++ b/man/VarScanFormat_Virtual-class.Rd @@ -0,0 +1,17 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/VarScanFormat_Virtual-class.R +\docType{class} +\name{VarScanFormat_Virtual-class} +\alias{VarScanFormat_Virtual-class} +\title{Class VarScanFormat_Virtual} +\description{ +An S4 class to act as a virtual class for MutationAnnotationFormat version sub-classes. +} +\section{Slots}{ + +\describe{ +\item{\code{varscan}}{data.table object holding varscan data.} + +\item{\code{sample}}{data.table object holding sample data.} +}} + diff --git a/man/getChrBoundaries-methods.Rd b/man/getChrBoundaries-methods.Rd new file mode 100644 index 0000000..173dde1 --- /dev/null +++ b/man/getChrBoundaries-methods.Rd @@ -0,0 +1,28 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R, R/lohSpec-class.R +\docType{methods} +\name{getChrBoundaries} +\alias{getChrBoundaries} +\alias{getChrBoundaries,data.table-method} +\alias{getChrBoundaries} +\title{Method getChrBoundaries} +\usage{ +getChrBoundaries(object, ...) + +\S4method{getChrBoundaries}{data.table}(object, genome) +} +\arguments{ +\item{object}{Object of class VarScanFormat} + +\item{...}{additional arguments to passed} + +\item{genome}{character specifying which genome to use} + +\item{object}{of class lohData} +} +\value{ +Data.table with chr and start/stop positions +} +\description{ +Method getChrBoundaries +} diff --git a/man/getLohCalculation-methods.Rd b/man/getLohCalculation-methods.Rd new file mode 100644 index 0000000..61a1237 --- /dev/null +++ b/man/getLohCalculation-methods.Rd @@ -0,0 +1,27 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R, R/lohSpec-class.R +\docType{methods} +\name{getLohCalculation} +\alias{getLohCalculation} +\alias{getLohCalculation,data.table-method} +\alias{getLohCalculation} +\title{Method getLohCalculation} +\usage{ +getLohCalculation(object, ...) + +\S4method{getLohCalculation}{data.table}(object, window_data, normal, ...) +} +\arguments{ +\item{object}{Object of class VarScanFormat} + +\item{...}{additional arguments to passed} + +\item{window_data}{of class data.table} + +\item{normal}{integer specifying normal vaf} + +\item{object}{of class lohData} +} +\description{ +Method getLohCalculation +} diff --git a/man/getLohData-methods.Rd b/man/getLohData-methods.Rd new file mode 100644 index 0000000..1e096b2 --- /dev/null +++ b/man/getLohData-methods.Rd @@ -0,0 +1,16 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\name{getLohData} +\alias{getLohData} +\title{Method getLohData} +\usage{ +getLohData(object, ...) +} +\arguments{ +\item{object}{Object of class VarScanFormat} + +\item{...}{additional arguments to passed} +} +\description{ +Method getLohData +} diff --git a/man/getLohSlidingWindow-methods.Rd b/man/getLohSlidingWindow-methods.Rd new file mode 100644 index 0000000..b21b1f4 --- /dev/null +++ b/man/getLohSlidingWindow-methods.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R, R/lohSpec-class.R +\docType{methods} +\name{getLohSlidingWindow} +\alias{getLohSlidingWindow} +\alias{getLohSlidingWindow,data.table-method} +\alias{getLohSlidingWindow} +\title{Method getLohSlidingWindow} +\usage{ +getLohSlidingWindow(object, ...) + +\S4method{getLohSlidingWindow}{data.table}(object, step, window_size, ...) +} +\arguments{ +\item{object}{Object of class VarScanFormat} + +\item{...}{additional arguments to passed} + +\item{step}{integer specifying the step size between the start position of +each window} + +\item{window_size}{integer specifying the window size for loh calcuations} + +\item{object}{of class lohData} +} +\value{ +Data.table with window start/stop positions +} +\description{ +Method getLohSlidingWindow +} diff --git a/man/getLohStepCalculation-methods.Rd b/man/getLohStepCalculation-methods.Rd new file mode 100644 index 0000000..c209efe --- /dev/null +++ b/man/getLohStepCalculation-methods.Rd @@ -0,0 +1,25 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R, R/lohSpec-class.R +\docType{methods} +\name{getLohStepCalculation} +\alias{getLohStepCalculation} +\alias{getLohStepCalculation,list-method} +\alias{getLohStepCalculation} +\title{Method getLohStepCalculation} +\usage{ +getLohStepCalculation(object, ...) + +\S4method{getLohStepCalculation}{list}(object, step, ...) +} +\arguments{ +\item{object}{Object of class VarScanFormat} + +\item{...}{additional arguments to passed} + +\item{step}{integer} + +\item{object}{of class lohData} +} +\description{ +Method getLohStepCalculation +} diff --git a/man/getSample-methods.Rd b/man/getSample-methods.Rd index 81165b6..4593530 100644 --- a/man/getSample-methods.Rd +++ b/man/getSample-methods.Rd @@ -1,7 +1,8 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/AllGenerics.R, R/GMS_Virtual-class.R, % R/GMS-class.R, R/MutationAnnotationFormat_Virtual-class.R, -% R/MutationAnnotationFormat-class.R, R/VEP_Virtual-class.R, R/VEP-class.R +% R/MutationAnnotationFormat-class.R, R/VEP_Virtual-class.R, R/VEP-class.R, +% R/VarScanFormat_Virtual-class.R \docType{methods} \name{getSample} \alias{getSample} @@ -17,6 +18,8 @@ \alias{getSample} \alias{getSample,VEP-method} \alias{getSample} +\alias{getSample,VarScanFormat_Virtual-method} +\alias{getSample} \title{Method getSample} \usage{ getSample(object, ...) @@ -32,6 +35,8 @@ getSample(object, ...) \S4method{getSample}{VEP_Virtual}(object, ...) \S4method{getSample}{VEP}(object, ...) + +\S4method{getSample}{VarScanFormat_Virtual}(object, ...) } \arguments{ \item{object}{Object of class VEP, GMS, or MutationAnnotationFormat} diff --git a/man/getVarScan-methods.Rd b/man/getVarScan-methods.Rd new file mode 100644 index 0000000..d8788bb --- /dev/null +++ b/man/getVarScan-methods.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R, R/VarScanFormat_Virtual-class.R +\docType{methods} +\name{getVarScan} +\alias{getVarScan} +\alias{getVarScan,VarScanFormat_Virtual-method} +\alias{getVarScan} +\title{Method getVarScan} +\usage{ +getVarScan(object, ...) + +\S4method{getVarScan}{VarScanFormat_Virtual}(object, ...) +} +\arguments{ +\item{object}{Object of class VarScanFormat} + +\item{...}{additional arguments to passed} +} +\description{ +Method getVarScan +} diff --git a/man/lohData-class.Rd b/man/lohData-class.Rd new file mode 100644 index 0000000..6d6a06e --- /dev/null +++ b/man/lohData-class.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/lohSpec-class.R +\docType{class} +\name{lohData-class} +\alias{lohData-class} +\alias{lohData} +\title{Private Class lohData} +\usage{ +lohData(object, chr, samples, y, genome, step, window_size, normal, verbose) +} +\arguments{ +\item{object}{Object of class VarScan} +} +\description{ +An S4 class for the Data of the loh plot object + +Constructor for the lohData class. +} diff --git a/man/lohSpec-class.Rd b/man/lohSpec-class.Rd new file mode 100644 index 0000000..8464288 --- /dev/null +++ b/man/lohSpec-class.Rd @@ -0,0 +1,59 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/lohSpec-class.R +\name{lohSpec-class} +\alias{lohSpec-class} +\alias{lohSpec} +\title{Class LOH} +\usage{ +lohSpec(x = NULL, path = NULL, fileExt = NULL, y = NULL, + genome = "hg19", gender = NULL, step = 1e+06, window_size = 2500000, + normal = 0.5, colourScheme = "inferno", plotLayer = NULL, + method = "slide", out = "plot") +} +\arguments{ +\item{genome}{Character string specifying a valid UCSC genome (see details).} + +\item{gender}{Character vector of length equal to the number of samples, +consisting of elements from the set {"M", "F"}. Used to suppress the plotting +of allosomes where appropriate.} + +\item{step}{Integer value specifying the step size (i.e. the number of base +pairs to move the window). required when method is set to slide +(see details).} + +\item{window_size}{Integer value specifying the size of the window in base +pairs in which to calculate the mean Loss of Heterozygosity (see details).} + +\item{normal}{Numeric value within the range 0-1 specifying the expected +normal variant allele frequency to be used in Loss of Heterozygosity +calculations. defaults to .50\%} + +\item{input}{Object of class VarScan.} + +\item{Character}{vector specifying the chromosomes of interest. If NULL, +will use autosomes for human (chr1-22).} + +\item{samples}{Character vector specifying samples to plot. If not NULL +all samples in "input" not specified with this parameter are removed.} + +\item{boundaries}{Object of class data frame with rows representing chromosome +boundaries for a genome assembly. The data frame must contain columns with +the following names "chromosome", "start", "end". If let null, will determine +chr boundaries using preloaded/specified genome.} +} +\description{ +An S4 class for the lohSpec plot object + +Constructor for the lohSpec class +} +\section{Slots}{ + +\describe{ +\item{\code{lohFreq_plot}}{gtable object for the lohFreq plot} + +\item{\code{lohSpec_plot}}{gtable object for the lohSpec plot} + +\item{\code{lohData}}{data.table object soring loh data with column names: sample, +chromosome, position, t_vaf, n_vaf.} +}} + diff --git a/man/lohSpec_buildMainPlot-methods.Rd b/man/lohSpec_buildMainPlot-methods.Rd new file mode 100644 index 0000000..d08a8c0 --- /dev/null +++ b/man/lohSpec_buildMainPlot-methods.Rd @@ -0,0 +1,25 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R, R/lohSpec-class.R +\docType{methods} +\name{lohSpec_buildMainPlot} +\alias{lohSpec_buildMainPlot} +\alias{lohSpec_buildMainPlot,lohData-method} +\alias{lohSpec_buildMainPlot} +\title{Method lohSpec_buildMainPlot} +\usage{ +lohSpec_buildMainPlot(object, ...) + +\S4method{lohSpec_buildMainPlot}{lohData}(object, ...) +} +\arguments{ +\item{object}{Object of class VarScanFormat} + +\item{...}{additional arguments to passed} + +\item{object}{of class lohData} + +\item{step}{integer} +} +\description{ +Method lohSpec_buildMainPlot +} diff --git a/man/lohSpec_qual-methods.Rd b/man/lohSpec_qual-methods.Rd new file mode 100644 index 0000000..c9d7578 --- /dev/null +++ b/man/lohSpec_qual-methods.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R, R/lohSpec-class.R +\docType{data} +\name{lohSpec_qual} +\alias{lohSpec_qual} +\alias{lohSpec_qual,data.table-method} +\alias{lohSpec_qual} +\title{Method lohSpec_qual} +\format{An object of class \code{NULL} of length 0.} +\usage{ +\S4method{lohSpec_qual}{data.table}(object) +} +\arguments{ +\item{object}{Object of class VarScanFormat} + +\item{...}{additional arguments to passed} + +\item{object}{of class lohData} +} +\value{ +Data.table with quality check +} +\description{ +Method lohSpec_qual +} +\keyword{datasets} From 41977fd7ef0ea8b75fab3cb39c32a0999cc6cbcd Mon Sep 17 00:00:00 2001 From: Jason Kunisaki Date: Tue, 9 Jan 2018 17:07:59 -0600 Subject: [PATCH 04/21] loh --- .Rhistory[Conflict 1] | 512 +++++++++++++++++ .Rhistory[Conflict] | 512 +++++++++++++++++ DESCRIPTION | 1 - NAMESPACE | 3 +- R/AllGenerics.R | 79 ++- R/VarScanFormat-class.R | 82 +-- R/Waterfall-class.R | 3 +- R/lohSpec-class.R | 881 ++++++++++++++++++++++------- man/addBlankRegion-methods.Rd | 25 + man/annoGenomeCoord-methods.Rd | 16 + man/getChrBoundaries-methods.Rd | 28 - man/getLohCalculation-methods.Rd | 7 +- man/getLohSegmentation-methods.Rd | 33 ++ man/getLohSlidingWindow-methods.Rd | 4 +- man/lohData-class.Rd | 3 +- man/lohSpec-class.Rd | 28 +- man/lohSpec_qual-methods.Rd | 12 +- 17 files changed, 1921 insertions(+), 308 deletions(-) create mode 100644 .Rhistory[Conflict 1] create mode 100644 .Rhistory[Conflict] create mode 100644 man/addBlankRegion-methods.Rd create mode 100644 man/annoGenomeCoord-methods.Rd delete mode 100644 man/getChrBoundaries-methods.Rd create mode 100644 man/getLohSegmentation-methods.Rd diff --git a/.Rhistory[Conflict 1] b/.Rhistory[Conflict 1] new file mode 100644 index 0000000..aec433f --- /dev/null +++ b/.Rhistory[Conflict 1] @@ -0,0 +1,512 @@ +) +#' Method getLayers +#' +#' @name getLayers +#' @rdname getLayers-methods +#' @param object Object of class Clinical +#' @param ... additional arguments to passed +#' @noRd +setGeneric( +name="getLayers", +def=function(object, ...){standardGeneric("getLayers")} +) +#' Method arrangeWaterfallPlot +#' +#' @name arrangeWaterfallPlot +#' @rdname arrangeWaterfallPlot-methods +#' @param ... additional arguments to passed +#' @noRd +setGeneric( +name="arrangeWaterfallPlot", +def=function(object, ...){standardGeneric("arrangeWaterfallPlot")} +) +#' Method drawPlot +#' +#' @name drawPlot +#' @rdname drawPlot-methods +#' @param object Object of class Waterfall, MutSpectra, or Clinical +#' @param ... additional arguments to passed +#' @details The drawPlot method is used to draw plots created by GenVisR plot +#' constructor functions. +#' @exportMethod drawPlot +setGeneric( +name="drawPlot", +def=function(object, ...){standardGeneric("drawPlot")} +) +#' Method parseDescription +#' +#' @name parseDescription +#' @rdname parseDescription-methods +#' @param ... additional arguments to passed +#' @noRd +setGeneric( +name="parseDescription", +def=function(object, ...){standardGeneric("parseDescription")} +) +#' Method parseHeader +#' +#' @name parseHeader +#' @rdname parseHeader-methods +#' @param ... additional arguments to passed +#' @noRd +setGeneric( +name="parseHeader", +def=function(object, ...){standardGeneric("parseHeader")} +) +#' Method parseExtra +#' +#' @name parseExtra +#' @rdname parseExtra-methods +#' @param ... additional arguments to passed +#' @noRd +setGeneric( +name="parseExtra", +def=function(object, ...){standardGeneric("parseExtra")} +) +#' Method writeData +#' +#' @name writeData +#' @rdname writeData-methods +#' @param object Object of class VEP +#' @param file Character string specifying a file to send output to. +#' @param sep Delimiter used when writing output, defaults to tab. +#' @param ... additional arguments to passed +#' @details The writeData method is used to output data held in GenVisR objects +#' to a file. +#' @exportMethod writeData +setGeneric( +name="writeData", +def=function(object, ...){standardGeneric("writeData")} +) +#' Method geneFilter +#' +#' @name geneFilter +#' @rdname geneFilter-methods +#' @param ... additional arguments to passed +#' @noRd +setGeneric( +name="geneFilter", +def=function(object, ...){standardGeneric("geneFilter")} +) +#' Method toMutSpectra +#' +#' @name toMutSpectra +#' @rdname toMutSpectra +#' @param ... additional arguments to passed +#' @noRd +setGeneric( +name="toMutSpectra", +def=function(object, ...){standardGeneric("toMutSpectra")} +) +#' Method annoMutSpectra +#' +#' @name annoMutSpectra +#' @rdname annoMutSpectra +#' @param ... additional arguments to passed +#' @noRd +setGeneric( +name="annoMutSpectra", +def=function(object, ...){standardGeneric("annoMutSpectra")} +) +#' Method calcMutSpectra +#' +#' @name calcMutSpectra +#' @rdname calcMutSpectra +#' @param ... additional arguments to passed +#' @noRd +setGeneric( +name="calcMutSpectra", +def=function(object, ...){standardGeneric("calcMutSpectra")} +) +#' Method sortSamples +#' +#' @name sortSamples +#' @rdname sortSamples +#' @param ... additional arguments to passed +#' @noRd +setGeneric( +name="sortSamples", +def=function(object, ...){standardGeneric("sortSamples")} +) +#' Method buildFrequencyPlot +#' +#' @name buildFrequencyPlot +#' @rdname buildFrequencyPlot +#' @param ... additional arguments to passed +#' @noRd +setGeneric( +name="buildFrequencyPlot", +def=function(object, ...){standardGeneric("buildFrequencyPlot")} +) +#' Method buildProportionPlot +#' +#' @name buildProportionPlot +#' @rdname buildProportionPlot +#' @param ... additional arguments to passed +#' @noRd +setGeneric( +name="buildProportionPlot", +def=function(object, ...){standardGeneric("buildProportionPlot")} +) +#' Method arrangeMutSpectraPlot +#' +#' @name arrangeMutSpectraPlot +#' @rdname arrangeMutSpectraPlot +#' @param ... additional arguments to passed +#' @noRd +setGeneric( +name="arrangeMutSpectraPlot", +def=function(object, ...){standardGeneric("arrangeMutSpectraPlot")} +) +#' Method getGrob +#' +#' @name getGrob +#' @rdname getGrob-methods +#' @param object Object of clas MutSpectra +#' @param ... additional arguments to passed +#' @exportMethod getGrob +setGeneric( +name="getGrob", +def=function(object, ...){standardGeneric("getGrob")} +) +#' Method getDescription +#' +#' @name getDescription +#' @rdname getDescription-methods +#' @param object Object of class VEP +#' @param ... additional arguments to passed +#' @exportMethod getDescription +setGeneric( +name="getDescription", +def=function(object, ...){standardGeneric("getDescription")} +) +#' Method getHeader +#' +#' @name getHeader +#' @rdname getHeader-methods +#' @param object Object of class VEP +#' @param ... additional arguments to passed +#' @exportMethod getHeader +setGeneric( +name="getHeader", +def=function(object, ...){standardGeneric("getHeader")} +) +################################################################################ +##### Functions used for lohSpec ############################################### +################################################################################ +#' Method getVarScan +#' +#' @name getVarScan +#' @rdname getVarScan-methods +#' @param object Object of class VarScanFormat +#' @param ... additional arguments to passed +#' @exportMethod getVarScan +setGeneric( +name="getVarScan", +def=function(object, ...){standardGeneric("getVarScan")} +) +#' Method getLohData +#' +#' @name getLohData +#' @rdname getLohData-methods +#' @param object Object of class VarScanFormat +#' @param ... additional arguments to passed +#' @exportMethod getLohData +setGeneric( +name="getLohData", +def=function(object, ...){standardGeneric("getLohData")} +) +#' Method lohSpec_qual +#' +#' @name lohSpec_qual +#' @rdname lohSpec_qual-methods +#' @param object Object of class VarScanFormat +#' @param ... additional arguments to passed +setGeneric( +name="lohSpec_qual", +def=function(object, ...){standardGeneric("lohSpec_qual")} +) +#' Method annoGenomeCoord +#' +#' @name annoGenomeCoord +#' @rdname annoGenomeCoord-methods +#' @param object Object of class VarScanFormat +#' @param ... additional arguments to passed +setGeneric( +name="annoGenomeCoord", +def=function(object, ...){standardGeneric("annoGenomeCoord")} +) +#' Method getLohSlidingWindow +#' +#' @name getLohSlidingWindow +#' @rdname getLohSlidingWindow-methods +#' @param object Object of class VarScanFormat +#' @param ... additional arguments to passed +setGeneric( +name="getLohSlidingWindow", +def=function(object, ...){standardGeneric("getLohSlidingWindow")} +) +#' Method getLohCalculation +#' +#' @name getLohCalculation +#' @rdname getLohCalculation-methods +#' @param object Object of class VarScanFormat +#' @param ... additional arguments to passed +setGeneric( +name="getLohCalculation", +def=function(object, ...){standardGeneric("getLohCalculation")} +) +#' Method getLohStepCalculation +#' +#' @name getLohStepCalculation +#' @rdname getLohStepCalculation-methods +#' @param object Object of class VarScanFormat +#' @param ... additional arguments to passed +setGeneric( +name="getLohStepCalculation", +def=function(object, ...){standardGeneric("getLohStepCalculation")} +) +#' Method addBlankRegion +#' +#' @name addBlankRegion +#' @rdname addBlankRegion-methods +#' @param object Object of class VarScanFormat +#' @param ... additional arguments to passed +setGeneric( +name="addBlankRegion", +def=function(object, ...){standardGeneric("addBlankRegion")} +) +#' Method getLohSegmentation +#' +#' @name getLohSegmentation +#' @rdname getLohSegmentation-methods +#' @param object Object of class VarScanFormat +#' @param ... additional arguments to passed +setGeneric( +name="getLohSegmentation", +def=function(object, ...){standardGeneric("getLohSegmentation")} +) +#' Method buildLohFreq +#' +#' @name buildLohFreq +#' @rdname buildLohFreq-methods +#' @param object Object of class VarScanFormat +#' @param ... additional arguments to passed +setGeneric( +name="buildLohFreq", +def=function(object, ...){standardGeneric("buildLohFreq")} +) +#' Method lohSpec_buildMainPlot +#' +#' @name lohSpec_buildMainPlot +#' @rdname lohSpec_buildMainPlot-methods +#' @param object Object of class VarScanFormat +#' @param ... additional arguments to passed +setGeneric( +name="lohSpec_buildMainPlot", +def=function(object, ...){standardGeneric("lohSpec_buildMainPlot")} +) +#' Method chrSubset +#' +#' @name chrSubset +#' @rdname chrSubset-methods +#' @param ... additional arguments to passed +#' @noRd +setGeneric( +name="chrSubset", +def=function(object, ...){standardGeneric("chrSubset")} +) +#' Method sampleSubset +#' +#' @name sampleSubset +#' @rdname sampleSubset-methods +#' @param ... additional arguments to passed +#' @noRd +setGeneric( +name="sampleSubset", +def=function(object, ...){standardGeneric("sampleSubset")} +) +lohFreqPlot <- buildLohFreq(object=lohDataset, highCutoff, plotType ="proportion", CN_high_color) +##### Function to create loh frequency plot ##### +#' @rdname buildLohFreq-methods +#' @param object of class lohData +#' @param step integer +#' @aliases buildLohFreq +setMethod(f = "buildLohFreq", +signature="list", +definition=function(object, highCutoff, plotType, CN_high_color, verbose, ...) { +x <- object@lohSegmentationData[,c("chrom", "loc.start", +"loc.end", "seg.mean", "ID")] +colnames(x) <- c("chromosome", "start", "end", "segmean", "sample") +## Set the order of the chromosomes +chr <- gtools::mixedsort(as.character((unique(x$chromosome)))) +sample <- gtools::mixedsort(as.character((unique(x$sample)))) +x$chromosome_f <- factor(x$chromosome, levels=chr) +x$sample <- factor(x$sample, levels=sample, labels=sample) +## Calculate columns of observed LOH and observed samples in the +## cohort for each segment +gainFreq <- function(x){length(x[x>=highCutoff])} +gainFrequency <- aggregate(segmean~chromosome + start + end, +data=x, gainFreq)$segmean +x <- aggregate(segmean~chromosome + start + end, data=x, length) +colnames(x)[which(colnames(x) %in% "segmean")] <- "sampleFrequency" +x$gainFrequency <- gainFrequency +## Calculate the proportion +x$gainProportion <- as.numeric(x$gainFrequency)/length(samples) +## Put in dummy data for chromosome boundaries +tempDf <- split(x, list(x$chromosome)) +chrData <- object@chrData +finalDf <- rbindlist(lapply(tempDf, function(df, chrData) { +## Get the chromosome, start, and end information loh dataset +chromosome <- paste("\\bchr", df$chromosome, "\\b", sep = "")[1] +chromosomeTemp <- as.character(df$chromosome[1]) +start <- df$start[1] +end <- df$end[nrow(y)] +sample <- as.character(df$sample[1]) +## Get the end information from the chrDataset +chrDataEnd <- chrData$end[grep(chromosome, chrData$chromosome)] +## Make top and bottom row +top <- data.table(cbind(chromosomeTemp, 1, start-1, 0, 0, 0)) +colnames(top) <- c("chromosome", "start", "end", "sampleFrequency", "gainFrequency", +"gainProportion") +bottom <- data.table(cbind(chromosomeTemp, end+1, chrDataEnd, 0, 0, 0)) +colnames(bottom) <- c("chromosome", "start", "end", "sampleFrequency", "gainFrequency", +"gainProportion") +final <- rbind(top, df, bottom) +return(final) +}, chrData=chrData)) +## Build the frequency/proportion plot +## Define parameters of the plot +plotTheme <- theme(axis.ticks.x=element_blank(), +axis.text.x=element_blank(), +axis.ticks.y=element_blank(), +axis.text.y=element_blank(), +panel.grid.major=element_blank(), +panel.grid.minor=element_blank()) +## Define the facet +facet <- facet_grid(. ~ chromosome, scales = "free_x", space = "fixed") +## Assign the x axis label +xlabel <- xlab("Chromosome") +## Choose whether to plot aesthetics for proportion or frequency +if(grepl("^PROP", plotType, ignore.case=TRUE)){ +ylabel <- ylab("Proportion of Loss of Heterozygosity") +ymax <- 1 +finalDf$gain <- finalDf$gainProportion +} else if(grepl("^FREQ", plotType, ignore.case=TRUE)){ +ylabel <- ylab("Frequency of Loss of Heterozygosity") +ymax <- max(as.numeric(as.character(x$sampleFrequency)), na.rm=TRUE) +finalDf$gain <- finalDf$gainFrequency +} else { +memo <- paste0("did not recognize plotType ", plotType, +", please specify one of \"proportion\" or \"frequency\"") +stop(memo) +} +## Initiate the plot +finalDf$gain <- as.numeric(sample(1:nrow(finalDf))/nrow(finalDf)) +finalDf$start <- as.numeric(finalDf$start) +finalDf$end <- as.numeric(finalDf$end) +p1 <- ggplot(data=finalDf, mapping=aes_string(xmin='start', +xmax='end', +ymin=0, +ymax='gain'), +fill=CN_high_color) + +geom_rect() + scale_x_continuous(expand=c(0,0)) + +scale_y_continuous(expand=c(0,0)) +p1 <- p1 + geom_hline(aes(yintercept=0), linetype="dotted") +# build the plot +p1 <- p1 + ylabel + xlabel + facet + plotTheme + theme_bw() + plotTheme + plotlayer +print(p1) +return(p1) +}) +##################### +#' @rdname buildLohFreq-methods +#' @param object of class lohData +#' @param step integer +#' @aliases buildLohFreq +setMethod(f = "buildLohFreq", +signature="lohData", +definition=function(object, highCutoff, plotType, CN_high_color, verbose, ...) { +x <- object@lohSegmentationData[,c("chrom", "loc.start", +"loc.end", "seg.mean", "ID")] +colnames(x) <- c("chromosome", "start", "end", "segmean", "sample") +## Set the order of the chromosomes +chr <- gtools::mixedsort(as.character((unique(x$chromosome)))) +sample <- gtools::mixedsort(as.character((unique(x$sample)))) +x$chromosome_f <- factor(x$chromosome, levels=chr) +x$sample <- factor(x$sample, levels=sample, labels=sample) +## Calculate columns of observed LOH and observed samples in the +## cohort for each segment +gainFreq <- function(x){length(x[x>=highCutoff])} +gainFrequency <- aggregate(segmean~chromosome + start + end, +data=x, gainFreq)$segmean +x <- aggregate(segmean~chromosome + start + end, data=x, length) +colnames(x)[which(colnames(x) %in% "segmean")] <- "sampleFrequency" +x$gainFrequency <- gainFrequency +## Calculate the proportion +x$gainProportion <- as.numeric(x$gainFrequency)/length(samples) +## Put in dummy data for chromosome boundaries +tempDf <- split(x, list(x$chromosome)) +chrData <- object@chrData +finalDf <- rbindlist(lapply(tempDf, function(df, chrData) { +## Get the chromosome, start, and end information loh dataset +chromosome <- paste("\\bchr", df$chromosome, "\\b", sep = "")[1] +chromosomeTemp <- as.character(df$chromosome[1]) +start <- df$start[1] +end <- df$end[nrow(y)] +sample <- as.character(df$sample[1]) +## Get the end information from the chrDataset +chrDataEnd <- chrData$end[grep(chromosome, chrData$chromosome)] +## Make top and bottom row +top <- data.table(cbind(chromosomeTemp, 1, start-1, 0, 0, 0)) +colnames(top) <- c("chromosome", "start", "end", "sampleFrequency", "gainFrequency", +"gainProportion") +bottom <- data.table(cbind(chromosomeTemp, end+1, chrDataEnd, 0, 0, 0)) +colnames(bottom) <- c("chromosome", "start", "end", "sampleFrequency", "gainFrequency", +"gainProportion") +final <- rbind(top, df, bottom) +return(final) +}, chrData=chrData)) +## Build the frequency/proportion plot +## Define parameters of the plot +plotTheme <- theme(axis.ticks.x=element_blank(), +axis.text.x=element_blank(), +axis.ticks.y=element_blank(), +axis.text.y=element_blank(), +panel.grid.major=element_blank(), +panel.grid.minor=element_blank()) +## Define the facet +facet <- facet_grid(. ~ chromosome, scales = "free_x", space = "fixed") +## Assign the x axis label +xlabel <- xlab("Chromosome") +## Choose whether to plot aesthetics for proportion or frequency +if(grepl("^PROP", plotType, ignore.case=TRUE)){ +ylabel <- ylab("Proportion of Loss of Heterozygosity") +ymax <- 1 +finalDf$gain <- finalDf$gainProportion +} else if(grepl("^FREQ", plotType, ignore.case=TRUE)){ +ylabel <- ylab("Frequency of Loss of Heterozygosity") +ymax <- max(as.numeric(as.character(x$sampleFrequency)), na.rm=TRUE) +finalDf$gain <- finalDf$gainFrequency +} else { +memo <- paste0("did not recognize plotType ", plotType, +", please specify one of \"proportion\" or \"frequency\"") +stop(memo) +} +## Initiate the plot +finalDf$gain <- as.numeric(sample(1:nrow(finalDf))/nrow(finalDf)) +finalDf$start <- as.numeric(finalDf$start) +finalDf$end <- as.numeric(finalDf$end) +p1 <- ggplot(data=finalDf, mapping=aes_string(xmin='start', +xmax='end', +ymin=0, +ymax='gain'), +fill=CN_high_color) + +geom_rect() + scale_x_continuous(expand=c(0,0)) + +scale_y_continuous(expand=c(0,0)) +p1 <- p1 + geom_hline(aes(yintercept=0), linetype="dotted") +# build the plot +p1 <- p1 + ylabel + xlabel + facet + plotTheme + theme_bw() + plotTheme + plotlayer +print(p1) +return(p1) +}) +lohFreqPlot <- buildLohFreq(object=lohDataset, highCutoff, plotType ="proportion", CN_high_color) diff --git a/.Rhistory[Conflict] b/.Rhistory[Conflict] new file mode 100644 index 0000000..9e140e7 --- /dev/null +++ b/.Rhistory[Conflict] @@ -0,0 +1,512 @@ +#' +#' An S4 class for the lohSpec plot object +#' @name lohSpec-class +#' @rdname lohSpec-class +#' @slot lohFreq_plot gtable object for the lohFreq plot +#' @slot lohSpec_plot gtable object for the lohSpec plot +#' @slot lohData data.table object soring loh data with column names: sample, +#' chromosome, position, t_vaf, n_vaf. +#' @exportClass lohSpec +#' @importFrom data.table data.table +#' @importFrom gtable gtable +methods::setOldClass("gtable") +setClass( +Class="lohSpec", +representation=representation(lohFreq_plot="gtable", +lohSpec_plot="gtable", +lohData="data.table"), +validity = function(object) { +} +) +#' Constructor for the lohSpec class +#' +#' @name lohSpec +#' @rdname lohSpec-class +#' @param input Object of class VarScan. +#' @param Character vector specifying the chromosomes of interest. +#' @param samples Character vector specifying samples to plot. If not NULL +#' all samples in "input" not specified with this parameter are removed. +#' @param BSgenome Object of class BSgenome to extract genome wide chromosome +#' coordinates +#' @param step Integer value specifying the step size (i.e. the number of base +#' pairs to move the window). required when method is set to slide +#' (see details). +#' @param windowSize Integer value specifying the size of the window in base +#' pairs in which to calculate the mean Loss of Heterozygosity (see details). +#' @param normal Boolean specifiying what value to use for normal VAF when +#' calcualting average LOH difference. Defaults to .50\% if FALSE. +#' If TRUE, will use average normal VAF in each individual sample as value +#' to calculate LOH. +lohSpec <- function(input, chromosomes="autosomes", samples=NULL, +BSgenome=BSgenome, step=1000000, windowSize=2500000, +normal=FALSE, gradient_midpoint=.2, gradient_low="#ffffff", +gradient_mid="#b2b2ff", gradient_high="#000000", +theme_layer=NULL, verbose){ +## Calculate all data for plots +## Input parameters +input <- VarScanFormat(path = "~/Google Drive/HCC1395.varscan.tsv") +BSgenome <- getBSgenome(genome = "BSgenome.Hsapiens.UCSC.hg19") +chromosomes <- as.character(c(1:22)) +samples <- as.character(unique(object@sample)) +loh_data <- lohData(object=input, chromosomes=chromosomes, samples=samples, +BSgenome=BSgenome, step=step, +windowSize=windowSize, verbose) +## Use the lohData to generate lohSpec plots +lohSpec_plot <- lohSpec_buildMainPlot(object=loh_data, plotLayer=NULL) +} +#!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Private Classes !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!# +#' Private Class lohData +#' +#' An S4 class for the Data of the loh plot object +#' @name lohData-class +#' @name lohData-class +setClass("lohData", +representation=representation(primaryData="data.table", +windowData="data.table", +windowCalcData="data.table", +chrData="data.table"), +validity = function(object){ +} +) +#' Constructor for the lohData class. +#' +#' @name lohData +#' @rdname lohData-class +#' @param object Object of class VarScan +lohData <- function(object, chromosomes, samples, BSegenome, step, windowSize, +normal, verbose) { +## Obtain LOH data for desired chromosomes and samples +primaryData <- getLohData(object=object, chromosomes=chromosomes, +samples=samples, verbose=verbose) +## Subset data to only the desired chromosomes to be plotted +primaryData <- chrSubset(object=primaryData, chromosomes=chromosomes, +verbose=verbose) +## Subset data to only the desired samples to be plotted +primaryData <- sampleSubset(object=primaryData, samples=samples, +verbose=verbose) +## Obtain chromosome boundaries from BSgenome object +chrData <- annoGenomeCoord(object=primaryData, BSgenome=BSgenome, +verbose=verbose) +## Produce data.table with window position data +windowData <- getLohSlidingWindow(object = primaryData, step = step, +windowSize = windowSize, verbose=verbose) +## Perform loh calculations on each chromosome and sample within each window +lohAbsDiff <- getLohCalculation(object=primaryData, +windowData=windowData, normal=normal, +verbose=verbose) +## Calculate avg loh for overlapping regions +lohAbsDiffOverlap <- rbindlist(getLohStepCalculation(object=lohAbsDiff, +step=step)) +## Initialize the object +new("lohData", primaryData=primaryData, windowData=rbindlist(windowData), +windowCalcData=lohAbsDiffOverlap, chrData=chrData) +} +################################################################################ +###################### Accessor function definitions ########################### +###################################################### +##### Function to obtain chromosomes of interest ##### +#' @rdname getLohData-methods +#' @aliases getLohData +#' @param object Object of class data.table +#' @param chromosomes character vector of chromosomes to retain +#' @param verbose Boolean for status updates +#' @return data.table object with calculated mutation distances +#' @noRd +setMethod(f="chrSubset", +signature="data.table", +definition=function(object, chromosomes, verbose, ...){ +# print status message +if(verbose){ +memo <- paste("Performing chromosome subsets") +message(memo) +} +# if chromosomes is null we dont want to do anything just return the object back +if(is.null(chromosomes)){ +return(object) +} +# perform quality checks on the chromosome parameter arguments +# check for character vector +if(!is.character(chromosomes)){ +memo <- paste("Input to chromosomes should be a character vector, attempting to coerce...") +warning(memo) +} +# check for specified chromosomes not in the original input +missingChr <- chromosomes[!chromosomes %in% unique(object$chromosome)] +if(length(missingChr) != 0){ +memo <- paste("The following chromosomes were designated to be kept but were not found:", +toString(missingChr), "\nValid chromosomes are", toString(unique(object$chromosome))) +warning(memo) +} +# perform the subset +object <- object[object$chromosome %in% chromosomes,] +object$chromosome <- factor(object$chromosome) +# check that the object has a size after subsets +if(nrow(object) < 1){ +memo <- paste("no entries left to plot after chromosome subsets") +stop(memo) +} +return(object) +}) +################################################## +##### Function to obtain samples of interest ##### +#' @rdname getLohData-methods +#' @aliases getLohData +#' @param object Object of class data.table +#' @param samples character vector of samples to retain +#' @param verbose Boolean for status updates +#' @return data.table object with calculated mutation distances +#' @noRd +setMethod(f="sampleSubset", +signature="data.table", +definition=function(object, samples, verbose, ...){ +# print status message +if(verbose){ +memo <- paste("Performing sample subsets") +message(memo) +} +## If samples is null, we don't want to do anything and just +## return the object +if (is.null(samples)) { +return(object) +} +## Perform quality checkes on the sample parameter arguments +if (!is.character(samples)) { +memo <- paste("Input to samples should be a character vector, +attempting to coerce...") +warning(memo) +} +## Check for specified samples not in the original input +missingSamp <- samples[!samples %in% unique(object$sample)] +if (length(missingSamp) != 0) { +memo <- paste("The following samples were designated to be +keptbut were not found:", toString(missingSamp), +"\nValid csamples are", +toString(unique(object$sample))) +warning(memo) +} +## Perform the subset +object <- object[object$sample %in% samples] +object$sample <- factor(object$sample) +## Check that the object has a size after subsets +if(nrow(object) < 1){ +memo <- paste("no entries left to plot after chromosome subsets") +stop(memo) +} +return(object) +}) +##################################################### +##### Function to get the chromosome boundaries ##### +#' @param object Object of class data.table +#' @param BSgenome Object of class BSgenome, used for extracting chromosome boundaries +#' @param verbose Boolean for status updates +#' @return Data.table with chr and start/stop positions +#' @importFrom GenomeInfoDb seqlengths +#' @importFrom data.table as.data.table +#' @importFrom data.table rbindlist +#' @importFrom gtools mixedsort +#' @noRd +setMethod(f="annoGenomeCoord", +signature="data.table", +definition=function(object, BSgenome, verbose, ...){ +## Print status message +if (verbose) { +memo <- paste("Acquiring chromosome boundaries from BSgenome object") +} +## Perform quality check on BSgenome object +if (is.null(BSgenome)) { +memo <- paste("BSgenome object is not specified, whole chromosomes", +"will not be plotted, this is not recommended!") +warning(memo) +object$chromosome <- factor(object$chromosome, levels=gtools::mixedsort(unique(as.character(object$chromosome)))) +return(object) +} else if (is(BSgenome, "BSgenome")) { +if(verbose){ +memo <- paste("BSgenome passed object validity checks") +} +} else { +memo <- paste("class of the BSgenome object is", class(BSgenome), +"should either be of class BSgenome or NULL", +"setting this to param to NULL") +warning(memo) +BSgenome <- NULL +} +## Create a data table of genomic coordinates end positions +genomeCoord <- data.table::as.data.table(seqlengths(BSgenome)) +colnames(genomeCoord) <- c("end") +genomeCoord$chromosome <- names(seqlengths(BSgenome)) +genomeCoord$start <- 1 +## Check that chromosomes between BSgenome and original input match +chrMismatch <- as.character(unique(object[!object$chromosome %in% genomeCoord$chromosome,]$chromosome)) +if (length(chrMismatch) >= 1) { +memo <- paste("The following chromosomes do not match the supplied BSgenome object", +toString(chrMismatch)) +warning(memo) +## Test if the chr mismatch is fixed by appending chr to chromosomes +chrMismatch_appendChr <- length(as.character(unique(object[!paste0("chr", object$chromosome) %in% genomeCoord$chromosome,]$chromosome))) +if(chrMismatch_appendChr < length(chrMismatch)){ +memo <- paste("appending \"chr\" to chromosomes in attempt to fix mismatch with the BSgenome") +warning(memo) +object$chromosome <- paste0("chr", object$chromosome) +} +} +## Check to see if any chromosomes in the original input dataset lack genomic coordiantes +if (any(!unique(object$chromosome) %in% unique(genomeCoord$chromosome))) { +missingGenomeCoord <- unique(object$chromosome) +missingGenomeCoord <- missingGenomeCoord[!missingGenomeCoord %in% unique(genomeCoord_a$chromosome)] +memo <- paste("The following chromosomes are missing genomic coordinates", toString(missingGenomeCoord), +"Full genomic coordinates will not be plotted for these chromosomes") +warning(memo) +} +## Filter the genomeCoord objext to only inlcude chromosomes in the input data +genomeCoord <- genomeCoord[genomeCoord$chromosome %in% unique(object$chromosome),] +return(genomeCoord) +}) +########################################################################## +##### Function to generate window position data for loh calculations ##### +#' @rdname getLohSlidingWindow-methods +#' @param object of class lohData +#' @param step integer specifying the step size between the start position of +#' each window +#' @param windowSize integer specifying the window size for loh calcuations +#' @return Data.table with window start/stop positions +#' @aliases getLohSlidingWindow +setMethod(f="getLohSlidingWindow", +signature="data.table", +definition=function(object, step, windowSize, ...){ +if (verbose) { +message("calcuating window sizes for loh calcluations on all chromosomes in each individual sample") +} +## Obtain lists for each sample and chromosome +out <- split(object, list(as.character(object$chromosome), +as.character(object$sample))) +## Obtain the window position values +window <- lapply(out, function(x, step, windowSize) { +## Get the min and max position on the chromosome +min <- integer() +max <- integer() +window_stop_1 <- integer() +window_num <- integer() +min <- as.integer(min(as.numeric(as.character(x$position)))) +max <- as.integer(max(as.numeric(as.character(x$position)))) +## Get the end of the first window position +window_stop_1 <- min+windowSize +## Calculate the number of windows necessary +num <- as.integer((max-min)/step) +num <- as.vector(1:num) +window_data_start <- vector() +window_data_stop <- vector() +## Calculate exact window positions +window_data <- lapply(num, function(x){ +window_data_start[x] <- as.integer(min+(step*(x-1))) +window_data_stop[x] <- as.integer(window_stop_1+(step*(x-1))) +window_data <- data.table(cbind(window_data_start[x], window_data_stop[x])) +return(window_data) +}) +window_data <- rbindlist(window_data) +# Get window positions whose values are below max & set max as the +# final window position (end of the chromosome) +colnames(window_data) <- c("window_start", "window_stop") +window_final <- window_data[window_data$window_stop <= max,] +window_final[nrow(window_final), 2] <- max +## Put in the chromosome +window_final$chromosome <- as.character(x$chromosome[1]) +return(window_final) +}, +step = step, windowSize = windowSize) +return(window) +}) +############################################################### +##### Function to perform loh calcluations in each window ##### +#' @rdname getLohCalculation-methods +#' @param object of class lohData +#' @param window_data of class data.table +#' @param normal integer specifying normal vaf +#' @aliases getLohCalculation +setMethod(f="getLohCalculation", +signature="data.table", +definition=function(object, windowData, normal, verbose, ...) { +## Print status message +if (verbose) { +message("Calculating absolute mean difference between t/n VAF at each coordinate provided.") +} +## Split object for each unqiuq sample-chr combination +object <- split(object, list(as.character(object$chromosome), +as.character(object$sample))) +## Separate out sample and window data by chromosome name +df <- lapply(object, function(sampleData, window, +normal) { +chromosome <- as.character(sampleData[1,chromosome]) +sample <- as.character(sampleData[1,sample]) +chromosome.sample <- paste("\\b", paste(chromosome, sample, sep = "."), "\\b", sep = "") +window <- windowData[[grep(chromosome.sample, names(windowData))]] +## For each window position, get the vaf data that falls +## within that window +dataset <- rbindlist(apply(window, 1, function(x, sampleData, normal){ +## Determine which value to use for normal +if (normal==FALSE) { +normal <- 0.5 +} +if (normal == TRUE) { +normal <- round(sampleData[,mean(normal_var_freq)], +digits=3) +} +w_start <- as.numeric(as.character(x[1])) +w_stop <- as.numeric(as.character(x[2])) +## Filter out vaf data outside the window +filtered_data <- sampleData[position >= w_start & +position <= w_stop] +## Peroform loh calclulation to obtain avg loh in the +## window's frame +loh_calc_avg <- mean(abs(as.numeric(as.character( +filtered_data$tumor_var_freq)) - normal)) +## If no coordinates are found within the window, +## make as NA +if (is.na(loh_calc_avg)) { +loh_calc_avg <- NA +w_start <- NA +w_stop <- NA +} +filtered_data$loh_diff_avg <- loh_calc_avg +filtered_data$window_start <- w_start +filtered_data$window_stop <- w_stop +return(filtered_data) +}, +sampleData=sampleData, normal=normal)) +dataset <- na.omit(dataset, cols = c("loh_diff_avg", +"window_start", +"window_stop")) +return(dataset) +}, window=windowData, normal=normal) +return(df) +}) +####################################################################### +##### Function to perform loh calcluations in overlapping windows ##### +#' @rdname getLohStepCalculation-methods +#' @param object of class lohData +#' @param step integer +#' @aliases getLohStepCalculation +setMethod(f = "getLohStepCalculation", +signature="list", +definition=function(object, step, ...) { +step_loh_calc <- lapply(object, function(x, step) { +## Get the sample and chromosome information +sample <- unique(x$sample) +chromosome <- unique(x$chromosome) +## Obtain boundaries for each step-sized window +start <- unique(x$window_start) +stop <- c(start[-1], max(x$window_stop)) +step_boundaries <- data.table(chromosome=chromosome, start=start, stop=stop) +step_boundaries$sample <- sample +## Get the average loh within each step-sized window +loh_df <- x +loh_step_avg <- apply(step_boundaries, 1, function(x, loh_df_data) { +start <- as.numeric(as.character(x[2])) +stop <- as.numeric(as.character(x[3])) +step_df <- loh_df_data[position >= start & +position < stop] +if (nrow(step_df) == 0) { +loh_step_avg <- 0 +} +if (nrow(step_df) > 0) { +loh_step_avg <- mean(step_df$loh_diff_avg) +} +return(loh_step_avg) +}, loh_df_data=loh_df) +step_boundaries$loh_step_avg <- loh_step_avg +return(step_boundaries) +}, step=step) +return(step_loh_calc) +}) +####################################################################### +##### Function to perform loh calcluations in overlapping windows ##### +#' @rdname lohSpec_buildMainPlot-methods +#' @param object of class lohData +#' @param step integer +#' @aliases lohSpec_buildMainPlot +setMethod(f = "lohSpec_buildMainPlot", +signature="lohData", +definition=function(object, ...) { +x <- object@windowCalcData +x <- x[loh_step_avg > 0] +## Set the order of the chromosomes +chr <- gtools::mixedsort((unique(x$chromosome))) +sample <- gtools::mixedsort((unique(x$sample))) +x$chromosome_f <- factor(x$chromosome, levels=chr) +x$sample <- factor(x$sample, levels=sample, labels=sample) +dummyData <- object@chrData +# define dummy data which will be chromosome boundaries, these are plotted +# but are transparent and will not appear in the plot +dummy_data <- geom_rect(data=dummyData, aes_string(xmin='start', xmax='end', +ymin=-1, ymax=1),alpha=0) +# Define the main plot +data <- geom_rect(data=x, aes_string(xmin='start', +xmax='stop', +ymin=-1, +ymax=1, fill='loh_step_avg')) +# Define additional plot parameters +facet <- facet_grid(sample ~ chromosome_f, scales="free", space="free") +x_scale <- scale_x_continuous(expand = c(0, 0)) +y_scale <- scale_y_continuous(expand = c(0,0)) +lab_x <- xlab("Chromosome") +lab_y <- ylab("Sample") +# Define plot aesthetics +BWscheme <- theme_bw() +plotTheme <- theme(axis.ticks.x=element_blank(), +axis.text.x=element_blank(), +axis.ticks.y=element_blank(), +axis.text.y=element_blank(), +panel.grid.major=element_blank(), +panel.grid.minor=element_blank()) +# plot an additional layer if specified +if(!is.null(plotLayer)) +{ +plotLayer <- plotLayer +} else { +plotLayer <- geom_blank() +} +LOHgradient <- scale_fill_gradient2(midpoint = gradient_midpoint, +guide="colourbar", +high=gradient_high, +mid=gradient_mid, +low=gradient_low, +space='Lab') +# Build the plot +tmp <- data.frame(x=0, y=0) +p1 <- ggplot(data=tmp, aes(y=0)) + dummy_data + data + facet + x_scale + y_scale + +lab_x + lab_y + BWscheme + LOHgradient + plotTheme + plotLayer +print(p1) +return(p1) +}) +lohData(object=input, chromosomes=chromosomes, samples=samples, +BSgenome=BSgenome, step=step, +windowSize=windowSize, verbose) +input <- VarScanFormat(path = "~/Google Drive/HCC1395.varscan.tsv") +BSgenome <- getBSgenome(genome = "BSgenome.Hsapiens.UCSC.hg19") +chromosomes <- as.character(c(1:22)) +samples <- as.character(unique(object@sample)) +lohData(object=input, chromosomes=chromosomes, samples=samples, +BSgenome=BSgenome, step=step, +windowSize=windowSize, verbose) +lohData +lohData(object=input, chromosomes=chromosomes, samples=samples, +BSegenome = BSgenome, step=step, +windowSize=windowSize, verbose) +lohData(object=input, chromosomes=chromosomes, samples=samples, +BSegenome=BSgenome, step=step, +windowSize=windowSize, verbose) +verbose <- FALSE +lohData(object=input, chromosomes=chromosomes, samples=samples, +BSegenome=BSgenome, step=step, +windowSize=windowSize, verbose) +verbose <- FALSE +loh_data <- lohData(object=input, chromosomes=chromosomes, samples=samples, +BSegenome=BSgenome, step=step, +windowSize=windowSize, verbose) +loh_data <- lohData(object=input, chromosomes=chromosomes, samples=samples, +BSegenome=BSgenome, step=step, +windowSize=windowSize, verbose=verbose) +normal +loh_data <- lohData(object=input, chromosomes=chromosomes, samples=samples, +BSegenome=BSgenome, step=step, +windowSize=windowSize, normal=normal, verbose=verbose) +loh_data diff --git a/DESCRIPTION b/DESCRIPTION index 47854f5..6d32cf0 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -98,7 +98,6 @@ Collate: 'ideoView_formatCytobands.R' 'ideoView_qual.R' 'lohSpec-class.R' - 'lohSpec-methods.R' 'lohSpec.R' 'lohSpec_buildMain.R' 'lohSpec_fileGlob.R' diff --git a/NAMESPACE b/NAMESPACE index dfc3c70..2e04716 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -29,13 +29,11 @@ exportClasses(VarScanFormat) exportClasses(Waterfall) exportClasses(lohSpec) exportMethods(drawPlot) -exportMethods(getChrBoundaries) exportMethods(getData) exportMethods(getDescription) exportMethods(getGrob) exportMethods(getHeader) exportMethods(getLohData) -exportMethods(getLohSlidingWindow) exportMethods(getMeta) exportMethods(getMutation) exportMethods(getPath) @@ -58,6 +56,7 @@ importFrom(DBI,dbConnect) importFrom(DBI,dbDisconnect) importFrom(DBI,dbGetQuery) importFrom(FField,FFieldPtRep) +importFrom(GenomeInfoDb,seqlengths) importFrom(GenomeInfoDb,seqlevels) importFrom(GenomeInfoDb,seqnames) importFrom(GenomicFeatures,transcriptsByOverlaps) diff --git a/R/AllGenerics.R b/R/AllGenerics.R index f005eaa..e5330fc 100644 --- a/R/AllGenerics.R +++ b/R/AllGenerics.R @@ -540,16 +540,15 @@ setGeneric( def=function(object, ...){standardGeneric("lohSpec_qual")} ) -#' Method getChrBoundaries +#' Method annoGenomeCoord #' -#' @name getChrBoundaries -#' @rdname getChrBoundaries-methods +#' @name annoGenomeCoord +#' @rdname annoGenomeCoord-methods #' @param object Object of class VarScanFormat #' @param ... additional arguments to passed -#' @exportMethod getChrBoundaries setGeneric( - name="getChrBoundaries", - def=function(object, ...){standardGeneric("getChrBoundaries")} + name="annoGenomeCoord", + def=function(object, ...){standardGeneric("annoGenomeCoord")} ) #' Method getLohSlidingWindow @@ -558,7 +557,6 @@ setGeneric( #' @rdname getLohSlidingWindow-methods #' @param object Object of class VarScanFormat #' @param ... additional arguments to passed -#' @exportMethod getLohSlidingWindow setGeneric( name="getLohSlidingWindow", def=function(object, ...){standardGeneric("getLohSlidingWindow")} @@ -570,7 +568,6 @@ setGeneric( #' @rdname getLohCalculation-methods #' @param object Object of class VarScanFormat #' @param ... additional arguments to passed -#' @exportMethod getLohSlidingWindow setGeneric( name="getLohCalculation", def=function(object, ...){standardGeneric("getLohCalculation")} @@ -582,24 +579,84 @@ setGeneric( #' @rdname getLohStepCalculation-methods #' @param object Object of class VarScanFormat #' @param ... additional arguments to passed -#' @exportMethod getLohSlidingWindow setGeneric( name="getLohStepCalculation", def=function(object, ...){standardGeneric("getLohStepCalculation")} ) +#' Method getLohSegmentation +#' +#' @name getLohSegmentation +#' @rdname getLohSegmentation-methods +#' @param object Object of class VarScanFormat +#' @param ... additional arguments to passed +setGeneric( + name="getLohSegmentation", + def=function(object, ...){standardGeneric("getLohSegmentation")} +) + +#' Method getLohFreq +#' +#' @name getLohFreq +#' @rdname getLohFreq-methods +#' @param object Object of class VarScanFormat +#' @param ... additional arguments to passed +setGeneric( + name="getLohFreq", + def=function(object, ...){standardGeneric("getLohFreq")} +) + +#' Method buildLohFreq +#' +#' @name buildLohFreq +#' @rdname buildLohFreq-methods +#' @param object Object of class VarScanFormat +#' @param ... additional arguments to passed +setGeneric( + name="buildLohFreq", + def=function(object, ...){standardGeneric("buildLohFreq")} +) + #' Method lohSpec_buildMainPlot #' #' @name lohSpec_buildMainPlot #' @rdname lohSpec_buildMainPlot-methods #' @param object Object of class VarScanFormat #' @param ... additional arguments to passed -#' @exportMethod getLohSlidingWindow setGeneric( name="lohSpec_buildMainPlot", def=function(object, ...){standardGeneric("lohSpec_buildMainPlot")} ) +#' Method arrangeLohPlots +#' +#' @name arrangeLohPlots +#' @rdname arrangeLohPlots-methods +#' @param object Object of class VarScanFormat +#' @param ... additional arguments to passed +setGeneric( + name="arrangeLohPlots", + def=function(object, ...){standardGeneric("arrangeLohPlots")} +) +#' Method chrSubset +#' +#' @name chrSubset +#' @rdname chrSubset-methods +#' @param ... additional arguments to passed +#' @noRd +setGeneric( + name="chrSubset", + def=function(object, ...){standardGeneric("chrSubset")} +) - +#' Method sampleSubset +#' +#' @name sampleSubset +#' @rdname sampleSubset-methods +#' @param ... additional arguments to passed +#' @noRd +setGeneric( + name="sampleSubset", + def=function(object, ...){standardGeneric("sampleSubset")} +) \ No newline at end of file diff --git a/R/VarScanFormat-class.R b/R/VarScanFormat-class.R index d45adca..d5f7f36 100644 --- a/R/VarScanFormat-class.R +++ b/R/VarScanFormat-class.R @@ -27,6 +27,11 @@ setClass("VarScanFormat", "normal_reads1_plus", "normal_reads1_minus", "normal_reads2_plus", "normal_reads2_minus", "sample") + ## Check to see if there is any data after the filtering steps for varscan + if (nrow(object@varscan) == 0) { + stop("No varscan data can be found after filtering based on normal VAF and Germline/LOH somatic_status") + } + ## Check the column names to see if there is the appropriate input varscan_column_names <- colnames(object@varscan) num <- which(!varscan_column_names%in%cnames) @@ -43,15 +48,27 @@ setClass("VarScanFormat", for appropriate columns and column names.") } - ## Check to see if the VAF columns are percentages as opposed to proportions - tumor_false <- any(grepl("%", object@varscan$tumor_var_freq) == FALSE) - normal_false <- any(grepl("%", object@varscan$normal_var_freq) == FALSE) - if (tumor_false == TRUE | normal_false == TRUE) { - stop("Make sure the tumor/normal VAF column is in percentages and not proportion. - (i.e. 75.00% as opposed to 0.75)") + ## Check to see if the VAF columns are proportion as opposed to percentage + ## Function requires input in percentages and will convert percentage to proportion + tumor_per <- any(grepl("%", object@varscan$tumor_var_freq) == TRUE) + normal_per <- any(grepl("%", object@varscan$normal_var_freq) == TRUE) + if (tumor_per == TRUE | normal_per == TRUE) { + stop("Make sure the tumor/normal VAF column is in percentage and not proportion. + (i.e. 75.00% as opposed to 0.75).") } ## Check to see if the VAF provided are somatic or not + if (any(object@varscan$tumor_var_freq>1 | object@varscan$normal_var_freq >1)) { + stop("Detected values in either the normal or tumor variant ", + "allele fraction columns above 1. Values supplied should ", + "be a proportion between 0-1!") + } + if (any(object@varscan$normal_var_freq<0.4 | object@varscan$normal_var_freq>0.6)) { + stop("Detected values with a variant allele fraction either ", + "above .6 or below .4 in the normal. Please ensure ", + "variants supplied are heterozygous in the normal!. + Make sure to remove coordinates with normal VAF > 0.6 or < 0.4") + } return(TRUE) } @@ -71,11 +88,22 @@ VarScanFormat <- function(path, verbose=FALSE) { ## Read in VarScan data varscanData <- suppressWarnings(fread(input=path, stringsAsFactors=FALSE, verbose=verbose)) - ## Put in sample name for now - varscanData$sample <- "HCC1395" + ## Get the sample names sample <- varscanData[,which(colnames(varscanData)=="sample"), with=FALSE] - length(colnames(varscanData)) + + ## Convert VAF percentages to VAF proportions + varscanData$normal_var_freq <- round(as.numeric(as.character(gsub(pattern = "%", + replacement = "", varscanData$normal_var_freq)))/100, digits = 3) + varscanData$tumor_var_freq <- round(as.numeric(as.character(gsub(pattern = "%", + replacement = "", varscanData$tumor_var_freq)))/100, digits = 3) + + ## Obtain coordinates that were called as germline or LOH by varscan + varscanData <- varscanData[somatic_status == "Germline" | somatic_status == "LOH"] + + ## Remove coordinates with normal VAF > 0.6 or < 0.4 + varscanData <- varscanData[normal_var_freq<=0.6 & + normal_var_freq>=0.4] ## Create the varscan object varscanObject <- new(Class="VarScanFormat", path=path, varscan=varscanData, sample=sample) @@ -92,36 +120,20 @@ VarScanFormat <- function(path, verbose=FALSE) { #' @importFrom data.table data.table setMethod(f="getLohData", signature="VarScanFormat", - definition=function(object, chr, verbose, ...) { - ## Get the necessary columns from varscan output - primaryData <- object@varscan[,c("chrom", "position", "tumor_var_freq", - "normal_var_freq", "sample"), - with=FALSE] - - ## Convert percentages to proportion - primaryData$tumor_var_freq <- gsub("%", "", - primaryData$tumor_var_freq) - primaryData$normal_var_freq <- gsub("%", "", - primaryData$normal_var_freq) - primaryData$tumor_var_freq <- round(as.numeric(as.character( - primaryData$tumor_var_freq))/100, - digits = 3) - primaryData$normal_var_freq <- round(as.numeric(as.character( - primaryData$normal_var_freq))/100, - digits = 3) - - ## Remove contigs, MT, and other unnecessary chromosomes - if (is.null(chr)) { - chr <- c(as.character(seq(1:22))) - } - if (is.null(chr) == FALSE) { - primaryData <- primaryData[chrom %in% chr] - } - + definition=function(object, verbose, ...) { + ## Print status message if (verbose) { message("Generating LOH dataset.") } + + ## Get the necessary columns from varscan output + primaryData <- object@varscan[,c("chrom", "position", "tumor_var_freq", + "normal_var_freq", "sample"), + with=FALSE] + colnames(primaryData) <- c("chromosome", "position", "tumor_var_freq", + "normal_var_freq", "sample") + return(primaryData) }) diff --git a/R/Waterfall-class.R b/R/Waterfall-class.R index 9236a0c..e9cfd1e 100644 --- a/R/Waterfall-class.R +++ b/R/Waterfall-class.R @@ -113,8 +113,7 @@ Waterfall <- function(input, labelColumn=NULL, samples=NULL, coverage=NULL, gridOverlay=FALSE, drop=TRUE, labelSize=5, labelAngle=0, sampleNames=TRUE, clinical=NULL, sectionHeights=NULL, sectionWidths=NULL, verbose=FALSE, plotCLayers=NULL){ - browser() - + # calculate all data for plots data <- WaterfallData(input, labelColumn=labelColumn, mutationHierarchy=mutationHierarchy, samples=samples, coverage=coverage, mutation=mutation, genes=genes, diff --git a/R/lohSpec-class.R b/R/lohSpec-class.R index a018976..3efb0aa 100644 --- a/R/lohSpec-class.R +++ b/R/lohSpec-class.R @@ -19,7 +19,8 @@ setClass( Class="lohSpec", representation=representation(lohFreq_plot="gtable", lohSpec_plot="gtable", - lohData="data.table"), + Grob="gtable", + lohData="lohData"), validity = function(object) { } @@ -30,42 +31,74 @@ setClass( #' @name lohSpec #' @rdname lohSpec-class #' @param input Object of class VarScan. -#' @param Character vector specifying the chromosomes of interest. If NULL, -#' will use autosomes for human (chr1-22). +#' @param Character vector specifying the chromosomes of interest. #' @param samples Character vector specifying samples to plot. If not NULL #' all samples in "input" not specified with this parameter are removed. -#' @param boundaries Object of class data frame with rows representing chromosome -#' boundaries for a genome assembly. The data frame must contain columns with -#' the following names "chromosome", "start", "end". If let null, will determine -#' chr boundaries using preloaded/specified genome. -#' @param genome Character string specifying a valid UCSC genome (see details). -#' @param gender Character vector of length equal to the number of samples, -#' consisting of elements from the set {"M", "F"}. Used to suppress the plotting -#' of allosomes where appropriate. +#' @param BSgenome Object of class BSgenome to extract genome wide chromosome +#' coordinates #' @param step Integer value specifying the step size (i.e. the number of base #' pairs to move the window). required when method is set to slide #' (see details). -#' @param window_size Integer value specifying the size of the window in base +#' @param windowSize Integer value specifying the size of the window in base #' pairs in which to calculate the mean Loss of Heterozygosity (see details). -#' @param normal Numeric value within the range 0-1 specifying the expected -#' normal variant allele frequency to be used in Loss of Heterozygosity -#' calculations. defaults to .50\% +#' @param normal Boolean specifiying what value to use for normal VAF when +#' calcualting average LOH difference. Defaults to .50\% if FALSE. +#' If TRUE, will use average normal VAF in each individual sample as value +#' to calculate LOH. +## Input parameters +library(data.table) +library(BSgenome) +library(DNAcopy) +library(ggplot2) -lohSpec <- function(input, chr=NULL, samples=NULL, y=NULL, genome='hg19', - gender=NULL, step=1000000, window_size=2500000, - normal=.50, gradient_midpoint=.2, gradient_low="#ffffff", - gradient_mid="#b2b2ff", gradient_high="#000000", - theme_layer=NULL, verbose){ +lohSpec <- function(input, chromosomes="autosomes", samples=NULL, + BSgenome=BSgenome, step=1000000, windowSize=2500000, + normal=FALSE, gradientMidpoint=.2, gradientColors=c("#ffffff", "#b2b2ff", "#000000"), + plotAType="proportion", plotALohCutoff=0.2, plotAColor="#98F5FF", + plotALayers=NULL, plotBLayers=NULL, sectionHeights=c(0.25, 0.75), verbose){ + input <- VarScanFormat(path = "~/Desktop/hcc_loh_all_samples.txt") + chromosomes <- "autosomes" + samples <- as.character(unique(input@sample$sample)) + BSgenome <- getBSgenome(genome = "BSgenome.Hsapiens.UCSC.hg19") + step=1000000 + windowSize=2500000 + normal=FALSE + gradientMidpoint=.2 + gradientColors <- c("#ffffff", "#b2b2ff", "#000000") + plotALayers=list(theme(axis.title.x=element_blank()), + theme(axis.title.y=element_text(size = 15)), + theme(axis.text.y=element_text(size=12)), + theme(strip.text.x=element_text(size=15)), + ylab("Proportion")) + plotAType ="proportion" + plotALohCutoff=0.1 + plotAColor="#98F5FF" + plotBLayers=list(theme(strip.text.x=element_blank()), + theme(legend.title=element_blank()), theme(legend.text=element_text(size=12)), + theme(axis.title.x=element_text(size=15)), + theme(strip.text.y=element_text(angle=0, size=15)), theme(axis.title.y=element_text(size=15))) + sectionHeights <- c(0.25, 0.75) + verbose <- TRUE ## Calculate all data for plots - loh_data <- lohData(input, chr=chr, samples=samples, y=y, genome=genome, - step=step, window_size=window_size, - normal=normal, verbose) - - ## Use the lohData to generate lohSpec plots - lohSpec_plot <- lohSpec_buildMainPlot(object=loh_data, plotLayer=NULL) + lohDataset <- lohData(object=input, chromosomes=chromosomes, samples=samples, + BSgenome=BSgenome, step=step, plotALohCutoff=plotALohCutoff, + windowSize=windowSize, normal=normal, verbose=verbose) + ## Initialize the lohSpecPlots object + plots <- lohSpecPlots(object=lohDataset, plotALohCutoff=plotALohCutoff, + plotAType=plotAType, plotAColor=plotAColor, + plotALayers=plotALayers, plotBLayers=plotBLayers, + gradientMidpoint=gradientMidpoint, gradientColors=gradientColors, + verbose=verbose) + ## Arrange freq and spectrum plots + Grob <- arrangeLohPlots(object=plots, sectionHeights=sectionHeights, + verbose=verbose) + + ## Initialize the object + new("lohSpec", lohFreq_plot=lohFreqPlot, lohSpec_plot=lohSpecPlot, + lohData=lohDataset, Grob=Grob) } #!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Private Classes !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!# @@ -78,7 +111,8 @@ setClass("lohData", representation=representation(primaryData="data.table", windowData="data.table", windowCalcData="data.table", - chrData="data.table"), + chrData="data.table", + lohFreqData="data.table"), validity = function(object){ } @@ -89,160 +123,293 @@ setClass("lohData", #' @name lohData #' @rdname lohData-class #' @param object Object of class VarScan -lohData <- function(object, chr, samples, y, genome, step, window_size, - normal, verbose) { - ## Get the primary loh data - object <- VarScanFormat(path = "~/Google Drive/HCC1395.varscan.tsv") - primaryData <- getLohData(object=object, chr=chr, verbose = verbose) +lohData <- function(object, chromosomes, samples, BSgenome, step, windowSize, + normal, plotALohCutoff, verbose) { + + ## Obtain LOH data for desired chromosomes and samples + primaryData <- getLohData(object=object, verbose=verbose) - ## Quality check on the primary data - ## To-Do: Put the quality check in the validity check - primaryData <- lohSpec_qual(object=primaryData) + ## Subset data to only the desired chromosomes to be plotted + primaryData <- chrSubset(object=primaryData, chromosomes=chromosomes, + verbose=verbose) - library(BiocInstaller) - biocLite("BSgenome.Hsapiens.UCSC.hg19") - BSgenome <- getBSgenome(genome = "BSgenome.Hsapiens.UCSC.hg19") + ## Subset data to only the desired samples to be plotted + primaryData <- sampleSubset(object=primaryData, samples=samples, + verbose=verbose) - ## Get the chromosome data - if(is.null(y)) { - y <- data.table() - } - ## Check that y is a data.table - if (!is.data.table(y)) { - message("y is not a data.table, attempting to coerce") - y <- data.table(y) - } - chrData <- getChrBoundaries(object=y, genome=genome) + ## Obtain chromosome boundaries from BSgenome object + chrData <- annoGenomeCoord(object=primaryData, BSgenome=BSgenome, + verbose=verbose) ## Produce data.table with window position data - window_data <- getLohSlidingWindow(object = primaryData, step = step, - window_size = window_size) + windowData <- getLohSlidingWindow(object=primaryData, step=step, + windowSize=windowSize, verbose=verbose) ## Perform loh calculations on each chromosome and sample within each window - loh_abs_diff <- getLohCalculation(object=primaryData, - window_data=window_data, normal=normal) + lohAbsDiff <- getLohCalculation(object=primaryData, + windowData=windowData, normal=normal, + verbose=verbose) ## Calculate avg loh for overlapping regions - loh_abs_diff_overlap <- rbindlist(getLohStepCalculation(object=loh_abs_diff, step=step)) + lohAbsDiffOverlap <- rbindlist(getLohStepCalculation(object=lohAbsDiff, + step=step, verbose=verbose)) + + ## Obtain LOH segmentation dataset + lohSegmentation <- getLohSegmentation(object=lohAbsDiffOverlap, + verbose=verbose) + + ## Obtain LOH frequency/proportion dataset + lohFreq <- getLohFreq(object=lohSegmentation, plotALohCutoff=plotALohCutoff, + chrData=chrData, verbose=verbose) ## Initialize the object - new("lohData", primaryData=primaryData, windowData=rbindlist(window_data), - windowCalcData=loh_abs_diff_overlap, chrData=chrData) + new("lohData", primaryData=primaryData, windowData=rbindlist(windowData), + windowCalcData=lohAbsDiffOverlap, chrData=chrData, + lohFreqData=lohFreq) } +#' Private Class lohSpecPlots +#' +#' An S4 class for the plots of the lohSpec class +#' @name lohSpecPlots-class +#' @rdname lohSpecPlots-class +#' @slot PlotA gtable object for the loh spectrum +#' @slot PlotB gtable object for the loh frequency/proportion +#' @import methods +#' @importFrom gtable gtable +#' @noRd +setClass("lohSpecPlots", + representation=representation(PlotA="gtable", + PlotB="gtable"), + validity = function(object) { + + }) + +#' Constructor for the lohSpecPlots class +#' +#' @name lohSpecPlots +#' @rdname lohSpecPlots-class +#' @param object Object of class lohData +#' @importFrom gtable gtable +#' @noRd +lohSpecPlots <- function(object, plotALohCutoff, plotAType, plotAColor, + plotALayers, plotBLayers, gradientMidpoint, gradientColors, verbose) { + ## Use the loh segmentation data to generate lohFreq plots + lohFreqPlot <- buildLohFreq(object=object, plotALohCutoff=plotALohCutoff, + plotAType=plotAType, plotAColor=plotAColor, + plotALayers=plotALayers, verbose=verbose) + + ## Use the lohData to generate lohSpec plots + lohSpecPlot <- lohSpec_buildMainPlot(object=object, gradientMidpoint=gradientMidpoint, + gradientColors=gradientColors, plotBLayers=plotBLayers, verbose=verbose) + + new("lohSpecPlots", PlotA=lohFreqPlot, PlotB=lohSpecPlot) +} ################################################################################ ###################### Accessor function definitions ########################### -######################################################### -##### Function to perform quality check on loh data ##### -#' @rdname lohSpec_qual-methods -#' @param object of class lohData -#' @aliases lohSpec_qual -#' @return Data.table with quality check -setMethod(f="lohSpec_qual", - signature="data.table", - definition=function(object){ - primaryData <- object - ## Check that values supplied in vaf columns are in the expected range - if (any(primaryData$tumor_var_freq>1 | primaryData$normal_var_freq>1)) { - stop("Detected values in either the normal or tumor variant ", - "allele fraction columns above 1. Values supplied should ", - "be a proportion between 0-1!") - } - if (any(primaryData$normal_var_freq<0.4 | primaryData$normal_var_freq>0.6)){ - message("Detected values with a variant allele fraction either ", - "above .6 or below .4 in the normal. Please ensure ", - "variants supplied are heterozygous in the normal!") - message("Removing coordinates with normal VAF > 0.6 or < 0.4") - primaryData <- primaryData[normal_var_freq<=0.6 & - normal_var_freq>=0.4] - } - - ## Check the chromosome column - see if it has "chr" as the prefix - if(!all(grepl("^chr", primaryData$chrom))) { - memo <- paste0("Did not detect the prefix chr in the chromosome column", - " of x... adding prefix") +###################################################### +##### Function to obtain chromosomes of interest ##### +#' @rdname getLohData-methods +#' @aliases getLohData +#' @param object Object of class data.table +#' @param chromosomes character vector of chromosomes to retain +#' @param verbose Boolean for status updates +#' @return data.table object with calculated mutation distances +#' @noRd +setMethod(f="chrSubset", + signature="data.table", + definition=function(object, chromosomes, verbose, ...){ + + # print status message + if(verbose){ + memo <- paste("Performing chromosome subsets") message(memo) - primaryData$chrom <- paste0("chr", primaryData$chrom) - } else if (all(grepl("^chr", primaryData$chrom))) { - message(paste0("detected chr in the chromosome column of x...", - "proceeding")) - } else { - stop("Detected unknown or mixed prefixes in the chromosome", - " column of x... should either be chr or none i.e. ", - "chr1 or 1") } - ## Change column names - colnames(primaryData) <- c("chromosome", "position", "t_vaf", - "n_vaf", "sample") - return(primaryData) + # if chromosomes is null we dont want to do anything just return the object back + if(is.null(chromosomes)){ + return(object) + } + + # perform quality checks on the chromosome parameter arguments + + # check for character vector + if(!is.character(chromosomes)){ + memo <- paste("Input to chromosomes should be a character vector, + specifying which chromosomes to plot, + attempting to coerce...") + warning(memo) + } + + ## Determine which chromosomes to plot + ## Only include autosomes + if (chromosomes[1] == "autosomes") { + chromosomes <- as.character(c(seq(1:22))) + } + ## Include all chromosomes + if (chromosomes[1] == "all") { + chromosomes <- unique(object$chromosome) + chromosomes <- chromosomes[-grep("GL", chromosomes)] + chromosomes <- chromosomes[-grep("MT", chromosomes)] + } + + # check for specified chromosomes not in the original input + missingChr <- chromosomes[!chromosomes %in% unique(object$chromosome)] + if(length(missingChr) != 0){ + memo <- paste("The following chromosomes were designated to be kept but were not found:", + toString(missingChr), "\nValid chromosomes are", toString(unique(object$chromosome))) + warning(memo) + } + + # perform the subset + object <- object[object$chromosome %in% chromosomes,] + object$chromosome <- factor(object$chromosome) + + # check that the object has a size after subsets + if(nrow(object) < 1){ + memo <- paste("no entries left to plot after chromosome subsets") + stop(memo) + } + + return(object) }) -##### FIX THIS TO USE DATA.TABLES ##### + +################################################## +##### Function to obtain samples of interest ##### +#' @rdname getLohData-methods +#' @aliases getLohData +#' @param object Object of class data.table +#' @param samples character vector of samples to retain +#' @param verbose Boolean for status updates +#' @return data.table object with calculated mutation distances +#' @noRd +setMethod(f="sampleSubset", + signature="data.table", + definition=function(object, samples, verbose, ...){ + + # print status message + if(verbose){ + memo <- paste("Performing sample subsets") + message(memo) + } + + ## If samples is null, we don't want to do anything and just return the object + if (is.null(samples)) { + return(object) + } + + ## Perform quality checkes on the sample parameter arguments + if (!is.character(samples)) { + memo <- paste("Input to samples should be a character vector, + attempting to coerce...") + warning(memo) + } + + ## Check for specified samples not in the original input + missingSamp <- samples[!samples %in% unique(object$sample)] + if (length(missingSamp) != 0) { + memo <- paste("The following samples were designated to be + keptbut were not found:", toString(missingSamp), + "\nValid csamples are", + toString(unique(object$sample))) + warning(memo) + } + + ## Perform the subset + object <- object[object$sample %in% samples] + object$sample <- factor(object$sample) + + ## Check that the object has a size after subsets + if(nrow(object) < 1){ + memo <- paste("no entries left to plot after chromosome subsets") + stop(memo) + } + + return(object) + }) + + ##################################################### ##### Function to get the chromosome boundaries ##### -#' @rdname getChrBoundaries-methods -#' @param object of class lohData -#' @param genome character specifying which genome to use +#' @param object Object of class data.table +#' @param BSgenome Object of class BSgenome, used for extracting chromosome boundaries +#' @param verbose Boolean for status updates #' @return Data.table with chr and start/stop positions -#' @aliases getChrBoundaries -setMethod(f="getChrBoundaries", +#' @importFrom GenomeInfoDb seqlengths +#' @importFrom data.table as.data.table +#' @importFrom data.table rbindlist +#' @importFrom gtools mixedsort +#' @noRd +setMethod(f="annoGenomeCoord", signature="data.table", - definition=function(object, genome){ - ## Preloaded genome options - preloaded <- c('hg38', 'hg19', 'mm10', 'mm9', 'rn5') - if (nrow(object) == 0 ) { - ## Check that genome specified is not the ensembl name - if(!any(genome == preloaded)) - { - if(grepl("NCBI|GRC|RGSC|BROAD|BAYLOR|WUGSC", - genome, ignore.case=TRUE)) - { - memo <- paste0("Detected a genome that does not appear to be,", - "in UCSC terms, please specify a genome in UCSC", - " terms to attempt query to UCSC mySQL databae.", - "Alternativly supply a value to y.") - warning(memo) - } - message("attempting to query UCSC sql database for chromosome - positions") - cyto_data <- suppressWarnings(multi_cytobandRet(genome)) - chr_pos <- multi_chrBound(cyto_data) - } - if (any(genome == preloaded)) { - message("genome specified is preloaded, retrieving data...") - chr_pos <- GenVisR::cytoGeno[GenVisR::cytoGeno$genome == genome,] - chr_pos <- multi_chrBound(chr_pos) + definition=function(object, BSgenome, verbose, ...){ + + ## Print status message + if (verbose) { + memo <- paste("Acquiring chromosome boundaries from BSgenome object") + message(memo) + } + + ## Perform quality check on BSgenome object + if (is.null(BSgenome)) { + memo <- paste("BSgenome object is not specified, whole chromosomes", + "will not be plotted, this is not recommended!") + warning(memo) + object$chromosome <- factor(object$chromosome, levels=gtools::mixedsort(unique(as.character(object$chromosome)))) + return(object) + } else if (is(BSgenome, "BSgenome")) { + if(verbose){ + memo <- paste("BSgenome passed object validity checks") } - } - if (nrow(object) != 0){ - if(!all(c('chromosome', 'start', 'end') %in% colnames(y))) - { - memo <- paste0("Did not detect correct column names in y, missing", - "one of \"chromosome\", \"start\", \"end\"") - stop(memo) + } else { + memo <- paste("class of the BSgenome object is", class(BSgenome), + "should either be of class BSgenome or NULL", + "setting this to param to NULL") + warning(memo) + BSgenome <- NULL + } + + ## Create a data table of genomic coordinates end positions + genomeCoord <- data.table::as.data.table(seqlengths(BSgenome)) + colnames(genomeCoord) <- c("end") + genomeCoord$chromosome <- names(seqlengths(BSgenome)) + genomeCoord$start <- 1 + + ## Check that chromosomes between BSgenome and original input match + chrMismatch <- as.character(unique(object[!object$chromosome %in% genomeCoord$chromosome,]$chromosome)) + if (length(chrMismatch) >= 1) { + memo <- paste("The following chromosomes do not match the supplied BSgenome object", + toString(chrMismatch)) + warning(memo) + + ## Test if the chr mismatch is fixed by appending chr to chromosomes + chrMismatch_appendChr <- length(as.character(unique(object[!paste0("chr", object$chromosome) %in% genomeCoord$chromosome,]$chromosome))) + if(chrMismatch_appendChr < length(chrMismatch)){ + memo <- paste("appending \"chr\" to chromosomes in attempt to fix mismatch with the BSgenome") + warning(memo) + object$chromosome <- paste0("chr", object$chromosome) } - # Ensure that columns in data frame are of proper type - object$chromosome <- as.character(object$chromosome) - object$start <- as.integer(as.character(object$start)) - object$end <- as.integer(as.character(object$end)) - message("detected input to y, using supplied positions for chromosome - boundaries") - chr_pos <- object } - # Quality check for dummy data - if(nrow(chr_pos) < 1) - { - memo <- paste0("Could not retrieve chromosome boundaries from", - " UCSC, please specify this information via ", - "the y paramter") - stop(memo) + ## Check to see if any chromosomes in the original input dataset lack genomic coordiantes + if (any(!unique(object$chromosome) %in% unique(genomeCoord$chromosome))) { + missingGenomeCoord <- unique(object$chromosome) + missingGenomeCoord <- missingGenomeCoord[!missingGenomeCoord %in% unique(genomeCoord_a$chromosome)] + memo <- paste("The following chromosomes are missing genomic coordinates", toString(missingGenomeCoord), + "Full genomic coordinates will not be plotted for these chromosomes") + warning(memo) } - return(data.table(chr_pos)) - }) + + ## Filter the genomeCoord objext to only inlcude chromosomes in the input data + genomeCoord <- genomeCoord[genomeCoord$chromosome %in% unique(object$chromosome),] + + return(genomeCoord) + + }) + ########################################################################## ##### Function to generate window position data for loh calculations ##### @@ -250,19 +417,49 @@ setMethod(f="getChrBoundaries", #' @param object of class lohData #' @param step integer specifying the step size between the start position of #' each window -#' @param window_size integer specifying the window size for loh calcuations +#' @param windowSize integer specifying the window size for loh calcuations #' @return Data.table with window start/stop positions #' @aliases getLohSlidingWindow setMethod(f="getLohSlidingWindow", signature="data.table", - definition=function(object, step, window_size, ...){ - object <- primaryData + definition=function(object, step, windowSize, ...){ + if (verbose) { + message("Calcuating window sizes for loh calcluations on all chromosomes in each individual sample") + } + + ## Perform quality check on input variables + + ## Check that step and windowSize are numeric vectors with length of 1 + if (!is.numeric(windowSize)) { + memo <- paste("WindowSize input value is not a numeric vector, attempting to coerce...") + warning(memo) + } + if (!is.numeric(step)) { + memo <- paste("Step input value is not a numeric vector, attempting to coerce...") + warning(memo) + } + if (length(windowSize) > 1) { + memo <- paste("Use only 1 numeric value to specify window size.") + warning(memo) + stop() + } + if (length(step) > 1) { + memo <- paste("Use only 1 numeric value to specify step size.") + warning(memo) + stop() + } + if (step > windowSize) { + memo <- paste("Step value is greater than windowSize. Make sure that the step value is + at most equal to the WindowSize. Changing step value to match the windowSize value.") + warning(memo) + step <- windowSize + } ## Obtain lists for each sample and chromosome out <- split(object, list(as.character(object$chromosome), as.character(object$sample))) ## Obtain the window position values - window <- lapply(out, function(x, step, window_size) { + window <- lapply(out, function(x, step, windowSize) { ## Get the min and max position on the chromosome min <- integer() max <- integer() @@ -271,7 +468,7 @@ setMethod(f="getLohSlidingWindow", min <- as.integer(min(as.numeric(as.character(x$position)))) max <- as.integer(max(as.numeric(as.character(x$position)))) ## Get the end of the first window position - window_stop_1 <- min+window_size + window_stop_1 <- min+windowSize ## Calculate the number of windows necessary num <- as.integer((max-min)/step) num <- as.vector(1:num) @@ -295,11 +492,12 @@ setMethod(f="getLohSlidingWindow", window_final$chromosome <- as.character(x$chromosome[1]) return(window_final) }, - step = step, window_size = window_size) + step = step, windowSize = windowSize) return(window) }) + ############################################################### ##### Function to perform loh calcluations in each window ##### #' @rdname getLohCalculation-methods @@ -309,34 +507,56 @@ setMethod(f="getLohSlidingWindow", #' @aliases getLohCalculation setMethod(f="getLohCalculation", signature="data.table", - definition=function(object, window_data, normal, ...) { + definition=function(object, windowData, normal, verbose, ...) { + + ## Print status message + if (verbose) { + message("Calculating absolute mean difference between t/n VAF at each coordinate provided.") + } + + ## Perform quality checkes on the input parameters + if (!is.logical(normal)) { + memo <- ("Input to specify normal VAF should be a boolean (T/F). True if + user wants to use normal VAF from varscan to identify tumor/normal LOH difference. + Flase if user wants to use 0.5 to identify tumor/normal LOH difference.") + message(memo) + } + + ## Split object for each unqiuq sample-chr combination object <- split(object, list(as.character(object$chromosome), as.character(object$sample))) - window_data <- window_data + ## Separate out sample and window data by chromosome name - df <- lapply(object, function(sample_data, window, + df <- lapply(object, function(sampleData, window, normal) { - chromosome <- as.character(sample_data[1,1]) - sample <- as.character(sample_data[1,5]) - chromosome.sample <- paste(chromosome, sample, sep = ".") - window <- window_data[[grep(chromosome.sample, names(window_data))]] + chromosome <- as.character(sampleData[1,chromosome]) + sample <- as.character(sampleData[1,sample]) + chromosome.sample <- paste("\\b", paste(chromosome, sample, sep = "."), "\\b", sep = "") + window <- windowData[[grep(chromosome.sample, names(windowData))]] ## For each window position, get the vaf data that falls ## within that window - dataset <- rbindlist(apply(window, 1, function(x, - sample_data, normal){ - if (x[3] != as.character(sample_data[1,1])) { - stop("Chromosomes in window and sample vaf data do not match") + dataset <- rbindlist(apply(window, 1, function(x, sampleData, normal){ + ## Determine which value to use for normal + if (normal==FALSE) { + normal <- 0.5 + } + if (normal == TRUE) { + normal <- round(sampleData[,mean(normal_var_freq)], + digits=3) } + w_start <- as.numeric(as.character(x[1])) w_stop <- as.numeric(as.character(x[2])) ## Filter out vaf data outside the window - filtered_data <- sample_data[position >= w_start & + filtered_data <- sampleData[position >= w_start & position <= w_stop] ## Peroform loh calclulation to obtain avg loh in the ## window's frame loh_calc_avg <- mean(abs(as.numeric(as.character( - filtered_data$t_vaf)) - normal)) + filtered_data$tumor_var_freq)) - normal)) + ## If no coordinates are found within the window, + ## make as NA if (is.na(loh_calc_avg)) { loh_calc_avg <- NA w_start <- NA @@ -347,15 +567,16 @@ setMethod(f="getLohCalculation", filtered_data$window_stop <- w_stop return(filtered_data) }, - sample_data=sample_data, normal=normal)) + sampleData=sampleData, normal=normal)) dataset <- na.omit(dataset, cols = c("loh_diff_avg", "window_start", "window_stop")) return(dataset) - }, window=window_data, normal=normal) + }, window=windowData, normal=normal) return(df) }) + ####################################################################### ##### Function to perform loh calcluations in overlapping windows ##### #' @rdname getLohStepCalculation-methods @@ -365,7 +586,11 @@ setMethod(f="getLohCalculation", setMethod(f = "getLohStepCalculation", signature="list", definition=function(object, step, ...) { - object <- loh_abs_diff + + ## Print status message + if (verbose) { + message("Calculating loh in overlapping windows") + } step_loh_calc <- lapply(object, function(x, step) { ## Get the sample and chromosome information sample <- unique(x$sample) @@ -398,30 +623,224 @@ setMethod(f = "getLohStepCalculation", return(step_loh_calc) }) -####################################################################### -##### Function to perform loh calcluations in overlapping windows ##### + +############################################################# +##### Function to generate segmentation dataset for loh ##### +#' @rdname getLohSegmentation-methods +#' @param object of class lohData +#' @param chrData of class data.table +#' @aliases getLohSegmentation +setMethod(f = "getLohSegmentation", + signature="data.table", + definition=function(object, chrData, ...){ + + ## Print status message + if (verbose) { + message("Determining segmeans from LOH calculations") + } + segDfTemp <- split(object, list(as.character(object$sample))) + segmentationDf <- rbindlist(lapply(segDfTemp, function(x){ + x$midpoint <- floor((as.numeric(x$start) + as.numeric(x$stop))/2) + lohSeg <- CNA(genomdat = as.numeric(x$loh_step_avg), chrom = x$chromosome, + maploc = x$midpoint, data.type = "binary", sampleid = unique(x$sample)) + lohSeg <- segment(lohSeg) + lohSeg <- lohSeg$output + return(lohSeg) + })) + + return(segmentationDf) + }) + +############################################################################ +##### Function to create dataset for the loh frequency/proportion plot ##### +#' @rdname getLohFreq-methods +#' @param object of class lohData +#' @param chrData of class data.table +#' @aliases getLohFreq +setMethod(f="getLohFreq", + signature="data.table", + definition=function(object, plotALohCutoff, chrData, verbose, ...){ + + ## Print status message + if (verbose) { + message("Determining proportion/frequency of samples with LOH in each region.") + } + + x <- object[,c("chrom", "loc.start", + "loc.end", "seg.mean", "ID")] + colnames(x) <- c("chromosome", "start", "end", "segmean", "sample") + + ## Calculate columns of observed LOH and observed samples in the + ## cohort for each segment + gainFreq <- function(x){length(x[x>=plotALohCutoff])} + gainFrequency <- aggregate(segmean~chromosome + start + end, + data=x, gainFreq)$segmean + x <- aggregate(segmean~chromosome + start + end, data=x, length) + colnames(x)[which(colnames(x) %in% "segmean")] <- "sampleFrequency" + x$gainFrequency <- gainFrequency + + ## Calculate the proportion + x$gainProportion <- as.numeric(x$gainFrequency)/length(samples) + x <- data.table(x) + return(x) + }) + +################################################# +##### Function to create loh frequency plot ##### +#' @rdname buildLohFreq-methods +#' @param object of class lohData +#' @aliases buildLohFreq +setMethod(f = "buildLohFreq", + signature="lohData", + definition=function(object, plotALohCutoff, plotAType, plotAColor, + plotALayers, verbose, ...) { + + ## Print status message + if (verbose) { + message("Building LOH frequency or proportion plot") + } + + ## Perform quality checks on the input variables + if (!is.numeric(plotALohCutoff)) { + memo <- paste("LOH cutoff value is not numeric, attempting to coerce...") + message(memo) + } + if (!grepl("^#(\\d|[a-f]){6,8}$", plotAColor, ignore.case=TRUE)){ + memo <- paste("LOH frequency/proportion color is not a valid hexadecimal code.") + message(memo) + } + if(!is.null(plotALayers)){ + if(!is.list(plotALayers)){ + memo <- paste("plotALayers is not a list") + stop(memo) + } + + if(any(!unlist(lapply(plotALayers, function(x) ggplot2::is.ggproto(x) | ggplot2::is.theme(x) | is(x, "labels"))))){ + memo <- paste("plotALayers is not a list of ggproto or ", + "theme objects... setting plotALayers to NULL") + warning(memo) + plotALayers <- NULL + } + } + finalDf <- object@lohFreqData + + ## Sort the chromosomes + chr <- gtools::mixedsort(as.character((unique(finalDf$chromosome)))) + sample <- gtools::mixedsort(as.character((unique(finalDf$sample)))) + finalDf$chromosome <- factor(finalDf$chromosome, levels=chr, labels=chr) + finalDf$sample <- factor(finalDf$sample, levels=sample, labels=sample) + + ## Build the frequency/proportion plot + ## Define parameters of the plot + plotTheme <- theme(axis.ticks.x=element_blank(), + axis.text.x=element_blank(), + axis.ticks.y=element_blank(), + panel.grid.major=element_blank(), + panel.grid.minor=element_blank(), + legend.position="none") + + ## Define the facet + facet <- facet_grid(.~chromosome, scales="free_x", space="fixed") + + ## Assign the x axis label + xlabel <- xlab("Chromosome") + + ## Choose whether to plot aesthetics for proportion or frequency + if(grepl("^PROP", plotAType, ignore.case=TRUE)){ + ylabel <- ylab("Proportion of Loss of Heterozygosity") + ymax <- 1 + finalDf$gain <- finalDf$gainProportion + } else if(grepl("^FREQ", plotAType, ignore.case=TRUE)){ + ylabel <- ylab("Frequency of Loss of Heterozygosity") + ymax <- max(as.numeric(as.character(x$sampleFrequency)), na.rm=TRUE) + finalDf$gain <- finalDf$gainFrequency + } else { + memo <- paste0("did not recognize plotAType ", plotAType, + ", please specify one of \"proportion\" or \"frequency\"") + stop(memo) + } + + ## Initiate the plot + finalDf$gain <- as.numeric(finalDf$gain) + finalDf$start <- as.numeric(finalDf$start) + finalDf$end <- as.numeric(finalDf$end) + p1 <- ggplot(data=finalDf, mapping=aes_string(xmin='start', + xmax='end', + ymin=0, + ymax='gain')) + + geom_rect(fill=plotAColor) + scale_x_continuous(expand=c(0,0)) + + scale_y_continuous(expand=c(0,0)) + + p1 <- p1 + geom_hline(aes(yintercept=0), linetype="dotted") + + # build the plot + p1 <- p1 + ylabel + xlabel + facet + theme_bw() + plotTheme + plotALayers + print(p1) + + ## Convert to grob + lohFreqGrob <- ggplotGrob(p1) + return(lohFreqGrob) + + }) + +################################################ +##### Function to generate lohSpec heatmap ##### #' @rdname lohSpec_buildMainPlot-methods #' @param object of class lohData -#' @param step integer #' @aliases lohSpec_buildMainPlot setMethod(f = "lohSpec_buildMainPlot", signature="lohData", - definition=function(object, ...) { + definition=function(object, gradientMidpoint, gradientColors, + plotBLayers, verbose, ...) { + + ## Print status message + if (verbose) { + message("Building main LOH spectrum plot") + } + + ## Perform quality checks on the input variables + if (!is.numeric(gradientMidpoint)) { + memo <- paste("Gradient midpoint value is not numeric, attempting to coerce...") + message(memo) + } + sapply(gradientColors, function(x) { + if (!is.character(x)) { + memo <- paste("Gradient colors for LOH spectrum figure is not a character vector, + attempting to coerce...") + message(memo) + } + hexColor <- (grepl("^#(\\d|[a-f]){6,8}$", x)) + if (hexColor == FALSE) { + memo <- paste("Specified colors in the gradient are not hexadecimal.") + message(memo) + } + }) + if(!is.null(plotBLayers)){ + if(!is.list(plotBLayers)){ + memo <- paste("plotBLayers is not a list") + stop(memo) + } + + if(any(!unlist(lapply(plotBLayers, function(x) ggplot2::is.ggproto(x) | ggplot2::is.theme(x) | is(x, "labels"))))){ + memo <- paste("plotBLayers is not a list of ggproto or ", + "theme objects... setting plotBLayers to NULL") + warning(memo) + plotBLayers <- NULL + } + } + x <- object@windowCalcData - x <- x[loh_step_avg > 0] + x <- x[loh_step_avg >= 0] + x$start <- as.numeric(x$start) + x$stop <- as.numeric(x$stop) + x$loh_step_avg <- as.numeric(x$loh_step_avg) ## Set the order of the chromosomes - chr <- gtools::mixedsort((unique(x$chromosome))) - sample <- gtools::mixedsort((unique(x$sample))) + chr <- gtools::mixedsort(as.character((unique(x$chromosome)))) + sample <- gtools::mixedsort(as.character((unique(x$sample)))) x$chromosome_f <- factor(x$chromosome, levels=chr) x$sample <- factor(x$sample, levels=sample, labels=sample) - dummyData <- object@chrData - # define dummy data which will be chromosome boundaries, these are plotted - # but are transparent and will not appear in the plot - dummy_data <- geom_rect(data=dummyData, aes_string(xmin='start', xmax='end', - ymin=-1, ymax=1),alpha=0) - # Define the main plot data <- geom_rect(data=x, aes_string(xmin='start', xmax='stop', @@ -429,7 +848,7 @@ setMethod(f = "lohSpec_buildMainPlot", ymax=1, fill='loh_step_avg')) # Define additional plot parameters - facet <- facet_grid(sample ~ chromosome_f, scales="free", space="free") + facet <- facet_grid(sample ~ chromosome_f, scales="free_x", space="fixed") x_scale <- scale_x_continuous(expand = c(0, 0)) y_scale <- scale_y_continuous(expand = c(0,0)) @@ -447,25 +866,99 @@ setMethod(f = "lohSpec_buildMainPlot", panel.grid.minor=element_blank()) # plot an additional layer if specified - if(!is.null(plotLayer)) + if(!is.null(plotBLayers)) { - plotLayer <- plotLayer + plotLayer <- plotBLayers } else { plotLayer <- geom_blank() } - LOHgradient <- scale_fill_gradient2(midpoint = gradient_midpoint, + LOHgradient <- scale_fill_gradient2(midpoint = gradientMidpoint, guide="colourbar", - high=gradient_high, - mid=gradient_mid, - low=gradient_low, + high=gradientColors[3], + mid=gradientColors[2], + low=gradientColors[1], space='Lab') # Build the plot tmp <- data.frame(x=0, y=0) - p1 <- ggplot(data=tmp, aes(y=0)) + dummy_data + data + facet + x_scale + y_scale + + p1 <- ggplot(data=tmp, aes(y=0)) + + data + facet + x_scale + y_scale + lab_x + lab_y + BWscheme + LOHgradient + plotTheme + plotLayer print(p1) - return(p1) + + ## Convert to grob + lohSpecGrob <- ggplotGrob(p1) + return(lohSpecGrob) }) +######################################################### +##### Function to arrange lohSpec and lohFreq plots ##### +#' @rdname arrangeLohPlots-methods +#' @param object of class lohData +#' @aliases arrangeLohPlots +setMethod(f="arrangeLohPlots", + signature="lohSpecPlots", + definition=function(object, sectionHeights, verbose, ...) { + + ## Print status message + if (verbose) { + message("Combining LOH frequency/proportion and LOH spectrum plot") + } + + + ## Perform quality checkes on input parameters + if (!is.numeric(sectionHeights)) { + memo <- paste("Values specified for the section heights are + not numeric, attempting to coerce...") + message(memo) + } + if (length(sectionHeights) != 2) { + memo <- paste("Heights for both LOH figures are not specified. The sectionHegihts + variable should be a numeric vector of legth 2 specifying the heights of each of the + 2 LOH figures.") + message(memo) + stop() + } + + ## Grab the data we need + plotA <- object@PlotA + plotB <- object@PlotB + + ## obtain the meax width for relevant plots + plotList <- list(plotA, plotB) + plotList <- plotList[lapply(plotList, length) > 0] + plotWidths <- lapply(plotList, function(x) x$widths) + maxWidth <- do.call(grid::unit.pmax, plotWidths) + + ## Set the widths for all plots + for (i in 1:length(plotList)) { + plotList[[i]]$widths <- maxWidth + } + + ## Set section heights based upon the number of sections + defaultPlotHeights <- c(0.25, 0.75) + + if(is.null(sectionHeights)){ + if(length(plotList) < 3){ + defaultPlotHeights <- defaultPlotHeights[-length(defaultPlotHeights)] + } + sectionHeights <- defaultPlotHeights + } else if(length(sectionHeights) != length(plotList)){ + memo <- paste("There are", length(sectionHeights), "section heights provided", + "but", length(plotList), "vertical sections...", + "using default values!") + warning(memo) + sectionHeights <- defaultPlotHeights + } else if(!all(is.numeric(sectionHeights))) { + memo <- paste("sectionHeights must be numeric... Using", + "default values!") + warning(memo) + sectionHeights <- defaultPlotHeights + } + + ## Arrange the final plot + finalPlot <- do.call(gridExtra::arrangeGrob, c(plotList, list(ncol=1, heights=sectionHeights))) + plot(finalPlot) + return(finalPlot) + }) \ No newline at end of file diff --git a/man/addBlankRegion-methods.Rd b/man/addBlankRegion-methods.Rd new file mode 100644 index 0000000..b779a57 --- /dev/null +++ b/man/addBlankRegion-methods.Rd @@ -0,0 +1,25 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R, R/lohSpec-class.R +\docType{methods} +\name{addBlankRegion} +\alias{addBlankRegion} +\alias{addBlankRegion,data.table-method} +\alias{addBlankRegion} +\title{Method addBlankRegion} +\usage{ +addBlankRegion(object, ...) + +\S4method{addBlankRegion}{data.table}(object, chrData, ...) +} +\arguments{ +\item{object}{Object of class VarScanFormat} + +\item{...}{additional arguments to passed} + +\item{chrData}{of class data.table} + +\item{object}{of class lohData} +} +\description{ +Method addBlankRegion +} diff --git a/man/annoGenomeCoord-methods.Rd b/man/annoGenomeCoord-methods.Rd new file mode 100644 index 0000000..6cffdc8 --- /dev/null +++ b/man/annoGenomeCoord-methods.Rd @@ -0,0 +1,16 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R +\name{annoGenomeCoord} +\alias{annoGenomeCoord} +\title{Method annoGenomeCoord} +\usage{ +annoGenomeCoord(object, ...) +} +\arguments{ +\item{object}{Object of class VarScanFormat} + +\item{...}{additional arguments to passed} +} +\description{ +Method annoGenomeCoord +} diff --git a/man/getChrBoundaries-methods.Rd b/man/getChrBoundaries-methods.Rd deleted file mode 100644 index 173dde1..0000000 --- a/man/getChrBoundaries-methods.Rd +++ /dev/null @@ -1,28 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/AllGenerics.R, R/lohSpec-class.R -\docType{methods} -\name{getChrBoundaries} -\alias{getChrBoundaries} -\alias{getChrBoundaries,data.table-method} -\alias{getChrBoundaries} -\title{Method getChrBoundaries} -\usage{ -getChrBoundaries(object, ...) - -\S4method{getChrBoundaries}{data.table}(object, genome) -} -\arguments{ -\item{object}{Object of class VarScanFormat} - -\item{...}{additional arguments to passed} - -\item{genome}{character specifying which genome to use} - -\item{object}{of class lohData} -} -\value{ -Data.table with chr and start/stop positions -} -\description{ -Method getChrBoundaries -} diff --git a/man/getLohCalculation-methods.Rd b/man/getLohCalculation-methods.Rd index 61a1237..81c3e74 100644 --- a/man/getLohCalculation-methods.Rd +++ b/man/getLohCalculation-methods.Rd @@ -9,18 +9,19 @@ \usage{ getLohCalculation(object, ...) -\S4method{getLohCalculation}{data.table}(object, window_data, normal, ...) +\S4method{getLohCalculation}{data.table}(object, windowData, normal, verbose, + ...) } \arguments{ \item{object}{Object of class VarScanFormat} \item{...}{additional arguments to passed} -\item{window_data}{of class data.table} - \item{normal}{integer specifying normal vaf} \item{object}{of class lohData} + +\item{window_data}{of class data.table} } \description{ Method getLohCalculation diff --git a/man/getLohSegmentation-methods.Rd b/man/getLohSegmentation-methods.Rd new file mode 100644 index 0000000..4e3e257 --- /dev/null +++ b/man/getLohSegmentation-methods.Rd @@ -0,0 +1,33 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R, R/lohSpec-class.R +\docType{methods} +\name{getLohSegmentation} +\alias{getLohSegmentation} +\alias{getLohSegmentation,data.table-method} +\alias{getLohSegmentation} +\alias{getLohSegmentation,list-method} +\alias{getLohSegmentation} +\title{Method getLohSegmentation} +\usage{ +getLohSegmentation(object, ...) + +\S4method{getLohSegmentation}{data.table}(object, chrData, ...) + +\S4method{getLohSegmentation}{list}(object, verbose, ...) +} +\arguments{ +\item{object}{Object of class VarScanFormat} + +\item{...}{additional arguments to passed} + +\item{chrData}{of class data.table} + +\item{object}{of class lohData} + +\item{object}{of class lohData} + +\item{step}{integer} +} +\description{ +Method getLohSegmentation +} diff --git a/man/getLohSlidingWindow-methods.Rd b/man/getLohSlidingWindow-methods.Rd index b21b1f4..c24c56b 100644 --- a/man/getLohSlidingWindow-methods.Rd +++ b/man/getLohSlidingWindow-methods.Rd @@ -9,7 +9,7 @@ \usage{ getLohSlidingWindow(object, ...) -\S4method{getLohSlidingWindow}{data.table}(object, step, window_size, ...) +\S4method{getLohSlidingWindow}{data.table}(object, step, windowSize, ...) } \arguments{ \item{object}{Object of class VarScanFormat} @@ -19,7 +19,7 @@ getLohSlidingWindow(object, ...) \item{step}{integer specifying the step size between the start position of each window} -\item{window_size}{integer specifying the window size for loh calcuations} +\item{windowSize}{integer specifying the window size for loh calcuations} \item{object}{of class lohData} } diff --git a/man/lohData-class.Rd b/man/lohData-class.Rd index 6d6a06e..dd51f41 100644 --- a/man/lohData-class.Rd +++ b/man/lohData-class.Rd @@ -6,7 +6,8 @@ \alias{lohData} \title{Private Class lohData} \usage{ -lohData(object, chr, samples, y, genome, step, window_size, normal, verbose) +lohData(object, chromosomes, samples, BSgenome, step, windowSize, normal, + verbose) } \arguments{ \item{object}{Object of class VarScan} diff --git a/man/lohSpec-class.Rd b/man/lohSpec-class.Rd index 8464288..32515eb 100644 --- a/man/lohSpec-class.Rd +++ b/man/lohSpec-class.Rd @@ -11,35 +11,27 @@ lohSpec(x = NULL, path = NULL, fileExt = NULL, y = NULL, method = "slide", out = "plot") } \arguments{ -\item{genome}{Character string specifying a valid UCSC genome (see details).} - -\item{gender}{Character vector of length equal to the number of samples, -consisting of elements from the set {"M", "F"}. Used to suppress the plotting -of allosomes where appropriate.} - \item{step}{Integer value specifying the step size (i.e. the number of base pairs to move the window). required when method is set to slide (see details).} -\item{window_size}{Integer value specifying the size of the window in base -pairs in which to calculate the mean Loss of Heterozygosity (see details).} - -\item{normal}{Numeric value within the range 0-1 specifying the expected -normal variant allele frequency to be used in Loss of Heterozygosity -calculations. defaults to .50\%} +\item{normal}{Boolean specifiying what value to use for normal VAF when +calcualting average LOH difference. Defaults to .50\% if FALSE. +If TRUE, will use average normal VAF in each individual sample as value +to calculate LOH.} \item{input}{Object of class VarScan.} -\item{Character}{vector specifying the chromosomes of interest. If NULL, -will use autosomes for human (chr1-22).} +\item{Character}{vector specifying the chromosomes of interest.} \item{samples}{Character vector specifying samples to plot. If not NULL all samples in "input" not specified with this parameter are removed.} -\item{boundaries}{Object of class data frame with rows representing chromosome -boundaries for a genome assembly. The data frame must contain columns with -the following names "chromosome", "start", "end". If let null, will determine -chr boundaries using preloaded/specified genome.} +\item{BSgenome}{Object of class BSgenome to extract genome wide chromosome +coordinates} + +\item{windowSize}{Integer value specifying the size of the window in base +pairs in which to calculate the mean Loss of Heterozygosity (see details).} } \description{ An S4 class for the lohSpec plot object diff --git a/man/lohSpec_qual-methods.Rd b/man/lohSpec_qual-methods.Rd index c9d7578..1dc0961 100644 --- a/man/lohSpec_qual-methods.Rd +++ b/man/lohSpec_qual-methods.Rd @@ -1,24 +1,14 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/AllGenerics.R, R/lohSpec-class.R +% Please edit documentation in R/AllGenerics.R \docType{data} \name{lohSpec_qual} \alias{lohSpec_qual} -\alias{lohSpec_qual,data.table-method} -\alias{lohSpec_qual} \title{Method lohSpec_qual} \format{An object of class \code{NULL} of length 0.} -\usage{ -\S4method{lohSpec_qual}{data.table}(object) -} \arguments{ \item{object}{Object of class VarScanFormat} \item{...}{additional arguments to passed} - -\item{object}{of class lohData} -} -\value{ -Data.table with quality check } \description{ Method lohSpec_qual From 92ad790291d5e7641654eb27bd13bdadcf015a64 Mon Sep 17 00:00:00 2001 From: Jason Kunisaki Date: Fri, 26 Jan 2018 15:55:06 -0600 Subject: [PATCH 05/21] commit --- R/combinedCnLohPlot-class.R | 4 ++-- tests/testthat/test-VarScanFormat-class.R | 20 +++++++++++++++++--- 2 files changed, 19 insertions(+), 5 deletions(-) diff --git a/R/combinedCnLohPlot-class.R b/R/combinedCnLohPlot-class.R index 638b4c1..f9515e2 100644 --- a/R/combinedCnLohPlot-class.R +++ b/R/combinedCnLohPlot-class.R @@ -807,7 +807,7 @@ setMethod(f = "getLohSegmentation", #' @param object of class data.table setMethod(f="buildCnPlot", signature="cnLohData", - definition=function(object, plotAColor, plotALayers, ...) { + definition=function(object, plotAColor, plotALayers, ...){ ## Print status message if (verbose) { @@ -878,7 +878,7 @@ setMethod(f="buildCnPlot", setMethod(f="buildSomaticLohPlot", signature="cnLohData", definition=function(object, somaticLohCutoff, plotBAlpha, plotBTumorColor, plotBNormalColor, - plotBLayers, ...) { + plotBLayers, ...){ ## Print status message if (verbose) { diff --git a/tests/testthat/test-VarScanFormat-class.R b/tests/testthat/test-VarScanFormat-class.R index 5dfd3ba..75dc5a0 100644 --- a/tests/testthat/test-VarScanFormat-class.R +++ b/tests/testthat/test-VarScanFormat-class.R @@ -3,7 +3,7 @@ testFileDir <- system.file("extdata", package="GenVisR") testFile <- Sys.glob(paste0(testFileDir, "/HCC1395.varscan.tsv")) # Define the object for testing -varscanObject <- VarScanFormat(testFile) +varscanObject <- VarScanFormat(testFile, varscanType = "LOH") ################################################################################ ##################### test VarScanFormat class construction #################### @@ -19,11 +19,25 @@ test_that("VarScanFormat can construct object from a file path", { ############################# test accessor methods ############################ ################################################################################ -test_that("accessor method getLohData extracts the proper columns", { + + +################################################################################ +########### test the getLohData method in lohSpec/combinedCnLohPlot ############ +################################################################################ + +getLohData.out <- getLohData(varscanObject, verbose=FALSE, lohSpec=TRUE, germline=FALSE) +test_that("accessor method getLohData extracts the proper columns with heterozygous calls", { + # test that it is a data.table + expect_is(getLohData.out, "data.table") + + # test that it has the proper columns expectedCol <- c("chromosome", "position", "tumor_var_freq", "normal_var_freq", "sample") - extractedCol <- colnames(getLohData(varscanObject)) + extractedCol <- colnames(getLohData.out) expect_true(all(extractedCol %in% expectedCol)) + + # test that there are no coordinates with normal VAF less than 0.4 or greater than 0.6 + }) From 99366df49fb951526a48807e28be8a670fedf217 Mon Sep 17 00:00:00 2001 From: Jason Kunisaki Date: Fri, 26 Jan 2018 16:21:36 -0600 Subject: [PATCH 06/21] commit --- DESCRIPTION | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 684d0b5..f665e26 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -28,7 +28,7 @@ NeedsCompilation: no Author: Zachary Skidmore [aut, cre], Alex Wagner [aut], Robert Lesurf [aut], Katie Campbell [aut], Jason Kunisaki [aut], Obi Griffith [aut], Malachi Griffith [aut] -Collate: +Collate: 'AllGenerics.R' 'Clinical-class.R' 'GMS_Virtual-class.R' @@ -61,6 +61,7 @@ Collate: 'cnView.R' 'cnView_buildMain.R' 'cnView_qual.R' + 'combinedCnLoh-class.R' 'compIdent.R' 'compIdent_bamRcnt.R' 'compIdent_bamRcnt_qual.R' From 1a12e33e295907d36bc8a4bc820ed2e252c5ad94 Mon Sep 17 00:00:00 2001 From: Jason Kunisaki Date: Fri, 26 Jan 2018 16:22:27 -0600 Subject: [PATCH 07/21] commit --- NAMESPACE | 1 + R/VarScanFormat-class.R | 4 +- ...nLohPlot-class.R => combinedCnLoh-class.R} | 27 ++++++++--- man/Clinical-class.Rd | 2 + man/GMS-class.Rd | 2 + man/GMS_v4-class.Rd | 2 + man/MutSpectra-class.Rd | 2 + man/MutationAnnotationFormat-class.Rd | 2 + man/MutationAnnotationFormat_v1.0-class.Rd | 2 + man/MutationAnnotationFormat_v2.0-class.Rd | 2 + man/MutationAnnotationFormat_v2.1-class.Rd | 2 + man/MutationAnnotationFormat_v2.2-class.Rd | 2 + man/MutationAnnotationFormat_v2.3-class.Rd | 2 + man/MutationAnnotationFormat_v2.4-class.Rd | 2 + man/Rainfall-class.Rd | 2 + man/VEP-class.Rd | 2 + man/VEP_v88-class.Rd | 2 + man/VarScanFormat-class.Rd | 4 +- man/VarScanFormat_Virtual-class.Rd | 2 +- man/Waterfall-class.Rd | 2 + man/annoGenomeCoord-methods.Rd | 16 ------- man/arrangeLohPlots-methods.Rd | 23 ++++++++++ man/buildLohFreq-methods.Rd | 24 ++++++++++ man/cnLoh-class.Rd | 45 +++++++++++++++++++ man/cnLohData-class.Rd | 19 ++++++++ man/drawPlot-methods.Rd | 15 ++++++- man/getData-methods.Rd | 42 ++++++++++++++++- man/getDescription-methods.Rd | 2 + man/getGrob-methods.Rd | 25 ++++++++++- man/getHeader-methods.Rd | 2 + man/getLohCalculation-methods.Rd | 13 +++++- ...egion-methods.Rd => getLohFreq-methods.Rd} | 16 +++---- man/getLohSegmentation-methods.Rd | 18 ++++---- man/getLohSlidingWindow-methods.Rd | 15 ++++++- man/getLohStepCalculation-methods.Rd | 10 ++++- man/getMeta-methods.Rd | 6 +++ man/getMutation-methods.Rd | 6 +++ man/getPath-methods.Rd | 9 +++- man/getPosition-methods.Rd | 6 +++ man/getSample-methods.Rd | 8 ++-- man/getVersion-methods.Rd | 3 ++ man/lohData-class.Rd | 4 +- man/lohSpec-class.Rd | 11 ++--- man/lohSpec_buildMainPlot-methods.Rd | 5 +-- man/writeData-methods.Rd | 10 ++++- 45 files changed, 358 insertions(+), 63 deletions(-) rename R/{combinedCnLohPlot-class.R => combinedCnLoh-class.R} (98%) delete mode 100644 man/annoGenomeCoord-methods.Rd create mode 100644 man/arrangeLohPlots-methods.Rd create mode 100644 man/buildLohFreq-methods.Rd create mode 100644 man/cnLoh-class.Rd create mode 100644 man/cnLohData-class.Rd rename man/{addBlankRegion-methods.Rd => getLohFreq-methods.Rd} (56%) diff --git a/NAMESPACE b/NAMESPACE index 49f14c3..50b5cd8 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -29,6 +29,7 @@ exportClasses(Rainfall) exportClasses(VEP) exportClasses(VarScanFormat) exportClasses(Waterfall) +exportClasses(cnLoh) exportClasses(lohSpec) exportMethods(drawPlot) exportMethods(getData) diff --git a/R/VarScanFormat-class.R b/R/VarScanFormat-class.R index 831581b..a7b6f6b 100644 --- a/R/VarScanFormat-class.R +++ b/R/VarScanFormat-class.R @@ -182,6 +182,7 @@ setMethod(f="getPath", ####################### Method function definitions ############################ #' @rdname getLohData-methods +#' @name getLohData #' @aliases getLohData #' @noRd #' @importFrom data.table data.table @@ -229,9 +230,10 @@ setMethod(f="getLohData", }) #' @rdname getCnvData-methods +#' @name getCnvData #' @aliases getCnvData -#' @noRd #' @importFrom data.table data.table +#' @noRd setMethod(f="getCnvData", signature="VarScanFormat", definition=function(object, verbose, ...) { diff --git a/R/combinedCnLohPlot-class.R b/R/combinedCnLoh-class.R similarity index 98% rename from R/combinedCnLohPlot-class.R rename to R/combinedCnLoh-class.R index f9515e2..69ab9c1 100644 --- a/R/combinedCnLohPlot-class.R +++ b/R/combinedCnLoh-class.R @@ -110,7 +110,7 @@ cnLohData <- function(cnInput, lohInput, samples, chromosomes, BSgenome, cnData <- sampleSubset(object=cnData, samples=samples, verbose=verbose) ## Obtain copy number segmentation data - cnSegmentation <- getCnSegmentation(object=cnData, verbose=verbose) + cnSegmentation <- entation(object=cnData, verbose=verbose) ## Obtain chromosome boundaries from BSgenome object chrData <- annoGenomeCoord(object=cnData, BSgenome=BSgenome, verbose=verbose) @@ -319,8 +319,9 @@ setMethod( ###################################################### ##### Function to obtain chromosomes of interest ##### -#' @rdname cnLohData-methods -#' @aliases cnLohData +#' @rdname chrSubset-methods +#' @name chrSubset +#' @aliases chrSubset #' @param object Object of class data.table #' @param chromosomes character vector of chromosomes to retain #' @param verbose Boolean for status updates @@ -403,8 +404,9 @@ setMethod(f="chrSubset", ################################################## ##### Function to obtain samples of interest ##### -#' @rdname cnLohData-methods -#' @aliases cnLohData +#' @rdname sampleSubset-methods +#' @name sampleSubset +#' @aliases sampleSubset #' @param object Object of class data.table #' @param samples character vector of samples to retain #' @param verbose Boolean for status updates @@ -458,8 +460,10 @@ setMethod(f="sampleSubset", ############################################################# ##### Function to generate segmentation dataset for cnv ##### #' @rdname getCnSegmentation-methods +#' @name getCnSegmentation #' @aliases getCnSegmentation #' @param object of class data.table +#' @noRd setMethod(f="getCnSegmentation", signature="data.table", definition=function(object, ...) { @@ -485,6 +489,7 @@ setMethod(f="getCnSegmentation", ##################################################### ##### Function to get the chromosome boundaries ##### #' @rdname annoGenomeCoord-methods +#' @name annoGenomeCoord #' @aliases annoGenomeCoord #' @param object Object of class data.table #' @param BSgenome Object of class BSgenome, used for extracting chromosome boundaries @@ -565,6 +570,7 @@ setMethod(f="annoGenomeCoord", ########################################################################## ##### Function to generate window position data for loh calculations ##### #' @rdname getLohSlidingWindow-methods +#' @name getLohSlidingWindow #' @param object of class data.table #' @param step integer specifying the step size between the start position of #' each window @@ -652,6 +658,7 @@ setMethod(f="getLohSlidingWindow", ############################################################### ##### Function to perform loh calcluations in each window ##### #' @rdname getLohCalculation-methods +#' @name getLohCalculation #' @param object of class data.table #' @param window_data of class data.table #' @param normal integer specifying normal vaf @@ -730,6 +737,7 @@ setMethod(f="getLohCalculation", ####################################################################### ##### Function to perform loh calcluations in overlapping windows ##### #' @rdname getLohStepCalculation-methods +#' @name getLohStepCalculation #' @param object of class data.table #' @param step integer #' @aliases getLohStepCalculation @@ -776,6 +784,7 @@ setMethod(f = "getLohStepCalculation", ############################################################# ##### Function to generate segmentation dataset for loh ##### #' @rdname getLohSegmentation-methods +#' @name getLohSegmentation #' @param object of class data.table #' @param chrData of class data.table #' @aliases getLohSegmentation @@ -803,8 +812,10 @@ setMethod(f = "getLohSegmentation", ######################################## ##### Function to generate cn plot ##### #' @rdname buildCnPlot-methods +#' @name buildCnPlot #' @aliases buildCnPlot #' @param object of class data.table +#' @noRd setMethod(f="buildCnPlot", signature="cnLohData", definition=function(object, plotAColor, plotALayers, ...){ @@ -873,8 +884,10 @@ setMethod(f="buildCnPlot", ################################################# ##### Function to generate somatic loh plot ##### #' @rdname buildSomaticLohPlot-methods +#' @name buildSomaticLohPlot #' @aliases buildSomaticLohPlot #' @param object of class data.table +#' @noRd setMethod(f="buildSomaticLohPlot", signature="cnLohData", definition=function(object, somaticLohCutoff, plotBAlpha, plotBTumorColor, plotBNormalColor, @@ -958,8 +971,10 @@ setMethod(f="buildSomaticLohPlot", ################################################## ##### Function to generate germline loh plot ##### #' @rdname buildGermlineLohPlot-methods +#' @name buildGermlineLohPlot #' @aliases buildGermlineLohPlot #' @param object of class data.table +#' @noRd setMethod(f="buildGermlineLohPlot", signature="cnLohData", definition=function(object, plotCLimits, plotCLowColor, @@ -1020,8 +1035,10 @@ setMethod(f="buildGermlineLohPlot", ######################################################### ##### Function to arrange lohSpec and lohFreq plots ##### #' @rdname arrangeCnLohPlots-methods +#' @name arrangeCnLohPlots #' @param object of class cnLohData #' @aliases arrangeCnLohPlots +#' @noRd setMethod(f="arrangeCnLohPlots", signature="cnLohPlots", definition=function(object, sectionHeights, verbose, ...) { diff --git a/man/Clinical-class.Rd b/man/Clinical-class.Rd index 6852f02..458d71d 100644 --- a/man/Clinical-class.Rd +++ b/man/Clinical-class.Rd @@ -29,6 +29,8 @@ of wide or long format (see details).} } \description{ An S4 class to store clinical information and plots + +Constructor for the Clinical class. } \details{ The Clinical() function is a constructor to create a GenVisR object diff --git a/man/GMS-class.Rd b/man/GMS-class.Rd index 1d199de..dedf178 100644 --- a/man/GMS-class.Rd +++ b/man/GMS-class.Rd @@ -23,6 +23,8 @@ reading in the GMS files.} } \description{ An S4 class for Genome Modeling System annotation files. + +Constructor for the GMS container class. } \details{ When specifying a path to a GMS annotation file the option exist to diff --git a/man/GMS_v4-class.Rd b/man/GMS_v4-class.Rd index 4f1c7b1..3b75f65 100644 --- a/man/GMS_v4-class.Rd +++ b/man/GMS_v4-class.Rd @@ -15,6 +15,8 @@ to the version 4 specifications.} \description{ An S4 class to represent data in gms annotation version 4, inherits from the GMS_Virtual class. + +Constructor for the GMS_v4 sub-class } \section{Slots}{ diff --git a/man/MutSpectra-class.Rd b/man/MutSpectra-class.Rd index 23e2a5c..b88c493 100644 --- a/man/MutSpectra-class.Rd +++ b/man/MutSpectra-class.Rd @@ -40,6 +40,8 @@ should sum to one. Expects a value for each section.} } \description{ An S4 class for the MutSpectra plot object + +Constructor for the MutSpectra class. } \section{Slots}{ diff --git a/man/MutationAnnotationFormat-class.Rd b/man/MutationAnnotationFormat-class.Rd index 2eb1fe8..d0c75ad 100644 --- a/man/MutationAnnotationFormat-class.Rd +++ b/man/MutationAnnotationFormat-class.Rd @@ -19,6 +19,8 @@ in the MAF file.} } \description{ An S4 class acting as a container for MutationAnnotationFormat version sub-classes. + +Constructor for the MutationAnnotationFormat container class. } \section{Slots}{ diff --git a/man/MutationAnnotationFormat_v1.0-class.Rd b/man/MutationAnnotationFormat_v1.0-class.Rd index f6fc682..618e281 100644 --- a/man/MutationAnnotationFormat_v1.0-class.Rd +++ b/man/MutationAnnotationFormat_v1.0-class.Rd @@ -15,6 +15,8 @@ version 1.0 specification.} \description{ An S4 class to represent data in mutation annotation format version 1.0, inherits from the MutationAnnotationFormat_Virtual class. + +Constructor for the MutationAnnotationFormat_v1.0 sub-class } \section{Slots}{ diff --git a/man/MutationAnnotationFormat_v2.0-class.Rd b/man/MutationAnnotationFormat_v2.0-class.Rd index 81b6745..4f63033 100644 --- a/man/MutationAnnotationFormat_v2.0-class.Rd +++ b/man/MutationAnnotationFormat_v2.0-class.Rd @@ -15,6 +15,8 @@ version 2.0 specification.} \description{ An S4 class to represent data in mutation annotation format version 2.0, inherits from the MutationAnnotationFormat_Virtual class. + +Constructor for the MutationAnnotationFormat_v2.0 sub-class } \section{Slots}{ diff --git a/man/MutationAnnotationFormat_v2.1-class.Rd b/man/MutationAnnotationFormat_v2.1-class.Rd index 606c4e3..b35bd38 100644 --- a/man/MutationAnnotationFormat_v2.1-class.Rd +++ b/man/MutationAnnotationFormat_v2.1-class.Rd @@ -15,6 +15,8 @@ version 2.1 specification.} \description{ An S4 class to represent data in mutation annotation format version 2.1, inherits from the MutationAnnotationFormat_Virtual class. + +Constructor for the MutationAnnotationFormat_v2.1 sub-class } \section{Slots}{ diff --git a/man/MutationAnnotationFormat_v2.2-class.Rd b/man/MutationAnnotationFormat_v2.2-class.Rd index f8b2435..4487cc5 100644 --- a/man/MutationAnnotationFormat_v2.2-class.Rd +++ b/man/MutationAnnotationFormat_v2.2-class.Rd @@ -15,6 +15,8 @@ version 2.2 specification.} \description{ An S4 class to represent data in mutation annotation format version 2.2, inherits from the MutationAnnotationFormat_Virtual class. + +Constructor for the MutationAnnotationFormat_v2.2 sub-class } \section{Slots}{ diff --git a/man/MutationAnnotationFormat_v2.3-class.Rd b/man/MutationAnnotationFormat_v2.3-class.Rd index 0a0ea10..462cc6a 100644 --- a/man/MutationAnnotationFormat_v2.3-class.Rd +++ b/man/MutationAnnotationFormat_v2.3-class.Rd @@ -15,6 +15,8 @@ version 2.3 specification.} \description{ An S4 class to represent data in mutation annotation format version 2.3, inherits from the MutationAnnotationFormat_Virtual class. + +Constructor for the MutationAnnotationFormat_v2.3 sub-class } \section{Slots}{ diff --git a/man/MutationAnnotationFormat_v2.4-class.Rd b/man/MutationAnnotationFormat_v2.4-class.Rd index b9137f0..46cb1c5 100644 --- a/man/MutationAnnotationFormat_v2.4-class.Rd +++ b/man/MutationAnnotationFormat_v2.4-class.Rd @@ -15,6 +15,8 @@ version 2.4 specification.} \description{ An S4 class to represent data in mutation annotation format version 2.4, inherits from the MutationAnnotationFormat_Virtual class. + +Constructor for the MutationAnnotationFormat_v2.4 sub-class } \section{Slots}{ diff --git a/man/Rainfall-class.Rd b/man/Rainfall-class.Rd index 38b9d17..91ffa9a 100644 --- a/man/Rainfall-class.Rd +++ b/man/Rainfall-class.Rd @@ -34,6 +34,8 @@ should sum to one. Expects a value for each section.} } \description{ An S4 class for the Rainfall plot object + +Constructor for the Rainfall class } \section{Slots}{ diff --git a/man/VEP-class.Rd b/man/VEP-class.Rd index ea079cd..4130295 100644 --- a/man/VEP-class.Rd +++ b/man/VEP-class.Rd @@ -23,6 +23,8 @@ reading in the VEP files.} } \description{ An S4 class for Variant Effect Predictor input. + +Constructor for the VEP container class. } \details{ When specifying a path to a VEP annotation file the option exist to diff --git a/man/VEP_v88-class.Rd b/man/VEP_v88-class.Rd index bdda6ed..37e852e 100644 --- a/man/VEP_v88-class.Rd +++ b/man/VEP_v88-class.Rd @@ -18,6 +18,8 @@ header information.} \description{ An S4 class to represent data in variant effect predictor version 88 format, inherits from the VEP_Virtual class. + +Constructor for the VEP_v88 sub-class } \section{Slots}{ diff --git a/man/VarScanFormat-class.Rd b/man/VarScanFormat-class.Rd index 068a583..251a9e7 100644 --- a/man/VarScanFormat-class.Rd +++ b/man/VarScanFormat-class.Rd @@ -6,7 +6,7 @@ \alias{VarScanFormat} \title{Class VarScanFormat} \usage{ -VarScanFormat(path, verbose = FALSE) +VarScanFormat(path, varscanType, verbose = FALSE) } \arguments{ \item{path}{String specifying the path to a VarScan file.} @@ -15,7 +15,7 @@ VarScanFormat(path, verbose = FALSE) in the VarScan. file.} } \description{ -An S4 class acting as a container for VarScanFormat. +Class VarScanFormat Constructor for the VarScanFormat container class. } diff --git a/man/VarScanFormat_Virtual-class.Rd b/man/VarScanFormat_Virtual-class.Rd index 25337f0..7730cc5 100644 --- a/man/VarScanFormat_Virtual-class.Rd +++ b/man/VarScanFormat_Virtual-class.Rd @@ -5,7 +5,7 @@ \alias{VarScanFormat_Virtual-class} \title{Class VarScanFormat_Virtual} \description{ -An S4 class to act as a virtual class for MutationAnnotationFormat version sub-classes. +An S4 class to act as a virtual class for VarScanFormat version sub-classes. } \section{Slots}{ diff --git a/man/Waterfall-class.Rd b/man/Waterfall-class.Rd index b815cf0..a5925e6 100644 --- a/man/Waterfall-class.Rd +++ b/man/Waterfall-class.Rd @@ -99,6 +99,8 @@ should sum to one. Expects a value for each section.} } \description{ An S4 class for the waterfall plot object + +Constructor for the Waterfall class. } \section{Slots}{ diff --git a/man/annoGenomeCoord-methods.Rd b/man/annoGenomeCoord-methods.Rd deleted file mode 100644 index 6cffdc8..0000000 --- a/man/annoGenomeCoord-methods.Rd +++ /dev/null @@ -1,16 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/AllGenerics.R -\name{annoGenomeCoord} -\alias{annoGenomeCoord} -\title{Method annoGenomeCoord} -\usage{ -annoGenomeCoord(object, ...) -} -\arguments{ -\item{object}{Object of class VarScanFormat} - -\item{...}{additional arguments to passed} -} -\description{ -Method annoGenomeCoord -} diff --git a/man/arrangeLohPlots-methods.Rd b/man/arrangeLohPlots-methods.Rd new file mode 100644 index 0000000..1052049 --- /dev/null +++ b/man/arrangeLohPlots-methods.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R, R/lohSpec-class.R +\docType{methods} +\name{arrangeLohPlots} +\alias{arrangeLohPlots} +\alias{arrangeLohPlots,lohSpecPlots-method} +\alias{arrangeLohPlots} +\title{Method arrangeLohPlots} +\usage{ +arrangeLohPlots(object, ...) + +\S4method{arrangeLohPlots}{lohSpecPlots}(object, sectionHeights, verbose, ...) +} +\arguments{ +\item{object}{Object of class VarScanFormat} + +\item{...}{additional arguments to passed} + +\item{object}{of class lohData} +} +\description{ +Method arrangeLohPlots +} diff --git a/man/buildLohFreq-methods.Rd b/man/buildLohFreq-methods.Rd new file mode 100644 index 0000000..63e7397 --- /dev/null +++ b/man/buildLohFreq-methods.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R, R/lohSpec-class.R +\docType{methods} +\name{buildLohFreq} +\alias{buildLohFreq} +\alias{buildLohFreq,lohData-method} +\alias{buildLohFreq} +\title{Method buildLohFreq} +\usage{ +buildLohFreq(object, ...) + +\S4method{buildLohFreq}{lohData}(object, plotALohCutoff, plotAType, plotAColor, + plotALayers, verbose, ...) +} +\arguments{ +\item{object}{Object of class VarScanFormat} + +\item{...}{additional arguments to passed} + +\item{object}{of class lohData} +} +\description{ +Method buildLohFreq +} diff --git a/man/cnLoh-class.Rd b/man/cnLoh-class.Rd new file mode 100644 index 0000000..fca9df4 --- /dev/null +++ b/man/cnLoh-class.Rd @@ -0,0 +1,45 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/combinedCnLoh-class.R +\name{cnLoh} +\alias{cnLoh} +\alias{cnLoh} +\title{Class cnLoh} +\usage{ +cnLoh(cnInput, lohInput, samples, chromosomes, BSgenome, windowSize, step, + normal, plotAColor, plotALayers, plotBAlpha, somaticLohCutoff, + plotBTumorColor, plotBNormalColor, plotBLayers, plotCLimits, plotCLowColor, + plotCHighColor, plotCLayers, sectionHeights, verbose) +} +\arguments{ +\item{samples}{Character vector specifying samples to plot. If not NULL +all samples in "input" not specified with this parameter are removed.} + +\item{chromosomes}{Character vector specifying chromosomes to plot. If not NULL +all chromosomes in "input" not specified with this parameter are removed.} + +\item{BSgenome}{Object of class BSgenome to extract genome wide chromosome +coordinates} + +\item{input}{Object of class cnLohDataFormat} +} +\description{ +An S4 class for the cn, somatic loh, and germline loh plots + +Constructor for the cnLoh class +} +\section{Slots}{ + +\describe{ +\item{\code{cnData}}{data.table object for cn plot} + +\item{\code{cnPlot}}{gtable object for the cn plot} + +\item{\code{somaticLohData}}{data.table object for the somatic loh plot} + +\item{\code{somaticLohPlot}}{gtable object for the somatic loh plot} + +\item{\code{germlineLohData}}{data.table object for the germline loh plot} + +\item{\code{germlineLohData}}{gtable object for the germline loh plot} +}} + diff --git a/man/cnLohData-class.Rd b/man/cnLohData-class.Rd new file mode 100644 index 0000000..b0df2f4 --- /dev/null +++ b/man/cnLohData-class.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/combinedCnLoh-class.R +\docType{class} +\name{cnLohData} +\alias{cnLohData} +\alias{cnLohData} +\title{Private Class cnLohData} +\usage{ +cnLohData(cnInput, lohInput, samples, chromosomes, BSgenome, windowSize, step, + normal, verbose = FALSE) +} +\arguments{ +\item{object}{Object of class cnLohDataFormat} +} +\description{ +An S4 class for the data to plot cn, somatic LOH, and germline LOH plots + +Constructor for the cnLohData class +} diff --git a/man/drawPlot-methods.Rd b/man/drawPlot-methods.Rd index e49b393..a087b3b 100644 --- a/man/drawPlot-methods.Rd +++ b/man/drawPlot-methods.Rd @@ -1,13 +1,22 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/AllGenerics.R, R/Clinical-class.R, -% R/MutSpectra-class.R, R/Rainfall-class.R, R/Waterfall-class.R +% R/MutSpectra-class.R, R/Rainfall-class.R, R/Waterfall-class.R, +% R/combinedCnLoh-class.R, R/lohSpec-class.R \docType{methods} \name{drawPlot} \alias{drawPlot} \alias{drawPlot,Clinical-method} +\alias{drawPlot} \alias{drawPlot,MutSpectra-method} +\alias{drawPlot} \alias{drawPlot,Rainfall-method} +\alias{drawPlot} \alias{drawPlot,Waterfall-method} +\alias{drawPlot} +\alias{drawPlot,cnLoh-method} +\alias{drawPlot} +\alias{drawPlot,lohSpec-method} +\alias{drawPlot} \title{Method drawPlot} \usage{ drawPlot(object, ...) @@ -19,6 +28,10 @@ drawPlot(object, ...) \S4method{drawPlot}{Rainfall}(object, ...) \S4method{drawPlot}{Waterfall}(object, ...) + +\S4method{drawPlot}{cnLoh}(object, ...) + +\S4method{drawPlot}{lohSpec}(object, ...) } \arguments{ \item{object}{Object of class Waterfall, MutSpectra, or Clinical} diff --git a/man/getData-methods.Rd b/man/getData-methods.Rd index 323314c..8256830 100644 --- a/man/getData-methods.Rd +++ b/man/getData-methods.Rd @@ -1,20 +1,44 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/AllGenerics.R, R/Clinical-class.R, -% R/MutSpectra-class.R, R/Rainfall-class.R, R/Waterfall-class.R +% R/MutSpectra-class.R, R/Rainfall-class.R, R/Waterfall-class.R, +% R/combinedCnLoh-class.R, R/lohSpec-class.R \docType{methods} \name{getData} \alias{getData} \alias{getData,Clinical-method} +\alias{getData} \alias{getData,ClinicalData-method} +\alias{getData} \alias{.getData_MutSpectra} +\alias{getData} \alias{getData,MutSpectraPrimaryData-method} +\alias{getData} \alias{getData,MutSpectra-method} +\alias{getData} \alias{.getData_Rainfall} +\alias{getData} \alias{getData,RainfallPrimaryData-method} +\alias{getData} \alias{getData,Rainfall-method} +\alias{getData} \alias{.getData_waterfall} +\alias{getData} \alias{getData,WaterfallData-method} +\alias{getData} \alias{getData,Waterfall-method} +\alias{getData} +\alias{.getData_combinedCnLoh} +\alias{getData} +\alias{getData,cnLohData-method} +\alias{getData} +\alias{getData,cnLoh-method} +\alias{getData} +\alias{.getData_lohSpec} +\alias{getData} +\alias{getData,lohData-method} +\alias{getData} +\alias{getData,lohSpec-method} +\alias{getData} \title{Method getData} \usage{ getData(object, ...) @@ -42,6 +66,18 @@ getData(object, ...) \S4method{getData}{WaterfallData}(object, name = NULL, index = NULL, ...) \S4method{getData}{Waterfall}(object, name = NULL, index = NULL, ...) + +.getData_combinedCnLoh(object, name = NULL, index = NULL, ...) + +\S4method{getData}{cnLohData}(object, name = NULL, index = NULL, ...) + +\S4method{getData}{cnLoh}(object, name = NULL, index = NULL, ...) + +.getData_lohSpec(object, name = NULL, index = NULL, ...) + +\S4method{getData}{lohData}(object, name = NULL, index = NULL, ...) + +\S4method{getData}{lohSpec}(object, name = NULL, index = NULL, ...) } \arguments{ \item{object}{Object of class Clinical,} @@ -60,6 +96,10 @@ Helper function to getData from classes Helper function to get data from classes Helper function to getData from classes + +Helper function to get data from classes + +Helper function to get data from classes } \details{ The getData method is an accessor function used to access data held diff --git a/man/getDescription-methods.Rd b/man/getDescription-methods.Rd index c9c6604..00f917b 100644 --- a/man/getDescription-methods.Rd +++ b/man/getDescription-methods.Rd @@ -5,7 +5,9 @@ \name{getDescription} \alias{getDescription} \alias{getDescription,VEP_Virtual-method} +\alias{getDescription} \alias{getDescription,VEP-method} +\alias{getDescription} \title{Method getDescription} \usage{ getDescription(object, ...) diff --git a/man/getGrob-methods.Rd b/man/getGrob-methods.Rd index ea1bd70..e132ee2 100644 --- a/man/getGrob-methods.Rd +++ b/man/getGrob-methods.Rd @@ -1,15 +1,30 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/AllGenerics.R, R/MutSpectra-class.R, -% R/Rainfall-class.R, R/Waterfall-class.R +% R/Rainfall-class.R, R/Waterfall-class.R, R/combinedCnLoh-class.R, +% R/lohSpec-class.R \docType{methods} \name{getGrob} \alias{getGrob} \alias{getGrob,MutSpectraPlots-method} +\alias{getGrob} \alias{getGrob,MutSpectra-method} +\alias{getGrob} \alias{getGrob,RainfallPlots-method} +\alias{getGrob} \alias{getGrob,Rainfall-method} +\alias{getGrob} \alias{getGrob,WaterfallPlots-method} +\alias{getGrob} \alias{getGrob,Waterfall-method} +\alias{getGrob} +\alias{getGrob,cnLohPlots-method} +\alias{getGrob} +\alias{getGrob,cnLoh-method} +\alias{getGrob} +\alias{getGrob,lohSpecPlots-method} +\alias{getGrob} +\alias{getGrob,lohSpec-method} +\alias{getGrob} \title{Method getGrob} \usage{ getGrob(object, ...) @@ -25,6 +40,14 @@ getGrob(object, ...) \S4method{getGrob}{WaterfallPlots}(object, index = 1, ...) \S4method{getGrob}{Waterfall}(object, index = 1, ...) + +\S4method{getGrob}{cnLohPlots}(object, index = 1, ...) + +\S4method{getGrob}{cnLoh}(object, index = 1, ...) + +\S4method{getGrob}{lohSpecPlots}(object, index = 1, ...) + +\S4method{getGrob}{lohSpec}(object, index = 1, ...) } \arguments{ \item{object}{Object of clas MutSpectra} diff --git a/man/getHeader-methods.Rd b/man/getHeader-methods.Rd index 6fcfc4e..c7b014c 100644 --- a/man/getHeader-methods.Rd +++ b/man/getHeader-methods.Rd @@ -5,7 +5,9 @@ \name{getHeader} \alias{getHeader} \alias{getHeader,VEP_Virtual-method} +\alias{getHeader} \alias{getHeader,VEP-method} +\alias{getHeader} \title{Method getHeader} \usage{ getHeader(object, ...) diff --git a/man/getLohCalculation-methods.Rd b/man/getLohCalculation-methods.Rd index 81c3e74..fc844e5 100644 --- a/man/getLohCalculation-methods.Rd +++ b/man/getLohCalculation-methods.Rd @@ -1,14 +1,19 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/AllGenerics.R, R/lohSpec-class.R +% Please edit documentation in R/AllGenerics.R, R/combinedCnLoh-class.R, +% R/lohSpec-class.R \docType{methods} \name{getLohCalculation} \alias{getLohCalculation} +\alias{getLohCalculation} \alias{getLohCalculation,data.table-method} \alias{getLohCalculation} \title{Method getLohCalculation} \usage{ getLohCalculation(object, ...) +\S4method{getLohCalculation}{data.table}(object, windowData, normal, verbose, + ...) + \S4method{getLohCalculation}{data.table}(object, windowData, normal, verbose, ...) } @@ -19,9 +24,15 @@ getLohCalculation(object, ...) \item{normal}{integer specifying normal vaf} +\item{object}{of class data.table} + +\item{window_data}{of class data.table} + \item{object}{of class lohData} \item{window_data}{of class data.table} + +\item{normal}{integer specifying normal vaf} } \description{ Method getLohCalculation diff --git a/man/addBlankRegion-methods.Rd b/man/getLohFreq-methods.Rd similarity index 56% rename from man/addBlankRegion-methods.Rd rename to man/getLohFreq-methods.Rd index b779a57..25c6557 100644 --- a/man/addBlankRegion-methods.Rd +++ b/man/getLohFreq-methods.Rd @@ -1,15 +1,15 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/AllGenerics.R, R/lohSpec-class.R \docType{methods} -\name{addBlankRegion} -\alias{addBlankRegion} -\alias{addBlankRegion,data.table-method} -\alias{addBlankRegion} -\title{Method addBlankRegion} +\name{getLohFreq} +\alias{getLohFreq} +\alias{getLohFreq,data.table-method} +\alias{getLohFreq} +\title{Method getLohFreq} \usage{ -addBlankRegion(object, ...) +getLohFreq(object, ...) -\S4method{addBlankRegion}{data.table}(object, chrData, ...) +\S4method{getLohFreq}{data.table}(object, plotALohCutoff, chrData, verbose, ...) } \arguments{ \item{object}{Object of class VarScanFormat} @@ -21,5 +21,5 @@ addBlankRegion(object, ...) \item{object}{of class lohData} } \description{ -Method addBlankRegion +Method getLohFreq } diff --git a/man/getLohSegmentation-methods.Rd b/man/getLohSegmentation-methods.Rd index 4e3e257..1814a5f 100644 --- a/man/getLohSegmentation-methods.Rd +++ b/man/getLohSegmentation-methods.Rd @@ -1,32 +1,32 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/AllGenerics.R, R/lohSpec-class.R +% Please edit documentation in R/AllGenerics.R, R/combinedCnLoh-class.R, +% R/lohSpec-class.R \docType{methods} \name{getLohSegmentation} \alias{getLohSegmentation} -\alias{getLohSegmentation,data.table-method} \alias{getLohSegmentation} -\alias{getLohSegmentation,list-method} +\alias{getLohSegmentation,data.table-method} \alias{getLohSegmentation} \title{Method getLohSegmentation} \usage{ getLohSegmentation(object, ...) -\S4method{getLohSegmentation}{data.table}(object, chrData, ...) +\S4method{getLohSegmentation}{data.table}(object, ...) -\S4method{getLohSegmentation}{list}(object, verbose, ...) +\S4method{getLohSegmentation}{data.table}(object, ...) } \arguments{ \item{object}{Object of class VarScanFormat} \item{...}{additional arguments to passed} -\item{chrData}{of class data.table} +\item{object}{of class data.table} -\item{object}{of class lohData} +\item{chrData}{of class data.table} -\item{object}{of class lohData} +\item{object}{of class data.table} -\item{step}{integer} +\item{chrData}{of class data.table} } \description{ Method getLohSegmentation diff --git a/man/getLohSlidingWindow-methods.Rd b/man/getLohSlidingWindow-methods.Rd index c24c56b..e16d863 100644 --- a/man/getLohSlidingWindow-methods.Rd +++ b/man/getLohSlidingWindow-methods.Rd @@ -1,14 +1,18 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/AllGenerics.R, R/lohSpec-class.R +% Please edit documentation in R/AllGenerics.R, R/combinedCnLoh-class.R, +% R/lohSpec-class.R \docType{methods} \name{getLohSlidingWindow} \alias{getLohSlidingWindow} +\alias{getLohSlidingWindow} \alias{getLohSlidingWindow,data.table-method} \alias{getLohSlidingWindow} \title{Method getLohSlidingWindow} \usage{ getLohSlidingWindow(object, ...) +\S4method{getLohSlidingWindow}{data.table}(object, step, windowSize, ...) + \S4method{getLohSlidingWindow}{data.table}(object, step, windowSize, ...) } \arguments{ @@ -21,9 +25,18 @@ each window} \item{windowSize}{integer specifying the window size for loh calcuations} +\item{object}{of class data.table} + \item{object}{of class lohData} + +\item{step}{integer specifying the step size between the start position of +each window} + +\item{windowSize}{integer specifying the window size for loh calcuations} } \value{ +Data.table with window start/stop positions + Data.table with window start/stop positions } \description{ diff --git a/man/getLohStepCalculation-methods.Rd b/man/getLohStepCalculation-methods.Rd index c209efe..54d05c0 100644 --- a/man/getLohStepCalculation-methods.Rd +++ b/man/getLohStepCalculation-methods.Rd @@ -1,14 +1,18 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/AllGenerics.R, R/lohSpec-class.R +% Please edit documentation in R/AllGenerics.R, R/combinedCnLoh-class.R, +% R/lohSpec-class.R \docType{methods} \name{getLohStepCalculation} \alias{getLohStepCalculation} +\alias{getLohStepCalculation} \alias{getLohStepCalculation,list-method} \alias{getLohStepCalculation} \title{Method getLohStepCalculation} \usage{ getLohStepCalculation(object, ...) +\S4method{getLohStepCalculation}{list}(object, step, ...) + \S4method{getLohStepCalculation}{list}(object, step, ...) } \arguments{ @@ -18,7 +22,11 @@ getLohStepCalculation(object, ...) \item{step}{integer} +\item{object}{of class data.table} + \item{object}{of class lohData} + +\item{step}{integer} } \description{ Method getLohStepCalculation diff --git a/man/getMeta-methods.Rd b/man/getMeta-methods.Rd index 4854b52..4bd2afe 100644 --- a/man/getMeta-methods.Rd +++ b/man/getMeta-methods.Rd @@ -6,11 +6,17 @@ \name{getMeta} \alias{getMeta} \alias{getMeta,GMS_Virtual-method} +\alias{getMeta} \alias{getMeta,GMS-method} +\alias{getMeta} \alias{getMeta,MutationAnnotationFormat_Virtual-method} +\alias{getMeta} \alias{getMeta,MutationAnnotationFormat-method} +\alias{getMeta} \alias{getMeta,VEP_Virtual-method} +\alias{getMeta} \alias{getMeta,VEP-method} +\alias{getMeta} \title{Method getMeta} \usage{ getMeta(object, ...) diff --git a/man/getMutation-methods.Rd b/man/getMutation-methods.Rd index c730840..0045ef3 100644 --- a/man/getMutation-methods.Rd +++ b/man/getMutation-methods.Rd @@ -6,11 +6,17 @@ \name{getMutation} \alias{getMutation} \alias{getMutation,GMS_Virtual-method} +\alias{getMutation} \alias{getMutation,GMS-method} +\alias{getMutation} \alias{getMutation,MutationAnnotationFormat_Virtual-method} +\alias{getMutation} \alias{getMutation,MutationAnnotationFormat-method} +\alias{getMutation} \alias{getMutation,VEP_Virtual-method} +\alias{getMutation} \alias{getMutation,VEP-method} +\alias{getMutation} \title{Method getMutation} \usage{ getMutation(object, ...) diff --git a/man/getPath-methods.Rd b/man/getPath-methods.Rd index bd486e0..beeae90 100644 --- a/man/getPath-methods.Rd +++ b/man/getPath-methods.Rd @@ -1,12 +1,17 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/AllGenerics.R, R/GMS-class.R, -% R/MutationAnnotationFormat-class.R, R/VEP-class.R +% R/MutationAnnotationFormat-class.R, R/VEP-class.R, R/VarScanFormat-class.R \docType{methods} \name{getPath} \alias{getPath} \alias{getPath,GMS-method} +\alias{getPath} \alias{getPath,MutationAnnotationFormat-method} +\alias{getPath} \alias{getPath,VEP-method} +\alias{getPath} +\alias{getPath,VarScanFormat-method} +\alias{getPath} \title{Method getPath} \usage{ getPath(object, ...) @@ -16,6 +21,8 @@ getPath(object, ...) \S4method{getPath}{MutationAnnotationFormat}(object, ...) \S4method{getPath}{VEP}(object, ...) + +\S4method{getPath}{VarScanFormat}(object, ...) } \arguments{ \item{object}{Object of class VEP, GMS, or MutationAnnotationFormat} diff --git a/man/getPosition-methods.Rd b/man/getPosition-methods.Rd index 0a6e5c0..8ebcd24 100644 --- a/man/getPosition-methods.Rd +++ b/man/getPosition-methods.Rd @@ -6,11 +6,17 @@ \name{getPosition} \alias{getPosition} \alias{getPosition,GMS_Virtual-method} +\alias{getPosition} \alias{getPosition,GMS-method} +\alias{getPosition} \alias{getPosition,MutationAnnotationFormat_Virtual-method} +\alias{getPosition} \alias{getPosition,MutationAnnotationFormat-method} +\alias{getPosition} \alias{getPosition,VEP_Virtual-method} +\alias{getPosition} \alias{getPosition,VEP-method} +\alias{getPosition} \title{Method getPosition} \usage{ getPosition(object, ...) diff --git a/man/getSample-methods.Rd b/man/getSample-methods.Rd index c17b90d..4593530 100644 --- a/man/getSample-methods.Rd +++ b/man/getSample-methods.Rd @@ -7,17 +7,19 @@ \name{getSample} \alias{getSample} \alias{getSample,GMS_Virtual-method} +\alias{getSample} \alias{getSample,GMS-method} +\alias{getSample} \alias{getSample,MutationAnnotationFormat_Virtual-method} +\alias{getSample} \alias{getSample,MutationAnnotationFormat-method} +\alias{getSample} \alias{getSample,VEP_Virtual-method} +\alias{getSample} \alias{getSample,VEP-method} -<<<<<<< HEAD \alias{getSample} \alias{getSample,VarScanFormat_Virtual-method} \alias{getSample} -======= ->>>>>>> 4fa590fa705dcce36ce96337d88a31bd01bd6792 \title{Method getSample} \usage{ getSample(object, ...) diff --git a/man/getVersion-methods.Rd b/man/getVersion-methods.Rd index 8307a6d..b11698e 100644 --- a/man/getVersion-methods.Rd +++ b/man/getVersion-methods.Rd @@ -5,8 +5,11 @@ \name{getVersion} \alias{getVersion} \alias{getVersion,GMS-method} +\alias{getVersion} \alias{getVersion,MutationAnnotationFormat-method} +\alias{getVersion} \alias{getVersion,VEP-method} +\alias{getVersion} \title{Method getVersion} \usage{ getVersion(object, ...) diff --git a/man/lohData-class.Rd b/man/lohData-class.Rd index dd51f41..d6e5251 100644 --- a/man/lohData-class.Rd +++ b/man/lohData-class.Rd @@ -6,8 +6,8 @@ \alias{lohData} \title{Private Class lohData} \usage{ -lohData(object, chromosomes, samples, BSgenome, step, windowSize, normal, - verbose) +lohData(object, lohSpec, chromosomes, samples, BSgenome, step, windowSize, + normal, plotALohCutoff, verbose) } \arguments{ \item{object}{Object of class VarScan} diff --git a/man/lohSpec-class.Rd b/man/lohSpec-class.Rd index 32515eb..8fae80f 100644 --- a/man/lohSpec-class.Rd +++ b/man/lohSpec-class.Rd @@ -1,9 +1,9 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/lohSpec-class.R -\name{lohSpec-class} -\alias{lohSpec-class} +\name{lohSpec} \alias{lohSpec} -\title{Class LOH} +\alias{lohSpec} +\title{Class lohSpec} \usage{ lohSpec(x = NULL, path = NULL, fileExt = NULL, y = NULL, genome = "hg19", gender = NULL, step = 1e+06, window_size = 2500000, @@ -22,11 +22,12 @@ to calculate LOH.} \item{input}{Object of class VarScan.} -\item{Character}{vector specifying the chromosomes of interest.} - \item{samples}{Character vector specifying samples to plot. If not NULL all samples in "input" not specified with this parameter are removed.} +\item{chromosomes}{Character vector specifying chromosomes to plot. If not NULL +all chromosomes in "input" not specified with this parameter are removed.} + \item{BSgenome}{Object of class BSgenome to extract genome wide chromosome coordinates} diff --git a/man/lohSpec_buildMainPlot-methods.Rd b/man/lohSpec_buildMainPlot-methods.Rd index d08a8c0..008baf2 100644 --- a/man/lohSpec_buildMainPlot-methods.Rd +++ b/man/lohSpec_buildMainPlot-methods.Rd @@ -9,7 +9,8 @@ \usage{ lohSpec_buildMainPlot(object, ...) -\S4method{lohSpec_buildMainPlot}{lohData}(object, ...) +\S4method{lohSpec_buildMainPlot}{lohData}(object, gradientMidpoint, + gradientColors, plotBLayers, verbose, ...) } \arguments{ \item{object}{Object of class VarScanFormat} @@ -17,8 +18,6 @@ lohSpec_buildMainPlot(object, ...) \item{...}{additional arguments to passed} \item{object}{of class lohData} - -\item{step}{integer} } \description{ Method lohSpec_buildMainPlot diff --git a/man/writeData-methods.Rd b/man/writeData-methods.Rd index b73e591..78f9fe0 100644 --- a/man/writeData-methods.Rd +++ b/man/writeData-methods.Rd @@ -1,19 +1,25 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/AllGenerics.R, R/GMS_Virtual-class.R, % R/GMS-class.R, R/MutationAnnotationFormat_Virtual-class.R, -% R/MutationAnnotationFormat-class.R, R/VEP_Virtual-class.R, R/VEP-class.R +% R/MutationAnnotationFormat-class.R, R/VEP_Virtual-class.R, R/VEP-class.R, +% R/VarScanFormat-class.R \docType{methods} \name{writeData} \alias{writeData} \alias{writeData,GMS_Virtual-method} \alias{writeData,GMS_Virtual} \alias{writeData,GMS-method} +\alias{writeData} \alias{writeData,MutationAnnotationFormat_Virtual-method} \alias{writeData,MutationAnnotationFormat_Virtual} \alias{writeData,MutationAnnotationFormat-method} +\alias{writeData} \alias{writeData,VEP_Virtual-method} \alias{writeData,VEP_Virtual} \alias{writeData,VEP-method} +\alias{writeData} +\alias{writeData,VarScanFormat-method} +\alias{writeData} \title{Method writeData} \usage{ writeData(object, ...) @@ -29,6 +35,8 @@ writeData(object, ...) \S4method{writeData}{VEP_Virtual}(object, file, sep, ...) \S4method{writeData}{VEP}(object, file, ...) + +\S4method{writeData}{VarScanFormat}(object, file, ...) } \arguments{ \item{object}{Object of class VEP} From c0246f4f883f44c3787efd0b9565a9cc9770a0fc Mon Sep 17 00:00:00 2001 From: Jason Kunisaki Date: Mon, 29 Jan 2018 11:45:32 -0600 Subject: [PATCH 08/21] finish combined cn/loh plots --- NAMESPACE | 1 + 1 file changed, 1 insertion(+) diff --git a/NAMESPACE b/NAMESPACE index 50b5cd8..c3845c0 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -10,6 +10,7 @@ export(VEP) export(VarScanFormat) export(Waterfall) export(cnFreq) +export(cnLoh) export(cnSpec) export(cnView) export(compIdent) From fe92167b18a35eebfdab74d6e00431dae5ace597 Mon Sep 17 00:00:00 2001 From: Jason Kunisaki Date: Mon, 29 Jan 2018 11:46:26 -0600 Subject: [PATCH 09/21] commit --- R/AllGenerics.R | 13 ++++++- R/VarScanFormat-class.R | 2 +- R/VarScanFormat_Virtual-class.R | 9 ----- R/combinedCnLoh-class.R | 68 +++++++++++++++++++++++++++------ R/lohSpec-class.R | 2 +- man/cnLoh-class.Rd | 4 +- man/getGrob-methods.Rd | 4 +- 7 files changed, 75 insertions(+), 27 deletions(-) diff --git a/R/AllGenerics.R b/R/AllGenerics.R index a7a72f3..c0552f4 100644 --- a/R/AllGenerics.R +++ b/R/AllGenerics.R @@ -823,4 +823,15 @@ setGeneric( setGeneric( name="arrangeCnLohPlots", def=function(object, ...){standardGeneric("arrangeCnLohPlots")} -) \ No newline at end of file +) + +#' Method removeGapsSegmentation +#' +#' @name removeGapsSegmentation +#' @rdname removeGapsSegmentation-methods +#' @param ... additional arguments to passed +#' @noRd +setGeneric( + name="removeGapsSegmentation", + def=function(object, ...){standardGeneric("removeGapsSegmentation")} +) diff --git a/R/VarScanFormat-class.R b/R/VarScanFormat-class.R index a7b6f6b..24f74c2 100644 --- a/R/VarScanFormat-class.R +++ b/R/VarScanFormat-class.R @@ -232,8 +232,8 @@ setMethod(f="getLohData", #' @rdname getCnvData-methods #' @name getCnvData #' @aliases getCnvData -#' @importFrom data.table data.table #' @noRd +#' @importFrom data.table data.table setMethod(f="getCnvData", signature="VarScanFormat", definition=function(object, verbose, ...) { diff --git a/R/VarScanFormat_Virtual-class.R b/R/VarScanFormat_Virtual-class.R index 2e4cb90..f6728ae 100644 --- a/R/VarScanFormat_Virtual-class.R +++ b/R/VarScanFormat_Virtual-class.R @@ -30,15 +30,6 @@ setMethod(f="getVarScan", return(varscan) }) -#' @rdname getCnvData-methods -#' @aliases getCnvData -setMethod(f="getCnvData", - signature="VarScanFormat_Virtual", - definition=function(object, ...){ - varscan <- object@varscan - return(varscan) - }) - #' @rdname getSample-methods #' @aliases getSample setMethod(f="getSample", diff --git a/R/combinedCnLoh-class.R b/R/combinedCnLoh-class.R index 69ab9c1..49f64e5 100644 --- a/R/combinedCnLoh-class.R +++ b/R/combinedCnLoh-class.R @@ -5,7 +5,7 @@ #' Class cnLoh #' #' An S4 class for the cn, somatic loh, and germline loh plots -#' @name cnLoh +#' @name cnLoh-class #' @rdname cnLoh-class #' @slot cnData data.table object for cn plot #' @slot cnPlot gtable object for the cn plot @@ -14,6 +14,7 @@ #' @slot germlineLohData data.table object for the germline loh plot #' @slot germlineLohData gtable object for the germline loh plot #' @exportClass cnLoh +#' @import methods #' @importFrom data.table data.table #' @importFrom gtable gtable methods::setOldClass("gtable") @@ -42,7 +43,7 @@ setClass( #' all chromosomes in "input" not specified with this parameter are removed. #' @param BSgenome Object of class BSgenome to extract genome wide chromosome #' coordinates - +#' @export cnLoh <- function(cnInput, lohInput, samples, chromosomes, BSgenome, windowSize, step, normal, plotAColor, plotALayers, plotBAlpha, somaticLohCutoff, plotBTumorColor, plotBNormalColor, plotBLayers, @@ -109,12 +110,15 @@ cnLohData <- function(cnInput, lohInput, samples, chromosomes, BSgenome, ## Subset copy number data by sample cnData <- sampleSubset(object=cnData, samples=samples, verbose=verbose) - ## Obtain copy number segmentation data - cnSegmentation <- entation(object=cnData, verbose=verbose) - ## Obtain chromosome boundaries from BSgenome object chrData <- annoGenomeCoord(object=cnData, BSgenome=BSgenome, verbose=verbose) + ## Obtain copy number segmentation data + cnSegmentation <- getCnSegmentation(object=cnData, verbose=verbose) + + ## Remove gaps + cnSegmentation <- removeGapsSegmentation(object=cnSegmentation, chrData=chrData, verbose=verbose) + ############################################################################ ##################### Prepare somatic loh dataset ########################## ## Obtain LOH data for desired chromosomes and samples @@ -141,6 +145,10 @@ cnLohData <- function(cnInput, lohInput, samples, chromosomes, BSgenome, ## Obtain loh segmentation dataset lohSegmentation <- getLohSegmentation(object=lohAbsDiffOverlap, verbose=verbose) + ## Remove gaps + lohSegmentation <- removeGapsSegmentation(object=lohSegmentation, chrData=chrData, + verbose=verbose) + ############################################################################ ##################### Prepare germline loh dataset ######################### ## Obtain germlineloh data by chromosome @@ -183,6 +191,7 @@ setClass("cnLohPlots", #' @name cnLohPlots #' @param object Object of class data.table #' @importFrom gtable gtable +#' @import ggplot2 #' @noRd cnLohPlots <- function(object, plotAColor, plotALayers, somaticLohCutoff, plotBAlpha, plotBTumorColor, plotBNormalColor, plotBLayers, @@ -271,7 +280,7 @@ setMethod(f="getData", #' @rdname getGrob-methods #' @aliases getGrob #' @noRd -.getGrob_combinedCnLoh <- function(object, index=1, ...){ +.getGrob_combinedCnLoh <- function(object, index, ...){ if(index == 1){ grob <- object@cnPlot } else if(index == 2) { @@ -319,9 +328,8 @@ setMethod( ###################################################### ##### Function to obtain chromosomes of interest ##### -#' @rdname chrSubset-methods -#' @name chrSubset -#' @aliases chrSubset +#' @rdname cnLoh-methods +#' @aliases cnLoh #' @param object Object of class data.table #' @param chromosomes character vector of chromosomes to retain #' @param verbose Boolean for status updates @@ -355,7 +363,7 @@ setMethod(f="chrSubset", ## Check format of the chromosome column if (!all(grepl("^chr", object$chromosome))) { - memo <- paste0("Did not detect the prefix chr in the chromosome column", + memo <- paste0("Did not detect the prefix chr in the chromosome column ", "of x... adding prefix") message (memo) object$chromosome <- paste("chr", object$chromosome, sep="") @@ -466,7 +474,12 @@ setMethod(f="sampleSubset", #' @noRd setMethod(f="getCnSegmentation", signature="data.table", - definition=function(object, ...) { + definition=function(object, verbose, ...) { + + ## Print status message + if (verbose) { + message("Segmenting copy number data") + } ## Split object by sample segDfTemp <- split(object, list(as.character(object$sample))) @@ -486,6 +499,39 @@ setMethod(f="getCnSegmentation", return(segmentationDF) }) +############################################################# +##### Function to generate segmentation dataset for cnv ##### +#' @rdname removeGapsSegmentation-methods +#' @name removeGapsSegmentation +#' @aliases removeGapsSegmentation +#' @param object of class data.table +#' @noRd +setMethod(f="removeGapsSegmentation", + signature="data.table", + definition=function(object, chrData, verbose, ...) { + + ## Print status message + if (verbose) { + message("Removing gaps from segmentation file") + } + + ## Get the list of the chromosomes + chrList <- as.list(as.character(unique(object$chrom))) + segs <- rbindlist(lapply(chrList, function(x, object, chrData) { + df <- object[chrom==x] + for (i in 1:(nrow(df) - 1)) { + ## Don't merge segments if they are far apart + if ((df$loc.start[i+1]-df$loc.end[i]) < 5000000) { + half <- floor((df$loc.end[i] + df$loc.start[i+1])/2) + df$loc.end[i] <- half + df$loc.start[i+1] <- half + 1 + } + } + return(df) + }, object=object)) + return(segs) + }) + ##################################################### ##### Function to get the chromosome boundaries ##### #' @rdname annoGenomeCoord-methods diff --git a/R/lohSpec-class.R b/R/lohSpec-class.R index 1282c28..5032f99 100644 --- a/R/lohSpec-class.R +++ b/R/lohSpec-class.R @@ -46,7 +46,7 @@ setClass( #' calcualting average LOH difference. Defaults to .50\% if FALSE. #' If TRUE, will use average normal VAF in each individual sample as value #' to calculate LOH. - +#' @export lohSpec <- function(input, lohSpec=TRUE, chromosomes="autosomes", samples=NULL, BSgenome=BSgenome, step=1000000, windowSize=2500000, normal=FALSE, gradientMidpoint=.2, gradientColors=c("#ffffff", "#b2b2ff", "#000000"), diff --git a/man/cnLoh-class.Rd b/man/cnLoh-class.Rd index fca9df4..97076fb 100644 --- a/man/cnLoh-class.Rd +++ b/man/cnLoh-class.Rd @@ -1,7 +1,7 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/combinedCnLoh-class.R -\name{cnLoh} -\alias{cnLoh} +\name{cnLoh-class} +\alias{cnLoh-class} \alias{cnLoh} \title{Class cnLoh} \usage{ diff --git a/man/getGrob-methods.Rd b/man/getGrob-methods.Rd index e132ee2..269fd30 100644 --- a/man/getGrob-methods.Rd +++ b/man/getGrob-methods.Rd @@ -41,9 +41,9 @@ getGrob(object, ...) \S4method{getGrob}{Waterfall}(object, index = 1, ...) -\S4method{getGrob}{cnLohPlots}(object, index = 1, ...) +\S4method{getGrob}{cnLohPlots}(object, index, ...) -\S4method{getGrob}{cnLoh}(object, index = 1, ...) +\S4method{getGrob}{cnLoh}(object, index, ...) \S4method{getGrob}{lohSpecPlots}(object, index = 1, ...) From cb3150a909712adca9685db656dfcb2835504e05 Mon Sep 17 00:00:00 2001 From: Jason Kunisaki Date: Fri, 20 Apr 2018 11:22:17 -0500 Subject: [PATCH 10/21] Structural Variant function update --- DESCRIPTION | 17 +- NAMESPACE | 9 + R/AllGenerics.R | 163 ++- R/StructuralVariant-class.R | 1217 +++++++++++++++++ R/VCF_Manta_v4.1-class.R | 235 ++++ R/VCF_Manta_v4.2-class.R | 235 ++++ R/VCF_Virtual-class.R | 44 + R/VEP-class.R | 6 +- R/VarScanFormat-class.R | 103 +- R/VariantCallFormat-class.R | 221 +++ R/deprecated-lohSpec.R | 680 +++++++++ R/lohSpec-class.R | 12 +- R/lohSpec.R | 177 --- R/lohSpec_buildMain.R | 68 - R/lohSpec_fileGlob.R | 99 -- R/lohSpec_lohCalc.R | 55 - R/lohSpec_qual.R | 104 -- R/lohSpec_slidingWindow.R | 48 - R/lohSpec_stepCalc.R | 75 - R/lohSpec_tileCalc.R | 47 - R/lohSpec_tilePosition.R | 46 - R/lohSpec_tileWindow.R | 36 - R/lohSpec_windowPosition.R | 48 - Rplot.png | Bin 356303 -> 0 bytes man/StructuralVariant-class.Rd | 19 + man/VCF_Manta_v4.1-class.Rd | 41 + man/VCF_Manta_v4.2-class.Rd | 41 + man/VCF_Virtual-class.Rd | 17 + man/VEP-class.Rd | 4 +- man/VarScanFormat-class.Rd | 3 +- man/VariantCallFormat-class.Rd | 60 + man/getData-methods.Rd | 14 +- man/getSample-methods.Rd | 7 +- man/getVcf-methods.Rd | 18 + man/lohSpec-class.Rd | 35 +- man/lohSpec.Rd | 2 +- man/lohSpec_buildMain.Rd | 2 +- man/lohSpec_fileGlob.Rd | 2 +- man/lohSpec_lohCalc.Rd | 2 +- man/lohSpec_qual.Rd | 2 +- man/lohSpec_slidingWindow.Rd | 2 +- man/lohSpec_stepCalc.Rd | 2 +- man/lohSpec_tileCalc.Rd | 22 - man/lohSpec_tilePosition.Rd | 22 - man/lohSpec_tileWindow.Rd | 24 - man/lohSpec_windowPosition.Rd | 2 +- man/svData-class.Rd | 80 ++ tests/testthat/test-VarScanFormat-class.R | 35 +- tests/testthat/test-VariantCallFormat-class.R | 83 ++ 49 files changed, 3308 insertions(+), 978 deletions(-) create mode 100644 R/StructuralVariant-class.R create mode 100644 R/VCF_Manta_v4.1-class.R create mode 100644 R/VCF_Manta_v4.2-class.R create mode 100644 R/VCF_Virtual-class.R create mode 100644 R/VariantCallFormat-class.R create mode 100644 R/deprecated-lohSpec.R delete mode 100644 R/lohSpec.R delete mode 100644 R/lohSpec_buildMain.R delete mode 100644 R/lohSpec_fileGlob.R delete mode 100644 R/lohSpec_lohCalc.R delete mode 100644 R/lohSpec_qual.R delete mode 100644 R/lohSpec_slidingWindow.R delete mode 100644 R/lohSpec_stepCalc.R delete mode 100644 R/lohSpec_tileCalc.R delete mode 100644 R/lohSpec_tilePosition.R delete mode 100644 R/lohSpec_tileWindow.R delete mode 100644 R/lohSpec_windowPosition.R delete mode 100644 Rplot.png create mode 100644 man/StructuralVariant-class.Rd create mode 100644 man/VCF_Manta_v4.1-class.Rd create mode 100644 man/VCF_Manta_v4.2-class.Rd create mode 100644 man/VCF_Virtual-class.Rd create mode 100644 man/VariantCallFormat-class.Rd create mode 100644 man/getVcf-methods.Rd delete mode 100644 man/lohSpec_tileCalc.Rd delete mode 100644 man/lohSpec_tilePosition.Rd delete mode 100644 man/lohSpec_tileWindow.Rd create mode 100644 man/svData-class.Rd create mode 100644 tests/testthat/test-VariantCallFormat-class.R diff --git a/DESCRIPTION b/DESCRIPTION index f665e26..ffbd1a1 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -45,11 +45,16 @@ Collate: 'MutationAnnotationFormat_v2.3-class.R' 'MutationAnnotationFormat_v2.4-class.R' 'Rainfall-class.R' + 'StructuralVariant-class.R' + 'VCF_Virtual-class.R' + 'VCF_Manta_v4.1-class.R' + 'VCF_Manta_v4.2-class.R' 'VEP_Virtual-class.R' 'VEP-class.R' 'VEP_v88-class.R' 'VarScanFormat_Virtual-class.R' 'VarScanFormat-class.R' + 'VariantCallFormat-class.R' 'Waterfall-class.R' 'cnFreq.R' 'cnFreq_buildMain.R' @@ -70,6 +75,7 @@ Collate: 'covBars.R' 'covBars_buildMain.R' 'covBars_qual.R' + 'deprecated-lohSpec.R' 'deprecated.R' 'genCov.R' 'genCov_alignPlot.R' @@ -100,17 +106,6 @@ Collate: 'ideoView_formatCytobands.R' 'ideoView_qual.R' 'lohSpec-class.R' - 'lohSpec.R' - 'lohSpec_buildMain.R' - 'lohSpec_fileGlob.R' - 'lohSpec_lohCalc.R' - 'lohSpec_qual.R' - 'lohSpec_slidingWindow.R' - 'lohSpec_stepCalc.R' - 'lohSpec_tileCalc.R' - 'lohSpec_tilePosition.R' - 'lohSpec_tileWindow.R' - 'lohSpec_windowPosition.R' 'lohView.R' 'lohView_buildMain.R' 'lohView_qual.R' diff --git a/NAMESPACE b/NAMESPACE index c3845c0..e5e0899 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -2,9 +2,11 @@ export(Clinical) export(GMS) +export(LohSpec) export(MutSpectra) export(MutationAnnotationFormat) export(Rainfall) +export(StructuralVariant) export(TvTi) export(VEP) export(VarScanFormat) @@ -15,6 +17,7 @@ export(cnSpec) export(cnView) export(compIdent) export(covBars) +export(extractVariantCallFormat) export(genCov) export(geneViz) export(ideoView) @@ -27,12 +30,15 @@ exportClasses(GMS) exportClasses(MutSpectra) exportClasses(MutationAnnotationFormat) exportClasses(Rainfall) +exportClasses(StructuralVariant) exportClasses(VEP) exportClasses(VarScanFormat) +exportClasses(VariantCallFormat) exportClasses(Waterfall) exportClasses(cnLoh) exportClasses(lohSpec) exportMethods(drawPlot) +exportMethods(extractVariantCallFormat) exportMethods(getData) exportMethods(getDescription) exportMethods(getGrob) @@ -97,6 +103,7 @@ importFrom(data.table,is.data.table) importFrom(data.table,melt) importFrom(data.table,rbindlist) importFrom(data.table,setDT) +importFrom(ggforce,geom_bezier) importFrom(ggplot2,ggplotGrob) importFrom(grDevices,colors) importFrom(grid,grid.draw) @@ -109,6 +116,8 @@ importFrom(gtable,gtable) importFrom(gtable,gtable_add_grob) importFrom(gtable,gtable_add_rows) importFrom(gtools,mixedsort) +importFrom(karyoploteR,getCytobandColors) +importFrom(karyoploteR,getCytobands) importFrom(plyr,adply) importFrom(plyr,count) importFrom(plyr,ldply) diff --git a/R/AllGenerics.R b/R/AllGenerics.R index c0552f4..994147f 100644 --- a/R/AllGenerics.R +++ b/R/AllGenerics.R @@ -332,26 +332,26 @@ setGeneric( def=function(object, ...){standardGeneric("drawPlot")} ) -#' Method parseDescription +#' Method parseHeader #' -#' @name parseDescription -#' @rdname parseDescription-methods +#' @name parseHeader +#' @rdname parseHeader-methods #' @param ... additional arguments to passed #' @noRd setGeneric( - name="parseDescription", - def=function(object, ...){standardGeneric("parseDescription")} + name="parseHeader", + def=function(object, ...){standardGeneric("parseHeader")} ) -#' Method parseHeader +#' Method parseDescription #' -#' @name parseHeader -#' @rdname parseHeader-methods +#' @name parseDescription +#' @rdname parseDescription-methods #' @param ... additional arguments to passed #' @noRd setGeneric( - name="parseHeader", - def=function(object, ...){standardGeneric("parseHeader")} + name="parseDescription", + def=function(object, ...){standardGeneric("parseDescription")} ) #' Method parseExtra @@ -544,13 +544,6 @@ setGeneric( def=function(object, ...){standardGeneric("lohSpec_qual")} ) -#' Method annoGenomeCoord -#' -#' @name annoGenomeCoord -#' @rdname annoGenomeCoord-methods -#' @param object Object of class VarScanFormat -#' @param ... additional arguments to passed - #' Method toRainfall #' #' @name toRainfall @@ -588,6 +581,7 @@ setGeneric( #' #' @name annoGenomeCoord #' @rdname annoGenomeCoord-methods +#' @param object object of class data.table #' @param ... additional arguments to passed #' @noRd setGeneric( @@ -595,6 +589,18 @@ setGeneric( def=function(object, ...){standardGeneric("annoGenomeCoord")} ) +#' Method annoGenomeCoordSv +#' +#' @name annoGenomeCoordSv +#' @rdname annoGenomeCoordSv-methods +#' @param object object of class data.table +#' @param ... additional arguments to passed +#' @noRd +setGeneric( + name="annoGenomeCoordSv", + def=function(object, ...){standardGeneric("annoGenomeCoordSv")} +) + #' Method getLohSlidingWindow #' #' @name getLohSlidingWindow @@ -687,6 +693,7 @@ setGeneric( #' #' @name chrSubset #' @rdname chrSubset-methods +#' @param object object of class data.table #' @param ... additional arguments to passed #' @noRd setGeneric( @@ -694,25 +701,27 @@ setGeneric( def=function(object, ...){standardGeneric("chrSubset")} ) -#' Method sampleSubset +#' Method chrSubsetSv #' -#' @name sampleSubset -#' @rdname sampleSubset-methods +#' @name chrSubsetSv +#' @rdname chrSubsetSv-methods +#' @param object object of class data.table #' @param ... additional arguments to passed #' @noRd setGeneric( - name="sampleSubset", - def=function(object, ...){standardGeneric("sampleSubset")} + name="chrSubsetSv", + def=function(object, ...){standardGeneric("chrSubsetSv")} ) -#' Method chrSubset + +#' Method sampleSubset #' -#' @name chrSubset -#' @rdname chrSubset-methods +#' @name sampleSubset +#' @rdname sampleSubset-methods #' @param ... additional arguments to passed #' @noRd setGeneric( - name="chrSubset", - def=function(object, ...){standardGeneric("chrSubset")} + name="sampleSubset", + def=function(object, ...){standardGeneric("sampleSubset")} ) #' Method highlightSampleData @@ -835,3 +844,103 @@ setGeneric( name="removeGapsSegmentation", def=function(object, ...){standardGeneric("removeGapsSegmentation")} ) + +#' Method getVcf +#' +#' @name getVcf +#' @rdname getVcf-methods +#' @param ... additional arguments to passed +#' @exportMethod getSample +setGeneric( + name="getVcf", + def=function(object, ...){standardGeneric("getVcf")} +) + +#' Method filterStructuralVariant +#' +#' @name filterStructuralVariant +#' @rdname filterStructuralVariant-methods +#' @param ... additional arguments to passed +#' @noRd +setGeneric( + name="filterStructuralVariant", + def=function(object, ...){standardGeneric("filterStructuralVariant")} +) + +#' Method annotateSV +#' +#' @name annotateSV +#' @rdname annotateSV-methods +#' @param ... additional arguments to passed +#' @noRd +setGeneric( + name="annotateSV", + def=function(object, ...){standardGeneric("annotateSV")} +) + +#' Method countGenes +#' +#' @name countGenes +#' @rdname countGenes-methods +#' @param ... additional arguments to passed +#' @noRd +setGeneric( + name="countGenes", + def=function(object, ...){standardGeneric("countGenes")} +) + +#' Method getStructuralVariantWindow +#' +#' @name getStructuralVariantWindow +#' @rdname getStructuralVariantWindow-methods +#' @param ... additional arguments to passed +#' @noRd +setGeneric( + name="getStructuralVariantWindow", + def=function(object, ...){standardGeneric("getStructuralVariantWindow")} +) + +#' Method buildSvPlot +#' +#' @name buildSvPlot +#' @rdname buildSvPlot-methods +#' @param ... additional arguments to passed +#' @noRd +setGeneric( + name="buildSvPlot", + def=function(object, ...){standardGeneric("buildSvPlot")} +) + +#' Method svCytobands +#' +#' @name svCytobands +#' @rdname svCytobands-methods +#' @param ... additional arguments to passed +#' @noRd +setGeneric( + name="svCytobands", + def=function(object, ...){standardGeneric("svCytobands")} +) + +#' Method adjustCentromeres +#' +#' @name adjustCentromeres +#' @rdname adjustCentromeres-methods +#' @param ... additional arguments to passed +#' @noRd +setGeneric( + name="adjustCentromeres", + def=function(object, ...){standardGeneric("adjustCentromeres")} +) + +#' Method extractVariantCallFormat +#' +#' @name extractVariantCallFormat +#' @rdname extractVariantCallFormat-methods +#' @param ... additional arguments to passed +#' @noRd +#' @exportMethod extractVariantCallFormat +setGeneric( + name="extractVariantCallFormat", + def=function(object, ...){standardGeneric("extractVariantCallFormat")} +) \ No newline at end of file diff --git a/R/StructuralVariant-class.R b/R/StructuralVariant-class.R new file mode 100644 index 0000000..67c418d --- /dev/null +++ b/R/StructuralVariant-class.R @@ -0,0 +1,1217 @@ +################################################################################ +##################### Public/Private Class Definitions ######################### + +#!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Public Class !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!# + +#' Class StructuralVariant +#' +#' An S4 class for the Structural Variant plot object +#' @rdname StructuralVariant-class +#' @name StructuralVariant +#' @slot primaryData data.table object storing primarydata used for plotting +#' @slot geneData data.table object storing annotated gene files +#' @slot Grob gtable object for the structural variant plot +#' @import methods +#' @importFrom gtable gtable +#' @importFrom data.table data.table +#' @exportClass StructuralVariant +setClass("StructuralVariant", + representation=representation(svData="data.table", + geneData="data.table"), + validity=function(object) { + + }) + +#' Constuctor for the Structural Variant class +#' +#' @name svData +#' @rdname svData-class +#' @param object Object of class VCF +#' @rdname StructuralVariant-class +#' @name StructuralVariant +#' @param object OBject of class VCF +#' @param BSgenome Object of class BSgenome to extract genome wide chromosome +#' coordinates +#' @param filter Boolean specifying if SV calls that did not pass should be removed +#' @param svType Character vector specifying which structural variant types to annotate/visualize +#' @param svOrder Character vector specifying the deleterious order of sv types (most to least deleterious) +#' @param maxSvSize Numeric specifying the maximum size of SV events (DEL/DUP/INV only) +#' @param sample Character vector specifying which samples to annotate/visualize +#' @param chromosomes Character vector specifying chromosomes to annotate/visualize +#' @param ensembl Object of class Mart to use in biomaRt query +#' @param attributes Character vector specifying which attributes to retrieve from biomaRt query +#' @param filters Character vector specifying which filters to use in biomaRt query +#' @param annotate Boolean specifying if the user wants to obtain mutated gene counts and annotate SV events +#' @param geneAnnotationFlank Integer specifying the size of the flanks of each SV event +#' to include in the annotation step +#' @param plotSpecificGene Character vector specifying which genes to plot +#' @param plotGene1 Boolean specifying if TRA genes should be plotted +#' @param plotGene2 Boolean specifying if non-TRA genes should be plotted +#' @param chrGap Integer specifying the size of the gap between the 1st and 2nd chromosome +#' @param genome Character vector specifying which genome to use to obtain chromosome bands. +#' Serves as input into the getCytobands function of karyoploteR. +#' @param cytobandColor Character vector specifying what to color the chromosome bands +#' @param sampleColor Character vector specifying colors to plot for each sample +#' @param plotALAyers List of ggplot2 layers to be passed to translocation plot +#' @param plotBLayers List of ggplot2 layers to be passed to chromosome plot +#' @param plotCLayers List of ggplot2 layers to be passed to non-translocation plot +#' @param outputDir Character value for directory to output SV visualizations +#' @param plotWidth Integer for width of SV visualizations +#' @param plotHeight Integer for height of SV visualizations +#' @param verbose Boolean specifying if status messages should be reported +#' @export +StructuralVariant <- function(input, BSgenome=NULL, filter=TRUE, svType=NULL, + svOrder=c("TRA", "BND", "DEL", "DUP", "INV", "INS"), + maxSvSize=NULL, sample=NULL, chromosomes=NULL, + ensembl=ensembl, attributes=attributes, filters=filters, + annotate=TRUE, geneAnnotationFlank=10000, + plotSpecificGene=FALSE, plotGene1=FALSE, + plotGene2=FALSE, chrGap=5000000, + genome="hg19", cytobandColor=c("White", "Grey"), + sampleColor=NULL, verbose=FALSE, plotALayers=NULL, + plotBLayers=NULL, plotCLayers=NULL, + outputDir="~/Desktop", plotWidth=15, plotHeight=12) { + + ## Calculate all data for the plots + svDataset <- svData(object=input, BSgenome=BSgenome, filter=filter, svType=svType, svOrder=svOrder, + maxSvSize=maxSvSize, sample=sample, chromosomes=chromosomes, + ensembl=ensembl, attributes=attributes, filters=filters, chrGap=chrGap, annotate=annotate, + geneAnnotationFlank=geneAnnotationFlank, genome=genome, verbose=verbose) + + ## Create the plots from svData + structuralVariantPlots <- svPlots(object=svDataset, plotSpecificGene=plotSpecificGene, + plotGene1=plotGene1, plotGene2=plotGene2, cytobandColor=cytobandColor, + plotALayers=plotALayers, plotBLayers=plotBLayers, + plotCLayers=plotCLayers, sectionHeights=sectionHeights, + sample=sample, sampleColor=sampleColor, plotWidth=plotWidth, plotHeight=plotHeight, + outputDir=outputDir, verbose=verbose) + + ## Intialize the object + new("StructuralVariant", svData=getData(object=svDataset, name="primaryData"), + geneData=getData(object=svDataset, name="geneData")) + +} + +#!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Private Classes !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!# + +#' Private Class svData +#' +#' An S4 class for the data of the sv plot object +#' @name svData-class +#' @noRd +setClass("svData", + representation=representation(primaryData="data.table", + geneData="data.table", + chrData="data.table", + svWindow="data.table", + cytobands="data.table"), + validity=function(object){ + + }) + +#' Constructor for the svData class +#' +#' @name svData +#' @rdname svData-class +#' @name StructuralVariant +#' @importFrom data.table data.table +#' @noRd +svData <- function(object, BSgenome, filter, svType, svOrder, maxSvSize, sample, + chromosomes, ensembl, attributes, filters, annotate, geneAnnotationFlank, chrGap, genome, + verbose) { + + browser() + + ## Subset data to only passed sv calls + primaryData <- filterStructuralVariant(object=object, + filter=filter, maxSvSize=maxSvSize, + svType=svType, verbose=verbose) + + ## Subset data to only the chromosomes desired to be plotted + primaryData <- chrSubsetSv(object=primaryData, chromosomes=chromosomes, verbose=verbose) + + ## Subset data to only the samples desired to be plotted + primaryData <- sampleSubset(object=primaryData, samples=sample, verbose=verbose) + + ## Obtain chromosome boundaries from BSgenome object + chrData <- annoGenomeCoordSv(object=primaryData, BSgenome=BSgenome, + verbose=verbose) + + ## Annotate the sv calls + primaryData <- annotateSV(object=primaryData, ensembl=ensembl, attributes=attributes, filters=filters, + annotate=annotate, geneAnnotationFlank=geneAnnotationFlank, chromosomes=chromosomes, + verbose=verbose) + + ## Get the proportion of samples that have each mutated gene + geneData <- countGenes(object=primaryData, annotate=annotate, svOrder=svOrder, verbose=verbose) + + ## Get the cytoband data + chrCytobands <- svCytobands(object=primaryData, genome=genome, chrData=chrData, verbose=verbose) + + ## Adjust the primaryData to account for centromeres + adjustedPrimaryData <- adjustCentromeres(object=primaryData, chrCytobands=chrCytobands, verbose=verbose) + + ## Get the new positions for SV calls and cytobands + svWindow <- getStructuralVariantWindow(object=adjustedPrimaryData, chrCytobands=chrCytobands, chrData=chrData, + chrGap=chrGap, verbose=verbose) + + ## Initialize the object + new("svData", primaryData=primaryData, geneData=geneData, chrData=chrData, svWindow=svWindow, cytobands=chrCytobands) +} + +#' Private Class svPlots +#' +#' An S4 class for the of the svData class +#' @name svPlots-class +#' @rdname svPlots-class +#' @slot Plots list of gtables for each chr combo +#' @import methods +#' @importFrom gtable gtable +#' @noRd +setClass("svPlots", + representation=representation(plots="list"), + validity = function(object) { + + }) + +#' Constructor for the svPlots class +#' +#' @name svPlots +#' @rdname svPlots-class +#' @param object Object of class svData +#' @importFrom gtable gtable +#' @noRd +svPlots <- function(object, plotSpecificGene, plotGene1, plotGene2, cytobandColor, + plotALayers, plotBLayers, plotCLayers, sectionHeights, + sample, sampleColor, plotWidth, plotHeight, outputDir, verbose, ...) { + + ## Create the gtable for the plots + svGtables <- buildSvPlot(object=object, plotSpecificGene=plotSpecificGene, + plotGene1=plotGene1, plotGene2=plotGene2, cytobandColor=cytobandColor, + plotALayers=plotALayers, plotBLayers=plotBLayers, + plotCLayers=plotCLayers, sectionHeights=sectionHeights, sample=sample, + sampleColor=sampleColor, plotWidth=plotWidth, plotHeight=plotHeight, + outputDir=outputDir, verbose=verbose) + + ## Initialize the object + new("svPlots", plots=svGtables) + +} + +################################################################################ +###################### Accessor function definitions ########################### + +#' Helper function to get data from classes +#' +#' @rdname getData-methods +#' @aliases getData +.getData_structuralVariants <- function(object, name=NULL, index=NULL, ...) { + if(is.null(name) & is.null(index)){ + memo <- paste("Both name and index are NULL, one must be specified!") + stop(memo) + } + + if(is.null(index)){ + index <- 0 + } else { + if(index > 5){ + memo <- paste("index out of bounds") + stop(memo) + } + } + + if(is.null(name)){ + name <- "noMatch" + } else { + slotAvailableName <- c("primaryData", "geneData", "chrData", "svWindow", "cytobands") + if(!(name %in% slotAvailableName)){ + memo <- paste("slot name not found, specify one of:", toString(slotAvailableName)) + stop(memo) + } + } + + if(name == "primaryData" | index == 1){ + data <- object@primaryData + } + if(name == "geneData" | index == 2){ + data <- object@geneData + } + + return(data) +} + +#' @rdname getData-methods +#' @aliases getData +setMethod(f="getData", + signature="svData", + definition=.getData_structuralVariants) + +################################################################################ +#################### Method function definitions ############################### + +#' @rdname filterStructuralVariant-methods +#' @aliases filterStructuralVariant +#' @param object Object of class VCF +#' @param verbose Boolean speifying if status messages should be reported +#' @importFrom data.table data.table +#' @noRd +setMethod(f="filterStructuralVariant", + signature="VariantCallFormat", + definition=function(object, filter, maxSvSize, svType, + verbose, ...) { + + ## Print status message + if (verbose) { + memo <- paste0("converting ", class(object), " to expected ", + "StructuralVariant format") + message(memo) + } + + available_svTypes <- paste(as.vector(object@vcfObject@svType$svtype), collapse=", ") + object <- object@vcfObject@vcfData + + ## Filter out sv calls that are not "PASS" + if (filter == TRUE) { + object <- object[FILTER=="PASS"] + } + + ## Remove large SV + if (is.null(maxSvSize) == FALSE) { + ## Get the difference in positions + temp <- suppressWarnings(data.table::rbindlist(apply(object, 1, function(x, maxSvSize){ + if (x["svtype"] == "BND" | x["svtype"] == "TRA"){ + x$diff <- maxSvSize - 1 + } else { + x$diff <- as.numeric(x["position2"]) - as.numeric(x["position"]) + } + return(x) + }, maxSvSize=maxSvSize))) + + ## Perform the subset + object <- temp[diff < maxSvSize, c(1:15)] + } + + ## Remove sv types that are not necessary + if (is.null(svType) == FALSE) { + ## Check to see if the SV type is in the data.table + ## Perform the subset if svtype is available + if (svType %in% available_svTypes) { + object <- object[svtype==svType] + } + if (!(svType %in% available_svTypes)) { + input@vcfObject@svType + memo <- paste0("Desired svtype is not found. Make sure ", + "the specified svType is one of: ", available_svTypes) + } + + } + return(object) + + }) + +###################################################### +##### Function to obtain chromosomes of interest ##### +#' @rdname svData-methods +#' @aliases svData +#' @param object Object of class data.table +#' @param chromosomes character vector of chromosomes to retain +#' @param verbose Boolean for status updates +#' @return data.table object with calculated mutation distances +#' @importFrom data.table data.table +#' @noRd +setMethod(f="chrSubsetSv", + signature="data.table", + definition=function(object, chromosomes, verbose, ...){ + + # print status message + if(verbose){ + memo <- paste("Performing chromosome subsets") + message(memo) + } + + # if chromosomes is null we dont want to do anything just return the object back + if(is.null(chromosomes)){ + return(object) + } + + # perform quality checks on the chromosome parameter arguments + + # check for character vector + if(!is.character(chromosomes)){ + memo <- paste("Input to chromosomes should be a character vector, + specifying which chromosomes to plot, + attempting to coerce...") + warning(memo) + chromosomes <- as.character(chromosomes) + } + + ## Check format of the chromosome column + if (!all(grepl("^chr", object$chromosome))) { + if (verbose) { + memo <- paste0("Did not detect the prefix chr in the chromosome1 column", + "of x... adding prefix") + message (memo) + } + object$chromosome <- paste("chr", object$chromosome, sep="") + } else if (all(grepl("^chr", object$chromosome))) { + if (verbose) { + memo <- paste0("Detected chr in the chromosome1 column of x...", + "proceeding") + message(memo) + } + } else { + memo <- paste0("Detected unknown or mixed prefixes in the chromosome1", + " colum of object... should either be chr or non (i.e.) chr1 or 1") + message(memo) + } + + ## Check format of the chromosome2 column + if (!all(grepl("^chr", object$chromosome2))) { + if (verbose) { + memo <- paste0("Did not detect the prefix chr in the chromosome2 column", + "of x... adding prefix") + message (memo) + } + object$chromosome2 <- paste("chr", object$chromosome2, sep="") + } else if (all(grepl("^chr", object$chromosome2))) { + if (verbose) { + memo <- paste0("Detected chr in the chromosome2 column of x...", + "proceeding") + message(memo) + } + } else { + memo <- paste0("Detected unknown or mixed prefixes in the chromosome2", + " colum of object... should either be chr or non (i.e.) chr1 or 1") + message(memo) + } + + ## Determine which chromosomes to plot + ## Only include autosomes + if (chromosomes[1] == "autosomes") { + chromosomes <- as.character(c(seq(1:22))) + } + ## Include all chromosomes + if (chromosomes[1] == "all") { + chromosomes <- unique(object$chromosome) + chromosomes <- chromosomes[-grep("GL", chromosomes)] + chromosomes <- chromosomes[-grep("MT", chromosomes)] + } + + # check for specified chromosomes not in the original input + missingChr <- chromosomes[!(chromosomes %in% unique(object$chromosome) & + chromosomes %in% unique(object$chromosome2))] + if(length(missingChr) != 0){ + memo <- paste("The following chromosomes were designated to be kept but were not found:", + toString(missingChr), "\nValid chromosomes are", toString(unique(object$chromosome))) + warning(memo) + } + + # perform the subset + object <- object[-grep("GL", object$chromosome)] + object <- object[-grep("MT", object$chromosome)] + object <- object[-grep("GL", object$chromosome2)] + object <- object[-grep("MT", object$chromosome2)] + object <- object[object$chromosome %in% chromosomes | object$chromosome2 %in% chromosomes,] + object$chromosome <- factor(object$chromosome) + object$chromosome2 <- factor(object$chromosome2) + + ## Remove rows that are duplciated in the ID column + object <- object[!duplicated(object$ID)] + + # check that the object has a size after subsets + if(nrow(object) < 1){ + memo <- paste("no entries left to plot after chromosome subsets") + stop(memo) + } + + return(object) + }) + +##################################################### +##### Function to get the chromosome boundaries ##### +#' @rdname annoGenomeCoordSv-methods +#' @aliases annoGenomeCoordSv +#' @param object Object of class data.table +#' @param BSgenome Object of class BSgenome, used for extracting chromosome boundaries +#' @param verbose Boolean for status updates +#' @return Data.table with chr and start/stop positions +#' @importFrom GenomeInfoDb seqlengths +#' @importFrom data.table data.table +#' @importFrom data.table rbindlist +#' @importFrom gtools mixedsort +#' @noRd +setMethod(f="annoGenomeCoordSv", + signature="data.table", + definition=function(object, BSgenome, verbose, ...){ + + ## Print status message + if (verbose) { + memo <- paste("Acquiring chromosome boundaries from BSgenome object") + message(memo) + } + + ## Perform quality check on BSgenome object + if (is.null(BSgenome)) { + memo <- paste("BSgenome object is not specified, whole chromosomes", + "will not be plotted, this is not recommended!") + warning(memo) + object$chromosome <- factor(object$chromosome, levels=gtools::mixedsort(unique(as.character(object$chromosome)))) + object$chromosome2 <- factor(object$chromosome2, levels=gtools::mixedsort(unique(as.character(object$chromosome2)))) + + return(object) + } else if (is(BSgenome, "BSgenome")) { + if(verbose){ + memo <- paste("BSgenome passed object validity checks") + } + } else { + memo <- paste("class of the BSgenome object is", class(BSgenome), + "should either be of class BSgenome or NULL", + "setting this to param to NULL") + warning(memo) + BSgenome <- NULL + } + + ## Create a data table of genomic coordinates end positions + genomeCoord <- data.table::as.data.table(seqlengths(BSgenome)) + colnames(genomeCoord) <- c("end") + genomeCoord$chromosome <- names(seqlengths(BSgenome)) + genomeCoord$start <- 1 + + ## Get all of the chromosomes that are in the SV dataset + all_chr <- unique(c(as.character(object$chromosome), as.character(object$chromosome2))) + + ## Check that chromosomes between BSgenome and original input match + chrMismatch <- all_chr[!all_chr %in% genomeCoord$chromosome] + if (length(chrMismatch) >= 1) { + memo <- paste("The following chromosomes do not match the supplied BSgenome object", + toString(chrMismatch)) + warning(memo) + + ## Test if the chr mismatch is fixed by appending chr to chromosomes + all_chr <- paste("chr", all_chr, sep="") + chrMismatch_appendChr <- all_chr[!all_chr %in% genomeCoord$chromosome] + if(chrMismatch_appendChr < length(chrMismatch)){ + memo <- paste("appending \"chr\" to chromosomes in attempt to fix mismatch with the BSgenome") + warning(memo) + object$chromosome <- paste0("chr", object$chromosome) + } + } + + ## Check to see if any chromosomes in the original input dataset lack genomic coordiantes + if (any(!all_chr %in% unique(genomeCoord$chromosome))) { + missingGenomeCoord <- unique(object$chromosome) + missingGenomeCoord <- missingGenomeCoord[!missingGenomeCoord %in% unique(genomeCoord_a$chromosome)] + memo <- paste("The following chromosomes are missing genomic coordinates", toString(missingGenomeCoord), + "Full genomic coordinates will not be plotted for these chromosomes") + warning(memo) + } + + ## Filter the genomeCoord objext to only inlcude chromosomes in the input data + genomeCoord <- genomeCoord[genomeCoord$chromosome %in% all_chr,] + + return(genomeCoord) + + }) + +################################################## +##### Function to obtain samples of interest ##### +#' @rdname svData-methods +#' @aliases svData +#' @param object Object of class data.table +#' @param samples character vector of samples to retain +#' @param verbose Boolean for status updates +#' @return data.table object with calculated mutation distances +#' @importFrom data.table data.table +#' @noRd +setMethod(f="sampleSubset", + signature="data.table", + definition=function(object, samples, verbose, ...){ + + # print status message + if(verbose){ + memo <- paste("Performing sample subsets") + message(memo) + } + + ## If samples is null, we don't want to do anything and just return the object + if (is.null(samples)) { + return(object) + } + + ## Perform quality checkes on the sample parameter arguments + if (!is.character(samples)) { + memo <- paste("Input to samples should be a character vector, + attempting to coerce...") + warning(memo) + } + + ## Check for specified samples not in the original input + missingSamp <- samples[!samples %in% unique(object$sample)] + if (length(missingSamp) != 0) { + memo <- paste("The following samples were designated to be + kept but were not found:", toString(missingSamp), + "\nValid csamples are", + toString(unique(object$sample))) + warning(memo) + } + + ## Perform the subset + object <- object[object$sample %in% samples] + object$sample <- factor(object$sample) + + ## Remove rows that are duplciated in the ID column + object <- object[!duplicated(object$ID)] + + ## Check that the object has a size after subsets + if(nrow(object) < 1){ + memo <- paste("no entries left to plot after chromosome subsets") + stop(memo) + } + + return(object) + }) + +########################################## +##### Function to annotate SV events ##### +#' @rdname svData-methods +#' @aliases svData +#' @param object Object of class data.table +#' @param samples character vector of samples to retain +#' @param verbose Boolean for status updates +#' @return data.table object with calculated mutation distances +#' @importFrom data.table data.table +#' @noRd +setMethod(f="annotateSV", + signature="data.table", + definition=function(object, annotate, ensembl, attributes, filters, geneAnnotationFlank, + chromosomes, verbose, ...){ + + if (annotate == TRUE) { + # print status message + if(verbose){ + memo <- paste("Annotating sv positions") + message(memo) + } + + ## Define the chromosomes to annotate + all_chr <- unique(c(as.character(object$chromosome), as.character(object$chromosome2))) + + ## Go through each row of the primaryData dataset and run through biomaRt + annotatedDf <- data.table::rbindlist(apply(object, 1, function(x, object, ensembl, attributes, filters, + geneAnnotationFlank, verbose){ + x <- data.table(t(x)) + if (verbose) { + num <- which(object$chromosome==x$chromosome & + as.numeric(object$position)==as.numeric(as.character(x$position)) & + object$chromosome2==x$chromosome2 & + as.numeric(object$position2)==as.numeric(as.character(x$position2))) + print(paste("Annotating call: ", num, "/", nrow(object), sep="")) + } + ## Get the breakpoint information + chr1 <- as.character(x$chromosome[1]) + chr2 <- as.character(x$chromosome2[1]) + chr1 <- gsub(pattern="chr", replacement="", x=chr1) + chr2 <- gsub(pattern="chr", replacement="", x=chr2) + pos1 <- as.numeric(x$position[1]) + leftPos1 <- pos1 + rightPos1 <- pos1 + pos2 <- as.numeric(x$position2[1]) + leftPos2 <- pos2 + rightPos2 <- pos2 + if (geneAnnotationFlank > 0) { + leftPos1 <- pos1 - geneAnnotationFlank + rightPos1 <- pos1 + geneAnnotationFlank + leftPos2 <- pos2 - geneAnnotationFlank + rightPos2 <- pos2 + geneAnnotationFlank + } + + ## Annotate the first breakpoint (TRA and BND) + if (x$svtype == "BND" | x$svtype == "TRA") { + gene1 <- getBM(attributes=attributes, filters=filters, + values=list("chr"=chr1, "start"=leftPos1, "end"=rightPos1), mart=ensembl)$hgnc_symbol + gene2 <- getBM(attributes=attributes, filters=filters, + values=list("chr"=chr2, "start"=leftPos2, "end"=rightPos2), mart=ensembl)$hgnc_symbol + + genes <- paste(c(gene1, gene2), collapse="|") + } + if (x$svtype == "DEL" | x$svtype == "DUP" | x$svtype == "INV" | x$svtype == "INS") { + genes <- as.character(getBM(attributes=attributes, filters=filters, + values=list("chr"=chr1, "start"=leftPos1, "end"=rightPos2), + mart=ensembl)$hgnc_symbol) + genes <- paste(genes, collapse="|") + } + + ## Substitute "pseudogene" and "" for "No Gene" + genes <- gsub(pattern="Pseudogene", replacement="No Gene", x=genes) + if (genes=="") { + genes <- "No Gene" + } + + ## Append genes to the dataset + x$genes <- genes + + return(x) + }, + object=object, ensembl=ensembl, attributes=attributes, filters=filters, + geneAnnotationFlank=geneAnnotationFlank, verbose=verbose)) + + ## Get the columns of interest + cols <- c("chromosome", "position", "chromosome2", "position2", "direction", + "svtype", "total_read_support", "sample", "ID", + "tumorSample", "genes") + annotatedDf <- annotatedDf[,which(colnames(annotatedDf) %in% cols),with=FALSE] + } + if (annotate == FALSE) { + annotatedDf <- object + annotatedDf$genes <- "" + } + return(annotatedDf) + }) + +################################################################################# +##### Function to count the number/proportion of samples with mutated genes ##### +#' @rdname svData-methods +#' @aliases svData +#' @param object Object of class data.table +#' @param samples character vector of samples to retain +#' @param verbose Boolean for status updates +#' @return data.table object with calculated mutation distances +#' @importFrom data.table as.data.table +#' @noRd +setMethod(f="countGenes", + signature="data.table", + definition=function(object, annotate, svOrder, verbose, ...) { + + if (annotate) { + ## Print status message + if (verbose) { + message("Calculating proportion of samples with mutations in each gene.") + } + + ## Get the list of mutated genes + object <- object[-which(object$genes == "No Gene")] + genes <- data.table(unique(unlist(strsplit(object$genes, split="|", fixed=TRUE)))) + + ## Get the total number of samples + sample_num <- length(unique(object$sample)) + + ## Go through the list of genes and see how many times/samples it is mutated + final_df <- data.table::rbindlist(apply(genes, 1, function(x, object, svOrder, sample_num) { + ## Get the rows with the genes + mt <- object[unique(grep(x, object$genes)), + c("svtype", "sample","total_read_support")] + mt$gene <- x + mt$total_sample_num <- sample_num + + ## Split the rows by sample and get top sv type + samples <- split(mt, mt$sample) + mt <- data.table::rbindlist(lapply(samples, function(y, svOrder) { + ## Set the order + setDT(y)[,y := factor(svtype, levels=svOrder)] + y <- y[order(svtype, -total_read_support),] + + ## Get the top row + final <- y[1,c(1:5)] + + ## Reorder the columns + final <- final[,c("gene", "sample", "svtype", + "total_read_support")] + return(final) + + }, + svOrder=svOrder)) + + ## Count the number of samples with each svtype + mutated_samples <- paste(mt$sample, collapse="|") + svtype <- paste(mt$svtype, collapse="|") + trs <- paste(mt$total_read_support, collapse="|") + proportion <- length(unique(mt$sample))/sample_num + + ## Make the final dataset + final <- data.table::data.table(gene=x, sample=mutated_samples, + svtype=svtype, total_read_support=trs, + proportion=proportion, total_sample_num=sample_num) + + return(final) + + }, + object=object, svOrder=svOrder, sample_num=sample_num)) + + ## Order the final_df dataset by proportion + final_df <- final_df[order(-proportion, sample, svtype),] + } + if (annotate==FALSE) { + final_df <- data.table::data.table(gene="", sample="", svtype="", + total_read_support="", proportion="", + total_sample_num="") + } + return(final_df) + }) + +################################################ +##### Function to create cytobands dataset ##### +#' @rdname svData-methods +#' @aliases svData +#' @param object Object of class data.table +#' @param samples character vector of samples to retain +#' @param verbose Boolean for status updates +#' @return data.table object with calculated mutation distances +#' @importFrom data.table data.table +#' @importFrom data.table as.data.table +#' @importFrom karyoploteR getCytobands +#' @importFrom karyoploteR getCytobandColors +#' @noRd +setMethod(f="svCytobands", + signature="data.table", + definition=function(object, genome, chrData, verbose) { + #browser() + ## Print status message + if (verbose) { + message("Subsetting cytoband dataset.") + } + + cytoband <- data.table::as.data.table(suppressMessages(getCytobands(genome=genome, use.cache = TRUE))) + colnames(cytoband) <- c("chromosome", "start", "end", "width", "strand", "band", "stain") + + ## Subset the dataset by the chromosome + cytoband <- cytoband[which(chromosome %in% chrData$chromosome)] + + ## Rename the cytoband + cytoband$band <- paste(cytoband$chromosome, cytoband$band, sep="") + cytoband$band <- gsub("chr", "", cytoband$band) + + ## Get the centromere positions + temp <- split(cytoband, f=as.character(cytoband$chromosome)) + finalCytoband <- data.table::rbindlist(lapply(temp, function(x, chrData){ + ## Get the chromosome length + chrLength <- as.numeric(chrData[chromosome==x$chromosome[1],"end", with=FALSE]) + ## Get the size of what the centromere should be + centromere <- chrLength*0.05 + pBands <- x[grep("p", x$band),] + ## Get the start/stop position of the centromere + centromereStart <- pBands$end[nrow(pBands)] + centromereEnd <- centromereStart + centromere + centromereData <- data.table(chromosome=as.character(x$chromosome[1]), start=centromereStart, end=centromereEnd, + width=0, strand="*", band="centromere", stain="black") + ## Get the new positions for the q bands + qBands <- x[grep("q", x$band),] + qBands$start <- qBands$start + centromere + qBands$end <- qBands$end + centromere + + final <- rbind(pBands, centromereData, qBands) + return(final) + }, chrData=chrData)) + return(finalCytoband) + }) + +########################################################### +##### Function to adjust sv positions for centromeres ##### +#' @rdname svData-methods +#' @aliases svData +#' @param object Obejct of class data.table +#' @param chrCytobands Data.table with cytoband and centromere data +#' @param verbose Boolean for status updates +#' @return data.table object with adjusted sv positions +#' @importFrom data.table data.table +#' @noRd +setMethod(f="adjustCentromeres", + signature="data.table", + definition=function(object, chrCytobands, verbose) { + #browser() + ## Print status message + if (verbose){ + message("Adjusting positions of structural variants to account for centromere to aid in visualization.") + } + + ## Convert column values + object$chromosome <- as.character(object$chromosome) + object$position <- as.numeric(object$position) + object$chromosome2 <- as.character(object$chromosome2) + object$position2 <- as.numeric(object$position2) + + ## Adjust the sv positions for the centromeres + all_chr <- unique(c(object$chromosome, object$chromosome2)) + for (i in 1:length(all_chr)) { + chr <- as.character(all_chr[i]) + + ## Get the centromere positions + centromereStart <- chrCytobands[chromosome==chr & band=="centromere", start] + centromereEnd <- chrCytobands[chromosome==chr & band=="centromere", end] + centromereLength <- centromereEnd-centromereStart + + ## For all genomic coordinates that are downstream of the centromere, add the centromere length + num <- which(object$chromosome==chr & object$position >= centromereStart) + if (length(num) > 0) { + object$position[num] <- object$position[num] + centromereLength + } + num <- which(object$chromosome2==chr & object$position2 >= centromereStart) + if (length(num) > 0) { + object$position2[num] <- object$position2[num] + centromereLength + } + } + return(object) + }) + +####################################################### +##### Function to change positions of chromosomes ##### +#' @rdname svData-methods +#' @aliases svData +#' @param object Object of class data.table +#' @param samples character vector of samples to retain +#' @param verbose Boolean for status updates +#' @return data.table object with calculated mutation distances +#' @importFrom data.table data.table +#' @importFrom ggforce geom_bezier +#' @noRd +setMethod(f="getStructuralVariantWindow", + signature="data.table", + definition=function(object, chrData, chrCytobands, chrGap, verbose){ + + ## Print status message + if (verbose) { + message("Adjusting chromosome boundaries for visualization of structural variants.") + } + + ## Split the data by the sample + sampleData <- object + sampleData$chr_combo <- paste(sampleData$chromosome, sampleData$chromosome2, sep="_") + + ## Get the chromosomes of interest + if (!is.null(chromosomes)) { + coi <- data.table(chromosomes) + } + if (is.null(chromosomes)) { + coi <- unique(chrData$chromosome) + } + + ## For each of the COI-chr combination, generate a dataset to plot + #chr <- coi$chromosomes[1] + finalDf <- data.table::rbindlist(apply(coi, 1, function(chr, sampleData, chrCytobands, chrGap){ + #browser() + ## Get rows in cohort that have sv events involving COI + dataset <- sampleData[chromosome==chr | chromosome2 == chr,] + + ## Get the mate chromosome for TRA events + otherChr <- unique(c(as.character(dataset$chromosome), as.character(dataset$chromosome2))) + otherChr <- as.data.table(otherChr[-which(otherChr %in% chr)]) + + ## For the individual COI, go through each of the chr combination + #mateChr <- otherChr$V1[12] + temp <- data.table::rbindlist(apply(otherChr, 1, function(mateChr, chr, dataset, sampleData, chrCytobands, chrGap){ + ## Get the chromosome combination to see rows which rows of the COI dataset have the correct + ## matching of the chr and mate chr + combo <- c(paste(chr, chr, sep="_"), paste(chr, mateChr, sep="_"), + paste(mateChr, chr, sep="_"), paste(mateChr, mateChr, sep="_")) + final <- dataset[which(chr_combo %in% combo), c("chromosome", "position", "chromosome2", "position2", "direction", + "svtype", "total_read_support", "sample", "genes")] + + ## Get the chr boundaries for the two chromosomes + chrDataTemp <- chrCytobands[which(chromosome %in% c(mateChr, chr))] + + ## Figure out the order to plot the chromosomes + chrOrder <- gtools::mixedsort(unique(as.character(chrDataTemp$chromosome))) + + ## Order the chrDataTemp dataset by chrOrder + chrDataTemp$chromosome <- factor(chrDataTemp$chromosome, levels=chrOrder) + chrDataTemp <- chrDataTemp[order(chrDataTemp$chromosome)] + + ## Get the "end" for each of the chromosomes + chrLength <- data.table::rbindlist(lapply(split(chrDataTemp, f=chrDataTemp$chromosome), function(x) { + chr <- x$chromosome[1] + end <- max(x$end) + final <- data.table(chromosome=chr, chrLength=end) + return(final) + })) + + ## Add the cytoband/centromere data to the "final" dataset + temp <- data.table(chromosome=chrDataTemp$chromosome, position=chrDataTemp$start, + chromosome2=chrDataTemp$chromosome, position2=chrDataTemp$end, + direction="cytoband", svtype=chrDataTemp$band, total_read_support="", + sample="", genes="") + + final <- rbind(final, temp) + + ## Add the length of the first chromosome to all of the sv calls on the second chromosome + num <- which(final$chromosome == chrLength$chromosome[2]) + final$position[num] <- final$position[num] + chrGap + chrLength$chrLength[1] + num <- which(final$chromosome2 == chrLength$chromosome[2]) + final$position2[num] <- final$position2[num] + chrGap + chrLength$chrLength[1] + + ## Get the midpoints for the dataset + final$midpoint <- (as.numeric(as.character(final$position))+ + as.numeric(as.character(final$position2)))/2 + + ## Get the chr-combo ID + final$chr_combo <- paste(chrLength$chromosome[1], chrLength$chromosome[2], sep="_") + + return(final) + + }, + chr=chr, dataset=dataset, sampleData=sampleData, chrCytobands=chrCytobands, chrGap=chrGap)) + + return(temp) + }, + sampleData=sampleData, chrCytobands=chrCytobands, chrGap=chrGap)) + + ## Get the genes for each SV call + finalDf$gene <- as.character(finalDf$genes) + finalDf$gene <- gsub(pattern="No Gene\\|", replacement="", finalDf$gene) + finalDf$gene <- gsub(pattern="\\|No Gene", replacement="", finalDf$gene) + finalDf$gene <- gsub(pattern="No Gene", replacement="", finalDf$gene) + + return(finalDf) + }) + +################################################################ +##### Function to generate SV plots for SVs on the same chr##### +#' @rdname svPlots-methods +#' @aliases svPlots +#' @param object object of class svData +#' @return list object of gtables for each chr_combo +#' @importFrom data.table data.table +#' @importFrom gtable gtable +#' @noRd +setMethod(f="buildSvPlot", + signature="svData", + definition=function(object, plotSpecificGene, plotGene1, plotGene2, cytobandColor, sample, sampleColor, plotALayers, + plotBLayers, plotCLayers, sectionHeights, plotWidth, plotHeight, + outputDir, verbose) { + ## Print status message + if (verbose) { + message("Generating SV plots") + } + + ## Get the svWindow + svWindow <- object@svWindow + + ## Check the input variables + checkPlotLayer <- function(plotLayer, name) { + if(!is.null(plotLayer)){ + if(!is.list(plotLayer)){ + memo <- paste(name, " is not a list", sep="") + stop(memo) + } + + if(any(!unlist(lapply(plotLayer, function(x) ggplot2::is.ggproto(x) | ggplot2::is.theme(x) | is(x, "labels"))))){ + memo <- paste(name, " is not a list of ggproto or ", + "theme objects... setting plotALayers to NULL", sep="") + warning(memo) + plotLayer <- NULL + } + } + return(plotLayer) + } + plotALayers <- checkPlotLayer(plotLayer=plotALayers, "plotALayers") + plotBLayers <- checkPlotLayer(plotLayer=plotBLayers, "plotBLayers") + plotCLayers <- checkPlotLayer(plotLayer=plotCLayers, "plotCLayers") + + ## Assign colors for samples + names(sampleColor) <- sample + + ## Split the sv window by chr_combo + window <- split(svWindow, svWindow$chr_combo) + + ## Go through each window dataset and generate a plot + svPlots <- suppressWarnings(lapply(window, function(dataset, plotSpecificGene, + cytobandColor, sectionHeights, + sampleColor, outputDir, + plotWidth, plotHeight, + plotALayers, plotBLayers, + plotCLayers) { + ## Split the dataset by sample to assign color names + df <- split(dataset, f=dataset$sample) + dataset <- data.table::rbindlist(lapply(df, function(x, sampleColor){ + if (nrow(x) > 0) { + sampleName <- as.character(x$sample[1]) + x$sampleColor <- sampleColor[which(names(sampleColor) == sampleName)] + } + return(x) + }, sampleColor=sampleColor)) + + colnames(dataset) <- c("Chromosome", "Position", "Chromosome2", "Position2", "Direction", + "SV_Type", "Total_Read_Support", "Sample", "Genes", + "Midpoint", "chr_combo", "gene", "sampleColor") + ## Sort dataset + dataset$Sample <- factor(dataset$Sample, levels=gtools::mixedsort(unique(dataset$Sample))) + + ## Create bins for the chr positions (remove position transformation) + chrOrder <- gtools::mixedsort(unique(c(as.character(dataset$Chromosome), as.character(dataset$Chromosome2)))) + chr1Length <- max(dataset[Direction=="cytoband" & Chromosome == chrOrder[1], Position2]) + ## Get chr1 data + chr1OldBreaks <- round(seq(0, chr1Length, by=chr1Length/5), digits=0) + chr1NewBreaks <- round(seq(0, chr1Length, by=chr1Length/5), digits=0) + chr1 <- data.table(chr=chrOrder[1], newBreaks=chr1NewBreaks, oldBreaks=chr1OldBreaks) + ## Get chr2 data + chr2Start <- min(dataset[Direction=="cytoband" & Chromosome == chrOrder[2], Position]) + chr2Length <- max(dataset[Direction=="cytoband" & Chromosome == chrOrder[2], Position2]) + chr2OldBreaks <- round(seq(chr2Start, chr2Length, by=(chr2Length-chr2Start)/5), digits=0) + chr2NewBreaks <- round(seq(0, chr2Length-chr1Length, by=(chr2Length-chr1Length)/5), digits=0) + chr2 <- data.table(chr=chrOrder[2], newBreaks=chr2NewBreaks, oldBreaks=chr2OldBreaks) + temp <- rbind(chr1, chr2) + + ## Get the start and stop for each chromosome + chr1End <- chr1Length + chr2End <- chr2Length + boundaries <- data.table(start=c(0, chr2Start), end=c(chr1End, chr2End)) + + ############################################################## + ##### Plot the chromosome plot ############################### + ############################################################## + ## Get the cytoband data + coi <- dataset[Direction=="cytoband" & SV_Type != "centromere"] + coi$type <- "Chromosome" + suppressWarnings(coi$color <- cytobandColor) + chrPlot <- ggplot() + geom_rect(data=coi, mapping=aes_string(xmin='Position', + xmax='Position2', + ymin=0, + ymax=1)) + + facet_grid(type ~ ., scales="fixed", space="fixed") + + scale_x_continuous(expand=c(0,0), limits=c(-5000000, max(coi$Position2) + 5000000)) + + scale_y_continuous(expand=c(0,0)) + + theme_bw() + + geom_rect(data=coi, aes(xmin=Position, xmax=Position2, ymin=0, ymax=1, fill=Chromosome), fill=coi$color) + + geom_text(data=coi, aes(x=Midpoint, y=0.5, label=SV_Type), angle=90, size=3) + + geom_vline(data=boundaries, aes(xintercept=start), linetype=2, color="Grey") + + geom_vline(data=boundaries, aes(xintercept=end), linetype=2, color="Grey") + + plotBLayers + + ## Get the centromeres + centromeres <- dataset[SV_Type=="centromere", c("Chromosome", "Position", "Position2")] + positions <- data.table::rbindlist(apply(centromeres, 1, function(x) { + midpoint <- round((as.numeric(as.character(x['Position'])) + + as.numeric(as.character(x['Position2'])))/2, digits=0) + leftPositions <- data.table(x=c(x['Position'], midpoint, x['Position']), + y=c(0.10, 0.5, 0.90), + SV_Type="Chromosome", + id=paste(x['Chromosome'], "_left", sep="")) + rightPositions <- data.table(x=c(x['Position2'], midpoint, x['Position2']), + y=c(0.10, 0.5, 0.90), + SV_Type="Chromosome", + id=paste(x['Chromosome'], "_right", sep="")) + positions <- rbind(leftPositions, rightPositions) + positions$x <- as.numeric(positions$x) + return(positions) + })) + chrPlot <- chrPlot + geom_polygon(data=positions, mapping=aes(x=x, y=y, group=id), fill="red") + + ## Subset svWindow dataset to get DEL/DUP/INV/etc... and TRA/BND/etc... + sameChrSvWindow <- dataset[SV_Type=="DEL" | SV_Type=="DUP" | SV_Type =="INV" | SV_Type == "INS"] + sameChrSvWindow$SV_size <- sameChrSvWindow$Position2 - sameChrSvWindow$Position + diffChrSvWindow <- dataset[SV_Type=="BND" | SV_Type=="TRA"] + + ## Get the dataset for the gene text annotations + dataset <- dataset[Direction!="cytoband"] + gene_text <- dataset[,c("Midpoint", "Total_Read_Support", "gene", "SV_Type")] + gene_text$Total_Read_Support[which(gene_text$SV_Type=="BND")] <- + as.numeric(as.character(gene_text$Total_Read_Support[which(gene_text$SV_Type=="BND")])) + + max(as.numeric(as.character(gene_text$Total_Read_Support[which(gene_text$SV_Type=="BND")])))*.05 + gene_text$Total_Read_Support[which(gene_text$SV_Type!="BND")] <- + as.numeric(as.character(gene_text$Total_Read_Support[which(gene_text$SV_Type!="BND")])) + + max(as.numeric(as.character(gene_text$Total_Read_Support[which(gene_text$SV_Type!="BND")])))*.05 + gene_text$Total_Read_Support <- as.numeric(gene_text$Total_Read_Support) + if (!is.null(plotSpecificGene)) { + genes <- paste(plotSpecificGene, collapse="|") + gene_text <- gene_text[grep(genes, as.character(gene_text$gene))] + if (nrow(gene_text) == 0){ + message(paste0("The genes: ", plotSpecificGene, " could not be found. No genes will be shown on the plot.")) + gene_text <- NULL + } + } + + ## Get the start/end of chromosomes in the dataset + beziers <- data.frame(data.table::rbindlist(apply(diffChrSvWindow, 1, function(x) { + leftEnd <- data.table(position=as.numeric(x[2]), total_read_support=0, point="end", + type="cubic", group=as.character(x[2]), Sample=x[8], SV_Type=x[6], + Direction=x[5], sampleColor=x[13]) + top <- data.table(position=as.numeric(x[10]), total_read_support=as.numeric(x[7])*2, point="control", + type="cubic", group=as.character(x[2]), Sample=x[8], SV_Type=x[6], + Direction=x[5], sampleColor=x[13]) + rightEnd <- data.table(position=as.numeric(x[4]), total_read_support=0, point="end", + type="cubic", group=as.character(x[2]), Sample=x[8], SV_Type=x[6], + Direction=x[5], sampleColor=x[13]) + final <- rbind(leftEnd, top, rightEnd) + return(final) + }))) + beziers <- beziers[!duplicated(beziers),] + + beziers$Sample <- factor(beziers$Sample, levels=gtools::mixedsort(unique(beziers$Sample))) + + ############################################################## + ##### Plot the translocation data ############################ + ############################################################## + traPlot <- ggplot() + geom_bezier(data=beziers, + mapping=aes_string(x='position', y='total_read_support', group='group', + color='Sample', linetype='Direction')) + + facet_grid(SV_Type ~ ., scales="fixed", space="fixed") + + scale_x_continuous(expand=c(0,0), limits=c(-5000000, max(coi$Position2) + 5000000), + breaks=temp$oldBreaks, labels=temp$newBreaks) + + scale_y_continuous() + + geom_vline(data=boundaries, aes(xintercept=start), linetype=2, color="Grey") + + geom_vline(data=boundaries, aes(xintercept=end), linetype=2, color="Grey") + + theme_bw() + plotALayers + ylab("Total Read Support") + + geom_point(data=beziers[which(beziers$point=="control"),c("position","total_read_support", "Sample")], + aes(x=position, y=total_read_support/2, color=Sample)) + if (plotGene1 & !is.null(gene_text)) { + traPlot <- traPlot + geom_text(data=gene_text[SV_Type%in%c("TRA", "BND")], + mapping=aes_string(x='Midpoint', y='Total_Read_Support', label='gene')) + } + ## Assign colors to sample + traPlot <- traPlot + scale_color_manual(name="Sample", values=sampleColor) + + ############################################################## + ##### Plot the non TRA sv events ############################# + ############################################################## + maxY <- max(as.numeric(as.character(sameChrSvWindow$Total_Read_Support))) + 30 + sameChrSvWindow$Total_Read_Support <- as.numeric(sameChrSvWindow$Total_Read_Support) + nonTraPlot <- ggplot() + geom_point(data=sameChrSvWindow, + mapping=aes_string(x='Midpoint', y='Total_Read_Support', + color="Sample"), size=2.5, alpha=0.75) + + facet_grid(SV_Type ~ ., scales="fixed", space="fixed") + + scale_x_continuous(expand=c(0,0), limits=c(-5000000, max(coi$Position2) + 5000000), + breaks=temp$oldBreaks, labels=temp$newBreaks) + + scale_y_continuous(limits=c(0,maxY+maxY*0.05)) + + geom_vline(data=boundaries, aes(xintercept=start), linetype=2, color="Grey") + + geom_vline(data=boundaries, aes(xintercept=end), linetype=2, color="Grey") + + theme_bw() + plotCLayers + ylab("Total Read Support") + xlab("Position") + if (plotGene2 & !is.null(gene_text)) { + nonTraPlot <- nonTraPlot + geom_text(data=gene_text[SV_Type%in%c("DEL", "DUP", "INV", "INS")], + mapping=aes_string(x='Midpoint', y='Total_Read_Support', label='gene')) + } + ## Assign colors to sample + nonTraPlot <- nonTraPlot + scale_color_manual(name="Sample", values=sampleColor) + + ############################################################## + ##### Combine the 3 plots #################################### + ############################################################## + traPlot <- ggplotGrob(traPlot) + chrPlot <- ggplotGrob(chrPlot) + nonTraPlot <- ggplotGrob(nonTraPlot) + + ## obtain the max width for relevant plots + plotList <- list(traPlot, chrPlot, nonTraPlot) + plotList <- plotList[lapply(plotList, length) > 0] + plotWidths <- lapply(plotList, function(x) x$widths) + maxWidth <- do.call(grid::unit.pmax, plotWidths) + + ## Set the widths for all plots + for (i in 1:length(plotList)) { + plotList[[i]]$widths <- maxWidth + } + + ## Arrange the final plot + p1 <- do.call(gridExtra::arrangeGrob, c(plotList, list(ncol=1, heights=sectionHeights))) + plot(p1) + + pdf(file=paste(outputDir, dataset$chr_combo[1], ".pdf", sep=""), width=plotWidth, height=plotHeight) + plot(p1) + dev.off() + + return(p1) + }, + plotSpecificGene=plotSpecificGene, cytobandColor=cytobandColor, + sectionHeights=sectionHeights, sampleColor=sampleColor, + plotALayers=plotALayers, plotBLayers=plotBLayers, plotCLayers=plotCLayers, + outputDir=outputDir, plotWidth=plotWidth, plotHeight=plotHeight)) + + return(svPlots) + }) \ No newline at end of file diff --git a/R/VCF_Manta_v4.1-class.R b/R/VCF_Manta_v4.1-class.R new file mode 100644 index 0000000..d96b0c8 --- /dev/null +++ b/R/VCF_Manta_v4.1-class.R @@ -0,0 +1,235 @@ +################################################################################ +##################### Public/Private Class Definitions ######################### + +#!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Public Class !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!# + +#' Class VCF_Manta_v4.1 +#' +#' An S4 class to represent data in vcf version 4.1 format, inherits from the +#' VCF_Virtual class +#' @name VCF_Manta_v4.1 +#' @rdname VCF_Manta_v4.1-class +#' @slot header data.table object containing header information +#' @slot meta data.table object containing meta information lines +#' @slot vcfHeader data.table object containing header for vcf data +#' @slot vcfData data.table object containing vcf data lines +#' @slot sample data.table object containing sample information +#' @include VCF_Virtual-class.R +#' @import methods +setClass("VCF_Manta_v4.1", + contains="VCF_Virtual", + validity=function(object){ + cnames <- c("chromosome", "position", "chromosome2", "position2", "direction", + "REF", "ALT", "svtype", "total_read_support", "FILTER", "sample", + "ID", "INFO", "FORMAT", "tumorSample", "paired") + + ## Check the columns + sampleCol <- which(!colnames(object@vcfData) %in% cnames) + if (length(sampleCol) > 0) { + memo <- paste0("Columns in the input data.table are missing. Required ", + "columns are: chromosome, position, chromosome2, position2, direction,", + "REF, ALT, svtype, total_read_support, FILTER, sample ", + "ID, INFO, FORMAT, tumorSample, paired") + message(memo) + } + return(TRUE) + + }) + +#' Constuctor for the VCF_Manta_v4.1 sub-class +#' +#' @name VCF_Manta_v4.1 +#' @rdname VCF_Manta_v4.1-class +#' @param vcfData data.table object containing a VCF file conforming to the +#' version 4.1 specifications +#' @param vcfHeader Object of class list containing character vectors for vcf +#' header information +#' @param paired Boolean object specifying if the svCaller was ran in paired mode +#' @param tumorColumn String specifying the name of the sample column with read support information +#' @importFrom data.table data.table +VCF_Manta_v4.1 <- function(vcfData, vcfHeader, paired, tumorColumn) { + + ## Set the data descriptions for the object + if (length(vcfHeader)==0) { + finalDescription <- data.table::data.table() + } else { + description <- lapply(vcfHeader, function(x){ + descriptionFieldIndex <- which(grepl("Description", x)) + x <- x[descriptionFieldIndex] + + split1 <- unlist(strsplit(unlist(strsplit(x, ",")), "=")) + id <- split1[grep("", "", split1[grep("Description", split1)+1]) + description <- gsub("\"", "", description, fixed=TRUE) + + x <- paste("ID=", id, "|", "Description=", description, sep="") + return(x) + }) + description <- unique(unlist(description)) + + # convert these results to a data.table after splitting into two columns + d <- unlist(strsplit(description, split="|", fixed=TRUE)) + id <- d[grep("ID=", d)] + id <- unlist(strsplit(id, split="ID="))[ + grep("[A-Z]", unlist(strsplit(id, split="ID=")))] + description <- d[grep("Description=", d)] + description <- unlist(strsplit(description, split="Description="))[ + grep("[A-Z]", unlist(strsplit(description, split="Description=")))] + + finalDescription <- data.table(name=id, description=description) + } + + ## Get the samples + sample <- data.table(sample=unique(vcfData$sample)) + + ## Assign the column names + cnames <- c("chromosome", "position", "ID", "REF", "ALT", "QUAL", + "FILTER", "INFO", "FORMAT") + colnames(vcfData)[1:9] <- cnames + + ## Check if the sample is paired + if (paired == TRUE) { + ## Check if the sv data is paired based on the input files/dataset + cnames <- c("chromosome", "position", "ID", "REF", "ALT", "QUAL", + "FILTER", "INFO", "FORMAT", "sample") + cols <- length(colnames(vcfData[,-which(colnames(vcfData) %in% cnames), with=FALSE])) + if (cols !=2) { + memo <- paste("Are you sure the data is paired. There are", cols, + "columns with sample read support data", + "in the input sv data when there should be 2.") + stop(memo) + } + + ## Check if the tumorColumn variable actually specifies a sample column to use + num <- which(colnames(vcfData[,tumorColumn,with=FALSE]) %in% + colnames(vcfData[,-which(colnames(vcfData) %in% cnames), with=FALSE])) + if (length(num) != 1) { + memo <- paste("The column designated as the tumor sample does not", + "correspond to sample read support. The valid values to use", + "for the tumorColumn variable are:", + paste(which(!colnames(vcfData) %in% cnames), collapse=" or ")) + stop(memo) + } + + ## Check if the tumorColumn variable is NULL + if (is.null(tumorColumn)) { + memo <- paste0("Input was designated as paired but the tumor/diseased sample ", + "was not designated. If the samples are paired, please ", + "use the tumorColumn variable to identify which column in the vcf datasets has the ", + "read support for calls in the tumor sample.") + } + if (is.null(tumorColumn) == FALSE) { + cnames <- c("chromosome", "position", "ID", "REF", "ALT", "QUAL", + "FILTER", "INFO", "FORMAT", colnames(vcfData)[tumorColumn], "sample") + vcfData <- vcfData[,which(colnames(vcfData) %in% cnames), with=FALSE] + colnames(vcfData)[10] <- "tumorSample" + } + } + if (paired == FALSE) { + ## Check if the sv data is not paired based on the input files/dataset + cnames <- c("chromosome", "position", "ID", "REF", "ALT", "QUAL", + "FILTER", "INFO", "FORMAT", "sample") + cols <- length(colnames(vcfData[,-which(colnames(vcfData) %in% cnames), with=FALSE])) + if (cols !=1) { + memo <- paste("Are you sure the data is NOT paired. There are", cols, + "columns with sample read support data", + "in the input sv data when there should be 1.") + stop(memo) + } + + if (!is.null(tumorColumn)) { + memo <- paste("The sv caller output was designated as not paired. ", + "But a value was assigned to the tumorColumn variable.", + "This value will be ignored.") + } + tumorColumn <- which(!colnames(vcfData) %in% cnames) + colnames(vcfData)[tumorColumn] <- "tumorSample" + } + vcfData$paired <- paired + + ## Get the structural variant type from the INFO column + ## Get the chr and position of the second breakpoint + ## Get the read support + ## Get the direction of the translocation + temp <- suppressWarnings(data.table::rbindlist(apply(vcfData, 1, function(x, paired) { + ## SV type + svtype <- unlist(strsplit(as.character(x["INFO"]), split=";"))[ + grep("SVTYPE", unlist(strsplit(as.character(x["INFO"]), split=";")))] + svtype <- strsplit(svtype, "SVTYPE=")[[1]][2] + x$svtype <- svtype[1] + + ## 2nd breakpoint and get the BND direction + if (svtype == "BND" | svtype == "TRA") { + alt <- strsplit(as.character(x$ALT), "[[:punct:]]")[[1]] + chromosome2 <- alt[2] + position2 <- alt[3] + dir <- strsplit(as.character(x$ALT), split="")[[1]] + if (dir[length(dir)] == "]"){ + final <- "N]P]" + } + if (dir[length(dir)] == "[") { + final <- "N[P[" + } + if (dir[1] == "]") { + final <- "]P]N" + } + if (dir[1] == "[") { + final <- "[P[N" + } + dir <- final + } + else if (svtype == "INV" | svtype == "DEL" | svtype == "DUP" | svtype == "INS") { + chromosome2 <- x$chromosome + tmp <- unlist(strsplit(as.character(x$INFO), split=";")[[1]]) + tmp <- tmp[grep("END=", tmp, fixed=TRUE)][1] + position2 <- strsplit(tmp, split="END=")[[1]][2] + dir <- svtype + } + x$chromosome2 <- as.character(chromosome2) + x$position2 <- as.numeric(position2) + x$direction <- dir + + ## Get the read support + format <- as.character(x$FORMAT) + ## Read support for the sample + a <- as.character(x$tumorSample) + if (format == "PR") { + ## Get read support for the sample + sample1_temp <- strsplit(a, split=":")[[1]] + sample1_chr1_PR <- as.numeric(strsplit(sample1_temp[1], split=",")[[1]][1]) + sample1_chr1_SR <- 0 + sample1_chr2_PR <- as.numeric(strsplit(sample1_temp[1], split=",")[[1]][2]) + sample1_chr2_SR <- 0 + } + if (format == "PR:SR") { + ## Get read support for the first sample + sample1_temp <- strsplit(a, split=":")[[1]] + sample1_chr1_PR <- as.numeric(strsplit(sample1_temp[1], split=",")[[1]][1]) + sample1_chr1_SR <- as.numeric(strsplit(sample1_temp[2], split=",")[[1]][1]) + sample1_chr2_PR <- as.numeric(strsplit(sample1_temp[1], split=",")[[1]][2]) + sample1_chr2_SR <- as.numeric(strsplit(sample1_temp[2], split=",")[[1]][2]) + } + ## Get the total read support + x$total_read_support <- sum(sample1_chr1_PR, sample1_chr1_SR, + sample1_chr2_PR, sample1_chr2_SR) + x <- as.data.table(t(cbind(x))) + return(x) + }, paired=paired))) + vcfData <- temp[,c("chromosome", "position", "chromosome2", "position2", "direction", + "REF", "ALT", "svtype", "total_read_support", "FILTER", "sample", + "ID", "INFO", "FORMAT", "tumorSample", "paired")] + + ## Get the ID for each SV call + vcfData$ID <- data.table::rbindlist(lapply(strsplit(as.character(vcfData$ID), split=":"), function(x) { + y <- data.table(paste(x[1], x[2], x[3], x[4], sep = "_")) + return(y) + })) + + ## Get the svtype + svType <- data.table(unique(vcfData$svtype)) + colnames(svType) <- "svtype" + + ## Initialize the object + new("VCF_Manta_v4.1", description=finalDescription, sample=sample, + vcfData=vcfData, svType=svType) +} \ No newline at end of file diff --git a/R/VCF_Manta_v4.2-class.R b/R/VCF_Manta_v4.2-class.R new file mode 100644 index 0000000..19343f3 --- /dev/null +++ b/R/VCF_Manta_v4.2-class.R @@ -0,0 +1,235 @@ +################################################################################ +##################### Public/Private Class Definitions ######################### + +#!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Public Class !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!# + +#' Class VCF_Manta_v4.2 +#' +#' An S4 class to represent data in vcf version 4.2 format, inherits from the +#' VCF_Virtual class +#' @name VCF_Manta_v4.2 +#' @rdname VCF_Manta_v4.2-class +#' @slot header data.table object containing header information +#' @slot meta data.table object containing meta information lines +#' @slot vcfHeader data.table object containing header for vcf data +#' @slot vcfData data.table object containing vcf data lines +#' @slot sample data.table object containing sample information +#' @include VCF_Virtual-class.R +#' @import methods +setClass("VCF_Manta_v4.2", + contains="VCF_Virtual", + validity=function(object){ + cnames <- c("chromosome", "position", "chromosome2", "position2", "direction", + "REF", "ALT", "svtype", "total_read_support", "FILTER", "sample", + "ID", "INFO", "FORMAT", "tumorSample", "paired") + + ## Check the columns + sampleCol <- which(!colnames(object@vcfData) %in% cnames) + if (length(sampleCol) > 0) { + memo <- paste0("Columns in the input data.table are missing. Required ", + "columns are: chromosome, position, chromosome2, position2, direction,", + "REF, ALT, svtype, total_read_support, FILTER, sample ", + "ID, INFO, FORMAT, tumorSample, paired") + message(memo) + } + return(TRUE) + + }) + +#' Constuctor for the VCF_Manta_v4.2 sub-class +#' +#' @name VCF_Manta_v4.2 +#' @rdname VCF_Manta_v4.2-class +#' @param vcfData data.table object containing a VCF file conforming to the +#' version 4.2 specifications +#' @param vcfHeader Object of class list containing character vectors for vcf +#' header information +#' @param paired Boolean object specifying if the svCaller was ran in paired mode +#' @param tumorColumn String specifying the name of the sample column with read support information +#' @importFrom data.table data.table +VCF_Manta_v4.2 <- function(vcfData, vcfHeader, paired, tumorColumn) { + + ## Set the data descriptions for the object + if (length(vcfHeader)==0) { + finalDescription <- data.table::data.table() + } else { + description <- lapply(vcfHeader, function(x){ + descriptionFieldIndex <- which(grepl("Description", x)) + x <- x[descriptionFieldIndex] + + split1 <- unlist(strsplit(unlist(strsplit(x, ",")), "=")) + id <- split1[grep("", "", split1[grep("Description", split1)+1]) + description <- gsub("\"", "", description, fixed=TRUE) + + x <- paste("ID=", id, "|", "Description=", description, sep="") + return(x) + }) + description <- unique(unlist(description)) + + # convert these results to a data.table after splitting into two columns + d <- unlist(strsplit(description, split="|", fixed=TRUE)) + id <- d[grep("ID=", d)] + id <- unlist(strsplit(id, split="ID="))[ + grep("[A-Z]", unlist(strsplit(id, split="ID=")))] + description <- d[grep("Description=", d)] + description <- unlist(strsplit(description, split="Description="))[ + grep("[A-Z]", unlist(strsplit(description, split="Description=")))] + + finalDescription <- data.table(name=id, description=description) + } + + ## Get the samples + sample <- data.table(sample=unique(vcfData$sample)) + + ## Assign the column names + cnames <- c("chromosome", "position", "ID", "REF", "ALT", "QUAL", + "FILTER", "INFO", "FORMAT") + colnames(vcfData)[1:9] <- cnames + + ## Check if the sample is paired + if (paired == TRUE) { + ## Check if the sv data is paired based on the input files/dataset + cnames <- c("chromosome", "position", "ID", "REF", "ALT", "QUAL", + "FILTER", "INFO", "FORMAT", "sample") + cols <- length(colnames(vcfData[,-which(colnames(vcfData) %in% cnames), with=FALSE])) + if (cols !=2) { + memo <- paste("Are you sure the data is paired. There are", cols, + "columns with sample read support data", + "in the input sv data when there should be 2.") + stop(memo) + } + + ## Check if the tumorColumn variable actually specifies a sample column to use + num <- which(colnames(vcfData[,tumorColumn,with=FALSE]) %in% + colnames(vcfData[,-which(colnames(vcfData) %in% cnames), with=FALSE])) + if (length(num) != 1) { + memo <- paste("The column designated as the tumor sample does not", + "correspond to sample read support. The valid values to use", + "for the tumorColumn variable are:", + paste(which(!colnames(vcfData) %in% cnames), collapse=" or ")) + stop(memo) + } + + ## Check if the tumorColumn variable is NULL + if (is.null(tumorColumn)) { + memo <- paste0("Input was designated as paired but the tumor/diseased sample ", + "was not designated. If the samples are paired, please ", + "use the tumorColumn variable to identify which column in the vcf datasets has the ", + "read support for calls in the tumor sample.") + } + if (is.null(tumorColumn) == FALSE) { + cnames <- c("chromosome", "position", "ID", "REF", "ALT", "QUAL", + "FILTER", "INFO", "FORMAT", colnames(vcfData)[tumorColumn], "sample") + vcfData <- vcfData[,which(colnames(vcfData) %in% cnames), with=FALSE] + colnames(vcfData)[10] <- "tumorSample" + } + } + if (paired == FALSE) { + ## Check if the sv data is not paired based on the input files/dataset + cnames <- c("chromosome", "position", "ID", "REF", "ALT", "QUAL", + "FILTER", "INFO", "FORMAT", "sample") + cols <- length(colnames(vcfData[,-which(colnames(vcfData) %in% cnames), with=FALSE])) + if (cols !=1) { + memo <- paste("Are you sure the data is NOT paired. There are", cols, + "columns with sample read support data", + "in the input sv data when there should be 1.") + stop(memo) + } + + if (!is.null(tumorColumn)) { + memo <- paste("The sv caller output was designated as not paired. ", + "But a value was assigned to the tumorColumn variable.", + "This value will be ignored.") + } + tumorColumn <- which(!colnames(vcfData) %in% cnames) + colnames(vcfData)[tumorColumn] <- "tumorSample" + } + vcfData$paired <- paired + + ## Get the structural variant type from the INFO column + ## Get the chr and position of the second breakpoint + ## Get the read support + ## Get the direction of the translocation + temp <- suppressWarnings(data.table::rbindlist(apply(vcfData, 1, function(x, paired) { + ## SV type + svtype <- unlist(strsplit(as.character(x["INFO"]), split=";"))[ + grep("SVTYPE", unlist(strsplit(as.character(x["INFO"]), split=";")))] + svtype <- strsplit(svtype, "SVTYPE=")[[1]][2] + x$svtype <- svtype[1] + + ## 2nd breakpoint and get the BND direction + if (svtype == "BND" | svtype == "TRA") { + alt <- strsplit(as.character(x$ALT), "[[:punct:]]")[[1]] + chromosome2 <- alt[2] + position2 <- alt[3] + dir <- strsplit(as.character(x$ALT), split="")[[1]] + if (dir[length(dir)] == "]"){ + final <- "N]P]" + } + if (dir[length(dir)] == "[") { + final <- "N[P[" + } + if (dir[1] == "]") { + final <- "]P]N" + } + if (dir[1] == "[") { + final <- "[P[N" + } + dir <- final + } + else if (svtype == "INV" | svtype == "DEL" | svtype == "DUP" | svtype == "INS") { + chromosome2 <- x$chromosome + tmp <- unlist(strsplit(as.character(x$INFO), split=";")[[1]]) + tmp <- tmp[grep("END=", tmp, fixed=TRUE)][1] + position2 <- strsplit(tmp, split="END=")[[1]][2] + dir <- svtype + } + x$chromosome2 <- as.character(chromosome2) + x$position2 <- as.numeric(position2) + x$direction <- dir + + ## Get the read support + format <- as.character(x$FORMAT) + ## Read support for the sample + a <- as.character(x$tumorSample) + if (format == "PR") { + ## Get read support for the sample + sample1_temp <- strsplit(a, split=":")[[1]] + sample1_chr1_PR <- as.numeric(strsplit(sample1_temp[1], split=",")[[1]][1]) + sample1_chr1_SR <- 0 + sample1_chr2_PR <- as.numeric(strsplit(sample1_temp[1], split=",")[[1]][2]) + sample1_chr2_SR <- 0 + } + if (format == "PR:SR") { + ## Get read support for the first sample + sample1_temp <- strsplit(a, split=":")[[1]] + sample1_chr1_PR <- as.numeric(strsplit(sample1_temp[1], split=",")[[1]][1]) + sample1_chr1_SR <- as.numeric(strsplit(sample1_temp[2], split=",")[[1]][1]) + sample1_chr2_PR <- as.numeric(strsplit(sample1_temp[1], split=",")[[1]][2]) + sample1_chr2_SR <- as.numeric(strsplit(sample1_temp[2], split=",")[[1]][2]) + } + ## Get the total read support + x$total_read_support <- sum(sample1_chr1_PR, sample1_chr1_SR, + sample1_chr2_PR, sample1_chr2_SR) + x <- as.data.table(t(cbind(x))) + return(x) + }, paired=paired))) + vcfData <- temp[,c("chromosome", "position", "chromosome2", "position2", "direction", + "REF", "ALT", "svtype", "total_read_support", "FILTER", "sample", + "ID", "INFO", "FORMAT", "tumorSample", "paired")] + + ## Get the ID for each SV call + vcfData$ID <- data.table::rbindlist(lapply(strsplit(as.character(vcfData$ID), split=":"), function(x) { + y <- data.table(paste(x[1], x[2], x[3], x[4], sep = "_")) + return(y) + })) + + ## Get the svtype + svType <- data.table(unique(vcfData$svtype)) + colnames(svType) <- "svtype" + + ## Initialize the object + new("VCF_Manta_v4.2", description=finalDescription, sample=sample, + vcfData=vcfData, svType=svType) +} \ No newline at end of file diff --git a/R/VCF_Virtual-class.R b/R/VCF_Virtual-class.R new file mode 100644 index 0000000..c6e9eaa --- /dev/null +++ b/R/VCF_Virtual-class.R @@ -0,0 +1,44 @@ +################################################################################ +######################### Virtual Class Definitions ############################ + +#' Class VCF_Virtual +#' +#' An S4 class to act as a virtual class for VCF version sub-classes +#' @name VCF_Virtual +#' @rdname VCF_Virtual-class +#' @slot vcf data.table object holding varscan data +#' @slot sample data.table object holding sample data +#' @importClassesFrom data.table data.table +#' @import methods +#' +setClass( + Class="VCF_Virtual", + representation=representation(description="data.table", + sample="data.table", + vcfData="data.table", + svType="data.table", + "VIRTUAL") +) + +################################################################################ +###################### Accessor function definitions ########################### + +#' @name getVcf +#' @rdname getVcf-methods +#' @aliases getVcf +setMethod(f="getVcf", + signature="VCF_Virtual", + definition=function(object, ...){ + vcf <- object@vcf + return(vcf) + }) + +#' @name getSample +#' @rdname getSample-methods +#' @aliases getSample +setMethod(f="getSample", + signature="VCF_Virtual", + definition=function(object, ...){ + sample <- object@sample + return(sample) + }) \ No newline at end of file diff --git a/R/VEP-class.R b/R/VEP-class.R index 567925c..d454d03 100644 --- a/R/VEP-class.R +++ b/R/VEP-class.R @@ -34,8 +34,8 @@ setClass("VEP", #' @details When specifying a path to a VEP annotation file the option exist to #' either specify the full path to an annotation file or to use wildcards to #' specify multiple files. When specifying a full path the initalizer will check -#' if a column named "sample" containg the relevant sample for each row exists. -#' If such a column is not found the initalizer will assume this file +#' if a column named "sample" containing the relevant sample for each row +#' exists. If such a column is not found the initalizer will assume this file #' corresponds to only one sample and populate a sample column accordingly. #' Alternatively if multiple files are specified at once using a wildcard, the #' initalizer will aggregate all the files and use the file names minus any @@ -141,7 +141,7 @@ VEP <- function(path, data=NULL, version="auto", verbose=FALSE){ } } - # assign the vepData to it's slot + # assign the vepData to its slot if(version >= 88 & version < 89){ vepObject <- VEP_v88(vepData=vepData, vepHeader=vepHeader) } else { diff --git a/R/VarScanFormat-class.R b/R/VarScanFormat-class.R index 24f74c2..5bb850a 100644 --- a/R/VarScanFormat-class.R +++ b/R/VarScanFormat-class.R @@ -111,11 +111,37 @@ setClass("VarScanFormat", #' in the VarScan. file. #' @seealso \code{\link{lohSpec}} #' @importFrom data.table fread +#' @importFrom data.table as.data.table #' @export -VarScanFormat <- function(path, varscanType, verbose=FALSE) { - ## Read in VarScan data - varscanData <- suppressWarnings(fread(input=path, stringsAsFactors=FALSE, - verbose=verbose)) +VarScanFormat <- function(path=NULL, varscanData=NULL, varscanType="LOH", verbose=FALSE) { + ## Check for the input variables + if (!varscanType %in% c("LOH" , "CNV")) { + memo <- paste("The specified varscanType is not a supported. Please specify the varscanType as", + "either LOH or CNV.") + stop(memo) + } + if (is.null(path) & is.null(varscanData)) { + memo <- paste("The path and varscanData variables cannot be both NULL.") + warning(memo) + } + if (!is.null(varscanData)){ + if (!is.null(path)) { + memo <- paste("The path variable is defined but an input dataset is provided.", + "Ignoring the path variable.") + warning(memo) + if (!is.data.table(varscanData)) { + memo <- paste("VarscanData provided is not of class data.table.", + "Attempting to coerce.") + warning(memo) + varscanData <- as.data.table(varscanData) + } + } + } + if (!is.null(path) & is.null(varscanData)) { + ## Read in VarScan data + varscanData <- suppressMessages(fread(input=path, stringsAsFactors=FALSE, + verbose=verbose)) + } ## Add varscanType value to dataset varscanData$varscanType <- varscanType @@ -123,31 +149,71 @@ VarScanFormat <- function(path, varscanType, verbose=FALSE) { ## Get the sample names sample <- varscanData[,which(colnames(varscanData)=="sample"), with=FALSE] + ## Check if the varscan data has the proper columns + if (varscanType=="LOH") { + cnames <- c("chrom", "position", "ref", "var", + "normal_reads1", "normal_reads2", "normal_var_freq", + "normal_gt", "tumor_reads1", "tumor_reads2", "tumor_var_freq", + "tumor_gt", "somatic_status", "variant_p_value", + "somatic_p_value", "tumor_reads1_plus", "tumor_reads1_minus", + "tumor_reads2_plus", "tumor_reads2_minus", + "normal_reads1_plus", "normal_reads1_minus", + "normal_reads2_plus", "normal_reads2_minus", "sample", "varscanType") + } ## Define LOH columns + if (varscanType=="CNV") { + cnames <- c("chrom", "chr_start", "chr_stop", "normal_depth", + "tumor_depth", "log_ratio", "gc_content", "sample", "varscanType") + } ## Define CNV columns + ## Check to see if there are columns in dataset that aren't one of the defined columns + num <- which(!colnames(varscanData) %in% cnames) + ## Return an error if true + if (length(num) > 0) { + memo <- paste("The columns provided in the varscan data file do not match the expected columns.", + "refer to http://varscan.sourceforge.net/somatic-calling.html#somatic-output", + "for appropriate column names.") + stop(memo) + } + ## If the varscan output is to visualize loh if (varscanType == "LOH") { ## Obtain coordinates that were called as germline or LOH by varscan varscanData <- varscanData[somatic_status=="Germline"|somatic_status=="LOH"] ## Convert VAF percentages to VAF proportions - varscanData$normal_var_freq <- round(as.numeric( - as.character(gsub(pattern="%", replacement="", - varscanData$normal_var_freq)))/100, digits = 3) - varscanData$tumor_var_freq <- round(as.numeric( - as.character(gsub(pattern="%", replacement="", - varscanData$tumor_var_freq)))/100, digits = 3) + np <- grep("%", varscanData$normal_var_freq) + tp <- grep("%", varscanData$tumor_var_freq) + if (length(np) > 0) { + memo <- paste("Normal VAF values appear to be percentages. Converting to proportions.") + warning(memo) + varscanData$normal_var_freq <- as.numeric(as.character( + gsub(pattern="%", replacement="", varscanData$normal_var_freq))) + } + if (length(tp) > 0) { + memo <- paste("Tumor VAF values appear to be percentages. Converting to proportions.") + warning(memo) + varscanData$tumor_var_freq <- as.numeric(as.character( + gsub(pattern="%", replacement="", varscanData$tumor_var_freq))) + } + + ## Check if the VAFs are out of 100, and if so, make it out of 1 + nm <- max(range(varscanData$normal_var_freq)) + tm <- max(range(varscanData$tumor_var_freq)) + if (nm > 1) { + memo <- paste("Normal VAF values appear to be out of 100. Making VAF values out of 1.") + warning(memo) + varscanData$normal_var_freq <- round(varscanData$normal_var_freq/100, digits=3) + } + if (tm > 1) { + memo <- paste("Tumor VAF values appear to be out of 100. Making VAF values out of 1.") + warning(memo) + varscanData$tumor_var_freq <- round(varscanData$tumor_var_freq/100, digits=3) + } } ## If the varscan output is to visualize copy number data if (varscanType == "CNV") { - ## Read in the copy number data - varscanData <- suppressWarnings(fread(input=path, stringsAsFactors=FALSE, - verbose=verbose)) + ## TODO: Add functionality for CNV data from varscan - ## Add varscanType value to dataset - varscanData$varscanType <- varscanType - - ## Get the sample names - sample <- varscanData[,which(colnames(varscanData)=="sample"), with=FALSE] } ## Create the varscan object @@ -177,7 +243,6 @@ setMethod(f="getPath", }) - ################################################################################ ####################### Method function definitions ############################ diff --git a/R/VariantCallFormat-class.R b/R/VariantCallFormat-class.R new file mode 100644 index 0000000..44d798f --- /dev/null +++ b/R/VariantCallFormat-class.R @@ -0,0 +1,221 @@ +################################################################################ +##################### Public/Private Class Definitions ######################### + +#!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Public Class !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!# + +#' Class VariantCallFormat +#' +#' @name VariantCallFormat-class +#' @rdname VariantCallFormat-class +#' @slot path Character string specifying the path of the VCF file read in +#' @slot version Character string specifiying the version of the vcf file +#' @slot vcfObject vcf object which inherits from VCF_Virtual class +#' @exportClass VariantCallFormat +#' @include VCF_Virtual-class.R +#' @import methods +setClass("VariantCallFormat", + representation=representation(path="character", + version="character", + vcfObject="VCF_Virtual"), + validity=function(object) { + + }) + +#' Constructor for the VCF container class +#' @name VariantCallFormat +#' @rdname VariantCallFormat-class +#' @param path String specifying the path to a VCF file. Can accept wildcards +#' if multiple VCF files exist (see details). +#' @param data data.table object storing a VCF file. Overrides "path" if +#' specified +#' @param version String specifying the version of the VCF file, if set to auto +#' the version will be obtained from the header in the VCF file +#' @param svCaller String specifying the structural variant caller used +#' @param paired Boolean specifiying if the svCaller was run with the paired option +#' (i.e. tumor-normal) +#' @param tumorColumn Integer specifying the column number with the tumor read support information. +#' Only used when paired=TRUE. +#' @param verbose Bolean specifying if progress should be reported while reading +#' in the VCF file +#' @details When specifying a path to a VCF file, the option exists to either +#' specify the full path to a vcf file or to us wildcards to specify multiple +#' files. When specifying a full path, the initializer will check if a column +#' named "sample" containing the relevant sample for each row exists. If such a +#' column is not found, the initializer will assume this file correspnds to +#' only one sample and populate a sample column accordingly. Alternatively, if +#' multiple files are specified at once using a wildcard, the initializer will +#' aggregate all the files and use the filenames minus any extension to +#' populate the "sample" column. +#' @importFrom data.table fread +#' @importFrom data.table rbindlist +#' @importFrom data.table data.table +#' @export +extractVariantCallFormat <- function(path=NULL, data=NULL, version="auto", svCaller=NULL, paired=paired, + tumorColumn=tumorColumn, verbose=FALSE) { + + ## Check if both path and data are both null + if (is.null(path) & is.null(data)) { + memo <- paste("Both the path and data variable cannot be null.") + stop(memo) + } + + ## Get the data if the dataset is not provided + if (is.null(data)) { + ## Add wildcard to the path if it not present + if (strsplit(path, split="/")[[1]][length(strsplit(path, split="/")[[1]])] != "*") { + memo <- paste("No wildcard found in the designated path. Please add wildcard to the path. For example:", + "~/Desktop/StructuralVariants/* to use files in ~/Desktop/StructuralVariants/ directory.") + stop(memo) + } + + ## Grab all the files and assign to slot + vcfFiles <- Sys.glob(path) + + ## Anonymous function to read in files + a1 <- function(x, verbose) { + ## Detect OS and remove slashes and extension + if (.Platform$OS.type == "windows") { + sampleName <- gsub("(.*/)||(.*\\\\)", "", x) + sampleName <- gsub("\\.[^.]+$", "", x) + } else { + sampleName <- gsub("(.*/)", "", x) + sampleName <- gsub("\\.[^.]+$", "", sampleName) + } + + ## Read the header + header <- readLines(con=x, n=400)[grep("^##", readLines(con=x, n=400))] + + ## Find where the headers stops and read the data + skip <- length(header) + vcfData <- suppressWarnings(data.table::fread(input=x, + stringsAsFactors=TRUE, + verbose=verbose, + skip=skip)) + + ## Set sample if it is not already in the data table + if(any(colnames(vcfData) %in% "sample")){ + return(vcfData) + } else { + vcfData$sample <- sampleName + return(list("data"=vcfData, "header"=header)) + } + } + + ## Aggregate data into a single data table if necessary + if(length(vcfFiles)==0) { + memo <- paste("No files found using:", path) + stop(memo) + } else { + ## Read in the information + vcfInfo <- lapply(vcfFiles, a1, verbose) + + ## Extract header and data information + vcfHeader <- lapply(vcfInfo, function(x) x[["header"]]) + vcfData <- data.table::rbindlist(lapply(vcfInfo, function(x) x[["data"]])) + } + } + + ## If a dataset is provided: + if (!is.null(data)) { + path <- "none" + + ## Check to see if the VCF version is present + if (version == "auto") { + memo <- paste("If a dataset is loaded into the function, the version of ", + "the VCF that came from the sv caller must be specified as a CHARACTER VECTOR. ", + "The current VCF versions that are supported are: 4.1 and 4.2", sep="") + stop(memo) + } + + ## Convert dataset to data.table class + if (is.data.table(data)) { + vcfHeader <- data.table::data.table() + vcfData <- data + } + if (!is.data.table(data)) { + memo <- paste("data is not of class data.table,", + "attempting to coerce") + warning(memo) + vcfHeader <- data.table::data.table() + vcfData <- data.table::data.table(data) + } + + ## Check to see if it has the necessary columns + cnames <- c("#CHROM", "POS", "ID", "REF", "ALT", "QUAL", + "FILTER", "INFO", "FORMAT", "sample") + if (any(all(cnames %in% colnames(vcfData))==FALSE)){ + colnames(vcfData) %in% cnames + memo <- paste("The columns in the input dataset do not match the required columns:", + paste(cnames, collapse=", "), ". This does not include the", + "columns with sample read support information.") + stop(memo) + } + } + + ## Check to see if there are any columns with read support information + cnames <- c("#CHROM", "POS", "ID", "REF", "ALT", "QUAL", + "FILTER", "INFO", "FORMAT", "sample") + readSupportColumns <- colnames(vcfData)[which(!colnames(vcfData) %in% cnames)] + if (!(length(readSupportColumns) == 1 | length(readSupportColumns)==2)) { + memo <- paste("There are", length(readSupportColumns), "columns that are not one of the", + "required columns. There must be 1 column with sample read support", + "information for unpaired data and 2 columns with sample read support", + "information for paired data.") + stop(memo) + } + + + ## Grab the version and assign it + a2 <- function(x) { + ## Find the element which defines the VEP version + x <- x[grepl("fileformat=", x)] + + ## Extract the version + x <- regmatches(x, regexpr("[0-9]+\\.*[0-9]*",x)) + + if (length(x) != 1) { + memo <- paste("Expected 1 entry for VCF version found:", + length(x), "using", as.numeric(x[1])) + warning(memo) + } + return(as.numeric(x[1])) + } + if (version == "auto") { + version <- unique(unlist(lapply(vcfHeader, a2))) + if (length(version) > 1) { + version <- as.character(version[1]) + memo <- paste("Expected one version, the following versions were", + "found:", toString(version), "Using version", + version, "for parsing!") + warning(memo) + } else if (length(version) == 0) { + memo <- paste("Cannot infer version from vcf headers", + "no versions found!") + stop(memo) + } + } + + ## Perform quality check for the svCaller + if (!svCaller %in% c("Manta")) { + memo <- paste0("The specified svCaller: ", svCaller, " is not supported. ", + "Only the following callers are support: Manta. ", + "Make sure the svCaller is one of the ", + "supported callers listed with proper capitalization and spelling.") + stop(memo) + } + + ## Assign the vcfData to its slot + if (version == "4.1" & svCaller == "Manta") { + vcfObject <- VCF_Manta_v4.1(vcfData=vcfData, vcfHeader=vcfHeader, paired=paired, tumorColumn=tumorColumn) + } else if (version == "4.2" & svcaller =="Manta") { + vcfObject <- VCF_Manta_v4.2(vcfData=vcfData, vcfHeader=vcfHeader, paired=paired, tumorColumn=tumorColumn) + } else { + memo <- paste("Currently only VCF versions 4.1 and 4.2 for Manta are supported,", + "make a feature request on", + "https://github.com/griffithlab/GenVisR!") + stop(memo) + } + + ## Initialize the object + new("VariantCallFormat", path=path, vcfObject=vcfObject, version=as.character(version)) +} diff --git a/R/deprecated-lohSpec.R b/R/deprecated-lohSpec.R new file mode 100644 index 0000000..aeec823 --- /dev/null +++ b/R/deprecated-lohSpec.R @@ -0,0 +1,680 @@ +#' Plot LOH data +#' +#' Construct a graphic visualizing Loss of Heterozygosity in a cohort +#' @name lohSpec +#' @param x object of class data frame with rows representing germline calls. +#' The data frame must contain columns with the following names "chromosome", +#' "position", "n_vaf", "t_vaf", "sample". required if path is set to NULL (see +#' details). vaf should range from 0-1. +#' @param y Object of class data frame with rows representing chromosome +#' boundaries for a genome assembly. The data frame must contain columns with +#' the following names "chromosome", "start", "end" (optional: see details). +#' @param genome Character string specifying a valid UCSC genome (see details). +#' @param gender Character vector of length equal to the number of samples, +#' consisting of elements from the set {"M", "F"}. Used to suppress the plotting +#' of allosomes where appropriate. +#' @param path Character string specifying the path to a directory containing +#' germline calls for each sample. Germline calls are expected to be stored as +#' tab-seperated files which contain the following column names "chromosome", +#' "position", "n_vaf", "t_vaf", and "sample". required if x is set to null +#' (see details). +#' @param fileExt Character string specifying the file extensions of files +#' within the path specified. Required if argument is supplied to path +#' (see details). +#' @param step Integer value specifying the step size (i.e. the number of base +#' pairs to move the window). required when method is set to slide +#' (see details). +#' @param window_size Integer value specifying the size of the window in base +#' pairs in which to calculate the mean Loss of Heterozygosity (see details). +#' @param normal Numeric value within the range 0-1 specifying the expected +#' normal variant allele frequency to be used in Loss of Heterozygosity +#' calculations. defaults to .50\% +#' @param colourScheme Character vector specifying the colour scale to use from +#' the viridis package. One of "viridis", "magma", "plasma", or "inferno". +#' @param plotLayer Valid ggpot2 layer to be added to the plot. +#' @param method character string specifying the approach to be used for +#' displaying Loss of Heterozygosity, one of "tile" or "slide" (see details). +#' @param out Character vector specifying the the object to output, one of +#' "data", "grob", or "plot", defaults to "plot" (see returns). +#' @return One of the following, a list of dataframes containing data to be +#' plotted, a grob object, or a plot. +#' @details lohSpec is intended to plot the loss of heterozygosity (LOH) within +#' a sample. As such lohSpec expects input data to contain only LOH calls. Input +#' can be supplied as a single data frame given to the argument x with rows +#' containing germline calls and variables giving the chromosome, position, +#' normal variant allele frequency, tumor variant allele frequency, and the +#' sample. In lieu of this format a series of .tsv files can be supplied via the +#' path and fileExt arguments. If this method is choosen samples will be infered +#' from the file names. In both cases columns containing the variant allele +#' frequency for normal and tumor samples should range from 0-1. +#' Two methods exist to calculate and display LOH events. If the method is set +#' to "tile" mean LOH is calculated based on the window_size argument with +#' windows being placed next to each other. If the method is set to slide the +#' widnow will slide and calculate the LOH based on the step parameter. +#' In order to ensure the entire chromosome is plotted lohSpec requries the +#' location of chromosome boundaries for a given genome assembly. As a +#' convenience this information is available for the following genomes "hg19", +#' "hg38", "mm9", "mm10", "rn5" and can be tetrieved by supplying one of the +#' afore mentioned assemblies via the 'genome'paramter. If an argument is +#' supplied to the 'genome' parameter and is unrecognized a query to the UCSC +#' MySQL database will be attempted to obtain the required information. If +#' chromosome boundary locations are unavailable for a given assembly this +#' information can be supplied to the 'y' parameter which has priority over the +#' 'genome' parameter. +#' @importFrom gtools mixedsort +#' @examples +#' # plot loh within the example dataset +#' lohSpec(x=HCC1395_Germline) +#' @export + +lohSpec <- function(x=NULL, path=NULL, fileExt=NULL, y=NULL, genome='hg19', + gender=NULL, step=1000000, window_size=2500000, + normal=.50, colourScheme="inferno", plotLayer=NULL, + method="slide", out="plot") +{ + stop("This function has been deprecated in order to implement an object oriented programming style! Please use LohSpec() with a capital L instead!") + + # Grab data if necessary + if(!is.null(path)) + { + if(is.null(fileExt)) + { + memo <- paste0("argument required to variable fileExt if argument ", + "is supplied to path") + stop(memo) + } + x <- lohSpec_fileGlob(path=path, fileExt=fileExt, step=step, + window_size=window_size, gender=gender) + } + if (is.null(path)) { + if (is.null(gender) == FALSE) { + x <- x[x$chromosome !="Y",] + } + if(is.null(gender) == TRUE) { + x <- x[(x$chromosome != "X" & + x$chromosome != "Y"),] + } + } + + # Data Quality Check + input <- lohSpec_qual(x, y, genome) + x <- input[[1]] + y <- input[[2]] + + # Obtain dummy data for genome + preloaded <- c('hg38', 'hg19', 'mm10', 'mm9', 'rn5') + if(!is.null(y)) + { + message("detected input to y, using supplied positions for chromosome + boundaries") + chr_pos <- y + } else if(is.null(y) && any(genome == preloaded)) { + message("genome specified is preloaded, retrieving data...") + chr_pos <- GenVisR::cytoGeno[GenVisR::cytoGeno$genome == genome,] + chr_pos <- multi_chrBound(chr_pos) + } else { + message("attempting to query UCSC sql database for chromosome + positions") + cyto_data <- suppressWarnings(multi_cytobandRet(genome)) + chr_pos <- multi_chrBound(cyto_data) + } + + # Quality check for dummy data + if(nrow(chr_pos) < 1) + { + memo <- paste0("Could not retrieve chromosome boundaries from", + " UCSC, please specify this information via ", + "the y paramter") + stop(memo) + } + + # Produce dataset with loh mean absolute differences + if (toupper(method) == 'SLIDE') { + # Calculate loh via sliding window + loh <- lohSpec_slidingWindow(loh_data=x, step, window_size, normal) + } + else if(toupper(method) == 'TILE') { + # Calculate loh via tiled window + ## Insert code + loh <- lohSpec_tileWindow(loh_data=x, window_size, normal) + } + else { + memo <- paste0("Did not recognize input to parameter method.", + "Please specify one of \"Tile\" or \"Slide\".") + stop(memo) + } + + # set order of x axis labels in plot + chromosomes <- gtools::mixedsort(as.character(unique(loh$chromosome))) + + # remove X and/or Y chromosomes + if (is.null(gender) == FALSE) { + chromosomes <- chromosomes[chromosomes != "Y"] + chr_pos <- chr_pos[(chr_pos$chromosome != "chrY"),] + loh <- loh[loh$chromosome != "Y",] + } + if (is.null(gender) == TRUE) { + chromosomes <- chromosomes[chromosomes != "X" & chromosomes != "Y"] + chr_pos <- chr_pos[(chr_pos$chromosome != "chrX" & + chr_pos$chromosome != "chrY"),] + loh <- loh[(loh$chromosome != "Y" & loh$chromosome != "X"),] + } + loh$chromosome <- factor(loh$chromosome, levels=chromosomes) + chr_pos_levels <- gtools::mixedsort(as.character(unique(chr_pos$chromosome))) + chr_pos$chromosome <- + factor(chr_pos$chromosome, levels=chr_pos_levels) + + # set order of y axis labels in plot + samples <- gtools::mixedsort(as.character(unique(loh$sample))) + loh$sample <- factor(loh$sample, levels=samples) + + #build the plot + loh_plot <- lohSpec_buildMain(loh, dummyData=chr_pos, + colourScheme=colourScheme, + plotLayer=plotLayer) + + # Decide what to output + output <- multi_selectOut(data=loh, plot=loh_plot, draw=FALSE, out=out) + return(output) +} + +#' Plot LOH data +#' +#' Build a ggplot2 object displaying calculated LOH data +#' @name lohSpec_buildMain +#' @param x object of class dataframe with loh difference +#' calculations and column names "window_start", "window_stop", "chromosome", +#' "sample", and "loh_diff" +#' @param dummyData object of class dataframe with column names "chromosome", +#' "start", "end" specifying chromosome boundaries +#' @param colourScheme Character vector specifying the colour scale to use from +#' the viridis package. One of "viridis", "magma", "plasma", or "inferno". +#' @param plotLayer Valid ggplot2 layer to be added to the plot. +#' for the legend's parameters +#' @return object of class ggplot2 +#' @import ggplot2 +#' @importFrom viridis scale_fill_viridis + +lohSpec_buildMain <- function(x, dummyData, colourScheme="inferno", + plotLayer=NULL) +{ + # define dummy data which will be chromosome boundaries, these are plotted + # but are transparent and will not appear in the plot + dummy_data <- geom_rect(data=dummyData, aes_string(xmin='start', xmax='end', + ymin=-1, ymax=1),alpha=0) + # Define the main plot + data <- geom_rect(data=x, aes_string(xmin='window_start', + xmax='window_stop', + ymin=-1, + ymax=1, fill='loh_diff_avg')) + + + # Define additional plot parameters + facet <- facet_grid(sample ~ chromosome, scales="free", space="free") + + x_scale <- scale_x_continuous(expand = c(0, 0)) + y_scale <- scale_y_continuous(expand = c(0,0)) + + lab_x <- xlab("Chromosome") + lab_y <- ylab("Sample") + + # Define plot aesthetics + BWscheme <- theme_bw() + plotTheme <- theme(axis.ticks.x=element_blank(), + axis.text.x=element_blank(), + axis.ticks.y=element_blank(), + axis.text.y=element_blank(), + panel.grid.major=element_blank(), + panel.grid.minor=element_blank()) + + # plot an additional layer if specified + if(!is.null(plotLayer)) + { + plotLayer <- plotLayer + } else { + plotLayer <- geom_blank() + } + + # Define colour rame + LOHgradient <- viridis::scale_fill_viridis("Avg. VAF Difference", + option=colourScheme) + + # Build the plot + tmp <- data.frame(x=0, y=0) + p1 <- ggplot(data=tmp, aes(y=0)) + dummy_data + data + facet + x_scale + y_scale + + lab_x + lab_y + BWscheme + LOHgradient + plotTheme + plotLayer + + return(p1) +} + +#' Grab data for lohSpec +#' +#' Look in the specified file path and grab data with the proper extension for +#' lohSpec +#' @name lohSpec_fileGlob +#' @param path character string specifying which directory contains +#' the sample information stored as datasets with columns "chromosome", +#' "position", "n_vaf", "t_vaf", and "sample" (required if x is not specified) +#' @param fileExt character string specifying the file extensions of files +#' @param step integer with the length of divisions (bp) in chromosomes +#' @param gender vector of length equal to the number of samples, consisting of +#' elements from the set {"M", "F"} +#' @param window_size Integer value specifying the size of the window in base +#' pairs in which to calculate the mean Loss of Heterozygosity. +#' @return object of class data frame from data specified in path for lohSpec +#' @importFrom utils read.delim + +lohSpec_fileGlob <- function(path, fileExt, step, window_size, gender) +{ + # Obtain file names with the tumor and normal vaf values + fileNames <- Sys.glob(paste0(path, '*.', fileExt)) + # Determine the column names of the dataset + if (is.null(gender) == FALSE) { + columnNames <- c("chromosome", "position", "n_vaf", "t_vaf", "sample", + "gender") + } + if(is.null(gender) == TRUE) { + columnNames <- c("chromosome", "position", "n_vaf", "t_vaf", "sample") + } + + # Extract raw t_vaf and n_vaf values and merge the dataset + for (i in 1:length(fileNames)) + { + data <- utils::read.delim(fileNames[i]) + if (is.null(gender) == FALSE) { + data <- data[data$chromosome !="Y",] + if (is.null(data$gender) == TRUE) { + data$gender <- gender[i] + } + } + if(is.null(gender) == TRUE) { + data <- data[data$chromosome != "X" & + data$chromosome != "Y",] + } + if(!all(columnNames %in% colnames(data))) + { + memo <- paste0("Did not detect all of the required columns in the", + " following file:", fileNames[i], "... skipping") + warning(memo) + next + } + + if (!exists("dataset", inherits=FALSE)) + { + dataset <- data + } else if(exists("dataset", inherits=FALSE)) { + temp <- data + dataset <- rbind(dataset, temp) + rm(temp) + } + + rm(data) + } + ## Solves problem of user removing loh values for any autosome + all_lev <- unique(droplevels(dataset$chromosome)) + sample <- unique(dataset$sample) + total <- data.frame() + for (r in 1:length(sample)) { + df <- dataset[dataset$sample==sample[r],] + dflevels <- unique(droplevels(df$chromosome)) + chrDiff <- setdiff(all_lev, dflevels) + if (length(chrDiff) >= 1) { + for (i in 1:length(chrDiff)) { + if(is.null(gender)==TRUE) { + d1 <- c(as.numeric(chrDiff[i]), step, 50, 50, + as.character(sample[r])) + d2 <- c(as.numeric(chrDiff[i]), + step + window_size, 50, 50, + as.character(sample[r])) + df <- data.frame(rbind(df, d1, d2)) + } + if(is.null(gender)==FALSE) { + d1 <- c(as.character(chrDiff[i]), step, 50, 50, + as.character(sample[r]), + as.character(gender[r])) + + d2 <- c(as.character(chrDiff[i]),step + window_size, + 50, 50, + as.character(sample[r]), + as.character(gender[r])) + df <- data.frame(rbind(df, d1, d2)) + } + } + } + total <- rbind(total, df) + } + return(total) +} + +#' Calculate loh difference +#' +#' Obtain LOH on an entire chromsomes from samples in a cohort +#' @name lohSpec_lohCalc +#' @param window_data object of class data frame with columns +#' 'window_start' and 'window_stop +#' @param out object of class dataframe with columns 'chromosome', +#' 'position', 'n_vaf', 't_vaf', and 'sample' +#' @param normal integer specifying the subtraction value from tumor VAF +#' @return object of class dataframe containing mean LOH difference calculations +#' and column names "window_start", "window_stop", "chromosome", "position", +#' "n_vaf", "t_vaf", "sample", "loh_diff" + +lohSpec_lohCalc <- function(window_data, out, normal) + +{ + ## Set each list as a dataframe + window <- data.frame(window_data) + sample_data <- data.frame(out) + sample_data$position <- as.numeric(as.character(sample_data$position)) + total <- data.frame() + window_start <- vector() + window_stop <- vector() + num <- as.vector(1:nrow(window)) + + df <- do.call("rbind", lapply(num, function(i){ + ## filter sample_data for loh calls whose positions fall in the + ## window frame + filtered_data <- + sample_data[sample_data$position >= window$window_start[i] & + sample_data$position <= window$window_stop[i],] + + ## Perform the loh calculation to obtain avg loh in the window's frame + loh_calc <- abs(as.numeric(as.character(filtered_data$t_vaf)) - normal) + loh_avg <- mean(loh_calc) + window_start <- window$window_start[i] + window_stop <- window$window_stop[i] + if (is.na(loh_avg)==TRUE) + { + loh_avg <- NULL + window_start <- NULL + window_stop <- NULL + } + + filtered_data$loh_diff_avg <- loh_avg + filtered_data$window_start <- window_start + filtered_data$window_stop <- window_stop + return(filtered_data) + })) + + return(df) +} + + + +#' Check input to lohSpec +#' +#' Perform data quality checks on input supplied to lohSpec +#' @name lohSpec_qual +#' @param x object of class data frame with columns 'chromosome', 'position', +#' 'n_vaf', 't_vaf', 'sample' +#' @param y object of class data frame with columns 'chromosome', 'start', +#' 'end' specifying chromosomal boundaries for a genome assembly +#' (required if genome is not specified) +#' @param genome character string specifying the genome assembly from which +#' input data is based +#' @return list of inputs passing basic quality controls + +lohSpec_qual <- function(x, y, genome) +{ + # check input data to x + if(!is.data.frame(x)) + { + stop("Did not detect a data frame for input to x") + } + + # check that correct columns are supplied in x + x_col <- c('chromosome', 'position', 'n_vaf', 't_vaf', 'sample') + if(!all(x_col %in% colnames(x))) + { + stop('Did not detect required column names in x, required columns are: ' + , paste0(x_col, sep="\t")) + } + + # Check that values supplied in vaf columns are in the expected range + if(any(x$nvaf > 1 | x$t_vaf > 1)) { + memo <- paste("Detected values in either the normal or tumor variant", + "allele fraction columns above 1. Values supplied should", + "be a proportion between 0-1!") + stop(memo) + } + + if(any(x$n_vaf < .4 | x$n_vaf > .6)) { + memo <- paste("Detected values with a variant allele fraction either", + "above .6 or below .4 in the normal. Please ensure", + "variants supplied are heterozygous in the normal!") + warning(memo) + } + + # Check chromosome column in x + if(!all(grepl("^chr", x$chromosome))) + { + memo <- paste0("Did not detect the prefix chr in the chromosome column", + " of x... adding prefix") + message(memo) + x$chromosome <- paste0("chr", x$chromosome) + } else if(all(grepl("^chr", x$chromosome))) { + memo <- paste0("detected chr in the chromosome column of x...", + "proceeding") + message(memo) + } else { + memo <- paste0("Detected unknown or mixed prefixes in the chromosome", + " column of x... should either be chr or none i.e. ", + "chr1 or 1") + stop(memo) + } + + # Check genome is acceptable name if y is not supplied + if(is.null(y)) + { + # Check that genome specified is not the ensembl name + preloaded <- c("hg38", "hg19", "mm10", "mm9", "rn5") + if(!any(genome == preloaded)) + { + if(grepl("NCBI|GRC|RGSC|BROAD|BAYLOR|WUGSC", + genome, ignore.case=TRUE)) + { + memo <- paste0("Detected a genome that does not appear to be,", + "in UCSC terms, please specify a genome in UCSC", + " terms to attempt query to UCSC mySQL databae.", + "Alternativly supply a value to y.") + warning(memo) + } + } + } else { + + # Check that y is a data frame + if(!is.data.frame(y)) + { + message("y is not a data frame, attempting to coerce") + y <- as.data.frame(y) + } + + # Check column names of y + if(!all(c('chromosome', 'start', 'end') %in% colnames(y))) + { + memo <- paste0("Did not detect correct column names in y, missing", + "one of \"chromosome\", \"start\", \"end\"") + stop(memo) + } + + # Ensure that columns in data frame are of proper type + y$chromosome <- as.character(y$chromosome) + y$start <- as.integer(as.character(y$start)) + y$end <- as.integer(as.character(y$end)) + } + + return(list(x, y)) +} + +#' Obtain LOH data +#' +#' Obtain LOH heatmap on entire chromsomes from samples in a cohort +#' @name lohSpec_slidingWindow +#' @param loh_data data frame with columns "chromosome", "position", "n_vaf", +#' "t_vaf", "sample" giving raw vaf calls for germline variants +#' @param step integer with the length of divisions (bp) in chromosomes +#' @param window_size integer with the size of the sliding window (bp) to be +#' applied +#' @param normal integer specifying the normal VAF frequency used in LOH +#' calculations +#' @return object of class dataframe containing LOH data +#' @importFrom plyr adply +#' @importFrom plyr ldply + +lohSpec_slidingWindow <- function(loh_data, step, window_size, normal) +{ + ## Obtain lists for each sample and chromosome + out <- split(loh_data, list(as.character(loh_data$chromosome), + as.character(loh_data$sample))) + + ## Obtain the window position values + window_data <- lohSpec_windowPosition(out, step, window_size) + + total <- data.frame() + final_dataset <- list() + final_df <- list() + loh_df <- list() + ## Perform loh Calculations on each chromosome and sample within each window + for (i in 1:length(out)) + { + final_dataset[[i]] <- lohSpec_lohCalc(window_data[[i]], out[[i]], + normal) + #final_dataset[[i]] <- plyr::ldply(final_df[[i]], data.frame) + } + + ## Calculate avg loh for overlapping regions + df <- lohSpec_stepCalc(final_dataset, step = step) + + ## Combine the lists into a single dataframe + loh_dataset <- plyr::ldply(df, data.frame) + colnames(loh_dataset) <- c("window_start", "window_stop", "chromosome", + "sample", "loh_diff_avg") + loh_dataset$loh_diff_avg <- loh_dataset$loh_diff_avg + + return(loh_dataset) +} + +#' Obtain average loh within each step +#' +#' Calculate avverage LOH within each step +#' @name lohSpec_stepCalc +#' @param final_dataset object of class dataframe with columns 'window_start', +#' 'window_stop', 'chromosome', 'position', 'n_vaf', 't_vaf', 'sample', and +#' 'loh_diff_avg' +#' @param step integer with the length of divisions (bp) in chromosomes +#' @return list containing avg loh calculations for each step interval + +lohSpec_stepCalc <- function(final_dataset, step) { + ## Remove irrelevant columns + loh_df1 <- lapply(final_dataset, function(x) + x[!(names(x) %in% c("n_vaf", "t_vaf"))]) + + step_final <- lapply(loh_df1, function(x){ + + ## Obtain dataset with out repeating windowsloh + loh_df <- x + sample <- unique(loh_df$sample) + chromosome <- unique(loh_df$chromosome) + ## Obtain boundaries for each step sized window + step_startMin <- min(as.integer(as.character(loh_df$window_start))) + step_startMax <- max(as.integer(as.character(loh_df$window_start))) + step_stopMin <- min(as.integer(as.character(loh_df$window_stop))) + step_stopMax <- max(as.integer(as.character(loh_df$window_stop))) + + ## Calculate number of step-sized windows needed + intervals <- ((step_startMax + step) - step_startMin)/step + + step_start <- vector() + step_stop <- vector() + + for (i in 1:intervals) { + ## Obtain positions for the first step-sized window + if (i == 1) { + step_start[i] <- step_startMin + step_stop[i] <- step_start[1] + step + } + if (i > 1) { + step_start[i] <- step_start[i-1] + step + step_stop[i] <- step_stop[i-1] + step + } + } + step_df <- data.frame(cbind(step_start, step_stop)) + + ## Set the end position of the last step-sized window to be the + ## end of the chromosome + step_df[nrow(step_df),2] <- as.numeric(as.character(step_stopMax)) + step_df$chromosome <- chromosome + step_df$sample <- sample + + ## Get the avg loh in overlapping windows for each step + for (w in 1:nrow(step_df)) { + start <- as.numeric(as.character(step_df$step_start[w])) + stop1 <- as.numeric(as.character(step_df$step_stop[w])) + + ## Obtain dataset with loh call positions are within the + ## step boundaries + df <- loh_df[loh_df$position >= start & + loh_df$position <= stop1,] + if (nrow(df) == 0) { + step_df$loh_avg[w] <- 0 + } + if (nrow(df) >= 1) { + step_df$loh_avg[w] <- mean(df$loh_diff_avg) + } + } + + ## Remove rows without loh calls made in the step-sized window + final_step_df <- step_df[step_df$loh_avg > 0,] + return(final_step_df) + }) + return(step_final) +} + +#' Obtain window information +#' +#' Calculate window positions to perform LOH calculation +#' @name lohSpec_windowPosition +#' @param out object of class dataframe with columns 'chromosome', +#' 'position', 'n_vaf', 't_vaf', and 'sample' +#' @param step integer with the length of divisions (bp) in chromosomes +#' @param window_size integer with the size of the sliding window (bp) to be +#' applied +#' @return list containing window start/stop positions for each chromosome +#' from each sample to perform LOH calculations + + +lohSpec_windowPosition <- function(out, step, window_size) +{ + window <- lapply(out, function(x) { + ## Calculate the number of windows necessary for each list + min <- integer() + max <- integer() + window_stop_1 <- integer() + window_num <- integer() + min <- as.integer(min(as.numeric(as.character(x$position)))) + max <- as.integer(max(as.numeric(as.character(x$position)))) + window_stop_1 <- min+window_size + num <- as.integer((max-min)/step) + num <- as.vector(1:num) + window_data_start <- vector() + window_data_stop <- vector() + + ## Calculate exact window positions + window_data <- lapply(num, function(x){ + window_data_start[x] <- as.integer(min+(step*(x-1))) + window_data_stop[x] <- as.integer(window_stop_1+(step*(x-1))) + window_data <- cbind(window_data_start[x], window_data_stop[x]) + return(window_data) + }) + window_data <- plyr::ldply(window_data, data.frame) + # Get window positions whose values are below max & set max as the + # final window position (end of the chromosome) + colnames(window_data) <- c("window_start", "window_stop") + window_final <- window_data[window_data$window_stop <= max,] + window_final[nrow(window_final), 2] <- max + return(window_final) + }) + return(window) +} + + diff --git a/R/lohSpec-class.R b/R/lohSpec-class.R index 5032f99..46be01b 100644 --- a/R/lohSpec-class.R +++ b/R/lohSpec-class.R @@ -47,7 +47,7 @@ setClass( #' If TRUE, will use average normal VAF in each individual sample as value #' to calculate LOH. #' @export -lohSpec <- function(input, lohSpec=TRUE, chromosomes="autosomes", samples=NULL, +LohSpec <- function(input, lohSpec=TRUE, chromosomes="autosomes", samples=NULL, BSgenome=BSgenome, step=1000000, windowSize=2500000, normal=FALSE, gradientMidpoint=.2, gradientColors=c("#ffffff", "#b2b2ff", "#000000"), plotAType="proportion", plotALohCutoff=0.2, plotAColor="#98F5FF", @@ -79,7 +79,6 @@ lohSpec <- function(input, lohSpec=TRUE, chromosomes="autosomes", samples=NULL, #' #' An S4 class for the Data of the loh plot object #' @name lohData-class -#' @name lohData-class setClass("lohData", representation=representation(primaryData="data.table", windowData="data.table", @@ -213,7 +212,7 @@ lohSpecPlots <- function(object, plotALohCutoff, plotAType, plotAColor, } if(name == "primaryData" | index == 1){ - data <- object@lohData + data <- object@primaryData } return(data) @@ -237,11 +236,10 @@ setMethod(f="getData", #' @aliases getGrob #' @noRd .getGrob_lohSpec <- function(object, index=1, ...){ - browser() if(index == 1){ - grob <- object@lohFreq_plot + grob <- object@PlotA } else if(index == 2) { - grob <- object@lohSpec_plot + grob <- object@PlotB } else if (index == 3) { grob <- object@Grob } else { @@ -335,7 +333,7 @@ setMethod(f="chrSubset", ## Determine which chromosomes to plot ## Only include autosomes if (chromosomes[1] == "autosomes") { - chromosomes <- as.character(c(seq(1:22))) + chromosomes <- paste("chr", as.character(c(seq(1:22))), sep="") } ## Include all chromosomes if (chromosomes[1] == "all") { diff --git a/R/lohSpec.R b/R/lohSpec.R deleted file mode 100644 index e365efe..0000000 --- a/R/lohSpec.R +++ /dev/null @@ -1,177 +0,0 @@ -#' Plot LOH data -#' -#' Construct a graphic visualizing Loss of Heterozygosity in a cohort -#' @name lohSpec -#' @param x object of class data frame with rows representing germline calls. -#' The data frame must contain columns with the following names "chromosome", -#' "position", "n_vaf", "t_vaf", "sample". required if path is set to NULL (see -#' details). vaf should range from 0-1. -#' @param y Object of class data frame with rows representing chromosome -#' boundaries for a genome assembly. The data frame must contain columns with -#' the following names "chromosome", "start", "end" (optional: see details). -#' @param genome Character string specifying a valid UCSC genome (see details). -#' @param gender Character vector of length equal to the number of samples, -#' consisting of elements from the set {"M", "F"}. Used to suppress the plotting -#' of allosomes where appropriate. -#' @param path Character string specifying the path to a directory containing -#' germline calls for each sample. Germline calls are expected to be stored as -#' tab-seperated files which contain the following column names "chromosome", -#' "position", "n_vaf", "t_vaf", and "sample". required if x is set to null -#' (see details). -#' @param fileExt Character string specifying the file extensions of files -#' within the path specified. Required if argument is supplied to path -#' (see details). -#' @param step Integer value specifying the step size (i.e. the number of base -#' pairs to move the window). required when method is set to slide -#' (see details). -#' @param window_size Integer value specifying the size of the window in base -#' pairs in which to calculate the mean Loss of Heterozygosity (see details). -#' @param normal Numeric value within the range 0-1 specifying the expected -#' normal variant allele frequency to be used in Loss of Heterozygosity -#' calculations. defaults to .50\% -#' @param colourScheme Character vector specifying the colour scale to use from -#' the viridis package. One of "viridis", "magma", "plasma", or "inferno". -#' @param plotLayer Valid ggpot2 layer to be added to the plot. -#' @param method character string specifying the approach to be used for -#' displaying Loss of Heterozygosity, one of "tile" or "slide" (see details). -#' @param out Character vector specifying the the object to output, one of -#' "data", "grob", or "plot", defaults to "plot" (see returns). -#' @return One of the following, a list of dataframes containing data to be -#' plotted, a grob object, or a plot. -#' @details lohSpec is intended to plot the loss of heterozygosity (LOH) within -#' a sample. As such lohSpec expects input data to contain only LOH calls. Input -#' can be supplied as a single data frame given to the argument x with rows -#' containing germline calls and variables giving the chromosome, position, -#' normal variant allele frequency, tumor variant allele frequency, and the -#' sample. In lieu of this format a series of .tsv files can be supplied via the -#' path and fileExt arguments. If this method is choosen samples will be infered -#' from the file names. In both cases columns containing the variant allele -#' frequency for normal and tumor samples should range from 0-1. -#' Two methods exist to calculate and display LOH events. If the method is set -#' to "tile" mean LOH is calculated based on the window_size argument with -#' windows being placed next to each other. If the method is set to slide the -#' widnow will slide and calculate the LOH based on the step parameter. -#' In order to ensure the entire chromosome is plotted lohSpec requries the -#' location of chromosome boundaries for a given genome assembly. As a -#' convenience this information is available for the following genomes "hg19", -#' "hg38", "mm9", "mm10", "rn5" and can be tetrieved by supplying one of the -#' afore mentioned assemblies via the 'genome'paramter. If an argument is -#' supplied to the 'genome' parameter and is unrecognized a query to the UCSC -#' MySQL database will be attempted to obtain the required information. If -#' chromosome boundary locations are unavailable for a given assembly this -#' information can be supplied to the 'y' parameter which has priority over the -#' 'genome' parameter. -#' @importFrom gtools mixedsort -#' @examples -#' # plot loh within the example dataset -#' lohSpec(x=HCC1395_Germline) -#' @export - -lohSpec <- function(x=NULL, path=NULL, fileExt=NULL, y=NULL, genome='hg19', - gender=NULL, step=1000000, window_size=2500000, - normal=.50, colourScheme="inferno", plotLayer=NULL, - method="slide", out="plot") -{ - # Grab data if necessary - if(!is.null(path)) - { - if(is.null(fileExt)) - { - memo <- paste0("argument required to variable fileExt if argument ", - "is supplied to path") - stop(memo) - } - x <- lohSpec_fileGlob(path=path, fileExt=fileExt, step=step, - window_size=window_size, gender=gender) - } - if (is.null(path)) { - if (is.null(gender) == FALSE) { - x <- x[x$chromosome !="Y",] - } - if(is.null(gender) == TRUE) { - x <- x[(x$chromosome != "X" & - x$chromosome != "Y"),] - } - } - - # Data Quality Check - input <- lohSpec_qual(x, y, genome) - x <- input[[1]] - y <- input[[2]] - - # Obtain dummy data for genome - preloaded <- c('hg38', 'hg19', 'mm10', 'mm9', 'rn5') - if(!is.null(y)) - { - message("detected input to y, using supplied positions for chromosome - boundaries") - chr_pos <- y - } else if(is.null(y) && any(genome == preloaded)) { - message("genome specified is preloaded, retrieving data...") - chr_pos <- GenVisR::cytoGeno[GenVisR::cytoGeno$genome == genome,] - chr_pos <- multi_chrBound(chr_pos) - } else { - message("attempting to query UCSC sql database for chromosome - positions") - cyto_data <- suppressWarnings(multi_cytobandRet(genome)) - chr_pos <- multi_chrBound(cyto_data) - } - - # Quality check for dummy data - if(nrow(chr_pos) < 1) - { - memo <- paste0("Could not retrieve chromosome boundaries from", - " UCSC, please specify this information via ", - "the y paramter") - stop(memo) - } - - # Produce dataset with loh mean absolute differences - if (toupper(method) == 'SLIDE') { - # Calculate loh via sliding window - loh <- lohSpec_slidingWindow(loh_data=x, step, window_size, normal) - } - else if(toupper(method) == 'TILE') { - # Calculate loh via tiled window - ## Insert code - loh <- lohSpec_tileWindow(loh_data=x, window_size, normal) - } - else { - memo <- paste0("Did not recognize input to parameter method.", - "Please specify one of \"Tile\" or \"Slide\".") - stop(memo) - } - - # set order of x axis labels in plot - chromosomes <- gtools::mixedsort(as.character(unique(loh$chromosome))) - - # remove X and/or Y chromosomes - if (is.null(gender) == FALSE) { - chromosomes <- chromosomes[chromosomes != "Y"] - chr_pos <- chr_pos[(chr_pos$chromosome != "chrY"),] - loh <- loh[loh$chromosome != "Y",] - } - if (is.null(gender) == TRUE) { - chromosomes <- chromosomes[chromosomes != "X" & chromosomes != "Y"] - chr_pos <- chr_pos[(chr_pos$chromosome != "chrX" & - chr_pos$chromosome != "chrY"),] - loh <- loh[(loh$chromosome != "Y" & loh$chromosome != "X"),] - } - loh$chromosome <- factor(loh$chromosome, levels=chromosomes) - chr_pos_levels <- gtools::mixedsort(as.character(unique(chr_pos$chromosome))) - chr_pos$chromosome <- - factor(chr_pos$chromosome, levels=chr_pos_levels) - - # set order of y axis labels in plot - samples <- gtools::mixedsort(as.character(unique(loh$sample))) - loh$sample <- factor(loh$sample, levels=samples) - - #build the plot - loh_plot <- lohSpec_buildMain(loh, dummyData=chr_pos, - colourScheme=colourScheme, - plotLayer=plotLayer) - - # Decide what to output - output <- multi_selectOut(data=loh, plot=loh_plot, draw=FALSE, out=out) - return(output) -} diff --git a/R/lohSpec_buildMain.R b/R/lohSpec_buildMain.R deleted file mode 100644 index 0d63da8..0000000 --- a/R/lohSpec_buildMain.R +++ /dev/null @@ -1,68 +0,0 @@ -#' Plot LOH data -#' -#' Build a ggplot2 object displaying calculated LOH data -#' @name lohSpec_buildMain -#' @param x object of class dataframe with loh difference -#' calculations and column names "window_start", "window_stop", "chromosome", -#' "sample", and "loh_diff" -#' @param dummyData object of class dataframe with column names "chromosome", -#' "start", "end" specifying chromosome boundaries -#' @param colourScheme Character vector specifying the colour scale to use from -#' the viridis package. One of "viridis", "magma", "plasma", or "inferno". -#' @param plotLayer Valid ggplot2 layer to be added to the plot. -#' for the legend's parameters -#' @return object of class ggplot2 -#' @import ggplot2 -#' @importFrom viridis scale_fill_viridis - -lohSpec_buildMain <- function(x, dummyData, colourScheme="inferno", - plotLayer=NULL) -{ - # define dummy data which will be chromosome boundaries, these are plotted - # but are transparent and will not appear in the plot - dummy_data <- geom_rect(data=dummyData, aes_string(xmin='start', xmax='end', - ymin=-1, ymax=1),alpha=0) - # Define the main plot - data <- geom_rect(data=x, aes_string(xmin='window_start', - xmax='window_stop', - ymin=-1, - ymax=1, fill='loh_diff_avg')) - - - # Define additional plot parameters - facet <- facet_grid(sample ~ chromosome, scales="free", space="free") - - x_scale <- scale_x_continuous(expand = c(0, 0)) - y_scale <- scale_y_continuous(expand = c(0,0)) - - lab_x <- xlab("Chromosome") - lab_y <- ylab("Sample") - - # Define plot aesthetics - BWscheme <- theme_bw() - plotTheme <- theme(axis.ticks.x=element_blank(), - axis.text.x=element_blank(), - axis.ticks.y=element_blank(), - axis.text.y=element_blank(), - panel.grid.major=element_blank(), - panel.grid.minor=element_blank()) - - # plot an additional layer if specified - if(!is.null(plotLayer)) - { - plotLayer <- plotLayer - } else { - plotLayer <- geom_blank() - } - - # Define colour rame - LOHgradient <- viridis::scale_fill_viridis("Avg. VAF Difference", - option=colourScheme) - - # Build the plot - tmp <- data.frame(x=0, y=0) - p1 <- ggplot(data=tmp, aes(y=0)) + dummy_data + data + facet + x_scale + y_scale + - lab_x + lab_y + BWscheme + LOHgradient + plotTheme + plotLayer - - return(p1) -} diff --git a/R/lohSpec_fileGlob.R b/R/lohSpec_fileGlob.R deleted file mode 100644 index 0b106ad..0000000 --- a/R/lohSpec_fileGlob.R +++ /dev/null @@ -1,99 +0,0 @@ -#' Grab data for lohSpec -#' -#' Look in the specified file path and grab data with the proper extension for -#' lohSpec -#' @name lohSpec_fileGlob -#' @param path character string specifying which directory contains -#' the sample information stored as datasets with columns "chromosome", -#' "position", "n_vaf", "t_vaf", and "sample" (required if x is not specified) -#' @param fileExt character string specifying the file extensions of files -#' @param step integer with the length of divisions (bp) in chromosomes -#' @param gender vector of length equal to the number of samples, consisting of -#' elements from the set {"M", "F"} -#' @param window_size Integer value specifying the size of the window in base -#' pairs in which to calculate the mean Loss of Heterozygosity. -#' @return object of class data frame from data specified in path for lohSpec -#' @importFrom utils read.delim - -lohSpec_fileGlob <- function(path, fileExt, step, window_size, gender) -{ - # Obtain file names with the tumor and normal vaf values - fileNames <- Sys.glob(paste0(path, '*.', fileExt)) - # Determine the column names of the dataset - if (is.null(gender) == FALSE) { - columnNames <- c("chromosome", "position", "n_vaf", "t_vaf", "sample", - "gender") - } - if(is.null(gender) == TRUE) { - columnNames <- c("chromosome", "position", "n_vaf", "t_vaf", "sample") - } - - # Extract raw t_vaf and n_vaf values and merge the dataset - for (i in 1:length(fileNames)) - { - data <- utils::read.delim(fileNames[i]) - if (is.null(gender) == FALSE) { - data <- data[data$chromosome !="Y",] - if (is.null(data$gender) == TRUE) { - data$gender <- gender[i] - } - } - if(is.null(gender) == TRUE) { - data <- data[data$chromosome != "X" & - data$chromosome != "Y",] - } - if(!all(columnNames %in% colnames(data))) - { - memo <- paste0("Did not detect all of the required columns in the", - " following file:", fileNames[i], "... skipping") - warning(memo) - next - } - - if (!exists("dataset", inherits=FALSE)) - { - dataset <- data - } else if(exists("dataset", inherits=FALSE)) { - temp <- data - dataset <- rbind(dataset, temp) - rm(temp) - } - - rm(data) - } - ## Solves problem of user removing loh values for any autosome - all_lev <- unique(droplevels(dataset$chromosome)) - sample <- unique(dataset$sample) - total <- data.frame() - for (r in 1:length(sample)) { - df <- dataset[dataset$sample==sample[r],] - dflevels <- unique(droplevels(df$chromosome)) - chrDiff <- setdiff(all_lev, dflevels) - if (length(chrDiff) >= 1) { - for (i in 1:length(chrDiff)) { - if(is.null(gender)==TRUE) { - d1 <- c(as.numeric(chrDiff[i]), step, 50, 50, - as.character(sample[r])) - d2 <- c(as.numeric(chrDiff[i]), - step + window_size, 50, 50, - as.character(sample[r])) - df <- data.frame(rbind(df, d1, d2)) - } - if(is.null(gender)==FALSE) { - d1 <- c(as.character(chrDiff[i]), step, 50, 50, - as.character(sample[r]), - as.character(gender[r])) - - d2 <- c(as.character(chrDiff[i]),step + window_size, - 50, 50, - as.character(sample[r]), - as.character(gender[r])) - df <- data.frame(rbind(df, d1, d2)) - } - } - } - total <- rbind(total, df) - } - return(total) -} - diff --git a/R/lohSpec_lohCalc.R b/R/lohSpec_lohCalc.R deleted file mode 100644 index 86c3902..0000000 --- a/R/lohSpec_lohCalc.R +++ /dev/null @@ -1,55 +0,0 @@ -#' Calculate loh difference -#' -#' Obtain LOH on an entire chromsomes from samples in a cohort -#' @name lohSpec_lohCalc -#' @param window_data object of class data frame with columns -#' 'window_start' and 'window_stop -#' @param out object of class dataframe with columns 'chromosome', -#' 'position', 'n_vaf', 't_vaf', and 'sample' -#' @param normal integer specifying the subtraction value from tumor VAF -#' @return object of class dataframe containing mean LOH difference calculations -#' and column names "window_start", "window_stop", "chromosome", "position", -#' "n_vaf", "t_vaf", "sample", "loh_diff" - -lohSpec_lohCalc <- function(window_data, out, normal) - -{ - ## Set each list as a dataframe - window <- data.frame(window_data) - sample_data <- data.frame(out) - sample_data$position <- as.numeric(as.character(sample_data$position)) - total <- data.frame() - window_start <- vector() - window_stop <- vector() - num <- as.vector(1:nrow(window)) - - df <- do.call("rbind", lapply(num, function(i){ - ## filter sample_data for loh calls whose positions fall in the - ## window frame - filtered_data <- - sample_data[sample_data$position >= window$window_start[i] & - sample_data$position <= window$window_stop[i],] - - ## Perform the loh calculation to obtain avg loh in the window's frame - loh_calc <- abs(as.numeric(as.character(filtered_data$t_vaf)) - normal) - loh_avg <- mean(loh_calc) - window_start <- window$window_start[i] - window_stop <- window$window_stop[i] - if (is.na(loh_avg)==TRUE) - { - loh_avg <- NULL - window_start <- NULL - window_stop <- NULL - } - - filtered_data$loh_diff_avg <- loh_avg - filtered_data$window_start <- window_start - filtered_data$window_stop <- window_stop - return(filtered_data) - })) - - return(df) -} - - - diff --git a/R/lohSpec_qual.R b/R/lohSpec_qual.R deleted file mode 100644 index 2156a9f..0000000 --- a/R/lohSpec_qual.R +++ /dev/null @@ -1,104 +0,0 @@ -#' Check input to lohSpec -#' -#' Perform data quality checks on input supplied to lohSpec -#' @name lohSpec_qual -#' @param x object of class data frame with columns 'chromosome', 'position', -#' 'n_vaf', 't_vaf', 'sample' -#' @param y object of class data frame with columns 'chromosome', 'start', -#' 'end' specifying chromosomal boundaries for a genome assembly -#' (required if genome is not specified) -#' @param genome character string specifying the genome assembly from which -#' input data is based -#' @return list of inputs passing basic quality controls - -lohSpec_qual <- function(x, y, genome) -{ - # check input data to x - if(!is.data.frame(x)) - { - stop("Did not detect a data frame for input to x") - } - - # check that correct columns are supplied in x - x_col <- c('chromosome', 'position', 'n_vaf', 't_vaf', 'sample') - if(!all(x_col %in% colnames(x))) - { - stop('Did not detect required column names in x, required columns are: ' - , paste0(x_col, sep="\t")) - } - - # Check that values supplied in vaf columns are in the expected range - if(any(x$nvaf > 1 | x$t_vaf > 1)) { - memo <- paste("Detected values in either the normal or tumor variant", - "allele fraction columns above 1. Values supplied should", - "be a proportion between 0-1!") - stop(memo) - } - - if(any(x$n_vaf < .4 | x$n_vaf > .6)) { - memo <- paste("Detected values with a variant allele fraction either", - "above .6 or below .4 in the normal. Please ensure", - "variants supplied are heterozygous in the normal!") - warning(memo) - } - - # Check chromosome column in x - if(!all(grepl("^chr", x$chromosome))) - { - memo <- paste0("Did not detect the prefix chr in the chromosome column", - " of x... adding prefix") - message(memo) - x$chromosome <- paste0("chr", x$chromosome) - } else if(all(grepl("^chr", x$chromosome))) { - memo <- paste0("detected chr in the chromosome column of x...", - "proceeding") - message(memo) - } else { - memo <- paste0("Detected unknown or mixed prefixes in the chromosome", - " column of x... should either be chr or none i.e. ", - "chr1 or 1") - stop(memo) - } - - # Check genome is acceptable name if y is not supplied - if(is.null(y)) - { - # Check that genome specified is not the ensembl name - preloaded <- c("hg38", "hg19", "mm10", "mm9", "rn5") - if(!any(genome == preloaded)) - { - if(grepl("NCBI|GRC|RGSC|BROAD|BAYLOR|WUGSC", - genome, ignore.case=TRUE)) - { - memo <- paste0("Detected a genome that does not appear to be,", - "in UCSC terms, please specify a genome in UCSC", - " terms to attempt query to UCSC mySQL databae.", - "Alternativly supply a value to y.") - warning(memo) - } - } - } else { - - # Check that y is a data frame - if(!is.data.frame(y)) - { - message("y is not a data frame, attempting to coerce") - y <- as.data.frame(y) - } - - # Check column names of y - if(!all(c('chromosome', 'start', 'end') %in% colnames(y))) - { - memo <- paste0("Did not detect correct column names in y, missing", - "one of \"chromosome\", \"start\", \"end\"") - stop(memo) - } - - # Ensure that columns in data frame are of proper type - y$chromosome <- as.character(y$chromosome) - y$start <- as.integer(as.character(y$start)) - y$end <- as.integer(as.character(y$end)) - } - - return(list(x, y)) -} diff --git a/R/lohSpec_slidingWindow.R b/R/lohSpec_slidingWindow.R deleted file mode 100644 index 8b63273..0000000 --- a/R/lohSpec_slidingWindow.R +++ /dev/null @@ -1,48 +0,0 @@ -#' Obtain LOH data -#' -#' Obtain LOH heatmap on entire chromsomes from samples in a cohort -#' @name lohSpec_slidingWindow -#' @param loh_data data frame with columns "chromosome", "position", "n_vaf", -#' "t_vaf", "sample" giving raw vaf calls for germline variants -#' @param step integer with the length of divisions (bp) in chromosomes -#' @param window_size integer with the size of the sliding window (bp) to be -#' applied -#' @param normal integer specifying the normal VAF frequency used in LOH -#' calculations -#' @return object of class dataframe containing LOH data -#' @importFrom plyr adply -#' @importFrom plyr ldply - -lohSpec_slidingWindow <- function(loh_data, step, window_size, normal) -{ - ## Obtain lists for each sample and chromosome - out <- split(loh_data, list(as.character(loh_data$chromosome), - as.character(loh_data$sample))) - - ## Obtain the window position values - window_data <- lohSpec_windowPosition(out, step, window_size) - - total <- data.frame() - final_dataset <- list() - final_df <- list() - loh_df <- list() - ## Perform loh Calculations on each chromosome and sample within each window - for (i in 1:length(out)) - { - final_dataset[[i]] <- lohSpec_lohCalc(window_data[[i]], out[[i]], - normal) - #final_dataset[[i]] <- plyr::ldply(final_df[[i]], data.frame) - } - - ## Calculate avg loh for overlapping regions - df <- lohSpec_stepCalc(final_dataset, step = step) - - ## Combine the lists into a single dataframe - loh_dataset <- plyr::ldply(df, data.frame) - colnames(loh_dataset) <- c("window_start", "window_stop", "chromosome", - "sample", "loh_diff_avg") - loh_dataset$loh_diff_avg <- loh_dataset$loh_diff_avg - - return(loh_dataset) -} - diff --git a/R/lohSpec_stepCalc.R b/R/lohSpec_stepCalc.R deleted file mode 100644 index 61b7bd2..0000000 --- a/R/lohSpec_stepCalc.R +++ /dev/null @@ -1,75 +0,0 @@ -#' Obtain average loh within each step -#' -#' Calculate avverage LOH within each step -#' @name lohSpec_stepCalc -#' @param final_dataset object of class dataframe with columns 'window_start', -#' 'window_stop', 'chromosome', 'position', 'n_vaf', 't_vaf', 'sample', and -#' 'loh_diff_avg' -#' @param step integer with the length of divisions (bp) in chromosomes -#' @return list containing avg loh calculations for each step interval - -lohSpec_stepCalc <- function(final_dataset, step) { - ## Remove irrelevant columns - loh_df1 <- lapply(final_dataset, function(x) - x[!(names(x) %in% c("n_vaf", "t_vaf"))]) - - step_final <- lapply(loh_df1, function(x){ - - ## Obtain dataset with out repeating windowsloh - loh_df <- x - sample <- unique(loh_df$sample) - chromosome <- unique(loh_df$chromosome) - ## Obtain boundaries for each step sized window - step_startMin <- min(as.integer(as.character(loh_df$window_start))) - step_startMax <- max(as.integer(as.character(loh_df$window_start))) - step_stopMin <- min(as.integer(as.character(loh_df$window_stop))) - step_stopMax <- max(as.integer(as.character(loh_df$window_stop))) - - ## Calculate number of step-sized windows needed - intervals <- ((step_startMax + step) - step_startMin)/step - - step_start <- vector() - step_stop <- vector() - - for (i in 1:intervals) { - ## Obtain positions for the first step-sized window - if (i == 1) { - step_start[i] <- step_startMin - step_stop[i] <- step_start[1] + step - } - if (i > 1) { - step_start[i] <- step_start[i-1] + step - step_stop[i] <- step_stop[i-1] + step - } - } - step_df <- data.frame(cbind(step_start, step_stop)) - - ## Set the end position of the last step-sized window to be the - ## end of the chromosome - step_df[nrow(step_df),2] <- as.numeric(as.character(step_stopMax)) - step_df$chromosome <- chromosome - step_df$sample <- sample - - ## Get the avg loh in overlapping windows for each step - for (w in 1:nrow(step_df)) { - start <- as.numeric(as.character(step_df$step_start[w])) - stop1 <- as.numeric(as.character(step_df$step_stop[w])) - - ## Obtain dataset with loh call positions are within the - ## step boundaries - df <- loh_df[loh_df$position >= start & - loh_df$position <= stop1,] - if (nrow(df) == 0) { - step_df$loh_avg[w] <- 0 - } - if (nrow(df) >= 1) { - step_df$loh_avg[w] <- mean(df$loh_diff_avg) - } - } - - ## Remove rows without loh calls made in the step-sized window - final_step_df <- step_df[step_df$loh_avg > 0,] - return(final_step_df) - }) - return(step_final) -} diff --git a/R/lohSpec_tileCalc.R b/R/lohSpec_tileCalc.R deleted file mode 100644 index cd0d889..0000000 --- a/R/lohSpec_tileCalc.R +++ /dev/null @@ -1,47 +0,0 @@ -#' Calculate loh difference -#' -#' Obtain LOH on an entire chromsomes from samples in a cohort -#' @name lohSpec_tileCalc -#' @param window_data object of class data frame with columns "chromosome", -#' "position", "n_vaf", "t_vaf", "sample", "bin", "window_start", "window_stop" -#' @param normal integer specifying the subtraction value from tumor VAF -#' @return object of class dataframe containing mean LOH difference calculations -#' and column names "window_start", "window_stop", "chromosome", "position", -#' "n_vaf", "t_vaf", "sample", "loh_diff" - -lohSpec_tileCalc <- function(window_data, normal) -{ - - ## Tile function to calculate LOH - ## Calculate absolute loh difference from normal for each call - total <- lapply(window_data, function(x) { - ## Get the tumor vaf difference from 50 - t_vaf <- x$t_vaf - diff <- abs(t_vaf-.50) - x$loh_diff <- diff - - ## Obtain the bin values - breaks <- as.character(unique(x$bin)) - - ## Calculate the average loh difference within each bin - for (i in 1:length(breaks)) { - data <- subset(x, as.character(x$bin)==breaks[i]) - data$loh_diff_avg <- mean(data$loh_diff) - - ## Merge the datasets for each sample - if(!exists("new_loh_data", inherits=FALSE)) { - new_loh_data <- data - } - if(exists("new_loh_data", inherits=FALSE)) { - temp <- data - new_loh_data <- rbind(new_loh_data, temp) - rm(temp) - } - rm(data) - } - return(new_loh_data) - }) - return(total) -} - - diff --git a/R/lohSpec_tilePosition.R b/R/lohSpec_tilePosition.R deleted file mode 100644 index 792a4fe..0000000 --- a/R/lohSpec_tilePosition.R +++ /dev/null @@ -1,46 +0,0 @@ -#' Obtain window information -#' -#' Calculate window positions to perform LOH calculation -#' @name lohSpec_tilePosition -#' @param out object of class dataframe with columns 'chromosome', -#' 'position', 'n_vaf', 't_vaf', and 'sample' -#' @param window_size integer with the size of the sliding window (bp) to be -#' applied -#' @return list containing window start/stop positions for each chromosome -#' from each sample to perform LOH calculations - - -lohSpec_tilePosition <- function(out, window_size) -{ - ## Tiling function - window <- lapply(out, function(x) { - min <- as.integer(min(as.numeric(as.character(x$position)))) - max <- as.integer(max(as.numeric(as.character(x$position)))) - bin <- seq(min, max, by=window_size) - num <- length(bin) - if (bin[num] < max) { - bin[num] <- max - } - breaks <- cut(as.numeric(as.character(x$position)), breaks=bin, - include.lowest=TRUE, dig.lab=11) - x$bin <- breaks - - bins <- vector() - bin_min <- vector() - bin_max <- vector() - for(i in 1:length(breaks)) { - bins[i] <- strsplit(as.character(breaks[i]), - split="[[:punct:]]") - bin_min[i] <- as.numeric(as.character(bins[[i]][2])) - bin_max[i] <- as.numeric(as.character(bins[[i]][3])) - } - x$min <- bin_min - x$max <- bin_max - colnames(x) <- c("chromosome", "position", "n_vaf", "t_vaf", "sample", - "bin", "window_start", "window_stop") - return(x) - }) - - return(window) -} - diff --git a/R/lohSpec_tileWindow.R b/R/lohSpec_tileWindow.R deleted file mode 100644 index 521c730..0000000 --- a/R/lohSpec_tileWindow.R +++ /dev/null @@ -1,36 +0,0 @@ -#' Obtain LOH data -#' -#' Obtain LOH heatmap on entire chromsomes from samples in a cohort -#' @name lohSpec_tileWindow -#' @param loh_data data frame with columns "chromosome", "position", "n_vaf", -#' "t_vaf", "sample" giving raw vaf calls for germline variants -#' @param window_size integer with the size of the sliding window (bp) to be -#' applied -#' @param normal integer specifying the normal VAF frequency used in LOH -#' calculations -#' @return object of class dataframe containing LOH data -#' @importFrom plyr adply -#' @importFrom plyr ldply - -lohSpec_tileWindow <- function(loh_data, window_size, normal) -{ - ## Obtain lists for each sample and chromosome - out <- split(loh_data, list(as.character(loh_data$chromosome), - as.character(loh_data$sample))) - - ## Obtain the window position values - window_data <- lohSpec_tilePosition(out, window_size) - - ## Perform loh difference calculation - total <- data.frame() - final_dataset <- list() - final_dataset <- lohSpec_tileCalc(window_data, normal=normal) - - ## Combine the lists into a single dataframe - loh_dataset <- plyr::ldply(final_dataset, data.frame) - loh_dataset <- loh_dataset[!duplicated(loh_dataset),] - loh_dataset$loh_diff_avg <- loh_dataset$loh_diff_avg - - return(loh_dataset) -} - diff --git a/R/lohSpec_windowPosition.R b/R/lohSpec_windowPosition.R deleted file mode 100644 index 5310d8b..0000000 --- a/R/lohSpec_windowPosition.R +++ /dev/null @@ -1,48 +0,0 @@ -#' Obtain window information -#' -#' Calculate window positions to perform LOH calculation -#' @name lohSpec_windowPosition -#' @param out object of class dataframe with columns 'chromosome', -#' 'position', 'n_vaf', 't_vaf', and 'sample' -#' @param step integer with the length of divisions (bp) in chromosomes -#' @param window_size integer with the size of the sliding window (bp) to be -#' applied -#' @return list containing window start/stop positions for each chromosome -#' from each sample to perform LOH calculations - - -lohSpec_windowPosition <- function(out, step, window_size) -{ - window <- lapply(out, function(x) { - ## Calculate the number of windows necessary for each list - min <- integer() - max <- integer() - window_stop_1 <- integer() - window_num <- integer() - min <- as.integer(min(as.numeric(as.character(x$position)))) - max <- as.integer(max(as.numeric(as.character(x$position)))) - window_stop_1 <- min+window_size - num <- as.integer((max-min)/step) - num <- as.vector(1:num) - window_data_start <- vector() - window_data_stop <- vector() - - ## Calculate exact window positions - window_data <- lapply(num, function(x){ - window_data_start[x] <- as.integer(min+(step*(x-1))) - window_data_stop[x] <- as.integer(window_stop_1+(step*(x-1))) - window_data <- cbind(window_data_start[x], window_data_stop[x]) - return(window_data) - }) - window_data <- plyr::ldply(window_data, data.frame) - # Get window positions whose values are below max & set max as the - # final window position (end of the chromosome) - colnames(window_data) <- c("window_start", "window_stop") - window_final <- window_data[window_data$window_stop <= max,] - window_final[nrow(window_final), 2] <- max - return(window_final) - }) - return(window) -} - - \ No newline at end of file diff --git a/Rplot.png b/Rplot.png deleted file mode 100644 index aaffeb161013525521114e9211f65e54212895e5..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 356303 zcma&Oc|6o@`##=si#w54*{M*7%9dRzOZJ^?*|L*;Cn?HavhUf)I>8l<(>s zIz&x#=+IxxG{?XzhPDFH;6HQ@3JO{(3JRQB9&V2uoNW&sx)mF%Z)VS`e^wUZX?N)| zO4nKBxmSrC9XDN~fk<9mb0`)o=9;V`_U+=F4TXeC{erqBjM&Z7yr&g(gOG9d6SCn6 z=asdS-YE^4%m9dAxC(?PO+M6xFP>ZD4_9&^=P}NY)Gubqn`p(LocZG zbsb-%FvRzEY$%@CzEM45k*n^w0Gpe6Yn9=R&4oWETkhq!e6WAM;?iE+pOz#0jBIJT z%`eK0|DpX!74|wuaffEg$tAd+_4{~o#;a3u#}Xzc)2oV3k?)$8k5j|iatbQmMRA4T zpNXvqOkI1?FOKil{eUThC3a+f@cGmr`e1ok>aX`Nn@!S}x;(aBbhDT7GX&A}oIp{iVGh;v3tM42x%+o(qdlHf86PXtj)~R$cCCr9u&LdFVhqX&dM;KL z7TQKv`#05<)a#M0$JLFFp0c?je++jXV_zChf9&SjinB~n7I}{tS@7?rmnG}c`aZOM ze6#oYvqku3BdU(iCQ|n4`5NY(xbpKuwo7HtO|8$!g$Rfrk>g?FJUtfPZ+=sS^2+_@ z;fwxJ((05%)|xXmVT;v>5)F~T}U8TYUfb%@-D`@(!`rn;l$0`&C}mwK*l zQ<=5ybXveo=LN*I>!+BqnhjB#7Mlw@H!1u(js@RCe;O_|cyvAJMbxOZ6P=Abef61L zj!mEcHIUZvvV(2Ked(v+NyU)lFKPIyRWoU0H$i&E@)W8q$4vt!jo7>8tKqAWbpoxt z!B=)WTl<2$gZqL}!5_?yyprn4nr{0c_?W}fqLbpd!u$Xic;5d)gWY_xQ~77FTt58pl+SzF|j>vCj!hYelo zTBAc4w4Mw;Vmu`2x2r6Z6pLpLUw?y0)oQkVEl+5}htm~5Nh5l~pNvc~b&%V`+e_(s197Owlc%4W= zZr$_?*&Uvr_~coRzxL#vxKtJrNA?<#mESKrWEUHHI5#IqU+dwX+o419hg9y~*7G|| z#8S7MMQ`peMNUS)ctLgcgZZl`cQ@~yz38YH!yJ3;Tnw{SN5r+L=SDQ=iBzfruPy`% zUDyogin?-9y?}P`+_RoSi@hM;w7$t!soL5#6eKqb-cb2-0@f)8n#n)-)D;nRscWd*(Oba6LVHc7AQrRgqe z+{W%Rd~)bN|2V59PZv;TP|>}0E<@Dmk=*X8?nu{iq`$qG|KFeE_h;G&$se_(M6e$I_elQp2Zy~qRbnP0aqU$M zJ?pKn$wC(FU+f#kU8N8!C@C51?V+4K8(K!eRa1*z{&W!stM&-Gl@pe~zJCx4q&WAl zb+o)SZw;XQYCjnm@hb(n(@~_JG27IJF_hl?nV8Kr;fo8VpbahjD}^ZM;$^o=(51S( z4i_G*kJ;sLn=w9rep33^6H#Z(b%!gOa=Uf0>@t$`%~u3iCA~`C*$-TFxN=D`ruwAp z1}F4t%VPa_x%a||ih}2`d8hMMlE<|ZaUl9-n1feSV_?t zP3ZxRTR)x^{0QFPUH56H6Tb{Sn-WKGT~+|0R7JtK-Z{-Icn$q~2(Ogb9fG%3RhYYB z`en}VpB(=EYF;F}BR)IObx>=h%EB#lXPP6iGWz33jV#Hr=Zxm5B5$Iij%%hANSz(~ zxJw!D7ewxO^qVehhYl5~XD>wicaRWdSMaXU*J*DO}I)0=0UU0h}~_xsS@ z-7UQ$XWe;X8(kG*yZG(h%0!WoVabx`Om|ZD*eKm~nSj;m*7eD8&kQTGyiQFd3t|?P z<%Dhat_`P`EHP48?Og|xZKIkZxMo^)EF6_3HO>{uI@P2OuiO|#?#%@1j!$(&yMV=6 zcfQL%(wIaRYTNiY+n+;bddjTo6*f?Is?W3Qq7nG)*5cN|sB`>kj2Bv&2U;ln5i?u# zAQmLs85mZXyNtUbTX$#0kxS43=YkAd(fk!A4XAVwEbOxVi$;0wAxz13$c%4#_@TaB ze3q~IK<8YNyJ$!o<(rdvnagx%EJ{)|_3pJ&Q*VWQ!*4aV(YiR~R1|-U*j2(zh`0~` zb+ms~(`@?NxB>nZU#xe^D4$&uAy_-sOuRA?1j8_$bGc#HpK)_^bUw}PEo2UiWfr|S zrd;4*=v=C!*CS(3)Q*)?Zc@5I(Ggrv7uAh7t#o;7L@HzrOz@P2&6sz?Q$T z+QCTbtG>ZJcbB9DmDRLkTi^7^C=h&Y!>d--7r*U(BE$_HE!qbjjuFM}5p0*DaqeHcrRYkGmpf&dyluZ>21PV_d&b ziI`n&Y?3spw6*UC|tY3utlXOS+I?1pwkv>C3aD{%Z;ik_`8cCD2VgB2ab z5lYDVzkgMR!st(;jd5jhn06gpj~y|ZQKsc0b$Yt4Oi@Zc^85EY3hLpK!c zS!g_&wy8OS9>&X1QY%cGZXV0;wn2vM5(^SFqOQ^QgqwEm^@r{avHN{LJQS}YzF6BY z>$B1)9tq2P-)ACd?HgZ;Y}N|uxz>OIkeac>wPZPKqA~{;2xtfh+6#Dsz|&|F~MsD zGz$N%L_6Qg@|`2PTSID5q$CnUo6S+D8&Sw_yRjPpN2$5iG8c z1#dM8!J;*`OcT_(bi6y*IZXJ9H(We78=I|8Dg+CqkQX;@s^}+Mf)zC+E@`0kab=a5 zb}i_qJ_#)TzgE_e==h?M)V$z4KUk>3Li5iXz|S6AqTJp_J{F8x%!i2ChznkF|J`+ssAjhi&Y?`@Oa zOzNFg9+YqWsK|cvjR&TZW9P`KcWLfwai*21}-7&df&S0jG2onA^nC$AXRH5Yu{Yfh_}aX@s`)EZ1+1IYP?6fml9PYxd? zzU0lmGRKB*`lNX-aL1{z)@3KeGB}ej`^xCLP6zwUmN^V_rhoJbdj07qcJ!8c0w(_f zPW4>in}tBfL)$Ak`_8!F^{gQUfu-FFymked>ZQ#6H5t)mI(BKy>TcndQ@{n-%SqO_z`J6%D2k4KjGP*MyLaz!`*dHKm5mZyd24SWx--!a%}!|x9xl<>DZ~C ztnLkT3pg(;O}p{xPSrMO-R>N}OXjoVTDw2@E@W$-xA-! zUk+t9SOw_HJD_SVSnIfoLe-U0#yrwTfx?0sgOfip>M3nLk!SVtpM>b`BKOz#Gr6Ma zCFgQKznY`=tcl>H6Dse#h-G!(nlDxobfqddmIqMgXj5u|`CHPj0p%mOUwHHie1h}Hq@GTHaS6ad-|nSun@?vvn!a3FW-CD#&{X}l^5Hc*zjhaGZvv}vO(5SfB`%MXv&tf6e7Wb zVo@Sj#V7r&%Vn#M4YdVtr?(x|1W*#Qyg`0`T~>qFM|}S_>Xh&J^?h|-idQ|IXYWrs zDF41WMEC6ZYgGF}$t%~b)p=CbVmgP0=T9&4q>MwMAHYzk>t-asmFD-YJ%Wf&9)%p| zV7EvOxR4?jZ!S{>LaF$3!DOcr`qmMlkR{q;xN<82CVcLqk7!8gol?sVNgtxoRa3KD z2Gd~?T)O7RB{)pDtPGnt0_O5i5^tMwrV<5)cTy$@r}jTRIl8I?Cd>RO~(GM@tc|e~gI)J)TL`p_ZDm+%z1}J7KK1G8@cPFKh(J`=exFis zRRX;1hO#)tA6D<{< zcSiZ%3@4Ou33?A%?1-}Txda11Eh!!p3aU*w%iA*6>))T6c2=gW!Vtx05OHT#ck^6? z)h%OW%!<{l?c@N$;^YGe|Ga|=;Yb?EHAl*~a_C91)Rf*ln(Zs|5uuQ_0y1)ca+p>v zQG6jzQoXbC#_0ZPv77{5$VIKfd7;qF=plu>?RJhq9^A1Dm5S{$6imCwry}OQ(_Q|) zVglbopU0RfL~*O8Bjp(z^=`yg+4GExrSu$ULNF_wPDBY~!-@)`YoDuux8Yk}NAL{n z2>4F=7q_mBm^?qxFz9qn(g&-YdkjR1uPt{aN4*F3o*bor9N|{_rb$}vstwWciIzto z?ZUe?CVtvJDT9)xF4Ms~ouup)lG8$!V0AA5Xb!BsGdpfeRX^4mzrq*je*$bWP8_Sv zinueQdghyE+RYAs^Us|h0O&FjiOjLmwa#ptPVx$?v+YSnSqGA61#eVQlB3>9Dn)+#uc}L(IiW zMg(_=lgk#I9%r#(_5e_>W zOQ^5z%!w9^M@8c^1!1KgOQHMgp-BPH?O#yQ$-G6tMM98)14f>x=Un{q4 zN)tcx)}dx}sD=<@=KCF@WHf|y&D3t~@2n)E)bUB{&MAgU#PoIrnR_C`lk`%=1Q!}6 zvc(+6J3lO-6LwqKQ)I3(K-?j<)v2mgZ2qKxZ-(jKH80|pv!0I7&EQTL{ta_SQnUBM z>ID=4 znRZ_#_t8}V=g4RhvOt_Q4>%;tGs ze_C8#YLT?U0s2Q>!I2PIIh#6kJ##B=nAMA*tzYt{AETcQ@<*+8yvzubj*84v?54=t zW~CptfaU1KF;DD?#D#**K=jdm7uMk=w5qXqPRS{a*w7^vg&o*{miGl0-|nl$x5~UP z=~{Icu}^mr%&*^z3504#Qi<%ILRw!rL%b{kFkEIpjrW)aEA-5dOi!;StcH zu7I=rua%~JS`VrOaUfnM2c(RyZ1R@*1uH|WK5~3jO5ZbbVOE&C!8L`*({DPwu*?)# z(;PSzXw=_orCIMHm~zg9h@N?)>KXSOl-oa5pRhmMeBC$gj@`WI1s9Ml&3ioeHE$_8 zvnyTUYRG5pYr}t`m?hO2cd%03b<$(?57?9Suy7~Wi|QT~$BSlfl>jc|gFQ@`BHS-M z)Kp!LD7Oe)6kWg}k@NJuK_{eAPSkycJ2jfoNf><2R`@bC0uEi}v4^{jgRxYuC#_}_ zR+dZgz0pE#a}#N$T#+kT$Jr3uM|EQFE-8p|xPLl@NPg?Dx3v#5#m zmqb`?%?O1uAz_^Hv}}loL48e2I-!DoG3?#^f*;;!ehYDI33Z#)8(Y~^%S?#nMf$>@ zow?0VP+_J`m??Vsx9BcA&qrtE!gnd0n>D zU020B_0t=5na&D+e=JRI3;+B!SK`@OjPOg|tl+3?6w}f5<;_XdY^J6_dk{$4tbtJI z{vDqGS(a4m_|Sgnr2e1v)AuD3&K0pph-Q||qT`Ss4D+8}Y4UE|Sbu^L7z)UWOX|mX z?|f=TBzN#4F`ypmnzo8+mCRbU?7wjeKxtE28=vQwMw`C-Is9$^LW$e#{mIv_`!Z(q zwFe(NT56z~5CL?AJ5MLbO?dWVMg^`4n6OVrxzsS4vxMCSrdF0$tyP);NA7JcpzbY! z8t5xigr>~BRn1uI`;O9so>jD;o5Vo=>_&7O$Nsex8}6z`uq^z!cj0jge!(rz+LwiY z*a_uw<*~IVi$;+~7D2Fk0e7d1og-#84b2ec$m)g9i?+xicRi0Y18ZyAe{1?gv0eJ) z(XHYp=Pk;jlSSz6yWph`#!dQhi4a-qQQFHaf}4c0DxUxvCmNpMeg}Ko*o%+B8>IZB zI0!?=2{WPTQ-WRZEXUs7#aY7jZG22YvMay9b)0IsI_~#Ij?1I|}&^qnO7D|!~hgMvKp<30OuM>cRKz%64`w1mK1Zx_kGZ zT)G5Uq^2{u)RrUxTA#~wJ%x24yIb;ArP21c6UQH4@Y=rPX2=FFJj%7`7$ahG!KKbB$nycXnILJ}>P75{f zbyM{EN9I5-FuSob=j|@L?~$(&aL}=^|<;QIYPC<2*x|)=l{tiBs+zFjsZZE|AZ^=PqM*VUUrfU!SPt1 zaTgU9YVS4#*>|^1MUB+=xHMu(Z9-_zAFO4+oh*B#3?&z@EbDxW2gp%c&PQI^a}HBU zW0|JtPbIi;&CyR4s-_$x7taKmHzP*ix7vg3956U zz11>;UPQOnwPaz&lz`-tAEKk4HwvdsK4Z|oiu1(u95kE-1}2h#K;b!C=KQVBL6Xa+ z#f8gyw1o;t6xvClS(4r!%b`$$U6>LouwylP!bZ!4sL79Rq&+Y2SXOn_f0jpP4=`-A z(%zBG-lH>6BpYq1Y%VihAp_R6MaPJg(A?xIP`Y~2T@y+{gMh3Q>l@H9iw*Bq0#Pq= z2#pW6Quq#N`^B$~g#+0hSUJH2A#Wq}xzCeYqPX<;EssaKKfm%+~kSrZs_R4-HL-Ddw@g1-J zozC-c<%XwQV6fx&F=hYJ57Y*Pi+dwz$`lQ{qB)t7n@46{5hCt}8^ z!4Z0qE`K@V0$MAyUwS3R%;O6;B?Gs^GktRqON0p1SSI1lG&?ol7iA4ENY@vKisOZG zv7;Yq$3_=Y&3nApw+56r7EN0QZF!BW!`5o4WKY^RYWV?SCK0y;|FMQ?YMzLYWGGbi(4JLOu#L1 zW%~^Y(bEw1i`vd*UKJ+9W%W6zAWT3Np8COhs!n25=Mzx7caruk_2|(iYaX z7OEP+pNtRl8@D&Yv~|c$fFqNg%kyZd1W17oO)5 z6z8eqHEzH2RMl7VBInEx*TmoJ?Mt`3CjS42fTX7Ef3NvJ;Lvamqt83k=gcfS>@@tc z(hTtp-o?ID~DIZ1B-M!SAIXE{+%ccsE=m~4G0XSM7D(-z5&N8Dq{3LV%v|>-D2UB&E8Hd zpltKhR`1e|7ux+i$_CfgcphaY!!ogQJ25?w+m}YNYOTrCyabbEx5ljfd=t>5zJliw zj4|K0bK!!^y1bNvQY!2a9Rxr7BW;DSg*bL*_$9&Dv?rM@6>pK}}*w+0kw zso15ZRz|c@DLI8lJ^e2UHS>CH%?4m7>he-*CZxEs>BfEr)Um@z71J!HmR_*qFi3iN zguv$^ZpByPFa%JzgBMP4#h?6lGBoSR`n{fpJDcTXP)`4T2claVgx))yl^NY{02xfp zBIQ%Qa%%~>*npF*p95Y5FU2sw?_t!L*^v+O=I^|*6ZNpo05GQ>UieL}99|q4R}huB z2CdvMm7{ZO;B2V%=X1t&gn_rww_J~^7s=3wW~P()2F;Y45d@H*yhsm6F*^i_xA=e^ z1a23#wNAEBxtbBo&o+nD^jg|&UZ_;9=bOJt7Y<40#UJx;ykD~xDp#>?55)c`l-{Q_ zAVt?YY17}HMWC*&4b!B9NEu-=EN3>M>Pu?Xo2i^^O84Zm2f6L`N|LjbXf^BJdPJS`0&GUh428xV?NSY}A4*wRo)&;CC|zn- zACcpZucUdc>5_l!WUyOF-VNjCEkaoqyMv?OiPx}86wb~2^?iw&vhyMWrHn>31rfLC zl%`R}ubeYBY{6N@t>HrVTRrWTfEMy*wJ3LEr$cUpp~dm8FP=ZvqPR;T;)J{49U{>2 zUY5O<74jlBM?YBmJF9^?KrkyiTnM>S<1p6;G~p`_0?nNHor-InYHH1=l&Z=`1%|89 zFa3W7RBAJc{H%#^Sr0%umejPLl$&63xj5#&nyr;@-4(}HR!;9p)W4Zw^WpQWOX>>s z^LGMk3M6x8U5CwfUY264_kSj8X5x;UE1-bnmw}qd#v*(*Phd-HBj1tO3);j(cKq-N zv$Y1Bc@RMA-KRUb7yZrV`rp}X_B7kCaxF>`P8qR!|7M5coq zx^gi+`T=8jVxe2xW@pm?&seODWtCRtOeyZs5?tv8Ru7uFF{h4*VP#^*y0XGLzs^oWT%jg)r>t&XuL z?&{LcHJ2y~4XyK+Rv+1-(|sdDvsPFsR0#z5i@a9phKhh1zfid*VYaOgxiFwoG(nJ=HuVsN)a72c1)(yHSROM`Xfl6 zCE7*fNghNf1n4UMCS)jHnK#G8{vEvalcAF@Ls3J`Ql@P#P)}H%E@3L_{p(AQ-2SE}-j!RFo}j9%5L)UjmrJA$y&Sqg2(~WTV~B(?js=K^VF-0ZFkatJbHlke*B7-mqLu=Tou4Q10n;}5fPuo zATgXN+_Y;cK37!vlkhaqt)5GV##{rRi8<>kHNnZPA@rrv zT>}>~Z@G28cr+aNW%@)c1BM6JaiKXk3mPT^dI-a%i5>{6@rRQw{#R?uH=S5S>=S;! zFj8)OwRQ(+Yw6or=^oP;zrAOxoDk~a2;G50Dj(48XPQfOi@&MxX8p|Yr5o4-B-Vzj zZVbOZ37Ci)-9|ukabotq=%_+oha5cO0%%W0LDM;e`i;tA{LbIJncp+K)uVrbxUmKO z+1l=8YoIT#Tr>05KzC11aKqKkB-LaAcpRJ5)}!F=H&;<^_i(XMk7odceYiN@u-?}s zJDtA~sEF(bqUJoyHXzF{F(E2_hszB6#eIU2_uvzv73wfh_v|Qlw)wBj>gA2Uy%&9v z32|g}?QdkA*Zkn;&Nhc39^_Y-j;M35V$DV`sX%F}^!S^gqn0}^|^g8J4Y=Nr(uU7Ek1@2CS$w;fTqrX3rMSghwC!!%%hOmG;{AUD09 zR*?PM;0>%aU{SuDy))&`l^FM2<$ZN>XGx1$Q9jvmEaC5O5>^|aja@X`8?dQLndx2g>X?S25S)x}M=D$K6y@>faGgnRIid<+Y)E$I_c5_!1$+Ob&j`de9AFH0F1 zoFnMhhwK@11SM3E|E?$n>x;t*`(WpaH}Wqao|3-3E3+fQw&wylVeoA%L#|{_<*9q3 zK4vM)_a*Te;%@9?7~gRh@v5&`Gh5df(H=O5;;bO+(RW!Tos~|)m%&lY)uX!K7IuB_ zBIVmVCmC|WkfeAM<5OrlM<9RN7QP4wf!_c$CCkPRTXf8(c%@9r?Jb=|sz>=?CGeTk z8NOzBqa2CAm_QD;HY9hKbcRg&<2O4iX*-2lem(Wn{@~kw(bRvwFlB4@fv>gP(x)@$ z_az7jg;NzRz=#w~mezM8P_z5J*TITt-{tD62>_;ujm}D`fyfg~R;3|+UGzqGPXcp* zAkO>}Olcx$r4O=7oY&U-P_qRT`ZOF{S92Z#@IUpyYeg;f@RUnoM#~PV&Je4()}q&X zBKpctBLj<|r4EerB>cJiNfF79P55jlVAArM7_^rLpC_){8PdsQS3op2iD3p3*sIN0 zdZ6P&RyrVO>c)VbVB8wE8*pdAvl_6KK0pE6W-q>A2s506MAkI#V0wb5p#E%X$qq03)|{z$dW=T+VdC)XfP#P8Me-jn7FO|_H4~&OOacKgtwb-mzW`Z zinc6%wTLrj|R-nuiK<#8Xxw>3!trT=bRg&CFux3(d8`va zXklF*$XDVm9NoE*6S7rWD;Pq`b*89q-4VEZz~K9jaO32!;DAX6ZOJbDCcgh_igXJgW)-fD5l!ahrEmZFgK`fY;U1FT01GolCqD6gho7In>~5JNa-_m!9Ed&6 z-`|HNG5=kxmSzRn;A(eIDY06*e5?C1)|N#7>C8b1jZ+J8sOnTyN-D5z0gGJsmmb>` zGlQ#|Akx$vK6(rTs3qsAPcMCzzwnM9re=M}Z&+D3KU6$E+n13Q@qxdx@$Fzp!0Wy? zefrKL2YlDEfYwbJ8eIu?AB-ghz<;A{%A&f=2`Jp_7Hhl%PMHOCSqcau!6S7JLj{pv z9^ne8ZMgoF=s_0rKmFqF$&bJpaEUuUfR2a4sy0!o5J^t~_M346y37T5PYr;n*=fAK z0-!Ac_aVOi+OdZ24@L)N=j^{O4#=lEWq^2V1jZ;V=?qH4)u+T~e}o=S|Zi`4FYSS0sppDQ1M z3$JNF{zBAS&NF`)cS4*z*qr6J!;j4qrV)cHSl?4*vAEjHG9?=j<)J zPW^|764pZFJXX^IJhU~kJ^(U#cx09f>sV1gW})`fj^I{I@ot>%iWi^d>`i}l^nXm5 z|9Mba($L~*8o$#0!^A){R&yRKp3@!rgErd|4VY|c+j|-ZO!nsoxjrLG8|1?P>13%$ zk5*Z5Y$Slw{&$PZRhLG9RdkLw=#&E&Y~suocLlGHT%LWUXHTnQEb}Yc>u8CpC*CNf zr50Wv@{qCExpU`U3HWv-@c~?4xD_Haeg;tAa(*#$_yu|IBumT!Fgs_<+WM6)fT)UKZqFLIU5W3U z?AEkdeLww@K5;tG*f{MT+}#Vff!e6@JPe7T%wEM-UNGeIL6Uts+5q-d4w(cd#Saai z@5@ktjY_d*Vzj~pZ$b)?yDQ;?Tn`+!t^%e}yD@&BEEetZ@%bPPeNrJaLW2e?z|!F{ z+V_5oeMNPPJ;sU%YuLzIxv9O&8wD?GBN&oAuA(vdrlhSCn%<~|2J^H1{z+vxiK;bV z6Mj=QR@iJ_TEh!fGTP@pZ@^Z|jcbX(!&a|fW^fN(^k51=sbo>${dr(6g%g5dc22{U zYA19>L+&+Agm-2;N+H+PjYfgdzf0T+gr++1B*uUQ4sPJ@Oai!kt*@RX@T}azIfO-i z)g)OxUF7A@^-K%vFb$fdz^h%808lC?2Lj`$P8$vYw6k9@-ihJ3ZQv)Ve>r8BHMNZJ z<4XZhYQ;GAnYjvlA^21Wn7t5ui`uFgLkDJUw{X4A@U?1br(hzWBJb5qpylV*SsNiqPwv*lVV{Y z@e@$Xzdh{+6%QoZqYIeLE4vRL6wX1SVEkMX_IR*BCF!QmkLQfvAc8DL$;^RD^S{To ze+^d;`tompdNg84|LhH9EfM<8y9btcepELdIi-o!?N+DWIgbs3UK{p6)Ik*{15K5@ zBHgn{R*x5;G9b zCG3GvpVW|iN^0QRGK;ut<_bB@E*lQ&uF1+)%7Ze1cBhKMvXMX`tGD@by4Y~)Yo3BN zoj0@9YN~adJ2SoL4jvNLz)7JM5&8j0Tqoq-T9u52MeI{ZARW3@!v2c+z6ji~U|b&a z&dCsG?cYXoP(^elLB7w~T*>ngAfC5I9zwPfcJh$4P6}=l8i4|>`Tb&=u!Uj-?XOvfK^_MYA6oaRyleL~C`GJ!sY z4@HLU@Te?x&n1UB6sXftfLuB6gz*#y@mJsT65cbwW`RYS{wikr(q>QF89A{W=?sg!`ZcdEB(Yyn4D}kmhiy2#y)zT@$ zlS)vY{?lmCS3&0ZF=`RID6-tdBnR~|09LMUYi$7$&9}RVMKpNNef_|+SKHDuVO(qt zwa%oCR}FTuYl;+$GwMrEi+#KG&8bQv5(^Axi$HRU4}Ez* z9((K~N65wpCRcq=0TOb5ugIUFE1ts*JW>rH7IDKzmqFh0o>h*Kd(UVQWLfh#aXE`r zT|sKI+%H@HrTPHCP4CKWZYxc<5-Yi$>lL&QNB}9WYO@w;mHo5@&`CeJL+GnSRsWir zT>fIO`gSH`H<*J()h5tFwIbz*_bLo)R2 zf;X(J_%~9LG%4+@TyMhJWsNAkn>c3z^B7%=z0!sY|5WLs3>H9MkLqSK9~&;0I~DXA zeyMf;`h4hm2Iw{bf@WZ^aRKeIblvO5@d~~<8^|R_t_j8W8*3zhdsz@CvpBAr$0oyL zUrQSShh{9B)QEAuc~}TzwH+#R-gy*s8zMk7aRDZimu%V=+3k@h8$de{s%@8I0;!nR z4C4@onHjdM`PN``SvsRzZ?X#+Z};q5SRkv%LAy6Gu9@m6|^R(HchOx z!$83`=@xU*ED`3eNA@*){L*Ty7~lkA^LyqF4En-%-y7WB@UjpBn3efECIBMB%bZ(Z zkIV<3LSuH@5c;I$msZ45K~{br&_8#B0zO<=qx!|A&%ZG&Dp*#6z6OvB)J zdf=~99Gi-_LPjO3a826Mcrb&W=A%9@%yb6smv+lM7&uJ__OX^RXa2E|S9Oc@B=3V* z#V4~K@VXHTV8>B$hR${7;gdrE&T0}RVq`!LGx*^Ip`lns+4&D7PhxACGlP<=F*zDd@1=>evi{hqyTV&gH zI@-_8|L?zA*Xec5QH7=7_-sgoo-M& zge=^<;nR@}oA7o8j4lv87ao982}So0(hrO2#HqE+wfZeh$;-YRFKm9n9I9oe=Q#wD zC=`~O7rdO2*`fMAJLDs~n9zlahD^;5jn6iiA3t3-MpF=Sa06ham=GpQiO5r2V?w7WTDD3OO#H>QHsI z?{BF3#G?a2GD(Q;&8`PTeSLl)5p(1q6s#o=eUp?g$@FS8^zp$UDI_I#$Z1!#KtULs zLq?PG9}Xfo^RESqSoSagtX3xa*p`a`-IP7PQQ-%~{7f|P@Rk)yMoewZCoO+|_wTy^ zigQ5B^haGFns<4#TzhA(Q1<`!-0{-O%Hx2Mv+_3}zXxD(jL9z35&|;-eDyfo8e$Dk z_tm6}0&?$5mn!Pw>;PC{ddjsBYEgO;FrA>@g1ppK6(uuL@C#xuSAqZ_i@m0ahx}pZ z{PuwkJQycMx@Bj6yH9v7=@Ez}<%8A5>7xk;)MN7Ae*;Wg(%H;k)l#FAjm{u}-s{KA z$I&a50O{3(9+7cC=09St7nXIPZ&wv;x*VdN+vTXI$NVoMbWEv7G_PiM7ve#a)=JNp z*u5Q>at8v4>bs^hIZ_*Ot(l44%w|GW+A?GX=TshhlyLOt@y;_ z@Rh3aa)EiLP{6&zXKn-Q_0i=|XEePiOcEXiu@`Q9N2Xce+6}_*MqKEUGfKD zhU^$w`g7HLD2%{RlGPV2yV5J{gOb2wdW4XybJq!D#SyLGpVD6`FImvw{)A&EE<6Nf zea*`=yx+d?<~UQcK7Io9!9gHhx-t{==)w(6-S16RiUEuY>i##iJD|I)tj3%+S6uZBh>L4%)+A1R*1U~_|G8RF{^4nbkj%WI;_CYvBE9(f;I;UO{ zXzFl;Iyhy(g#{YNUd`qTejMl?KSdt$p&*wJ zWF?B|m8Z73bU^90d?i8ufBjdIWl#^$I0Tyy}E5wr$hmy)9>{(1l9mi!gOLbE>ZCI<@h+e93soBg%^ zftuq}az~Zsy1TZ@E8_#E`Xc9dDe51f+Em-00LYgIZwamvDV!k%>>XIeH&O)!GDJu% z{G>nVaR#BzeX|?&2OakpR6&s!WWWMLow@K|6pZyr{1Wg1IYZY&I7^&7pd^vcy#>w3 zKIp0CjkQAVQfeV3YhLo8hWRJ*epDB%L|SYW4kBbeH$8DXd8f+Iq{ikYfNWy*TXu5W zY45lQw=Loq_jsS|?h71WD^ZGP zPX=sK5tB5i2CV6x@f(y^gV;VMh#9PTolFKwBShA4%Rez;?o1p@u&ubyMjW) zs~oDP2YD=l*Ur&BOS`72r}K*9uSTcz|&Ed^@TdUz(jRO!P8u#0L+*oy}Yq z8qf(wDs5(Ju5AL=8jIOM1-K-3e|FoiuH;|C=q9OxJ0(6hvCd%5Wmo{kIf`GO=<&Bl z$j0V#ce8}lw-5fgS>gt4hW)aS%bA}$GywwjP^%FGP2>}|qn5yW4%y{LkfHl6KPkE4 z^xZw~(VMvhm$YcX0ZS1r=a8%2a5tdp33(O2)`!hh9)F|ZRt+HtMm`V4&{ zU*Nw0!O6V*~^kQ}&yuy9QGcj;XO$I=`R3*zwRsihcIV z?H(DlPY5}qx)Km6ac(1yBjxjIoY*=CUEE@nJ7j_gu3hW|6<P@gP9sQCWGouf4JukxG3qc0c#fCb> z0E@eDfXXL_LR4^604d`vLO?SG*gIJ#nVGJFXU=He3285z&|iM__@l2I76JjAl@-)D5o` zb%=5V?mg%Vicji(aeqEYhmKG&&;XPdlzOn)q8&Gz&w;n$9u@23XF_ zBVjBw)3vxf1!~=@4_UsGV@w%4?~k60vFNitAk#3=ltMf>BsT*a!yr%(ZHu#f(!nhc zJOw{qT|4NnUoe(1?O&dohMY@dz_3&31Majj0sSWB0Nc%xoFfl+m8@!V~OxtBmye49xSS)HdGfh`;uLub_1{-E@r-Z&418jRewvn(3>SS z`ulR0h4NY==;5gWa{M;9638|^TB{Vo^q^zHxHVv{98mWt9H=Dq{I4!59JoV2{!=GF zMuCsQDPT24b}t>ki#?HV{OcyOm53=<0?R=or-AOc(YpFiB>hLM`A?I^dE~c%144w< z#`o|tnH^AWV`^-BfME9sB^`;*&Z}UevCjVZ{SNz|LBmHbXjed2Pyx@*y?6JjL8%FV zb(eE*>WzBK_G4v0@mmCit(9 zZ3Ct<6A$|0+aNh>ct|Kq1e73lE8wO96L1-gj4u|DQvbN&yY2&_O@ z?h#|)NkYkq_GWpH7*oI%VyOXB`g(e|s;c~tbODtN;_Uz(i~;)1`Jsf&w9AX)P{-0} zwoD+8%rj;l1n9geXAyp+Ht6#DnrWTAwzEciE9D#i7>`QIjIgGPMZ)ugcNCf--|?9g zfXfvi7TStIIucZFLZPzGB4069hja${0TBCEvC%;0vfhE+kN^J|dkd(l)~$b75dozP z1Q7{AKtw_m5RkG^QbeRfx{+=WDWwqskrX7A?%D`QBPku5ZrF5f;+xAG-@Rk}@2g`l z?zrdZ+3dB}vz}+pU(J6b;G&0CJ`|ugNb9;~u`%1R1t@VJu!B-o)J7v!AipkZ`n(pI za-HK}Vjz0Dm1)Pkqd~{4_9~ke?{8_B+P`OXpJ40N_#cq;q!`@<-n~td#la%;_`0f{ zZ!#Y_tANrmfN(p_{qYY$-HJ2GKmnDIe%+U6i0g#6IQ`qY@+i-l9w5?N@2*Qm3A?$5 zNp(xCbxLs9cuUzROy81OHeR9l!?RI6turKI|C7774?+@Hr;=dx^^{oY8>3MbrhwHU z;>Lb>xwP(klu`-ruhiIfK4DgZ17+wT%Tc;$r<55(JofHkmN%vRv!I8>Hp+Q=^RmzX ziFg~X{3?Hk#Z*=rvey9NJ%|VefQ#bYyy(2qAr|96vU#bbq3g%H^Q=GHQeR3;1byv& zCvNEzyXh-tB^qwDnETFX5xBLj>z4X_Ia%*ql6UT1=x>5UVs~0`N?l#uY;WYPviOBE zp#?H0GW5Ey+A1Q`I|Lqfq{pP4?^!|AsGI7g3o$|S)UHq1p|)cyE#B9%>^)n?D!ZB0 zy1ltj6pOLg>`PavFk~f%TSg3D0BgP z`c&+7+n9CP1LCZ{O~L7~=gaBXhpPvfrKK8+T<~=PuWia<<*97r&p<%%*mYkvke_S< zmgxL1C>%)LT%9LjG_OBVyn>9W)>qN*6tgN1OS`brKz+;+Zi8V1UR3N23%RzLJ<(~V zqOkXfe2$Ec+l)ORu(nitYLLc2%-$P5WVBuvkc#4 z;)GiFR3{B58$w{=2i2;}5QhTO=PMZ0>G7QSAwn(4abJAEhajHfdTHThR8C6+lrCgG zdlOf>`7m{{^Z1IX9vcnO?B{lCleRt0L{6<8Os<~$tQMXA`SBE_=Vhwtf8_~};?5Wl znRTWyQByaGBNWx@C7svuV{K?meneMk1=hVOnS1ikrRXcB_Z9W)MLn*|bj(9ProL_mGN2oFVBz1O3GqW<^q*0@yaA=-VPs_^ z6mZYuwEu;pw+DQKf954v5L^n|;7i3+0m}X;__>Wuw;SBqm^+_P`bNLCC|f z?B(XJwCtUE?K%Swtae&qSvkv!0WKTql49o_lbT`?Wc7hOY;x81!T)4|hRpz$wYk(Y zG-6rGY6z;{Cr+13u|JMLgs;1pc71No;?s>1yPIjb({>&7t{Q3$X0Y1!6U2k$R|Sy( zAH3?{NcxCl34omRZ|cGPmH5`BK44zAVe}4s26>y3e8C-PqR@ zfI2Sz;>l++?Gab6Z+`KUfdbjrZGQKTMH!^hIGIHi)1z)m*9h7(g2=bG;u&~g&pS1G z5mN96eHD<&A^Ib*`WiugnMk6F5MqKOqBzEJ_oUQ(&de5pDkO@|m;nr6*JJp&i|&ct z(IF^9lXuS^Ot)B4(b%*=R%$DsHENCQD%!;3cUK^C^Yo2=ey@%O;t@XD+-c#3LzK;r zm6Ri1qvCCnZ~t$#u6sVB&@h2YCW*pvB7pb0pv=~TbzA8Gh>c76M0VIEBWx3E0N-m4UK}K}rj_#W`8ttf5>i=w{gs+llK5dQjCp2s{|^m| z2n{a${zWMKlD-YWdxT`0y-+4UdQh>ES+>j%A_P^F97i<5{N>Du(nLerYO9`hoqx{S z+S>IpgA%6aJsVE@A6FO2;X#u42F*;FqtVmE`O=~R$6I5v@&u)WU62<7B zx*9$*5L>N)$Twfjwx2Pa7!GtOpkgfQD7OG`?1KX^`lSGO{U}6Z7#Kah%%$_##7XdJ zjWTratZWjS4+2~f9u0tr{_pN5Sh>#`ssH$m*8lj8)?48j{Wn^_^{lA|G#s;cY5$GU z7Y4d*p+PJ_Uj|>^6xyQX5f8vVtQ7d%@*3rmPOReop&-B^_|-beeLH_TOhMfc_-G3g zyUlaXpd5>K%kiQiz3nr`7@<0z)8k~3pYqUk=K2R8$!rPqe zEzV7(Zc%$do`mbaF#CLz+tDG9&HVEyh=&z~&LsJY+%}+?UC!PB2}b`__nyUo|y!v=(C54-qnffA27U@soUG5(br@-t2t4crSu%GqZDp8-iI7_0FS z2ncB;i4MBU=tLdkc;frjCb0@uCyWf*k+Z_C>^ZA| z^{gfmYMh~7F#r^lq0#6+#o8@a3Y(WC7x^w$<^&=kcE35L|3u?2D^%dhB}uM*nE&|g z4`?x6FOCxTne>zqh&|Sk5#0QM@D@mU;5eNHyM1eWJaF*eW_ac@4S=7pS?s$xJnUSg z5L88NH`K8^Q}(&O$$7GIB1!QdF|H!Ar<{xWTc}f=78)i|h9hn%Cum@+h$1$bEaPMS zm#oU&h~m`(TO-#!HKxeZ{~>ism!tcNcaL`h*5j=MEaH^BA`H3|V+3`hw(Y9|Loo9~ ze_jgGN-j_D|3UeE%-!f*!;=%AqqdP)R>V_tQks9|*)_INc1v z^2RaKl)uBOq21$wKuGLtVi3ZUN>9XBv#_$}Aq*HWjN>h`eL31>C?e1=C=ptnJt2lK(sZPpudu?K2?^p}0){4tZQ@T%5y7Me zf*`paVbNii_CNdt(@IZf>HPIUy(rW4Nk;$-fb$g5XTN6$D3R+Nk<U1LSQ2`rCu&E0^SnE+3kGvi8H7f4N|QUUvbBD4ltZ4Un@%ZG4) zyA-K0jS`D+r~+{BhG5vy!`%2|;E2wE_A%B6DVl#nu^F^*!Y$q;y-o-ggrv1M=Num` zGCuD+B9_-xPoG+@Q=ear7*R5B<g>#3fUpcC&VIx;x;fOYEX~u<83HiY;By z316)ee72}-bu?F#<7XZ{t2pMTReYJ#Q* z;5j$2fI5H3`nn9q%uFZeV!rLZ>Fh=O8wGqtAoDX}GxE zt~-iX-R%<3D;@lz`xI3;^dcM^r(#IW=|jb8TlvKb$r}#YFSlB-Q(tAZ{V9;)sQs%G z9EftU>k$795;*02gE6Hqj+Mqy*TT!j(={qxpVT2ngby?2&_LX6R!O*o^vYVj zST(c<{JUBj4YyV234GPhdoqtPHtFZ8Kr{0!yllQg_Qp0{r5ybAd7HG%;aOf+&{3J= z{O+91_fzX)(}APO*W6)rrTh|dgpsnN}ZmLR{O7_4++ z41_Dj$YHuvzTVmzq%BWZ=TE7Ph_AadRC)&rO^t2lf8_wxE%JG`6J6GP3x`YV%nwG375-+2>0QB1Lu@hxV}!f!0$q_ z!{|bB+k9l`6OZY9k& zt4f4@?cF%I8}iUn$9>h}P65M$F{~u(1|tKA@|u3%WbhfevZ8-^-r#QtC-gu|T-LZL6MIvD-|3_s2GR3MaM2viCgz}-eJUNVS- zL*!Pwt;rwH;yDDR?*p`p3cyXrtRFpp01@e)E`iBSdFi1D-apQ`Yl7}SRXT%q3qT4xA^XzXD=3@thE@Q{rmg7uMkcqxo5+R1j06bl|r3Yn;iRklV|?d zLG%wu-#y_%11#`AL$?VJ=_meh0S_M1Eda_$_PZ(hCluS~PkHNGLPGT_kOBdauiNTP zN^1rw>e<7V&1{7h3=Y`zwSEfJpX!_^*Sx)?hC}Y?P9M zr@LQ0{xf4j2smWwBNRBBmElZOE{O%}KJn!{oEa{Ce~_Oa$F*d5D$rG<3KD#nIItUI6dKu0Rx?C=L(9ge#Th=T?U zDTt`(MUxUF-T$_F07my*Ig=T|?$jLTl9G2%hZUOiYxSzx#X#Jpeyi2tZ>AeoMd!I< zCsV!E%n|;d7NP$2!VQbu{e*BM2|T_B7b{)bu-8oFobjdfD_7UfGDP$x-S!yR5v}7va1pEf|JmL`f)^(G|e8gnl<}YqK zfsQpP>eBW&1nUn^_TQN`D*}1Aa-5LMP)Z?G)z|L_)xE%Tj*oo{pIrczGyV|6jvk;2 zMPaN8cxZRFKh#p!aNPYJ&qzmdB|S4h$ia=Fg(u^-q0BPU{8!U@50}>f>llFS&EG9K ztd~0#XQ2L*0m)ia7l9I}H0-+a52c~(M%E;(tcY9ZRN-|^vvOGo+`$zxxx zWgZ=E;qjfEBqNjkapKK6&({>{1__U}A87x=)&6Dg{Ud%gF7@4^FXaL`KQ|a5+bJ{LeoI&v7=D>29#FSWuRLt$S{yqD*4i?zMGmd%1(v z%*$ukq@*Oh9JBhsS+P5SxoZIC9@-KsIJiG1-~%S#L^AT^=}V}zJ7z<7v`?rz`PPcu z5UQSrJc&;j#*tSw#Fh}5)RSY?8qJprSP;KumL^~_>Su$VyvBX}$DerFQ(p>w$#4C{ zN|ZvWtOUHnMWZ_?-W|}gmvq{17Sp?sq^GCr0Q2#twhBm@CZLO0KnHgd%@qwjJfAB_ z>b^iT^G0KVk!nTaLD?O9@a{LrE2uHDDd%(cM{sDcBOOIcG@sluBv@8`eOBT38Tu$* zLnja|?~G_Yy|dAN-y`7~^IzOcI`>Cco@SlAhtV3;xzU z?>25HoEU=!kJP_fEcabw#PV9c)?xZ}h{j?p{CisXsMT zFJ^maY^gad6&%kw)GAlEhL)CT4eTXrQZOHjl@Bmm9e_CB^m-qT;tQ`x&5+&00PD{N zA{5RnQky!yZ9iY%mX{6=C2}{Q6XB{<^~?qW1#$t7;NMNUseyr+fnLdm0Ulv zE&<N^N%u=Zfpgw-_>ZmBN+_ zK_|-hHh>d4zh52V{ugiaYg}7q_k41KoQtrRwlzXx#uX%@X#%~rZbguFSUwf5G6@z` zl!o=a{y^$7A#z=c;|E;*4~v_c#H%=tR``Ee$O}=90y-k2<*>2Nv-T>#xEoR zImwH@4jg6HF3C9JRYBDw0S%{IkMC|*9t}G)bfjrQ-#ty?^TJ!>$#~h@l8aAiUmnj& z8wAGUxO(!!Obg+&7at72289 z=!op{M9CPM!LSZgEf9~CU>PFpz@7wLJ>T*-_n=P@60(Dv0j$*1?y=6z` zoFSMoeSbF-hh6FZ$Qjz+4_{UU7aj3714}gYu%*eO$Ar8J92DOz#Hemi_Zqz1jBQ5M z6bTlLj5#GZ7Hx9`^Yq@MM_c{W*t?IsUeY*}C9Hy$laH&=$iykskx#Fa)-(5B7u$s% zsg<81n6G>>kFMqgHKq~Uo^7WQC_)?%wByy~P<^dVJhwx}3!w@KG?12MtAZc88_fsy z6|=CHvBGo&jk~9q`~gWQ-iHUs6A`5 zdE&=RI_4cYk!An(gU!HqikUr52~pEM+p4N`l9Oeo>t#0dBaT^khE8zJ)#p&=!=>^o zf+MPgjW;fSSy&G=9n_Jyx?kmC-JB}pI&_DG&|twn_!;bRLm;lX2(?j%4F(Lu< zS)VAMl39WM(+f3cBfg>%M+i@!#*x{@TUD$77T^AHi8ay@KdvsH<*h{W)NK8^7|blG zRfnCw#>*K2MeWNiM(7jMUXV#1GV93HU07(kV9OGo%p0+~=e}!{;8;Jz@pWN%!FuuH zCe5_K-W%0T!H#OqGh>d-6bsZSuWo^H3v(Zo#{)Aj$?f%$hdv{)6HoHHJ93=Sy7>zF z>`V=}%P>OWO{F(Ms|N9S!mZi5>*FTZ*x3uqSj_cXK3+l2*IhPzxNXP+3~ zcs~g@e1N`hF%30ww^1JLvB%=1u7b9*aOdo(pCc%LDo&*nj}9_^m=&(bE0K2AF;YN74;Q1n9)7K5X{H*nFLI6 zO8D#^S#Jp}3}sQp3I-Ze1_c+H=NRPu$A+ak;UVWvgFMb=X|1<{{L3vZvZid1tC17pSvlDC+fMecuFu5w>V!vA^q4Sz+-h z8ZsZxkGJDMwWsI)3Q+ww!b8_`k9!1L(cN?0UrKXFVH~(CnTs42u(1Qn8Arq&^O(+} zXF;~#dPn;>?kdDG`{9hZF1BDIc&U}{@5KhH5y$Z!teW08ja`gLxMc2RKp-reGR6@R z(0a;p)mf%4MX=zf3XkpJ8B=q+ImyY;jP(a|wh;$&AENwadXDx!XxHBmAnBi=Q#<;K zxt?!0VBw*ap!}{pn)&9XA8&xSz2`mVb+oWd!&=cuxG%=CN zF{0cW7Em-f?Z1M-daEwWe=cd@mx^egPwmAS14v!XHWrAk@%^nhR<8T_JKZq{4@Uvd z!YLR~7}2!g=ziV%RtSs|Oh|6?BoKAvGu2-dXw}&~?Sdv$yk4R|=J|y;R0g4>J^%8U zqi}a*`|VoO&043h%zR5kqiKOu438!N`I-GnN&5(iW0V{MFZ6U2)8idTrfRfm6Vy+D z1YF4yK(~KlH#|D;AEJ*A6{Lj^tk=~cVM+fVV7|NH98Ed4*{i{;f)U=CrrV)ISj!Oun$W+hF%!?h)3}0a^jhA|u(7j;=e6=TU#^6^$OTPFT1G}d zeU@^8xLNTSUVo0Z&uFg)RMh_U7CwJhvf#T{?~#?-uWBI$mntNKO-H#Xl0`w&II7}F z04{uP^gvD4LiSs4HrMVM;)YQ1YuBy?!=%1mfGLU^z(_p>Oj`)(yc+>s(S_3UnVg(9 zIi4GK5Zxmy0Abz^fUgEPLl)+${r;LcB-l;cLrXC3@5gMps42SvzA-laf8Kv*h%B$>)N7u9ThX<1ZTIG&iz6 zm@SjeeX!gAVxG>JO!VqGb)xy7S!O0K1I1}!^m1Q^N=>3wl(!q^E$f^!_gsU&^XNM+ zBWvw-#OosSRT`%*fgsZX%zU>R?Lm!2uFEGm((Na75vTgrafS9`Xtg(3nO>N6ncX;V zh(7kzK9J|w^Yp9#(ZoHD6saI5kYi`8p(MGxBH{pnTDs7h=4w{qRMD$}kn9W8;O>lL z5$>*)BtKY1RwJZEc7=BvWhMd14Fzd`GwdusIj+4t@4DIWyMy_kRrkOCRLV=_1^XFg zd*G+vGX&nLrdi%Hg@(l%j`sZ}TWy2Cd5?~r+Bt)~Na|w_KyU1&CcgcvW&Ajv<@as~ zv+E{-=QU|^?cn({IPe=lpvBo0;`05kX6t`9?v@{pQ4m<=Yt51W)dsb5Hno@a(E*w4 zBb=*GBfhH%%r{*#yo<9rrg8o(OM}F49jt`=es)v$`;)lK0!w=D;6BS(Pcr=ImHVjZ zOwQo#=QoW{p7#Z=Ku>u$mur{qWipOPKyJuodT8Yw1i$)X58v&M!P1 zB^0Dx_2K+1sqO<(U8LyI&QfOFD@l z%*_yk`z1gBc~7PqD{O~hV8(6)HAE7ulg6-y=YM?s|M&}K0V2-`5%*3oXu#CL=1f;m zP+*~rY`I(OYil~7h+6~NRa{n9_HL}eUw){RpGft|YGhG@Z$Sq}Te^pf(VyLgY+V-M z=fi=w6^FHbqKoUz->nwS?XwLs&o|(lxJQ8>vx|1Z2=4Z`xlWT=#Qog|#Gg7#phmY3 zN`27ovam#AL0j8^$e^2Qe*EP%1>C2zhQfew(>t6^x3_Cf6`Hz8;k8i1i3aY1 zbTf5vE}79V%aB{2y1TLIO;iGXg?dHT-1Ka;RjSrmq6{g<|8Vt2q&x^l=olTe+CQ%2F&#X-7h9=4)LhV1l5UnE4QH+0LG21%%z zf@&Sjn67&)ReqkuI5?)r`#$&dw;=BBIajbM`Rjq{i2w`Qh3M6f?Rq1%ugJVv>b_8@NFc2(_n@dT*=nX~ z|7<#)GGQ7vyZMuvgI(jB?N7d#DsmoG$!Qmv02lhUH%k&=#wF>AYsg&;%*w*t;XNpQ zg5ewdF!!r>J9$w~d*H=(^phi16G?1MQ~H9+?E=b(gn+v@%9t}>7C$hRl-gc4U$5H2 zySe>cav}R>)8ppvjylqH%;punS=7BX#dxjHXwe5!r_CY`=WcOG)lulDH73jO#K_rY zE<%qGxx#Xue}AxHSvY8aNnCp1mFjy|;T!U~g^W?`-@YZ2M|_iMOg1(;^y&}wmw6m2 zS(fGmgpEK(VkNDPl0<0xIy~mg} zcM7McpFUE80bQ{;Se?7psC)fkLO(6PVeDP3GEZW5#x_Y&ka4DzEyewuyf9cwU_mH> zq=fADL49@yMfLXh`1o@*^R>BEP1(MaR#(pnkz8HSjIrYSX?3&T@_aI((szm5c*?^z z&VCOU8#uzH3YHxrf1WQkrDLyq6l7NU(8-v>84VWQ73V4@lZK3Xb$waUmKeh~TXxGs zlmpWp^`>Z)%l00Pj`JtWosrDp%#v6I>UkFkY-C3lO@!v=iTav2a&z0bN$AV0D`omY{5ff`Y<~Nd@y7wW-JNGT$;xWLC`(Lp+i| ze`KcujkP+v(1-?2DZRrP@%Z?7x(z)EgX!V3Y1^|W%t`o`(F{_quCA$GQjK<4U)j~2 zGxM)`J41S@rUcEzQBI~3+jmmY*^X2{w#oWb1gZ-g^H;O?MJ@h;c;xS#L?c5A3_)&p zCRW7ZosdUorp>UINCP9`vOpq-C&qp0di#1Zt?aXB^bQVHGHWwaUO^`s9Tk1lyxVql zmQq96`!+qbW9_1rQbQ)c;xhxw}-~$DXcwdC}*d6)g{$sc<_I(Aaioym5#+>Z%h^8pu z5osyiDI%_`ReCJAy&8X_E+_sqz$aNO*fTm#Tx;1pLHorcjStbQ@%I%gW^yqrY_b&- zhmY8M1e~ESFE$5xIf>A3gfsXn?mY^E3Yn+4!#}o02uR8_Tjhf{{Qh((#jg_d`Mltg zrKfRyX`qUeS}ED{azZ(7IB9dX<34;~-k_ke3<8t=Uq8XkxY^%7ybER#jLg=R>2TLD zAADFXSUZzEt`9!GXDW32Aj@$<^9Cr$*w-M9-i2;HA>aTO8m|4BiE)2`yTVhG-8;(M zWInOFP$fB=vsWw?cud{G|KYt{nLq_5ITrxh(%8-*@lSJWL0|>(G~B)3>G^h&y`J~N zqoT*rLN~nRC_267){~_kW@#wT4i3FS+itUR87k$X=+!RfeIeAT=Ev&Flm5xMF07&cVfq9rl^3IUw!76$ z?#ig?5s$f?jzFdIWIWkkH68j}P@0*70d^_Eh$%VfeD)>`kuRhw-wRQ|t`{5w54LSE$|3$D! z;2Ef~%3+*?)eoss(f@Pp{(EH~!*Q;?HhBE6e#4?D?mairVtfk&uFTBT3nj)rm3*#i z9c=qu_k1_rZa4evOm)*^c{<2f43iq-wG@?j6)U4}N*F(IB)h|Cv+Z%`mlWlVv|oGu z-#VxTB^Dyvsa1`JFPb~NT#7ea-ng3e!7sYwh9Gt8(AWIs*lSke)!S{|wjFr}3YR$i z)NVSB&?tJwtgF*Y+qSysm!`>=1#SuX&?$rohe_r#a*%2`#+Cy)i4pfUV z2SO@diWSK{5DR9MS-2Bnvh!$$)#bg^(BrwoG;Jd$?1E(E(zgg~{*hR=Exp+o2bJ9~O&>p>jwLtWwLef#n5n;cHYHdf{Mc_w4tHehLplPDqjaLPRlheaGl#ZCGDSKMTHj?c`LQl2kBy$oiSw5kx$9cr z$}>x0uA65=Bwo-`66hq@7_QwcVH@Qy^*Hq1S}03%+j4wv#4Pu?>+xP6SI27-v9B|} z(rq;wYl;6ZCfrpSMwO-;xVL9X|LVa7zYc{qEarCcANRE1>w-`EHK8Y;dX;t1pZ3w; zjbAiwuA@8Wxpxg9!AeS?&!bIzEN0H{5ObmCFDYjN953R}`JZhvRZE@$HE=VMOV<}B zMTv`wx?hF_drR58kAT{tk*wgM|?-MEC4z`3- zFxMHFeW0wrm(zFn{gKX4zQAd8-R(ZELp=S{Roli)mP4 zL_!}S_YDr_8XcDchl9?x?%k@BuF$_n@1eU21qDTqX5|m)QCz{(5qQx&_M7D9UikYM6IL2ix;o@R=EcDXDq)maa z>iJOS3kSrJg)D<4gH5(PU$$k3!$p|}OS>ceH$@GIw3s!NH^m0T}wzsI=h$^j4| zf>RbH^1{VqC4hG%7>I_C{~+h}EY2KT_3eP5%HM5W%{qW^(sN~=bF)&+nB`38@V|N4 zvS-dVl%BlzyyNxp6JMa8wJ|c@Ss9z|PJs426fyToI|m>0b0*mAh>{+mbNWl!fj50H zH=(C}*i5;@I*|{|cx#Lh1EP8|H8GIO0y0fjr6w*UC-TOWs|(mm{?%&~AWCOUPC&t? zd{r^{{w%!cbX3lvXI`$3*Xl*h##wJ9hw_G~`Tw0L!kZ5Hb|4oG#G*mnyMwYzfm7~L zzS%Ip`3H;z@)9l>6M6k#rPsfYulDb_xj>>oJ7Ga)dzO>^)#503B0*SK*fSNCg}19{ zDP$+g;I^7+4FkT4?Xbw@z)^{B!kEgmP`C6B4Ah;_Dbw$;+FVrPT2GppFl=sW!gX68 zagYdiJv3AejJY0mzdk&Sb$o4pKs*w%H18g4bTP&K48kQ8cGe)5vZ+iiC`_)K?aNNR zoq0kaDx8gb%}95d$WJ(uX&o(bs1hvD-8OY}P@Q(~dZ9UQX;G&7)cY)~ZLDP6ohrtf zsyB_8rtzSZx~Y}4M{W+MX?fYy&P8bJPmDi&WG7`)Ab~O%5X)WhXk@1(`EEYEZ?3kM z@%60&%DMMm)S5ZF;0dy0OuNp(TguC!G5y~Bnwr66$m1W395HL| zqivMIc(x2d85$-tZE>`^xrU(gxDUAkC+Gm z(F=EGDvrCH*dx#vp~az|m5V;^(z@8IVd2|y7|p95c0r?Tp~9q@Jn_UPhRArjB|MTt z+S>Qtc5|V5=(8pL@|Sh%ZB3s_tW?KM;nn0~-N5FyX77LH&~1&%;(Ms)wq?xG+!WcR zwiYwcGlnHu(vEq#`OSPXDnjFxZ;Mc?Ms$7a)3k{*)}!TicpHRWaa0&GuVu`0;StA$ zj2%9$wx6JNZG?myvpRNG707nvQ&7lMofAKrONndpJat}`YtjKcM>;TXhkaK$gLT7w zr@O4%ZwYZTw3?<6VKL>0rOuyS-pK_Do#sdK9wVH$7W*He)Y_Q8WOZ0n5AyQ8{E&um z-3;6+(%MsK{c_IS*i}1DMg_Yy{KQ=wJ$<2Bt+bazRdc?R@z)7|mn2%3*>lX7vDdHL zCfV6Fmra)XU>LBwfv)=f5piXmb%UR@7r%Z>`v90#^M_S!HJfA0J2Yz$W;F9YG46rW zaIsE~1aIJ#Z7M8z`B5w@8%cZNiF%>>p_W@$OExr7&-tfZB8c$OC~V=4-3{%Ca%G2V zAxs}HjArQSiMHa1Zw1sN$Q}^KE%;+7y$BYWSnN8V3d1a&12ql5=i-HqrlHeEH6n zL*^AOt}R0Pb`miohai^y)6Yxr&E|UhL*i$rQg_?HW9}WX#=#?g&*w z3(oC~-Uaph262RCMHxy<;+3`|s#U5rRIh%%F{aS}UO;R;s$B2QiT-MH=)1cHnFMMm z7*1Zl2Ktr~9Zip2uJP#TV2YXf_ly$bmLE(rvDS-L$+d^zp`oXBK0}=sLXsQ6FYHCq zvK=#5xjRk8VAqr##P=j7M3iXmn)ti%7zQGt#U&&HhDRL2(S1J7 z#5`Mbs^>PBdAClE2wMfXRJl+qj+R0*UTM9Hf)Vf&SkO$Uu4U(Ntdw#zIuR8w*X+aK z*zGo)Ol-OK#}c>cl4Yy;2_dAmUX;bn4{h;{=M|wx%t^bf92}(i{gKl6Bj2rgsw0Ku zp_nU}0(;(Y2oP}fMId{D+vM!#2jFxT9TK1|)J_!W9Bb9!c{}kwut{ReLclfl7Shy)Y2ck1{D> z--oDbO3FL0G*xY@PEsfqxfG#yTkYs6)a_s16?E=+;?;2gd-)(^CCI1fft+Kf>?FN( z`F6xxGXvDJ-hGR!fLwn1_={T>-w|0t7}M0M@F^qnhQCViX{ zM24E%AibP>f1i2s+6mo$;l5Yk4E+(5Q4Z0rA;@qxMmJC%2ar_sPrW}Hr>J}jGoTJF zDCckAAfn{Diikw(x)LQTu5pzj;e-*FZ3xP2WUCp)ViK1#Dr{ArKPMAa$*J#~*GlR5 zOc=?|xA>!ER?_bPAsa0Lnk$_wO*OZUCw-MHRthzLoh~w{_v1n`Dv)pbqrKx-LZR`Y z{Q5p{NFCkQov)3PK*mlz1f$c!`zwNb-bfNSqZlpDFq}rEuzc4VK$s1GM6+oRkbdc; zXGvxKCZO*2Jo2S+T2YT@GQ=?7Lvnp$BiLRb%`F(EkDPuwT9OTfe*?>p0I6 zarxjL#7L;xLR|Ah@T8F`ZX+3bUqC{zx>4v40WV^%pqzu}JJI$b&F>WZE+|?r%ng;~ zN#F^>cr49Hc&;T9nH0&7d`9lRYD6YCK7g$M>Gz`edx^A%D?aQcBeOU8+tDgcIkgw@ zm>gwICJpd|@lW<4I{6Z7I+yL`VFn~AR?SlF`OVU$zM^dF$al1Yj@A!o$t;t+Nc>$i z{amp6^(Z8ykNy4-*fL*QJJqAWGtF)Z>#3}>nsx*Efm?^0-|Tf-#VF zYV!r;M(orLK82&ySR^Ad5etlY1gl^Zkms)&I{moX@$Kt{DxT}@<8&gP9S4ho^lzrgo-)%r55aa#3d$$LZ zO&#IbECsfP;gDtDy-zBrv$z%Lg5;rN`V>@E zFP8u!qsG73hp&>s(We#7KO66%%GGc)9Cl=Xhg3U%_s1Um_t2NfGBk{&=}ST%|IZLw!t zbfbB+Gf$v5tB4qSqayUwX(k26J7hi!3T(z#;0L(ek%>063F(0~BFw%E_ULnbqpwdu z2?G;Hf$&m=i-mRD=p1|q4koI%xm=gF)^zxz`Z zOIyt6Y+sD#TEq@(XKTl8)6~EmSChpad{5O6VTKEzDEH22G$}<+INoj z*VVQ!eq-Md$nK`m_H(5zWtRFh`CdDk;1ZS-MaMCXdQ3sK@shx*!mA`QujM)Brl#v8 zeB0J)GkC8oC@1pr?k?6)_|Hi5IeU}%i%IicbPt1@+QR(3r^zCKlDs|633GGQ^+MB+ z1JH6J1_d?7EZS}XipW!p2B|ge1 z^KE#YRCSsV`XUu%+AfGUM7mN||Jqm-V-r_VA5YpEu|M~rf_bL4IGyy;dzVj3MM9Je;PWv`;^i^`iS>PVtaX&KKUI39iM_Q&tu3*Z70$rtH^bsNRiIg!A8g z+bk;-Th~iiR7@n`sO39Cc6%=7ti3O>qYVxX#RQAtJ{OKHT@bPTIhv^f4d;1JIqO{G z#03)@5%P+$>!lYj1m)S@_hH}qF_ldvGv(ysGn{Ibf-xAkf8Vp<1oX63{hoeDz zsnDz1t}mJQS4M*~#d+QN2VLDg-^paoCbpij4tcmy%@W&ImdMNffP=lWkjil^<<=Kv zeS4g~0n^Rbaq6R=gjs9OkFQYA&<{iruTWcTU6z_Glm7nDJUiL6C@(`vMU%HRNoS$O zu&CR89dBvaK{~xzHi)n)e~Ow#QOujd1EqvE~OUnx|6EIj-)`!Gh%q_sPqe|=!d z)c8e+MvPZ~z~PUc$Zq$&hi*|OZj*~*o8G~*wPrEv4fBU?N0_5`>dx=fe<_9ZSDWR_ zM;r5ac1PxA^lzk6ZG<%r#LT%qH(&NsC-P-iR}NK$-*GP-euqS?qzX*tljS+N$}CrL zaI{Q=wU!mz@Q$1H%4_CzdTp=PaLet5w`sa5o1D!wbzT=GmeY3OP0%cTMpwZOYGj41 z!kuG}PD0h2x|08E+ec!x0PZcg4=u(UkBVlA^*+in&uXR5X>5p+E2!RY$ul_)e?F$r zQd-PVnyu+)Yr5*k;{Vg}`~ag&QpU*u7pPU)=(=6=QQEX4g|7?KN#*(y)Kto;aVz6% zhI#~erEOcJZDVx_&A#Q3R=)5ycf8e2zBDkel|D+$^6`i-tA0@R8ShiMp<#?y+TOM&V06dPj+7!&-_#e{s)teOt#`t{>xSZ zm`$VP8KpwaO4nb3S4I}(orV?Sa!Ac(zGoF~9A{L?H~z{S^N`}v1KM&+wX9^z46~)J zp2&hhjN^qzaLc(nw-VLSp(Wn!_-QTN-`KqsZ8F*Ra9qyFTe}+$vD4q}u#l zxbn4-6a~ivS~{y;niu-1Gm`Ko+a~dEG0uy1*jlh95-t=H^pa0poW}0a1urOb#1!fg z8l2YFNHDe^Dytge?RO&jDBy_6^6XYha3TtqzpuJIR~<7OblT*sP2rwqq^5e@;---c zT+3+PqS*Q2qFf$}LF-eRhaM%OrN?LJrWJ?+B#v3>Z?Jug*uk6rHP7yld7ww%-W%`3JC&$)-+5E-w zi~xDy{-nC_x4?Kd=k1B96oK=$Da!h-g=Q{~d+cTcZbtQ%)Y6UC54COAd;(1$G+(r| z@M(0-zS!mY;gZL=c#-LO!_cGenl4b9#E^2|Th_ld*_hA$<^JQ8)`UwxRM&Uawi&IY z9ow|Oc9nRUZJcjy54KI|3`)M`{eAm^4XDX^`0rmwF~p%uJ_QcVDulBbPq&rF&-hO-2#NF!Jw+)&#q)I_KBTDo7LPg}!AttWWgy_n0^b52y7+ zYE+~+N-IYdgLI6}UGSaAPTRt#GpA;Ll3+h1#yQx!a~h1#{tOKqv0igr8ol{fT+MAf z_isvcKhAG$Jz;X*;k`D>O+jEECjSrKL#mD^`O1HY7XK%Y>@In};nT@`H%R7vmI97; z3OzKwm;KtDm}Z)Xu*h|ZXJX;Vm+HCciSt)fhXF2*(mL_I?29m~WC(yUF5M=ws``-% z%z^i1+MHUaHP8z0d|6FGFlAS~@e_4mncMbja-?)7B;0|aFnfWu3)#WVsEKGI!W~7Y z%pL(D^*BVo9N)_8dv2=Hdq+p;MmdCaqRlmRJltOL3@E7iB(bou{cOO`uW9O|wrF&2 zaRO)S8zGMFr|Rm7Xa@_oHdc9R;z(EUmYnM5P%F)E-Htq`*YpM#Y+8>ErVuq|5$}1X zmR#JepBG;0Wx)h*=K2!A?{{3q>Kf@4Tr?nK-g^F5Pth{`b6=u2U10X?XA~)|&|Q5O47$=S6@!FomV++gvtcgx z8n}eRtE)$^;LTvce-@Lm>@`pU?cUtI7kS@r&(5rhNU-A#ahk)W#~XX#lZFG3F|>b@ z>Ga#wjDXp%b?Z1Uu^`5@}78dd0gC~2q^NavG1l0X> z`sUXb%P=T+8#@@{)dW+?7#fFENuPImGQdGgenM%jJGzAa#mfn7wJQ~Jiktt#zk}8~pnt#$H z>IkXrX9Z~bmZ36k-E$qXs6V-Q4}c^`u=Cm_Xr1S`C26Q(2@DQl&fS6zdVxuStTb`e5yZ7L%6@( zA+IHhw{4&PIH3m&!bsIjSSH#Ywu`$9CHEs}?K!#~#!FC+pE+a7rKw8(ND2jCKE98` z6IsN^*y)Y$7P@=EfnLyGCO`zpP$bJ?|DIq$v}6qX@w-3b;xgaYwF*NnPu{UUh|lOU zSh;-&;g~0>kH>B}jJo5`-ymVq)<)J#l)tIu-^mvv>4R-5>8$w!?NAd~HTwWW`HcH@ zKav2Uwal4JQb_)=Vf39RSfTLjS8LusIkx;&c>fLOR|*043xr(U_gvg?$o zG+{rJ+?I{Hl)H8zanmMz_pcNduW_$pQKAjv41cpf9zT~V?7qLJuPgnB%lYRH>u$mT z@(q)(HwPsCiZ3%fGm7)_(#prMzhcmH1Av~-%cwKp_^Tu0izuBr%)SeG|Ni~$=bXka z1d}r}5?9aNblYrfySvH!^yyPNZf@>Ph40au^uZAk%sXHj%}{XFOBX)=N=ziKro9-q zua}qIT;EW$?Xd327mKa_US1OY%4dDOSXsl%l-Rwxu|+nogMf&~6V!Q?hIe~L-uI#H z-`yU$ITIdGKcI9D>&P5XH>|ILE-sHr%E_|peC#TGe%sN{&o3!AmuvT4Bo_m2J9^aB z#m2_w(T41kHC%`V=5TPV`Do`Ks$civueiP7ZrmN;j&GSlm;U(D{N@AG&cZ!6D*yQD z@9z0000LJ6IcK4N-zC?l)ZISlwaHaEs~0a zBAtqWv`FWW0xBiaEz%_^IeOLv1bLrTriAl;30=g`e>^E|)%dEfP}^?dL9^ⅇ z%r)1w_ny7a<2XNuck{?kPDcrXyV#nKDk|I#9CcEjN=gx+XN$GP!wp(tv1dbDEBEb@nx<5NvKn5LAu-N?ht?j=$#Jqrz5&Y2LLX} zY%s&O#EoR`Ro{v^P>TyH0FZjT0W<`51HO<4c-cFc32--7mN3T+8(7B{qyz1H2-ryV zPQOt4Y{hHifHe4U(BpVstEQoG=UG1q=|(pIgC5-znqFJ03CjJ~8Fu1Tz$Mu&a=E>< z^$wUVShRl+@Ujtq2mIp*`DB6f+9!dMcjkAvZ4Heibr@Xar8}_9i79EYcT9wGh}`Wz zM9nQMd@{;4L(f@OE5%UO1p6+vAN_{*j=I5WKI)MK`Lt(gA4J0Mn#Vea1Ld+{*hVf* zX!61)rg_Es#0L+ zUq@*n357fN^FDATUKFkgpRHZ2IAHOG? zo#G*mHREshBy8QH*{n4d$CzC|Deq_avwS)y$}{(Bapql?^eG%}o8LTQSPzYO>zgyX zMYIAHUQ%9}{$QkH&b(PDYSkNi-|G7)cl4$-?CB=;W_oRoc==j^j*`T2&yYKJPRfs< z1X-yS++MXTt9s29uVi*#S8YYbU%WoGe`+1Evw!`r`J=3&V?9JfMD)&4#dq`NE311u z^u{@bIuL~%h1(vA%j?7PppqzgN;fkPGoxRSc{2}*%aGLR1dYs3tjx7OCqH;hpF0?S zTWxYRw3w+Lx^}({plTofz4_$jelCigiHF+yx#AEDlf;t={X@;!cHLf+t(m9-|5Q&7 z*}u+*QjCm@gPFApYO%MfHox{VcYe2K6Ei0B=u;mDi=Z22SdnY#2V->i9B^2DAn-~p z$C)-QS}wi9FU!lN^4w_u0jI5mC{*{$QN|>M=`w z?9LKlOvjqR)68%@eDKv;&S}(YwB_&Fd5+5fuG4nFl;uh(@rG@2^~mMPo79Jo$fL;- zpNtZqc>P8b_Z`NU#|02{#eJq=%&x?xnXlz5pGp2fsSt zG(_!7?&^9ynrV`qQe71>4fbWlCyit!YlSztZ5#aBbPcXlbbwtRI7Lt{_}8=J$}(qX zEQPv#S6#re2WBltX7u?&S!eu5BSVD|PL-|_{lltbABpbCD&M(iD>diC{|2O0-bzNnS`r8umuf|9yW;+f!ouODu-jyZt&zMYePuY3R z5x2XShDMh>vxE1bRdbhZofa!d&%Y(mkJy_u@PLxHneGSgH9OhQ&$$m;Bk|&IaJC24 z#DFeT@F>zG)wA`;-`Ds2pc)~}l$&Jtld=D@AMCN|Q$1@%ZHk=&YjJKrSv`a|nv|mx z3%5f@V%9nO^vJz%HaLhGTlumtO+8IZu==XZyI);o4i4ItmYiGGz*>Rx7;1K0SA$r&62UR~&Twk&^x+FDBV8SO$|ITv+WCR?4v1^1^B+t8+i!=< zh2>XU*Px>%cB_QCXiYt2OeMmMdGI8LVJ+Fs=wtb&U5rhC0aK5CMUk5o*OK?ex3zbR z&{j*y#8UVak3qlM3m7yV$^ofZdU%wkz&r$PjDH!Dg30#bLFbP^NfdLte- zG@A%~bP_4h1G>qQj;8jPQC612o{f(Wd+sOGF4q6(lNgALpzrSyD-Emhk1t=>Mn|zv zN=^D|RX@l5P{sNz@58zjsd129=@R}ox^MjK4%GIBJ=h^uGI&s?>g}Wh)4p{Cvl?p* zI2d(y>Lsl`?Kp*;&7;AMemtXCWdRE2FBX?srV??|YAX(577)G!WdOfT@Jbc=Z!2Z>XmB|==E_8Ojs z6vx>qE124t6CXWmoz7vJtT9Yn|ERM|ZEw#tbjVKSezAcb+Z7>ALA)nX=xKUeIy>ge zTo7XuXIgI&BoNRRLVjC%kv~2@rM4&_$n%cla`61wMK@V5bz-%ts9ORjjs`|^>-_)pW2}js9=uWVNi8z^jOkJC!6hMJU?CDXsw94kN zrduO>0z7sJDS~ZYNm;?xh&Csxlz&N**@uK~3E;e%CRfzK`sF4R>9a+0#M&A3h#v1I z5JoO&9XyFC=%#@BXj>R(yJhWATAQGRdLqmVi5v8Hi%UmrX_k?-+hm6XNX3jj*oaer5!&;068kIAz zJU%q)D0kFW^2D8_Rndt0>2I>vT09I3l&cr>@L?*Z<9`0A ztY&l)@>h&--2}B_+YhY zkZ;Dh1xMCiS@Q7H>mhBM+D)N>?bucaF}xx1lK94rM%`b;0)kc2)nk5ALAleP+^c&N zcd{c#l-jLXpy@(&SjMa8Fxkhir)5#9ej6CGg*pVe_0a!n7`^aE58V}(BzF2FLOaCa z@^VhskzqgH{@Rg*0y!vg34kLwv6}Jiy11%Ez;9t`6IbF z_wKD`{;lAVxJ_b$3Vws)2S@Iy()@z1 z-VD8Zp&*2uyFV zRy;=XggHl-Xg?b=^en=j4Xege&>d;Ok@0cI3SZKe;GdYQrK@cWCI2dO|MJUYU;Qo3 zI(mCJEw!aLTPxrKPh??Vu1Q1cKTO+h{nAZ(UMj_#qq9k5l#Y|WlcC^Uw62ggH)RlS zKptCw!*{!bSCiI%#4weUj=HvIoU~ON#uMTccBNIZ*McMLcGF0F_TAY;r;%Y;iU- zqQ~mFU*Tb@GAhjX5GOau!CM61R^4Ht<#Xs5=IeM{d81O|>m+{vK@3Og9pa!{^+)Z_ z`a6fr+i8EFA0i0PO{cWV(w|Qe*_QVN%Ow~r_rLk$gEz+*Eg;IHth4UZ8^WRT@Wfb5 z^%N!=R1tRL5nSbapE78_Q7S#c2eNq`Z;O{_rJ4E|J(ecv%T*1Myu&t!1G2z5Rqo`Q z^HZ^eTT{c-enL7m%&QiKXZUX=RnH+NQ|a2vA--uQ>jZJ$8^u#BeT{o`OgvF&PrvJm?m0}o~`|8D08RJ(QlYmjvd94 z_hX$?o*=)M1T!4eV)s%@auMHz?J17>8@+QoOAVo)r^2kh>icUeTw4UQJ$!1Gs#;{E z7RQg~wY))*ov(>KuK4l0Kf{RUFu#{v<$|9pry=^Ln2*_ai7p<98k}{YzZVzh>f5 z{zqq+kJ7L`t3W3pKO~&^fuRu%_R*H2(dMVVdb2X4OKn=*i?#h0zphgZU3#55shxph zW!0h){&V=?>vZxPgJ7xB_g~z4qH`x)goG(u-^&2EBVwS0dJn5L(=Q2NXoc{D-NgivEcKrj1SXT z?q~!@=$$?;=`|Q=dU6)i43?4*nCYMDi^ipQA{g6GjzvtzXIkH~>NWCQ7rjXfnQ~1MlV7xdBrK{WIsGP)d*?&g<9Tu_(?&;YW*z5t$7fffuXGBnb!ND6cTn9Q zf00jsq69}#-=q!0dob`!Xws-aeVWZi;l|`6{=Q9#u17C-*^ZWFsy7rvz*2{=JkkEc z4s0!RRvdG2zGL{-Rq;^O%wywuEK?b_&hORsBz!y*RWmvR_$MQ0{Rb}i!F?p*n%wv8 zNoLf<=nRW}`1=fRofW6=JFFk4Z??^pt8#t{o~n1r4EEfW&tzUtrJB8r1AOVCshW33 zaMYn`5kg1rD*b-e5txyWgK6d}na(sr{@@thqGjpv!x&0O>#&m_um^?Vf0hSdztR&E zzC8@A>yfurf_EdF%;No0?A1gG_}BQp4MCY|YuE{n-Uw!e%5|>(~+Yrg*^xdZM9BDE%H+geAWjqepA5_SfU?D#C(zY6{V)zmT zw<9hcnWdhu$GStG?;w1eKhUm68~4HEkNWPa03AgVbbETEC%JV0#;W=&!;;`x6JCY= zkibdFm)i;wt-@HZFffb&}`JIlb_$nJe19Q>cQ-dDaH$n;;n) zOf1vWp8x53_}~5!&f*PNukVQ&3O=t7q$hz>mhj=Y2!z}m7qUy04F6y*bYRFetaxBEn_>>x4Y z`b8U~_RB}#B>5j~zX1i>nUH-Au79llHl|4F161j2*CSI8VH;n-GEfKkxG$tBY`@PF zyHI;x!RkRb*=nNO*)G*$^1{iq4YB(rh{x@-n=;G2gMl1Jw_RdE2l-qMKDz*;TTk7vt}BmJ`t84Kj8TleN7N5utZ~Z&oc_?o#_3H=e!OdW)4*>n!Lb3-{TqgW-HU&3~4^!ZXoIMFYM7 zPx3pcH<_u{zgPg!{k^Z&bvr!eB&JWcARyy024Lsz3h??w#6>f8ccCyVpf&N!id4cK ze+dc;Xp?pqEQQ_IO$H*e8c?vK^YfXSN{C5;hLwPU!iLWi;+jVI&#HjN8~w%BKyM;; zppVN_zX5j3=|Ft5O+T#dUqWR)$!obDo|WAf)-6=-J8t zzZaUf@x0V}OLUi9d}W7^$bUy?2|9LO+`-kDCKDtzFN<0Mt>hswR-$C|0M?UNXum}} z{r@+Z0ClT;<0QxWxWnSw&RzhIb;6Czr&OKZxllBb~*sC{SKV!zC>4`2fGUx zWuF5UG|vWr#L=Ij>t>)gCnS*7fX0*+JkK*9(5mVeGe{C4_;r_Sj+%vu>1SWEAn%(9 z79TVj8dWN=)r$Id)&K0mRy@g_s@fj|2^m{ zyi@h>26XD}l}TQ4v6D+s8;E~$SG@b+_(n4{{R#j=%P+zF?gl_%<2EGg!3;1tuR4Q- z2;1}B32*8W_(eWw6B}fClmdE1>RKMf$liZ}FYYx*^T@m9<-gI&I$wAzWxn|X+A3cH zSX(%#Dock79ms3|Z0lWrZqEDo=K$f&Te4IS8fbOePBw<6?{ZUI&KCSvfVKXoZiDNe zuZT;XNpMX@K<8O?%mVDB1KePuR-@k`&x&q01au3u=v=PvTLfr;Ur|k&?BFx*P zT*w36i2qurDzLtImzs@Y7X7oYrqkd)kgsCFLaG3whD~(oen^R3J)5sgQ|GFm|Au`B z2XlOR=LWum5#2Eh-=~V`5V2{KDEOdDxL1D}NE5TwFx+O*tykYSLEUaY#kdP<<_84N zY#_Yx{Llin5PC_l!pr@7t=|O_SC(tm_6R((DzI=C9jIX zpIdQoYZ^I{6%$0Edv0*zmsDgw5Sa9X@CWVm zD`0Ih89eF`gCIG>48xPLb@n5zEx!D@=8%hEnTY@#OF!N1Exp5rk<)`;DL;RTA2a9; zFUKRMri3c#KrhZwZ(>l?oxY@ZxJuWRr5gW~iHVisQ^@ygm-9e{a)7RJL9SfB7l~B6 zg&ha8{?6<}wxdJ^vg%HTxW3v@F}{|rH^QCcwZu0A`R*#hZh2uwMhOy!VyT>XKvx=g zkb^}ZVr`We)LlWbgm|c*ndcKHjDcb~v~;|s_WYgxz3M>r?St8PMU^-w!V*2n{DBI$ z*^C*ZZpiRqR(4nZ$e3nj-v6U1nX3U!Nl#8Lno7;oNjUe@{PPb5=jIhD507We=?S9+ zx%48ckmk{-PVlFj9Gi}_7d2(pv*L_Q*476fRbmq>e0|$K6dlKwtTe?=k-VCKms`@Z z;NlR_hYntdO9UQNz!%)bF9XM6<}hd2osJaXj!ZkSny%=rRten2TyY$wi&|7bUGBRm z9ymEs+pi5io_7Ixi87u(x>n%esJSrM;iG*T*RhZ;6ym71u3-YR$Eqh@*k&%T%yO zl-Y&wv7oNkZo*Z<-y^+y26ya z`ru*zeWh$A5f{y>Cu;md;{ImX=WRJ9-zcsYAgeDcD}D1BF#7t_;OHAwPfu z#0B}`$BtwjS?Bnyq?OUZ=V^71C#yp{3x9V5E-W2^aTy?8YD99aq*NiaZ9%4G&BCNv z97DJ#s94PLLiNpi_HCFEi#neK2Hu9D%9(ZUdk-a|n49r+ab0`3`sXp+N z+SV~@S&q@U+K%o#zAJyuObnOc|D*SOvZtPYqxg*!FRCqu6&LbJDpO8f&nmHWjrpfK zLJ<*1J!Ol&lKC&i$Jys!iVv~Oo`he=+mku>oAVbMb;f}lU1w>36p2a~>zO*o8|uY( z_Fm})rxdJjJPdN68Pa!NnBkUAP*}^DH{R^6dK|)e#r1e7?_!;3MRXqjIraYtJ*;}n z{~wiyPs;HG5zno$Wv+8H^HD3wD6y48!hotB_k9gM3$<32EYV?8EC2P_Q9v_fVsXZ6 z2TPa!9;(h+$7cJp6S;tmMz|bt$bctzpElmc?nMZ5*6m~e_RK3Mcs#cXkJZexBF#Lu z$_G|o1XqoV4D$?m8gL~!VNNz#jKk& zL?){wj~j3~9m$fhpTB;>Q7+M&yY$u|V)D&%0l2AZ52Xcn*aKXwfR5vsLjg*AiYTRD z8|lm$<2O7w7gKiHSaew3G5wt5Fw=Lxrej=tL*Rr>`-++Reup#Sl+*SU8}o>oH`V7f zM`&k$UbQyqYiPxW1JyL_4@F5=sfGO>ozmaS62-Q=P}2(HPqw?qE@!%GpFnD^54rD0 zd$q}+vp9I4Ho)Hg+aPd{u!YbFY28)22 zc*55w>o}e!@!$bDZxIJvi*CTG-FB9&PKCd#!YHmb_|Lr;yLg{VCzq-#+ko!!>dysw z{9wWBrPR%P1ZbUd0<-?m&IU7sMAXzlZ!SVt7}ycBlq+KDrhzJ3Jz%L%ml9;&wV6h|EKPRGpbV$1!>VtGWDzjaR zjFJ{$INJXa5kgMDo^-j=i$U7{I}NY6#pW!vzyJVod5JTiHw%RPAadpK&X1HbV-+gc zBZ6{GaZ#s@<1D3!JyUe_;J+P5jRXU~ZI_6@pc(=^G*pTISxe;n@AGBiSGg@SY-$n! z7LjeGB^0Q_JHPt8*u;+8VSV7)e!F&du>-#+N4UkKeQdm|b98skhjXr700upJm(B^_ zUGOVABxZ&OmZ=Bm!S8&-EgUJjkh0-4d<;rdslc^X#ifHf zTv`Y=+;#xjiD`b;?|DNDJl|Ns{i^{0S=V{j*SOw%$0IIKE5W_{>f++38en=x)o}*@ z!wC49y^)htwjdJ(t#%(o$H%X6vd;n6Zi3q5x82_RikMkm8&{;kupg$uhA*?GYsW_1E&1m)?Xk}e{TN% z;O=$qLSG(H@C}SdgRHDBa86tzkHu~VH6~C)lW^CWtg=cJI$w^w`_b+3l2i&1djl_y zijMxX6b9M7`%wv8eo1+OjTd@qAW~;}P@4J}Snw9SF{xhWCOajRFh|HpQn{`_oBOSe z58&H3b|6RxtrnDs!T|S3?#`;HFB0Tpr3k3uH_yNkRcug$wc~gzNA5PY;q=}}LH^Lq zX#+2B1Evh^11T9(Qdik1l$-lY0WvI|uQEO)D^Nx#iCsmd|BS8bV{l zRpE+)p-A{Yl@WLC-&wi68spzuu0Q>II`qx2RMl>-;S@a2gKfJL{!3Qoxj~M4@}xCa z_W?1?26FKb5>#&p^L<;5W@bt2%d?T{Q?#@p?{xv$9Qv$l3` zv5B&>E|W&2d8Ul&RCy+DM@9m2A4}B0o*f!=MMbF=cb-i|$%s+9XvJ9_AWb+CqgyBo zArOQz%#+&;VJ0~&H_yvL$p+b0G#?yTaHsSKZ3)#&NtaRekdcwM<=n(PMy|F)?9 z15%z~-qG|RKIDU%jQE2QZ;ixFQbGLs+utYObn&oCQeCtzI{g*6-6}eyTO!)S$(3T_ ze(mLw2z<`Xma1CDzE&JOtw5fve|eJX9GK`jHJ}!ZLi_2!UDm%X;n2)Nh3>kwC&@Qe z#X6v&8nv0c_|`~Z(MI7XWK+`e9p()_7a@nyL;n`1g>=gBiAaGV%TlO&a*m?hl*bd|ED#Va18Qm{i zAmIZS6B0XxX{F;s-?g3k`>nqI+D|T`2V;-ev#aEnNd%!HVbgRrhJ2^KtMj|ZOq!Ni#>1Cl zM(vDe&)lZjJ>zf%Ev*uSYSvJj_dNDCkG9JXxmL`Fou+qEb)AvCIi$F0`nX$#^vQC{4Ddh-C^5fziu~&85wkqw=^0o%Zeuj+OHxE&x9?;*oWNa+&;VR zrzZ{_p^E$jrPCyU{h5f@oI1xHt0Hgy-W&f}1KkG(vPSe%()DT%xLp%twb-oa$nl zK;M=0Lu#A0osb1m_E*jCL`sDF^m|X=gb-^C-P$C%)YOErkLB{w&_xAJ*in7kFO+wg zIQcgCgwPEOS=+@Pm)g(0VSux&d#?=1=xeWclX|p;nOf*7+DV?e+G{3rxf3a@POs{& zA56A#vyyFD9J5+?sFPIICYI3go>EAmmv=kh5$#GIFBC4XsJ3sX;ry!G@UQcE(B-{1 z`pE4=g)D#QwSPY5chDB5fN--kN~pS3G7DnmIqUdcdFkiAn>aaxx!Pebikdm&E$Rflt@DG_M=e``8EM& zC+@|Y&XeyoqPup_Lf=wz_Eo@RY*cfJry5b&Pdh%VtSx;S%!nPfLY!HRqBaAOVk3Op zLHq{_RfxMW3!Pcj zP@TBt;$o2>zuxu+cW$fl0rV)sWH^`>VzDHvOJ>`vUl>nmOQE;B@oaai+r!}f>dogDdvTglp*|Z<{Mk?)*k!2@G=IEUFBy8HSFI*Y zV>uYIUP67PEU>zi`>Ct+(1H#+-QauGY;%F~h$XskVwD;?*uMB;H7UR!Zu^`f>~Ts6 z-k;dD{1Chc-(q_ikC>=BEnn{4G-dX6PngtuF*~WT*vOCf*H>+#82BdvgQoNlLzpnF z$JVEmIfqV!(}tx=l1JgAFtO2GwnXgf3!K49hX%{exHFUMIp!ZXnrHbZRUwRWNpV9` zu{V(?7jx}Ww7VAjdF~44hT@xAggzySRn<@WTAL@9u3hCcIS?-PfX@!tay;&abMHI7tFf)ug4(2!VkzlMUd=ymwVNdzM7j=Z0=jiO} znN7YI*SN(J6T6$9z?)X%C50WDI?SkV#fEd+$~NNp<8krl<$FiqH*WQwW+QIvIOQNt z1AmevF)zM6O=5-8i4aAzo~Vnk_ZFW8*speSQXRA<^&CH;zTW!nOc7c#8U4CT+i*Kr z!D#=mvV%UkYu(>;$#FgVYB-)a3%2C9p?gyL{-rK2KN{HI#yFQBi(yh${5dDWMZdr2 zfcADe^sDR3ME~34V~=6Cs#Nnt?z-?b;^rUgzb69wM?-=VP7DGug|#QPf8@GekE54~ z?ChuHb&YO(6A(S-HtYJlQ9L@UXQGwB=Uw|Y;WhvCiwzNm(e5`|(1qoU9`slo5}xsr zZXWYad!PG=`VFxHtNm;rCnwJQ3D-dKn2IoFYK+kg)B}RZNx|R_R?Jv+PKX^e;?Bx$b}slO!IgiDTH!6`#f`; zS%2qy9)|0F|pVd@32pk{Nt`#@J^)fiJ;kmLU#!6y8b-P!D zR*!Xm=|j?9b&es-YGWIzfJe6Ie!P4_qm9H?u%3$%d1S>w-`&byVXal zCm}dPaY=ogNw9NG|MMj3+>oWE!{)4bdi*}~JK36$UdpEh!ZyE1vN+7PO1mWdgB>DO zhOHQOlHLG#iO0RZ(CXPVW};KM-OkdRtgj7J`Da&-E?4sgRNrssTk5~kw3ba2>N>6< zLvVvMqM@Ru&VOQxY&TI8*SLrRtdj_?4d1 zp_8SqZ*-(*JU1#;hSpCZJfy0kH!JUCAZTlR;2EC9%$Nlmj%-MXMQ^ci{fE+ELCexU zF9JjA`@F?@JF<8;TmyVG+lq`^FA4H4UfVX~noV0d!CbF=8^e&;jm8YA)xjtX2duTW z#*ZG2{hUg3=O#-hH*83syIS*`Ex`%KDbMs<)_^2r`y)-@`U)bXpJ)*(O-_O!y64sJ9mki6$IR)|6J1ty*58|AF+UdW^qI(&axhw|*O9nQtZ1SbSH-M2 zlNP$#YDZ+U5Bly&X_rZ*@UMLw>(G2e^_K|oX2TnD`QX4Q`DdR=>SY6ONdm|+EYexq zkK_Q)I@XY#6QjK2W0X+`@&u~i=OgSKb*kG&La2A!EA6~~z@hJ)KeTOXNoy+fUD6u+ z{XUM?M0$z)744dHzsI@8kA|TMjz~+-rR&~AMtaL4`iY($!yrtTt%~u?Ihs0LnVgd4 zNd!3XTr;_Fk4{a$)W&>jQSxAg{ckk|mybkzJ#NY=JI6BHP^VzGjhy)OH=jyq1Q_) zZjxXKohNwbQsbSR0{b)Py@3F(Rp_iH`rL5mxvHi&1M&-Km=0%V0&$-h(TnFNq~oT0hE zoBcNHE%{_qDQ8SyvQv%384D*=7M%#loVw0*oNTn%)9-w@_*|j9q(}autNxiV`Rz>H zh|dJHQK zJ)p-qY0;PF{Bq#IQM>W=Xwp&MibOEVsB|Ez7 zPZ!ySi7vr8LPqI71L#2I$!G#nR&g7-gLzio%QGF zwwp)Rq4RY%+PZcl#{rm)vO!XKsd#9K3F6M~q^uyU(v;h%z~{bzt+$R;-gcke>xt*w z2~%*04dhLr1W53WiedTTg#vlKcdh*m+8)QFfeMX+&+Gwe^Yr4uhu9s)2DiuuOqdv{%Jm09nW!g}A^U=5;PDpkC2bV26kMnFFq-4$tFRKinGj14bTT$wvk+Aup58PvLGfjcN&k0*RIP!`V{ z1z8T4IEo~9(;&xvbuLMZnFgE|CW|!D3j8S`9NtF81Pc>9j_EK_3VirAiNEiE^0pdr z``Lga?j7h9LA(5(+)`EvWe!9Y6R~mzWxOmv%AA2>PCz`qPFqz^F3baa-4LOgc6!Oy z`04Q)ml9;%Wkg9@qwbFNhYW1G%PuqbJSk7r=wiUW%Pr})soSYKnI3ZgfCPEKZtpO^ zyZdf}AjK57vS<825*Xq|ocB6_n0PI1cXV?_FnTNnu-3KWeExY1{p*d*@4NwB%TzMJ zd}2NYhW9W>2gPtEzeq@j*fWIeIs)0jaLCuWWFZOS6MKHNh^aO25v72%%`t0G({0}! zz|%jN_MxCTU~GGBTiTKSB30Y+l=>Abc75B`NS^ZWq)BSgT*`I@YH#%~wuHNT`{oUe zh}iE46dcEY9OM7GJ_W2VqFB9g9JHfjs<&5tE^Emq{@(P3v7qW8z^YO90zlcEoPMug z6>lv6i5%|bozt#pYX>QywsL#=#2x^8^U~AP&zOeH?QEhEU{T2O#U`GzdHfUaA(-WIs9^rg za9upB|95j9T$Ho_voE76Y7NiA05#bxm10@h(dPSE7B!ba^LO5%!hDw0&-Eu$7Q<)A zrQuxAN0@I%p4sfljJ#v1+lv0?z{jBkD~%WpE*39tXgb}$U1mh*b^IDZ>Xs(=qLxhq zH<&>ZgvVM|mC+tQtwGV<45UXAIyMlRVuFa8d|ueN%2(i2%LOL5Y2#Y}>6N>_ICj(7 z`CB*uD(Qu0z>zpt_`{U=Zq-1&D;)E9kujnE+nbHX{iCGJy;eHTo>M4N`A5tK^|uefS__Wf}mP( z3(q)d6|dD4Z+k*Po#KCczW=Y)SKt1P7pk}^u&p-uxq$U2>yFAg>v?-k-=XGx@SuKN zfX33sMj`cLBzK4xjtm(Y8u~D?zPh3HD0(UZ~)%%$0GfXQe5?;!FWf zZXu3U!Qh<IDc7S-&@-$5J%h`m*fI2 zsK`#k>E9ExMlhn9;Gt0p*eUJ@f7)}AfJZ$H42u%OmkGV_PKm05pS{B9l=-C)`L`vnJ$#}MsJ2w61z zFnKR4p3`JXEzs^|Cw1%iH#<{ja8Gl9ZQD`807zgb)81eoqT>oayocYhH+<~;qTjhk zv|Bv~MF&9LQ_r0=TtDhX!szVx;|i~1@^v|Z&vK?Ul>iz>%1OTi>!8{In$vqgfjZ2W z0drHI;J>aiy$?(6Ke!${ zZH7>fm2`hFF>$M%UtCh|wU8k`?s9O-`G_i!M=+T%)$Xv1o+|6;q4~jZSp1J;R!I^v zZ)B+UV@C4ECN)%GbWBCp660EJ$d_)Tu7oogz>H`7CY5S3DNz}5BHZ6uysbQofE^_$ zDXHrCKTN)GcC-07m#ZMK_id>+rrSk*qM)E)Wa~n!5XI zc_&FlU(-4gJJAZ6_nhZ5C9Py9FE1ir;Dz9@h4%1{8=}8%-&qnz+Tr&#nd4(~ZG?W= zjTnYZgTg)?_J_P>WP#=Q0{fxq2Qj+K{Xs@mgO+Rixrg3Alg{(X#)~xSzI{+36L2uS zhz&a6&})C(5{@2YM2Y!n-#rXTySr1KGimWyF>q3)_;Y{uk2rnj29!wIr^hP-Dy&-Y zmjvJ-WjPVx&?LoRv#+uv7yDsxC~8)}-*MR~o}ltPsWks5L^!66B`mqwg(uOhYN~~ z>xb^ReU8xdGI*Im%P3)@K9RUV=5|?kw2MpPea=7YiJX?j9BNI5ZTZZE0pX@pY0Z(saxjTlYb6*vE?en+F|6vRQvM^ z)dFvDjO-6ht@&sfm-`vS!AdF0{}E{h@-VB5dt-9VMxn^6o7JzXitPMv#FUn-;Ety6 zTrcapp)$gPidF8!(3q+zhtbhm`DL=eYUUz!*h^OD<8iZ^)wzNoszJ?}B+x<>qnl6= zAC($1y7C&{t!>iDJfYiZgobmuZd` zY1w@#3IALsAze{NA9B5n;Lm=|7}fn-WC-}(b7)N{evY2*cggMbY{4Thu0Kg^kHNG0 z6J*s4a+cp|#5fMFC7g@<{47jlzce{>m5P1J&#;Htfek;zH=MN?hBm)n$uabLXc4>kj1>j)#pcCJ?v=tbVC1Lmt*W2MWLTx&&fX&TXY~MFL5_}AKkrIDw*WRn^_OpLF z&dX3;US+`$t$xOYQ#|u^f7EC86`ppE+^B93ng!Q^32;>IIg=Ut<*)X4<91p3YfjA} z)mYsPotMq?BZ<(0l^|lHk9(IVc5`t;#9ucI_S*jTJJuGL?X3uHCc8s6F3b~&hb$^iUq|j)Mtq;<>GiH9$bO9`yH1<*zCr7%rU&2vL6$uj4qb9esy?@E>s`r z>Qx}Cu$MQbRPQ?qi(cX_H>K7PX8)@pPZeo$nW%ZfKQx$iEhjClRl7PDHa`B_=qzf9@l}N0a&kSSqLM?T z-*ddE8ySsXCSnu8I+Z~iHtDc-UiN-m=*GdRDm(e>)Nt?DcmIdA_l|0+Ti3o-l%mo^ zMLLLrbm&XFu;4 z@1KE`nYFUkob$ea*L7`{Gr3*)iDn!+(P)nUQJQepVX!?a9eDyy*AX&Le{-90f}EH@kGV}kvOd!y$dmi(U7e(X>3 z-&v;qb2;QnO4~?b_4RK|*8laCIqk1E3qDy8=+DFdw)Fkyd;W{X=^J4EVnF$S@q#^HySZHx8uZeoQISDM!XlJ9wz?S5VYTStqL)`h_FsPUj!}9j_{w z^4@0_7WQ-=SXsq^Eip?f*H>7>{e^X@9?icGCls%k*fh$SG25ET>5{F+guc(U`pVSR zAEGPDRSu{k3avi9nW0E2{m@S_TSNV8ai_|ApS5c*WB4Nlq9%%9rv+$WKi7$f?~%M%B-GYcTwP`cChh27T7B&>eI1t2 zc=K;v1b9R)ab2zU4U3A-tq0GT_!VkO+@Q4*m$Ow}-@v=myXioML#vX7l&y1thQ}i>!yY+faESXgW4a(M|KStv=%Cnsu&G#P(_TR7n;)DI`*oZMgG9-wms$#6R zR{xT9acQy3>DF!cnLweiAnvyPe#t+qL*lg zp(5`~i%l3DgQci=sIg3TU2%}sd_Z;o8?WNM#nG`5brjw3;4H%oNkz!$%LTu#E8mHO z<-_5Q@I~c_-n^BSwsLb!p4r@&d0_cKoQeGWV*AZ)a2S&IEe^DKe0M91nA7~wF8(w& zSbb^gWhm>&)ExhVCjOJaJuF)wa35p;N_!v;svX;kX=xmZmO4Mp~yOvaf_ zme16xsGr_!GDWM;K*8#4lP~SBSr)<_+*}#dKYWKTPfEsA%Sl(P1gv~COH=twPwGf5 z;iwcic+r{2CAj23RZ!5o{@~ix-2M9exK}W$6VN8Yt}q8Q%tw|6sz;;SQJ2Y16YmAz z$M8Qmi8!}hX6G;x(plc_rM~@z21L|>c~W2Bmn-*0OWs`kaI7-g@t`v+ozQFVO;L`N zNpE}&BD6_mZR81=%4^Eh$LYzpRDmjC_alKiRYUBBn^_#p7bgzw8CZ-a$-wm&}=8l^>ZtF|ivX`KWszL35 zos4E8*|51jN_&&xAZIB0(UFrT_t%dr(E(|q(N{a;^oh#hz}~TJokbVS4=k1t)v9k* zTR{mm##ic#>~>KG_PR4tHGO-p2bdS%Cw5~-`kbPTI?^~?S`(DlK5L&2_=97?4u1wE zpn}{$v^2WaTbLWOIfZDPwQ}7!FoxVazUQ^`Rj}zLa#KpSJ1(y{5){KtC4yFmRCdWs zSJ}%z)j2$Tj~jNcWpzQ@)%L^B5w80SJO*uc8>`NrGaCYzECA!eohH{?>Uju)Bf$&B znGWJbL;5L?^2#bxSiAxZe9633dwapgKnB8Ru!c z7&Hf|m!AT^zC0yn9-+A9o8M>U9?yx1Z~ye_^|Bxee^r>{c_7E>n2<~Mz(+%7%O}&b z+#xX8C_A2{t%dd$yr~Qu?_&z~F*cC{@%Bj&c?0;2+rLMu9$Vqz8{rJctXT>@F1@`FI5C!oqndXMyAxsUCA;HH~}Kn-~2#pQ#nJ3cO4cPO#$S-r*0*Q^33UO`0r*uU56t*ggtQwlkrwA~A` zKYeb@|FPE9{`Rt)dECWU)hy?2t!m}YvOf2jqI2KTQsL7T<8KP&JnwQQ#~ltXQYbMa z1sV}UxFQB@uMm%l)RGjgZ%?F1&{UZ9LX8i*jpysG&*D<0A#s3jb9#T$$s$k4YOQ>! zzdIjoi>a$r(I+_B@ZrKk(oqAPsk_}iFP#k9GRqxv3|knj6@;`t<=3v3P%xrD;Z$Pu zSm8<1nsJ_SjT7fzK$fW_mW>k&8TelUZ4bZ7$`^Z9#JrS^Nx$|u3+0;EBII{`T94N2 z_ms?f{D^}8*JI@hx>hxLcO8pMvB9O~MV6v;9y9$h{*|%^t2v1}mp{(8O_x7IDu)>-E(d2p`=v&o}^ zW9*hoXL$SGdB-CmgFC}d7^?3!a!XLGhFgq74`uN;~rL{M@b zQ$S@;5PCX7Bc)42;WDl#H&hkG0u%aPr>}SQOHy=EqqoeB&MgqaQBKpC6kUI{rnoU} z(xvCizCz;PHjV`;;ubh~6YqpO5mS=wzBE9{SI+-i>0aCSl#@NRB4Fv7Ltdq}6Ze!g z7AAkbfH0>AkKFx1dQg!@c-1%%`1v_3vG}%%v7%gCrl?1jDEs+N>*P40JYZNH-9OO; zI8-+)$~yR-w#+LE`TLXitfXD!?+U$9lLXx)s@TSET6Cd0BF*JBJCz@b?mr;SEbpx}XCZ6D1rPC$k#-I1o=Ayu_TBoi zBKV6qLLzENSP;2)6 zk}AOkEXIt6E{oM0vF*I2*`B)_-ibXZEdG@-~vGK~=z*QfGDNXw7 z(~gZz#Dyk3B>&wsyNbI{;=lXBR5t01i_Ch+q-4oXzkk0>j1jJVh)YD)DlVgW@3xTB ze|iD5#Tpn1P~he^OOBG9+t9#2AY+yF(Q<&uKz=vjD%`O{*SqCnPte*Ro?&RBf-orY z+`@jmHB(`Q<`B7JOI_41-$mm(DV!lqEqhvPboPl!n`rT?KmnmrCfn(sN@*iLyXL9O z9m3RVFoKD12)bLDh-?O{b_!O9dj<(gZWCNy%#CGgs+xZXB35HBdE=Q28Y=y6HW#p zbT5+U#nkMxHhg@Is>9=lDWN4+iv(=U;$DQG(20gWa8PqTih??xhgTBVa(FZQcbYBl zm@HzsA%k@&R?Sx}M7>VPRnY-kLj?D9YZmwLIx_XXG$K|*?B5LiqL zlRWuh)vV-6lUEK%GFFG1LubqnL>kK1s62eJL!{~bZL;{=@JGBd#lXi^i0_y@$A&Ev zo2RB@;7DN{ADW9P#ftV0ea-SUBSj(Ot#=d@df)of_4wor%tkkY+M%JRxwkA66=Zd> zUQsao^gBXxA8*yCgo&gE8|`CIQd4BZpOVy!RV%hG8=?EZPS*!fm#=IFMa)R%7TXbw ziS`R_d@7#6wkkLae#gP{YZr9Gpr_FP*I`BVz&+|y@>_(ZeClI5O#yKIU`Gm_4~a#B zvwdT7`(iMmilOY-4mo9L)DQuL zZ70p=lH~V;0y_Y1loZqQdmtW6dnb5CGMZ(Y-u4E*Kl5UEhoB!`8V#V;+lLv}9s9 zHwiJPv9{A@<1Y}2p7{eI)zjbSQ;u4UzKJal`csZ4lh{+_lkNd7md6}E#HC{@4nG)B z@C!qr0s)8OWE3SGVI3m!9$zJ+E>z4fnduaCJ(iMsabTMa94NW>OagJc0`yRJ6V99v zu9DYT`1}jKR83$DK|^Q=cqQtjL#PH8+4LZBpfx5j)+o2$*>NPj2)Zm;%R%By?m*;b z3H+vQSTu#I)_Cg1#E#JllI+gBrwyZszyQFrN8(LRlQ9iCkcq~{=2iWD!7rAyzqWYOVgY< zp-5z5-A=6|5Kfs1(F}hwg zRJYEMjU&_;2z07EhI#B3S{(n$W?XKlB4lpNibi$4FEM8`ts&@|erTb9 z?KJSZ;Z%u0xsW0O3>N(DJVnRelUyLI)wSv=;HL8NY=s{YSKKegsOv-i7`Q4D2<~LS zY-b#Q--rCOX7#@n`FimIKEsu^0q|@x0~+j*c1j1i(0MzxcArV0_7R9WS&VS=TnH^9 z76A+}SO{>m@erD>K=y`Oo!jAx;1oO;y_ObQ31NOJXLK_1Tq&Bj?Y(;($jKZ8oH7!) zLo(Sv2KDsLKHi@Xd7^(3{YU}mDH_QQ`yvqU% z_S3g3r}_v;6H&a0!fy7prz;68lU{qiG+WHZ{>}idViSY_GB=&`P-+he=-PuRVvPHf z5;Zh66`|0}HU%no;JD1OJqOOR4RNC>^}oN9?CrdpYooBqC%?gf#tTAFE50W(1G7IM z_oD+)jNceO#48ye$L>y6vbJR1J1zJlN$vKc0k|TM0-CKVCo)+}2M^bDt8G&*pUzKN zS)>Wk+{g0ieRhLp1PSrKy=jX7n}gzdPE@^-n>QPF04$Uy8F5aPfU+L2cZxj$N;Q)0 zo#A)`GI*c(drRqFERYTpOH%H~TcPqB|KDR8o};S(1XMSwYOqzk7@{IkSM^rYx+a5n z^^GmirvAW~==h83F+34Kni^j50M1mhi#JpXAO79k>-!s-^SZ9Y|Nh(qywlTvFhX(M zSxDCtM-(38Z#@L*k2wH?A%Qh|6kz>1Iyyq~G&L&cnt<3x%kU>5E%}JTMWuE=FO5?T98?%m*0k1o{>{h!U;6J0T;6v56iDQrj1{2i;N+Z zS0F%A<_J(2Apnq@7P`;>!E^xw$s8t~m;M_!J>#HT{+{Q%2ycy2LunAuR9C#AGRi3l zyZ{(Q7I5CG#1dOdJlTG;7H?4~9V&7ZTNW6}hq^kdD)2-PN@{jBp_0XXhe#m8;Q&bE z_cpo*;0U7tky~6j;Fy(_BJQs;(lC0*Zu*Ab04}_8-zJFX0*Q^XQ8^)Su>=Rbxxk)( zkIggkH)yK6cSec+lhfc8DnDP76pcRu%FX3d)^!;-+YaE@{i+uxih_q6Zk6>Her!Ve zcmZ*!5MU#2basYBSmSsAo<%O?K%5rU)eW1Ila@xG2v8b$a1yJNyL5avb64JCaTw%y zbaXVM$a9&6{VY=fynO;dQk|3bud6L5O3O_LQ_HI|iMc|q zGNF@m`U}3+d^v4--m_n78>e|W4%X3Q*JJC;ANYmXCR7eAwz@JEmVRVzj@m`J;CT!z}%Q!OKzAcZU22lm42Cb4?+Q6ai4Z;sz4 zn(LLwV)NEl>sX!(9D!I?y*BtmNW9g>$xYPev5vxDI=6kRX$$OdGVf5=)c^V$vf*}o z8@9nqLuNA~s4j93nZjxuW|l&t;~UMU`$~7yl9H>EOuR>3D`HB5nV8}{M0B4`6DY)& zb26!W(q&#ErNVstoiKgZ}fLg^zMQP)5r^npqpPG>zwDA2A1R zkkC@Id+;)7eW%!^d0sK=uKB#%9M6ERq)9?Ub4c>kWV~WQqk659!=tzFr2kRxdF4cu z`z56&Kx{$?U>~Fmaz5;)Mrct(YVKX$-{}#mVYr3HS;-J+YMLg6*$wAA)u~^a9iW3Z z_Q^bpo9eMmY@5B8&dl?_xQMyEc5l`v=Mk`Ypfq-U;Nx6~L(^$6bxUDrq#XWHnQeGz zGVF}!cywC(GgOJ5aX%-cLVB@g)b-*@Eb;6XbytGs*m{NbGNyKnb)Z*ag@Ti-9sj{; zvp_N`oX#0ts9p7Ln;c!(x@?Bo@T(0u;)KuBZ?h>hQoe{b_IYKapeTzPVfNI}B!8jF z`1_1(3{B?cHr2M$HZmeiyXivVGMd_V0^}Qf@U0jdp6%q!urzp8B#up^6RiD~FV~>iP`1ZMIOgAlVgSy5~K_ADqLC_wJprK&5ga?1sXfBAR zw%mL2ErMJO2RqM}PBELhLPw(((NpdVpGo|+y<2WUJXZ+e*PnJv1VX*&p4z%l?p176 z%{OZG2K&6^8xTwER&chTO4qTWohN)-li!*1!+b%vPX2)ec@AQuoFTM9Ezpz|8W}KX zaHzIFsNbVlTm^n^y&sk}3&qBnjO=uDWBuh;;*=K;# zN82i?W&ohcWUM41SiHO<-_m&-Ya`Lb{w1QZ3&~UXfCxlI;ki;9#D*)<@|L2R-azw} zj`(JQxn@Ko6IRgqYE zg@}*Be^ypPKNjL#o@{$Sk--G6)Fk$O^q3N95vP;)UcDR3&NO~|yPO_O zu_`me5KN}2cbD*asIXI>3LB@64Tsi)@!=_**GNB_5Z?Xd{-Y?F3GY~@h7;=HBZg^+ zd7^LijvZ=@#0TF_zz5>C)yRmw>#|^UQIvq@KDJm6gCCyR+nSYAMI+m|(2}jd}ZA&zElvHujKCHgR&NtR3 z>{Y$@=Az{`_EZ0^?|4Yr{eptK#m&^=oW`!PycOY;9w%Ib^7_t+O;w{7PowfYdiePY z`wQ(}BD%jm4ZLVnwe|Bv$)nxk|;4`~4#dz7Xme_v$>}pi&7> z$4{#e*_}SN%YwFD|x))e~jAL}!Ul=^pw0M7$lr!Pk>mspU z@_w%(r50LPi5P6%yEWbqw5iHf3P`vz>0a4Sn{`|UMT9=_l$c!=xtfHsJRx$oZ)nk> zegNKSyf37)0?vOTvX)%%x^G6zK-t{PtkkRBOV!@9*M_OgD~gEeQoiaAan5}Bc~3nb znev~i{U6*TED}Yn>E9zifcrJ;ANhqHLhrbpH7_W`g)^ri772CH4?^Y<;2{>uFb$HH&JxoRsE+sj>HxGD)x9LqX0M#|vtJ_8|Etl$?H3fve8qk`op!`d3wL^Y z;o(gErIlu*661U>`sATQ2KH@tDY`X+h2QRCWd-r@L>Y! zloZnx1V?{5mK2oT1`+(he1y*qGm-v@ZOv}*Q(IxFTA(N|ziPs+eMV%;00f;pAKG@w zMLEo@aVEYr3-ovYG*Ngc()*(H#8NS`J1sQ!dM}GIK`W+PleyV?3gh&l`#=X7j6;tE z>I*_Kd3DQ#o+z>P7?;!7{@h-F>t8cuE$wZ@r{*IG>=*6*Ny%%ugr8P|D%LgBGlcCH zj+D*0j?M`#HXZw+*E)LgZCYL1112J$#<_@T{6l&lSxJ}3XXReI+Y~pm$EqJ~x??Uu+2Y4xO+t31#$Vm!iy8tU ztv^npZ)G;5yFi4OfX=820lrn?A$k zuUS2N#Po{S2c13G#NGSsa7k)->qzvfDQSsiL%Z{e3UcEo7r%H*e{)o6{bIoDomyta zJkkX5$1?9O@bL@GI*3G46cbhJ*pcE9_DKiHbXddVB@?~(mJ7?Tz0Na*cF%Up;bvwU z)rR5LYbqJ>eUs(z5*6r3PBUmM$5}*b)K^MzHm7=nr+*4fn=XGj5l?-78TFk5$?|HK z&*3qRVs9y06oJq<8IAv$xq>Ys=gQj~cP!f=y%3s-T*~J?0=?8UaIM*pU1ggQU* zI;Eg}pjNHNpIxI1B>r*ws_q4BCu$)X7IP<%UE!odoO0+OmZv`7uFWN%Ii92lCwZjI zF9=B*#H!eq(jnwr_ySTzE>bDGiQh`)GR=9pni#~`lJE>VtmDwy2leG=L1gBCpna}?r{HWXYWSyBmr$8PPq7 z99SVtE>^q3NMr@88+SM|p;k*0$s3d@^7-?&vP9R(#a>Wz*j9Muq&dsF8f*tT7q1^O zG(eM-h7jKQ=_Q^(!Nth`ZO7nIc>T}(PlK~lf0W^KCi?MmWT>AVKYw0TeJ$al>0176 z1!wX;!6C4huZk?<$;;c6Le!tf%ZS#U7)#vKFIj>|MiCcLJ!X1Ih#5UYk=XUC=lgWI z1O^-#X}-L5m^)4UGS?wLhnxAELOh>UyhB}v`1gm>nwFgJY<_8kO(s~3ptjHQhP`;E z6e}x6(p3c8n^)tVx4ASdhSNf|UwTZ;riq`Ap1~{3n({8U!%Fw)UA}Ge9HXis@Mm?o zE~FyP93G4#ctVq>6z)H9Z#B<)C?ot=kMrLLJsaEBVINj-@3k7JsyrUi zVy01fyjVGs-r@c+>FE=<%q0ZIAjUoLo({Dpq%xa%WQnW|2|lMBkeK?e-@wNp{0(uA zDC*p^7tZL}&ubK_`fR<{+O7q;((`jiL@j8TdeAa2kzRfvBV+99h*^ATvt%|=sG0)t zL>W|H+{UTrh*?Xr)#Ef<;2YbOpgj4t`F!-c2ca+vEd!0{$Gj!|x(e{}fB4g;zgMxe z!^k3)QiN@=WQF6;p6%KDq#>n4R&eBmaOIUJKl^vCs~+nZV6;(<$?Gu82Qc-3$-B1S z9o;Yb6wL*m|LRtn`_=7sQqE#48OmJWrx?S;{Mw&7>+Q#f{VX%yh>c76VQuFLwwZ!) zD0Kn|@XjN4z*e4+js8>gTC>#XGAt&%B=%Xm`%|+^ouSoIYVp&WpbBM=D#aroVJ|W5 zl7hyM7>|olFVGjQ_?^04aD+D_0#FmK;@5}*>zKz$VCb3dkmoqTT|Ujb=IG*X zIVR|gMSp-xbC{@%KptB!hgJ`UiL;K;36$48T;>wb^ooVbPFi&d=B#c zH`TrW_5wf?^$&SWAV}yf{(lbl-Ub!ON(Z-%mA53jxNGWMAx z73ERW8wChw!cH~=Kte*pK(MJt?j)-#@Np;-tDO>VWZdDXDIg*l&7Ix%EVRkTjK0z@ z`rady(4Q32pv|jaU@&VF(jqdwa>nZHu)$H-I$9{5p!l0umUeITee(Oj^Oc&~>zeRs zsUrd*bVvD2r6T4F=gZA!4UTJ}t37)lM`yK&EMb2Kvb@cX-^ocj%Y)^};Uv$xzT~jw zB9R!5I&1q!`D~&{6}UwIzL`Nk!oGEyX0l8^Y6dPs$e+g4o5Zc_uftZ`QQ75eqJgls zJDb_1VNS^FpxJK<&A=ncj72FWV=Gb}L;(5>%AKs5=U&!ahnjND(o81SPVUAy)GdZr zDP0t=L{0ksj0{vWj~=gc$Z24bE#6Gdi;(oXlC|4g5?H4|+=J4Qo{A}oUW-EG!pDDT zh5*TC_yZ>hm}_x&cx`Y>!*81BkHmpQ{JG`XVLhGX)MGM({JGeyHT73DJrzk#qiVXTh|!L$VUGts*G(hIn?y~ zEM8Wr^s)WH$Zb$No`IiP`kSGS$UU?&Dc_%J+=OO#1q*~_KEVAPFX>z3>o zL6xM4=ix9{+{`s}<3>X4q6GbMG@%I3chks%Pwv@{7Qdr`FM&EWX_kb$dUCj6n1E-e z;yB)|t{w54PT~{?PtKIz&$^8y5RQM!uX&&zr1W#z>(lz%T#uEwYw4GTW90fxg%gU{yc2;6dE;RU{=yjRz6+x6c4~um+jsB1LnP@CVl&u6d&Mu` z5~TLHnp~Dwv~c!sY7JN}f#-J}`Y-9UF*c$y5saanBHFrF{nw}O-B;F46k)YqW+P9h z%&EaeoCCT?=1Uy%F6q%@48diSJbH7*Ktsy((AQ*-tv>Y4^Vxnlc+kbDlr#4fOXcG9 z_bdHKVYk5WDY@9&W%t*BUI%@{%3`Y;VV=K+qL87OHWHXfRi`}=gq1(D!& zEy{7@w)S`tU;I1Wk-bRz-hLC_)7_WFZdt;}>e(Nd`(%AqKO&C8*857I>iSVVjJB+! z*`pLnV634O5D0Nt0VnpIt(Fa!n<+YMM|F;>>L%_Wc8}vpG&~)k;MK5qglCqXd6sIg zS6Z4SLy?pr>5V{!aw`Ta&jXJOv6OA+UG_B1L8h-9aP_+%Nq0wuKMT7U;ACnL|JVI?8 zT2O7*i`El%*A{4pWKG>;Ik>Rq?dq?s8*?BiUjx`@0JuL{mEGM;y7S$j* zCmd6=9v)vy<5$TUPLFf8DqvfvN{3G(N>Rp=gKe{QWg?hOAt?*Vw5_p8Or`Q^ZLRyZ z$i^`3=N-;RMXhUgEEOdT51WQxa|SX2cAu}Idp3lsDDPCw>DSbrdt$9#%9HLF9uI{! z=^rmG)vn3@aF5~iR%#jnXV;W-+^%`wvOd&k5yTl9iYxu)>I)%jjXLu>R@#wQ6uQfKeI z{?&WReEh|d9^n(J@K+Y>s`tJyuLMqNdarKh6CM}?(G^mPSv$V~1bMY}T^>+tYJrv` zxdB?N&e%)#n+4JCZ9}hfH@Cs6TpAG&Agi?36)9E#Ntq~k(I98^`Q* zHu%#eU`CZI#==59Ux;;k$|iXShD;a3lFa;+_I*`L(wP1j8P&oW>ri=^V)NjO~q2627 zJVsqQalh)RYJ0s;H)^?{ad&2gy3SjB_$!!}TJ;ErRor)9*>PHHWo~_K4Vx+#jOdOo zu|4POSJHjNabT24hPzc4uLwm=qHV5sQ-7Ls?5)6#;l~3!<}H=vn%k8tY#Qj&i!G&x z&?n+$7ds!}2-n*2C*N>>4Kg?^d>fRw4%^@41jnHK_3T!**+PVImprw~`1N-6TzwEr z;g|;c((iPhmv}$(3lxeR-hk5cE3BYrofX%)lRGVRT|T=W-ji0yb%~dt6W=w}GT8a; zqCePo1fNU@i|adZ6mcAhGpG4piXQJ(UVSDxt;f$f449FUD=V(Y71vw)%Fkn1|_%W_g563cHJ@xo7LPVrXCe{ zr{a)B@XyO7BKi`K%U`R*Dp6h@CK9y)bd9xjHzIz3!7w2?WSz#lJ9~<2T15_2Xq!CtF1Uemd78?fl1cARLVUVUjmL1`6jDxUP=HYu3>yK_@NM)}5seSEVP~q}3k3pxL5TVuISt$tF=eNDE?tSoi{LGaMj#t0oxIPVZ+?e$&b4>K% zkN)xci!Ku40vTaigPuiSOz76cd+yMCFeM|779T_qwgh;L#8Pd|`dfb2 zuY%6o^Yu&YmwlZzN|>c@5Ey;Wx#4~{q;34xX@4epT}WW7^&3NQ5DjdozDE7w$vf8Z z%;3=5uQwRs7^j^(%(#RwEBK1%nQH&TvXY=L9jkZ_)QHB`F`72Qqmj0ymZ}8)&M%}F z-VF;Q`K2+)e$NdGKn0S*;G=6SS=&=Z=@F=TH1BhdbKbYNb^0kzi!gfGxMfd4MBw!m z-o2TyDmn=b<@wECZDlKT9?LCTd)2LKH;#bWRj@kRQ*Q^imHr}?YZ=#;I)cUM;`Nf z?x$qPam-aEJQ{JUdpu3_Lb^HB%d@azciZTIz&{V=pCxj1Vd}mV4l}h5{$(RfWE0cB zZMGf%a%h6Xir3vAokE{EC5*%=AJTvl1$fP;fbHx=nzhde>{073p2qT#G+cw&ZcA$( zSFTdu<-KtYoXj~sB|vcpA2?4tZ3fS{;XIE>fn> z-a8NYiV9aWy+8VO+JnRW1CPcHOVWl%&E~=g_GZJ5e%CI{q~VR|BDK~t{@Ku#n2Tc0 zAG+w0A8yMIGX$*592RpQs=P!=)|N3Hgh`RklV&t!J~~rVv>fN?dls)3AL@(zVE{ju zWer18@GUHI#JV9AY%b|2=nRW339pD02!>EzD%LW>J(LG|gi8 zYZN7lLcw$yF4LG@b$ARCA-Gjtj@13 zoL_><9LL$Ly-P!F=Ye_#AL^Y(Uok?0f@lCrJ`xOGf}0zSC7tR+i`?7zp_T^nd|T3~ zzYfN$kKq(8>xoAb=dtC7^4})_iQWbsHwcs9xcm+gE4#)+^^d-Ec4VGjyzG{9^H#@-#DZ zbh1BaM90!^MZIBmnn!wb7Not2oyBWWAsqov5w8UJ?4l7+&3jO#LY=b(YNTHNia#T~ znK3;oPq%{C=}Tc1r3QMJ{~ZpuI6AYQQvCD1B);#BA3jfzGbPQqyyDf-IX)MiW|Q^tY?`kh&H zE93{BrK{pA&dMLdoO&H60<58*Lw(2Zi>yibTQ>T4a3hO@wO45DK0ktc@71Hz!XxC#TG46p~;@i)-ZB6+>srUZsq;CF|hX50hrI*6z{Y($kJK zb-q-L1FhV0k7PRv^hyNs5v6BekG`MZK-WuGFlvD#;bcDyTmPk9{GGD9};H(zhEZ+g1r56A3e^~-LE^i$qb zEl#xwz`8?HbjaCE-l3s3$4o}EsHfONv949`=v8~3L}S#ITff6&wCmUEj1f4tPVH%^YxS&IVde$B!NP}>H5k`(?kRtqZY`-FU`Rz`F8tjn;HS486JB>j{ zvjG8pa}uF;iq0OgH_l6FH}6>ey)-&x*!S%I>vC@aohz zx4PLcoX-n%>)v`K829?JS!z{3J*pSr(;FyuY(dHM(?I1}kve{uTQqJ4g(N3)uqzV} z`uSU@uI;Gz+fLP_cd*W8_68|GYpLfC;mv+CvG~)3 zy0lP6gd-uLv@$1Z8d3&p|N8K7a4be#gfiVtFeL2;>kyS z|H>1aMW$75f}qB?!i984a3w=O#(ts;H#~yC65uYyg!j@#{-FCi z6+PE;;v0h!$JbNwnGl%H=s4gBLxQ7q=kXktL?We5dAd_@6-@htO8&RHcz zgZR;hf&Zj?H4Z8Y))uo~0ZwaKSh|UQ|L|C22zaxb*Tb-GFYx5Q7xexWPIa+NR1Fwd z3>_?Y4+HU_nHWY|3-Clm;LSytK|rUJZxGR zCJbMl@4|pMO+;it?dIZg#gegj7sYU1Uu7EgN9lXqRU{HJp?!&+3t$@e<8auUNI^ye=)m}sMVE! z`l-pd@Z8v3RT19U#GM!8_x_F1`@HeFxm^wEP*sbtuUTlc$>jII5*) zA3xM(aR<=iN!2ffD>%FSclQ56booF06VWY1T)77Z7QMm$hcOqj(d03 z_%1a-dIPeiqD%nT7NK(J;S>S9FkC(DZTIGyT5T@&JL>`SCiZ>aRFfn(wz{m2mC}|HTsf|Mh^a{oPXo26YK>eisvy?u<6Y& zw9t%2TyEP80}Z@z_{DYEF@vqMvc!V7lM85livmxYHmvv?F5QdIPb8n-CUzofx!p@k z|8VZ2kqn2FNbBlLNKZ%R^Vh6D30{BcD*Qr>OGHAOOmydN=`P+x)lT}cH*|Bhwx;O3 zfgm6tf=3zVwL9w}p9oS$l}#Vct{=}L5$u3F%5-Y*cFt?V4kGn>*OJSpbgOh?w76T8 zclCX3S55u*p5xy2p(VQe^$ij39pE4T{|C;TcRZPGEWSbZ_B+ME%2m9j=A+DtG{UZX zV~@GDyL13<+#bLyyP2|nmyRx9Pu{uG3;}Y(iUIhwqVa68IVQ)>(BV> zKXX{`<^Xt*g=`z}(PAcHkbBj!i$Wj(W47k+_(K5T`L({1{gr>ddRZo0MXDQ8$D_bX z#%tR`mn9yNMgo|^m?$eLD{rsm{_z67jHVbZA8yqhm2B+){rdr*ZF?u}eel7sN;{Bd zTOl(A(3V!dwty2Lm;F+Q%4x=<@AwqP>XB3ApCb+c6Ta{p-1ranOy-A#d{+a5G^)*w z4b}p{xJ|;l%GP3oIinjH_}qK5h>vXukaJNVCQurAn@?=;DE0dJoF{31`{bmosQ0Z8iVVpa5kQ9o!i z-!pv66Ue8nq-!_U0^)6!cdvGKZ}O(q;jnrDo9A*^krM<|Ht7%;7(l!E`zH(AZ|>aS zl#@<~m%{jqhj@3y^j7JJD830nG`}(ayCXLcf>+$>0%#gKfr;ydsxGwR0^n_b5m50V zKJ>55ec+#YaYF~=i=nko3~4F80q&StR%cXpEyPJil3mlb&G^nv&0O4}PWjn);2@2g-$^h@DqttS_dkx< zzj#nUXA7h)cT~YKY;KFe{7ZmNBaG9atpf=7VFlV@(Rd^b9e`RD@NEOMHC=bgfav5H zfc#gphMyYO0CRyMu!M*LrcXH_LyPSu4t0OAT~<*sLd&-4UbN0fR~(%^v-X<^Aagwf zTcE8}>bR}|M7CD;Hsux8cEO)J;nWgk`U0cIzEdJrjX#ho^{+1Z|M~(}bOTj3x;20? zwxDZ%c1A@JgY9XTf{zXrrCXZDPv~F zAO<5(c-Pg9{*^@T8hCLXXWHUzh;aadIJ*ZTpP_Emy<$KmBGEga-iW=WME#o63 zVncOp@LL*~Z|sE;=zw?7oF+lL?x*Frp2mu1#Myh1fW_zBCXk4;+Tfu9HJ08DEdz0@ zRIP=YO6LgSQ~$bN8_P8sWlb$()kPLX#9>Kze?@D~>g%^Xq`mohB$pgfJPerLEmJRt zuAef-eeSAb1>O)FxOOixSAJ$WKs29M=$@0hQG5^QlV|igqN{z0AX5&tB27em{x1bx zU6Ycuu&VXSt?bI|smYWSyg)#)?6-UTqYrBf!D%otkg zEW7=O@|s!b=arIfo8Hmt0#)_B3_ zAv$uCJS{| z`|gG2WYzdEpFJ#|S025_kv<3!VIQW`>^3~hT|8A6SxYZT@lRe{>|S|fnZ9jRYj%N_ z5b(G-TtQeYPq}MUpKwg>Bxa`4xRi!Q4Vto8{J%yZnrCAt7P70 zsBnLf0^Si%u8hU3LBUQl7bW0a@UZUx$Ju+wHPyB0{*Mh*9z;b!q=}%YGz9@^K}0~h zg7hXGr1zEtl`c(sCm_9s-iso=3ZaHxLk|!_APLED^Uln9&zv(ezUTKZA8~K?UTf{O zuKRmm*9KK^$3Vyv=fNx~OmJUo&n3n%>x+$PRfY!z^u{U!YcC{(4JQ$pDVN;BPU~E) zP3w`+)`SfKQZ!chu%c$zyO?G@>aT(DQF>P)Ye~!0Wy$^O2h3s*wk{I8UT;E|9CW|c zU4M~S_njqNV^a=l|0$>1ck_ZB4V*#1C_#M%ttQ<;!`FI1nIuMLcA+2$t-V#=GQDQ8 z`+ARO=!+oD(usTKYBA3k@Boh5FOPV8~Ph-Z+oX9T8J5opZYMQlTm>w{;;*XFLDgX-3LMTtQ_IIRCW9IBU?uAiK0hcB|y~yx&F^q+S#4k!GfD zSMe8o#JO5m4s!a?_!L=up+;$ObSt^Bpx&^-eYfOUX|*?(nC27_Db0A^W{ntt?v0XTQo8(LwZu9`P)MV*26SKo7W@niKEAUsGkwbl z%$*FH5ggdgApwk-3ARq+aK=|`f^+G$;}HI8OM~5j(k$PjTF)LPkq^h|nx&(N;wgAf zOtH=9f-iPx^-*(|YnZFiqCfSe=lNL|U+L^E(oEb^>R7%vOAyroQ6{z+>YWxYckDFW zv(i`+MdcYz>3^o~eWvZh0Rv4t|DPEOcswmHL|7GEk!WxU+VJ&uk+`i46xcSP(Kyg-I&!}YWd{IKB5RneH`3HeqR?zCDc4Lx_(*~ zI(V8Jn!ZM;cN%F}P{lV;+o&n#&`{A0zA@}7Y&n;mkNhFIg?_0VaKe)GOz{xGA>X{_ zQK(w4up=y*V_wspx6@AtWwSN_sYqODg^+&Gebjsnd20VL^bU`OM54_ui~w76KxSvu z++!?E*g~$!U`yVSo)^eZd~tY!ez-#r^_b8s;-eO7HLDto{0}bx1RuXVrIUHrAkx>8 z(I*96MfzA0t^ID}JG#2=dMLpbXtD219>~$HQ7Kx$ew(+sa!qgiNLQSiOQaCw_EhtF z@5*%H=WBJBbZTrrH#-E}ttppFX@u$faOY-Cj1RpHbbB&~dviZjs5)^3Y;vEPZB7>= zG1xGR;@td6pTd&{Xp1ph;Yb;?7 z%`dGDtraoO)El4HBGgBPrsZ!bu^SckOVN5W#6y8p zyu|92c7YRE@Wm>{rPUuow+r)i-G>%u;2TsHx-k6-;;^d? z;RCJ_%_*QSt9PQ6Jf`dtIfl@4ef2ylw9L;Bt%-NsyVk*$NOUi=9aa*=HB2N?At|QUps2SC(d3d=Gj~Jd2J3=dq(pe{=#N+fDB=xvvc1L zK(H!+yP^*d5Oz3DErNR5BrMh8x1Q|y4tgW*zj^`DK%^Ns3mo}4pY57Ue=97S{>#6j za#7TlQ_R>x?1m>`q-+ixsi%98gXXz2T9g;NN4X#La4Nz;kguJuQV>Tw8bH(i>x~Jx z(eR!{eJmfi};tf&7+(OkO|>;#c4T?UCRW_6lGW-=+@m5yKrHJvr-n z-v+oLnP0%k6So35`tzI()2=WEc1kA4m&0#0OZ6WEmeE{iKcx{_xh?`6e?tS?Y+e}l zRco=?FY!GD`Yz8-=ePSl(pv*x^!gM*Xx|6qMl8La5w6$6t#mbBeL#YMn*+*^vFiBrOrfrG+;*X zc5`!6;p`_G8XCaY5pN(GNb?0V6R9{G1G>B~7bf*V?glUwm}T4Eo;yZ4*tq!Z9Zl~>sir&sTst1k zeRP3XeFu9phR){Wbg52Cj?eXD8OU0bMfCg%@sP<#Y~AN5Kg+`Fu9o4OEKsI?vSmL4 zBd+LLE-j%Mn02=n`&}gOWRpDG+L$vy-9~P~vYbph8I6pDc&3~P#=WI6akFL~6TF{R zG~y4=P5+hg>a^so1TxSzBDglG{Jt{vO+zh`(0 zrXMM;Di_q0N7~~OS&dayfE!B4e|$jp88WTt`Y}9`W8;t#+0-;5g+UzE;?>k?VAP zoDWwJAdBhsc`GtIh2Suf#qpZ-ZvK zk03OaM$Qk0L;Yz^Cg&4HrN|5!uu=yKJE24|Q}yGq1p1zHzi4=Z<6boRdi8Uh9RGT) zE0HHJkY`?8@_Yd8bL@wXPp=X13Lc9|O};Vyy8i|*h<=?gEoAxhZT`b88*3xWmX|@# zLVm;M(vK>T=qILKyKx*fo@=b<4O3s}$%5C{HFp4o5u?YIP2I26nTCJES`H0U9>}KN z3&rmboN}n3EKg-IPZy)7lxe|+7%*R-AWD<(nVOs~9PT#||M+Wv;z@&TA+&mhf{lEA zk9cg&Z*jOUqt4@q{qk0He8)>cThkZ>l0?oP7P_h z^XA(ku#z>ww_)p4hLHlD6g2(~#mswJ)0d`QP|7jpXl3qtsTY9!bh6B9n7~d$el66R z%u{X5J@yEznGKq5c#mj;62C(?Yw#k`u=rYWezpA;6DKRt8e=PHR`JATnGYt*uT7;M zg=TE6HnSXpXUzjN9QK!{@R0_~iuTtJhM=k>Xay6{tz+fZqC`qUc{z*cO|t^7bKyjGBV#*!Lp8AC7L_HcEbLf47{>+KjdO!ZR-$%o&8*h| z{4n}4Je;dust!=uy%tDUoEP@g-3+E5GbDWMH}beUQN^1QG+IjNbBlDXzwAML>Mr8@ z=9k0BGikd03^e98q<8B3C*BG7(gx5qaf=ZN3)|I>&cJw79rV;W={S#5p@pF@WrK#a zW_@xjZ)p>t3qKOL$Qr|`@;+aB$4j!Cc#n@WUq?q3!Qbp^{gZs%$50CTGhnkSxC0N~ zj7fSAL5`Yo@;J0@-79afNE63x|9T*Nd5WnSJvYBapeNfFdl|?Y9oBq;mB=C7Gg=Xx zdr{u&t>L-dfnLbmg*z9bY50M9t^PV}fj;$2)-1U?w7Tu)<)m`To@2BK{ z{!=?|qt*97bE?Fb{!A`!dcy>GX3jVOHnAE9=~XfHjJp><8+?5ky5W^@&}<+&U0@m) z#^TmA`w|jmD*Uqb*~d|R6b5{wS0cjI-gV|W4>OVj;2K^Dp zSEI!zwX#N!+$M0DAyMG=A>+R=*FOI8v|?$wpXRy$opggS^jWW`?}2A%M8e@J_XHsc8K3TN<~FUyQwn4<@HxX<&kTOlxJb4b=_Fw$Hv& zN8ToTor~ZRVuX3^`u5nXdtNB{zDi--oA{;WtP1q1pcD+VO9vAM6_AW zzWBjHwH?JKHG4FULsiQMn@f| z)S6@BH`$&B2%iK`590lDfg|RZCpXDl@QBL3n)GX;>+B^2^;Z!+y{OsKA7}k;kB)I_vRt#ji~7*tw&uDx<%sbhOay? z(vt;5bY!T&N%f>WD0^?P)p+P|yL3l>E5pE(Jpd#RCQ7&K+R@IcC!`}wbNp#4cnqSS zt{9?0VsdrY8BO}J=UMX;oH~h}#4bT6w&Ry~nI4rYg76@QGs9|Gxn}~m2&oaibMznMm>uHTK$2cf>lvX`bZ~yB#`Wo@0y#`*odFGR zYTi!AN%R93Y`xu-2P~>V$GI4*jAve^NokjA2BFPdLM@_)Vpg{vlmB`-zXFnF*_Zfzm(Q?x%aO3^ot#tFsch*>uN=B)f&ip+qdHf7oROBgtv}TqA3$K1w$zzcow-OlZZ}M2kF862{b*O>L#Q42h%M9Wk0rt z{!4;*8m)eYInE}yaU@>93#9-UnC{uJYCq=jL1Qz`l;KZKjt;OnCutQ=jYL$ZKeL;J zjjDQzA0<`Og%6T7Hn6w$8C52>zxs=&Ei&YCtg=_Ygb!9Ye z4sLQ{p15)Azc4U7>C1{Y+AL5-|E!pA=~{27Q5`vX-y1|Mlt}eIv`>-2pzd=s; zF$*3OO%ua9+0Q(moxba{?!%g)I;H*2$3i+%pHb@)dim4AWl_VRyaytitae#PBBi>` zZyz?#xWne{YNf_e3|#F2Kc0Cly_VUkCglUIrC9cQByoG+>#Dgs>!S*N2jN@Q(9I<8 zev<`#)^VK6$y|cO6-c6KSBIVB4mPI7e)h@fc&L1-=HX-!Zg(7&M0e6Uq#~0g= z{p3Z>p@Zkw*d$C4n;oix-CiZU-wnO6SCk*|NcbF862$I~TaI$F28Btz9?)x^^e2d( zI?|E9MWEMU<96s1t8}Us!i>4~N2-U%fd((0sb+LRX7R7@`i;SBb|6p3awG~Ee+CX+ zk$=T6+e9uZ)cn?dFhfPQd6JXf;DI*XvEK@(Q#hiL*`!~x`vh+fL#MLOO%%_Ks)nj# zY@1>-X(rnuT#)pPju||QA4tEHG_KcDX>H;JspVQxiQf%r;S(E><$C(v@@+L$gNDPh zNggAvj=wP+PUfe7&1=li+ahwSs7@nnaTA?V4e8QBgqI}Jhn>7jWsz`wJ&;|_L`zNP zwe1SJ&Om}0*ip6v`4jTSj-U7U=M#0`CTWUmOpgFzz)I}{S30L^dhyOXBWHDHb)Ygm z?pve74ODw4e0gU|^4(e>e!l#Ar7`6zai9SE-%ua_p=oV9UpzyI7Hv9VQ2a)8izI-B9mVy}6XtNb z5CtbdhI9tpDSLne_E;g<_jG9X%!%rZ2dVAFzzM5dzEg*Nib=a*7GL7NGf@7n!kwj`SiVW&1>)EMIi5OD|lk-kLu+#_xsc{6}WDH}MWRZ@m! ze*RhO)06vvtg?0ngr7}L51SpX@JR84Hw+TqRZwq8X4COf=m8Mc*{z{vU>+IY8iMy@ zCB97eC3!JC{qTv@-t*WQP*|tY-!UPbKy`iE;Z>!R*MQ)}y0A&MQOWn+eZe%a+FlHd zXvSq3M9nz<#Lng>=%_r>9M)!bAx8Ci#X0;+jOta!0&wp>5i>M@Hzt!2pe^P1Ioa`9e@ zAB1oe2Rq%i#3Syf`1+Z^n~z53FG~*eDkt&FoCUJNNQZd?&s*7gC(>9Pf1Gn3mgzwU zd#6n=cWdRJMZT3N0c4WX!7Li81+ZS{{sD^p8+(y4Kf`qMUl1_2tB(TiX1KpN&?J2aT{pP_#WW6Ygi_-E_*x+gq$}0?j1-G9*Wta z1*aTRs*{nbS1l;!Q9a#J?5lt@I6D8uwuX8Dr^7u848>!{8^NmAN#QT$1po8|_kKS7 zLBZw>P=bnHUK>MbFqtr4JMdC{JP*i=(~IZPdkARLk#@Y^-hJ$_n_%E|Q}qJ44Ptci z-ik0yo+^yjpusf?h?{*&LBldL((c~8R-{fzeb)^30kF|a=Gn6htb%1Qh zV5+bfNUj_2UCPq zWh0oTp0vI{-^v>N*4}1y!HXOyL*ej^a^bgY+4L&F}!eGa4)Bq z1qSCN=%NDP?08hps`($QCa`AxcSzm22f*-b(*oB#02Zd;RDea|2ZVI>X~5{#Uv2?3^MIC9rHWcai1I}A zozOaI)rcfR+Lzz|0Yf$b25u!gMx{cz?f#RfTW4U|jWe)J z@;vLi(MIh=xozih`+np6smfVD==2@&t>Vg> zypyuqz#Y2ZyWT2Q$9yj^-*7D#qU^$1u?v7tEA^c^ZdU+6RIhOm^TTEzTs&YZJ2??`@c1VcZ{3fP<~@K& z%eVT!bmBCHk!G=0@(oT-IXXg3+vP{1_9YK%iC_A+L`-jWb4jPt@txa zxW);X4?oVImNX}dd6e!s{&avkI3BJKI|Ek8XXO}it_a``w_l$vnVcWP93T8??Qn;l zw>!O-;WNaEQGkfTfg+VN;Lbc9I9I4qw5{&Z?2WCMXEMW-@+_+Ri3{1!SQ%;bqNyvc zOjO%UM0ZR+UnzH9RmcQEUCMwZBAZ0$S+G$$EmE3~gsuaVv&`kJW|CGUVK$4`ILO)> zqPN!U>QzG>pg30H7*v5M<=1G9_s`iIyF8f-OelA5;Cmbj;6n_W%%i=B1v)WaiR*4& zyaR)ReqdKjo15~$CRnWq6V6z)+FIJzvCDg0t`YK_EddRp%U?S43mQI`5QxBhgAdvjfF^zUJe*(^lew!Jh^E73s zq%PNTM|x_MV*eK#MgY^Olbk}lKg_2^m~x=c1DUUm*eF?E7w0JnEzVK2bg@z|ZI&{f zC@hfB8tpa1-Y(CW*S>fAsV7XWmu};YKr14Q6~71lhV?*9602m41iyJv<=XMST`7K* zMuu;-7Hg<&SOl2V^mNcWARZ1Ps=pILBWg>g-lp-p9Po)3nGM6z2- zpYB%X6nwrEI;Rm~sA$90PD1FBl&4iW(^9psK%A$|oaO=xvY)FYl=2QsJ%DGKKhji~ z(`uHv%BTCha$vGg5U3>)b35mr+5FP981dw1RWnLcHDqPR%b1FmN_65y)7YQrwJZG` z70R27PesX)b>8{HK46Z8CEva|IeS%#@%_VOd!qB)`=26wj?fdy`M8L5BvPWEB1|4Sn}+a!%8Cr8+GiG1S*d>zo=d1G~2K z*L17OVCpccq~N@b>aIjHjv<|7!Y1B&c$JH;$5KV|p;7ii>Ll7{K@R^)gNzxoyJcm& z_^QvWW3(;;7x}s!h!_={*wl;#h>ZG5*BL!z<&<7so{JiqmBX?V)$Fl z2Le&!Q5!E@BuWh$Ukys|)!Hk5wHRtAjn*0UD)LE2WqawAj$8#au8pbTk^+znc&>u# zz*(roKuv;g{2*A=UEykyNJl-r~8}1NZJXw<~ zCw_6af0wV3PMMEQ(LuToX$W~bQQYT9jL6Q1E8f{ZJ@9F*HQLS?+7RZ z-k6NN{RwF~5Riek`*4Mny~VLHl^Oc&SNNA zw;crOEOOonM={zMY)Ez~i90gG%2bKV$^h$MA~!9IcyAb)*MFj#3K_U`-xbCM|W%@t4#H$G>c-UYNV- z8bdzn#Pf^nD~^W2BfJE*R!2mOgVRx1foZR_(HepNLN%Xk4b9DVL?E}W_$+evPVH|l zD^sH4=}&ui)`^wpTrPZy8E*!)FweqcyoL>@)eR994I`q@r$$P^yG#b~`H7hIwGKB| zjaXHCw-)fp`A`YiV)+W>!8{^725*HkU2CU{j#FH=_ev{3VFaHwbFWhkaukVirLHpu zrP659*NkdIASGu9J0Nnh-o&Ya_C|h5Nwwcze|NmKW-YvW*h>72L1J%r93<^J~60zDlH3oF}xT zqJkssU^IrlcVhg3o5yc{=DJc1iC&v}@ChDY1*+a?F`;5^-;(Ej?Ty{$tequEH*z1j zE?&~=?v3lqZfa681$rPORx6C9n_V}x*;0hY6j6hlVX_laY4&gDL#9sI;+?|-esfd% z?)%Bzg{N14voP1R_`6?=Yvz>LF)G8s-I`ibMknMMyZnHpqvkbrK;c*`$-JxoRA`TiCBc^ z5zuy>f~19nM=mhhvT#MuFZMb*&a2k#7leCVuF2IJHfV{icYSEy|2G)uf0u=^zErP?lTb?RZu<+gcsj9$vIe#oV6 zg8Z%odcKMDlEdXA0oj@d2-ply%)^#@q60dO#RiS<8eBKB?V{h0rye~pnac;!@|~V{ zI&#lcO%WPKrR3=QDNI`3m&&6w`B7Xej6YOOseDiAGai88k1Z;4h>u|I-JX<+TtT2_ zC`7#^4^UMTb{@op!wm#wwdMf^M%GPd!O3Bwe5hJH$*&op!Hs^fQ3p30(IW<*xJ??D z^KR^}0;LdfS{xGFtKkqIhlJ_B@Dq!6nC39YxM;po&G!omzp%NiOLOeMLLf%^9zcM# z`epR+(#bB_>ouT&;TYuLzf2a|!g8_Mpy=1+?bj(Am$;jD)kp}{edFN2MyK(4yY#HJg{`{&BrIJ1~e8J`lCC($L4m$c3cFrjS`Tt|zWg%}cGF*X&jy4A*vn7$9tY->D-rQKp!8bCh;s zk(e@1Y+!=6@4YVQzyK$HuG)EbBO%za#KiQ^X$qgzMmq;1{BvmKQI>?=pt}2t9>WgT zagal`Xp6j2vv<-Vx;14WrZfT8>Uaa9A^1~B=;pj@TF!DyZmtgMK}F9LcRyP(RqASo zQN1<@Km0D`wzDPRA{(6ob*8T^YVTqa9z7`6p2>cE0hSV89{+Qq=|^dUF1p@+xwAb}Peh=`f2Cg9nRyf+i+k28V9hGUqA` z3JgV5j7L_f-hOVQTRu-!KBXp3v3=i26c>6BqRJGbU*!qK3<$3llF^(DV#I9moy~pE z8|Z{N*xs;z%qZWQ3yxk-NYh$Rxu$N+UPx2@!m&Jy9BTR5hxs81mI$bdWEp^|x|E_~ zZ~=U&k6|J^9Q{?%KwoT+c>>8&Dpe?O41H~r6O^(ZLMXF`lpHl@yNr*GC9*eryNx|h zYYmp7%1B`wj-h6}TSB9yQ6OEgkTuQGgSs=qEi}+YCzM3Fg*6=7%81YvT()2Cyt{!c zsT`M94*AWykVm&GWto1$aMD#NnYKp9LdT=aVMIp8Y0{_W|J^t?mXhsLtKyAT9#0ya zBEaWst@*&K$t~T2U*J0PD$x~|e16KITBc6-j}@6Mj1+(4MC2+!IanuHWqk~(z^k*b zN=VX}oJ}jqhBET(Tx*}1`g)sdWhs9v)21BFwYcglzS+#fRg#F~TpCOSmqcOw%p-m+mY-UBX4zVE`v+qUL>nFy=g?!65X zRRt4I)`AyeSh&*^n;ma&E+YwL1zXi!D&&G9MZ>-rIVlr1=AxOQa$wPJTDfN!G?qtS zY@A%>;<1xlOjF{Zro!qa@?r9)^B9iI1AFfXI-(-0Zat^umo)gPy)L6jk&W4_)1QyL zwEDb!RnR-zOUdw>ef#1@6aBmS#P=5B#VXFU)SW_>;+&70Xfn{!@856QO!G7FyCxD3 za}|}dCK2^Uc#ndD(!oS8-@^tlQIDuARarxg8V%JJm1F5mb24_yOxXm!qlew#Pv6W> zZoQYM8FxsWUZ?GUyqCl6!eBmg&746Jq|*N;G;gliBW5#MhDUAL*^+$^(DwBQfppol zfs#GW%i9MRM>gCOBC}>MmYMb3Ji)<+3dbtI@~e6tBcE~*Xkw_b{{%4OQ_0*Bc}~7F7_#4o8c|vCg(=pnd&ua zx@IPDbL-rjN*VO7qEGDoLf=|*r&8n9(q9hmxs6Jlp4iY`J6d|xSNFA9D!Y(zoO65X z>80;EHcH&i+QGkho67wC_>LETQVrYBMmLbQ8Zgl@H-~`gP^<%F8P(G!zhg2D3FNdx z@!iq+i_eG8nvvMaqY>rSn^DWpM!hkcB78+q6$@GHUb@oQ{()x9&p_BtthYq>@loJC zETUx;^5dL^%6Rb&uT!j-bN~Df&sG&0n;pjAPLd60C8dh7&fFstB#Ef@mm#PPf!rQk z>2W}RIuB67ydqr!3iS%_d?~5l!tJGAQN-_NWIPmjk4nySD2=@W4b{~??WBPC$s9Ba zyar{PcGATqw?GX>gg;Dq)cVs1Z4||34H%CFIprw*wjSN07?6vEcCCr*sLrn;>6@wO zziyWYt#>YP9nAQ%7FCZN08RZpIYzA-U3!#Wr{OsbA)uFm)QD$Ad|%yEr|`5jQ^jM= z(msp7UZ8XA`lz}T!iR{Oc^kMxW4ySXl3sq}Q6Q7uL<+QYr$uTy!uRP92hV;OAHQc= z_f=-9(>Q?zNK`ngUwXXeV;D}&r-1o@fu^7HXi0tOhT&hu!=zCILZ_+&sW9S-_#A=}eI;g9aqZeAHFrIf-vEo75lCaK78hdRJY@Ixo=23|1kEYN zb8GA(C-R4MhC7u+n@&0)0d-rhM1&**P3;`Cda%fC+|Z(|1F@}BxsqDRmmuYL)PrYP zE=j3jgPR+anV$*{nDS=Y@9G^I?5d6nKc}8&D5?^XW26+_B_H=sJGU=V>iTA*?@f;3 zDwHTCn)}zDbw2fW#0ozSPJ0&Md3PuLEuCReb>xUD%kcmfXl)#8kg}R8Nnh(v0s?1G z=grrD`$gBhzu@102Y39T&vQBb%To$E-kVdFR{W&xxm;_zE4VK#y_BUw6jdyEevEjV zwq@9j)(L4bWNK#324b{Pr4KiDlqXtuoe$!Bv~4z+!JKGhe0WS-yRJQ|pwJCYvr;)7 z4dDNP`&ANdC9wOhiUAkNE6Qn(2|;G?*%r$0%9Z_8#S3F3?5vi1nB5$h%D^hv*dqte@&UctUo*TEcza*LaLvdvR(i(7H;o-5AWenWm|#6q4m z5JeY6-K_B3Hxb$JuLLRz5rX6m-~K2(wBn=<(%@iJor4|DE8(q{fxTMaswx(@mQmhNFkX83Ux;5-ixvhs)!Tk>)*2bZPcM9=7QgDo;3iA>`n@-lu1iQm1ux%e?=r}_YJdD(U5-2w(nvd zy8yfsQ90Lq6TQ*{U)P>e?hIpj;!En|7Fj%o*m2)vtqJMs{W#rr+2;b~gNVVjB1lnX zH?|hq~I`vgM zlmMmF-l;w0G=e$qoc<+7m&al}^un-#!(aljcCom|U?Bw55M$&e8_%n`db2`JZ1gj$ zs3wVouuNfoG16HqUDo6Ii^Z-ZIZ#k@O-q-Lq^-9ZC3t;xBh-B;FU^(rWt`6qqSe(k ziE)m0MP}Ql*Clb6EVq`ae5(8+DQ&0MYLBSaZtF1?8CbqaK}6;bC1#UHk5ods8GhNA zt`<&^HpTcc+C6DFF zKluie{0x(uq$V!Un!zPvp4W{CF)^54UJjis8Tu%~NO|`{`P0sMy+YDQ*1Orb;yC0r z0n28tEIH;6py6?GE7pD!(_P|Yevdg=zk7KeHS&cITJY82alaN2$|zQxQZLy;>SQ|U zekbiF4YIZ&{t!A%s5ub%M7YwlK|_VI@mUu<->P<=)sTL~y?>%{qu~nUWo+3vrurU+ zN!-e&^A_YU;~g;@ixFQdn&o1tE$fE>L7R|Z1bNNS?~+LGyY8VBW+43|^6@N?zQj1cgA+WC+)g3Q4XPl(-;3AI_x*o*Q-+Vh;? zRqY(^I=;!~H%a#}sFLU|7!eK#hAw_8+!|@#-5pKo@1_ldrt>aa7aQ9m)FWqNHnxs? zC4!EmyE^(x$I6#aKZ%bk#F~Pi`f3*=WoPt5B1yL7m!z2TqfF&Dya zY<{2%?{+su>MZXKEF>#!X{*oLlkGTI3=~KeL(0t`!{X%<)@)9TS z_6W{$NWPRt^pUm4TAe-e;pDrxew2+v-H#$Z@8S}>Z+)#^a{TC;(YNIKJW~V;yqSBt z@IHss_Q_&G`XLZ;{ffSPKT9Eu@r4=%bFY)H6JwKVh0;V-KcfAqL+KzF5`MRUJFZYA zPKUJwaml0pO9fUtxz!o_YKPCS|MNV^Ig_5tTfeA`kAUa1EzOqLNa>e9RyJBnADa36 zo3)O7q8oU;&<5^A0!G<($d4lUijF)v!(SO)Gc_rL)4Kh{t`^Lm)32@72cb7v6KS@q z8!HylKV5@-!3o{4bsKFNOzfg>CtUpiCqG zAKeFxouUfV^EM?vXuIG}wCA7&sE0<@#*%3;7NIHHFmP-gC5z+hdG;-_)yR7!f z{V_B7BG&|P1BucpV0Uj9pb+q?x9~={rXK;VQn5fan=Y1j!eE634-=QbO43mPr~&rY zqjniUdK9DnTw|G();ZwF@uzy(mmh;t3qZMW!eLDNv8v>$t9;OLPXNFhy=lQUqkEop zF{x+NzHI%z3>d7$07O91y|hpg{vGb0xXv=72{-TCDp7dy##`mMAONr$GUTmaxp~@N z2YoHdxlTIs)BuuREDDIv`_CLn7{uId<7)&tV-E8!0roma(K3@&?LtO3dIQbQoF&BQ z&$`;`k?c)CrSiWrmieb3>8|u48Jc&HlVDibiZSFms|hoCtwiyAA6hNadI1hQ-^GCx zQ0FlXttmfZ6LA5sJOX;7c&><*rD2C{HSh@~oq?Cd7Tt3w0ap?EpYBRn*cTJI^We1i<9vfOh(?L)Cc+z|^HiWKzqw zp9t_CNu-v&HP)S38+h|d6+)%b8E_Pfa$4@}0V4gZi<0N}OkMWWVfa`gMv`2avjfOA zM`L;Vra1W2y%nzafJ4a&IME$C2d6(${<%>lJxPH_18e@XMK3b&qwyY3)0cw3H_xWi+B-cY^L z<|AD$^>5{Aynuf77zjAbSrB7P{)Y>Z{>3HQf3be8a-~cvI2B;ffTlt`Mr@u;!r2M@ zj>T^5)Xv8P{=-*bL{pdYSSA2-IsmM|=ws7BkOn5_ZnmSiEZgyNugTF-Ge&=K^+v?4 zZJN8!-vHsPJXkEY4b2kxkAm=-Nl#i9b6e=2MDNLt%V$O~4Tr7&j{|}sJQQcQB z8axG5>ItF<(kY=2K(ILL7Xum10NKOhyAN*njDovtWZl4S-u;d3Y->p1c{L~vOomC3 zv!>3$;cJU$bN_#wGTSB>?VGXVB?q3^&9S5Z%a$qTETokLgp{uKaKd7Tz-t0WdY^13 z_v3QT%yINx1_Y1vg7nNixnfUiZ=!}^d_c$Q?S)r@m$yHhHLv=e3p)AJQ?P5@J3A9>y`(*~2h8$M^Nm97)1Uy;jN> zXE4u)qj_K7>3b_4f64tD%hLu#VRMH%>#;-dhtJ%E*fA-797{gvx#j@4g!!)u04vZl z#Y46ZtYyp=etbqZDm?-&SGIg5mUMfR*~nw`&!3Ei3(}vcU-_#ZR{v+9rya*9{U2Tc z|2^DO0px*RX_a3$!X&{fo0?{XuE|5cj$FYiL?L(%1bw`Qs^?^^+^EKz7H7v+0df;LCe8B_7=C=yTPH z2$=oH0R6GQg(%J}r*^DCwr5Zt^W}Dj>-Lnv#((rR`|^YEpADJ(2O9qeJ0_R^&W@=c zD(479pB}ko+g>z0vtrr}IJ18A0?5KuAWkM808)??tAOF+DllQ9StPu>0s3d9aN2bR z5dm){HN=_!-)>DGgCMV*QkWuM0WbXy@EHw@_!kDE!|M!(`4(ruTB`RHH}7Edpf~p( zjX(U7Il>V@YR~-BG+EMs1(Y9vitGQgU6VAlcCVW~vVY{o&$S`wk-!O{(b-}Fvjx*O zt@w(?V>lTP=ePQu@m~Wzq_Lw}`+t}@wVd%igo7F0@y$)44VrF+qkQ;;3nX@fzD-Ct z#L*ySZA;SM%sZB?`JH6k+)V2F()Ep1{1qnnt^5;Ki%HVDJHCwqlfN=2Zv9#Nmf!-_bw*YP{8M-@=4q zcGb*)x;~b>+crGS&Xq;-Ou6G*(sy#_?!dg-cF2yhCab$~{+Q*nn6=ZiCWYpQ_9F#- zNR`vWwn8rGt0R4JrR zYgn3@snS(sVJ{WEKlgKTe1bj#V&l7{=9{1QYT0eRAm(^4sIGW^D+>H2&mcbyv}|tW zGFa{>aX4c%viSEgMfe!L#xQ!el^`N6J=gt2xVytB)k+E zWMGU>ujmwZ@OvmaPM57>%IAPI>xbx@yTr!lK#>>b^Mkz09qjV9Lq30;@xXI{bSN&p zFAlE)x4`OJI*eyD-eEW7E@K-aSof(QTQ>gjh6uSP<#kp4R+u{+aZS0^gD_c&5VGaS ze_tlkdLWMMAZP`Qn{VhwwD=i82Zq=9Bt*4F)>VVIZgSG_e6+J)mVrYeu$iGWVUq2L zCL47+MnezjthTu?zju2il(*C_=+3OsM$*)T3ESR>4&g-KRJyNa`yV$?^?CN&BM`G5 z{l6nRUrx0Rb+I(KaseXJ-%Ybk%Z-i)jcHx&M8q_oQ;?|V>_ z3m*3kxxxM<8$sD*SHG4j(v97?T%~9jM3{+hpEf9}Y*{fC8~So|&z`t{2Ldwxc8m`a z`O)|8|D)_Zqnhg8c3%}0l`aA*B~)nwf*5)b5kabg^d{1zMtTjP2#9p)HPU%B4xvNn1kU3B?sxAo&K~D|p2NoslB~7nTr=yw=5=4c>M%P=ch6Pwu;}5czvdg` z63UT4Cd>P6vBrzEr#3$CQp&c7M%^v`)MTo#Ei`P#zMm!yrhpn+yL)`F+$|v8mz@v* zw3?wzs^^uzQKzWa>(%xNp(zth45~$@an&WaG_N$8x~v>i3gcpkdrGCq_3V??hbj$k zstv|nHeLfH%>L{0Aji;dn#Q(|_<4uW(KT6u!h@!uLo?-!#P`#q*4;G6{y|YKMX~0j zOa}gJ7ROx!TX0S?M3sp20m8f9W}ll!TI5QJfnwb--=2Z)i`fLgj(X1D8vl{Bq8UyF zm0hI52aCIg?{*GCKg*sHiO01FtBgFKlopG#LC;D-WZNFjALzi<>1heEkW#IbzmZA0 z2B!%`B{*(|4CAV|eY*|{^QE!-35s2+Dqf!UAxhiT&lp1vcOZ#9ZV92`hVt!Q7)d~S zlgB;ZrE4ID=z<0w+7M^*C&08QtCwpbhim3zdx9&=sJc2H zR4@DMjg&}Z<@)~1{VEs(E5mouz-B*(PrsiYc+AXA7STp}aPt3o)KTmvXHK`PL*22@ zKk@9{#PRpzV@FA`&!U@Q@H;k@Y;%Jmt;&XnqLUEQDMEOVXNdV`&OwFAtZ4&)Kte9J zpBt5O(HKS!!eKoNqICNX>{W4~A$3aZAIS}h{blf|ee^c_Va61{Suy=^%9#v3HOpo` z&4__cKbTJS1 zBsDHV(T9~rbgJfZK)X*rH}KZf_Qh=q&TLC}gmfrSNt(e7xQ#D-#PD~JYYNlUQHLTa zEL&e*$MvliBi_isovy>i=M`+yR;oDOXm95ap$K-5Yn@?|D|bAW?|%2hrfyErY;*gV zD#dl1bJ!;DScre0Ipt=%$`0Onse>)GZ~?5??N{j_=cJ5e;1OWkF*|8^joI|+dpJYy~HJ0&N5Q(J@XDV^V~@LXEp5Cs<9SCH&o$qjzFRNLtrbbhBdcJ1Qn4 zPEwa^;bhyKe!0$$7%;A{-^u98F64fI5esbseEv&YXN?v_^tMS)Kh&O-yUyPZDA^r4 ziC=76Cb~7vC>tQdZsBHR7d5T+%kQ;ifQ+n65JUg_u6^Cgs^93kQq&6}Pb{kHthph~ zv-Lpa=u|&U(4_x&YRB8a71$B&6J*^HttCOAwb$XBcfFu<9L?(o3rUbUuLQ|Fl@o-PWdET|zj?&# zBm~3jN(XcM`=rCem3ybO(Fq2&L87{H77V*+**&LPs|JsQ%Dv1KQU-o`+uF^JAP{RFN$6a>(eQF!35U!N%IYfDc~`Dp3Ed0 zH6S$i8fGyPZCZQXm{>43*Q(mER2b)biEkwtnJ2?MpruM z5PG@kM@dg2?P1aLLF261J14WgvYnTc9+j1R`?5+(g}v;_xKv|AS@);Z?+tfGSokMy z7_2WU#Vjw|?+2aVOMdLyLN0b3xWn8ECOw$M7Zg#rZTYpD&oA8~$XQ*F#+dml!IOkw zH|b+|>@YQel0z%CD~^VY9t zyIPa1u=>bDw+Y5~-bzoyTgg8ChW9H+y@0`tX*7oXkRyJakp>gzX-@mEs6iZ73#{)4 zR$61KVbkoGbniJz#cPG=R~{IQ=NbBlybQ=kl@7brF*08m$=otySraN!m^XH+xrgUeqiF9Tit}cnnm>038=GH2HrJC1 zwkiy;Woq|U11lA5y;$Qpn=wk80^prMM@)`v7@F@6kWs{SGzmk7uAF7++2qwlXNShv zS;Pcpdo(ZioQSragn^0O?Rkdem&4ALgaRu(?@ZMM`UA?}lY zJc3}utx^=j-dOq(u)%V%u-uA!I&+(vn>5GO&}msX#*FRWDRB_cH}m;SV>KZ|9$A*7 zfpTXLiWMQ_byY@YJi}8Lff)pi7v6-t-+sS7boI7cZ4O5x$M`JnG z;9@Y&o4GP)2abMjF2Phiy_;PS+($LG<9sAK`NK>bp`(7^_v}}wcVG5Y=~wdD2`2cr zkucl?G2X?cmA5KFY(2OGpV8!{^*~gJ{^ACo7n2C*-Xzl7J6`CrdT++%;xAp3O6Q=E z$TF-PA`2RAG&iR95dN7F>YB`I)YX<(#WP;PW1KpsvU4;fOd*+_9d@V^cSB_O-?R)r@se zn|=td@U&~W!YAfRV+Y@u(z?pYNAR<#M5xoERYy#59N>ZiqFxPT>TPqTS=D9=%7nh> z(tyb0zSu6P7F#G_r2?Gds|oRc#S)lBGpjK6MJsEEm0jSOH=$|0nzAGwL4-F5zr zkem(U*%peD3OgqQIVq}^v^zvklRthu+QoOVlDI5Z{MA!0Jro2fb_h|y8DU5z_JF{T z`>6&aNbBysQ}_!>J+Q4FyTh`02LBU0gV

^2Qvu7tPLqV`rVKqF(wsK3t&6Xzr(b z#$~VwuKnsntng)fw`(_PP9H<~Zp!@TI$msiPlNBC@D=Uo3i|u|E|@)!_w-HyN1y9% zrG)dx0N(kkx3VZ>nUJy_u8)PIthJJ>?|aupR(}s9sOq^Qv-0xN58MPN{jEH7zX&$7 zOYB;WuE@dYdJKo9!mOaOpNb2IM_(mV8jsCN)y1~>hZ%L&{|+D}>wUD2@B&>T404|F z^>0-f?7VWPQZ@1W*CQB82AT$v;cp?8Mz} z)_e4C1lyZmuauW2LLZ-t%h&%R(fPl18qfnk>N}RQSo`t(ANLmim&n6$r9{~Nvl8*Y z#D2(2Kn>U-7#gFn{3kv0zfR)ie}d8p{zv8WzyA{uNP)Qc-z|h3Bl^rkSy@^7fBI~k z$`A-#ieqbI;Rlxsdz(rR2Z!>V&&BskX`thuk5>2pdbAZKKVE2XJgZ#s@YLNTjrh^v zh#ZS{NSjiqHo%>rt(}*W$n4>K+}xB5nHdsCCqE=G4O+-Bh+(k&nVgkX5wve}8lqE- zmo3foP(5QOrvSRCrGG2VWY{3LRkt3Ri49=`**$emk7$#IBcOCKSqNSWbgR9DP7372 zimGU!lzOSPZ$RZ}iHlnXyB=8LOKNa&Y4^ibxJK0RhEKM66HElfu@AeAdgSORpkn zQ{cEZIf&+0(1wb#?O+PW&l0Z9 zgZJ-lRg)jJV3jD*5~@$H$f{;lTjmeknAjwWT zUw#AI=_5)gzScFA1>p{`Pj@A>0Sg3P#fMu%i+k(30g_eQG zrurH>)8mFZ0rV^XV7BBy7PUj(keuY;{taI3z#jGkcS94eCjMh)Gv-@wyxaR67E{B= z)g{auEFwe0csnZBwGAwT(%LWkrroZMsjIJhv&X-E(vWbC>H4>qKIAXmKVQ$d%e<-< zj?DS}@%mCKv&{RKGVgxg`Eld4^|m-j=_NU_x^&3hhO7wXSMKp0-K>|})xFw6=4M;; za;(1;N932cst&nkidHr}dXxDbR8I$FVlyaMI?ud-;DXHhi@kT)=>|=W)MM>%)5A1L zK3R4o=<$@lM`~Ky}pT7}#=9W0(m(`lfg9@Fb;aBbGo$On#$NNc&GgV5I3e--wHG*PQX2 zNGY4l{vr^Y5_`1QlP z!$KEH&Bs(njh{^2*gia}Rc71!JVFy5u~MtISWBF5m>0f_F*kr-oR6;oTaqTH=Yc5d zdzvyJVA~eg0@BM{k5|&{;pTFV_)>>|QZ^f~UqdpsxF21q4gu@=uW0Llx|4DAM}D63 zp?nsnfh(Mr&e~oVQVgO@^F_V|e}h&m3P8Uay-wdgsQwLz@)=OrK4Pf;$gHZ`=laz7 zI6_&^%?uPF-g~a#ZN6d0qsoQS*o}Jj?we)1FADz!=@2pg&PS+k=fy498@KpxPvf(V z`1TS!mzd1ge%-QYo%YBs?}fa`AKKUl@V-jGtUnO^G8^9Ah?ulteM`4@lGtCG`lDu> zK*7^;P~K#eluM}I0rc}!OQ@NuHjDPnE{}GSYHX2Pyemh*Bt(U_{@5y(=dEbWg;C!7SM6;+X=vmIM+|c6rlk!fFn22fwkfw<(um@kDoW zlk0@TtH>{Z=RF;`c%^YRdzV{3YRw@<{U!VHPeKDL4?!xEAwI*H+awIXyu5~wI4q>D z2veZ5G4??--vDrK0C8mD<8HO^z#h}HrLUVO4z%*%AR0Nuj2aDm%Gvq_v3>2w)luIc z*|re~WHfdO+_Z4s&Yjf({hXsod#HpwA7;}wD(|~O>5zdOT^~RD=)t{)cB8sk;V|HJ z)HBh0@Sb9LM1#8H{AuOax4m6+RAdNS7lX;9hFiDe@84Vny85i++rC;m+mC0^-n5M6 zeX&+8bTJu}_&tPc#;O>PCIob_*siC3BIX0Av<3*Zyz-*o6Mxr7d!nJ-Pj~j4wWMiG zmDz%$%r}c}ycSa#U}!NgU6#D@q2`mRblpkJ`rGJC3FjFh0LuQ95)(`yGQFahb@m-r zJFhAjCQOuu2pv}vaXaPCnlk4$Chg{DB&k)Y6{VaN?YZq5><|t4wKFurqYN|-ogper zOOAf{qJK;2PI!JLPc$!ODpnyuF$y6~JR(ph;$h?hhH;d?#RvII5qddusl~Z?@bplqh=&Jz(m0A%*WnnSb#Q3syXi>we9a&$0{VF4kFeo~@n_{I=8n8p7nRSrJm13Yx2xA`_TTB zaL=yzEETiN{KIpm>0mP!y)iz1>-NKMzEI&Nk-(Y2p3L#oU}wFkrH5m;lIQDOtO+AR zM`a{MI`U&ktSm*dq2B8{+|twmHOVH`Y0h)9Vjs;THok=)cHsXS*;~zK4NRA33u+Q_?qr#=B1G11?m3|O^W6S# z+cg*(??=N>u5Oo1sb$D<@MuZjbFHJO?9*}2U~x=v-Vldx#I5mLby$zf=0{e1ejk5^ zPGh@9V#-q6Rov2Sw~8kggoe~V&CU`ojA69)h_?};yAL3G{wGN*>1}sC9}uPQ5>7UyLNQ;zdKyEV&L<7* z%)zYI*roJ_2cK zN&wWp(AuKEM$_%gvZEj(nSQAE#V;XEA!-i`g!7QhBJ;2oQ$yEqfUWf~^d4Y?aX^Rj zRPpJbyXy)Tx1XyZ|3DLihO!i#v{u%c&AXyMeY)pz5RM3vNzI< z_OM^m!r}C$mm@kveI3;48&_SLEI=!%UDfev;~T-DP&|!;c>5c8aVc2YeuK_?J3WS) zZ)W`q%;oaHn|y!^HXo-psN8bYhfz&Bma9jT9xv_fMmt?gwCQaDMb{fF%QhZ2xuOiL zWk?S!p0{x=+5|DcSCj%ejZ(esj)RDC+OWUPKMpsuo?99Bpr?&lvsyE7Pg~=PE-4grdJR!a?R`$SzVUrofs;waih%~Yfq=k_!dt{R#EX+ zrE_-OI;L1A3e(+G1``Jo_h>Mp;Y5gHKDqda7mR(aL za^iN}kwRrjlbr+?W){%$j-ICevX!*BSREYuYRkrhJBX;tEL`jAC8UH+?|=B)#7)W*i1I#l<9vZ>3xx-L@|z7ed5q)7 zCj^GIp?|>hdX)TIyJX&_VG@Lf8rY(3Dm$J(H8}7y4|`%dmNr)Lt$>q4{t)Y93$D}e zAw-#vs!wf$PBK(lu01*?jHk;~msp5~1h;^#zq_0tn-8`MU8a68#W;k8WvGBW>UJlN zA8-j#fV%vt5;13nzmcd%SfOULAI`bk{jk zzRGOg)4rbN*^``DY!>!H85W|(58>>F0ujD5%W3ds99{kF}5>=5Ac+!FSLJ9g4|eH1Wi z=3RUaVcN-*h>A8U{Ni&Suw1r616rE>kVN!IXj*o6{4{uPcGnH`=;K&nBJ)R9ks*GX z4HjB&=e}151(NdqTEU(?sWyz&zF+44)UK&i>;0noa6D<2IE5YnHFRTbO5=CbB(UGg zC!lrT1CON1^jVjVO=>#8hfmu%epOZrOnPDN5`P(5zJpzGNy)my9%19Q*LNmK(hM=f z4rTaGDc%l-z~4FTrkSpdBE^C}%U~?K=m+D?&tFlo(c(GOf2^(k)ljL?&)96df4Jx* zUIF30?4ls-n4RChExwZ;x%nWU zSDr;BmHMJhfnX^T@XOU!UR0F5qoL;-O#uQedwG$V`MlA&u*a}nC#zP*ykp#xlWFy% z_z5P24wH1!gG%HN9Nl?eJ8`?1x5t`+)i%=q1}*Ju9EwxG^8*Fa0@?ytpEg|Q;bD~P z3q2dJlmlBm=44Ro41f9^0n=V|8B3Wh(=))RglnZ#DbRi6_u}hIS}8_D=7}Fdb8i^` z1+}pxhQbw_n~lpXbcgZ3o*~YC2|)DZ=)RE9iwXi8SJ0NIRKW3rRVeOT?|M~!@HfEL zUB}@a2H2r;3ZFPFJQIb9VFAaO;$W7NLKn_;2S6NJt6<(EoZhSZ8(FeZ^oj-QLwFuz|il54S3e1^qnvn!FN-}pC# z%p8#dkr)d5t)KG|I!_vIo$cMxHBTCdNY-SNsH1yG;B+5As* z)v*$C*OR5#!D=Mlrh&PEcM}M#vH)0p{rSo+BUV1yS-_`@hdh4K`Cn{Ogq-C092q4N zj~IAEo7qApDZW`XVY@~EI(|7H*amoZIV1psq4O6YwEA)^<<8>URu#{AN*RjGV^4hO z^}5s5>Yu{hx@uRr)pC&+w*E=AvQK*srpGx{z2IHj`z5Nn=@`N{||N&%k38W7A@LGaRBX$A1? znFjbGNTb*<+z+rz>Vvb*zJmY&#pWOdb~x^Mi9gC_2@^+?-bL<37e^icjM(p!oG~yx z#czAh7~Iu)s+%la{7wSbFRlCGk%+yC=r&>>4P**^@&dLv3T~;G0LRjF7U1LM59atE zul)ZWl@ag_G9W`Kf#3KI2AC3PI~2X92EEF{?jj>#uS4#lBHe_h9M$Guq^%@5C`YzP z(fk?wmYrn(b2t$&e4EFTxS@AIm&dZFKq6Ce6%aaBCVpwV3e{buo4C zv{HUw*YNlb+?oILi~x?y=D~H+JE_K@B2Oxzh9@V$Fd8fYt~HXr*dSP6wC| zG-beOetbdxgW%8bHEykcGql%bXGe6Q2cLs>fE=sO5h&=s6ykoxi}|<7p)|5}hzv+?yZtN$HhV1KutSUY zjbMTE>iaXE`#leU^Cy@Ke{`qd5x{1xF{_a&{O8O5m4xmqfPt)Fz5(QFnY#lxkc6nC z?U|XB3|)k)9Tp%KMwX4-AM#!9gU>vk5Q~uj?xMrIK7gmoyqoBEc~__AOKL9gccPL* zL=Oz}4ll)VU-z|bblgXxe_jdh+#I2~=?u)kpIM;{5_K};8oD;7gx{~Iw19sQ`rd%k zc)hT?iW!R+!vRpE;gpYyK0A^!2!jV0*M*QvH7;otU}7PNZgK&Ma`icMPyfY4yE@1% z@>w79D@<@c)mF_ys3UOqW&#UI`!SF@8s~arJDKzjEiLUJU@{-a0cnpyJcf;kz|dF& zcTS}Q!43l+OtB&IiK!KLDbO-@hHnO#BNf2fRLJv!NeH#MBId6=8w*efA zF%0~lUPqo+#vcRgUYwmuU<*<$O1YY zxb*?Xb8c#CYG5@Tse#k5y2YRGcbysUAO{24Q$7#S+SV{#v943}@8voGi@5G7pl5yH zoME98ex++&>Stb9NiMn7c(&yT3>>C;7TBe&A93`Xz50QBesf;v&M0wp&c9-B7l3b= zC)vFb1@b2c9r`3v5IRu21;DC0IiFG+394k(ddP{%2@vQl6HNrZkWMH>0b;j?VBry>Do{3 zB0%HxEN_sHl9sw)G$86sodYyQxclM8_zgc`#cLxywyj&s!U4GFEFeZT)>Zh~q6^Ux z0LxKLkrftRy!(n2n}Bp5avKp`bRju$_+tyC#Q}Mz%0TDGhpT4@1jnDN>l<*j!a3#e zKg%p~)_#m{m9SXq>@E?P`%aI^98%`<8;*UZO6a#(s28DnMk-P)fC-d!Xz*LSFRMYt zQ&?hEodLBqadWEFZkT5mPzp$~W;cjlw|Gq!{EI9#GJB?nls}E;)#yEZrDj6SMYgk> zf&P@hLN2b^qjY!5)G54&09*xD3$3iSW=6_Y1TLsR8qIyo5mQ4WK{V!7s>-lEYM##SKL)Ssrv8!}nCR*< z3$a`C#{xah;n%?;Of8Gcu1w|wX>JC3U_H+36=!>O1w2M&&W^Re);8zB=$Nsr(b(+X z_bkHffk;yI$`(=jfNP&Hfm1zSOBW?~zYml2e zF-*iq;72X#6b?3+E#8(joZUlZ@$QG0b^7$An_8i*6{zprDr%X|X3sR(IKZ`0>}|P$~hA{r(cQ+JmE{K9dz#$PE8V_Vrb6|3JrQ za2;Pp;cD4Z^uuHk2Z0U^3m`BSOB=*TYuo-}CWpx_OY-RM(*g6mA>J_~>spCW8n@s+ zPAE9Xs{!k%s>}Cl@(^5QX+@J=q<@-`*|kgr@6D~tdm~(+=+s3+RDHYBt`burI?UHc z{TCbhLT3j10{oawa|wGhiip#XzEYV_1G$-Yo>zfL5#`RPmfD28-5pu0UAat!zEkF^ z^sScJ*TM0h(z!l_?A0o-GvR}s2D&W_I92$DANT1%@h{KG1;TG>OJ;6gE4biT=o`Ty zU~4W-5>Q)tsIn%VSb;q?-zTz#D9++sN02ZVnut##VwulcggxPDRA7PRO5Iyypte;u zG%7G6!lT>hVd||267Yz3PNb>1)2_Oy84|W=ua3Iwb=2XM*0;+}R#x%njrtc@TgdXec? zIuIkck;ZVkQ!W_5L`MHGT&-albe8*I=@IEp5K6mb5a!Y?N1IFhX1@=w8MB~fk`5I_ z1-O%^Zu@oH3OLjjBl&p`HjykMRBIu-eYwTXofy<+G-x^BGCFxZ8lDej9`$^$59Mxo zRW-&C;fZ&XDTacBQ0uco4}EA}*LJ8&al#RZ?j6>-@7D&7clk2tohK*fqajZeJqHde zyScqczHvZVs%OxveJiXB6!6?(La*^@HSvn*eQmKENmmBvv6>;eHo7${#*>lJJ&5At zX%tj?ET!-{PS`z$Cu7^lFa0JR_XhvSBc*qDSA!jUxri zLTE0dpNT!lv>qww$kkmhqJ`-7)mXP0vuye^L4>rC>K^x1+Y*++b`r~@T;RU0L-|(7 zt;wB4kqOL$jU5@cgV{V7#bF%Zy;5`ks+@AO71LT0Gk7OsIs6%Fc2ndz53({$1gfIg zhjdjLsrrGubV03k%!bi1&N1nYNSBl}}m>o1~h?|3vvknJnH_p}R+ zUDK&~Gy12*m+&NfE>{ujbKQYUysC=gePed>J;-``D#E27@n>>(A!243yN@P1q;Fe*vh}3PY_(w>yIwW|4kBRo zcgtf;A54tjbcPceu^-%xhvCh&H$|Ci&O+b zPqI)~(cJs_8YUu&RVV$PuI5{ahR}fHIec}kWgF!t6!sE-_ZwWYv%q`N<_BbvG1jw1 z*)1cNtX6qG^MtedZW0GHg!*Y*GK073k!|PB*YrO9)(F$ndl2L5l}Bc`M5Z;yHu31= zXlKO;==zUfoKt_NeR>b!U!?%YM;aOX;$z*se(j}=dBUFD#N@)AgTL5_(3C1u#vXPi zPc=2yqWW5vi}Q@Ci*@CiX>hKRN6Pc(s=D9M#g{oN@u4(_lmWybPibB)x5l^W}-Q@ zGxsILL*}Z7b2uN@%rqY%%V2SUtz=qFr=@$5@X+mBaT4#M=TZI43%lq}?zOxqXBK+!H_clfaZY3)vr!R5yDzV%H2gF(zf+nASIe%!w z<_@H6+eqbqXoRe|V23#Ay^iOo^sl08H>hqKF3FTzFFE&)}Olup7)6x)9%=t+AwYZU)G*A#ectc^`ns?S#%dU7M_>=u4Xz;rWhs;9s<F?`oL;)cH-KAums4#YQY5TWbDA zt@nTaMN92U=unCXa{vGHZSFr_(vcShgit>r{QoXr|E~(y>gUzFIPKr_{X1>qKOe0{ zMgcs`9+V9HS^Pgo{eOM*|NG!SDpBO<4E}r%-DKPW9-lLTM%P06x$W{H0MD5X=yug< zRDkrR97Mxcq}2$aaRg@lCi3zEnDu}Th(15r=Z-1vyG1YRC`U-|_)dl<1?Z_0blIBx zxwP)l%oISUI^YL17-wEJgnv3YHTVMDK-tclm}sYklNGoM&@0WMJ3=i$Cce}3L0#P| z5O$?<0ejn+Z;7U`hk$T{9V;~+zXEIW0Ci-pwYF~iq&Xa>8q2HSSqJ2rAGaFnW;PsR zxSfEO%L0$9GWZJAIbK#3UVFAxpAC5QqMb~!L%Dz?V!(CvRg$<=vP=MT3A_v_j=*D2 z3is8^fK3i1__4{Stf-`_yscXOG1yw`s!-^xL#2c^=>OMkK=N2Hr@#Z~s#jD2*q~Qm za?(uZ^$gfF&M4s4Yq8@Q)vyTSsgl#RsZ`fKx+*Z!!yr0Ww;L&gxG*4+Ruph|#qz0K z2}xJ)76BryD*)Xw)+w{JlpoOV^8RyzpVLFofH1^eXAj6+noo6Sh{i@skh!mctMpQ* z*4{L8{y-E7*_GDXeeJUp8Wbj)cZEHF*Qt!fFMG2BMKuxM6o?8K~%s~8UuB7om?id#S! zL=Ovr<&4yBnsXz13^hD&g(Jg`+g;2b3%_6sWzoNC!B`2MtpLO7+^Qi|C|J{JJIeQfK99`cch3UY;mOb-c%6lH_`K? z2Ii-jUkI zEAlP>26R7RK!%{vt5BZ015GmI9f`4JJB$sE5~)x~Pj28f?qm_Ld8D#g==-)1d+gf7 zy0rJ;qvX;@EAWy9w-3o=>uWsM90A$+@wK_cg_ju2`$s9Vt9G5qaN$i|MPnjF_&O^| zScm%g1=1Xr(z0vs*fWe&N+iL&wRx{b9y6zs7<2lSOINRq;p2fIa(Yo2`39-&@*>+Dey$$*0#_SFxXC6cI2 zSeH{|@~qN~P9{+EVSl;f#)O@UEZD~n9`_B`^;?$^48L)jb-ojuc3A66@;GYK<~O&> z8{+WKJ9e}W%V%w`ali!|-}yDpJF}3UHOHTXyl_fsjBVB;6gz!z5mYF+RmjKeE8Z64 zYUGTV^9w(jl|IV8z*j4ZZC04ZjBo6RdDkeoPh^tex@_}w&z5h9htiMz@TTr0+gR?l z+nV^fkp08UFwh+rZnzJaIJk464gz)WUUJ-!^qlW2?UpaAJI0QQI)86pO)V-sn`NtA zNbwMMTCaQmxYXr@_AP*-nL%^&@yXFbE8M`E%&1MNTobfeocV{JCU22s&Bsmb8#h4Z z3QwPqDtdZy_?~DV@eEe1Q4ThJ)s18H^ozatgx9yHBctVZLu0h`&+1t0-$)v`n)XwTWh%Gr#v z4ILn6r8sj|ZJ3Qe!oRX8_OER?%Mc9OPS0WRxbA795-9P}kAxiY8m7d;YGWl<_t(k_ ze#j7+EuI`IQ3X3~^@eHD@mN%l64}-tj92XX7>$on5ZMF}pWD-i^8M_;b$fP76a4(r zQ4?;EaWS%Zt}R~Ruru)FW1!+WqlwoW>P6F5?QIx|6KtsZUw{UX8L58_%L!+%Ai!G_CY6OHJgIz0guW- z^27aL*?qP6stY0-&D)Iyb{|#h%b}bnY`)eTOL0czXP2#=E(@8aAeCV}y z%EurPk5Eyhbz$yW>bfcqw#>^f$&#=6fTR**?o4@mQx&DGuMSaJ@PWy)kF$9^j^%C; zciNhiK6a^aRVUnh`xra)B*e_z*tp?O-B9*ShXkl6s+eZsc4g_-*T&EkC2RRAYY;WFWW>>F8rP*095-X{IGG)d^FpataE#cQNg>Y zh1-YoVY#MW28_6F7qxHUVi?OonNKl#tlS+iW>WTd7XNddVFY$W5f3STmxg)~I^t!2%Ju8wC&i}e` zpEfIsHqx=fB{JQ8XWWasSbD}0uc6|!Dq9g>Eip=qe0-1%DAhMrxHA6Q)#!py66RmdEd9G*74B= z%F!EuB=K5Nb9_2G%%r>B6J@xF_CCL$sY8&Ow&M=p3rOtZF0-Z^@*U}sVnARR;|=i- zy8!(v>&gg6U%{(*@8$^fW(DibLWMhyBOTpRgkESc$Jk$HOIo_WwYAR;h45PK)}@+q zlW3h;?aAOf`${*6;C!9d*T!~ORE8ZXVoGTw=S&xFjlYp%N@Oc;k$E9xH8#YO7%+W$ z7^8QWPWV}7yiWLdO-Zh?T1LR_9zyEgo}C4ivGa_ms#$_is*{gyWQ|)7W$arN^|{ zYOU|#=floXa765HX7#n7%S{n`^rXYtQ{#Hl&P*?LIpIAG&`v3@F!<_rt!_Y-Y3Ra0-x9}}A0%mpV4X?o^C@v=^}JFlt?uYKY75QlKpE%{e&^hV8gjIpy|dy%1&vi-tSVMDV$6@gK`JnrG5_OwPR!) zID=ENMSNVa#hf{5PV(OSD-F-2oANI_EwoA4uXqGUre41MhG>Jeri`u#G;PIy26tb@6IQ z&WyY$$Yo4CW2M#a<{VqN5N$ku<6REng0yiGvUIC~5BI~J4=!Xt{(ZJyi+0Q3A6K$D z#d-Xm7nYS=s54k17nqd}L(R=G2Q~_N{Xq(}X+Vw`>`br|E-xuz-4fkW;S;(E9;`D^ zp9d>0#xXp>x|nO?IbFhOppTR%GTu$P+Wt1?Qw2H0v9}*0S8ovUrrm~SxxI6^w$IG8 z*%Z*zlLvK<2v82Wg&jDgWN%Qk&2Q~#2?1kx4>qPDJ;|E+yL#z%AF_$Mlr0J9Z(A}J zL^acYd0nBGoF*@{zZmFPF*=uidc%gxgK31O&3UBxh5w5ukGP#303^M^5lHgPi!pIV zOU+60xl_#Nos!+?v$=(7Ugzk5?T=WY@Pa-Tj8Df%$nL_-2j%sObzYFNu5D=pr^!Vt z*^dk9NeowCwo+*zB#Uo9ONiav;@DzEzLh{}Fw4vs?iO6y>uFvk54KoG{`#td^QdNV zK`lROV_KlFE)3mZy18G;gKAjm;Be%}t`+3fu{Lg@!@3u~VP zRqzW;*Gi30oB2YRC@v@^K@|ksD5~h{g;!MG4~VE;%M$JOWQm-R@nG25<#Q^HVImX2 z-?Qn7RjTq|E*l6T#R~MQicuj5Y-;}+SWMWEmW!5@wS8lQoYmYk#I&Br$oWIodTv`O ze@Hyigs0#&Mdj&yqTsC-7@V`D~cPAP4*?k^Vad#JyxZUNvI3VH@qjIWCL>utzb!iqQIp7IW0Hj zE1Cm3J}pCU{J5YOT5?Zk$=3@H$vHVR7A?WXQ$I~$n-I%4)Of4maiW%RE&l?0t-icPS*PPc7IO6E1mr(?+rWjKRm*pyb_VG2hxNJ(m8<2qT+9NRL*Tn+k$_ zicX?}&wj3jbou%z4XhK(t?cb;b@&0cwkV`gjYc&o`DYLujXD)zsqc=PAq5&hdrO~k z5)x5m`me|X_ z-Gk##NfalMJ_r?~=T!sK5HbpL`fId~!VDuLc~Oba(fD#Q%$ILs?N+bL@sfH!Qr zi!iyJORc_=9f{MHgMHaS{IcoX6DTLE|9jMp+|qn&iXFCkiGhNqkS|r9e+v7nb<>L0 z@R*muip;uu^L1EvnIQNh(m34Q+{5u$J@o0KDr)!5lfOd&)(z@FzWvOI9A^M(H=wUA z#kv|#=W%0Lih7hbouQ5_=I2m@2V78fA^Gs5_;bPm8trn}RyfCCa|8Rb)Q=XsPLIzU z9=h6zIl;K9iA)?i2s>DZY)^5VZHw>OI4KO1%b~~J)m&C>3x;vNs`7<`#vz|eOb}7K zECk3^$qkoU^IIo$mah5CT1I@LZNUu^HjO7{YXJXFaQay5h&--HZL#V+%ioD?x8$?* ztCxdTSG(f>>@c{4(7k!w!D!G>2XxVB761WgHzn9arVPTg*AC7BbypD)_?3OIey!Bl zz@nEjB-*R4HF|i>F@=5IH31GUz-Wb;?1>)B7r)MCDE_g$!sp5ZDehhwPLB3^(t1!q zy;pt@z$94y`J;Q&eKo2oyOE?Nf9>QX^&t81YjH;0lhyH2)GpFp6lp~URzFtRw3CCj|*Rl>w7m{C(Hmy zdFg*si3s&2@oOrZU;6XE$Q>6#VceUD{oa&How?8WiYBK~ea%wR|9I~Z_?vyFuJ2rd zn8XY~crQ=$e%}xHr{E%swjsiTmjDVeatpDqEH<{BZGMa&4TEhMuL16Yk-@*>mxxnG zK=o8c^fb`r~nZWWiyitE=L@EXfp3(X|X%wS0dnC0O@B0BYTvML6(vMM5m0JK zk#3M01O%j|yGvr|t`Q|gT3SLP2+uxyLW@aO{#MmkxiePnNpu>m08n^N^2x2C~t1f~o3ny3+` zFQ>SMBma{UO`b^Hz9NQQ4%jUmZq7K`+b0Nm93dSgvV~A)pYD6$r3@5N_wDz8Z8A?j zeMF|L`+tl5ia)E|e0hiQRS4ofsb!H3m@Y?gAKYv<0Gz)*TnrDE6~HW&;(6K&jZ}XG zgroin2cte0oZpK)uJ&Of9`|JT%+NGQT01soa17b6#_8&~;+<)q`m$YWq zGU7qF^7k>wp<6Uk;c|fJL%)7CPN$zu-;boyi2Cm~WHW*ccNA}<@1#ZY=IsVR(ZmpZ zpTl;fJqw6F-K*Xw<$~5v+gbnt4If8%@AHyo9IN|wJZ}e$^1pv(Kvk$Mx(NJk3P5Z7 zBhXh;5dcOVy<3ZxLby*ojv^2ja6q)QJCOls1!J1N9{zF~v~+y8AqFJYswnVx;9}kU z_2+~dTLV%cS9R+H`@j^xmq6iE-t?D_JBwy5WU>p#}a6pPjWdgh&aJv(0p;H z|FRR6E>Zq{Naftm(M5|Z%Q%7uq%%6-oKC@)D23RXPNJK_9e|E^Xt7(9S%>Qs2nA&% z$0dS@Ecp}c#MTPobcYn9cZ|4T*OBh~q>NEo^^pj#|Z8F2SF zr4C{P@TekV?I8rRu&L_9PEz=O>!H?I~a0LW|$^lWX=5qkw zhmoXbtPEeVuNXIsTyS#Q<3-%Zcx!6Uv`ui8fb z^hIoYGp>SX-jU>qB;7MK-TXcy0g& zt#Jv{YRvlf|0n@wxi6+&gA}HoFYzm61%hAMeHv;iM3mJ{doq%!`A~CL`x6Jd0Z14u)5X%7R z=A~QL`lOcns{l>(mZN9@O-!Hdsl%rVuo56P3PCvQ5-fjm?);Hxt$gZJRB<|~lf72* z$LAcqim7i4qx~fyMXX`QOZ0uOsiTvuUZ^>;W#?RvpQ>Q<`Ex04&|&4&Lku#*k^`Tm z0OA)u(0jgP)(-GcG>6@6y3qVUQ2qe_r(?pk6d=ruq(`|E8e3!d-@_hIeFnGD3h$O4 z3m&|BXP-`f)HL?c$i&1%0N``(enEO6uJrGRww|l88l(5tY5_85sRozrICqv60J0Pb zgeAwKKYO((v9A^Ei;G!MP%tJ*3OPybxlzR2nys>)^;l1t`bb!!q6fmm3{kHCq4YiMM zu>^#E7B*0|uVA&}{Eltw`VWinoZJs^LMGzW%sI-=Lho*3?!X2k?6{Y=s43VR+{EjN z46<1pfD~;Bq+5j4cTsrRl*up*?mu&+>@v~?5}ye$SeP`53ooojQ7F%XJ^~%~LANDUj2wp?SAY5?bPHSl#*P4vi4F1@ClBScvtUm1gQYa?w4iY_l~6 zl+pck=u+37zI!IJQ`)xkrD4u!4|rC``(E}LkPP)FazS>yfj`=^ntzionNd1G$JTg9 z@n1FtK#NRvbT9DV1a>kRVtsd`&C_7ku(pe&ztNFKp!5rJV2x08B?@>#vnP1dAW**x`ea>9~D;}cprui1Ny$M`NIl@-(5*fpSV9MMlMO;V%fYyq8Nq&4}n@S+`q7C$- z1o~kTCN8wQQR0a-jQl2*Iw{5*^o>~8UUZo-Pn7h{qXMt@8!(9r{frJf_ffX42+*DW zcfEbHj)zO02>+%3uo(ZMzCI|?ZCw7&G&;bCuqk=5`YBQ*cvY7NV})V_X~wp+{Bx=jlWAFk}!L?ch( z%7wb*jw;@))jp?hJx&x7*gec5B_@~rAV*yaEi(hAqOXL5X$91YpK#N>!#k%O}SLt6mDlQ*Fl0T`c{t`=`VnT6$aV zcdnbQr5&|=gQ3rSPq|Ri$SqYNBKiK2XikXrY~TFaRs^uB@rHEeo2khPFzmliM)F>~cso^8#J zDy$?MobTP67}M_>ODN98JhgJEDM9w5u!&*FgEMGRGaKds|1`C#97u+0_m^HN)VBt~ z>JG&Q_<87DK74nIfPWT9f=7P)g^`1PlVE$C^7P{vULjta=x+_mR05|*32pnDpG)FS zNaylc(-2t6sskQ+=*Q1I7hj7kJ@H9hmN07z0^KAo&>(2kG^$j*c%FLk1~ZNC?V1IV z)+?WxYHR!{B>&rsb>!(hWaDD`2tr6)&%guQDXw_OZ81 zO)4Sbx}qOwC;K59g^`~vA;f6cl|6GFF=MG-RksZ|5h9ljC(E*UKRd%`N>G6&#chWY zQD)K@C>sjp~^nYZ7_&h!@AllyRiG|K(!DK_=l7ZUaW^nvgsct@0v%s*3wkKLQ*T&r^d}2aX%SjaORKs5C83md6}O7NI9+ zcf4a(S~@mZ*?W#Cpd+0lLXr?VM^$?t9r4mYrf7dC(%I+@U4B2C_RM~EbWKv0h3&!k zo@n(ztexDVZ#Za*YWJE#K>sI;Hn+%b`F2pSdKMPJT@(>pYLSntOTOKo*kasrk!`tM z?#70+8xVbJBq5Qz$~ShvuTH<_77YZyjDeGmvqsW5H=-3!pXwH8# zF=ee3PrO5SLd{-8c-lMk2DcT3%AP&uPAWdD6K2Y)sISk-66v#Je?8rx3}sU1&Djlt zEXa9{A-7jRu`Euiip`eM&T~G44=qsKrdLE9kzG8*+r0juaF1gkO|;aFVNm7Zz)7i6 z1nE*__clxjLDPb5L=5sb)k=^GCO&sIbqbq>-AR5|%OTeHrq**QDmHokiBhqiV#io7 zF#oeT8>KVnx1ZhO-fzo!n5xBAo)c`7yyDLL^41h7a4@uH0MJ;nnjpHw9jDr~4bBtG zGf$h&P}6bew%-L*r%o&GOj+76z?gbza499*{M{jG@trA#w?%4oxF~;$ZiY>JJ)-=l zM$(j*s885z|euL~Vux@9UKaZs?j_F*~06YDk1j zH`ZPHnh#gs09X&5VM>MBj>4{0+-yfBQi@9_NrN#fR~{;Svo%!@RZ{&G@09lNqI3$m zTCVg7>E@#@|6_0)M|8G}(_?j1-ZU8Dz;pMLw-D=?b87!~EbTK_FV$LfVBiklM)|L} zG`oS+=;F&&J_y8^tyXsj94K>^Pg2cK^zpZRO9work$UqP1B+&}V5)Pr-GcAcuIqz^Ilb9Sz!_9wqu+96yBR5tTh?|8^u$zmx`cYRfP(SF zW|;ButR>p6%5wf(aFZP-JO1P(UTd?R!s_=#Oig#jk-!~6(g#FG)gR|DH(FDAo~q^w zHsf>@e0l16iPtG@!`^ zu~vk(PRwMSBH3-K*Ph!{+yyWFc>r;$EMUF$(1O|4trB@Pv7Gn2-!Q|tG-*?FZU8?e zWNNCU@u;@}{PGsSBP9$9D&kRnrdTb8JeMKPJ{fL%b{%59(z?&`W5u{I_!}2 z*FgKukJr1F{J$K^A3s{XS63d@s`f&5zeIk!xbK4ife_M`K(!$YsBYc17W7I&UL2Y( z83mEY0p7o~aKLNjb!w~BMcwowNMl`0h@;!i=6^;?1Ukc-(iwkaKdhFgBfi|@gF35VHond*f z*kXzBIhP0c{0hLE{Ae<=O@>rU!!A15w7XZrHmm}4E8SAR2ia_BV)x9S<4{&J~6x{+*0dgi?;qpL^PWlb9<-RVx1sWkh z(@Bv4s9CEv14(T^pYn_r6jg?)2Ge80KZ*yE{+I3?;AC8&94^*tXg3&ckXTG9n+1x7 zG2mcsT|z+4XZ!1>npP3_zI4xc(Yvt8XXw$i@kc3hv^4;m0A^GRWT|+aZX}VtQ|HdY zA!>hUL~1i`&+uQr1efOz^&bj2BD>G$DuI-SET9s*5srteKk0mEqyw2bVES+W(Jjv7 zh0DBJsJOc-@FxwRBYWTz0Lwnw_g#SS1^KBbj?LS7C^ zeH1qg}$q|9VtzEVftHbh83$=-D3 zOPkRxJ}Kx#r!ySPQ)N^9Cf;9)$w4cvAw|lxS}(+5x*IW5uY?U88o$xUxK%>gAd%(dpKqIm3PW?waN&`qU+| zjosoTjH`rXY^!F>dHMAw^=nBWWL{j$YW#d8Q2w4O`)zac_p*erE-njTrZiGmE`N$~ z9E~dg(`o6W+hKJz&TWOxIP=AON|L(tcNsR zHwVotRWg^RlsZrnS2_b0!6AAD7}Eg3+Q&6Ttj7sYk@eVG@}@Mc+x3t?72W}KSB)vE z?gLdK(KxH|i3Lz!C(rAUvX2n4!0fFgrWdpNulqU3^SQf_z2Tfr|Q;{W59jY7Wi^xNjbACVqUpD=MR70QiHHETO5nrM#%?^zWD z&BbmB?bZ^B4^ zw*~V!Ht1nhk1i&dV&fP@|sif+Cx+hREajv38!j+KXkTQG+|rw593HE{xGui3*k2**ph{Z$>|U zxPHm_*f37T!_BIgBH%hQrxqg+Y!~q3HM^lo6RWYScK(yls$iE8*YqM%7Jo&dDRnpq*P)X|e`i-xPRP)1{CAaBdsu`r&PX}CzN{1vNv--nC{jHCRxeD|C zL(wN9u$#mk(#R=Gk~!Dyo6XxRDYL}jCn8UZe|O7+A;yqYt}lYy_>jWALSOa5GR8rH zDphO#Q^>BS+Rx1xvJc7%?X!_WoD%Bv5jyCHzv3(DVmr}wOpf};hAy;cZ5!mJtI~n- z5AFO(F3dcZK|()DH)y@?_E!Wr5OyL_LvY35s$P=xI^nQIe17fSPoRg%8K&_&tValO zoOH~m2)$&=-Ke6|;T@{xh85Yb*zNZpu=b63zBwC{lxWpQJv`&dC*uTRvP_(yHB-mN zXffOE@$Kqv*}d&veeQjmHIxfXi>fu7Uam{6+11_-B|?m=t5v3pDKp!3yTxI*$%uZ7 z$eO4cyO>5}{wGhw6!_(yGQURqLD;<`iJ3sWbA58yl?_C;)Y%jPqbF89r&CZ-SklTS zphya-{>=$JtlGgsphKy$jj@*6qB}c%=(-n@IekKOAvDw#0AKZ@AXvSAl6Ejf zUU`vk8gr}0J+ShI>+a&BD?%=aqS}t5;3X6o;Edt1Hg=BoM=4a6DQXtO57;=6t53<$ zz8~OJq|_{a4gEIIeHE39)zo~obUGin*0{K0MwgP`J|~L`rooj432&tvS1Ee~u-nZm zM1wbBoIZ8phFjeNda6bxsh3up=JuRxyXv$|(p&iP;ww|Jia*dK{UeFT-7Z$fDy-kq z+r?;y5O#>D&5I$jJ+)+ir}aU31poSrN4LY3)D91|&t7}PDxExABlCW^vtM!=NK8I-NX&$|nAW@t%RVGppq? zm)~pm1$S#@QAZjg5>-T%-j_!wrzI)z152tzu_vpXM?1=1k-R>2%4uDNj!S6#g~z(7 z@9X_JghE%ck&V6bb`-66uj6c`q&c3T#G$|YuhmkACdTJ&8^}ke6z_h#(s^-pIM(c` zkQWw8Hi_Qbt*5J|I-a<`rWMC{xSj|OGA4D3jG4)QZ2Qi4VXdP)TBrmQ>XdfOc|?^~ z05oBfo!4pQk3;!7`43DOjjHq~TdXGSsGeCenGZ&VbRJCnW6GOBU=Pb;$(~cWB`kT zxFXFuTn0|-SthFwwo4?Zl68k>U3QP;D5x95J5G(xV(rr-$wieMk7BJu6hYw z9X^L964j#b3MT|>3h^%*IgRMRCitPny)SbMD>;0s0*%gLY$iFXLlqO zcgy2=`^P;$Hc7{HZJI~g7Q1cyIdOzPn2~p$PuF9&)85h?lMl7?nt!=loP31sa$Fna zzLjlVXOl0>L*B4$zNx%fH0kBv(0vwovLRAzlUEvf48&FCl=!SV_A%I=Ri5)6waF3r z9!nK8LW~3auFx}$=qQ4*`;!Kbq^T~OIUW#SJ3ktFa$MoKLO@en#u22-GmwdH*LM4xYIW_o%}Qf!8H^Tz;^YOGYL zR@Gb2<@UYTRY&#=CCkBSYi@uRS(?4R7sbtk!i=MNqgwgxod7~q=phjtSNp_ z@VWw<5Q8&5^my9unM+hwapc6vI-y2d6dj{C_;j3LQ`X=*ANteh-nqD>nkiAF9tHcihf2(r4*Fhp!a3II^S;bRW7=d3*RXbD|LYr7llVc03@+Gb zYtKQEok&y2wir~J(Nx3|TTR-C9GiSYdpwnqk3q3U`WpY;@Isw$d8B1C17h}z-1B!M z5q~2DvP!N_-Co+gG+6NCoE%-}+B$C7_0-;)t+Oy!WDQClzWDz7bnDp!31**Fe3pJw z!<#kcc0U|}&uG`ih1X~2xqycNE;NwJ)v`4?*$g>W&flViTdBCH@y)-~qSa&KhMta3 z>rz9lRG}ejLyTc%d(k?%u76_YUGnOk_Ellt4*3NJN%d-{gw=hk1{kX>@+sVisxiIg zSQ7j`m$$0(NDKA6KX<~WPG+Z0vlflR3i3nAU34tM-N-w zG9T@|L;9+8zH<7p!DlFX#iCt!Sioyg{?Ss;(B+eF(HfTE$MoIBSc=gfT%-6@H;-b$ zY@T;HX=Ua%WfC%DIh$_?EXshsbZG^8g52aLnG_)xKGuP?f|~qh4H3 z9Eo7ow(^)Di#BH$FkFgnKC04R5wnh&%*_u^83lW#{FD^&%{(HtAzxXX#tofFob5ZL z3tgz@-PL3fbc%fU7`Z=Q;!SmPQf{F03+)4L6nq=s@gS#dOhodIQ9cb^vHWle80-H$ zdwp2O{dw_|HAZQ!aG~DI+@Ue_8L7#&z6oCiL$I5#>mf5A<7g*o_DS5NV<*$D$ydFI zm&2X?guIh4srydZVXn#uBi$JxQI}5F1!!b8Bk$Qe?wpdS=JkcU5j%`hdz*Y%+zAjr zm!szjriI+Jq|7(%8o7sXv^Qoh;M^_4yV&lsnJL~e3Mz@FO7zzc|5r+R5w-N5Fv*xT@`*Xk&4hs4c zs$d7&$&Uw-R}CGX_V3z@G_m}Bl5tbC&t%IgjjowwV|L*#mYOrtPag|^mHG8ml;zb! z`vcBZ8ng_N-`_YMfbpjf`1b0g#*iT~%K7&1-vPt?@tUDX=Z%)MO7qSs*B?~K^`~SO z2(GVKAG|nS9s1e3K%3`|TYjMfM$2@z*ZHle^Rr*fLmcSXsK@?0FXAo}T!j}fB4yzw z1x2y8C1Tg^m$A8H)+lA2Y_wJY@?$+POG{pQhb3*t!`b+`M!P7pTl|+^1%vWz#BW?s zM-UVcgWExhhCR%__LSac)*5Bvr$dVS*4es3T~8dATnuyVyhtfyP=*im7i#3_U9p&0 z(&~A=shTcEj|uTGfzZq}D}hr5(A5URn>IL(aI;&NJG-Pslc|O@8?Snw?ZvD08&o#8 z)NZ$ET$t>t8a0TZ`#0>b)p4j;X|-=Ur|jErLa5N#9?aSHkFUc;I4$wqy(tm|%)C8s zFN0#8YRmZUG|NpxP*U;&OLr;7KCdJ<%SjSF=(Zaeovts%@F2KqOlh}UkX49i z!^z~(VgDHC_U;o~{FPr-&tZoxv-+Gig;@B-tAEF_Ua!Spl=X1faPArA=svR>N=cOz zanM2OGD6>L77XgayvbP0WU}iEU=OA}WJd}x3 zD;ULcGlMGeHe(IwhXx=sL4pT0+K@ukq$8z8KfJmu!RHJsK{tli4NysIYHTw@kNcEpaVtE8J zqwr>sGoD}5WE#l7YrkH3M$xA1BB$X4L9N{BGlviTo&0*yy84UXZaeaTp6<%Xm@VKg zkPr3Lmvpd>wnEgbvLcLsGl&?PfbpGo8RLe027lTec3RfR-38z89`^$%1)J?K{I@A-jg%=5QmOu`l2_tV{l)2~5JpXRwof*BE172gHSTQf z5*w0WC&mV5uHEMO>ZBG#mPE^I?KtMVRy_3&2UXbTeynyf20`cE)9Jx2{df!Kt44Ox zu|@T6z6)#z3MzU|Km2Xm88b8n5)z)wGtq#I|FNUs(a@4n`LU0mj1!Ebox-aUY4>2J zdpb}GyAeTqFhJ-X80$_658iy_kH&N~^Xk1XRa7>oP)n@iii-b0Fodyt4DmwmV5Xzl z)al{F%g%mY6B&Y0R{x)u52-NT7d;Oun%v9pdII*Hk<|Y_v*=JJenkVEk2JHBar7D( z6{}|h^?8lxAA@`zXHbBb$ULflw_|LkKiUoRI4E;CZq8PXK@;0q5^Lv0KA>|fj5Kjn zOG}patw67e#SNBwf4k(9N}DWX-}MGQ#}I*^SV>AMXbqhSW0{|LG9nKCedQ0G)+mpn z&W@_mbstTe&RQl2>NYg54GqF!{ctBpIc-H2uN5N&KM|9+y6n#OnYPLZTf6nN{_vEypWv+5y9&?K znX)w(@hl_IZ*XAnxoC+2qICuSsC?8*WnNkAOnqzvC|FJdF!V$n-ggU4>L16hzfL<+ z|8rbq0~7Q1v|?Xh$L}`nbx2K+L^pd?v_8U|GEqXbkkp`NtEjp1iD|sZdLPj3g4*WU zWAN}H$unu$EQ+re=s&L19FMr3s5F0gz#&B?V-Z)bad{~(Z7p~>Dv9J8+&ISP{HteN zco%7LTy!!zWR)G!T=_BRvF-^c_%j-E*e<~W*kvT8_M98h%oGz;YGlK6XT>2C%|2)C z{DJl>59hQj@&%lug;OS)wPQ}Eib!i+Mt-G#Ls*#(bBqkMWa57DShn{F+cGowRK`|< z+-;>Yo+{2S@x;-N|EwbTR#lL%T0{G2JKuSON$Z+Nm=d|!296sV`<{&^wpqp#<9moZ zUS+MAylsgQ+>Cu|$VSZkST@*o&3-b3-@XndXz*-f{AqtBVbJDZV?~^g?5M^Pb}9Gd zF^t-WtDXs@7iX+K(P#cPdk>9Kp+}e-py?JI>Cu!O9is1*VtNfH-QGhU_;yb8oC$nc zXpX{P9=@E`-~2MX{;};-|MU)U+IV#ofSTfcSMR)M-n-eK1| z>Y5$68S;5d+N*@M6kj9=93}#r(lGo}CUOc2+gjtswG0gZy6sex))}{eN)OJc!a*tH z6qA86Z6-HV=P}I>Mp*H$&`iZDBWi+r)B_{voy&POVFQQRkKAcue0R-wZ+}KS!_*lz z^2*i~X`Gfw&L@6tkR6dU=jJ3T!1Kgn_ZL%X^Pk=yN}c)VcseFOT?Kt~J?mD!vW#c5 zO)p5OC0xC;p#yyV=-8b&{%my2Wm25FcsB!f(N`2blQK0LR7dr_=K=NVR$&4zJ2u;1 zhhOkvpGDed!c-*42uv><1LWzRIU;Hgtsnt72U|m^2(e`Pm*oc~MZk{mSYxu}gtwQG zz}oNJqe9+wi68+8jr<5-k^+{9y98ZMO89HEb+1B)EOMt5FI-1hk`B_Ux*SF1d-DiEL9kp&5;R0nD^FI0< z^ZEXF7t8E4h;@!)qmh+ua)Ht(z5v^tD(z5I#2?gZiwW*z<;2?53D1VV2czU!f4^u? zo@V4;k(aCrX~O0}kdilF2$IKWywL0oGXnmXkj&~P)WVeF8c zNXEHkSh28QCtg?5=16=)~e*^uuh?AmNrj_?^?oCh==(RO`(At)F?bN%b$WR&0nIYZLFTCtS_J zM(5Z_8xelwfg^9sxgqq_$wH_GBiXv()0XC6Ea>})j>{O&XOFB6t~G>{(O%LI*-I%b zNG)uplAp79+T$>Zj7Z&#KKy-v(Ko?Qx${={v(#A*_|Bw!pU~3FPVw5!d(rP!#LMoH zp_JO{9m3hdz>k^MKk|WCE8eq)4<8* z>@Mwj@u)ZM0T(SZR^v|kNm(#V&%b8R9jADBEY7p0z>aSPdq#7`_G4ZJo@Y!=pW77Hw z!WsO<&jpYw+I?$B3jQoefqYCwK6>=|dcPYA7uFm5@(}Hs+{*e&Aq+$x0g!im8+qG& z|0qWRd6e;h+!K$@ppsfP>lyeEElv1*t^yg6EE{W=00v;f+<-jXv!`yKzX5(&CIvK0 zcMI=GP9mu0s+u?bQ`^%%Jl3XvNZL$CP5J1bUjuaZ_kk%-u!*tDJh)V*EcUhE|U zsM|aQfa%corhGCli{AYJD8+3dFMd!m4eT=t2omFQ0f304$Mv7H+pGO^kv(&^mv6lA z0Q{?S%M;>hJi*=glqW}{vTWJgC9s9PpVeKViR=ztv`c_&_E+^x&IQs<^f04<4Q@?% zpL(C+LCb0B(aVsV1wcEOO%z|o6@GXPT>G~Cdw|Xwrtn1K{o@b+@G_jo`~eaH-|I+^ z1W|!Fq~`l)V9MR5^Mw$>BYlt6SZ-hlbW)La(|^~^_Va%z)?$E^ag_tmLIm#VDtQ3h zBSeryDvTr+7=rSr)sk@-`_CJtczJij?O;H}_E;J!CHh{Fc#l@Tmj{ml3bdU~IoCj2 zBfSB=dqv_XFgM=bk~4Iaq9I7X&kJwmb>qLMvkdS|8K2Z1yFuKht6y2@e4%m3b;h=r zVC9ba@&+>*OUCM-eZ0+ z69JIViBcLFpbfUTSHJB%FS1UhZ)(F8yzoN3^F30Pf;i%RZ15M%O0q{YWAQrS z;zz)Z_76YG`^VZeen9Lhcp!;~X%`p+Zvs|gRuXEr6%M6tL97*W=v*Q&$34F!hs5hT zN;mbiu(x_)4}q_2*!awPUn&-t#~V4;ECM*>=rpotK5xzvG?C%$VN~~a0}Wk=fTkM9 zD#g#XKLmJ-2RK*siecuQ)3p$)ZPIUF_9*9GshX+$%jJ>a8-B%q4fb|tWMcBU8yte( z9(zXAc%RR^jR6*bF$KY0WK5`SR(IDu2^nBI|6*$Z*y*Yo8u8V@l$&~%0Wjn9%cls? zB+z2~e=Go=fiw}3)2)euKZ9M;$dSCcA|Ny#lmpOL$AKAWgvlNO3p{7QYNZxMP^1zY z@|Rv3Sm9~3kO{hfyjO> z2E>hRJ!-39 z3_yZ!MKGiQ+GkIIMC5&RaIftp7j$LTb`_^}bfYfk*q+As?G41Vv3$%eTAN)}yG;1- zIsX6uYnt*ga5W{-uKK>0tCAiKJLRE@_zH=fboZ1YCEq-MV7NX}@wTQISj2b7B6nOj zYkV;2Ii3rkx10^E7nZPB9Mtz%+7PT(02x$RFk`;mwIY9Yx;?eS$s(l`F<`?Fp;F}K zekhM``#GbW{vW>_%108I?4sS7U=cuY@P;1q?yLrueRr95C!L$>X(a$)xK#kq*9~rC zl{_F&natVuUKhL#Zvz_dLREH%g{JfcK;FTB_jW`fMZg1fuL}@x-Y6Ye5UF)sm4V(F zHn{F8Bbt3e@s*-6ga77Gf2z)7RB!s1HBw6V93WZ=3(eiD2#_mciAb;I5c(JUJE2mc zaj~)4!2Er_?^E^9gXvFu(*^nYy^6Sw^ecdoYEvTN)sLQ*`>-Ma@l1dJ&_t+d_O5kF z!+{pH{Fv%@YZcqCFJnGSJc;F3!Z}ch7qv&N!G{DzH z8vccXqkc)V7x?=A@!Ghh7r$b&ek3;Vb|B%i)kV!tHOHOJSfrh7DnbQVv@74*tT5D29?1D;WpfFB|k4}3uhK&==jCML2g1_k=Y zG7s)4zO@wxz{-^`JpMBTyw3YW6Qv%Du#}c4K->Z5&$lp9u6uCKZ2Aqb-G0hp^>@`Lg zuN!?YKT6Z34eRou0Hiyl$i0@H7<&3!v4dpkZs74QNba>$W(fcaLz!8CGlDigaPw5B zcSbV(^Gan&d#|$p@Yz1>YJUIC?RV*^Vm%1%6S-D<%EjS_to!EegtyN+II){v?a&z#&6rM@C1 zRwmHubag}jO-KGT#Jy0fs`toRBez$rPd6{DDaY~Dis^m!OJ4CR9<{tMVw;%WzFrlG zUJ;u{vZ%90ZoTSc4n%$MdjhVg^X{zhx<<$lq-Hl+@_OrsE~|t2i$kd&HeH?@{$8im z5VVrMB2Om{`so3&L$kQKNq1iNIX>1BON_CC>Mp-4FXv1lGcBp7*DRF=7MEsmQ)MQ( zzw|?fZsCwLUk7>Cv*4)#?U~@Ig6}Bi7}v*;1q_|jgKL_Z(14-{&AH1X^|(qBO;gv! zgrOSKQ9XJJpKyw^ouL79cyp>*fXoFsFALlZLeDLTJIkQw1ex6X87%OJmLR%NXZ4q% zk%xYoS!K^)d@G)+@R0LUxyWDf(-ZE5zNA@>ZgMdg+YlhK$v;r43^Ry_NMXs#@J*#>b-yMY|CT5x^dM z3W=e(eTjOpc4SE*bfr?|5H=@PP5eo85OgY+fX17d@ol5J<=zHvM z=P%b~ZQ3L?w_)b3K4)`344RMqa?=$fQ>4sEn<18~J8)OI171F_je~U`^0p@lTrpYo zAKvSrt=`X>2_s>-0# zeN`?+91!cX{DEg(e_Um;uzgW1XYgx8r?$0n#troogLeue z7Rzi$PvgmQ-^I~v@cazMx+=^RCk-kk7s$F4IK;r#$!7K>Gr?bocW9NCTI2oheYQQt zc5_&qtTK~HRw?Ao7ewwaFb6^$(B2)`T>TX}4;|mIt0r01Li$!Rbmv=Z*vw+xq zH52i7uE45`7RZih4&*`R)*UC`k>=Uv82voTz%3^??Iwmk2x{}8iNdRs62lxPCOF0U zDlJGV@vX+^(9^)Lso3Zw?H@eBh*%Qn@cuhK`yQLcXX{X}eK-A;M_Nx|!OiEXf@6Qy z?*!M~;`a6qo>yyDod)`r>P_>_u#O*>jm`GSD}m+8mES%&1q?O=F{HD!95Dx7aE6NK zF2j2ksUGToc(onDcfA{kY>pCP{gM>jGC%0_x_uA7iBU>fc&5IOdU2#^=67lPRa7B0 zOG(=1h3k@M4!+CdO4Ub|%JZ`oAt0%QU39k0za8e7MvEnjkFl?suyv3mBO` zX;=;5aDU~_jNzbR6KMl`5l!o@|h7f4_KbK9Y*g^{7rDSx1q{y0-22Geq~9IV_bPB?FR_qSsb_VFWBr7wGQn? zrdBI7pY{o;yr3Q|WWKFq8RatB%Y-;lTn2oLNLN+b9R4ky#0&ARKic9tGKqtSo>eH@ zGR0}>y$W>|Ps@LeA@(%!39<91XW%8LEGaF6B$j@q$!)%DD?yD9!x7xoZ4}!9t#vaN zc<*Z2^A-f$Qu-4GJ4#I2;y=AL=W-U}bu*Nof6lflUb5sl9d5QEp%=iL!Q5wjI5{@p zjnzO!63^z>*t$r#{BlD2@X?Lx*#!84)@e@& zPA&itL~nqv5zO9=GmSH}gV-Do0a1$Jmk8S7t#p4ayGqvJIN^A=mopskC!UUXit#NW zBfK77VRp+o>U@2X@H*6+_gh2Pq9}6f^yCqSG0(}oYFsz2P>4BiI#MlDoKRo@oF3~shG0<5&{L?6F87cpepD3n zo)q3f5*|}TFCanvFXvp~NxuDY(GAwXbF=fkV6to+&=Z>Xhgt^t3EI>>;BD*PJvV*v zPY3t^_e}3c`Bx=$^31t%cw!W@9n$=@YzBY$@sjzNs-x;Zo@am(cQJ-Z81C*`f- z-`4pBvU!bj`d^cpu&To3SBtB;uX@DFr9fVuOVOv-q$*l$_%`m!IVu)#v+D3o^!z-% zhM($1y@cTceSZWih+WDzU1nbxjN}zmWnccNtV&f=i!BI}8O|%zO{MU<_WLCkHB@rb zmuH^a)DkJo-}|t(+!3iv{{kEYqu>H1;t)jzAwJ57`Iuf_q*;8- zAvNr1cb+Aw*xEwzz6CXBHalOoo{X#Dc|{q65Z9erc~-IfHobc_ES5C1TdpF~r6;BG zUK7g1JsTD>Q3kd`AA56EB+RE)4&~6&w@d)oF$hG>7<$BD)$4f<-X{V18$X`tAz6@0xlhO%Cx-z z8R+;}8~Tf8GhU~VGfOz_K$0+j)5UVPw_{tZ)8K7HrD4mXV-AbpCp)v+awqFzmYUGE zTZ;PPc!+<KY`{IL7vamS)D(6nn>+p zIk#CacW9FkVoEPNec=EB(H3Z^(NIYjpTAHUY_?8R%1Mpb!H8QT<4iGpVH<$J854#X zy=H6)`Z!dywmX!Z|K`7|iW^?QXs9ddX4oiGCkD(#@S2$4AAYAYj!Z<-XR)H^UB%K@xjx6~G zVNMr#$ud#@ci6S3suk7-wUUJmn}@GxZG-S!dWspPU=x^IVpawx6}_chcV#(Nx6>m!46jb?Ohi`g>T zJf5vu9^+2hy_1yce@@UfWMv|Q`CO$kV0&5ogheNp>}(@wk7l)SahdLT6ew8Ya0P9k zvX;zHz==Ex+DBP$jbR$nb2mz(kASx@cw zcbgPe`So%p8uUS`Y=TS&j| zR732SAN9qtC|LaRP#0M8&wQ$OynWwxt3R8n(cIDTx(syj2Qiy84I^4ze(=r>YWytn z5AzoAGi{F6C}9z27&Q^p;heMw@2`>|m%5HtWk>T6D06|;pDU!uHC_XtJ>op0SS$^< z8SA?_JJ#9~BN^ASGGP6|2eWmNN?!jlV-fYPBFp<)UuviCB}agAnNbNlp3XwepJ8u< zI!6zIy^EDm{`FsCGBmG&inx9e0gVQ7Xqw*O(Ig_b2i-prn>=DHqh%5~i%gAmgS8UL z6k5o#8Ke_)wEOx&Yyu-ex~=rpQMI?2aORN`%{or_UxqRM56Pq@>(cNwpK$8AaH8{_fRgF#FYt|vCnD-7bJ zUv>7>xWHUj-f4a6#Lm=6S8TE`C@lQwwR<`PxNw_;0wg&B8O+ImU21IgOnn-0uH5Z) zdu66@_sJn|XawXMNfu`n!snmxIn+D4=$&lE?qL$OtC57qRE|2BavYn+It%I9q0AW@m$5bUr<~2+_f&3W2{5h z8lmt8%-iak>go;>aHq;Sc}vcXv%xeXQtEpSE_P%9}H@tq;U4xZ4|D4meE*)?o^ITVoA&^{eMJjk;|S z0tFk`7|@=%y+_9lq#(5YcJxG_U1J%EyRzZRiM&j@9h0U?0App)AJF zeBz$NoH+H1V;DXh4qK${Og8D%9~UD&C}*w`=dq)OnuDpKPh zGhw!Z%KUt4HPyk270n@LiO@Jn!&p5e5O&9WAGep*Xgvuv7P&++X@pUi9%4=7Gg?YN zzF0nx5~-c1pQ?A(I?h(tmHVj`+94X&(!<8MgN(*T!~H=fCEP^$R-~m@VOkyDqaLgG z@!*Mu_mXVKw>0@dVdZw<1(I%w*=J)lE3S$?)@xar!ob$BeHcxxIZ zz>;$OU<>2_VeCAkn%uf}z1^sQD5ywLN)!Y{nh4S%RuE|lo8G&WfPi!oRFEPiB2{TB zO*g%TP5>d1VyHqOK!i}F_m%=@<$b?zjPv7+z0W^&Fw7H@wVr3qdCluSZLRI4{{+{P zmHF15QTSPh8bUCJYxcRRh?8XVv;%P^!4_3k^FvNlA}xFCrGvZp=a4yNkrF`!T**`@ zZ`i3`vT5HBnlPVx(pn(JtdM7TvYC@%x3<;v+3 zw@AN`I+s7$gzbkaMf$!%5HxU{A?&p2Ib=36+K z1)eK0G2+f#`CEP!dMr&r%KvH&-v;JHK*mGNYs>XLxmOIn=@4}DYEj0^^Vz^yQAVQ~ zQEukKN<5topRc$gHaZ>%*FF#rakpe)&cmNyRGJjOXtPd^L*q^LB+(3@s@J&03N*RHaHI7)8S$tN)uwjH|0)@~d6 zJD6eyKgV^*RS_lkg4yxFKHI71nPp|=J2e}7X6Z_6fo-hvYU51_(~7a?8{hM8QD?f7 zDtq?>#}F;Loy~e%EQ-&mCW&zuhmd`#2b*WJT`E_|^VAkk{8=7S=>ECcMxBbyejL6< zFT{ap7xFpSqsbR!FSSSh_;sr6cUwQ>Mz;uud$eT9w6ZTTnCQ#da7XM)Nb7#)AR^&l_tUGPkdzIyrn%ezE|z@MB!Xggj4kh9Ci{f{0n6octVq0~bnbXBp&gSX=XDFNBB` zu{~%g@12&Sr6_H@roG%s=IHiOlV1JBV;D#*JG>LP*ZEwt0H%oiq_R?N{s1xyUUPyb>k#V8@BJF|@)r;7ZikG^WcoB(>x6F!Qt!B^^)_$js z7Un$s!qvb;IW{lR&-q)RJ$mJLdexcc3gRF-D|kw3_(-cpxjb}7%sHO{8vK`CMn3U8 z*G@oo8)HTpbox`)Q}g88`{byj=EJEQUzVd1i%h9P}UzV{g#usr1G zqINP()hux>LpuA~I7cUO2mejSh_;&Aw6R^^TkZXJMTVR)sMkLR>Plo1vxz+eo#U z-5xnD_xtF3kZ7U6?i6lgH?hS6WZ=c;%gCJ(;0D5mDsMOG?%jXG_Uw(%pJNI8H#jIZ`z{^hp{NaZ^@quE%-g0VLik7(D=p+kf1Q(> zAweyC<=WD`YzkKKvddbtjGWE~@@Jt7sb(x5Yfa5b&4__LSld;9SU7ZDSlBKc4OzRG zDBe_xlo2K#aFWssO7szgJCVkW^@Hs*+jmyFLKJhWVM*Nl@Roajl?#D2x zty{8@Scs<2tn>&62)hIP<@~cpUhiP{Rm2azv5NoFM%#pbCJJstrmtj^&yfX4r^#Bd zqWRjBGH67_^IiWCr_VFP1gXuN9cs0>(dMIH&!EE>Pk`s&43>9yYU?h=XJypUo)gMeNA~#PTOr^8#^{`ysT()8t~8L1$@+Dg(Pvo(6If(6QrL zo;7$j8g-a_{%(3p7Pz&rV3d&Grawz1auPesS6A-Qg!ywM!q{B)S>?G0=4rKEsE#|( zc}nG~9IJ=pyq}M|yG9w0cGM{LoS2ri02|Ltq6S*zXwf?B9lg!;9L(A`oPk%V{3+v% z)21iCbo*%YN8c8^{PxUL@#XWc|BX4}dE4Ti{%J1$fX@%#di3V~Tx6KGoiECIbrsA6 zcl_mkGt}^sYETu;#xH`#lrI3fqf&Hnk4wvoV-I!&z2Mys4(J)DJ8MKJ2#2`_s+#ko zQoo}B7aQ;L{q2?Adzs6|jB&E*sp}xJ37;z~Q?59*V9Mu?Y6cDC-JFk;yJ2S!~srvM~JkHeuLv-pwj*-6k= zT$l`At5z0YNqLlbvmtpaRtEPFG!pecef2d%gHHC!SKSje_qmcVhx9r3=8ZVdB46*S zk9c9zorODYg3(M>M)WRIu|#3*Khqd;qA%&>3q9a!S1G=E;dc&F7g!$A#0T=A=PBzt z^ktjgsy?yH8V-yHc+%sQz%TEMJnOFYW`=?HZST%$dGjC;&=Cc_0CC#2n(!oBhH7(9 z0teS>H%QNkNpaH^@IRde^q7H${GH7Xo$t0Qnrc4m`T58T?QAbP_WqFydZF&;!R3x$ z#T$P8$Ij?&H{o?~h2$BV-YnHY9r=mB*7`rFRBZ2)ka~c_NodjvaSsAXWrNaKUXsFa z4e#ss;SE4LIRIwQR+^Gl7F8E3-`?`yw+yB2FcT%wRPW%moTl;qnR)0@AQ^PaGeOwc z%jckZJ2%MEE$7@++~mFuKm+&OAkeeUcPptARz0F_EdUGFR&>AmBMIRUvP(3+?NhOnnDi^95iEwAi*B*%U_u$<|mG z5GL!9t$d1pA?Xox>P2?ku<)OMtzts!AcH-h9!Z_)HzrEwa)fetRRW#`0Z;`la4v60 zf{SAryz2!33+aJGr&1_R23(PdcG@q^dl9Ey(vk&MKnq;&Tf`Z+q$4l(G+EkaDmo)A zH#Z(w1J+3&#ua91C+|*h)Oh{sa@D#Fdd4Yzr#A2WV~zD=$9bFSRS*s=zG!V|XqW?N z{es}JmX{1Xv$wQu+Qc2`>mDS?Q_9C?ya9odMQjS*Qx8hOScdaxojh}CCZB}sj59(bFnmxI|GZj`T}TntjWy1apU3Xehk!Ej=0-28S`vEY5se2(|~>%u>8 zBRtV9=QMZ|_QixbI5-w6x+M!!e-`LLh*luXx@o%_29{j)C@ihF;g5v+`uYgdgQ|*( z3iUvq>$VF6c^-d*jgF^lM!mdpZW0$~XQlqYCh6!1BKvl>s_hOjK{a*~m<|7(qa#+-Ju$z6*02}iU(p8CnsbfFoJjUNkj~^4^ zmnH)fbdvZMojn9B6xcr~yDKa4)jMLw6|c@;R9-F%n~&vFMkQcsy+|rBaLb6>l)K;d z`9aJ8kp0e-^8@ECPumQpvNdLBdqm}=CY!@V0G}7hWcc_LX6kz3KYzC7H(t_78-CjV zq9p29)u`*==>FDVG94!AwI+H8GW_^2-~f!MY4q)~%C6&02s3}G64-;Qws6V?z%VyA zC_mH{dr@Y<(AYBBsKjDn?fE#^Y2}j^;%p+BrD(UZTh*Wb`F{M%@om<&xHra_fBx`M z_x~J!=}&k2(YYT>z(lDnpoj=c9>AiMHllQdrvaiiVCtNi{E*F*=>4R*uDdjpwzR;7 z-hWUJ?ihoj1sU(a{AwoHJeu2;nKWX#6S}&))7}0~umX5aJ$18tYeD-i?!Ao2k4)te z`$@od41&P9?B0<#03Z_4qhoF=K0mMh4)?a{YZbYW^hRdRFHfp zH0e?c%A2`4@k-a>fFe6GVSgL=jVCbg43aB3>b95=*e*DS%YK3wacX$~*LtPA_)Pu3 zi#2z<;~c^qJ(}VqR-}irF!-u^97-ZCgi@}#8sR*^GQIg+i-mTnauj8$i@yECxaLFh zz^en4>&d=5HI|ef)abREdbeW!<4|!?!yNni!t463L}_CrpT;}YM`N_RrLM^frtUhL zafZ9N{r<1GMGt4yMDF#8cp(oc#%|zl<75{v!`@Ho?Y=ym3AX>2k<$|FX2cBRy{=#K z6(R3`X5Pu=Rl84fZ!l3)nrJAfa?q4C8YnN1-F&|`WL)R!SfU-R$C|d*sI2tK+!3Z{ z*&fly_$9Iap+*6Q+N$O|iu7uP&XBsP9rN+Se$__tYWLN&pBlHroWyh7_q9iLhg0}# zl5?yM@%g2;Y!mzE&YkY8aj+hvBu#{F8yj)Q3OiJDAV$VA+qQ4XB*IPjjIs`O;CN^B zN8P=N&Fe+IzKa<$x`;a3&on81q{IZ#J;^6@Dynq!d{Y~O-9sJzns81kka{IaLj_@u z^mebz7B_EJDCldSZ(zsdqF~)k?)!tHguNW@pXap9V@^PA9zbk(tlGowH?49Z=H6|s z+z%};xL+Gy`uG`|#W~h=$=m`dTorQHy5Pr_uWxlOhOC?E2 z`%OzKOb`1))2R#InthE#dxLOk?m%2T5a*K0N|gau%*cK;vP*=GdoKTC+A$D?#e_qP z?By3@&KJ8G&CImcWWl$Ecl0_1!6pmN>4AFF>U5GW2JoZBCBr zbmg)UQKaro3kd2a9(fpk24$+BY`D;@&x|m{+lJTUM}8CXj_dMCCq5nBCs!=F>5{7GlRq|gmLeuGnBU|~anRVCKrR@?*I(14vG$*~lQ|AK8*-Ts zl9T<8e+BzarRRpQPnLqO+3Rw8d1P7e91q!Q_|$#)GGj)~ee;ho;V^|n_3^(h5M-PY zX@2A(xf1h5`>}1dWvbKCxB_g2i=qI(E;Yv#QoaOB{}~BgkG!}N&9;o*|APw?w>vy} zV`jW_&$I)V^bQ1=XQhlm z45A0?l$&jIH;OnxW?B$i;U2(^by1wFUeA8Id*Cui)XN^LUhvCS_N>SzoRfz|N_43c zqsy<2rBmA!LNfA^Y0%#-Cr-ZR70~Uf&n#jE)tCF?zcm6)5;ZP4_KD7fm%0zmUyJcr z-jmkV&Q!ayvj{`ny0SH=x8)O50}H}OAs+DALO7WYKWahuXf2EJ&%f?R5bh1k%WDHca#D`@J z_I}80kb5K7V!epTf~@`EqR#U2LsgKMwQD&o?I^-47zkDwxAi94n!!YoTc0cRI5#M8 zyv6u2ZS4NG#h&Ep-f|QleE-2}TSxmK&24Dto_X_tq- zDW+$0O@}l4zU{rqJ%r!*rW`3@*Z8ps)Ey{_E1x@jntBIO``WkgmX7nx+m7Mn@1)w8 zJ`}IslL)T6?=7Y*dfZ728zi@VtkP_Mo+N5v3BOSuE`C$nCW6nCLCYs1pKD~vDl%_= zsf)v>i313NE352SO8oa%Bgn4;mqT-HxxDgGx;%pWj~WKCRPy*(oOe?BQM0c0l~(C# z+ap^(?O6F-L$1G&YKQ6+sVW30vhV9sG)%`@NaaH3 zsX1!+`_|EFc246WQZ|s-)S=NN@fx=fOnsU47p>sFlzz4wnC43h?i3SGmn;3ocFYXz z_A+q28rX8UPt`@Qe#Vec)NK^c`~-^n+P#EZ^q$PuvStmPVC?n}{Q~Js+2=XW`$9!mE*LCHClU2}srvK+f_3k@iC-dlm4_T8*Rt8F$ z?(@z9&yxAB1sqvbpE(YW3%Y#DW2`RvU9032pPb$PZ>$KNgV$DQ1dW=I4K(UCYUU(F zbv4eStDtORX!CHCf@{-A;fRElQo(mJ=a`c&#hKH4fRRT9bbAKC@Yq&aH_%uZ_ zp1pz}j5IyH;n}#M9t8A1F>}=s?Ia{rjqZ_udaZH%5S#+VK8##CkKRl!%>{!ooM#-V z`x`q5Y4g8aWOP-gqXem`eI0kx6uj($fIt0>WA&S=d#sA>5H>^cG(hAQBnWD7cDr)8 z&@+iIfzxEaNkDcFJtE?BVDS|%e3`8aC>%&#I)&_-&S4XL}t(4)_v*5mW({P5o20zZ#GND{g5!|hD;_$?n0YRq-! zwbafL=;L$H|BY^8RsusfZz9@^qv(>q|NNJHRvE;kcgkyxgTg895nnk@%~xiOq`U)< zumlm*qghYfLWpxsxb>lyne4I2RFlQDDrvqWkouhjoZ>ukP8`KuyI-ClM{n638F3i6 zv8l6%7dO4;$o`juPgIN2IdCFVnyT=3b$#`0A_^9?vW(f%S&LHnzww^`_n%*;+hF9U)y$>)$)PG@6!Ai}45W@*uy^^vWid5ZwI6K=B zYAXk(^Z@Sj>Ybzf-f4^yrqS-E+i+34RE=5TvsjXeu{OQ7Lr-83FEq>rLGTK`0E2%j z4p15`P*xSEuSB|9{@}Gvxe2GFMOwa2x)J?HS3ueEt9gyb1AE(8=OWMIwi9z8LdH|)=%rKh&ocbhjcg0-xLdis3glF;H&;lY?;@H^Oe|8c2!jAQc_3sFmk^+?}WBR3d zg}5!o41uyM>WxCoiPpd~^YVG&e#Aa&tJJ@j5_Q-9C%8b%hytP>@<1Wu9oY9yj;t2% zG~j>KSzaRJHfo2YzkXVc7$4>f=XvL}=@S{os&wrL{u@kuO%vJU_*IoQuz^4M{Kubc z2Iu*1M66l%f~D*$TJd0!^XQ~!%>DkGuMQ^zp_-~SqY}xN&Mphgd2 z-O9Ou&>pJpmP4_RrpEf|kCng+s$74bq6pMmj@ctKL6g;jcSo22o6gh_O2lLr;v+4w zx84=k=(?1{ovjTL^)nYz-e;wDrd%j>`aZMld^!~ zlX7|V!E7X#Ro3pr{0;fLd{$44JlpRzmFpt*jh;SR+~#oUYmsCQO>=`0B)3|*FFT^H zN-+vlwhG6tr{*c!EGc;2t-lqWx}~DEHm*3DYxR=V@zMVF=5OqvOfMA)kZvy!{F$$M zNW9}D?krfE__J4TXS!j;bLr=>1b$aBs>nj+JWps2txS_QVHh`E=2jPyVf7#dxgu$q zsDpR(ZDlw?@!?51!ZkoHMqVPI%$LtRa-6NG>YdECBGoU<>=aX>RzX+eF6|t@av`}J z;q5!-IL|P=AH(VUfv+@Chx$#@h12KZg9l)OYG&Yj@6x9(ziUq2PYHLM?xtHsE(9qq zUPTllSK|E&lvgJDBt2}Aeo;P-T~~UKNT0Ubpjln83kQwV3hTU=47(;rFAAb+Iyvs3sH12G^hhSl! z7U0y{DquC4C}M{+%MgbN&86w~K6+XyxJ@-P%gXCJ3$(9QHd78uTesA*N_2gV5N=B~ zT9(crCq~n=Np;j6zt-AglNnd;%lW+SgrzgXiP^61F*AG})tl!rKHod*4!TyMWruKsjp>^HO3ad}9ZYGs9?4sR6mTeP7C%h?AW@SCxCdqCC5^*Ya z52E0&tCc(J*v!q;>?K0#&6AhWH*CS9N(s|~ZSNK=#6jFEIAwMv{&Tc(Tyyaar&@{1 zXeswd9n9U`2kz)Y%=hQCGxGVZVKJf6euJTt$thA=7^n0ZuS<{GmpYsmyHPo84Uns5 zUo))G-$(o7xG|Qde1yhd_Fe?! zx&_iZ3L6GLyjz5OC^dtt_vv7J-nWP3^&dOK2R-SyE20}DlzBvh_|`<6wr(4GjK*7ezW*`bRs`8Y4`NE62#J2#&?)QPK{$v{_)J0-x^ZfOK=tgk!Nc z%!7jQ1B7<>ob%21A)@YF?%DxsJI~4Q3xJY-zsN;CMI%HM@XV-+gNHKKYxb2<;fZ6zE8m3^yh+u;I%VvlOZw?FFSFK6sdHlX8@ z>on~!!}ay9JX(ZNHtg_r^iya`ZGyAiQaN~17rKCYFcVC8GHiD`7@Qbh!-X(meO@@H zt6i;0WLrjq+_xkR1580qyqb8XcUO5`&&h15rfvQDy)2Od-LT#7vkodv1`kvfV4+^x zarL%V_E@Rh9))jN_Gd>J9C?vF3w|)=v9z-9_R-lHO3xplAMqG%w!-qmu>^f~`EZYEBC@*(SxA0ElI_iC*xPw9WjQ+lXlkPp~9p7MYw+Z z$eh`4cuGn!W7zNcYahQMbdI*qnAe)rJ=J)=>FA!hyP;xUF!5P!&Dd}J_HVW%L8RL4 zi%>M_lBk>KHaF4UVk79`eQoE%SMOa~Sm6U5TwKUZDeGqVnE%Qp_cR(g*jO2o=8o#7 zdRA9UEh(=kw3HV7Ha~Z7Ii~K7Hzkagg(yrq4xS5sL*haNXS{aBKG9LtP5ck@=w+R_DCRZ8|+ zPTAcQDQkB*<2)XOPoU(dRuSm&y8X}D1q{1K`iB9Ru2;eKJKmMcB3PCwjLilzGpa4_}YRJM36Hn?hE3YSmtdITYE7y>QmRg7aVdI9ZkI!gUCLg?Q8I&UM3oGpD))SrHbk|$FMlm4Y_-mi?q^XQw=ef{PcbPfY@*izFLW$w{uBD zN@&F###)x9R*6r*zjp;TmDwn7C8O3&`U_OFHce~J4A{IEn%!k50i!q2j+%IVgS&rQn$Zwnw=R|fschRHnaYyxTg3t9nQACP}O6l0g*8Y}rSDwBN(H-Ks zOQW_j+VYt{ncF#nV{j*24Gf^`xa6Vve1R6W^|Y3w(Ov}VtHt9co)>>$)96wF5yk^s z8W19U0R1!viW96J^i$|lk?(6so?yaK3xwcFL5H}THVbn2EK(0%d;PqwY+n^-jAflz{=;IyIzTU5ZkY8|p%2$(zbgaHmIboZ+HaeT z6AHGM z8Wwm=cl`@8Y%Lhl_)1wQFXu#CK-9cSkr9e)Aud>iv#MfdtXDLgqqMZGX}_gCbg zpZ#ssImD}DYdxs!ev<<*F@>?vba6IDVU^^sJdsu zDNmhGZIn!j|E~+6C7b28uuG>PLa)+0^RuNmoB7aehJ^Z9t$(%ydi+bMKvvD2iNd4z zu76*T)e3YaG~Y9;cSxxwFneGteninsGoR(){3rSDxoS?aFxVlbZf!(v^0R5l!J<8L z`{Vl=ISIGi{L`<+9O`5y%+pd~Vo05o$!u6h;9HxDv5@TpeuFn^@oKNX=bY)ApU&Ks ztctlLl7!Fm#4um;5+tp}kg7Yquo*Dv*$6uY`>-FsG%o4mn?t0>YqE9T{E%;Yb@O*S zmk_>Hge-nIYkxDeobPVzdVH64x?DDUq;r8Al?qVZQboa8Y>fqw6 z(iraWUU3NAcIz@tQ%mW?o~uo-XVF|{-+%0QMOsrgxG$TV@J-nM3OHG?aGA}zC46gs zrhiG{sR%N0<6<~u z?tV%G#(~)HbK>6Z;qw-48LzpVkbrq$2Auw(i2&8;W+f zBX`P{G6em^bhX>hQWc#j0goTE6(&Uu6RvEAg_OUA6K}+&)&P(q#cX zVFeyi*tD#nF4p$Dp(PeDd$+jEUhmbQWn(Bwx{U3h*`fJdD6hHw(VG4nVDghV=jZ;4DwZJD1)Y zyux@CQ`lPjX|0M6;iWwrz^?{9oLTZ)u0DwxzV11QBi{`sJ#kYbc=h0AOo!|2{nN|d zyU*uO6cq=EJTh12qJ-cW?KMw7d=@t1&XeU5iqWlYJNXIC{>Ytj=yI?f46&9V!f)|m zioEPK%#QigGLLQzGUnyPQ}ajejVf3LK;;Sj^HE391y=GHL%-9|K4DMwv2xow?C2+Z zSP}8D$(Eg>2D=};(V>>e z;vQKBtw07So7g2?L6=G7SR0_6OUKJ`zC~;x2%M4p2Q6n{@uQ^YS`m^`uBI$WV)4~~ zyGyp2#>={F#-xdfX2uTwvP3(qcqheiNI8iUJ|L-=KNfo(#6mQOVJ2u9<2c5Oc&>^F3&)2L=I)#$<$8B3A7sNC&Nh8ttPe(>3Je&3kyKr}X zk)6v$gdb8atGsKISr|EJUj)Qe%?SVKWqOImpDLfx!NKJ)3wUVt&E>&Z2Ct^ut$6wM zIJXc5@1|Za#`FxvLAfN7g2s_~`DcL%Kgxp(Qld@4YiaTO(~4PagHh~I}(pd zg-TZdB~8uIc5{+q?|n*0tp?2Ujw)hd?7fdLMaw~9ol3i2n0+cf%yO%fAcZ0K$kC4P z-f%uDP`y~7a#D;@-k-~llZ6&Z4I!8*k*q^B?y+MI!&FTMN^MSpApp`J_Uw19XM(T< z%yVoL?Jh{9vAG1m2i-f_67hfN>H`rIaj+>(xCE13b7G$(AnB{t&X%738j8Qzl$ok0i;_CuSb7a&3_f9+n)By zA=F=t3!B|io_?bePoA)co7)wNIsM~%dRcwmrVVIFJk}dB(%P>HC;N#hB%W{lwgp-v zr3Gz+EUV}v#F2UbuY?=_7pM6gJ48+qD*}m<5PxDX7(}bqJv&XH6MAdmlv?(1V{3Tz z1fOTk2hMY=mjO@oZ9pDSnbo@SoT7)(!d_h0VOL!wUrrYVG+v{e^9H;u*DXx$1|9k0 z2eJ}6V^}nD{0j0|fwdt);-@?@q*AYot5`ca5O9$_Ieh?^`A1=lyTYHwmcGfV&Eylo zrvr)4L072&@OZ?v&pa|t+S3ygpiPp|WMp^e5>S|_y88ZbJ3U-u5rF$2h*Pf40_ARM zr|-Eq^mRADI=Ff5L1~je z?)?ihB~W&SNd;Jp)D-a`FzGp9J%0vQ2_wZ-5BEuf54bErDj#2Z7Wg*MBe4Ujm(1ha zwA&_tz{~}RrglBP`|a@Wn2HNe{>0p$z8hR_PeAc_)c;`)(nB0_uIs66v_A&|wp_Z1 z3}}vg)uhKBYBCqUX;HEIoS|vJ-bPq&b4&!dq4U@e>u2**05S{?%~%D&Obv5f<88O( z$NAB(!~WX;XYNbjk7NAjx*CQ8?$3fDP<>DD8%)yCeqh;9u1+P18mI)qyIq$tSn1!Xc6g z=$L$v>T(Dajb^^fuV)UtWdXb}ABWZPx&;6kuftcsr})s^v&q-zjV2cKejZQ!qs=%4fVjxDMyStl~3A3h* zjfA{=%iN}SH|-&r4vS&{-Z}}=gopG+n8d`4^Y(9kR7DbN|cGu)`H`5vd8fMmB22Lyx91jhD^%6Ji8k?*UXZL zeX|+Rf8}0;Y+%juNw&X}xrdJ1in%;|edV74I4`Dk1?|HRVvU1rAhhSUPfYE9sZ_HU zo1oJ(Yo(noS9~HskV{VZ6vwCxu_c6zXyC>V@24Q&1(}NM5&LMc>pkHMbL*6 zwMH8K|521LC6ee|>XXfl*Z<3k)%Zi2)qEP5DI|*FRbjo_@Fu8dr~+wQlgonLK^ze@tMB%=BYN z!q{YQu1w8sSlpkzM}nqc3*M~5B<0X|D?rk&hI zkkZLO3Dx+{7k+#Rv*)gJrjezzNZa6=TU3$bj{uHD0P$AQfy@3JjRJbf8@}RZ?UswN ztfhbBRN?LS^Nrv9%7^R6SjRoT`4cen|zE4c`_0iWYME;_n$< zT$1+Bz^B}$W5N&oK-qp9!{eC?8tRwnyYqu3Kz^nUfUs->V0San-YoX4`^-_*(hho< zd6E1<--$B*!2F21&E_L1Jz*HqRoGEKZpYUE9AyKYBH0-LuRsf}*3PPiz22l-`5e1b z0<-r=LTMvyMemkWu)DgZLwo=hEpt zfJVqlQ6+A3`$idfDhkmuF)}hD3mSam5{{tveCKePOVVqAKUkn{^&;IR%oUGK-T}du z@?=XO0LDV83H8|^{d}-7aBBdVQ?p!MT?gp)Nf5|A5Op7r@#H1zqs4`$pdHtw((oM- zfUfR17rgtIo73ZWEnq%_eQgxHFl7K=ZadySdCzM%@WoLpy*-#oh$o`O7)>@@VqvALYluW#c-({QLnpTPpv}D?i5ljZzf%`KjisQv2UdPPOU6M{N>oY{~2* zxEq99DGpK#x2_c$nKn$Q_OIAT#j0oe%j?-dsD&N}y4 z__SgDr0XcnZsNkPZnj4D0OBES3pYd6_<<|cpO>7|dqBH+d=}oGGI=;WyqtPN>_(zB z)@bO7l%#>5(Hsj!5iUF(Zmh8+IHYqabeRYBT{A__v1|XKXdSiN+OsV6xU*CrN@?TR z(L$&~r;=BIk}qDV{COE1d1^yCP0A{1;P;5Z2lVAppPu>m9_ zlt=IjMTKCGQXnsB|Et{f6-7Q6r&8#7w=+$UgoYgIEj3tXSmu_83zDR?EydN(M{`{9 zBSJ@U15ep8ZifLOAbzT3(S7;c5fRxR6;EH^=`*&tNmSMCe)>JrJIg8POT@8( z1(umnHi|bE(w(IQb0@cbVys)xhv=#L)MOG>2(|E=e;~9SwPmh2jS0;^FIjoW7W$2C zZDh(msd6RcNLG1!4YhJD_C#V)Gd>nEfr8(eA|=oa5rz3J)LqsC?!HF%F=+qox+n|{<^M@EmY8I&DoUC3a=J*tjT8C zLXh45;ar~vjeO#H%RAj!%QMr^A>X-fIkn!Li(@p5VsX7O&?+;2i|9!7IWqNH2nFi;G_;*?0ZN)DKfPB@&Kk#3cZ=O!n5XhCaDr)(Zv78M7dr1*5cvs97Vt7 z*{c({${t0NQn?Q5#`iyg;jf7=GIh-4X=dvw?+~+Q>I3ommgAx`s8>G9T3hA4o2CN1 z%5U-NqC}*4@4?((8NH1M27^yD_}}GSu#QEnEXZPUM*BlP+7I*rExXuUO^7AtA za5pl)h<{#2a`*Lpu!#TKpxW%3P~fB1lKOc6<(ZP2GD5SZ2q~*!cbZ%8=qfUZP`&aL zTZ1lm%~Fuhz&4f>&}X_>Ta#UbXlm&lY&>$Zzqs=t^mB1jQy8N%VQjRmg_s!q-_8 zEL$Kq2()YZUujX}v^ZMzW1)aZ%jvSC1=?OgewShCtbP1VgM8er)oMT1y$mdC+QMM! zST)9*VxHnR?uC6UQJ?J`6Mt$$K8KbQb<-6w0o+V1 z%VBIm1jQ$~tF$nCHzNlf9-G#&LiYK?;e2`*w9lihZ0%&@-@GDQgu~z>ewh^}YxB1E zTR~U%DM2Zao?jPN(B88ZLwRCxPs}E>_wy}T;-BTWpS?@aXFL4GK&ZMnFj^wiNSw|5 zvG7h~Lh}7u^F^26=>cf}Z|?Z)Vy^r;Q>{IPYc@MFm~y`ShkmS_Qd(;o?~m|6bF2I4 zvG|olwGesLb)ukt@V)yN$x<*Am>1@dUtGFXY2?{%wZ-Hi0NCs>^G zf>$94r6XAJLiQxy^%jUAaEfvDb;vfD$H3_HDCpE#la+x?Y-b8i-m@tJZE>h6@WfR3uc2lJkEpPTiHpQmD?=<|2a zGtHOk4C`;5vaZ-(BcdIij;rH3P27@KYKYAaPgy{w>YF#!)*&gfeQh!y-oU5YUL(B6 z+U}Wn?)~1%L)c=N&q~>Q6t|feFLJ%mN)i9M7ke;_`S=wdXr;DMV>Gpo^J-4(BQER} z80T;fJqJH2CXLIoO3Woqv2V zq|<=?-~|C4*y)VRFs1)p8Yex;!QQM+qL~&ODiOpz4E#N{v(=iaBRmq<`Dm;8`o~an zc*O$Jcu7(jx{_FY?dwI9H2Q&*wTBm^a$Apai>7uYcTDEt8ix^t-O z8QBkSe7H=#f1~hUy?-x%ylzqThZZrn`93W|t8PYCWePKmyu{}l&*pnZ|4XIqf9h~8 zoOfSDPHX+kA@M(@lf`p=%1ldBPrdIIeP|#2Q^pr)_1rJiUHzAX#eW~)d1B}jye1Bg z#{W1f3tq@ZMyOA?+9ju9T5b@NNceFXP`~NNG_U{5G2p+W`F&7<#gpzmnQS;TW>l!R6SU)xBV0UuSQM7K|Xi*7nyEvYeZ)vH>ELq>O zc)_&yquSL)q;HC&Q=ugFrZVhQ{)e25B~v9r`(P8rXkk+fCs6lge4n5^SoL+wzz8PU zBc4_9C#A$@A!_8oOZRly>C^l(HPt4ruEV(r#wN^4&%Vk)EHB{&vv1mppk!9m9W8pf z1=FT;d{QMBoQ)Bw#h<;G*48u=)iPW-O#O_kuc^cL8J+(+I~ILrQHso@F;L zUZ|LChCiy3Ub0P{MlEa}RqpY>@G~?#Ji-M_HJxS3eSB9c^!B3{pB|oDh+^Wrogl!; zOFQ!>{+|D1(Ldju7Q}tI_Whd9v151g1aHY6JC>KaJ-J2hKBAb;7bW_vHOMow-Mwoe zR=2iXv3s4^x*1@rKZk|{v>i=QvJ)@dxzjj|01r%wbbO=R3 zrS~2L6hxYcNGJ4Oq)H$G5oyvydY5jY_ZoUYs`Su%uOXoY0(pq-A3Obhh*PzjgNu7;<0wAF3HZRK8PuWQX zWY6b==P0a3zgr%T8~GRj_ecmoRPWDXlNHHCnPG19Ow!bvXpIc~%r4b_dP0|mBb?k} zAd`RLB(U%6gx^em8WI2zJ{JM-y~p77QQO7#6!RM6bAf4SQ*wdRlC| zKQH&zBU^Ub)!BPLlk@5MEv>GpdYR>IF%9< zGPhWQCMT&?_%9k}RTgfMgY#2yrxi$gdoS${bfm0o;%@zMwAoI<7*YAc)4A!AyxD`M zoQ#ud)H|p%+>UaEgvO#wm*$>8RN1t;eE|DPLm7C0w)g;bfOeT)Pw&USa9 zw^r1lwNr8r%&(op82R}uO;#gfKltHo?r6`(?%gUFScpme^i^xf+UreH0!`V$Ij8I) z8i3U!UtnApfeMg@&Lz&%{#8>Fy#?k;^u|}|CCZr6$;cReKrJNjN8r6LkE2Od)f1>h$^nL4>UzZKQyxsW4~KW2A~zO8BH$)%RzUCY(tYf%2m)scw{&DLiAL!YQ- zg1Pn7LmF#Nlmn#QkyxEeD3InD@`K=}MwHy5|J-YuxRveD)mJ5mNpeNk%vlyZb?Ans zCS*?q5_ef(lsrnNU~=+rPhJ>HFT1^4GWT_Sn{;Z=8-Zxn83DcnW|UX(+`1yl~*xAvo6>#=-W4t6gA|M(<|gUGGOeEg$$ z4J6<#9qW-q`YZmnq9`9r#Y3MAJUH=a=0kOA_5nYj-*+Dj)Im+FlDbtLW()<%l(`!8 z=?=9HWB;;n8W`vw988bRCYRe$Zaw?WZ_?jy#D#L`eWN?{C)sqXu0L=cbQErKt>sJO zi`2)CXabg3du2UMIc>6~GzBv@R|)t}7{BDcPU3qmuZ7r$sGXmF@7*ex`+Oa4>-D5B zJvh<-*VOA(!9rud<{ISX_mUea+nP8R|LcLBrF4V6@@8TLI`F zf3YD0a8B~_&W|16m#Je(4n!=mIEGxRrt{FOI!TvRI+~ti_2E5FNpgI9XJ@HErYvXm z;9D~;&#x}bxupylTxM*}z z`|`-vddu^C_QR!AU&h>lxdi#c8s-dx)@H2C zyP@TTI2B{T2J$BZVRxV-G%n-{q4P}AHeZi|gpGKguHr4sr9K6EeDQL#YyWTo;5Z zVQP?m1qOQB41Ujol0BWv4^>aM=2#lGcBO``W#K`m;l5Kgs~0FjEl=0hkhGH|Rd{3RVAm4WL5e|BZ3!iu*LEigww@XLLf10_WKFdN2=r|SwiMFF7m`q4B zGcE*G-;ybI<;|?^pE0RohZR|2j!#0@vT#1NA(8Q!cAl^f!m3K%>{d|x-T%ul? z1Kj;`I6aK0T|oqz7R7#YjtuA=JwK&GpgyYdxA5|&vkmt=<|GAzT}*DhLS1eH;SAtv zVVlt?n?gwTcAic3=u^fakLxx0<)QIqkHE&0toatR8j{IWV(@ zbFZp>+kC*~*`nj!aJlaGSd6u2Uu;|>utU9Hi9V&IV=^9Vot7{(I&Q=!Ww1HR0-NU} z&td9hEP#5dl|S%cb~{l}eE?iMV0|wSo;?l6&TWf>zELYW2dsyzUw9z zE{%~DAG8KD-&H}g&RK+zgB-bgIQZERl%0l~C)GbSzRIPfIGtt)yDXkpoUT?nQ-HDi z*|yoFAC%dHiw)YNk1N})yjO_I*6U5%o~{{{u;#I*@VV#6G>la*kIt4ni#+gLEWCMs z65x08jA`eGQpVwvn$3W_tMM(#$JXo8gX*Hu3FB19`vQAk6^}ueFiY>PLOl;>ib$rj z=lafRg~K6~DX8S287$LsBKsVUX6fyKx1hb1Q*n19hBh15uWY1mU*nJ-uT6#NeIY9Q zNh@8E{4=?F)$U^g(XUgAvr_@GM=pj6a3Le_=AFp;B4xl;<)=@;{ziU=I(v}wH_;g{ z`!EA+StNhH*$u&x7!jhz^_(Uc_eZ|36vJ4$M5+()`)$Y!2DK(V>6e6J@m~$(76UrX zj9g(3-#g9Jk@J9`Xh-6KK%^^HDzhJRe7SNASeu}MFF*hU4cqm3kKuTOT^rwpdW2X^ zpXpE_W1EgrHB-2n*d3K4dgjN24)Sr9AM}@^0FmliEqUCu(U0 z5&})@Wa+z6QIrOJ+Fjz+HPOQr9!VzqT`1WntB_*gQvlJ&TM)SlP#96F3XbMG3CMU5 zOYlmSqI^0hGb72mq-RWEqNS#)mJCMBs4ciB6?M!bAP1lVD{>iqr&NC3b>IfSb)r%A zsOXPoIasHy^aR|9>%@p5@I&nh(Z@UdR*MM2wBZ)`n^GadRWHe;^4jN-t+NZ?48rO=5%WG;poOt*y8GgW1jUYWc1-2{ zyFe>y{&4w#w81gq0#N+`P#sLRXO6N-iD83#_yE<;d$Mo`^RNMz_Q#IX?{FV$_zjvL zR!8`nG7b!$5?Z2c@Q+G=3C{gh;Z_)7r^4??D;6yzEj4>(_nLRCt~Bt-&(R-8VcVDd z3Vj0J2T}Lv39aQe9!nzK1)B^qxU5UtH0wfyh(Uj?y<px#mnjQ-mC zO_%Oi+l}u82%8hV-dA~3pBzO$bb&!pCT-GNN9MvXr|K0IxIsleA4dG6-}>g0z7cQ- zK0ocSlChI)@%D6*RHFUguwtx`8*hWj=faUpklwlptS?DOLgxH$qe_FE_->)gMu-M} z$}HFoD(d%AT&eRDIDpo^J*!W4DF3nwH2;$De8UIV+{s$S)`M(Z9%5|aP2omZ_zBLo z5 zdp^TO(pKOi#s)`!-n;M14ydU0G{mDGhsb+8rzFRQ9l%NkI;%T=Z?f!>H2GdH?i5;@ z=x_Rb{X)pIrFHGYq`vWJ`%RPqv()oE8r4`)LpLAP*7*?<6Ymx9ejB9(;4ERC%WPz4 ziJYYozJg6}$&fkG8nvdpvxrmXse#dxH|%cWJ2TWG1F()OOLkUXSJ_@)i=hpP1u605 zB1SI8b|rUqBDQpx8cP)S=E?bij&<&#BDo6CkxiiuU{h}l=c%ax22t~O>f})0YqbcT z+R#y&U~e^MP=u@-|MC6}6xr&woa|CCzWUOvkX~4+`9gVMLWe2|YkOAjr%i@ylg;KS zLe$ca^qxsPNzNpB)oYJ&cgsxPz7axg<0M-8o-Nx*X)f_}Q8_(=usshcn!UJk^QIJ> zpnY{tG+?rV*HLgqv9)f?!Ok&y%hxQ}XyhH8Z^`Yl7skpKDRcVR2@`pTi=S&ZJ9$5m zD4jQ3iK-x;d`yV3vp~I2D!HHGm>2k9F}6}o_@c1?b|UWx&I-}Mn%R3`X98=bEuaX6 zH`Xpz-fTTS9N9zsEREr~`?pi5lGw+W$*G#8) zKrC%`5=~tUv3W-3`jazH+-04|0cC4YdtmY^nd;8sXM|!NSrBVgz;)^A1~dsZ9JlNr z{*69oZy|Ay_@FO0APPirVxBTlEbaZb^qCl#juZ9C7lsjiMejRLAnO@G#l}MzTSek1 z0m5zgh@w)Z-`}&M`Smu)L9{sFAgr`&^#;cYg{-HLww}A2JTf|F{{nwNxc)uPal#$lnw zU_SOXJjiKtFqiM?l=98F_bebG9k&nNjBr=On5EFu*zVRzjK zB5H}HqJ#Z*iFV+P91$Q2yb4Q=qeY|4$r&weQCJN=CsJ!e)TrZaJN z3*D@}-jmp>z7{z5r>BeD$Z-QvEa9-@5JA(_S6P-JbH^n}7YHTHT8~)Tvm6AUPN<|f ze6`-%|1M3|94Qi(-SG|ea;lFoE}KXPuDbt~%U;@r*gyZw8mDb-ZjAJ26;E{R78;=E zwL4zy@vA&i!IiHjC+z_Ngdq-f)-xrMe)Nd2gL{c4m3C{sE!xW@Qh`k1B}6k+raxe> z%ghPs&_Q?MAyHNlGER&JFy)0B^kvuGzjNL| zo`$_(u4QbE;zqj1?KJRgsnUx;9%}ZXt(w>=!KjwIva}|A__ZxcxLWGp@kk-s5@-Hz zm$-}w28Y)^TT~_AGE5YumZuV5w{}XG(fMiRA#x`-a3lGnL3gV$bQ$@BQIMcO3jih* zCPEKkb#GQ`Jbnaq_+GHi2TNc)x7rJ7!3x1GkxRkg$Xf_n(5vStQw@?&{zJVBJh=B% zv=S7!!7#G)Hw0_8fYsM69xNOV2y}JnMO?M&|AhNamLe1)b9WfrK&9hH9KSdf(Jd}* zPUl3-44t)(s9y2(pS9h`Q&s7qQIaL{e5H2<(nFcBQq(54Ua!OjL#U9qcUX`VWslpC zV`G7~7b(tqMvby3fW$9FUj!p{z{>AY@4&2;REYW2sWWs!L~ft>EszPp`9fX9pTRr{ zp3xDxto%8;qY;(~LT7lH-VI=|AMetfxVQoKIx%7J^4(l#Cj zbNJNMlQxj#0FLZ(B*BSBz~9J8wspSTO?%@rY&Xk!Lo2eKNK}5GeE42_pDqS+NRgNY zGK_%Ot_mWh>~CER4)oTdeitkRsiA_o-2o@?o0H`OGxn}qcsgMl5rertNMa7nc;UdK zRCZ_xH~^LXi73r+$>5K)y(M*6Ys(tU>~_;vOY@u3BS?$-_w5UJLD3PnNBx;#U~2wSm@n~o7Gmk-xJ~QmnJD&Hl6yB>Oyk1UCSH9c_RT&j-ItMc*|Hha3^Z% z$@qXckFpG7N+pzc)-~D`%htJuR!;v~e953K^NKe_Y`@w*QxkUT{tE(w2VbPS1yVQt zohKX-KiZRhEETMic3L1iKLA@4FzL&g8hbP02L;kN`F1xIIN0i%{~Du(sSQk}AngGKiAk^u3K z^S5ZQA}_Cva{y3=#)2~B+!eb;#~Atupe;;-MRf14G2!0)$(9^v{?0cT@v|d~)>aJw zPO4FHsQyJcr~?A0p#;)u<1D9}hZSiI=)Vf&KQG6W85~OdX*{G3L_fPMA(KESwGXB1 zM2a-`0fpEP$cTUh`k^s|=f>}iMXbJkVJ>DT7b3e~Whe#*5`xla%%Iz`((h-@`!abc zy!a^ozM;5JeDj9?GZu<}_-B+@8qmUTD9Pe9C3kCmU3bwx_|a6j`B@ zvp~#tFG_?PpN}R6L;w|?qbb3 zt}9aFQS2O$#7+7yn;XCglnXy_d9D$tHuIS~^CKsrhU7-hr+~TlD~Hq5;SGQUf7`bE zN_J-3Cz5bs6)*qtAu#^)MlV>LC=kEj2bKKuZvni1E-<4;oyf=l0}MP+k1g`5}(yy-dhad}n3VRO5&8Ug%1mxd@X>JLSfeXDUDxg5UtXppBT~Z|J*tX$`NV zMW$-Go}g#a@-+_Ph0hHeDkUEO(=__eOq+dl)9b~$$hcwloXvI|VEtV2B_*KfQ;H1) zaGo6kWWYlJH`BI5#&Jy$uqky1-VsoiPX1PDY`}Fnb43EyzDxj47(hq@2Yog4 zQjh2JR_Lr#qpK#YQm(MYAAA}&q$rrw2!OG5WTViaK&Ul;lKD5Ur+e=PU&Fq9vZROI zq)m3j5WoS|N$>zF(i&nj?lChjKmW|%F>J9)ag0|NU-(=Bz%jYes|*^)qu#CL5&*?U z&_xDMDqo#D8=aDOC4ZJ_Il0240;a@;%v)c0)^5wgKgB=rZ?@Bm*4H~(BwXkoqB2$b z#|7x${3`UC*sfE}LQrxQ0C@G_0?GO|#1%FH>gdg1B;8_}-jn^7zJSgZV-XeEkcIuw zbY?^ksG8}4MujK~Zk23OQB*T3zEkT<58yIzwdQkc!wOr4yZs>c2L)1<`Un3OqH`+`zMrv4Ac((dc8sRW&-Yd-Kg)V>PI zUySE!V1)&;QHT-iJU-8q{^!SEmV zpz*Q!hi3NXMg08vDW;ya+4;J>^YMdZ8OQOykJXy|Km#>Ep~&Zm%sB0}-WIz%r-)%L z#qBYE+UkCVyVZI^+8S5s)>`!8mVb@hNl`Pc{J+^<{qOpFjOlfzM;c6$w)Xe;V`~TC zyjM&f_}SE)I`HUxjSObFOWam*zLvVgBXrKvl|C4J5FLem35bEPK%$0x;=1410i-b7!EUb$5+gLA_mOlJNgLA;6S+gmsMn-87?1J0}A zuHgAE=C$mj8`5;dMt~4@17Oc@1+@U(4)MH*6EiMZ0EPAimtMtnlUpIHvQh+oTtBDA z!^5+2Hh1Ye>C(xRkU1)4odhUOBmu%ZK!G9I5n}>ix#<2tUe4Q%-smrbK_}eoggrkQ zFxG?0_nHyLY?O$aCTm6Kuc5S;?WLCql_M zY4ggLZdlA?^DPD%%;b5+p8uxPDFCd7ch_#X1iZiXk@+dGW&P8ry@TJpf|a-LZM!J! z0@MKID{p`WVX?a!S6dPQHKwslU$>P4jH;K|qomEag{*pClFOdIS3CM};0|gk)Qz92 z|FBoFnrxpZV2%XPFw*>2-2b1YrKNeZak*dfi5M6bsk_ULl+KNp%GfFo_FuRcOT#JS z|3$1&@SGU7%ns7qbjDnH2Fw7n$)j-fFb#H6D4YI$>6j3R4|as#&o|dO{s7*QrVhxT zj#h5v%i@2QH*Nu{>;>|@y50w@@1tXRH!InMgZrP&H_Ba|j$-0`vneZ&qgEH*s%ohx{dGQl8A-{Tq5!B zm3Ry?U-Xt<0QVYfpL>Ua6@Nzla_({g9Y{MVUs2ec^)RE(uFSJy=UWu+KH^6~$>`LI zWfz}C+%o&rl(21uyE}Kk&N@$}0NC_yZE_Ls_4=Fi(iSfzb?{`F1KXwH4<-O1fC}{= zu>_5@)1TdpRnHp{%VuTRyc@s2lNp;IAiL@HEaMBt;@s{F){Tr|*ELwF@-`d3B&W~- z#JxvBqy|Emv?^Spo_1B7`E@!ZCo@d-fRf=(_tfN~(YGbXc_HYCws7ymn!Ocv5ffBm zl(KztwFlT)8+s334W!7b95e{7Jz*L% zbSrd6`=z~YmrPyH4rN;C8=ei9bl{27Sv!`<(lW1*6BT+#7lsOT=z^9Tu0Y0(^z^&q zZa!#$>O~Jsto5aox1UBPUhZYURE~rb`Gno3&UJ?xMjqnqDHA`^2m<8`v*3oMw~ju@ zBz$322kZ9+?(sEx3m#o@vBFYCd|^k4seKN__%vfPMR99Q9wfTzn`rzrc07TEYt;xd zO8SJ}`gWN4BipE&tR=VFcurD6NpF|vF30bw4|ORO3X+goMFYe9$&IbhmR6`YPtW39 z*z4bS^c9MuYB$B!Y`2g4adMS`qz_WVgo@@y7udaocuR|^{q+p&-)Tj4PQ{rM0j=;q z!=r?@*3qq$GCPh>?_ahCVum>*QPu5wNsN;2Hgz~L**7WRcXB@GCI$4h0o^r`4M;L( z=b*|-$<-5`zCG#D6-#KksIed_JBsSWTN zzOAX!(^_#T3Ki4P40M?rX%7sacW*bT{;fV zY1FsZz%g|ityQH2JrakX@kTm3urR~YGU4|2ZaBb}=UaiY;c_jeh-(<{SDR}EFO zZU@!m=XdI>gqw0B&j%;(P9qwA-}U9=6017VmMaw40zWufCZ+4#_DD?~z#xc9qzSux z6Iv)Q%6P_%Ey3!kohz00t!u3|GMntd89o>O*iCys5o!iL%T7#?rIhkiYL;Z(4YQ=b z8mteh*gALm#i=iEiS-|*=IeV7l0ioAf(>*;E;Bm^w(f-T*RsAE-b0ONstp%O?HQG5 zb9&ud1o6qF^Daw|O(i7Wk$M{xaSN#Sth(CgOM{`HnvhM=A_9pHu$=92hHLNF8dcCI zln_gXJf-eQYD%1ihq1G0Sb`f0&?0u|)iI@5G}{-;CLnxv(P3MEW7ei4v%cNg9?qB7 zX(2iq(Ngz5Oce^pv-@j(yfcDR-ksM^9;8gP!N&B#X z9@S2Yddf3pqFU=PG&{a)Et4_d;h7OU?N^=RnR9){EI%ipig#|U#;$Q+TrX{rl8K?H zDU{}elxw6I9QhgBh>0A4@oWgo#^!hZaeP13*dPgsT_VT#$tj(5H{^sa*ts%CzOLkn zANXZ=ap;+?SY%K>OG3k)nAAUT)~L@R$Y{S-42^}5YLAx4j{=-jYzIdWM;Euox+{2)`$uEmkiT58a z0_RMnysF*n*PT?Koe8{=wtynQ-#F~~9#>c!>L1V8{~aI1v)>Rq-z~yoGGln$L**y*};ZhjmPC|0&4%&mRGw zhjOMsQhnaLK9p(pg7xYGasR*r%j~gC^F~EQNq;04^lTK97DgQ!9c9J7%634?_@o;% znzh}?xaSuh}Zzp6k-#qe|HDVL~rF&$E`}FD7_IH~)eWgNHT@d;_-40<(^p6>1KjrN z*P&JjHy@|0wR+e}aN(esS_*;%;F5NE%?G58PeGw`h$oeIh!%VPK&9t05k%!kWQS`* zQSX)@69cT!i9jRl(`J-kUH=PrDc?h`{9FJckkl6ltL!oQIsd`PXp<^=n;f zF{|C$+va(ig}5;<(U@Yl>7S{=@sl-pq*Hi7NM~w->ttVwEY}Qlt&g{A3O(0!Is^1C z7JG2Tlh zP#)0mrp7qo+dO`1fJj5=-8Y}md~5Rz(grHf2j}acAV3A3Uq<`?uK(B!&G% zyF2>D}h&TZFB}C2CI3%-J=_sOZVn*Ep^W*IURPOybFm!!@u8fk*~^#$zY{nnBH;Ip~zpw^gzqjR=uV>?xL_+Fl{nxuZH zgA5~usS-7Zm6X>))p32JvdUY9)#-8Cm#1hyNF30JN{0Rw(A*o|69b*Zv#Hc+y{0WD z!}1}rzWMfR|IYhHc=s=Tj!VaM*YtJJPAc~f4kNFX(KGhO5u;Wcv6W>X?wT~Fev5~P zWazkGLTsm`%}PRHWdXQH0t&`es|eQH1BZ#+H$!@n1yeIK1+6>O8D|ShG3?=tF|Ed8 zPh(7QckO{j>)o=%U>v2dMAUIWpjlDdma2oYqWxAYa1XZ5nK?#{iM(TUu3d@8hV>My zHBK;wOwYQ~OLaq!Z;3QM;9WUwnnqO5J8;InFgC_g27U|Mp5}RF_eRgJ<@Ld!C5;CZ zxY|jiVJnOC@kdjYb=?QR9&TNSZSs9GclHi7k27(F%qYrwU%Cow9o$(=wm7nOnOuqe z^>niKI>PT+p4I}WOwCL5C~>O`2X5PH}h-9!apjwYT6#@nz?ARK3jP! z=R|X>U}u%n(-dNy5%$DE#ONuvJ8gEUwVz>)tL3GtP9y=*@dW+P=ALYmIYx*`?Z-Vr`pH6bt{H|zqhLP<``a~TGN_MfGv`R=N&#c0 zdSP+T8IL_IC_mL?@z|}Rki=BIH}P4 zJd5#Z{-1yhN1X%jevN~Nqk2+zz9x)sm`E4$=%3+QDs>SX!L0ebPiV{Wyc-3V=U-^F z8G(+DG%$SRw(Wc~>x*%TfT?Y$RJ@~R-L&;c0zMnxtB3illa13ldv?9k_$%C?N~xT> z>ayp^s&VKmD}frR-><_2kJ^mHfCb|0>B#ztq=bD04`K@=zk6o6OoSulEWn>+aH@;p!g+8`rP=yEuod_ly@Piu1k)*zd(;Q3@zjk`VxEuz0evwzDFN3wmYcn{4eTx?vL>;_v z8w0!rPVbh<@$1$O8e5);cqbu4amY7i839YwA{9Cg<7KdI$;?iEI_Un`8I!zOpzn8Q zrXohVn}>Ox)z=lj;?ZnjmVf(?S1gx%^zQF4OTe8%l|Ve{j{XzM`MS|yFg6o=c`3D6TBeBH9+OmIO9F@9yyu{B^`&8GD zw+3mtm6+j*kE&F^i3pLo(j>wV8>4*G*pX{aHks>-d;BtE4K_PkAtUb>c7+`=PHi#U%9z+_1(4Gq%am`UJ2MQKPm zypSD#+ww_Rbk=RpUQ#r#jT|U_tcq#mr(Ie~)h~qcRdi$+OS&>m^0Js_Z;mmf4V|FF zJXngOEIzCg8=nZfS$UR;Ta=WHz0itbP5q$&zKF3BQooc;$E}xA zzW_PEc*JRC!5liN#zl4Ku@Uz6kyfy(lk3rdhE4RRfqfihebz~{L#m-u z%f$-<@n;p~*~_dMiCK}ZCA8u%#n`B=Tok1#whTk|vb{dfi!h;{P9zxOItsG-=YDE& z<_}*ixprv8EFjhXsBc(>56^YUcfL;Z8RS!6N0+i5v4MXm@d2)x!b{ePyQ977adAm~ zt>gu^KxwC#WMH*o4s4(g8IB}>yB=M<9ze?pRPlTGF8+#{bi-a~EnXaOAvmU8<;Kbm z2C%kT!+z;d+hk$ekkdb?4pAIU1I-=l^XA~YBOON{#YCTB%b9GI{NmnvGg*!sUdnDN zz@hT0)3jIyNw_!p>lEJ8Spz%oKlxQ7e$93V)oOJHmKrf$DMQ<}T0@(^3kzd{Hoio( z{IXZS#I2NbZC@iW;(9r5?3X;bMrgIFeV&$?D2pbc$r}xheA$bczZ-P2ab$3L$Npd> zfYh=*EsE$voGX8}>}tQJA9>Gv)7dVL?r+}9nNPv5K^5 zC1k4I?@UlmB$$7}caH5@(ShldPG&NEew3EGjHMeME~-Db*LUoiJjiWw;_lN_JseI@ zu*wnn>>Pa4!=}-0q_1_tjl)hoS|}@$>@cwVBz$7`vOKX`w*>^hKrh~n=(yGTla8jrKKv< z-)9yp`-vp<}G7}Syq4GDwZ(@p>wD7k;A9_ip)Q&+?@Nosoq zat58zxzcbFS-7Msyc4F-^hU#BQc^u!0I99mbapO(v1;JQHdP@$&dSTej1Dc%?-QH* zBc8a0YN8l#XMv6D_eL7dSbR^l6F0i55p9yM(Mp+kOj!PWDG%?(8$2 zu>t~Dh#!0I;MS}BZaRXl0No|JY}EBy!BUtkf(aK*<$-bM zv(h4G$SaQ6+Jt4XyzUvU!iVZhyy-5~GA_q<+hI+(XSQ-XCJ z;!;~FXZGc>xlA2fwtMylIy0t^PX(G0O;^SNMB6^8FxirliDO7fHjMo*zF!><2-UI5-OT9E!-s%<(Enap!c0k3f8L`6R8C-Hi?rb7d9kB;E;kl8 z%4M|DUa_fTx`u))%$oTJ)eP)p*@aoi>3m3HR|1Cvm)?T39e{(qHgJJN=P32F8-_gb!Jg-Zkrw&{xwk0ILF z^}1j?qt-*eon;b5exR$>f}AQ>m^ZpKV150871L9??S8~Y;cD*RqiP+~kGT8v$3uuZ zJJ%c{YX%d}dWRrkSf*PsFZfx8&&Q%Yt7K^+fyS1_1Q#>fkWhSS;fJ!&QVki=tQ3T4 z+NTfGCkaE@QKOfwAcS+(2HD0BjWjDC)`Yh6uuBACG}5m~hH4y3wDhY9CVazwWy3z{ zTStvo2pz;v+LMRkZ9nw(+U{!pB%o*(^L^H})OJdSZuR=$jfsdAofPl!PdJX+!51!FCGg*R)j97%&V+llOXdt%7?IYBO0{xF@-$Pxs#gQ)I<|M z?3z^iOMC^$e*7XrhQ{Zh7Lzw=oXQ8CKomo(R!g=eJ9q0Hwc1H^1DJeG3F=r%viR1` z0a84LJ;hBvVdvRicZ?&AMH0PVt#Z|vK0_YRvY?Q{X>#3fvfQ_ZERq8MDGJLZDqxHr z#0A5AeFKEM2c}#N3`fR zpK>{KX0_T{P!rpT$!NBJ8@qSP4w@`c|9hL1ch zY$oI|LDz$Ar&Nv({5M{JgroP-aGqsZ%RS#!ZmddWuB~-VX?#d9y1BubBZS7M*|gS(t_HGsGVhctWRn3V6*xhi%01=vw9D%#mG z)_TU`;vrcxgHb_JJKK$h;=%k&#jfir7O!6xyl;=k@Sdwq0J5U`T7pd+O7i1CJKy|^waGblNMe>&MV*{|hg5AH#ob2zi@Iw!lv4Ami4nRSg z%8!4G5N}cAPJhk_6oh%GXZRhj#3rKwx2U%3PJxQ&_Nqmr*kH}q^eW8Jl}(Vob(+Tz zA%nyGiULGdBsKi>H zY%5z7N0|e!SwMSpcH-rLl?u2e8!+-G{sydEaNLd0n~c4wH&an;2ewGTT7# zZPtG!Aka;soVS(-$mXEjrAR4WCbwPz5jDp_^G53oc$M*Ry)O=^$!WH<4ObhAt!d$@ z$%fS$zS@x0Z&7x7DgY9bN6 zJb#5yoJdx3mp&ZP+5lKtRpg%M08dIS!O%6-SYgWMXw0GJZlJV)*N`&jgVY^w&~~bX z+m#F_705d9`XnC!OtV_w1BJZ{vO7T1@WH2MsX93?;Q6^>ymdA|gRb1NkDjxJ1NgZQ zlGwir!$2C_SYUxi`z8PX-A##&YWLRD26 zUvT{GEh5>I7Qxd402-yU?-H|r#bA1&XYtQJ7x3NMfKYXTsf6h^odU8TsfJiKZaFXG)=jBZyaWkMl>#!htuZV=c9vHo4<$lYz+eTy?uR0 z{gxbDoXoeZAPE(^E_WvIh%yo^M>F--_+X9tr-NimJUp_RTyg9b&K(8b~)MGd`)ByyRkLHmR z=gH0sV|(0o`9R*4ojkzObK0x=@|6ZqWAuD{7Ue{7vE%GluH3qUar}H`V`d8wS*x8T z-_Ef}1K=|%s$rluos#aeD`Agp_5H5kkwURPL3m1|5$<#SSXzDE{7rjlchXBDZ`QmaL{_D5uD-cA8V9K z%I@KZzULDM#FP4WXf`;Uw^S}tt`CyR&xRW20Y2~DPGs>tzlNuro8XI@n*i3o?uR#^ zw_7AM^;dlOFDA}A#hW!yq_v(cfGtDT&3bR~*i$V5qKoR>oG(yhINe5881K_p08mrM zN6SRBgz?@*_b8zL<00B$6$G>c@wfaxzyiMBcG5%K@)tPUE(g?SfD-9fmlDT6>ugvk zbSEfK03VVnL%&_aH4PA=JkV|nCa*pR{OY*66XG{)>vR7Yy}@6h(Ev_f8sJkM=L9IP z+<}(hD}@t3pmMPM>34adVmG-|2Y8+98~BpA%s0lb<~vX`!LHw`Yv3ITbyhNjuEeDqEuw)H z&bL{cdE!qF``)F*_OHh30fjDbFy7PX0PE`r?Jaw7bMd(85eL27q#( zFIHcjGvo-S=m!l~nx?6_3r|fX{PPp7yemt}OR`GSiRXxZU47ND;PC%*Z% zhj^sBZ7iGNb7Ip*UP@jDAUh3p7OJSO<||hMDj4x_E>oyXdP8r}&8qzarlN>P{i_{$Bv2n|OpWk7^HiDR))=T%=e>lgg`t z0R-`m0U=<>=~@S5{S(%2QIYKlUjPit1TUDx578S;OibQ)FmWS;NpCU`Pdq#ys)%h` zmNej?gITe{33T*bXgU zS1vABCs@<3S{#V|`Q(sls`Ye;^Rz2~{%axo(X&{UiU~PHIf-LZ1Zv2@5iJM#C?Hi> zD3&KjYBoqKyYK+>Q(2H@d9gm-OtiJL>YXY3S+uh8*IdQO#Y$IglR37PdUuC6u^3Du za7__>+y>f?ePuuOQ*i(05^v`SK7sN5Zdw$z#_=1OV`OQ|vgM+diovV-5NYfYrMlye zp!e;OT(XW2{7T@X;r{bx(T%);KiT%H1ukWknzF9bPIwvHq34-y%^$@#Gfy!5~mVd<75OYk-!$K(NrL?k6DDo2_$GuyR35KdW!#Tqh`N=xI%_ z67?^6uAg&UV2xLIpc1oG9SoG-vS%vIR1-BZmn&<#!7po;@YdS*&k-2!N(UvdkUt6Z zYrpeciZ}zO3>J97w1SIRAAwv{cBjq$D);)zWAc3Vae_j_y@WoVu#A#^i8`i&IUkWE z_5Cb9Sojh_**Xz#M8e@qxMAlETM%9QgTUz(iJEJ9hKh3(3 z^DeqD-jQj4xyx`sJKlaDeoMgVWM1fL$l0ou8kbs z)GJhc6P7D~_<83;G5L0g!FIOI*Rmp_6xjg7>9FcQNkPEyv#`b~9@2Q<$L&#*iv3$q zd83y7K-NeuZK5S!#?nqJS->sGEK}ux{*dGI1U)F`J^_7j^8GpsqMb7=9m^&CN;MAR zSrT+l2{kr?(r_8cGzV=!a=diECmPl5Y2`;~8QQzhq_>m6ZS52IAN8TCPnE&Zd3>y} zn{KP%vDyRJR~PP!v(=O*YUAEYbAp^_vvR!3UvaNNxSmz;5bkevI0Wa8U{OLG{@%19 zAKRbsdLD<-D%zfg3OzPrQ%ezLC1tFrL-UVMeCQcT*L}E$Yaw7mw%ja3tJR)3l6`x# z>U_kC`U6w-u^8Mqd6gVBfaz+{wZPGTgtS*68tlMX!3a5C3%A_;AR^aV(cKObQMXmz znd1#1j$HH-M1T$zW=veWoiNQDb^W~+(_-6XH<0P$&y1MrGgN^raN^Z!7oJW$eY#&p z+f2mOi~A;ued1y4l=icr*yk1fQCF1+d*}7kX0z3TC$>u!gbp4+IHqj-Y0L{Ux8L&q z9Z9*I@1MIunTgi>Mv|eLVWb-e9)m|LC#($H-({1j1)I=Br#Kd>f|8WlXtZKesS@UJ z#wBMO_v~EM`In;`V*EL?B%RoZ9>avF0U}EOLyh>>@HA9wc*Itpv;9qb;Z&C3w#BwU z(a+#sCm1L1TaCMaK?O^_L?{CCnt2jYO(c=u&#mIb+yR@OF$RgCj7=Wuw~??A7Xpwt z&s*u*OFJ|3Kzv{y6Y$YC0ez7{ug6k85L!_@BN4fB2uDsh)4+1I5Y@INq2*E4&5*yARyA+ z-QC>{L)QR9N_Xc_@6BHCS?9|+XYY^9g2mi*-Piw@2db9Av;0~IzbVq}7n!~h;5B&f zvyDr}x-RLf5Ry+0z3cra4BGMAGYTR*20O3~cNdvlIlY|AFb0KeDhw7ZO)iI2z;OHP=Ck10APOvKg#N(u4 z=e188vfdftmV}7R-Q84yORMTp&YCK2yxtx>uyn%Bopa}okC(bBCYf>HUAKdf=@5{3}%o-?t-yK7KfeCDr&b? zNq;f<7Z|Rx-S2nb&=CkGk4Dcp5&xh|4T3(7E4h~7*G zP9_QY@IR#B2YEt>OhekTLqFynjZ88p6B1?r#+G)n#Dlu$ zF2`<^yITJ3mzd`QoD~2}2l+I^Se_-a)iCF3>Hp2aka-o`6m zxbC(KAz92FVaU%)9s_#(h1L3Ibcl-0#Hd1y6ucvOhU=L_v05I#yiGGl!D38&`Mylu z-sfl_zfg>!1bv^^<}04lJIke|RfZW1-<}vtHm~gEJJl9FWM4WGN@)Ao%(FFlJ~5ke zgcisX;r2s6+QiCGCTC>k`E1OW$8BpEIfB>~B)0K78J{T-KCfBnsmh~E8Ax&Lr-fy7 zPH)dY16ErbqKVN{mU>OiX$QV9YOa$iQ6)HTkE1v;V} zot4K3pOv=yI$fud>oKWF`U;o~L+W5@PwmFqz<{7q^RbocB$$MY)fOWqZ`Wl{C#n7K zbm9ZHG+zTS#(Ub3dP+ETIM3<@%Y5AZ_Z1}uEi5_x>knm-p9N>6<4-0MzztRF0GMm?o*LgSP0uBnS`4Fh0X%L3 zm|5dNz=Y(mU(uIaQn!R4-9ea`-gRIdMv!^!qG+zGVFMK@=D9CIMIy7UU#T6dzyD-- z;@4l5&!91t%eoY?Ah{z0X{;9f@ouVTGA|WooHYO%NIaweog~!%qs#Qw8N8BFNhtc} zyJobyh{{%NLozU#`@$Qm0aPgum8`YnJjv4bL)YX|dE?L-$sBeg!|`P7F!M(8?}&iW zJt(+S}U3Sv}YMp z3E8#=LrWd@4(=T~`DIzoIKW7*u`?F&q3vkH!shHY7ns+);VI z0fJ2<)(m?0Uhyi+$++_!%u3li%xxQ<4Q-}A^r-|pXcm`z8iJbD-E7W3$)#`in{?f- z$CJ=We}DVc6E~=kicy=Ul~}BhvSAjl$i+Vln!XsZrE{4gYs*k)!#BrW%Dr}Pq#ZQ3 zTmBo<7V5iZBo_99NIdoAciQkRaNVd|F5=>`4qBWMgT7whhq()UEz76~t?&){9F0g2 z^bJADsIQN`vwlZCXN+{n@-YF@(ZrE4PwE6|e54#OCQ4itI`QP;`AK{!RqN>Xx!3C+ zCaPsqb=FCtCA;X0yx;8|?WPmR+}7!0us$p4Go4f%Hf9~fkcfyV>tFFX$r|)6S?3%w zC0IS^^C+E8yWYjK7_xMt;n1ihuS`s>(wg+^LEk?|Vj0u*5Ra=kcaYE9{eaQ7>OEWO z#3&HQ=FxpzeF^tHoj43w6sWfVKt?eK+pQOR1x)4J{+}%ro2=?bl9pB7rqKN%Og+3t zcA`@`rzoHHsW!j|vV|pxo|#WOsRC`v_>t9zJGyan!OK3c=J9h9svL#GlG-BqoR`+P zDJFg1ulj%3ASGpJq&SZJ&U&w|oi)8ibMQN6NN3-)npGygJ=e@F4RBKYfIKrNO@w6w z+D^e%0ie#p9pww*CimDdfZEsUT@rr4TD5n6UL9znP}Wzn)&D?Lpe@%jMP&J zsdhwE;q#FVre`nCFz$3v>F4%kooM$}dVW5;)_pWaqnYGbbkR-Z+z`n&q%cN0d+oQr zNIh!*ODUA;$4?zKu8AHi)IKX#Q%TpFg#`-z1g8a4cl+eoQ@iVu)(CE4&Y>NRDGgI6EGNcM}_7GvAv#8b4xe>lYmZu`Mz`)eGAp!HL2^3x^OZ3}bUf z_q7lK)8?87O8_9Pd`vi>pocI2?tpJpF5pMyvEF^r+?UN|l1(&)sM+7zzaEw_aw4<%;zh zyYmp3DqffHR$4@yMeh+@SqX^cn;wbonmP^I2(12+UR00D#OhBZ6Zr6aIUifk;&1aS zKC+0xo(;&=ZTZPGqN~BW&9h~~o@pU`aXktH#`LlbMOkE{A}~#KHH(CpA_?o1SHz0u z@~e)2S!mQdg}m?Amap66;|M{9TB0LjONhiQ^pUy#!>VPn>Oz1m$B-;40lnudJQ+c( zbC?ukeQ!KLog32iv?aU)@9SBV&fgo5{j38t{uKhTLs}tJ^)L7FcY|shJO;Nwvu**> zIiAkM3o6&H_ZobFC0$&@;+klug2pO8+?P*5{XFOD1;48oF1ckKm#zr;Wjy&|Fq(}Z z6*?_G3l{Tch>|f&xCz(Kw!m=Sy1pXK)0(hXXYV{AQvPtk+2(nxi%|pA?IiKN;wq;) zdl&0Hu`rXM0}_j*N%6RT13ck!BSf&elVUiN&BX*M*6s}wxo&h1rN{2u_+m;AGRUfW zNSaiBkK7@9<=tjZBq8-pM6az}gKf5r4L)c2rxaVhbnXC>RW7guRbSzvW=hY(98bcs62|?SgSYst|V8;w{Z_7@WybL+qLO>SA zdsyGaxFcV3MAo*%;YZp~vSKE2&tf@Fb?V9Hq11=N!<%bn05Mr$S6lG^aHRSRf3FHE zO>VR+JW+kdqH48O&w?+A$HtxMyp?jL9Q$-t>Mn+2ob`^Z& zOI{3gSB(b06gi?p(klCVMLQ>n2sw3@d}e@r(~qgaiqwMq)?QEUKfzo61l zo0x8Er72evMfN<`)rH~a3&-`}!!62k*hV-h7d_5~5uH|5t=O=69iG8?8ldt)3F7^} zEvoI?r$zd$?F;PYmeazb(upMGyaW=@!KkFc=I?P#Y$%RmUza6cJ#jYw3C#Z$Y>BVz9ftx`sN zrlY&qf7|XGi}q|WsYvqfaFZf{M4too=2PRpT+i!{yNhdW4;N*V_^ro&=U$IjUWlE< znn?iByKl5JSN7OdOsh=tt!{Zh>>U&cUf0{Y0JU9vG`fcp0NN-95UzFmy?P9UkHtn` zbS3XcUx{9m{(GG4|3hiVhZM(vDUhz^W-|%VGUk5{ltztPVSZ?l7bx@q64Y~om|AC} z?}5DQD%CK?BI8tE!2X9Ca{q_El-3GUf!S`o-vO}1<#<0w&7G?<$$Mf*)O#K#j~Px- zD4gwXy!$sUZt?`VNHG4h3wVWvl znmXzUv@ZqRiB=aEugF~2BY@4say8(p%?8@c+KA^9ElSm!HO_&Ks%@3WQJwN`;$HwJ zY3AzrFxP?g_#ffAPawN8&dNomEdNb*gEP=OH0@x&J(kgf(F(Y^8>nSVI?KH7_slwc zUhDvEZ)M70BOvIYd=0oBs&QLsH6L`+n<6jnfC4WCF|oey#?ws(m;#L4`rW@9J9A}H z65;dnd$6`NdKaZcvBbUc^PNdWz?|B$d*#R_@OtnzZEw7ApNIeKAjXZ|esieqqThp$ zi{9cU(qn7>D>^=-mb$c8pA*hmwQvh20!1H@U_P z=2liR#r8#XB^A9ym$5M#4<|1M3E7ON3N@&pDnND{`;YdYiLExP0$_M`qGOQ|1wMld zpFG1Vum4$satwgj*F5oqiHEiiP}lv!@527C3vM;P+!wv@^1#5TUs9-?8C>_fVq}`KtzV<;;a+R0Ot5!} zU49x*1y^!$c`7ev^y|r#gGyU2HEtn7yVn@q>EDq7dW(vTp4WMZMfba=)dN$3MZ{8D z(H2k5k<{ll-rYIL84~p}BK8s5tE|mW@7mjW+T2Ysa zTa!CWx1J_Rgu7-{{jZU?mUglNNK&m@V-O<_*L|T<9LuLoQ&UZ01v~ru;R~1+XBjP_ ztZ5_$Uy*2D?w=^nh$vVmj3wO4E(S62MIJUiVturjKuf#TAmY-O90C=$W4Nva-`TY_ z{&TsfWwGg5DVPHSqSWMdTNwj}m+<#*9Aqnn7{Pwlff6*5o$r-i^OOgGxzgZ)VGm-n%=b@n@DbzQx5juRsJmWC{EZ zfn4#^ExJEqz+xXv#t+|Oi9Hy+1Sb(qtMrCjDZxQCC{rI!oW-4@dK7$p8mp=n;a3x3 z*iFGIZ_ug<`52h8*g0@O6vZ(o>EbtoutT zCgvh)m&{Ynue{drRSY!^6v?B4_(CeNNXn~fz}}3#m{NcNECI1Tv)Vz7I7?}hhTOgu zKOkiQ;Z=^PXEz94{*Am0oQ7H2GFl=wQ_WnYQyk?*;h=9+^RM-;7o#gDW zx}ieCAWKU$aSu<+w-0YqbT!J>phMgsqL1Z_*3ql=Ox5fW5>_-8Woz6FLfv{{9B0T4 z+x`|uE+M@B_z)KGmT4wCL)b!B>Skn4V2WV(4e0q$ndg1fW^FO#hH0(MM$0bZV7+mG zM|9}L5MR}n;o8)_5U&}E?Pz6TAL29om|3Vi@{z<6C_OY9dUWlE$mcWfyGbiYN z-ODo;wA_4&|Do0X(#Q-^t=^d5sxeNUu-Bi^OR6;PK zVIp?&)u`c+R0~F8Yc=cj! zliGIl?IHx3(#Fv9sAKm;JWAmh@za{ z$tCV9T!w`oVHA|KsGq4hMGy+ODi4YhV*&)?xaApzg**AM(J;f=6ged3Ft5Q{kBC)` zl*w%+V-G`MLOKNUWoe$Rc?$DJn~3-BH?KXt1-HGrm{?NDi=oGTEdNpv-EbnG;4JhL zN>XSw6&4f7D7!)aF?@P9x`gV`1*TiF(|k56k#^nPXa4~0lIB>9wraZg%kJTFX@q0r z_nQCynKiUuIGgW*Ib-N(cGB1z5q5&sVc?E=QpM}$G1eA5^XdirWW-oXUV$(XpU z9^SdA=sd)nVejyg zdOzG&L>-0A-EaAD)#*yX{P;%;`0UIic`Apna>H2Py+^VHr~H&BhlUjE^$IV|dsEp- zr9x?BJo!kSt}}Mn(zvD)l^+{`#<|Ivwud9S+~;^vAEsDa@vb7}VA}k}7bz*0BUP-s zvommy^n1x#C;Jn+dHf$*wbt^@uaFJD?q_IdR59t7n;7#ddFoNk^SBclbY3#RG+Kk& zGU7Hr@IX=ENz!v_FZ=+i^_RnDLf!@g9ai(wmd}xHDrnIVJ)L2-$41q=Z1jzVV>Kwb zM{e_(b^ndTn!Zl58c#ysiiMR#L7RT?!--qylCF*nAvdSSLO#-Be-25d6SUqFdLzeg z56iBe3^kaL&=nADI6Qw6cUY%g__DjTl+=(9Ixt%W>b86u_J$Gtr%9SVQ4{6*XCZijcjaA;4U$(h>U1#l74z_AeVp_d9XgYd$lfzf?b8A6AqP^Pj z8|J)52Z737?$W(O>SCe_F*hB!>Vm8`m3y;0a9H}3G?*8q!~eRxRgMc{?5;JjOFSXc zLPQi>NUtw^fgqDiOm|oB2BNDd!Y&!xJ}VBFv^E%d60v4`A?8Ngq~$qQCExdv*y|(O zRhkl|>iQh#agwspy)@4Du!gqwH_q=VCaq8YIL!GT8401(;shKwSUy(@UirTG)5F>T ztSx?6bfj&z_khpc@;T1nG}_AALL$hmCMWG-9|>3eK7ffE$O;uROroYlvzqYq+an-N zbe`)9H-1=0Al<$S-e300KPAOW>o!%48lm4fM|I}wK29fZi2Wy~&Ax}XlRuh|xs_Sw zc#if8XZd#qDp{ijgoavvncvq?EY8rJGKt6YS}#q8W6`4oZhuI_)jO~xc>AeDu$ZQp z57_2N$?~eZ-`V1B+1G(R0d3F~PNRSP8c=|;eyf0@wUAAs*} z(N=ywl3~sM96XMI-FpNv1kxGGA6}49)U_mwjYJn%XYZ9hy7nrq9Yu(d#MLfa9c4li zdcN(29rfhXBfgu3@znM0l9KHHr78R7*FsmNZ;-!UVJn3@X9bo#RZ1S1=m<*K>sSip zKfbF+W6CAAYK9gyk_rHRq(-X>cNSDGe}3H?_psR3y?TgkUB^Z=ewWdciYu8LT0ry5#2l726$&sw70l&|dO86&J z%Bjfy5m0hT-_5$*SBAY&^n2no?q%G$5%QxC6hNexBLHj6iD)B`8#Mta>{0>wp};J{ z1<)ksVtK4QKN3GIoaJoeRhzE?fCdygXK4GK zv6k*_vG>bd-~4D@O6akMc z_75b@673-fk>4Lrr{ zZPB8JzmA~6BBRhIC{|a8T}uZ74vvn-7u_psEyX9&$bb0UM60gUI*z$6dp}^q^U}M5 zR4G60Gg|qUH3RAyI(D z<6=qJ@Y1q{w(|vtNKXe2jqDVM>*azX6U^(~d>*15noNV+<$i&GGrFE1tnWe5wuynN zNmuIpac-wM_RDYHd-s zdNq~YP>z1HOsVtC^3=PnO;Ak~d((C44wcc1U3cLNhIyHZ?~*fS4=5lULXs><^XaZB zxbKBqdBM%#pM8Cwo;Hxi&A9Pj0%=1#J$NXmWDScY#XisRXC5=2qXprOKpKHck6C!R z9vefM-25_N*BLIff)6Bq336O5h}v&k)^V%gRgi(;E_v+fy8UhQl`$@kT&Lo z!%}zXPe88q*s^nF}qkmZnlb#cG~eAt6(Fb7-g=NU~~KS(7s3*O=%+E2G>OL@r~x zpQQ+6*B zc1QzUJzcBvd{suQ#nrG>yBj>-93r#H5OKK39gl_kc%OJ;AT>B>k>Lu0*AMak9C(Wo zs>R1h%QPQPF!=q?OyRxs0f8?|t#%XNMH32rHTYXp<>!Gxmq1IW*xhk#>Dcw{_(u8D zN=MyHQh&RK^gaumUDy4n{z%mu5`_}nG5D#IManGSQWqA zWdDOz#bMeG7IJNY?rxJD&G-6rp&yn%XjML|sA?z&{#Yx5we8H@83!>k@YiP(jukY0 zAQm2K{Ww?GE08o6XSGo-EED_uQUGqHp;4hVD8Ia27TrY-D5^wmU*Crsyo*wtH}l=Q zh_5L)JPW5m<}sVU`%7^ z?yi59Y!@l1hM-8(@GnUyi-a%VL2COo8R8pp%JB+k3DYn<6_KnTk>-O z$Lav_eg<8+H-ADoRcr>ysl0RlB+9_!hAOV(=S1_`?Ax7X>+mHH2k+{!%kPBe64Zi; zJ1;Dd?j^A7>5-vXSh%$Gy7zw1!SO#am{}hk=X*^TsnycP&aYcVqgZZhEDQfMVtHnb zdcc~mrPa^BoGR2DSDs-&Cmk-IoxkhNV#~UG0MHw>$K<}h*NjfTgYHiPcft3 zvnUL*Lu1D9R3{!|zuX|P_mfx_33|jv%e%fGPp7}oGVzJVD^_vO8fZXiaFZ%ZskfO# z0h_>`rvyjPJ8c;T0Xu|<2K!NN>xd$8rDGaQ4XT9dKle~CbsNteUUK_u`}*qQZH{W_ z1VkLP#nk9EbLMBq!!(|B?_h>2F4er<=6_RSXs~0xGgcb5)Xu6^mj#?i4$2NK@~^cz zy4#@ubTB1#pij6XEv z0?&HDF|}A<3ottF>U~`^*y}1S$F`Ox?r%_unUcxk{jt{;U4xq2Y>lLBLU(0=RX%q& zD?}lc)V*)dVx~0OtJy}gnD)ZQKI87LwvZ|DZfzkZDJhZTD7_VbepWkkEA7P#ix}C0 z)UKVAveY8GNqfD&D15zUM&R{o#Q>Vn#hLEBFzFcimn3V>2h^<2p|A`Xu7M$^e^;6f zW2Mgg7|+qYV%5%r*xxT^3-VyvT8NJ}hde>`4*o?9I54S_ad0BvkeMfs!#0IU zYAIM}gB}&T-TO=q2^{a_M;m+`;s`}Q2))1#@8IyDE*tn8hcM;F9((7JO9B)XZg(=x zn?&FRCTK)S!ZGic-T>@dIprvW7dOYZJgr)@MTrr)7+H*);!MnsKyy|G4S@pXDxr}u|XbhU52wa&3rmRZ* z&uSFp(uooBO9u%%*W^b<5M|VW*GLdPWpU3e1xH!)05qW`sKSkLuacW$k1eiZ7#Sbk zN5E46wwqQ~RsMYz^7|)d%FgquLbBwaxHd>K?P#3OXjYK_#~(cK(T=%y2;DfWR9oz$ z+myUjt=Iy4=>MR;CJ6uj%^I6F8VKJ1N>hnHOJm|fr4LlE8%ZvU46^Go>v#S_yF^Pq zTx<%+H;+s6L=?!NY)Pc?LkeSx7$Z0&Kejc-B;mWnFqD;UvSBngLd0Gc%~(dq=^&Wx z6(@(|jY@5kwn)D0W(5ykcL=&?4<+3dq&SovQyZKX4JUk*x-#>P_Un!Su;eNlpB-JG z1E5MZ6M%oGPcP@K(XBbZGiGt~Eyq-w)4Xh>$6k>A-;VIVk39y> zAuXq)^fdFJC_;`Umn?@pm^2vx7QSL_F7ZA}KZ)a&_rbI zMP;q#wNJSc6D=sXzodR(lJje!V3N@CI>wl-bWp};zv4}Cy8at52;`?$^bCwE-SAoU zQHI}5y)O%vzLNMb@$x*#fmQRg6_EI|I_^&W0_41W)K7Ai1IH{NWj47Pz%c^Zb;oHc z>s}xqnycj20g-Js_9fp}|w>2TIxXWe;C8u?^#&o~^F{HD~WYb@f^;ZZ&r&VO|TFTGB6E^lfI# z_0UfAAtuK}khIh8K-_~{8!1tKzz^W)hUv{=%&NZew~ex$A(yY!vS5OGTOX=`00 zMB=2Jj2dgjsMd5D5UG@sQ=6T`rilZ82c10YH1fvlMf7Vsjtdl>y9}zsVpbV^cEsrhn+;0w5}9TIA98<>ExkOUvStA z`?1}*ZSSs6gc78J-SU@_>145U&p=Yx{?<6TQSsG#@PMaQ38)mE?~kB7K&!SWZOH9h{}FEV<^aeKE=L8|m&)|B>yEhswh_1^ z;whR~N1JH1NVD}6O5fQ%0FXl#xbv~H!z^Y47E-qtdo+NBrIO}VQ5D!d*T~37(n%%s zaXMVE(S%{X&YFpfi%TWO!viu4E_Bj%4F9JLeGyPH4Y9)A3fsF(v&6z`pBOoT7;$KQ8o(mj zt$3rtaeY3$V2_j#M105qY%aCuX}`brmJzf7PJ)B3(1f3c<;2WCep(Jo*-&q|kp25L z<&ohT^&#MRf%3} zHix67#Xsn>GM-6BGu59{-wzFploZqtDxbCV0!xjMCt@-U3NW9h)~V}f4g-Gy^I@g+ z3)X~wU$ZY5Vq~t_kjYa3y}+YRN_byJ@&NeUXfiQ5SAKRkmi;zl7wqRiDQkN`(A_0+ zSX((0I_ymJkR|9;n?^vw!m&bGXMeR@9s?b3CSlkCoVwiq>x<#P?!^2cWEWCuuP+#X z-OaV=mlMOyT1!4r_VYhnudxC~+6Dki$=2)gk2KF@>xW%d8V$zgMmG325?T5%_tCtx z&=J_tVWk7@^kp9dsKR>vS}3lL#eA_ko8s`@IN&<8+ygo#3(t3_i-aPYJ0g!>zKO@? zeY`uv-2se2v5-N#fk-Mlz$l4^8{)AX)vn3x${jnpj>8CKhkN;qiCaDlnEHfY0hqvb zM(7o-E#eQmWzmlP>ImnzT)wX~p#GlJOq8(!h zQD?gTIR^Aq6%x&WmQn56e+6*lex#zJ>fCdBvd+>m$JajqhETJUznVUR`9SS6EHsRJ zm-YrgeGP%KPVDnjW@3A}A!!^;?(O$CYvhjvl{c)^;p4~@Y>flnVR8QIv+LL8OI0Sa zu85ty4Is+C221pfu8NBBI{|?Ce7`CA@9$g3(64ziDHEQOHus1N<$a7Y?ghB2sc~Z2 zpJ&tGEEnp>br>248JqfnXyngHATaCBF*3!>VW5Em4TtkQuVCLiDw<765rt$W6%T!0 zX`<@Z{`bebABMXC8O;PpJ>I4wZb!WyD1q4hN@N{+1R!A0x-QnUqx|${bkuoFQh*DV*H*9@ZjO%{#uv*VuO;> z>hSNE7|J(KC58tzDVmAz*QFtVb2yYw-mwdVLp=B9^z_s`*bHz1R=S+%M+yA>gD|yg`fUDuX4@BYXRl%vk+^GWq zcMg;50s+M3(7KgE!+vIcVBNmtVkI~+?{6fkJdddV?8!UD{j61R z0NDYIdj4eUttqKp+6BJuF<=zNIW&HMY^6rFdO{nO`H7Iiz6V@=`p;GhEMynf zaI{Xq#VF@?zD@CDKBce!VgdWy0C?U$TlI%i1XfF(QN6X)^UHe+r2kLQDKzUxqji>Q zH|0u|MN;_weu0h`Kia%`zMT~o3&nb8ls-`ftV7`x-oex_Z^qU{@U=ez>fW?>gB&lH zJ7T9sHGDP$unN>)Gd3ut6k*$yA3a=x0^`1^U;#s099PS?ju6A0r1P^06UOM zK<6P|q*C%r)iRWrL*{yE8SsHypLEJ4zb?h+QAtN>KMB@&@D_A09{99YygfT-)(leIo{a-U{kW44~|iy65d z#&^oN2D~!F4uKb6cc07+tzn@v@zE^pqT9cJaFfuI9VR3$Nvk6$#o%=_#v{oI;)b0z zfHov@S5YfrQ<8Rhguc0y{U*exp`l@-7OY7KywLc#Tma>a>TUbD6KFZe8EF~q=}SHt zM^Axs{e5dBKaq~cJ%{?-H5UDVZrWP`DPNEI3+aTvr&ZpZW{g^9-p%r#``OXrE*kb?u2w0_ zT%lH0r0Z+uYuTy0ChRhfZNIsn3|2Qah%t)Y+&YX5iHs@P`Ix0;R8=X|svu3T?8RZ` zfvh()d+XRDr$Y*9tJEwrGg8n}_`G3GvXPN^keAk=3;x)`uE8|_KIxS*IaM@Xk!3|` z40O+W$(o;v4J4QN3hUt&dW?GM_r3><$YRYp9}&2mg2G4Z{E~7J4#)84&f0mH#SG=8 zL_=V0PmqY=23-yLB)j)@alLf73DoObEMw4wO?GgtaLUeUP(dd7hf+2F4b_G*ozqhh zSlMLdG=7zYBjsc<;lnq_@7kIW3zpfhI=;D*^paqm7HY%_%ZCCa_0!WS<^fnS=d-4e z!Xi0WxwOJ>dvo!7m2b;49rJz4)LRN!h>GuNf1cXKh@f4neGi1`HI$yo&PYO)@!fFb z7}N_TRR^J!>=^OUlEfJlVjb{+TD1H1LMV8uUm@mGAke5ZT_jgh&Pv}_%?=G>(0rBV zbyA5?%5KbsdbO%y&uf<&ZCGgQxktdfo->qb-FiH48P`u?x17>aDM_Wh(GWx4r}?2N z*ui>{)xJNdkS6|_X?Y(#`B+*pTZ+C~>rb^u4KCG2(#Awdv45M&{3yVgUFPD9V5xX#CIN398SkCt40VKJ=8lWaao&l+VBB@v49Was|;q<0wb@~*pycb0vay*|7bXqdx^g=rck z*WwqMeZi{F%{DFBYEgT0v2e5n@eSrQN<7cQQDi+RQ>x{t17{^ZNNswY`B^EEFC|?U z13DtQ)c^%W;07x$mq>^f`O0CWALg0+HF1~o?HvawF?Gd{k7x*gIBfw%O^mVP@f-69 z@o9T_<>$7_ubzt<5qJy+m~>c_#EJdi#_9>#1g2vOm#xdsyJZ0=UitpBvh9M{&X&Bc zp{0JZK6%bR?6dXxgX0F(CFTu18fhxdu^Ja90~1VOOLoTD0)AqFsh(O66OtM2%4uz? zciuIBL_H%*x$}vkdH1tw;>afm4lv>)mky>7D>$CtAozcpE1YCoyl{wRnBIs!h7#_ z(0$LYm{C4C(&ji!_%SS~oc%OB)Xg(rY*nZkZ3l}R*WhKQL?xSvbVO=X%G+;>j5LsQ z|Ig~&sze+UO@5A7gm6l?;^SEkR$RX$73zoX%OB1WWSX{GLY_k9xN~F1&&4Ku80oQ4 zuR_=yOO=+A-yZdk3G4=))tj%cgajA2c(_oT)?(r#QD1l-xPl4e!r#)){pCix zx1&-zxogy9ZF&)&lz*$Y+-Gu{fl4Ew+Jw&uE$LI-WG*DXPjtg6Sd{QwbEKh@h4^88 zQ+eo*ZgmCr_SW^gyAIs4D zHW%pIdGrmqP;&@rlpr5_$bJ!xKY6($(9`HOw&wU^#8q$>zkJ=pei7jZ$KxuU=7sA* zp_$KFLJbB7gV@7T6{GQb``UY-{01BK)~j9C{;r_0Z9g;FtxR>(B61iMBtRg+($DPD{@T#`&@ zRAyMGhuv8wc}i1~+agbJye*a{2@YYrW21MuGGMN@wi#r?7CaM3gmq@VJydYU>EoKc&AA)x zf?BrFdk|iE8g0~g*|K$CZMFLd+Dli7HRL`W#3w2q6#p0Zp!1xuGMf-kH@^^7b@OLF zCk?BOA`Xqv&dJK{=jRFCHFzOZZvg_yg%1mMA81%Wk%`(p{YxZh>*Fpdi!gybdn!S; z_ltQLp2H%d87}LOJ!*?`l5wE!`Ho_YKfGrdZiz5T>odI};aIzK@6Q&R;;7o) zQC5}xW*VKj+2B1fc@{G-)nc{xSvo;*4rD7x7?+Pq#0)iXkm97v^= z-N|=5vb%PU$d%s48(Ff6)#gU={)n_62%O)(1A8EOC++tiv(-vc)-MfW}!y66Z{&DK>8P zx(cNYgGro2_SG{GXQhQYb7opbC2w<*M98!MS$zA#k5tW?Lp5V%X6P85>&__ zFzL||!!Y-5z0=NOL%4N)1DG%3n$?X`P{Uke%%nTvH5M0lH2lvBCH&#hfqVo}igeC70{`AKnh5|T3 z0;~wgE7*PZkJvvKOw4+%K)*+hW3a>(G-}7p&$;{;37^8=a+{Y%QG&ET=0B0J;b3j4@u|CxCr^^r0d+kaXIT#T%``P0V6z3M zt7jL^LuFv6$0IC(SP=N!iXV&T^|Q413wni6499;vZmuA=Vj!*c?oQ^6dR>CwDlhY1)cY*7PRP}w>Js35IAZ0vTKqpKfdBf-{5<5!%1Wv{K`XwC(#yq( zEd~qS0*i%QWY)y@3%Pg=cK^|lSc)M@Io|-D-r|3l+>&sQ(K^AQv*`bZh4|N3aQcYk z;WY-F_di5ub5kWhl{vmae9En+gggHLsGbU}OgC+|RF)pN>!X0Uj4vgUK(m-nu|^FY z7!jI0mM>4qb$>oN*?0_uwDnKqNKWP+^`il$IpI$&awX^h8W`&b=L@eSzA=52jmAu@k0>V4%Ps0%W6KAA8mF) zVb}iiStURw(Q$E4cyHvtK0RDe4+V0is!Mr+ z5E2Cyl~@o&Oa>T6eMy`bY|XS?P6udm^7Cn*E>ZiJCIAfB?`QO&u{;9SFgRqw8R;j_ z4stDy_oJIn_;Yo|yAFEt%-bl9h9nH16 zIPwjHn4?APw>cv^UknU(ovRFutq&NE5+rt)d1ld)I!Jr6yq?ZAxWB>#E@ioP`r<@A z&H4Ao8ggj8_L*wW#L5j=L-1>&>J@6HJtk>O2jk2WNSfAr_k*!kDcW+2=r{2t<0~!4 zg&ZP5r=;Y=6x!H6p+BA*MPhmhv8qDzXd%iqycbt(N<4zUk7!=EjzRmFc0tiN4*DGX z&WnbUB=B+P8p9oT&UfV|eP);2g3^U*z`O8}|$hsn0@lu?(zZ5p+73<0{~G!2q1 zva*?xT%TXk2N^V6iI04-H5d%2c)!MSbv$m$?0N}J#69^%RWK;i+|(}#ZHnPjoa2Y# zuWl+BssqMGx1V>^u8_NKe>hDz8G!32 z2iT@HPgOA*-gD!$Fj0=9^b-RW)$MKTC;pu9mKreZg6aANK1_HCJ4|Zqq-H&6J^l6VjA*EZ2dv!(VYZSBL29?c~|1?>zu=*{G|L*KEe=>f1c#!E2u5flD(R z*hM8B-^M+oH5#9?RTuOm$!RptZH#% z35H@TN-rj~OLcwU9=8IcTMr*Ge(?}cCb>0IH7SG5%7Pe9*59eI5Kz)=cOER$EQG45 z6hs+f%GbU+@UdkIb_K~41kV*60DB+H0;2*thK~x73!9nooI3ckNY?e(YFjShyx#71 zEr3>cexh)?x*8x@Uyok9wd_~iw)S$Ux6Ne>WRz&SM&}q&#+hzW6AbF%nw==%%fDoH zq`wYX`iCp}o#gz7Xi4plm)?ysUrBHO*0_b_H!#lZsJ%j0nrNk66VScW?1M8+$Y28v zd2y#bUMl@p2-3F|VQ2PIVb3>dUR{)lubozF2e_@xQgMEFo&63mc<$<(93o6K(^%3E z-AKfnNh+PQwdoXtj{h@>jo-7)WM<22n*sU7^3M&nwX5S=ky)B~>?rUbWYYMx`R`r4 z_pk2Bl}%+ef@69B#J1B*3rk&*Rb$0`Z{YFwU72FR6x$AL zMwxa!gBgn1*POu@j!!rtlu)(hQD88KYDV*ti`?@lMcr;Tqc4GU`+YY7<$PxTx27(! z{hA#3I|NW`v>SgnTP9gGywZIt;Ye0gbI%XPb9MOPPH^S(n)lo*yDBoYeF5Y)rP5zNhX|I}PA6esTSC!H+mS!q0 zMbz^#FM_>+kyfN8byUTC3s5l4MyF<6@QDo?co90qI{-4E)H|5~G9T^NfYZRr#eG;Z zy53KoYPG@YDThkpTk%otak8=^!j4e0B55tcgU^bM@ct7mwpnq2+-%(7NiO`Sv|gLu zy?_;4_PbqvIstzCSNvGJ*U+;;vHy&xpBFjR}S9lDc3kVy5`idE8?O#R3rmj2xC# z>}igH(#Z9{Y#|%p$JfT=pZoVwRQp{J&+KsB6#-{F;iIeL6p!1%rcf2l)Tc`vAE*sK zkw?uMdQIP*T!a3_7p*epwi?gQiMM{_!`RTTs5b}k-{P)C-ZM_Q=F39GyiCtv_&;L0 zKlW#m&*}4ByWUl7{p-YBcAgm+J}IFZ?vP3KURNQy-wXZBD1ya)Nj+cZ{XH(~b8m@T zp0*$SuKMB?-3g@xM^QD$9t9M~aifIi1+U2yDEyiG z!YUX)m^^zj?d5=xI3H{ry5 zt@pC(-L&#sDoS!7-4p_}jD))tS zI)7u?W2)7~D^+D`s=^!{e~$=AA&#VT?}@^#EQlJBpPu!DsT35`E7k;5mw6L5c2)Yr z+^8kb;ZRX$JgpfzyrcIg+ED`%-*JlA8`ZJu8=JsmQCT{jeW#S9vU&PR#GxePRK!_D zsr2)B?PXslqqG`ZO)4Iz=kI=_&0)Sbocmc)LM#?CE>Le5S^u_CD&*`&5)CMv|Ku=1%7aJ5!pV4~xRfHp5T}W3eKMD7jHh6N@8WlX$ zu8|kY&scIzY)?`pP*r;7iW0ZN140k+CSrk)^jm#RIRYY$Eit?&rtW?G^zh_e0{t$g z6VJ($4=6+ucjrWQHD83e2_-R(dM%W67jLz=o$^t*>tmkt$BR~AMM_B;b@Vjc#W$-w}!$3m*|Okg}~5S)D=h=Ksq_Uz1E6dVFqYeD`N?uVVv$Q3;G*N+p(H&>@VH3$)1WAiJ<`_hMp-r=rNR z_Pk8~5RQqtTTB&faZ>uq{CVSY8iu~v5{@+8G9SU7yTeLd=an`oF&~7)(?M8%R(!>;q+LNrZV0Vr3(P>l+U5CJVdT z!-pW=)I^dzA))o1u^pA@9+lX-An{#!>jpZ>psF_)h5?6Lk_X9`yyn;0Kb0ZQ`!ErX z!-nEWUHy;^WQ}9Qg#hNa@6PnmJjkxQj}fY1D4(h3OesRIPML#k(i20HZRfgo<;rJ# zVlVKC*#pw?Tw5)#ktOJ`tvzx7KrsvcFr#XlO9uZXn)!@ZG7?-g`zn5xgrdp@7f;!;^V{(}@^(fH!AZCMBi?aGsi2>ctkCTie{?FZ z$j4E7#=J4d@ePEMZsV$2N-UVB)Ng|9(uSd9$xE121@va` z?3X+$_{C|u(P39(Sg@ndlOC*rj#)UTU%9>8fagu*F!7uyeuJ8?H*v3j(}MH~FGF z(|3C%o~wK?4tqP8s=??FN?H|toL9`+Cf_>z?4l5T-)2H)_}>wj>YH!Lj!HhtudC>l&315HDFi20 zhbZHw2J5Vci>$sCXuqdg6T&Dv!#^-3wnXR&d1<+~oEuxYn|F9>K4&YHFbu~%LHM-( zyxHeV(79}7qC0LEQC}vlKJ`;b56(3qgeV!2^sZvc4FU=R*jE$kR07EeN80wi(X#O8 z_9NJZ7AtUj%f3ai<%<&7g=K$=%#HK^GBhpgmnB|ec2TI)LDhYDnM3cd#w6_0@P z-K-aTGE;n{&OPYYkn6UZCdbmCcKoFkLPg3t&o78Y8b_t6;U*2IpH`rx2(YH>zt;4v5}&m~?H0c5 zzhbztGCNiC4Mfc23_zUfn&64r>Wpe@d**bruu1hs+bP}YbV})v=no97X(b+}EBP_( zdpgaL>>LqG3n@F=_8PKzl=+Xu;oY%|NZ3>;UvjRXNC89@hF^E=qlx8Y+I=bX9eH*Z zwfjqegS}R;^c~5t`YIvIl`XGSTtx(r^B`SCz5%@>SS<=zgHc7v(#$iyIF=9nc!7LYC+!&|REIWdGu{|U zLfQLCyJt8)z#hb)Z38RSpLr!3Wd>qC`)h$!=5srja5aU8wCUQuu5-v6Q#s zVP`?p8GyJV#X14rxN-Y9T8_GXi2O;unFmuLjg4db}r0m-%nkh#QYzo+7MXJ+A}?51SYo-dEcB?K~ZANqP9 zChecQWgi0fXhos!5F&v!03?P3j-&r428s7CSv1g!g%Um@6oBBU$0}IY>{ZsZi`=W6 z)*1uM1XZwrGWrF|zdp0ov-6lI#R&N9HW}`ij1rHIB1qw0t>)yTj=&Va8#rlHZb_cL zNCY#0Ldkd*DbSQdpY?dSTL%C%nwVmg?vE1XVlBn7Dn+>PC_rUQA6^tih=r5SV*0=n zI4)ID9W+nm7r$Lkk0eO=%uNPv|1#k7Ub8tGGdQpw$tpfx#ebT=|Az)`(=J@o?TLhH zooy}%Zm0X7{lv~vaLxU|%R&e97Xlz0-;@CDeD6rAfZ+08&%~kJxe*@se}m=Y{u=ACC_n|9=8LP9@{g zoL6f)3po(!QeF0+bJXS*#oPD36I=t(L;ALGF|vW6jB zfY#Uyv2V`oijE$GhqwZVrI{Q5OBW*wkoVtkqb@ ze;dWZI9N^A7&(4r@OJuquF{MG?7LE=$pBT7Q&Xb?d{n_L0QoAWBgtQzSsQ{zZB`*b zKPz)8?G?9i5FSZD`^Y*LiZ6Z$fJ6Ox=W&0UYzX{vPC!KFoX+vAadPjW`(MuO#pdP; ziv<`t@;95jL#`gD|HIn*-vH?^(TEJGQ3vWjxO|k^k7z%)O*Qc|jk`wnFOJy*WXk|- zm>)W05Db5Wu)%(Vg*4w_x7N`?LYYF zw`|jPG@T@vL}1ftPznhNwUKHA9(7v=XLwft+#2X(%thW$@55*I2lKV!YUYAqG$Nkl zaqo0`o|7JwhY~p_2p`NEdDC3@zC}JQ^#Yf}w zcVlkfN?-1b|E5tXX>r}y?f{t&Y8V7k~2s6+GDC-(<*^dH_OoBn|8*jI#i?yW`G9zXy zOv4))nMo~XO8BB^REfb1hdCJ@NJ7A2humvt6H7MRW+u!%5%IlQuOcgB=eGvfO91k2 zfprtiwt}F$^c5s3awFj%u;mbMVf=edG(Crt=GZ2^8TtdH0p^Srz=a>NIF5i$rRkpW^F^R^QJq|Sx?{yKhDwE|Qfn2i4$ zCnzOM0LEHBP#%>-GwzR*KS_cPhC7f0WsnpN-S9e$wN zSqDQlN$NIvuUo7)Z)PxUT`jGEk$;(=`Iyld*q&b`g0o7e(jJV4Bl&@)J=mNr}i^I}V*#Jtz6S@w_1pay)4u*4TJV_8xV_N%pUv+2CU zk}6=0-9vbY*EcPLsUO^QF*~*YRMXuy9xbCQU%0<37d`jmwLu-vJszUZE%{r66~pyo z6x9=7uJt-;z8s_%VUf0H-@-+5`${UfdN6v>qjl%%v{ITBal|Dg)}nY(r6Po8RcB>` zbkNjWjaI_?5!Nvi)35q$$yDK;5I2BI)x+nfsHRqtsI^!GK_5SjA_9k8?+X`7t9=+& zZW+ajZKE%&B*SM@cQG@Fp0=DF_^-VnN?m}mUPqZ&!&)5b|s3D!&7 z*U=9_Hr?#0KQKGVqR z(!`LKh`r>ZxeX(4a*3q(maC~%o+DXd687nLAsPPz5w)n`&%;u*r%|8}XwJ>BR?D87Ktk05>I6f63 zZN9PoWiJ<-3#-(d)T_N5JL?uefv`k~5H_nWmW?p-@TSGYraCaM6 zTw6R;ZlDaCKd?f5_^JN@)wjdLQM4lNQ=r&kw+Qw`b4&eVPKGX$b1*|0)^qCs4sx5W zSmO-E?}wIw9!fk{dxaH@QQuEnm)@(g7meAQ%<(m}y{79MQ&5_MAd^q)`ZUz(x+OY` zVm!O~@#Ea44Ur-vsW81T^ zOYpLLwVXouvQjZ>{_0_rLf_zGz8C9SyzKpbJG)hjZwq%vtgFVM5J%VM*PEh{sEm-W zEN<3~slne}IUb0Az1fb0#r1Yt`}o8gEVVr6pQ4gzlKAA*$9d9REmLjNZtc2W_g=rG zAC?E}{fMIPaP$#x5x#bt@Iv!IE?q1UAN3p{Gd7ZK5;{oHm_lM9Ul?pQj)2m46BlQpk)}+1jTcnxjQA=MSyQfNJJKNv^~8En^5PRWXCt!@H5|FS4EFA{E)`A|hQIM=tXkonGlo zdMoBf_v||eHj(&(kWXA&^yC4u3ThR&n{dM(oT@<K{Q> zrPLE>#6%%}hx=|o|JYXjgnL5jnPisIy}kZI#YCaaGfo0e8hkihqiQNwFnb%zmLcqK ze^HD@t%Tr!q{Xf_Fe<_+gEyKU_@~M1-sWRi(^>Xk(ftm)X>OBe1IHY2(Hwi3yo+gW^Cm+rKB@o%Nsf0n=(TF-z-QCx2*fZ7!EXE2#a ztnROrdv+AfXv_bkykB1@&djW%!R#G{5eJ2E;b@Di#q1d7I`LDEe>&Ne8#fsH6gDal zr)22!MUL268BTUxk+&r-qx#3wP{%gPGv8quJ&&Vw)p6{TqjU!aN_wZ&F^QtkOo?c6 z5ux4G`K5ZgQ3!u*k#V!xLw06bs%HWC`4Vx;M~-KnBs08^+n z!Z8_H=gBQ{u-_I{|Kg&fA9z@CunAS)Zc9$#tb{YAC)*=A{7BU$tNOqonSnt_hN-B# zK)gaYj@eJ_orJEeLKzlqDMWfJEsb^^O0je^KFmew5Z( z6(wJ7!LJC{Kk%`0O|5N+@r^3r^GP%Zl1?ja59{(3QOnjS5Oe4Wd6H({L;QLyR?pwCdaaf+sM5p{Qu)$nM4==tOFS29ux z^v1{l)zomMl?u%m$9f0xZumvkoB7*6Bg}o(6^~@#Zo{lF`5BNG!+*!DWMAvgl-OLz zloi0wuL#i59_gszyD7GLrOS@1EWX~CUlay}Y)l5ZC9WWsZ_U!fMO@L?(w>=)0)c$z zvpLFcF3h?lFcbf8hciFdpmu)8?Ps)O?-GkTW;(o0C`(Qrw5NNl>%oyyW=b*dd1q$x zbtIns%;%0gZ-+llKoqsBTlhBtZhEaWL;NLiiK;o8J~|KSjV^Jic0s&M0rW$MvlkF| z3-nV_jormxi{PD`yGcxk|AlAh84L^x{D8SQ%=z$){d()US07UUqkX}>?ahNwlSrqE zDwa2ud5lzEy-f;Nxqs%fzTebzvcZu|C4qNT!E?V-AW(Rts(=?%Jw)jqM08GxJ#yx! z#>wBJUJ9h4JIk-3H8;1rq8XB9mut-`S0Qe%rB4htN1lRGz-{7ZO8BQUSQGQB z<_JH1IL%=HYAFL#k7c|M5uIVH9YooQR06(uW@V8cSu)9VAjPzNEll-1#lMau1|^Tg z$@E3HJ)Dazb6Ql46xpD*xw)2fm)k-YQyn z>r+#*nECyEGTSg2BfAOtebG>%+At@n2WibQi?a<|{&oAd}THmJV25H|GHY-s|T_LH`UEB(TLs;M$?+cbdu4vJLFSSB{F?+W7ts(8UYaQd zYrbZV^N8~OnS_Q`-i#i9Ty^|U;|*8eGQLG0WRaAjO+0*7YN6O7bDvIXT=%eS44aHto{;y=lY;S74z)4IycaDmfU1k; z_m0tw6WV&0WZrS7P1yD5t%tMQFy)BR2ymPvERHU=TPsf&Ev(Cs6v^}`X|bOM_$wrN z4dxNeZg_L6iR#MM9y}-3FDU$CwMR0iOS5vDsoOrd`4LNegsb;PV9%%dDvg65A_%Xa zhlPO^tMlvCHXMXrk&-BzdQkmS^f?6E^k&3!Rv?kIW#%@W@J-c$U$p2%LQ6&S{OYJ=f=HIB6v72?n7A_iP9njcOU1^_27!dI@Z00-#Zl$M@ph zbc2v>N(*YV*Btum?xlC3HCqL{cnW0NDvJs!6rRWP$ecQ;95p(2{rkrGI@cuzy~Mcp z^&*(?k-A*1M$h1X&3NxS-*Iz1ol4{i_du!Sf_4gDY+8|6l|0AfHjcE=B*E`t5Q}mx ztyiQDRqTspRIdt{D!rRWcF(Xu*sHndvn@g3hT7?51weZWykp}!P% zS<(o&Dnb_}L4&VprO2CvgS&_X5t8#C>`aj&UBs$`PROh`rJryyyi$|utNqXPAU^aDri6@;tl z$4+=XUlVi0qENp<8{ImtVxm|E;+O?)Zth@O?*#AjY<4{F1@JK`z0g(O!WUw~u*|2R zBj$T;JSU@7v*dyH;%+5DsLysYP6as5W$^4|ZpuD4Y?QNUx}OG$PFsZ1u)OBiF6S6G zKO5Qja2Uj^omHo38V7oclC`&Eyb`PAgP2z%}Eha~Sy5lj&d3|m; zYLV54!+Wy`bq!HbNj3L$2Kw3~3vSc>_xp1q`k&TSG)-!i{B}t2P*SrZx3p`%dsCJ3 z^=G3Z*}b9}0iG8j;U7==Y73P;;&YpIT~RAXMQ?V57c9|dL`MEl5+)DA57rCc*qY(v z6l!i=jFA!Va|&J$(%I3E651|EcT{}$BYg0p(bmeq^bWo6YhE0<6Q(z+RBTiQDsOF7 z5LR{`D%JumT-BSzWNy*h&#r~xAp2L!?4V$qO%H@)52}lcjXKY|6qm2H2MgyFLo!WQ z6Ah$}`4bx~h}(TDm?#SZASc=FO}Pwx zej!g$Un*20`0LIurkqRMbZNn`TCc_TI3FFd7%%)n*kVPrP!RU#VDUS;9{${G?5hQY zISN4!&V;B=|H^DjAE}JloyP5j<`eQUOetW1r7Qf?gYTx~n^V)fY|Y^tn#; zXeYqE4391iFnk+65HNG7H~H<#QhL(8jKACWrTsUA@KeJbE*#X@CCEiTMMhzjD&({T zxiQbXj4eww%{--lNN`Jg-oiwpB6+l!H?6y)j!7Kzu~+LA%&va@mviDIPV2e~CZw4T z-xwj}=6xJzgU}_s4m^NLvK!I)7kuvL>g*=8LVbkZ`sOe>V*34=s(VnW$!;Z|D+^o&j+N!#f|d4t|b#ulGmy2ctgZ0thtS{8hGVCs87Y5H5eC zI{xcSt~NH48wc(xLs5pg$-^c3ePve6i#EE7)0sq3rSn$EohL>abj}+6K2HjHBi}=l z`2Gc~3$o3F?^eaDfV(yeug7|Iyt?pLxL5pr79zEBQN(k!%hFdIYZOz`Tk5U%AulxF z<~*1uL)~)^z6_U8=!ldCO`aK_3ayH+Ix6~qjQ>dyl)0^NQ~1z*JT=Yyi>03(u4+l- z?enAQle|}+AA_&E;C9~4jRcz$x-lw6(W)BRQq-Ab-X@RSEKei9fF zxYFhQt@V0U^LwFsQq7aS_r+IT&*ql0pVpR0TEG{a!W$cecgu9Oj~qfDEPREWkD`|Y zR$)5SS0BEeMEojqT%HhR=%nB5cDdmBBF%IBj5^#p>W=0H^O^``ypIa8M+6R+bn`$b z9}rPzYF&LqsrTpBB&sN!@cjCTua&yDZt1k=tk{e`TjqQ_lO?cMNhrJNtQ9eV^iR9- zH&wyoYgA52prD^?7OX;>q7w7XQ@-5v-M-Nhk%gRhluZ{sUyDfAh?bxbuJN~9QT ztiSG=2@JMQESy|zwC5lgJ*1JoGfBUZ??QB~Y$EK>qKa9yWYcinJ}!d}ewv(=J>NYR z93?k@aN5yNdJ~PcgF+w`X7*CW!v5-Io{qucll$Bc;zzBv%Nw^uOdkbN(y1*;d zkLoxs5gv}EwmEA38n48>e^%amYIr^1hsmO#^g>7i`Iu}hx;h9SY|2gxG_iM|^jPc3_P#tX%$>x-Y_Ru=u_qnc zXNwvbU+wxKwX2X-dTh))%tK&&dK$NFonkNiqVtUC+)I;&EXdf4rKN)bbLa{MVy3PU zAlTOuNIV!{87bkx-ZsY0f@s%k&A$1G#XisFD1~muD6texdgcjcm(fn(r)Oob08Ap~ z@g6UlZXN@{h|}jV$hifFA}=ciJoiMUro+r%A%TYh-AUu6hNgTOD;meHI0?-(2VIfWPWq&H}_POxgG zk_w-5K*?65J!##GsP4gb^D2vVLB`1`D5;xA$4*1_Wz=Q=TgbD$KreD{!yi6KL^8Eg z2Gr#^7Dl<@2YjG}8$`A#!}muL^iq@^{;3HeiFd5<3c&CQnS z7~@dmN?l<5?`@(+ucY9WapwgOE9rios4CqX(aC21zp)7qW71HlSFjCH%D2p{^0l}p zTuTF0sN6QY$?oKhfA@%Z@3v*qU)`&3BG72meE9=lgna{?!cbl`=@j?ZKm8W2w-a2} z|Jf>fFaOLRhkmL$XCMS<0%6)z-1C$Jq)PgY<0e3~lq+bvQuoDi4vsYhdkg9b)zWyoOlM^AAjDKl>;j!Zb3y=y$2Al?gQcCwBMtwKd8%>env4U zt=uc?)&X2)EE^Gtk}?%#lg5UoIgLTmM=IvT{+TapV(g!%&sg7IVR|zc=L`+fH zSZF_+15;$qptmu=d?#gpw=w$Q-e!re3>)N=Nr;AZC)U_cm~r5_3; ziZXgyp2>s3dPVTgpf&#Df6+mJ({d@_HCa-eb{(D)Kta5mQ!zuxJNRihRX^!Y{`YN0 zP5pOE)c>l5O#JN8k*K$o#T?ed{dZm-WKcGgodNrt2w?1|MlO>?qu&(}3fzFyyChFT zW5sF!B&6IGgrC1?u;$VhuYHcIT6y*N7e!JD1&-78M=n}N(8`|k;*tF74%)hpc#P#x z36_~84T0T+tfI{;Tt-2VNy&oC>)sIX_G25la6W>QHz2PTkvs#mNpC^?laNKt^2=nr zTcx~SfVaByU865pJxor;I<#it% ztr9WH`GHT`pDX@1UT9Lf=_9-744B44Yu)dhfoWHe6n2&6qSob{k|$y{Fh^9%l8n_0 zkN96iQ{Or0BY#186v#T!+nk6<*P` z0sN;>CC7by2XMbszW`F}d)BX2rdn3`4cb`P*nlAOW zN7Mb>3?eH4gosSYPfJ4+0pzGK{dT}XITO!eh~R~){Kfir=ie^!NpbsHahC3SUnDsU zbgkozKGsT}nky1f;gKVFJlrhKIUs>(C~XPA9~jQpSf2ooJw*GX*wVG${zBSxjz^+M z?F0}-d6;ttrjoCn0frX&=(wdD@(k%v>>gxr5xJT~mVn$+nEr@-wshpmir(X>;tu@L zhu42JZ(E+D&D2MGoP;O$e8^7FbGq&RHxi&pW(9^DNFKTTe0-i79(U(hVQtiplTl3~ zcL_-B#$4E+zHL|GfR^##M~5d6S~Sao_FNOFv`&BxQ$H~82d~l?Q^08LYiz{X<17g9 zjEQ2Ufc_CT(0|4tiTc`UE7gyDj9fY)MrBjl3&doxTX(mDkc&jo)Bo;!oo)rs?_q=o zKtzzZk&#+o)!y@V2_+3ik|TZ0)VDLK4A6vKxeGsS8}72v9u>uaWoGGJ<8 zXn3QIg8P%#Tva*VMy(!@6Tn5ynqPPQFZJOgmQexz;Vc~zueaYf01l*8HLB%CWCZ#} z@7Eyz9#GlqJkx;R+^(UOLXV1y>H{+=!^Nj-YA#t{B7($!j)#uW||l>=ti5D+ETbsp%*|~Jg0$C zyji&aeF(r(GZaT()g9c%qetO%!Az9eiVb+dt%I$)jP2zkzYDvrFdbh57gBu=o&+T) zwA1VJUFxml{|3GEYypOx`W9T5OI|17AXBpbRlT=h-HngUYtR!S=$v)+8tH2ZD45~r zAP>MVPJUg=gTCo9%~bS!XX0H>k&*$(Ub7jOVntm1ycQpX5AYkMKbX5XPhq#f^NS83 zc^F9q=A&soMe!0mj7{>OXv5lsSzsSkx6w*uKn%GZe~ z{UF|Z$J(Ur+?vdLe;oX1F5D|dkx1%_7J}FgED4mQL5kv)WznJ~n8AQk%-8z^gawNJ zN4UpJ@RG}F=`$`1RE4;auE=0F{2R)g#E|cu%XUs-kGuL2~S|M?|%YZ5cG?8$ddeKOpIl?j=j%WK`{j-FR{y5b$#`Q zBH6W!3)EDIQoUX;m|D1q@%Zz)BXUXKegALB?9eBemRuj0ZPr8|>EM9`cBW-=OkZHf z7zqj;dJG&TM&OP+ZP2^RtzHHF;BnQjy%)>{&I#-!BZIM%W<;)1X6uy>ZzOV3r_=X~ ztd9bCABwl%Y;0a{H_0_49=Q#II$~~3=g~8HB1d+t(Z#`~><~!TA^;9POn!XXumB1t zHT}1pot+ng#NopYS7C@gp;oz4>&GOSs@lw z6xBfd46Pm^LV!SG+OAIrKfb?TV)8&vT~GZ8m*m6n?RZ10!`XI>!S#s$eywx3n5oq> z&o`+WfojF)(n)gEtYwKOIWDV(>liBZql_V$8u>Vp{^5h}wqJ%XKSLPn74IL)9SEK{ zD^4~o#`a1&^YbI3o2LGK9YX%o7KIoIr+7MF>x&>glGZtQQp!(d^m87*(gg~k3ICr6 zKfl`&)7lb!5)- zc=_XV3B z=IZB8NfsQL?Wb&6d2IGPV=ce0&+XSw&euQ?Z@~LPiSqmK8yWS#z{@4*Y63y#`jsMI z({iTmPE1Yswyd-Kx9<9N?q)nX&AKmkD#g)}o992d+(yjoaz?H(#UuZum244;GeShe z59bpWb4u$~RW9eB(gnCoq1)8{{1LL4a_t>M^0xRGb78})Z>$=M_k{@NGtGN4NEi9k zVV;6;&O~7Fl}i5mT|e_iU|gocU70yGA>mVg%<{Zqo^=`CZEUMwN~&M6s53}?F0R~$ zBde+L4-($#b=pabpOK**xpr%$wcLYnMXGbG<&}5`ebfgD?-%!c6TJFdf<3p-cwMRE z6cF=M*86ed6DjQ)-;~;uueL*-b(feKMOQOYX z;|h;!Miutd#r-rMO*A4F#znp0Wyv2Vvt=)GLtoY)sWrL&y0XwmViR|;?9If-s>{H< z%aUPnCa_yR7kDtT=*F^4$9v!2P0B>}w_Y{1I{M;5YieVun*B4(L|bBAfG{w3>+~ZU z=SXK<*IaXBt@?=xYXxFk7gqkVOZ!;CAH}IPakTrH1YeRdFS?!fZnNYG6v(j`qG3be zYWg(3B45IVsEZJ(%6Euh;uQ?8_V#kJ>s#bUqZa|z9i06l#W%st1Mq*eAP`(p-);HC zsLiJFjgnqN*|y!p5z*9OFP7%rnB(XwIf91}pKS|EmJMU#BYZ}v0>NmHL%`DdTaV*F z4u|-bWEN@ObPFiY8?@Ul5~y3ipzEP!U7i~=3thD{JZqnm8#`~6PRf1Zy8-&y)$;&1 z^z*(7z0>eh>fn=!^c%QlUBuv>+3V(&40Y{jnqmQH>HRa*-(K~R%z=IK?{=Y*DN=e6 zo0394I}TCvJWiX%)@U0e2!}$?ddlLa>{^(Z8)V(S9ZlD-^IT}_+|TY@mvKlVQWy8PSd8%QS>?gtT6*W#lDl`#KeTjxioIqEIBNqZww7r`v{`S z6TQN8U5cizSkUs6lO4@qK086*54v}1jrXMi{~KL*!+~2@m)dbW8kH9h;bwtWhPQQy zb(l3q#T+xe01wXJ*CfY^vf&$i8+x}TJl>X68=JZT0$ZenX~|3;j6-U1w>kZrnwMMt zL-CPYmzu?{Ry}(|doKotcJHC6JzY1Q{y3td*c2IzW#=z=d;W|G_RKuY=Dbf{{sRI{%fJowc@IZe9Xvhk zxziNg$xhlIxBZd#ZfE9QFJEOO&N<7hn}nmAIx|LRhEI*uQ1)+a%(*Hz%1`rH>QmRL zxO|8kbV53Y^lcpOxenq{j2`_xt-76;(ownV(b)kC04H;1r}=5WisjpRY2WW2O2w24 zi5oU0S%WY~qv+GwP*hT>^{q@K@UV8ccRbNq>UTMdH zz3h%4L;De3+TObZ7|TOu>@Vm_Lue+J0sG|g2Xf7Her#ssglHzzOQg1g7FgxAL%W^l z%&htHML*c4)0^d^juD?R!YT&YGsK>nV{%uRpO_!CJK}p`7_4GCRvI}*r5fL+qm&C9 z|4dsT@nS};dp|}L|CiLSszy(!>Ow8mhKEPbUo$_9s~l^#4_@+Ub#*4Tg-W}S@uwN9 zg-2{4M|8}dvu2W~hp!hS7flH|+UOTC+QqcK$NcF0})adgj+fUXDskT6_BF! z3dHwG&ea_)!Y;}yrcSOY2bUI2R~va;4N<$mWPQRpua#i4*9ehy`3RxoV6DiU9W#%f z00Wk&d9?p%yB^2z2f0Vn{oc8h_0*YxML=1IOV8F0A^s0--Y6W719}n9wX?py;>P0b z2CM1LMD9EKuVeTQ^Rg98EWdb9V~0)fRG<#mrJjHHEj>8Tcc+W<3T(PSuSGxj&~U*S z_|;>(VG-CKlS&#S1LS@iWI2oONtoAdXBlEZY&8UyVHgfi9vh4HW@pUP8o*Y}`}W=U z%{Qmi-#3#zn*4t}MpS!@H-FwDuJ9uTqNJkjzaBLm4W*r4dXg4R->q4DzfsZm{k8>d z@@`2-nlu%K>oxJXUL{fISe2P~zh=puy%pY%hi_s;43zrFm7>d%+o*U4%v)3=g(;Em z*KTTUJ2Xcht}w^ewssJWr_xt1#6(yi3Q#Onvk?MD`jCP}K4Nhe6aheuQ{M?wO`(I63ju%>p+L9l& zb*U?Pe>)uqvi=EZ&$ImwEM(3fCO>NDarQI4wB0na9zev{uV9LmB8%a`a|qMDk1()b zB3p1%=pldOW@2XwL||nfwP%$nKYg9J-|pglsE`QKj@V0ReQPqQeNs3e-}StSPe872 z!vQB3t)QZ{yKlbI#@c_iIeEgiAfmk-0^yLQ4I5}o;@Kw%ee(Y)Gh$0!%A z$*@K$=IxFax_;7UiYtzpXaYadtxcOGgqw27?riCaf2VYe*PjT#*0@vq2n7= ztQIr#E3MTDaVN*&eSPLp4{#^QE-&~z_dRY|p)ss47pp^esn9fHtX~)JNM1r^VrYp*zT<#NZ5sOV^r|kg`9M(>7P??pXnpeBm~>{_`KdB zD6@6LT8$f{9JcMc<(sFR-uGKaCtw*oBE0D{qj-bocFSjYfolEd#_F%8ha`Ql_Ei$r zlp0Tzt5Jep z=)CTN*2qO1dzRdE^>&3N1a0WgFuO1G&m^1g@rHj|#rbbi0)w;N#Ry+Z9tFe7 zscE)Fk!-Vq8?&$Ra%OJ%8)%6L;vXSA(VF*z6}?$rnaaF!eXW@FWwSrqB)*3ai<_Bw z2%L(C)?_G9eD@>PtXT}Bz5 zKc#`0#|f5S_t5@{^>;SGdXnK7(g}kPa56o+NrA7s^lc$LNG020>ADaz9n9Ba#$0iEfC7^KdHkH=JRqkbssDtM@yr8Y5dJTd`J3xT0N2` zulgg<;gJfObvPGdjdssSE?nfP77@05@e2Ep4Ku+bMQW0 zw!XH>w|{0!bRUfWw-u_ID>HWg?b)xmUNLqcXC<C#L>O8*|1` zlTyOrH(m^L`{=Vbc3R?0m?w+}6h!)TmzTaUo*RW?2LovRzWp{@ruCn-4ecOqzq4=g z9&d~bKHf%dG-2r`4c831vTn4x2CB8%Pp!^KL*bkA8<1tbm>Lw?5 z_sYc@9v7Q;+H7RL7!+rnw|buTV@eh-h;8MkLpLLHj+Q&|?SV>(yXoMK0a-dQ?t3S( zp=j5HsJU@7kg|f_cJlJ#JqSTA z?6`ULLX5>L1>6!r%0g;w&kr<_sZlrr) z=wxbYHH%7W-_k%z$b1e{)@K!K}8(kwCsq88M%Ct{B0n&|Up141G z=DOs6{@VZR&g`f&?6gwaJ$&LW;4SzV!s!X`I6x2N6y@5Bxboea-Q1*Jwcc%ALF^tQJ@{=Z%ExU?znxXmtvO& zuld$%3Dm-e7O{Ooc$An2s?%XTqP{ctc3o6ywl-DWZ{>#qqh-xkGtz$>c5z%EfB&cy&$5-{Vv!Uv30vn1_I>Mm zsigzpx*(+h#Xhe2WCoC(%=UehaRWdp?Q61#AwY(>l5}u7b2+R~lR$`B z5E^XhH=0QU=nAzdzaS+pYi!O!XeH{N=T%k;4-E~GwspnwD6=Gelzc4eVjZC#T2fM? z=?A7Y3A$Hwd*jeFYRQ388@P$&-@8_`JfN7dVV?oy<_K*aoe?YA z9Ey7SQv&9xbCh4lx1u7%+hhGoGf$6N{@#IY4q_`@sCaba(f#6SVawl#qa>|vSeSC= z7R+3)37ds@3sT|U+Su4gA9+-5V=$OQw-mYFeR8_t1M%pp{p2e=sRz6LmI3sV=aiz( zE)JtaIV6$Y$Wyt_tgXr)qbRu6QRjFuu3FHdo`b~j)>fCc zV^@*>X8SQZwptZp-WO-@HpRazzQDmH$n{9k!^?i4RbrunU6qyipj`1~3AC|1uycgo zniy?0QeH}hJ$50yt6(0d`9KyI;jy{0z7WWG`=@!M8PMK(>+Dz>9WAD!JA{^qpTahc$6S5>;C zLh!=OGk?N_O`iatrl=`M`OD6G-^@AOy_YeFzQvWc9iKZFjkjaI+~wJ3%VYG} zk-YA=2r3^ikzsYYEtd;#V83=fq1fXaQ#n+esyPT_K>-)JuF@9K<)nH2_YYQBynO|d z>q{R@HG*Kp&};#Rejoh>6`Ho%BI&dx65=s?{f3j*NHuc)im0%>@Yo)yPEGeGwx1*i z2=l*r8qoJV^$|kEwn-#!(K?oUZK|H!Tu9>aX5i8p&cF|L_ET7lEub9M!@!*g0RbUwncVdcGN?ntRxqYDX8pC+21d3^#>`GLwoE-?uS7OYWTRPJSG$q z7&M@deD;(sS0=Z!#)?KH_eyqJ$^%Urde5!G8%iT?K})Zd#s6e?S9X{h{6N|{igIaIA5 zq{pmz_C&Q2j6bC3)2r)Xye{D&85$wk`3M^!l>)t~{)LAiiBknvxG8vq1yOKW;5Yz8 zCmU4MjaNWyw6f4-y#M`)ZdC2Lu&ViPyI%ki>FC0t`>H9IGHyoG`ib<+yQ-E5mK&6A zleb4U)9&~Xr-&U~J5dUq>DC%Rtsu`NMbH`P;yF@o;N6~KLO);q3U%zsjK*ILn~Kz9qu;>QPk(dsuRBBAFr} zwY*9_j#bX`K8Yn^8}_@(^*Ja`)lc>(oXKwIAA7LjpvO~1w?{va*=N5zx>>~ME?&hI z#ny(dJ|K}#f1fgTy<8V+EIJmxUW%h!;w$;3H2DPI3~h4CfSyr0bxWDxbpy?90h%*L z8%&A~zIBgnM~Me=B7I`%c3gdBK?&|~;j)`;z2U5Lfq-3`#Zj3lbn&dc*yX10Jflur z8$6hCY&@FRL@Yy#vV#z=pj%>Li*3LSePsYWbuvbu0VwgMc=Bm|edIL15$?L@vfUQR z{HA8wTm&tHuW{Sg1wQ6c_3oiwjYglDcuPVCL5r~4!JQtk6dTg8kmUB>_({ljR%4qN z#Pi&3Qf@I^2H^x^A1|FQgpl)v_@FOLe|}0yDNf@8MT_EjsDvwLeGFYJ3WQ}Uo z;^}3VvQg6#Uj?7Ax^fmawNhC>Nxnc-gym(#Pm3l0aZz}ovhZ!mGN`9qA@<_Gz*)4Ex^uMra;;yC)(WYWqx z?*7H8^qRLdE`I9pvo}JDX2lz#jJ`HQ7pXP;TkK#=GrMg5q>v2CZo7Fc?MbopJuUIV zA0L!Q&X)H$iwA@xJ`1n4FMu-*&3oZd8R24Frtg+Uj$`^lPh$tfZLLU`D&e8{XG;DE z+6K)hJ5MPdSU?s%?kF&yH1!f7)8x6^@HWAwSY z{@l+N$AJ)`^I;S_oZ7QHVBnD9h<(_ogvDy25*|hW0Ta<>c464d)UcA2;-_Hid*qPlC9#RhTrJe#p|RJWqPcLD9_; zRcxuV{Yl3hPGA3(X$>8M*^kV)ccb7^uy7$w3++oV6CDJUkBjuwfZv zfJMb-7s*x;^@VFCAKzNlsN0L?PV|jpwIjONa;=vK+;Umx7s(DO9&5jwTYe(F4vUi= z=0EPt8lte|!JRK!4 z(Mfz>sNlE1{yma+aWH1Dzs=&;rO~_Gq3ifur-n82qb<$%2oJ-}N$Nx6fALf;&OFRf z!odhuRe@6-tq%umXU8n31Rb65HVP|kHUQWEpO|Z)l)=Jkq8DozyrTEBc1e=K3xf7 zh&Wvpf$=UKhbyO?y!>SxO#Sox)DPcL$L|(;1C31O@OJ()#d#Wj-QC?zV^x-hzV68% zKY=)mG%IPVloo*n&oBWOL$Qu9x|+;8<_G&w`&Y+0CrcM2#=p7`XN{g=70cwRpc_pF z4}Q%odB8Aqn}6fBEB*g$?tEgvNQ%CoIaZ<3vgUqF@cquCD6T>xp4^>sc3ZRvfRDhE z#0d43WoC{p*YBDCew?zOdHMaE?~Q3~zGc|iwOXZ)jP;ov85S|?JtJ=kasP=;XU}Jl z;D<&y7+kIDH?Q<7Hy;<6@Y=4{<7~Cx)M*;w<981xZkL9Z3A=oI9C4UVn;J>0M%XL1 zV08Y(;-i1jIGm@WnWk-kd-`|9#H~7Aq9Xi`dGn2?GW9Vj25BCz@5>dVPzmPh=RA%>tDkcQZM%?zplqXkL+fYz=2X3lX<{SpwMzDSg6KkcMhb*__9;<(hP)wAb4k((j$>0 zyc{nbId3P-@khWmax8O*t97(?9Qo>$4E(7aZthWFKkBs-(bGrrb(ht+%ry15UgJTu`bJ*_eB@a zS>Xq_&NiTY+IIPL@=}6d_?WeFHQJ)9_>E4 zLJMI$=Pv8mS7QPTsX?wfsbRCi*R)3?>!J(oZmjEkcGc%2DQbd15yFqUNT0Sl8NM({ zr(j4tu&c`TW+#9g2f(1v;kR*BtVy3VPNK@avY*vGm!63-2#$oPFQJzU76<&hg)*z} zYngX1MzrCs1^a{q$8~T4r-*zS z3eTKpoiQp^4AhQ`ET{-suiRJ7`a1|E`jPc#920ma&6WW~u$?!(r>qXM_W0qO4x{f4 zsY)Qh4DK`+boi12ds-~2F~$Zf^aF)ztBdD8yN77=ZPh=IBB%P&aJ@O<8yVhQFed{5 zUA|V?li&3*0v^m?g4=3i=lKO@f#k*)rjn}5VnQwkl3iNEulder?7twSU-(vTip7Hy z{@HuU*t8~D6C9gco8oO~tzB_!>X3u-!A%NR!nUvE-P-_}vTMEUAF{Xn*n zTCMM}6LMzNLb!YMcAlE4W#SM%gCt{>R~TVwsq+XD?$^P@E{XLhS@BU1Ze*$;f2Ja& z2WG554iyVpkrusKr=FEUWkntyc0T>O&#K}(+YQ3u>w_E+RLrOoZ*`P%dw`dJ659ZC z2Ee?ubgG|@n{OW>yiX5=zPUHUF;zQ#_AbKRrRVQtiLBlgXyD+}z6{y<6$(FZJZmFd zk3g@uK)rNQ8xT~Ui(0kcM%ujH;MOhPi*ys?ENzXSv3~=E?G%(R~~#-O55!dpLh`P`#p?u@~pvw4^Hp!&{7>pvw!j zCyaO0g;vdKRKC{EDv2&l-mDET_hAYuHm<|X>80>4N~HZKsd+0@cC5!)oB)d zmFszot#PW!TzcdjhyGg6M$}YBsen*M>iJP+uR1T4umh3+1X#(IP)jnav^rSf-p$pc z1I`>IY>?i$J#KN`VcT`ofLXpxsUrsO^odhTo|xP2 zeaT10*Dz}iuZ1QflGmRgp>ht%{`F2q=@U|-KjV--GpB#eo!=$<+m$(Ezr)H!A~~D% zjme)q_DP4j^e`64=8N+VH%W;~3!Njeg&QT9xVy#$r4&mOZom3q?YyO>ac(=fiFzz8 zXOrzCmj|gnz7Fv_Z|PVD(x1_nJ#WV%x6kFr&1aGaBrf+Q%ma68d+B$s7%HnuoN?%D0Jj``?EXo-XODsQj&8D>4?}|s^Og&ngvc_`cAJ{VlzZK**v_~LdZ%{t+E1KmzHNy6 za{eC*c<=Qj-w)?%Sprs9m5!Iy>AOE6Bluz{gC*gx5Mj3SP}KliQYdP-82E=Y3e5>ip@8 z-ZVaUMFZrJ{2d()OCz<9>3sYYs3-g0|Co__Rn-LwRe9^XBD}Aj;@zha8;yK&?_bKh z!xT5K%3@AHZ=Q*SE%T#QQ?c))t1IG{L3yl1Hd^0#NR8Uft&P5bcD70Nq_eqo3>UiN zb3l8!OIx*WP<}Vo!loT)KsT8okIjAn zq}=laLgdjWW1J#;?F<7fpwOpg8yeG9OKE?2+t_y}??novH@WHxemDS%g`48OrX4j| zMj*$!iodE=-&~`2om)xb1pITGMBkbTATXsZkwv*^Fz=~9>D#yaL9D*GDtn-XJzS#in^^KWRK^xGX7lrT1?aPyHle z^%tO-N6<8Bdk|O!8iOFB!(TFP!!Z@cJ0Met`LI?A!LmyxP{Z?r*_;wL-FN5XDI|h@}9=jnoNX9`n<(E%eJbpKc zY%kBP{akOWkJFuvwn2w)N$J1rFqUl#q10I1eY^hSf0e=if2#675cD5`=Vp9)w$-CZ zOnIF{LOW76W^b|95h*^B9}nW^r_f(Wl%C=Zmr?nReK`f=69Mvap|!ZB`AzB2u45XH z)wDom^Z6`#8XR{pt_Wq=JV|n~#%Ubl9t}8F=p8GIV+Id=Y0v1+fjB~50^1)pyhhN% zEjg2abJMMb`itHD3bEwx_pP>`EOJYXUxGyHn5&R%Pe~@Bs7;UwHS8j4WsSmDJhvU` zrR)TH2(Q1r$vLnp2HVf4sMxwe>aN?-vGrS}ImnI07)#K;_2}Q~G9ML25YXqm7zAMahQ??=!T zqOLf1K|0J!5sD8kRd&=o|KojmVOsX2H;B3GT}VMU$?m_5_ItSGY-X&!oa1u$>q$2d zi*@==Fu6Lb!ZR zgTs?rjvH!1c%n1e9k$lyRX`Ce%EFX#T_;4Oe&A#EW?4?_WAwlDUK&Jvu2H%QO}iOO z>$u%CGEacQtC*aW6WBTgF~uMhxu2ymAjL`UD@A%N>Fy z*Rb1JZ-?3=JbxO$Yhe@OAcf2$N_jn9T=yn!_>{{2Si4PMZsQ=zSAHy+mzQ_gIB0Obrt#Zu zrVcGSbE1?W>}Upz_FGj}^8@j#i{Q4q1T0<$yVBmoaBA{@dC$@jY2p&icDN6vq_pLf z)?xDOoC{F}a96Kr4cx4|xK=v(pMMQ0eXz8A4YcpBYk>YK0uWp3)su;ax;1V^q~-YLfNL`J=<{pmsXB}3hRv%B8-Q#o>C`+QGgH&B`Ap@7Y}fT!1%)7baKSQ*Jkg2mjJ(J9v0gCYaoCWLTs0MSJ8a6xc)&K)s$A z=t_}qQz_&-ah0^r(R+JNRJx#M@7r(f0olSj)kD9O=kKMS|CqQhssGSp&W|krK|n%6 zg430!F4?d5Dly%oME)2ML4}Lb$RGaGg$UfNFuQ_sPb9ko&mmmxh{k;};^1m`xBMOs zhigwbsFCJA@x9*(xUZSOn88;>yQ9%!C%1<|kax}25LUj?`fHX@`^KYYhz<5(h zbW;EXb#fFafKhu%HUb=oN!+02D=&c=R1G>S<2VU$q}oe_x&^FA}CY+vq8 zP6WQdf`jR!IwAO$W2$^~3Q4!wEZEDX02-0)+e+gd0MSyz&f-dFO3O3i{!3R~9LGn` zWsE7=c~}d*B5~;svPAY#z+0GlIOBaO;I!J;%m8T%ridILA4h@ccti9SW;|wp&*}k| z;Y~Sk0SdB}$xXMmwmJa^<3m_i443>>s3=&Hc~fOW9!I;iXkD!=HJ*66!?)>|uik)Y zu&rKttmVS^|t}`6^@Y3I1uLXnxaek7j!eEEMY-Dk+i7itLkyO*_Cq zs0?HY?<1BYO1V~+G=vWBH&Pv#V%OL_d7cj%YpOI-(Y?oMC=`i#p7~!b^_q3qhfSbwh@l zd+jbs`b+;1$oeLFt?Ds@P@?|k8p!_`bejaA5^KsF~PJcnet?&f3jia zzl^q!@HXb195uZ+F@$aHBlXp9XN@6l{*pODe&<-0sqECT_nT4 zPPUmM1_4-9D6+HD`c3=ww$9E@A|K^CPtkXB^qzA+E2-2oUDzo18$y^PdGbhelM}?- zA5}sR;_Bs|k9;F#!)(SPOmmlUZtdKm8Lu6SFkaW7Q8tpxP{Y4KG!1Bln>;`&`%8|FbN*Sz`oY zQV>di+$}3TNrtM;?@4_NngkwNM?L54_rh(*eM5*V^G3}^m$3b}dfbgY9-)^{=VULw z175lL;k;0pn>Za=(w!b|zr}^>p~T}mQ?zXzlDn1LklRLy3-r~V#-guN{2vf+-f};- zs3Kh%?MhHsvbPp{AgQe-)CMBRRg8`V4vQu*KlkW=mycJg=4V?pt@56CvSOLB4#`mr zsba0XojTr3in}q)C)%k9^r%hgo3^JavB82wrX7xY%sOrDrn&-S-xw%!gHw$g9+JQY z^b>Qpx6tVNnaJCOV~nN0LI!5o+Q_PECA7b9&?8$V9=t3e#0Ct(JM^*726K6@r-l^j ziJc3`Jbff$SP(XpVphjWO}RsvJS*vq=+QcTSUi{BXLGpsiO*)dtHrRiogXc=J=7&a5H4Q8Q(5)eSDnaa~I=@ zbk+Q72HnMbp3MjkoA!0miJ~TJ5<=5ji9}6mou(e=xN|vvXvfc*2uY;lWG>ZGa*|N2 zuszBVU5mRtUrE}ulH$$CrT@LhZ}{RGKTp^*r^@^9eK!}4V993{TB*T;3(C zoedk=m*7U*r6Q=M#hZi;{(HY1cgZ14W1EewS>2Om1pa}@<`ofzn0aVQHD``-bQ{gx zIBIu_z444h&O~3wDgS`I_fnYVKxCE_p(q_PkLt|$Ox2;`zM7Va{8J20Wx>?|`+r+_ zK>IdVpDlGHeL|AL3coVjXak9-eJ|sbaCEyT`I;f9v=ha!KXREEllhABvo0Tp121w``uS_lB17QPED(p zaDw_qn#t#PZ_p`@8qq$}(LwIVTdkYonuvXIDcQ@>5-VGdO&;wzLnQJjgr!cn)31}D z7S6R)239WIXm=q-n=kH)*A}LJ{@D_=Vjf{zXOMc5o!mCAiBC(gxTIG{hHLdzWXA&; z`8KaptNtbjEK?j6`cO!i-P}1-;8#*>QMtiWvk>1q!>$jH!uf^|_lXkeousHDzx1}s zBnuRLUha1165p8(85@o161e_ns?F1hp^m&@C*&p^R>xB=aS)kDX?u4bMwS@)vf;#Vi;EL-t@?v zZf`GKgmoO(a#jY;cHpAjO|mG(-hGCwYFN~q?=1M~^_MZ$v{G0`7iS>}XUI0dF#2>G zUeNHc)z)I}r!b^f<4?o?h7r&)6WY{Sl>eufeb0`~D-R0%9(<=^lc*4mz)0 zaTS>*qs%(Cl+9_VbHZCUJoKUo%a_J@uu<`oJ~J$&~VfV>>X-oKb(Mi#1D z7!$Rj*3X{`(Ko$>Rx8-8aPw%WE;?EtvS#QR*BV{=rKfh{1WliGX8LQM=Pmp+TXbu3aE?-R8ieX2)>HVzx#P}&-gaTL`sB~!kx zOB&XtJ+)(HaH?INyZNCI;2z(Xi=|Y4OnY?a1vo(Ml+pFcCl`sS*Kx^7uC6gOG>kTk zy&+^|R`sHI8*(gtRhGFsjuY5%@s%O;*V-76q1f_p=64p-nD5B{07bE?Y+P_^kAk3< z)p`tO_^Uko_draCahRIs3_RCN!ZmEa0xfrNRfz%Y0`<-{VoO zAP(wSr28I{PrMeqndbW~3B`7vXXesG0MPRUBaOXAU_wdL*i_4goarz^;3^4Tu34rN z=%sY7uDeL35FBkF z5w6v*-mbytv6zziB+8Z3^V$xvRIvK)u+n@+>Atx9;Vz4b#K$cyeT=o8k#C{-h@BhR zzij+(-mv=m+?pt#;(gJJ3NyDn{K;rLJ54f9e9C{>$X*?_-N=Y$|7wbD30Yu>ew|Sj z4RKKFZWG)ndU3opOQVhRFQ@V6@2O?zAhpADop%PN1#T2wo@deDyZ%pq`9BVM4Orjj zlP@YR2Gukl|J%3Tet5$ke@@iTY1N&K=&LB+%&k5t)Bk;9{EwUB9b0-LSE4$dc8z{d zr1((=I9OYRzhxn1zC_# z4>dp7ni3765wFU|2f5~ob~U>)LuVNAg{#`Q8d-|le4qf>(`TQod$tBhoEg@(SMF`U zxhmKSz_ACIsg~?R?^P*UIk3wn-3KMRSU~)E%Ui(0$T!Tpto9RVVtIi)wCJsR*elVs zU+Jg@9~=(s-d-0E0wgkNbg$nDl%=wN`Iyh-m9z%4VnUQYkd1zG7pLDXY$CX#VC1ac zg(pL2RM9_t3FJUdQo$F-=9OaV^@xmy;)~a5LM?l6*BAtK;NZmQ)LaBZ`a1f|pO038Jq^xR(?FF7xj3*7IQ{6Ye z;p0l~GfD>wxNZ<#CGYJdEpi4=eO>Fc&NnioGx7Gr%0SBZL#>A@3D8on9=%=tZ%vVV zd^XL}QRNkG?Y@v1u}rNE+0_bE>3WEe5_*V@ttUlLs!FG1$MQ7>gY)i(-k$_jd3n{f z5!Y8AY%QbCv@=UBeEL`?u#1$}H-FdV*B`5AK&&HE#>c1Ut>k&?oYcxGzepVaCAFNX zg<6{KkQ7hhE`GY+)*PXi-govk$@pnFJ4ZWj37YwJqOw+!9Y<`}EP1@lT`McUykYk& z)wZv$$zKY!X~gDjR9BaTWh72^c5fZJ-K|cImT=DIxRB$&MDCg@p&umwwvpt zMIUv9%P_wiMNaI>-ZGaHQ`oXN6Wr$N(eiA>W!QZdfuz@j1QDLN1dDYzpVNpimq?9s z*c4|nSsCoiIL@d|*%IkrL~;x*E4v&i#CJgwO~NRC^ravBBk{>H1e`47yleM+2g{KS zgQ#&v_4C))Y!0Hrs8elg(6(dm5MJqJxh~_(PsgHTd&T55dWqity9*q9_LHpY>@ZrwU>Qux2Uoqb#Mn>2Iq}r>#&RhA36jLgQzb_ugsA7&C4r z6n=`(DrUAyLZ?1{9Gj(0Q2{&oT(S_Fj{4amKNx_^CZ2hRghmaPVJK*KF<64m63rMZ zX32`MF_aPu?>I$0|)L7a%;*_h5=xVL(xaR#wp}2G1@%Yx$f89+?{L2x(1e1IraHlFaos9tm^2cEP4AD8c zX&J^Co9FE@a!9OBfoF5$Z)?Qz?XDS%^rK(h3O$ME0^Hw+ZEYehdXGQVy^f?+(y^<} z<7V8{`@0|IwYQKnkQ2F*HSOH}`?X^xM1?6}FPNI^SR27BN57z%Xw6WYW*>+W%(uuF z-zW@YQ$WX?Z|DE=ZQd-GV6-VZX>dZ;3T2RT#KiY-<#8-34-;t%hA~vD8&g$`j!G|m zTU$T1RI+2;>#sLzLA{$XfBs>hp}#k^Gr@*k%H1tSs9Qc(m+uw);#K6p$vUW-$uC^? z$CXXOJl8#g#arAW%8RHm~n{O}*6V^3ypz!a*?tAZjx76YPMfoL9-P z-)z<|z=eyZxq*;JtPc9qW+Luuh+J$=Rsf#>|8bl6<@2=}?_#HJUR;i14snofhDNiP zXWEpH4ISS~y}Opa_p+$pB;rd-QX$0&OqZ-IKJ|~U{XNkkT|V4)68B4K!aw-bo%~wg z*Xa@{+=Xdbp3)2Pa0DxSyY^lB;qpOaP*`W#bx`VJw00($>(N&H6cYj5vm=8!r0ceHt^ zG+}LT#e|WGca{f=!^w-h(5HktsqYd^lC=>o_lh3nnZk%A_%wswJ|eWr@U4@j%@WtC zkBr=$|E-c~%yXWmCi3Bcg&+rSdp|EP1aved;(MW|_*psoBVgwk3HavQmg{-bI^Aqp z{%zNzoPOo(VS3E zf*9K{jVx6Km4$_%q_nUdC6>sEXI{%>&=j_fgL9NTPv*AX8Gg{o-&-a`nyp4S&nW+bMEgy*`AU{JV-i3Wh(kbcscuM@B_4Ozk0TgK0fUXX^m*DN+FpKEEM-t~4Z zOPhEycQr?ua!d_?t$GtjQ5L~iOe#Jf-Vk%Mnay85N6N3N_Z^oN`kz6?&$lmC-F^Qd)l~7V;;uP8Dp9vema~>nJ=!%Y66%jlY#N41obE>SSZUkckf~jE zTAqg9{cSLgZ;WG8B3)MY%0EP0#GJg$e#Qy7VhbW~jm_1#cl*@8lDcgdeVXTtzjEip zzTj<_+s_t;PYJ!fi(G!rpvZ~2x`AAj7> zFBh9|)7qYPNtIij{K-TgPF#e0IZH3yZAyquKx*L4}1CYUG-SZ2)(5{ z3DXDn)y)v%*^ID>O>7t9P44+U!n;A``b|+)VJea1*J>d7uU>7*#Ke0?%2xNIv~LwR z!`wKI9R|4SGxONaPnKu03=F`ah4&O)UM$(60$E_g8}>6FTb4f3s8cOo7*@|EQ(8Lz zC<%dd_OA2Zp1emw@DeVVX)JN>SN1Ljt*Ir%fL~c@-Ex1cIK;pW#`^g}b6uD-ciWd7Kl*0optC z(#1SX51%bt`d<&O42!Y8mQyoQ+0}V#d4s|PPowej3`q)h02d>K1%ud4am!vxl1(w= zg^==o!YM?&QLnMK0IR8^F#M0!x$ek2%`kLL6EZapS2OHy+gYbuS5mTjLMA`+sdk8? zbpA+qYn<+W##{HzT*RhV-YH+p=Gz2gT9$@y>-g}fPamf zy!g#~!)6(x<|3X9t%rpbhK4xqR5W`(s9hA$(Raq|-TUL0vPy=A+3ufs%8{JbbBZfM z;*Zu5)Z~h#NsRV$A9sGtiM$y0gDI9JoqgQ>9_gJ58+&ez>Y$+HUBv`FBhjzy8hUqc zy~JqB_^3ZV?~m4HOCSzD!=o3RH-sa0Bd;$m(6+%gZgNP-bU-FD1WfN11wXT&y?LD? zoF^vyuOCFI;q3FB@OY(1uIwx^_f)y^OY4eA_&UL#|DAgDnepq4vRnA>hNIAT?P!m# zopad^SNqYx1j)0%5<1=T(5h!HsZ;95@TN9p0@ff!-Dh7?jlU*(6k7Q`+DOtI^^?v_ zRFH&gM-hru(b!OOwy%sTDJ-S0ABDU4Q;pMamMXQK{mKn<^640Dvwe$RYxZl9BBZf7 zelj2tY7-N2Vn_b!VcD#N(2Px`shl!Y@HPHW2npHGl8mTeeM{*9)PWC!3?hIgAzNg` z=nabqd`QVMmaA%~yv9DlhW*c&Ia#j9Z*ePPd_2xa>z-B&&&dKTCKRil78Y^4acYZo zJqpu>S=(BMGwW@jXt5PFqxX#dnLY?5_bq?b^RQ`>ZM z-~0td;|}LPTvq$A*%-|#Y$cS9KkvRTAlz<#Z_eb+>Alv5z(+S@1{tucxFsx|pM}uv zf1tmJPM>9|ywP~-VDHP@p)}r3B7S~UUHnRDrh3yu_wm#Bg;G)Yu9c z9o;I%;vTH;*$)0sOyhM}qJ~&90l8r38Dkhkp}I|$1=XX>^eKR(<{(0<=&&P zT|!Zvp^w|*VZ+q2O+iI?GTR01b6*BpY0+uDq$YB8?n(Ob`VN_$aN34WL63K4KOP0kxn#v0ckL|1uwi{z znK$Ml$S>)h*X-Bi(ulL~7@g&k>yKId@6qJbhAO<(J1Y0;%DPTgfUeeU$jG&01Xehk zH`YZbwj#t{(wkP{O8&(H+|M2CBkX1IGTrwPtQ#r*wk3JoPOI!+e-)VY{~|Z2u$Y?6 z*v;C$Rvc{~Oe^@qxZ}G}MtObfLMHab-_=1@=K*sCUW({CmuYkyklQy2a6=&A!EEB1b!lZhZ&;+$#7h$cvw@ZpnzP5r`;p^0w< zCrwvyP<5X5_2G8#R}O{Ihuxz=I>BmV*AmBW(?YboY$-j8aA4RwWH5f3R<2#oOX(OS zQx-${L@Pzd=Wc>dViu4H$s^rj3ndxXd^yrkSCeb>Au{J8+WE4sNg&1M16c%lfgN_= zwbZ8;;dRr&?J>kjK7_WX@%<;r9hR(!iCP|;Kf5l&>MV*LlFkCk&RIb+k3W%$znYU34ygwu6pkm2*oLU2II)75;6%Exh^c^!l6P!WW^#c-RFalEias#(vz5&k>(Y zo4!G&IJkx;1x61XciAW6K5$@Rj>XJzYJH&-+sTJ0U75tsHB&^mp6wGP80pD1MGXG( zJ4ttfpInl|w)-B>nT-wI65S}*ohh-%mFBlm?pz@y@Ol!9EW;Bc~4oe;k zQ(ND3ylAZI*~wD08x6{A-o}Gc)TQ z-avtaeIE;n0ws!A=6dYMm^VwF&o31R16(r#Ec1G)#tckj@0i<^-8El!T6?s9+k)Ff zztv^=(K77bPnuMikx#V5&ZmBKw1%0E7gKbSkW%W!_Z}6mwDL5=h#|q1Y#iLR$>)wK zHiwD&AKRA&udN}9ZcJd;C!=|rmyMGNKLQy$gG9JtjYXfZZ`mu3_%|6v`4kW*QDC|J zUYaM;qm>kE@@YSP!k3VW>y%HyriW`1T_0|kCX#mXOSIMF!I(u6G+&_AYYiu`EK7sT z2Px3bvPLmOmorlXe}BU!Al%x?-Lpin?tw*Yu8kH_t4?#dhF5&b9Xa$-BXcg%#>Q)x z!K{6W7m1pN^E)2uWhS;O2_xH3?JJ*RS!xxm3 zu+ls$J@07hSPLzOF~$C_Mw_@2VzYzFQ+~`L*26L`)6bz0)}B*tZinFQ63Skr%IDY9 zbq@t;P{Ff9?pwtRt!{EHA4dy&22RP>Gn$>N2p?)@?+c;m_myE^j#YM6EEDY_P~9W^ z`fHq4ePg?HT(L!|Wy7`!Gk7*PM()0UYrN422_cn&tPfCRs%9pW$Jo7-$l-M zq$F6ajr2_$AB-l^ex%O&J>n389wT%m_uXt0=1Vv!m$4FRl^@ocehur*BPH)%NFuba z^*@Qj{GitoxEWfcx8mp!Rr!fG=})%ekgwM(=I7)KHcBXFI>=LQRe#>cI*Fcw7H2w! zAlmDoPfF1&lP87f@4&~3>NsVl`8GSCGKj;PUN)1EvG?EIe7T5O|5#KJ&2?za)2w9rflhie!qUZ58_T%Bk7#i?rOAo-$`D>AqRS$E&?*ME;cCTd= zg-XEL*CZCCH2@z~#Y84kdV0CiOUT@qaP>8TC^E4Utrp=~EE3%PkM-OC(hc?E?W~>w zr7F-Z)`bKV>bk-_1WzMhd}mciI3X=aj9%fy&P29M!smOdiWf{ptg& z7oaFx7WR!G94pY3khs{?VTY zfGoT^q@0KV@yot}M_P_#)L~1sAhx@2*KvpNF0u0XP$uMr}G*eZ} zgE~lzI7m{idMF0uK$yBc+KhUj97W4YU?ZkiJYSQgyt--~iL;NMPQMYZ1nxIkw}oIx&uLX_ zg2pD#hd>PDSbO8QURA1OcZTuFb^t$z*`&czhcstJ&pgHoOFC#RZS2q5^ zIf#5_JVu9sNti#;3A6~Uu|ox3reRFZ6tc8%r+KC3@<_iFGHe}DgjJUe&}Fl;5-n6-gmla27YY~NC@ za`wvPefPH6k-9^0Fkd07+wpT6RFS3V0xgf!{F=Q^0o%z6r`;AZ78+@+OL+ZEA&_?3 z1ssP{fGM8ibJg0r{p#;OOz^_FCxrl!_6{C93*`6J*A`r7^Uw?eBW1c|IO-8sYW49` zf~y=0gsPHo<}4Hhhl7rWeAWCn4iunyB!dw;B6YVjH37lu%mlh4YV#chnTY!Q9J73W z7yCBTKCIvK9;~UYCgs00=yE6U0Qmojz3XH)1W!jtha}PI3Y%?CuAR^M8IS;I`4 zK>VPOTl(rzllMI6m#to`Rl9Q~lMMVXnWP$4N(n4atHf3R3Vf+?#slcej49U{@!hZe z>jm|7*|V}V?u@k;*!41DO#_3};WAydTWWlLIBFg@*Q4c2` zpvPA`G%uwOJ~)>d^gt^Tp5M~>zb=wquP}f9n+5QHOw+9Hl*R|{j-;3F4&w0=>m;Mlr))M6v#fe-FBja!j3=0-fz9?)LIdL z1wG4BH~*4SqjQUU<*t%B2HaPYW3Re-C6^bc2w;Cn5K_5?u)9 z=bWO~0dI0IXGt0c5up7B`vJmCU|FG~27wNifUu4Rehme%44IFE$MvdtE@g{O5Irj%YQw z0j%@=&7Oy#&scT!bO>0YGCup=ZvwMaoZ4;HM>;|F%AsMPHYzV_K&J0zh`my&U%?(1 zw;6Nu@)TK8+m_VLrFnWpl^=?QlwuJtGV zARG8*KK1}@Q><)blT2!11*l#1>ucDI;o(Q zWr(HwLElQ`BK-ZC&{&C%qX(5%OGMV)27WY4(j|-Oky!QT25=lALs7DH4vm6k5QM^dz>Vx@W9y5H%%)U7nKGG z`r7F2f2q4@2_Vxsqy8Vp-ZQGnuKo5^QBV;95fDR_2aqnk2Ne+n0hQi6h!A>*fQW$7 zmEJ{q?_lUi@14+l2qAO`gpk0#dEfsT`@`A$oaYlGBaE=fJ=R*+TGyPvNg@xP3~Wiy zaI#z)Qf~I!RL9=5@5(@XNX>ghE@+ht=>KDPvK`kF%7s1S%@jm}c1;sH?sY@|*Xja8zjIk*)wOQ5c=DRc5*4s@1Y??RLy4wQ#Nn)_(vE~B zztL+Im4bVC42GcY;$qH{SJI@(rlI9ed`IvfQijdf8$WZZ>W{h({VtY_Rhw>#PSbS- zksJc|4%U!<0lqgu-M!mA2_LhN> z@`b@-7iZ{#x~{OCewt77n`wG_$?Mkq?Ov$8yL3v>(%6kAoWjg?Y59 zBTZ4Gcbx@hO8h;%A!>F?Fov9*>7n(S+^$8i{b<7Z2}7(_u?|=IqWo;%MdYG;#8DY1 zo)%g-o~_OFY-!~=O$T;Nd3lA^CR{T*g7?Os9Lu1Ysod*lg|=3DmuVu_l?NI)08%(3 z>}UeLQr10gPZ3IiH1;{wUS|fCjRagCOBv)c35s&Pw-Gt9v4JSngl!2nwDyPh_vsj# zn!DKiF0qImyTB*(TfpD-W4x<~ZYs%4A>Nbrn^O`V{HA;O&qgCk=Vu)6olL!6j$T~; zOEni6M6>?J0frLSXl$Z!Up-fhR?uf?!WB!2q_xrvop(m_1Gch@(QpA!`K{L$t0@c? zCrNGptZ;WFyzwnJBT0Ogo3Iny!n3r`iGGSm(OE~fR|`hcKJAFLbD80ojQ^;;pU#gKcr+ zrhZtT;zV8Hj`M(TlR@08xe~UHJ5?14DBXGk+p*M^u4_XZ9=7QCKv_C|Lb@w}wZ zWOy~2cG~s#Pmyf)blt((={Mkdxi*Iy{1dvs?o6HGT+jaqvbwOGw%_Q_Dozm6j@7dV zt+%PCH!Qm_a`Us#3hpBK^qLPc6At@Wg)P6n`myE|`6Fu$kP>DC-lk5^Lg=9JGhJUH zyL)o{TuQ5BB|@*=eE$mrYG_CZWfUy@v+ttx0o>Ys11#=#c;$90sAH1Ic^Uxky|#BGtkYhN`_ehkww;7rRxtC@Z-%e8}?%#Og{=OVfzu_lbSV^pH9c`4WH7Nu_73#wz4uO z!I?LtXDzIhr;I+T@0);*GW+Ragh;L2S$N}FOig;4t)&VRB(2uwu<}E7Khx#$ote5y zwJ%cLsv9Ap)NZ-=U}nKG*FUYdXzqy2$OMmVZsC;#KSV1Cu-%#|aM^Q*D*df2!4iI?6BA+}|86oU zRvOk zEXNVaFP~K+WvZ1DHziDq0Iu8cb|}cXX?&`|N8_cM{n3g~EuEoF<6Ja4jg92uRAZ~O zC1mgYo=nAp2YlloLE$b&V>TLUEwe|v&o$|wR(iVMghN#1pDHz(64d6R=kSF?=046T zk2i`p1uMhvs zXL)s~qX{7M5G(A~vJt2GH;0J-xdhTsVBTdej#OFypV$9CKU#^uUGpH{!o&eO*eH4C zWRIwlSx27#OGWp8`mD`RK#Mp{9iw>X|Mc$vd*EbrSLge|PqK^fD+MOeyc5ZaPqxmIzibkiL_4Sov*k$8@Y9w}^ zTelWbmlr@Js;ZnYIK2I#VyA9SjBMuPnkzzcssE-n_F}_pNp0MEKp58J;oL%zd-;|; z>BF@CiKs|_`h00+Q*2dbpDpF^VKAbgsYJdR2z|7j%TZQU+-ePw15DpX>iRxKk)PI$ zA&VCwjNIJDnf<7d^O->rBc*~z25Fyo9CFn&D@6mRCt+dCht>;LW zKJ==2-;PF0wK^o8Mz-&-=s|$T3z!Nb`*L{E>l#*5^XziyExXJ=EZOg0-fm(I$oc+I zKJ@9Y*59{vpTEh(<)D7gzBOpEqvEFul{OJX7KZTAtbv{uri@Kj z3|nlQ@pa2z)-aG*UZOXZF)Hs9^eg=MJJ)t1<*eS8v88LBz59EU;FkR4tpevec<1PF zzq_;cScDjqV>0Fy^=7^8r5IuDfTJ?LlE08etyiv4AnY!8f^YxLqty5eFh|qj*3sXb znXV^CANub;(8-!TEMn)alQ2nIEz~aA;3dm`9C14E;J`#6>+zQlqZ_w+L1h~xMcPD- z_$mpx=OrV{pF?0Pi?WyOn61fv%^Jx?-*E=i4~5rZVob_j_((Q$p0ZDD@ZVlD2E3EA zi9_ARUPEDDWjx+;;GYi6;6mq5So!^+@>CR34;u(TEUlsQ>mmUNl3b%*(&Q z+1IpL$awiE7_aD4Q(p@)DYVfi@TCdAyp2R|1j6;rr|$RXB&1~kOup5cl1SN>H4hZI z|DU>imxag-F^$5!NVH(%VqN&4($~v~h@^)7gU%Ei`L zl~H>+&#PXnx8%0ppKBQ~N^Jp9W~jsdQZfBVOU9oPmTs#lmA z^AnmlXmhRKOOn_lPkPv=7|eyMakLnvK%AR?&g`L;l*C1c`S_>;)6YBAUTM!vU*d4u zWqeaheuieLwaHcQr@LsHW7mZJUFK3jE%zC@HKPwuI?F566QiY-ov7|cqmVDD-Diz$ z6!x}(NqPF8(Y z+C2@^|EL0fX zhN;j~deQ6JAd1ePH)Mb=m1s!2X0yllyq-$6Fsbm>A$Pn+<+!Vp!ylKV(H^6g{l<2Y ze2qJzQaPmjIM>XqonE>;D2s^ga)9RC*>{0(x((VMDBrgAq&w3vfw);5#*bZt8QZVT zyPeN#M+UjqSvQ*TB@_gXtT_AaV%lrxB@LZX5)Zk@W-=sPw z+I0(3&SgCM7NQN`gp(z1W&;Oog5K5{>fMi){i)wy=xU*z3H$ z<=^ft)9u}I8CH{GTV0z$30q)@7@fPQw(J+O#et#!GhF}*)kGXZ=7}IUVaW=w}T3^KE z_+7FAwoVu0`D5*R#eDzaHJP6%xU3DU#vzPs8*A1(ha4L8w3*Yv4yDwMkspuAB0vgD z8r4C}+&l-%Dg5#LmqRUCgvX|C{Y&h8w*b)PT)O|VSLb9# ze^b7%Cl19iZVh%zvj1G4C=HF2?SS_X^)qrK?C^+-%#`M&tkVaNL?6Y=VQ;dBla&A7 zHcxayBdg;a>SOC)cMKS;m_ySy0v2c21PwaO#eZv8{Ou-w0#mrJv-BoRHv7+o!u&I2 zs1T;as5_D&27LCN^g~%XNcTQf40^9jI!#1b^dT(_>}aAjA zxKJHy!zxg3@~I7Z8WO`ziP!fZr59F9KO_!63VPhIE~WE6n4Y^!iv0UXyUu>oo5KJ< zlA>+4s=)g`(NC^hyvF0gf?FnJuY1N=hY(TRaebK$h&2}}W)8ifA2nA1{ z6AhlfnUBdBlgEy2W<1T_dfM$%G1YrAub;IxDmDSW2bnIa4hnaJ{cgt&$A<_fWeLd-%JINgu<&I?FUHTP#Ct3iu1ieL{RIL=GE6&mUAMsiS<&2 zT%wSK@LBxhSO4m9bjsJ*)C*~&sx5bo}Lj z?#MAgCc~bQSe?b3{y+i-PI*gpq3Hv*Vzat*_9^A{=SJ}&w*YdHmi}0 zdm@c}@OM!&1gm0a-s|d)*R5xnaX$n*=wHa-7ai7bx|tCBQAm)tS&L?a?%km<96(SU zNu1=1F;w0X;Beu6!of^MO>T+z#r`nPr4!06vZS?jI2W|+d)Nv6h)ejvB;4}ux!7{L zanz5B#-Cu2ekJNvYOzZz5o6PEzn#kv9^pq>HcXbDN8gW}W;d4DYC(ug{<#oBLh2yF z+@P{$t0SvOri*8FuKi`b$DQU;mqrdxQk2x?lXC}uc6B|DfUAf^VsfclV=YVR3>@mW z$b1F?%0E2&tSrHI@^P|i^tec}omRDQ%4K6kl!z24w7+K2iqI#5-mWTrD_g&UJBIno z&TY@>P~SHRxXi!7WERvTV)kU?&}-_GRTce<=ar(nZOS(zgY`Fza7cCX?A{oox>_ZE zA*%t!x$tQj2JiiDQl7TS<7MOYey#W${VFrd-!8G6wk*y!z#I1-D#C>dK#?L&wL)s+BfRmA2s&5YSffo zpUW`^`+Bb?+t_mT4#RyO;!Y@AT%U(C*;V*e9`F$+&gK<)ruj?DBo%0{zf+LHcia|; zr#m;%95Ou854|g05m1cvHAo7_uln5q?-Q}oGZQOrqvD**$CbeeCZlaVw$I={R; zbR>7%FYVV-L~b1Xj)A44LkCS^stZN zFNmLd&S_rQdHu(NTwmvFXI2Oz=;)_yWjgU64P}x3Y%=Hg3g4l-E`-vEG%5xy3ah-^*nAGenr5M~T+&>_LO7d5lDA4f9v%#vx<bJP=uk0GrLDc8CmBGyc(7R*Oz zm!)iXfhcBUhoGh>BA>47mHDg+sWtR$m=3>5$zxNK-QUniH#eDcNv^OwYS_YiUn|2H zFD7k%)L3#{;2&lIdrZIgjy8Q;RoZ&LG%G_;z)3dzeumn}Ew5%LRX&~4UQzEeTOC0T z0YEWr$h5OaLbs1~`)jGi< z$e_+J?4L0IbwNTfgT=QP_wMxhQ=g~4pXbwubLutdL^oNH<=@Fw2FXyR#?S=|t|mwS ziSld#LW@gjt%MAzXiO*5HU%J->7q=Dj(X$!n|%A?r8{KcE(sQ_vnngO>>xZg$bo*}gcVjjijw)W(Z zcY#jnK5VeG{k>;V4aU;uriN=?--fYU<~_)_n##|HjaOs+kEM2ki?--lb$SIj;JWJ% zrVD;}CM~sIV*vAUUIKI@mxIu5RDCb@FS1N5^>(n++6js_>iV3Cy-T?8%pY~BwFS@H z;j)yHK-<^9C*rSlO;H~{IBI${Y`81WIca1CP2|ebPudtRRQE!}&8&_Uv1b7Fp0z(8 z9KXYn`dr|n%&X5B3~-Zu7U^Ymb{wg@RDO>{3#8@00!cx+wv+y<@*0pYPDy|6$bz6h zB;_VG(x+Gt>9&wI?2>j-LLQd^@Dn-swk1`C0d=HXzkKZC^ zYkt0B_KEZjLjpQV-qpRLTk(uM0w*1@(CICMm$4A?xE;^+YMYK&kpEl}`{h29j`*}3 z#Uxe3Sy2$(MRilb=V4zOBc2EKt|)t_qtCYnMG6fvsh_4?$94x^B5-Rxa$CEzX$LOz zh_uD#7m3+aj9|`>d)r+SKg|0Z+8|XLLoP#I?ObnO=x={$|NZEOPx&O<=dW>l8kPbUL(htGXVCP4{0BO z=UKmMQL}doRp4AJf0*Hi&5+h>OBD`oT!8_+jV_EyL#txni^+^1F(E+j^dA;6%Ah|5 zjxZ@AOEsh^e7piF{J%wkTlqQqEjvyA#$9gK>!1L9Lo@0 zy%niJHVM-vEna|rvqNoe@t^DC24_JMJx9&OE#Fk`_PX)AjDMLu zB+jf8ApX|yDA3Ge{)fM`PR`<7r6lx&4uBp_zBVs*qcv1;{Xkt|afD>vjvB_Ab}S`YnJ{o4KW$$8 z#2n}Paw&_%%hyRTV>!+qcdg|QY&{hmVmE)@I$X%rENL~6c`NrgA=cU@&$ZyKz0U3% z(&p($@hV|dbGRzBk)J&{3~t{3r}KI0>H(Uond&h_vW9gna5|r8{Pn6f%=4*AYPj;9 z^G`L^&~`Jpu`zh6;D#Ye8`=Rv$or`Q+1>kfM%st&EMD{%JF9Xg>)zOg# z(}zmUneZ}o;rD8)vm(mKVAzt~W^@wuK&IpNC zWYE`>Mpg&comDJGKB}uwYS|*cY+Cw8eM9QMyEvEMq<$nbvsb_7{)17gKbhLdaLXpk zpxnX^d}LH4+n;1cd=@#z+S10cf&O5rRAn_!7G++=xfJj}J2#ey1V?4W#1tob+i8B6 z;qZ@4hM;gW$i2VJW|%ZX0Syshy1jQ&Z#>iyUEM(LkS67nEcIES@@-8r}-CzWwf-@A* zZBd?bd9V;aH!UOsgT%2s6P4mR$9x7?H4mA;BC($~XqC8C7PCnDp@d*~Wd#O}n(=q4iOxSBMnbq91`F&fCo#|t6b|cr5gzstp z-5*K*yFZRrbn#uRQ9<811yZC*tT0(f6lC=(MT#HL()U(;0(})deKv$3sy!g`4L!(_ z#1Ut(cxoxk>sy^V??@ymBq|VUTi3d-9sQYqrf)L*IvZ^0SA-M_cu&?p7jE&u3+8hUNBYV7~%v48fFPo*jc{* zKRe(*)@j`=r&L~e!1NucVd>Y7tZ?BK2AjTTcg5na8TK6B;Gh0OR#-sQz`*H3K3pg0 zYW`U(6E&WP2FV+#v>*50z2F)Z-1&R~$ZEz@I=pj%6w|5)VT%*x!Urm##-!30d-jhd zUGtm2TP9RrNzT?!`y%^bcz_y`3?MeEgnhA&WuH9OBaGI%BC5oiA|DC-Hat%$@!YQH z7A9YR!){udU@~9lVBGZG^w(l)kq5Gr#m#aVXb=UoO1}6t=vuF8_jT;wD4a|J<(97) zu1kbnkMaEXSz}khMWg;;T>_@eU*-yNfC4yg_MPpZ*Y+(0_jCP5Pp2YL(V;7Hr7M8y z*y0G)Yk85G$)fJa;sQENQ%|m>V>E5|H2)0)<1?!xp#KBx zR^C0}G!H;jyv1?%q*iTI28dlk1&}Z*`k(b1A0NG{8fQx|_^pO5#aA0BAm;fp=o>d4 zHw(ffp=kZ3%CbG_&0m3b>d|WIi&tt~AjZpY)*?n_>^cekJ3~(qUSG5QR2Qv_S~lZR zY2&39u=nw1hr{HNO&_4*9NjK{ttkw!?^-2a0@7eOWqIbm(5fykgtcBJ+@=H)5#Lh; zXb0qa&>D7QZExT~=K?xf{s;h}u>jm)Uxn6*mP>MlJWFu|fU1V|fCLSrS&kdTjA=vT zeZG{vLevqkN)usx_4yxhtF$dTb~+csm-r}%6-|W0>es=pc5>Oqv<~1|CjydT!SjjL zIBg>vP}WZ3RMy?|zFAC9h9et=PRi{~{lqJU^Z!+`_rKpWfv~h{e_aI7&?o0US4i2S z!54LH?6bPoX>s1CyJ_sIsUIg9;#|^b4IBd?_nY^idsSt87+h^PAUSI*1c<$VYE@7G z)bo4;6Bv? zR?*v1mUXY+{fh^0OM1QeeoTuHl9qM}I!Li*Fovs9l!{De092wY!X(^} zgDM9AJeENF;>#)#QDsepgDC%0?AAiv%k>>VHR;fjgYr7jI(D;~sS9?se$8%1`fr-d zU$3?FcN?>rsqg#_f;(a&2Z7>)rG zItKfYGh^R82B)5Zi-qVo0A39gV6fjQAH2HWxpF*ovU`M3H!0r)xZj3jqm)+vV!m}# zJd$+%IJxuyNMU*}m4l~YKDKIkS(W9yL$4DUdbL`R(Fy)T*br-}7^L$f--Yh^7)t^s zfU$zS^kiT{HWBMdcKy{(dAa;};*9bSB3|E)XJTq9_lmY`14!fRexbLv#(+)W0jLX^ z>Y`e|5)2vxRM$0P1R#<&cjXEJY^+|-*Ydco3ZntBCVjg4uloCoZ*E>~Y8`oNT6Hga zIP#~%&-=8Se_~@b6%djSxQ!8>U3Av}00X9N!OGVI4u>&o+4C7;+bJIP5Po#1kr#qm zonY1S#m(?c{f$EeSf+>L_L{@sv;41_aKbu=Y{fW`LPhA@_*Lg5jfhqM053J%IlbWk zIHR4%KMkKLjRul~r=0;XEjSYk8;07~IJf=sBcu4=3)%nIcW<)8(#nzJ4!8$8w8JY8 zv?8uZ^}=pj8guj(f!SHklgHXc83N|7afChpjH`LaLpVR>*EzTYB;Oi_)z^3ldhE`- z0!y}TaR`$ic2>J6QI#zC9fH^TP%681`EJz~7_UVTj{? zSlo6eqyFy+Fg$o@N<{mWviS=5jkXAM?2F|@t%mWdPFu@;++S`h*)H?A1^x1@b1B*U zT_#Zm03@n*MSZZP0}=slMHYW5DyglExyn}OQp+K3&ON>oO7pkiopHcCw$7L@>7aGn zq5QVQY!~%r;@`~C8xD5@7~H4ZnosrtSAhz!ZM>NEMwg5m`Rv4Ds~L>}YzYy0c6@yN zl^9sB353p11#TXH3?>3IPDlojxFgm$)*Gb`LxE=*J+? zH~^}heCd6#+WCF38^EsV4cI+DOmTUU28f3jJ+p2*$Eb*M4$Y<8H6Ci5bsf-_DY$*~2B3Q4q*e{tt!2qP* zdln!~hf2z#{_{T^0FsBd+Qv{f8~}d%=-+dX2`qiJSgQhMfesb5rWY2{Ihv(FyW>k> zO_8%xVsz@DtYzutXqoca!ZM<~nP%q@%*NNZstX$r$zF;k%!nh=?txRhS4EWl0ol&K z7%k}O4JO=3$OHeP--}H?c>oBxjEgkm@p@TiW*hiLw?icaSi}mn%ZxNFKW^rya$ixa zv{BkX&gl5n8qq;KRBbcpW-uAN?t3Xhg+w5RB9Zr{NderUq^~$-yY9dwWzW=KY zHMW=;8^q&|XB2a`gw2Xd#&fjOb&o|-Ar%Tt<<;v>4?xnl*dZ2u;)T86#1Isf zYpWQ)n`-5ij&36$pUO(1k=Qv*VI{PT`^Xi&I9SBZShr-~?Rpkx{U{z{Ui!~+eL!ZH z5tma*bLohBXx;~&BKSl-x!zHX@uUqvB34Q;cB>Wed>Uk&#vy#=c=^oZJuF87|@PhKCq%1377M zp`j)oLJdsdt=G^j{;BcCp#Myl!BHjZXW9E^R-LSaVNXrnHGxUK@x;l$*#%QwkPyEho%RFhc*bIoK)-^S7m}X2d#&YhyO+%(EtxV$UVkY*7L$n@g0_?6 zm_*H7<~Edvsh}xv_~V51a^9$UOKz}w$6y&g=?jgBTUw#5W<&OZj@M;uq7G!p`7ddHhKNs1)4`S zx(twwgsr*0HuZR3*AeDjFf_8dN{PQw{UkmE|CF#%CuSi~eW2X=*Ql4Rh}8g1il`oR zuwq{0Iyd)2b|na_zKs}XN8=^|e4WkfPdfFj&uXo@Y95+a-F~X}biD9rfGNVhOWNGH z?E>kQr#OsuPeaxl={Fc0DP?I)$fuCdvJg69fh2Fo6={QSBv zvq=~)ax@d5S%0C9DG2wiyL}Z-#^JIFAtYMP9hTeqmEU2M)&pppYzBIa@9P$|%nPH; zqF`*lA2accfnG92;<+rQK+Q6O+UU$XB{`YRX7uL)n`!u#+Uv&&&MKqc8kfllla@L< zpgzI8-i90%L%Rhf1~2Yg?t`%7(DAWiKmgL2Af2=&Y!e6Fpg$bZ@BB(yJ$hT0#e)rD3yFhQLlqk*+N(K6+B;7Voxu$-Ij*$0Q74w?Ij8A#HWM(gJrGV!A2n2jo@+>IOOM8)+T~c5)MMX=^D3OKN&c4eq!W9GEl7 zbR}~&?VGr)W?PSWG<)QV=-WxUq`7D3Y?~CMvEK%Boc6VkJbB

XENZcm9%b>vfiC=?WMNXhT>;~TOmaxeO&>c8hT>}O=>vHj#%yzqeX z(wTky(axh;jfdc#XK+T~tDbwrd9FuJ&y#L2HTu(`0Q&9fZ0Xh_Im(*^3zh%qY z$cvscLvr~pbqW93uK2L(;qQ&t{py1JP6KR5_E+X$o}K0y;HL4oWTdX7+-?Fod!8mH zT*xPgJRD!I3h`>@KEipeWVy2LtqXW2Wu2S1#$mY+YFD*Qdq#L47+d#f+Yy(v+}_s@ z+Pf)Y+ng$#xfZWnFz3YPP_>RObDLjY&Wy9{&v<-w0GM35olUmt-7d-fae?(+)~%x4 z!G9IX@}FY&Iz^%&XU;(xF^z3#>*Dzl@xaMEeu%9_;!e}?n6gd74p$53ivAKVo?veY zL~w7bm+Xj?cnt!5t#;Rw8SA+`GvrWO!^W3A!6DH-a-Rfwrj>tT{`yZ1I6`wBeB%#` z-@S4O{hniz1KjDVmzq&4<(+a#V=5J#uYZlzD?eYVO;m%JqyJk za2Etl^;`|jO~}=OPBZCHf}!xZv73R ze=&W#yeiKiz)J`D^n8Q!tAWmT3k(0tff9#*_HX}4U*(`@NJU@hb_$@HY*m1Qv~29R zeAsLS0S9kU1$?h>?bxqM_np}+vxO_;ADS3G@-LaL0j&*;*F_1zA$uU>U3(u>FGT<=7d4=e+nJza)0hRjOE1WA1NOwqz=hctDGETYzP~n;?_{2o) zZsU<^(GqaEHd~`0{~y0_q507I=i`P&ck(UemAH?!+budW^fam^XKkwb z@Xsr3;jzgnT2l>;pR|5H($~{?W%|85bLsA+f|vHJZD-7!i>xDiSzlynna1AX(Z-;X ze|_Dd$Gx?`AyHrf%=S#(H~7OsM%jaI%tK@$~CgS_-r9wWMd~rM;A;>C>?j+j;tx=rIXLOWLNPPAnfe4~Fv1gv^&yW4gI?fX1E?af16u;B?VlPXD)e1wbB7A5Gpef9?*+!$?3 zk`cq{r^3Cl!Hx94OzMfKmwh{)MnBl?m2(CAcGQ2_(}`1f7!CW91W@C!`neLp|ds)5RnyRs$;?=9$o!=;i*IWQYe&-ecmfEB-%2z-sa*nJab7ngD9zh-Z(%DL2*YCJeCd#DKte4&w6Q@Q+R(M3 z9Ao3~_mlVWTN~7vXhp2+;~2VL2*O*sv@!8k&P&rU=A%lc5*3U?qkse;ilnvyuGIz7 zYx!jXh{L#H3*LNdvdF>oA?@9i%^~Q^_~s}4yq6QNGrSmfRKGd#mZMWSHG(2jS3wd= z`b|^Ur?%ad6tI2k&RTh*2`*sToU|h`D;41AjGa6VAm28B0x`aV1|N@KHgQ9$-}|du z;W{)#ZN-`M`}EF~8ZnQv5H+bHMGPsOp1B{^E!PLt5?>iq@z5qxJ0GG^Zqfa>YLCU(iLxyh1529O;G! zl@*56@lu*eF&N!(;na$1b6tNq@q%wv+N9mfaOdt|RP}~*q0s!{iPzDhVqS(*uDzYC zg*3!?7vO^*r*Zp5<4%V+UXB}^^$l8^FS;S)=6-ko&(MaF6n=Y#Ra(==_afTT+ z6}53gSLeJe+2a-06Kl1cdIlhsO&t|x{O1`4)s$4yW|&vf!j_RD2&+`vKTt@U6Jy_U zdkKCBRgyCrE(rQfTZiz=>PFvPNctE+QqO`Ek?ptrQapqERpDeRiTx!9Oon4rV=ZO{ zxSGFWu^`8n1N0Mz!BZ<-+v~`U1g^G;UIM!o;dr30=8j-#YZBopOG^91E>9^5-BG|@ zj!A*xXZ(-b0?AjMKzw_Nt?-d@@tu0K5vqm%?92BWXp*#-GYY@yp+OM_rZmam6$yS0-wJrw{6(Z3)t=@)ftB{|am6+3>huk#3!R8m7Ab)E{zk*K8B-sN`7or^^} zZFJ>x4YzZr>Cok^{5-dqR#Ys?I1ZEYpYJn(?Kcz2=ELljiw>K6G%duD;PLo|5A9#sHG8c@P{(+^f z7@VpbLlW>>#*RV4*#dy%giSH!{f)WLvcE#^FAhN0^-ihsw$4U`Q0YFq0y4fOn?UdH zCy*gER(;R~@=)}+?RGD~7oBbXm!;-}a&w^p$UldP&90UhkzQKK{A2bWE-%yhq@C|` z{S#-(?ceTvj(#o(+U|hB56LpNmQBVt`)L(vvi!ykB5z2|$GVLVsz)3j{h}lIrC~q{ zu1*4$fgfR!Zm~H%w7>UPSizYjxGDe36o#TE*S$rdv`b?#8d`|!b8IhJIB%tf5z7)Z zh7=SWAeEnW_PhzdiVpWVef=~Bxgzl=d04`4x*`N&)=pfJN#(q~Kx@W6^$+-)x9b?~ z$hD>b)4tdN<365`zm)l9WuyuY_3{h{j+zrO4KuNRX0I5Rd}GL+^w*ImO?zz}+D1Jq z;~y|<8|@#Gr8tB_4Pxw-yg!bYQ*#o}ze?zaxL0J#4ugDpxQtUhZ#TWdCd;65%i4w+ zU-ywX-|=mR&d~9FIGBF&?h+j)W+@STpFr*OX7NzX4Ql}#fC&d+&@msjaxQ9oH3qOR z?LoTlbkk1dU`#6&0<6u4D(a)i&3()~|{Jm~y(v{YYV}y2E zl8BZUB254ZT~V0rAm%w^@rBMu+hT1Gl+(TUSXWtwO6y0fr`wFV^0W3DJm5b-?+)nF zf1Wyh9@C%*r_d1g4(!K^PZ)y9{WpD&O*Nc)Rah~-rc*FS+2 zlXQnWtcs+Jp)Pd6%Oq}=%nTL7&ZuZce=6$hmI=drLPjGaLrMN)& z&KF8JNoBkaUBBND-Wm=w;PBH?Er=?X%|=?+870y1v?ldc8>mJ|BDig^_UK6>;ZPg?M$Ikn(O!l)O4%ll;gru#%CFY*d0kllZS%x~0gycp zx!XV5J{ZA-?V!fi&g;GHJ;iw#y>58D*r-CYSmdI92@P2e)1&sJiV zmz=sf3Tc+E;WtaqpEhMY7P2Q7Yz4b^zXKr=Bs0s4Jkt3-=*8pi{LXhXaOt@4y6ir~ zoWIv5@+YMn^^+5FCIaes5gPT3?%2oZ3z6hJ#}KR(9g(Hm+{=C-cxf`+E0DF9GvwLC z1ic?f+XN2ryf+cEwtmMY`IMzOT5Q6ncp%I`JGI+YG0*(4XVXWEPHK&i-+sx<;JdG| zQ~wE?`zWpa4bOV=S%D{+(!q%6J1-eEuL#4w=(Wzr3yb0GbjB_t86Dv*gc@41$W5!% zCz1C>`@Y9KT0Sb3yYJOS;)`9Y_4PGdvb;FxApD$+czreK#>;Hi>C6n_xlJ^uG|Ip0 z{u%kx>09QE$$__ygyAMT3OxY>j2M;2=j-JNhTlDFLerZMTNbSG-Krj_?Kw5^fq~V! ziZbu0I97qbBA6;z$iI=g`%{JR${_eV+z6-V}qkjb&Ebs`3eVGp|o?8jW5IaJK4Qa6+iufv2GYj z3$zo-a@O{k)PKdvj7K%`8GA&=@i*-nsR!p^ABH4V=?mEb>qE6tixa1ZvY2kXJ-C;~ zZ%xP&$J7EFQt?%h$T~~M=ahwd)kkQqvRHrX+_0<}_m3y}DZ-@jnne7kkbzLHT0gqO z+}5ThMlO=+&;;T(CUH@dFfN;ccLSlh!-_plr*}q@8;F5%zpw>TmPj)dZn2rv!0&r99AT#f;%v^0xVzlDRT zWv4Zt`Ub#piVBO@TrUGWUpu=Bur0`$BUQ1!G$e17pfy->6@@ zn;VjBJoRfJQE!SOE$3-@aqrT1`-!sDrxBa5z{c(R-dkM)XWd>&BY}|h*0$C$)3z@X zs1suYEh~td>UP7nv|yUkY}`g(gp{*NB=(WVIaa}VkaF=Dw8qFdmA%fqgAm{lp(BRL zJAUrDzVV>zbyk4>k7`b?;{DD zxkrMzcgs4OC$$=KFQrfGi>deJH)}B8hM;!p!xCr9N9k)fWZjMfhV}P#WtkJH4k;R! zU-_DJVM#z1y?4yz@-BL4yC;wjoJX+EDVx=m*#4tsO?c`XbD^bdr= zq64;FBwP}7`H6px$RBo(@t6uO_+8Kb$V{4R+!);awr(|VsWl=IDm~p)_K<=V8Ub00 z@f#Xlfh#05;QNFe^SH?7EnH+8V574r*(r4_Gga=e%L5;9**KqzC^0OrP9V>nqYpcP z70x&k_01Y&j=RsX=U`FZow)U+$t1Y3gmU8b+m7!U>-2wkb&GwBBS>yvK2l%q!#nnR zfPb7UK#k8e)VnCl(4ZUYd8#V@KuqW&<^N*rtOJ^S|97v5q9P!oG>lMDQo2i2L`u55 zq`S8vpoGMvrKOwE%>e0cMt66|7;v6_&iQ`-Ip_TR{HcuX8M}8s_xt_6uGdxBLDVKc zFe#ybHsdOfiIN7Yc4>LhtFl5{ot+4bE+*UJ8&9FQtsiD2|NPoVHRNk%&%bPSeFF6HyajFNBLK#g8KS$> zvZ|bxSYhMgs;*aW~ipsD@d0%`zvLE?WJJOA&W zHG23r63GjNApmJrrb60>2_%iG!%w_wOfs^0H%p}q?;O~XiCE;q3Gk&(%`LW~_>2O_ z`2;Z{2B5i=XL~-_-XcAsz>he*_M@;VlK)aI;FJu2wKmc~SJ}W8u{d>?MEkdVc0ahA z;@jNyY2`@{kYt)FeBc}oh^f8^05es!TK-90)DC>m|307#k_!T+axRmFA&viHd=3o$ zF`?%e64u5Vk6$`HOo(F#DDO^R*R+GYgoJ@X?FO6Ih4f;j4qNr|lgpa-XXW$`R;Iep zi!$K1~~+_r%5Bi z?gsGkp2o$U2sa&_)H0-2Y7KdOu zdwBh6$q~TPW8A^81|5?xwK0i3lh%(#fY_{!ILpF8;Knz&r&L(KgXKg8JzpSuoPh*B zZgwCU)#M*q*gv4k;OMv|E}$zn`vH5AfoJYRQM2;jSB}`4f*Qm`IU zE$xuv2ZlR0Y?{$z^b?527K+ZUPwnj)ic-> z!muXM^+e0bs>kwj2qKYhy#OXO6!^LzrZ{O93H~mCP=A31rh4gR`3ao~!l**?a{>;W zl?&qtp<8|`;f#kjT%)FJ1Rr7g&wjuweR%ozR{`i7d1CW` z>P~+V{)C&0D;*;lR2lv)?wcqUiY zx=oYMUDHZnz_b@|#m%wVAYApKr^&csl=O|&XG}Z%-l)!k)!)}=<5WoFK#D}(b@V)@ z_g!5IEGUhc_^XG#z`At)Dvvko(9L4r@soBVT$k0SwqmsY^HqI2^x?|Ynvywb4Q2%Iw| zM)-N{QOO?w$DkCe(SY=5bO|gNdV2e9{XS9HL8Zr|*-()O6qY0yQf;lT-D)dw0p0QhG(IIB>Nxd&_jxLa8qN;@&sBobkotj`=-$iSeKDI*2YQ0+BK zj03MSm*$&%kwpEIwM|*~ESGFU*dHs4Q;=dEP<*3M_y1n|FXSd$qF934MG`20hHI&J z;SR(&rvv+@z)m?*_cTWYVR!_{c8lb%65Us0Rrd&;-`QZo2>~fG&$A#BHo3X;HePL= zyrqk^6zJj%nJo%-d=Id?Hxt5%Ya>WH$9Q4jp88 z(Q))}^lT?)$mcE@TiZNK_aDiblGW3~-;U-=pH8|S9oHl@C}2&ED2?Sz*bY9}OaJ{y z6dQyXhgGgR%gRcZwlTtcdu2B|v#6QT?{U5*>ujn`iovIvDh%fFH@{eqY{64#H>lVZ zQytM`&YgDL$tw47jz?GMo6u4Co3!UmEs%vTd*q!v3NF;=ypyjoG)g(quWGd=n(2P1 zm|q;40M88Ks*_0umqJ^Uz)FtdWuEABTtZ*hht|u%^D;`AS!G{Rihm{dhVP7VGm*ec zQf^GAmfCC`@Ds;>_e`cpo42h`%2p5ky6}6b$h= z5cwUT!{!+3m1L=Z)kYzu7xnW%J$~Eck;dm(uZ|kT;h@nS&dQZ5bN5UHFLc6$`7mln zI#THvr^Ke&Jz(n6r%t;_KeQ9Rxst<9kfC`;8nIfv3ays^MQ4`7AhKE9Tva46@iv+V zjYN)46*JpjL<$-nR*U3Pa@yHx%?GnGYQv1=t*We+2t*@E_QlS>BixTh`14YV`$fWQ z&emVk#+nb~_`#PCyhW|%K}WZ%&5FY#{@l{c-N=aF9DIKr0iU187Ud7oon%o>RH{fA zRcN@ARHj-!{!`*!Z3`}bByB&5;c9|M^YeCtzHM`|B}Uz3&+FomS~byl&j11;Je-Lp z(Y_6(_BON{S^U1Ip88GD9K>81`h?f5M!w2`Bez*^_nF5@mvP)T21lO_$q%Rk+YBPz zqT9Ut@3JnAvA3iDOQr8fwffjKl!u@nfugJ}#N4!JzOVC~KA>bSF5L zNTKwT$3ccyX0_w&t3v)a@j4fakgu|R!uZ{yqrFIN5tCfBTH&z#=z568>y0eR62ucC zsONPm5y$jlTC#6#zurC{{Bn_BEf{CvePK8VNWS>l;z^kI30{X%wy@IH9(O_4-Aog7 zt?y)3CvN>(NeNwMJgO(UChYqFDNPUq)lm+%hSh1OgZDbQ(ga|GMJi;_eO|>0dpcek zV;MQ{GE6*n>dj^DFAkFgKG!$bK>5@Li`sei-Bw=;lu99dZXmK^Kim#MmFad5+PMF^ z+~ycBvkc#C3azq6Al+|}rP{Y}wyW`si+8I1@pIVRUPa*Yz}D|KYqBniqnhuLI?l9;9N5{MF}Mq!xPa#Q zgTJuKZ?7}3o{>SVoT8F+=ik`AAh4#+YhOcu^QK&`UR;W-Azm>I*#_dX4awhpZp!z` zl%q)YK%D=cA*hmTd$sk9&1eoKFJhmb$m1}83Tb?IE}1Yr#m+O$3-`wpom%Cp$!~CW z(sg6Lo(>&N)ARa2U5$l}A$O7QeZx zr&~Q_6Woo5DjeO)dV$ZwH%F<~C5SzjE2EwT>8+XD#cOk}mI!6ZaUh~kDGw=&p$5zW z&ZwT(9y;9h?4AxD9@{`4dxd>^z4D-~dQ-Nt?_e~X7tU75&&YXN4f9WSL{YsRTYY$f zYvfbK&(XidP|y>7#x6o~lzF_~&?+tnk-iP#>HlIaE~vf~bCFXry20m#AbysYqM>=_ z0Fs^?YVY6xEx{*LscMA#wG-jhMGt7FB$3|Vh1!2Rz7M7SQH4*Uo?`_>X0-W}J82d% zes-DRp?(g771EP%3y*)mro!d)+P6T!i$&0`gtjLaZNS0+g?)r?7pmCk{3oS(L1krG)tXFIkuphxJ=nPB=&u9 z9iRMS$N#xRkl2<<5^q@~DH1T?kAK*Bp5D%0?l9{I+pqD8b-F};4_Ynu$GEdoM+u9lOz@+RDG)@QOMX0UDO=nLj#T?c?QUOj zOk*rHXkX<0eu0Pk1KLiI#CDtW)C#=vYYBG70xol8Dd;{zUfxp*t%lJW(^6C(5NaC9m-q4Tv}2s|yvq-beq~qI?%Cf7USnlr4u4_XnuCaeXGPlV-&$qOC4^8n0KOl3}?jD_~vTa1I_#YV$G-k?%Wj?xGf5Yb@1 z6vA6b+KtOrSJV~1^W!bW=M@Y9`W_y+@}NEz5duFt-)pK5-*7vDJ79ABJZ;swnYseiLdA*4dlc?&ss^MGYxLoW3 z4|Pz<5&!|R^hw)>E5^1K23x@Q5cIg1#?1u@fLMf-GJJzTR`X!-oL84yjAGmIC=ox2lAA$0>M3Mif;vk8aL8WqLanf zmsHgMPDAvcQ$EgPfVqwTm6+~d9JT-RkVZeu$=4=Zm<0N->fitKdsJe-rE!ekVzN2@ z#ew;s7EuUY-U23xB>jF1!+k;X_7Cd+xrYB-|Nm4WzQB0BqCUIhY+=~%Bje-e_#Q>O zGOl~G!XcFWCAr=}V@TkiT49=fWEmz$9M52Tyx4r<&v%t6-eo`FY+bg8xKzbk z0Qz9kKua-i5|P47Y1epLMZyhO?!&;yIFp}}r6FL8$m_CM$Ln$KagX}4*b-=dxZD{PC-9yM$yewcwT?-ZjCd*g z&(g%0%|`On;6I9G5(T({sE8CpEwk)tfcdTnDCrpeIDj7K@n#-e)oSZel;B>S<0cZW z*ZSGCH!eySK*(U$tV27Ms|;XBvv2(jLw6C`m$VCgaWo9n9$Li( zoXUVXln#$dpv>@95HZUq;MsF9-!mWyy1VRRHD2veMoJ1T#vJi%N;fSYFTpGW_sl^6n&OLW*Hfx`3{cw;J!|^XstU&t_=hw}m>f__XOGp1BW=qDKbQj@y8`k%ONsWt7J)z@ zhDCyQWUg9IswTN}I9thzv9WAT`r822q~%O^}AW@ zn7@-$&`sg!PmBp_-*UsYT@x@L3_N4(Uky7mJ1%FWSECp1X3|FT0`Zp9{I6N8yR68) zSoQp6c9DnE{wBS#^6N;EpTxMaR~{GsI^fZpky6P|uqy!PyqCP!^Hk04s>5IY)8($C zaUStvBaY#bBg{W-ic9F#Qd;Pf&NoF7+8KR#qOTo=9+{02kqG?spZ1&TwczAGx+B6( zp4^winJC~8dgoUr6>2N30T7#=?dE@8IH3oLyx1vQ!ui%OpI-64itt^C(@6TNNeJ*q z@CRE(-#BMhs=;sP{o|FhxSs0}MC=0kWYm7mW1A-nLN}6`uV=ny z8Kh?BPd$;3#yzJuD}Zy9s;=_y(d}sXkiAoHxu@CzIJal_?eGa8L-}>L2+l#^^**P$ ztF!D34#;*|R+e?8NQd!;WwVR}_mHog!;`lp*7cri&>Wq9y5lz@rFUW7M)9Qe)6yK$ z(T!mn$`LD~;8j7tV@VO@YXZAAH1hR3#}s*MyrEI0^Rfa-KLPLxy8mo0?E0{APeCC} z?z*KRtJiNg(IU!?)krLWqJdOiWQ?qInSu1{!OJ^JaXc!)B@)7isASb_ugI5O@yyU; znr1?3!Bw!nOhf#fMf;iIHO;*kg*&MI)~n|PjU@qa9}+6WWFRw$)A}n%85l8%fcuI_W6l)=3pe#set<@AyoNb+g zK{{Cae*M6El;1dHDjd4=owjdw^ZdIbn-p+IPVY6pgCdYVB9GpMPoS zSA!1}yb&iWW0@AS_kDnWX{!q_vJ@#l?EFcy~jk(m)}{=Kf`_WW<(l~=vK<8%52h%~paKYijfd(ZdqzTw81FXvy&dC#J54A78)wymcM%3?fmx+{2qV zRV8VlyT_jMh2QuH^gUrfY1gw-qOb^m^>78Ld?Z;@{5{ZqDOq|?bh{qVw4Dd!SvsSe zK|ua4v>jp&@EQ26G@#8)!j?INc#!b2VDme=}BGgHdqSmlzC;0hf;g2r#KzSx@J;U%yqX>@uiW7 z&WIkpj%i7P-44<_SxKNV-K2HX8AJC>%{SdLN>fkE?Wub>*k52ZAAEmKCTo&E)xRF9 z$7F;{y%}iGH;o*MZm#&4d;=TiylbuNp0;KZGo8KF2z@D`N65Jv@Zc>2%8D}A%6|Qe zr0%7XekYuH+kDelt%blU*JGXY(S5>v~E?&2M`n;>QJymOWiKN9BdM zd05onNEEJX=6Idx)J%kZ*loIpKmBUP<+40#`eWVgbv=0@X_QA+lJMokNx1VP@nS@d zf@InFUE}YQmzJ{iT#(PmV7;4Fn0ciR?Bk?A`ybo0nKue7j4I=Q z?pK@E49FXb3+UyRGrkio#!tiZ3K(q1hF+9+tx5LloYRcFt)O1H{>G;wmGBsxAGqNN z!tpbjy$4@Ous36?-b^ie#|yUY@nE@H_v`+o%_Q$`bY$P26h3=4Ym^^ee&B=vd(g$ns*qHB}37Pr{R`-)XY6_8(TdwCnP1|K!7v7LWIJ^ z^6vS9 z6t)~Ae_`u*q&RcuL|N<9D!s76QnTpGhfU47VeQ;eJW+>}lbJ}@ldj7ArGPv$7{dJ8 z=YfacLHxAuslNn)umF|Q{Db#>(fs=)bgIF(y?bxmzlyBRrzCM)N%e%@Zhsl_Y*iF> zhf2R?oWWL~OQU?yHR&dL*rHNk)KhNUt)v9EY4731NwpXvyD5T z^N#}S^`LI_V;ufDm8}fTQ!Rb>hFXv%6dZB$S})y?T}QE6 zO~#oU0fdY?dY~_aa%bOFjl!k+4O`3{#hLs@P8R5kQGs)De9|$YXKX+-aqy7A+96Kj zxK<_)4_)=(JS{Em%l#(Acu(Pyk6fSi0u8?wO7Z;!ue5mgl?HCWoRLF8QG+3w~rT&52e!zLU49*sQ4In zO7f^}db)}>XnV%RZjoF&f%L0Qs#6bd&Ey~6hO>TsO~>r;IKPV4zs1xo#_^|6Q9QfT z53ina|B%W_T>C`|RHq&a*0M^AgX)wDxJ$#&{h7jOH3s#SfckW_7w?VuIqkZYV;F+g zHNf(#@v$kCzW>1tuX^oFZ2%1QLD7d7P55cRe_qbx?V~ z$N;0@;t32nFgKErbhCQ2{xLM7{T$Y>zj82OyB{ao@ll?BNd__SA@rx<_#EJXd*xTk*NEf>ikZrnBL@Na8B==)P%K1?gobmAMb%lmzL97 zS!a&pHBJ{YZU|6o3r{~*V9 zF2(#Hoc~W&YawBkc*#)Ka^;z?N;knG!&=~Ac%1LUkp%_^h%;yB9es+m`CL*`-cTx@ z0j-`p0%jtWe9p$j(x6wyQ(|Igf4;|Qt4ZK&yOzxcA{@ii#*g^GGO2&A_MvI==S6+# zfv@qVI0RKWM|F-kjqICzYKIr!mkv>swp;pI(bp#JzsXFo7Y7ozyGP2UVO*ZOTU}w$ z90coBaDj@Co$Nx>0|L$~1L?#@a~q4Y;x>t=Z7<_1wQP#BX5X;OANhvca+mEjP=*2O z4%;Qep5jn_9dSu-?h7TH{V{u{tpF;kFO?^L>g##mk4kZZ+t}PuKV0^|<=>QlZ0xllBB|(Z579jdKWYXj8?=JwM33c7zo&*E8k7`~8#Z_$wZyqH73PKA6Qd4wS zz1D4@Ru9eTv+II15$x;NeU13Tg{5>n>86-*+0tA+I+(P_uU-r?u<}a-7a=|*2ME}S zWli*T@6Ug|OfpEkP(7yF83I&>fgzrqQ$pWGHtw2r(^}c##4fdcSRIr=*rhn* z+Dc92x^^jhZw`uP?;HAQYkXfStfl;Y(km(az7*{z?-4MC9^r>-0h^`U!yc72(hKmG zBbyr`#SWS<{)Y=!uu403^O!SN_O{zEh>Cb&nga4sy`FvsI9{Zr?(xkWb%P!}FKN$Z z);!ti+#tE^;G<}f94~0ae!)t#qg*`Ic74 zez@GC1e@1!fzcy?i?^sofg<(y#er)x`BFjpDc?PU%TgxlCf99RqIssa&5?}pN>6>4 zwwCIrVNSRgJz)UdF3k2A#2*-}UF1T={F14g!Fb@iki9~RNqE$#mCNAm193ITFAc}~ zhvBph%xvk8;*aqtB27uC!={|Q+CwNJUdnhpx6D7RIT@=ZDQ@<`d-J~GOq6}1D!O6B zn}vtebKmi%sXWwj!YYHTO6@ZI*{uKjWKLU;z5%ZmY*uZO0hsWZghyd^Nbq;_CiF&4 zrcD}urLDl?{u1+8wd0B4+Kz4^-8P};DyN2L zHWzWhpPa|>tT4hQ{H!u4$xRBh zo5|YO&4in)p2LNCn|>Y0A`FphMqn0j=gxTDOLT&|FJHmc)ui2;M2fuAG(JIPwBCF-}!_-=%B{_Cia%* zfkwxeRMy!pdQDIzt7dlVOdwr~=9^;#RK`WZ2YS=6>3$Qk?=QXTuUv)}E7d z=V9iFNkjrFnO#uq&+v`YnE+j_F;!%DYDRz8SCqk+OYSj_?eXySWWS}8$n@-B{t8^F zumDv*dV095#O87EqO#fFCQTF}@*=jKSZcuZ^|vikbQ{C@OZ=B7^BMt_N6D)x*9o_+ zzZ9H4YZIU3g7|nCBuQ#{=ZqF)D#VPjDc|ECVv%$H83U<^T-j+xrFT8)kbuzmUV8~$ zA)lx8tj&wlAETk4QngIheS_h_+>zc59stQ;(|klfZjJVB6gzg{j7 zU`K}WO$s0E;#^!52Doga!OZE@`rclVc@x$`)jPOKJH1ib(z2QlA^TvHfI1`GYKRZ`!YFLF64#^y+IR-xHErtt~dHuKL`@72X(@ zpt%aMhHBEMF4*27GBm{Zc{v6?ll<*UweH=fesNvD2a%WKUwO*Eksk3$pw(v@2;6*L zSLq6LM(=V=r-%TU>B}Yd){DkJ6FA2zuK^K8=PPfa|yC zpKlKwfYea;NNabmQ^2VTiOty?@9}r7-_ki;Ve`^(16k|+0aTfpu4-F5qc7fO0FdY= z0_bN<3IMYHvBul0wveG(8K$9HP2R%A0b*<(0<2=OD)$iyb;7^C7gBG4EUxUPcCvNa*gu#+DV5+9@4_!6$io zQ5vPD4_vP?38kybz{di>cA}F7pJ1R@Q*-87iN}fio*e+r?FA-dwLf(qKf`!yGO}> z6`;X&Bdnm}wMno7bXz6*O+MQ*U+c8O1n~fY)IOF5KAKgcGRMDhD77nm zvbmox_IDyM`T+m>xvKL)3)Q!HO8cjO{l3~VVD$?f1p~-z zWq=N4HUW%^x@!=CHM|=L!nUR*OhK$J%|L;v0HcPSmR9`Cvko796_uz?J6F9NLG(w! z!XMUod_wgtx;ln{SQaL9__5a49teKtfTGWJ)9GIW`-JR!%vbW+!~n%#mofHj;$6(h zD;!aDOO3Kh3swYhw1^o__)MF6B=nBluN9{NQ~XDOEq8i-w43YlumVgLPA1>#kK*j zJ#l3UY+&0GVR)y?avzYeMFS+K?v)t5*{#H2jKUDSW2r|}k$ll(W(C9!$Y2Q#Mbs{hRf>&IOuS}D2A62tHQoJF`{**R|8=2O zrQA!|IO8B+;M1-}@B52xJKOKKlITUUK{ljI+zt%+fgO7GXREjs1kmF4F5^M4^DfDz zfG5@!1r`GM>XC%R|9JoU=L&@XP9UFRO%?p}pcS=ryMDS8@rTS?u3T+ozz-Yd%^^8>*F`Udx>ba*tYZ zHxw(-Z=nLqxV8#$zi@4|F;ek=T;!X(S0Lw%DN?dx= zdfY!b=^RTf&xc+q)pFI#&LAaA0%@3Mt*pU|yjRXd=c=~-viSn0#}jVs*c!&JJp&>7mO z<&+!>of;KjJ?-z}(CSR-l5K#h&tz!!yc`N}ZQ$zNmNJ=oswBIc-^V8>%IjVZn|Bum zo!pNB#|f_U(Bd|v7rpbx=avGsx_0s6(e;b??`364X7J+bxy$V2My+%wN0iG-(aUWX z4sXVLm~Q7O#zseTE7qp#ZpEF_c!a7aMtzq(Upmz^w+NWB!zw*Ky zy7r@r*hqjm6#Qxowyk~!0he%%wpVeVwKA-5Iy@ROX&w>udJc^Ldu1|(&YHK6Y6je# zh}OJMTQA)6ygSF1f+~3`EN{FHTHVKBnwqLx7X_*i_-D}AhI^WYy|RMGLT6+H z8kHodsr>TxV#&xI7v=0`9nB3D74BS#%e?Dy*RrlSZrpUG$~+`9BTriULD`&abc3*+ z+LL4s&d}FRYw;>Y#4?mklgT#h1ojm>)|0cAd;_9UX*Pkb6D|AiLQyV#)bb4s@EA+2 zUim4%l&Fwh<-V!VHe<$Ddn++!-Qr8_ggQLv19{OHNl*iFs357Bnk<=;JPdN;1Q*K}xm+f)r* zx@prAL$g`Ep_0?wOG>Sp-74Y2r?n5AHrU%t5nG6fgoorePuvHZ_$B0t#}?MqXw!>0|6C_xG@U_wI`ZdWAyitd+(BUJETM= zM`xCxes=>IY35!gGe`XN8;E?teOs)%bG2_IncC6?cea1iDR@Bb;l#N(wNYY(ID`GN zQSj^g9>HvYT;*r|Y`LVk;z1Kp>23^nNcY1kBQ4#GO4)u(MD{I?^L})kBh^yMterm6 z?6_UgyO_$xRB+`Bbh96=8lR(PE7}7)j*>h4laO_S9%Sx55$e!R-(cuW*!j+XbWCWL zS7OLFCyxDc>$v5OsXtXonW7+^RSBYkYkcu=vfkw-i;%f!Cpy|yJY_GcRV$}=M<5xZ zvC0Nk&b&H(8$X;jyf*6oavX*iSZHi%{T|{Q+b=vLzbN#Z!IC0Q-{YebE4ja}PmH9GSx6MGf~C;tGfoGmTfD12%^M1O z%r;fpj7K3fP@#2F8xHV6#it%#;vaxM{lUDl{*vbu2BCGr))#H zwCw&WK1OsyU-xv8=fS@^x1z5X=Hv+_1x=IIu%b!i;sPN)8*nb~g}DaG9@9kDWM#OcLh z$8zTrV+HlI&*=??CMHk(jJ9-FYF+1eNx9||BdweVRlumHHZE+OXd5Tu?L zq`!r$4MeCZX9^t7ViH|vCytBUDn?bcUbmBLaTzZZX^;N|+eq;1w3L39n#UKp9wX_x z7}i2yoMH7Zx&fuv4qPpTD@-zMw(Z|c*U}5^*!kw zWEv7wQ)Cj`i>t{mZWZXQ_wD#pQCoL>t3iKa2)(xQr`ZpWX^R+k>kFIfi53r1i{1c& z;Jm%`qDRYOK1N~XPaLn9@s8f&$yQb#U?)Se zYxi5_7&Lypefp|I@!I~X%XvGReDj1P2p#p1`MN+o3_YKtjM5SgZSPk&%fQlmVc*^v zO}@T$eBodKcvx1#XAci-&F1(U?30*Cz8q<7BD0wl*(;eyNVmd4LXi<}TWyXzhz!)} zSV2@$v?D94tK8=6`U6AN4fE^K7Zmby(S_z&uIsS+^8%G`mH(XNx|LN($^TZ*0>wlf zA-18nUGuAUtOdV=Ny>ETn`w8)B4(@qsfYI8DycF4{qN&Dsk6+Msnaw?3J)To_+uYf z=pz4qBLC0R7gawF5WLSD6L(+mFO9o@UbNRwY+9^pLis&u$%Fft7Q!uy>_>mAn}J&4 zpXZKe!j#(DmM^#eT5A9ISH6k~89EV(L4+9_AQJ>82a8d3TgMHv4G9h3V<91ZSnWFG z3SkeQWtsU@Cl<1Xl>;%;X{AzrkEovmF0@tU%#8QlpA)UEw`BGN@Y5BSYL2V4D)RD_ z7@3&3bdkTfYd+l+y(liC>)q0l{^@af_t-i{p&RAd}p_3S$E6{2F zlBTfTA~5?!+xK&u2mzHsMiyQWydozsag$ek=I0M5jp=+k-IE&XnH`19_OLlDvf}qQ zMc&qno^e(`YMtpge?z}&+mFT&c|S=OJ%`5|?@r%+q1g2ja=4c9Yo5G3AwAj8<%&8=OgAUK@Tkv`@2G6V)hA)!E4&5ZDZdUTu!t$gK=z z?$DUukDAN{PUR|DSW1s2{EvsPa>1Q%8@$8HBT^kW1OplLU29+=z)RVxJLSMSd1qN~ z+zzW{5dJdu8acOIoW2OFX3+B$>eG9>nZ3O*bqpU_ir_lJdpcg9^fkY9FC_;3-UH#- zi!7(g{6M^cSXs?ETsOLTRm8?gYsNcK-@Dq~QVITTJv>{wt}N-Tt;rVMKYY@d*4Zs$ z^v!g@#V}PrvO& zJy3{W<(4R-&frnyva*^ludEX{m+F+vy%HSr^+VtV1uCmLlc!(wgR`O(wbWiG3gE}$ zeaz%R@efXa&&xDO!iib>1<5m;@etCYDoNLwa4+HrPu-z>E95{HGvd|9IajwXL*?q{ zIp(u7Go0BC@w%Sd1+RY$kyaT`*%%ApdOhsTXR^M5Y;)MVi507nxGL1i!^yp+S2Pz@ z9Fznu;tS#8mo0J<;i8R@A0GbFoixX=7|aINZ3~$i8~Py%ptflnP%Fuvkvk4Hz9j1> zn;RpRnpYZ$5$(S0(ge)5eY%rUCZhu8>Z7@vdB=4rQF$A_IA;-~cq|-F>R!VBDqXpL zJY*c{pMa8+;ZCJu0AF^Bx?XX?IC!%q!USI576(3P2V9uUmDh`B8cyuITUi2YuTS~) z5Fxe#6^^?FW4lJ@P9zSF@arjHI^5{T-25k84M> zn}s`9pu23=rbMc0_ZLgsQ66QZQ)ib9(lCFi+0E& z{o(A{uGv8=$Z@qNY)|J1R}eX#K>O??p%c<~vlvnEAaEtt^Dd(lQ%7FAu4@v^D1OiP zm9^ljVkfn))LlbH$Ioy`N`>OqP3YQ1DpL2;B)!xDkfm?nE+LSHNHbTB%3Mb0T}@Jz zGAh;{A|Gv^-M@G%HDYAzzupxGDNgu7JQWf!rJXfQ*hap#YHoAq0DD+IHZr5VRe(Sc zedTbzaAQ%@3X+atjk47{H45SpUKfjLt75IdUVPPD2vWQqV~~(%kT6^vazU)*(AKEv zE!45%dl61-ykXAIIy^9ttGzByWkI4AEx>9aks&&WgDlvJTxhu+X1cl1^MGy)9dTXdysfmJM53g#HjTCmh9Y<%1)7&ON=Ki_ggpYN zEk#u*_>ws@m!t)_)E_+4tndQOI~r_`OpGFf@^xn*!e0wac{tR=-j)|k<=c;C9*>*I z1mD3^HQPX_O&2Kk-iOFBe!iZ@Y{9CHp*Vbo)*+bycpFByQ;uzqz^LOJ6KJ z8`xAxKTq^}G#5cq|MKw1(*^asE0`r6TeCB5bbpL#X%%&iiXGgwUizhs&}8ew3hT)n z#34v+{Nxo<%&t|gtAAT|sknJO_g)(#xXWq?f_gRA{EIC;=h2#H^41{h09=aLih0lo zH?H$A!yi$6=&(W>bWAE-=vyMxdz5N7y?aBacfQC_nvKSXtcdnqsfNRi7Z_z})7=M_ zRH^){cwXOUGy-#lGgE_;B*V`4HvN68A*+u*TGoj>#|l_ zWNUMVK1wsZWD}!HdBqCqy~Y>ZrddnyWDI}NjBId;(lsml#eXh8b?hjG=#8CCIP@{( zPI|t~LU58-6JT68J{foVV$}N4P)`M%W7cc?mzDYDJlJ~=9P`nu%Zgs~ZYG72#1=pOOxM5iYM<=#D?bo-M(45+FBlq}%VHC+H-RyR1lD7C3p{ z_9tGRE0(5&#*jfoF507~6-!Tj>baPFF4ST97lZ&>Vl^DGQ(8)4BD=&fVVhi>lweJ9 zOy?^#Rbrx9k)#iyy|0zaZ*DpNZZg$uM^pI7#R3cW`?9%`7W%m*34fe_Cze2w8DNyL zx#)(VubN^Hs{>;?7vIxOSw+ZHoU?v=@KulWjlzdyuLt@>S}GsGwI!WH<=R#YhQB)f zAX2$PC2ZMTp=_ELa^IY34+(!6e|~AMnP1$#L)rCQe5FeLeRL~n?JcSA`tMDbGGdFj z+TuOVAZ@`7U26FL=;vX&!!L=9giqaq%fO`h2K$fezgP_;BTX?{RFr7gV=6 z&S$CNdhg0%D3D|#=Jr!_XqHR$?}i;tmXuEos}141U(V-Fj6M3 ziy$5gXFs;d3X1x2X1$5$K-XjRy}!qaI9nH!Wro6~gmnm1DnH7-5lSC^{SEK+9TZ;h z7uT_vp&A$6aVa732As#NpFY;^Hh99%8m>>+4s+ze@7WY{gXsnGd-JGS7>5JlWeP+4 z5u%$ezoA~@*;~mn=@ZDkSH>MQGYVvz-%fpJiVlifoW2N|kC4^OkfdJG#pq~fu=x4} z@<0-=JI3Ep*4)n&&05P$)=8}q9Obo^dGRNh%qv1d6dVU7OcqG#8jyUWV?2C+a{F*a z%Kcbn@l^!Evf`z}T^EbU6N4jZvMSxm(cyZ6=2o<1CFAJHtJ*i>Nv9w7>ogiZrIw-= zANMWaOt2NIsuq}#+y{a8#re-0myRXL={?3C{IHX;ZhGl+@?a(lexZ&}-%^Cjj-c6u z>pfLa8;P|6YWG1lcWz;m`9oh)in7G@Gj&tWrNp}`%R$|gO008^DRa(GYnV~ZBV#z-`wN1dr&D+l{Elmuv6Cs>P8)w@qwvR6qPR7^s64K- zhe`xZwif8q4V)uFIhkkGy2j|kU2cQ+h|YV}rQ<8vp1vXXpLhZWC6AExQH}TU`?$QF zDrt3|v9LefRP6PUj~nePoqV|ub1d4BIZ_g74~}iP1`GlEO}Qnw-(bQ#(x=l)!X?eW zbP8+=bh!m@>%Ho>QqmcLBiY}7P9ASoZ;4@=wdSgkB;}CV7Wz?WuqhpXsn-ow=w|7K0Qq~at-SjhHI61ZRDl4yO|h*~AuUqWg(%Q>L}?O#J-N9|j-pJI zm&bg@HmYL?ZeAHc^jYd^0{#6?dGFM(?*B#Edw4b7wf~xrAR?k5q99%A9qAne1Vn@= zNbk~1KuQRqiYSPbh&1USy@ncuK#<;h@4a_I3lNwu&wJjpX3d&8{^lRhu(Mn4ecjhb zSK3}iY|sQAS6D4E_odpyeA9xM=Ry%JD2D01a8P9RV5P06vgYztF#5|_f{CUqb% zRKsi`NuP!`O~3Vezv`hSsxXEH(&4kz$-L5NtlXA*OSV0T7bDI?I=j}p^z=Jv);|#0 zZogkb|oqYJ=IIvEd)kOA}h^kL6IeC@DCu-wNx zJp@jKFHl!wO=3b`$BPn57iC*`^T5MSIq&9jDn96Y{{&(`q_68jWjkHkbw`nZmA)fO zibjWQNq4Z&VM}YKd{BybgLEH)r&i7lI`HVUu0ONG5P*WPc2BzSL_>4Ua!MDBjXbXqEM|vmD%`x z&l;<+9;YKwr9{-@I$MTiyiusIqbsL{d1{Q=XrEoB5yOHY(k2crb(wcWSoG!mgr;D5 zb4r2cR>+Z&1pA;hiMWlm(U_`((sl@6&mcpEw644VhcN0|eLo9<%Q?Xe=WQ483B4m`~V68fS-(U_1f@T(5#p&{iV0<5>Ro$?SEd!VP-| zhwrj#b(vduW~fiVtAC02!WgFXQpwA*AZPe2jmI+yD^DOIpwus_;!1;@R=1ePQ+sy< z)uZ7>B`EbXaYHagcwn{m#T<=KFw)UCOI~JX3{EqjzTfjv;^|CJ(pa9Yd$+=;K=-5% zmn%CAz=T{1;=mYtzU}$x5!|iAjab1PlvFDB3B;^jcn-Z(>vv-y{+^!PMhwM6dpt9y z1|_r_#~xusT@3j&W~1!E%07ZE@hjljgZ`C6r|-sGt~}t`u(gq~oO?Hy{CLE1^| zI?RY=5Kz@YQZDkD9-%PT6b?dzi0p0LlJ#tq>(V=EPP$~zGZpMqZma?0wmKiI(D50b z>|-zXNZF3LpZ0>g#3IK_6SA$o^r;tbJ<*=djsnmV3_~@0$j5?Bq`l0-kn_UX=5P5p zLj)%2*NI?k`n~UUr<+6zH#`2;hNtCuOfBvbsy6d8$C>dkl7me^vVEN>rk##5?Dg|FZf8a}aaps8 zU|vWMoBdQ$rAND+w7>QyWvjX8Z*?lq$Y`Tbf%Q}=_2aSkl%<|+f5r;92p|&n+kJu# z(G;)g(dEoxr0NZcbK>*qOeG*DFCy=KNe%Dp9#{zx&f6C2DKXH)Jz%fdyZ5WDHlafzyl zD>xJ$=g-uXe!|_!hi>$3jS3Xdze5n3r=G?A(U38DVD6M}Y%!p1<1|9y0=sq3Ap)!f z??=7R&Uc}%9h(e^)JVqwpIfeCNu&e-!hf3juW zN%hV&BQM!>IN3!*h|pQvSwmZ4rOx#5_!8CC8<0*D@RrCI4B^hN#gVfq+|< z46AsgFT`%hv*GLfq#bVU5w%=&8vObAp{mlY;Bzy|L&28MCwkRLp# z**1eSEZ+3#o?t+3$SjO~d5pf>_db`)I}P{bnFe1&l7Ak?CJ3$Jn$2{p= zFSRtch@Z7E@-}r&rP@yD&XqgA08i@s*!KI{i)5d5^YIx#HvQ~_PD#l>g+1EfvTbV& zahDf4XEY!$o<)ZaY=6A5dE&G7Jz_-?J7t1k^8Ug`KyA%KOv9e?rz!z+FJ!LR^fK~_ zF{EZJPzoaN^Tx?ru10(G-7T9kTB#iE-e8~-&JNL^t?=A=oN00&VsXUpvG@T!1%=csK|GWax4a+LiJA7p2wAp zr>>%IL^CtoZ1`;16tzJIUYt#pn_No_$~Jc!zxa%O6*e=j9M|R~Y-$hOc-$PQQw?w| zb>Y#-=Q*;0cDpuj9fjkO(P4NGS|fJQ23;tYSZ;iy`7G#5l>Hd9ach1;{d{BE(YDoTOWZ26lN3?^4< zvQt*%$W=@1<2Be^6L{I??CKh@p=TWuA*_Z2n2kA{ zPV>9E;fWJcB33;#6*MQf=pyZQVm}IyV7WWzU3BTe@NAVQbCObbPH5hKZ$i~QGyw^ z*rg-)+YF@Twp*?0TM)gi6VAoze^#PYr};_V+^y-$^vfXk_LdjLef~(gwm|6L_++9|!c~vEDor&c@#Ria5E&2jEI33qW?^$;;{2 zE#r6T4Fj;)L&DldOTf1<3{$+*7dG~18wjyYUDf}Rax2+NBRgQ(R2l{@q!d?J`;OrM zBhnC~{1NuR$6sVLCHgY#F`&)^ED>@5tB4BAfpoq*I`ce>X=kqa`*Tz(^qnl{?D@>e zQk158#C4o0Ga1DaZ}l4ExN|F=<-agE_vhDf0?n5mFI;7cKOFm$dOrs&t%>v@%m8i& zSa{n2djsMyrF*%yFg?%`*mWv6cAkQ0(_h8KuT*i=*MGr zhReO6+S_TNt@K`9^t0`fm&J>*br+f5SLd^%sKxxQnb#ip(BJ=I$X)ioTJ3BADwC`! z07`ZjUA`weWeOFul24ddXBf>FQ2@<&M<#o2aQM_=yb9<{??Lm=m@HtS+`F!I>sbkB zZiJfvZk^22GuWd?n<(vtyw>jgxXy_^0O(nD5{b1`QHBO9D>?4_j#iHzto)UUHAwjb zWP>_5e{W?6qFn!F(48~?%b*WKrF$RjTwqYgXYsp$Y(&^*D&jYgZa#UbF1gJNAh|(_ zfVK9TaI_@;TqBs&To0&10ejrZ)ZODA$z2ENt4knH$j^xQvsBh$aU)6R;aLw56U}$+ z&Yc1>N?m|xs}K~)mcFcBl5C%{mtE-)+eP!E{z|ED$3Q++mG>nkB^GE=Zl*Xc z`n~Y&9$r0N*;G~MbWk}5MV8*2F~DkjA4H}^Q3+btSer-tt)i8XA{`250o)4Do7*fmS3}j&MGdf5*PKk{J zdKF8+v^tKualTHR2*e@xcC5;rRN?8(0BygWe07HR>q|r`y2k@lRpj9fS0wODfu?V+&6sa zCYkP60~6E#7k>Ud)sFs>I@iwHqS1$`X$X*B{V)VPWZv=QbRnG1!HQw%Rgs;D;O30P zN}sHUEbF{x%Go=W#-O`YjMvQZl+Veu3((pyAt|JKheA;XuwYX(GI_Pa8BC($X_G%R z5V;%;>vYz@Fk8;(1ebkO#*GAL3t+9aM3ZOz4Pf|_0Q%T0cxh}u7cSlKli%Ffo+5J7 z9_{jFuSj-g8wo6(@pM|%b{-S-6vZ2iMY_d_L*fAi@mwfB5KCZ;16qyXi<@2>fcpuv&ie=ze?32*E;E&!BEk}ajNhnd_! zTLja#$8eq&!TzS?nmt;>^Xjx!b^jzge;;K=H& zFD2O7GuM1{I>DGC9d?rsPC0#lIgogsGBr2 zG+t2^!0D(r6(}QLhQNNiH&;{-xU%(>;PgDPCcZEPRG{=jTLZIS4S7T}>Iye|RUyfG zb!2i?p?jnxe!YRL`){t$=H;DP8I4LrK%DAFr?v9xr1T-?w@mITtpaBG&b(uSYslQ7 z%lxgAPd(%$i&C2V2gbJ%FkBUZmM1xVaGz(j#Tv%{b_m_ZL%{!mA1>|uKH|CW?(W{v z&X&RrglYTNb`~SBQ~EP(VzvX!2DBC>yFs!SW{8l0WWGA-g|AFo-%rRK^Y$(y*BlMbL3<+-bZ)zVHJR6BW=Z{wc< zx!W3yPLsbq2~z z^tuboYTr@W0jKuCqj`0i zor!o6aJ&@Yxoe+1B&%F)5wpEmFjg?!pKhUdo%f;3J4!?FlvzC2m>WUQ!o}y0^3ca*Bw|CpP7PN>_A0kb2Hw2jCT4w=x<#p4iq=TrH^&J2~(y-pj-j=U7ad-{QgZfW*L*Vpwc6Js`U&%@V$6N<+`10=h?0RM9<#j}w zqX@_!i@RhD1FfWzFFOf9UZbcPE%glL8ov9UGxT`W5uiz6A94fRIs-k5nZq`xSyR{%c>Pmj*J^=>kXuD>mP8 z^eLPNayy0IQnXcZL4oV%cEm74dgnReRqqv6R(fEzhYa}4al-$qU6S zB!cklw_!g6)MAoXx~Pk8br4eoqaR3!m&i;{*Rqn)Mf4tYs|KU*iuU(X)UL4=&yV5r z)hz3<27igq@)YX$q=-s&e&XxF8_9m@l zGm2vU=X{Kr?6HT;=pt3Oh}unj&m?j}->uSSgV<)Mv2KV|J@U-#sG(#>N9&QlNc#?) zj0xGZQ7egzmA+G->s|awm@y17GLv-qggr8Egkjl@8LDZJcs^$k!ksBOY)UIkN4Mp5 zzISoD0qz)M92`$x;jJBapWH5(>5m}bVwdc2?_0Ml2I~x;Ei&a-7W~j$*UFDyPE$Tx z4@s5OFhIHe(B#^-^R`w-y~_yHw%LZ}g+)i-QSPk0;ylBB)GR zbgRqFpG2f(}CAY&JF3Plnhmm(Lj>>eJ*?J$OhJje}g6 zEy{9mI%bIE?04lRJ!}g3&d(L2U%}P=lTUCud&ckCx&sgD^WEwJ^PW>UK4A5(H&x>?p5DPBGu0h6lqUeRUAllvcVm!! zHaGe8d3Z8?qCiJ(UoNYy>Z)oFrFj;>S#fdk6|H{m5f*Og+0%cg@pEboh6u(18iO-@ zb8G*@_reJ~PMUF6!sn} zyWFW1`s=5f7cGt6Ur0nRPQ8*jB#&?9)h<$A;o5)X1;AQFrpD_8~xnSR?4*zq0v^p zTG`{0^frBgJ@!&Rne)`1^^`RcQ68X@`}NhQ$pr(|H#auEJCj(sk+&?kKsH3!s3Sp# zWKukXpp2}-epi3HcQ{Y=KADC`7MXW2>eT1i1hS`Z{4&b=W@a*>qTcM1yfe94e-PZs zES0$47pR@w;>(dD-0u{Zoo6P6hz%KBQD&9gN)JkFlljJHKP$w<>S)neJi#N3y#xj{ zIQOe9^DUq7fv8c`p`>P1l==2s2t~1qWpP`_%h#IfMrVpMPsQ(jK@Cf+|Ex1b8nx=n z{LnlvHShg_>D@lem_e>_(6e=PnAZmwOkK=@T^fDYz4tvSH6ILp=nqV)FoOMkR9ijBKNvhE^+HUQ_ zvnk&*$E%oopO}bfG`GI6rA6PLdN?}(J+h6`L%CJe6j(Al<>C9>ME9ggt#rHdL?Lg) zDzKV}v{Go$5Ry`JUiSbSIyXN`elXb``p;?xsrMXyLY$UaPv8SFpgDG{Xy`f!M*?p9 zkYX4!57ZupHV=g*NZxg@$-MQQN$PEsfwxQpt&vMWJ7)x-aiVnTSEPLO_1P#>@}CA~ z*PpkiZ*o3-Ba!H?++zHe5y?m;^=l;2!2>1EKGMLGee z87Z$i7HHf7z5*VU;$UoCD_^^vh%NC65Y@ra*3sk!?TtS|oqT~BMlvPpG85f&x_CCy7m0hjf>>+7GVvPaMsPz*Sp=>U3i9z8^QV_m%bSRzbL8z`3m z!}VJ^&-@t~@1eKK<4o>VlS!>#4|4i}GE3V+bBG$ytdEEWOw?shOla4P#+?bxgaZC2 zAMCapd7o(R%SiM$#s+()XD>#NzA@ArCb|MJuM6Nb0C31@_tH>NM@kU*jTV#MV9Itl{u0T)1GeRc!zZFFOm*qo* z?gl;ESra*E?L5GKyQhA>F~}*Z!NYnP=t)`5j5YpIV&2*TwERBUrQ7=Az!BzU@VX-}(SS>GcoE{7&t-l*T}k2$G87Eww7~^y6bIERMkuq`FxpzFuanqM(q@ z@*5o0iat*{c~sw2q`f{{$NSdiPxUsF(`9BcttMahP~F+{RO9?%ZG_H(6oUbAu5mcw z-Io)j=ec)sUv9sk5c%vqX>W+q0HUgTnA4h8>r(bDfm+0}$~Ug=&dg=6sOY2)aeEM^ zdVjH|p!H~MLA8f)g2(~mztCr?zKSeIkbr5ZLcLk1P0;UyU#DE2{~FtAb^*Jg zmn2@Fos0xjfJcqo?O!bu56n^L$eyUFTzK^r4Nhi}!bb%Kte6DD6q6#Z=No%q=}3)ENv_#J6rycCIiHN(3- zyIDMOxJLM@qCgwlt|r=XgK$S@AO|qbYh_J|sCB;T(XmDTD1C7zrkS~#y|AcZ?#4KL z&bFwbeN`Lc_-13GB7fO_)#%Bt*DRU^10+FdvCfJqZfu;ft$z#cF!hz2#XR?EU?I*m zbWfaB8GNZZJSpBMeKl?-qxq1IoiaXwW*L(rs}L@|(^xgOGYu%vP0)v#2)o%_ z^|Pd7n$2E`50DegoupaqPHlsGk!FpzI;N`1ATvgVKCjPXFVo@fwkDbC>s~5{pcB6^0_J>WbLTCI$sq+TAu>pTfCHse$hy*zld@5&D(0AiII6D&OYRA znU?D9rih?JZ)3P1b_irar2Qg3$jzy7$?WwX`cL4a0FTkIg3Qc)TBtj+t-qC)%{tN9 z`-ko!c1RP{F1~8WeuTTFs#eJQE1*<^jy1W()=eATjM!!B)_GO%+|T$qv03si=9Bk8 z;7(;_W&3;(9q*OzN;^wgPn@9gC60J?W6IhltuEJ1oTiX>PYqw-W=oNF(jZ`W#TIkY zc&csnEU%I{5gJoG82etqb(rby;pi>9_vfS?OPM(TmS9pbgrdEjE$L|hAt~2aKFD)% zs{lvmQ1fboWCdrL%Hc^Xj&T=nO!aqv`#N9jSOczx{+NpI*mLyKWxv^k^Wkf_c99`R ztKWgeQSHU~r@qChS{{woCUVbH&0i!1WElqpFynxNM;eD_mY#{55F-ZwrzJQjLhU@& zF+Qqb{VtM$ttpp)9W(p`A_=E&K%=&OK`vfmdZuA_eEeaeSZ!g42~ z{<~Wwj~y|uPR0j08WxHbuMDlNnATxt%NDk_7RD*79FJBxe=cIZdlwH3_+%M$+)cn# zLLOhI4kLGCABivQf!44-`JY^EjK_Rfd$zQb+;LH7u}&0YN=5_fJm1$`GMuNgS~C(D zJlirqleA|IcE0a?9J&4!jy$@6u%0Ec&B9D0$Cc%&`}zl}bz95o=^p`?zvn2C)03K2 zX_uXFHebAgm{{bXP6w69H}s~@yL?7lpaRX8sN~w ztg;z``woNT*-0P7`|alNoGYgllX2EAQWh^uyZsKN|HKcsH{(a%L$g~>7R=H)N;B#m z4(@Vgyz1O*cg&9oaKvNNZ=m=3+7+K^qPgymPyJ7a^nHR+D1dzWZ&&#>dYe6d#-aLiIH^kUqN)@LZl;)t5Z zU=(}HF?xu=vt++|lPwAawHux?@o}LBn!-c65S3mjpSErjFq0{H~@iV z*WA5+kEPCFNfLY>RUE%J3AIU9xx$GLYVM?)$?>BQ|8)UC0urw(QuGCu(?`Ks4jz5H z{lp9uO9ixHx@kx9bdk@g3u+Om0UzV^yD^WzF{t8=sRrNt{&G5+@aejdw;)O&L@}D0_7hIAJ!Yx?Utb} zo%LDW=NK+c1u3zIMB#DVm1`dROR~u^&Wp!g6CB%ZVp$?o#0T~U^=u9mzWD|dQp?C3 zW8eGF=Ttw7SgMalwKG244n(W@0TI|G#4>ATm-``C*~?i#39JEr>&wM5AMOoh5}_q- zi20q4Oe&sa2_bmJsiT$gU9#JSKh44E^ICnHAt_pOHXNlvMf-X)=mAKtCCF_f`m4}= zxccwM_S4FN2YmtR#MMqd@`DhaqVru$`D@T?OP7SeKrNSJ%DQxs&{tcmbuo&@9ir3K z3fK#QPrln5Q>}^BOL#9WDQX!H_#}=8_->16+Zy#FUQOMcZ&&mKdk&jKBuW#6pgjH0xn$gT$!z{c66a|+*qXraA_9F!gq5}V7pP5 z#3Mm8ls}2ju=R^hgV+2aY|h->CVujZQ)s}FKfc5sT|)b!<$Fy zdRwFtN-4X2)7NjrYrutlx3UhUq|NO#NFX1^M+V&DnHqz_1~2fV^};p~{USrTKE8!# z@3LjeRl<1jCSoro+JrKFr~1H+oYyu(?hx})}<0>9&1u_%EgQd@I)Yza_M$r zT|tVi)Z$|am2BUmx-Z`1Z3cA%QL~pjY!klkU~$FTpyF2Vt&q~*nO#B46%?|t5aL_n zW(#GdnH@Y<((^58r%k9OS15hvp2}#G3OzjfK5wt-o{0idRX!f-y4fB}uC9 z*pSawva=@n731L5EGB3f6{h>j#wP?`MnObtL8H>GGrd$!Hc*k#q1R12Pc3xCMAG|8cG&VIUH-PSg%7PL8=YCD;>ZM}3CbBQio6`>Z(@DO& zUYY+&qFh6S-mBmo&G3o-!#JmnuWXadNhS6n>bO$JO=i;M+@UtSD&(-Up#MyvtXaZp zr2XSrnnY1u0kJR>M7?^d<2fNQJoHA>Q9eTkb`wJDSib+Yyh4qu+>xuosdD{Pr0q;r z_H{7>0lQlZaZ7MaOmvu7a50`>$)ptli^AsAKdG783EZcDth4(aioxGI#6kCsRxg>l+ zGW%1QGK-y>I+jl?GF9P|*1Mz~*|ONH3*U#>5gigyip;ogoj8L5g5Oam)7@(&%j6*BM4{vO5Q7do_ec6K@`f zksgxUqz^r#f)|1B_@o3kd=$G8_MA(v7i9oBN|IDtB0xizvbPdO7G zGXPfFWxj&-Kt^VLq@a`Bu`zI?9ZCa|L_v`=G)t!K=`ut?sv7sx=b+eE!Otq?BkyI6 zH-neTDk?16lans(E|1Z27q1#dYw7gXtYVNvixcJ;$XQ1Q0=8Gc){N}@^RTkBB%*DAsZ*ny0}hiC=Yoh4x}NGE_q zOSUQ8vX)qHO^NV19#@t*$^|{8Hxp#u143`xt`(|O`V;_|Unz5gj{1M7P`#!{_-gh( zT|RLmJm*qh{mBqk{Iyv#>3AACtHF4NU#LAFO#H7&HC(6@@boe5dap`acKzgMS(Yy4 z!=BEMgz%wrWN#b&B3}NNu{&#wI*jEg`rUO5Fh!$^82xeJA-D5of$SNOPus_!mcdoS z*+VY8;RcD36s{aGc}>CrS?xF*4txPr_-Nt)eW9a8Y8vm~>NCi@cyO7s9B<&4;I%1H zQC(s^{VEfM@+!pezC^swusg9%3n_cyXOG?kQR} zGo#1&ZiA=nI@f#|C{`KnF4zQbkv+Qk>5mdKU>c<%vͼ{?C?xAss2+i7z7Yd4gE zN14|7^L5;oJLNPGvcNo;4T=RYM-T&FjUjK{g$v4c_h`wS9|HtT545_&e*}}WbpWAk z+*4#8|Ha0g&71PFBr) zAk7v@>uYv*pt|LuK-7dcPxDRk4)NcrW0m;+wu4#Y3v&R1u?!R(c|6Kl;oQlW#@xrRVF}peG;R4(Muee!Qsqee<@)|4y`(-D&{{XV;6nZ2!xvPL^cc6#L*tJ{u ztmx&;+HYt13iRnd0HkfEZ2?-;N)-7nAVp1kO`&u>m-klg&-pZ8D;}>assG365%%I^ zvk1kKN9Y=mG_O-Ewx(G8)%|Qed-D8-iRU^?$c{a_sEF6AfQ=Y_zEuXNG@HCu3LZ~7 z@exySvwMi95>ErfQG*vgP~$ZWX;@Kv1Uz1E@n-=fUaZu`UZcD6d=@9y;Vu6seUkpa z1B#(C5r6lymFwXY z9y~lLlE}JI>fh$@XFy$RG`@N1EFNL_v}SWR#=tQGm=@}QCOHbPBn7u+eE=-NP5@ZN zUmr!JMCq?_w-u9-2HvH5Ke5uAQb$%1m6fjoXFa@BM9RRMPnai|gGf*Q5A^ zgyjZeKJJ%5>rw_CLcb#KiLVc#4^Z0J1x8yL3m|`7K;a=qmAC4}#>R#~2|#&G%tV|5 zX-L{0%JVdI+6ZH?V(Bxgr@%;y23>1c#i!DT{#I@G2)RFIl>qKQs}`4(lmt-%rq_gK z@EViQc|2n5pB?HNfIqYZ^0|*6_g^H1N;w{0Ym`rzd@mLmVgb~ta|e3g9Rks#-Q_CC z&E?RpeH%{6qi^9kNB#frV~oiY?Y#u;gc|@A{M{Rgz`nNyEWCp-C+|jjf{9pfKs~DD zGF=UEnTCwE1A1P|>xp{p?z|R{KF5BcH2w~t*#=Vp8Eo{ur5UO<)C$6^_d+SF({<3y~@f%T1EiKhJo^l1j4*Qjtfpr;6t}d2l zk$nBi0l1RiL(i~`CMFo?)mZ@erUUe+UKSUp`v*q|ziA4N5Mp}3+)V4*#oyfD@O~M< zXg{|m{_wkIGoF_5GhUa3fW~tKfl?5i`&i2xDhXgmS;Gg){9E|tZ4Yk#ZGTA>#hapP z!UE{~-3nDZxC_>U9y0qoj|YWp82>g2*4;4XL%WjgrUr{RyH=>;-R=~blO zM-j;HSaCI3Duq!G6Y@l`0JAAf4p>W~x0?I@D&v-WqHH?# z+t~#`Njt6|U>woF38i=p*r>gh*#6@~{qVntq~r=dEHyQ?1pt_5z2Baw0BU5EsOnGK zz+S|LJ3rz3I{A>WX7syqmgk==7S))xflSrz)$7x*N9NoC6b=T~wG$pNOy1u_{Ruznhz#{D5NqHW1+UIe)!m zdu?rvtdfJ#!*IPTPEc@ISQtj}l$jGFJ5 zoSa-*#)9-)CaB49XGqS_(vA)fZ5_37dCJXQtcR8M;#x26$HpjP z`FbhWbz;W`3w+(&a()=&v4zDN`wloLza|AU+;SvDlXdw`YoLL;5=w@C!^cO_JS zq`%woe6O$E8?z-9&BLtT$v>(7L`-Bl@ z$y#r;)D_3FUR=3XH$vh0ieI!qhC|38*ea-_{*UE8LTOfEI7l# z^K*-F+2SB%vg2hAPw~=4GlkNaBK6s+AZ%Jd{lQoK%?)AI?cbGfBvJ`1YLth1<&%#D z$R4ZQodT^{z+RTG#W_5F2WJl`hdRQkw^!A&>YTUp1$J4adxe6N>r6Nex`4Ym2eCDn;F05)I+wFG(Q=^L0pWYW* z>b82MhkRe+8$MWfV79*i^Gv3(>*#`l4YmV{_c%QF{_%i z>9<*M=$KYBKQbFuY~DVA6>!_!Hd1T{dwG>1r*9oqHJs^0AE%8VEA;)gsdaMQwR4T= zBw~N2hi*izQzzBg$qveNi1m+;=Pf=LfTzw1i*EkjzZ&-<{Rfq2cjednnzc6QzJ|(; zAIi~L_vILJUVH-;r@|Q(<$TT>4;*rG_F9AH6cn3QHTzS(-TeORBm38fWDma^XJkaY z^6V||S~|fMxQ@(sEzJbzE!&cMb!4nSohZIxCpysq?uK@cqXlER+N^= zyS_`J+uU&LANlQIryo61sA)tV@{oXCp3OX=`kwHnFyAX<3%LoF929QsIa-*~~3{U%yce)_8L07P%L41+Z-Uu{{-KlVHJPtJlaG2RxJ zl{IfzaJ~6&F$yqsrDRI*{ZZi}*F!c4Iyvp$bSMV{H@ zR5l&?()^?PMMWY?PL$EuC+jVFG_?$5$(Owz>d z>pvAFAH`#Jn*}89>9hv?wCG)UbJ6s*=Y~F0;RBKa`*!>kR~y1e*5&)7&^8NK@%JXh zAJj+s+Rr*ktED(UTSlk-Ftioz z<7I(EQQfHXNcYhIy!RtP!UcXcVPhduQ6vuh+E34%hx61BVC_PED~$KfE7k(&2>~h) z<-LL?T9~2!)Vg>u^~8#g9I?u6d0HPSap-dBxt9@IGn~5x3%m=t@AFNq_XYwg9^RL? zu)-{fI7C}*cPz+IY_&Z-oR{TWp-WEdYn5SbZx-$%-6JAzf%Jm}-aEe>DQVa_pcS>C zB|TJV3UExocN@Cm)_(L`n>@c^)bop%=26LtZm(tn$hOOT^dk>~=78+INJ>HG+ zDqTg#<@D?mCrMbax-E#2hs4fjcZK|}amrDyOwkO?c1m%O(hTeyCZRbZaPCvD>GJ3L zoQ7pH#;Agm)A!yU%XF1%`#IU@g6&<-Dw+I6NBPc%4_BN${oZC@QN8`caM6t!<v?O1 z)NJaZNYz^W_Ul3;Q_3~!#`ljC%1b_qt))U&XroCr!^H&D5@66QRV0u6p(=&6q7?7U z4LshhF&8h|Bkq9rNfygk* zc1tsmRM`%@e%|d5ID;+n|Fl_?p8Qa_Y9LkZ3*}0WHpzxRGbU(5aPHNJYi(e{;qu-i*RV+iJlJXRHtad7 z``*y<3$95;&FS{DfTy$$RT z(EBoj`CVmOFT7fD%;|JUj1XWgLM2JLcUMKZPl7>Mrl7pOc_&FJ>C->tBX&6BFTGoR zthJ7154gZxtD)c)cGvIc(>=FpDwS%( zXhffeJx4nKE|uS7O}D9D;z7w9WC z>SXLZkPxZrGA5KGCp>4rA4`82_*1ky!j_q>Ov2*$qT)DLF{PAmH$HIxn@vCDY6_#1 z-=8-W>ukygt2y|A%%fPlqDK_bLn%vXlWEv5tUE3i`LMuJb{WFRSdo!iymhlhO7hFo z;)Oi23d1+rk8m5~at@b-cHVx)@2mIG(~?QryorYjtd3mh$h+p0lc^Y9a&6vOC;n6P zcP7V6={~*+>DzM(j*h9~OBTk~HQP0~M)i;s_N=bTTcS);TaTwj(^VT$Zb?LNk^I(q%w7dJ7)td+Oy^_dm=!GildPNhq7-jJEMwLJ9TF5ZxnRI`ykax}D^}DgJjt<`M?^)5PUA zpWIkn_c!!xjB9)=W*x!OT1`#*G#xk4?^3y}6ho)GPP$l`Ne}-bh4^Z&TRyjeI?57@ z7Glk^%qyH^sE>4gy;=Tp(M6dwqN-N92%G!8EqlEU2njljGNxQPh73}=;TE^lbXLdT z*x2=IXLDm$hwcv}pQ)WVyksogH3;3bUiL!G)lG%!OvO(Aphd4VW;n!n;?Z>-A&qRY>WKMhRZ*a=+xtmk}U2;E4hwi<| zgW=hUirYn2(p2k)-i!3V71jKcs^aaE#q<@dMP&!yq;1ck(|w2`!vTGhJ4rI(dm1nh zZ~M?yBh4s#aa}NGsf@k3M4J45tBQUHRmuLFO3@{&91c3>ZMR~B97=s=8J2U{hpJgNezzWvLhNS`0N^A@?AMA)0mQ1qhs?r zR}?&0ON|LFGvasMSYOjwWWVxiez7BD+?_eeuXr!|c({SQt&68>*VdsiDB(x@k*mw7 zE-Ou#M{f#|305S`Emo8afm1*UYmUk37CYUY4L}PyGcD#${RtFzVcxnpI~C}xDiPH^ zlRkx8emc_`SQYz9el}^n%+8o^|I?%EpR4Y37kYTuQyohR2U0_@uL8KY#ob`yum$FQ zn1H8-k28DT{1azhdX}CBne|sE+d-8BxoQK}Yafc79W%FvN^59TXfjHjYrqij%KdLc zHFJl_S*Od7keG1>2#jx(G33gq0~}6-vS;yT;9q=i-9G1{_ou_D{tYMk?;nS8@7KhC zZKMe6mzB_uT{u?tJvP244v2OUsE8F?)_yC!GiJpMD2SX`4MWEo=Y-`uB#@JN_s){s z1fHjF@sw-kGZDMzM~IYp#j9zA>kX03)44O7b+h+BDyDx~H$IN>PSLb+oPXwGY0LX7%jRS&L<<>d-V1hNpISR8j~&6@!M{7kH5uZQNb({_%zT z_y4LR(qm;MWAbGG{Ao0j^oO9I`$?-<2h>w-il^PQcF%Ov0DF6l{bEgIKb*{6_s z1A?bBDUday;y^div@^~>Kr>QuJO$ek!54{DUcy$d1If&zx|06%GST>5B2o7d)Ae>`=*bMGHN{XhP13Ed?lUt5orl^~J-i~T5x3Lep$|6lBI z)l%_lzVqh!lIRsi`Rxm8uk-X3`#|VTrvS3G%*F_V)H@kq3poq(vP z2Hf|v=-WYeZy(S>?}P7rzUaD$|9}Icx~9e0BK8=!@?GHz{Y%lXmHzbfl9H1D&TyW7 zb>E+t$(aGQu4WT1^0TMKsi~8V?$%>{wtN%Pd z{yJiq)8JsG-&E+uZQ0*WczjvGVK!Dvt_I}`d4YAW&d^<2+Sv`}I*U7X#qJI1udK%y zhpBmNc)u`2-rlOr=ZRm?l6H`o#aYKX1`sFLJY>2w(p{nQByBni* z`JGON@U!*KwaSZ`TaT9fW!)I|10m%ilc!7Z_uix&)GVbGwfmi9cg||G7T|6R`g;)? zNc5waMmoDg=x;@@yo^6cYT_7mmqDc>r1?vIVYpfn=gA+W*i)eAG6gs!$ zvW9FLjcXR{M?h+PgW8x>7|j;jVi?F~ke6z9^cy~|b6om+PcXX(GL3zAz#xM_okiiI zJ*=Z`O(c&}&YrRdsC`9<%EN!7o5{K)T3OvY4a4r>>jcqsgpO9BJEq|goUScS1mV?R z)ZYDhzN4?C4p(9og=!|qp`Mmf0y|~R642A_Eo5I#=_zz?>lyk>4Q{_z)%Ux{%>{3y9Ly+gJV%x9Yno5jwoy>Zo@6+@(y?$c>_<1#;lDOrIgPdI+Qo-i zjW~APV@Jm*P|!b|7d;T0SMS!3^|l7!*N)qpV47=JHDj1-s5ZGa!;`|k z^ws!UK;w()VEtJtn8D-9g->BE>T0aFc70si>32(cN)A%ppInDUc7An~J{mY#i3bho zD`Yk?57!kOr^+!(yNmp<^w;tuP`SjYw(Ub#1qK!DLNfZP9tY8NqusKfBog{z*YK;2 zmiR^re%k2a6|D_A+*h*zo!oX?I!wQs?2nqAL4mZ^?+4Bf>tW~Jr2Qud1dNPDc!D6T zS1yAdMbo>PZS*tB&$Tv@Jpck zj>qvAneNP{Od2n|pOZ#6xaNc2I(GL?S&8>C_OGQXzS!zss##ka#oT=vNX`aAd z%_%*)PdBG$a`1gFd-P2C%)6eXuK-?*_{#^WR*wTz52=z3RV_$ z-M5kMG*(k36D?Rvq4Ou&};itwvte4J~0xURyci+>Hd97Zx5D8YGL8o?}No^Vkp?U5n_S&qrUWp^*|7;sDdbpHU`NAtX$mq~ zq-z5UF4r(uLwbx|SC*j#;S${uZ}=WZ@g~H3Z?|t|IU5`KE^jr2JtwKQ`z(4Vggm@A zZ0DlX`c;hKtr@XS7|IRO_hz4lbLffbLzCH0!*eCfk6z}|xs}%S9{mZN2wSNmX{|S_ zazl2+9(Ox-+IWAv_SzNEo}}K#MA2ciIdWrY`ZH#OR#8>jY*Mz=O3`(PUR=y@^+{Uz zC+@bbi()|%-Z?w|>ciOG-*96U_>{HX;s|@V>X?^x40Nu*adHoppZ44)5aR4OhBzxV z0dZ-t@0TRB^)uE=KHJ@9-8k`NZA|Mln{6V|Zy|#CJ#QPE^kgj>En4Z>`$^ExMt zOFmq;jxY8b&KR}72I&dmv!7Z@O;4=RJh;YZ4pyg{7Cl%hpTR86@x^ISZ9R5(6!5%$ zsl@!!1JNr$qFNqzd5Et)hFQ=_^1q=ZeNT({c`X0Moz-3xo5T_F_3hqWx@Ras`)yzG zrFtbM#WUaGg?6X@GRZk^lrft2W?!K9yRxf=w$shuNwcZwCbQonp2hXOg3o54#i(f|D7HToHiIVk-(#vvD-d8m7 zH_sw?mL90?yomLzcgvq?sUK`cs)iJ#2}=aaSkJfEwVa?gNZnm4xbf4+vK&&A9cp+| zS+|DT*#5Y<`TC-&a9kBd)30Kta;FkSmYU-xTdNI{nSJR6=Bh7Tvya&0Q% z1oLL3Nc#t7#LrU3Zux0gGGqM}w@o)c*r6q1_5HA1li_aM zVGu;mpy}uJUbB{C`roMO^3^zq>5YUc)O!A0KkJ$OucOO4A$T9yC8-v442!={=iHae zqYeCa2IF4a(rGL|v(*~?&Kk$=WtXMhV92zHT715Bn--cFJUHK^q`ze}m0~0G`m})> z30Jo1Qi4oN)ett)kV=0XBynGj`+Z2N2G^K2+LVT#ec{G^VuLx%U*11_$}h)U=PzEz zd zYjM5ggTEXniigEgYUH|W8#zQvF$`B=VY{_pGW z;ZTwc`ydaOChHoaRb#Gdc*kew|&`z)0n7=`mrkbC)m(O5PZCO)E|Djdw3^s?`$ z4Yu>;zpB3zLZ9e5TT_%a6PumXcFbA{`9|*DA8U^L^W~yMZvS!}?TAr3nv;LFvV7i3 zvXAZy1-=DcxpMo8(0K99NnCU$qd&C+odd(iJKeyN^Ny?G@G&jS(ZgE8dokK^HiWy0 z7XJi*X#Ozliz;UKC2~-(402hEysNmYkaCpiLV<&Un@sTUSrsK-FZ2}!dq>N zfLrSOen!yieUp)o^*ia`-aN_?gw}NKI`ikMZ{CX!jGTX;nR9vLV>pMqC7_}30-fBpP5F?;G})6Q zv)tdacJ*b|pO3X5$%)a2*A~AXkeWb6S0K3pCC#@WC7ohBQU?h?4V6DposR0>K6_81 zvpQo}*?3hOnK^}ql+PR~NQuYu?Z|08;+JEHCnIa`+e1};?azE*ic7&w&A}`RMzvB= zcP-okQAZX1*cX1*AY!dJvtX74nA?wp? z7Gy(@vRUdnH#JN$V~$zi`46w~{;}w*$087Tc`^95xP7A^u5K=J_rpTPQ)O7GI%l2d zS~<~dG4$PzXW`FVvJ#3+zvum_y*ed(3hrXMq%(2&w{dD$wdZRL(AQ%-OvpDO{6`5&mT6FKG@Xi@V8qd7E-E*08+Me;&zsX`Ol&*kKTF>%Fe_{CUs&S{rIZlPQ z<`V*BWM?)0R_RM~1hLXw-qwM6rb`xBklN7Q*iGxGpmPVU#;`3qLYTh@@00+PVkSHS zGunOUw$8fQ6Up5p8^m!uG^1E4o*I+bRI0q~v@W-&8A5zSI{ga>SFW8@L1gvARiyR* zB3})&6M04+o<}%4wsEJYd{={&{|>Qi@dD}5PYJN&^T6`3K=@(BYG&42)9|h6;Lt*# zjzb3cW>y>0xm>E+BpMHvcNf^A`CMrZH!*_Slnyy{T-jNG31Y!Hz7FY;q8 zmG~K9ml`!#)el~0?BUYFEP!U)=dK`Ob-g_az_1mdMLh+vPb%kLXx{f9VbbIKqgo1L z-2h~r3fu`&!HQOf#dE7}B|?$)nb?%8F&?bdVn7UhI_3o;F#aikm`jC`?(^yaEZ0u? zIAB7qL)vCEvwZlC(MTT6G{83tOakM^ee*UXVV-OM8u}CWb#UglGVcHlG4K9_A@BcL ztu*j>IGq-6{kOA@O)eni9LZju4Ym=c6d+7wp7 zg8k5O#-A6_|Qdn+re{o+JRY0xHLV_hHiom1sG@bh^NKtrp8@sBl+%CNbW zC36T4wN)&(A9#pG0`biw9XO%(z+N6cA0wRvr||`g&*3FQC(GX)|L3!Kn{veR5=dTI zDSF@g`vH(YaRFjgNtuN68uz&yDpRnaRR%L^-DT7yTBE3cV&Z2MpN=V9<}FZ3x3*}K zEtz-rke-9w(uA-(@h+b7%RKUyajd|7b_KKnsGWn#eYcKlX>;bKv$JwJTKbx=by)d@R912?>`2Es$Ve%pfZ z&Xtt!s?UL_>c4#MpQs-0xw92{=d4riY<`}{gzLXUZ~_W?z9h8w=D!R_Bg2L}kud_% zhYwgExZ{?id5k=D?rU~lMeQ8`wx|RQ zW&fZiJfQ|Zn3r~rG-rVPdH;?f-W$x~Jp-M<1I{9oOb=YHe1>ze-Si_(_CE|h;}9ay zFz{qnBlr+E3Cw}}bIm~$VbLxP&zqtw%s^{Yn?|1pVDHn;`!#~qt|humxvkeg9YNmx zzRpLvKynq2jdC-#Q}Dcwc&Bg0S>!$&*7vZIJi+ycl;mh@6@Q4#z>XF!4ZUWn02j9OvQ>4DB5WhUdwX(k%@$;nW#32&z@GxpaftV?@P_4stlY1R}|uXyL8rDxX9VO zOSd9_14q@V*ESoP`8BUj{iYrocs#icy;_Ra50CkWAFeNS>4SwuKdZ-D#Np?cKyGE6 z1f^p0Q^HYjXWhnRWjbG^970D&2M?^16RgW-0v@>S%sYbD92bmREBFxKqpl_+Iteg* zCehru zCwhiUmsJ5gMy*0NxL5NrS5sy{r-i^+>FbTfcpFs!>*}}z6X%~bfRG;Nq9;vdxlS0G znJ9PY&qJJG8`H@X?!kf4r1RT#F}eg7rLf(_P9<>0YP=+=PC%_;{H7=y_4#Y)qR$~& zea;1=KmYP@U240k9QT0RYnB?BpGP38D-db2qYF zM)@Li%I!@m2s`a6P3OfFAV^?W$5?j+z491*?5xHQQw4ud5cKbUMTs@dum8k$gfe2`oQiZSnQi_-CNPz}a5G z;YeVE8CV2-AV*DsZy0Ob7TftdM_&pIW?RJ#HNO{%Ei_Xxx-P*r2<^@zu1cNpZ=CIf zs>M|N+ri=wu)LRgp@&Cz#ZBf3ax+6|k~Y|0x%E3I7XxdCC3&JT1<84t(Bne`yusIc zX!VC)ildkECqvdBS`c}(vbPDJ&`Yj*6plV`O{@l|7#W9CvvSK*@@?#XtUrgGy7Dq7 zksb1&B#ipK7NyM!T*XP+t=)#$!{M}CzjqQ2r-j=5$;Ne~XPy~vC>nmutfIJ%xVs6< z(JF6z{l>$>+WNWX+2TzLC?S{~-DfpTzQ3&)$#RL3P2{@SYX8gUm1*~EmummF)ZN`z3v%%>t!|b^ zA<5@e7poHv+0}tSKE53_yXCCWP>h=lXV}&Z7ykN$eN|PBv1%!|>CQF58%!*9eaCgS z$z*}{$`ylV_zZj59@KP`_G_o-n($+<1%remMZ)1Tr0Es=m!oodgLb!iDaZ`M1h$su z>8T3QPpPHnC7l#l92pmBUt24!PnYV8A0OIFEwa-GcL;c1Ani(pFgYy2%+?dCPd3sZ zsjQP8w@#Uyb4BQ$a9Kx&Z}r*?P*FqKHf_eXeV|t{Ei|^GHwMTl94=aQ_%rXFalr3x zZvSp5@FN)wz3Nu|K3-xsBQ#Fx%>?cknZ_z}T+;4#Flw(=(IT}QVs(YH>wkFx*t3SC z$GXH8ZWs?5*V6)FWjQOcT3BWvev{*@TAt3)sPZ=wQ(Lyx+J&5@fq7rU7E3>GRqz{a5pG{W z2gVc_mj7bknJ034m_X%TmHjy_%`*2QJyOR(m0SIpWTM;tBbqS2OdcBRO0Ue*=Z?z? zrxoN_%q!``Rfk*7bz{caDHyCJd2jFm)n3cCy>gGHuIw!fL#6%60OJ)c+jYT-p2!2b z3Z&aU#9h|UNTXsm7n8z;90*Oq$ys+h9n%-;k`Uv0OCOy+8gce+Pu>ITs$-$re`EP*9`#58s)$>T4Ncf$_eOTOQ^E1ua0-#pff6WV>* zZ&D^QyrlJe*f#1_7^U5qlccN|W?l;WT{t{?yVuL5qet$%aPsyNe3KxlKb=~^xq!-} z3NE-E8B+YcEs=@YtY+(VT>iKc+~;-6kLw2~>jx|Tbcv#se!gn*kkyG3(dwT{0_y`= z?Q`t4mw(%o^teq6gV$w|{ z0lSMb(P5HlyO?Kg^S!dEG(1aMt7UrK$@`HXB30Lpi^;s#sC?Ut8dN$0eB$^_x9iP> zm)piq{tSJpBBwI4lew%v9bh%)7f!t-E@5-p;dt(~>(n$S7d{pFCim?JExeWw6^k{} zAy++n?)K`Q;#!l;bD81yqX#uk#|yB%7^{vy;n@PcsnLedd>+bg#gIqJn675*(k&I$ zh44!a$M2z5Y5C&f_a`^ue*^Ass>yiSfQBo!z0GK$X#tCNqJCx_NPL;r$PSc+Pxa^_ zq%NfD)J&*WQFg)mRrj9H9;2OHkzMsAbt%ni5CUbKYHZzmg`6MBAor3J;hGgLdOW?la(=pwb2oSI^7O*Iw>#{2a^A!&Lq3*g=ebp*FN|w0!dj5~o`AzW z3^98k#$q_zvNY=6{BwT>5hU-1vC!wAGrX*Ahoo+(7gr#Q+LmuOGA;j#*DJZ(PR>1o z2(;5M;)rA$p8Q?Rn-8Meao^?WE)FZNEgy9HDs=gSg?X!ubf|? z*8^fn76Dw)FE}^ok;l8A)|+}L4Wtyyfiomb>dfpn%2v^r$DX4 z4mJD{8KWBojZV5@mslCG@Y}YTEUP~rt!f=1FlDo#D=ME*#iuXLrI%iwdvgX-!RyVE zZy~tc=`iHw3||ZSJ7L!)!gk-m>z49MsI{f{3mUBM;)M{YXcF03VzEW`{y^5^-8%>N z8t=U_Ag`xhV+7y@J&BVs1}mLtR-rPMLXIyXcDIw~g-?3}!u6XK8+_cWZ*RuW9(_MZ z9c#U)-)LsB$n5ZL0=7QU?#_ZQ2$UW9g_I`AM~jq$F20I>%vHZ|GLb)pn41%~x`FcC zTm)Q+S0$?zV8vq!%qR(Q5H9Tz>vP>Eo_z`S`i1)I0tT%#U`3aH-f4`D(Wozh?O~(! zjwM4t2x`W;9iV0=|LWmgHk8ky{rkPuLG!KYI)Ok@*Z*eDRDXJ1u3N<20LNH+pjw)5 zwDGC&vMK0T(_o)78fjD?;eR@b!^NVmW-1h#bq|?#r`bHtY(*tvkCc9acCOUS5YOTA zGbeS8G^;Yh*~Vav>Lrpt+VhSYW5BMt=wY|!AlFEZ^skBe_H0vRT*Z^gkpko5x)d%Anm<`+ zm}v+7F=OKOq;YAq=dgzPz@L{HYDgGO!yLZZDL3ofkA4qL?!^;;CWd%xre^hl%!wcW z;VM;5V}oEZquNxG`=WJo4ydwYDuYxUEB4niIZ)@Yd#LQ@O}dJ$!aJ+%R+ zro)Qo%9fOGDmk4Z>Dj{`P8UA}^LjYxK!fSO%%A_~`gx0y?Zwd?Szd&QA@pCC)cD%44yPfhvNb0bjmg|^6eo)VQU3VOlY366cwG`y;T`qc-T3A0LU+R3Ut z4phNH&4viPvBE?#oog7eW{KLOei#t7aZW;MjF;{OsCmv(Ysi&>IdLDj zW57Sal0l9~(699L^qK@u!BQp_w0`Cq>1h6up8F#5>R@A%C*V8-2GlOyGymHRY{=D- zFt7Uo_F&SVc5Z$D-)3N7-e2oO3_cAs#B{*yL;fSLfKq`x?{5|QalTeKS+_xCos(7J zKuLOFKi~2>NgC|9B7itjI={!yn^V()9p#%F3*gwFA%I)xe^eKHnE0Lb3T!ToTrAAX z9X|&-(>lNXS;5TxyqKCt-}Y0&p%3(r{*TSTnSY?h5mQRTun=XxxSTz-+KK4P&fpt_i}6|`Hezv z6Z>dVpD&t3d%YP-KsHR&gLgfw8JvS@C1h3^Nrv*785t^G?qsUOB;ik$qTY)nrE%uG zEf(Bcp5m%L*5gXiuYQ%ez(BZijQn8njh5F_OwiSJI#G+g=i!r?ElMhG(#nr)u4avldjyFqQg1v*YPY5Pb0HkdLGypZJ$iiPWQAjVSMR-`JDX z_E(J3Ey^jCr}hpX%&ngmnqtORuFMQ-PW}i(V9b;SptV`5`xA&QwZ9~Zl;Y}_%i)u? z50^NTiL`DVQ`>7D2!i)VHf9^sihsk^I5%HWS5$@a-Po)DEZMf~6Ma~h;4qB724Z*? zE+<%1>Wl6*uyDU>*hxS2A7tl!c-5ezGEfneQWa5M-B<)ehp>I&DZI{EvpRLc@H3%;( zi`3O_Z1u~|KXEyFI(p36AG1rUXq4Qo()DG9kAhyN$ZjmVs*crZUfkGkyH5qWOde1A zwUm0>?v~zO{AOCX=RA9#0Q!E9P41Dgr0v;3+Qy!jpZ1W;wB_k@v1T%h;+$yJZqglk z)TP2NCY~)b@C3%`)C7mEcgzf&_6@jax%!g97bS31bXHrHEMvULl=fie%QmjpLPpv> z^=oFDA!*cVmVYW9xegAKNPJecoRJc;Bc~#MVoizG_ejUB6^@RS)YO_q z(@^-G9cCQI7kSECtd1sktp?HQZ>1*KUF4sq#BV2*W$Uj`u2>}O-hr@4HQySUyK_2o z$7^Hw7i!AI&HZ>>Gd-A^$A)ssvmf5KOmz%^PQ^H8_YV#yu)rAAqecmDs!Brvef;|= z>0A<(wsux%9vcB@#8-* z#c#TqpNI9xE|S80in~@2go{kg?Q-D+$?Bs{(o`kt*O&3gvm-ZmLV=mTc8=hB(g9=Z z@Uxm{G5Z5fnXz$>gkyn+)icI+*pv)Az139J$(P4A9U3eSg_hQ9WuQ*}>lDs^V?KJ1 z!h131?Wuh(G$>}}>7o7M-_rxw3(tY?yYs{ZgNGgSY=?xoBp#ZBPnk@9mS4K!VB%y< zB_2>H-@|MrHR~Ts>*2DAE0=Yc()&~#Y;qii-q&!^T?jla5>nN6!WE+pi88tLb(Eeq z?jpA@avD6;7ZWXgZl(tfOEGI|Yhn~RQOCe!EH^CFzcx5$4??U>9N6gT!)7_W@iW2c z)ekas=`z zW%qQs@*g4Ci0#72w|0LjgfRyO3cK$q^LEB2Y*X_zQo)7;`QNd+t?dJntLTCAn${fl za39yNmaZ+bdh57u2x$sePDa0H?zZXqdiu|*6cIPJy1@@1Tm)^oMJZnU zlG$6G$E}MuSGGs8WgS&9qM|1FnWm`rY<1Oqg&Afd>b7i~Z5Deti()tpRrB}V3T7u& z10xBp_(oNI2A_2O<>{bJ5i?lKDL$Gj)0z_4iLuMJnd%lqHIa^oQ`{j8L_Y zEArlyhs^%GX^#_PTAlA6bYdM+BK1>wkMs?Ci?!#gC%FI}=#+K}RFp=3| z+cuL;uvy)w(UoS*q>hvCSCY1aDG{0KlP&eXBl hadGlr*W~9nc&*+px>FH+m|dJdkC~ z8{Y&}J{KTRU(icjt}#fju9Q5!M^3-gS}(ryp{`th9OW)pJkf1Z#iBbcF#r0B$NTlT z$d$M(1l-9tU%M9LjBWUQl5J^qj{zUxUC8{6_1Hs#;r8$fPcw%JLA(0?90?C0MQvLV zp>B0x*SIoZP2SB@mlycXR`dSa(+=8jfZRCNOO!|ihCA4DnT8!+kD8)eesB5yxq4pJ z@6{`8*ksvBXE+{!Q+2i_((>i{-bfYQ=`Z@LZ@Bf>dIE8p5$v-L@RT~&y@M;4w+Tl6 zLq&((%;nB1B?=G44!lPiYq~El+YA-|V0UL5YQ*t)dQY+mWS=b{mxvWtPdB>}J>c~j zimK#E*s3cG6)W88liC&9x6<$SY9Q;DFN_?w^N2$H#hwuTIlQibx9MJ*AUf5Ce-5PY znK@EpP^On%E~0mkfxUrVRaDP(&k&9unPsIs*3{pwRu#LNSGm8BOZr~(4!<3Kgl>+0 zccNd#(mbLGpB6cx$P2&tEowdSXYZy9iDVT0#UsFoe6n^mPw#BUv%BoC zOK!9@#4w?$qMn3&Z-hfOP5%TAa7v#QmQ7bh?FVgn?3bc=wZCnEoJKG;V%d9E*5^do zgJZ_IKmMho=Q4RObiiMq$*-bsc;%=4SxrM9xm+`rXd-2oagws+gK-L+QPvtF)6yp& znm7>oBP2s_x~yk~NSl-PhVF&q4+Wj3I;pZ@48NePi3LILwta5UnZX5(YUy|$;J#Z~ z|0(}7PNej=hVoHZQ=r~5$8cwEqe=K!^ypK1F=t5Sbm24f?*OvftarcA=LY(|y>S!1 zpO!r4b}uN8msVTZwvL39mTN=y4)0^FY~UaL5SpU=#PYE7cZ@$7Q~E@0E!y`YE9FOO zPu_QyhV0&JtEid$@y0by7G3SvqHVC92It04tcf!CAkVk#+7hGJsE%_h*NjVgE>H2= z7laB49?0ML5Jbaz^(?r7)q8p3-M|&vMuWR7jpCMCB@Y#HE+-LJNQf~Fgy@RV->jsr z&~|*O$RIJ1FYmpPhfStR)UUp8bL*C5)6=zydAUX(-jZI@2z5$3W7{CsZ{JZ_xSlA2 zfDPr_(_j+jRu(AbiWE-5F1f(bj-M-GohT8i!7k=%l*l(Np z^u37BUdPKD&eRXA*Af}UPS)83<`P_2#QHNF8s5qUPHYi4!|nRhsJE$Qy{D0rKU^&( z(=p}G#FPinX=-yn3fg=n*OJ1^-V-x*TOkB}^}C4)zi#9K#;+7s&qigkw%6|)tVwQ{Xxg#4aYcSU${*E$9q^rKrrsK{q921;@#$wJ%7SOT5pJ~vqN^xbluy{shlyb z-UiktRb(A$O=EL|ye*qrjO~JC8lN+Vz8Wj ze_h)2+iCtgrAqlU9Tpu83Y#hH+Ib`|iJGS67atb=*FLJ2Z^^r_6 z5$Rkxy0Mm%n;U5GTg|;y%!=yyv(T=};e%Iaj_T!{p{%JEK0nHA4yW?1i*qMWiWt71 zM36XVQ5E3c$ny6|U$h>Q-5Jbv2`ir8X1HUDRWgidFgsCGr83T%O-}sD1@Tl5aEp+> zgfv4Q7p|zd7|ka>tRL~ z?&Ai<+5AAVOhAN!R_P-O$Q-fqvdB(FQh|ok(Uqhz_x+!FLLyJG`TC;`o(v2!nM3vs zP;{M|JD*scVogWvK|ZgesuVXy8)HBRiJjYm)C(-?N=2{qlwQXVfA;Ck5UG$L?J^QIipPXWH#G zwwOk%~;JoCOE!$ZW<1(qT&7CVu_5Ju!c^>{}F}(>gdb@l0v0sz!r8G*|oy}9j z5aGiJNKyaNfHtddmh0MO?>--CzZ+hpkoA^F%Uc#xvrUB>>~*T|1KEtf;Q>xpeR~%pp5Tu8??__yM6g zcOl8v6jsa1lswNmEHt!p_zAGt(=9?t003RjN~ck}%Fvq4~H=7~&=55;MuTbXG$qF~p16JztI$-1BwV%d)Y1o21f z7POcHTRAY-!qY!b7yYW9&r zt?j$c<oF8CH(F!r$^sEoM=6c5}hl}FHmg?8-m;?oDCjhFWglv(1vM+$^8 zbouO`Nb5HgtnVNC z%CMT503rl(kIGzT`>iAYJgePa7v9B1=Xu`r0JMlXV0V;3e`9W={(x05GxBg=C+jfE z7nrB9g|bM!!CLYaWl^3spbYAWWb#J1x6NnYN_vn6+eC09W}}uyWgal>kU4lBD;L{f zGTw#RaM$OZ6CES?tIIc;{uKqJas@Gweg7ZO&bTn4knI5Y)yW~JFcRC5*(S5$El1`Y z`kq9U%9cO3X*Q5Y9cDNZ#8@Y9Z&VwIakbjlXj#Zpl^2smoHKUm@7Q?$#vbI@cx5Hn zSjK?74|p%cJ!~xKY~l5Jko5p0@%?ZWQNgzB;Y=WQJX&>Pe)0X~?LXH67LXJ4(2~+x zUQkZsUv$~&t3MH^M=L+s;MS0!26^`Z=)1OFjt#Gef z!s&bw#v;4FL-_kjgUFOX#ll_kaN4&Y0D49!>Q0-W{r=MaA1Kwx&N_!K2{g>`@TeOx zHSZ1F_tMWJnW550>z&q~^RA>pYBv%=6tw?c)J(-I)Qm00>mYU91~my&Ir@$yG{R=I z1m)Sz`2mefC6=n$Z{|y@sfY|=1 zwsOzZISoxcU>T*O>FLictrW#8G*shtoR;Ukm$e`N(bJtua{jB_O}M(GLG1-81jke} zNZ0;w^8I_BUuX{lD3m0ygZe|l9Cgk=)JMi8h&)+1^P-hJjVKsp+;QzRLN$DmS*Cs% z{9Nf3#W3dBa|6*&onlwdFVpc@@3|tLVb+~^{=dPemZoS56{DU%Yi!XycaJy z`l|f7yG`}p5H4ZU6AioOI_0*M$|~c2%hK~VP8=l6d<;D}>K zbms|?zd*J^>{}>@FSs_-#pf3a&NR{R51sh6&`-6%oHy$<>NW~990A5Yv8=I)ydLl{ zhV35>OoOvFUOjp{sQJOy76huBlI#A@ z@Bg)5EX4HYA22u~pWNUJ@Rio|IcV{tk+HEj7%quobo0WFIk-v=w~koq+W9Lxpd?(X zKVyIea$hKvWQGLm!?Zk=ZsVW^Ew{KsESS4 z$^l5#z5;~xs;81YbOq#j1KW{8Lc+YwsZ@}qV9m{<|2K-~#-Z%j1#S@6|G3Te3*1`& z@(lTOKAHySUS$9LTCV_4?2)IA&0iSynS36ACh=|gWAL)_-0fTe*rbw;_ilXuFzVFl z_>yr_k=#s=97VAjRXyrm>o?~d6ev)wd*)T|f6zpUsxEfMM|a7d5gKi7@5G0lvv`aj z{ud~?&E%(Z;cd`Axltsr37Yq%;DXgW>uYv)fj6~%oS@-jNx(|4se5_aZ=S!e)J_uY zni<|~R+Kym%OkG-|3UHcUIScBRc7z?apMeK&6d9-7>PK%DZY|50P>Wp`s`#=?bIV^ z{Z>`S_vYqiTydUP&UACSKPg=r81u9{K*kaRSf&y!#xi$Ehz@~qBBrjZq zP8}vx183zlG^+=%3KCWw6i3!@j;mLL%G&+as{C?$HQ3QRBWiMYP{-5jR6qkK20ACt z>LpMZ?B|HqH4JY{B5(WJCRC4k5AUIcWX@Ohc+p|7%^)hFCqt_8Y5J z;gXB7I`QhEr-OroSYu2z&bW9K?voA2WJBz7lrZJz*-p~IoE|AniOqVId*9Kqa zs%Anhzg9$Ns15%eNLJ)5@$>?;I{5FN|i8MW0rR_J`-nQUW+5|bhRxfvFaas zA=hZ`hkSA{Q5^0ZRd9Fc$X2l_XZjg+Ybm`CWn^-^DcJr0Q1+gIaCLp#cSuAMo#>2H zL5xvcb8oifMMg$SP_ZHE6Z-beLP7uBKZuCCtyIs$FKhMYOynWs?ds}rcwlb0a0R<7%{FU+}%>cp{2YC?KFH~)@zc&<-~e495# zkGnjYQd2;Rlz(?JWQxb<<1G7!l&1pfv%DVHIr~In21Tl;%1h^b+Bna`F~XD4d$k*K z(2W(oBCF8*O`T=ob6tb7@MoqMGwhBp%d+~mu3v^)@BUe(7dYPZi4w5Y(g1pT(igq0 z5vs+q*L-t6heu@=#V!Mm-GDC>Gfa{eiT=@~T;XFq5b?2CwivzJaCUgS&m=%uFT(U<6B52l z#J_>J#COV=A8&c^!@fp)UDUTfhadIN|aj6dPw@YP@thCRph`g};{XhL}Pk%J$eSGte3 z3$zFHVcp81Oor0L)p=#aI0r;M5SWfhp1Y8AweTOu2=VikDD1%oJc&zWXI<{^Pb~Y$ z@|fK;NBRw3QqY4!E=`1#-+srpa=h2sQ44U2r0>FZsX=3k^1bLqitrOQ{DP$L7>|# z;(dt(jX%sStmLG!n?_Vc{J>sp1@m>bvB$`UVD$uem3phHMrrSfOYB4)Ln)h`!Q)XR zqEC1n32(b}I_gf+aFg+bDOSF$`**J!sz*4SXAKj?xdU#unmZOX~b3vxSL&@ z4Vixai#5al9AfAx^Tr2F@-Ish|NmxX8t=}H(R}ROcDI%J7dx2$9P$Xz$%OL$FFx>~ zmg#QwE3&oyi0^L6@h?vVICr}K<)Q!iQbUoqccz!D{_qd~Vkz@~ufi6q1&!xBtbA>v zTV-aTixSVV-AW^%{a9E4>z3&msVT}ca7lT7P*Y>3Uo%BxYc(A4!FA%9t*vrFjg1tb zlZg(i9m&CKtiqOpAYIz~apT$YFd7a%*1%jh;VY5OTY&oUM|{I4)x6 zEZJJ?6u-!@*c@7=c)}<|lAMus89-^4&1KwC$gegx68kX%)IWPOQRq%D6H8^gqZ7{e2@9-9`io+^lp-F+t<=PEX*SSw*yeNRdKU!KD+G*OZ%s} zCZKHMX9P7*WP*8ra_&`W476ko*F!8LuDe47J|ig7pC~l!{L^_oturN+Z^e#+=%AZI z+gFFrG4)YafrSlXbFHYTBG(CdQ34281_}*=VdE{UB|m@D?huOufksS|ayNu#vuIB% z{5q;|GL{|2YZYqSe%XvKOuQCLpiSzUbuk;4n&hXy@H2iTaY2~qGAl&(m>Xw5Hh=uy zfbBC)Vi_b^0kFpuP>lx(1)gWSJK9$(O-`r;!11nH6%_(gb9m7D`+dK9Dy2TP*@Exv ztICgAl%v1AR?cBH3<3d-M{yCRNsbK_1&r4h;}UY$7bhH5l&f~oW7Ou&<*iwTRxobI zTPUb5!^vN`XOMhBdcJs|)2T*3fRb-xY4kw&M{eQD=_h-JrtqV?O+!@%G#Sv<$x72_ z+|G;-r@763qMk3i4YxQcZ2#C+g9EKZheZt22#q0-?H$H8HgzM7XKyy?O^hQ2gT^0E z|G{cof|KN}GPSI|bI1}RpQKo`xcV!1Iv<|yS4!5%vBY5%FYY`vH#3t6KbM$S1{|1w zN@^q&(}ej9E>k3WWJ(K2?YVK_A2ErGF_Vk~o5oA|@0vY$&P+JKd3J*auDIP4VS63~ zv;F$5UPWG#0CSGZ`y};f2;h51Q}6EIOwZr&UvDLhPhWjfihJrwFQdu@aVa&GMcI5ddF!4CrLY18PV^9mLD|J4f))-mT)e=_e&r zT!*;`-IJhGoV|5Nj)RXxHXn@2Z(gZ2H0#gnG^8nlj8!`uWEnq;_i)ut=ncvA3o_Ar zAM0^{Biy_5GF_ZXOQ@sF$KQ+#paV9ystDpei_0=KeTPf*+b+4!1 zbQj4b%WA00m=N2`h-!#BE|0i%7%RtEu5r;;Py-Sfcy2i?$C8!^u!|JkGG`C&M4!;} zD_Hc7&P>XkcJ|L~v0B>9?YD2+kZ;Un2hZ-CDW~$3ooy$L*3%vQtS`^3Eb((m70LuNEh|rgja+_%#>eNH)tN418NFH}`%l@eLfxg3g9jI2%k0Gs;T<(?Oo1!78>oP zVL0hA)sQw8zW1>24+%||)((GNKV3#HPmwatI+DZva!x!;|5k9XdN?U^pbDNsDg4NJ zWYyP=b3*p%DORB?|BuRz`B{$jAbAAKF2 z2vj`MXD;{CXH5N3KiSY3_&T_reHhh@_8%!J%_||A9pKI@OZncut4g1p+HKHT+g=vT zO;}p=N^_UTZhhlG-AVxRw1I$#UqYA6lmziUoGOX4;rO8b)0 zpUcUrKBb@q$Q$77TJBj;rHtc+`(XQ%bz##e7c~FNJnqYplxF>YB?@hA`=sj4r}s5t z(*n8MU|{B?f+F|6uMNm|h@*#}K_TIh zAy8-7WQSg$EGCCyAEGgAA<`6KwA%OwU*st{K_B)%^i$60i#EJ|s~>t~mCE64-6BO# zY0!PSRNVBT_j%P>dx-OWwiGaDVhQdQ0Yc6O;LK-inr7u`5cy3_jpdOkPp}vWodi{T z^!+?WF3*|aO}w9-aUHK2VHk0$n&v@iEqwLd#pJ~+*{DNue*~rBe4XDeuYdN7Y7ZC2q5|vgLo@0UKNJ6*PY6hi@U-`zCF}v2IE+EB;CxUy}uCfeD&2 z_tc&c;NAn%iY-dGNoyISv!3e(DZ9HEHT4JK>aObc*QS}0?*Nz;HfyGuGc71*)b$_$&`ru zut|!Qzg~#Z>_Ydl>wViEQFaAx#`=-~_}sojebsyMH|6jzteB4(bAH)%?>)x4T$@+t zeW2&d$Ab|*LyiraUydTzincsEu!)XopNa@P@WW;QwyKjFn@}*1I$w>*xw-z9^X*&Q zR>ZEy!fYf>%6Jawr1>NJ{kO;Sls6Id16Suhk61?0l6&LGL%(P54Vg3@b(P}vtTZ2= zVNpXKd8Wp;wAekOBAUOxp;p(*5ppuit3vIQVG@|LBTU01GluiNe1R`LgkJ2V$gcm4TK_Mxaf;dk|x zWbg0eURharbae>RTdislE!L?E_%#1b7l*HbU3g-L{${dPWGGD<#Y4|!ldx0pP{<24 z;k=*ReJLU=-fP8sdE(v|DRhD!q2GNQ!&fw(PXJxYB;D%%(Aw>|q$CY}+tw=$eu8L66% z_Sn76x%rO4hA(AyyVwm};#6juK!)0D?(GE9m;b|b@B)6E`D|3qnEV>sd%~@6fHP7_ zCsehJgF|0%{szMUuDkKZy%c;4idnMu9m{bVf-;=8ei20}QyLX;JQWx39~2k3IW+Pf%#x&q zQTt2}NQY4B+=?4Fq3DmhdA2d@K3NWCF}D61?iuSL&*xMckN;8)w~iG z&s~?V-luJHb12+r(AqcELI~b|#y#ULE;MYni*jtGQqm6E0i| zLzQW6^WOs#gaqVBAlv6qPzGm$7$7`3tvmHAS_s?ljniC%}iucjk2ljs9F z2GGnp3$+g3{FI{S`!zJ|hm8_)?t>1SA4|xUF%10h87$6uZ%yy6ohX#W_R1rQKU{x| zLDMjwA2v0LA4N@$e$){-n$YePd%Dn+IdkIADv##j-+uO-^{lx)0N*O?Aasw`3B@IT zgb{r1Xelh@MDAj4+~AstQUYBZMt=OPFQ)v8J@;;NtfN&;Keq>yyDmMxojsl3d$j(G zp}ZAjo!dN2P%yH)`N&QSvqk%GiJ7w{T*Bndc{jr~F=@(l@IWY5vj^LK(U-?Wq)Sow zV+wK!>)kIpITBQoZagLK-S5C(qDUD$n}|VG)L4ywsCiy8Wazv-Xg(o{3tH#?Tvv-^ zxs0KQ$MWv`zEpwj=2;(AkW81WU02m}YG-CGSV9J|vI3+N_U89X8$slTyxw5*Oy)gxiz%hhtFuj-@`ysx z3F#uXLMxi+Y$6vucMe!noc}iPTT@Olzu&8>B+(nsSE+=z;_fLlNbo>-X!+PujI~>H zD|{1k45Bjkh9+5DdwF99n%)PlCwGi5_hemr(<>gyW>nIdugPW5wi9V)H^hJW4(kNL z*s=`1lUQ&3qH*H!^eI$r90&+K6XR6F^4Di-WAEoxF9(=QM(2sn`ld-3!kEUz-&Vdq-Q!WL! zCr6RaU+lsVpv#Ks`-H^We_-oMo|w^jQ)*^$G~f5*4e@tQ(kex&_Z>^FH#?f+qeUtp zYt_BC&At31U;-q|=8FjZq&c7Vm~#srFEiHn*Ul)v3dXRy;-aDEAIbW-C&LpdM);Tf za*JSFVTpqI?XHQ5tjjkd=-zSR__hxM-7N5Z`d9z(OP>9$Jd4xf{)6%vN|hHZ!n_V^-l!G>dTl_kml!9LmL_W;$g=Su)KX*tPz#x+1S)sJ7txil*Cyk1qZ|| zOJ+B+FR;3Czq6Cq-2K(dG5|+L`^v*|ZZf+bv#PZI{De7zk56nTV_-BvGGyu{*AkE5 znL4$1ja$aHtp2C_!B_du5ku}ODISf#o~85NFeO+PPj|+3=fKgv;Yz1c}&7N*v&Rx|L2yw{47IFovH0rmXyPel@{ZZol}}^K{Z&!qqiE z()W$|n>VedcMYt6QO>HCHUvDY{D3>RdC;2j)=IBm2%2h0RuqWbymRoz8x6kLc+sr7 z5m5`Mk!(Jr@%W_zrvS)rLEc1Q!iq`~eL?4Nzth^E1F#^$P@Ov<6es}yQ$05eDN2JN zS4KcC!{M)05I!H0`E8QjBmIzqId;l8cUlf8Jy5#4DiV;S z`WM%|@9=H`0A`jKl_GlnqcIsuK&lVD<6q%y+JD=;YVAMkz8qHK?tbCg6U%xt?kW`? zRt0E%hVDXG&;$}5bPeByb@za@k4hl(N!iZWeXoSFOB`s8ZpW%AvwptwM{eK2Yf}^C z|HBUk5}M-JECu$46u>7LjI8Z#DZJsrTQ5ZbkK~-2Q?>ea7alOyC4qMuCb3siAOFqR ze|WPHt-x6UsB(txj8dHpK1~&y9cs>iz9RKtdKR!qCc;aN1MJ#d7QGvUT(UtaNm}|2 z0YFUs#2r6U1dzgi$jx4bacyw* z9P|(+e{}F}>E?28Z&Nkv{UlJZ+W{hDl4m{8B>@D#r3i)E&aD&xc}M)6C<)nc-VTOW z*c?z~XrX1^-T6lQ&Vfuf-bSEBz7xcfUJgj1Dy39j+P>iB2Cnpn)T0#%^65;3D(k

@pVhO&kfAy z=RP=&`UEKb{xE*jM&?i7%3%pi`u{et53rd@61j}O0XFlI_Yoi)0IjSd2jcDwr$?)7 zS42H>sRjY@VSRk#^`W&407jwKaaG>u&dVqVzTkTZgTQK-EK{PM-WvUZ(@_#j z1t5YI?{30j{dzL?-v`BahX@N2*gYRlsY*rjI-lKKQ?0ZE2zWp;kldY@ z1dHDCU)+vbr3c|cYgEf+Pe;dqVg-;=s40Cn5E%g80ikhondV##VQoMGI*gq_iL1;5 z#9x5qK7nxE(GBjSp{2cxFs}qMtETS|ztQGa=A{OWW74kZF&nE8LKrX`$^-7=$|$hO zt^dW;m}bESGRHVB^}Yhkih2B4pg`|FhwB|+CWEfw`;zz2=cEWa8ObQMUD?ZNbtcyV zC^u+mlkOy(#WKKLlJQ7( z>kp7WP65;OBoGR%%1I&+?oY=<&ZRj-x0xc z9%v4&6G>>xh3X`w2e$7H*4^|2=?Zz_|Myqcc^7ehad9>9Bxud}10b5Fd$zoRpg-%y z-vLOWi5vw=^k=cB`?Oyr&RdAK0c~9+FwZCBv>+CDNZz6pY@n2*l3{xX8V2f7l?HPq z8ugZ=Y>h|#BD3Q_#+9p85P=Xd{QFpU;t!%n+U5T$UtllrmyUVb>MKC;cu}!UW51Gu>=IJ}k0@{8?w@GE;b^`2O27>@ zdIvD}DU8sv7QZ=Pz8RSZ^6i!}kADC?=_<3ZySF8$5uk8#1yU%P9ZJIQ!YN($=9(iD zAilx?f9&ntm@EJw1;T00n!moZ)~z%Nx_c&h&)K1_x0{ao*<)qyM5E#!cj*dQoua(| z;;mtg`zRI2`M9C|Qa9&Ogz7okshj6?@B6k01UTBXk6aIcctX$4> zvnpfYuc)b7vc3ii?kQ5p15EsXHGsCW-$Q~*05Creq-zR_0Lgd70OkDyCZQbOojGvigkZEv_>1gb1N))^=W!k5gnMWuPCp3FlA|{Wt+AZG_v=MyAg()>Y+QW8UfLOuVYZH(U4ma5YPs=1bCIGUB8zgH4n42%dc$EY2LRX&2~97uw%0KI%a0IqrHNZ zxXLJdUq9?F(SRF+23&UaoaR1761Cv*vCbt70`!G+R;W%r+M>-F8>~`h7|Wm_P@?c`6BjCg!ooiFq0G&WLj>Q*`mwlY~9^wp(#;vb`>8l zzn8aPy(A?Yb*lq&0`~7=7t8v$u^p`Ig8=C>ARI>=t#OckdJ}2PNFfjp*Mw#e@%OOF zuxoOT306Z6dFVneNrkCG3Y}gh`zyo^f%H}ilnWDH=cS%=#BS1QHHUp)Ev>HT3BhU? zOf%-;O1q$%loPkeAB90!>=4$9zc{Z)M_FIa2kti)WEQ-p5E60q#esK$7!*texTz_F zTAMbXc;iD3f8ArCO85v}NH&Z)1TxTTo5L%q_crQ6hvmX6@r*$*<-+^Lk?5hv6>>s8 zeM5{Cb!D~ujl>RX+zeq#TXu!0Ppwb(GL-sGG&2RwkQN`9h8Wm$?oEa%^$b&e82zww zB`#6u(pM6xU`JUz0mm z%Xn^wdD7kO!ld?0jNi&?oH@!g0totJ4?PJlWAnT+%Clr7N*R7!n}>X3{gZ)~dbuYG z`F)dr=sjPs#TFBlPGp9;+<*)ucv&48eZxUFONj3`Q@{QF)l$q_?tC$H;Q5eviB6U1 zk%8mKj1!u!IKnIAo3-yf$xSE^Yj(}SPOo}Z;l_ejeK9NMVJS7Aw6-a}oy&!)J+wWB zdYP6UU>GHSmb`tN%qLimv=~Zl7hNz8*dkV|Q6!<#c-P%eKsz^oR%2CFLpmC>H?h3K zt``KB&;q&URXm*IJdA6YxGeQz28ZExDeNdn_Mdsfbqe|r8zXr&VyWK!5f4*&g= zyWIkkz<1Ak>bej8v{xRdz|JB4;!A{i;Q-gCZLjFzmxkj-A;T1g08NW+`jfo`Z*0y9 zT9fj^Q&)w=lf#l3>ZZ=GpcUY3k*X%j|GDqi)%0_FcGGt;_w1rti^gB6E6Ni9wV^c| zMv1i81p8-Wi>)jd<(Gup7rmFTlR|H`BWl9=gKLB6Oy7ke>=jgX3lsc zvLakmwc76`I)-!nk)-9r#Z2K&JBe8Fg;gT`w6iKhPoH7F(1Qfnj$jgvDNSY?!WSgt6w#xtr^#>Pq*6O)p_v})r`3~~vLFdpJGv}G^ILLi*LY;Q zpncc=sI2|4WYsGYmkUJ@9rw;;jOw;>*ZqZu?t$E-SKF8{y+QX$PP{}(3Ag%px2g9qu5xmAP-+5m0DTNyclejM$Uk5b*f$qr^H;$J<3lnXlm1yal zj2de-!yd&4+mvr+29igHsGNV@sphg$SbO~)MlFA2=Q?&Vd`a%W;-IGzA!|M<0 zM1OMF!4q1+b@1q?nC+!?6jXn>Cy7;v4gH$AA3CVARv^8*@D z+6uMNkU9v~g*c%5Wf7%BppKc1@Gdt*+IVfgkQ$NWfAp+y{c0Ytlq!s@eM)qiMJo>V zT)Ai%_-ZpjG&t}{`Kp@whNu5y2JbaZlaO0VHqY#BK@?r5o>64dHa3epTJ>DKP3+kP z&(+8t8>THHg0_OSrpAilWFS2&&c<#yb>B>HD*6w%!bxuJ3PtR;wuD=!$C5Ye)ZX)>wELRzQDiY zUt~q#ES({UR`MrHRvou1o0hox+6dyq*_ zFc$E6ZUL^XT0?U^hTs7KR#}XKGa!Ga_4yzqLb?|Zx;>J(J@VGU(EsMh7igrfT~yN#FM@MRr81kFF+Z^-TSxZIf?XG;qJheZB?q4s@mFw?1CO zmlg`7_o$z}{1t{{kl%KeEu2QF!CFm5`SHG+p}9U^b;Iu{TAf+M=;T7_wZBaB?0JSn zIo5R}42h>9B=9@v)5gOdT<0^VDT+P~HaqK&Ug%W8z0o`r#UE_l_6SjUobCSUak~qG zI-vj6kbd^j;^jh%2y3ms1+}pI(DUv_W+!dYaIU6%kz|bRMzaPZElSz12AGn*A4F5h zo(~e1oI67{stWg>E%++2STr4a=(wT>jMB2De`%MqZmQ{^;MXoK+3dO8&I`V{Q^RU| zhePTT8Y&w6RTAV+>D3G>sfG_S4*DG;-=JQqr>@u{2Bb$vcaMkhjZK*6)ezcnc2D9& z<4E_InRKzn=}1P5!CztXC+41 z=sHUN^FTUol>ajAa(fQ<_Bo2pOD)(zY%+j;^Sxr_w2~s6nYdh9oBWNc_|?q2LX+*m z4#cKGww2Yh_;F9<{d)>&gos+--bZcH{uu}{dLL8_O zV(;U+N#=XQq{^DoXL+-c^NE%+M536#27kl!2vT&bxlZQXp)X&_e@IA4I9I-<6}11L zYJpz4t2CY7UVd*rSYr@4q81|dkP|7sczLXKm>pOlhDo3DJMiTt58+x$0j1|%({E%Be_SmzfmrH&->Qb( zD}D)4H=AUZ2(fvmjIh9Qa+vHF@hLR%=Dypf`?w$0>AE%Pe4k&Ds(g%m3u1Y;a#@}A z06|8MW{yz$ZrR6EQm!iQm6I=s`VvE>#_%$pD19RC-s&2)Kw)#bxFARf6BJ#6cxBxSEg$Gsi3OSbeS+LSeSu$-jO1I|2|NmPG&x@+2$Fnfo<&98V&QUz^e$n|7>W;?_)>-Tyh zZy*bZ1~;SOanCs+`Bm;4me8o@gHdBG`;se1lC;lL@r-{Ss-^Qh!<%aY88g@<_JoV= z%4Wx9-&|j!*UYN=lD!kQVJewESW+q2#grt~)|eQNG@YCQ+Vdxw5o~|Tz+08k_)}># zv5RV~&vMV%rSn@=R$lm!bR{lT>;1`(~kG&}_p-p~jh3z_dXikntYcu5}G1NE7XL(8Ed0sI& z8Rof2C}g5D)bfLX(az2*O1l&{*7@+@zGwH}sH0kLz!raWt{rt5uhDPv91c#P;};+l z+5S>o-o{dvi=Hm46Fax(A8YyQVZHJ~^x{c2wwJ8;^tiULjQNnls!83Y0yXyGm1vUb zQWm%9jPtR_>+fAE+y#3#D;S+j<#!NGuRlCZ$iuVgJ;MokQk7r$pe8@DnM)T7HFx!9(`xv1ZiZrq^lA9mJ5 zwyQG@29@Vs6Z(WT=YB-;+R@6!bCS69EfzW#ZKcNBL3w3Im=JMo#kQ=7lRq{KQ3DS9 z&v{6F#ChG}nH(QK4U%{^+g5yuEijfh`%3CWizVzLZW7s5pbf5N7*TFiGrijN^zg|O zqqC}cyz@uM$EGZ;OJOV4I<8-7-_->M+cqS#k-T!+!+HDgWZVjwdcyDUgXfxMZPA7P zVxjiCGTwSufEQ;Mo~S`=hWqK<`kR_rZqJn{nM!$vMe~Cge};E9GH7pNdIo_xDIyLD ze(xD;0#9sTo5#LSI3V7yX5&K%_5L?X9~XvpX&9GV!Y|9Jz9S2a$si=*KVc<-k3+BG}P5&osEGqpC&;1s4V6&sa^N9 zu_-wi*9oc!=PG+TxK{0L&b;QfhWPjnnm6F4xiy>@p`n!k`N)If8gtW}O84HIZLAv| z8Hu&l9dj<;5oQMha(fZZn;(b7#tw@&Mc7ZaCx`Fq&O>6Qi}ms7V!(Pvga(|%a%agY zDS#trl(|<}$_y~chM_)=3=J6-X_l~QjIbVlcA7#yb#a~FL?2@us~uN+9HpndZcevF zj%bhcg?^&QF4Lm4$IFqdGNDJIXK7LO-_XTKm)uiJJLN4!_&2ccFPX460WWI%g{r(q zWNn$fJ3&X(v|^TDDdCoe=;+svKq zU)5%PP<`zDg7#xFlV^#3Z_YJKCqDeTWq_g9p`=mHQ+>k)wCb0&2VJltvE5KwFR}Jh ziF2|4+4FFg%nLIrV{-d2g=;yk$>gY&l_leopBvq1A^oEKO|&vR>f1-^)3s zgax7{%hB^e;C7AZfeH@hx!)uYSrykuu<*id(5QP@D98mNgns~`B4ZY2n9}UYU2wnz(&>(1j8<<}9g(4Ye z0RgELm*&Qshqk^r=W2vz3#+@0AE=Hb=>J9;;b1m?if-o0yM=}QVd>`VAeW$&@Jf}c zS;AUPvb&yyUsORSCMu*vQ9GUUX^ckf*5qKYV{(>mA@q%xOIraXYn)IKIP^Lk6b zrkc&=kb+u%T1kA1O0RNcyM{XA=~NUqzp+k#wvvuYZ$a^^R;IX;v# zVWdBw0UwWzAedP59^;w6q~f>Ezl)XTcUXe#nNsB3>@3}uPgc!WmKs#U@U^i83%-UO zu<{X2P^NSW+2Ba*=$nC`a3P{{8f3f!`EyV&em2i2QKol3d?F3glw@fd0mqV18p*$o zDjm9lmT@HtdYbRzU(TI@?|OD7aZ_Fpw^^6d4JMz;n`_rs8}^e8iYpiAsmD(j?=zrD zt(V}^i=H?QgA>@ktW=AnwZlZ^B$qTt715R1y~8m2tvs%Vr&(WijA^W_{&BEHu_1P(ZDP)YjRSex zuKsFVlg)JfM!j2Dxmlww6#;|8$tr|0jCGzW^n){xDEn)xZWpaZFe@r7gC*erE+=o+ zYk1Fke_^r2DAg6!!FgU=kr}>4UZ2)(Y7Ph}x?nEZf__Pk2oOwI|($%(4hEEc7 zU?C>Pzryx}FXcget1p#b{yN;q|JF}9ypF$T5*fG) z;7+E?KQV0|GF*X2tltAXnyO*cxk{}yrcoCRe?Q(xbUqc}!h()udl>7rzcFeRS$e`U zHI#E?eGn~Rz4utgiX%1XPeR+Id)oB7;pZZ+*)SdYiAc3nFWGMn>H8;7eg|@qv*|ak zC+0L@!H>&{x-LZ8m7IDX8sweSG2C>XabwwtCxD^0K5knH)-w~=O%H^K1C1uTK}&c) zn=$Ot1!B5=YD?`%qojSwF6BcZ7Kt!)0EVlxtrzpLm_jxUrbFijb;2Q0LAx$%x=EkB3opt&*OiYllQCaodX7N;#&9EjI*ew&=cLPsGbHHu-L?_bj-M!fBvIgT!Z_j zHlL$#l(Phd-&g;IN8jzj1&44m6^;MKIEL+r?@}=sce-j zp;18;4iNsW`2}da9tT)0dVPx7wAr^RQK5%tm+Iv`IU;}?T&<`PO^1MQ23O-R1ef-W zS1+-|ZG9yilE)O=pf&nGY{=5H7nc*ej$Vg)NlM}asDRySf!L|=%AbXxjAOSseqkUnn)n|PjM!e2t}9(pcil#B{1Utv zVBJcKMNlHi!1CbYnA-5xy`NcpF$c%KG6JvH87s=xwOso+K);sXUK6CPTOm3+^e(@f zP^Va6=q--{T~lXV&cZSlE~kmkFYXqes9b~`rOb;XTg3MwGM|8cvZ#puHYwe+@txqJ z8$Bad*!Em=!u7HbD*FeXUVbn34`s@5L`Et{wGRFYnJ1}#e{90gD;oZSxrIzb`EUX( zs=WG-2Ay} zy(ts#aI$+Ox|7oY0c%uaz;^1g!?zs7p+GLk!_leyi*Sz^udn4XMpM}HF)9{Z-!h2t zc&Etc2V<6kg;%mVwG=+Jl1VM0Prefql-r!b%H>Kr!hu3%?WR zVNSy*DMjMI6+fI1w;{eBnfJf-`Sd|IJl|&E>!`?4&NR%~e8pVzMPl324!oryo5< zbyNOjhKeuPwy~{#WwtRr?r%=k^x$SJpj+|*pX)FQJd|+zdmq%q;_uKtM%3T3&G=P0 z*|S~mZRqVf^J%99ve12amKbX`$BHNnYf3hjn=`c04P8RZT$H+pk!WV!7U-d{E#x+FD1n6FV+X@;NH0A#wF!#or)BiO_W-XBc2Xd$J7Z`6nYrm8zh{0 ziq5)eStGV-SE_l~{@j!k3hR<0YV%rf-%5358jH*@O0KZ)r0dQcIUTL=ihB4J>W`Y2L4TP)(Ceqn;{LWr(>+>lYb}=>$@YJ zVZvp8qI)dSa<7O$OEgzfTeIfMkwot!jdPd1iEf4lrY{9=Ccx9;Wa0Ku(lNv23$RlG zAWvU4zlf#~KO6F@Q#BT|u+Fogis5>~kdNz{uE~Ey=Ra`&VKCJ6JlrQp|JyP9^keF3 zi8jR7iU41su!Dtx1RT;F!Ha7ql$?%fgpA6~Pk_PcFc;5D?T@O~Vtf%NBf>4iEJ8i- z>wB%D%{ChAAamY0ffv3azO2$hnMT};w<3~wIxy~8DuXlQ|J=5GU|mUL z@jVmtLf%#4az?C2=_4^h$a`ylU^0(Tq#ZB2@{M?c0vJ~85JNadEUUO9kF)J3(GEF` z;BRNipj9t>vt+kg^kg58F3K;wy7qyU5tcXd^@oP#q~3?d5r8$(q8YQK5V2Lf@wQb# z&xekC)6V8F%4hEe_Sl9~4AjXwmK~^V?`aa)sS!mrQJy4hAu4bD)i{2_jMc__lXS!`aM%OmkJ0x~wVpXVX^x=K}z`~07TgZl=@S#@Sgb>u}Exw<+R zE50&QK9`QQH^w_}F5hjGl@-Y$&U<#(mz>6!YpMu9=Hb=&^+wiAobG!SnF_uNXN z-QE*-3$k4^H_~a948?2HOCA<D-lxg>X?04BnI$ePj%1klfYRbSy zQSnWwg3J^R{;T*y)p>X-L3 zeYQPOZkscE=mS>KVU95F+_o`KcL*9VkP4u;dX&Jj-I9!cfBZ_zhbmi0C*jJ2n?tX6 z;l7jT^6Tpuu2*4FFOBJA@?}6wtePzWTw%2`4Di<~!#>osR9ch&Ffv#RIzs)u?DKq{ z>osoDjV~HE{b1m?w7D5Z52$P@fMmiaX8SRL3SP5c=!tEXxC)rw(PaxIi^r`ABrO}i zu@u->en;yNmhrvz`3>y#>^eI+F;Ulx@CB8`n1t8a8LtU3?(B-+x!lF_o!{jhWyx+n zRmm=^-=cHu9a?BRvQcHte_y42pETE$9)_83rA}u8`A_5{MDnm0M3Q{5>9YZ5B zGz<+QA}S@_prmwnNq6_qIdn6?Fu>h>_ndXst?ztyE!NUCpfmhq|M!0P?|q(HJ#SQb zEw1+>}#@n{=P&g)T_BMZ*$KsWm8Bu3s4!y>k4nW?wcxRI5bk`#I{1xaD6&r&$BKyZ)7k)<;4gn_o_dR_on{qbVR1pQL3?g?at5N`!`XLrn6#uA5Ucell{AA?%C&kiBp0Zr!jYru_ zK&CtjggBN!Lh}*!5`+YM#^wWI78gnHY_sPQ*?dF!-wVHaBKNF7 zKK*EE1|YpQRx@)g4nD~1s5|#dvyL636D)z8nlBzF1e`wf;Q_;yAVyy$s_+1OrnC5^ zuwU~nfrqSDF35fLHy9NjiUL?C_H@Dm1FS%m+qe2JIF`V`;sk^|C+i7kD+&9WamU1d z?tgA%4im#6F6;R*LxLMc1M9mT+@&B*UY}F7D>F?!>Bn}F{GMSF7lXC@Qx&=aV$+9ivYHtdd!10oE;@$>A3K?G!w^EtRd-_6Quo@fgb* zQ{ceH%D$951%t-&MF4yBa&Mx{fB$%YFkY8v9WHj;q6nzn_r&8~zZ z+4GBxyf)Y&$kTRAeEfGu=zo3>uw_01lXPiHBe_d205p~sec!V$(h*=r9043gZAqNN z)EMXx=~O`=`sr;ud61y1U<{aIH6ES-+m*RNvmaZm2lY4iQ*8OD)83LB^_;|ozU*Hv z;Ct6)|H;wty+mt@3rj?yG)@3CVLanKkk;<+4P~m9wtLiu1Prq?A0F181Mh_otO#WB zQB72Egmxv8GjE613#jt=a1;sf<91a9&`{}IkQK)+^xzkwcQ6tSI#R6oh_4(HR@$#& z^u7{DUF5{C|CJN}c!%SkCcJbB-@PkYJq)oxSU~K7L6&MDy zR0RO*^zBgn4rr}E+%Ga6xaFiNv@@(}S>8&F1td#zDbRxRFOsFj>GnS)S%PgFFs%6O zeD52#sLam7f#*y!C70H6jF)zWU4Fo@gg9vaIGw?Rtltd zd{@}`!H{=rkv`i2_|{Mo#3F{m6i2699@7cB95>BFMs0gUM0^Cz`L1kLZi#Zs3Y%w~ zy-XvZe-M6G^T3sP%f{Ka%vlA@jT#l~rr8${vg8 z(wYO#anO`w4is;PX;{amCGhy#jIl+>+6JIm8R^qYL2GQ~PBX1`Be0;Y1KP68oCZC2 z+02!-sp?A5Vgs0rJ@L+~Y@n1~V*NX9OxU70BBj9aU%X2_?xvX zKmrXwZ}Y(zSkbdAx>dFJ)|w6s4>P$RL7&wbg&1+zKe+tkAfAB!I_7b88(b{KD+6ic z;4!If1<;j+J)+~lC;#)gj*M%sb8ZbbBOf0Ruv2BFJB?fRvAy5F->TfMC)h}hvDj4& zPMv-LLgfWLu1ilXs8#~VYP0$6R|lUTL`UDHefIvx26$@K>^K6I^cehp?LB@n@X>np zF2=EjUN?RUGrpWsJV=H5bmHU8_eqJ;PRhr!dYTUhq*9ufWq6=2k}AKXhzkkVrZeS8 z3mmhbJ-N4#Y!@ElRzK4F)21z(gxGa7c-2M@&Doy2a{mnL$JfRPiQ7)KE7Z}{*3>k7 zr_UugY?)y@9m0hWCxYsd*RZ(cWk>dg?7qD#M5~lAXxh8`nS7EMwo*Gnon+}@$fRLnlhsJ;2pYBAYW;SeUegLrddr+k|w zHuyAFsmEL;?p>)ge*3-kM&rlwf~~fNlXZUF$4f`QbNGxlU4k1(T^`Cx?S^y1|NPR9 z#;$v`vD~JlZMRP*RC3WXcm%pP+194yt*ci=#_NQN%`;;3zwBKJ-J+7MJbGihUNkKt51dP^zQo|_9#av%6vGlKBmtxl!VABZccTM zdz6$@=k9XYRd1bQ^`kF%SU;w5V103W$oxZSmVdXZW~J7XRig$;G{RWdHsj6h^nm>z zBZFEI=m;2KOwkuq1}Yoe?JoIsCH0YQ6@E}v*EY>Gxyri(>$giJR54FfH4X@TcydGD z@svCeuI4s;Oo1YIt9Fjb9_jV}rhjPdecUwvhQ{w{FV?=DJlS?SF3PBAZ>%>@g?eP% z?CECl0WBqg65-(eyc9jtTuH(yTC=C?Yilt^N+DL+7-Zxg(fsNyGcpD5P$>JK^53&k zqo!BCVtyksb}{$1stYJJi$9dKyvn!=+euaseWKH5uDI<~2~~C$zLzBZCx%e ztZC=kHkxltKCH0&+_7Xg1 z8C@LCIy(>V*XGsDOJg3p->+074%>-xq(72@a#xBO-q8y+EE8_iqw6nD8!wkOVE#$D z_UJVe_X^9DI^P4CjXHryQZ$MAq3tGW$VeEXaa6g3*U&&y|=j$CtAzsM{N=# zCy-v-fF5n$>7fqy=I02O*Lf5kc}>T=C5_LP1YXHLa@*qznXMXZYcu*PU}8@*=>2`Z zvBhyH6R+c$!dKR&zO|?DJf6yP{}J}Xo&FAwJl-`mJcDSPi;-+taHe-wf8 z7A}n--klARL;T`ecqzz@@fN+rvb-z!m~!m7&Y^2{#6oX(BayvUT87nYIz95Ts;7q( zLLasnU$M*PRzZhWSBu_|G7H2HaHDL6*2Sqj5@gJgny zbPS&#iJ>-vwA)PD@3rS$t(x_GORGqAS@*hA)}uIFs(e&ttAcP@q}{!dfpR4-g+)5j zDBpv<_-J(Ge5+QORf#{1kR0oxDMpAJMeb2HmT%8BwAMV4B`U4y43qSD8|VhZ7*{nvp z1|cnu=Pc7V$DG@dt8rMXvqm=@QnML4vlK2^jAs^PtXY90jKQvVVY*{STsikT2V>k~ zrC6-5q&Tut<|Vk#Q!gOP6Ygr@On!x`iqlp~M8S*r+?bonN^4y`sXO|y@q7B(MY0Js z8WLIUkBvG_KMc2>^i~}g7Obi5Fg8f*lEEXrApzO1BNguLvrIOs6~Kxw+h;WP2rSI| z>vprSaA~)6*+U9~6?DU`>ewtb z!E*>9A{vTxW%fC_KO?4ocO)-t^f{}msL7+;bOFoXHUaD&fMkU^@hLo^8oka;C-9t0 z^~_0wb@WCq5yMFOAyUeWgcQ90}n z%{~Mt>Fcilw)48QE5hl=b8t{`MN$1_QjTpT-3xyi)erY(qQg$EcBodZ%o8}1DAnC# z6j&JwS~h=AV(_v$P(5>`lj3|8fpdqTN3yiRGTpk+UTM9*dqw98{|WDRtylMZTw^NFN?6)Eu4lBdpf0%Pnl&G^ z=*AOf;A@xSE~)JpqJ@PWE{x{Qe=E0Xbc?xwl~33%+ESK3Wgo+%Dc(25q~=0=7#4ZJ)F$sI6>U!Xj(}?FrXnx@D?1 zGbXkgt@cu@Ei*0GBG&;C9&GLlh1q$nQRkQlvV#puRD$cnMMy1VA5iim9_q_pPJ4%cxjwOp#zW^8kG;7OL{4plTonOmp zr0!9J2gHLG$G`r`X?-)CF}p zHo$7C;v`P-JC-;8G5-0pP#hxmto)eRA>7Yj;cfA8!+S{D3k zS$_1R0{HKyh`>jNpFU{?v{oDL_*$jsar zR8rtvt0z|w*7K#}=DNuAxy};6AFkDdiklHwV?DfhDHe$`RZ&;Rx;zAS^}=#nw8a`% zc=5Sy!b$8!LXYEoAmPlg(75Z7`Y_Fti$-(}5WADD*af;36u59@!|lJwE%Ae_-#)0P z-SvnIyJ#_|eXJ`ceK_SfPv`=c~6$3d3lO+N)z(5UKoo&hR`tcJhVBOO>@PVvIe{{xH0xT0S4$1aWC1F0~LtPC0SqugQZr*AJCX%y1f zyBzXp7HYtt=`Q?*?+W6!>+;NY)xyK3L`OHB+#D(Wdl!iwo2cOK?CIs6w z^5CWN91~%AZpOfa@jT*_Hrv}fcnpv4z?=pf6c8_8?XPn$v>hXY8yn;y;^@|g67?(K>qGR@ z#of4f;a2mwzLwm44D@Dh?WT$lqQ5OC^z1ipy1_U3*TEx|xnmW@Q6jCWerLU^?m0ap zx&8(DlBdzo)DK~g_olzbA`j>CR+Tpn0{i*ZRNkB~5q zZ-y*vN1%qr#g28aSZ{jte-m95-JZ$a0K(By_tQZ~=4H@nBSc%WCyIKtinfka>%Gc6 zjk|U%lU!hkXVeC5R?TpZ?ci>{2O(eJcB?7lGF@Or@H-^fOuEO)QQC~AS|n^`{Ui0s7lf;sej(+6_-!(h!N5 zP+KT$U#2aBZ3f+lDRNLxD?2!2$LYS>P&l_K|6tJX$GD$cv#OL1G4#JLiqf)~^>ALb zG(Vgq?j>yO2Nr1I-LK|q10%>$Ybwobp6~e`JSvleOEU?m&rh~7PAVn)p`#AyC7!I3 zhf)#_PiB9Y!v%wHyGn6==8knaA9iYQ>1h^5l2KmQGQ=ASsn$`YX}vNKkqVe`!8;W} z@0`81i9L?II2}uykW(w<-j0dd3yCd{cHhb+UX2kRen$jd-rm7yI=V`$cLj2kr51H? z(wEe=)Y-lIHqE#BR`avwpaCxX~dsL&5MkOapyu8DQQ z%?`BL5wiOO3GfUjYfm@yC$q^fT7DhUHOE@)a^KTcPSY!!Np3o|qF>S5)jT_;@lW?! zUkLFrmNOSU$Dv{4^MT!kicE)H*x)&DXOdH7(lF)xFo!IR)j7(E}!6dTyyo+J|VGHWKJ=b+tZ8m%+i%9EYs zdr*7Uycayw@EYdEufg}%oGex3X$J;1uRFpPq%IfoN0NTmu%tVPel#3)*E8l>^XWSF z+`QU_=$&5=xiRl>T95A7h`xQyFdIY0`hE|5!CmC6(bBw`HgF6Uzh@9=Fibup1$n7j z|5#6kBL&L3$;KVf>>zA)^I zT^joBp9XFH4(o9Off2y3-Qf%1;EZ?7Wc#=T+8NwvRwxzw&pr9wgVC~cWSxB^hX`4i%=>-kHO{0%; zCe_$r8l(UMuXf4k76V7ovnDJ>*W=+~f&EjUk z>)v!Z>65mqKDzO3$Z#E@In;nEH2;Yp9sP(7r2UJnCb`mo|KARks z;;l=|9+R%QZqB>vQwhH%T>H*@^YyB8Hj3yZ`9|Ikz>f(HB^Yx5!t_ z?)|x18a8>)(DvdN%kv@THllYYSclja zeDUV0#OBhtDui#;i7mEXGGnEv&^ijm9Mt4}6wdj)F_$uC-+*Tjm$Aq^Q$W(W5C0eUB;2#51vXTt^XciB7f0ZVumZ>H)>QvK z2`3GB*;a51brkB}fy1G?{d)(j&z+XbG zlisJZxUj$}iL_p&_{v(~ic+*C-&xKy0K!@ZYH$c!1A{8cUZe_)zw@1*!<+)8n~ z(#?ukZ@9sN*e}p^oNI%ZDvzvINvhsD+2R{xbzLo3@ge0P!quy^%)Jz9nyJ?h^ksu< zJsfbO;3jA=gg6B-p50Rk3iRjTa-01nhfofW|JdvOlQK7pdOLv-FWp+`N81$Go`Zxlb#|n-%`%NJ)-VAHf z@=iQ3A#L-b~Y)kZ`RWwOv(;zwj8 zA2&Nhun{qv$Pws>e*Ve1D7WQ%fbI*}_R%G#wnhtG2`b`iGmx(4CUr2w+Kz<53PWmo zHTgEmfBO9BfG48k6M}<{0#7zvl3jB!XH7RQnZJ1tYrFf~rJFt68L2_Yu-$BnH|2R4zD8*b~On^t3!EmVs&kr9&(L-F`%h5~=6 z9XvQ!YdcfHO7A1XdLqPjwyjygtGzt`%In7K1nz;%^!Xt%lSM*E-$jvNj*F=k3)dgc zCgIK^&+qh1Y64PtJk9(Pv$j33#1|*e^m-(`=V!9Gm$F9v+zlW zMKsSO^|+4P;=7fhoURgkn+z4KRblkOG#RlCSv*5WKXFMb7lx-zrY21k+n(98FdPP3 z=Q#^0ng7{$mydF_EkkICp{pWFaI6A(T>gkN%zW}xOJ_l<5DcWMB`rs7(7o&t#Cl{K z)X-`P^6}XJs^@3_3EfwsLeN#((HpS`9~>-R*zS>PL#?Lc3tSIG?qis({(b zrClzFh)Frp2oTNJMCRAL6a1=xinit`Rzx`-o^dh)^5d&n-&=sa;6@iL5+8nhG`L## zg-9-w9GW|FrRLf{mcZ6OC_rW%#MyNs*O636*W0+ucxi&Z|w{Ny_h#u;W^ z7sV3HlSyq!sQvt8N5rsCWoOY(hn|PoH1#wRV_IblQcDYWXAa9%`EBIZmi15VYraw% z2tE7I=r|5Hb4J~Ioxt=;H;Krp;G>9Wa)~5|t%{M6>Oo;mfvKm>hi9)b%5=PDlYPHO zvyq4$Gwgmuqf$CyTiX?kGFT$~p8ds_3^ zZN=~}#Iy!@n=p0SZ&3+;>~Fp&4SvZIg0?F_*>2#kJv%2^E6P5!KIj-sWuqi>7v*MS z2qETzV-$&X@)W9$f^qsBx>^g)H*Pc&qv-!N6LKvgaP#7Y6LZQ9XSrNeZSQ|AfjmI6 z>il7d4e~cH;;yJ7d_YdCF452Jru|5}adyICde7tQuuCY<`QZE5*Pn0K6uop?6`S!? zSWxU1_`Km~zAQoMcJ=lx@!!b?gvfSozmqv1ycl%V(@9D$Ck>iK(-wM3Y&1jGq{q-< z%vJfME>2Or4joh=#`siTm1J({m!^8cJ4l1jW_B+J3$nteRG`l~H2;V;XfY)GDXe(UWkrce8huw@ZUoxq`@! znBfT=e!~>Dghz;KYq8v3s^HBIbM3mc+=izwEljebCg;tg73EI<{Ny3wjaDPvFIc~^ z-?Vqp>kx+B*mpJJ2E;rsMD+dK>v*plkn+sA$wWSHOzAOetljUk{88@QCF62XY)YdP z)pK@w1B8@WOb$s6Y56Ov`}032BmG}`{3Pbm9`5}ffnxBenp?`4-r~bJ$ejjFFQNU7E%oEx(tlA1(g|AUExMO zY~r_mdvDQ;w*n-+Ww{Q>U~Vi!QmnMYphlt97C5$LIP$Vb)WH`WaRNe4f$|fYhwRKI z5kb+kONOJ?x!=yb8RmKnq)kyokUspr^FM?-j;^>64#$}$s^-N(sWw*P>7UO6=N|JP zVV|2GYVT4@l@IUu+)ZxC4{~i*Moprn+IDyY_Z7LbMHrlqB*#rz{Y?OOv_i&h+lU(a z8#!h~bGp65gP%a!ftot^7mu(O@OGibWT^(PA17bP#FX}KUnyJVfX8?^!- z9!_mPel`6W0!qSTd{aO1YD%Zw$1nJ;Kn?ObL&$ZZOHux%xaO|_l(Lr+T>hhQJ}S@> zVZq3$RhFkz8)rzMce6xnMnYUn!r>p5Xp3I{AE?{GlF^>A9~a?-gOpxUlpCvhrlJas!MdL*uQ^ zYpkFglsZ;>I$lcyBmT2xS-_^2-NJk9KbC-7U_D#VE1!PAdGkGM9l00ag6eoCi3jfQ zjyC~SHm~~^um72b98uE!{sNS#U6U{B(^9t_9$xT#|5Jeezy5Ng3?yafco#sq{OSJn z?EeTu=8iP~Z(+!F`+VV`NSzo!RD5{OIh*UYVTN4GE~SLtbYgxK<5fj=P&s{S@k^j) z$KUb}l*8k=1CBK|{Qt+2g7H@=Kj-;Fc~uvQmdEG8*mBTXnWpc|Tl4Ls@xIxFei%k13bQTo%}?x3i+2no!1nKy>Uy#Llnbv&QOj z*WwDQkC$SgKp}U|(E6h24qoCk;I$Szwcoeu1AT9Cly%P2Rmn4~1VO-+CeTBD#p= zgCJwvpyt_{=F=0y*X8BXQ}UI^=4B?v!#XZumRoG-^-j5EPP59A*b6TpvV*g96yyLc zFVe@-{*`xwrUA1V>Uv}a;$1F-U2#Gq3}Cxb&E&1MQy2(TdanTZu7gwg4{cHsPvp(_ zpYrI%GAJ*TlKj8F)C%#pbwtlTP_PUED{@sqhPc;_Cd~fIK*z#{Ifq%L2J)|Z8n^>2 z+)gmXmL4bL0BTSgi~`)x_kfNZ2-1lXNHD&%2!;_0Z+|o|88hagiDn^`^%t}<0$xKs zb0_TbA1fo7Yl6&|dfY!gwu5ssN=To1-kXaRGT9}(Mp~|&W~EkVyymryj%jXuj6_?^u`x4@&f?>?ML{S z@4Z*LrKS8r?3xM@_z*dCo4b$x?jzjqmB!zGrLY-bX89?vynHM`1fxa^0Db~TQdi{IlK%!&ft&Yl_ijB zFWs4M8UJ*hz)!ly$lS;40s#!j!}>N>U<)=6f}6ohk*;mObP=Hh!S}#wkP=i>j(zcf zr5$kAAsqo{x=(gNM%Hb?8BnW`MNVVn;GLddiN2@x{LNeN_rJMlNIaRD|HOHQ(pr?& zfplSdhOu1tPJmcD*v$j<)?p;L3QI3I(3rkJ_d%|*nNMY2`G!UMM%}RjvoV!~zTV#& zE&{LMLf&3{BF=9yQC5~odR{eP4fe}8D@H1Ae*JUn!A~i_9I;Uw=D$5pdB!B8A2PEq zAoBTtq3H$CbmMjd^5$S$_gf{_v2h9HH}5!{#yQS?V^nw-o-*l2^K`wL*77zv#C6+K z+ph0ro7UJa@C=p!pZzHK1_D5N3olZsH2^9-uH&*{M9%uU=wk2e*Ljzv`vAyEwxhVZ znyZ}l=7Q4G33+&q`JHwbTBGn=!5$^AvKiZz`*~#G-m_vBi;(^Mqu8x5lh;7>bgJ+$ z6Motb82cVLx~zpg!Z1X8{5@^nLHo^MN?8qglnYN8skq6uo$R zeYa<}OYdlpPs!U8cO5#Si;WWnJki)2#aI0eb>m%@;d$d_)LZJAMVZ9huZS=d|K(} z7yBY2vy8tV~L_qiT)~A;pE!F|*>_H5nHl-Th zp*kEkeXg;wY8G(FqeLZ;Y;e^n#Z^fMVc=C?)7NCqWRO*Oo9KA#!Ai9dM)`0y%skW? zlEpV|lTmv3#ex>@cd$8?@a^e54aBJY2=WYBlJR>_PM$5Bh#B$%i(U5d~O~Hj<#Z!nPCtl0ze`m1mq^PC!=~q=p%sF#O%MzCMvN&R?anCdxz<_ABJVz4gN6H0 zm~{*vs|N9%yMDG`o9dwKJj~xjk54F%9kE4rVwvn+!qF+BSA-p6|yB58tadqTCtkzr^#uBnkxdACmI_85C?(Q<^K z&2C0PjkHfes6#=6O?&7LCMZxx>^Cog_1R_s`+CiZrTPMG*988tVsIBC(^ZH^#{Qa= zkbX*XY-@;hSk6g-#-4|`@UX3U@s^Hrm9JGS1!^|ptya$icLciPKCC1ud{@E1aCK0+ zWN|o+^&o@!^lYYK1f`^K4$U!yYt~`mgD;7KbQv^x zBx94!GiJrU9jUV|c=@fV*y)B0D<&n!4jjoi_1){PcK5G)vhyP0(>cx4)KQ+6_#gNm zT!T+UJZi=yMVu7UJ?>i|7I;#P*@(iMYL+HY6T%ItJ(1|snLJ!%t93B@^MDw4!|(I@ zUVL|9vz)Ma-Z9=0$ky5Foa@)xXOc2pdlakR-AU0aVg5~DTgFIj`=fZxqUo&{&`L+j zvNj$wb@1^$Zeh9+yoWC~IZgwu-=UD=3o9#if}j3GoKwv2MfXG3((l;k`Cm26*HAN| zrCd?_!C#o1obNx~@4))VhPKsI$fWx=5Q&s{P#b!9;4B?Rmw6P7b}GI#@^&s_`YSBM zk6DoV(J}CWxl-B|w&wg3?hT2lfRfl2va5(Wj+HOZH-&2|%L!3$62Ju@ueAC}JInA2 zF3HPvvuX^p6X?--y_ldJwzn=KN(sL?%$8G>tZYgjQxm79NLAyC?~zle7OW z;NED=WcL7OSd)AbGR?Q9y(AREK6rxv1FI@^-saTJHIyXf*^zw6knimtJCBPx;?^2n zZ3%ukK3UOKD!zuGG5_GEi$11e*xU2<@aZv-Lr6>;UGAf5RniVfHzX6tVrzW<^wwH> z;BW3Wg0*Fe%D^t&w#b%nzFRrRqMzgX-RIW)2v_st_T7eh6y@E0I!IK^C~Z8<_op|c zRI!JnceFMG<#VKuEyzxn+)mC0*)XWJ(n^aZ4qUlT-p|X-REf{0((~xMZnb#oO0UPW zc9D(iMvW6p7wv4kQ=q^W-*UdQiCGyhg_kJKhtM?#xJ+4`Y)HGCqvtt!JN?n7FFMp5 z1V*&9&inh=ByB#6pvTk;-KMRCJkF)KYtO8Hoh#sr*1VvKFIu!bbM5xFA09`)3nq?! z6Vd(jbC_#>BUOw1`kNmqM!OA27l$YQ^oJjC#t|r=ARJTk-I@Xk@%#_@YowKC@0w#A zQ}R87WNPs}@;NbN5-PqM1ESvi)B@uIXSDaGgH~7RdiC2E4yW=vJl02G@dk$s?iMqp z50?i!@aVX#65(`rfxfGHPmJxdyG_i?foaque2K>ti9 z!CUZaVAk>9zjUpy_1BiF#RjbY_n-ai{}aT&SXKlFyu151Yl{DTEAPRzXX0fKLX(;P zcHZ;v6-wOak1RKZq@^Aa{_Rxm-_vC^vWp2cnM^(dyE8MfF*tCLKldm7 zby~uyd3l0D^94e}F=y=h+<`6H7~{Lq@66v2e?GK0(1G}(X;`i>XJ)6_b#3{291uK? zDOjGpMvP#Oww`ho1-z=Jt}28+mluqq-%A4A7b`OF2?akTE$fL2};2dE4s?tQQA#!np-Q% zf(XH5J|c^W;IfEtZ{R!N$d8+ox8eV+;ObKO+hOwN$n}M5J$F>8(N{ISBWWv*o!*4a z{oZd=`(W{$sZ@1a$uC8%vHy3b`b-5EKQCbZ`+ePrmF3GK3I&`7pD}! z7PJ{K!fvtLXVt&YZKC3r{^UF_qSVvAoq&{iokAtJhop|^k50R5Zy?wCf%%A(c6MM; zgqAtzx$Vg~dx&B`FtxbX#4!I94IlKmI{$bjrDCC$nn^E2Q}K%q%9v(tpMb(i@3u7# zpUd?QyDdFx66>2OLP?w|DR5o|LBY?lAIFK=Yl!)doP7(k_S`LYjl9l>d=Py|?bhIO zmB2sDQzgE@uh{^4rQB$rE)_46AdHL@t^7qPskma%*&3&gGbM^v=l0egt)s?GO-(Vi zl<*!`@~a*X$u(_dk(Zh*mtga~y+0Pm2A@q=IBXe!A{Hb|HCM;!_M&fQZpDzT$F-47 z)_Q;Yxo@K1{uCULkg%}eyv~xf^Wh=%SZ0(#i)yNz(==d@k%+#Jzg5D|V57BfCwuU6 zd{nN50F^H##kC9!KDDL-+7C5dde=OYu$^u69f#ykL^y5b5y=xzOfK4v#==hb*2k0 z*qu0#EK+hPmYps%y76+%$0kqH?#9Tdfd zHaW%pNCj#WANVju1Hcm>+uEzjoXUgCIU{>!JZO1(_HIZ|!8@{;wg6uve* z{v_Mh+=m|e{GIY<^`Xwmn0&2onNmO>1FZ!W?Fw}~0?#%#EntU|2kXr95GotjToGXi zJAiD2a11;IElIM@bOqZ|Y{U8fuSdH^cKo|XdiWbeakJTP(jO6v?Elbq>Ef1P5RDaK zCSo^@dvVkuJ4aVuA&gRtcxu97<$gP;VUn&F@EO@kZa7x4oR7f?1|) zv6vIHxKko4V3K%*P-wOeQp=A^yK9hW*R_sJ=bvpPN7SAo+0}H4u=@iF<3kxq z7n;9Yqf-<0zDM}CGV?{u$vdS*?ymM<5x5@HCRGrEpt66o@gQ#ShGrYSe-mShFG5YmC0Di;zD1rV_Oj zD?Q#787^5TuH7HS+?%jLX2>_Zl85Iz5T9`qqDk2J?<2aW#(r_OnAS35v_|w>Q`Qib zj{F{K-=oA|xrL3~Bx(x+JWwT%d)ystCOVILm_DQ<#gcl0HF$b@w_KPjxc{D|8R>oKCBNC4IS{M=YqWaIeI ziQDDr>$a(R_g>yYhR~gx#xYj`r_ti62HKhzTRvR-!{^FInZ@E=YLaXQs*w)kt9Us^ zTk=thT>bWB@=xeb68pEhkSKme8h#)0CZu6Z6N&^LpAilrRNPhOT8Q<;ouk#&>ai`a~_#e$0Y^tH! z+{f(n9zW36CyO8jwJpUzI^IjskKE!J)(XWu4G_W^lNdyJqMcVXVE*XGf%M!*ti~9D z$8YoG$K1!Y*C+NA+M$m`X*AER8>LgAS-qkgwiK)R-*U$asnoWnHuK()k-x}~4~#SP zop>BSXA%-Akm{`zNJXR9fNz|Bt`$n5dXs)ti*<}^HHCk>aFKF+ylGm1w>U?`eFs*v z8cX#h*N~m9PqZn>aFnY#kZ!tFNjj4>&GOEgQmkndYEXj(KG<}G?^UC?Eyb~;nb?ts zuTUfOqk|;|F?({t_aTaCY^Nn|b2`Sj#rZpHzC`4(dg{SjJVr1&rx^M5RVnnE#5!z* z`_EgENfs72@`h7y!-n%Cu$~h~7JSotK%Y(hRQFpehH*Ob=LHv54`{nIq z{4*b~;xyJ_Dq}}?B5!8pT-!~cQW@D6f=`gM_>~fLR|~MDzC~IqqDQbh4Yh~Vtb(r{ ztDUh;v2g00ly4!?3GJ6o$xl=2;&HX`LXQkd#xcm<~Hwq%HO$@~yHB&STu0_hz zZPnoLG|K*buIM;J^UIZ}gS`Xu=_9Pao`d_D8wo9GLTNqMX>)|}?#61z_0jGV1}?@! zoM{8~&*|AZ{(BbZn^dPTgD)danzx*SuG(vT%_mGc_!4>i#;>0<@G8`=NzFOw?6fQO zbr)jb3-z{_C0MT+HMY(dhCxN)?u*Pq^F_4vQ1giw3ojFRS{`?~kuZ6;nb{rfZ5i$) zxhE8BP20MjyK${*@%7-l9X&=a9jjR)nHpaO$X$|5C=al_ak%U-LNk-KL*uy+U@F1L z!X>6B#;CHI2yqo@PCZHPg-oB%ejAgdP2jHHPdq(bf$gBUNR|8~N_!Rrn`vNLGhF*x z1GxmI9tLt%d;$Z$Rl=+`hOt?-;=_UaQmduURPv(cd@k?U(up^hr3Q`}*P1{W1LNJZ ze!bb^LZF@%y1Qxh*w231csJ+!sl(lFXk?-!w@6XPZG&Q5zfi#`dMuD~(q-TN#-3Xh z^k~Q6i@n+U3XlC>{ttbdZt+_XKZlZ)+Jxy{ zTcO?7q^z{9h80;7Bu$zhP4gA>Weh8pga%sibjdYgbL(VU4t8TM!CLIRh1&jvZhQn| zaOuPug%(i3?Jrr5yKHfOb&D8%)B*OdMTU#3rYpuseWndnwGL>eb6uYg7!O7y?B4OL z-ysg56Pjt}$xlN|i4N9%0DQSK%nOy4{LjMqUWD%NJ@HS(#$a@<2b5(*XERuz%34cu z)=mrCPuu={Q$^>8V*`jn|5AIrd|xTQCP=`t$$HS!6K>ZPP0Z8X2VX{;^=OTJIZuV3 zF?Mj%U+uSM!swO0oVJ}X#_`Oen5J9WV&>^a2#y$k6w%tA&6dI10(t0I^S%)o%n>_i zn-`jNA(-wL0>n&<=z%4?#JpsZ7sa!*9Y~M$;eieX&H|zaeyKpun)6|IxAOh~0%B=( zUxy`iAQFvZsP*pe+}pL9pYU<58NUZzZ?W!~51eyO{z9mxBt@4uJ6d{%9V;iCd?&TJ z&@TF<<&b85fbzs)%08qkaucr!dJ7i4Rk}q5M317BqSQ}A?HEi%F!sdpS}R`e-N)63 z1!pX*xF_x_1lZ8E&laKq2J7VH(MixNY>|#<)3l?9lw8Yfssn#?6=oc~6M9 z`RYzXjr`_l+Mi2KSVdqR@|Z_Yv8fyR_W037tsjO{7SN0HN0eq=gV5 z`S0A%%;+<7KljZ0?d9Ub(OkgU`|Q2W+H3vF!ly%nQxz6z?=>ofAG!v?6cIob;+7XBO)w?6AL9?$?&7$WQp*`&V^z4OG?(kQcHx+=h|nlr0_FMNAq8n1QoOO3Qi zFCvOju=;&iay?r41Gd-u!s^egZjSxN0IAT6-CVl9L1+xGGXXFXy=$8zHeRZ-1-3<} zck<2gP8I%6VztT)QCvy7S}v;n3oCJ;Ayds z6d1BltrJ4iR!|mTrqLQ9#h8#OQZi$7vgcaU(1+6^*|^;Tw9L10zvZ|$gQUb2(~AdcgEaXx{YsM3a=6YS#2c*Qp6&Ytbum z?a^Jj$}<9sS#bWLsucIZj(o>y2*UG5ZmXn}_hEut*<`KDOOJ3$A44nFcUPKiV-Bic zU|_w=Qucw(!6r=>XMaXk+C_NM)8r!RI*-Zw`Wx(~KX_Rz*kvW4w^7}hnh|HALykq3 zv?|GkO>1x5B$sit;j|8whJ~LHyF`VKZRtpEK6;RJMdwGE_)p*PAvY;n)?Y|-gLBdw z`7owklg0!&EzEx{mxqxW_Rq5IDzY<9e=9%V)hBxNb%fuiz1e`^J#SBLR(T>(7sD))iP6wgEw)2-!7gV8%h8eS%~lm_ z?#)6i;-u6f@i=X*l`z&G;&jzZa+drq{dCfh)KN`VNGz+sI4nHGKs;;2v8MWZ&gZq^ znQztJgrefEy<3~o`xR|GZ>L_l7}Qw6NZ}4?nL+ke7S^WLauW;&Rpk5etjN?8Em6ar zkyyjMy$WGm3Ks$iASBIG`Y>;f3+gP4q-vR zc{=I?UM+Iqsc;mSYudBjH0HGRv3&obaQA=)m?@i6sa7@77KK2Bw5|*⪙6E*O1?e zT^o1h*&N@7%^SJ4ag(KV{GIGfKofbROVOE2De|PL>bj^XaUmTsQsB2Gusbq{wgz^z zciuAaC<4(n-Q5KxMLW~IDVFJcMV^xY#Y5_*TBT}9sZ`HI)`50$X`j;vMK+J1n%$>; zpEW&z%1_H!Eb+WlH+CcAGUy{~QTxc5W(nGVIfj5v)d^s`8`@TP@bJ+_V|bI2{d#K; zXnglko!Y5jFVNRnDF#O0SDpb#2M}HoTA|rn(yOrp{12a@5#U7|(UM_7q58W|HUtMJ z%kBx+?5%t5Edb!c>T338!gcRT;#3$OK#xQn;H2I(;kI;FK7}eGohZP3)MhgSWXMILKEZ zQzYTFZi%ssQFF*j@vsvI;GEH(6+li*d~ny+0P}-tyL=@KS^sJpm>M%9%^QN^mZ+F9 zeJnsIfJT0_WkEH;a8bSS@!%O19yJOcOBUkcTdQmQ1VTe?DDV5@^-Ntx9QXdRO0LUw zNOg1{XrASqUjx{W>=|fFuVc43)Z=jV%`GLC3(Pr!x#?N}cVxPcL)D@=b~xenm0ot8+L zi%J4;z6cKpsXI76bOKqH^Ss`24v1GWPEj=%0isarlbB6s^3V#V-1%*CMCpK`faTY$ zXI^oe3e8}r{(lB3U3^x1u-PiHISf#26NxD=F9OIQydO}jM1q+g z09d0boS^xxZtQ0%o^04(O^Y{0CGL z=OKZ(S}GoFlzniV#vCZ6vAg$a67rnk?Vbsf$g(F!$giu;IeBGBaD(jt`ExECR4-mz z!6 zzePe66?kY-9(X&jJ6n?1^?!(WN~M1)*sSOVXqvnG-5>5icK}dDXHk)|w{ZyyU}~|p zy`P4`e%x){0=gGQ9Kx2`AW9sk#<}C1%J=?5gD5`e!0LgFQSfRZ0Hpw(8*l)`rHWHB z?EDY(DBeSLZ|%V&p6#A7ueOOA@|K9t&TN8XubO130-W^96MzXzz)5Y0!;fgbJMoes zI(x06FPOvo>T?*-5sUtsuG<{JX2W$q8~{D$8fDoBfsuEln2;=(Cl%$JtDHs;&9qql za&?>zARK!}JIpbPf-#$WbI(o}< zz`*7_Y|cEUt)BX-80hXcqwHfTDMpQeJ{VcJ>bH&hG1tn4C>a>g-R&>%V_N0>3XpFf z)eK%{4kb!Dr&2*_narxU*FAfIVu4a;Loh=*_1*HgfEwYLG(d|Gvb}OYI#Tu8-SF zISgHsU3mY}0YpWTqT0>)llI{8o4q{_mcrW~LTN!{#PvO|-i^F3UQuw0(iPoROsgS$ zOvhpJ_NMQm7{FoqF0OkQINPo>Ve{`yVARM;@RyVyL5fR7ng;cs+P^eNWH#X^*x2^Y z{0)LlpD1YCzm#=K!6>%03;+JXcNMKxcG+hWhlGT7M1qp%Zks@i$ougv{ej}C z%(~@w^1_yl*l5hds)g(6cM45{75Il`&0Ez;9zSDC}Y zbo&SyGI#gX35rbcXc3!ebTH;YvbNyNE%`_mGYp)O(dhQda*6GlB8eSaNXMSQEvq*4 z^Xv{u%+ogWq& z)RaOl_Ezm?IREVMe6VZ_xphjG4QbrZfB zjQNN?OSh!0Fg&y=G0uD*-ED;m@Pip3=kvwY(W+vRXNcApKh;Z27azHUkB!%b^(}>X z*LR@r-0*4Xs|;X<-0dLi4UV2xDHAtfx)7iXME6}Yn&2oek za%~}D$P_M1>hhYh3E1YI28xo#xGV6HN4FrC8ziBDq6y8c)*OIPuca*{E%T#hU~5rQ`h!?)F%B3E;2Ai z<1yywfqO{MrZ<6*pAFp)@!RmgQ5IR>M6wahjiN+~lvdCV6RgwRk;k2q+@$@Ez4E-; z1QipDOkc2^9*B9Gb$ur!cr+yNg){Cn15~i-uxc~YR&vh5ou!F$j&i|3?yP2T7FT#! zvJ>74{Z8_pS;mJbo)9ywJ4!CUDAH=3`_L&{@S z`;0y^?xF^pO97H2Y9Hapvr^&2sV~y{CF|Na)nT^m*ee<+A>6sHJl%aH{4j1k*mUGWA}PQlxn@KlnU;mPBMny!Sxp_6*t%6^ zVwuD_5xUx=5A(YAQ-Y{bSvt$&v+&BeJVuJi3)wkjCD*uC7ZJs)u-0TA4pk22f+sZb zdN=;)E1{{}RgWX3c(^!y-+n7KSJw;wMck7U^yMmV@@ji=Qptx=XiB=3k~( z={i3!PJu{CqYKAz>&zMl$Zyq)=X)o1yhkU?Z){eSg+ld!rD2QFJTIezCH9^e#Xyil z$qm{!8&Fa?F(Q(Jom30Bf!0>!(%8Q(-!eIcKI%_8dmm@r*P?I}TajFL(W7@wVRUBq z@N_I%V_Ggn+wA*LraU)++xexSg`4#LU31?@7P%F2Y#V;n1M0Re^E2vcSA>pgKc&13M%}ask2S07oI+b(9BhB7*Vz0eFeFqnYw*3BvmUJ?s z#AFHkG^+oH@TRXgkq3?lfTwtClnP3|<5Gg`Uc{cacZtkI__8JaU=W_i@Gu(C9eW>v zq>y*n{A0^DJz*168Tn82h@~0CHVqm8;>~TSFkOJBr^0jv@rhTy0%DQ_5R8^^UwYiY z5aSnXxCVg4%?>U)l_v0sCZqt?NO>~<2Wbz#~_A$%`>5o41A(dw* z^qGt8igRfsMxJq@*58Rw&BVh6k+JIJ2U8z8YYJy9=P5RUOr7C@_14*|(UfZ!`jamT z+&{48ml_&#RpF`&GOuJ2vq*X~y zg=nn%!1)(;Nmd{~Da|R6<)Ta48#5ucKB6L^-=7w9;Eo2mK3t#RrP<}3I@fReP5FBQn|E$iV$KJL!UC>z!#gb4O?)oCD7hgH(VBbK_@J%-xy z(S+}xADk?zb7~YD*hsv?moS;bYO^W(&4iVA6OyzLx8(a0|1qt^xG&ROfu@+%mkU4m z#ow$WA?(@P3n;vn%X!liz3l}m>-FD2X6B5L^Q~!lDT&A%mleU9CragRKunfLFKr2} z9ll@PzNbhbJl1QOMI{h9}1Ye|u@$1O4X4Mj*?P3lP854~}{v-oK6 zBfVAAr^X-hIi9%f>kruhL%EG?hT&3GL8 zIJ~#x_RQKC)d3@qg^L_@WHNa~UdGh0NSG%%-2Liw_=+t%TVJp9UK4BQsrh^;owTW4 zjF81-SnVlEc}C=$dHh3YEnbJibn%eIZQcmckvZd+!>=Pek`=X#&O8}+N^u_{FDCjI z5lIVr^4*ml^Tw1}x18R66+?g@faE2+K?iwIPaFB1e9C;XxAhI>{8sP5Y7tNtlRX`O zmfI;?3qRz;+DfIEGb;4&e-&2YZt9XqW=)!j`DRSscZ^4+M-qH9Bm@@`X3-bSP`7!r zjTAhqaddiGLc--k7H$-z=k!PY27~6)@)B;n2I9V`1Lq-)-z5SoUVqVD93T6hHg)z$ zwI$1~nU@`V3~ZZLd#~@nOAJfCj|Ik73Hv!HW8ZQy>m5rn8O&O>Ss&;RqaHw<_nmV`xB7Mc{3ew! z(K5J(iQ6zGeW)vs;)V$J4w=iBO3(EAK#|syrpK|K4S0zqXIQ+&EzzbJ9I7&xcw*Ot zRCjsLGa~qm|5Z_*AIi&`O1Z-Gv~P1SFAtWi&h_MebC03?Y^TM;qg-!`HU-JWX(bDr z!MhMCvDw-2d&gYn*~>?;X*+JLEfUN<|ecWWe@jK_01t; zjmO!zgPhW0KSQ|*wx*xf?w~A`y^2R+Y5QS1R?B;zWqk;DQEN5^HCY>$TKsc~`dNu* z={z-(6dIs8<-%KJs6+3l+&<1Q(VjCuK$#~$teP<9Qof65FFtgca)AD%`%bQERZ!=F zd5KXk`zsoZ^cktX(M6jv4-OAbnF@X9oJx+P37$mA2;(O}Wf^yD%wBW5e-^u| zzw)(rFxZ_#qU)X8s|gNCUn$ z`szdt!*`e>@ihVM@SH*vFu`V3O_iQ=yh`MqyKb#5*XM}BcM94uH|v$JM0ns&4UNQZqOOvd6*j*y#r2G{0Y;d%n#zSdMY=>Hge_zx{aYhX^mnb6< zrK#mRWL1rXbSu069Pvmpe?1}yOoU69{g!IRDysXGl;0BSnN%@c!_6ETVLdGRJ)e1GD7rPm;d3JpG8}`nBJ0(dTDencFbS( zXf%X;wNkKBBuug(%Pl%t>S;S;$o#tD#{Qmuk-M$2o;?uzzXaN--YLMNLh?w zv_8^f^NWAnPr{VgGFsdg%ITlaeqdI!Pk6%Aprv}baD?$EcC=^GwY2Nr@xM68|Nc?Q z9Zm{N8vpc*;eV*B{2glhUi&ntnP)BB=f3n`fn!zfgW7^hv$EmueS!b;x|@&6NYs9w z9{pFC*nd`60=T(AL6Up=iqL;3P5sYrTQ~;_SwnnPn##Y=!2fw&8%^zUM7u=C|5a7w zpFjTm1gH(-&W(M(@?W8n&Dy91tu`rTmH%quWsU?0r(CA{U$b7=eDEfw4(Fdw+^urjN?P z$H2G8@&H#+!m{-=5RTl(wJ4H{Zb(XsNRX-i1J+57x&#=gt_hb#@c(&5+RUBjz3ef) z`EhOBulp%Hde)QLZ^(#IM*=ffWCyM?{Y?!mhi9!*)gljS?w!2@kh0AA(q$Y>H3G>= zQh<98mr4Bjq`ntF)6M=W<%?uo*sq85-1U$@=s-9CfUXg4#*F)gO&WXvP_-GTo+dXc6Z(RoKRpRH6WQ<~ojHFF=PTC%0O|x|Dic%u_h8&!Zs$cg^eP@T|VqF2P*{&3e^K(ek!fy_{by@NjL3^LuMC7fSn2R&GI{u z0!&8+ml&HIU8R>kryJUIyzA$n|6kGRf8uLy0L|uWP0GDnznA~b`nkd8T*#gPMDvOs zu6sHBbca^nQ@P5xdODHoY2jhAohSMo^U2Gmlu+3v&l1}_G3W8Go@tZ7+sIx=udO0x z4Rk$oqV>kxTG?L$R&SUrZ5WKABjF3eTDa^L(B6H#(bn>9=^aJ{P5kJ>atTI1z&|Rq z5cB2!%4h@(Jo^EyFw|MlcAu$WLw zT=KAVh*Q@+H_fO0snPgLxWJ04W6mBBqm)e3k3i93dZLVeMTx%$JhP4~k6JPo-o33t z{!Y`^XFuk<`~-_!^_`cs`Y;aY@%vl zYoFU6gMB7U^;k-gfL<;h;D+6~^D+XWIPPh4IZ)~DIaA@U3#7lN$fT$yVH^ zQ?N2<3s9A957W|L=RvILNxwbe&vQsXMX5OmAJ;?#J>nuNLqBfuJbV_09!ZvV`?kc2 zrM5m%h)f~-jDIK61gNWlF09AWijM2AeNjka{OnFU*@L!sGPt_AJlM78@AqZ`ligu*Fj7-@_ z{1j>3`a9}crFfyf0tj+!jANTj`>x;>(0t`t&t&AcH1cMat@fXB!+)}*eg0?8LA|Ku zSA9Q#n)j{GZ@5foi^+yn>=-}K^W!y(WAHb!jmy^%i53RI2g<&fg0$h zk*HcNXj*r%2+#?)6_2NS3RUl|w_72GFg@t%gDSo&TN(XtTx1OE3k3CKmc( z0dYZtUsi@%WXk={3u|@RUeH6YGwlMKCkUeVuK7lXq-0v|b&m2X;N{kouGoHobYH1O z*ES75+mX0^N&&oWt@44+!ccb0*N+FnECR-WxQ@v=TjPJ<;-{#6^&1r%aX{AKABkBm zJq0Z;$fZBM;X+WjZtuo4XR68xqB+U1Fj!vEBn^`>F znc6m4Gry<8x<1rftyIC)ke6#lI`F_uG6dGOMy_mbzK;QUZ+MFv2auh@m*F1-I*nD8 z+B*H5sMB!=*`<11?$ysaH5E$HJ!J!T&3;(BzzukACD?F)pDKd`Ko#&|Knab@|AAcs zIFisy33(JiA1=u$K#!vqZ&(ahh^yxr2ru8BUcJHqmqdn3Zxw*g=&9&>BFc;Zyay&|Q85v&wn z0q7FpP~BG2)C%X7zfraM1?hPXyq(C_@mvLY&vtcoHb_%HJS_Woggu3pF@P$ggCDFR zmr^xHGRZS%K7&)ydtf7Snddl&)c9=Ff(d-9AGs+jQzkYo@bo22Pdb15)9$oazcXS4rjJJj)*FW%m?7-;f*5*(*$ns|(R*`Ppv*Ulj+4U(nAN5Gqb z5o}2*VD;zFa7r>aTEzL5vGJIN@kIbE(b<~W1D*--ZC+WIS7)F-x%!@#O8|aidM+<^ zEAl%OZ0zRrTb0urRGb0`OxHNX4ehlON2#a@WU>H64HH!qCv6zOR_(K0)&*a2v*K_@ z?^ydx2C{s!bfCI8P+cI-BRGvgZVvT*HlGK8Q2z*#|Gc<)6T#Xq_4~0!fA;uuaOMDJ zq~EfYLe&$m)zJf$vgtFaqqkb1cTK%!nUWO!{dCk-qm2M2O=n%_761>?4uM5t-h`?H z@ln;dBq?Cmhw%VDdRlVxE}ay-bq?h5g! z5N#fR-N2q7UfqMLp<)K_POM&>K`1$TfDX>%WJzu+64!KYaA^G1~Ou04>1C+yFdr7jH-mwoKlKsTFJNC^Pgf& zd#a(c^{=@JRmtvt^OZq>@Hva<+atCpnrPctfwKVv&z@%sM~uZ2hoXB) zU)IpKIZ8=DFi*(C=((kX{n#GEiVz(=Qma^sEH| zaRz76st7j8&cp*4aD0e>@#Q;Zrms)rv^Rz@;=yu{P+Yl8#Zg7HO#sC&A;$Q~P{+5) zFtc+}-asx3ZkDf@K z|E^H@C=9%`?KPuR|1FvN$DjZGB`L#4<^TWx<(Jn|Xw7>kc;uETWe32Q@;&vt`M1qp F{6Cf1rSbp( diff --git a/man/StructuralVariant-class.Rd b/man/StructuralVariant-class.Rd new file mode 100644 index 0000000..e5a34cf --- /dev/null +++ b/man/StructuralVariant-class.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/StructuralVariant-class.R +\docType{class} +\name{StructuralVariant} +\alias{StructuralVariant} +\title{Class StructuralVariant} +\description{ +An S4 class for the Structural Variant plot object +} +\section{Slots}{ + +\describe{ +\item{\code{primaryData}}{data.table object storing primarydata used for plotting} + +\item{\code{geneData}}{data.table object storing annotated gene files} + +\item{\code{Grob}}{gtable object for the structural variant plot} +}} + diff --git a/man/VCF_Manta_v4.1-class.Rd b/man/VCF_Manta_v4.1-class.Rd new file mode 100644 index 0000000..19ca0dd --- /dev/null +++ b/man/VCF_Manta_v4.1-class.Rd @@ -0,0 +1,41 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/VCF_Manta_v4.1-class.R +\docType{class} +\name{VCF_Manta_v4.1} +\alias{VCF_Manta_v4.1} +\alias{VCF_Manta_v4.1} +\title{Class VCF_Manta_v4.1} +\usage{ +VCF_Manta_v4.1(vcfData, vcfHeader, paired, tumorColumn) +} +\arguments{ +\item{vcfData}{data.table object containing a VCF file conforming to the +version 4.1 specifications} + +\item{vcfHeader}{Object of class list containing character vectors for vcf +header information} + +\item{paired}{Boolean object specifying if the svCaller was ran in paired mode} + +\item{tumorColumn}{String specifying the name of the sample column with read support information} +} +\description{ +An S4 class to represent data in vcf version 4.1 format, inherits from the +VCF_Virtual class + +Constuctor for the VCF_Manta_v4.1 sub-class +} +\section{Slots}{ + +\describe{ +\item{\code{header}}{data.table object containing header information} + +\item{\code{meta}}{data.table object containing meta information lines} + +\item{\code{vcfHeader}}{data.table object containing header for vcf data} + +\item{\code{vcfData}}{data.table object containing vcf data lines} + +\item{\code{sample}}{data.table object containing sample information} +}} + diff --git a/man/VCF_Manta_v4.2-class.Rd b/man/VCF_Manta_v4.2-class.Rd new file mode 100644 index 0000000..38bded2 --- /dev/null +++ b/man/VCF_Manta_v4.2-class.Rd @@ -0,0 +1,41 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/VCF_Manta_v4.2-class.R +\docType{class} +\name{VCF_Manta_v4.2} +\alias{VCF_Manta_v4.2} +\alias{VCF_Manta_v4.2} +\title{Class VCF_Manta_v4.2} +\usage{ +VCF_Manta_v4.2(vcfData, vcfHeader, paired, tumorColumn) +} +\arguments{ +\item{vcfData}{data.table object containing a VCF file conforming to the +version 4.2 specifications} + +\item{vcfHeader}{Object of class list containing character vectors for vcf +header information} + +\item{paired}{Boolean object specifying if the svCaller was ran in paired mode} + +\item{tumorColumn}{String specifying the name of the sample column with read support information} +} +\description{ +An S4 class to represent data in vcf version 4.2 format, inherits from the +VCF_Virtual class + +Constuctor for the VCF_Manta_v4.2 sub-class +} +\section{Slots}{ + +\describe{ +\item{\code{header}}{data.table object containing header information} + +\item{\code{meta}}{data.table object containing meta information lines} + +\item{\code{vcfHeader}}{data.table object containing header for vcf data} + +\item{\code{vcfData}}{data.table object containing vcf data lines} + +\item{\code{sample}}{data.table object containing sample information} +}} + diff --git a/man/VCF_Virtual-class.Rd b/man/VCF_Virtual-class.Rd new file mode 100644 index 0000000..b529b14 --- /dev/null +++ b/man/VCF_Virtual-class.Rd @@ -0,0 +1,17 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/VCF_Virtual-class.R +\docType{class} +\name{VCF_Virtual} +\alias{VCF_Virtual} +\title{Class VCF_Virtual} +\description{ +An S4 class to act as a virtual class for VCF version sub-classes +} +\section{Slots}{ + +\describe{ +\item{\code{vcf}}{data.table object holding varscan data} + +\item{\code{sample}}{data.table object holding sample data} +}} + diff --git a/man/VEP-class.Rd b/man/VEP-class.Rd index 4130295..aadb946 100644 --- a/man/VEP-class.Rd +++ b/man/VEP-class.Rd @@ -30,8 +30,8 @@ Constructor for the VEP container class. When specifying a path to a VEP annotation file the option exist to either specify the full path to an annotation file or to use wildcards to specify multiple files. When specifying a full path the initalizer will check -if a column named "sample" containg the relevant sample for each row exists. -If such a column is not found the initalizer will assume this file +if a column named "sample" containing the relevant sample for each row +exists. If such a column is not found the initalizer will assume this file corresponds to only one sample and populate a sample column accordingly. Alternatively if multiple files are specified at once using a wildcard, the initalizer will aggregate all the files and use the file names minus any diff --git a/man/VarScanFormat-class.Rd b/man/VarScanFormat-class.Rd index 251a9e7..07816ff 100644 --- a/man/VarScanFormat-class.Rd +++ b/man/VarScanFormat-class.Rd @@ -6,7 +6,8 @@ \alias{VarScanFormat} \title{Class VarScanFormat} \usage{ -VarScanFormat(path, varscanType, verbose = FALSE) +VarScanFormat(path = NULL, varscanData = NULL, varscanType = "LOH", + verbose = FALSE) } \arguments{ \item{path}{String specifying the path to a VarScan file.} diff --git a/man/VariantCallFormat-class.Rd b/man/VariantCallFormat-class.Rd new file mode 100644 index 0000000..d97a22c --- /dev/null +++ b/man/VariantCallFormat-class.Rd @@ -0,0 +1,60 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/VariantCallFormat-class.R +\docType{class} +\name{VariantCallFormat-class} +\alias{VariantCallFormat-class} +\alias{VariantCallFormat} +\alias{extractVariantCallFormat} +\title{Class VariantCallFormat} +\usage{ +extractVariantCallFormat(path = NULL, data = NULL, version = "auto", + svCaller = NULL, paired = paired, tumorColumn = tumorColumn, + verbose = FALSE) +} +\arguments{ +\item{path}{String specifying the path to a VCF file. Can accept wildcards +if multiple VCF files exist (see details).} + +\item{data}{data.table object storing a VCF file. Overrides "path" if +specified} + +\item{version}{String specifying the version of the VCF file, if set to auto +the version will be obtained from the header in the VCF file} + +\item{svCaller}{String specifying the structural variant caller used} + +\item{paired}{Boolean specifiying if the svCaller was run with the paired option +(i.e. tumor-normal)} + +\item{tumorColumn}{Integer specifying the column number with the tumor read support information. +Only used when paired=TRUE.} + +\item{verbose}{Bolean specifying if progress should be reported while reading +in the VCF file} +} +\description{ +Class VariantCallFormat + +Constructor for the VCF container class +} +\details{ +When specifying a path to a VCF file, the option exists to either +specify the full path to a vcf file or to us wildcards to specify multiple +files. When specifying a full path, the initializer will check if a column +named "sample" containing the relevant sample for each row exists. If such a +column is not found, the initializer will assume this file correspnds to +only one sample and populate a sample column accordingly. Alternatively, if +multiple files are specified at once using a wildcard, the initializer will +aggregate all the files and use the filenames minus any extension to +populate the "sample" column. +} +\section{Slots}{ + +\describe{ +\item{\code{path}}{Character string specifying the path of the VCF file read in} + +\item{\code{version}}{Character string specifiying the version of the vcf file} + +\item{\code{vcfObject}}{vcf object which inherits from VCF_Virtual class} +}} + diff --git a/man/getData-methods.Rd b/man/getData-methods.Rd index 8256830..100e115 100644 --- a/man/getData-methods.Rd +++ b/man/getData-methods.Rd @@ -1,7 +1,7 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/AllGenerics.R, R/Clinical-class.R, -% R/MutSpectra-class.R, R/Rainfall-class.R, R/Waterfall-class.R, -% R/combinedCnLoh-class.R, R/lohSpec-class.R +% R/MutSpectra-class.R, R/Rainfall-class.R, R/StructuralVariant-class.R, +% R/Waterfall-class.R, R/combinedCnLoh-class.R, R/lohSpec-class.R \docType{methods} \name{getData} \alias{getData} @@ -21,6 +21,10 @@ \alias{getData} \alias{getData,Rainfall-method} \alias{getData} +\alias{.getData_structuralVariants} +\alias{getData} +\alias{getData,svData-method} +\alias{getData} \alias{.getData_waterfall} \alias{getData} \alias{getData,WaterfallData-method} @@ -61,6 +65,10 @@ getData(object, ...) \S4method{getData}{Rainfall}(object, name = NULL, index = NULL, ...) +.getData_structuralVariants(object, name = NULL, index = NULL, ...) + +\S4method{getData}{svData}(object, name = NULL, index = NULL, ...) + .getData_waterfall(object, name = NULL, index = NULL, ...) \S4method{getData}{WaterfallData}(object, name = NULL, index = NULL, ...) @@ -95,6 +103,8 @@ Helper function to getData from classes Helper function to get data from classes +Helper function to get data from classes + Helper function to getData from classes Helper function to get data from classes diff --git a/man/getSample-methods.Rd b/man/getSample-methods.Rd index 4593530..b66d4aa 100644 --- a/man/getSample-methods.Rd +++ b/man/getSample-methods.Rd @@ -1,8 +1,8 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/AllGenerics.R, R/GMS_Virtual-class.R, % R/GMS-class.R, R/MutationAnnotationFormat_Virtual-class.R, -% R/MutationAnnotationFormat-class.R, R/VEP_Virtual-class.R, R/VEP-class.R, -% R/VarScanFormat_Virtual-class.R +% R/MutationAnnotationFormat-class.R, R/VCF_Virtual-class.R, +% R/VEP_Virtual-class.R, R/VEP-class.R, R/VarScanFormat_Virtual-class.R \docType{methods} \name{getSample} \alias{getSample} @@ -14,6 +14,7 @@ \alias{getSample} \alias{getSample,MutationAnnotationFormat-method} \alias{getSample} +\alias{getSample} \alias{getSample,VEP_Virtual-method} \alias{getSample} \alias{getSample,VEP-method} @@ -32,6 +33,8 @@ getSample(object, ...) \S4method{getSample}{MutationAnnotationFormat}(object, ...) +\S4method{getSample}{VCF_Virtual}(object, ...) + \S4method{getSample}{VEP_Virtual}(object, ...) \S4method{getSample}{VEP}(object, ...) diff --git a/man/getVcf-methods.Rd b/man/getVcf-methods.Rd new file mode 100644 index 0000000..6487fc7 --- /dev/null +++ b/man/getVcf-methods.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R, R/VCF_Virtual-class.R +\docType{methods} +\name{getVcf} +\alias{getVcf} +\alias{getVcf} +\title{Method getVcf} +\usage{ +getVcf(object, ...) + +\S4method{getVcf}{VCF_Virtual}(object, ...) +} +\arguments{ +\item{...}{additional arguments to passed} +} +\description{ +Method getVcf +} diff --git a/man/lohSpec-class.Rd b/man/lohSpec-class.Rd index 8fae80f..386adc4 100644 --- a/man/lohSpec-class.Rd +++ b/man/lohSpec-class.Rd @@ -3,36 +3,39 @@ \name{lohSpec} \alias{lohSpec} \alias{lohSpec} +\alias{LohSpec} \title{Class lohSpec} \usage{ -lohSpec(x = NULL, path = NULL, fileExt = NULL, y = NULL, - genome = "hg19", gender = NULL, step = 1e+06, window_size = 2500000, - normal = 0.5, colourScheme = "inferno", plotLayer = NULL, - method = "slide", out = "plot") +LohSpec(input, lohSpec = TRUE, chromosomes = "autosomes", samples = NULL, + BSgenome = BSgenome, step = 1e+06, windowSize = 2500000, + normal = FALSE, gradientMidpoint = 0.2, gradientColors = c("#ffffff", + "#b2b2ff", "#000000"), plotAType = "proportion", plotALohCutoff = 0.2, + plotAColor = "#98F5FF", plotALayers = NULL, plotBLayers = NULL, + sectionHeights = c(0.25, 0.75), verbose = FALSE) } \arguments{ -\item{step}{Integer value specifying the step size (i.e. the number of base -pairs to move the window). required when method is set to slide -(see details).} - -\item{normal}{Boolean specifiying what value to use for normal VAF when -calcualting average LOH difference. Defaults to .50\% if FALSE. -If TRUE, will use average normal VAF in each individual sample as value -to calculate LOH.} - \item{input}{Object of class VarScan.} -\item{samples}{Character vector specifying samples to plot. If not NULL -all samples in "input" not specified with this parameter are removed.} - \item{chromosomes}{Character vector specifying chromosomes to plot. If not NULL all chromosomes in "input" not specified with this parameter are removed.} +\item{samples}{Character vector specifying samples to plot. If not NULL +all samples in "input" not specified with this parameter are removed.} + \item{BSgenome}{Object of class BSgenome to extract genome wide chromosome coordinates} +\item{step}{Integer value specifying the step size (i.e. the number of base +pairs to move the window). required when method is set to slide +(see details).} + \item{windowSize}{Integer value specifying the size of the window in base pairs in which to calculate the mean Loss of Heterozygosity (see details).} + +\item{normal}{Boolean specifiying what value to use for normal VAF when +calcualting average LOH difference. Defaults to .50\% if FALSE. +If TRUE, will use average normal VAF in each individual sample as value +to calculate LOH.} } \description{ An S4 class for the lohSpec plot object diff --git a/man/lohSpec.Rd b/man/lohSpec.Rd index dbd9bcf..af99d12 100644 --- a/man/lohSpec.Rd +++ b/man/lohSpec.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/lohSpec.R +% Please edit documentation in R/deprecated-lohSpec.R \name{lohSpec} \alias{lohSpec} \title{Plot LOH data} diff --git a/man/lohSpec_buildMain.Rd b/man/lohSpec_buildMain.Rd index 4bb46dd..ea395cc 100644 --- a/man/lohSpec_buildMain.Rd +++ b/man/lohSpec_buildMain.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/lohSpec_buildMain.R +% Please edit documentation in R/deprecated-lohSpec.R \name{lohSpec_buildMain} \alias{lohSpec_buildMain} \title{Plot LOH data} diff --git a/man/lohSpec_fileGlob.Rd b/man/lohSpec_fileGlob.Rd index 2bac569..dc01e27 100644 --- a/man/lohSpec_fileGlob.Rd +++ b/man/lohSpec_fileGlob.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/lohSpec_fileGlob.R +% Please edit documentation in R/deprecated-lohSpec.R \name{lohSpec_fileGlob} \alias{lohSpec_fileGlob} \title{Grab data for lohSpec} diff --git a/man/lohSpec_lohCalc.Rd b/man/lohSpec_lohCalc.Rd index e9f8538..dee96a0 100644 --- a/man/lohSpec_lohCalc.Rd +++ b/man/lohSpec_lohCalc.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/lohSpec_lohCalc.R +% Please edit documentation in R/deprecated-lohSpec.R \name{lohSpec_lohCalc} \alias{lohSpec_lohCalc} \title{Calculate loh difference} diff --git a/man/lohSpec_qual.Rd b/man/lohSpec_qual.Rd index 443c248..97727bb 100644 --- a/man/lohSpec_qual.Rd +++ b/man/lohSpec_qual.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/lohSpec_qual.R +% Please edit documentation in R/deprecated-lohSpec.R \name{lohSpec_qual} \alias{lohSpec_qual} \title{Check input to lohSpec} diff --git a/man/lohSpec_slidingWindow.Rd b/man/lohSpec_slidingWindow.Rd index c9b4b12..bb48352 100644 --- a/man/lohSpec_slidingWindow.Rd +++ b/man/lohSpec_slidingWindow.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/lohSpec_slidingWindow.R +% Please edit documentation in R/deprecated-lohSpec.R \name{lohSpec_slidingWindow} \alias{lohSpec_slidingWindow} \title{Obtain LOH data} diff --git a/man/lohSpec_stepCalc.Rd b/man/lohSpec_stepCalc.Rd index ef1a792..d732fc6 100644 --- a/man/lohSpec_stepCalc.Rd +++ b/man/lohSpec_stepCalc.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/lohSpec_stepCalc.R +% Please edit documentation in R/deprecated-lohSpec.R \name{lohSpec_stepCalc} \alias{lohSpec_stepCalc} \title{Obtain average loh within each step} diff --git a/man/lohSpec_tileCalc.Rd b/man/lohSpec_tileCalc.Rd deleted file mode 100644 index 4671b4d..0000000 --- a/man/lohSpec_tileCalc.Rd +++ /dev/null @@ -1,22 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/lohSpec_tileCalc.R -\name{lohSpec_tileCalc} -\alias{lohSpec_tileCalc} -\title{Calculate loh difference} -\usage{ -lohSpec_tileCalc(window_data, normal) -} -\arguments{ -\item{window_data}{object of class data frame with columns "chromosome", -"position", "n_vaf", "t_vaf", "sample", "bin", "window_start", "window_stop"} - -\item{normal}{integer specifying the subtraction value from tumor VAF} -} -\value{ -object of class dataframe containing mean LOH difference calculations -and column names "window_start", "window_stop", "chromosome", "position", -"n_vaf", "t_vaf", "sample", "loh_diff" -} -\description{ -Obtain LOH on an entire chromsomes from samples in a cohort -} diff --git a/man/lohSpec_tilePosition.Rd b/man/lohSpec_tilePosition.Rd deleted file mode 100644 index 17d4b69..0000000 --- a/man/lohSpec_tilePosition.Rd +++ /dev/null @@ -1,22 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/lohSpec_tilePosition.R -\name{lohSpec_tilePosition} -\alias{lohSpec_tilePosition} -\title{Obtain window information} -\usage{ -lohSpec_tilePosition(out, window_size) -} -\arguments{ -\item{out}{object of class dataframe with columns 'chromosome', -'position', 'n_vaf', 't_vaf', and 'sample'} - -\item{window_size}{integer with the size of the sliding window (bp) to be -applied} -} -\value{ -list containing window start/stop positions for each chromosome -from each sample to perform LOH calculations -} -\description{ -Calculate window positions to perform LOH calculation -} diff --git a/man/lohSpec_tileWindow.Rd b/man/lohSpec_tileWindow.Rd deleted file mode 100644 index 5ee464a..0000000 --- a/man/lohSpec_tileWindow.Rd +++ /dev/null @@ -1,24 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/lohSpec_tileWindow.R -\name{lohSpec_tileWindow} -\alias{lohSpec_tileWindow} -\title{Obtain LOH data} -\usage{ -lohSpec_tileWindow(loh_data, window_size, normal) -} -\arguments{ -\item{loh_data}{data frame with columns "chromosome", "position", "n_vaf", -"t_vaf", "sample" giving raw vaf calls for germline variants} - -\item{window_size}{integer with the size of the sliding window (bp) to be -applied} - -\item{normal}{integer specifying the normal VAF frequency used in LOH -calculations} -} -\value{ -object of class dataframe containing LOH data -} -\description{ -Obtain LOH heatmap on entire chromsomes from samples in a cohort -} diff --git a/man/lohSpec_windowPosition.Rd b/man/lohSpec_windowPosition.Rd index c82f254..af649f1 100644 --- a/man/lohSpec_windowPosition.Rd +++ b/man/lohSpec_windowPosition.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/lohSpec_windowPosition.R +% Please edit documentation in R/deprecated-lohSpec.R \name{lohSpec_windowPosition} \alias{lohSpec_windowPosition} \title{Obtain window information} diff --git a/man/svData-class.Rd b/man/svData-class.Rd new file mode 100644 index 0000000..ddf3473 --- /dev/null +++ b/man/svData-class.Rd @@ -0,0 +1,80 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/StructuralVariant-class.R +\name{svData} +\alias{svData} +\alias{StructuralVariant} +\title{Constuctor for the Structural Variant class} +\usage{ +StructuralVariant(input, BSgenome = NULL, filter = TRUE, svType = NULL, + svOrder = c("TRA", "BND", "DEL", "DUP", "INV", "INS"), maxSvSize = NULL, + sample = NULL, chromosomes = NULL, ensembl = ensembl, + attributes = attributes, filters = filters, annotate = TRUE, + geneAnnotationFlank = 10000, plotSpecificGene = FALSE, + plotGene1 = FALSE, plotGene2 = FALSE, chrGap = 5e+06, genome = "hg19", + cytobandColor = c("White", "Grey"), sampleColor = NULL, verbose = FALSE, + plotALayers = NULL, plotBLayers = NULL, plotCLayers = NULL, + outputDir = "~/Desktop", plotWidth = 15, plotHeight = 12) +} +\arguments{ +\item{BSgenome}{Object of class BSgenome to extract genome wide chromosome +coordinates} + +\item{filter}{Boolean specifying if SV calls that did not pass should be removed} + +\item{svType}{Character vector specifying which structural variant types to annotate/visualize} + +\item{svOrder}{Character vector specifying the deleterious order of sv types (most to least deleterious)} + +\item{maxSvSize}{Numeric specifying the maximum size of SV events (DEL/DUP/INV only)} + +\item{sample}{Character vector specifying which samples to annotate/visualize} + +\item{chromosomes}{Character vector specifying chromosomes to annotate/visualize} + +\item{ensembl}{Object of class Mart to use in biomaRt query} + +\item{attributes}{Character vector specifying which attributes to retrieve from biomaRt query} + +\item{filters}{Character vector specifying which filters to use in biomaRt query} + +\item{annotate}{Boolean specifying if the user wants to obtain mutated gene counts and annotate SV events} + +\item{geneAnnotationFlank}{Integer specifying the size of the flanks of each SV event +to include in the annotation step} + +\item{plotSpecificGene}{Character vector specifying which genes to plot} + +\item{plotGene1}{Boolean specifying if TRA genes should be plotted} + +\item{plotGene2}{Boolean specifying if non-TRA genes should be plotted} + +\item{chrGap}{Integer specifying the size of the gap between the 1st and 2nd chromosome} + +\item{genome}{Character vector specifying which genome to use to obtain chromosome bands. +Serves as input into the getCytobands function of karyoploteR.} + +\item{cytobandColor}{Character vector specifying what to color the chromosome bands} + +\item{sampleColor}{Character vector specifying colors to plot for each sample} + +\item{verbose}{Boolean specifying if status messages should be reported} + +\item{plotBLayers}{List of ggplot2 layers to be passed to chromosome plot} + +\item{plotCLayers}{List of ggplot2 layers to be passed to non-translocation plot} + +\item{outputDir}{Character value for directory to output SV visualizations} + +\item{plotWidth}{Integer for width of SV visualizations} + +\item{plotHeight}{Integer for height of SV visualizations} + +\item{object}{Object of class VCF} + +\item{object}{OBject of class VCF} + +\item{plotALAyers}{List of ggplot2 layers to be passed to translocation plot} +} +\description{ +Constuctor for the Structural Variant class +} diff --git a/tests/testthat/test-VarScanFormat-class.R b/tests/testthat/test-VarScanFormat-class.R index 75dc5a0..5a82fe0 100644 --- a/tests/testthat/test-VarScanFormat-class.R +++ b/tests/testthat/test-VarScanFormat-class.R @@ -1,10 +1,11 @@ # Get the disk location for test files testFileDir <- system.file("extdata", package="GenVisR") -testFile <- Sys.glob(paste0(testFileDir, "/HCC1395.varscan.tsv")) +lohTestFile <- Sys.glob(paste0(testFileDir, "/HCC1395.varscan.tsv")) +cnvTestFile <- Sys.glob(paste0(testFileDir, "/")) # Define the object for testing -varscanObject <- VarScanFormat(testFile, varscanType = "LOH") - +lohVarscanObject <- VarScanFormat(lohTestFile, varscanType = "LOH") +cnvVarscanObject <- VarScanFormat() ################################################################################ ##################### test VarScanFormat class construction #################### ################################################################################ @@ -12,7 +13,25 @@ varscanObject <- VarScanFormat(testFile, varscanType = "LOH") context("VarScanFormat") test_that("VarScanFormat can construct object from a file path", { - expect_s4_class(varscanObject, "VarScanFormat") + expect_s4_class(lohVarscanObject, "VarScanFormat") +}) + +test_that("VarScanFormat errors if both path and varscanData are NULL", { + expect_error(VarScanFormat(path=NULL, varscanData=NULL)) +}) + +test_that("VariantCallFormat warns if conversion to a data.table is required", { + dataset <- data.frame(data.table::fread(lohTestFile)) + expect_message(VarScanFormat(varscanData=dataset, varscanType="LOH")) +}) + +test_that("VarScanFormat errors if specified varscanType is not supported", { + dataset <- data.table::fread(lohTestFile) + expect_error(VarScanFormat(path=NULL, varscanData=dataset, varscanType="CNA")) +}) + +test_that("VarScanFormat prints a message if the LOH VAF data is a percentage", { + expect_warning(VarScanFormat(path=lohTestFile, varscanType="LOH")) }) ################################################################################ @@ -20,13 +39,12 @@ test_that("VarScanFormat can construct object from a file path", { ################################################################################ - ################################################################################ ########### test the getLohData method in lohSpec/combinedCnLohPlot ############ ################################################################################ -getLohData.out <- getLohData(varscanObject, verbose=FALSE, lohSpec=TRUE, germline=FALSE) -test_that("accessor method getLohData extracts the proper columns with heterozygous calls", { +getLohData.out <- getLohData(lohVarscanObject, verbose=FALSE, lohSpec=TRUE, germline=FALSE) +test_that("method getLohData extracts the proper columns with heterozygous calls", { # test that it is a data.table expect_is(getLohData.out, "data.table") @@ -37,10 +55,9 @@ test_that("accessor method getLohData extracts the proper columns with heterozyg expect_true(all(extractedCol %in% expectedCol)) # test that there are no coordinates with normal VAF less than 0.4 or greater than 0.6 - + expect_true(length(which(getLohData.out$normal_var_freq < 0.4 | getLohData.out$normal_var_freq > 0.6))==0) }) - diff --git a/tests/testthat/test-VariantCallFormat-class.R b/tests/testthat/test-VariantCallFormat-class.R new file mode 100644 index 0000000..5c33629 --- /dev/null +++ b/tests/testthat/test-VariantCallFormat-class.R @@ -0,0 +1,83 @@ +# get the disk location for test files +testFileDir <- system.file("extdata", package="GenVisR") +testFile <- Sys.glob(paste0(testFileDir, "/*.vep")) + +library(testthat) +# define the object for testing +path <- "~/OneDrive/Hepatocellular Carcinoma/HCC_SV/Discovery/raw_sv_data/HCC_Manta/*" +data=NULL +version <- "auto" +svCaller <- "Manta" +paired <- "TRUE" +tumorSample <- "H_MU-748892-1209080" +verbose <- FALSE + +## Create input for SV +vcfObject <- extractVariantCallFormat(path=path, data=NULL, version=version, + svCaller=svCaller, paired=paired, + tumorColumn=tumorColumn, verbose=verbose) + +################################################################################ +############# test VariantCallFormat class construction ######################## +################################################################################ +context("VariantCallFormat") + +test_that("VariantCallFormat can construct object from a file path", { + expect_s4_class(vcfObject, "VariantCallFormat") +}) + +test_that("VariantCallFormat errors if both ath and data are null", { + expect_error(extractVariantCallFormat(path=NULL, data=NULL, version="auto", svCaller="fake", paired=TRUE, tumorColumn=11)) +}) + +test_that("VariantCallFormat errors in no files are found", { + expect_error(extractVariantCallFormat(path=paste0(path, "/*.not_here"), svCaller="Manta")) +}) + +test_that("VariantCallFormat errors if unsupported sv caller is specified", { + expect_error(extractVariantCallFormat(path=path, version="auto", svCaller="fake", paired=TRUE, tumorColumn=11)) +}) + +test_that("VariantCallFormat errors if unsupported vcf version is specified", { + expect_error(extractVariantCallFormat(path=path, version="1.5", svCaller="Manta", paired=TRUE, tumorColumn=11)) +}) + +test_that("VariantCallFormat errors if the data is paired but the paired variable is false", { + expect_error(extractVariantCallFormat(path=path, version="auto", svCaller="Manta", paired=FALSE, tumorColumn=11)) +}) + +test_that("VariantCallFormat errors if the data is paired but tumorColumn designates a column without sample read support data", { + expect_error(extractVariantCallFormat(path=path, version="auto", svCaller="Manta", paired=TRUE, tumorColumn=8)) +}) + +test_that("VariantCallFormat can construct object from data already loaded in R", { + testData <- data.table::fread("~/Google Drive/hcc_sv_dataset.txt") + expect_s4_class(extractVariantCallFormat(data=testData, version="4.1", svCaller="Manta", + paired=TRUE, tumorColumn=11), "VariantCallFormat") +}) + +test_that("VariantCallFormat warns if conversion to a data.table is required", { + testData <- data.table::fread("~/Google Drive/hcc_sv_dataset.txt") + testData <- as.data.frame(testData) + expect_warning(extractVariantCallFormat(data=testData, version="4.1", svCaller="Manta", + paired=TRUE, tumorColumn=11)) + expect_s4_class(suppressWarnings(extractVariantCallFormat(data=testData, version="4.1", svCaller="Manta", + paired=TRUE, tumorColumn=11)), "VariantCallFormat") +}) + +test_that("VariantCallFormat errors if data has incorrect columns", { + testData <- data.table::fread("~/Google Drive/hcc_sv_dataset.txt") + testData <- testData[,-length(colnames(testData)), with=FALSE] + expect_error(extractVariantCallFormat(data=testData, version="4.1", svCaller="Manta", + paired=TRUE, tumorColumn=11)) + + +}) + +test_that("VariantCallFormat errors if data has more than 2 columns that are possibly sample read info", { + testData <- data.table::fread("~/Google Drive/hcc_sv_dataset.txt") + testData$fakeData <- "fakeData" + expect_error(extractVariantCallFormat(data=testData, version="4.1", svCaller="Manta", + paired=TRUE, tumorColumn=11)) +}) + From 401b9d2d349661b36a417a2b7e17820bdb4ade50 Mon Sep 17 00:00:00 2001 From: Jason kunisaki Date: Tue, 24 Apr 2018 16:27:56 -0500 Subject: [PATCH 11/21] Structural Variant Update --- R/AllGenerics.R | 15 +- R/StructuralVariant-class.R | 595 +++++++++++++++++++++--------------- R/VarScanFormat-class.R | 18 +- R/VariantCallFormat-class.R | 2 +- 4 files changed, 369 insertions(+), 261 deletions(-) diff --git a/R/AllGenerics.R b/R/AllGenerics.R index 994147f..4e91ac8 100644 --- a/R/AllGenerics.R +++ b/R/AllGenerics.R @@ -332,6 +332,20 @@ setGeneric( def=function(object, ...){standardGeneric("drawPlot")} ) +#' Method drawSvPlot +#' +#' @name drawSvPlot +#' @rdname drawSvPlot-methods +#' @param object Object of class Structural Variant +#' @param ... additional arguments to passed +#' @details The drawSvPlot method is used to draw plots created by GenVisR plot +#' constructor functions. +#' @exportMethod drawSvPlot +setGeneric( + name="drawSvPlot", + def=function(object, chr1, chr2, ...){standardGeneric("drawSvPlot")} +) + #' Method parseHeader #' #' @name parseHeader @@ -939,7 +953,6 @@ setGeneric( #' @rdname extractVariantCallFormat-methods #' @param ... additional arguments to passed #' @noRd -#' @exportMethod extractVariantCallFormat setGeneric( name="extractVariantCallFormat", def=function(object, ...){standardGeneric("extractVariantCallFormat")} diff --git a/R/StructuralVariant-class.R b/R/StructuralVariant-class.R index 67c418d..62b5fed 100644 --- a/R/StructuralVariant-class.R +++ b/R/StructuralVariant-class.R @@ -17,7 +17,8 @@ #' @exportClass StructuralVariant setClass("StructuralVariant", representation=representation(svData="data.table", - geneData="data.table"), + geneData="data.table", + svPlots="list"), validity=function(object) { }) @@ -45,8 +46,8 @@ setClass("StructuralVariant", #' @param geneAnnotationFlank Integer specifying the size of the flanks of each SV event #' to include in the annotation step #' @param plotSpecificGene Character vector specifying which genes to plot -#' @param plotGene1 Boolean specifying if TRA genes should be plotted -#' @param plotGene2 Boolean specifying if non-TRA genes should be plotted +#' @param plotTraGenes Boolean specifying if TRA genes should be plotted +#' @param plotOtherGenes Boolean specifying if non-TRA genes should be plotted #' @param chrGap Integer specifying the size of the gap between the 1st and 2nd chromosome #' @param genome Character vector specifying which genome to use to obtain chromosome bands. #' Serves as input into the getCytobands function of karyoploteR. @@ -65,12 +66,11 @@ StructuralVariant <- function(input, BSgenome=NULL, filter=TRUE, svType=NULL, maxSvSize=NULL, sample=NULL, chromosomes=NULL, ensembl=ensembl, attributes=attributes, filters=filters, annotate=TRUE, geneAnnotationFlank=10000, - plotSpecificGene=FALSE, plotGene1=FALSE, - plotGene2=FALSE, chrGap=5000000, + plotSV=plotSV, plotSpecificGene=FALSE, plotTraGenes=FALSE, + plotOtherGenes=FALSE, chrGap=5000000, genome="hg19", cytobandColor=c("White", "Grey"), sampleColor=NULL, verbose=FALSE, plotALayers=NULL, - plotBLayers=NULL, plotCLayers=NULL, - outputDir="~/Desktop", plotWidth=15, plotHeight=12) { + plotBLayers=NULL, plotCLayers=NULL) { ## Calculate all data for the plots svDataset <- svData(object=input, BSgenome=BSgenome, filter=filter, svType=svType, svOrder=svOrder, @@ -79,17 +79,16 @@ StructuralVariant <- function(input, BSgenome=NULL, filter=TRUE, svType=NULL, geneAnnotationFlank=geneAnnotationFlank, genome=genome, verbose=verbose) ## Create the plots from svData - structuralVariantPlots <- svPlots(object=svDataset, plotSpecificGene=plotSpecificGene, - plotGene1=plotGene1, plotGene2=plotGene2, cytobandColor=cytobandColor, + structuralVariantPlots <- svPlots(object=svDataset, plotSV=plotSV, plotSpecificGene=plotSpecificGene, + plotTraGenes=plotTraGenes, plotOtherGenes=plotOtherGenes, cytobandColor=cytobandColor, plotALayers=plotALayers, plotBLayers=plotBLayers, plotCLayers=plotCLayers, sectionHeights=sectionHeights, - sample=sample, sampleColor=sampleColor, plotWidth=plotWidth, plotHeight=plotHeight, - outputDir=outputDir, verbose=verbose) + sample=sample, sampleColor=sampleColor, verbose=verbose) ## Intialize the object new("StructuralVariant", svData=getData(object=svDataset, name="primaryData"), - geneData=getData(object=svDataset, name="geneData")) - + geneData=getData(object=svDataset, name="geneData"), + svPlots=structuralVariantPlots) } #!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Private Classes !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!# @@ -120,8 +119,6 @@ svData <- function(object, BSgenome, filter, svType, svOrder, maxSvSize, sample, chromosomes, ensembl, attributes, filters, annotate, geneAnnotationFlank, chrGap, genome, verbose) { - browser() - ## Subset data to only passed sv calls primaryData <- filterStructuralVariant(object=object, filter=filter, maxSvSize=maxSvSize, @@ -181,17 +178,16 @@ setClass("svPlots", #' @param object Object of class svData #' @importFrom gtable gtable #' @noRd -svPlots <- function(object, plotSpecificGene, plotGene1, plotGene2, cytobandColor, +svPlots <- function(object, plotSV, plotSpecificGene, plotTraGenes, plotOtherGenes, cytobandColor, plotALayers, plotBLayers, plotCLayers, sectionHeights, - sample, sampleColor, plotWidth, plotHeight, outputDir, verbose, ...) { - + sample, sampleColor, verbose, ...) { + ## Create the gtable for the plots - svGtables <- buildSvPlot(object=object, plotSpecificGene=plotSpecificGene, - plotGene1=plotGene1, plotGene2=plotGene2, cytobandColor=cytobandColor, + svGtables <- buildSvPlot(object=object, plotSV=plotSV, plotSpecificGene=plotSpecificGene, + plotTraGenes=plotTraGenes, plotOtherGenes=plotOtherGenes, cytobandColor=cytobandColor, plotALayers=plotALayers, plotBLayers=plotBLayers, plotCLayers=plotCLayers, sectionHeights=sectionHeights, sample=sample, - sampleColor=sampleColor, plotWidth=plotWidth, plotHeight=plotHeight, - outputDir=outputDir, verbose=verbose) + sampleColor=sampleColor, verbose=verbose) ## Initialize the object new("svPlots", plots=svGtables) @@ -246,6 +242,35 @@ setMethod(f="getData", signature="svData", definition=.getData_structuralVariants) +#' @rdname drawSvPlot-methods +#' @aliases drawSvPlot +#' @importFrom grid grid.draw +#' @importFrom grid grid.newpage +#' @exportMethod drawSvPlot +setMethod(f="drawSvPlot", + signature="StructuralVariant", + definition=function(object, chr1=NULL, chr2=NULL, ...) { + ## Get the list of gtabls + object <- object@svPlots@plots + + ## Get the chr combo + order <- paste(gtools::mixedsort(c(chr1, chr2)), collapse="_") + + ## See if the desired chr combo can be found in the plots + num <- which(names(object) == order) + if (length(num) == 0) { + memo <- paste0("The plot for the chromosome combination: ", + chr1, "_", chr2, " could not be found. Make sure to append the chr name with ", + dQuote("chr"), " rather than just using the chromosome number (chr1 instead of 1).", + "The possible combinations that could be used are: ", + paste(names(object), collapse=", ")) + stop(memo) + } + finalPlot <- object[[num]] + grid::grid.newpage() + grid::grid.draw(finalPlot) + }) + ################################################################################ #################### Method function definitions ############################### @@ -256,7 +281,7 @@ setMethod(f="getData", #' @importFrom data.table data.table #' @noRd setMethod(f="filterStructuralVariant", - signature="VariantCallFormat", + signature="data.table", definition=function(object, filter, maxSvSize, svType, verbose, ...) { @@ -318,11 +343,12 @@ setMethod(f="filterStructuralVariant", #' @param verbose Boolean for status updates #' @return data.table object with calculated mutation distances #' @importFrom data.table data.table +#' @importFrom data.table rbindlist #' @noRd setMethod(f="chrSubsetSv", signature="data.table", definition=function(object, chromosomes, verbose, ...){ - + # print status message if(verbose){ memo <- paste("Performing chromosome subsets") @@ -406,17 +432,39 @@ setMethod(f="chrSubsetSv", warning(memo) } - # perform the subset + # perform the subset - remove GL and MT chromosomes object <- object[-grep("GL", object$chromosome)] object <- object[-grep("MT", object$chromosome)] object <- object[-grep("GL", object$chromosome2)] object <- object[-grep("MT", object$chromosome2)] - object <- object[object$chromosome %in% chromosomes | object$chromosome2 %in% chromosomes,] + + ## Remove rows that have nothing to do with the desired chromosomes + ## Keep DEL/DUP/INV/INS events that occur on other chromosomes that + ## have translocations with the desired chromosomes + allStructuralVariants <- object + ## Get the chromosome combination + chr_combo <- data.table(paste(allStructuralVariants$chromosome, + allStructuralVariants$chromosome2, + sep="_")) + otherChromosomes <- apply(chr_combo, 1, function(x, chromosomes){ + chr <- strsplit(x, split="_")[[1]] + otherChr <- data.table(chr[-which(chr %in% chromosomes)]) + if (length(otherChr)!=0) { + return(otherChr) + } + }, chromosomes=chromosomes) + otherChromosomes <- unique(rbindlist(otherChromosomes)) + otherChromosomes <- paste(otherChromosomes$V1, otherChromosomes$V1, sep="_") + + object$chr_combo <- paste(object$chromosome, object$chromosome2, sep="_") + object <- object[object$chromosome %in% chromosomes | object$chromosome2 %in% chromosomes | + object$chr_combo %in% otherChromosomes,] object$chromosome <- factor(object$chromosome) object$chromosome2 <- factor(object$chromosome2) ## Remove rows that are duplciated in the ID column object <- object[!duplicated(object$ID)] + object <- object[,-c("chr_combo")] # check that the object has a size after subsets if(nrow(object) < 1){ @@ -866,7 +914,7 @@ setMethod(f="adjustCentromeres", setMethod(f="getStructuralVariantWindow", signature="data.table", definition=function(object, chrData, chrCytobands, chrGap, verbose){ - + object=adjustedPrimaryData ## Print status message if (verbose) { message("Adjusting chromosome boundaries for visualization of structural variants.") @@ -885,12 +933,21 @@ setMethod(f="getStructuralVariantWindow", } ## For each of the COI-chr combination, generate a dataset to plot - #chr <- coi$chromosomes[1] + chr <- coi$chromosomes[1] finalDf <- data.table::rbindlist(apply(coi, 1, function(chr, sampleData, chrCytobands, chrGap){ - #browser() ## Get rows in cohort that have sv events involving COI dataset <- sampleData[chromosome==chr | chromosome2 == chr,] + ## Get the rows in the dataset that have sv events 2ndary to COI + otherChr1 <- unique(dataset[!which(chromosome %in% chr)]$chromosome) + otherChr2 <- unique(dataset[!which(chromosome2 %in% chr)]$chromosome2) + otherChr <- unique(c(otherChr1, otherChr2)) + otherChrCombo <- paste(otherChr, otherChr, sep="_") + otherDataset <- sampleData[chr_combo %in% otherChrCombo] + + ## Combine COI TRA with 2ndary SV events + dataset <- rbind(dataset, otherDataset) + ## Get the mate chromosome for TRA events otherChr <- unique(c(as.character(dataset$chromosome), as.character(dataset$chromosome2))) otherChr <- as.data.table(otherChr[-which(otherChr %in% chr)]) @@ -973,245 +1030,275 @@ setMethod(f="getStructuralVariantWindow", #' @noRd setMethod(f="buildSvPlot", signature="svData", - definition=function(object, plotSpecificGene, plotGene1, plotGene2, cytobandColor, sample, sampleColor, plotALayers, - plotBLayers, plotCLayers, sectionHeights, plotWidth, plotHeight, - outputDir, verbose) { - ## Print status message - if (verbose) { - message("Generating SV plots") - } - - ## Get the svWindow - svWindow <- object@svWindow + definition=function(object, plotSV, plotSpecificGene, plotTraGenes, plotOtherGenes, + cytobandColor, sample, sampleColor, plotALayers, + plotBLayers, plotCLayers, sectionHeights, verbose) { - ## Check the input variables - checkPlotLayer <- function(plotLayer, name) { - if(!is.null(plotLayer)){ - if(!is.list(plotLayer)){ - memo <- paste(name, " is not a list", sep="") - stop(memo) - } - - if(any(!unlist(lapply(plotLayer, function(x) ggplot2::is.ggproto(x) | ggplot2::is.theme(x) | is(x, "labels"))))){ - memo <- paste(name, " is not a list of ggproto or ", - "theme objects... setting plotALayers to NULL", sep="") - warning(memo) - plotLayer <- NULL - } + if (plotSV == FALSE) { + ## Print status message + if (verbose) { + message("plotSV was set to FALSE, so no SV plots will be generated.") } - return(plotLayer) + svPlots <- list() + return(svPlots) } - plotALayers <- checkPlotLayer(plotLayer=plotALayers, "plotALayers") - plotBLayers <- checkPlotLayer(plotLayer=plotBLayers, "plotBLayers") - plotCLayers <- checkPlotLayer(plotLayer=plotCLayers, "plotCLayers") - ## Assign colors for samples - names(sampleColor) <- sample - - ## Split the sv window by chr_combo - window <- split(svWindow, svWindow$chr_combo) - - ## Go through each window dataset and generate a plot - svPlots <- suppressWarnings(lapply(window, function(dataset, plotSpecificGene, - cytobandColor, sectionHeights, - sampleColor, outputDir, - plotWidth, plotHeight, - plotALayers, plotBLayers, - plotCLayers) { - ## Split the dataset by sample to assign color names - df <- split(dataset, f=dataset$sample) - dataset <- data.table::rbindlist(lapply(df, function(x, sampleColor){ - if (nrow(x) > 0) { - sampleName <- as.character(x$sample[1]) - x$sampleColor <- sampleColor[which(names(sampleColor) == sampleName)] - } - return(x) - }, sampleColor=sampleColor)) + if (plotSV == TRUE) { + ## Print status message + if (verbose) { + message("Generating SV plots") + } - colnames(dataset) <- c("Chromosome", "Position", "Chromosome2", "Position2", "Direction", - "SV_Type", "Total_Read_Support", "Sample", "Genes", - "Midpoint", "chr_combo", "gene", "sampleColor") - ## Sort dataset - dataset$Sample <- factor(dataset$Sample, levels=gtools::mixedsort(unique(dataset$Sample))) + ## Get the svWindow + svWindow <- object@svWindow - ## Create bins for the chr positions (remove position transformation) - chrOrder <- gtools::mixedsort(unique(c(as.character(dataset$Chromosome), as.character(dataset$Chromosome2)))) - chr1Length <- max(dataset[Direction=="cytoband" & Chromosome == chrOrder[1], Position2]) - ## Get chr1 data - chr1OldBreaks <- round(seq(0, chr1Length, by=chr1Length/5), digits=0) - chr1NewBreaks <- round(seq(0, chr1Length, by=chr1Length/5), digits=0) - chr1 <- data.table(chr=chrOrder[1], newBreaks=chr1NewBreaks, oldBreaks=chr1OldBreaks) - ## Get chr2 data - chr2Start <- min(dataset[Direction=="cytoband" & Chromosome == chrOrder[2], Position]) - chr2Length <- max(dataset[Direction=="cytoband" & Chromosome == chrOrder[2], Position2]) - chr2OldBreaks <- round(seq(chr2Start, chr2Length, by=(chr2Length-chr2Start)/5), digits=0) - chr2NewBreaks <- round(seq(0, chr2Length-chr1Length, by=(chr2Length-chr1Length)/5), digits=0) - chr2 <- data.table(chr=chrOrder[2], newBreaks=chr2NewBreaks, oldBreaks=chr2OldBreaks) - temp <- rbind(chr1, chr2) + ## Convert BND notation to readable format + svWindow$direction <- gsub("N\\[P\\[", "3' to 5'", svWindow$direction) + svWindow$direction <- gsub("N]P]", "3' to 3'", svWindow$direction) + svWindow$direction <- gsub("]P]N", "5' to 3'", svWindow$direction) + svWindow$direction <- gsub("\\[P\\[N", "5' to 5'", svWindow$direction) + svWindow$svtype <- gsub("BND", "TRA", svWindow$svtype) - ## Get the start and stop for each chromosome - chr1End <- chr1Length - chr2End <- chr2Length - boundaries <- data.table(start=c(0, chr2Start), end=c(chr1End, chr2End)) - ############################################################## - ##### Plot the chromosome plot ############################### - ############################################################## - ## Get the cytoband data - coi <- dataset[Direction=="cytoband" & SV_Type != "centromere"] - coi$type <- "Chromosome" - suppressWarnings(coi$color <- cytobandColor) - chrPlot <- ggplot() + geom_rect(data=coi, mapping=aes_string(xmin='Position', - xmax='Position2', - ymin=0, - ymax=1)) + - facet_grid(type ~ ., scales="fixed", space="fixed") + - scale_x_continuous(expand=c(0,0), limits=c(-5000000, max(coi$Position2) + 5000000)) + - scale_y_continuous(expand=c(0,0)) + - theme_bw() + - geom_rect(data=coi, aes(xmin=Position, xmax=Position2, ymin=0, ymax=1, fill=Chromosome), fill=coi$color) + - geom_text(data=coi, aes(x=Midpoint, y=0.5, label=SV_Type), angle=90, size=3) + - geom_vline(data=boundaries, aes(xintercept=start), linetype=2, color="Grey") + - geom_vline(data=boundaries, aes(xintercept=end), linetype=2, color="Grey") + - plotBLayers + ## Check the input variables + checkPlotLayer <- function(plotLayer, name) { + if(!is.null(plotLayer)){ + if(!is.list(plotLayer)){ + memo <- paste(name, " is not a list", sep="") + stop(memo) + } + + if(any(!unlist(lapply(plotLayer, function(x) ggplot2::is.ggproto(x) | ggplot2::is.theme(x) | is(x, "labels"))))){ + memo <- paste(name, " is not a list of ggproto or ", + "theme objects... setting plotALayers to NULL", sep="") + warning(memo) + plotLayer <- NULL + } + } + return(plotLayer) + } + plotALayers <- checkPlotLayer(plotLayer=plotALayers, "plotALayers") + plotBLayers <- checkPlotLayer(plotLayer=plotBLayers, "plotBLayers") + plotCLayers <- checkPlotLayer(plotLayer=plotCLayers, "plotCLayers") - ## Get the centromeres - centromeres <- dataset[SV_Type=="centromere", c("Chromosome", "Position", "Position2")] - positions <- data.table::rbindlist(apply(centromeres, 1, function(x) { - midpoint <- round((as.numeric(as.character(x['Position'])) + - as.numeric(as.character(x['Position2'])))/2, digits=0) - leftPositions <- data.table(x=c(x['Position'], midpoint, x['Position']), - y=c(0.10, 0.5, 0.90), - SV_Type="Chromosome", - id=paste(x['Chromosome'], "_left", sep="")) - rightPositions <- data.table(x=c(x['Position2'], midpoint, x['Position2']), - y=c(0.10, 0.5, 0.90), - SV_Type="Chromosome", - id=paste(x['Chromosome'], "_right", sep="")) - positions <- rbind(leftPositions, rightPositions) - positions$x <- as.numeric(positions$x) - return(positions) - })) - chrPlot <- chrPlot + geom_polygon(data=positions, mapping=aes(x=x, y=y, group=id), fill="red") + ## Assign colors for samples + names(sampleColor) <- sample - ## Subset svWindow dataset to get DEL/DUP/INV/etc... and TRA/BND/etc... - sameChrSvWindow <- dataset[SV_Type=="DEL" | SV_Type=="DUP" | SV_Type =="INV" | SV_Type == "INS"] - sameChrSvWindow$SV_size <- sameChrSvWindow$Position2 - sameChrSvWindow$Position - diffChrSvWindow <- dataset[SV_Type=="BND" | SV_Type=="TRA"] + ## Split the sv window by chr_combo + window <- split(svWindow, svWindow$chr_combo) - ## Get the dataset for the gene text annotations - dataset <- dataset[Direction!="cytoband"] - gene_text <- dataset[,c("Midpoint", "Total_Read_Support", "gene", "SV_Type")] - gene_text$Total_Read_Support[which(gene_text$SV_Type=="BND")] <- - as.numeric(as.character(gene_text$Total_Read_Support[which(gene_text$SV_Type=="BND")])) + - max(as.numeric(as.character(gene_text$Total_Read_Support[which(gene_text$SV_Type=="BND")])))*.05 - gene_text$Total_Read_Support[which(gene_text$SV_Type!="BND")] <- - as.numeric(as.character(gene_text$Total_Read_Support[which(gene_text$SV_Type!="BND")])) + - max(as.numeric(as.character(gene_text$Total_Read_Support[which(gene_text$SV_Type!="BND")])))*.05 - gene_text$Total_Read_Support <- as.numeric(gene_text$Total_Read_Support) - if (!is.null(plotSpecificGene)) { - genes <- paste(plotSpecificGene, collapse="|") - gene_text <- gene_text[grep(genes, as.character(gene_text$gene))] - if (nrow(gene_text) == 0){ - message(paste0("The genes: ", plotSpecificGene, " could not be found. No genes will be shown on the plot.")) - gene_text <- NULL + ## Go through each window dataset and generate a plot + svPlots <- suppressWarnings(lapply(window, function(dataset, plotSpecificGene, + cytobandColor, sectionHeights, + sampleColor, + plotTraGenes, plotOtherGenes, + plotALayers, plotBLayers, + plotCLayers) { + ## Split the dataset by sample to assign color names + df <- split(dataset, f=dataset$sample) + dataset <- data.table::rbindlist(lapply(df, function(x, sampleColor){ + if (nrow(x) > 0) { + sampleName <- as.character(x$sample[1]) + x$sampleColor <- sampleColor[which(names(sampleColor) == sampleName)] + } + return(x) + }, sampleColor=sampleColor)) + + colnames(dataset) <- c("Chromosome", "Position", "Chromosome2", "Position2", "Direction", + "SV_Type", "Total_Read_Support", "Sample", "Genes", + "Midpoint", "chr_combo", "gene", "sampleColor") + ## Sort dataset + dataset$Sample <- factor(dataset$Sample, levels=gtools::mixedsort(unique(dataset$Sample))) + + ## Create bins for the chr positions (remove position transformation) + chrOrder <- gtools::mixedsort(unique(c(as.character(dataset$Chromosome), as.character(dataset$Chromosome2)))) + chr1Length <- max(dataset[Direction=="cytoband" & Chromosome == chrOrder[1], Position2]) + ## Get chr1 data + chr1OldBreaks <- round(seq(0, chr1Length, by=chr1Length/5), digits=0) + chr1NewBreaks <- round(seq(0, chr1Length, by=chr1Length/5), digits=0) + chr1 <- data.table(chr=chrOrder[1], newBreaks=chr1NewBreaks, oldBreaks=chr1OldBreaks) + ## Get chr2 data + chr2Start <- min(dataset[Direction=="cytoband" & Chromosome == chrOrder[2], Position]) + chr2Length <- max(dataset[Direction=="cytoband" & Chromosome == chrOrder[2], Position2]) + chr2OldBreaks <- round(seq(chr2Start, chr2Length, by=(chr2Length-chr2Start)/5), digits=0) + chr2NewBreaks <- round(seq(0, chr2Length-chr1Length, by=(chr2Length-chr1Length)/5), digits=0) + chr2 <- data.table(chr=chrOrder[2], newBreaks=chr2NewBreaks, oldBreaks=chr2OldBreaks) + temp <- rbind(chr1, chr2) + + ## Get the start and stop for each chromosome + chr1End <- chr1Length + chr2End <- chr2Length + boundaries <- data.table(start=c(0, chr2Start), end=c(chr1End, chr2End)) + + ############################################################## + ##### Plot the chromosome plot ############################### + ############################################################## + ## Get the cytoband data + coi <- dataset[Direction=="cytoband" & SV_Type != "centromere"] + coi$type <- "Chromosome" + suppressWarnings(coi$Height <- c(0.4, 0.6)) + suppressWarnings(coi$color <- cytobandColor) + coi <- coi[!duplicated(coi$SV_Type)] + chrPlot <- ggplot() + geom_rect(data=coi, mapping=aes_string(xmin='Position', + xmax='Position2', + ymin=0, + ymax=1)) + + facet_grid(type ~ ., scales="fixed", space="fixed") + + scale_x_continuous(expand=c(0,0), limits=c(-5000000, max(coi$Position2) + 5000000)) + + scale_y_continuous(expand=c(0,0)) + + theme_bw() + + geom_rect(data=coi, aes(xmin=Position, xmax=Position2, ymin=0, ymax=1, fill=Chromosome), fill=coi$color) + + geom_text(data=coi, aes(x=Midpoint, y=Height, label=SV_Type), angle=90, size=3) + + geom_vline(data=boundaries, aes(xintercept=start), linetype=2, color="Grey") + + geom_vline(data=boundaries, aes(xintercept=end), linetype=2, color="Grey") + + plotBLayers + + ## Get the centromeres + centromeres <- dataset[SV_Type=="centromere", c("Chromosome", "Position", "Position2")] + positions <- data.table::rbindlist(apply(centromeres, 1, function(x) { + midpoint <- round((as.numeric(as.character(x['Position'])) + + as.numeric(as.character(x['Position2'])))/2, digits=0) + leftPositions <- data.table(x=c(x['Position'], midpoint, x['Position']), + y=c(0.10, 0.5, 0.90), + SV_Type="Chromosome", + id=paste(x['Chromosome'], "_left", sep="")) + rightPositions <- data.table(x=c(x['Position2'], midpoint, x['Position2']), + y=c(0.10, 0.5, 0.90), + SV_Type="Chromosome", + id=paste(x['Chromosome'], "_right", sep="")) + positions <- rbind(leftPositions, rightPositions) + positions$x <- as.numeric(positions$x) + return(positions) + })) + chrPlot <- chrPlot + geom_polygon(data=positions, mapping=aes(x=x, y=y, group=id), fill="red") + + ## Subset svWindow dataset to get DEL/DUP/INV/etc... and TRA/BND/etc... + sameChrSvWindow <- dataset[SV_Type=="DEL" | SV_Type=="DUP" | SV_Type =="INV" | SV_Type == "INS"] + sameChrSvWindow$SV_size <- sameChrSvWindow$Position2 - sameChrSvWindow$Position + diffChrSvWindow <- dataset[SV_Type=="BND" | SV_Type=="TRA"] + + ## Get the dataset for the gene text annotations + dataset <- dataset[Direction!="cytoband"] + gene_text <- dataset[,c("Midpoint", "Total_Read_Support", "gene", "SV_Type")] + gene_text$Total_Read_Support[which(gene_text$SV_Type=="TRA")] <- + as.numeric(as.character(gene_text$Total_Read_Support[which(gene_text$SV_Type=="TRA")])) + + max(as.numeric(as.character(gene_text$Total_Read_Support[which(gene_text$SV_Type=="TRA")])))*.05 + gene_text$Total_Read_Support[which(gene_text$SV_Type!="TRA")] <- + as.numeric(as.character(gene_text$Total_Read_Support[which(gene_text$SV_Type!="TRA")])) + + max(as.numeric(as.character(gene_text$Total_Read_Support[which(gene_text$SV_Type!="TRA")])))*.05 + gene_text$Total_Read_Support <- as.numeric(gene_text$Total_Read_Support) + gene_text <- gene_text[!duplicated(gene_text)] + if (!is.null(plotSpecificGene)) { + genes <- paste(plotSpecificGene, collapse="|") + gene_text <- gene_text[grep(genes, as.character(gene_text$gene))] + if (nrow(gene_text) == 0){ + if (verbose) { + message(paste0("The genes: ", plotSpecificGene, + " could not be found. No genes will be shown on the plot.")) + } + gene_text <- NULL + plotTraGenes <- FALSE + plotOtherGenes <- FALSE + } + if (!is.null(gene_text)) { + plotTraGenes <- any(c("TRA", "BND") %in% gene_text$SV_Type) + plotOtherGenes <- any(gene_text$SV_Type %in% c("DEL", "DUP", "INV", "INS")) + } } - } - - ## Get the start/end of chromosomes in the dataset - beziers <- data.frame(data.table::rbindlist(apply(diffChrSvWindow, 1, function(x) { - leftEnd <- data.table(position=as.numeric(x[2]), total_read_support=0, point="end", + + ## Get the start/end of chromosomes in the dataset + beziers <- data.frame(data.table::rbindlist(apply(diffChrSvWindow, 1, function(x) { + leftEnd <- data.table(position=as.numeric(x[2]), total_read_support=0, point="end", + type="cubic", group=as.character(x[2]), Sample=x[8], SV_Type=x[6], + Direction=x[5], sampleColor=x[13]) + top <- data.table(position=as.numeric(x[10]), total_read_support=as.numeric(x[7])*2, point="control", type="cubic", group=as.character(x[2]), Sample=x[8], SV_Type=x[6], Direction=x[5], sampleColor=x[13]) - top <- data.table(position=as.numeric(x[10]), total_read_support=as.numeric(x[7])*2, point="control", - type="cubic", group=as.character(x[2]), Sample=x[8], SV_Type=x[6], - Direction=x[5], sampleColor=x[13]) - rightEnd <- data.table(position=as.numeric(x[4]), total_read_support=0, point="end", - type="cubic", group=as.character(x[2]), Sample=x[8], SV_Type=x[6], - Direction=x[5], sampleColor=x[13]) - final <- rbind(leftEnd, top, rightEnd) - return(final) - }))) - beziers <- beziers[!duplicated(beziers),] - - beziers$Sample <- factor(beziers$Sample, levels=gtools::mixedsort(unique(beziers$Sample))) - - ############################################################## - ##### Plot the translocation data ############################ - ############################################################## - traPlot <- ggplot() + geom_bezier(data=beziers, - mapping=aes_string(x='position', y='total_read_support', group='group', - color='Sample', linetype='Direction')) + - facet_grid(SV_Type ~ ., scales="fixed", space="fixed") + - scale_x_continuous(expand=c(0,0), limits=c(-5000000, max(coi$Position2) + 5000000), - breaks=temp$oldBreaks, labels=temp$newBreaks) + - scale_y_continuous() + - geom_vline(data=boundaries, aes(xintercept=start), linetype=2, color="Grey") + - geom_vline(data=boundaries, aes(xintercept=end), linetype=2, color="Grey") + - theme_bw() + plotALayers + ylab("Total Read Support") + - geom_point(data=beziers[which(beziers$point=="control"),c("position","total_read_support", "Sample")], - aes(x=position, y=total_read_support/2, color=Sample)) - if (plotGene1 & !is.null(gene_text)) { - traPlot <- traPlot + geom_text(data=gene_text[SV_Type%in%c("TRA", "BND")], - mapping=aes_string(x='Midpoint', y='Total_Read_Support', label='gene')) - } - ## Assign colors to sample - traPlot <- traPlot + scale_color_manual(name="Sample", values=sampleColor) - - ############################################################## - ##### Plot the non TRA sv events ############################# - ############################################################## - maxY <- max(as.numeric(as.character(sameChrSvWindow$Total_Read_Support))) + 30 - sameChrSvWindow$Total_Read_Support <- as.numeric(sameChrSvWindow$Total_Read_Support) - nonTraPlot <- ggplot() + geom_point(data=sameChrSvWindow, - mapping=aes_string(x='Midpoint', y='Total_Read_Support', - color="Sample"), size=2.5, alpha=0.75) + - facet_grid(SV_Type ~ ., scales="fixed", space="fixed") + - scale_x_continuous(expand=c(0,0), limits=c(-5000000, max(coi$Position2) + 5000000), - breaks=temp$oldBreaks, labels=temp$newBreaks) + - scale_y_continuous(limits=c(0,maxY+maxY*0.05)) + - geom_vline(data=boundaries, aes(xintercept=start), linetype=2, color="Grey") + - geom_vline(data=boundaries, aes(xintercept=end), linetype=2, color="Grey") + - theme_bw() + plotCLayers + ylab("Total Read Support") + xlab("Position") - if (plotGene2 & !is.null(gene_text)) { - nonTraPlot <- nonTraPlot + geom_text(data=gene_text[SV_Type%in%c("DEL", "DUP", "INV", "INS")], - mapping=aes_string(x='Midpoint', y='Total_Read_Support', label='gene')) - } - ## Assign colors to sample - nonTraPlot <- nonTraPlot + scale_color_manual(name="Sample", values=sampleColor) - - ############################################################## - ##### Combine the 3 plots #################################### - ############################################################## - traPlot <- ggplotGrob(traPlot) - chrPlot <- ggplotGrob(chrPlot) - nonTraPlot <- ggplotGrob(nonTraPlot) - - ## obtain the max width for relevant plots - plotList <- list(traPlot, chrPlot, nonTraPlot) - plotList <- plotList[lapply(plotList, length) > 0] - plotWidths <- lapply(plotList, function(x) x$widths) - maxWidth <- do.call(grid::unit.pmax, plotWidths) - - ## Set the widths for all plots - for (i in 1:length(plotList)) { - plotList[[i]]$widths <- maxWidth - } - - ## Arrange the final plot - p1 <- do.call(gridExtra::arrangeGrob, c(plotList, list(ncol=1, heights=sectionHeights))) - plot(p1) - - pdf(file=paste(outputDir, dataset$chr_combo[1], ".pdf", sep=""), width=plotWidth, height=plotHeight) - plot(p1) - dev.off() + rightEnd <- data.table(position=as.numeric(x[4]), total_read_support=0, point="end", + type="cubic", group=as.character(x[2]), Sample=x[8], SV_Type=x[6], + Direction=x[5], sampleColor=x[13]) + final <- rbind(leftEnd, top, rightEnd) + return(final) + }))) + beziers <- beziers[!duplicated(beziers),] + + beziers$Sample <- factor(beziers$Sample, levels=gtools::mixedsort(unique(beziers$Sample))) + + ############################################################## + ##### Plot the translocation data ############################ + ############################################################## + traPlot <- ggplot() + geom_bezier(data=beziers, + mapping=aes_string(x='position', y='total_read_support', group='group', + color='Sample', linetype='Direction')) + + facet_grid(SV_Type ~ ., scales="fixed", space="fixed") + + scale_x_continuous(expand=c(0,0), limits=c(-5000000, max(coi$Position2) + 5000000), + breaks=temp$oldBreaks, labels=temp$newBreaks) + + scale_y_continuous() + + geom_vline(data=boundaries, aes(xintercept=start), linetype=2, color="Grey") + + geom_vline(data=boundaries, aes(xintercept=end), linetype=2, color="Grey") + + theme_bw() + plotALayers + ylab("Total Read Support") + + geom_point(data=beziers[which(beziers$point=="control"),c("position","total_read_support", "Sample")], + aes(x=position, y=total_read_support/2, color=Sample)) + if (plotTraGenes & !is.null(gene_text)) { + traPlot <- traPlot + geom_text(data=gene_text[SV_Type%in%c("TRA", "BND")], + mapping=aes_string(x='Midpoint', y='Total_Read_Support', label='gene')) + } + ## Assign colors to sample + traPlot <- traPlot + scale_color_manual(name="Sample", values=sampleColor) + + ############################################################## + ##### Plot the non TRA sv events ############################# + ############################################################## + maxY <- max(as.numeric(as.character(sameChrSvWindow$Total_Read_Support))) + 30 + sameChrSvWindow$Total_Read_Support <- as.numeric(sameChrSvWindow$Total_Read_Support) + nonTraPlot <- ggplot() + geom_point(data=sameChrSvWindow, + mapping=aes_string(x='Midpoint', y='Total_Read_Support', + color="Sample"), size=2.5, alpha=0.75) + + facet_grid(SV_Type ~ ., scales="fixed", space="fixed") + + scale_x_continuous(expand=c(0,0), limits=c(-5000000, max(coi$Position2) + 5000000), + breaks=temp$oldBreaks, labels=temp$newBreaks) + + scale_y_continuous(limits=c(0,maxY+maxY*0.05)) + + geom_vline(data=boundaries, aes(xintercept=start), linetype=2, color="Grey") + + geom_vline(data=boundaries, aes(xintercept=end), linetype=2, color="Grey") + + theme_bw() + plotCLayers + ylab("Total Read Support") + xlab("Position") + if (plotOtherGenes & !is.null(gene_text)) { + nonTraPlot <- nonTraPlot + geom_text(data=gene_text[SV_Type%in%c("DEL", "DUP", "INV", "INS")], + mapping=aes_string(x='Midpoint', y='Total_Read_Support', label='gene')) + } + ## Assign colors to sample + nonTraPlot <- nonTraPlot + scale_color_manual(name="Sample", values=sampleColor) + + ############################################################## + ##### Combine the 3 plots #################################### + ############################################################## + traPlot <- ggplotGrob(traPlot) + chrPlot <- ggplotGrob(chrPlot) + nonTraPlot <- ggplotGrob(nonTraPlot) + + ## obtain the max width for relevant plots + plotList <- list(traPlot, chrPlot, nonTraPlot) + plotList <- plotList[lapply(plotList, length) > 0] + plotWidths <- lapply(plotList, function(x) x$widths) + maxWidth <- do.call(grid::unit.pmax, plotWidths) + + ## Set the widths for all plots + for (i in 1:length(plotList)) { + plotList[[i]]$widths <- maxWidth + } + + ## Arrange the final plot + p1 <- do.call(gridExtra::arrangeGrob, c(plotList, list(ncol=1, heights=sectionHeights))) + plot(p1) + + return(p1) + }, + plotSpecificGene=plotSpecificGene, cytobandColor=cytobandColor, + sectionHeights=sectionHeights, sampleColor=sampleColor, + plotTraGenes=plotTraGenes, plotOtherGenes=plotOtherGenes, + plotALayers=plotALayers, plotBLayers=plotBLayers, plotCLayers=plotCLayers)) - return(p1) - }, - plotSpecificGene=plotSpecificGene, cytobandColor=cytobandColor, - sectionHeights=sectionHeights, sampleColor=sampleColor, - plotALayers=plotALayers, plotBLayers=plotBLayers, plotCLayers=plotCLayers, - outputDir=outputDir, plotWidth=plotWidth, plotHeight=plotHeight)) + return(svPlots) + } + - return(svPlots) }) \ No newline at end of file diff --git a/R/VarScanFormat-class.R b/R/VarScanFormat-class.R index 5bb850a..bbdf9de 100644 --- a/R/VarScanFormat-class.R +++ b/R/VarScanFormat-class.R @@ -140,7 +140,7 @@ VarScanFormat <- function(path=NULL, varscanData=NULL, varscanType="LOH", verbos if (!is.null(path) & is.null(varscanData)) { ## Read in VarScan data varscanData <- suppressMessages(fread(input=path, stringsAsFactors=FALSE, - verbose=verbose)) + verbose=verbose, showProgress=FALSE)) } ## Add varscanType value to dataset @@ -184,13 +184,17 @@ VarScanFormat <- function(path=NULL, varscanData=NULL, varscanType="LOH", verbos tp <- grep("%", varscanData$tumor_var_freq) if (length(np) > 0) { memo <- paste("Normal VAF values appear to be percentages. Converting to proportions.") - warning(memo) + if (verbose) { + warning(memo) + } varscanData$normal_var_freq <- as.numeric(as.character( gsub(pattern="%", replacement="", varscanData$normal_var_freq))) } if (length(tp) > 0) { memo <- paste("Tumor VAF values appear to be percentages. Converting to proportions.") - warning(memo) + if (verbose) { + warning(memo) + } varscanData$tumor_var_freq <- as.numeric(as.character( gsub(pattern="%", replacement="", varscanData$tumor_var_freq))) } @@ -200,12 +204,16 @@ VarScanFormat <- function(path=NULL, varscanData=NULL, varscanType="LOH", verbos tm <- max(range(varscanData$tumor_var_freq)) if (nm > 1) { memo <- paste("Normal VAF values appear to be out of 100. Making VAF values out of 1.") - warning(memo) + if (verbose) { + warning(memo) + } varscanData$normal_var_freq <- round(varscanData$normal_var_freq/100, digits=3) } if (tm > 1) { memo <- paste("Tumor VAF values appear to be out of 100. Making VAF values out of 1.") - warning(memo) + if (verbose) { + warning(memo) + } varscanData$tumor_var_freq <- round(varscanData$tumor_var_freq/100, digits=3) } } diff --git a/R/VariantCallFormat-class.R b/R/VariantCallFormat-class.R index 44d798f..578e381 100644 --- a/R/VariantCallFormat-class.R +++ b/R/VariantCallFormat-class.R @@ -62,7 +62,7 @@ extractVariantCallFormat <- function(path=NULL, data=NULL, version="auto", svCal ## Get the data if the dataset is not provided if (is.null(data)) { ## Add wildcard to the path if it not present - if (strsplit(path, split="/")[[1]][length(strsplit(path, split="/")[[1]])] != "*") { + if (length(path) > 1 & strsplit(path, split="/")[[1]][length(strsplit(path, split="/")[[1]])] != "*") { memo <- paste("No wildcard found in the designated path. Please add wildcard to the path. For example:", "~/Desktop/StructuralVariants/* to use files in ~/Desktop/StructuralVariants/ directory.") stop(memo) From e8e417cc10d4063c8e34cfa272de60fd91c8b15d Mon Sep 17 00:00:00 2001 From: Jason kunisaki Date: Wed, 25 Apr 2018 16:10:25 -0500 Subject: [PATCH 12/21] Structural variant function update - allow for DEL/DUP/INV/INS to be plotted --- NAMESPACE | 2 - R/AllGenerics.R | 24 +-- R/StructuralVariant-class.R | 396 ++++++++++++++++++------------------ R/VariantCallFormat-class.R | 65 +++++- 4 files changed, 269 insertions(+), 218 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index e5e0899..b57bee4 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -17,7 +17,6 @@ export(cnSpec) export(cnView) export(compIdent) export(covBars) -export(extractVariantCallFormat) export(genCov) export(geneViz) export(ideoView) @@ -38,7 +37,6 @@ exportClasses(Waterfall) exportClasses(cnLoh) exportClasses(lohSpec) exportMethods(drawPlot) -exportMethods(extractVariantCallFormat) exportMethods(getData) exportMethods(getDescription) exportMethods(getGrob) diff --git a/R/AllGenerics.R b/R/AllGenerics.R index 4e91ac8..9b033d6 100644 --- a/R/AllGenerics.R +++ b/R/AllGenerics.R @@ -332,20 +332,6 @@ setGeneric( def=function(object, ...){standardGeneric("drawPlot")} ) -#' Method drawSvPlot -#' -#' @name drawSvPlot -#' @rdname drawSvPlot-methods -#' @param object Object of class Structural Variant -#' @param ... additional arguments to passed -#' @details The drawSvPlot method is used to draw plots created by GenVisR plot -#' constructor functions. -#' @exportMethod drawSvPlot -setGeneric( - name="drawSvPlot", - def=function(object, chr1, chr2, ...){standardGeneric("drawSvPlot")} -) - #' Method parseHeader #' #' @name parseHeader @@ -947,13 +933,13 @@ setGeneric( def=function(object, ...){standardGeneric("adjustCentromeres")} ) -#' Method extractVariantCallFormat +#' Method getVcfData #' -#' @name extractVariantCallFormat -#' @rdname extractVariantCallFormat-methods +#' @name getVcfData +#' @rdname getVcfData-methods #' @param ... additional arguments to passed #' @noRd setGeneric( - name="extractVariantCallFormat", - def=function(object, ...){standardGeneric("extractVariantCallFormat")} + name="getVcfData", + def=function(object, ...){standardGeneric("getVcfData")} ) \ No newline at end of file diff --git a/R/StructuralVariant-class.R b/R/StructuralVariant-class.R index 62b5fed..61fbdbc 100644 --- a/R/StructuralVariant-class.R +++ b/R/StructuralVariant-class.R @@ -120,9 +120,8 @@ svData <- function(object, BSgenome, filter, svType, svOrder, maxSvSize, sample, verbose) { ## Subset data to only passed sv calls - primaryData <- filterStructuralVariant(object=object, - filter=filter, maxSvSize=maxSvSize, - svType=svType, verbose=verbose) + primaryData <- getVcfData(object=object, filter=filter, maxSvSize=maxSvSize, + svType=svType, verbose=verbose) ## Subset data to only the chromosomes desired to be plotted primaryData <- chrSubsetSv(object=primaryData, chromosomes=chromosomes, verbose=verbose) @@ -242,12 +241,12 @@ setMethod(f="getData", signature="svData", definition=.getData_structuralVariants) -#' @rdname drawSvPlot-methods -#' @aliases drawSvPlot +#' @rdname drawPlot-methods +#' @aliases drawPlot #' @importFrom grid grid.draw #' @importFrom grid grid.newpage -#' @exportMethod drawSvPlot -setMethod(f="drawSvPlot", +#' @export +setMethod(f="drawPlot", signature="StructuralVariant", definition=function(object, chr1=NULL, chr2=NULL, ...) { ## Get the list of gtabls @@ -274,66 +273,6 @@ setMethod(f="drawSvPlot", ################################################################################ #################### Method function definitions ############################### -#' @rdname filterStructuralVariant-methods -#' @aliases filterStructuralVariant -#' @param object Object of class VCF -#' @param verbose Boolean speifying if status messages should be reported -#' @importFrom data.table data.table -#' @noRd -setMethod(f="filterStructuralVariant", - signature="data.table", - definition=function(object, filter, maxSvSize, svType, - verbose, ...) { - - ## Print status message - if (verbose) { - memo <- paste0("converting ", class(object), " to expected ", - "StructuralVariant format") - message(memo) - } - - available_svTypes <- paste(as.vector(object@vcfObject@svType$svtype), collapse=", ") - object <- object@vcfObject@vcfData - - ## Filter out sv calls that are not "PASS" - if (filter == TRUE) { - object <- object[FILTER=="PASS"] - } - - ## Remove large SV - if (is.null(maxSvSize) == FALSE) { - ## Get the difference in positions - temp <- suppressWarnings(data.table::rbindlist(apply(object, 1, function(x, maxSvSize){ - if (x["svtype"] == "BND" | x["svtype"] == "TRA"){ - x$diff <- maxSvSize - 1 - } else { - x$diff <- as.numeric(x["position2"]) - as.numeric(x["position"]) - } - return(x) - }, maxSvSize=maxSvSize))) - - ## Perform the subset - object <- temp[diff < maxSvSize, c(1:15)] - } - - ## Remove sv types that are not necessary - if (is.null(svType) == FALSE) { - ## Check to see if the SV type is in the data.table - ## Perform the subset if svtype is available - if (svType %in% available_svTypes) { - object <- object[svtype==svType] - } - if (!(svType %in% available_svTypes)) { - input@vcfObject@svType - memo <- paste0("Desired svtype is not found. Make sure ", - "the specified svType is one of: ", available_svTypes) - } - - } - return(object) - - }) - ###################################################### ##### Function to obtain chromosomes of interest ##### #' @rdname svData-methods @@ -433,10 +372,10 @@ setMethod(f="chrSubsetSv", } # perform the subset - remove GL and MT chromosomes - object <- object[-grep("GL", object$chromosome)] - object <- object[-grep("MT", object$chromosome)] - object <- object[-grep("GL", object$chromosome2)] - object <- object[-grep("MT", object$chromosome2)] + object <- object[!grepl("GL", object$chromosome)] + object <- object[!grepl("MT", object$chromosome)] + object <- object[!grepl("GL", object$chromosome2)] + object <- object[!grepl("MT", object$chromosome2)] ## Remove rows that have nothing to do with the desired chromosomes ## Keep DEL/DUP/INV/INS events that occur on other chromosomes that @@ -455,7 +394,15 @@ setMethod(f="chrSubsetSv", }, chromosomes=chromosomes) otherChromosomes <- unique(rbindlist(otherChromosomes)) otherChromosomes <- paste(otherChromosomes$V1, otherChromosomes$V1, sep="_") - + + ## Write message to say that only non-TRA events are shown + if (length(otherChromosomes)==0) { + memo <- paste0("No translocation events detected in the dataset.") + if (verbose){ + message(memo) + } + } + object$chr_combo <- paste(object$chromosome, object$chromosome2, sep="_") object <- object[object$chromosome %in% chromosomes | object$chromosome2 %in% chromosomes | object$chr_combo %in% otherChromosomes,] @@ -914,7 +861,7 @@ setMethod(f="adjustCentromeres", setMethod(f="getStructuralVariantWindow", signature="data.table", definition=function(object, chrData, chrCytobands, chrGap, verbose){ - object=adjustedPrimaryData + ## Print status message if (verbose) { message("Adjusting chromosome boundaries for visualization of structural variants.") @@ -933,7 +880,7 @@ setMethod(f="getStructuralVariantWindow", } ## For each of the COI-chr combination, generate a dataset to plot - chr <- coi$chromosomes[1] + #chr <- coi$chromosomes[1] finalDf <- data.table::rbindlist(apply(coi, 1, function(chr, sampleData, chrCytobands, chrGap){ ## Get rows in cohort that have sv events involving COI dataset <- sampleData[chromosome==chr | chromosome2 == chr,] @@ -952,59 +899,83 @@ setMethod(f="getStructuralVariantWindow", otherChr <- unique(c(as.character(dataset$chromosome), as.character(dataset$chromosome2))) otherChr <- as.data.table(otherChr[-which(otherChr %in% chr)]) - ## For the individual COI, go through each of the chr combination - #mateChr <- otherChr$V1[12] - temp <- data.table::rbindlist(apply(otherChr, 1, function(mateChr, chr, dataset, sampleData, chrCytobands, chrGap){ - ## Get the chromosome combination to see rows which rows of the COI dataset have the correct - ## matching of the chr and mate chr - combo <- c(paste(chr, chr, sep="_"), paste(chr, mateChr, sep="_"), - paste(mateChr, chr, sep="_"), paste(mateChr, mateChr, sep="_")) - final <- dataset[which(chr_combo %in% combo), c("chromosome", "position", "chromosome2", "position2", "direction", - "svtype", "total_read_support", "sample", "genes")] - - ## Get the chr boundaries for the two chromosomes - chrDataTemp <- chrCytobands[which(chromosome %in% c(mateChr, chr))] - - ## Figure out the order to plot the chromosomes - chrOrder <- gtools::mixedsort(unique(as.character(chrDataTemp$chromosome))) - - ## Order the chrDataTemp dataset by chrOrder - chrDataTemp$chromosome <- factor(chrDataTemp$chromosome, levels=chrOrder) - chrDataTemp <- chrDataTemp[order(chrDataTemp$chromosome)] - - ## Get the "end" for each of the chromosomes - chrLength <- data.table::rbindlist(lapply(split(chrDataTemp, f=chrDataTemp$chromosome), function(x) { - chr <- x$chromosome[1] - end <- max(x$end) - final <- data.table(chromosome=chr, chrLength=end) + ## For the individual COI, go through each of the chr combination if there are other chromosomes to plot + if (nrow(otherChr) > 0) { + #mateChr <- otherChr$V1[12] + temp <- data.table::rbindlist(apply(otherChr, 1, function(mateChr, chr, dataset, sampleData, chrCytobands, chrGap) + { + ## Get the chromosome combination to see rows which rows of the COI dataset have the correct + ## matching of the chr and mate chr + combo <- c(paste(chr, chr, sep="_"), paste(chr, mateChr, sep="_"), + paste(mateChr, chr, sep="_"), paste(mateChr, mateChr, sep="_")) + final <- dataset[which(chr_combo %in% combo), c("chromosome", "position", "chromosome2", "position2", "direction", + "svtype", "total_read_support", "sample", "genes")] + + ## Get the chr boundaries for the two chromosomes + chrDataTemp <- chrCytobands[which(chromosome %in% c(mateChr, chr))] + + ## Figure out the order to plot the chromosomes + chrOrder <- gtools::mixedsort(unique(as.character(chrDataTemp$chromosome))) + + ## Order the chrDataTemp dataset by chrOrder + chrDataTemp$chromosome <- factor(chrDataTemp$chromosome, levels=chrOrder) + chrDataTemp <- chrDataTemp[order(chrDataTemp$chromosome)] + + ## Get the "end" for each of the chromosomes + chrLength <- data.table::rbindlist(lapply(split(chrDataTemp, f=chrDataTemp$chromosome), function(x) { + chr <- x$chromosome[1] + end <- max(x$end) + final <- data.table(chromosome=chr, chrLength=end) + return(final) + })) + + ## Add the cytoband/centromere data to the "final" dataset + temp <- data.table(chromosome=chrDataTemp$chromosome, position=chrDataTemp$start, + chromosome2=chrDataTemp$chromosome, position2=chrDataTemp$end, + direction="cytoband", svtype=chrDataTemp$band, total_read_support="", + sample="", genes="") + + final <- rbind(final, temp) + + ## Add the length of the first chromosome to all of the sv calls on the second chromosome + num <- which(final$chromosome == chrLength$chromosome[2]) + final$position[num] <- final$position[num] + chrGap + chrLength$chrLength[1] + num <- which(final$chromosome2 == chrLength$chromosome[2]) + final$position2[num] <- final$position2[num] + chrGap + chrLength$chrLength[1] + + ## Get the midpoints for the dataset + final$midpoint <- (as.numeric(as.character(final$position))+ + as.numeric(as.character(final$position2)))/2 + + ## Get the chr-combo ID + final$chr_combo <- paste(chrLength$chromosome[1], chrLength$chromosome[2], sep="_") + return(final) - })) - - ## Add the cytoband/centromere data to the "final" dataset - temp <- data.table(chromosome=chrDataTemp$chromosome, position=chrDataTemp$start, - chromosome2=chrDataTemp$chromosome, position2=chrDataTemp$end, - direction="cytoband", svtype=chrDataTemp$band, total_read_support="", - sample="", genes="") - - final <- rbind(final, temp) - - ## Add the length of the first chromosome to all of the sv calls on the second chromosome - num <- which(final$chromosome == chrLength$chromosome[2]) - final$position[num] <- final$position[num] + chrGap + chrLength$chrLength[1] - num <- which(final$chromosome2 == chrLength$chromosome[2]) - final$position2[num] <- final$position2[num] + chrGap + chrLength$chrLength[1] - - ## Get the midpoints for the dataset - final$midpoint <- (as.numeric(as.character(final$position))+ - as.numeric(as.character(final$position2)))/2 - - ## Get the chr-combo ID - final$chr_combo <- paste(chrLength$chromosome[1], chrLength$chromosome[2], sep="_") + + }, + chr=chr, dataset=dataset, sampleData=sampleData, chrCytobands=chrCytobands, chrGap=chrGap)) + } + if (nrow(otherChr) == 0) { + ## Get the positions for the sv events + dataset$midpoint <- (dataset$position + dataset$position2)/2 + temp <- dataset[,c("chromosome", "position", "chromosome2", "position2", + "direction", "svtype", "total_read_support", + "sample", "genes", "midpoint", "chr_combo")] - return(final) + ## Add in the cytoband information + cytoTemp <- chrCytobands[chromosome==chr] + cyto <- data.table(chromosome=cytoTemp$chromosome, + position=cytoTemp$start, + chromosome2=cytoTemp$chromosome, + position2=cytoTemp$end, + direction="cytoband", svtype=cytoTemp$band, + total_read_support="", sample="", genes="", + midpoint=(cytoTemp$start+cytoTemp$end)/2, + chr_combo=paste(cytoTemp$chromosome, cytoTemp$chromosome, sep="_")) - }, - chr=chr, dataset=dataset, sampleData=sampleData, chrCytobands=chrCytobands, chrGap=chrGap)) + ## Combine all of the data + temp <- rbind(temp, cyto) + } return(temp) }, @@ -1116,14 +1087,16 @@ setMethod(f="buildSvPlot", ## Get chr1 data chr1OldBreaks <- round(seq(0, chr1Length, by=chr1Length/5), digits=0) chr1NewBreaks <- round(seq(0, chr1Length, by=chr1Length/5), digits=0) - chr1 <- data.table(chr=chrOrder[1], newBreaks=chr1NewBreaks, oldBreaks=chr1OldBreaks) + temp <- data.table(chr=chrOrder[1], newBreaks=chr1NewBreaks, oldBreaks=chr1OldBreaks) ## Get chr2 data - chr2Start <- min(dataset[Direction=="cytoband" & Chromosome == chrOrder[2], Position]) - chr2Length <- max(dataset[Direction=="cytoband" & Chromosome == chrOrder[2], Position2]) - chr2OldBreaks <- round(seq(chr2Start, chr2Length, by=(chr2Length-chr2Start)/5), digits=0) - chr2NewBreaks <- round(seq(0, chr2Length-chr1Length, by=(chr2Length-chr1Length)/5), digits=0) - chr2 <- data.table(chr=chrOrder[2], newBreaks=chr2NewBreaks, oldBreaks=chr2OldBreaks) - temp <- rbind(chr1, chr2) + if (length(chrOrder) > 1) { + chr2Start <- min(dataset[Direction=="cytoband" & Chromosome == chrOrder[2], Position]) + chr2Length <- max(dataset[Direction=="cytoband" & Chromosome == chrOrder[2], Position2]) + chr2OldBreaks <- round(seq(chr2Start, chr2Length, by=(chr2Length-chr2Start)/5), digits=0) + chr2NewBreaks <- round(seq(0, chr2Length-chr1Length, by=(chr2Length-chr1Length)/5), digits=0) + chr2 <- data.table(chr=chrOrder[2], newBreaks=chr2NewBreaks, oldBreaks=chr2OldBreaks) + temp <- rbind(temp, chr2) + } ## Get the start and stop for each chromosome chr1End <- chr1Length @@ -1172,6 +1145,9 @@ setMethod(f="buildSvPlot", })) chrPlot <- chrPlot + geom_polygon(data=positions, mapping=aes(x=x, y=y, group=id), fill="red") + ## Get the available SV events + availableSvTypes <- unique(dataset$SV_Type[-which(dataset$Direction=="cytoband")]) + ## Subset svWindow dataset to get DEL/DUP/INV/etc... and TRA/BND/etc... sameChrSvWindow <- dataset[SV_Type=="DEL" | SV_Type=="DUP" | SV_Type =="INV" | SV_Type == "INS"] sameChrSvWindow$SV_size <- sameChrSvWindow$Position2 - sameChrSvWindow$Position @@ -1180,12 +1156,18 @@ setMethod(f="buildSvPlot", ## Get the dataset for the gene text annotations dataset <- dataset[Direction!="cytoband"] gene_text <- dataset[,c("Midpoint", "Total_Read_Support", "gene", "SV_Type")] - gene_text$Total_Read_Support[which(gene_text$SV_Type=="TRA")] <- - as.numeric(as.character(gene_text$Total_Read_Support[which(gene_text$SV_Type=="TRA")])) + - max(as.numeric(as.character(gene_text$Total_Read_Support[which(gene_text$SV_Type=="TRA")])))*.05 - gene_text$Total_Read_Support[which(gene_text$SV_Type!="TRA")] <- - as.numeric(as.character(gene_text$Total_Read_Support[which(gene_text$SV_Type!="TRA")])) + - max(as.numeric(as.character(gene_text$Total_Read_Support[which(gene_text$SV_Type!="TRA")])))*.05 + ## If there is sv events for translocations, get the gene text + if (availableSvTypes %in% c("TRA", "BND")) { + gene_text$Total_Read_Support[which(gene_text$SV_Type=="TRA")] <- + as.numeric(as.character(gene_text$Total_Read_Support[which(gene_text$SV_Type=="TRA")])) + + max(as.numeric(as.character(gene_text$Total_Read_Support[which(gene_text$SV_Type=="TRA")])))*.05 + } + ## If there is sv events for non-translocations, get the gene text + if (availableSvTypes %in% c("DEL", "DUP", "INV", "INS")) { + gene_text$Total_Read_Support[which(gene_text$SV_Type!="TRA")] <- + as.numeric(as.character(gene_text$Total_Read_Support[which(gene_text$SV_Type!="TRA")])) + + max(as.numeric(as.character(gene_text$Total_Read_Support[which(gene_text$SV_Type!="TRA")])))*.05 + } gene_text$Total_Read_Support <- as.numeric(gene_text$Total_Read_Support) gene_text <- gene_text[!duplicated(gene_text)] if (!is.null(plotSpecificGene)) { @@ -1206,77 +1188,98 @@ setMethod(f="buildSvPlot", } } - ## Get the start/end of chromosomes in the dataset - beziers <- data.frame(data.table::rbindlist(apply(diffChrSvWindow, 1, function(x) { - leftEnd <- data.table(position=as.numeric(x[2]), total_read_support=0, point="end", + + ########################################################## + ##### Plot the translocation data ######################## + ########################################################## + ## Get the start/end of chromosomes in the dataset if there is translocation data + ## TODO: Allow this to occur for intra-chromosomal translocations + if (availableSvTypes %in% c("TRA", "BND")){ + beziers <- data.frame(data.table::rbindlist(apply(diffChrSvWindow, 1, function(x) { + leftEnd <- data.table(position=as.numeric(x[2]), total_read_support=0, point="end", + type="cubic", group=as.character(x[2]), Sample=x[8], SV_Type=x[6], + Direction=x[5], sampleColor=x[13]) + top <- data.table(position=as.numeric(x[10]), total_read_support=as.numeric(x[7])*2, point="control", type="cubic", group=as.character(x[2]), Sample=x[8], SV_Type=x[6], Direction=x[5], sampleColor=x[13]) - top <- data.table(position=as.numeric(x[10]), total_read_support=as.numeric(x[7])*2, point="control", - type="cubic", group=as.character(x[2]), Sample=x[8], SV_Type=x[6], - Direction=x[5], sampleColor=x[13]) - rightEnd <- data.table(position=as.numeric(x[4]), total_read_support=0, point="end", - type="cubic", group=as.character(x[2]), Sample=x[8], SV_Type=x[6], - Direction=x[5], sampleColor=x[13]) - final <- rbind(leftEnd, top, rightEnd) - return(final) - }))) - beziers <- beziers[!duplicated(beziers),] - - beziers$Sample <- factor(beziers$Sample, levels=gtools::mixedsort(unique(beziers$Sample))) - - ############################################################## - ##### Plot the translocation data ############################ - ############################################################## - traPlot <- ggplot() + geom_bezier(data=beziers, - mapping=aes_string(x='position', y='total_read_support', group='group', - color='Sample', linetype='Direction')) + - facet_grid(SV_Type ~ ., scales="fixed", space="fixed") + - scale_x_continuous(expand=c(0,0), limits=c(-5000000, max(coi$Position2) + 5000000), - breaks=temp$oldBreaks, labels=temp$newBreaks) + - scale_y_continuous() + - geom_vline(data=boundaries, aes(xintercept=start), linetype=2, color="Grey") + - geom_vline(data=boundaries, aes(xintercept=end), linetype=2, color="Grey") + - theme_bw() + plotALayers + ylab("Total Read Support") + - geom_point(data=beziers[which(beziers$point=="control"),c("position","total_read_support", "Sample")], - aes(x=position, y=total_read_support/2, color=Sample)) - if (plotTraGenes & !is.null(gene_text)) { - traPlot <- traPlot + geom_text(data=gene_text[SV_Type%in%c("TRA", "BND")], - mapping=aes_string(x='Midpoint', y='Total_Read_Support', label='gene')) + rightEnd <- data.table(position=as.numeric(x[4]), total_read_support=0, point="end", + type="cubic", group=as.character(x[2]), Sample=x[8], SV_Type=x[6], + Direction=x[5], sampleColor=x[13]) + final <- rbind(leftEnd, top, rightEnd) + return(final) + }))) + beziers <- beziers[!duplicated(beziers),] + + beziers$Sample <- factor(beziers$Sample, levels=gtools::mixedsort(unique(beziers$Sample))) + + ## Plot the translocation data + traPlot <- ggplot() + geom_bezier(data=beziers, + mapping=aes_string(x='position', y='total_read_support', group='group', + color='Sample', linetype='Direction')) + + facet_grid(SV_Type ~ ., scales="fixed", space="fixed") + + scale_x_continuous(expand=c(0,0), limits=c(-5000000, max(coi$Position2) + 5000000), + breaks=temp$oldBreaks, labels=temp$newBreaks) + + scale_y_continuous() + + geom_vline(data=boundaries, aes(xintercept=start), linetype=2, color="Grey") + + geom_vline(data=boundaries, aes(xintercept=end), linetype=2, color="Grey") + + theme_bw() + plotALayers + ylab("Total Read Support") + + geom_point(data=beziers[which(beziers$point=="control"),c("position","total_read_support", "Sample")], + aes(x=position, y=total_read_support/2, color=Sample)) + if (plotTraGenes & !is.null(gene_text)) { + traPlot <- traPlot + geom_text(data=gene_text[SV_Type%in%c("TRA", "BND")], + mapping=aes_string(x='Midpoint', y='Total_Read_Support', label='gene')) + } + ## Assign colors to sample + traPlot <- traPlot + scale_color_manual(name="Sample", values=sampleColor) } - ## Assign colors to sample - traPlot <- traPlot + scale_color_manual(name="Sample", values=sampleColor) ############################################################## ##### Plot the non TRA sv events ############################# ############################################################## - maxY <- max(as.numeric(as.character(sameChrSvWindow$Total_Read_Support))) + 30 - sameChrSvWindow$Total_Read_Support <- as.numeric(sameChrSvWindow$Total_Read_Support) - nonTraPlot <- ggplot() + geom_point(data=sameChrSvWindow, - mapping=aes_string(x='Midpoint', y='Total_Read_Support', - color="Sample"), size=2.5, alpha=0.75) + - facet_grid(SV_Type ~ ., scales="fixed", space="fixed") + - scale_x_continuous(expand=c(0,0), limits=c(-5000000, max(coi$Position2) + 5000000), - breaks=temp$oldBreaks, labels=temp$newBreaks) + - scale_y_continuous(limits=c(0,maxY+maxY*0.05)) + - geom_vline(data=boundaries, aes(xintercept=start), linetype=2, color="Grey") + - geom_vline(data=boundaries, aes(xintercept=end), linetype=2, color="Grey") + - theme_bw() + plotCLayers + ylab("Total Read Support") + xlab("Position") - if (plotOtherGenes & !is.null(gene_text)) { - nonTraPlot <- nonTraPlot + geom_text(data=gene_text[SV_Type%in%c("DEL", "DUP", "INV", "INS")], - mapping=aes_string(x='Midpoint', y='Total_Read_Support', label='gene')) + if (availableSvTypes %in% c("DEL", "DUP", "INV", "INS")) { + maxY <- max(as.numeric(as.character(sameChrSvWindow$Total_Read_Support))) + 30 + sameChrSvWindow$Total_Read_Support <- as.numeric(sameChrSvWindow$Total_Read_Support) + nonTraPlot <- ggplot() + geom_point(data=sameChrSvWindow, + mapping=aes_string(x='Midpoint', y='Total_Read_Support', + color="Sample"), size=2.5, alpha=0.75) + + facet_grid(SV_Type ~ ., scales="fixed", space="fixed") + + scale_x_continuous(expand=c(0,0), limits=c(-5000000, max(coi$Position2) + 5000000), + breaks=temp$oldBreaks, labels=temp$newBreaks) + + scale_y_continuous(limits=c(0,maxY+maxY*0.05)) + + geom_vline(data=boundaries, aes(xintercept=start), linetype=2, color="Grey") + + geom_vline(data=boundaries, aes(xintercept=end), linetype=2, color="Grey") + + theme_bw() + plotCLayers + ylab("Total Read Support") + xlab("Position") + if (plotOtherGenes & !is.null(gene_text)) { + nonTraPlot <- nonTraPlot + geom_text(data=gene_text[SV_Type%in%c("DEL", "DUP", "INV", "INS")], + mapping=aes_string(x='Midpoint', y='Total_Read_Support', label='gene')) + } + ## Assign colors to sample + nonTraPlot <- nonTraPlot + scale_color_manual(name="Sample", values=sampleColor) } - ## Assign colors to sample - nonTraPlot <- nonTraPlot + scale_color_manual(name="Sample", values=sampleColor) ############################################################## ##### Combine the 3 plots #################################### ############################################################## - traPlot <- ggplotGrob(traPlot) - chrPlot <- ggplotGrob(chrPlot) - nonTraPlot <- ggplotGrob(nonTraPlot) - ## obtain the max width for relevant plots - plotList <- list(traPlot, chrPlot, nonTraPlot) + if (nrow(diffChrSvWindow) > 0 & nrow(sameChrSvWindow) > 0) { + traPlot <- ggplotGrob(traPlot) + chrPlot <- ggplotGrob(chrPlot) + nonTraPlot <- ggplotGrob(nonTraPlot) + plotList <- list(traPlot, chrPlot, nonTraPlot) + sectionHeightsFinal <- sectionHeights + } + if (nrow(diffChrSvWindow) > 0 & nrow(sameChrSvWindow) == 0) { + traPlot <- ggplotGrob(traPlot) + chrPlot <- ggplotGrob(chrPlot) + plotList <- list(traPlot, chrPlot) + sectionHeightsFinal <- c(sectionHeights[1], sectionHeights[2]) + } + if (nrow(diffChrSvWindow) == 0 & nrow(sameChrSvWindow) > 0) { + chrPlot <- ggplotGrob(chrPlot) + nonTraPlot <- ggplotGrob(nonTraPlot) + plotList <- list(chrPlot, nonTraPlot) + sectionHeightsFinal <- c(sectionHeights[2], sectionHeights[3]) + } plotList <- plotList[lapply(plotList, length) > 0] plotWidths <- lapply(plotList, function(x) x$widths) maxWidth <- do.call(grid::unit.pmax, plotWidths) @@ -1287,7 +1290,8 @@ setMethod(f="buildSvPlot", } ## Arrange the final plot - p1 <- do.call(gridExtra::arrangeGrob, c(plotList, list(ncol=1, heights=sectionHeights))) + p1 <- do.call(gridExtra::arrangeGrob, + c(plotList, list(ncol=1, heights=sectionHeightsFinal))) plot(p1) return(p1) diff --git a/R/VariantCallFormat-class.R b/R/VariantCallFormat-class.R index 578e381..de36f97 100644 --- a/R/VariantCallFormat-class.R +++ b/R/VariantCallFormat-class.R @@ -50,7 +50,7 @@ setClass("VariantCallFormat", #' @importFrom data.table rbindlist #' @importFrom data.table data.table #' @export -extractVariantCallFormat <- function(path=NULL, data=NULL, version="auto", svCaller=NULL, paired=paired, +VariantCallFormat <- function(path=NULL, data=NULL, version="auto", svCaller=NULL, paired=paired, tumorColumn=tumorColumn, verbose=FALSE) { ## Check if both path and data are both null @@ -219,3 +219,66 @@ extractVariantCallFormat <- function(path=NULL, data=NULL, version="auto", svCal ## Initialize the object new("VariantCallFormat", path=path, vcfObject=vcfObject, version=as.character(version)) } + +################################################################################ +####################### Method function definitions ############################ + +#' @rdname getVcfData-methods +#' @name getVcfData +#' @aliases getVcfData +#' @noRd +#' @importFrom data.table data.table +setMethod(f="getVcfData", + signature="VariantCallFormat", + definition=function(object, filter, maxSvSize, svType, + verbose, ...) { + + ## Print status message + if (verbose) { + memo <- paste0("converting ", class(object), " to expected ", + "StructuralVariant format") + message(memo) + } + + object <- object@vcfObject@vcfData + + ## Filter out sv calls that are not "PASS" + if (filter == TRUE) { + object <- object[FILTER=="PASS"] + } + + ## Remove large SV + if (is.null(maxSvSize) == FALSE) { + ## Get the difference in positions + temp <- suppressWarnings(data.table::rbindlist(apply(object, 1, function(x, maxSvSize){ + if (x["svtype"] == "BND" | x["svtype"] == "TRA"){ + x$diff <- maxSvSize - 1 + } else { + x$diff <- as.numeric(x["position2"]) - as.numeric(x["position"]) + } + return(x) + }, maxSvSize=maxSvSize))) + + ## Perform the subset + object <- temp[diff < maxSvSize, c(1:15)] + } + + ## Remove sv types that are not necessary + available_svTypes <- unlist(as.vector(object$svtype)) + if (length(svType) > 0) { + ## Check to see if the SV type is in the data.table + ## Perform the subset if svtype is available + if (all(svType %in% available_svTypes)) { + object <- object[svtype %in% svType] + } + if (!all(svType %in% available_svTypes)) { + memo <- paste0("Desired svtype is not found. Make sure ", + "the specified svType is one of: ", + paste(available_svTypes, collapse=", ")) + stop(memo) + } + } + + ## Stop the + return(object) + }) From f0c0591c051d4e02365bacbc905bf3700810d78d Mon Sep 17 00:00:00 2001 From: Jason Kunisaki Date: Mon, 30 Apr 2018 17:11:55 -0500 Subject: [PATCH 13/21] Structural Variant Input Parameter Checks --- NAMESPACE | 2 +- R/AllGenerics.R | 11 + R/StructuralVariant-class.R | 686 +++++++++++++++--- R/VCF_Virtual-class.R | 30 +- R/VariantCallFormat-class.R | 111 ++- ...ng_Large_Scale_Chromosomal_Aberrations.Rmd | 129 ++++ 6 files changed, 836 insertions(+), 133 deletions(-) create mode 100644 vignettes/Visualizing_Large_Scale_Chromosomal_Aberrations.Rmd diff --git a/NAMESPACE b/NAMESPACE index b57bee4..3c5f1ec 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -10,6 +10,7 @@ export(StructuralVariant) export(TvTi) export(VEP) export(VarScanFormat) +export(VariantCallFormat) export(Waterfall) export(cnFreq) export(cnLoh) @@ -32,7 +33,6 @@ exportClasses(Rainfall) exportClasses(StructuralVariant) exportClasses(VEP) exportClasses(VarScanFormat) -exportClasses(VariantCallFormat) exportClasses(Waterfall) exportClasses(cnLoh) exportClasses(lohSpec) diff --git a/R/AllGenerics.R b/R/AllGenerics.R index 9b033d6..82b88dd 100644 --- a/R/AllGenerics.R +++ b/R/AllGenerics.R @@ -942,4 +942,15 @@ setGeneric( setGeneric( name="getVcfData", def=function(object, ...){standardGeneric("getVcfData")} +) + +#' Method checkSvInputParameters +#' +#' @name checkSvInputParameters +#' @rdname checkSvInputParameters-methods +#' @param ... additional arguments to passed +#' @noRd +setGeneric( + name="checkSvInputParameters", + def=function(object, ...){standardGeneric("checkSvInputParameters")} ) \ No newline at end of file diff --git a/R/StructuralVariant-class.R b/R/StructuralVariant-class.R index 61fbdbc..16f13e0 100644 --- a/R/StructuralVariant-class.R +++ b/R/StructuralVariant-class.R @@ -18,7 +18,7 @@ setClass("StructuralVariant", representation=representation(svData="data.table", geneData="data.table", - svPlots="list"), + svPlots="svPlots"), validity=function(object) { }) @@ -61,7 +61,7 @@ setClass("StructuralVariant", #' @param plotHeight Integer for height of SV visualizations #' @param verbose Boolean specifying if status messages should be reported #' @export -StructuralVariant <- function(input, BSgenome=NULL, filter=TRUE, svType=NULL, +StructuralVariant <- function(input, BSgenome=NULL, filterSvCalls=TRUE, svType=NULL, svOrder=c("TRA", "BND", "DEL", "DUP", "INV", "INS"), maxSvSize=NULL, sample=NULL, chromosomes=NULL, ensembl=ensembl, attributes=attributes, filters=filters, @@ -70,20 +70,46 @@ StructuralVariant <- function(input, BSgenome=NULL, filter=TRUE, svType=NULL, plotOtherGenes=FALSE, chrGap=5000000, genome="hg19", cytobandColor=c("White", "Grey"), sampleColor=NULL, verbose=FALSE, plotALayers=NULL, - plotBLayers=NULL, plotCLayers=NULL) { + plotBLayers=NULL, plotCLayers=NULL, sectionHeights=c(0.4, 0.1, 0.5)) { + ## Check the input parameters + inputParameters <- checkSvInputParameters(object=object, BSgenome=BSgenome, filterSvCalls=filterSvCalls, + svType=svType, svOrder=svOrder, + maxSvSize=maxSvSize, sample=sample, chromosomes=chromosomes, + ensembl=ensembl, attributes=attributes, + filters=filters, chrGap=chrGap, annotate=annotate, + geneAnnotationFlank=geneAnnotationFlank, genome=genome, + plotSV=plotSV, plotSpecificGene=plotSpecificGene, + plotTraGenes=plotTraGenes, plotOtherGenes=plotOtherGenes, + cytobandColor=cytobandColor, + plotALayers=plotALayers, plotBLayers=plotBLayers, + plotCLayers=plotCLayers, sectionHeights=sectionHeights, + sampleColor=sampleColor, verbose=verbose) + ## Calculate all data for the plots - svDataset <- svData(object=input, BSgenome=BSgenome, filter=filter, svType=svType, svOrder=svOrder, - maxSvSize=maxSvSize, sample=sample, chromosomes=chromosomes, - ensembl=ensembl, attributes=attributes, filters=filters, chrGap=chrGap, annotate=annotate, - geneAnnotationFlank=geneAnnotationFlank, genome=genome, verbose=verbose) + svDataset <- svData(object=input, BSgenome=inputParameters@BSgenome, + filterSvCalls=inputParameters@filterSvCalls, + svType=inputParameters@svType, svOrder=inputParameters@svOrder, + maxSvSize=inputParameters@maxSvSize, sample=inputParameters@sample, + chromosomes=inputParameters@chromosomes, + ensembl=inputParameters@ensembl, attributes=inputParameters@attributes, + filters=inputParameters@filters, chrGap=inputParameters@chrGap, + annotate=inputParameters@annotate, + geneAnnotationFlank=inputParameters@geneAnnotationFlank, + genome=inputParameters@genome, verbose=inputParameters@verbose) ## Create the plots from svData - structuralVariantPlots <- svPlots(object=svDataset, plotSV=plotSV, plotSpecificGene=plotSpecificGene, - plotTraGenes=plotTraGenes, plotOtherGenes=plotOtherGenes, cytobandColor=cytobandColor, - plotALayers=plotALayers, plotBLayers=plotBLayers, - plotCLayers=plotCLayers, sectionHeights=sectionHeights, - sample=sample, sampleColor=sampleColor, verbose=verbose) + structuralVariantPlots <- svPlots(object=svDataset, plotSV=inputParameters@plotSV, + plotSpecificGene=inputParameters@plotSpecificGene, + plotTraGenes=inputParameters@plotTraGenes, + plotOtherGenes=inputParameters@plotOtherGenes, + cytobandColor=inputParameters@cytobandColor, + plotALayers=inputParameters@plotALayers, + plotBLayers=inputParameters@plotBLayers, + plotCLayers=inputParameters@plotCLayers, + sectionHeights=inputParameters@sectionHeights, + sample=inputParameters@sample, sampleColor=inputParameters@sampleColor, + verbose=inputParameters@verbose) ## Intialize the object new("StructuralVariant", svData=getData(object=svDataset, name="primaryData"), @@ -93,6 +119,487 @@ StructuralVariant <- function(input, BSgenome=NULL, filter=TRUE, svType=NULL, #!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Private Classes !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!# +#' Private Class svInputParameters +#' +#' An S4 class to check input parameters of the StructuralVariant function +#' @name svInputParameters-class +#' @noRd +setClass("svInputParameters", + representation=representation(BSgenome="BSgenome", filterSvCalls="logical", svType="character", + svOrder="character", maxSvSize="numeric", + sample="character", chromosomes="character", + ensembl="Mart", attributes="character", + filters="character", chrGap="numeric", + annotate="logical", geneAnnotationFlank="numeric", + genome="character", plotSV="logical", + plotSpecificGene="character", plotTraGenes="logical", + plotOtherGenes="logical", cytobandColor="character", + plotALayers="list", plotBLayers="list", + plotCLayers="list", sectionHeights="numeric", + sampleColor="character", verbose="logical"), + validity=function(object){ + + }) + +#' Constructor for the svInputParameters class +#' +#' @name svInputParameters +#' @rdname svInputParameters-class +#' @importFrom karyoploteR getCytobands +#' @noRd +checkSvInputParameters <- function(object, BSgenome, filterSvCalls, svType, svOrder, maxSvSize, + sample, chromosomes, ensembl, attributes, + filters, chrGap, annotate, geneAnnotationFlank, + genome, plotSV, plotSpecificGene, plotTraGenes, + plotOtherGenes, cytobandColor, plotALayers, plotBLayers, + plotCLayers, sectionHeights, sampleColor, verbose) { + + ##### Check verbose parameter ##### + ## Check to see if verbose is a booelean + if (!is.logical(verbose) | is.null(verbose)) { + memo <- paste0("The verbose parameter is not a boolean (T/F). Coercing verbose to be FALSE...") + message(memo) + verbose <- FALSE + } + + ##### Check BSgenome parameter ##### + ## Check to see if BSgenome is a BSgenome + if (is.null(BSgenome)) { + memo <- paste("BSgenome object is not specified, whole chromosomes", + "will not be plotted, this is not recommended!") + warning(memo) + } else if (is(BSgenome, "BSgenome")) { + memo <- paste("BSgenome passed object validity checks") + message(memo) + } else { + memo <- paste("class of the BSgenome object is", class(BSgenome), + "should either be of class BSgenome or NULL", + "setting this to param to NULL") + warning(memo) + BSgenome <- NULL + } + + ##### Check filterSvCalls parameter ##### + ## Check to see if filterSvCalls is a boolean + if (is.null(filterSvCalls) | !is.logical(filterSvCalls)) { + memo <- paste0("The filterSvCalls parameter is not a boolean (T/F). Coercing filterSvCalls to be FALSE...") + message(memo) + filterSvCalls <- FALSE + } + + ##### Check svType parameter ##### + ## Check if it null + if (is.null(svType)) { + svType <- as.character(object@vcfObject@svType$svtype) + memo <- paste0("svType variable cannot be NULL. Using all of the sv types ", + "available in the sv dataset") + message(memo) + } + ## check if svType is a character vector + if (!is.character(svType)) { + memo <- paste0("svType variable not of the character class. Attempting to coerce.") + svType <- as.character(svType) + message(memo) + } + + ##### Check svOrder parameter ##### + ## Check if svOrder is NULL + if (is.null(svOrder)) { + svOrder <- svType + memo <- paste0("svOrder variable cannot be NULL. Setting the deleterious order ", + "of sv events to that designated in the svType: ", + paste(svType, collapse=", ")) + message(memo) + } + if (!is.character(svOrder)) { + memo <- paste0("svOrder variable not of the character class. Attempting to coerce.") + svOrder <- as.character(svOrder) + message(memo) + } + + ##### Check maxSvSize parameter ##### + ## Check if maxSvSize is NULL + if (is.null(maxSvSize)) { + maxSvSize <- 0 + memo <- paste0("maxSvSize parameter cannot be NULL. Setting the maxSvSize value to 0.") + message(memo) + } + ## Check if maxSvSize is numeric + if (!is.numeric(maxSvSize)) { + memo <- paste0("maxSvSize variable not of the numeric class. Attempting to coerce.") + maxSvSize <- as.numeric(maxSvSize) + message(memo) + } + + ##### Check sample parameter ##### + ## Check is sample is NULL + if (is.null(sample)) { + sample <- unique(object@vcfObject@sample$sample) + memo <- paste0("Sample parameter cannot be NULL. All samples will be plotted.") + } + ## Check if sample is a character vector + if (!is.character(sample)) { + memo <- paste0("sample variable not of the character class. Attempting to coerce.") + sample <- as.character(sample) + message(memo) + } + + ##### Check chromosomes parameter ##### + ## Check is chromosomes is NULL + if (is.null(chromosomes)) { + chromosomes <- paste("chr", seq(1:22), sep="") + memo <- paste0("chromosomes parameter cannot be NULL. Using all autosomes...") + message(memo) + } + ## Check if chromosomes is a character vector + if (!is.character(chromosomes)) { + memo <- paste0("chromosomes variable not of the character class. Attempting to coerce.") + chromosomes <- as.character(chromosomes) + message(memo) + } + ## Check if it has the "chr" prefix + # Check to see if the chromosomes variable has "chr" in front if not NULL, autosomes, or all + if (all(chromosomes!="autosomes") & all(chromosomes!="all")) { + if (!all(grepl("^chr", chromosomes))) { + if (verbose) { + memo <- paste0("Did not detect the prefix chr in the chromosomes specified ", + "in the `chromosomes` variable... adding prefix") + message(memo) + chromosomes <- paste("chr", chromosomes, sep="") + } + } else if (all(grepl("^chr", chromosomes))) { + if (verbose) { + memo <- paste0("Detected chr in the `chromosomes` variable...", + "proceeding") + message(memo) + } + } else { + memo <- paste0("Detected unknown or mixed prefixes in the `chromosomes`` variable", + " colum of object... should either be chr or non (i.e.) chr1 or 1") + message(memo) + } + } + ##### Check annotate parameter ##### + ## Check if annotate is a boolean + if (!is.logical(annotate) | is.null(annotate)) { + memo <- paste0("The annotate parameter is not a boolean (T/F). Coercing annotate to be FALSE...") + message(memo) + annotate <- FALSE + } + ##### Check ensembl parameter ##### + ## Check if ensembl is of class "mart" + if (is.null(ensembl)) { + memo <- paste("ensembl object cannot be NULL if SV annotations are desired, ", + "in which case, the ensembl object must be of class Mart...") + if (!annotate) { + warning(memo) + } + if (annotate) { + stop(memo) + } + } + else if (is(ensembl, "Mart")) { + memo <- paste("ensembl passed object validity checks") + message(memo) + } + else { + memo <- paste("class of the ensembl object is", class(ensembl), + "should either be of class ensembl or NULL", + "setting this to param to NULL and will not perform ", + "sv annotations.") + warning(memo) + ensembl <- NULL + annotate <- FALSE + + } + + + ##### Check if attributes and filters are valid ##### + if (annotate) { + ## If ensembl is not NULL, check if these are character vectors + if (!is.null(ensembl) & (!is.character(attributes))) { + if (is.null(attributes)) { + memo <- paste0("If annotations are desired, the attributes parameter ", + "cannot be NULL. These values are used to specify the ouput ", + "for biomaRt annotations.") + stop(memo) + } + memo <- paste0("attributes variable not of the character class. Attempting to coerce.") + attributes <- as.character(attributes) + message(memo) + } + if (!is.null(ensembl) & (!is.character(filters))) { + if (is.null(filters)) { + memo <- paste0("If annotations are desired, the filters parameter ", + "cannot be NULL. These values are used to specify the input ", + "for biomaRt annotations.") + stop(memo) + } + memo <- paste0("filters variable not of the character class. Attempting to coerce.") + filters <- as.character(filters) + message(memo) + } + + ## If ensembl is not NULL, check that these are valid inputs for getBM + if (!is.null(ensembl)) { + temp <- data.table(listAttributes(mart=ensembl)) + if (!all(attributes %in% temp$name)) { + `%nin%` = Negate(`%in%`) + discrepantAttributes <- attributes[which(attributes %nin% temp$name)] + memo <- paste0("The following attributes: ", paste(discrepantAttributes, collapse="|"), + " are not valid inputs for the designated ensembl database. Please run ", + "biomaRt::listAttributes(ensembl) to get valid attributes.") + stop(memo) + } + temp <- data.table(listFilters(mart=ensembl)) + if (!all(filters %in% temp$name)) { + `%nin%` = Negate(`%in%`) + discrepantFilters <- filters[which(filters %nin% temp$name)] + memo <- paste0("The following filters: ", paste(discrepantFilters, collapse="|"), + " are not valid inputs for the designated ensembl database. Please run ", + "biomaRt::listFilters(ensembl) to get valid filters") + stop(memo) + } + } + + ## If ensembl is NULL, set these variables to NULL + if (is.null(ensembl)) { + attributes <- NULL + filters <- NULL + } + } + + ##### Check chrGap parameter ##### + ## Check if chrGap is NULL + if (is.null(chrGap)) { + chrGap <- 5000000 + memo <- paste0("chrGap variable cannot be NULL. Using the default value of 5,000,000.") + } + ## Check if chrGap is numeric + if (!is.numeric(chrGap)) { + memo <- paste0("chrGap variable not of the numeric class. Attempting to coerce.") + chrGap <- as.numeric(chrGap) + message(memo) + } + + ##### Check geneAnnotationFlank parameter ##### + ## Check if geneAnnotationFlank is NULL + if (is.null(geneAnnotationFlank)) { + geneAnnotationFlank <- 10000 + memo <- paste0("geneAnnotationFlank variable cannot be NULL. Setting the variable's ", + "value to 10,000 base pairs.") + message(memo) + } + ## Check if geneAnnotationFlank is numeric and is greater than 0 + if (!is.numeric(geneAnnotationFlank)) { + memo <- paste0("geneAnnotationFlank variable not of the numeric class. Attempting to coerce.") + geneAnnotationFlank <- as.numeric(geneAnnotationFlank) + message(memo) + if (geneAnnotationFlank < 0) { + memo <- paste0("geneAnnotationFlank cannot be a negative number. Changing ", + "geneAnnotationFlank to be 0.") + message(memo) + geneAnnotationFlank <- 0 + } + } + + ##### Check genome parameter ##### + ## Check if genome is not NULL + if (is.null(genome)) { + memo <- paste0("The genome variable cannot be NULL. Valid options are those used by ", + "the karyoploteR package (e.g. hg19, mm10, etc...)") + stop(memo) + + } + ## Check if genome is of length 1 + if (length(genome) > 1) { + memo <- paste0("The genome variable must be of length 1. Using the first value.") + genome <- genome[1] + message(memo) + } + ## Check if genome is a character + if (!is.character(genome) & !is.null(genome)) { + memo <- paste0("genome variable not of the character class. Attempting to coerce.") + genome <- as.character(genome) + message(memo) + } + ## Check if the genome exists in KaryoploteR + temp <- suppressMessages(getCytobands(genome)) + if (nrow(as.data.table(temp@seqnames))==0) { + memo <- paste0("The inputted genome is not available in the karyoploteR package, ", + "which is used to generate the cytoband positions... Please submit a request to the ", + "karyoploteR github page: https://github.com/bernatgel/karyoploteR") + stop(memo) + } + + ##### Check plotSV parameter ##### + ## Check to see if filter is a boolean + if (!is.logical(plotSV)) { + memo <- paste0("plotSV parameter is not a boolean (T/F). Coercing plotSpecificGene to be FALSE...") + plotSV <- FALSE + message(memo) + } + + ##### Check plotSpecificGene parameter ##### + ## Check if plotSpecificGene is NULL + if (is.null(plotSpecificGene)) { + plotSpecificGene <- "" + } + ## Check to see if plotSpecificGene is a booelean + if (!is.character(plotSpecificGene)) { + memo <- paste0("The plotSpecificGene variable not of the character class. Attempting to coerce...") + message(memo) + plotSpecificGene <- as.character(plotSpecificGene) + } + ##### Check plotTraGenes parameter ##### + ## Check to see if plotTraGenes is a booelean + if (!is.logical(plotTraGenes)) { + memo <- paste0("The plotTraGenes parameter is not a boolean (T/F). Coercing plotTraGenes to be FALSE...") + message(memo) + plotTraGenes <- FALSE + } + ##### Check plotOtherGenes parameter ##### + ## Check to see if plotOtherGenes is a booelean + if (!is.logical(plotOtherGenes)) { + memo <- paste0("The plotOtherGenes parameter is not a boolean (T/F). Coercing plotOtherGenes to be FALSE...") + message(memo) + plotOtherGenes <- FALSE + } + + ##### Check cytobandColor parameter ##### + ## Check if it is a character vector + if (is.null(cytobandColor)) { + memo <- paste0("cytobandColor was set to NULL. Setting the colors to Dark grey and light grey.") + message(memo) + cytobandColor <- c("Dark Grey", "Light Grey") + } + if (!is.character(cytobandColor)) { + memo <- paste0("cytobandColor variable not of the character class. Attempting to coerce.") + cytobandColor <- as.character(cytobandColor) + message(memo) + } + ## Check if desired colors are valid + areColors <- function(x) { + sapply(x, function(X) { + tryCatch(is.matrix(col2rgb(X)), + error = function(e) FALSE) + }) + } + if (any(areColors(cytobandColor) == FALSE)) { + ## Get the invalid color + nonColor <- cytobandColor[which(data.table(areColors(cytobandColor))$V1==FALSE)] + memo <- paste0("The ", nonColor, " designated in the cytobandColor parameter is not a valid color. ", + "Making the cytoband colors dark grey and light grey.") + } + + ##### Check sampleColor parameter ##### + ## Check if sampleColor is NULL + if (is.null(sampleColor)) { + ## Set the sampleColor to be of the same length as the number of samples + sampleColor <- rainbow(length(sample)) + memo <- paste0("sampleColor parameter cannot be NULL...attempting to generate distinctive colors.") + message(memo) + } + if (!is.null(sampleColor)) { + ## Check if it is a character vector + if (!is.character(sampleColor)) { + memo <- paste0("sampleColor variable not of the character class. Attempting to coerce.") + sampleColor <- as.character(sampleColor) + message(memo) + } + + ## Check if desired colors are valid + areColors <- function(x) { + sapply(x, function(X) { + tryCatch(is.matrix(col2rgb(X)), + error = function(e) FALSE) + }) + } + if (any(areColors(sampleColor) == FALSE)) { + ## Get the invalid color + nonColor <- sampleColor[which(data.table(areColors(sampleColor))$V1==FALSE)] + memo <- paste0("The ", nonColor, " designated in the sampleColor parameter is not a valid color. ", + "Making the cytoband colors dark grey and light grey.") + } + + ## If sampleColor is not NULL, check if it's length is the same as + ## the desired number of samples + if (length(sampleColor) != length(sample)) { + memo <- paste0("The number of colors for each sample (designated with the sampleColor variable) ", + "does not equal the number of samples in the sv dataset (n=", length(sample), ") .") + stop(memo) + } + } + + ##### Check plotALayers, plotBLayers, and plotC Layers parameter ##### + checkPlotLayer <- function(plotLayer, name) { + if(!is.null(plotLayer)){ + if(!is.list(plotLayer)){ + memo <- paste(name, " is not a list", sep="") + stop(memo) + } + + if(any(!unlist(lapply(plotLayer, function(x) ggplot2::is.ggproto(x) | ggplot2::is.theme(x) | is(x, "labels"))))){ + memo <- paste(name, " is not a list of ggproto or ", + "theme objects... setting plotALayers to NULL", sep="") + warning(memo) + plotLayer <- NULL + } + } + return(plotLayer) + } + plotALayers <- checkPlotLayer(plotLayer=plotALayers, "plotALayers") + plotBLayers <- checkPlotLayer(plotLayer=plotBLayers, "plotBLayers") + plotCLayers <- checkPlotLayer(plotLayer=plotCLayers, "plotCLayers") + ##### Check sectionHeights parameter ##### + ## Check if it not NULL + if (is.null(sectionHeights)) { + sectionHeights <- c(0.4, 0.1, 0.5) + memo <- paste0("sectionHeights variable cannot be NULL. Using default values.") + message(memo) + } + + ## Check that values are numeric + if (!is.numeric(sectionHeights)) { + memo <- paste0("sectionHeights valures are not class numeric. Attempting to coerce...") + message(memo) + sectionHeights <- as.numeric(sectionHeights) + } + + ## Check that the values are > 0 + if (any(sectionHeights<0)) { + memo <- paste0("sectionHeights cannot be a negative value. Using default values.") + message(memo) + sectionHeights <- c(0.4, 0.1, 0.5) + } + + ## Check that there are 3 values in the variable + if (length(sectionHeights)!=3) { + memo <- paste0("3 values must be supplied to the sectionHeights parameter, which specifies the ", + "relative height of the plot for translocations, the chromosomes, and non-translocations ", + "respectively.") + message(memo) + sectionHeights <- c(0.4, 0.1, 0.5) + } + + ## Check that the values sum up to 1 + if (sum(sectionHeights)!=1) { + memo <- paste0("sectionHeight values do not equal 1. Using default values.") + message(memo) + sectionHeights <- c(0.4, 0.1, 0.5) + } + + new("svInputParameters", BSgenome=BSgenome, filterSvCalls=filterSvCalls, + svType=svType, svOrder=svOrder, + maxSvSize=maxSvSize, sample=sample, chromosomes=chromosomes, + ensembl=ensembl, attributes=attributes, filters=filters, chrGap=chrGap, annotate=annotate, + geneAnnotationFlank=geneAnnotationFlank, genome=genome, plotSV=plotSV, plotSpecificGene=plotSpecificGene, + plotTraGenes=plotTraGenes, plotOtherGenes=plotOtherGenes, cytobandColor=cytobandColor, + plotALayers=plotALayers, plotBLayers=plotBLayers, + plotCLayers=plotCLayers, sectionHeights=sectionHeights, + sampleColor=sampleColor, verbose=verbose) +} + #' Private Class svData #' #' An S4 class for the data of the sv plot object @@ -115,12 +622,11 @@ setClass("svData", #' @name StructuralVariant #' @importFrom data.table data.table #' @noRd -svData <- function(object, BSgenome, filter, svType, svOrder, maxSvSize, sample, +svData <- function(object, BSgenome, filterSvCalls, svType, svOrder, maxSvSize, sample, chromosomes, ensembl, attributes, filters, annotate, geneAnnotationFlank, chrGap, genome, verbose) { - ## Subset data to only passed sv calls - primaryData <- getVcfData(object=object, filter=filter, maxSvSize=maxSvSize, + primaryData <- getVcfData(object=object, filterSvCalls=filterSvCalls, maxSvSize=maxSvSize, svType=svType, verbose=verbose) ## Subset data to only the chromosomes desired to be plotted @@ -148,7 +654,7 @@ svData <- function(object, BSgenome, filter, svType, svOrder, maxSvSize, sample, adjustedPrimaryData <- adjustCentromeres(object=primaryData, chrCytobands=chrCytobands, verbose=verbose) ## Get the new positions for SV calls and cytobands - svWindow <- getStructuralVariantWindow(object=adjustedPrimaryData, chrCytobands=chrCytobands, chrData=chrData, + svWindow <- getStructuralVariantWindow(object=adjustedPrimaryData, chromosomes=chromosomes, chrCytobands=chrCytobands, chrData=chrData, chrGap=chrGap, verbose=verbose) ## Initialize the object @@ -287,37 +793,25 @@ setMethod(f="drawPlot", setMethod(f="chrSubsetSv", signature="data.table", definition=function(object, chromosomes, verbose, ...){ - # print status message if(verbose){ memo <- paste("Performing chromosome subsets") message(memo) } - # if chromosomes is null we dont want to do anything just return the object back + # if chromosomes is null we dont want to do anything just return all autosomes if(is.null(chromosomes)){ - return(object) - } - - # perform quality checks on the chromosome parameter arguments - - # check for character vector - if(!is.character(chromosomes)){ - memo <- paste("Input to chromosomes should be a character vector, - specifying which chromosomes to plot, - attempting to coerce...") - warning(memo) - chromosomes <- as.character(chromosomes) - } - - ## Check format of the chromosome column + chromosomes <- "autosomes" + } + + ## Check format of the chromosome1 column if (!all(grepl("^chr", object$chromosome))) { if (verbose) { - memo <- paste0("Did not detect the prefix chr in the chromosome1 column", + memo <- paste0("Did not detect the prefix chr in the chromosome1 column ", "of x... adding prefix") message (memo) + object$chromosome <- paste("chr", object$chromosome, sep="") } - object$chromosome <- paste("chr", object$chromosome, sep="") } else if (all(grepl("^chr", object$chromosome))) { if (verbose) { memo <- paste0("Detected chr in the chromosome1 column of x...", @@ -336,8 +830,8 @@ setMethod(f="chrSubsetSv", memo <- paste0("Did not detect the prefix chr in the chromosome2 column", "of x... adding prefix") message (memo) + object$chromosome2 <- paste("chr", object$chromosome2, sep="") } - object$chromosome2 <- paste("chr", object$chromosome2, sep="") } else if (all(grepl("^chr", object$chromosome2))) { if (verbose) { memo <- paste0("Detected chr in the chromosome2 column of x...", @@ -353,11 +847,11 @@ setMethod(f="chrSubsetSv", ## Determine which chromosomes to plot ## Only include autosomes if (chromosomes[1] == "autosomes") { - chromosomes <- as.character(c(seq(1:22))) + chromosomes <- paste("chr", as.character(c(seq(1:22))), sep="") } ## Include all chromosomes if (chromosomes[1] == "all") { - chromosomes <- unique(object$chromosome) + chromosomes <- unique(c(object$chromosome, object$chromosome2)) chromosomes <- chromosomes[-grep("GL", chromosomes)] chromosomes <- chromosomes[-grep("MT", chromosomes)] } @@ -445,27 +939,6 @@ setMethod(f="annoGenomeCoordSv", message(memo) } - ## Perform quality check on BSgenome object - if (is.null(BSgenome)) { - memo <- paste("BSgenome object is not specified, whole chromosomes", - "will not be plotted, this is not recommended!") - warning(memo) - object$chromosome <- factor(object$chromosome, levels=gtools::mixedsort(unique(as.character(object$chromosome)))) - object$chromosome2 <- factor(object$chromosome2, levels=gtools::mixedsort(unique(as.character(object$chromosome2)))) - - return(object) - } else if (is(BSgenome, "BSgenome")) { - if(verbose){ - memo <- paste("BSgenome passed object validity checks") - } - } else { - memo <- paste("class of the BSgenome object is", class(BSgenome), - "should either be of class BSgenome or NULL", - "setting this to param to NULL") - warning(memo) - BSgenome <- NULL - } - ## Create a data table of genomic coordinates end positions genomeCoord <- data.table::as.data.table(seqlengths(BSgenome)) colnames(genomeCoord) <- c("end") @@ -528,18 +1001,6 @@ setMethod(f="sampleSubset", message(memo) } - ## If samples is null, we don't want to do anything and just return the object - if (is.null(samples)) { - return(object) - } - - ## Perform quality checkes on the sample parameter arguments - if (!is.character(samples)) { - memo <- paste("Input to samples should be a character vector, - attempting to coerce...") - warning(memo) - } - ## Check for specified samples not in the original input missingSamp <- samples[!samples %in% unique(object$sample)] if (length(missingSamp) != 0) { @@ -690,6 +1151,19 @@ setMethod(f="countGenes", ## Get the total number of samples sample_num <- length(unique(object$sample)) + ## Check if the svOrders are in the sv dataset + if (!all(svOrder %in% object@vcfObject@svType$svtype)) { + svOrder <- svOrder[which(svOrder %in% object@vcfObject@svType$svtype)] + if (length(svOrder) == 0) { + memo <- paste0("Structural variant types in the svOrder variable are not ", + "found in the SV dataset. Assigning the following order based on the ", + "mutations found in the SV dataset: ", + paste(object@vcfObject@svType$svtype, collapse=" > ")) + message(memo) + svOrder <- object@vcfObject@svType$svtype + } + } + ## Go through the list of genes and see how many times/samples it is mutated final_df <- data.table::rbindlist(apply(genes, 1, function(x, object, svOrder, sample_num) { ## Get the rows with the genes @@ -759,7 +1233,7 @@ setMethod(f="countGenes", setMethod(f="svCytobands", signature="data.table", definition=function(object, genome, chrData, verbose) { - #browser() + ## Print status message if (verbose) { message("Subsetting cytoband dataset.") @@ -812,7 +1286,7 @@ setMethod(f="svCytobands", setMethod(f="adjustCentromeres", signature="data.table", definition=function(object, chrCytobands, verbose) { - #browser() + ## Print status message if (verbose){ message("Adjusting positions of structural variants to account for centromere to aid in visualization.") @@ -860,7 +1334,7 @@ setMethod(f="adjustCentromeres", #' @noRd setMethod(f="getStructuralVariantWindow", signature="data.table", - definition=function(object, chrData, chrCytobands, chrGap, verbose){ + definition=function(object, chromosomes, chrData, chrCytobands, chrGap, verbose){ ## Print status message if (verbose) { @@ -876,7 +1350,7 @@ setMethod(f="getStructuralVariantWindow", coi <- data.table(chromosomes) } if (is.null(chromosomes)) { - coi <- unique(chrData$chromosome) + coi <- data.table(chromosomes=unique(chrData$chromosome)) } ## For each of the COI-chr combination, generate a dataset to plot @@ -1030,28 +1504,6 @@ setMethod(f="buildSvPlot", svWindow$direction <- gsub("\\[P\\[N", "5' to 5'", svWindow$direction) svWindow$svtype <- gsub("BND", "TRA", svWindow$svtype) - - ## Check the input variables - checkPlotLayer <- function(plotLayer, name) { - if(!is.null(plotLayer)){ - if(!is.list(plotLayer)){ - memo <- paste(name, " is not a list", sep="") - stop(memo) - } - - if(any(!unlist(lapply(plotLayer, function(x) ggplot2::is.ggproto(x) | ggplot2::is.theme(x) | is(x, "labels"))))){ - memo <- paste(name, " is not a list of ggproto or ", - "theme objects... setting plotALayers to NULL", sep="") - warning(memo) - plotLayer <- NULL - } - } - return(plotLayer) - } - plotALayers <- checkPlotLayer(plotLayer=plotALayers, "plotALayers") - plotBLayers <- checkPlotLayer(plotLayer=plotBLayers, "plotBLayers") - plotCLayers <- checkPlotLayer(plotLayer=plotCLayers, "plotCLayers") - ## Assign colors for samples names(sampleColor) <- sample @@ -1065,12 +1517,18 @@ setMethod(f="buildSvPlot", plotTraGenes, plotOtherGenes, plotALayers, plotBLayers, plotCLayers) { + ## Split the dataset by sample to assign color names df <- split(dataset, f=dataset$sample) dataset <- data.table::rbindlist(lapply(df, function(x, sampleColor){ if (nrow(x) > 0) { sampleName <- as.character(x$sample[1]) - x$sampleColor <- sampleColor[which(names(sampleColor) == sampleName)] + if (!is.null(sampleColor)) { + x$sampleColor <- sampleColor[which(names(sampleColor) == sampleName)] + } + if (is.null(sampleColor)) { + x$sampleColor <- sampleName + } } return(x) }, sampleColor=sampleColor)) @@ -1157,13 +1615,13 @@ setMethod(f="buildSvPlot", dataset <- dataset[Direction!="cytoband"] gene_text <- dataset[,c("Midpoint", "Total_Read_Support", "gene", "SV_Type")] ## If there is sv events for translocations, get the gene text - if (availableSvTypes %in% c("TRA", "BND")) { + if (any(availableSvTypes %in% c("TRA", "BND"))) { gene_text$Total_Read_Support[which(gene_text$SV_Type=="TRA")] <- as.numeric(as.character(gene_text$Total_Read_Support[which(gene_text$SV_Type=="TRA")])) + max(as.numeric(as.character(gene_text$Total_Read_Support[which(gene_text$SV_Type=="TRA")])))*.05 } ## If there is sv events for non-translocations, get the gene text - if (availableSvTypes %in% c("DEL", "DUP", "INV", "INS")) { + if (any(availableSvTypes %in% c("DEL", "DUP", "INV", "INS"))) { gene_text$Total_Read_Support[which(gene_text$SV_Type!="TRA")] <- as.numeric(as.character(gene_text$Total_Read_Support[which(gene_text$SV_Type!="TRA")])) + max(as.numeric(as.character(gene_text$Total_Read_Support[which(gene_text$SV_Type!="TRA")])))*.05 @@ -1188,22 +1646,30 @@ setMethod(f="buildSvPlot", } } - ########################################################## ##### Plot the translocation data ######################## ########################################################## ## Get the start/end of chromosomes in the dataset if there is translocation data ## TODO: Allow this to occur for intra-chromosomal translocations - if (availableSvTypes %in% c("TRA", "BND")){ + if (any(availableSvTypes %in% c("TRA", "BND"))){ beziers <- data.frame(data.table::rbindlist(apply(diffChrSvWindow, 1, function(x) { leftEnd <- data.table(position=as.numeric(x[2]), total_read_support=0, point="end", - type="cubic", group=as.character(x[2]), Sample=x[8], SV_Type=x[6], + type="cubic", + group=paste(as.character(x[2]), as.character(x[4]), as.character(x[5]), + as.character(x[7]), as.character(x[8]), sep="_"), + Sample=x[8], SV_Type=x[6], Direction=x[5], sampleColor=x[13]) top <- data.table(position=as.numeric(x[10]), total_read_support=as.numeric(x[7])*2, point="control", - type="cubic", group=as.character(x[2]), Sample=x[8], SV_Type=x[6], + type="cubic", + group=paste(as.character(x[2]), as.character(x[4]), as.character(x[5]), + as.character(x[7]), as.character(x[8]), sep="_"), + Sample=x[8], SV_Type=x[6], Direction=x[5], sampleColor=x[13]) rightEnd <- data.table(position=as.numeric(x[4]), total_read_support=0, point="end", - type="cubic", group=as.character(x[2]), Sample=x[8], SV_Type=x[6], + type="cubic", + group=paste(as.character(x[2]), as.character(x[4]), as.character(x[5]), + as.character(x[7]), as.character(x[8]), sep="_"), + Sample=x[8], SV_Type=x[6], Direction=x[5], sampleColor=x[13]) final <- rbind(leftEnd, top, rightEnd) return(final) @@ -1230,13 +1696,15 @@ setMethod(f="buildSvPlot", mapping=aes_string(x='Midpoint', y='Total_Read_Support', label='gene')) } ## Assign colors to sample - traPlot <- traPlot + scale_color_manual(name="Sample", values=sampleColor) + if (!is.null(sampleColor)) { + traPlot <- traPlot + scale_color_manual(name="Sample", values=sampleColor) + } } ############################################################## ##### Plot the non TRA sv events ############################# ############################################################## - if (availableSvTypes %in% c("DEL", "DUP", "INV", "INS")) { + if (any(availableSvTypes %in% c("DEL", "DUP", "INV", "INS"))) { maxY <- max(as.numeric(as.character(sameChrSvWindow$Total_Read_Support))) + 30 sameChrSvWindow$Total_Read_Support <- as.numeric(sameChrSvWindow$Total_Read_Support) nonTraPlot <- ggplot() + geom_point(data=sameChrSvWindow, @@ -1254,7 +1722,9 @@ setMethod(f="buildSvPlot", mapping=aes_string(x='Midpoint', y='Total_Read_Support', label='gene')) } ## Assign colors to sample - nonTraPlot <- nonTraPlot + scale_color_manual(name="Sample", values=sampleColor) + if (!is.null(sampleColor)) { + nonTraPlot <- nonTraPlot + scale_color_manual(name="Sample", values=sampleColor) + } } ############################################################## diff --git a/R/VCF_Virtual-class.R b/R/VCF_Virtual-class.R index c6e9eaa..12e718f 100644 --- a/R/VCF_Virtual-class.R +++ b/R/VCF_Virtual-class.R @@ -23,14 +23,14 @@ setClass( ################################################################################ ###################### Accessor function definitions ########################### -#' @name getVcf -#' @rdname getVcf-methods -#' @aliases getVcf -setMethod(f="getVcf", +#' @name getHeader +#' @rdname getHeader-methods +#' @aliases getHeader +setMethod(f="getHeader", signature="VCF_Virtual", definition=function(object, ...){ - vcf <- object@vcf - return(vcf) + header <- object@description + return(header) }) #' @name getSample @@ -41,4 +41,22 @@ setMethod(f="getSample", definition=function(object, ...){ sample <- object@sample return(sample) + }) + +#' @rdname getMeta-methods +#' @aliases getMeta +setMethod(f="getMeta", + signature="VCF_Virtual", + definition=function(object, ...) { + meta <- object@vcfData + return(meta) + }) + +#' @rdname getMutation-methods +#' @aliases getMutation +setMethod(f="getMutation", + signature="VCF_Virtual", + definition=function(object, ...) { + mutation <- object@svType + return(mutation) }) \ No newline at end of file diff --git a/R/VariantCallFormat-class.R b/R/VariantCallFormat-class.R index de36f97..20c9b7c 100644 --- a/R/VariantCallFormat-class.R +++ b/R/VariantCallFormat-class.R @@ -37,21 +37,12 @@ setClass("VariantCallFormat", #' Only used when paired=TRUE. #' @param verbose Bolean specifying if progress should be reported while reading #' in the VCF file -#' @details When specifying a path to a VCF file, the option exists to either -#' specify the full path to a vcf file or to us wildcards to specify multiple -#' files. When specifying a full path, the initializer will check if a column -#' named "sample" containing the relevant sample for each row exists. If such a -#' column is not found, the initializer will assume this file correspnds to -#' only one sample and populate a sample column accordingly. Alternatively, if -#' multiple files are specified at once using a wildcard, the initializer will -#' aggregate all the files and use the filenames minus any extension to -#' populate the "sample" column. #' @importFrom data.table fread #' @importFrom data.table rbindlist #' @importFrom data.table data.table #' @export VariantCallFormat <- function(path=NULL, data=NULL, version="auto", svCaller=NULL, paired=paired, - tumorColumn=tumorColumn, verbose=FALSE) { + tumorColumn=tumorColumn, verbose=FALSE) { ## Check if both path and data are both null if (is.null(path) & is.null(data)) { @@ -88,9 +79,9 @@ VariantCallFormat <- function(path=NULL, data=NULL, version="auto", svCaller=NUL ## Find where the headers stops and read the data skip <- length(header) vcfData <- suppressWarnings(data.table::fread(input=x, - stringsAsFactors=TRUE, - verbose=verbose, - skip=skip)) + stringsAsFactors=TRUE, + verbose=verbose, + skip=skip)) ## Set sample if it is not already in the data table if(any(colnames(vcfData) %in% "sample")){ @@ -220,6 +211,71 @@ VariantCallFormat <- function(path=NULL, data=NULL, version="auto", svCaller=NUL new("VariantCallFormat", path=path, vcfObject=vcfObject, version=as.character(version)) } +################################################################################ +###################### Accessor function definitions ########################### + +#' @rdname writeData-methods +#' @aliases writeData +setMethod(f="writeData", + signature="VariantCallFormat", + definition=function(object, file, ...){ + writeData(object@vcfObject@vcfData, file, sep="\t") + }) + +#' @rdname getVersion-methods +#' @aliases getVersion +setMethod(f="getVersion", + signature="VariantCallFormat", + definition=function(object, ...) { + version <- object@version + return(version) + }) + +#' @rdname getPath-methods +#' @aliases getPath +setMethod(f="getPath", + signature="VariantCallFormat", + definition=function(object, ...){ + path <- object@path + return(path) + }) + +#' @rdname getHeader-methods +#' @aliases getHeader +setMethod(f="getHeader", + signature="VariantCallFormat", + definition=function(object, ...) { + header <- getHeader(object@vcfObject) + return(header) + }) + +#' @rdname getSample-methods +#' @aliases getSample +setMethod(f="getSample", + signature="VariantCallFormat", + definition=function(object, ...) { + sample <- getSample(object@vcfObject) + return(sample) + }) + +#' @rdname getMeta-methods +#' @aliases getMeta +setMethod(f="getMeta", + signature="VariantCallFormat", + definition=function(object, ...) { + meta <- getMeta(object@vcfObject) + return(meta) + }) + +#' @rdname getMutation-methods +#' @aliases getMutation +setMethod(f="getMutation", + signature="VariantCallFormat", + definition=function(object, ...) { + mutations <- getMutation(object@vcfObject) + return(mutations) + }) + ################################################################################ ####################### Method function definitions ############################ @@ -230,9 +286,9 @@ VariantCallFormat <- function(path=NULL, data=NULL, version="auto", svCaller=NUL #' @importFrom data.table data.table setMethod(f="getVcfData", signature="VariantCallFormat", - definition=function(object, filter, maxSvSize, svType, + definition=function(object, filterSvCalls, maxSvSize, svType, verbose, ...) { - + ## Print status message if (verbose) { memo <- paste0("converting ", class(object), " to expected ", @@ -240,13 +296,31 @@ setMethod(f="getVcfData", message(memo) } + availableSvTypes <- object@vcfObject@svType$svtype object <- object@vcfObject@vcfData ## Filter out sv calls that are not "PASS" - if (filter == TRUE) { + if (filterSvCalls == TRUE) { object <- object[FILTER=="PASS"] } + ## Check if the sv types are found in the actual sv dataset + if (!is.null(svType)) { + svType <- svType[which(svType %in% availableSvTypes)] + if (length(svType) == 0) { + memo <- paste0("The desired sv types as designated in the svType ", + "variable are not found in the sv dataset. Setting ", + "svType to NULL, which will include all sv's in the dataset.") + message(memo) + svType <- NULL + } + } + if (!is.numeric(maxSvSize) & !is.null(maxSvSize)) { + memo <- paste0("maxSvSize variable not of the numeric class. Attempting to coerce.") + maxSvSize <- as.numeric(maxSvSize) + message(memo) + } + ## Remove large SV if (is.null(maxSvSize) == FALSE) { ## Get the difference in positions @@ -265,7 +339,7 @@ setMethod(f="getVcfData", ## Remove sv types that are not necessary available_svTypes <- unlist(as.vector(object$svtype)) - if (length(svType) > 0) { + if (length(svType) > 0 & !is.null(svType)) { ## Check to see if the SV type is in the data.table ## Perform the subset if svtype is available if (all(svType %in% available_svTypes)) { @@ -278,7 +352,8 @@ setMethod(f="getVcfData", stop(memo) } } + ## Stop the return(object) - }) + }) diff --git a/vignettes/Visualizing_Large_Scale_Chromosomal_Aberrations.Rmd b/vignettes/Visualizing_Large_Scale_Chromosomal_Aberrations.Rmd new file mode 100644 index 0000000..6770099 --- /dev/null +++ b/vignettes/Visualizing_Large_Scale_Chromosomal_Aberrations.Rmd @@ -0,0 +1,129 @@ +--- +title: "Visualizing Large-Scale Chromosomal Aberrations with GenVisR" +author: + name: "Jason Kunisaki" + affiliation: "McDonnell Genome Institute - Washington University School of Medicine" +date: "`r Sys.Date()`" +output: + BiocStyle::html_document: + toc_float: true +package: GenVisR +abstract: + Instructions for visualizing large chromosomal aberrations using the GenVisR package +vignette: > + %\VignetteIndexEntry{Visualizing_Large_Chromosomal_Aberrations} + %\VignetteEngine{knitr::rmarkdown} + %\VignetteEncoding{UTF-8} +--- + +```{r setup, include=FALSE} +knitr::opts_chunk$set(echo = TRUE) +``` + +# GenVisR a brief introduction + +Intuitively visualizing and interpreting data from high-throughput genomic technologies continues to be challenging. Often creating a publication ready graphic not only requires extensive manipulation of data but also an in-depth knowledge of graphics libraries. As such creating such visualizations has traditionally taken a significant amount of time in regards to both data pre-processing and aesthetic manipulations. GenVisR (Genomic Visulizations in R) attempts to alleviate this burden by providing highly customizable publication-quality graphics in an easy to use structure. Many of the plotting functions in this library have a focus in the realm of human cancer genomics however we support a large number of species and many of the plotting methods incorprated within are of use for visualizing any type of genomic abnormality. + +## Getting Started + +For the majority of users we recommend installing GenVisR from the release branch of Bioconductor, Installation instructions using this method can be found on the [GenVisR](https://bioconductor.org/packages/GenVisR) landing page on Bioconductor. + +Please note that GenVisR imports a few packages that have “system requirements”, in most cases these requirements will already be installed. If they are not please follow the instructions to install these packages given in the R terminal. Briefly these packages are: “libcurl4-openssl-dev” and “libxml2-dev” + +Once GenVisR is successfully installed it will need to be loaded. For the purposes of this vignette we do this here and set a seed to ensure reproducibility. + +```{r, message=FALSE, tidy=TRUE} +# set a seed +set.seed(426) + +# load GenVisR into R +library(GenVisR) +``` + +## Visualizing Large-Scale Chromosomal Aberrations + +Complex variants in the form of copy number amplification or deletion, loss of heterozygosity, and structural variation are important genomic aberrations that can lead to the pathogensis of various diseases. Intuitive visualzations are needed to aid in the analysis and interpretation of these large-scale genomic variants. We present 3 functions that serve this purpose to provide cohort-level visualization of these aberrations, allowing for the identification of recurrent patterns that can be associated with genomic diseases. + +## Supported Files with Data on Large-Scale Chromosomal Aberrations + +To visualize large-scale genomic aberrations, GenVisR is designed to work with 4 file formats. The first is from [VarScan2](http://varscan.sourceforge.net/somatic-calling.html), a computational tool that analyzes sequence data to make variant calls. The second, third, and fourth supported files are all [VCF](https://samtools.github.io/hts-specs/VCFv4.1.pdf) from the structural variant callers: [Manta](https://github.com/Illumina/manta), [Lumpy](https://github.com/arq5x/lumpy-sv), and [Delly](https://github.com/dellytools/delly). Additionally, users can supply a `data.table` object to the GenVisR functions that produce visualizations for large-scale chromosomal aberrations, but the `data.table` object must contain the expected columns (see details for specific functions). + +## Functions to Visualize Large-Scale Chromosomal Aberrations +The output from `StructuralVariant()`, `LohSpec()`, and `cnLoh()` are objects that store the data used to generate the visualizations as well as the final arranged plot. The reason for storing the data and plots in such a manner is two-fold. First allowing access to the data which was plotted provides transparency as to how the plot was produced. Secondly, these items can be accessed by the user, allowing for greater flexibility and customizability. These data and plots can be accessed with the `getData()` and `getGrob()` functions respectively. The final plot can be printed with the `drawPlot()` function which takes one of the afore mentioned objects. + +# Basic Pipeline to Generate Visualizations + +## Reading in data + +When constructing a plot with GenVisR there are three basic steps. First one must load the data into R, as mentioned previously GenVisR supports four filetypes which can be read in this manner. An example for each is supplied below using test data installed with the package. + +### Basic Syntax + +**Reading in a VarScan file**
+The required columns for a VarScan file with LOH data are: . +```{r, message=FALSE, tidy=TRUE} +# get the disk location for VarScan test file +testFile <- "~/Google Drive/GenVisR_ranch/GenVisR/inst/extdata/HCC1395.varscan.tsv" + +# define the objects for testing +varscanObject <- VarScanFormat(testFile) +``` + +**Reading in Manta/Delly/Lumpy-VCF file**
+The `svCaller` variable designates which structural variant caller was used. Currently, GenVisR supports data from [Manta](https://github.com/Illumina/manta), [Lumpy](https://github.com/arq5x/lumpy-sv), and [Delly](https://github.com/dellytools/delly). Many of these callers can be run pairwise (e.g. Tumor - Normal) or with a single sample. If the analysis was run pairwise, the read support column for variants in the tumor sample must be specified with the `tumorColumn` variable. The `version` parameter specifies the version of the VCF file. The default setting is "auto", which informs the function to find the version from the VCF header. The `version` parameter must be specified if a VCF dataset is provided, since the dataset does not include the VCF header. +```{r, message=FALSE, tidy=TRUE} +# get the disk location for VCF files +dataset <- data.table::fread("~/Google Drive/hcc_sv_dataset.txt", showProgress=FALSE) + +# define the objects for testing +vcfObject <- VariantCallFormat(data=dataset, svCaller="Manta", version="4.1", paired=TRUE, tumorColumn=11) +``` + +### Viewing Data + +In some cases you may want to view data after it has been read in, there are functions available to make viewing these data easier. Briefly these are `getVersion()`, `getPath()`, `getHeader()`, `getVersion()`, `getSample()`, `getMeta()`, and `getMutation()` which are globally available for each object type (VariantCallFormat). Let's test one out by viewing the samples from the VCF file that was read in with `VariantCallFormat()`. + +```{r, tidy=TRUE, eval=FALSE} +# view the samples from the VEP file +getSample(vcfObject) + +# view the path used to get the VCF file +getPath(vcfObject) + +# view the header of the VCF file +getHeader(vcfObject) + +# view the version of the VCF file +getVersion(vcfObject) + +# view the samples in the VCF file +getSample(vcfObject) + +# view the data of the VCF file +getMeta(vcfObject) + +# view the Strutural Variant types in the VCF file +getMutation(vcfObject) +``` + +### Additional Notes + +All of these functions expect a path to a file of the appropriate type. Optionally a wildcard can be supplied with * as was done with `VariantCallFormat()` causing the function to read in multiple files at once. If a sample column is not found one will be created based on the filenames. Each of these functions will attempt to infer a file specification version from the file header. If a version is not found one will need to be specified via the `version` parameter. + +## Constructing a Plot Object and viewing plotted data + +Once the data is read in and stored in one of the previously mentioned objects the data can be plotted with one of the plotting functions. We will go over each plotting function in more detail in section 4 however to continue with our example pipeline let's create a structural variant plot with the structural variant caller. + +```{r, tidy=TRUE, warning=FALSE} +library(BSgenome) +library(biomaRt) +ensembl <- useMart("ENSEMBL_MART_ENSEMBL", host="grch37.ensembl.org") +ensembl <- useDataset(dataset="hsapiens_gene_ensembl", mart=ensembl) +attributes <- c("hgnc_symbol") +filters <- c("chromosome_name", "start", "end") + +BSgenome <- getBSgenome(genome = "BSgenome.Hsapiens.UCSC.hg19") +waterfallPlot <- StructuralVariant(input=vcfObject, BSgenome=BSgenome, ) +``` + +With the plot object created we can view the actual data making up the plot with the `getData()` function. This is an accessor function to pull out specific data making up the plot (Refer to the R documentation for `Waterfall()` to see available slots in the object which hold data). Let's use it here to extract the data making up the main plot panel, we can specify the slot either by name or it's index. From 15c660d868807be7521012ee21e1f3dec0e24dc4 Mon Sep 17 00:00:00 2001 From: Jason kunisaki Date: Mon, 30 Apr 2018 19:05:41 -0500 Subject: [PATCH 14/21] sv update --- NAMESPACE | 2 +- R/AllGenerics.R | 11 - R/StructuralVariant-class.R | 686 +++--------------- R/VCF_Virtual-class.R | 30 +- R/VariantCallFormat-class.R | 111 +-- ...ng_Large_Scale_Chromosomal_Aberrations.Rmd | 2 +- 6 files changed, 134 insertions(+), 708 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 3c5f1ec..b57bee4 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -10,7 +10,6 @@ export(StructuralVariant) export(TvTi) export(VEP) export(VarScanFormat) -export(VariantCallFormat) export(Waterfall) export(cnFreq) export(cnLoh) @@ -33,6 +32,7 @@ exportClasses(Rainfall) exportClasses(StructuralVariant) exportClasses(VEP) exportClasses(VarScanFormat) +exportClasses(VariantCallFormat) exportClasses(Waterfall) exportClasses(cnLoh) exportClasses(lohSpec) diff --git a/R/AllGenerics.R b/R/AllGenerics.R index 82b88dd..9b033d6 100644 --- a/R/AllGenerics.R +++ b/R/AllGenerics.R @@ -942,15 +942,4 @@ setGeneric( setGeneric( name="getVcfData", def=function(object, ...){standardGeneric("getVcfData")} -) - -#' Method checkSvInputParameters -#' -#' @name checkSvInputParameters -#' @rdname checkSvInputParameters-methods -#' @param ... additional arguments to passed -#' @noRd -setGeneric( - name="checkSvInputParameters", - def=function(object, ...){standardGeneric("checkSvInputParameters")} ) \ No newline at end of file diff --git a/R/StructuralVariant-class.R b/R/StructuralVariant-class.R index 16f13e0..61fbdbc 100644 --- a/R/StructuralVariant-class.R +++ b/R/StructuralVariant-class.R @@ -18,7 +18,7 @@ setClass("StructuralVariant", representation=representation(svData="data.table", geneData="data.table", - svPlots="svPlots"), + svPlots="list"), validity=function(object) { }) @@ -61,7 +61,7 @@ setClass("StructuralVariant", #' @param plotHeight Integer for height of SV visualizations #' @param verbose Boolean specifying if status messages should be reported #' @export -StructuralVariant <- function(input, BSgenome=NULL, filterSvCalls=TRUE, svType=NULL, +StructuralVariant <- function(input, BSgenome=NULL, filter=TRUE, svType=NULL, svOrder=c("TRA", "BND", "DEL", "DUP", "INV", "INS"), maxSvSize=NULL, sample=NULL, chromosomes=NULL, ensembl=ensembl, attributes=attributes, filters=filters, @@ -70,46 +70,20 @@ StructuralVariant <- function(input, BSgenome=NULL, filterSvCalls=TRUE, svType=N plotOtherGenes=FALSE, chrGap=5000000, genome="hg19", cytobandColor=c("White", "Grey"), sampleColor=NULL, verbose=FALSE, plotALayers=NULL, - plotBLayers=NULL, plotCLayers=NULL, sectionHeights=c(0.4, 0.1, 0.5)) { + plotBLayers=NULL, plotCLayers=NULL) { - ## Check the input parameters - inputParameters <- checkSvInputParameters(object=object, BSgenome=BSgenome, filterSvCalls=filterSvCalls, - svType=svType, svOrder=svOrder, - maxSvSize=maxSvSize, sample=sample, chromosomes=chromosomes, - ensembl=ensembl, attributes=attributes, - filters=filters, chrGap=chrGap, annotate=annotate, - geneAnnotationFlank=geneAnnotationFlank, genome=genome, - plotSV=plotSV, plotSpecificGene=plotSpecificGene, - plotTraGenes=plotTraGenes, plotOtherGenes=plotOtherGenes, - cytobandColor=cytobandColor, - plotALayers=plotALayers, plotBLayers=plotBLayers, - plotCLayers=plotCLayers, sectionHeights=sectionHeights, - sampleColor=sampleColor, verbose=verbose) - ## Calculate all data for the plots - svDataset <- svData(object=input, BSgenome=inputParameters@BSgenome, - filterSvCalls=inputParameters@filterSvCalls, - svType=inputParameters@svType, svOrder=inputParameters@svOrder, - maxSvSize=inputParameters@maxSvSize, sample=inputParameters@sample, - chromosomes=inputParameters@chromosomes, - ensembl=inputParameters@ensembl, attributes=inputParameters@attributes, - filters=inputParameters@filters, chrGap=inputParameters@chrGap, - annotate=inputParameters@annotate, - geneAnnotationFlank=inputParameters@geneAnnotationFlank, - genome=inputParameters@genome, verbose=inputParameters@verbose) + svDataset <- svData(object=input, BSgenome=BSgenome, filter=filter, svType=svType, svOrder=svOrder, + maxSvSize=maxSvSize, sample=sample, chromosomes=chromosomes, + ensembl=ensembl, attributes=attributes, filters=filters, chrGap=chrGap, annotate=annotate, + geneAnnotationFlank=geneAnnotationFlank, genome=genome, verbose=verbose) ## Create the plots from svData - structuralVariantPlots <- svPlots(object=svDataset, plotSV=inputParameters@plotSV, - plotSpecificGene=inputParameters@plotSpecificGene, - plotTraGenes=inputParameters@plotTraGenes, - plotOtherGenes=inputParameters@plotOtherGenes, - cytobandColor=inputParameters@cytobandColor, - plotALayers=inputParameters@plotALayers, - plotBLayers=inputParameters@plotBLayers, - plotCLayers=inputParameters@plotCLayers, - sectionHeights=inputParameters@sectionHeights, - sample=inputParameters@sample, sampleColor=inputParameters@sampleColor, - verbose=inputParameters@verbose) + structuralVariantPlots <- svPlots(object=svDataset, plotSV=plotSV, plotSpecificGene=plotSpecificGene, + plotTraGenes=plotTraGenes, plotOtherGenes=plotOtherGenes, cytobandColor=cytobandColor, + plotALayers=plotALayers, plotBLayers=plotBLayers, + plotCLayers=plotCLayers, sectionHeights=sectionHeights, + sample=sample, sampleColor=sampleColor, verbose=verbose) ## Intialize the object new("StructuralVariant", svData=getData(object=svDataset, name="primaryData"), @@ -119,487 +93,6 @@ StructuralVariant <- function(input, BSgenome=NULL, filterSvCalls=TRUE, svType=N #!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Private Classes !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!# -#' Private Class svInputParameters -#' -#' An S4 class to check input parameters of the StructuralVariant function -#' @name svInputParameters-class -#' @noRd -setClass("svInputParameters", - representation=representation(BSgenome="BSgenome", filterSvCalls="logical", svType="character", - svOrder="character", maxSvSize="numeric", - sample="character", chromosomes="character", - ensembl="Mart", attributes="character", - filters="character", chrGap="numeric", - annotate="logical", geneAnnotationFlank="numeric", - genome="character", plotSV="logical", - plotSpecificGene="character", plotTraGenes="logical", - plotOtherGenes="logical", cytobandColor="character", - plotALayers="list", plotBLayers="list", - plotCLayers="list", sectionHeights="numeric", - sampleColor="character", verbose="logical"), - validity=function(object){ - - }) - -#' Constructor for the svInputParameters class -#' -#' @name svInputParameters -#' @rdname svInputParameters-class -#' @importFrom karyoploteR getCytobands -#' @noRd -checkSvInputParameters <- function(object, BSgenome, filterSvCalls, svType, svOrder, maxSvSize, - sample, chromosomes, ensembl, attributes, - filters, chrGap, annotate, geneAnnotationFlank, - genome, plotSV, plotSpecificGene, plotTraGenes, - plotOtherGenes, cytobandColor, plotALayers, plotBLayers, - plotCLayers, sectionHeights, sampleColor, verbose) { - - ##### Check verbose parameter ##### - ## Check to see if verbose is a booelean - if (!is.logical(verbose) | is.null(verbose)) { - memo <- paste0("The verbose parameter is not a boolean (T/F). Coercing verbose to be FALSE...") - message(memo) - verbose <- FALSE - } - - ##### Check BSgenome parameter ##### - ## Check to see if BSgenome is a BSgenome - if (is.null(BSgenome)) { - memo <- paste("BSgenome object is not specified, whole chromosomes", - "will not be plotted, this is not recommended!") - warning(memo) - } else if (is(BSgenome, "BSgenome")) { - memo <- paste("BSgenome passed object validity checks") - message(memo) - } else { - memo <- paste("class of the BSgenome object is", class(BSgenome), - "should either be of class BSgenome or NULL", - "setting this to param to NULL") - warning(memo) - BSgenome <- NULL - } - - ##### Check filterSvCalls parameter ##### - ## Check to see if filterSvCalls is a boolean - if (is.null(filterSvCalls) | !is.logical(filterSvCalls)) { - memo <- paste0("The filterSvCalls parameter is not a boolean (T/F). Coercing filterSvCalls to be FALSE...") - message(memo) - filterSvCalls <- FALSE - } - - ##### Check svType parameter ##### - ## Check if it null - if (is.null(svType)) { - svType <- as.character(object@vcfObject@svType$svtype) - memo <- paste0("svType variable cannot be NULL. Using all of the sv types ", - "available in the sv dataset") - message(memo) - } - ## check if svType is a character vector - if (!is.character(svType)) { - memo <- paste0("svType variable not of the character class. Attempting to coerce.") - svType <- as.character(svType) - message(memo) - } - - ##### Check svOrder parameter ##### - ## Check if svOrder is NULL - if (is.null(svOrder)) { - svOrder <- svType - memo <- paste0("svOrder variable cannot be NULL. Setting the deleterious order ", - "of sv events to that designated in the svType: ", - paste(svType, collapse=", ")) - message(memo) - } - if (!is.character(svOrder)) { - memo <- paste0("svOrder variable not of the character class. Attempting to coerce.") - svOrder <- as.character(svOrder) - message(memo) - } - - ##### Check maxSvSize parameter ##### - ## Check if maxSvSize is NULL - if (is.null(maxSvSize)) { - maxSvSize <- 0 - memo <- paste0("maxSvSize parameter cannot be NULL. Setting the maxSvSize value to 0.") - message(memo) - } - ## Check if maxSvSize is numeric - if (!is.numeric(maxSvSize)) { - memo <- paste0("maxSvSize variable not of the numeric class. Attempting to coerce.") - maxSvSize <- as.numeric(maxSvSize) - message(memo) - } - - ##### Check sample parameter ##### - ## Check is sample is NULL - if (is.null(sample)) { - sample <- unique(object@vcfObject@sample$sample) - memo <- paste0("Sample parameter cannot be NULL. All samples will be plotted.") - } - ## Check if sample is a character vector - if (!is.character(sample)) { - memo <- paste0("sample variable not of the character class. Attempting to coerce.") - sample <- as.character(sample) - message(memo) - } - - ##### Check chromosomes parameter ##### - ## Check is chromosomes is NULL - if (is.null(chromosomes)) { - chromosomes <- paste("chr", seq(1:22), sep="") - memo <- paste0("chromosomes parameter cannot be NULL. Using all autosomes...") - message(memo) - } - ## Check if chromosomes is a character vector - if (!is.character(chromosomes)) { - memo <- paste0("chromosomes variable not of the character class. Attempting to coerce.") - chromosomes <- as.character(chromosomes) - message(memo) - } - ## Check if it has the "chr" prefix - # Check to see if the chromosomes variable has "chr" in front if not NULL, autosomes, or all - if (all(chromosomes!="autosomes") & all(chromosomes!="all")) { - if (!all(grepl("^chr", chromosomes))) { - if (verbose) { - memo <- paste0("Did not detect the prefix chr in the chromosomes specified ", - "in the `chromosomes` variable... adding prefix") - message(memo) - chromosomes <- paste("chr", chromosomes, sep="") - } - } else if (all(grepl("^chr", chromosomes))) { - if (verbose) { - memo <- paste0("Detected chr in the `chromosomes` variable...", - "proceeding") - message(memo) - } - } else { - memo <- paste0("Detected unknown or mixed prefixes in the `chromosomes`` variable", - " colum of object... should either be chr or non (i.e.) chr1 or 1") - message(memo) - } - } - ##### Check annotate parameter ##### - ## Check if annotate is a boolean - if (!is.logical(annotate) | is.null(annotate)) { - memo <- paste0("The annotate parameter is not a boolean (T/F). Coercing annotate to be FALSE...") - message(memo) - annotate <- FALSE - } - ##### Check ensembl parameter ##### - ## Check if ensembl is of class "mart" - if (is.null(ensembl)) { - memo <- paste("ensembl object cannot be NULL if SV annotations are desired, ", - "in which case, the ensembl object must be of class Mart...") - if (!annotate) { - warning(memo) - } - if (annotate) { - stop(memo) - } - } - else if (is(ensembl, "Mart")) { - memo <- paste("ensembl passed object validity checks") - message(memo) - } - else { - memo <- paste("class of the ensembl object is", class(ensembl), - "should either be of class ensembl or NULL", - "setting this to param to NULL and will not perform ", - "sv annotations.") - warning(memo) - ensembl <- NULL - annotate <- FALSE - - } - - - ##### Check if attributes and filters are valid ##### - if (annotate) { - ## If ensembl is not NULL, check if these are character vectors - if (!is.null(ensembl) & (!is.character(attributes))) { - if (is.null(attributes)) { - memo <- paste0("If annotations are desired, the attributes parameter ", - "cannot be NULL. These values are used to specify the ouput ", - "for biomaRt annotations.") - stop(memo) - } - memo <- paste0("attributes variable not of the character class. Attempting to coerce.") - attributes <- as.character(attributes) - message(memo) - } - if (!is.null(ensembl) & (!is.character(filters))) { - if (is.null(filters)) { - memo <- paste0("If annotations are desired, the filters parameter ", - "cannot be NULL. These values are used to specify the input ", - "for biomaRt annotations.") - stop(memo) - } - memo <- paste0("filters variable not of the character class. Attempting to coerce.") - filters <- as.character(filters) - message(memo) - } - - ## If ensembl is not NULL, check that these are valid inputs for getBM - if (!is.null(ensembl)) { - temp <- data.table(listAttributes(mart=ensembl)) - if (!all(attributes %in% temp$name)) { - `%nin%` = Negate(`%in%`) - discrepantAttributes <- attributes[which(attributes %nin% temp$name)] - memo <- paste0("The following attributes: ", paste(discrepantAttributes, collapse="|"), - " are not valid inputs for the designated ensembl database. Please run ", - "biomaRt::listAttributes(ensembl) to get valid attributes.") - stop(memo) - } - temp <- data.table(listFilters(mart=ensembl)) - if (!all(filters %in% temp$name)) { - `%nin%` = Negate(`%in%`) - discrepantFilters <- filters[which(filters %nin% temp$name)] - memo <- paste0("The following filters: ", paste(discrepantFilters, collapse="|"), - " are not valid inputs for the designated ensembl database. Please run ", - "biomaRt::listFilters(ensembl) to get valid filters") - stop(memo) - } - } - - ## If ensembl is NULL, set these variables to NULL - if (is.null(ensembl)) { - attributes <- NULL - filters <- NULL - } - } - - ##### Check chrGap parameter ##### - ## Check if chrGap is NULL - if (is.null(chrGap)) { - chrGap <- 5000000 - memo <- paste0("chrGap variable cannot be NULL. Using the default value of 5,000,000.") - } - ## Check if chrGap is numeric - if (!is.numeric(chrGap)) { - memo <- paste0("chrGap variable not of the numeric class. Attempting to coerce.") - chrGap <- as.numeric(chrGap) - message(memo) - } - - ##### Check geneAnnotationFlank parameter ##### - ## Check if geneAnnotationFlank is NULL - if (is.null(geneAnnotationFlank)) { - geneAnnotationFlank <- 10000 - memo <- paste0("geneAnnotationFlank variable cannot be NULL. Setting the variable's ", - "value to 10,000 base pairs.") - message(memo) - } - ## Check if geneAnnotationFlank is numeric and is greater than 0 - if (!is.numeric(geneAnnotationFlank)) { - memo <- paste0("geneAnnotationFlank variable not of the numeric class. Attempting to coerce.") - geneAnnotationFlank <- as.numeric(geneAnnotationFlank) - message(memo) - if (geneAnnotationFlank < 0) { - memo <- paste0("geneAnnotationFlank cannot be a negative number. Changing ", - "geneAnnotationFlank to be 0.") - message(memo) - geneAnnotationFlank <- 0 - } - } - - ##### Check genome parameter ##### - ## Check if genome is not NULL - if (is.null(genome)) { - memo <- paste0("The genome variable cannot be NULL. Valid options are those used by ", - "the karyoploteR package (e.g. hg19, mm10, etc...)") - stop(memo) - - } - ## Check if genome is of length 1 - if (length(genome) > 1) { - memo <- paste0("The genome variable must be of length 1. Using the first value.") - genome <- genome[1] - message(memo) - } - ## Check if genome is a character - if (!is.character(genome) & !is.null(genome)) { - memo <- paste0("genome variable not of the character class. Attempting to coerce.") - genome <- as.character(genome) - message(memo) - } - ## Check if the genome exists in KaryoploteR - temp <- suppressMessages(getCytobands(genome)) - if (nrow(as.data.table(temp@seqnames))==0) { - memo <- paste0("The inputted genome is not available in the karyoploteR package, ", - "which is used to generate the cytoband positions... Please submit a request to the ", - "karyoploteR github page: https://github.com/bernatgel/karyoploteR") - stop(memo) - } - - ##### Check plotSV parameter ##### - ## Check to see if filter is a boolean - if (!is.logical(plotSV)) { - memo <- paste0("plotSV parameter is not a boolean (T/F). Coercing plotSpecificGene to be FALSE...") - plotSV <- FALSE - message(memo) - } - - ##### Check plotSpecificGene parameter ##### - ## Check if plotSpecificGene is NULL - if (is.null(plotSpecificGene)) { - plotSpecificGene <- "" - } - ## Check to see if plotSpecificGene is a booelean - if (!is.character(plotSpecificGene)) { - memo <- paste0("The plotSpecificGene variable not of the character class. Attempting to coerce...") - message(memo) - plotSpecificGene <- as.character(plotSpecificGene) - } - ##### Check plotTraGenes parameter ##### - ## Check to see if plotTraGenes is a booelean - if (!is.logical(plotTraGenes)) { - memo <- paste0("The plotTraGenes parameter is not a boolean (T/F). Coercing plotTraGenes to be FALSE...") - message(memo) - plotTraGenes <- FALSE - } - ##### Check plotOtherGenes parameter ##### - ## Check to see if plotOtherGenes is a booelean - if (!is.logical(plotOtherGenes)) { - memo <- paste0("The plotOtherGenes parameter is not a boolean (T/F). Coercing plotOtherGenes to be FALSE...") - message(memo) - plotOtherGenes <- FALSE - } - - ##### Check cytobandColor parameter ##### - ## Check if it is a character vector - if (is.null(cytobandColor)) { - memo <- paste0("cytobandColor was set to NULL. Setting the colors to Dark grey and light grey.") - message(memo) - cytobandColor <- c("Dark Grey", "Light Grey") - } - if (!is.character(cytobandColor)) { - memo <- paste0("cytobandColor variable not of the character class. Attempting to coerce.") - cytobandColor <- as.character(cytobandColor) - message(memo) - } - ## Check if desired colors are valid - areColors <- function(x) { - sapply(x, function(X) { - tryCatch(is.matrix(col2rgb(X)), - error = function(e) FALSE) - }) - } - if (any(areColors(cytobandColor) == FALSE)) { - ## Get the invalid color - nonColor <- cytobandColor[which(data.table(areColors(cytobandColor))$V1==FALSE)] - memo <- paste0("The ", nonColor, " designated in the cytobandColor parameter is not a valid color. ", - "Making the cytoband colors dark grey and light grey.") - } - - ##### Check sampleColor parameter ##### - ## Check if sampleColor is NULL - if (is.null(sampleColor)) { - ## Set the sampleColor to be of the same length as the number of samples - sampleColor <- rainbow(length(sample)) - memo <- paste0("sampleColor parameter cannot be NULL...attempting to generate distinctive colors.") - message(memo) - } - if (!is.null(sampleColor)) { - ## Check if it is a character vector - if (!is.character(sampleColor)) { - memo <- paste0("sampleColor variable not of the character class. Attempting to coerce.") - sampleColor <- as.character(sampleColor) - message(memo) - } - - ## Check if desired colors are valid - areColors <- function(x) { - sapply(x, function(X) { - tryCatch(is.matrix(col2rgb(X)), - error = function(e) FALSE) - }) - } - if (any(areColors(sampleColor) == FALSE)) { - ## Get the invalid color - nonColor <- sampleColor[which(data.table(areColors(sampleColor))$V1==FALSE)] - memo <- paste0("The ", nonColor, " designated in the sampleColor parameter is not a valid color. ", - "Making the cytoband colors dark grey and light grey.") - } - - ## If sampleColor is not NULL, check if it's length is the same as - ## the desired number of samples - if (length(sampleColor) != length(sample)) { - memo <- paste0("The number of colors for each sample (designated with the sampleColor variable) ", - "does not equal the number of samples in the sv dataset (n=", length(sample), ") .") - stop(memo) - } - } - - ##### Check plotALayers, plotBLayers, and plotC Layers parameter ##### - checkPlotLayer <- function(plotLayer, name) { - if(!is.null(plotLayer)){ - if(!is.list(plotLayer)){ - memo <- paste(name, " is not a list", sep="") - stop(memo) - } - - if(any(!unlist(lapply(plotLayer, function(x) ggplot2::is.ggproto(x) | ggplot2::is.theme(x) | is(x, "labels"))))){ - memo <- paste(name, " is not a list of ggproto or ", - "theme objects... setting plotALayers to NULL", sep="") - warning(memo) - plotLayer <- NULL - } - } - return(plotLayer) - } - plotALayers <- checkPlotLayer(plotLayer=plotALayers, "plotALayers") - plotBLayers <- checkPlotLayer(plotLayer=plotBLayers, "plotBLayers") - plotCLayers <- checkPlotLayer(plotLayer=plotCLayers, "plotCLayers") - ##### Check sectionHeights parameter ##### - ## Check if it not NULL - if (is.null(sectionHeights)) { - sectionHeights <- c(0.4, 0.1, 0.5) - memo <- paste0("sectionHeights variable cannot be NULL. Using default values.") - message(memo) - } - - ## Check that values are numeric - if (!is.numeric(sectionHeights)) { - memo <- paste0("sectionHeights valures are not class numeric. Attempting to coerce...") - message(memo) - sectionHeights <- as.numeric(sectionHeights) - } - - ## Check that the values are > 0 - if (any(sectionHeights<0)) { - memo <- paste0("sectionHeights cannot be a negative value. Using default values.") - message(memo) - sectionHeights <- c(0.4, 0.1, 0.5) - } - - ## Check that there are 3 values in the variable - if (length(sectionHeights)!=3) { - memo <- paste0("3 values must be supplied to the sectionHeights parameter, which specifies the ", - "relative height of the plot for translocations, the chromosomes, and non-translocations ", - "respectively.") - message(memo) - sectionHeights <- c(0.4, 0.1, 0.5) - } - - ## Check that the values sum up to 1 - if (sum(sectionHeights)!=1) { - memo <- paste0("sectionHeight values do not equal 1. Using default values.") - message(memo) - sectionHeights <- c(0.4, 0.1, 0.5) - } - - new("svInputParameters", BSgenome=BSgenome, filterSvCalls=filterSvCalls, - svType=svType, svOrder=svOrder, - maxSvSize=maxSvSize, sample=sample, chromosomes=chromosomes, - ensembl=ensembl, attributes=attributes, filters=filters, chrGap=chrGap, annotate=annotate, - geneAnnotationFlank=geneAnnotationFlank, genome=genome, plotSV=plotSV, plotSpecificGene=plotSpecificGene, - plotTraGenes=plotTraGenes, plotOtherGenes=plotOtherGenes, cytobandColor=cytobandColor, - plotALayers=plotALayers, plotBLayers=plotBLayers, - plotCLayers=plotCLayers, sectionHeights=sectionHeights, - sampleColor=sampleColor, verbose=verbose) -} - #' Private Class svData #' #' An S4 class for the data of the sv plot object @@ -622,11 +115,12 @@ setClass("svData", #' @name StructuralVariant #' @importFrom data.table data.table #' @noRd -svData <- function(object, BSgenome, filterSvCalls, svType, svOrder, maxSvSize, sample, +svData <- function(object, BSgenome, filter, svType, svOrder, maxSvSize, sample, chromosomes, ensembl, attributes, filters, annotate, geneAnnotationFlank, chrGap, genome, verbose) { + ## Subset data to only passed sv calls - primaryData <- getVcfData(object=object, filterSvCalls=filterSvCalls, maxSvSize=maxSvSize, + primaryData <- getVcfData(object=object, filter=filter, maxSvSize=maxSvSize, svType=svType, verbose=verbose) ## Subset data to only the chromosomes desired to be plotted @@ -654,7 +148,7 @@ svData <- function(object, BSgenome, filterSvCalls, svType, svOrder, maxSvSize, adjustedPrimaryData <- adjustCentromeres(object=primaryData, chrCytobands=chrCytobands, verbose=verbose) ## Get the new positions for SV calls and cytobands - svWindow <- getStructuralVariantWindow(object=adjustedPrimaryData, chromosomes=chromosomes, chrCytobands=chrCytobands, chrData=chrData, + svWindow <- getStructuralVariantWindow(object=adjustedPrimaryData, chrCytobands=chrCytobands, chrData=chrData, chrGap=chrGap, verbose=verbose) ## Initialize the object @@ -793,25 +287,37 @@ setMethod(f="drawPlot", setMethod(f="chrSubsetSv", signature="data.table", definition=function(object, chromosomes, verbose, ...){ + # print status message if(verbose){ memo <- paste("Performing chromosome subsets") message(memo) } - # if chromosomes is null we dont want to do anything just return all autosomes + # if chromosomes is null we dont want to do anything just return the object back if(is.null(chromosomes)){ - chromosomes <- "autosomes" - } - - ## Check format of the chromosome1 column + return(object) + } + + # perform quality checks on the chromosome parameter arguments + + # check for character vector + if(!is.character(chromosomes)){ + memo <- paste("Input to chromosomes should be a character vector, + specifying which chromosomes to plot, + attempting to coerce...") + warning(memo) + chromosomes <- as.character(chromosomes) + } + + ## Check format of the chromosome column if (!all(grepl("^chr", object$chromosome))) { if (verbose) { - memo <- paste0("Did not detect the prefix chr in the chromosome1 column ", + memo <- paste0("Did not detect the prefix chr in the chromosome1 column", "of x... adding prefix") message (memo) - object$chromosome <- paste("chr", object$chromosome, sep="") } + object$chromosome <- paste("chr", object$chromosome, sep="") } else if (all(grepl("^chr", object$chromosome))) { if (verbose) { memo <- paste0("Detected chr in the chromosome1 column of x...", @@ -830,8 +336,8 @@ setMethod(f="chrSubsetSv", memo <- paste0("Did not detect the prefix chr in the chromosome2 column", "of x... adding prefix") message (memo) - object$chromosome2 <- paste("chr", object$chromosome2, sep="") } + object$chromosome2 <- paste("chr", object$chromosome2, sep="") } else if (all(grepl("^chr", object$chromosome2))) { if (verbose) { memo <- paste0("Detected chr in the chromosome2 column of x...", @@ -847,11 +353,11 @@ setMethod(f="chrSubsetSv", ## Determine which chromosomes to plot ## Only include autosomes if (chromosomes[1] == "autosomes") { - chromosomes <- paste("chr", as.character(c(seq(1:22))), sep="") + chromosomes <- as.character(c(seq(1:22))) } ## Include all chromosomes if (chromosomes[1] == "all") { - chromosomes <- unique(c(object$chromosome, object$chromosome2)) + chromosomes <- unique(object$chromosome) chromosomes <- chromosomes[-grep("GL", chromosomes)] chromosomes <- chromosomes[-grep("MT", chromosomes)] } @@ -939,6 +445,27 @@ setMethod(f="annoGenomeCoordSv", message(memo) } + ## Perform quality check on BSgenome object + if (is.null(BSgenome)) { + memo <- paste("BSgenome object is not specified, whole chromosomes", + "will not be plotted, this is not recommended!") + warning(memo) + object$chromosome <- factor(object$chromosome, levels=gtools::mixedsort(unique(as.character(object$chromosome)))) + object$chromosome2 <- factor(object$chromosome2, levels=gtools::mixedsort(unique(as.character(object$chromosome2)))) + + return(object) + } else if (is(BSgenome, "BSgenome")) { + if(verbose){ + memo <- paste("BSgenome passed object validity checks") + } + } else { + memo <- paste("class of the BSgenome object is", class(BSgenome), + "should either be of class BSgenome or NULL", + "setting this to param to NULL") + warning(memo) + BSgenome <- NULL + } + ## Create a data table of genomic coordinates end positions genomeCoord <- data.table::as.data.table(seqlengths(BSgenome)) colnames(genomeCoord) <- c("end") @@ -1001,6 +528,18 @@ setMethod(f="sampleSubset", message(memo) } + ## If samples is null, we don't want to do anything and just return the object + if (is.null(samples)) { + return(object) + } + + ## Perform quality checkes on the sample parameter arguments + if (!is.character(samples)) { + memo <- paste("Input to samples should be a character vector, + attempting to coerce...") + warning(memo) + } + ## Check for specified samples not in the original input missingSamp <- samples[!samples %in% unique(object$sample)] if (length(missingSamp) != 0) { @@ -1151,19 +690,6 @@ setMethod(f="countGenes", ## Get the total number of samples sample_num <- length(unique(object$sample)) - ## Check if the svOrders are in the sv dataset - if (!all(svOrder %in% object@vcfObject@svType$svtype)) { - svOrder <- svOrder[which(svOrder %in% object@vcfObject@svType$svtype)] - if (length(svOrder) == 0) { - memo <- paste0("Structural variant types in the svOrder variable are not ", - "found in the SV dataset. Assigning the following order based on the ", - "mutations found in the SV dataset: ", - paste(object@vcfObject@svType$svtype, collapse=" > ")) - message(memo) - svOrder <- object@vcfObject@svType$svtype - } - } - ## Go through the list of genes and see how many times/samples it is mutated final_df <- data.table::rbindlist(apply(genes, 1, function(x, object, svOrder, sample_num) { ## Get the rows with the genes @@ -1233,7 +759,7 @@ setMethod(f="countGenes", setMethod(f="svCytobands", signature="data.table", definition=function(object, genome, chrData, verbose) { - + #browser() ## Print status message if (verbose) { message("Subsetting cytoband dataset.") @@ -1286,7 +812,7 @@ setMethod(f="svCytobands", setMethod(f="adjustCentromeres", signature="data.table", definition=function(object, chrCytobands, verbose) { - + #browser() ## Print status message if (verbose){ message("Adjusting positions of structural variants to account for centromere to aid in visualization.") @@ -1334,7 +860,7 @@ setMethod(f="adjustCentromeres", #' @noRd setMethod(f="getStructuralVariantWindow", signature="data.table", - definition=function(object, chromosomes, chrData, chrCytobands, chrGap, verbose){ + definition=function(object, chrData, chrCytobands, chrGap, verbose){ ## Print status message if (verbose) { @@ -1350,7 +876,7 @@ setMethod(f="getStructuralVariantWindow", coi <- data.table(chromosomes) } if (is.null(chromosomes)) { - coi <- data.table(chromosomes=unique(chrData$chromosome)) + coi <- unique(chrData$chromosome) } ## For each of the COI-chr combination, generate a dataset to plot @@ -1504,6 +1030,28 @@ setMethod(f="buildSvPlot", svWindow$direction <- gsub("\\[P\\[N", "5' to 5'", svWindow$direction) svWindow$svtype <- gsub("BND", "TRA", svWindow$svtype) + + ## Check the input variables + checkPlotLayer <- function(plotLayer, name) { + if(!is.null(plotLayer)){ + if(!is.list(plotLayer)){ + memo <- paste(name, " is not a list", sep="") + stop(memo) + } + + if(any(!unlist(lapply(plotLayer, function(x) ggplot2::is.ggproto(x) | ggplot2::is.theme(x) | is(x, "labels"))))){ + memo <- paste(name, " is not a list of ggproto or ", + "theme objects... setting plotALayers to NULL", sep="") + warning(memo) + plotLayer <- NULL + } + } + return(plotLayer) + } + plotALayers <- checkPlotLayer(plotLayer=plotALayers, "plotALayers") + plotBLayers <- checkPlotLayer(plotLayer=plotBLayers, "plotBLayers") + plotCLayers <- checkPlotLayer(plotLayer=plotCLayers, "plotCLayers") + ## Assign colors for samples names(sampleColor) <- sample @@ -1517,18 +1065,12 @@ setMethod(f="buildSvPlot", plotTraGenes, plotOtherGenes, plotALayers, plotBLayers, plotCLayers) { - ## Split the dataset by sample to assign color names df <- split(dataset, f=dataset$sample) dataset <- data.table::rbindlist(lapply(df, function(x, sampleColor){ if (nrow(x) > 0) { sampleName <- as.character(x$sample[1]) - if (!is.null(sampleColor)) { - x$sampleColor <- sampleColor[which(names(sampleColor) == sampleName)] - } - if (is.null(sampleColor)) { - x$sampleColor <- sampleName - } + x$sampleColor <- sampleColor[which(names(sampleColor) == sampleName)] } return(x) }, sampleColor=sampleColor)) @@ -1615,13 +1157,13 @@ setMethod(f="buildSvPlot", dataset <- dataset[Direction!="cytoband"] gene_text <- dataset[,c("Midpoint", "Total_Read_Support", "gene", "SV_Type")] ## If there is sv events for translocations, get the gene text - if (any(availableSvTypes %in% c("TRA", "BND"))) { + if (availableSvTypes %in% c("TRA", "BND")) { gene_text$Total_Read_Support[which(gene_text$SV_Type=="TRA")] <- as.numeric(as.character(gene_text$Total_Read_Support[which(gene_text$SV_Type=="TRA")])) + max(as.numeric(as.character(gene_text$Total_Read_Support[which(gene_text$SV_Type=="TRA")])))*.05 } ## If there is sv events for non-translocations, get the gene text - if (any(availableSvTypes %in% c("DEL", "DUP", "INV", "INS"))) { + if (availableSvTypes %in% c("DEL", "DUP", "INV", "INS")) { gene_text$Total_Read_Support[which(gene_text$SV_Type!="TRA")] <- as.numeric(as.character(gene_text$Total_Read_Support[which(gene_text$SV_Type!="TRA")])) + max(as.numeric(as.character(gene_text$Total_Read_Support[which(gene_text$SV_Type!="TRA")])))*.05 @@ -1646,30 +1188,22 @@ setMethod(f="buildSvPlot", } } + ########################################################## ##### Plot the translocation data ######################## ########################################################## ## Get the start/end of chromosomes in the dataset if there is translocation data ## TODO: Allow this to occur for intra-chromosomal translocations - if (any(availableSvTypes %in% c("TRA", "BND"))){ + if (availableSvTypes %in% c("TRA", "BND")){ beziers <- data.frame(data.table::rbindlist(apply(diffChrSvWindow, 1, function(x) { leftEnd <- data.table(position=as.numeric(x[2]), total_read_support=0, point="end", - type="cubic", - group=paste(as.character(x[2]), as.character(x[4]), as.character(x[5]), - as.character(x[7]), as.character(x[8]), sep="_"), - Sample=x[8], SV_Type=x[6], + type="cubic", group=as.character(x[2]), Sample=x[8], SV_Type=x[6], Direction=x[5], sampleColor=x[13]) top <- data.table(position=as.numeric(x[10]), total_read_support=as.numeric(x[7])*2, point="control", - type="cubic", - group=paste(as.character(x[2]), as.character(x[4]), as.character(x[5]), - as.character(x[7]), as.character(x[8]), sep="_"), - Sample=x[8], SV_Type=x[6], + type="cubic", group=as.character(x[2]), Sample=x[8], SV_Type=x[6], Direction=x[5], sampleColor=x[13]) rightEnd <- data.table(position=as.numeric(x[4]), total_read_support=0, point="end", - type="cubic", - group=paste(as.character(x[2]), as.character(x[4]), as.character(x[5]), - as.character(x[7]), as.character(x[8]), sep="_"), - Sample=x[8], SV_Type=x[6], + type="cubic", group=as.character(x[2]), Sample=x[8], SV_Type=x[6], Direction=x[5], sampleColor=x[13]) final <- rbind(leftEnd, top, rightEnd) return(final) @@ -1696,15 +1230,13 @@ setMethod(f="buildSvPlot", mapping=aes_string(x='Midpoint', y='Total_Read_Support', label='gene')) } ## Assign colors to sample - if (!is.null(sampleColor)) { - traPlot <- traPlot + scale_color_manual(name="Sample", values=sampleColor) - } + traPlot <- traPlot + scale_color_manual(name="Sample", values=sampleColor) } ############################################################## ##### Plot the non TRA sv events ############################# ############################################################## - if (any(availableSvTypes %in% c("DEL", "DUP", "INV", "INS"))) { + if (availableSvTypes %in% c("DEL", "DUP", "INV", "INS")) { maxY <- max(as.numeric(as.character(sameChrSvWindow$Total_Read_Support))) + 30 sameChrSvWindow$Total_Read_Support <- as.numeric(sameChrSvWindow$Total_Read_Support) nonTraPlot <- ggplot() + geom_point(data=sameChrSvWindow, @@ -1722,9 +1254,7 @@ setMethod(f="buildSvPlot", mapping=aes_string(x='Midpoint', y='Total_Read_Support', label='gene')) } ## Assign colors to sample - if (!is.null(sampleColor)) { - nonTraPlot <- nonTraPlot + scale_color_manual(name="Sample", values=sampleColor) - } + nonTraPlot <- nonTraPlot + scale_color_manual(name="Sample", values=sampleColor) } ############################################################## diff --git a/R/VCF_Virtual-class.R b/R/VCF_Virtual-class.R index 12e718f..c6e9eaa 100644 --- a/R/VCF_Virtual-class.R +++ b/R/VCF_Virtual-class.R @@ -23,14 +23,14 @@ setClass( ################################################################################ ###################### Accessor function definitions ########################### -#' @name getHeader -#' @rdname getHeader-methods -#' @aliases getHeader -setMethod(f="getHeader", +#' @name getVcf +#' @rdname getVcf-methods +#' @aliases getVcf +setMethod(f="getVcf", signature="VCF_Virtual", definition=function(object, ...){ - header <- object@description - return(header) + vcf <- object@vcf + return(vcf) }) #' @name getSample @@ -41,22 +41,4 @@ setMethod(f="getSample", definition=function(object, ...){ sample <- object@sample return(sample) - }) - -#' @rdname getMeta-methods -#' @aliases getMeta -setMethod(f="getMeta", - signature="VCF_Virtual", - definition=function(object, ...) { - meta <- object@vcfData - return(meta) - }) - -#' @rdname getMutation-methods -#' @aliases getMutation -setMethod(f="getMutation", - signature="VCF_Virtual", - definition=function(object, ...) { - mutation <- object@svType - return(mutation) }) \ No newline at end of file diff --git a/R/VariantCallFormat-class.R b/R/VariantCallFormat-class.R index 20c9b7c..de36f97 100644 --- a/R/VariantCallFormat-class.R +++ b/R/VariantCallFormat-class.R @@ -37,12 +37,21 @@ setClass("VariantCallFormat", #' Only used when paired=TRUE. #' @param verbose Bolean specifying if progress should be reported while reading #' in the VCF file +#' @details When specifying a path to a VCF file, the option exists to either +#' specify the full path to a vcf file or to us wildcards to specify multiple +#' files. When specifying a full path, the initializer will check if a column +#' named "sample" containing the relevant sample for each row exists. If such a +#' column is not found, the initializer will assume this file correspnds to +#' only one sample and populate a sample column accordingly. Alternatively, if +#' multiple files are specified at once using a wildcard, the initializer will +#' aggregate all the files and use the filenames minus any extension to +#' populate the "sample" column. #' @importFrom data.table fread #' @importFrom data.table rbindlist #' @importFrom data.table data.table #' @export VariantCallFormat <- function(path=NULL, data=NULL, version="auto", svCaller=NULL, paired=paired, - tumorColumn=tumorColumn, verbose=FALSE) { + tumorColumn=tumorColumn, verbose=FALSE) { ## Check if both path and data are both null if (is.null(path) & is.null(data)) { @@ -79,9 +88,9 @@ VariantCallFormat <- function(path=NULL, data=NULL, version="auto", svCaller=NUL ## Find where the headers stops and read the data skip <- length(header) vcfData <- suppressWarnings(data.table::fread(input=x, - stringsAsFactors=TRUE, - verbose=verbose, - skip=skip)) + stringsAsFactors=TRUE, + verbose=verbose, + skip=skip)) ## Set sample if it is not already in the data table if(any(colnames(vcfData) %in% "sample")){ @@ -211,71 +220,6 @@ VariantCallFormat <- function(path=NULL, data=NULL, version="auto", svCaller=NUL new("VariantCallFormat", path=path, vcfObject=vcfObject, version=as.character(version)) } -################################################################################ -###################### Accessor function definitions ########################### - -#' @rdname writeData-methods -#' @aliases writeData -setMethod(f="writeData", - signature="VariantCallFormat", - definition=function(object, file, ...){ - writeData(object@vcfObject@vcfData, file, sep="\t") - }) - -#' @rdname getVersion-methods -#' @aliases getVersion -setMethod(f="getVersion", - signature="VariantCallFormat", - definition=function(object, ...) { - version <- object@version - return(version) - }) - -#' @rdname getPath-methods -#' @aliases getPath -setMethod(f="getPath", - signature="VariantCallFormat", - definition=function(object, ...){ - path <- object@path - return(path) - }) - -#' @rdname getHeader-methods -#' @aliases getHeader -setMethod(f="getHeader", - signature="VariantCallFormat", - definition=function(object, ...) { - header <- getHeader(object@vcfObject) - return(header) - }) - -#' @rdname getSample-methods -#' @aliases getSample -setMethod(f="getSample", - signature="VariantCallFormat", - definition=function(object, ...) { - sample <- getSample(object@vcfObject) - return(sample) - }) - -#' @rdname getMeta-methods -#' @aliases getMeta -setMethod(f="getMeta", - signature="VariantCallFormat", - definition=function(object, ...) { - meta <- getMeta(object@vcfObject) - return(meta) - }) - -#' @rdname getMutation-methods -#' @aliases getMutation -setMethod(f="getMutation", - signature="VariantCallFormat", - definition=function(object, ...) { - mutations <- getMutation(object@vcfObject) - return(mutations) - }) - ################################################################################ ####################### Method function definitions ############################ @@ -286,9 +230,9 @@ setMethod(f="getMutation", #' @importFrom data.table data.table setMethod(f="getVcfData", signature="VariantCallFormat", - definition=function(object, filterSvCalls, maxSvSize, svType, + definition=function(object, filter, maxSvSize, svType, verbose, ...) { - + ## Print status message if (verbose) { memo <- paste0("converting ", class(object), " to expected ", @@ -296,31 +240,13 @@ setMethod(f="getVcfData", message(memo) } - availableSvTypes <- object@vcfObject@svType$svtype object <- object@vcfObject@vcfData ## Filter out sv calls that are not "PASS" - if (filterSvCalls == TRUE) { + if (filter == TRUE) { object <- object[FILTER=="PASS"] } - ## Check if the sv types are found in the actual sv dataset - if (!is.null(svType)) { - svType <- svType[which(svType %in% availableSvTypes)] - if (length(svType) == 0) { - memo <- paste0("The desired sv types as designated in the svType ", - "variable are not found in the sv dataset. Setting ", - "svType to NULL, which will include all sv's in the dataset.") - message(memo) - svType <- NULL - } - } - if (!is.numeric(maxSvSize) & !is.null(maxSvSize)) { - memo <- paste0("maxSvSize variable not of the numeric class. Attempting to coerce.") - maxSvSize <- as.numeric(maxSvSize) - message(memo) - } - ## Remove large SV if (is.null(maxSvSize) == FALSE) { ## Get the difference in positions @@ -339,7 +265,7 @@ setMethod(f="getVcfData", ## Remove sv types that are not necessary available_svTypes <- unlist(as.vector(object$svtype)) - if (length(svType) > 0 & !is.null(svType)) { + if (length(svType) > 0) { ## Check to see if the SV type is in the data.table ## Perform the subset if svtype is available if (all(svType %in% available_svTypes)) { @@ -352,8 +278,7 @@ setMethod(f="getVcfData", stop(memo) } } - ## Stop the return(object) - }) + }) diff --git a/vignettes/Visualizing_Large_Scale_Chromosomal_Aberrations.Rmd b/vignettes/Visualizing_Large_Scale_Chromosomal_Aberrations.Rmd index 6770099..7bb18d1 100644 --- a/vignettes/Visualizing_Large_Scale_Chromosomal_Aberrations.Rmd +++ b/vignettes/Visualizing_Large_Scale_Chromosomal_Aberrations.Rmd @@ -123,7 +123,7 @@ attributes <- c("hgnc_symbol") filters <- c("chromosome_name", "start", "end") BSgenome <- getBSgenome(genome = "BSgenome.Hsapiens.UCSC.hg19") -waterfallPlot <- StructuralVariant(input=vcfObject, BSgenome=BSgenome, ) +structuralVariantPlots <- StructuralVariant(input=vcfObject, BSgenome=BSgenome, annotate=FALSE) ``` With the plot object created we can view the actual data making up the plot with the `getData()` function. This is an accessor function to pull out specific data making up the plot (Refer to the R documentation for `Waterfall()` to see available slots in the object which hold data). Let's use it here to extract the data making up the main plot panel, we can specify the slot either by name or it's index. From 8a1201303e908580cef1f3ecb4eb05ac46e88213 Mon Sep 17 00:00:00 2001 From: Jason kunisaki Date: Mon, 30 Apr 2018 20:12:26 -0500 Subject: [PATCH 15/21] sv update --- R/AllGenerics.R | 11 + R/StructuralVariant-class.R | 709 ++++++++++++++++++++++++++++++------ R/VCF_Virtual-class.R | 30 +- R/VariantCallFormat-class.R | 111 +++++- 4 files changed, 720 insertions(+), 141 deletions(-) diff --git a/R/AllGenerics.R b/R/AllGenerics.R index 9b033d6..82b88dd 100644 --- a/R/AllGenerics.R +++ b/R/AllGenerics.R @@ -942,4 +942,15 @@ setGeneric( setGeneric( name="getVcfData", def=function(object, ...){standardGeneric("getVcfData")} +) + +#' Method checkSvInputParameters +#' +#' @name checkSvInputParameters +#' @rdname checkSvInputParameters-methods +#' @param ... additional arguments to passed +#' @noRd +setGeneric( + name="checkSvInputParameters", + def=function(object, ...){standardGeneric("checkSvInputParameters")} ) \ No newline at end of file diff --git a/R/StructuralVariant-class.R b/R/StructuralVariant-class.R index 61fbdbc..9298e94 100644 --- a/R/StructuralVariant-class.R +++ b/R/StructuralVariant-class.R @@ -18,7 +18,7 @@ setClass("StructuralVariant", representation=representation(svData="data.table", geneData="data.table", - svPlots="list"), + svPlots="svPlots"), validity=function(object) { }) @@ -33,7 +33,7 @@ setClass("StructuralVariant", #' @param object OBject of class VCF #' @param BSgenome Object of class BSgenome to extract genome wide chromosome #' coordinates -#' @param filter Boolean specifying if SV calls that did not pass should be removed +#' @param filterSvCalls Boolean specifying if SV calls that did not pass should be removed #' @param svType Character vector specifying which structural variant types to annotate/visualize #' @param svOrder Character vector specifying the deleterious order of sv types (most to least deleterious) #' @param maxSvSize Numeric specifying the maximum size of SV events (DEL/DUP/INV only) @@ -56,12 +56,12 @@ setClass("StructuralVariant", #' @param plotALAyers List of ggplot2 layers to be passed to translocation plot #' @param plotBLayers List of ggplot2 layers to be passed to chromosome plot #' @param plotCLayers List of ggplot2 layers to be passed to non-translocation plot -#' @param outputDir Character value for directory to output SV visualizations -#' @param plotWidth Integer for width of SV visualizations -#' @param plotHeight Integer for height of SV visualizations +#' @sectionHeights Integer vector of length 3 specifying the relative heights for each of +#' the plots (TRA, chr, non-TRA). The sum of the 3 integers must be 1. +#' Defaults to 0.4, 0.1, and 0.5 #' @param verbose Boolean specifying if status messages should be reported #' @export -StructuralVariant <- function(input, BSgenome=NULL, filter=TRUE, svType=NULL, +StructuralVariant <- function(input, BSgenome=NULL, filterSvCalls=TRUE, svType=NULL, svOrder=c("TRA", "BND", "DEL", "DUP", "INV", "INS"), maxSvSize=NULL, sample=NULL, chromosomes=NULL, ensembl=ensembl, attributes=attributes, filters=filters, @@ -69,21 +69,53 @@ StructuralVariant <- function(input, BSgenome=NULL, filter=TRUE, svType=NULL, plotSV=plotSV, plotSpecificGene=FALSE, plotTraGenes=FALSE, plotOtherGenes=FALSE, chrGap=5000000, genome="hg19", cytobandColor=c("White", "Grey"), - sampleColor=NULL, verbose=FALSE, plotALayers=NULL, - plotBLayers=NULL, plotCLayers=NULL) { + sampleColor=NULL, plotALayers=NULL, + plotBLayers=NULL, plotCLayers=NULL, + sectionHeights=c(0.4, 0.1, 0.5), verbose=FALSE) { + ## Check the input parameters + inputParameters <- checkSvInputParameters(object=input, BSgenome=BSgenome, + filterSvCalls=filterSvCalls, + svType=svType, svOrder=svOrder, + maxSvSize=maxSvSize, + sample=sample, + chromosomes=chromosomes, + ensembl=ensembl, attributes=attributes, + filters=filters, chrGap=chrGap, annotate=annotate, + geneAnnotationFlank=geneAnnotationFlank, genome=genome, + plotSV=plotSV, plotSpecificGene=plotSpecificGene, + plotTraGenes=plotTraGenes, plotOtherGenes=plotOtherGenes, + cytobandColor=cytobandColor, + plotALayers=plotALayers, plotBLayers=plotBLayers, + plotCLayers=plotCLayers, sectionHeights=sectionHeights, + sampleColor=sampleColor, verbose=verbose) + ## Calculate all data for the plots - svDataset <- svData(object=input, BSgenome=BSgenome, filter=filter, svType=svType, svOrder=svOrder, - maxSvSize=maxSvSize, sample=sample, chromosomes=chromosomes, - ensembl=ensembl, attributes=attributes, filters=filters, chrGap=chrGap, annotate=annotate, - geneAnnotationFlank=geneAnnotationFlank, genome=genome, verbose=verbose) + svDataset <- svData(object=input, BSgenome=inputParameters@BSgenome, + filterSvCalls=inputParameters@filterSvCalls, + svType=inputParameters@svType, svOrder=inputParameters@svOrder, + maxSvSize=inputParameters@maxSvSize, sample=inputParameters@sample, + chromosomes=inputParameters@chromosomes, + ensembl=inputParameters@ensembl, attributes=inputParameters@attributes, + filters=inputParameters@filters, chrGap=inputParameters@chrGap, + annotate=inputParameters@annotate, + geneAnnotationFlank=inputParameters@geneAnnotationFlank, + genome=inputParameters@genome, verbose=inputParameters@verbose) ## Create the plots from svData - structuralVariantPlots <- svPlots(object=svDataset, plotSV=plotSV, plotSpecificGene=plotSpecificGene, - plotTraGenes=plotTraGenes, plotOtherGenes=plotOtherGenes, cytobandColor=cytobandColor, - plotALayers=plotALayers, plotBLayers=plotBLayers, - plotCLayers=plotCLayers, sectionHeights=sectionHeights, - sample=sample, sampleColor=sampleColor, verbose=verbose) + structuralVariantPlots <- svPlots(object=svDataset, + plotSV=inputParameters@plotSV, + plotSpecificGene=inputParameters@plotSpecificGene, + plotTraGenes=inputParameters@plotTraGenes, + plotOtherGenes=inputParameters@plotOtherGenes, + cytobandColor=inputParameters@cytobandColor, + plotALayers=inputParameters@plotALayers, + plotBLayers=inputParameters@plotBLayers, + plotCLayers=inputParameters@plotCLayers, + sectionHeights=inputParameters@sectionHeights, + sample=inputParameters@sample, + sampleColor=inputParameters@sampleColor, + verbose=inputParameters@verbose) ## Intialize the object new("StructuralVariant", svData=getData(object=svDataset, name="primaryData"), @@ -93,6 +125,486 @@ StructuralVariant <- function(input, BSgenome=NULL, filter=TRUE, svType=NULL, #!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Private Classes !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!# +#' Private Class svInputParameters +#' +#' An S4 class to check input parameters of the StructuralVariant function +#' @name svInputParameters-class +#' @noRd +setClass("svInputParameters", + representation=representation(BSgenome="BSgenome", filterSvCalls="logical", svType="character", + svOrder="character", maxSvSize="numeric", + sample="character", chromosomes="character", + ensembl="Mart", attributes="character", + filters="character", chrGap="numeric", + annotate="logical", geneAnnotationFlank="numeric", + genome="character", plotSV="logical", + plotSpecificGene="character", plotTraGenes="logical", + plotOtherGenes="logical", cytobandColor="character", + plotALayers="list", plotBLayers="list", + plotCLayers="list", sectionHeights="numeric", + sampleColor="character", verbose="logical"), + validity=function(object){ + + }) + +#' Constructor for the svInputParameters class +#' +#' @name svInputParameters +#' @rdname svInputParameters-class +#' @importFrom karyoploteR getCytobands +#' @noRd +checkSvInputParameters <- function(object, BSgenome, filterSvCalls, svType, svOrder, maxSvSize, + sample, chromosomes, ensembl, attributes, + filters, chrGap, annotate, geneAnnotationFlank, + genome, plotSV, plotSpecificGene, plotTraGenes, + plotOtherGenes, cytobandColor, plotALayers, plotBLayers, + plotCLayers, sectionHeights, sampleColor, verbose, ...) { + browser() + ##### Check verbose parameter ##### + ## Check to see if verbose is a booelean + if (!is.logical(verbose) | is.null(verbose)) { + memo <- paste0("The verbose parameter is not a boolean (T/F). Coercing verbose to be FALSE...") + message(memo) + verbose <- FALSE + } + + ##### Check BSgenome parameter ##### + ## Check to see if BSgenome is a BSgenome + if (is.null(BSgenome)) { + memo <- paste("BSgenome object is not specified, whole chromosomes", + "will not be plotted, this is not recommended!") + warning(memo) + } else if (is(BSgenome, "BSgenome")) { + memo <- paste("BSgenome passed object validity checks") + message(memo) + } else { + memo <- paste("class of the BSgenome object is", class(BSgenome), + "should either be of class BSgenome or NULL", + "setting this to param to NULL") + warning(memo) + BSgenome <- NULL + } + + ##### Check filterSvCalls parameter ##### + ## Check to see if filterSvCalls is a boolean + if (is.null(filterSvCalls) | !is.logical(filterSvCalls)) { + memo <- paste0("The filterSvCalls parameter is not a boolean (T/F). Coercing filterSvCalls to be FALSE...") + message(memo) + filterSvCalls <- FALSE + } + + ##### Check svType parameter ##### + ## Check if it null + if (is.null(svType)) { + svType <- as.character(object@vcfObject@svType$svtype) + memo <- paste0("svType variable cannot be NULL. Using all of the sv types ", + "available in the sv dataset") + message(memo) + } + ## check if svType is a character vector + if (!is.character(svType)) { + memo <- paste0("svType variable not of the character class. Attempting to coerce.") + svType <- as.character(svType) + message(memo) + } + + ##### Check svOrder parameter ##### + ## Check if svOrder is NULL + if (is.null(svOrder)) { + svOrder <- svType + memo <- paste0("svOrder variable cannot be NULL. Setting the deleterious order ", + "of sv events to that designated in the svType: ", + paste(svType, collapse=", ")) + message(memo) + } + if (!is.character(svOrder)) { + memo <- paste0("svOrder variable not of the character class. Attempting to coerce.") + svOrder <- as.character(svOrder) + message(memo) + } + + ##### Check maxSvSize parameter ##### + ## Check if maxSvSize is NULL + if (is.null(maxSvSize)) { + maxSvSize <- 0 + memo <- paste0("maxSvSize parameter cannot be NULL. Setting the maxSvSize value to 0.") + message(memo) + } + ## Check if maxSvSize is numeric + if (!is.numeric(maxSvSize)) { + memo <- paste0("maxSvSize variable not of the numeric class. Attempting to coerce.") + maxSvSize <- as.numeric(maxSvSize) + message(memo) + } + + ##### Check sample parameter ##### + ## Check is sample is NULL + if (is.null(sample)) { + sample <- unique(object@vcfObject@sample$sample) + memo <- paste0("Sample parameter cannot be NULL. All samples will be plotted.") + } + ## Check if sample is a character vector + if (!is.character(sample)) { + memo <- paste0("sample variable not of the character class. Attempting to coerce.") + sample <- as.character(sample) + message(memo) + } + + ##### Check chromosomes parameter ##### + ## Check is chromosomes is NULL + if (is.null(chromosomes)) { + chromosomes <- paste("chr", seq(1:22), sep="") + memo <- paste0("chromosomes parameter cannot be NULL. Using all autosomes...") + message(memo) + } + ## Check if chromosomes is a character vector + if (!is.character(chromosomes)) { + memo <- paste0("chromosomes variable not of the character class. Attempting to coerce.") + chromosomes <- as.character(chromosomes) + message(memo) + } + ## Check if it has the "chr" prefix + # Check to see if the chromosomes variable has "chr" in front if not NULL, autosomes, or all + if (all(chromosomes!="autosomes") & all(chromosomes!="all")) { + if (!all(grepl("^chr", chromosomes))) { + if (verbose) { + memo <- paste0("Did not detect the prefix chr in the chromosomes specified ", + "in the `chromosomes` variable... adding prefix") + message(memo) + chromosomes <- paste("chr", chromosomes, sep="") + } + } else if (all(grepl("^chr", chromosomes))) { + if (verbose) { + memo <- paste0("Detected chr in the `chromosomes` variable...", + "proceeding") + message(memo) + } + } else { + memo <- paste0("Detected unknown or mixed prefixes in the `chromosomes`` variable", + " colum of object... should either be chr or non (i.e.) chr1 or 1") + message(memo) + } + } + ##### Check annotate parameter ##### + ## Check if annotate is a boolean + if (!is.logical(annotate) | is.null(annotate)) { + memo <- paste0("The annotate parameter is not a boolean (T/F). Coercing annotate to be FALSE...") + message(memo) + annotate <- FALSE + } + ##### Check ensembl parameter ##### + ## Check if ensembl is of class "mart" + if (is.null(ensembl)) { + memo <- paste("ensembl object cannot be NULL if SV annotations are desired, ", + "in which case, the ensembl object must be of class Mart...") + if (!annotate) { + warning(memo) + } + if (annotate) { + stop(memo) + } + } + else if (is(ensembl, "Mart")) { + memo <- paste("ensembl passed object validity checks") + message(memo) + } + else { + memo <- paste("class of the ensembl object is", class(ensembl), + "should either be of class ensembl or NULL", + "setting this to param to NULL and will not perform ", + "sv annotations.") + warning(memo) + ensembl <- NULL + annotate <- FALSE + + } + + ##### Check if attributes and filters are valid ##### + if (annotate) { + ## If ensembl is not NULL, check if these are character vectors + if (!is.null(ensembl) & (!is.character(attributes))) { + if (is.null(attributes)) { + memo <- paste0("If annotations are desired, the attributes parameter ", + "cannot be NULL. These values are used to specify the ouput ", + "for biomaRt annotations.") + stop(memo) + } + memo <- paste0("attributes variable not of the character class. Attempting to coerce.") + attributes <- as.character(attributes) + message(memo) + } + if (!is.null(ensembl) & (!is.character(filters))) { + if (is.null(filters)) { + memo <- paste0("If annotations are desired, the filters parameter ", + "cannot be NULL. These values are used to specify the input ", + "for biomaRt annotations.") + stop(memo) + } + memo <- paste0("filters variable not of the character class. Attempting to coerce.") + filters <- as.character(filters) + message(memo) + } + + ## If ensembl is not NULL, check that these are valid inputs for getBM + if (!is.null(ensembl)) { + temp <- data.table(listAttributes(mart=ensembl)) + if (!all(attributes %in% temp$name)) { + `%nin%` = Negate(`%in%`) + discrepantAttributes <- attributes[which(attributes %nin% temp$name)] + memo <- paste0("The following attributes: ", paste(discrepantAttributes, collapse="|"), + " are not valid inputs for the designated ensembl database. Please run ", + "biomaRt::listAttributes(ensembl) to get valid attributes.") + stop(memo) + } + temp <- data.table(listFilters(mart=ensembl)) + if (!all(filters %in% temp$name)) { + `%nin%` = Negate(`%in%`) + discrepantFilters <- filters[which(filters %nin% temp$name)] + memo <- paste0("The following filters: ", paste(discrepantFilters, collapse="|"), + " are not valid inputs for the designated ensembl database. Please run ", + "biomaRt::listFilters(ensembl) to get valid filters") + stop(memo) + } + } + + ## If ensembl is NULL, set these variables to NULL + if (is.null(ensembl)) { + attributes <- NULL + filters <- NULL + } + } + + ##### Check chrGap parameter ##### + ## Check if chrGap is NULL + if (is.null(chrGap)) { + chrGap <- 5000000 + memo <- paste0("chrGap variable cannot be NULL. Using the default value of 5,000,000.") + } + ## Check if chrGap is numeric + if (!is.numeric(chrGap)) { + memo <- paste0("chrGap variable not of the numeric class. Attempting to coerce.") + chrGap <- as.numeric(chrGap) + message(memo) + } + + ##### Check geneAnnotationFlank parameter ##### + ## Check if geneAnnotationFlank is NULL + if (is.null(geneAnnotationFlank)) { + geneAnnotationFlank <- 10000 + memo <- paste0("geneAnnotationFlank variable cannot be NULL. Setting the variable's ", + "value to 10,000 base pairs.") + message(memo) + } + ## Check if geneAnnotationFlank is numeric and is greater than 0 + if (!is.numeric(geneAnnotationFlank)) { + memo <- paste0("geneAnnotationFlank variable not of the numeric class. Attempting to coerce.") + geneAnnotationFlank <- as.numeric(geneAnnotationFlank) + message(memo) + if (geneAnnotationFlank < 0) { + memo <- paste0("geneAnnotationFlank cannot be a negative number. Changing ", + "geneAnnotationFlank to be 0.") + message(memo) + geneAnnotationFlank <- 0 + } + } + + ##### Check genome parameter ##### + ## Check if genome is not NULL + if (is.null(genome)) { + memo <- paste0("The genome variable cannot be NULL. Valid options are those used by ", + "the karyoploteR package (e.g. hg19, mm10, etc...)") + stop(memo) + + } + ## Check if genome is of length 1 + if (length(genome) > 1) { + memo <- paste0("The genome variable must be of length 1. Using the first value.") + genome <- genome[1] + message(memo) + } + ## Check if genome is a character + if (!is.character(genome) & !is.null(genome)) { + memo <- paste0("genome variable not of the character class. Attempting to coerce.") + genome <- as.character(genome) + message(memo) + } + ## Check if the genome exists in KaryoploteR + temp <- suppressMessages(getCytobands(genome)) + if (nrow(as.data.table(temp@seqnames))==0) { + memo <- paste0("The inputted genome is not available in the karyoploteR package, ", + "which is used to generate the cytoband positions... Please submit a request to the ", + "karyoploteR github page: https://github.com/bernatgel/karyoploteR") + stop(memo) + } + + ##### Check plotSV parameter ##### + ## Check to see if filter is a boolean + if (!is.logical(plotSV)) { + memo <- paste0("plotSV parameter is not a boolean (T/F). Coercing plotSpecificGene to be FALSE...") + plotSV <- FALSE + message(memo) + } + + ##### Check plotSpecificGene parameter ##### + ## Check if plotSpecificGene is NULL + if (is.null(plotSpecificGene)) { + plotSpecificGene <- "" + } + ## Check to see if plotSpecificGene is a booelean + if (!is.character(plotSpecificGene)) { + memo <- paste0("The plotSpecificGene variable not of the character class. Attempting to coerce...") + message(memo) + plotSpecificGene <- as.character(plotSpecificGene) + } + ##### Check plotTraGenes parameter ##### + ## Check to see if plotTraGenes is a booelean + if (!is.logical(plotTraGenes)) { + memo <- paste0("The plotTraGenes parameter is not a boolean (T/F). Coercing plotTraGenes to be FALSE...") + message(memo) + plotTraGenes <- FALSE + } + ##### Check plotOtherGenes parameter ##### + ## Check to see if plotOtherGenes is a booelean + if (!is.logical(plotOtherGenes)) { + memo <- paste0("The plotOtherGenes parameter is not a boolean (T/F). Coercing plotOtherGenes to be FALSE...") + message(memo) + plotOtherGenes <- FALSE + } + + ##### Check cytobandColor parameter ##### + ## Check if it is a character vector + if (is.null(cytobandColor)) { + memo <- paste0("cytobandColor was set to NULL. Setting the colors to Dark grey and light grey.") + message(memo) + cytobandColor <- c("Dark Grey", "Light Grey") + } + if (!is.character(cytobandColor)) { + memo <- paste0("cytobandColor variable not of the character class. Attempting to coerce.") + cytobandColor <- as.character(cytobandColor) + message(memo) + } + ## Check if desired colors are valid + areColors <- function(x) { + sapply(x, function(X) { + tryCatch(is.matrix(col2rgb(X)), + error = function(e) FALSE) + }) + } + if (any(areColors(cytobandColor) == FALSE)) { + ## Get the invalid color + nonColor <- cytobandColor[which(data.table(areColors(cytobandColor))$V1==FALSE)] + memo <- paste0("The ", nonColor, " designated in the cytobandColor parameter is not a valid color. ", + "Making the cytoband colors dark grey and light grey.") + } + + ##### Check sampleColor parameter ##### + ## Check if sampleColor is NULL + if (is.null(sampleColor)) { + ## Set the sampleColor to be of the same length as the number of samples + sampleColor <- rainbow(length(sample)) + memo <- paste0("sampleColor parameter cannot be NULL...attempting to generate distinctive colors.") + message(memo) + } + if (!is.null(sampleColor)) { + ## Check if it is a character vector + if (!is.character(sampleColor)) { + memo <- paste0("sampleColor variable not of the character class. Attempting to coerce.") + sampleColor <- as.character(sampleColor) + message(memo) + } + + ## Check if desired colors are valid + areColors <- function(x) { + sapply(x, function(X) { + tryCatch(is.matrix(col2rgb(X)), + error = function(e) FALSE) + }) + } + if (any(areColors(sampleColor) == FALSE)) { + ## Get the invalid color + nonColor <- sampleColor[which(data.table(areColors(sampleColor))$V1==FALSE)] + memo <- paste0("The ", nonColor, " designated in the sampleColor parameter is not a valid color. ", + "Making the cytoband colors dark grey and light grey.") + } + + ## If sampleColor is not NULL, check if it's length is the same as + ## the desired number of samples + if (length(sampleColor) != length(sample)) { + memo <- paste0("The number of colors for each sample (designated with the sampleColor variable) ", + "does not equal the number of samples in the sv dataset (n=", length(sample), ") .") + stop(memo) + } + } + + ##### Check plotALayers, plotBLayers, and plotC Layers parameter ##### + checkPlotLayer <- function(plotLayer, name) { + if(!is.null(plotLayer)){ + if(!is.list(plotLayer)){ + memo <- paste(name, " is not a list", sep="") + stop(memo) + } + + if(any(!unlist(lapply(plotLayer, function(x) ggplot2::is.ggproto(x) | ggplot2::is.theme(x) | is(x, "labels"))))){ + memo <- paste(name, " is not a list of ggproto or ", + "theme objects... setting plotALayers to NULL", sep="") + warning(memo) + plotLayer <- NULL + } + } + return(plotLayer) + } + plotALayers <- checkPlotLayer(plotLayer=plotALayers, "plotALayers") + plotBLayers <- checkPlotLayer(plotLayer=plotBLayers, "plotBLayers") + plotCLayers <- checkPlotLayer(plotLayer=plotCLayers, "plotCLayers") + ##### Check sectionHeights parameter ##### + ## Check if it not NULL + if (is.null(sectionHeights)) { + sectionHeights <- c(0.4, 0.1, 0.5) + memo <- paste0("sectionHeights variable cannot be NULL. Using default values.") + message(memo) + } + + ## Check that values are numeric + if (!is.numeric(sectionHeights)) { + memo <- paste0("sectionHeights valures are not class numeric. Attempting to coerce...") + message(memo) + sectionHeights <- as.numeric(sectionHeights) + } + + ## Check that the values are > 0 + if (any(sectionHeights<0)) { + memo <- paste0("sectionHeights cannot be a negative value. Using default values.") + message(memo) + sectionHeights <- c(0.4, 0.1, 0.5) + } + + ## Check that there are 3 values in the variable + if (length(sectionHeights)!=3) { + memo <- paste0("3 values must be supplied to the sectionHeights parameter, which specifies the ", + "relative height of the plot for translocations, the chromosomes, and non-translocations ", + "respectively.") + message(memo) + sectionHeights <- c(0.4, 0.1, 0.5) + } + + ## Check that the values sum up to 1 + if (sum(sectionHeights)!=1) { + memo <- paste0("sectionHeight values do not equal 1. Using default values.") + message(memo) + sectionHeights <- c(0.4, 0.1, 0.5) + } + + new("svInputParameters", BSgenome=BSgenome, filterSvCalls=filterSvCalls, + svType=svType, svOrder=svOrder, + maxSvSize=maxSvSize, sample=sample, chromosomes=chromosomes, + ensembl=ensembl, attributes=attributes, filters=filters, chrGap=chrGap, annotate=annotate, + geneAnnotationFlank=geneAnnotationFlank, genome=genome, plotSV=plotSV, plotSpecificGene=plotSpecificGene, + plotTraGenes=plotTraGenes, plotOtherGenes=plotOtherGenes, cytobandColor=cytobandColor, + plotALayers=plotALayers, plotBLayers=plotBLayers, + plotCLayers=plotCLayers, sectionHeights=sectionHeights, + sampleColor=sampleColor, verbose=verbose) +} + #' Private Class svData #' #' An S4 class for the data of the sv plot object @@ -115,12 +627,11 @@ setClass("svData", #' @name StructuralVariant #' @importFrom data.table data.table #' @noRd -svData <- function(object, BSgenome, filter, svType, svOrder, maxSvSize, sample, +svData <- function(object, BSgenome, filterSvCalls, svType, svOrder, maxSvSize, sample, chromosomes, ensembl, attributes, filters, annotate, geneAnnotationFlank, chrGap, genome, verbose) { - ## Subset data to only passed sv calls - primaryData <- getVcfData(object=object, filter=filter, maxSvSize=maxSvSize, + primaryData <- getVcfData(object=object, filterSvCalls=filterSvCalls, maxSvSize=maxSvSize, svType=svType, verbose=verbose) ## Subset data to only the chromosomes desired to be plotted @@ -148,7 +659,7 @@ svData <- function(object, BSgenome, filter, svType, svOrder, maxSvSize, sample, adjustedPrimaryData <- adjustCentromeres(object=primaryData, chrCytobands=chrCytobands, verbose=verbose) ## Get the new positions for SV calls and cytobands - svWindow <- getStructuralVariantWindow(object=adjustedPrimaryData, chrCytobands=chrCytobands, chrData=chrData, + svWindow <- getStructuralVariantWindow(object=adjustedPrimaryData, chromosomes=chromosomes, chrCytobands=chrCytobands, chrData=chrData, chrGap=chrGap, verbose=verbose) ## Initialize the object @@ -293,31 +804,15 @@ setMethod(f="chrSubsetSv", memo <- paste("Performing chromosome subsets") message(memo) } - - # if chromosomes is null we dont want to do anything just return the object back - if(is.null(chromosomes)){ - return(object) - } - - # perform quality checks on the chromosome parameter arguments - - # check for character vector - if(!is.character(chromosomes)){ - memo <- paste("Input to chromosomes should be a character vector, - specifying which chromosomes to plot, - attempting to coerce...") - warning(memo) - chromosomes <- as.character(chromosomes) - } - - ## Check format of the chromosome column + + ## Check format of the chromosome1 column if (!all(grepl("^chr", object$chromosome))) { if (verbose) { - memo <- paste0("Did not detect the prefix chr in the chromosome1 column", + memo <- paste0("Did not detect the prefix chr in the chromosome1 column ", "of x... adding prefix") message (memo) + object$chromosome <- paste("chr", object$chromosome, sep="") } - object$chromosome <- paste("chr", object$chromosome, sep="") } else if (all(grepl("^chr", object$chromosome))) { if (verbose) { memo <- paste0("Detected chr in the chromosome1 column of x...", @@ -336,8 +831,8 @@ setMethod(f="chrSubsetSv", memo <- paste0("Did not detect the prefix chr in the chromosome2 column", "of x... adding prefix") message (memo) + object$chromosome2 <- paste("chr", object$chromosome2, sep="") } - object$chromosome2 <- paste("chr", object$chromosome2, sep="") } else if (all(grepl("^chr", object$chromosome2))) { if (verbose) { memo <- paste0("Detected chr in the chromosome2 column of x...", @@ -353,11 +848,11 @@ setMethod(f="chrSubsetSv", ## Determine which chromosomes to plot ## Only include autosomes if (chromosomes[1] == "autosomes") { - chromosomes <- as.character(c(seq(1:22))) + chromosomes <- paste("chr", as.character(c(seq(1:22))), sep="") } ## Include all chromosomes if (chromosomes[1] == "all") { - chromosomes <- unique(object$chromosome) + chromosomes <- unique(c(object$chromosome, object$chromosome2)) chromosomes <- chromosomes[-grep("GL", chromosomes)] chromosomes <- chromosomes[-grep("MT", chromosomes)] } @@ -445,27 +940,6 @@ setMethod(f="annoGenomeCoordSv", message(memo) } - ## Perform quality check on BSgenome object - if (is.null(BSgenome)) { - memo <- paste("BSgenome object is not specified, whole chromosomes", - "will not be plotted, this is not recommended!") - warning(memo) - object$chromosome <- factor(object$chromosome, levels=gtools::mixedsort(unique(as.character(object$chromosome)))) - object$chromosome2 <- factor(object$chromosome2, levels=gtools::mixedsort(unique(as.character(object$chromosome2)))) - - return(object) - } else if (is(BSgenome, "BSgenome")) { - if(verbose){ - memo <- paste("BSgenome passed object validity checks") - } - } else { - memo <- paste("class of the BSgenome object is", class(BSgenome), - "should either be of class BSgenome or NULL", - "setting this to param to NULL") - warning(memo) - BSgenome <- NULL - } - ## Create a data table of genomic coordinates end positions genomeCoord <- data.table::as.data.table(seqlengths(BSgenome)) colnames(genomeCoord) <- c("end") @@ -528,18 +1002,6 @@ setMethod(f="sampleSubset", message(memo) } - ## If samples is null, we don't want to do anything and just return the object - if (is.null(samples)) { - return(object) - } - - ## Perform quality checkes on the sample parameter arguments - if (!is.character(samples)) { - memo <- paste("Input to samples should be a character vector, - attempting to coerce...") - warning(memo) - } - ## Check for specified samples not in the original input missingSamp <- samples[!samples %in% unique(object$sample)] if (length(missingSamp) != 0) { @@ -690,6 +1152,19 @@ setMethod(f="countGenes", ## Get the total number of samples sample_num <- length(unique(object$sample)) + ## Check if the svOrders are in the sv dataset + if (!all(svOrder %in% object@vcfObject@svType$svtype)) { + svOrder <- svOrder[which(svOrder %in% object@vcfObject@svType$svtype)] + if (length(svOrder) == 0) { + memo <- paste0("Structural variant types in the svOrder variable are not ", + "found in the SV dataset. Assigning the following order based on the ", + "mutations found in the SV dataset: ", + paste(object@vcfObject@svType$svtype, collapse=" > ")) + message(memo) + svOrder <- object@vcfObject@svType$svtype + } + } + ## Go through the list of genes and see how many times/samples it is mutated final_df <- data.table::rbindlist(apply(genes, 1, function(x, object, svOrder, sample_num) { ## Get the rows with the genes @@ -759,7 +1234,7 @@ setMethod(f="countGenes", setMethod(f="svCytobands", signature="data.table", definition=function(object, genome, chrData, verbose) { - #browser() + ## Print status message if (verbose) { message("Subsetting cytoband dataset.") @@ -812,7 +1287,7 @@ setMethod(f="svCytobands", setMethod(f="adjustCentromeres", signature="data.table", definition=function(object, chrCytobands, verbose) { - #browser() + ## Print status message if (verbose){ message("Adjusting positions of structural variants to account for centromere to aid in visualization.") @@ -860,7 +1335,7 @@ setMethod(f="adjustCentromeres", #' @noRd setMethod(f="getStructuralVariantWindow", signature="data.table", - definition=function(object, chrData, chrCytobands, chrGap, verbose){ + definition=function(object, chromosomes, chrData, chrCytobands, chrGap, verbose){ ## Print status message if (verbose) { @@ -876,7 +1351,7 @@ setMethod(f="getStructuralVariantWindow", coi <- data.table(chromosomes) } if (is.null(chromosomes)) { - coi <- unique(chrData$chromosome) + coi <- data.table(chromosomes=unique(chrData$chromosome)) } ## For each of the COI-chr combination, generate a dataset to plot @@ -1030,28 +1505,6 @@ setMethod(f="buildSvPlot", svWindow$direction <- gsub("\\[P\\[N", "5' to 5'", svWindow$direction) svWindow$svtype <- gsub("BND", "TRA", svWindow$svtype) - - ## Check the input variables - checkPlotLayer <- function(plotLayer, name) { - if(!is.null(plotLayer)){ - if(!is.list(plotLayer)){ - memo <- paste(name, " is not a list", sep="") - stop(memo) - } - - if(any(!unlist(lapply(plotLayer, function(x) ggplot2::is.ggproto(x) | ggplot2::is.theme(x) | is(x, "labels"))))){ - memo <- paste(name, " is not a list of ggproto or ", - "theme objects... setting plotALayers to NULL", sep="") - warning(memo) - plotLayer <- NULL - } - } - return(plotLayer) - } - plotALayers <- checkPlotLayer(plotLayer=plotALayers, "plotALayers") - plotBLayers <- checkPlotLayer(plotLayer=plotBLayers, "plotBLayers") - plotCLayers <- checkPlotLayer(plotLayer=plotCLayers, "plotCLayers") - ## Assign colors for samples names(sampleColor) <- sample @@ -1065,12 +1518,18 @@ setMethod(f="buildSvPlot", plotTraGenes, plotOtherGenes, plotALayers, plotBLayers, plotCLayers) { + ## Split the dataset by sample to assign color names df <- split(dataset, f=dataset$sample) dataset <- data.table::rbindlist(lapply(df, function(x, sampleColor){ if (nrow(x) > 0) { sampleName <- as.character(x$sample[1]) - x$sampleColor <- sampleColor[which(names(sampleColor) == sampleName)] + if (!is.null(sampleColor)) { + x$sampleColor <- sampleColor[which(names(sampleColor) == sampleName)] + } + if (is.null(sampleColor)) { + x$sampleColor <- sampleName + } } return(x) }, sampleColor=sampleColor)) @@ -1100,8 +1559,13 @@ setMethod(f="buildSvPlot", ## Get the start and stop for each chromosome chr1End <- chr1Length - chr2End <- chr2Length - boundaries <- data.table(start=c(0, chr2Start), end=c(chr1End, chr2End)) + if (length(chrOrder) == 1) { + boundaries <- data.table(start=c(0), end=c(chr1End)) + } + if (length(chrOrder) > 1) { + chr2End <- chr2Length + boundaries <- data.table(start=c(0, chr2Start), end=c(chr1End, chr2End)) + } ############################################################## ##### Plot the chromosome plot ############################### @@ -1150,20 +1614,19 @@ setMethod(f="buildSvPlot", ## Subset svWindow dataset to get DEL/DUP/INV/etc... and TRA/BND/etc... sameChrSvWindow <- dataset[SV_Type=="DEL" | SV_Type=="DUP" | SV_Type =="INV" | SV_Type == "INS"] - sameChrSvWindow$SV_size <- sameChrSvWindow$Position2 - sameChrSvWindow$Position diffChrSvWindow <- dataset[SV_Type=="BND" | SV_Type=="TRA"] ## Get the dataset for the gene text annotations dataset <- dataset[Direction!="cytoband"] gene_text <- dataset[,c("Midpoint", "Total_Read_Support", "gene", "SV_Type")] ## If there is sv events for translocations, get the gene text - if (availableSvTypes %in% c("TRA", "BND")) { + if (any(availableSvTypes %in% c("TRA", "BND"))) { gene_text$Total_Read_Support[which(gene_text$SV_Type=="TRA")] <- as.numeric(as.character(gene_text$Total_Read_Support[which(gene_text$SV_Type=="TRA")])) + max(as.numeric(as.character(gene_text$Total_Read_Support[which(gene_text$SV_Type=="TRA")])))*.05 } ## If there is sv events for non-translocations, get the gene text - if (availableSvTypes %in% c("DEL", "DUP", "INV", "INS")) { + if (any(availableSvTypes %in% c("DEL", "DUP", "INV", "INS"))) { gene_text$Total_Read_Support[which(gene_text$SV_Type!="TRA")] <- as.numeric(as.character(gene_text$Total_Read_Support[which(gene_text$SV_Type!="TRA")])) + max(as.numeric(as.character(gene_text$Total_Read_Support[which(gene_text$SV_Type!="TRA")])))*.05 @@ -1188,22 +1651,30 @@ setMethod(f="buildSvPlot", } } - ########################################################## ##### Plot the translocation data ######################## ########################################################## ## Get the start/end of chromosomes in the dataset if there is translocation data ## TODO: Allow this to occur for intra-chromosomal translocations - if (availableSvTypes %in% c("TRA", "BND")){ + if (any(availableSvTypes %in% c("TRA", "BND"))){ beziers <- data.frame(data.table::rbindlist(apply(diffChrSvWindow, 1, function(x) { leftEnd <- data.table(position=as.numeric(x[2]), total_read_support=0, point="end", - type="cubic", group=as.character(x[2]), Sample=x[8], SV_Type=x[6], + type="cubic", + group=paste(as.character(x[2]), as.character(x[4]), as.character(x[5]), + as.character(x[7]), as.character(x[8]), sep="_"), + Sample=x[8], SV_Type=x[6], Direction=x[5], sampleColor=x[13]) top <- data.table(position=as.numeric(x[10]), total_read_support=as.numeric(x[7])*2, point="control", - type="cubic", group=as.character(x[2]), Sample=x[8], SV_Type=x[6], + type="cubic", + group=paste(as.character(x[2]), as.character(x[4]), as.character(x[5]), + as.character(x[7]), as.character(x[8]), sep="_"), + Sample=x[8], SV_Type=x[6], Direction=x[5], sampleColor=x[13]) rightEnd <- data.table(position=as.numeric(x[4]), total_read_support=0, point="end", - type="cubic", group=as.character(x[2]), Sample=x[8], SV_Type=x[6], + type="cubic", + group=paste(as.character(x[2]), as.character(x[4]), as.character(x[5]), + as.character(x[7]), as.character(x[8]), sep="_"), + Sample=x[8], SV_Type=x[6], Direction=x[5], sampleColor=x[13]) final <- rbind(leftEnd, top, rightEnd) return(final) @@ -1230,13 +1701,15 @@ setMethod(f="buildSvPlot", mapping=aes_string(x='Midpoint', y='Total_Read_Support', label='gene')) } ## Assign colors to sample - traPlot <- traPlot + scale_color_manual(name="Sample", values=sampleColor) + if (!is.null(sampleColor)) { + traPlot <- traPlot + scale_color_manual(name="Sample", values=sampleColor) + } } ############################################################## ##### Plot the non TRA sv events ############################# ############################################################## - if (availableSvTypes %in% c("DEL", "DUP", "INV", "INS")) { + if (any(availableSvTypes %in% c("DEL", "DUP", "INV", "INS"))) { maxY <- max(as.numeric(as.character(sameChrSvWindow$Total_Read_Support))) + 30 sameChrSvWindow$Total_Read_Support <- as.numeric(sameChrSvWindow$Total_Read_Support) nonTraPlot <- ggplot() + geom_point(data=sameChrSvWindow, @@ -1254,7 +1727,9 @@ setMethod(f="buildSvPlot", mapping=aes_string(x='Midpoint', y='Total_Read_Support', label='gene')) } ## Assign colors to sample - nonTraPlot <- nonTraPlot + scale_color_manual(name="Sample", values=sampleColor) + if (!is.null(sampleColor)) { + nonTraPlot <- nonTraPlot + scale_color_manual(name="Sample", values=sampleColor) + } } ############################################################## diff --git a/R/VCF_Virtual-class.R b/R/VCF_Virtual-class.R index c6e9eaa..12e718f 100644 --- a/R/VCF_Virtual-class.R +++ b/R/VCF_Virtual-class.R @@ -23,14 +23,14 @@ setClass( ################################################################################ ###################### Accessor function definitions ########################### -#' @name getVcf -#' @rdname getVcf-methods -#' @aliases getVcf -setMethod(f="getVcf", +#' @name getHeader +#' @rdname getHeader-methods +#' @aliases getHeader +setMethod(f="getHeader", signature="VCF_Virtual", definition=function(object, ...){ - vcf <- object@vcf - return(vcf) + header <- object@description + return(header) }) #' @name getSample @@ -41,4 +41,22 @@ setMethod(f="getSample", definition=function(object, ...){ sample <- object@sample return(sample) + }) + +#' @rdname getMeta-methods +#' @aliases getMeta +setMethod(f="getMeta", + signature="VCF_Virtual", + definition=function(object, ...) { + meta <- object@vcfData + return(meta) + }) + +#' @rdname getMutation-methods +#' @aliases getMutation +setMethod(f="getMutation", + signature="VCF_Virtual", + definition=function(object, ...) { + mutation <- object@svType + return(mutation) }) \ No newline at end of file diff --git a/R/VariantCallFormat-class.R b/R/VariantCallFormat-class.R index de36f97..20c9b7c 100644 --- a/R/VariantCallFormat-class.R +++ b/R/VariantCallFormat-class.R @@ -37,21 +37,12 @@ setClass("VariantCallFormat", #' Only used when paired=TRUE. #' @param verbose Bolean specifying if progress should be reported while reading #' in the VCF file -#' @details When specifying a path to a VCF file, the option exists to either -#' specify the full path to a vcf file or to us wildcards to specify multiple -#' files. When specifying a full path, the initializer will check if a column -#' named "sample" containing the relevant sample for each row exists. If such a -#' column is not found, the initializer will assume this file correspnds to -#' only one sample and populate a sample column accordingly. Alternatively, if -#' multiple files are specified at once using a wildcard, the initializer will -#' aggregate all the files and use the filenames minus any extension to -#' populate the "sample" column. #' @importFrom data.table fread #' @importFrom data.table rbindlist #' @importFrom data.table data.table #' @export VariantCallFormat <- function(path=NULL, data=NULL, version="auto", svCaller=NULL, paired=paired, - tumorColumn=tumorColumn, verbose=FALSE) { + tumorColumn=tumorColumn, verbose=FALSE) { ## Check if both path and data are both null if (is.null(path) & is.null(data)) { @@ -88,9 +79,9 @@ VariantCallFormat <- function(path=NULL, data=NULL, version="auto", svCaller=NUL ## Find where the headers stops and read the data skip <- length(header) vcfData <- suppressWarnings(data.table::fread(input=x, - stringsAsFactors=TRUE, - verbose=verbose, - skip=skip)) + stringsAsFactors=TRUE, + verbose=verbose, + skip=skip)) ## Set sample if it is not already in the data table if(any(colnames(vcfData) %in% "sample")){ @@ -220,6 +211,71 @@ VariantCallFormat <- function(path=NULL, data=NULL, version="auto", svCaller=NUL new("VariantCallFormat", path=path, vcfObject=vcfObject, version=as.character(version)) } +################################################################################ +###################### Accessor function definitions ########################### + +#' @rdname writeData-methods +#' @aliases writeData +setMethod(f="writeData", + signature="VariantCallFormat", + definition=function(object, file, ...){ + writeData(object@vcfObject@vcfData, file, sep="\t") + }) + +#' @rdname getVersion-methods +#' @aliases getVersion +setMethod(f="getVersion", + signature="VariantCallFormat", + definition=function(object, ...) { + version <- object@version + return(version) + }) + +#' @rdname getPath-methods +#' @aliases getPath +setMethod(f="getPath", + signature="VariantCallFormat", + definition=function(object, ...){ + path <- object@path + return(path) + }) + +#' @rdname getHeader-methods +#' @aliases getHeader +setMethod(f="getHeader", + signature="VariantCallFormat", + definition=function(object, ...) { + header <- getHeader(object@vcfObject) + return(header) + }) + +#' @rdname getSample-methods +#' @aliases getSample +setMethod(f="getSample", + signature="VariantCallFormat", + definition=function(object, ...) { + sample <- getSample(object@vcfObject) + return(sample) + }) + +#' @rdname getMeta-methods +#' @aliases getMeta +setMethod(f="getMeta", + signature="VariantCallFormat", + definition=function(object, ...) { + meta <- getMeta(object@vcfObject) + return(meta) + }) + +#' @rdname getMutation-methods +#' @aliases getMutation +setMethod(f="getMutation", + signature="VariantCallFormat", + definition=function(object, ...) { + mutations <- getMutation(object@vcfObject) + return(mutations) + }) + ################################################################################ ####################### Method function definitions ############################ @@ -230,9 +286,9 @@ VariantCallFormat <- function(path=NULL, data=NULL, version="auto", svCaller=NUL #' @importFrom data.table data.table setMethod(f="getVcfData", signature="VariantCallFormat", - definition=function(object, filter, maxSvSize, svType, + definition=function(object, filterSvCalls, maxSvSize, svType, verbose, ...) { - + ## Print status message if (verbose) { memo <- paste0("converting ", class(object), " to expected ", @@ -240,13 +296,31 @@ setMethod(f="getVcfData", message(memo) } + availableSvTypes <- object@vcfObject@svType$svtype object <- object@vcfObject@vcfData ## Filter out sv calls that are not "PASS" - if (filter == TRUE) { + if (filterSvCalls == TRUE) { object <- object[FILTER=="PASS"] } + ## Check if the sv types are found in the actual sv dataset + if (!is.null(svType)) { + svType <- svType[which(svType %in% availableSvTypes)] + if (length(svType) == 0) { + memo <- paste0("The desired sv types as designated in the svType ", + "variable are not found in the sv dataset. Setting ", + "svType to NULL, which will include all sv's in the dataset.") + message(memo) + svType <- NULL + } + } + if (!is.numeric(maxSvSize) & !is.null(maxSvSize)) { + memo <- paste0("maxSvSize variable not of the numeric class. Attempting to coerce.") + maxSvSize <- as.numeric(maxSvSize) + message(memo) + } + ## Remove large SV if (is.null(maxSvSize) == FALSE) { ## Get the difference in positions @@ -265,7 +339,7 @@ setMethod(f="getVcfData", ## Remove sv types that are not necessary available_svTypes <- unlist(as.vector(object$svtype)) - if (length(svType) > 0) { + if (length(svType) > 0 & !is.null(svType)) { ## Check to see if the SV type is in the data.table ## Perform the subset if svtype is available if (all(svType %in% available_svTypes)) { @@ -278,7 +352,8 @@ setMethod(f="getVcfData", stop(memo) } } + ## Stop the return(object) - }) + }) From 23c395ad7d9e6d7a73407a2fd6a6444249b7a35e Mon Sep 17 00:00:00 2001 From: Jason Kunisaki Date: Tue, 1 May 2018 11:05:03 -0500 Subject: [PATCH 16/21] sv update --- R/StructuralVariant-class.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/StructuralVariant-class.R b/R/StructuralVariant-class.R index 9298e94..71813a7 100644 --- a/R/StructuralVariant-class.R +++ b/R/StructuralVariant-class.R @@ -18,7 +18,7 @@ setClass("StructuralVariant", representation=representation(svData="data.table", geneData="data.table", - svPlots="svPlots"), + svPlots="list"), validity=function(object) { }) From 40b4a05a1e9fc8c092b21124f417d8ee7f542bd1 Mon Sep 17 00:00:00 2001 From: Jason Kunisaki Date: Tue, 1 May 2018 13:47:59 -0500 Subject: [PATCH 17/21] sv update --- R/StructuralVariant-class.R | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/R/StructuralVariant-class.R b/R/StructuralVariant-class.R index 71813a7..e34f04a 100644 --- a/R/StructuralVariant-class.R +++ b/R/StructuralVariant-class.R @@ -159,7 +159,6 @@ checkSvInputParameters <- function(object, BSgenome, filterSvCalls, svType, svOr genome, plotSV, plotSpecificGene, plotTraGenes, plotOtherGenes, cytobandColor, plotALayers, plotBLayers, plotCLayers, sectionHeights, sampleColor, verbose, ...) { - browser() ##### Check verbose parameter ##### ## Check to see if verbose is a booelean if (!is.logical(verbose) | is.null(verbose)) { @@ -1518,7 +1517,6 @@ setMethod(f="buildSvPlot", plotTraGenes, plotOtherGenes, plotALayers, plotBLayers, plotCLayers) { - ## Split the dataset by sample to assign color names df <- split(dataset, f=dataset$sample) dataset <- data.table::rbindlist(lapply(df, function(x, sampleColor){ @@ -1532,7 +1530,7 @@ setMethod(f="buildSvPlot", } } return(x) - }, sampleColor=sampleColor)) + }, sampleColor=sampleColor), fill=TRUE) colnames(dataset) <- c("Chromosome", "Position", "Chromosome2", "Position2", "Direction", "SV_Type", "Total_Read_Support", "Sample", "Genes", From f0fad6b9f9dc8870d1bec8891547b4ebba5037ee Mon Sep 17 00:00:00 2001 From: Jason Kunisaki Date: Tue, 1 May 2018 13:48:27 -0500 Subject: [PATCH 18/21] sv update --- R/StructuralVariant-class.R | 35 ++++++++++++++++++----------------- 1 file changed, 18 insertions(+), 17 deletions(-) diff --git a/R/StructuralVariant-class.R b/R/StructuralVariant-class.R index e34f04a..e85f2e7 100644 --- a/R/StructuralVariant-class.R +++ b/R/StructuralVariant-class.R @@ -1,6 +1,21 @@ ################################################################################ ##################### Public/Private Class Definitions ######################### +#' Private Class svPlots - custom class that needs a definition +#' +#' An S4 class for the of the svData class +#' @name svPlots-class +#' @rdname svPlots-class +#' @slot Plots list of gtables for each chr combo +#' @import methods +#' @importFrom gtable gtable +#' @noRd +setClass("svPlots", + representation=representation(plots="list"), + validity = function(object) { + + }) + #!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Public Class !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!# #' Class StructuralVariant @@ -18,7 +33,7 @@ setClass("StructuralVariant", representation=representation(svData="data.table", geneData="data.table", - svPlots="list"), + svPlots="svPlots"), validity=function(object) { }) @@ -240,6 +255,7 @@ checkSvInputParameters <- function(object, BSgenome, filterSvCalls, svType, svOr ## Check is sample is NULL if (is.null(sample)) { sample <- unique(object@vcfObject@sample$sample) + sample <- factor(sample, levels=gtools::mixedsort(sample)) memo <- paste0("Sample parameter cannot be NULL. All samples will be plotted.") } ## Check if sample is a character vector @@ -665,21 +681,6 @@ svData <- function(object, BSgenome, filterSvCalls, svType, svOrder, maxSvSize, new("svData", primaryData=primaryData, geneData=geneData, chrData=chrData, svWindow=svWindow, cytobands=chrCytobands) } -#' Private Class svPlots -#' -#' An S4 class for the of the svData class -#' @name svPlots-class -#' @rdname svPlots-class -#' @slot Plots list of gtables for each chr combo -#' @import methods -#' @importFrom gtable gtable -#' @noRd -setClass("svPlots", - representation=representation(plots="list"), - validity = function(object) { - - }) - #' Constructor for the svPlots class #' #' @name svPlots @@ -1478,7 +1479,7 @@ setMethod(f="buildSvPlot", definition=function(object, plotSV, plotSpecificGene, plotTraGenes, plotOtherGenes, cytobandColor, sample, sampleColor, plotALayers, plotBLayers, plotCLayers, sectionHeights, verbose) { - + if (plotSV == FALSE) { ## Print status message if (verbose) { From 2d7a82ee34ee41e7c91fe98dca8d3669ec4c475f Mon Sep 17 00:00:00 2001 From: Jason Kunisaki Date: Tue, 1 May 2018 13:52:22 -0500 Subject: [PATCH 19/21] sv update --- R/StructuralVariant-class.R | 30 +++++++++++++++--------------- 1 file changed, 15 insertions(+), 15 deletions(-) diff --git a/R/StructuralVariant-class.R b/R/StructuralVariant-class.R index e85f2e7..8b4bc20 100644 --- a/R/StructuralVariant-class.R +++ b/R/StructuralVariant-class.R @@ -89,21 +89,21 @@ StructuralVariant <- function(input, BSgenome=NULL, filterSvCalls=TRUE, svType=N sectionHeights=c(0.4, 0.1, 0.5), verbose=FALSE) { ## Check the input parameters - inputParameters <- checkSvInputParameters(object=input, BSgenome=BSgenome, - filterSvCalls=filterSvCalls, - svType=svType, svOrder=svOrder, - maxSvSize=maxSvSize, - sample=sample, - chromosomes=chromosomes, - ensembl=ensembl, attributes=attributes, - filters=filters, chrGap=chrGap, annotate=annotate, - geneAnnotationFlank=geneAnnotationFlank, genome=genome, - plotSV=plotSV, plotSpecificGene=plotSpecificGene, - plotTraGenes=plotTraGenes, plotOtherGenes=plotOtherGenes, - cytobandColor=cytobandColor, - plotALayers=plotALayers, plotBLayers=plotBLayers, - plotCLayers=plotCLayers, sectionHeights=sectionHeights, - sampleColor=sampleColor, verbose=verbose) + inputParameters <- checkSvInputParameters(object=input, BSgenome.=BSgenome, + filterSvCalls.=filterSvCalls, + svType.=svType, svOrder.=svOrder, + maxSvSize.=maxSvSize, + sample.=sample, + chromosomes.=chromosomes, + ensembl.=ensembl, attributes.=attributes, + filters.=filters, chrGap.=chrGap, annotate.=annotate, + geneAnnotationFlank.=geneAnnotationFlank, genome.=genome, + plotSV.=plotSV, plotSpecificGene.=plotSpecificGene, + plotTraGenes.=plotTraGenes, plotOtherGenes.=plotOtherGenes, + cytobandColor.=cytobandColor, + plotALayers.=plotALayers, plotBLayers.=plotBLayers, + plotCLayers.=plotCLayers, sectionHeights.=sectionHeights, + sampleColor.=sampleColor, verbose.=verbose) ## Calculate all data for the plots svDataset <- svData(object=input, BSgenome=inputParameters@BSgenome, From a7d06f5b62a0f2196fa54d928851cb8e4985747c Mon Sep 17 00:00:00 2001 From: Jason Kunisaki Date: Wed, 2 May 2018 16:35:29 -0500 Subject: [PATCH 20/21] Update SV function, allow for Lumpy input. Write input parameter checks for each of the new functions (lohSpec and combinedCnLOH). --- NAMESPACE | 2 +- R/AllGenerics.R | 22 ++ R/StructuralVariant-class.R | 65 +++-- R/VCF_Lumpy_v4.1-class.R | 216 ++++++++++++++ R/VCF_Lumpy_v4.2-class.R | 216 ++++++++++++++ R/VarScanFormat-class.R | 4 +- R/VariantCallFormat-class.R | 14 +- R/combinedCnLoh-class.R | 553 +++++++++++++++++++++++++----------- R/lohSpec-class.R | 480 +++++++++++++++++++++++++------ 9 files changed, 1301 insertions(+), 271 deletions(-) create mode 100644 R/VCF_Lumpy_v4.1-class.R create mode 100644 R/VCF_Lumpy_v4.2-class.R diff --git a/NAMESPACE b/NAMESPACE index b57bee4..3c5f1ec 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -10,6 +10,7 @@ export(StructuralVariant) export(TvTi) export(VEP) export(VarScanFormat) +export(VariantCallFormat) export(Waterfall) export(cnFreq) export(cnLoh) @@ -32,7 +33,6 @@ exportClasses(Rainfall) exportClasses(StructuralVariant) exportClasses(VEP) exportClasses(VarScanFormat) -exportClasses(VariantCallFormat) exportClasses(Waterfall) exportClasses(cnLoh) exportClasses(lohSpec) diff --git a/R/AllGenerics.R b/R/AllGenerics.R index 82b88dd..3dd89bd 100644 --- a/R/AllGenerics.R +++ b/R/AllGenerics.R @@ -953,4 +953,26 @@ setGeneric( setGeneric( name="checkSvInputParameters", def=function(object, ...){standardGeneric("checkSvInputParameters")} +) + +#' Method checkLohInputParameters +#' +#' @name checkLohInputParameters +#' @rdname checkLohInputParameters-methods +#' @param ... additional arguments to passed +#' @noRd +setGeneric( + name="checkLohInputParameters", + def=function(object, ...){standardGeneric("checkLohInputParameters")} +) + +#' Method checkCnLohInputParameters +#' +#' @name checkCnLohInputParameters +#' @rdname checkCnLohInputParameters-methods +#' @param ... additional arguments to passed +#' @noRd +setGeneric( + name="checkCnLohInputParameters", + def=function(object, ...){standardGeneric("checkCnLohInputParameters")} ) \ No newline at end of file diff --git a/R/StructuralVariant-class.R b/R/StructuralVariant-class.R index 8b4bc20..fa653ca 100644 --- a/R/StructuralVariant-class.R +++ b/R/StructuralVariant-class.R @@ -89,21 +89,21 @@ StructuralVariant <- function(input, BSgenome=NULL, filterSvCalls=TRUE, svType=N sectionHeights=c(0.4, 0.1, 0.5), verbose=FALSE) { ## Check the input parameters - inputParameters <- checkSvInputParameters(object=input, BSgenome.=BSgenome, - filterSvCalls.=filterSvCalls, - svType.=svType, svOrder.=svOrder, - maxSvSize.=maxSvSize, - sample.=sample, - chromosomes.=chromosomes, - ensembl.=ensembl, attributes.=attributes, - filters.=filters, chrGap.=chrGap, annotate.=annotate, - geneAnnotationFlank.=geneAnnotationFlank, genome.=genome, - plotSV.=plotSV, plotSpecificGene.=plotSpecificGene, - plotTraGenes.=plotTraGenes, plotOtherGenes.=plotOtherGenes, - cytobandColor.=cytobandColor, - plotALayers.=plotALayers, plotBLayers.=plotBLayers, - plotCLayers.=plotCLayers, sectionHeights.=sectionHeights, - sampleColor.=sampleColor, verbose.=verbose) + inputParameters <- checkSvInputParameters(object=input, BSgenome=BSgenome, + filterSvCalls=filterSvCalls, + svType=svType, svOrder=svOrder, + maxSvSize=maxSvSize, + sample=sample, + chromosomes=chromosomes, + ensembl=ensembl, attributes=attributes, + filters=filters, chrGap=chrGap, annotate=annotate, + geneAnnotationFlank=geneAnnotationFlank, genome=genome, + plotSV=plotSV, plotSpecificGene=plotSpecificGene, + plotTraGenes=plotTraGenes, plotOtherGenes=plotOtherGenes, + cytobandColor=cytobandColor, + plotALayers=plotALayers, plotBLayers=plotBLayers, + plotCLayers=plotCLayers, sectionHeights=sectionHeights, + sampleColor=sampleColor, verbose=verbose) ## Calculate all data for the plots svDataset <- svData(object=input, BSgenome=inputParameters@BSgenome, @@ -185,17 +185,17 @@ checkSvInputParameters <- function(object, BSgenome, filterSvCalls, svType, svOr ##### Check BSgenome parameter ##### ## Check to see if BSgenome is a BSgenome if (is.null(BSgenome)) { - memo <- paste("BSgenome object is not specified, whole chromosomes", - "will not be plotted, this is not recommended!") - warning(memo) + memo <- paste("BSgenome object is not specified. This parameter is required ", + "to get the lengths of the chromsomes being plotted.") + stop(memo) } else if (is(BSgenome, "BSgenome")) { memo <- paste("BSgenome passed object validity checks") message(memo) } else { memo <- paste("class of the BSgenome object is", class(BSgenome), - "should either be of class BSgenome or NULL", - "setting this to param to NULL") - warning(memo) + ". Should be of class BSgenome. This parameter is required ", + "to get the lengths of the chromsomes being plotted.") + stop(memo) BSgenome <- NULL } @@ -257,6 +257,7 @@ checkSvInputParameters <- function(object, BSgenome, filterSvCalls, svType, svOr sample <- unique(object@vcfObject@sample$sample) sample <- factor(sample, levels=gtools::mixedsort(sample)) memo <- paste0("Sample parameter cannot be NULL. All samples will be plotted.") + message(memo) } ## Check if sample is a character vector if (!is.character(sample)) { @@ -265,6 +266,19 @@ checkSvInputParameters <- function(object, BSgenome, filterSvCalls, svType, svOr message(memo) } + ## Check if the designated samples is in the sv dataset + if (!is.null(sample)) { + `%nin%` = Negate(`%in%`) + discrepantSamples <- paste(sample[which(sample %nin% object@vcfObject@sample$sample)], collapse=", ") + if (length(discrepantSamples) > 0 & discrepantSamples != "") { + memo <- paste0("The desired samples: ", discrepantSamples, " are not found ", + "in the SV dataset. Available sample names include: ", + paste(object@vcfObject@sample$sample, collapse=", "), ". ", + "Please designate valid sample names.") + stop(memo) + } + } + ##### Check chromosomes parameter ##### ## Check is chromosomes is NULL if (is.null(chromosomes)) { @@ -510,6 +524,7 @@ checkSvInputParameters <- function(object, BSgenome, filterSvCalls, svType, svOr nonColor <- cytobandColor[which(data.table(areColors(cytobandColor))$V1==FALSE)] memo <- paste0("The ", nonColor, " designated in the cytobandColor parameter is not a valid color. ", "Making the cytoband colors dark grey and light grey.") + stop(memo) } ##### Check sampleColor parameter ##### @@ -539,7 +554,8 @@ checkSvInputParameters <- function(object, BSgenome, filterSvCalls, svType, svOr ## Get the invalid color nonColor <- sampleColor[which(data.table(areColors(sampleColor))$V1==FALSE)] memo <- paste0("The ", nonColor, " designated in the sampleColor parameter is not a valid color. ", - "Making the cytoband colors dark grey and light grey.") + "Please input a valid color before continuing.") + stop(memo) } ## If sampleColor is not NULL, check if it's length is the same as @@ -1506,7 +1522,7 @@ setMethod(f="buildSvPlot", svWindow$svtype <- gsub("BND", "TRA", svWindow$svtype) ## Assign colors for samples - names(sampleColor) <- sample + names(sampleColor) <- gtools::mixedsort(sample) ## Split the sv window by chr_combo window <- split(svWindow, svWindow$chr_combo) @@ -1612,6 +1628,8 @@ setMethod(f="buildSvPlot", availableSvTypes <- unique(dataset$SV_Type[-which(dataset$Direction=="cytoband")]) ## Subset svWindow dataset to get DEL/DUP/INV/etc... and TRA/BND/etc... + dataset$Sample <- factor(dataset$Sample, + levels=gtools::mixedsort(as.character(unique(dataset$Sample)))) sameChrSvWindow <- dataset[SV_Type=="DEL" | SV_Type=="DUP" | SV_Type =="INV" | SV_Type == "INS"] diffChrSvWindow <- dataset[SV_Type=="BND" | SV_Type=="TRA"] @@ -1686,6 +1704,7 @@ setMethod(f="buildSvPlot", traPlot <- ggplot() + geom_bezier(data=beziers, mapping=aes_string(x='position', y='total_read_support', group='group', color='Sample', linetype='Direction')) + + guides(color=guide_legend(ncol=2)) + guides(linetype=guide_legend(ncol=2)) + facet_grid(SV_Type ~ ., scales="fixed", space="fixed") + scale_x_continuous(expand=c(0,0), limits=c(-5000000, max(coi$Position2) + 5000000), breaks=temp$oldBreaks, labels=temp$newBreaks) + diff --git a/R/VCF_Lumpy_v4.1-class.R b/R/VCF_Lumpy_v4.1-class.R new file mode 100644 index 0000000..2695996 --- /dev/null +++ b/R/VCF_Lumpy_v4.1-class.R @@ -0,0 +1,216 @@ +################################################################################ +##################### Public/Private Class Definitions ######################### + +#!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Public Class !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!# + +#' Class VCF_Lumpy_v4.1 +#' +#' An S4 class to represent data in vcf version 4.1 format, inherits from the +#' VCF_Virtual class +#' @name VCF_Lumpy_v4.1 +#' @rdname VCF_Lumpy_v4.1-class +#' @slot header data.table object containing header information +#' @slot meta data.table object containing meta information lines +#' @slot vcfHeader data.table object containing header for vcf data +#' @slot vcfData data.table object containing vcf data lines +#' @slot sample data.table object containing sample information +#' @include VCF_Virtual-class.R +#' @import methods +setClass("VCF_Lumpy_v4.1", + contains="VCF_Virtual", + validity=function(object){ + cnames <- c("chromosome", "position", "chromosome2", "position2", "direction", + "REF", "ALT", "svtype", "total_read_support", "FILTER", "sample", + "ID", "INFO", "FORMAT", "tumorSample", "paired") + + ## Check the columns + sampleCol <- which(!colnames(object@vcfData) %in% cnames) + if (length(sampleCol) > 0) { + memo <- paste0("Columns in the input data.table are missing. Required ", + "columns are: chromosome, position, chromosome2, position2, direction,", + "REF, ALT, svtype, total_read_support, FILTER, sample ", + "ID, INFO, FORMAT, tumorSample, paired") + message(memo) + } + return(TRUE) + + }) + +#' Constuctor for the VCF_Lumpy_v4.1 sub-class +#' +#' @name VCF_Lumpy_v4.1 +#' @rdname VCF_Lumpy_v4.1-class +#' @param vcfData data.table object containing a VCF file conforming to the +#' version 4.1 specifications +#' @param vcfHeader Object of class list containing character vectors for vcf +#' header information +#' @param paired Boolean object specifying if the svCaller was ran in paired mode +#' @param tumorColumn String specifying the name of the sample column with read support information +#' @importFrom data.table data.table +VCF_Lumpy_v4.1 <- function(vcfData, vcfHeader, paired, tumorColumn) { + + ## Set the data descriptions for the object + if (length(vcfHeader)==0) { + finalDescription <- data.table::data.table() + } else { + description <- lapply(vcfHeader, function(x){ + descriptionFieldIndex <- which(grepl("Description", x)) + x <- x[descriptionFieldIndex] + + split1 <- unlist(strsplit(unlist(strsplit(x, ",")), "=")) + id <- split1[grep("", "", split1[grep("Description", split1)+1]) + description <- gsub("\"", "", description, fixed=TRUE) + + x <- paste("ID=", id, "|", "Description=", description, sep="") + return(x) + }) + description <- unique(unlist(description)) + + # convert these results to a data.table after splitting into two columns + d <- unlist(strsplit(description, split="|", fixed=TRUE)) + id <- d[grep("ID=", d)] + id <- unlist(strsplit(id, split="ID="))[ + grep("[A-Z]", unlist(strsplit(id, split="ID=")))] + description <- d[grep("Description=", d)] + description <- unlist(strsplit(description, split="Description="))[ + grep("[A-Z]", unlist(strsplit(description, split="Description=")))] + + finalDescription <- data.table(name=id, description=description) + } + + ## Get the samples + sample <- data.table(sample=unique(vcfData$sample)) + + ## Assign the column names + cnames <- c("chromosome", "position", "ID", "REF", "ALT", "QUAL", + "FILTER", "INFO", "FORMAT") + colnames(vcfData)[1:9] <- cnames + + ## Check if the sample is paired + if (paired == TRUE) { + ## Check if the sv data is paired based on the input files/dataset + cnames <- c("chromosome", "position", "ID", "REF", "ALT", "QUAL", + "FILTER", "INFO", "FORMAT", "sample") + cols <- length(colnames(vcfData[,-which(colnames(vcfData) %in% cnames), with=FALSE])) + if (cols !=2) { + memo <- paste("Are you sure the data is paired. There are", cols, + "columns with sample read support data", + "in the input sv data when there should be 2.") + stop(memo) + } + + ## Check if the tumorColumn variable actually specifies a sample column to use + num <- which(colnames(vcfData[,tumorColumn,with=FALSE]) %in% + colnames(vcfData[,-which(colnames(vcfData) %in% cnames), with=FALSE])) + if (length(num) != 1) { + memo <- paste("The column designated as the tumor sample does not", + "correspond to sample read support. The valid values to use", + "for the tumorColumn variable are:", + paste(which(!colnames(vcfData) %in% cnames), collapse=" or ")) + stop(memo) + } + + ## Check if the tumorColumn variable is NULL + if (is.null(tumorColumn)) { + memo <- paste0("Input was designated as paired but the tumor/diseased sample ", + "was not designated. If the samples are paired, please ", + "use the tumorColumn variable to identify which column in the vcf datasets has the ", + "read support for calls in the tumor sample.") + } + if (is.null(tumorColumn) == FALSE) { + cnames <- c("chromosome", "position", "ID", "REF", "ALT", "QUAL", + "FILTER", "INFO", "FORMAT", colnames(vcfData)[tumorColumn], "sample") + vcfData <- vcfData[,which(colnames(vcfData) %in% cnames), with=FALSE] + colnames(vcfData)[10] <- "tumorSample" + } + } + if (paired == FALSE) { + ## Check if the sv data is not paired based on the input files/dataset + cnames <- c("chromosome", "position", "ID", "REF", "ALT", "QUAL", + "FILTER", "INFO", "FORMAT", "sample") + cols <- length(colnames(vcfData[,-which(colnames(vcfData) %in% cnames), with=FALSE])) + if (cols !=1) { + memo <- paste("Are you sure the data is NOT paired. There are", cols, + "columns with sample read support data", + "in the input sv data when there should be 1.") + stop(memo) + } + + if (!is.null(tumorColumn)) { + memo <- paste("The sv caller output was designated as not paired. ", + "But a value was assigned to the tumorColumn variable.", + "This value will be ignored.") + } + tumorColumn <- which(!colnames(vcfData) %in% cnames) + colnames(vcfData)[tumorColumn] <- "tumorSample" + } + vcfData$paired <- paired + + ## Get the structural variant type from the INFO column + ## Get the chr and position of the second breakpoint + ## Get the read support + ## Get the direction of the translocation + temp <- suppressWarnings(data.table::rbindlist(apply(vcfData, 1, function(x, paired) { + ## SV type + svtype <- unlist(strsplit(as.character(x["INFO"]), split=";"))[ + grep("SVTYPE", unlist(strsplit(as.character(x["INFO"]), split=";")))] + svtype <- strsplit(svtype, "SVTYPE=")[[1]][2] + x$svtype <- svtype[1] + + ## 2nd breakpoint and get the BND direction + if (svtype == "BND" | svtype == "TRA") { + alt <- strsplit(as.character(x$ALT), "[[:punct:]]")[[1]] + chromosome2 <- alt[2] + position2 <- alt[3] + dir <- strsplit(as.character(x$ALT), split="")[[1]] + if (dir[length(dir)] == "]"){ + final <- "N]P]" + } + if (dir[length(dir)] == "[") { + final <- "N[P[" + } + if (dir[1] == "]") { + final <- "]P]N" + } + if (dir[1] == "[") { + final <- "[P[N" + } + dir <- final + } + else if (svtype == "INV" | svtype == "DEL" | svtype == "DUP" | svtype == "INS") { + chromosome2 <- x$chromosome + tmp <- unlist(strsplit(as.character(x$INFO), split=";")[[1]]) + tmp <- tmp[grep("END=", tmp, fixed=TRUE)][1] + position2 <- strsplit(tmp, split="END=")[[1]][2] + dir <- svtype + } + x$chromosome2 <- as.character(chromosome2) + x$position2 <- as.numeric(position2) + x$direction <- dir + + ## Get the total read support + a <- x$tumorSample + x$total_read_support <- as.numeric(strsplit(a, ":")[[1]][2]) + x <- as.data.table(t(cbind(x))) + + ## Get the ID + id <- strsplit(as.character(x$ID), split="_")[[1]][1] + x$ID <- id + return(x) + }, paired=paired))) + vcfData <- temp[,c("chromosome", "position", "chromosome2", "position2", "direction", + "REF", "ALT", "svtype", "total_read_support", "FILTER", "sample", + "ID", "INFO", "FORMAT", "tumorSample", "paired")] + + ## Remove duplicate IDs (i.e. reciprocal translocation events) + vcfData <- vcfData[!duplicated(vcfData$ID),] + + ## Get the svtype + svType <- data.table(unique(vcfData$svtype)) + colnames(svType) <- "svtype" + + ## Initialize the object + new("VCF_Lumpy_v4.1", description=finalDescription, sample=sample, + vcfData=vcfData, svType=svType) +} \ No newline at end of file diff --git a/R/VCF_Lumpy_v4.2-class.R b/R/VCF_Lumpy_v4.2-class.R new file mode 100644 index 0000000..f8a7be5 --- /dev/null +++ b/R/VCF_Lumpy_v4.2-class.R @@ -0,0 +1,216 @@ +################################################################################ +##################### Public/Private Class Definitions ######################### + +#!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Public Class !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!# + +#' Class VCF_Lumpy_v4.2 +#' +#' An S4 class to represent data in vcf version 4.2 format, inherits from the +#' VCF_Virtual class +#' @name VCF_Lumpy_v4.2 +#' @rdname VCF_Lumpy_v4.2-class +#' @slot header data.table object containing header information +#' @slot meta data.table object containing meta information lines +#' @slot vcfHeader data.table object containing header for vcf data +#' @slot vcfData data.table object containing vcf data lines +#' @slot sample data.table object containing sample information +#' @include VCF_Virtual-class.R +#' @import methods +setClass("VCF_Lumpy_v4.2", + contains="VCF_Virtual", + validity=function(object){ + cnames <- c("chromosome", "position", "chromosome2", "position2", "direction", + "REF", "ALT", "svtype", "total_read_support", "FILTER", "sample", + "ID", "INFO", "FORMAT", "tumorSample", "paired") + + ## Check the columns + sampleCol <- which(!colnames(object@vcfData) %in% cnames) + if (length(sampleCol) > 0) { + memo <- paste0("Columns in the input data.table are missing. Required ", + "columns are: chromosome, position, chromosome2, position2, direction,", + "REF, ALT, svtype, total_read_support, FILTER, sample ", + "ID, INFO, FORMAT, tumorSample, paired") + message(memo) + } + return(TRUE) + + }) + +#' Constuctor for the VCF_Lumpy_v4.2 sub-class +#' +#' @name VCF_Lumpy_v4.2 +#' @rdname VCF_Lumpy_v4.2-class +#' @param vcfData data.table object containing a VCF file conforming to the +#' version 4.2 specifications +#' @param vcfHeader Object of class list containing character vectors for vcf +#' header information +#' @param paired Boolean object specifying if the svCaller was ran in paired mode +#' @param tumorColumn String specifying the name of the sample column with read support information +#' @importFrom data.table data.table +VCF_Lumpy_v4.2 <- function(vcfData, vcfHeader, paired, tumorColumn) { + + ## Set the data descriptions for the object + if (length(vcfHeader)==0) { + finalDescription <- data.table::data.table() + } else { + description <- lapply(vcfHeader, function(x){ + descriptionFieldIndex <- which(grepl("Description", x)) + x <- x[descriptionFieldIndex] + + split1 <- unlist(strsplit(unlist(strsplit(x, ",")), "=")) + id <- split1[grep("", "", split1[grep("Description", split1)+1]) + description <- gsub("\"", "", description, fixed=TRUE) + + x <- paste("ID=", id, "|", "Description=", description, sep="") + return(x) + }) + description <- unique(unlist(description)) + + # convert these results to a data.table after splitting into two columns + d <- unlist(strsplit(description, split="|", fixed=TRUE)) + id <- d[grep("ID=", d)] + id <- unlist(strsplit(id, split="ID="))[ + grep("[A-Z]", unlist(strsplit(id, split="ID=")))] + description <- d[grep("Description=", d)] + description <- unlist(strsplit(description, split="Description="))[ + grep("[A-Z]", unlist(strsplit(description, split="Description=")))] + + finalDescription <- data.table(name=id, description=description) + } + + ## Get the samples + sample <- data.table(sample=unique(vcfData$sample)) + + ## Assign the column names + cnames <- c("chromosome", "position", "ID", "REF", "ALT", "QUAL", + "FILTER", "INFO", "FORMAT") + colnames(vcfData)[1:9] <- cnames + + ## Check if the sample is paired + if (paired == TRUE) { + ## Check if the sv data is paired based on the input files/dataset + cnames <- c("chromosome", "position", "ID", "REF", "ALT", "QUAL", + "FILTER", "INFO", "FORMAT", "sample") + cols <- length(colnames(vcfData[,-which(colnames(vcfData) %in% cnames), with=FALSE])) + if (cols !=2) { + memo <- paste("Are you sure the data is paired. There are", cols, + "columns with sample read support data", + "in the input sv data when there should be 2.") + stop(memo) + } + + ## Check if the tumorColumn variable actually specifies a sample column to use + num <- which(colnames(vcfData[,tumorColumn,with=FALSE]) %in% + colnames(vcfData[,-which(colnames(vcfData) %in% cnames), with=FALSE])) + if (length(num) != 1) { + memo <- paste("The column designated as the tumor sample does not", + "correspond to sample read support. The valid values to use", + "for the tumorColumn variable are:", + paste(which(!colnames(vcfData) %in% cnames), collapse=" or ")) + stop(memo) + } + + ## Check if the tumorColumn variable is NULL + if (is.null(tumorColumn)) { + memo <- paste0("Input was designated as paired but the tumor/diseased sample ", + "was not designated. If the samples are paired, please ", + "use the tumorColumn variable to identify which column in the vcf datasets has the ", + "read support for calls in the tumor sample.") + } + if (is.null(tumorColumn) == FALSE) { + cnames <- c("chromosome", "position", "ID", "REF", "ALT", "QUAL", + "FILTER", "INFO", "FORMAT", colnames(vcfData)[tumorColumn], "sample") + vcfData <- vcfData[,which(colnames(vcfData) %in% cnames), with=FALSE] + colnames(vcfData)[10] <- "tumorSample" + } + } + if (paired == FALSE) { + ## Check if the sv data is not paired based on the input files/dataset + cnames <- c("chromosome", "position", "ID", "REF", "ALT", "QUAL", + "FILTER", "INFO", "FORMAT", "sample") + cols <- length(colnames(vcfData[,-which(colnames(vcfData) %in% cnames), with=FALSE])) + if (cols !=1) { + memo <- paste("Are you sure the data is NOT paired. There are", cols, + "columns with sample read support data", + "in the input sv data when there should be 1.") + stop(memo) + } + + if (!is.null(tumorColumn)) { + memo <- paste("The sv caller output was designated as not paired. ", + "But a value was assigned to the tumorColumn variable.", + "This value will be ignored.") + } + tumorColumn <- which(!colnames(vcfData) %in% cnames) + colnames(vcfData)[tumorColumn] <- "tumorSample" + } + vcfData$paired <- paired + + ## Get the structural variant type from the INFO column + ## Get the chr and position of the second breakpoint + ## Get the read support + ## Get the direction of the translocation + temp <- suppressWarnings(data.table::rbindlist(apply(vcfData, 1, function(x, paired) { + ## SV type + svtype <- unlist(strsplit(as.character(x["INFO"]), split=";"))[ + grep("SVTYPE", unlist(strsplit(as.character(x["INFO"]), split=";")))] + svtype <- strsplit(svtype, "SVTYPE=")[[1]][2] + x$svtype <- svtype[1] + + ## 2nd breakpoint and get the BND direction + if (svtype == "BND" | svtype == "TRA") { + alt <- strsplit(as.character(x$ALT), "[[:punct:]]")[[1]] + chromosome2 <- alt[2] + position2 <- alt[3] + dir <- strsplit(as.character(x$ALT), split="")[[1]] + if (dir[length(dir)] == "]"){ + final <- "N]P]" + } + if (dir[length(dir)] == "[") { + final <- "N[P[" + } + if (dir[1] == "]") { + final <- "]P]N" + } + if (dir[1] == "[") { + final <- "[P[N" + } + dir <- final + } + else if (svtype == "INV" | svtype == "DEL" | svtype == "DUP" | svtype == "INS") { + chromosome2 <- x$chromosome + tmp <- unlist(strsplit(as.character(x$INFO), split=";")[[1]]) + tmp <- tmp[grep("END=", tmp, fixed=TRUE)][1] + position2 <- strsplit(tmp, split="END=")[[1]][2] + dir <- svtype + } + x$chromosome2 <- as.character(chromosome2) + x$position2 <- as.numeric(position2) + x$direction <- dir + + ## Get the total read support + a <- x$tumorSample + x$total_read_support <- as.numeric(strsplit(a, ":")[[1]][2]) + x <- as.data.table(t(cbind(x))) + + ## Get the ID + id <- strsplit(as.character(x$ID), split="_")[[1]][1] + x$ID <- id + return(x) + }, paired=paired))) + vcfData <- temp[,c("chromosome", "position", "chromosome2", "position2", "direction", + "REF", "ALT", "svtype", "total_read_support", "FILTER", "sample", + "ID", "INFO", "FORMAT", "tumorSample", "paired")] + + ## Remove duplicate IDs (i.e. reciprocal translocation events) + vcfData <- vcfData[!duplicated(vcfData$ID),] + + ## Get the svtype + svType <- data.table(unique(vcfData$svtype)) + colnames(svType) <- "svtype" + + ## Initialize the object + new("VCF_Lumpy_v4.2", description=finalDescription, sample=sample, + vcfData=vcfData, svType=svType) +} \ No newline at end of file diff --git a/R/VarScanFormat-class.R b/R/VarScanFormat-class.R index bbdf9de..be196e4 100644 --- a/R/VarScanFormat-class.R +++ b/R/VarScanFormat-class.R @@ -261,7 +261,7 @@ setMethod(f="getPath", #' @importFrom data.table data.table setMethod(f="getLohData", signature="VarScanFormat", - definition=function(object, verbose, lohSpec, germline, ...) { + definition=function(object, verbose, getHeterozygousCalls, germline, ...) { ## Print status message if (verbose) { @@ -284,7 +284,7 @@ setMethod(f="getLohData", colnames(primaryData) <- c("chromosome", "position", "tumor_var_freq", "normal_var_freq", "sample") - if (lohSpec) { + if (getHeterozygousCalls) { ## Remove rows if necessary if (any(object@varscan$normal_var_freq<0.4 | object@varscan$normal_var_freq>0.6)) { message("Detected values with a variant allele fraction either ", diff --git a/R/VariantCallFormat-class.R b/R/VariantCallFormat-class.R index 20c9b7c..3c042e7 100644 --- a/R/VariantCallFormat-class.R +++ b/R/VariantCallFormat-class.R @@ -162,14 +162,14 @@ VariantCallFormat <- function(path=NULL, data=NULL, version="auto", svCaller=NUL x <- x[grepl("fileformat=", x)] ## Extract the version - x <- regmatches(x, regexpr("[0-9]+\\.*[0-9]*",x)) + x <- as.character(regmatches(x, regexpr("[0-9]+\\.*[0-9]*",x))) if (length(x) != 1) { memo <- paste("Expected 1 entry for VCF version found:", - length(x), "using", as.numeric(x[1])) + length(x), "using", as.character(x[1])) warning(memo) } - return(as.numeric(x[1])) + return(as.character(x[1])) } if (version == "auto") { version <- unique(unlist(lapply(vcfHeader, a2))) @@ -187,7 +187,7 @@ VariantCallFormat <- function(path=NULL, data=NULL, version="auto", svCaller=NUL } ## Perform quality check for the svCaller - if (!svCaller %in% c("Manta")) { + if (!svCaller %in% c("Manta", "Lumpy")) { memo <- paste0("The specified svCaller: ", svCaller, " is not supported. ", "Only the following callers are support: Manta. ", "Make sure the svCaller is one of the ", @@ -200,8 +200,12 @@ VariantCallFormat <- function(path=NULL, data=NULL, version="auto", svCaller=NUL vcfObject <- VCF_Manta_v4.1(vcfData=vcfData, vcfHeader=vcfHeader, paired=paired, tumorColumn=tumorColumn) } else if (version == "4.2" & svcaller =="Manta") { vcfObject <- VCF_Manta_v4.2(vcfData=vcfData, vcfHeader=vcfHeader, paired=paired, tumorColumn=tumorColumn) + } else if (version=="4.1" & svCaller == "Lumpy"){ + vcfObject <- VCF_Lumpy_v4.1(vcfData=vcfData, vcfHeader=vcfHeader, paired=paired, tumorColumn=tumorColumn) + } else if (version == "4.2" & svCaller=="Lumpy") { + vcfObject <- VCF_Lumpy_v4.2(vcfData=vcfData, vcfHeader=vcfHeader, paired=paired, tumorColumn=tumorColumn) } else { - memo <- paste("Currently only VCF versions 4.1 and 4.2 for Manta are supported,", + memo <- paste("Currently only VCF versions 4.1 and 4.2 outputted by Manta and Lumpy are supported,", "make a feature request on", "https://github.com/griffithlab/GenVisR!") stop(memo) diff --git a/R/combinedCnLoh-class.R b/R/combinedCnLoh-class.R index 49f64e5..50adf62 100644 --- a/R/combinedCnLoh-class.R +++ b/R/combinedCnLoh-class.R @@ -45,26 +45,51 @@ setClass( #' coordinates #' @export cnLoh <- function(cnInput, lohInput, samples, chromosomes, BSgenome, windowSize, - step, normal, plotAColor, plotALayers, plotBAlpha, - somaticLohCutoff, plotBTumorColor, plotBNormalColor, plotBLayers, - plotCLimits, plotCLowColor, plotCHighColor, plotCLayers, + step, getHeterozygousLohCalls, plotAColor, plotALayers, plotBAlpha, + somaticLohCutoff, plotBColors, plotBLayers, + plotCLimits, plotCColors, plotCLayers, sectionHeights, verbose) { + ## Check each of the input parameters + cnLohInputParameters <- checkCombinedCnLohInputParameters(cnInput=cnInput, lohInput=lohInput, samples=samples, + chromosomes=chromosomes, BSgenome=BSgenome, + windowSize=windowSize, step=step, + getHeterozygousLohCalls=getHeterozygousLohCalls, + somaticLohCutoff=somaticLohCutoff, + plotAColor=plotAColor, plotALayers=plotALayers, + plotBAlpha=plotBAlpha, plotBColors=plotBColors, + plotBLayers=plotBLayers, plotClimits=plotCLimits, + plotCColors=plotCColors, plotCLayers=plotCLayers, + sectionHeights=sectionHeights, verbose=verbose) + ## Obtain cn, somatic loh, and germline loh datasets to plot - cnLohDataset <- cnLohData(cnInput=cnInput, lohInput=lohInput, samples=samples, chromosomes=chromosomes, - BSgenome=BSgenome, windowSize=windowSize, - step=step, normal=normal, verbose=verbose) + cnLohDataset <- cnLohData(cnInput=cnInput, lohInput=lohInput, + samples=checkCombinedCnLohInputParameters@samples, + chromosomes=checkCombinedCnLohInputParameters@chromosomes, + BSgenome=checkCombinedCnLohInputParameters@BSgenome, + windowSize=checkCombinedCnLohInputParameters@windowSize, + step=checkCombinedCnLohInputParameters@step, + normal=checkCombinedCnLohInputParameters@getHeterozygousLohCalls, + verbose=checkCombinedCnLohInputParameters@verbose) ## Generate the cn, somatic LOH, and germline LOH plots - plots <- cnLohPlots(object=cnLohDataset, plotAColor=plotAColor, plotALayers=plotALayers, - plotBAlpha=plotBAlpha, somaticLohCutoff=somaticLohCutoff, plotBTumorColor=plotBTumorColor, - plotBNormalColor=plotBNormalColor, plotBLayers=plotBLayers, - plotCLimits=plotCLimits, - plotCLowColor=plotCLowColor, plotCHighColor=plotCHighColor, - plotCLayers=plotCLayers, verbose=verbose) + plots <- cnLohPlots(object=cnLohDataset, + somaticLohCutoff=checkCombinedCnLohInputParameters@somaticLohCutoff, + plotAColor=checkCombinedCnLohInputParameters@plotAColor, + plotALayers=checkCombinedCnLohInputParameters@plotALayers, + plotBAlpha=checkCombinedCnLohInputParameters@plotBAlpha, + plotBColors=checkCombinedCnLohInputParameters@plotBColors, + plotBNormalColor=checkCombinedCnLohInputParameters@plotBNormalColor, + plotBLayers=checkCombinedCnLohInputParameters@plotBLayers, + plotCLimits=checkCombinedCnLohInputParameters@plotCLimits, + plotCLowColor=checkCombinedCnLohInputParameters@plotCColors, + plotCLayers=checkCombinedCnLohInputParameters@plotCLayers, + verbose=checkCombinedCnLohInputParameters@verbose) ## Arrange all of the plots together - Grob <- arrangeCnLohPlots(object=plots, sectionHeights=sectionHeights, verbose=verbose) + Grob <- arrangeCnLohPlots(object=plots, + sectionHeights=checkCombinedCnLohInputParameters@sectionHeights, + verbose=checkCombinedCnLohInputParameters@verbose) ## Initialize the object new("cnLoh", cnData=getData(cnLohDataset, index=1), cnPlot=getGrob(plots, index=1), @@ -75,6 +100,360 @@ cnLoh <- function(cnInput, lohInput, samples, chromosomes, BSgenome, windowSize, #!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Private Classes !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!# +#' Private Class cnLohInputParameters +#' +#' An S4 class to check input parameters of the combinedCnLoh function +#' @name cnLohInputParameters-class +#' @noRd +setClass("cnLohInputParameters", + representation=representation(samples="character", + chromosomes="character", BSgenome="BSgenome", + windowSize="numeric", step="numeric", + getHeterozygousLohCalls="logical", + somaticLohCutoff="numeric", + plotAColor="character", plotALayers="list", + plotBAlpha="numeric", plotBColors="character", + plotBLayers="list", plotClimits="numeric", + plotCColors="character", plotCLayers="list", + sectionHeights="numeric", verbose="logical"), + validity=function(object){ + + }) + +#' Constructor for the cnLohInputParameters class +#' +#' @name cnLohInputParameters +#' @rdname cnLohInputParameters-class +#' @noRd +checkCombinedCnLohInputParameters <- function(cnInput, lohInput, samples, chromosomes, BSgenome, + windowSize, step, getHeterozygousLohCalls, + somaticLohCutoff, plotAColor, plotALayers, + plotBAlpha, plotBColors, plotBLayers, plotClimits, + plotCColors, plotCLayers, sectionHeights, verbose) { + ##### Check the verbose parameter ##### + ## Check to see if verbose is a boolean + if (!is.logical(verbose) | is.null(verbose)) { + memo <- paste0("The verbose parameter is not a boolean (T/F). Coercing verbose to be FALSE...") + message(memo) + verbose <- FALSE + } + + ##### TODO: Check the samples parameter ##### + ## Check is samples is NULL + if (is.null(samples)) { + samples <- unique(object@sample$sample) + samples <- factor(samples, levels=gtools::mixedsort(samples)) + memo <- paste0("Sample parameter cannot be NULL. All samples will be plotted.") + message(memo) + } + ## Check if samples is a character vector + if (!is.character(samples)) { + memo <- paste0("samples variable not of the character class. Attempting to coerce.") + samples <- as.character(samples) + message(memo) + } + + ## Check if the designated samples is in the sv dataset + if (!is.null(samples)) { + `%nin%` = Negate(`%in%`) + discrepantSamples <- paste(samples[which(samples %nin% unique(object@sample$sample))], collapse=", ") + if (length(discrepantSamples) > 0 & discrepantSamples != "") { + memo <- paste0("The desired samples: ", discrepantSamples, " are not found ", + "in the SV dataset. Available sample names include: ", + paste(unique(object@sample$sample), collapse=", "), ". ", + "Please designate valid sample names.") + stop(memo) + } + } + + ##### Check the chromosomes parameter ##### + if (is.null(chromosomes)) { + chromosomes <- paste("chr", seq(1:22), sep="") + memo <- paste0("chromosomes parameter cannot be NULL. Using all autosomes...") + message(memo) + } + ## Check if chromosomes is a character vector + if (!is.character(chromosomes)) { + memo <- paste0("chromosomes variable not of the character class. Attempting to coerce.") + chromosomes <- as.character(chromosomes) + message(memo) + } + ## Check if it has the "chr" prefix + # Check to see if the chromosomes variable has "chr" in front if not NULL, autosomes, or all + if (all(chromosomes!="autosomes") & all(chromosomes!="all")) { + if (!all(grepl("^chr", chromosomes))) { + if (verbose) { + memo <- paste0("Did not detect the prefix chr in the chromosomes specified ", + "in the `chromosomes` variable... adding prefix") + message(memo) + chromosomes <- paste("chr", chromosomes, sep="") + } + } else if (all(grepl("^chr", chromosomes))) { + if (verbose) { + memo <- paste0("Detected chr in the `chromosomes` variable...", + "proceeding") + message(memo) + } + } else { + memo <- paste0("Detected unknown or mixed prefixes in the `chromosomes`` variable", + " colum of object... should either be chr or non (i.e.) chr1 or 1") + message(memo) + } + } + + ##### Check the BSgenome parameter ##### + ## Check to see if BSgenome is a BSgenome + if (is.null(BSgenome)) { + memo <- paste("BSgenome object is not specified. This parameter is required ", + "to get the lengths of the chromsomes being plotted.") + stop(memo) + } else if (is(BSgenome, "BSgenome")) { + memo <- paste("BSgenome passed object validity checks") + message(memo) + } else { + memo <- paste("class of the BSgenome object is", class(BSgenome), + ". Should be of class BSgenome. This parameter is required ", + "to get the lengths of the chromsomes being plotted.") + stop(memo) + BSgenome <- NULL + } + + ##### Check the windowSize parameter ##### + if (is.null(windowSize)) { + windowSize <- 2500000 + memo <- paste0("windowSize parameter cannot be NULL. Setting the windowSize value to 2500000.") + message(memo) + } + ## Check if windowSize is numeric + if (!is.numeric(windowSize)) { + memo <- paste0("windowSize variable not of the numeric class. Attempting to coerce.") + windowSize <- as.numeric(windowSize) + message(memo) + } + + ##### Check the step parameter ##### + if (is.null(step)) { + step <- 1000000 + memo <- paste0("step parameter cannot be NULL. Setting the step value to 1000000.") + message(memo) + } + ## Check if step is numeric + if (!is.numeric(step)) { + memo <- paste0("step variable not of the numeric class. Attempting to coerce.") + step <- as.numeric(step) + message(memo) + } + ## Check to see if step is greater than windowSize + if (step > windowSize) { + memo <- paste("Step value is greater than windowSize. Make sure that the step value is + at most equal to the WindowSize. Using default values for both parameters.") + warning(memo) + step <- 1000000 + windowSize <- 2500000 + + } + + ##### Check the getHeterozygousLohCalls ##### + if (!is.logical(getHeterozygousLohCalls) | is.null(getHeterozygousLohCalls)) { + memo <- paste0("The getHeterozygousLohCalls parameter is not a boolean (T/F). ", + "Coercing getHeterozygousLohCalls to be TRUE...") + message(memo) + getHeterozygousLohCalls <- FALSE + } + + ##### Check the somaticLohCutoff ##### + if (is.null(somaticLohCutoff)) { + somaticLohCutoff <- 0.1 + memo <- paste0("somaticLohCutoff parameter cannot be NULL. Setting the somaticLohCutoff value to 0.1.") + message(memo) + } + ## Check if somaticLohCutoff is numeric + if (!is.numeric(somaticLohCutoff)) { + memo <- paste0("somaticLohCutoff variable not of the numeric class. Attempting to coerce.") + somaticLohCutoff <- as.numeric(somaticLohCutoff) + message(memo) + } + + ##### Check the plotALayers, plotBLayers, and plotCLayers ##### + checkPlotLayer <- function(plotLayer, name) { + if(!is.null(plotLayer)){ + if(!is.list(plotLayer)){ + memo <- paste(name, " is not a list", sep="") + stop(memo) + } + + if(any(!unlist(lapply(plotLayer, function(x) ggplot2::is.ggproto(x) | ggplot2::is.theme(x) | is(x, "labels"))))){ + memo <- paste(name, " is not a list of ggproto or ", + "theme objects... setting plotALayers to NULL", sep="") + warning(memo) + plotLayer <- NULL + } + } + return(plotLayer) + } + plotALayers <- checkPlotLayer(plotLayer=plotALayers, "plotALayers") + plotBLayers <- checkPlotLayer(plotLayer=plotBLayers, "plotBLayers") + plotCLayers <- checkPlotLayer(plotLayer=plotCLayers, "plotCLayers") + + ##### Check the plotAColor ##### + ## Check if it is a character vector + if (is.null(plotAColor)) { + memo <- paste0("plotAColor was set to NULL. Using default color.") + message(memo) + plotAColor <- c("Blue") + } + if (!is.character(plotAColor)) { + memo <- paste0("plotAColor variable not of the character class. Attempting to coerce.") + plotAColor <- as.character(plotAColor) + message(memo) + } + areColors <- function(x) { + sapply(x, function(X) { + tryCatch(is.matrix(col2rgb(X)), + error = function(e) FALSE) + }) + } + if (any(areColors(plotAColor) == FALSE)) { + ## Get the invalid color + nonColor <- plotAColor[which(data.table(areColors(plotAColor))$V1==FALSE)] + memo <- paste0("The ", nonColor, " designated in the plotAColor parameter is not a valid color. ", + "Making the plotAColor to be: Blue.") + + message(memo) + plotAColor <- c("Blue") + } + + ##### Check the plotBAlpha ##### + if (is.null(plotBAlpha)) { + plotBAlpha <- 0.75 + memo <- paste0("plotBAlpha parameter cannot be NULL. Setting the plotBAlpha value to 0.75") + message(memo) + } + ## Check if plotBAlpha is numeric + if (!is.numeric(plotBAlpha)) { + memo <- paste0("plotBAlpha variable not of the numeric class. Attempting to coerce.") + plotBAlpha <- as.numeric(plotBAlpha) + message(memo) + } + + ##### Check the plotBColors ##### + ## Check if it is a character vector + if (is.null(plotBColors)) { + memo <- paste0("plotBColors was set to NULL. Using default colors. ", + "Tumor vaf calls will be ", + "dark green and normal vaf calls will be dark red.") + message(memo) + plotBColors <- c("Dark Green", "Dark Red") + } + if (!is.character(plotBColors)) { + memo <- paste0("plotBColors variable not of the character class. Attempting to coerce.") + plotBColors <- as.character(plotBColors) + message(memo) + } + areColors <- function(x) { + sapply(x, function(X) { + tryCatch(is.matrix(col2rgb(X)), + error = function(e) FALSE) + }) + } + if (any(areColors(plotBColors) == FALSE)) { + ## Get the invalid color + nonColor <- plotBColors[which(data.table(areColors(plotBColors))$V1==FALSE)] + memo <- paste0("The ", nonColor, " designated in the plotBColors parameter is not a valid color. ", + "Making the plotBColors to be: dark green and dark red. Tumor vaf calls will be ", + "dark green and normal vaf calls will be dark red.") + + message(memo) + plotBColors <- c("Dark Green", "Dark Red") + } + + ##### Check the plotCLimits ##### + if (is.null(plotCLimits)) { + plotCLimits <- 25 + memo <- paste0("plotCLimits parameter cannot be NULL. Setting the plotCLimits value to 25") + message(memo) + } + ## Check if plotCLimits is numeric + if (!is.numeric(plotCLimits)) { + memo <- paste0("plotCLimits variable not of the numeric class. Attempting to coerce.") + plotCLimits <- as.numeric(plotCLimits) + message(memo) + } + + ##### Check the plotCColors ##### + ## Check if it is a character vector + if (is.null(plotCColors)) { + memo <- paste0("plotCColors was set to NULL. Using default colors. ", + "Tumor vaf calls will be ", + "dark green and normal vaf calls will be dark red.") + message(memo) + plotCColors <- c("white", "Dark Red") + } + if (!is.character(plotCColors)) { + memo <- paste0("plotCColors variable not of the character class. Attempting to coerce.") + plotCColors <- as.character(plotCColors) + message(memo) + } + areColors <- function(x) { + sapply(x, function(X) { + tryCatch(is.matrix(col2rgb(X)), + error = function(e) FALSE) + }) + } + if (any(areColors(plotCColors) == FALSE)) { + ## Get the invalid color + nonColor <- plotCColors[which(data.table(areColors(plotCColors))$V1==FALSE)] + memo <- paste0("The ", nonColor, " designated in the plotCColors parameter is not a valid color. ", + "Making the plotCColors to be: white and dark red.") + + message(memo) + plotCColors <- c("white", "Dark Red") + } + ##### Check the sectionHeights ##### + ## Check if it not NULL + if (is.null(sectionHeights)) { + sectionHeights <- c(0.3, 0.4, 0.3) + memo <- paste0("sectionHeights variable cannot be NULL. Using default values.") + message(memo) + } + + ## Check that values are numeric + if (!is.numeric(sectionHeights)) { + memo <- paste0("sectionHeights valures are not class numeric. Attempting to coerce...") + message(memo) + sectionHeights <- as.numeric(sectionHeights) + } + + ## Check that the values are > 0 + if (any(sectionHeights<0)) { + memo <- paste0("sectionHeights cannot be a negative value. Using default values.") + message(memo) + sectionHeights <- c(0.3, 0.4, 0.3) + } + + ## Check that there are 2 values in the variable + if (length(sectionHeights)!=3) { + memo <- paste0("3 values must be supplied to the sectionHeights parameter, which specifies the ", + "relative height of the cn plot, somatic loh plot, and germline plot respecively.") + message(memo) + sectionHeights <- c(0.3, 0.4, 0.3) + } + + ## Check that the values sum up to 1 + if (sum(sectionHeights)!=1) { + memo <- paste0("sectionHeight values do not equal 1. Using default values.") + message(memo) + sectionHeights <- c(0.3, 0.4, 0.3) + } + + new("cnLohInputParameters", samples=samples, chromosomes=chromosomes, BSgenome=BSgenome, + windowSize=windowSize, step=step, getHeterozygousLohCalls=getHeterozygousLohCalls, + somaticLohCutoff=somaticLohCutoff, plotAColor=plotAColor, plotALayers=plotALayers, + plotBAlpha=plotBAlpha, plotBColors=plotBColors, plotBLayers=plotBLayers, + plotClimits=plotCLimits, plotCColors=plotCColors, plotCLayers=plotCLayers, + sectionHeights=sectionHeights, verbose=verbose) +} + #' Private Class cnLohData #' #' An S4 class for the data to plot cn, somatic LOH, and germline LOH plots @@ -345,22 +724,6 @@ setMethod(f="chrSubset", message(memo) } - # if chromosomes is null we dont want to do anything just return the object back - if(is.null(chromosomes)){ - return(object) - } - - # perform quality checks on the chromosome parameter arguments - - # check for character vector - if(!is.character(chromosomes)){ - memo <- paste("Input to chromosomes should be a character vector, - specifying which chromosomes to plot, - attempting to coerce...") - warning(memo) - chromosomes <- as.character(chromosomes) - } - ## Check format of the chromosome column if (!all(grepl("^chr", object$chromosome))) { memo <- paste0("Did not detect the prefix chr in the chromosome column ", @@ -430,18 +793,6 @@ setMethod(f="sampleSubset", message(memo) } - ## If samples is null, we don't want to do anything and just return the object - if (is.null(samples)) { - return(object) - } - - ## Perform quality checkes on the sample parameter arguments - if (!is.character(samples)) { - memo <- paste("Input to samples should be a character vector, - attempting to coerce...") - warning(memo) - } - ## Check for specified samples not in the original input missingSamp <- samples[!samples %in% unique(object$sample)] if (length(missingSamp) != 0) { @@ -556,25 +907,6 @@ setMethod(f="annoGenomeCoord", message(memo) } - ## Perform quality check on BSgenome object - if (is.null(BSgenome)) { - memo <- paste("BSgenome object is not specified, whole chromosomes", - "will not be plotted, this is not recommended!") - warning(memo) - object$chromosome <- factor(object$chromosome, levels=gtools::mixedsort(unique(as.character(object$chromosome)))) - return(object) - } else if (is(BSgenome, "BSgenome")) { - if(verbose){ - memo <- paste("BSgenome passed object validity checks") - } - } else { - memo <- paste("class of the BSgenome object is", class(BSgenome), - "should either be of class BSgenome or NULL", - "setting this to param to NULL") - warning(memo) - BSgenome <- NULL - } - ## Create a data table of genomic coordinates end positions genomeCoord <- data.table::as.data.table(seqlengths(BSgenome)) colnames(genomeCoord) <- c("end") @@ -630,33 +962,6 @@ setMethod(f="getLohSlidingWindow", message("Calcuating window sizes for loh calcluations on all chromosomes in each individual sample") } - ## Perform quality check on input variables - - ## Check that step and windowSize are numeric vectors with length of 1 - if (!is.numeric(windowSize)) { - memo <- paste("WindowSize input value is not a numeric vector, attempting to coerce...") - warning(memo) - } - if (!is.numeric(step)) { - memo <- paste("Step input value is not a numeric vector, attempting to coerce...") - warning(memo) - } - if (length(windowSize) > 1) { - memo <- paste("Use only 1 numeric value to specify window size.") - warning(memo) - stop() - } - if (length(step) > 1) { - memo <- paste("Use only 1 numeric value to specify step size.") - warning(memo) - stop() - } - if (step > windowSize) { - memo <- paste("Step value is greater than windowSize. Make sure that the step value is - at most equal to the WindowSize. Changing step value to match the windowSize value.") - warning(memo) - step <- windowSize - } ## Obtain lists for each sample and chromosome out <- split(object, list(as.character(object$chromosome), as.character(object$sample))) @@ -700,7 +1005,6 @@ setMethod(f="getLohSlidingWindow", return(window) }) - ############################################################### ##### Function to perform loh calcluations in each window ##### #' @rdname getLohCalculation-methods @@ -718,14 +1022,6 @@ setMethod(f="getLohCalculation", message("Calculating absolute mean difference between t/n VAF at each coordinate provided.") } - ## Perform quality checkes on the input parameters - if (!is.logical(normal)) { - memo <- ("Input to specify normal VAF should be a boolean (T/F). True if - user wants to use normal VAF from varscan to identify tumor/normal LOH difference. - Flase if user wants to use 0.5 to identify tumor/normal LOH difference.") - message(memo) - } - ## Split object for each unqiuq sample-chr combination object <- split(object, list(as.character(object$chromosome), as.character(object$sample))) @@ -944,21 +1240,6 @@ setMethod(f="buildSomaticLohPlot", message("Building somatic loh plot") } - ## Perform quality checks on the input variables - if(!is.null(plotBLayers)){ - if(!is.list(plotBLayers)){ - memo <- paste("plotBLayers is not a list") - stop(memo) - } - - if(any(!unlist(lapply(plotBLayers, function(x) ggplot2::is.ggproto(x) | ggplot2::is.theme(x) | is(x, "labels"))))){ - memo <- paste("plotBLayers is not a list of ggproto or ", - "theme objects... setting plotBLayers to NULL") - warning(memo) - plotBLayers <- NULL - } - } - ## Separate datasets segLohData <- object@segLohData segLohData <- segLohData[seg.mean > somaticLohCutoff] @@ -1031,21 +1312,6 @@ setMethod(f="buildGermlineLohPlot", message("Building germline loh plot") } - ## Perform quality checks on the input variables - if(!is.null(plotCLayers)){ - if(!is.list(plotCLayers)){ - memo <- paste("plotCLayers is not a list") - stop(memo) - } - - if(any(!unlist(lapply(plotCLayers, function(x) ggplot2::is.ggproto(x) | ggplot2::is.theme(x) | is(x, "labels"))))){ - memo <- paste("plotCLayers is not a list of ggproto or ", - "theme objects... setting plotCLayers to NULL") - warning(memo) - plotCLayers <- NULL - } - } - ## Separate datasets germlineLohData <- object@rawGermlineLohData chrData <- object@chrData @@ -1094,20 +1360,6 @@ setMethod(f="arrangeCnLohPlots", message("Combining cn, somatic loh, and germline loh plots") } - ## Perform quality checkes on input parameters - if (!is.numeric(sectionHeights)) { - memo <- paste("Values specified for the section heights are - not numeric, attempting to coerce...") - message(memo) - } - if (length(sectionHeights) != 3) { - memo <- paste("Heights for cn/loh figures are not specified. The sectionHegihts - variable should be a numeric vector of legth 3 specifying the heights of each of the - 3 figures (cn, somatic loh, and germline loh).") - message(memo) - stop() - } - ## Grab the data we need plotA <- object@cnPlot plotB <- object@somaticLohPlot @@ -1124,27 +1376,6 @@ setMethod(f="arrangeCnLohPlots", plotList[[i]]$widths <- maxWidth } - ## Set section heights based upon the number of sections - defaultPlotHeights <- c(0.3, 0.4, 0.3) - - if(is.null(sectionHeights)){ - if(length(plotList) < 3){ - defaultPlotHeights <- defaultPlotHeights[-length(defaultPlotHeights)] - } - sectionHeights <- defaultPlotHeights - } else if(length(sectionHeights) != length(plotList)){ - memo <- paste("There are", length(sectionHeights), "section heights provided", - "but", length(plotList), "vertical sections...", - "using default values!") - warning(memo) - sectionHeights <- defaultPlotHeights - } else if(!all(is.numeric(sectionHeights))) { - memo <- paste("sectionHeights must be numeric... Using", - "default values!") - warning(memo) - sectionHeights <- defaultPlotHeights - } - ## Arrange the final plot finalPlot <- do.call(gridExtra::arrangeGrob, c(plotList, list(ncol=1, heights=sectionHeights))) plot(finalPlot) diff --git a/R/lohSpec-class.R b/R/lohSpec-class.R index 46be01b..9707700 100644 --- a/R/lohSpec-class.R +++ b/R/lohSpec-class.R @@ -34,47 +34,405 @@ setClass( #' @param samples Character vector specifying samples to plot. If not NULL #' all samples in "input" not specified with this parameter are removed. #' @param chromosomes Character vector specifying chromosomes to plot. If not NULL -#' all chromosomes in "input" not specified with this parameter are removed. +#' all chromosomes in "input" not specified with this parameter are removed. If +#' autosomes, it will plot the non-sex chromosomes. Defaults to autosomes. #' @param BSgenome Object of class BSgenome to extract genome wide chromosome #' coordinates #' @param step Integer value specifying the step size (i.e. the number of base #' pairs to move the window). required when method is set to slide -#' (see details). +#' (see details). Defaults to 1000000 #' @param windowSize Integer value specifying the size of the window in base -#' pairs in which to calculate the mean Loss of Heterozygosity (see details). -#' @param normal Boolean specifiying what value to use for normal VAF when +#' pairs in which to calculate the mean Loss of Heterozygosity (see details). +#' Defaults to 2500000. +#' @param normalVAF Boolean specifiying what value to use for normal VAF when #' calcualting average LOH difference. Defaults to .50\% if FALSE. #' If TRUE, will use average normal VAF in each individual sample as value #' to calculate LOH. +#' @param gradientMidpoint Integer value specifying the midpoint of the loh +#' color gradient, which ranges from 0-0.5. Defaules to 0.2. +#' @param gradientColors Character vector with valid colors specifying the +#' gradient to visualize the loh spectrum. Defaults to "#ffffff", "#b2b2ff", and +#' "#000000" +#' @param plotAType Character vector (either "proportion" or "frequency") that +#' directrs the function to plot the proportion or the frequency of samples with +#' LOH in a specific region across the entire cohort. Defaults to proportion. +#' @param plotALohCutoff Integer specifying the VAF cutoff to consider LOH events +#' @param plotAColor Character vector specifying the color for loh frequency bars +#' @param plotALayers List of ggplot2 layers to be passed to loh frequency plot +#' @param plotBLayers List of ggplot2 layers to be passed to loh heatmap plot +#' @param sectionHeights Integer vector specifying the relative heights for each of the plots +#' @param verbose Boolean specifying if status messages should be reported #' @export -LohSpec <- function(input, lohSpec=TRUE, chromosomes="autosomes", samples=NULL, +LohSpec <- function(input, getHeterozygousCalls=TRUE, chromosomes="autosomes", samples=NULL, BSgenome=BSgenome, step=1000000, windowSize=2500000, - normal=FALSE, gradientMidpoint=.2, gradientColors=c("#ffffff", "#b2b2ff", "#000000"), - plotAType="proportion", plotALohCutoff=0.2, plotAColor="#98F5FF", + normalVAF=FALSE, gradientMidpoint=.2, gradientColors=c("#ffffff", "#b2b2ff", "#000000"), + plotAType="proportion", plotALohCutoff=0.1, plotAColor="#98F5FF", plotALayers=NULL, plotBLayers=NULL, sectionHeights=c(0.25, 0.75), verbose=FALSE){ - + + ## Constructor to check input parameters for the lohSpec function + lohInputParameters <- checkLohInputParameters(object=object, getHeterozygousCalls=getHeterozygousCalls, + chromosomes=chromosomes, sample=sample, + BSgenome=BSgenome, step=step, + windowSize=windowSize, normalVAF=normalVAF, + gradientMidpoint=gradientMidpoint, + gradientColors=gradientColors, + plotAType=plotAType, plotALohCutoff=plotALohCutoff, + plotAColor=plotAColor, plotALayers=plotALayers, + plotBLayers=plotBLayers, sectionHeights=sectionHeights, + verbose=verbose) + ## Calculate all data for plots - lohDataset <- lohData(object=input, lohSpec=lohSpec, chromosomes=chromosomes, samples=samples, - BSgenome=BSgenome, step=step, plotALohCutoff=plotALohCutoff, - windowSize=windowSize, normal=normal, verbose=verbose) + lohDataset <- lohData(object=input, getHeterozygousCalls=lohInputParameters@getHeterozygousCalls, + chromosomes=lohInputParameters@chromosomes, + samples=lohInputParameters@sample, + BSgenome=lohInputParameters@BSgenome, + step=lohInputParameters@step, + plotALohCutoff=lohInputParameters@plotALohCutoff, + windowSize=lohInputParameters@windowSize, + normal=lohInputParameters@normalVAF, + verbose=lohInputParameters@verbose) ## Initialize the lohSpecPlots object - plots <- lohSpecPlots(object=lohDataset, plotALohCutoff=plotALohCutoff, - plotAType=plotAType, plotAColor=plotAColor, - plotALayers=plotALayers, plotBLayers=plotBLayers, - gradientMidpoint=gradientMidpoint, gradientColors=gradientColors, - verbose=verbose) + plots <- lohSpecPlots(object=lohDataset, + plotALohCutoff=lohInputParameters@plotALohCutoff, + plotAType=lohInputParameters@plotAType, + plotAColor=lohInputParameters@plotAColor, + plotALayers=lohInputParameters@plotALayers, + plotBLayers=lohInputParameters@plotBLayers, + gradientMidpoint=lohInputParameters@gradientMidpoint, + gradientColors=lohInputParameters@gradientColors, + verbose=lohInputParameters@verbose) ## Arrange freq and spectrum plots Grob <- arrangeLohPlots(object=plots, sectionHeights=sectionHeights, verbose=verbose) - + ## Initialize the object new("lohSpec", lohFreq_plot=getGrob(plots, index=1), lohSpec_plot=getGrob(plots, index=2), lohData=getData(lohDataset, name="primaryData"), Grob=Grob) } #!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Private Classes !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!# +#' Private Class lohInputParameters +#' +#' An S4 class to check input parameters of the StructuralVariant function +#' @name lohInputParameters-class +#' @noRd +setClass("lohInputParameters", + representation=representation(getHeterozygousCalls="logical", chromosomes="character", + sample="character", BSgenome="BSgenome", + step="numeric", windowSize="numeric", + normalVAF="logical", gradientMidpoint="numeric", + gradientColors="character", + plotAType="character", plotALohCutoff="numeric", + plotAColor="character", plotALayers="list", + plotBLayers="list", sectionHeights="numeric", + verbose="logical"), + validity=function(object){ + + }) + +#' Constructor for the lohInputParameters class +#' +#' @name lohInputParameters +#' @rdname lohInputParameters-class +#' @noRd +checkLohInputParameters <- function(object, getHeterozygousCalls, chromosomes, sample, + BSgenome, step, windowSize, normalVAF, + gradientMidpoint, gradientColors, + plotAType, plotALohCutoff, plotAColor, plotALayers, + plotBLayers, sectionHeights, verbose) { + ##### Check the verbose parameter ##### + ## Check to see if verbose is a boolean + if (!is.logical(verbose) | is.null(verbose)) { + memo <- paste0("The verbose parameter is not a boolean (T/F). Coercing verbose to be FALSE...") + message(memo) + verbose <- FALSE + } + + ##### Check the getHeterozygousCalls parameter ##### + if (!is.logical(getHeterozygousCalls) | is.null(getHeterozygousCalls)) { + memo <- paste0("The getHeterozygousCalls parameter is not a boolean (T/F). Coercing getHeterozygousCalls to be TRUE...") + message(memo) + getHeterozygousCalls <- FALSE + } + + ##### Check the chromosomes parameter ##### + if (is.null(chromosomes)) { + chromosomes <- paste("chr", seq(1:22), sep="") + memo <- paste0("chromosomes parameter cannot be NULL. Using all autosomes...") + message(memo) + } + ## Check if chromosomes is a character vector + if (!is.character(chromosomes)) { + memo <- paste0("chromosomes variable not of the character class. Attempting to coerce.") + chromosomes <- as.character(chromosomes) + message(memo) + } + ## Check if it has the "chr" prefix + # Check to see if the chromosomes variable has "chr" in front if not NULL, autosomes, or all + if (all(chromosomes!="autosomes") & all(chromosomes!="all")) { + if (!all(grepl("^chr", chromosomes))) { + if (verbose) { + memo <- paste0("Did not detect the prefix chr in the chromosomes specified ", + "in the `chromosomes` variable... adding prefix") + message(memo) + chromosomes <- paste("chr", chromosomes, sep="") + } + } else if (all(grepl("^chr", chromosomes))) { + if (verbose) { + memo <- paste0("Detected chr in the `chromosomes` variable...", + "proceeding") + message(memo) + } + } else { + memo <- paste0("Detected unknown or mixed prefixes in the `chromosomes`` variable", + " colum of object... should either be chr or non (i.e.) chr1 or 1") + message(memo) + } + } + + ##### Check the samples parameter ##### + ## Check is sample is NULL + if (is.null(sample)) { + sample <- unique(object@sample$sample) + sample <- factor(sample, levels=gtools::mixedsort(sample)) + memo <- paste0("Sample parameter cannot be NULL. All samples will be plotted.") + message(memo) + } + ## Check if sample is a character vector + if (!is.character(sample)) { + memo <- paste0("sample variable not of the character class. Attempting to coerce.") + sample <- as.character(sample) + message(memo) + } + + ## Check if the designated samples is in the sv dataset + if (!is.null(sample)) { + `%nin%` = Negate(`%in%`) + discrepantSamples <- paste(sample[which(sample %nin% unique(object@sample$sample))], collapse=", ") + if (length(discrepantSamples) > 0 & discrepantSamples != "") { + memo <- paste0("The desired samples: ", discrepantSamples, " are not found ", + "in the SV dataset. Available sample names include: ", + paste(unique(object@sample$sample), collapse=", "), ". ", + "Please designate valid sample names.") + stop(memo) + } + } + + ##### Check the BSgenome parameter ##### + ## Check to see if BSgenome is a BSgenome + if (is.null(BSgenome)) { + memo <- paste("BSgenome object is not specified. This parameter is required ", + "to get the lengths of the chromsomes being plotted.") + stop(memo) + } else if (is(BSgenome, "BSgenome")) { + memo <- paste("BSgenome passed object validity checks") + message(memo) + } else { + memo <- paste("class of the BSgenome object is", class(BSgenome), + ". Should be of class BSgenome. This parameter is required ", + "to get the lengths of the chromsomes being plotted.") + stop(memo) + BSgenome <- NULL + } + ##### Check the step parameter ##### + if (is.null(step)) { + step <- 1000000 + memo <- paste0("step parameter cannot be NULL. Setting the step value to 1000000.") + message(memo) + } + ## Check if step is numeric + if (!is.numeric(step)) { + memo <- paste0("step variable not of the numeric class. Attempting to coerce.") + step <- as.numeric(step) + message(memo) + } + + ##### Check the windowSize parameter ##### + if (is.null(windowSize)) { + windowSize <- 2500000 + memo <- paste0("windowSize parameter cannot be NULL. Setting the windowSize value to 2500000.") + message(memo) + } + ## Check if windowSize is numeric + if (!is.numeric(windowSize)) { + memo <- paste0("windowSize variable not of the numeric class. Attempting to coerce.") + windowSize <- as.numeric(windowSize) + message(memo) + } + + ##### Check the normalVAF parameter ##### + if (!is.logical(normalVAF) | is.null(normalVAF)) { + memo <- paste0("normalVAF parameter should be a boolean (T/F). True if ", + "user wants to use normal VAF from varscan to identify tumor/normal LOH difference. ", + "False if user wants to use 0.5 to identify tumor/normal LOH difference. Setting normalVAF ", + "to TRUE.") + message(memo) + normalVAF <- TRUE + } + + ##### Check the gradientMidpoint parameter ##### + if (is.null(gradientMidpoint)) { + gradientMidpoint <- 0.2 + memo <- paste0("gradientMidpoint parameter cannot be NULL. Setting the gradientMidpoint value to 0.") + message(memo) + } + ## Check if gradientMidpoint is numeric + if (!is.numeric(gradientMidpoint)) { + memo <- paste0("gradientMidpoint variable not of the numeric class. Attempting to coerce.") + gradientMidpoint <- as.numeric(gradientMidpoint) + message(memo) + } + ## Check if the value for gradinetMidpoint is between 0 and 0.6 + if (gradientMidpoint > 0.6 | gradientMidpoint < 0.0) { + memo <- paste0("gradientMidpoint parameter must be between 0 and 0.6. This value defines the midpoint of colors ", + "that are used to visualize regions of LOH. Attempting to divide by 100 (i.e. convert 20 to 0.2).") + message(memo) + gradientMidpoint <- gradientMidpoint/100 + } + + ##### Check the gradientColors parameter ##### + ## Check if it is a character vector + if (is.null(gradientColors)) { + memo <- paste0("gradientColors was set to NULL. Using default colors.") + message(memo) + gradientColors <- c("#ffffff", "#b2b2ff", "#000000") + } + if (!is.character(gradientColors)) { + memo <- paste0("gradientColors variable not of the character class. Attempting to coerce.") + gradientColors <- as.character(gradientColors) + message(memo) + } + areColors <- function(x) { + sapply(x, function(X) { + tryCatch(is.matrix(col2rgb(X)), + error = function(e) FALSE) + }) + } + if (any(areColors(gradientColors) == FALSE)) { + ## Get the invalid color + nonColor <- gradientColors[which(data.table(areColors(gradientColors))$V1==FALSE)] + memo <- paste0("The ", nonColor, " designated in the gradientColors parameter is not a valid color. ", + "Making the gradient colors to depict regions of LOH to be: #ffffff, #b2b2ff, and #000000.") + + message(memo) + } + + ##### Check the plotAType parameter ##### + if (is.null(plotAType) | !(plotAType %in% c("proportion", "frequency"))){ + memo <- paste0("The plotAType parameter cannot be NULL. Must be either 'proportion' or 'frequency' ", + "Will plot the proportion of samples with LOH.") + message(memo) + plotAType <- "proportion" + } + + ##### Check the plotALohCutoff parameter ##### + if (is.null(plotALohCutoff)) { + plotALohCutoff <- 0.1 + memo <- paste0("plotALohCutoff parameter cannot be NULL. Setting the plotALohCutoff value to 0.1.") + message(memo) + } + ## Check if plotALohCutoff is numeric + if (!is.numeric(plotALohCutoff)) { + memo <- paste0("plotALohCutoff variable not of the numeric class. Attempting to coerce.") + plotALohCutoff <- as.numeric(plotALohCutoff) + message(memo) + } + ##### Check the plotAColor parameter ##### + ## Check if it is a character vector + if (is.null(plotAColor)) { + memo <- paste0("plotAColor was set to NULL. Using default color.") + message(memo) + plotAColor <- c("#98F5FF") + } + if (!is.character(plotAColor)) { + memo <- paste0("plotAColor variable not of the character class. Attempting to coerce.") + plotAColor <- as.character(plotAColor) + message(memo) + } + areColors <- function(x) { + sapply(x, function(X) { + tryCatch(is.matrix(col2rgb(X)), + error = function(e) FALSE) + }) + } + if (any(areColors(plotAColor) == FALSE)) { + ## Get the invalid color + nonColor <- plotAColor[which(data.table(areColors(plotAColor))$V1==FALSE)] + memo <- paste0("The ", nonColor, " designated in the gradientColors parameter is not a valid color. ", + "Making the gradient colors to depict regions of LOH to be: #98F5FF.") + + message(memo) + plotAColor <- c("#98F5FF") + } + + ##### Check the plotALayers and plotBLayers parameter ##### + checkPlotLayer <- function(plotLayer, name) { + if(!is.null(plotLayer)){ + if(!is.list(plotLayer)){ + memo <- paste(name, " is not a list", sep="") + stop(memo) + } + + if(any(!unlist(lapply(plotLayer, function(x) ggplot2::is.ggproto(x) | ggplot2::is.theme(x) | is(x, "labels"))))){ + memo <- paste(name, " is not a list of ggproto or ", + "theme objects... setting plotALayers to NULL", sep="") + warning(memo) + plotLayer <- NULL + } + } + return(plotLayer) + } + plotALayers <- checkPlotLayer(plotLayer=plotALayers, "plotALayers") + plotBLayers <- checkPlotLayer(plotLayer=plotBLayers, "plotBLayers") + + ##### Check the sectionHeights parameter ##### + ## Check if it not NULL + if (is.null(sectionHeights)) { + sectionHeights <- c(0.25, 0.75) + memo <- paste0("sectionHeights variable cannot be NULL. Using default values.") + message(memo) + } + + ## Check that values are numeric + if (!is.numeric(sectionHeights)) { + memo <- paste0("sectionHeights valures are not class numeric. Attempting to coerce...") + message(memo) + sectionHeights <- as.numeric(sectionHeights) + } + + ## Check that the values are > 0 + if (any(sectionHeights<0)) { + memo <- paste0("sectionHeights cannot be a negative value. Using default values.") + message(memo) + sectionHeights <- c(0.25, 0.75) + } + + ## Check that there are 2 values in the variable + if (length(sectionHeights)!=2) { + memo <- paste0("2 values must be supplied to the sectionHeights parameter, which specifies the ", + "relative height of the loh frequency plot and the loh heatmap.") + message(memo) + sectionHeights <- c(0.25, 0.75) + } + + ## Check that the values sum up to 1 + if (sum(sectionHeights)!=1) { + memo <- paste0("sectionHeight values do not equal 1. Using default values.") + message(memo) + sectionHeights <- c(0.25, 0.75) + } + + + new("lohInputParameters", getHeterozygousCalls=getHeterozygousCalls, chromosomes=chromosomes, + sample=sample, BSgenome=BSgenome, step=step, windowSize=windowSize, + normalVAF=normalVAF, gradientMidpoint=gradientMidpoint, gradientColors=gradientColors, + plotAType=plotAType, plotALohCutoff=plotALohCutoff, plotAColor=plotAColor, + plotALayers=plotALayers, plotBLayers=plotBLayers, sectionHeights=sectionHeights, + verbose=verbose) +} + #' Private Class lohData #' #' An S4 class for the Data of the loh plot object @@ -88,18 +446,18 @@ setClass("lohData", validity = function(object){ } - ) +) #' Constructor for the lohData class. #' #' @name lohData #' @rdname lohData-class #' @param object Object of class VarScan -lohData <- function(object, lohSpec, chromosomes, samples, BSgenome, step, windowSize, +lohData <- function(object, getHeterozygousCalls, chromosomes, samples, BSgenome, step, windowSize, normal, plotALohCutoff, verbose) { - + ## Obtain LOH data for desired chromosomes and samples - primaryData <- getLohData(object=object, verbose=verbose, lohSpec=TRUE, + primaryData <- getLohData(object=object, verbose=verbose, getHeterozygousCalls=TRUE, germline=FALSE) ## Subset data to only the desired chromosomes to be plotted @@ -113,7 +471,7 @@ lohData <- function(object, lohSpec, chromosomes, samples, BSgenome, step, windo ## Obtain chromosome boundaries from BSgenome object chrData <- annoGenomeCoord(object=primaryData, BSgenome=BSgenome, verbose=verbose) - + ## Produce data.table with window position data windowData <- getLohSlidingWindow(object=primaryData, step=step, windowSize=windowSize, verbose=verbose) @@ -134,7 +492,7 @@ lohData <- function(object, lohSpec, chromosomes, samples, BSgenome, step, windo ## Obtain LOH frequency/proportion dataset lohFreq <- getLohFreq(object=lohSegmentation, plotALohCutoff=plotALohCutoff, chrData=chrData, verbose=verbose) - + ## Initialize the object new("lohData", primaryData=primaryData, windowData=rbindlist(windowData), windowCalcData=lohAbsDiffOverlap, chrData=chrData, @@ -303,17 +661,6 @@ setMethod(f="chrSubset", return(object) } - # perform quality checks on the chromosome parameter arguments - - # check for character vector - if(!is.character(chromosomes)){ - memo <- paste("Input to chromosomes should be a character vector, - specifying which chromosomes to plot, - attempting to coerce...") - warning(memo) - chromosomes <- as.character(chromosomes) - } - ## Check format of the chromosome column if (!all(grepl("^chr", object$chromosome))) { memo <- paste0("Did not detect the prefix chr in the chromosome column", @@ -363,7 +710,6 @@ setMethod(f="chrSubset", return(object) }) - ################################################## ##### Function to obtain samples of interest ##### #' @rdname getLohData-methods @@ -383,18 +729,6 @@ setMethod(f="sampleSubset", message(memo) } - ## If samples is null, we don't want to do anything and just return the object - if (is.null(samples)) { - return(object) - } - - ## Perform quality checkes on the sample parameter arguments - if (!is.character(samples)) { - memo <- paste("Input to samples should be a character vector, - attempting to coerce...") - warning(memo) - } - ## Check for specified samples not in the original input missingSamp <- samples[!samples %in% unique(object$sample)] if (length(missingSamp) != 0) { @@ -416,8 +750,7 @@ setMethod(f="sampleSubset", } return(object) - }) - + }) ##################################################### ##### Function to get the chromosome boundaries ##### @@ -464,7 +797,7 @@ setMethod(f="annoGenomeCoord", colnames(genomeCoord) <- c("end") genomeCoord$chromosome <- names(seqlengths(BSgenome)) genomeCoord$start <- 1 - + ## Check that chromosomes between BSgenome and original input match chrMismatch <- as.character(unique(object[!object$chromosome %in% genomeCoord$chromosome,]$chromosome)) if (length(chrMismatch) >= 1) { @@ -494,9 +827,8 @@ setMethod(f="annoGenomeCoord", genomeCoord <- genomeCoord[genomeCoord$chromosome %in% unique(object$chromosome),] return(genomeCoord) - - }) - + + }) ########################################################################## ##### Function to generate window position data for loh calculations ##### @@ -543,7 +875,7 @@ setMethod(f="getLohSlidingWindow", } ## Obtain lists for each sample and chromosome out <- split(object, list(as.character(object$chromosome), - as.character(object$sample))) + as.character(object$sample))) ## Obtain the window position values window <- lapply(out, function(x, step, windowSize) { @@ -584,7 +916,6 @@ setMethod(f="getLohSlidingWindow", return(window) }) - ############################################################### ##### Function to perform loh calcluations in each window ##### #' @rdname getLohCalculation-methods @@ -595,27 +926,19 @@ setMethod(f="getLohSlidingWindow", setMethod(f="getLohCalculation", signature="data.table", definition=function(object, windowData, normal, verbose, ...) { - + ## Print status message if (verbose) { message("Calculating absolute mean difference between t/n VAF at each coordinate provided.") } - ## Perform quality checkes on the input parameters - if (!is.logical(normal)) { - memo <- ("Input to specify normal VAF should be a boolean (T/F). True if - user wants to use normal VAF from varscan to identify tumor/normal LOH difference. - Flase if user wants to use 0.5 to identify tumor/normal LOH difference.") - message(memo) - } - ## Split object for each unqiuq sample-chr combination object <- split(object, list(as.character(object$chromosome), as.character(object$sample))) ## Separate out sample and window data by chromosome name df <- lapply(object, function(sampleData, window, - normal) { + normal) { chromosome <- as.character(sampleData[1,chromosome]) sample <- as.character(sampleData[1,sample]) chromosome.sample <- paste("\\b", paste(chromosome, sample, sep = "."), "\\b", sep = "") @@ -636,7 +959,7 @@ setMethod(f="getLohCalculation", w_stop <- as.numeric(as.character(x[2])) ## Filter out vaf data outside the window filtered_data <- sampleData[position >= w_start & - position <= w_stop] + position <= w_stop] ## Peroform loh calclulation to obtain avg loh in the ## window's frame @@ -663,7 +986,6 @@ setMethod(f="getLohCalculation", return(df) }) - ####################################################################### ##### Function to perform loh calcluations in overlapping windows ##### #' @rdname getLohStepCalculation-methods @@ -695,13 +1017,13 @@ setMethod(f = "getLohStepCalculation", start <- as.numeric(as.character(x[2])) stop <- as.numeric(as.character(x[3])) step_df <- loh_df_data[position >= start & - position < stop] + position < stop] if (nrow(step_df) == 0) { loh_step_avg <- 0 - } + } if (nrow(step_df) > 0) { loh_step_avg <- mean(step_df$loh_diff_avg) - } + } return(loh_step_avg) }, loh_df_data=loh_df) step_boundaries$loh_step_avg <- loh_step_avg @@ -754,7 +1076,7 @@ setMethod(f="getLohFreq", } x <- object[,c("chrom", "loc.start", - "loc.end", "seg.mean", "ID")] + "loc.end", "seg.mean", "ID")] colnames(x) <- c("chromosome", "start", "end", "segmean", "sample") ## Remove any NA values in the data @@ -777,8 +1099,8 @@ setMethod(f="getLohFreq", x <- rbindlist(lapply(split_df, function(x) { # Create the Granges object for the data granges <- GenomicRanges::GRanges(seqnames=x$chromosome, - ranges=IRanges::IRanges(start=x$start, end=x$end), - "sample"=x$sample, "segmean"=x$segmean) + ranges=IRanges::IRanges(start=x$start, end=x$end), + "sample"=x$sample, "segmean"=x$segmean) # disjoin with grange, get a mapping of meta columns and expand it disJoint <- GenomicRanges::disjoin(granges, with.revmap=TRUE) @@ -793,7 +1115,7 @@ setMethod(f="getLohFreq", # convert the GRanges Object back to a data table disJoint <- as.data.table(disJoint)[,c("seqnames", "start", "end", "width", - "sample", "segmean")] + "sample", "segmean")] colnames(disJoint) <- c("chromosome", "start", "end", "width", "sample", "segmean") return(disJoint) })) @@ -888,7 +1210,7 @@ setMethod(f = "buildLohFreq", ", please specify one of \"proportion\" or \"frequency\"") stop(memo) } - + ## Initiate the plot finalDf$gain <- as.numeric(finalDf$gain) finalDf$start <- as.numeric(finalDf$start) @@ -1019,7 +1341,7 @@ setMethod(f = "lohSpec_buildMainPlot", ## Convert to grob lohSpecGrob <- ggplotGrob(p1) return(lohSpecGrob) - }) + }) ######################################################### ##### Function to arrange lohSpec and lohFreq plots ##### @@ -1044,12 +1366,12 @@ setMethod(f="arrangeLohPlots", } if (length(sectionHeights) != 2) { memo <- paste("Heights for both LOH figures are not specified. The sectionHegihts - variable should be a numeric vector of legth 2 specifying the heights of each of the - 2 LOH figures.") + variable should be a numeric vector of legth 2 specifying the heights of each of the + 2 LOH figures.") message(memo) stop() } - + ## Grab the data we need plotA <- object@PlotA plotB <- object@PlotB From d6d05f2631af9fd50e73b6e459992a2e7686f0d8 Mon Sep 17 00:00:00 2001 From: Jason Kunisaki Date: Fri, 4 May 2018 15:52:10 -0500 Subject: [PATCH 21/21] Update to combined cn/somatic loh/germline loh plot function. Allow for multiple samples and chromosomes to be plotted at once. Also put in constructor to check input parameters for lohSpec and combined cn/loh function. --- R/AllGenerics.R | 43 +- R/StructuralVariant-class.R | 2 +- R/VarScanFormat-class.R | 273 ++++++++-- R/VarScanFormat_Virtual-class.R | 1 + R/combinedCnLoh-class.R | 918 +++++++++++++------------------- R/lohSpec-class.R | 31 +- 6 files changed, 609 insertions(+), 659 deletions(-) diff --git a/R/AllGenerics.R b/R/AllGenerics.R index 3dd89bd..9907ac4 100644 --- a/R/AllGenerics.R +++ b/R/AllGenerics.R @@ -790,48 +790,15 @@ setGeneric( def=function(object, ...){standardGeneric("getCnSegmentation")} ) -#' Method buildCnPlot +#' Method buildCnLohPlot #' -#' @name buildCnPlot -#' @rdname buildCnPlot-methods +#' @name buildCnLohPlot +#' @rdname buildCnLohPlot-methods #' @param ... additional arguments to passed #' @noRd setGeneric( - name="buildCnPlot", - def=function(object, ...){standardGeneric("buildCnPlot")} -) - -#' Method buildSomaticLohPlot -#' -#' @name buildSomaticLohPlot -#' @rdname buildSomaticLohPlot-methods -#' @param ... additional arguments to passed -#' @noRd -setGeneric( - name="buildSomaticLohPlot", - def=function(object, ...){standardGeneric("buildSomaticLohPlot")} -) - -#' Method buildGermlineLohPlot -#' -#' @name buildGermlineLohPlot -#' @rdname buildGermlineLohPlot-methods -#' @param ... additional arguments to passed -#' @noRd -setGeneric( - name="buildGermlineLohPlot", - def=function(object, ...){standardGeneric("buildGermlineLohPlot")} -) - -#' Method arrangeCnLohPlots -#' -#' @name arrangeCnLohPlots -#' @rdname arrangeCnLohPlots-methods -#' @param ... additional arguments to passed -#' @noRd -setGeneric( - name="arrangeCnLohPlots", - def=function(object, ...){standardGeneric("arrangeCnLohPlots")} + name="buildCnLohPlot", + def=function(object, ...){standardGeneric("buildCnLohPlot")} ) #' Method removeGapsSegmentation diff --git a/R/StructuralVariant-class.R b/R/StructuralVariant-class.R index fa653ca..937f40b 100644 --- a/R/StructuralVariant-class.R +++ b/R/StructuralVariant-class.R @@ -776,7 +776,7 @@ setMethod(f="getData", setMethod(f="drawPlot", signature="StructuralVariant", definition=function(object, chr1=NULL, chr2=NULL, ...) { - ## Get the list of gtabls + ## Get the list of gtables object <- object@svPlots@plots ## Get the chr combo diff --git a/R/VarScanFormat-class.R b/R/VarScanFormat-class.R index be196e4..c31c3ab 100644 --- a/R/VarScanFormat-class.R +++ b/R/VarScanFormat-class.R @@ -15,8 +15,8 @@ setClass("VarScanFormat", representation=representation(path="character"), contains="VarScanFormat_Virtual", validity = function(object) { - ## Perform validity checks on loh data - if (object@varscan$varscanType[1] == "LOH") { + ## Perform validity checks on somatic loh data + if (object@varscan$type[1]=="somatic loh") { ## Expected varscan column names cnames <- c("chrom", "position", "ref", "var", "normal_reads1", "normal_reads2", "normal_var_freq", @@ -25,7 +25,7 @@ setClass("VarScanFormat", "somatic_p_value", "tumor_reads1_plus", "tumor_reads1_minus", "tumor_reads2_plus", "tumor_reads2_minus", "normal_reads1_plus", "normal_reads1_minus", - "normal_reads2_plus", "normal_reads2_minus", "sample", "varscanType") + "normal_reads2_plus", "normal_reads2_minus", "sample", "type") ## Check to see if there is any data after the filtering steps for varscan if (nrow(object@varscan) == 0) { @@ -33,6 +33,9 @@ setClass("VarScanFormat", normal VAF and Germline/LOH somatic_status") } + ## Convert nVAF to 0.50 if there is no normal column (all NA values) + object@varscan$normal_var_freq[is.na(object@varscan$normal_var_freq)] <- 0.50 + ## Check the column names to see if there is the appropriate input varscan_column_names <- colnames(object@varscan) num <- which(!varscan_column_names%in%cnames) @@ -68,10 +71,61 @@ setClass("VarScanFormat", } } + ## Perform validity checks on germline loh data + if (object@varscan$type[1] == "germline loh") { + ## Expected varscan column names + cnames <- c("chrom", "position", "ref", "var", + "normal_reads1", "normal_reads2", "normal_var_freq", + "normal_gt", "tumor_reads1", "tumor_reads2", "tumor_var_freq", + "tumor_gt", "somatic_status", "variant_p_value", + "somatic_p_value", "tumor_reads1_plus", "tumor_reads1_minus", + "tumor_reads2_plus", "tumor_reads2_minus", + "normal_reads1_plus", "normal_reads1_minus", + "normal_reads2_plus", "normal_reads2_minus", "sample", "type") + + ## Check to see if there is any data after the filtering steps for varscan + if (nrow(object@varscan) == 0) { + stop("No varscan data can be found after filtering based on + normal VAF and Germline/LOH somatic_status") + } + ## Check the column names to see if there is the appropriate input + varscan_column_names <- colnames(object@varscan) + num <- which(!varscan_column_names%in%cnames) + if (length(num) > 0 & length(varscan_column_names) == length(cnames)) { + mismatch <- paste(as.character(varscan_column_names[num]), collapse=", ") + stop(paste0("Column names of varscan input are not what is expected. Please ", + "refer to http://varscan.sourceforge.net/somatic-calling.html#somatic-output ", + "for appropriate column names. The columns: ", + mismatch, " are discrepant.")) + } + + if (length(num) > 0 & length(varscan_column_names) != length(cnames)) { + stop("Number of columns in varscan input are not what is expected. 23 + columns are expected. Please refer to + http://varscan.sourceforge.net/somatic-calling.html#somatic-output + for appropriate columns and column names.") + } + + ## Check to see if the VAF columns are percentage as opposed to proportion + ## Function requires input in percentages and will convert percentage to proportion + normal_per <- any(grepl("%", object@varscan$normal_var_freq) == TRUE) + if (normal_per == TRUE) { + message("Make sure the tumor/normal VAF column is in percentage and not proportion. + (i.e. 75.00% as opposed to 0.75).") + } + + ## Check to see if the VAF provided are somatic or not + if (any(object@varscan$normal_var_freq >1)) { + message("Detected values in either the normal or tumor variant ", + "allele fraction columns above 1. Values supplied should ", + "be a proportion between 0-1!") + } + } + ## Perform validity checks on cnv data - if (object@varscan$varscanType[1] == "CNV") { + if (object@varscan$type[1] == "cnv") { cnames <- c("chrom", "chr_start", "chr_stop", "normal_depth", - "tumor_depth", "log_ratio", "gc_content", "sample", "varscanType") + "tumor_depth", "log_ratio", "gc_content", "sample", "type") } ## Check to see if there is any data after the filtering steps for varscan @@ -113,44 +167,90 @@ setClass("VarScanFormat", #' @importFrom data.table fread #' @importFrom data.table as.data.table #' @export -VarScanFormat <- function(path=NULL, varscanData=NULL, varscanType="LOH", verbose=FALSE) { +VarScanFormat <- function(path=NULL, varscanData=NULL, type="somatic loh", verbose=FALSE) { ## Check for the input variables - if (!varscanType %in% c("LOH" , "CNV")) { - memo <- paste("The specified varscanType is not a supported. Please specify the varscanType as", - "either LOH or CNV.") + if (!type %in% c("somatic loh", "germline loh", "cnv")) { + memo <- paste("The specified type is not a supported. Please specify the type as", + "either somatic loh, germline loh, or cnv.") stop(memo) - } + } + + ## Read in the data through filenames or through a dataset if (is.null(path) & is.null(varscanData)) { memo <- paste("The path and varscanData variables cannot be both NULL.") - warning(memo) - } - if (!is.null(varscanData)){ + stop(memo) + } else if (!is.null(varscanData)){ if (!is.null(path)) { memo <- paste("The path variable is defined but an input dataset is provided.", - "Ignoring the path variable.") + "Ignoring the path variable.") + warning(memo) + } + path <- as.character() + if (!is.data.table(varscanData)) { + memo <- paste("VarscanData provided is not of class data.table.", + "Attempting to coerce.") warning(memo) - if (!is.data.table(varscanData)) { - memo <- paste("VarscanData provided is not of class data.table.", - "Attempting to coerce.") - warning(memo) - varscanData <- as.data.table(varscanData) + varscanData <- as.data.table(varscanData) + } + varscanHeader <- data.table() + } else if (!is.null(path) & is.null(varscanData)) { + ## get the files + varscanFiles <- Sys.glob(path) + path <- varscanFiles + + # anonymous function to read in files + a1 <- function(x, verbose){ + # detect OS and remove slashes and extension + if(.Platform$OS.type == "windows"){ + sampleName <- gsub("(.*/)||(.*\\\\)", "", x) + sampleName <- gsub("\\.[^.]+$", "", x) + } else { + sampleName <- gsub("(.*/)", "", x) + sampleName <- gsub("\\.[^.]+$", "", sampleName) + } + # read the header + header <- readLines(con=x, n=400) + header <- header[grepl("^##", header)] + # find where headers stop and read the data + skip <- length(header) + varscanData <- suppressWarnings(data.table::fread(input=x, + stringsAsFactors=TRUE, + verbose=verbose, + skip=skip)) + # set sample if it's not already in the data table + if(any(colnames(varscanData) %in% "sample")){ + return(list("data"=varscanData, "header"=header)) + } else { + varscanData$sample <- sampleName + return(list("data"=varscanData, "header"=header)) } } - } - if (!is.null(path) & is.null(varscanData)) { - ## Read in VarScan data - varscanData <- suppressMessages(fread(input=path, stringsAsFactors=FALSE, - verbose=verbose, showProgress=FALSE)) + + # aggregate data into a single data table if necessary + if(length(varscanFiles) == 0){ + memo <- paste("No files found using:", path) + stop(memo) + } else { + # Read in the information + varscanInfo <- lapply(varscanFiles, a1, verbose) + + # extract header and data information + varscanHeader <- as.data.table(lapply(varscanInfo, function(x) x[["header"]])) + varscanData <- lapply(varscanInfo, function(x) x[["data"]]) + + # aggregate the data + varscanData <- data.table::rbindlist(varscanData, fill=TRUE) + } } - ## Add varscanType value to dataset - varscanData$varscanType <- varscanType + ## Add type value to dataset + varscanData$type <- type ## Get the sample names - sample <- varscanData[,which(colnames(varscanData)=="sample"), with=FALSE] + sample <- unique(varscanData[,which(colnames(varscanData)=="sample"), with=FALSE]) ## Check if the varscan data has the proper columns - if (varscanType=="LOH") { + if (type=="somatic loh" | type=="germline loh") { cnames <- c("chrom", "position", "ref", "var", "normal_reads1", "normal_reads2", "normal_var_freq", "normal_gt", "tumor_reads1", "tumor_reads2", "tumor_var_freq", @@ -158,26 +258,42 @@ VarScanFormat <- function(path=NULL, varscanData=NULL, varscanType="LOH", verbos "somatic_p_value", "tumor_reads1_plus", "tumor_reads1_minus", "tumor_reads2_plus", "tumor_reads2_minus", "normal_reads1_plus", "normal_reads1_minus", - "normal_reads2_plus", "normal_reads2_minus", "sample", "varscanType") - } ## Define LOH columns - if (varscanType=="CNV") { + "normal_reads2_plus", "normal_reads2_minus", "sample", "type") + } + + ## Define CNV columns + if (type=="cnv") { cnames <- c("chrom", "chr_start", "chr_stop", "normal_depth", - "tumor_depth", "log_ratio", "gc_content", "sample", "varscanType") - } ## Define CNV columns - ## Check to see if there are columns in dataset that aren't one of the defined columns - num <- which(!colnames(varscanData) %in% cnames) - ## Return an error if true - if (length(num) > 0) { - memo <- paste("The columns provided in the varscan data file do not match the expected columns.", - "refer to http://varscan.sourceforge.net/somatic-calling.html#somatic-output", - "for appropriate column names.") + "tumor_depth", "log_ratio", "gc_content", "sample", "type") + } + + `%nin%` = Negate(`%in%`) + num <- which(cnames %nin% colnames(varscanData)) + if (all(colnames(varscanData) %in% cnames) & length(num) > 0) { + memo <- paste0("All of the columns in the varscan dataset are valid and are the bare-minimum required ", + "to run the function, but the dataset is missing ", + length(num), " columns, which are normally included in varscan output. Will attempt to add missing columns and fill ", + "in values with NA.") + message(memo) + missingColumns <- cnames[num] + varscanData[,missingColumns] <- NA + } + if (!all(colnames(varscanData) %in% cnames)) { + memo <- paste0("Columns in the loh dataset are not valid. Refer to ", + "http://varscan.sourceforge.net/somatic-calling.html#somatic-output ", + "for appropriate column names.") stop(memo) } - ## If the varscan output is to visualize loh - if (varscanType == "LOH") { + ## If the varscan output is to visualize somatic loh + if (type == "somatic loh") { ## Obtain coordinates that were called as germline or LOH by varscan - varscanData <- varscanData[somatic_status=="Germline"|somatic_status=="LOH"] + varscanData <- varscanData[somatic_status=="LOH"] + + ## Check if there are any calls left + if (nrow(varscanData) == 0) { + memo <- paste0("There are no calls with somatic status: LOH.") + } ## Convert VAF percentages to VAF proportions np <- grep("%", varscanData$normal_var_freq) @@ -218,14 +334,46 @@ VarScanFormat <- function(path=NULL, varscanData=NULL, varscanType="LOH", verbos } } + ## If the varscan output is to visualize germline loh + if (type == "germline loh") { + ## Obtain coordinates that were called as germline or LOH by varscan + varscanData <- varscanData[somatic_status=="Germline"] + + ## Check if there are any calls left + if (nrow(varscanData) == 0) { + memo <- paste0("There are no calls with somatic status: Germline.") + } + + ## Convert VAF percentages to VAF proportions + np <- grep("%", varscanData$normal_var_freq) + if (length(np) > 0) { + memo <- paste("Normal VAF values appear to be percentages. Converting to proportions.") + if (verbose) { + warning(memo) + } + varscanData$normal_var_freq <- as.numeric(as.character( + gsub(pattern="%", replacement="", varscanData$normal_var_freq))) + } + + ## Check if the VAFs are out of 100, and if so, make it out of 1 + nm <- max(range(varscanData$normal_var_freq)) + if (nm > 1) { + memo <- paste("Normal VAF values appear to be out of 100. Making VAF values out of 1.") + if (verbose) { + warning(memo) + } + varscanData$normal_var_freq <- round(varscanData$normal_var_freq/100, digits=3) + } + } + ## If the varscan output is to visualize copy number data - if (varscanType == "CNV") { + if (type == "CNV") { ## TODO: Add functionality for CNV data from varscan } - ## Create the varscan object - varscanObject <- new(Class="VarScanFormat", path=path, varscan=varscanData, sample=sample) + varscanObject <- new(Class="VarScanFormat", path=path, header=varscanHeader, + varscan=varscanData, sample=sample) return(varscanObject) } @@ -249,6 +397,15 @@ setMethod(f="getPath", path <- object@path return(path) }) + +#' @rdname getHeader-methods +#' @aliases getHeader +setMethod(f="getHeader", + signature="VarScanFormat", + definition=function(object, ...){ + header <- object@header + return(header) + }) ################################################################################ @@ -261,20 +418,14 @@ setMethod(f="getPath", #' @importFrom data.table data.table setMethod(f="getLohData", signature="VarScanFormat", - definition=function(object, verbose, getHeterozygousCalls, germline, ...) { + definition=function(object, verbose, getHeterozygousLohCalls, ...) { ## Print status message if (verbose) { message("Generating LOH dataset.") } - ## Obtain loh data - primaryData <- object@varscan[somatic_status=="Germline" | somatic_status=="LOH"] - - ## Get germline data if necessary - if (germline) { - primaryData <- primaryData[somatic_status=="Germline"] - } + primaryData <- object@varscan ## Get the necessary columns from varscan output primaryData <- primaryData[,c("chrom", "position", "tumor_var_freq", @@ -284,7 +435,7 @@ setMethod(f="getLohData", colnames(primaryData) <- c("chromosome", "position", "tumor_var_freq", "normal_var_freq", "sample") - if (getHeterozygousCalls) { + if (getHeterozygousLohCalls) { ## Remove rows if necessary if (any(object@varscan$normal_var_freq<0.4 | object@varscan$normal_var_freq>0.6)) { message("Detected values with a variant allele fraction either ", @@ -309,7 +460,7 @@ setMethod(f="getLohData", #' @importFrom data.table data.table setMethod(f="getCnvData", signature="VarScanFormat", - definition=function(object, verbose, ...) { + definition=function(object, cnvType, verbose, ...) { ## Print status message if (verbose) { @@ -325,7 +476,15 @@ setMethod(f="getCnvData", "tumor_depth", "cn", "gc_content", "sample") ## Convert out of log space into absolute copy number - primaryData$cn <- (2^primaryData$cn)*2 + if (cnvType == "logratio") { + return(primaryData) + } + if (cnvType == "absolute") { + primaryData$cn <- (2^primaryData$cn)*2 + } + if (cnvType == "relative") { + primaryData$cn <- ((2^primaryData$cn)*2)-2 + } return(primaryData) diff --git a/R/VarScanFormat_Virtual-class.R b/R/VarScanFormat_Virtual-class.R index f6728ae..901b7fd 100644 --- a/R/VarScanFormat_Virtual-class.R +++ b/R/VarScanFormat_Virtual-class.R @@ -15,6 +15,7 @@ setClass( Class="VarScanFormat_Virtual", representation=representation(varscan="data.table", sample="data.table", + header="data.table", "VIRTUAL") ) diff --git a/R/combinedCnLoh-class.R b/R/combinedCnLoh-class.R index 50adf62..7064038 100644 --- a/R/combinedCnLoh-class.R +++ b/R/combinedCnLoh-class.R @@ -1,6 +1,23 @@ ################################################################################ ##################### Public/Private Class Definitions ######################### +#' Private Class cnLohPlots +#' +#' An S4 class for the cn, somatic loh, and germline loh plots +#' @rdname cnLohPlots-class +#' @name cnLohPlots +#' @slot cnPlot gtable object for the cn plot +#' @slot somaticLohPlot gtable object for the somatic loh plot +#' @slot germlineLohPlot gtable object for the germline loh plot +#' @import methods +#' @importFrom gtable gtable +#' @noRd +setClass("cnLohPlots", + representation=representation(cnLohPlot="list"), + validity=function(object) { + + }) + #!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Public Class !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!# #' Class cnLoh #' @@ -8,26 +25,20 @@ #' @name cnLoh-class #' @rdname cnLoh-class #' @slot cnData data.table object for cn plot -#' @slot cnPlot gtable object for the cn plot #' @slot somaticLohData data.table object for the somatic loh plot -#' @slot somaticLohPlot gtable object for the somatic loh plot #' @slot germlineLohData data.table object for the germline loh plot -#' @slot germlineLohData gtable object for the germline loh plot +#' @slot cnLohPlots gtable object for the combined plots #' @exportClass cnLoh #' @import methods #' @importFrom data.table data.table #' @importFrom gtable gtable methods::setOldClass("gtable") -setClass( - Class="cnLoh", - representation=representation(cnData="data.table", - cnPlot="gtable", - somaticLohData="data.table", - somaticLohPlot="gtable", - germlineLohData="data.table", - germlineLohPlot="gtable", - Grob="gtable"), - validity=function(object){ +setClass(Class="cnLoh", + representation=representation(cnData="data.table", + somaticLohData="data.table", + germlineLohData="data.table", + cnLohPlots="cnLohPlots"), + validity=function(object){ } ) @@ -36,24 +47,42 @@ setClass( #' #' @name cnLoh #' @rdname cnLoh-class -#' @param input Object of class cnLohDataFormat +#' @param cnInput Object of class cnLohDataFormat +#' @param somaticLohInput +#' @param germlineLohInput #' @param samples Character vector specifying samples to plot. If not NULL #' all samples in "input" not specified with this parameter are removed. #' @param chromosomes Character vector specifying chromosomes to plot. If not NULL #' all chromosomes in "input" not specified with this parameter are removed. +#' @param cnvType #' @param BSgenome Object of class BSgenome to extract genome wide chromosome #' coordinates +#' @param getHeterozygousLohCalls +#' @param plotAColor +#' @param plotALayers +#' @param somaticLohCutoff +#' @param plotBAlpha +#' @param plotBColors +#' @param plotBLayers +#' @param plotCLimits +#' @param plotCColors +#' @param plotCLayers +#' @param sectionHeights +#' @param verbose #' @export -cnLoh <- function(cnInput, lohInput, samples, chromosomes, BSgenome, windowSize, - step, getHeterozygousLohCalls, plotAColor, plotALayers, plotBAlpha, +cnLoh <- function(cnInput, somaticLohInput, germlineLohInput, samples, chromosomes, + cnvType, BSgenome, + getHeterozygousLohCalls, plotAColor, plotALayers, plotBAlpha, somaticLohCutoff, plotBColors, plotBLayers, plotCLimits, plotCColors, plotCLayers, sectionHeights, verbose) { ## Check each of the input parameters - cnLohInputParameters <- checkCombinedCnLohInputParameters(cnInput=cnInput, lohInput=lohInput, samples=samples, - chromosomes=chromosomes, BSgenome=BSgenome, - windowSize=windowSize, step=step, + cnLohInputParameters <- checkCombinedCnLohInputParameters(cnInput=cnInput, + somaticLohInput=somaticLohInput, + germlineLohInput=germlineLohInput, + samples=samples, chromosomes=chromosomes, + cnvType=cnvType, BSgenome=BSgenome, getHeterozygousLohCalls=getHeterozygousLohCalls, somaticLohCutoff=somaticLohCutoff, plotAColor=plotAColor, plotALayers=plotALayers, @@ -63,39 +92,35 @@ cnLoh <- function(cnInput, lohInput, samples, chromosomes, BSgenome, windowSize, sectionHeights=sectionHeights, verbose=verbose) ## Obtain cn, somatic loh, and germline loh datasets to plot - cnLohDataset <- cnLohData(cnInput=cnInput, lohInput=lohInput, - samples=checkCombinedCnLohInputParameters@samples, - chromosomes=checkCombinedCnLohInputParameters@chromosomes, - BSgenome=checkCombinedCnLohInputParameters@BSgenome, - windowSize=checkCombinedCnLohInputParameters@windowSize, - step=checkCombinedCnLohInputParameters@step, - normal=checkCombinedCnLohInputParameters@getHeterozygousLohCalls, - verbose=checkCombinedCnLohInputParameters@verbose) + cnLohDataset <- cnLohData(cnInput=cnInput, somaticLohInput=somaticLohInput, + germlineLohInput=germlineLohInput, + samples=cnLohInputParameters@samples, + chromosomes=cnLohInputParameters@chromosomes, + cnvType=cnLohInputParameters@cnvType, + BSgenome=cnLohInputParameters@BSgenome, + getHeterozygousLohCalls=cnLohInputParameters@getHeterozygousLohCalls, + verbose=cnLohInputParameters@verbose) ## Generate the cn, somatic LOH, and germline LOH plots - plots <- cnLohPlots(object=cnLohDataset, - somaticLohCutoff=checkCombinedCnLohInputParameters@somaticLohCutoff, - plotAColor=checkCombinedCnLohInputParameters@plotAColor, - plotALayers=checkCombinedCnLohInputParameters@plotALayers, - plotBAlpha=checkCombinedCnLohInputParameters@plotBAlpha, - plotBColors=checkCombinedCnLohInputParameters@plotBColors, - plotBNormalColor=checkCombinedCnLohInputParameters@plotBNormalColor, - plotBLayers=checkCombinedCnLohInputParameters@plotBLayers, - plotCLimits=checkCombinedCnLohInputParameters@plotCLimits, - plotCLowColor=checkCombinedCnLohInputParameters@plotCColors, - plotCLayers=checkCombinedCnLohInputParameters@plotCLayers, - verbose=checkCombinedCnLohInputParameters@verbose) - - ## Arrange all of the plots together - Grob <- arrangeCnLohPlots(object=plots, - sectionHeights=checkCombinedCnLohInputParameters@sectionHeights, - verbose=checkCombinedCnLohInputParameters@verbose) + plots <- cnLohPlots(object=cnLohDataset, + cnvType=cnLohInputParameters@cnvType, + somaticLohCutoff=cnLohInputParameters@somaticLohCutoff, + plotAColor=cnLohInputParameters@plotAColor, + plotALayers=cnLohInputParameters@plotALayers, + plotBAlpha=cnLohInputParameters@plotBAlpha, + plotBColors=cnLohInputParameters@plotBColors, + plotBLayers=cnLohInputParameters@plotBLayers, + plotCLimits=cnLohInputParameters@plotCLimits, + plotCColors=cnLohInputParameters@plotCColors, + plotCLayers=cnLohInputParameters@plotCLayers, + sectionHeights=cnLohInputParameters@sectionHeights, + verbose=cnLohInputParameters@verbose) ## Initialize the object - new("cnLoh", cnData=getData(cnLohDataset, index=1), cnPlot=getGrob(plots, index=1), - somaticLohData=getData(cnLohDataset, index=2), somaticLohPlot=getGrob(plots, index=2), - germlineLohData=getData(cnLohDataset, index=3), germlineLohPlot=getGrob(plots, index=3), - Grob=Grob) + new("cnLoh", cnData=getData(cnLohDataset, index=1), + somaticLohData=getData(cnLohDataset, index=2), + germlineLohData=getData(cnLohDataset, index=3), + cnLohPlots=plots) } #!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Private Classes !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!# @@ -107,13 +132,13 @@ cnLoh <- function(cnInput, lohInput, samples, chromosomes, BSgenome, windowSize, #' @noRd setClass("cnLohInputParameters", representation=representation(samples="character", - chromosomes="character", BSgenome="BSgenome", - windowSize="numeric", step="numeric", + chromosomes="character", + cnvType="character", BSgenome="BSgenome", getHeterozygousLohCalls="logical", somaticLohCutoff="numeric", plotAColor="character", plotALayers="list", plotBAlpha="numeric", plotBColors="character", - plotBLayers="list", plotClimits="numeric", + plotBLayers="list", plotCLimits="numeric", plotCColors="character", plotCLayers="list", sectionHeights="numeric", verbose="logical"), validity=function(object){ @@ -125,8 +150,8 @@ setClass("cnLohInputParameters", #' @name cnLohInputParameters #' @rdname cnLohInputParameters-class #' @noRd -checkCombinedCnLohInputParameters <- function(cnInput, lohInput, samples, chromosomes, BSgenome, - windowSize, step, getHeterozygousLohCalls, +checkCombinedCnLohInputParameters <- function(cnInput, somaticLohInput, germlineLohInput, samples, chromosomes, + cnvType, BSgenome, getHeterozygousLohCalls, somaticLohCutoff, plotAColor, plotALayers, plotBAlpha, plotBColors, plotBLayers, plotClimits, plotCColors, plotCLayers, sectionHeights, verbose) { @@ -138,10 +163,16 @@ checkCombinedCnLohInputParameters <- function(cnInput, lohInput, samples, chromo verbose <- FALSE } - ##### TODO: Check the samples parameter ##### + ##### Check the samples parameter ##### + ## Check if the samples in the somaticLohInput, germlineLohInput, and cnInput all match + cnSamples <- as.character(cnInput@sample$sample) + somaticLohSamples <- as.character(somaticLohInput@sample$sample) + germlineLohSamples <- as.character(germlineLohInput@sample$sample) + allSamples <- unique(c(cnSamples, somaticLohSamples, germlineLohSamples)) + ## Check is samples is NULL if (is.null(samples)) { - samples <- unique(object@sample$sample) + samples <- allSamples samples <- factor(samples, levels=gtools::mixedsort(samples)) memo <- paste0("Sample parameter cannot be NULL. All samples will be plotted.") message(memo) @@ -156,11 +187,11 @@ checkCombinedCnLohInputParameters <- function(cnInput, lohInput, samples, chromo ## Check if the designated samples is in the sv dataset if (!is.null(samples)) { `%nin%` = Negate(`%in%`) - discrepantSamples <- paste(samples[which(samples %nin% unique(object@sample$sample))], collapse=", ") + discrepantSamples <- paste(samples[which(samples %nin% allSamples)], collapse=", ") if (length(discrepantSamples) > 0 & discrepantSamples != "") { memo <- paste0("The desired samples: ", discrepantSamples, " are not found ", - "in the SV dataset. Available sample names include: ", - paste(unique(object@sample$sample), collapse=", "), ". ", + "in either of the cnv, somatic loh, or germline loh dataset. Available sample names include: ", + paste(allSamples, collapse=", "), ". ", "Please designate valid sample names.") stop(memo) } @@ -201,6 +232,25 @@ checkCombinedCnLohInputParameters <- function(cnInput, lohInput, samples, chromo } } + ##### Check the cnvType parameter ##### + ## Check if cnvType is not null + if (is.null(cnvType)){ + memo <- paste0("the cnvType parameter cannot be null. Using absolute copy number values.") + cnvType <- "absolute" + message(memo) + } + ## Check if cnvType is a character + if (!is.character(cnvType)) { + memo <- paste0("cnvType paramter not of class character. Attempting to coerce...") + message(memo) + cnvType <- as.character(cnvType) + } + ## Check if cnvType has a valid value + if (!(cnvType %in% c("logratio", "absolute", "relative"))) { + memo <- paste0("cnvType parameter is not a valid value. Valid values include: ", + "logration, absolute, and relative. Using absolute copy number values.") + } + ##### Check the BSgenome parameter ##### ## Check to see if BSgenome is a BSgenome if (is.null(BSgenome)) { @@ -218,41 +268,6 @@ checkCombinedCnLohInputParameters <- function(cnInput, lohInput, samples, chromo BSgenome <- NULL } - ##### Check the windowSize parameter ##### - if (is.null(windowSize)) { - windowSize <- 2500000 - memo <- paste0("windowSize parameter cannot be NULL. Setting the windowSize value to 2500000.") - message(memo) - } - ## Check if windowSize is numeric - if (!is.numeric(windowSize)) { - memo <- paste0("windowSize variable not of the numeric class. Attempting to coerce.") - windowSize <- as.numeric(windowSize) - message(memo) - } - - ##### Check the step parameter ##### - if (is.null(step)) { - step <- 1000000 - memo <- paste0("step parameter cannot be NULL. Setting the step value to 1000000.") - message(memo) - } - ## Check if step is numeric - if (!is.numeric(step)) { - memo <- paste0("step variable not of the numeric class. Attempting to coerce.") - step <- as.numeric(step) - message(memo) - } - ## Check to see if step is greater than windowSize - if (step > windowSize) { - memo <- paste("Step value is greater than windowSize. Make sure that the step value is - at most equal to the WindowSize. Using default values for both parameters.") - warning(memo) - step <- 1000000 - windowSize <- 2500000 - - } - ##### Check the getHeterozygousLohCalls ##### if (!is.logical(getHeterozygousLohCalls) | is.null(getHeterozygousLohCalls)) { memo <- paste0("The getHeterozygousLohCalls parameter is not a boolean (T/F). ", @@ -447,10 +462,10 @@ checkCombinedCnLohInputParameters <- function(cnInput, lohInput, samples, chromo } new("cnLohInputParameters", samples=samples, chromosomes=chromosomes, BSgenome=BSgenome, - windowSize=windowSize, step=step, getHeterozygousLohCalls=getHeterozygousLohCalls, + cnvType=cnvType, getHeterozygousLohCalls=getHeterozygousLohCalls, somaticLohCutoff=somaticLohCutoff, plotAColor=plotAColor, plotALayers=plotALayers, plotBAlpha=plotBAlpha, plotBColors=plotBColors, plotBLayers=plotBLayers, - plotClimits=plotCLimits, plotCColors=plotCColors, plotCLayers=plotCLayers, + plotCLimits=plotCLimits, plotCColors=plotCColors, plotCLayers=plotCLayers, sectionHeights=sectionHeights, verbose=verbose) } @@ -475,13 +490,13 @@ setClass("cnLohData", #' @name cnLohData #' @rdname cnLohData-class #' @param object Object of class cnLohDataFormat -cnLohData <- function(cnInput, lohInput, samples, chromosomes, BSgenome, - windowSize, step, normal, verbose=FALSE) { +cnLohData <- function(cnInput, somaticLohInput, germlineLohInput, samples, + getHeterozygousLohCalls, chromosomes, cnvType, BSgenome, verbose) { ############################################################################ #################### Prepare copy number variant dataset ################### ## Obtain raw cnv data - cnData <- getCnvData(object=cnInput, verbose=verbose) + cnData <- getCnvData(object=cnInput, cnvType=cnvType, verbose=verbose) ## Subset copy number data by chromosome cnData <- chrSubset(object=cnData, chromosomes=chromosomes, verbose=verbose) @@ -501,7 +516,7 @@ cnLohData <- function(cnInput, lohInput, samples, chromosomes, BSgenome, ############################################################################ ##################### Prepare somatic loh dataset ########################## ## Obtain LOH data for desired chromosomes and samples - lohData <- getLohData(object=lohInput, verbose=verbose, lohSpec=TRUE, germline=FALSE) + lohData <- getLohData(object=somaticLohInput, verbose=verbose, getHeterozygousLohCalls=TRUE) ## Subset loh data by chromosome lohData <- chrSubset(object=lohData, chromosomes=chromosomes, verbose=verbose) @@ -509,20 +524,8 @@ cnLohData <- function(cnInput, lohInput, samples, chromosomes, BSgenome, ## Subset loh data by sample lohData <- sampleSubset(object=lohData, samples=samples, verbose=verbose) - ## Produce data.table with window position data - windowData <- getLohSlidingWindow(object=lohData, step=step, windowSize=windowSize, - verbose=verbose) - - ## Perform loh calculations on each chromosome and samples within each window - lohAbsDiff <- getLohCalculation(object=lohData, windowData=windowData, normal=normal, - verbose=verbose) - - ## Calculate avg loh for overlapping regions - lohAbsDiffOverlap <- rbindlist(getLohStepCalculation(object=lohAbsDiff, - step=step, verbose=verbose)) - ## Obtain loh segmentation dataset - lohSegmentation <- getLohSegmentation(object=lohAbsDiffOverlap, verbose=verbose) + lohSegmentation <- getLohSegmentation(object=lohData, verbose=verbose) ## Remove gaps lohSegmentation <- removeGapsSegmentation(object=lohSegmentation, chrData=chrData, @@ -531,7 +534,7 @@ cnLohData <- function(cnInput, lohInput, samples, chromosomes, BSgenome, ############################################################################ ##################### Prepare germline loh dataset ######################### ## Obtain germlineloh data by chromosome - germlineLohData <- getLohData(object=lohInput, verbose=TRUE, lohSpec=FALSE, germline=TRUE) + germlineLohData <- getLohData(object=germlineLohInput, verbose=verbose, getHeterozygousLohCalls=FALSE) ## Subset loh data by chromosome germlineLohData <- chrSubset(object=germlineLohData, chromosomes=chromosomes, verbose=verbose) @@ -545,25 +548,6 @@ cnLohData <- function(cnInput, lohInput, samples, chromosomes, BSgenome, chrData=chrData) } -#' Private Class cnLohPlots -#' -#' An S4 class for the cn, somatic loh, and germline loh plots -#' @rdname cnLohPlots-class -#' @name cnLohPlots -#' @slot cnPlot gtable object for the cn plot -#' @slot somaticLohPlot gtable object for the somatic loh plot -#' @slot germlineLohPlot gtable object for the germline loh plot -#' @import methods -#' @importFrom gtable gtable -#' @noRd -setClass("cnLohPlots", - representation=representation(cnPlot="gtable", - somaticLohPlot="gtable", - germlineLohPlot="gtable"), - validity=function(object) { - - }) - #' Constructor for cnLohPlots class #' #' @rdname cnLohPlots-class @@ -572,29 +556,19 @@ setClass("cnLohPlots", #' @importFrom gtable gtable #' @import ggplot2 #' @noRd -cnLohPlots <- function(object, plotAColor, plotALayers, - somaticLohCutoff, plotBAlpha, plotBTumorColor, plotBNormalColor, plotBLayers, - plotCLimits, plotCLowColor, plotCHighColor, - plotCLayers, verbose) { +cnLohPlots <- function(object, cnvType, plotAColor, plotALayers, + somaticLohCutoff, plotBAlpha, plotBColors, plotBLayers, + plotCLimits, plotCColors, plotCLayers, sectionHeights, verbose) { ## Build the cn plot - cnPlot <- buildCnPlot(object=object, plotAColor=plotAColor, plotALayers) - - ## Build the somatic loh plot - somaticLohPlot <- buildSomaticLohPlot(object=object, somaticLohCutoff=somaticLohCutoff, - plotBAlpha=plotBAlpha, - plotBTumorColor=plotBTumorColor, - plotBNormalColor=plotBNormalColor, - plotBLayers=plotBLayers, verbose=verbose) - - ## Build the germline loh plot - germlineLohPlot <- buildGermlineLohPlot(object=object, - plotCLimits=plotCLimits, plotCLowColor=plotCLowColor, - plotCHighColor=plotCHighColor, plotCLayers=plotCLayers, - verbose=verbose) + cnLohPlot <- buildCnLohPlot(object=object, cnvType=cnvType, plotAColor=plotAColor, plotALayers=plotALayers, + plotBAlpha=plotBAlpha, plotBColors=plotBColors, plotBLayers=plotBLayers, + somaticLohCutoff=somaticLohCutoff, plotCLimits=plotCLimits, + plotCColors=plotCColors, plotCLayers=plotCLayers, + sectionHeights=sectionHeights, verbose=verbose) ## Initialize the object - new("cnLohPlots", cnPlot=cnPlot, somaticLohPlot=somaticLohPlot, germlineLohPlot=germlineLohPlot) + new("cnLohPlots", cnLohPlot=cnLohPlot) } ################################################################################ @@ -695,8 +669,25 @@ setMethod(f="getGrob", setMethod( f="drawPlot", signature="cnLoh", - definition=function(object, ...){ - mainPlot <- getGrob(object, index=4) + definition=function(object, chr=NULL, sample=NULL, ...){ + ## Get the list of gtables + object <- object@cnLohPlots@cnLohPlot + + ## Get the chromosome-sample combinations + name <- paste0(chr, "_", sample) + + ## See if the desired chr-sample combo can be found in the plots + num <- which(names(object) == name) + if (length(num) == 0) { + memo <- paste0("The plot for the chromosome-sample combination: ", + name, " could not be found. Make sure to append the chr name ", + "with ", dQuote("chr"), " rather than just using the chromosome number (chr1 instead of 1). ", + "The possible combinations that could be used are: ", + paste(names(object), collapse=", ")) + stop(memo) + } + + mainPlot <- object[[num]] grid::grid.newpage() grid::grid.draw(mainPlot) } @@ -832,13 +823,16 @@ setMethod(f="getCnSegmentation", message("Segmenting copy number data") } + ## Get the sample-chr combination + object$sample_chr_combo <- paste0(object$chromosome, "_", object$sample) + ## Split object by sample - segDfTemp <- split(object, list(as.character(object$sample))) + segDfTemp <- split(object, f=object$sample_chr_combo) ## Perform segmentation segmentationDF <- rbindlist(lapply(segDfTemp, function(x) { cnSeg <- CNA(genomdat=as.numeric(x$cn), chrom=x$chromosome, - maploc=x$position, data.type="logratio", sampleid = unique(x$sample)) + maploc=x$position, data.type="logratio", sampleid = unique(x$sample_chr_combo)) ## Run CBS cnSeg <- segment(cnSeg, min.width=3, undo.splits="sdundo", @@ -846,7 +840,6 @@ setMethod(f="getCnSegmentation", cnSeg <- cnSeg$output return(cnSeg) })) - return(segmentationDF) }) @@ -867,9 +860,8 @@ setMethod(f="removeGapsSegmentation", } ## Get the list of the chromosomes - chrList <- as.list(as.character(unique(object$chrom))) - segs <- rbindlist(lapply(chrList, function(x, object, chrData) { - df <- object[chrom==x] + splitDf <- split(object, f=object$ID) + segs <- rbindlist(lapply(splitDf, function(df) { for (i in 1:(nrow(df) - 1)) { ## Don't merge segments if they are far apart if ((df$loc.start[i+1]-df$loc.end[i]) < 5000000) { @@ -879,7 +871,7 @@ setMethod(f="removeGapsSegmentation", } } return(df) - }, object=object)) + })) return(segs) }) @@ -945,184 +937,6 @@ setMethod(f="annoGenomeCoord", }) -########################################################################## -##### Function to generate window position data for loh calculations ##### -#' @rdname getLohSlidingWindow-methods -#' @name getLohSlidingWindow -#' @param object of class data.table -#' @param step integer specifying the step size between the start position of -#' each window -#' @param windowSize integer specifying the window size for loh calcuations -#' @return Data.table with window start/stop positions -#' @aliases getLohSlidingWindow -setMethod(f="getLohSlidingWindow", - signature="data.table", - definition=function(object, step, windowSize, ...){ - if (verbose) { - message("Calcuating window sizes for loh calcluations on all chromosomes in each individual sample") - } - - ## Obtain lists for each sample and chromosome - out <- split(object, list(as.character(object$chromosome), - as.character(object$sample))) - - ## Obtain the window position values - window <- lapply(out, function(x, step, windowSize) { - ## Get the min and max position on the chromosome - min <- integer() - max <- integer() - window_stop_1 <- integer() - window_num <- integer() - min <- as.integer(min(as.numeric(as.character(x$position)))) - max <- as.integer(max(as.numeric(as.character(x$position)))) - ## Get the end of the first window position - window_stop_1 <- min+windowSize - ## Calculate the number of windows necessary - num <- as.integer((max-min)/step) - num <- as.vector(1:num) - window_data_start <- vector() - window_data_stop <- vector() - - ## Calculate exact window positions - window_data <- lapply(num, function(x){ - window_data_start[x] <- as.integer(min+(step*(x-1))) - window_data_stop[x] <- as.integer(window_stop_1+(step*(x-1))) - window_data <- data.table(cbind(window_data_start[x], window_data_stop[x])) - return(window_data) - }) - window_data <- rbindlist(window_data) - # Get window positions whose values are below max & set max as the - # final window position (end of the chromosome) - colnames(window_data) <- c("window_start", "window_stop") - window_final <- window_data[window_data$window_stop <= max,] - window_final[nrow(window_final), 2] <- max - ## Put in the chromosome - window_final$chromosome <- as.character(x$chromosome[1]) - return(window_final) - }, - step = step, windowSize = windowSize) - - return(window) - }) - -############################################################### -##### Function to perform loh calcluations in each window ##### -#' @rdname getLohCalculation-methods -#' @name getLohCalculation -#' @param object of class data.table -#' @param window_data of class data.table -#' @param normal integer specifying normal vaf -#' @aliases getLohCalculation -setMethod(f="getLohCalculation", - signature="data.table", - definition=function(object, windowData, normal, verbose, ...) { - - ## Print status message - if (verbose) { - message("Calculating absolute mean difference between t/n VAF at each coordinate provided.") - } - - ## Split object for each unqiuq sample-chr combination - object <- split(object, list(as.character(object$chromosome), - as.character(object$sample))) - - ## Separate out sample and window data by chromosome name - df <- lapply(object, function(sampleData, window, - normal) { - chromosome <- as.character(sampleData[1,chromosome]) - sample <- as.character(sampleData[1,sample]) - chromosome.sample <- paste("\\b", paste(chromosome, sample, sep = "."), "\\b", sep = "") - window <- windowData[[grep(chromosome.sample, names(windowData))]] - ## For each window position, get the vaf data that falls - ## within that window - dataset <- rbindlist(apply(window, 1, function(x, sampleData, normal){ - ## Determine which value to use for normal - if (normal==FALSE) { - normal <- 0.5 - } - if (normal == TRUE) { - normal <- round(sampleData[,mean(normal_var_freq)], - digits=3) - } - - w_start <- as.numeric(as.character(x[1])) - w_stop <- as.numeric(as.character(x[2])) - ## Filter out vaf data outside the window - filtered_data <- sampleData[position >= w_start & - position <= w_stop] - - ## Peroform loh calclulation to obtain avg loh in the - ## window's frame - loh_calc_avg <- mean(abs(as.numeric(as.character( - filtered_data$tumor_var_freq)) - normal)) - ## If no coordinates are found within the window, - ## make as NA - if (is.na(loh_calc_avg)) { - loh_calc_avg <- NA - w_start <- NA - w_stop <- NA - } - filtered_data$loh_diff_avg <- loh_calc_avg - filtered_data$window_start <- w_start - filtered_data$window_stop <- w_stop - return(filtered_data) - }, - sampleData=sampleData, normal=normal)) - dataset <- na.omit(dataset, cols = c("loh_diff_avg", - "window_start", - "window_stop")) - return(dataset) - }, window=windowData, normal=normal) - return(df) - }) - -####################################################################### -##### Function to perform loh calcluations in overlapping windows ##### -#' @rdname getLohStepCalculation-methods -#' @name getLohStepCalculation -#' @param object of class data.table -#' @param step integer -#' @aliases getLohStepCalculation -setMethod(f = "getLohStepCalculation", - signature="list", - definition=function(object, step, ...) { - - ## Print status message - if (verbose) { - message("Calculating loh in overlapping windows") - } - step_loh_calc <- lapply(object, function(x, step) { - ## Get the sample and chromosome information - sample <- unique(x$sample) - chromosome <- unique(x$chromosome) - - ## Obtain boundaries for each step-sized window - start <- unique(x$window_start) - stop <- c(start[-1], max(x$window_stop)) - step_boundaries <- data.table(chromosome=chromosome, start=start, stop=stop) - step_boundaries$sample <- sample - - ## Get the average loh within each step-sized window - loh_df <- x - loh_step_avg <- apply(step_boundaries, 1, function(x, loh_df_data) { - start <- as.numeric(as.character(x[2])) - stop <- as.numeric(as.character(x[3])) - step_df <- loh_df_data[position >= start & - position < stop] - if (nrow(step_df) == 0) { - loh_step_avg <- 0 - } - if (nrow(step_df) > 0) { - loh_step_avg <- mean(step_df$loh_diff_avg) - } - return(loh_step_avg) - }, loh_df_data=loh_df) - step_boundaries$loh_step_avg <- loh_step_avg - return(step_boundaries) - }, step=step) - return(step_loh_calc) - }) - ############################################################# ##### Function to generate segmentation dataset for loh ##### #' @rdname getLohSegmentation-methods @@ -1138,11 +952,17 @@ setMethod(f = "getLohSegmentation", if (verbose) { message("Determining segmeans from LOH calculations") } - segDfTemp <- split(object, list(as.character(object$sample))) + + ## Get the sample-chr combination + object$sample_chr_combo <- paste0(object$chromosome, "_", object$sample) + + ## Get the absolute loh difference + object$absDiff <- abs(as.numeric(as.character(object$tumor_var_freq)) - 0.50) + segDfTemp <- split(object, list(as.character(object$sample_chr_combo))) segmentationDf <- rbindlist(lapply(segDfTemp, function(x){ - x$midpoint <- floor((as.numeric(x$start) + as.numeric(x$stop))/2) - lohSeg <- CNA(genomdat = as.numeric(x$loh_step_avg), chrom = x$chromosome, - maploc = x$midpoint, data.type = "binary", sampleid = unique(x$sample)) + x$midpoint <- x$position + lohSeg <- CNA(genomdat = as.numeric(x$absDiff), chrom = x$chromosome, + maploc = x$midpoint, data.type = "binary", sampleid = unique(x$sample_chr_combo)) lohSeg <- segment(lohSeg) lohSeg <- lohSeg$output return(lohSeg) @@ -1153,231 +973,225 @@ setMethod(f = "getLohSegmentation", ######################################## ##### Function to generate cn plot ##### -#' @rdname buildCnPlot-methods -#' @name buildCnPlot -#' @aliases buildCnPlot +#' @rdname buildCnLohPlot-methods +#' @name buildCnLohPlot +#' @aliases buildCnLohPlot #' @param object of class data.table #' @noRd -setMethod(f="buildCnPlot", +setMethod(f="buildCnLohPlot", signature="cnLohData", - definition=function(object, plotAColor, plotALayers, ...){ + definition=function(object, cnvType, plotAColor, plotALayers, + plotBAlpha, plotBColors, plotBLayers, + somaticLohCutoff, plotCLimits, plotCColors, + plotCLayers, sectionHeights, verbose){ ## Print status message if (verbose) { message("Building cnv plot") } - - ## Perform quality checks on the input variables - if(!is.null(plotALayers)){ - if(!is.list(plotALayers)){ - memo <- paste("plotALayers is not a list") - stop(memo) - } - - if(any(!unlist(lapply(plotALayers, function(x) ggplot2::is.ggproto(x) | ggplot2::is.theme(x) | is(x, "labels"))))){ - memo <- paste("plotALayers is not a list of ggproto or ", - "theme objects... setting plotALayers to NULL") - warning(memo) - plotALayers <- NULL - } - } - - ## Separate datasets + object=cnLohDataset + ## Get the cn data (segments and raw data) rawCnData <- object@rawCnData + rawCnData$chr_sample_combo <- paste0(rawCnData$chromosome, "_", rawCnData$sample) segCnData <- object@segCnData - ## Define parameters of the plot - plotTheme <- theme(axis.ticks.x=element_blank(), - axis.text.x=element_blank(), - axis.ticks.y=element_blank(), - panel.grid.major=element_blank(), - panel.grid.minor=element_blank(), - legend.position="none") - - ## Create hline data for cn plot - hline.dat <- data.table(chromosome=segCnData$chrom, - x=segCnData$loc.start, - xend=segCnData$loc.end, - y=segCnData$seg.mean, - yend=segCnData$seg.mean) - - ## Define the hline plot - hline <- geom_hline(yintercept = 2, lty=2) - segHLines <- geom_segment(data=hline.dat, aes(x=x, xend=xend, y=y, yend=yend), lty=1, col="red", size = 2) - - ## Define the facet - facet <- facet_grid(sample~chromosome, scale="free_x", space="fixed") - - ## Define the scales - scale_x <- scale_x_continuous(name="Position", expand=c(0,0)) - scale_y <- scale_y_continuous(name="Absolute Copy Number") - - ## Build the plot - p1 <- ggplot(data=rawCnData, aes(x=position,y=cn)) + - geom_point(color=plotAColor) + facet + hline + segHLines + - scale_x + scale_y + plotALayers - - ## Convert to grob - cnPlotGrob <- ggplotGrob(p1) - plot(cnPlotGrob) - return(cnPlotGrob) - }) - -################################################# -##### Function to generate somatic loh plot ##### -#' @rdname buildSomaticLohPlot-methods -#' @name buildSomaticLohPlot -#' @aliases buildSomaticLohPlot -#' @param object of class data.table -#' @noRd -setMethod(f="buildSomaticLohPlot", - signature="cnLohData", - definition=function(object, somaticLohCutoff, plotBAlpha, plotBTumorColor, plotBNormalColor, - plotBLayers, ...){ - - ## Print status message - if (verbose) { - message("Building somatic loh plot") - } - - ## Separate datasets + ## Get the somatic loh data (segments and raw data) + rawLohData <- object@rawLohData + rawLohData$chr_sample_combo <- paste0(rawLohData$chromosome, "_", rawLohData$sample) segLohData <- object@segLohData segLohData <- segLohData[seg.mean > somaticLohCutoff] - rawLohData <- object@rawLohData - - ## Prepare loh data to be plotted - normalDf <- rawLohData[,c(1,2,4,5)] - colnames(normalDf) <- c("chromosome", "position", "VAF", "sample") - normalDf$Type <- "Normal" - tumorDf <- rawLohData[,c(1,2,3,5)] - colnames(tumorDf) <- c("chromosome", "position", "VAF", "sample") - tumorDf$Type <- "Tumor" - rawLohData <- rbind(normalDf, tumorDf) - - ## Define parameters of the plot - plotTheme <- theme(axis.ticks.x=element_blank(), - axis.text.x=element_blank(), - axis.ticks.y=element_blank(), - panel.grid.major=element_blank(), - panel.grid.minor=element_blank(), - legend.position="none") - - ## Create hline data for cn plot - hline.dat <- data.table(chromosome=segLohData$chrom, - x=segLohData$loc.start, - xend=segLohData$loc.end, - y=0.5+segLohData$seg.mean, - yend=0.5+segLohData$seg.mean) - ## Define the hline plot - h1 <- geom_hline(yintercept = 0.4, lty=2) - h2 <- geom_hline(yintercept = 0.6, lty=2) - segHLines <- geom_segment(data=hline.dat, aes(x=x, xend=xend, y=y, yend=yend), lty=1, col="red", size = 2) + ## Get the germline loh data (segments and raw data) + rawGermlineLohData <- object@rawGermlineLohData + rawGermlineLohData$chr_sample_combo <- paste0(rawGermlineLohData$chromosome, "_", rawGermlineLohData$sample) - ## Define the facet - facet <- facet_grid(sample~chromosome, scale="free_x", space="fixed") - - ## Define the scale - scale_x <- scale_x_continuous(name="Position", expand=c(0,0)) - scale_y <- scale_y_continuous(name="VAF", limits=c(0,1)) - - ## Define the colors - color <- scale_color_manual(values=c(plotBNormalColor, plotBTumorColor)) - - ## Build the plot - p1 <- ggplot(data=rawLohData, aes(x=position,y=VAF, col=Type)) + - geom_point(alpha=plotBAlpha) + facet + h1 + h2 + segHLines + - scale_x + scale_y + color + plotBLayers - - ## Convert to grob - somaticLohPlotGrob <- ggplotGrob(p1) - plot(somaticLohPlotGrob) - return(somaticLohPlotGrob) - }) - -################################################## -##### Function to generate germline loh plot ##### -#' @rdname buildGermlineLohPlot-methods -#' @name buildGermlineLohPlot -#' @aliases buildGermlineLohPlot -#' @param object of class data.table -#' @noRd -setMethod(f="buildGermlineLohPlot", - signature="cnLohData", - definition=function(object, plotCLimits, plotCLowColor, - plotCHighColor, plotCLayers, verbose=verbose){ - - ## Print status message - if (verbose) { - message("Building germline loh plot") - } - - ## Separate datasets - germlineLohData <- object@rawGermlineLohData + ## Get the chromosome and sample data chrData <- object@chrData - - ## Define parameters of the plot - plotTheme <- theme(panel.grid.major=element_blank(), - panel.grid.minor=element_blank()) - - - ## Define the facet - facet <- facet_grid(sample~chromosome, scale="free_x", space="fixed") - - ## Define the scale - scale_x <- scale_x_continuous(name="Position", expand=c(0,0)) - scale_y <- scale_y_continuous(name="Normal VAF", breaks = c(0, 0.25, 0.5, 0.75, 1.0)) - - ## Define the gradient - gradient <- scale_fill_gradient2(low=plotCLowColor, high=plotCHighColor, - limits=plotCLimits, oob=squish, trans="sqrt") - - ## Build the plot - p1 <- ggplot(data=germlineLohData, aes(x=position,y=normal_var_freq)) + - geom_hex(binwidth=c((chrData$end[1]*.025/4),0.025)) + facet + gradient + scale_x + scale_y + - plotTheme + plotCLayers - - ## Convert to grob - germlineLohPlot <- ggplotGrob(p1) - plot(germlineLohPlot) - return(germlineLohPlot) - - }) + samples <- unique(c(as.character(unique(rawCnData$sample)), + as.character(unique(rawLohData$sample)), + as.character(unique(rawGermlineLohData$sample)))) + sample_chr_combo <- data.table(chr_sample_combo=as.vector(outer(chrData$chromosome, samples, paste, sep="_"))) + + ## Split the dataset by chr_sample_combo + splitDf <- split(sample_chr_combo, f=sample_chr_combo$chr_sample_combo) + + ## Generate combined cn/somatic loh/ germline loh plots + #x <- splitDf[[8]]$chr_sample_combo + combinedPlots <- lapply(splitDf, function(x, chrData, cnvType, plotAColor, plotALayers, + plotBAlpha, plotBColors, plotBLayers, + somaticLohCutoff, plotCLimits, plotCColors, + plotCLayers, sectionHeights, verbose){ + ## Print status message + if (verbose) { + memo <- paste0("Generating combined cn/somatic loh/ germline loh plots") + message(memo) + } + + ## Subset out the datasets to chr and sample of interest + cnData <- rawCnData[chr_sample_combo==x] + cnSeg <- segCnData[ID==x] + somaticLohData <- rawLohData[chr_sample_combo==x] + lohSeg <- segLohData[ID==x] + germlineLohData <- rawGermlineLohData[chr_sample_combo==x] + + ## Get the chromosome of interest + chr <- strsplit(as.character(x), split="_")[[1]][1] + chr <- chrData[chromosome==chr] + + ############################################################## + ##### Build the copy number variation plot ################### + ############################################################## + ## Define parameters of the plot + plotTheme <- theme(axis.ticks.x=element_blank(), + axis.text.x=element_blank(), + axis.ticks.y=element_blank(), + panel.grid.major=element_blank(), + panel.grid.minor=element_blank(), + legend.position="none") + + ## Create hline data for cn plot + hline.dat <- data.table(chromosome=cnSeg$chrom, + x=cnSeg$loc.start, + xend=cnSeg$loc.end, + y=cnSeg$seg.mean, + yend=cnSeg$seg.mean) + + ## Define the hline plot + if (cnvType=="absolute" | cnvType == "logratio") { + hline <- geom_hline(yintercept = 2, lty=2) + } + if (cnvType == "relative") { + hline <- geom_hline(yintercept = 0, lty=2) + } + segHLines <- geom_segment(data=hline.dat, aes(x=x, xend=xend, y=y, yend=yend), lty=1, col="red", size = 2) + + ## Define the facet + facet <- facet_grid(sample~chromosome, scale="free_x", space="fixed") + + ## Define the scales + scale_x <- scale_x_continuous(name="Position", expand=c(0,0), limits=c(chr$start, chr$end)) + scale_y <- scale_y_continuous(name=paste0(cnvType, " Copy Number")) + + ## Build the plot + p1 <- ggplot(data=cnData, aes(x=position,y=cn)) + + geom_point(color=plotAColor) + facet + hline + segHLines + + scale_x + scale_y + plotALayers + + ############################################################## + ##### Build the somatic LOH plot ############################# + ############################################################## + ## Print status message + if (verbose) { + message("Building somatic loh plot") + } + + ## Prepare somatic loh data to be plotted + normalDf <- somaticLohData[,c(1,2,4,5)] + colnames(normalDf) <- c("chromosome", "position", "VAF", "sample") + normalDf$Type <- "Normal" + tumorDf <- somaticLohData[,c(1,2,3,5)] + colnames(tumorDf) <- c("chromosome", "position", "VAF", "sample") + tumorDf$Type <- "Tumor" + allLohData <- rbind(normalDf, tumorDf) + + ## Define parameters of the plot + plotTheme <- theme(axis.ticks.x=element_blank(), + axis.text.x=element_blank(), + axis.ticks.y=element_blank(), + panel.grid.major=element_blank(), + panel.grid.minor=element_blank(), + legend.position="none") + + ## Create hline data for cn plot + hline.dat <- data.table(chromosome=lohSeg$chrom, + x=lohSeg$loc.start, + xend=lohSeg$loc.end, + y=0.5+lohSeg$seg.mean, + yend=0.5+lohSeg$seg.mean) + + ## Define the hline plot + h1 <- geom_hline(yintercept = 0.4, lty=2) + h2 <- geom_hline(yintercept = 0.6, lty=2) + segHLines <- geom_segment(data=hline.dat, aes(x=x, xend=xend, y=y, yend=yend), lty=1, col="red", size = 2) + + ## Define the facet + facet <- facet_grid(sample~chromosome, scale="free_x", space="fixed") + + ## Define the scale + scale_x <- scale_x_continuous(name="Position", expand=c(0,0), limits=c(chr$start, chr$end)) + scale_y <- scale_y_continuous(name="VAF", limits=c(0,1)) + + ## Define the colors + color <- scale_color_manual(values=plotBColors) + + ## Build the plot + p2 <- ggplot(data=allLohData, aes(x=position,y=VAF, col=Type)) + + geom_point(alpha=plotBAlpha) + facet + h1 + h2 + segHLines + + scale_x + scale_y + color + plotBLayers -######################################################### -##### Function to arrange lohSpec and lohFreq plots ##### -#' @rdname arrangeCnLohPlots-methods -#' @name arrangeCnLohPlots -#' @param object of class cnLohData -#' @aliases arrangeCnLohPlots -#' @noRd -setMethod(f="arrangeCnLohPlots", - signature="cnLohPlots", - definition=function(object, sectionHeights, verbose, ...) { - - ## Print status message - if (verbose) { - message("Combining cn, somatic loh, and germline loh plots") - } - - ## Grab the data we need - plotA <- object@cnPlot - plotB <- object@somaticLohPlot - plotC <- object@germlineLohPlot - - ## obtain the meax width for relevant plots - plotList <- list(plotA, plotB, plotC) - plotList <- plotList[lapply(plotList, length) > 0] - plotWidths <- lapply(plotList, function(x) x$widths) - maxWidth <- do.call(grid::unit.pmax, plotWidths) - - ## Set the widths for all plots - for (i in 1:length(plotList)) { - plotList[[i]]$widths <- maxWidth - } + ############################################################## + ##### Build the germline LOH plot ############################ + ############################################################## + ## Print status message + if (verbose) { + message("Building germline loh plot") + } + + ## Define parameters of the plot + plotTheme <- theme(panel.grid.major=element_blank(), + panel.grid.minor=element_blank()) + + + ## Define the facet + facet <- facet_grid(sample~chromosome, scale="free_x", space="fixed") + + ## Define the scale + scale_x <- scale_x_continuous(name="Position", expand=c(0,0), limits=c(chr$start, chr$end)) + scale_y <- scale_y_continuous(name="Normal VAF", breaks = c(0, 0.25, 0.5, 0.75, 1.0)) + + ## Define the gradient + gradient <- scale_fill_gradient2(low=plotCColors[1], high=plotCColors[2], + limits=c(0, plotCLimits), oob=squish, trans="sqrt") + + ## Build the plot + p3 <- ggplot(data=germlineLohData, aes(x=position,y=normal_var_freq)) + + geom_hex(binwidth=c((chr$end*.025/4),0.025)) + facet + gradient + scale_x + scale_y + + plotTheme + plotCLayers + + + ############################################################## + ##### Combine all of the plots into 1 plot ################### + ############################################################## + ## Print status message + if (verbose) { + message("Combining cn, somatic loh, and germline loh plots") + } + + ## Obtain the max width for relevant plots + cnPlot <- ggplotGrob(p1) + somaticLohPlot <- ggplotGrob(p2) + germlineLohPlot <- ggplotGrob(p3) + plotList <- list(cnPlot, somaticLohPlot, germlineLohPlot) + + plotList <- plotList[lapply(plotList, length) > 0] + plotWidths <- lapply(plotList, function(x) x$widths) + maxWidth <- do.call(grid::unit.pmax, plotWidths) + + ## Set the widths for all plots + for (i in 1:length(plotList)) { + plotList[[i]]$widths <- maxWidth + } + + ## Arrange the final plot + finalPlot <- do.call(gridExtra::arrangeGrob, c(plotList, list(ncol=1, heights=sectionHeights))) + plot(finalPlot) + return(finalPlot) + }, + chrData=chrData, cnvType=cnvType, plotAColor=plotAColor, plotALayers=plotALayers, + plotBAlpha=plotBAlpha, plotBColors=plotBColors, plotBLayers=plotBLayers, + somaticLohCutoff=somaticLohCutoff, plotCLimits=plotCLimits, + plotCColors=plotCColors, plotCLayers=plotCLayers, sectionHeights=sectionHeights, + verbose=verbose) - ## Arrange the final plot - finalPlot <- do.call(gridExtra::arrangeGrob, c(plotList, list(ncol=1, heights=sectionHeights))) - plot(finalPlot) - return(finalPlot) - }) \ No newline at end of file + return(combinedPlots) + }) diff --git a/R/lohSpec-class.R b/R/lohSpec-class.R index 9707700..f721eb0 100644 --- a/R/lohSpec-class.R +++ b/R/lohSpec-class.R @@ -236,6 +236,19 @@ checkLohInputParameters <- function(object, getHeterozygousCalls, chromosomes, s stop(memo) BSgenome <- NULL } + ##### Check the windowSize parameter ##### + if (is.null(windowSize)) { + windowSize <- 2500000 + memo <- paste0("windowSize parameter cannot be NULL. Setting the windowSize value to 2500000.") + message(memo) + } + ## Check if windowSize is numeric + if (!is.numeric(windowSize)) { + memo <- paste0("windowSize variable not of the numeric class. Attempting to coerce.") + windowSize <- as.numeric(windowSize) + message(memo) + } + ##### Check the step parameter ##### if (is.null(step)) { step <- 1000000 @@ -248,18 +261,14 @@ checkLohInputParameters <- function(object, getHeterozygousCalls, chromosomes, s step <- as.numeric(step) message(memo) } - - ##### Check the windowSize parameter ##### - if (is.null(windowSize)) { + ## Check to see if step is greater than windowSize + if (step > windowSize) { + memo <- paste("Step value is greater than windowSize. Make sure that the step value is + at most equal to the WindowSize. Using default values for both parameters.") + warning(memo) + step <- 1000000 windowSize <- 2500000 - memo <- paste0("windowSize parameter cannot be NULL. Setting the windowSize value to 2500000.") - message(memo) - } - ## Check if windowSize is numeric - if (!is.numeric(windowSize)) { - memo <- paste0("windowSize variable not of the numeric class. Attempting to coerce.") - windowSize <- as.numeric(windowSize) - message(memo) + } ##### Check the normalVAF parameter #####