GenomicAlignments/DESCRIPTION0000644000175100017510000000412612612051202016675 0ustar00biocbuildbiocbuildPackage: GenomicAlignments Title: Representation and manipulation of short genomic alignments Description: Provides efficient containers for storing and manipulating short genomic alignments (typically obtained by aligning short reads to a reference genome). This includes read counting, computing the coverage, junction detection, and working with the nucleotide content of the alignments. Version: 1.6.1 Author: Herv\'e Pag\`es, Valerie Obenchain, Martin Morgan Maintainer: Bioconductor Package Maintainer biocViews: Genetics, Infrastructure, DataImport, Sequencing, RNASeq, SNP, Coverage, Alignment Depends: R (>= 2.10), methods, BiocGenerics (>= 0.15.3), S4Vectors (>= 0.7.1), IRanges (>= 2.3.21), GenomeInfoDb (>= 1.1.20), GenomicRanges (>= 1.21.6), SummarizedExperiment (>= 0.3.1), Biostrings (>= 2.37.1), Rsamtools (>= 1.21.4) Imports: methods, stats, BiocGenerics, S4Vectors, IRanges, GenomicRanges, Biostrings, Rsamtools, BiocParallel LinkingTo: S4Vectors, IRanges Suggests: ShortRead, rtracklayer, BSgenome, GenomicFeatures, RNAseqData.HNRNPC.bam.chr14, pasillaBamSubset, TxDb.Hsapiens.UCSC.hg19.knownGene, TxDb.Dmelanogaster.UCSC.dm3.ensGene, BSgenome.Dmelanogaster.UCSC.dm3, BSgenome.Hsapiens.UCSC.hg19, DESeq, edgeR, RUnit, BiocStyle License: Artistic-2.0 Collate: utils.R cigar-utils.R GAlignments-class.R GAlignmentPairs-class.R GAlignmentsList-class.R GappedReads-class.R OverlapEncodings-class.R findMateAlignment.R readGAlignments.R junctions-methods.R sequenceLayer.R pileLettersAt.R stackStringsFromBam.R intra-range-methods.R coverage-methods.R setops-methods.R findOverlaps-methods.R mapCoords-methods.R coordinate-mapping-methods.R encodeOverlaps-methods.R findCompatibleOverlaps-methods.R summarizeOverlaps-methods.R findSpliceOverlaps-methods.R zzz.R Video: https://www.youtube.com/watch?v=2KqBSbkfhRo , https://www.youtube.com/watch?v=3PK_jx44QTs NeedsCompilation: yes Packaged: 2015-10-22 03:05:38 UTC; biocbuild GenomicAlignments/NAMESPACE0000644000175100017510000001155412607264575016440 0ustar00biocbuildbiocbuilduseDynLib(GenomicAlignments) import(methods) importFrom(stats, setNames) import(BiocGenerics) import(S4Vectors) import(IRanges) import(GenomeInfoDb) import(GenomicRanges) import(SummarizedExperiment) import(Biostrings) import(Rsamtools) importFrom(BiocParallel, bplapply) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Export S4 classes ### exportClasses( GAlignments, GAlignmentPairs, GAlignmentsList, GappedReads, OverlapEncodings ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Export S3 methods ### S3method(as.data.frame, OverlapEncodings) S3method(levels, OverlapEncodings) ### We also export them thru the export() directive so that (a) they can be ### called directly, (b) tab-completion on the name of the generic shows them, ### and (c) methods() doesn't asterisk them. export( as.data.frame.OverlapEncodings, levels.OverlapEncodings ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Export S4 methods for generics not defined in GenomicAlignments ### exportMethods( c, ## Generics defined in BiocGenerics: start, end, width, ## Generics defined in IRanges: relistToClass, narrow, coverage, pintersect, findOverlaps, countOverlaps, overlapsAny, subsetByOverlaps, mapCoords, ## Generics defined in GenomeInfoDb: seqinfo, "seqinfo<-", seqnames, "seqnames<-", seqlevelsInUse, ## Generics defined in GenomicRanges: granges, grglist, rglist, ## Generics defined in Biostrings: encoding ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Export non-generic functions ### export( validCigar, CIGAR_OPS, explodeCigarOps, explodeCigarOpLengths, cigarToRleList, cigarRangesAlongReferenceSpace, cigarRangesAlongQuerySpace, cigarRangesAlongPairwiseSpace, extractAlignmentRangesOnReference, cigarWidthAlongReferenceSpace, cigarWidthAlongQuerySpace, cigarWidthAlongPairwiseSpace, cigarNarrow, cigarQNarrow, cigarOpTable, queryLoc2refLoc, queryLocs2refLocs, GAlignments, GAlignmentPairs, GAlignmentsList, GappedReads, findMateAlignment, findMateAlignment2, makeGAlignmentPairs, getDumpedAlignments, countDumpedAlignments, flushDumpedAlignments, readGAlignments, readGAlignmentPairs, readGAlignmentsList, readGappedReads, NATURAL_INTRON_MOTIFS, summarizeJunctions, readTopHatJunctions, readSTARJunctions, sequenceLayer, pileLettersAt, stackStringsFromBam, alphabetFrequencyFromBam, encodeOverlaps1, flipQuery, selectEncodingWithCompatibleStrand, extractQueryStartInTranscript, countCompatibleOverlaps, Union, IntersectionNotEmpty, IntersectionStrict, ## Old stuff (Deprecated or Defunct): readGAlignmentsFromBam, readGAlignmentPairsFromBam, readGAlignmentsListFromBam, readGappedReadsFromBam ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Export S4 generics defined in GenomicAlignments + export corresponding ### methods ### export( ## GAlignments-class.R: rname, "rname<-", cigar, qwidth, njunc, ## GAlignmentPairs-class.R: first, last, left, right, strandMode, "strandMode<-", isProperPair, ## GappedReads-class.R: qseq, ## OverlapEncodings-class.R: Loffset, Roffset, flippedQuery, Lencoding, Rencoding, Lnjunc, Rnjunc, ## readGAlignments.R: readGAlignments, readGAlignmentPairs, readGAlignmentsList, readGappedReads, ## junctions-methods.R: junctions, ## intra-range-methods.R: qnarrow, ## encodeOverlaps-methods.R: encodeOverlaps, isCompatibleWithSplicing, isCompatibleWithSkippedExons, extractSteppedExonRanks, extractSpannedExonRanks, extractSkippedExonRanks, ## findCompatibleOverlaps-methods.R: findCompatibleOverlaps, ## summarizeOverlaps-methods.R: summarizeOverlaps, ## findSpliceOverlaps-methods.R: findSpliceOverlaps, ## coordinateMapping-methods.R: mapToAlignments, pmapToAlignments, mapFromAlignments, pmapFromAlignments ) ### Exactly the same list as above. exportMethods( rname, "rname<-", cigar, qwidth, njunc, first, last, left, right, strandMode, "strandMode<-", isProperPair, qseq, Loffset, Roffset, flippedQuery, Lencoding, Rencoding, Lnjunc, Rnjunc, readGAlignments, readGAlignmentPairs, readGAlignmentsList, readGappedReads, junctions, qnarrow, encodeOverlaps, isCompatibleWithSplicing, isCompatibleWithSkippedExons, extractSteppedExonRanks, extractSpannedExonRanks, extractSkippedExonRanks, findCompatibleOverlaps, summarizeOverlaps, findSpliceOverlaps, mapToAlignments, pmapToAlignments, mapFromAlignments, pmapFromAlignments ) GenomicAlignments/NEWS0000644000175100017510000001130212607264575015707 0ustar00biocbuildbiocbuildCHANGES IN VERSION 1.6.0 ------------------------ NEW FEATURES o Add strandMode() getter and setter for GAlignmentPairs objects in response to the following post: https://support.bioconductor.org/p/65844/ See ?strandMode for more information. o The readGAlignment*() functions now allow repeated seqnames in the BAM header. o Add "coverage" method for GAlignmentsList objects. o The strand setter now works on a GAlignmentsList object in a restricted way (only strand(x) <- "+" or "-" or "*" is supported). SIGNIFICANT USER-LEVEL CHANGES o summarizeOverlaps() now returns a RangedSummarizedExperiment object (defined in the new SummarizedExperiment package) instead of an "old" SummarizedExperiment object (defined in the GenomicRanges package). o Slightly modify the behavior of junctions() on a GAlignmentPairs object so that the returned ranges now have the "real strand" set on them. See ?junctions and the documentation of the 'real.strand' argument in the man page of GAlignmentPairs objects for more information. o Add 'real.strand' argument to first() and last() getters for GAlignmentPairs objects. DEPRECATED AND DEFUNCT o Deprecate left() and right() getters and strand() setter for GAlignmentPairs objects. o Deprecate 'invert.strand' argument of first() and last() getters for GAlignmentPairs objects. o Deprecate 'order.as.in.query' argument of "grglist" method for GAlignmentPairs objects. o Deprecate 'order.as.in.query' argument in "rglist" method for GAlignmentsList objects (this concept is not defined for these objects in general and the argument was ignored anyway). o After being deprecated in BioC 3.1, the "mapCoords" and "pmapCoords" methods are now defunct. mapToAlignments() should be used instead. o After being deprecated in BioC 3.1, the readGAlignment*FromBam() functions are now defunct. Everybody says "Let's all use the readGAlignment*() functions instead! (no FromBam suffix). Yeah!" BUG FIXES o Various fixes to grglist/granges/rglist/ranges methods for GAlignmentsList objects: - Respect cigar information (as claimed in man page). - Restore 'drop.D.ranges' argument in "grglist" method (mistakenly got deprecated at the beginning of BioC 3.2 devel cycle). - The 'drop.D.ranges' argument in "rglist" method now works (was ignored). - Handle empty list elements. CHANGES IN VERSION 1.4.0 ------------------------ NEW FEATURES o All "findOverlaps" methods now support 'select' equal "last" or "arbitrary" (in addition to "all" and "first"). SIGNIFICANT USER-LEVEL CHANGES o Add mapToAlignments(), pmapToAlignments(), mapFromAlignments(), and pmapFromAlignments() as replacements for the "mapCoords" and "pmapCoords" methods for GAlignments objects. o Clarify use of 'fragments' in summarizeOverlaps() man page. o Tweak "show" method for GAlignments objects to display a shorter version of long CIGARs. o Add checks and more helpful error message for summarizeOverlaps() when "file does not exist" DEPRECATED AND DEFUNCT o Deprecated readGAlignment*FromBam() functions in favor of readGAlignments(), readGAlignmentPairs(), readGAlignmentsList() and readGappedReads(). o Deprecated "mapCoords" and "pmapCoords" methods. o Removed Lngap(), Rngap(), introns(), and makeGAlignmentsListFromFeatureFragments() functions, and "ngap", "map", "pmap", and "splitAsListReturnedClass" methods (were defunct in GenomicAlignments 1.2.0). BUG FIXES o Fix off-by-one error when processing 'S' in query_locs_to_ref_locs(). CHANGES IN VERSION 1.2.0 ------------------------ NEW FEATURES o Add 'preprocess.reads' argument to "summarizeOverlaps" methods. o Add alphabetFrequencyFromBam(). SIGNIFICANT USER-LEVEL CHANGES o Export GappedReads() constructor. o coverage,Bamfile-method now returns empty RleList rather than NULL o Add "mapCoords" and "pmapCoords" methods. o Defunct "map" and "pmap" methods (skip deprecation). BUG FIXES o Bug fix in flipQuery(). o Fix issue with "show" method for GAlignments and GAlignmentPairs objects when 'showHeadLines' global option is set to Inf. CHANGES IN VERSION 1.0.0 ------------------------ The first version of GenomicAlignments was included in Bioconductor 2.14. The package was created from existing code in IRanges, ShortRead, Rsamtools and GenomicRanges. NEW FEATURES o coverage,BamFile-method uses \code{yieldSize} to iterate through large files o coverage,character-method calculates coverage from a BAM file GenomicAlignments/R/0000755000175100017510000000000012607264575015414 5ustar00biocbuildbiocbuildGenomicAlignments/R/GAlignmentPairs-class.R0000644000175100017510000006662712607264575021707 0ustar00biocbuildbiocbuild### ========================================================================= ### GAlignmentPairs objects ### ------------------------------------------------------------------------- ### ### TODO: Implement a GAlignmentsList class (CompressedList subclass) ### and derive GAlignmentPairs from it. ### "first" and "last" GAlignments must have identical seqinfo. setClass("GAlignmentPairs", contains="List", representation( strandMode="integer", # single integer (0L, 1L, or 2L) NAMES="characterORNULL", # R doesn't like @names !! first="GAlignments", # of length N, no names, no elt metadata last="GAlignments", # of length N, no names, no elt metadata isProperPair="logical", # of length N elementMetadata="DataFrame" # N rows ), prototype( strandMode=1L, elementType="GAlignments" ) ) ### Formal API: ### strandMode(x) - indicates how to infer the strand of a pair from the ### strand of the first and last alignments in the pair: ### 0: strand of the pair is always *; ### 1: strand of the pair is strand of its first alignment; ### 2: strand of the pair is strand of its last alignment. ### These modes are equivalent to 'strandSpecific' equal 0, 1, ### and 2, respectively, for the featureCounts() function ### defined in the Rsubread package. ### length(x) - single integer N. Nb of pairs in 'x'. ### names(x) - NULL or character vector. ### first(x) - returns "first" slot. ### last(x) - returns "last" slot. ### seqnames(x) - same as 'seqnames(first(x))' or 'seqnames(last(x))'. ### strand(x) - obeys strandMode(x) (see above). ### njunc(x) - same as 'njunc(first(x)) + njunc(last(x))'. ### isProperPair(x) - returns "isProperPair" slot. ### seqinfo(x) - returns 'seqinfo(first(x))' (same as 'seqinfo(last(x))'). ### granges(x) - GRanges object of the same length as 'x'. ### grglist(x) - GRangesList object of the same length as 'x'. ### show(x) - compact display in a data.frame-like fashion. ### GAlignmentPairs(x) - constructor. ### x[i] - GAlignmentPairs object of the same class as 'x' ### (endomorphism). ### setGeneric("strandMode", function(x) standardGeneric("strandMode")) setGeneric("strandMode<-", signature="x", function(x, value) standardGeneric("strandMode<-") ) setGeneric("first", function(x, ...) standardGeneric("first")) setGeneric("last", function(x, ...) standardGeneric("last")) setGeneric("isProperPair", function(x) standardGeneric("isProperPair")) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Getters. ### setMethod("strandMode", "GAlignmentPairs", function(x) x@strandMode ) setMethod("length", "GAlignmentPairs", function(x) length(x@first) ) setMethod("names", "GAlignmentPairs", function(x) x@NAMES ) setMethod("first", "GAlignmentPairs", function(x, real.strand=FALSE, invert.strand=FALSE) { if (!isTRUEorFALSE(real.strand)) stop("'real.strand' must be TRUE or FALSE") if (!identical(invert.strand, FALSE)) { msg <- c("Using the 'invert.strand' argument when calling ", "first() on a GAlignmentPairs object is deprecated.") .Deprecated(msg=wmsg(msg)) if (!isTRUEorFALSE(invert.strand)) stop("'invert.strand' must be TRUE or FALSE") if (real.strand && invert.strand) stop(wmsg("one of 'real.strand' or 'invert.strand' can ", "be set to TRUE but not both")) } ans <- setNames(x@first, names(x)) if (invert.strand) return(invertRleStrand(ans)) if (real.strand) { if (strandMode(x) == 0L) { strand(ans) <- "*" } else if (strandMode(x) == 2L) { ans <- invertRleStrand(ans) } } ans } ) setMethod("last", "GAlignmentPairs", function(x, real.strand=FALSE, invert.strand=FALSE) { if (!isTRUEorFALSE(real.strand)) stop("'real.strand' must be TRUE or FALSE") if (!identical(invert.strand, FALSE)) { msg <- c("Using the 'invert.strand' argument when calling ", "last() on a GAlignmentPairs object is deprecated.") .Deprecated(msg=wmsg(msg)) if (!isTRUEorFALSE(invert.strand)) stop("'invert.strand' must be TRUE or FALSE") if (real.strand && invert.strand) stop(wmsg("one of 'real.strand' or 'invert.strand' can ", "be set to TRUE but not both")) } ans <- setNames(x@last, names(x)) if (invert.strand) return(invertRleStrand(ans)) if (real.strand) { if (strandMode(x) == 0L) { strand(ans) <- "*" } else if (strandMode(x) == 1L) { ans <- invertRleStrand(ans) } } ans } ) setMethod("seqnames", "GAlignmentPairs", function(x) seqnames(x@first) ) setMethod("strand", "GAlignmentPairs", function(x) { if (strandMode(x) == 0L) return(strand(Rle("*", length(x)))) if (strandMode(x) == 1L) strand(x@first) else strand(x@last) } ) setMethod("njunc", "GAlignmentPairs", function(x) {njunc(x@first) + njunc(x@last)} ) setMethod("isProperPair", "GAlignmentPairs", function(x) x@isProperPair ) setMethod("seqinfo", "GAlignmentPairs", function(x) seqinfo(x@first) ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Setters. ### .normarg_strandMode_replace_value <- function(value) { if (!isSingleNumber(value)) stop("invalid strand mode (must be 0, 1, or 2)") if (!is.integer(value)) value <- as.integer(value) if (!(value %in% 0:2)) stop("invalid strand mode (must be 0, 1, or 2)") value } setReplaceMethod("strandMode", "GAlignmentPairs", function(x, value) { x@strandMode <- .normarg_strandMode_replace_value(value) x } ) setReplaceMethod("names", "GAlignmentPairs", function(x, value) { if (!is.null(value)) value <- as.character(value) x@NAMES <- value validObject(x) x } ) setReplaceMethod("strand", "GAlignmentPairs", function(x, value) { msg <- c("The strand setter for GAlignmentPairs objects ", "is deprecated. You can use strandMode() to control the ", "behavior of the strand() getter in accordance with the ", "stranded protocol that was used to generate the ", "paired-end data (see '?strandMode').") .Deprecated(msg=wmsg(msg)) if (strandMode(x) == 0L) stop("cannot alter the strand of a ", class(GAlignmentPairs), " object that has its strand mode set to 0") same_strand <- strand(x@first) == strand(x@last) if (strandMode(x) == 1L) { ## Set the strand of the first alignment. strand(x@first) <- value ## Then set the strand of the last alignment to preserve the ## original relationship between first and last strand (i.e. if ## they were the same, they remain the same, if they were opposite, ## they remain opposite). strand(x@last) <- strand(same_strand == (strand(x@first) == "-")) } else { ## Set the strand of the last alignment. strand(x@last) <- value ## Then set the strand of the first alignment to preserve the ## original relationship between first and last strand (i.e. if ## they were the same, they remain the same, if they were opposite, ## they remain opposite). strand(x@first) <- strand(same_strand == (strand(x@last) == "-")) } x } ) setReplaceMethod("elementMetadata", "GAlignmentPairs", function(x, ..., value) { value <- GenomicRanges:::normalizeMetadataColumnsReplacementValue(value, x) x@elementMetadata <- value x } ) setMethod("seqlevelsInUse", "GAlignmentPairs", function(x) { in_use1 <- seqlevelsInUse(x@first) in_use2 <- seqlevelsInUse(x@last) ## We cannot just do union() because we want the returned levels ## to be in the order they appear in 'seqlevels(x)'. intersect(seqlevels(x), union(in_use1, in_use2)) } ) setReplaceMethod("seqinfo", "GAlignmentPairs", function(x, new2old=NULL, force=FALSE, value) { if (!is(value, "Seqinfo")) stop("the supplied 'seqinfo' must be a Seqinfo object") dangling_seqlevels <- GenomeInfoDb:::getDanglingSeqlevels(x, new2old=new2old, force=force, seqlevels(value)) if (length(dangling_seqlevels) != 0L) { dropme_in_first <- seqnames(x@first) %in% dangling_seqlevels dropme_in_last <- seqnames(x@last) %in% dangling_seqlevels dropme <- dropme_in_first | dropme_in_last x <- x[!dropme] } seqinfo(x@first, new2old=new2old) <- value seqinfo(x@last, new2old=new2old) <- value x } ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Validity. ### .valid.GAlignmentPairs.strandMode <- function(x) { if (!(isSingleInteger(x@strandMode) && x@strandMode %in% 0:2)) return("'x@strandMode' must be 0L, 1L, or 2L") NULL } .valid.GAlignmentPairs.names <- function(x) { x_names <- names(x) if (is.null(x_names)) return(NULL) if (!is.character(x_names) || !is.null(attributes(x_names))) { msg <- c("'names(x)' must be NULL or a character vector ", "with no attributes") return(paste(msg, collapse="")) } if (length(x_names) != length(x)) return("'names(x)' and 'x' must have the same length") NULL } .valid.GAlignmentPairs.first <- function(x) { x_first <- x@first if (class(x_first) != "GAlignments") return("'x@first' must be a GAlignments instance") NULL } .valid.GAlignmentPairs.last <- function(x) { x_last <- x@last if (class(x_last) != "GAlignments") return("'x@last' must be a GAlignments instance") x_first <- x@first if (length(x_last) != length(x_first)) return("'x@last' and 'x@first' must have the same length") if (!identical(seqinfo(x_last), seqinfo(x_first))) return("'seqinfo(x@last)' and 'seqinfo(x@first)' must be identical") NULL } .valid.GAlignmentPairs.isProperPair <- function(x) { x_isProperPair <- x@isProperPair if (!is.logical(x_isProperPair) || !is.null(attributes(x_isProperPair))) { msg <- c("'x@isProperPair' must be a logical vector ", "with no attributes") return(paste(msg, collapse="")) } if (length(x_isProperPair) != length(x)) return("'x@isProperPair' and 'x' must have the same length") if (S4Vectors:::anyMissing(x_isProperPair)) return("'x@isProperPair' cannot contain NAs") NULL } .valid.GAlignmentPairs <- function(x) { c(.valid.GAlignmentPairs.strandMode(x), .valid.GAlignmentPairs.names(x), .valid.GAlignmentPairs.first(x), .valid.GAlignmentPairs.last(x), .valid.GAlignmentPairs.isProperPair(x)) } setValidity2("GAlignmentPairs", .valid.GAlignmentPairs, where=asNamespace("GenomicAlignments")) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Constructor. ### GAlignmentPairs <- function(first, last, strandMode=1L, isProperPair=TRUE, names=NULL) { if (!(is(first, "GAlignments") && is(last, "GAlignments"))) stop("'first' and 'last' must be GAlignments objects") if (length(first) != length(last)) stop("'first' and 'last' must have the same length") strandMode <- .normarg_strandMode_replace_value(strandMode) if (identical(isProperPair, TRUE)) isProperPair <- rep.int(isProperPair, length(first)) new2("GAlignmentPairs", strandMode=strandMode, NAMES=names, first=first, last=last, isProperPair=isProperPair, elementMetadata=new("DataFrame", nrows=length(first)), check=TRUE) } ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Vector methods. ### setMethod("extractROWS", "GAlignmentPairs", function(x, i) { i <- normalizeSingleBracketSubscript(i, x, as.NSBS=TRUE) ans_NAMES <- extractROWS(x@NAMES, i) ans_first <- extractROWS(x@first, i) ans_last <- extractROWS(x@last, i) ans_isProperPair <- extractROWS(x@isProperPair, i) ans_elementMetadata <- extractROWS(x@elementMetadata, i) BiocGenerics:::replaceSlots(x, NAMES=ans_NAMES, first=ans_first, last=ans_last, isProperPair=ans_isProperPair, elementMetadata=ans_elementMetadata) } ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### List methods. ### ### TODO: Remove the "[[" method below after the definition of the ### GAlignmentPairs class is changed to derive from CompressedList. ### (The "[[" method for CompressedList objects should do just fine i.e. it ### should do something like x@unlistData[x@partitioning[[i]]] and that ### should be optimal.) .GAlignmentPairs.getElement <- function(x, i) { c(x@first[i], x@last[i]) } setMethod("[[", "GAlignmentPairs", function(x, i, j, ... , drop=TRUE) { if (missing(i) || !missing(j) || length(list(...)) > 0L) stop("invalid subsetting") i <- normalizeDoubleBracketSubscript(i, x) .GAlignmentPairs.getElement(x, i) } ) ### TODO: Remove this method after the definition of the GAlignmentPairs ### class is changed to derive from CompressedList. setMethod("unlist", "GAlignmentPairs", function(x, recursive=TRUE, use.names=TRUE) { if (!isTRUEorFALSE(use.names)) stop("'use.names' must be TRUE or FALSE") x_first <- x@first x_last <- x@last collate_subscript <- S4Vectors:::make_XYZxyz_to_XxYyZz_subscript(length(x)) ans <- c(x_first, x_last)[collate_subscript] if (use.names) names(ans) <- rep(names(x), each=2L) ans } ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Coercion. ### ### Shrink CompressedList 'x' (typically a GRangesList) by half by combining ### pairs of consecutive top-level elements. shrinkByHalf <- function(x) { if (length(x) %% 2L != 0L) stop("'x' must have an even length") x_elt_lens <- elementLengths(x) if (length(x_elt_lens) == 0L) { ans_nelt1 <- ans_nelt2 <- integer(0) } else { ans_nelt1 <- x_elt_lens[c(TRUE, FALSE)] ans_nelt2 <- x_elt_lens[c(FALSE, TRUE)] } ans_elt_lens <- ans_nelt1 + ans_nelt2 ans_partitioning <- PartitioningByEnd(cumsum(ans_elt_lens)) ans <- relist(x@unlistData, ans_partitioning) mcols(ans) <- DataFrame(nelt1=ans_nelt1, nelt2=ans_nelt2) ans } ### FIXME: Behavior is currently undefined (and undocumented) when ### strandMode(x) is 0. Fix this! setMethod("grglist", "GAlignmentPairs", function(x, use.mcols=FALSE, order.as.in.query=FALSE, drop.D.ranges=FALSE) { if (!isTRUEorFALSE(use.mcols)) stop("'use.mcols' must be TRUE or FALSE") if (!identical(order.as.in.query, FALSE)) { msg <- c("Starting with BioC 3.2, the \"grglist\" method for ", "GAlignmentPairs objects *always* returns the ranges ", "\"ordered as in query\". Therefore the ", "'order.as.in.query' argument is now ignored (and ", "deprecated).") .Deprecated(msg=wmsg(msg)) } x_mcols <- mcols(x) if (use.mcols && "query.break" %in% colnames(x_mcols)) stop("'mcols(x)' cannot have reserved column \"query.break\"") x_first <- x@first x_last <- x@last if (strandMode(x) == 1L) { x_last <- invertRleStrand(x@last) x_unlisted <- c(x_first, x_last) } else if (strandMode(x) == 2L) { x_first <- invertRleStrand(x@first) x_unlisted <- c(x_last, x_first) } ## Not the same as doing 'unlist(x, use.names=FALSE)'. collate_subscript <- S4Vectors:::make_XYZxyz_to_XxYyZz_subscript(length(x)) x_unlisted <- x_unlisted[collate_subscript] grl <- grglist(x_unlisted, order.as.in.query=TRUE, drop.D.ranges=drop.D.ranges) ans <- shrinkByHalf(grl) names(ans) <- names(x) ans_mcols <- DataFrame(query.break=mcols(ans)$nelt1) if (use.mcols) ans_mcols <- cbind(ans_mcols, x_mcols) mcols(ans) <- ans_mcols ans } ) setMethod("granges", "GAlignmentPairs", function(x, use.mcols=FALSE) { if (!isTRUEorFALSE(use.mcols)) stop("'use.mcols' must be TRUE or FALSE") rg <- range(grglist(x)) if (!all(elementLengths(rg) == 1L)) stop("For some pairs in 'x', the first and last alignments ", "are not aligned to the same chromosome and strand. ", "Cannot extract a single range for them.") ans <- unlist(rg) if (use.mcols) mcols(ans) <- mcols(x) ans } ) setAs("GAlignmentPairs", "GRangesList", function(from) grglist(from, use.mcols=TRUE) ) setAs("GAlignmentPairs", "GRanges", function(from) granges(from, use.mcols=TRUE) ) setAs("GAlignmentPairs", "GAlignments", function(from) unlist(from, use.names=TRUE) ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### fillJunctionGaps() ### ### Not exported. Used in the SplicingGraphs package. ### fillJunctionGaps <- function(x) { if (!is(x, "GRangesList")) stop("'x' must be a GRangesList object") query.breaks <- mcols(x)$query.break if (is.null(query.breaks)) stop("'x' must be a GRangesList object with a \"query.breaks\" ", "metadata column") offsets <- end(x@partitioning) if (length(x) != 0L) offsets <- c(0L, offsets[-length(offsets)]) idx <- S4Vectors:::fancy_mseq(query.breaks, offsets) half1_partitioning <- PartitioningByEnd(cumsum(query.breaks)) half1 <- relist(x@unlistData[idx], half1_partitioning) half1 <- range(half1)@unlistData half2_eltlens <- elementLengths(x) - query.breaks half2_partitioning <- PartitioningByEnd(cumsum(half2_eltlens)) half2 <- relist(x@unlistData[-idx], half2_partitioning) half2 <- range(half2)@unlistData collate_subscript <- S4Vectors:::make_XYZxyz_to_XxYyZz_subscript(length(x)) ans_unlistData <- c(half1, half2)[collate_subscript] ans_partitioning <- PartitioningByEnd(2L * seq_along(x), names=names(x)) relist(ans_unlistData, ans_partitioning) } ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### "show" method. ### .makeNakedMatFromGAlignmentPairs <- function(x) { lx <- length(x) nc <- ncol(mcols(x)) pair_cols <- cbind(seqnames=as.character(seqnames(x)), strand=as.character(strand(x))) x_first <- x@first first_cols <- cbind(ranges=showAsCell(ranges(x_first))) x_last <- x@last last_cols <- cbind(ranges=showAsCell(ranges(x_last))) ans <- cbind(pair_cols, `:`=rep.int(":", lx), first_cols, `--`=rep.int("--", lx), last_cols) if (nc > 0L) { tmp <- do.call(data.frame, lapply(mcols(x), showAsCell)) ans <- cbind(ans, `|`=rep.int("|", lx), as.matrix(tmp)) } ans } showGAlignmentPairs <- function(x, margin="", print.classinfo=FALSE, print.seqinfo=FALSE) { lx <- length(x) nc <- ncol(mcols(x)) cat(class(x), " object with ", lx, " ", ifelse(lx == 1L, "pair", "pairs"), ", strandMode=", strandMode(x), ", and ", nc, " metadata ", ifelse(nc == 1L, "column", "columns"), ":\n", sep="") out <- S4Vectors:::makePrettyMatrixForCompactPrinting(x, .makeNakedMatFromGAlignmentPairs) if (print.classinfo) { .PAIR_COL2CLASS <- c( seqnames="Rle", strand="Rle" ) .HALVES_COL2CLASS <- c( ranges="IRanges" ) .COL2CLASS <- c(.PAIR_COL2CLASS, ":", .HALVES_COL2CLASS, "--", .HALVES_COL2CLASS) classinfo <- S4Vectors:::makeClassinfoRowForCompactPrinting(x, .COL2CLASS) ## A sanity check, but this should never happen! stopifnot(identical(colnames(classinfo), colnames(out))) out <- rbind(classinfo, out) } if (nrow(out) != 0L) rownames(out) <- paste0(margin, rownames(out)) ## We set 'max' to 'length(out)' to avoid the getOption("max.print") ## limit that would typically be reached when 'showHeadLines' global ## option is set to Inf. print(out, quote=FALSE, right=TRUE, max=length(out)) if (print.seqinfo) { cat(margin, "-------\n", sep="") cat(margin, "seqinfo: ", summary(seqinfo(x)), "\n", sep="") } } setMethod("show", "GAlignmentPairs", function(object) showGAlignmentPairs(object, margin=" ", print.classinfo=TRUE, print.seqinfo=TRUE) ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Combining. ### ### 'Class' must be "GAlignmentPairs" or the name of a concrete subclass of ### GAlignmentPairs. ### 'objects' must be a list of GAlignmentPairs objects. ### Returns an instance of class 'Class'. combine_GAlignmentPairs_objects <- function(Class, objects, use.names=TRUE, ignore.mcols=FALSE) { if (!isSingleString(Class)) stop("'Class' must be a single character string") if (!extends(Class, "GAlignmentPairs")) stop("'Class' must be the name of a class that extends GAlignmentPairs") if (!is.list(objects)) stop("'objects' must be a list") if (!isTRUEorFALSE(use.names)) stop("'use.names' must be TRUE or FALSE") ### TODO: Support 'use.names=TRUE'. if (use.names) stop("'use.names=TRUE' is not supported yet") if (!isTRUEorFALSE(ignore.mcols)) stop("'ignore.mcols' must be TRUE or FALSE") if (length(objects) != 0L) { ## TODO: Implement (in C) fast 'elementIsNull(objects)' in IRanges, ## that does 'sapply(objects, is.null, USE.NAMES=FALSE)', and use it ## here. null_idx <- which(sapply(objects, is.null, USE.NAMES=FALSE)) if (length(null_idx) != 0L) objects <- objects[-null_idx] } if (length(objects) == 0L) return(new(Class)) ## TODO: Implement (in C) fast 'elementIs(objects, class)' in IRanges, that ## does 'sapply(objects, is, class, USE.NAMES=FALSE)', and use it here. ## 'elementIs(objects, "NULL")' should work and be equivalent to ## 'elementIsNull(objects)'. if (!all(sapply(objects, is, Class, USE.NAMES=FALSE))) stop("the objects to combine must be ", Class, " objects (or NULLs)") objects_names <- names(objects) names(objects) <- NULL # so lapply(objects, ...) below returns an # unnamed list ## Combine "NAMES" slots. NAMES_slots <- lapply(objects, function(x) x@NAMES) ## TODO: Use elementIsNull() here when it becomes available. has_no_names <- sapply(NAMES_slots, is.null, USE.NAMES=FALSE) if (all(has_no_names)) { ans_NAMES <- NULL } else { noname_idx <- which(has_no_names) if (length(noname_idx) != 0L) NAMES_slots[noname_idx] <- lapply(elementLengths(objects[noname_idx]), character) ans_NAMES <- unlist(NAMES_slots, use.names=FALSE) } ## Combine "first" slots. first_slots <- lapply(objects, function(x) x@first) ans_first <- combine_GAlignments_objects("GAlignments", first_slots, use.names=FALSE, ignore.mcols=ignore.mcols) ## Combine "last" slots. last_slots <- lapply(objects, function(x) x@last) ans_last <- combine_GAlignments_objects("GAlignments", last_slots, use.names=FALSE, ignore.mcols=ignore.mcols) ## Combine "isProperPair" slots. isProperPair_slots <- lapply(objects, function(x) x@isProperPair) ans_isProperPair <- unlist(isProperPair_slots, use.names=FALSE) ## Combine "mcols" slots. We don't need to use fancy ## IRanges:::rbind.mcols() for this because the "mcols" slot of a ## GAlignmentPairs object is guaranteed to be a DataFrame. if (ignore.mcols) { ans_mcols <- new("DataFrame", nrows=length(ans_first)) } else { mcols_slots <- lapply(objects, function(x) x@elementMetadata) ## Will fail if not all the GAlignmentPairs objects in 'objects' have ## exactly the same metadata cols. ans_mcols <- do.call(rbind, mcols_slots) } ## Make 'ans' and return it. new(Class, NAMES=ans_NAMES, first=ans_first, last=ans_last, isProperPair=ans_isProperPair, elementMetadata=ans_mcols) } setMethod("c", "GAlignmentPairs", function(x, ..., ignore.mcols=FALSE, recursive=FALSE) { if (!identical(recursive, FALSE)) stop("\"c\" method for GAlignmentPairs objects ", "does not support the 'recursive' argument") if (missing(x)) { objects <- list(...) x <- objects[[1L]] } else { objects <- list(x, ...) } combine_GAlignmentPairs_objects(class(x), objects, use.names=FALSE, ignore.mcols=ignore.mcols) } ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Old stuff (deprecated & defunct) ### setGeneric("left", function(x, ...) standardGeneric("left")) setGeneric("right", function(x, ...) standardGeneric("right")) setMethod("left", "GAlignmentPairs", function(x, ...) { msg <- c("The left() and right() getters are deprecated ", "for GAlignmentPairs objects.") .Deprecated(msg=wmsg(msg)) x_first <- x@first x_last <- invertRleStrand(x@last) left_is_last <- which(strand(x_first) == "-") idx <- seq_len(length(x)) idx[left_is_last] <- idx[left_is_last] + length(x) ans <- c(x_first, x_last)[idx] setNames(ans, names(x)) } ) setMethod("right", "GAlignmentPairs", function(x, ...) { msg <- c("The left() and right() getters are deprecated ", "for GAlignmentPairs objects.") .Deprecated(msg=wmsg(msg)) x_first <- x@first x_last <- invertRleStrand(x@last) right_is_first <- which(strand(x_first) == "-") idx <- seq_len(length(x)) idx[right_is_first] <- idx[right_is_first] + length(x) ans <- c(x_last, x_first)[idx] setNames(ans, names(x)) } ) GenomicAlignments/R/GAlignments-class.R0000644000175100017510000006337512607264575021070 0ustar00biocbuildbiocbuild### ========================================================================= ### GAlignments objects ### ------------------------------------------------------------------------- ### setClass("GAlignments", contains="Vector", representation( NAMES="characterORNULL", # R doesn't like @names !! seqnames="Rle", # 'factor' Rle start="integer", # POS field in SAM cigar="character", # extended CIGAR (see SAM format specs) strand="Rle", # 'factor' Rle #mismatches="characterORNULL", # see MD optional field in SAM format specs elementMetadata="DataFrame", seqinfo="Seqinfo" ), prototype( seqnames=Rle(factor()), strand=Rle(strand()) ) ) ### Formal API: ### names(x) - NULL or character vector. ### length(x) - single integer. Nb of alignments in 'x'. ### seqnames(x) - 'factor' Rle of the same length as 'x'. ### rname(x) - same as 'seqnames(x)'. ### seqnames(x) <- value - replacement form of 'seqnames(x)'. ### rname(x) <- value - same as 'seqnames(x) <- value'. ### cigar(x) - character vector of the same length as 'x'. ### strand(x) - 'factor' Rle of the same length as 'x' (levels: +, -, *). ### qwidth(x) - integer vector of the same length as 'x'. ### start(x), end(x), width(x) - integer vectors of the same length as 'x'. ### njunc(x) - integer vector of the same length as 'x'. ### grglist(x) - GRangesList object of the same length as 'x'. ### granges(x) - GRanges object of the same length as 'x'. ### rglist(x) - CompressedIRangesList object of the same length as 'x'. ### ranges(x) - IRanges object of the same length as 'x'. ### as.data.frame(x) - data.frame with 1 row per alignment in 'x'. ### show(x) - compact display in a data.frame-like fashion. ### GAlignments(x) - constructor. ### x[i] - GAlignments object of the same class as 'x' (endomorphism). ### ### qnarrow(x, start=NA, end=NA, width=NA) - GAlignments object of the ### same length and class as 'x' (endomorphism). ### ### narrow(x, start=NA, end=NA, width=NA) - GAlignments object of the ### same length and class as 'x' (endomorphism). ### ### findOverlaps(query, subject) - 'query' or 'subject' or both are ### GAlignments objects. Just a convenient wrapper for ### 'findOverlaps(grglist(query), subject, ...)', etc... ### ### countOverlaps(query, subject) - 'query' or 'subject' or both are ### GAlignments objects. Just a convenient wrapper for ### 'countOverlaps(grglist(query), subject, ...)', etc... ### ### subsetByOverlaps(query, subject) - 'query' or 'subject' or both are ### GAlignments objects. ### setGeneric("rname", function(x) standardGeneric("rname")) setGeneric("rname<-", function(x, value) standardGeneric("rname<-")) setGeneric("cigar", function(x) standardGeneric("cigar")) setGeneric("qwidth", function(x) standardGeneric("qwidth")) setGeneric("njunc", function(x) standardGeneric("njunc")) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Getters. ### setMethod("length", "GAlignments", function(x) length(x@cigar)) setMethod("names", "GAlignments", function(x) x@NAMES) setMethod("seqnames", "GAlignments", function(x) x@seqnames) setMethod("rname", "GAlignments", function(x) seqnames(x)) setMethod("cigar", "GAlignments", function(x) x@cigar) setMethod("width", "GAlignments", function(x) cigarWidthAlongReferenceSpace(x@cigar) ) setMethod("start", "GAlignments", function(x, ...) x@start) setMethod("end", "GAlignments", function(x, ...) {x@start + width(x) - 1L}) setMethod("strand", "GAlignments", function(x) x@strand) setMethod("qwidth", "GAlignments", function(x) cigarWidthAlongQuerySpace(x@cigar) ) setMethod("njunc", "GAlignments", function(x) {unname(elementLengths(rglist(x))) - 1L} ) setMethod("seqinfo", "GAlignments", function(x) x@seqinfo) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Setters. ### setReplaceMethod("names", "GAlignments", function(x, value) { if (!is.null(value)) value <- as.character(value) x@NAMES <- value validObject(x) x } ) .normargSeqnamesReplaceValue <- function(x, value, ans.type=c("factor", "Rle")) { ans.type <- match.arg(ans.type) if (!is.factor(value) && !is.character(value) && (!is(value, "Rle") || !is.character(runValue(value)) && !is.factor(runValue(value)))) stop("'seqnames' value must be a character factor/vector, ", "or a 'character' Rle, or a 'factor' Rle") if (ans.type == "factor") { if (!is.factor(value)) value <- as.factor(value) } else if (ans.type == "Rle") { ## We want to return a 'factor' Rle. if (!is(value, "Rle")) { if (!is.factor(value)) value <- as.factor(value) value <- Rle(value) } else if (!is.factor(runValue(value))) { runValue(value) <- as.factor(runValue(value)) } } if (length(value) != length(x)) stop("'seqnames' value must be the same length as the object") value } ### 'old_seqnames' and 'new_seqnames' must be 'factor' Rle. .getSeqnamesTranslationTable <- function(old_seqnames, new_seqnames) { old <- runValue(old_seqnames) new <- runValue(new_seqnames) tmp <- unique(data.frame(old=old, new=new)) if (!identical(runLength(old_seqnames), runLength(new_seqnames)) || anyDuplicated(tmp$old) || anyDuplicated(tmp$new)) stop("mapping between old an new 'seqnames' values is not one-to-one") if (isTRUE(all.equal(as.integer(tmp$old), as.integer(tmp$new)))) { tr_table <- levels(new) names(tr_table) <- levels(old) } else { tr_table <- tmp$new names(tr_table) <- tmp$old } tr_table } setReplaceMethod("seqnames", "GAlignments", function(x, value) { value <- .normargSeqnamesReplaceValue(x, value, ans.type="Rle") tr_table <- .getSeqnamesTranslationTable(seqnames(x), value) x@seqnames <- value seqnames(x@seqinfo) <- tr_table[seqlevels(x)] x } ) setReplaceMethod("rname", "GAlignments", function(x, value) `seqnames<-`(x, value) ) setReplaceMethod("strand", "GAlignments", function(x, value) { x@strand <- GenomicRanges:::normargGenomicRangesStrand(value, length(x)) x } ) setReplaceMethod("elementMetadata", "GAlignments", function(x, ..., value) { value <- GenomicRanges:::normalizeMetadataColumnsReplacementValue(value, x) x@elementMetadata <- value x } ) setReplaceMethod("seqinfo", "GAlignments", function(x, new2old=NULL, force=FALSE, value) { if (!is(value, "Seqinfo")) stop("the supplied 'seqinfo' must be a Seqinfo object") dangling_seqlevels <- GenomeInfoDb:::getDanglingSeqlevels(x, new2old=new2old, force=force, seqlevels(value)) if (length(dangling_seqlevels) != 0L) x <- x[!(seqnames(x) %in% dangling_seqlevels)] old_seqinfo <- seqinfo(x) x@seqnames <- GenomeInfoDb:::makeNewSeqnames(x, new2old, seqlevels(value)) x@seqinfo <- value geom_has_changed <- GenomeInfoDb:::sequenceGeometryHasChanged( seqinfo(x), old_seqinfo, new2old=new2old) if (any(geom_has_changed, na.rm=TRUE)) validObject(x) x } ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Validity. ### .valid.GAlignments.names <- function(x) { x_names <- names(x) if (is.null(x_names)) return(NULL) if (!is.character(x_names) || !is.null(attributes(x_names))) { msg <- c("'names(x)' must be NULL or a character vector ", "with no attributes") return(paste(msg, collapse="")) } if (length(x_names) != length(x)) return("'names(x)' and 'x' must have the same length") NULL } .valid.GAlignments.seqnames <- function(x) { x_seqnames <- seqnames(x) if (!is(x_seqnames, "Rle") || !is.factor(runValue(x_seqnames)) || !is.null(names(x_seqnames)) || any(is.na(x_seqnames))) return("'seqnames(x)' must be an unnamed 'factor' Rle with no NAs") if (length(x_seqnames) != length(cigar(x))) return("'seqnames(x)' and 'cigar(x)' must have the same length") NULL } .valid.GAlignments.start <- function(x) { x_start <- start(x) if (!is.integer(x_start) || !is.null(names(x_start)) || S4Vectors:::anyMissing(x_start)) return("'start(x)' must be an unnamed integer vector with no NAs") if (length(x_start) != length(cigar(x))) return("'start(x)' and 'cigar(x)' must have the same length") NULL } .valid.GAlignments.cigar <- function(x) { x_cigar <- cigar(x) if (!is.character(x_cigar) || !is.null(names(x_cigar)) || any(is.na(x_cigar))) return("'cigar(x)' must be an unnamed character vector with no NAs") tmp <- validCigar(x_cigar) if (!is.null(tmp)) return(paste("in 'cigar(x)':", tmp)) NULL } .valid.GAlignments.strand <- function(x) { x_strand <- strand(x) if (!is(x_strand, "Rle") || !is.factor(runValue(x_strand)) || !identical(levels(runValue(x_strand)), levels(strand())) || !is.null(names(x_strand)) || any(is.na(x_strand))) return("'strand(x)' must be an unnamed 'factor' Rle with no NAs (and with levels +, - and *)") if (length(x_strand) != length(cigar(x))) return("'strand(x)' and 'cigar(x)' must have the same length") NULL } .valid.GAlignments <- function(x) { c(.valid.GAlignments.names(x), .valid.GAlignments.seqnames(x), .valid.GAlignments.start(x), .valid.GAlignments.cigar(x), .valid.GAlignments.strand(x), GenomicRanges:::valid.GenomicRanges.seqinfo(x)) } setValidity2("GAlignments", .valid.GAlignments, where=asNamespace("GenomicAlignments")) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Constructor. ### .asFactorRle <- function(x) { if (is.character(x)) { x <- Rle(as.factor(x)) } else if (is.factor(x)) { x <- Rle(x) } else if (is(x, "Rle") && is.character(runValue(x))) { runValue(x) <- as.factor(runValue(x)) } else if (!is(x, "Rle") || !is.factor(runValue(x))) { stop("'x' must be a character vector, a factor, ", "a 'character' Rle, or a 'factor' Rle") } x } GAlignments <- function(seqnames=Rle(factor()), pos=integer(0), cigar=character(0), strand=NULL, names=NULL, seqlengths=NULL, ...) { ## Prepare the 'seqnames' slot. seqnames <- .asFactorRle(seqnames) if (any(is.na(seqnames))) stop("'seqnames' cannot have NAs") ## Prepare the 'pos' slot. if (!is.integer(pos) || any(is.na(pos))) stop("'pos' must be an integer vector with no NAs") ## Prepare the 'cigar' slot. if (!is.character(cigar) || any(is.na(cigar))) stop("'cigar' must be a character vector with no NAs") ## Prepare the 'strand' slot. if (is.null(strand)) { if (length(seqnames) != 0L) stop("'strand' must be specified when 'seqnames' is not empty") strand <- Rle(strand()) } else if (is.factor(strand)) { strand <- Rle(strand) } ## Prepare the 'elementMetadata' slot. varlist <- list(...) elementMetadata <- if (0L == length(varlist)) new("DataFrame", nrows=length(seqnames)) else do.call(DataFrame, varlist) ## Prepare the 'seqinfo' slot. if (is.null(seqlengths)) { seqlengths <- rep(NA_integer_, length(levels(seqnames))) names(seqlengths) <- levels(seqnames) } else if (!is.numeric(seqlengths) || is.null(names(seqlengths)) || any(duplicated(names(seqlengths)))) { stop("'seqlengths' must be an integer vector with unique names") } else if (!setequal(names(seqlengths), levels(seqnames))) { stop("'names(seqlengths)' incompatible with 'levels(seqnames)'") } else if (!is.integer(seqlengths)) { storage.mode(seqlengths) <- "integer" } seqinfo <- Seqinfo(seqnames=names(seqlengths), seqlengths=seqlengths) ## Create and return the GAlignments instance. new("GAlignments", NAMES=names, seqnames=seqnames, start=pos, cigar=cigar, strand=strand, elementMetadata=elementMetadata, seqinfo=seqinfo) } setMethod("updateObject", "GAlignments", function(object, ..., verbose=FALSE) { if (verbose) message("updateObject(object = 'GAlignments')") if (is(try(object@NAMES, silent=TRUE), "try-error")) { object@NAMES <- NULL return(object) } if (is(try(validObject(object@seqinfo, complete=TRUE), silent=TRUE), "try-error")) { object@seqinfo <- updateObject(object@seqinfo) return(object) } object } ) setMethod("update", "GAlignments", function(object, ...) { BiocGenerics:::replaceSlots(object, ...) }) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Three helper functions used by higher level coercion functions. ### ### Note that their arguments are the different components of a ### GAlignments object instead of just the GAlignments object ### itself (arg 'x'). This allows them to be used in many different contexts ### e.g. when 'x' doesn't exist yet but is in the process of being constructed. ### .GAlignmentsToGRanges <- function(seqnames, start, width, strand, seqinfo, names=NULL) { ranges <- IRanges(start=start, width=width, names=names) ans <- GRanges(seqnames=seqnames, ranges=ranges, strand=strand) seqinfo(ans) <- seqinfo ans } ### Names are propagated via 'x@partitioning' ('x' is a CompressedIRangesList). .CompressedIRangesListToGRangesList <- function(x, seqnames, strand, seqinfo) { elt_lens <- elementLengths(x) seqnames <- rep.int(seqnames, elt_lens) strand <- rep.int(strand, elt_lens) unlisted_ans <- GRanges(seqnames=seqnames, ranges=x@unlistData, strand=strand) seqinfo(unlisted_ans) <- seqinfo ans <- relist(unlisted_ans, x) mcols(ans) <- mcols(x) ans } ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Coercion. ### setMethod("grglist", "GAlignments", function(x, use.mcols=FALSE, order.as.in.query=FALSE, drop.D.ranges=FALSE) { rgl <- rglist(x, use.mcols=use.mcols, order.as.in.query=order.as.in.query, drop.D.ranges=drop.D.ranges) .CompressedIRangesListToGRangesList(rgl, seqnames(x), strand(x), seqinfo(x)) } ) setMethod("granges", "GAlignments", function(x, use.mcols=FALSE) { if (!isTRUEorFALSE(use.mcols)) stop("'use.mcols' must be TRUE or FALSE") ans <- .GAlignmentsToGRanges(seqnames(x), start(x), width(x), strand(x), seqinfo(x), names(x)) if (use.mcols) mcols(ans) <- mcols(x) ans } ) setMethod("rglist", "GAlignments", function(x, use.mcols=FALSE, order.as.in.query=FALSE, drop.D.ranges=FALSE) { if (!isTRUEorFALSE(use.mcols)) stop("'use.mcols' must be TRUE or FALSE") if (!isTRUEorFALSE(order.as.in.query)) stop("'reorder.ranges.from5to3' must be TRUE or FALSE") ans <- extractAlignmentRangesOnReference(x@cigar, x@start, drop.D.ranges=drop.D.ranges) if (order.as.in.query) ans <- revElements(ans, strand(x) == "-") names(ans) <- names(x) if (use.mcols) mcols(ans) <- mcols(x) ans } ) setMethod("ranges", "GAlignments", function(x) IRanges(start=start(x), width=width(x), names=names(x)) ) setAs("GAlignments", "GRangesList", function(from) grglist(from, use.mcols=TRUE) ) setAs("GAlignments", "GRanges", function(from) granges(from, use.mcols=TRUE)) setAs("GAlignments", "RangesList", function(from) rglist(from, use.mcols=TRUE)) setAs("GAlignments", "Ranges", function(from) ranges(from)) setMethod("as.data.frame", "GAlignments", function(x, row.names=NULL, optional=FALSE, ...) { if (is.null(row.names)) row.names <- names(x) else if (!is.character(row.names)) stop("'row.names' must be NULL or a character vector") ans <- data.frame(seqnames=as.character(seqnames(x)), strand=as.character(strand(x)), cigar=cigar(x), qwidth=qwidth(x), start=start(x), end=end(x), width=width(x), njunc=njunc(x), row.names=row.names, check.rows=TRUE, check.names=FALSE, stringsAsFactors=FALSE) if (ncol(mcols(x))) ans <- cbind(ans, as.data.frame(mcols(x))) return(ans) } ) setAs("GenomicRanges", "GAlignments", function(from) { ga <- GAlignments(seqnames(from), start(from), if (!is.null(mcols(from)[["cigar"]])) mcols(from)[["cigar"]] else paste0(width(from), "M"), strand(from), if (!is.null(names(from))) names(from) else mcols(from)$name, seqlengths(from), mcols(from)[setdiff(colnames(mcols(from)), c("cigar", "name"))]) metadata(ga) <- metadata(from) seqinfo(ga) <- seqinfo(from) ga }) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Subsetting. ### setMethod("extractROWS", "GAlignments", function(x, i) { i <- normalizeSingleBracketSubscript(i, x, as.NSBS=TRUE) ans_NAMES <- extractROWS(x@NAMES, i) ans_seqnames <- extractROWS(x@seqnames, i) ans_start <- extractROWS(x@start, i) ans_cigar <- extractROWS(x@cigar, i) ans_strand <- extractROWS(x@strand, i) ans_elementMetadata <- extractROWS(x@elementMetadata, i) BiocGenerics:::replaceSlots(x, NAMES=ans_NAMES, seqnames=ans_seqnames, start=ans_start, cigar=ans_cigar, strand=ans_strand, elementMetadata=ans_elementMetadata) } ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### "show" method. ### .makeNakedMatFromGAlignments <- function(x) { lx <- length(x) nc <- ncol(mcols(x)) ans <- cbind(seqnames=as.character(seqnames(x)), strand=as.character(strand(x)), cigar=S4Vectors:::sketchStr(cigar(x), 23L), qwidth=qwidth(x), start=start(x), end=end(x), width=width(x), njunc=njunc(x)) if (nc > 0L) { tmp <- do.call(data.frame, lapply(mcols(x), showAsCell)) ans <- cbind(ans, `|`=rep.int("|", lx), as.matrix(tmp)) } ans } showGAlignments <- function(x, margin="", print.classinfo=FALSE, print.seqinfo=FALSE) { lx <- length(x) nc <- ncol(mcols(x)) cat(class(x), " object with ", lx, " ", ifelse(lx == 1L, "alignment", "alignments"), " and ", nc, " metadata ", ifelse(nc == 1L, "column", "columns"), ":\n", sep="") out <- S4Vectors:::makePrettyMatrixForCompactPrinting(x, .makeNakedMatFromGAlignments) if (print.classinfo) { .COL2CLASS <- c( seqnames="Rle", strand="Rle", cigar="character", qwidth="integer", start="integer", end="integer", width="integer", njunc="integer" ) classinfo <- S4Vectors:::makeClassinfoRowForCompactPrinting(x, .COL2CLASS) ## A sanity check, but this should never happen! stopifnot(identical(colnames(classinfo), colnames(out))) out <- rbind(classinfo, out) } if (nrow(out) != 0L) rownames(out) <- paste0(margin, rownames(out)) ## We set 'max' to 'length(out)' to avoid the getOption("max.print") ## limit that would typically be reached when 'showHeadLines' global ## option is set to Inf. print(out, quote=FALSE, right=TRUE, max=length(out)) if (print.seqinfo) { cat(margin, "-------\n", sep="") cat(margin, "seqinfo: ", summary(seqinfo(x)), "\n", sep="") } } setMethod("show", "GAlignments", function(object) showGAlignments(object, margin=" ", print.classinfo=TRUE, print.seqinfo=TRUE) ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Combining and splitting. ### ### 'Class' must be "GAlignments" or the name of a concrete subclass of ### GAlignments. ### 'objects' must be a list of GAlignments objects. ### Returns an instance of class 'Class'. combine_GAlignments_objects <- function(Class, objects, use.names=TRUE, ignore.mcols=FALSE) { if (!isSingleString(Class)) stop("'Class' must be a single character string") if (!extends(Class, "GAlignments")) stop("'Class' must be the name of a class that extends GAlignments") if (!is.list(objects)) stop("'objects' must be a list") if (!isTRUEorFALSE(use.names)) stop("'use.names' must be TRUE or FALSE") ### TODO: Support 'use.names=TRUE'. if (use.names) stop("'use.names=TRUE' is not supported yet") if (!isTRUEorFALSE(ignore.mcols)) stop("'ignore.mcols' must be TRUE or FALSE") if (length(objects) != 0L) { ## TODO: Implement (in C) fast 'elementIsNull(objects)' in IRanges, ## that does 'sapply(objects, is.null, USE.NAMES=FALSE)', and use it ## here. null_idx <- which(sapply(objects, is.null, USE.NAMES=FALSE)) if (length(null_idx) != 0L) objects <- objects[-null_idx] } if (length(objects) == 0L) return(new(Class)) ## TODO: Implement (in C) fast 'elementIs(objects, class)' in IRanges, that ## does 'sapply(objects, is, class, USE.NAMES=FALSE)', and use it here. ## 'elementIs(objects, "NULL")' should work and be equivalent to ## 'elementIsNull(objects)'. if (!all(sapply(objects, is, Class, USE.NAMES=FALSE))) stop("the objects to combine must be ", Class, " objects (or NULLs)") objects_names <- names(objects) names(objects) <- NULL # so lapply(objects, ...) below returns an # unnamed list ## Combine "NAMES" slots. NAMES_slots <- lapply(objects, function(x) x@NAMES) ## TODO: Use elementIsNull() here when it becomes available. has_no_names <- sapply(NAMES_slots, is.null, USE.NAMES=FALSE) if (all(has_no_names)) { ans_NAMES <- NULL } else { noname_idx <- which(has_no_names) if (length(noname_idx) != 0L) NAMES_slots[noname_idx] <- lapply(elementLengths(objects[noname_idx]), character) ans_NAMES <- unlist(NAMES_slots, use.names=FALSE) } ## Combine "seqnames" slots. seqnames_slots <- lapply(objects, function(x) x@seqnames) ## TODO: Implement unlist_list_of_Rle() in IRanges and use it here. ans_seqnames <- do.call(c, seqnames_slots) ## Combine "start" slots. start_slots <- lapply(objects, function(x) x@start) ans_start <- unlist(start_slots, use.names=FALSE) ## Combine "cigar" slots. cigar_slots <- lapply(objects, function(x) x@cigar) ans_cigar <- unlist(cigar_slots, use.names=FALSE) ## Combine "strand" slots. strand_slots <- lapply(objects, function(x) x@strand) ## TODO: Implement unlist_list_of_Rle() in IRanges and use it here. ans_strand <- do.call(c, strand_slots) ## Combine "mcols" slots. We don't need to use fancy ## IRanges:::rbind.mcols() for this because the "mcols" slot of a ## GAlignments object is guaranteed to be a DataFrame. if (ignore.mcols) { ans_mcols <- new("DataFrame", nrows=length(ans_start)) } else { mcols_slots <- lapply(objects, function(x) x@elementMetadata) ## Will fail if not all the GAlignments objects in 'objects' have ## exactly the same metadata cols. ans_mcols <- do.call(rbind, mcols_slots) } ## Combine "seqinfo" slots. seqinfo_slots <- lapply(objects, function(x) x@seqinfo) ans_seqinfo <- do.call(merge, seqinfo_slots) ## Make 'ans' and return it. new(Class, NAMES=ans_NAMES, seqnames=ans_seqnames, start=ans_start, cigar=ans_cigar, strand=ans_strand, elementMetadata=ans_mcols, seqinfo=ans_seqinfo) } setMethod("c", "GAlignments", function (x, ..., ignore.mcols=FALSE, recursive=FALSE) { if (!identical(recursive, FALSE)) stop("\"c\" method for GAlignments objects ", "does not support the 'recursive' argument") if (missing(x)) { objects <- list(...) x <- objects[[1L]] } else { objects <- list(x, ...) } combine_GAlignments_objects(class(x), objects, use.names=FALSE, ignore.mcols=ignore.mcols) } ) GenomicAlignments/R/GAlignmentsList-class.R0000644000175100017510000002356212607264575021716 0ustar00biocbuildbiocbuild### ========================================================================= ### GAlignmentsList objects ### ------------------------------------------------------------------------- ### setClass("GAlignmentsList", contains="CompressedList", representation( unlistData="GAlignments", elementMetadata="DataFrame" ), prototype( elementType="GAlignments" ) ) ### Formal API: ### names(x) - NULL or character vector. ### length(x) - single integer. Nb of alignments in 'x'. ### seqnames(x) - 'factor' Rle of the same length as 'x'. ### rname(x) - same as 'seqnames(x)'. ### seqnames(x) <- value - replacement form of 'seqnames(x)'. ### rname(x) <- value - same as 'seqnames(x) <- value'. ### cigar(x) - character vector of the same length as 'x'. ### strand(x) - 'factor' Rle of the same length as 'x' (levels: +, -, *). ### qwidth(x) - integer vector of the same length as 'x'. ### start(x), end(x), width(x) - integer vectors of the same length as 'x'. ### njunc(x) - integer vector of the same length as 'x'. ### grglist(x) - GRangesList object of the same length as 'x'. ### granges(x) - GRanges object of the same length as 'x'. ### rglist(x) - CompressedIRangesList object of the same length as 'x'. ### ranges(x) - IRanges object of the same length as 'x'. ### show(x) - compact display in a data.frame-like fashion. ### GAlignmentsList(x, ...) - constructor. ### x[i] - GAlignmentsList object of the same class as 'x' ### (endomorphism). ### ### findOverlaps(query, subject) - 'query' or 'subject' or both are ### GAlignments objects. Just a convenient wrapper for ### 'findOverlaps(grglist(query), subject, ...)', etc... ### ### countOverlaps(query, subject) - 'query' or 'subject' or both are ### GAlignments objects. Just a convenient wrapper for ### 'countOverlaps(grglist(query), subject, ...)', etc... ### ### subsetByOverlaps(query, subject) - 'query' or 'subject' or both are ### GAlignments objects. ### ### qnarrow(x, start=NA, end=NA, width=NA) - GAlignmentsList object of the ### same length and class as 'x' (endomorphism). ### ### narrow(x, start=NA, end=NA, width=NA) - GAlignmentsList object of the ### same length and class as 'x' (endomorphism). ### ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Getters. ### setMethod("seqnames", "GAlignmentsList", function(x) relist(seqnames(unlist(x, use.names=FALSE)), x) ) setMethod("rname", "GAlignmentsList", function(x) relist(rname(unlist(x, use.names=FALSE)), x) ) setMethod("cigar", "GAlignmentsList", function(x) relist(cigar(unlist(x, use.names=FALSE)), x) ) setMethod("strand", "GAlignmentsList", function(x) relist(strand(unlist(x, use.names=FALSE)), x) ) setMethod("qwidth", "GAlignmentsList", function(x) relist(qwidth(unlist(x, use.names=FALSE)), x) ) setMethod("njunc", "GAlignmentsList", function(x) relist(njunc(unlist(x, use.names=FALSE)), x) ) setMethod("start", "GAlignmentsList", function(x, ...) relist(start(unlist(x, use.names=FALSE), ...), x) ) setMethod("end", "GAlignmentsList", function(x, ...) relist(end(unlist(x, use.names=FALSE), ...), x) ) setMethod("width", "GAlignmentsList", function(x) relist(width(unlist(x, use.names=FALSE)), x) ) setMethod("seqinfo", "GAlignmentsList", function(x) seqinfo(unlist(x, use.names=FALSE)) ) setMethod("elementMetadata", "GAlignmentsList", GenomicRanges:::getElementMetadataList ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Setters. ### setReplaceMethod("rname", "GAlignmentsList", function(x, value) `seqnames<-`(x, value) ) setReplaceMethod("elementMetadata", "GAlignmentsList", GenomicRanges:::replaceElementMetadataList ) setReplaceMethod("strand", "GAlignmentsList", GenomicRanges:::replaceStrandList ) setReplaceMethod("strand", c("GAlignmentsList", "character"), function(x, ..., value) { if (length(value) > 1L) stop("length(value) must be 1") strand(x@unlistData) <- value x } ) setReplaceMethod("seqinfo", "GAlignmentsList", GenomicRanges:::replaceSeqinfoList ) setReplaceMethod("seqnames", "GAlignmentsList", GenomicRanges:::replaceSeqnamesList ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Validity. ### .valid.GAlignmentsList <- function(x) { ## TDB: Currently known pitfalls are caught by ## GAlignments validity. } setValidity2("GAlignmentsList", .valid.GAlignmentsList) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Constructors. ### GAlignmentsList <- function(...) { listData <- list(...) if (length(listData) == 0L) { unlistData <- GAlignments() } else { if (length(listData) == 1L && is.list(listData[[1L]])) listData <- listData[[1L]] if (!all(sapply(listData, is, "GAlignments"))) stop("all elements in '...' must be GAlignments objects") unlistData <- suppressWarnings(do.call("c", unname(listData))) } relist(unlistData, PartitioningByEnd(listData)) } setMethod("updateObject", "GAlignmentsList", function(object, ..., verbose=FALSE) { if (verbose) message("updateObject(object = 'GAlignmentsList')") if (is(try(validObject(object@unlistData, complete=TRUE), silent=TRUE), "try-error")) { object@unlistData <- updateObject(object@unlistData) return(object) } object } ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Coercion. ### setMethod("grglist", "GAlignmentsList", function(x, use.mcols=FALSE, order.as.in.query=FALSE, drop.D.ranges=FALSE, ignore.strand=FALSE) { if (!isTRUEorFALSE(use.mcols)) stop("'use.mcols' must be TRUE or FALSE") if (!identical(order.as.in.query, FALSE)) { msg <- c("Starting with BioC 3.2, the 'order.as.in.query' ", "argument of the \"grglist\" method for ", "GAlignmentsList objects is deprecated and ignored.") .Deprecated(msg=wmsg(msg)) } if (!isTRUEorFALSE(ignore.strand)) stop("'ignore.strand' must be TRUE or FALSE") if (ignore.strand) strand(x@unlistData) <- "*" unlisted_x <- unlist(x, use.names=FALSE) grl <- grglist(unlisted_x, drop.D.ranges=drop.D.ranges) ans <- IRanges:::regroupBySupergroup(grl, x) if (use.mcols) mcols(ans) <- mcols(x) ans } ) setMethod("granges", "GAlignmentsList", function(x, use.mcols=FALSE, ignore.strand=FALSE) { if (!isTRUEorFALSE(use.mcols)) stop("'use.mcols' must be TRUE or FALSE") if (ignore.strand) strand(x@unlistData) <- "*" msg <- paste0("For some list elements in 'x', the ranges are ", "not aligned to the same chromosome and strand. ", "Cannot extract a single range for them. ", "As a consequence, the returned GRanges object ", "is not parallel to 'x'.") rg <- range(grglist(x, ignore.strand=ignore.strand)) is_one_to_one <- all(elementLengths(rg) == 1L) if (!is_one_to_one && all(width(x@partitioning) > 0)) { if (ignore.strand) warning(msg) else warning(paste0(msg, " Consider using 'ignore.strand=TRUE'.")) } ans <- unlist(rg) if (is_one_to_one && use.mcols) mcols(ans) <- mcols(x) ans } ) setMethod("rglist", "GAlignmentsList", function(x, use.mcols=FALSE, order.as.in.query=FALSE, drop.D.ranges=FALSE) { if (!isTRUEorFALSE(use.mcols)) stop("'use.mcols' must be TRUE or FALSE") if (!identical(order.as.in.query, FALSE)) { msg <- c("Starting with BioC 3.2, the 'order.as.in.query' ", "argument of the \"rglist\" method for ", "GAlignmentsList objects is deprecated and ignored.") .Deprecated(msg=wmsg(msg)) } unlisted_x <- unlist(x, use.names=FALSE) rgl <- rglist(unlisted_x, drop.D.ranges=drop.D.ranges) ans <- IRanges:::regroupBySupergroup(rgl, x) if (use.mcols) mcols(ans) <- mcols(x) ans } ) setMethod("ranges", "GAlignmentsList", function(x) unlist(range(rglist(x)), use.names=FALSE) ) setAs("GAlignmentsList", "GRangesList", function(from) grglist(from, use.mcols=TRUE) ) setAs("GAlignmentsList", "GRanges", function(from) granges(from, use.mcols=TRUE) ) setAs("GAlignmentsList", "RangesList", function(from) rglist(from, use.mcols=TRUE) ) setAs("GAlignmentsList", "Ranges", function(from) ranges(from) ) setAs("GAlignmentPairs", "GAlignmentsList", function(from) { if (length(from) == 0L) pbe <- PartitioningByEnd() else pbe <- PartitioningByEnd(seq(2, 2*length(from), 2), names=names(from)) new("GAlignmentsList", unlistData=unlist(from, use.names=FALSE), partitioning=pbe) } ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Subsetting. ### ## "[", "[<-" and "[[", "[[<-" from CompressedList ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Going from GAlignments to GAlignmentsList with extractList() and family. ### setMethod("relistToClass", "GAlignments", function(x) "GAlignmentsList" ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### show method. ### setMethod("show", "GAlignmentsList", function(object) GenomicRanges:::showList(object, showGAlignments, FALSE) ) GenomicAlignments/R/GappedReads-class.R0000644000175100017510000000517512607264575021031 0ustar00biocbuildbiocbuild### ========================================================================= ### GappedReads objects ### ------------------------------------------------------------------------- ### setClass("GappedReads", contains="GAlignments", representation( qseq="DNAStringSet" ## TODO: Maybe add the read quality? mismatch information? ) ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Getters. ### setGeneric("qseq", function(x) standardGeneric("qseq")) setMethod("qseq", "GappedReads", function(x) x@qseq) ### Overriding "qwidth" method for GAlignments objects with a faster ### method. setMethod("qwidth", "GappedReads", function(x) width(qseq(x))) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Validity. ### .valid.GappedReads.qseq <- function(x) { x_qseq <- qseq(x) if (class(x_qseq) != "DNAStringSet" || !is.null(names(x_qseq))) return("'qseq(x)' must be an unnamed DNAStringSet instance") if (length(x_qseq) != length(cigar(x))) return("'qseq(x)' and 'cigar(x)' must have the same length") if (!identical(width(x_qseq), cigarWidthAlongQuerySpace(cigar(x)))) return(paste("'width(qseq(x))' and", "'cigarWidthAlongQuerySpace(cigar(x))'", "must be identical")) NULL } .valid.GappedReads <- function(x) { .valid.GappedReads.qseq(x) } setValidity2("GappedReads", .valid.GappedReads, where=asNamespace("GenomicAlignments")) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Constructor. ### GappedReads <- function(seqnames=Rle(factor()), pos=integer(0), cigar=character(0), strand=NULL, qseq=DNAStringSet(), names=NULL, seqlengths=NULL) { galn <- GAlignments(seqnames=seqnames, pos=pos, cigar=cigar, strand=strand, names=names, seqlengths=seqlengths) new("GappedReads", galn, qseq=qseq) } ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Subsetting. ### setMethod("extractROWS", "GappedReads", function(x, i) { i <- normalizeSingleBracketSubscript(i, x, as.NSBS=TRUE) x@qseq <- extractROWS(x@qseq, i) callNextMethod() } ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### The "show" method. ### ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Combining. ### setMethod("c", "GappedReads", function (x, ..., recursive = FALSE) { stop("coming soon") } ) GenomicAlignments/R/OverlapEncodings-class.R0000644000175100017510000002247612607264575022117 0ustar00biocbuildbiocbuild### ========================================================================= ### OverlapEncodings objects ### ------------------------------------------------------------------------- ### setClass("OverlapEncodings", contains="Vector", representation( Loffset="integer", # no NAs, >= 0 Roffset="integer", # no NAs, >= 0 encoding="factor", # no NAs flippedQuery="logical" # no NAs ) ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Slot getters. ### setGeneric("Loffset", function(x) standardGeneric("Loffset")) setMethod("Loffset", "OverlapEncodings", function(x) x@Loffset) setGeneric("Roffset", function(x) standardGeneric("Roffset")) setMethod("Roffset", "OverlapEncodings", function(x) x@Roffset) ### encoding() generic is defined in Biostrings. setMethod("encoding", "OverlapEncodings", function(x) x@encoding) ### S3/S4 combo for levels.OverlapEncodings levels.OverlapEncodings <- function(x) levels(encoding(x)) setMethod("levels", "OverlapEncodings", levels.OverlapEncodings) setGeneric("flippedQuery", function(x) standardGeneric("flippedQuery")) setMethod("flippedQuery", "OverlapEncodings", function(x) x@flippedQuery) setMethod("length", "OverlapEncodings", function(x) length(encoding(x))) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### The Lencoding() and Rencoding() getters. ### .extract_LRencoding_from_encoding_levels <- function(x, L.or.R) { if (!is.character(x)) stop("'x' must be a character vector") if (length(x) == 0L) return(character(0)) encoding_blocks <- strsplit(x, ":", fixed=TRUE) nblock <- elementLengths(encoding_blocks) tmp <- strsplit(unlist(encoding_blocks, use.names=FALSE), "--", fixed=TRUE) tmp_elt_lens <- elementLengths(tmp) tmp_is_single_end <- tmp_elt_lens == 1L tmp_is_paired_end <- tmp_elt_lens == 2L nblock1 <- sum(LogicalList(relist(tmp_is_single_end, encoding_blocks))) nblock2 <- sum(LogicalList(relist(tmp_is_paired_end, encoding_blocks))) is_single_end_encoding <- nblock1 == nblock is_paired_end_encoding <- nblock2 == nblock if (!all(is_single_end_encoding | nblock1 == 0L) || !all(is_paired_end_encoding | nblock2 == 0L) || !all(is_single_end_encoding | is_paired_end_encoding)) stop("'x' contains ill-formed encodings") any_single_end <- any(is_single_end_encoding) any_paired_end <- any(is_paired_end_encoding) if (any_single_end && any_paired_end) warning("'x' contains a mix of single-end and paired-end encodings") ans <- character(length(x)) ans[] <- NA_character_ if (any_paired_end) { tmp2 <- unlist(tmp[tmp_is_paired_end], use.names=FALSE) encodings_blocks2 <- encoding_blocks[is_paired_end_encoding] if (identical(L.or.R, "L")) { tmp2 <- tmp2[c(TRUE, FALSE)] } else if (identical(L.or.R, "R")) { tmp2 <- tmp2[c(FALSE, TRUE)] } else { stop("invalid supplied 'L.or.R' argument") } ans2 <- sapply(relist(tmp2, encodings_blocks2), function(blocks) paste(blocks, collapse=":")) ans[is_paired_end_encoding] <- paste(ans2, ":", sep="") } ans } setGeneric("Lencoding", function(x) standardGeneric("Lencoding")) setGeneric("Rencoding", function(x) standardGeneric("Rencoding")) setMethod("Lencoding", "character", function(x) .extract_LRencoding_from_encoding_levels(x, L.or.R="L") ) setMethod("Rencoding", "character", function(x) .extract_LRencoding_from_encoding_levels(x, L.or.R="R") ) setMethod("Lencoding", "factor", function(x) { levels_Lencoding <- Lencoding(levels(x)) factor(levels_Lencoding)[as.integer(x)] } ) setMethod("Rencoding", "factor", function(x) { levels_Rencoding <- Rencoding(levels(x)) factor(levels_Rencoding)[as.integer(x)] } ) setMethod("Lencoding", "OverlapEncodings", function(x) Lencoding(encoding(x))) setMethod("Rencoding", "OverlapEncodings", function(x) Rencoding(encoding(x))) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### The njunc(), Lnjunc(), and Rnjunc() getters. ### .extract_njunc_from_encoding_levels <- function(x, L.or.R=NA) { if (!is.character(x)) stop("'x' must be a character vector") if (length(x) == 0L) return(integer(0)) tmp <- strsplit(sub(":.*", "", x), "--", fixed=TRUE) elt_lens <- elementLengths(tmp) is_single_end_encoding <- elt_lens == 1L is_paired_end_encoding <- elt_lens == 2L if (!all(is_single_end_encoding | is_paired_end_encoding)) stop("'x' contains ill-formed encodings") any_single_end <- any(is_single_end_encoding) any_paired_end <- any(is_paired_end_encoding) if (any_single_end && any_paired_end) warning("'x' contains a mix of single-end and paired-end encodings") ans <- integer(length(x)) if (any_single_end) { if (identical(L.or.R, NA)) { tmp1 <- tmp[is_single_end_encoding] njunc1 <- suppressWarnings( as.integer(unlist(tmp1, use.names=FALSE)) ) if (any(is.na(njunc1))) stop("'x' contains ill-formed encodings") njunc1 <- njunc1 - 1L if (min(njunc1) < 0L) warning("some encodings in 'x' have a negative number ", "of junctions") } else { njunc1 <- NA_integer_ } ans[is_single_end_encoding] <- njunc1 } if (any_paired_end) { tmp2 <- tmp[is_paired_end_encoding] njunc2 <- suppressWarnings(as.integer(unlist(tmp2, use.names=FALSE))) if (any(is.na(njunc2))) stop("'x' contains ill-formed encodings") njunc2 <- njunc2 - 1L if (min(njunc2) < 0L) warning("some encodings in 'x' have a negative number ", "of junctions") Lnjunc2 <- njunc2[c(TRUE, FALSE)] Rnjunc2 <- njunc2[c(FALSE, TRUE)] if (identical(L.or.R, NA)) { njunc2 <- Lnjunc2 + Rnjunc2 } else if (identical(L.or.R, "L")) { njunc2 <- Lnjunc2 } else if (identical(L.or.R, "R")) { njunc2 <- Rnjunc2 } else { stop("invalid supplied 'L.or.R' argument") } ans[is_paired_end_encoding] <- njunc2 } ans } setGeneric("Lnjunc", function(x) standardGeneric("Lnjunc")) setGeneric("Rnjunc", function(x) standardGeneric("Rnjunc")) setMethod("njunc", "character", function(x) .extract_njunc_from_encoding_levels(x) ) setMethod("Lnjunc", "character", function(x) .extract_njunc_from_encoding_levels(x, L.or.R="L") ) setMethod("Rnjunc", "character", function(x) .extract_njunc_from_encoding_levels(x, L.or.R="R") ) setMethod("njunc", "factor", function(x) { levels_njunc <- njunc(levels(x)) levels_njunc[as.integer(x)] } ) setMethod("Lnjunc", "factor", function(x) { levels_Lnjunc <- Lnjunc(levels(x)) levels_Lnjunc[as.integer(x)] } ) setMethod("Rnjunc", "factor", function(x) { levels_Rnjunc <- Rnjunc(levels(x)) levels_Rnjunc[as.integer(x)] } ) setMethod("njunc", "OverlapEncodings", function(x) njunc(encoding(x))) setMethod("Lnjunc", "OverlapEncodings", function(x) Lnjunc(encoding(x))) setMethod("Rnjunc", "OverlapEncodings", function(x) Rnjunc(encoding(x))) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Coercion. ### ### S3/S4 combo for as.data.frame.OverlapEncodings as.data.frame.OverlapEncodings <- function(x, row.names=NULL, optional=FALSE, ...) { if (!(is.null(row.names) || is.character(row.names))) stop("'row.names' must be NULL or a character vector") data.frame(Loffset=Loffset(x), Roffset=Roffset(x), encoding=encoding(x), flippedQuery=flippedQuery(x), row.names=row.names, check.rows=TRUE, check.names=FALSE, stringsAsFactors=FALSE) } setMethod("as.data.frame", "OverlapEncodings", as.data.frame.OverlapEncodings) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### "show" method. ### setMethod("show", "OverlapEncodings", function(object) { lo <- length(object) cat(class(object), " object of length ", lo, "\n", sep="") if (lo == 0L) return(NULL) if (lo < 20L) { showme <- as.data.frame(object, row.names=paste("[", seq_len(lo), "]", sep="")) } else { sketch <- function(x) c(as.character(head(x, n=9L)), "...", as.character(tail(x, n=9L))) showme <- data.frame(Loffset=sketch(Loffset(object)), Roffset=sketch(Roffset(object)), encoding=sketch(encoding(object)), flippedQuery=sketch(flippedQuery(object)), row.names=c(paste("[", 1:9, "]", sep=""), "...", paste("[", (lo-8L):lo, "]", sep="")), check.rows=TRUE, check.names=FALSE, stringsAsFactors=FALSE) } show(showme) } ) GenomicAlignments/R/cigar-utils.R0000644000175100017510000002673312607264575017775 0ustar00biocbuildbiocbuild### ========================================================================= ### Low-level CIGAR utilities ### ------------------------------------------------------------------------- ### See p. 4 of the SAM Spec v1.4 at http://samtools.sourceforge.net/ for the ### list of CIGAR operations and their meanings. CIGAR_OPS <- c("M", "I", "D", "N", "S", "H", "P", "=", "X") .normarg_cigar <- function(cigar) { if (is.factor(cigar)) cigar <- as.character(cigar) if (!is.character(cigar)) stop("'cigar' must be a character vector or factor") cigar } .normarg_flag <- function(flag, cigar) { if (!is.null(flag)) { if (!is.numeric(flag)) stop("'flag' must be NULL or a vector of integers") if (!is.integer(flag)) flag <- as.integer(flag) if (length(cigar) != length(flag)) stop("'cigar' and 'flag' must have the same length") } flag } .normarg_pos <- function(pos, cigar) { if (!is.numeric(pos)) stop("'pos' must be a vector of integers") if (!is.integer(pos)) pos <- as.integer(pos) if (length(pos) != 1L && length(pos) != length(cigar)) stop("'pos' must have length 1 or the same length as 'cigar'") pos } .select_reference_space <- function(N.regions.removed) { if (!isTRUEorFALSE(N.regions.removed)) stop("'N.regions.removed' must be TRUE or FALSE") if (N.regions.removed) { space <- 2L # REFERENCE_N_REGIONS_REMOVED } else { space <- 1L # REFERENCE } space } .select_query_space <- function(before.hard.clipping, after.soft.clipping) { if (!isTRUEorFALSE(before.hard.clipping)) stop("'before.hard.clipping' must be TRUE or FALSE") if (!isTRUEorFALSE(after.soft.clipping)) stop("'after.soft.clipping' must be TRUE or FALSE") if (before.hard.clipping) { if (after.soft.clipping) stop("'before.hard.clipping' and 'after.soft.clipping' ", "cannot both be TRUE") space <- 4L # QUERY_BEFORE_HARD_CLIPPING } else if (after.soft.clipping) { space <- 5L # QUERY_AFTER_SOFT_CLIPPING } else { space <- 3L # QUERY } space } .select_pairwise_space <- function(N.regions.removed, dense) { if (!isTRUEorFALSE(N.regions.removed)) stop("'N.regions.removed' must be TRUE or FALSE") if (!isTRUEorFALSE(dense)) stop("'dense' must be TRUE or FALSE") if (N.regions.removed) { if (dense) stop("'N.regions.removed' and 'dense' ", "cannot both be TRUE") space <- 7L # PAIRWISE_N_REGIONS_REMOVED } else if (dense) { space <- 8L # PAIRWISE_DENSE } else { space <- 6L # PAIRWISE } space } .normarg_ops <- function(ops) { if (is.null(ops)) return(ops) if (!is.character(ops)) stop("'ops' must be a character vector") if (any(is.na(ops))) stop("'ops' cannot contain NAs") if (length(ops) == 1L) { ops <- strsplit(ops, NULL, fixed=TRUE)[[1L]] } else if (any(nchar(ops) != 1L)) { stop("when 'length(ops) != 1', all its elements ", "must be single letters") } if (anyDuplicated(ops)) stop("'ops' cannot contain duplicated letters") if (!all(ops %in% CIGAR_OPS)) stop("'ops' contains invalid CIGAR operations") ops } validCigar <- function(cigar) { cigar <- .normarg_cigar(cigar) .Call2("valid_cigar", cigar, 0L, PACKAGE="GenomicAlignments") } ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Transform CIGARs into other useful representations ### explodeCigarOps <- function(cigar, ops=CIGAR_OPS) { cigar <- .normarg_cigar(cigar) ops <- .normarg_ops(ops) .Call2("explode_cigar_ops", cigar, ops, PACKAGE="GenomicAlignments") } explodeCigarOpLengths <- function(cigar, ops=CIGAR_OPS) { cigar <- .normarg_cigar(cigar) ops <- .normarg_ops(ops) .Call2("explode_cigar_op_lengths", cigar, ops, PACKAGE="GenomicAlignments") } cigarToRleList <- function(cigar) { cigar_ops <- explodeCigarOps(cigar) cigar_op_lengths <- explodeCigarOpLengths(cigar) if (length(cigar) == 0L) { unlisted_cigar_ops <- character(0) unlisted_cigar_op_lengths <- integer(0) } else { unlisted_cigar_ops <- unlist(cigar_ops, use.names=FALSE) unlisted_cigar_op_lengths <- unlist(cigar_op_lengths, use.names=FALSE) } ## Prepare 'ans_flesh'. ans_flesh <- Rle(unlisted_cigar_ops, unlisted_cigar_op_lengths) ## Prepare 'ans_skeleton'. nops_per_cigar <- elementLengths(cigar_op_lengths) ans_breakpoints <- cumsum(unlisted_cigar_op_lengths)[cumsum(nops_per_cigar)] ans_skeleton <- PartitioningByEnd(ans_breakpoints) ## Relist. relist(ans_flesh, ans_skeleton) } ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Summarize CIGARs ### cigarOpTable <- function(cigar) { cigar <- .normarg_cigar(cigar) ans <- .Call2("cigar_op_table", cigar, PACKAGE="GenomicAlignments") stopifnot(identical(CIGAR_OPS, colnames(ans))) # sanity check ans } ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### From CIGARs to ranges ### .cigar_ranges <- function(cigar, flag, space, pos, f, ops, drop.empty.ranges, reduce.ranges, with.ops) { cigar <- .normarg_cigar(cigar) flag <- .normarg_flag(flag, cigar) if (!isSingleNumber(space)) stop("'space' must be a single integer") if (!is.integer(space)) space <- as.integer(space) pos <- .normarg_pos(pos, cigar) if (!is.null(f)) { if (!is.factor(f)) stop("'f' must be NULL or a factor") if (length(f) != length(cigar)) stop("'f' must have the same length as 'cigar'") } ops <- .normarg_ops(ops) if (!isTRUEorFALSE(drop.empty.ranges)) stop("'drop.empty.ranges' must be TRUE or FALSE") if (!isTRUEorFALSE(reduce.ranges)) stop("'reduce.ranges' must be TRUE or FALSE") if (!isTRUEorFALSE(with.ops)) stop("'with.ops' must be TRUE or FALSE") .Call2("cigar_ranges", cigar, flag, space, pos, f, ops, drop.empty.ranges, reduce.ranges, with.ops, PACKAGE="GenomicAlignments") } cigarRangesAlongReferenceSpace <- function(cigar, flag=NULL, N.regions.removed=FALSE, pos=1L, f=NULL, ops=CIGAR_OPS, drop.empty.ranges=FALSE, reduce.ranges=FALSE, with.ops=FALSE) { space <- .select_reference_space(N.regions.removed) C_ans <- .cigar_ranges(cigar, flag, space, pos, f, ops, drop.empty.ranges, reduce.ranges, with.ops) if (is.null(f)) return(C_ans) compress <- length(C_ans) >= 200L IRangesList(C_ans, compress=compress) } cigarRangesAlongQuerySpace <- function(cigar, flag=NULL, before.hard.clipping=FALSE, after.soft.clipping=FALSE, ops=CIGAR_OPS, drop.empty.ranges=FALSE, reduce.ranges=FALSE, with.ops=FALSE) { space <- .select_query_space(before.hard.clipping, after.soft.clipping) .cigar_ranges(cigar, flag, space, 1L, NULL, ops, drop.empty.ranges, reduce.ranges, with.ops) } cigarRangesAlongPairwiseSpace <- function(cigar, flag=NULL, N.regions.removed=FALSE, dense=FALSE, ops=CIGAR_OPS, drop.empty.ranges=FALSE, reduce.ranges=FALSE, with.ops=FALSE) { space <- .select_pairwise_space(N.regions.removed, dense) .cigar_ranges(cigar, flag, space, 1L, NULL, ops, drop.empty.ranges, reduce.ranges, with.ops) } ### A convenience wrapper to cigarRangesAlongReferenceSpace(). extractAlignmentRangesOnReference <- function(cigar, pos=1L, drop.D.ranges=FALSE, f=NULL) { if (!isTRUEorFALSE(drop.D.ranges)) stop("'drop.D.ranges' must be TRUE or FALSE") ## Not sure why we include "I" operations here since they don't generate ## coverage on the reference (they always produce zero-width ranges on the ## reference). if (drop.D.ranges) { ops <- c("M", "=", "X", "I") } else { ops <- c("M", "=", "X", "I", "D") } cigarRangesAlongReferenceSpace(cigar, flag=NULL, pos=pos, f=f, ops=ops, drop.empty.ranges=FALSE, reduce.ranges=TRUE) } ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### From CIGARs to sequence lengths ### .cigar_width <- function(cigar, flag, space) { cigar <- .normarg_cigar(cigar) flag <- .normarg_flag(flag, cigar) if (!isSingleNumber(space)) stop("'space' must be a single integer") if (!is.integer(space)) space <- as.integer(space) .Call2("cigar_width", cigar, flag, space, PACKAGE="GenomicAlignments") } cigarWidthAlongReferenceSpace <- function(cigar, flag=NULL, N.regions.removed=FALSE) { space <- .select_reference_space(N.regions.removed) .cigar_width(cigar, flag, space) } cigarWidthAlongQuerySpace <- function(cigar, flag=NULL, before.hard.clipping=FALSE, after.soft.clipping=FALSE) { space <- .select_query_space(before.hard.clipping, after.soft.clipping) .cigar_width(cigar, flag, space) } cigarWidthAlongPairwiseSpace <- function(cigar, flag=NULL, N.regions.removed=FALSE, dense=FALSE) { space <- .select_pairwise_space(N.regions.removed, dense) .cigar_width(cigar, flag, space) } ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Narrow CIGARs ### cigarNarrow <- function(cigar, start=NA, end=NA, width=NA) { cigar_width <- cigarWidthAlongReferenceSpace(cigar) cigar_ranges <- IRanges(start=rep.int(1L, length(cigar_width)), width=cigar_width) threeranges <- threebands(cigar_ranges, start=start, end=end, width=width) C_ans <- .Call2("cigar_narrow", cigar, width(threeranges$left), width(threeranges$right), PACKAGE="GenomicAlignments") ans <- C_ans[[1L]] attr(ans, "rshift") <- C_ans[[2L]] ans } cigarQNarrow <- function(cigar, start=NA, end=NA, width=NA) { cigar_qwidth <- cigarWidthAlongQuerySpace(cigar) cigar_qranges <- IRanges(start=rep.int(1L, length(cigar_qwidth)), width=cigar_qwidth) threeranges <- threebands(cigar_qranges, start=start, end=end, width=width) C_ans <- .Call2("cigar_qnarrow", cigar, width(threeranges$left), width(threeranges$right), PACKAGE="GenomicAlignments") ans <- C_ans[[1L]] attr(ans, "rshift") <- C_ans[[2L]] ans } ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Translate coordinates between query-based and reference-based ### queryLoc2refLoc <- function(qloc, cigar, pos=1L) { stop("NOT IMPLEMENTED YET, SORRY!") } queryLocs2refLocs <- function(qlocs, cigar, pos=1L, flag=NULL) { stop("NOT IMPLEMENTED YET, SORRY!") } GenomicAlignments/R/coordinate-mapping-methods.R0000644000175100017510000001264612607264575022771 0ustar00biocbuildbiocbuild### ========================================================================= ### coordinate mapping methods ### ------------------------------------------------------------------------- ### ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Generics ### setGeneric("mapToAlignments", signature=c("x", "alignments"), function(x, alignments, ...) standardGeneric("mapToAlignments") ) setGeneric("pmapToAlignments", signature=c("x", "alignments"), function(x, alignments, ...) standardGeneric("pmapToAlignments") ) setGeneric("mapFromAlignments", signature=c("x", "alignments"), function(x, alignments, ...) standardGeneric("mapFromAlignments") ) setGeneric("pmapFromAlignments", signature=c("x", "alignments"), function(x, alignments, ...) standardGeneric("pmapFromAlignments") ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### mapToAlignments() and mapFromAlignments() methods ### .mapFromAlignments <- function(x, alignments) { if (!length(x) && !length(alignments)) return(GRanges(xHits=integer(), transcriptsHits=integer())) if (is.null(xNames <- names(x)) || is.null(alignmentsNames <- names(alignments))) stop ("both 'x' and 'alignments' must have names") ## name matching determines pairs match0 <- match(alignmentsNames, alignmentsNames) match1 <- match(xNames, alignmentsNames) group0 <- splitAsList(seq_along(alignmentsNames), match0) group1 <- group0[match(na.omit(match1), names(group0))] xHits <- rep(which(!is.na(match1)), elementLengths(group1)) alignmentsHits <- unlist(group1, use.names=FALSE) if (!length(xHits <- na.omit(xHits))) stop ("none of 'names(x)' are in 'names(alignments)'") x <- x[xHits] alignments <- alignments[alignmentsHits] s <- .Call("query_locs_to_ref_locs", start(x), cigar(alignments), start(alignments), FALSE) e <- .Call("query_locs_to_ref_locs", end(x), cigar(alignments), start(alignments), TRUE) e <- pmax(e, s - 1L) ## remove non-hits keep <- !is.na(s) & !is.na(e) seqname <- as.character(seqnames(alignments)) GRanges(Rle(seqname[keep]), IRanges(s[keep], e[keep], names=names(x)[keep]), xHits=xHits[keep], alignmentsHits=alignmentsHits[keep]) } .mapToAlignments <- function(x, alignments) { if (!length(x) && !length(alignments)) return(GRanges(xHits=integer(), transcriptsHits=integer())) if (is.null(names(alignments))) stop ("'alignments' must have names") ## map all possible pairs; returns hits only map <- .Call("map_ref_locs_to_query_locs", start(x), end(x), cigar(alignments), start(alignments)) xHits <- map[[3]] alignmentsHits <- map[[4]] if (length(xHits)) GRanges(Rle(names(alignments)[alignmentsHits]), IRanges(map[[1]], pmax(map[[2]], map[[1]] - 1L), names=names(x)[xHits]), strand="*", xHits, alignmentsHits) else GRanges(xHits=integer(), transcriptsHits=integer()) } setMethod("mapToAlignments", c("Ranges", "GAlignments"), function(x, alignments, ...) ranges(.mapToAlignments(x, alignments)) ) setMethod("mapToAlignments", c("GenomicRanges", "GAlignments"), function(x, alignments, ...) .mapToAlignments(x, alignments) ) setMethod("mapFromAlignments", c("Ranges", "GAlignments"), function(x, alignments, ...) ranges(.mapFromAlignments(x, alignments)) ) setMethod("mapFromAlignments", c("GenomicRanges", "GAlignments"), function(x, alignments, ...) .mapFromAlignments(x, alignments) ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### pmapToAlignments() and pmapFromAlignments() methods ### .pmapAlignments <- function(x, alignments, reverse) { if (length(x) && length(alignments)) { if (length(x) != length(alignments)) stop("'x' and 'alignments' must have the same length") if (reverse) { FUN <- "query_locs_to_ref_locs" seqname <- as.character(seqnames(alignments)) } else { if (is.null(names(alignments))) stop ("'alignments' must have names") FUN <- "ref_locs_to_query_locs" seqname <- names(alignments) } s <- .Call(FUN, start(x), cigar(alignments), start(alignments), FALSE) e <- .Call(FUN, end(x), cigar(alignments), start(alignments), TRUE) e <- pmax(e, s - 1L) ## non-hits if (any(skip <- is.na(s) | is.na(e))) { s[skip] <- 0L e[skip] <- -1L seqname[skip] <- "UNMAPPED" } GRanges(Rle(seqname), IRanges(s, e, names=names(x))) } else { GRanges() } } setMethod("pmapToAlignments", c("Ranges", "GAlignments"), function(x, alignments, ...) ranges(.pmapAlignments(x, alignments, FALSE)) ) setMethod("pmapToAlignments", c("GenomicRanges", "GAlignments"), function(x, alignments, ...) .pmapAlignments(ranges(x), alignments, FALSE) ) setMethod("pmapFromAlignments", c("Ranges", "GAlignments"), function(x, alignments, ...) ranges(.pmapAlignments(x, alignments, TRUE)) ) setMethod("pmapFromAlignments", c("GenomicRanges", "GAlignments"), function(x, alignments, ...) .pmapAlignments(ranges(x), alignments, TRUE) ) GenomicAlignments/R/coverage-methods.R0000644000175100017510000000361512607264575021000 0ustar00biocbuildbiocbuild### ========================================================================= ### "coverage" methods ### ------------------------------------------------------------------------- setMethod("coverage", "GAlignments", function(x, shift=0L, width=NULL, weight=1L, method=c("auto", "sort", "hash"), drop.D.ranges=FALSE) { x <- grglist(x, drop.D.ranges=drop.D.ranges) coverage(x, shift=shift, width=width, weight=weight, method=method) } ) setMethod("coverage", "GAlignmentPairs", function(x, shift=0L, width=NULL, weight=1L, method=c("auto", "sort", "hash"), drop.D.ranges=FALSE) { x <- grglist(x, drop.D.ranges=drop.D.ranges) coverage(x, shift=shift, width=width, weight=weight, method=method) } ) setMethod("coverage", "GAlignmentsList", function(x, shift=0L, width=NULL, weight=1L, ...) { x <- unlist(x, use.names=FALSE) callGeneric() } ) setMethod("coverage", "BamFile", function(x, shift=0L, width=NULL, weight=1L, ..., param=ScanBamParam()) { if (!isOpen(x)) { open(x) on.exit(close(x)) } cvg <- NULL repeat { aln <- readGAlignments(x, param=param) if (length(aln) == 0L) { if (is.null(cvg)) cvg <- coverage(aln, shift=shift, width=width, weight=weight, ...) break } cvg0 <- coverage(aln, shift=shift, width=width, weight=weight, ...) if (is.null(cvg)) cvg <- cvg0 else cvg <- cvg + cvg0 } cvg }) setMethod("coverage", "character", function(x, shift=0L, width=NULL, weight=1L, ..., yieldSize=2500000L) { if (!isSingleString(x)) stop("'x' must be a single string for coverage,character-method") bf <- BamFile(x, yieldSize=yieldSize) coverage(bf, shift=shift, width=width, weight=weight, ...) }) GenomicAlignments/R/encodeOverlaps-methods.R0000644000175100017510000010627412607264575022163 0ustar00biocbuildbiocbuild### ========================================================================= ### encodeOverlaps() and related utilities ### ------------------------------------------------------------------------- ### ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### encodeOverlaps1() - A low-level utility. ### ### > query <- IRanges(start=c(7, 15, 22), end=c(9, 19, 23)) ### > subject <- IRanges(start=c(1, 4, 15, 22, 1, 30, 25), ### end=c(2, 9, 19, 25, 10, 38, 25)) ### > encodeOverlaps1(query, subject, as.matrix=TRUE) ### [,1] [,2] [,3] [,4] [,5] [,6] [,7] ### [1,] "m" "j" "a" "a" "i" "a" "a" ### [2,] "m" "m" "g" "a" "m" "a" "a" ### [3,] "m" "m" "m" "f" "m" "a" "a" ### > encodeOverlaps1(query, subject) ### $Loffset ### [1] 1 ### ### $Roffset ### [1] 2 ### ### $encoding ### [1] "3:jmm:agm:aaf:imm:" ### ### > query.space <- c(0, 1, 0) ### > encodeOverlaps1(query, subject, query.space=query.space)$encoding ### [1] "3:mXm:jXm:aXm:aXf:iXm:aXa:aXa:" ### > query.space <- rep(-1, length(query)) ### > subject.space <- rep(-1, length(subject)) ### > encodeOverlaps1(rev(query), rev(subject), ### query.space=query.space, subject.space=subject.space) ### $Loffset ### [1] 2 ### ### $Roffset ### [1] 1 ### ### $encoding ### [1] "3:aai:jmm:agm:aaf:" ### ### > encodeOverlaps1(query, subject, query.break=2)$encoding ### [1] "2--1:jm--m:ag--m:aa--f:im--m:" ### > encodeOverlaps1(rev(query), rev(subject), ### query.space=query.space, subject.space=subject.space, ### query.break=1)$encoding ### [1] "1--2:a--ai:j--mm:a--gm:a--af:" ### 'query.space' must be either an integer vector of the same length as ### 'query', or NULL. If NULL, then it's interpreted as ### 'integer(length(query))' i.e. all the ranges in 'query' are considered to ### be on space 0. encodeOverlaps1 <- function(query, subject, query.space=NULL, subject.space=NULL, query.break=0L, flip.query=FALSE, as.matrix=FALSE, as.raw=FALSE) { if (!is(query, "Ranges")) stop("'query' must be a Ranges object") if (!is(subject, "Ranges")) stop("'subject' must be a Ranges object") if (is.numeric(query.space) && !is.integer(query.space)) query.space <- as.integer(query.space) if (is.numeric(subject.space) && !is.integer(subject.space)) subject.space <- as.integer(subject.space) if (!isSingleNumber(query.break)) stop("'query.break' must be a single integer value") if (!is.integer(query.break)) query.break <- as.integer(query.break) if (!isTRUEorFALSE(flip.query)) stop("'flip.query' must be TRUE or FALSE") if (!isTRUEorFALSE(as.matrix)) stop("'as.matrix' must be TRUE or FALSE") if (!isTRUEorFALSE(as.raw)) stop("'as.raw' must be TRUE or FALSE") .Call2("encode_overlaps1", start(query), width(query), query.space, query.break, flip.query, start(subject), width(subject), subject.space, as.matrix, as.raw, PACKAGE="GenomicAlignments") } ### TODO: Put this in the (upcoming) man page for encodeOverlaps(). ### A simple (but inefficient) implementation of the "findOverlaps" method for ### Ranges objects. Complexity and memory usage is M x N where M and N are the ### lengths of 'query' and 'subject', respectively. findRangesOverlaps <- function(query, subject) { ovenc <- encodeOverlaps1(query, subject, as.matrix=TRUE, as.raw=TRUE) offsets <- which(charToRaw("c") <= ovenc & ovenc <= charToRaw("k")) - 1L q_hits <- offsets %% nrow(ovenc) + 1L s_hits <- offsets %/% nrow(ovenc) + 1L cbind(queryHits=q_hits, subjectHits=s_hits) } ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### The .RangesList_encodeOverlaps() helper. ### ### This is the power horse behind all the "encodeOverlaps" methods. ### .RangesList_encode_overlaps <- function(query.starts, query.widths, query.spaces, query.breaks, subject.starts, subject.widths, subject.spaces) { .Call2("RangesList_encode_overlaps", query.starts, query.widths, query.spaces, query.breaks, subject.starts, subject.widths, subject.spaces, PACKAGE="GenomicAlignments") } .Hits_encode_overlaps <- function(query.starts, query.widths, query.spaces, query.breaks, subject.starts, subject.widths, subject.spaces, hits, flip.query) { if (queryLength(hits) != length(query.starts) || subjectLength(hits) != length(subject.starts)) stop("'hits' is not compatible with 'query' and 'subject'") .Call2("Hits_encode_overlaps", query.starts, query.widths, query.spaces, query.breaks, subject.starts, subject.widths, subject.spaces, queryHits(hits), subjectHits(hits), flip.query, PACKAGE="GenomicAlignments") } .RangesList_encodeOverlaps <- function(query.starts, query.widths, subject.starts, subject.widths, hits, flip.query=NULL, query.spaces=NULL, subject.spaces=NULL, query.breaks=NULL) { if (is.null(hits)) { C_ans <- .RangesList_encode_overlaps(query.starts, query.widths, query.spaces, query.breaks, subject.starts, subject.widths, subject.spaces) flip.query <- logical(length(encoding)) } else { if (!is(hits, "Hits")) stop("'hits' must be a Hits object") if (is.null(flip.query)) { flip.query <- logical(length(hits)) } else { if (!is.logical(flip.query)) stop("'flip.query' must be a logical vector") if (length(flip.query) != length(hits)) stop("'flip.query' must have the same length as 'hits'") } C_ans <- .Hits_encode_overlaps(query.starts, query.widths, query.spaces, query.breaks, subject.starts, subject.widths, subject.spaces, hits, flip.query) } encoding <- factor(C_ans$encoding) new2("OverlapEncodings", Loffset=C_ans$Loffset, Roffset=C_ans$Roffset, encoding=encoding, flippedQuery=flip.query, check=FALSE) } ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### encodeOverlaps() generic and methods for RangesList objects. ### setGeneric("encodeOverlaps", signature=c("query", "subject"), function(query, subject, hits=NULL, ...) standardGeneric("encodeOverlaps") ) setMethods("encodeOverlaps", list(c("RangesList", "RangesList"), c("RangesList", "Ranges"), c("Ranges", "RangesList")), function(query, subject, hits=NULL, ...) { .RangesList_encodeOverlaps(as.list(start(query)), as.list(width(query)), as.list(start(subject)), as.list(width(subject)), hits) } ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### .isWrongStrand() internal helper. ### .oneValPerTopLevelElt <- function(x, errmsg) { if (!is(x, "RleList")) stop("'x' must be an RleList object") vals <- runValue(x) elt_lens <- elementLengths(vals) if (!all(elt_lens == 1L)) stop(errmsg) unlist(vals, use.names=FALSE) } .isWrongStrand <- function(query, subject, hits) { if (!is(query, "GRangesList") || !is(subject, "GRangesList")) stop("'query' and 'subject' must be GRangesList objects") ## Extract the top-level strand and seqnames of the query. errmsg <- c("some alignments in 'query' have ranges on ", "more than 1 reference sequence (fusion reads?)") query_seqnames <- .oneValPerTopLevelElt(seqnames(query), errmsg) errmsg <- c("some alignments in 'query' have ranges on ", "both strands") query_strand <- .oneValPerTopLevelElt(strand(query), errmsg) ## Extract the top-level strand and seqnames of the subject. errmsg <- c("some transcripts in 'subject' mix exons from ", "different chromosomes (trans-splicing?)") subject_seqnames <- .oneValPerTopLevelElt(seqnames(subject), errmsg) errmsg <- c("some transcripts in 'subject' mix exons from ", "both strands (trans-splicing?)") subject_strand <- .oneValPerTopLevelElt(strand(subject), errmsg) ## Expand the top-level strand and seqnames of the query and subject. if (!is.null(hits)) { if (!is(hits, "Hits")) stop("'hits' must be NULL or a Hits object") if (queryLength(hits) != length(query) || subjectLength(hits) != length(subject)) stop("'hits' is not compatible with 'query' and 'subject' ", "('queryLength(hits)' and 'subjectLength(hits)' don't ", "match the lengths of 'query' and 'subject')") query_seqnames <- query_seqnames[queryHits(hits)] query_strand <- query_strand[queryHits(hits)] subject_seqnames <- subject_seqnames[subjectHits(hits)] subject_strand <- subject_strand[subjectHits(hits)] } ## Should never happen if 'encodeOverlaps(query, subject, hits)' ## was called with 'hits' being the result of a call to ## 'findOverlaps(query, subject)'. if (!all(query_seqnames == subject_seqnames)) stop("cannot use 'flip.query.if.wrong.strand=TRUE' to ", "encode overlaps across chromosomes") query_strand != subject_strand } ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### flipQuery() ### flipQuery <- function(x, i) { if (!is(x, "GRangesList")) stop("'x' must be a GRangesList object") i <- normalizeSingleBracketSubscript(i, x, as.NSBS=TRUE) xi <- extractROWS(x, i) x <- replaceROWS(x, i, invertRleListStrand(revElements(xi))) xi_query.break <- mcols(xi)$query.break if (!is.null(xi_query.break)) { revxi_query.break <- elementLengths(xi) - xi_query.break mcols(x)$query.break <- replaceROWS(mcols(x)$query.break, i, revxi_query.break) } x } ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Should we use a generic + methods for this? ### .get_GRanges_spaces <- function(x) { ans <- as.integer(seqnames(x)) x_strand <- as.integer(strand(x)) is_minus <- which(x_strand == as.integer(strand("-"))) ans[is_minus] <- - ans[is_minus] ans } .get_GRangesList_spaces <- function(x) { unlisted_ans <- .get_GRanges_spaces(x@unlistData) as.list(relist(unlisted_ans, x)) } ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### "encodeOverlaps" method for GRangesList objects. ### .GRangesList_encodeOverlaps <- function(query, subject, hits, flip.query.if.wrong.strand) { if (!isTRUEorFALSE(flip.query.if.wrong.strand)) stop("'flip.query.if.wrong.strand' must be TRUE or FALSE") seqinfo <- merge(seqinfo(query), seqinfo(subject)) seqlevels(query) <- seqlevels(subject) <- seqlevels(seqinfo) if (flip.query.if.wrong.strand) { flip.query <- .isWrongStrand(query, subject, hits) } else { flip.query <- NULL } query.breaks <- mcols(query)$query.break .RangesList_encodeOverlaps(as.list(start(query)), as.list(width(query)), as.list(start(subject)), as.list(width(subject)), hits, flip.query, query.spaces=.get_GRangesList_spaces(query), subject.spaces=.get_GRangesList_spaces(subject), query.breaks=query.breaks) } setMethod("encodeOverlaps", c("GRangesList", "GRangesList"), function(query, subject, hits=NULL, flip.query.if.wrong.strand=FALSE) .GRangesList_encodeOverlaps(query, subject, hits, flip.query.if.wrong.strand) ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### selectEncodingWithCompatibleStrand(). ### selectEncodingWithCompatibleStrand <- function(ovencA, ovencB, query.strand, subject.strand, hits=NULL) { if (!is(ovencA, "OverlapEncodings")) stop("'ovencA' must be an OverlapEncodings object") if (!is(ovencB, "OverlapEncodings")) stop("'ovencB' must be an OverlapEncodings object") if (!is.null(hits)) { if (!is(hits, "Hits")) stop("'hits' must be a Hits object or NULL") query.strand <- query.strand[queryHits(hits)] subject.strand <- subject.strand[subjectHits(hits)] } ans <- ovencA names(ans) <- NULL mcols(ans) <- NULL is_wrong_strand <- query.strand != subject.strand idx <- which(is_wrong_strand) ans@Loffset[idx] <- ovencB@Loffset[idx] ans@Roffset[idx] <- ovencB@Roffset[idx] ans_encoding <- as.character(ans@encoding) ans_encoding[idx] <- as.character(ovencB@encoding[idx]) ans@encoding <- as.factor(ans_encoding) ans@flippedQuery[is_wrong_strand] <- TRUE ans } ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### isCompatibleWithSplicing(). ### .build_compatible_encoding_patterns <- function(njunc) { ## Each "atom" must match exactly 1 code in the encoding. ATOM0 <- "[fgij]" if (njunc == 0L) return(ATOM0) #ntimes <- function(atom, n) rep.int(atom, n) ntimes <- function(atom, n) { if (n == 1L) atom else c(atom, "{", n, "}") } LEFT_ATOM <- "[jg]" MIDDLE_ATOM <- "g" RIGHT_ATOM <- "[gf]" WILDCARD_ATOM <- "[^:-]" sapply(seq_len(njunc + 1L), function(i) { if (i == 1L) { atoms <- c(LEFT_ATOM, ntimes(WILDCARD_ATOM, njunc)) } else if (i == njunc + 1L) { atoms <- c(ntimes(WILDCARD_ATOM, njunc), RIGHT_ATOM) } else { atoms <- c(ntimes(WILDCARD_ATOM, i-1L), MIDDLE_ATOM, ntimes(WILDCARD_ATOM, njunc-i+1L)) } paste0(atoms, collapse="") }) } setGeneric("isCompatibleWithSplicing", function(x) standardGeneric("isCompatibleWithSplicing") ) .build_CompatibleWithSplicing_pattern0 <- function(max.njunc1, max.Lnjunc, max.Rnjunc) { ## Subpattern for single-end reads. subpattern1 <- sapply(0:max.njunc1, function(njunc) paste0(.build_compatible_encoding_patterns(njunc), collapse=":")) subpattern1 <- paste0(":(", paste0(subpattern1, collapse="|"), "):") ## Subpattern for paired-end reads. Lsubpattern <- sapply(0:max.Lnjunc, function(njunc) paste0(":", .build_compatible_encoding_patterns(njunc), "-", collapse="-[^:-]*")) Lsubpattern <- paste0("(", paste0(Lsubpattern, collapse="|"), ")") Rsubpattern <- sapply(0:max.Rnjunc, function(njunc) paste0("-", .build_compatible_encoding_patterns(njunc), ":", collapse="[^:-]*-")) Rsubpattern <- paste0("(", paste0(Rsubpattern, collapse="|"), ")") LRsubpattern <- paste0(Lsubpattern, ".*", Rsubpattern) ## Final pattern. paste0("(", subpattern1, "|", LRsubpattern, ")") } .build_CompatibleWithSplicing_pattern <- function(x) { njunc <- njunc(x) Lnjunc <- Lnjunc(x) Rnjunc <- Rnjunc(x) max.njunc1 <- max(c(0L, njunc[is.na(Lnjunc)])) max.Lnjunc <- max(c(0L, Lnjunc), na.rm=TRUE) max.Rnjunc <- max(c(0L, Rnjunc), na.rm=TRUE) .build_CompatibleWithSplicing_pattern0(max.njunc1, max.Lnjunc, max.Rnjunc) } .isCompatibleWithSplicing <- function(x) { if (!is.character(x)) stop("'x' must be a character vector") pattern <- .build_CompatibleWithSplicing_pattern(x) grepl(pattern, x) } .whichCompatibleWithSplicing <- function(x) { if (!is.character(x)) stop("'x' must be a character vector") pattern <- .build_CompatibleWithSplicing_pattern(x) grep(pattern, x) } setMethod("isCompatibleWithSplicing", "character", .isCompatibleWithSplicing) setMethod("isCompatibleWithSplicing", "factor", function(x) { if (length(x) == 0L) return(logical(0)) idx <- .whichCompatibleWithSplicing(levels(x)) as.integer(x) %in% idx } ) setMethod("isCompatibleWithSplicing", "OverlapEncodings", function(x) isCompatibleWithSplicing(encoding(x)) ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### isCompatibleWithSkippedExons(). ### setGeneric("isCompatibleWithSkippedExons", signature="x", function(x, max.skipped.exons=NA) standardGeneric("isCompatibleWithSkippedExons") ) .build_CompatibleWithSkippedExons_pattern0 <- function(max.njunc1, max.Lnjunc, max.Rnjunc, max.skipped.exons=NA) { if (!identical(max.skipped.exons, NA)) stop("only 'max.skipped.exons=NA' is supported for now, sorry") ## Subpattern for single-end reads. skipped_exons_subpatterns <- c(":(.:)*", ":(..:)*", ":(...:)*", ":(....:)*") subpattern1 <- sapply(0:max.njunc1, function(njunc) paste0(.build_compatible_encoding_patterns(njunc), collapse=skipped_exons_subpatterns[njunc+1L])) subpattern1 <- paste0(":(", paste0(subpattern1, collapse="|"), "):") ## Subpattern for paired-end reads. Lsubpattern <- sapply(0:max.Lnjunc, function(njunc) paste0(":", .build_compatible_encoding_patterns(njunc), "-", collapse=".*")) Lsubpattern <- paste0("(", paste0(Lsubpattern, collapse="|"), ")") Rsubpattern <- sapply(0:max.Rnjunc, function(njunc) paste0("-", .build_compatible_encoding_patterns(njunc), ":", collapse=".*")) Rsubpattern <- paste0("(", paste0(Rsubpattern, collapse="|"), ")") LRsubpattern <- paste0(Lsubpattern, ".*", Rsubpattern) ## Final pattern. paste0("(", subpattern1, "|", LRsubpattern, ")") } .build_CompatibleWithSkippedExons_pattern <- function(x, max.skipped.exons=NA) { njunc <- njunc(x) Lnjunc <- Lnjunc(x) Rnjunc <- Rnjunc(x) max.njunc1 <- max(c(0L, njunc[is.na(Lnjunc)])) max.Lnjunc <- max(c(0L, Lnjunc), na.rm=TRUE) max.Rnjunc <- max(c(0L, Rnjunc), na.rm=TRUE) .build_CompatibleWithSkippedExons_pattern0(max.njunc1, max.Lnjunc, max.Rnjunc, max.skipped.exons=max.skipped.exons) } .isCompatibleWithSkippedExons <- function(x, max.skipped.exons=NA) { if (!is.character(x)) stop("'x' must be a character vector") pattern1 <- .build_CompatibleWithSkippedExons_pattern(x, max.skipped.exons) pattern2 <- .build_CompatibleWithSplicing_pattern(x) grepl(pattern1, x) & !grepl(pattern2, x) } .whichCompatibleWithSkippedExons <- function(x, max.skipped.exons=NA) { if (!is.character(x)) stop("'x' must be a character vector") pattern1 <- .build_CompatibleWithSkippedExons_pattern(x, max.skipped.exons) pattern2 <- .build_CompatibleWithSplicing_pattern(x) setdiff(grep(pattern1, x), grep(pattern2, x)) } setMethod("isCompatibleWithSkippedExons", "character", .isCompatibleWithSkippedExons ) setMethod("isCompatibleWithSkippedExons", "factor", function(x, max.skipped.exons=NA) { if (length(x) == 0L) return(logical(0)) idx <- .whichCompatibleWithSkippedExons(levels(x), max.skipped.exons=max.skipped.exons) as.integer(x) %in% idx } ) setMethod("isCompatibleWithSkippedExons", "OverlapEncodings", function(x, max.skipped.exons=NA) isCompatibleWithSkippedExons(encoding(x), max.skipped.exons=max.skipped.exons) ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### extractSteppedExonRanks(). ### .extract_njunc_from_encoding <- function(x) { as.integer(unlist(strsplit(sub(":.*", "", x), "--", fixed=TRUE), use.names=FALSE)) - 1L } .extractSteppedExonRanksFromEncodingBlocks <- function(encoding_blocks, encoding_patterns) { patterns <- paste0("^", encoding_patterns, "$") ii <- lapply(patterns, grep, encoding_blocks) ii_elt_lens <- elementLengths(ii) if (any(ii_elt_lens == 0L)) return(integer(0)) if (any(ii_elt_lens != 1L)) stop("cannot unambiguously extract stepped exon ranks from ", "encoding \"", paste0(encoding_blocks, collapse=":"), "\"") ans <- unlist(ii, use.names=FALSE) diff_ans <- diff(ans) if (any(diff_ans <= 0L)) return(integer(0)) ans } ### 'encoding' must be a single encoding. ### Returns a sorted integer vector, unnamed and strictly sorted if single-end ### read, named and not necessarily strictly sorted if paired-end read (last ### exon stepped by the left end can be the same as first exon stepped by right ### end). .extractSteppedExonRanks <- function(encoding, for.query.right.end=FALSE) { if (!isTRUEorFALSE(for.query.right.end)) stop("'for.query.right.end' must be TRUE or FALSE") encoding_blocks <- strsplit(encoding, ":", fixed=TRUE)[[1L]] njunc <- .extract_njunc_from_encoding(encoding_blocks[1L]) encoding_blocks <- encoding_blocks[-1L] if (length(njunc) == 1L) { ## Single-end read. if (for.query.right.end) stop("cannot use 'for.query.right.end=TRUE' ", "on single-end encoding: ", encoding) encoding_patterns <- .build_compatible_encoding_patterns(njunc) return(.extractSteppedExonRanksFromEncodingBlocks(encoding_blocks, encoding_patterns)) } if (length(njunc) != 2L) # should never happen stop(encoding, ": invalid encoding") ## Paired-end read. encoding_blocks <- strsplit(encoding_blocks, "--", fixed=TRUE) if (!all(elementLengths(encoding_blocks) == 2L)) # should never happen stop(encoding, ": invalid encoding") encoding_blocks <- matrix(unlist(encoding_blocks, use.names=FALSE), nrow=2L) Lencoding_patterns <- .build_compatible_encoding_patterns(njunc[1L]) Lranks <- .extractSteppedExonRanksFromEncodingBlocks(encoding_blocks[1L, ], Lencoding_patterns) Rencoding_patterns <- .build_compatible_encoding_patterns(njunc[2L]) Rranks <- .extractSteppedExonRanksFromEncodingBlocks(encoding_blocks[2L, ], Rencoding_patterns) if (length(Lranks) == 0L || length(Rranks) == 0L || Lranks[length(Lranks)] > Rranks[1L]) { ranks <- integer(0) names(ranks) <- character(0) return(ranks) } if (for.query.right.end) return(Rranks) # unnamed! (like for a single-end read) names(Rranks) <- rep.int("R", length(Rranks)) names(Lranks) <- rep.int("L", length(Lranks)) c(Lranks, Rranks) } setGeneric("extractSteppedExonRanks", function(x, for.query.right.end=FALSE) standardGeneric("extractSteppedExonRanks") ) setMethod("extractSteppedExonRanks", "character", function(x, for.query.right.end=FALSE) { lapply(x, .extractSteppedExonRanks, for.query.right.end) } ) setMethod("extractSteppedExonRanks", "factor", function(x, for.query.right.end=FALSE) { if (length(x) == 0L) return(list()) ranks <- extractSteppedExonRanks(levels(x), for.query.right.end=for.query.right.end) ranks[as.integer(x)] } ) setMethod("extractSteppedExonRanks", "OverlapEncodings", function(x, for.query.right.end=FALSE) { ranks <- extractSteppedExonRanks(encoding(x), for.query.right.end=for.query.right.end) ranks_elt_lens <- elementLengths(ranks) tmp <- unlist(unname(ranks), use.names=TRUE) # we want the inner names tmp <- tmp + rep.int(Loffset(x), ranks_elt_lens) flevels <- seq_len(length(ranks)) f <- factor(rep.int(flevels, ranks_elt_lens), levels=flevels) unname(split(tmp, f)) } ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### extractSpannedExonRanks(). ### setGeneric("extractSpannedExonRanks", function(x, for.query.right.end=FALSE) standardGeneric("extractSpannedExonRanks") ) setMethod("extractSpannedExonRanks", "character", function(x, for.query.right.end=FALSE) { .extractRanks <- function(encoding) { ranks <- .extractSteppedExonRanks(encoding, for.query.right.end=for.query.right.end) if (length(ranks) == 0L) return(c(NA_integer_, NA_integer_)) c(ranks[1L], ranks[length(ranks)]) } ranks <- lapply(x, .extractRanks) if (length(ranks) == 0L) { firstSpannedExonRank <- lastSpannedExonRank <- integer(0) } else { ranks <- unlist(ranks, use.names=FALSE) firstSpannedExonRank <- ranks[c(TRUE, FALSE)] lastSpannedExonRank <- ranks[c(FALSE, TRUE)] } data.frame(firstSpannedExonRank=firstSpannedExonRank, lastSpannedExonRank=lastSpannedExonRank, check.names=FALSE, stringsAsFactors=FALSE) } ) setMethod("extractSpannedExonRanks", "factor", function(x, for.query.right.end=FALSE) { if (length(x) == 0L) return(list()) ranks <- extractSpannedExonRanks(levels(x), for.query.right.end=for.query.right.end) ans <- ranks[as.integer(x), , drop=FALSE] rownames(ans) <- NULL ans } ) setMethod("extractSpannedExonRanks", "OverlapEncodings", function(x, for.query.right.end=FALSE) { ranks <- extractSpannedExonRanks(encoding(x), for.query.right.end=for.query.right.end) ranks$firstSpannedExonRank <- ranks$firstSpannedExonRank + Loffset(x) ranks$lastSpannedExonRank <- ranks$lastSpannedExonRank + Loffset(x) ranks } ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### extractSkippedExonRanks(). ### setGeneric("extractSkippedExonRanks", function(x, for.query.right.end=FALSE) standardGeneric("extractSkippedExonRanks") ) setMethod("extractSkippedExonRanks", "character", function(x, for.query.right.end=FALSE) { .extractRanks <- function(encoding) { ranks <- .extractSteppedExonRanks(encoding, for.query.right.end=for.query.right.end) if (length(ranks) == 0L) return(ranks) ranks_names <- names(ranks) if (is.null(ranks_names)) # single-end read return(setdiff(ranks[1L]:ranks[length(ranks)], ranks)) ## Paired-end read. ranks <- split(unname(ranks), ranks_names) Lranks <- ranks$L Lranks <- setdiff(Lranks[1L]:Lranks[length(Lranks)], Lranks) Rranks <- ranks$R Rranks <- setdiff(Rranks[1L]:Rranks[length(Rranks)], Rranks) names(Lranks) <- rep.int("L", length(Lranks)) names(Rranks) <- rep.int("R", length(Rranks)) c(Lranks, Rranks) } lapply(x, .extractRanks) } ) setMethod("extractSkippedExonRanks", "factor", function(x, for.query.right.end=FALSE) { if (length(x) == 0L) return(list()) ranks <- extractSkippedExonRanks(levels(x), for.query.right.end=for.query.right.end) ranks[as.integer(x)] } ) setMethod("extractSkippedExonRanks", "OverlapEncodings", function(x, for.query.right.end=FALSE) { ranks <- extractSkippedExonRanks(encoding(x), for.query.right.end=for.query.right.end) ranks_elt_lens <- elementLengths(ranks) tmp <- unlist(unname(ranks), use.names=TRUE) # we want the inner names tmp <- tmp + rep.int(Loffset(x), ranks_elt_lens) flevels <- seq_len(length(ranks)) f <- factor(rep.int(flevels, ranks_elt_lens), levels=flevels) unname(split(tmp, f)) } ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### extractQueryStartInTranscript(). ### ### TODO: Maybe put this in IRanges and rename it setElementLengths, or even ### better introduce an "elementLengths<-" generic and make this the method ### for CompressedList objects? .setElementLengths <- function(x, elt_lens) { if (!is(x, "CompressedList")) stop("'x' must be a CompressedList object") if (!is.numeric(elt_lens) || length(elt_lens) != length(x)) stop("'elt_lens' must be an integer vector of the same length as 'x'") if (!is.integer(elt_lens)) elt_lens <- as.integer(elt_lens) if (S4Vectors:::anyMissingOrOutside(elt_lens, lower=0L)) stop("'elt_lens' cannot contain NAs or negative values") x_elt_lens <- elementLengths(x) if (!all(elt_lens <= x_elt_lens)) stop("'all(elt_lens <= elementLengths(x))' must be TRUE") offset <- cumsum(c(0L, x_elt_lens[-length(x_elt_lens)])) ii <- S4Vectors:::fancy_mseq(elt_lens, offset=offset) x@unlistData <- x@unlistData[ii] x@partitioning@end <- unname(cumsum(elt_lens)) x } ### Returns a data.frame with 1 row per overlap, and 3 integer columns: ### 1. startInTranscript ### 2. firstSpannedExonRank ### 3. startInFirstSpannedExon ### Rows for overlaps that are not "compatible" or "almost compatible" ### contain NAs. extractQueryStartInTranscript <- function(query, subject, hits=NULL, ovenc=NULL, flip.query.if.wrong.strand=FALSE, for.query.right.end=FALSE) { if (!is(query, "GRangesList") || !is(subject, "GRangesList")) stop("'query' and 'subject' must be GRangesList objects") seqinfo <- merge(seqinfo(query), seqinfo(subject)) seqlevels(query) <- seqlevels(subject) <- seqlevels(seqinfo) if (is.null(hits)) { if (length(query) != length(subject)) stop("'query' and 'subject' must have the same length") } else { if (!is(hits, "Hits")) stop("'hits' must be a Hits object or NULL") if (queryLength(hits) != length(query) || subjectLength(hits) != length(subject)) stop("'hits' is not compatible with 'query' and 'subject' ", "('queryLength(hits)' and 'subjectLength(hits)' don't ", "match the lengths of 'query' and 'subject')") query <- query[queryHits(hits)] subject <- subject[subjectHits(hits)] } if (is.null(ovenc)) { ovenc <- encodeOverlaps(query, subject, flip.query.if.wrong.strand=flip.query.if.wrong.strand) } else { if (!is(ovenc, "OverlapEncodings")) stop("'ovenc' must be an OverlapEncodings object") if (length(ovenc) != length(query)) stop("when not NULL, 'ovenc' must have the same length ", "as 'hits', if specified, otherwiseaas 'query'") } if (!isTRUEorFALSE(for.query.right.end)) stop("'for.query.right.end' must be TRUE or FALSE") query <- flipQuery(query, flippedQuery(ovenc)) ## Extract start/end/strand of the first range ## in each top-level element of 'query'. qii1 <- start(query@partitioning) if (for.query.right.end) { query.break <- mcols(query)$query.break if (is.null(query.break)) stop("using 'for.query.right.end=TRUE' requires that ", "'mcols(query)' has a \"query.break\" column ", "indicating for each paired-end read the position of the ", "break between the ranges coming from one end and those ", "coming from the other end") qii1 <- qii1 + query.break } query_start1 <- start(query@unlistData)[qii1] query_end1 <- end(query@unlistData)[qii1] query_strand1 <- as.factor(strand(query@unlistData))[qii1] ## Extract start/end/strand of the first spanned exon ## in each top-level element of 'subject'. exrank <- extractSpannedExonRanks(ovenc, for.query.right.end=for.query.right.end)$firstSpannedExonRank sii1 <- start(subject@partitioning) + exrank - 1L subject_start1 <- start(subject@unlistData)[sii1] subject_end1 <- end(subject@unlistData)[sii1] subject_strand1 <- as.factor(strand(subject@unlistData))[sii1] ## A sanity check. if (any(!is.na(exrank) & (query_strand1 != subject_strand1))) { ## TODO: Error message needs to take into account whether 'hits' ## and/or 'ovenc' was supplied or not. stop("'ovenc' is incompatible with the supplied 'query' ", "and/or 'subject' and/or 'hits'") } ## Compute the "query start in first spanned exon". startInFirstSpannedExon <- rep.int(NA_integer_, length(query)) is_on_plus <- query_strand1 == "+" idx <- which(!is.na(exrank) & is_on_plus) startInFirstSpannedExon[idx] <- query_start1[idx] - subject_start1[idx] + 1L idx <- which(!is.na(exrank) & !is_on_plus) startInFirstSpannedExon[idx] <- subject_end1[idx] - query_end1[idx] + 1L ## Truncate each transcript in 'subject' right before the first spanned ## exon and compute the cumulated width of the truncated object. subject2_elt_lens <- exrank - 1L subject2_elt_lens[is.na(exrank)] <- 0L subject2 <- .setElementLengths(subject, subject2_elt_lens) subject2_cumwidth <- unname(sum(width(subject2))) subject2_cumwidth[is.na(exrank)] <- NA_integer_ ## Compute the "query start in transcript". startInTranscript <- subject2_cumwidth + startInFirstSpannedExon data.frame(startInTranscript=startInTranscript, firstSpannedExonRank=exrank, startInFirstSpannedExon=startInFirstSpannedExon, check.names=FALSE, stringsAsFactors=FALSE) } GenomicAlignments/R/findCompatibleOverlaps-methods.R0000644000175100017510000000330212607264575023632 0ustar00biocbuildbiocbuild### ========================================================================= ### findCompatibleOverlaps ### ------------------------------------------------------------------------- ### setGeneric("findCompatibleOverlaps", function(query, subject, algorithm=c("nclist", "intervaltree")) standardGeneric("findCompatibleOverlaps") ) .GAlignmentsORGAlignmentPairs.findCompatibleOverlaps <- function(query, subject, algorithm=c("nclist", "intervaltree")) { ## Starting with BioC 3.2, the 'order.as.in.query' argument is not ## supported anymore for GAlignmentPairs objects. if (is(query, "GAlignmentPairs")) grl <- grglist(query) else grl <- grglist(query, order.as.in.query=TRUE) ## TODO: Use 'type="within"' when it's supported for circular ## sequences like the mitochondrial chromosome. ov <- findOverlaps(grl, subject, algorithm=match.arg(algorithm), ignore.strand=TRUE) ovenc <- encodeOverlaps(grl, subject, hits=ov, flip.query.if.wrong.strand=TRUE) ov_is_compat <- isCompatibleWithSplicing(ovenc) ov[ov_is_compat] } setMethod("findCompatibleOverlaps", c("GAlignments", "GRangesList"), .GAlignmentsORGAlignmentPairs.findCompatibleOverlaps ) setMethod("findCompatibleOverlaps", c("GAlignmentPairs", "GRangesList"), .GAlignmentsORGAlignmentPairs.findCompatibleOverlaps ) countCompatibleOverlaps <- function(query, subject, algorithm=c("nclist", "intervaltree")) { compatov <- findCompatibleOverlaps(query, subject, algorithm=match.arg(algorithm)) tabulate(queryHits(compatov), nbins=queryLength(compatov)) } GenomicAlignments/R/findMateAlignment.R0000644000175100017510000004461712607264575021141 0ustar00biocbuildbiocbuild### ========================================================================= ### findMateAlignment() ### ------------------------------------------------------------------------- ### ### For each element in GAlignments object 'x', finds its mate in GAlignments ### object 'y'. ### ### Alignments 'x[i1]' and 'y[i2]' are considered mates iff they pass all the ### following tests: ### ### (A) names(x[i1]) == names(y[i2]) ### ### (B) mcols(x[i1])$mrnm == seqnames(y[i2]) & ### mcols(y[i2])$mrnm == seqnames(x[i1]) ### ### (C) mcols(x[i1])$mpos == start(y[i2]) & ### mcols(y[i2])$mpos == start(x[i1]) ### ### (D) isMateMinusStrand(x[i1]) == isMinusStrand(y[i2]) & ### isMateMinusStrand(y[i2]) == isMinusStrand(x[i1]) ### ### (E) isFirstSegment(x[i1]) & isLastSegment(y[i2]) | ### isFirstSegment(y[i2]) & isLastSegment(x[i1]) ### ### (F) isProperPair(x[i1]) == isProperPair(y[i2]) ### ### (G) isSecondaryAlignment(x[i1]) == isSecondaryAlignment(y[i2]) .checkMetadatacols <- function(arg, argname) { if (!is(arg, "GAlignments")) stop("'", argname, "' must be a GAlignments object") if (is.null(names(arg))) stop("'", argname, "' must have names") arg_mcols <- mcols(arg) REQUIRED_COLNAMES <- c("flag", "mrnm", "mpos") if (!all(REQUIRED_COLNAMES %in% colnames(arg_mcols))) { colnames_in1string <- paste0("\"", REQUIRED_COLNAMES, "\"", collapse=", ") stop("required columns in 'mcols(", argname, ")': ", colnames_in1string) } if (!is.integer(arg_mcols$flag)) stop("'mcols(", argname, ")$flag' must be an integer vector") if (!is.factor(arg_mcols$mrnm)) stop("'mcols(", argname, ")$mrnm' must be a factor") if (!identical(levels(arg_mcols$mrnm), levels(seqnames(arg)))) stop("'mcols(", argname, ")$mrnm' and 'seqnames(", argname, ")' ", "must have exactly the same levels in the same order") if (!is.integer(arg_mcols$mpos)) stop("'mcols(", argname, ")$mpos' must be an integer vector") arg_mcols } ### 'names', 'flagbits', 'mrnm', and 'mpos', must all come from the same ### GAlignments object x. ### 'names': names(x). ### 'flagbits': integer matrix (of 0's and 1's) obtained with ### bamFlagAsBitMatrix(mcols(x)$flag, bitnames=.MATING_FLAG_BITNAMES) ### 'mrnm': factor obtained with mcols(x)$mrnm ### 'mpos': integer vector obtained with mcols(x)$mpos ### Returns 'names' with NAs injected at positions corresponding to alignments ### that satisfy at least one of following conditions: ### 1. Bit 0x1 (isPaired) is 0 ### 2. Read is neither first or last mate ### 3. Bit 0x8 (hasUnmappedMate) is 1 ### 4. 'mrnm' is NA (i.e. RNEXT = '*') ### 5. 'mpos' is NA (i.e. PNEXT = 0) ### My understanding of the SAM Spec is that 3., 4. and 5. should happen ### simultaneously even though the Spec don't clearly state this. .MATING_FLAG_BITNAMES <- c("isPaired", "hasUnmappedMate", "isFirstMateRead", "isSecondMateRead") .makeGAlignmentsGNames <- function(names, flagbits, mrnm, mpos) { is_paired <- flagbits[ , "isPaired"] is_first <- flagbits[ , "isFirstMateRead"] is_last <- flagbits[ , "isSecondMateRead"] has_unmappedmate <- flagbits[ , "hasUnmappedMate"] alter_idx <- which(!is_paired | is_first == is_last | has_unmappedmate | is.na(mrnm) | is.na(mpos)) names[alter_idx] <- NA_integer_ names } ### Puts NAs last. .getCharacterOrderAndGroupSizes <- function(x) { x2 <- match(x, x, nomatch=.Machine$integer.max, incomparables=NA_character_) xo <- S4Vectors:::orderInteger(x2) ox2 <- Rle(x2[xo]) group.sizes <- runLength(ox2) ngroup <- length(group.sizes) if (ngroup != 0L && runValue(ox2)[ngroup] == .Machine$integer.max) group.sizes <- group.sizes[-ngroup] list(xo=xo, group.sizes=group.sizes) } ### Should return the same as: ### args <- as.list(setNames(rep(TRUE, length(bitnames)), bitnames)) ### tmp <- do.call(scanBamFlag, args) ### tmp[[2L]] - tmp[[1L]] .makeFlagBitmask <- function(bitnames) { bitpos <- match(bitnames, FLAG_BITNAMES) sum(as.integer(2L ^ (bitpos-1L))) } ### 3 equivalent implementations for this: ### (a) x %in% x[duplicated(x)] ### (b) duplicated(x) | duplicated(x, fromLast=TRUE) ### (c) xx <- match(x, x); ans <- xx != seq_along(xx); ans[xx] <- ans; ans ### Comparing the 3 implementations on an integer vector of length 12 millions: ### (a) is the most memory efficient; ### (b) is a little bit faster than (a) (by only 8%) but uses between 12-14% ### more memory; ### (c) is as fast as (a) but uses about 30% more memory. .hasDuplicates <- function(x) { x %in% x[duplicated(x)] } ### 'x_hits' and 'y_hits' must be 2 integer vectors of the same length N ### representing the N edges of a bipartite graph between the [1, x_len] and ### [1, y_len] intervals (the i-th edge being represented by (x[i], y[i])). ### Returns an integer vector F of length 'x_len' where F[k] is defined by: ### - If there is no occurence of k in 'x', then F[k] = NA. ### - If there is more than 1 occurence of k in 'x', then F[k] = 0. ### - If there is exactly 1 occurence of k in 'x', at index i_k, then ### F[k] = y[i_k]. ### In addition, if more than 1 value of index k is associated to F[k], then ### F[k] is replaced by -F[k]. .makeMateIdx2 <- function(x_hits, y_hits, x_len) { idx1 <- which(.hasDuplicates(y_hits)) y_hits[idx1] <- - y_hits[idx1] idx2 <- which(.hasDuplicates(x_hits)) y_hits[idx2] <- 0L ans <- rep.int(NA_integer_, x_len) ans[x_hits] <- y_hits ans } .showGAlignmentsEltsWithMoreThan1Mate <- function(x, idx) { if (length(idx) == 0L) return() cat("\n!! Found more than 1 mate for the following elements in 'x': ", paste(idx, collapse=", "), ".\n!! Details:\n!! ", sep="") showGAlignments(x[idx], margin="!! ", print.classinfo=TRUE, print.seqinfo=FALSE) cat("!! ==> won't assign a mate to them!\n") } .dump_envir <- new.env(hash=TRUE, parent=emptyenv()) .dumpEnvir <- function() .dump_envir flushDumpedAlignments <- function() { objnames <- ls(envir=.dumpEnvir()) rm(list=objnames, envir=.dumpEnvir()) } dumpAlignments <- function(gal) { objnames <- ls(envir=.dumpEnvir()) nobj <- length(objnames) if (nobj == 0L) { new_objname <- 1L } else { new_objname <- as.integer(objnames[nobj]) + 1L } new_objname <- sprintf("%08d", new_objname) assign(new_objname, gal, envir=.dumpEnvir()) } countDumpedAlignments <- function() { sum(unlist(eapply(.dumpEnvir(), length, USE.NAMES=FALSE))) } getDumpedAlignments <- function() { objnames <- ls(envir=.dumpEnvir()) args <- unname(mget(objnames, envir=.dumpEnvir())) do.call(c, args) } ### Takes about 2.3 s and 170MB of RAM to mate 1 million alignments, ### and about 13 s and 909MB of RAM to mate 5 million alignments. ### So it's a little bit faster and more memory efficient than ### findMateAlignment2(). findMateAlignment <- function(x) { x_names <- names(x) if (is.null(x_names)) stop("'x' must have names") x_mcols <- .checkMetadatacols(x, "x") ## flushDumpedAlignments() must be placed *after* the first reference to ## 'x', otherwise, when doing 'findMateAlignment(getDumpedAlignments())', ## the flushing would happen before 'x' is evaluated, causing 'x' to be ## evaluated to NULL. flushDumpedAlignments() x_flag <- x_mcols$flag bitnames <- c(.MATING_FLAG_BITNAMES, "isMinusStrand", "isMateMinusStrand") x_flagbits <- bamFlagAsBitMatrix(x_flag, bitnames=bitnames) x_mrnm <- x_mcols$mrnm x_mpos <- x_mcols$mpos x_gnames <- .makeGAlignmentsGNames(x_names, x_flagbits, x_mrnm, x_mpos) x_seqnames <- as.factor(seqnames(x)) x_start <- start(x) xo_and_GS <- .getCharacterOrderAndGroupSizes(x_gnames) xo <- xo_and_GS$xo group.sizes <- xo_and_GS$group.sizes ans <- Rsamtools:::.findMateWithinGroups(group.sizes, x_flag[xo], x_seqnames[xo], x_start[xo], x_mrnm[xo], x_mpos[xo]) dumpme_idx <- which(ans <= 0L) if (length(dumpme_idx) != 0L) { dumpAlignments(x[xo[dumpme_idx]]) ans[dumpme_idx] <- NA_integer_ } ans[xo] <- xo[ans] # isn't that cute! dump_count <- countDumpedAlignments() if (dump_count != 0L) warning(" ", dump_count, " alignments with ambiguous pairing ", "were dumped.\n Use 'getDumpedAlignments()' to retrieve ", "them from the dump environment.") ans } ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### findMateAlignment2(). ### ### .findMatches() is the same as match() except that it returns *all* ### the matches (in a Hits object, ordered by queryHits first, then by ### subjectHits). ### TODO: Make findMatches() an S4 generic function with at least a method for ### vectors. Like findOverlaps(), findMatches() could support the 'select' arg ### (but with supported values "all", "first" and "last" only, no need for ### "arbitrary") so that when used with 'select="first"', it would be ### equivalent to match(). This stuff would go in IRanges. .findMatches <- function(query, subject, incomparables=NULL) { if (!is.vector(query) || !is.vector(subject)) stop("'query' and 'subject' must be vectors") if (class(query) != class(subject)) stop("'query' and 'subject' must be vectors of the same class") if (!is.null(incomparables) && !(is.vector(incomparables) && class(incomparables) == class(query))) stop("'incomparables' must be NULL or a vector ", "of the same class as 'query' and 'subject'") m0 <- match(query, subject, incomparables=incomparables) query_hits0 <- which(!is.na(m0)) if (length(query_hits0) == 0L) { query_hits <- subject_hits <- integer(0) } else { subject_hits0 <- m0[query_hits0] subject_low2high <- S4Vectors:::reverseSelfmatchMapping( high2low(subject)) extra_hits <- subject_low2high[subject_hits0] query_nhits <- 1L + elementLengths(extra_hits) query_hits <- rep.int(query_hits0, query_nhits) subject_hits <- integer(length(query_hits)) idx0 <- cumsum(c(1L, query_nhits[-length(query_nhits)])) subject_hits[idx0] <- m0[query_hits0] subject_hits[-idx0] <- unlist(extra_hits, recursive=FALSE, use.names=FALSE) } Hits(query_hits, subject_hits, length(query), length(subject)) } ### Use to find self matches in 'x'. Twice faster than ### 'findMatches(x, x, incomparables=NA_character_)' and uses ### twice less memory. .findSelfMatches.character <- function(x) { xo_and_GS <- .getCharacterOrderAndGroupSizes(x) xo <- xo_and_GS$xo GS <- xo_and_GS$group.sizes ans <- S4Vectors:::makeAllGroupInnerHits(GS, hit.type=1L) ans@queryHits <- xo[ans@queryHits] ans@subjectHits <- xo[ans@subjectHits] ans@queryLength <- ans@subjectLength <- length(x) ans } ### Takes about 2.8 s and 196MB of RAM to mate 1 million alignments, ### and about 19 s and 1754MB of RAM to mate 5 million alignments. findMateAlignment2 <- function(x, y=NULL) { x_names <- names(x) if (is.null(x_names)) stop("'x' must have names") x_mcols <- .checkMetadatacols(x, "x") x_seqnames <- as.factor(seqnames(x)) x_start <- start(x) x_mrnm <- x_mcols$mrnm x_mpos <- x_mcols$mpos x_flag <- x_mcols$flag bitnames <- c(.MATING_FLAG_BITNAMES, "isMinusStrand", "isMateMinusStrand") x_flagbits <- bamFlagAsBitMatrix(x_flag, bitnames=bitnames) x_gnames <- .makeGAlignmentsGNames(x_names, x_flagbits, x_mrnm, x_mpos) if (is.null(y)) { y_seqnames <- x_seqnames y_start <- x_start y_mrnm <- x_mrnm y_mpos <- x_mpos y_flag <- x_flag hits <- .findSelfMatches.character(x_gnames) } else { y_names <- names(y) if (is.null(y_names)) stop("'y' must have names") y_mcols <- .checkMetadatacols(y, "y") y_seqnames <- as.factor(seqnames(y)) y_start <- start(y) y_mrnm <- y_mcols$mrnm y_mpos <- y_mcols$mpos y_flag <- y_mcols$flag y_flagbits <- bamFlagAsBitMatrix(y_flag, bitnames=bitnames) y_gnames <- .makeGAlignmentsGNames(y_names, y_flagbits, y_mrnm, y_mpos) hits <- .findMatches(x_gnames, y_gnames, incomparables=NA_character_) } x_hits <- queryHits(hits) y_hits <- subjectHits(hits) valid_hits <- Rsamtools:::.isValidHit( x_flag[x_hits], x_seqnames[x_hits], x_start[x_hits], x_mrnm[x_hits], x_mpos[x_hits], y_flag[y_hits], y_seqnames[y_hits], y_start[y_hits], y_mrnm[y_hits], y_mpos[y_hits]) x_hits <- x_hits[valid_hits] y_hits <- y_hits[valid_hits] if (is.null(y)) { tmp <- x_hits x_hits <- c(x_hits, y_hits) y_hits <- c(y_hits, tmp) } ans <- .makeMateIdx2(x_hits, y_hits, length(x)) if (any(ans <= 0L, na.rm=TRUE)) { more_than_1_mate_idx <- which(ans == 0L) .showGAlignmentsEltsWithMoreThan1Mate(x, more_than_1_mate_idx) ans[ans <= 0L] <- NA_integer_ } ans } ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### makeGAlignmentPairs(). ### ### TODO: Make isFirstSegment() an S4 generic function with methods for ### matrices, integer vectors, and GAlignments objects. Put this with the ### flag utils in Rsamtools. .isFirstSegment.matrix <- function(x) { is_paired <- as.logical(x[ , "isPaired"]) is_first0 <- as.logical(x[ , "isFirstMateRead"]) is_last0 <- as.logical(x[ , "isSecondMateRead"]) ## According to SAM Spec, bits 0x40 (isFirstMateRead) and 0x80 ## (isSecondMateRead) can both be set or unset, even when bit 0x1 ## (isPaired) is set. However we are not interested in those situations ## (which have a special meaning). is_paired & is_first0 & (!is_last0) } .isFirstSegment.integer <- function(flag) { bitnames <- c("isPaired", "isFirstMateRead", "isSecondMateRead") .isFirstSegment.matrix(bamFlagAsBitMatrix(flag, bitnames=bitnames)) } .isFirstSegment.GAlignments <- function(x) .isFirstSegment.integer(mcols(x)$flag) ### TODO: Make isLastSegment() an S4 generic function with methods for ### matrices, integer vectors, and GAlignments objects. Put this with the ### flag utils in Rsamtools. .isLastSegment.matrix <- function(x) { is_paired <- as.logical(x[ , "isPaired"]) is_first0 <- as.logical(x[ , "isFirstMateRead"]) is_last0 <- as.logical(x[ , "isSecondMateRead"]) ## According to SAM Spec, bits 0x40 (isFirstMateRead) and 0x80 ## (isSecondMateRead) can both be set or unset, even when bit 0x1 ## (isPaired) is set. However we are not interested in those situations ## (which have a special meaning). is_paired & is_last0 & (!is_first0) } .isLastSegment.integer <- function(flag) { bitnames <- c("isPaired", "isFirstMateRead", "isSecondMateRead") .isLastSegment.matrix(bamFlagAsBitMatrix(flag, bitnames=bitnames)) } .isLastSegment.GAlignments <- function(x) .isLastSegment.integer(mcols(x)$flag) ### 'x' must be a GAlignments objects. makeGAlignmentPairs <- function(x, use.names=FALSE, use.mcols=FALSE, strandMode=1) { if (!isTRUEorFALSE(use.names)) stop("'use.names' must be TRUE or FALSE") if (!isTRUEorFALSE(use.mcols)) { if (!is.character(use.mcols)) stop("'use.mcols' must be TRUE or FALSE or a character vector ", "specifying the metadata columns to propagate") if (!all(use.mcols %in% colnames(mcols(x)))) stop("'use.mcols' must be a subset of 'colnames(mcols(x))'") } mate <- findMateAlignment(x) x_is_first <- .isFirstSegment.GAlignments(x) x_is_last <- .isLastSegment.GAlignments(x) first_idx <- which(!is.na(mate) & x_is_first) last_idx <- mate[first_idx] ## Fundamental property of the 'mate' vector: it's a permutation of order ## 2 and with no fixed point on the set of indices for which 'mate' is ## not NA. ## Check there are no fixed points. if (!all(first_idx != last_idx)) stop("findMateAlignment() returned an invalid 'mate' vector") ## Check order 2 (i.e. permuting a 2nd time brings back the original ## set of indices). if (!identical(mate[last_idx], first_idx)) stop("findMateAlignment() returned an invalid 'mate' vector") ## One more sanity check. if (!all(x_is_last[last_idx])) stop("findMateAlignment() returned an invalid 'mate' vector") ## Check the 0x2 bit (isProperPair). x_is_proper <- as.logical(bamFlagAsBitMatrix(mcols(x)$flag, bitnames="isProperPair")) ans_is_proper <- x_is_proper[first_idx] ## Drop pairs with discordant seqnames or strand. idx_is_discordant <- (as.character(seqnames(x)[first_idx]) != as.character(seqnames(x)[last_idx])) | (as.character(strand(x)[first_idx]) == as.character(strand(x)[last_idx])) if (any(idx_is_discordant) != 0L) { nb_discordant_proper <- sum(ans_is_proper[idx_is_discordant]) if (nb_discordant_proper != 0L) { ratio <- 100.0 * nb_discordant_proper / sum(idx_is_discordant) warning(ratio, "% of the pairs with discordant seqnames or ", "strand were flagged\n", " as proper pairs by the aligner. Dropping them anyway.") } keep <- -which(idx_is_discordant) first_idx <- first_idx[keep] last_idx <- last_idx[keep] ans_is_proper <- ans_is_proper[keep] } ## The big split! ans_first <- x[first_idx] ans_last <- x[last_idx] ans_names <- NULL if (use.names) ans_names <- names(ans_first) names(ans_first) <- names(ans_last) <- NULL if (is.character(use.mcols)) { mcols(ans_first) <- mcols(ans_first)[use.mcols] mcols(ans_last) <- mcols(ans_last)[use.mcols] } else if (!use.mcols) { mcols(ans_first) <- mcols(ans_last) <- NULL } GAlignmentPairs(ans_first, ans_last, strandMode=strandMode, isProperPair=ans_is_proper, names=ans_names) } GenomicAlignments/R/findOverlaps-methods.R0000644000175100017510000001706012607264575021640 0ustar00biocbuildbiocbuild### ========================================================================= ### findOverlaps methods ### ------------------------------------------------------------------------- setMethod("findOverlaps", c("GAlignments", "Vector"), function(query, subject, maxgap = 0L, minoverlap = 1L, type = c("any", "start", "end", "within"), select = c("all", "first", "last", "arbitrary"), algorithm=c("nclist", "intervaltree"), ignore.strand = FALSE) { findOverlaps(grglist(query), subject, maxgap = maxgap, minoverlap = minoverlap, type = match.arg(type), select = match.arg(select), algorithm = match.arg(algorithm), ignore.strand = ignore.strand) } ) setMethod("findOverlaps", c("Vector", "GAlignments"), function(query, subject, maxgap = 0L, minoverlap = 1L, type = c("any", "start", "end", "within"), select = c("all", "first", "last", "arbitrary"), algorithm=c("nclist", "intervaltree"), ignore.strand = FALSE) { findOverlaps(query, grglist(subject), maxgap = maxgap, minoverlap = minoverlap, type = match.arg(type), select = match.arg(select), algorithm = match.arg(algorithm), ignore.strand = ignore.strand) } ) ### Not strictly needed! Defining the above 2 methods covers that case but ### with the following note: ### > findOverlaps(al1, al0) ### Note: Method with signature "GAlignments#ANY" chosen for ### function "findOverlaps", target signature ### "GAlignments#GAlignments". ### "ANY#GAlignments" would also be valid setMethod("findOverlaps", c("GAlignments", "GAlignments"), function(query, subject, maxgap = 0L, minoverlap = 1L, type = c("any", "start", "end", "within"), select = c("all", "first", "last", "arbitrary"), algorithm=c("nclist", "intervaltree"), ignore.strand = FALSE) { findOverlaps(grglist(query), grglist(subject), maxgap = maxgap, minoverlap = minoverlap, type = match.arg(type), select = match.arg(select), algorithm = match.arg(algorithm), ignore.strand = ignore.strand) } ) setMethod("findOverlaps", c("GAlignmentPairs", "Vector"), function(query, subject, maxgap = 0L, minoverlap = 1L, type = c("any", "start", "end", "within"), select = c("all", "first", "last", "arbitrary"), algorithm=c("nclist", "intervaltree"), ignore.strand = FALSE) { findOverlaps(grglist(query), subject, maxgap = maxgap, minoverlap = minoverlap, type = match.arg(type), select = match.arg(select), algorithm = match.arg(algorithm), ignore.strand = ignore.strand) } ) setMethod("findOverlaps", c("Vector", "GAlignmentPairs"), function(query, subject, maxgap = 0L, minoverlap = 1L, type = c("any", "start", "end", "within"), select = c("all", "first", "last", "arbitrary"), algorithm=c("nclist", "intervaltree"), ignore.strand = FALSE) { findOverlaps(query, grglist(subject), maxgap = maxgap, minoverlap = minoverlap, type = match.arg(type), select = match.arg(select), algorithm = match.arg(algorithm), ignore.strand = ignore.strand) } ) setMethod("findOverlaps", c("GAlignmentPairs", "GAlignmentPairs"), function(query, subject, maxgap = 0L, minoverlap = 1L, type = c("any", "start", "end", "within"), select = c("all", "first", "last", "arbitrary"), algorithm=c("nclist", "intervaltree"), ignore.strand = FALSE) { findOverlaps(grglist(query), grglist(subject), maxgap = maxgap, minoverlap = minoverlap, type = match.arg(type), select = match.arg(select), algorithm = match.arg(algorithm), ignore.strand = ignore.strand) } ) setMethod("findOverlaps", c("GAlignmentsList", "Vector"), function(query, subject, maxgap = 0L, minoverlap = 1L, type = c("any", "start", "end", "within"), select = c("all", "first", "last", "arbitrary"), algorithm=c("nclist", "intervaltree"), ignore.strand = FALSE) { hits <- findOverlaps(grglist(unlist(query, use.names = FALSE)), subject, maxgap = maxgap, minoverlap = minoverlap, type = match.arg(type), select = match.arg(select), algorithm = match.arg(algorithm), ignore.strand = ignore.strand) remapHits(hits, query.map=factor(togroup(query))) } ) setMethod("findOverlaps", c("Vector", "GAlignmentsList"), function(query, subject, maxgap = 0L, minoverlap = 1L, type = c("any", "start", "end", "within"), select = c("all", "first", "last", "arbitrary"), algorithm=c("nclist", "intervaltree"), ignore.strand = FALSE) { hits <- findOverlaps(query, grglist(unlist(subject, use.names = FALSE)), maxgap = maxgap, minoverlap = minoverlap, type = match.arg(type), select = match.arg(select), algorithm = match.arg(algorithm), ignore.strand = ignore.strand) remapHits(hits, subject.map=factor(togroup(subject))) } ) setMethod("findOverlaps", c("GAlignmentsList", "GAlignmentsList"), function(query, subject, maxgap = 0L, minoverlap = 1L, type = c("any", "start", "end", "within"), select = c("all", "first", "last", "arbitrary"), algorithm=c("nclist", "intervaltree"), ignore.strand = FALSE) { hits <- findOverlaps(grglist(unlist(query, use.names = FALSE)), grglist(unlist(subject, use.names = FALSE)), maxgap = maxgap, minoverlap = minoverlap, type = match.arg(type), select = match.arg(select), algorithm = match.arg(algorithm), ignore.strand = ignore.strand) remapHits(hits, subject.map=factor(togroup(subject)), query.map=factor(togroup(query))) } ) ### ========================================================================= ### findOverlaps-based methods ### ------------------------------------------------------------------------- .signatures1 <- list( c("GAlignments", "Vector"), c("Vector", "GAlignments"), c("GAlignments", "GAlignments"), c("GAlignmentPairs", "Vector"), c("Vector", "GAlignmentPairs"), c("GAlignmentPairs", "GAlignmentPairs"), c("GAlignmentsList", "Vector"), c("Vector", "GAlignmentsList"), c("GAlignmentsList", "GAlignmentsList") ) .signatures2 <- list( c("GAlignments", "GenomicRanges"), c("GenomicRanges", "GAlignments"), c("GAlignments", "GRangesList"), c("GRangesList", "GAlignments") ) setMethods("countOverlaps", c(.signatures1, .signatures2), GenomicRanges:::countOverlaps.definition ) setMethods("overlapsAny", .signatures1, GenomicRanges:::overlapsAny.definition ) setMethods("subsetByOverlaps", .signatures1, GenomicRanges:::subsetByOverlaps.definition1 ) GenomicAlignments/R/findSpliceOverlaps-methods.R0000644000175100017510000003154412607264575023003 0ustar00biocbuildbiocbuild### ========================================================================= ### "findSpliceOverlaps" methods ### ------------------------------------------------------------------------- ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Low-level helper functions ### .rangeForSorted <- function(x) { part <- PartitioningByWidth(x) xflat <- unlist(x, use.names=FALSE) IRanges(start(xflat)[start(part)], end(xflat)[end(part)]) } .compatibleTranscription <- function(query, subject, splice, clip=0L) { qrng <- ranges(query) srng <- ranges(subject) sprng <- ranges(splice) ## FIXME : should clip be a modifiable parameter? ## Or we could consider taking it out entirely... the aligner should clip if (clip != 0L) { bounds <- .rangeForSorted(qrng) - clip qrange <- restrict(qrng, start(bounds), end(bounds), keep.all.ranges = TRUE) } bnds <- elementLengths(setdiff(qrng, srng)) == 0L splc <- elementLengths(intersect(srng, sprng)) == 0L bnds & splc } .novelBounds <- function(query, subject, qhits) { qrange <- range(query) qstrand <- as.character(strand(qrange)) qrange <- unlist(qrange, use.names=FALSE) srange <- unlist(range(subject), use.names=FALSE) ## bounds violation for each match lviol <- start(qrange) < start(srange) rviol <- end(qrange) > end(srange) TSSviol <- as.logical(ifelse(qstrand != "-", lviol, rviol)) TSEviol <- as.logical(ifelse(qstrand != "+", lviol, rviol)) ## bounds violation across all subjects hit (grouped) lviol <- start(qrange) == start(srange) rviol <- end(qrange) == end(srange) TSSmatch <- as.logical(ifelse(qstrand != "-", lviol, rviol)) TSEmatch <- as.logical(ifelse(qstrand != "+", lviol, rviol)) TSSgroup <- (rowsum(as.integer(TSSmatch), qhits)[,1] > 0L)[factor(qhits)] TSEgroup <- (rowsum(as.integer(TSEmatch), qhits)[,1] > 0L)[factor(qhits)] TSS <- TSSviol & !TSSgroup TSE <- TSEviol & !TSEgroup DataFrame(TSS=TSS, TSE=TSE) } .allMatch <- function(x, idx) { (rowsum(as.integer(x), idx)[,1] == table(idx))[idx] } .oneMatch <- function(x, idx) { xcnt <- rowsum(as.integer(x), idx)[,1] oneMatch <- rep((xcnt == 1L), table(idx)) unname(x & oneMatch) } .novelExon <- function(splice, intronRegion) { if (sum(elementLengths(splice)) == 0L) return(logical(length(splice))) ## subset on elements with splices ans <- logical(length(splice)) idx <- elementLengths(splice) > 0 splice <- splice[idx] internal <- unlist(.gaps(splice), use.names=FALSE) if (sum(length(internal)) == 0L) return(ans) ## FIXME : not competely "within" hits <- findOverlaps(internal, intronRegion, ignore.strand=TRUE) if (length(hits) > 0L) { ans0 <- logical(length(splice)) ne <- table(togroup(splice)[queryHits(hits)]) == 1L ans0[unique(togroup(splice)[queryHits(hits)])] <- ne ans[idx] <- ans0 ans } else { ans } } .novelSpliceEvent <- function(splice, intron) { if (sum(elementLengths(splice)) == 0L | sum(elementLengths(intron)) == 0L) DataFrame(Site=rep.int(FALSE, length(splice)), Junction=rep.int(FALSE, length(splice))) ## subset on elements with splices site <- junction <- rep.int(FALSE, length(splice)) idx <- elementLengths(splice) > 0 splice <- splice[idx] intron <- intron[idx] iflat <- unlist(intron, use.names=FALSE) sflat <- unlist(splice, use.names=FALSE) site[idx] <- .spliceEvent("site", iflat, sflat, splice) junction[idx] <- .spliceEvent("junction", iflat, sflat, splice) DataFrame(Site=site, Junction=junction) } .spliceEvent <- function(type, iflat, sflat, splice) { if (type == "site") { combiner <- c elt <- rep(togroup(splice), each=2) } else if (type == "junction") { combiner <- paste elt <- togroup(splice) } ikeys <- paste(seqnames(iflat), combiner(start(iflat), end(iflat)), strand(iflat), sep = ":") skeys <- paste(seqnames(sflat), combiner(start(sflat), end(sflat)), strand(sflat), sep = ":") novel <- !(skeys %in% ikeys) rowsum(as.integer(novel), elt) > 0L } .novelRetention <- function(query, intronRegion) { ans <- logical(length(query)) if (length(query) == 0L) return(ans) hits <- findOverlaps(unlist(query, use.names=FALSE), intronRegion, ignore.strand=TRUE) if (length(hits) > 0L) { ans[unique(togroup(query)[queryHits(hits)])] <- TRUE } else { ans } } .intronicRegions <- function(tx, intron) { txflt <- unlist(tx, use.names = FALSE) intronflt <- unlist(intron, use.names = FALSE) regions <- setdiff(intronflt, txflt, ignore.strand = TRUE) #map <- findOverlaps(regions, intronflt) #mcols(regions)$tx_id <- # splitAsList(names(tx)[togroup(introns)][subjectHits(intronic_to_tx)], # queryHits(intronic_to_tx)) regions } .result <- function(hits, nc=NULL, compatible=NULL, unique=NULL, coding=NULL, strandSpecific=NULL, novelTSS=NULL, novelTSE=NULL, novelSite=NULL, novelJunction=NULL, novelExon=NULL, novelRetention=NULL) { nms <- c("compatible", "unique", "coding", "strandSpecific", "novelTSS", "novelTSE", "novelSite", "novelJunction", "novelExon", "novelRetention") ## full result if (!is.null(nc)) { mcols(hits) <- DataFrame(compatible, unique, coding, strandSpecific, novelTSS, novelTSE, novelSite, novelJunction, novelExon, novelRetention) hits ## no overlaps } else if (is.null(compatible)) { mat <- matrix(logical(0), length(hits), length(nms)) mcols(hits) <- DataFrame(mat) names(mcols(hits)) <- nms hits ## no compatible overlaps } else { mat <- matrix(FALSE, length(hits), length(nms)) mcols(hits) <- DataFrame(cbind(compatible, unique, coding, strandSpecific, mat)) names(mcols(hits)) <- nms hits } } .insertGaps <- function(reads) { query.break <- mcols(reads)$query.break if (is.null(query.break)) stop("missing 'query.break' metadata variable: reads not paired?") reads_flat <- unlist(reads, use.names = FALSE) reads_part <- PartitioningByWidth(reads) left_end <- start(reads_part) + query.break - 1L right_start <- left_end + 1L start <- end(reads_flat)[left_end] end <- pmax(start(reads_flat)[right_start], start - 1L) if (any(seqnames(reads_flat)[left_end] != seqnames(reads_flat)[right_start])) stop("reads are on different chromosomes") GRanges(seqnames(reads_flat)[left_end], IRanges(start, end), strand(reads_flat)[left_end]) } ## Until we have the formal 'gaps' method for GRangeList .isNumericOrNAs <- S4Vectors:::isNumericOrNAs .gaps <- function(x, start=NA, end=NA) { if (!.isNumericOrNAs(start)) stop("'start' must be an integer vector or NA") if (!is.integer(start)) start <- as.integer(start) if (!.isNumericOrNAs(end)) stop("'end' must be an integer vector or NA") if (!is.integer(end)) end <- as.integer(end) ## seqname and strand consistent in list elements if (all(elementLengths(runValue(seqnames(x))) == 1L) && all(elementLengths(runValue(strand(x))) == 1L)) { flat <- unlist(x, use.names=FALSE) gaps <- gaps(ranges(x), start, end) ### FIXME: this makes this function more of an 'introns' than a .gaps. ### FIXME: this breaks when the GRangesList is not ordered by position if (!is.null(mcols(x)$query.break)) { insert_gaps <- split(ranges(.insertGaps(x)), seq_len(length(x))) gaps <- setdiff(gaps, insert_gaps) } idx <- elementLengths(gaps) != 0 ## FIXME : can't handle lists with empty elements ## 'start' and 'end' not quite right here firstseg <- start(PartitioningByWidth(x)) seqnms <- rep(seqnames(flat)[firstseg], elementLengths(gaps)) strand <- rep(strand(flat)[firstseg], elementLengths(gaps)) gr <- relist(GRanges(seqnms, unlist(gaps, use.names=FALSE), strand), gaps) gr } else { ### FIXME: does not handle query.break column yet psetdiff(range(x), x) } } .findSpliceOverlaps <- function(query, subject, algorithm, ignore.strand=FALSE, cds=NULL) { ## adjust strand based on 'XS' if (!is.null(xs <- mcols(query)$XS)) { strand <- ifelse(!is.na(xs), xs, "*") strand(query) <- relist(Rle(strand, elementLengths(query)), query) } ## NOTE: this misses reads completely within an intron, but this ## is intentional: a read is only assigned to a transcript if it ## hits an exon. Otherwise, it could be from another gene inside ## an intron (happens frequently). olap <- findOverlaps(query, subject, algorithm=algorithm, ignore.strand=ignore.strand) if (length(olap) == 0L) return(.result(olap)) if (!is.null(cds)) { coding <- logical(length(olap)) hits <- findOverlaps(query, cds, algorithm=algorithm, ignore.strand=ignore.strand) coding[queryHits(olap) %in% queryHits(hits)] <- TRUE } else { coding <- rep.int(NA, length(olap)) } query <- query[queryHits(olap)] subject <- subject[subjectHits(olap)] splice <- .gaps(query) compatible <- .compatibleTranscription(query, subject, splice) unique <- .oneMatch(compatible, queryHits(olap)) strandSpecific <- all(strand(query) != "*") mcols(olap) <- DataFrame(compatible, unique, coding, strandSpecific) olap } setGeneric("findSpliceOverlaps", signature=c("query", "subject"), function(query, subject, algorithm=c("nclist", "intervaltree"), ignore.strand=FALSE, ...) standardGeneric("findSpliceOverlaps") ) setMethod("findSpliceOverlaps", c("GRangesList", "GRangesList"), function(query, subject, algorithm=c("nclist", "intervaltree"), ignore.strand=FALSE, ..., cds=NULL) { .findSpliceOverlaps(query, subject, match.arg(algorithm), ignore.strand, cds=cds) }) setMethod("findSpliceOverlaps", c("GAlignments", "GRangesList"), function(query, subject, algorithm=c("nclist", "intervaltree"), ignore.strand=FALSE, ..., cds=NULL) { findSpliceOverlaps(grglist(query, order.as.in.query=TRUE), subject, algorithm=match.arg(algorithm), ignore.strand, ..., cds=cds) }) setMethod("findSpliceOverlaps", c("GAlignmentPairs", "GRangesList"), function(query, subject, algorithm=c("nclist", "intervaltree"), ignore.strand=FALSE, ..., cds=NULL) { ### FIXME: order.as.in.query = FALSE needed for .insertGaps(). If we ### really want to use .insertGaps(), we need to make it robust to ### different orderings. ### FIXME: ### instead of relying on query.break column, maybe we should add a ### 'splice = .gaps(query)' argument to .findSpliceOverlaps that we ### set to junctions(query) here. The downside is that a GRangesList ### derived from GAlignmentPairs will no longer work. findSpliceOverlaps(grglist(query, order.as.in.query=FALSE), subject, algorithm=match.arg(algorithm), ignore.strand, ..., cds=cds) }) setMethod("findSpliceOverlaps", c("character", "ANY"), function(query, subject, algorithm=c("nclist", "intervaltree"), ignore.strand=FALSE, ..., param=ScanBamParam(), singleEnd=TRUE) { findSpliceOverlaps(BamFile(query), subject, algorithm=match.arg(algorithm), ignore.strand, ..., param=param, singleEnd=singleEnd) }) setMethod("findSpliceOverlaps", c("BamFile", "ANY"), function(query, subject, algorithm=c("nclist", "intervaltree"), ignore.strand=FALSE, ..., param=ScanBamParam(), singleEnd=TRUE) { findSpliceOverlaps(.readRanges(query, param, singleEnd), subject, algorithm=match.arg(algorithm), ignore.strand, ...) }) .readRanges <- function(bam, param, singleEnd) { if (!"XS" %in% bamTag(param)) bamTag(param) <- c(bamTag(param), "XS") if (singleEnd) reads <- readGAlignments(bam, param=param) else { reads <- readGAlignmentPairs(path(bam), param=param) first_xs <- mcols(first(reads))$XS last_xs <- mcols(last(reads))$XS if (!is.null(first_xs) && !is.null(last_xs)) { xs <- first_xs xs[is.na(xs)] <- last_xs[is.na(xs)] mcols(reads)$XS <- xs } } metadata(reads)$bamfile <- bam reads } GenomicAlignments/R/intra-range-methods.R0000644000175100017510000000657512607264575021424 0ustar00biocbuildbiocbuild### ========================================================================= ### Intra-range methods ### ------------------------------------------------------------------------- ### ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### updateCigarAndStart() -- NOT exported ### setGeneric("updateCigarAndStart", function(x, cigar=NULL, start=NULL) standardGeneric("updateCigarAndStart") ) setMethod("updateCigarAndStart", "GAlignments", function(x, cigar=NULL, start=NULL) { if (is.null(cigar)) { cigar <- cigar(x) } else { if (!is.character(cigar) || length(cigar) != length(x)) stop("when not NULL, 'cigar' must be a character vector ", "of the same length as 'x'") ## There might be an "rshift" attribute on 'cigar', typically. ## We want to get rid of it as well as any other potential ## attribute like names, dim, dimnames etc... attributes(cigar) <- NULL } if (is.null(start)) start <- start(x) else if (!is.integer(start) || length(start) != length(x)) stop("when not NULL, 'start' must be an integer vector ", "of the same length as 'x'") x@cigar <- cigar x@start <- start x } ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### narrow() ### setMethod("narrow", "GAlignments", function(x, start=NA, end=NA, width=NA, use.names=TRUE) .narrowGAlignments(x, cigarNarrow, start, end, width) ) setMethod("narrow", "GAlignmentsList", function(x, start=NA, end=NA, width=NA, use.names=TRUE) { gal <- narrow(x@unlistData, start=start, end=end, width=width, use.names=use.names) relist(gal, x@partitioning) } ) setMethod("narrow", "GappedReads", function(x, start=NA, end=NA, width=NA, use.names=TRUE) { stop("coming soon") ## ans_cigar <- cigarNarrow(cigar(x), ## start=start, end=end, width=width) ## ans_start <- start(x) + attr(ans_cigar, "rshift") ## updateCigarAndStart(x, cigar=ans_cigar, start=ans_start) } ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### qnarrow() ### setGeneric("qnarrow", signature="x", function(x, start=NA, end=NA, width=NA) standardGeneric("qnarrow") ) .narrowGAlignments <- function(x, CIGAR_CUTTER, start, end, width) { ans_cigar <- CIGAR_CUTTER(cigar(x), start=start, end=end, width=width) ans_start <- start(x) + attr(ans_cigar, "rshift") updateCigarAndStart(x, cigar=ans_cigar, start=ans_start) } setMethod("qnarrow", "GAlignments", function(x, start=NA, end=NA, width=NA) .narrowGAlignments(x, cigarQNarrow, start, end, width) ) setMethod("qnarrow", "GAlignmentsList", function(x, start=NA, end=NA, width=NA) { gal <- qnarrow(x@unlistData, start=start, end=end, width=width) relist(gal, x@partitioning) } ) setMethod("qnarrow", "GappedReads", function(x, start=NA, end=NA, width=NA) { stop("coming soon") ## ans_cigar <- cigarQNarrow(cigar(x), ## start=start, end=end, width=width) ## ans_start <- start(x) + attr(ans_cigar, "rshift") ## updateCigarAndStart(x, cigar=ans_cigar, start=ans_start) } ) GenomicAlignments/R/junctions-methods.R0000644000175100017510000003205612607264575021222 0ustar00biocbuildbiocbuild### ========================================================================= ### Extract junctions from genomic alignments ### ------------------------------------------------------------------------- ### ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### junctions() generic and methods. ### setGeneric("junctions", signature="x", function(x, use.mcols=FALSE, ...) standardGeneric("junctions") ) setMethod("junctions", "GAlignments", function(x, use.mcols=FALSE) { if (!isTRUEorFALSE(use.mcols)) stop("'use.mcols' must be TRUE or FALSE") grl <- grglist(x, order.as.in.query=TRUE) ans <- psetdiff(granges(x), grl) if (use.mcols) mcols(ans) <- mcols(x) ans } ) setMethod("junctions", "GAlignmentPairs", function(x, use.mcols=FALSE) { if (!isTRUEorFALSE(use.mcols)) stop("'use.mcols' must be TRUE or FALSE") first_junctions <- junctions(first(x, real.strand=TRUE)) last_junctions <- junctions(last(x, real.strand=TRUE)) ## pc() is a fast "parallel c()" for list-like objects. ## In the case below, it's equivalent to (but faster than) doing ## 'mendoapply(c, first_junctions, last_junctions)'. ans <- pc(first_junctions, last_junctions) if (use.mcols) { mcols(ans) <- mcols(x) } else { mcols(ans) <- NULL } ans } ) setMethod("junctions", "GAlignmentsList", function(x, use.mcols=FALSE, ignore.strand=FALSE) { if (!isTRUEorFALSE(use.mcols)) stop("'use.mcols' must be TRUE or FALSE") if (!isTRUEorFALSE(ignore.strand)) stop("'ignore.strand' must be TRUE or FALSE") if (ignore.strand) strand(x@unlistData) <- "*" grl <- junctions(x@unlistData) ans_breakpoints <- end(grl@partitioning)[end(x@partitioning)] ans_partitioning <- PartitioningByEnd(ans_breakpoints, names=names(x)) ans <- relist(grl@unlistData, ans_partitioning) if (use.mcols) mcols(ans) <- mcols(x) ans } ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Natural intron motifs taken from: ### http://www.ncbi.nlm.nih.gov/pmc/articles/PMC84117/ NATURAL_INTRON_MOTIFS <- c("GT-AG", "GC-AG", "AT-AC", "AT-AA", "AT-AG") ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### summarizeJunctions() ### .extract_unoriented_intron_motif <- function(genome, junctions) { mcols(junctions) <- NULL junctions_len <- length(junctions) Ldinucl_gr <- Rdinucl_gr <- junctions end(Ldinucl_gr) <- start(Ldinucl_gr) + 1L start(Rdinucl_gr) <- end(Rdinucl_gr) - 1L all_dinucl <- getSeq(genome, c(Ldinucl_gr, Rdinucl_gr)) Ldinucl <- head(all_dinucl, n=junctions_len) Rdinucl <- tail(all_dinucl, n=junctions_len) xscat(Ldinucl, "-", Rdinucl) } .infer_intron_strand <- function(unoriented_intron_motif) { natural_intron_motifs <- DNAStringSet(NATURAL_INTRON_MOTIFS) intron_strand <- rep.int(NA, length(unoriented_intron_motif)) idx <- which(unoriented_intron_motif %in% natural_intron_motifs) intron_strand[idx] <- FALSE idx <- which(unoriented_intron_motif %in% reverseComplement(natural_intron_motifs)) intron_strand[idx] <- TRUE if (any(is.na(intron_strand))) warning("For some junctions, the dinucleotides found at the intron ", "boundaries don't\n match any of the natural intron motifs ", "stored in predefined character vector\n ", "'NATURAL_INTRON_MOTIFS'. For these junctions, the ", "intron_motif and\n intron_strand metadata columns ", "were set to NA and *, respectively.") strand(intron_strand) } .orient_intron_motif <- function(unoriented_intron_motif, intron_strand) { ans <- unoriented_intron_motif idx <- which(intron_strand == "-") ans[idx] <- reverseComplement(ans[idx]) ans <- factor(as.character(ans), levels=NATURAL_INTRON_MOTIFS) } summarizeJunctions <- function(x, with.revmap=FALSE, genome=NULL) { if (!isTRUEorFALSE(with.revmap)) stop("'with.revmap' must be TRUE or FALSE") if (!is.null(genome)) { if (!suppressWarnings(require(BSgenome, quietly=TRUE))) stop("you need to install the BSgenome package in order ", "to use the 'genome' argument") genome <- BSgenome::getBSgenome(genome) } x_junctions <- junctions(x) unlisted_junctions <- unlist(x_junctions, use.names=FALSE) unstranded_unlisted_junctions <- unstrand(unlisted_junctions) ans <- sort(unique(unstranded_unlisted_junctions)) unq2dups <- as(findMatches(ans, unstranded_unlisted_junctions), "List") ans_score <- elementLengths(unq2dups) tmp <- extractList(strand(unlisted_junctions), unq2dups) ans_plus_score <- sum(tmp == "+") ans_minus_score <- sum(tmp == "-") ans_mcols <- DataFrame(score=ans_score, plus_score=ans_plus_score, minus_score=ans_minus_score) if (with.revmap) { crossed_by <- togroup(x_junctions) ans_revmap <- extractList(crossed_by, unq2dups) ## 'ans_revmap' should never contain duplicates when 'x' is a ## GAlignments object, because a given junction can show up at most ## once per SAM/BAM record (i.e. per element in 'x', or per alignment). ## This doesn't hold anymore if the elements in 'x' consist of more ## than 1 SAM/BAM record (or alignment) e.g. if 'x' is a ## GAlignmentPairs or GAlignmentsList object, because, in that case, ## the same junction can show up more than once per element in 'x'. if (!is(x, "GAlignments")) ans_revmap <- unique(ans_revmap) ans_mcols$revmap <- ans_revmap } if (!is.null(genome)) { unoriented_intron_motif <- .extract_unoriented_intron_motif(genome, ans) ans_intron_strand <- .infer_intron_strand(unoriented_intron_motif) ans_intron_motif <- .orient_intron_motif(unoriented_intron_motif, ans_intron_strand) ans_mcols <- cbind(ans_mcols, DataFrame(intron_motif=ans_intron_motif, intron_strand=ans_intron_strand)) } mcols(ans) <- ans_mcols ans } ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### readTopHatJunctions() ### ### Read splice junctions file (junctions.bed) generated by the TopHat ### aligner into a GRanges object. ### Usage: ### readTopHatJunctions("junctions.bed") ### ### Comparing with output of bed_to_juncs script (assuming the ### 'new_list.juncs' file was obtained by passing 'junctions.bed' thru ### bed_to_juncs): ### junctions1 <- readTopHatJunctions("junctions.bed") ### junctions2 <- readTopHatJunctions("new_list.juncs", ### file.is.raw.juncs=TRUE) ### stopifnot(all(junctions1 == junctions2)) ### .bed_to_Juncs <- function(x) { if (!is(x, "GRanges")) stop("'x' must be a GRanges object") if (!identical(mcols(x)$thick, ranges(x))) stop("this BED file doesn't look like the junctions.bed file ", "generated by TopHat") blocks <- mcols(x)$blocks stopifnot(all(elementLengths(blocks) == 2L)) unlisted_blocks <- unlist(blocks, use.names=FALSE) even_idx <- 2L * seq_along(x) odd_idx <- even_idx - 1L ans_start <- start(x) + end(unlisted_blocks)[odd_idx] ans_end <- start(x) + start(unlisted_blocks)[even_idx] - 2L ans <- GRanges(seqnames(x), IRanges(ans_start, ans_end), strand=strand(x)) mcols(ans) <- DataFrame(name=mcols(x)$name, score=as.integer(mcols(x)$score)) ans } ### 'file' must be the path or a connection object to a junctions.bed file as ### generated by TopHat, or to a tab-delimited file obtained by running ### TopHat's bed_to_juncs script on a junctions.bed file. ### Returns the junctions in a GRanges object. ### IMPORTANT NOTE: readTopHatJunctions() does NOT follow the convention used ### by TopHat that describes a junction by the position of the nucleotide ### immediately before and after the intron. In the GRanges object returned ### by readTopHatJunctions(), a junction is considered to start at the ### left-most and to end at the right-most nucleotide of the intron. readTopHatJunctions <- function(file, file.is.raw.juncs=FALSE) { if (!isTRUEorFALSE(file.is.raw.juncs)) stop("'file.is.raw.juncs' must be TRUE or FALSE") if (is.character(file)) { if (!isSingleString(file)) stop("'file' must be a single string") file_ext0 <- ".bed" file_ext <- substr(file, start=nchar(file) - nchar(file_ext0) + 1L, stop=nchar(file)) if (file.is.raw.juncs) { if (file_ext == file_ext0) stop("'file.is.raw.juncs=TRUE' is not aimed to be ", "used on a file\n with the .bed extension") df <- read.table(file, stringsAsFactors=FALSE) ## The 2nd and 3rd columns in 'new_list.juncs' are the left and ## right positions of the junctions, respectively. The convention ## used by TopHat is that these are NOT the positions of the ## left-most and right-most nucleotides of the intron, but rather ## the positions immediately before and after, respectively, that ## is, the last and the first positions of the flanking exons. ## Also these positions are *both* 0-based. ans_ranges <- IRanges(df[[2L]] + 2L, df[[3L]]) ans <- GRanges(df[[1L]], ans_ranges, strand=df[[4L]]) return(ans) } if (file_ext != file_ext0) warning("'file' has no .bed extension, suggesting it may not ", "be a junctions.bed\n file as generated by TopHat. ", "I will assume it is this file anyway (or a BED\n file ", "with similar content). If 'file' is a tab-delimited ", "file obtained\n by running TopHat's bed_to_juncs script ", "on a junctions.bed file, you\n should use ", "'file.is.raw.juncs=TRUE'") } junctions_bed <- rtracklayer::import(file) .bed_to_Juncs(junctions_bed) } ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### readSTARJunctions() ### ### Read splice junctions file (SJ.out.tab) generated by the STAR aligner ### into a GRanges object. ### Usage: ### readSTARJunctions("SJ.out.tab") ### .STAR_INTRON_MOTIFS <- c("GT-AG", "CT-AC", "GC-AG", "CT-GC", "AT-AC", "GT-AT") .get_STAR_intron_motif_levels <- function() { ans <- .STAR_INTRON_MOTIFS[(1:3)*2L - 1L] stopifnot(all(ans == NATURAL_INTRON_MOTIFS[1:3])) rev_motifs <- .STAR_INTRON_MOTIFS[(1:3)*2L] stopifnot(all(rev_motifs == reverseComplement(DNAStringSet(ans)))) ans } readSTARJunctions <- function(file) { motif123 <- .get_STAR_intron_motif_levels() df <- read.table(file, stringsAsFactors=FALSE) ans_seqnames <- df[[1L]] ans_start <- df[[2L]] ans_end <- df[[3L]] ans_strand <- strand(df[[4L]] == 2L) STAR_intron_motif_code <- df[[5L]] if (!is.integer(ans_start) || !is.integer(ans_end) || !is.integer(STAR_intron_motif_code) || S4Vectors:::anyMissingOrOutside(STAR_intron_motif_code, lower=0L, upper=6L)) stop("'file' does not look like a junction file generated ", "by the STAR aligner (normally the SJ.out.tab file)") STAR_intron_motif_code[STAR_intron_motif_code == 0L] <- NA_integer_ code1 <- STAR_intron_motif_code + 1L ans_intron_motif <- factor(motif123[code1 %/% 2L], levels=motif123) ans_intron_strand <- strand(as.logical(code1 %% 2L)) has_code_zero <- is.na(ans_intron_motif) stopifnot(identical(has_code_zero, ans_intron_strand == "*")) idx0 <- which(!has_code_zero) if (!identical(ans_strand[idx0], ans_intron_strand[idx0])) warning("For some junctions, the strand reported in the motif_strand ", "metadata column\n (which was inferred from the STAR intron ", "motif code stored in column 5 of\n 'file') is conflicting ", "with the strand of the junction reported in column 4\n ", "of 'file'. Bug in STAR? Obscure feature? Or corrupted file? ", "Please ask on the\n STAR general user mailing list ", "(https://groups.google.com/d/forum/rna-star)\n for ", "clarifications about this (only if you're confident that ", "your SJ.out.tab\n file is not corrupted though).") GRanges(ans_seqnames, IRanges(ans_start, ans_end), strand=ans_strand, intron_motif=ans_intron_motif, intron_strand=ans_intron_strand, um_reads=df[[7L]], mm_reads=df[[8L]]) } GenomicAlignments/R/mapCoords-methods.R0000644000175100017510000000461112607264575021131 0ustar00biocbuildbiocbuild### ========================================================================= ### 'mapCoords' and 'pmapCoords' methods ### ------------------------------------------------------------------------- ### ### Generics are in IRanges. ### mapCoords: setMethod("mapCoords", c("GenomicRanges", "GAlignments"), function(from, to, ...) { msg <- c("mapCoords() is defunct. ", "Use 'mapToTranscripts' from the GenomicFeatures package ", "or 'mapToAlignments' from the GenomicAlignments package ", "instead.") .Defunct(msg=wmsg(msg)) to_grl <- grglist(to, drop.D.ranges=TRUE) from_ol <- findOverlaps(from, to_grl, ignore.strand=TRUE, type="within") to_hits <- to[subjectHits(from_ol)] from_hits <- ranges(from)[queryHits(from_ol)] ranges <- pmapCoords(from_hits, to_hits) space <- names(to_hits) if (is.null(space)) space <- as.character(seq_len(length(to))[subjectHits(from_ol)]) GRanges(Rle(space), ranges, fromHits=queryHits(from_ol), toHits=subjectHits(from_ol)) } ) ### pmapCoords: setMethod("pmapCoords", c("Ranges", "GAlignments"), function(from, to, ...) { msg <- c("'pmapCoords' is defunct. ", "Use 'pmapToTranscripts' from the GenomicFeatures package ", "or 'pmapToAlignments' from the GenomicAlignments package ", "instead.") .Defunct(msg=wmsg(msg)) starts <- .Call("ref_locs_to_query_locs", start(from), cigar(to), start(to), FALSE, PACKAGE="GenomicAlignments") ends <- .Call("ref_locs_to_query_locs", end(from), cigar(to), start(to), TRUE, PACKAGE="GenomicAlignments") ends <- pmax(ends, starts - 1L) IRanges(starts, ends) } ) ### prmap (not exported): setGeneric("prmap", function(from, to) standardGeneric("prmap")) setMethod("prmap", c("Ranges", "GAlignments"), function(from, to) { .Defunct("pmapFromTranscripts") starts <- .Call("query_locs_to_ref_locs", start(from), cigar(to), start(to), FALSE, PACKAGE="GenomicAlignments") ends <- .Call("query_locs_to_ref_locs", end(from), cigar(to), start(to), TRUE, PACKAGE="GenomicAlignments") ends <- pmax(ends, starts - 1L) IRanges(starts, ends) } ) GenomicAlignments/R/pileLettersAt.R0000644000175100017510000001110712607264575020320 0ustar00biocbuildbiocbuild### ========================================================================= ### pileLettersAt() ### ------------------------------------------------------------------------- ### .pileLettersOnSingleRefAt() is the workhorse behind pileLettersAt(). ### 'x', 'pos', 'cigar': 3 parallel vectors describing N strings aligned ### to the same reference sequence. 'x' must be an XStringSet (typically ### DNAStringSet) object containing the unaligned strings (a.k.a. the ### query sequences) reported with respect to the + strand. 'pos' must ### be an integer vector where 'pos[i]' is the 1-based position on the ### reference sequence of the first aligned letter in 'x[[i]]'. 'cigar' ### must be a character vector containing the extended CIGAR strings. ### 'at': must be an integer vector containing the individual positions of ### interest with respect to the reference sequence. ### Returns an XStringSet (typically DNAStringSet) object parallel to ### 'at' (i.e. with 1 string per position of interest). .pileLettersOnSingleRefAt <- function(x, pos, cigar, at) { stopifnot(is(x, "XStringSet")) N <- length(x) # nb of alignments stopifnot(is.integer(pos) && length(pos) == N) stopifnot(is.character(cigar) && length(cigar) == N) stopifnot(is.integer(at)) ops <- c("M", "=", "X") ranges_on_ref <- cigarRangesAlongReferenceSpace(cigar, pos=pos, ops=ops) ranges_on_query <- cigarRangesAlongQuerySpace(cigar, ops=ops) ## 'ranges_on_ref' and 'ranges_on_query' are IRangesList objects parallel ## to 'x', 'pos', and 'cigar'. In addition, the 2 IRangesList objects ## have the same "shape" (i.e. same elementLengths()), so, after ## unlisting, the 2 unlisted objects are parallel IRanges objects. unlisted_ranges_on_ref <- unlist(ranges_on_ref, use.names=FALSE) unlisted_ranges_on_query <- unlist(ranges_on_query, use.names=FALSE) ## 2 integer vectors parallel to IRanges objects 'unlisted_ranges_on_ref' ## and 'unlisted_ranges_on_query' above. range_group <- togroup(ranges_on_ref) query2ref_shift <- start(unlisted_ranges_on_ref) - start(unlisted_ranges_on_query) hits <- findOverlaps(at, unlisted_ranges_on_ref) hits_at_in_x <- at[queryHits(hits)] - query2ref_shift[subjectHits(hits)] hits_group <- range_group[subjectHits(hits)] unlisted_piles <- subseq(x[hits_group], start=hits_at_in_x, width=1L) piles_skeleton <- PartitioningByEnd(queryHits(hits), NG=length(at), names=names(at)) piles <- relist(unlisted_piles, piles_skeleton) unstrsplit(piles) } ### 'x', 'seqnames', 'pos', 'cigar': 4 parallel vectors describing N ### aligned strings. 'x', 'pos', and 'cigar' as above. 'seqnames' must ### be a factor-Rle where 'seqnames[i]' is the name of the reference ### sequence of the i-th alignment. ### 'at': must be a GRanges object containing the individual genomic ### positions of interest. 'seqlevels(at)' must be identical to ### 'levels(seqnames)'. ### Returns an XStringSet (typically DNAStringSet) object parallel to ### 'at' (i.e. with 1 string per genomic position of interest). pileLettersAt <- function(x, seqnames, pos, cigar, at) { stopifnot(is(x, "XStringSet")) N <- length(x) # nb of alignments stopifnot(is(seqnames, "Rle")) stopifnot(is.factor(runValue(seqnames))) stopifnot(length(seqnames) == N) stopifnot(is.integer(pos) && length(pos) == N) stopifnot(is.character(cigar) && length(cigar) == N) stopifnot(is(at, "GRanges")) stopifnot(all(width(at) == 1L)) stopifnot(identical(seqlevels(at), levels(seqnames))) ## We process 1 chromosome at a time. So we start by splitting ## 'x', 'pos', 'cigar', and 'start(at)' by chromosome. The 4 ## resulting list-like objects have 1 list element per chromosome ## in 'seqlevels(at)' (or in 'levels(seqnames)', which is identical ## to 'seqlevels(at)'). x_by_chrom <- split(x, seqnames) # XStringSetList pos_by_chrom <- split(pos, seqnames) # IntegerList cigar_by_chrom <- split(cigar, seqnames) # CharacterList at_by_chrom <- split(start(at), seqnames(at)) # IntegerList ## Unsplit index. split_idx <- unlist(split(seq_along(at), seqnames(at)), use.names=FALSE) unsplit_idx <- integer(length(at)) unsplit_idx[split_idx] <- seq_along(at) do.call("c", lapply(seq_along(seqlevels(at)), function(i) .pileLettersOnSingleRefAt( x_by_chrom[[i]], pos_by_chrom[[i]], cigar_by_chrom[[i]], at_by_chrom[[i]])))[unsplit_idx] } GenomicAlignments/R/readGAlignments.R0000644000175100017510000004151712607264575020613 0ustar00biocbuildbiocbuild### ========================================================================= ### readGAlignments() and related functions ### ------------------------------------------------------------------------- ### A "flag filter" is represented as a 'flag' vector of length 2 with names ### keep0 and keep1. The .combineBamFlagFilters() function performs a logical ### AND between 2 "flag filters". It returns a "flag filter". .combineBamFlagFilters <- function(flagfilterA, flagfilterB) { if (!identical(names(flagfilterA), c("keep0", "keep1")) || !identical(names(flagfilterB), c("keep0", "keep1"))) stop("input must be BAM flag filters") ans <- bamFlagAND(flagfilterA, flagfilterB) if (!all(bamFlagAsBitMatrix(ans[["keep0"]]) | bamFlagAsBitMatrix(ans[["keep1"]]))) stop("BAM flag filters to combine are incompatible") ans } .normargParam <- function(param, flag0, what0) { if (is.null(param)) param <- ScanBamParam() bamFlag(param) <- .combineBamFlagFilters(bamFlag(param, asInteger=TRUE), flag0) bamWhat(param) <- union(bamWhat(param), what0) param } ### 'x' must be a GAlignments object. .bindExtraData <- function(x, use.names, param, bamcols, with.which_label=FALSE) { if (use.names) names(x) <- bamcols$qname if (is.null(param)) return(x) colnames <- c(bamWhat(param), bamTag(param)) if (with.which_label) colnames <- c(colnames, "which_label") if (length(colnames) != 0L) { df <- do.call(DataFrame, bamcols[colnames]) ## Sadly, the DataFrame() constructor is mangling the duplicated ## colnames to make them unique. Since we of course don't want this, ## we need to fix them. colnames(df) <- colnames mcols(x) <- df } x } .load_bamcols_from_BamFile <- function(file, param, what0, with.which_label=FALSE) { flag0 <- scanBamFlag(isUnmappedQuery=FALSE) param <- .normargParam(param, flag0, what0) res <- scanBam(file, param=param) if (length(res) == 0L) # should never happen stop("scanBam() returned a list of length zero") Rsamtools:::.load_bamcols_from_scanBam_res(res, param, with.which_label=with.which_label) } .load_seqlengths_from_BamFile <- function(file, seqlevels) { seqlengths <- seqlengths(file) if (is.null(seqlengths)) return(NULL) bad <- setdiff(seqlevels, names(seqlengths)) if (length(bad) == 0L) return(seqlengths) bad <- paste(bad, collapse="' '") msg <- sprintf("'rname' lengths not in BamFile header; seqlengths not used\n file: %s\n missing rname(s): '%s'", path(file), bad) warning(msg) NULL } .open_BamFile <- function(file, index=file, asMates=FALSE, param=NULL) { if ((missing(index) || identical(index, file)) && (is.null(param) || length(bamWhich(param)) == 0L)) index <- character(0) open(BamFile(file, index=index, asMates=asMates), "rb") } ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### readGAlignments() ### setGeneric("readGAlignments", signature="file", function(file, index=file, use.names=FALSE, param=NULL, with.which_label=FALSE) standardGeneric("readGAlignments") ) .readGAlignments.BamFile <- function(file, index=file, use.names=FALSE, param=NULL, with.which_label=FALSE) { if (!isTRUEorFALSE(use.names)) stop("'use.names' must be TRUE or FALSE") if (is.null(param)) param <- ScanBamParam() if (!asMates(file)) bamWhat(param) <- setdiff(bamWhat(param), c("groupid", "mate_status")) what0 <- c("rname", "strand", "pos", "cigar") if (use.names) what0 <- c(what0, "qname") bamcols <- .load_bamcols_from_BamFile(file, param, what0, with.which_label=with.which_label) seqlengths <- .load_seqlengths_from_BamFile(file, levels(bamcols[["rname"]])) ans <- GAlignments(seqnames=bamcols$rname, pos=bamcols$pos, cigar=bamcols$cigar, strand=bamcols$strand, seqlengths=seqlengths) .bindExtraData(ans, use.names, param, bamcols, with.which_label=with.which_label) } setMethod("readGAlignments", "BamFile", .readGAlignments.BamFile) setMethod("readGAlignments", "character", function(file, index=file, use.names=FALSE, param=NULL, with.which_label=FALSE) { bam <- .open_BamFile(file, index=index, param=param) on.exit(close(bam)) readGAlignments(bam, character(0), use.names=use.names, param=param, with.which_label=with.which_label) } ) setMethod("readGAlignments", "BamViews", function(file, index=file, use.names=FALSE, param=NULL, with.which_label=FALSE) { if (missing(index)) index <- bamIndicies(file) if (is.null(param)) { param <- ScanBamParam(which=bamRanges(file)) } else if (!identical(bamRanges(file), bamWhich(param))) { warning("'bamRanges(file)' and 'bamWhich(param)' differ; using 'bamRanges(file)'") bamWhich(param) <- bamRanges(file) } fun <- function(i, bamViews, verbose) readGAlignments(file=bamPaths(bamViews)[i], index=bamIndicies(bamViews)[i], use.names=use.names, param=param, with.which_label=with.which_label) ### Rsamtools:::.BamViews_delegate requires the ShortRead package! Rsamtools:::.BamViews_delegate("readGAlignments", file, fun) } ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### readGAlignmentPairs() ### setGeneric("readGAlignmentPairs", signature="file", function(file, index=file, use.names=FALSE, param=NULL, with.which_label=FALSE, strandMode=1) standardGeneric("readGAlignmentPairs") ) ### 'use.mcols' can be TRUE, FALSE, or a character vector specifying the ### *inner* metadata columns to return, i.e., the metadata columns to set on ### the 2 halves of the returned GAlignmentPairs object. .make_GAlignmentPairs_from_GAlignments <- function(gal, strandMode=1L, use.mcols=FALSE) { mate_status <- mcols(gal)[ , "mate_status"] ## Dump alignments with "ambiguous" mate status. flushDumpedAlignments() dumped_gal <- gal[mate_status == "ambiguous"] dumped_count <- length(dumped_gal) if (dumped_count != 0L) { dumpAlignments(dumped_gal) warning(" ", dumped_count, " alignments with ambiguous pairing ", "were dumped.\n Use 'getDumpedAlignments()' to retrieve ", "them from the dump environment.") } ## Keep alignments with "mated" mate status only. is_mated <- mate_status == "mated" if (!all(is_mated)) { keep_idx <- which(is_mated) gal <- gal[keep_idx] } ## Check flag bits 0x40 and 0x80. flag <- mcols(gal)[ , "flag"] is_first_mate <- bamFlagAsBitMatrix(flag, bitnames="isFirstMateRead") is_last_mate <- bamFlagAsBitMatrix(flag, bitnames="isSecondMateRead") bits_0x40_0x80_are_ok <- is_first_mate != is_last_mate if (!all(bits_0x40_0x80_are_ok)) { keep_idx <- which(bits_0x40_0x80_are_ok) gal <- gal[keep_idx] is_first_mate <- is_first_mate[keep_idx] is_last_mate <- is_last_mate[keep_idx] } ## Split and order the pairs by ascending start position of the first mate. idx1 <- which(as.logical(is_first_mate)) oo1 <- S4Vectors:::orderIntegerPairs(as.integer(gal@seqnames)[idx1], gal@start[idx1]) idx1 <- idx1[oo1] idx2 <- which(as.logical(is_last_mate))[oo1] ans_first <- gal[idx1] ans_last <- gal[idx2] groupid1 <- mcols(ans_first)[ , "groupid"] groupid2 <- mcols(ans_last)[ , "groupid"] stopifnot(identical(groupid1, groupid2)) ## Drop the names. ans_names <- names(ans_first) names(ans_first) <- names(ans_last) <- NULL ## Check isProperPair (0x2) and isSecondaryAlignment (0x100) flag bits. flag1 <- mcols(ans_first)[ , "flag"] flag2 <- mcols(ans_last)[ , "flag"] is_proper1 <- bamFlagAsBitMatrix(flag1, bitnames="isProperPair") is_proper2 <- bamFlagAsBitMatrix(flag2, bitnames="isProperPair") stopifnot(identical(is_proper1, is_proper2)) is_secondary1 <- bamFlagAsBitMatrix(flag1, bitnames="isSecondaryAlignment") is_secondary2 <- bamFlagAsBitMatrix(flag2, bitnames="isSecondaryAlignment") stopifnot(identical(is_secondary1, is_secondary2)) ## Drop discordant pairs. is_discordant <- (seqnames(ans_first) != seqnames(ans_last)) | (strand(ans_first) == strand(ans_last)) discordant_idx <- which(is_discordant) if (length(discordant_idx) != 0L) { nb_discordant_proper <- sum(is_proper1[discordant_idx]) nb_discordant_not_proper <- length(discordant_idx) - nb_discordant_proper warning(length(discordant_idx), " pairs (", nb_discordant_proper, " proper, ", nb_discordant_not_proper, " not proper) were ", "dropped because the seqname\n or strand of the alignments ", "in the pair were not concordant.\n", " Note that a GAlignmentPairs object can only hold ", "concordant pairs at the\n moment, that is, pairs where ", "the 2 alignments are on the opposite strands\n of the same ", "reference sequence.") keep_idx <- which(!is_discordant) ans_first <- ans_first[keep_idx] ans_last <- ans_last[keep_idx] is_proper1 <- is_proper1[keep_idx] ans_names <- ans_names[keep_idx] } ## Make the GAlignmentPairs object and return it. if (is.character(use.mcols)) { mcols(ans_first) <- mcols(ans_first)[use.mcols] mcols(ans_last) <- mcols(ans_last)[use.mcols] } else if (!use.mcols) { mcols(ans_first) <- mcols(ans_last) <- NULL } GAlignmentPairs(ans_first, ans_last, strandMode=strandMode, isProperPair=as.logical(is_proper1), names=ans_names) } .readGAlignmentPairs.BamFile <- function(file, index=file, use.names=FALSE, param=NULL, with.which_label=FALSE, strandMode=1) { if (!asMates(file)) { asMates(file) <- TRUE ## This is required because BamFile objects have a pass-by-address ## semantic. on.exit(asMates(file) <- FALSE) } if (is.null(param)) param <- ScanBamParam() flag0 <- scanBamFlag(isPaired=TRUE, hasUnmappedMate=FALSE) what0 <- c("flag", "groupid", "mate_status") param2 <- .normargParam(param, flag0, what0) gal <- readGAlignments(file, use.names=use.names, param=param2, with.which_label=with.which_label) use.mcols <- c(bamWhat(param), bamTag(param)) if (with.which_label) use.mcols <- c(use.mcols, "which_label") .make_GAlignmentPairs_from_GAlignments(gal, strandMode=strandMode, use.mcols=use.mcols) } setMethod("readGAlignmentPairs", "BamFile", .readGAlignmentPairs.BamFile) setMethod("readGAlignmentPairs", "character", function(file, index=file, use.names=FALSE, param=NULL, with.which_label=FALSE, strandMode=1) { bam <- .open_BamFile(file, index=index, asMates=TRUE, param=param) on.exit(close(bam)) readGAlignmentPairs(bam, character(0), use.names=use.names, param=param, with.which_label=with.which_label, strandMode=strandMode) } ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### readGAlignmentsList() ### setGeneric("readGAlignmentsList", signature="file", function(file, index=file, use.names=FALSE, param=ScanBamParam(), with.which_label=FALSE) standardGeneric("readGAlignmentsList") ) .matesFromBam <- function(file, use.names, param, what0, with.which_label) { bamcols <- .load_bamcols_from_BamFile(file, param, what0, with.which_label=with.which_label) seqlengths <- .load_seqlengths_from_BamFile(file, levels(bamcols$rname)) gal <- GAlignments(seqnames=bamcols$rname, pos=bamcols$pos, cigar=bamcols$cigar, strand=bamcols$strand, seqlengths=seqlengths) gal <- .bindExtraData(gal, use.names=FALSE, param, bamcols, with.which_label=with.which_label) if (asMates(file)) { f <- factor(bamcols$groupid) gal <- unname(split(gal, f)) mcols(gal)$mate_status <- bamcols$mate_status[match(levels(f), bamcols$groupid)] } else { ## groupid=NULL when asMates=FALSE gal <- unname(split(gal, seq_along(gal))) } if (use.names) names(gal) <- unique(splitAsList(bamcols$qname, bamcols$groupid)) gal } .readGAlignmentsList.BamFile <- function(file, index=file, use.names=FALSE, param=ScanBamParam(), with.which_label=FALSE) { if (!isTRUEorFALSE(use.names)) stop("'use.names' must be TRUE or FALSE") if (!asMates(file)) bamWhat(param) <- setdiff(bamWhat(param), c("groupid", "mate_status")) what0 <- c("rname", "strand", "pos", "cigar", "groupid", "mate_status") if (use.names) what0 <- c(what0, "qname") .matesFromBam(file, use.names, param, what0, with.which_label) } setMethod("readGAlignmentsList", "BamFile", .readGAlignmentsList.BamFile) setMethod("readGAlignmentsList", "character", function(file, index=file, use.names=FALSE, param=ScanBamParam(), with.which_label=FALSE) { bam <- .open_BamFile(file, index=index, asMates=TRUE, param=param) on.exit(close(bam)) readGAlignmentsList(bam, character(0), use.names=use.names, param=param, with.which_label=with.which_label) } ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### readGappedReads() ### setGeneric("readGappedReads", signature="file", function(file, index=file, use.names=FALSE, param=NULL, with.which_label=FALSE) standardGeneric("readGappedReads") ) .readGappedReads.BamFile <- function(file, index=file, use.names=FALSE, param=NULL, with.which_label=FALSE) { if (!isTRUEorFALSE(use.names)) stop("'use.names' must be TRUE or FALSE") if (is.null(param)) param <- ScanBamParam() if (!asMates(file)) bamWhat(param) <- setdiff(bamWhat(param), c("groupid", "mate_status")) what0 <- c("rname", "strand", "pos", "cigar", "seq") if (use.names) what0 <- c(what0, "qname") bamcols <- .load_bamcols_from_BamFile(file, param, what0, with.which_label=with.which_label) seqlengths <- .load_seqlengths_from_BamFile(file, levels(bamcols[["rname"]])) ans <- GappedReads(seqnames=bamcols$rname, pos=bamcols$pos, cigar=bamcols$cigar, strand=bamcols$strand, qseq=bamcols$seq, seqlengths=seqlengths) .bindExtraData(ans, use.names, param, bamcols, with.which_label=with.which_label) } setMethod("readGappedReads", "BamFile", .readGappedReads.BamFile) setMethod("readGappedReads", "character", function(file, index=file, use.names=FALSE, param=NULL, with.which_label=FALSE) { bam <- .open_BamFile(file, index=index, param=param) on.exit(close(bam)) readGappedReads(bam, character(0), use.names=use.names, param=param, with.which_label=with.which_label) } ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Old stuff (deprecated & defunct) ### readGAlignmentsFromBam <- function(...) { .Defunct("readGAlignments") readGAlignments(...) } readGAlignmentPairsFromBam <- function(...) { .Defunct("readGAlignmentPairs") readGAlignmentPairs(...) } readGAlignmentsListFromBam <- function(...) { .Defunct("readGAlignmentsList") readGAlignmentsList(...) } readGappedReadsFromBam <- function(...) { .Defunct("readGappedReads") readGappedReads(...) } GenomicAlignments/R/sequenceLayer.R0000644000175100017510000006005312607264575020350 0ustar00biocbuildbiocbuild### ========================================================================= ### sequenceLayer() ### ------------------------------------------------------------------------- .make_empty_sequences <- function(skeleton, class="BStringSet") { if (is.null(skeleton)) return(NULL) skeleton <- PartitioningByEnd(skeleton) skeleton_len <- length(skeleton) if (skeleton_len == 0L) { unlisted_len <- 0L } else { unlisted_len <- end(skeleton)[skeleton_len] } unlisted_ans <- rep.int(as("", class), unlisted_len) relist(unlisted_ans, skeleton) } ### 'filler_width' must be an integer vector, and 'letter' an XString object ### of length 1. .make_sequence_fillers_from_widths <- function(filler_width, letter) { if (length(filler_width) == 0L) { max_width <- 0L at <- IRanges() } else { max_width <- max(filler_width) at <- IRanges(1L, filler_width) } biggest_filler <- rep.int(letter, max_width) extractAt(biggest_filler, at) } ### 'filler_widths' must be an IntegerList object (or list of integers). .make_sequence_fillers_from_list_of_widths <- function(filler_widths, letter) { unlisted_widths <- unlist(filler_widths, use.names=FALSE) unlisted_ans <- .make_sequence_fillers_from_widths(unlisted_widths, letter) relist(unlisted_ans, filler_widths) } ### Parallel combine. .pcombine <- function(x, y) { if (is.null(x)) return(y) if (is.null(y)) return(x) if (length(x) != length(y)) stop("'x' and 'y' must have the same length") xy <- c(x, y) collate_subscript <- S4Vectors:::make_XYZxyz_to_XxYyZz_subscript(length(x)) ans_flesh <- unlist(xy[collate_subscript], use.names=FALSE) ans_breakpoints <- end(PartitioningByEnd(x)) + end(PartitioningByEnd(y)) ans_skeleton <- PartitioningByEnd(ans_breakpoints) relist(ans_flesh, ans_skeleton) } ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### sequenceLayer() ### .make_fillers <- function(cigar, ops, letter) { ops_width <- explodeCigarOpLengths(cigar, ops=ops) .make_sequence_fillers_from_list_of_widths(ops_width, letter) } .D_ranges_on_query_space <- function(cigar, before.hard.clipping=FALSE, after.soft.clipping=FALSE) { cigarRangesAlongQuerySpace(cigar, before.hard.clipping=before.hard.clipping, after.soft.clipping=after.soft.clipping, ops="D") } .N_ranges_on_query_space <- function(cigar, before.hard.clipping=FALSE, after.soft.clipping=FALSE) { cigarRangesAlongQuerySpace(cigar, before.hard.clipping=before.hard.clipping, after.soft.clipping=after.soft.clipping, ops="N") } .D_and_N_ranges_on_query_space <- function(cigar, before.hard.clipping=FALSE, after.soft.clipping=FALSE) { D_ranges <- .D_ranges_on_query_space(cigar, before.hard.clipping=before.hard.clipping, after.soft.clipping=after.soft.clipping) N_ranges <- .N_ranges_on_query_space(cigar, before.hard.clipping=before.hard.clipping, after.soft.clipping=after.soft.clipping) .pcombine(D_ranges, N_ranges) } .make_D_and_N_fillers <- function(cigar, D.letter, N.letter) { D_fillers <- .make_fillers(cigar, "D", D.letter) N_fillers <- .make_fillers(cigar, "N", N.letter) .pcombine(D_fillers, N_fillers) } sequenceLayer <- function(x, cigar, from="query", to="reference", D.letter="-", N.letter=".", I.letter="-", S.letter="+", H.letter="+") { if (!is(x, "XStringSet")) stop("'x' must be an XStringSet object") ## The 8 spaces below are also defined at the top of the src/cigar_utils.c ## file in the GenomicAlignments package. SPACES <- c("reference", "reference-N-regions-removed", "query", "query-before-hard-clipping", "query-after-soft-clipping", "pairwise", "pairwise-N-regions-removed", "pairwise-dense") from <- match.arg(from, SPACES) to <- match.arg(to, SPACES) D.letter <- Biostrings:::.normarg_padding.letter(D.letter, seqtype(x)) N.letter <- Biostrings:::.normarg_padding.letter(N.letter, seqtype(x)) I.letter <- Biostrings:::.normarg_padding.letter(I.letter, seqtype(x)) S.letter <- Biostrings:::.normarg_padding.letter(S.letter, seqtype(x)) H.letter <- Biostrings:::.normarg_padding.letter(H.letter, seqtype(x)) if (from == to) return(x) ## Right now, the way 'S.letter' and 'H.letter' are injected in 'x' when ## 'to' is "query-before-hard-clipping" can result in padding in the ## wrong order (i.e. padding with 'H.letter' followed by padding with ## 'S.letter') so we temporarily work around this by enforcing 'S.letter' ## and 'H.letter' to be the same. if (from != "query" && to == "query-before-hard-clipping" && as.character(S.letter) != as.character(H.letter)) stop("'H.letter' must be the same as 'S.letter' ", "when 'from' is not \"query\" and 'to' ", "is \"query-before-hard-clipping\"") ## TODO: What follows is a big ugly piece of stinking code (350 lines!). ## There is of course a better way... inject_at <- ops_to_remove <- NULL if (from == "reference") { getCigarRanges <- function(cigar, ops) cigarRangesAlongReferenceSpace(cigar, ops=ops) if (to == "reference-N-regions-removed") { ## "reference" -> "reference-N-regions-removed" ops_to_remove <- "N" } else if (to == "query") { ## "reference" -> "query" ops_to_remove <- c("D", "N") I_inject_at <- getCigarRanges(cigar, "I") I_fillers <- .make_fillers(cigar, "I", I.letter) S_inject_at <- getCigarRanges(cigar, "S") S_fillers <- .make_fillers(cigar, "S", S.letter) inject_at <- .pcombine(I_inject_at, S_inject_at) fillers <- .pcombine(I_fillers, S_fillers) } else if (to == "query-before-hard-clipping") { ## "reference" -> "query-before-hard-clipping" ops_to_remove <- c("D", "N") I_inject_at <- getCigarRanges(cigar, "I") I_fillers <- .make_fillers(cigar, "I", I.letter) S_inject_at <- getCigarRanges(cigar, "S") S_fillers <- .make_fillers(cigar, "S", S.letter) H_inject_at <- getCigarRanges(cigar, "H") H_fillers <- .make_fillers(cigar, "H", H.letter) inject_at <- .pcombine(I_inject_at, S_inject_at) inject_at <- .pcombine(inject_at, H_inject_at) fillers <- .pcombine(I_fillers, S_fillers) fillers <- .pcombine(fillers, H_fillers) } else if (to == "query-after-soft-clipping") { ## "reference" -> "query-after-soft-clipping" ops_to_remove <- c("D", "N") ops_to_inject <- "I" inject_at <- getCigarRanges(cigar, ops_to_inject) fillers <- .make_fillers(cigar, ops_to_inject, I.letter) } else if (to == "pairwise") { ## "reference" -> "pairwise" ops_to_inject <- "I" inject_at <- getCigarRanges(cigar, ops_to_inject) fillers <- .make_fillers(cigar, ops_to_inject, I.letter) } else if (to == "pairwise-N-regions-removed") { ## "reference" -> "pairwise-N-regions-removed" ops_to_remove <- "N" ops_to_inject <- "I" inject_at <- getCigarRanges(cigar, ops_to_inject) fillers <- .make_fillers(cigar, ops_to_inject, I.letter) } else if (to == "pairwise-dense") { ## "reference" -> "pairwise-dense" ops_to_remove <- c("D", "N") } } else if (from == "reference-N-regions-removed") { getCigarRanges <- function(cigar, ops) cigarRangesAlongReferenceSpace(cigar, N.regions.removed=TRUE, ops=ops) if (to == "reference") { ## "reference-N-regions-removed" -> "reference" ops_to_inject <- "N" inject_at <- getCigarRanges(cigar, ops_to_inject) fillers <- .make_fillers(cigar, ops_to_inject, N.letter) } else if (to == "query") { ## "reference-N-regions-removed" -> "query" ops_to_remove <- "D" I_inject_at <- getCigarRanges(cigar, "I") I_fillers <- .make_fillers(cigar, "I", I.letter) S_inject_at <- getCigarRanges(cigar, "S") S_fillers <- .make_fillers(cigar, "S", S.letter) inject_at <- .pcombine(I_inject_at, S_inject_at) fillers <- .pcombine(I_fillers, S_fillers) } else if (to == "query-before-hard-clipping") { ## "reference-N-regions-removed" -> "query-before-hard-clipping" ops_to_remove <- "D" I_inject_at <- getCigarRanges(cigar, "I") I_fillers <- .make_fillers(cigar, "I", I.letter) S_inject_at <- getCigarRanges(cigar, "S") S_fillers <- .make_fillers(cigar, "S", S.letter) H_inject_at <- getCigarRanges(cigar, "H") H_fillers <- .make_fillers(cigar, "H", H.letter) inject_at <- .pcombine(I_inject_at, S_inject_at) inject_at <- .pcombine(inject_at, H_inject_at) fillers <- .pcombine(I_fillers, S_fillers) fillers <- .pcombine(fillers, H_fillers) } else if (to == "query-after-soft-clipping") { ## "reference-N-regions-removed" -> "query-after-soft-clipping" ops_to_remove <- "D" ops_to_inject <- "I" inject_at <- getCigarRanges(cigar, ops_to_inject) fillers <- .make_fillers(cigar, ops_to_inject, I.letter) } else if (to == "pairwise") { ## "reference-N-regions-removed" -> "pairwise" I_inject_at <- getCigarRanges(cigar, "I") I_fillers <- .make_fillers(cigar, "I", I.letter) N_inject_at <- getCigarRanges(cigar, "N") N_fillers <- .make_fillers(cigar, "N", N.letter) inject_at <- .pcombine(I_inject_at, N_inject_at) fillers <- .pcombine(I_fillers, N_fillers) } else if (to == "pairwise-N-regions-removed") { ## "reference-N-regions-removed" -> "pairwise-N-regions-removed" ops_to_inject <- "I" inject_at <- getCigarRanges(cigar, ops_to_inject) fillers <- .make_fillers(cigar, ops_to_inject, I.letter) } else if (to == "pairwise-dense") { ## "reference-N-regions-removed" -> "pairwise-dense" ops_to_remove <- "D" } } else if (from == "query") { getCigarRanges <- function(cigar, ops) cigarRangesAlongQuerySpace(cigar, ops=ops) if (to == "reference") { ## "query" -> "reference" ops_to_remove <- c("I", "S") inject_at <- .D_and_N_ranges_on_query_space(cigar) fillers <- .make_D_and_N_fillers(cigar, D.letter, N.letter) } else if (to == "reference-N-regions-removed") { ## "query" -> "reference-N-regions-removed" ops_to_remove <- c("S", "I") ops_to_inject <- "D" inject_at <- getCigarRanges(cigar, ops_to_inject) fillers <- .make_fillers(cigar, ops_to_inject, D.letter) } else if (to == "query-before-hard-clipping") { ## "query" -> "query-before-hard-clipping" ops_to_inject <- "H" inject_at <- getCigarRanges(cigar, ops_to_inject) fillers <- .make_fillers(cigar, ops_to_inject, H.letter) } else if (to == "query-after-soft-clipping") { ## "query" -> "query-after-soft-clipping" ops_to_remove <- "S" } else if (to == "pairwise") { ## "query" -> "pairwise" ops_to_remove <- "S" inject_at <- .D_and_N_ranges_on_query_space(cigar) fillers <- .make_D_and_N_fillers(cigar, D.letter, N.letter) } else if (to == "pairwise-N-regions-removed") { ## "query" -> "pairwise-N-regions-removed" ops_to_remove <- "S" ops_to_inject <- "D" inject_at <- getCigarRanges(cigar, ops_to_inject) fillers <- .make_fillers(cigar, ops_to_inject, D.letter) } else if (to == "pairwise-dense") { ## "query" -> "pairwise-dense" ops_to_remove <- c("I", "S") } } else if (from == "query-before-hard-clipping") { getCigarRanges <- function(cigar, ops) cigarRangesAlongQuerySpace(cigar, before.hard.clipping=TRUE, ops=ops) if (to == "reference") { ## "query-before-hard-clipping" -> "reference" ops_to_remove <- c("H", "S", "I") inject_at <- .D_and_N_ranges_on_query_space(cigar, before.hard.clipping=TRUE) fillers <- .make_D_and_N_fillers(cigar, D.letter, N.letter) } else if (to == "reference-N-regions-removed") { ## "query-before-hard-clipping" -> "reference-N-regions-removed" ops_to_remove <- c("H", "S", "I") ops_to_inject <- "D" inject_at <- getCigarRanges(cigar, ops_to_inject) fillers <- .make_fillers(cigar, ops_to_inject, D.letter) } else if (to == "query") { ## "query-before-hard-clipping" -> "query" ops_to_remove <- "H" } else if (to == "query-after-soft-clipping") { ## "query-before-hard-clipping" -> "query-after-soft-clipping" ops_to_remove <- c("H", "S") } else if (to == "pairwise") { ## "query-before-hard-clipping" -> "pairwise" ops_to_remove <- c("H", "S") inject_at <- .D_and_N_ranges_on_query_space(cigar, before.hard.clipping=TRUE) fillers <- .make_D_and_N_fillers(cigar, D.letter, N.letter) } else if (to == "pairwise-N-regions-removed") { ## "query-before-hard-clipping" -> "pairwise-N-regions-removed" ops_to_remove <- c("H", "S") ops_to_inject <- "D" inject_at <- getCigarRanges(cigar, ops_to_inject) fillers <- .make_fillers(cigar, ops_to_inject, D.letter) } else if (to == "pairwise-dense") { ## "query-before-hard-clipping" -> "pairwise-dense" ops_to_remove <- c("I", "S", "H") } } else if (from == "query-after-soft-clipping") { getCigarRanges <- function(cigar, ops) cigarRangesAlongQuerySpace(cigar, after.soft.clipping=TRUE, ops=ops) if (to == "reference") { ## "query-after-soft-clipping" -> "reference" ops_to_remove <- "I" inject_at <- .D_and_N_ranges_on_query_space(cigar, after.soft.clipping=TRUE) fillers <- .make_D_and_N_fillers(cigar, D.letter, N.letter) } else if (to == "reference-N-regions-removed") { ## "query-after-soft-clipping" -> "reference-N-regions-removed" ops_to_remove <- "I" ops_to_inject <- "D" inject_at <- getCigarRanges(cigar, ops_to_inject) fillers <- .make_fillers(cigar, ops_to_inject, D.letter) } else if (to == "query") { ## "query-after-soft-clipping" -> "query" ops_to_inject <- "S" inject_at <- getCigarRanges(cigar, ops_to_inject) fillers <- .make_fillers(cigar, ops_to_inject, S.letter) } else if (to == "query-before-hard-clipping") { ## "query-after-soft-clipping" -> "query-before-hard-clipping" S_inject_at <- getCigarRanges(cigar, "S") S_fillers <- .make_fillers(cigar, "S", S.letter) H_inject_at <- getCigarRanges(cigar, "H") H_fillers <- .make_fillers(cigar, "H", H.letter) inject_at <- .pcombine(S_inject_at, H_inject_at) fillers <- .pcombine(S_fillers, H_fillers) } else if (to == "pairwise") { ## "query-after-soft-clipping" -> "pairwise" inject_at <- .D_and_N_ranges_on_query_space(cigar, after.soft.clipping=TRUE) fillers <- .make_D_and_N_fillers(cigar, D.letter, N.letter) } else if (to == "pairwise-N-regions-removed") { ## "query-after-soft-clipping" -> "pairwise-N-regions-removed" ops_to_inject <- "D" inject_at <- getCigarRanges(cigar, ops_to_inject) fillers <- .make_fillers(cigar, ops_to_inject, D.letter) } else if (to == "pairwise-dense") { ## "query-after-soft-clipping" -> "pairwise-dense" ops_to_remove <- "I" } } else if (from == "pairwise") { getCigarRanges <- function(cigar, ops) cigarRangesAlongPairwiseSpace(cigar, ops=ops) if (to == "reference") { ## "pairwise" -> "reference" ops_to_remove <- "I" } else if (to == "reference-N-regions-removed") { ## "pairwise" -> "reference-N-regions-removed" ops_to_remove <- c("I", "N") } else if (to == "query") { ## "pairwise" -> "query" ops_to_remove <- c("D", "N") ops_to_inject <- "S" inject_at <- getCigarRanges(cigar, ops_to_inject) fillers <- .make_fillers(cigar, ops_to_inject, S.letter) } else if (to == "query-before-hard-clipping") { ## "pairwise" -> "query-before-hard-clipping" ops_to_remove <- c("D", "N") S_inject_at <- getCigarRanges(cigar, "S") S_fillers <- .make_fillers(cigar, "S", S.letter) H_inject_at <- getCigarRanges(cigar, "H") H_fillers <- .make_fillers(cigar, "H", H.letter) inject_at <- .pcombine(S_inject_at, H_inject_at) fillers <- .pcombine(S_fillers, H_fillers) } else if (to == "query-after-soft-clipping") { ## "pairwise" -> "query-after-soft-clipping" ops_to_remove <- c("D", "N") } else if (to == "pairwise-N-regions-removed") { ## "pairwise" -> "pairwise-N-regions-removed" ops_to_remove <- "N" } else if (to == "pairwise-dense") { ## "pairwise" -> "pairwise-dense" ops_to_remove <- c("I", "D", "N") } } else if (from == "pairwise-N-regions-removed") { getCigarRanges <- function(cigar, ops) cigarRangesAlongPairwiseSpace(cigar, N.regions.removed=TRUE, ops=ops) if (to == "reference") { ## "pairwise-N-regions-removed" -> "reference" ops_to_remove <- "I" ops_to_inject <- "N" inject_at <- getCigarRanges(cigar, ops_to_inject) fillers <- .make_fillers(cigar, ops_to_inject, N.letter) } else if (to == "reference-N-regions-removed") { ## "pairwise-N-regions-removed" -> "reference-N-regions-removed" ops_to_remove <- "I" } else if (to == "query") { ## "pairwise-N-regions-removed" -> "query" ops_to_remove <- "D" ops_to_inject <- "S" inject_at <- getCigarRanges(cigar, ops_to_inject) fillers <- .make_fillers(cigar, ops_to_inject, S.letter) } else if (to == "query-before-hard-clipping") { ## "pairwise-N-regions-removed" -> "query-before-hard-clipping" ops_to_remove <- "D" S_inject_at <- getCigarRanges(cigar, "S") S_fillers <- .make_fillers(cigar, "S", S.letter) H_inject_at <- getCigarRanges(cigar, "H") H_fillers <- .make_fillers(cigar, "H", H.letter) inject_at <- .pcombine(S_inject_at, H_inject_at) fillers <- .pcombine(S_fillers, H_fillers) } else if (to == "query-after-soft-clipping") { ## "pairwise-N-regions-removed" -> "query-after-soft-clipping" ops_to_remove <- "D" } else if (to == "pairwise") { ## "pairwise-N-regions-removed" -> "pairwise" ops_to_inject <- "N" inject_at <- getCigarRanges(cigar, ops_to_inject) fillers <- .make_fillers(cigar, ops_to_inject, N.letter) } else if (to == "pairwise-dense") { ## "pairwise-N-regions-removed" -> "pairwise-dense" ops_to_remove <- c("I", "D") } } else if (from == "pairwise-dense") { getCigarRanges <- function(cigar, ops) cigarRangesAlongPairwiseSpace(cigar, dense=TRUE, ops=ops) if (to == "reference") { ## "pairwise-dense" -> "reference" D_inject_at <- getCigarRanges(cigar, "D") D_fillers <- .make_fillers(cigar, "D", D.letter) N_inject_at <- getCigarRanges(cigar, "N") N_fillers <- .make_fillers(cigar, "N", N.letter) inject_at <- .pcombine(D_inject_at, N_inject_at) fillers <- .pcombine(D_fillers, N_fillers) } else if (to == "reference-N-regions-removed") { ## "pairwise-dense" -> "reference-N-regions-removed" ops_to_inject <- "D" inject_at <- getCigarRanges(cigar, ops_to_inject) fillers <- .make_fillers(cigar, ops_to_inject, D.letter) } else if (to == "query") { ## "pairwise-dense" -> "query" I_inject_at <- getCigarRanges(cigar, "I") I_fillers <- .make_fillers(cigar, "I", I.letter) S_inject_at <- getCigarRanges(cigar, "S") S_fillers <- .make_fillers(cigar, "S", S.letter) inject_at <- .pcombine(I_inject_at, S_inject_at) fillers <- .pcombine(I_fillers, S_fillers) } else if (to == "query-before-hard-clipping") { ## "pairwise-dense" -> "query-before-hard-clipping" I_inject_at <- getCigarRanges(cigar, "I") I_fillers <- .make_fillers(cigar, "I", I.letter) S_inject_at <- getCigarRanges(cigar, "S") S_fillers <- .make_fillers(cigar, "S", S.letter) H_inject_at <- getCigarRanges(cigar, "H") H_fillers <- .make_fillers(cigar, "H", H.letter) inject_at <- .pcombine(.pcombine(I_inject_at, S_inject_at), H_inject_at) fillers <- .pcombine(.pcombine(I_fillers, S_fillers), H_fillers) } else if (to == "query-after-soft-clipping") { ## "pairwise-dense" -> "query-after-soft-clipping" ops_to_inject <- "I" inject_at <- getCigarRanges(cigar, ops_to_inject) fillers <- .make_fillers(cigar, ops_to_inject, I.letter) } else if (to == "pairwise") { ## "pairwise-dense" -> "pairwise" I_inject_at <- getCigarRanges(cigar, "I") I_fillers <- .make_fillers(cigar, "I", I.letter) D_inject_at <- getCigarRanges(cigar, "D") D_fillers <- .make_fillers(cigar, "D", D.letter) N_inject_at <- getCigarRanges(cigar, "N") N_fillers <- .make_fillers(cigar, "N", N.letter) inject_at <- .pcombine(.pcombine(I_inject_at, D_inject_at), N_inject_at) fillers <- .pcombine(.pcombine(I_fillers, D_fillers), N_fillers) } else if (to == "pairwise-N-regions-removed") { ## "pairwise-dense" -> "pairwise-N-regions-removed" I_inject_at <- getCigarRanges(cigar, "I") I_fillers <- .make_fillers(cigar, "I", I.letter) D_inject_at <- getCigarRanges(cigar, "D") D_fillers <- .make_fillers(cigar, "D", D.letter) inject_at <- .pcombine(I_inject_at, D_inject_at) fillers <- .pcombine(I_fillers, D_fillers) } } at <- inject_at if (is.null(inject_at)) { value <- NULL } else { value <- fillers } if (length(ops_to_remove) != 0L) { at2 <- getCigarRanges(cigar, ops_to_remove) value2 <- .make_empty_sequences(at2, class=class(x)) at <- .pcombine(at, at2) value <- .pcombine(value, value2) } replaceAt(x, at, value=value) } GenomicAlignments/R/setops-methods.R0000644000175100017510000000162312607264575020517 0ustar00biocbuildbiocbuild### ========================================================================= ### Set operations ### ------------------------------------------------------------------------- ### ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### pintersect() ### ### TODO: Revisit this method (seems to do strange things). setMethod("pintersect", c("GAlignments", "GRanges"), function(x, y, ...) { bounds <- try(callGeneric(granges(x), y), silent=TRUE) if (inherits(bounds, "try-error")) stop("CIGAR is empty after intersection") start <- start(bounds) - start(x) + 1L start[which(start < 1L)] <- 1L end <- end(bounds) - end(x) - 1L end[which(end > -1L)] <- -1L narrow(x, start=start, end=end) } ) setMethod("pintersect", c("GRanges", "GAlignments"), function(x, y, ...) { callGeneric(y, x) } ) GenomicAlignments/R/stackStringsFromBam.R0000644000175100017510000001122712607264575021465 0ustar00biocbuildbiocbuild### ========================================================================= ### stackStringsFromBam() ### ------------------------------------------------------------------------- ### Should always return a ScanBamParam object containing exactly 1 genomic ### region. .normarg_param <- function(param) { if (isSingleString(param)) { tmp1 <- strsplit(param, ":", fixed=TRUE)[[1L]] if (length(tmp1) != 2L) stop("when a character string, 'param' must be ", "of the form \"chr14:5201-5300\"") tmp2 <- as.integer(strsplit(tmp1[2L], "-", fixed=TRUE)[[1L]]) if (length(tmp2) != 2L || any(is.na(tmp2))) stop("when a character string, 'param' must be ", "of the form \"chr14:5201-5300\"") param <- GRanges(tmp1[1L], IRanges(tmp2[1L], tmp2[2L])) } if (is(param, "GenomicRanges")) { if (length(param) != 1L) stop("when a GRanges object, 'param' must have length 1") seqlevels(param) <- seqlevelsInUse(param) param <- ScanBamParam(which=param) return(param) } if (is(param, "RangesList")) { ## We support RangesList just because ScanBamParam() supports it too ## and also because that's what's returned by bamWhich(). param <- param[elementLengths(param) != 0L] if (length(unlist(param, use.names=FALSE)) != 1L) stop("when a RangesList object, 'param' must contain exactly 1 ", "genomic region\n (i.e. 'unlist(param)' must have length 1)") param <- ScanBamParam(which=param) return(param) } if (!is(param, "ScanBamParam")) stop("'param' must be either a ScanBamParam or RangesList object ", "containing\n exactly 1 genomic region, or a GRanges object ", "of length 1, or a character\n string specifying a single ", "genomic region (in the \"chr14:5201-5300\" format)") param_which <- bamWhich(param) param_which <- param_which[elementLengths(param_which) != 0L] if (length(unlist(param_which, use.names=FALSE)) != 1L) stop("when a ScanBamParam object, 'param' must contain exactly 1 ", "genomic region\n (i.e. 'unlist(bamWhich(param))' must have ", "length 1)") bamWhich(param) <- param_which param } stackStringsFromBam <- function(file, index=file, param, what="seq", use.names=FALSE, D.letter="-", N.letter=".", Lpadding.letter="+", Rpadding.letter="+") { param <- .normarg_param(param) region_range <- unlist(bamWhich(param), use.names=FALSE) what <- match.arg(what, c("seq", "qual")) param_what <- bamWhat(param) if (!(what %in% param_what)) bamWhat(param) <- c(param_what, what) gal <- readGAlignments(file, index=index, use.names=use.names, param=param) gal_mcols <- mcols(gal) what_col_idx <- match(what, colnames(gal_mcols)) what_col <- gal_mcols[[what_col_idx]] if (what == "qual") what_col <- BStringSet(what_col) layed_seq <- sequenceLayer(what_col, cigar(gal), D.letter=D.letter, N.letter=N.letter) ans <- stackStrings(layed_seq, start(region_range), end(region_range), shift=start(gal)-1L, Lpadding.letter=Lpadding.letter, Rpadding.letter=Rpadding.letter) if (!(what %in% param_what)) { ## Remove the what column from 'gal_mcols'. gal_mcols <- gal_mcols[ , -what_col_idx, drop=FALSE] ## Sadly, subsetting a DataFrame will mangle the colnames of the ## returned DataFrame if it has duplicated colnames. Since we of ## course don't want this, we fix them. colnames(gal_mcols) <- param_what } names(ans) <- names(gal) mcols(ans) <- gal_mcols ans } alphabetFrequencyFromBam <- function(file, index=file, param, what="seq", ...) { param <- .normarg_param(param) region_range <- unlist(bamWhich(param), use.names=FALSE) region_seqname <- names(bamWhich(param)) what <- match.arg(what, c("seq", "qual")) bamWhat(param) <- what gal <- readGAlignments(file, index=index, param=param) seqlevels(gal) <- region_seqname what_col <- mcols(gal)[ , what] if (what == "qual") what_col <- BStringSet(what_col) at <- start(region_range) - 1L + seq_len(width(region_range)) at <- GRanges(region_seqname, IRanges(at, width=1L)) piles <- pileLettersAt(what_col, seqnames(gal), start(gal), cigar(gal), at) alphabetFrequency(piles, ...) } GenomicAlignments/R/summarizeOverlaps-methods.R0000644000175100017510000003271512607264575022740 0ustar00biocbuildbiocbuild### ========================================================================= ### summarizeOverlaps() generic and methods ### ------------------------------------------------------------------------- setGeneric("summarizeOverlaps", signature=c("features", "reads"), function(features, reads, mode=Union, algorithm=c("nclist", "intervaltree"), ignore.strand=FALSE, ...) standardGeneric("summarizeOverlaps") ) ### ------------------------------------------------------------------------- ### Methods for GAlignments, GAlignmentsList and GAlignmentPairs objects ### .dispatchOverlaps <- function(features, reads, mode, algorithm, ignore.strand, inter.feature, preprocess.reads, ...) { if (ignore.strand) { if (class(features) == "GRangesList") { r <- unlist(features) strand(r) <- "*" features@unlistData <- r } else { strand(features) <- "*" } } if (!is.null(preprocess.reads)) reads <- preprocess.reads(reads, ...) mode(features, reads, algorithm=algorithm, ignore.strand=ignore.strand, inter.feature=inter.feature) } .summarizeOverlaps <- function(features, reads, mode=Union, algorithm=c("nclist", "intervaltree"), ignore.strand=FALSE, inter.feature=TRUE, preprocess.reads=NULL, ...) { if (class(reads) == "GRangesList") { if (all(unlist(strand(reads), use.names=FALSE) == "*")) ignore.strand <- TRUE } else { if (all(strand(reads) == "*")) ignore.strand <- TRUE } mode <- match.fun(mode) counts <- .dispatchOverlaps(features, reads, mode, match.arg(algorithm), ignore.strand, inter.feature, preprocess.reads, ...) colData <- DataFrame(object=class(reads), records=length(reads), row.names="reads") SummarizedExperiment(assays=SimpleList(counts=as.matrix(counts)), rowRanges=features, colData=colData) } setMethod("summarizeOverlaps", c("GRanges", "GAlignments"), .summarizeOverlaps ) setMethod("summarizeOverlaps", c("GRangesList", "GAlignments"), .summarizeOverlaps ) setMethod("summarizeOverlaps", c("GRanges", "GAlignmentsList"), .summarizeOverlaps ) setMethod("summarizeOverlaps", c("GRangesList", "GAlignmentsList"), .summarizeOverlaps ) setMethod("summarizeOverlaps", c("GRanges", "GAlignmentPairs"), .summarizeOverlaps ) setMethod("summarizeOverlaps", c("GRangesList", "GAlignmentPairs"), .summarizeOverlaps ) setMethod("summarizeOverlaps", c("GRanges", "GRanges"), .summarizeOverlaps ) setMethod("summarizeOverlaps", c("GRangesList", "GRanges"), .summarizeOverlaps ) setMethod("summarizeOverlaps", c("GRanges", "GRangesList"), .summarizeOverlaps ) setMethod("summarizeOverlaps", c("GRangesList", "GRangesList"), .summarizeOverlaps ) ### ------------------------------------------------------------------------- ### 'mode' functions ### Union <- function(features, reads, algorithm=c("nclist", "intervaltree"), ignore.strand=FALSE, inter.feature=TRUE) { ov <- findOverlaps(features, reads, algorithm=match.arg(algorithm), ignore.strand=ignore.strand) if (inter.feature) { ## Remove ambigous reads. reads_to_keep <- which(countSubjectHits(ov) == 1L) ov <- ov[subjectHits(ov) %in% reads_to_keep] } countQueryHits(ov) } IntersectionStrict <- function(features, reads, algorithm=c("nclist", "intervaltree"), ignore.strand=FALSE, inter.feature=TRUE) { ov <- findOverlaps(reads, features, type="within", algorithm=match.arg(algorithm), ignore.strand=ignore.strand) if (inter.feature) { ## Remove ambigous reads. reads_to_keep <- which(countQueryHits(ov) == 1L) ov <- ov[queryHits(ov) %in% reads_to_keep] } countSubjectHits(ov) } .removeSharedRegions <- function(features, algorithm=c("nclist", "intervaltree"), ignore.strand=FALSE) { if (is(features, "GRanges")) { regions <- disjoin(features, ignore.strand=ignore.strand) } else if (is(features, "GRangesList")) { regions <- disjoin(features@unlistData, ignore.strand=ignore.strand) } else { stop("internal error") # should never happen } ov <- findOverlaps(features, regions, algorithm=match.arg(algorithm), ignore.strand=ignore.strand) regions_to_keep <- which(countSubjectHits(ov) == 1L) ov <- ov[subjectHits(ov) %in% regions_to_keep] unlisted_ans <- regions[subjectHits(ov)] ans_partitioning <- as(ov, "PartitioningByEnd") relist(unlisted_ans, ans_partitioning) } IntersectionNotEmpty <- function(features, reads, algorithm=c("nclist", "intervaltree"), ignore.strand=FALSE, inter.feature=TRUE) { algorithm <- match.arg(algorithm) features <- .removeSharedRegions(features, algorithm=algorithm, ignore.strand=ignore.strand) Union(features, reads, algorithm=algorithm, ignore.strand=ignore.strand, inter.feature=inter.feature) } ### ------------------------------------------------------------------------- ### Methods for BamFiles and BamViews objects ### .checkArgs <- function(bam, singleEnd, fragments) { if (singleEnd) { if (all(isTRUE(asMates(bam)))) stop("cannot specify both 'singleEnd=TRUE' and 'asMates=TRUE'") if (fragments) stop("when 'fragments=TRUE', 'singleEnd' should be FALSE") ## all paired-end reading now goes through new C algo } else { asMates(bam) <- TRUE } } .getReadFunction <- function(singleEnd, fragments) { if (singleEnd) { FUN <- readGAlignments } else { if (fragments) FUN <- readGAlignmentsList else FUN <- readGAlignmentPairs } FUN } .countWithYieldSize <- function(FUN, features, bf, mode, algorithm, ignore.strand, inter.feature, param, preprocess.reads, ...) { if (is.na(yieldSize(bf))) { x <- FUN(bf, param=param) .dispatchOverlaps(features, x, mode, algorithm, ignore.strand, inter.feature, preprocess.reads, ...) } else { if (!isOpen(bf)) { open(bf) on.exit(close(bf)) } ct <- integer(length(features)) while (length(x <- FUN(bf, param=param))) { ct <- ct + .dispatchOverlaps(features, x, mode, algorithm, ignore.strand, inter.feature, preprocess.reads, ...) } ct } } .dispatchBamFiles <- function(features, reads, mode, algorithm, ignore.strand, count.mapped.reads=FALSE, inter.feature=TRUE, singleEnd=TRUE, fragments=FALSE, param=ScanBamParam(), preprocess.reads=NULL, ...) { exist <- sapply(reads, function(bf) file.exists(path(bf))) if (!all(exist)) stop(paste0("file(s): ", paste(path(reads)[!exist], collapse=","), " do not exist")) FUN <- .getReadFunction(singleEnd, fragments) cts <- bplapply(setNames(seq_along(reads), names(reads)), function(i, FUN, reads, features, mode, algorithm, ignore.strand, inter.feature, param, preprocess.reads) { bf <- reads[[i]] .countWithYieldSize(FUN, features, bf, mode, algorithm, ignore.strand, inter.feature, param, preprocess.reads, ...) }, FUN, reads, features, mode=match.fun(mode), algorithm=algorithm, ignore.strand=ignore.strand, inter.feature=inter.feature, param=param, preprocess.reads=preprocess.reads, ... ) counts <- as.matrix(do.call(cbind, cts)) if (count.mapped.reads) { countBam <- countBam(reads) flag <- scanBamFlag(isUnmappedQuery=FALSE) param <- ScanBamParam(flag=flag, what="seq") colData <- DataFrame(countBam[c("records", "nucleotides")], mapped=countBam(reads, param=param)$records, row.names=colnames(counts)) } else { colData <- DataFrame(row.names=colnames(counts)) } SummarizedExperiment(assays=SimpleList(counts=counts), rowRanges=features, colData=colData) } setMethod("summarizeOverlaps", c("GRanges", "BamFile"), function(features, reads, mode=Union, algorithm=c("nclist", "intervaltree"), ignore.strand=FALSE, inter.feature=TRUE, singleEnd=TRUE, fragments=FALSE, param=ScanBamParam(), preprocess.reads=NULL, ...) { .checkArgs(reads, singleEnd, fragments) .dispatchBamFiles(features, BamFileList(reads), mode, match.arg(algorithm), ignore.strand, inter.feature=inter.feature, singleEnd=singleEnd, fragments=fragments, param=param, preprocess.reads=preprocess.reads, ...) }) setMethod("summarizeOverlaps", c("GRangesList", "BamFile"), function(features, reads, mode=Union, algorithm=c("nclist", "intervaltree"), ignore.strand=FALSE, inter.feature=TRUE, singleEnd=TRUE, fragments=FALSE, param=ScanBamParam(), preprocess.reads=NULL, ...) { .checkArgs(reads, singleEnd, fragments) .dispatchBamFiles(features, BamFileList(reads), mode, match.arg(algorithm), ignore.strand, inter.feature=inter.feature, singleEnd=singleEnd, fragments=fragments, param=param, preprocess.reads=preprocess.reads, ...) }) .summarizeOverlaps_character <- function(features, reads, mode=Union, algorithm=c("nclist", "intervaltree"), ignore.strand=FALSE, yieldSize=1000000L, inter.feature=TRUE, singleEnd=TRUE, fragments=FALSE, param=ScanBamParam(), preprocess.reads=NULL, ...) { if (!all(file.exists(reads))) stop("file(s) do not exist:\n ", paste(reads[!file.exists(reads)], collapse="\n ")) if (is.null(names(reads))) { if (any(duplicated(reads))) stop("duplicate 'reads' paths not allowed; use distinct names()") } else if (any(duplicated(names(reads)))) stop("duplicate 'names(reads)' file paths not allowed") reads <- BamFileList(reads, yieldSize=yieldSize, obeyQname=FALSE, asMates=!singleEnd) summarizeOverlaps(features, reads, mode, algorithm=match.arg(algorithm), ignore.strand=ignore.strand, inter.feature=inter.feature, singleEnd=singleEnd, fragments=fragments, param=param, preprocess.reads=preprocess.reads, ...) } setMethod("summarizeOverlaps", c("GRanges", "character"), .summarizeOverlaps_character ) setMethod("summarizeOverlaps", c("GRangesList", "character"), .summarizeOverlaps_character ) .summarizeOverlaps_BamFileList <- function(features, reads, mode=Union, algorithm=c("nclist", "intervaltree"), ignore.strand=FALSE, inter.feature=TRUE, singleEnd=TRUE, fragments=FALSE, param=ScanBamParam(), preprocess.reads=NULL, ...) { if (any(duplicated(names(reads)))) stop("duplicate 'names(reads)' not allowed") .checkArgs(reads, singleEnd, fragments) .dispatchBamFiles(features, reads, mode, match.arg(algorithm), ignore.strand, inter.feature=inter.feature, singleEnd=singleEnd, fragments=fragments, param=param, preprocess.reads=preprocess.reads, ...) } setMethod("summarizeOverlaps", c("GRanges", "BamFileList"), .summarizeOverlaps_BamFileList ) setMethod("summarizeOverlaps", c("GRangesList", "BamFileList"), .summarizeOverlaps_BamFileList ) setMethod("summarizeOverlaps", c("BamViews", "missing"), function(features, reads, mode=Union, algorithm=c("nclist", "intervaltree"), ignore.strand=FALSE, inter.feature=TRUE, singleEnd=TRUE, fragments=FALSE, param=ScanBamParam(), preprocess.reads=NULL, ...) { se <- callGeneric(bamRanges(features), BamFileList(bamPaths(features)), mode=mode, algorithm=match.arg(algorithm), ignore.strand=ignore.strand, inter.feature=inter.feature, singleEnd=singleEnd, fragments=fragments, param=param, preprocess.reads=preprocess.reads, ...) colData(se)$bamSamples <- bamSamples(features) colData(se)$bamIndices <- bamIndicies(features) metadata(se)$bamExperiment <- bamExperiment(features) se }) GenomicAlignments/R/utils.R0000644000175100017510000000165412607264575016705 0ustar00biocbuildbiocbuild### ========================================================================= ### Some low-level (non exported) utility functions. ### ------------------------------------------------------------------------- ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Invert the strand of an object. ### ### TODO: We should probably have an invertStrand() generic with methods for ### GRanges, GRangesList, GAlignments, GAlignmentPairs, and possibly more, ### instead of this. ### Works on GRanges and GAlignments objects. More generally, it should ### work on any object that has: (1) a strand() getter that returns a ### 'factor'-Rle, and (2) a strand() setter. invertRleStrand <- function(x) { x_strand <- strand(x) runValue(x_strand) <- strand(runValue(x_strand) == "+") strand(x) <- x_strand x } invertRleListStrand <- function(x) { x@unlistData <- invertRleStrand(x@unlistData) x } GenomicAlignments/R/zzz.R0000644000175100017510000000000012607264575016362 0ustar00biocbuildbiocbuildGenomicAlignments/build/0000755000175100017510000000000012612051202016263 5ustar00biocbuildbiocbuildGenomicAlignments/build/vignette.rds0000644000175100017510000000072012612051202020621 0ustar00biocbuildbiocbuildTAO0iJ 6āiWK.YABPĮ#vi|т:N;{ߗNa lmc.ڪlן2ȿDR&RMtTw6w4c@/ a&sP]|az)DN&*NP$J+ a*B/)/6ߜ|\㲓_ᣣmbjZ-GA,3bxQHΒ Gaw!B,?$昁)h|#Gt+B!(-NS?b0@.UdWL7BCάp8=١Uy=>IGenomicAlignments/inst/0000755000175100017510000000000012612051202016141 5ustar00biocbuildbiocbuildGenomicAlignments/inst/CITATION0000644000175100017510000000165412607264575017333 0ustar00biocbuildbiocbuildcitEntry(entry="article", title = "Software for Computing and Annotating Genomic Ranges", author = personList( as.person("Michael Lawrence" ), as.person("Wolfgang Huber" ), as.person("Herv\\'e Pag\\`es" ), as.person("Patrick Aboyoun" ), as.person("Marc Carlson" ), as.person("Robert Gentleman" ), as.person("Martin Morgan" ), as.person("Vincent Carey" )), year = 2013, journal = "{PLoS} Computational Biology", volume = "9", issue = "8", doi = "10.1371/journal.pcbi.1003118", url = "http://www.ploscompbiol.org/article/info%3Adoi%2F10.1371%2Fjournal.pcbi.1003118", textVersion = "Lawrence M, Huber W, Pag\\`es H, Aboyoun P, Carlson M, et al. (2013) Software for Computing and Annotating Genomic Ranges. PLoS Comput Biol 9(8): e1003118. doi:10.1371/journal.pcbi.1003118" ) GenomicAlignments/inst/doc/0000755000175100017510000000000012612051202016706 5ustar00biocbuildbiocbuildGenomicAlignments/inst/doc/OverlapEncodings.R0000644000175100017510000007677312612051202022317 0ustar00biocbuildbiocbuild### R code from vignette source 'OverlapEncodings.Rnw' ################################################### ### code chunk number 1: style ################################################### BiocStyle::latex() ################################################### ### code chunk number 2: options ################################################### options(width=100) .precomputed_results_dir <- "precomputed_results" .loadPrecomputed <- function(objname) { filename <- paste0(objname, ".rda") path <- file.path(.precomputed_results_dir, filename) tempenv <- new.env(parent=emptyenv()) load(path, envir=tempenv) get(objname, envir=tempenv) } .checkIdenticalToPrecomputed <- function(obj, objname, ignore.metadata=FALSE) { precomputed_obj <- .loadPrecomputed(objname) if (ignore.metadata) metadata(obj) <- metadata(precomputed_obj) <- list() ## Replace NAs with FALSE in circularity flag (because having the flag set ## to NA instead of FALSE (or vice-versa) is not considered a significant ## difference between the 2 objects). isCircular(obj) <- isCircular(obj) %in% TRUE isCircular(precomputed_obj) <- isCircular(precomputed_obj) %in% TRUE if (!identical(obj, precomputed_obj)) stop("'", objname, "' is not identical to precomputed version") } ################################################### ### code chunk number 3: untreated1_chr4 ################################################### library(pasillaBamSubset) untreated1_chr4() ################################################### ### code chunk number 4: readGAlignments ################################################### library(GenomicAlignments) flag0 <- scanBamFlag(isDuplicate=FALSE, isNotPassingQualityControls=FALSE) param0 <- ScanBamParam(flag=flag0) U1.GAL <- readGAlignments(untreated1_chr4(), use.names=TRUE, param=param0) head(U1.GAL) ################################################### ### code chunk number 5: U1.GAL_names_is_dup ################################################### U1.GAL_names_is_dup <- duplicated(names(U1.GAL)) table(U1.GAL_names_is_dup) ################################################### ### code chunk number 6: U1.GAL_qnames ################################################### U1.uqnames <- unique(names(U1.GAL)) U1.GAL_qnames <- factor(names(U1.GAL), levels=U1.uqnames) ################################################### ### code chunk number 7: U1.GAL_dup2unq ################################################### U1.GAL_dup2unq <- match(U1.GAL_qnames, U1.GAL_qnames) ################################################### ### code chunk number 8: gaps-in-U1.GAL ################################################### head(unique(cigar(U1.GAL))) table(njunc(U1.GAL)) ################################################### ### code chunk number 9: no-indels-in-U1.GAL ################################################### colSums(cigarOpTable(cigar(U1.GAL))) ################################################### ### code chunk number 10: readGAlignmentPairs ################################################### U3.galp <- readGAlignmentPairs(untreated3_chr4(), use.names=TRUE, param=param0) head(U3.galp) ################################################### ### code chunk number 11: first-and-last-U3.galp ################################################### head(first(U3.galp)) head(last(U3.galp)) ################################################### ### code chunk number 12: isProperPair ################################################### table(isProperPair(U3.galp)) ################################################### ### code chunk number 13: keep-only-proper-pairs ################################################### U3.GALP <- U3.galp[isProperPair(U3.galp)] ################################################### ### code chunk number 14: U3.GALP_names_is_dup ################################################### U3.GALP_names_is_dup <- duplicated(names(U3.GALP)) table(U3.GALP_names_is_dup) ################################################### ### code chunk number 15: U3.GALP_qnames ################################################### U3.uqnames <- unique(names(U3.GALP)) U3.GALP_qnames <- factor(names(U3.GALP), levels=U3.uqnames) ################################################### ### code chunk number 16: U3.GALP_dup2unq ################################################### U3.GALP_dup2unq <- match(U3.GALP_qnames, U3.GALP_qnames) ################################################### ### code chunk number 17: gaps-in-U3.GALP ################################################### head(unique(cigar(first(U3.GALP)))) head(unique(cigar(last(U3.GALP)))) table(njunc(first(U3.GALP)), njunc(last(U3.GALP))) ################################################### ### code chunk number 18: no-indels-in-U3.GALP ################################################### colSums(cigarOpTable(cigar(first(U3.GALP)))) colSums(cigarOpTable(cigar(last(U3.GALP)))) ################################################### ### code chunk number 19: txdb ################################################### library(TxDb.Dmelanogaster.UCSC.dm3.ensGene) TxDb.Dmelanogaster.UCSC.dm3.ensGene txdb <- TxDb.Dmelanogaster.UCSC.dm3.ensGene ################################################### ### code chunk number 20: exbytx ################################################### exbytx <- exonsBy(txdb, by="tx", use.names=TRUE) length(exbytx) # nb of transcripts ################################################### ### code chunk number 21: CHECK_exbytx ################################################### .checkIdenticalToPrecomputed(exbytx, "exbytx", ignore.metadata=TRUE) ################################################### ### code chunk number 22: check-for-trans-splicing-in-exbytx ################################################### table(elementLengths(runLength(seqnames(exbytx)))) table(elementLengths(runLength(strand(exbytx)))) ################################################### ### code chunk number 23: exbytx_strand ################################################### exbytx_strand <- unlist(runValue(strand(exbytx)), use.names=FALSE) ################################################### ### code chunk number 24: exbytx2gene ################################################### tx <- transcripts(txdb, columns=c("tx_name", "gene_id")) head(tx) df <- mcols(tx) exbytx2gene <- as.character(df$gene_id) exbytx2gene <- factor(exbytx2gene, levels=unique(exbytx2gene)) names(exbytx2gene) <- df$tx_name exbytx2gene <- exbytx2gene[names(exbytx)] head(exbytx2gene) nlevels(exbytx2gene) # nb of genes ################################################### ### code chunk number 25: U1.OV00 ################################################### U1.OV00 <- findOverlaps(U1.GAL, exbytx, ignore.strand=TRUE) ################################################### ### code chunk number 26: length-of-U1.OV00 ################################################### length(U1.OV00) ################################################### ### code chunk number 27: nhitPerQuery-and-nhitPerSubject ################################################### nhitPerQuery <- function(x) tabulate(queryHits(x), nbins=queryLength(x)) nhitPerSubject <- function(x) tabulate(subjectHits(x), nbins=subjectLength(x)) ################################################### ### code chunk number 28: U1.GAL_ntx ################################################### U1.GAL_ntx <- nhitPerQuery(U1.OV00) mcols(U1.GAL)$ntx <- U1.GAL_ntx head(U1.GAL) table(U1.GAL_ntx) mean(U1.GAL_ntx >= 1) ################################################### ### code chunk number 29: U1.GAL_ntx_again (eval = FALSE) ################################################### ## U1.GAL_ntx_again <- countOverlaps(U1.GAL, exbytx, ignore.strand=TRUE) ## stopifnot(identical(unname(U1.GAL_ntx_again), U1.GAL_ntx)) ################################################### ### code chunk number 30: U1.uqnames_ntx ################################################### U1.OV10 <- remapHits(U1.OV00, query.map=U1.GAL_qnames) U1.uqnames_ntx <- nhitPerQuery(U1.OV10) names(U1.uqnames_ntx) <- U1.uqnames table(U1.uqnames_ntx) mean(U1.uqnames_ntx >= 1) ################################################### ### code chunk number 31: U1.exbytx_nOV10 ################################################### U1.exbytx_nOV10 <- nhitPerSubject(U1.OV10) names(U1.exbytx_nOV10) <- names(exbytx) mean(U1.exbytx_nOV10 >= 50) ################################################### ### code chunk number 32: top-10-transcripts-based-on-U1.exbytx_nOV10 ################################################### head(sort(U1.exbytx_nOV10, decreasing=TRUE), n=10) ################################################### ### code chunk number 33: U3.OV00 ################################################### U3.OV00 <- findOverlaps(U3.GALP, exbytx, ignore.strand=TRUE) ################################################### ### code chunk number 34: length-of-U3.OV00 ################################################### length(U3.OV00) ################################################### ### code chunk number 35: U3.GALP_ntx ################################################### U3.GALP_ntx <- nhitPerQuery(U3.OV00) mcols(U3.GALP)$ntx <- U3.GALP_ntx head(U3.GALP) table(U3.GALP_ntx) mean(U3.GALP_ntx >= 1) ################################################### ### code chunk number 36: U3.GALP_ntx_again (eval = FALSE) ################################################### ## U3.GALP_ntx_again <- countOverlaps(U3.GALP, exbytx, ignore.strand=TRUE) ## stopifnot(identical(unname(U3.GALP_ntx_again), U3.GALP_ntx)) ################################################### ### code chunk number 37: U3.uqnames_ntx ################################################### U3.OV10 <- remapHits(U3.OV00, query.map=U3.GALP_qnames) U3.uqnames_ntx <- nhitPerQuery(U3.OV10) names(U3.uqnames_ntx) <- U3.uqnames table(U3.uqnames_ntx) mean(U3.uqnames_ntx >= 1) ################################################### ### code chunk number 38: U3.exbytx_nOV10 ################################################### U3.exbytx_nOV10 <- nhitPerSubject(U3.OV10) names(U3.exbytx_nOV10) <- names(exbytx) mean(U3.exbytx_nOV10 >= 50) ################################################### ### code chunk number 39: top-10-transcripts-based-on-U3.exbytx_nOV10 ################################################### head(sort(U3.exbytx_nOV10, decreasing=TRUE), n=10) ################################################### ### code chunk number 40: U1.grl_and_U1.grlf ################################################### U1.grl <- grglist(U1.GAL, order.as.in.query=TRUE) U1.grlf <- flipQuery(U1.grl) # flipped ################################################### ### code chunk number 41: U1.ovencAB ################################################### U1.ovencA <- encodeOverlaps(U1.grl, exbytx, hits=U1.OV00) U1.ovencB <- encodeOverlaps(U1.grlf, exbytx, hits=U1.OV00) ################################################### ### code chunk number 42: U1.ovenc ################################################### U1.grl_strand <- unlist(runValue(strand(U1.grl)), use.names=FALSE) U1.ovenc <- selectEncodingWithCompatibleStrand(U1.ovencA, U1.ovencB, U1.grl_strand, exbytx_strand, hits=U1.OV00) U1.ovenc ################################################### ### code chunk number 43: U1.ovenc_again ################################################### U1.ovenc_again <- encodeOverlaps(U1.grl, exbytx, hits=U1.OV00, flip.query.if.wrong.strand=TRUE) stopifnot(identical(U1.ovenc_again, U1.ovenc)) ################################################### ### code chunk number 44: U1.ovenc_table ################################################### U1.unique_encodings <- levels(U1.ovenc) length(U1.unique_encodings) head(U1.unique_encodings) U1.ovenc_table <- table(encoding(U1.ovenc)) tail(sort(U1.ovenc_table)) ################################################### ### code chunk number 45: U3.ovenc ################################################### U3.grl <- grglist(U3.GALP) U3.ovenc <- encodeOverlaps(U3.grl, exbytx, hits=U3.OV00, flip.query.if.wrong.strand=TRUE) U3.ovenc ################################################### ### code chunk number 46: U3.ovenc_table ################################################### U3.unique_encodings <- levels(U3.ovenc) length(U3.unique_encodings) head(U3.unique_encodings) U3.ovenc_table <- table(encoding(U3.ovenc)) tail(sort(U3.ovenc_table)) ################################################### ### code chunk number 47: U1-unique-compatible-encodings ################################################### sort(U1.ovenc_table[isCompatibleWithSplicing(U1.unique_encodings)]) ################################################### ### code chunk number 48: U1.OV00_is_comp ################################################### U1.OV00_is_comp <- isCompatibleWithSplicing(U1.ovenc) table(U1.OV00_is_comp) # 531797 "compatible" overlaps ################################################### ### code chunk number 49: U1.compOV00 ################################################### U1.compOV00 <- U1.OV00[U1.OV00_is_comp] ################################################### ### code chunk number 50: U1.compOV00_again (eval = FALSE) ################################################### ## U1.compOV00_again <- findCompatibleOverlaps(U1.GAL, exbytx) ## stopifnot(identical(U1.compOV00_again, U1.compOV00)) ################################################### ### code chunk number 51: U1.GAL_ncomptx ################################################### U1.GAL_ncomptx <- nhitPerQuery(U1.compOV00) mcols(U1.GAL)$ncomptx <- U1.GAL_ncomptx head(U1.GAL) table(U1.GAL_ncomptx) mean(U1.GAL_ncomptx >= 1) ################################################### ### code chunk number 52: U1.GAL_ncomptx_again (eval = FALSE) ################################################### ## U1.GAL_ncomptx_again <- countCompatibleOverlaps(U1.GAL, exbytx) ## stopifnot(identical(U1.GAL_ncomptx_again, U1.GAL_ncomptx)) ################################################### ### code chunk number 53: U1.uqnames_ncomptx ################################################### U1.compOV10 <- remapHits(U1.compOV00, query.map=U1.GAL_qnames) U1.uqnames_ncomptx <- nhitPerQuery(U1.compOV10) names(U1.uqnames_ncomptx) <- U1.uqnames table(U1.uqnames_ncomptx) mean(U1.uqnames_ncomptx >= 1) ################################################### ### code chunk number 54: U1.exbytx_ncompOV10 ################################################### U1.exbytx_ncompOV10 <- nhitPerSubject(U1.compOV10) names(U1.exbytx_ncompOV10) <- names(exbytx) mean(U1.exbytx_ncompOV10 >= 50) ################################################### ### code chunk number 55: top-10-transcripts-based-on-U1.exbytx_ncompOV10 ################################################### head(sort(U1.exbytx_ncompOV10, decreasing=TRUE), n=10) ################################################### ### code chunk number 56: U3-unique-compatible-encodings ################################################### sort(U3.ovenc_table[isCompatibleWithSplicing(U3.unique_encodings)]) ################################################### ### code chunk number 57: U3.OV00_is_comp ################################################### U3.OV00_is_comp <- isCompatibleWithSplicing(U3.ovenc) table(U3.OV00_is_comp) # 106835 "compatible" paired-end overlaps ################################################### ### code chunk number 58: U3.compOV00 ################################################### U3.compOV00 <- U3.OV00[U3.OV00_is_comp] ################################################### ### code chunk number 59: U3.compOV00_again (eval = FALSE) ################################################### ## U3.compOV00_again <- findCompatibleOverlaps(U3.GALP, exbytx) ## stopifnot(identical(U3.compOV00_again, U3.compOV00)) ################################################### ### code chunk number 60: U3.GALP_ncomptx ################################################### U3.GALP_ncomptx <- nhitPerQuery(U3.compOV00) mcols(U3.GALP)$ncomptx <- U3.GALP_ncomptx head(U3.GALP) table(U3.GALP_ncomptx) mean(U3.GALP_ncomptx >= 1) ################################################### ### code chunk number 61: U3.GALP_ncomptx_again (eval = FALSE) ################################################### ## U3.GALP_ncomptx_again <- countCompatibleOverlaps(U3.GALP, exbytx) ## stopifnot(identical(U3.GALP_ncomptx_again, U3.GALP_ncomptx)) ################################################### ### code chunk number 62: U3.uqnames_ncomptx ################################################### U3.compOV10 <- remapHits(U3.compOV00, query.map=U3.GALP_qnames) U3.uqnames_ncomptx <- nhitPerQuery(U3.compOV10) names(U3.uqnames_ncomptx) <- U3.uqnames table(U3.uqnames_ncomptx) mean(U3.uqnames_ncomptx >= 1) ################################################### ### code chunk number 63: U3.exbytx_ncompOV10 ################################################### U3.exbytx_ncompOV10 <- nhitPerSubject(U3.compOV10) names(U3.exbytx_ncompOV10) <- names(exbytx) mean(U3.exbytx_ncompOV10 >= 50) ################################################### ### code chunk number 64: top-10-transcripts-based-on-U3.exbytx_ncompOV10 ################################################### head(sort(U3.exbytx_ncompOV10, decreasing=TRUE), n=10) ################################################### ### code chunk number 65: Dmelanogaster ################################################### library(BSgenome.Dmelanogaster.UCSC.dm3) Dmelanogaster ################################################### ### code chunk number 66: U1-reference-query-sequences ################################################### library(GenomicFeatures) U1.GAL_rqseq <- extractTranscriptSeqs(Dmelanogaster, U1.grl) head(U1.GAL_rqseq) ################################################### ### code chunk number 67: U3.grl_first-and-U3.grl_last ################################################### U3.grl_first <- grglist(first(U3.GALP, real.strand=TRUE), order.as.in.query=TRUE) U3.grl_last <- grglist(last(U3.GALP, real.strand=TRUE), order.as.in.query=TRUE) ################################################### ### code chunk number 68: U3-reference-query-sequences ################################################### U3.GALP_rqseq1 <- extractTranscriptSeqs(Dmelanogaster, U3.grl_first) U3.GALP_rqseq2 <- extractTranscriptSeqs(Dmelanogaster, U3.grl_last) ################################################### ### code chunk number 69: U1.OV00_qstart ################################################### U1.OV00_qstart <- extractQueryStartInTranscript(U1.grl, exbytx, hits=U1.OV00, ovenc=U1.ovenc) head(subset(U1.OV00_qstart, U1.OV00_is_comp)) ################################################### ### code chunk number 70: txseq ################################################### txseq <- extractTranscriptSeqs(Dmelanogaster, exbytx) ################################################### ### code chunk number 71: U1.OV00_rqseq-vs-U1.OV00_txseq ################################################### U1.OV00_rqseq <- U1.GAL_rqseq[queryHits(U1.OV00)] U1.OV00_rqseq[flippedQuery(U1.ovenc)] <- reverseComplement(U1.OV00_rqseq[flippedQuery(U1.ovenc)]) U1.OV00_txseq <- txseq[subjectHits(U1.OV00)] stopifnot(all( U1.OV00_rqseq[U1.OV00_is_comp] == narrow(U1.OV00_txseq[U1.OV00_is_comp], start=U1.OV00_qstart$startInTranscript[U1.OV00_is_comp], width=width(U1.OV00_rqseq)[U1.OV00_is_comp]) )) ################################################### ### code chunk number 72: U3.OV00_Lqstart ################################################### U3.OV00_Lqstart <- extractQueryStartInTranscript(U3.grl, exbytx, hits=U3.OV00, ovenc=U3.ovenc) head(subset(U3.OV00_Lqstart, U3.OV00_is_comp)) ################################################### ### code chunk number 73: U3.OV00_Rqstart ################################################### U3.OV00_Rqstart <- extractQueryStartInTranscript(U3.grl, exbytx, hits=U3.OV00, ovenc=U3.ovenc, for.query.right.end=TRUE) head(subset(U3.OV00_Rqstart, U3.OV00_is_comp)) ################################################### ### code chunk number 74: U3.OV00_Lrqseq_and_Rrqseq ################################################### U3.OV00_Lrqseq <- U3.GALP_rqseq1[queryHits(U3.OV00)] U3.OV00_Rrqseq <- U3.GALP_rqseq2[queryHits(U3.OV00)] ################################################### ### code chunk number 75: U3.OV00_Lrqseq_and_Rrqseq ################################################### flip_idx <- which(flippedQuery(U3.ovenc)) tmp <- U3.OV00_Lrqseq[flip_idx] U3.OV00_Lrqseq[flip_idx] <- reverseComplement(U3.OV00_Rrqseq[flip_idx]) U3.OV00_Rrqseq[flip_idx] <- reverseComplement(tmp) ################################################### ### code chunk number 76: U3.OV00_txseq ################################################### U3.OV00_txseq <- txseq[subjectHits(U3.OV00)] ################################################### ### code chunk number 77: U3.OV00_Lrqseq-vs-U3.OV00_txseq ################################################### stopifnot(all( U3.OV00_Lrqseq[U3.OV00_is_comp] == narrow(U3.OV00_txseq[U3.OV00_is_comp], start=U3.OV00_Lqstart$startInTranscript[U3.OV00_is_comp], width=width(U3.OV00_Lrqseq)[U3.OV00_is_comp]) )) ################################################### ### code chunk number 78: U3.OV00_Rrqseq-vs-U3.OV00_txseq ################################################### stopifnot(all( U3.OV00_Rrqseq[U3.OV00_is_comp] == narrow(U3.OV00_txseq[U3.OV00_is_comp], start=U3.OV00_Rqstart$startInTranscript[U3.OV00_is_comp], width=width(U3.OV00_Rrqseq)[U3.OV00_is_comp]) )) ################################################### ### code chunk number 79: findSequenceHits ################################################### ### A wrapper to vwhichPDict() that supports IUPAC ambiguity codes in 'qseq' ### and 'txseq', and treats them as such. findSequenceHits <- function(qseq, txseq, which.txseq=NULL, max.mismatch=0) { .asHits <- function(x, pattern_length) { query_hits <- unlist(x) if (is.null(query_hits)) query_hits <- integer(0) subject_hits <- rep.int(seq_len(length(x)), elementLengths(x)) Hits(query_hits, subject_hits, pattern_length, length(x)) } .isHitInTranscriptBounds <- function(hits, qseq, txseq) { sapply(seq_len(length(hits)), function(i) { pattern <- qseq[[queryHits(hits)[i]]] subject <- txseq[[subjectHits(hits)[i]]] v <- matchPattern(pattern, subject, max.mismatch=max.mismatch, fixed=FALSE) any(1L <= start(v) & end(v) <= length(subject)) }) } if (!is.null(which.txseq)) { txseq0 <- txseq txseq <- txseq[which.txseq] } names(qseq) <- NULL other <- alphabetFrequency(qseq, baseOnly=TRUE)[ , "other"] is_clean <- other == 0L # "clean" means "no IUPAC ambiguity code" ## Find hits for "clean" original queries. qseq0 <- qseq[is_clean] pdict0 <- PDict(qseq0, max.mismatch=max.mismatch) m0 <- vwhichPDict(pdict0, txseq, max.mismatch=max.mismatch, fixed="pattern") hits0 <- .asHits(m0, length(qseq0)) hits0@queryLength <- length(qseq) hits0@queryHits <- which(is_clean)[hits0@queryHits] ## Find hits for non "clean" original queries. qseq1 <- qseq[!is_clean] m1 <- vwhichPDict(qseq1, txseq, max.mismatch=max.mismatch, fixed=FALSE) hits1 <- .asHits(m1, length(qseq1)) hits1@queryLength <- length(qseq) hits1@queryHits <- which(!is_clean)[hits1@queryHits] ## Combine the hits. query_hits <- c(queryHits(hits0), queryHits(hits1)) subject_hits <- c(subjectHits(hits0), subjectHits(hits1)) if (!is.null(which.txseq)) { ## Remap the hits. txseq <- txseq0 subject_hits <- which.txseq[subject_hits] hits0@subjectLength <- length(txseq) } ## Order the hits. oo <- S4Vectors:::orderIntegerPairs(query_hits, subject_hits) hits0@queryHits <- query_hits[oo] hits0@subjectHits <- subject_hits[oo] if (max.mismatch != 0L) { ## Keep only "in bounds" hits. is_in_bounds <- .isHitInTranscriptBounds(hits0, qseq, txseq) hits0 <- hits0[is_in_bounds] } hits0 } ################################################### ### code chunk number 80: which.txseq (eval = FALSE) ################################################### ## chr4tx <- transcripts(txdb, vals=list(tx_chrom="chr4")) ## chr4txnames <- mcols(chr4tx)$tx_name ## which.txseq <- match(chr4txnames, names(txseq)) ################################################### ### code chunk number 81: U1.sbcompHITS (eval = FALSE) ################################################### ## U1.sbcompHITSa <- findSequenceHits(U1.oqseq, txseq, ## which.txseq=which.txseq, max.mismatch=6) ## U1.sbcompHITSb <- findSequenceHits(reverseComplement(U1.oqseq), txseq, ## which.txseq=which.txseq, max.mismatch=6) ## U1.sbcompHITS <- union(U1.sbcompHITSa, U1.sbcompHITSb) ################################################### ### code chunk number 82: LOAD_U1.sbcompHITS ################################################### U1.sbcompHITSa <- .loadPrecomputed("U1.sbcompHITSa") U1.sbcompHITSb <- .loadPrecomputed("U1.sbcompHITSb") U1.sbcompHITS <- union(U1.sbcompHITSa, U1.sbcompHITSb) ################################################### ### code chunk number 83: U1.uqnames_nsbcomptx ################################################### U1.uqnames_nsbcomptx <- nhitPerQuery(U1.sbcompHITS) names(U1.uqnames_nsbcomptx) <- U1.uqnames table(U1.uqnames_nsbcomptx) mean(U1.uqnames_nsbcomptx >= 1) ################################################### ### code chunk number 84: U1.exbytx_nsbcompHITS ################################################### U1.exbytx_nsbcompHITS <- nhitPerSubject(U1.sbcompHITS) names(U1.exbytx_nsbcompHITS) <- names(exbytx) mean(U1.exbytx_nsbcompHITS >= 50) ################################################### ### code chunk number 85: top-10-transcripts-based-on-U1.exbytx_nsbcompHITS ################################################### head(sort(U1.exbytx_nsbcompHITS, decreasing=TRUE), n=10) ################################################### ### code chunk number 86: encoding-based-compatible-implies-string-based-compatible ################################################### stopifnot(length(setdiff(U1.compOV10, U1.sbcompHITS)) == 0) ################################################### ### code chunk number 87: string-based-compatible-does-NOT-imply-encoding-based-compatible ################################################### length(setdiff(U1.sbcompHITS, U1.compOV10)) ################################################### ### code chunk number 88: U1-unique-almost-compatible-encodings ################################################### sort(U1.ovenc_table[isCompatibleWithSkippedExons(U1.unique_encodings)]) ################################################### ### code chunk number 89: U1.OV00_is_acomp ################################################### U1.OV00_is_acomp <- isCompatibleWithSkippedExons(U1.ovenc) table(U1.OV00_is_acomp) # 1202 "almost compatible" overlaps ################################################### ### code chunk number 90: U1.acompOV00 ################################################### U1.acompOV00 <- U1.OV00[U1.OV00_is_acomp] ################################################### ### code chunk number 91: U1.GAL_nacomptx ################################################### U1.GAL_nacomptx <- nhitPerQuery(U1.acompOV00) mcols(U1.GAL)$nacomptx <- U1.GAL_nacomptx head(U1.GAL) table(U1.GAL_nacomptx) mean(U1.GAL_nacomptx >= 1) ################################################### ### code chunk number 92: U1.exbytx_nacompOV00 ################################################### U1.exbytx_nacompOV00 <- nhitPerSubject(U1.acompOV00) names(U1.exbytx_nacompOV00) <- names(exbytx) table(U1.exbytx_nacompOV00) mean(U1.exbytx_nacompOV00 >= 50) ################################################### ### code chunk number 93: U1.OV00_qstart ################################################### head(subset(U1.OV00_qstart, U1.OV00_is_acomp)) ################################################### ### code chunk number 94: U3-unique-almost-compatible-encodings ################################################### sort(U3.ovenc_table[isCompatibleWithSkippedExons(U3.unique_encodings)]) ################################################### ### code chunk number 95: U3.OV00_is_acomp ################################################### U3.OV00_is_acomp <- isCompatibleWithSkippedExons(U3.ovenc) table(U3.OV00_is_acomp) # 141 "almost compatible" paired-end overlaps ################################################### ### code chunk number 96: U3.acompOV00 ################################################### U3.acompOV00 <- U3.OV00[U3.OV00_is_acomp] ################################################### ### code chunk number 97: U3.GALP_nacomptx ################################################### U3.GALP_nacomptx <- nhitPerQuery(U3.acompOV00) mcols(U3.GALP)$nacomptx <- U3.GALP_nacomptx head(U3.GALP) table(U3.GALP_nacomptx) mean(U3.GALP_nacomptx >= 1) ################################################### ### code chunk number 98: U3.exbytx_nacompOV00 ################################################### U3.exbytx_nacompOV00 <- nhitPerSubject(U3.acompOV00) names(U3.exbytx_nacompOV00) <- names(exbytx) table(U3.exbytx_nacompOV00) mean(U3.exbytx_nacompOV00 >= 50) ################################################### ### code chunk number 99: U3.OV00_Lqstart-and-U3.OV00_Rqstart ################################################### head(subset(U3.OV00_Lqstart, U3.OV00_is_acomp)) head(subset(U3.OV00_Rqstart, U3.OV00_is_acomp)) ################################################### ### code chunk number 100: U1.GAL_is_nsj ################################################### U1.GAL_is_nsj <- U1.GAL_nacomptx != 0L & U1.GAL_ncomptx == 0L head(which(U1.GAL_is_nsj)) ################################################### ### code chunk number 101: U1.OV00_is_nsj ################################################### U1.OV00_is_nsj <- queryHits(U1.OV00) %in% which(U1.GAL_is_nsj) ################################################### ### code chunk number 102: narrow-U1.OV00_is_nsj ################################################### U1.OV00_is_nsj <- U1.OV00_is_nsj & U1.OV00_is_acomp U1.nsjOV00 <- U1.OV00[U1.OV00_is_nsj] ################################################### ### code chunk number 103: U1.nsjOV00_skippedex ################################################### U1.nsjOV00_skippedex <- extractSkippedExonRanks(U1.ovenc)[U1.OV00_is_nsj] names(U1.nsjOV00_skippedex) <- queryHits(U1.nsjOV00) table(elementLengths(U1.nsjOV00_skippedex)) ################################################### ### code chunk number 104: U1.exbytx_skippedex ################################################### f <- factor(names(exbytx)[subjectHits(U1.nsjOV00)], levels=names(exbytx)) U1.exbytx_skippedex <- split(U1.nsjOV00_skippedex, f) ################################################### ### code chunk number 105: names-of-U1.exbytx_skippedex ################################################### head(names(U1.exbytx_skippedex)) # transcript names ################################################### ### code chunk number 106: FBtr0089124-skipped-exons ################################################### U1.exbytx_skippedex$FBtr0089124 ################################################### ### code chunk number 107: FBtr0089147-skipped-exons ################################################### U1.exbytx_skippedex$FBtr0089147 ################################################### ### code chunk number 108: sessionInfo ################################################### sessionInfo() GenomicAlignments/inst/doc/OverlapEncodings.Rnw0000644000175100017510000015776212612051202022662 0ustar00biocbuildbiocbuild%\VignetteIndexEntry{Overlap encodings} %\VignetteDepends{pasillaBamSubset, GenomicAlignments, GenomicFeatures, BSgenome.Dmelanogaster.UCSC.dm3, TxDb.Dmelanogaster.UCSC.dm3.ensGene} %\VignetteKeywords{sequence, sequencing, alignments} %\VignettePackage{GenomicAlignments} \documentclass{article} <>= BiocStyle::latex() @ \title{Overlap encodings} \author{Herv\'e Pag\`es} \date{Last modified: April 2015; Compiled: \today} \begin{document} \maketitle <>= options(width=100) .precomputed_results_dir <- "precomputed_results" .loadPrecomputed <- function(objname) { filename <- paste0(objname, ".rda") path <- file.path(.precomputed_results_dir, filename) tempenv <- new.env(parent=emptyenv()) load(path, envir=tempenv) get(objname, envir=tempenv) } .checkIdenticalToPrecomputed <- function(obj, objname, ignore.metadata=FALSE) { precomputed_obj <- .loadPrecomputed(objname) if (ignore.metadata) metadata(obj) <- metadata(precomputed_obj) <- list() ## Replace NAs with FALSE in circularity flag (because having the flag set ## to NA instead of FALSE (or vice-versa) is not considered a significant ## difference between the 2 objects). isCircular(obj) <- isCircular(obj) %in% TRUE isCircular(precomputed_obj) <- isCircular(precomputed_obj) %in% TRUE if (!identical(obj, precomputed_obj)) stop("'", objname, "' is not identical to precomputed version") } @ \tableofcontents %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{Introduction} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% In the context of an RNA-seq experiment, encoding the overlaps between the aligned reads and the transcripts can be used for detecting those overlaps that are ``compatible'' with the splicing of the transcript. Various tools are provided in the \Rpackage{GenomicAlignments} package for working with {\it overlap encodings}. In this vignette, we illustrate the use of these tools on the single-end and paired-end reads of an RNA-seq experiment. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{Load reads from a BAM file} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{Load single-end reads from a BAM file} BAM file {\tt untreated1\_chr4.bam} (located in the \Rpackage{pasillaBamSubset} data package) contains single-end reads from the ``Pasilla'' experiment and aligned against the dm3 genome (see \Rcode{?untreated1\_chr4} in the \Rpackage{pasillaBamSubset} package for more information about those reads): <>= library(pasillaBamSubset) untreated1_chr4() @ We use the \Rfunction{readGAlignments} function defined in the \Rpackage{GenomicAlignments} package to load the reads into a \Rclass{GAlignments} object. It's probably a good idea to get rid of the PCR or optical duplicates (flag bit 0x400 in the SAM format, see the SAM Spec \footnote{\url{http://samtools.sourceforge.net/}} for the details), as well as reads not passing quality controls (flag bit 0x200 in the SAM format). We do this by creating a \Rclass{ScanBamParam} object that we pass to \Rcode{readGAlignments} (see \Rcode{?ScanBamParam} in the \Rpackage{Rsamtools} package for the details). Note that we also use \Rcode{use.names=TRUE} in order to load the {\it query names} (aka {\it query template names}, see QNAME field in the SAM Spec) from the BAM file (\Rcode{readGAlignments} will use them to set the names of the returned object): <>= library(GenomicAlignments) flag0 <- scanBamFlag(isDuplicate=FALSE, isNotPassingQualityControls=FALSE) param0 <- ScanBamParam(flag=flag0) U1.GAL <- readGAlignments(untreated1_chr4(), use.names=TRUE, param=param0) head(U1.GAL) @ Because the aligner used to align those reads can report more than 1 alignment per {\it original query} (i.e. per read stored in the input file, typically a FASTQ file), we shouldn't expect the names of \Rcode{U1.GAL} to be unique: <>= U1.GAL_names_is_dup <- duplicated(names(U1.GAL)) table(U1.GAL_names_is_dup) @ Storing the {\it query names} in a factor will be useful as we will see later in this document: <>= U1.uqnames <- unique(names(U1.GAL)) U1.GAL_qnames <- factor(names(U1.GAL), levels=U1.uqnames) @ Note that we explicitely provide the levels of the factor to enforce their order. Otherwise \Rcode{factor()} would put them in lexicographic order which is not advisable because it depends on the locale in use. Another object that will be useful to keep near at hand is the mapping between each {\it query name} and its first occurence in \Rcode{U1.GAL\_qnames}: <>= U1.GAL_dup2unq <- match(U1.GAL_qnames, U1.GAL_qnames) @ Our reads can have up to 2 gaps (a gap corresponds to an N operation in the CIGAR): <>= head(unique(cigar(U1.GAL))) table(njunc(U1.GAL)) @ Also, the following table indicates that indels were not allowed/supported during the alignment process (no I or D CIGAR operations): <>= colSums(cigarOpTable(cigar(U1.GAL))) @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{Load paired-end reads from a BAM file} BAM file {\tt untreated3\_chr4.bam} (located in the \Rpackage{pasillaBamSubset} data package) contains paired-end reads from the ``Pasilla'' experiment and aligned against the dm3 genome (see \Rcode{?untreated3\_chr4} in the \Rpackage{pasillaBamSubset} package for more information about those reads). We use the \Rfunction{readGAlignmentPairs} function to load them into a \Rclass{GAlignmentPairs} object: <>= U3.galp <- readGAlignmentPairs(untreated3_chr4(), use.names=TRUE, param=param0) head(U3.galp) @ The \Rcode{show} method for \Rclass{GAlignmentPairs} objects displays two {\tt ranges} columns, one for the {\it first} alignment in the pair (the left column), and one for the {\it last} alignment in the pair (the right column). The {\tt strand} column corresponds to the strand of the {\it first} alignment. <>= head(first(U3.galp)) head(last(U3.galp)) @ According to the SAM format specifications, the aligner is expected to mark each alignment pair as {\it proper} or not (flag bit 0x2 in the SAM format). The SAM Spec only says that a pair is {\it proper} if the {\it first} and {\it last} alignments in the pair are ``properly aligned according to the aligner''. So the exact criteria used for setting this flag is left to the aligner. We use \Rcode{isProperPair} to extract this flag from the \Rclass{GAlignmentPairs} object: <>= table(isProperPair(U3.galp)) @ Even though we could do {\it overlap encodings} with the full object, we keep only the {\it proper} pairs for our downstream analysis: <>= U3.GALP <- U3.galp[isProperPair(U3.galp)] @ Because the aligner used to align those reads can report more than 1 alignment per {\it original query template} (i.e. per pair of sequences stored in the input files, typically 1 FASTQ file for the {\it first} ends and 1 FASTQ file for the {\it last} ends), we shouldn't expect the names of \Rcode{U3.GALP} to be unique: <>= U3.GALP_names_is_dup <- duplicated(names(U3.GALP)) table(U3.GALP_names_is_dup) @ Storing the {\it query template names} in a factor will be useful: <>= U3.uqnames <- unique(names(U3.GALP)) U3.GALP_qnames <- factor(names(U3.GALP), levels=U3.uqnames) @ as well as having the mapping between each {\it query template name} and its first occurence in \Rcode{U3.GALP\_qnames}: <>= U3.GALP_dup2unq <- match(U3.GALP_qnames, U3.GALP_qnames) @ Our reads can have up to 1 gap per end: <>= head(unique(cigar(first(U3.GALP)))) head(unique(cigar(last(U3.GALP)))) table(njunc(first(U3.GALP)), njunc(last(U3.GALP))) @ Like for our single-end reads, the following tables indicate that indels were not allowed/supported during the alignment process: <>= colSums(cigarOpTable(cigar(first(U3.GALP)))) colSums(cigarOpTable(cigar(last(U3.GALP)))) @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{Find all the overlaps between the reads and transcripts} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{Load the transcripts from a \Rclass{TxDb} object} In order to compute overlaps between reads and transcripts, we need access to the genomic positions of a set of known transcripts and their exons. It is essential that the reference genome of this set of transcripts and exons be {\bf exactly} the same as the reference genome used to align the reads. We could use the \Rfunction{makeTxDbFromUCSC} function defined in the \Rpackage{GenomicFeatures} package to make a \Rclass{TxDb} object containing the dm3 transcripts and their exons retrieved from the UCSC Genome Browser\footnote{\url{http://genome.ucsc.edu/cgi-bin/hgGateway}}. The Bioconductor project however provides a few annotation packages containing \Rclass{TxDb} objects for the most commonly studied organisms (those data packages are sometimes called the {\it TxDb} packages). One of them is the \Rpackage{TxDb.Dmelanogaster.\-UCSC.\-dm3.ensGene} package. It contains a \Rclass{TxDb} object that was made by pointing the \Rfunction{makeTxDbFromUCSC} function to the dm3 genome and {\it Ensembl Genes} track \footnote{See \url{http://genome.ucsc.edu/cgi-bin/hgTrackUi?hgsid=276880911&g=ensGene} for a description of this track.}. We can use it here: <>= library(TxDb.Dmelanogaster.UCSC.dm3.ensGene) TxDb.Dmelanogaster.UCSC.dm3.ensGene txdb <- TxDb.Dmelanogaster.UCSC.dm3.ensGene @ We extract the exons grouped by transcript in a \Rclass{GRangesList} object: <>= exbytx <- exonsBy(txdb, by="tx", use.names=TRUE) length(exbytx) # nb of transcripts @ <>= .checkIdenticalToPrecomputed(exbytx, "exbytx", ignore.metadata=TRUE) @ We check that all the exons in any given transcript belong to the same chromosome and strand. Knowing that our set of transcripts is free of this sort of trans-splicing events typically allows some significant simplifications during the downstream analysis \footnote{Dealing with trans-splicing events is not covered in this document.}. A quick and easy way to check this is to take advantage of the fact that \Rcode{seqnames} and \Rcode{strand} return \Rclass{RleList} objects. So we can extract the number of Rle runs for each transcript and make sure it's always 1: <>= table(elementLengths(runLength(seqnames(exbytx)))) table(elementLengths(runLength(strand(exbytx)))) @ Therefore the strand of any given transcript is unambiguously defined and can be extracted with: <>= exbytx_strand <- unlist(runValue(strand(exbytx)), use.names=FALSE) @ We will also need the mapping between the transcripts and their gene. We start by using \Rfunction{transcripts} to extract this information from our \Rclass{TxDb} object \Rcode{txdb}, and then we construct a named factor that represents the mapping: <>= tx <- transcripts(txdb, columns=c("tx_name", "gene_id")) head(tx) df <- mcols(tx) exbytx2gene <- as.character(df$gene_id) exbytx2gene <- factor(exbytx2gene, levels=unique(exbytx2gene)) names(exbytx2gene) <- df$tx_name exbytx2gene <- exbytx2gene[names(exbytx)] head(exbytx2gene) nlevels(exbytx2gene) # nb of genes @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{Single-end overlaps} \subsubsection{Find the single-end overlaps} We are ready to compute the overlaps with the \Rfunction{findOverlaps} function. Note that the strand of the queries produced by the RNA-seq experiment is typically unknown so we use \Rcode{ignore.strand=TRUE}: <>= U1.OV00 <- findOverlaps(U1.GAL, exbytx, ignore.strand=TRUE) @ \Rcode{U1.OV00} is a \Rclass{Hits} object that contains 1 element per overlap. Its length gives the number of overlaps: <>= length(U1.OV00) @ \subsubsection{Tabulate the single-end overlaps} We will repeatedly use the 2 following little helper functions to ``tabulate'' the overlaps in a given \Rclass{Hits} object (e.g. \Rcode{U1.OV00}), i.e. to count the number of overlaps for each element in the query or for each element in the subject: <>= nhitPerQuery <- function(x) tabulate(queryHits(x), nbins=queryLength(x)) nhitPerSubject <- function(x) tabulate(subjectHits(x), nbins=subjectLength(x)) @ Number of transcripts for each alignment in \Rcode{U1.GAL}: <>= U1.GAL_ntx <- nhitPerQuery(U1.OV00) mcols(U1.GAL)$ntx <- U1.GAL_ntx head(U1.GAL) table(U1.GAL_ntx) mean(U1.GAL_ntx >= 1) @ 76\% of the alignments in \Rcode{U1.GAL} have an overlap with at least 1 transcript in \Rcode{exbytx}. Note that \Rfunction{countOverlaps} can be used directly on \Rcode{U1.GAL} and \Rcode{exbytx} for computing \Rcode{U1.GAL\_ntx}: <>= U1.GAL_ntx_again <- countOverlaps(U1.GAL, exbytx, ignore.strand=TRUE) stopifnot(identical(unname(U1.GAL_ntx_again), U1.GAL_ntx)) @ Because \Rcode{U1.GAL} can (and actually does) contain more than 1 alignment per {\it original query} (aka read), we also count the number of transcripts for each read: <>= U1.OV10 <- remapHits(U1.OV00, query.map=U1.GAL_qnames) U1.uqnames_ntx <- nhitPerQuery(U1.OV10) names(U1.uqnames_ntx) <- U1.uqnames table(U1.uqnames_ntx) mean(U1.uqnames_ntx >= 1) @ 78.4\% of the reads have an overlap with at least 1 transcript in \Rcode{exbytx}. Number of reads for each transcript: <>= U1.exbytx_nOV10 <- nhitPerSubject(U1.OV10) names(U1.exbytx_nOV10) <- names(exbytx) mean(U1.exbytx_nOV10 >= 50) @ Only 0.869\% of the transcripts in \Rcode{exbytx} have an overlap with at least 50 reads. Top 10 transcripts: <>= head(sort(U1.exbytx_nOV10, decreasing=TRUE), n=10) @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{Paired-end overlaps} \subsubsection{Find the paired-end overlaps} Like with our single-end overlaps, we call \Rfunction{findOverlaps} with \Rcode{ignore.strand=TRUE}: <>= U3.OV00 <- findOverlaps(U3.GALP, exbytx, ignore.strand=TRUE) @ Like \Rcode{U1.OV00}, \Rcode{U3.OV00} is a \Rclass{Hits} object. Its length gives the number of paired-end overlaps: <>= length(U3.OV00) @ \subsubsection{Tabulate the paired-end overlaps} Number of transcripts for each alignment pair in \Rcode{U3.GALP}: <>= U3.GALP_ntx <- nhitPerQuery(U3.OV00) mcols(U3.GALP)$ntx <- U3.GALP_ntx head(U3.GALP) table(U3.GALP_ntx) mean(U3.GALP_ntx >= 1) @ 71\% of the alignment pairs in \Rcode{U3.GALP} have an overlap with at least 1 transcript in \Rcode{exbytx}. Note that \Rfunction{countOverlaps} can be used directly on \Rcode{U3.GALP} and \Rcode{exbytx} for computing \Rcode{U3.GALP\_ntx}: <>= U3.GALP_ntx_again <- countOverlaps(U3.GALP, exbytx, ignore.strand=TRUE) stopifnot(identical(unname(U3.GALP_ntx_again), U3.GALP_ntx)) @ Because \Rcode{U3.GALP} can (and actually does) contain more than 1 alignment pair per {\it original query template}, we also count the number of transcripts for each template: <>= U3.OV10 <- remapHits(U3.OV00, query.map=U3.GALP_qnames) U3.uqnames_ntx <- nhitPerQuery(U3.OV10) names(U3.uqnames_ntx) <- U3.uqnames table(U3.uqnames_ntx) mean(U3.uqnames_ntx >= 1) @ 72.3\% of the templates have an overlap with at least 1 transcript in \Rcode{exbytx}. Number of templates for each transcript: <>= U3.exbytx_nOV10 <- nhitPerSubject(U3.OV10) names(U3.exbytx_nOV10) <- names(exbytx) mean(U3.exbytx_nOV10 >= 50) @ Only 0.756\% of the transcripts in \Rcode{exbytx} have an overlap with at least 50 templates. Top 10 transcripts: <>= head(sort(U3.exbytx_nOV10, decreasing=TRUE), n=10) @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{Encode the overlaps between the reads and transcripts} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{Single-end encodings} The {\it overlap encodings} are strand sensitive so we will compute them twice, once for the ``original alignments'' (i.e. the alignments of the {\it original queries}), and once again for the ``flipped alignments'' (i.e. the alignments of the ``flipped {\it original queries}''). We extract the ranges of the ``original'' and ``flipped'' alignments in 2 \Rclass{GRangesList} objects with: <>= U1.grl <- grglist(U1.GAL, order.as.in.query=TRUE) U1.grlf <- flipQuery(U1.grl) # flipped @ and encode their overlaps with the transcripts: <>= U1.ovencA <- encodeOverlaps(U1.grl, exbytx, hits=U1.OV00) U1.ovencB <- encodeOverlaps(U1.grlf, exbytx, hits=U1.OV00) @ \Rcode{U1.ovencA} and \Rcode{U1.ovencB} are 2 \Rclass{OverlapsEncodings} objects of the same length as \Rclass{Hits} object \Rcode{U1.OV00}. For each hit in \Rcode{U1.OV00}, we have 2 corresponding encodings, one in \Rcode{U1.ovencA} and one in \Rcode{U1.ovencB}, but only one of them encodes a hit between alignment ranges and exon ranges that are on the same strand. We use the \Rfunction{selectEncodingWithCompatibleStrand} function to merge them into a single \Rclass{OverlapsEncodings} of the same length. For each hit in \Rcode{U1.OV00}, this selects the encoding corresponding to alignment ranges and exon ranges with compatible strand: <>= U1.grl_strand <- unlist(runValue(strand(U1.grl)), use.names=FALSE) U1.ovenc <- selectEncodingWithCompatibleStrand(U1.ovencA, U1.ovencB, U1.grl_strand, exbytx_strand, hits=U1.OV00) U1.ovenc @ As a convenience, the 2 above calls to \Rfunction{encodeOverlaps} + merging step can be replaced by a single call to \Rfunction{encodeOverlaps} on \Rcode{U1.grl} (or \Rcode{U1.grlf}) with \Rcode{flip.query.if.wrong.strand=TRUE}: <>= U1.ovenc_again <- encodeOverlaps(U1.grl, exbytx, hits=U1.OV00, flip.query.if.wrong.strand=TRUE) stopifnot(identical(U1.ovenc_again, U1.ovenc)) @ Unique encodings in \Rcode{U1.ovenc}: <>= U1.unique_encodings <- levels(U1.ovenc) length(U1.unique_encodings) head(U1.unique_encodings) U1.ovenc_table <- table(encoding(U1.ovenc)) tail(sort(U1.ovenc_table)) @ Encodings are sort of cryptic but utilities are provided to extract specific meaning from them. Use of these utilities is covered later in this document. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{Paired-end encodings} Let's encode the overlaps in \Rcode{U3.OV00}: <>= U3.grl <- grglist(U3.GALP) U3.ovenc <- encodeOverlaps(U3.grl, exbytx, hits=U3.OV00, flip.query.if.wrong.strand=TRUE) U3.ovenc @ Unique encodings in \Rcode{U3.ovenc}: <>= U3.unique_encodings <- levels(U3.ovenc) length(U3.unique_encodings) head(U3.unique_encodings) U3.ovenc_table <- table(encoding(U3.ovenc)) tail(sort(U3.ovenc_table)) @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{``Compatible'' overlaps} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% We are interested in a particular type of overlap where the read overlaps the transcript in a ``compatible'' way, that is, in a way compatible with the splicing of the transcript. The \Rfunction{isCompatibleWithSplicing} function can be used on an \Rclass{OverlapEncodings} object to detect this type of overlap. Note that \Rfunction{isCompatibleWithSplicing} can also be used on a character vector or factor. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{``Compatible'' single-end overlaps} \subsubsection{``Compatible'' single-end encodings} \Rcode{U1.ovenc} contains 7 unique encodings ``compatible'' with the splicing of the transcript: <>= sort(U1.ovenc_table[isCompatibleWithSplicing(U1.unique_encodings)]) @ Encodings \Rcode{"1:i:"} (455176 occurences in \Rcode{U1.ovenc}), \Rcode{"2:jm:af:"} (72929 occurences in \Rcode{U1.ovenc}), and \Rcode{"3:jmm:agm:aaf:"} (488 occurences in \Rcode{U1.ovenc}), correspond to the following overlaps: \begin{itemize} \item \Rcode{"1:i:"} \begin{verbatim} - read (no gap): oooooooo - transcript: ... >>>>>>>>>>>>>> ... \end{verbatim} \item \Rcode{"2:jm:af:"} \begin{verbatim} - read (1 gap): ooooo---ooo - transcript: ... >>>>>>>>> >>>>>>>>> ... \end{verbatim} \item \Rcode{"3:jmm:agm:aaf:"} \begin{verbatim} - read (2 gaps): oo---ooooo---o - transcript: ... >>>>>>>> >>>>> >>>>>>> ... \end{verbatim} \end{itemize} For clarity, only the exons involved in the overlap are represented. The transcript can of course have more upstream and downstream exons, which is denoted by the ... on the left side (5' end) and right side (3' end) of each drawing. Note that the exons represented in the 2nd and 3rd drawings are consecutive and adjacent in the processed transcript. Encodings \Rcode{"1:f:"} and \Rcode{"1:j:"} are variations of the situation described by encoding \Rcode{"1:i:"}. For \Rcode{"1:f:"}, the first aligned base of the read (or ``flipped'' read) is aligned with the first base of the exon. For \Rcode{"1:j:"}, the last aligned base of the read (or ``flipped'' read) is aligned with the last base of the exon: \begin{itemize} \item \Rcode{"1:f:"} \begin{verbatim} - read (no gap): oooooooo - transcript: ... >>>>>>>>>>>>>> ... \end{verbatim} \item \Rcode{"1:j:"} \begin{verbatim} - read (no gap): oooooooo - transcript: ... >>>>>>>>>>>>>> ... \end{verbatim} \end{itemize} <>= U1.OV00_is_comp <- isCompatibleWithSplicing(U1.ovenc) table(U1.OV00_is_comp) # 531797 "compatible" overlaps @ Finally, let's extract the ``compatible'' overlaps from \Rcode{U1.OV00}: <>= U1.compOV00 <- U1.OV00[U1.OV00_is_comp] @ Note that high-level convenience wrapper \Rfunction{findCompatibleOverlaps} can be used for computing the ``compatible'' overlaps directly between a \Rclass{GAlignments} object (containing reads) and a \Rclass{GRangesList} object (containing transcripts): <>= U1.compOV00_again <- findCompatibleOverlaps(U1.GAL, exbytx) stopifnot(identical(U1.compOV00_again, U1.compOV00)) @ \subsubsection{Tabulate the ``compatible'' single-end overlaps} Number of ``compatible'' transcripts for each alignment in \Rcode{U1.GAL}: <>= U1.GAL_ncomptx <- nhitPerQuery(U1.compOV00) mcols(U1.GAL)$ncomptx <- U1.GAL_ncomptx head(U1.GAL) table(U1.GAL_ncomptx) mean(U1.GAL_ncomptx >= 1) @ 75\% of the alignments in \Rcode{U1.GAL} are ``compatible'' with at least 1 transcript in \Rcode{exbytx}. Note that high-level convenience wrapper \Rfunction{countCompatibleOverlaps} can be used directly on \Rcode{U1.GAL} and \Rcode{exbytx} for computing \Rcode{U1.GAL\_ncomptx}: <>= U1.GAL_ncomptx_again <- countCompatibleOverlaps(U1.GAL, exbytx) stopifnot(identical(U1.GAL_ncomptx_again, U1.GAL_ncomptx)) @ Number of ``compatible'' transcripts for each read: <>= U1.compOV10 <- remapHits(U1.compOV00, query.map=U1.GAL_qnames) U1.uqnames_ncomptx <- nhitPerQuery(U1.compOV10) names(U1.uqnames_ncomptx) <- U1.uqnames table(U1.uqnames_ncomptx) mean(U1.uqnames_ncomptx >= 1) @ 77.5\% of the reads are ``compatible'' with at least 1 transcript in \Rcode{exbytx}. Number of ``compatible'' reads for each transcript: <>= U1.exbytx_ncompOV10 <- nhitPerSubject(U1.compOV10) names(U1.exbytx_ncompOV10) <- names(exbytx) mean(U1.exbytx_ncompOV10 >= 50) @ Only 0.87\% of the transcripts in \Rcode{exbytx} are ``compatible'' with at least 50 reads. Top 10 transcripts: <>= head(sort(U1.exbytx_ncompOV10, decreasing=TRUE), n=10) @ Note that this ``top 10'' is slightly different from the ``top 10'' we obtained earlier when we counted {\bf all} the overlaps. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{``Compatible'' paired-end overlaps} \subsubsection{``Compatible'' paired-end encodings} \Rcode{U3.ovenc} contains 13 unique paired-end encodings ``compatible'' with the splicing of the transcript: <>= sort(U3.ovenc_table[isCompatibleWithSplicing(U3.unique_encodings)]) @ Paired-end encodings \Rcode{"1{-}{-}1:i{-}{-}i:"} (100084 occurences in \Rcode{U3.ovenc}), \Rcode{"2{-}{-}1:jm{-}{-}m:af{-}{-}i:"} (2700 occurences in \Rcode{U3.ovenc}), \Rcode{"1{-}{-}2:i{-}{-}jm:a{-}{-}af:"} (2480 occurences in \Rcode{U3.ovenc}), \Rcode{"1{-}{-}1:i{-}{-}m:a{-}{-}i:"} (287 occurences in \Rcode{U3.ovenc}), and \Rcode{"2{-}{-}2:jm{-}{-}mm:af{-}{-}jm:aa{-}{-}af:"} (153 occurences in \Rcode{U3.ovenc}), correspond to the following paired-end overlaps: \begin{itemize} \item \Rcode{"1{-}{-}1:i{-}{-}i:"} \begin{verbatim} - paired-end read (no gap on the first end, no gap on the last end): oooo oooo - transcript: ... >>>>>>>>>>>>>>>> ... \end{verbatim} \item \Rcode{"2{-}{-}1:jm{-}{-}m:af{-}{-}i:"} \begin{verbatim} - paired-end read (1 gap on the first end, no gap on the last end): ooo---o oooo - transcript: ... >>>>>>>> >>>>>>>>>>> ... \end{verbatim} \item \Rcode{"1{-}{-}2:i{-}{-}jm:a{-}{-}af:"} \begin{verbatim} - paired-end read (no gap on the first end, 1 gap on the last end): oooo oo---oo - transcript: ... >>>>>>>>>>>>>> >>>>>>>>> ... \end{verbatim} \item \Rcode{"1{-}{-}1:i{-}{-}m:a{-}{-}i:"} \begin{verbatim} - paired-end read (no gap on the first end, no gap on the last end): oooo oooo - transcript: ... >>>>>>>>> >>>>>>> ... \end{verbatim} \item \Rcode{"2{-}{-}2:jm{-}{-}mm:af{-}{-}jm:aa{-}{-}af:"} \begin{verbatim} - paired-end read (1 gap on the first end, 1 gap on the last end): ooo---o oo---oo - transcript: ... >>>>>> >>>>>>> >>>>> ... \end{verbatim} \end{itemize} Note: switch use of ``first'' and ``last'' above if the read was ``flipped''. <>= U3.OV00_is_comp <- isCompatibleWithSplicing(U3.ovenc) table(U3.OV00_is_comp) # 106835 "compatible" paired-end overlaps @ Finally, let's extract the ``compatible'' paired-end overlaps from \Rcode{U3.OV00}: <>= U3.compOV00 <- U3.OV00[U3.OV00_is_comp] @ Note that, like with our single-end reads, high-level convenience wrapper \Rfunction{findCompatibleOverlaps} can be used for computing the ``compatible'' paired-end overlaps directly between a \Rclass{GAlignmentPairs} object (containing paired-end reads) and a \Rclass{GRangesList} object (containing transcripts): <>= U3.compOV00_again <- findCompatibleOverlaps(U3.GALP, exbytx) stopifnot(identical(U3.compOV00_again, U3.compOV00)) @ \subsubsection{Tabulate the ``compatible'' paired-end overlaps} Number of ``compatible'' transcripts for each alignment pair in \Rcode{U3.GALP}: <>= U3.GALP_ncomptx <- nhitPerQuery(U3.compOV00) mcols(U3.GALP)$ncomptx <- U3.GALP_ncomptx head(U3.GALP) table(U3.GALP_ncomptx) mean(U3.GALP_ncomptx >= 1) @ 69.7\% of the alignment pairs in \Rcode{U3.GALP} are ``compatible'' with at least 1 transcript in \Rcode{exbytx}. Note that high-level convenience wrapper \Rfunction{countCompatibleOverlaps} can be used directly on \Rcode{U3.GALP} and \Rcode{exbytx} for computing \Rcode{U3.GALP\_ncomptx}: <>= U3.GALP_ncomptx_again <- countCompatibleOverlaps(U3.GALP, exbytx) stopifnot(identical(U3.GALP_ncomptx_again, U3.GALP_ncomptx)) @ Number of ``compatible'' transcripts for each template: <>= U3.compOV10 <- remapHits(U3.compOV00, query.map=U3.GALP_qnames) U3.uqnames_ncomptx <- nhitPerQuery(U3.compOV10) names(U3.uqnames_ncomptx) <- U3.uqnames table(U3.uqnames_ncomptx) mean(U3.uqnames_ncomptx >= 1) @ 70.7\% of the templates are ``compatible'' with at least 1 transcript in \Rcode{exbytx}. Number of ``compatible'' templates for each transcript: <>= U3.exbytx_ncompOV10 <- nhitPerSubject(U3.compOV10) names(U3.exbytx_ncompOV10) <- names(exbytx) mean(U3.exbytx_ncompOV10 >= 50) @ Only 0.7\% of the transcripts in \Rcode{exbytx} are ``compatible'' with at least 50 templates. Top 10 transcripts: <>= head(sort(U3.exbytx_ncompOV10, decreasing=TRUE), n=10) @ Note that this ``top 10'' is slightly different from the ``top 10'' we obtained earlier when we counted {\bf all} the paired-end overlaps. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{Compute the {\it reference query sequences} and project them on the transcriptome} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{Compute the {\it reference query sequences}} The {\it reference query sequences} are the query sequences {\bf after} alignment, by opposition to the {\it original query sequences} (aka ``true'' or ``real'' query sequences) which are the query sequences {\bf before} alignment. The {\it reference query sequences} can easily be computed by extracting the nucleotides mapped to each read from the reference genome. This of course requires that we have access to the reference genome used by the aligner. In Bioconductor, the full genome sequence for the dm3 assembly is stored in the \Rpackage{BSgenome.Dmelanogaster.UCSC.dm3} data package \footnote{See \url{http://bioconductor.org/packages/release/data/annotation/} for the full list of annotation packages available in the current release of Bioconductor.}: <>= library(BSgenome.Dmelanogaster.UCSC.dm3) Dmelanogaster @ To extract the portions of the reference genome corresponding to the ranges in \Rcode{U1.grl}, we can use the \Rfunction{extractTranscriptSeqs} function defined in the \Rpackage{GenomicFeatures} package: <>= library(GenomicFeatures) U1.GAL_rqseq <- extractTranscriptSeqs(Dmelanogaster, U1.grl) head(U1.GAL_rqseq) @ When reads are paired-end, we need to extract separately the ranges corresponding to their {\it first} ends (aka {\it first} segments in BAM jargon) and those corresponding to their {\it last} ends (aka {\it last} segments in BAM jargon): <>= U3.grl_first <- grglist(first(U3.GALP, real.strand=TRUE), order.as.in.query=TRUE) U3.grl_last <- grglist(last(U3.GALP, real.strand=TRUE), order.as.in.query=TRUE) @ Then we extract the portions of the reference genome corresponding to the ranges in \Rclass{GRangesList} objects \Rcode{U3.grl\_first} and \Rcode{U3.grl\_last}: <>= U3.GALP_rqseq1 <- extractTranscriptSeqs(Dmelanogaster, U3.grl_first) U3.GALP_rqseq2 <- extractTranscriptSeqs(Dmelanogaster, U3.grl_last) @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{Project the single-end alignments on the transcriptome} The \Rfunction{extractQueryStartInTranscript} function computes for each overlap the position of the {\it query start} in the transcript: <>= U1.OV00_qstart <- extractQueryStartInTranscript(U1.grl, exbytx, hits=U1.OV00, ovenc=U1.ovenc) head(subset(U1.OV00_qstart, U1.OV00_is_comp)) @ \Rcode{U1.OV00\_qstart} is a data frame with 1 row per overlap and 3 columns: \begin{enumerate} \item \Rcode{startInTranscript}: the 1-based start position of the read with respect to the transcript. Position 1 always corresponds to the first base on the 5' end of the transcript sequence. \item \Rcode{firstSpannedExonRank}: the rank of the first exon spanned by the read, that is, the rank of the exon found at position \Rcode{startInTranscript} in the transcript. \item \Rcode{startInFirstSpannedExon}: the 1-based start position of the read with respect to the first exon spanned by the read. \end{enumerate} Having this information allows us for example to compare the read and transcript nucleotide sequences for each ``compatible'' overlap. If we use the {\it reference query sequence} instead of the {\it original query sequence} for this comparison, then it should match {\bf exactly} the sequence found at the {\it query start} in the transcript. Let's start by using \Rfunction{extractTranscriptSeqs} again to extract the transcript sequences (aka transcriptome) from the dm3 reference genome: <>= txseq <- extractTranscriptSeqs(Dmelanogaster, exbytx) @ For each ``compatible'' overlap, the read sequence in \Rcode{U1.GAL\_rqseq} must be an {\it exact} substring of the transcript sequence in \Rcode{exbytx\_seq}: <>= U1.OV00_rqseq <- U1.GAL_rqseq[queryHits(U1.OV00)] U1.OV00_rqseq[flippedQuery(U1.ovenc)] <- reverseComplement(U1.OV00_rqseq[flippedQuery(U1.ovenc)]) U1.OV00_txseq <- txseq[subjectHits(U1.OV00)] stopifnot(all( U1.OV00_rqseq[U1.OV00_is_comp] == narrow(U1.OV00_txseq[U1.OV00_is_comp], start=U1.OV00_qstart$startInTranscript[U1.OV00_is_comp], width=width(U1.OV00_rqseq)[U1.OV00_is_comp]) )) @ Because of this relationship between the {\it reference query sequence} and the transcript sequence of a ``compatible'' overlap, and because of the relationship between the {\it original query sequences} and the {\it reference query sequences}, then the edit distance reported in the NM tag is actually the edit distance between the {\it original query} and the transcript of a ``compatible'' overlap. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{Project the paired-end alignments on the transcriptome} For a paired-end read, the {\it query start} is the start of its ``left end''. <>= U3.OV00_Lqstart <- extractQueryStartInTranscript(U3.grl, exbytx, hits=U3.OV00, ovenc=U3.ovenc) head(subset(U3.OV00_Lqstart, U3.OV00_is_comp)) @ Note that \Rfunction{extractQueryStartInTranscript} can be called with \Rcode{for.query.right.end=TRUE} if we want this information for the ``right ends'' of the reads: <>= U3.OV00_Rqstart <- extractQueryStartInTranscript(U3.grl, exbytx, hits=U3.OV00, ovenc=U3.ovenc, for.query.right.end=TRUE) head(subset(U3.OV00_Rqstart, U3.OV00_is_comp)) @ Like with single-end reads, having this information allows us for example to compare the read and transcript nucleotide sequences for each ``compatible'' overlap. If we use the {\it reference query sequence} instead of the {\it original query sequence} for this comparison, then it should match {\bf exactly} the sequences of the ``left'' and ``right'' ends of the read in the transcript. Let's assign the ``left and right reference query sequences'' to each overlap: <>= U3.OV00_Lrqseq <- U3.GALP_rqseq1[queryHits(U3.OV00)] U3.OV00_Rrqseq <- U3.GALP_rqseq2[queryHits(U3.OV00)] @ For the single-end reads, the sequence associated with a ``flipped query'' just needed to be ``reverse complemented''. For paired-end reads, we also need to swap the 2 sequences in the pair: <>= flip_idx <- which(flippedQuery(U3.ovenc)) tmp <- U3.OV00_Lrqseq[flip_idx] U3.OV00_Lrqseq[flip_idx] <- reverseComplement(U3.OV00_Rrqseq[flip_idx]) U3.OV00_Rrqseq[flip_idx] <- reverseComplement(tmp) @ Let's assign the transcript sequence to each overlap: <>= U3.OV00_txseq <- txseq[subjectHits(U3.OV00)] @ For each ``compatible'' overlap, we expect the ``left and right reference query sequences'' of the read to be {\it exact} substrings of the transcript sequence. Let's check the ``left reference query sequences'': <>= stopifnot(all( U3.OV00_Lrqseq[U3.OV00_is_comp] == narrow(U3.OV00_txseq[U3.OV00_is_comp], start=U3.OV00_Lqstart$startInTranscript[U3.OV00_is_comp], width=width(U3.OV00_Lrqseq)[U3.OV00_is_comp]) )) @ and the ``right reference query sequences'': <>= stopifnot(all( U3.OV00_Rrqseq[U3.OV00_is_comp] == narrow(U3.OV00_txseq[U3.OV00_is_comp], start=U3.OV00_Rqstart$startInTranscript[U3.OV00_is_comp], width=width(U3.OV00_Rrqseq)[U3.OV00_is_comp]) )) @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{Align the reads to the transcriptome} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% Aligning the reads to the reference genome is not the most efficient nor accurate way to count the number of ``compatible'' overlaps per {\it original query}. Supporting junction reads (i.e. reads that align with at least 1 gap) introduces a significant computational cost during the alignment process. Then, as we've seen in the previous sections, each alignment produced by the aligner needs to be broken into a set of ranges (based on its CIGAR) and those ranges compared to the ranges of the exons grouped by transcript. A more straightforward and accurate approach is to align the reads directly to the transcriptome, and without allowing the typical gap that the aligner needs to introduce when aligning a junction read to the reference genome. With this approach, a ``hit'' between a read and a transcript is necessarily compatible with the splicing of the transcript. In case of a ``hit'', we'll say that the read and the transcript are ``string-based compatible'' (to differentiate from our previous notion of ``compatible'' overlaps that we will call ``encoding-based compatible'' from now on, unless the context is clear). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{Align the single-end reads to the transcriptome} \subsubsection{Find the ``hits''} The single-end reads are in \Rcode{U1.oqseq}, the transcriptome is in \Rcode{exbytx\_seq}. Since indels were not allowed/supported during the alignment of the reads to the reference genome, we don't need to allow/support them either for aligning the reads to the transcriptome. Also since our goal is to find (and count) ``compatible'' overlaps between reads and transcripts, we don't need to keep track of the details of the alignments between the reads and the transcripts. Finally, since BAM file {\tt untreated1\_chr4.bam} is not the full output of the aligner but the subset obtained by keeping only the alignments located on chr4, we don't need to align \Rcode{U1.oqseq} to the full transcriptome, but only to the subset of \Rcode{exbytx\_seq} made of the transcripts located on chr4. With those simplifications in mind, we write the following function that we will use to find the ``hits'' between the reads and the transcriptome: <>= ### A wrapper to vwhichPDict() that supports IUPAC ambiguity codes in 'qseq' ### and 'txseq', and treats them as such. findSequenceHits <- function(qseq, txseq, which.txseq=NULL, max.mismatch=0) { .asHits <- function(x, pattern_length) { query_hits <- unlist(x) if (is.null(query_hits)) query_hits <- integer(0) subject_hits <- rep.int(seq_len(length(x)), elementLengths(x)) Hits(query_hits, subject_hits, pattern_length, length(x)) } .isHitInTranscriptBounds <- function(hits, qseq, txseq) { sapply(seq_len(length(hits)), function(i) { pattern <- qseq[[queryHits(hits)[i]]] subject <- txseq[[subjectHits(hits)[i]]] v <- matchPattern(pattern, subject, max.mismatch=max.mismatch, fixed=FALSE) any(1L <= start(v) & end(v) <= length(subject)) }) } if (!is.null(which.txseq)) { txseq0 <- txseq txseq <- txseq[which.txseq] } names(qseq) <- NULL other <- alphabetFrequency(qseq, baseOnly=TRUE)[ , "other"] is_clean <- other == 0L # "clean" means "no IUPAC ambiguity code" ## Find hits for "clean" original queries. qseq0 <- qseq[is_clean] pdict0 <- PDict(qseq0, max.mismatch=max.mismatch) m0 <- vwhichPDict(pdict0, txseq, max.mismatch=max.mismatch, fixed="pattern") hits0 <- .asHits(m0, length(qseq0)) hits0@queryLength <- length(qseq) hits0@queryHits <- which(is_clean)[hits0@queryHits] ## Find hits for non "clean" original queries. qseq1 <- qseq[!is_clean] m1 <- vwhichPDict(qseq1, txseq, max.mismatch=max.mismatch, fixed=FALSE) hits1 <- .asHits(m1, length(qseq1)) hits1@queryLength <- length(qseq) hits1@queryHits <- which(!is_clean)[hits1@queryHits] ## Combine the hits. query_hits <- c(queryHits(hits0), queryHits(hits1)) subject_hits <- c(subjectHits(hits0), subjectHits(hits1)) if (!is.null(which.txseq)) { ## Remap the hits. txseq <- txseq0 subject_hits <- which.txseq[subject_hits] hits0@subjectLength <- length(txseq) } ## Order the hits. oo <- S4Vectors:::orderIntegerPairs(query_hits, subject_hits) hits0@queryHits <- query_hits[oo] hits0@subjectHits <- subject_hits[oo] if (max.mismatch != 0L) { ## Keep only "in bounds" hits. is_in_bounds <- .isHitInTranscriptBounds(hits0, qseq, txseq) hits0 <- hits0[is_in_bounds] } hits0 } @ Let's compute the index of the transcripts in \Rcode{exbytx\_seq} located on chr4 (\Rfunction{findSequenceHits} will restrict the search to those transcripts): <>= chr4tx <- transcripts(txdb, vals=list(tx_chrom="chr4")) chr4txnames <- mcols(chr4tx)$tx_name which.txseq <- match(chr4txnames, names(txseq)) @ We know that the aligner tolerated up to 6 mismatches per read. The 3 following commands find the ``hits'' for each {\it original query}, then find the ``hits'' for each ``flipped {\it original query}'', and finally merge all the ``hits'' (note that the 3 commands take about 1 hour to complete on a modern laptop): <>= U1.sbcompHITSa <- findSequenceHits(U1.oqseq, txseq, which.txseq=which.txseq, max.mismatch=6) U1.sbcompHITSb <- findSequenceHits(reverseComplement(U1.oqseq), txseq, which.txseq=which.txseq, max.mismatch=6) U1.sbcompHITS <- union(U1.sbcompHITSa, U1.sbcompHITSb) @ <>= U1.sbcompHITSa <- .loadPrecomputed("U1.sbcompHITSa") U1.sbcompHITSb <- .loadPrecomputed("U1.sbcompHITSb") U1.sbcompHITS <- union(U1.sbcompHITSa, U1.sbcompHITSb) @ \subsubsection{Tabulate the ``hits''} Number of ``string-based compatible'' transcripts for each read: <>= U1.uqnames_nsbcomptx <- nhitPerQuery(U1.sbcompHITS) names(U1.uqnames_nsbcomptx) <- U1.uqnames table(U1.uqnames_nsbcomptx) mean(U1.uqnames_nsbcomptx >= 1) @ 77.7\% of the reads are ``string-based compatible'' with at least 1 transcript in \Rcode{exbytx}. Number of ``string-based compatible'' reads for each transcript: <>= U1.exbytx_nsbcompHITS <- nhitPerSubject(U1.sbcompHITS) names(U1.exbytx_nsbcompHITS) <- names(exbytx) mean(U1.exbytx_nsbcompHITS >= 50) @ Only 0.865\% of the transcripts in \Rcode{exbytx} are ``string-based compatible'' with at least 50 reads. Top 10 transcripts: <>= head(sort(U1.exbytx_nsbcompHITS, decreasing=TRUE), n=10) @ \subsubsection{A closer look at the ``hits''} [WORK IN PROGRESS, might be removed or replaced soon...] Any ``encoding-based compatible'' overlap is of course ``string-based compatible'': <>= stopifnot(length(setdiff(U1.compOV10, U1.sbcompHITS)) == 0) @ but the reverse is not true: <>= length(setdiff(U1.sbcompHITS, U1.compOV10)) @ %To understand why the {\it overlap encodings} approach doesn't find all %the ``string-based compatible'' hits, let's look at the second hit in %\Rcode{setdiff(U1.sbcompHITS, U1.compOV10)}. This is a perfect hit between %read SRR031728.4692406 and transcript 18924: % %<<>>= %matchPattern(U1.oqseq[[6306]], txseq[[18924]]) %U1.GAL_idx <- which(U1.GAL_qnames == "SRR031728.4692406") %U1.GAL[U1.GAL_idx] %U1.GAL_idx %in% queryHits(U1.OV00) %U1.GAL[12636] %which(queryHits(U1.OV00) == 12636) %U1.OV00[305] %as.character(encoding(U1.ovenc)[305]) %@ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{Align the paired-end reads to the transcriptome} [COMING SOON...] %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{``Almost compatible'' overlaps} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% In many aspects, ``compatible'' overlaps can be seen as perfect. We are now insterested in a less perfect type of overlap where the read overlaps the transcript in a way that {\it would} be ``compatible'' if 1 or more exons were removed from the transcript. In that case we say that the overlap is ``almost compatible'' with the transcript. The \Rfunction{isCompatibleWithSkippedExons} function can be used on an \Rclass{OverlapEncodings} object to detect this type of overlap. Note that \Rfunction{isCompatibleWithSkippedExons} can also be used on a character vector of factor. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{``Almost compatible'' single-end overlaps} \subsubsection{``Almost compatible'' single-end encodings} \Rcode{U1.ovenc} contains 7 unique encodings ``almost compatible'' with the splicing of the transcript: <>= sort(U1.ovenc_table[isCompatibleWithSkippedExons(U1.unique_encodings)]) @ Encodings \Rcode{"2:jm:am:af:"} (1015 occurences in \Rcode{U1.ovenc}), \Rcode{"2:jm:am:am:af:"} (144 occurences in \Rcode{U1.ovenc}), and \Rcode{"3:jmm:agm:aam:aaf:"} (21 occurences in \Rcode{U1.ovenc}), correspond to the following overlaps: \begin{itemize} \item \Rcode{"2:jm:am:af:"} \begin{verbatim} - read (1 gap): ooooo----------ooo - transcript: ... >>>>>>> >>>> >>>>>>>> ... \end{verbatim} \item \Rcode{"2:jm:am:am:af:"} \begin{verbatim} - read (1 gap): ooooo------------------ooo - transcript: ... >>>>>>> >>>> >>>>> >>>>>>>> ... \end{verbatim} \item \Rcode{"3:jmm:agm:aam:aaf:"} \begin{verbatim} - read (2 gaps): oo---oooo-----------oo - transcript: ... >>>>>>> >>>> >>>>> >>>>>>>> ... \end{verbatim} \end{itemize} <>= U1.OV00_is_acomp <- isCompatibleWithSkippedExons(U1.ovenc) table(U1.OV00_is_acomp) # 1202 "almost compatible" overlaps @ Finally, let's extract the ``almost compatible'' overlaps from \Rcode{U1.OV00}: <>= U1.acompOV00 <- U1.OV00[U1.OV00_is_acomp] @ \subsubsection{Tabulate the ``almost compatible'' single-end overlaps} Number of ``almost compatible'' transcripts for each alignment in \Rcode{U1.GAL}: <>= U1.GAL_nacomptx <- nhitPerQuery(U1.acompOV00) mcols(U1.GAL)$nacomptx <- U1.GAL_nacomptx head(U1.GAL) table(U1.GAL_nacomptx) mean(U1.GAL_nacomptx >= 1) @ Only 0.27\% of the alignments in \Rcode{U1.GAL} are ``almost compatible'' with at least 1 transcript in \Rcode{exbytx}. Number of ``almost compatible'' alignments for each transcript: <>= U1.exbytx_nacompOV00 <- nhitPerSubject(U1.acompOV00) names(U1.exbytx_nacompOV00) <- names(exbytx) table(U1.exbytx_nacompOV00) mean(U1.exbytx_nacompOV00 >= 50) @ Only 0.017\% of the transcripts in \Rcode{exbytx} are ``almost compatible'' with at least 50 alignments in \Rcode{U1.GAL}. Finally note that the ``query start in transcript'' values returned by \Rfunction{extractQueryStartInTranscript} are also defined for ``almost compatible'' overlaps: <>= head(subset(U1.OV00_qstart, U1.OV00_is_acomp)) @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{``Almost compatible'' paired-end overlaps} \subsubsection{``Almost compatible'' paired-end encodings} \Rcode{U3.ovenc} contains 5 unique paired-end encodings ``almost compatible'' with the splicing of the transcript: <>= sort(U3.ovenc_table[isCompatibleWithSkippedExons(U3.unique_encodings)]) @ Paired-end encodings \Rcode{"2{-}{-}1:jm{-}{-}m:am{-}{-}m:af{-}{-}i:"} (73 occurences in \Rcode{U3.ovenc}), \Rcode{"1{-}{-}2:i{-}{-}jm:a{-}{-}am:a{-}{-}af:"} (53 occurences in \Rcode{U3.ovenc}), and \Rcode{"2{-}{-}2:jm{-}{-}mm:am{-}{-}mm:af{-}{-}jm:aa{-}{-}af:"} (9 occurences in \Rcode{U3.ovenc}), correspond to the following paired-end overlaps: \begin{itemize} \item \Rcode{"2{-}{-}1:jm{-}{-}m:am{-}{-}m:af{-}{-}i:"} \begin{verbatim} - paired-end read (1 gap on the first end, no gap on the last end): ooo----------o oooo - transcript: ... >>>>> >>>> >>>>>>>>> ... \end{verbatim} \item \Rcode{"1{-}{-}2:i{-}{-}jm:a{-}{-}am:a{-}{-}af:"} \begin{verbatim} - paired-end read (no gap on the first end, 1 gap on the last end): oooo oo---------oo - transcript: ... >>>>>>>>>>> >>> >>>>>> ... \end{verbatim} \item \Rcode{"2{-}{-}2:jm{-}{-}mm:am{-}{-}mm:af{-}{-}jm:aa{-}{-}af:"} \begin{verbatim} - paired-end read (1 gap on the first end, 1 gap on the last end): o----------ooo oo---oo - transcript: ... >>>>> >>>> >>>>>>>> >>>>>> ... \end{verbatim} \end{itemize} Note: switch use of ``first'' and ``last'' above if the read was ``flipped''. <>= U3.OV00_is_acomp <- isCompatibleWithSkippedExons(U3.ovenc) table(U3.OV00_is_acomp) # 141 "almost compatible" paired-end overlaps @ Finally, let's extract the ``almost compatible'' paired-end overlaps from \Rcode{U3.OV00}: <>= U3.acompOV00 <- U3.OV00[U3.OV00_is_acomp] @ \subsubsection{Tabulate the ``almost compatible'' paired-end overlaps} Number of ``almost compatible'' transcripts for each alignment pair in \Rcode{U3.GALP}: <>= U3.GALP_nacomptx <- nhitPerQuery(U3.acompOV00) mcols(U3.GALP)$nacomptx <- U3.GALP_nacomptx head(U3.GALP) table(U3.GALP_nacomptx) mean(U3.GALP_nacomptx >= 1) @ Only 0.2\% of the alignment pairs in \Rcode{U3.GALP} are ``almost compatible'' with at least 1 transcript in \Rcode{exbytx}. Number of ``almost compatible'' alignment pairs for each transcript: <>= U3.exbytx_nacompOV00 <- nhitPerSubject(U3.acompOV00) names(U3.exbytx_nacompOV00) <- names(exbytx) table(U3.exbytx_nacompOV00) mean(U3.exbytx_nacompOV00 >= 50) @ Only 0.0034\% of the transcripts in \Rcode{exbytx} are ``almost compatible'' with at least 50 alignment pairs in \Rcode{U3.GALP}. Finally note that the ``query start in transcript'' values returned by \Rfunction{extractQueryStartInTranscript} are also defined for ``almost compatible'' paired-end overlaps: <>= head(subset(U3.OV00_Lqstart, U3.OV00_is_acomp)) head(subset(U3.OV00_Rqstart, U3.OV00_is_acomp)) @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{Detect novel splice junctions} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{By looking at single-end overlaps} An alignment in \Rcode{U1.GAL} with ``almost compatible'' overlaps but no ``compatible'' overlaps suggests the presence of one or more transcripts that are not in our annotations. First we extract the index of those alignments ({\it nsj} here stands for ``{\bf n}ovel {\bf s}plice {\bf j}unction''): <>= U1.GAL_is_nsj <- U1.GAL_nacomptx != 0L & U1.GAL_ncomptx == 0L head(which(U1.GAL_is_nsj)) @ We make this an index into \Rcode{U1.OV00}: <>= U1.OV00_is_nsj <- queryHits(U1.OV00) %in% which(U1.GAL_is_nsj) @ We intersect with \Rcode{U1.OV00\_is\_acomp} and then subset \Rcode{U1.OV00} to keep only the overlaps that suggest novel splicing: <>= U1.OV00_is_nsj <- U1.OV00_is_nsj & U1.OV00_is_acomp U1.nsjOV00 <- U1.OV00[U1.OV00_is_nsj] @ For each overlap in \Rcode{U1.nsjOV00}, we extract the ranks of the skipped exons (we use a list for this as there might be more than 1 skipped exon per overlap): <>= U1.nsjOV00_skippedex <- extractSkippedExonRanks(U1.ovenc)[U1.OV00_is_nsj] names(U1.nsjOV00_skippedex) <- queryHits(U1.nsjOV00) table(elementLengths(U1.nsjOV00_skippedex)) @ Finally, we split \Rcode{U1.nsjOV00\_skippedex} by transcript names: <>= f <- factor(names(exbytx)[subjectHits(U1.nsjOV00)], levels=names(exbytx)) U1.exbytx_skippedex <- split(U1.nsjOV00_skippedex, f) @ \Rcode{U1.exbytx\_skippedex} is a named list of named lists of integer vectors. The first level of names (outer names) are transcript names and the second level of names (inner names) are alignment indices into \Rcode{U1.GAL}: <>= head(names(U1.exbytx_skippedex)) # transcript names @ Transcript FBtr0089124 receives 7 hits. All of them skip exons 9 and 10: <>= U1.exbytx_skippedex$FBtr0089124 @ Transcript FBtr0089147 receives 4 hits. Two of them skip exon 2, one of them skips exons 2 to 6, and one of them skips exon 10: <>= U1.exbytx_skippedex$FBtr0089147 @ A few words about the interpretation of \Rcode{U1.exbytx\_skippedex}: Because of how we've conducted this analysis, the aligments reported in \Rcode{U1.exbytx\_skippedex} are guaranteed to not have any ``compatible'' overlaps with other known transcripts. All we can say, for example in the case of transcript FBtr0089124, is that the 7 reported hits that skip exons 9 and 10 show evidence of one or more unknown transcripts with a splice junction that corresponds to the gap between exons 8 and 11. But without further analysis, we can't make any assumption about the exons structure of those unknown transcripts. In particular, we cannot assume the existence of an unknown transcript made of the same exons as transcript FBtr0089124 minus exons 9 and 10! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{By looking at paired-end overlaps} [COMING SOON...] %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{\Rcode{sessionInfo()}} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% <>= sessionInfo() @ \end{document} GenomicAlignments/inst/doc/OverlapEncodings.pdf0000644000175100017510000061315612612051202022657 0ustar00biocbuildbiocbuild%PDF-1.5 % 212 0 obj << /Length 1877 /Filter /FlateDecode >> stream x[Ks6WprfJoIf6%9++ɶ&(v}A$|:Q)E6RI̙ F]fH F-5r1Nh~ ?^L@iH2AElTnzL0> GKv Dƒ b ,na*q2` POHp٥U\tJxMl No9.ܮ=[¹1N%< 1Ie:X ;.@$PFX",| &p+IT"1gJxd ')DИbt%kprzO󒀈<\kvDd- ڴL' R:K'vQCPQ(壅BG!('<߄T=9GY7զmx%;蕎PBql ]i ^IIs7{*aS.pRju4ss\-ѱeSbM[ˀVb[wJ~dpHiԕi;= dmȧ>6ۂ|;cx/v*BlW° h&NyhْŒV C b쑌q앓 9D}ur,Cv7NʾU%6nI!> r*ҿkŎv61窈-hEEQVZ=[ bRJb r( %+v[U)Ǵ\4k8_ηPF>bBiѤWX*z6oH_iִvqשxMT,ЊB %w{/[S #[ȋ"BZ|z،DiB݉if#p;rv Y;WJS{i=j4]P/7uBucgZ lֶ{żd&ץzMj `9uLz[%|-`H]v2lGHX n>s}mo7vO'/Y%:W?,.t:GJ/z48M՝ϭYWqz^[]9ׯ-_ִam?N/vT[T246I8> ELt endstream endobj 2 0 obj << /Type /ObjStm /N 100 /First 814 /Length 1617 /Filter /FlateDecode >> stream xڵnH|99 L2 H|s DLj$*3~lJml Aj6͖$Ȓx=I&i?ɀRpI9GJ. mq@ 4E#M 5Y cz $L 8#EExc[G>R AqVS0B(0NdNn`IJSJP] ha2G 3C7 Pp [ւ(rmK 1AC2@\5tIEѼ.1X+QԘ,dD4 E$ 88 4Mkn/'QQ$ c&QX^FsE*554"=J bxR f4JiMcz3-a]-{tR5z}p W.iRSԷT''g~B8c:?j7\/(OpR^oK,ݑ4"QR.柲ڛfRTӫpLW }޺ϛ9Kѽ/5@}]԰t$nF5[ȁr6*r;ַ"y,U[/6 mL(a Y]K./' gy5<.E>Z-|Ut ]v\4QYmC%J䚺gA/.v<]<ҭEjIz\Gug 8)o ĕѴe4'5<Z߮~W8p6t N8<4 e˫ We}{*oOpߡ=0aii-ephꛃﱗŏa3ۄGws^P4ը/* hs\Z*ףZ6,W`t[Oz3}Cs97A_h~؜s~684\|/Q]5힬K9g~))[aqXKg7FγI=Sq/;`;a#r\F|8#}PU5?k?0Y*_v6$;D2YN$kMx!Bċ/&^Lx1bċO LV%5d]>ِl;S6:lW68'm858K3ksZ=VhK Q]T,Vo*!W Q/*ċL,LlȺ9\K \՘rr( 5XᅛdhMZaIז+_,(|`fs/ ʢ_I<>1Xϗ K:֒&1:7\KT^ZRCU?>Dk6*|8;l|Fg5 c:V45"nV :=4KXN~CIó endstream endobj 235 0 obj << /Length 3130 /Filter /FlateDecode >> stream xZ[s6~e  ;Mw6ltvhVHT=)I>"A\;Z#9z|)F(Qn-+F>%:hӉr.Zw82Vk86P8x"L)di25"yYh zd41y.GmDaKu!،NJc/2m#+6@($.Tu:kN=Ӊ)~r)f=LceBr2jT x~Zh27T>^S{}6/QC^wpVGC^/xEρƝ"8QJ&(P^;Q]ćqb}-awIΖU]?{͂]m@ךd2-*=-~>czԫǻǀ| =G{zM&D;Q26+nKp\@!7cx ^m>F]-QSX|jOnG۬{7'$yο-i:1N e]-j2 qܿVȰyCU8?Д+9h.&jWUUL#ALL#Pj{hʠd1 dΛB&GKfD';:H]2  ii5##T쉢k4i`iW#+պCMz)W TfǵSIRͮ>V(I('+ʖ:E ݔN'rvpdd;vQ$N_Heg i8,ۡ8W) jyv<Hs Be ySnv~s\ ׿&LnGL^> ҵkHp-NnzC8#d?FFR\ËѷBRz =d1M3$-}+CON\M@qNIb0 #ێǑQa |TA5󦵭r U;{pgBffzeZ&{?~~g߆Yy")ϙ?Kv1 hM}pSIgw 3ϳD4o'l|N0"ecO$9gn&g96x' {Ok Fq}\R)•7@zpRp8 @a5 Gd<1&y6AyU2yIA7 04 [Jg ;W0nF04ϽG: <muC]Ejo[N=GEAT:552MرƵQުBma;?aBQ ($ cHzb=V9X<.In-3}1J LI۫vZ뷞Vi>,'I?&4 em?:eyǎ6v;p;υ:4B*>Ɩkډ|k >)Ju5)ğUD8$_AF jmOE::5p5:Qi Y+e2,ὒgy֯Yڧ;L{-)Ǹ-R&.N_$Y_4 ,U=xy^ٿK5|oXO]h:㲜ʹ?{;(x_xo̥}\"aa,%W&ϥw؏Y¹e@ba_ գ\Ҷ 'vVw!:ZX(&Jo>3sv xJ1k y9?X浠l7;u_(Ґ' endstream endobj 243 0 obj << /Length 2655 /Filter /FlateDecode >> stream xڵZm۶_HS@$=v:v/$ -t$E/ﳯ HQ;]@f{<+GURyGg'JGE棟Ư?6;.ᧆg37+֓+s^³Z&kUi )632yM84M,)}CxRx,<< \cϠ~Ó6KLD Ǿw[YyD}hN_cHf3ZTy~;Җ Bx>#!H2ZLbB8V QɷJʒbzC!<"cL)t~Ξ;jód"y:ٵw\FWTSOdЎds)m0DŽRTm~&aX}CɧS<ʪR1"^> ^ڛnF8OzMtO6/L\{j#;b_Q Dd}Kqva{:FXb^vBdU&=,K2l1Ҁ |BFwIB]Q&94'qw!WQt "Shk]M#K+|1 h6IRXFiDםDcz3"V^ P5n1E',P}ix]bu/u7&QE;? _0YxӨGZXS&ӎq_q6j#Ix1r2g;|^J!: ]@[[k\ tkVҫ,:D.:L{FJ1jprU̕%ozB)v MЕU> A Ě؉eB]vԻ"B6r磳8<Ñ8oH,.έ$ӓ.6ںPV;MNJ Wf9r6]y-}RUM+wrߡ Zn%̓B핫YGC-'!X>5_EĘ. ;DEWK!\`?zGq4`R/%hs'p=qF`F~ k W?[ Ϊ8q0, }z$]i? w#^NXJ>8.PNXecC-?'q endstream endobj 247 0 obj << /Length 2375 /Filter /FlateDecode >> stream xn7=_!K%lr8'( @`f7.AFweɑFMseF-{-#Cxn9:ѫg?=楶F4FrTarTk#-Fos=kמo&SUyno#ݔ”hxL߼dé(5ZXВ7ڿ)S=[(8Lь}ػG; ]:V? bdZH]H{:uͩ_%oi%.vTB9B4UuyɫX݋ CnF8Hޏi!m#opUg F˻?!U=(F_(! }6l""'y`#{LKy Qz^S*'܏DȡyZC%ǤHrOf M{ٸ s}w4mLWj3E;t(p[/-hy#cZs@Hg\OԎ% ?e`R4ug_:'d/uLk+_߯s ;@xlL:Ħ.EUpnڿݎ0>y]&ʎox >& xN0<>Dn]XjYr\ƃ1ެBQEgi6NepTZ2rX Сv^ӝ}yw^-yQ('i]5f}JAW$&XDG8cG9RFH8A7ĩ\ԑ<'wK М3}ಭWዎ Dԋ4,*9%MboӺJd \H-8 6L܉-f 8-(,ĪZHYw LJRW 7|ߑs;cY˞!Ozu( R1@3``nwgEKx>12ѫ?v%]£Y9`z2=T &>-C"pPIw>E #- ?}r_=/t endstream endobj 255 0 obj << /Length 2709 /Filter /FlateDecode >> stream xn8=_!acF")J*ؙ6Yti]S,[qږk)I{n(GNf!y7&Q==Q ]tvNDu*l2͢9~sF9c ŏGyrtpOU+xߎ6WG /(8A$ ƈ[S3d%fc+;"q8L@B4ITJ[\p34A ^*@׷=u`ӗ<9&&g0]~2 fBj'`G Ǡг@Y\M̢8*֫{LB~lU5#~[Flz֣˓7KQ>'Sr.|kݐ+#;A] RV\ Ч~\L\@-&gxJ6za6|L#1)G1&3ٍjM}o,^_0ΩD+b5%y4fMJlwE͜QA[!8xPJV 7#.32 M@fT f)M3H[!@xC:hI1 "nKyE7Ik=Nw@d3acSZEfR@ˋHSCyr } & .HN ,8tSxyW[{nZADԧ eQ٥)=N-E+mLin/_DB <"-a'iНI6rJNlv/$S:;ln`'9JEޏ\/#yg.-_`q^oNnx7)x X~`DZӭ *.lXqC"βhMCGUƂ^BBBzIONsnR%:Nj* a*YK% SQ˰xyÛvGuE3Yn[펞?JMwWujtӤ*橲ʨNw~d*d7^:Xlƾ,c@A@7ڠ^C"Mh2E-w12DSZ<۟$4k`hݩN,Bt ]BblnCQ@:uO #éTW~=EB2r,S6#N>>9\;eN{kdۊD{Sri _rBJslϱY\SaρUgVBM_yAZ^]w 51t IXuLNorq.wDt i6|Ov!z+2ϗu1trhlˋ弿G6X/F78أrMYJ:mu\Fqv%ϕuvLF Yל nk;}nȼ :_3:^%NSW:K0ιi^I:-Qw8 Μ:Vй{EUBɋM.F5XzB7I=81Q@REIxn{>5mX4Vc.)/k3c w Sy6MYNٟIpG\cv7y>en"#<\R@߃[0ӹ|hwr8vLsO6<С0K1盅Ruu\u,>CfWz=k̙qcU1bS]Q$Z 323drxl]f eܲZɢ&p-f⏓, 4> stream xZ[6~_!Lփ5`[`d6hiX[r,y.@|ÏɒfyX"; g/fgQ~ězq'9(țۻ"6\Ŕs6)wyQ]LY:)Zݲ0O8KDvX:a΂SM<呟%4f|)֗ā Kxފ&bKq+іxEk@sEN+ x/KJx08nUxy1HS?@E%+H_pZ@8ӯt2I{ R6)x^WuQAkkL܏X$MUϙ5E[saceXK0ed*h{ۧf|wGpn w8,+3fwFIƮf(JKQj ]>e}ƟoO +G;%RJa!r)ZdkضuR/Zh k{.z7xvΡyqUv ih!q˕a+Y%`-F.`>8B$y!Dι {#&?iVufi5& w=\~Z֧[k, "&/W$ ۨ8W'Z|Fo~{6_}sM}k?:DfÔ'»L?"~ p ɸo emɈ'B[@r?#o ɓ\D NլSPEhdIa("&o$G6I`,,>.^ yK agqG!S+ޛ38(jXuq[}ȻU:%[fL8|!;$GX`S3g1%V^Yy70R킻vtiX~.{aB FVmylVfD`33ӊHP]q "lww~+sNg&NH: ,z6sJoo:9Yt[YUh ߚXWZa% TTo3@%ۖږ5!c {KY7έ }nLBb/騎 (0o#zcKݖ2K];=.Ԣ7n0 _W#DfE`Fqě~;6+? ~bs W-}NPiP_`zbn>n)!,Q{QJ_ka&v"X Qa@ޡ@4"T g-v% =ٌ|0~8"U HDV lެokO] mo;an'S4\t7iM {/4t\G9 8|; >g1QcҎd?d6SW܇-t_>1B#8D%؞x> stream xn6=_!l}pMTlڡi;t֦CJ";lɵK}x9($Z/sӡq0 p|C J$ ".ypMw@]i(pj7P nNelN;|gt! IM_I٬ $~Ɂ-WoMKd`r`oIE{vvGؔw>!QK ޓ-i6VZF?  7F1qXKL-g.[ˁ=r" 50_mp\!]bHs.Ö AC9-hA{}|vO\| 85ݢI--}6yip 0 qG EjlzJF)`f1 2Lƣw|,?*3e*J܁ (G\rub tTꄣM N ?i% Ch=~k#3VfYXB2RZ\٤mnJ@:IV3אu-",I=o^9QB ]R@LP ^3(Y)&]1:Y[YiFZM%L-:4$]"F>U!0֠}UzD9D1Ŷjp/QVf C.QBt6(M>RB#zԹ^[5=DyB39Φ҉s*!>R{ٞyN:aY,|ISi8߃;Bd_%k"x.lOTa~7,u=C h\'q!bPbJ&2m%XgڒԞ h91:ϛ=ʍڳ[95 a5j'&7Mڔc „JLRWc8* SЀ pt-G !7QhwX bn޵݁& Jcש}O#2&mgՇWmn hnnU@ &Q;*x(Mwj:jJ3cH<@ssry *M"J U/1.s$UE6WPXWaeof&V#VS ߍ'̚B,z&]1 '5ck-Ve͉;//l =i*iD[lװ 9nK{>{AeM|הi{6e'\}- [Kg`2?JEj^y흚xrEj4{Dϝ$͟rz Aҭ33Ofkp*65[.=6`+'\JY8FP5Xfp҅MNOw T{`>4{`?ץF%P98|˷^ϯ?T7x^\*pEC_a+S+k`u …f2DB6?lC-2s1sJ2#:) Qw bm9u?{*\gǯ$ލV{RV;Mώ/) endstream endobj 272 0 obj << /Length 1729 /Filter /FlateDecode >> stream xYݏ6 "/lQeY.V0lf{e$w'-;rtrd")GRGx1xJAJR`<ĊT t>z{7h{mdf GBh6ϓpēhjfǁLQB-m/(U|0h' pP3̌ n6uiFK4++{?Lh4ɄKRGB$Jq4ߐQESF4鑢evmO=8~IkIi/?5|PϫtyHΠD u_.O-⯮;uxLx )PȢJaGaE]gmԢg+%|j0(Uin,Y{ϲTgсY3$-٢f0 Ah!?97ccSz SHy.sdstg`KtQ22|88۵)/}mxJ03JdfNHj2SxX|2IckѴԯތ gkqg)њ§Lg$1 g9McbgLB֐[Puuf-IlY1[l^9Ձ>mo)š΂87}D/X༬3W }O|D|7)pԁ'XG_(ڬt.2-no[T,qY`%,[kVG::l Jk@gza%vAxP$İdr\ƩԭfO5+#r;Fpt<Ү0!ӊnUn掺W7f[ t2!R1rR8>euJhU|3Pl69]!4odSEY`>CI"] E!}FaTeK2pC&ݽtaX=]if菪lUP?~L) "js *a*dy ̱/2(aEr@=6W wlj֏~9{vGyT؟kA3Uȫ; ]UkU3Y:kThGȃ+ zkȧ5sw˨ph@v ͪǫYQ%׮=Wne[UBtqD7|W`,czFu6tKŞZSoWy^m9\e9N=yc}HN8O$ Xyy ޮr8> stream xَ6}B- kH)H4@M&iKZu>#RL{moPLs!~:{zyBYE*UvyJdZ*Bev9/?z,_O c ^|LV(!P38\:BBRUn@{ cm0à0>KFC~Y`hq@g8c* ; \ t/ϳH5p|c.yi9X:T(8s;eM[_QZI3J ZZQ%8ώOOI9:'|JPYczqh؇h6ރi" 麰qIYߌK/P5۰PbՉ0A+z |!Ofb}"|cl?Bd3 f)PF\nS{P[Cd'1-WE0>"`TMUUWs3Cx6ƈt Bb4f_G=q 570%^Cb( E r]yg!х{=Nj,~# c`;gW0(>7,A,!@ږKpZN#Ӷ1 E  <hq( :mmF,D@~SvV<7 DV)nE=w6>6m%y5L\%@}ic{Bd U[(F2vt6ܶcSjcJo69|>ՊtZLj٫x^_mn5*Dt:&k STkfyjd ގq-bd`&UߢM &X[=%ݷ &ߤq7]i|;CÜWQQqlM6:B!1no*˿rS-nvY ~W3$h l3t1gӧH7n vP7CC nkb J!@/:Kbomzƨ$mY!DžˊӸLe_qI|XAŖ =s`SN#Vl#l$QziWRъ(uTaiG:Aԕ\ 3%(,Cymȣ]KFXUWԼ2A1,aچXfhhxYѲ6>} O縈 [ܟȵp] Vqf4=ݦu@İJMxvG^qLyy?gsaڛд7m|Raa)KqyD4`/jj$)'kWdZrY\y2\7d2D;9L<$T-F,y6G(pk-ˎ;B\PL>9>}đFi "wvg?EFwe4W:hnm4ڃ4^^4vrV ts1F) z|=4l )aBe&2cΚV WvI2(V# `}kEl+%"-CDɎV$Jƭ;t]KTc*f-WFH&(rk,ܛяȃ?x놧I GO\%m[pH*tΏW><ܛ, &<ѹ y(:5Xo"as U@eB-> stream xڽZ[o~ׯRЈY^{hEqC}+I 9rW\]R\r83|3b8W׃+Va׷CmTjx=Xh?Sh㉔bTOD9AjaeFs ťɎ0{"kO_Ơ_hZ_ ݉n|.#|=񵃶eTTkAغvm^Q|oܐ6{~7nц]\ *ueVE'{)1Ը(G:o~eɸTm])eywCk*%Wl Y9khжz#g%|Inb|opD0j7M/"b;b.UˤN-liVJڿ*^֘̌ f̼ )˦zrBULVӁ^x ~wPR Ӆ%a:g"7b,  ]tU2VCI`J Z4@ V0u[3ELXx[:EKE&Neߒ0[-]'B;.C[URAj2L!Q `{tܩjϥFsfMz\":9/ `j{vx9Xw,&oy.ߋ,tcM)@&7@V>)T(9efVwL`w DnvhU0leꗝC~95[ꏻ?K͐O#,uMGLCyu/wicvw|$g;E'ې^љm=i$iR##ѫiA#B$ü:?܏[]|Ub>GϜeGO_}\'ѬҴ׃=h endstream endobj 284 0 obj << /Length 1486 /Filter /FlateDecode >> stream xYo6_!e2!)t@R`(Юcˎ;l%m')9nb{8ґɏq0/'/.d,׉.gL"Hf .}1f ?cQ$D+hO֣(I)4@v@fӊ z:q4FUHH܎yW<&%'?8z'PLWP8gRVϣH%5t tdCo̸*u3RR AplcEQha]}"1tfls5'-KAS EظkgkfF%0 ( -I0]sfF>;Sb>"d)2Zeh#Ԝ"r^B͇s_chP/L~,eY?뺟g}Y=()W4Y)ۣNӾ2NMrKB7m|lƲ,iw&)佷h}~I ǍOY wj ʈrV~˝ܺŹb6>S8Xۑ/CGH$}[|PzfD-퉊_iߕ DK,/=T 8hbäRb} G\XWS3fnH<7"G0EKcrע* sc5ZЅ:P )5WEC+(B6uz|> stream xYo9_DE';'Nwx(mӴ MH"ǻ6-xco><3_?F_h_T'Vp2z6~jhD)Y.?]'ҕНC<]]h5XB#NL0.8I1审!kh-wQ>wh h {h㉑ }e:sM7␀nh &(eDVChNiabj00,.qBzD } *W9zHbO`Pk]['B qL>ỉv”AKޝ|_^rJ/`=~L>:{7W]E6SO'{?_+UO?@la*VtQ;E+ZWw{p(>-'bCm0{a0/b e)Um(q<>;&ES!9q㼴ӂ9'ʼ>ҳʙOrvWĦ+(?o.wTo.NSN-'!x{p"2ۖWdEq}# Ư"oxsi(SOOr?A.{ yr8Ewb}mnr}v፛1Z|MH[eˉeF9esv~l`tS>-#8]iک]4z2z)rJ\]S5;G59y?byKμn `ϛ<\rLWzu_ DLS&i*U ]X,~0}*7(_k 6B,^} /vC%KC´it5N ]HSMYy@خ-{p^)cw)^,"v8e*M;*n.=uJ@h@"2-LT?մM5y,&PM!+fRIev5N3[3_Ĩ/ꌂ; .I<q+P ) 1Oýt=v*[>2{lѷ s$̳/B>lxCEŭφqߜ L\GW׍'m" Fyvl6􃮖tJy1vFR9%C  ,˹9G* 8 endstream endobj 292 0 obj << /Length 2413 /Filter /FlateDecode >> stream xZYo~VVk N2qł(Y%9"mdnI'@IvWW}u7x'om>*"b>J(-(il}uSu{61F53.Z/.:y-2$Mߜ'&Ydt1ik4{ 5\+ OLf`Μ$ڌ̀̐/R3Vy Q M$a3}6Is <[tu;&p3PЂhh~q牊#kUk'IJe08z!XW8 cxy 5S虀|\NeEϞkLV}&$QY j=ݧSx|?hkjL= Pk~"6p;R(a/ &ܗz%QH;PtWgQ>ahRo?n&1pᄝpHuSXBfNxjh^Uj}Co`C" .xa:3>z*NnYx_pAnWţ&ѝRJ׌>YJ90J|݈F8o#SMgK٪}t <_dj%hSb=0c__3 bHGmy._<Ou\.Z:5ڀ$Y?Ğc01*O9h|] ,/0%?R՗ Bw.'SfrͿB[!x\g.]U; M5cx-T0(7)t)^OY\̺#{Y&ܑ5,dM6y%9T9<,?hK+5G#kdVb3&=TA5`a-F=y|[xstC.jArƑCH+ ^uҲ "~ "wAqliKh[2<1WV1ma赼/Yxu~YE2CͲ-O"8͔}#En1 &Uډ6ĕ|%j|qFIJ}55,n)qUD6 Ѿ>@[u%XK%˲G_,ɮ;Q[Bf#yIUl8y*'vFQ%GxZ&r,MzY SM`vXBVAi^as,؆&@)9aXKdEKM0UøFBuS# %n|hȘ> GZ[w/Y")bT<1$&Lmi)߭%%5A0$ǃKʎ鲓'͘{O#8$${{:2扎`JOG\8A5>꺋O^Ph$Rʞp}'LFrVW٨pűTѝ U:MݠB5=ۃ7}_pr(|2 +%Ko$6{s0A[5tC9"V2NtѻNG倓pSPA7r_|A4@`Jė!OOڠ|hdOû?X!6!-tHvhÅ w6MqK"B̚V}!G.4խ_^zP|Fjᶣ<lVJP}_%::ۖoC.>Co=}v+]懀q?S3:*vI_&N/ ORwOS.}:I*Uh{hvDxi{+=.o |پns{^م;`z9~ fNΡ뷶;xoJ?p(>|XӫWBEh TuD{>+hJO.vg(*!g~894!J-Azm !$R*!dwLCTdVlGKzH{02u#.X˳c;[ VcH-8Ob >hQ{QY6B'm܏FG&Ql9k(PP ^P: t^У |QmwHWŶkNBxicD)v[<1?v}=-[8J;+?tP. 26CL?zuoiMC_Ky^wLV˼@H~{kԓء"!r^L߯=A3r#۵~-ߵfDl7x>ڜ endstream endobj 222 0 obj << /Type /ObjStm /N 100 /First 873 /Length 2135 /Filter /FlateDecode >> stream xZo7~߿BO4(R!?4$)л3uw}m8^_٬w8fP)f,@q RR(["6/ Кk bBxrF OqSj"t O& S 9+K[ȅ5dCB$paW 6Sā jf*T@1ĮfXz3@ɡ|kan]C =A16;:u?}Cp>_fݫ˷_gݣŻMnLݏXw<^F$N%ș#SQAa8: ݫ=[^InX~ _,9*9@5/qDDbےqvrS|PmmD-R7pnʭI@I5&߰~>S>P&j=&1a FĆIve6H#8 !n3IqLF0b$0䕘<{~I=?RӐ8|D&+5:xrf1LOD a*QA"ӭ{]'qbDaQɩRyNAbah` za$ .svQ a.CZ8m$,dLW w*V{MfgS(NL:]`QH46TiLf(qE'q䬂`#hl ^$mvֽeSRa<cAuo(M'~a};eJB ߐ}맞غGuhi|݋œ{ Ǜ89gcᕎrqyq/yɣa0!Bn ~MP#*z*W\u#U(6"ˌԋrK;sX3h5,ڡ: "` F4I@WF:CʾW]eKw< QA-$[*k6%?uD%F6~F/NF`#Jd]JՄrrs!"Z }Ub7hQCA~;TI_cbz=rGGݫwWo2^e_g}7`Sv+alAaP@F抖nc1dH 2;(`262_M(49Z㭼!{e 2 ⑨ްWZQ{EUǡ-H}-8My^)oYSWYSVYSX94uV$Ąz?*Ĵ'f6B $t}AQ>a";珳~ؿN|޽?{v?[TEyªNW|Eۭ*ןly\,5}ϗyY2;$CNZ(ْ|:Q#sF86Rr> * 6B߃OM_>;ˣxy0v SS@m:Zh(i49F6Wxջ]T eu{tƪt8^G) Z?i> stream xn6=_a `c3#^DRA`lk(q=$k+ Gs(Ѳ,˗` )߈$I'8JN2-t殓j31JDunF.ݟE/gn>tGn:u0zoo~(kNCpWBz~c_jR+D13<]գyLz*$,'"4.׷ϓ׶AN(º gY^<$82\iU$W)ܕ:}ӷS6pO5^'IF|hZWD_}gxIDuM>jɇ31f y85D-yV}('Emż'Ҧq/~ ƕp23b_.c'nrPL ~ɢ-`ȤWQ6H#̴!6 9]|:q<^}Z$[m7X5V"Y!H]~mwdp40}C+r1]0%SZI'xسq~E\ )hX&F~SAw~oԋw 8^SXG/a{Y_Z p+ Cv BF!ЧžVXQ⚈~( أ;{c*J'{ C28Mbig [<jSTe~Akm]F~8ٝa7Vam@.x2@v\_6e&e*.K5?,H4W~~x`bxtʑdC]!.O3c0%@‡'sU|Q")FLr-jȠIb4w8|Ltѧ.>`t:fe0XcT }WO+ړUM[OBHo Ԕ[<@|xZV~W%cq=YZpm͘K mLd>F B,u\k[ ЬLgB,;Aӧ3֝Qk^eHsed Q^0 ,/C^GUVqvkE/n1NJea= xPvɢHY{G.H)oE JU޶(_$*V$m>D=n}ې$_U ;ivPUMV_pM )׌#x~=D |mE,U]t=MQVQo ݔ):-PLjB/buTuSHnvS[یn*<$OM}#cǩC͊ݕ4Xeڡ 5|F??pm(5\Rdm 1%i: WԞh%T "hm˱nlsД^xLFncKlݺF(2@iE[hBijk{빞|FJ%lDq5$a)4O?荨1o^ endstream endobj 303 0 obj << /Length 1913 /Filter /FlateDecode >> stream xZo6_ad/60l}h:tk;bG%׮t(Dǻh>'GrN2i˸No/?FbxsЮGRr8[d9*Nrmq=e˒Y#@ &qR:(BiVZGJ=\t5<_ߐ*!Ek: b=2 W* }<*TK>#I3nxm|_C7a])D">"2b~c4`J&-JA3ShȌg*QKZШ"u #a2T&yh6*zR(=2ѐwag)ݰ`JJ 1q*t ~LU)_X]O ùWs?A~ZD8>zS4ܱۙ2\4cȈeF&~imfH\ VTr=lxM!jT?J?4 sqHOR\H} rېɟuV@;@ 04T5Z Ӭ[Щ?;Lķdacy?wcN+`^u 7 A< ѹZ8=Ksg\jLnLJ8Q58xwʟmD8C^)s "wH<Ïo=sρ*x NQqb n!Eq>g9(շ0_]c endstream endobj 307 0 obj << /Length 2128 /Filter /FlateDecode >> stream xY7~EZ5Q{ڪV(\A/ِlxHǻqfm7/ǼwG?ݺcJ;>ˬSL[ud K3m>*%'·rsfK aEo7Y0*rœ瞜ط}^rKzV6Eä `Θ@ɷ=PLSߞ8W4'[H tī-ygZ9ziM Ĉ&KSy+Pz\LDo"0F#ʆÓdAܠ)|,YCoz )YaBQ-aؤ˙lSnӥo/mzAVpՉGEy7zkiQ@8(~$(V:|_F9C'$[G%-pN __͟!/!xǨaJ(f=_ZrC1o'$ްLșUG&{ q9A >)L["UD^We%yOһltB>΂8$E/DIz"s)Dt FLI`tS,πi X(.gIS@P^rãQbav iמJS1-l3f)uJ2"tU;^v5Ư&B` `eMtG\/ !Аk82J~OB`GV(IKZТ)) lӷqAw{+\W!E!q 3fgYo ]O!Ҽ7`xf|z#>/roެ.qNYu(7n0&'a>!-[a{הK=="8Pq}*I⮨ E^˘2[̲c.BT\=ɩptqGduƳ7JjGynv&l_pv(1(Bt`oL:ev4!q !JhfEg_7ugU;818mE'R yKCɆ|Vbv8'+ۻzZ=Z"7&V{F,~M,0W[nC]1ea0]>ӐYmx4nb$uNCٸ {ȳArgwc5\eگ.;$0SR3b)EӐ j;^Cz+Fh<^XIr S%jz΄C,=[ pM3&UA;"w@Vר |^IR8mϛU}m=K0n쵷E4]x8L9>M^%Ͷ75ue#Zf؎\:ĔqC9GliܢOIVa+N|]%<ɡ3(s8K)#oe#Pz#ܞn~Yn,9V(d1Riz 3sNOGI]$2' 6 .oy8 T,*.!(Pۄ!s ac\'csꫯ,B_`F;kTf_ô=+Qgl1Q഼db6UxhCe8J.|CG)t_l: Ӓmu6*b\TQ&KP"G%JӲ*vW: dU`TuiTV2Q\Е q B?,b}*K]W"LNl{R:C*3ݾ֫ Z> stream xڭYmo_A\Q@N} ڢS\,ѶlQ;o\ɔ_@Z<;3eNώN^hTl(.2иAi_-c3\ 9;iW<,q r{kJ"pHГeIF y\ [> {.Ti d|W'ppFXScTS]4#w+w'w/RAk7pM | &{tL ~mѾ1-x.({r̤hX6"3ryѸ>eż}?m- :Enk@y%qGgt}$ _6 Ȟ戔[h1f{`5a#3`*E3p FTAJ8\I|8Y<Jg^'"֓M *V`ñ` 25q'ZpU@ CG^e~W y%3ҦA5(@ ::&VtBtfTɪrhgN fDKnZ:!(y' Z;,(c+796-c%XŸ7ǩ]d1J/ LMFnII]:#(Тi[HFK&76vv:[#Msؘ:Knj6a/(cg%I:y#X2 翈if pA'?ҧzu?n씙e?q.^6?qwƻGތsd5b,D{wq> stream xZoB@ F.ݠW@qFwMt!P쵬D:q}9c)n,;zV1ApjRLNXf\O/LqmjwY׬R 5>)hg'JG3\;G3Bg'Ƌ))\q,r%]SьL8/LVL*ס7:7ok_a > Bk*#ޡK)_/SMu0zab:H!R*VU|2g92f.Yōlbvn[B =|]ڹyoE a&ttaT,Y@ſ,XZb5BXbZܻ'傲1`^p[v4e:l\"DyŠ:Ԝ#\@;1{ tKB`SmFqDN?y $in2 ݅.0-`%[>buTȋQݖ֤Uf؊P.A{V↞4T [>r fi4zzMl dh/fՒ5"0KTvTEC% !&B 42dܶ9[@ã M,f yMd{ egSk__`"Խ5ɋ=ܾN4`n'(\;!>B'RˠbmDT! Op@X* Mt8oaH,z@p8QSmqA}L|L5>Qx<;ϣ~$n=nˍ_4K3 Kz@3!q4Į2g48#";'1bx .E~H KDվ11q1',S8RM58""!ĸX]jEƂ{YCM 1C ǝcúHD.7/LJ5O8,:Mu?#֠bxlHO \]㜽;3WSd'm !(;.$H wa'7S( dHnaf !0.aXĺKwI.AL_q;I|ܑPgC#k .Km7bEQGH"(P]; }K%霧Ѩ(@gQ"fI?FgrBc o|7I]ٰq-Cє1#l>[[ZkЎ dLԴ4kZ.bssT`ks_\M Xy%Yd-"˦T>܇B$kȥj&ɇY4 >ZPw2qQp @qΥeE#K>YSa XKؕ DQZ+{7(GDUY?GmZL ȸ!ef@"RчS#b)߱ 9,{ztڊO薮Kiِ:[lf?/$(!mȣ\=1&J2^6 '\ٗ>+9ݯp^k aմ\o_pPYo+G0x0` _.9wYrw%ٞD1{83ꪸ9Cw  /Bd(u8DqK+mxi]>ֱc";EYb%I6pG\[HcuKw6~E}pD4n(SUHd¸~_- uH{<~|)}d>d9#$Ek—jci8+Bei4q%愣uGr_}Ij"E/Zw > stream xi !(P YM8.д"l% DIݵ}{f8<-A|4.Ɠ$&HU:ZNTd&\-&?E>TSoᧄn:ZEthxzտ&&EH@Ad1#L% 0KD͚An,%즀w kp~{Jy-% Qwbh+{v,f_\/q*'a|_tJ"[WIXT2o$)XKbpĥ[ykotLWƩȌqH% daVܐ4&ofmE K̹ht{V0;G;2%=ta@޺667Y ;!s@\k&#\T;7%nln!{:[+KGva]L|P]8LS MoF4P&Z nZa%R-TQ3Qhm}6fn;ydcN|fy"SJN YVU0Gt󚳚;״g:I-[NDYҫ7Dy}㶽'd%JHn,$f>~CQ 3Gy7REjpdF[9T7@KU k IoXV4W+U:9̎; ].Ut<kSY'SxqD"Qwѝ%J70[H?vw X-j,G&~łyPi"WuCW\_)rSJ xZ{Agc=>y5V> JʒaTE[ѫ#Dms&?k'd"!_|@`2e,s{o,KRNwGEۜ2 e.${:0aY|[\ر oX.*Ynje޺=vϼb f2k%Ӱg!ݝG:ÐӜU!&#}d?UjO?2#\3cg)CSk鴜s$z`*-|֖09!JJz5FgS԰2j`fiIq.w5Tm7^& KSCa! JU9#%Ye*ӛ@yk2V wоNk#Zk(.Ȩz e~ ob$I5#Nsl(j@PMDGC(=UH3ݷeQCl 2@W~h(r -H0JIY6ٯ&^؍k#t,-cFwsZm)[ =sVJ%Qo)6yx}c+3GjOG |۸?7<yߨ5ݞhm$9Ww/mibeoIqk;Z$v-hKթ2[H~"}`V.M:)cbn7.( h+`jуg>pɜKݴ9r>9dENi(M,'㨽CZx8c/)P8Mc#Gģ`:t߹mKl|;8r$L*n[2S fG뱏D[Fl{c}I⊸twFRP60.-\yqnkG/ XAtY){kz!N/,Ew= p;OFmNsc#oB|K;%/H(O ő0$%J81GԤ#IENjA7@vJRqcӇ10c׵L*: endstream endobj 332 0 obj << /Length 2721 /Filter /FlateDecode >> stream xko8wqfH&CDY,lw絻(WA%r3hD7gM8h6}֞O"וy6_'iYy ,E'S&iXzAcTp >%̳TißsU}YpHz4R_R} E{n8k5 wU`-KvE ;黖q=bӪwLצ]1=Rӈ 5 H˼݉&S*ˈ ^ AqY8љ0U@BW̠i0(<طgxx/ 3 ߿"O68 T Y|Cqd}Bq'*DU^Ӳ]|Ǭ , Vr]yU";ZYEy{$ |,,_¢ߑzkR/XiPaA4-k G D}N< +]C a,RF[]0蒀 0D+)r/cʸf#|)r\q&E|IUƾFy)*Il7nuX _-kflv}]ۈt;!b=|^-f51 'ɿco>ZDzX$qwlrJiz=Q2%j= 2`T[#W"! (i4 ];\1<"iNT~Q qKT |-}'08+fHai,&};ԡ "slH}b9cCg]ϖ7% FZ#jB >r,C@[ hL Wk 7CI$?͛;r<& ?3g%jqZ?΄E;?#ߴ7Th. v굚' c"SԱch y&Ji1¾IKsW<#oeF4/{PY ';~14AyZ&*[#Q>H[Knﻏ@5/yӆc2Ȇ?Aұh[Atz^214&GQk2rD3,*$0Wp~3g[;Zw<,-7GGʚڸxckhȠ#ӵįv͟+!uizkG*X+1ڛ*ɇ`y|C#˴1k6=X[k֕sfDYFEInГiV)\0vR2`gE v IB}+Z&0=l3V%dy_~`XJr*˽םkS4jY$hIRA޻?96 aZo$2Uav ^Wq1gD;Gc=V#9]\D@xEyp.PB ם0ccMr)ٖT֢C2eАZ4ɾ[ϋ,@.43,"xuM'Dg%2umE̼AS1ӛ+VDC֚ ` wzQb/.%I􎉳"栌,^J pBV)Nl,uH5ǖVFRNĉg0p=tCi`AݣnB=bZrXC\p.O8su˹,2dkFn+(uCWM5]R>rW-*  gY/5 @l R ,ILJʅ%]uFXZ|v{mm"ZI茱{EcD1#›6U K=q(%.e);1zj;k .pk'ȥv` \Uii lw3e4(khqu#w}G]{hXĻpb>;UyTU:븒qLR'fg5Na!֝/zwHKMhdr LD< U2tֳAX>9-o#mS崌y[S7t+Gf\_# endstream endobj 336 0 obj << /Length 2249 /Filter /FlateDecode >> stream xZ[oF~PFB-ûI]>$A KFUJb{n3#Jv\`gΜwΜI~&~v70t/͙?7g/Ξ^F`M \-q%pFGH w+g v4`o`<+F aosS\ge D@ UA?oy˒ KH=<5+KRf&ɰa:UJUB⅖ 88ɘ@htIAo\ˁΠ%΅/-0r^Ʃ%O؋X{74>4b,pLF ,Ba LQr`m ź&ZJ=SY%>Ệo^.fK`vRoՌb {8_8L *$**OpE*C<{4 :HxSsމ$H3QyBθ~k \,4yEOUa Fht* 2D<ʔ6(^lԪB_&qN&`e%n:&g}G.>N&Ål? 7q1U;XR3r@vo+ֹ7A<|(e2w&l ,˽)@?-_*bk?kOb`U1PG1 ЌndՒXpIN!!!FA&f(tNLE=)L|$n@'6:׬ VjA [[~Z.J[ t)Vm]b5[A9 Tc e0g3 }`+j0&"f!Z /`#/2r/\*AH.U2#q+t&Bve?բsL)%ψXl*M诶R/+Ifd^{fY}e:^X,' Pz 1#7qU:uHa(ylfS}z<_ +\Y6Dk6㼭D+)E^&zw%"+&V)bjeZ!͉ +4 cRȯtÍ%`2%4:kF=Vɴ+ARURPq@MFAe^lBȖb" OQ'r-}Xb. mR i֩0D}fT9Sa(ݕS0zTxd*$MqK)-P{<l#yF|?89qCS@3bZ1ƒy˰CA8G>)l;^a8|?RD}+h\ \EЈ}Q5[sT)%]K-D9;&"ܣ%ft.& S^ SH sL=q5Gk |/o4.vPYιU]I[QuU>򢭤y(p)fsDF-I:s1ܿۘdokn{ko2'n"@i/tk\Y|? OجšeZX2"IGG}%NMHTd<>l-+SĘ zz!<*n@c'[+>na+UӨH0n[07٥y|o5֎k+{uH2hҺ% AOpNo,߿ J芲Jv#$=jTskQIxm7EOH~O_ŞP}g#t𽐒n Il5x+ΣK_B8RtvO{ێ^s%ف|<`+~c'i[a2}7*2}5jvq@IA-}\4{яKҟ?ȹHYɪ3kUIg>}A9o9 g5[im {Kb,ħqC1j~VՄԼ*,Z+l^(\'^.d!8`WҮA˱4HcPZ+V=Y]|AʏR@qdM/eL]ٵܝ6=~\./ 4帗,̻)N(64y,ThUq5;8~yIOsY;y3QGt3(͜rp:q#͊ r'^Eڪ. u1sVubXW#/*B J endstream endobj 341 0 obj << /Length 1794 /Filter /FlateDecode >> stream xY[6~_l:S3ݙ&M^IS>l2/&td˶1};GcXųţnhD$m_O1'kƕ&P3[`8l,k~~!=ʶlz/,KVv#%5_qB1D';GO#!`َRn\t-+gm/c L-n%pp 0R B.KԄoOMG z_QIZq'Gov=޲&87}`Y9`֧(j[b\E])rדA5R!V,#ȁ:}Ϭ *¬Nl*^Q5iwq sUSCGMl26Q\} e Ju*q-YgSB]9zNM˃<q8Em]*nX5EM<ÁY̎&x=tJKɜp"v?ZnO-w{ḪB0,O?rB H8b&>l5gfD_&b3']'1^\N]uWl^`EepKrM=N$ETsm8 2d87\xvQTMU7-z}Ma@,ߖoWE~!8γ c-~6X2_ּ6Eq. * cD5Ϊ{zzZ/u`m 8@PWj[Dlt< #0op+:sѢ]Z{ -x ^Z!ܡNվpg“ gv / |S㈿T^V9QV,b_M;K0`˽8"KlnѪZ*\RȰJD; BXePQ8Wy`6 3/E ,̰`=n88&ݽz9-K2x_NsBHDtk (4mj\AmBZ Q 1ͱxXo2\AI /BX7@Mm/'\8eHw NZc*xt_ar;ƨ7r`RMa+> stream xYmo6_! 5+% kHnX5 vbJJ%-q y86 UE(u&ʬSSzr{% ,$ڣd14gPr@b O_$}cU &3((J9Nc((WPB>_2#(, oF9N@8Lư\*U%:]'VTj'u&u.uu\$quNH61,M:-Xr^ºB4q!'3[6kI/cf-"#a_d^Jk -Xϩ0M!Xs]SC9Fsh>u&,''"R&Yok,~D00AҦ&nt\b f(yib:6~Enz3qyCsEAգJVXv3 ˶h$rYqm"ȁ2݆wzMuF+?K}3QEj o/^uՠ X4jl5&BHc7EcS.% :r)VJӪ駽/Fx~[(('sgN@y/*{##rEt/w-G"6a{v=0 w@]1krBBoe.=eM-Q*No>(0lt( PB ` k< NDYuMʥ tѸpѸz&;Lv#c',8*,~qٷ+-J?RʗJfF1mFYKI"O$R6c=[v'[堚18e&Eԯ[B_l|V,!dٲ}=TDN֬2,d\XV (Viԙ, 13SoebIL)E*8@5"aIaXE%hĽ hB{G%ohGulN{I-;t LfC=P#N"rvDJ2jw:'~J0ߌwx_P7$ڤm~F-CIꚇZyW4L`v ӖxOw3倃%IR;pJAϓܳ:޼G &v+ڥJzp"zL㥌L}e 2FvGRc}IboݾwTLswL?ZO-=a|l(]ɨz:q)_ڜр>T˾'_2V_Cl/ endstream endobj 349 0 obj << /Length 1885 /Filter /FlateDecode >> stream xYmo6_ad&cwEQönm}hBc@Q^۱3@sǻ .dprcLfST2|ʈ/7!MS)] SY2A4L'c辅6X_<y)Ia G ;z@pS#(Lk׊h=XX>ɀH,i$"˕[A!$yIxb6_R>ؑ<aJ bNR;>Ur_ԘAD&UːER󓩗~V ⥐ ֐b2s$Ha8aL{t$sDhrci[*,- +`+KoGz];n̬`9K+F=6Wh`3Q iٷj3Ou~aU_iF.dʇ"LR%:3{hSɸ>)&/$w;4y-gȾ}ydµ[k޶c9"pUHw|lb̑l zEҒzӆR)ՂޡQmԳ/=UNiEb|8z'~<뫍hxεzPX:-J)1b7l UlL֣>%^ `I% SB;.b&B7@ Ӵ{p spAL#EtP9Lg59'9.eEyHD!/>WB@Oz[H6'אtbfN:‰CwThI#mQGi6!dGBxBۧOXV|ل""eN\ļ$Br>bPv?VF 'J4M_FoK\o'PohLkPXᡱCR%֣NKn5c^J_:#=S8-RSHVs}nU>`N Q_|=vr#h?{ 'ֵeæ\gGWmC.aneB ]wpu}XWXG⑃uݾyuuCy{xpgwHQJDKz!~z _u]&Yf妎m /#4S?CXKqw xM09aKI"p,+|}JKYw!&h^X^AIX&>\ZbWE fMu*Z[ c9 Z컹}fK/p^(/g' v|] հ8%J[.q VԷ}qxvתozy4WuҦV5k6ZVEFóq.F #sq/f"]~ dBIFzfn眰LsO"o:rm+]@j CYkGj?mmHHLWXTLZc7tq3׆2Jd2JJC =\y2`H[ܐCj057%_4)ep)v[>ڙ ݣH»Ft/#AG3]1y*sl~B01&_=Gx`Hj4m M9țՈ31O,>Nkхs_WMe3_m%P|V#]3?՜XY'Gɡp\ _ʍ&Ll<ݽ#/U `&#'9 vگ{L @ۊeaؗ^ڦ\ω?MY_Y# epUl}ӛ9V0.*NR+;At܎!w;X8l~:ģӃv endstream endobj 353 0 obj << /Length 1784 /Filter /FlateDecode >> stream xY[o6~ϯ pT膦X1[mm(TRߏ<(Yr$hRwH,˽H\gGD"3R*EvffՅ)]υk797k\<ʤD+Xx\AEOI8XY I.’CG pb\W+ ǡ_|25R|4#R_njc>іGdff6J7V +pnǿYtk7n)+l\y+.9Tkl{v CWg5.sd}5-O N'(.3<,h𼜸rQ M sW~sY(]d  $"2 9^qMu[/X % kb]YᥣI%m'sZ֣~3gopUcvg }b~P6<,ȞbaxÌח_)iaks9_Fy ֭k¹!8lÄ%۲:2.*UNxDŽ7u7eJOwJ> y_M? #-h^WMjL[,a/1x+'Gw-#c%9'Fc 'p<۬mJ} ޥf=|6*;% v.=P܇UC6ywl*%)[i40vy8WX MB-X+5,E6O)NʤmE(NE G*AvR13`ö2EfcC(Ĥ@$F!dV*4\rLVUUnWq$l^#E$Pw;RwAhr[a1h;ǾV]q"W[zxkг|GDeqJ]܁wzF7us ǻu{t͍wϓ `$h}a"9& Qlۉ.?>xNP8/R "tpeRf/}7&{A-CF2*GW(H=F<.I%B2B2ܑ$'I'`I\h"Ih0|h|e("9EnZH3 CYj1YuM gI PWP4/(ayzƋ.xf(Pn>\>aI [U{~X%Qڦ ֩ |TH;EPA *,/l> stream xYmo6_adfc+KA`bövm}hAI]bg@ǣD*c%M}`$Ss/d <~ў*%+06̔r`a^ ]G|8??Q&~4eumzia  iG{F+fRp^+L産kP\R3a* +&=ơ@{ WMQ_Mbu?g8_JVs?OЖY⺦h֍LTِW,FeVJC6lI+%'2 K!ġz8%zoזwGտjlf5 P*)ʛx&z; 3"HX`=7swL}qۘSyH)d!{f]sm3IOj=fRٴu+% ,Gh7qb1V.AΕ +#n wDsށ\5;W|VF0,y_ۢ[lD*lIc5VgS,,>#O'?FkC2\C*v!/"'ޓ?G Jp+T12K88j֝]݈LlI! :S6sfzC.sA~ׅ`6/Nܩ $ Ӫ>mtėL f$]V֑'׾$ay8uaiMn`ʊO/\ɥNR0l$rR@<8KC~8crX_x؋ ŢUy/Ӧ2aHIJ6IPdXH*tS͈opC7tzni`\u$Jk"(<- ġ.8]A%f#L)O< ѭg;}7HLV/{k}7 c=tǛ䰰#0&.m>`4YVn=54^b @D/"CBиB}\AFn"k@Z ~-orM4B`ugศ 4Y4Eyٺ@gP˨Թʷ -;/e;q?Pt1{G oΛVw/EΊUSNOA=ut-Y ,mV4KAd%[7Ϯ^<Z endstream endobj 362 0 obj << /Length 1867 /Filter /FlateDecode >> stream xn6=_`3+RHZŚbðm=EJԗRwL˒4=Т(xN$M<9:U69:NHur4M^*rpejP.a>Y G 0XT÷G&:υ5Pp e0QEn pdT6XԒ#7I' c;ފG&0V0D0>{ȏ`O,EĥH:Qd5oIHy(~ކC=-AȊ$P˼>-dojy7_ hnuͼ$Uq?Nf{df/T;Q;uoA= }BP ~Q`Y;fZ#̷3YHhZ[x}:zGFG K Muj6 d9(YBfU/|zpU\.6j8 ]/80wš.5aG% 5t HK'A\WcL7̬,\]o8@%Mg.VF& ){?[Y"#JmޔW肛B!x(;:RF(#e>LpTH}0]yT чm~ >bvbDђ1g9;19CFsS Cv?I A঄Zի~cv+~H6ںb֯BAUA=@hRT *ګK=@̽ǽT}^ gm6(#j)R%0` PR47( \E\X&_Phgh'rDjue{𩳽g ᜊStVl%uؒ2,w,sWn`ޤ؃keurRV5)5E8?߫PNJjd mɟl7TWTQ\Rvquk~xcPK4.$Ma<㢺S;[́.B$ 0j_ǝ;4xuLb L8M LueX5=P21n!X.lmɛ .Y7Mh8w)%]Q" U[7T8=*@BFhz[ײNBtӐ;}髥t? p=9ew<ʇo'MCù@Oս79>e,s~ѵ,ƔnF6MSn7_~] \窫 (s]am `+ '' endstream endobj 366 0 obj << /Length 1569 /Filter /FlateDecode >> stream xYmo6_at 7 ۀh:  l!-6Q6JJev\7 ix;swdh1GϧGώM:,Vhz>0(1q(hz6: ^cTgzAW7굈 DZOОة0\<_B گ[j+#FJU ZV&G|Nѧ_-;}=c=KhWҦqzO5) g2n8TMiqAF;W.Kr j%dKkҽ#u%n첢$\v̂<Ý;+o *Qa|po0$2̢h~>{CTЛAf.6LQ0W[G\Q8ˢ[@n3Q;yDp[YͺiH+[,;6WrAb+'Rku|W$ݭ6bQ_|7ps A~ŧ‚ypã>f=C)} d~sk6Q$e6o9bI]$;ܴ~QpxMWlиaOnܛΡ2^+/pzP  (5zQc$'Rd]b^p/~ww|f4N [ $4zϸW;!E&%u5Oe0FpV-7-yN!PP0;_J)&q[Aꄩ]A1H]rau"d(w; n`p5`{4CuɆCQ?^$+G*<9WfS9Uxc9<1^M+8CKe,ioYDeǝwX@y~bZbS:_9J1mG{43Cnb;hф"}AGYu&ݬE1`W^|fg*|lIؿ}g|o1i6bV+$QbB•5Jmjsu89?&`'vXk$vz(}´]?}B7PpmKZ#%*z̄ӀiV5sހ5>`װ,1sn$޻ ܋sz,9t^= iۯSq(v 8"xn/G # endstream endobj 370 0 obj << /Length 2324 /Filter /FlateDecode >> stream xڽYYo6~] 5nl=bLY[nN_ےɯߺ(U궓M,:Xl ;{q4L׃$S 8xp1|ߕ[Om?+0-aa8T.9OG^ 8I2uQS{-/NT懡/^d O -f= 7N(& ~Iy!ww1w w) a[JjZ!F&w<1owcx8N^5LsWEaͳ KSRP soY.uB&K(OΗO܍@ ߿l,Vܼ1&I/i`CUJ" A՝`DLj,L\L7!DɗJ䮾ըP$ 7qt2GJ8Gy8:v5AE6-& lrb!AMn)I^[<;Q,HС_MA(YQOED;\lE-]IJ/Ўd(c߆ɦjePZ/Y@Οs?v* v|EX}#;\kԍ" egȃc\kJ^@If5Z+Lqrc\ܚ0YķI唌qs.J|[V-zrQܬax9Q3OW7{^(m:/yP~! y`%3A]Whx7(-Jcj"9qÔ3q`Q#J_H"'%M lbY* ^>8̱ʀ.d< :\H6eBnylϚ5M %y[ @J6n]4c7;@C|D|24=k[,9gf$)[hr-ήtDN\o3gd($+M j){a54g홎,Dz]uc?Jx7w%έ Hy~Y6rP9o $H4Ȳ[."^ Q %pc;ώҔ,q} S^~ULGCcub:nB}my[wt=~pOU ֏l)XEDlhȩ)k5Hh<+p{Qkm0} ưn[r>-< VTޏ |Q4 A`QF\hk3=]?cw P=*hCelu$Շ&qQAa0_i23CI#K҅O9-rJž ׅ4w҄61*_ neq /gH/^ރo$Ln!4$Kw)'_N"N 3q#}?nJ@EgLIo=B v0#Dz\xVsY?^t 82tHJYC>Fz퇎 E47"ǥͭ3 N]1OEuT9PNi-3M.dI~,㉺}^n 0T*uj-bqtY5A$Ǻѕu4睢a<]L1VǶ4bs5w#WR&LdžY|GHϰd?ǜ(]e[þRrvt`.:GH+Ow(W\zo$Հ~.KrQZd]w t}Qzt dla%WW`Trol I ]Zє)F~`4@:7f]RUW׺iKUp_sٳ6{-ưpe{FCz?OH ܺuv}͔eB{ɇr*fBlta߲ys^FWOUܮliv?/KES endstream endobj 375 0 obj << /Length 268 /Filter /FlateDecode >> stream x]OK1)&d\+VE=kIڥf޼:XnwY,Pm@?A"K!G.BW/y`޴A jpjZqlzџC,R,sL!֔;"=LGoYJGvrywl endstream endobj 378 0 obj << /Length 119 /Filter /FlateDecode >> stream x313T0P02Q02W06U05RH1*24PA#STr.'~PKW4K)YKE!P EoB@ a'W $o&| endstream endobj 382 0 obj << /Length 104 /Filter /FlateDecode >> stream x313T0P04W0#S#CB.)T&9ɓK?\K(̥PRTʥ`ȥm``P73`v(PՓ+ L5* endstream endobj 383 0 obj << /Length 122 /Filter /FlateDecode >> stream x-ɱA($ \vTSHB $:@\#Q_TQUE&MG-nu8M [Yð,ΐV]'v=WN;S3uz3x:cE_ endstream endobj 388 0 obj << /Length 149 /Filter /FlateDecode >> stream x3135R0P0Bc3csCB.c46K$r9yr+p{E=}JJS ]  b<]00 @0?`d=0s@f d'n.WO@.sud endstream endobj 296 0 obj << /Type /ObjStm /N 100 /First 880 /Length 2155 /Filter /FlateDecode >> stream xZo7~_KrC`s=Iמ$BSɐC7\^yRآp8gBgȡ/ ɐx >MbR11P8o$)\6%D)R0w)߱/ئD8tMh0 :&*OUX\)M k)ttu`t"P&^;ل(4"Cބ3:*U|ł!5:V$.!'1::HT4'W>NMJ;8bWB v;0fC0v`0pХ&Eb0 Ky%`ЁY g@u*KxEU1XWP1>QU'EVHGuDOH:U@$X J,Aí@o8I`\,ODπ#-PŠhRT;doײ Ruѽv0O9 3<  fBdRYAHɺ!QrNjOֈ(l\svf X1#y`!Qݲ{dN}| Iz5{3ߘK4olt)sL9d/77պ|Ҽ߬n׳M:jў0 S Irvysݮٟye6[3/Y_WєbcԒ{+ s*/XxB[ۏ['~9wZa11eir λN;d I- {X@ Y=ޣǹfǨ/ͳr/ٯߏĭtbۤ9_*676;U]f!Zp0$NbSճ;^ޮ wmV$sf8I)֓զ*<;;;4fjټi~\i~]flZ}s~o㼽7WmZ,}]}90gZ-6 /%m"Wx2ZOE ʎ@H)H9H>aB4Vxw'IAO{ix8/G@UeS*{2,oZBt_I-pXyzW̧|RpY d(ZgK>&㝙`8ޝ& kDFck.GMo?{ M5szNlN ?iGu^o}k(7~T=vW#ʹzb}y]*懶M}Zj|_߫%U7 6B.,w+:wuJRHW'*W^q<˝gO+v]6WwPi-oV"SOhhXP ZECrdߎhk{]Kg@]E{7˜l1"Q~mG`'8"y;y?է{``կiKӢy0W%} ^fMW(I WHP o nLCw{Emڶeu^+)2IP<ȝ|zRޔ*El1c. W"iW .ꓮlyՊީB>(>z IQ rq}ťJ +"R5:e~m(7"_?'|Eh#h6#mK"5ŸG)l_\ դ/T+E$=v< Q=zzi@^HJ[ۺ_ǡ~QvYkjV;bDEv] =>R2M9gÊW iV1 wgG"z]YߧzU> stream xڌeTs%-N!vrX+Ԯt7dJ"f&@I{WFV&>+ RRb`3$7v;dlV.>Vn> Vfy&=R?4V^^n"v@g+Sc{%hjl Pu0z KWWG>ff&c;&g !Z%@tvJ`l79&J?G@H`ke wٛ ~@h? XoccSS;Gc{/+{ -()07KdonleklR;xc22t1urtuar+K܀ -ao&`gwuA+>q+g)^7673+37Gfu{+'7@"2 +Xij#CֿĠ<|T~V@/cw "VV+hae;H 4BV_?33{[7YFLALCߤ=u0\.^.:Moá,@o&l-@c =NS?wo-1IA_t@ ZyЪ_UM?-4r2Ơe <#/?b+I+OvlJ.V]@F63ڀ.P>Y%MD6N. h89>5z=f&{W rqE̢7Y70Ff7 Y7b0KFlf߈4ȿob@| O_S@|ʿO7FfĮ5~#P"^2"3sm_ݿ6vmR20q66]sGϾk?<"N-h+Kbg;wlmERΝ@P|a5 濽4̭pױ۟ $s^*t,'*%  TIp c>U@w/o*N/{Ю.⏐@A>be%zoA!Pw9@uu#1go7:9LlI(=+(8B@?* Rwm @ 0Z:Pq= ?\\L,g@P9=+?b`zܦnΠ?r@O)ꒃ)uChCݛ)B-DM9!G-OjҸP.<$xxD h7,ftSO8KXb^dwڔBb:ߏaI* hyq(J+,XG#>R cVwc-. "s,K!64!.e{ CqtkU9$w8qɥI[8E}GP% kxsbK޹姣\41z&(>+˼[ь8io=ÿ{M"f]X]+twe Vq•DƺPd8 2wMXƠ8NΛm.?NDb^746ą2Н*;^ APj1')^ށ82]~Q!ȅǖy.:}ݤL^}d&Êki$ܮ()n}Y=L We,NX]K0J'TJUܠDU 7HBjMkuai'Cq3?3c-)"D>D@ӊG% i&w5/q2J[4qJk/eg MPN~Hʷ9 |y̒j>y-p2ٞK{١׿ѥ>v cQdBz_7zj8븩$)xF&䳮n0^БAK +IˤxZ{e,%wc2d,F|TͰ*^bU[̸jǦ`]hfj$*s d@6v6pKuv=ȽV&r0V82-{;Y%=:qS FPH.y.1]Ik0fg!_GhJ=LpI Jx7`I&k}WK"q ^r\c!^y y>W+Ϫg (KFP+bjh6,>(Cz,!vKt8,j{Ȕ޷H5I۽ˢB3:%ȶVdQ\?}tߔ ߌ,v5q%̙3y.GJ:iWwԍ/*ȵ X@{+arEևl1.1dUØ st։{.O>Aӎ-y`& uM އ>> !r%wQW%lpd-T1A}_eK nyXך/gWg2Hr'{s⯅SkzLxV$v(V¨\n%av-~- "sezOcwZ=iAGB/ ')H6ߌjȎ>X>oP.?d) CaS%?J@녙bbo&z޷hkňUTh>YfB-EKFcH\J]35kex;r[1jqٵńq}__Օg%a}O,WwY -m\=c"~iǁ=@*=}ЅOSy^2@HvH yWGNȊTؖ q z3Gz7Ub61..c>IڐcrrpS-FPωڤ7]2f0at#]V y͹|R)Ӥ\64-4w5?zqS5RpinEYT1=R8тA="`{Uټae(GTW̙P,uZ~%Jc/saF"N/ObcЬr Zҏ/Np'j&ؤ D!N(Yx* wf̝r3WencW_G>τsD& 2HPL쾎 {jUOo+>ķ5_-S=_'/uQ >@!de nVh$—kBC{uM\w}69@LIX{ _"<G%/sF9On8'URҕ3.*e"!;ZOjՇFrluŽ@:34'Gt\c=3=`kAU僖V+tpiai*ԧX K!Zd=(A.D74[g:aN)rtK. >XjWZK9r?Լn+G?ñEUfC-ո,3<}3Hu|*9!ieJax{B[vr~?VTL˷K߮"1#aY@i['DH4܂$W̗jҘ&w,ł؇ņte`/jK/օݷl"O ;/1&7[ Z:ܬ֦j[?muW.rEkh?HbgAvT&m[Obqm}K[6}edc3۹-ئ@qK\ a|U1|m\ʽnۑx+wú1'?ϘϤyjX35)2ܘkBXX{9^` GFM#{5Th[0=ҵU 2s-Z˭TmqqJ|Z{vseu%\^Ƞ *eBC<=:K^%!l 'ebIl7%r> fQhz`!7FwBpX`MoN1%\zζW|~.L%91Ի\&A{uˬJ$osvWz u[cW.CHʴ 4:4h#Z\`_ݚWTZ<0mk(0`Ug'9W;;VYfRlF\ >WЙ%G2WSʘDZСfճc :FRZX-lS U^28hc!1U,#=I3Aq3b:#5_Xt !ޕ{hj`J0uKi (:hs炂W,u:w 7/U6ך`+nY!`v$>eIeEH&=.{ڠe'm[uB0֙KU4|j͞B`*xX'&ch{RDFv_^'./,tba-f|C(E]X\c:67HbޜD|Ume3!>֬oo&Qp)a,Kb>LR?2Դp+BͭU&o8Xz>n>%lKKW+m}= Cir`ϗ F%Ź~'ܹu~#A!p*x;R PgD:c#R^5ll!zҁ J3i9D2(g/SE&ޓ{\<>q{e۶.rrҌ/6(OweLdt"*WoQjbd p 䲦EADU@}vv3.3zsuq>ߍ ZHg<y$W8 pcD8|~s]@\ l#8'A7 qP%~qkc|q/3Ϭ9%{m>R:UӓDN1nރ+XZ E%hCRibDH Z2v$-栞õ^<ܔHQArFNI"[5{1`{\=yh_(8P"ppH +=E jeo4XHlf!a%-”Ez^KR%YI&(lIԫ frDXD)~sȋCJ.64-\Iv4ٌ:]GQ#6x-NyKbaݷKx*Uo,ʲ/+_u&)vvib,)}x;ߊ_٠#}*o8ܑE1NE!S̡}Rsޑ==yH"0n7dkZ,/r4fwl 9 XlCU %݄h[{oxO<'>1SĻ0Z= ]('X3" ~Ȓ<9sA7.'MZS%lxEϴ7YH{eW 0"=ZUhqZu') ₞Q9c¤c%̓<үrHHuC#D k5ώ'v\5)&՟.D}mqꕲg7. k?aa괇LU[=יE茦rիQ_ukׇ̐Tc3ݭ]w5:f{0kf}WmKcQ)2(-9wj3;RUܳTqԓ@~wx*Z !Cԣ:K=?GRqpňUQy=Ҍp҅[W WIȝw<]r:t^\Z76ŔҺ u7W12(zFw8EԞ~ (is4qZ~7A7Bm@ķ:~ 㱇b#:pZ (E˥ύ]bp6(17ˏ9\ BJ?F{K3cIqI/'я+栺/ rN{24F)p.G`8ZsԜ^QHm 8 ԺĞ譫N aHkǙQs{ZR5Oi}6, wG  Z\@JhXLxlFm a1f Ɨs0T bC(*3 nыKmؽ)Eڋ*噀0˴VzzLЪ`V/[.fkn3n$9 tSΝX7$Zj㦒Fc{nrfxy_ uWRe ${HHXQMIbV P.%v(}n˥ޕs2әZ!tFYHW2"xu ;'kt w9FK#<=똓ߪӠBGϑg_P+pIN2Qր"ywEd/]/V7RdAMY}Ty;B݃krjAP Z7[wmX?}xX@2Hψ!<]kXڱE[ k21͖$9!$:YwڹޡE:]Tyl*=x65h$:̒pgz]WjH]GBVfR}+6 ӱY鞊z e?QS "aD)a:W<ժQY+2[G zm) ^ʞhsUf^ #zcz5-:ނRSY>}DHyaS4r~>t/C<67] "Go,H:ؒ8o*}#($)W\_Qi%\5]з;x#_ᕍj$ohSºKˬ ݘpq)XOH( ,A!htEI,7."d8g%Z%tfB91Vڽeg_"NCkJ{USO輩~wub+? U{G(C>2|hcŸKwD4!5k;)db ͤ]`y2vr lH4`)F. HKuVS+rR-wzH}}XrGnL0q2n} ↞BxVkN$|gF2mY\Oϴ [I&^e*HqCbJ>$cѿr T_y ᖸIoN.7YڠĘ"'v8=ʒ*{/u4eV~x$О XdKu<=Nw%#@cGˣկEDehvjsGQ_sk7ϰ]]ɰx 4ʈ`w {T;UIlC_;vp!PGwGM+/I/N?'2C͞X~dСz72J_B[Yno|n M~Z67|p#0ft ʇWꀕŽClh;iqЖOB~l̈s˓%yӪ*z)uVz!_!egPoQ2;elHWp3 n.½?# 9\z'?SPf/hHTDmt?mY +Ooz*\MO;_rI~.ɤ~L@\TpGb(Vmmn-jB̐Hv޾ö{R1GUOa̕n9&|'o$z@ N=谽Oί2ExRO<ӓ@ώ4"[3?|7읅I\ \#݀=־aBge;xx)аގ5lDh"(Nt-j} _͎qvsF5_LN`u>}8œNua\څHR}6U$e %PS뮙6FPg}{gܲĻ22BuΈxAzn^j"/"61xd;o~ԡ;ސs%aVV\kSTGjNXE,NvhޠH.殾bn 2*gDK*L@=/Ļ)&OIFER@4w h 7*6}E)s;5>1U y*d o+utImh۸Ab2NeF2Hf>aNzN'*HEϦ+&eL /RG&d'`[OA:PN#qO*YI؜ qx|}gW!~os1惤]?eX<QQV(R^g C4FT"'ɚ ķ7N^2rHشewgơp@ >:$e Tk}DAXp]Ǻ;~UlS8Tg!k(ٟC<_ji F%3_/aŚI&uJo%yWbHZwT^(L)C|&.:wޞ h=,eGv? ʿ>ƻ9  SVA $ %U.(M6ZVQ ƙV"xCVCbxSV0z҆lQ$sc})E~Tŷ*bP$ {`'dXgKyv!p{&YJI[@!K/%gzX냲5v_`yL0=ƣ>4о1Cl8%7ЃJ z" -3/68ID+#WQlQCH2-؆Zt^<$)`g:[MP;W.KPBu0oAD5U3a c Pb5Jt LOѸ\kSZ00դ=R|v߼udB"zr0fMC %AUgBKMD:!/ⶦ, @0Ͱ✦~bbWU[iYHZgAd [֓cQybUKai`Sr~j9T "6PiCmوv&r4 2!49RZ|'򫟛dpnɖCl.S? .=j4;Dz\($]!Ӫe*\[,> ߊ.r3Rj/wqMbKJĶKw5ڡFB'nl="גRO6)&̨%Vmy稉حf6} V_T)EI6bM^a‰k<.myse' ǧj;k :f 0otp,k՞_^nRYQx5'݌0c(NCF"I?ѳJ>0e!@ӏQ >g}sn `4XDUn]h´8tÛAgQTL6R " yE3&s~/HmIdw9>.콤4}ҷnҘ4xy5yU]jZ}nMN"a /":oںle8}Rs?E_T͉fm ӄƗj Ҵ(];^nf-C)`Sk+}vC= o4%X`tT/9U]ޑ`=ɠ笲-MTF٧%h ^/ D,6L#NyAq\诮Tp ׈ǧiB0F%rMHQ%و+n兝%l^%z*7q6o6B(t S=Ņf^-S^M:"pQ_1:SOUl9Zj$?tNYM RvڥV3ejSߪ)!ќe|23~ivwI [3ıNbzjZu)!Ҷ '#j[hh*};cp\_mu_goCh|iLr5}ͩ;ON8%H[^3y ϳ/$]oq'&|U[-fh&DLV:EP`Χ0}vM/;޽$`ZAM!Q35[$g{*ݢ!qyJr3< :LnF!UTXMY-m7\/"d/۔ %R׮uY7Dn =%n6O ;C;ZrT/v%s :(HJ/:o$+K15seX0NXg-D|cn@5*P_Y+ńk١C:D62rT3Qz#]>Q] uA yu(o(E}F/a-`s0 gQr5FFvՐO}9H?. !6Yˑ|8f?֒[(tV5FW0 `bzu%~Q ɐ."?Z>z]yy7v+$D2qՂU{$tkWET.&o>RTc/ p9P\WDBphr ?3]ySÃ\|!}1u-$Bs5%teYÕyvWdD١&-՟1/+[R\O(UO LVNj Ce̝,UTj *F{Ѡ̿Hhdg:y XqVʼnB1=Yg6 8+3;7I^GȲá-S[w:k$DЩz*n{ Jhaa7qBD]Ξo7\8d/$*%2rux+%u.:bKI/;_0Pi-H(}ꊏ3)B@𑑩ujF n(lR4㑎:\_dt/7_11]U 6` >3 ;fhV'Eȼ SJ^3륄mxIUU2"tsۈ<8WAփYzkx>akQkxkx@zF2x2U!Eںji  iԍ?n[J 45)bC OZ*aY7nzTs= {c_x/59~EO*o0p(cؔ%|M~ค,>MO!yЛʏ-k)覕,_RGnchg^&CǃLtD]|a&(/xQzQ`*dY\-s[GK.~m1i; U2Fil$2TE $g8GI2Nw 'L;֜|]66?i7"C$;0lm`"}>T>- `1<̹%y;j(lɩ&OP ~;6F= S 3J˂Z Z!g./4Ǜ on "PJl2 ȶ%OyZY{hNe+4yai%'}O bpz`e^U(F1v+*0$̦ M1UT5;lĶk8FI#|ά0vVmNO^K+bhlد9TSH ege>X!rQ7L:0:v@*߁>_ d{Q,Jcֈ.!MgAD퓧笥n&Z4MxAI}Vnٺc?6^e+m6!Sl_yéN1X\;MH Qo3VۭQH '^pz>ʜ>6%1I7aӱfIkM;D4(#TL1m|+5*2=>D=YD 7"'9;5vz#QYɴAp~ф'׉>my:WE) FB́oDaCy(|R4ai71-ZFDr.$Yr=$&g]Uxx=*,Mw#}ӯIȟV!`Pbش++)@!+` {L_x&~cu 1L07ھw^J@w6|iz0y+lC<s# Z/]:;6@G%K"Ö\;$e.swfw5R ժdd`C#6v_bd\ٵaY[yxJ^>xB#6IUWs b"]MYo}(s椬=|_R:vR]bؗY,-oىmza+՚7<웇N_@rF ) Od$s0US!#{sVxWG~r1XrRo=4}&~Yx<2ſ4gTClW}n Vew-V?M9z pw mb&!d1zq61 X50@$tgȎ f q3jS(P# Gݩ/DVF)rn+, yhp6Ѥmq ƅR;D!?|ρP*cوhi# &a7 #P9) Tƞ^+CH]T%0i5 zL-)W endstream endobj 403 0 obj << /Length1 2605 /Length2 13814 /Length3 0 /Length 15275 /Filter /FlateDecode >> stream xڍT  twtw0%%Ht -Rtww g{[kX yJU qK9Pf`eH*ihpٹX9Qhh4mQhn '?,$]f`L 1T9\^A>Avv'; A)3[K+@tC9{Zۀ!<`p1wZ96@G@da {' ,j re`xڂm@7d#XQh6n+4@V`O3W "p:A\ܝ,;@CN tXof?pr_lr69:9y:YlEV`d 70u03@F\ `,\mnnjdfi'KI# +?)[Wl ?dedi Kwg6-'[w?6o5 aggg]@/ _Đ|A+H@?[+ vu/BXZ@k['!b2W[/;d8~d0KoF&O*%$@^_^ ';@@@#o圬@k4ux\  :ߐ oE_z fX@ 9 %@{VZں;_ r"N6M hj {7Hx['*t@׿ch ?׷ h2? rW#Nɲ=QDL="ajYI4:W61n˰+3p%Y6 %ݷ)qqe5Db=Η}Fijg@3͵[SmW_(L&LjgDQRbkiAl;ܭۻH$ɒE!A)UXV:J{:ґ| hG5h7qK#w3[+7aE\d^J?9(%0 {YeŢ'$8^v;Hs/W&R}C VV.i&̡W-L} 軽7xɰ_RSKso}ȭB7_V1J U?^]pB$@e}110*k;U.n }S~'I 4L@!OL]]CV%E!c `$c`Ms/Ψ7kS,Ҷ;5͟RgeBS~8h1ui8#88@dajܘ_s4[ TsR:x.E51Nqce Cd_7rQ=2SesE}%=~24~O/~KW4`%8Đ'tgN5q^v9V bR5>q+Q$ĪmE;#naSdA)4c,+eXBIzکWfdoؗP.'~f[EH^qxQkhvsFaK΍y=Nǥ=Q ֙0KJűXWj|: a\@ڊ# qKkCE#GA*:Yr*]ûEMÇzdZo 5Q?M"$76Ba*Xx~1MOJ&9ט>a2=s#&-A~]8zx+SkaV% 4OW@] Eh$l7**Ŋ "0Ҵ<‡U[Q- ImS.K?oa8])_: Ě?`lN<ɤ/%^SӺpR=yl_2k''g\cK+@lo!"x!0)G(W<1J䙧 IT{rW+ئ0}I>'|Cr+r`'ݏ%i[Da%KqtT C!źԴ'qNQPlˎI? aĹ֜6ʽ)5o٨̦#wf.۶Eٛd"kG p;=ZRn`f;ԉ^tHzC;|K6ɮSƽ976zIP@YCY/wj+}s育^u!82˖O|91C6>(Kw/Cαzyž+f4bIWdz'޸Zb:EV;X7bzl u"خ'='nzbS%ĥZA%ےqKEE>B64G;Q#[NB:޴&~$B|2(yB!׷n< ?=\,ɳ eclJ ff0WLs:hx&w_gN詏Hpng7u1]Ƥ+PL$޼`vKΠDB5+T*'?O-kBnE u?|S'ei@HPS}Y\T wqDvbz)GX)y x^)LeFWb0 cvQ,/. ܭ/cB봻W,^NMLd1xyZt 7|+"7%6mxW``MҔF6-ۈp1 Cேb Xe2y5칥^I2ɂr>^ myNUjj! ǠMCKd)>L漸>ɥ]6^zW+uqVN2RӓnnmATЫ05.|AZ=0=[1op0QP1L(]RT<u|)!4%&HZKCy"У qmuto-Mhnk12M2{eFW_8T}̿Ēƌ|O4poCڋG,}ûf|cK#P}߻X{5!!Q^8>k_cNd/c5/9t j7;x8@]WwVoY*Gzp60U̟#բEsګY?>JKᦁ!'1+vO) )sfŞ60tW@-)e]DD2$14֤"a1LQ}r5` `4Gj;z퐦x()l_a:)$j܈F0an3zn`ݛ Xr+%ُ-׳߸Mz0/u_UANQ؝P Tf`}u i=GUx!wƞF+GH);*KP6b!NېẮlT)aWB[}0x)!('|t~[K:?V*΄⊇YRDq6BFAZFôU,A5;fiRbi -^q.9mLF۾Q錘XW8̨l*A}tp mNVty(l =Ԕ$0$ӪiDr]#C3h(`wnz wBUa3RmU3/O{O.?OXtA'7B]U(~?lt}yk/wG$WYc geQL[U:ھjff* \E%P(eFY FtvEArzh*w$b8i b* n 9tJvjpks$65n'I] ! ϪU'"T 乮Vͦ݊.؟/-t~*H gG 424wܾ[_9qtz`!K9砼C)[I~ GX*G <H'4Wlq}l 3ʻ?nyN}]=RgUɨ~޽-E>w{&˨ujs*rp'₽n/XD$2k=qԯ0.e: o@K?_ (rC)+^;v.Ք@i&zoo&X9 !&MMmA!XS2 abhyH$v}D)T!>|efk.Nⓣi9 TFwZ{ӹЍOb䏼"Qۧ)R5.o\u|A#UҰcl2~yňt 7S_蟒"}o\&I2; B2AbUr$98;FH$HhN&иMYzh*twu{6ݚE6\О^ p/013 Ԟsy_q mD3z&]312/6*)`oF<gZwȳm-otV4O\‚ߕaI|Qrwi.CFi+/jaӇOݥ+BA ]£(jle$<*74Hд} ш^BW~)&YrcWrr]%ĐXx(Gk`^ܹܼ yx`:;rC./QyG2,7*8 ғ$ )/d) ҒcL{φg:ڢݔƓ? {`9Q,&o: d%0齎JnS#k'lk\ڭʸN[y'Y+&{D[j gnFSЈݕ"(K0lɃ!z +ک(̃u.z&o>% _T{ۥ򾴁5D<\#n=),͠r^٭_Un mn_V=LE]=y0eCzڪnk=B4b`H2mϪyAP"v_G|-̣faXsģS}?N"GwOYڗ3P/wY~f2U <_o&[4#]_FMC@u#Pd,5^7թV9+P>UY$MKyqmfOb^>X2Q|Џ%& %]"BKE=> p[g nGL{B6{:XWX[$W?VwqUΆbwƤnn#sG*WgmQX-Eh j*y-}^CAX 0WU~-6 \tFMƉK8–Gv PFgp }m-hRt$+"YRʭI\4R.ހQ^zC>;-Jͮ8{4"OYthEKP7,l %_ 3Yn#!ķS(#IamNRq`msqJ?U3pߴ U?_=V&e*QPP*5q\;&mA>N֌_7dVⓠf1 IT58ݒ"2`h!!z#W 2!b͎Iư7CW mTTn,ws*m9H,]j17;`33f}FR z(@h48aq" 5 v }#Ԋj3RLId]*?RoQ>ۚ nTl}^9v} @tgߘIgN^/G6`cHמ?@e kn\򉓍`6Jh;#E0%@LﮏZ<J˜EקʣXDYgQl߇_ ˝dn\,24ӪMaűIfU})XM_hoҷh" wƽx L"ʱR %],H G mCYZ_ݏo# m|bCIt]5lITiu'G6<|1HbۄkF|G-H[@጖}C'Gf(4H+pU'yMI`o,๕>aӣ iP4+Vx 5"uwҎS[ZD^|-Lj}Bql\T>Vg4_R\6{B@jKtqr44_ƽ: aXƫ7ôྊ$ԉW l|_jn1ㆠKmMyX Jx8a! ](ws2Nq쿖tpoJD?*kZ8Ac!-E~Z@~>8{ (2v ؘ]^»^$; bW"F#ͤb#e # }mDQELԖQ A[q_- <{wI$AƦGNADISm^ϟPN(\8$LW af +d!-b9Do2lmsp.[)sʛ<J~ki/{X^aolP ?[3xjk_p: 8 ߔ7{uͻ 4yejL,JAx=myXeM Eȡ^/!EtDov '}a6qbq}IaMˌ3;Qz1{6 JH >'ɩ2hPK퐱Rj۫g fϐmClםon]ޕؔ<ٟʚbO.1ƺ{O;B)Dz$8CQqH/rG֓U'0.<-5 &c]nG:Tap$ Yh^J;[T۹HH|e |$wm#^>:ҾdjpP]B"g84<{)N"bkAt=ʷrFRXwլTE4uHɅmc.q$ xNP7,Yra878LnJ$?mԌbrֵH0Un>1pVF"\Dk`?smnpϴw kJTiryrvdfdFQ+0wؤR̔c)*2Iu4 ̄-XEYK^6$'vKz5JoWU}o ! )F눅55dD7PS%8'>9)= =NS[?gT+0,z /_ˌnF>+(T=Ģh߼^0 |eHQҌ϶~ŠO}⤉}Sف2~#0'Uĉqla"~ɋhfUP/dEz1;YJڇ0CA4[r<˅HY%ܮfegB){&G+feq3r-oVxRՉBgQ5UnP zӈ_YzZق{fC={УmwK`)q^ a> Fᆲ5o TgBl*`T0x>w}wlIzPT@lAkH= TN!#Si~rN?KzJ,^6#tG"&4@OnK2?I}/zrx֍5N|Z} 8dJGdh2whGz(V#H#L?>a^*yĊnq).R~j: P%H΅],}t#&Uae1zZl{SCm튈%%H//8d]G^: Y[PұheAۏ1L "|d87cVX)O q̵s[@wr\sL.}<sHa=n[NvifÆN-{L{D!> stream xڍTk6 ! 04Hww7 1"%t7RJtwHH})y[s}5ZPK,g T@ ȍIO ;c\a`(D_ )W!#*P@@D@l P(B! &lkGd g r[Y@*p;"#@ jIwpq@]m_0\-y1N0 @]1)/SOs8#>FNDxq!V 8-#XN+#K?%qrGD8#V!//=! m]-C@/`8 "u K ,Bx K_Q "wc &!j{@F;ϤX"?1F?ld93 n `_B[\n 53Le)}u4.#LR. |Irp9iܞ|&I{U=Di %O _?Ӡ57B5bLЛ ,Ȼmm x-" xo\ݴtFnD\H6E\yIXXKN9Q+ %$!V%y {.UV6Z:jiȢ{Pb4g莎;(!lGIfSUe`ț,`iD_Ҷ6 'Kyi$ㅘx},Y=!O^7,IWݛ׎h:%gn8xj!fCacu'lƧ5 GYo4$%dNxi=3s2dGH8zn#(s4'mEchnS5nc<ϗXMmf_r4aw5S:Lh- ќv$}<~fs%kᡳIv}SbP? 칠5XWSDopQBMф*iV,u,<e(!/_{Ctm&i1z\!9+W&'p+wHS/MY<a|SJf-ujnFAu{Ex{cy+'҅򫽸9tO 7{読C=>W,ܐ=VNJF%@&3jq}ݳm5/]xR,s#NLc}p6;tc!zD2ml* Ef9fBQWԠOM,ޥC1;1鮼w|i7}ayw٥d e^P4bWm’eiHch[|p 30.KB j6M~W`3㸰.r6JNRh)9TzuCꡀ.󀰠dǧ1_ m|(%Ie}UbHtiV>zzZ!EeBs RE~w.w5)AYTeDfK8"q^7V+&,WlZbTgdl( n+yEiq|+2Kxu"M14ݓ]zy\or%R"-0OtLIڌ7v<ߝ.pGc EJ}J]s}K[ynDonzׇQc4 FMl^)q6pڕM}Cδ9~'?\gq{Ty9 lҍR, b ?2Xv v |AqulR8FNeɅCIe,^ $%[h| 󌋸pb*"ONQ vpx^|[z_̨1"to0n*r虖23Pù¤dL*qħ2v&|r?v@81>>{>Q?sŸwyaJcDcWy*5`'ƪe#/jC%ҌqDKpT,U"PNf=?ҝVpv UTI;UJ WP-)}Lm&cpTZzYUtۄv1aj}O|~!w>;}Y!ַcDjܒVd) &ŘXâY44eDI G*Dug15˕:T8cN M9Z٧ }EY&/٦$9+"xۛh29]m)-Z9\&^>hh L!U,QZ/sT۵%&kl>vlb(,Pf7Fs_A &ƻ{dcױkY}T/D.2|ljY|X=qm ;L}HK4.%^5"#hĽʼI^q;~žMw&!Y*w{ZkYiށGC(>٭ HٕRos,2Ey]i9 ZV卣*;`g"??G?ѕugc$PzWꭦF#!02[(AEQ״v4iH3*O0ߗφ6O_#|śE0a@hkgMј*+/T#b7Ϻo?3V{\]j8#<8I1nH S3PS{}ڗH6WtFw1tr2S/,}_Ĝz^F^SRso {w?ksCRmeiKgR[ZN\ t-bOhGNC:Z!l/Ό6ɧЕwӜ`}IY|k %(cq=]Q:VG#=gB>-ASr⒴(~#y 0cbeLTx[FRSQ&Jg$5/. Z@F@]2]<9J6d)ZaXkQsUQn^B9& m–f]ĘҼIHxQ ŷĉ~',  c -Bm$X! "gXR] ?v Έ/1:b-QK>O4[”6VVmPhUzfarG|'csOs^|nF,DӇjǗ3H{o7 >=.,oO4@3zLQNY]J髵$r5<eyqn.FIyV#/l*ؿ6؍JMFf9.ۮ,orq`c،E<˝cGb8'94bmsk׉U5Jk^ ЪI15!Onwk(L8NB>h܉vqdѶ䇌abjeH#?C1|drJX-t=t\֜ٴ B?D£h6~6-bnDC–3L6i$ıhpIo>b/٩vY{OZgPes;j7tDkaE:0~yoL\0h2\chɝ'(;eO V܍LWw )쎿 ,-H6Ye݆%+;_$>|#z[VP}X5N~5 Kp!Zo9(%~p [)ofy&f:Fxko.Y<O'1.oYQ7SgdFLw]!QIn@+ƬCIMq i :zV&#8"Bk10ȝjs:LZf8saD!%|%{N1C2RO iʗf)BOs8p)zcBRcEsQ:OmdOc 6ꎶg?@>CIaG5@܃j!rOBFs+SJJ8YZ}Fa&p&i?@r`j ;nRIb[YƦ77hsn"f=A+NrU5abUڗFmר%4i5 a '䟊tr)Z~~,<gGnjlMšTM} >j4];+pKHcڳfDMhk7 /# F}/~Q#`FvAJOiRB`(l] Dv]!x׷D8F)ӠVOCφO 6-:.S"Ŋ/U#&H?w(ps: >L4{~Hrq>Fvl݅ 3֜qwmTcg & T)U*]FFktHvo_̃"pJM-àh*RXD4pڏh7" \CϪٍ@H7it_xNxĜtF>(TOJ\ 3 f\Z7.@?YZ3 |2fٕ!ʋΖV5_a~m:0Q#^xiUvu|.;7^\Shy=UUxNBWY^<hjsxun9g:QbGӛjÌm󁉍e韩&Rd]BZّjvމw>P~/=H*3)vrqq -u7R&Opj:y `TgqRx8{]#f ;4ͺF%g|EzkL$ʏF홸11R JoCC- JҵWMZ.+$ ߜlt_pw燻Qvx]P\䓗y.*UqT~hDQ8oԴu8јb[3'^9QY/~RAJȯq> a Wٖ o(;0}`)w@)2w`o1P^f׷Gkj:O%+ΌJJ|sK}z#i%XMk`=ZgѦM[1 g~kk՘m} {&_R!tH;C/_sjνrL NսZb$PIdLEcHǺ.j; Ig D2ún?I,o"z/_S,K\Cp[t9a"ij^#oV(zG.rHOy-.TGnja8ž9s /4o'Cs)kZVh3«w(b=%e%/BM߂6Jxwawt3O@m/MA!etgz1˜BƵce y(̴ԍ"_Y~Udķ]1p/篬EVZ`WT v_0U `Otϲlp]dG7FS߹!L^␑>gw|{!4z}u\ endstream endobj 407 0 obj << /Length1 1585 /Length2 7638 /Length3 0 /Length 8667 /Filter /FlateDecode >> stream xڍT>" 6A@Bc " HwtJ?;;gss{_: [>:$(Sw@;:~iEsfE<@;:ݝ}@"(B P!|>Կ ӿ o@QG4/Bݠq$D4<C:ЬijG,(N=t3my7PXI9bFR ą,֢#46a1iX/^˺ltZ7rbi)[ŒѽFđ(xg][ap3eȄqOJ^ݧ"PeH{EEjб|Qͬq ? d#J[8#DQZ:>'ANu ɸ]oetj^I:BᏟGfyp7ucg}D$U1 pwne0]{i[v/6Pq+i[nP_:8 E{OZ.\LMGJ0V~N˾3vdOz]_,hÜd +SZKBkBYԇ$+4ݽ-hz%[LNI)ߵE}y|<ϧ(fI )tnxe+Mpz5##(7XƲII"g^ѴַLC|.;rSbm7?Q?kUtIKud ?Y_ĊήYu`[f8utġJ֙wŽ{$Nv7Z幋dçd)OG"{+0eQ@(@ q} '/"wFk=p8.䐒U c^]fR]|{qE.3Уnr|PkT;fa~nzti$`@x:p1i~m̜B#9]V^4eI gŴ,eˆ.ZȾNQavMm+^sOq4;AȏԷ-&#))@9PBzL4# þqFTW3B)fl&,H ><_ΜP.+Ux3@L?\bl)9` _1&. )S_IU;~]ԜP/Z3yED6xװ v@Lj8H]tk@"i)Mn[Ə,C6@|SCt;#F ߘ;d9>=ggEaETUL'=zK"%VJ&b,MDqm/ַ]wNnQE&ȁC; ;-ޜ0r4"gJnZ7l>+=0з*TbS-ez֫[v8Tk-0ASm(Q`˙. 2Q1bEg'Z3wwp9XV:re 6&Iا*J}c,V+o/f)}"CbR;_!']s=%d%G1ODϴưFN KݟMrBlx:RgAk1ULs8'r4n"^>OXQ-KX >sX}Nfxrx~Uu~aw 6#m%u&*MmҚun"֣Lln'N1yȧ6|as46ܡ8i3m_>38+A I,oB(~Ìs;GSڼRe#̯7e>Qj%dZxaN$W)f~(.n'0Xwׁf I,>I_Cڼ#|lyǥo+?\M}mqCXb5,& ٕHd"B*[$1MWp˚4,݋b`Ĭ;~dNsy+J#SB2&Y<~D}M` RuZ; b:䣼!>-=ee #!׷1htJ{҃s o4y+[ԌE1Y^y.2oڜ2G`l[ܑʐ{=ʸ4vCBwVp(j?z'(r'tέݖκh& ?]a*aMeNie%ƫOf)ޞ }B;>^ >·ֶdl׍,;j4!XBsY+NZa65;trRSsư@ ,GKg$1بL*zsor*f:Mt: ꮕ=`]$#Hv&iDj6h;Qz~ZdOApV&oLlؑӷksjؽ|!B{&?lKRO%&CVVºs$1v(pwuofatN . svZˆU+&&rHB޶!˞X%1S:RZl#nxN#LM9$=zѓPFILؙMw'EGǷG7~p2X_y5jׁX/K93)${֡<'ujRM+QP<˟'N]c!KZ d9 'W?W?",馛urA[3U!M&}IҤu5iY]FHciJ 64gZ܁jQ'>f ľff̰Wo+9]A m YXz×Ymf jdZ9M"gi)ߋY $0 W\+ݸh}P#du0"HNu('jRFmbpnIqjѭ cۙƿo/:{Iң2 pPxfßME* N_HErmڧ),1R3 JE0<]6&Hz ]Q_MqMe(ƍ'nM3zss0l+NY&0&HǫdE_P+D{_aeN ӴvfyȢܖqqAĂcpb* X eB6|+*" I[ #J`FbȚ{3 /gBϫW ;$,JR񂢴ya4~'{[Yq${[qDwQ=gzWlje>h#HT^٧O/pKUErpߦx]Ѩd5V.LU^E'JvnG}]=9^nknC9L o[OU诟%*HJrbR/~.9~U~Ǐ\>x2Qpp-<\z„M0Hb\Q\'z&Q|tpij|bk WB5d1bk>ޘ^H,9O1ğ~P(,c֧W@ߪv7k%ieuɬ:\}7\*By[[x)yxC) Bt}֘MCx ܒM~jS&8u*㹃NRaWw3Z{-add]'8;~8{/2akR*zÙ{U헣l[@#O[tZ H`cZ`Nǁm,p .c2j3sP37Iw} Z}I_Id>[#,m*o] F4F|[ݣ R֔߄Wg*aj[zsҮw(tt *ZPE+mHnҽjY'rKTҝ⡍^u<& L;ݽ Rʟc UcK- Їf2NAbK0޴aD=7|z3Y' ΖQ DwI^XaťWoȼ{prջӇfDpq4ɴ jw<#kmv%uP\^˼ yt"UGVɨ<9GcK Vq.p;y;*pя)M𢡄i ciPNAQESKynz;ʋ[2ˋăEGkރ7ao[_dB䓾AjNj)^u|k쓖_c;$FLLSZ*lqFZ˒­R ѼS{X4 v˜p$ܵA83,Q{QjŒORa96) ]X=oQvTPT;["qc,!y{ kި{ww!* w_:kH\7Et%ؓ-+.v>PpLa5W~ہ>m6mpWtwʽh&T @q9%uh|itz5(k$ q_ {*wc'(QF2)ޟh8>0HCΗfZ{$i̵vQ& 0̹w9+CNS>g|Q{OE>Gb1~nh;NN;JR X< }"Z]je, \қo7%z,NS}[L[YQx<^c0m3("hzQ?n7B_a=T߄vh;yfaQv͠ie*͝i@BZ2j_>}ҵS{icD[Ic]c̲m6l/5G#sKhBۖg~zz) x2֒p.HK=C|z3C^Dx{bb,z&%J/Epe'yyI0TX,!JN>ީ?RIcd52mb:6gtge܉rUP'OtPx#.' [VZi\{ym>Dw-G9W~MEdao_0{IA'IqNG>Q,$݋6-6myl(vgy$Y}~!r`&"H1zl BIW @o~N7*~zo.mL@n!lKٖT#7/\vwpTXz]} 9j\'bL9hnƔV"v+/JKczWf`ZD. ϸi~ ٶ9b~p*t?WZn>dG v.1)s +&IoA\Y͚MS;yoÎRFO7RFC$J2|Ĝ^:q#S tT4bk@n^k <tWaKX7_7vR5 +8leqI42֦!QIi|wx{[dRTiyvУʟ˚WhhU ~þ}$ZUH+nhKѰ\8e!CJ54C+h^ ]n`|Q?͟H{Fh(zY8 c@kK9>7(Z9';iS`Hl"R˞!>EtYvOo2ŮywKTg?Z#)>0%1:M]| e.N6vkg}2cWE(P^^VNE u΅h/m+~"16A1dIgfm{m1Jϖ>vupyt`e~ Yqȹ!>dksӖW\J"J$&]e`d;vL$ 'IQaU>V3b47܈a`j\xN'x 4Q`p[T&iZݕK rۈ> stream xڍP.ŃwwK`ݭwwn]PMg̽$ϲw=K/&W`,l % >' 25&Z;a 4u$M]!vJ`#+`c!Y i(@dj 3rL sS5r@lzW:!kWWGVVS{=j P݁_ʦ S4A.5@D`2:@<, 9E#ocſ o9ljnw4u9X,Av@"+◡ on 35)@ZL ` !=sg E_a Ur\]' rCwgm>K/nZ '7?&o:֬kz9R%0q;,!$~ K puvòV !b|g'@ 2{_B`kI1_8 `fpxy~_RUS?ɱ(` Rpg,Yz 2@{ ظ!o MH/5_dd\!k,^e%rs i'Bjn v *0p涐 ҫT@>R`_0uv6B> z5V+;#(Uo`XeE|V߈ qXEV'$#dd~]@f?_ љ %WeX-̀!n˿<~ ۅjBG_j? BgBt Cvߡ!> /5${jH= WB. o7?CNb=! GndY]$R%? ox7`nΐ_dcz4@s/ `sPжZ1"qwqzܮ4>֊/efM,^.O/1Nxtg'BI_0 }Z &ySB8 Ƀ? 8r%ëњb'ql^ˈM#.h kO*-,YJ^,pq݇^vUmLl40 grV9 cZ%0{T2Kbٲ -'P+4fxZIriPkM{#!P}Ujcb0; /<,|]{ϧ+]AYᔭ9(27k7:ޟ~3 #N6TZ9tFd gM UZXfV_7; ]H>JYp_Ja*5a)tᔅ "7Bm)uHk=̷:nvkNT{_$=)WeyO=̝3]6Ker&cR+BBFX i#T'8]V"@.If-PW-3SZ j(Ni:Y&щ^ Wߒb#\a(/M CQ9myug)LP3\0^>~ui&q~4yW |C~~e:gfNf63Z+ ZweaRɻOe6$j?SKF8Į+{SFx\ƒ]7 VѵW<)?@GZ_>F-݅.0?aqlz)dP:cX<ŋyɻTV]bav5؏<$ut?~{B$KX԰4wizRvog %|+^bh|]i5ȉLI,k-m^\oZhJ"D++?bqjh=n$dQ2Qsߒa&)Y ; DaEͫXu:U2Ɏ>FIṗlr|Ѱ_ jbD&~@i~31e4j tϯ[K=2lS׾- fA<'3Ѩ4CHc2[7@ƬrJ*s`K*?;F^ L{I!jDdj:reX䎔<4a`tSҒPvv0 C>ZU˝S[Ԭ={qi3֊#aS0ϞŖgh>Άcfm(ɲjr%Wi](lL}31p"z)ڛ*~bAθF- qK9qDV am#-{IDg#4;iPz^}^h*3'GG" }UᅾYDA#V/8] X_؜}$ G∟xi0~3Ѭk'.PǴ jIbcTd5u ]H aՆ~W:N0048j1%M+iqC},Q][F-b1d0V́ ^̪[{[1݉Ƙ{i;`*W=d}gfwInɗ`ҽ%"d&Y^[9>5-3q ` mnS<_`Be,أtʑk[g؜iS"E%]̄Xk(MMMU ES|"wǭpSaB?f5qAxLھNpqκ])O9T'۰YyCp8;M E=A˕>VM GQ8<3$@~sxmݫICÖ)UaҷV/L~ N6:ho?ipCYA l }U4j*i-VCKxPL2Ϫrc-S3Zά]BD֓U}+ ,Y0\Tɩ9!oߙWr2ܜEy)a!kw/^Ǒ?f\wZĺkmqS)`3&uM?``.Y(K`~s <5/ij]$}*W!\2VsCAwܹ%&ΰZBISʮ՛"yls $%ӖR<w ޲阧/3U7}f\/k߭4i?;N"%=^HgGrֹ04B:.ҁ$8kAMBVr<4'/bddN Y9xtIJHPDK%.wM5Hcm=< %zu3T_ P:E{rÎ A(bzFh/j Ħ[+T➗/ݮjw%nE0ZihPn?|tjpȧN}|?>֚m|H4rŹ)H)e 2Fb00oڹ!N+5-M/ph"o eb"7LOtAÄgO\"ƸsM$d1=1eMVGw.Ákˣ['#;$}Y~aqZkGVq;Sp jqn%bŭ'YY*P/ì@d-zDvۧ댫p3;r4/˩Y[B[o)ZwjXv ryلX ,/rH@VK ]U'SV;fnfJ{}ϗf?10>"a1c;Ojȑƥ-0N,9ʎl3=,s9a|K|'f GG)KT'SCGzP?+ˌ:Ttx{cf(B1Ο+h <'|Y*KNTM?WcGekNntY3k{]y޸ld;l DE +C dLo#oHx%\ɢ5s1Qz&ĥ# j9?, Dݕo;0([9{CsLb5cMM2]4|*nY&]ʶuoUHǙ)b8Y& \ci&9g\7W(0!5ߗwmLㆇ*Uv$?;pGcSL;;Z~wPEyI$%fpj ~(mpE&TY>Zq5,ʚ#zFok/ b>ˌZo}S@[ʬ@O=ڑ#m6ƾ,D9$xu/DZ4i1%.KG7?Z6MmJ&V03KK~ I 0_ע4m1-_84!X )=}0'L i g^yƉەI? W Hb]yi l-o"!dvዡ7=ȷL~$\wt8rCM~PY~ðqYY@B~^XZr qgSN݇ t$8DjGց~)y$uW-ϪSlWee*{&qr$9RgE9.f5vOdnBpb!U 2F6ԆIz.,"LziWw>11pVsVd9 <t:.۾?4ND.w-YrUء8Ob>1e^SbɜԵlCB9HNYYW"%U{4(dMZaOq1[aRqYZxl`HS Krr0<㯆yǡxJe0%?E'^Ȣ) "mG֬b[+E F)]nQaMDDGptc܇̼p(\/o/zBn EE.TO;wP2}~+ﰥyǢJe/P #G4h+Dr T;Kݏ~92CDЊl`f"k^= zo+gf&N'D:Cj.giܜܲ8ǯ;iH>F=qϜӟ5iU lajݶ)'/KM5pdc[&p;eO)I[r"듛sp,Kvr~ϝ/3z';w4^ -+'W><4׉.Okpx _yɑTgrx/Ƒ½Zr2ẋe; QyYzH+iLdREΜRWܒd$M/*G. =q5Ӓ'e^fw#T3X+:HMNM[}9"$A*'+p i!͒Ȳkl4œiK%MlWb}"V4mXfİHZ+Q1TܴDU0&w\N-}hdd/GܕGh,*3f91뽨6& ث-`Cv]2QPQ6 5> uF>y@{喂5u\qLw/E{ pF/Ң Y/FJ_$fCbeʃGeu||̻ ˜M V vUyHʆ 'F NO2x\9=q&ЋƎm 7\ ^&y9f'=)$3!@L-a%Y v/)6 j&sئZ35?Б]Wv`_HZ$9>Nа DB'"Hrdv9:bm]Xp ɂ>P{>WƬԞ<>lJsa)i~bQU}ԣ*> 9`rMa6Nz*!{lvoDoR؎JeSׯ5EPU[͟MJɭIn ~90o({23TSI>/D7}P1Dp ǣ'8gHM37sLhJ%v(dѕI|fA*C7?c պ߂\5"˗ⲩ/kQ۟tW$ޥҾIe}MAiްOKHt+]Ly$_̚[ȓBWAAH+HzedC$⃥KR`I0 e98WpB9/t k|%x\?Ӆ{ ׃}ꘫ; @躪J6R߲;-2;fl1 l=Y{. O*fDZ輡 R޴UvWջHy+@GQNF_>D!yc͒:\F3)>FěQ"(uM-g.>8C~"uoAoU6V ѤK^ŶzJ1N{dKoX9 {,pJ 9]=N6agE7zܨ|PעFUW)sxT9nAel${9s_#dOzf=EK18Oѯ|E7#@"ȫ2 ٰqNpl=UϤ'6ɬ`gf*sYofsBfm/LrhF~/wU}}Q#G=T;dIE>N&;%Rc1^45 *d.Bãhqm~ˢus#zYYCjl?L.k$&Nm7P=auUδ|tѸRa0yۼ+̔9g˶d>|Q8;=+<TR( VTbW&{vY2.oR> OhE56ub'lO:+β_؜EbmLr |C+5#37"{ྉ߰ rDZ0x{P)=Q!:3ʘڭhkZ@-Xӗ8z`T퐏 g̫\Ǥt.:ohSsK4mO[ T܃/N.֖vQS~I c\96.$z>?H(hkejYT 4d G\9l]ccȿ}j1`Ei{)LHÆN'5><Ğ,>Dt6_m39Z@MIv-'H@+ .¶ !UV Ba}| Ez@ncH-fy-M5&bGd nOBeVl1ߤ7:0J,ư:_N FfG}f8EIcb 46>ôڊ̫ œ@\.yxxvC͈-N;q ;s]J"'d~9*иMԄף:YwUq"_9·߰^L?Eӄ+U*ٌKZTYCuk!CV6DAeHL/I1OHr6E-qh#`vJ >0(:Nʙɲ{5}&[]Br#CBulYIY/@ƾg'(˾8xIit*>>-ٶ=HaaM40 qe1Ϭ}̓2FK)*a=[a’G载|j%1ܔ6J=yV`EO endstream endobj 411 0 obj << /Length1 2192 /Length2 13036 /Length3 0 /Length 14330 /Filter /FlateDecode >> stream xڍeT\ A A;m-;]AGιo{UfLYA l9102DYl̬H ' &#;;PvYg _" 7v`;#tz鿏SZ _[ djlP0vھhjlPNɞՕ֑ ,@G h-hl G#%@I lj ^l@@;'g;3 ?@MFd,7XY ߁@v9mAvs $)D03M4qlM^%o QhBGSɑd[%0/3~'M_*[ہ]<`so)fLv gX/KH,NfffnfNt3d=/#ޞ`{7h8Aޞ6/BbaL&@ ҟ/@K@@n=&d0dgf`;?IDJA[CEEnO.+3 HZU6'E3xRJqOg|h"?cl{rQI/)/-?vvzˬ_ۘ_ˬYSJ$ h r2{/m@v@e#``af?3~`_/ewK ;S)dC H/8,/jtLv`8o9T99^߈$q n`q1$ 6SzziP&?Ob0x^\L\LAd/`_!+o;/ſKޖ@Z[ܳ/k_Z H|j\L"sڽͿ/yqEK"/c S=3 hfbc4S56?֓򰼨uotW98^/4{6,!f'W^d; T_E뿎_wSW 3gezn@SY)_UMPm+?I6+X>)õX^V_~ܬ%sgf ܵ 5}yCD>(J[R&@D2SD陋s* nSl*J!<\Wuj6Pģ\J.~Z?4K/uJ.7@$Rs)1 D St޽%/M#MK!G{A>XbɆL}92յnv$/S'9*ʲnj!gm)&[@{ת8N_ E1-E$^_c섗2(ÅoI!Dj-B#$j앙ȷHOMY,FhC0mX-;;yd}%}\tUgi«]S52'|./8Q"6Ӊ4] O2ǺPЯ$`cqlX܃$)Z h{>BP&U%wb~=?aG~yE{#x Ƀd4+&= 9$fՍJ,zbP72sXo#6@&՜grFH)B@<$0iJ\mo7DARY< ]z<ѵB&m"\mX1|W妆*Vw<3o2«"< S'|hbW0)٬FMrKeE#G%ݾkrvRv6<@'Er[g  KKɕyqT۷ }Yd9>DfrS0َ){ô9AZ߾ ;@$*-2h1hg. li^o7B! uw=Ys1x{fJnR#aي{] P>>AVf끦}`̮"$n?ݹpq:aqPWֳTFa%X8Sd7ĔsZnoմ6-dwсӳ;+U ɚ95v{}+NBd炂lDM+Uvd|o`tu5l/4y mzvjJ[3l'sC[HJ COِ/h2~ؐj\飱 HI+cZ$:⼞c5>W'z]pQI8OeXB՘|H;RN\\_65c:N@m<4<~dl s֍ q$EwNto,uW(Su5%$Zx@ K?1WZ pv!-i1(s跳H(iAGjiZ9]'GShpz6*͟fӓrI=D\8-n7mg#m3Ե}V⮖Y=/'dmY|~ȕJʸ*!;, )_Wd@BHOS*TAI86O \>i ]h8q̜z)E_ yuH0E۶ c%MB| XMEp)cgm0L-pcVֆ )J 9g&?v㤲FEaai!PKcӢ]UT8e]RY"5 sxMAm˰.>?y~^TWNO Re*g{0"}*3eC"\nnLh{lx=T|qgr`op DP(`ZPW %6cktS+) LxEv8cgdŕa*,Axm;$>н&8G^Yy ]O> Aː"Aw'wc|"p-#2{7#f <-bReDJm3kheC. M#ů"PM(IAuC uRL xY?q/s-4ZWkn&(퓤<ȶxiг`]ƍ0f%0H6צ){FkܪqlĈq\gM Sj_s5T#hX}33hZpѽ"1GbMץ9Tk4MdJE2!;k}~zCr> Bͧ&֫-w| -&. [(]4QPy?C݌ZҊ]cgF^;Syr}PN9Xd؍ E%O=}^6OnYK,X:N\iEEa)ZQI yCc˵6ozRQ~f͎b"VM`D[v}աv#$l6 }4O)˩q9~G5gl!W]> ญ )hJ^/eo 3yss0| Ʀ 4ǭf#-CRX2ē ϯ^=р=syFg}_/-SLl _ Vȿ1ҁ? ?CDyxfBDac馏4C[ ?y)0JUa0{]jBw}nsrqK d*Q4x  K* 1/-q8T08lHhxZNgdoZXN$=}0jZA`idջyc<{lA:/MԂALOKv% ̷1k紿}Z7vRL%f@W?F5-na{N ^$~@gʢa~|D43 G}[9yIESa/k2]oAHB,uJҊJaU!h]')U].p;lV3lmbc uF4r)Q `P_ tv\7%2]w$+ocfwR@\Y0!+vh'2\}tm+>qt4$w ŅO\%K ʒ 9kGkÕm <_JgHG}?Tt+N¤!l| [L3eX#1_uR$%;j΀e9 wP8"ZQl1^fzvR Rk,u?H-4ÏW9t6U"M 7&9^R ,`}ݯi_?VE|/ر&t+_ĬvN_g:c+޿- uC;BK3|%eN#ό+3S*.;3)sj3Gǯ6wں܂G`+t+5&M$Qp!GD ҳ7} [ALytQnν]!_R&J{N\?}eyJ٪ARՕwpBHT\jesEᤥ^zv͕CeȽ<8жi#Ozʥ$誇L3՚8S Iw@#L0S2읥+ѳ9/G_(f ^[Hvv mVRUvL9pB[V&ސѳ:gq1x}cvxW2vFLR[MМ,}x||z_ahSCE|ߞ'b{p\Tx]Rv _u+0#eiVxv7D;au '(̽TpjOuO-(0wzY"dU5w߱hJ:dN/s=QuPf~761XVS(/lk,4Z!PF܋v!Gy3<ʉdu=; O˿jx1K];O&{_t8A98=gV z|#|X ZK7lSG'[佼oZ=<ˡGƾ ݆L'T QoT\[i |OTze`EP6\ w-m'7z%MYR<m`{/5bkFu?U5oPCf@̗߿.:B^ĠFȇ>_J@>EiWZc'^F@oجKԮ$邇k]S_UO+p3^?:lI?8'O1ʇ@™pAne $rX܌ԵD¢Y hM )DN\őq*@z5*o`xʼnM0s]5?6 9DwNOג?JzeP#PQ/#q|NUݶ2)b&*Z-<Ųż^iEAP 9 T-4 Uih1I酇ؗ B,V|c>;ךֱ#~f:Y7)Zo٧ݥx1NJeVTN}TB]tWF8an#^4cQ6KBmwd؆mƐ8 )p]Ԟ]Ud*5סSoEW摚̇+#ŴU/(*{$Xi %@=|BȞ]Mr}:w)sv {EWn~GC>tooZ9vW}lwI3;7ZkV}f 2\K%4T nnsP)$e}Q9Dq@LeͶ)|Z[)"9|.bl _ciq5 . W~>A:I<R8'>mI`=X_1Ί$&{AWFòXYHGM;!@W47.xU٭)ә< yIwl#$8œZ?61N4ް<9lhR07ԡ͐ZFnqÒp syc{;f?1B'1:9#CtqI2wuOȘ"B)G,E—(j%\R;,ImLޢZ1]˱}8ӋNVN["0a$2mFqAȷ~j]U+ߌ\rJPHJ"**#~ߺ / 1FTY\656izw)WY9V=>]j:D-l"4F3O?i8$º7o*jg/<Ո'0MٝxJ B9(nۿk:) eMސ֪NZͳM76A@DyG[QJY7=8fu3{E`EHϮ6k}Pءdٜ#9XJ*Z:iT.썘&vFpxlA&ݱEZAI{˾w,xλ[s~1klz:L_cxQ/=9 }lm((HZ0flr=0% [eyՠ9'$# >a1v }lμ(Goc@)_uܨ3.}`2 ]UbY|U~l$;E}G% ]o<w=I岔HH(}xRw w7Ns{UhvlY;CiB8JAR-H#1P-*)%`0JnR[T)h_gZ찶@ $ 8KZ)T%Rjw HnӖ%DĚzքfwd3-[T>bDuxy'¦a H@~zּRY nmzjt#s(>[=/;).qdϖiԌqWTʚ;2~QoY|bg6_֜I^r~OKc>0`naU$:5Y(u ANu"`NsKsi]!6"*8D0:snu'"M gJ<"3F YvQOK7 xbmB(_iĿJu.4hK3!:#Iq-;. 6ϡ!ҲvEKv55z;GIM('5w.]  .\u͑;U .Fl;6)~2#<Ł2G:XJXyohmB<0eN1It^U5vtgO;ʜ6wO=Ǣ}?,יg&zFİ1a] V?3na% $ǐ%>#.U<]caj~hek駓!l4C\QIE7G(-qO)P;% C٦}|wV?uےXرv+2XSU1yz+ϧFz\#XrYQr1*m&κy5Es޷ S^lO]|%CsSVՐ$w:*>,PhZ6AT hpN{ >GeSk#31AJBd/YN?oz˗ߏ[Sl'u"lmc\OR^J+P_\;2tT'0a#yP~]6O?n/Ï<6\OՂ$YhNr%ٰ+cb˷/C afXXj{uT#VcS1=ꖹ򤱡&Tu9TZlɻ$&`L`O ;mtqӛ~U[R2j]IԸֆ\rmT5Z&ɷأ*oV^H:XƇ']$LAҧD9~f~gK,(V>73w/RS={g_ @D|j?qgqBFa9N$N9l;+7"sVnJ{A_ٕ5Vbԥ;?9+r3фZcw* Y_7ۗbEbks"ABB}ch&T#~S7Pd(BEʝ{"x$H7iW\qoE=}ESB"DϤЖW@Z/|^ uaڇ&{^hφ|J]&';"\@.db Z(>zrB_B}_Uh+ފoUT#>`R~W+`1:b4 \, ZۭXRr_`! ݲGQJ_Nc]ȏ9PtiчM|RZz59 d0F㎷_]5 endstream endobj 413 0 obj << /Length1 1993 /Length2 10537 /Length3 0 /Length 11727 /Filter /FlateDecode >> stream xڍTkMH CI J3 00tHHwHJJw(tww7Z߷X ڽ{4Y! +P )\l@ '+ _6 a" 8dR&N0Ke@@  !P P؁$!P,>|,mAP@ d hfbЄANA^Օ֑ ad Gd4@k4!N&P&a>v ()Pm pq_v9AlMv *03ehbmLLanWZAG3(ɑlI_a`,mg. 99O ޝ?j/Z-~5blϮevpKcY<@ % YJօ=`k y:NPg矊&49 ` ۡ,f@n@r~d2son]\GM^J?=^y^>jI(v©a=5Ԥ>PO}JK[Eas~U FW+a O77iЏd(}qiJv[l^v&kQHƧ)-ns=jEvȄ0 E{K`p˸ːR&+7f/' P 3u_-"kJGy)Sւaܨ,DFFC%\iՔ־W4B!yzZ_kOpAF=e ;ߋrHv7y@L:3Qny:K%evv.x}zo2>f7|:=]C76揺H 6 v^IkF۷44"P"sKqMk܄aAZcǷdu鏔|׈ /KreeB^'#MjSșOxh̋-)it}iF¦ۦ#l7'au+MJ6MmK.:hdvH6rHa38oAO)o$[ Uv‹meFԦh"w ~ )_lyNQXڋa9|$gom 9 eicFUE5EtSiD}%jt楄Z#eL/J6 Hm>YnrO<І7:p&+kb5I6{>E⟹l;xtm`;9:_LFh|#Xl {sqM,_X4}ax?RJ(&;kˠI9_'Rx}$mk9nIVpsGUQ dzqvQrrJ4TDEĤ=saeqH02"U5|{K ҕPFHi|VzB2>*1DX>W혓Iv~:()ec>vεx%pġA5wVwcUUQFD'WmMy?)P`K !w~..[D%!T9:[g?hEp5bMؽI.Oq $AhMRgJtIá~cX}dcɞRswW< {unf^<8zc S4k&[4;/4ܨA] EY3K.<8Uә3ַD`>ʱdܵo2ޣTi&B3y;iM ֫< F/x@2 I~*sD2N8&dƟ]Kch%0s_.~^*M8'Ԗ0 {%-dzȜ&gn,_ѨQ￙࿋^BxNtĸӒè~t2Vz+ʍe5 2gj.[J[8*v!? یYE@i,-ԏ* \yS8 e3 mЯ[>ĉ{ 19ϒDX?igH^ae*vx6ɼMj2ŋoǜ}R}@#;Ghu4 *OЧTa,!E pL?i.{ʧG^ 8}HSy8H)zw˨s&@*@~{o1d{ZQPW*T4Ul5_pjn;ZpsQY381iP0Q ĜU ͼ*'"6fJ Xg $Cr-(?uv挒P@MDsȢ;IO8 Y2wAV؜۬;>[ܴ\%ѩ Jr"T(y){6{Ã:|y!RRW mT"SR=%Mʮ|`9ȷhLhwݴ1_H ifZI!XQ\‰r3-nЉ쬉tYSMU+B/z2> v'=*Zl]P6[fkZ-KI.+t70}$~DGl(x[KzdFkOV*5/vys| 8ydА8^WW0уJki ӽ)̬{} +[an){TZ{ wi O^ʅF/G}5|?:6ʏV .y/ST+lR/="2h9Ѩd]AQLOHRo?qklMy9#ڀj% KA.>(JkC #:Rvw Ǽ$D}}:[EL6%[2Soxy+ܥnl^C|;nc[Dv[+$˹Y%&X^r9~^VE/8ChJݓS,ǘ<|>YQf\s}CLشatMgZ%k'v=\00xPá>퇯PhI!5t] 7<YZ QB<<V*OlT{f^2F8BVB pgP<J'nܢM5t9Bz7f7˷M=- xB6|<|.ꆿn6b , l~c=HImJ+}&7*ŭPҋ߂ Pbchs:Y?H'F>'/GBk4VVopxGbmSNV7h0 t&Ͻ 0 ۪7|ھݒ7ț =ޱR_7|z-"79U"Zc-.E $tn\DcjȲ%ujPS/5{ŽwNcBn ^#u_CC"8 ]*_Ttǝ(51dZ.YMr)CZۨN2ޟEONeJe_LHhe=֒ f,T eJ80:mReq>?B (eΐTպdk ؿ/w'8jf(^(W<Ŷ,ǻ-scW|Bҁ+o^NA -MB]{D܏Z+7țAh s/W'_ &.h!wT;e9 EJ w#D0`젾#zτȋ% hTuu:[+-\кDVb*:)C>fGר郄JFv׌۶<ʥ>]OfAɖ%sE#X3iôMb~ꍽQ Y!}ԗs 뮤p]-%*# v/(*D>R=SF'T沬jg ,PG<_/uD!?|^REHB$f{ GS E2ҐvX 4~.)⽆̦\j7+$&Zbh1=zbvpb{7; z;5!5'2VN =NBC^fi!]yVu{8:kgO\fpx `_ 'P]!EۈU,mcSm* m._fܶ~0JI.Oݙn@y Y@{϶+臎ùe"?R=-jݬO6)HBۜX,wߚ6DR%;6x[ŝ}!A#ރmPOį- μnvJ`)2.|Vd⫯.Փ<ŶA!tM (k;k` w @x{/B.~]A@iA3*?pvwBpΤ5+DIk'͛@o}ZЈڣW:JH׃B8}#_&s7=v!g+'A8)C%X"u}1(OZFr;wW#4Ƚ΢H^E}ٳ>!.{qnz_olEYa _{$!Ad]{< _ryYb.|MDW(O<3hz_P`;3;nkb4: />IUwk|cT؝ 685< #nnYuM_8ė &|Q"ggS?'Y,nS}(#|[ɚ@ &3=̕PWh ݥ*†uۤkP{QbxAM?6ܒ8D]ЬZ0uͣ=Urpqtu#E,'BPGpZ!wkuNtzIOv8h_)UcgFp\? 4,GC}[ geKLά)*y}62zCfk̎R/7]Ƌ7f[i]Ipa2W(w*/۫%Rb1W*gχ9`[92s!ե43%x,2P]Z|H ĊFLܐajK#&WFqo qé$szb*.!ZzFqN7x-uShX/>^J^$5I 7("q3ᆲD4N1k]@ÕrJd AszWAWΖs<~4)yf=gO;_T}A_}3hZxU?e54v 6G7P(;# `p)ҥ g+rHfotAaMJb|[{[fnnkcN!/xxޱi+4"*ˁ߄wM6<R`">(^)شE/ IVҍ`7I&[7b7ѢxVjN^/Fƿk`N{H%L9IS8%VWtou$KUHU;k,WWwP{)qWIڛt"Ok]jݧ\$oinЂY ;DS۫D+#ݗeMkx81G2 Rx%~{TF:\1Rס}K_wfEؙ;]e![osTmƷ).}yԢU"LpzbkOo] p/kx5Y 욬'΢hCYCN9r Ǒzp;֧/4zJ_+Q4ؖbTu e͸Y*۸ 5%^# g^X @Fڡ7iơWoV*SPbc ͸33vP<>"=0P Bth]2NtET{e/,oq0ˉFX_i~qV/[?GXHiSok|O䘳];cv?@SQ喾''I9m2x( jjEXJiy` uqfL2j@RfJσYPft!iNg){b>!W?h;[i"ܛU*#j/0( e(/Ӌkk#'|Y^& ¹=An,`DXl٭dKRn6_w=C|î<)z94&GS`io#讹oxf|-Mǎ H%p8к=shA>^ ֞$ebZÏJK;ϴ+Š?+j'-CjrnLTi')1[Tlш :TޘE9 YA{ٞd9O R^|'A o"xBgN)$6[P<$L.ʨKfyա=D=٪D| :{Zx\i_6r:3fa> stream xڍT6LItҹKtw7"˲+ Kt#R4*J H H9{gfff)t 1 q"@R_BI@||Vp9 #h` ΧH !US _@$JHMΧ B=`\^!t7c0uH O 0 G {ő(!Q@X@P? 4 89 GDc((C4.EpFS(Qܟٿ #<p/(THn`/4ý8ﳃ:0Gý~*gm&O BpkdG"F}Zp.|P @KHh *;ۍcAqD!pw(C4-r\e78pzTǹظ@ J@~-:"q; `b2 $@NFB__{?> Pbr)!; q; #' {H? wI7@O{ -'c$N&B1 Q} 'un1,p  @Éqߦ%ed` D홤 +S4$ #Q檠B~~[BeJ /S ) er?$Qo?t ~(N/ Bȧ' ѯV>ܸul')ؙӣ=zk12/atv =3A҇b:kܮ'.ӰG'h m35P=xfwi;T?>{\濑sKdi\aD|lYʫ+֮ƺ^RNySUZkaz2$CK-)Lr؀KVՂ2W4%X*YMbӺ DGM;c EJG@0əpayRkmلPkhb+SwQ{߮ 3:FO{-|J5}yQara!=IG'4 tSG KҶZ d/C%!st$7ysWRs{޾w\hQiLih5$Dt܇NV o#0F;Ӯ(@=E+sݬa~Au;jʮe$7yکK#ZtWM2UP*]m遱r;M QIwI9Vt-bi?8>Ug;g\Ӿ7> u(OAÀ ZQzA~k:+uD1GGﱥ_)TOu|:nڗ D0]:Ͱ_uW9{K{ڥD1JOg]"fГw&aOth^װ>7+Tb3vś?邛#k\>e<pIʚkUQz= bnD3g'Ò{YI$zf2B&ȜIfPyBGDx.`}@l-8t,\C#7Z T/hU7dbSck TNByW=j"^ku $Kb27oa'(lZ$0bHO Nxe(PPf~ kzu/9"x%p c%nRigdXAxJ"ٯ|unm$S`dzI؈Ο=/<7}/4_>d+0ڡ܆6ܛ%s Ym'/-G2|8b`=ԞEp JgB&my6 %ğYAozkw/uOiެʂ7b*wL/.NYUfT5E,J@NJKS@4 \ЌMNE\sD움rJ}'Z 9̇R6ynv.i{y2Jx̰,Ƒ>d8WBRv˖ 3UiG;O ~rk],6%p`ϵ0v,>=2Ӊ͸enEC5V*4 `ir7GV}(UpxTOӲb+BXqM)gM ʅO$aemlx1^Ũhw<Vp qLS(aRpWV:~1Z~RRdZ}J *W٨d/Ny6zw>m~\xbiޝOk?tEM.f6^GDwS᠜^Xଷ}a̜ڌEUkx+QЙK:R̢v쟌n>y)wI&}65U8[λ.pz݇V޹0$g  ?&ڝe&}cs+ .0= yԌ/E!ZnoZlxܳ}N`ںٰ*AjݴfIY5?ʷGR= pv៾~Ԁ?1vy!| pXsjQBV θoИݎq8?k"U1yKfڤ4 ۜTZ}l-V}!@nrp* ϔ)y26xNT8I0y)3:e4M+t,uYathSkՏY"ޢ{ҡjVxPEϑݻNK OI[c'y'Y2fw^^_h*k%ʵ$K5֓+^9<:a౎d9gx@=nFZހ,CnWA i6'|/ Tj&)ߣu$&:;ϋHnAKq^U} Fϋ)!d|xgM&V:ZHc+Dylʾ_6e<OTJb#|pT]e s"Ҁy^Wcn$hSXyT"+ ƀ qwkLM=bAy#bp1;9.i.4dn})|{?Jox]_-+D8YْooLr+*zH'@ܧDB>sϢBs.luYvTӊNդⓏ]]ӚJyW&#oBB"_ޏ_Sx A3 fEXΔQ'n$ɴ7A/BC:F(d5۝#x8jHZ@<c0}&oͼQJU;Y1xV4d;@j wWyD¬C» (fKNi:5s|pJx5DCkn*΃+I\`^vWQꐓ Two1(۴G](.8M.?~Sǻnwwz;ϾB%>޸l8>Qflt!4Msa5Ӷye+!F2j͝MWIQ'uǍ@웝D;Y';g ,(g\9N^}m){!Mܠf.5c̯y*y I=Eo$x.EAd^8~Sv`9F`IZT+qrqEmd$H+7-v'mU+|/E@[#|4yOLxWKWER]![$C%TLՙ<ƃ@8V'`fHL$᫰jàcKh[]FVW 딇Wa7S?7K-̈rѕyuK2r2sikpH͏S*م$L aaٞ#ơUݾJɮf po*_^Ȳ_V|f)rqA2 ֿ,wI3M f X*#SrMx)E^&]<}X#?ʴyilc&F d̞飯]hTRE`ա=1pJ&Ea8jY;M֭Ȑawհ(L&P7/Uc؄{GMkA SlA 3_ytďb#X<GQ0.E(- ^=;ė:u䇲&]8|̜=n]Z ;3Z5! ݅ɶd8%4DN+l7O{'&Quܥœbň7U#'%{PߎKQ8Xx V+r ؋ע.߃F ްaV4>褮,ĮiwHT`_~,\4Iu=/ N~=5. )ى}27C9Xw¬= .cJF@skyʫKM:G x׼j /:B]KM{Dٚui-ð@3{xf{ӮAw>ca7n',Z$K^zm; HWw*_ZE6P(^m-Ly[RP9o7",*ڢt7eߢ6O r%#oO Iww1Yv Qi";@ ^6tp~{NzAu\~଍<VJfF5#b3E3Rˉro^r;w\С N:Wo~6+)9RYXKc! glLP}pPȰvn]zL.᜘pP20CޗMXd6b#-āXomMW>)'oRg2O-o_7vH~ f{=ci "S+[x?'X;Lf WSrЅ`ߨf'wj& od=%V_9%^J $J+2N+4\O|<[tzSM&/䣼casY7Rgт,ohr;|*_CK!޾-y6^[c]GNs)DWCQ_+9Ƨ)/W?Usɒ9|QhG8 4`8/#ո7i/e 9y}ԹfOSq3!8Ɯ?\i(xOg7m'eTظ^P$zf&?f%Skǻu V endstream endobj 417 0 obj << /Length1 2637 /Length2 18783 /Length3 0 /Length 20299 /Filter /FlateDecode >> stream xڌt 7nl56vhbN6mNc6>]Y+rbEz!;#3=3@DNU GNjl /\dag/ G3&j HXY<̜^vSP@ S +733`4cDha3?@fbgkG3Jh*)?Laa;w= oQ -_lMIT\P4Ԁ of 23~1^TMo+#wOivqmh?l?,4p\)gCІٚYSH 'q w_6[[,~=3V tS@mz53z,CGGC8&|A;jtk v (;#r~8'Q0AF'QbM`XRȟ'A  .??OS@T 6]Ţb@hAXA I?$ibf942tjhhl=C10@A v֠a/7O J_A0 #Qr; T@Zo˿}DX~b7 @IhH-AO*Xޜ?|P)m@ddqrmbc֙+$Ig4ȦݿAa|؃]i6m5(;{I<6P]{ß$#_~휁&Fj 33c7 q'лO$8Y:(?уn;#_3J_ .& Nv k@FA^=A3Ȓ'?4vq tRVy-;j&?ΑhP{8~syBIrJEY\%z:mm)VynykpT~^U[= K< I1_½~lmZ-J7x<(sڙ= ڕ;Zt,-Y4k6˗ύ Un\2\m[ /IK^%EQ[myuJa3Y;pK3h!fٟ"-КK)s5s:Y:9=1݅\o}!s]`^JVg9uf?~m\  1 |$MnÏ_l)\2Ϟnn SERFhDƱژHt#e2<k&U3g`r{>>=~l9Я9Y?B#B]quOn{Ax0,l #ds]yxZLE *W0șń w^=<'v°~b]kvJ1 $;B|wXyy{~P0.Cr 7=f& 0v4ߒv:Gcpu>v2Ψ.>L;P|pQ~fC+џ]-z^er͖|YJydd"]+̂p:t'3U:R'Y}l + @]s0w/_+_(ـ6yd$}U%'!/JC #50 RKi r.j1`Xc9tX [=/sl%j;|~nP?l▀(!؜]S,8|]dWtAm/`8e7Qթv[7k9x;biqe/KTIJqo:tN0#&Ũxgr-Utk`pv70{ap}I.i6}ofBf}]Nс?$7lH?OvNJƩvf|7Smn ݓLb&hu\^d,b 7XCDsHW ¯BOG-LvǕUZ= ~!䭺}x#L$[̃m4m o&f1Erg)^ Ih;H\㘌†(AwImLaW(r|L`ߘ80}4-,v99^:j`5 R:\Uv<??!hk+S`b¼I oDz=*=mG+2XׯėmRt $w{FS/K\kSYmp;,a[D9<ۘ;I(XΤ}X3f*]@ϴlĻ9u%S3`[OFA ƃkhGHRg'h11Q 2@ݼ9"1.譼Y⁊JDՃPFӛRrJ43ʒ7y@׳{Y5 L^`UvÏWN7a瘾aWz;Y,.:HTv z$hiuDhTAF  "DB{*{r6qJ4njO+~d[mNX" M"<)y 5Rph^]>J| *iƲmAz@xxz6r܏W,^ȵ4<À5jGX|C~٫h*/Mx+rgkxUE|=NˮoVi`4Jԓ#R{aʤhKj8fy6!e@k@'H7*WA¿l55nvlV gf}ˮU-31@ީ `X'IuƟmV.f~ (>l։ ]Z9qӧCzzЛ8N#~'zBޚY4}ߠYG ԨpJ`e8޾ O=J`DՠH29B3Ɯ v(RzS^`3ؒW2->klhnb h3}=6=ECCEƶl\2C'9}qTQZ}P?F5\@7)`M7\ !!څJ'lЦz ><q_hL se|(%/f,ЌQ?JkCA~\#I`^e:f&}=/m4T~2SD7|0 WI}xN)!UCfC-h<acR IgYrO‘k5;F=I[;_TSf,iH5^jٓ~ IJޚ.⫇1⃣A2#:=}`$Lj+`EO1+{a-U3HUZ,\UÔɰ)pSy_WEhsYJ.jrbK<iJULhϱc-G>b}s4P ϴZ˦#-?7.7yp?(`!wF,~RÍ~9MjB!vm/堐N^qtCx$SW&U~oCo1<.v϶֓VXoU dix.TIq\D'hSD|yqaRv } ӂ%J\5݁=ț)幛H'$ ;C3# %o ] %m`?̢n% <|$N2G֡68wdG}aXG%j\p siV`+#)e'xȧfbAn%F泑hu0c/n !d>.:׭NVH5!8K6G-̻D[~o%Unr&󮴸?crnnOI)>Q@0l[A8>M\ fg v(7R@D&/*i1 )}REc(³>1}3Y l¦*=/w̟MH3Ф/(Rb BHkSf_iڅQhK*15lMB|\R!+]ӎ>Ykm`d͚BboKϿ,7NeTY聋q7 @d/3C#MX@<9R1 ym3t[мE hxN.\,\ˠ@p6yÏct.bSCx]4]rCGF] Er2Ɇ^Fv2R3jv-xn f?Yzc;P)JTua,U͆#u>mi7~: ů^P]B),FC+1J 2WvYoX;Švri(A_I:aopzlpL-zTu6%Į4ekQ) |\#W^QW>?z!] p0#(|dm]2p ֲuƷi>9ߕe>ahY1y/Kw=_o\?Gt;qGM @2\3FN<Dbp\ `zB։J?)Sa v[bwJp-d=gxAt)/P-}*\GX*lS80:b-طPE_)d{,Ii{MWWv썒"3Cw4Rf 8@5q>G&CGip賴`-5"ZTDaBL(1ܱ \c1~y|L9l7&0nf0!$/,)Gj.1vN{R,jFju=t<נq)sPo?I}̥PvM}Js.UX cTH=:T9Vp($1|}܅ZtE (51ITt+_ήňg+rlcSD GDˊ-~0=jT~.=ncH j]1hoj|%( qw_>sVbjr 8wZH0_\kg,By D&B~<7R M~UHTM&yN"12%TtSR:V:}*p%R?&e~H(e+Vx-DX{r<,(t"*8!BX_M =7 3Wr6B/6L>oΉЋ9~UvHU#(+ OOx@בUЂSגt {(_̔曆-eQg|,<.+>KANK~UNE1;̪< 2Q9b) wOỲ.ӽc̬FOaöF4B:$1|pBxO \v.6=l쪺U$lJO!j$YZi&z0C1wh6:V*ol%XjuʲoCd*yؓ|v\ I58 8-r)ކIEҊ[434\Tb)V҂ZW!#~^Qu]D[ ^3j{J_>c&Ylhnj7eC_W˱|pC=F5Cio=PVڽ} an,; +&dUr>kQIkXlabur'%3!Zx 1`/j{ 9,)"u0aT -޺XQD=?0aY8g5Y鈙.ѓ OP3a'g#? =FF|QJ6 UZ\1=_6qh62&5у3-;ר@L* ޫNYHx~Ȧv/QpaVj b|{AQ,r$Fh*f31cy׊ׁYLK,ѡͦVN 2!;ŭ"?hɣ@&p;]?{L3nf@ܾQ]-}Ualcb0t|%N+lU$'5iX;2d?2cW%DOc\$tl!DeV)3BӳJeolⰦ U=}^Q&uKH*tq]I!/UbjMNLwԕ:Rgg?OT}Œ !ZY8>Z_ۂz;Eʇ$R UqCG[[_JgLߙ$?fxQV jS7ɜ,Lt ä_f M]jxRJ'RX,Nk+tceJtz.ʾUaעAʋs >"p6Eޯy(O[lF:U2̉loUY[ouTT"O_AOY% QCG gȉ)i1 s<agUZtiI'ObV{'6,g|Z zďrقW=Cd_ +s5> 6~Es1 s;RҐjyM[:H$z6XBzE|jC_YC5} _wxlFrԈc80{:bV1B1^+͸ί-"s^"lP\cj0HJ,{h"rQU:E&L:izrH)1 `so] 4=3k(liM0;T4P .g7{KPygC3d.@=Z:gSބ\H+dlZk V,.ͼ7ua ᝪh[e ĘKW-Ԭ!m.KmSh$|>r.T'칻h,;>y[ b@Уe!>y T JNa$V3|'\-i^ *;=[ #%J0ީ-}P@dhhzKGl^V͘0'6^JZOsJ UEnxa/RT8iw )i@q'(0َ =h|5uG4.Kԃ|u?k/8%lI0~}P8T7WOw1FPOQPB?VX^ą ߷4#[oOaA WJ>/m#x||uՈIXVy ˛ "|y5K"X),\hS#y0B*o#^ޛ0co {|jl=Bq@AY5"VTlƷXhgX1L%hZhn`M)KDT>daD<)>!B]xX'bT>OF r} ψ1iNLɤZA 4C줜 U.'?.Q7Mp+a³kn5Z3H9#Nxok&1[vxxS?K6ԕ_3wvv;#o ~wLؿXoӈkZ$0E ,p s0c +UZ) \x36UF,UW4r)s.3Z%.q|d4_qRc.@QJiaT8OY~ jg)pd"CYQxE.-ԉm_6#DH!kWbrrYZxq/J%Ǧ3'@L>|Ͷ(MQM>AL|nW,LI[R /s/8+5{qpjus}AI,۱Ҟw4YʲRuj)̆u3xsHJ 8vpQp]笤b4ƙGmm߶K2W92U5[; NRaȇItd2N+ҵĒ6J`<8q {nbEl#]ѸWDIUuxX~`%ҍ6k ^* Vz 0=t(RK='9rk7[Y.WeHl|mZ_4X ^ǶY hEl2!<_`9|$$ZϐD8,x MtgyM"{/g09+V.O-0 (a/ӀXM!p&ipbF)h: ҩ{y,s~k絰c Ww|O"{q9ڼg>>~I^.u50Z0CM4̍*0PuO!Ǚ箌ܔtT2S("67fhcz]s rM,_sxoAsZUGsunb( m7!&o&g ՜o$ ڧ[ٻ!\WԴ_98%;s"wkaZtHdah>mZX) 5]"! `BtG jYv;HW6oUX))"d,bY/?{v:S;fCL;nj.?1Ń++㬬S4ڈӴtf#Coւ 3{yRbץ gL~5Y*+T]]gx8um-'p2 :O#D.דr Yl1G|tϛxbbk5X[#:\* 8ؼbg0F4e!rT.˴qʾͽd K[,'(!~A#/}R雬n]ܯT~@ҌtUNɒi p(O{Z9͸<la0(d]>gb;^b+~<ܾ8S4)~x> 97qxԅy'O^(C (OFً>;؍H+!ړ]6KFc}fx%*s-gefwt6JOc ]5DT!._qXPep9T:>σF+ɞwQm~sl#@_KDhuE(j],?_2A!6P@(ݾ<͇˻is.?)q-0YI/s9_2| THWiIyP:XutB89.[tIKR{P=ktk>3$Fֹᗈߪ`ǦjZh꤄F9xPI؉1{e!Y(j [0|7~֍'j^AKٰjsLL(6lݖ}e/)6D>Q/K:)F:>92hL#72ΠxI5R8lz{ ޴ Zp1T Wks(G֚?.b{hR64$W 0ϡ. U820Q Ԅ<}`!*"~K#ևGn$%TNm5,FRNS@.p EjZ p}mu3TQEA"rXgPov}th׶|j)D<JMF>g#%,uƕ2'&Jvy!q8XiMO5J9*Ղ6"dwFĐ`2]Kvh㜏﯃lkHܤmtl¨^S/j+i_ w@g!k:;0WzXzA da%@bLSh}f\S OTFis 4~~*PSђ -h9&Ҝ몉ahqf`S8}>[t aCU3%́ͮnql7.ms@QfKPq J*ŨzUPʝt|ȜGs~ ߏy뛚% o-,[Z?C9xx2I6jV_+ï(j I1v'vP=H?6d]emF]u}2/2)/荌Ml15)S9T P}N.AN@骄F1RKNֳŕ-?Jat;__D #r5[Nٜ|QhYΆ~Uw )#LQCΫL˞I/"vߡ O#/I]l cǬKsw~.ۤ`ܗ2n v :w?;~s{찙TMRk\[W呣?K>Q G'uH׀w|7y-jM ;2;h7 (ü^;nH oRh 3x&}ݹ  S[iwuS>>yriY]Qڮ+x_:2ܽp[O [~EBmVRfWHQ ԋ=UF'cE吋B}5N[9vmȑ۳E"Wjԋ H΁ S'gŅ5+].z AF:18@O`iIR+CV?]xYy.+v&KeRi4 el q\n"r~X<  _$B(TY"r__Lܻ0X֏/tvat-i22mVWPIntxb&sN7ft<:Vsf73TSD,Oۼv lK_LLݴ7:12e|e$f GrA.0#(d/H[nY#}i+_Įo7i; y&W(u`tʤENtVc!^Ř JQ!!2_5) cZx}a Qc#^oIDu6AMTG(\P 5=D2r4kwlaVY)]U}x~8W7SW h\#X{ga^ca]&-6ʎ,l^vu\'D3]Xo'pTƗ2U9++cK tD!.o$(dk^7sCS WM+HHGAˢVydF#i=1x+"I]]Jfc7m)ʧi«U_-ʌV+.{ዾmd 6{PD,~R!:b;;_yI}NKƚ#<b]as$imZwc~EñڧWYJ%g|Ul5N$7u4vsfuQ}! gs56 T,q Ţ\/GGVfF@|))AeK %=Xw'(X_9FSv&Jf\G'-ex[= hL8~3zl;_nPb+c9mHj<0rqV2]O'Ry_믑g;K}T;WZ1zQ'{3F1KYحݫi4s$BCӝR6H !ˆwE ^G2ِv+ɗZMޣT2πdLE([icE?͈UZ̳xtaNxV=j:$vWHt7pkXPJJ??qMd3- q3f_JLE=sfl2iG7zd`,d68XX^5;Ƈ{#DUT jȚE~x}yV@Ԟm@ z,Ga} 3ttNɐ ?,_67LGq ȳMlT{γU5aYF4'qa#ZEv4IvąX" i,З]46kfzoM$.718'@n9,Ѩpr{{4V9!(k$$tN@{7^F3m)"r.ZmцN#AZ6a]50 syO BQ?n3'Lrc+j*W=%/UpYh*b}Ԧ%P1-ͿD w%Dןb6Y&;W8_z@}8f}u֠m&&n$;9T -${AEqԀ ףdX s%0dd- 4D+xj8R?HkEɌ@z5sY{0/ϮiZ:_{7IŁaQp k} }a+S.,!&R' ;#P31dΚnyFK$'+] S )t$$!&8I- ّy1ƞeϝbU5Ďɟ:hY%;-+0|ZԬɋ.z+Ę<=Zd^N?hs/%A}S8{|td63WelP ?o̷suԷA,:K{N[es*aͷ71t\?ȝyVaw.Irܝbs䘭Di,JJs'ak醶)hO(`0/|Ǐ"k"XaC}͘, Q8,JdkEcb\fzuL&d?1 ōy0ɷ}ڒg-Vf)C DzGh>Wl/*\%aJ0ܧYa?(@6O(w"l$I]P)rɗG70,0u+gXn":Q#V*MAVpR[`793޿\n'8c5tD~ j=fݝn}v!sj&wܷ~b>f79akL끒I@]SrV8&>c'h5Ȱ+=T 3/Jne&o5Q/*s)?PsBw*. [w'>h=~)0nƶ endstream endobj 419 0 obj << /Length1 1525 /Length2 2317 /Length3 0 /Length 3273 /Filter /FlateDecode >> stream xڍT 8׏DeI=*e`$YHٷ՘yf<_%-JlIRh{ߐ-BيB~u}5539wnM w i, f  8w?F !6aG P#[h͈&f@"(߁ &hlA`ѴAb} HϤV! ba.CЎ :pG(Vk(pxHd@ <> ya  8CYjM# #, GS0hwp77>0{9рlt!I3H! 8 }3tAatC@3G4+W2g o8ek6HH Q!@]n0 iL! CBО:A]>6(C0n!3AE FA,Da _["`B !:Ylt<(N@GӟQ1# 1Fo򏠵5DdhIF1 D^g.thlaPQ@;Y]`gF?G 3)hBg&qz"P5 f8"~n#Ȅ! XlΏ4(d@Fb΁`C #+F>:nmaœ^=xt1D&DtG`efz&~5cQ_Lgb<$<"?L#4E?Y7]E+g1<+ J=ʀ`8" AKDG$uɒmU^ۘO»Gm X(b"9[ cMw]n鼤=ÓO"'s[T=X2=ٟ{dXۙ-}sλܯibBr2Ѫ7ZP*onh%nJr?n>Np]_9ҥiZlwQq_Lѡ[.IxwvUQؤYYt+)pk;^Ee׶,Nz?WAb2wZbScC}sR+  b]ҵ/oj(]g~+EJp7'u2!T.M\b;}ZA|#㙒j|xF; [U(QjXYTXq _{VF`Q;fNn;hٖTh,ܧ%C뎏NnSpQ?V//Hr>͎[swNz㪇Vgzf@>[vvϷ;ݏ+c_N<$kyD+iZH)LH1IO\E<Kt |T{z-~ xdl"}B-TW'evXOXtݙk8;[tFMUO~ z}18q\K*Nj:^|ט0N=[qQ&+)>^;NNj"]t8$WvƊ[3s(L,tpuM%R]RR\|dkh:B+i:O,2'ިX夏'U?Iwa}2z4L){Q]\kv`Z^VQ+k=jRslj+qGRu͘/4\"&|q?uۯpûnYǟYUh+kϛsW.*~pqCVrϞDe> j`!/Inv#ͫ \N6^vM$qWZ1RE+ulI>ڢSENQt?1]`]\?wr0hT`u/Ksھ/j֜%חP0\;㩥*o>A{ߙ(Wj2v;g6tgbQ,{-IԼpݜvNHHN^.|ܗѲZ,FLFvhN;#͏o߰_1B2Z4%鈊DOE]*C<ʵKnՈiА{v2jҚͣ34G,(y<{!OwS{,>CgyG~ƶ=i_:sC%+[S#tQr.2 _0.nJS$r,0[j⡾$_#gOXr]݆/sv_Dq+jەwJxZYYŢXYk endstream endobj 443 0 obj << /Author(Herv\351 Pag\350s)/Title(Overlap encodings)/Subject()/Creator(LaTeX with hyperref package)/Producer(pdfTeX-1.40.14)/Keywords() /CreationDate (D:20151021230523-04'00') /ModDate (D:20151021230523-04'00') /Trapped /False /PTEX.Fullbanner (This is pdfTeX, Version 3.1415926-2.5-1.40.14 (TeX Live 2013/Debian) kpathsea version 6.1.1) >> endobj 397 0 obj << /Type /ObjStm /N 94 /First 846 /Length 3774 /Filter /FlateDecode >> stream xڵ[r7}Wc[w**ImmK|&ZKPLR_ 00T[ea@>эeMUWһpO_q!yNzJBGU:5,P5,F8`RR0b*e4rQWZBGHWis_i JkaJ{Aƃ]e@X1Hc+ 2FyAҊXP*; g )|e9v4 vҪⰏ\VjM I: PFG*WS.Mr;UN* /pgRpۑRYꀰ9< y*/*_+ 89'`M契qO @_[8>)o=r99 #^s<lC<r Ko&u `0p^?<-஀>Y "O 0 =h:%aP7JF,DkQ:Cp㰝ȅ萠"6$'(K- !M 5)!-ߵ[clᏡ1! =p$ =GÞ{XC,zV;hJGԢD!̑4G{aWE66duN{aֽqhaO[p+F !@}= s;8):D^WB󞝴/kFxhʲˆ^:<=8ohA&nFkC>P K%İaсHRlhьlr#TXIV) (thBp1YHkh)(̷5GG˂V)+ 0vdLJ2$= + СI 6pN{-KОdSLM•83Y.P4 |IJ`, oɄimI31칏X%D>PFiFj*H1xמ"Fִ T%p8%x ՠbST*]CnmO@qE bl\NCS+ŭ.SЬx4 {MSI>_n6Մ>^ywr] st^.Vfe<bhŽ7ϛUzp1x0a'|v~7c?ao7d"06vȎ1{~fO3_){^We{}dS6iVM737&V=uh609;_Η h],5b5k}}kؗ]U34+vŮjl`s6okvl1[4lq{̛].ؒ-aLW͂L^0|@9[^}e_oؚof=6lsjsn4/W d_j(t֛O?)_~X4ce^I4xE~좁46KA#dw,w%{J퇰>nz>]_ x'[Co_dojNA1P|J>4@6s-Gx)-YX!uͿN @2PS!^@%W9AqIc~ }{|t#pSՃ`8S,4q1HyNmІsYof\@~|t6`-oq eLڍJ )A݃ύwN-ƣIoWmq|ɓ޶[h E-d7]ow`Jеu`8U Nq)ޅbk%AӎN,CJ~9{x7~UᎫcw3p.lvɉ9u [JlUv8p>Иh%\r~B< :thnp*AC߬lޠi8a 0bs0|wWCk'ꇷ١z^Kq [? 6-(ڷ5Cn3= ~~}s+n~+ԫ}a[,c ޿^6kH[LT,Ҿ.qtz*&N T2$nxݒρ{"%y|?Sthi.ut pGDpbf"nuaW9h1 0wT)-mi1;׫}WFnX̤d[v*jQ^(jvY.EMsugX+*`tШr{K5jQWH뺼:XMaVeD#55PXP=ҕWT)dTejMŭG=rg4DYĘFѳ&YRĈ1g烻]yƎ({v*W,=.W iq;cutmvp3se xvXDF*ɩsr|K%D@xO\Zw]g͏q Su Wpu8;Q\IBp6)8rvUAosMzm\%wPqMzl vPm3\lvWj;2c_[g ExP3J]/Ҹ2UkO;Z4K/ƒRT!<"ՙXƻ}gƻ,{_vUW. \sP=sWY4kf 'uv54UgFddQe6P^Ū0^t UK ;\Ke)+iYQl{PxetyTY.790Qf8*q G}#xC5eήg-짡'm* ɀā^.ӁFBkGPiNh˦0Єj݊",> ȺNG:3KG,BvuZ;b)8@)o)S.m:\m{Kȑʔ"<:T <:G <:Y <&3=6hjF CxlHJMm`W)D*a8ȲQQ'Tt{pQius_#D}>Hg0pˋTn˺vba@>4χ&30)[&Q2.jnGD¸[㒐q6K Gv-W\ݹ~Q*ގTn OnmX* OQTfWLF5P(iCyxQRO5,P}t3//'{NTwl^,/~_[idpQ endstream endobj 444 0 obj << /Type /XRef /Index [0 445] /Size 445 /W [1 3 1] /Root 442 0 R /Info 443 0 R /ID [ ] /Length 1065 /Filter /FlateDecode >> stream x%;leǟ; ޹(RֶrJ9(D&f8&0qp8a3.&n 6HMs}.ٛ,3,"AK +Anw&ps7HXpsYFЄ!l-yVIuԮ5?lPR Neq6uP7 n`w)u(}K1ԍ`Po~B]Foz u}#'=LPfzZHZw;X`pơ]Bi 'jrHt5nKP1mz <& :*ln }iA%3'&GFKPYOannic P qmB JQ/AĆۻO( Qr{[VnNiuF! |05MJj8DSmmtmnh @1Ng?s;}6ͺAq u6kmhihqyENNè_?Ͱ`C9];=.r~_s@df"w{&Ò{2?JWUPԆŚ{W 5XRѽ龹7kvIAF.$q`(? Y;\{ZU?ժ>_ӪƳЪֳVu=xUg}UgU#PBuu0Ts&Fd]ºu9a\"|r"5A%}YW[?W endstream endobj startxref 201029 %%EOF GenomicAlignments/inst/doc/WorkingWithAlignedNucleotides.R0000644000175100017510000001211312612051202024766 0ustar00biocbuildbiocbuild### R code from vignette source 'WorkingWithAlignedNucleotides.Rnw' ################################################### ### code chunk number 1: style ################################################### BiocStyle::latex() ################################################### ### code chunk number 2: bamfiles ################################################### library(RNAseqData.HNRNPC.bam.chr14) bamfiles <- RNAseqData.HNRNPC.bam.chr14_BAMFILES names(bamfiles) # the names of the runs ################################################### ### code chunk number 3: quickBamFlagSummary ################################################### library(Rsamtools) quickBamFlagSummary(bamfiles[1], main.groups.only=TRUE) ################################################### ### code chunk number 4: ScanBamParam ################################################### flag1 <- scanBamFlag(isFirstMateRead=TRUE, isSecondMateRead=FALSE, isDuplicate=FALSE, isNotPassingQualityControls=FALSE) param1 <- ScanBamParam(flag=flag1, what="seq") ################################################### ### code chunk number 5: readGAlignments ################################################### library(GenomicAlignments) gal1 <- readGAlignments(bamfiles[1], use.names=TRUE, param=param1) ################################################### ### code chunk number 6: read_sequences ################################################### mcols(gal1)$seq ################################################### ### code chunk number 7: original-query-sequences ################################################### oqseq1 <- mcols(gal1)$seq is_on_minus <- as.logical(strand(gal1) == "-") oqseq1[is_on_minus] <- reverseComplement(oqseq1[is_on_minus]) ################################################### ### code chunk number 8: is_dup ################################################### is_dup <- duplicated(names(gal1)) table(is_dup) ################################################### ### code chunk number 9: same-name-implies-same-seq-in-U1-oqseq ################################################### dup2unq <- match(names(gal1), names(gal1)) stopifnot(all(oqseq1 == oqseq1[dup2unq])) ################################################### ### code chunk number 10: oqseq1 ################################################### oqseq1 <- oqseq1[!is_dup] ################################################### ### code chunk number 11: most_frequent_cigars ################################################### head(sort(table(cigar(gal1)), decreasing=TRUE)) ################################################### ### code chunk number 12: cigarOpTable ################################################### colSums(cigarOpTable(cigar(gal1))) ################################################### ### code chunk number 13: table_njunc ################################################### table(njunc(gal1)) ################################################### ### code chunk number 14: readGAlignmentPairs ################################################### library(pasillaBamSubset) flag0 <- scanBamFlag(isDuplicate=FALSE, isNotPassingQualityControls=FALSE) param0 <- ScanBamParam(flag=flag0) U3.galp <- readGAlignmentPairs(untreated3_chr4(), use.names=TRUE, param=param0) head(U3.galp) ################################################### ### code chunk number 15: first-and-last-U3.galp ################################################### head(first(U3.galp)) head(last(U3.galp)) ################################################### ### code chunk number 16: isProperPair ################################################### table(isProperPair(U3.galp)) ################################################### ### code chunk number 17: keep-only-proper-pairs ################################################### U3.GALP <- U3.galp[isProperPair(U3.galp)] ################################################### ### code chunk number 18: U3.GALP_names_is_dup ################################################### U3.GALP_names_is_dup <- duplicated(names(U3.GALP)) table(U3.GALP_names_is_dup) ################################################### ### code chunk number 19: U3.GALP_qnames ################################################### U3.uqnames <- unique(names(U3.GALP)) U3.GALP_qnames <- factor(names(U3.GALP), levels=U3.uqnames) ################################################### ### code chunk number 20: U3.GALP_dup2unq ################################################### U3.GALP_dup2unq <- match(U3.GALP_qnames, U3.GALP_qnames) ################################################### ### code chunk number 21: gaps-in-U3.GALP ################################################### head(unique(cigar(first(U3.GALP)))) head(unique(cigar(last(U3.GALP)))) table(njunc(first(U3.GALP)), njunc(last(U3.GALP))) ################################################### ### code chunk number 22: no-indels-in-U3.GALP ################################################### colSums(cigarOpTable(cigar(first(U3.GALP)))) colSums(cigarOpTable(cigar(last(U3.GALP)))) ################################################### ### code chunk number 23: sessionInfo ################################################### sessionInfo() GenomicAlignments/inst/doc/WorkingWithAlignedNucleotides.Rnw0000644000175100017510000003411612612051202025342 0ustar00biocbuildbiocbuild%\VignetteIndexEntry{Working with aligned nucleotides} %\VignetteDepends{GenomicAlignments, RNAseqData.HNRNPC.bam.chr14, pasillaBamSubset, BSgenome.Hsapiens.UCSC.hg19, BSgenome.Dmelanogaster.UCSC.dm3, GenomicFeatures, TxDb.Hsapiens.UCSC.hg19.knownGene, TxDb.Dmelanogaster.UCSC.dm3.ensGene} %\VignetteKeywords{sequence, sequencing, alignments} %\VignettePackage{GenomicAlignments} \documentclass{article} <>= BiocStyle::latex() @ \title{Working with aligned nucleotides (WORK-IN-PROGRESS!)} \author{Herv\'e Pag\`es} \date{Last modified: January 2014; Compiled: \today} \begin{document} \maketitle \tableofcontents %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{Introduction} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% This vignette belongs to the \Rpackage{GenomicAlignments} package. It illustrates how to use the package for working with the nucleotide content of aligned reads. After the reads generated by a high-throughput sequencing experiment have been aligned to a reference genome, the questions that are being asked about these alignments typically fall in two broad categories: {\bf positional only} and {\bf nucleotide-related}. {\bf Positional only} questions are about the position of the alignments with respect to the reference genome. Note that the position of an alignment is actually better described in terms of genomic ranges (1 range for an alignment with no gaps, 2 or more ranges for an alignment with gaps). Knowing the ranges of the alignments is sufficient to perform common tasks like {\it read counting} or for {\it computing the coverage}. {\it Read counting} is the process of counting the number of aligned reads per gene or exon and is typically performed in the context of a differential analysis. This task can be accomplished with the \Rfunction{summarizeOverlaps} function provided in the \Rpackage{GenomicAlignments} package and is explained in details in the ``Counting reads with summarizeOverlaps'' vignette (also located in this package). {\it Computing the coverage} is often the preliminary step to peak detection (ChIP-seq analysis) or to a copy number analysis. It can be accomplished with the \Rfunction{coverage} function. See \Rcode{?\`{}coverage-methods\`{}} for more information. {\bf Nucleotide-related} questions are about the nucleotide content of the alignments. In particular how this content compares to the corresponding nucleotides in the reference genome. These questions typically arise in the context of small genetic variation detection between one or more samples and a reference genome. The \Rpackage{GenomicAlignments} package provides a suite of low- to mid-level tools for dealing with {\bf nucleotide-related} questions about the alignments. In this vignette we illustrate their use on the single-end and paired-end reads of an RNA-seq experiment. Note that these tools do NOT constitute a complete variant toolbox. If this is what you're looking for, other \Bioconductor{} packages might be more appropriate. See the GeneticVariability and SNP views at this URL \url{http://bioconductor.org/packages/release/BiocViews.html#___AssayDomains} for a complete list of packages that deal with small genetic variations. Most of them provide tools of higher level than the tools described in this vignette. See for example the \Rpackage{VariantTools} and \Rpackage{VariantAnnotation} packages for a complete variant toolbox (including variant calling capabilities). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{Load the aligned reads and their sequences from a BAM file} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% In this section, we illustrate how aligned reads and their sequences can be loaded from a BAM file. The reads we're going to use for this are paired-end reads from a published study by Zarnack et al., 2012. A subset of these reads are stored in the BAM files located in the \Rpackage{RNAseqData.HNRNPC.bam.chr14} data package. The package contains 8 BAM files, 1 per sequencing run: <>= library(RNAseqData.HNRNPC.bam.chr14) bamfiles <- RNAseqData.HNRNPC.bam.chr14_BAMFILES names(bamfiles) # the names of the runs @ Each BAM file was obtained by (1) aligning the reads (paired-end) to the full hg19 genome with TopHat2, and then (2) subsetting to keep only alignments on chr14. See \Rcode{?RNAseqData.HNRNPC.bam.chr14} for more information about this data set. As a preliminary step, we check whether the BAM files contain single- or paired-end alignments. This can be done with the \Rfunction{quickBamFlagSummary} utility from the \Rpackage{Rsamtools} package: <>= library(Rsamtools) quickBamFlagSummary(bamfiles[1], main.groups.only=TRUE) @ This confirms that all the alignments in the 1st BAM file (run ERR127306) are paired-end. This means that we should preferably load them with the \Rfunction{readGAlignmentPairs} function from the \Rpackage{GenomicAlignments} package. However for the purpose of keeping things simple, we will ignore the pairing for now and load only the alignments corresponding to the first segment of the pairs. We will use the \Rfunction{readGAlignments} function from the \Rpackage{GenomicAlignments} package for this, together with a \Rclass{ScanBamParam} object for the filtering. See \Rcode{?ScanBamParam} in the \Rpackage{Rsamtools} package for the details. Furthermore, while preparing the \Rclass{ScanBamParam} object to perform the filtering, we'll also get rid of the PCR or optical duplicates (flag bit 0x400 in the SAM format, see the SAM Spec \footnote{\url{http://samtools.sourceforge.net/}} for the details), as well as reads not passing quality controls (flag bit 0x200 in the SAM format). Finally we also request the read sequences (a.k.a. the {\it segment sequences} in the SAM Spec, stored in the SEQ field) via the \Rclass{ScanBamParam} object: <>= flag1 <- scanBamFlag(isFirstMateRead=TRUE, isSecondMateRead=FALSE, isDuplicate=FALSE, isNotPassingQualityControls=FALSE) param1 <- ScanBamParam(flag=flag1, what="seq") @ We're now ready to load the alignments and their sequences. Note that we use \Rcode{use.names=TRUE} in order to also load the {\it query names} (a.k.a. the {\it query template names} in the SAM Spec, stored in the QNAME field) from the BAM file. \Rfunction{readGAlignments} will use them to set the names of the returned object: <>= library(GenomicAlignments) gal1 <- readGAlignments(bamfiles[1], use.names=TRUE, param=param1) @ This returns a \Rclass{GAlignments} object. The read sequences are stored in the \Rcode{seq} metadata column of the object: <>= mcols(gal1)$seq @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{Compute the {\it original query sequences}} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% Because the BAM format imposes that the read sequence is ``reverse complemented'' when a read aligns to the minus strand, we need to ``reverse complement'' it again to restore the {\it original query sequences} (i.e. the sequences before alignment, that is, as they can be seen in the FASTQ file assuming that the aligner didn't perform any hard-clipping on them): <>= oqseq1 <- mcols(gal1)$seq is_on_minus <- as.logical(strand(gal1) == "-") oqseq1[is_on_minus] <- reverseComplement(oqseq1[is_on_minus]) @ Because the aligner used to align the reads can report more than 1 alignment per read (i.e. per sequence stored in the FASTQ file), we shouldn't expect the names of \Rcode{gal1} to be unique: <>= is_dup <- duplicated(names(gal1)) table(is_dup) @ However, sequences with the same {\it query name} should correspond to the same {\it original query} and therefore should be the same. Let's do a quick sanity check: <>= dup2unq <- match(names(gal1), names(gal1)) stopifnot(all(oqseq1 == oqseq1[dup2unq])) @ Finally, let's reduce \Rcode{oqseq1} to one {\it original query sequence} per unique {\it query name} (like in the FASTQ file containing the 1st end of the unaligned reads): <>= oqseq1 <- oqseq1[!is_dup] @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{Mismatches, indels, and gaps} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% Because the aligner possibly tolerated a small number of mismatches, indels, and/or gaps during the alignment process, the sequences in \Rcode{mcols(gal1)\$seq} gnerally don't match exactly the reference genome. The information of where indels and/or gaps occur in the alignments is represented in the CIGAR strings. Let's have a look at these string. First the most frequent cigars: <>= head(sort(table(cigar(gal1)), decreasing=TRUE)) @ Then a summary of the total number of insertions (I), deletions (D), and gaps (N): <>= colSums(cigarOpTable(cigar(gal1))) @ This tells us that the aligner that was used supports indels (I/D) and junction reads (N). Finally we count and summarize the number of gaps per alignment: <>= table(njunc(gal1)) @ Some reads contain up to 3 gaps (i.e. span 3 splice junctions). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{Put the read sequences and reference sequences ``side by side''} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% TODO (with \Rfunction{sequenceLayer}) %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{OLD STUFF (needs to be recycled/updated)} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{Load paired-end reads from a BAM file} BAM file {\tt untreated3\_chr4.bam} (located in the \Rpackage{pasillaBamSubset} data package) contains paired-end reads from the ``Pasilla'' experiment and aligned against the dm3 genome (see \Rcode{?untreated3\_chr4} in the \Rpackage{pasillaBamSubset} package for more information about those reads). We use the \Rfunction{readGAlignmentPairs} function to load them into a \Rclass{GAlignmentPairs} object: <>= library(pasillaBamSubset) flag0 <- scanBamFlag(isDuplicate=FALSE, isNotPassingQualityControls=FALSE) param0 <- ScanBamParam(flag=flag0) U3.galp <- readGAlignmentPairs(untreated3_chr4(), use.names=TRUE, param=param0) head(U3.galp) @ The \Rcode{show} method for \Rclass{GAlignmentPairs} objects displays two {\tt ranges} columns, one for the {\it first} alignment in the pair (the left column), and one for the {\it last} alignment in the pair (the right column). The {\tt strand} column corresponds to the strand of the {\it first} alignment. <>= head(first(U3.galp)) head(last(U3.galp)) @ According to the SAM format specifications, the aligner is expected to mark each alignment pair as {\it proper} or not (flag bit 0x2 in the SAM format). The SAM Spec only says that a pair is {\it proper} if the {\it first} and {\it last} alignments in the pair are ``properly aligned according to the aligner''. So the exact criteria used for setting this flag is left to the aligner. We use \Rcode{isProperPair} to extract this flag from the \Rclass{GAlignmentPairs} object: <>= table(isProperPair(U3.galp)) @ Even though we could do {\it overlap encodings} with the full object, we keep only the {\it proper} pairs for our downstream analysis: <>= U3.GALP <- U3.galp[isProperPair(U3.galp)] @ Because the aligner used to align those reads can report more than 1 alignment per {\it original query template} (i.e. per pair of sequences stored in the input files, typically 1 FASTQ file for the {\it first} ends and 1 FASTQ file for the {\it last} ends), we shouldn't expect the names of \Rcode{U3.GALP} to be unique: <>= U3.GALP_names_is_dup <- duplicated(names(U3.GALP)) table(U3.GALP_names_is_dup) @ Storing the {\it query template names} in a factor will be useful: <>= U3.uqnames <- unique(names(U3.GALP)) U3.GALP_qnames <- factor(names(U3.GALP), levels=U3.uqnames) @ as well as having the mapping between each {\it query template name} and its first occurence in \Rcode{U3.GALP\_qnames}: <>= U3.GALP_dup2unq <- match(U3.GALP_qnames, U3.GALP_qnames) @ Our reads can have up to 1 gap per end: <>= head(unique(cigar(first(U3.GALP)))) head(unique(cigar(last(U3.GALP)))) table(njunc(first(U3.GALP)), njunc(last(U3.GALP))) @ Like for our single-end reads, the following tables indicate that indels were not allowed/supported during the alignment process: <>= colSums(cigarOpTable(cigar(first(U3.GALP)))) colSums(cigarOpTable(cigar(last(U3.GALP)))) @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{\Rcode{sessionInfo()}} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% <>= sessionInfo() @ \end{document} GenomicAlignments/inst/doc/WorkingWithAlignedNucleotides.pdf0000644000175100017510000043060612612051202025351 0ustar00biocbuildbiocbuild%PDF-1.5 % 46 0 obj << /Length 3074 /Filter /FlateDecode >> stream xZKHɎ U va7AFmKnh"h{-33+_f9VQ=J/>z*,T%U^FEQ'FW2z7\n\-|Qz4+A>K3zB`W7ॼi҆Cۛ_+^ |as{- >0G~ԑRI皸)UTYT07s]}%]0'? ZgCFe-ص?Bܱitlb}ΊY>Vo:0A,BymF.iNCZlI-ZkhٳQ5&t1 ouu}'O0oc- gp;bn3hxc4PГ"7&VpۡPŻ1TAVW9 'ο 's~ 8KAbtȷ&jW2} ~C:JgI K$܅n v7dC/Z1*4a 8#f ]d5 y`Z?Tab?OA o IfV?BY Jz]ނ Ca)yKG겔l! X a9@ɊH1@*Vͻ"(:' N l\یJpaqO7 Q.9 V%ېZk}Cpe>[ Od=|nkz@:",=>`!_iHw[{jj+HȮL ;Uc!95t밍G`?WQ.2N]$/ս%> (WJlA0ꩺ6>L;ߙ4\.RL4sy8tp;ϗAr?:S&^$B%Kl#WN|;Ꞥ؀zCȶzLoθ/.8uV$*TXpF<7 endstream endobj 61 0 obj << /Length 3832 /Filter /FlateDecode >> stream x[[s~`B3&]=ZHv,%@$$E&@ɚɏ $(>bv=o.(x\.t1:E\̊8F]E]D %\W4M;,XQ3+h7v#;1x1pqJitֺ.uq3FģvH:jC#(PqtGJ}R/)4fڷ{Teۣ?0dɊ4Rᘼ050"D1 t kf韛Rq6`KTY)<j_) Z$ j(@Z~`x:+u붙Ly,@:w %Bƈ1QټݎPA!ru]X7mfq!ԛD@$l*B8`Σ2{ yIE֠6jFNcGqA4w%In-ҰJTAr~υ. ~;xd2N2\FdmY+L_Wg#Xk8k]_fodmaPPͼ/c4:j0Ӳ07y-#;gR㐻! @yЁ]j0v<[{% ][9էeXũֈZkt kV$gklOb }H}rd<G#ocɱ#=:1TCxiNz|*/=D7.}|,4. De o;2[d{B͖XV8ЎAAڅ4{덬ڠ64)$AC3kO._dUbwi<1Л}YAg[BmLzk͒bhX\`O-(+T*Y=ܾ9:z`gE`s0;+~kޔ}E0c%<_w3I& 4 `0e]X,4&(TxެNlks\D䷜nRx?40rWr'-1x0$hBJ%ު(a?a͝YCm$LIцSQˇn08'2}hqx+ua>WDkM r+TƪrB6ZN[|6[EemXtٔ +շyj.3?}&Saz}, `}zX8Mߘ)ty9M9u*B<&`'iK̝y%N>g:Vh>Ҳ sl^} !U7+s -@(씋3utg68pU$h'*"x^PLPL F&=?'q$\2+#͜Po`K(\N agJs,FX:L' %Q֡IE]i80~&|Ml ~'  ov}mӊ@gFΏعK6V̠P蚻;ZEgRMrBwNIֱ۸ ֱ+[%$%Ho`Kl/ny2BFro(}.uvھ21iwFue:80BV,k'O*9 oWЌ}m ,ۿ+z`WSg:YA(ʇNȫ W#D%_:*fdz!P2Q:;<^Nbq2K R]04B1|?BwB) endstream endobj 69 0 obj << /Length 2944 /Filter /FlateDecode >> stream xڭZY8~_MMU5clI$LkkԔcM_)N*) jΚٟ_Ѭ ,f,͂LfȂP?q1ߝ|?uE$/p-o:\Z=ȷ ;eW߇i<~~oG>sq?"YR̓?B -"A/8_)K"G_咪CsE=$ϩ3ZRO\Ztux3Zzo$?)J4DR#'N-IQӃؤ|((TsMܬ9K.zE #^rkPh\ZK1pGHA}a%}.OuNaf p,זe'ĞtYr,X2eX=u`ki9K;TSRZp}p{W7^o1e#"@lG@+:% ݽb;N<G-]z[:KW67fxxB*-EBP{ c䴌@I;K\( JU&DieA1 #M;MȚk`zᤓˀ< ]вEP8t;Kq7sFahsmиp a%)Bj7:0ͅ,W/0VEԸ!Ƭ f@0*"Bg<74)V8QB-^T: hߩ=|B؋лKS~>q!m G8E@т=a?nc fG^4A>,3u߾]Ұ[ ޑK0oC43pȯO=ߩE.v;ҙ%'Y€p9"m}`Xm+"Lqp/5wCW\V`9(T`<2/tO\k ]V[6[9&$y/M7$.6Vpy;ױAvDFa #0B/*V`u{ȭS0lD О tdꕀfHW  I&dDz<Ɉo0(x&2n-Yoi뫦򼫘~z.yM3q޵gM&i9X^1l5m^jnN&n#ƒA;_ud#/K.W]:*FZF?]j8{o[*F+}鑥8n㮮l]TGtԎB_|~$D,2HJMd$ UaB~Ac30YiOA[N^^Q\Xtwverg/ڳ?d!E|qPl9{!WP DYY$s|- &l2,M~о4N7&u9POkmi&sLRj5OHUXî˫I^mI)TeGIt\rԴNvnDa@:.kPXAˍ9@L?Q,GF6.uYlߩ8) N62^,F$RD'[:eבEՒ &B P`"1ٳzh@p+P{ڱJwTk+ }Jf {d+nɶK:9:RCF |DQ2\3d;*ein;@=5 [߭ŖФ-#bR@goeS9cl:ϰ$'዗*a34:g*U'nͅ~DZa@@W&S1gJCt\8t`@\5ep2AԾ'UXWWwB<U>L v]^h.*IA @ *M%^r-j[rl1(Dpi[ڜrMt} {qt}|ti1#ˏA7R)ْb:Xg|מ w>urNzihSR$af[x|/L Rѓ2QD kfޣ 0p惫FA(̡^ecʀ{`bר'÷Z"E4+EPFf&s БE 4\1^vJ%)$TOdYTn?h <[T^W*m*]+Si@Xo:ݑDGM;b٭uhQ2l/ܨXu|d>]\4jVܙ", ceJX"d8ޠ 7O֌=`ȝ:l2_083p2';2U;OcflOxhP3+?oDdi46ptF;GN}aN~@Td3&=?m*>z endstream endobj 74 0 obj << /Length 2348 /Filter /FlateDecode >> stream xڵYm6BW Č(JU!iiK-z@ZK^;47J,ﶽL3ϼE/^=>ItF6lf4*"x=yMGqdG۱;x1fFRHQ܋9h׊߄IHOL._s_0A'Qlt^~wʞ`C0XMmƛxDGPy*=z6q 8 sj:{1MF+.^׹KR vPE@IpAe\+y֝ t?"Y>:>'xІ\JiZ*ک@䥴Ϥ=v&^H{,э{q"c!{ J1;W,Jʴ#DCbǒh-.rWծ}%m=Wpg|D_{]Y]VY1cR*"Tņ+nbωc&z;qj&ڜd%E)Sx.>8I"߽`╱\e_Q>G<6R{TN@6˪IIȩѬx}7aa/Fvf@B1"S% '.p_ә$}`ƥ/+)<((-: ۸SnH -rҬBSGQ35&@s'DNx㰫8/o˼.>Fr@wMCL06+ !ҴL-/ҍ*zJ7ڨԄgz IafsNޝ+qO@MZyg2DGʴb QglK,ON, d Puz> stream xZ[o6~ϯlxXt6+bkxCl r(RN @(;qp i%h fa٧_CZ ! 5”)az:_J̦}mǍovh޾0\;Ӂ s%+beLM,gR{0V`|sew 2SPf@Oki{_IE/|:Ad~ݔ2ȔM![uUoCʦpu'25^I/39rB{m8fĘphZ4{ۀFLJC&i+ 07T{E\[(֢Gk]#I[<~`SS]@{a ymlD-}>z4ّ4^`HtdP(O2(AK,ԠYm0(x6 >y> m 1Qy c([dF,';}SwoTLÓV=cLmE0L;AɦB8B$qz')ѫ*>]@xpL'R/9ur^%wp".q,50Zl̬ Ĺ=Ҍzh# Rgxt iיpV> 'uҝHi;Z`~NS)Q R+rN6ޒ)(X^-W*;^)84(-ZIzMʚ/ p cP:t7hpZPQ~Ƅ;T`R.8PEMV=S5 힯]ݒ?꘦:sis\'fE5|ǞG!tsxYyV=PQ1(H"]c ĕvޘګk<.2$*^&օ0Kɪ Rr;#&X\Jw>%+hsRr㼕bUO8,`Um.⸿ne2omGH6 5lyV,vr)c|q[&FXzuS",9iQ#5'IM"Qٕ4dLV}=&[펙h,mw~G&IݧmO)6\ w59`/%n4{2'P6cNҠޠ{f$0\w6 0Na6d|'= C-+3w+QA< jGևZ_«gZLi~Z}_|Gv)'eq}:Z})(Zt#N^ o1w39!{ǦڇxO;Hzn:}xPnq-)~n)|]3'_?ܖ endstream endobj 82 0 obj << /Length 2339 /Filter /FlateDecode >> stream xks6{~._JD,N{3휓];w3I&a"[*)%})Ȓ@b߻T2%g~xLu>X<ΫtT _tT/!3v ?8;_m`ݖ_%YBF9 ~p39D<-|\H{RIlMRy7lL,cф7 xV|3d:Jn|ȭz*pq#PM"l- rB9Q/sxC|k :tPE\)_{{J+u5k$Ф^͡oWbklx]wr|(3y|[ $GvNãL9tu#T͊[}myx*t QN0^ZmxitWI Bd\6& ݬKfJ0@%`Re5qb$W +;>&( 4*cYC2(OLGS\8Wb_p*:0hSޯPXie{țge2CȍGDjΪXPY`GU $`K}x"sHR"ΦCi%#ūL\UyR3&ܡCJbuL&zF;1<î2hG7|MGHMKE)>`l3C}-4.C{?lmJEe YX2#[+<)Y"fe]&f UiVd ^dNz!I 5LTq*Rv{ _?͹Oz]k o9\b2pSF8teU쯋5‚b+lX; O7h !8>L N"~9ϋXA?^zK/tܢ3Ζ ;њ&> ZR\Ĭ&g!^řͻd=㼒_Fl虥T°c9rk_)C< cqǧ^c̃^ɜ#NT{.<=L_. a)TP^}aw> stream xڵX[s8~Wx%2 ! 6!C2L'@BBHi'؄ve;c|gΠu8j9x=8D8q(5ʡl"g{͵a]ʼ D\99p>x;n܍ҙh@ 2_qqfΥwIg{@~>z}\Kb=^0`%:EsVt`(Y\Q٧z=TZ!0.c5f;Ty )S!#~rf4CfP# Ncl򢗞'g>lȭ΅ptMY09rÞ{4s`ଥ9/Ȑ [ rŔ\[h&XHSkIƷ"|M~kLIZ?CT1h"س.nIC1롲1ڇ ͈݃3Rm0❂W\ EYn0nP5̔oPLz`[Z&TYE #EG0L(cJf߭RAm,`. $T=(=߭*vGg۲;鑶նKB%j]uR*~@E\0^J&Y9 J`dH~iO|KRnoy4T5O5Fl;%X+5-AvLJBt_Sà!wU2׹Gq+Ij.H^LlI,.u>'* 'b9z! LJQ/LsB?2/},_ahRIw#1Id&q[&x6}Eqs[C 5]Z& CZ1__p#ڦiAj(t1i̜y#<'apզmH '}@դ s*-)> stream xڌeT-;wi,ӸC,Kp` kp }{?` `VժYGM$flvv`bcfH(i(jjXY9YYّ5m=4H@7w[g'H<2I3@`qYYk4(1䝝H.>n6` 08@fkaP2:-@qA+hlf-L݁n@K_i'njD дuJ  l-NC 'KАSmoF`cfN_,,]̜|lV@"#/C3wgy3O3[3s7H9'Cw 7[wfw[d RNΎ@'w⓴uZ+w흜`+['KRh9ٺrȬ.VVV^pc _$>.)sqvXSZ<70EHllK[ 9 who 7[o+xx,|,zj 'Z\ `bp7IUl?9Y9|?A/3x?[`j :y؂;&iÿ,hk0su xA%Qrmn+-mAV ,bNgc]hjaao; N@Ugwۿ. Kܴ_V)' g˿6`f 5v..xe-r a rsXqX  `,R#V`,E)A`>?̧TF`>?̧ 0 `kf3Y9 p#N0-tVX 9utvp0s!WxQ>7g[ BΠU͟%q?,2@pv2'fnp=PH|39weq#%5إ )tqG}/- zrNp\@q'Hp\A@Ks؀*8z!_,6n?)U.=nL\l@pa@v0ϟ@sϕbr_?/Kz-V-{Ĉs qkݿ8 w8x$U'l?@+ACF&Ix2cbE`B17 *\"N_~(8*{A^sG-,1DxGDZSRrHLJ+C?X$]hT継'y}䶳^LӅaqTH$Ks"*lzD b ioV)xpcrII;x#/ypEL;D+2ٟ l?#s/ؤQy!uc i4XS^Ȉ "90g`fPB|0M=q(%ii杺KRo1>kuן2z苢)ZTVf|XY,TMZoÌ-daLe4?[Tc&pqX$^H:> ET65W0/v䊚VĽ>#Lb86Mj檢=}3:qJC׺c1e&`wpQDc}!'+dqp]PXs$k% [7g|G~ "%__F󗚑;Z\nFJN.mQRm}!)3@{MOF%pbjk%L1zj\Toɩ_mҖīZTKs5høfa),&!}ݺ $^j),859+`tɕk@s^?Xqf𧿃Kqt2rl_^OI ;i2z,gPÐ#W$Z6LjI OQ5̻lQLq9rVgSj>^i,xE՚=5-BH |kD`gL+=Z 9ezzw_%򥜜r2W<()Pq]waT3$f[dWs,{1{rQ:;3` nY͏cR&r$Gv,qOrU9c`f=[g{ R+JgE{莩vT1e# ԓoRϝYg&s=.8 Sf_h=_ԟ8PayMDYANR(M>3.[r\LF>B.Fk ЫJ*憎Xhэak,fT96QٟҠ$h O}y3D 5ƬHm+BŨ -NZiʍ=\3/:W2U8}Gc4נ 8JF 7%BuCBԿts\͔]\x.vB390M#ݵl*MV+禎u+HsVGgs j3=# F˾5]QOykM|]cR)6CZ`䨀ZC=C?tS'޽)jKvFhR.\UaC-~NV}.*S[2fMY?<<مihOtgLywHAa]{'h ɲ&5#M6DRfo lM ]ikJ?wJޮ%Mq&aːUըfW߅ t1 r.`E=Ԩ:c(5k䁜Q-њI#T&au圐IM8gLw/7"=/2Ȓm:K\2dzstZL},1KT4`_3XWxt" 7E(l0$WJ'Cم ~0Ϧn,IM 4t#UHG޽:QtHYnDB;#X6'<~jD>"_(쮑%J9%.P1²3]֓QťEϋ+bljV>'I}]3j^0. x#"2sRynܓz~piÍF+YɫT#]DtĘ%jRr(0̑.""'8O߈□ֵH>) Fm_R&1.S Ж}`SQճBrs}CCxZU?`vfe(vζz|l5+ʛ2\Y&+ x"2R^nwmOnz%q4o򫴴W|Ǘ1wXd"XCqj6?ZG.VbٔKD ݻSg9^?mߢjBD; k(:7&n R)i6(DzjS:K dx6u$;DW/=8d?d"ѧnW7%7۝ASG<95 ܱz? 98İý5[6e8C,ok -v*28@WØ M^xpo >±-,y 1%o*'0뜚\ ^-P*}g[+~ߓ$=yЮR<En@Y՛5nJj}ǀ=|~%(z&eJ,{`S}u둡ηzz|ⅥL&9oBYZ0a1-:LE=Qc?4?CsG̰4a xOsO yXPxҪ^[rvd`Xi}^3jvҏ1J392,\mޱN E6l呡%mi^ϢkLK"$,G};{cc#}?( mSIEm؆rr^Ye9[^lHJY"P}eiάy񎇕P iLBJ1[&;OzX0/|ѓT=/8yfK\@@=wwd5ΗW̅9A V稵7<&Ke~6brBJ|LW$s e"b,0#: f/m h hث2:E+zj\l|o1+v$$B '߿9q<0~j;W,]&>M#޼5m߁ވ~sR(o@fFKv!\)K7ݟq nnL?̹̌8qNA3Mk>_ixw o>[zL:Tib!y"ȬT#aƝY|'>d>u3Ob5,ș2AА a+z Z:`q◽~I[% kLXȻY,ѷhy[3d(c ["S:Y^HP_3?8|_rCt&4J5bt_H>Bk{!$Ñs&버 ĤEJCe<5dGU[>&L`R(R 2xg,>S@o^g\hQx"&5$^8[bнr{Ĭ3$2jJ}/V"dT~]/~CsG$Ӭ0Z)cc+t5J1t#΢.TD{c`|) fNJ2u`"qҁ~ʥdw-{:ﰠ^Ff`z^&T Ȟ0R}lꢶ=2,ZF3i9HYW n0/&> iOYSǖv;;!;Ti-wn8aV3,RB; dUXeE߇i.LHB`ߠV:v4M7kYmlQԚ(daft5@gIïW`m.$sB'ኮ<5 ^͓QS.ʧ976%d~" DqeܣTϱsi9 5$I#[L88&G}sӆIΛ} al~2ʷ:3ju}N]sɢo>įzW(d dsE_ !E@PF5FF| ?'[CRW\K\wO2lwsɃYB&RFoAS d2JUiPT:5dĴ}ûEB#CvTS¹P/x&+,}fͺ~^ztn 1{2{g,;5=Ǫ^(dk[|Xۉ_UEԙ:5=0Iœi^!?fI6ոc;Nߵ}RZu,{Wj_$! TFmoq-0mr ޫjI"5I=M'{Dh~@^-ܮGV5<*B/p<%wK]{Efq Gu8a?Pr#:fXwwyP@߿q^ x)>G,94?vDoDB3N2k?K<ӛNL)¦"c S Nk:$DrSshQ0C.hmHU\=WpjFo&saꗮR1[XR.ÈEzG-\! 0"Yߪ.K]P2~з  mFVph5W#UZΓ^7Ҵqoy.tU\A-XF1)>ɍt%/UN.v[܄bٱ'13 9&Y86/n_j -si[Nay {4Hd.cW"Trf P:}^S-Jh_ڨ+ХJ) E͎߱eۿ?ф=˷*^7G&6nO 60,2G']^=ނuꉐ294x4cSc6pnClƕoϤ+ϗ;"j.9ȵ; n#Us7qSNY'b[; rXZxdqLˋ|X!]+Q.^X^CRgưC6.54 ll:2d;` 1{}=J#ޭY]^ژP4G;o9@~Eky@ǃyy=eO< &3GzLMJ.+>p RqD*^a^:6+h>?bF#HSvi}*~!3q9 zUby`_X!G\5 Y2Hh%ڮo-^R}'zNTCMwyK#n=UszcUp6C9dVsƬ#~@wa9E6(ٌ 0os.rF 7*XoE 0`-HpzH}Z\v*ZZ2")XtpŭO9<5/#Ǒ( XSF<8bI-=۴H.hV$bچ3~Lg9XEce%KPK`OSHb1Fծg8i d e5^8/U7ϘڭM(DPMSEPtw$)l=>M~)_qiE~XU(ļݾ|]}7dHVYU^_QV$9f8|& +1lDo2QJUPkcD2E~60TKb}}kV9咡E?%m3KMiљTcmRs{ HS J̳Q\Hɏt-4E+ō17b$v{1 ~XÆ,Y=dl#!'.Q '*kz}"7<~Lt#p ZqDXs1R/)H_",U|j)4&φB.}{ȗWS}iAq@iF0T꾩lH܃oI˨nSkƈtc/mr7-_XY3NAu`yF;EMpk%E3"& PeϜ9ݷ%թ(lӂY*qfGġn F!CKtzA䡶$MNq>"<(Ai9EPHX=Z"*0PHzTIƵOz߬W%%w\_q}CYr4Y3`yQ{G+Z+zt ewfM0[ f]ЯyRl w)LA(z.ǎAyI,jXr]"CLsݷ7Ѵ5Jg~@ޠҖh(S>-:䜉vK174nKolP +!Pcn#6lv"% 9)x*Ҋ *e`9v K23ygV/3Şl>=FA%Tg['AQ`1I>8pu5TcpsܘMmo8!q2el=Mq<" "-)mrqfv;n!ߟ)+>_nE͑q=H@q %v>G6ә }>ײx@EMioZ:vr"M'hў|hu$W#MC =QޚfwsN!XZHWG҂A9C2?lu\#Ʀ,lC'[~Z)͗ GX!^p!$&~"3B/祶|cƆAG"~-eꛨ,?݊*Y sfܞ;Am#(k]9YEe\#ˡW;9$MnXP[ ǡJm?{PQ q4W$%Fy1ѧe(z3"󂨏6d_ّW$9hbBbxfK3 Zد+ߝ(#<8e,p=&ȦjMDNx|3E֫1}퍌I(#5",I]!QWd4j4!i_H+|j^Crm1[ʇ[Jtp2CdS0x.9@E":mU,0|-X\} *We^;(ON_?)DŻrr~N QI+p7X!j ^M0M@ +MؖE^%2CiD 'sh=ҷ:i UˎI{X_M% F5a(8Ň_ft. CI;6Nmx [+w, PXSFMcJl⠮a 2-P w|JTt!_nLtjRv׼Q~-0H1OU~v=$\:LA5CR 88y}ex-}3>h|n^D|"*y )W^(\KhT^\[.}8jA,mjÉQ2}s=oI^-P'3f/!ROx =V [eUߕډ`bG໡eF|maTԄ=HB#]zo6Gy5F\jPX?taf ܆Ftύ)( šq7(S 4ꙡ^6O)-{Ķn,) m~2#>K@AY6w,V4 ${/'%n߽!y "?cfKhE?Ҕ 2ڐޔ 吣iUc!62#^{<;GN>mvaMuo[G~~*GIQqv [R<(a{G#" bR֫4C)lʼ8$B;C݋cMB]K&ѭB׀IŸ/GXmBߘ N7=9ȡyARp&h-c^&H2M)3f.ءTqh`=xRA}Tp: -&%eojnʱ83QLa;Pc;"BqxL<@:c.獱] k8jVsh{3-n߹Ɖ1jul [U07ӝא3I'4wcK=ǻChW[E` M(,HV9UWdfDoFed+X?diJWk&Y%S9琐[}QBoP>`蹲F14m]kH'7yekQɆfڪW~GRnl啥lfi c(s9ǰ)_%n1ה1 A>m38zm(SMwyχt2]K׼wƥN4=/m6>FLJ ĮBIrw\Urjdw%.$FeoZ؆zӔyĥ'Dͥho2nt!hU/qv(9:pfYY:ܺ䌕M|axx᪊xwDպ'C̮^ 0NQ4r!}67lu4}Q\ *VZ%4cוMz w[Щ;žZS 4} BX١`\VQ7\Q% JP2%zBP]5}㓏Z8091}eb"Ӗ#sX[ou/v9J)!pJvІ= If< ޹=Rlj}9ܩ?՘oo 5?i3ZFcPW1%$,?;jٮ0+U:GPu[ĶF 46:&ߨ Jmu" %/JpԮ\[;z,%31dX4>痈ف"0RVr\Y,{1u~u\l\$!.Ǧ.5+$ٷU9▌Tm<8MAN2n2­+D#4FQYD3뭂\^WM8(-V]$BN7#?ooX]CcF+ܐ+{Η klmJcZȩ:aF<ʀCݞTTQAK}tfI%dI_P~:qsxTG?5`%:@t/QVz"ب]U)}@ &ܗhBL)6Ъ=@y~|?t:ŧa˼؆ 7̒=Ez4'dr((&c[ܪfcyQl8aC 3^ƛ4eYI^D^db9RiGv6e/}v Y'oѥ;dҺ'?Q;}7k*Q>å69 17Iƭ,)ꢲ`4g ~0uMUAiFxՁZ本y^&6zCaJ2ThtH* 6.G WZ~[^K95Ҁd2OfŚى~ˏ}kjc{ֈaM|]LD?+ + 9gWw[ԪjN+X'_rFe(! endstream endobj 102 0 obj << /Length1 2571 /Length2 13813 /Length3 0 /Length 15263 /Filter /FlateDecode >> stream xڍPm SܡV@CXq(bݵCq?fΙ$nn{_BM,jhrtpcfcـ dGف#GwAdnCEG؁@:$L=EZleW9=_Q{ hf 0 7 A'hbjb%LY@ w%S{? Q4V;Zy qqw uY 6` ;_ΦN`+%PR`qrc:X64suzL J % 0TO}.`'7WWYYB;? wok?`a w'VM;HV @2fMR;'G'% @zj_@V`?!b1d.`/>~lB6F̪$#OU9z1sٹ>>>)_RS?P O,? Jul hyc|oGݿt6ћڃh(:B5<+,W+f 9"Vvm$U P[{3Hx;H0G9t涐[2@3;7 0v..;6)yk,nxljn"%۷Q|J* U ƦzT}\+ >҉rX&)BZB/A{rP7 s?)[yOQQ(p3/ܷƛo Z}[ 7\0ZjV+[z Xk1m蹹N_TQI} mE ]TV6hfce4ص`c"cPuB_K7ΰk ƌfeI0N`ÏQ_N:LZ? JzCGl23zn/WXS:(ź5 @@5 +޳=ƐoϩnkW:X~HtDsQf_kI&S9wtI톟!:U ى]UT[357NM%ႈDk nOKԓe!_ld -K;1MU Sh1/?CGTMdJj}a5 "}o\BR}k&DMu(q9ڬP;SQK} MLH9|XFY촹M IyaL@Ғ-A[; +Cy.Ŏ#{~2Zx2JECg]@*ް@BdWZ)D/>rYѸ7 ԇ;DGknȸQ./ ȯ+Tnqj$I(2QcY^.>?Ʃ(WY9_@3 -E.0#tdۘ`$oQoEUJQ(/*} ωU([s| Duͯx##xߪD qX(<"[޷"'2=m gmuE>쀉#tD]3 mH \Yp!tO&Y]aJqAt`䢫7E4d;tELzKj["[ ,/DfXU_RkG U>|ɴh+ ^-6(g:O-ʁsp|s{ ``ݛ^?+y /`˶0!^J>rHߗ/ l%LoDR%|S% ή'u'G r. d.oC#F Fi{+5"pB:^jEg$c S9<}o%] P5wZ^˯HΛQP8NnّVb e狛l ʒFo9Dz9ݸS, w{XjJS0L# %~ .=:;*}s\>@0(E8XK};#~0ZGCوF79.G9T1'ޱ\*o{3Z8щ;ݍu%֓Z=)Z?HS3d.r} еy>XiMF2])>FPY~TaFG\g{;rI#6FQ1 V5mdq9mUn;rC9=ɢ!QVG6(xR{ZRKXNR.٪ VMG;KryI.>aˏ#$p Cgi1UGg@~ܤ _=H#n(;?h7Ԅ *Βdʙ;2aǧN6.;&B*ƕk!iٜwn,CI5_&fϺ8sU(6c~ɴ$(e;cryzԎD5Læ7܀P}gR?$1__643 J8P C~~J_lma[5A8eIk ZuT.ddU`^,W@ݾ;Q^/R-e 3&m5/@׹%wcmnjMfTĞKbv6SvNV :&cÈGmy%2."WxW.&ZN%DFӼ$u*|kjT)Mbu3ɡm #F\ h0+ʜ [~ƨ#samco@;0HNdJ4dxAQQҫJ&hݜ'KX\tr B}n*Xʟ!$2 !5r'])tkCaU@`@1. `]|jmvu# 6M3:k7tQPʠcrgO:eȓKR67jv[f%bNr"A:IxֵQnR#ǂ9ףkܮg~sv:-!V ?V/*"h 7їhmWQES=\g&3)̇kEɆaVb_BNB0 { $GB'xL"?g u#{8 } ,kG) HM.3K6-^|OJmy ɟ0)8.ԮbD׶@vʤ4pP\@>< p/q $1f.*y gvU6`"q-G7(lҜT~V˂p'*fc@@_U5}FC3m1ӝhCrGteԂl62W g ųq}mz ӱwH&8L]${p q-pD S,w^\"3QoL yFÎlLz}v"':L1D]%wq\v)9d~bVpsgzpKL00oLoI!$y3pĀf"ݕ}c8*ʰ gv>a4I%h4=}6oB$>25'F[MOl枛cB_# W2zJX(~doƝ^ N 1d}Ơ{t3feaY 5dܓm.V[y44ڨmgk p.hWsPDIt H IL (XU%`aۅ jE G*Dۋ|W}| I:R"xP# L-+dm56 M"ȸ-RVM fGXx|*ςWe1Uy /R{N N1AJx<ě?6 +V)g}EGO(Dىv~)k]+HTOfJFU.Ox'Eh\>Fq'hMSJ-bӢ KtarIU,SbT+V ,\Fjuz[|KZA1)& c[S=(C]Hv㗵/Ih2/a@HD!>ֲ+g鎄8kNjh2"GAO2FBTdo(1XkbCrPl)؁}C0s1 7Zܦ2*Y*Nbl'Ļ͟4kĹ葳vCJC;[0"=?WZi.,b >^lj{%ْYy..4}\.eV.v0Ǻ}y/,{߽<Ͼ0,;iFDL#n$qGv%lה9F(kͩqw{UY!?yp] ѴRQtZ;?䥷RUel96VѨQhsYE Q/~Z0znr wLYef=TiQ1ϏKsOCrUXtA+;LME( ng0U4~˧K4rh@2c@oQ1=i~0JXSn4#n~~o%8/ž4EZ17ҊD0s)]ڇ/?ڟjV9o hF'|Ÿ}OO6-oVʶ-WSO6ǮCd}Zv`Q'aEdPirUqcb~"&Ǔ"ݭؗP涍{f.۷^ԇ H^"슡]rD|vԇ>L15S;k9[_o0K;JzIϚԟ yH:eiФyaTfdn :nABs0V犽 q_{ZCp:Ը%P)ÿGSlͶV OS :?%9i{WT :R6i|R+s^chy>Sp=DKǭ0hyN;WP,n baJq M|DM:~gu -P9i$F}q.9iA Мl羯.uF%_aOkkvTl%PXNرu` YBq6RYA{zK,"ٹpxujNMԡ0s (h$օ㾄iEoQxvF/c gAgm0l V*ؼZ9v*Ci 3xM+@ :EUuA 6X]< ~|`X\4|$Fg QX!6tMFScX-%S{[jd!w@NhUopc`u^H@#p2qִ=먕&iiq̃cvԀU[jcbzd2-+=(Rww{CKAY̭kWkܑx$T:Q+4\PNR"mx ѩ. vE}WE[fyyIrm{J: >hi%zּQq:c$+[7c c۪fU=4buGH)b:s cLUh* J87Esދuq7R>ks~AN }Y̅#N}֟S"gD7!Eg{S׏^5m#I{Ϳ俑[FlhMPC$Y/t~% 7&חLU1#=f]7ahSRŁK6aN hFGi-b OZ L׾nA1t?hU(z帺n41~VX}nZQ8 ȯ(*_̩`cw-{9KEV#sy561yHgS*..q2 d(qy$k9Ó_5eqϰUv yY.-yTrIq.ړ3"7[3u(L0Wqs r6pj;l:O9os0/M㍊Ӎ. 3apdIוcM[S+D(WxT>JЛe;#+qm5O&$E% ) ̺ FadP~_G|=,["gtsC J W]|{e9">j2C{~J:ntă tq\t }H虣2`%[FQ<8mS?b. YȰQ}槐)[BACOxܷ$J|~q؊Bnٲ"(mN [!SlEa%M{ FIl/3ɥ*nn~^sO%QܡDߺz^nVd{B~ vJh='>fKDi Q]FS>jYYSe9{-U|蛑n]^muSvH{wE5zՌL4OUoUJ_{Vy "rՇhU=Q]+ױ+}?ĽS%结Z6-{/.%8䝹̘:•κًj3} P"N F Φh=4EWGTec[rMÂ4PUF4J%K9֗S.WfGA3<.{>'8te@;U익#D2Y5i?ƦF5A,3cE2%>'df?i%cPJ#lkzѢ..X1jXIs'X'}\ASҊMYIjLs(=U[-"|6McUA*XY!㘷z''b^\wre:kN Oy#2F/7$(KkF%ݳ4Ț_RN*b_X͡B,`W'ɳbL)cc8߈lN}1*|+V|q;gy ~-rdIcx_CoȲyZ]LvS NRB]tpJMDmVt])*I_iˊ&*YIZFVUZ4J~rqDv~_XgT ,u'>`۬OH}[969@A?VCϻn|>nPT7穵Ĵ~b3#*½$4"&x(>lw u~ ~&,K݉q=[>]+^q{YZ#pFBoXPbmS([ۯ7Wpct<G)_cn\uaZG:ZbE& "#(z~>v]ї#$wa7<Tܘ A-w\)೯:pcUԠ<"K$Yh2OwJ~f2㴞GM(pjX(|BL!& دݏM_KN.[.لZX| 7PtKrJWf&9&x exB8AC69HrMQrTKպd'cߥg2Bm&ϵxe9D%ЈcN"' wQZN!"E>A[~ᇖ󣱫RP`CѬ eќ5jˤz<-, ƊoV6;Ote]Ydg2t# i[;lwMk*?R>'G='$. pt~sBD)anW򤓪*i6ܽ%A߳~n }gNj 1._9?!w=scxNxۥ *1QAtӣox?CZR:O)FGhf)SDvp*w̚u6}Q1 \_rs=;|&2O _}¤ʲʀKAv.PG-t ݵÇTJ^m]&(<ӠmTaffTOb,5r5#9 ,ܶVܿZɕ 31ny@ym\,/MZ7;g{ޏ8iMtD8zpK '7ԯL)b#a86=y؇uj)A.sfauB>euo[xf;OuѢN= KMލЮ܆ܑMcÝ07%6Me(K+$dNAkeR@n%Tׂ:UÃ(δcj E;k" qU=p3I)#+{{bH)9wN& %lFR˃z򝸂#Z92D)̎3{^;@JC0'gM?}9oo0CGll5; 9ۚؕdePCEBb([gwej㯛}^ G3m ^ ;᳌WUۨ@ ,^T%Ttd|hZy;ԭĴA۫IRs&* V>y3bU# qPHzz7l+Š9f,5.:\,:a5O(ᖏy8KRQM;p1wFOO״\ R$}_j2̯K%x6ppYdn}lޢ@Ю Ip^"Q^Z崟u4"y(4@Ui52V\v6iMۢY/#@wnVUҼtX7:?%3,{YBJ_y4/(q黆ƫD'p ^Wc?#N(iJ4^c=Ы^֋S({EЧ~u̐ 1¹|o2':q f5qKRapM{qI-r?1K Xom5icho$6?ei \ ֈOPI| J]iENJ.!gi/i.2keXq/0/(/skd35nĸS@9[%"ƭl QGZ"ո=^9HnH n~4$O 9NֆbQʪ!L顪ɝU=oGIzyJïV;I3(}7m!~v mƝ9Cn8^vP-d`~@lb婁g~Rm&Lx`'8y7 w1O{t9D>*L(bbMڟJSRsq*4-OTMFxD>**q_3.8Q h6n 鳓T'=Z^! jd,֡G6hc(J> :Pؼ^bSԲϷ i,oSnVr>Nؤ0 Z0v&e[uϴ}Rdgm],smbQ*C n}-۟^RuwI2iy`Lc;A c1s?AzbrSvҀVBFם-{3g}:AF뒼!k։mk=kד@99N"YC0XG-=ۏsZ3v ټfZSbSY*9:<QZ[e}"RxC'JAM5u *]}up4Ay<&N[j:즘]HxƙRjo0\P']ہO}TwW˳yyt[y2Kuү >pw^k:5hĽ:_b۸wR-ϬkFpۜ _ <cUmb⬙:%jӊ]Fh>,]y#9jʟi~Z@iTo ɁtBx>zQ ~)=K<TLP6Z2IguVC-^;, *i<ꑔ3O%"Nw{3 t|{݊en3T.OU viS:+5'F>Б?[xisgCv:ժ?s(։NMY?{ݿIc3`^Z0 rb+5;|NeNj*$]CX7f0%饋=qڜf 2+-:s7Pp:f{Jb@I :YoD"qUW-| Qoρa4B ˵vD[az{h# VToK0hޱ2f~x7et~}39|΃SUCN(E+˵q,ʁ,]V?n-q؃\q"mr-XHhc>Lń6'a]x!!Rk旉@dD>a$TPOTZ]ȵԖ6({_LzҵiH#hΐ+9ȃj^ & ŧ\ 9m>Bx&V4h2C3K>&rB ko[q/2g4+߯hTFD:+Uh\{{ZKL|IO˿Ue9|_\8f^i~BHK] _0q<{,Oq 1-:Y2FQc@-2!Årg[x"c3JמY .XzJq9ee{Y%8k f̢' 7*9""h#x(?vB4M3jM7j.kC>R9E. j(d~&&g| ce<>hv_åF6F_OttGRIjR j *2ANkS36TEj6MFlF;?z&xCPU#CVxm)sY%JA+lT S[Qԝof焦N} خ=Xu;8H>,ŽoFElD XFåPE,H%=/KaTkU~{.~9[0-B\ jw]E:b a{B@v_ՖXoEhe)z˳ g|Zaa0R hvK=,kw[&>`^u^QW6E4`\#Iqx$ endstream endobj 104 0 obj << /Length1 1921 /Length2 9559 /Length3 0 /Length 10745 /Filter /FlateDecode >> stream xڍT.LK7J3tݍ4 C*)-ݥtHttIto{׬53w7H)v(8y9 ==^b22CaN嘌Or .D W#(#$ x@y7 @<1\O̓F_nmVp˹:;C\`z@l}p]\}\FP2^n.Pw/_@a ?s CK y^9 yC0/+0yx` ` `ClLf0oG-oW(ee]}N^0@H@ni!AJۡ+@寭a7+|!oxw:z? =>^0jhO! r_ _; TBPS9;A] ڮ_7|l᷊'PA;ߐ .6_+ yx0  c\.0 ^s3pxʿ?[7pF"n0xL n ގ%$7_;|%m޿^S~CxvYA8_^oO_b\c_jx6nb<ƞg?o<<_jix “WNxi9_!qC ̹iW0Z Տ =0{GJ_eUCiڳe_Q5CPY=,:P]Ƅ" uLQLN߾̷]U|sDd (=ǧM~C6eX z{!EC.dbȮM2{{N պj‰ȈUisHU=d"?DTx뚰yi:{oHF :CDdl҇] {I<0y{"xtC#$R'TjMLB$>%)*K>KJ)>eU*!ަ֠aQ.ʩmOKe֝*Za.6[`pW' {9ַ>~kQ(bD>/\ĶҒ]. 뤃b.fsbZKB,>&iݱЂ"U]$dvjˋ/~Dv+^mŌd_/W8x|-q`VA*[# zr˜zQf<;>%fi .!0*g[ƩٞKfϷ2{9l=zM7y#(\-u_Wڼ?{SqU28Q7xª5YI~^gE dQEi=FX._飯#U(}/t0̣d$N#zPݬxJB5[#=>b}Ho=`6 !w+=:_9y1 B|LyCfat3xK|Rut5L9)6+y> jⳉv21SayJuҍiFHՏ)5i%}Njթ&{loBVlW "ƹ+7 }o)޼sMPB :,7 (UY[RAG ޠ8KeY,Y _\ʑ}Ȕt!V>Hs6=ȔZ Qxw X ވvk s'zz)7׹a./FӋ )Z@GMYSiK97hm,k|4!*UaaI-c DSgO$6=0hhR[╔(D ul6:&"gz5^d}ouI].N4č)u`ꎀ;rX&M~B_FD=BnjGa7#AgWÇ(QFt/54C:pM0?>n  XXD~ F9QNo+B?5G r;Uiz Fu83Rw|%X('aݏ|گ#>)ZWfr&_>xQRlp0{v׏Pk;'ߑ;yAһ['bٽu(h 6=H{7w͹86Fߞ+\(FRŻF:86Z{5W;noηJgIGW4hgkU)ːMt,$%SO*s<98:mZ>#g|[Su !/JDi:^X#~u*f}mUU yBA[>cM$Dˡ+$u$gvS5TuOc9 „> HpUpDh/&i;;񙨼er'r*AdaOtkq%#Eɑenԑ&Dޟ+]-4FU;J+Yh ~Y}D:599>2TG0} ,蓍9/L{,vJD~@!()\& Wt oYLEZs-'-tmK!JG1[NCjG{# '5b/g&k6"lwz{EYy''[H*F4N/>I^|c$Ͳ;TKŎ휿JLundR)ȟK  2v#3ZQ~XF vMxYȁ/9,*5جmu/ AJ_Sk.gp\^fMSbל .nIfcor QoNX哷;WfćZFˍ^ikŊTAF"^R,B1al:: ^JLnd&ÈQB*=,mEr?5@?);gg_; C]?p(5848ն (EkF dIwK1QsϓO*jV>_%(({;eB"1ϧ(x5Ӎ5·60}?[MVx*?e{k%4G7\Jw&{zgԉ6}ȭ6J;̈n9.`p)0gJxRa8I"h̻@+yqy'G y߶Gmt4^y=7M#-CK0 jTH[$=F\[lbn*f9b!<!~kX`NQlk&\`2OO.pY_$_NhZh: I<I ū{LD<ʂ~.AXC?>~O=[:\šS9̬ȑʽ@ʮԨۄrdU͚uR5MW~L(-^'rc_WE?%<Oz1oɍ2)q(oMl|32<UseG,dhh^kѡCj';2YJr;Mf YZ.ѳ@5β *K?Vhf|{3i5ld7m_\kebZ&JO8/j!!:j.MRgG,}$맙B$M4q<+h}~EVs"zE)!2$rAn[5.u j:h>a,Tzy)9jݸb91ۘfSV1GCvM G]3xf[I_w 4U!R{6sn4W8ʶLZ[IA@1B"H@"'OP㯍a6Jj [8Bi{/6J㇬m@Ns/2j @G>c*=: φ=Տ'U\?eKq=8top."Ki).43F`YkǏ U'yیIpNMX:@ײJw<]@nr"ctbNE)i~D L -mh\+cQ(:B1})Mn;R-Tq3PNVo/OSJ).? (p=̑o9ihN/˗Lhx)^3u`r(1`ŵ"gVNM+'HEgq(ޢ􊌃u+U ,?FqW జ⌧jHPC Fl(<e9tqRT47̯xs}ˋiKLm)K!푢 ]xiO tT8Fy@$}@=oժri]rf%ﮃ>7GNp:˶tHFCї#m~INY{h|#"H%Ї\DxMMy1eXxW0HIqʃKω ݫ  $ꡪ]ybd{bYo<Ҋȃ`+v呒vK}qmiL0VR.h[s۞[Os]රHݝ;M @oxKѐyhwꪋbJDPn+:?Z`{ӯlG{Uߓx`7  /%orq-AW1fL#jSym yvGAS\&n*Tt 6Ydg->Q>W>0U'_[_U+lm-> $~xC[*jt87=n]#V={pУ*6f9KmǑwԀTτ>lS @g8ghoS`bڄ59>Q Ɨżw[:DيWvƙHb H/wfzjfMn؎FUTOhdP=}%|ZђKO9Q[ o%}͓1ø%C /-✛~ .%z"׍:- qkTF4g; z#EjCBi5h6MS\cŐXC3u/%Hrt*{@JEyYGӰZS A#F#/eCFG,NQ=lxӨNNdENJH5^kP)Ooy.tljhQ* 0CbK3R쟤MƳaũ#)HOK9,Uk2q i#Q M3~TgP|fvF5<ѭ4 \郣iBזRgR i4Z;=Dleg.]~zѸ/*pguJ 'td$Z H4wiz-$^pT p@Jk|5^6K9=/ 7'*_VT,qg]%Z(fEjOG 5ZKaW!B-l>ZƇ!6v`ѣbn AfpR)}W[awiY:I!h1BgKF[Tpҡ;?gcvm,٬ԖQˌZv,In;D?0v[> `k< ҲAG:RR!Q(3B|?l];L:w7[_Rε_[I=x&K)&r}=R¤OA`d V/ >jPzv1:`3rN98Ur#O>Y\)W~\蟵, @ENY} VYMr>3zV:Ys k ԑ@n)&$j|--1X} q p]ܠDV/ =vNyŲΡ) gB0h['˖MgU/݋tZd"\51(Mhi#{{g 6 O >?7Uny$_I^1'Tl>[_-}! =+L)Epw yc666%L{0rOQ/gU1KԌ-YV?(~ $#$#00. b4zDԴCrN\<MΠ7̋PdkF4B|f !F,U۱Iʷ% T"X8I".ס3Y5w=t@hpDngsiAk٦,T(|Kنi1\A9FÌvC bo LwH*w!h\ߘ-w;ߣZ־\ZxR_ꍇpFL,:P~M$`VSG+~vNN)ʉKn̳-ݛ><ÍO*0?L"cƢ*?oyԡCjLSI2qf˄,Z $@T1e~Bk QPegFʣL2kQײQnGLdڔ258!ۅgjvmIS7dee˻7H^ҵA61'+q7Ps7^;N)74C O(ډE]R7HF}j|N=8QODd~ 2/Jqq.?ۼ[IFe~.hTmc0bhztԦFȧQ{1!E_cN3WdTz@%ҒցlL W>F+D֚rf%/'li{}e#8~d uGXډ2[y{J;OҚޢIfB|z˫޶#--eZ6'FOs]@(M;KCzbѕxLd;v]sIƋ-_5#hAoϣ$Hh%\4(YxgB2vJ,tsu& k;7&k0738<)}1D endstream endobj 106 0 obj << /Length1 1839 /Length2 9139 /Length3 0 /Length 10277 /Filter /FlateDecode >> stream xڍTl6HHIH]˲"%"t4Hw %9wݽf{gn:* mVIKXuadHjks8888t .vhtz`'g */]DUjp q qp88&œ2K*@ ;I< 6.s `18YHڃ  tO0 "6..Bnnnl@{g6# b;^-$Ԁ࿤tl :aV.n@'0nPgx+VT;U$jtEJ `@j ؁r*l.., h _!v@ 8ҁ9IM/} '33F_imZJPg_@ x=WPodZZa 8eMhm`//l sXe} V`35 ` ,(p3O ';>~_O% jiI2%+`r iij!;" Syx`053{M8x9@/#oeNV$jgOyŀ |5Ta/U>-!UtWDjmO#!rwd}v(X X998_:+ ?\`NHY(fkx@''|¸xy^-1v6(X~) ] `슿/]7F, o`9#~?H<'7J@nxVH;p c`~36ȿ Wpv!'W;;pv`+Vο.XxeN2&ër7:qcs#7} 0[۪MnK+-1!.3^6*()R斥DIߊލO{2\ XLTpy$۽&uĚun X'jc#ן *̽kq2ϱI]"%[v hW\ Mp]uuG!QRMWkQ>t'qd+w{ND>KQta?GOz$ 'Tv&5}/+Pz?J+MEUF;.Sy#m uC0s:?({81k Nz]%t A8qXIQMU8+;(+E'?`.nE O' : -Nv4uqszzם,-dHTL&9ܸ֫}䠃{,֝'ʿ$ޢG<~ņ8եcqǗQh]Q!< nzod^ڹVb8y Z+(Oh6{0tp$RYB96!/ T~E`?w'Au*w$׏(S,O-1S夬\L-Y._)^ҩE*MLNW Ґ5m!x_!kʎ5/ВȗøçV4P9b9ϼ<,e;FrjV+%}/" ,Ew3E}tFᗹV./1KDuHn/,S/~]78}%|G=dTx$~I I`F}p͖m+JycD>732mf{GPd?fac۠~6/@h1"EUyӊP9iF@J& OLZDekW'(}s-}"E55\Ukr_LCi~ݿ.z1>5\:0`rЭj"TVZ` tI}V =YҍXyL2?zIiv㳕 tt'a%vϰUȍ-JuD4QvzgR2+ͱ q‹t?QS(T{jFٜvkңH [_ aCHL0 a$U_啶. 4D"?6z0 #@Q潌qݧ\ j] {jCH7H<$xSڳ(9!38\GBhT_- f 9 ~~'@9}Y]qM8*5^ h 8,W 6Wc&Ԋ{{fu$Ày.lgQBe&.s@i."}l2KB863FsoA4Zj$jJ/!kvNư'҅a}RwZ| ΙՐ:):4.p⽏7T?q3 @b9^9N4^ǝJpw )?}a_^p܅M U# 5.#cXt> LxhB5d3waةgZ2lD4`."xiNDZ#P1:Zm]PI_<,;s=#6`iE`G˱~ /guC.gBP[y+"Emp6F [\W| ɵ[[BaG27f2U44GsƼ]lV5Q̯}ؚ,ץAgE,U#hz&4ʛd`VOnWb~x>SV.Nu@s5'@;6r&Yr}-MrU/J$"C {sp؞FF멀=HU"5?pT@g"9c~\MRq&]K,oj/7Y۩/4\wZr %ylrG)MX*#} ,s%8dDkCALTSNPt_-9]qΓi8rp2UۋT9GxUkl $f1C@ٺPDb:g (v mTHD_:2Se XX{ݑ_e%DijQ锍<$ r2k9*dWde׻{+QfC 6ݾ )`8CxLiK?:Mc%L6{É$c30NJWј;G }?EUE̚%yAv)LfxB,)t4!hz˾31g Y޷p=KIYt35lAÎJs]R|O~+q&^XTEzaiuƣծq[g裻DU͔fA7$yd?Y MvRqtc JZDc%Mx\l:G|}FnqzaSQ iߕ3/.e/Q@,XE.U Z׏bX{Vf2/%q%/V5@Q#M x>[kh*#֐{.28hYZhKEz$^Duш&KPHJtgT@XZ1#نC2P:^fQ /s=ծ|u*Gݰи)T:Y/ŏ,d m߈}?%)ZPvaT&GL>裵"xP|o9X\XSY_vB)V9WQ ; PI\Ajb GMl9- &U QYD>'afE>K_媹F-z xP-Pk{bkĔ9K ʑh,L? Ҥ,U.atmXoG&,.)k23Jthuku= zS+ 6n$S3s̉b3e~A#SQ|w*ʪZ9UYx#iwuWkagTSa=h\eYߞ;i_&;۫Sݰ3ldmPgzmr`I{%cVql_XvnJI+9_^ӔzZ 8YgHm/8^ᥠr%C=Y`)mHv kcҌշ2՟w~F|b3]dbY?d Hm >\=/A6}Ɖ4WDu]rt};ٲR 1.]['XǪqE!^-Ay<hϓx7ũ]=;S-3E vQODˁQ>NϚT1`O@>c: ߹l!ko]C\=#S~HN'`X_$ϰiC͵b ʦG+ruAU31$bMS|~pt0a2]od5qJ85F4TZ\7XçEpT(ԛC> ڨJfͥ*Hc}BH=&#9C/\I?Qᤋp^εs TCp2zhF@?X=Y\=sAdG۳e;|<2ofBcg^WL#Ī;XHLh-^Y_Hſ9B|}r[t/iuZ5f\ RH4>8hI%q\*Tc&F01UdͿ-INF7(p?QYI"1MV\ ]Qxo OHCUz g~t' uNIi^$IުY@rJӑs3箊Ȕ"$ F+;g:_Xb=-&rRvm ׅ4̕bfnU) 9=!Vl^%Um#aP9儌퇯( ${Vvv63rԯ/W(-l 99ehe^w-xbuȼk6<<5"kNĤty-K<or;ā<:s`^d͏:騬;㹥d*"m4Mua"/~SeHД< 9r_at޻g\PO K؈ֻ(YH2>7^8y"ŇIìDB1NIdԞܬPCDVfr4 ]ΣL:<~k<,x6n2/7<&GG{0% jx%@{^u{nR7OV{1нv'GezҠ5: BFȽP?оꝖAgo?2@jDQ~7^i>ڒh:P-^EsŐBoT+=jӉg4m~NJI_<2Cdl~$\tH ]~(m\LȩlU-~4GD%WaْUO>1Pax:&JilU2c&y' A|6àC ֊ U5+q園hɸCRLYڌb!2 *?`-@veaVB<(&gX>)%`QaGC7Og^̐)FoYuH&ڜ(3SB*rՒ*mQN->Giޟ޵! H*G^gM)7~Oj[beH.veH>XS}DGne)H"FZ~+L` آ#,X3 7Bx⎳:S6iV!0a2ϠLXyVI9u 1_pvrB& P\+]fP8oo/JrrN( &ӥN@4ΑwyB$YwHdObǰaa89T=K`$uLyUЧc I2^ mG[)̴Nl,2XʡX9 !sl|^bQY5`a)Ȼ5a"Y[/O^B|Nq+5sm nP>keD;(al%poKW74L^nG- sš} Lh$*x% f7" [vmp= j7o#N2Mq}+f)hqqy12b O @Ԩ}g=eܸM vg cϩ7s\rȂ mgc$`ӝh"LsswI]rѝpk +Cjs?H t&rlMX~E>]܃*DҦ>XN L}CMC1ZFϜtRq3-$"Cb^jZvPDVwWcO^vRMK%3Fx]:<~t0i7b>xQ?PFUtG"j%~`;bd!)A!9%=Ɉ!xT`G+:΂wr-z@ťc!=1ϴd :#~( endstream endobj 108 0 obj << /Length1 1665 /Length2 7840 /Length3 0 /Length 8910 /Filter /FlateDecode >> stream xڍT5 t Htt!]Ұ ..%% ҡt tw7H H#-Rw=;sg<άk/oa(~!Ai$@PPD@PP4H&/" BmJ 4<! @XPP/"! PyBZ 8 gW N(t~BRR|`hPN`WtE;`Q>I%BI^^^ W(`$  P&0t P^ 6@!v`#uMYϻ _ ;;9 P0@GES` (y P- <B !_ҠoYfwuPH_S vkY 'p~p `u?)h?6G0 &((()(vN_ }hnp7ZF"A` _H`Cl?f|`.=!߿,eA}/PTOC^_~q1 @HP\ !.o//񿭺 ȟ':CXp2܀VІg g-w=q\!P? Q@B ^RXe-=(z=aпTxu!(;?f.C!0. LJ^8;D ާT-8@|ѭG#1zC޿GQZ?Q) FbhE=-@0/(: NtAt- Bh.a]8g n/8_P DV::_ sv^?z`7f n'̹YY<xӾp1WN8 6e)EǦxF-2$0VsϿw9ᴎ%R"V_1ؘ6Lx SPΗ_ֹ@ KK"M zYs<@f&CPh4ECI ܴz妋W !D.Ȓ^ğ'ly[<vM_LDH.fWIHkm\ZnA 'rف9\qEu=Jt7~9v'o1r%fbFbǑ`.md 4Tv9Λ]1`%Z8t=. :ͣ*xΝgiٶΘѽQ'bIG'p5',!Ǚ Z#I\g>m+qj3a ݒp#Ui#xc.؏ÆƭR'4.&Rr?U~Xpx貌v0~bQK5/"i*uH~<Bl򩞩yȰuQ yU5p;Mcj1 P;qG]ۗvuT7zF&;w8Awӫ0gjbՇVc_ST_ 2|QkX<7߼`J$l*zlI$\\oK*;Oj b*QDń !N ASy}'Ա$("{+yl 8K9`ѧϜ\!R/yH^)\{XT xc<ݎ oy%I=-KP27M7pe?З^4ZR ,`]-`b >cxTg8Q~0M&N.뉠jܒyY61/a2ywmnj+!ud0ΫL㕑Q@+1}rOtKPMV$蝠~ 5A.c9Qm&ӳf`ެbV6}sd꼜}܊[?"9Rdٹ5fSrF>:m[ ^GbBj|g;F فXkinǛ4_K޺~Ǽ 45(Gj$ @ ߗ|nQ ӭ2>zw"񵮹ֳֈ. ;% T"rLol׸fjx4 S8_!>қ`בgg_IeSmvó0R6+{l('{E|"tBER͚TVݲ6B1<|W_K4ARxTt_SW"ݲJ@-VW XlXfۿ༈JWRxrNn7sPnnA7Жt֛+V8_EGZ\X7޹dD$)j(x5ͯ\^]S+t2k~bTamC9>0 Jzu& o2R;6:۠u,TX^yG!q-@MJbrp@݊3e@%%}kOOl7فSpoNλtFY⣓mCU)N5GGGebX=)a\:|Yě]M# [,V"dVh ruNhX?{rTm6"9,G| ܦԙiXvҠaLJYʙ#ɻT]໏0 b{_o0AmR'QarL\ #O{ .ob(ťy-Y[eE/͎VyܪFm2_;atСf=(H!4ܲ\@PZ]|- ftهѓ-Z vi Eݾ,;FfHE|]aq|_KYvZ:.,GwS^[{823qsuFnR?%^xX]x'FY hM\;wqN lߒǢ (F{5䬬D Km]2pn//ZVٔL=NQY-ZB7\ׯtNE{mqiͽ*^!0|!V aukClvy3 Y4IF1a  -,1g$;7Gs[(3ljֲrɖSWee; g9\42pwG):BºoDY vb[tE j# LzYR +'I6T'^.Nu+?y_s0c:G+Y9$%ۖ h[/Y9o8aʹ땶VSKBvFsz!P{_7Vp1C.O036uțS{Nm-tX>~ʐN7[AU(KY=<dždyU'lGQN[yqU6tJ3M GM;s:ɤGCf N(WŤݲ# *Q"xh߇GE8hz;!!U|dq &*~oo!a:&hkye~(ermÔ qxg)w?,k?9>!C I֌+%f؃ne36oG[h,)n/{O|nD`UIkur)F tΩa2+=Ŕr=.'5YWT0auV]9g7!O D".&v4ŗަFC[ j{7L'}_xlǕs+@Nn*ĸnXx\7Y~'ni.3L&+TJa;)vg=ѷ--~qPBmmCG'[4~Ő5Ya,|z"쬧R:n4>6fA|3bƳxOZuӢMxΧ"?H_G |Penl+^ pB^["?3O}řqXUK~NN8K K֏>N lyqf2$+*ba8S5uҥG{fuߧ}5߼hڢ(ɴ K3itؑnEϮ"Ѩ2Ceb)j "_Li -{6S. Ţ)o'!]gUwf=2X=WYW@yVI)f,nXV\Q@IM߭{HB8ww|Ҵ{C]5ixvxFV\K"0Y? wYu& C&SEB<')O^t] h#\LL w1٫nō'UM]S׶8q-iZ31ER|\-Kt nYkmvʊuŔ %fm|SHK/DQ4u?_bZSr5Ny7*x;%{r dgӪ/b&%4>>)0yic][Vp?`܏4w|&A᪩W-]"oN=/9V\ 9oQ5 >|]Yc(َ4]z"9l{:3scvL]'oAqcW*\Z# jwKT oEk n-6=ulE*5(#ofQ" F W{dհeN,7>߁1~H&h4?;+1yKe?u;lpt?)vLV)oys [@I(~. ex#@*jg4 sz+sErFgΒ$Em(Cp~bi|-G9MC4媑,s%fKSA <,Ѹ?jb9QhcZ~C~6'a6Y\Ulx&36OZUT&~1PṛP-"$w,eL} cOt?ݞŴFmP j6p<ːcpy,n>؟ftpiO~sB/P+À^oY*K^M7wq.ީ.wj?W9p$rvlN_)M*V{WHpHM`/z>,6QK:@>á]ZDb L${wG|rp[۷PDp0b\=?ǭ,%1ov /4#&Rǿ-O'(KmB6sUn!,=ڞZG"_ 5nzNݩ3o9_cn[h '2Q〜on$a9dNuʧ幝 R9Ȕgu]<p׽=uwS)hTp?.G]}^M}][YpZ9;d`se'DzX#7;!ݣu Nű'~> stream xڍweT[- !85kp3ssgV]N9udhm A6@:N:DOFlh'Smm8 _mT[r8 !ڂ9: L lnj? #Jp5lnd`1p4Yf42(KюŅځlKIp1w4(@`g1wYkR5qt1+s#k1 xPفlEt[`##[k;7sS '*MH01M4r}7p6020|%xW`6sts0]%oF Z[lO 2zicb.Ɏ^ $!o֫ `a```g` W#3I@9ͯuxzL^Ky^= AG㟎F@ `25j +@ ??鼞3c[+?6^LSVFSv ں,rDZ !gB igOl-mXG,W36#7Cd]*PQ{:C|%H8p 3P]Fz(p>LF0C?4-YpkJvcIQTζ/N2cB z\ c:~sxS%:*W6rq12[ĂQ߳h іi4w&V`#|^m!7iA ǺT=0Rp.0Ӳ1@_hXdN&pV|(VY|G;zpYoGXEgMY*d +,uNKd>_jAt Y@0@X'u ,6M4c[;&zz5b?FrTIT="SSf[nAld=b\f+np"/G]Ƀb}1"(٘cv[1O>G,?a ae>r_?/mYD@X&KLNh'&{dME᝴^[$Fa|SKNCc&6pŽ 7"S|pehX;_]br=Dns5Lr%[] C wo}OKO%y%vi=JDSe|"Rn*>Nh?`,5odDy0eh_:0=j܅*a/=/N/_gV)@XEXN;CC.ޓ;12\0~ZT`1:zI ArGn'A``I}o.(D*mν'y)n 8Ǝ UA0i LHƭ%( I7o+bc8CIP{!Oa|v2!w'^ KF>vWɿ@o.I0j{Ѽqm~UI Y*EUDaN>`1d֖vї.5EDuzH=$ gA{L@bvsAJX3q2_o~rQڕ(acHnB}00eL~ W/ڱ(#3/oU̅>FݿlxZ퉽͜n'/~iϝN \o<$ʊJHSl$ǹ=~pz2'9܆~qۗГ*nIK49+bE5kmFC&q/yv4!Xofji-$EuS‡zrc\nwNB;=*$#e\P¼"wi~ֈ~5AP"3)ӹhIΉ ֫238͛. KoHRMF4Vɨ?v6%&ZK{H M=1[Ҧ{eaw~)rl DdT#k`#9w?7˲9tpq:^u< ep6#CYn:q6@:CIY лYNd!)by~FqVjoJ(\au#v]Ks=Y6%jai\ݧȩ^es!֩n@kc۽5q#̩@Κ'\M ~vZ+Xx; #./: #irl2zYyu#SlԨ #=T9}a! ħ.dpf}Rp☔%2cnMO )u,KOQ&/?BHc{ ~$a=Z{Ȳ}&Dz˘^4uGӜ":R6/~.qto}d$9[T쑘189<)+H7Rq;*) C[\Ao&Z]FvS. "X½@ZݸBNVbmXC&pZT?sdP${1#u?yR%&+P>L3$lC_%ݺjd< 8!JQm#TbyMITY*feϋk˨W &AzҢ $ tcaXq!Bp} !I3<%WFQb%;!=dmiBy^n^ʪhK8Ogerc&f׏r_qCj%W+~ye"xż?oT>l=70^opi6 ;iʘ5o#uRC]6D?J*όu+t1lF (]M $J>=К| HKK=3&L$I'11Y*UDӁ-ED LX4VN $Lu. >9.{kH FAڳ8dQ*oۗm£hk. :&7`2?7e aY'Z5^.E/v7ka>?gpG5S-Z*2_{-r.'䐾Y=ۓk/V|&g@Օ-Y|;(CrNю} =i /Tuf~b}&FmFj[ 2@ODm~[ ΐO8KO%680~p< }:RF7qFv熶^(x sѱʍJ1 Y0x?Aಌ73yflt(w@]?|YUr̻3P'U,ݐ찈5XWcsM+?6 3=8SIXZ c+^6$+njuzc\>ܹvqfQyӯ_ԹiC V""b8Gqh?m]e6}#*ҡ xdB;*8BG&Qb%Lՠ1boV&_,NigYT3Vk$] J8\5j7WT˙!H&t*&K&DurMx_M5403]~:O`yR᧣°j)>A'80lVoz zÉMwځ4J*7w$ `TXXldG:6 \82`NjO(g-sdmRjص '"$T6 U@lEeܕ^ӵ6P[ !NMǿ2GjO7{Qk=&Nre_]QSr}BĬI4CwK5R%fC%Lݴ={{fϚ8x]|]lߧD#e)f H1o!.xͽ{Ջ]ǸN? ju')<*ݲGє2nlz ̼'W;,rc_P]φu $HvN!Mn;T &VGB3aT"ygw2<؋ ,RB͉mq0>1#ZKDW=Wy<Y~ӷńlDT%e˖Pr  ;~>yG|TJA,BzIm Kx٬+uTJ;Uؘ}pH2Nr2\q1+-\6ۙ]yΨBt.j/B-Y%;]q߸A!f*~eG!ˍ`0TalIO֣Ác≬ ?Dɛvs x_n{Zv(y6$_9u 8NV!?@^EڻH +.p34# e *F5ǹ})gOa*oZ؏0pZ`> G㞌uGmJI2j`DB/ϳnι:L͠fM|?*o2KboInD]XYMJAH،jSŠ׏ _g]k7(E%޾x n~ǽgrֶwAXs\ÿ 蓸GjnEpƕg#VhO\ .zuC}<-(Dg U;|ɒ[[I0Q.!-Gͣx&osip^S$lVYJ#EM7jt*=!9&D܏Ip 8܀%A,q՛룒-O3T  >>ܯ /4JK^\!OXg'+ݔy&7.L8&xj|P<ͳeKȢ` 4K LT@M$>&enRDځ%1KT8:N\mL+ivG>+.0LجTU [c3!)UP)%~hW.{";zA#G8LjOrt@^ r9F j4Ljmj'L\W(+$h'ںm45/ {8CʑX|I)|&%ϠLB+Sz *Tw2Dh8_D.ɢŎo#~Vb'ϟ >K-VHއ"S_KT Dm*PVnF6`m?Dq`LL0JgZ&/t_EcL9LlG Ӳּa62k_[Q$KݪPY}z6!".΋u`y<^I r46=QvXIV7DZX7,5f6#ac_K|]ZZFt )bX YXǢk|OI:_4$x4/r'w+1ͷ>`i{B{c^>r3xL Ж&ЙeM(DT|\5W(x3ƅay&jwMhVzNJ6紃+|,j;Gdgi3xUgǂد.`TG>:uuk1l*jUDR&1jAJn~S\H3mpN͎?E(HixDݜ0qwmk!՘#C֩ )ĉmXBFxlb!3)48nV02Hh%eD Ք!yLx~d"Щ6`c0 V&V;GܼyC}8dqHp< eu"HXA țl4!=_upչM~٧/3a(IbnEKvK^@ey{ؑImtM2V'&u☢ϧl(r*m44nzoخ] \ߍbʲKVW   ޛ'^}-|+)DwZQ"\ 63dL72'9?e"rgV Y1Eu{_R-ѮŊ 89~fm:!IJ}7`(v0ugipbw6F^LԔ)'uvtw&_-DTQŶ%夎 Uy%.w˳cK `;K`}L4^ Y6/y/PxsjAMB3+b8/1Z}RXG4XJ' D%3l~q|nm.)B۱m&oʲl T!Rk&BUWLSֵjCSC7$P,(3ГTy|L̼58ۥ^A:N^A@Pfx2%!'s' z1) 8gP&R(k:R 3J?M hy+8R 7On%ҖpD R ql%M{"^)XPEll~%f1, )׏Syo{'pZqJ&A5઒^!\ib8Xh-^(HD{\xW{jb<=RLkpMo`+ny.Kףmp[h Z*5teJ%_<pܵe?NDކuytVv)b+d\2{?@XӽH<2et K\io{(=Zx^ IƖ߈*!W8i;NJ^g l-L2??&}wPn{l}|SF(zMӎ;U`J)`O+۞oZcSշŌR<+IVڇ&?_j\EιnZ3- ÖxPy^z 1hpfJW"^(aY/hO3lQcG ]~@3be]J&罱kcZF oe+$\@ks# "7J݃ Ot͍@t)Iu8<CꋁF<{g ǫT7sZfIaQNS.ݿ|j{(<|F*I_ƩlB^"BYA~50UHA2p- WL8j?؆hN4vd?# UV:…(C^cNT|cJX}C*{'WM@D, e;j9;4K=d/YMy sk^H u44OS2r'R=G<h[΂ E*TbːJ?$$բbPaD~}|%~)c]2 zs9dqMy6o8DN/=XR*J/u?"Dʢs>-K߅S/~vZ!0KFBVFr ɷ=]گf )ک<ȓ`~X!RrxM*=Fi;^cI\oXY}LY3;it7Ĝr涩L󍣙xmYVOdbxҏdLSVq9tꈚv"sچWBJ*_绳N7o%j;TUΕz]z0CTKKJ%5*3% Ph%/}iE$&1L,K,xI{N)ha=nuwkG_ݣX'~#Um:L,9e=H<%mdP &³]AԎ kUA_~Git:~=!l.Sa+ֳX,5)u (pBsۢ t)*2ɼ͖2 g -#qrKjÿ+>r =ıVuIVCXYN!E!5.Bo_}%M'1I}UK`tC86b$Nq|>U+}Vn|UP8XoXݾv^O(WM;&i0~KEы*6{&z6?4Dy~ =2q-&ᖱaox,'0[|)8n\UB[on](c6wz$JDlon\IMP?8l6YN\e1ziOMieJ$]+s:}eO# [ =,H*} '-4X"%Z nT5~̙]'G򾋐>g1EY=I¨Νc>.H߁X'Nbױ!`J>܅nd/oF'FZۓfǠ1Շo!nig2omM]kRFՅ@~zH횒vO5f [eBo8n @O2漋Gz>e+Wn~Y d6T U9:sCfr{L]E.5lMδɹ_=IP)U}> stream xڍP.wPCpww+^wRHq/VJkqwwn>=g$yzk_BG*a`uwe` T8 D{ q@;@H9M]2iSW(Sf p r N P?DgA;PtI98z9C,\bpe;C@SW+4"] ; (# j_ETM  F l!  h)(&_wXrrs4[, `2+ jon 55 +0O. g W@,co.`gwuA4 6ދ?kca/؛[*͑]VY]<@ jv=AVBr%VXh>.`O#49 0[B~{c8C<@r^~3o_̮&#!JJ:x|X<@#oG?%U7-Wm*qg8YFGPu4{^y "e7WSuC0zC+tATkbT]k6V(ag[qx! g?g ` ;@~]=P t@Cw뿃؃-!'/ :Pn9;BMhΕ.K7KF|v߈./FvTqص~#nο:즿4o$`~uB[@<thJ@hNV@h @h@h"v!tDP.o5zG8Q qG\P@hh 45 zu @'? @B!U!߯+$3 ;<|ZM"] nE*&a]ob4돩k-)@/#k}C'?8:c0vhyz>sQWIµ($dnöה"|bY e[K0H2BUxw0KOfO'Imm(F!/ZVo%V݋Rzp J tvIt 6ح4><-!"%=< ">[Vf fD8J<1|!]bBDq~^Ԙ`UK]P,EF%@ Q8ϜO19&#Z%\57 hfaKkW|9~; y0f$WV[Gc!}!PVߛUa~gܜO-7|WqQ2AxŴzj cOw2KZZ[JlPVxM:ٞno_Q*'ܱӕV?R6 6~(a4H d@T+?T i #E2Xyu"\W1/^@c>} #}b/]3胻Qw8^nK̢0+~xhB*a0yK:MܘP ?ai$\[ ڜUw٢D{vJڔNn?b ƤU7M|I+9}|re)䮀"8řmW, Um5!> (9fƯ{D`3<c e^m$>*.DhoJ2?ghBU<%ŭcc˱8V[R3.qN/m22cw݃~;]gk x[VnɳeVRr¶:!1S};!=Drzmtp /x2T2EVr+>5TӚƨ&~%ķs^;|]Կ HaTjj̕B^U K&/ֶ?{k+sk2Ih%c0nf%ljNb ?4 4D]E=Cx[ބ٭溯H뱼%M8lufL\FaCIM}RVSH^~>Φ6CbH11>іؒԫ(3xgJ~yF%$Pべ]~P?7͂Cd ~|O[Y.8ύ9Y`mz{žw%a l=?Y MI{.l]:TNS&P ej4o-oo8GaQ`J>#tiBWXkg~#HngeL-"OtLp1Zk=c#Vi0:OxV0&5¬}I?^tU ~Z}Tjp3~tiWV )rAI.:+Ux}I|G_?щ05?I*%="I$8 )qej;:HѶ8/꿕{oPdkkS, ]aI@=qA&T>+w['\H8G룼?꺦#j#S|` 2>JO?8ĻDHFfm 'NԳs^aM'wR"Qȵg^q\WaZsФ^)hPվD;jft[DQ1D  T#RZ}u|*M)TF1e@Lo)(d]!.|@RІ|&zE;DcFsVYxb9>Y68%:#0YB5qHq)lJn`*]SCX8wrb[R]F/ߔlٳd\­KuZuʋѷSKA{(|mZ<ǣ^82DS+JA_ gS3[ȬTo-iphUz0ݷ qTهo i7gۡ|`iy*PRLZI)K| U(9"ADOmmn5lst 7ϓܓEZֲ6niJ#"(礨Kld賍y%>ctz(.)GMeܙ޿(b{5ѴhG%\xM`BB L;JbMrvC&t>< #r Gq.M_,i$縡'wr2dk[ҕ46"O8V~d(כ8Ub{Z~2W0xR}UjPE> 80CDBH\6HQ,p=)gq;<ŸĚ5c|ۑ,$utؘ8AOO0ՇҌ ˫1 ;ξ^ `1_WݫdBYpfHq%[=[`JZ ׯn//YSӚοjݲ1@% bmЎ^̔o]RXQ}KsyyJEg^oTKw/tŝ}O,s_|n6*cJw`;Z\4Ŋl%jU*Šp5fao2+AT!h}g4&![BF$bt bN^ټ$<bN' 9v H8uɘf=م`{tH X%UWɫf檞Ͷ|ۅB#'EU+bsRWunm*&f9Y=i1.9Qw%L,SlHc^J^b*j<\xbjvm"-`ǂ۴=վnZy.}5)إ&V'Q{?$*#J[ *Ȕ#x1bG6b ;mNF#=aiV2- GN6觛i2gNeϸԅt,Q9'P4xe/s!qm_0-Ci]?C(´ov.b)$K ~]@?IR8LX],jLh{vV, yH2;GQ71oV(QQ5 HiD!uJ=NǢ=Mw1%n&eż{U[kw.s3U|+^H/BRaH}TC4ݎnp88C.BĘOjKUd3r;#c&\_BnS'N_?3Eaתo&m&l-\SEXfg;EOپMdfS Y{;:i ly F;dZJz"-*`iN;Y;t[KꣀPMz3 2|hlbL/Y?{y.Oz~f~ܬSR!U*9ϑA9(Xp'<:=u~_6IC9 ɚ3&EƯ?h=p3pɚ=~nh(` INzߕ)=#( S,mʹQ;UӞÈm)?ޥ==2!뫫G œ qδVt%2,k^ |̹hNJx&~ugu p *P~O|dIM\AV78cNl,>;tG>ZAce9J>l٩T%-+uG0\mNק05)K[l`qG/ ĘU;M .GZ\F*EĀxE!r٘'t,g+meǼJ 9u&fz $ahۜVudv;Z46۩ Iy.֖"Q-$'Yx eQ@ڊ6D3% |hzYjRoeq~ʈ H_INWRmxkJ1`; |'/!L7Z:pMNdw9O)8eQL4dM4)|t A~yl1ap 'aFa#$+ QV˛,aL@Lv_juğΌ={&cvڄ`Φht+N~ɋ%0<PlFGp9j#8 ;HJc3Zrt)d}?ج-B1mBf$Fƽ{蘴2n]|q[W) ]EݵTuby],Gt7t*."=Fw;4[ 5ambai@CMMyI¤c/1Zuxi49uuyҠE6 W6 o^Nx(WŎ?{ąt+^S17^9!}SѪT--X1](f͛[:9tPg3è}޲͝/"u;-mbuʅt '棇x*cv=$r% aȋ>~]cQ#-]W?Ԕ?ͩk4Iy3F{lj}~]⽴7.Kb o~Ji0EKoAhHԺwLWpܾ߳Gjui*>HDnt&w-mbI+&!|t=$_,KC-ez[lΙt$ }nQ @ޱmߗugZb2ZO$kGt QUGTXW?NFE`}GZ?o<^h쮗i|;PW*I_, >yD 8̎ Y Ҽ'ZIS#EY:y" >iܰtWwd&7_}?X,Ҿ쌎Ժ\m*Ba15Ū!V{EO(!pI~e{kcyE:Cg߆t}w q4g실]4S׷{r 'ɷ]ǝQ4k*V˕9Q?{wr d=G>-W˅* =Lpv0gz2`tveB4^f*ŏ!Cw:'>C 0ܠ$kR=XN$rAIa%4D‚9#t[;N}^vLU{zXe(HÜS0ukDQU›lNk霥lus';›NȜpӷuz0D,m{ jޠilX5t7á2CbTNCx#g uqS<ߤL%0`z~sśl}!-twJ6%#97<}g;o6?3dSUܾxQ~~-jH^}!zj[vRυďl1g¿DNZRgb5m’;B"tͱ[TyxbtHl>3jД0:E09z&LtAɱC\dzq\'*'& vGw,3Z]k8|xӾc-7}Ϥ6}J6yң]ׇjicZ;~88>9Ǜʝdme E~M1cʌ x/O*ؤxz&}& z󗖄0e{k@/^%A.ڮga7+v0}<7^Kב3Eɯ{ߧHնTy54!n44K+I8+oHMܐ]Rq-C{UR`$3:2o %v1՛+m K#nĉbq 27p\(xFG`t6c;D?MM ɵ#p&.|hۚpautJ dHq3# .gsoTۋnwHAzC|4K1xS|˿w!ᴊz&[âӑXp5GR ExtY*NNdf ~w8sIX*ܧw+NX|9w).RRW"9e9^ŗ0eR4{tqds^="oa#t~b:G 6P£6qDZف21 0ֱ;o wC@;O;z`=-RLI`ۓB|ޗ<ۅV27pvc/vaj;^/@J^ɻ{7;}lzR6g]{Ίn>HD" XHZ'/Qp#j0R endstream endobj 114 0 obj << /Length1 1582 /Length2 7616 /Length3 0 /Length 8639 /Filter /FlateDecode >> stream xڍT6LIJIH.ݍt ˲ ,KtRJ+J(%H(HHǻg}kgg9X jp$H kd)(@ !BcꅀåEQh fZޮAa$"{IT>0@Er({{D= AIIqE7 tHg:# 0rHHp8#R@ !$!PU4@6B3  W GcP/:=HSA;A%C n`? pBj:H?$ wE"`0l&>;xFg@\ %*A G"O~]pwpUjIB9AQ$!(z~gft(w#h !D!>P㿈 P'uF`BO z2\\]U*)P~!QA HT .*-V0QԄ;$ݾ*s8\n3蹣g gA Ky~/ Լ]]d`7P{# ^R͠.^M$(p'u=0`CB#`^=|僸_/vAѻߤpï% PmuqPDݽݫ8eI zAa_P J@ADK <E@A2_}FZ7O' ^^E/A!SN}Wene |T]J1ɞ~6!ai!j [c~fu'f'7ǘqz|JLR%^qdNF~L,U׊Z]C ill6^=b-)[uL3Vm3*ŮYƶ-HrUn*%>[)t9m3ǣ# JW?ȬG/YvIf:/njx e0]a;\%< r´MwL߼sW*$`uq:E8 ~s 9nw=$s!t.;!^x5]ÏiG4X`*okAo8!YFC2rQ% Ռ{4á&@jmM"oacnC:?a)[ *hڗsYR۰!UP.Z靤krxɱ*Q#OԃD*F?3&oO=`L8%Ө.la66굠j[WM MAYJ$b@8c0TrÔM5\l&lK^r}A =owSʽ1&y06iۇh4/>Kdtɓ6̮gZ9 k>vƿFPuCJOo3&j |fej-7dFC|V̐8 v%.]GyT$#6bRD!yUm'L._[B SC t/so$+&[OĻ&ۏDfLJƜ}z}!h^HծjGZ)x6+8,ם}Gb>:CxB"wٲ@2nH 83Tۡfn̜ #"AN>﭂vo*Y4(";)qf^Z`LR'Fw4 zEyreҘJ^FـOEr mI\MaYRRw͔"y HVJhXm;g% .n(/FyM<T!ee.{y ș141 *7d$JM{w2I$[pS̲ؗ(}"6T˕=Z(>s9iZ v94M)`L!Cmus-7|*F\=rQ-M~™l #ۦh~C2l|FN(iϐU! \"Ow\\ =fs>`0naqfu:Սˍ{[^U9\sO҈tl|ƼJ,+G8-Jf XPXUaպ ??3.|8ֈr!|Enhl!bhlxI~GuL()[H:~q.qyӘ9A\x?Zf={*ǣ}O)Ա%ܼe?$5[LJ":e+KL|yԙD4VMV1=dN-0rbL^@;U CnhuCCݣA+ 9#c '߆p#ҒXIYE@@՚c\dOoD%zsHnC%ڏq@SjeSPGLyא-pAƨ ByQ&Nh`?sn:P{\?KȗsXs^?, m >I`AdN3Jׁ#E 7|'W0N-so{ jqƂo;΃&-Nq' ',^7w yZK nE~ov{]"fwt'ϠHYbU;_֟&/k G)0S{nuG:*%O0xǔ s}H3&a&7GHꬫ0=ҊidOcxwƻ(1Z_~J*3V#XlXS¤Q#O?u輬|Mn-X{;FjV=N=sy`'7}uJW&L'/f^iq @R`ln̹g\? i8.0LX ,q9Td9IhGf!v\~ҵT<6|bn90*z1#o euu{i-B[0)&ލҐ*79p ~r}T0af1bdwT*Yv_!۪ I@{țWշ;'=We4 ܚݗw]cM ` I G}c 9Dl oi8?SU&ʩ_ `'\JJi] b[xkrltߍd>JKNc\dUj֢ueGF80d_eJ4ib.IMt7I!%l?|ES76vd0y&ܙz(bu Uz[wu[?) dzV?).a iTn|(e1-s g6G?sXZ|FS׊NSE2SV&7 ܃ṽht!gn POX_m~!CW:K[~EnUqu$^5*lfc>:nOÛ}Vq&`?c_+^m{Mq`9sZ9 l^iU?"s7镈}OɣS-:yi׽v?s_me,3a}'NLE^J?"]v‚b 7yLC(ݘg3'pavPy%"s UOǣA$ #.%S liwjz+(߃m0\ ݔ;Vwiz{aDn]_E^"UǥʣU_C̎CL!pzFF]ha C+/ ϰ>Y{쉉R@8w5<58vjoDC,j~|j4.)=I%>D(ïH ~/^hNRH u8_SO23Xm}P.'dW>dsFZҎkY .ꊲA=˞*Ў1 TS4n o#kk;y9#"ħ/'{ռZLتٗ=-tCE%j .sN![x{NL0|~ ٩Jy&G#?PO&D\vlu,ƾe9i_ONF"C} 0ÈCX.Ϗ15b [D]rɫ|ԆLP∏SB? Y]~EfgZ{wWf?Ų-0 .30O[3~Ǡ˷HUs"!ЕO\<0<Ԫ퓭Kq! H/UAb Ʃh; \T8V&]՝{/9N1X\L[JZN9.s(qɌQ@K-SqU`3^[Ʒ%NtDN;k8@󏗳ޫ؉9CV!CI)?ymoїFO2B낪qxfGQ*'Nv99srg/Omh~3m~aL=H8/ Ě)BvGӥ+oi3۸G0l q>ר^\W20_u!녩z }a|'t/]9^zzʁW^{{Eӡ7Ϫy9]&=b AHQzΈnfޠm b8Aqчm ]! G[b{/~SsD}t^¶)sJ139p9uB+'Vʣ&@-]<V\H?YٙۦI_;_^nLumZG_,)0x<~GɅ +͞Q,_x sxRfo6?xrsMQxg@,#%64ˬBL)*'Rԡ}n=cGC[72S@G'KGRO1ȭ$=V7ݙlCP q%6Kp57#Q88[H2 MA$wo)וS&N@C+K[nv:eWo,T^%DdTVu]Ҍb0J䐊2 0BG$VHw"T1.#埝Y9 aFqzg%B8RR4yEYFxSsh,>ϸ70%zz1+wf'yDwO($=0ʻu|ina }W<;șְZdLt<ӫ#IZ2㳱naQ26Ie/\|1$iޟֱuSGk]PB6II*~̜fN;0^NK"\+౗[ŗ|Q$k0]Quhx` 1γL04o{my|%ʕ4#WϚxы/.ćuɯRmwDS5_1u|OxJnpV4=i ?l,P⨼ eUخo_>9ue^,) b|C+VI/R$SOm)5:P5JmJ/p,{e/.=Zc@/ܞͥЅ<„^E;>/\0s.js^Ŧ瞑4oe$k6/s1pWժ*$;*biKn |آ9[::;W`FhQ|421$K:OgvbtL1*ez4{#AOps*(؃8 6C:$4,_-rMFDP_ЮjOg <*.=!.&aO0!{L:9V2Jaw*I˜sHg)"]Ї~~\]|q*DAv9Diiu'P{5Ce{sވώq&2 -J\0›OSt"źer!mKʗ6-5֞GL^K(_E؊ il\一l Cq ޶X9 ɢ wL&đ\+7Xb~1!i 07BwqB$!7]Ѩ#> =T^x V}{dkyUөI.?ߨ?sz}XaEg鴷t ?cg!j|T1Ne4zW<:{#W>L3s RΪk ؼp Kr{4pL$9|i]u-LnmZ'K (b|/I<4A`xVoe}c(@ 2 oH endstream endobj 116 0 obj << /Length1 2618 /Length2 18440 /Length3 0 /Length 19952 /Filter /FlateDecode >> stream xڌP  ww  $ }ޢjW?}\UYl ۻ0 $45ll,llԚ [@'g^ ' D&i1T]mvv^66 NI79@ :#SK<@V.~Йy>:LJ&.V@;-@lx :A+VVwww;g0=bP:܀怿R(IirBln@ 33䈫9 ah)T1VYu>lbfs0[,@@" /C[g0伉 bw&i15 $s6s988lʑ/72KٛK.' rAOsmE {s0wu`ղ9$,.n666>N0b@/1$_odCv6q\\*!Af.S%wh ?v_~3L9-fURQg'`73 oKUM@?9{ 0?)@j4  `4t=7 }uoDҮc7zcfWf(!aMuYg%9j\L "foio!A *o mA@U3t3)ΐfB67 2_ovȎ=m+=r`vB<VDA<V߈*X%#~Կ *Xe~#o ` |O7)F>O7F>§qX5#HZ$7!qFK; p-WW2qCm!_ _;57BNH"`[?`\(N!!K ٿG u}r@L,CHN&Kyf<wnXy:X@@H@H/l9@bCkB.OT_C) wtQC2r8s\5 g3ӟqz!3ē?i)O1_ 4C^Z 긭#rgޚIg^rtGGL\sK\ٔ]&{>hm@ mWky4UjG6?4Up V?HYStG;[:ѕ]5}@ƣ~x–v5cW(sԹ)\IO=0殮g^c}8 9>{Vhr8R&M'X.)\ZbgZ$M~$(Mf/3N^UƖCkF wwi<W7aNJnшʞ?t-6^!o4J>:*!_nXRz[O:zl{htK##$b`5R^pUn }/(Ჴwdzgq>/wwFOۄ"9nSf2k#= px삅2Z[JQU3҇J;7FeXuBͻpsz&~-:Wܺ˛zuCDR_&irPvo"!$arhS̠֯;TOU(74#1]Q(tU?NdPC!e\oWHud]hp~T: vV[ ~`U;߮صkɨ/dQCѣJͳ v-ۺUɸ‡+h,N[81l=><;{o Y|Yn~(e^D{6>IY=)'lH&ZO匑V R++jL#(]m[ߺ,mAwWRdc:~kKsx:̠eSN]u;Ҳ29:]%-G6dX]f|fX"G6*49+\5s2TziApW#Xr9gW#T=qHTplK}}I' 5FkeZz&=Ej*kj(L?;a~Hsfby_#~aC$ GO.kQNv gh^&^3{YSO/"<uiFnä쭻86:pwcQow9M B3{=[>BX-]ُ?+z(+F@9XzM AVNo3]g$v-jFcX~\>YkcNCMtlU7d7557epObG?EvVEth`CeP 5sCuApAL6%;4~RgK'X3ƤP tv$(  hXRLJ2 4)+q_Rr(6HSEe+oԝ|#uy `LkTdi਀#h(׽=e1vxUS3Z^WSVDc̀Um C:\.{uC{xMdjcCb , nAf 9.#nҰ蜥ˬb [nZ/LI,]od]'Hk`.{-YaaXG:uauqn4"1NL;+mPb`g`Ca~].{XfvV~M:\ Mn!t"A7Uצ4\폨=c*=^CR,|b.ƌɓJ4^>~& U;Z(1p,.rVa l9m;AxZ9Fy1U\9}N`/Z=?|C\KI!vTrd\?b@&#ڜ+KۥGi *d_T!=HkՊ?oqڌp~ :LiY7,Ek=IWP`;,Ï9LZE~͙+9 т󟚏ѥ"RO(@>Wz]BշPQ~iC4Iyu:h}fM#.O](cZ':XJ1%rU1!XM H 8Mb8E(83+z>qR^!LmW5 mHWTԡßwXw'wZ[fl@v.UN/MI]G,?>p`N)Ȏ/0"C1nZ<֋N|ja<=Y"hi!$9[ZaJ(@cY4{^y=joh|-bFxu_Sn1/-mt–]uZ+/aw!'k4 q{l^۠ٞM7D^ބf6H!MxmVi~lP/e*$ ,9d*8JAO~Tzuqȕmy)cTkfx[МkMgֶĴhHn~QAۗ5;̐I_=B)MF=iXFy DŽ9 D\{$uӍ?J!ɟuziZ}te_nNo9DĞVTd 8P#2P( #x-nX+˽O⎲_`~~KtRŞoq\[`v|@fHƘ-ᅉvd"w_hQäu:^;W% ESt'~2=(A@>LIC"2WɌޤ #7'my!H1I;فeV,YS=skgf8D-%qq)}uØfoRNUUm@7:[1ha.*aqCiך 4Q&HGėrsPD_O5Ԣ-L0QF6 vZ%3*KMqƭo HZ36 `^˿#yNOVZq C֧R#6@y5ҍ]|zxk}v.u0rSr} ,8&GմLCXF4I .K.j{>}WdA/Vr{iq&'KAKiƢ9َhSR\NWblk9 `Yw.]-.7h^)o8Z#}>Hcj!vh/塑N_suþ=wznAWn)c7PCu_a!Anxۖ*\f^5_ָw_~wv83h75>W=n') M$+(d~e,B`vWٶ/ywd3=^\x*RP"#Wo8}br] ~ KYG:TKEl-^{ZT%wEΖ*9(w0w.}9" [tTLw5!pp'Kh*Pݜ +&-Y'LCwCl i4e4Օ S˸~QY ޟ (|cmGYVPaWSan A"lze$JY`) ' hM hכ_w ɴEyZ 7PNV5j8ci6GϹc/ws^۸RTnN;s?D(mIH\}JbJF>!Q #s AaP[13|1{9e<1M\4l0e-`jZC84cI%ފyk*ls`[ڎ x$WkG2}s&˜1s*R6-mF `pE`S); cLnqp`K]cy+Qe`ij9 -H C"" J']cy#uR9dz=>T,SD ݊J7'; EJ &ަ`tm p %9g\|Oz#i9})6XnAwЂHDњ^ѡuqUswAu 2;R5"[$rEllIx"SPoj'Q'' Ga7zc$%}qZˡo"ա]KvJ=|u6-솼ugQr\D[17 A?z1~P#޸J_Ûi|]3^r}_gd3 6/r.agi]5yU.(vxҲ?p*x2u42 ?ucEiKSX tB!@'u9M6,+?2f=ѡp}Wl{&m =m[Aܓ7̾{Z$GZCS!V: O$mrbI>)ԑҺ+Ao1aYS$A{*MZ0͇"V|Ĝi>/Uhi~rP % Hڿ^1hݑuT\z4' tjqv ʬ?z!wf,|n< s)-cKS6/}Mθڦ"o<}es@EDlKXONj S*a@i:P]z ,jy#m\7.gW9UTQld%~~fbqUMeʃz8|0?L)=|8< c2338F= ,rոARM95<^FC`b#f"C!sdS4;vGj{eEet2Dȅ(ӽZKR1r=iz?:L/T\Oj5sd\[ ɿ9Nr/i) ?sbT2vB v"s0kpy[Y~R^|[Í."U*|On8ԻN-yh@-X̠VdȄU"Bf3Z"fZX:pYh^Z3"->E[򌸾MۓH%d*?s%g]Q}gi{I Rv?MF}3A-JPեc`slКm?v}\~:,~4[W烙10K3ZjZF@Jg 9U7r^]-\q[2{#FRnibjk<w'.FJK*N(>`R5wJaㄹ4R1[fKnPFDF(rX"z3T=62PI0~މjC.(3l0b}psx8h##d(*Ա>)q%Ʒ̣pq*"o:;ӥr"E pWu;C%)ޏc]-ys%V]u|=n2ҤpQƙ Mp$uo0JFwPu_@ zuXi[彚L%U1fˡ̑ny w )[̸oJfmvZz/Qw8thǹR=ʂx=[4 Cw2ho9ӕOصw؅XNtͷ% …#8oFd_ Y2ʗg-l$|EvA/ v1:|GDluH9\MLύ , EziFkWvo1qVz ֟r1J)L5,g]^e}`3f)[ l˰q̈́i| 6UKw:Lkxz9 :`*>h"+FF^ sPfY&+͌01q#C _=ZbeWU+)v q 5%CvTWc$$u5U[QUs/*CGh5X['A$;?>W/1L7. 2^<}_8>V}7w"Dz#7x F1G/iّ’ke[\akwp1l$9PJWhJl;ٿ9H__/e1sH~0Pe:b=nzV2sp 8 eFL?]ΜSm,:J+OHc`aHOͼ?SKA-6>4O'۳SJ _5%UʉK_~4 [Tc/T\L[9Mൎ;yľe&CW 븧ء+$RlUfZ0lgOYnԏџp X'/yP"6~31sŞ[$i_3Si>)$ŠF]2E5$ͽJ]!ܸRsvu@뛍HOܐ$VsG\'/~ kJ%|}nV C= -[4 p&>ӳ D:[? ҎtH}[vuGΔwX 7n!fr}Iֹ] !#5]N2Up YpO5>D5x)WDkg;!_"f{+#iY}19lO?OX;m5MJw'T0cԏK&^.dK3W1(|C2’x(շE^%یnTq~](eBߞ ?\Λ_3"S= ~HʭwzH\1D-v%?mYQ|ɗWLj]uÌ7?5Me.vfZ.|CuQ{TSSz$ jA ElB6.B:uXB{yٍ`d!7Yڧg6 5&V($gTŕ\ū/Ѓ(wXLw"_ϣ?=/ِܶ'w@y2>g W\Q.5<딽;ֽ @vTXGE'S'1YlTk:JzI fiv+3(PdƯnedD{Q7bRsVjbW_o|?OO`ܯ_~$-BAm55u (RjDo;3wbD.-K6ŔZ:bg,lhyQ= Y|uE`U3t#cJ%X /Ŕp3#A7{ PY8 P '1FPkX% q~1$+dDn5R>k I,c.Rcى@/]œ7>>)n0b o,1o/=1wlpb̉lPiӥ˔ kf TX'pSFcjr;Z6&~Am.'V$Rl^>ـnc]8}ܭ=d2jr@߶yl~2&;BWgմ>2 3lR\?q\Gd`:ni!Qmj&9Ъty&ىŃ,M@yq>  1i/YS .E֜o;q ȌrAIyGFH쭕9uShgqw- }ejGk-wXehʥd[GESPx1l;_E,rgnY?z6{眥o8V5`v՟I?͊n*Vrué90`z$qEȮhh3KYR }ŃRC g %B:#Tł:@i,SF\w VYȂ)#N=?ѽYWB7> )RUwvb)F`mZɛ5٠$Lk#UXm^ \7*!vɀ?&OEQ,p ;F,ai)ž&^CL ፕB0J\_>i؅k9̑ id xRii*V؛.qnvʮ#*K䮣$?agX>Aln؜? Eq[ZIȊ)vN'3zw"+6Hs k޲hM~B)C'9Tz5_6PJ*E0IE(ktߘBGpb\d .}vmq<[D/6KtGΏtPUbYm Hl"l%>4^|u yLqTDh+WZ./'cPG tVbç՟*Ya 8S|;`GJ kղYNp 63XBfg3q?D='Bߒ]U?m`/hh.t0rFqrgյ UOz2OadD!2CqGu9Ssۮ=ƒJ+l0|]üow Q,~"HispPN^Ћu}PV\>@f=W(W;lT1F\˙PV݌'g ջ`yܧ$"б J}f >w9)ځW_\Fzcb@=qV(U?"פ9g;S$ܫf XӜ5j]=MǩDN,p'31<6)0tVe+-:-@F)pbe*;O+$Y J(4iWfZG%b:+6_]G_k93Ǚ7LyvU|T=M/7o Nmp/A?Eec/' ³亣꼯o (P!_C)<2*{M_}C],\)Mt#oSg7r*8̲iTDZh>K&+KG GfL`VҺw>!yn__z-f5ɲgv?tDNQ~w\]e,vY4{I^׾`W}KpS- Zx;$S u8"O,V[U4w:? HOym<2٥ĔkS|ՍIJ} t90u5|wimf]8RN LNm`^DLۇS`$ By|G"`Vuy%T@OˍR$%w5B; cy2=o2oTA"'/0:Xt'xAz8VI5:ϰJ?e^.9acYэn" U. nķdz(EԘ%6&7ZiM~JEa@vc_Ʈ}&|Q9[ fB֚\)C +ʟlooC;>kW>Q-VY{!AE9uD>0#c_2MʴϨU[ G9˔򕕓&r4-װlڐݗ8&B_M B:[=q.uPP8:ci\J^Mm Mj}]9,@>x^R[4f2"kDj$ϢJ:x-u) Ohv>%'<>Nzi$&!=FjѣO9XdvLSQ%)z5F5Í~fw*15HR!]v:HÜ!=~vjYOgƉ-ȰBQw+I:D46&ްz(4<2\ ]Jz] k\* OaRw,4:)ΞZ̓ڲ]QټΧ:Qci2Bs2W"+iČcEt!]zFu%KޝA_ h(: _ŒѿsJhAh.U0>Cqxf6W1oQ=FsDڻp~`ڧiP_Єia5f%tFNI:}&6Xn_I!s (}7Vb'1 2c.o9- >t˸9 `WpZ{e܎MbJh-Vr&i]Xj%PVx^k[>"YGf-S ­ rpFCbpI˽:m83, Db0Jۍ1'UNMz>>dMW@R=k]R\{8YzmtƩ=ϨQDvGl\9Z[ʨT/3=GMqf YE/Al']@cJLShU[m'Po;O].md_BWbh?Lh©}:Ƚ3/qJTw暋0!l֒ݾ,Ex|S&rk]LھiXFL27Fh*_WCR#:sCpc?(DeQD~^Y Ծg5;"}JA iO3 7kxgxVTgg >ʶe9^r0Jȏ\)enXHR XӿB!W6y㵡0Ԃ`r_P{ӑ7in=h?a5y YzGٍZHR",jyޯe8/Q: 4O5#8NfF^{3ʺ>W9-Li/EDp#|YH7&hVĜ]oY&9̇䁃%FG9`oJe'wf}R#{S2f z:iÃ!s)fd&]ָuMjR)]v291.?q×t]fؽH=硉nh0󀙙X]pGh>u`LqimϑmˑZc"Vd[NZi0fEeWyqolHvI:nVW%^8诔/fW~ iQ=PdbD/YYFV^V>ڠ7kz,%ݬĭA@H/$挒pPa%w,e.Au] cyl Άҹ9 =Ms'EG0]:n{iAɁ*ס 9dloMT}5 G`tjdM{n}EއU+!9Ox,lh7&J pC].R|>hW>LU).Q3Gl+R;iݘ>Ztj2ͳ~IMa_x"AVLrzI^rOCh_ܰ)"oo,I{/RӮ(~kg*W+M l^d;r3H4~FW)PT:)+$LGF0!6YjlќVY F[y+x~⸐֒W?墡KoRi,@u]xE1DSz,c^V՜(JاA%O&jmz̆3'׋_uuvX?\)8 [Z=C+9yT4pr'0Gqzq@`=͂Y6Y4/ȌХ,]A hEyr9s$)S ,e1~$gW"w-Zl"@b_|(3ԣveSa/QYk9a>_'HWFj>, Utܐ] nu0!z Z U_h-Gpӣad;b/b4w,AVD=Wn^lC @{JϬ|_2oEyK|a,k<u'x0 f06~[R5lbtV/@;A. (v2B8LZ46;pD4$Ġfi.S-ejwpS4mW(ӊJ^|:ʌ:Oa<168/8O YUB3d~tx?"`o3o\q uvIo:6%k}̠tUM23s0HUBxf]O V"-ȞkI;&)q ޛsn]~멞T 9 O:hchkUxE/^jӓ% ] #"RWMطUģY[֊dru!BO]ø·.w$i|1_WjlJޡP) L=HMAB0sS gD4$-{'g%]rɞ(G'ZE*M9  <8&FWz$^iocF3F'{{'T\)#'fç)=pdN\D,+s\ɍ绕4IëD QX$r)2ŔVï$ɇNI ս?1% q,zM/0N ٳ|WI)q6f=? qx "t"%K<]W> q.J{*$۩\{(T1- Iט]0_?l2P~c(a*uAŝE Z11@F>,>dOT :@ )Dy3un9ts#ldLw: m><QClh-:քL`J[&>͒aHį*MD\"+YXnޛԁ޲1 Rڷ3,_ZI* !Un#,yOoaMs+X !̪'̍F*OQzMu6-a͑ hObăσ|j >i;9KaByGB@+Vrg DGy@aUcp޻ .RJsH%פYV kB׀5W.T^R)$a:hUs0'KQkZ;bn P-ap0r z} ]x5{'z̘;Y 9΍/4ٝCrE2^Qlb1pׯEAgqfZl)Ltí{N5EVv9Oa+POM-u~u 0^F6TH@c[8ݛI\}1pKi^xŀJ*g3X5h5lyEmEh˸ X)jܝ'ٸǺydU!gwec`iSMh0<5CΔѐ"f|l8RLIִNfg/q.VyD;;E,` 3_c7)|qYl]Zr~qd!!dyS̖򜠪Qh5prJY8wyѲ$(P<׼wE] R82 ܕZ)H{.따hmm mwY-1"H5(N%;d^:4` wDNpj7ɶ+`j2Gl }۰띬d˅#ۀR(fT@ >\sMO+ˆTLfd">iU~mH~\J3JSd2aI71ze"]CɎ ț/哳N4dԣa"ةR@NŴvREuZ?"1֒g*Kw:q &UsԈv+ӰHgpbaix!Hˁ=hS?C;+.h/:| Q>NVdrgrCT6v}YR*$ i֏ɸeCZ{S)7:-㻭ߡÈ톒'eS%4E|FpS>|~j\(0 {Xʂ/1.Rs mjiɉ/HÞ̙ Y%cixcF‰{śIަĬWѷ,XXcuҡz%.Ɯ=36^xӏqbrzV1 ?C`AjoM: ς 8ew_ IGF_xWWa_D;3Ïp 9P]( 1ۣ !@DR]?q]kUKkĐ7tK^x%ٮ(}"HT&9?BHKyfx53.Y'vxq^ݿ<=bnP|L}p|GJ4p%nE޺?Xҗ bU]yʥ.vN~_mZF~ 6# Z5<Ĭ'ss endstream endobj 118 0 obj << /Length1 1525 /Length2 2317 /Length3 0 /Length 3273 /Filter /FlateDecode >> stream xڍT 8׏DeI=*e`$YHٷ՘yf<_%-JlIRh{ߐ-BيB~u}5539wnM w i, f  8w?F !6aG P#[h͈&f@"(߁ &hlA`ѴAb} HϤV! ba.CЎ :pG(Vk(pxHd@ <> ya  8CYjM# #, GS0hwp77>0{9рlt!I3H! 8 }3tAatC@3G4+W2g o8ek6HH Q!@]n0 iL! CBО:A]>6(C0n!3AE FA,Da _["`B !:Ylt<(N@GӟQ1# 1Fo򏠵5DdhIF1 D^g.thlaPQ@;Y]`gF?G 3)hBg&qz"P5 f8"~n#Ȅ! XlΏ4(d@Fb΁`C #+F>:nmaœ^=xt1D&DtG`efz&~5cQ_Lgb<$<"?L#4E?Y7]E+g1<+ J=ʀ`8" AKDG$uɒmU^ۘO»Gm X(b"9[ cMw]n鼤=ÓO"'s[T=X2=ٟ{dXۙ-}sλܯibBr2Ѫ7ZP*onh%nJr?n>Np]_9ҥiZlwQq_Lѡ[.IxwvUQؤYYt+)pk;^Ee׶,Nz?WAb2wZbScC}sR+  b]ҵ/oj(]g~+EJp7'u2!T.M\b;}ZA|#㙒j|xF; [U(QjXYTXq _{VF`Q;fNn;hٖTh,ܧ%C뎏NnSpQ?V//Hr>͎[swNz㪇Vgzf@>[vvϷ;ݏ+c_N<$kyD+iZH)LH1IO\E<Kt |T{z-~ xdl"}B-TW'evXOXtݙk8;[tFMUO~ z}18q\K*Nj:^|ט0N=[qQ&+)>^;NNj"]t8$WvƊ[3s(L,tpuM%R]RR\|dkh:B+i:O,2'ިX夏'U?Iwa}2z4L){Q]\kv`Z^VQ+k=jRslj+qGRu͘/4\"&|q?uۯpûnYǟYUh+kϛsW.*~pqCVrϞDe> j`!/Inv#ͫ \N6^vM$qWZ1RE+ulI>ڢSENQt?1]`]\?wr0hT`u/Ksھ/j֜%חP0\;㩥*o>A{ߙ(Wj2v;g6tgbQ,{-IԼpݜvNHHN^.|ܗѲZ,FLFvhN;#͏o߰_1B2Z4%鈊DOE]*C<ʵKnՈiА{v2jҚͣ34G,(y<{!OwS{,>CgyG~ƶ=i_:sC%+[S#tQr.2 _0.nJS$r,0[j⡾$_#gOXr]݆/sv_Dq+jەwJxZYYŢXYk endstream endobj 2 0 obj << /Type /ObjStm /N 100 /First 809 /Length 3908 /Filter /FlateDecode >> stream x[oƲb G8M4v/D0{91ɗE{)M ;.'Beljy^ n}}T=*'׬exR:G0~Țj<~i/^=z48ux\QL-t bDtQrڛӉ䬡go=[V")އ3;E `m0pkC0: vg "E!j2 *)V-0!dv%LKVMq.]@yo"1Ӵ2g j!VMQ*(&d"7S"s0Y VِX +Ls;"ɰ+x+A66߾{ψ,d\8Fc8@nAWP`Iab!rZ>VM3TM Sq",Fڅƿn0ITia ?ih3; И h7t|Cbwȧ1]6r~6,_ǚWŨB7:lF_w:_^q}\fr3A QQ{5^kIt]d`{-O˲Śi { R&=u~Ք,:`l\4\trb45g,vĝM&EXqY&epu#:t [ ܲ Ux,^WoqqzvԐMjԥݤ)FT\0vn,532 73 Vx p_ JPׁ[`(!.y6LW,Sa} kz,?'ȏ]A%D7v^x"ZGd +oӭkaiYmkʆoFN&4y&=R|k= .Ӿ{y41*C$\TJO ¿';'0h!$5':9.9TL 0k 1JXEQ],i1["ߪvtF+qy㻥D7id)k-ftyjޑleZQ.E7Wi}^9Z[#%wmܚZMj,FzR # M=z!9wڔ搄TzJnS9Ū䤽K ]q# :QjOԵKS0`ЖyKѾk%ܤD*Ddjܴ x B+xA{|X OKSlĐ  P ~ZlpCݳ cxIV| {ש}>jicӭ{3轩o˶lMӻN[.-ZM:~ ;Nat#N{9MVY B[dY""h#%;AeE~ghbqnzf ;O3b32tj "MV i`q/ZC[R+N\ZEO$=nao ⛳W리қ³׷o j^~^\==zGbTǏ  h\w.? 3G%9?gUhFy3WHy(x|ċQ~y9)*~/\_c>uͯ'WgEU/Ƽל^S%E5,z4GqR6l+^7UQOd<z*'; !$I#|wz0e(LG"6v͜vf=w]뉩|Ϙq{2"jTgS7¿!O?Mwhd!hK؋:LoRKU4f]|3Gy}`\gmdUª [[[խX)m?ih:rZ"x5Lrf7> endobj 122 0 obj << /Type /ObjStm /N 9 /First 64 /Length 364 /Filter /FlateDecode >> stream x}SN0+H رTP!U"{N\9)dxvv61F 8 O3XZ90n(h OEBFqVf9=G0mwO^Ն^n?Wt"L»3&<4NMcM\([L/^L71p'OMƘAKʵ\8,,vQr_m+3Ua*T]n" $ܥiT sqb}ba*1G4&Ф)2âO (AZ>ZL5o!r?;Miʍ^ۻVV=ǃTcsqZ^Q^Le;UO]z/u endstream endobj 130 0 obj << /Type /XRef /Index [0 131] /Size 131 /W [1 3 1] /Root 128 0 R /Info 129 0 R /ID [<86B8A25E89EAAAA7F6430441FDB5F610> <86B8A25E89EAAAA7F6430441FDB5F610>] /Length 317 /Filter /FlateDecode >> stream xNa{dž`{/6,Xa+W:{½o§phb(̙/∈9">,cB(D b\A R(rJjB4nZA؃])@+tB7mGA3l>t@/t_n8AS|a!u01دu0 *[&` a0 s0 I佝niYҊWҪj@,ƓU-m>,T_-mpNe9.qً^\Vz/"x+ endstream endobj startxref 143177 %%EOF GenomicAlignments/inst/doc/summarizeOverlaps.R0000644000175100017510000001722412612051202022567 0ustar00biocbuildbiocbuild### R code from vignette source 'summarizeOverlaps.Rnw' ################################################### ### code chunk number 1: style ################################################### BiocStyle::latex() ################################################### ### code chunk number 2: options ################################################### options(width=72) options("showHeadLines" = 3) options("showTailLines" = 3) ################################################### ### code chunk number 3: firstExample ################################################### library(GenomicAlignments) library(DESeq) library(edgeR) fls <- list.files(system.file("extdata", package="GenomicAlignments"), recursive=TRUE, pattern="*bam$", full=TRUE) features <- GRanges( seqnames = c(rep("chr2L", 4), rep("chr2R", 5), rep("chr3L", 2)), ranges = IRanges(c(1000, 3000, 4000, 7000, 2000, 3000, 3600, 4000, 7500, 5000, 5400), width=c(rep(500, 3), 600, 900, 500, 300, 900, 300, 500, 500)), "-", group_id=c(rep("A", 4), rep("B", 5), rep("C", 2))) olap <- summarizeOverlaps(features, fls) deseq <- newCountDataSet(assay(olap), rownames(colData(olap))) edger <- DGEList(assay(olap), group=rownames(colData(olap))) ################################################### ### code chunk number 4: simple ################################################### rd <- GAlignments("a", seqnames = Rle("chr1"), pos = as.integer(100), cigar = "300M", strand = strand("+")) gr1 <- GRanges("chr1", IRanges(start=50, width=150), strand="+") gr2 <- GRanges("chr1", IRanges(start=350, width=150), strand="+") ################################################### ### code chunk number 5: simpleGRanges ################################################### gr <- c(gr1, gr2) data.frame(union = assay(summarizeOverlaps(gr, rd)), intStrict = assay(summarizeOverlaps(gr, rd, mode="IntersectionStrict")), intNotEmpty = assay(summarizeOverlaps(gr, rd, mode="IntersectionNotEmpty"))) ################################################### ### code chunk number 6: simpleGRangesList ################################################### grl <- GRangesList(c(gr1, gr2)) data.frame(union = assay(summarizeOverlaps(grl, rd)), intStrict = assay(summarizeOverlaps(grl, rd, mode="IntersectionStrict")), intNotEmpty = assay(summarizeOverlaps(grl, rd, mode="IntersectionNotEmpty"))) ################################################### ### code chunk number 7: data ################################################### group_id <- c("A", "B", "C", "C", "D", "D", "E", "F", "G", "G", "H", "H") features <- GRanges( seqnames = Rle(c("chr1", "chr2", "chr1", "chr1", "chr2", "chr2", "chr1", "chr1", "chr2", "chr2", "chr1", "chr1")), strand = strand(rep("+", length(group_id))), ranges = IRanges( start=c(1000, 2000, 3000, 3600, 7000, 7500, 4000, 4000, 3000, 3350, 5000, 5400), width=c(500, 900, 500, 300, 600, 300, 500, 900, 150, 200, 500, 500)), DataFrame(group_id) ) reads <- GAlignments( names = c("a","b","c","d","e","f","g"), seqnames = Rle(c(rep(c("chr1", "chr2"), 3), "chr1")), pos = as.integer(c(1400, 2700, 3400, 7100, 4000, 3100, 5200)), cigar = c("500M", "100M", "300M", "500M", "300M", "50M200N50M", "50M150N50M"), strand = strand(rep.int("+", 7L))) ################################################### ### code chunk number 8: GRanges ################################################### data.frame(union = assay(summarizeOverlaps(features, reads)), intStrict = assay(summarizeOverlaps(features, reads, mode="IntersectionStrict")), intNotEmpty = assay(summarizeOverlaps(features, reads, mode="IntersectionNotEmpty"))) ################################################### ### code chunk number 9: lst ################################################### lst <- split(features, mcols(features)[["group_id"]]) length(lst) ################################################### ### code chunk number 10: GRangesList ################################################### data.frame(union = assay(summarizeOverlaps(lst, reads)), intStrict = assay(summarizeOverlaps(lst, reads, mode="IntersectionStrict")), intNotEmpty = assay(summarizeOverlaps(lst, reads, mode="IntersectionNotEmpty"))) ################################################### ### code chunk number 11: gff (eval = FALSE) ################################################### ## library(rtracklayer) ## fl <- paste0("ftp://ftp.ensembl.org/pub/release-62/", ## "gtf/drosophila_melanogaster/", ## "Drosophila_melanogaster.BDGP5.25.62.gtf.gz") ## gffFile <- file.path(tempdir(), basename(fl)) ## download.file(fl, gffFile) ## gff0 <- import(gffFile) ################################################### ### code chunk number 12: gff_parse (eval = FALSE) ################################################### ## idx <- mcols(gff0)$source == "protein_coding" & ## mcols(gff0)$type == "exon" & ## seqnames(gff0) == "4" ## gff <- gff0[idx] ## ## adjust seqnames to match Bam files ## seqlevels(gff) <- paste("chr", seqlevels(gff), sep="") ## chr4genes <- split(gff, mcols(gff)$gene_id) ################################################### ### code chunk number 13: pasilla_param ################################################### param <- ScanBamParam( what='qual', which=GRanges("chr4", IRanges(1, 1e6)), flag=scanBamFlag(isUnmappedQuery=FALSE, isPaired=NA), tag="NH") ################################################### ### code chunk number 14: pasilla_count (eval = FALSE) ################################################### ## fls <- c("treated1.bam", "untreated1.bam", "untreated2.bam") ## path <- "pathToBAMFiles" ## bamlst <- BamFileList(fls) ## genehits <- summarizeOverlaps(chr4genes, bamlst, mode="Union") ################################################### ### code chunk number 15: pasilla_exoncountset (eval = FALSE) ################################################### ## expdata = MIAME( ## name="pasilla knockdown", ## lab="Genetics and Developmental Biology, University of ## Connecticut Health Center", ## contact="Dr. Brenton Graveley", ## title="modENCODE Drosophila pasilla RNA Binding Protein RNAi ## knockdown RNA-Seq Studies", ## pubMedIds="20921232", ## url="http://www.ncbi.nlm.nih.gov/projects/geo/query/acc.cgi?acc=GSE18508", ## abstract="RNA-seq of 3 biological replicates of from the Drosophila ## melanogaster S2-DRSC cells that have been RNAi depleted of mRNAs ## encoding pasilla, a mRNA binding protein and 4 biological replicates ## of the the untreated cell line.") ## ## design <- data.frame( ## condition=c("treated", "untreated", "untreated"), ## replicate=c(1,1,2), ## type=rep("single-read", 3), ## countfiles=path(colData(genehits)[,1]), stringsAsFactors=TRUE) ## ## geneCDS <- newCountDataSet( ## countData=assay(genehits), ## conditions=design) ## ## experimentData(geneCDS) <- expdata ## sampleNames(geneCDS) = colnames(genehits) ################################################### ### code chunk number 16: pasilla_genes (eval = FALSE) ################################################### ## chr4tx <- split(gff, mcols(gff)$transcript_id) ## txhits <- summarizeOverlaps(chr4tx, bamlst) ## txCDS <- newCountDataSet(assay(txhits), design) ## experimentData(txCDS) <- expdata GenomicAlignments/inst/doc/summarizeOverlaps.Rnw0000644000175100017510000003255612612051202023141 0ustar00biocbuildbiocbuild%\VignetteIndexEntry{Counting reads with summarizeOverlaps} %\VignetteDepends{} %\VignetteKeywords{sequence, sequencing, alignments} %\VignettePackage{GenomicAlignments} \documentclass{article} <>= BiocStyle::latex() @ \title{Counting reads with \Rfunction{summarizeOverlaps}} \author{Valerie Obenchain} \date{Edited: May 2014; Compiled: \today} \begin{document} \maketitle \tableofcontents <>= options(width=72) options("showHeadLines" = 3) options("showTailLines" = 3) @ \section{Introduction} This vignette illustrates how reads mapped to a genome can be counted with \Rfunction{summarizeOverlaps}. Different "modes" of counting are provided to resolve reads that overlap multiple features. The built-in count modes are fashioned after the "Union", "IntersectionStrict", and "IntersectionNotEmpty" methods found in the HTSeq package by Simon Anders (see references). \section{A First Example} In this example reads are counted from a list of BAM files and returned in a \Robject{matrix} for use in further analysis such as those offered in \Biocpkg{DESeq} and \Biocpkg{edgeR}. <>= library(GenomicAlignments) library(DESeq) library(edgeR) fls <- list.files(system.file("extdata", package="GenomicAlignments"), recursive=TRUE, pattern="*bam$", full=TRUE) features <- GRanges( seqnames = c(rep("chr2L", 4), rep("chr2R", 5), rep("chr3L", 2)), ranges = IRanges(c(1000, 3000, 4000, 7000, 2000, 3000, 3600, 4000, 7500, 5000, 5400), width=c(rep(500, 3), 600, 900, 500, 300, 900, 300, 500, 500)), "-", group_id=c(rep("A", 4), rep("B", 5), rep("C", 2))) olap <- summarizeOverlaps(features, fls) deseq <- newCountDataSet(assay(olap), rownames(colData(olap))) edger <- DGEList(assay(olap), group=rownames(colData(olap))) @ %% By default, the \Rfunction{summarizeOverlaps} function iterates through files in `chunks' and with files processed in parallel. For finer-grain control over memory consumption, use the \Rfunction{BamFileList} function and specify the \Rcode{yieldSize} argument (e.g., \Rcode{yieldSize=1000000}) to determine the size of each `chunk' (smaller chunks consume less memory, but are a little less efficient to process). For controlling the number of processors in use, use \Rfunction{BiocParallel::register} to use an appropriate back-end, e.g., in linux or Mac to process on 6 cores of a single machine use \Rcode{register(MulticoreParam(workers=6))}; see the \Biocpkg{BiocParallel} vignette for further details. \section{Counting Modes} The modes of "Union", "IntersectionStrict" and "IntersectionNotEmpty" provide different approaches to resolving reads that overlap multiple features. Figure~\ref{fig-summarizeOverlaps-modes} illustrates how both simple and gapped reads are handled by the modes. Note that a read is counted a maximum of once; there is no double counting. For additional detail on the counting modes see the \Rfunction{summarizeOverlaps} man page. \begin{figure}[!h] \begin{center} \includegraphics{summarizeOverlaps-modes.pdf} \caption{Counting Modes} \label{fig-summarizeOverlaps-modes} \end{center} \end{figure} \newpage \section{Counting Features} Features can be exons, transcripts, genes or any region of interest. The number of ranges that define a single feature is specified in the \Rcode{features} argument. When annotation regions of interest are defined by a single range a \Rclass{GRanges} should be used as the \Rcode{features} argument. With a \Rclass{GRanges} it is assumed that each row (i.e., each range) represents a distinct feature. If \Rcode{features} was a \Rclass{GRanges} of exons, the result would be counts per exon. When the region of interest is defined by one or more ranges the \Rcode{features} argument should be a \Rclass{GRangesList}. In practice this could be a list of exons by gene or transcripts by gene or other similar relationships. The count result will be the same length as the \Rclass{GRangesList}. For a list of exons by genes, the result would be counts per gene. The combination of defining the features as either\Rclass{GRanges} or \Rclass{GRangesList} and choosing a counting mode controls how \Rfunction{summarizeOverlaps} assigns hits. Regardless of the mode chosen, each read is assigned to at most a single feature. These options are intended to provide flexibility in defining different biological problems. This next example demonstrates how the same read can be counted differently depending on how the \Rcode{features} argument is specified. We use a single read that overlaps two ranges, gr1 and gr2. <>= rd <- GAlignments("a", seqnames = Rle("chr1"), pos = as.integer(100), cigar = "300M", strand = strand("+")) gr1 <- GRanges("chr1", IRanges(start=50, width=150), strand="+") gr2 <- GRanges("chr1", IRanges(start=350, width=150), strand="+") @ \noindent When provided as a \Rclass{GRanges} both gr1 and gr2 are considered distinct features. In this case none of the modes count the read as a hit. Mode \Rcode{Union} discards the read becasue more than 1 feature is overlapped. \Rcode{IntersectionStrict} requires the read to fall completely within a feature which is not the case for either gr1 or gr2. \Rcode{IntersetctionNotEmpty} requires the read to overlap a single unique disjoint region of the \Rcode{features}. In this case gr1 and gr2 do not overlap so each range is considered a unique disjoint region. However, the read overlaps both gr1 and gr2 so a decision cannot be made and the read is discarded. <>= gr <- c(gr1, gr2) data.frame(union = assay(summarizeOverlaps(gr, rd)), intStrict = assay(summarizeOverlaps(gr, rd, mode="IntersectionStrict")), intNotEmpty = assay(summarizeOverlaps(gr, rd, mode="IntersectionNotEmpty"))) @ \noindent Next we count with \Rcode{features} as a \Rclass{GRangesList}; this is list of length 1 with 2 elements. Modes \Rcode{Union} and \Rcode{IntersectionNotEmpty} both count the read for the single feature. <>= grl <- GRangesList(c(gr1, gr2)) data.frame(union = assay(summarizeOverlaps(grl, rd)), intStrict = assay(summarizeOverlaps(grl, rd, mode="IntersectionStrict")), intNotEmpty = assay(summarizeOverlaps(grl, rd, mode="IntersectionNotEmpty"))) @ In this more complicated example we have 7 reads, 5 are simple and 2 have gaps in the CIGAR. There are 12 ranges that will serve as the \Robject{features}. <>= group_id <- c("A", "B", "C", "C", "D", "D", "E", "F", "G", "G", "H", "H") features <- GRanges( seqnames = Rle(c("chr1", "chr2", "chr1", "chr1", "chr2", "chr2", "chr1", "chr1", "chr2", "chr2", "chr1", "chr1")), strand = strand(rep("+", length(group_id))), ranges = IRanges( start=c(1000, 2000, 3000, 3600, 7000, 7500, 4000, 4000, 3000, 3350, 5000, 5400), width=c(500, 900, 500, 300, 600, 300, 500, 900, 150, 200, 500, 500)), DataFrame(group_id) ) reads <- GAlignments( names = c("a","b","c","d","e","f","g"), seqnames = Rle(c(rep(c("chr1", "chr2"), 3), "chr1")), pos = as.integer(c(1400, 2700, 3400, 7100, 4000, 3100, 5200)), cigar = c("500M", "100M", "300M", "500M", "300M", "50M200N50M", "50M150N50M"), strand = strand(rep.int("+", 7L))) @ \noindent Using a \Rclass{GRanges} as the \Rcode{features} all 12 ranges are considered to be different features and counts are produced for each row, <>= data.frame(union = assay(summarizeOverlaps(features, reads)), intStrict = assay(summarizeOverlaps(features, reads, mode="IntersectionStrict")), intNotEmpty = assay(summarizeOverlaps(features, reads, mode="IntersectionNotEmpty"))) @ \noindent When the data are split by group to create a \Rclass{GRangesList} the highest list-levels are treated as different features and the multiple list elements are considered part of the same features. Counts are returned for each group. <>= lst <- split(features, mcols(features)[["group_id"]]) length(lst) @ <>= data.frame(union = assay(summarizeOverlaps(lst, reads)), intStrict = assay(summarizeOverlaps(lst, reads, mode="IntersectionStrict")), intNotEmpty = assay(summarizeOverlaps(lst, reads, mode="IntersectionNotEmpty"))) @ If desired, users can supply their own counting function as the \Rcode{mode} argument and take advantage of the infrastructure for counting over multiple BAM files and parsing the results into a \Rclass{RangedSummarizedExperiment} object. See \Rcode{?'BamViews-class'} or \Rcode{?'BamFile-class'} in the \Biocpkg{Rsamtools} package. \section{\Rcode{pasilla} Data} In this excercise we count the \Biocpkg{pasilla} data by gene and by transcript then create a \Rclass{CountDataSet}. This object can be used in differential expression methods offered in the \Biocpkg{DESeq} package. \subsection{source files} Files are available through NCBI Gene Expression Omnibus (GEO), accession number GSE18508. \url{http://www.ncbi.nlm.nih.gov/projects/geo/query/acc.cgi?acc=GSE18508}. SAM files can be converted to BAM with the \Rfunction{asBam} function in the \Biocpkg{Rsamtools} package. Of the seven files available, 3 are single-reads and 4 are paired-end. Smaller versions of untreated1 (single-end) and untreated2 (paired-end) have been made available in the \Biocpkg{pasillaBamSubset} package. This subset includes chromosome 4 only. \Rfunction{summarizeOverlaps} is capable of counting paired-end reads in both a \Rcode{BamFile}-method (set argument \Rcode{singleEnd=TRUE}) or a \Rcode{GAlignmentPairs}-method. For this example, we use the 3 single-end read files, \begin{itemize} \item treated1.bam \item untreated1.bam \item untreated2.bam \end{itemize} Annotations are retrieved as a GTF file from the ENSEMBL web site. We download the file our local disk, then use \Biocpkg{Rtracklayer}'s \Rfunction{import} function to parse the file to a \Rclass{GRanges} instance. <>= library(rtracklayer) fl <- paste0("ftp://ftp.ensembl.org/pub/release-62/", "gtf/drosophila_melanogaster/", "Drosophila_melanogaster.BDGP5.25.62.gtf.gz") gffFile <- file.path(tempdir(), basename(fl)) download.file(fl, gffFile) gff0 <- import(gffFile) @ Subset on the protein-coding, exon regions of chromosome 4 and split by gene id. <>= idx <- mcols(gff0)$source == "protein_coding" & mcols(gff0)$type == "exon" & seqnames(gff0) == "4" gff <- gff0[idx] ## adjust seqnames to match Bam files seqlevels(gff) <- paste("chr", seqlevels(gff), sep="") chr4genes <- split(gff, mcols(gff)$gene_id) @ \subsection{counting} The \Rcode{param} argument can be used to subset the reads in the bam file on characteristics such as position, unmapped or paired-end reads. Quality scores or the "NH" tag, which identifies reads with multiple mappings, can be included as metadata columns for further subsetting. See \Rcode{?ScanBamParam} for details about specifying the \Rcode{param} argument. <>= param <- ScanBamParam( what='qual', which=GRanges("chr4", IRanges(1, 1e6)), flag=scanBamFlag(isUnmappedQuery=FALSE, isPaired=NA), tag="NH") @ We use \Rfunction{summarizeOverlaps} to count with the default mode of "Union". If a \Rcode{param} argument is not included all reads from the BAM file are counted. <>= fls <- c("treated1.bam", "untreated1.bam", "untreated2.bam") path <- "pathToBAMFiles" bamlst <- BamFileList(fls) genehits <- summarizeOverlaps(chr4genes, bamlst, mode="Union") @ \noindent A \Rcode{CountDataSet} is constructed from the counts and experiment data in \Rclass{pasilla}. <>= expdata = MIAME( name="pasilla knockdown", lab="Genetics and Developmental Biology, University of Connecticut Health Center", contact="Dr. Brenton Graveley", title="modENCODE Drosophila pasilla RNA Binding Protein RNAi knockdown RNA-Seq Studies", pubMedIds="20921232", url="http://www.ncbi.nlm.nih.gov/projects/geo/query/acc.cgi?acc=GSE18508", abstract="RNA-seq of 3 biological replicates of from the Drosophila melanogaster S2-DRSC cells that have been RNAi depleted of mRNAs encoding pasilla, a mRNA binding protein and 4 biological replicates of the the untreated cell line.") design <- data.frame( condition=c("treated", "untreated", "untreated"), replicate=c(1,1,2), type=rep("single-read", 3), countfiles=path(colData(genehits)[,1]), stringsAsFactors=TRUE) geneCDS <- newCountDataSet( countData=assay(genehits), conditions=design) experimentData(geneCDS) <- expdata sampleNames(geneCDS) = colnames(genehits) @ If the primary interest is to count by transcript instead of by gene, the annotation file can be split on transcript id. <>= chr4tx <- split(gff, mcols(gff)$transcript_id) txhits <- summarizeOverlaps(chr4tx, bamlst) txCDS <- newCountDataSet(assay(txhits), design) experimentData(txCDS) <- expdata @ \section{References} \url{http://www-huber.embl.de/users/anders/HTSeq/doc/overview.html} \noindent\url{http://www-huber.embl.de/users/anders/HTSeq/doc/count.html} \end{document} GenomicAlignments/inst/doc/summarizeOverlaps.pdf0000644000175100017510000050406512612051202023143 0ustar00biocbuildbiocbuild%PDF-1.5 % 47 0 obj << /Length 1867 /Filter /FlateDecode >> stream xYIs6Wp<=Hmfة3M3^LG(YSIt$ڱ6PL/\)x@$W; Ϗw4PiMq\4 #x^y\T~h- B}9\ǯ'%#Q0vq_9e ܊pf$0G(j0c-y0'j&t+6)Tkc\>DK:`m,5,SϒԻR~Wc1ԑ04iͺc;&% Ou}U0WSzig|h{E\F,l-rBq+?T4YP~hT=33vlc f󎽮\u ?F^d^o97ˠO ^"Gؕ?q[א:7 'r L=I "JG<*yҋ,gDm>+^^^mДtɄ)*]+ 8d 2iV|abyY-uz`[Sl(,=YKNiz>n=-gD9y8s5XaU/8|vI>~+aE]}b:aDT* bw_`x|ϟ%L:)|OWH̚[#.|mLtzB6n6,3eE|h Q[h g_y fVHk 4&DIxWi힛W/lI(WBfxtmՠMhaj@e SZT d;<"|CHErhժ9}W fg.Ijt݀3}Q'pK#ן^IE7;M")ϝ>+MÇ]Zo& 7TסaۅI_nL`JM͆p=VH+9@@u x ̑pDƇ]\]XL^0 Vb8ƍ  ]2Y+d(+[LFdwPrG,NTw7ECc;9UYKQśz ~.ߜwI#"kRiJ9pV4_4ljH𪜵3fH5~헤Aܓa}s]sĺᦇj:ƍK2䤛v?dwIReI{h_On ݆Yw߮u:v{mw} ߒqP)ȁNӻ}+}j}qWuށeP+{;8F[rcs(Saeods` endstream endobj 65 0 obj << /Length 1652 /Filter /FlateDecode >> stream xڽXKDWr\͌4pd)(,$Ux-e9vӯaY#[/r/"]5،(}V' L.^H#}"aʌL_J 2_7b wn .Q&7X22xwq@W'Ze&{'H$43~[Ȧ_ g_i%zSm1XWޜgVSgB$x㵅l}ĵa%c3"hN"!~G`-bϸ6n͝GYSeSg(J[*[fNAI"oX9G(vra5@-ɛwITT,]t eȜZ7A֖Y@.9%H1a%U:#­'Sk뵉^H.J [/ xg?t&ᓾ#[ۿ@;2 =G%,zj>P! #BaOunG(W>?='U6Y `8\Su٘|f9]d#'eH|qOۯFRs(耂e*o BU>SXC̨~\ePu&ka mˡ94Gz=WJɢF;ΊQ1ݰm|w-Sl9_ty#89/+|z_E8 }ZܱcQKڍd}oT_N\M%v8^#|/d endstream endobj 70 0 obj << /Length 870 /Filter /FlateDecode >> stream xڥUn0+x!MK(zHrp,yl˕wJJcA Ǒ`+&lrqi4+xa3fKf,bN[.46yʤ>߾?U:UJ% t9-Nd#t~vy(oTSw0&0)оS׶w cZXnG( zs L2!c&4/fۄ[#s0BE;ՓOc4fR?g>3_dm\i!,`l$NR A6Ltf |6\ L V A^}"l˾h?i n"bS5Ћsb!Gp']Cܣѿnd6LxnIacXaN&f8xd5[EYz.eXE&F/d`/.(f1tڂ“2M=R!|IT{zN׫=O3`߬]2h28^D| D&qWynD@5z߳ejUaS B LD得D){`Ď+v+E*h;Fo *ƈn>XkK5%% (AS;Rt÷&2# @=Y204PbBwrX yI*ldu  OU2%[k/O諠"G48 TXvWg>= v endstream endobj 62 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (./summarizeOverlaps-modes.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 73 0 R /BBox [0 0 612 792] /Group 72 0 R /Resources << /Font << /F1 74 0 R/F2 75 0 R/F3 76 0 R>> /ProcSet [ /PDF /Text ] >> /Length 1902 /Filter /FlateDecode >> stream xZK7 W9z, ؛]&-u撿_>4<?"%lÏͿAaLfuۇ៍&Sa;!Aq0_o6ƺO~kgTřm,8!VA 5O*XbfA <04bh> ^[bz$l=@jNgaTԢǍkXP ح9VMǓH3K S(xI*6FUx2;='9ÎM; U DE)bYeKM(J/KJqC1YP -.󞙟R]7[j2OOux^iev^Y`lt٤"Ǹ*D`OÐvwcr;Iv,’~$G>]Z1Jln ,Ch ԐujzQut@ .9p.QWځ=L>R.;A윃Ʈ䜨έcPvиNv+.цW.q]~g&cCT3eޤk9VTFѯS :a.ܣ:S,PDhX]gzUt|r@`}5(QDcDZ%- tHUjpunu aXSQxWS bR\ @CR^8a7YeL P,vtK endstream endobj 78 0 obj << /Length 295 /Filter /FlateDecode >> stream x]Mo0 9v@HH 4B~m:smO$F9;aiƕ_eI6aM?KCnn᫣:x`ɫSԄY#+Ku[Ҏk]~Y˟X)=EN fJpBQr,]/?[i ە3%8%"xG>l#Hu<o"ID"&{&:ҟ#WTGNq ;]˛sa|0[6S;3* endstream endobj 80 0 obj << /Length 369 /Filter /FlateDecode >> stream x]n0 em˺w)BZ[Fm ,rei!\;X*]hDIX'1r,#4B)&aV) \|d f|@.)LҹyB.c/??z%?9#J)c):HOS+?xS;͟eAm2'jl8}֍ v7;8a=꒸ endstream endobj 82 0 obj << /Length 269 /Filter /FlateDecode >> stream x]j >aqB`ٲCд`t 1}uܶЃgᛱtѡxV訍KLڐSeExY8RDm-ΌiHsKݝ/^fK~u f02ҶT< ,f(PTL}s@9e" ^ HXK%`Կ\ɲd𱴌Uu#će T%>fƚ:3O|B,=jd1gt*Wظh7M .|_ endstream endobj 83 0 obj << /Length 86 0 R /Filter /FlateDecode /Length1 29464 >> stream x} x[Ź9Z-Z,YeIG:lKE^ǎ+8$'8,NXKh-R(r 嶽 -iP(z9v }}C'3?o3sd;(Ң݈EBX C!l4/*$B*Ͻg![O rk#`4z=B@b.RBm{/ f7 E?\.ҿ=rXœlu_C쮱X M!HDtS>"d|0<PA ++*uFKoKȎPeH :A6_:fb>ZE[aQ3.B]H 1a"9NCGmYX:nA{p.Z<eEtLzF߇VKh-L=s }ݎӑ z0z( Q+BЭ@C#G%Y _A ݊BSxN&OrM`%թPԓw7%&Ы2o@e8 (at:FXۣr|MOD}hė9-?!; `}at/=Zv|}Uf] !q6q{`h2TF!| >:c?U@ ]Z{!:^g9>NUL#qso r(_xn_*P'>ZR%t& {`\/F:rj+A*f} gnVvx: ^WjcwNA[^<\VZR* y\/qs.#Ǟm˲fZ&Aj*B.c ^.M||kk4D4&8hj9'R4\L0>)"&6p6X5\gM<77M|78Mv 藺`pYM\r͉{{!MZ#M Ci5%!l`5Sl9a 69ҟ\dw oI ~EB(NP4&tn*YKla M SYg@u^;9k#ս{ov-uhX&wo L9bzfcJ`JJ\_o&-r 5{i/&{or'#(ۻw'|w)]75c8۹=C(Cz > Qt[,& \t*E޾*@O7Q~PBػPCmæ{kwo ϵMs~8k]lћ쉖u"qM=,˔ha?Pβ*!eO(M){#J!a6(+`xLm3`nc.d; G@lfS'ݭ]YzJϧ?Ojck1f:sz$'_Ots&wyә2s`9<?W@sX=|ՊR`]x+b\W ŝc*ҥdu~2|GVSn8Czŵ5OIqqi>_nz&WBy::OBzd={Pb4gfVTþ<_N]=y>)k*ÿ̩^mտ\la|u&~f}=\ܡqϜyɐ['=N3(Ȏ EՇ4jΦ愪 \kW/Y\°/>.6Wm?w2/Fr4+s.),|y7i9+SgCƬrҖ !ߜ️%M35aZJh)ްVرZg< ! }z ZNjX\5:G4Ȭ ZFjtlzz='KD=4L8.9Z-Jj>ޣ<%?z/3ʭS {yylƼ:S+mwy\*sm}@}f \0c4EDa BsZ7µ=e4 9 eo.#,+(~`s1\> amdLS @+RԌZ` ZΥct,D5夘0-3BpŠY1rd\^g) 9st*s!jO-Q;{=xNS➒bp+2>"Q_æaӦ5+a /;c䀹yx]:>CnAz:i"UOSU vZj @X/òl+Ţ3äg/<'zĘ!.-4)֦56}8j<+`{:YFaמA L99Ò(>{Nv-Uuƫ*ÔV>Nl m?frM+tc}ݺ}Y*@cJPS6YI6[IPw|{tϝzX*k(ә}WO<+_m=+/yoϼIfB-Tԧq&N3^9dd]v^I#JjO4!m,m.M2&ƹIt1)v Tt[# rh3(z)VϼyfYp7;]Xd~D`XkId W $kRen[B>>-C3f fr X#hẌ́:aY.8䚇v,!%gL˔ٜ!hd'ʘ8fز;.w X ^i3zywjX82 /ĕVyx>CCsݗv]uh}g_re-܂w?9EK pХ0{̣AK4kʬM6YYҦ-#`G=;i5^T&V28sdv_R>3Z:B):;w]2u(;)yBƧ֘1?]I;*USlh)3ÆE?hl:cX@NTrdZsI.S.ݺxg-98 NG=7#~qI%ŏ T`G1{%`6eu CPA+5g5y\+ש ,ڕ6BZTBw0. S؉s) _Y.vWv6q@ٟg6ݑWI (MNIc]F0Ybr >,<^J0ׄ7GaEؤWTJ"._p|Ots2M\' YaJ0U\MsJ,x=)30p>h 4h dH\>E)@@9F vҭ2End"өwΦ~71A$SDwo\NP o6~42 CB>$ZA̹A` XR0Ԟx;ESdq-û/zz!2xrqxIp" \E]̗4Ԙ91Ɲ6x_o)^^;x[pW>zhb0/ VzoqK_S;veU$~u|G^5V#~Qp!7_PouPHp~5;12v>y,׈%9Iس㓘a3X;ÒezۈiVF6B 8#G7}+)UJx|ΑǕX`JW?=H΄X~j jcux5&k5ݞ{&s~ʥI ?=zr_|jYZa= *Ju~/Ҧꦎzk,PDNdNmEuVE;ݬ"ʀ8Ko C1 E`k7 gT;&A*6+\L%spq.ŗ -M(ېdo)U>Fe;; KI"Pxyy ˗[kf<>,!fAH7e/421@aWIfWr&1Oϩ*b Yp0)f=Km^|,f(q}yEdj \;B~~*Ll,veטrs ű=rEo>.t=۩o}A>T098xf{ :ʮś6\>e6pˉ_'M&VUBة6 9^WPѓajJoy1J;8ېcza3u=VJT"ƚҫ1:Ǽӎ}NWzE=}[4!-"{,MՐݐ^Av 9zP{7GJr7+7vn<'ßɌr(2L2 fl0rD 89&qҠ2!)3|Tӛ?!Q/1&.c85I' 0|/s=lͻƺu<¬ars5|U6ݓrsa1ooFA%C8)ll}[`U=\Qt#%ƴ[[nޗliiL(,wZjr(90BG@ 7(XJ,%3`dV5sTU_ڬ&KPkL=dǔ/)z娒Q <`Bh`:/pg@Ɛ9?pLԹ9[K z^"d6sFbN=FjPd{HB5kk;x|-<1eV%W>Pg)|>m@$#\/]a(OVe>Po3'ƙ+.\ /97v@RL.t 6\BR@ŕӢ6 {^W>uוBx]ỷGxa,^W += ˜2@Z[ilRdg ֹVY՚׻ޟm;mێX^s{EA ҮcAV 2אUTW4p/m8hH45!Ȏ7 7y+8{{!\M9ɻXN `Aw pyC%vF'Wr|%"'V(l'BR'kkUS93ORV)1}KleZ6ZQuhZU ,ZiA=c+ Bπ;ҤBY,:JZkĺ^7H$C5r솉4W lgV,T|3tl3 ;&s  9yA9dwʡ)|Cㆍ:oe~pX<{&w}|Z4;K/M ^m>^qP_  6SHW %2Pu) R^GVTkJIa2*r}.nt@gJ")f-R(ΰ;K0%BIgXDu&AS;=km9Nu2pVrLAkEQDB-YJ$zZ|SJL^Af9m×[U}Nt_6PՅtPBt),L@~fJ悛V{PK͜mtYp }tcw(ۖ"%/ry~bH[rڗΜ.``Ŭ`pyἦ<6wɏf?P 9e8C#_`- ={f(UQ ~I8OeQYļgiE2Ԫjɝ'zGUL_fdk*1/Ek_75?ؾW4Ϳ-i\uet9*>˞_czk:ܓuYn!zivƚBOqoAKo7~ܞY_ʦ?7u+-gjE1)\st=ߌ.ZD܏QQsObY j!t@~PvΥoDjT-Tv|by.h=$وVB#P5{!nBfc't H0X~ ,<+ TKH _H]ϼ/in ֠ կ$XԭSVW%-26|_1K0d̢ cːxˑx+P^ Va$X2LFe/2La%ы.l? ڵ$X mRXM`Я%@Ǿ\Af C ZA?K07!ߜ@~wI07 C I0 ӈ/I0h7,C d- R8X~`PqN (cLL " (l&K0SNa /` seR'$?KaOI0Ź+%l Or ~{(ߖ`/Kl  Ha?OQ|DI$(j`_"ʏhZI;OTI3z)yShBc(PAɡ!m@nGhR\P#&&yڇ(-0&R -rơ3&qbF~nUUSTJ[`0`V!NGz1H穣Bi:IqF-Wy?{yq#kF:[lqu*9t` 4 >1Fxqٱ 5m8\ߥ#>6AWZ!5N@A%pLsGk| =@K8$@5Fy} O-¼1XQjo'jCM)2%aP-?N9I5[-D,H9P"wg1Aѵȇ@}/hJ24#]ɀ> 8mPZ&Q3(P]$an E)_#R9"vRms9*IP3%REaLmA"ֶR9EstsQShJ-Jm!Oѷ#Pm'|TK%,hDtdDI8)zDeFvPC2VF>Ad=!=m6a|L\ j9]./ڥ()+qE랤)MҵsvRZb#KJ'5BI:H.BgO)ODi\/HqO.D={&#ar4F%;$EOsNŅ8uɼ$vSIO,/.bO,۳-a5>[/cΞ bYQOГTzDZv)JjL\W+:k?P<ŖFiVG>,eQzro( qhQi?=w_\Q=WE>$gaY@O Hý0*nA^ ܖÐyCt!j0z\ wJ:Í$BwƅЇnD܆(>:2&qtblt"ƆH&bq.26H<tRe 5Dw"cщBnf987 Ź mqܪ87--$0 &0e뛈Rƀauh$2q;AXvP79򀡡hUĖ>ahhbtr 腋^ĆvDaQU&F ;&&'`Y6"}1nE$%Aغ8HqOi2FFvF'ƢH|<$,r;b)Pm`d"cZ|/m鏌Qn+YG0Y0薡L<96 H;QLetp}P9deh{dkdH4&ZD< QBG&%plƆ#SbcD|h0 vY]dNh0}8=NMh{lsqxdwF%!k6jYذa՚nM zUcsfa 4]E! PH c\j "75:IF@4YBzXazdD4JVuð(ktK< i;q@AI |[.%'D4)y/Y`#܎$ )X,_:</>/>/>/>/>/>/>/ {5Җ舕4;r\oCנow_#ZQ>gGlƉX4*?\N$0IOb=Tk_92NL(UrY|ɘO,f'F$K|g1ۤ3O %؈~s1x4/7 1#9;\*B(e2v$sJmprANfiJX!U"0Ԑ&C-H 0h:j&ǡyǘ0{fFQ*4ؿNH J$iH LKDR࿅8HY1 Ǵ.@"oddLtKJ;og؟#Ai(P>=3zCnMv 6-v*>*dhN:/mHc^AQb8<.vݖ,uqG{S}cF!4XJc_c!3`,K;BJfgԺ Zv9 bqIsy|Q&c W'-({ wwRUF]z\z_@3*E >sB}W/o&MP͛774"c_@! HN%AG(/=^^0ahjFN8"iʠhWhKcGk 1kVQ t)gd/j-rQ0pcnj*=TC#={ KA: >H!Ih` fH,wΤKGMtdz1J՚x(+gX{m#Yv$]$ &3U5G6 $բ4ΤtM1Twl-u1%_c,nh!/1Rv)tR Y 襠Rt XSJAbAmH zH =$$9m@{1 ~H P AnH Azc0bwCJ@z%;47XQ!BmB FxfeiôQ% dUԻlZPwYS375eWXMߴ~;kܯدd5haCx [Xt fA=VR[ujgҋo |+ ʅ"skl3;NX ` ^͘f%S4ٯ9Ih45bNq\qRBީU)v++(.eHY@ O@bnS@{ ?Ni1Z y1 @7:$Bm B+x2ȋޓ^&2s 5 tSy<z!y'xȋ <+ 6;!E!!Қr$r}&t,s{ X8"3 zv {;cnK6ےŢ쥆j. ;;)B)~$ ?8n3 xs;<gvA.AàLMFiy49dr2(f"I ZN\/hxyݏxݷy]CsB4 ^ݫ^S^7ޣ_#%Znʇq9}^t?t?twqnNW: l:5叄u=ʀlI=Re|1ұiIkUӂq'sI7@aO";>EFfWCp2q1ڤtkB y_I??(O8x/9]R| 0@99 _G,#1B9lGaTs9N|({W,+9P77C)(nOz|JVe,nd;0lA1l/b[gP %N[! ֍rI{O/Ad;I !ҠBp#9"$ŀVX.J69*2ƕo* ~!'+9P39 2YM2eL !\4@)!aY1z_UoPtݗ?`}``VU,K|]r]Sϸ.'Y]CuAXVovS?k}9]C]Ѫ::@G=]ТDF(g~溰{ x7 H* wJҩ4L**]UT*JbTH3;f e60w b(1mW$*mԺDU-켸_m>ԶKik7% 0 +9|v ]8EF\g'quwwY:cuKdRtsj-m8H98 367adבv< h(cj'1:,AÇP]"H4k(&q){nHM~&Hha-Ҁ*!_)^{;_7H,g}"Gg1o 3wtWoBMܴc0+{ !#-}D;hSbo-.ҽo:7tMf>=ӱjn\jCU:?{tw\dնnn:B+_k Io鵻Wd,sg]eT}HNh $l6.piҕN+en>F~g55|Ic1QYbG> stream xy\8|<3><0+;CHx0;H!a 14Xh ֵ5uKCQ*ZXf~*moU;!j#Os9 gFz" ݻҏ~(Ba}a>[w}+>DCmOW!wv\_P#Tb'AA yߎ]W|Qz䓐3GI/uEe"!]z?= #I _;H}:ӛ{p{0<bgXN$HerRhuzCdXmvGŻD7CX\ȎP= v"3?m(s*CV#5ڇ_Acb2d"t'z]2 &kqQP*6MSJӸC W0Qd?Ⱦ/b_ZyGe?L}h+z_Fnԉnʸٝh:~jFDoN~UlSٷG0ꅑ>n'gEh1ZMlŬ ff_VxDJԁ>j΢/Gy IքFЕ {=Ÿ13f;OӸ ){(9[-fQ E/q ܰdjXa:^<~ t3́C.RBU =h/ pE->#r]):h@Khƾ4&yV< kv|߆'MF̸A8 KB$VH&yh PXCel,b**k:3̾=$ eˁ#aŸ p/|yUZ˖uz.C.=\R%zD5{lSZD (*C ?@v~ix2*t5:nyCG/_w>}Hufxď7oa< g1ۙ๕9ͼuv{'79q\VT эůHB0=S46Y4km/>1;Aa'w@wW`H{AZ_x6-tx<(,_?H;`m'y? O[w 1Â4 `Rzf9¬g;3O0{C2'Ygcl;~} O\6r۹kW׸7E.QhыbLA|qHĒVVUHR?h`ݧ.Ry xHT]¦EY7?mXf؝ٯ˘x#<.Q5 ݄7yg!IfgT3r׈3TS̷kkϡj=-=k0Ls#̕G}@z/anEO{oY/ *\Ƥ#qgMA_D~ O"bī%pkQJ0}?`'q1V}V|-ďЕIYvLtZ#hdA??,آ7D7FZD+oٌG%iP]=A2h_X {ab< ;`h&'󰳦P#57q:AOjܗ-SlFg)% l6TmArQ<=4 \^ 8/}ʭ{[rXaب`_F}Q=nm써#{oR>wOvU6f(•} /W>c #<_Aޔ)2=<@`EϢ]O@*]Ü.c`Bd̺}/EN .Y\:UUYQ^VZRLcHQ8 }^w9 vb6:FR*2D,XhwY'?+b$킂<-8Ir-XנXo?hx%\p3(|eG?;e{vnlN(^y,N*7{'y cn> yǭ8oodscnEq}w8.DhTO׏K4|Y ?:|Ӥm({=]ng0nBo>n${A~%ֺIc3e7 0s]q|Lȓu5Vm$%2R×wcl} Mx*{7{vo[WD:vI[/EOhu9PkR蝯mNt#JqL6{aMU$Ba5wVC^{~⒮|د}HɼA<G%4_dƽi- mڪ@|Im%symO !ig:I\q9~F?dhQ=M7Wߴtɖ|6X\Nx#N|0Qx S p"i-щPb;JO#߉86}},-JHHGE##RD.+b$nr.)tn0$,.u7 ɥJN0ثT1 6Ą& `0`$( cNp:̅bH,ħ9R{Ļ-Ϸfjk9 ];SO%:} aN3siq ֕TTqMfSi]^ZfPW ^o@WE`cUr>,y:>`Q]${yi`evvUo+b)I5LMKFcL<MNOpӏJUJeYY3x;!?LTN!?sc3L=#pƕ2NӞHKuc㨄J9 nU~71LytHYQ[;h3g۵Ӄ rPѥک %s d~|+2TVUT1bT.enat4.{D)LwhX큨Z\ "@"EEEW_}5ofZ=:nωŰd̄&OS<,lZ%I E+@c)RM*C$C*T,uE~6P^VYQQY^*J#)ꠏXE*w|~Mj&'Ə^fC/7kJcMz[q5=Ұjt^^_pFߡmO:^R8v-\75 $kԊrS SýןB:ew0Lm᝺;7MZ`-ćlE٢Pv޳%haMFb؏a֘&]p`6 FQ,F5 ӫld#$~WJ' B8sWj Zøapp 6t:9D|b ~}Z; 6s,#,֙S>3v!v*R@r8RQWziȽD67}r(fs/xۖC[K;nSߊ@/P6ފB9v⃝tp<ȕ)*] ^dZ 8 _(čA~".r\pdEGÓs_oVØhy }/ۉ5!}B!BȎK7~/Nkwht́:MsYN("oI;OHn gsUc`Q׵Fv5r;ҶFu%v쟹{b5#YS*pB &KTKFyrxR?a}4XXlv^]+>ء:@+i-ʭ.]Oegˮw{.;v{e.`I-V,-|C:%=-e]|=>fVwrv3]Z%9=][CXq2i4RMw*+fdi,^I/ mamA|Xh:#3BK db*;,#1xτs<k+y!2Ҭ% ZwDTZ@^#o!SB5)=SYV}עw-tJk|J 3`ߵ!pd:2'6j`N')`;4)Fk`MlBb;J*H1nZ9,֍ ؋ D8.v[Fg큖l(gZxQ"$z/3>xn.od)T7 Q#~eٷ ߔF&u&!͛vK()q \xTG_sO7ΉwT ʣJF9(0i ؒod];Mul.NSJm<6H2<fYE- PܦAL٘˱F*:ƐwZctŘq8Ǵ|L.E9͛ża,9DRp,$L#jH5 b 72bMB<ٺ5iA-O KBu5$/_eL-^-h\6cBg^ٸRg7 h.K:.|>j#+lZovT l+ pF<u̇;}iߘOZ}@"Q+%%e4Υd.i*ĭ2aGvOAkt7(JBĠ̒]}9IMm9STYU>IYѦl̂[-ӒYYYD W]$2MrҜ%C8, b D ]QyB-**Ykql}}.8mn&5EEf3PVw}1[sHXB`tX8d,t=bu܇ J}%UPc1X$*=W zAyRs@394VӌE9#3}V3' 8nuaKeë܆Kg*\r/L+_Z;]die +k_TSm'=U7eJ"uڶ(P^YtP,-ڣ4v;YCV`q]wXns|[p_W_>ŕ.[V"A_Y˹*(US3$ݡ?W'Wjnu. 陙3p/nѫ$M8犗+ K=kK˚5ŜΕK‹/i;qhQt$a{EM.ŜUƆ~$vo%s u&ڴ4,DBx`iI0֤;zej،=VtXUB\zQ)D|2lv\Jǿ<{: /?Am<HSEd|K/A;?.z({sߛ7B[]vۃ]v۫qٍn/*EZoz%ƢJzdڒ6l+T)Ԗ8qh|*~:ƣأQO':4^y_vsKv`t}MDs (6JQZTvo)ʛX8\!'8E/Bnޅ0oG;}J%CNM`W^9e3ϔn؃ͥ/Oh-ԕ-qkח2uE*0O+8^.;&e%/ɍ?z/PQ ydVm1znhxd}C]G4Fݏۿ 3"Y%^7Z68:NKqXaL7fy/$/Yߖu?-bf~F׍W3ʞ@1%n ' n)11-θϹUmoi%_&)$hA$B>UX*w)q8d -J"u4Ch A2RlؘV>jöI N91Fb'łX$?|>=3egPG;#Az;K.U`Irܦ' )VĜi% m*ADs u\aW߸K_/.r^ŗ{h2|ob[o`@"`rz}sv4:R>#_D8Ү~J{H]ŋ^<:$ݧVzm?eͥmee'l(7az(n :QX.mb # E]R쒏əN3r%aV`)3Ƅ9ܝ/6CEyjjm '%*, $'T*x\ͻς}a zUf,Pr}ic%9adW`[`×ސ~xUEĜj孕AQuZL޵g% ʼڟL};}Y&Eq-iQ}x[yͶ~4Ƣ'!{u?<-_^ si$^֙JtMOL%$Bb4 ]M"Y!|R\Q~`ѱd*q.<5"{Fh[m~J(:?,yJ"E@j*NC0hs8 \ME{ѨU­KzcitĺLc&NUL߹Hrq}>w#L\$4lbpҠ? х($H(U"RF9s|7.]p3y~tmg}-b.q1칸;Sھl6^?P/7ҩψݕP Kn4` uuJ]Ncң{c2X+a::"C~)ŃwJ&Y::w2NoƑV-&zX*k>מ<ñIo(2*zN{F}2VW\+`rԘPSj}˘{C NyzwgstMLvFjO䍣,0ƀr`rr[ ,4vdyK/ۋRl48LKɺ_CKO m.sKW\x]='2[VHCYe0o} !qt& 8$lbG۰-cmpfd>xSv (< !"F$z[v.@Xl[ W6 pH$7Ij"T)WHĜH|Yqb6N8͏ lrASG|UJd*IySojWsk33<̠fm3 zTܹmr Isqc")l.Y;TK7Z- ۣnz\فs6cO/?3,!T]vqnOw{]%nC.r1e_^f b]7x`ޓ=<=g;\w.hF8NPoanq;;҄Ct!v &]\v+xjIfJ0p fu^õCLIc6"NT#,Ȑ(0W;. 7eex;6xfJcݫ ( 럷Z3/;ѯvVIZ+??w)ՆKBo؉MU(GQHÅPXi-LW= +*ltX;lvH%RjnX1VѤiW:N^8:Vs0PV*U K 88ɻX֤3J-._ZQ^QI11R.^*W\Zzi٥VlT Eؠ zQ8Yg |wHHܙ|(1z;skUv4؏W1`C*a/pٝΧ IIHF.P*e h"b*1b)I :-uuoX$sIףΈVeh?s< Lay2,$=x8˰%oO#irg8I%"f5f6~,Hi>?Mv8w KJ "*+Ea 9 $!+)KBp,ըE~=M q)׉Awy 3n6vmwko#9#h0wTX4).IB]׷?z"KƍM~vQ6km>տc6\s6re.YRڴۮ[/-֙kl:9|[~\nu%Si)]5[b*,|ꆕ׽ T_MТKo\67_oX*%wٳ[QGm)ky?;}tmۡRrvW;TZ.W@4 l0?h~`@W*-h5n.- 67HFoߥ4?}Tw 3t:B" Ye!q\׵J6Zֆ)ho!07]o>`U6WWdRpf~90N5Zv(u"\ԸNk2{Ii(Of L l!0)H2b5^Db-X  (~xtaHVr !E Fb3rGR , MOOްwK`OZ1+~-+kŗ$cɹB,?( JA`!0`@l0!}a: ģs):&wakԆOO%ڦg΂NM[Pm9k֞'a:ٴ%w}GsZ(pAZ"R怹H1Ki grt*-P&NBj  0$1 cj]m$/ǂ%"/rwwU.tsËs?ʍ޿Q[EjlJ}_)/1{/hu5{KVa&4˒>?gO,ScŬLˢ(E*R,m-Dr<$wKGKŚI ^Q-ϼތw }m=;?zaQۨ}q(v$")yRk*;Lְ=zN_)U(*RQzEꇼKΡ K9t.wlG&sIltE9a16Ri}D*=zϫRp MDN'/>cZȕp)_uuO"fLj&q` ڬqKG|C5d`2<*otF_ΐnޖJNb=Ouo.pW$RT9w-篵g.6G(:ĥ8,u ^t IHs&b{_7t76 ֣(s=K5fwzn)[9r,(ބݾ6B5% YSXײ6bFT4RJS_ID=Ekʗ؛KC*j1a =LOEy=sNh&jU0 pNЫ``/39^/`9|&3tFq+ύw*qM]tEsNWgWŪB)7|IԦ;xٳxG dFKOI U+ƬǬX@)F0lx~dA?ˆAitcr$_y8hn)Iq0cX b bc $T [0,K~oB&K($ɦcV>c^&fm{ 1 pd`K%V(z̸23X+hcBV >1|A B-dv`'x0huh}|;}w @/m# bQ. 2|Tv\ȮS^WPѿl(!P:VB .hFFtc)93kH*Ta󄪧ՌsӜ6ACUy}΄T0)qw*119H9aZ1BM+ NH/;>m-[>[[][Hu߯XUH.`ӏ4`Jؿ(\(*cO<]>V.qX(˙r Slvjr҄N*4Tܧ4%[hr'q)HңW|Jc\p'8t,T,}N?[[YmhPԃ9 oi /л7{KS?oR+.2ry\6,+ָ_U6+M ޻𳳅BϷ%"kekV)E߯Ws*qu$ OmD7<vpC~IfcF*L0*-5BPA} |y2e h"N!% -QRyy-D= mx1GZfK؟p;EWD_k%zɟ:dɟSܯ[Q7kJ/?iYY^jlkϯЃ6#3LՁC)]nAr+0FNci/5vaEyїYyXz%ߏu5“Eq es~PJS yȓ6Q7ztCreiw9)C=Ahϝy?c-ysr>9Ipnܜt,20w-+T[4羋9#Qi!|ϛ;!94T*s y=B?n_~#TFKkv*/Gy\/x)]NRsoȜM^tOӄ]4l_^'<8Ƿ/J=ŶsBtuf^K=N0ޜw+yZ@ۜ=B)N1^ {W^KU|\Цп[XIQœg7`59KMC<|F&\Oޖ#wB ޼=.΍Q>樕[pޖ>Xׇh T ymk>޼%379?GN*!8 NUP$d0~@)W~ũT2QIm1<įY߷w_ӻ_;k#] ?T7fȤ%>ם6PhЊu?!~}wWWf'?߮n}aha5|˶mqkw?Իw4Ϗ؞Jطot۽fu]{Q~c_@_ݕ= d--Yop!(wmx/34wӽ]yIsek\=VwP+ݛ`;w}ޮ!woޞ8ϯw@֡{`W/?Gw 3F{SL/FmV?b ̇2ݔ[}&và پ^1ܻ{oO/,ptf $3пpbHzgȂv ptKd|%<8PrtC!ҳ7颲ߵ{ܗ#3H>~ѕ邾0p_u$ǟ4qxN{Ewo?Yp?־}0Ho\v7#Grru``EhW+v" ;`29 -4z]r={z3}dDb޽]yBAt;w'v 51LX!;2N*Î{{$.kZ֯\nʖ5|2~5k׬WUrw7 wP)@?fUZD {*ȉ,.wm6趣 5u ( ܻ{D r/ޜ& g@D`h@3;p)% pᅽؑSͭ֔ׄ ]PD+灊DƷӾ]==}dP%J[K>T߮vd_ t20(D>|8 4I5Z00 <& c㇥(wwn k4ذJ2WWŒeɤL eeWVJ/vݿ݌$ȣG!1 !qVq9 oSen'wqŞ`c4'/V>yɋO^O^|b+X'/V>yɋO^|b+X䋕n?.]C}z/y?f?ysMrn1ĩf :_{r߁,Ze#8>e0>xO>e8aZ> ;I>^<&VdF 4R_r'BG!%w ;Pn6i/{o8c&.myI,@t+V`1{ Og:i r)kKyZr HH((E_6WثU*hsP%|CW B!@!U!h?IA8Fr^c:^>rm?JjavIkaɑ 9"|!m{imIRhNvOC`P>e pl/z]vIv`".ـϳ%U@$l @WvҲQLD˺[˶"Vrqub\18ħgĢkwQXFөH+FV+ AѪ$XuV k!!APγAnt).r1i@*iJ5PִB脐׊kH Ԫ*ȩ Zf> Z! NbZH_+8ϒ0jjJDzu xo%r?W׆jބ?JϹ.+亟;WX=j.D$YBS&JMb8,ނ" .  1(} JC-: cD@ב򣴎@?:Q]RnXQAi8ghyK1ZNZ #Jp Uw[`nA: !Ы&b48v oopME'P|t\'ЖOGP >Zs g hx#TEV(V8rPzjqA@|"b ?{ ]"L G3tG4ۍ=cwQ勱@qgg,gl9%]g˨cw9{nK#-ب#iӞ]T4(S )i^@Ϧ"LcM@ 5 h8P&qA=F6L 62LTcHJE,"%*!)N)_f1=U" TJpN> ;wiƟ k[ePHAl,nnvfkw MMH˛VjVt^S{r=Uj+q tw1\su+]K9TN\IB;0sjrLY[@RTENt֮}`z> stream x|{|Tյy&ɐ9a!dBy"` π%$H2̄Z+>ZE:mJm*Xڪh᪽,Vܵ9y z{~s^{zBB~ap{=3MQq2nIw!s{;/(7h]7ttPiye\ @r1;Ǿ}mAcz.gNl4ED R[^Wn6qv@NS6{8x:x> j:~4 yRE'3l#Y=|YMģ*'<9~ P ] p`wIjd/ÃK+H{9\  D>Mxgm̄JX ~\x=ed(#rWGc/:r ^|^Eo?q7 π !! "tDd B=BQ.G$\-T*G‘Hef{)&Khf}> $!-=0;$Zs&H\XW!auchP#~9 k5`-J(wz->[bA|Y~ +'+::Bq>mC{W>M OkgĠG!PSɷ[䏴n? WB7O?HY@VoNr5|C^!Ǵ6M) ?F knܪxqkcDnUסw~8 o>|H4$# |k!ZF3L|4@w}(>gB0Sp B$Q;yF@Gڹ@CSKym[zпrν7c7чVQz>;0➆I4Jr"rZfH ^c.S9iDm\G )r5 NvE}z!w{2M-=̡m_vI?"ͳ0,@Eț٘aVNAKCP8 *hNX宬tW,|aY邒‚ysrfgrfe:ffH4kjJrRbB|c2:F(GmvEc9`gJGKX®4aI)H%JB鞠$fJ5)JC%WjDjG>zq8AI鬖¤E nivGUqN.6F!X8ѻ$/"5e)M(Tꨮ :a!^:-#iNnTyap,Ǻ8 Tq6amUXH> *=4|ۨZ[\m6ưib<,.[NDdjih0\Xsx&)Ʃlj5p.ͪmEַHȍnkj mRb0dG i( Ŏ-pVfX`4Gڶ;WIuKG6[UhTD'gX &cDXJ(IuZ y { ~ G|aCU˰aM! 0<ǣh85.W8' }2.9GkBJ,͟|ZZը%hMw)L[ȡĵldh|dbz#y/&ΉXsR|MgY$}Ͱ׭qԭQnQm[0/Sp|UFU |r1k4F,n1*yj斥Jd'FΰY.sMo/֞&^!XpqpZaCCcT3g4rhMV0.90MśâsNn-&ZT;2 :$cx?}>?[28kokB[u9@ |jo:XZ(Fx@^9AP7/R\ʗ?-?Wb K% Gp >I<ޮvY  Pj:Ӂ SPwD(JQA"h6.\B>͌rPŕ7BKFb]»_s+5+{\;^ ""umضh$gSVkJN^Ԓԛ$$b4?`ff3`>6mbTۄrfMdckO鎢vbO*4gܙ9Ev]nNХ(ZϝXnsOAũs'*NqK\ii\鼹I_$k`1CaXtIIIs1S+\y /?;M&^8{۹wn1.Nf7Yz@'ƪGj%mhl(!3wLT5g)'4?$,gYN9gɗ2wt{~`}̔HR>z4f뫓=ٞ)*KsKs\zksM/Efe))!9?( #!ell:ۖS=fgL$F31BLMHf6OJ;fA,cM1{ +#s~m)9:vjJJ49+ef~AQ-k+T;oF[ߩOO\gO}Z~I@  sBߩ>fb~p͟_Ÿ"ݬE ) > IPDKH$sKK7A kn:8#s얛_i6$|Ζzؿskkض 1&kfg%M})}ֹ=m9Kwm-Xqh|FD,QP*m2WQF5τM":}E׫ݩA'ЅuttZR,54}z|%3!jH_bre%39-BK0aI`J[roa3Ļi^$?D]N}# w?VT)=;.O2I$>)J F IY)Edr($/2g5lXEktL"10HcѰطYK*Z`|\stKd)$n=z'"1VCDSrȅ Fkܦ" a"iI:@6` ϫd\M Ef-|{o.Ԓ#XX{- !o0Rєe*2U4 Ŷiqu[moB ͛咽?p:?RO8nؓv9}V+K6ݲ膘Mm1W]Ksq''XF4mt3w=tYY1[6@jLQ=+,2JR1'h }>%4L~c̍AaXw V*4d[yc?*7z_k07`ɝgb\1ט+JpM7|QE Mzӻ#.}֧?deеOo}Gӓ?=[vE ק[C3Noqx»-[U/_zנ.K B¥2>2̗0zI"9K%抯``|XFzkn3KKb-ϊ!zJ"IH5x\Zߡ:8L~zpN70CōBGAv}{x ]7a#*N@ct*.@K5mSq-_:h5ߠz7DzHţ`^Ή(?&Ac /%!"zt0$Z(u#. >JyMG)WqQ'*>J]U*>J8(u@Gօ*>zT}dGٟTq#_GfsQLYx41W43]fx5 sUhǹ. 2XKBtrЃR$~ J8=]8?j?\)B2 HOo yP\bgtat !>k5Df,ې*d#ȣ [-B)} 0 `){M=zqԏ~rfOYfNRԣ&[Oq2{niCIB\"f ی& J>_'W mAz6OULZdRGL^J*RuLQ;H'J;!{xKA&*.I[ynEB*J$xdXἦƋW]ec3LNWT/q=W2¤pyQޫzP SGs8R{نڝSZ ~!"^5RхpM[ŇWf5~cܢ]|>[5oVTMVB;]j]}u&>N[^ (]8&sjpB6כ\M^$u۬||;Ucď%ћUk++LfyWǽizST4ݾb;n. RNׄݼ5/D/UyۦŦ }?n~oؖx l MLveԬ즠eSU|"5[G'#Mƭw{xdnʃ!Ŋ!>\{y u9.[?B8Vgi>˞ߟc_y0+{)K*|˛'U{B(-&w+-;Oj_wJjo:9d H>ofsWM6IZ `HmG !5JOHrJ Ҋ<&]Ay&VB}Oo.Yx|=lM;GZoť.O0y}i u@3-(n&[`P zЂh$_&}=b/Ry|8RgŗNjj`  >4y/*({`ЏB\)ԥ=4 ur3tml6Q EBrO'#`-,ee˪*X..[VU|MTduMM}dlD[E Bܢb\LAifzY>R(_{:"1Oji +F834M,dt,!s;qR.BI'k0z[C45EYq0'L11Ei1BΓuR3G ^&5Њ=<\O[Feg\KBu}L!dMA%Hyyw[XG.%%XNrW{;I<(_=Bd |*+$iv,V l@؎AXa+A3|-$UV^U7\ޤzBV+R+\*bTp2IHc^, = !@d: vD 9$H#4āRF=1iXV D8p4}|ޣ!ջPa'A:.fdxLjXbwPGJJ sĕ",INSQۑfGH.sF \ V" "h{ `NZy Ax-FXF(=:\lL_A2k^L_o/yX/ۡ2 瘱6c=qHDرG@Xa;3GqȳpDH9xHv cLbİ)tRs=dccck3bpmD+6 İ4sd&"UZi4"`|&2~0횝c:@#CCdH&CגP9 Ȑ !7z,@S iRw :B$CA2$CYd( I=J3FW{*پE(cZ4:A,"DxˍDL853T(RN| ^0zaeC"Zoe,"FrqN#P">W^Z|_ɠfe^*lt"=NK 82JLaPiw0qZol}|2|E:R Nv1.}:;̵ 1l>gOlяm'd&<Kzy9J: q'ppgƶľde ܱ+Kqj[5+lWb6g}.Rv3uזNwnQB7_We4]>NoF^Ջz}hsE*JfJJ.pPG,&uC^kg8Fqac1 A]Wݨ.:\ V~q7!w4ao> stream xk۸{~O^\J$BwiKq }hBki>g)n}9/i{AC?l$Ùp^tbO>ޤfRFe$͢ԓdQl&Wt[\̴ӝ}m*O€@ws˿Z[Q%([ 8, ?ڿs+-S97qq"$ 3vbi 73qv<d 8'&``B [jp.*uUQ8\:+dL`cAZ#KY]M# UbX%91bByO<^g+3Z+~HX92N)ެTαG)82$5,2e{9QWIشkSqK_;v_hݩsݢrfԋq, Cd "\xD2|z3ZRG.'ͶI1o늚uBw/^Uz KE{^.bc>񨸈RNCPˋyӚj{~הpI"Ti> mΚ ɳ1oRx Ci=IVU&M%#X]=Rs68(ꬆwkrn̼^K1c4*Ojϔj$ᄦT5 $cҥ3PKU'w\VB`#OqHp\NSccδDhw-,7t1by5/|b; 3@OUbLT?%$QZU&C7O:KTtv>8R}?K^zu_Nz?fICz [G@t;?l<aܻ4MڜI: Cð97(CWL+ďlN F+ݗ/*^/j endstream endobj 96 0 obj << /Length 1430 /Filter /FlateDecode >> stream xYK60rHIQ)6E6kkח3J-)6AyəOt0ZwW2~h4]dGahno&l\϶ZïO1ޫ|~^'`VOJ&WFQe@=]?T]끞!J`{/fLH`(P[^ ?bOTW1ղm6`MV&-Eɓ>X$"3 B`$30X9rCݯjk:ADXULx^b5%yhX epfu1Zb5qE7B^P2A7sOT$FZ*718F<[7kïTV}&"VA J;IY^^ }y|HRϗ) k*Lq*7~1)0(+X S)3$ ޣ(V=\YW :I ,A74S9n$00klA U1`aQ zs< s3Mk5d5.wַeeI?ޜ Hy sSP;YZ,IDB-tYu)/Ĉ6a JCqGYy3) #A  f Q )bmŝc2i\#]ي.M z}n,!W|54m & M %BEOPm洨Ϗ=HjB QTT ZV^=5섓$๥3FgI皜9'7y'OGy(O/_ ~:X0&3o$|yL:bB9 y)s uf~Y!>պ>!챇CWC+A FZ gpu.|) ~qXoN^s,V͖Xg %H<k f\h2ſ! endstream endobj 106 0 obj << /Length 3045 /Filter /FlateDecode >> stream xڽZms۸_uz4I|4i..vI&#KT7 EN%}yv`0󋣓*Ot2 D%y4HM3<~(^Cϴzx?ȣ*4LJ$+Wr! $GpFn)6pU2Ϲ ".G,t02y("$N^2-Mɰy&2?By3zf) E+|4  NS^K;f,h-KT_[P.|[ 9R#qP> !&Lx02rkجpD9BC!1uG:a}քZ %LvK2*x16DHטTC1` G(DaX8`vdm`Zk[^?œ[4x"ht@_"F#ӄǠ VZ@m-_(~E5A!7c/`rټ%\ϯQ:GU˙rڲ #_2Vz"pB@`Bbg )mWD(?lYd_Qyu&gNNnooRآiP~Ұlup*oNXJGQϤNʓO6Z݉qܳgg%v>Jan%}LФOⅦ a+7jZ{DmN/ws(wYbg MFP,k=*FĨ4m =>@ K|LQYkԮMAkK[ķHc4.vPɺR:\ r'6dh1 b*+T WK/"yS\73Vs 襥eM\:4J# += cviv6StU'S-=k,NKTQHB| l+bmQv12BoŞ*\7h*0wŕU'Ggam -etdfBDFˊ NW PP|Dw81Fx-Y7!Dq_* ]FH%~fȓZ?-8֌*$•" TtH{N\L#jF*hy4[gqt,TJ|~8:V*/4*R3419 ]r3c acLxqlAmxE؎ ~v+ [ohG覵}"Ioiv[>N!衖(P{W'f"-5ѼQMnszg~* mKs+N[8HY[\,hOsjzL%6@33V|rhbS<).k-I -/pkc@9ngpD{s-ǔrn\h`G ٝ71&r(:ƹۨC̪,W DQLLM&./gk?02$!% \{m+I]cQIˢ2lul9P@ɯ=و-Q}1{͠L/qHV.~,)/3t/`Gxȼۂ>J1ݥtK}JHPMYd-Tv'4̯(ڗ*v6v)K07S]~>ĶB-U,Dw԰T.EU <[YqgTP }>xsO;u&>^6/}?}|`hއ8WW)ފd~㦅fkzuxԥKF&Ӏ~l_Gu9Y]#)=gIZΒ|\3RTo3_GqKf@Eiv;[<5NڝG`۞Ѝ;,+>K'UؼJýNi?xB!ZЪ [V$I14[/FW.*)W<{{+s|$3B=Tmw:iq-l?mG2q> l2y{z[WLǟfc vu!&vL~[`3`LݥXؽ)ڟ|x (M7Jp]it~Zjj܋|M) ={ Sf &U;%O hgNa6l o7MCf_xjj26M^,6ArwB\×0 U/<, b- ^J_Hv#ȗ[ŁJVb 1I '0YoXidI]}yHK+Q*5e,Lo> stream xYr6}Wp<}ŝbJ'ĝ$Mlgd:I-D)"mb9 /!j۴@eL xzq=#2 fF7q>Ɋeפu]ft~?pޡv>Dn?4maJȜu . eoGߊ]94P=+0}V*BޥeQ7$}^䚁]3A$醮Dۄ]nxx6[p! %0P>gv]]︥9P%[dx0,mF_м=h ېsi1;N0Cykc}Wi(ҞX1B>@ VvT68~)aĂrB^v]IDZ "|`v^o_װ Dz (] dtmDՈ!|= 4+D4%y9OdHgѮ[!gyy(` I O$'u\ b·#L5Wx"d{*dIr'@+o8;ĨL3H'Hݾ8]̀i 9٣9GbKNT—E5gc"H?UxJc(]{+?o biX(bIg͒먜΄; U$1K+/KC G~[1̀eXu -NPu- 봛@2`L;1wFC$5xwIRBڎջG+V4nT$/y>*)FD+- 菫TTۨDޞJ9X2QTR!점S4wh2dץ f_#vS&JF|5*{M}^3'eAcbC?0i"WdAOIAݤ 9"2gs5d$pnGL_Zd_DYELڒ%Uwj=+ 7>ܿU|ж;"*SX_`~bW׆\~y6GȘ$i{\SK}R׆VdQ ]1rh 8u"1*.)#K4jĈ3r|y*NX+RII=ٴ ,4$5!_f:0:nׂkS@J">8{ZcҴb ʹQ\hs XGJ2fLdY\Mk1햽$Nq'^Z(j] " ,)HXB|HM|ڶ6 (cy&~CUD栔Y;G*:XR˒yV)lON*?=8?SCuA d9y+ݒ(G\{S\2c^ǟxf`yB9cG fj:7=ĦdCڑaVM4볶ܐ2Ϫ0TIw揵kP*e6#}^$Y_IuTA@yQ=ƇQ%"JZyԭBH{SQgJF,ȚMz]$V BVeZX"?̔pY/r$6%XQU4\x\Y/"F*uj1EJ4`cCF>PgnprHt 8P.=ҍfhM)۲L+lǰL!+ |L n :a:Nׂ1rߺi}mOavxѺl {ǐ3(06kύև|c!\ŐBAz=Q0\=5A]kS>w9D\S1'v{ͷI)JD~[ދaz$ .C7nl\io v,nTUMb<6Om˧7"M /klkrBXg7KV endstream endobj 119 0 obj << /Length 119 /Filter /FlateDecode >> stream x313T0P02Q02W06U05RH1*24PA#STr.'~PKW4K)YKE!P EoB@ a'W $o&| endstream endobj 123 0 obj << /Length 149 /Filter /FlateDecode >> stream x3135R0P0Bc3csCB.c46K$r9yr+p{E=}JJS ]  b<]00 @0?`d=0s@f d'n.WO@.sud endstream endobj 135 0 obj << /Length1 2628 /Length2 17191 /Length3 0 /Length 18713 /Filter /FlateDecode >> stream xڌeT-wظ;`$w rw1Y6jUQi2[,2 gfv6;ZGDts9 F hI{MAOG;'GW _C@ P9ݑ%A.nv6` 2wY;=lN`FKsG&?!l=<\XYY̝Y@n6"Lo;[.b8$j*M8YNV@7)Pu:m??޿9lni rr1wsX92J,>Lsg߆ 2spÝwÀ-l% rr:{#O h /?G v휭bªl XGfp Xڲ&ud-rXKYͽ7O`Vv 3ҟ`1o 7;!xl`VAp t;-= _}>@K[]uD{_xo_=ɸ!wXUʉo>IيB+CCF$Iz;KtcbÄ&^*{F5ob?9;G l7xF#RlQ(0cBKchmDh}F/45$©hqX,6ֵ$7ҘLo*qξ|~w {QlUƯ=S:j䍏Aio,?k߰ PkX9UBc{9%')`>"tLN&rbypQW͍Xz*;&``@n,́1FG^ 1486qBRze4F }Y ;_s*w8^;]_ %K¾i`x"&2"yddj| xL'ɕYCEw{5D%MO-U:#+0^dΰHj+%=ofbտ%"gi؟^twmyF(utf͇4vfp|j(&-L gȈ]C3 ܩଏRBNn,!\8li%qdI_64cT=_Zɳx@.#gpZweUM+0ՖDkio)Į{MaRPJNyl./HJssYoe~i+Su3ԇ #s2=ش 8<6T>Tp㢗aƒv$ My 8525[ӆ&@ O*!&}ռ|ǯ,Qj)"49>'h|ɇϐr6L=;UGd|_l?n/)1K{2ֱ,'C0ZCWD:vLjqScI /1ưlaӒLQyr6>%M3dܞw+^~%D$-XH\?ʜy1y2fBznwpI*.E}TӹI^1Ik}Vj]]hC '$"Nb8r=dGycۮr$Y2[z`i.^:8> !5PZ=_,8FM*Kg} ̖~jR3X`Ț:5ݟ}S BSgQ4i?DEZ˄ guY-8jY4h SSx1c)xe7&E|1is&FE2kD#\ n廕jY7a'*>1"r,̯bGU93n?,Y*{ gA&qr"r&Ae6̒N 5BB-1^)O "K޻[|g^% ԟ=fހaMo5Pa(T=UpºeLj9bq[A2nNq1QWt8r>TL-VE6= OFIt4>B_(H7RE47WOyX6ibGK:oPG䫵Ysr_:+H#SNc0, ʺ#]΋Q %Eߛ;r|aߪr^fW*2p-TEt֝+0>N`0EtgJAjܨ\D{ú\unsɏ7g{;2g1 -Q`X"8\>2qjU=F4p.BiԸ)mӂ|S0ER Ѿ*¦:jd~0E۬=(@o eE#i4ϧ[~9/e8$$ Y*; sXt]hF),'hwd|X# v:Ѳ{mn6ηaf xG ;NE/}&?SlZaswVk|61~cz)Qj#l0ԅs8R7G{3 eJFa qۥ->p5IT)qʾRDvEWѫ!hL0ObP4 }t*gb~hV=c:ݛ?T}4,7KE^#`!9a d?'$Ht:/#8˜Ϣ{bRu ̣:}JD%GzÛkr|,?|@U=vp3P,H9֨k欻G.yAqC$DY!]f}Cv#MxT?⹹&ٮ~zytյ£K]+Nf'߈A*RqU;EqW >V XF`T#/6Dkcc&t/*{OҨD$AW!e #-bܽ蕸gVFr%i}s+z`W8Gfc;b$|~RrLUϯ__k翇g2K-No̪~ҦY:ôokLb&aګ{Dа›P14+DGFS_\ܹsIxXR};جQZ.`&(wԫfm^+rnҟ>Riӑ$Ny6l١븕mm\b8kLK$$*E9ag'2atMǾ8DwaeعS}ff@R}Lx} μq醗P i\RZ)[6;Gf0 ߉`Û,M) (: A9 ֏'VYʶ^2gIZA^?9,1[2wOۊ ׎*]P38^*x5o@è}՝7d1|nCl-n"ǞjdJda}h{8ͫ36SM{w˙J{"y[I1s̅=$Qx P*-=e}=aVμ-['M |wOH9dWD[7կD(C6+諲$u;SEk !QZ FbA|00Hd)> M$>o5ۮ((2|94[N+#F6޼Y~{ P dd%ahtmG4Ir.\^Q _{zt:TiR#^7O23[iw>v\\1W(žoR4D/dG ٥U{0k58apa6fF23VNVU7kԵڻu+1Ow*6}d(#uGU ,bo$(ס]A~B/w5KhK&Iu+k9%뱆E/WG>&RqD{ n+j]V "P ٨a>0m9Aij%m0$g6^%f#u&ɸ}, yA,IT2 fW3&{ މb v\X9(c^{u4c6@Ag9ɝι2y[g"qچ~ƭs% feq^ʍВY]yq؀hwak.VxƖ:@8y4/G57kp۾i[o31R~Q==dy(2pcPw{˂ޛzlki2JPtVLv `*PE>d؏aYM>?l<2ZSƻ3= V 6Ng95*D=̖a:Kwꕫğ\p\Q#~+q,JXOx-g$E܈H_F?#>̯^i"%GC3r6'sXC%Tj.\2#M= *Z9 "/0lNfXe؉&øڮ\'NSTA](Ev\2 1.YVmzSSrv/f4~՝F/򃦾iL!YGV>Ti5V;߯8;aV3nR~/2BDgUl[gD} [Z1B-rDHi4jԶ^ߤ2U>Q勧%V}c> J ܀#Wl)roWi+?簍PcZrVK-H!5!JSA$8ۢ4'iABr:~O2clflBOC]QVDJ.ywCoQ#ǚwI)H1&ܻ 1Kͤw<Ƭ-af2-S l qk=@^Tj>~hE {ukp@JXV7kYǭl\bf> :0NՔ"Xk2 }|WH(m͈vJo>yr-;^}G͹ck(d6Y՗^%J[2O⾬a~dCPƀ_?mKh(. IZꟽ9E~D[oP{8ٹL[jlʕӹuxh,i\ÒxO Kȅ9j!m KXܨMZY~(~Pt$K:󙟌doe-ƪL;D3YGt12I\,/ODo-pp>"@R Y}g`kN}hßm=C i-2Yx+ZFckpǯJS:'%̸VẇLڽꊣz/ݸaXvU%}% ] p+QP)ʡsEЄ5B?urmR)ީgr𷾟/(u4ߦb%Ziܔo7 :  Pb6j-"3a>9NixDؼ њyb XS5#šNZpx$ϔ$]=^#W+쓆%}  ([N"7SR 6 tp*K?bzLbo@M`7w쨣s7j;\wݮ}M%ꧻ!l=\F*}g`,Cʯ:zzJ֨K*.uB*Xe뷟[ĝU}}\fFjO&k}xA7#HR}%TeԆ  >rEpRkY!GO-P4+/(/՛% xM%R_s{RL +׷IT>b8sOֶoUMrv:4_ӭi ~12]PXzkd"fCfeŹ(ysKz )< '.ExiCZyYa7tkz؛Wod/$lj}tZOx" 3yK6 Hw~W3(:!U$9 R+7pYq-6 s}(`!1JgӢ P뫕⁕:7ִaK[ &J#42R$h  MgAfu)Y04R;(3q 2S 8Qc:8} 3G&RϻW + REiD[VL 7!|3#<E|VSLi,˹;>Hk|˳)>l}11 r/V [U\L)7Y)mZp`ziQk ^kُI"Q$9;Ty22ɇ^OT3Nȏ/1$a,kuH UD\d+R0m1cVIEq%P{k_mZWUv[nȞPR twW햂ԯ09AEnFKStyWRumGMƟ( 79? !mJ1MO< j+f} I@K Uhd<}hµ@yRo 2;܏&=qsQ?Cc+o֋Kޓ6ԣp{,\vL< ˋ|"΍ Qucbů>^/&|h<$=g3nJs!Q#oSM ~BM!|O&bA賔a!.1CE[TMϻl]3oވsRe嶢O``-(΀Ẁ|‰;ײ )>ϜA;߸Ì [+J.0~-v*-֕J9Ƈan/X i1XB owƫqRWA\]JK?j~iB6CH! 2TDvbV8zXgJK H#Q#\-Ӫ˸7ҙ,60?CQ a9x~<'-Y*dGm6@\jǞ!PTѧ}4[إtƷKq]TI¦ҏS68[gǹAH}4}vt U+#8ޤ N^?Mw.\c }-JYZ4KMI[RFly4T+}pEا_k3@S*'#SP:F0ۘzvМkqL-/E@&hZG]f{4ܜBE(`{j j_L.Ͱbi4ԼdďdIיl|~ PA!H낲9$ u:ԟX?y1;8Np>uO0yk9^y\WՓxU 9 >%k{d675…kxLt`k{%>m<7)0Wjbm1Z|8Yf Pyq}'ɳ!g nR#U\5\M^,4,&}tP?^ Ő6ᢽ J^΂Aۓ_eIFzab ٹCoNK2>{<}FP~ Q qNy;k+Ll&"h|mXb;ґ)jb_AՋI*D 0L v֥7nTB/SqUkj#k ~U |cPj4MLj=g9 BCY-,.^i0?m3}q+.DbW" YO4tf_e5 ϑ/qKPIyX3l 玢n'A7g3p9x&Vҏh$x[MMFFhAjlkR~K~ E(u[o(d?!f'+B0;l*aަZ''9i|o˸%G-`q!J=9Q4Ac̆)/W H_# _Rӝ\ZDܻHoY>fr-hOO$?[lw}#ӈ*]Vze[2Zw%a6/l,([}oϊi5j{(@(f  q*!W|[)NeݏRGdNI*q>6*ʜHF:+l?y)OʷʢzFX8(?RYFKbqqL,ysSӡ۵B$>'v0"Vu~ e#29*N:pe"4̗ ,1#_w.y,'ﱄ7zVLSz.Y<"Bvߝ˸lGF`<U àuA4N=zjG }"x%B&G.y .l=fʋmeU>: XLT TJ0A7G5YCH|hMkb}$s•+Be:}Rh -Tqз&Fl R ˽D$bۤ_B-wjXypUz]P@@YnR; jՊ EQ,d֗w.r<;O ]m r Ѷ-j _:s116v-۝#N8h؃ =,+ aJ5:BںS8S&cE`e9S%.ޤL}ͺ:@}Vv_"V̅EF".fvISY6Sm:T=rjU 7x>*P* :K!W]pƛ`-`\,< +X,ga2s{KR.q4|t6EOj2en%[6\mlCu>Oˋ/?畓ݿ\UeJ6fr8:bTǓ ~ f^4y'=RvTw'`ba:m!F t=P[ři[MMa0X#X`NWV 6Y <{~l 3xM[* xN[ HZ$F&hPTk9`KJRQ<`0ΐP"f)}5ɡ&IgP050Y!AATeUj#2s/SG -bG:cۓ)6?Bt´a/-ej b݇m##|'Ma盠irĹJ<Uw@m0u͌N-?^̲$a3un0!Ljw~Ė孶'h;ij&V&)Ee!Q[Y@E(š'hl* l 9s&zeKeo%1;I-"[\um8%zk|nD`[\j衤ٟ{Wf7OGIdpc)*E< b#c? a H&%}J0뷶J={e_X]^~h3: Q(M6|ގ 6?6y2ګ&ˡ  Rv0B͙' 3lnCi:"SC~3P s1Bsd:@aЊ5HtA:=5)y1ijLB{ x4b#F0m)>Eu2 18NЈ ! 2Z:kMe-8C9)z^ZA&&Jm] 6t@֕ܔvI9-.e&SJkg0y@1.t)pRocϼah"² ͐G^#[%vrgKM+b.%Ty=% 7c79].zs L7FED f٩Bk<ڬv %ٍ m:<Ԇ]O'u 1NC~sMuKjNgy: [ I#ٍj8Z.;ޕZ"b PJܯ!SF-GWƀ7xA&$|$DxD;*t}X9%|S+ނGgrfiG:%$=2/4l@lv&,*4#/X!Y=c'd; g|ow\:t+W5˒"xWLlu KP\t{yFvXPlylx% % e-{[ R(_Eڧ̟ !a1)ۧg)Itgs+8л\V<-g󡉠ц2JyDh;1o=hm23Wa(a2^`-UVE1 r BFR?%jG_e#B *jhZ:-a]&)>>#z]Ux suWvs(fĬV3@e%}Yk'p>If[M'$\Fv:}ewals.wǜ R^R"YݩW j; b CAu0lZl(9v+(;Ľ.'ڵ|/Kn!OC|U "P|HR +[TQuveGGD ~F:]9sbFD=>355<씘(S툊R.le:n-ϫA%9ŵ`%ORW_vI_' #8`{M<~ĩ>)%-U&s1tR8{U }۷{z]3L5Xȥ[ՄK I1WL=CHʬN;Zk& 6]>v {&DJIX}q %N`}Q!8C$uGuTaŲz٫➰1I.Db3^ vmv⋢g2=:EXe:kf]t/kU9d?~U O{Ruu+$.jxfGQcm@2t[,e3 gIM\>Es=?X~0wRC:$S"k(jhy¬g~,Զ i =^"`̞ 3D 6*P@+Q;Op'ևJ{Kާy0 0`Unw+L{9xm׆Q `$,EɎ2̲K~ϳW@r¾ƲSD+T䉨ƓAx?>iJOShCЂs vCBhx E'WLOT4Wc 1ϱ>s"y DADupGl-t<ͦ;uPf}%rN ʀqc$0 S-x(+lvBHtfZ3܄+> PV}Wim>}B\_I7F4lNL 5E?10AmA5%(k)hHH?wjuH\eG7NT9 +@oQpXj}LMv H|}%;^͡>r5"v LMS8%SX3@vCӎs̪hM&u(UNn+@UZU]MKӉ<5଺_}X໣ aIn AERfcׅE{h:̛W;nq;=06`{^f̦dRgg-TRLbưȽumiA;6pRPm| jŷ8;^4A]5h>&bᘃ%P=h ʱ] X^p+l6Guײ| |S=:4>_Wb^M-xK4+,•4o3 &f+ps"J%CLEHkԯ.Z cksZ`uaۓRTz)nϠx/ zm*6t`1Mv9rd/1N%#ST4;G6R%{[x<`KP\UݩٰbhZ7~g$"_Ǒn:~Y*Ϗ#<t^8wQo&-ta1BcMBv.Vj#"=ݙ"=МygA zMUҝQ}j[7}v*W@&h όFl h""`/@#Ёń AߛrP1ԉ0#BSfLeaP+Qm?#P#.uHZT u@䃇nt Q/V}ؑ;ve>R m{:_9*-$c{ׄhsƎf\tm?IӐpi^SUޔFYTZbܖ^u'/ 鵮*|FcH[. T=ʐ'mBbT[d0)(#!xc JCYR$x$s-T:Ŋ%3x5-!؉(:kѠ]5NjJr}m旡z*Lǫe,%{p@UhWaAd%i1ϭ4qӀ覹{Ibcavh}ogWif%m-K ukNņވ Ihp]Wm1B Qy<aG^3X*F$6^tZ!4.P\#KVdHΥ}{x6'J\DqAo,Q tQ endstream endobj 2 0 obj << /Type /ObjStm /N 100 /First 805 /Length 3645 /Filter /FlateDecode >> stream x[Ys~[Jip_)')שf#iMTzQ#Y#I1H]$'Z@ ݍcP D.,bZ m9QȒ9 1i`0 OXhD(lD 0D " V̺9FNa4llavL V^zs2i1!Y (O@= J2T6`:.<0.Uﮡ^/,eD~=ŷ2D\1f~v@p;ͧuy-.z\׋ BGis҂Y U>&6 # UP}x܌]_b _xضASkoq3 ܃h\򝺽zu/ۨnmzv-CD^ 6NS|.{0[s)`)CvݩCp fgY3^b6ht~wr?aE4/&b/v~-Z7TRy.^a[oF^{QOj'A>;ۺ/0FD8]&|r!ն74a7$~;t0 }UoV&k 2_%gQGߢ76-H_'Qž|=I}{v {6Q=Gj)^]9rF/MēNeu\a\zln*`P̯! 7XБ^T{޴x gx`BeVJV2Vֳџ?SaU6#rR /%E5M*8_LǏxTMdt^eגʳMYa5<ɫ(BRڳk4dp.wu> |ᦪ22 ey;@~@J{اY% [+ q,Yqn9%>4l\Om^A A:DŽLahP|}3|ixB8'2}=#>VB:*%aB E6q|~ ]l.I#ӦzrB7H~hWu芄{zv,U5_2ZÏya; z6?w{P r4#PyWϺ-VX,{*)AWXG( -)VNl^=*zËd؞{z5JO O:FhEOdtxuem95=_z6ٰ/w_&tbY~aYk+Ggސ =w48 VDl`rB#!WNֈ]Vz`H/O`*)"PX o`v`(Ncqsrjl~I4_x tJ*ٹ0>w<^tI-Sf ܧ֑9&m1WIW1Y |BcHd "l9^Ֆ1&i1e %r& Y.yWxj,gz*E\ѓ^[V%=jÞkӔY85Szu㋼~},";sXKu 52p^ǜam@ -W1.bIVSh0Էrj9N ddT0D^S|~ΚTNg:$zz.grv5}l\gv ?OWӵ/&SŎl. endstream endobj 137 0 obj << /Length1 2514 /Length2 13272 /Length3 0 /Length 14700 /Filter /FlateDecode >> stream xڍT +%ݝtwwwwC )4HI(]RR;s~GzZ0׮0TLb`s4э `e`feeGgGDH 6I37H n`qYYvHy,Jy#Jq#ւW:@0s( f 6nnN,,f`ka:F'tx-$HcFhڀ\vh<\dtt;Z]v"@ w`cf?ٿ J6;89zV { @EZˍ`h+ 70ٛC:@ZL `Q>W ++F_e mr;8\Oݛ9=}@VdX;h9݁r@Lm@7+++/+ zYذ"vdehu; 2 + _Ý G!f2~l_?~2l%w_#fQUTcGNqq p[O_VU3?HŠˠ 3@{ YX- ?߁R*O$no:ArAo;_䊈9ZH4 h r{7Hy{#P 0YA*iB)-.;7a\\_6-zfG$ )7Eo `x,/E7HxX,ҿE7bF |O7)F>/A70F߈AjF>Fvn/,;,Y,W{/;NȲ !V@_ 8~Aߌl s  B雍 ~V$? v@H /ܐXț7Nݐ\'hlX]eN! s܁98n@Ksv f5?Z@\nׯq3鴫!M y첸ٸX?H<$@j!BNǦA@t|~R7\.r<Z .̂-lk?y2­mtD%ErQ(ʒt7NW/#?2^Ms{!շ%~T0Hj &I8KR#A351I֙񆧇czuO(E'O#r8#pgb)5o%euee0/P*GN! I'mPbmw6~ك'(Nu*", I]@S 4&{C+Rαn,qmx wIm*21$~'aytT+'~U{hd١X(s/܏ CGE&[>opWCV`Y'_.W/6k{0xEwPv@ۆĩB3ZTQ:Aa"虏rݶaATSp5:텺S-buW7vt$өX )C PMy*sŲ" *z Q &PBq`VeQW.! 9+L-R ݏ-҇fmǥ߈e0|wў?6FOXe*zssaq߽Ҁ=XQ{rq;_mMev'-95\'s9JC~y|]>^%Di/:d? \rK[L ~HwbWQsƮͳ"X~E'xu& /\CTh+wtkdUՃ1lj\ƯV:MI}.|F]7i+x]kJIdϺ8v5T >ZMhDuȃ 0u=ּ@'WI[c?U\X)jDVEMIy`l.t(eŖjW;镵Տ#.EcE4pK[oisjb[ C%ڋ1) ?ap+zo_DA0^qg;t28TjlyO C%c Cke=t` @peˑ䘀Cx1$NEnɖE"V竻|IGV(B n/8Ӓ1Ű1*?N3x]wO)+Paϔ7o ŋkL]ik]>fG0.p'I<.?7NrP>,3pW?]\4$}y#{J/WR?%`k|,Jj/@w)] Tbr!\faf?H^jSZ.5:Sl bYut'vԼg1ח*띄Ƴ֭ @:yK t^|{g=d3H<(KzFn>'D)̦|tq"wn"W {4Ǩ6*ct&TYotpwjƤ@WC?#:¶;04M2¡QA-E7^BNnCĥlHyc0; ԗz=yiB;WxO;9jemʃօB߼c<1f3}I>(Dr=8>:"Y mE l;p@4u}ER}}Ѣ3Jy<6czm]k]vKVT18M-Pn14۶X5 !FKk$7ɜPM)rSA#5W0Yh'/ü`o)rOCEM~PQYdVv>Y|?qgf‹!.TtlDL-;|UiwSj(%9u(#yY_&|ǥD圣 n{_l d!ft3FW+w۴ `TNYmeo^ЇGXxa$>y|>>xF)ذ)}T3a0?thÏ;ܐn܃E`55~OmH,Lg&]0V(sSgȓ ulxnڴQ3rˆ=V9Ixӂo[10]fRW̷gFc[EٯaJ&I+>|kO(g)~j~5v 10NHڍc}Pb~q]ۆ€ |5`Ơ؀P_N.AfRLj3t(|A+iiIfǭcv%r(Maς'_ˌF.0 ']J(s P,_9 Vc/ã9)cy Hp_U%YϏê$ ]Dx"0Oe~t}b݀nfpnxyد1[.k3d/K URѨ8$Gw߷a.)Ƽ3=#D`hDѲl]矋&YcX3"8s9L3JE>WGT8͇6pM\8ѣ:x1Ka)=xo˛DKOSC^OoI."@ADz{ m)/ۓ% Au1L79}Nwسή#qfYۇT|A%0kam7ʵ)XeZiӚ줲Kk )ַ7x *Ah&1:{¾h]naN;Kw"LX rIx()<;XDHҷױA@"e~DG>Q5>bY0 }e w}T#h0'V9Кl?S|Rme]r@/yȘM)?qmN"UjX^(f:Q`w^:F]x9`29Aջr &SvڸDШj(\* q[3Lxzt~Ec-p=~ȸd3&|^m#ǘ+B>|&6#M%x+?  곫Q ȻtX}9ټf'U-A/ Y;e? u L?VIjJ[+V&zш,O# 34dh@v0d͝AyGKf[KJɉ!&j^X) {=  4F:]$*1Dߙ?V;.;O1;nq5 Hx˩=pEHTsa{\O$?qΔ-01<d]s"B`odsN:lO`K*K9c}jsse$oxTXI.)%}Wcwwʸ*Թ]3q3w9́a t-]^;h$qmlT.X2gtĢ~^)SnyIsˤF7󸴾6_fV*,RƖ DqSH,Äd>7b  R9c`{ e3h8yE'~|F5'fDiS,aūCF.V,~2W%C%羝oҾ K?RY~O}<;nb\7CDG:%r`#W F5w=t]kiywiXOja!a5A0|fV^e7UkK>ݓs~-'%*L[Ha]F.;^TG·LxbA?ˡ\ˊBZE2x ^~ֻB#a83M2DY |m } ()Q3RgB|tަlTC==`<,G*B?k漊ޠ4 uBW\C&&wPWL({a!}ҥ]zJ!C\') o,#TvBg6D8"o1^(Zf`n]FWrH~~>Qrv?D|4lz\N 8dE0F+σ~ԙGKY7RNZ-7b_2GR wǒw8W(4+U:o֏cps)uc۝W+\P0OeVRsz;ytޤZ\FB~o(U(Va36P)[Ɉ0ZhE.@1^jbu9痏HM&ӷnjٚoU6?ȘF* #M/Ukͽ'Cqdi}ࢨgpMKv.SO.'W|pbZeJD;$QP.mQb6/ʵ%p~z'~)w}p?1Xq< ~*C ZJ00qZ/S2@ H~Z"+m./iʘil^tGmG~c oS0^j.+0im)? yq_|cIFk`]B'6kOÃi2- wns5Un') a^daXHWJiP.ނn.Ph'vxCnBHo-q`Ujg-9}K{#0!Պ⸓k+ ޳r}JQs2L &y]<o VN zb2hqZ*tuˍT )؜مQN,įbBέ?QwFG˰Oq8t [_+w|k5j+$/m ? |7a2yS$ϵr6UKPGJ". EXn|xheI/SȉM_|[А'ͭٹ*_?& ˮ pާP|JX1 zrJOL"" @1ozج)PE'WڐyG )vAWlOTLJǾGV|]ȈK(|ΦfI-}eY$ƩL-jY^?7wxZ ]O ͹^o _Lp(Xa0|X 3- uZ(n$ӹR  Y'GAOA#>zyoF/l5xl|+KoUGX(z@zϖ~4T&Fa|>P`d7HI@kac(XwJ+*5jԙj:4?(E۹,TQ{eyٽ=Ƭ:YА/O(g;Vn_ mM>2(³res9H'g\H/;)mAG~ȎV(oqїs=}j-9uS|$cKV1$x{(:tE,@/ ߣL4?r[غ;ĂͻTtB:w9(OUk"N[ϔ= P'}c:4N 51Ӈٮ%2{] G[o:Ic<-6%R肖!ww wrHlR TxP̮w$q[unãA)Sw_گ%?/+o??Q޺x,Q{;o{u%9r{xkj-FW tIl-gC \;h^w3%rkVKI]a.AcqphS U8GU{bwOh;kkؤ1Pԉ qi b'JϠjr9$PQkJइ wIAaK_6> 3N33MEfj=}.IW"jT6-R/3GmjHrLLE0hϥFt8Hx-Z;_ #חᣚʓ`8CR=L[Nι9ۥt,0rCVo5/ buapF] "u]y~{ST{iv0%N[e`$פzl,@%>ۧ¤8}E7k-3q'i$y➏,WY^p>NSwg/+1N{_PPO6Y|F#2^=/2p g0+q@9 %hj%fsҰ&.rBn#yrHW&|Z:"4C,'|_q~~gOnǀ0% ]Lۙb ׄ0 P^w,v>I#e16;,RϢje_RǕnD4u >9$l=I99E}BHR6C{KмK 0dΑ[JolT$,Jܶ9|ųc;X xXLXc BcIݵ$jt~T1} Tif&6MM/hNG-8K$A|2{(<6oc[uRB¨)Fq40f814^ƅB6dl1.7U=c1J9JwN>hӭ(*bֳ#\"s'xdqѦ ,*RI`p{Z\TKNka*(6;if (\Iώ& 8=) vԋRK26{nƤ_m4꫷TӯQ2Q4J38gǩEr&[W0 b) r[?&3F|{mVRSfrZZDfT7Iѯ,S?uOdKNqoQ "՞P[S1=r3{0LvDn2'?8HGJ$@U>9=g5}@ #* O\YiHo2pg]0Ͼa>4+5s1a!t }0̝"UXŞ,%a>Zaqěu|FW;kILmSX P{KRzʷ) 5Gn~?w-& oQ]4 ZZ39c6ɹ۞?9.hx-jɺ1&*'6H^?6}xYFox`XswŸ#7ዬϹ@09NUJ'\V[8z@n ʳVŧ^P ;p jNOyH7)k{4L 1]L1/XLP511K7R8֓D h7ve4lh`i!| =lc*#H.vv1g:c]~Kxk=bq.Ze=3Պ{SMڸYk!NSoIտ6YgGU#cUѤ;Ǿ&P* UXv[*G+C h ӊ&`fTאևr28$17y߃;hϤ?̥M̨% 7mq&Uu $8!%'_h4S}Z/,_ >޳Ts/]*q\񐳁>  v.'2ng? C;silX^[Y*%kcM,t& 2%Zp'k9˴H9raܔODP6,7 D6 H^Z> Nb9K}LyRP )?4j$#̔>)@ )e=@R1nNZ#VEݱ'VɟTˏz")ViE[D%}| fSƣ٤ˬ[%v{$ܰW81ϘX/U òͭJo;ߥO;\] If&aMu!5(mt'ΡЮ.m /NXl`P} +QMۆ3}俩+frh iNblo/`-e$jK=Aiqv?{#$H>}lYBnfS$F~) >Nof7a0=#pLU b[N+\)ޖOO_c'd{v^{<$YӠhzl]J礿@)RV)5jqylℱ2_S}.S m>qu$ A#*G7ZhY&*p}P\;F?eӃ_(հr\.Lhj(/Ir(]']ߌ`ۛ֒(gQi)*RST3՛'}l>ӫ։t*Kiƪ sCx7] [\_Bvn_uYg$0#Qj<%'g>Y=2WK3W#St 1-G-9u8ۅu,)[Z0R}01|5xq|0 rlY W$SD) okG%]֓sO57ZvPyړSӈE<,VPLbCc dM1o7rd4[d& dUWc "J w&>c+ğL],e[L}Bfr"FN̆16l8 _ٺW\tإ1u}g]ٵM%V|O':8MB,0|R3-1򭢯f 25,9e:Ԃ g:%:P[t݅PÝ4b~ $.?\!e>{d[B1U^;j΀_IFZNuɑzfЧjB_Vw8e{˂PnNgNNRazq$x!sOoc}=-+3WCb$x#`0-q\) KRE_f@@^JH4#1͐4CIBBNY+:1RVtLuXւUOq@4xg2 l=C t-my"h;5)Gܮx\+O3vL'X(QƩ;>Wd?V!k\_<Hc~aPg…ywf%'[^9*qJnɅR5nV׼ۘR޻I^釪 sNH#7,\B.vf?=9I>Ӷ`3W} N1A.I@mU<[\YUz%*h5b4}߭t6<>1bD3'9jHL`E ]?cۄQ M3ٰ9?p3h)> stream xڍTk6 ҡ 093 -"-ݡt HKt4 75k<{{fzm=n{-XEpx9 ==p!Wr\fC'! A e6$Qz@(HH"ayo=@ r0w?OG;$""9@ 4lN`7dD;WF.cy:Js| '.~ дqU.3@ Ss@xH+ #M`O2:@OEIV9wYralcgssA+΃Epl6pjc$ @QF`vwqU#/76+@`nn`(+?y'w?޿  P{_e{@!^`8Ho#k+;%YC`;,q#p6` o.!`Gw'F'`D9a0oG̫g*oW(eeanA>7 "$ ? ?6vuDټk0v#h ~sށ?LFoF^$6nWqB WC\RZ rEd4W!;?s@w@08׍C. V#OS Z>>A.9a|rK 7 C M0O_g*(%xABHoi $7FH;r y`r<~KWxA^o^|H_HN^ȿ 2Ad~n!/ +FvD A[/l7 ;wDd`?9y;/OOv"o pavbaaW2>ck &'uLiYk*4Ų'W!S( ϺaTBiDG:ffF7υzw?vwLEnWԈX{&Ls8bOt/}{ѐK~fq#Cij5U$Id٪pY w 5悾:zcH߹=6}PW21(z/P^1v :WbdD)K%%#N%7!KH-d1gi00(5x*dMpT!2Onwna&Fv8AG1oY6wk=uS1PKt+XUiB> rY䞙Iv]oh}T-nrS HrfL;>>bU(vbT/W8rCElONq=^gcb3%fǨ~`a =GڵىWz醇߷2 >[b#zu} ŋL,(<-uGS^=CK<7,$%nT&tT 3^G>nMAl'o֣F2H??z4vz疶_>RO_U"'}@!!וe$Tt:?yM6d+Sk$SŃ3'v_ 04V$z}rrH҂xz<52"{P/iyI{F~(|WS:]P#ړ`h];"U?jfGg<? p;/RxoWq~( wDurW޸ ##&y+_cevnx3z1CThJԺPfuU56Jϻ)~֐A\_TbUe*pg-vA|AR OdфIl.7eyPy{t|dKS9 t.!gT6)0 Ui nz6+,k+9JLIwlGέWiz%JyɁ5wVhGN шqq ÙنT_F- &;3u7PwI̿9NFUt6q| 9V?- l"%;eԹf./ԋ /ZZ̧&&ҁ.n&y%/t|*UaaI& fO^aJ5m{p)b2Z(ݏVqR^bZ隉h_z>~͢QNԴ#1]"(=ŰLz3nч l70.?k{XC~K5^/ZI}>\sZ:]Z|GԎ?&neNۍaqQm7'OMr`gsoQ[y<ۂLߏ _ {pn[CzO}GR M؞!?jHG"Н٧RC9b( WީJvGτ4닯3N^X3OS}l+R|I\mꏃ%~|kZ;'g.Rա}s<:xri˱>&^F?Z̆m=Һ" "+ ْȰs Oӗcl—f }M\z=l;af0&3;lҏYD<@u}~!-[2GmfZE[  Ӈ ׭/ {XZ%G,*݂Q$DPU"աd12-J2FQOׅțZ0XqUK;DXګ9dHđym^SFu~. $r>i)yo a\vdrgd6T0^63 |[aM^= Mg~Y&KtϽMrpohG,XNწS)#N|qmp>"SUad&M #l\kZ3}f$26 ԵU+ڌ^?1;o[pB/jZSVJpER#Uj& lNG;mt+di~{YYTGńɕV+D} /Al_E%ګ =v`b/q@]GMɼA0cnܚGK+ɄR4ʔj %u&X`l h֍z.,"/#njoji.z%yO|^y0MyҮRclxNB<ïD:a\)uh#7R=tS$ JQ{rbA]K9E'+uȨ六4L?+ﱬr7@?,zx /9UΪEYov U]Ṟ|\"'Mȧ(xpVunvvbeZG4]Cc,e_akw4@HȒ/eHT ?#XSѰŌF9{RH0VjgW}*Q}l&SzϚ31ċ3ĵbKBCZVvInXE\fg[Ȩ*9V5LN-'xrm$Ͷ/LeBra߃6SvME#xNWADI{SMPCItSxD]gvâx_(ëĝ t&Ό.^y'T#Mch-](m8'rq^GEǶy̞N w TµFp#*;ߗl>]^C,GLYլ#_'uQtݏe̶%Km̏O?cV^77D%܅@r.Y_C}#^ 5B; ':fU LJ !x/(65|7E_f=28]0H'pa:;|<.mc$ nѻ|vB3]'\߯e'vAkj Э]ܶV.g'I|vTBW7%:_1}0Z௝[p񟫟hiP˳!5 Qu1Oz-?yt"_>n9~@,?r{ےPT6^XM_}úCx_=) j !i Ck.ގ8q%Cл]7#m@397m=jIώY oK8YpP tm:7/Y,9etLގ,oyzHq4w2Ѿ\%f%Vo"hpVĖ 1D*NWS\eWlyfcD뵦+ Eq6PҀk%xי-&9j $ONԸ/i!"obϥ>ᣑn&%T9~6zLhyrZ-}uPCĺ 6$Q6mIc$<'k⢳cW byfYo-]EF؋<Vs:-{_Ce$rvl)P=?@ώ\\:tu0}^x4 SEe媵u5~ˍ;NU8zشmv;+@l?Գ?pJTJm i.nӥqޛ /vn=UJPk&MAú<]1_!lyj G}XQczû@{l%#ϣ` ~괙 GTntׇW/qN<ַŃ:|onUFGOg tB$?N?Ä"b_w0[J ^^Q6> *KAYvv` 3aSbO&c.7kd%*2]:ɆlԭRq.; lvl@UGqCP'z@:`e 0VI˚ؘP5 h#ց UU;T\2GKnFEaIUAPL {7r=Jc29ou~zn/ϻk]L9 $lPx|`4ͼϐ95h=RT"VE{APԤxԜÏQy?8{xe1 (BX,+eXcSbN}9)ؠpEݝu\I\e6I!A,Xot^Mu9%@񜯺:Cf]{ ;"ӆH4?M5ul[̑ myhɊ(*GWmEeD>>*ud|n _b4Bv'д)PM)lK7<0r86ƝgM2{ *xߏw8~FY9ѣX/ aSú#((Nτpx_2GWq۞I߯B BCAaZ}4UifXJx3*PBVB(_"܅p{D6,Y]~ΨC^B>[VI!x7yC/4:8 n-)u&w_x&5$]!ӌ8 +6 %94"}wuʹgϦp,ތgd$XvlߚAYV Lv!SLU&oٝ*s(ITk} *FJ+)8j!twC%uxt%]C%{RV/M) jGz*^|ѝaL0U7~:ט.8rMJl:9)M,doǮWz#;Eql?ܛ32TFG5bj -eUYr4#ˆ GtIu "DkRS}\!c '9zmt>~CS/TP͡%w,NBhv"69ENEMQ'>GazkS` y7O(h95> KE{=ןE,F!pl?֯f?,{;PipR6n?p(~ }Q_;Z u0u8^DOtVT iT&Azo5l_G<͛P(ݖćxr{T*&{xc'g%l/.{Ke;UEZMU-DKOC7;ĈEK[ Ǚ[yG;18f?ᗟqZFFjsqؖ9T-:ySV\ni@l'|~Yt )1T *)LZ}`!"iwtM}3n,fh>Rǘ_$mb%|ufsוϟ`PN>t{UytA`70Ù@F8"(#:n`-|@j.S-v쪵#Fecz mG`޵M$؋;?m|'Z>:;soL%"82dG)Ą9`Vgn!2.`9> stream xڍT6, "Hi6a]*  Hww! R wVFm=9[ Tp zz ( 㲲\п츬P W v)]o5A"@ +(a ^ueU@0{כ>C8 119'(#`WMGCB`PW`tpuEyxx\xh{in uݡ_`'xqY0?zH;W0 1a(& a EnTZ((`?]_``#`{ h)zr_` &67(7 AP..0/|܌Y atr"\]pOBn:" aksv*scfu@Q zB~5BA;A7|PHfqCh7ϿE q@aߘvG<f_Y({UTqIo<#$ "7e_[?* 0;h"o ~srށ)U=Gvjh oF?Yj ss_+fE sQyBma?T=ܔPm ׋Y:ͫrs[]ЛoK%ik`4 QtP"7)z~;$ם 7Aѯ |A _PnJ!oJ!or7.>C <~ F߼{3' Bp?O!!O"Х5(d5ߗO gY@܅kcJuɠkͫ@00L\!?j>:˯fcuȝ|R~|ܷ wέ'tu4)ע%ꯌl'= 3Cػ +2HYjZo8ONTXMeI#Nҋ2ϙDDaٚF`'U rs GjWC@IaP$)G GTNJ 7 K2|Ogd9.K};ёTY'> &%E8[*MvtO{#\u\f($jb]3I'nJj(}ү=9R"wlhzeQeϝs3dF0c 2O= -Jh}L[>SA<)]vk&]#su`0z!Оrr|-GVmi9Z[3,M.-dbMYo|֙JZTX`[z_U0.X6{ǤK3>JԌWOwNp>jz \oLS/*1<褰8S3B&5ݵFIڼ.)e7<ϳsUPU"(O eW%7yh~#pabajjOJ^]:6ϒ*CZd;`L]c\8++ۯ[}./qr#tUL:yAMSkW"(=7/DOS(_|^~*[O}'!ulyaSb:9XqXw=򰋿&"/sU|+ޙ@I;7Ѱ)1gA^^,dKk<;$ⳉ5ߒS<'^ɗLnycJ-x}ydc֬pfT{^ohg&=;Z4;JML41Zwv!baGL\K#2 ١U/ް:r@G ~'Ņ;K>wKb4gC>E.H+1;6[7YWt̫3vڈ> x~3kJ3q1~Z;sċm(8e@GPXQ)<΀xI㤟F)4r΀) NڙﳟNe &. !,60*){0ʰ;R]3 O(dʮ8jʾ괯<`~ggJ\^1%0܄E,ȐS?u/(Z(-tMD6L`܍EwgB4ykWf@rgHJv,A=M1xTRa[ *#{c&faX=6q2-R%5. ~dK_q,nj8Nr%OVntX|aζ6GR=kzPOQ[Vt_ g%ZXIVtwk?_iC"cb*x u pViap%XDPГB` 2'Sl#&*[ "*,5lft G!rwMh}&J7BɱWKнSթ GVRA{WQˍJo&/c7(OdeoccSl:W5nb}˵6y#g#FۺVE`݂ m)Ŗ4v˜ek#k]ϣ6KO({ KR| N`uLX,ʌw:+j&_Ի=ֲNu+v꛴7)],O$i%jF*;74Avz3;dHRԚhߥ넝ȕ^\)OhȖ@eJV nx ~UygXTr8. & ٗ ~Cl&B*_=G`ǖ42ۗ[јEz^ \k-m'Z3 CB2Ec~Vjqk:5W;#e@["ъoFJy0M~F7nXAնf*oeOP6I ٩m/gZNos{0e\k\xk5=ٮ*Mɝ8s $%Fl#x$ϚՍ׾&@.ESOmuUthyWՒne%)ucdo|/Ce+'IdyjšmUkѤfݲYOu%;Ǧܟ&zĈ 5&Ʊ0~d<_Vzt@Ǖ%%iY&,ҰȢ~؃ a?ro-cU06]PȳË|!=>dͰf"DffqE{h_+lÙFnUmhO iY9Zd W$*(oGf{zxV鰑P)S__<_Ia P={ }0vŃENWhqe=c^@W| qx)=Ӑ@c<;pt_K6/q"pLzmYu^s̘EY`^?O2 =FH~R-N*/üToW2hQ]K^Aܨ'G7>&e0qBiu|_%4&CījPR%PX!\(nnENǤP b7\4,mAX uFl3Far![̺u1pd^-a|΍$/\g)Z..Z$#|jDe}0U9Q:YPh46M轓ǐCr[6թ,y/f:UO/&P9 @#7тڏ~`qWiOֿKWݦj3Y#B8:ǠݪƱN7CC}4 Yzp6A۹Jڪ ?MR%%9# E?CW߈`# _}60npY+ԑtpb#VJ6:Ȯ$($w^}܉&VuW)C6nd0~q7% ed;VqX[0QAh-ryG{^{~7j92[\ G[vk,pѰ\8Jd-1f˂n)&WPS}Z#yW4˫]T|te jr=Uܕ/p%YGyF/=1.ĵ*ۅ||6,=͘"gPC~AC0!^njd^=6'jfm)m}#MqFŐ-^HFZfIQTG,Itm jGsQzH&vHM|`KU'mbbpq`0:mDb8c')5ӃæziwWO:w@x2c4zH& u<ҏ[/`{}) =Ho(hb/G|-Ů1"V x!de[eB~\]s,/k= jLg \bcQe.]L?N^1ܒ._\'6(!}0*štRJ6tYbW15R-Yh'g Mu>Py:cQf!41agPh%oru|7&QCa e^ nl0j%" ,Oo~g9'*CsBW^aξ/2.%ۣDg`/J5{ @ӅaRxVMX¬tm pOqj/eQwSN5HF#>kI;#O'@Q+3Q,(ﱒo?o 1N w&dz䐔j>=_E~70d⁼M;%׏IѧZt{& >goaԶ\V8*OO/T߮Oݰ2eɍ{ΗS୙ }0" ?4aA .OqĕV0% S̗toR:g4+qn6it;Whgf +WXԪNS1FS침T9MƤ:az7E"pS1՞<U5_g81_+Ӽ G~L;s](c$ɐ1_vs>jՐB4YbaRL.Dyzpwk~RN0 } F[V -QP$cWDt(QN'O|H\=+JfeRGk SZ" ף έUϘ@S̄d I k3S7Zafu%Or!&o3tG <.Y&kgF,kz=c!D(p&.𻝠f ˑphaoѫfK>*Cq ?dw]U5[DTdwf0c]f/٣鋒m]p/ylVX8 EpO^vX<':F/Lb1N$ Uk2ҮBJD1] ߚgZf uS8^N4 $4d%XJ;zGYB;>jL&/;،^vDoٳɟ(pmva q%{B\=^J9gw,x(Q9xz$Y&bz>s&R \p]}<]+P˧<'bH Oߤӧ}H/t+aJa=bOES/U`\5RLl}BfG]ˡjOd<C)[Jh1naM10Tp ^5W0"LQQeb?XmKGy wyV_ ZяBG;Mgv9V lf RHhK?U֒H ;wj##ES5z?T[;U`3ɵelC^==^+FI2>w(o]zBʏwvGp~t|cEU3&qF2d=^UL\9.$e/ϤdۗSʴ@jn;1oھx,,#5yE>m9pΡ%hѽ,tIUoԜ;^Ht>/0֪.m/=Ugic)FY!hW!HnĠw/CaSӎDj95(YtY5:wkrHCFJ<eI߳6p6Qwt%ygK}眚 Y00[mޞ%(\bI蝵׮59sS$ͷ,zAD_OW#?;[ =㐇ǯL:v^aiUژfnXK[Uh4Z~|*Y[6b"NޯfVhEĻ ^TH0~z&պp{'y ~pLsd/ZB1ea`wbTqWJLeV1ƀ 1e7/ Kȅto'+zX: ^*z߫s,f}tB1Q$~_B _\qq]ĮuPmkj`K/H85NT7- gzЇAMgދmmi!rzA֥Ffy}~} :%w۹E%g1|h:fE^gc r{k"C*䮠j& ,n{!c BaaF2d8Z%(7p4 Pu`(uvDJݙXMڪ` endstream endobj 144 0 obj << /Length1 1910 /Length2 10777 /Length3 0 /Length 11945 /Filter /FlateDecode >> stream xڍuUTZ- Npw:CܥqhhB,h !Cp'͝y^]K9U*L`S WTWXYٙYYِY؁x4Agk?8ˋM兪vȹ "0q6(2 g$*q'~h@^^nƿ @ dR6xW Z+G>wwwf{gf0RnbP9 n so%{☑שּׁR[@@%*A"+;w"kM& k;@YJÅ``hb ~7q331}!ռ @JT` ֎.vUNrВ`{{3$! dmo)殎,N Y^LHl '++++yY.x|!y;.W?@ di'd/2k?2x3s_͢.bb`77 yX3*&e,x9Hq|{}]A 2 5gd5{^B_;;oORvv1hC&vL˖(_vZ-}.&/"`iQZ;KY{U]̬5Jv deپ<0/ \]R l{ 8&' N7e]AM8x C~*'E_"X$ ^߈"Xd,#6߈g4b_Yߐ7tCBB|Qn"3?eX_: 9^/~^i@?ZSX xҎ/r84B /o_;2j=  ialdS(;I/m6BC^IxEOR =@)Cv%1_+s[udLdR{dׯogњHJ P*$施Th>4 إRrJmK3py5n4ħٰ ܌KQJ'hEwF_X!s > q \G})q;L694-_ɟ̙V!ɻ[k^!)͊N{ds-̮QA_pIr>/.,mM;-Ib+kmUiGZ´I.gYnJ t[QҹE" & r5UCKmج;y+>Vg[tU= q/Ly)if pt': DŸjߗc܆µc B̭B<5XVޘF6}wz,|2~_2KqY(0rGd_@Dǒ;`H%!8J+uʘXΏQf(vE8"IrGWص;ɒX9R\B5)BY|.|/Mn%a /1' :;˃&a$0_v@bMoKasĄ$ҮHM B Wx[$Ҵjw\9|ZӺF:? N@yY+=[cwHن&FF]\R0"!Lc53Ұ{pkIksW8]UzO >rI ||Hё ᠮ̷=#48Va?Q@vSgpAi"6%KcΎ\M mJMP]F}$2ّhzFW=aVPO Pa-}VψHt2E2aH%[ !_YQtBg_Jd}*LsK}toHW1DpnҲD7bLҖ`=,pJW/8omWESRjZ֛EdWx$q3ŭm6gWaLc EE#rn f<g,h$wzMs٩^4G(e{P?qZy:n9ڧE9(䨿nVI[kFx_|Lk06$_W(z¶(Nʺ*%= )[SbBBLqP,zg Y^ :q$ yv5tEn^9s"ZKr=_.Yoqhߪ䈝"^k}nf"8Ѕo0Sţba};\7È[:_iAlQ.3,4C~ЅdBFUUp%M͑i<0ӧ}<-Ԏ,0g $*omC̈́;82[2`J],1a?a牬̥ZKFΆ7N&>y DZM*1fT |SPf%3WSyrWge%$T`).Cx;n%?Ǭ2vnܼz@>~z'K~J2Ó܃2@V0gӑG0Wdt/;3f+)]8GJGQgӘg6xχk{1Ӳ^GFZtIؚ$}\8>mCzSj"~[_|8PKJ|S?TW+NqpGn.>wLSjqrH2<Kڿ:"|oaUԜ0%E2-GG |Tv&SԖSM֐%ːqѪ"XK,CI}D`}9R~v>ΉKnKzЍH6}7U}IJYQa^j`dk`г`]͊o>F;Û5$K &Deq,$5 +Ąԑ* ax\C|E™\yiUghNE YrofHV_ш-:ߒSgc6vWmS 7OHEm`h²Ы}"¯eq fF] UX#bdS'돻|m7 5<2 UI0+'K`ɕ5] W֟]ehIF|BZ[nXє~$͏"n|`rEkZzw]A--FH.˙9{i~H\'aM#nZ ܮG xp4AWuRF_α"n$܇uss8|l]CI`ggN¶4L (WFm f4{B̓"yy﫟4k8@z'=%V"\HJLvt ă'ٖI r8 #UWBF]W L`mzR Vo/˧ E#]զϽ`uבS.zH& 3F ®4s{.oej'"N ^ 2ř(u_{y=2?.=ecBhP/g1\ekfv*^B# ~^.mGP銽ዠ~GRL❉2뇤)mϣyVk/lt^wh@hϜ ?6!y ݶ֍OwzlM;.Xtc+qH~ʏ̸Ӂ(,eb-yQd K3&Yh(حv;:~jϏaW~ogOW}rW hs^ªH%݃fR*s#NǚֳL~ɡ7R"VYy[{VQUƍ~۫YV|X]ZBKΦ FcEg7ZLۜƱPlbjM\ yTh7dI$2W*O|&t;[VGp6=@KvH/3{{phhpخ#qz.sCPW1fsCBMp2r S~ᴓoLC-6i!cRLFټ#օ0c9:Hfӱ;փ ~I|QFпi*(B$k)y^0+S,pn\- 9wz%TudsX^; a& â#*2zBVZ<=IC\R/y$t'q'RpQ7T:qR6F9OjVSHXM;:nt9p54oQEL3C~Kxk=P#kNf{-{qRdFb0H"":Z:8VO4g)w2Q9: TՒ[}L+.G&;wFEQFcj24a1GD~Y Jn 'p5jfXTmz6OSMT ,XQƄ &sc`HuC܅9B;*җ|"E*=ENTFшEE 5Tv.+Vu#(A;PDw$u YmoZ}h9:B8Q"іZ>XZVcA7̑Ѧ)GgUȓ wRQƱg3.tɸއﱒGѬ/Tu@ڽ2Zl3u$P\+{%F87]Na@/E>;A*-Z87@Pr]FjLK1:k]ʆLöߴl:2"L/O gT&ܭ۩"8υ.4ͷݹKy: wku; + !cfЈ A |R~M~ $2& }9[$ju(:˵rI6q0Ѣpů= D L==r$LX0b 7B2G[1ϒB',/3NïLFᜡBy%@n; !E&6#a8[/z5^S+" ף5Ubdn8/M̼8/iIEQoC.VT$?\fu F9i@ Եy mmX eLd P^p -jJ p.r_l\m0gWOvd2>T<^B+P.n׵aѼF뺡P3IߜEy/6ovec$`@)&Y{=zEj;4Ԏnqw;ScsehU*xo24\漃p~7MG0H :B+q- BF-eh "[CiMc23 +ύ}o_Cˣe3 >4] u-Zr!hx\};:բ?!'~ r89ZI1@#XIeUvtYs-a} ڹ"t M--hdim뾻 oɱaY(柾p8!4%;Pw$dd1X%3!503HT;7GK;zu/X2l 5`AaUaKW^r :̕vG7[Y#hBX9"EttR{m]M 懫1uh!U}9ƵB(5Q)R% Hag$y@0q ~&>P%a=yHVKҫ= _!qmuJtf70RX%DDؒkxӌuJGyeh~C)kKA&̻֨Ұn3(ζMpuj^TlMחUm+#EnV`|ku|Xl9 =*:Š7dDnf֥M&9Y2h;;؋F5b@taP sOރv8^*OcI'qZ: O[̐6 2ECNc'ԏ|cϲ XJDTuwM "rsGc& >9,iҪH7?(> m'D1 L'54L1W6ݻ+(f[Ƭ;vSS>zy] *$g!d:rpPj[}͌m*ɠ|+#8HwTKDIg6!bѬ.R=%&1WKZH#fgz84]Z9I Zoc1hiSX_c[M 3o֖;G%YފOpHD`TU5X!<}ۢU&O9Av kyJ/P#J"K̀|VڋT KOtb\Z_MZ% 5viɓL 9TXrǍ5RMJγl$TIt ך@3CI.#2>exWUD;ȆHI؊hwmg!X#"c'Bo2">cE p5Q|="RvmmS֜i^8HA{{y&Zf ܅,9%D Œы4tV@帘nrvu\U:9ڵz|hpvsY8>X; h` 'UeT2 Wo<$ynN:Nk2sq xޕonbx,4A+ Fmس(4 >'gk wЮlKNRq)6ϯZya:3:_I:G&+W 0M>O։fG$|ۄw)Meqw iX#ma_?M_ꪸkGcv'/n;F cK mqcJ&F ڻՅ$2>+hDvLA@z9VJ\K7'J5L3=! &Ϫ(16NUjƕ^/è4kU%܁IhJ8P'HbNߪf?j/#RJS3[^s^dԠ ~S g'8Yc XJ=oV֟Do2ţ2?Yo-gdI@ DDT!)+1q9(Ms~^PF;eHlj.'i͌)N#0z}vvLk4MxeP:Jlu0WcPyǬ⨡W-W6B &0BGz󆉂f?4m.< @ /^?9(48nW?>4h+VH 54Hڵ{FtX(6 Ԑ㭜(6 x$uᣇȲ?ΖEvO,@EKQ*EfV2'W|E9-Nإ,YMuݚ}I_pFU1k>g }哥KbW<@W,w0Ib;?PazL܈5J(ȫ>`IJ0YTq>k.HYlhHq(iC6xK\x2MR‹(Tn=_|-X&"~o))P{ yFڧo">3PgLKлhU>A P\:n`1洹y^Ǐf#p-vSޠ9Mh@)dGk~ȼ0uiB /ް}VD٭<3= Ms* s֯so_7q|FQpb}[8(pGBKO06JFgH^ IBLw?%ʧ%zPyDlk{V,>Y7!.O*Unh}x2ԢgJq͏Qy.hvJq[wO*k"dU2{L7%ʧ01=qCt7&w az0#:N~[;N 4۞<CX pުb ᱤxoq=0Wp<}6(r0$]V5e#.|ZkEU@<8Rێk&0GOY=va׋)u[d;84.M^`-(+[qΤݞC͚8xoQj͝7N0|N. q!ȿ0װATSlN5ə$uU6v֝*ʭbGyR @i >sW[Ӫ-;%jmʥHw~S s=Øk< Ny vz\D-T={MmSb%SOj_1^Q 4v`ptVB癡Z$|UVE$`95Wʛ%Gfm)d*U$4)잝Oww9R776UԙuET{u*}/&CϿU?9 GF.V> stream xڍTM R4 (C %)ݍHt+) %w|kݻXk>{:j5MV Xuf` 558@@ iA,tNT7)G3&m TA.v@.   v9 M]!@e6" vI<!Vp|,%sS(PlW47j!`g`vvvdgwssc3wb9Z2 @ lU4Pwml:5M#7AP'x 5^U?_tl+W"`Sss)ZB@Ul,@S/GS;'<bgjwc@Y u)Ŀ t2w88;9A~+ eR0{{0 kG9=_[( ZB pq`׆B^rڬ@ͭIhy8XeWsZ @,/'SW0 ;V(p3O#@ ? Mfy-j(K0]?0wx>M]V5S_- ]_04/σG_ݒ yL!v> 0@UX+- .l  Y984Bd!` 5] P g >|NjXg뿢2Psů!::z '|Z-8 s-a_ deR?]_C|@v ?K@v Ȯ_Kp=ٰ[p}oOk!!\7p!>. 8p׿!77o7oߕ˿ u !\8:Ÿ)7?`;0?3 v^̍ucT0Ju͹Of[ffƂR|/M뫬^TuTVTf3_.ifru%)("q:,4鰽?%='(S nS$w fA 31o֢^( ĻU .RtE(n= qƕ$FYú.vK2߳+{{[n܁|7M笵٣E_%t}1tH.ZomR#M^/Du: j FLWrԭ:h&b/_dDsXy,cV[3!zPYK5 (0Ln`E6i*X+[qYYft=/~aLfzy٧{(I_=/h0cv-eqǹ&e7o/c:6\ 25$D%CRʷ/a yLe@㠑q4Pr'46P?|?01&G"Dxv <[n#`̥~NF`'VqD,,QO>{YuH6@Be+? 82d2:E }80A{iMl(u`ެ4\r=/E6lL!al#Z+%vjӝ7".P@M AMSzl)+D#Q'ךnd?KR-5̓,K4?z%2Yز'mޡ !Ll Iry=yVirgV)o9H2znMKlыdUײ\=iŠbOBt~.Q[].L#%܊#2-jc3Mdh4zD>|.|ZT7VRQU!wdV o|Y3xe# =Ϭ\lGS'(qTiY ʭ(! MSKGCRQ~>Z+!X>-n[" Ois* br%z5+2k.j5Kmh.i0e %߷}DtчMs{<ȕS<呮zax}@J69Q~Gܜ&AĸULA1́o1S:XKۙ6Y{q1r8Mhun"n/݅(K2(їmk9]ieS#~k$Fw2 #tAr!a +=Q5OTU9r:>6V_m{w,p\W>/^Lc:uN^>-(}|OW+zs\"22yi$:^7Eqy#D} ?y "{&u!&|.Fa㝊-[ NYR9kU56}VC23@=KrS֘FU㻷HDF4[>0AzlRKWumj)ҴwFD$t)ϟjmAgmSh)Mw=k^4VuԮԡ%ῒ貹HES;2( 1l_R*E?v4奒bŦS[=MBXvu @$6imn]O:.,JF!:8v/tˎ/: B5nL3 To5MdHIQwJr?Sx_{ |\kMUSPynRC 4Dvi/l<[`ۗU8A8 0qC3C&Dn_V(BNc~o7qғG:<[w^a2c>τm*?WWD[fo_ۣ خkM3?Xz6@bZ1"N^Q5~Zx/Ⱦ*]6?> 6`gd&MJ`o`\gT,:X| bno* '/ dԻԳJH 2|ᢳQ{\7o4^?3xpKݱhWR)EGZe2%O~CϣBySk؉nE85h kzHUI8 I j* 4d%䔣=sqRe Xmt>[ѽs0[O:/| ;B/ce x([Ȭ-/|jK9Z"A]X3)PTrݯ:?tع^I6tР^lz<]bM>馌F}*)HHpK`;GZS1Ї;*աPyW[ȬAkB&&([z<$iOgqKG?iڥ) 5 \.!BAZd\O>خPpKUXߚ(ߕT;x*R=qz4L~3eڹ3O"m{<̲I)J*IJOWR0ȦFfg9`-Qם&ѸG7n̈(1YCIƫT2kf\ZzeBÁ'j[/ pU6BR֍:MDd -XE:,i4U(V Egqhh#qø j,#ص@{cH9:u%{f%zrtS.~i#JO; Մ"Mh*0lds-g^OxR em^2G Sǧ(b{7ְF'ZzLbBB LaY/z*bws}{00FQ2]{єwHA k6ߋb7хޥlrւjW\Djbc$Uz; Bm[QKn_ST0*m5f&bcGœ,?Θܫ`\:mKKBo>^G Щ~f|[JxqhRJ =97` 7f%-}%!&`Nn=B el@wxZu%u\-_@Wlհf%)PKx067ڦAFO eCIHB~-% Qw`#Ro_`>.ucLWndYJmUj|DjU{3tL@vߣįzcR-͖xoX9aϤffįn~m=傤~4{dȈ< NOO8 !?2c}th@)<5dH@CP[ͣxB^~ʰ,-mPpXWLZh׫f)ebRvCWz&: 77fhvD@5aX[~}!+iV$>wU٩K節w_|&up+JwaP81,VilSS>ISBiUd]f/Eo(xdwc--;tGđ齠,HEJM5.i炝|-AYHd9tMAAV_J<ɫ}1sp25PZʣX֓dMZ c|mB\#:S`N]i?nwyX Q,l-]'K|m89Z+ZG^\}o`bv/05v^H8}وf=\;:U_)? ,wb,HfڎZRY$1y]ov`YNS BRݖEŒ 4㛐 %d15e^<<.`e*OLCŽ]BBD`{6jG2r/}".e> EeDimAL9b:K 'Ɣ&zEn<$n G`d̴O{}ߩQj}n2;$61uI|x,jLHVV= g#H2`*\^M̛a t4k-CRQEeK}'3hdH3!O bJTѷHcd~xĄYSk3ұ GZl2ȳqlO*]]Vt`57 3/pR>%K/˼hSfJR4&CfasynE]sN?ø {Р4iHLsNY QLhTUe-=ƞ9J-? g{׶r|K1@a$1k y-CQ1l1xj+6PtN'Hƥ#^@HKz=Rj#ɯ,?lbLÉGZ+Uglc|;K__X4%uffHp$ءdHKR[žl$4posuߏs7%&k%hKr:5-ĭ^&2Yۏ5/ JG !Ik3+bhh熠eH|r(K. 3oD;2mU۩ i?쨸=ڡ=9"jlB3Th\RFZ?Z!弭qOFjn{ߠ,}}G'(cD}zSh:5p`:\tt)G%_,ntG9sytOt,e' z&7Zig[8n:#(6nOvGVWhomSo 'r|\80ehD% hflA$;3`W<ź: ?B"pw2A4˦}\0+r,G`BtXٿ$ZK~sbpƀcP+ iNTNOZ11_GʦRM[+v_&=۞!#19HM%gzŊFmF = Gv UL3v34Ƥ]NJY$=%;c+ 奂-صOU@ʒntOP(S.hn2wh%7@< QC :KtP^y!B!LA^ -Teسq\&.ؠ ḩsYYd9f]ڪ z+pՑ5.ѷ^o,Ek`6{Xƻ $T|9t}FX EƌEgs|tQs)[{&N!%I6zesu~a\Nc+aBc2n q?`|, NV-jG<3o긒5hXʑl:< ^ec? 8)]&+nwg5HEmԫ$0#rh z˩Nh먵tV30<8ru-ɝw{y~A~FNFžQ>Ԉ*Ѐ]D">2&8`)R [-M6C\Yb&G'5/>Q\q^1(P8F)Su9o1rF3vtw u -H'=^(#vå) _"ķ-rA΍D^Lq|Y9eݼHWrY~k6@]iVM;-k].*G@ ebZW re;{%[eIW푮K t9!,K׺DWɑB35AѝR+)CClc$(| 7pAbJw؝?N|Ca7s%Cg_{k}-kwت/|zF^ȥ%d8jnñ!#q2qαU7܇D>aw8RR{P!Rz[w ]՟P"pi家y~6=>=>ˠš9CnvNdO b~i«{@d,9Tri %/IrQA00_Ym5_vJW+ƥ3RYYͤ\*TY6+ G*jߊD1?뗑cΰak->q.+G5 fTT=dpl8& 'mE t6f/MIjriluDfCg ˮz2x k ^?Rjɍ|?[}&hI}x[~."p5vUzry'ӥP%5o#AfT}ǦsO5m.+5" %S[TUx5#qI4CH='ݻ}JPqa"xo#{IE2652^X":ӟ,<`zPw4lHغV&"'D'9E{b2)icVkmN58da퉀$6 t 1_ [ mt0q%NM޵*QFyM>v$IsՉѸ=UP Jq/`SW iF%]@voج~dûZ='AA'wGe0"iRl7Q|^fpH)/"tg-s -HTn]C(\:=t]qi3+o%^FnٸayO+8a&Lgo~v_`gu7{ eϓCLtjf(V)F}S|m $n$[@ 'D1橔 ŋW;i)IFA 71~NE{ Fמ[g\{-yH]ZzPo>u_mwOIX33\̼e endstream endobj 148 0 obj << /Length1 2352 /Length2 16352 /Length3 0 /Length 17731 /Filter /FlateDecode >> stream xڌP lp'w,hp  ^>}-Y*25&13 PlPTWgcr0#QQm#Qi@`;XH8do`;  `ge!ؑ i 2(2v@'$* #-hMl||<l Sc;%- @ l :{OZAKgg{~777fc['f0# l P:]f(mƌDP9K6wv3v6 Sӛ&PX_7p+ogcSS`ݝvf8]A6&on 0~co~N {g'f'_Y f);3 - $A@ӷ{qnv^A ;3hس|9e%m&B#:XYYy9@Ԓl8xكo4> s?$/'cW O"$66`!& #6~lֿMmv6~b)1U _8 `bpq>o1ߵ#9/ o o ~=V.Vӷ++ߊ]llGol 48m"m?&_4_ۆY 'i;Lljޢۀ*`'_to+gjvSom7)c;:{ ;mG̀6xc0;"\DB?"X$ )/aHAl?Ao|[>?-[>?-AAol?Ao5޲AoLMokx+xS۫G㲘%+?;m7\*1#_j?L, 9[z[Yԛ 7F|<,Bqڽ?o 9GV[0_(6'ۿkηnٿ~rQ};kNo| o?lloC65]z3wz vX-x72n85𭯮oeoHm:TsL]~@@S9@U]P]4ծf*עc|2]ufXPʶqK|hkǶG'xթ6IcĈDL{-rT.h*wn}2?ʗGCv?Us#?d_2Cg5Ι}f+gT.$Kg=~sRݩ@159yulV:f#d X6|2>m,Z(jFuhܤe "ކ92)+yxm.\k_Mzo!"m4J>:(]vyZeQzZMO﹫uWH!&c`7P _bs!V@ u,IZfv{<Its#jI(2j&2?BK`L)*忣[6*:&}9mXhIaPp,| |3j9E(B'6ҶN]Aa^DHȠjm #j V;e|=gl<4qn/-vhZy,ޞQTf]8{s/V.onъ,#w%b0kC53ж67+Ԛ+~^$϶}WUg5t.ͦ qI )S[Q|TVA`Y0 ѪKٳu-5RA^5f'.^{*j !mfEMKzn{ϡ/KQ "WiL27_("(*(et1eޟ~GW`K6:a̘ Ufdrne l*<:mab@N@L:2)}X{–,5y5_u*N@U SVreO^A&c=>{W'Kqn7Nъ-ecϣ)6Cf捴R4G\aҦBvVٷ:fLqPF8LrdC3#=nj啭E&]?[Pu= .HIhibgF*^Ԁ4#S[]{>$U~⳥Sl38W个4He)^ Aǻ B[A\aႄ S.*}d?VbTUuW c#gčl+eݩXgDdI/?ϭ- >fhE]=VC8f)c,27kfn?f~@SJbF+SֲwSsDVʈ+~fИ<_~Lخ[RO3\$aO}W%f[6\4&#&_>0kxl"*)\;4)&A}x<1cb~}c7҈vVF8K6%qć2 R [k"ӂU@k.~ ɢowY!Ց*@miڵC#-9xe)f:Lg#qQ*T@O=2*ccf`阝e,_HYsZkp>!'ASvn>rdb߿ J =kԨ'q-{>UFՓ9wʠEB~ѰBAuj5[ :*l4upᓄpΫ`W#~'W>.|KF`c,ܷĪ{gWti]0 ˘H=1i <,,!m+ ~CS4/ 'tXi>tbz;_A jM }2m-*}XstUc,Uu 3Cve}+sx c]iB)^(ڬ'F~CԸeD$n_|7u^+Y~zx b4ߧg#jr,]{%aq˨ҋOP~ykBDI#^?iRj%]P. o7HɩBr2ӟreFOyhC(6>B#W!T+bWQEÈoS^JTI #뗲+Apà\XRⲈc|I$oe kׁThXfNxJMm%\2|zeG3fDX&N4ƚb iœ\օH/?Bjo6}ÞzeGo{@v~t܇_"^;?8JɌ5lFHXrEuӣ7h$Gx9q+]e]Y\{]٪3=xMI2YH/7.5.F2xNغ(DEd~F#ܴyr:DZYsx.j ! c3$ѰB?CxN+G,[D.{;Iysg>46ɓI՝ʲ-<,^q0LfcQ :FIx֧.槻nԲʶirzz4MZ |X@bͫ+$ܖ" BUZN9XDPz’{ QxO- ]663ea1sTmB\fvR/oJ*iObR4$E 0GRud%+dG@YݤQss:!GF~A.\!!y,1^ad&j8D.%F[S>h^8ropfdq%AJ~6>+ =(Ilj?W*:^b n7c /`yW2R3!4/lxa_:}{q?_?&ُ[e&Zj \N6; N%Ӆ037@&$5D4KaP'"q:j(/ @ƙ} ( \`Iso˫Q:.ri!qѿG[^^7G[_** [Mu8ԍc0qtu/z=Vu1A\\:X֤{$Zԥ{$c%]ac,vYQ{)I\8PG\@>IsUfS!ԫSŲVu}6`2H >bXxI n W냧n:S1e1cS6rUlĖN'6^zk4p&7SHYڼ=龍)B Ph[wD8 ;m{Y}?^\ջ_m#]"*m a;X_! O1d7a LO:oqSLuq-sOz)$F[a!cP]O~km{CA;Xr$[%y3IRfK l)fA=s9O{p" iWjhO8!/d4#dԍK)1;E"$x/[,SzSF~ApfI!WNLeދ9n-RU\"ٚ~_eϢh"ﯜ|أ>ѹ;rڈqDbq@g8pśx|>~Hb?G90l3֨t`Xfr*RASm~KC989RqWB*?k5OrtBq5{PB=?=Qugg ɘ(k11e_fd B(2Ψdc)j?,b֛L1!JpW5B}&T]LT\ME -t}UҜ!ПOezgs0r+S-xESsÔXJǷAХ#,}Ǝ۳ZרA%"# n?kWoX8\b 1_N vu*(V0L*V'H12gM} #t H融W@,y^AP0_ͩ[ FF4X}-xI*.QuCW gwB&6]w3ѸO`B%ƨv}WAn0qoi^Opr֢X6׺ m) B**.#Vy!k⸉kFK=5l!SM2}ԉe*]eޥƂhGRr<t}Gs0S y6_=T̢uI1[=v,!LTj`yeţfiWqZ:P:2d8?ѭRG*h~AVIk?DjÐxBBW !zo RNHS ӉG(8۩9 %8[5Hsj1HQJь3E5;*,Iq\鴌ȑӃYBIyʝ:{͔eGKOI]K7XO;£aDy:U;FY{#t6VC˄,ȣ'Pv.|exTY}ԉ~ ۾pi:E?Zs4SYkrC!{'"2}gBcrfTmS=cEw_`?ONO%UM\Xu"Y$fڍf-4EpXON% 3 i/}wV< $y5Ww)18ԢG}>HWQ\~/ͥvQFDҎ'wYvw#s*0*]TF Je%TPyճ/i8UDm4UeK7cd:T@s⾮}a 'W5_=3} y4fgr5I # JR,C ^U 7b;q[1V݈pߝ Xv wJAՙ ʄ.KS'1sJƔO'PztHL.ۤbR/] FG.s-@i,ߛڏC/1u0ʽUR33T cE6es8?4Se$z` î <3Iп@)\3f\С7Vݩ f Ƥ@ ECO hp: 0 |Jև*I)tW Ejm͛8 @,yC=-_:);(:< TpfڝZ0MyNc.Ewإg/r&${JGW*oK}ke/\ fRZ2q]jd:=ùrCx&6OP=LX_u-aCߑ, emi AsAyg̳#q},!{ʪ 9g-sns]u5QrʾXl1vH7R3hD9؉^ zET~+"2\.qb HLnͣ PLΚ^or\tP _U'Vk꣪=}h@,rDj9:R'Fhˏzjmmrˣ5'>q߼ *2Եl~u _8|n,7F~=l2tv93G{З< "g\U`_7ڑyE˅QҶ^ x9!'Pd4P+/1Htc7]~0-6ocE.XH??VsasYQAgȺ[fc_^p0?͔(XQ?㳍GɣtܶS c4ضе>1ƭ7Pݺ [㯚YtB hs&mn,{FҲvƵ=ʊw<=pUd%٪ 'eMn5szc\(4~tsFĎ%3LaWK\Rg'lS^Z b>(^cj/MTrb?^:iMG7F׹?Q!\akWzζX/:ma+̕]{kFrS`[>;7^8kYLrO`ԹX:Ԧ:m7,foD)q^[jXWHo˶淕${{'ˆ.>@cCu!Yѣ?[o#þl#P"!̘Ybc+w-2nFfk3Z¢vBa%} Ln {tSE '_a~>;oo[M%T5bNZϚD LkB=c"f1rs\ݵpo QiًlWFAx0)WcpuYKG0?Fz]5r C%[mVu;ޮʉ&_AamB@ʣi]CU%ȁ|%vނ[$g|~o U101ɴa݊_%GN'ڤ.߫re̫QɐC302[pVԷ9if< $+f\/9: n4W _XVs}QGFŦW&ծ;7b3L;EcA 1y85qs))@C#͠Zɲ\YwE&GT%|7E}/WmaaUFxP+k䗅dr9[;1$uO$3G[P6;cԁ#R\L٦ (NNGD̥%mjוU~+X5Fa窜Ç䘀2Ri߿l,TY~PtKbAv|g_F߇Y ۛvG,ZdC˜㲼}2B]|R> ҇Ige@bSh&UD7|S^Z-.5a@`T %y<> Vs6IWiDv!$js>kf9;r}5I=Jw' +Y.3THz|ﻐԱRQG$͂g+%hTOׇ(9 l*7bçڪ',S=_кЬRW{s+d#4-vu7ֆ9_(FEf(G4-ܮO7eml\j_hi Gy75˼xTB6Llq7dq WڥI'4&lEdҭS&#j95ݟkn{ aA0}LPxEV2ThzDP;*щ=Ly %s2M$-N˓QmN G,$?Gۡķ;uMu5!9~4%6aM(Fg$vO[kGgYoW ȵ4-hPZWQE0fL[ralɀ-x!Zs,.J dEJ {O*hjoW}R5.HOyT*QD_:!| /"m& nt_$^xExcb%Z|p*Α&ԏ0OLH}|%K"'eRjapR"c}HaLӓij;o~CnCE4H8|܋>En.'mR5e4 9(XT|;蛠p*wGYOp #5˪Wոf9!%ʾu{x5亷KBѽ[#G`*V=)(Fdf*vǗ Qwh)l82¡E,е?jj@6skס)ayQa-ˏmy0Yl rfWԃ L"xl3@+bLU# :ydg$J RFbr1Uj%ݐ`ȤrjJIc:l>\5==_g4#31 c}5[M;uK7mh܄ˠ{=k fl `'3 ={6P5:aU ǎsc[^'-˃Ov[$Ig |MBk 7+H*kZwYoDD NJfR2mJ\xma)'KydSZ3$s,op}K?/&VOw.0Nj;d;܌"';lzVwRk[i~&U oNk4q#\l4| K P;>go)b(^ :J|Q 贰N4AgYgX|`;at`HQTv&Blz_A=Q~FlsR5h0 |c۸P*Xm=ÉE|Gleeb7w̜f2wxl& ''v!3P~+fHÒ¢ 3 砺E<񝕻jwI&wf +*riMSD[ 9I6$fCC,TQҘ #}N5:]?0ܢ)hhSCHFД|Zkqarh+{%Y)qIP+3tgk +dQ8ʧEy^a޹od>:]B" "h2nMg4SUi{q04@϶ !ϢsqF̎Q*W5;aUà j~1_!$(ԛf{W7CKa, ` ɊiI#CL>턟zr\!,Br T%>ɤ?HTmۜ[QV >Ayzy7TރH?&Gy Kؙ \?;Y6Z:D|/[4W:+F~ YJ&&.Sz]*;e:3b+a=Drӵxz}LEEq;Jkz]B{z9B7덜#ͶȓM @c 091<NVN laYk|msR:R8tfkEݠZe<'w'uEi֡OyRT|r:Qng耩, B 9/{ÂLLBHJ}|81L/ )|2cޞ)p; D%V=_ٙIǬ~m=q̱vIEr4U8SN"(N dU3L~M,EP;}rt<ͺrsǑߘbX/Q'ahTnku~ۚkcH5I[|B#d2+yV &xu:tx 4Ƶ2u1cxc"͏p&uu0R>T|-*c>ͅMŔS}ȯ3TMuZN|jK)D]JԒ?PefJ):챖 x7ڶgC ^ YY˫>R&%:2ֽ wo"kk 8ݯsH)*r쓡ߵ+klne  cvBn͔V_ V"PSވkR \ U2f#,xҮU"DE97#؄1{745]rdc7̇!fsQ>`Ns{@^W+2bzTIm?R F/zĹY+_}>[GmFlNHwM.8d OFWg}\Rg&鮉 ` >3:R"W7lŢeF]\N+tgC4^bĐHEtأ`1& r B B+ʱ{՟NֵI"U*6LlCdݶ5wqA?*Nfm˻&K.J-Ms:xߵAE`{E8X&TBQ^-b!hLfo^?{lI٨)}m*+r4U27Yz6>\kRxOE֎M)#~s&$ 2ZkVN _l{zʭF] ?y jn-V҃%gwȀdz]"|Y󚺇ߞ\=MҿSs]c <Fv ^MIk{ghI8{nU  Qӛܼ?0I4L`^&Qw. #Gi]?}^<_A9a9*R%j;7\ׇst}~Hͤq޽+n3#;.sZ&Fyz8+.OOI>\k_Nl?zr0 E߶Zj3{|࣯"[40M^w  4=Z3ڗeOLK-׳ 8[B>_ ^w{miHշK~؇V<%Dh?G]vOӢvm Tz.C.jݴYΣB儮Z TGcx03}[ɥ^-p˭ӛSD7G;Rb7Lb߉_.oy'䨝AA,6@#s1in$>,#ЯuԂtd@hpPk GBͻ{9om#}eOKzٍX ~JMEAl||YbD;D&F`G3_kUlAGJL,e*O/ȣ2ɑc*D"e'z9k'*>vqcng=`4Ę`ڙCR{,+Jjώ "i1ID&rۖaf\>3$}ŀ1@K)1"3?p!Y+e)7-i=}~#^o0R<= ^בc p9a OW/BOW1ZQ}؍hz=R;]Ū4 $ 96޳oϣ%@:UwfZtvC혀tLZۂ@(N kz.`<ԭZ-GဋcqUt57GN_GPAec~ Ƅ0L΋%esFH;?k-[G bўWBޝ>Ca!8a:&|ӥEI0q-͚8-i)kzYw(SAw,`r O/2dԎ"[,zsjpIؕj?U S!aI }zOX x1:efLK$ͰhUݔe 9f;Xm~9&{=ѣ sd3IQ 8Qn7St F'}US 3vFHSZ)? P2Hq:l 6vNi6J ]3ryGS}|DFLw ! +#Hm̳?aC d;nm? ɜ9*c{:濍3m[+Ib?̉+joޠgN'p_ 'Wc<<= V?;dG:h. 1yf=Ѿ{U_ϡS:XόF1qt{4}ň*W'!NHE5=DrJni}6%+#jh!yp(kpwA_#j`QorldaUgB.u߯8Tc;MqpYntt0F{TS<0xhj{*3U"+DcW,WL) F1m͈J8[Ib6+ӳG6ux$5Opc/h)龱? endstream endobj 150 0 obj << /Length1 1554 /Length2 2925 /Length3 0 /Length 3898 /Filter /FlateDecode >> stream xڍT 4oR %-/,SR !wԘ3c""ke ,)!PRH$eKb~9gf{}GVꠍ>Ө,* X"Q@`diځ &FEaq,fcA4*`AjR܍F 3@8O2PLiT 5}dW / Wڻ}7A㨀Eݠx EG^^^87*WA"Hd O,Q,qn 5U,`K"38lhDBƃT&A% ؘVt#G22Un%{intՇLud XYJX Q4(#Sp.Pq5cd:$S8—@c6 hnn ń-ϐ}+{JDD2@\AQJ d,@@h;zI>tpى\2C4:@hd"8O`1<?# x!3Hg'$?$XwRF_b~ʿѼ?$RS4Pꀦw_r_đWΆ]τJ?(@IsE+KC_yS?/U=(eǹ)>+=XfXР; o m>Օkd1$$e:LҘPA"A+? )L貖] Qw4iCih8C@Bih~HhG *ƂR]@1`KW[[-n PZ*.?:gR? U QP)eu /?A a]4N/%T[PuS^- 0j_ E̿E^zAqhxWq9ѥ_ٿUd(5dVUx\Jp,6xq6)|q?fW٭|:1Uu+S+n+oQi"ÜkfqrmJMe.˒##t3NޤM @@ A@yf %S<eErlc]. 6{~U{|9氊QX}^ywϡC j@QؗaK9y"O-_HM)oojfjguo{NB'w8edI;*v(vn{o6n:r7dH+&Yy< /!Un_|Lt"m]pMl/ݟ_rMzk-&1b=k}JyOuJUD=ΆʰR% )6w&|O\Mscq۪-?#I0 ooK% M$v|k{{ +1LLv?Ӊ˰y=,vKw}}WCݯv7iNy|gc9Ş:_g^6Um +iTl[GchrRFw{]̂i% y{@|U"|^w5yG~mDKM]hsڡ}IƥFjeLA(~!{=BA)*vWCBLz`'6-Τ3(fBz"3>qE̷op%[4kzv2 ㅀWRe{R Hf݇\{8 /HYS:ÛuFE8,N'j4[RC5WW?ʔi;k-s+Ћ;Demtii)-9gn(aao$b:S8}=(QrmvEesWC¡oAq5D,‘0}jojVֽX&k+/.0yx-ԴV8bb줚Lxmqss_zeՒNMj W/ƵlUy~}edNN$:A7`1PbE.8^(oןUTI~p4Aǩq67)>f6_Sgw4*wbm<2.5psVjĔ:i,au6q<(,{1`TJutفQҙiL򣧤~QF}A1#4 1є26۱chbؓ&0c_7q%FTh,5U| ۅ>g25%^>>QN]]me6Lp 0v '}xހ-6Z~'vNwu+}gpwFOv&tMSgS\ R;'+P*Q=H!2^_ DeI>Sw[ӹ AƢG &=bW=+>]۝#OlvKa=7H@F6J^S|ȮEqDun1:0vuC[Bˎ pۭ*d"I-_Pnv'DOz)Ds,C;G> T0 ~`y-oMϨT`zZQ{V 5 zo$oǝMZhUwf.vgYi'l[HS @jQ%.$?~Wu#V,H.`^W}f}`prc$>I9XY=9\.K~ 9H3UNã4C< 쾙+'KY)-Rb% Z=(rO\*{Ub+kfS(RjpΏ1 b}院NNOiNrzys/f}aVLBS$ꅊ:ZIa>H4\] 9f,z,W)#4\KYKFsO6Duh-w;TV3*wnrlgE"|1-_2i`y趼ǖ55ucKb*zEюfSgWQ z:L?OK HNI6.\ԩ3ֽݰ4}p5Jjp,RV;;ͥ~gjSՕF#sS+T})vҹ3rm2.Bḑ RKv[u4ƕo2`rs=mbiɔS=):";eȈ/a HIE. _Q>/tI[ˑ-y*GDw퍚w>>w,R1FLG͢ 6?iښ2jWUWh}u+[[6A_'xꌩŪgжޚ=U} >rek<9c)'n=s*cHOl{]~ĺM9Nw{tֻx}TQF2v}&W_wa*٢qLw-z&2mgdEJ9^e>wࢆf'U-rLYnaY6@nbh+wd(kHj-N4JÛ{M"-؁*DܫKk7Z]SۚxJѷ=;jg endstream endobj 160 0 obj << /Author(Valerie Obenchain)/Title(Counting reads with summarizeOverlaps)/Subject()/Creator(LaTeX with hyperref package)/Producer(pdfTeX-1.40.14)/Keywords() /CreationDate (D:20151021230537-04'00') /ModDate (D:20151021230537-04'00') /Trapped /False /PTEX.Fullbanner (This is pdfTeX, Version 3.1415926-2.5-1.40.14 (TeX Live 2013/Debian) kpathsea version 6.1.1) >> endobj 139 0 obj << /Type /ObjStm /N 33 /First 272 /Length 1459 /Filter /FlateDecode >> stream xڥXYsH~Wc[֜R;IΦ 1h홑$kU_ PPAPBS e>×PqEPDр7*d0*&Q:9y]G8C8> N9 %Dp #%dww܀"-ܚO E cy>3S$4az6շ{KʹN~vzE YHE*T(`Kc-٢jQ׵e$Ftn{nnd֜T[%SUg@v`0O]Z:j."b00btQU[OY([z3_\vh&Qo/ʴY!p?kjrPdcgR8,7Pe|O2sހe 4 -{O_9y@6y^UxVgWB?U r$4Tk񛭸 $G5[L^dWϢΰ$ ӓ:8NM2MF~pc{XI蹇[}ܠT_[9]S<4A+K,RP]Rb,gaA+Ze&ʼX#)l~AF4`.U=V(au,/&,Vy OtI1DqPQCժ%jQUV,X{vy;U>yw`u3s\3vbp]U|2;$d.ayi(]EW;~\qFrL5fpiWYٴbW r]%Je} Ѱ>>RpqhLd|<V,XܽBҵ7g{MhSV^Wdq mCQc}hw:׳Uwi endstream endobj 161 0 obj << /Type /XRef /Index [0 162] /Size 162 /W [1 3 1] /Root 159 0 R /Info 160 0 R /ID [ ] /Length 422 /Filter /FlateDecode >> stream x%ӽOQsn[+ -y ֢UQk*+j $N1!t&FWIL'Lب̂|{νiNEDbCH$)8R;K ArԺI8upQ$5A37{7a*- KpJRI-]UI\@%u p (Vaw` ]_ӶP0&a f`'B`3'*m xԦnyXE? ^;X5ê]WB`b;9KNuoRHhRX]Z$ y3YuBD endstream endobj startxref 165263 %%EOF GenomicAlignments/inst/extdata/0000755000175100017510000000000012607264575017622 5ustar00biocbuildbiocbuildGenomicAlignments/inst/extdata/sm_treated1.bam0000644000175100017510000014560212607264575022523 0ustar00biocbuildbiocbuildBC]j0`O];hnZv+VA.붻hP:/?PZI@&NHf/fJ'KB|ϻ s@w;uf7<ߣ?6boru<w jނ[4Zp܉:1 x\35J*lV ؁찄Oh!y [h{{d^ԡdJf||߮32BzΗCvn J'DcnP'[݄BCg;}{,[ZS]]U^ݧ f~$nvL`FBU`WcJB!$j5ȘQ j"FQJ`}VZUGg_[qxQ?_;_X|-&g' (uY/~ҫ֋WCV;nu %Dy;ys'|e0_xx(fLJvxݟ7t_먮3] m(6QCe ʣvG*WUY>JK:1_/Żŧ7(/6(aaxu^.Œ6z(:Qq]ooo4xA:̋0VÁnJza*ʏ`o \<;k>'f*S49F!H9,d2tkE(}<(IQ2nW۔eʫ* 8'n ޽_ɸ,KݪU9wa;(OODCUU] " hP׋~=U ]ygAAA!/}ƋꋱVվ~e^up!9}4/p$b?K#Fqa 5dAJDAW<ϔ9$$=eEK\N q^:SP:!=ng$,r=P>GoAjo4S Ŷ:7e=i,0OeUaZ(x6LӜ'lks-G^+}Uaz oQOR:R۴ 4E%~ x3z<D0@Ƭ_w4PNs ^ 0lHwz/g @0 hG=2+(0 CI,Yp`CڴAQ 8caCw%-7`>`Py]r37 =o:$$oA5r7Pwk1K{7EnD)QVn_Z.Lr%ŷ粰GQ(,6E`#Iq{Dbf)>|"ŘLtW-1t6{&$:^iK|eRČ<ڮvltUO@?)tߒMEs ry%gI&eE'+O}vJNJ4L=GF_sAǨ=`jp4LW#G8Ax3B4(3CDx`@ƾiNMȉ4D!o6LKBCE:HAqb*\4znCJ\xA)1$Ƥoɢ(pn~ #E$Q>L؉e)5lCA1[pz؄ QX &L27$xpb; 9&5( @-@f[W/W؈g!z TdA; T3I-IIj$@CQxS]ST,ǝr(8dhaY=g{ NgE8D bXXBs2sgpʐc`؉Pvj}WN6M>:܏ MQ:x8GQ;F: Y懀һ> .QGm;>i|S9I8oBT*22u(WQ!('1_1_"GM#1lOAʬss8P>)3w ShкG$:" }- '_pL3ǘk)9$QD1\)8tBסH v"FQ Q0Y4DpS]2UA}r(C C IEMU  ?;Q80 ÈrID(C Ί8GdɿW) :ɩHɩ (Ϙq`rJ1JWc<},PAEmtB1> UBPjМeN Oa, q-Cxhv큝S><,-U~GKMݚ4M:DY!:z91@P< ؞P,O(EQBUw@aQC:PDQ,|>Em:1,t>e* r) r ;jڜk^3v%CC:$4}8G|+:Aq8s(]O%s/a'y!6!'M}f`YgZ\2 X"7Dte9o͜zďYx1Hj)F|ʶ:8GӌM4`%ܶK1a[2-(BY2zcr}Pp6,û?1#1U jq4<ټG 4"o ^ΔQH(.j9~.teÍ[yd /_몚L4u:1M>kΰ/~ZNyjkKO oL@e QmBkHȡHR,d%NP؁ >'#`i\=1-0c⁡y8}ER Y^@Ӈ7t* O"^(mڗ?s9%|2*yـ F&'dچy5Pv֕?#e$͋1;g,~ebg$HAGaxxT3-]@D82+ &aY.rnĘ,Em+8-Ĵ 礸") {QupU?aPwQd21jO\L;֗BŢVa }Fq9~;2~W](~S6I5m.0b$2 Y!+ C.bY>5a&xކ ;YE'Mb( þA<Zg@8dj $:ҔU*ŀ7^y,7tYn tfp՗I+@\x XU~QrI}JL&w(Fgiq>_|;dr8 ƟM\Q  ]mR; xpzo7b ,azR,E}=Dt(饴8`hz7!ԆI`Qk& {U'<ݺuE i,:UܳPpc^FQ;(NgIX;L'dfvwH/01ԗ-%ꇙp/z6%u "xޫsdbt+.[JJD RR,xmI0 r1{wKqtaƌɪꓩѓ:.IGG`׊v}*JCW0T0Sޚ nG8¦n {C4mjuݢq#)qr vgF۝W;ǥ5kŨgI1Eq$!X/7 ^'ף3rnYC ʃR=? u"q%Y^FNaTj;)1Jw,\UDcnR߽{rw 8]5X&p"`_?Z6Y|}ֵQBc_->[Qo\m{L->Oe2]RT !euIWVX6R B{Tb"Q%um\ 'Y״(3x(.1Bh]ۑ64Wd&j -=#Lf-c ;ESU,`~{:z.!8n8,IyO1 p$o S \! q@`3A^EF tȬwQߕ@)0ļ_3NɣWmCfNX TG}9_-qE׹FEW Q!Vct_ &t]QzH1g\Y%DYt,f(8A(@r~@MVi؍V=aPھo".96ՑniXbZeͯ;$Fgρae(%4]!1-2(!2p"i|$3-^EO=)" ︿(LtX;DtY2"KrDD͘EZ1Tպ5~HufMDbhgo Q47[͙~k:D6OMhߜ߾),  0`:X*q$I}3kS+ RRsF38udJ'RHG1t'}0=h3HHd[ )\: )CNjqD<#n:N]ӵ)[\1E~_ωnSEAy E~)5ŐI1Z$$"P `xuǨ?+sV,:~֎0!6Shk7^L)R q1Dej ( j~ӿfl>ɥs)TXdq۾M 040%XGDT`.Y[E='k !5Vl|`ыkQF<5lvU j\Lt ra)qt}('U:FQ^۶Є;=݂QQ-+RQJZPΊJ,o|= Ǡ/e?"eEA&jӿB1  ?7+@1vE٢k%f{?*%' D'1g؛ ~jWP$Ea$CfV,)X8Q:C8bB.kfdIHi'(C ܂k/¼b=pފ@{8UI ֕^p7EiNE= ˲&M'( 8 F1f@l;j ~)QuUc^QfESs'P}=4'x aQ3?kfe3iaڔϣ:YM:?.%.B?D碬Ѷ5ϋe !JFh?zWblhTY C Q_U鿔IOBHbƑ(ؿ:ȏӌf}81tǘtOyYصD&0ӰMlS I"waN6qGtQ0FPi;UĘCG3JY8\~'*<|sPN="X'9z! U"3H7XVBTVNHJ0?J"3T= s8Vot&D&g oC)Qz( >TDBlhr(lVGvQ)+:ˣY2F EnS#??= ,tpP޽<]+Gid;,/rL(¹iΫo(Kd` &ȹr",B0yK,pN sWd)"W| GQ)JJNBXgo{rxo&pG-Bpl>&NM-b jPqȍǝW oz]E'EW fh۠z0>%u АMkuu'1t{.oC'b()z=%7#& |W{obl=ql.-dPGAJ.)[ לL.ვp tA@+QϺ؜[GO:\tX[/XjEqHi-e͂HN03y(tQ-ŝ1jaAI-(;؛JcҢT Z`{qخC=zZa@tLVKϗb4(P(mWg?t0Y*SVo܄H S4=Tp4Ba90IǽD#s&7567BW_"?@NT@zlA)"ɊSD91am' !dr(RP!)/@Vg&E}œ|) .b.wx dJ& G 1^ g/xq LQτ'="G*QqxM}DǭQA) IӬQ(@pc$=-H-ZO&m&氅('1K/"FfzhW>RoK߀u x\ ŗJEey'[C#]Oi0A?*eYA&AD[;[gC&e`EcRvJ6W,خKlw-$`دT<6OcX, JOahP(0!6V#%=R<+&.:x]gAXoOI" ߼Ip7&k܉gu:4&_L/E&Y3Sb4dz67`[$ox(fk$x"n7/xWbl2C* 6;8$ŕ`֒u}z[6mQri^qTGؠxMI[WT!F0-]@TA Bi9)\,MNtm4((Fv܍z@Ʀ. b`QC/W`DpgLpk:G5f=~ q(X+,<Cak61oU/M8HqEY݇:%0Bq_'gfw+@1R|cb]5)@`Eyѫ;rw#p|O⟚V^1]{եfܝG,螄 >дyr,tN e ޜ̊`awM*@'rXMvUyXQ骪ް{"&-ـ'BEZͮM*qWWUV((%4!45gO9<?oۇ(px,ԇ %Ih{~_yEntIN.DA"3OlضXsY7lsR<7l `C0;2 /0X6pf8,b6sR$*?g{'BTUWϲ?/AGOFNYfLF,(KO\.25P~6 {!E9IȺ f9WXTu=aCUl\\$W(/luE w$F-\p4A3j)s^j5w燊HĞSMQmJI|ЗP Wu`@kDQk7" O`߃ nh!7Ez͋obT`?ߍ'6A&q llP$k[JhSEJb✭s!s|q֫xc݂{R k*(ڟ8Pbp 3ǚ;2%わq(Ms3 4qvP?rEXI|̓-iu)dᙸɁ].ϱ8( ohQf@hd1~C!Ax'[$l iFP7h~rJQ$1 oʝ騆1%gLa7W<(żb4xBʕ(F>xA|krz ^BRfiT/~SQ{ ?uU϶~\1q/bTqf)Xq95j"y"F}ST"&[ fK@u`ysZ3IƣAOc*qi XhږsƨaǠI1MqXW&PkIql+ѪG`*l %5wN+)*Hs* %j~bEa&"OsXbssHHs<0*b*bPxg(>϶rixS3y6ⳍbDE G-jC5i'i0O`AtvmK̠W<&+_șv\6Y$yX =F堒}Qp>"a'AppϊiW hHiR4燱U5UB3un4U@O+>]~AY3E{xS41B03+10*RL6d1H-PDXe ]ukP-'c4@@>Ipcv=Aa<),kƪGpCsg3l̟_Z~Ląm";<\@aJ*<郔Xٶ:fֳtEuk)?x)31Ǟ5p+j?C UrsWtK3YIؕ~

lXXXXXXXؠبؤRlVlUPmHHHHHHHHHȠȨȤȢȪȦȮȩȥKGWO񷢰bbbbbb­Q*q I)iY9yŊ%u M EbbbbbbbbblkEDE$EdETE4ElEE\E _bbbbbbbbbbbbbbbb"HQPRVQUSWPTRVQUSWPTRVQ\Q\U\S\WWߊBŠ"bRҊ2r Jʊ*jZڊ:Ɗ&V6n^ފ>aQ ­Q*s KK+kk}k`Uww.FE߃v {pn#GI)iY9}+$,*&.!-'/o]/ݲ_G'g}w-oHdЭnt}7  ) ()R+(*)+2(RQVRVQTPTTTRTVTUTSTWTVUSW4P4T4R4V4Q4WRVQUSWtPQSW P T R V Q U SPTRLPLRQUSW,T,STRVQUSWlPlTlR+B;;{'gWW77wwOO//od{)b*b)b+(*)+(*)+(*)+R(R*R)(*)+2(+r(r*r)r+RQSȯ(((((hhhhhTc> ?"P1A1E1U1]1K1G1O@PHBRJFVMGq@qHqXqZqMq]qCqGqWqOq_@PHXDN^AQIYUM[7""""""""""""""""""""""""""/E^E>ߊBRҊJʊ*jZfV֊6vNΊ.^ފ>~A!aQ O¥Vcc> __XXXXXXXXXXXXXXؠQlVlQTRVQUSWPTRVQUSWPTRQUSW\P\T\R\V\S\WPTVQSW!aQ KRx+ _"@1N1C1S1K1[1G1W1O1_TL\VVlWPUW\P\T\R\V\Q\U\SRSW~ KRU(|~qɊ)iYي9yEŊ%eՊ͊}CcSӊ3s{g7wOÑ1 99)(*)VWTRQUSPTRVQUSWTPTTTRTVTQTUTSTWPTRVQUSW4P4T4RhhhhhhhhhhhhTWLPLTLRLVLQLULSLWRQUW,PQSW+B[[{{Gw/_dGb)b+*))++(r*r)+(*(*)(*)+j(j)(*)+(*)Q4V4Q4U4S4WTRVQUStRtUtSPRUS V Q U SPx( bbWW*)&(&*&)&+(?2Z8})twJ( ҝ"- -\1s5Zs=c<&{L1cl9s=yXc2+<z8qi3g=yqUk=nyϡpND'ʼnv8DNz!d,A 8 P *C _AMԅB3h 5 o tnz@O}/G `80 Fïq0 `.̃~rXk`# /a}pq8 2 7܃#x O);?9B8 D(At!$dBFY!ܐB( B0bPJAeA ԃB3h |B ݠ;|~ a( 0F( `2L0 8< rNW8Av9Gm~8A~d Y|q: \ \kpnMw.܇SxWOއÈi1ɌTFj#Hod02,FV#i2ryFAj5ōgFYQި`T4*__ՍFMQǨk7FKhg7:]nFwe6}~Əc1l 1~6F#_ߌ8c1ŘjL3~7KeJclil3v{}aq8f7Ngƿ!Hh$2IF2#Hi2RiFF#fd7rFj6EbFQΨhT2>7_ՌFMQۨo44FKbt5ݍFOc5??@c1i2~1cqxc1ɘl0"cXj76?_Nco0q8n4NƿUqݸa4nGcxf<7^/Wk1ňfD7bDFr#Hc32FN#c4J%RFiQ(oT0*_UjFuQӨm1 &FShct4:]F7` 4!Pc1g7&SwcXj,3+uzcjil7v;]nc8`2G1q8i2gKeqӸe<2O3x oD4"QF#Hj4R F~Q(f7>3J2F9Q٨b|aT5ՍzF hc5NFgk3CaHc1c7&4c1Øi2fs#Q(b5* Fhot0:F7m1c1͘n0fc1Ϙo,1ˌ*cXk3Mfcq8b5'%q׸g7Gcxf<7^/WkxgG1ьF #ˈm1F#Hl$5)Fj#Hgd22YlFv#gFaQ(i2JerFyQѨd|nT6___ՌFQϨo40F3hi2:NFg[ft7z=^wF` 4!Pc1a4FTc1Øi2sBcXj,3+*cXkl6v;]ncg7Caq8f7N'SiqѸd\7nOgsxm"1F#͈n0bF\#H`$4F2#Hi2RiF:#hd229\Fn#Q1B"FQQ(k7*ύF QӨe1MF+bt5ݍ0c1i2~1~5~3cqxc1јdL53,c1Ϙo,0~72cXi2Mfcf56q8i2Kƿq͸n0n{xl<7^o;E c5FD#وb2qxF"#Hgd1ٌ#(n1_U/F-Qh`45-F+a 0!0c1c5 Dc1٘bL5ӍLc1ۘc5BcXf4V5Zc`l46!q8j3')q8k3%qŸj\37-qx`2ow{)gD31F,#׈g7F#Hn0RF#Hod02F#e6y|FAj1 FUQݨa2juF=hh42MF3hk37ƷFn0zƏOFc1ll 7F dc1՘fL7 EbcXf,7V+UjcXol06?-Vq8g7.Keq˸m1GcoD11Fl#Hd$1ɌF*#`d1ٌF#m1FQ1 EF1Q(i2JeF9Qd|nT6_U/F}hl41Z6F;h|kt1=^wFc1gL4&)4c1Øe6sy|cXb6 Fcf3#Qq8e6 Eq׸b\3n;]xd<6/WpFx#шdD6QhFt#ӈe6qF"#Hj2itFz#ld1ٌFN#cFaQ(f7JeWFuQӨm1Fhb43Z6F[g`hd7Ì(c1k3$c1ŘjL33lc1טgn,6+`%56@pD `7 셿*܀pyv8o5މDv8ќN '׉w8AE +jYQtS䁔5蛨AD z%j@QBԠ y57j֍W5AvG :jQ\dq}5xSF ޑQKC( "| |UK Auh M)4ZAkhmvF{m1?a0 0lK`4c`$RB:H #d̐C(  C ( e,P*B%*5TPjAmuԇAch͠9 ZCh3t C ;  @C`WcaLI0f `>,a!,Ű2X+alͰ8(ppW*\pn!<^OGbAl !$$RAjH 3dP APPjPjB- u.ԃCh ͠9~vF98tg3Ǚw8rgrv;#Qs9\p.:ys: N5Sér8Ni4wZ8-N[tvqu;N wF8#QhWg3w&8y"gYrV;k:glutr;;]^gs9r;Gcqs9w.9+Usùrn;w=yNqLI #'Ȇ8A6 r Nq9'Ȁ8 9Nq;Nqq{`{'8~ 9Nqݎu`u`;'8.m?n1~й9'AX'͉rb;$NR'Idv8YN'q:ŝgN)S)Tt:_;՜N Sǩw8MN tt:9:ݜNO;{ r8?;#QhW7g3w&8)4g3Ùv:K*gYs;??m_Ngw8s9q9 EsŹ\s;7-sϹ0˄,& O~  ca0I,f s|aDX*, +*a]! '+5pC)w{}Nx/|aB4!C)qxB|!HH,$ ɄB !JH-م\B!!D ńB)PF(+ JBePUhhn-}8x&ޠ:qpO'ޛ{:q@@pS'ސ[9q@@p''z!P@((BPPD(*J %BYPA(T _ _ _ BAV&tz}OBa0\! 3,a0G+ ߅baTX&,V+UjaY"l{CapT8&N'SipS# S\x)|䑅XBl!HH,$ BF!Y"d مB.!P@((B"BQP\(!J 2BYP^ T* *BUK+PC)uzB}Ph$4MfBsZh't݅BOG+ (  Ca0JE-*& $a0M.f 9|aDX% 녍VOaC) !pD8* EpE*\n;]p_x < kA_)apBx!Q!b 8B\!HH,$ ɄB !JH- lBN![# B!!D ŅRBiPY*|)|%Tj BQ$tz B?a0T&F _$a0M.f a0O]X(V aI,l ۄ}~pP8$N gpM.n wDx*< /W›JF+" B4!K- BB!XH"$ ɅBJ!NH/d2 B6!W' !T(&|& /BMP[+ BsZh# ¯o8a0A(L 2aRX- 녍&aES& !pB8)gsypQ$\ ׅpO/< Lx.^ Nx/|>W0BX!^ D" (BT!C% DBb!J"d EB1PR(%|!T 5BmLh.Z B;[# ?? ? A`ga0L.F _a0WX , ˅Ja]%{!p\8!N =Px,< υKZx# JF D" XB\!@H($ ɅBj!I,d لB!G+ !BPX(" %Be PM!j :B]Xh):NBg;G'0P$  ÅHa0F+ Ta0]!f s"aDX!V kuzaI,lv=>ap@8( DŽ pJ8+. W5pK- Lx%ow{D" QB4!S% BB!TH&9Bn!T(, %τB)PV(/T* BPMh#:]B7C) ?? ? a0D!F _Ida0S',KJaZX# &aE*)l ap@8$GipV8'.KepU&n ;=@x-WڰB8!A(D" QhB ![#$ )TBj!VH'2B!S%BgBIPZ(# _ ՅB-Ph$4MfBsY"tz=^wBa0P$  #xa0E*Lf3Yla0WX,, ˄ aNX/l6 ap@8( ')pV8'. WkupW'<^/W[ # BD!E*Db BB_0@( Caa0JE-* Da0SX.V aN l6 [Ÿ_vaS- !pD8* ')pV8/n GcRx- F+ B$!E*Db1XBl!W' IdBr!ZH#d |B~!D9ŝNIS)TN5SérjC=i4s;-B+Fh+ BW[# ? ga0L.* $a0E* "aDX*,V 5Za^ !l  ۅNa[# CapTG8+n w{Rx%F+ B$!E*Db1XBl!PH$$IBJ!ZH# BF!8YlNv'v8y|N~S):EF܇>T|Œ N#i4s;-N+A( ? @a0[+, Ke6/aK+ )pQ$\WkupS- CTx_apBx!I,D фB!O/R B!^ ńB 3PJ T>* U/BMP[+4 BLh!Z BG+~~  a0J- Da0E&Lf3Yla0W',kuz/aS%  QpB8)n wHx,< /+Nx/|>W0BX!^ D" QBt!PH$$R iB:!A(d لB!K- BA" ńτBPI,T Մ:B]Xh"4 ͅVBkVh't]na0H,  Äa0ZUM'&)4a0W' aBX-l[?m_vapP8$GSipV8' Lx.^ w{e '"(B4!C) BB!DH&$R 4BZ!Y*drW0B8!Q$D qBB8 2D@\!$D C H !dL@v 7䁼C(E(P:ԂZB+h #to[]{ ?0a_`4 Xáz / #pq8'\pnMw.܃GSx ->~/ p"B$ Q *ĂCH) %42B& Y /PBbPJB)( | Au M:@GBw ?0  o0Da L0|X a,. {a쇃p18' p.eU w.܇Kxo'C 2D bCHI )TB: ;䀜C!P( 4P>P| ՠ:ԀPB}h 4:@g ݠ;/G Cca0 f, s`!,%VjXka 6V>8G8p N8"\p#x O))"@D! $CHY +d @!P( Š8|e,P >Pk u>4B3h v:Bg@WC ` `80 ~+c`L04RX [`+ /#pq8 p 57܆;pxO C 2;4 C<` kCK| C74yCL  C[64[C< r04OC[\ C*~ ]P8Afpх.dr _8 _8o~ppCP8 \8}OJ"AdQ!d,AU5&4f t C ;zC#aW 8`"L0ta̅y0bXKa v `셿apN7< !$dR@JH i -PB9 | _AMԅzP@Ch 4ZB;hAw=;Cg `8Q08 a u6Ff[O;a#p 8 4p.U7&܂px%7{?)@\H! $dB69 'ܐA~(@("PAq( e,P*B%*P 4f ZCh #t tnzw=~'`0 a( 0Fo0&$ S`*L0f, `1, VfA8'\kpnxW2a ( C !ąD@RH!bPACe—5TPjB- u.ԃB#h M)4ZAkhm:Agz@O@_?0`?Pa,0&$SaL0 |XBXa ,eVjX`#l?`3l'l`;쀝 v >8:܀[p])<^+x o-ᓲa ,"B$ Q *DbB, q .ăB"H I )$RB*H i -2B&((P>P B9("Tϡ2T/+5ԇA{3|BW='{ }/ a0F, s`.̃r;`'ݰ߰80p 8 g\ \p|R.ĄX@\!$ C H t2@V!B0P C JB)( e P*P@ !4B h t>00#aW &Da Li0f,sȧ;,E^8GSp?p_ :܀p n ><3x/%|| 8Y8\Kp+pu܅{pCx =|Ta!D "C ĄX@rH)!4Az!d,Av9!<A~(@("PAq( e%|>4Ch-:Ag`a4 c`"L043`̆90v. {`/ `?pq8 4,܇{I0b@L!ąx@"H)!4Az!d,Av9!7䁼C(ŠRPBy| |UK jPjBkhCo}?O`?P o0&Da*, VjXka-mCpQ8SpY8\K/\[pcxI0@v !P@= !4VA{3|B ݠ;?Aa 0F s`.̇;,ERXa v8 ,p )<^kx =|0Ax!D(At 6āCH! $dR@*H i -2Af!P*@e AMԅzP@/}?@Cg `80 ~+c`,0t3ă90|XBXa ,eVJXka=l 6 v;a=8'p xIH@T ąx Az! CQ(%3( ,P*PԂPBh14 C h 5:7-t C B?~0  CgaLI0t3ă90|XBXa ,eVJXa u6F6  `7Cp18'$p98"\pnmw @("PAq(AI( rP*@ECe_@U PjB- u.ԃAchM4ZCh =t tzBo~! L0ZX(pN)98"\/\pn-w܇'sx/5/@XQ *DbB, >$ CQ(AI( e,P*B%@UաԄZPA#h M)4@[3|B ݠ; B?~00~` 0 fBXa ,eV*X k`- 6 v. {`/ `?p8 $py\:܀[p]P JCh14 C h m:Ag.zA?` 0~0~0&Da Li0f, a,%za3l}Q8\+pu w.܃3x/%7>OjC 6$DR@JH  d,AP JC( P%|_C55&ԂPB= !4BKhm :÷B7`Ca 0F/0XaLI0Tâ0< wX`1, X `566  `7쁽pqy\+p =xO w>~R+ DbB 3dlr@N!P B!( Š8Ϡ$2PPB h m-B7='{ }/` !3 a0FH\a,% JXa-6f[Ov;a=}A8cpNY8"\p x O)<Oj BH! $RB*H i -2B& Y +dP ABa(%2PAy| |_C55.ԃ&o tnz@OB?` a0FHh~0 f au_}A8cpNI88 <\Kp'sx5  2D C ąx@BHI!$RAjHi! 2AfY!䀜@~PJgPJAi(ՠ:ԀP@=M4 ZC?~0  C`Q _7ca 0&dSāY0\a ,56Ÿ vn{CpQ8'$pp u<3x5wᓺ :Ā bC $D@RH!TB:H #d̐B>Š|%2P*C—5TPjB- u.ԃAchMVB;h#t | ]+tzB/}~0PaI04`6,ERX+`%u6& pq8'3py7'C :ĀB2H 52@F! dlr@Ny PBq(AI( rP*@EF6 \px1<^+x o->~R? DHgPJAY(s _Au5Ԇ:PA}h14:B7='{ }?O@`$_`4  `LY0\a a VX `l-Na}A8GpNi8Y8\K/\p w.܇I@T!ąx@BH! $dR@JH! t2@F Y | @A( rPP&ԂPB= !4B3h-%6A{ Co}?O@a Ca 0F/0~` q0&Da Li0fLa,ŰJXa n > pq8g8 .;x' @X!"D@\!$D C H -@V!\@^PB9("Tϡ |_C55&ԂAsh-v:@G@WݡaL)0f, s`.̃VJXa u6F`;쀝7pQ8\p nM (e,Tϡ2ԄzPBKh-:Agݡ7A0~0   a"L04 `6́0X +`%5zv;a}p8 8kpnODB41 &ĂؐA|%2PAy| |_BSh͡5CwHo0SaL0< wXKa, Vf[a=!8 G$pE_W܀p n]!<3xI C 6āx@rH)!|P B!"PAq( e2T/*| _P C 6ԅzP@ChM)4ZAkhm t CO@_` 0 f,a,E X `5v^~8 g8 <\p .ÿp5 6܁px)<^+x o->~,<x >~< p"@DQ *DbB, q ćAbHI!$RAj +d@^ bPJgPJAi(eT%4 z@OO00#`o0&Da ,ERX+a5f[aa'쁿ap N9 Uw.<^kx|EX!DH@T!ĄX@\!d,Av9!7䁼C( B+ 4ZAkh=to tnzw=G `0 a( 0F( X`2L0 `6́0"X K`),V*X k`-6&Ÿ vn{oCpQ8'$pp2 W*\pn- w.܃#x O)<^+x o->~2 p"@D! Dhb@L!ąx@BH! $dR@JH! t2B& Y!ܐA~(@(P C JB5&ԁ Z@Kh  @WAo}?O@?P#`2L0 |X+a5zap8 8p N_W\pCx />iB8 >$DR@JHi!<AB  p o0 a),V*X k`-6&[Ov;a?p.%  :܀p n ><3x/%;xIC 2DCz!drC ?PB1(%kաԄBchM_`4  `$@RH!dL@V!\@^PB1(4Ch ͠9 ZCh =tnz00F(Fï0&$ S`*L0flsa a,%rX+a[Ov;a=8cpNi8gp .ÿp57&܂p=1~0~10xaL)0 a,ERX+`%5zal`'ݰ߰80cpNI \kp=x<'[xI0"Ct1!Ć8A|H !$dR@JH! t2@fyB(AI( P/+Au5Ԇ:PA}h 4&Ash-6C7C a A0HW Xa*̀0 X `5 [`+ /;a=p!8 G(pN)8 g8 <\p . :܀p Cx oOpNx'ʼnq:ɜN];LN'tr9,a!A}ldf +>A޵2}Q탬iliB ;>}}mi`'>د^}p}pnÄC 2DhAH ! t2@F!'P B!( Š,Tϡ2T/*TP jC !4 C h v:@G@Wݡ70#`$0& `:̅;,E*X k`-6&6 6  `7쁽7p!8 G(pNi8"\pn ><'Kx w>~1 p"@D! DhbB\!$DC H!d,Av9!<A~(@("PAq JB)(e P*Ae_@UjPjBmu>4CSh͡v8}~Ώg3tF98_18g3љLq:Ӝ, sy|XBX@{Ǡ; 6V_vNa셿ap.:)N!/P AB1 `q8l1')q8g7.Ke_qոf\7n7[mq׸g7/+u k3F$#ňjD7bF2#Hk3Ff#n4ry|F~Q(dFaQ(n0FQ٨jT35F=hh42MF3hkt2:]nFwe|g|o6?c1٘jL33#Q(h2 EF13Q(m1jFuQӨe5FFchc3FWa4z}F?? 0FH `Li0flaKk`-6&[al߰ 8 4,p-x  p ?pp n]O)7Op"@DQ!DbAl !$Đ@Z P B!P(Š8Ϡ$PB9("Tϡ2| 5&ԁCSh-%{ }/0P  `}=F{1cTi=x,Xc6=x8yK=y\qSg/<^zxQ.Gd(Q=yD#G<z$H#Gri(QʣG!P@BBYP^"|!T ՅBmP_h(4̈́B A' ($Aga0\!& ӄ a0_X ., K aJX-6 ?aK-  ApX8"N 3?YpA,+\ ׄMp[+ #Tx%ow{~#D" (BT!]!b qxB|!PH,$ ɄB !JH+2LBf!U&dr9B!!D ŅBIPZ(# _UjB Dh#|+t ݅B/;{WQ, ~ #(a0V/L& Ӆ,a0O/, faUS)- GipN8/\. W5pC) Hx.ocx!Q,D фB !K- B"!DH*$ )TBj!V,d لB!K((BaPT(&J BPE# BCXh"4mvBKN^- Aga0\!F c8a0E)BaJX# &aE*)l ;=^oa_8  cqpR8%. Up]!n w=Px*<0BX!^ D" QBl!_H $ IBj!VH'2LBf!]!r PP($Eτ2BYP^ |.TU/B=Th&4Z-VBkA)z }B?a0HY*  #hW7a0V'L BaXX*V kuzaQ$)lv=^oa_8  #Qp\8!.Ke_pU&\n7[mDx*<^o D" 1B9<ףGa"E=y(QڣGy<*{TQͣG #=>qa'<8Ƿ"!b~ˆE#ޏA#F8bā"G6T"!k@D\qi":⚈k#RG>"mD9"x "gD"G<PD# E<Q8HDшb#(Q:Lce#*DTQ-FDOFt%kD>"G 1,bxĈOE<l舱/E1!bbĤ#^1+7"ގNĻ #D,X$biIJ"G~Ė">;⣈#>q `ġG"><⋈/#ND8]?_F$H""eąE\qIĥE\*"u7DqSĭwDqWD"rGPDBD(Q4XD"*FTQ#fD"G4h8iODx2uD#:Gt#WD߈"FDx*bTD<\/D1:b|ĈIS"^1-╈3"^x-bVoDnļ #E,X.bCĦ=@a{0н5 Ƹτ1s\Lc=<}Nqwqwqb睘rƸ{kƸ{hLU+c0qUb'sbZ9^iJL}^qw߈qnNw'bz: 1sF'Ɖuwos8sDĸ;~c^{Ǹ߳=~Ÿߩ<.Ÿߟ;~ObF}qr:=/cs1=bs$f1q1ctv9{>ǽWqc{>0=Wb/ƽqb:sqϝqϙ-='bs =1}Y{/Ÿ\1}VOI&q.p+~%J*jZ:ǽoM+it{~frntX"ֽqϙ,{ĺM{ĺH{ĺH{uϓX^cgRL>GǺαy+sol Z'y^ob#=?b#=?b#}.uϋXy4=7bs#vquo{|cXwuXwub+ݳb}*=qu{{c>/ź{T{cXwωubݽ&_b=%}ΉumbX&}n]K*gY샏p18| '+8 ߜ5( \p54p=d&np?<9!<!(C!(AY(TJPjA 4$C 0b ` `8`< s<10^ 0&dxë0ހ9bXKa+au6fxN {`/|'A8$| )I )$.b.+ \! \i!=d nV n;n dlrB. y!(#P@Q(Q(%PCEUԀPCh M:B' ݠ;A0`< haL)0 ^0ނxH2X+`%հ6&  . ~8(/|)8 ?B2H).. HW5p-\i}fskM{s-q5%νĹא̎\^GG{݈sAkFl^/D{}s q νĹǹq3Hqq>ǹq#g8ws8wώs8ws8wOs8ws8<}s8wύ+"TPB55&ԂPB=h 4&'4V@[htN@Wݡ^@_a A0` a0FHx F < a ` 0&d/Ttk0f ao\xޅy 0BXa ,e,VjXka f#l>lf|aa6{`/샏 pa8bcԸq/̗ʜ4_o̷9m3ߛ̏$5Lr\`!s\n0̕*s\k3MsIkҙLzd4̍&sln1sm1Ld3Msy4Ln5L~)`2æy6ELQS7)eJ21S֔3MST2MST3M S2MS3M42M69h9jS|a4'W|c5i`~4?$&If\h.2K̥2s¤2WsΤ6i&Ign0Md27&jn3;̝.sk3YLVd792M򙇠 < ( E((P JCx B9("T*PjB- uԇ ZCh =tB7='B "10^q0&x4xށy:X} {`/샏c p18g9|_ N->kUn2PJ@yOB+h m-.Aw=> S`.̃V:`3[`+l`;쀝!ݰ!8 G()|_7-|?YÓ@RH!\)B.KR .+ \ Wp \ AjHC:CF np p wp A ; 7䁼ÃP0PB1(%vz@_a A0` ao\xޅybX+a5 >p!8 G(gHCjHCZH7@zf {!<A~x CPB"P@ch N@w=!s</hc%a"L0^0`>,{VJXa u6F} ;`'|`/샏c80p çpp ~:kdH ep9\J kZRCB:CF n;N +< 7PPPJB)( e40 zv;Ca}| ~8cp@RH!\)B.K2Tp%\W5p-4n 7䁼ÃP0G0P ãPJBi(AY(TJP@55&ԂPA}hMqh͡'C3t C }0b `!0p#)O3,< "10& x^Y0F[a=YRp;w=p/Y +d rC ?<!(C!x C1(B ( 4Ǡ"TPB55&ԂPB= 5v:B' ]+tzB/ }/0B  q00#`$<ixE c`,`oC9bc|fN=ܤ6iMS7)eJ21S֔7LEST1UM5S0LmS5L}44LSifyҴ2M LO~@A00#`$<` 0&d/To0ށw!X`1, 6fxVv;C c8po[8;~z6)$[V nY!dp?<9!<A~x @A(@a(ERPcPC2TPjB- u.ԃB#h M)<O@3h-%< 5C txxFXx ކ `>,X =X+`lMn{#2p/Y dp?<9!<A~x @1( e P*AeUԀP jC >4Ch C3h-6A }/0B, C`( 0xF /8`"L0ހ7a.)\ AjHCZH7@z!7͐n[6;.{> !@N y <C!x C( Š8ԂP@Ch 4 h͡'=t :C ݠ; zC ? 0C 0 S0 g`L)2Li ̀W5 uxfa=l>l >v‡ v^p!8 G8|_7->녤.K  =dp w=p/Y +PCx B9("TPB55&ԂPB= !4&86zB/a A0` a0FHx F < hcaL)2Li L*3aox ކwaĊX `=lMއ-vNvn{a|'Y/&n[6;.{>Y!dp?<9!<A~x CPB"PAqxJ@I( <e P *C ՠ:ԀP jC >4Ch  C h OB+h =!` `8<`"L06. {`/샏c80p ×SpI!9 B.K2Tp%\W5p-\! t2p n;.B y / BPJCx B9(ՠ)$tAw=>A!ba 8Ca 0+0f̄Y:olo\xޅy"X =X+a5v;C{~B2H)H ¥p\W@*Ԑn2͐rrAn < ( E P@UաԄZPA}h tnz&̆9̅w`|Xa=?OgMp9\ Wp \ AjHCZH7@z!7͐n!<a(@a(EGPP*C ՠ:ԀP jC >4Ch  C h OB+h m-:B' ]+tzB/ }/0B  q00#`$<ixyx^0K0&$ Se 3Uxfx ކ̃rX+a5zala lml>]^ pa8GOsgArHp \J Ԑn2B& 2]p7dlr\@^CPB"PAqxJ@I( <e"TjPjB- u.ԃAh ; zC ` X!Pa`<` ,xބ0ޅya ,eVZXalMއ-vNvn{a|'A8GY 2@FP V q0FHx F < a ` 0&Ttx f,xހ7a6́m 0!X`1, ރV*X k`-6&  ;`'|{`/샏c80p ç|_pN | 4|#t$ C R…p\ p\J dLp#7Cf{ 7P0G0PJAi 5&ԂPB= !4t.C}a ̄Y:ola ,e,VjXka 6fxV8#gMwp 9a(u>4$6CW aL5 <z aa쁽>#pqNIo{~ΚB2H)H ep9\J kZn,Av @^0bPP JCx B9("TPB55&ԂPB=hMqh-%< 5C3 zC ? 0` 0^q0&Da SUx fbXKaaհ`3[`+|#80p ç|_p5?5)\ ! \i!!dLpwp0"PJB)( e1ԅzP@Ch ~@X!Pa`2La*LW`:̀W5 uxބ0ނa. VjXka 6f. {c80p | '$| 4|#t$ArH@J.+ \ Wp-\! \i!!dLp#n;.B>E(P*AeUTPjAmuԇAchMqxAsh-Ih vC 710C a0FHx xF /8`"L0^0 ^0f s=X#|_pp;kJ2H)H p 2Afnv{ < !44ZBh =t :Ca00#`$<ixyx^0K0`2La*LW`: L&̆9 sxA<$|X`1,񬗓.b. Hp4p=t2p A ; 7䁼ÃP0G0P ãPJB)( e1( /K8_Io{~ΚB2H)H Ep1\ep9\J kZRCB:Cf pwp }B69~xrB. y / PJcPAyT*PA ԅz8<͠:Ag]B  a`40&0tk0f ao\xޅy 0BXa +`%հ:X`#l>l >>]A8 GO3/| p NJ.. HWUp5\ ! \i!!dLp#7Cfnv^~(B ( 4Ǡ,P*B% U*TPjB- u>4F@SxfZ@{t.zAox` ` 0& L0f ao\xޅy 0BXa ,e_ 5Lp#7Cfnvn dܐP CI(AY( TjP@CxZAkhm:Ag]tzAo}a 0FS0 08SaL$|X`1,u >8 _INw=?Og͸@y!<a(@a(E< %4P*A5xZAkhm`bPPJAi(AY(TJP@u5Ԇ:Ash3t zC_a A0` a0FHx F < a 0BXa ,eV;aOS 5|)8}k 9 rC (:ԅzP@Ch 4 @;3tnz@O}AC`(I0X=X+`%հ:X`#lͰvn8'4|wdR.b.rR5p-\! \i! #7͐n,A~x PBq( TP C 4F@SxfZ@KxZAkh =t :C ݠ; q0p#)c%aLI00+0f̄Y:o  X `=l V{`/| 8G|_)8}֬.p!\%p)\Jn,A!| <(P JCx B9("TPB55&ԂPB=h#tz@O~@!0O( c`, 0&d/TtLÛ0ނa.B<$|X a,%{VJXa u^8'Ni৳^OIbRp\ p4p=tp 2p pwp pd C 7䁼 @(š4Ǡ,TJPB55&ԂPB= !44Z“ ZCh =t :C ݠ; zC ? 0C 0 Hx F < `"Li L*3 < `!,Ű{V*|ߟFHWUp5tp 2p n^A)uԇAchM%< #t0^7M smx!"X Ka9|ߟf]aN"H񉔐Hiq"-I E̹0%:Ԑnf96ùӹ+9sx PsGuSy>9;sXhMZhCv0Ю@ 7':`C:hc< t"@6Щ@}0o]@W&P@i]@e1P@7@Ye =P@z P@y T8P@E T*P@UT1P@UU T=P@T7P@5 xfju6j}g^z_ 4$а@42SFz.@/hRɁ^ Zfz#Л(!@ - 8В@K-Ў@; ;О@{}Hまt"WN:7 }S(%. tY te]@i tCLn tO{(K(W< *X T"P@ T6P@UT'P@5 (P@M5 xZj@ >P@u%P@ 40PL@C=@/@4!Ф@M rz%@3hNhnwh^@ Zhq%ZhUՁZhCh[m#@{ qO t8Б@G t<Ч> y/UN:@1Oa& ,R0E. tET tuk](mtn1P@79P@5m @D.)h1M SN_3Љu9ÜH)g3Lr&;o8Yu9}&>uU,wV:\b0}unr6;;\{{<׽uYt>tv9==fg ]⽓4@8.K+D.R'RD>&RDʐH)S"ݘH7} [r?r O(Hx4@P)@UT P=@5 P;@ @4dVs.z`@b`p!F$s|"K 49^N4-'ҌDHo&DH)>iA",Lʼn*$DؐDؒ[a["lOv`o}> q8p#8_.n) pQ\WH } n9- %@d#r o|x0 (h P6@T P)@54$@m >@t%@= 71b 0"O่#^x1bxgƄ1gLsqxfìsxf[9`^ X`IeVX`u 6`[v0 7|_* p:~cK)\4e p]1@7)2%n p{;w' %@9 ? x(@D*%l"ONDx2Z%BDk"H+$BD1ap"%°D#aT"<$³\"</=F%go&DLt&ɿ`J"H뜍<}>sCϗ;p7}.>C9HgysJ|'>'wR8CLǻv|*J*'Ih{/޷Żc}V{Ļ0=D{o^:5:>^j{uk\{/<u9"޽ėv89_ΩTq:՜N i4wZ8ig|qN?݃=&C=":*ĻߋxwxwϽx\wϳxwϡxwσxOu^q;3Wל7m'Y,t8KergqυMf}='s"=!#cs9E =?x)IHpσy3=[$ }{c'== Npu{{|{|{Î{cPqw{uc'8''8Sqs{:N3= Op}B^Wq Op}{ Lpq 5,=s a 9'>= Op}{$= i{c0qq[{|:&5= qMX6a~cۄ&6_ Yp)\Ԑn2Af{^@V!@N!| @q( AY(2TC h OB+h m-t0]L7ݸ{#)OóLi L* o;a,ERX+`%}p§|_pN7p Nw=tւ.p9+j \7@z7Afn;.{>9!7䁼P C( Š8TPAu56ԁ@SxV:Agݠ;@?` @, C`( 0gxF /8`L)2Li L*3aol `!,ŰZXalm>]^ 쇃p8 o&  5!-d 2p'}rB.a(Š8< %$ P *CUա4&'%< =tzB/ ?  q00#`$<</Xx xaL)2Li L*M s-x;.̃xXa ,e,VZX`+l`;쀝!ݰ>A8S| p ~:kQH \@jHCZC& '䂼 "PC9("TPBh M)<O@3h-5B7='B?10FHs</hc%aLI00^0^0 ^7`6́w=X+`6&  ;`'샏`?pp~:kqRH) %\p\BZH!d&2-p+w]p/<PǠ:ԀP jC 1<? x g9x^a40&Tt&̆9 sa1,`9հ:X`l->]GpQ5ᇳ$dR.+*Ԑ2­p; @ ~xrB.(C!x C(Q(%2rP*@M9 ZCh t.Aw }/0 !0S0 q0&k0[ `>,X ` u6 . {`/pa8_p5|©&p ".KrRp5\CZH!3]p7Y +d < P@i(AY(ՠ14ǡ4 ZCh =t :CW=71 `0 `80 gYx`40 &x4x x^0 ^7-a,ERXa%հ6&a섽>0 ~᧳% R.bRڴsΤ6i{ZvIo2&dn6-Vsa4w=^sbl&a7&m&o4Cy2¦)jQS”4LiS5|o~&InR LJs\l.1+L*sʤ6i&Igқ fsmrMN6yL^O`?p18%$| p ~8kep9\WCjHC: n[N {>Y!@.x @A( B ( rP*@EԄCSh-Aw=0C `< s<0t&ڻ½p^½pr{\{+V:Վ{\^'W ½pW+>K8 >^W׿oeR$7)LJs\l.5W5ZƤ37[̭6scl&arzSqJw_X+Jw_~W3 LC45'L3´2Mִ3Mt7=L/1Sfyd3Mn5L~)`2uM=S40 inZbnaz^o&Ěfj(y3_/ s|m7?O&Ij}^>[I$Z|m*7ֺ~mA)bbyԔ0L%S40L3Ě& 1C0yflP3܌0fgB,6K2YnVfYm֘f`6Mfyl1[6q~ ֻzwX~׻9=zwֻ~{M9:<9*PCsxZCshsm=yѣGg.]=ytӣGo>G?f1cG<{0#=bi3ݼj昷f7 fYlfjNm}#0as7ڜ2ߙO1Ij M*sd27&a&m&o4S1EM1SCDLj="zFcG C=Fx<8<&zL1c <^x-=z=x 1E/yxm ={,XcJM=x8qǧy|qi<~4?֤&+[{V^cUՎ{:B:Mp3d[6{> ;AgYx^%aLi0^0 ^7`|X a,% X `5 66;a=| 80pNWp~:k[H@J..j 2@Fmp;wpd rC~x #(PAyԂF@SxAshm#tBOa( Q4a q0&x f,xހ9 `>,ERXrX}v . #p|)GArHep%\ 2@F7-p+p'w=p/Y +dp?<9!<A~x BQ(š$P*@Eՠ:ԀPAcxAKxZC ? 0Hx g`40&Da L`&olo\XK=X k`=l 6v p >NiI )$p .+ \2p3d;.=z{ ; 7=x(G <G4x£Gsnw#G_5ISSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSS?oOߣEN1rYޕpJ3Vy Gn?~g]jWծv]jWծv]jWծv]jWnig}k_jG;юv5K^(n~_ծv]jWծv]jWծv]jWծv]jWծv]jWծv]]iO{Ӟ=iO{vڝٯ|(թSN:uԩSN:uԩSNZwG:uԩSN:uԩSN:un9'uԩSN:uԩSN:uԩSN:u?ߙZ4NZ's?3ߣ;s}f퓜"""""Gh9 G8|.qk癯{tr<\98ϗ:uԩSN:u;R" """"ts;=gn9=["Z}&Ff'ssu3g?~չus\:y3 fO7fnܮ;Yg3=s>}ykܥo5cA웃̹ss~{5veeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeek'3CYn45:ÜgzCKϷz_p}իW^zիW^zիW^zիW3|իW^zիW^zիWM/]~v.کuȟ3γb"׺Y9۟(ùyɩ^zիW^zիW^zիW^zիW^zիW^zիW^zիW^zիW^zի>o~η+իW=ܟ-5ʿoyN?3իW^zիW^zիW^zիW^zիW^zիW^zիW^zիW^zիW^zիW^zիW^zիW^zիW^zիW^zիW^zիW^zիW^zիW^zիW^zիW^zիW^zի;3\9yeeeee?)?sgCYYYYYYYCL/ѯoc|/1ʿKk]Z׺ֵuk]Z׺ֵuk]Z׺ֵuk]7]T+յuk]Z׺ֵuk]Z׺ֵuk]Z׺ֵuk]Z׺ֵuk]Z׺ֵuk]Z׺ֵuk]Z׺ֵ׿% z>~o4s:VC~js;~Dg3WI| eeeeeeeee?1Դyzg<<#=tv 98թSNOWs|SN:uԩSN:uԩSN:uԩSN:uԩSN:uԩSN:uԩSN:uԩSN:uԩSN:uԩSN:uԩSN:uԩSN:uԩSN:uԩSN:uԩSN:uԩ;GkoZq> թSN:uL.3`3=-qsZ׺ֵuk]Z׺ֵuk]Z׺ֵuk]Z׺ֵu?:eeeeeeeeeeeeeeߐ}=jr9_5ǩsYjUTr*{8UիW^zիW^zիW^zիWԩ{t۽CzM:uԩSN:uԩSN:uԩSN:uԩSN:uԩSN:uԩSN:uԩSN:uԩSN:uԩSN:uԩSN:uԩSN:uԩu]pk]Z׺ֵuk]Z׺ֵuk]Z׺?2??k<_쪉_Sé瑚otf+++++c5~g|4͟{<~~S0wߡO_krj;uN=i4rkO{i}k_׾}k_׾ϻ}hG;fn{e]bsmu~f?K9ofܢ68WN׾}k_׾}k_׾}k_׾}k_׾}k_׾}k_׾}L$^sǝ'fNsyiv8m^ծv]jWo{vuO;]jWծv]jW{>Vq=ϧdz҇j7&gߨksFH$IIR$T7jѨeҍkX]=LZRRI#g7I9Azm&IJ)?ޮmdV4פ\5hd3? w!GenomicAlignments/vignettes/precomputed_results/U1.sbcompHITSb.rda0000644000175100017510000043240012607264575026427 0ustar00biocbuildbiocbuilduW?tw KHwww HwwwJ "%(*t"`<;5ژ=3;:Vo]4ab/Nq;C_I[)4s֮ӼYŊ_O$4Q1gIž]_%2sn] zvCf`@` 2_&0?Â?^/EaXWò?VaX6obcCl =;!vbW=!7ć!8pOB|Hc!8dS!N8ls!·,CMoC ]C q;ĝ?BSCB< (o!~gB<w'"Nx!H"igB 9DYCd ;DB Q8s!(dR!ʄ(J!V:!hU!ڄh]CtB^!zb`!bD!Ƈbri!XbaB, &!6bs-!x;ĶC A!> q4ıCq2C\ eB\ q=č߇wC^!xxOob"N!x*DB$"DB 6DCd =D9C ;DyC<"_!BQ0DC<H!(D!J(\!*Jj!V!ꄨ^!hIf!he!:g!_!bP!bX!Fbt1!ƅbr)!bfY!fb~!^,XbeU!6ĺCbcM!6bkC3Į{C|b!8pOB q"Bq>ĥC\ E!߆߇/C["nx! t!HB&DCd%DBd#DB'ij! (tr!ʇbJ!z!hQ6!چBt%DBt'DB 12cB 15B 1/ B, RC, 8ĒKC, <ī!VXbUC&!ֆXbCBl 9Ė[Cl =;!vbW! ~B aB|`C!8XS!N8ls!·,ą_&?~CAG!~ Go"N!x:D B$ (DIB<"eT!RH"mt!r@! x.DeC Q>DBTQ%DBTQ#DBQ/D C4 8DMC4 ě!6bgB ?āC i#!8x!·jB\ MoC }[!~q/?%ģ!bx:DC$ `_#8'X#8NEp:|DeW#*܈nF]Gp+܉~#3";"xߢ+ADt #HAD4 U#HAE>d sY#ArG/JFP*B#ADP5jԉA"hAE<m"x>tc"AG#^O"&D0%iL`V#G E,`E+#X6F)l`[#E?P#$O#8NDp2Sl"8g\DMFp3;~~QDEW+ĉ n"x*$ I#A2E9,d ["AT"(A G\E"(AFP. TJ"AFP/eG>NtK]#AD0 `b"F0-̈^`QK#x-l`s#x'D~D7#8Ep8O"8NEp:3|_Fp5"fEp'#F("=?"3"xߢ+KAE4 C#AD/PE"(AGP"R#AjGP'4Q#hAG"V]#AG#w}"AD0$ `Lc#&E09)L`Z3"E KG4W"X^`uk"x#bC!6bK!-bW!> qc!N8t!> q!!.r+!e![c!8dS!N8ls|BC\ q%k\F_GMFp3"~ESDk"x~G7"x:$ Q#HAB%DV8D)/ҿT*R_K/5C Q/D B4 (DMB4 ,D-B *DmB .!ڇcB3Ġ#B 1*ĘcC1!BL1%B13ĬC 1/Ă C,J!VXb}!6bg]! ;{!0G!>/B q(4ıC q*C\q1WB|jw1Gݗ~;/Ѣ7\,G #hŎ/Z-3EѢie)Zh٣V_JK)/e쿔R_*K/UTR_jKi/S#AzE;#D06q`j"fF0+̉`n #x9E,`I"X`eG:5`]["l`{D#vG^{"|xLl\|">[܎N?Dp?"9_#-?"x!b"N!x:D@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@KK^  x=:&F`m`]`};> |(q`_`@`Pp#c+[~ < /T a I i@@@@@@@@@@@@@@@@@T@Pp@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@/^ , ,XXXx-z`u`M[Ḿ-{>     |&p3p+p;p'kAQ<qqORRRR22 D   JJJ****jjjZZZZ:zzzFF&&VV^ Xx'+n`wG}CÁ#_ \ |!p7p/p?S߁q IIRRRR2222 D  JJ****jjZZZtt t tt    L L LL L XXXx;#3+n`w>   \ |%kQHHHHHHH(((((((((hhhhhhhhhhhhhhXXx+#aPp q_|nGxzňHHHHtȈLȂȅȏ(((R(JڨzhhfhhVh6h聞>AIxK ˱k۰`v=|8Op4pGD!FQC EyT@TE5@MBmA]C=sGw6 Ѣ\.?zhYn?-叞^,, l x'+^`OcSO <HHHHHHHHHHHHHx6/?((((x.P$P4P,PP!P1P),GEAQѽ"h9 Q7JTtATt'Q *:QѹQ@hh;1*zF-zF>ڛ6D )h[mGEŨGE?*:Q~T|GEg;*:Q{0hw}TxTtѢGEg:*:QY-ߢ.E-zE}-:Q7CTOQ{)*zEEu/Zto)Zz-zDE@~|v<rp] Mj^ZT<NLJ\D<B((򨀊ʨꨁZ:zhFh&hfhhVh6hvx:3+;z'z7/?` a0`(a8F`$Fa4`,a<&`"&a2`*a:f`&fa6`.a>`!^KxK`UJkxo`-a=؄؊v`v=؋>>!'Gpp'ppgpp>E\e\W:nk|oqn~]{3~xx; 7)F,FE<< I !9R %R!5 #2"2# "#r"r#YC~D  9AQCq@IBiAYCyT@ETBeTAUTCu@MBmA]C}4@C4Bc4AS4Cs@KBkA[h ] = }111C1 1#1 1c111 1S1 131 1s1 "^XXx˰bVb^jXuX7oa#6a3`+a;.؃C|qq >1 )9gqpWU|k[wpwG} ~<#_xĈj1b!6 .)>^|1a? 0>888888 9.. p q_|n~]{3~xx; 7,F,FE<< I #R"R# "#2"2# "#r"r#YC~D  9AQCq@IBiAYCyT@ETBeTAUTCu@MBmA]C}4@C4Bc4AS4Cs@KBkA[h ] = }111C1 1#1 1c111 1S1 131 1s1 "^XXx˰bVb^X5xk&6-l&ll؆x;.v={>>!'Gpp'ppgpp>E\e\W:nk|oq{q?g_w?o'1kXX8xx O#> !!1 )A2$G D*FE:GdD&dFdE6dGD.FųȇBD!s((((((򨀊jڨhFh&hfhhVh6hvx:3+;z'z7?` F`$Fa4bc&b2`*a&fa6`.a>`)^2,ǫXX:Vc Zz x [ocv`n=x`/>GpSQqIi9gqpWU|k[wpwG} ~<#_xĈ1b#"ӈHDH$Hg ɑ) i Y ّ9 y,!?PQ(8J$J4ʠ,ʡ<*"*2*jj ZZ ڢG{t@G肮聞胾񘀉ɘ阉ex+^jXuX7oa#6a3`+6l;؁؅wa؋>>!'Gpp'ppgpp>E\e\W:nk|oq{mq~/~1?x#Ĉ؈4#"# $Cr@JBjAZCzd@FdBfdAVdCv@NBnA^<|ȏ(@ABa<"(b((R(2(r( J*jڨhhhhhhhh/: zz?` a0`(a8F`$Fa4`,a<&`"&a2`*a:f`&fa6`.a>`!^KxK`UJkxo`-a=؄؂x۰`vbn=x{1 0>888888 9.2 | p75=n6ŏ ?xG <]bBlA\Sx I !9R %R!5 -!=2 #2!3 +!;r 'r!7 /E>G 0CE1G D)FE9GTD%TFTE5TG D-FE=G4D#4F4E34G D+FE;<耎x]=}00C00#00c0000S00300s00 /%EX%XW *V`%V5X7obFlflVm؎w; b7#|}؏8C8Opq'q qgq.s\%\|/q_77-p?g_w?o'1+VX8xx O#> !!1Ar@JBjAZCzd@FdBfdAVdCv@NBnA^<|ȏ(@ABa<"(b((R(2(r( J*jZ:zhFh&hfhhVh6hvx:3+;z'z7/?` a0`(a8F`$Fa bc&b&c bcfbfcbcEK a9^ *ױkb؄؂x۰`vbn=x{!>؇88NN 3\縈K+_*5\ |o-n;|[;w#>~~ 7)F,FE<< I #R"R# "#2"2# "#r"r#YC~D  9AQCq@IBiAYCyT@ETBeTAUTCu@MBmA]C}4@C4Bc4AS4Cs@KBkA[h ] = }1111#1 1c111 S031 1s1 "^XXx˰bVb^X5xk&6-l&ll؆x;.v={!>؇88NN 3\縈K+_*5\ |o-n;|[;w#>~~/`!^KxK`UJkxo`-a=؄؂x۰`vbn=x`/>GppSQqIiYy| q q_K\W븁 M|q q?.~=OW!1)9Z%Z5ڠ-yGt 肮聞胾񘀉ɘ阁٘Xx/e,b,ReXW+ uXx6b6c mlv؉]x}|c~Aa|OqGq q'q qgq>E\e\W:nk|oq{m]{3~xx; 7)F,FE<$Cr@JBjAZCzd@FdBfdAVdCv@NBnA~Ba<"(b((R(2(r( J*jZ:zhFh&hfhhVh6hvx:3+;z'z7/?` a0`(a8F`$Fa4`,a<&`"&a2`*a:f`&fa6`.a>`!^KxK`UJkxo`-a=؄؂x۰`vbnC|qq >1 )Y縈K+_*5\ |o-n;|۸p?'_+!7?'c$Ft qOiG$D"$F$3HHHHHȀȄȂȆȁȅȃxQ((xEPP%PPePPPPUPP5PPuPP M-m<ڣ:tBgtAWtCw@OBoE?  0 (LdLTLt,:Ǜ؀ ۰`vbn|8 cM\ȃA!aQ1q I)iY9yX^",,+Xx+^jXuX7oa#6a3`+6؉]x}|cAa|OqGq q'qWU|k[wq~?1G"$F$3HTHLȁgQEP QeP] 00C00#1c000S0030s00 /%EX%XW *V`%V5X7obFlflVm؁؅x`/>GppSQqIiYy| q q_K\W븁 M|q q?.~=OW !!1 )A2$G D*FE:GdD&dFdE6dGNBnA^<|ȏ(@ABaE1G D)FT@eTAUTCu@MBmA]C}4@C4Bc4AS4CsF[<耎x]=}0C1 11000S00300s00 /%EX%XW *V`%V5X76a3`+6l;؁؅wa؋~C|ppSQqIi9gqWU|븁o--p?g_w?o'1DX8xx O#>"#)A2$G D*FE:GdD&dFdE6dGD.FųȇBD!s(((R(2(r(hhhhhhn聞>!Q񘎙2UױkbMl[؈M،-؊ v`'v]{؃C|qq >1 )9gqpWU|k[wqw#>~w?X8xx O#> !!1 )A2$G D*FE:GdD&dFdE6dGD.FųȇBD!s(((((( *ꨉڨhhh/3z7/?` a0`(a8F`$Fa4`,a<&`"&a2`*a:f`&fa6`.a>`!^KxK`UJkxo`-MlFlflVm؎w; b7>>!'Gpp'ppgpp>E\e\Wq q?w?o'1A\Sx I #R!52 #2# "#r"r#YC~D  9EqE9GTD%TFTE5TG D-FE=G4D#4ASD+FE;<耎肮聞胾񘀉ɘ阁٘X`UJkxpp8FdHHTH4ȀȄȎȉxQQ%QPQ =}0#011/bc l=pGpqpq _+\]G#FXHHHx)Y QQePUM - mϣ=:#^@'tFtE7tGD/FE?  0 (8L$LL4L ,<,ċx /cc bUJkxob9xG1?DH$Hg ɑi ϡJJ ʡ<* :>1ZL0#130c~1j><ȋg(B(PEQ Q%Q QeQQQ QUQ Q5Q QuQ M - mϣ=:#^@'tFtE7tGD/FE?  0 (XxL$LL4L l<,ċx /c`)^2,ǫXx c5`-a=6`#6a3`+vN»؍`/>>a|#8c8838s8pq q_K\W븁-n;m{_+!7?'c$F  qOiG$D"$F$3HHHHHȀȄȂȆȁȅȃxQ((xEPP%PPePPPPUPP5PPuPP M-m<ڣ::+;z'z7/cbcbcFb`,a<&`"&c*a:f`fcbcE v`'v]{؃C|p)N4,3\縈K+_*5\ |o-n;|[;w#>~~/<ObDqF|$@B$Bb$AR!1)9Z%Z5ڠ-yGt 肮聞胾񘀉ɘ阁٘X^",,2, *ױkb6` va>~Ƨ838|{؇884>E\ 3HȀȄȂȆȁȅȃxQ((xEPP%PPePPQ QUQ 5PP M m:3z7/cb0bcFb4c" _bOHHxɐ)131 1s1 Uj|}؏8C8O)(8N$N4,> a&fa b9^j[؄-؏sc4,2hYe8Q!Zlx2cc ,rXUxk[ v`7؇8CGpq?hyP-koa'v#1iOxiBEvDaD9TF D]4FoXu،-؊ v]|Gp'p6~xbDWq R"=2 "#' ?P QUQ uP m = }111C1 1#1c00010s0/e,,2x c5 z؂v`vc/>؏8(8N>縈K/%+\ |oqp?>O;Fi#iG$D"$FR$Cr@JFZGVE>GA<"((R(2(*ڨh&hhVhvx ] 0C010c01S11/b ^rXuxoa#6a+6lĻ؍= >q)y|qpW56~}_/$F+#b#"HHHTHHȈȎȅȃxQ((xEPP%PPePPPPUPP5PPuPP M- ϣ=:#^@gtAWtCw@OF_ ` P pHhXxLDLdLTLtLl\|,B2a1`)^rXUx c5 :؂xvbn#|88(N$N4,<>|˸/%+\u&۸p?'_+!7?'“-c!6"H$xɐ)i Y ّ9 y,!?PQ(8J$J4ʠ,ʡ<*"*2*:j&j6.>!1)9Z%Z5ڠ-yGt 肮聞胾񘀉ɘ阁٘Xx/e,b,ReXW+ uXx6b6c mlv؉]x}|c~Aa|#8c88S838s8p".2 | p75M|q q?.~=/;_xĈ^1b!6 .)>^|1a? 0>888888 9.. p q_|n~]{3~xx; 7ѫ*F,FE<< I #R"R# "#2"2# "#r"r#YC~D  9AQCq@IBiAYCyT@ETBeTAUTCu@MBmA]C}4@C4Bc4AS4Cs@KBkA[h ] = }111C1 1#1 1c111 1S1 131 1s1 "^XXx˰bVb^X5xk&6-l&ll؆x;.v={!>؇88NN 3\縈K+_*5\ |o-n;|[;w#>~~/<ObDqF|$@B$Bb$AR`!^eXW+ uXx6b6c bc}GpqS1Iy\縈K/%+\uG1BlA\Sx I !9R %R!5 -!=2 #2!3 +!;r 'r!7 /E>G 0CE1G D)FEyT@ETBeTEu@-F]C}4@C4AS4Cs@KBkA;G'tAwA_C @ ` P pHhXxLDLLtLl\|,B2a1`)^2,ǫXX:V :l&ll؆x;.~qY\|/q_77n~]{3!w?b!"# $Cr@JBjAZCzd@FdBfdAVdCD.sHB!@IBiLdL,*xk1FhqY9x&Vi9gqn9U1a7!7?' .#08ʢFa)^2:y| q q_K\W븁-۸q?xē/q4!#R" "2"7c`.a>^[ ۱a؋>>!'Gpp'ppgpp>E\e\븁 M|۸p?'Sr@*FE:GdD&dFdCv@NBn<|ȏ(D BB}@+ «XX7 ;.؇qgC,A|$BbDdDs(ppGp=] 9Cq@IBiA9T@ETG D-FE}4@C4E'D@hLjSHDH$Hg ɑ) i ّ9y, J ʢʣ** jj ZZ ڢG{t@GN.n^>~A!aQ1q I)iY9yX^",,+Xx+ uXx  [6a/SQqIiYy| q q_K\W[wpp?g~A!aQ1q I)iY9yX^",,+Xx+^jXuX7oa#6a3`+6l;؁؅wa؋>>!'Gpp'ppgpp>E\e\W:nk|oq{mq~/~1?xG,FE<< I #R"R# "#2"2# "#r"r#YC~D  9AQCq@IBiAYCyT@ETBeTAUTCu@MBmA]C}4@C4Bc4AS4Cs@KBkA[h] = }10C0 10c010S00300s0 K Va'|CU;w#>~~/<ObDn1b!6 .)~A!aQ1q I)iY9yX^",,+Xx+^jXux6b6c ml;؁؅wa؋>>Aa|OqGq q'q qgq.s\%\|/:nw۸pp?g_~1?x#z=ň؈4#"# $Cr@JBjAZCzd@&dFdE6dGD.FųȇBD!s((((2(r*jZ:zhFh&hhhhvx:3+;z'z7/?` cbcFbFc bc&b&c bcfbfcbcEK`UJkxo`-a=؄؂x۰;.v=؋>>!|OqGq q'q qgq_{{ ?G 0CE1G D)FEyT@ETBeTAUTCu@MBmA]C}4@C4Bc4AS4Cs@KBkA[h ] = 111C1 10S00s1/b a^j؀[b7LJ؇88S8˸; ?~x q ) ّQ(((J*hFh&hfhhVh6hvx:3+;z'z7/?` a0`(a8F`$Fa4bc&b&c*a:fbfcbc^"eXUX5؀>~I\E\U\׸{ !/<Ɠb# !9R"=2 3#r#/# PPϡ)9Z%Z5ڠ-yGt 莞>~菡Xx=iYe\uZXx ɑ)ِ EQ QuQ M : 'zbcbF`$Fa4bcafcb)aN,n{c@dA.CAB1TFTE5@}FN.n^>~A!aQ1q I)iY9yX^",,+XXױo`-a=؄؂x۰`vbn=x`/>Gqq >1 )9gqpWU|k M|q?.~=Iu#)$@B$F$ErBE:G6@NBnA^<|ȏ(@ABa<"(b((R(2(r( J*jZ:zhFh&hhVh6h+;zz/ab0`(a$Fa4`,a&bbf`&fa6`.e,b,ReXWc b=6a 6l;؁؅waAƧ88s8 ˸/n6ŏ ?xG <}*ƈ8) i y,!?PQ(8J$J4ʠ,ʡ<*"*2*:j&j6.>!1)9Z%Z5ڠ-yGt 肮聞胾񘀉ɘ阁٘Xx/e,b,ReXW+ uXx6b6c mlv؉]x}|c~Aa|OqGq q'q gp.s\%\|/q_77n6~]{3~xx; 7&F,FHDH$Hg ɑ) yb(2(JzhhVhnAYx+ob#6a3`+6l;؁؅wa؋>>!'Gpp'ppgpp>E\e\5q qw#>~~/<ObDB1b!6 .)!1)9Z%Z5ڠ-yG肮>~񘀉)i9yX2l51>DHȉ\ȍgQ((b(((򨀊ʨꨁڨhhhhhhh/: zzca0`8FbFc bc&b&c bcfbfcbcEXWb^uX7oa#`xŇ؇88Oqp'pgq.s\%\|/q_77-p?g_w?o'1]X8xx O#> !!1 )A2$G D*FE:GdD&dFdE6dGD.FųȇBD!s((((((򨀊ʨꨁڨhhhhhhhh/: zzcbcbcFb4`,c"&c bcfbfcbc!^",,JZ x  [6a;.x{>>^|1 S縎[wpwG} ~<#_xĈ)1b!6 .)~A!aQ1q I)iY9yX^",,+Xx+^jXuX7oa#6a3`+6l;؁؅wa؋>>!'8c88S838s 9.. p q_|n~3~xx; 7k"F,FE<!1)9Z%Z ڢ;z'z7/aa0aFa aa1V .I #R"R# "#2"2# "#r"r#YC~D  9AQCq@IBiAYCyT@ETBeTAmE=G4D E/F ` z x  [6a;.x{>>^|pGp 'pq.s\e| 5M|q qw#>~7Ĉ^s1b#HDH$Hg ɑ) ِ9yQ((xEPP%PPePPPPUPP5PPuPP M-m<ڣ:tBgtAwD/FE @  p(XxLDLdLTLtLl|,BK a9Vb^X5Xx6bmlv؅x{>>^|88NN 3\縈/nѯj QPePPPPUPP5PPuPP M-+a a8F`$Fa bc&a*f`cEEXxc5Zl&lv؅w>؇88NN 3\縈K+_*5\ |o-n;|[;w#>~~/qX؃'p q_*5\ |o-n;|[;w#>~~ O!$C*FdB@^D 8J$J ʢ*2j>1)9Z5ڠ=:tA7@OBo  0DL<,BXXXװko-l6lN|{ŏ'1&BBfdCv@.E4ʠ&:37c(a8F`$Fa4`,a<&`"&a2`*a:f`&fa6bcc ,rXUx c5 :Ǜ؀[ocNn! NN,<.s\%\W7-p?x; 7c'F,FE<< I 9R  -!=2 #2!3 +!;r 'r!7 /! QEP %PPePPPPUP5PuQ -mϣ3/?` a0`(a8F`$Fa4b&b2a.^",kX ؄؆w`.2u|op qw#'_+!7?'c$FtU qOiG$D"$F$3HHHHHȀȄȂȆȁȅȃxQ((xEPP%PPePPPPUPP5PPuPP M-m<ڣ:tBgtAWtCw@OBoA_C @ ` P pHhXxLDLdLTLtLl\|,B2a1`)^2,ǫXX:Vc Zz x  [6a;.x{>>^|1a? 0>888888 9.. p q_|n~]{3~xx; 7=F,FE<< I #R!5 -!#2!3 +!;r 'r!7 /!? 0CQG D)FCyT@ETBeTAUTCu@MBmA]C}4@C4Bc4AS4Cs@KBkA[h ] = }111C1 1#1 1c111 1S1 131 1s1 "^XXx˰bVb^X5xk&6-l&ll؆x;.v={!>>!'Gpq'q qgq.s\%\U|k&;w#'_+!7?o'1BlA\Sx I !9R"R# "#2"2# "r  /E>DCQCq@iEETBeTAUTCuG4D#4F4E34G D+FE;<耎x]=}00C00#00c0000S00300s00 /b`)a9V`%V5X7obFlflVm؎w; b7#|}؏8C8O)(8N$N 3\| wG/~1?x#zň؈4##)!9R %R!5 -!=2 #2!3 +!;r 'r!7 /E>G 0CE1G D)FE9GTD%TFTE5TG BmA]G4B4Cs@KBkA[h ]=}00C00#00c01 1S1 300s0 2a1`)Ukxkoa#bNn=؋a? QqI9\%\| p7-n6.~} ~?ƓѯX84#! $G D*AZCzd@FdFdE6dGD.FųȇBD!AQCyTF EKL4؈M،x۰]pGq q'q qgq.s\%\Wq7=nǘ utBg@OBoA_ 8L$LL4L JkX ؈؍=0N .". 6~/x IAH$HtH,ȋ|((( ꨃzhhh耎.聞>!aQ1q I)iY9yX^",,+Xx+^jX؀،-؊ `vb{x`/SQqIiYy| q q_K|k[wpw!1)9Z%Z5ڠ-yGt 肮聞胾񘀉ɘ阁٘Xx/e,b,ReXm؁]˸/%n6'_b̎Ȁ(TD%TAwDXL>Aa|OqGq q'q qgq.s\%\|/q_:nk|pwc_5i]8Tm۶m۶m۶m۶mQ+}E/b>DT2w^L;A~_7 $ &k0X(#ItxIL$'E|)NJ 2iDV5iO:MadC%dYM֑Md3B^/&q7!HBd YHRT%t2! ",!K2 +*!k:l &l![6 ;.!{> !r!G1r ')r%r\%ur&w]r'c<%s$''|!_"I $A%HxD$I$Hl%>ėxGⓄ$IL$IEҐt$=@2L$3J$'E$O )L8)IJ2,)GʓL&Mz>i@F iJiIZ֤ iKڑH:Τ JIzޤKdHdJdIFd KƑdH&d JdIfdKdYD%dYNVd-YG֓ d#D6-d+Av=dOC09J9IN9O.2B&EG)yA^OƇ#QH4x7ID$%IKґ$7)LJIj:iJZNzd$EFdAd!YD%d)YFd%YEV5d-YG֓ d#D6-d+Fd'Ev=d/G 9D#(9F$9EN3,9GΓ "D.+*F&En;.G!yD')yF%yEސw=@>Ow09?&1H,&yH^'HAR%IUR H}Ҁ4$Hc҄4%HKҊ&mH[Ҏ'HG҉t&]HWҍt'=HOҋ C0,&KR,'+J&kZ'Fl&[Vl';N&{^'Ar&GQr''Ir&gYr'Er\&W5r 7S$k%{|$g|%w@DD#щ7' Ib )I#Id"Id#I"I#IR"IR#I R"IR#IRT"IRT#I R"IR# HC҈4&MHSҌ4'-HKҊ&mH[Ҟt$Hg҅t%}!~$5iMڑH:Τ JIzޤKdHdJdIFd KƑdH&d JdEf9d.Gd!YD%d)YIV5d-YG֓ d#DdNv]d7K 9D#9NN<@.K Nn[K1yJyI^ yGޓ#LN~_$&aHXD IdD'1I,'HFd&YHVd'9HN&yH^'HAR&EHQR'%HIR&eHYR'H%R$HmR%H}Ҁ4&MH3Ҝ -I+Қ!H{ҁt$Hg҅t#=H/қ!(2L&MAN9Mΐ9O.LNnMOyLyN^yMސwH>o Af$IuҒ'](2!c82L!2# _/lZX$."I#Hv&yI~RT"I Ҁ4&MHsҎt!]I?2#42% b k&Gqr\ 5r<# &G#P$D"M4$3F6Cz>i@F1iBf9iAZV5iCڒv=@:N3Bn;Az^7C~?@dJdO&Id2Fd6YBed9YAVUd5YC֒d#Dΐ9O.LNnMOyLyN^yMސyO>B'E~';X('HDD&HlI!IV%HRT"UI5R"IR#IҐ4"IҔ4#I Ғ"IҖ#Iґt%Hwҟ "#H2L&l2,&KR,'+J&kZ'Fl&[Vl';N&{^'Ar&GQr"gYr'Er\&WUr&C<#o7&aHX'HDD&QHTD'1HL&qH\E%.&O$ IJ$IIRt$H$K򓂤8)IʐrD**GiL9iEڒvAOdNFId E摅dYLdYNVdYM6Md3Bmd;Av=9Bc9Eΐ"LkInKyH yJyI^ yKޑH> JI~$ '^P$4 C’p$<@"H$2Bh$:AbX$6C/M|/q7?O$IH$ IJ$IIR$ IK2$ J$'Er|$?)@ B)NJR )Kʓ "D***F&Ej:.G!iD&)iF%iEZ6-iGړ#D:.+F'Ez>/Gd DdAF1d,O&d2Bid:AVLّ\2' B,&KR,'+J&kZ'Fl&[Vl';N!{>#Ir&g9r\&W5r$r#<"S!o;| '|!_7 ?/@D?&aHX'HDD&QHTD'1HL&qH\E%.&GI<$ I"$!II2 )I*!iI:d I&d!YI6 9I.!yI> I!R!EI1R %I)R!eI9RT I%RT!UI5R 5I-R!uI=R4 I#Ҙ4!MI3Ҝ -I+Қ!mI;Ҟt I'ҙt!]I7ҝ =I/қ!}I?ҟ  2 !C02 #(2!c82L $2L!S42 3,2!s<2, ",!K2 +*!k:l &l![6 ;.!{> !r!G1r ')r#r\"r\'7Mr&w=r< #Y@Ed1YBd=L}9AN3\0S.dYNVdDd?9HsyLyI^N~[!QIl$$)I*%H~R'IyRT#HC҈4&MHSҌ4'-HKҊ&mH[Ҏ'HG҉t&]HWҍt'=HOҋ&}H_ҏ'@2 !H2!c82L $2L!S42 3,2!s<2, ",!K2 +*!k:l &l![6 ;.!{> !r!qr&gYr'Er\&W r's"#|"|#"I $Ad܂"ID"QH4 1I'%IҒ$k$-g_| ~ßd$ ! b@L!/?$ĐRB*! 䀜Ba(,ԀVC?a !0p a,0&$ S`*L VZX`3l a?p n'k?ăB"H I )$RB*H i -2B& Y +drB. y /P B!( E(PJB)( e,P*B% U*TPjB- u.ԇCh ͠9C='~0T3a!,u v8"\p57<kx  |oZ @4 I )$t2A6 PAM >4ZAkh3t0haLI0TāY0"XKa,Uz8W |ke*Y!R C h 5C3tnzAo? 0 a L)0 s`!,-v;a=~8#pq8'3pyW*< _RBAha!"AdQ!DbC\pCH I!4Az!|P Aa(UԆ:PA}h 4&Ash-6A{t.Aw=>Aa !0p#a10xaL)0t3á0X` =~8#pq8'3py\+pu7܆;p}x< >G |o~O!! BC 7x!ćAbHI!$RAjHi! 2AfY!drAny!P Aa(EPJAi(e P*AeUTPjAmuԇAchM4ZAkhm:Ag]tzAo ? 00#`$08`"L043`&̂0< `!,Ű2X+`%հ:X`#lͰ6;`'ݰ> p18'$p98"\p57&܂p=!<3x/%;x#|7?'j BC .pA|H !$$ArH)!4Az!d,Av9!<A~("PAq(%2PAyT*PAu5Ԇ:PA}h 4&Ash-6A{t.Aw=>Aa !0p#a10xaL)0t3ă90|X a,%rX+a5zal-v;a=~8#pq8'3py\p M܅{pCx g_|~o@?I ! p"@D! Dhb@L!/~ >$CH 9 RCH =d 2C ;䀜 rC ?P C( ŠRPB9("TP C 6ԁzPB#h M)4ZAkhm:Ag]B?` !0hca0 &â0|X a1,VJX k` 6f[al > p18'$p98"\p57&܂p=!<3x/wEh!$d A(%,TPjAmuԇC+h m-B7=>Aa !0p#a10xaL)0t3ă90|X a,%rX+a5zal-v;a=~8#pq8'3py\+pu7܆;p}x<'sx/7{|/w? TP@X!DH@T!ĄX@\o_p<@BH!)$RB*H i -2Af !\@^BP@Q(šRP@Y(TJP@UաԄZP@]4F@Sh͡V@[htN@Wݡ^@_a A0PaQ0XaLI0TāY0\a,ERXaUZXalMVa]^CpQ8SpY8\KpU܄[p] PB1(%$PB9("TPB55&ԂPB= !4B3h-%B;h#tB7='B?` 00#`10xaL)0t3ă90|X a,%rX+a5za3l  `7쁽80p 8 4p \kpnM܅{pCx ' _+|~/ A/_! p"@D! Dhb@L!/~ >$CH 9TBz ;<A~( 7L98"\ ^+x _ Ma! ĀX !̐Av yPB .4 ZC[htN@Wݡ^ C`( 0F( c`,0&$ S`*L0f, s`.̃"X K`),V*X k`-MVaݰ>0p 8 4sp.E W*\pnmw܇x 9W;x#|7?'PB8 "D( C I.܃#x O)<^+x o->' _+|~/ A/ɿBAha!"AdQ!DbAlq |nC< !$$CJH i L@V9 '䆼C(P JC( $D@RH!T@ZH!dL@V!\@^BP@Q(šRP@Y(TJP@UաԄZP@]4F@Sh͡V@[htN@Wݡ^@_a A0PaQ0XaLI0TāY0\a,ERX+`%հ:X`#l  `7쁽A8cpNI8 sp.% W*\pn- w܇cxO9 ^x =| >w?0Ax!D(At>C H i -2B&Y!"P C (eTZP@Sh-5B7='B?a0 0  `40BX Ka-lMp 82\pnmw܇cxO<^kxo>g'A/YB8 "D C 6ā7x!ćAbHI!$RAjHi! 2AfY!drAny!P Aa(EPJAi(e P*AeUTPjAmuԇAchM4ZAkhtN@ /0 `8Q0x`2Li0f, sa,%rX+a5Fa lmvn{ap8 8p N8"\p57&܂;p}x<'sx w>G |o~O!__ 4C Q *D@\x!ćAbHI!TB:H #d,Av 7䁼C(bPJB)( e #pN)8 g, p . ܄[p=<'sx/7{|/w _b <B ?P C( Š8P JC( 4Bsh-6A{ݠ;^8X+`5 9 "P ZBkx 'E $ )HJO!dDfdYF yKޑH>o;A~_7 $(`I$!^ě_"n!~ğ#I$"I&iHZ'I IRT"IRT#I R"uH]Ґ4"\,"~r$ar#er !EC?IHRT$5IG$G꓆]0%!ÃJ;Z&+E|ȷ`'j6N%yr%Oɯ`Z(ڄ]ڇsz+(*)*)+*)F)F+(*)+&(&`rdM.;%o):%7):%7)^:?p?Gp?uWun9pہ;uOx+^;Ɓ|s?/~;?B9ځ8u@;ā$s iH@:;сLdv (@A6;Łt8Q9p܁t%:ṕp}8ā7u'>;Łw&@"9ŁDs qv߁Dp H@Z28сLdv Y@v;Ps%(@)J;PƁw@uj;Pǁ4rMh@3;6u@wz8O phC94ݡYvhCZR9ܡuhCv8n {-p9 -\p% W-\p- -ܱp -9ف/|s?/r=YB;ƁDv @ b:ˁuo|u߁x$t H@R;ҁTu @6;Ár y@> 9P؁voXjjZYjmYjo:YbzZe>ZoiYbiaFXii1Zgi&YliYniYf[ZniՖXZki 6Zdi-ZfivYmi}[:`頥C[:b騥NX:g邥nXi閥;[zj鹥7[h铥ϖXj雥~Ze鷥K,##l'ЖX`)H"[f)bYm)%oK>|-,-y,YR|K ,%RbKI,%RrK,dYE6]DAQHEDQQL%E)QZDQS4MDsRmEWMt=DOK}D_O`1D (!&ƾ |^o 3|^ s<1_mwA.ȷ HN!/ȭ~A rc_ 7W/ܐpQ\WuqWP<r3]x]C|$?)@ B0)Bb8)AJR4)Cʒr<@*J2Bj:AjZ6C!iLiEZ6-iO:3JIz>/Od$EF1d@&Id2Bd&Ed YJd%YEV5dYO6dAv]d7K9H9J9IN3,9O. Jn[6CyH9yIޑH> JI~.&aHX'HDD&1/#$I@$$INR$/)@ B)F$)EJ2,)Gʓ "D**:Aj:.GƤ iJiMڐH:.+Gd D!d(FdMƐd2Bd&Cd)YFd%YEV5d-H6dK9H9J9IN 9KΑK2B&MO^7LEH "??X(!aI8D I$D!QI4 1I,!q%.&GD$1IBd$9@2$ J$7C| )G*ʤ NjKiHƤ iJiIZ6H:Τ Jz>/Gd0MƒqdD 1HL&qH\E|HZd%Hv$Hn%H~R"IR#I R"IYRT&UHUR#I3҂$Hk҆%H{ҕt#I/қ!}I?ҟ  2 !CH2&cX2'D2L!S42'J&kZ'fl%ar"s%|%w"ILVtP$4 C’p$/+F_7 AO0\ &aHX!$O$9IAҒt$=B¤)NJ)Mʐ)O*BjvGdNFd KƑd&E%d)YFVd YK֑dH9MΒs;I~$?g !aIxD&QI4 1&>ėx' Hb$%iI&d#9HN&eI9RT IeR%H}Ҁ4$Hc҄4%Hs҂$Hk҆%H{ҁt$Hg҅t%Hw҃$Ho2 "2 #x2L%2# ,'+j'Fl#.r"Ir&gYr'Er\!ur&w]r'3&G|%w$o@!I,$#Hjd'9HN#IR"IR!eI9RT$H5R 5ImR%-HKҊ&mI;Ҟt$Io2 $C02 D2L&ST2L'3L2!KR,'+J&kZ'Fl&[Vl';Nr"r#g9r\ %r\!Wur<$c<%o['g|%!HxD$QI4' HB$&IHR$')HJ!iI:d I&d!YI6 9I."IRT$IRT#5IR#IҐ4"IҔ4#IҖ#Iґt"]H7ҝ Ho҇%2 "2"cX2'",'j'Fl&[6#GQr''Ir&gYr'%r\!W5r ]<'/+!o;| '|!_7 ?/?s,Xh#ID"H "Ix_"~ğ#Id"Id#yHIR&eHeRT%5I=R4 I#Ҕ4#IKҊ&mH;Ҟt I'ҍt'=HOҋ&}I?ҟ #2 s<2, Vl'{1r ')r!gEr\&WUr 7mr%| '|#'B$ G“$ AbċxKI<$ I"$!II2 )I*!HFd&Hv$Hn%H~R$HaR!eI9R 5I-R!H}Ҁ4$IҔ4#I ҆%H{ҁt&H2 &cx2L$3L2!s<2, ",!K2 k1r"g9r\ %r\!W5r 7-r!w|&_W|'?O&$ v/ M$IbċxK\$IHҒ$B$'E"()FLiAZV5iCzޤ/Gd Fd$EF1d,GƓdYM֐dH6dIv=d/9CΓ "DkyH yJ%yOo;A~_7 v?4 C’$%n!~ğ$#I*!iI:d IV 9In'H!R!EI1R %I)R!eIRT"IҐ4"IҔ4'-HҎt"I/2 2#d2"2#,"KR,'+J#&l!;n%~r$ar#Yr'ur$rdIfdY@Ed1YBed9YAVUd5YC֒ud=@6Md3B 9Fΐ9O. F&E{)yF^W5D~$ 'P$4 C‘$"J$"ć?O$IL$INR$L$Nr$7C2)O*Bj:AjZ6C!iD&%iMڑH:Τ J'Ez>/Gd,Nv]d7C}d?9@C09Bc8yD')yFyMޒw=@>O3Bo;A~_7 $ &?WP$4 C’p$<@"H$2Bh$:AbX$6C/M|/OD$ IIҐ$IO2$ J$M$O )L$)EJ2,)Gʓ "DIjz>iHƤ iJiIZv=H;AzdHdJdIFd KƑdYH%d)YF-d+F]d7K(9F$9ENNn;.G yN^W5yK~?%HdD'1I,!q7!I'H"I#IR"IR#IRT"IRT#I R"IR#I҈4&MHk҆%H{ҁt&]HWҍt'=HOҋ&}H_ҏ'@2 &$2L%3L2%|,$ l fl#" r&gYr'Er\&WUr G-سp$R#I RT$I5R 5I-R!uIҐ4&-H[Ҏ'HG҉t&Hw҃$Ho҇%H2 $P2 #(2!c82L $2L!S42$l2, ",! "#&r& r"g9r\&W5r"r#<"<#/|#I "y,B$I/M|$ILRT$5ICҒt$=@$')H ¤)JJҤ )O*ʤ JiLiNzdEFd&Ef9d!YDd9YAV5d-YG֓ dLmd;Av]d7C}d?9@C09Bc89ANSJn;.GyMސyO>E~D?/X(!aI8D$HTD'1HL%^ć$)IA2$ J$Ir$K0)BJ)MʑH*ʤ Jz>iLH:!d(F1d,GƓ d2Kd!YD%d)YFd%YEV5d-YG֓ dIv}d?9@c$9M. FnMOyL%yE^7-LuhD ^EH|d#Z޽޽woZ=Z7>ySDob)b+| £S+*)+(*)+R#-I&; P AQR'%HIR&eI9RT#5HMRBchMt  C`( 0`*L0flsa,V*X k`-6& ap!8 G(pU܄[pcx 9 ^x| _oCC YlዅYnᇅfXj!Xk˂_ n  ~-ijB -$BZ ,BF 9,䴐Bn y,PB! -PBq %,PBY ,PBE ,TPB5 -ԴPBm u,ԵPBc M-4BK ,tBo }, - 0H ,0X ,0D ,̳0B -~ G-pI g,pE -\p ,Bt 1-x[gB< -$B I-$B: Y,dB -PBa E,PB) ,PB% -TPB5 -԰PB=ECEcEEKE+EkEE[E;E{EEGE'EgEEWE7EwEEOE/EoEE`6n!1Ii9E%e5M}cS3sk'gwO/oE"PɟRVQUSWDPDTDRDVDQDUDSDWPTRVQUx)> _KVxxDTt ̊,l\܊<|BŠbRҊ2*jZڊ:zƊ&fV֊6vN.^ފ>!1q IɊيE%劕Պ5]݊}CÊk늇GNJ'gW7w_?חHȊ(8 /[Q+)+(*)+(*)+R(R*R+*)2)(*))+ ( )*+J(J*J)(*)+*(***)*+(*)+j(j*j)j+(*)+(*)+Z(Z*Z+*+:(:*:)(*z)z++*F+*&+f*f)f+()(*)*)V*V)V+(*)6(6*6)6+*)(*)+()+N(+.*.+(*+n(n*n)n+(*()^*+>(SRVQUSDRDVPVQn""""""""""""""bbbbbbbbbbbbbbbbbbbbbbbbbb%B)(*b+(* ­(T4t􊌊L̊,l\܊|BŠ"bRҊ2r Jʊ*jZڊ:&f6Ί.n^ފ>~A!aъ1 IɊ)i銙ي9yEu ݊}CÊc3Kˊ+k[ۊ;{GNJ'g7?)B)B+(*"*")"+(+b(b+(* OᯈHHHHHHHHHHHHȨȮȡȩȥȭȣȫȧȯ((((((((((((((hhhhXXXXXXXتئة88xxxP*SRQUWDPDVDWPTRVQUx)> £S++*)*)2+(*)r*r) ) +(*)+J(J*J)J+(***(*)+j(j*j)j+()+)+(*)+Z(Z*Z)Z+(*)+:(:*:):+(*)+z(z*z)z+(*)+(*)+(*)+F(F*F)F+(*)+&(&*&)&+(*)+f(f**+6)6+(*)+*)+*)+()+N(N*N)N+(*+.(.*.).+(*)n(n*n+(*)+*+^*^)^+(*)>)>+()~_?*+"*b)b+(* ¥p+ ))iYY99yyEE%eU5u --mm=}}##ss KGG''ggWW7wwOO//o_OPЊ0pHȊ(hX ¥p+< ?""""""""""""""""""""""""bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb%N^AQE]CSK[GU)  II)iyE MMm]]#33ss+kk[[;;{{GG''ggWW7wO/oo__??@E%+""""""""""""KQ* 3@/) (.JBʈ(/*,.j-ꈺ/ h( 3 ;2h.Zh-)ډBn: > {0@z-/b,B€BQb#  .@N "ib;-@ *@nbX( Bn6 [(@nu [&@K #@+!@ <@yy 6@y -@ީy w'@ޙyW &"@ކy  d] 9੐} 7@mK!;6൐ {4@fًdN  ;+@vTAsd ;#@v(((((((([x|ʷl`<_j|h|f|Kʷc`*IdYDVS7_OOOOOLLLLLLLKKKKKKKHFAA@t?P(J@}>P(^Jׁ@jt5Pz(} >J@a0Pz(= Jҽ@^t/P( 9P( Jҿ@_.Pz(fܗҽ@]t-Pn@oҙ@Lt!P%@Z_ 4H2 LdgIAg$yIAg$IfAYP2!InA)d$Ai||Pz!yIAgMd9$YIA d. =$ =$;,HvX _A$ %Hr d$wA2A+Ao$cA2A2A[$unnnܙA2A2A2SA2CArK o$$~O ??! d rC>0bP JC(2TZPBCh 4ZA;]+tzB/ }? 0 XaLi0Xa),VX `=lv. #pn=x1<^[3| ~B/4"Ad C4@{3tnz@O` !0FhcaLXd'Ev=d/G9L9ANS49CΒs<@.K2F&E>y@')yI>O3Bo;A~_$ &grP$4 C“$"Ab$."ćq#$O$IL$IMґ $#D\$7)@ )MʑDiHfiIZ֤ Az^7C~?@Ad(Fd"D&)d*FdM搹dOdYLdYC֒ud=@6-d+FdO9J,9G.+*x#|o~:Db8$.">EC?IH$ IJ$IIR$H2$ J$Ir$K)H ¤)J)MʑH*ʤNjMꐺO1iBiMڐ=@dLdIFd GƓi30ro=Fn0gȎ #aD;2܏an +bX2m m137g ABD $5Hf AJT 5Hg AFL d5f A.y 3oPA!E 3(aPҠA5 j1gРAs Z7`ѠAg.] t7a0`p# F6c0`D3 f6c0`| ,1Xj`*k l3gp! N48epYs .\1jp-; <1xjKW 5xgGO  Y2m A8 "D2l Aj 2(bPԠAq 7`ѠAn} 7`0``!C L6j0`Ls ,6Xa`j[ v6cp 18gpU7 n1x`Sg ^4xe[w >|4dB>AxH b1k137He A r2m A 4(eP֠Ay 0hn A{ :t5f0`(c L0h0`s 7X``Re V4Xe`[ v2m`> 68bpq' N6dp5 <5xak7o 7`g/_ ~604 Y "D66px 7H` Abd) R6Hc AF9 r2(gPɠAk :t2lŠAwa F4e0`Xq &0i0`* v6c`~ 58fpy 2xf >|1jO_AB B1k Ad(Q D7a Ax $2Hb Ar) R1Hk A d5n A!E J2nPˠA#M 47haڠA[v :t6bՠA z1kϠ`!C L2e0`| l7a` N48epe+ 0ip= 0xk'_ 0iAA`"2m A 0i A^nA< $6Hb Ar) R6Hc Az 0i A 4(lPĠAr *T1jP͠A  41hfܠAKm 3hoAo>} 7`0`h1 &L4l0`4 ,1Xn`Vm 78bpqg 7`p} <6xb  ^1xkO" Ah0a 7` A b2m c Ar) R6Hc A&Y d7a A^| 2(fPΠA%u 3oAc&M 0hiʠAt A   L L   ,,   l     \ \  << < <   | |   0A!ߢ/B:aB!B9QB-qC7C _C/C0B8IB4B<BP<CP5B4]B5C0<#C0*C0&cC0>B01C0=3B03B0;sB07C  C(C,C>[qgqͿzB(* QKT*PAu ԅB#hM4 ZCh =tB7=>0 ` P@X "D bC\7?ćBrH)! 2AV!'ܐCA(bPJ@I( rP*A ՠ&ԃAch-6A{t.C ` 0Fhca2́0X K`)6 a=80p y:܁{pCx/5>g_;+ pB4qCH 9 RCZH!+drAa( rP*B% U*TP jCC3tB?`0 a0F( `Li0X +a5u66`7p8 8Spe&܂;px W>g_| ~CB+ "B$1 &Ă8 .p! $RB*H i - 2C ;䁼P@Q(%2P*B% 5&ԂPB= 4&Z@Kh mtnzB ? A0pa2L0f, a,%JXa-6f;a솽p 8 spU><^kxoC+V( a ,H|I )$ RCF! drA>0bPJ@I(  PB( TP@#h ͡nzC a !0pc` 0&d`6,EւPlycm[޿Ŗm[޿rCp12K彋-7xl[(Plyb˷syb?wőǑƑ;3NRQQQUQQQuQ BRJZFVN^AM!qdLǴǜǼ,Ǣ,NJlRUTQSWPTRVQU\Q\U\S\WPTQU|d'H>#M#7ܬ>@1HȮ]3Tܦ>c>GN錏%>bGv+>rH|S>rH| I|K>%钏tGn#>G|dH| %>V.GJ镏Gzs_<3| 閏 錏G#o7wW:+Wv_鋯Wz+}%__Wr\}ev}%S_]_VYL}+WJ"$g_W2}e}%g_Wr}e}%k_W}%__W|}%__W|}%__q_q_k_W2 }%C_m_W _Wr|%7_WrWr|%'_WrW_;+W=+7+J>u_Wr+Y^'$7_W̹r_2メ̻++~+3+7K%oKf%yd׻d׻d׻d׻$_z]\]2.̿K%yw>wI\]̴KwI..m̶. .K..Kf%ٻ$o풜]]K2uI.%dN]2.S̩Kuɜ$cd쒌]oJ!3]KrvI.%9$gtI.M̦Kf%$sd]KvI..y]2.%y$o풼]2.y]K%ٺ$K̠Kf%3t=]]]]]]]KwɞwI.%$]KwI.%w[--7[-얻IHt-wˌn[:-epKn-eee n[~ pˮp˞p˞pnmwm.#n[==ᖽwKܲݲݲݲV[>%{ݒ[f-ٻeG%c|Mw˷[wKnܒ[wKn-%̼[:wܻ n[. nr eeee/eeeeG3nttt-rK!t-in[v[[v[v[:=NSn[:NSn[-}rKwnGvG]>xG>xGvGvGvG^xGxG:x#;#wGG=^xdGxy<x-[w#};Nx ]]ᑞx}ȾȾȝ#{x;GGG:}x7y=t#;x{⑎x#GnxGnxGzNxmH/< t#ȍ#H'< t#H'< #]|K{dxyW< +yS~, o'3'{OVdLL>='s'ﮟ`e/&˛/____~w/s/Z+e<<<oe)));_v̖̖̖̖̖̖/;_v/ﰿcc/9K>/̣/﴿/]/3/]/s/=LKee<<<<˻/︿t_f_///QlVlQlSQSWPVt.,S!-ݥtwH+JLR]9EwHw ʳc~淏|y}_:vXX\X\X\ n*w=zȣ=GG52Z Te2NLTf)sBWeXY,S++UjeV W6(-VeC٩R)CrUPPn)w{}TyU*ٔJ%KɭP *"JQR\)RJ+eJ9RA|TR*+uFJcLiTZ)JgMN R+CHGU%@V %XS+ӕ,e2GS+ "eDY,S++*elP6*-Ve]١Tv)=^7e_9T+ǔ rJ9Q) ErY\U)+וMr[U+GcLyT^)7[O/S+/of]_vp~ٽe]?_vg~ٙe?旽_v`~}e嗝_vY~a _>͓_X~y䗽_U~Se?嗷K~Ae䗝_vM~1e䗝_vI~!͒_G~)ՕJ-RGW( FJcTi4WZ(-VJk^tR(ݔJK|S+A`e2TPF*>(JLVf(yeLYTeUM٧W(CarB9R*KUr]Tn)w#JKy?)JB%XHXI$U)ɕJJ%VDIW2(LJf%UɦdWr(9\Jn%WɧW (BJaRT)WJ(%RJiRV)W*(ϔϕJJeRUTWj(5ZJ=@iTZ)6J[QZtV(]nJwGW(H_V %X QB_e2CV(BWeLYPV*5Z%ZYW6(MfeC٣U~S)ArB9U.)urGS(LyP^*7[O S+ ʇJb%ZɢP )"JQRB)RJ+eJ%RETj+uJRiQ*//J+ItQ*ݔwJ/2LPF*>+J(J2FS)BWeDY,WV(+UjeU9V)%rE\S~W+7mrWW(3ByR^+oS(\IRR+i'J:%Qɢ|dS+9J%_)TJ(e&JSQtWz(+@'e2X U)ÕHGU%@V %X QB0e2^LUf)beLYPV*eD(JS+Ve]]HBr+qTDžB')!3!wo!хd[Hfn!d[BB2 ɍZHf_!ydYVHfX!]+,w\aEzGaR녥 Km-,5[x,-UXr/<X+`%5 Q6F[`+lv. {`/p!8 \pU n- w܇cx S$ $@ZC 3dO!+drB. y /P B!(EPJAi(e P>ϡT*PAu5ԃAsh-. z0@ aLspn ><x 9 )!PJPjAmu4Ch ͠9 ZCh :WAw^G ` a !` q0&/0"XKa,VjXk!"  `3쁽Cpq8'3py\[) 2C(:ԀPB}h500> `*L0 |X WXa ,eVJXa pHhXalͰ6;a7쁽8cpNI8 sp.% W*\S<$cH!#drB.(utt.AwBOa,6;a솳p.% W:܀?܆{pSx/5OxB">Đ'2@FBV!\ @A( Š8P JCԅzCSh͡V@[5tB7@/ #F- wJƃB"H i P jA}h 4 Cw! `̅y0~8G3pyunm <T< $RAH @:H #d@^BP@Q(šRPCA% u.ԃfz3 !`4Bt3ă0XKaU@46.{7Ww7S:ćAr y!P@Q(š2P*@muԇ6zB?` `5(pa8 g,p.% Ww5'S&$D>P ZCāmM i  A~(EԆa0| Fh 0& `:̀0 f\ `5C$D& [`+lv. { OP@Yh-@Ca 0|`)0f|X K`),V*X k`-CDA46& [`+lv. {`/`?p8Sp.Ew.< ^Kxo'CH ǐB2H) %Ԑ'C 3dO!+dP@i(eTs TjPjB-u!4B3h-%B;:Cݡ@_`3a ,pHhXa/쇃pQ8sp.E܄[p}x1< x 5'!$! $dR@*H =dL@69!P B!( E(PJB)( e0p 8 4p.E ܄[p]*ƃ|cH 9O d rC>(EPJAi(e P*AeUԆzP@Ch M)4ZB+h+_C''?`Ca   8WXK`),V*X k`-CDBD:X`#lͰ60cpNi8g p.eW\p n K !|Bb>$ C H 5 2AfB. ?"P JC( ] PHEk]"wMi=En.rtԅAh ͠9 ZC:B 3 !0/?( 0aaLi0f, s`.̃¯2X*XJ8D(JNYlPv*o>er@9R+G)rV9W.(KerURn+w=@yP>T(ɕJ%AɨdR *JR\)TJ)eJ9Ti4WZ(-VJNBR|tR:+]nJO{GWW(A`e2TSJ(J2FELU)3,e@Y,V*n7e_9V)ǕIrZ9U) ErY\U)+וr_yP^*7[O/S+ J"C%DI$WR()lJve9v `V:`9`;8ࠃC;8N9898ppmwup}tARpA:dtAtA~uPAq%sPATvPA5sPAv:砿 r``!B9`&8`):`f:`9X :lp&lq{wp1\pp%\qp5;7q#r$;H 2; |;(ࠠB ;(⠨b;(頔r;ࠢ*j:hࠑ6:AG_;䠋z8z:A/;8렟 r8` 8`f8`8`:K,sAhlvVv^qp\pp%sKv[;{+:H9H >qAzdtAfY| l;頀 9(⠨b;(ᠤ9ࠢTvPA]wA3tAG_;⠫nz8Ao;렟8 p0ҁ_~s0lsu0| ,t8X`V:X`(;`9`stpigup5;9x9xW^;xୃsw;H $wA:dp: \r; |;(ࠠ":(栬 *:䠊j;ᠶ::砾:h䠱&8h렝:8A]tsA8AO9:砿:ǁv APa8`f:`9:`V9X`D8t :rppp98ྃ^9xtwvx;H >r$;H T 8(ꠘJ:(場28렡F;h⠩f;hᠳ.::;vsO8`;u`9`_Lt0t3t0\`8X`68`8`9C;8ਃSN;8.;ઃk~wp 88x'^8xൃ:Ab;H d;H OduA^vPAQwPA9TtPA-wAC-uA'tqAO9{?8'8`f8`8`;X`e;X`U:w AhwFlqv;vp \ppe;7rpww#tG>vAR$wAJv'9AVtAnyuA~tPAaEuPAIvPAYTpPg>wPAUTwPA4vAs-vA;_8A{_9蠓9`~r0;`aF8ǁ?Lr0L,vZltf[lu.u~tpaGupq'rpwpE\sp 8:xృ':xoRi| L9 :(栄J*;⠪jj89h젉9h8hktvAWpsAo;㠯:g q00p0ҁF9` ~q0St0\wB:X`UV;X :[lupp!qpI\un8MvSp+_< | R:H 9H 29 OduAv9rPAaEuPAq%vPAyTtJ*;ꠚj8h蠱&:h根Z:h렝/wW::A'tqA/}u0 ?;`@XL8 4p.57 6܁p?>0$6|dHfHnĐՐݐÐӐPPPPPPPPPPsC%CeCUC5CuC CMC-CmC]C=C}CCCC#CcCC3CsC+CkC[C;NΆnކ }  C # >_8$l\BïEņ%5pC!mXgXo`naimkͰϰpppppppppppppppppp-m]=}C#S3s K+k[ß 537$0$4|`АcCrCC:CzCCfCç\܆|B†"b҆r jZ::1|kiCOA!_0l1 c c fVVV HF&6vN.noÆk 7 nn^^^4exg!!!!!!!!!!!3*ꆚƆ&fVv/ _:2t4|mdlbfna𝡗{ } }   b7b%F(b;n$ Ll\ïEņeUՆ5pC!ڰްѰɰٰŰհͰݰðӰ˰۰ǰװppppppppppppppppppppppp/;߆>2$1$5$3$7042637d6d1|j(l(j(f(a(i(m(o`hdlemckgoh`hlhbhjhfhahihehm`𽡏aag0p(C!00000000000aaa!a4D  [ ; ; G G ' ' g g   W W w   O O o 57$0$4$2$6|dHbHjHfHaHiHohemco(`(h(d(l(b(n(a(i(c(k(g(o`lbjfnaiehbhjhfhmhk[COC/Co } }   ?FF| `C!fcgo`lbjnaimX`հȰذ°ڰưn0D ц͆-m}Æ#s󆋆Kˆk nn^^^43m'?Nj!~ bH1|Cǐ"1!m Đ=|1䏡@ c(CP%1Tz 5bemckh`hdhjhfhnhahihehmhchkhg+CG׆N.no ?~2 2llbjnai1  X8xdt \BR2JZz&fv.AQ1q I)i9e5u {G熿 537|hHlȐĐԐҐƐ!!!!!!!SCVC6CCNCnCCCAC!CC CiCCyCEg U U 5 5 u M M - - m _2t4|mdlbjfna𣡏aa'`Paaaaaaaaaaaaa!a4D  [ { { NNnnn^^^^4ex gHdHjHfHnHaHeHmHcHkHo`jfnaemg(`(d(l(b(j(f(n(e(c`hdbjfniemckghdhlhbhahmhg`𵡓[COw(hC!b5153L6L1L7037,0,4jXdXlXbXjXfXnXaXi0l2l1l504215704150426\5\3nappppppߐCCCRCCZ' L̆<|B†"bR ʆ*jZچ:zƆf6  _:z1|kckgo`hl7F ACaaaaaaaaaaaaW"bRJ*jZC!mXgXo`lbjo8l8a8k8glbmox`xjxekX3|ndfeckhdhnhihk𕡣kCgC7COwކ }  ?~6 1 5 ц@Caa$dT4t L,l\<ïEՆHfV6vn^o}CÆ#csKkGdž'gW׆7? 6cߐА!!!CzCC&Cfçl솜\܆<0Q(J'J%RDi,QLT!uAhC!0~Q&*Te{udUȝ:!#)ab!F _!H!7QBHF0!ȱBw|Hr++7HiFm2Rnr{/bX"baV!h^lr7;a!|Ƒ GyJ);j중F.n[ⶸ+⡐]3RvH%#ew0RfH#e~y=RfE>7}=#oyo$v#G攏}d6{Gf,B拏>E!!#SLHHHOHHHHTR>E QSȻ̧wO}LnB;GGGGG[! yG Nwd#H>O}$oGjG}|}$oY}F}$wG2;GJG,}6 G;G:|v |[GnB9#V}.⊐}$k1|}$sG}^ Gd#}#W2\}?+yJd+Jd+;Wr! W9+Jve5_y{W2|evJ+yJ_ӷh(X4-}[B} Wƾo'!J+R_yBԂԁ_ 2|e&W悯__R2|eJm,ZZZZ~^]'||w k_}||v[WV_Wr}}/ s_W2}%s;B}}}}Z:$?O::${?Ovt?~R~R~R~~~~dWOH~_\H~'9I~~l?{!yI^~'YIV~d'}'3O$'?a?a?~~~2$7?OOO'3odI^~~F!}'IIII~,$K?yOI~~d'='YI~d'''I?I~~n?O2L$O?O<$K?~rK?[_nSE%c_2%c?%c_~~%c_4_0_n1{_涿mwww_r%s_2^^ۋ+QH?K?K-K- zzY/5/=/5///5///5/=?A@r \$5@<@<! Ho ;@=@C ^ɠdU)ٕJN%[ɣHMzU"RP*A55&Ԃ1ԁP:1|C:-1|÷1|C0 !1 aX cb! Q1!0000000BUY+Je637l0l2l1l5l30461fo8`8h8b8j8n8a8i8e8m8k8g8ohdbjfppO߆ >2|lHbHjHfHnHcĐΐސ!!KC{CWΆ.no  # >Qц@CaaD4\|BïEņeUՆ5pC!e637l0l4l2l6l1l542615615704261537\0\4\2\6\1\5\313<4<1425iϐ#dž$dV (2 & * '0(# %P@K+碒,.j-zh %{%P@Gl'r (;?PyBvs^ ~bI ?b+dO كab+de^ " gӅ8[^ (;Pu@ǁ2e, 9(s1Pf^̸@iN.m(+PfU̦@En wj!!s(PN̙cBfK̒@ہg VxWHJʛ&x.-(uZ&P8 7HkgP"!5$7yP REZ!7xMMP!$KyE~QD=T\HIIII I I ɽ$a܃Am$urm$TзB%$۠B (H2 "@HAg$9IAd!yIAg$yIAd4Gr$wGArWIAKAr${?H|$IAedOHAa$7HfmdXH>AId$ <$`"X@<Y{rn,K6M%`%8~&%D;D!!!uuuusrCBBCB$6D LC$!k6Dr -D \C$5DuA!r"s;䦐C$;DfC2!2Bd>l"HC%P2B%P?TfẇP2BBe>|Z*****;>TfCB̅PPP:* Tf@d*:Tud*J2B%P=TÃP2CBBBeʌ*3"Tj"TvzC&Be·ʌzZ*J2BBB%P2BBBe Z*3 Tf@***JJJCe>::*u*5*s T?Tj!T?T?T?T?T=T=Tj!TvuyBBB߅d*yJޡC =Tr*:T*ʾCC0?L?LB&&Iay0aaqd&?Lr&YIau~~d&&&7\0L$07Lz;Lr ^|b/b!4& u&"Ln0a2'¤^Y&!L%Lj"l+] &u&{ LDĊ0a')rF9S+%rE\SVî+7b#1܊v cxÓ<1_c8|qH4qHOD"k!Gr!w! ǡHơd*šrġZjơvġnǡaǡIǡEZơMǡCq6=cġoa@8 ð8O|0*8aLaR&azfanaaaY6+G)rNo|c#7Fn1r7y/^#7-6F-cR5F1[țu]e]4cH 9 RCH @:H | Y!d@(0PJBi( Ts TjP@Ch 4fZ@Kh v| |k tna A0 >`4B0 4`.̃¯X `9 " za+]^ A8SpY8Wwnm ><'sx/5ϸxAb@RH 3d C 7P@Q(%$PB9(T*P j@MԅzCSh_B ݠ'?B_a A00#`$B8`2Li0RX+`5Ѱva`pQ8'3py 6܁cx 7x>>,)\C(0P C (TPjC]-/+3t C#~Pa$@c`,0~0 &a `1, C$Mv`셃p18'$p.E 6܁^kxoO ??CHCH I )$TAz 3dO!;䁼C(PJB)(TϠ2ԂPB}h 4& Ch _@G:AWݡ?Ba ` ! B Xs`9 B46& [`p8 "\px1P@C% UԄ:PA}h V@; ݡ|{a?Q0!B! x`:̄Y0X"X K`,UZ(MV;a`?p NI8 sp.e܁x / ?/xgZBHI #d,)dC((PB UԀZPB}h 5vtt | =|?@ a a0 a0FH_Q0 B` q0&/0&d`.̃bX+ &`7`p8 g\pnM܅{ ^gzJP@Uu!4Bsh 5%tN0`4BCBLVX Ѱ6& [`lv 8 4p5n- !4@Shm h#^~a0 0 |!!B! 8`6,Ű2X+`%հB8D@$DA4Va'#p 8gp . w7 6܅{pCx <^+x o- oϜ!$cH! 2AfBn "PAq(%,PB55&ԂPB=M4@_a a0 0  > `"LY¯X `9pu6Fa lmvn{78_x >$>#HI!Ԑ'C 3dO!+drB. BP@Q(šRPC5&Ԃ:PA}h 4&Ash vt a0 0 H_Q0!!Ba,0 & `:̀0 f `! `;p}xO)<^xy $D| I %ԐBz!3dO!+drB. y!P JC5 u.ԃB#h M)4ZB+h m-/=t#tB7=zw z?`Ca 0|`@P10x `:̀0 2X+`%샃p8SpY8܄[p]%7 ?A|H !|Bb>$R@JHi 9 'ܐB ( 4P@-4B3h-%B;N@W=~ Pa c`,0fljXk!"  6Fa;]^ ~8#pN)8 \KpU܄SxW_x >$D!$RAjH@z 3dO!ܐB>(ERP@% 14B;@W=~@ 0Pa10Xa:X`3]^ 18 g\+p ~p#x O% 0$|#HI!Ԑ'2B9!<A~( ERPCA% UԄ:B;} H %r-|ׄJR%YTɪdSr(9\Jn%_)Q*ŔJ RJ)W**5J-@i4R+͔J ZiS+JW]S~V+C0e2BQ %X QB0e2^LT&)Le2_Y,Q*˔JD*QFeY٢lUv)=o r^\V(WߕMrGS(sFy?R*iJ:%QɤdV(9J.%W)T )J R^||TR(UJMR[U+ FJcTiP(mvʗJkMPQUz++}O*JQ*e2ILU)3YReV W"H%JYlP6*eC٣U~S)#Qr\9TN)3YrA\Q*הߕ rWyJ)c8e2ILQ*39\e@Y+:eQ٢V({ArZ\R.+WurGS+Gc\yUT)(*gI2%BIRR+J&%MɮP*%ϔϕJJeRUTj)zJ}Xi4UZ)NJgUPQUz*J?2HY WF+J)cqxe2ITf)9\eLYD+;eOٯT+ǔIrO(J2FQ*eHY,U)+eD(JNYlP6)-Ve]٩Rv+rH9Q(gsyrY\U+7;]r_y2{˜].u2O\r3LBr_.Br_e,/3*C ա6ԇCSh͡%6:Agu4& CKh t.#` ilb1G, b-Nl"6[Nb8@$G)4qL\#~'7[mqx4g1D?'b017Jy묔7JyKwzbDl&;]nb/8@$#Qq8I"NgEqG')xA$^7[/7޶*HL$#)D*"5HKd 2YDn"G' BDaQ(A$JeωJDeQG'DKњhC%_퉎D'3ѕA!Ab(1A& "!Bqxb1BL#3Ylb1O,"Ke b5XKDzb#A$vQq8A$Ng9qN$n;]>xJ<#/+5xKE#O|@|D|L$!ɈD "K' "DQQ(A!*DUQE! FDc%ъhMt :.Dw -ѓE|O@H'~"È/Ob1@BL$Si b&1X@,!Vb-I'6-VbA$v=^b?q8O\$.+UqI%GsxE&5D"-D|Jd#9\D"/(@R(%JRITSj(5ZJmHi4Q)͕J7;уI"A`b1%F@"&B8b<1HL%3Ylb1XD,&b-ND 6b'8H%NsqJ\#~'7[m>xH<"O _mm<">HF$'鈌D&" N ry|D!0Q(J#%D3 QN jDCјhB4%͉DK5цhK# &:.DWѝA|C|K|G"O b(1N F>/GD J%_$b21JL#3Yb.XI%"(bD&!0q8J#')4q8K#K*;qE&!xL#>'**DUQI"juD= ×  _::z326|o𣡏a@ cÐ0,1*\L> P{.py`"&y˛$\7m.py3 \npg _"X,K2\!wwBnp7Bnb*b%F#v {0\np ;-\nBnp {#\np#Ÿ ŸBnp #DBn؈cDٗ쾈OENK"dDn()dDވ]!!Bf{2#dF|Y!1Bf^̷e2"dNE4E!(B@}tkgķBz(Bz&Bz$B:B8B6B4B2BRoRSR7R+R+B%B%B%Bj%B$B!B|#$׈B2L#$yEHg!yFlaa"!oy?D[!Ba!EH~rFBn_#V+6;4Bn/#$1═.⍐{.Br#喊"%H-2H.R02H#^[(RHk"3 3R*䆉L#%H4RHC",( 7"%ȢBnH#%H8Rr)9GJidC!{&Rl& "eD܏|#%H㑒qH8Rfnd!FJ2["%ȟ`!#R)F\)d.DJizxww#]))HHHHH!3>Zf|@-G"Z@@@@@d-3 Zf@2eG˼{ ZfBrD--5-5-5-5-@I b1X@,$~%KerbID FbBl%ۉNbC%~#Aq8B%ljIq8C% EqB\%׉MqC%CxB<%ωKxC%$"!%# ćGD")HN R4DZ"=)(@&JDQBT%5D-6QK# D#1фhJ4#-D+5цhK# $D'3хJt#=oowďD/1B %ÉH‡%b1!B_b.1O,"Kerb$ F,qH\".W &xN ^oGD"HC%2D"Q(H" ňD $Q(KT$>#>'**DUQA$j:D]јhB4%͉DK5іH|Mt%z=>@'gb01F 'F# —#bHDJc8b<1HL"&Stb1C'~%%RbXM![mNb7q8A& xN$^oğ_;_mC<">HD|L$'R)TDj"@d$2YD"'M!D Q(L!ňD),QLT!ՉD-QhH4"͈D %ъhM!/D+#5щLt!݈DO;ћC# gb(1N F>/1$`"C% /Db1BL%Ӊ_Ebb)XN V("XGl 6[vbC%~#ljIqB\#nw=>xH<"O39xI"^ow?ĿDB"HB$%ɉD*" Jd#9D $Q(C%UD &QM!DCјhB4#-D-юFt'z=^Do{G/я@D "~&@"O, +p"XGl$[NbC%~#Aq8B%ljIq8C%ψ %xM!mD*"5HK|B#D6Q(N JD,Q(OT **DuQE&uDCјhB4#]nDo{/џHD "~&ÉG"#cqb:1E&b)XN V"XG'618q8I"Ng%2qJ\#~'n7;]qx@<$ωwɈD>"?Q(B%J%RDi Q@T$>#>'**DUQA$jD єhF4'Z-VDk іhG|A|I':_NDg ѕFt'z=^Do{GїG "~&C0b81I@!/$b21JL#3YlbXB,%VbA$~#aq8N$N3- I I ) ) i Y MfDs%ъhM|A|It :.DWѝA|C|K|G"z}~Db1DL !| ?Ÿ&B0b 1@BL$&)Tb1A"fsb9FHe- O454rV\UqMai%{GO_w?ooHbHjHfHnHaHGd 2DN"C%DAQ(F'J%RDi Q(OT *UjDuрhD4!Z/DѝA|C|K$#z>b1!| ?Ÿ F@"&BP"C%Idb 1FL'fsb!+XBDVbI%~#CaqxD<&ψ 7m[<">HH$"> YD."7K#2DYQ@T"*UjDuQE&uzD}ѐhD4%D-юhOt :_ďD/яO ?/O "C%_Tb1E! _Ebb9XM!DID:b=Dl&[b'G'Ca(q8N N,qD\&CxB<'D"!HL$%ɉDj"K&D9QJT#5D]>рhH4&MfDKњhC%z!H"C%_db 1A&ˉZ" "b#8B%kM6qK#'SxA$^7_;oێD "%HM|B'2DS"+E&BDaQ(F'J%RDi,Q(OT ՉDшhOt ":_]nDwѓMH!Cb$C~?@"b*1XOl 6b+N {߈ q8C%.+5w:qE#OgsxoO$ IdD "%HC|B#ħDV"A$ryD>"?Q(H!2DYQH|NT"*UD5.QO4 MD39тhI"mvWD'3эM|O@!@'b1$B0b,1OL ~!&b.1O, K2b9XE&kp"& fb F vb/O (q8N\ .+UqC%Ogsxo Fd' "DQQ(I"JeD9q8E&gsyqD\&WMqC<$ωk xGMCKG'$DR"HA&iOtDz"Dd&YlDv"E&y|D!QHt$D?b1A$|_'Qh"""CL%3XHJ,"K2b9XC%‰"@l$6-Vbq8H"G1$q8K#%2qJN\'n;!xL!鉌D&"3Jd#9D."7K#D(Q(N J2DYQ@T$>#>'*D5:QM4$.DWуM@H#b1A~D J%&sy|b XF N',qB\%;=>xH<"OsǶ/HD|@|H|L$%)D"=Hd&ىDNQ(I"UjDuQE&VDk іhG|A|I'":݈D_џ@ $~"?!Pb1A$"M!㈉$b21JL#3,b61K#+5DED;]AqBN$n7?D")HN&D"/O D(Q(N JD,Q(OT *D*QN j:D]>рhH4"MD39ђhE&mvėD{ёDt&]nDw ыM|O@H!b 1L !Èb$C~?@D(F% /Db1BL%ӉLb1C%BWbXB,%+*b5XKD4q8I'.:qM!Gc xF<'^/W?Ŀ{ہD"C"11HJ$#RiOtDz"Dd%9D."7K' BDaQ(F'JrDyѐJt#=owD/GїG ??Ÿ""#b*1N fb.1O, b)XN Vb-NDDM#&b3Jl#;.b7KF#!0q8J#')4q8K#U;qA"nw=>xH<"Osv0HD|@|H$&>")TD"B|Jd#r9\DnQ(D!ňD% QFT'j5ZD.ѐhD4&͉D-хA|C|K&H— Fxb 1DL&ӉLb1X@,'V+Ujb@l&[mnbO N'3Ew:qE&w{}xD<'^/w߶CD"1HA"iOD^"(H" ED1$Q(KT$>#>'5D#1фhN D7їO ?!Pb1A&`"D(-9Q-qHCr .vb;CcR”e2IV(sy|eDY,S++*eFYD(:eQ٦lWv(;o>er@9V)Ǖ5rGW*/+FSKy?G)DʇJ%VɪPr*JRQ\TQ*ՔJ-RG4V+-/DGB7= 7|? G0#`$@0` L0Xa ,V*X ѰV;a쁽p!8 G(pNY:7܆pCx9ox >$D> CjH @:YlJv%SɥV(EbJqRF)S+gJ%RUPj*J@i4U+-J+KA|tU)=^JoGe2DRF+JS&*S4e2SQ( *eD(JNYlP6)-VeK٣U(r\9Q*KerUTn){}RyV(ϱdJr%RIV)镌J&S%MɮPr)%RX)SJ)ϕJURCRj+uJ=@i4V(MfJKQZtS+=wJ/2RQ%@* $e2MV(sycˏ-Vju6F2mm*/'A*H Y SɥU)%rJeRURj+uJ}Hi4U)/J'S^AQU)~2Z T`e2NELR*ӔLe2GY,T)K2eLǶmۙ$oll9ضm۶mo1YkSϣau6 `7}pQ8SpY8\+p M <'^+x o ;9/y{ع0^>"x[vsv۽yxs1?o?C a ,"QFt#ӈe6qFB#Ha629F.#o1ŌFYQިhT2UFQhdm46-VF[l0zF1a6 dc1՘f6sy|cXd,6ˌ c`l46-Vcm3Caq8a4N%qݸa2nXF #Hc32YlFv#m1 FQ(i2 FeQݨe6FFcha26F[h 5F1a5) c1˘m5bcXm1cll3v=^cq8l1njq͸n0nw}xa2^_ow n0BF#ވlD1ьFL#ۈk3 FR#He1F&#i2y ?#(`a4 %2FYQިdT6j:F]hb45͍VFkhc7:]nFwk 4Hc1kL0&S4c1˘m1cXf,7 Fcn0v{}q8e\17-qϸo<0gsxe6>OgiaؿPFX#шdD6QFL#ۈc3 DF#Ha6itFz#dd6YlFv#c5|FQ(i6FQèi2juzF}hdm46- dt6݌Fe3A`c1f#8c1јdL53RcXal466ce6cqs9\t8WMsyOgf|7~?_+D0#i2BaF8#hD1эFL#Ljk3 DFb#Hc5YlFv#c5?F!Q(j3%F)Q(g7*JFeQըfT72j5ZFmQרo40Fha7:NFWa4z}F?1h 2C0#2#(c1oL2&SicXn0knco0q8n0N3yqٸb\5׍Mq׸g7xn4~F#m1F#Hm32YlFv#m1BFaQѨlT35F#he6F/o 0 Dc1٘bL53|cXil6[mvcm1uqӸe5Cxnc0^d|5?Ư*c5tFz#dd39F#Q(l1ŌF Q٨bT5ՍFmQרg7F3he66F[n=F/k3 c1j 3 c1ݘa6 Jcdl1q8l1N39qŸj\37[]xi35Ɨ:hD2"QF,#ψo$0F#Hi2RiFF#bd59\Fn#g3?BFaQ(fi4J2FYQިbT5ՍZFmQh`44FKhk3F'jt7FOc5@cd4Fcq cXk2v{>cq8d6Gcqq8e<71^7[`|4>_+LH#c5፨F,#d4ry|FQ(l1ŌƟF Q(k3JFehj43mFk 1Apc1c5dc1͘c5BcXjl6v{>cq8h2G1q8i2Ng9qѸd\6׍{}xd<61^/w{d|6_ow n0B0FX#шb0bF\#Hj$34FZ(mT1Ռ_F Qۨc406MF hot0:]nF/g7A`c1fApc1e6cqxc1Ři5+UjcXg76nco0q8e6Kuxd<6/;_b|5ߍO n0bFB#Hj62ٍFN#c2 EƟF Q(m1FQըa76MfFkhk3:Fn=F/d 6Ì@#i2cX<`;ݰ~<^+x o- wwB9aNd'6x y\ _J@)(U:5&ԂPB= 11A'aL0f\X a1, VX a#lpNI8 2܁3x>g oAp!!0C 2Dh@\ !$$ArH!dL@V9C Ba(E;_7D tB9N 'I$t:ɜNZ'dwr89ߜ rB;aN8'щDv9ѝN,'ω$p:$NR'Iw2:y|N~S)wJ82N9SѩTv85N}itZ;N'tw9@g3 u9Ag3ՙpf:g3ϙ,p:%RgYu9[mvgs9q9'%sŹrn;wο|w~8?_'J0' Dp"9QN4'Ӊu9NB'ItR94NZ'dq:ٝN'S)r8%N)S)s;JNeSթTwj85N]i4wZ8<]N/g3rF;c8g3љtf9 e gYlp6:-6gv:as9v8sݹtn9;]sy;_wbs;0NX'Dv91N'IpR;NV'x^"~Bl^26w^c{Y۫sl'W^=c{4{#Wޝۻ1b{ylI,t ݄BC)z }B?0@(  C0a0B)F cqa0C)f s"aTX&6 aM.v pL8.N pN8/\. WupS%w3Zx+ 'E*|~W`B!Z# ᅨB,!BH)R iBz!I,d مB.!PH(, ]ǻmz{V\oQq)']zJ\o7q"Cvv qכqw7 #Tx&<^/;_ !Bh!N/D" QhB !OH,$R BV!PD(* %B)PF(+* *BUA(t: ]B_a0E!f baTX&,V5ZaA$lv;]naW'N pN8/\. W5pK/< OgsRx%>OW]!~W`Bd!S%qxB!TH&itBz!Y"dr2BYP^ T* *BUPC)uzB}Ph$-4MfBsRh%mvB{I)z  a0D*  a0B%cqxa0I"L ӅLa@X(, KeraRX/l6 ]naW'DžIpZ8# EpY"\ ׅ-pG+ #Dx*<^ A(|> _owS_ B!PBh!]!b qxB|!DH*$ )Bj!VH'd EB PV(/T Մ_B PK- BcLh.Z ւVh':Bw!@!z } a0D* Åa0N/L& a0M.f &aE*l ;=^a_8  cqpR8%\ ׅMp[# CTx&^ wGE*| ?0\!B 0B8!A(D" фBL![' $BR!\H%d لB!O(,T 5fBsJ BGE%a( & aPX$, +UjaVX'l6 [aK+ G1pQ$\WkupWx(< I,| +Q!N/D" 1B,!BH% BF!K/ "BqOPJ(- BP]K%uzB}Xh"4 ͅBKZ: .BWK-  a0D*F ca0I,Lf3aBX)V k FaY! ApX8"gsypQ$n pOx"< /E&|~?_8J-" B!\H+2 ,BV!S' BBP\()J eB9PA(TUjB-@h$-4 ͅVBNh/t: BM.z BO/  a0La0J-& a0[# EbaTX&,V+UZaI* ApX8&N g9pY/<Og$Y.b xB|!PH$$ ɅBJ!ZH#2 B!M.r B!' ńŸB PJ(- BEPY"j :B]P_h 4 MFh':NBgU&tBOa0H& $a0M.f a0O/, raRX-6MfaU&lv pP8.N gsypU.n p_x < O3Rx#BH!^ D" B4!G+$ IdBr!RH%d 9\BnPH(,  %B)PF(+* ՄB=@h$-4MBKZ: BM.=^BoW$  a0N/L 3BaXX",V 5aU!v {}~pX8* W5pK- OkV |>W`Bp!R#" QhB\!PH$$ ɅBJ!ZH# BF!M.r B!P@C(. jBu/PS%uzB}Ph$-4MfBsJh- 텎B/W$ Apa0^ L& )Ta0K- BaDX*, 5fpP8.N %pM'< 7[^ |> 뿒 Bt!S%qxB|!F d2 لB!K-|B~PH()J eB9PA(T* UBMPG+ ̈́B Jh- mBE*z }a( Fa0N/L& StaHX,, ˄:aA( ApX8" DžipV8'\n w}Tx&<^ NWx/| ߅JV D" фXBl!OH# B6!C)r yO((E?BiP^ T* U_B PK- BCLh.Z B;W'A`a( ÅHa0Z Lf s /W])4HBd!U%qxB|!PH.R iB:!A$dYlBv!S%~B~PL(.)J B%PE*Tj uBRh%6B[A(t: ]S% Ä@a0B) LaTX&,V+UjaNX/l ۄaK- qpZ8# +UBWx/|WڰB!Y"D хB,!_H $ BZ!S BBPL(.) BP]K! BL BW]z=^BoW'  (a0Q*Lf 9\a@X",V kuzaI,l ۄNpP8$DŽ p^ \. 7[mpW'Lx!^ W aBx!M. BJ!ZH#2 9\O/ B)PF(+ BuPOh- nB[#  a0R% Da0Y"Lf 9C PW' MB+Fh+: ݄BK/  C8a0WX , ˅*aFX+6 [a[+ pN8/\. upW'< \x! _¯\!aHBd!G+ DBb!\H!B&!E*d "BQ?PjC]oh Mv ta@X(, ˅JaNX/l6 a]- 0pN sy'S)u;%RNiSѩTv8UjN}i4qZ:tz9>N_3 r;CaN3r8㜉$g3řpA8GSp9 \pCx xo|/~5DH@T ąAbH)!4Az 3dP C( O(6ԁzP@Ch?:B' ]t=>A `L0< `!,:X[`+lv. {`p8 83pu<x-[Q!DbAl %t2AV!\@^| P Aa(E %$P*@/5Ԇ:PA}h 4 CK6:Ag`( `4q0Ls`,VjX `=l!8 g,p. Kxo3|o~¯߲0"@DQ!.ăB2H) =dLBP@Q(O(%2PAy*T&ԂPB=hoh M)VtA0 &$ S`*̀0 f a,%rX`5`+]8 G(pN) W*\p]!4@Sh-C'ݠ;@ 0FD S`&̂y0BX +`%5`3l  a}p8'4 pu7!< x o_x#|~¯r"@D!:Ā@\H !$ RCH dlrAn(0PJAA  ! M4Z?v:B'zAoa !A0FHa,043`6̅X a5> p 8 p M ><Sxx|O~+"@D! DhbB|HI )$@V9 '| A( Š$ PB55&Ԃ:ASh- Bw CaD S`*̆Ev #p 8\kpnm ><[ |o~r@X!DH@41 Ć8@BH I )$RBZH!#ܐPJCY(TPAu5Ԇ:PA}h M)4VC7zAo` Sà0BX+a .EW܄[p=xO~e}/zl^/zy_~x˾^.qy=/2?/޶y{y7z<ޮݮ~ޛv?.?o'+;?oޙx? y~޾ݒ~^y}݀~N~__?~ޜ泟wOyww?y7~ޝD~<|江;~^v|.˓|^)'=}O>{yߓˑ|w#9y :܀p n ><x x/7>G |o~O[`BAD! Dhb@L!ąx@BH! $dR@JH! dL@V!\@^| P Aa(E?RP@Y(TPB 6ԁPChCh ͠9 Z?CG}0 `80f\K`),5z`3lmvN {`pY8\Kp57&܁px1< ^[x{|/w?+ C( a ,"B$ Q *DbC >$RAjHi! 2AfY!䀜 rC ~C B!( E(2PAU*T74ZAh =@/ }/0P c`,043`&̂0< `!,ŰrX+a5z{a#pq8'3puw.܃^x __~+ C 4C 2DbAlH 1$ C H 5 Aa(EG |o~O[`B@H! p"B$q!$ԐB:! dlr@N! P*AeUTԄ:PCh5Ch =t :CW!z@Oa 0&d a%հ:X`#l-v;a=~8#p 8 4 pn]_["B$ Q T@: !\@^| P Aa( Š8 %$PAy.4FZCݠ;`00 X `5  `7쁽80pN)8 g,p.% W <7>G |THQ!:Ā@\!PAq( rP*@ ՠ:5&Ԃ74&AK :C ݠ;@O }0`#a10&$ S`.,%rX+a5zal-v a}i8g"܀p n ><x 9/7>g_;t 4C!.ăA y /A>(0Pj@MԅzP@ChCchM4V v:@G tn 0FHa LI0f, s`.̃"X K`),ZX[al80p 8 .܇xx |OW_ !!0Ax!D(C 6āCH 1$ C H 5CY ;ܐPP C( Š8 %$PB9("TPB5A  4fZB[zAo}a0 aA08`2L0 `6́0"X k`-Mv;a쁽p8 8p N\+p- w.܃SxKx w FؐRAz! drA ~C B!( E('P@Y("T*P C}h  4fZ@Kh@[htN@Wݡ^0  S`*L06F ;`/cpN)8 g\pu7܆;p}x8p=!<'^G[`C 6ąxAbHI! @V9 'ܐPP C >v:@' ='P0X`1,:X`#lv `?p8 \KpU܄[p}x<W[x~BB( !D Cl I!#drAnyAA(('P JC(  p18'$p 1×ߪ"Ad1!Ć8A|H !$$A y /PJB)( e P*AUh%m=t='q0&Da Li0fLa̅y0BXa ,e6Fa lSp],E VJXa u6&a'cpNI85U!)$RB*H i!d̐ŸPJB)( e,P*B% U*TԀP jC 9B7='Aa$0a6,2X`5a=~8#p)8 g, p . :܄[pcxO%w_! p"@D :Ā B< $RBj! dlr@N!PP Ch M):@Wݡ^`8sa#lv. {pN8 "\p <'sx 5>G Fp!!p"@DQ!DbC >$CH 9 Av ~CQ(%2PA TԀP jC >4Ch-B;h#0 `,%*X aKpU.܃3x x 5OW?o5C!,"AdQ!:Ā bC! dlr@N (0TJԀP B= ! 4fZ@Kh@[hCa`2L0 `6́ERXaU`+lv. {`?CpQ ><x 9/%'Vp!!BF!ܐB>@qJB)( e,P*B% UԆzP@ChM%m-:B' ]+t='C pa, X k`-6acpNy w><Sxx | 8 BC <Ą2@F! dl rC ~C(%$PBe MzA_a( c`,0&dSa&́"X K`)6V;a=~8#pq8܆;p}x g_|~V'@X! DhbB, q .$DBv yA~@Y("TP_PjB- u.ԃ@Sh͡V v:@G tn^@_a A0PaQ0XaLI0TāY0\a,ERX+`%հ:X`#lͰv{apa8GpN8\KpU܄[p]< ?ÇBAx!D(At1!Ć8A|H !$$ C H 5C 3d C 7䁼 ?? bPJAi(0A  a*L0flsa9 ;`'}18.<[x{|/BB(! DhC!+dP B!( E(RP@YUTB;h#t.AwbXKa956&;`'ݰ>8sp .6܁px1< x 5>ꇂ0Ax Q *ąxB2H i -PP@Q(šTJPjAmuԇ C zC ? A00 #`$08`"L0La ,eVJX k`]>8p2\p ܇G^kxo_5!P@X!DRCH!d̐Av9!7?RPB9("ԃB#Ch-:A z@O0FhcaL0"X aupQ8\pcxO<W>G |o~ "C :Ā@\!$DB69!< BP@1(%P*B% U*TPjB- 4F74&ZBtn>Aa 0x` ̆9VjXa+lv. {cpNi \kpnM܅{px 9/%;>G |o~O[`B@Ha DbA\!$D@RH!T@ZH!d̐B69!䆼 ?? TPB5A 6ԁPCh)4CG tn'Aa !0 ! caL0ta,Fa lmv `?Cp 8 <\p 9 > ;뷿Ap!!0Ct 6ą@RH!T@ZH!dL@V ~ Aa( Š8P JC( !46AG}0P0F `<3x/7·ߚX@\!$D@RH!T@>(0P ßPJB)( e,P*B%UTԄPB}hoh -B7}/0&T;a 5K #d̐ CQ(O(%2PA2TPjBmuԇAh C]t C`( Q0XaLI0T3`&̂0"XKa,VjXa]^CpQ8g\pnx 9/% |o~O[B8 "DB41 ăBRH)!4Az!d,rAn ?? PB1(B ( 4P*@E TjPPjAmuԇ@Sh͡V v:@G tn@a aA0 &$ `:̄Y0\a,ERX+`%쀝p8 8p98\+pu7  D@T!ĄXA|H !$$ArH =drAn( E('P JC(  e0!!4"@D! ąAbHI!9P C(%$PB9("TPB5A 6ԁP@;h#t^@_` !0 `80bX`lq8 2\[ ^;|_ 2D bC !$$ PJB)( e"Tm-@W!z@O} 0PaQ08sȧX;`=8 \kpnMw<sx #| ~kBB( a CjH =d 2C 9 'ܐA((PZAh =t :C7zA_a @0 `:̀Y0|X a V8<;x#|~:0' u;N$'ʼntb98N\'I$v8IdNj'2?wJ:NSީTt*9N5=5ZN]i4s;-N+x9iw:8NNgۿ:NO p:CQhg3Lp&$3`6́w{ogǻc}c[y={<=G@1Sޮˡޭˠ޻%O33,c1ǘk3 "cXj,3+*cXg76Mfcfl7v;]ncg0#Qq8i3.׌3xi1/Ʒ!k3F$#ňjD3bF\#Hb$7RiF:#hd22YF6#(b5J%FQ(oT0**FUQèi2 FFcha4Z hg7:]b 5FXc1hL2&S4c1Øi2fs"cXj0V덍&ck3G1q8m1q͸n0'3d|6_Ư1e6F#ɈlD3b1XFl#׈g7 DFb#Hn0RitFV#(h2 EF1Qhh426MFK`t4:.Fi6}~Fc1d 6F1a4F1Tc1ݘm,0KeJcXol06[Nco0G)q޸n2^o;_n0~NF$#ՈfD7b1XFl#Hh$2I4F#f7 EF1Q(oT0**F Q˨m41͌Fkhc5:}F?1b 5c1m1c1ɘlL1ӌq̸`\5nOg xc5WFD#Èi2bFB#He6itFz#ld3~FAQ(i6erFyQѨdT65ZF=hl45-VF;ht2z~Fc1P0F `' o]AX :Āx@BH! RCH !#d̐Bvvnnˎn^Nt{)Tg3ݙrf;sy|gY,v:˝gYlp6:[mgq:s9q:ǜIs9u.:s۹u;cysu;O7?݃9NH' u9N$'ʼnp9$NR'dt29,NV'tr9~N>'S)q9ŝN9Sɩv8uNCiw:8-vgq;Cas9r3W^.xm@\xjW^Zx:G=4?37yxzzx5 P%ǫKҞ26&K'xwz@-Ochf4-}hCk}hC[އ>t}CW݇zӇ>|D&0Ň>Las}|ȇ>,a|X Vʇ>a|&6Ň>la;}p>G|81p‡>|%.pŇ>\|='><}x+^Ƈ>}7S‡>!a|C\ć>!i}HC&2Ň>JP·>T|CP͇>C jPLJz>}hCKZڇ6>|C'݇zӇ^>}}C0̇@0އ >La3|0χ>,a|X*6чM>l}8Qp܇>}E.pه+>\}Mnpۇ;>}xCć><}xG>ŇZϨ>D!1|Cȇ>$!|HC&Շl>d!9}C>P҇R>e}(Cy*PчJ>T|CM|hCsCzˇ>|0ȇ> a|F0ʇ>a|$0݇Y>aK}Xr6чM>la}nׇ}>|8Qp܇>|%p݇>|cԇg><|x;ɇ>~W`Bp!J-"QhBt!S%ɅBJ!ZH#r ~B>PP($EbBYU}CMPׇz>M}hCsZڇ>t}COC}HF0ڇ1>a}d0͇>a}ʇ5>a|f݇NaO/ DŽSipA$\ ׄ pK-kA&~W`Bp!R% фBl!O/$ dBr!RH%B!Y. ~B>!PB T* 5:B]Xh"4 ͅB+/ NBW]!z >B_0@(F c8a0Q$Lf 9\aHX",V+:aU& 1pZ8#WpBx!_H $ $BJ!A(d2 YB6!C)r yBPX(&J 2BYPI,%j BPOh,4 ̈́B / nB__  C0!P #(a0F+ a0]! BaLX!V k:aA$l >ap@8( DžIpZ \. +Up]! Hx,< τNWx/|> \!B B!E*Db1B:!A(d لBn!O/! "BQP\(%er_B P['4 ͅB+/ BGY"t ݅S%C a0F+ $a0E*Lf3y|aPX$,V MfaU)v {>p^ \. 7\x+>O/B)ф8BR!B"d مBN!O/ %RBiPV('* jB PK- BXh"4 ͅB+/ B]-  a0D ca0M.f |aTX&V aNX/l6 -6aC+ CapT8.N sypQ,\ ;SVx'+> w !0BL!HH!R 4BV!]!r yB!PD(.) BEPY"T ՅBMDh*4 -Nh/t: B]'  B0Z#L ӄLa0[# JaZX# ->pH8, WkupS% OWNx/|> /7C_ B$!E&Db B"!DH'd 9?!P@C((EbBiPA,T ՄB PK- B#Z BI,t ݄~Ba0P$  1da0U&f a0O/, +a^(v >apP8$\. W5pCx.#^ [I,| k`0!B) BD!E*Db B!O/$ IdB*!N d PB(%JBePU.%j uzB}Ph$-4 Vh':NB!@!z @a0D*  a0B)F Da0Y"L ӅLa0[# "aLX.V kzaI, CapN,\ 3Bx)נB(!V'"HBd!M.qxB|!HH,$R)B!U.r yP@C((EbBqPV('T* jBCXh"4 ͅBKA*t B0T&&Ida0CX ,V+Za^ l6 -vapH8*N [Dx.#^ 7[I&|~?_58V$D фB !@H($B!A(d2 YB6!W BAPX(" ŅBiP^$T Մ_B PK'-4 -B+/ ]B7a0La0J- $a0U&sybaTX&,V+UjaY[a]~80cp.% W܀p ng܇#xj2^Ogf|7~א`F8#ˈm1IdFr#Hc5 FF#bd5rF~Q(d6EFIQ֨lT1Ռ_F Qۨc5FCohm3F'`0z c1e6c Dc1՘fL7f3cXi2VkFcc7Caq8f7N'Siq8g7.W q۸c7ύKxc5G f7BaF8#ɈlD3b DFb#Hf$7R)TFj#Hg72LFf#fd7BF9QŨj0j:F=hdm46MfFshe66F;dt6]nFwg70#2F#QDc1՘fL7fcXn4V&ci7ǍIq8c5 q˸c5/+h|2>?_kX0#ňfD7b1XFl#H`$1ɌFJ#Hkd42,FV#e6?F!Q(k3F%QŨi2juF7mFg0z}~c1b 5F1i2FcYlc1טo,2Mfcf1Caq8n0N39qa<x_xocCq( e"TPB5A 6ԁPChoh M)4ZB+h :@G+t='ca 0&dSaL0flsȧbXKa,VjXkal v. {Cpq8 p.eW\pnmw<^kxo #|7?'m\0! 0A 2D C 6$dRB*H i!d @V!ܐBI( rP*@E TjPPjAmuԇF74&A h 5Ch =t C/ a A0Pa10xaL)0rX+a5z`3l   Kpkxo|O7?oC 4p"B H 5 w`V.n$Li A@ %An)AA BA$Dhlk\|fZ{s< ((<OB1(e,PAu5ԁ< M9-%B;h#tB7='«^ס? 0ހ0›0 [0F0 F `"X KcXaUB :X6& [`+lvg >pC5|pQ8G Ni8g p.eW\pnm{;Q *DbAlq!ćAbHI!$RAjHi! <AF! drAxAuBMhM4WV@[h#t 0fbXKcX+ag<\0b&ex&Ih&Ij&IeR4&Igқ yd4LV09M.1yM>ؼlin^1-LKʴ6L{t4Lgt5L2M׼j릿`A 3 1C͛fn2#HeFw3֌33L23L3 iffk3|,0 ͇#,6KRYffYeVj֘fYo>1W|g9gΛ 撹bk憹in掹c&abX&cx&I`D&Ibd&IaR&Igқ yd4Lfd5Lv4Ln5L~)` GLaS5 y3M SҔ2MS$CH 9 RCH =dA dlr@N!PJB)( e,< TJP@U/@Kh tnz@/ }/ `00{0,!|`)| `9@(u> >]9=~A{8 g p.eW\pnmwAt1!Ć8A|H !$$Arx £P *CxB55Y 9 u.</PB#h tNކQ0`2L0 xfrX+a6& [`+lvgpOp Y8"\pn- w=@4 6ā@BH I!$ RCH x2B& ;䀜 #P C( c8< OA1(%$PAy2Tg)-6A{ tnzB/ }/CaL0f,XKaO`| al-vNI~3p \kpnMܽgR :Ā bC >$CH 9 RCH xjAG tnz@O~a A a0ކQ0ށ10`2L0 s`.`>,!|`1,1,V*X ! k`- lOa#lͰ6;`'|s{a|K8! Cpq8gp5{( bA|H!<!䁼"PPJA( OCyT*PjsP@]x^zP^Acx@Sh͡VC3t z(  `EVA( lOa#lͰ6;a|a}/0  | pQ8G8 sp.E \kpn35*DbB, q .$DB6 7䁼P #P C( c8<U< 593a!|"X Ba-6&8 2\p 6܁L ąB2H) #d C /0<š< 59 uh͠V@[htN@Wݡ'0 `|`,B`- lͰ8 ?i8g p.eW\pnmwB41 &ĂB< !$ĐB2H) %ԐC2AfY!drAny!?<  << < OA1(%$PPC2Tg*Tg&Ԃ6ԁE%h 4 4fZB+h mt.Aw=>^~a 7`0 0ނ0 \ \gFTH!ԐB:H drAa((GqxAyTjPjPjsPB;h#tB7Ux ^00Pxpx FHxFhxXaLI0Ta 3ẵ>| `!,V*X ! k`-pC5|w=#pOp N8 <\p . :܀p n{ϻQ *DbB, q .ăB"H I )$RB*H i - #d̐B69 0PqxPJC( OC9("TPP óPjsP@]x^ԇ!4 4fZ@Khm-Aw=W00Pxނ0ކ0`2L0 x{0,#Xa ,a, k`=|S`3l  n _N8 \gf >ԐB:Hx 2C ٠(<Š8P JC(1 M4zB/ }M#aw` q0&Da ̃>|GrX+a5z .B|k(\kp n3+ DhbB, q .ăB"H I )$2B& Y +d<A~x @Ax C( < OA1(%$PCEա< 5<ԅx+ZB+h m-:B' ]+tzB/ }/uca 0 & `:̀wa&̂UB` u>Oa#lͰ>_8a|a8g\̎q!>$2C ?< "Pq(šRP@Y("Tg*TPAw=!0ށ10RXaUB ZXF [`+lvg9=p+8|cpNOp NW\[p{DB< $$ArH 5CF!7|PPqxPJAi(ei(TJP3PAuBMAmuyx^zP^Ach*u` 7`0 0ނ`-lOal-v;3^_~A| |cpNI~3py\+pu7܆;pQ *D@RHAx2B& Y +drB. uyh 4 4f^ZAh q0ޅY0{0‡,Űǰ X `5@('> 6 `;쀝a7%_!o{8 G(#4p2\p 6܁A 6āCH d,C 7䁼PPB5 Am/PKBcx+ZBhtNBw=>^~a A !0ބa0ނ0FhxXa"L)0t3ă90ރ`,#XcXaUB ZXF [`+ly!P JC(  !4 +ZB+h m- 0›0ނ0xaL.̄Y0|XGX 2X+`%S`3l  s {a|K8! C5|a8Gp~3py \|B41 Ć8A|H !$$ArH)!Cx #d̐B69 'ܐB> <0(<TjPZP@]x^zP^Acx@Shh5@Wݡ^@_@o`CM-#mca 0&dSa: 3a,%rX+a5z6vI8 W&܂,HI T@V!\B> <0(PJB)( e.< 4&AsxZ@Khm:AWݡW`:̀Y0\x|x>>`,%>eVJX!Ba lͰ6;`'|`7쁽AC | a88?)8 <\pnmwYBL!ąx@BH! $dR@JH! t2 <!d,Av9!<A~x @Ax C( OA1(%$PrP*@E <UTP P"ԃ4ZAkh t.zk: 7M#aw` q0&Da Li0f0\}B>ERXaUB ZXS`?|  Wp{8 G(pN# sp.EW*\p n{χQ *$ 2C #P CQxǡPBy <UTPjA%h #W Ca80`2L jX6& [`;쀝}pB|kp NIN8\Kp5 6܁|B4H ) RCHx 2C !\PSPJ@I(4&AsxZ@Kh v:B' ]+tx ކQ08`"Li0bX a=_!o{8 G(pN#4pW=At1!Ć8CHY0P JC( "TPjP0&Da Li0f, s`.|` | `9v;3n{a|K8! C5|w=#pq8'~SpY8 \pnmwYAt1!Ć8A|H !$RAjHy!?<  <0<OPJAi(ei(TJPP C xjB-xjC "ԃ ZCh#t.C 7WCaa 7a `aw` q0&Da Li0f0fls=a,#X+`%6F[`+lvg >ݰ>×pB|k{8 G(pN#4p.E \kpnM w=K@T!ĄX@\!$D@RH!T@ZH!<C2AfY!drAny!䇇G"PqxPJAi(ei(TJP3PAuBMAmuyx^zP^B3h@ h 5C3tnz@OWCaa 7a `aw` q0&Da Li0ޅ,GЊZA#hm16EжAGA_DЁ:AG:A=t~SN{:鬧s{颧K.{骧k{馧[n{鮟QxMODVOtsz93 9r@g3qSV+;=xg㮘Lsf8:}抹f[>rug=j^~qǽ^SvW}jryǽw\vV_qշ^*$q=B{^! It϶3+$~Ƅy^{N sc2q]ێ{|B9Sitg3әs>t>r9e g q8OM6=! quCg͐Η,X:=!qqBc>9=!1qqY=! qC{{Cn9%Z{q_Cc9&pcP>-=uBPuEB;99N'yC#Na~懺9yZqσPZZթB{.q:/:y9yq}h{P^;CkZ{CkI@gP==qu{(=Lr&;y:qσP<qs!}|,t"='Bs"tqϋPuϋPgqϏPuϏPuύg{~G>=?B#=/B"=/B"=/B}W{ uϱP uϱP =גPZzɹ :܀p n{Ϛ C ąxBH 5dLAv9!bPJB)( e,<  4&B;htnz@CM-#a40Xa:X6Vpo[Q8 ?)8 g, p.eW\( bB\!$ĐAJH! !<P #P C( SPJ@i(ei(TJP3PC xjB-xjC C#h /Ch@ h v:B' ]+tzB/ }/ 5xC`( `8#`$ `6́‡V K8ao;8G#py*\p{6D8A|H !$@ZH!<AF! drAn(< OA1(%Ԃ6ԁ</KBcx@Shh-z@_x`oHxF `F$xfbX rX+alݰ~!p 8g\Kp57&ܺgct!$yռnflF1fg&Ifc<3߼o>4EfYb2ܬ0+*ڄP`>5&l5sԜ4? 撹lk溹anlod&IaRAh2,&f&kaS4"ISڔ1eӦh*ja5LS47-L;t0Mw2M׼j!fy 3#hkƙfbifa},6fl5v4]s5͗ 3ߚ9jN̏9o.+檹f方&c&Ih&InR&h2&j&ir6r{l^sfc{_ٽOlvfٽnvfٽ~nvf9{ov7?y7܁lQ!D bC >$$C H  GqxP JC( OCy@5uxKAchM9 ZC;3tnzk:A#`$ `,LI0La.X C-l}>?mqa[kŽnmq[[ŽnmqY[^o{Ž>oqͷw[EWહfkl{3 LB$1IMJʤ1iMz<`4&b¦y4Ԭ0jj֘ fbmfef|i&2_asܜ5ys\4WUsmML6qM<$0 M"$1IM2ܤ4L֤7Ad1YM61yM>)d "ij´1mM;t4Lgt7=릿`afyی2c303׼g}Y`",1efYiV&Ĭ1k:|b6fbmfe>73As|k3ߛ9jɜ5Es\6wc{$0 M"$1LrҤ2iLZΤ7LFd6YLV2MS1%M9ST0M%ST1LuSbb&g4&Igқ d2&nr&k)d "y0 GfYl2ܬ0+*b֘f̸L(|E(~}}Wg}δ7LGt6]LWt7=LO6}L_g^3ox 6CPf3Ҽ`m1cX3Ό7D3L6ST3L73̻fe>0 GfYlfYiVfYo6-fffg0M|gGsʜ1%s\5 sM 2qL\7 LB$1IMr¤4Lj֤3Myd5L6yL^7LA)d ")aJgL547-LKʴ1Lg0=M/3 43ԼmFflifa53,35yfy,0 |l&Ą5fYo>1̧fbmfa>3{>o4Afќ2s=QLTD71LL$0Lb$5LjƤ5Lzd1YM609MAS5 )f)eʘMST2U3fES44M δ7Lgt5Lw2}L_g^3 3܌0#(3ڼcƘfjf'45 gC8[}q||븟{wg=s=\.f[Q3@q 0@$ ,@) *@i >@ Kr o|x8@P$ x'P"@ P6@TP1@ljx> ^ B#h /CShNp:)g8N F!`DFc0!L0%0',0K|`M`c`[v2@X uo|p#8x~cSN8ls.R+V}Lt0@I *@<d -@97@<Ox*@T P9@M4JZhu6hs>x=o`hax+o`B)X`a|`q%86|`cM6`G]>;{ ?*_6w8xN!\ p97o_D #@$@*@!@9 ;@y ?@ P8@E< P>@<FZjhiWt)@= +@ faN1`| &`J 03 ^yx?XX`q%8+ :@Hk >[l =;|`W7_ |.8hts.r+V8c0{??I 5<CB!BP@Qx')(%$PAyT* Ԁg&Ԃԅ%h14ZB+h m-z xPxpx FHxFhx S`*̄0{0އ2X+`% a쀝 vC|p W*\peT!$$R@JH! 2C !䇇  xAq( ,< | #X`%հ:XF [`+l|K8a[p ~p2\p nÝ{ƀCH)! < +droasdX} {)ϐaEG s7lca9CaD{;a_Ka>=Tu{0"̽wsj:Y/̽Wsžwg0.̽Os0 s0~ ̽s?Ú:?=s.q?-}. sϱQĈ%JQbDfN]lr -:wrDŽQbծv]jWծv]jWծv]jWծv]jWծv]jWծvO՞=iO{Ӟ=iO{Ӟv*˟s9#YSͩPurN;gq{Fr77gsysѹ\v^׽u{^׽u{^׽u{^׽u{^׽u{^׽u{^׽u{^׽u{^׽u{^׽u{^׽u{^׽u{G{Nwӝt;NwӝtsQ矻ܫ⚦`Fğgҟ;/8/:uu] sd7WN߯;_N:uԩߺ""""""""Nceԣ_i4s].߽˝Ͽ%_{Ӟ{?hG;]3r_wNwQ"sQ}ÿ~ᾙvhG;юvDs??vhG;юvhG;юvhG;юvhG;۹tnpZ܉d3|w7JQhNt'ӉewQ_?vv~hqZ!ٳgljSVVVVVVVVVVVVVVVVVVVVE\̸kᄻin!_yY?~8 N"'I$ӽu{/]?/Y]B;`;uτ`OʿwRծv]jWծv]jWծv]jWծv]jWծv]jWծv]jWծv]jWծv]jWծv]jWծv]jWծv]jWծv]jWծv]jWծv]jWծv]jWծv]jWծv]jWծv]jWծv]jWծv]jWծv]jWծv]jWծv]jWծv]jWծv]jWڍ$Ӟȹ~FhWծv]jWծv]jWծv]jWծv]jWծv]jWծv]jWծv]jWծv?^GS$8wVN:uԩSN:uԩSN:uԩSκ"ӿ:uԩSN:uԩSN:uԩSNݿ}L%uԩSN:uԩSN:uԩSN:uԩSN:uԩSN:uԩSN߳srR;iN:'-3mDDDDD"z]n~O;0{:s]Gy[:uԩSN:u_3n_W#IuNHxdq:"p_OC׽u{߻wz:s?UVVVsם`@g"o"Cwu+;zC7M 3~~'?k{tvF9իWݏ9R#Cz }իW^zիW^zիW^zիWo>sd{,ԫW^zիW^zիWwW#D:u^g'""7Y?S RS)U^zիW^zիW^zիW^zիW^zիW^zիW^zիW^zիW^zիW^z#q.]d{ԫW vǯʿ+|իW^zիW^zիW^zիW^zիW^zիW^zիW^zիW^zիW^zիW^zիW^zիW^zիW^zիW^zիW^zիW^zիW^zիW^zիW^zիW^zիW^z\7(xxg3QYYY3w ?OSwGψYףw͓L7>s:묳:묳:묳:묳:묳:묳:7:Oæ:9;O謳:묳:묳:묳:묳:묳:묳:묳:묳:묳:묳:묳:묳:묳:#zOּG79ӝλy3ۙWO:OijjjjjjjjjjFYk75555T”tJ92NYuԩSN:uULN:uԩSN:uԩSN:uԩSN:uԩSN:uԩSN:uԩSN:uԩSN:uԩSN:uԩSN:uԩSN:uԩSN:uԩSN:uԩSN:uԩSN:uԩSN:uK[~o3ԩSN:ts(N:uԩSN:uԩSN:uԩSN:uԩSN:uԩSN:uԩSN:uԩtS1N:uԩZL?{}(++++++++++++++++++++++++++++++++++++++ry6:NeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeH gfDdymPVVVVf63yoDKYͿ6iSթTYguYguYguYguYguYguYgu_0kQVVVVVVVVVVVV :LWyVSSS>ra:krsj:N]իW^zիW^zիW^zիW^WN.}W^٫SN:uԩSN:uԩSN:uԩSN:uԩSN:uԩSN:uԩSN:uԩSN:uԩSN:uԩSN:uԩSNݿǝ:묳:묳:묳:묳:묳:86u~y˽SVVVVVVVVVVVVӲY, #gd9sKNi4q:ʹ={͝W}k_׾}k_׾}k_׾v;y}k_qa6 {گ}s;7|6g#kk߿}~g/߱ǩ_k_׾}k_׾}k_׾}k_׾}k_׾}k_׾}k__5m~1itZ96N[tt:iWծv^d7׮v]jW#ƿ;ӎvծv]jWծv]jWnK!݅}~s?~_Sdծv]jWծv{!hک2gYrV;!Nh⡫MYYO wwzhjjjjjjjjj!XN/MMMMMMMG28[O&g >o}ىȯ36MMMMMM߬pvFgԩSHz ԩSO7#רN:uԩSN:uԩSN].kө^u)+++++++++++++++++٩|v8{A;GѢD5J(qLܴu6Mv~iFMunXQ>WJp N{ɣrF:E- Ztn1vF/jԼ\[p/wnG GenomicAlignments/vignettes/precomputed_results/exbytx.rda0000644000175100017510000324677112607264575025372 0ustar00biocbuildbiocbuildX[=EIK*!҈4ҡ4 %؉ b!؊AX|KDB<﹮qc9W7۽ݭ|49}8001Ӕ40v<O WQc=&ąӒ{pldxO#Z d{Bx|l(QcK e3zU_6Le/(e_x' O #h:XPhh}WXhCCC_װ c޾IAeo[ect`Б -D=f9vD·+76,^{C2oh%/Ȧe[#0!Q}OGDr09tez-tzў_﷿/u07=(d) (s9[9Wk*c<š06xد4QI[-oX^@8)ށa^gQ^Dx[.>here# cA/! dD)ԟzdF%k s2A7d[EOA YЖ//YC箥۠ V[D^~gwNίgz=[oЍs6)v[T-!o31_k2#2dO)&I4]/.&H,3/07Tjo=WdkTww}܏*2}y>_̋4X-5X>h(X7,,`6:X,2nXRk2uXe6?XbQjgeK^L2]fu*URK*s(V^`ռZ`5tc?vZ+`_:z4'J`?͸~c}]ou`m`E`T6Oy-@l#u-P%mSMx-m#]lǪvlvtzGo|?^3Ā 59lK!s{v,2,G/,2 F/Kn-eevW]`ע[n8kZC?Vuҭvw{ݛs>}m>MB`XNl{=_gπ&vCZڢ/8f=ǼVpIk,?5]\35;\klp-V2Sp-? )ԗ׹+S:OczJzr}t+1=A4}w#0i={ :;ݓ߹SBڿ(7y[*/;Gz9xd#c'ٹ ﰷ#%z=xO4MO6xZ"a0x>Ok=x;;Cw6xWRoAf&wp1p _b0ƹo RoMgߌup|/N9w9k0 |ǂe}~02w R8w%?~ 'Ҿ)O-_-Ĉ~Oɡ3_O7࿶ x7)ދ /z],79-*?QOP &0C;v<~кu=VhB`J zwֆ3B XFdC<!p OCE=UC0zC03J = 9,h:gAp !;o09M@oBD!t[Ւ6 }ףO-T;Oq}W{ D_S5b8|ߏG 2rDFHDS!21""!2=܍WoOgּalQWh+D Z?7B暞i9¿ߛЫk>]c.k XQt zAL}t b!6z Ė@l)2^Al!bzb[@l/sM{R :y{"I^@?-~&\,VkE?璆~7tAUHȭD-HL琘E9 0e yC(>@bHPk /n y9s̶ȀfTybA[y?2rmu`nC~H zZo]S Z!B>Oמ5/~yiw6SIjgLo#XŃP<Ųj(uĺPkJ6P KPP,(֥a"Cl(R|PMJUt*JԻz~ù^=1pVbέyE(] zsh~ֿt%PwD Pek my'P4G(+-j(m$sluClӏFF峼P w(?:ґ{, WrPqYW xAwTp*Ԡ*zAeL,ף{?k+͡$T򣠲*r0 *@T|2\oPiʓPy4V*TVAuT_Aq9TߋBC T?{_qS\gԸ2==};ޞA b5yE@u͘ndO'DBm9BM;j\Pi%GCMM<vT~v3A-9ԆڨPUPXPˊZ'6އZq6ρPU }}vH?O]k=j/NTޛ.tmt=zPW(ʯZ3E, oCDWnJjPyP:#B#6<-QP3@} X@= t[C}ԫC%;&(b`bh-:(Nvuhߥ39A><{Lmh[&hhBc=[kCC 4]Ó^OCO:t4Cgt 7BȬc:{'At`*.BVn}7-} ]2mB7} A$z[w7~ЗfX }]qwq)B?.B1DCO1O "WoRo2Ҿ>b蟤+ _Uá_??W=~u_YQT:Oea0`9 @M `90U^ ca`Å00q{T`3`0 \`rDAP: 0H{q0<SRaG`ʿ;ߚ?KM1lMy&0XLߋM` 6^S=}]4-?'aPKU0Q l/. y; Z(a >ށ0h`qǞQ}Z0o6`uۈ/30-՚n`pKK1n5CR C ]a08CHro!f\9`,X: 0V> Ka<&01]  %0ٴ &'.gLn Llɽ 0i80yR0}Pia6}̚aֲ000yCoe]k%M0Ê0빯!7`0#uY>^cX)B,2PY2,,4,`a5myX|\]LQy`kbӇnŻ$ օdv%k+,ka;|`)}9)`)-Co{t,a\>Ђt·prc),wXX˒@XVee,h #"\ɂy86(x?͂mn؎ ۉ`;3Ga[] ;Rر]쒷l6y+Tثz)Z.ŝ`_)_r ݃&_5ckM:ךW<WAFppp~pJ |H=2]_N Cpk uP=g(wLu4dqdGpǤCpWqR}:e  Ip\{ XHqt8n%p%x*p< 2% _ p x _cĕ'p=NBlk$N).IN2g? N)I l32:#8Y[3i\-Ť#8iq/p:Y*m8S>מ pNθm Z"u:7nj oSYz,gE4洏gl g$8ًξp} onԹg g=sg ٹwͰk[BA(Z< !-4_ձOf˝\aNUI9N||C1Di:(cJ\ e! 2v9$9CQO{ )fb_( S4\\U.p p ȸk*.zԚz֟뽑kv_3dk %еEcv.(I+\|.qpKhӤ pt .S2-.Fט.uK%4\u(\ݧuzl>S0^panspG.k\pw#'ρ"9kˇǠpp=Կítc[E. ўkපz5g=pO= 'jܳf? z\:0E '0yCӖ;-ѧ1R#Hѽ~}_A=;,Y XՑX}vmxYe0W9L{ 3{|g&WN㌯O3܀q0fbXkG[b~/7`xKR AB$|A}!"HAqaJqZ> o@MCJA+AkLQo! !Ao"*ymo|յvbRZ`GA-P`62E6۞A_Gpd_^ᚈv!ij!3}2=Bf@suZ)gk!<-·J#|]E%/;˓/~1s "2LU[ (8bذ bk""b;ȿt]A D7DDy "Nn@D7"n?E$2D<ـ@QDFd#"c@qy'pkDMEKDEو< Fn# 0Xb0bF4#6bDqF<Bq9# "h/6>N@Wv qW.qqb\]yf{s1Zg#lC<@:^:Ŏ"^r&e#^V:M)Zo׺~.( ~&"gy0g?l4tK}^&յLL{"+QBg>{}NV>c3ˇ1ڢp(mO] v"awa,AHc?b ƪl؁I;hj`n"ƶ Q3Zo;m#v"eEU;::뵑ȅGbs$ĥL +$3d(!1s5c<ڻf/]XM>HL-wm!q_CV<Iz) OrHJDDc$MDR $I is{nf0MAHERn CҾ $LA!$DH*W@RuƱFb\t'c#q0d59b3ݑq0.(B`\*ʼnocG&j&ё¸I0.e3ƥ|1^ c&\p٘p56bB}=&\S=z"%L#F_va彶|FL9-%ab&i;?plpy%?&g1>&1&m$Ø4&y_äњƝ>k0}LsZlk/E붏km\I{w>=Zf I,Lo8 W'H9ɣ#d)lT70y1q)&;EbMLvO䡾)Lɝ^e100 &U`rpLSvZc5L)CQ)~~؁)0dT”HLd)7amaLiÔwv~inCR冣b )WbBx#ŝ))#4)IZH7)&H) ^"em0R9#pRRFVCHB]H0wsCʑH9z)ґR&[H9<#WQSH0)r ) I$GI1!L}ÉMr,-`4pRbYi1s4qcNL<ٱif,M0jQ眛r׼ܗgϞ/}^}aZ4mo0#?*@( Ɵ4Ao I M84HS+D@7i isBCsSa]'f~>#҆ ;i湠}Nej@ܕHw iV73o̘93Eb>fYbUf ,dz)6bV[< 1[Cmlj60lC#6em;7]慄s9jW[O)fsdx?ݝ0K%fVV߂AfQ1r{~wm0LO%aim>/4Ywa߉90sob1sLr1lc84`8 sə3r)36椭KsNY0wS]'_5ʘyǥy0Gb/a̳yB1o̫,Ƽ";yg&a^T'ssxnڦMйczŽS_H_+ʑ Y75/a(ҋd)Kc /X,ai_ÒĻKh>-ϖ’uXa)cɚmQXm-ǒM4lzbə ,9KΗaɅaXRZ#n)RX*Kec,eTrT+K HK-&`<1R X.CKK}Ea1XƔe q*cY?cٸeX^eaٓ#XlX#c9R,皁|1Xn&XKqˇl_,1׸6V،Ŋ!XqgV]\A+ŠAX+Zc3c+VYqX铉V/XX+:aXGQ>6`X9Μ49w͈YXY+,oұA+6bB|my ~)r:σ9!X%jUbӱMĪǪX9.6aU6dU[Oadqv&aծxj<}/Ps[cE}t)Z1 EPB:dxѶyci=n2"ced$GF6 cd, F&;2e 2  SGi8ߞL Bf,2lB'ȬvGf<2oC]'d>nAfd>As_dW|}Tz[m x(buQ+Vl՗auEV-sbfd)d39x̟"bhn,WȊ^LĈYq'0Yc#+1 Y5~rۀZ~~3 SEֺZBndmpA *F&o d8\v"k+d[G#f"m#;LniȞ.왗=k6ɶfJT׹ {}( =[ {Odۑ} }}.PS}Rb7)#=sKd>l?܌1dט!d>Az_z.Gv}+mEuadߠ{ٷ}{;r !ηsQȑ@lY|rG G 9ʚQqS#?k#'@r#S{ˤk=9ȉAu^"'3riϘ $X!'>r&oi gLǸV9EC9Ň9[m"y9#gr"gpSDHeXߙ3XnjArr*LU(rN@9yȹ >^z9"1E)rF3A_M@k-伡ogI3|F| E.T)#rg $r(n!?y9/֋ķ-F`DJ4;U Wux5rM2kJ&Z܆F]:Q4!י%r]; 7 Qȍ8ܘuI5j-r/"wL1еCnpԯ1BK+U|l͡3r/s zWϪ݋K}WzrEl&k|]zN3f l]ɟyF$6,Yϰy>6F;ѥD[M?EijIè-1b^lM߆+bk5l=!Kq[|#E[Xlxzc$l}CtbG;v-N);TNM -+켵;o; u(` #vԾr k ?vmM;͍]{(]d8v]5+rv]®Ώr=n$aMWI}O Q܎=*cv{İǥ{\fcϥ!sU{'`L"[,7;ٴ{Zd}_iu^fya^"5,^c5م35wr]5{3gbo-5ػv"^덽wbO{A[B{ߧ`A(틒9(Lq%=P`P{KJP( Eɚ*lENU(}tfC#Kb_/^g>]اc ;}n[oZ} w`طbeLžMOo?sؗ}kn]sƾtny>^Ev8wdbZ==?y7)`M .S{OOmǁ{p`NA88 g8XPeR(ퟌR}=iEzVŮ=-{wza|qp!g\:uxS3}CfJ7T7zQOuԐbp12މc2)8qLؠ:3qıBvǂp,Q=^Qhߣ{{ ?{ ~ǭct!9:{?3=uuuw߽<^KP>ePe<P0wLЛ eB(>չ+Q|FEIJSG3dQ& e PeQLeI(SقV7Q6hʴ(#JQ2Tyowz/n?(3rC̦\e(FhrRA]鳹Fk~O~F9<{ePGdG_3|ks|8'|2S_|.N~ދQ7TA[*B)>BrFE1*F裢2UҨ8炊󾨸 w_*y#).nTRt4*(^RR*PJ'TpmE[%*=Q=OG\uT G|_T. @b#Tu-FKm QY ֠TmGe/;*U@<;TF;8;UP%U!RBvʲ7l7n:PȊ*Tj*PUsQ5U iL?eu&׹g_W3v>3_NYv5zw{wu#=_wJgTGՉ*>zpUORP8ޚSދQuz)Zb7é8N5 T?NP(jB5Q.YMgUzǮO.cqZ-W8f%Nw p14]8E}{;Q&83gL8IƙqpfBLڍ3pfJΤL"eÙdYKc8S>gl)nُq㸋sq%㜠4=FGF¹w8pΥܲܪs1:sN\:[*{q^}XQ#F!53Pe[ԨGj TPc56Qc;5\xף)jPQo@Ma s֢&xjB'(j"Ƣ&zM73{5;5)YDs޶jΘ]\8QM=7jDMjסv۸- BpAb .4C-k"jټQKC-o .0 paA\j nPZ&׮5g՜Z]V_7ޮ5MyQkqPkG}ZFFg8٨}y-ȖF" .rOpQ`. 5qqDsp~).: E\⊋nqqh.z?g;h6#Zx]o-1\lx.<%h\2{K rpi?.mKUkq.HƥiԤK-p .}XuOU}z0\+Bl8}n17 ]vN\7zW?RnF ffnv nd-=ekPd.u9UsOph[kM8#٢oQ7TZ'Qn(n3궭ENDn#{+PW7uשq uePWquP"/9O^0B|P/܈zA9AX-_DoQlzuZkpv_ץq]c&r5q=? q}$n;eq'n0& 79|y.fym܏yg7V/EK[Ҝp]zT[qɫ-~H؅ۆmɃ.}=o-3w&q*wj^skh5ؗ Р-h>h}hp<=%Iq z4 ;`ÿw.hۈ1А̎ih PhY7 /r{;>m}}M~g:Gp_O pRܷ֫qf8}{;S)}$(ތ/5^{7clv3p75PZ84]P9$|p /RŴDX;/9e1^܏x` ^.+^Qƫ{cu4?O^u ^g8׋zqQ[׷8^Ss17x7)6ʹbI397{'y7sMmo͇x;@om~2b!-Lqor ު[ex݀zڢOBo-,gm[0ok92?)M/=U3_ {Gm=w~x2<οݰ[)F44Df4?^hZSxgi}5h݄Ƌx6/?C4^7x634>fh|5*_ ]m Mlh%?~L3?VDh,{=H;x=^;hƌh MZh:cCt\M_S#*fBT]{[tQME)Y`ߡYƋ'4Gs Ѭ8 s< ơ9&עy)Kyi4BsYף$xl4WsQBsm./od;hWhEI GUhU}4?/(o@hi47`$|襁!n<_QYa>ԭ‡k1} 뒩vw|ŏXOfEO⳪?> pCZia|V<'o)oh Xi>(2|S|Ɲ-F3yIU9r#WeE)ihsGDJ3U6;jVehGk5&45u+ZDk7h]'B}Z|~ja[ڐ)7Zi=3Z?/!8GF N @|;e9wgn?eE9W;s~߽Wsnοus\ߟ{ʯY7,E'pw}OWϒz?5ϒso]g|{l6}>^j=f9Pw @9(Ϸ|3#)D0sUL.&(ҢxNq!A 'tG}ڞ ('($GPHpΈz{{Fӻx?8wjbo@;!#F2k߷xƱLK%LLJ0_'L&?`%ڄa&ʲy`.a6!6}z²@Xf|k&a=ޘAX?  \Kv6GMDN&l2&SO;""aS}M "l)ubUCz׊#%џ 4'1]pcV1Xw`±|XF8Gd±֒ps!6zoyb_yK0&Yd_<3:tu~OF8v l͋p$K2t;E8pUҾ^@8D gn <ԛe[O8O7γ7 繹=Uyb.'\c W[%*A.a%kHf.لKلpi.m&¥p 3᲏$\zF"/k U}3^J|<^C3U  J/"UR'\,ϱ:kD`p0Rh_`p ).DJ"PfFLaT/%W )"Fg,1"}OiDp$PH7-}Dp93&N[ÈC=>&ND D9ɔ7Dh?IV!BD(˞e3Sl!B9~Dh/tDW0S>f#lVavێ5'%nDG#%ϔEO FL,YJJ)SdI߹ D"oDd\7YCDV uuqbw:EFO#"qD$1]5f#/qDB^ IDOXIp}>E[f؎%Dl+yOD"v|;@7m'[񭻈vXLw&{N񽣉$"0?~Eğj~E);y=?G]xF՞ >] ,zD?H8 cm+l"aC$ DbHpI$#a1D""?KdDy"s&2wG{DܟCd#2/؈!DJ}D*Od>:YEDSK^V8ZYkoȨDoYs"Cd(jlR<2ҿoiADv: Id >utƺD6Zґ8R!u&"{L'Y܄+m17&r~D.w-#!rS\q&FDF{AҊȽO-| "?ixZ~ ?n̏N" )"_6fFDLyC OK ':RjȀdcd@QLcBsTb Q% CQDp(<# Y&HMWtj\9-'m1ԏ(CG bDqT9ݛ'8 QLK'E QLˈDQ"3$xW(ޫ& '(9oJpd(y%$JᗈRQLjӉR,QNZƏ9 CZ Qq(͞K.!J-ҵ>D Q;(ݣ{z0(=^L#Jh[IL̒OY2,9%Q]Cm(neDY(!2Ej@Ք-DY׊(Ye͸ޟ() ʞLjUw(a%D9Ң}Cwuoڷ\Hg>!ʗra|Ô Dqrx$Q92&qD5W^'DZ9QlKT[tƣOxne9*JDus:κ/ߙ՜߹};c*1Qp)&j)RD-5MIԎpuIԙhȈ Q<H 22b%XH4ߔW>F4 $" Dc1riDc'QB7,?3ʟov?Pֺgؒ+Z-ǯ}~3Mр CE!L4w{v# E'5wnEȻN4$F} O|3ѨerM7dN4YfMDSєq#DS~ _=/L!kG gDs:kD3Khf? ki-ߨF4}DuD׆]; ;$x]?5? }?n 7эHqv=Dw&M槰#()R4 ER2Lb j  ~ ~'J {#YĐw1G }i_{Z'ڏ Cb(D CM+bL CP_HR<#S:oqbD gÙ?+Fbz (*zBozvϴ՗W$FYW|G>Ĉ~6NN&FQ 1֑+ۈbrh<(1֜Kwc_ab<@8Gr+b\AO"Ƨq%]x{ȕ|fg| =1z- $31%MH1"&Rib20bbkNL '1i˃4b9}]LLFџɘ$$m:KQOLm-1'~I17 'f܆ސ;Pnib=:oE+1/K׾' |ÜyS\ 槹 GuRb2PC,tˆVbaA,MbaXy ubtXx(P&.M,B6yb~%ԳY=ۓ~73sJE7XSMAj9E bqm8>?x}XĒ7K,veyR?Բ&˛J!bʐbC,3Oܑ2?X|rV߼gZyby,B,$Ok.bX2+b弓Xy!V^W;^+Ej1qjduXŖv$DibXe#V9>* ZD6#V}#߼1{y#O|<6_1PsbK@GҎyrn ?YAuAW8}`Ogf08Da-aaez8L'3Y~aNqKqgm 28JQ4G488#v28R>08Ǩ:HG)ǔq$q}8/iޥ?ao1:a0{D'VqkYq8k!BC)*Kde<]I\2:q'LĕZWO4`D$'ii6o"qmqe׉ۊms!Lvl{8+u[\xqU'Ľ_q;d܍>7;0]΄+rګ3{?9Iܙl?Zzθa{$w>ey * Do3Щ+id¹ddh;2tb{~Ql;#4@<8(O'׃(լK\>{Aʉ?KtϚўg߹ 9]jN4 $@X a$@͜= q KH@ DN'$ b PnbC@$P5@08P fOl=l`0: 9`g@P] Dp l{Zd8p ﹷ;OP18|.]m cb0+I{txho}#Ig}{b?Ҿg^wN=:}_Փk>2);FR~E j +@rqHH,@-9 rzFY~;eY$R`fgQ0;:m߃Yo /+0/DAya`+`N 0O`N94m4o?֙j`O1W-|̗ρ,0_Kl`.͝r-˪ b PM fh N뮒`qNKB_'xՀŽ,~-ڝam/uS2~8#Nx`mL Vt4-K++Xu@k\o|Ēql& ~&l`ؖq` O {/_ t*gFA`_ kP (W3 7 `,8Cv KFr,s'8Z7C!8޽3x : r>.'Vp%˪\q{c׺nuWKD Ϗbp,wL :{\{R.q> ǏxpwiK4{G8-p{pxQ ܟƂGW<<G)<3 <;Mtk{<w7#kl)<~>~7µ] ;Y,E} 3,H^.DV/c,ʯ^-5IXz ]1$ C SH@;b*! b!&sb҇X{h?Iclr].][g4ihK;j a,9s bDwu ak_ Qkc$!'bNH%z!wqq Bi=, Uv! k!~5C?=SCo$)ok.y~YV7C/Ļ73%Ao BbI$Ṕcر.CǤ:D2?zeH*l3H:gBҩ!iHzux6$D!iɅtOs@r*HNPdpH<> 6BF4 R!5GR} v RI+!R1N~ ސ%;{AzUHo/ Tp ]!9sS)!wl }߻A9HH1PȰ[ƴ P qPRdۿJUPKY(>LJ\ Elc@1}r]L3YA~jrP6*v(Lq1Lϯ\xy۠gBy53g>TǙCyt(sZO-6eP~ [**ա *ܱPt =Tz%Cm {/ ;P8TBR*'jP AMP~*1^PxJJTP -LʤPYr#wU*gAT8Bl)Tmb*鬦=U֩9;i|C}j P5gP6{=R j[6-P[XD"Pjj:%tEh (o 5aP:OԹPhCs9~QmWZnz&Pu};,yPup,4CtQ-x5ԃ>,귲~ P?@fY $;bneH' t4@k$gc=bX ,ko>~-mS7 48zCACfF0hD\F874 C#z4FFL4KCcbhցР4̇Ʀzhl hdƪgXBg&},dzAaGhr&O4Bl4MA**4x?'bo==?i39t[ ih:h溓\B \:#kpz=hxg\|r xPCeh B֯=*7r-'r !qв-m[ vVGoO}?soғymgJV֤b_(1; kЩ:AJ)>^>CTF/p~ @?d?K qЏ~<l Pbtn.?h f:ƭ0|[r0\ҽCoӞVᶱ0] a R)Lòi֯ьKf`ƺf,`TIO0( Wab:L2/iGY( 3af*a&1f|,0KY\;܁G`qE71SXK}zsI}63`]C(a]:`W尞BZ_k;1X[ZjV,X9a- kTX /(+kn)Xs.5'š/aJPX]XݷU|F{*"Z VC`+>{|c5gT?VuR  9әVUJXU? cʰ:r Vw XjnX|ɰvVŻ`Vao\ʯJٰzV`5A~?w7[ wՓ`wO}ϱ{߲o~^vwﰫw7nzrMN=o>_/{aDvP&*vη@/qt>9vCag';(ؙZL(ڶ<- (>Y(`;}`;Qþ#~M1a%`g On}__;?鰯_5쟗SH?~([3pGϺ ɿt^wߝqLopd q׾yD.)8ԋr).zC[]F?ujGs84Ju ^]ópx DZpxá55QiF~{7ptpt*G8'z/COTX)8c|*1y[KḪGMxh6Os*'oKZc /Ql^8>>ǖJ86I tktFٌhGyݻpҩ@E8S w 4sQp2}ߑ;3ѵ?,k-F#dL 3C 1\mqv]ҳap=NpJiӔkp Nڳ=oNE3eu_{Ű]qlpmoE^Y ppָap6} k8CpN$^8OxO8瑛sc8 Ox\.˂p_ )T2 \V=ppY.K)w?.ᒿ .b^ڕeH:NڥE3M:Ӄ:IpM̄k6ach_ϻu}i6.DMp$˥};nVp3C0n&{B 7ps[t9 7_Sy q'ܺܘW2pq.we ebpya` UxXz <aa:1IAxLUG*< @95 3>#],ǖ8OSq=<:F+fx&xs7c$|8Vw&t}9<mzg g33 fwW5|wt|v`V|*F|gD~"g' ?ɱ3џ/jAF4^`(Om-GݦU/ww%&'3W2"o+~Yq[Xr^ SZn-Mj޴[lm;1OX?ü៺=7B i {p4;r _{:/W'u͗ ;̂?濻۳u'7KU<%)d*6#>.;"Fd"zm|!IVr#`P=`VS}}mz9g"ro8,FD4M" y:&!`*̬A*{Y^ȽIl@drF G.{ F`wdSNC<)h?.Ce~̇PENEPDкZ5Tӽ~ Au'tP[~YA?R"^UQ rGгf9G`RAGW xEAp|^P!8`"즀}^y!L-_~FW nBHPB $`,B#!>(xjxR_ $!!c<XVD/lAH$BC[!d,l9!-/6FQQC9ۖ?3{RUޖeԷO ˕8$ !9P[oP@h_a "t8"49B*wxg! &n0SB^Z@؈ DXUCXEdy!a-nk>Mpe?k.bJUCx1GZ{ G{]#>n6:>sw_t#wT[M?ct;vLO |>=ÄvsfDz%|}_96 f=о]Mˆ\Cϒ;99jh9@Z7",Z/Bq9Ds`'iw"+yNW5}]ʨKy3"kگ]=6 #aā+{41b[$?$שPeDM^I5QN#ځKaJȈS5_Gt#qDݝ;SuQ]UQPA9UDBԩJBT%Ua}%Q;#"} 9/#8 Zђу `$Woo--jZD;5whȿGۈntCň>CE^ ѳS݈{A='5?X+F1b){1}!F17h 韴pG:s-GC~BOCvk\@Z.FC|B W#Q?y-~ٖu w q΃1y1c+Ę0~:nq\~=) M2d%3dEeDHig2B٣PQ" vR=:sdy~vu2/8yg meέ^W`j[/;8ZH9vՏ-?+^5+w`JlϋPlϘgs=)}lՏ~?y9sD9w_י=9?K^k%cޯ{zG?ÖӳϢl/w] eٰ]ra8 (xakf[5^[Ͱu:[G U{]jӻw߾wnNg?WQm~f6cl;ld1l/*0nRLmp؞mVe QV3*a{3a[F+޻ۻ_)66lo^ޠK3`o]^ m 'l_^s'> ӻ}Ra>g톳n` U;=y;-V3awvm`WkYU%쪖 ؽUiؽ{vg®Iv/`)vþk^d+yG;a?Ca?b{ֶ҇ |-&\Q;a#l>ؗPy ا U)[h*8.a)D S[Ku`t:0 p0tLV =Q;NkVku?뎕ӰWhQĎGm ;nߡh}UֿHSpWGb GŎ/pdֽGSGj8#Ft^8QZo)FQepGk&UԀc%8l9&Ip>8o'3z8˅wp|DP7f,$ɄIv?샓L fމ182Ӌ pzt48=Sc*;v<854Lpʀ` 3Ùy̽ζz\ҽr<[8Y6}ul "0F1k ܮ/_k̬}`CD|@aG0?ɣ08Ƽ 50Væ `Xc}06<ce0\[9~~`g B: 0v^] W=0`8Ӻ[$]57\#]~wǛfϿzfϏSa>ӏ_ߺˏ_7}Q\KFpq~O_ %8< ggxJtHsǂQ`T*9pl*=yߟ3_SgU|O+wQe \8Ef.\hÅm/\FQ̆(Kerg9?-ӗ[\R||\"Lۯ9C%%.rb3\&åh$\Kr:?.e\ZV)b1\wթ:x\@A\ẇj^/Wr5Xp=Qap8ә_kp}pmbU3pcp9ncFm"_a #:*8M:7yIM|^g4n|p[ n-jp;a p},g'Q ۝X~p:3[M{y0{`<|t$G M%_WpoZ'vWLLbep3<ƝX>xznvZxox?ix/.haU1l=`;l=NM+{ͰνA>{"Bf=yIؓ6{2"›$ u}xO7O3tǺjZ᭩ oV[ o՛lSSx)GQ^ K7|gVpφi>޴oU'G cTARޙWd- %ao(mžccߴv!_}|j[}y&k8ȹ'D5ݍVDs?hqp6AAA}&\nfUegr8X7q'Oǡ7y8ۉKju(_PSw? ߃zכO״E?Wn})ZBD q/A(#`H?~- 0B-+(D=Hs +Ք\0A}XmAzX v:n l4pBXKq鞝Lp̹֝g4ܯ|^wsڗ{POr\!!2!2*!۪ 4"zPX/{#GVAΏu7pve B- tS"BGZ1Z]+"gOEh,bzd5BS#4<гtE^-}S Y!B/+ mBOB:CGM} )_˿ż/Æ=Fؐ* 6G W TD؀LG & l|#l¸$6:Ea0 -0 3C30V uBV%ŒD61a4c0oAEn9ڏ05o#9`}}?W_;b#,~YV5aWhfJvyJf#s/"SH " "rpĊ獈'qq B_"' r/"(zR KF:D:]F1iB;4띊݉|H:D!rkˆ$TiDGLȓy= ycZ"Q5b< AV QDwQ 5SQ¶DD{׷>e(z22@; BFDmD?؎#+UW VsQw8*֌;=x=艷-hq!D fV-k@D"Ze?Mm<tѺc !ۃK.~ZCDW!eR#8bx"Y ~Dֹ7 1 916Q:{zC:/Y^RB!HXG&5lFk1Sm/Vbn!ve !v b'@옥eXiEg1Ĵ"{ 1sS=CWw_{N}ŠM]k[9bP}tW݂^)(6 bݶ Nius nb؝o;MWhC쾄:z|{GQYNlGl bL{q!bW#6w+,F[GV->^ۖr qSgU8;8׾KMGI-E\ją.C\P=tGCuoT!~ dF|8WoA|oyy-#*: 8q,Y8㘮7-HDZqlyL億qH Ok?e&F[$p_@H0߅[`ҀH0HA^@‚9}ُA!a9W# {H[yH8$F$DޢH8C! !6#! 5@B*$r qX%Y#q!$!qHH A"J(f"k,Eg]$!$U^V$("Qb8b"q\$ZGJm$Bh$.Q@ #Q04(;}Nߙϑ`#=[ϩny-[f3$Os==Cg9mÑ׫*I-,HzIOUtI T?Iu6H@R_ 89'~Ɖ1pN~OqbNFOIw7tKHEIH: [!j9 ($eHX_$GCYH>2ɑq!}ϕ!d-#J "H~3ѿ8@MO#^<_BN5r^ oƮ{>{v?\>Q=\坆ܓ8MmliA&cVȧK1ȏB~r@? EӐ_׆Z:_nC~Kj@v?@~[`t=/hP/$ (Hd\ ףجŦoPl2ŋPl`y(MsQKQl8mBqXCPD@?,Bo(N䲡J^x*\֓Mv~5.gsr.BџP:rpq(-Ci曣4o%JRY(Pz&s{ݎ\(m^ @YM(ca(2qD٤|%l@|D6uT:՛Qfq e([M>(p ej(KEى@ GYO@(Y[ĕ\\Iĕ]ٸ2 o+7N%d4w 97oпm6JaT MAèME% \]ȅ*R|(LPS Ge=T^Be3TA)y\]UZLQS(J%UrP%ybmP5+U3txғ)_T*̺PUهP挪L zUoY/} ZG5Vَʑkqm" IN5K6+UJpM)BP-j6TOZjvT_jǡz-To3^޿QP4oʫDLFjLލi5Aq7(Ӝ:Ԩ3 R DslCF3lAukPc25њx8ۜl"<] +Q;v jG_cp]-upqG؏[a:7 o%&[bbF]T7.lv }.6s~Sr-m'ϵegM{xv}f O*4ۋ71-n čqUQ I76R}Cn?FC nFJ| 7.&'/nFÏ[ަ2$j ŭOsq{6p;X vUx&nϸMޮ\} ˯v93\g5='gIqܽ7wo0T}ō/Re(~/ʸ%6=kq;DAƸw & x{qx9^a8}o#qQUsp1{*~XU߼;{χ3Ocad6|Xpm+>Vkd{FAhIlh`k п,D4> E,4>ZFC461)Uh#PAc4F?G4݀FF4:ƃxP.x=3<'W?7/M1#x;RdM#dㅦ t't MItMh Kh@!/MOgݥ;BӛSa?|x^ǣ`yZeZ\DuZ6Ҍt/Bw}[7?D-mP)Zb)F%Z¤ђ4- hDK+ZNtղJm9^)Ux ^;WqRx=^݃ (tZC U3]s^;X׎(ڶ7u5 `A>z }x3{ ^k ;x}ʚzzΌ[Sx+V6^ދKx[ ćÇhCnŻGIvOF^, | 3`zmǂ3ϧcR|B1:7|EwZ?Gh_:z~mN֩hVtEAZMЪCVR.Zuzvu40GՉ Ęڷ~n&Oz;ɣm^wm}fm жt.ږM?波Mm*hCKw<my+|frէ\>KR[Jn]X_ҡd,;@_yUo r·@ _y{f*V'|mͬѮr.YC."lϞ5L]B Fks] }Au navKh_nh7V}S |AAbCDGB2F2=hTNGT &do!KI~E CB#@B&Υ{9!P/"opG!c2`j2`,&xo;>@YddS2x",F&KANAڧS |݅ CT'Cʒй3P d(/:12t\JjzF`(dhQ24e?zR }A >2G22Ȃ = Mu#,gR~'=w aHXF˄e2˝i +&,lO ˨¢`*ՕuoMEX[e qɅ8Ŷl',ۂˆ}k$,ф%ya9nHX KaIP',%>[zrva9#ܙv3h9aEXn Zfjk?>E # K6T A $n aK?a0dmI 󤞇,vnD '_$#xǞkl3O2˜d02bv2b+!ُv$aݳ:sV{a]gKXVCªV^wٝvT #U{>Cg;ѽ}lﯼ_'r_>ޣQLȺddn22ψL%##HdW%JFn#9ɨ[#K^&d?V=dƥa[D8q a[%lz3ۢ&¦i[6m>a#liMa?NBf, l?q"l ڕ]+&lWw+Xr2vX{@!c^dlx2b26Mt!cYb 2mtG[U~h32n4s7_:Mƽ1$n!n<& ȸKd\Sd\2Σ)"SɸIS8f2n'WI&"J&pSH S^ Mdi+`LXIsU2LN7 $u꺃!o@m~h?aEw+vO+rL!/ c|?M}uh231g Q%)$ <H8B1=`@8zb>򓔆vS:pB&& dgdr*\LFϽzH#|,|x56CƇ[> e ۰c%|kMߚGog!MHͦƋY!|Al/P6'|2wξN"|S +N{AT{>(?'?9OJGa/lB~_`6J5ޥƱ={~r_IS9^wk"gWpY"o+k՟uJBk"Sμ"SNe6dJz/gWH䦒)٭dJƇ}*2:zw7!i;4!"͂"T"p(XwhD%{@M->H;h-hz}i=xBV+D"(zKgbDPTN@ˈg"8*A}Fͬw<If3"z'\aѳD0f" ZE)XyD0npW-1{=\g3D~M \"DQ%UNDBED0Wwv!Dh9Z(Mt^Q!m~"н&B DhX""mR"B[f2q7"G;%"TNJХID"/]!ByPn5ʢ3 O"~͠OҦnǿvԧ͞?wk!tOU8zR&B/e0HZG="~ 6֏s25& D8~,N8[=C?+kK)\pcD8b+ga0>_CfεxW~MW#"IDN)&(؇{\fJD-1DtC ]GDQU:7׌2 u&ѽ2D;csD4r չ]OD8"zcy@D+4he"Z,KDs~w^kҫ7cb2%IfbvJɌdd_50%3<'3w/&3;Tsc'3+>֎dfc2 OD} CĂ) b D,.;iDĒY֩d",$buD,u}D#OLNQt~". $jb>7p zW(D\_#:bfv#툸"~r`:Ei.V믚L7 9"1}H~Oo&Rc)D"uvȟUz j_Cic"5].2;V2D~3H\&lշdV2{ZfCf@f qd~47[V!k̠Df "Cw~DFX|&2SuY̚4"cQOdl}Dv#"B~GO%r\"u'rqDNM}E-Dǎqo$rEDna.SH#rrDY8UJb֓D. )&lO(W"z>bAWmZ"?#s^y=1";/%:o|+"Elٳ!7>L$FljFD>zD?=ȟASDAU((3 oO䬈œz } u(,~N1˾G|BHBB G G5B-Q8N⃈ipQHAlQxIGDI(_N' +(X+V87(.K'KQE#,DQUQgJ6EO>(:s5;e>ל]ȾYβeYwgwΕ()+%46QE$C4QZO4%m]4(%=Zwe5(m#JW% 1[ALD۔DTZ{}ۗ;OSs 7,絑yɼ}d^{2z;w222,GԆ\!>w#jZ^zL_ V^x/gx>gD}uD^B#+GNh F4F; _1 0ZM4LBDæh0 D@"D#3D4rFY&ѨZE4D^IhQ!v99hL%RDSu=I4pMBqѴI&o6 "f<0h)"Z :SZJV%Z$' 32-Dug.Ѻh0"Z nDVh]H+ADʓVuv>K#߿h})a9cd~2a!GA.d~E2g?o9&? ]zeZP){ݞ̯>OWْd]Ksψ'܃h_m&ڗ". 6}hg %/<[ܷHt$:6Btt͸Bp#YfY4Y*,ڛMm5 ˯Qe>kFtue'<Ŋ螔"z爞*`0$zr 8ì􉾚 W'*5$J" їٛsC$FDŖL"OZb 1Xz, ;n 1RL0$FH6I5}/MeȲdـ0E?Ԭ,'DN#KeΑe^rdҎjO\_.1ٛILh'&މbo1u_ML܀XAL4>d1[2'fSLV@1bZc:,FaP@ qĠ;30ɢK?ozVv쓃?28 !>)u: Cc814}6fL 2xs1 Cife2Gևgbi4|bI kLެ-Wxv#^ˆs)_%YG:Hggn1z~Fga䝸x$YGo;M0- M؆mw< 63EYփͪl|wmCN`kW`{=cc ypIucxb bLC+bԈo0vS5& ]}ۭk1iVq?~WqM_0{rCS+ޣ7Zk;j= ൪DŽL8 9)[ cB'L*0QBQ4c0&1a?jk0qjLTD8߳~{Tc?dG;'w`hK]z3|] `;"ʆ`Wq(؃}EsQK`?UrPm8q8#r cpR\Ťi1))4" "/)3 3(-|Iq1%ط\=רkb;5?&}E<ͻ׷v-7ke.Qp{\ue5*ڻ޽ju'Gpi=ǃǵ5ϼQQF3x h"x,)<ۼc_𤦁%xnO<15Q*>ZJ[r5"n={uPCFJ7Q I= ?fm{s?Շ̬e~b7SncʭOiӟ` 4yZ 1Mqq]=O8<[LZi1tv.=Ĵ'0ӊb%iL+yietOu>5ĴDzֺ>Uu=i@- jkcC`?'@ȆILft@@_y7 `M۲ ۪ `m@pAS A~?N͂1 BPDbG!8+47;r 5&AР_7>_ϾIyWSWo)$AH Bb $BR $j<{&|j"6_wC˜8 !e(dm!l aiupUL4@X‹Cx\/aÝ` '@)7@-߂pclpҵՆ # vb/z&o L71`Ø~wڏߙ LFg!2@" "\H]{ "#!R/ [MvgDȽ&64{@5DhBiDY^A5#@tdDG@$ U Q55g@4)CqDrA^JAtRvUHŌ71031S)33-13C1#{=wf\``%̸ 0If6?fn!fbF[\$ !vb7!qbGZ!v:ĢۘU_:r!?dl53[ԯz8f}Y% +!NN_ .qQK ⒇!.s)A|̇Yq&g _*e:wUHx dHFA2l6$shedTHσd~#$  y)y2:_NϪAqWGBj5$mdHB~$x!y3!yo$BE$Q_;Wj@jHM8)vڸ:HM2~lo!d')l nѤxW~3oY!m(2 fCdF@mduG4^2_!3)2fktp^dDl # 3df@F<2[ #5"2sAf]ȘFBf+ȬUVY2Afϼ{l|ϳ! ޵گexdN~̚Vo 2]v̋y;))/}NOĜ+1sWAvx dY!;J c!>;#KLLi@(d$ {<'u y3ن}pM}ǣiMqP=䄿BNt,fLZQWmN~bȭ̈́:?ȭ gEmV m; Grolk ׎+Թg7Un_ Ґ 7 B~ho yUGyÐw5r}fs~UF6Ԯg|h!@> !G)Jq >C>i?OB>y'ȟ|(E SKYK/K/ɇeT A  qv(HBA >ҡuA(P^ [(P½p(' l(>D(:B =/@q4wow }6A1$/WHVL3+ (fyG(1w{Ce-_BI<JRPS%u7(iB0{ s#BY^sBY- oCYrP^z L\s/O66(}+B9ˠ\ {Sx2k;/ G&T(^Bg7T&KA*.RCe TR|PT@ED* y;Gs*gbT MPYU!PYMglBuhجVP.o T<ļǙu04< Y1τPƗh&ZOOCs4GCS3nASa.4lN}~ [M<B G<@khC34@3.4 /^ s3 ;yi44/C|64+@R Uymr u<.CGQ{d_}=kLYeGg 9hͷZ|g{i4r_M5@ZL(565Zl'5^ìzQ֌=֬В(+hi@k8֏h9Ѭ1Fr-C-/h򖇖\h.;ZCm[:; UOϽj c~OXջ}~~̿7P܁\h B;Cġ߽vq)ˊ].+3]! mо-2?{vmnA&oоOhi6_x0hΐ1::,3ltBu3tF@gdMϥ~)˨:cAgn/QህΤl p߇,L_#@PxGw:jxÏ1Β:,w05tVAgU6t,bZwo]tِӻ)wft{?''۝z,66>yܧ̟g{ͷu=EtK:)Љf4=,-N1KšSx\uN3tmNLԤB:uit׭й;.}_,$X~+  "Ұ 7 )ڰ| 俦ZX~DJB[X(]7aL*ιrP cPΝMA*|X*謺jBh,B1X3 a"Z* [y&,w E\;>Ƥbѭ>{;"{Ao t{x)t#yK-X݇ˠ-ӡA8􆯇)F@oT_~\KBODzrЛwMң{]]5z#9zg'Hqz9+Z7WzWz׎AaՍލлzd~WKo/ӯf>0eu/}W j578%7>}_ }EzC?GoB':A6S.6 !~.|f;;owq{'w~~ws?? [01 OW xR|&9€_Sa FX l`@w `+ݱM s=S0ՔY`Uvpz?E + a\ ]Lv\> i0(W}A5;y 8G)J81 04 z0\\/ρd F:0 f*<Ƽ$qM0GqF0- #H F0RH4ƒߜ{s'+aElGLQ}%tdz,$L:fKX} 5,Yf%ƪXZ"K-ÒXbK%bvo,s{,q؇%;axcIv,)OŬ%N;<|%/ȟ|),&TK 1{!ML"KX*Kg[PcK,ðt,U)%f?5-~n;b,eRW_,utїɌDz9X&w˰Lx`Fla,[Nar̊lm,3ߏe+_axٚX66R`V/M,eIXRe,J].r'XY2R,_fHˍnճ}eF0.^l k㛑0K#7=.?t:-yM0Cq &8 S&dF R` Y<o`2&_dH<&[>0mjp| 0Өaz(L4: gl9L4+L8LKV k` O{i}٩sWw`f`fX%l"+0tff +fay&t`S_۳f~7 37s}ӷm-/W|szo~fkL;=f^qd@ﬧlw{mLmj0$qe% ;R,M faf^0;f9Wzw]!+pE Vc30 s@/Fxs07 G`a̷D|0Fips;|Hf~8)ow=_8`~gE6tG{xg+z}LzKu{{}xRV /JQX9c5V-êX a1} ,DL`1 ,$a! ý|!]6f+v+Vy{+vyg{lcyzߍgrڞ88g`/5)lL2aIX,=b SAHt-XdE8,b5>V::f:V c%{=>ϱX3(֌ÚqRX3ެgf֌2UrkmĚǩXkMǚ"Xj/ͱvf1Jpb]f^J_V*7Vm:,cڴr3 ]L kcy1ͼv+ݷkmeN TWa<z`ǺXg}u-5ƺeθqSgPat3ǺJXguaNT:+gX;c)Xi׼ų^f&3gcsϧxuXuQXw>X3 bgc]uL/c;ӿ'l\64]6cӌ$&M&RTalGɠ&ەdM^y^K[r1,uY`i2 ؔ'C{-{fmK[wX1۶t{.ͰejX&kT,,O,eYXGڰ|Bg,X/l`5VC=aV`%P +LXf HgN*u2&*KV\:wVau^VaywXª6VGztXz ky kEkp3EiwտfF+`8=5a`CX:_`} ^u%XuF16w XWº=pFk0lx*,XT^ ˙:\Ѡx2\SMmԯ5L%l)l Ӂy6C>a3 lQgy6brg%ð֫ӰFlݽܧkmblc9mr5 {Pb}mKma 6nl3]mgm8l[&U[_mmc;YkaM4uvb[/h¶`zF)le`[<=7a5DQmc@lX<>ۧ`{xl^5% [[\m_5?=6o uS lS`-a&σ`un ( R<G`'ٛ`'{Mv Sx;װ,R͟]+ag հ ]PziCe.m:f]([>'`_{`1. -S| ϸao4`A#;O S0$ĸ0kE%f'v/ބe\8¡Wj pm;(C sdC,8<ԃ3m8< N8U8|Cc\+vLx]{!%kCgvʧ>K)R ǝ[P pSxOʫ:x386d8>ji( X'iw)@3:p? 'pQ&8i) <Yԙu#Q, gpV|g쮽!8ϗp_p=hIg>w|oP3/98g]!p'ߟ` ~]0}4#3h30&.;08,0G15 }`-Cx#ӣC9 Ue0hD`aJo0VŃ. } yj>ᰖ>E=g`n`{ ֿ*#ˀQF&sN0ـC]F}2(*b33_Re}Q~E`TjqUi`ԆqzK0!@q'm0ҹ{h*!}U`<֢h?OixٟW3{`I m`|m` få\M!_2 .,72,.edA.J|acwÅ%\8 2 \x2y\WE.R"UzhEsvV\'\VP.+Eb .k19#.;.^zC'ap  #%Qp9J ᒶ.rޥ2.R;.erux美ޭ1\n?\k?np יQp%IQW)eUv#\tϝk:[޷ϫ5puם4K {?5\SC?5zaE\ Z<$ 'p}Kwpm)w]7ui삛eM_n)jN1=Ђ[S,ܞe/^w4;) p{! p (}k|Ap>:lK>n%?hOw+pJ;z*Q\=p7Q7=|1#=Y# =)'3[ ~~; "}Kplғ\nN&sw*b) 3]~'w~؟1ܛSOgd?L?; <7oW뱓~V_;A9X ;G1#sv9G]~ N}`=v.Ueعw~^IvDQaعZ;a_ΚY炝(vk=L[9<,G^?x\ K^^ Cq9 x xh;D#}BC?gX{^3|Fg|f\K mYU5b|ࣚص!=c9>}|=/)v¿Z|]:i _rw%}h)R'.}fx[;&/6|;PSAjWΙJ#z-ɬ;"F7G7ZY\M83}!={#7{V&K{-߬] ?ɓ~J ߜosB8?=u&=TߣE74i-zL}f]2 VY`=,<;>Ga;T}\w GK`?j'c?Q& `ac ՋqI<؆y8xS#q`Oq\WД84!/8dCT?D5c:Mq& r6Pi ġ8HP@8~8}šOq 3?D n a?9)c3'~z;\{o?eo_:𗩃Z0?:r|?:ῆr;6{࿙>Von9O7 م_4E8,ۙtV㰶'JⰙ_=װA%89qʥ:F 9N<k^_x+(+< RhE1BK"Xe 5LEb9`6EE%{/{xCxA|!݉?g\;el}}߻{xnwJBd'#DBF |>B)?s GBHB7 $!}!t1'!1rP a~])rFFؙKt e!,sE²","g Er"RNMW#p!i8Ÿ9 N}t"U&"b_<"W""."惈p!XDDADDEDҌv}NOHY !n1"uxBvD ""/]DD3S.rGVރ||O5l#jnD-jC]DAlD#"Q[r-VGRDVFԚZ;|xhfQ$?fV45ёYCIci>唈(mQG9ю#??ȸ582>G&G9p~ns3qtA.Ok!.QU(q4>ѣ-R-9oXD#Ϣ#‚VHA/G܇Q}Mk,G2 @,Wb%;mbN V0B;}b{֕ Vu3bՎ#V#t#b/m@eAĖi JbCf NĶ}o7|;-qwFq͈;\e .r'!/o18hcspL}HWM۬9{hSKgĦ.gtѾ)9]UT_=ְulں/8c"_,qűZw#H%H}@ $( A]um|H` )3C}"v#c 񰌮6Zw;Opd/NT5MhIqI'VU\zI$4Y_r'MjYprNZd` L3N)R41y$E%GQtQ-p2f:Neq#)n0yB-WL~''lpm$ 90o@p; !EP)H񚄔=GREJ}H$#dTCJ!3iHI{2‘,nHIBJG@y]\BJ&ERl:Né8ST 3cg ;2g]{3pFg' uTH܊ԽiHKA~KLg 5m8RFS#Mioiγ橆("- i;c(@Z2Lg+ Ev~1V itVi5VJQ럑vw>J,qCXpvhβ8;gYS1pvΎY!8˻+xE8;E]/qVgPd_]H'׍v^ak>}4OtvP }9߄){.`D6oYH%H<3&p9=Y?}};Gtg(DQ_r gCHB݉tHiS{tMuk ]׬CH{t?tGiWg2癍֝3?r7ߍ(F5Oiֹ'Dt OAi3Ow`ҟ )}FQwBVG$d[#c:2Dv!Ct2f,EL~d߻/pw_~2I Cz X|;{VAES!2,[F{NFFTd"zd f02n/@Ɲ|dϓzsWeAŽ⍂~(? , ( cQEi Q`+Pf4 '`c ;NLUn*WP;ivϳ}ʾs~Hp  N~@Ar3 N ͤ]FA" 2 Qu(CZQp q.L x q+q'&o>;\ą)Ҹ &BP&.… Wp!=.=ƅ@\(p lPȋ Eǜ;⿙=?4=t..]Fm\v'f?ǧ^~b ֣p.; ppPZWf= }‰3 O$R&Ca67 u(|˅(lۀ¯QG@Q?  PIJ EdQ4 E (HnzJ(}"\9s6gޓBi -BQ_TUGOy1GX,bEPGrˠgObAۣx%+IJ(6;l(X#a(NG(j@q>@5(}qRŨExq\|sz\eqy1.O/Eqy4\^> |p7wa]1-ODw\}"={zy=߽Gq9I +vkQ,\~JßtJ93Q-Jq Q:yJ+~eҳ/j(֙9R(]U(@(=XCf(WPHyd=EiJ#(?rPzb0VjGؠ[z JoU23o2֠#}Vu~Bi J?ʆeSP6u+ʦG ʄSokތC(21K:2w(4A4Pn֎QϿV뾷*A5=g[̡e;.>\w.(smBGvF,DЮ/ME~qUEYRjznO`jw}Qʞ|Eٳe({ e-Qeow`}w؈O('("P>>*(DgOxr={wP*j(W=r5MQ>G ʍBVu5Pv Q}YkZ:%(?E<em(ƒw(u~gE]I\9WwW*pfܺDI\뉊ܨۄ TLCԥ hTLtE;$*8k3TZ<3YgO7zPa@❨0LFqT,9X惊t1*LtPa* )X1+*o7;`tơ~-MQ ;TYʉIBg䚀JnKT\G%_7 *%Q9{"*P"J@xT߁e\ʘDT.@e*OĘͨBe{T>ԹʋQYʊE\ʫŨl:OqUWqU{"LP+C|jUPk|P2PkCAgPkoiώO6'VQ\C]MKn<Wd˪>& uC(Q:[uk3gOʨg]ޥ{H hXؙJAE&}^_ ŻݣL{DlO 4l'l`7 lh8J?ѐ\ՙg8!S YryE-rАһw7)FE(Fh[qܸ+XhVe9*n.a։LpD&nJfঔ7n㦼#n*͹4H{'5QM"#+#$H 2Cf%34);TSi7Ϲuszq Yv;e,>/rDָJdMI\,,d-!:|YG=A"{8"{IdoAvrdCvTdo߆o{lٓw#=SZi ϑ dG":cՐ}/Av%s G|rFt9nϐ3Z9c"a!r4ґy9Vș>93~`F'Yu9{y 9{Y|9Gst9r!'vr: '^9 Z1#Ht3\ ːs!rg"+rq/2;=r=;Ò֯8y0޸;M!7 rw 7xe]飮!rBnY<ٍ| ax*5=Wix,tP>F3$Yf< :EFڡ  l2Q`Ww9>Q< [ t9 vp`"C 33 z3-wcȷ(+Rmif!Ƨ5 ?CA? >  n>DA(k{Q='쮳wR.w_[_(oM͝{>-Dᄧ(B(\XEQ:[Vp(mE(ܱ;m~޻iX(<(¨(L Px PxYWrPxm ӘOb>l@aVz>{3$j{V^SޠZEJ(8E6Q~EF5\{h>m]m( QA|(vq~ÂN jvC#Gq\[_@?f(vWA(S^׫6*Cq(>j (>< {Q|1P&\GqӞvBqwfx (~6fs!EKopf¨.(.y)?D(P;k(؊(C Jx۠O[->(i?%"9`@DJ$DyX`N(](Yt%KQJ0\BI J0\DIL9J$qu'x$Q%Il'=QP %q J;vfvPXო7>8`E|5Fwj̍Yca.|n^;>̐O<sთ_-a|)>r'>c|8"я牚X?|1 %+iB|Z~V-uO<1mk%>mǧѭt¡UnA7[o֮ v QʎP9g5*7c@eRTnaͨ=Pj*__C8?TM* T-;kwU쳽=|i^Sߧ%4\ "z U#Pɨ;g* PUr;^kM72TwjEVD PF#P  P }.z_ӜTA<}92Qh"zJT_.>?Os|.P/&t6BMeĭAM&jXe9o+Ps5i)}L_ a*j]DM?jQ 7 Hp&L>CiKXD լ ϋeQD剜3#C4ĐhфD'&MI%J4QhDaBD/%#:-Bt?Cb x=Ǜ9|-k Q3Qru'Wg%*P#*d"kDDl> ܏8p8hqp'!Г8P:]Uk9nmSڼmiֳgj흶4gnZ3gwx5i{Vk9G{?Ѷ cB86_"fıs,qLwG.qG[xԃ8WBt87826]q&^}j/9<1^M򜒊)78先Ӱqj'Nج8׼$εcs p'@uck{ňse|8GKęF9ę'S泾y!O\Wq .;KrE\D\kנ~M[7_Ac:՘ƚܵj*%`INH7*.XN܅ܞ_%Wk5Ox`F<D<("լfkijGx"ާs$x]#K$'_- {}5;PV=9ԙ!xa>Rē 'i3dTC⓾E|2Ov \ڑ$χa/-"%uy~ڦ<[^o#@z6]s~ .į5F:]h3$}?D!4r8C2džm_JFH6 @O'A6z /Hv 8 GEkZm$2$0rB@D81$`8 44N.!Sboz:% ө[(c{(>H컅@1$PՅqI;5 *0D`$4i(RmR/);SLH̅{&'=Ij{@҃sHzy^qW'$íΐG2$&dIFždIF$n+"rlu#E$cz HІd2$3$c:]wM2+XyA2A,?_dֹu#H f{E29H&TH& /HdTg8ɒrvfɞ!n${!d/"KIJ ^3'I6ɦ E$n';IId3<}8d $ L"\k}:܂L[:䶹\nBrIdȷu4wCI^Ֆ՟%xk$Hu^$?zɏFK[QME$?g"yTsƑ fu3V4_[tHLƓJg߰72%-KH>XW!5GH>3o$H~G>'}gH~2?dG![H>N%H>ɗO$l}$iSywIgHҟ-WDRZM `N =B/Rr!>"`l I*)8 $PRD Ɛ-j2[)T"K[7֟{2|~R!oo),=E ~=nJ6s(RX=E*Ia<)&$R6| RwƒBȼ?U.yN"{wI>C)dvOߑB)P"z/j^"EΤ(% HQ')*7#1UהjkRtw su"w51{bo)fxA. f Hqk CbPnH* h$)Ɉ))WB )I%%)ǚlR?EJCIț Ht3) o)H34KbbRr!l/Iͅaut1RfYDJތ[mAN@[8R:OWok1 -ߘ:HQ'S)Y:NJ.R !=3H%\T&\r rNEꐚRcGjN Hm C&-YIjK!-S&`xFjkGj뎐?Ws~'cد}U?_+?gyKjtdJzHmDjZR 'HS^/R;xԎhQ9R9yRRKXMj'֑ZC:%Mf|FPR{bMj=Iz#s'KٺZK'uY!R7ZAfԇ{I>G3Eu۷Ӥ~8ԏ^%1}2i떐Ɖ54?Ƌ ({B/I(i>CoHSiXlWҔL:y^BSIss\4 3!͐{*iM$=4mV"s{I394/pu!KiL!Aΐkd&ixQY&C UYQDNNYwi[OZ:?gs{~?)&-gv֐ZKZo,im&Hk?CiYFZaFZW'ɭ|1Q}ҊYCZ I%i#8i:hzGuai]T 3H ~Һn{CZw]=,'*^ I#i. {OZ>?~GZnVԮ|i&գn:Q71&:np"SZln6.6X%PS,?OݒP6nWYD2TQ~-GkP*+Vm~NnGڢgIi'mmH| i{ ^#iPzc"i$]%I{}viLc8mZ|+d=ǒnʶJHTԐC%n F Y'DǒI;%]%SnN9 >ۍ+I;5y̌s}ݙGwmHMkHf"C鈜%c8tLIԘt RWHlHA!t&u&KHo2; ~F:=IrytߐIZJ#_LҝFg';Iחtg뷍tWdP]HOG!='U8;agǸCIύ#Hoқs =Q[@z˚kkQ'IFO{trI>6ϧ5\hDzV>X^Izo%LO;&}sҏyO~? $m20' d'%k`{nl0'ku dpZdxw #Ç0O#â$2,:au2<> C&$˨; \_{;kꮳҦnp+GݗKU&=ŇKSV,lPbTgaר{gzu]f7u4.gjؠn;Ɉ  VQj2!#Gd$9N;i1M7E2^BF:+Hw622% ddkt $#se*21zQ dd𐌬:3|9C,|ߒbA Q`2pit[o (DvZnm2k`yp/ZLFIO(ٖΗQ22N$3lƙ<2J#R2OFUX$Ku&cdl4dpdNơId0bƍjȅ Nq Ud=w"Xo܇ r 2yN&/ɛ2ygE&U[K ridL/'2@T\-:1'.t>NG)d:}'ΰ"Yt'n#-4ؑLW3!A{_)ۇ鳍dr~#3 L@c)L[&%C|q6Ya]\GfeS*k2{^6Ͽk5v2U$s2$sj2:B}.2Jn5ۯ"s 28̝ג$A;d>n$Ow}#W&yn2z` I=zP>c)Xsz`8D=]džPQzQ2Se T}O= GQOԳ/]W9`zC]@=sRd1:Cˑ oKBd8Qn)Au}d,L duYn r@_*M@/AJ 9AgmA#Ay@Oj p[඾` >ຩ..`h =NԗW<"wxT   |nok9:OYm*wͧh mZk))6hd#s߽uqvWKrs&;O 8k5ק#h>&.@96V[0oPs+o8i MG P:݆bH@OAT%.,dHHImi\Bj*BjIcnW[H@jaOtސVz iُ^h)Q I!>!=ң4!=r?Gí-4kοu=ޭ]c!}!r gV9y?9!rCCnH e-yb2rK @cn\Nx^A^!CNBnmgCg@Pz!?9cB~t*4MkMޘsj# 76.~= <K(AAz@AR bP⃂0(Io&GBt(A 9-+(B[;(*J@QAq}tk-=oz+JP >NP +Bq{(f@`(,h(ek# P ŝSb/@XCrtzс8VJӹl9?΄_(.& ,Et](TtC.00_.w/t.[%|7Y.;%t{3+tyPT c_T"]Pj.(B%Tyb[ C`XC#x02ix8*Ϡ<*~+D*򡲠Tf5][zNc8 ˡr/TRzCCJ>; U"r@ T /POq6T>JE T8*O`#TT}[IP#=W{<5sﻂ3u봯oUv C+@eX{C}T0Au4T5(TW J?X UPe,zCun$T眅l̇8{=lW5# +Ue6vyU-]2ht]8]e3A2 5P50Y]?@wPwoJ"ԺDAu: 5PjP^n PS5ö uu&r}~̿5֚ܰk"LflOs9Ac'+C]PuPb~qy/j>2߷G*Aj%jGG9jU?Zך~_+mnϏV4Gks}kxP׍_] ԍz@{zouqz?V?2{>QϠ~ꙃ }q~5P|f!0Wap3ae%ӔFYOh<ohT?Fe4>B+4^&ohh@נIeNIԴ>hͅB(D|%l-4֐ . QSfBk2Ak>7f_ztPB=-,v_gC-;9[hs,vAmhw/әй:уs tBgd҇H P!tt#:Rm#9: # 5pv̠Y]]KrsC}wydӟߣ^X_0ο`|Z&TQŦ??s՞?w?g{} x|n:?x?>W?dŸ_Uoҳ2:~?׋/ߟݿҟ8Y?nqZe[+ݿ|~;S1rտ_'o[_';uqVb|ʐȭP|?&~?gFmO}}h?￯w]_~_Ý?t)~O8w~'߿?e-?h/#;orM=~w:oC"|~}5Kγ?|vZm?Sz?wſ|;|?o>`}/OO_?{~Mkw\gm;B5䆮"tBot܅.ty4_]Еנ+k ]U'0$/k1}b[}!p:@vyj?!:zoA~[#>Ω[s7W[OMzm/@ 8CCá( =Гx.54AORו z*г]=c虱ؤz3:Wk=i&s_[|xoӧ=w譼 Л7"a>6zˆ5&ުƽ_Pu֍blez;Ao[8DzGBM|V۷ zЋ^A;S(eg+u{^"6U7og }P~Go̅<+ݫŶo} .~f|g cI oU_\Я>0?_ذ5owm@3 xad`5{àFhK@S ca.`0.Z:*[UZö0ȁ!N+aah?6Wa8 :Ѕ#fp p2 xpr p 0p ǚ%._e`z8a8= }٬3`8H}~ԌWa_mnfS^ +v. k$Kah ` 0wؽ~R0a ômy1]uw<?7rRMs'5}桻kGn|e v{<}5tw2Fk+teC|`ľWq`P--@>g2¨H јshM azF`akn0yr[~0: 74˞Xw#էXƒOa,>0c0d<`9F0zg af ^ }eˀ0JsQn?nz ~%w2O0 wdmO0A0QbDt*{2&0 :X>]`bճe10ea&0/\ 0ѵ.xc?uk|&LN/]*g0`{ɻ 0qI\dq6L=߫*T~06aL>d"&>4L^)ɋ90UY[kaj#S}0y`:tiL 0]x_.ԃ\5>0 foaf0tf&7憆 ͆ي}0[%\`()-fM4Z<0{0+ Y1-Y;=cSa7fO[gZnay=;yGQwB{˾as 0{ v5 sR̍/#rL;Цv sf E)0_ s0fz1~x 0 v0:0z?oJ[:i[~m}~Q_Һ}U `-vu ]OyR1OÚ ˃a{a{`t `yzoy!}=Bѻ,VF`nڰҚ +joNٰrXI1J &jgXyja5 fՌ:l }a wyzs V/{>/z)Zk֝aɠk 2+VXNºXk݀X/X:(m7nI\=\Xjeax ]FX/qX{1k?ކu?=D )h'¦>la6*d免ElzLYG߁M+lvfGl6%[$n936'MasW6wg]|cmQT4 mm[rv+vօmG*qölV 1Z9.?[ k킭=sMu؞KmM õ|S܏ڻ76c7lӪ|`' ;Rؖm1>m3lXO;l;6X7j;]3X{-'Qؙ9F;~saa7 :`X;ޜu7~]v vKî3vEΰ+])m]?`->®b/8ؽY oU{*a/:m2؛p4S`w,L}&X~mد`# 7[EZkWK\gF]. }=_yG؟C,8c8Pw8 Ց62-k$ ' ~ph7/jZ+EAa^Cpzއ`i ^p=`f$8Q* 1p\u+8tUd8t9p*8 `)>1W?>8vE90ayiW`vZ #p.gᨲ (/Gp; G5-׿DNkO8z[k1;P8qe :NMs3O5XMl7ǔkCS-m~6[nqs8[or?#ep^@sA7诛ؘ3lпlOb@`9 ,Na@`AUb2)b)$0`1Icс-G\1i%vĀs1t$À'f|3{fo&‰N|d6Nd 'p28 i|v5wZ|Ni6o >kׂ r'Q['y28ٵk v8Jswg8s١3upy&p{s(1a%'WI|\t3G0?y>8`u~pNf3|Η6b.ϫ9_9pbzA_^aR Ap~e/\$Am`pg m;0X̳qz]08L1x. [5kE0s C1$ZCc zC_>S1r|ڌ!m"T+f'up.aE.jeth֛.pmM]]4jבo2.e8\ldex,%>]"%.;̴3ې]ް3>?.qMZ8#G'Oi:.W3%%VWT˗I4{PK|f[\><\>Ke P5*)*C0T%( P-k[41 ۙC;yb| ߺ70CP'k_v_4<C#cm}ml[1t2 ]t}1l8)~cv׋cxE;n:c-nZOᦹn/> nM Zp[7' pcSn*!?n2QZwϞO5z7{Ɂ[wy}p{Rg0Q#L0#`O6Fp;cWGc0ږ5w3/{nk&lnk& `Ď6'Fd#Gwň(a0? ҘkN󄭷֮`1Fpm0rl -[02)#O(sc7FqdQt4J0+#7Y# al,6#F>asOGv#\0F&Gb{e̺ KҼэ]QY31B_W6?7~F3Y̹~bQףalt }[֭g1fk7m ]cMnat,FKnhP^17u[)F7h(aҩxUFfxO}"3`tJew}LT6h}߽w}ڃobji{cc Si1{0sP*F׼iZs8Ka4ƨae}:10c Ƽ+d1:1pi)}cls7;6j4c}hFձkM0~Lsc~ n+̱xA9v^MϾxi}s|+H4>ǘ쏍ko 0;cyNb,*m 㢟c\T xqj0.2+0n:ƿWb-&\&LrLPUń.٘:c;5 0L1Q0 b&DL⁉=1y%&Dzy&c^b0qe &ŋ0>&.d 50`pLL`sb1 LlU:!_Mܵꁿ^wk<5:>8ܽ|W0db L`|JǤW0e:&]0hݓŔ)˜g'0lrb*Ia*<0S0uM1}`E2|=0 SjZtjfc|L)iӎbڔ ,4i+0-DӶ,L *Ǵ0mc+=͏K1x5%\´v>] Ǵ_0/i/Ѯ_}J1$̒ ,Ig p𔍁4g(eY̓61gC˺u?*ЄgjZ5o0{ ̞ٳ1rm=ֈ f-՗1;/fgF"f00 s c04*,B5`{x9hˮ^ ז -x-/o z2^Gexg1uWTV^+^Oi~e{6k:^ xpH^b^{Ryys9q> r6o3,.{xnwۄ-uZ) oXx[;?7v j]}j)Wb=x_ uMsϏÛ=Y0;bR 泹W`6cJr :'x]|z+ł1X  -JaAЧ}r[`Af&9` Xp.`t.,z 9)I,] 2cA,x 7bA9T'Qǿ5abĂw n?|$G5>1 q3a |4* >| >c LyɾqWτԧ!7> >ggUoO1|BяX _`b,,XXr +(—{|q _bᗍXy5VªX'ѵZ幺"|;ȶ^.9;~RN"a&8&8Fܢ.*X<MƢ),JENXt}$];E`х9KXteaQY,bQ1*gXTEX>Ŝs칱Xzݺmb_z`<3,5M,~ȐyN[vXũD¾i3(=cX"%rDfymimMQq`2c1,K4+^c%oSMh~[Ē^XS K>cb# 1`)51~X{:wRmXj{TOKuT:vJ!k _g- ,v KkKgbif,DXK+<,}KLiLoVޭ} ?+u ?)y%2n"pr~~s:oZڦ־1v_x5vgoWWdoK$Pt|S='֐ VSz$3nτ_}dvswN4X)W` gɓ+_S~ƲX)erű,k>=ebQ,˟՘ke9?pw"Cg,PŲ7 lzV> /XG+zcmVYP;ank. g+x+Šk棞4'nOm/0y+vaő 8 +35"i^ܦ XO`ť6X2qMp?.?jј_]ݨoeH"Vnb x{1a@+#$sB%VʓXy+cF+/cel/XyGv},^'^ TJ;V;j+X} V':clՑ:9V/j?3^ š M,5c-kBaMp"ּƚRXSj5W&/ kn\~w5__qs`_l5cjTzc'kuĚ7LLJ_yRW iTM`m{iG/y9uKmkQz g5a5?/{巕ko;}8=``)_ s+?Z w e/цY&4>;k-W=Z0okcJZ 4k=cʏ5uZ/o}kocmJc^$%=^Xץ/b]Z 3 9G>c}x?:`<LK}D*n;.EP$s!ZG#@}խӭoc{F[c~m/bZԮUw'w'{G^Lm-_ `g!`/K#`@~C~\.2&Ӯ+3<0٬i^rݧk-yfP3jhk_P,ꊀ:!`uHP3 Pe!"PҗN5E xZ^ 9;ׇN߅@T~s3~ѧJ&G`SDڱ߃"\9xQ皟,G1+x,E`&QA`g>m!0/!6aA351 l r6y0m ~h+a`l\c`X 2aCl{Š KGc56, ާ/~ 6:Εiz G  hN>gPAОE6l@~NDqQEDVg1 [`U?lX-Tazj\DPqAPmFP4#2G!X%-cd>lqgc3eTlٶixnlbW{y}gw|g~u;[]jزš}j/g_>ߘ+8:f7ӳo{][Rs[lEcw`-awl`>UGX8ӽh9|Vj\㻍`MtD{& ؼ={7־_cw67'BL滞\Ug"x}; &nCF!^ݦNZ\c|>բr=+\B ض۬`[_2Ol}[ 5<>T_g#DCBt#[?h|F:B# 'B:!DS*\^WZ}ߖz"j-Bm@C BlCq@r["dVqBd|׉GZBUU^*3ꩉx iuЉ;:WCϓyrV[~]o0H!tBYJk~1Sz2B/,B?NBhuChm\CeyB#]Jl~|| }{bPl=;*aul8c5ê9رpmu bhG`Ƕ ر;ͱS9;;yagea/vڎ]+|Gb SmX7ֿ5c#v4}:z9?yCG>kT+{b @;D &{璆|S޿%a@TXM)asf?a,a3@Xd0@!uXS6a.6Ha{uQb1=;=t{xM/-)=wcbt==Ggu;"ܼFnتݘSWDQw&wp'wj5>zG\G{vm6 s Uᫎ |U/3B׌4s֮'GBx*+"< Ÿ\D G' H%3DvPFB("e R=CDE$"y襬kΊt`B8YDQBԡ{7!2r "#6cȨ_/'tl\\d;"kv/5e˶^+6{E6`>-ik|6]>;<{]WwP*:)a{ ^~kl=̣w15`a?6tMVwt?{j5{ Ҋ׍IaS-uG}i96þ7h!`ߒؗ}7A*;0#: \Bp j⠨/RqPRuNGnmpPK5;Z)nppu pyE88U'83w9N`l;<8Q@Q5Q3!j]DMف]5F]DțQ"8^ӈ>3,e(cGD-GT͈2(=qDi!J4"J=Q ?mWff|?nD#j;QGlu`}-WqBTeu!p(*]/eP¡+{q(-C'p4ơ;68~w@aqT*C+p(w!opX޿ὑ8+#pm: ‘!y8 GBv8v#{>G(Dk!Z-ѪlUލΪ Bl*e-5ђ-hᾈ:hhp>y}G/@[D/g z:D_؊s} "LD'mCa : !5G%ԉ Dc-<=D?\%X j0b,ӫ=bzd!F1Xm]]͂gEX更ΠrG-4[uZkŞr#f>ü EbguGPlaAVv[q1{v"fb@̍k&=]ic聘{ ˆc{Ňc7pjc)8yxgv 8.ȏqgھ2Zo~~_yG-6[w^gZחcp|1\߷ #{x=8VYi8N3&ضsbymp\(?\,rLGb- W"bͥk݋Wz?v--@و*X=pFGdĆBG REl2Įgu,k v;2#.fg?ެ>wb? NdoC>O_1遈Mۇ>Sk5zA\;ęq3|?\80Z7f2L8u?Yws3}<j3'hq> ggαv*#nⶇ nz"n"DsAkb;"(S} ^u9Uv#^y8J/!.1s~}sJ%wF[Oߣojx[<@$ďx7Zx }?U;|,هŽh!#~'לEj[HG|h,C|#zMqሿ Ocwp}@눿#/^B-K;a"a  "$ۂOpA p3bp, 1H8䃄(= a[m/<@k7$ 'ڥDt൨hD ;-q3j8Q(.DJ{$oDaC$DHD#HBb@$r#9;9#Hoq' 0u9H-a c$AW g!qf$.B:}o#quWe3(6unk;"amk58v'# ka$~[|$qH>$Q$ '!IIHR$ $)!IIҮHj~Kǽy4O$M)4 Iۑ45#iB$-5IaH:zIHƸ{tGM[HBғHz I:I/d_xq'{⤙NvN8iv뗌>pr f} 89'Gɡ#Z⊓+׮_}v_e`]pr'C p2dNn ɈQqp 8j/cp*/NSIq+n_ué^8uA<1Nw^aOsN8}m2菳qsμa3oLp*y3%?K'f؄2Z8U~Ũ78;"g] pv(Ywxgǧ8pv/neJ8;g}pv+.q]  Ź6qK 8p\ƴyĹ87Fm8; R7gT¹Iqn΍c36ܲidH$; Y m#Y%EqJ"%{ܹL;be]oI{fGCϼԷrnj'32=|/"6$gLEr$߾UHC݅H~KA|^η`0y^Qy,܍~$WCr;?M@H~oʑ/o#< /^H~?ɏp^T}~mFū)ì7/9Og9-ICF-q^W絶wA.%o:ϋo pa\`B6N\ Aqa .l!Fw\zmq+.\ 鹸(4.=b>ۅҸ.E9p<.8Ҩ=)푲u RXxwz=ڷ\|Rf %lRBʾHIıH91)qO{)H5Dhe\vLpł\0ev6S)lQSVl\[sVl\޼ /ap/ak\ɩ̓+jGjW.:N-Iwpu \]WWtUw}u`\IzX7\5p~!^q=w3R;#? +!Ue#R;oE'R'#UKgR-j\j~y+AsU: R=̛H]? +#uy.R}@I.%T[ۑԴ ^@AH=H=i!FZ$!- u+6ZY߫ƭ}m~:x}=~?~uok=[=6Uv_-kP=={ww>x(#Vt6HFzgH{7֮c!}Km/FvEHwN!}o}^}?<{䑾yog6d!=G#Z$S7&|p? Hŭ qa7q#7pcDrÍ븱7V*s(ōB[xq 7>oƍ )x7^eF2D6_tdCFw}d'"C2᠉ ȰKBF?]d= } so#Ãcqm][aȈQd#Q$rdE,d bl7qS7.Me767]nո9 67]ps\.n# iUnr  {7fOnΕ3N}9i<Vf*nf$nĭB%*؀[O3p++>kpŖQ(nw{q[)nnpێpE1kq\[ٚ;[ pgC8l$qw= AGwwG{cL{7&n ܽĴqos)Ľ!:aޢ7o:yf6ͥz޹w6N^\^{*O ýRr'^+fk!+n\oةzLOdmD6쫀Lr s'. 9ȜqMaiӐ9+6!sY 2^"s)1io!sod<̠LpFfL2J 2ovGŃȼ?,c<'3 Lgē)xⶭK^AyYȲAVq댬Lrfx@]캿.YfȚ)Ț@u>ݶeZ3Y Y+>s%yl@&׍l^"+@qU'7Yu}7ǚKAVp=k2ޱ=V_gܻ_V-m-- =,N=`{w l>t5Ol=+!8!r3tDgkG#=rz#g0rV"Ǫr,d.rMCcC΂g}^3w\y4uRס{ݮ BF5b@nslw~\iO)#Wd rՇ6lk3{;Da$ 2; r7h#/|WH!wY@Xf!8^c{ܔ @n,r#7F KO Đ'9}ܻ-="6r0Bn;kV@nUV,~*䎧# eWX+|e(F1us@ѧd}Aѫw QT(^bO 8Xs5PVNuj8c2ogPBqSס6_EUB#(Ny֖GD#JTsQܦq1}J ٺ*JªP%3'dz7LU@ɔ (%ףd NL6N~fLu=F}_{~eNO_;_~~Uo.5Ըp_B,|{Prg Jܸ bE>(f(r%d7wwS;S3]Gw%'.^P*tv*-SPMWPyi%ۢ4#?JoBiH)JGiRJc?׮j(`7Q Q/)x1xx<U@xn6x/R+=^nB5ͻ9UFZ%BaJY 2f8޲ (ye#DQ6!ʆCِ(eyP樏2d MeY-elQ}GBY,l:ʞHԮE({fP#kQ=|Au:Q ۣ|b;CX!Qr5 nF(壄P>zT|;?@DDd7eʧ1o @Cڢ|Q"ʗh|)Lס|E%WAj(_( PAn(r[|J|;F.FvdG|o(P~准0;s ʏB19_XvOl (Od$94l @yN_(4}\k'P4vL%(;Q~(a(^2v(/eS /dGR!?뫐lKOiZכ_funV Y :t1^o jdGT͂8߯ hT*}P6*腊7Q ؁ 0 Ψ0> #Ttg^wP1'*\zbHT z gyT @tTؽذ>`Q1Un{P1*橢bk%*6ơ@T㊽Q 5CQf=钨H݂Pqi*."G.oÇV X|y=|،>2>t<7a,>ܹ^|CPuaQy]W!*362>ZnHDTێ;YU=QYO_+gM y|=_}(. p',5ErǗ.5ID8ԌUB͘IqkQ35fl@M\|/4LԼ]q) ބNb \"$$~D};ᮋ  rEO4וh!Dք6#Zyh(eG!ZG3ym}ͶD[%L'ڴhcцDw n"!J#zlDw+"cqǶq"qDeıw;q-"8nAnj#ڀ8h)uHE 98_#v3SP8F' q&ήĩ"E[3̇8C#sPܤDE⌷!#jy-qXMgyqu%.эn,qG\BY%A\Y8?]'Ώ +K2uڷ7Kiѿ/>ɉj&ח5U*G74K#nJn@mJ7y3-^Pi41,qL$##D< GO'U(@yN^ v +ORA}B*:S;jV#H4{8s$;HxG>-G‰ϩ:_DVS{ι$6_%,7~Kg3k6ߥ>k/2?~ Mw%N"H( >wun̵iC"HD$"4H "^*WT0DړS 8&'Hdh : WId8K"I$,Dv$>l$t5V}4mkc˚̟{th[:g(k.o8<=I""$򘽖rLr9̫$a2n#Ѡ\1=YMH4_DΑU$@bmo Q$1<I&)C$ehl]z0I/!$N]H؁IZ?I듴3G LR+ HʧRjkH6z=3YZ$]y7$ֳiܿh&NHFt T dHɘ[]4CF2חdgLK79H2{cH&.db-I&N2'd.3+H&;ɤU6jQB2=QS@2õ$SzdY_r)"W.$S^H2orI y_|~N,4udwN!Hv !-H6hnJΓ9$Adސz3'?#J7I0׾$WjI${&Dl|=s%9y"jd_ $B/$|ӚNr}H0ErHNZ$o}-n߼cW9?D3N na+u捹_#K&$R. $粑䆄\$j$s[vuA }Dj7Cf$oV$csco븷H,|~ϛDU_@ Ig3)p&Λ ʤ1PE5ZM Ia9R}a)x!Y 0c7)x”Nd$),'_RXhL H;IRx^By@5EruRfEH3;ˇ0R8EՑջbBRjn )#>mW_MNC{KER= dGeU&[-",d{x~\u~#W^VJ+)4L#iJ F_ƵB874# lՑ4M|HS?4%̀LNI i #Ͱ)4$̈́[:4%yAy4'#WI,<4sH@R8LZHio'-#0o3$I_l e bRHZǐV^i]7$܃ӕz֙$:=N\'#+I6ڮsn6j&[I#pmVv;>@=rHDI{r iO*!|~6'&Itt"%vtTHt7DAtbH'ڜt"/lY׃t֌gt Ig d{&6 s5DHW|@RYRD=Љte4IxҕfD *sפk>tMV%]./Bst^Z|#c_}rL}H$zW m" SI;1td n YIksOWw7!IopOؑF$IoL9]Ez H>>Dž "I*R!-IM{^#}AQ-H?r ȠNI?|0 Ig乤g$}~z4omJA&.toC! CRkWWfƙL2赅 BȠO)OC = Aч j55"1`92TJ<7hLtp^o'$S "S[dh^ 3}jQ nd:d1̠E\ȴd2֑L#_֞ Qv3+ UwftEݙ1ug@Si4n MeJ} oMǒy2=Mdȴ,>8`E@i ~+ /g88ikEOOxle0&K9<87"}@F0/4!NpqzAGqJa}q&*_,\ET' !N I!\IZN \$&δnęHI}hAę؎878gt/ MX]`٘h !NA IW78}퉳q[gC{{H {2a4qvgp sl+fI^b)w`w>?v ^!K<%݉SnNYr%nRܨ:}܉kM\4G׬qXMf=JȬ FfY?7r+EO%x2hGf};x ",JMNY؞ WكVdvzwR9 $sUa2_jG2ބic|Vh,Z'ŜSd,K֑ՀxHVfr6-%idjGVjAfl *A#jV}bUZwfϬ~6vWϋQnX~dTqd(Y@VtjYm%Ud!U(zOV3 Oh6Y=HVV{yٓUQ؝.0~8eo/vYUbnE{p:YK#Хd Oց[J.7 [Y '/d0lZXilNr+Қl:N'7q9I6jLfG&M&Y%N6fTYI6o|f͸*(jK`w D6_Js(l Vl [d֌WŒ`]ZDܲ1|՝v#֕lom =J,ax4" ldҍlW5)*<9] K)&nE.-{Ovk]"[y6%]F٥ܓ6dw/N7&&dJvsn׃j%58W=Z^aճ+TJV쥬ɾqoԈEC'{4ϩ%NS}p2놑N7/^W/"eGrPį`W>7JrhOɡ|rp എ73p”ﳮnЭ%9%Ir#.+ȡ`rh@lSr^Oa%rB}CNF}#RSHoat<}rs<.2&ae'rX,Vc 9JYx 9^Y`JJb"9>yBgx195nBNI9q"ɠ99Frr^FNdrZ!䴷9&5ivV"3ڐSTrpl*gyw6wrښDN[N1=GNCx5Wt9],%|~ךDӭ,rz2Y;59y>)9G3ש~`ﺊ]q N#goɹyrLcKy}rsgrf!yĂDlM^9F._w! 9~{,$9/|DKs5ͤNeg6j㟜'l;uYlsIB.;rލ\&qRF.K-H.wsHn6(Mgs^&BsלIA*P)Iz\ pЭM _@@ju<ɝoAL{B7ׂzt!) i4z]i_~&VU BNr΂W0܇Ky깒Ng|WKbH UjWܭZW#W!% t-N1esW96 NC腥_BI6_ui{+V5u!.haIi{_cOLw ܥ1}Kw<)cOQ7A8|0Cs!uDG  ~ˏ.p >!|/~1xD;H.WVQ8%Y@EiVa1ᮁ.ftf~"!xhBcB"Î@$-Df_žY YyϏٛge(_-^ujWgXU[JJ^W(DB4̘D{Bw{с'!>Cy:\>E2-6JzsA㵏x]Ě^.@bnK?Ă@l>Tخ{b;bG&B,k0N Ad^/w/b{ . &+ wB\-fA\~ĕ@\ӛ-Y?!6ğCċ_T@B=$ABt:$ AB-$Bb*9$́HQq&: RnC0Hy!u ߵܣ{' R6Av28C_ UxH=}zR@m0t IR Eg@[Җ1@ڹ?]! ҞncRs:܆_0C{6g>ݐ^v.% ;__nƕ+ 8қخa;BzkHY;}}[HB4IX&Y54]&w#I?j}&\Wh5|YY\Ć֐k*"h*.S{kOy8}FY0SwZewن=@qhbw]<7f:h*GFST45]gϢ4GӋ`|/.}ȸiB= 2 u2 ;TOu Abڐ9%Ͱ2[ s2 ٷf/$!s2׮@&/275 s dBdsIȼ> Y oJrbd7CV}?dAVUo~^oLua<#d#&C67d;YV;/F1mAk. _M!C .@p1dJWlkZ}. {f:dsX5dl^} }ؕyoBm7Ⱦ{e-sldlZ/V\9} &kr=!'rS9妐Sguw`e'9lh9@r^^ ٳٳukpr ש`߱A= r!ig"h!Eh-EYhlZE hu1ZLA@{-X3YQhѳ->E/6; -Ai"$Z,CU! 1c轪j?@~_a/(K(8AQ z5`f!  ԠW'& #J0+Ƭ¸qP 0E SŠ0m) Y~!f>;ٱ)v(dX(l)j<OPػ ՠ} g⡐3oZx ް|az 6C(\( k<g|,;C1l'Oz#׼>"Lb'\Pφdv!(nR\R6/vn(\g굇%wP<A'W; J<,W( W@J?~`4̈́R yJeP:T+;Cy=2<ǓV%Lj>p@yGw-mma3=U@9$/UƯ]/dA|J_`^E9Tա*/Ce`B%"*QM=*{Cem5 'ʤ Lʴ+Pq*AeC|䴄aU 0?yP?_j;TOCK=M@TuVZMZ/# P[j+=Fj@mi^#cvLUR,Ծʠ%A|Sίeh0-)Z@K5 l)-K^2)PfP4{Lf94^f-YjZCK=CK;Zz}e8Z&ϡ-hYx@ZVסeΰZvkw9- h];ZmAې8ډBhu#kUB/:Lu*|eZrZ+C:6ZѪ CsR^M_&зE}ja:NlV)h[lmtt[CǮtנ*t[ЙڑCyuDshl:;:?rUU'SW9>:G>Uwܪ.xF{&!\i˥յy睡+ӊt[AW^--:W,_wsݙ" ׊n3gƺBocxB1fAoR"7O z[pMT^F<6JAoC>L޶Xmwo`}Nk;IAM@2}>~]gۼsU8f/dCuk nWd`}DFU' 2| C. ū1{/gwX)fV}5OY 0]C(vm }~00V?08V0^ 0.O`uL$a0LDe L4dalҬRވg#7>Sܿ~μP^Ϫy25ݥeS{6ļ 6XDr߼ch_N kF71'\qU}8'+ܦ6 \'p[WV{%-c3R5Pn\p#p]=m܀lpuyp#p{ǃ'wr:Әܔ0pM7UN.]̸BVԛ9Vlaڋ'w,k{ZsܵK| -ݟDp3'h]+7Ov>ٞO0ky fa1?̪ux&:vٝ#cٳa6fwaԗ!f{af7n%ϨVvq0+s٧"KNK\5 ÜGk,jk>`~$ۨy+惘v|Z4̓|z"glyKwjR|%2o9\/5>-y%X: 0N;,LgÂ+ 3OX8dx ! !gCygٹ2gעefv?,bb,obXL3ޙ#a1w,R X^^˫Oaw7vgXteJk׋XgIo}, 1>V&,դް?sZ֋whE:)"_΄O*=A_zZ2MJ~ʧ,[ǽ7$Q,gw}wiyѶN,ltT.ؘ܃]ͲBجuZC᰹[.<vsnvݍk -^;U^(S`o8ƣ`ozw{w{Mq ma?WcF3|F][ߓCD;< `_'?]Zt~pX8t9"pHüOpH pX਱Zh` GCp4Gb.~4ptb8 Ǖk8)Iy-~pW8u9n[O<2B)Nu5N34|:b4'b7i38: ёpkqRp Nq l~b8wӤpְ۪g,8M=$8MLvיo4+Ns,4w"RB4ώb33?L 8N ?i4ҶpNtTNOi"Y8݃Ӈp؛8UXÙY1ᬸJmY՞jp;yJp^>Up޶|;\=bcY-9*\zI.Cr.n\ؔu  p?pޚ"O$:8pmwN{lS?ʿ+U( *"\$*>*m WU^jb 7ڝe=5\ܮzgv?R2a =)pk }Lp=pyk\[BjW]˖8f[VIMDM-$TnKp7pSd([y_[pkn֑iEn~5d3! íxpn}W­Bp dxpCG 6"nc xZ {&jOH]:p;p{ p+bcy'~7bKx{]6Whufwp76b:_ݲ w^ w}=܇{2 c~U|TKOvpO,dQOQc;> tk-ph͏ Ϻ{fwi|+x8:<\_!* ѿiVwioOtOw5}i<~<}ӫ?y&O皮\5{G³6B:h#vm/ &wW}<.qVhmAeKfM)G۰3h5es^ ^k x&[}1umjVBۓ)h{j*gXCx,Ӿ{+xo2f?t>V ;c] Gk;xHSO'0OO6`s ՄO~>3.>q3%|&=7v>I73=>s=3%|g|:g4|VuY>؎l.C >0=[gG'>%MI.=k_<0||븈Oτom ʅoO÷B~7Fxw){e}d 6M=IxO9D 輻:1B'jO3DC{%;]ra:\.7;KHt. Mò7-h~ cd K]U5]k4tC:叮,D$F"@&v^^eG:XJ" 7jO}{"_$F@EygbxI쬗myTV!ZmTC`?_G`3K1|C`!XC8#0ncޣ:|za=BjD_|'quwO;73?sGh[#s0Y~oQAAAR Y&?u{ XqX==A+'z\C/u8I‰``{m; ؕ/nۛ  2=o x$!xR>g"x2/ॉ5e.^W>{;"H}Dp:W b#_j>ddkȸ6p6Kw.ΓExz?ϒzLGW?G3$ } Bas }.yόtɿ>wo;P}G,B;''-,!S2xڼ7{Fov8;^#VL}o@߂{t`~`('"E?觐~JOeQ jDm\-&:Q}vEE3+uEa BԵ>QyP7ussy?i*L` وVWAf z UkDkCNDC6[DAщ=iCtQDO/FlDexg;sgC?Rrϫmm=r}X*wq*MD>xinipѷ7 %D D.TDtqp9nW]#U\ו~wsj q+w17EܫW{ q O ƘvE0HLd혠̳0b &:aLp6zcwwLp|/aBۘе&x_ڦ Z`B֭}>T'򼭏^ODz 1 &HbhA=&!S5WYӽz&D`<|Ll }-^cG&ovb4Lqrk _1,L}«8b -g#^c+5jⵕ6!^3ofk=׬۹?gwj݀:]+ѷVsf⏺ ;!> O$#>GW1f;5{/#aGvD¾u~T>w[Ya忛 k \.@Hx\`$E$6Y]nVzWu^nGC櫛{4Hg'*Z$zDG$ #Q{&u"W诋<$v n߳fUf:7/$ Db8$F]B|$@45$&B⺇H0MCmdWͫk~*VU>5Դ $YH+C}OH,gU &ucxIm'I_`"&7ɍS0|p& _0Yn &0d 阬e <3aҽ>&PoٮRCL.s0C&n))BS1Et=4 Lރɣ]51y'=&_1fovj7vuZe&L;9LqNZScJ{)L)aL 1{4oP=15q N醩Sbnsobj%LMMYT Sԇ0QWLSiʥi0 6҄!ӒcڜDL+icڲ֘\eb"LˌôuKG1#LŴO0Tigܻqn>Ŵ[1n`ZY6Eho$5Zƫ$$H|Ynn$KY$Y;" Ya\k6 Io#s$uGҭH;IgTHv)"{$?@r$$!+#>gBH^H^ɫkMɳ<8Gr= k5E= `؂{k?y^ Y}ɫm%LH^m5='`z!<Pw>8çԾgL3? Uc`ŒR3F]nj11afL1S3'afYg0 3bBl3cflv3G 3Fcݘ9 f+;fya(fbVN9’njABhUwƬ5nfMYU(YDextsܘNga9JŬy Ŭ]k0k370x:vk!naV>;Vg̺'Ԟ:3|¬g1-^?kZ7iY`hWn,Pҍxh1f`v$q0{̎/Ķ=MEPړm]ه}1iα[]pM~2>rsu;\Ɯ0GsEi?-#1G}hc's`̸̱f 9"0gЦ5ӮNK2œm3b|̙sV5e(v07s\csScn RR{0G*R#Rܕⱦ~}H)!H_ajH,@JRb:"emGʨH#qH8qHp )3.!e&H"e ۻ~R6x %R6G!e+۹y)"h&R@Y6ô͐7)7#%4ђH4 cnba晕ccks b"y[bc{rZbDžHoBW5\Ǹf,tD,rnTHt6 _RE ?H CjL!bb0_[bvo7 |o>-&afC3j?KjͳV=y3o;~? 8\sjk讚h02̟\1?%mk`arc㾘B_r^7×9Lm}{[$w٣ZJϛg.~ê=OJ b(D`g, ^ł)X01?f?:lXr`GJ%~ּj#w\KN9| ‚X~|xT >V}yy baw,Ltk,XӐ ½,s4fmwXxV sİ0 /ba n [p,=EMbQl,J<\{UEI3Kb,VѮQ_v&wgyÐ;H[i mB"mi#U()"C$>0d"0Ҿ{~j25`6zamWcφa]9Xwr±ϕ`]ndu K^N=uũZue { ߰^ci/őХ!] 5!]˔! bt eH-FTBz!H&mnjt+} FpQBZiH_pfolΖ~pҏE/H?.ZH|gG"ń}Z6!p g[dd#u 2ÑmּzBd n%2Co!#RQȈh2VB !8QSq2*@F2.;a6MF. ehh,&36c匆Eo̰ [`{46z&acW6`cSldm ЭY}ac8`64d(Aq~M9ؘ  K6^ތe$$Ul[M[BltjO>V/Mˮb/ S,lOVblub|lMvC~!C{lm>6|r݈ lf1>[RޅmkL`Y`hl`p +]DZp;l_aۅn?o%nc_swǎ;+_V<駪rvcGDv$4ÎI!1%;aG%vWؠ"O2bvc*4YVYi;bS{3f۹`git>{`lm˯b(89z-_;o=۳b켷; 8,EqY;HcCe9ab'Z]b׊?z~]w`׽U]6bW *9 -nݾ)vwֵTkxVgS}16`UWMyܠw=w7Yb+Xa m7`r5{rGh1=cϗ{{/m^yث{-6`>:006ū+D~v؛v{טcd,{aK˾g~ {wn?޳؛c"2{&`p͓d؁7c7ɟܾwbhwzb\ )``Su>5]UjuX}cߺؗ>r?O3Ͼ?9_ft`qFfTeLl9Zw 3!ӠV]SIV.>@&4 2BfpdE#3#2{FfmdZ_2"~d3yd`e-2o( .d6Cf^``2קJ|yD6` 9O8K(z.AAUCTqHi:yxa!i+Bra҃p(Bz#ֳqvHUf0OԆ! G]pd;\#_] -p$]G2 wƑ]Kqv<#\qq*<5Ǒgqyi%ϲ^@:Yp.e],6rG(dy#> ˧)!4:!ףÚ{3AV(1dE!+d2k/wI9Y=z{DVb{Y~`?| '}Sb|Y9bZY k%#kAdͷ)vANV4GId`DY*w' م8ZjpB] '42qBK'ZkDh)N}D?8?Rc7`w؀솪kND0-'G781u'氹y8r/8ϯph\E;Ir 7pR(':Wm^~?RpRR~ y{qr;\'SUe|)+8lN;d,oN0Cv#{z{dt'!{EcdW1>٫^"{PdFy#dv@%Ⱦk㐝?we}rDϞ!EW՞`\ !=dB~s"-VDMi$v3؄3"ngL8ӽ<3oqvlΎۄqvJC9s"q*-^P#'v{#\9SℜyC~HܙmS0~9T[`0ǹ%~8b5έs2q.}e&w 1wpEMx+Wʒ?jVp^s\yt>5!8-^Rw߰]o[k/5/,W `5+l\m<ȕPEnim~-bܸL\ȪD?UKm\KDnb\Axz#Krİ]#7U?cv.%]q]B1?}e_?Kۖܝ7[>'Ð{%K*rK!k0r%B#E\Ӫǻ` 6y% Q*W5j+~52USOʹf+p<W-pW8j-Pvqy"f3kpէ \mwW}jgY\ծѸl՞ a~;?wΦ{z@W^܇kQGq-Fĵθ׊G㻸=k/e9{_V.!0eq]i%]WuMc\!uGq^]q}0GZzL3n\Q\_u7]q}D\?9+#vB z#O,yWUꋼzȓ<59iJ!yue +gO]^>? y3y 78Bތtzț?̝j2[Τ .Y~[郼U':y"/>63mkiz9NDގ|~y7jps͓%o3/9voX)Sϼ5tӸ=nn9zn>yn:TC~NUf>"_1!_7|fVwVӯV5 n}fntsqBSjw;lw{ wnDfRRW3Qe{Eٸ >)ޗu1U&<łjn(hp he֡`C 2`Wc(82?gvCDEPE}gmhhjE(Z:(Z勢OhguqQśf{7C.MDKp1f6]xtzlwaJ3dʪxwꌛx7ޥǻkxim݉w;_ݶG[2;љxwHWOݙx#w`ǻKպ*J5tQ$JAxJ'D4G&27LE'(32P PhlOB5aTB(UC:Lh ʄ_LʤP\2(S;Qf2T9~j5sC=#~wiǯyJ󣫿Kvv}acqMTnM}.ϼܐ]5} ]饡seW}k~:ʺ(oFi(a(鋲-P61KQ6=YMdپNfdBslRQʖzgNxS?@5+奣ފ;Pv7O Ȗ6 ې@Y)oOiON}K/"QK^77MCS|h ʰC^გ;>c(ջƇ0H20>[gu.|X,ʛ->f{36(R (}{Q'!I|PGK]|8a|ܲ6ǽq >e{NHL|c=%/ KGy97rYyx\ I(W@:եbQnQʽ{|sQm/{>E@a(#Qdӛ3{llMb(߲[cPmʷGV((d(W}j2:S`{|꞉OAG7| Pxxk8O"iZ|;9Iy |^Ӆ5>3 O|ϛ˴Vd/[vE|9_r\|X/߰x}Mr"=/,_ޗ ;]_O|mt_BUDIoɸf"jN4(0WU9+kKWqWd|ueh|mے~vT+߄[֭%uo9v7ۻVo۷]? XTH/CEЪ/ʟ^3U] P 3?TسS!*w *0"s*n[_n>{%tE# z!L}LHʹWU , OOU ^^K{*^aJfDJeDcyU-"D& ݉,9="|h?@ Q4Gw&!$8krD)g@wmreJWͽZXE1"f'P oEB+Ih; -;OBf7v?!lv~:0">FB Ihxek슉ϮlkR=[= H 7_E$l0MbHt gE6 ,3#@º׫ݟ^DIx? =MA7 $v4 !ᏍHb3PciM"2HDj74[N"HF"JN$G"z];D JH(DL4I ޔBXx'5EEPclj5v[LIL)#MHl~Nb;:)$Gdzh52;Kg;3#sB I"?N/tIv/Bwx=JHb`y$& !$FHbr:ILKkDrI%#}rY|v2I,9IKp@$$)aEͻIfJ MꗹAmxUB}Odb4IN )3>$9Ü$g'ٶ$ $i$=I.QbxCIr~{zdʚ+$};xG9[w/W %3t{_];5!3I*_n%$u6I=JRT#zHR $ I=%l**CxNBHZ8E;W? i#$|S$1IO(_DMQ[IK.5oNM8Raɜd+jH5QԤx"Ӟ3&OCɳHjB{ԴTN#SMI%;ʙ5rVl&s;H%גT.pIR\O*WI*õ9r=TͯTn'/H7ܓ'AR)\I*Cʳ lsJ&զ+IUyt"յ多Tt"խ&nC{^֝g$׾CCH R=Gwj?@R}ՏT_ː{}#5Rӵ 5qf`NjݤJ }R!/I(R6[01&u囤n0Mz> =oǐEHC"cF+DͯʅCMt3|&<)v '݀*^;Mz[=V~\pW5_eV(*2.![ 0Uydp__%Rb6 Jڔj4~PT I:df| דK<9@02EVgjN\K#+duy7UQU1YBV/! %zi,NdUNd)4% Gڷ/YwA֝hgɺ2YBd=$$aGnݏݱ;]d= Y/#QϨWzY'#za'oL)d}hY_dvd&d}Yߓ%@/ΰؐu!+I֏"lͼ$x>4F6ې)[Sϼ =HU VN6ò& D'Mady:l9D6[_Ͷ2١̰lvM$݃Xe2 {6Kֽ.t #2dsٜYA6W\2{ n4 ]}rON W侄}EJ =55syXIr'~Pώ'1@#(&M{KgjW״c5{H'))HާuL1y^W!ȇw̄ih>eؔ|VTOiޔ|Z#U 7H>m 'K>Q'^N>cGϸosL^b̿A>fس|#"u'.ajM>vP{ sjoMeP{^7K旨vDcj|~*W 3Ԟ}i_?GGKjzUv־x :ȴ-n{@ںRmCxz%_%.|/#^wzrM7ګ3~6p/_ctjOΐw*jL5yޝe;6'ߧB"b`gCr(:RGԱ#(v:JNR˨ uTI[{:ڽr c*utA~7M>EԱ=QNY gS;;Yޖ:MʤNQپ?c~a;ӑlt/u:.>IJ-Q.GPs.hN~vϑm~K2iX[A~oەB~.wdO޺#jLpDNSp݆^P` ,Gy=vÄGNQMpC)u]D}\'>!_C_kS-mԽt u/)֠AB$CA-V0>?GA&)J)(fȢحa J6az+ Z3MS((͏~`v JA'($ 4'&ޚt.,Gf#H>C=fRJPޛiIz_c>\6_w</jK xutPHWQ ~y??J ^gxK!Bb"B!b+u Qts}>A! (-v?@!c(db Eo'D jCERhg0BEoy2zRH B"(6cg )1zJROd>l:z67b(rSzZI= QOk6ס;mO2wNg9dy_u{_(, Ka"q/>^O0g),Gr/QX w[M tz%t^R-7wH}zwS۠)S꣐J}L4fW.ӯ9_Zeͭ+6jC}+S&yN'W?J:Ѐ 4`6p$zShHT߫F6i)tZe=W4X%;,Mh- ytݞA_WyC!E엤Lq}`D4TFsFRT(4Pƞ7YSo;G1).bS[WEVRcSlٟbW@ eVH# %k.v !m5@h2 B>AhN~G,XU_P;0W?o ’z aяa΃Pnsu5@U/kBX-+ [!AؤMUv a݂< ?~!܏}!܋ia^U3&Ax!DY %A |E!\w |{ C|.D>~d`~hA ڌ(<#D D%t!*b5DfBTuD&U5lʪb,}Ү{UZC(D=!= ZnAeDԞ#aDٝvU0] 5DoAt6W/p.:whX--wmz}5ߣOsƷ,X[4_ΠШ.ڠ\4F3hteIBhF 4ڿ߯F cƣ{R\3lw]sƧ]6ihb^/k Vb+JsIBp! B\wĵ!:.ew({ZC|Sūe ^ o! $^Bg>$?kem@<$-DR>AZcE ]#c!1u($&C"Q!173[B"9$r3C2>?ߓ筇ĵW3CM d^ws-$nTItQfH́R@j#HƠZR vBj?إUg'XsY&RIJ; 1۩ :ëٮƿtsHK8@Z\ҍS h=EBZ5{?GShzAM]y:E45QhvT{nI&g4~39hzj't4]ua; yF 4;hzw7^G}h^6ch?ZM|db \Ș@D2!c2AY ^ rC @ 2gBFC$2Eȼ7!+Ya5llb>3k| r!'9+@{&ؿ'r=I#=uZ>_RGKZ 7)rO|!ȏ^P53r :V'Whm6ZErhQ"yh(- C>*sb tS!8!' @~lA7_pΐ?g@>{=OAd3k\s|#K!l䟤A`  / qiek]-WSgW (ȗNw VC56BPCPBW(tP &A mt wgB!\sW;&}~?߾cCc@O(_B6g¼+PHSjP8ʅ(LB)(e?=P![8 یϽbN(ONPWXz1DCY(ޟůT{kJTyWY|$oP /$1_¡ds!JP2 _J}CmJm@#(A`d|Mo A\>(E*Ci( !ɬPQ ,7 JcrmPJ#o0@ir;(M`'TS̫e/<.}A(?ePL$͝lv&ӫ朇Cng|}o[53屳<9GAyd c1@OQ(QwfV(dz:n s|<ʇŠ|oZA B"ʥgou~15Pi*$tT5jP;*CűT8P1L=3= PI/A%_*WEoTʷPjh_USiU^P[-@}9T[BՍqVkH4AuЖՐW#@u,8 P]4w:oTS:j|_nn@P]]jZ[_swߜ% ckzC T\> " iπZZ}Պ PKڴ/ Pc߻&_Z1ŻAm99] m!PۺAjPK/bpP[{?j,6jo@5w1v/j¡vMjWvIjv^jg?B-j' -_@K0YS\4-f-#B]1 JP ^h ughT$hHw_@$PO^CGX k~3ĠC}{1ԷA}kB}T,cC2nu+)AdC]o(u1A]@]=vz?~_l҆=?{g*qm-4re4ݠ24VƲWXhVИAЈ q+CA4:yRԶcÒ)glw>cǠ~gjȮi ?h|`ٮx0hor2ߠ~*kMlMLhC3t9` 4=vZj-=RIߠ5x\VyZ7*>g5*s5r!.V6}heBZMxU;ǭšm6w+/|nkm 3ڣB{{[ :ZCNxy]n+crNc\+߳b2=4 ݮ. >mjS;Ϻwg{6\mg_|ޮ-jޑ<z#[A/Fz=*g=)3Ђ=t@Oz-AOa@q/5=z£֞%gψ=Uıg3wg_xGu *~T~лzw \k蝗^Nx+w-?Ccb.@tG=ma`p◡> %C@~4 $n'f@a-9,3{='=vk؎c7 S0X]y0  jq gaPE3:wa0CN0j|D`K ` 0q^x(gΜQvm=[ysDz=`b&XJb0\XLDZD܋ύab8 &a* Sio0̓I*L`C|q%0C`:9Lo^itSyӵ`Zxc3at?8&ļg8)Ŀapgb7pE\f?pBY6KY²KY4yW$ śgsImyg%F'97Gd'& 8ށs9_w3xv8.ם)\_Y#8 r(p-kv6v< nd^߯%q,?:1p]wS.~׶{f5=K;>t t~LfQ0SV)5͂ f&"03303$~˪Q`oM\g zY/j1|`l_ـ0s}_?MN y71yC|Y R0? -a=9Θ}0yAEv-0X=a1*,Yx,]3`h,`f7ˆ><uƏ- hز)d"%)#*+ dDi4Fwv_ݷ\}?|sy^:1jBmXMZ2T[xudZWf;ך̧WPP{juP9ul!Pi%4A<4r<2}]-fc؜O1Zf@"Zg6A5Akk{ 4$y{ay32ռ{gOZi-eY6_af9^hFhN4A{Xtʠcz: ji Dάt@'i%tfG@g.LhN@謟u կ~]gHɆNtޯo uꊹм']ؼIn,Z ݞ xW+  t@p9tm;Xp#;tGcg@wlX}g4fY zU_ϼuY[ z9|IS^z@_Uo5E ߵsQK!~c?foz6]}oW !37E4 MXCAFwa;;ިsg7m`x9 ^01`; w\#1< C 1<{gPNk#߷c0Z" #%0FB0j7Fm-06ds_8{F{42|?}{[~mg ^0FEa9Fate6-[+| lǍ0v0LQm4Läs%Lh4ޓa"2K`"}&#a`<&9 0Y&arj%LJ`r&dOLvä([?}ۍYo: `rov\zS$Z3 yLvx=Lc74t`evm0 U03E_̼x{[7s޿g10wZs [h='\a.杊`a>G;=͇ك0U06 fWε>0f{L/=S5yC/btE`wXEb", WKwXZrHXZ:X~ d],r$Xe XƸrV,2Rt Kד=q.Ps?lkln5?ϸEn;ngkn;`u-w}<,/B,tlZ o<Vs1BoFh s UF~I0FڎKt0Q#Nsk.F]31rXw.W`}$F61X?lFl&΀$l4sV&V6&*lfͷ96c`s6Ellbz!ۓR slۄx|cvm^әeRÊg`;|o3Z߳?=Gv ``6vAal.o-fS}ښ9 Q;fJb`<쎄57`wv }-τ=؎z v5a5CpP=uÛYpxm px*G7p/w՚s4 G]pGCp c1IptGWQ8]q8f1#qgL4~8uNppN{hEm^mZ&mtbL*Jpp9z17 0'\y1?`̥As3뵘cauVoay!y.1ù!ù8\*;=-Ny"6c[ >>r>4>#2>8wzGϊY:>IQYUION{9Sd -O~ &,` Y1!Cr0aU6|0[&4l„Y +ߋל}Wf+||^c QN6C[z{{wG2|W7 m.J<໇s"~?|T%Vj|?|o]|aߚNt _5jyKwYQS0÷A⓽cGLɾ}6i & ?AZik' ~7x[Խ? )B(o)iE LO4lg ?\Y}~z\QȀ+珃z_΁vCSmU3ÿԀv5C___: Pa3tD*'T@@v11E@#P j.z!0^D!X5V\`7C]{Nl%`|$nptd[C*)ɯ0}L飗24(oW~'=翸]>?\ܮ?yo;wnNɿ~4#ci`A^"{]0I{0%S0i7 ~AaZ >|6] [we-= !|+GG`}={  ^5/l$Ÿ@w!L_oyU[;oϺY3\F`f^KbfZfHbBOL̥f` f.¬KYFaK̺9h0f=Yg`VDP$",þ2x!BSk\D8" "FDuDX׈w {#b"vEq"nC흈xgT #Rx";; R"6"0#5!ͯ#t"U/#ReTHY Hi3us*tXȩ86jx""}'#2ʘB2 2"_#rI"SW rUDnEEܩ""wϼD"DFdmcY>*"?rO(9R( D ޅ(1SG j^D*EJDŤ!GnC$D[.E&D/FUvh8Dx6`u '!ڧnn :}":(7=Bta" ؾi%)w F3b4 1j341grA1ʺQ|1wBmbv#f}1b֊ &W1k#&bV!fb fĤ,qo]f֝1s; 6v(bMkpZ^XHybCtrA셥D ľAְX/0 F`K+퍹}c$CUsb%{ ՘6sCbJ ]vs/b9]̭0܋o E̽>sNƼ1{ؿļ֘a-z#Nt!89yG0guqOg(8j:7pgSch ,Mq_"^/7?PjWApkK"l*J ;[ Gy`q,QoC8l#vWycIX<K|krM²{X aq*ǘwvߺWcq3W߉ R$HQ;w2)J{):2)qjD.R )"iJ)$+ );sͯUo. T LHʴ+ټJ OR)uHؙ\< [#XΙ7pH HrDj'vT}Hcv}.K:7/3 m']\  b ΎCZb9%qzX2%`,%`8),qc+]Ry19%Y5/ ,'%|N,ii7"*iϒ4i/ *۾͟_Y_=~?y3, %X.l%aF ,ِ:ݼܯލd9%Um6ZzO-Ex+"]ՙSB~$ҵOqۑ?!+>{# 3\s#SAOoBlҧ ~&j9\k=wwk>g.ϛc d8#a2F"Ö0ܲo8y*s1Q{_"T,2 N5c!_>52m2+#)vT筍9L{Ed6ɝ9a2} 9*2="}otx[~7{R 'V!,d!8{5D-dFQȼ{w.^D+2c{lwUeS@zVGd}}ܼ>K;7ˮzb?,e}~G,y˪`ًX j}SUg"[`*}+rXn<w}/-C>~ 3?eo}$6_c/X>þaym,x}|bg!X~A 0&k~?'\ 5[:+TCbQV,T%X+`i9b JNX>|ƚm;mʐ+~𳍼++r δ-_+t۳cr5;TUz\ŷȕG7nO%d亲j\Cvnnm<: c CD^ދ:E"O/s[nl GOu۰ķc'a}XJf\aVal5h¸#w^Qeȷ?U" ys yݶ6~`G~y䯫E }_4*ͱl;"E[/gsgQȿG=;(舂(@ A(`R I@(Pj+P=G݇( \KP`SB`3vPUI fP63ӂS `R̝9(g(8Ŗ,YL?G{O(F(l_BABJdz -9z P %QkQҖe3MG--awܟ;(vWQXi('Qx\GgFau8 _BaU1 _ء A~4AGcAl6Ƒ4l6)bSM{ˍ6~VBQM E_$ ]}e0ﹿ=aulm:+m l6#M5Msnbm%VnL36SwlŶHl[m e-7|˰-[Ƕl; c[cJl7mvg7>5 }clwǾEh =q|bv?5lƭ$`<A;vaӱ7vlvǎMQ ;c=vdƎؑ ;ϬvG5`Gy v|\Y%x]59x"vLξS2 ;bgo7ـKqyBǰA;NNaة;bz}w 3iH~%ڱ{O`Π9;>NBt3ޞ{Vs߽HS;;s~W6ec]欿P"K[:v}RA#Vɐݖm]Yg}Dv`a=)vO|Ұ2v{`w,۷,3c}ov]]nc^{갇`wio{w7$`<{&gcbw{fRSOyOfyx\/zxVx{aղGV_b˱; _Oհ}~k7ݱa uf}v^sI {c2`BS}{/aB"wq;ž7uZG{]~1Z"byG_-N>d~?< C_˰9~ki6wFb&?W?9N{2K@8 5Wjsӌq -/A88 V61m^gXO8u=n>85ppuW{~1]=geGqwDX&FH8;twClSDq0'}P6{%(ECmPlAŖ3P rY(?J =kkss Q6Ů}Q\b'}n;ϺxUG@ iɢxf~CPJz$D8JDG޺\' rGɄ(B*( %Op'J X~J Q2=%3P25%;=#%q}P2wJbPUq(Ya6 %yy(JVO@()<(͞xJ+J2%Prj2JNO^YSv J>A](Bi-(WAi^(t"P:@Q*=R)(LEi(!RUi*oEy-B遵(ݛULd9ڌ@Q(C{C:AfJj݌λ??O*8ġ(S2C( EMQ6a|,8[G(; e1=P6[e(+߀6(;i(;<e(+^}Qv:y?;UGYe<΍=h#f8" G-q ő68" GOM1}aa}Ƒoqd ۳GVH&nHncWn+8t;<#_HMdל~qTS%8I8*+Gpp=!7 8Hǒf c5n8>Cp<-p<3Ox*Oqep|&'T1 'w8y'2ĒRXap κәn828}7N_ɰHtB2\~MG̓^vU*PԝSK9^N@ mDPd (/ n(ϭD(OHv?K켳P~Ovj_X/|?ksQ^s Qivsl78:8厳lbIp֛G_!31,՘ٙ 8ol*_5T@RT8?a+#禩HT$@E/*P{ɨ YThi)[g>oSC.3V~kl׻ίl1{qJ:.7F.Ji;8wݿ$zᒘ.IåKpi \ťŸt.UJҙ \:K'7҉ pLJSp åq) ,.Ũn;o/5'C\V e{<P\qeq.oy-w^P.Ozmqma5Zk1*'%*&Pi| F PiXʡPɽJ-މHgT&Gq#X>F|{EJ+/=E5Qpvj\0WL⊉9t\nٸWW;g\廎+U:x؏=qsj+U p}eo^E5x\ԡe{µ pGUK mq(2~aUimp8n?p|n2x8ډW#;yqg>_]+w{~gB={2poP qa/v~[}z%{-7js|?͉7T~w׮ﺴ(iɥTSm ߉:޸5fָo&px?sq-Cfƻv?V=61~5<,<~GAxGxt+ZJ9}G_'w N>Bʇ)Q<6Sxj<O੮ hx;ṧe__uH Ff2F!U;w>Uӿ*Uq}PΉTQrʏEՎWȲ[&z U{Pu(uDU @ձ6:[;탪ըCYaT]hKQu8NTf{DU_yS?ZWWՁSx+Jr==8uoFm<^,^x3 {D'Me_G^_ũExULxx}n37(^_f 7fx7#h 71oF$U/T T?7=PN-A';ZYJQ=p57yigFzrT;F=?MPjKܺYM83Tes}3~:9 38:e&:SՋGsk2 )xu &Z똆wG]xǿK!kdQN ՏQ}*'o~[;F~77ʻWWڴ>67[gwkn -wKw]fޥû%ovR3»?ohq;wWxf7޽f} =1O&}y.Rx?EIM_1tE?vo]g*>0O>u*m*z*A5> Ƈ~kA77)Ga>$Ň | Ԓ5HWrՏꆏNՍ3k 91cq|\煏WJ^ǒ7wvC|쌏AMu^Zsٿe ?>~JǏ6~'> P|JO#G 'F>)=][cO9iU=>7§.9?zIN Sy.|op|n/5mQ5n8uD`EԌ،5@1V7ޛP3N 5SQ0 53-Pz5ɺIdZA{Ԭ_mN)>iy5O>QԼB-%)jd{]RAm;_@wjF8ԎuB3?[ׇ3vq[؇5MfgG= vF|}n +Q{ Q{1 P{#uڽHُ[l}t4jOz5^nU jo8X_2@D:3XuuZS 筙NIynyY.@ u~ɨ,v{:u z.uPz8J^g5Q9}Qpꓙ? هQu;O)|1/S|A}~פo3Q:/P G#ߺJc_^K'Pq!/ؠ<;SP"ꏈ@gowv1Ɨ/%w/wG˝Er7\/W&=n/Ϝ9_S>v药B*_;OW_|?2չ _᫇9T| z|]}_W1. DE^~Vw|,3-j͝wޯ<K4iZG1m+& ZР$mhh4-ϡVGCP?4g-efԼuϼfO0o0)\-ķg>HhoB  m;lA 3 D#LO vХ)͇on3d."NJvni޿0q aB0m6W%DtOId َ$>Y3G|oh~fCi0_ ~05K|"7{yL"~:"~+s7M"~įs'FLM? LJUHQL6!?$Jr ?2K_#z?7&g݈y3N&#[yә_-gM1o %H 2f!b>$Dj[HmwSvjs.U:ÖJ&}Q-u<_Pڅ7}3?v22N6H`4 Z$8C, %>$8u9 %pi]Hpv;KɋH0i! Ǒ \ؿ~/$ ԑ7_5#>'H(|Z2 ȴb<~^y= #i!$НƚW ABWjkPReS}o}@$t̊ʓP2 jKBIhScP#Y$T.$t? ][HBW.7n4՞whLBU>c+A?R=X@z.y=usA:؎ahPؕ:䯢y1?aTop2:;9āFK1Q$:GVp~S5:PGqwxK[Qc36Աu<֩D{ ujK^pQF惆Q$ɩjSTwqSORlHMQgy=u.R罁 |::ҡGJjW|ބ=p- ʐ$Ѓ'".$<}"Ix[$<·HxF m$<- g-%%1$+DkIxk^>&$\Dy$7!n$G~ !#$\ pI1 "ኻ$| {6w?&$|Mxpj>B"|$"؆DH"uD!~)$2-(i4q$G9WE"iMSsID'C"gI |O"^uD^ 3IyyRrw/O]:m. Kԥ—A]4RuIZM]>hR2L#!rߥ.P;˩ُԵ[ vq uMnezUW;?])&>-NdHtM $Hm=HH1V=I\Kb]*I-$jV!'#1"SLb؄$ĒH,NO:LXղ $n+XI^>$2Iin޿B R]ښK`G>`Х}*zQs~s-+߁z' $q$$4yHqH" ILoROMh("IJn^ CSk굻zz@.u^5Sz_Nޝw[$nӋz LJʨ~]z)ޥqf&C_}-z_mC,ޗG2-H>jPeO}ps?Z#ό>!}iFCIRܑ$EHKF63%IZ޲߶ IՐWK};ՓEKsĪé꫷d #@}S_WՇz}{3ac 7S߫y_HTARHߟ~3ufԷ?14H 걐}ӂh} 94hU_a ʉOӠGQ4m7ځ `>5Ŕ ;ރXS{4XM O`4XO{OE4صIviGfTu54xZ[I'nz 9=yHrZHNɩ*}kٗBrsdH.ʄ&& Hn!<$7=+$$ęŸ_yj7Jr{7ܶ+%HJ:U܉$wc#$wh9ɕtMf|+2?TwmF~[e=ɛAjyh$D㏐bT 1zܺǦɖg\s|gF|mڔEņ$;+2?1!GI+Asoe'Hλ:Ȑ|e??=^jw{7IAT4Sal=)xg)#CಌIaR-E A 06) S9.dbu(ЃqYRm))HZDjIQa )!BG[IQ;JREh7)2d=)_ݲ$v#Ÿ8b{Sm?)uGJGIRbHJj,HIl9,Is=)yy!)ڒ ܚYo9mk2)ż#V5&_'tH'G Bt_n YRځ.n}IzR@vI);1t#eŤ2Hy')g3Rv}00Đk)e"eoR;2HԒSEzSr)?EʏHQ1)?4'ףHj )L%lǛ\\E̙TƑJrRK*&"$TkeIEo/bO*'Ie+R E*ϓ45RA*s.J;RG*JlIR T%ա i9p/H5 %H5c*zT LRwTOǓɌ͙TlI,~Τ|GX Ρ4T }Fӄhq44d "MCЀI4tr LC]g8ky0?9ܿw|vk?aRSۑ3 BjǓ~RSTѤfcBj1jѕԂR ᧤qJ#Iݩʚ4^ Exz4f)|4;v5HS#i:摦m'ͅ4nfC\H9HsUi.;ͳGf'i_! >4J>IxFc*Y646u֤Y4߲^KliNZB5ŧHZ[jÚjDHkz{˳&IKad[Tå8iͻ@ZHk:eU-MZoY}CZUbSAa/PjDFm; 붟uyIÄgѰ>492oC }GFH0`ҎAQ{Iȃאf%)'0mt* =H]_._*޺qu:G l.}0tI\{{џtqj9VYL?ІIiHOV^"4<۔[,J$=kJz޸{:!jH/BՂ>%u!gԇ#2H'w=JKړ~ W'a/9#.SŦ}?Gq&UH^}7ҫNzZ~$ "Jү@ʏ kd ='dz _d!&dP҉SKs ɠ8; =x##Ƞ̟eҘ釐.dpמ fP$OJ72T K9dpqGd2 dД XaI:JsaP >'C"2XB dLfdha8ji~?"?)G$dx}+^.^4fEL!d4(Ցd45BQ2 :MFdp& a2JFF߈Q2Z|7ߝ'olzKXn#!c)ڀ[dP@NmJdغ3;~hs.'1 S8g2@ƞd@ƮѾֿ5x 2Kƹ)d9nG&~nd2y1L|I&dLޓIN2F&s$*L"K$(L d]Ud,L&ϐIx2Y?LJɚdɣVT #c!L dy*CG2!Qj|MiOd Y2M!wtA_BIGtyA4LgiGٿsQddՑL74Gɴt=Oo8AfsٛdvΕ*ɬL!3OYϼS'2o?q}lɼ'd.Zڔ#d~xr, GQd񐽣\{ww3yod8Y@dY*Dur&CۿjLײJYV ,i4Y^ "-V= /}|y^bdUMVW՚*dj=Y&C5 #bduZNVe'iDtFΦ3~U ˢш9iD'3Xn\A#oЈi+6[2FԦ7҈4bM)z7/M2_K#JOi4&oȧid-O*VL)Y'kd-擵d YM=e!nId}Y_'mdՀl_!ۯ|4Jh*I-Q9giJ-%F~IQ;jhԁ59 8/rX{>="W6tO"GGZwQÛǐcTr6%GKM*8UYNc=i{c9Db ,r'-g \oK9e##׮CUx-%WYkd@ \e\%JrMۋRTӂ9ﻗu\u#{PNH%gPr{\0nr<*;r;Cnoۚ(rw|Eֿxwh*ڳqKՒ{~r_Ik}r\Hϑ%yrCF~ ؤJ hJSe :p<6^πY?ˀi@l]ES~Z,C x] GS>I17C-}1{Ӏ: ~H`ǯ }iiLJ-{yP7@ c82n Eދdk r;hChs$Z{ӠVUi<fg7H;8~^OzyM~j~_{~y 7z_/7͟Yߌvfc34'8:]o{ _m >'>iyi p LY| ,6J|#dvo1l#+xSSH%AHC<BZ gB\ڻ&}dACFV#W=a9tQÔ-{a `؍ۊaot(KBH~tHۉ]g(:oPtt: /O\ᾎT+'C6~?w|uVCR]Mt|.a?F.s " 2?DZC$ "3B!2S"Qᬗl!1"^BdLl1I<4%]{J?tD63ѵ]( AW#5t iEj2]Mxkgl/EWI:Oȣ*ql ֯dV\nz~ԁi{:'B4E! =x% zhD_c? !z#g>g}.}فDhu@%;C8:U@LDb]4zy"wXC l i+, c=vFBlXI-N @L+_ 1;պ=Fjxrwxwku q^MA|?-CjG@|,j!n> f=CKcB|ǯC9;Z?g85V :G ~r'˟q6/{v [`t:nBm#tΪ)E7:t3IC7NEDƓmU[[Y[`ިo~)t;0GF̅dt7V]]꡻ t;{AtG`t5[+6gBнb5_&+yzDm@ik'GzdK'mE+fD4:X?= }$z;`zĢ!_ez6?%|2 ; C$VU@b\fw3G/Fs-Km`\ү$!)!9 9o $!i8$7H)dGH3]ˏ?bֵd/$1|F_u픅%C}%зV7Ķ6d+;G틾wZ-滢{^VBʃ{-}{y}H3ë9-ҤzCJ APRB;Hh@jJC*,R@* R!RBj;v Bj"HrH/YGH]G!jK U_ڄKwԁtgH·XC'{-t_iViHy$GvL!=:cRԷiya~7HA:}=B:!g6Wt+HMަ 3!}`1!]ҥy݀tm_~ F~ __my~k&_';w 5w]A?h\? 5렿c*&{}Au [C2d2|ntb!2E Ai,?2YD9dJ S2G s2'!s>d.$B+dBf?˙aY^ow~'!#d^<;mȎ6lpfwdH8wƞ)ݛSK7`!I io`gZ [AE13&\ŠI+0C ܋ɐ{yr@8UA ޫAc:Cfȷ.eu ;@Esկw eC~'!+ͅȫ>7ˌB9Պ ȏq!<SB~(/Rb@ BPjPwP^P0BPPPmNP8P(mL(ئAaš jPevPXmP <.p{*A?rĚ~Lz(`&ހ;|bn g8`;Nk]P(> W^gO(>Ժ>wf'q** @QyU%Eu{(j^-/k\(\ P,qb+/@#C(: ׫`%eY( ] %Z( %P2](E5֘z(9 qOIgCTArHXAž*NPq^P)< @%a=T=PY0+T6PIJ"T.ʵPM]4W0T xCc<jc@ P51oӫ6[e@}ԭ;Bݦ=ougC}C73q^Kh hlmC$q 428:/m.oc5Mu[h?M{hFJB3ʛU=G>V q, | ͯE%`- ZgAKhNp :ֆ\hBk+hm)֑к +;ʍЪeu_u aݏp0l)bf S70%;hwbX/^hmu5Sv@0Ե=Բ?w=ОW xih'|v6A;uAGо56p~gC [t,A13W@g l>$@gWg J98:@;<{Щev|u5}ڜ7t ;z1|ގ;8#=zMَi0TC)˦3@V?reЗτB1J$UB_ zAz9Ro}Gigi~WBWпrWCv?>C/ _0C@n) @W `0w`0 ad 3 VAdY0Xo-a}8{- .5Ư vq0C,ۻ܅~|-~fs4˔Ӝ> Fnq0|00F7`tI>݁a0/y0jc{Wqw:SazlָW`|+q=x g_ Os'$! &I>0YP0I]%0Y-+X_/̆I0]CaoLô-S\Nm`:*0u]rxqz]~L~apA}`:UO`:# 4R0]0 ;2"vFL`0]J0]f S07S3 fR0΁Y0S3Esń,v?a|VDlQ7a5̶[0{PΩ/UaV ft},٧]0uW럴h`, u B5XloʷŎpX>}_`v¢X! -d~e)=C OYr^Xҽ,=$`9q,wr>XΪebX&i3܆B/e:3rgwVgq-<ˣ`y,wX>eM,laY;UUVZ+2+2.6&/VSVjZ6U#?j*H`䘧|z9z~XOφ,TH-XmxAMyj67͚趽6 y̼=~4l;VX]~؊p<*FVy/lU`vlVg-l`z}?`[: ۊ.4ʹW`F2`[kۯ'0_(51FƨQ3q'8r=ّ[u$g4v`tva7c¥a7?aUvWaegal;첷.w5حuaBngrp8 HCQp0up^cᐔ G0[փp[ákGr8 lc8JhñH88j<>8Fz11ͽ] Sv8]Wm8u̇S8 ?!8u S#pc9I7- qpRb\yTIu80^ 'tv\8ͭ>q]SS=9}8/S$;#biG8[j8%eiq=,Ĭ/g$")Nyp=N{Vin8;T<NJp:y(68WɳpWtF bt9|_`tPs΂{< 48oKޘs\ޯϞupG8. we)\%\RO% .˔j|*\֞˺|lh m\vbycpp.l\ pAps.wpy)*AQpK+Jբ)\pP)| ]E8\wl롉p=l]w-$>`Lf: nfpp(Fh] p{n(rw0+σgܭ}ܭ`wG[Ng8o{7a-pp?~=0 7½i(,l?{ oJNW1f+<ålxLyC }UxN9Ƕ |?KG2x u / ɸ0켒 <-c1<% O #Z5\x- 0o3C޲ߒ4i ^Y^ xweN'|孧 g>'~8|l0 >*8>_DGM3|[ޑ>9U 59s>99 >DçAch Lp 076/DŽJ0ag &upb©՘p&?[. 10t &DŽ+1 Ueu ~Nl>ִji6$cf^iV1md{L-4u`w5ôYc0mg~!*Pe*^C 8dz_sC5k!44C-VLOڌ a.XS`z-Lϙ髽1=w}՘~P3U?ae6$9ĶH?nuHD$*A4$6B/$N$,$!G~$E5lGR3DT$-exkgc~o}0_ū0Z,VV`~ggۈ^ݐ\CUɪcf{tuH/h7@K},X ֎ IcAwX`Uv6Zn" X "\`g,{`ACX#saJ)JH3 %mR@r)_`:g/ۂH9ށa RN!S\ FJ'Rl摑%{V]w?sRwu6Զq ~=~'7L~T3yf^7w/z/eTAHwBh!UuR@}SMVc(ƺH51AL@g;CO4RCn u&?C:ԈH0FHi\Z"itE҆ C6Րf i&H3UB Y29mi.fĿ:믹G&xG)MC;yV!my_AUM܄w iH FڴHU~HBlEHis!-$ m2I33[[775ϚzgR -fJ"-Y/|$Vߧ5H]<}nmE!7%[{0%ĦAHȐDez uȘRȘmAj3dz!g$2}G#sud F ^̩QȜ&ж,7B9Wo@{5d߄55DYrȒEY?5o!O6kD ݑ膬QeZY+W!kTdBY_dUH B +d=쌬'ot-Ʋʥ O ]3כ==|ys1;jMYyD:7Tjً%CBqdo]퐽{$d {/Xldß}MamdW #hFo ]6aŨX~beV`e|EV>G>:g`9Xp0 .bgG9Uuȑ=j6:qGΘqNEKW不y#4GNTfwR99)Y 96-6)2D =9^ F4jWwjXk>bͧ4| kjr;al5O3yx\߽i<+6."GJ|DQJmF3?+g\H*y!We r/nFK书!f!o}Ee oR!/# /ɘ9Gی^1[뀼wy fꢑW/n&;wcE06X?"lpC~b;|.o/p!c-;#s(#_,+Vn݌kA6u ߴĚ=u3\3g q?#?4;2s}b8XM5eϵGoʐmswD"_A_j >ȩ/zP BPе y'@k9 e@GzQXT8E(C7 |tQ!R#(؝Pp NEy9܏aܹ_9kbaܹm_QpԂ;]-@Ad+_~WnFs?oFۦ~p}/7 > K6wyM5G{;vP`( UX68vܽ կPs u^P7 QhB(՛ Nб6B( Aᬵ(4Fa p|ƎjQ7k;0?G/w~`hz;Px7Q㾽z/sU=)iPZJZ4hQ$ Q!#;3{RY!t$ qߟqus|^yl=6 6q3\&n{l,M*MB1$M^$1$`S_Sr&7ؤNjM#3嬊տkߝm睦Ny4Yo;{tl M4+b°igSVlǦO?bؼTW~؜yؼw>\[92[9VZimN6%6=m× 6q;`1sl;qꇾcCv@Ӿ6c[]O(~(`Kzd.9,5 Q0GP0$C FP`QQ(g((p؅Gue]vv׻}x0 lGѧ(x{\Q 96`7ucm:K};uvtZkF`Zkc:;XݻaZtbpcOg1t=2#!=}`OQ9=3|iZc=#0[Ğ'{G{4԰H읣ћ7X>ޕwu-Kފ[xbG>7 栰;v} V}ƿqI͹OoܽoSwhS%?^hwva бNWQ8!W= S) }pj 0Pi2 7GV}@,F)9(<E\)(Љ":VxNq|?q-q#P9 E{z\@: ex"Rr4HE3EhJy3ESh2Ynrؽh67}oQtE <? _2ye[#|q@cxBo|Wz:9rۗ!ݡq_???޻x!GvӜ7(~8`9/P8qW8,SߩvƁ8pg}`<Ǟx5OFfވs(>E}QWϡo}E)(~_P8ťk/^M18&^pLz{twyK1U pCS+ƱR81;cqlyscV8cq80ǖDZ|8v%fx]m]l] .]DZI8ve]ƱpD{֍X݆x18P x./ N8$p@?TqR㟥pd( 8aNpOp'DpzvN/q:S=N:}֩ pJKVꋃ8&W ''53p*DL38#g4pYga8z g"xq&Rgfęhk8:{Wg:!?z,}g߻GXgS;wn9s',p|;sgzYV\p 8W >jܧ9&yvyQ8=GhNy8p^QZ~5y8of #/%O8

症ii8#?;_pA[m59ӊq2<8qOsJP"-~Qp%[KQ/](}%{'pJɠh%JN$RJGɵJƢa؇[ Pr;%e(k{Pr%F T%TP %_'7.t8 ="J꿶׌P:;mpӚOܷyT3E%(iA+&A [b} VR&.XqٿW. ⊘3Z+[q㊢p{Z=m]Eq. .{}y߻orh sq\ybk+vqe\HUi:u3}7;Ώj;iB|S\KeNCvsݒŵ(Q!(/@)(5QFjC0J6t=J'ԇS=P:S(M(  J4esO;JϮExyһyN$\)kp4\&7nGuj\p#jn̮Ǎqc)Xq.nzwq7;D&on MzܔZg2Nu)߫,9٩MLܔW{܎ށsKq;6 &]~Z{]Py4!;p$);0U );b#Ca(GHD;L6z桬Y@/LyGL9eǡL{? E٨nG9:Mec#ʼtP6UgܒE (煲kkX݂%wh1;J$n/YmS+{wpIw]pwB/ܝȉqwgS;w6F&N,[:1b/q)~IXC_tC߆Ds)5^xāƯ)|H M`x|N]Ńixp(ۆ%Ll',Em(0E; I4QmFy8ˊ^'-DPToA\R \S_8*f@EtGT,.AE)*RxQ *uQ"(*61!8Yxv^E C*\A[_<߮Gx^ < zQ9d2*ʢҐFPiJs}TCoܥ{}jϬCwv/ ThRPҨrCi Q Y ^lG2r;*5Q9߄xWT.-ʤT.7P<*WrcTV9TꡲJU`UҨ*釨ꟍ~\ 6d*;nTCTe8*TʿUP|U*TFM{ʶp3Ë] p^\.Ƌ+>^;mGGy4hO g'r^n_JAӝ~Tw9|ٳ|N7%ǠZ 厠[T+gZ0P=@ զ!95gk05h°5QܺGs~@}Y|P35>Q;5[Q5YP;5yը5Yv&jvCٗF_[Ps}jf)<ʳyq5չ=3ߦ{ jV(R}Q+z_P;$ Y5f8ZãƑͯE_(KdY+:˾xɐ;7xyG}hmvLn~R^\ ~,/^b=셗_ KI+Qx%'3Ixpk=Ji+^+@RSb+u5pū,kP5^i+mKQ/p12"^+:Đ$oFf8^Ûax7;f *>m9`7'Y~)ěwy]=#v{{a oNx)7Vsx[o?\ۯRϠs&E]7NuG]רcyo;;w*,k\uQqsC/s:먛r3L}~?i9li;W͹Ѩn,ԭdMPSuxPE]EoE~xT:|؎k!7 ŇwQOl"zNWE:O,u)chc? Qoc~r6'#Po?:"@}?Ʌ%?sϥQ_$Կ܏/#9|gOG1 58<>jG8t>9U|4녏+q\|qǫ)Wa>a8Oeg1>Ba|'OEkm`t|:aOa&>=Ƨz|z~*ӋT'OY{_J|->h_^{}|~+]wITKsV|gy̷n>o瓁 z'ϻ Zz#˂wMo%6y/9|l/] wO"?|sa]< Mbj/#خY8|q|/ %p=dVo5}~9?/2˽rWA%|6W:_ xi2`xu՚N_='f`(׬{|C|]7_TOԒ t z_vc|3h@|/4I;6DZ5LjGΤ=&#d'Y^%TDz0^xGj1_fUOnaTyՄ8_g~ٚo9ߪFMhs?sǿz"L" ]/H:8G6֟%y ǨCJ7DUЦuue]u::DRGy=-Z5͍cgm1eqa?X:nNLi2u|VL_5vlNo:AFSw1:~zF?_N7[l1q[wO)zN܊1ݟqӈ{d $MĽ}qJ{ ]4 >g)~>i^ֽS[n;t6R'RމxO L<|ˉ"1ZCⱞIS˩{Խuޑlu~t握h*uB{Ҩ-uҧB \]˳~gV8\٫aV]$tdDG{.^4uzzh9W֥5!P՛ACy3'^;Mx}oTx%ބ<]dOěxc2>9Okw"n'hM|Om_̶>OWT^30#>CN@|v" ހRķ;O|WߣG>>_XG|>*'s"7hW&/J< t!SI(G Sa> :"A&7HWSH0 `XnB $0XTI` -n6 fxOqn$ߑ"%$T;$fC+`:;?9W"-|?x:`( !w$-[PmM&!>r'/I< MXGBIhz_mkv"{ $"ȱ sK $Poa^اېzoOB[]Vj:oEB\$ DBq:N?&3HJ:/X/!̫H@*eH1~O6xvQ$* KBIpӹ,{eH 5Hx{ a$uHd !a$<ʇmyw$r2#17OeLbXΤ$6͂ĦK،4@b̓N$v^kx$EyH\+ #II!}Nwr#q$>.7ZiӞ"_ N[H| O,&lwa_Ƹ]H|%"H|_{4Ft ^xw$~P$DIB8I`(& c$'$d;U?a)pCOIb%I\OߓSO^S8z4nA{ިu>A݋L܆=7F3/f& I}=-i"K9Q4ܧs]ә'?%^$#G2IFZd葌Lu$=dtL2t I&уdjHf&,B2H&&"%$Dn$d*}d_&7lGΞՓ$?Nr_I.@W #|$ÔRרUQԏ7j'C 夐vH!))dn'ˤZr&Z]RH 맒f"-<vN'RL {rHa&RG p^ ..>0 )rJ2"CIc_RBub(Mb3HQb,)r'E(mC晤fO8Yamx[_,)ga N=R\7em|s`9)&ţnxՀ$xC#Xy_b:R5"ŗ[IfR|TY2)s_}*LnRgGﶕOO.4AA?-9ɷ[=M+R; }GcW'MJ*%% 9RCJbHIs()iIbG Rv$eǯ<k< ) ˤ-Ds1_ R;8ýX(2"ʈq5I C*+IEl0?!%SMMEʈT&~~8T? .Rp!HE[팟9?3n޳~ove ;݀Lf6B?T&Wԥ20̘H*>ڞGJ>Vj+R M$lR zN*+XOJqTIUlJ>!Ҥ*T U_?rjMC7ԑY:JT-߲ڇa/:#UG؟T''Uo]K>WHu&%qR pTCz0|!KjjK(R3xKjN KjZىԼwOt!t e'6/ڢ8ԖTZJN"VZRBjXa9ԊI1;R;Ԏl"bMR>nZ8}&/%phV LiY4`xnƟӢ.}hE4m! HBi@80K@UЀ#4"idYc_>~LH s!nҤ~ǩK"u.mM2SIC-+w$uu! >P5sH][o7Crz'ԓ&-by}kѲi8JH&iאV}s7 t>G#ޓHGƞtt>OΈcf@:2c)PC:Vɿ{Ƌ38^jM0 /IlXN:s|]JHc ] #]Ťt'7NO3BHwf1Mt^tW UHwMw]+IHwMw',|)˸ptkkI)b{t?W`cJ9kh0t}\zG_{~Jդi;4` ,6gim 6m:n:`L.0^IgnE4x^<ς pk|bWmۺshppC-|?5a(^kj5Wϥ^7iU <ߪE~|?ҌoCzJHOy+S)p琞 x'=cM =GzIo [Lz[Io%R=[Az˥{~Sފ1ɴ,8J;P^n'aFz5꾐P>>ҏ΢! hȢ4l% y󘆼O!VАR˴jg" +K3>{*I_=9CNfF I} .??.!h3wK!W ܏z_4S"I*F:D; HJ/#/I~hv3I(CuHoş흌#S}5( ;_VLwY?;\{w[=D/-2Jq.k207~Gm O" d7pɠa&KG8x㸛s' 28vK9eI2RHW3ZN&]N?7wnT?NC44Mi=jHCMh.- GC _w!2$CA+2Aud( $NB2MR Ȱ12^K}PV[adO PqЋO#ɯ[ gn%Cd跊 ]0#,'PvNX&>&| 0 60 <%medChA%%2P")dX{i_P%KɈ߄2ıZPȨW72 #t2 #2RJF &#-o2P%qd6&Dg-"9d3绑}42O "dDY|7UfoI yd݈wpN- 2;q0|h;̏gD'ld_2?Bgl읜$XΥd~iK=w@A>KcS1Fb Y#c"dy,f El'XNdә,N'S9dqzY$sdQ}z,nEY)Y<3$dQم,&^M5,nj7J]^9 #K S4'aK"Y.0#˴d,7'[rGY\$crX,r&˃dye&ˣFdy\,O(7vXs6?;c|,&˗}=YӨ*4J礓fBw} ?@UȾd_&RWLw:PIx֑3cfܪ^kSd=swUlmٿx|J3~I~{Y{7?sҗ9=[2Cɍ1]CИhL!zLc1Ҙ4=Jc?]_vqǑ_C9ȧHArD9R=9rhu>Oȱt\lDNi29 JN&=iArHNS)`9-&HGW BeC39W;7jZq<4"} 1ܧqZ&J3N ^L Th.4;\1#Ĵ ȥ>CtD.2r9;KPru\,h%FK'\20\K_r9\ rC\n1r+g!vG]Uur6#WrIڳ' !W)r]N5ݖ\s'k n\O"u-[[׶_&םoujrݓO{ɵP9x6@GOHr=B뙹zv_J%;hz r\Kh9+ܲmlrvٓ[+M"ӄ34#M(asUM6 N҄7Z9^#=#$#~4<"'eE6HDzܒZ@^kxJ a>2~{gFٙ~gsK3gy$ uty] kfgzԏSyG%|֟hZ?r$!Q$ܟ&IIoh,b#/\/LҤu4i:m5MQ)hFMHS-[K Kރ{:j{cxЁpwiC{+HsߐwdhCC[,[ m]KJޫNwm^]@ޛ]Z[f>2Ol!}>ˤ!yDoD>%gE>\%|ުT.ASw]4Rzف^W3j;|U4ՔZ>h3kڙ4MyE3}fD Y-昡f(2O}{=mzfuwӌsht#jL3.4fyt7y&HGV&i!?=/$v}' Uf; wO(`~ 8TBR@1??՜ߝBNK-|UߊPAI: 8*G )\a8ܔMr)؇&_GG2lx۞\(( Jg(Hz9| 9p AoRP;[ݲ.ݹA)UQJ RMAj/)H )ZlPи}侅(ȏRPH&R4 @A,/XGAFIA(hmfzL :`Ni(8c ߙMe(n W6J)E!\M7[gZDwj#/?j]{mC!|)9LK!{($4$=?ZSab 9nJ!'l) 9;*9=N XM!(s_ 7)TZS/zBW4r GQ*3 0kؑPYF/QaOABU,13)t zo_7{;=}:WBpw9w)t~ ]Bs{K)tnԢB)|. ש])\ߌ (|'{ KcR>})ܟ9`iN)|ֽ?.Qx _ZD˟SxjxIqxF5gS ϝAy{(| PGY}~"GREϩ6~m `'E$EMd^XRA)3c\_.M(b!EϤQ8"1=IGE\OWVPU33 x"VSD9[)Lz7wqo,E/)IYG)kڪɿ"RHE pЋ4/)-"չ:})R7" S5EHN9#ӔZJPItH)JyŌ"oQyo8E>CQB 2do7(JE)Ji>E)0oj#)jJQ5FSXׂwvr΋(iҜAj-9f4ǖ'Q4Qt)E <~(ZEGJV:Qs6͹=㿿;~i i6a9Ec#)ڃeyyR. uAsh]wi:߱_Cs-hͽnBsB*BvooU}dZvV|g1kD<å4ؘNZмwiއ9 4~/8ܢa,tԣ|A1]PLj) i7#@1"#I1)FHWQOcH1:l_>+Q#ߡ <N1s)%8b.{R̅zbJ'R [9bnˠ3)ayzbSLC\C1rżYN1u1۽7P Ŋu؞6k"JJ1`\dsNe%N"9{|KkUˠ؁k(VuakbMOQ숭kƞc0n':bަǞrEc8iRl㔢8w' Aq۸>[Lq)?ӔRsS4S@'AqZ(Ϊ9_8Ls )n-y8]IBqKS(nM : 4vQܾ{WpLP܉w5]5k" z(/}(OzR4_`GhD͗,Ri~4_~,+{;}?yz7 ً\JN9x͏9ۏPs77hs4;Nv]'i~><4{AI4->lڋri^-}%hQZ03NChͥ:2@ϖ0-[{hanR|ol{5Dz\M[PB/)-?߽CRScWYQ @ki6iuZ(\J mh UZx-|m?v\A N-3 Epa CM }J._+(qx)%QY%tD bQAhIQxS >')J,_I})z/%<%"Zd5v di{8i>-Nܧk&%qt$Ώ&sV496t.OI)iUJZ}ޤ͔!6^g(iJ,d4JG2/)gJ̋N-k*zl9'Q %PreJLɡrMcOPK9%AJNFɋ$)y,%t3C(`J>wJRN~uq )JCW0j>_ˢ{|}%m{U{):k\(i(7{7QD}(-؇u%В_Zra-oOK}m]zɧ?пi}o[ߝ,EKfJnY>ϏۅY2[N]h]`PTrR ޔb$R)e%nR )̧baO)VbUB)zdS4JJ):2 8TPʇPJE4۔-SB&eGiٽYA/ZMWEny~bZ>{i\Z/\EshAW7j 7WX4͜~(-_3q9wX=* DG)uT$Z}T끔ZPLizl$'zJ=;R>JVtͤ %[Za g7@iwyPڽEvߓ^VgDi*)#QڧI9ҾcXG+;Ukw g4W HJRZ)ѕVJ1/l:ۚJzZr҇tҝ(}fgPz(} guJĸ- o@J~Pk>*^V|U%h XBʵҡ (ƙrm;1l\;8:;_S?{ֱN,g@1?/(7l e<{rPn͚ ΠNSn2:R^CDyS)OzΧ<٣'Ǽ}QMowί|?;:7?CiT}~Z2xɼAI6 rhĕ}0mҦ ie6q4D +kZ pupepy:pS|AuZ uM)n] sv  ڀR4|y'\8C8xOCc;8Oc>8xK=pxكm+891v8<6[B#A}#1AS=pOs"825%83ijxTpN>N/?pzsAp I* ΐfipn΍ \p ALd[?? YY Ӊkgٽߺ8)Wmpi]RpS.\G`46y[x~7_KyB+eo>1ˋTWW+ B+7m=Om}6õ "<:t Ezj<_Ezd6'?{dްťѱytRG' St;N"$NۧuW F'ewtN]GpkU{UpO\ vk.Bpۭ_{lj[칟N33sй}t@g<|yM;Q:'Cl7j.:~tz'/Gg fǬF/}oQGf7Af:_م.ć.\Er$.RZ"z]_/u@׊L]ANy]?B׏u0Z/瀇éMҖ5L*gϱa <>q,vn 4Gs!tv ݍoG=i;֢G$zl-A-}#P=ᚇ.c\zXGQac_gxǠk ^J.kJoOW8xTg ^mEjWc7xg/ի9Yo0jx;[F;w%ۍg=3{j29V3(A}w@p :2}vC{5,$v;ۙ A^.asJlC} Z~t `<@ﱜSic FAЖ_"/B=?Bo%Db| 2{%Dr 6"@:"Uy; $D%AT7D= }1CTn+DenCTz$D{tQ Z QCTy^P-Dn4zUZǣգ۽~՚Y?=j -{~kr~hc[s`g{A` DwI.XRILc)XQ~UiK e!b!b;!?b6eh&x]gB\G+ }VC\{o(4 a4)ޭ v+!v8ĎufH%A C@"l $  1K,  =$*} \D$>K7h5jYigJ5%ٹSm);onDoUyzvX g0z1G]?͑M^]ЫKO ЫA^!zG/m)Wb?^okq-z>^ס׹=AraHKBjHiAjP6CAO;% >tOHKM'/!=݂!szf\4CB],˴iֿeOY?E X  =1F^߿Y">'9|2'3mdmUY9GB|X ׃ ;"d=b .A=x ' >i!7u3 9mWː[rwC8UC~$=iW;ػB~BAk ,x%w2~'F_+oB~o]!s.mES]}9jvnûﰋ kz}g~F_:=}l.2@AwfW3<~ڬw~ǣ{G~g_y~W!(>N(]{Zӛ-r Cq_ʹvZꞋ~>Aa;AI J$1J4tNAI)P}-c@6 J4J>PJu4)J^ɼ.iQkٳJ C)YPxJB) Jo:Ci(.jݳ—$e_+-xwY[}T._@InNRE_U ]u+^PZe;sPesHP~!EP *S @G*Bų*C2mJZp Tn0J _o8Tf1mir*Tn*BT*@*s*W2ʫPy9*o7TCTB. c.Cu2T͍Bu5?TWuRI.oԯŅSc5dSP[ـP :: uԶAGu:YuyPuPw%PO EPχzi9/6kwq?wB}(oӂKPP/gܣ4hpgBCK=t]c| ҾАƀhނޢ1r4Lya9g|a ۅ5np] \h}>8OלF.h蘏ַ0P4 Q7r4`(4gKk~2hz9C4=ު_< 94B`h>T-|hpVwMhu^hIl/D9% -В -i\o>MOX-В -в̃ֈh&A)Ze ZEgZAf iКZ?q9oOhC;SMmOhvmC=Zڣ^@+Gyh뎄@h+B{mn;_7Wgk/hywܑvrw~;C\h?t_h {Ym~W{yڵЮЮ~^zh?{V4_E+tBt传#q_ڜ;:awӱ vttff]:_}> k:9Ք{]Asq.<5!卂1Е]M | ]1 z@#;VYЍ ݰ̅nk#}!sr;-΀n#tC:?G˞qksnVBsoԕwk%SPvzkg1zf7zЛzz1D3KЫ1{Bohe=lꩌs qhlI ,~Zs>5| ih :yr/9NП w/3[ }]5_@V5U C:wCp?Sw>/s{20\!0 W03g}g~0> ^` ѡ*@9@ a0X)K`# _~'0x: r01AC=1&bLVNc uP| MQ,f?*`QzH큑ZTs`4F:FU0z+J0]`a,U2v:52Lm020VSe PVs(a<:xP; xB/^Q0|%& aT )_`ˮ89x+a3~w㪭կZaY=᳖cxT X1:bx <'SCu^r?DtL1otV ~ }D&0D#&j` &3d1Lܖ%&~0Sz$L;$loEn^01]ؠ< 09 S<0c0٫(I#~RɫJԊ:f aja|a* 3`* b/a*XSU0gg~i܆vM;5tNk;H=?;];";?3H)0]b{{yM/={tGZ Aq| Fˆ01#M 00S/05i0ɃY2,9fKag0̮4 fW`v)faVR3k77ݒj]#ц f,'0{i?xZ)9qF9Iw`׼쇑i°2bdy] KyT Ke.XE%X xpy7u,GsmǻLtoێц?;`i Ƒ Eٲ gKQX K[!X娚w2?,SF2Yy`vVcy;mѰz8r[`TnFe(gGyFm1j+Fmg֯u@ƨ}C*Ĩ͵o u>je~Vae,a2*QXOc $ۿ=_Rq>F轼{Lo>lk]'Xks.},a=9a=Ns"X ڗqSoz2guT8#~h+a]p;F0܆ OwXO)~$7¦vyl:̿{^l5rMRu`/΄GhfB˜ nԦ{F[ 6ea36SqvU͌0|eEm[&O|?mMaļMNlV [ت̂r"lak [7`c:~*le`klUx r>Qc gYNkؖu.^+O`{g-`{"W`G̓Ѱ-L5ݜۍ]39 =` ~] aK=^Lܼ߽O o=Su.Samض&;AUة]0)܇]_YɫN?z_FOkLrqYRYRv#GnV  [;#k;3ӃݨNmZ^]`,g[ `7m2 M .mgϾa68!V.}7VnE .y<.n5.1v ,c);21M5j]W,3]?g\,=cO'1xXlH[ ,6D]o}q猇Ww}a˱^Fl{Qo+J^~cwra {9 {g9͹I Np^'_.XY [_;a#a 7=-ؗþkn %1F>I{X1#=c0*`10FSc`̵acQa<eQ R#;ñ8=7pxY p CuΈBfig.|[Gv޿Z.-ۛR~mFp˒ǔp\R շᘕnjQpܱ[ḅq:gp94{)fS8EH)t'f>S8-S=$|?w;©3υYm8^tp:N/B Nwt[ N|VN]r>M}ǰ{-pq\}'_:7㜅Jgnj:w>0 hggpv|gpuD8Gٯ+y='yZ&OVSup>Ι[Xp^αL9g绮Cp]2ap אpMk@(\<:SSO7F wrxO/ʅ"/,c1wwaZ,+K0^y`x9U`1Lކ ÞbBk p;n;Om5&vD Wb ;o ?ac88scĊcA றUp׏Mp]p߻1<4cCxh|$<bWxȽj]ygcFxLI[ᵓ?<<}j ;=a},4G H_ ;xu`.чNxJߠ? 5[5>08Ke5^zl\N˹^5k-^̀׬LbPWuMy)O+-oxs0.;2!.z  [ %}ޅ}JG$υi6|Ɩ0|wgYxgf(|W0gN4|f]OBa\/$nSx >k'G>#|])Z܁57>7o_u*qLZ醞"1b41=SM56ckcQ,03/c:;p|L]1A>G90}UL_΅0}gL_a'*6Kkcz"L? OaM7?2SLK04ӯaF箘aASϏ:sϞ_UUmSO`,7 7}6ig}vi+#`i3ݮ703w`!l,|\;Шbfm*|e;·OWh^,|U|׵nw *s;Zo! B,6o)Fnyo~gO~4.|8wn*|oH^ ߋp/<{'מ_~~kO;E/~A?~s7b/χ_ %-//A~ 9e]_JʧK mm| C5v-ߎ@mgn; F+Z> >>) vKh|[ok~L|@d;lG=e28l3w#c_|s~3οʠiIh}Ll5ck\!-DpH%#@R = 1bu@6#xSo[> `揀!N3 F\S_B?<n?#cg1p"^vef/gwo2 ͝iyX<9%UwvnXסQko);66;B~sxɋ] u\5+>#0u7"pSF#pnX{sOc Z=AoX8>FM*xaKxq[Atq*#Y =X5# !cܵ ṷ`c>b G#-~{w l `*kG؇`Valq_w<i_yڛo=eVT?G"ۄ"8q!x~9"xss& /"G?tF(o7 =qM@b8 GBƞBHv8BEIIBH$B"P!q{ !1~!sW d6/Bf"$7B"2>!a v޿ݎwz/B6מ5t\!B tu"X)gȻشql]Y^Uи}%r7>гa Q`@;aV4a{}s5 TŽz^Ba&#^ 6>i!O2@ػu@89SqDWIw_n+γA ]] !8rA2q""h|*D!F&"F}qgqt[6.@D}oDr@LV"4DvDADuCDz GCD=Ex{DoG4ǖQk~5 J9lgV"W"CdgD&@dmDҭ|{_/"LFd9: 8. Jd&}Ew=& jF>ZQs 5[ QQ\X{ ATBz2eD/DF:>0klr2,{m̲S0kx4f ,}mz2~eCfՙcVy%fݫƬui]ܺ6kM' ~5_c3 h`r>Ɯ#ssνfœ=1d0?<Ĝ{1t\+œ\+1+漳B4uG y ѪVVF'=4'47Etl5D Bqx%}v:Wܫ0\9.<̳?y՘g<5|̋:yal?C慘c^Ll11ݭmb,&"V <#Sq1v2к b"V_ fJD UیXUSNkϴ+bk)"6xPS#vn.ه-],!-b/^b {Nqqb'qB]gDs,?#b(97bVÂSX aUٌx,O tGY1u=}yir%L?A&'b!R,Zg5X' wO{,A?dkOzn*.#uHk{Hއ W$E*$` H0 nH k +ՌG2-+@’/HH| ,q$aŦmMB^$[cuFam$\Cs ґp #U$ܬA"BB4*"qd=G!TFH4܆ġH4DH\D-1= qHF:RK-zmRCjeVa^< +bPK0}^ii]aŭز+ Ƿ·7@D#Mf]fiӐfxifHs0FX{B@M )HsB"߅H[i mumGÑi iv'Ҟ*"z ҞJ"TJ9y+% iqHUH--W-i2)VfaeV\ikrCL!\]ݶuN|hbhJMZ/'G|8#O6Vjʯt\eH/J*=XIYKW!6W@}UW*7V^ǪSJ%`U?wMzCOdBRdh f#x2(#&2gD#xȸȸqe2.EFI2^d\fEf`2{"s-d.Ff:?2Affdא;2@p9}Z峂#WY3#k*7&/E-[!0Y'@YgȚ0Y[U*d#d*~jl1dwNE㑭6V2AvȖ>^׺.w ^RdgCvFd/FN+FqX3;j 2V 9aYs%Nd˼N)V`uiX-u%ncY˼1VX=:9!' 93(rfD39FrQߍ1yѲ>b@뺓isϿiv-qΚ.Xk||Dk!x,X5I'fatƚX> kV$cͺXEk6ui7{OcMS1I7)!Ty%'< y<)țy9 ؀<`Mёxdf2לFjKd@>^dJCL7AfddRcgYSwFj?֌k,fg3_,df!Id^̛y#t=°}L*vGOӛe``a8p۳+}G>Kb؞ 7vL'簃7vxaw vpcvۿc{JlUi(f;>*BcZͿ1;3pb xr+_5z N#kƲ:f\*5 Yg5v3fE֬PdMIYSc r b郬rd3!k i#k V?C֊ Z"ح0;[bw8{e =gXzcV1;?e܍Ǟel<9=/ް~7|dw5

>AĥD+#0vNfϐ3}W!rDZ~Zލث惽W.{al^W\g 앏ػ{w'[:`f?k.>C1P5[[~ޏ[L/R/ž9㑣r9mCh9"G3 95ș9șu93W#gL*BDgL8q|BN+,]%Yx9 2в~>r^g"e_<@5\ȹ 9Esa "޳#oc֣ؿSDZ2s#8xqX/8;BV@H`W[惁Sppڍ37too_`f\/vG8dp0 {P/eC:Cp(i4ph2Z׷6bvuf]+'Pq^wġ8b==lC8T~3'E{0/}Ms2qX*wKQ7HpKö]q^i8; 5ͳ7+܎Q~>1 WZ\uN䪾Cd*"yz!W#kӰZBnMC5]eȝalYȽk-B.pr߯FnZB}*ܻ{gro!8ҡG$LF^oT;F3<3A^aZ$% o&f"oI.}F@WF9G FȻlAy#T;'p(Q>u`ΊiptJ4N8s 6±H ]_:G x?﯇cX]ı8R49U8'd{x_"|'6 뼒+ךO*$N lj%81f)Nh韚,k dg[OD 31F8y'd惓7. qrMcփL˗Uh^м6f#j@yC9]|[ -LG~ {>1'"U !Ӗ!S7NAzyܓ?\}/򳅑_sT8շA {q SqʆU3N .AU .850)4r)'*N]Sq\:58UjSw'vuzyiUp|f- QNU(EA>wn5 B;A(p"8 @v DayS#7m6FdG .(x0 PP%Qv *,Pf> ^mi8-3"_pFx%`o8`3|83\+deܱ;gƜJq}!Dz8cD*Yl=c'lv.ή釳+pnG7 ù;87;g܌u87e{t݈s18 ƹCMqZGsGM='>]Es޻'q=ùqW݇Spw%OzSrp>-C4/pa.8\ qd>.A .t\*R).~K/G\eL|\^M^j #(tj4a]>Ⲫ.drkqyi\qyl\eϸ~?]Ge[VP\Z˽f*OZp4/ SPo" jB(ds ?@<ևDa2d0" ס0: gGpZwD粤PyiWNWucXC(|ͲlQ{Ca ?mV0OM_VY |GZ`a) gHh3Eo1oy4\?9׏z4lp`rq\?+TpBP}Ӹ4k׊pcyp #ᜎNB1I7&fxo+Í Opc~kE| nōkpm箋㦺:nv鈛*pSy7n*pf'cܔiUC:K7tꂛK9nzmMI܌p^v7qn%J澮o-67ײLQLtV ]``w8߲Qop͗p+5܊_ [q*+[ոU[ m[ qkn­ķ =gخR{ϯeQ_íL;[qܺ[%pkn}z[pn+ʧЦy-p`nމ=p[o1n-¸ܴ7L!sq=/>;d9n_ݘ3Zܓ=ɮ'xxN=WܛӚԎ g^h[9W2gpq^}{^ދ%(`w(`e ۅPbU zGE_P2,JSQ?%PmJEP*D(R) ]Bɢ@.TJ5vT} Jm$F^E(]ҨX.2@mF2oJC4d4Jt9J:tJ%tJ}]nJUP+7t&tyo.DlƇPV|m}{;jnx?l`PeoA^ YA<(X% PBP}j˖F_Gax >-Êъxt,(+mG[/zC<)[ xG5S=L<]Qx.-\;nx3/S([M݃b^ =cP> |9ʷFy:PuQ~ʏ5]xӼvY DyU7مOQq?@( (uOQx^q>y=9x%W"^īx%+W}g/Ixe<1g4,]ZzV*Mx1THXHgހ7w7ӣCo6nµ.QaasQ1Pa6iKD~VӺơbUT,JE¥XP1-*͓4?]ReQ* Q?'Pq2*>@4Q*و@%sTꄣ[/5.*{D`CTeUguYQ9*6.6ƨJXTzɢr,\ye*c2iP9q*gsgKUf]1u~=cGm_fǟs/z>+۲ }o8Lۊ}nK믍w {TsdJAx8}wx6S7}J?Cz$>)'E>|>OO4)>M}ՠ_4>o9e4>'*|y:ôug0Gg{ |ϖ;پ-kϮ||)Č=m}v<{yWTJ QiAݬؐBUWr:?GU_CT kMz[Pujr*+ UcZ{Zҟ]h}G[,cquZuWVjQT}Euǥ@ ӤQջes ծjT;բ-DT;Hz$G~Clxv&P=^132AmTZQؘ+b/%a|7 ߺVjGT'7/-k[Z|]w<ݙo o|+ًEtj:Fx jĀ~; xXpd j\BM*Լ5/tP|'jAMY*jG ߅ҕ)D͝b>CjDMej֠ j9OPmcԊ8VCo ZV= VZR[Qk/ڈΛc @\&8Ԯ~ Ux2<:ُ]_Q)ڌ٨MOB ԦA推ڍnpk]}GO>C}Z|w5OL&O׫MDD2DiD.DnDc9 r$r"#$rhH"sy"DFND}bP!%LSH5Qww;G=T"5bAH7 MiDSd`-Hхhۿֳ:/ "D6Dg׍8oqtIRGC8w@w!I8x*80"Q_8҈Ý8#.qd1~7qF)#c5q4#!ık%߃8rt WԞG6s;NiIsPOh^@\ۉK\ԈKq%mraI\U l;=zۍ^ Wyse'N:3G)qKj7q} _҈*~Eܷ޹R{ L N m{kqYnA/:W,"N)Tk >_>2_2É?n+G&it n/c,h_F'c$0 " g0q X4_4yH&i$_A$1%k$PGI]xَHp$dH, VEJ_I ~S$!^$ABP -YAB@Bq=I(&KH(0 -8 FB\$g5$҉kIh mJ!o$S^X+ J/OBuH, $:y{б)$t K3\Mgڐ2 )$׋ HZßI|1Yx V ՓIxU" 7'uI8 D‡FplEŸO$̾5}A"(a`}m>H%QIKlILDL2E"JI2D,ΐ:Yd&!sIl' 1M~$LbHl].Ibv$fkAb$6 ,ؤ+$6yXc GbIlN'BbjlOjO$nӛijjH^`AR$ $u;I],%|n:NoIk!A֞:Hݡԡ%u0ԦK0ICC|%uHXAޤÊ!eCV5uxEH:T iC$-j@֓.Ii[AHzIO*%ibB>$=ے,$HqD!Il>!2%DF2.1t$$C2=H&(di4ˊ&Y0dsL;F2sIVZd%7 B.\_8deQ2vF$| $8dGڑpY͠LQ$ݼ6!HcFm "٘}$ ɖqÁ$)ɾ@ߐ3vgI,}A]WSG1:.iqDu>:ZgЧVNqIW:y@3y'Rs|qc./cIrQFܼ$:nUGrپ$ۓm$H&SI.ɝxNrn3t$$wq}!C$v8U$d*=&$WLr%Hچ޶ZyW]^y; $/dO$ϗ@ܶ$O^$/jO~M!3HVFdH?z1RwBNI1G?!y$?. D:e.H~o{G]H>EI`_?ڝsb}[7$zɟ!$_W4Ն:=N]ӷp`)#EͮJ"HQ8'KD 3IbBR46o)5&EH?%.X}ua}=J*ݺ6ʀJ*=kQIT6I[F*Iexgo;#I%}p>9u[F_T|KkRyI*RrT%+2RI*֐3rn=M*g{NB j_F#J=bMq*TţHUiMOTj:iꨋ:.P!U#걇T݌IŅT;6c&aR۲vZC؊g7gϓTjpRvTj{m{娋uC] WzC-J*.5E]vu.YKX/ YCjoHM$,Ru#5jR '5Os*zMgzc8uH]RK빕\Z06áAOz߈Sr} u-O]PǙ!u}+B]+t-dHZOIKeoܻ:0i4sHk%Қ&O"Y&HH*6,"vi'{x.i#mhCώ$=~+I{;in']ЁM%M+6q&uI~nם;vn7R(@݇SwԽWuBQwۛ iq˞w }m񴴫=o>)uISknuÎzRa_1v"H= N󨇷lcnVӅzںl,ꑰz,M=M9;TgZW- t I7p2R'{ݓt  N[ j @on ҭ`5[Oϟ2(at)>j{6{`G;_o}'Sȷ5dy=ӤGIzq-ɖUғEzHo!߱zcқ#Fzդ緗fU1L$Ioқ&'I7Q&0g=Hzwރw?JH/l!~'G7ПiEֲ>MjI_ ]z2QO7m鸍z:[RsvL=^SYsU9u|z.Sωè=z;Бzz\AarGc|~X?B=+Q7e koʗz^HÜzsP #SkR̗z|`^Qsyu^WRԫz]^k~L+>eԫy^>w"}ɇ }I_b2w:OU\BJ2؏{&}jч. #}y߇64~ݛ]r?"ҟcAys_ݩ$Ƴo~Jϵ'lUEۭH6 <֐32cC60 {Ud`ܴ"5dz\^KAWa2$Cdp 4G}>7>ܳψ 9qo_} 3^yF}&]'Cd ;#Ndo!^d8}(N}J搡O_2 Cd8| CJ>d8̜ ~$Cod8Od85ZڑAr=9;al2LV#\mAt*OQE~ө%HRoQSLv]o؟;@Rc`AMsټa+gXWNFk(5QO=6Qf2ڻN18jQawynt!|dtu4'Z[2JƜqdT3G2FFqWՖud<*y26#cBƿn_K!8. %d7C 2>+J/Ș}3~֙x2ջy:i?&.d.N&C8dp2`C&db~L̪Ȥ"-L,%<2C&6KdbL{ a}-y樓D2uLf>f`J&GIѭ{|Ie2YĠA&dэL֮#fdr$"v|2L. d-<'Gd:ݗLl2AL Id]Ft,y$S}dvL 2 u'` zDdSd MF.dňL4zF%p:.AL'}t/\d_!{2;Mf';Nfz'3w2s"7dVٽl2} b2t.~&}\Ćwdn=ɼV2_B=QGyx&ŜdEQ7)U2?QBjdɼ YN'  02 ~ daF{ŀAda,.s=L6gݏ,Sb`,FxbGo,~7$y!dC" YD&+dY,JJ;),3}Y}FFd,=&-dց,6EYV",#,~oU;\0,4 X]FWȢX,ɢЉ,.#=KGw-vd)HhN4m "k*di<,LȲOYl#_ɲ}T KIuk2]}޶ڳhRTa&,&[4o "@@M(ް7EhhqyT N4v& IѠ4(! :[` #hPsT4]@.4ԯwA׶ѠhЕ4v0 r~D& 42-hhUezVv-{D`i|*知y-jCMhHg "?~5i QS!hH4D!4`lWUW-@CLӐ48!smN!GҐW4$#V!KҐœhBkk%!JVŒFTζ{۳wo)OVf}Ȫ=Y nAde Y,글[h6wkMV.deڶ/wrj_O%UR!Y#u]di'Y~@Vb2Y"9duY.''{&7]i4+:S94Uz܍#kidEUZ1'wi.UW_aBWbznDO׆0y4LՒ$<~\E֏Ⱥ}a_6MdceL6vjdtl_$ ][E6W͕dSA6s|O>1/l|&Gdɦ1<ϫɦBl^a//|"BQv^َU"Ѻd;\l#[ӹdkrlmyomNd܇&OƓ]9U\c$ :udm|{R+W5sݫ4=\kAÿTI#uhF.ԡD]hdF5iԈ85|_ErhPA5DF Q(/4gJۼUm˼C>9Dw'ea4 q+9v"G1cQUn&#ǔQX ֒x9e<r<<SЕwʑ!Iߍ"I,ɉWd7r~j!s' \=\]`%mr)!Br!oɹe:r~6b{`yu0"~2bwM.v2L\8OrR%qra\ oa[yW_r N.S6ˤ=C/rNry3I5\CߑQ\&׸;IkOC.Z\"r#ל9uV_$דWhL h ӡH0svcN3Q>Mc3.46q\Gc|/n?Y"McјLΘƤј->4fٝKcvD+fEn}r` On#ɭ{uC8KYrލߦ; &!4M75qّjJnIɍ}w[6\i8t' /r+|Hnvb6#G=Lnɭdl$*]r<>-$n w$wxrܵg'w r7q$91~$3a<Vyh*WPD|ȃw+yp5WȽ -`w*^ޏ<wHNKg'ǛqG_WO׻[#|6; D^cnJ^M^Cj y$/ñ yi;yhǜC^nqab{/AY?ѸOi܇eNޅ}ʋ&Cn>y=EW{^}w,%{롖{}3o5af3w O~y%lW%yKi|)4^O>=Vwיz[8wöh7?/֦Si|<Ng3Wij;/K㋘vU4{?H4!nQq|Gut~H>kݚוtZdS1=|zט͠H>#W4F/nE>Ygg 9O>G)v ÆyYY|>%u/) 4A$& hfK|l+M.I\h4qI8)M!HmCib4}M&rj%MJIФU}iR`| %_kq|'@n9|g&UH19|f{|"ߜo3f#{3|o$kӯů#}z|_{f ~9Ih4MVirE4Y6MB._5܎'H;ӌVԼuy-f!R "e_z,mZN~IN8ؼE#g/\ef[gB~;"lϟz{wwV&jOPi俛l# /&{wNW?1N4e%vL ivZSHsҜ4҆'si+p-νO8Bs94j ֤9s x(P؞S  VHڡy5Q} T@).lR3Yм6c(p@ 4 [ 8TP{ \i~^ I- |Ʋ)$AIP > h6/B9hceС}bCA)h$eMP OsN#_hnn6=<4hnO`7(FP. 3({C\aW)*YHa)W$ 0Ki w|(l"7jO򋶏‚R؜L Has5sc])l-(,| v` k^Oa(,8%Υ-awwf4׺ls^I օoS33PxFoMi oLʚlз۳",^S)K(f>E G֙񔁛"(lI?"&Q̛1EL4uڭO= ExPENE3(LzI)_C0-xpӂhA-6n--C q|E j_3Ђ Z͐rndZQ Z3Nhl!-4ʴPw;-4 {uA*p䉺zȇ_<'ZxL]-"!oZ$JbiZĻuFf"g nHc!-RO|uݰ'-2^j7PЇլE߄hoK<'-zD=)JАk}0+})$E a+5ؕR}5oE:晬.HQ OQ{)*4:Eg;Rv(\ޮ qXC!CQSTEjmx4/,4/"4/ i~u_NC')nS-潙G7R4fpRtF/ &}Ͼf喵= EW>#8b)לb8fR+ka?g1R#فb$t)fUńHR=3-xRŸѷ)fi|<@1.QSљb>OlWڳS3bRLbL).ŪnXXUX%yկXNݷRl7#՞LZuZXS;J8@c)%b1HQC"ŎL;!y_1;ɄbSR(vG ԟbgS4nLvt{{osyŞ>gP-̡g^[^W{Aqf,}&dЀ5xnG\xRa/:)^ތ;jQ/y}4⻃vx|?Oi?XmZK"uuۺ> o ͻ)~+o0;Q:vfF6_-8 L&?3)s/J^R|~şLUſBOi- zX`-w&bʹX-;I iYZlL g4~b$ZllJaFG#hq67-޳z@ 1|9ޕ_K.whG-9CK2hɑlh0/DK-hsϿ__jNUҲylN-S_oѲE=iYkZ-[6]{KNܤe1Ҳ޴@$-ߕa2(!ݕ͡])(:R‘p PhJ8ߴ?C ֔oO ']NT1>,4(~J@ w)NJxJ /<(y%<[I O)Jxդ-F˅>&|1WLתK,-_IqNZ;-5)Q#(Q͘U)Q1 %*p6D}6Omez?ԝ[|-GKČ픸%ė“)PS7J, '3)SgJHS(JbO#(u%m_AIFv5.l z3n+{huZ7Vh4Z᷆VҚaiѴ*ZSrA\Lk-5gҚJN)կRg.bJ]NPj͔un}4w(5bo:B[DX~{?v{/GSYZ։R㭔`+Dky7Z֒ ~ԏןiA1=ڞim }Hmh+?=ևwh}mZᅵ֐HF܆Qa"y6xT҆1~՞6'M0yim<6MJ|hGi󄍡MiZ*m^ܘMT`mv{]ygGڼT(MYҖSb~JBiٗ)JqҮٔve9;QZ!]iux2PÙқv/l]|Џ^3^PZ#JD[i9"F[$'EtЋhk-u>mшlL -Cir2 m4?>mhմ%emYUM[wі%IDӖIeEڲ&mA[gпMsl޶mKaX>޴5Μ(ںЎNuTm5[Hc)}PJWmz=܏6ol,)ݗ78s[N߶t_Aui{uLú1GnL]N;Q?|-Yu?kgg5]n?޻[h ^~VN?ߵ=_ms68p Ժ:#eI~C"=xEւ[t@wk8Z f, } ZPJ ]{йafOr:gUθ.V9O2~ִ=woVϿA#c81Wc1U7Qۼm4w66\l6O,p  ~p\NSm]>uϨraps9`OnlB[w/4p_yܷ}g |_3kw̎?Ylڹr |_e>{֏ 6M Y̼_1CN+I?sLLg`|g([=?=xzYxYwU[8_~qSTD+o;g ~7Mߜ5?:w2_p|D6[5;qo?%Ղap/Ýh2͝'gwT ROֿO*,V7櫹 #ߞz ȕX4o[bX

@p,}Yr ~ nxdA05 ] ,* ] x B x>%!X8 W 7CA5C7 B!$Rdȅr0TW4}i!8=ao|Y;|DZ(:Y^ᥫ 9""Jk} 94߶N;4"ջRC ~ 'DcJ x&D73>mD3C4sA۽b{@pOG{} bս!Χq~.+כ > !W !ޟKonm˴.uvd7xqI-pO!>'1fx\Oe/Sx5ē b0WӾ܏̦h ܕ{U '8Abb8$&;@b(H m8H ļ}~z]Nz m~hz5s!{:A"@bý< mez;~oDB~$B |! 1pH0>HJ AR.{ e,$ u!i/Iu# Y.ĝn^=owyў3~ۏY;"017)غH6 5"߁saN}pop/P81WtuI_ux l6i~t&hGx\AuH z#ЗGGpt[ JgYOp{ni8c8vT*pTǗ=Zpb8Y 8 #q#8j{~V)tAqxNl.lk§z]N[QN !pr%8zӒxۼmWʷX6kpNΩN7mȍ2Ip溂Mp`vܾ[0ȁsc8W*?puW׮R. d. bVMk1QP\<\5'\~5s&hjg*Z\k0Lr24U- /M{~_77kv<7Z|Sh޳ʲW}kAӞ5-n{y&w$p>ܻ{>;Cgpoe;;m7_w|'pH{Dܣ9n_;GĞbG{߫wؿ11x5xG xwGj.xWG%xOg" m:/o >^ rks8xwMNرu? ^בu2Cn ޭ)M;9]kwU-xټ͋7x%wn/fnin~4xLSgQMi]~2?ߕc|' >]I~Ӣ:ae?'?߷Wn^+B VWx4nK*7@rhBl!yAfH@@3A{z.+W<|  1|@`y qBk|^m~Q@ B2k8W7~dp!4j FCn8A&BEI^#ލC-P6+ s% Q! n@x{dP0.y4yZHg#td.H> s!\0‡ޕO #GCx*oM޼ Cx\= " =nUφZv^vˏ^ y!2Dfai!Q)y"vYkm U/ ~0vD;T<țy! Gy()a{u } >H{lbqEw`q qmo5 @, ,!_  C ~`5ij ~K 'MH8@ Fʐ{o CY6!AK1(@b %$" 1&w]f@8!qW k'48xf 'uj@ f4 :>I|Kl .U >mf,gy|46&ޫuՇg߄>uZ´O?_h1cN&o c  ?sKڟ-aLg*c{ ٿُ (@6fu5cBmS!1^)w!s!c!v@Ph WnaG ħʐʠưBqk } ^B, B{Bhpmgzd}MϪuhGA(0X>D~7aU Ht E/|l PQh:gJzx[X/h".q>YWh nbL/몷4&@l69{N(> b˸ >n~rgQ 9oEB'VX>cCbhH1\FYuSuzmH[ xH<֯Z_URp$Br$ i;vމ $G@,C$x!4(H;W]=!u '$W]#Cr6$g?_u.HCrvH0eNmg}AJ5LBt@|C*t$_opTnH-; E̬_3; uv My]H4W"{RH_ԕwI Խ2HkqH̀T9:Ct#!2Zq⇌8d\u!3f5dr 㷒鵐o׼o7/GojZcK!e}ONm2]JZ|dV͂ Yp2S!sm2dC.̓>|c7԰PI ?, 1?G OpA$۝ gL!ύӺ"/|q?_LOm_i91W +Љw:MNqg::]DEtzN/Щ *7?}agO/ i~7IPt*sК;\b΢*,V ]u6':"t}tFu-;mY'ϣsn:M)$@A:tt` D`pS4;gӘsPp9ů0 ˍ Z R^ sTZ-mu;(CQ2Pӭ5%+sCQ1Y=ՠ 5ٞYohvFL2WC1eSCq}O(n

w%gQ(C=JQPQYPcBP ٴ]{VYAi\(OR^ ;'Ot:TmP~2 O?B oM~5Pсu_/jn&Tm #~j|PK;j;5 j;Am@m=BB)Ε'~v3jwRVbѰP|zuPﲹf@#cA}zobsz&C>6ԣo@= }A3[. =PthtQa(4UMz|Fa?wOm'~i"eOXԋV6֟%s[pBDgb>[<-ӸcL/h&i|Ƙ 1-4&A14fƜK!4zC#ۘ?}42W@c+4s̡q"4ؿg'qi4.gB.4qcOs @f4/&Ak4y )9ǡ) ͞{{?%IE7N衼=C#=i@SߡIowm1tپ̣MZhA+LZQ,[W+&CZsUugO#ο+-VA,-B{ah[om h]6;ObHlsw _Po#9zF̷m"z'#L<-Q'Eyϡ'z_g4zг=[mٽp#xQuYa?̓i]y.NӮ|]>'veۜݼo stWW/:}3- KOgY|f[BTWKЫ2꽧a^7ɩW\Z^)k͘:.1}|Ҽ&8[׀קsh@{!\uu{wWAV߳~I5N홌Ґ{/Nh +X0a'a`s/o[|Na 1C`0I+`>ބU ap n äN2}hz_ڠ[>?kk枯|}ԜGk 5a C0TuaWPcOCOkz[v43eOe}Yy}.l-|wjӒna- '`(fֲ` X }s`hq=`hu 0t k taI0pӴ`0\xq` G.OW3}\&q /vfâ^]uܯF"Ӑ ܏wFB@],>~ ME}ww]瀾[עA9= :; ݀~ y跤-G'oa~;߮^֌Po*eaq qwxsC0>\0>XKvoKa|s}-׹0ϟ2/_Ȼ.a57?fwG>%wRT-`e ~2g|,jTX +@X93@X9wa5kj.l3X[ Sɰz`TVkaU~ V `V˒^vx۰4j3y'}u4֜szyoc[ ͙yMp,leP ێ9g}gu*^mWCز_n`ۿlMBak[ [UڦnlG%֛36!Oah;/svW8E&* 2[zo͞cv=`7ȅ%ژy'M7ov9a`vi!۲v`w쎌axs`w N.?v'R7=VO_(د~ /`X]^?'`z}ìW6mfV.~Mf25._J]nawטSo[ܘe1 70i ?X_cr謈0bjH(ň#fc}Fu(un`5`}U)Q`{ zO?Z+FKcFKcTFwh-;߯k17덹1?=#F;`)= }aT1}=[`t ds`4?iAw70{=І>%+ 2]ŴeM2Л|+%pȈC62Cfp8ړip+Q!p#~/:Nrpyo=ᘨ}lO!, '%#8xI<[853vqpq8Ei+pZik; NK4N ٍp!)pp< g8EY, ,gX8ˏs%pz)pVL5¹A8kswc8ul05 la < '߁sj93Y ={J༟ 8s>Oe[D.-,Ks ,.rN$K3\V݆:.Һg]\d'A c7ՙþe}J=+Jz S\ #~u.o1papi zP}ZWf1<2": eHNJNMkm/NexWcl9ƾ /*.xY!^ॴ^Q19_&xmobTnxS$x_z+}uタ=:U{ZOhQ(wUxǝ?=ϞݸwR?=cX6b|&okzcA)?<>=1L,߆%|gp|g2zǮ>싕IMZo,dV?7qcXIx1~\!|'>.|OL[2|OxoY #߁O+|v^,|]߻ wyz:A;&R0q٦{yT9&8k=SٌvraBa:1LLbRLän`v?ְwp<60h&&'\ZR}[(1Eu,PL9S /bΒ։ &a SW`jL]SWbrܓӺ4Mg5C0q;S4TL(xvk8owô5}A>^0/L8L1}Y'}K1=e L_1C23d-aFF8&p3ƌk;0,C̸1*fOh<FoߴKuyn4 k5ߜO׾=~O o }bosc[>D?1 [ (?PYݐ%p.;-%Vb`sNl~,)?//0+gRĜ"9 sb&cNl!,R{bξpٿs||dO1+1@"x 3:G@L(MA| @Mxm>*t;诅SA4Es  m@@q,Yf}J8pH7g1G`3}hЬ|j3M,8V"R^A`b^wASg"h:!h./4_Aswi%4sdan-:9{ sY-ܻ0-ܧ#} B Bp:oމ.Y2?RA]9 D8!'ҁ,Bi4!ݶ=ߧ-|N4CkT5{|vz_mg^zR(#Dc Bz{ ;B "D{uùǾ8B3q! "$!)tĖ=9![m4y<a6q;aK|²!l~0C e#U6^3jxN9?}9{[׆s+=\q5 1CZAܯs@8{-÷LDxmg̭;!|wU}?ṗ~d >|/e9ᒦ_9NMyyts}fbQ4.|0$O|_A̟<ϯ4)(}aNu9Θ(G3Tb~92 O$k_Ň0?U-{&¾]qQ WqmE'""2":ucύo鈨EXDDQCqDCst{HKH/mDZqx~ٻt,<싅#-2E}±ȸY`]O,Q&ho܈P@4=D>F4qD Zh$ō-)h)WDwF|Dˮ=VX\Q{u0o3/ο/-{+{# :t',(DGӚk>3 s_{1o];A^15ὌL-F<Ĉ;!F+bd!F~b#a?=8MC\ĸFL4B̤)5Ed)eh̑gx@]Q l>7XY/m)d}&yf?;qW<@Lebj VwClHĚC` Cm*b;\Oݺ|雾a+nElbkN ,h⸗ A}9#g z)#nZ"f!.$qu`".:q1VtA SKi~=6!nw& BĕEsvɈx=!QܘU[TYįKB6~ħbX- fcB,VbYB,1˶#yX'=?e^"8A$tFB^CӅ?r%Xn}EܦGbX~W{{@*k$E:$Eƃ׾!|#)HIs-BRz2xԲUOKI$s!57VtކB+aEb譍}+gYX駀Z챲}-V~+m:/D2ǜ\2!$ E2$nv-S;@n$+Br>H֜װ."yg"yC$Cl$Fr5H^6}}H>TmMk$_tDaH~ɯV ƪ+8V ǪXYX-iܼژJaZGnj؏b-Տ"C }%RtbHw)Oϣ<<)FHqELDDC&#eJLFʌ{HH l﹦2mm{̃9Xk>OXS=eHCj"Zj}+ ^B^fG꽾H-{ڏ{02o 0눟a{þccuW_6c ^7s`U eu9~_1jc6gbC6ڕbc6ظ)6CdGl<폍`ذ6d+i+ 6b#56 c56:Mas6Ϯ &uͣi9}ٙؔs¦Itr86a͹t٪nBl>c\_a+l~ˉY4H7g(ET!Ҥ"M~/vyi" rV#: wlaJ-ױEbH`?Hc4lQ4U[ `Plq-ʱes4l=-gkw6Gmim} [{c]l_4~zc)e%Uضڮ_Smkm]ma[ZglbP~ղ}l+bJ4]ggmw^`ӞROlρmR-ym3l{v>]:һG-GOÄuH SS!}Zҧ@z /H_Wݻ>!}ggE^VDzΖ6s׳V6ep{# 2Bw }]l᝱w6TZRihH)j2W){-vVh(ZDٴ$Wrivs9x^3>.'Zz>;ٷ >\9|B٬T>|S q;|;M n7'4כ>/~V3 _ Ey_)#;3wVkv >711Es=)>4weW |u p4|{llX?gnHgj;w?tZ M SlW5[UWeuQoI\&p ]k..; qq.nZ[Jpqo4.HCpqOg}d=.;j-\b.y%K>~Kkg.¥ŸK TKETe;p*[q{ZP'TWEoq o'.Ȱ~bkk)6K6߃ u4_Ӱ_(xïK&A g~&}g1~:8 ~V7lF9 1lƄG?"- %l{v6 1 ~8 e?G [Ax=>)zFO S;f [xktF?>b#X0/Z=n7&:4Bgd#t!_]=au7~~B#ued\VZȐmqY:n.\݃+ lq5WVY㪏tմfj\V՚fF5\5צmõepe3Tw9zgXf46ou>5\va 3!La6a2~(N#` "$Bp nEƸ1 7G{FarpEߋ@ < ~}y=3~ksbO8m_߼WpFxZ+?;W܎!Q᳜u{oD("#"mCDg=DS60:^{a|g"f bNDEtD,؅ )XtfOvߘ1}.3Wwf|^"g9B_կTpۂ)nx,DᬷK0oO:fF|~6+Ҝ[]p/nV]Y_,>3qLĝ)pDZ?,/Ɲ5f<7N~w)iҿ'vj'{kT2GdODv4BdbD"r@"!r6"@jDICT2~e!(V걸>sK}np6fX%D#zDGT|oD%BT=,AԳJ2"**Qj 2Dtu;!z8C(Dc^>ї}eo :z?_I!.b#F1b#11rQ*FbEĸ!fg>bv CLe8b"˷_@1 Uݰ{#w3q7A-Vn7b+?6v C/bեk|;p3bMEP7;&bAl8[ꈽgg" 17#N!nFč88x]GԓVEW~7ĭfCFmqC܌ v;͐ q)qi$ qO/#{]W^9ڸfӘ{k6pOb']}>Oq:; {?}͸(Wq?%'0|2q% |@ [#,ď☛ߜxVGy!ޯ3C #o=[;^ի+wHhub$H!Ac.4 1H : j5$x!d WD=ƿѣk=͞/sag x_32X}}02v!dD##Fq>ۡi@\7ɧVUc8LcWdBmȴ"dGldn- 72y2D 2[!3ArMys 2oi#3*ȼ7`(2nEf5d>Gf2 F2 ӈ?}֗fI~5Y1k9%Lעy}>wg+,;2Y#{!(l eӑ5Y*ڇrVglW_N'Z6f=9*imItUEFN齥yr̚tɯB Fΐcȱ?BDLLvG"Lc3gDμiYe 7_lM{&7}T-qr"W7r$jQ rEk=Y=iC%r'2nÐ\zz.Gݱ#crO kx]>g&?L? x-*(POi =޷bZ o]PE A;>H8|б$|uL+Qz>N=+q _x%,ǜ4>~y5y<ȓߌȳ@HyǑ稆iț^nsrB,gcKE窉eC^#oܟ2䝳Fޅ*B^ /y KEaoV /]!yYa=9+`R3| D('J3|D~{|wW܉|0 W|u !ߢ"ۜC>E(ـS? dz}!ү] ]l8d!&GM@~4;C8I0FO}"/6O?WE8Ғ;~y+gm 34mסũ-ť7otf֜uAEA(DA'Oh^-Yt^t郂Q0 ꁂP04 `|ƞ|~bm=ӧ/q11o-DNݽ{tQ/ sK(xΕ1(xBA>cT" *ƣ|PJ&ۮ&ʢM{f_{`ozzfG3>{}{3.k}>gvBM[jAaW6 {BaO{( Fe4 l@(| CvfnvG()D-(wy(tD4+N7F =:MC(s'rPx\ TP"eMEJi(2DH3EZ!(R_,Ohp @ь3(EsYJ- p{sNc\sn3QvKNvBѩ LP5EKPt*.tA(^ `_|'kn|O#iD|ZOmO; ir|ڻ 3m<>OS#|JXO=)3>=4D7(>&q((NDS5??W|P|ϙi^(N>퇞Ee:8yP7 P\…rW,FqJD4%b[Q"))(iQ(](?%=tC^t~m֯ %;P#gQ2r6JdT5JtEXa+Cn,~D,J\ĭo}nEC}(Y;%njQ(<>(ͭO1-_Ў׼^:$[%9Q> s݅}Nl#J͵QjaP:`Jt#JG(RkqG?o~7fj =Q:y4! QT͘Y5QuJQzMBi]ƼCW(7 ILp EPz#DRlJ_3Yεk-䶶kxCOD:MCShZbմn愲A(2هl9ʢls͚7XPq*Ga TtF TY"A]Q郊 Hn\{XEptTB)HBe߻4dH)/VJ5tA)gtYmܨʭnJk%De=T^)BeTfBe:ڢmTCpT٦j P5UjUÞ[Oyߏ[61Ϟ~Q)&BC)6uAǨs1U6*˜U)Ph3AUZT=Dz˧ze7TZjwcTꣃP}60T0~}P}kcPWN@uj NCuNjꠦpHuGLOB&mƩUV5W25)DM3o7cmF]gdV" ބ,B@WYDDHI0\%FA<\ j*-J[p1q*1q%n3׉-Ĉ:G%g{YW nC;l8q0!E)q.$-k/n=Gx!ùsa7,&`% YAx?$o~J|<7u) '6|',K~#g z9{Zꏛ r7׽e|'xajZB}J-t>|߹)$Ն2@3BHFƵ؋$pO'IJ@+ T:@)%A:IwHgS޽{bӳ [DsEHpD\\G H0ɞ_%b,&($ʓ$.6E$t|$ ȑP$j(ўJmt4Mo-jӧ#մ} Hz`z W͉"js+6OǑf wFz$$=2|&$|l {W/؆I8ȗOp轆HVf^c$_c̺"Am 籞HQ$bYH"Id'G"%qv _H5D>kzSڔviK8Ƽ aiY3DƐz38D$H%W8^ݡTW7Y;UJ"gY_D">HğH|I%oI$MHbN2$6[!-"}Il?][ObƓbC$ėĜ-HEĖXĮ$k$vwX|"I,ʃĢ~j/4H\p xG"$kI9K $.ۅ|I* *pHZHYO]CH7&^3H|Zc_Sܪn$F+I|~_ߏė4]"q6$~ď=$~ʄĽxY3$U: mLWj*v`(GRۓjyqj[$$IB2$d&I `xAm߄5Oejg v݄ͩ$~1In$HrQ"$y9$_'ɰ+$L^9 _9?yҹ1W.(sސ-$ϖ䗏$Y|$Kd!) $5 I-&թ$η.wg_8$ER7yIU i$;ߦta?bD%$]͸/$a`կ+OtMIS{Cj4G6\|SKA_kIfPF2H{(%Y$+/Jkƒ|PCH&ML$2>ːo+;W`H'yu$/e; C y.$oj[o5M{ګ4?G\&q#BI~k/?:O1#{HqOA3H~fh3=&=3XߖL;jH~!H!{ 8^%I>b8ɧؑa Y$Ғ3ٽ#sH)p$R"VRP9J I ZmN$QHa^RsƩ\;4)_MҸśv<&IaO)=N XF I!t*)#X֓2YriIѶ )\%%0Rr#%kba(|.uXES6R"#HEYTT]H#C{kZˆTt{JäTi!~I$lB*;BI%RpTH%=>dr*ZRu&U~ʍ'U%k\ETo'HڃTg0\ANN:'T`>.׼-51BuyHjr6ajurXt7Nm]R;Dj^Hw$51vIԒH-R{>[YFKeHu}Ƃyropƚb?R6v8s=HRO0\!AH}7gykvq>1O`}";D4f7&Mљ)P8GKiJfiɴ9d/iοM {%2=ܔE[Hsiᬯf8BI4?k$ d0-s& `9}YEzpϥWX!uuT1;XRI=\/S HF=f7̗za2 w$) g; %a ?'Ç^7CWl;=}yzd2%Ldrb>\N&dȆ_$q݊L!S*2&Sd*LJLʐ 2Ejk?qrpƝ&teO2]Jt"`(%Mtn1&ӭt;^9poKi41$3.a2K!Gqdz̞ WMe<#IdGf3[3#s2$LSj2/&1d̗3ޮa,qy Ia.d~cߴ ďd-?J/Ok2>I9l_:CTߓ2t?'y02/Mԏ~ϩG\;)Zj g-k[wKw~f=_{giAo~Vwoy7Š~5Rtf-|i9t'|vע-}Olits:MO&}ʾYM"+]BVsUj]Z6$+FV':7d?zU * p Y=9NjD˽_ќSnϽŻ^kUBY}d3XPl5+6/u_7ޛg84Tz? ACP4T9 CCzP-MCMiN_cJCw4*wJӽsf[hHzz2 Mv?^͕l\SbR+N:-#|NDօd]}lG dSlZ]k5?FS, Ѯ6e]})1 z/ +'-p)Kv\3xek..,6,}ZӞ1 \ۙgkpm \nyM\Ts oU?m\J'- G ߴw zs\/uO\ u\70~PTk{9f/j̿ahCG 5ֵ-x!he eZ B@h \!keVu]Xk[ tqA'T y>K`ufګbC6*hx ‚hm^ͫ%h󴰖 RFODA8=!|¯_Ցz\Uph &Il,}_ 5b? 1x11Ic-f=y f״O`.D?af|-X_ ؑscM O+HA\^2zoҶZqD0jP˼-ws%[b . qU o]kcιڼə-+噇܃!^T!45'h: q $ HWhH\yMtGH\ 吸79H_Ws8vtvhǽ.˩ p3E;u9딌v*NY:XJovrFh'v=[$2dr?5S'9gݒ<_ɗ!Cj SIhwjQ9HjC* R-!.!AҝgBZ$S -y!-z"ni[AZ 5&A7{4ieuCS]\[;Bv:늞] !;wJVτLY_ cd/A6`(d/]YA>BC. yޥߚyrAn+!?R#:B~-6S~ X7u|:os|?߹=|k{6oJyEz j{ Q?># w#Usgoc m LM|g{+' Q`?_ ')fЄybϨ,X\JrW.P@?CFU>[9P W͠ %t(k'p/*q:ZPvj(φ@bja(,+|#ZLjBN6=8!.߳Ġ^r<2 OG P,6.05P b ( |I6:%iPZĠ%P:P:J[Ci6A)t .^ PzJW^@r 7GRQ[QPi\ȽR*áPzY"ЁdTnGP*)Ra(}a_:AПy*HB tCIn0TOF=KtHJGy,d1 ^0|],E5tmuyseP4a(e@. =?PbY̡<\NdQ wVC9$PW_7(7@yO)w7Pړg𜵅v_޽}s~ւ8T@e8}[[AJ/\6Jx\<Uq BTbr]`Zg7/ հJ6Qn Ln>G&JTKv. : ՙ: w:y&T(C$T{@uJZB" 条&2P5jyP UPUIR :S+$N",YN|~wNڋIYm0 f*mCi9:9~F6,Am>-w>ԖnڶPۺ jjkښ߸jbvju |K7jؾH~!PK W P{9jOR.uQ6XF[ R02!Pתj\}{LM,'6K'{nz .+6%;suc?ӿ8CsX P9DWAԋӠ 4O>4 9q5$ Z7sZkBk8߀ֲNrtGC':iIԇNttYMS;]B?SͫjO\ q _WC*Wv޽$?ѧ0*,Ak=.v˜лƝ<`06zaƝXk:_g]G8x'{[a._mӸ7 }DQ&r&0| Ջ01ˇL{ôULyaRZ0 .L`ړ`jzl LtLRa:*LkjKohr`EbgW3˽FwC8Eﬕks0:'`S9Co`5זb0OK:_,`W`!ܰb|}=,:υE_oX,Gaa.]ma1,c$,;pX%5uru7+aƝ(aܫH+7T K64S۰4,g2X^\ K$X\``y,Lis/ ꀁs0pH 6b8c5 <ɍa\ O,欽Vsgqu=g}$f.|; rr1O}m[-Wrӗ `5`ؐ6,Mac1lJ Ü6bغ*:AÖưCv`6ퟅaWcam/0CgabxA gK`xL  _= C1y_ ˆV">^ #DqrU7g_ Ǎ죃=4X#_bg9 #/N:X+š#[02b>l.ش6a#62a#} 6REi0Q6ɰ ݸ6oПa;lfج1Y oa3lLg56vS`3h l,pB}.X%lf:/lMe}jMMMZ\dwel6=:  C$lr]lQ kؔ¦=2U l׺V ~a[v҃mUN]۾ak ۝ݢ ͬgخ`܉E>aR Xۋahhg]EW`'wkǑ1];nx OYnd>gmS-Yssa7y+`70v+L[>]a}= `7F9`{zmQ/cT]*¨ hV\0ZF#}F[w=ơ3L13~5ƌ1!61cLV2*af]mˌ0vH]^0t1_xbquت 0Ni8iƩb3q=wa\E[q+1n?ƅo1^*Ʒq 1h}܏qY<Ƹ w`\To t8^wq(gt,yø;1n +ww|%_Y,Ha/'L[ !_cU13&m 1at&ecB&9bB.LƄsz- g`i%Lځ p *& '1칶=1! &dtLx^kWbP}uy ] a=`Ͼwڛ=q[k~X m Ia?; a?cMi9~;د D7ae/L'0qI9&.:Һ| L\鉉˴01&xڨz@/LjUI0z>:!L=02A#AD <1i=|CAu;`hfJ>,E`3Ln#ɭ0nUüP?L0%!”8LT'jPzU j`0uqL]_oUkp̀n\Ө4EoHkNnk{]~F=N Qkj~Mܵٽ2}ۆY~P tu$8f)1}tg=noϮO) ʖ,5s6cjkY9+1g̛䄹799'S1' œîa7*e0a|(T'bg+&0w&ny#?aH[jyJ.=|ٳ/ŠWZaE? xF`WP 9ð`4cq1 >","Xt{X?5?[?bwC5x],ŎXgaX<}~=ι[8 穗٭Vyps Շgyb8{8_< g1p> 댻}9ű6>j!\VsѐXƒpi#)piGp} 8p.= ip.p1p.Cw%\v_Nx^ɫ\DC$%q\9 Kyb>\;%5ޟ.9'ʣWMpXZsܖZn?\-; pQ}સU\~.o+* ~zupڨ?%\'|hwC3zrӺCi~kpݸjp`p=׻u8p{9\ +,p}֩6Oe;Z;õGwGk0\ &n"pp[p㉂ r͢3m4M7ہpnVp;f ]v-vpK,{Q?ۗX&eRX\ue*'L)Ld2`YCMw39=aXIUbXnK5A/=cWX~Jˏ#V ÊX!|<$?X1X?#ñbQt+-rXyrVJ4[+pzOUX%ZU"IX%gUR㰪p].U]O`?VMŪ1X5ZF`VUʱjvV-Ǫ%jg)V=jU;VV\dhUo*kVe^)z{zӯy>7gv㱺?TbuVW`u5VWtWѸ5j cX"t5:5ݝVlgX-`5g_X+vk'buOCuYg-esKekymucn.V5~~/7ϟus`LsuScXKXy ַ%XBpj\6`Clx ӱ~l{ (|Cj=?kjk9{][Kwaã gp6={y6W`stl͉b>K7?"9' -\[b9/آw[4?caJU.ÚS=Ğ\f2[xVrke>ز'>t[*Աŭ`t,MV9l/ͅbk uW\ [eGbkqvjz~![Dc5R[d3ce)l_qgp׆!%g]8m<.xp7w,IZwp7\ wsbluwp 5pセH;St{,-m]M=Bla4\9? J';bw~ʸ6rl0_IE2pϛ^ 9`.-l8'Ķ"l{:ƶ%v]o/x{uα&?%(v`G(2}l}&l4v3gl7nݾ`տzwt y۰s2[:`s,WcW>f]z zY`WM5v]N5vMى]c.dĮA{kx+]}vm]\ ̢6v-]sֿjRkU.by/v Ʈx]%vCazt^d6m-#`,'chѰ~oz6qnMk_d^ֿ)={aw;隂=J[G~6Ⱥci=5 Աv_7]t_aOտ{:zǣ`??}+'_d [aW o1uG* ?",={8@AL803nD![8༹^v~9sn9xk8p&6̟Yv0J#N|{`f&!!y0|xa-5 5qR!8$dpH}'!pA uq4g-^xVCf<:ůk g>CXJ2~q<,xI8MSiBk x< HlE>o{=U`\ÑQkqg$8#/pD5 8׵Mi4uib枆8RG[y(Wߺ.хqttyptݻGw323sqG/GcW} PX {c+bql{[Tcql|uvX!+ceqNJx585x[3ی<=Y|g&.oẎg x܀N{ə8άÙk8s$΄>ęR 3A8xg.Cq6;T(LF3ap[P ޭ+ݪom.\+;[!޲= o!֖#xJxˇY} ޣm76="J»z" 㜞9͹870!뮂s×Q}nbN\8g?&;87)&Ԉ|qͿs+SkKqn;%,:ƽ #py}-sO B`\j_Oc8Qu_/IWN l>.%B9.DB\(r%|G|oǡ>g؇gerMoLռgg{m\ I>w'lv}ݔ_whn/6=߽ qQm |?0Of7tj3|oQO mZޮa{mf{ty&.NǥlV?қ\JKĥN~ v𓓄~;}%΂ߦ[ ~:ּ2x9=8 ߗ]u+*yFQE@ih5\XGU(p?m]\w\=W ]V}R#`8%fϭF2@ j , Y.ߴ.z.+AO[7BUEZ}ĵA*~tAPi S'AP޺|>-vC"f}.<"pGZ]}'.cDy#L NA 66fWԯjf ! A*`O9`-#k>BpV`M`n; I#D5^,2"4lv &V2 R}?^AOoNnv5g}Nk<i۴h 1#4 (1h(D{&"C F21ڋNv91%13z bF-Ae !ֈ1ƭ{b#&CoFY9柖CL1S1ٱy&1q1w Vbn &?bUrS-~A}pWGwen]bOFu~jݷSZ:3hw^=5ؾWkjX D3 #>Sbp;K{׀V^783̜jFĜ!_K<[vޖZ\'sED ښ"AT %H0BIW$Z0$GBH0؂ZH;< !c 5(+DH ^H4yFH:wаvcGb+$.G$Y[ļ<$0dM!_Y!$Gb$K5Q姞ӂ=I7$\DxĊ$:H؈$WH6IzHRViLWyAW4.: ɇ;pIgy]}/理H6@+$wvCz$CZ=S!yn$OBDy$O j_ϸ"yS$/~ 5<_ so0!y4$o֮,ބoWk3~oڻYf~kso|_ɱHV1x2Ã; A+BxP_<R 78`zL9yHV+,;Đu |HI`}"^REJ$ix Re#F<ϐ )*)o7 )WʇiH퉔wבR8)Gm<_#|k'xa5R{E UaP]c1 :O{n u=Rw)#uG(R.FԕH]>ӳ=ROX#xR1#A-zhRNBꁧHTHԋLEhD&.HH;\QW'DZ. !-eY_3`<3b<[L}=-y^v-AFd-Aֲr,!Ț+UȚԴom˽?=S#٧}E_{dD=ȎB1ȮӶSbNG/`9 2.rLCڍYSU2xZ. p r[#>^Ezx{ "rNrkNozAf{Gmn9Q ߁wNF盧Nx2>7{M*Żn\kwcxg+wn2nwy3]wKN-Q|FK+|ꟛo>;rcq(rܐC~rŃs9\5Zku;#r-ՑۧSwtB'u܅;@mC-7__u& n!xotn}x"sޯ|ɋ}dx_{tz> ‡ wჹ>|Hz gD7|zpR6wm}~_>άi858ˋŇd>F[1b#>^M>bbT>VT3ǒu\'/O/ pQm g4]ms0a}گD7;g 2衰$( +PXeQXʸ)(,f(* PXPp QcH^(|oο"ٗ܎wl HE}>a(Ef9q(i^'~ƟBZ"\M)~9\(:P}P)vB(ڲE/hAkռI|`'Wt>>7§6|:Wyٴ?ӣq-WS;>§[!_]vswvg +>§},wk?+.g+L|Tp|K$yb4>۵{R|>S}ҿ,Pc/Kxc: D~c A5{Gq Gi_F1C= (;r](~_ܷ(~ 8FI(C /J>P"qŦuMF(9% Q2dJ'Ģ%Fl9JNAɌI(/Gɜs(Y6BɎ+(%[Pr@%Prtx]~[(CI DILƽ+8t| JNJtr@}nꄖs?+tpFKG.BEE53Bs(Q@f<tBi^JG(ҷz(Aiz"JK濜mY%k n|&Zd2ʌ/*zArٔlq((_1Ρ|YOFH9r*Y(!r(WFy+CykUFY.~v]{yK;>}vW{{_ߪ:s{o~GNؿ_~o9_}^][/>?_>)kߍW_Ws;ٺFP~S;e`S6;8)(/(t< 9.(xXԲn7܇g0f1 0@,TS*>ah=}Qa*>k;iR kިـ5 ɨ2l ΨJpT;JlTj )T6G堹8Z3+BPG.2<*#P׼Pj+*?)**rQ19P*/ЪTV8^\QյQe*2a:Ui6AboT닪ٯQUuUٽQqUQu.0t*ޣsBGzxTFPTwCT+ɡ=7w5y?Lw>k~׷g^^ޫ/Q}CuQ}&"g%;|1@M5QFʠoѧkըr5P3i.jtP3a:j4GcY85NҨ95N/MQ3O^@'^Z"笥 z9Wi̓KjCd5hh"D=6'$#v$|S6ym')hD&"}E-q(ש6q=J\W!q& UE\٫+˜2d+cqgq/szƸpz}'-z7.v%n=uL<i[kE|'wxO4g&&>7e}aM=Վ1ӟN,&~ІߛD6'~?/&3#H8NQu5 k% ImjZlOǐ;$ЀL"H`03SQkHB=L;JX*Q='8΀X=QWt&ɗHо >BzW$8ՉX "_ J~$+D֒j<;ĒG R"Z$8 s'$p7'pmyC^;=s`-%H0\Z%!$IBzB$$MB}IH' %Ih ABFz$O)Z5#%u( y$$׃ !v#^$<*$l7mI R#a$|$ G"Q$|CxH r& kn7pj ?$ᤳ$|__"gHy]Go$2hR$QoI"v$"CE:$X܄n ޾-hO"HjL$K]H:DG~$$:.~GOh"D*fHI$M$8=_&y3->*jǰ/Tا_'^#!,Ɵـ<-$тFF_ׯZSWHH|k@ $n҉ħD4Ͳ'q'Q>$co"q$ɛw/l0Ͼۋ#+$YAⷙǷ= " GHl:[-ԮrjMnHxشGh~FcDӻ{ʙ ը-_&MmUʨ;9͠Cm%^S۶bVڶQ5fz4ئg7' .$COIb&p\OIb5I NfmjZ$S͝$.Ia]I2ITD_hw-]}FQO90jD=:J QגKIrqI!IM$Kʞ4Wu"I?U7#ēbG\JoH I|`H+IU1I%ɚw$ݓZK6 HR"9_s$rmء$-G$b"I="'$ڸԍEP[Eӷ$=% IO!~$=aOZ1Ӟ׾.n$Ĕ'EIza_^0}k-HzEI/!e Hz I=OһsI\I{] CO$EOo,EҷH/HK5HyL% If|(Ɍ"!H5B2I 2#\oIÌ.yG}~d 95$7KrsInG]#]?OrF! N!jW \{+LI^x $HkkjB_6̨KIs)($jL;R9N ]ZR#O>R81SQkεŐ{TR6lED3RF[2Hy ʎW0~'Ru%e|CzCK!)'L3UH}V~6);IRoM*<I;T&ƒ(#RO*2ȧ3>ﺈT椓BR^C*S'ʆRY?TV&[ފT*J~(ɑJR@bHUԓT!jfL&IؙT YC=H,vIIs/RxTّRuhE HuR]wTW'ڐ>c'n!-HuӖhDҺLRLy |*f=oGSGԱF(@'RG(CzP-qut:nJ7<ը8]:c=c߮?u!zm^ER;dOjBHmOjN"R;!EjǦZ5R GjIj1l"[I-/]gsҸg1?5THC6iL!14z^hʠLڤJ4I͒=Ӽy_;מ_OC=⤡iKjwYVl%A V1p0i 8IKI.跛4-ICpaXt^E!H#̙4?kY~m>iD"(WҸC7OF`|HZ;XҸAH#֓4k_7a>_fuQ4I&p4r/;sx=4yN\HS͛4;= M5ifhn!iQ;9Ӿ.#QHO,OcGmlHg ؊4f1Ҽ4l' \4ɤn%0KBZsIK)iɶ&-S%KZZ~IiIZb,VYIZG kY _c+ie & >:IΝ3*Om=~UQIxiiCԹ$UH[zjzi&I{ i/ =7um.#cI:.mI:'ƀ$҉4%0tN6t $YJ{H7,6!I{͝t/O#o}E>{jV,%ݒɜӆuy~A9ZN]6uݾ^@]ck uT ?eչ׺Z!=ZLz\Ic[S\Fz^eӕ!= 9ZFzHd9^uoӊt Ho M{ϠFz\7#ɑқOz3Ho}5-gEJ96&HzyKzIo4y%ICKdgEzH/ΕM)һNzΤawѿxޔvZД/amy_dDS MZ~=k;V8"}A/5Ǒ'7l'}NrHrI}HK̯eSҿ]D7Juxy'2(G 2K+`2p}Г '2X 打_[pe?4ߣ%eM=SDыzH1Nb1,A=g.P4x˼7:2\EB9Qꗜڅ5;^h#LFxh'%$d<ґ?"cI굺zY ^C쨗P2XĄYe2۱eތXxڸ}2O:(z^VX756}SK<^tz%Ed<3VƯεy=xN}Pwσdꓵd.> )zL}ގe1ʼndҮ;M%x2L#~dbA&F'893:C&d̿H&Tdّ|!| )W_2J|8kVd*&NChv .LCLfRׯ^Wmvz__;~%g0o(Y'sUq2WH悹dڝy^Y /U-!H2+%d%̊GK2owߜp sǬ;>]<d.KDb ߵ}cȼ2FFdn̻n4<"s%dv!s⌎|R&OL#ldQN|_ ed 26̗ #sϘwkF7~oxW^"2Ǟk4kd5߾I7˩dc7Q?E8P?]o&;ғ,!ɢTCɢ ݣ~_VSrԯnGWfvթG\/'Y^H#Ӌ;YnnY HW#2tYY߻AqkMLI̟ E2ͺ>,ӭ6@FeVY(*ɲ\,?i+Ц2@kYGT:LZ]DVj0Z>':_ow [#+J{KVd~:Ye}> 򠡳rh3?GC7iP$mix4Oа4,^F܏ѰhdnO>O֋u'@֝l-5XͿc9>d" uti:m&[kqZmdՅlo$PE$Qd{ds nz){H_Ȏ)~g;HfHNu\5ܣ< |UB_ ~n X(UB\Xbw`(c<9i ! /mVǝDf?iZ2uSޯkҳ 1j!8yePDON4꠳t[g|}nO^~"O٣;OrևJX>w>{o@[Ex)F 4Xϙ l-a62#0jg zp6 G0Q03`FF̎ ŜeҘw7Bp p8 @omwXuz5ףTk:00Scc 6Im&S9l Ħa;bpٌ]bK͵{&t*Þsw<ݿwc_k{f]=آ ,w x܂l@p  "$;=3=s]?]Uשοopg_K8\0͏Om.p+9\p!!0C)oS{)o>$LyaW~^~Q_ (}M~fs _kWmvEO{Yگ> sU sU s]~nX`#3F0nu] Òk|=,va \1.,sa +BXsUW=3aa {-q>[>l?lCk]uE7(a5͡a9Eo=x~ݗ \7*rᐏW ~H8߆#N19p+lN\bpuÉ>N<䷷ 'tR8mC ϰk8CYZ-L0᡿s^p !\0b%> NThB%g!dv ac! ˆ{C²Xծ_0߇0vv aVmק!̟VqGkoCҿLaZVv+=ڮCX!,x{Zڞ/Ezݮ B6B8;!lz9 =!/!9w@H&#Br!5B:!񐞱Ho/7' iOo=n.ґ3_)ϴ],Cy*G=,?.6{߾]vDEϡ窳Bˆ;WC Fjae*vf0ì:+6#aٮ ,yPu=am*_?{rX5FAL}v O8!^siy0M¢#NqMXtyCxy^:# Oܺ!vaziPZpPT!նe:^/kvHѡH)L a , /aبՏCWQa!K npv]ǡwCυivmf+}?L}Za VZE6kO 3ssa1/l{q9ąØ9 c8),֙r'loِ•ۇp!\Y,µO eo 3tBz +tѬNSEy^YuPYPY}PMW l!. Sz%NfH;մmv7(N^5mWCسBs󿚞i|^u0; <[}fe0ߏg}\0纳9w~(̹ˍa]vBaC Æl? SN}WrF>!ߜ&0r][0FnDv4v-9~04K?90LЩa~xoN;07v_gÏ4̸aY> 3k0ۅzT[9v;{mj_{v0ʼnۄYO5z>&,f=agLJ~_jM9M:4qݭasp`5\KabQF-sp~a/QFm\! ?F={QFDYaV[FkG2Y~K[<{U,sW2}C\^W?M74[nx΅bV*6UkC5q!,oXU߇¡v?N2C۟"g7>{KA>IG ˄қ/wdd9$.#Cv ؏C!9ഐZ akO B:cn G̥Bz!kdV_"dMG֥ByCyPoPPc<gBy!{ʐ=涐; dP˻C3BS66d,ڽ|= 3gi^^ԟ3[T Mpl@ávNJoeIo.KCqaX6?7?gYv]b&vlamj77~`V"lS3֟K Nv_oiVFbZKl|mWoPC^iTzu{C~\ncXb­wzgVBkޘ=Ow̵XLVT.͕K+O]۷IWNDҥCX]ˮ^OÖ3NK_o-Wg~%zvߠ^/۩/K73tmN*ûIr=ceu}=?aY.풕MY/FK3K?2C̓þm'C<;#7=qvk'g'udƀ겍n_0><:ȍEyAR![~]-`d bnnjF ~ '+س1sF]gש>|6!Umҗon@{io߷˘1yaWKۧ}~_] YyI353k!˧֟^^.u.蘿IljK[s~+'S xsho%W$=OVK߆>&dn#n>Gec^zG=|Sڛ` 8$iА+;MzAb3s 7NˍU1CLX Ɵl|ë4CgJKpjhlٳ8>O5]tPj[m=k:}`JhJSUZ;Q/c[}\_['6%ǒGo0v|xg+s:ݦozlId^r BJ?28`lK[:^Ik4a:,7-gxA+o(nlfZc٬sU^yt༼S?'Xj>1V|RװFpX>Md`K9=~cXg8)N|`_\&ʵk/`5ΞKlҿKәavgD86XLeoGuI}<`=qM|3LC!sgq?GppR_ż^+W䣲sfs؄~4;0lXTC  9 qe_o{TMk//Q?%ɥ(Od~< l[cj8 8ID[6}ʆooW+}e{UoKM8} %t3ȡ7~oFJ'_3Y }Aή?+Owwݷ͘w5y,9FѓVi:_|f2F,F_]?ݘ? xHk>< 20x4~h0)4tAZd2 ֪FwJ7cIOd.&g ZǴڤ׵<=y'H?)xpeóc6>4],==&@0W~OLJ/Mj3־mbE<=EN9uI:kb_7 2nL7Ad?KY5} {ts tˈKﷺl,0v!$s$8尦l|G)Mi4V{͉dKJ7ik/붙3*:TF'EB/$q39xEHlaEG2X/Bv~^*kE*%a]پrm^][& +&!>ۀ3d_%M94_C)6,lEX4/N.wZ~- mڼ+o: f̅#EƋ[aUMc5W'~T9AO Id,|_?d{(?CA-Q> zo{ŘlwpJ/ 9ARld5e3<_f|t^{ ߹P%dv?>n}Vlc<}z}Ö@Փ[λ&M&o=,a<6D|p}CΛ~tWz~=6Vc_CZ ՛g$}R =lϻVbM)&dPvymk58/`49 ='}o^Vgq{?p Q]s¿ï׳l|Pe l9W|ƟeBe.}5?lS3i,q<̢>a3ұg2W.-h8#WyX_ӉAe6[_t_d[\l%uCmu8ç O>=gmwN'a3<|ܩ |to;^cFq:>QK.S1)y.Kb+Aqp My;o=|ȐYrD'ki0u3û=ۘ,\bIt_y>#^ [H,¨̽Ke<|}O EA7vحMhѕyX;_ `=_X8a =Ad}+_Wƀ>(mnY.=ex>fBoA4]YyJM ʾTO}{Mݗ ZV>8G{(59<;41&kw39b; mi=-3=Ԙ|V 0b||/tZ:6|]Wљ| AJִ՜|sfU}{ 4_.3]piy}8}90:1Gߛ!<փ|\īu^H:bW;WW, -. г~֔f6|hY)dmmrP/)>}Ѓ' d|ӛ[ O}48/~QjGhM?:m V i v8ehʽW~`/d4.߮.\9ڶS:FIhWy_{#)ZLtޓݚ;l)A4 Z+:sRcwZӋ(%W4lmGؘLlϳ;;)y',/E_ЇcKnk V^}/KL?ɯylYwt?[/0^5=[>=w/N>6׾;?Vtwɫwzfq`lcÞ$t7w䪆[_B ~5^R͊HД.:x3[]#}/ȗz(ٿ'ߧ^V;y賌w}42f`p)^g ,*Xҵb}ɯ򵯖W<]v},?!5/񧕞=yC8&狮uȯ7M]|sҾ7O 1mwb?AU5yjkj^v6 ;$|;3jZ7 mo :8>2xޟOE3JX^`(ş>OӞs*Z]_U |- ҁɢtK,e'}[gͷlȒW eo9a0Cf\/@{vwx hk5a'+L7g{{:}[YU<kk+~Vh|WxZd+:x= kGvz MR[?+sa,? 8&(Ṙ4e?ߔ.uԛ37I90W"eXK-6vN/9 u\ߜދeDpAڱi$۽={Mf Jsڐ|="3py]85Mq>5K;tMp&~}ōO*#c^τ~<aCj)OBz?CC蟑St=z sg0!ۄA?q<vo|W/oг֥Ͽ?i['mJb,9;˟`,AosK3.ak]^0{;䵫wvzߓ>qa,`#ڗ?Sí]:G1~o'Z`~ل RK3*o~)M [Ď^̓PnrKh_gGNٚ_n#62{ E!nۓFD'  9*sldK{ۊpt;FS+ AϏ7Qw_l9c)]8XMz}u\o" f/Hc-vWyT]O[P7O>&`:"ڇC1oOMmz7nU֋ G5_ռ]ެ)QOC/[>}r(6 ^K6 _"t;U[&=N>'Sh];i_NQnysۮ :IANk-'U HOq/_鰛!gyh:eeiE }k-_x<*6!d!>tT\C[yl/^JkgE]}I`uRLwߞc`U77m蠍Q̆,p$"~ gU>w:EG66T d+Inm+uwwG/REn~Ok~2յgy6+yy|ʺz]p=8~f{_cV;44ꃴcC2z٭/'yǺUtnK2|Y{F^dvǎe_7&Y=Q,P?).uѯ2(}o,vG2<q.l:c`.TF~g$?GWwu۶wkq7|C'ןsJL빪7gcZ^w_QR1׽B0'+v-{deGBwZf =w'zX?qqłZd+;}R̮OB.~9Gwyq?|߬ ҫcwf6C'b)_d-.˃$/ֳ~T o ClW!e SF,ܡ 2 m'ZrxϲQlw|CW,3po 4fϊâ FK$'ؚJ~ox1xeo.' ;S/&v|}}ei=謰8)i)Ho%Zm6G׾ɾc\c`}Rk: A~',n8LSNŴo1'W>jwqު}{##Mqy>+-HcYYGzwFVl}fGQa^~wd]< t?;]Ӧ4i 48: K:4[;=~.'A<ږ>;ٺ^Fv1^V6'ݖis-oig[ã:Yotll* {4#$>vkO6; ޤ@gmFde}]2}}?/ec ..yHӅYIω^#`C>K6[m95Y_;KLۿ)mXN~xi)sfÁO2gEEO?p4J7KC9mWF:2& K_9,ztoR>87Miu;3^We^>O1RmGtySb6O?W>FcG`ANXc23m<7mM&qZ?鮍dl~ &Øڦ7&mN%Y l o zKEvĻtYdK`N?PP~ ̀1?!~*1'24' 73Y8]_|211cq'';=y x=Yxed9p"<'zZqeϸ3~ v o-%[[~"V;A+6r&I'kxT*)ױ b[/ :+5;K>W/.=C]rWcaOϻ|k\$eݸyߴ kЧK&V-d_pf.:GTwcü|eߩeNfsl$L\wX;#l)v5'7wFemy%]d|l$n>5Y-13[-@'U >dUK~' vrﬥ+oܘ.9k#i(o4@0XUq,'*媛[.z2 L7ųoߢ\{T |tK]jUѡh=Щͻ#]E~s#q':2: ݡ35u羼[/wY^^t;Kzïվ :_?1dn[{0rq_mߓ0k4Y)4ך9:{<3lt8}н e7KeZE3:~8B1He"m[>2tFb׷")|fv/p z}K0kl ~ | CG ?WwxZxgXh+~Q4gJ BBGa?+;9Wq8eoHv@ݔOr^:wrgn= I[昳IK waJCV3?.{3s#}w,8c,]b38V8J' 3:Җ~k|Ck֕2v,bXkqoJOn0!k>W:릌XIڶ5]rmޱnxUlyl9mS <YWF4Ufd'c߱vak14wٲ*o<6d#A/tǟN{VS<簖!; V/D}x'nbE񵗉qa6u!ǭ-~[bϽC7ŻAӼ۠7yiZNuޙLyexa/7m]~Rg0+),r̸mky~mmĦƫ%Ε+_=(|A΃ero+&w+B}? mC۠yGx_h:zTS?i͠Hu"n~9UIz G]TKu9: tv&'N"g7ڄ9݊=EkNoY YJ8+voA__FW:^=ɵϊМW ր"kAk_ :#{xg4/nefZѿI4λşF}|!8/m=/Kڵ)v ʠhɿ-S/c{۔)h]~e:}W|zlI;Ph)>-V+AҪq:?.g7Ygp|3up?; .5A,{\ŖJ ~iS=|ҀemXήWo^(%;xx!8n^|k=7C*bSZ)R[79ɣ^drmk{>Sv}k.⟂7ۛ:K}Ro`tknJt7Olvwtgyl}5e=AOE8Ă<le ZHAv_\#9o֡!SظW,dNxtb6ɢm63'^}&zt 85>o>Z1>?+|=%:D>׳KҾXM!l 6Jl99н 3:}kD󵩳^zmաHt_xiw6$⺪ﯨ=ڗh hSv}H)g$q.pxF8|JsߵpwrP\NO6 d^?Z C4_nIVc`؉s7B&G/d\/KS̷˰\^#_c>8gߠsPz7xYU 3Al4{$^~xruojܖoٿ`3ʞK#m,QclʆCVdd>g4lɩ7qIvG<܁ѓ~q2(?Q}D+v8P|kLZ}\ k 6e3bVoۘ l[(Bb&ycR[aTt3E:}F\#҆bWw#kl& qK+e 7sҮnJsk:]2rNKeci+>ygIoe%-|MpGV\G"y;khzetNď1 on[bkO14۟%_rEH[6R>G`<غOh}^77+νV lyxl4l8QggZ| ,Ttؿؗx71v5[,]  w/r>H g7CWd4Dl~nڽ|վt{h7+?rOb>Ŧß>t^"3atRq2 .iLF.س ~#Ω*^O5M[bd`o|_{,ߟle`ؽ3W&c>jcq d䜏nPII\!zѿ~BGD5z~nSF\&K×J~/eFګLat=ƥ{ou^F1h ]h&]ll2vox 牒'"r0OqɃ#+fȳ>'_g:co,]iҵҮo,MKs:9as1[Wgk>Oa.3O/ Yy7OKLV,Nwq GlqvX myաΥMihƾl\;;6+pS1̻[OaN$.F t'grMC+ۢz+9it~lp]Q֗nv`Cz[ԙ>dΓOMvL3h'cKŇ9^o4T}OБmy|֟aB/ԟ څSߡ(']wo 'E'Fl3B7m7S=6:r jzg]/Wuwטwk>">mޛEi c9C<l)㟉}q J< w].۾?诰1йFHcycɳvmu+[l*n=).1ѫ|[g|/~oTv+,t 9{Jz?8(V#M2x ^>βrϾ,dk]2SߜJ>*N՚6Ʒ瓮sL`|nlP?|8{:M=73|-eSrGۖ3r<,廱OFgkV&ƃiM|+ytl#"8cƏg8 Yɿ~MͿb?o9`:dH02lw]o.H۫ mBAHGWwkz߲};zAhajkC]|G}3Ǭgs,1#z.䟞ى70U^ Z. +K+ ^("Coْ0M !|++5[':tE##/=֟tAF[NOuw3xi`]F>C>pf;p%k~VkO.kT 6YC[cONdVjz/;>d?ZS^wL," փ gn<8ԮӇ_XWqdtgb3^۔ď?x.MX_q&ʇ9@gjE&2<*k+3 _<7OË>~O/Y2k #JCVۮ,{|#^pTQ=9;ԡnQ^UP)33|6* a/6|VyP< Ѱ|8 in8p} kAS6 mӦ=@[mpvf-$Ih}=^/8_q&{$(`r6?#^;(uk(`pW[)8/Grn?zt?>9"_Ç}/.ӯ6եYi߳˽O9I6cV+4S~Jo>GO+&Lu<٫ 牟7EUϿA/a|G cYfg]{&&/}dk:_.S!CcFoFx/8ia-&Oy]/F~4׿|`TTYc/w|x63>wjtS>o1wɠ'0?Ƕ>.❍ Qg\Q8OunRr/6S6}:x[ΰ_,dzZz?ZnvECyYǧ:glX+kl=?ƙ+} K~?aoS:p{4Agw׺NT~d]1/5!˸]|b|eEŲ:gi6]cR4WT&:vm߸;֋?mj6uqϡyYȱ՞OwXdob98 Y1h}rϤ2捾\w 9}k:#opiۊḳa|\'UF? z%t&CVW"ou_7Ď#wGPqW/S=L^]GV1:.>$ +x~4邭]Xk_c~%1 g)M ~VoǴ0-oE~|,;lCuU\/W[C?ݑ+2_龡+w[K|_6I'mzZvi.)=3Gc{{g/b![PlNjɘƚn\[Gu(_SjU둽孽m;;lrCþ;׹LjtXƵh4C眸ゟ8'ޜ7_& o< e۽+^K&=T2l[ӈK[{g+C|,5^Ug&gOxG7ڈdVZdآޱg~_ رEO#~wO260l~ڲr#'ԡE}yȹU7tw,SszQt/ْ@q )&AJ_=yi; 6'6e veGoF5~B1b2^ >;nv$5}s#=>pK !cDF8x\>長뿬b |ob`H{G:ӕ#-ҞFc#2g_Noz3(O;a:~ڪ7];צGSgh &$)Rp:G巇\\g Ϸ~XG0Vi;/W/nj+dueYreҰ%|{^%yp7b_mM˗&_ľS.\}駜K䛟v.#o7_]+r-١:ƳF1n䳏XOehC_[*ȷtc%N|Am8+?ʄ~eA[: hͯ {Xt=yy#y֔yY3V٘#x,lL/*:ig KrmLTkm.^ Cp<TxKxWfYS d7^?jܹL#>vTh?{eczzY+^E$N\Y[uÇ< jcyz' ْFct$g77=6f$pe_>dV&3֢) <\Yvc; iOz:Wg^0lU[bRPcX2Fb2/ 8Éq<̞1E܇ ;!&dAg9ivQkSq"G9jg _13B CUc]Az_sD0؇6qPK:QO+cG혿Ӌ2S7uj14ؚMR16; K5b$wJϧK|j &>PF}oP,H|+6_$SAʏ/UqW%6^s?q Rw@^gh{7:nn5AweR piI_4j_4b1 /^EgL| ŕ5Þ.lۮS>jwGP^/ޘ&;* OuqDž%=U^S)MgDH{oTF{;; ڐVsIuV)t>F/1/˽/y' >tE?v)rF}qmPIv4ڭ #.I|='3{l_G{c'6;?84W.oo۠4go]Qy||~-#c n$S>5sM`3yzkW\_k;5O1ЋH']GpS5X6~XҏGa<[b 6} =Ɨ'8܈IҪ70>1yỶδ_A{ă2=􀨯6G&\b5>~Yo>!N[y6^'G?.TܸpJfĪ䧴i_W6h#W#ި3-l*qnz^͟Ek6'+u/Ǟ3>ՄewSZs)-Y0qm{?受gopOR t3#p@9uW#Ld$7dh-9Dkir|Zb9=P^Kӥߣ}߽tėnN9[{I߸MmWnJ'&vt5NiJ;5Mgƻ"z-+fz5y5#_:mYgUIt4٦jk}^J^ f}qAeӃ_+PO/k{u؅%BCrؕ^{Ҹ4XUzÕa>#{l?iWy<6w:=~i|'K&,6ˏcl"bMſG[<:Wzr;i3Wgmm.+}G7M< Y+,72N0aDq 1y ]^&_j7uv_j||q({HkvIW?53|Y#cluɥ`;#\zV;gqMywTm0zdܧgxrߓFg:%ߒg}P%OvS;:Ct_ѳ[:GAo |6gqJGw_xOcHs6RsWxv?@lrm,2M7W9|^Pf\9tg8L!;q^E3Ex@kpk1{n0sn|.'~SWH~ewW'n ekad O1tk_{db_/-rm l wWߩHIvQ}ѭ]_؇/:?e; _4[TBg=՘ zzɁo^t*^92KwT"/10ܥ3Jg W'.êX/QQ5cשmɬ[vnީX޺2m֪dIa6T /'?Nrc*~KnE΁B3^/CvEw@g6׫bouge7*(ʣCYh~'bN ;p[OYW&zaiu_:lp#>\(ۊA{p )ؔL ޱGďkT;&HXvGisǤ~,[t[> nC6/-->W{_ zs. {='O񮦴ξHSum ]bU.SP[:Mg;E(SNe؆tz6V):ۻӽi{;9Vw"L^w% ܜY,\)-ۦ}9uf+]}ceo꾬 oR!o"RAgn>FlMf K=Ol?i <.9^T5WqX`| v }|9Ci˵KoJޞ)yŖGt|iT @~o 0f{cY2O^ ϰq5c8=?Tw"=#OP{)G{9y#­,yX` ?/7~?pxR][q:5IE|Km~3NpS{}w1zʻϤl>˛Ⱡږk;¼\=洹|ߪW:=K="?TkK`x.YLoď+s%>Ή[ Fw=s[ŗ]ؚ`8}x7F+MhkcfGO|v+O{K)lcb/"^2g?k,:&~tэyŘ/pl?L>Wgg{1r7^CAb3^tY8]]Z^_Ey p:CZb2S4"7sl01M@J#ܢ})^65u<}~(6$F͐lK;lНs Gwg{d;BC߉{| {!J?jLNv=Smk|4u)[RL5]e5s7=g.uaY(psj?ОK KږN^q\q5>1׉Q`_61_wT.ĿXN4` ?g){|">h@0kO.O1hAsx5}̑| PǽГ}g6;lg{񷩭n:S{ CLot\&9`l7ܖe҉т\gܕrx=__pr9;^>\0} 7/+gJO4%Zko`3V9gXI &%UKpbށgOg/`J:Ϻà|'ֹMt ~¾2s L_~s9WP|룥U.oĵ~a&GWk5H U=ϜG*;=*o/]}}!{>[G<M?:Y/(= O}h|eWuss 侣8t 'vt& e1[ NtՈGNi#`x(Ie@Y&hXE6~*]ښ_ާMR6oxy/0PcRMhצM7MCl5`{\{27u\ʷ2J8_1bsY&l߆<(١e`hǤKy+L>+YEdjv{m_5Ǿ3'5+&OmS6&kkQ{Fl-bLpRyð̥}yy gXc#܊drMVqq7qʒ}79 0g[TY OA0xԞCلLQX?4M9Uw{=Cѭz^92_*xy}^۷7C>{.Gpv9i ~t^Gx+()iuy[}>z 8b[cmS<-&Is-xPٔZ: 㳈3z! ϲپ/x/#ytD_rXu5~V;S|Meuʷ~H`.u;M:Mz 4tsMۏud_O9O!MGFM5+lSMe^k*^}\ZhG#x;6b3Pv.^}>sgc]|,c'bM11qa,#=|qpn={mEu6.vC0$9}^MLvcf|LiN\p8:"g~=Vipkvt[4m @n[?t~A9Seor Ip8czkq&t(}+Ƶ만%W Oy1:X'Yq`u8Bv[tnG5lo9 |54t !ة- TCL΃wY.vQ= y|$ԞML~_{ 7x$lJMC2C =-Ѓw3y⫧=ZA~3>g_O#ׂ+giN@; 4)[o$~^?#Cu.Hrs>{3ktT0nWuoTxK7;pyd9 L盠gxi+M[ْ{Vg,66. dQЗfLlMkka\.ґM6|[!ߏs퉙 1xA@tp]cdG* W1_1e_'λ>na Ŀ`'nwѕyҰ=s16>S<#bCLv-pPWirPud,M>38tTvtz؟ou}Oo/NW\K'O]9;/t+s}xEU֞+`a zf 2+_&ٟhFY ybtҐm*768/8b4JTOjptվ3t-y8>۸k<}GgsS]zFon\g@lW6ybiʠaJ>EZN3/aw@g%b |N}?u;.b+xݾes6-MZ6Ϥm|BP:Pen4ďb˚궫_Tov󽯨}u-?Z1# 37m",-yx7j[ӹy 8@_Ӌrn(qdwkfsqk(&z_=b؟'݃;I'xEX=q֏b߰>n#8eBjFUዞlwtY!];^2G_`v?+O"ߗ55g=/N/۽;CSN/k=KQ?Ny 2OddY }W qxԞD[h{;| e9-λP}C?~E,h525#1,oeKR]Z#A!sNScd~G7/%ĔZ_;*o5|S.218ݟPva+[F~)o ߈uO̾rkᗡ% =ʾ(>xb$1 Eј3CI=طfEU.dw蘷]|yGź/whV>=8(S1}|zUtBFz~x}k=kRMf;ކ> ~U:gc:v`9tආ/}\P:K<|ACK- ^3\t_asoޡi7l#}4Ok8"N>ƸgLP<4E%gOt4xexokG: "7- zY6v Lwe8+=g,ݘwe2_gx%h<Pn`Þ'=&-'xm|gAF[ů?AMLӇd7&}u=WgLyUNpl`y5],E&bcO ?\7#/+\M7vx2^^]玃гcN6|F䫆}.K4orb?g0";ql }g})6|ROܤק֔vkt׿#໥wm|=M7NA2b,p: 8uO㯳?WY{7xP ':.>]^2_=Oͧ[M)kx|ҝ5hk-> S3]æv%nyJGc|okssۂ%ahBy`ɹ&ksb| bp5%:mox0kC<7`-?#i{ڕv#}7qa^vߴ]A|{ɕ; l,^⋷mVrg79l&_t eWd atJC35Hٖd7X{w4YOУAF#{֒|pX@.z}veUxD?w"LwQNx>9wv'\<^˓֒]ٳP:ܯ;zf~a+Kxa'61=It]@M,YEpe? g9L0|yUTMM5[m=_z)scΚP${/Bߣ=־sf2?@~C߱S?(uwہ7  =՟{.$)g>_y^tTG6G{{6uUzm^*ϓa/qڏQ{.t=1X}EOëbYcF֊O>q|RM|'eF'[z=y9!8>+V:Ek}-37B16q<}*maM}w\ {ePLb!Bwg31M1WsjzaA2̧Q^xtHٚ'yZ柾5Mq윆wؼ%֟cg=UױW?.oa]|ZImlTv ߐH S{3kUUKK/YY5?Cve0E 4Tsßk!7cFYz>{#VSν _wrCgЏ?{ ~F'1O?^5wl&cǕ :~^sR?CqD*6_;oA#/,3:lG+u 3<4EIU5@'\ 2> ߦjj M%8iEk6^R\l/:=Sw+sYVe)l_._k5F,*8&Lv/-xCXow ;gbOsz9j?O;'zZ;)m8>]V~VādI=_l@37|9'ؕO7 u'򗊍ނ$54qWu'u|)/mH7r >r?WFOslW`_P#d2|1kdC"˟}y~Ϡ)1-i]&4Cg6933YUHgt6&r |z%| (L2GAؗ#۔΂<}u|v}J/oS;'ƗP!f2OQ'Ä.twhKx>/O9䌸nڤGei^ܳW  e7X5~rf^rxpn||^׵MNY( ?\?y}k~=_'F_*7AyXLzzs{޷u(]tѢt`9LŲ"5rO1lƫ(.A?:,uj?qzT<ܻ}"2+247Iyủ,qm2tއɲ\-3YZa{2:NK(CX{;NƓJgvG<}+k;:itFNǘohtsOd8b茋ҥigC۔u$TVW|( qx?u=F.iqIwJ.Q'+Vq>yw+GI$ѹ>2ik\+}@zOk'N<qO|Wfo"XDޚ5 9Dyhۧ큖?a(<,L,]5hOj\n1M..]?s( :Goڙ6xq]4HW5ngh7 %˥C^-&4&cm?2a ;Fy+ku S9 0y|e=Cғټ^CڬdW^縴P;Wm}OK1N1MК&{9sZto1^O3<*9#l^՞4dUA1O{T\}ldC.Nq/ּV "hK߷8]w^Æl bǐ/i⇶7.WyxLL}AnKHi3!zz~kέ2kRN?_O߶\Q{àqG e;8a5"K<9?K3`.Ot-_Re_3syz߱3(K65bFˎ<)W;Իq,0}57qpk\]O=)\񾖷sF߅.xPA -B3ȂB焼n|.&gw)6 'Ob6o͐=gf&>[Osn|o=>v|ݞWh&g*6?ILltA*O6GNv;+7x] k7sKVo걝a~G^:/>=ޭq32{7^b*~#I)$;97Z6/,^۱àXZg CZ6+_@ +nt; Dvg;|5V68[X֚ľLbdGd@k /h(^V1g[:C`{GD^X>}==P/kMc_ :lPYx~OK!48d7wG/NrI&_ gZ3bt%7:!ffbU3t zVUN ݀|_$1咏ƆV%i]s7N:/z6:뿏詨HWPeVo[U ΋Gelʫ)NkhOh ~owި^%>d5״Ӟv7|nn~tew,O;d_q K'ޫQZ.[lrc_}aoչG#߯! ߂ß!z|dnL/[]كwm;.>밭Z)i)oVҙs)}sۤ`]“.Oe?V2ꯌ|;3XNplsXA:C ѳݔnƳڏpb.jb~ܔ^h"`^0ݫ8]fp.Yc+S9C)s0wh[- 9B>L 㴙o`~".G/Eߥ>47>43b8?˞]<(zLA2'vyFGs6MxLWOJ`9y"7L[gc ^#s(]xx1|S[*JFԮ<ɱ6)gd8q[GbF]_ŗW\1wd0uǎ ?fI2(v_H8f"7Im!BFK"N nﺣ]>ח"#>NJ\ w*эWWs3A><vMj.],Oʼ~$ Y;ǠMpkf|gxdlk|}Y璳Gt2;^ٚeq=< 8s7}%}H)W7߬z)7[CgxghX.uh]e+_7[k\gd|gڛ{>5{&qqIt =O߭| ;| *Ѿ>4zuJr4N;]YLgSwI1oJq{d d\F&sWߊ_BF0wo7MyK;;f?>_6.bA٫ms~ƭ ̷4wo_')^eo^<1?צNsHyqbR^qci:?hRrNer=xe\6aoTrtvւ߇uy1{l̗(ȵI͑Mӹ,}(qۖE[?x)-C&u>\b"DA_k.8ď2mc=a]7WM\~]P?Ol1^]>|?Њ3I{M&O ;0Iq}aFh{T{+2;~*< TIOc;Ŗ|TgIS0t L|9_[C&mǓ䫃 :<_cWۓ#7ڥ+H0pEt:Olk.nwϡd}N>G7}5틂N[ غ48M.־ϛ=%l2ߎQ9iHؚ/xg/HFAݑMeNk-Sf~k^B?lŸ?4uÎ-}ǿb_oqzxtIk5 ̂3~%guXco|i9_;~עg`/enpn]T$k8iKOc¾oGppO?+n:N5"b{P{.(~<zãe_qϱX}ybكOPr\?e@N]Y2u\՚\1Xp0pyCo9mWrm4_jl1 ~I=M>&D//WFPs|]nޙiޑ+טG tѴ^5&uNk|w.{i4|75<]1o>Xkvrɠ4c\}Oҳ]P_k4?¼;eo|Vx!ևY4cCC9ôG ={e&ʗc`S}adw+GyxoxK~DrU?b;+~(d07u.=^G[9jʯwy+ >)}ןd垥})WvהÞ]AK Yx}}=֥|UzC $ز/Kqxw;D_RtWo9-"NkK0ρD28~czڧOk|^P_gz:׈8/;,:}SYlW1绊k ۖ }#OZ1;mkJ!Aa<,Z5-(+;ՙ #ɡxuuESe x ,u_vseiߨɦt(0^aW\]dZX8.'v, 2)wB΋tV]Mi+Ϟ^pa๟ lM%喘~d.} v>V-<:S|~um{wKzg.L+o_71d3PLf/o|نԕ${~x^Ulx&lЋ]ަt.O {mCq.ΰ?Mu5_~r=ac/:c=OKO/}3G7?C /*%QǴgq=̰MfK\?1r% !"CCƵn|~x/gF#k藡w`Ww`wWF5+߁ux. b\6 Dkdݮz:urGÙ2 tQOg߲JƗ,>yϘNc4C_^8z?RnrʶA{_!Chܷqkv6n7{s9wG9o%:/b pޯEw̆ hhM#s+˙ovQl{rk:,iNMcOpuo}xk#wWaxp@!ʘ_uW3S"cǏ~[l/]~X\D/>Rǎw\Ѿ1?Ҭ)Xλ9Ge6w#rq(ci8^̆;W 0٨!t)y vw'|drt75fTvo&uY~X>vXM}EGO+T7tVOx}px}W>/%Q||xigvWB,mE/Sڡ>e$s)"c$ۢ{ñWJ7u>Tr;sw$:N24pMuq{K ObRH>Ee֩ 1L^Ip_nL_t@39^zL6(nWqW`gl\9uU6[~Bسw,f#f@ *-|6ڭ#g^C.9_ְdIǩq4o[|E?u㷐K ah,UFN~j-*Ⲳ#֗]^yv=ezt-=6vT>Hgx,xBld'~ 7| uF v*Е/7ޔn?[A0hVVvRc|iOZq W)]}t7]1O [Gx,t:1XhɐNc,Ms΋spӁox_u}n$wdrwzK;",wxzvO~ܡ gmu)/ʧѧy~<ө *֢^{fEP,|o[?gS+֓lkQv.#?χ>NGdHr+>a}:h/ɇM"?1_Np ws"櫿mq(mL{5? fe[:4.k5gh-oqῊO2vg#EYn@1_6qš]y!Ztf_s9Ϋ+J7-vLhjb x^Nm/zzb۴|=߲'ONQ+D ]#ke !H(ALN.Lc7|b&9ٿ1N6dNn3Y0Ʒ/%Ouf wŃB_h=P|'+2'yM RC|,8h|~q2zF ?gE o8/i+8Y{7\z/sS_Ͻ'cgROtBB\;>$!wEϓ9z\^ eh ޖ?a=#e_u+Gܭٷv1f,'q4VwxtuC`]y#7L֬M0e P'%:E>~,[=2 0faS |ckpN7W,,64i$r̩Gߺ.cĚ 5V2YI .H5 9Od֖xI[vv?k[ WM#ă/&t'-*'.ә _;zld[KG| _oYmТH/Os_`+_9ͥK_&Aȵw:.;4F΁7kL/zIe/nc۠MA%+L2,3)lm3-[[G[ҜJ6l"yabWЃ:~|^=$>Q^˗w]?MGh.LNY 5߲]0]|ҡ̢{?b|Ԯq=;)>QηH61ZtkZ }u5K./'=^vt}]OFgy)wK|?l߶b=1_v2kFlrĭEAd apCm|S1kEUd˵)_mGzjku||#ϓxO|M/ jMbs K7ygϧ&7JT{s>c< +sXdm[k6^6[7o% .tLnS?|˗kkQ{E!{ Gz X|?vA٠女iWk9tY!шU|Noq);:Q?)ozυ G+"ow.S`nnvɜϹTmCcɃ ͟_z۸ yֶ1_rE{0VH;462lV.8/.tv|{ڇLjt7\jo?Vtv~/ vtR<dFxWx}}\wΞ6k[+ ʼe8#*3h/11Y2-3x 迏?wΞ$b<7{8czgc qeM3!Okt`]:~)1:# N^ [W5 J ~Az]u_v|meZ}罌t زiMi/wece{F~8^;l>!]<阠AK~qi?qE׋,ddpm,zJ>:?tR-O2l,8F ڻh幋zWjNg- !9]3-D!_گz|^ٟ"bԙVO>~ow}|Sd{8I@OnK~ dGk1:g"3>$ח^>}Ϭ'p/4m7O{>&C;x3DL#nx9{֍#~B~1F+< &+m=j?|NL;R8ִ4_PSz@G`ྀuȃwBƻs_PE] @;6ruJm8W.!9-}n)ef?Ce.ʬPVrRybl> _3 :hkJԘ}= w2^?3`X=LO^Fπ%X*({B,{_l }y.t[^!d8t.Wڸб@cڷia6[S%j<ްyiԏ)Cb\>"Oڧ%psoNs$lZ5c?oj1zQ葍 :\_-[LQ~t~gt:}y_O.st|S*Ƴ?3O3!\Ӻ-!_;U/yϥ`FsfAvwٙ-µz9w('FbcD5 H*& p1ilV&}&ΚuMGak5NVuOVs:.ʩ2z4ɜT-fҡesQ^L V2S\F}2yQҡM#kum>#^ suxcKf)۷}t5.htar%2tc ?sŹ2HU\?oHq5V՞OH?ȉk@۔ ظȓ|\g4A nXٺ"k}Mϡ4| ~pTy? %8qvXFU8)-|?y*H4tQ7_6/^ċJgws%ބG鯃ZmS1cс.'bq1~@t?p%ZZ' qߝCYКN7ڏ`~#?^Mi Y/7Y#afHVq_T tTfit^-.CF1%2rb_je-.#Ц Jl9'\Cй"K|ω֨{ ?pQ\:֜|X ̗U\}&ةsZC{K;2/k{ɷ:lrܻ!4]7tK|oĨKF5&%ON^ ] ts~W I\/D|U1LOA*p}lL3M6#q`2Arf`5zn}nl\틮n:~jߎun6qn?m9!X㲓\#}v)<73ef/^|h;6212Nn랭b]$o|5SCgpA1z,6U1:1=5?埿S}a]0{߼=A\DgC[Y3K~8];uN4:;$|_1P߬=zf/Ő˛kX?6ķωg-v|wx.PYvw;(oh'vƄ/m*isש=^]rڥU޷v'瓱zYOv9v2y#^^wb95[;JxY.` 0{7F|yÞlQXדt8FǼfוܶ3߇n^Z!2gN~\ֶΔ1ހs;/z8غ|w$oS`m߶ް/ÍQgב|m)oĺJ FL6(<>{7x];[eteKGOx6^)H<1,Z@X{#p1| N? vKwtz QsMwyS-ߐYȫo<\>wx!(v{!LyEw%q`ss|u:2 BW ڋ[F.@a2`dֲrgjis6]BEχ=DoƂlbo8x/ !d7Mj}% iF^ .ϟg-CoV~.C7O)G,^eoem%<eH:w^F=γ#ANb$WܣvKǏ3M;:nUW3dL{fo(g!#_Zϰ#-9Avf0T1\|]Kc֕kͷVG`sW >Q^[bسщ`Ű=*M^c v[X?x+p5m i n6uF(ƈڔoNS^-Ӟ t}9ǕR|ƗIw\˧ ֽ}{|:uio` Z49)(GiOsԗNUiw*Hy[dp46fBͻGx3ڐ/>ڿNu&olvI}ӵ24Edo#1KaƧqO}u7 u2}uS~]mtVS;:C}ۦ?v}ҷ/7]ԗ 1Z^gbkgFczzm(% :{7A߁~n86>GvUsg&k;8@)ts=oSo_~t,t];A? x: ؚs6y;-'g\{IOr9(C[b 9)wXHUnML2$țulbRѾ yq \`oI6%}H-d8klѯZvσ́=/FW{<.rv;{=))|'xP~3=/H4K wm>a#:WZ٩uS[q}c~]o# אLa_<9ސl+|,5.xcu׾N2",AW7-×i'؂Ƣkɞg-zײ\yYRd_-?cc1YX#΂\+~ #MI)XBl|Ί"V(zctL%}\گt_3pX3!(m[0zP^yp?~Ul)'!߫2r: t)FF?+K^^ac ހ.V9ͿY\ѧ>r_Io_HXO]]Lx?mS: pEkRL sNBWW1j#;)Αo_༠dCx1#[uW /r ifQ;u-D܏usẂ#n\Qb`|x[/p_C=7R1ƅo/ 5|OIK/lDeهmϯ>la@ܡwZ<ѣ<+.6edYƻ$K;X{>IQvxuWD@|Ǹ2]~x,K9u*c 6Vq {<t ޞbawh ;v[ GW`xZy?o ]ZtN߱FXH'@7:{!cWB5s71@ORa"ms$I]oZqq>+qyM zi5x{} [ߔ&og7d DVClm$?o'[< ѵtT*7Ph z:`V߿'V_7%m1RѢ/ d9i}*WC?QXuLYƺ=']{l6}\^sڋj[v e,pm%ܳ^dwjy_6n)>!+'X:|k/SmGY+F>uc9 cZ=2K{ӮS2U-Ћ?m^_ {i?ꐇ>\=P(6^ט^,һF`g@bP b{w3=ϙ+J^]_\io6Ψ .{7]6%:G@W,HC!M2kߘ>fgūAGki#}>O66GT> ;++9|I玮^/T7pCGK&kݮ)bYþni(?/?]}K7S\>ھ-\iWgy7t+ڳu&b u巌/eCjZ+s6uhNmSl<pF@ %٢iNG?خ ujj/~WNrcź?\~dž%;F} O=c;Ʒa^Ʈ{/ o~R?߲6|gNp~kᏢ]USS[=mHq\l*Oׁ>*'O1 vJ:e A]qӥOϩKgsQ&K!?/2[ԧcU@:.T'#q.㴋?W5 xmbp[߃11d[ ̄Zq]LMzCG)<6ocC3a X:O^=棛: AF!퍰5.aFki6=Z;~Ȫ޾MQo6yt۸Cm&m|^ |2 7O,Ho^>=/9o|;corw}YX 7/ݴs&Ps^|nC?rF*y=~mzou.:aU>d;=E}[f z gx[ҡ] 6F`g3x2f.lmOMgXkcOF·`c\'Cd*2 2ž(?s)9 F؛--lAGD[_uh4ʷa#AfA ':Vz!(llRe]V <^pk?#"3Lq5KNeOݾCrgirjq-p0>&Gx: yIkibkI{?'rk:tKښQc.Q7 OƸ@0Q2+c>|qu:a7ӆcoWKB{Fc;AeW4~g`.:wK'O]=X)M1M1_(]MEA ]bEY({LAY-/e9^.v^lÃbem6#*~ <1|ziopY^W{⺨/]NA/ oNBݽ M' 0ZC?uǾ`f nS5V:m]w爫cg8 ٩͎l_itD2A| h {;thXecݡ?uw\؀87=G;?9ix]S}ICU+?<{ۑW˻1l }1 ׃CgLCeSp)hz A>m,,+tzpX7倝)-tm51r@U(Y_lo N 4o잽}nk_}k.WYmLVx-xKqLO4 zbMiAg)0#!@&{#7kcK$:^t67uJj.ozBV珼?3~{O1 Iqq wVaN?ǹ5Mbۂf Nl*rFڃl_WIÊ];ɇʞ[#pZGS`wN+ocNZ} CGMƶfHԞY+{3?wnF uiG:j48??u|\ϑ8{jL-t2wY]Gc;k9d |y^vi}>_>mvKuD{X8x>%5 ]߄X?ACoׯޠƹ]ۑA t;w큖\|ms=A#k-D/#^n^s*\wE> ;vk8l|5FėBi~.n6>Zg5) ^9{15|yЄًz:n5{K:?`Zg FCƸf!I6Z&촹ݵCmlk6nǴwn{1vEp\S @ٍ#M!7ǽ$R OjߎeMd=g&6oX}p<ӦsEy*N4H G*fU}aO|>K_&q߅O5?ve٧=*ѓ v dë'=G,<}Qo=x<"ՔF3ZD '`#53CRģ8YvBa|FkZrTc[Ӥ<߸K)&#/pdB9J^FL2w+0`&O]=p|[|=?N!52*jrYh*< _|{i2 SLCn${qM {й.cۛo-cө~'%/+a|,]1 Q7c^XO QGOy';lh xS?+}Bф0>k9@{|M?r\)Dt:i71CtxIoc_fϗsu^yMub</Υ_K}y>y߉y!xnPW>:JNpN_GSO..|V#Am=7,]kϊwql{.֞AJbEF>G2VSyX4x_J5334~o vf?LJSIA6m-hC#ʭyz9أ%PGFtfϚΣgu> (ЭN_=Z.?Va>NÃ+u6چMЫO/W<6ٱ E'cLɜϿ5_~k?ӲsC.m82 O# @lEإVl770hc%=TdnM28s5K @ K%s>BgiMS9 p[~pZ873.]nbjI ]g4= m]~+~_Fd]{'i|g-=x|XlxVS A+mH?1;pWs8c'A61^)}n9Ȟ/]Y=Sť3XJ։4z \1kA=]F*]Mu6&5C⎃ N>U~|_ҡ/@k2ȷCzY|'g {B:h۞cMK_"b"=9M}ǀ֊Sew#/tGGϙӥׄf{iw{M~f3K"%+ /B.#,mᆭcA_c|B_,XRG;MQc~Nn>inRek }|iMÇ5,&]O6u󻼯3xh'ym^_l0ҹek ]wWvˏK.34Fk_" MtF'BO}+3(ܭAq*䭫DX~7Y8+>O\g=qsꁃ#n Oر58 .j0yP,NH5~ˬup qLrO>#ive׎seki*; 6t./Z1M|o췝҆ĴizyŃw[=C[xC^].ڏ~(>;\Myp\P @fgE)*gnj59}VY_mwˢ=5C6#[o2·dqX}Zk nܮvmj.p.]k4J; 0yI>myve6LlG:Ã<.6I`}PwWǙˊ> |gAwvT)Oѯ錾v#e6.Z胿f;|Vk{t-zϬ,~ AwobS#<ń  4ߎpD϶$ES`oK2KB:>foI7~7WFcBW1+&|;oHun2>_!מ v |ȶJŭər4ྱo;s˰-akt>S}ca~c]kh߷4rvBv|ɤu5%7nJ1.ɏB|,m>86{I?;!`ؗ.J>駼7>6e4ҧ3|6jm|-I kMijQzysA?/׾%Ù؂d1cl/F7<>ď+N`Q|< M,ΡVQ%&(2o׮oZG`xzQ1ܒAEg,d^=+gP&sX ?yѾ"nW;ӪGtWfG1pDDd]I`;-/g|V{wsxWr;kȿL/Ee>\]wf|^cˢMvtWߦ/yEZL@5oeVpV[ m=yw=s';'㇤︥)m΂ BgwyV'Gz\ ^Gغ"}a Π)1k,}j+o}33^~\Ͻ|pG~[XTq ye㟧^~|vzrcx#l󳱏{h3iq8oľ\\׵JF0=/1򾥼_{7>fSZclm[NgS[sדgsyJVd bڤښ.lQ:짍kf҅g!'owf_'r['Hb=c NHkBG3Ҟ %XMiUʃ?jE☁#Y9 tQї-HuZZ/ YSYӳ_ڪ Extv}=/\M9 ~CONW2;cX/֭o~r;m==4ϓUL9k8ϲ}/CGxf:.?y"1Q /ޔjmHGtsw{. Wh˚Gq}mIßR:8쵗;)v=#yA3si}m\֛}}ob3s'5?uYwƆM|/ʗobb mXPoz7o:-/==c_<}5z vd,F: Y}^kN:wX; p{WMߗ"盺]ɏ@u3V Ec|>i4owB1cc3Wߞ&Y R+%ȇV7ScUM ݁O^׍{l{>ddp=]lTS.)s9Q>!Т͢nn;!}Ǹp ΂G?1~lxGyhޗ ׀*TXߵBDw;FORqlY n{k?W=_>wRYo?9ǧOƧW5>E_j|ڟTb/?nl }~W "~o8O~jgRo~^>Z+Oosp3ۯ߁K]M8+UW5>E?OG&73Q/xڄ౏6 _,;kA]sjp?l x>%M<BX٠8}ڣҦ.b':m^d+ֈ!~bO|_?W=;gp?_Ň'Ibc=صo5kK?ߔnE} ɗs)# nw'm?DV^gpvݷ~>4cy=z޸~[en/a݃bއmTM.ȧi?ȷ m=_|9Gᝠ=jsU|FRG={x(K9cz̓lm99ؼn;ܩI?Rܪ =vt%g4X_kϩw%3ǀcGwJ^F.ͷ}+=y]p =̙Fu~= ~-\GeHs35dA=g?tG{=79 fԡ${֒WteNk= IǻJpGO|Yoq ·O0W2bZqpbp]ߎau2eoĭ=7a ?<~7aߚ2.b6'}7Yt{n8'-\KVgѐ}Y+BN7%b6 1 ۯWpx:{oN9X㡉+ě?T1dFo=&q϶]׃$kGq~\X08sٞ )|2t_L0Gw3] _q3tOER֦ѯ^.j0)&)|sҥ(iRŵos4ތ.>\wftXl8IogߓX=JrOg^>ߞF.~wOſ1Q_=-~ʓv[O}SN[2jwv)oACW36'o\vD6&Gm^?O>`ީW^)\EWkmSw֞+%ߥ_] G%Ssiʟ̥M//3#|b.E}AT聍Ϙލ]N>bƣ?fmz{FiIGЫ._y8sG8t3͌n7_ʌsֻk7G5w5^WlsҌ#ȾB O: >4\뉻Qxa=%U-rpͭ\&m/e={R'G=atkqw`1~֮t؟fav5o ӭH9j\]{؋=ryGI7vhSD؅l9n"4 VG>T_>|=hБN~;\;r72g|2Zv'm;smڥ|׮ȇZ׈BnVv_skkyxo-_qYqeFxw_\kȵyAU\ Zs0ugeG660薭#9%aˀkp41&,6Vb»k{ҽ=u }J6_F7l4mD煜hTeEatfw.~u7ò+sǸ.{#.c+K^nKu߽ ?sl$:m] " ϠB<37Do E[*:|ͦQ[M .+#>835]xdz:aA>J jŏlԷ?K)L mV}&y.kpݰ6Cuֵu8Wnκ}}qE|'k|n|ɬ3mer`Vbc{r3@@{L.C1-=1Z?oO/>+hW3ڮ8Om6 n3b'@n[n .WA+OѝJv+l1< 1=uf;]v/u'=~C˨oAw}w}%}FO.FV?x !/k_N+e L<:{˃ )&/vxN#y-Ћs#x :=g|C/ ,0iƊ66VC_Ȃ$݅ ?_R155^E!tW}c;ġ%ȥeb vYyU~=)ϯ-Uߴ<8xCQ/|񃛕TOeu-O.*wrl ++)tVg/2%/`(rKe: >AqP; otIRjlfjkSnC#DZ x֘6\05Fg1C8N]ҏ|ϓW`Ug&0 zWw|Zn({ ї ^: ݞtMy"pg)Ii8jZ:3/AMu!ߘ/E\:cљ1[E `a\^&>U=^^5wN+O^c?B~X0^{*ah؆͛#÷=%~phx2g4= A⛱kY'Er|/~c4mG6: 6Z>26+Z(AW}l|ǂ*`o|u6|L/k u/zu-+M0/=ȿSkʞ#yW>dI6>ѹE,Ϟ>)?3C.Л@wx} gJ[_mk~yh }<<4}yel΍r'w7ϊ)$$'t]9vIqmi=+4#יC/s`VvWgpyS;Kҳv O,#ms1_Nӏu۳Lv+/d+ nsJk4\:ߎʙ 0Ǹ/#twj/PzjWx dOڨmdzԍxنdlώ}>巺` 㷄1V-k[92gU9:u2usgkak@0Wyn0Yc/~7w̃9|A&^ͱƓGCc))fa?ז7K{;'6iVp;(΅ni4K$m<eM :7V3lպF6;UUˡXnBS%y佐K\(dϵ5Amn71;˟~A'7cn<$M~q݈'@&u:bWgó~Ƈ|D|h$ ?SBG>4q4G~72FYw^I_u -1٬)';1Nw\P+?{_`$Y8>_k9U}ȧlOx|Boxma2-{ϩb#|4ӌc㚈i/LVo"܏J+HzzQPG/&c$~-μu˫%FGS}ݴ> -)uS9'"ME:l:f]l!\cJp_oʍ>\#Ώ/1&ˡ7}~oŸsbK{OXlB16v~]6n8}skxx4uL6:A!Y1Oey'$oJgsq?I4|ɯ"M9+b;\xz^êP 4_w"V䗽_eN8<13ɖ`'pOzZ~M톳="2>~".<9 ߢC1+_Fko 2{$ lh:'5x~YYzVMvc7CIS`27Blvo0% [İt(Y|q?$}Oσ~ "sa'?ZWM#<̇MuߥͷjlXCg?/:'6cc \1){K# 5:~O@[>2'tnRP<v%)-.ڭFQ;ߋD2|IͲ1R\͒dcr8p~gC0~ٞMW||2"Ot6ا6)PpAEg >}dw]cj`z3g'©xp!~6giKCOmY<̔tQGH+y[aZg4L `+-͌_4] ?V/L\b_¯ə$a{+2v9vmϓhY9@p}'@+CO<3~NObxZ񓌇{?Sq5:=|/Vu q<~ MEw>2ޑ_@f;>ƮW؞Y<ϾngFe&ާ{ac7-=oͻmyhԒ'W?25o䲄 e{·dr 2c^~/V>Wl0Vʸ"KZy]"KZtoA6}MsϿ}ƾ&6:=}~ݭlRPD @ɷt;UeeXV7XU햕-,-9]x37 =\V^8ͯ|?c&2~g#*csbȗ //:{PKǺ~ D^ K"$x=xwUKbeӱYAa?HOA0=HO/_295ţVLvp݃~_`kFq?'{Z>`B7̼M_e{_ 5^lLo] (q֊4C7-)󽓥ظw(9aӊp|'\G)uN?$} ~7vMDz 7-C|Ygv0iO[mb?pmt8k6?> 6~ҙK 8?|^y6w0xE}_3_{ EK|yB{:gautx֖4zY_ [kw^S_q~ δ8e7?Y9k{2C*eϺ7ޟ<8Co')~:O OYgZgV;5Ű ~5~5_s"EMP,of<]6r)k;V| /[yrd,xܪWzDtC1ck}vbߗK\^_ \j8R` NVl\6飍.#m/%pߣ+urpe7e_Q~@{uX ^e ;44Cc{3W<(5e&ٓ5c2l;f2=lp߫s%# V=2C0~zC7d;Z_p.(q};?qD![5-~|v}at^TCwp@|SCuXOw̤7vC6sd΃/Y7^ : _Hi?C~~T!9X ~:~+.|?|%6ފ|F_`8^AwjaLh|~! 1ށ}هv;!q n6FOOI ~.Cׯ׏JK4^`2/Ç*VpsxO&([e>(WϢ; u}(oۄoI?p}87%w?2jp[O+4H}@~bm(>lw|Zr:㻏}Sm}_kOYq_#|<:{u^ce}n:/?wuf[~W.:ϾۥMKn ;ƔCao@ y-&W6[yx0@#3]?`2LK|r޺OQnuCM ~щvAl)&*´CrG\n.}|;{f <6dxZټmtz*'^@r'd;gFbsן\ܦ󔾴:;خ/=P1V>&sA@C1!\I|qW7 1]T^m£"؏m:^!o|smm,5sYWotK~.a1&Myo\sp8- LՐMK x+׭WG1Q?W06>5u`h=ópטl+:-XV[!ek?'FW8%5y`p;.F΢LD-痝ǫvL=㽈Iy1l1LJuP+_|v)ҏJuwe." ?"C O=L W 6zqY;,şad/GK ý %F(=Aal?a9Sk[- vqòm'6KyK\0)vݺG{ki: % #p<#gxAb04`kb˚ '?\hn[/ؤ(z֣] ծ;w\%O,L:cj{_q!Oqj5W4{l}qE: &Z!||:af'Xw5 m읺yёh.\x$β$|:󱠻.%`D*Mh bt;l{Qb:3 ĭȊaxOx |N6Wrړ*:RHh9>!eG -wn/c +{p|?]o{?=7W9_/ǯgjpw=h/.5^m >gΧ8Wfk~Hi2)yel]/栻C1B/?ts<ǀ{l;er_Gϡiń2|"~KAШc~0oZߊf:Q. Bg;눶zWR|rdVblzǘ]?|uУd&O$F)+6z8x1qmA(DZ +`;|gˋ\ʚ2xe$uclGK?7 xlzdtT{|GR: u>{{A;Gεvƺvի '`\߇k2C KK Ws7`ru蝑r>h7moxxxSbulŻt),~Y:nx+5kǧ5{Kl_?xIV+1|AY{{DoRbKSrxG[9U:g~'݉a{$Kؠo}3F<̂A;}gt3+YdR/?WdeF_8—M䫴뢉|Ë pkXm} @;fj/#N}HϾwg>fiϫ/  ZIcĶ:k|{1i_9>s8E{.eͺ+Ox'vqgse _ғOWeRj6ry5[طR6 qɜS6\#qb\GSyP#p|.i_s(2t> 9-X|jV莉0vDOx{ŮK˘o"; `^曾Elm'2Oz/-c|ҥ=]+ϵR{ͫ'kGτi~f8IѧwY%seyM<e AwEw%ەp¾}Pg yL 8?k?sQqc{!3#n&w BrG~[,x,u]cY/5sˌ5삯^e~n+f(T!Fh'<1:xu_ F*l|L`ІW~J֎Szㅱ֕?nb+3\] [gƿ%%[,y+?t pv۷׌ui3~'1c~(8tӱ?A~@^#B,7Z%&H[.h[{nSg춖d[Bh7>-?mtKdq_{oeسa2zr5({B.}[}Rd.e7 \r }FCWpپ3_ ;DnNmWűxkzAnO]ˋi݋BFs+ayq5?~ڞFs#;ۖůg2kg8u39}:3. e_\ψ܋>`lHO^A1?~׻&?B_x8Ad8p1/Dd(Ţ(_۬-n`lI?#:6WZSR )Aw` CֶeoyН ~^ءWSC665_ȟom-^ ^84 <u?c$MߵbW[ 尸X[Q|V]{<.5[߹W7w`OS'tPGWaC֏GSjMSch;_tA+[ a"6/p3>'摨c@š6M =ڿ35t&m_:4b>ם@cS|}+C'=QOc_fl:LhY;ˆ:zڅ-ѵQugQHW}P `J!>j/<,_Gvg|e-SUڭlYMB G 9ioy伸ѝ_ j|Ǧk^HnukKGK@ph|fk>A_¯7ю!WVWܮ N}tbCWF\R֬#?BbUNV]ٞ|jh\z!g el.8ߋυl 1-\^-xpzr΋Amౡ5謮4`4w~{ı~1ާc|8|#g|jFio:>K ΃C?ll]70/gq9L 8?#sӎg-=fG7)q]|qU1G6Y u)8=[;Es3zXGy?gupݹ6QlDR6l `2>V+OS xr8%/ՙzN muz0ৌoǃ?7Lob5^ŎgwJ/I?P#NmfWgB&<cwu bAj' ԥ-_vQU}љ.ӫ|.t)ק,{oGR.R[rb?hv n. s*[q>c}mJț\u#]v?EAӌ`xb[?>eu)C_f8 >e\+O~m1}ϝm:~QCK=ކV$[W%0c׫| -2.x=DE><>Xh3:hz=Odn__esYVZ;N{n-1,)r2S>'wjtn4hk6A{a6Tg .+9׿:8e|:.2ȀD 59(ାRh~sq͚Λח!_8$}78dot/;gJ;|٨78&_voO;?uM+tϤ"/mhQ$oro8o|2lf}N+ՂMW(?#?>fp"'k)߫iy;_ONU|ÆFs3f0Č@^ ߳R\ugsbӖlx `@cO<51zq_R\zN[#utREٷlُ[sA㭇L>\+ NU3v}[6{p0[q_KwgFGj!pIfc9X?{N~1g>(m.WB0zla߰RwI}^x|'49L>q߽߭=>9@ѱ^ vm$mk+{Dd|M2(Gº@ֺ!~yt$tvh$!ˆebd%'M=s{΋gg<{p6gtc39mc}ZBDZp~ z瓹 ixכAM||gKVx߸, _t` gkYgKO.P)#8Nnz3_qe Gx}lQ.=3wv W.n|C?5/CNwc'BΡ\ϐް'mH _7=q'g><lopߐq8bOSXj}~,zIVGѴ :brz7p|t^dgol ㌎ sm,Y卟G ȝ)vm]FY9YPwf.m5vH6yn qeOgi[7 ?^>.Y7}flm6=Vq/Mc -ry1{[\еAX]!8dLvsҺpyj8f"(5O1c9ouIMٿ$fZQQwZ?٣'i"2!|w9~#'`K}F>)Z$#_v%|V }wd oN xkǃЂfG oJ?Q>֑okA}'~3< z#aX }y'<ѾT"1l~׿J'a8_2 +z[m!Lc[_}N8l.\mj:>ݭeq}Ѿ0{7 oCk_;]:Mzn'lY?)N M_CwQF=K9|j3qܖguF87dgd!~d^A<8rοE6igGߟpc t)> |6K\S >ÖOsiY o Dg1]+mݏ7,_F̍w y{lJtNc'i%^;G;"YY_^v}1#'y>W\d#ֽb@D:xEq_z=-=jwT"}g2|=߇Egft٩gd yg.l\xQC'm ?sj;>.|ZnmϗwϓX/Uٞ/4}~}ˮQCg?IXQo̦\f<&?QYs\#>np6U.>gU{5H[#=F[q ?g[RcY˸N C4(V3;6VGZ)bJux_:ŜRނ%yŲTwV<+PIr75zm} :?tDt9yG|F o|Q쳚ݸg69 */ÑM';=)1L?~jS]]=\]_e~ <5K4:Р9 ~,}^Rk+>VEt5<öZ&DbLPQxR>]cyPO |WXJ?>tzwyzü6wCثK|ӬrA6g w\+z6?Yu|`r6@KV-?rjs =Źo;|xA|qn˰ zq:w+_!hCyYV"|Rb>?߿=_m|=M3dكqC҄)!'+R q(XOit*ܭ)};Þ'^{OIu([-r op#˗jL+.2۵}gjoT˓iىl>z h9JOtݾg—[io]gjR5 oFRtkKzO񽯆8/ugbڭ;κ5Vqap࿃W|>RY~mBGWȾY~UmoR^OZU6;^@*{!uCSQS:{)Gڗ~F{\?'? r.qQl=䏰j2h-z7CCv9MY&tWdZ:Cn }U\2oӯ;8?ykM0F8|%14Ne+_0{$4coeݞֽ`إq";}KWFOb8Y1&p;M&9V|ϋk-py㺗\_̟zU tiN!tpp&ybt' tG1m6{u5{M8e=vw ć1-41$\7[鷑u19̕=ࢭI|>ҿTԓPF'sGœOqk,{y`kgL ^-?zņ6V]=okߗ:z$Ytqtg5}"ʆ#G=_碀GOkMl`7@. =mK` r[?[imNϭn31Y.Fa^^lG˓NVrWEOc.:|W6i mN:&3rVջMRf!1r`.wZ#=9x{"Hvnv;Sp5S]EQ旞8F茷W_zF}^{a$FC6exC{ܝ*V+/ӽ<uJ8<=9^=DNnߏߧ^lO|գ]&]o~rhc5ӵ+wI|]㾲}L=^p: z{IK_ Wp#`Y_>yy \||D'J.ł>(6=7ʏ}ӿ1ڛ=Mw!>{-3Kpw!GϓuN[rL̠Whם!%#->S>'ȆҹOV>V#FkЯ 7gd1/I'\d{Zqt7lq~x-nt1m 1cxfh dRחW#1Wvwo?R啽H{ByY='4~#i_pRǤ[t&k>ѫװbװ4]9M~oSpMJv 㹝yM]?ozkUEɟomm*Vs ?Y/xl#ɟ/>+/MN359=~1İ(֖f{yyċGNzg:YCvw~x]tWC3sOm՞i[ zo?ϱ8{[EneU?t7Z0v}9(~#2[=V}3d6f>`&ctC?{V_w- ogź8YK1]6 #~)}'g_AKanpaC{=_RlUmMW`i>|"CSq3Oz&9/ǵ}X/"//t 2E)C?$`1#y!5w~dKNonF-VXʆ~G8׃d.7ve:}⬏c 5zkێcb9|hcX9w`;(D~^ LV Iz=ȎPëe7kɦ齎ce3gg;o  |AGX,o3);gxcż;:iv٬=` gh̪EbV-?'SWIS3Nt'=~Y!8 L#z .FwKll?}fzĆ w+d + t117|km~9*+K&\3tI.*jxM|[#QVu+Vm>LP,5YxdcSf#L.צ[cyrxGu4B=HѸ^Pzc0:Ǒ{yF9BW:×yyl?~e.sF}cǾkfOy]~6.qc8#]=Gn=5Ug"k71|Cť#>.Wrz$TrQ!}Np'xp3OowxY<\ޑ<ل軰 NLl;9 "E3 KiZf}\AwO>/'~-)""s鼌|sd110gy}6l8Uǽ>;<=1wlӽOE#}+ixXOƓuϴKi|{bk@v\Z:ϴGD\g#xA:쯞NoKC>~Yu+;6Zh兴Ŀ< :i<%%5ʒ^>Nd^鎳sOLvxxL]ߧPxZeyEyGhk3b'4y\=,;"[~Խ4:Nvqvb>tSi.Ws:'7};<th{ L93Q1ll>\~t _|CY>yp: ,|+ -@wk4\<M 9 \\Xp:o;jOLs;+90 9)돱Um9>V.Ӯl] h ~*6q8^.=Woi|][>t@v$=1GW.N*'tYiÏA~l*N/g_!x}:Nfk:FL:l έp)4[>;[7&7"6t&.?&zkkvhq]cF_`t@1vq:uþ?T<q3'_'G=B\3?d0:4~H}IoCEVѹߚcr(LlWz33ϚǷ1ys8GoOāEJTCÉ-.[{ߛ~!u=;ϚܞSybs[zB|`ͷ^KMk/ϷrN=~z}i|L,6xIJ_srzߧgO?ى:. ~b2[q%JKOg.7PCb=ˌ7:7 0GU:v0kd;ӝ%NtƞP/GgY=O2Ji1>e Z)kXvic>XZu.g=ZE_O8d㷡Zk&rd[_]G۳vo_g}?}gIGϤXn_1ge?gF%8LX#mͬƮ-ܻ{J/ϷҊu?ACG" (֠)/>0t XKM_qx+@]!S 򛮄NwKE8$ȶՖfN)u:鉾nX{GwF`Kazϻk{qO }[H_*ʛ$[`ldmioѾQA\adK\ZKG  Y|3M:7MƐGkk)M)5?m1e0*Ǡg>dϻ@bBuۦe%{I7?ݼt5~c͜`3Yi{U}OL9v#l]ۻ?73⺷ VnGm0SZDvV{`mo/۩N:g\mI?+NU:=1{h7>L1#X:sG'Dl ~?בWEWO~cp j@:D`G܁8Vwy{ޯg?)1G[߯\+/ݞ4\Zxt6za=n/JW>z$l&8o(Y?`qWhȌ<츃u_}IN?ek^= dH|z}{%e"S <+M<זG5y/hݕ 0Y.[=zڮy{Ql<8Y\#hAAZ]ݬ({A.1/ڥ;W_xUgݲo[{xO췆b2IRXo<.ayH_ )?QfESwF<Չ5#nz{ߌe[f Q0:_S F ^cRpyf2ł,?{5Hք-moI_HWM ^Ͳh [Y'|9WVI^?U~#K?Yzm>6d`˃CW{E-{b|;>A5> .i-7 q/tLj+Cs#H{ݙ~H6V;3^}:c%H݂출yǣf[_҇Aλ&8NCfz7Lp/UdOCfCat)Îh\x /pOl|t:rn+-{K>vxJuf>Nkl겄:(n36Cht+_}}>MdKuM1"^6w͔ea[>o':i 8 ,D:!{y]^>GWڹ(WrW:Ua}$`F]sO St6;gS;/)^u܇\`"kO͜6S}p_:kR;'u;=צxƾwyU<>񝘿t;춶϶Fݕ=yrw&ٸfAmt]mk9y=_yiN+4k\_9spFgi e>]g% d7d߲CΕjA1e4|:)ry6>]g ?+~7xFﵞqtjQCҞWB{Uz ?l)7`kkI1ɌP_$dr\kz>PO8M[Vfά-ʆ[k-><{~{o6.07G[4Wf -s7E1 S[^w ;ǩ#JoOx 5tNNAgP#6C1p?;yt }?Vލ˥[=>wխ_HЙEzyOI{zE+_cl֮b{ioC賍ן]B/>᬴x{GO;/LSq|(w1XS5(^QVهnP~~pY8#Sݑ=X\%aޏW fݲu]{ݎne}k]Ƨ<7>ў':Tȣx?WNãwtНBSd[+J*z>\zYO -/ՌA^z1o>d2 bGOž*+duT,Xi·Bmڐ?4 ~ nk%oo>1sfG?Q6oFv9_+ ^/m.eKv)5"nwXxt-?.lֳL7g0E }>LV'IR#GO :3'b_8cdY;+V=!_w+;oٸ=z.mk|nmd=c; ֙t=b5}&}[x|ƅdֶ|cgZVj>p2Sogٺf1cl.N\/H<x|[SWǂ`yǿzW_E|X&k(jX? K~g٭-\-zޖri]Dۢ|)2 eo+8Ϭ3{?יoÑ}b% \KaߨDW.=6 e_2:CLO]8i0.bX%Z:KݔuAgR%W}?~:ԍGFx~ʿ?aC6mu.Mo[>:3_{Jէrepv k ɍ'F)ѓq g9+ne/WqN wi]ʺի(fuQs Ꮟ=Gs?T^An|Y$Y!Uz.~?K_/[,Av N) OҶVqX pxc|gђ6k|Qw~{@Yw. ܳn#j0GE8Od䣐QYM2(v<՚fanظߺQ~|g:$;w8CNxPӦn\ו?v|̹x,u8GVwDM"4e +K򁗏{mk2l >L6DNogJg-!?BZ5, nRF"3#~}tjQ6e no>[!$WFT>-zt5pqXW]i4zu?7ywck_ 3b>oC|  #C{^FG[Ϝb75D7)[KR֬.e v`zohQQ/Y%P,e)6Agd#\\Bކ3kxjtclIm&)=_U6ƃ1̓Ȃ#ih<6gF3SYJe bZ'kxb'r&9cNԍ‡{ݑa,~.]uѭ.v>Oı9~Wm},<-g[ȑ}?lGOJ`꯯>s`OizlVZ[I} *?S^^zeK>D:[6R; b+W@8qLj'={N )V1|񸺻{cA( 5.xG$wS3}V!^d}SJi =F1kytFm-s+59t o< 1rCff=+b87];o}?loD`2|#Y̠~Tz2[+YT}Mz\Ev叏;U_8iuf86}W'LĿ'ܴ6)y/k]LxS>*3u3 c߫.U33 -z'hIS!/?UW|v!d-m΂7/w bgx!df([:7i [Ϻ?"W&j>O_ѹLeGMit".o&3^·^{|wc[r{ 9{t~ W=2tn9Ѝ~EN[Qx!3:u=Ѓol=:_wաuJtgogS_~CwJBzVݣ3[н5G?K|Y~]ޑ+--=j;8-/Nr mf'XK`T3k"ƆL/ g/>=Lﳶ#yd{b޶ =D}?Th6xp ˻Wm*`Xo+ Q?Rw:%#ulu&XKv󔲋:Hxn\KX$o<t\3.|w)v<-G"BB:A8l>sd+@t\E9Y1;xZh;~{Ð3+EFgцok(gm!3}}uԧ\F _l]$6GlJp{.A=`q11f#\:4dٍ_z:i!ktvEWݻVv/vcj$rcݳ~_w|gg}5_͘ںjk}b'>̌|١wEֳz ىŊlҞb PCV>~=dz+hz->zӝ6Oo אo.ɥs0Ѓ^l+D 3o?qށEf1n_uCsLNyc`2nQ5{>UdmM1SWbV&8wwtK:Ufr̡0wT7ܶ0WRrl ?+]4<1ߕ?cc˶+Mt|B4f}-poAwۛ?Ѿ߂PŊڬu>}Ͷ}988~z&XAg]6?,bc!dȔG]G᳆U%3|!/ _C~_g~G^.)/KϪ.+˯j<>-WAWvfq}C?Zqס|59`?x(y]+F*KVe6n0wZA k@~IQ[KΦzsYgC;ocͰ~kNi{_:Sd ,iX[vU4ۑtn>U!HoUޗQQá}H[sSG96W햹ۚmy89M[#ce|F$tՊ2c]v=j/9Ͼbw/micSߓ]Q]BCF-O ignu:|tѣf/\Xv[(o _Oqxg&w]o?*|:4t/|/ksy_}Cg& <(;e|u. ~Š&Ceࠃg!G}v=,߈]ŕ/4nVjG읩ɧɽqtʲp drs}[н3{nekK]!|-Feۣ.e'v);K=gxhg!>t_OX̱aűٿ9 owOm]/#}:H߫)6oIg JxSv>V2Q5_\l=+ޡsdPunFуyE_jtfpN0;\rzwam;Ŏw(xϷ;H== :Cqsh8K\0p}YT ڵ3}:1w`ߠ&@>ݢь!8K}7#_O$ I,| 9ab ?* 㯸 ,1MD5<}?Β6CӃ%6ѓ? _Ƀ59,k‚7+==>8`/NJ2Ť9;Koz;j=;¢;Too, Nmy8t zj /k9ӳwgGX~4P6[[r=SS:-'+پ{=?tΨfkvH;#}^, 1|.CSG;83c/yۻ7rb:<7tv[:&>5hac[@a״3̳:P셯qW3<㕲X˚2h}Kf< z숧i-s.;'}Az ɑYwJY7ݣDvdm= 90Xwgk:7ο*uWCbh<{[lDZ38};䫍a&[ٺ3rhf~Xqo|iSWb|dܳDr设qtOqLDXWx;HBh <)tg}'| IbԻ'7#k3_\ޖ%yNȚ6^%96eEW`4z6V~a KDa`>QH,o;ɻ5Gt0Ǹ> 4ӂX~+~y1/).nt*?{yg]ܥ[\M~"~ߝ]QvGcu8'E9KyG@㌗&G `9ύA39>ꢻ*Ka\7E+-ۤկ%; |vr~̧^D㗉e!_bKHŞ3&&?F Ndnt{'-]_oad~|i_VK'YFtN^v<4'GU_2kAyȑ˕#yY`\91oB 4-~v+ǮzrVɮmw; )ppt9O"{8ۏEf6YOwGvwWS> ՑOuΉAct(ȗoZǥ,YzWדRUjy{{C G!  0oaJ)i]kVsa g<2W ?Plp9p8&5 [?t!7"磟-Y6祡uItoޔ%}4^Z6\:~?tYKiݯ˫#V}, j :tL٧,>X.lC3Á|_ġ@mL nF =VzgUo$ AVN1mߕ>_{#&73{z /rp 3T YoxdF xulM 2Njwv?О"zB{C뙘ˊ遞o6l.7pU13i1# ee,+8&bxa|em_&M,\:]K#;1 4v!@:}"> #|㠷]+~}SryI><;F&{;,oΰ(n'aV"Xwj!mrζlĨx^nL1Jj}}[4_1 :y{9|z(_wB]tw35Ӻa|€eOp^Lv3<,?_`W4 p)aAzͺspri듾^C{ϋk5WW]? S?=牿$yʿS^xڿHyE9Oחm}8>]:'kƱ2\O)Cw{|0QXSSߑ]>»ΧV_s鷫_$ u>O[4MG:6s=5̑,>3FC?l~6FQ v4^dܻ)7\Vg /tn/kKrp~M9o'B r'x%.B6?T}-•}O`\;{R V.~Ew%}%tݭeb$ˆ]i9ഁ=F|xxoC}YC+=^_ ^:ubt0?lkC(%s۠_xy6ɂmΉdcV?2x\F{gy")ql^ =9>Dvah0:Sa/(okP+}Iy0>TSC~mD ;ktm GK#ףk>&ۋ\Yܰ+}*q I񅀿CW ?Y,1:)|tO(2blFe[׬y8`J=#y޿xZ:`IJO<oc֗V5_ ge}ɽ+_WmZ䋴BgI[{{vqx[6"QC_A']q24U{pW3ym67S «zk&.UEhyք}\}ϲl&Na狠8ϟem#<bmj{ѷ}CS3>sVo}ѶvWnt] װlVx>-d ElyuQ-^-G_vSS˔R>ێ,}[kaw HYvχrZ5 ]oe{T^.?يbl╭g dMAsk sgQw+kkkp}4IgI92ًyls$5 ~x.c:aX3F|q|Oa›̺N{p|;:W[udd:ꎮ.9w&\Q\6>}>Ι3I?Sf:W$vtQE;ѳa3BK1eMrI}Ot8}!on2,4}/8dEaߞo#}]8-U[CM`³i\w *`SGhLE[)mM napO3}8+;y,>q5|ٮB{M6~1n뚇.0m3ra֧h\.X/\+ -cg6lh ~`zQ`LlWX ߥ-Q}+:=lϹ~f{)Ewh A߮ :;1qV~yzw\n׾Y{[fo:>n-@AOd3}7|8U!s-x{IN˨Ajr@*WhacUKһ۟ hF;5XΤ%m}- {x5[Z_||IҁQ]Gc#mL 3-?xdeϒߏcLy~l\/g g͉il(~6Fb66Y[>K *Gxj§AX/W8qoyk|u3d a w]>trb[mI։U8!zm/ g60zS72/S#O2)ZF3M/Bο<1恻GEƋJw겄o ݄:WTWؒn A|Ξ+/xaV5!]s4B׹8)X0Y/WN/)h +,+Z`##6%m*6;Ʒ1h 򗔞szUd{MJ9.L_w88ql mh,\/MGg?=MkχuE!rޞy6<g7ǟ:/bi#,?6>D>"_Kʦ2GbpG,c N;Rv_?d}~+ah}w{|K9:/ XuN=c{0oV׺^c&ߵ}]\Ώ 9d=Skt?=Jcn~5 _>#Y.Nx(?4R| N4?0w.zme븎7~h!usAOxy?1jx&eeO^͢f#]/s}M±syW=;|fqfo+o/?5>k{ʞ_~ߍh}xᱍYaK\?xkWM&Mjןw?cgئKTӭ l~j{4=ԥ?3 |g7>ƨ=ȭG`>ʰk~7M5>"Agߓ*H~n7c/M i7ir7r<~%ȔY6g^>qm{| OÞؘ/7 46JygEwAV@E=\-h- Yϧ[ʧLyGAg3+P1w;-eե6?$_xlޭs#Կm?z]{矱6WqAGSz2hV ~GUM ھ6amovtigV;:#Vю|UfF.cѧC-8dƿM|;|UC_n>+N4ht]x _qC>N1oi?JLOϴщ4Q~|߂=o)ҟb׻6]b?ʼKHy;H_ϛmX`W&ˤƷɞq?+F/ ޢ{}k{}^~ ΃t[7;# $&p\ *'fOכN|IUp k㍂|sShAFrhukF_O63zxblZ6vc0>Gp E7~[8C7atn}S{~{|gϳg|7$&u-?5,m%5{ƾ}"x|/F8gE^_ka{ן䷺xәC>>.=9`u \rR+:=-;C|BzB/}c݌Ǿ6u?B ^o=*j7ʌﰶн[[,KHu?6>:ўYwBaJ1GɷyaZ d_ #̉mδpg/ݭ n0Zc;,HNfֿ63χ=ܗѿW6:'v܎믕+v_y݊rX;{]p7<\N@gekq\r-#w6|b{a+BZ}z{VF15=AW15/x>|?מoyM |q.>Й't ,{5 6!x)nϵb->UB{Bߧ0z%iV)ޭSqScp?Aʲ{ ejbH)mxC }VYpC_]y 7N6I60\\N|mEѶѵ_~YWqF[w,e11a/x`7iYtc%y*3Sgbq_sv'LjtC!d?6\19|>4_cfj}HΥ+~Gpߥ=H8u_Ol6{^+ QǾ_De_ߥ}[~){#o; s?nUBK<:98DkF_[gݓ ٸƐSlUGKݮX/]>1Ofܥ]~գGy}~2nȷ|mO ߹66l!zXtI -mF;|:Ń8:H_񼣯롁[Mr}GYgdn^>D[%uo^^Y❔>vyҺw /| KSXG~?}b@ T]jm2.;}L6}=b!rotcmuδ#~:pMhx)JOn-ivǃ\9w{,`0R>-VQwVoyguNU+Bd,yY9No=K^Sg!y?m\6asyRWp?%^ep|˶ϙi'1koqfHwL6wގFO?oaT>? aӽ\n6ˆ xUHwOXѥfB;i{4;忣7+ 2n4 c;>l%gjнt>QNؼ+< ?:癬ZO8|s89׽ź;95sɷcz8'Ue|{A Q]ټ5f[mF084䎼Y臑qE?.3z.T|4{jg?<1NG^G+5kYBV:aLoH_:c On{vٟc_uq=7>}_ϸpqzA79뙜ęX#NN ⌽h?gw浩16ǭg Y|_(䮂1Y1Gv&ϻm~>g͊p5 W؀/`.m||?zNm=&^߃h]$ٞ/ةPlAD\. d5euC܎dbS+G66wCx;I㐍=Fg ER/߈|-x*{^65dmG{ײ=_:R|gX._*cu=fX 0: WigK _1 i|d[u'js8/{ύ&kp>89r3},5c~cFh+w p=0YXs+A_c gpiu׬{diɽC лmjgf{3^Ho=>>ڙ}(=LǪF3l6uwhsΙfgfW`w6C,b=|5A1&`˰zF%9\>%0["NE+:3te-5cs{Tkkt0Zb6<;)Nh3Sd([R63y%mtuJg)QL䕼Oz2hɜdAAjUÊ7{v93#-WC1+x|,Y#i%qW6QK=?wd(9zc}ug{X_^^pt ߒy׬|A6 ~s_j8jq#%?f|ELekFQ?otU>6#Ϥ俢<oƮ}M=)mÏ=?%+nF<輌5luiw{(Mw/]&KO^n+d>{9Clu:cuZg>Nbosނ%=8KE4I[Z:KL Jr8k 0ZH[牽[T>{`}dXmα"\Hyܝ*"]_i?b ?=?];l0Oܿ&L}5SsfYqJtc6RC=G\Om?loI矑?==g }4cȾ0N>LEZpK/d&N7 2k;E.Pܷ6ɺ}qSc٧Sdq{"oxv6Ϊ :gsٱKz4^1I^*f7'|- V_-/S[PRbpåCD|w!5O˦o1ʹf 8ݔ?Ft^i9.Gxw-י aw̧-$49a6f}Q6ry.mPCUnN᝾>W[IAǴk8ts p8lZ]Y%+qm}=btwg_|^ ?oqnt<^olFwݬfvr{ ]Ig=OFf%rLo1=V&芰9I.u^~ψ_дശ,e7v/~TOCi|8p_[i٨oyۚ^ l2[e Y w; =;Y7w'*&sþ73stWVXFײk?>XgZ?2- yS/+sb<”cUABw۾ӽ ӺjlCi4^X~IٳD>:<Y=v7IkÛ}NFb1=?l}tTrmvJX:HV ͺs&]xL䷕}qs4v|,vK aUU(Gn,]++ֻz%}̚鎻SJ?9~&d8! ñt8++?KVj4X"I9}ҍ hN/-Xyq.gE~~t~^Cё ތ+L̟tB]U 3hv}·z</Yc{lؿޙؼ<5^u< ۫_Etg}<0{YI(b,T7ڦ:t F p'_b \}㜤ΰ\hc=xux<c#я,Њl< pt-U(//xF}>Bu/[SGyu 圧k؅wlL?`,O|ٍ1mg?c[9wI`.̛g&̓chAght7<Ẅj8l?/\,:zЍANdˋmt;+OYu_&WnVpe('epg:^RLn[󺏁>;әuo& nVx^:rX:t}}.,wDOFҫ;bL">{?\Iӛ%Q2)hr_ly;b㊮U}<#Ɵ\ Hl{_~k949>x0I.0KIP"a^wcG(2}uwKg@|d0kh=K>4$g{{V<MYٟ۟O߹=ͅgx?:F~z=yFF&<q/ި3.nk65nw[ s~f_ynmף=o|njri?߈M^}K>|7x~5utk+:}y=}h)/3gҷcbҠgDv3 O)jBke`e\g>nqDLsfX*oQE}yxH~NÝ ;ѯrJ>f):_񎺺pt]/k|ߍD&.*VOy$vg|'6~_yhl7>YV =+>*S|+"MUjoK)z:3|>ѷ>K#G>>7t잆O/;JYU_79VyX4OoOs,v6dt3&Ks~$A_}kXV_=DC&ՌOf oxLl3K#ã-Z&0g!G׳~^ؾ쾳Q<ɣ& _5}SgM%'7 7aג)E"K_r .~gxFr9F-5u胐s6k8ZsR!x^^c9ӗ=y`@1Js+_MWqdPgIRkӂS42zb_yaWPpy1s~Pӄ??]ڟ'OBa "^}+\a/,m];Δuk;=>s%ˍ^`x.sdb4n_vtRp_: x}:~&o8Bxmkk>Xg366Imt? /<|\~v/ӹGo.e+e׮rcF ^b_)gZ,'Ft^[l&ZA/¿E5&>}5(}e> (s#+sY+LL^=T?^cAu_f>KӚCdFS'w] DRh2q *SLf[;,?y bc8-͗ty{]I|D4xH!_{&x\VQF,|*)3|CIE3V0Ļ-%>ku=` Kp:n]g2&LoqGO96~uHWgjAw;tLv͊Ճ,cyem):B[~X.DN,-_>v غ#^q'v{p+f}ɖA~}u>sM}ݏ Oc?+d5U}Yt^~x'7,Fn4܇]}рN ~݌vlÝPd/t |86ML7tQ&?80eUnܥ_>|D6O)~ /=;FRb{ |=g8xmAfGΔw0B?ƫ50ſ]3M^S@w KW%m<zMpq=>$eO^֣Κ+%yG~"||Ny:5=`HsEq-A_Kwq<{:^^Z]~m̌JfU{rK-5rQ-EZYsx'7 | AAkpƈ2!xj͎ Ⱦ{hq{6fS6.cۑ%ӥ}q[xt`\aoh\ee[|liX1^7g}Pݭx/]Hm>6#?]#N#eck~.J1ˌf1W}m }"K:!+|&^l7]C֍ z_kݽ@9\^qϦwFi^t-ビ_org} \,CoARGVUֱwekű>L_[|D/x~zwc=C+Mot,Vҧ>T{Uܪ}[}U 1ܳO{>sr;OfoV>J&9˧e,Ȯ̻6vms sI7,v{}i4fr>fw.}hb.Rz@ңNZ=t{-U{>K1 $h}n#! vplAYaZWo_NH7gt_ <ǃx|8|6pn?@V vxNKwui=~2}1m8nk-™3_G_i*~޺CPE^ȅ lt&Cs,'Y4oәWyiӽӃbi {_r5l,~gd3m ~:ө}jpJ YL[~8rd/gn yw1zf^[=\z+c݉ſw:5m?9A̡3:KfӷҲ3qUO!{+M|oI,ƅ;e+6 /n id GHY+>Ӝ0s\bFg_'l沆|c8 9͟(ؑew~]\8Eg X胯59lֺhCt=sCEpb[ I_޾l;ڇre+/W\对.G;&.0}$Ag'DT.o:+’ۜ6#_q-'E _! | `-/S \(>6-*d$1m];Ȱ# L3yܶIӬ!B޷uK~dIsuk}޶/q:tG*uWqIl+P|e3;pR<)>X^gӄ4s?3Xн ';>Ⱦtuyf]g|5ww8xh\sNl]R3ȾE ސkaoW;/L bt)2G ?{<<=s^C=>fBHb Eollߴ{j{QZ||t~/_/%Jg?ku{}1q08W [׃Oʌ3~->g7OW#`8?L#|lkKӺOCR۱oA>iϚ˫ WKCM؇ȽF%2Rt/z}?Odm'gh:V:)KǍ]g%}b(n4dx9օUbtM =5txlֳ?v+NKZ#Jb|*+-/O_ˮz,LghkBbs‹l;^B,ŶF#w\i|;zb!WAޱ>e9`#=/3o래KnK8mmK5a~X #݉^p2? [b:sK9ʈ{<4nz=ޞ?Pw,çB,tǯ:8|JaZ3?n;*^EV\|KQB+ڛ\h/W&~M i3Of9 3>x"p=,t97>Mzqx?Á3ݧ4.Tl1^&~;c\l^1ac&O}̊y)r2y vpcnk.'v{|Q <*g|< żɭY엡O~g]O -/##)cg/1Z'n o,s~m\ȃ&/jG/3VX#b5/THce=OBB| ^ qcZIޱkd˟-j6kMȬ]|>T6 6=`e Bmf~gLSǝ?z/K_p|xy[^/?#m֗-~ѿ?~k"17_ ׌Wņ^1׋ ԎtW瞏m6655fPf Vo|\X<:qz e [tOc.<|IMfv{tK7>C<<|9s*[+e`Mj'_>ԟboǾӊ2'A8*9liXptipg݄wޅnGϓ'Ecnm2t=腞woOQv7zl)ADY(Sqys{p=6(_(Au+?B/x'5>MlOnc%yv֖~μx%\W<ǂTmaڟVVg;{7C{!31]>||GpeĦÿ){s;O}`W}n u~Hם OE~cOGO--}0:^g݉ ;"S> b]qŎuHvA_M{˸|7c<>-YVmq  cg #w%<B(#|}ͻn ^&^/.mNsߗ|^ugk֎|Lf#md1slo~D7l땻(v]88dhtӊCxYavlҽ`_?GG?3ވ5L~Zφ̿}?sU<1ȧ^gtd~zp݁?Ggk*KLν'_XlA̠uWn }ǍVp\E7a2 gx@:wgx܆'kʾe1Nf7^h聒#Ɗ0'D~ƳKsݠ[fFo?jɺ죞\Agx=_z/NR/h[({K9rحNXC!n;r8>oFdo~u5搵yQh@7>\%Kuqu.(\yKv)|l|ɸ-el#dtO_W2n Nw.~zdOow pGk>ho,&|ItsF۴g\_p;qFg|ݝa89=_ C?e%=ڔgn6.ӜThII3|\/>+t r^d>dOEb'D^Ϣ3UkuJ3xp4B%n h*uljE>"o2~Mٳ ~ky'hjOTqLgqwَmbgAS\Hߞl|d߶o m ׌Wl'۱=-^4z戽/19=a>l=`zÝE{ɳy)f[Xջߙ.c Qג|ڬM 'Ő=c5 362df)k^fkE/˥Ol6;ȁ?ey*+I/5G|<|38Y=]ň$˱o0Y,}'<>R`=G.1%,qUO7tvC5o|<([:Kw:*{6xF6?m X1C6^#>ϺiF._&dt78wE~@~6փR\nilݎ'ųy#1dt#yU5d}֣^DAo W\ׯX"D;V ,&^oBAt8m ^~ʧՙ;9_uZI>Ĉ.wΕ_P.ezoEχ /z mdDoaRaGrx9x^%W|drI$s]ƺsL!ƜCmdϺ# {NX}1?LgSdށG1)xx cT]^\g ?*/<-6~2|_75ZCgk{o˷e.Āȧ!?\Ϗ g=^qy}cfx5Ԗݎ`FY[_M6an0̱kuiY{2FGjM@Gx}u^!azVדHEYV ma1gĖ8?\V#ߍU쉣|߈{]kL 9oXg v #H1-ygoآ˂?z lC|gL7yA1aeX; ? 6g#$ٻRh$xŠ:SdŇ#G>FzBWkɨOt) C󾪿Ɨsl*qg=okrd{b'Soc< 7WWu*m %klne3dbs-U \F:YBwss yWҳ;;E|:ƺQS?ױemu[ x @o:N'N4FұCںx#l!}ގlm㯑JAr>O_10y~Ig7{~;Nqڭ9oc7;83M dYghbu{{/h fˈ-J&==smO.nwa+7<:|=:zǁp mAzqïkyWE.,õ);Zo1<ュX{78Wи3?tf0rrb~.fӥ< u¤}4y2ל|sI gwn{cq?cuqepq)1US(=t\i/cGM\MżAEfA~zn؆ut _L۵WFMn?؄\ۣDB}p:B+?|^}Vq2GyIzW{W >Gs{ŗ[k&Agfjpyl\ldkܟehmp vXGCc}&'5x}+쀊5KFeK:?$o#N<,C:-o_Cb`㙵+鼸gWrg)AbM@>sY{=[hyr|gD5|JVч<;>(bߩQIKbReCg[:^!));>sQg79F1rv+t$8]4_8dtmw`Aψ@g!Qt)sƲ:$3NqR?Oܵ,cW|,dgdƿy|^%:h'@Vl|Q3=b+[ӮO{NAm{Zg s! C/gG:7fsP|A{>`ne=7. eŲzQV_v[V}Mm-Ց d>cNK GpY|r?}{-Ỿ:inU⛱9}%Nl;?v/4zT?)w(Ҕqw֘^ުV|<ω.ѷ̈́┽)ミ#'=]c\ FŹ6_v9G?c)<"gݾ;MylCֳSyUYw)l9}7̧*S;8os פ[D / |8o!{'.Vn?||n->+&ɀɼSv}/ȇsKQEo|J:9yu 狿1լ?~&l/^<꡾4/V Ϭ:FGF.̪S oHcQֱr:Pp-[';8Ux]>3F6f4TGAg%ιohխl8>)W d˨T_^rXd xV%RIwWS0A{{ 0貫٬:>8ןx1x=#ԟstX` #Nu۠^ PLo>'Ml}ՐkдgFۧ1&,^n3b2:MOn/a:/ j_ȭt?ڀxcߧ}ROq/p?aԱ&k뮸Xsx'˄uN!ig =$>DWσlYּo݂Oŵ~p:3<~yQ?{Xd:8K›s#^|߁ldm̃|uflƳSzc#U>g۠iLiϓFwjfsGhk 6l\mSGe&h+{GϿb:A4>GWS;Kߌ4W,=&Ҙ%?c%)t̽wwY"%g\ $ga,HT$P$UDPA $1Q:5wzv]|=~cNUWW8N}8VG8>6go&n-~"򚭱Ca.}6CAFtWm,838hYiWIl!:0r^!.M=QvpbXbZ:~Ow)|]户cMb@Vl3}_vpYӾ{ /2F|kF.oqƠf| l}WpϺ1(L ./+1o\ކֳ^g}w sHgm6TWlLZ?sWFzR3=k/XcG ]ѻ}32ys>ӊq> M}X7ZwJANtabq~(ŧ4>Z\ye+C?^hq7d.#P4D|7x^~ygֽj1}[Њ#y%ix縛^~v Ր>.3w9~kɒ.-NNk {ٚ ;Pk}.Fn?gymz迌ן]v}ÝĎz:ٻџB*8cw-}a>׺  4l -xѭ:'֜B3٭ oG7Nl%Otk6_WU5E# S ro=޿>f*&q݀)8(K%(_ח|c'=ut x+tp-xt K}H~aE6_lfY/'rZ!~'gݰa;oBܰ`+=e}@Eik_ٗ򵧘n0Oo~_~Ӄ|u }1]aϏQYA+䨼sygŦѥ/d/@A&3a7I\/ǕihHٔsseYs9;G`}mm\Eq!65>7{9Y{7~0FJSۛe3O|U&oMμeӍYc^达}q(:a)h~W np0CF9{Ŭpfˊڗ,|p\>4~J_~ђ-ig. u'YpyS=!{-A=#H\M.'ѓm]]ѐ+6JXD'MVXd5a1zOemսHw%ώW.tԓpG{#Nxxrt}\tfb`NiuVlב2w=:9Z^bCYԷyg~Km?b$FuNֺ1>W`hb>ϐSH'[ <?6}K&~ze3y^ ?g+TXtvw\5PtxR{m6q E4 ?wCn7:Y@t(.k '3 @.y.}9l}yg|ntoq;L|u6ۀyF!=2dgY-kS p!g=h+}}jGYLq[:Zwq.sm Q*.Sg>3^VU|֝|=1_6O/"R%~^|{Y;3=疣3 8N>d1R>].?Vy먟+W)&q|94tJ{ugw>Ħ-y!޲vs|+ }/w ^RMTн{Ql摵m _]SBtrgoɾ'vtau'NvNg5ײdb!h]elmURg:w9WNp@Yqk0tۯgvYqI㋓yihǑyk_Ed߾#/w[}-_M_w8 &ݠټOd>s҉@~W,_c~ݲwk%_7@DKw\vW)V|/Wߛ_i?c)oAj딗+FNrё}}kLAaj呖oaΌr8;o _ L< ݝ=ou'xW+|*~|<cm͝'7]w|?ebW'am *1<:7:Cd?ջb»֏G4f5}>MfE#ҥK=KAg9 }Ywڼ*88iqO 1 Q}-(xYQ姗lԶCA∝| !2O'&]h`^>KSL&O+  ltFUw¯",?<4l#_߀^}\ˢ}C9YKK>y.*{JFmC+,81痹Ue3h4Mt?A7!᱿I<~Q N^m4[?d/Wi5T)x ֍I~k"eX֧A ?6w1we8H;dptjmO$nV[{oA;Oڙ1sGƾ.πbaKG_[??^m4Ec쟼vpŸrht#-QCu {nhWUwU8O[a\+WOV۸ַqlvGg.ֳGNCf :|8?\vt~_3'_ Y]: NǞlu~-~ٺ}˕gı@{X<.h%ң2m+bc>4Y:^0oKgxt?7{ooƹO{&pנd/yZq .w)~o]+躷^w}6\ft_筌 ԚWXc=;Q~_ X:bDƝY8u8S#+' x]_qc\{mr3okQ>6!{bJXj㩸^1<ݟ|x'!˜ٙבdϨem[xfa3EzXwZ8=ܙǝ@rCU:ga[{@vvxFo0ĵvؔkdlEe䦇v nZr[ĬS yp22fЎ)gI7.>SwZM |Fku(ȯ\A\3yJ9FO΂|1+{0(6q]؆SwS,4S?&q,KƳ#_ieA5x`7 [b;a/U`GUX#Xyq&gʉ٭,]'~7 |l޿^7>W޾JoݣJ yױ󡣶u ;ʉ 5jQ+u/ѻß_׹4ںv.=9n/ ?f͢C795oy3?Z|>ú,9#-Uz7չzr sMu͸f?#U.vgZYZe|ٜy9>c4Xt`|=O'_OpGOt_52dQeZaOMk7񾉿{tG:_Nls?X^~7+V<sYxk}73/ SyQWt}&:/#|m7(+RC`Ot^!3 ~7,7 aW<@s=JZitz#ϛgd|ʮ #|C6uXWF|n90;*mg^IzcuuO >5 {E\eK ?7:o||[)ۥ&nߑ 3#a#o:l\.?:6hܡȟ#5l:0_R8xjď~: f3>uCb7kl$_/:sQ'S!Lח}Gu-S>f3Ѿ٪w[%lF \+ù@kq)BV?$GRm H<rQ0QXwV"-{gcrG7i|H~7 ~?7~/E_CW;jL n< Sv|5a 0(tSɀ>B78}(ae7|-zmwcޡk[l oiI53mjq|C ;'rdzhd{;o܍5Wt a5Xt:cN~~ki'/Y.m}\C:Kc.Tn+x5-y%l 6Z"~[n{؅Y[9 'SvE}>iqv9lc{ ;zDF5~; θ>85~-lh$wgi)_9S,}-ybүgY{-:b7: #opD5s*u2閾F~Fs\fX5phbV1eSGtZ|5#=̈́^=@p{yⲁOב]r߯b|bۺu}:N_ ܓ=ɍR{U`c_ mY%c'⫍[)ھY~,uRa VD,ϗmaΏs{rp~x MdK!@d?O{{yz]䠳 +flY1Am5zآ_oOoaeG>W4!8yo~$ b2]x?v?:gܮ??>:"98ʹH fzqkou N:36;7 ^c0e`(oor)4)f\ߎΎ/Ƣ^[3ϫe6C'8GY?jwף 1:O|Ey m} 5xڲ 7Z_͉~138}۫z;<7Y[DA-ܗӽF#=68nj2T u.^g9~m ߹uu'5k0[>=!Nlw]=a]J"oYo?,93ϰ}Gh~6{>٣lgGhlj׋{ t۸>>/ocйoW6ܴœy!$d|=("zۍ3f1LAށq>>cۂK o<_Wzwy>әߥՐ: *,ahrp͋?z*t8!t5_ӧu7yz~T>F/M_vddl86Yg=(G #|hюĻ'םNDV]ǟY~2̓lLs GG^CV,0%}:v_.=yj+^Ӄ&@Kd pHl~!mk@_ӃƗa۽~6o>h07OCzg@jun0=|'Yr_9[V(s0NUqlxkeY*/{ǯWZSlOˮ>/g _֦i#w:OGe~|2<\xKۚ2 g{h7mO{֝&:bV޼iA6T,h4)/5ɝs,:vG'/ ^h':P|/7;ON;:XǼЫ|z[?t;xF ~Xyfr|#'{n3c\no% osr-GR] !&1M3.Kp'%oo;xqu#6]ѭg␉ϻ]Q:Nc+DZ:i1:ѯ|*=}K=as#<÷c؅~xS};4޾E2?{ΡZF7`r 6t0rVo$Y:K%d۟RܕW!cǃ3D8t|Qt=k6*Ap qޙښ?Le|~L4ٴb {6Y_=chw_)T/ի_'z5j%}r=7;m̛m?K6y2x)(*#4{q[l;4t־vb4s6;wc;SF4Z[z6[q=RVJ)$䖒~Q2o\cSFvQ9)@^zk|26~փf[clv-+g 8wHs ۜ`?I3͞R9qͼ n+;Y uʒ1LmYpK Kw8gi7u-Yj&O~h&-}Z+ rJYg7ނ 'ңޭ3@w?6z c[ - ڼq\mx)K}pZ]4nD?`,7=W^",kTqOy_s lgs팗"v!zJBL4M0>|`ql*v4<%*:Wf&<  x)D3tȈ͂oAtL~6oKtmz' ހG漵ޛ+ϗ}8_z?`o{]^Ssx5 5?<dt6=w=樬.{b)Q=Wc۬=7w=qL+;wOXVO|ɥ~Ee߀J/b]$ W7xiYfo~3:Ov\2.4Y{}>aJYKxw-`6%CYmS ;ʴUQ"]cjmE6 ?!l|>Ã笽&ș5'z@WtxgzMё͆#Ě.G8ɫq1߾i .pk.-KJ-|V˻D9USo=7>b1!hXVǡ:ϙ3L ݎɆ*MXR7Lt^,4) ʦuN_t޷GZe ,tf=ᑒ2Й{}Y5CoHyu y#L6tT%2\Qk`Ac)]?kFmءpyjI/˓y̝I}Z|>Fsvc']u ނ5ܚ0_oB M4ut[\gQlPgllj|m_)V6ӀFnuحK {gC){Ҿ;e5Y$>R1feDn76{ Vp6u{ti6x &[&+=Fϻ-{Qq'L؝K`}?]bD;Fk_2?Ev zt??[_t=4:sOM[m[߷ߡ3_-/׍c~}jp5]\tp.ص|2zH)ϒx wU$ޣwMܴ. ߪ1+?ܛ* :|&r]4m"T",O;ζH!_U\ȱԃC%V17!~]2ygź!G1#Gty~c/x>duYjXT~st|],A:&峂b|9 ܽ~.g ^e9ǐzƴ|,[]߯;::Oq)簣=LЃ#;V?y/Vmeke:w`Ss{~% &5g] |J3ɸ@vM4?9LQds Yatسsɨ<%z^9G@&CNGAo_㝆쑓U)׸=aEV`\ls&H}1lLdp]ɘ҇#c^pLyglp);yRp}xt[^_W7,2z# [qE=U -hI<\Q6@OE<mT3}g`gau?h5ؒq_QyAgjv=|u?{T 3rKIm:kt3vZ?OE>}bЦFa?@>L *4bᆧX10v ~N: ?FM QuA-![.n>Or۫Oc<:gc2A>D:e2HgV>KBG9sx'Q>תjUc H^f'{LPKOl{q蜱p\:%>{g; v;1(2;J+5qsy:xx#zƊN+[wrDb5|4 :He_R;tVYQ^lw1guyǼN7y`AkHps'm_: oJ0*q]=gl9lv;B9]lS~FDZg,9|!ϓo|wbI>8NУcALR~ ~ڇNx FZiP>p؀ͥhS|6I?X~JqyYpWI#e{ s|fgZI{LΎOspy>8=˿4#whT[nEBt4ͳ0&:]G/0Keb1mm7'{go>Glܵ\alhE_?:3=y\ȩ돱l3fO_3ɵRb4Og`pfwsF3k۬طeh 9۬uO/Yw,թ~Ow<:CÙ0kuyeټ!S Kγ|yIX᩸;U1?c| @<|޸~6OgX['q+׈Pze |·{=tjy>nm=mL Z_W/MmZycGE'CI|k;X|+5ֵ.~1{ƪ= tr*.d}פf~Z<־C߁ ׵l0%ztSXK 2\:l\|wv0J+/cLy1=6: =OK/D~Zdw勉kFUZ;(A:;&[tk{Nx"}֑J~cy~dΊ|'X$M2es+:1>8:=뾍]%UR=ll6/܈nl8~zeLiHƆ`K}y#:_DfPb/_Еfo|P+-|zNr_d~J>O 46cIyR/@~wtW͏==:ķᧇg zVo?Ϸ 1G^ȯ8x|HFqYOm~oi:Y=b}V|>ad/ur١Zs?[ˍ{g{6Hk\߶Xրy4Lbq-ǧ:k?!zd U/ go.萯ů@Y:vPwj#/wy'|Nx+s==g=m־yLMs[]͓ DfgFtg3z4}9'{re<]뾻Dc{_w{~'Gש<>!أ=Ӷp#OtIuu>p6PanV_ǽ>+Ծ3~81hf=s#m‹i1/'x2w^vksPe`Sکt7lDZ`2d_%|_;}]j톣_mNIFEe(#W_ O3/Ÿpvl[(6BP\}xLl1:cͩNwU:|xAJ{.Jrc{N-t|q=ܷ `1>~ػ+=(ȿxt>_NAz(vV>GB7lCÿ#[O持ᗑg=3yvطl뾛?+,shXE.]:|c#=Vr^ݧ{un`߇<WuD l߉n =p|-G4t»82V3\g7ja|d|]iK:,+VTZ3@-6 +qLl$Csq5;1ٯBGoDZwn-893}ʘ|*,l}X%}1/WGw*˱8hǸ|pℓ߸:`V,ZiC >R.A+U5ĽIz3LtԚRL:ҋzs&.yKNYwjVxyhinQa`cC'}ɞ 3:ݭ\}L Ȥcgαnӆi=w~# ?^,qL}S_?XqK"|BO)ݮl:_ln9-{|q/r|ir׺-̳*7RL|5=3(k=wл-WL>vt?p\~KjL&~O^ߜJ wno9޵,5 sO/^?h\:wͦ;vZglct 0?oޫ tֳG湎xۜl|]ǹoQ6^tbgǶX}Fg&/ f4$_~R%#xO\n9/ӹ8[N?{ zG_1>Mg% "`_uִqٵKxxTm`l,9SzwU2;qLYw:0#'/yׂl$!U}燺S޴wbGE,?{WnY|]>z Љ|)y\?n ̸s]do^?Ow]@M1ll~8=~ v6捙er (X{;`Kp3Cojlpz8ਣ>%.a;/>:e?|8_(VI%[AYCkx&3ۼm} ^h^r'0\ذwyZ;{h]`"@_*6~AZzl ( wu ?H; NaR 78[[:ԭn哊)Tev.Wk]ܲL_ٻd,+R[5x?OM]6u7 iqm|򓁿'l ^6d~M?;ZÎ{`x+KNtzp:?9ߨ|";L `8n'Uf?=<;׶ȑMF秓"}7ѢƝ_|1C/rK܋w?ݎKqcww;u:N@,"X9^ J61^~\~BGk:oֆXߩ-ylKh>VVI%tkW|~p ehM6]ۄQ,pN}?xݿ[mʡOƗ[+;ȧ= \v#|=*廗('}GO['KY^5w=yIl"M8'k{[D/y%ygsW5Y6ܕÄAŏ ~}0wp:W7{o"g>q7)*N>c3u,c#-i{hgc] G5l.w?U7taf8f-u7tQpk/w.'m -{ë{~13y[d/[~4ݳXc/\_!δbdӫ;Sx{L@[ox8_2з"otfPlM|u놟I{c2ͩb{6qrovjYhkL?3mt,!G uM綞my򥿵$!yq^Atya^>>uiѭL:)z֪}8>O(OqoWfk `Ϥg;/KKwv=tuר t_F?#_ژ׎jmi\[xwh3|<:?ҭ/s \2&5jpu踦tk[_]Kۼf` m[ܞpNx]:Nc/ֱAX^.dr֭|(~Ȏ䑶z]7 +ac{񉭁\׾⺔ _l]h}1ߧwbK^ a\398|Wu. Yt/ 2+jMWZ;()ם w)_{V?=~K?~ZoXpW^oQ<᭻ mVӠ;97 W >NJ׆h{y6l/3)ح.q Ƹ֮8b>n g/-7g><ɟk|@g|F;}}ȟ))әÂ2Ӝ]-$ RzA]5 1)MuX[#NhZ7:}|Ÿc%~xk2Hsz}5Z?>yØKd t_t_$6Lq:<}b~&?/b#uYBG>CowHm 0''ے\ɧg:P[ƶ]%h><.:ӱ~ b mTV[7v[U mAy"P?qpq]˦e0Y1)8E.}DaF%'4I{Nux8x+!N3ihѩ6͜i&}Q!_L_|!'|qf|6>sWٟ;UtQı31[ NJ.PYm< w:߀qLxFv3sMgEfG:UkZN>y ۘユ{ -:t؞QsM4h69ݦ.<rї`zYq,s}Ly. V742-< 85SllLStb3^](rɟ+Q/aOј>E:ⓂX ӂMl/չ uꗵ ;#ڙVLdrtSE/[98 ۴^7>:+iIi{ryk-Q| ?k{N)`tD}L@LVvP6ݬ \F mTm+7p0%}=#mȗ#e?-(["|⏠>FqxlZĥ*>J{gj@ r߁lvrWr $#3aW}-phoChm@cO|&NkexLO :A[)y/K vt#\*/{#U}u(_U&߉?6*uC\'1\NG}דu~3<3p 5Q>:lݪp > NzUO 1:Vc !ku2>ݛax[ [3׊€O=bL̷I1^Ҭb\2ye&} gu| غ9֑wl&Jg؟c>_t_.l|DZ_P'4w߯R'^xx9@$}iGoȏ|xr5w#>:L woM>_&;j1jyٺW:aHKi]~lS6>%j;*[lT,ᣫ 1Vף=I3<|Dbξ=<2 dWF)<Eѧ\j<󓷏.kˇ}eAh|I0iНX3> 8j|&y,K sqӶv\ &6FryVG(plnqi&k?c}\ MBVy œ}.RwGCg{ңՑٺÇWw:,>~r|Dx$DZ\~n2FeMUw>{9zODtJ#~\7Ϙ? dfp}<-VIxClrš38O_F\g+6<`yث_Tu眅8=@49> Lw 711p >a+v|6M9wbgO3"{Y|-&>7߭?hHfei,̥?0`}~WغfL6u,!:Z6rَ]fuGqPov=nd5Q4AEGxo;ynd߳A[ ǥ4~Hgٿ}Eg$;T<NaJd;WEN˥kZC97Dorpʊ=W^j 44Z cN ~m} %0dk W}mߥ.e'v)[Lx8=lyFy,}&u{_ѹ?@CХ^M #;{gF:y:+k/Yg u[|5~ cO͔=3K>{Ӝr=)#ͳC~5;y>'飝y0$lf;&+N>S0&\YΨDzhO=f$6>niu尲OCn=uQc'Ի8qܟW gEe ^ ^l#Xϸ\;o3zvPt|>PV[_s7|~v2.Uqy&9OC2w=b{{FcY':I>yڗu9oɎHy^+>cOۗ#gݷhC8^;->8GMK1WGCvR6O1@x>ſCg=kڷ\Xp=stopQ\-tb/=-  }=%^wy?awx. 6o6v2ϲV{˘oӊ}!7Efq|𲯇2-5lfx藤G=!*㵵0e庇prsf g2b~,:}Ru~O/Xh+߽-Mʼn:?m!L`~=|/c:b\p8Ū]y3<|ߠ}5{ 6LHcZ}ŧ0rt{:كX6}Cer60q\?!۵y Ȃ Vy&>^EGOq=0<~D=<<. k?ͿOokw,oo_s.hvX3@w]X|g/Wӯup1Ҁg15݅Y=ůƗ6X_gڛ7_6"\W6_Z,]&`01Z7eryt%2y'rpL>˓ ;ebw2Q6b}IG9}ljF't\Y{2Vi 3V?p8݁A <|]}x蹰I0]l_&dG+k9$H.);}2Ӽq&r.:dr{GLx}gu51Z3l8p,,~irX\ݞGWE 8>hO$NkyDskct@y~>_}wyG`ZguIԏ.~Gc-Snyb/}xƅqgL1-.< Si~8io,4Q0e .FqsCN1ti(1x>-YBIY^V)쑒Lt:?21|FY/l}ۑ]]!d>rb-a/l0|.b'z<5^v؟.咛x'^m<"K'8\e8Υ_vJW7o /۞0]O ~use/{ nt͕)C_ClAH򯵱LݼFw7;$4w j֖b1pGzרQy[;zťdo:w(ҿ7@٦{wgks%Ma*6J>^Q4||up >>.25oc-Y&Y^7>vg?kGg񓢏&+Ȏwfa:QQ04}Va:gt)9v_7gтV2g`!{eۏ3g#y앧;5ry{=!ËϨ 8em\Hw򖈸}/'|޹mtS ^'<+¡0'av*t?u:~-XJd-J paa> k̃QgCGJ?wK[0FqG/,r}Ct:Qch?*SV#7A_j{z3^6?ìdU7>sݏ&r:ie'[/[~r#]}`Ӂ72llS!ZfcgR7N c^\තs ~ksg/kgfx\ӗcwq⩂د ӵ+F쪴8G;Ts㺿Vq̼'q`*cSm"m+1?x;ͽ:5l.x:{`xfS}mux+69]B .Sh?oo3X27rQqLkۺ{{¾ֽ=|6} ScV|bl9^eulr1~!MX$߃i̇Lo:SF{w ڴ{:[.S|JmV\&;+-{tߑ>פuu}t!ovQL1/gY+{0| _k|'a@]RGvZHt{Oػ\ zbtfO1Kʈs!I-P*G˷ >Ki |rmp>|٫J4.v蒡ޱ9O<]lMs?M6uU1Q~_.P&_u^= uS{ٳ.3\\"qg4@[{F{Y 91H+{:ی~eQ#}Cpjbr>:#br#:W>1> ^θGl?$\v0#m]P>vL>9'O{P 2Q'[nu0Kغ?rpؿq¿\g2i|fѣc;CuHu]g/p mǞöl dڪC8BCM@1*7`u58# S;oT~={+v꓂؄K ~4|4oWg2⾰F h8]u]IΈʟgX3Ku&[_9E"87CrܧX8jl׆#]7ܭ62Ao20]ʻhLL:݇3ʹS+G`gzt;ڛRh̓.,MO/GvGdw%7Ij{t٬A^WY,~[Й 3Ke5jùOSH֚qmzVlrC"zjgZnqBٻvƯ+Fݛ!nm?pSsgS0vguA]7u#npk@n|ƽr׃Kb稓gs\}>tv $q_DtH:Qc18ߗ΅Q{dC\Agf|7\D|o=%tȓ|^.~|]ZlT?T-C1lGp[JdP΋ڼY[.b\צK3>FWXam}sT~qM0Y+A !d'VÉb (&\xQq.~PJA;~e qt6Fy9v2Fz+Qxbً:w{~kޖd\ pmdhy<'G9ruEXj7aǚz|~.>=I  >] ⥟Sï)=[y݂&u#[3eqwk9qGc\yCٜ-LG.vț_a+Bo  hz7ݵ m;%6\pG18qBb8 1~\dܗ#O}& 7k'!Nv{c ƠEe~}z-$f7?^|<nWu֥>s-2Vn;5ǽ:+#= Q~lrܠvHx\0EyȂ(_'qwӃ}_k;gߌ{t2)|Azt}}2Km SoϿ״|_1b'0_7@_;z~:p̳5=?g]νX>`?#Nh縨l~/ ls+ОAbJIź~4Fb2OmrǧEb\ '}^tYb|~ ϊ_7=O}qbcD^j̅gdi#?Ifs_3}5;/ɟox`7(ft&r]l~ uKͷw%T>\>m݈'Ya\I?Ίy->x1v_gY:b>M50Cg&7З?"cs}sRvbtNbb[U^iBgXuG3-@o\vyx x"tIl ! &7Y3z4:;8tF;zֿ]xoN Ke?- UlkU|Ӝ%6(7vwPߓ6o: WɏG%GCrall2pZj/:,+K krN}wZ34<2x<3 S?%e}PRl@w܄̹!Ku#?.(sZK.@o@Kiݭ~~zM_->1TɌ6E a!|q#vO3&%c{^(׽1EoQ+/Y 5eC)D͞r7x-ZwZ?@W.n L?پoHp? [co s׮<^ȅ3;ad_ wU=|8~#+5ǎAwyg?oc e*IJ%2>)]퓢q} -XuwԌ@O*;>Mcq m¿c/?df/rfxbM[Oz)3ֆ|ggG0^ aWZ'|u,K$7:Go9Al}9qYŞ+]遨Ǔ?/|=૎ Yzߍ.jk vGbl~[?{lLXv_{K}0oߙkkzd쁳|Ãpo㭸F߈㋮ }c4ok>9ⲩCbKrs|0;k1aFit^=waư~Ss?r~a$C. 7(6hfT^}M8:ǩ^H>o3+_/)FӃ|ukLL&܌\Ȏ|Z\7lQ]](߻G Xp0(7~1 ]dAO\s_ՇseX''} o3%>9ޱ,stUs/}or-uοrߵd&F~gҫ65ܖ9dqxη7-{Oo|*/kJ}ɇee[^֭?(_'</WY m+{x0?Y^Ԇ}=54A>f܇?M Cvfqv0854Y-|$Ȧ._ fx-eOj;yNhɪ):/ ud w"sc<ǽ7/U] oaտ;[5cW.?>޸XkS_v]NizGܪAu; 73Y|do^ur)&Ծ{S>_mWlw>8g[Ԗg{A:|bU<0ھAqLw}?W3Nflxk|pOa1J`RiV@~YY7~K=l$c6HEje_OlcxeTöuK{%J{fW;c*mMzl11m8T1*[yOG7*(MwVTp_sڕO fTr]Q&;KRto `e@?k;ѹhOV 7 xNe >L8dxf9h7ߔM03{89矶ndɊl,ϵ 6zgt(4Ʒit/y9Ο6}i9Cxwh݃Ke=ez-Z31j&byIˇoq|FFW2;4>~F;48uNQNʡSg'"+aCEF2zXkǷ;/߁2d\"H6ogΉ.ps?U;)_iqicLZ[lo>{A=#=Uwt|B{kACDo8~ lv ޿Wl+⚯{hsC84S2^.(/[͠x4 ^Ov8tJ;m wt?86}~]:OEјk/k_k7Zb K]ũn;!oql͊Gװiyw>4Ei6M݇=3C~Yt ~|Rp%rؗ&$\*[ tLzf<9ne}c~8:sjk+b>tf_?۴ഞteŷO λIΓ?|.墨0:O1& ޳Aq~aɡ7oyo+Rm 꿯W=yА% ^(yMSt?'So|_k^,VNG 6,^40$"ۚ7zy^!tul17$cE+ _HWMA)lFWx_ذs3lN@;&zK^fN31ⳃ!{\/dx+읩?C `32K<= 5wMНA19J~N{wȵ׭ci=?n*8m47A.m,pBaƾ䃳 3K}t|ؖ+[cYi[k]7-WHh7,6gwZPmLGظgMt{ήNbk;L{8~LN,} :ndWnܰG`6ۃImU{p^ޭ[]β!3-xG'>ojp3lgASOil%?x߾=h3y 1?:UhQ8R[o)HaO=7q~uY6A3-هf<)xqn-Y L_g?B3nGǢ#w;%R͜_^ *e};U:^F|V܃+ڒn^8[#,ri/ȚěHXkkIu%t&=^5ayzqSYe y )ȭ&eeIFWM~nb[o!A[u{ZO/Y3p+é,fmXbݲV=5n.{$|צUzG8mh{Wh|v;;]v&[>i?t+;qQk!C#a>Y'1 X򇄇F>Hp; _A7F[nd;rGpΓq_b1D&3Oʼ|JtL4q,军e#;T7bӂž,+/gmֹ5 -nOl|[Ѹ\:l63c@>+ tx78&Fu^'phIJJye7 ?&6cgY3y`>qy3̞3bk{)\\?,gn __Iп4&<az;\mlV̋}`7ob2X53uv?+3\#trCsgU3zv=Z|MΐM:r5A~fpgCNg<ΖNY9< )FucH|w9w8'QY786‡}| a^s}y#¬y(Vcs';lK_qm9\&Qسnqq #=]H~zCͽ{Ȟx/Ϲ 5ir\G|묪CY/p#om#Wǵ39۱%ZbPbˇ>*NjU0>EL^bԐ E]hwl!B#ELb=fBFw@oct8{9ϣ f0//qEjxsx<|d )8g aǵu#Z39|d^pGNs/Ƨ6֋t)6(b=AO +ƽaY XpU`%_̪'O`۸CJEWr:)mz>d_+wgމc,/dx9a40]"kc"z}1KNxJ|}:ׯt)mAp&I.uY} _eOKכkˈuGz=xAM=bw n4h5<1w'}|ۥAzF^nc&;rVb$mMIV6%Ӭg}>n}#гۑ~?!~_N5; =eۜ7UGx+>45Ap\ub1D[ ʯQ~Qr~zm&\ƅQt}H-ЬqѤOC`E ]΄p}jȘ1ɶЬJm]6ۡ2elflkȊwk\ö{eUۤ W' dCW{ ̥qcW:՗RX0a-Rqr\\Ӈ{F‹94;`t~щAgm// Ҷ'9+?7Ng7>DSeWx $دy_t՛V5_؏'zec6q}m/['K?t?v˭ !{-4PlSlЏoUg?[JE#L:&71C{\V:C_l?sV⽭-lu8)xz>,(Q@/tU>bA{,*;%↲h[}A.]|FWk\0ߣ*|??Y}x}ӄxwXӃb$";e=Ñ:]x1Ά & nD=D;4+rr6OҜ7at^<(x)ȟ Rt9!G˷<-|":[tksob٘k 8P" tgScF}%E. |'&eq(Q<^_ʠC>ߑyݳvZmJ//4>5g,|ArڠYcn)N;:#gOkLyS7:+=U?'͊9lU^}yWyy{־ב&5j.ܭ"[)߶֚E%k7; MFkۏ2xr9wC=/G/69N;0<5a?x[|>ǂ3E=φɎқo>vLp { 2#YI;[ߵ#߉ xSqy[gi CY{s}:򹟯#J{'[\yUŐ:52Qwޘ,kh8oIfN<{Lٙ'89# xb\yn5Rpe1yۯ o2Ùqb6>ygKoF5wO#/BzwVGK˵g 3(&25 =r즱/ϟ.i;Œ\^;7;Go\g<ϐl[DZWޤC18q$u8qC[د?:ݕw6':1=eX!+k }NܪTKx=L!bONv]ox#t _'G9.jy/ΓNS sq{_OjZ;)޶,N= ^>O%Cs{46!7}ӡ|!MtǾL6ػ3}^й7t{[X w+Շ=/Rz-xp9RGő h^1|'U-SwŹD^6>' rQ/{| F`vlKrUʠO_׍d]%B|`fY%?ÃG/n4;*ʐEu4W\撶uv5}לdYWeovs7{FO3t{[ih8TK%r~JwrmTbd/b@~!]rξ>l~?!yGIاvbe$'f!d##5)|Ϝw>g};<:η64vRjti5~71~ok7{>p.ԸNrYgc{abHҊ_\}]W~|Eʇ x&r+}t6r5%eRf9$2|Rҙh wK#?ǭ|l=8߭G{ٺP6s}^Ɉ_+^dطy;y E:c"^{3 GimxlR2x7U8_ǖ`?wL .>oV.*|&I ?&f׷b/S.͊_Oł?*}kuk?6<5@I|w^!;}&ZsgpW?L{%FoK)i&>uDg+E] xax上pGў͡ΚOf?#6z ipzpv,%8E>>jDY:=z8[N0ȖƇ7Yh=}RϏÒ^FkȁDy^0N|f]<^KO}JpUqPGy<"?;cƁ)| |>xP<뾤ֳ儗9J?C< \~ڳSF}'yҽ|=5<ۂn~s|Y{1vZ9۽nNk0%z=tF?0Ai1_?p<؂Z'\ק :;3eUȮ-}#m0Κ;2vq0S Nӂ i1D%ߊs/ҟpu˱.}1ɳS7a_<[ ط{}[,NeףKʊ)W^ngy[emn!^cksB\J#3`ִ b@1-_y:/or'o3lm#ѝ#[?Ę"̠#¿O[\7CG_s[G<02]ө {A/wajOF+m3y*Vڌ_H\B?h ~>3'i/xZ9Z}eRj1]7Ru1)+B+ۃ69m>]a #*Oq-UWD^[UN [=L$p=w!;"]|_>4J<@\{k)x*ӳ\\gӃt>&E15Z ߳oYoLδl\:fR_W}_먌rDゟ}?bOX=?U1xo dAG;]&~ =52z}gcܱs1m3q/zKdǯ5WhySy [|}FkEq&OG˳؉vpiЋ|~;pAz>ѐ*0^ /u`}ϨwPghru=8/_ub}CtЙZip''?{OW6mO$G{?c?~ثO;,9ddHZ䃳?#Wtoy1k$fmސ,˟9lXOvZҙ`/1~`;xu9ܨ6sZz}wL>6PW=|rhqpzf&AIrb`=N;Ln@Ӄ>(9f'uuu]×z1G?Ytx{#FqDЗ>\ VDw/B[yy>+?'KƧm~u[O-2=q[t~RP=c--:%0{M/e+kd1L=`0uyW F4|x/7Yq͠G \53 +=?<;V4osFbN^\}:^.* 4t}Lo>{;r]n 39(yӺ:`cщCZ0CK b2yg`ύK|{L\wT(̫= }%q?tQq+O|]K oSgZW6u]k~b]j8Ɨ=R}7B~jI.g~k60F'anV[$}Ы?˗_ƑWmzÌ7ޡh3g2kV<s~pMf05i4|Fs8j?l o^3K;Ӳ}?s2_+9Ψ{Z='QO}; m1ĒaF3F0?C G!w'#`/{qlvM*n4:D57a?ބ=lFp+r0?,Ev9(WXmޡ;X؁ p&|Ul ^F  1/_#<1]ZYUem>}g1w=W {y?s } {;a:҆84`77a+`59 ~ vxg?\#>!4k0_Ō>肼,ܪ1N }=9Ȯ.{'^np$jګؖW7ڙY+1F7k𦿶=Obޖ7|nůBs#g~?(+;/%Ѐ}7r.~7wc_,`FNॠft Ȕz<_ɖè6EݻgpK;/-bBB_py̳!Ÿc+%>_kgk:[>{)OYngݸg>ڢfw3;wFcn6g63dݏ>?qp'Yߩ&V :dhݾ&t^73MS{FguOUJ#l } 31򎋊ǭ:#[&>5 Y1Z?{:8GL~+@vNj:[͍ cv/~Yƹ F;.\^ N1u_?psL OU:ịFX]VOo {,ikݗAp !Nð l>Rf>`f0k2%!#_#_\?lL^u3#rQnmx`ƶf_Ϧ9VKa۳q\th% _uЫOBGZ]` ~t&}lm'pVg~xАvJxZP[\|0W$v%ټ IdBh :890VkKp:VVSF\~pc˓>פyF]UJAx?*v\U{n;Yo[nHUdkM^P9TOK_Q]ʯue?}t.TbZ]}˺pOq ~.=ЩAplB>oҽ—>=UM} at?g8r~|[F'k]_6yt~&?3 ~qB[Vf.3ݳf{7)/Acis5WI0#X&!#_/SGg&ѧO1w\N9HyYIH25mX9b8| Z0e9_+E쓗7WWj6 ՘k5x[:FǓoO%OѾ6ٴ'~IH/KωGnsCwg|b~rS[2Zyysa$6O ~σxhÇ:(ΑAzhgZnCu/O CX{|^Q۽`F?;v]:= t%rɚq/,)cc79F>:HûfmDGŊE*? #q5Ybz/};UnӋrgŠ0~;90)xci|ujdʑ Ս6𬅺;bC3 h{1x|[gxV1б+gt̪4}GgGwwMpžt߷+L}akmuuX޹,^dg[W#OɩYA>OKaa\.7XDdzƞ ~X~C.mC&1 Q 5t$C~y1[_gIJ3p ]Gηu/|7.~Ȭa&<u'A}ug㞒nC_()˴~=&E0ƓGt6w36'n(g R?Wϗ|Dl.7|4z|߱}wWY+kG%Uդ{3wc嵃tGt16|VC:㳯 {~~mndA_yg*mM ɳ`܏4%2OtsΤϥ]^)bĻڼ;IQI)`LC^cyͤ(S2wc}>נK3qĕ~\:KBF?SkaYoln{{' ܾ7{:v޲rr[9vǮv/oϹ{GkDw@b,v|ů/k?cg:ɶ9gtl?͗>~=KÕ4}3YTMaheۖ~^~2xkޮ/o־z=j%8h8x,dy\gR[1G{$o'~Fk=+i|&~Hobҵʞi[x3%\27%- gwS&?G\.4""fw!=<^t)=9d뚏|V[f_{ >{Om ;I֌>3ϟC=~ۨ˗çg>b+% .9|2} 7Kʗ7N,o{Ϟ d IX>8Fa#p߱tg_|~i< 1G :Jt7%m}U^ v"]$%psX;#Q}l2OZ_l|em=Bѽ>n=oP?3ҽ)tN趍'n>< vwpns<,ydRsFLuhcmΈ ;A&>o~3qF';2bh8(v5s=M <]pdet'#Go8Xɏ:afɴ tzR3tU}tuG`Q.cu'}j׌FsT̈eVVO~=6cm"]<@s7p:_=KZ|V;qt ½^pY}m*#m"x\*KV|ᮊp̽[-N1V{eqnlu^7>:'nDfOnTl"*tɠ75p3|y;ƹ.ewu7/N ]g}0>Cr 3\'3Mȸ׷:7 %AAv' 8G6- F2ކf1!{1R5=tKf{N +~q+|7S5VO^2@3a)[ Q=XOF+,Y]CoZ_c˻Rf.d+Jo{H]E}Nz ǪUcku9ت\EvP ~8^-vƒ~?+:sW5/Y!X/y`ՙ/_gJH;G|mN#ykugg5?U{?a3V;3/v#7\+v+_{yGyys.FpU~H˾bg[q1#Lay6Fu]aOKY~zr8bw1]_.nc3 *XF׸W~Vtxhu/)ɷ[A gjE~| *A ?Й>2W_<ƯrmL|4>ju伪T1_Hc33#4oAp읝٠=ez,7\ҞёFl(}G֭[ ߞ74o~`)>s"ͥ룕N>wzbl:. ز7 'v/~BqS}/at+WALNM6 nMmPc =qB3Nc#|˶C|d3yEںS< 7\Fp+F;җ¬y1םA}51 ?}%/(fzrxͮgh%oQ~nxtc&m>tf7 N4m0hl'_t6h(|2tqN'Mw#z9%LƐ3xw^.+ hIdM^uݷɞkc!õz*6to= -VL;d/XRo8 ١[HL0CS7vE4̛0I1""HȞ9%balO=xس]my~+)t&6>֎|Ug;{xI ȗ9:s 3f8"ꦍ>V+W"oMy hI.2lӔoǿܺconkWWY^r;cJݛlx.x |nyk+dmn1Z;ikZv [O=7i<^qvb:_wR'g .ٻ3ۿ_ !"8΋|XԙA+¯ȷi?_10g_ nc0jO| ߷QSω}s |c8<Κ:ic(Mj{tVOCN9=E>C\Pls$:GM& ?${pooNOg~ە޲a}y5ɸZ~ >\U>-ߕ?F/y`/|һ':S_+Z{6/b߲lr.zEݯB|>>mfgZ١Gg>?Ś {g0z\ca—웙xV~2P~%O jYUkOK8#=tbƒtnQ _~Sw.Γ|D[x|,5`{{).g4-}e_-gF|ܡ*9M_׃o>RC?hnS lm6Qstge⚉rT!mu':̒TYl="{xѰUڔ{W|nzG*n,mOb,,nc17ϏmkBk9XM]umrKXgoޒ?>|G;ӊGq`Ϩ7x=@_ Q^a*h.]l`߹'[~!pjA{v s _~Y~3yXx8Ÿ@SLRb6`~rY[zaiS9z^+SvlqvXpQYrpwJ?ǐmI= .^:C%kx׻jPscxFGg&𬿉{nә#񋘚yB AлM8SOc Amʐ!VlyyÇu yC?AM[{ͯ{e5x7[ ֌V n˞/py}!2k⻳Ϻk,?to wF6}OІy Oۙn>:!Фovep_\xN? ons#\sKzbd3|Ȳ%k~2 Ɍ:osS-<ר6uew}TzMp[֗SF,t{:atŒ]ӮɍVwhsY;aA4X%3mA挵u'Fuvq@gxy_B20ƹF~F@_F/fgvug ?357: k=<450a#/>|aEn>֐*\ۣa.4~X?<ӳ>XKU|[Ά8VNeߥu).S̘:E=t ?/IwOt }79i14Z8ΰ!}b @K1}n4CTۣ5rw%}3\b?׺W:_{LJM]Y g(kcືihm)hgT>:i_rNn_Y=ѥ|?u:!i_td 6b4xgVfdSȯ:WקᯗnNNs8tG F~j0mE6 3Z^4icGt1Od36PuۺKݷmsׁ tM]?=k8ļLZt$#|=yexqPx2ɔmD)Kr 'L9οc83oEpe]6@AGVd2 !Pomޒ^d8b|kz?"IA g;9?jEyqs-{c~8 ڊuԟP/]@ItYפ+e13h늳Ӄ~L7K[^8W>Ԍ|ShVhcO qm@w6_\6Ep07 s+nu+[ocZfL{Y-Oawbуw(x˹U>״7 ϑ->6L  o@S>t}_h 5kOqo J ;pMrEq"~tV(6;@@6ERX0:_y?zZU_d;k#rᇡ{7FN4n[縞 ~^*1v0eW;[ec|i5d+}zὠĶ (3|t+du07= їC\d/}lj!}SI%6< gμwg`ճ} [9\٨z͔AKYo]KxYu7x7?->s76*psu;m4Pg ɞV^կu tv霸qkn=~aYL bokk7l m.z piu,}- 7J?ȗ;䫐'2ƺٮn Wocߔzgr]&}a.*7vGp?OJ~(4u#o9n Ǡ̹E3+uW+F [׍gi쭭gbW4m&[ŵ ~4AFXv]3xe6ߥ:Wi՛7{!/Ե:¿D9#ܨ#vtnWP&|=%o ]*2$ysC;ӊL0`m&2sx/&=XExw3a.x5n>a$l[ºсw;Ig] ;[ĆV\;ZP|l㌅tRֿcmChrP^.ު _dMQdasl]:.vYҙiZ/a7588ыݯBg`,8?ߎ2V3x,#dxvxi| 1Y/ߴnmlA֡}#흗 O{OxO{:N[տܻ㻨? 9BrOÑ;o<_(n*Bbz8{g}uOmo=&$W}+YޖotGOGRvitr"/jF,pk.e7 ~ev_i?|ft`ŎӜ3|kk?3e2<8%*[Cmcg _3g7=}tM{9YGp7VmVΚA1BUЇi>xu1[T쿾h2/C->+V^A>:6~sQd}$9fBFq_trXnl]}P12iam>@j#$Abk"[rj96󿜷-l?B+´6s!pP}  k-.#KYYcU_ 92gRv@G޲2_RwRtPzTd^>Pr3+P3|nmo;9M!M7h t^:CC^.3.ҳFcogV1RǬACUXK;_M,;kṈcϡ>?=og8;hzSLOg+x߬/:o?} yao#Ye924KnLl؉6ˤowgxV&-:!3tc?wnd) Cz2 {myĿr݂^lUV{]I ;S}ve0=|~ _>w#BClj6'Mjƻ'u]d\<#A,s0pw ]6;ug<$1t ϣ]`Fp_t'uZq2|!П%v|۰l\orFbEQ0wؼhp+3>;E{ıΕacC™cb/{̷C܋^a|qhGC6~M_!6Cd2HZAJmt91@iuMS@sA]]#2^.$=pIك>ek LRb6 AqsĆ|p=z;a8V}W,$x<=tk?rzYqMxl-~^>/<2{A/_,=7LsXv4^,TǮ/{س#iA[yӹC": \w P Etjt 'B.K 8d- W#@ ߟ.A g ).G}l]m }=bq^=BN W) pڇU~vd g gfXggEw_ED _͹a}>k= 2&N"hI|}W.K"= u+F]Y16~C*l'w_Cs&hyzIƯ1Ov\lo7l^q}Lg_c῁dh6tqۋɆq>΍_, [vi{G+ökuX݇V amcoUq5l,+>˜ni|5ǫ1&GH:rk[?gD̬OJ8"=[OoJ}+{^ $d+3y= snT{||zͶY1[zCwf߇e ̲eO{ԽK{ԣ:Qw4~+흒K# 9nM_C5%)v.uCB OAfg lͣljxwo-dѠ{)|\TU&;='5CgZg$|l/S "Lm6G-$ :7cE0SgM4%Ǚq 1lh/5|plpoKgA[Gδ'^MѿJ͆E'ٵwm m+%ֲ)Z9!ϱJp3s^ݣ,5EM#Y'[[wy蠠oU6#dPtHqn%8!V='DOTkX`tLJf `F={d˺Og &=,HwSl+A^y_߼3_g{ H}?-am~kOTLҫC+0˶gj`Н*ux>l"Y3̿b*弿yq.#󹃢#Zчw'1\^:sg>/Olհ0n _{ 6辊czWn|!:W|EFo`#9Ah/1S~">Xtěq|F ^53YnjsA[_$x |cyv5ZO n0=8Coɤx[.%ߴц&|3ޝ8cn@kx8!{{X#o_uTZݓs.oH\5[^}^hqnjӹV|{'"}Huy'7q\زYz㢻ώc܀ۘo6`cÿK[Owa&fn!'x /ӹd [xE}R恽l᭒A]}5&Wȃ`O>e}43@pr&x ;( 6y ;r\ ]~f3t`ޞq4THaa|l9g>:Op~¼|FnzIm'Sc/->3Ӄb?Cϛf} 3qQ;y&o_b޲y"=Ag U\S#g~UuWw)brY}^C緾bo#NK1o?L0hƷWO=KNv~H#EAϔX>z6݁psmIV&,*96lj-u>tcs#vtNE2oi?|YrW {_ٲd7Lإm=H'yAϋ4g`Ïp|-8!gءqz(ǒ <&} [Igs[;2/k:c/O[5w_M>ox䘏͍16u?@Mܴ"RwKV: UfeutL>"&8Lvf+_;zƶ~F#Rd8q.s^>U:UkjؗVϩNa&y0o&D6 ͦc\gLDǺ7zH,:Gϲ #]XKtǖ):q|%}{ :Sd?ӱ Ly d]ip`4|~܇h)>CG8cE  z,Nq,,/z/}px:caB7^cpǸY;)8xtd/.7iil2φWjFeg]<|[g2:x-ʻɿ'W{c ͕e};=_5fFzaz[CMdΛF@wAlIGZ3'= \rb#\C |u~7</kr3<&|3} ֍>O\ ûO67zp!:2DgxKG\ޣGǽXxre>o_KGtI9gmU,Х5Bqx8#K]`x!O74e, :5lPW8ޔ?o&5|nt>y\(}[_wx;,Og?/{wLkm-)['^'i{Ye a_k?6siݫtS;oم1XNgS̤op:ΝX_(w1ndΝFnc3_5HE=ÈNס0sq=auzk: v!~ o'#8}|$ӗ)CvM2[ksඦsw=u:g-;^Ҹfb]}p@fֹ].1̂έsE ^a_.6Lsb"HلV6,F+kȱ;>59ùlZg?dx\z>&)Av3:^Y:f|lVӞ _5:Ty 4SK[EywM.r-3l23ǚ|cΑAV ?etch{V܉;t sYL=W=ygwS"֍ d.ݟO+9ײv{` &^7,Ɨ9jes϶ Oކ\018~Gż#X~kxm\Ɵ_2ܿinοү3w=&>wqfZ+Y+?7ӜK *=a?xַֽ$W\ǡ *,Òt)+{]QX|jQ>Qt!H/)h[}/qOM$ A2x^}L|bhߡHAtbl ,U6MY]~WL 7G+@x^2Ѳ |+}+x*'K[6?l|ǒI>˲tGFHmN}lc4"5?ɶB =z[.k~or0xh2Ƴ^'5%a#?]ՙ|б_F#?ke6? `3ܥ@Zr3si;=O;Z~Uhǣ}H @OX.mc.=(Ъ~Y\RN:8\cԭL[ϊpA._ywد[ţ#09]N9 7'ԭP:L wX 9q# ۏK࠳;0Sn6m7IQ>v[:>Eq/800]Rf -pu/Y~4 pޥsq[]|0n灗igRE7^DnDΏ`9oWߤ=}/| ΑV׮tUWvc].̽0JI> ^hsro##o796gAB7~vwӱ$ypKb_PE'g[q~-%e9ϦA~'O|?GlGHZsj8kו tG^*nŠI5%7?i|8S5pI8)/l$5̕.2ڛ>nLg:a-5\>n)Η^k>yu߄˺xbL?Zic}ʑ hׂklWw=XY/FPL; 68/f5Y7+Rl&N*dt߳nmWs}]"W~g!QekIJ;%Nh]q?M>BNc%5bG祧k6>ss?==_n}'&0rlE_l+5_+$}p |A5 fJP DXΣV1Kcq`5p Ngv:[?ްm _~`;ڶ5{?y9Z>%ٳΉYɔ\ntEL/^A< _ul ZH&CcoW^(uwXkːo]FUg7;2e.9'!#>OxBty<+#[7{.uoUykVk"{۞7@gZ _| 7 %LѮ06V^jjH0|9񣾦ӧ_}-$[*# w~Hh=_QR# hkP|ܐш4hq}7{4<:0>ڟ9@?`?G b߻ډg'1w8HʛY`BWln/_oBODvWIk1i}W;җgs.죝YºߊuWۼ4E\1۹ 1f'oo=rL&G;.}N6>3Z|NjG|>nyjpۂUaDL#HF2_S\kC: oϕ6nZYwbSetR,MUF|:{|y}rFOE<#8^8_:VaάVbҶ#c/y+F3@<}kt񢕽`vz7 |wyU:gb2}#Vٷe!s~ >W,Pzǜm}ϴs^྽lZ6V976Z;I&DSl :~l%g"Y=ٵv㍱Xލ~:veX4tп}^~<&z^a/=ے=rcBߓ/$q+3Mqk)㻎wx-@׾Ų‡!zM/<n #F?)@=}>˿~ 'φ~>qӭ-|.92ٹ6ec8(>x>С*/gWVЇ*@oK?@[Ϟc-)ʄsr9ߓ󀢂1`@I*`X#J0bB]Q bLp1g׸ļUiy ~ptS#['vqE4y~M,5. 3Y&m٪-7[jl$]2W~}?XKiӐ'|2_ K?u V϶>rwk4y׿3(g`{Vj<؞l'?=_4}nAzs<#}Ҷq<5qgm.S}ڥKeJ"9>6hi/Wy>}=>izVagroG<_R|> /MKߕz$hqs-\oҏZ=>{̜yU|KYi/GoPEjSԥ>tG[]U}g˽d9IyOֲ>y~K׷j|>>.]+?`Ƽq>]K9&j[{S>YVu-={Xj,ej,><=Լ9'n`P f{kP*Msi~oa煖zP.uGaۙoix}/.mɜ27<և-5f+}ɤOӂ+!] ׺s@sR/H49!Q͒9&_3z};n{2j\D9Oǚ"깬'6KTorMzՎ+9qKK,9G<1`9#hB0]ː}lj.{"R#2.(X%wr2rqxҷO/UX>pn1l~ܷcq?y2Π/˻̄SQ?Zj{ZkӜi{iϴä}drqoF߿>qszoJUqsrɽ4U{q[{(/Z*s22?G=,PFdgO[^woܫv@\[[K;:בzSfR}>.i܁ϝz.f\|8{/o$i4eN'\ lz,'<}9qsوͤ@[Y;c\_,4{g<9mkD> rr-e#y^i7J} sDO8(Eԑ <-jGu_alb?sEʹ=/;]/=om얮6!~䞦LSۦշpwWOwLR幚=ci{+Hꇪ?pktH }qwIe9I}$N|B3WI?t̫z󕺰RuعdftO èϪ15u2&yaKiہi잗e%.R_(8&'V]tm RGHVJ_o.a$~䗶]izH[W!uZ [x$ă|O{na>-.Ųq:%LHgQi~%.B}ߓs/4ܐXڈd~--Vn{AgOֿ1=X)t=זvedR'rzpIۡ`I;mrJۼ?\wQH;xgʹHdnlqgq߱=MgT[G5~&#?/*uK)ӪḵsGt= ]/~Ov[׾}[}^kqeR'is_u/Վ]^?rN;Ү{f}gm뙲?aQf{UoR7{vmyj }r,.^jYwX}+u~nusWug&t?}˷<ŏqרrtQ>VJVzIڢ|Ҧ'1彤f"c=qҎFn4L|(j}&ykI]m=ջdj̷1qo/YFmQc5[Ը3uzW%rtDjS~H[6bzazx%}s@גz}qyeW弤.'m_|&^ɾɵ/GV!\i{= t@R ȶTcWE^|~{?(sۑVf r?@ye-mX f5SgOkB_y 7!,q~9^zslΫ_2)CG9"תؕ<7ջR߯逞V϶^J/koc{1v3M8̓gԸUҎ(Lj檾K}w<cX;՘23;Oo˼5}mH3-`sԓ.;Mƽq=/"S}~e{K8CU?J&w7lYFX|;/uHv~Os2'[ p}{W[^Oa̼j~>4R1rJQOJ7Rc>v?l~B`KY5VeUm~\\~}9K{^l-0~Z9zol+$mrJ|IX_{su}Rs+7Kwze﷤,u(io՘'}wc,9}oUH/e'&ʹPOU)xb`v.[܂LEAe=I!c^nN Ii}N\☴NJgiP#nl&\WE[#5#]OnK[yKȘ$>b3 ~8Ok^zSF>Tmwvϖzвqr>{.+{K??-.'ϡ}Us[]nY9q}[7nGku]y>OI}lcyWﺒsZ}݁ct:x{"]FgioB{uZ^{H{{w)'p'=&S;y꯾&};M78'|_,t}'՘Os'1&gF6WU]Xq +n/wizZ=W"|:J׃U͝9+۾R2-.EpaxzޒrPM~i.gӰ{y#6QOt}R}ճXזc-ueدRWVcJ]4[Ჺ NLUA)˽A*7l՗]cX8ϑwm3X9}[9"m4b1둱Uݗ|+-ik qq/1 ɳ-=I?~N;+<' Wni緯Qkl v*V{(+WmPGjM#oI%nFGbzvM$^ʹ{/5Vć[iu}-&,}/]r̑;sA=x{*%TPccSϒ:SmC}x>9>徧0XiֲR8sm7`}c7w߾Y''?û1o}ym/1#ɽq{F="4)io)0^IY淈`w/(R/'2/#ORa;{6('iz:Q'Q\8rwurܩOzM;i R2^^|Jw9~2NuhiWϹv+K<@?3^HP_a%e^S^z>zs3L=Oƺ|uztiۜre7Ӽrχc~G69 VDz"˦-~/UsB[y7B]N[1K~VvzUK5I8wNq}>UK?/is~]fַ[?G{rK-!w*J=zO~ˏuKYGCz~ ؓ}gJ([lU22.8|-=H;-5V꽏3I\٩'5烌"ջSߡĶbl2[܎m=/,?Kcܞ.q|Kl1g-m{#]wP|BO\c漌gIe~@Ҧ*(5G9>r,{$bܜ<5IWSt_-=pz[G~+K;Sy-:ܖUw7ۘm,Zܪ2cz>Ok{x<kZ27Pi2n!<jQy+C7ay:]%/p}ݪz$Ξ`紞gWve|I8WAl`,Zf❸(?b_{^oU?c_ê[y]W=XĎk-UU;=/0McRwlV;]gK/Ĺٞ~ȳnϹeNpk._/:1\g\/~VD=zeƲ{Wr,-wYom[㲼zoݗ/W@b>#}]ۙ՚X\Q^[`W<\vOK]H_&ץ($C=WiH>\rc$s^I@eeouoX;ߋu.O?}'zA%ϻ^\r=rr9%Ե+zs.(v|K↌aG{I;oo22rr_ɋױjY<ýlk(S_ uAWMΡq,~`klGxǧLb3QحWs󓺧ܽQI SNסQXy{s=^9s[ۏ=۪-ke_}ص|n{K:3\R_{=Mz9#Lq@'ەz >#c}8+u? ^8rq7@X k/AyPA([PHW,KI\q'@~a2^y^~E>qwޯ8O? sԳ.5ͩ:^٣.T8կhOXz}o=oV93|勖vE=#g9-3_6MLƮ6#3/4dKʩ@Y^N=2}罅KO>5=tە}nDRj?ĕ}#-5>f?adlUiwU8nݱgs?& !+ֿUm_EwOrNsf{ ^w%72C$P_cڇiSs#V,a埰2zxj~]ew@r/Qgϲ<:> >bZ/j̗ws}>]T\NP(M"8_^쓾gsf=ӳ]6UKER_ X`YoL>q^?DĴ#(1& w%t鳬n~KG9HM8_8S1@iz&=?Yjܧrs4oxgwݧHZQ'yU_8( y/.jvH-/#n$ߖ:H];q6-=QdZ8IWWc_cKЃzOU]VfrK=LW/Q~^z5lI~I޳IYPr/j~X{3-~CR_{GNnQq7.+muHYUy{ha*049}tR~?uO_,$$D?c_t[u|֎#Tm}ӎ+-g KoT?<'C'u5i{.Zsu)u[O.Glj=!$ˉ[ŜnyeI+uBgx4}NRScTPSC *ոoj+fZ}%jA^D_3{=%.iv٭Ts=O5k=ui6Kz9.s^{r-iqk}ǶlwǍ.ko7:ն}moVqw=5ϳQ۾?.<bۋbw]S77{ˋkc}}9u^c}}z8v,Ʊ+C__uy/N^qNߺ՘?~~'}\>bvĦ7v\ϓNď?[˳x:z]]'c6Kl ,:P=&K=sˊ==/$M?.e} &=g<9ee$=LcP>ʟT_?XVD~Qp`#|q lt^>/9YKG$~q.}cKC8Lsd|fﱬ!e]>і~?9K[Ig7xWTO,Is–&c^8{NS=ޱ]ɱz=}i{nzSH/+}#5Z]rnawUJϝ,̓ktKK|UρUA~}VR>깧03xkJ[}^h_=o~>lҤ/:{s>4iLhjg 亐gǤ'dw-ScɹJzFk,|R;z^Ӷ6tgk4_~0O;glYzv6#bE םzPs8Xu*5xFf-=,O+c,*J}}r/Yr/+,|ƫW߳T*5F\/w됱d fyלWC C?ged8{;,}ݵls ˾˱69(b5%UU2-lP =סu\t׫잧PZ5fPV996relE~O&q%<>{s,U_"OђGJ'HL?uZꙃH\/~Az_'k6}//;]+M~;>FYޣLGi('\ީMK,CH5>|__Kvr?,Nky\12g7g%s>]<e_ M%t-unqޫ qV\XQNƵ{y~U=oyܕđ\j[#Q~3[۔>Krlorj %۴[qm,wyWCR)!}d= y'< ia{#yLԻne?,xE^</~&㣨gIeDsLgYL\A=)K܀_Xzc˨]Ҿ_(jSnm9劏ˊy7Z=x؎Lۥ^{Ғ_-[K~@z\cRQcN='ݒ<B1ȼ-fZ]e;Lтtjܫ抋M,>Ǹ:-Y4QǠq2!&uۑgPrn3'^wg|wyǔ,>ES''yU>l0Cœ'XyM?q5~{z㱃A? \Iz^כA:jc/dzOXQ;=O"sOϴV.g%Pݒg2Y=σQz>}A0PčA3<ծSc3?zi_ ]\K^q[Xj D?]-e>/%.?n1ݟj܉x}M9l߾y19>5. MGNڞ$*Ȼt]RzWY챺Oro+&m;’NSup9?kORտnηǘcCL1Ł}YsnI,&n*v) <ǽg,{TzK'>$?kgI_{uOIM-W[7YfG-s= gl;BۼjG3#c5=3]I8CoGbu 6RWs ?wjGvIW*(}lwh鎜ff[I@ڬL]Mqi{==fʹ6,=6[<.tvynM+X= e+< =3j7k_xsv.e8Ҥ\}M;ˑoߩf˘ ٦MzؠqC~D#/%m2&uTżt||.u ߮]B8*QyKr|/ J(}/ߑmRrrOI}sK{bO8\'ovg./G{vke_i~Ao3T=?jXջd^%BҜ7t:>c,3}Vluj i6~֑~-V%`sQGUĭk-/7W,S}eޅv˫1S{!ޤpG5,侂vęwu?zuz09:]k?ݑDc%E~s[r\տ@8+ĚSUek)KQH*~dcu[^WJqLsx98K9f^q-o. äZ @}$**>7WCh-Ot^,zBb!KdsZkc+1:E>;ySMֈHrg3ϵ{tr̓MrO{]c>{/ޡ̝ۘt?5F#/{Wvlw#9i)j}X#W Hl~S=]?2^KCx/_\~s][~h&m168U_'jy[t,fɾw7"«{R7+kSu~ߑ.k[eLJ^x5+%;5U&i};^>BY+=.>{br9>9ϣ_27{> /IP_|Q>b\5(\9_= .i=+{Iیiz(ᜓ6$qzȯ;#OLz\߇qk}Gx\'kU3߷5d9=:LS.>=-[]T3s$Z׿SuoduJ]FWn=/'j{[YyEn~_bl~Rr] iX-τsS kuS^aI2's k+2I)]UڹᲜroy'<WW6UcP_/Gިz[p"K#,;C_r\#[oYӪ{N&rM{ZW6{>BӁNSg}9o'כ}U%fypWuaW]ҥ.vg_[S{{q\;;ճ(=Mywrζ4T۪ItiWuKU^cئiIxx]c ܦypP@ں2yf;bʩ_^V[݇oz4uMrOTs7smeU_7t=wWZy,rRڮ>iS%W ʜ .B u%v[WŽel%"cWۜ: w^l_#Gːya3ߏj9/5H|Wo|LL!ӪkU3-y?}]ZgleH[է6]R;n<_0U߬QN~zwYQn:aruK}KeZU«Cj\y*_^# ϺWY-7e[n㑊[缺!=R,U;s俒{]ro.=2&O=?Ҧ/h5&篴 oT#GQ}]e.r/ZƫEr aWΫOiկ",uޟd{^l_9w󧚸/5'[و+=/uLS9^o"I|>:)~β9k\F}SM}O"?K\T5פzN᭖r_XVE=W᜗+LjKY?VGAUgF┭@!xSuvF+Kj?]N|ăxΎ]ݵւ=2t#O[ A$=;b9Q=Q\/UeU9U-ʹT/'f#Mi|tze?soۦ md'cQ' -KwSCW. ib껨;XiZT<ئ`j KEUԚnꘗ7[R޹,̻-Kᒼ-;hn.zoLm>L5&PJ&_Mw4w[m>6= !U' SҌ)M\zRvixoIw84em,he`%ېse}RVIQQSG'LKܓ4꣣փTkEqDgX,!i {FlNs,3-(U-l"KWw:j4&MrP4K7+]dvq_o:Yy؇:m<:DDw5~OΤJ*$L",@jio^KWRmۊR4^Ku%TtiN[5t5Er[WerkMP\ K7*,VDwhn|&UZ_m $+|mE,ɗЯȗ|ij-/ iJ[?ti>pEmZ~Gn mGQYʱҼj*BTw6VzՅ瑡#ix4U. my߂ti^&3=,8j曔c^#y]a!TZ>vI?R]$T4m^k&pz0>M9/nRn3.;ҔIPM=R&QcY8zQUL+oتNaz0WurpSv`4 .Ҍ'Mr.iRUzT]t}࣪K>J2iP]>xK4Kp|Rus?r B0Q %;F!áHs lK.XnQHsb JRUNqyBUTWg@a.>ztD/bWK]\؏KOVK5ʣq MCa޶$M:%<P]p i"˚\B[-7xp W6j;&A=΍+p#fpJK oVtGs:m2Z Q4-{OUW*{'Ud6od-Q]?M6[H7F"y`1я]鿳u#n#ޠ6 xqYw21^\B5Z0Mg7!= ^Cnx+c2wxƋwHj?C^C^C=>p z/^ ]TeZ*轁m?b55,?/̒nC4/ ǼvHwwy ?CzU7pݲ[( 㤋j[^Dc{)_5 2P; /~ |x .?^i<@Rj5^/x-~'G}~8oǂ~BUsJR8sx.!X,CZ>˾c:>˾ͣ*}}W$_ZwG}|pe*v郇>x胇jx(Cя~I>X'z` u>Xm>xi>'Cɫhԣ,MV``P.`%kann` #>b #g>⷏#6ˣeغ#._'Nay><#&i>b+R޽fr2Z"޲d;YqGg}kGk}ZGG}Zy'/5_ﶾvIM?pGpG1=?$n ~XꇝyLfk.%[^|U?\cc~臏~臵~X뇵釳~8뇳2ܠ<蟛G8aZpWpW* mX?X,wBYx-nle[/XmlO@[ ?!Eq ?n-]~B~`c.f ]`i&nyGm#H ᴼ&)0Y gx, cy?pҒG,ȓwKډ9:%~.eA5E|86٦a p?>@'9pN p^al|!j]SaN0=0\; \g9{m6lo1o m3vᦁs\~/1ƅyxl 5WyEu_ տG8k_>adq`̇l4^kxl A<6K .ąp0R_w"bc na5A/q N&^vf_ޞ6ҏ-}l.=gA4xCHr AS:q cw A1;qG6gk"8a? A1; ^ĻxZ Y2 d/ ZA\+ ķV83}/۴|^A)xoCq >[xKD<c8R /A% mO[98c: , ~|2 JA8cϸ% ?RΙ&tAA8A:Ҿb`kagfaffah^ffafOOaOk § | §.6/+++p+p+'4 a@Y!W!W!mF(S!85!X5c>昇E!Q!9!8T(L%oQ,ByJ:yek>l  PG%۶~eY[`ORބp!x7KC&oB72720-B0-B,B,B,t.Bp.Bp.Bp.U=!q!!u!Xu!Xu!8g{.ȿͼc, 7C2#C02C01C01t{/;% ૼ>_C5_C5_C4CC05SC06We< < < S5ΆlΆ଼2C1C1C1C1e$vl~g~g~g~g~g~gnfnPs\^_C5_C5KC4KC4_C4CpK^7-Ƀi!i!!!_˗öl \ < < L , yRKQaosϬGX}K_, | l      W]ҿ jje~蘇!!!!!!) |   UiFz06 S037a303~G~672 gAG^6p6 3ð6 702\Я 0 Wk5 'p2ԯ 0l 0l 0l 0l 0 ì0 ì0 é0 è0| ç0 ܖLo.Xf&ߙvYr7vYNS&[mn˞1 ð1 ð0 Ç0 %pG뻽cala_22|W4a(Clc~adF]ޅ]O _a________΅a`օa]΅\΅\΅\΅aXW~W~rp/ ð. °. - -\Y;`aaaya{a{a`A:, E+dFadb 0 0 p0 ð. Ճa8~Ƀ-[[,=x~|7axYa9arE><.ϊ|xoaaaa8a8a8aa8{aX}a{aK 0,Wa_3mYe}4 Kð4 Kð4 Kð4 Kð4 Kð4 Kð1 啎a0 0\TC\xk0#¼?QƆal&F^E`\q}# F``$_}8KLlФ]agd>^.g.,"00"p0"0-+#0"-"*"419o嘇a]k9Lð|mTNES>ESDwӤQ.ë]]%iǙ]E]E]E`]E]E]EZEYEY.E"  Ed_N;yI#l$M9ͥ G`s6G`s6G`z>GzFG`tFG`t&GtFoF`G({K;#:#;#0;{#7{#7#7{xwwxyyu]}kn{98`B|&D["xKi&Da"K-%DpY"M6D7>g"L3|F^g"Lw $DeKs)%DnM"I_'$DnM"?M)<%DS"xJO)<%<%Dx>Gd(;xGȒGKgQ'] 8L0Q&Dc.ixM5Q&D(N-o&D(UJW6l=[2ZRm]%y%yuvmy%(vaQ*GE(.ˢ8[TQ*SEq(NťT‘_Eq(^#]6/e(ŧ8Xp[٦oÿu;o,{Eq(şQ'D(ѢX%ep(ţXOKQ,KE(śxSo>|NQ*;Eq(ŝuIËxD$G:q(./E0Si8Gtr,:uL0Q$Dq(CxH!Q$Dq(.EHŽ(fzbz_b/3~up,dO|(~ 8D M:~/8BGQ<#Eq(}Q|#oD(7F߈Q"WDq(.%Eo[ξN\&De7׿A2xZ][<,Eq(ɢ_Q+sEq(c.e(^ˢxY/eQ,sEnm`Q,Eq(8X`Q,Eq7ſW_Q+EiâxXaQ<,E(âxXaQ7cf ߌ1|3op8g ׌1\3kƎwI;% '1<4p=cg 13o;ct?–wpcxc O1\.'pbA `z Ogns3Ͳ8jqqy&p.ûbL 1<\'BGKMsu<{2xUKnbU O1)?pãbS wNT Q1<*:4>åbT 6Wp bo38K G1!#ػixCrrxD 1#Kp>'b8D 1<"GbB W 1\!'bB W1 +pn bA 71 pn bA 71 p؏8B ۦabxB O 1Ɖ+ipc'Ɖqbj'Ɖqix'ƉqiO,88N,88N,7m0819NLsW-\'ljqbx'nljqv'nn&^ljqbvWibw'nljqvKRWJF |($pQ8JGI( &$Q8JMڗixKOI) %$p^=GH |$$?xGH \#$%I# <${$p?GH |#o$7CH\_+!Ck$8CgH I|!a<^+l$O$$N'Dh泶Ip$ $,H˓$ H£^uLz%mp" 'p" 'p" p. ! ! r[Ufkٹ 00y5,;zۺoIII8I8IIXw2qy LK>oA>KKIؘIؘIؘIؘIII8|>,:3o{c &ao&am&k'al&s07 s02 #02 S05 O]o[7 p8 wv)I3) p9 p9 08 08 p8 p8 p8 p8 p8 p8 p8 p8 p8 p7 wp7 wp7 wp7 wp7 wtɓtXIXIXIX$g2]V.04f`V ^`T F`T ΤL ƤK+ʭSUr/Zc]/^Ru[ξ=S=uu[R~w ~t 6q >s .r .r .r `p `p .`p `m `j%y6up p `q `m m `n ަm ަm ֦`m Φ>g)))xw3 S7{S208S6oSp8umkaqꇶo)x)x)x)))ae~XXXOX782tY[OysnɲniYyoYynq;ow@+G4n%xdLi<2Gt̥IY3sq4Ιf4Ι98gLi\3s47ӸfLi\3cq4~/-w?R~fmxtNi<:G4ƣxtNi9?4ƏqgNCixs.i7sYNi;_4~ƯuNi<:G4ƣxtNi<:G4ƣxtNi<:Gq4~Ƌ8nMi7æq4uӸlMi74ޛyӸmi7q4Ot;}ImyMi<048^Kxi|0q4>58_Mi|2q4ޖOI7i&4]ҸJWI*i\%q4nMo1e/ZPYn:߰`neu˺^`e.XPm}o++z^geq4b_Li|1q4Η8_OL_ q4>`Li|04. `Li|0q4_M8%'4aWLi|1'4~ xaOLi0C^a]֥q4|O4KҸL6ac ^㒆asަahhh/IRfe`c6f`cfc>f`c6fbfafX(30 30 3}\&Bkn+SxwxKZ% .fZ 7 | 7.xxxxxxxI: .t 4 7373737373'ڦpgpgpfhfafaf`tFg`tg`pg`p+=yIl , Gsq>Gs1>Gs=Glsq=G\sq=G\sq9G\swhMVL9#7CEcb}8s?هa_}KxbO9\1+psbW9|1+BY2SpN)s8e7ᏹm߸bW923pΘs8eo]9-{pýrW^9+{psW a9<,ïrTT9*SpárUQ9+cNçrTʽeX9*g{v Ε;ߑJ<rxX˽6orYRG:ro1iZ7a9,pnrVY9<+_`\pr8\}p2qi9.pNr8]t9.r8\n9.ޖr8[g}1ђ\Z90ns]v9.p<8]ty|.q|ʶ]Goz|Dg? փFZwֳ~׮lwm׮'.~X:\Wryrvs~5Ꜻf߶j=zW9MoSSs泎4yyyyyiyymzNy:[qǧG/HÛ8sgy93q<ΜǙ8sgy|9/<Ǒ8rGy9#溏3뾏Y~;ɺM%O!O!O!O!O!O!<yyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyy y?O q<.;/Y,u<<ߛ45//^V)ẋH-G\^S M)6\+pNSs xM)5V^(:qSq 54Sw 8N)6ܦp~SI xF(>"Hl."Hl."}"7"qH."qH\.lHl.b1Ol.U3O.V4H."qH,.oxEȔ!Eqq2O|."H."1HL."1HL."1H<.2"1x[Ml,7"H,.C71H-w"1HL-S"H<-O"H-?"1H, > C<."1H .5"1H .iM:1x#4[)r"H."H."H|."H|."qH\."H\."qHL."qH\."1HL.6M."qH.K/2.Y-os9by]$VEbuX]$VEbs[$&Ep8\$Ep8\$En[$Emx[$El8[$EfY$nEbf]umw="<(gz>沮,Y{E|e^p޿YVm0 p0ӊ0ӊ0ϊ4ˊppp{V Ɣ`LI ۇ|u,[>şncelc_lwEܣk"nR1qYFү;wpQi\4i[Q?JG (%wpR%)"%<؁Q1J8G ($%KpQ;һtrYf` pNRIJSXK_ +%ܯt#G7.Y#Kd酶iSpNY%Kd ,%/WJx_ +%ܯpWJ_ +z%p[f= O,%ܰpNX K8a +r%>V;Jxb (%![H *X%pNRmJ8[gJ_pTƒJxP *?%ܧpW]ͷ=O*H%SgL)1e<ǔq2RG(e˔q2PʸCw(eܡ;q2PʸCw(el[ܡ;Tp P*8Cg <3Tp P*B' 'T ~P*A?†*A?T 1BL+ B<+.)w,+0B +w0w4*0*0**0re`FVT`EVT`E6T`C6T`E>TC>TC>TC_}\^TEVT`Ea}q>˺~+ \ \H<ܬ ܬ ܬ , ܫ , H{K|ʹUηMg!QQ P!W^$T.XFl7QT`L+%`P떿*5ٖ{c^vOt}X6 '+p'+7++'+p*yp*p+*_4y_%3fAX8]Ԓ ܬ|L |٤W4, w7< , ,6 W+0O+G+9zq7&͹._8_^^֪*l*l ʟ(+m*T*>RGH#U|Tq*Q?xH%UTSLirI SQ TmY:澯SvWSvUUq*WŷxX'fU|Uq*W8`e+mM̱X._V ~˪q~sn܁k, W5߸qUW*^\kUV*~\œ8s:](w-ne^s=㚿(Vq*.[imǭ{.LJn/+#8|_R[W*^]ů8tlӸrgUKWq*n]ű(s)kWq*]ŷ8v׮Uܻt<]ŵ8wU]ű8vU_W*ZKOiyg.ipY^q*.]Ɓ8uLU{3'wV3*Y3k&gռi\spZÉkh- ᥵OkxO ?>5 pnTÍjxU L5ܩVͳ5Wp^R5\5\çjT S5|Op.P5^%jpkpk.?hE>R=jxN S5pnRI;ԑ'Pj8D `^ `^ +iG:e ֎5\kjkxF ڽgA:Lܮܭ\ܪ<ړ, kOBYZ58Z#f׈5bv]g9`j_#P_#`Z_#g2p A J J N^"G v`G|3# ^^H#5Q#5R95R 5Q 5P/5R{s% `B vJ O]]ܩ]ᘇ'5R=5XU+58S15R15R-5S5xQ5XS+58R'5S5Q5xR5b_#`C Ծᘇ)5R5Qo-I'~׈5XQ!58P#`D_#׈5~ v`M{/46/j#s~3_Wj0cjp_VIVaEVaEC=dE=l#fNDNFaIaIaN>D aHHȫ-ɳ/0_갥[갥[-7\wɃIuR'uxRcuRim2Ay8TCuS?٦aQ6aMNaOaSaO.aOOaHD~aEaH~KaOfԉuQu8Pu8PuS1uS?v ,lÝ:Ã:\É:É:?AaNaNԉu8Q-uTM\NqÄ:LÁ: Â:ܨÍ:ܨÍ:Ó:\ì:Á:|Ä:qN\:̨Ò:ܨÍ:N:qN|:N|:?0C//v, 갡N̯:\e/v,K갡7pF](/:O~~-_ uxQuPuS+uXS'aB&CVaEaHC>C>?O0309/9aI+FoxR'uXS&v׉uR!uR!o-ɻjE\Å:É:ܨÍ: Ò:LØ:Ø:1N||È:Ò:̨:|Ã: C 7 ߀ _(=H%  7 xр 8,HO×FjAznAzvAz5A Ӏ?m48 8Հa Xh:.ip3] pG00[o{p7MÚilii!o2 ljljjjj jLjji1iҀ/ Ӏ; Ӏ; xGGiieKU XՀU/oՀ xԀM ԀI XՀcoƿ/Xn365`S65`S65`S4`P5Q>5SV5~$\hق5S4V3H/H Ȃ<ф>s2 ?5¤&kfLú&i&k®f6Ϛ0 l¢&|j¦&Li&i&6_>6c>6ca^R:貎˂-wnay綷nmwmح:n% 2xFiM<4&C8HwhM|_4&^IEh Mܢ?4q&./xCh&o MDhMܠ5<ܣ%J>n%7V%֊ew(4FYjUM|5&ĩxNi5M4&{Mi=M)k` i-~oZO h-|O)ZJ Wi-_*o+p>ZCh -Z8C h-p`A>.њ,ɟ[n|5_Le,3Z̢|ܥp.‘Z8Q 'jAW)wnl\- p.¡ZP iI7>cZxN i:-\+p“Z_.ﲅU[ݷQ~+^ZxY /ke-p[ZxK k1-|sZxN i>-\ueZL 7j\-˴pZM4|㴞hq}ZxL i1-ܦ۴paZ8L i=6l3˴yZ/rC-ߴqZ[{ZP `iU+%k{{)w刯-m"-bs"V-bw"-b{ނ -҂ -xӂ-"@ E `] &f `o >`\ ` J pSZ8D h3,l,l-<^SZxJ oi--״^kZxM i>-ܧ “ZxR OjI-γc?_qr;Xaɾ;ys^>x81\t.q]fc?93'>ϖ'''''''''''''m.)))iia6Z||F|kgggg>sG-ܜܔ!|nF|s \ƎrX9t2n[Vf![;=c|?ns#܉1;91܇||=ܝܕ}(ܽM㖔{\fmP||| >'y$Gy|1|||t>O$>O>gy~33gygy.yy>e|^%|*>9%G %.o;.\=ɻhI.iy#Es/s W۾ qyAou|^5|.][('6l؀ v_8@'hnʯSgh6nþ6nÿ6n6 l6 l6 l6l6m6kû?٦a_h?10[ه9`k_bFaeNhhac^FY~m؆mنmXچmxچ3]l e}Z3Ls6ln6|n6jõ6jí6jí6k6?HSϹ9ϻ6\jð6kñLW\S>S6XXf+s2W6kî6jú7LkÇ6h×6jÏ6kĖsG:iÜ6|ié6iÛ6l?bb~ctBtb}X߁8ҁ///H!vu!wXЁxсx!wb~kk.k_ne2tےe~m<<< s`PFuVG::0[r0m,s5IzPFvahvahvakkb.lEvqvovo^w & o:Sk乭S}w.^Ѕ]< p 0 ׻0 ӻP]tqnk:u kv܏}-xNFkY{F.鲜@]<'uoǛPA]>ǺX3g3Gu.ߺG?k]\uq=VZ]\ku3',ñ8V_]ܬuuC7ǺxX_]ܧ;uq.>ŧTY]ܫ{uq.nͺYWX)b]ܰv. a/u]u_`_d~cŶy\+v.=L|]vq.N 8a]'{8f'=^ {f=ܰ lzxa/=ܰ ?}uI{];i/N{a=<~z(VZOD\/2=\>x `q>~{xKM}>o>{8O?oǃEG)q>aP7K:NiNB}<}<>sxNA}>e7rA4'0???0CG72>>>>qO<[>0g0OL><ø>1O#䝼$a@aB}'}b'}bj'v}bkڇG;ݥ O>O>1O w>1Ow>O>Ol>qyg}bb'.}b'&}bb'&}|'}b|.Xm]ozN]}zi=.Oqgs~ڟEYv|vKqo:p>?8I+lG}\G>CxH!}<}v62[]~úw/($C.$ /}<>~ 8^}^qȌ .oxp}<>}l}.i8p_|v;{8'qby^=8/mӸxf7x;}|xp;0/w p6<8`nq;8xp;{?tMfi|wp[\ҤN<wps\wa><?y3p.<]ovpn;x蒼-{_:?{p,κp=xxp=x2x}y:u5!!\!!l!\`>aaa.aaFa٦( Qk;g|mklY5C>7~dA%KG!1! yb7 q!0oo0W9qmCd~Ly<` !^1xgCcc q!118Cq\aG q!118^p1#?#?#?#x? q0'FyG|GyG{GpyGyG|GyGsGqGqG{G{Gl|GmX[,G07Ĥ;`V.i0~nc˻K~0F?#`?FY](p.1%Fg2#8#8#8#8<#8ߚfY)GpytҚJ8e8yͲx7#\aGp}#`^0%Fb'8?FvdX8geb_a0#<#?gFޏ`F`FLLl\ n0}5˾i?CF8w#0F',0F~_}6ߜ:a`'#`p0F8dE>0F8#a_0F0|$ !pYcx?cx?c|`[Lxc0Əaaa1>05ƺp1L c|`nn_~# k~vgg;aaayx:c?c1_d Kưd G/5/r<|Ö1,cϵ1{L1q~ Ɨl1&x=&c8>&c? c0'cX5)c6+cX8&=񺮫y~]Ycr?70| cb)t=X?&b_LX1&xg ary7L 0&xGx>8??&Lp ~0&\bޗaWL ^1+&xOObSLp 1y)YR]׷YΗʽ`>{e79g.5yu-*7biOM`L`Lp n4&?FhrKumG L 0X9::ng'pvg'pv'o'q'q'py#'0t'ckx<899/:6y[l W4770wS\`LO[fO74rp| } ߧ}3y `OOOW)̟),)\m0x p~ y y { w wL)"O\0{ } ߧ} ߧxOOOOߧ0 ;pt G0u gpv gpv 0x py 8VOaѶiX>S>}SM/ãmwY;mq>NVNaNMaM?hMS4YSx7wS86ySX65S85SS5[S4ES4CS84mVMMa&M?lg i ߰)L©)  )L¤)|Ÿ)<£)l®)¡)¦)lª))JSa ~miE2GS2#~Έ3131'1<4[3b<#Έm̈ɳm` ̈3b>#ψ糊_jYg~Ï~Fܟ#ψ3813x?#Ō?#ψ3x?͈38?#ψ3X?#ψ3bx>#ψ3b?CyaFܞg1{F̞gpa#fٝ]Æ1}FLg~Fg0`f~FLgcK#ψ380#ψ38?#ψ3X?#ψ38?#ψ3X>#ψ3b?#&Nw;,(6̈3X>#ψ3?3;#Έ3=#ψ3b?#ψ3?#ψ3;#Έ3X;#Έ3x=#^a˻%>#..6qpFLgrFg1yF,]fپ3b?#ψ3b<#ψ3b8;#Έ3b:#> ;#>j&Έ3x;#Έ3;#&ψ3b8<#Έ3b:#Έ3:#ξi3bx:#Έ3;#Έ3;#Έ3b?X=#ψ39#v~i&Fψ3:#Έ3;Jkgk38'~Ήs:'Ήsb;'Ήee5&P6~|Ë9yN91|N 9};9yN̞9yNl9q|N91|N9q{N̉sb>'Vωsb='Vωs89'Ήs<'Ήsb<'1eWo?'8?s0?|Â91~s̉s80s80'ωsx0s?'œ>'ωs?'ωsx?'ωs80'Fރy9#a~# n̉sb?'OsIs2sX0s1)sb?'ωsb?'ωsb?'ωsb?!s2!s2!s2'ωs0s0 sX1V䟻"yaa"3 _pfWpegpf+b;cW0f[e{g{o0߱g. dgW:6W8a^aa66aaK9ä9,è9í9ܚÕ9<Ó9<_<â9 ϶̷aESro֊H>20yew0Sx [vk0x0xpxX[k_oLBg%[eI-XdI"ٖ,PB&B' CBK^Bo 0P-_ʇuIzֳl7 G>= c>4a=:a39>vp{3a g?ǭk[-r^/h-1S-fÌv3bFc0/fŌY3bF[M1)f4ƌƘ3Z`Fch07fÌv3bF?}0ff g63`F| 4Œ^ 3yNF}0ftČ3aF?臙Oք\-3p3`FhM0U{h-0f3ܟ3.35}0~3387pnuaF#hϰ~Fp}3:aFM0 f F& 3`W~F/0ft og85f9vΰsF1#f6w{{}i23:`w?^h 0ftnj&3`3l g<>y3|̵aF{̼f>rf8{!ևx|!·bv!8zp&i&i8 B q.ĹC q0C 1+C, 8CL 15WC iӆC 1,iPdd!bb!n`#!΅_/wB, 0ĬBc8bO(?aI 1*ĨB 1)ĤB, ,īB 1*ĨB| *ĥB\ *ưB\ ,ĪB 1,İBL q+ĬB q+ġЇSO!bSM!N5a}!ƅUU!vbN-!bXo8Iyf8bZQ!xL7!bTW!.s< } `hs!vbWi!>bTQ!FYg!ޅf=, }^:qlq!ƅh{!^xUW!^b^o9-p!Ɔbc!>8l!dz#!XbA!8s??roa!քbT!v8s!M/!N'!6ua<|=ϯ;/Bq'Č3B"ċ/B"Ċ+Bt}'~?7¼ ?醿?1cw;?wx;?w2s뫰 믰 뱰6 뷰~ k kv k >:/O ^j 뼰 믰 믰 믰^ 븰f Ú-Z.Z//:1:1:1:1º-:..-z,š,š,a]YXυ\:yg za^aMdaMja ua]ua{aցa~am|amva=qa oa=oa=oa=rak^5]^\X[X߅[X[X[X5XX5XX5\X˅5]XZS7zO |WZXZX`XubX'ubX'u\EwܯZ0z+º,/,,,#:2#:2<{ܰ k>xհ Ȱ kΰ а k kŰ N İ k k Ȱ 뽰n ưn Ș5-ֈa ֍a pa}ևa}~axaM}a}րaxa}a}yamvatawa`#k/NJy6M6ïsu˵<_ '̣0\ {e,{avraVjYͲnu,;f=|} y9ˣYh=e,f96˱YβleO1k}1lI,e,fY4ˢY;-Y5˪Yrm,e, gY8YYβp,,Cg:˵Yrmk\,f5˷Yfclnle,f5˸YͲg_e,f4˥YrkU lsh=f97˹Y^2p e, gY8˯Y~lg,fy6˱YiUܚ,fY6˧ُpkϼI2˕Yβp,e,{f4˥Y.riKepn8Ǐ<ϼgrifn7|OͲjU,fvda??a&sk[,f7˷Yjw;y-9[{,gY7˾YͲo˳1f?Yg,?g9YzFk/9:{os|c X89νuF1vscwx99^1tso6ǯ9~k_scx89αtsܜ;==~w.cs|n? 4& >/-Y[ÜvF[_ CtƜޘs:cN79 14Ĝsu3x s}5x!4Ĝfs`N+i90+vF5Gimpnڻ[92]˜v.seNi92]t˜f?x賾sbNfNo917Ɯޘ/sΏ;1>:89N=7 C`N'陹gNC9=09tŜ66sZaN3i9}0œnsZaN+̽hœ^ s:aNi90?4n s_1a+oد/œVsb90+Üv saN79]14+^'x saN;q||t܏aṈysc=8>91liscX7Ǹ9qps̜X>91wsrkis< 3/7os|/F>3sgsמ];#9Ǽ9Eh|݋p/¸"\-¹"\/"<-´"00¿#s|VD1#OΙ1#f~̏"Dn8gGX1#fĬ=b>Gy1#w3:bG1#fx,;R w1#0!b~F"fjLs6bF{35bF䈙aBl7bFވy1w#n܍3-bEÈy1o#fl38bE5a߇53#NFۑys{߶w?˳oc~ܰ>FGa^yFabuEyg&F_Ea^F8aeEX]w&F{ƹ" 008W_EabFFL=싼=Oyi^GchG~GZ ">#+#<#|p?"h篽6GϽso|9=0&na^y0#ļN a^?wyy]0 5üf za:an٧w^-2Fkx5~}1w;;>p;izm^y6ټNbl^y 65ټ6h:l^kUͳz^̳u imb<{u|/8 y?yϳ{^ͳ{o8\?zY#>k.{=2?~N :a^'ky115p^3ky01{?w/| Wky=4sۘ545м'd^y]2uԼ~M:f+o٧j=w6ӼΚb8Y+kym45ӼfCi^;ky4uӼnMi^#ͿZj^Kkym5uԼ?6^/ky25ƼZb^kym2Mn92uǼc^y25Ǽ> c^sky-1!5Ǽ#6YȞkß˼ ]˼v2_˼^ c W}7t̂VX aAG,hM4ÂNX aA7,ha;N zc <{}^w>3g1 >ǝm]?x#~-0{Aw,kßyf-ka><\`x^-jW ZBt=KSIL/6ŞbkX.v ]`_Cٻ.0w ]h݅+.pw ={po/pv ]cxЛb_w=^8n.u ,]`wؽF.r ]>yyf,<u\Yx->-|g9} xy+;-(xeX,pd' \YgxF-l᫂5F-0f; \YK56-lޯc^3kk_Zd"ٵȮEv-k]Zd"ihm=l[d"9ȱE-n֯jWZ"L\"_5{["ȲE-lg<["YȴE-2miL[dQx/ʭ(܊r+ʭ(\+ʮ(*ʩ(܊*ʪ(*ʪ(*ʪ(r*ʩ(>e슲+ʮ(,r*ʩ(r*ʩ(WΌYM'QDYeAQDY ʂ( QD5fsLQ9p.w˹̄uND5f| Q3^s3zI ,{K ^bߥ=,^bX%/xK,^b8%.xK]RU!+쥧^bؽ%f/={=ؽ%v/{K^su/|K,_b˗X%n/|K/#?}38%/qv{.}й]%/1xK ^b%/1xK/ ־jdK\^z{F/yK|^b+%./qyƬ|3ؽ%v/{K^G8%.qtK]bC#:xC%.1tK ];%-qo{K?^_>i;\w~_xpO|ZGKhI-%}4̒Y"K_ Kl]b[غw_]{{%pp/b|-Ʒb|;c.b.vc_1c_}1X_1_1_1_1_1Řc`1_1^{1}AcL15ScL15ScL15?c4;c쌱3/c5Vr?_c16cc5gcq6Ccq2{c133č13'cq2'c|2#c|1c܋=cd1e1^Ƹe16c1>c1FƸca}1c_gq/b1.Ƹbl}~pE‘1c,0)ބkx%#k}Ⱦ1cz18x1r1co1cn[ciݶۦ)|?w{}Z$]zwO}'}b(ebZ&eb:&cb̌鑘0b\1+Ƭb*b܊*ƫb:#ƭb {~=l-{cd1Fcd1Fca1xa1x{qYgap_^9glqkqYhqYgiq9ghq~fqfg['?5{=5{=Mn~G;>1g>lOiָfkָfkָfkָfո^ո^ℽ {m\um\ƍkܸƍkܸƍkܸƍkܸƍkܸ~׸~׸~׸~׸~׸~׸~׸~׸~׸vk׸ָ~k׸vԸNkظvk׸fwGΟr3k޸k޸k޸ލӃYӿq׺q׺q׿q3o9?zqqqqqqqq=q-טq-qqq׬q qעqיqץq׌qחqםzՐq אqבqבq׏q׏q׏o᜾o[kKoqs17=&yn}e\;uc{kɸތ͸ތsZ4EZ4Wz4:4C:4C:4C:4C:4C:4C:4C:4=Z4EZ4!1#z3:1:11////׭:/:/:/{ y `A= $4_ %xˡόH!ogCyx=|J>3H)7M#;I˔{9Z5 $X`M5 $ؑ`G??`3K,I$Dd5$'s(sIp'wIp'wI0'sI&op„-My?[1Lwϸ{p9\Np9\Np9LN093z &`l &`l &iq< 9|GW!q?tq!wI魄^JhfJhJ覄nJ覄nJ覄nJ覄nJ襄^J襄^J襄^J=s:+:*Uo%TBo%>-xjKhJhJ譄&K譄JċkJhJhJhJhJhJhJhJdI聄HKk6Hh6H菄HhNIhVHhFHhFHhHhHhH|C^yHhHhHhH莄Ht?#?#?#?#?#?#?#?#?#7$7ꎄH莄H荄HI^{$GBs$Fuc>뒄.Iߡ5M$ M$ M$e-ELޛ/o{u/eϲY;:gY#-u5в>ZA:hY, 98ϲY?gY,eϲY>je ϲY;zeic>`̚Y3fY,ke-oϲ.YZb9>,_2'e/ke/s|˩;X˛X˺cYw,en-3kˬYf2o'2KY̵e,d'g15Ʋ>X`Y,e]e/~ˌ]#ZcYk,keꇸ^ʇxmq˿i뽿>7wup[ƽGo7~Gϣ\cmxu7w?g|̚.^˺xY/_wtV6^+xE{o0~^+zzEOhWv^+xEhmW>^+xEhMW4&^+:x:M}')~ }Wt^+{Ek, {>{|--gn9猕 GpNۯ,g=W4_+~Eӯh=W^+z|Ei6”Ycz +S>cVnvfˊg(+QVaǏY+3_+~EӯhMW>;x+{EwhW^+_W^+{EW^+{Ewe#pKWW4^y{MW4_+z|Eh-W_+:|+}EhݾWtN_+|E=W~q¹__^\^+:rEh VŊZ3+zfEϬM;VtNJY+:bE3=VkrOn874+zfE蓕딕 ,+)%s%]%]%]%_%]%]%]%]%]%]%OꅤHjSW-I-III=IM|[댤.Hr?$N$Mr5lM5$G='qI'a\Nr9$\Nr9$\Lr1z$KWV%yJ;I$ٓKrk:+Nr(ɡ$IY?a(8ǜ$sI2'ɜ$sI)ɜ$sI2'ɜ$oH2"ɀ3ﰗ;ܷ1{>ydcWI^%ycy}Yê$J)ɦ$lJ)ɦ$lJr)ɥ$\J~ژ5N%dTQIF%?g3J2+ɪ$J*ɫ$J*ɫ$J*ɫ$Jr&ə$d)I$dJ7I$I#I$dK)I$dJ)I$dJ)WO;I$MI&$`&1 ɀ$ H2 ɀ$ٟ́dBI?iQRO)?ezRp7RHq#ō7RHq#ō7RHq#ō;̑CRH#ŔԻ }H')XbI%)^XbE꽇s#Ō3RHH#ŏ?RH)s?eCY@őLHq#ŅR\Hq!ŅRLH 变ِbC )xAj}3R\H1"Ņٟ2S1kHmkHm̍+R| )>e֧Yڽ_RHܲgo7M7)ޤxM!)6Y2Sfy,O)s?e2SfzO);e~2SfvʌN۩NNǬO)>eƧy2Sf}ʬO)=e2Sf{,O)n{p̓s2{pOi?m6f~Oi3?mY6f}ڬOi=xHs ́4҉fB iyAi6~ڌOi3=m~kC cI/i4~i?mƧY6fqLOi8my6q3,Ͱ4 K3)ͤ4\Js)ͱ4lJ)ͦ4lJ)ͣ4+î +ì̛p+í 2p+yYgexaIdaFfdy֟2a5dXL3dXaM5dؑaGvdؑaGfvO2<PCdxI'dXaI%L|5dIf}3720&ã _2|%×L-X/ WmϠ 2'5xQGexQCe8aPAdO=3a M7dxM7daS;daE)dy13xϘY73f{g9[ֆǰ 32 p#Æ ;2|!Çg }fENd8ygfdaFfdaFfdaF6daG|/u^dxA^dA ^aAdXH^dyyVdXC fdxaE &daA dY13fy,Ϙs>cg913xϘs3e>3e)Xe*7Vy:3#Xe*+VʋUF&3f1Ye*CVyʋU^b?{NrcXe*VU.2c Xe*VU~6 f*VwWg~5yoYjfپjfپj3\sy5I{?|dM˧)˻c>4{v ,\*VyʲUNrj[ >?gsme,[e*VYʲUleZe*VʳUf2kY [*VʭUnrk[Z*VʡUrhCZe*VyʣUhEY*cVY-C_2aVٳʞUg=Y[͏pt+ovu:a=5/}k{ĪXzbUOU=#V>XbGG>kU5VƪXZcU[U]+V=X_ƬiUmKVuɪFY&dUjUmMV*W9Uίr~_*W_U__`UޚXk`Mi5 5֯}k|_5ޯ~k_c5|k _ci}{}Opw廵vXk`Mi5=Xk`M~k0>]6s9}~XkaM?56Xkz`M i51k_k _rYkc-w~MIȚY h5=AִǚXkaM?5 5~qqkl\c8֙5nqsk\gع5~5i5~}dk\O>f=O{qtk]G85qtk]G85qtk]G׾`:[غ5ukL]cSטԵ/e5f5k]#53| _35yl^K־%ϭ53}L_3׾wYy {oks=`Ek,Zc~dƞhLJ~b=شƥ5d3kLYّu.g.g=kYc{سƞ5qg;kY {شƥ5.qiKk\Z-9Ʃ5NqjSkZ8(^MY6e0X1L[Y]YfeeV̓o1tiwqgbYeٕ]f1*>͐bmϦ!`Y-Yg@{}V#dȺj6j>ꉬFj;{͐muC8xC;{- ًn~" ^uDÂZ"%Z"%Z"#"#k"!"#:":"Z"!"!"!"!"!"!"!"!"Z!Z!"z!z!z! : : : : c־j̚NꄬNr?,r?,j,j,|β3,;2:֬r4,323}#ehYvfٙegYffyfY>febYfgYf٘ecY6f^{Y6fٗe_}Yeٗe_}Ye[oYe[oYe[oYeٖ6_uoߍYcYucfߎ]{wcy|[:ζule[[{;3iz;|mO=_:u_:پpZ`X7׹ΐu3d!롑0Ş4s}e[g:>;LZg:5ɺ>Xg:Χu>iO|ZӺΤu3g9µu^ ֵ6X`]kuM 5&X5>=7nwS|&Yb]sk ^N;'w.sq7ss17ssOܛp9M|9Fct9FXcq98{)r;wNw|ꆜfisα:sα<>C{& {x}9c~9c|9c|9{Lpny:sq?Xrϱ=W _:s1:r5n8}ܷiFi\3x 9 9]9 9=999999c98c|-{1Ş^]LOtLN4HN4HN4HN4HN4HNtGNGNwtGNwtGNwtGNwtGNwtGNwtGNwtGNwtGNktFN[tEN74CN;tCN7tC9n{QpگpMy<µ_u:+r*r_>u%Qr(Sr:%Sr%Ur%Orz%Ur(Ur:'Wrz%Wrz%Wrz%Wrz%Wrz%Wrz%Wr?ꖜfififi/LX299]%99m 9 9 9999cu9Xcm9X[Q~?Z$Erz"Gr5^_GNc4FNc`^^uF^F^kF^OuC^7uCMǬi:x)")Z!rc:7zϛ>wy y y Z ϳ? {>6_ns}LG/B^/B^/B^/B^/B^+B^+B^+?s:"#:"#:"#:"<\~z#xyyglC5y.繜ry5^yuyV9uo^0 {l.s`&G1 NO|yYw75?uϙp + +zW`_aW`^exVYgUTOUTSvXURW6T`SM6T`SMTQGXTPC^^*p *p *gURENXT5F~|dWXV`Y]fU`VYfU`VWN8U`V7n̲ * *«ǜ{Mp[nU`W]vU`[Y^xU`Yo>n= ׎(WdYYEfUdVYEfUdSME6TdSME6RB-EFPdLE9QdMEyQdNEQdOEQdP!E9RH!E9TH#Es}Єspùa}f9UL K-E3#kl,.M87|d\3} ?3"L,2"C*n gcE6+CYddEFgE~YgEvYdgEvYdgEv[ekE/W9[djEZdjEZdjUEVSdN9E.PB E.PB/EhR4E~9_d@ь/Eh^4ߋ(~?ȝ"3(EnQFEnYQdDEFQCERdJ'EQdFEfQdFE^YQdE/Eȅ_4{ӔYU| SO?EySM7ESdN1E~QG+E* xTuqwȭ"zϰ"Ê*rȩ"*rȩ"<*ȣ"<*Ȣ" *2ν+?ƺ"ϊ+2ȵ_|\sE9g4`6 mmk\6k4\7wlv;1xC7 n0t `C7 n0t `C7 n|5mlw6 l0`M{geF|d/6ػލlY|ml] &mkK\6xfpmvk|?µ1׏#׷pG__ۏ;G߻\;^hCmh 64І^KZhC m 6Fk;7\64ԆPjCCmh 64Ԇ~OiC3mhg ]Qqk\1ykކ{zoCmhOy~znCmh ]6tچNϺmCm趍O٧6t߆}nCmh =6܆ҡs_8rNmh -6t߆}oCm 6W7n ݸ7tvnC?n }64ކpnCm|Ʒ޲Gn 74ЀpCnh 6{ކvnmCm 6t߆x {a^6ކ{zoCmh 6ކzZoCm赍ߚb&onCm踍?;&]64߆|oCm 6tކy:oCJ:JZJZJJzJJڭJJJڪJڪJJu6r=׽C^t]Iו> )N~C-ޒ-iے-D(1-}X%ޖB%^x_n#?r3K\.qK\.qK.qKl.{K-qK-1sK- G>{֖8\bm/zK-'K,q'K,q'KL-+K,17Ycau%֕XWx^.xXa%^s1a%FYbd>g^xYe%^Xb`%Xb`%8X`_y9Zbhxqť{K-{K-{K-1K-K-K-wK-`σa_NoҞm۽2˼/2ˬ/[p^VSOe>9WRSeƔTfU/elQ6OƄ2KL(3̄2ʜ(̣2[l)̗2(3̌27(s̍27(s̍27(s̍27(s̍27(s̍27(s̍27)̕r{SO?P?eSO?e֔RM-eRfK9eSK/eRK/eRK/eRJ/eRfK+e9RH#e9RfGn8ǒM8ǘo8Ǟ2{)̞2{)̞2{ʬ)̞2oʬ)̚2g|)3̑GCo97ww{;siڿM;<0}qg;9eS9emS:e}S7e}S7e}S7e}S7e}S5e S0eR+e R1JYs_5a'kL8 :m{=TemP域p^?kuEYODYKD7Ƭ昵IZEZEZEZEZEZEZ ڠz`?]+7fq=oM]+65ŦbSwljMm7ecSwlMݱ16so{9ͲM6S޿{ͲU6ʦV):eSlb1:fݦm{S={)w۞M65ڦFhmSm)N8A\;s-vԎqSmjM=@mSmnatnSm?:p36rԸZtSnjMA75ԫ:tSnM=7ԜrS_nM}/7妾ԗrS_nM}/7妾ԗrS_nM 75&ԄzpSnMM57u.[M͸7uNԉM/6ƦjM=6ǦcS{ljM=6ǦcS{ljk6M 6{Cc*#*Fca{=oghvh~藊~藊~藊~藊N葊hh>;9C*:h>0 +p +p +, 3+L¾ *̫gc%bTSaMei3*L£ *l0· *0¨ *0 *« +̪0Js̭³ *<³ *<7>U K+, '+p '+0 +p +zUV128׷ G#?=v낵Z*zeo[bؼ-6oqy͂Wo1z[lb9noq{[-6o1|]Ge3:[bؽC9-oq|[Ƿ8-oq|[Ƿ8-oq|[X-&o1y[LbX|[\6y[lbV-Fo1z[b-Fo1z[Lc֎> g÷-n1z[g8-nqv[o-nnqs[7-nnqs[b#-~ns[7-nnqs[7-nnqs[/cֿhY1k,bX-ox[bشŦ-6m}Ә_s~mjQ[\bń-&l1a [LxŁ-l1aݏ~ =~?N1{c}~Zf;~۶~s?{趭^K[ziK/m-;#Ӗve[lKm-=ϺjK{l-?kƬk- 3tƖ:[cKli-ͱtEMWtEMWtEMWtE)~}{4JM4JM4IMHMHMHMHMGMo4HMtGMoFM4GMs4GMgtGMkԴFMc4FMc4F?Y{:Cj:Cj:Cj:Cj:Cj:Cj:Cj:Cj:Cj:Cj:CjAjڣCj#HMԴGM{tHMGMwcԴGM{ԴGM{ԴGM{ԴGM{tGMwFjgl?S?TMctTMGtTMGtTMGtQMC4TMC4TMCSM?z7)<j5Vh5Vh5Vgᜆ鷚~鷚~鷚~鷚~鷚~nXu5]Wu5]Wu5]Wu5]Wu5]Wu5MWr5}Wu5}Wu5]Wu5Ve5Vr5V_5Uiiiii骚骚骚i˂WMTc{M/Ԙ\fu5>xW$5N8Uj55NxScEͼp-kjƚkjqƚO|5RcKƬiύO5TcP95xScPwG+XPC5`=j 1ƛojƛojƛoj5XSN;5XꜨ_;cpΏ:?Ώ:;쨳,Α:GsVc2Μ:s̩Κ:kΟ:Ο:Η:sꌩ3Θ:cꌩ3ΗuԙSgM1uԓwˡ:kwѡΏZgiu~Ygfu6ֹXXcuVYQ_ΐ:C 3ΐ:C ΐ:C Ώ:?Ώ:[ꜫsΑ:G 3ΐ:C l xQgAuPg@7&_MXIuN9QgK!uԟ9Ύ:CΏ:7 3Έ:#꼨sΉ:'ꌨ3WfԙQ=;s΍:7|·:|·M9uԹSNCuԹRJ+uԹRJ+uԹRJ+uYRgIk>s#n=kܩsmCyST\sΕ:W\sΕ:W\sΕ:W\sΕ:W\sΕ:K,sΌ:#ܨsΉ:'쨳Ί:+<-?M5uySP9Wp?uyT[3Ψ:ꌪ3Ψ:ꌪΩ:sΙ:gꜩsΩ:̩_^M 65`PA 5N; 4XG 5jd-Ƭk`N9 49X{54~djpjpjpj0j sa.7Y0,j sa~7f~ÜnpaV7y0Lj 4Fc5|Lo|j7F!xo70fzLolOX0mpn=w'Khhp h sa790vn san7톹0tÜn0z;9~G7xչ] ꣆6jh&lh]^ \ }WO >kƧ }~p^s5WCw5tWC5WC{5tUC75tSC35SC75tSCo5VCo5VCo5VCo5VCW5tUCW5tUCW5tUCW54U#k/Ujhj諆jhj覆^j襆^jljޏg's[{nkm͹=h֏Zr[cnkmM`&G~ۑt[nm͹A|~wO z^{m֛ۺs[nkmmQf֮v[nkmu53Kn7:v[nkmͺcuֶۺw{}̚&֞s[nmunm}3&nY6ykc]g6붙mmsm[?nmmn{6;S6-mfns7c67mn?{̚Vfv 3656Kmnsw 6ϘbgMsmo~یf6׷mo3}یf6󷙽mo~_1f+Gپmo|lf6뷙m~os||`#k1f;Ǭimom m` f6Omo~ۼ->8cИ?~Þqq}^;lkmö^5͕kWto97w'F ʶNf6Yͽmmpnokmoko;ww8dw7y;wXpt;0#y3wظnt;acwæ6jW;y3sL{~е?5{s ]qwtѵ;vG}sw4>;ZzG3h >g w4;xGhQw4FϺvG]sݭvG-kk&ݤWk6Uk>Okn[Ag-z_׮}z_ס5}z_ר5}y_ק}-z_ק}3~ o}}>Ku}y_wס5}z_׬}z_׶}m{FO? c[O ap ݿ>Cx?a1}>7 'ݿ>1w= ݿ> ?qΟ?Opk7?+M]>?<6ۿ}}q˃|8g`~~|OcO7|s?#}^p?{OL<' _5tp'׃Ľa~aSx??s>=_oi>w<ѽ'_?C0aw̟;Qqf=ߏ1~?vx{bzaCO=r}1<>?{b'>y=}8XQ1}?>8~m2Ǘ:Ŏ;Ut|?}ž5ts|k/q|f79^F;^>78k!;ep|+?~9~uP#Ck'?19~3v;^pǟ8qxUu㷦{#;;,;,U#9;\7/}5Ք7|oww }`dZ{1^Y{MoMVp-xG;8vu]x)xW{8n:^tG:49{sq\5w]3y53wGޛf쮾5{w]xwyټ 'sן3]Fn:6Egݼ#߮]s: aux}sG;!}Cz\f建g#k1a &Ϯ>;zgW]}Le\ycDzhW;jݯ ^uӮnKhW]vˮn-hWKl7Y?:iW']MvuϮA=Yj]-vF(eWj]-ov̮3zfW] v5ҮFHiW?j]͵3S cm?ܲn>q}O2}7`W_2z`WjW}nvaW?j]vukßtҮ=:dWv5.wn&hꆦnhjzZ:o[Ώ^9M MMMmMmMMm~jijiꛦij^iꕦijijiݲ?{KS4uNS4MS4M31oozڢ++91ZIz-jꌦhjijiꑦik&?Z&C m2%Lnꉦiꚦin4_5uS4y4M7Ck|ora#5QS4YdgMf6dfMV7M] ͏bh>qq{?aʟ#s_;?y~~Oϭ O^FS4uOS45HS4?o >떦jꤦ~ijijiꜦiꞦ^jjviꙦijijvijiꐦi꘦iꛦ>iꔦi~SphViꔦNijViꍦ^ijFijFibºvij&j&#lr#+?m&gn&Ûm܄s,n2^h&ϛ0y+5-v-Xz-Xx-+c֙bv-j--η8|-bk-^bv-fbv-fm-^bvK->Ã1-3e2[fx˼oe2[:cΙ-^bAoŧZ1ņ2[h1yѽlhqō7ZhqņZlhŌCZ i1EcgH!-K3-8H5-FXbG!-K3-`߷N%-8F-8bJ1-ƴO뻦;i1ŜZjqsOY ~~½:Z|lųZkqŹZ|ken햹2[vn-xy'3[f}w'fσ{ݴcM-6bVY-&ekqŐֵ!pu_Yz {Ǘ=k]{c γjU{csǜ=1g9{\8Ǯ=vlg{<X=iM{lc6fm|Zcǯ{ZfO==GtŞ){ZdOo=tÞn {aO}ʘO=tɞ~&{:aOW=m-Ş} ^tù/{zfOi=-OɞV){:d+_=-#tĞ{:eO=ݰ﫧M!4ҞI{:iO}Ț'{){aO7=ݰo͞7{fO=}ƞ({eO=ͱ94Ǟ.{,{cOsi=-EȞc==4{)twa{cwm{:bOi=`$5>u>}sg>Y}-5p'a_;k}þZc_kk}-}9i8w|FLynx=:a]}- i}'GrZd_k}-EȾ">yKYϲ}ݲw` ϴ}sm2<>[7aGl>ٷϾ}&3s YC#{}ӡ=F9׿gg{ww)\߇g>}3tlg>}yS)=+Ia_k}3ug.Cs}k}-}}Z`_+}lg>}|>}~>3Y||g>y}pٹ}~tNqߔ'{=pq?w ] ӾLZi_+}Ҿ.Gi_3k}ʹ=:lw]jhϯMأo}0=uھNi:m_{}'CuYks}N}݁^:P@_}uՁ:`z@wށ;sz@hx6D׽qyw.sO=iit}{|}C7黮}3{z&9x~` <x8\rY<+xn8%<j^]4g{@<3xf8p3Á>0?hNyC^~t?Z@}~>? qp5fȞ~=ߥ< x8r@|4gMX#&kϘp~3'Ԅcn8ysƜ \u1ϙpNfҺgp'҄ '?&ʄOcy:uY3ׁgM3>Z>@[xf:@hm~g}> 4=uz+iك_o<_>>-@h ^>x{}46>@+gm|4>1k@K|tugׇ>!|CqCq?i9jC{u8o=CkPSjCMq)5š8p˞wgPz8PcC=q'5ơ8P3jCmp졖= C 'š8Pw~1z vGɡ69PjCrOu!}?ǡ8#ZPp=zPPCr 68`=[hC-qaY~CjCCrz}CCPjCsl?ȋCO|:!wCŇ>3ӽ܋/Wx^Z␃>d! YxC𐅇,<"z{;d! xȾCK=xCNr򐋇\Yc!{ßzϓCA :d!yuȭC;!ywȺCNɘzr=~1c+5-rC=6L=dᵩ=d!{y^9emfjmڬl-~[S{ǸO+yu[+uBk6o6osS>6یo36ۜos6m36sos6ns6ns6o6۬n6O۬n6 o3v=zõf|mƷf|m m#wǬ=5rm޷5D[#Yf|g}mַYfwmη~m^yfzmYmzYmfyf_WgkT̡kj3Ϳ6,kͻ6ڼkͻ6ڼk6_۟mֵYf_}m\wk/Y‘5>fQ]m]wmYbmVfmfYfXm9Zu2ӏxrİ#Go:f?bS#,?2ӏ#,?2#3Gf~dGĂ#3Ȍ?2#sȜ?2p#,?2Ǐxpă Es1#G8/xqċ1{FϛG8bǑdG~dGY{dGfdGfcnٿ{9w.=G9tĬ#c:ˎcɄL;Nq_F1h;bwļYXvIJ#qoGYGY ,<13#N1Gb|#.GL?bx~5cF#kG?^2Gk#]p)đf85-qcFޘ}6zo}~t‘N8 G:HW#-q%đ68ӑ׎YG_8GH i#-p7u}j{}p±^8X ?68ǺX7cp'cp ±68Ǭ?f8ZX prn83u8Xcq-ű8XWx8 X#kcrq;_9>_߸oMr=7 豮g=zKOV=Ѫ'D_}y/O剶<і'iMg=ѧ'D hxO鉖<є'Dh=z?OtZzZrdMםwNމ<ѥ':D?h=xRzN≖;х'zDϝhw}Nω9>'DKh-uNԉ.;e'pNtى.;ф'DhtNщ>:P'Do|Os֔t'>;xG]k>M' N>1o.5_5O)ϐ'wq3qw;?.wD'8>9r|/p|o9c̹;>{us"y/9CŎ/r?/u|+_rrOpwǗ9^x㫦;;q|x_ZǷ9҇;{/oýYySΝ2q;e)N9z ySV~{)8Vο-ndσ]o{NvOtIGt4KGttKGttJzS:[:W:ڤM:ڤa:ڤa:U:U:ZS::3::O:W:Q:O:M:ڤ>źh脎h莎蚎艎;p;\0;lph&hF膎n膎苎PG_tEGtJGttKGto?1}:~,tjG;vcG;v4`Gvt`Gv4dGv4cGucGu`Gu]Gv4`GvaG+v4dGv4`Gu^Gu\Gut]Gu4`Gut]Gu4^Gu]Gu4SGutPGuPGu4RG#u4RGttQGtOGtOGtOGuSG?u4WGutWGwutW=|н-#)o}mw=s=iqu}[w}w9c밎hv賎>蹎谎.h^赎ffjv蒎.蒎-׼kFџwb}LXG7veGv4bGvZGu[Guۙ:R{L[i3u?4ٛ|ago{ϴ™^8^gZLgl?c3s#NgÔ׾еO}~!ɏ~·[=9Mb{ޣeʟ?ܰO_i3|ϴ>gZL?3m}ϴYt̚^>gLk塵ȞϺL7i3 ~4?g[n9_F?gL3]sδ͙:ngLi3vϴ?gZL˟i3tf: QwܯYg|':L+Ly8ӾgLi3{>~y}ϴ>{g|g3~Ckן?ϚG>n̾g?1cy=g:L3~?g3o9S)x8sù8rnswpu:\ks{uϵ&>\ks zquN=ש:\sMza 7^\לsM{i59?\ksmtεҹf:RZ\Kks-uε:[:I\ۜksms5O;9ϙwγsg<;99uΰs3a|;9 = <9Yt΢s3?̶sml;Y7s?7sƝs;goo#{oiWOϙvsu;g9 Yxδs_ų?.xt ]G<`.Xt ]pCl`.Xw FOί .S|Ͽzm=or#u.4҅?B\ t.ąOCŅFB\ }sc.tDž& #t̄s -rO.4˅f,B\h r7.tȅ B\h re.G rQ.tɅ E=|g.˅.B\ r_./4ȅ,B\ rW.\ ss.tŇr5g#<}5)k؅>%B\hg }~{=sC?68Ӆ&$B\<7x,B\ Msg.ąnԡss6z/mr7[Ώ^`]\|-׾`kZB] -t.ŋƬ ss.4΅^`M\|i#8ا.bֺEzB#]h mt.tхFCB]h t.4х>GzB] mt.х^KB\h s{.tυMB] r.4Ѕƹ4zB]h msa.˅~>r̺fB\h -t.Ʌ޸zBo\ ]q+.tŅ%:BG\h }q%.u+h -q-.ŅָkvD#]˒5߻f{lkw|L]3ˍ޽察p'|p/Ft|>׿-Sn}oMywo1ri998^?כ;yo;{iS>{]Z]mV]mS]^]D]T]MW][]F]mI]Q]}G]}S]T]M]✦ꩮjꪮꜮꨮjjjrd]MU]N]S]Y]Md]Q]]]}']]U]]TݳΝN8ǺzgQz:}ڧ}ڧY1^t1YuuOWtMWtuQCMWt5OWt@WtNWt@W tCW;t5BW#t5DW3t5QWtuPWct5JWtuAWtG]wy}WtuDW_tDӞ/x{4KWtHWtuKWt5GW{tuHWtIWt28uSxsmc:iqkZkgzqqkkkzgzqki:gSqڥCJWtMWtydW5+];]2WMڨoo{?kn8?ڪz#fߍ|~icf]o3{1#k|z1DŽCzkf1&鄞í_j^ 4%/NR\jKp+.uť|;R\K=q1.5åfZRK\jKq5.}~Kp-.y}K~_ d%/9}zK._rR\R\rۗ,3|_ܿ%/K_2՗27Ş{~K_K=p.uYp[7eC.9zK^|%/{K^rїd%7/{K=pU.φǭ={1f5^r×%/}Kn_r%/{Kn_>cs,d%/9|K_r×%/Ld%/}Oc0,%.tK^^2񒅗,d%G/Y}95};w5Ss}Cw{\;.u>1R\K}rO.ɥ>'R\jK}so.ͥ?zR]~#\Lگ{?|R]H.5ޥƻxR\K v.uԥVR#]R.uޥFHzR]jKqyR\jKt.ѥ~X;W\ˡZruR]=~{1;~ivN78S~O1s:xpnrn70oҾIם/!:zzzڻ:ں)G.&kFkn6k&kӂW}}} }=}}}}=}}}m}m׻}׿}}]}}]}ף}]ק}׫}}׸}-}׬}װ}׮} ת}׮} ײ}׭}׮}צ}מ}]ס}!e_cf_sg_h_i_ud_Oue__uf_5g_{`_a_'b_7c_Gd_Wh_cu`_ua_uc_Ob_5b_R_cO_A_G5E_Q_?(x}uA_[5@_KuAgMI}m}9X%CG_9my}ya}ye}^G_ygj}c}Fn}}^}N9?9rḠ3+K,s>SLϚ>\ϟ7Wfj;}o͞73\l};Yac>co}ofndg}sl`csk`~ ̱y6x͵60f,km𖷬}sg`6 .x#kfL3k`f ̬50,Wj`^ ̫y50Oj`V ̨Y50Ssj`N ̩950fU3k` ̣40[k` 2S1fal` #ͬ50fLm3n` ̼y6h gsm` ̹y60m3l` ̴60fOXwo` #kWgsq!C?p` ̿980|p`Y80 <{sp`ŁY80sq` y80<mso` 80fsf<r`^8fsq`NƁ70}o`ˁy90/_y=|3s`~ρ990'sr`NɁY:0?flr`~:0Cssn` ̿90C\3n` ̼70f|}o` ̾703٬un`&ā80 fS3l` 70s)yĽkN+3L2w+z_ey=oFWfY~e~_Wf|e._WY{e_Wf|e~_ӄu3L2+sܾ2w{r\2߯+2ϯ+ʜb~e_W~e_W~e_Wf|e6_Wfe_-Y3ׯ+s 2ïpe_W~e_W9~ef_Wf~e_Wf}e_W}=܃kjc;⚝yp?]qWlbF֎F֎5WCqC9qŁ+N\qWb#pŇ+N\=c3OpŊ+f\W?pŏ+f\1 Wlb;qōY>}=SXqŊ+V\Wlb#rŕ+v\W"("(8G8@sܙ:&m6I&ӴM1mӴIQpgQpg]gnc?g}J~afafaVUOVws#w8r-wrw13[[WpWP+wr)w8s)w~,8faaaaaaaaanaaaa1{Y|,Ø;f3}̾cf1w;ay~<~{̽cᘙ3scfťk5s;f嘹3cfk< >Y3cq<18f~cc4ܬ1s4fԘ3co}=1⾻{xó>=73^~>~}l)ƥb=%tΩb̊*ƣb<(ưb)ƦbL}NQ1xcW]1VXcUO1cTY1CE1CS1F3cL1$Ɛcbq!׾f5XcIC|~ch1^1&ƔSb< Ɗ+b"Ə[bl1'Ɯsb[K/{{Ug1cSM16Ÿ+ X]S1nc[{1~VW1ŸcT[1nŸcZi1^;p+1cN91f8Pi1c]y1X;T[n=~wc^y1ž3rb.cj5>x^1xb1fƸca1.X`1cc1&Ƙcf16b1&xb1.8`1c1^8ǬYgW4ce1^Xca1Xca1cmߟf?{G8Gs48[l28348c㌍q^8̌3387㏽~=}`=A}}}@}{YqqřgZqƙqLJ>?17>q^gjqƟY֞q58W78O,s68g㜍8g{=s88[s88|9{XО ~w܍=8W|;8㌎ϵ78㌎:8㼎30nqVǹODָ_qyOGB> 58g㼍38K㬌28+㬌s48+㬌28C|s38܌s38<08'̌338⼋s'λ8<(Φ8܊s(ή8슳+η8|3+ά8⌊3$Ζ8'Ο8l3(Π8<,>nyXcq~_:gYcqvřYgqYXcq9[oqZkqygXiqvZiq9YOq^yWmqyE[Cnj3&Θ8c⌉3&θ8l)Φ8l)ѳ {s$`QEw)an'xxpl&90{frLN 35a&9x M'a'0{|O 7a&҄0Kg kfq,N 8ȹ0fxœM s5a&لٜ0folM 6a&DŽ0fi,M 4a&ӄy0OiLs s.a%քٚ0f`\M s7?"L s5a&ڄ03k|M s4gB3б0[sY0Wj\M s5a&fr¼M 7:^ 8a'0flM 8a'90pL 6a&ڄY0kfmN 39aF'=>>{OĽؒ`K- $0Op!Hp#?ZcI f$xM f$F F$`F $C >$`F .$x`E $>~-;!ro o3ٔ`UA >%8`VO >%P[ n%`UC %XSO >%X`QE %z1,Oz?I%ٓQYI%f<_Aɇޗ`[=\y{1žaI&YdeIN&9I&oI6&yeI^&YdiI&YdcI%9dcI&Yhco$&9fI&nfhoㆽ#sp9$,Jr(ɿ$?,K2)yE{YWI%ٗdYI%_I%XcI%[}I%ٗV[In%ٖd[mI%ٖd^ cI^&>k\Lr1$3L\ }9jI&-r>gqqI%b{I^&Y߉\aI&9bI&ٗdaI&8'{-eVg@7{N1.ɿ$璜Kr.ɹd9n&9djʜO}{}ucS,Nq?S L10RJ1+űRlK-ŶR,L/ž S,M17{)Φ kSMq6cSLq6wSLq3OS`)NNO^lv"8fk)8`)xi)Fn?)~g)z)Φ8bf)bp)6n)~>`)^s6/SLrRL13S\L27S,M11#SL1T=Fxbc|L%tsؐIgR=7bػ:SRLI1%}`޿򜿍ǰR Kc5n=$ Ǹ6ƴ1ƍ=487Ƙ1ƌ1c=c{4Ʀ11g9c :uqk[c:X4Ƨ1^j;c<c5ƨ1~k\{bpk|cƘ4Ƥ1Fk_cƸ7ƽ1}ϱϺ!?|׽|ϧ~Λs.cbLwi1 04c_0!=w煮k11Gƴ؋"/r]i1-2SƴɘN#czdL"*ccLi1}2O^Z%cdL1=3rM閱=:fLӌi1kLӌ13gt͘3czgLKi1]1Ƹ>\w냱uX51Vg]{鞱Țۈ9$ccLi1}2C4Ș; 퉮i>ɘN-ca9 >/CX'i10!t쳦54Øvczb;}{޽wεʘn0ceL钱12_t̘*cdLiWGε͘(cdL鐱D/ZfLr~Sӌ12e:7c:2c::c:?c:gLߌ13k3g4Θ7ccL{5t.SCsA;iw}4q}1kY{Ȁ}_;QƵʸv-:e\q2Euȸ.*Zb\WkqM1zd<}kgjqm4ak\>z~}5Ayk볦O4uԸ\\g8cY;q3xe'O+?y=eq0#5Ÿ%)tq5Ǹfb\Oq~g85,8y>E# _<3ø^a\+kqm0Ƶ./rM#kq0ƹ>q֏3#r)Ƶø6y\ kЧ&8?q8Y=q^ϻkLg89Ǝgpz8{9;qƎswGCg8s:qst{~}|8Oǹ:W7qn3z #Ə3ߊ߳ N7}yni#}Ӄ{۟ߥ u߸zZo\kq7u޸wo kq7ݸwmBq=7܄>]zlB{Mh^;:C6c 6&tքNZZkBkMh 5&քGhBL|@c&ʄ.9:K:>(r]L m6&GE5#kzhBLh'E5ф~&cBwL莉>Ʉ6&dBLh 3SLh 2K&tʄ6&dBL ]2E&gX)eB{Lh M1)&4ńzbBOL艉/޻~ހ_ٯk&4ʄF"ZdBLh!׾j5}3o&ׇEzgBL 3u&΄֙:Zg":<gBL }3&Ø=ZgBLh 3u&΄֙:ZgBLh ]3q&̈́:eBL 2_&V\L =3O&Ʉ>"dBLh 2Qc&\k ߺ8~4`s҄CzhB+Mh M4&΄֙:ZgBLhmwj 4&~ 8Dο7rȹ_kBM 5c^zeBL 1 Lk57\īܫ&7&4įkwuįkg{ܛބ`&'8~3{7G|}wQ>}0F`B#LEhOCZa/?zaBL ]0&6 ]\/Lz_Bǽ>`RLc<bR7LI}0# ?,BZbRCLjGG?8dd}#obR7L ?.3` dRLI15&ƤΘ ac"O Ĥ?)r޻1&5ƤƘ":cRgL>#r;&5Ǥ|vi|jI1;&ǤƘbR_LI 0I&su-1&ĤF:aR#LjI0)&5¤FaIOr~/sUs0&u$'?I-0IO~$'Y?IO2~$'>IO2$'9?IO2~񓌟d$'ٯ&d$'?IOR?L>Ť $'Y>IO|<<3vd$c'0:SbJGL)0 ?)O=*3pM?lȵrCiGeJL)194ǔz̀쳮Q4ԇGGeJLi)m2[ɔ^(SdJL)]2KȔ#ScJ{L=5 SdJLi)179V\Li)2C4ǔ֘S:cJ[Li)}1-9/$SϞg}ѐ}EsX>g_<5ܔflSmJM)M6ɦtԋ#ۀ=mJMi)6SM)6SMi)6٦4ܔ~nSmJMioq7GN)iJM鿩>k}tߔ}SoJM)7#koJN-ww]3N#┖oSmJMi)6զڔVjSZmJMi)6ϦJ[SsZ{WYjE6qm}[=~-޷qmwoIn3yg2e;˔w),SYLy2}cʻCw2eʻԷG>x>ރMy3f;͔w xĔS+L)]=Syu7S:]f֮ӺuZNki-:E ?v{촞ְvCvZNki:_~֯uZN?q'puֶiݚ֭iݚ֭iݚ֧i=֣i=֣އYӹi=ֳi=ֳG5hZ{uiZgZiZ?kcnأiӚ6iӚ6iӺ2]4/:2z1z1Z13z1Is֏i֍i͘օi͘~f1)8910m'o&o&o&o&o&&,s:'!4PZ5PZ5PF4QZ5QZ5OZuQZuMZ5NZߤ_뚴I뚴I똴>I듴>IkFIk4!4lL3,Ͱ4#ӼI&ͦ4slIs'͝JygGw|iNYtiytkN:4ӼN:4ӼN:4ӬN3;4ӼNOnfvi>si>fti&fr&fRIi&YRKi.RKi.9|I%͗Ts=WYZGifPAiٓN9i9~}AiCifQ=iy~c5&1eS=~dDVdXK^dXaE3la f0Ä`1g80Ä1g1g7,sڿ[ os?Y>>1s{͡2?cIϽן6u!)?w3nF6f4ی83`N3iF3{ftόyZdS颙O :~jp}r~]5f4Ռ=3i"g > ?s}:h3kF|Nftǟ:r3:nF6f4c6e3sftΌΙ93mFh6fیvn3/rMhM7f+CnFh=7fXz7Eִ̝>qF78gtnnF78gtnэ3qF78:ֈ3qF#h8g4р3pf;t:օ3qF]8 gt.т3oF7s٣gN9s9 ї3rFShM9)g4LwzϺѠ3tF93gtΜў39Ѡ3?|m9-g匶і3rFG-9%g䌖ј3zrFO=9'g/Osh97g~%ԝ3sFsh8g>ђ3qF#Aoا#g~c}.ѥ3tF35fƌ֘3pFh19f4nj3cFs\Fe,f6˰Y2hc,f96˱YNβle,e,fY6˲YͲ}e\μY1˰YͲkG<,fy4=5`f?< 7C}Hg^g,KgY:Y>),g7ˤ٧7ɑOsjc,f5˳YnlW,f5˥YN2kB猚e_,f95˩YN2jQ|e,f3Ցk-tI_ڋkyWy^7˵Yos/ >Y7˸Y2nS,f4ˢYgG e,f3˟Y2˜Y2g9e,[f93˗Y̲e-\,Of1ԬQ|Y-5fuԬQjVCjٟG{Ud ثf5٬6eZkVsY5f֬ޚZ >٬\ZkVJpfu׬NT:hVjY-4f|jY=4fYHxTjV?Y4f"8[po YX{jY5fu׬]CdsmNi9M6t֜ΚYs:kn>< aӂs:oN974w;7ђsZrNKi99#t7pzsZoNik98ߜӕspNi9 8ts:pNi9 84zsoN974ߜӈs4d=7=gwQ~~ӯsuNg9}9 ✆ӌs:qnWνagjܹ7Fw]Gߥ4r5;y֝szw_k9}<&Y͛չYmճY=YMY]յY-՜Y=ՓY͙զY]ՕY]ՕY]ՕYՑYՑYՎYՎY͘yxjˬ~hdC">ѻ_fhVf5hVf5iVfhVf|jҬ&jҬFjĬ6ĬNjĬFjĬFjĬjj꼬꼬꼬꼬꼬꼬꼬꼬꼬jjjjjjj;7n }~޿{׮YݚlY-e9iYjY-RY-RY- 뮬jꙬ Y]5Y]5Y4YM8Y6Y]5Y]5Y]5Y]$Ҁ%;#9ȹꏬv\YYݑivgq}z$5#7z#Oz#7z#7z#C#9#9gMd5GVd5GVodFVodFVodFVkdFVkd5FVcd5FV_d>;[|B-7|O;|W5g~s֑Y\Y}]Yݕ]Yݕ]Yݕ]pׇܣz-ײ,*z'i(k&7`]eNVdN-}OVeQVd5NVd5MVdNVdNVe5pC:h^Ϳ{{{GA_ky:Eןs^wОDžD]{!׵4]{䀟}o~{޿Ϛ|^Ky]=uz^Wkֻ磇\뷮uN:}^y}>6z|^ƀ=7]{Gx~=îtC׽s?#tSEA{>yg{>3켞б׶vC:w^ky;q5sky;}׾w^ky;{5֝׺z{^{ߙ׼^y;u֝׹vEYz|%9~~|ϑ =~<㦟e߇wy={{3g޻ϼwy>}!=g޻ϼy;w{3f<>ޟ{3gѼwyHy{N3f;|uȵ!׼#{G3f޻ͼwy6y{~3f,a lX4E|<_4>Ãy ons{hpϣ=~~#{^pc\3 ?5âfX ZaQ+,jE !u"E.2v^>ן }jO J'?3tI{lkxýîߧ )C?O >3"OO:jQG-EuҢNZgӢ~Z|^s=ᵻ4עZT5֢ZXkQg-ϚZ^/pӻעZ_kQ-EעZ_ZkQk-jE֢ZL{ϊi/?[{nQ-f㻟ӡtu8ԃoQ-jE8`].\V\ԇzqQ#.jE 5\}ZpQ-jEݷޢ[|oQ-Eݷuޢv[nmQ-jE}٢6[fϽ}3tݢ\ԚxzMC|{Q|{]F ߧun^͋yQ3/j u⏄hE-*t5^ԋzzQK/j+8ՋzQW/_ E-^ˋzQ//EV^ʋZyQ#/ƃ>{~^_z}Q/E5^{Q/jE 5_jŷO/j >{።r>s=s=s1s3s:r/sZ+r:6rz+Gs+r+r+rz+s+1s+r<ڇ r,r->:.r,Yr:F9 V99 9͐ 9m69ݐ$9 {ƀu]9ݐ9999999>k! r r:!sL1=>q=r_u_}\q9s\q9sL195}8t9Nc~ѹd7 X ] 9؞u9V縝x9渚i9F174ZqȵBp}nsC oеaw9}9}9}9}9m9uBN#AN'4BN#4B9sLʱ7ǥr<)ǧr|)ǧr\7Ǧup-:rq=3s1,ǰr9VW9^cYa9V~Ztrζys 10Ǿrq/ǽr˱.Ǻ/^{9帗^{9ؗLwCk9W9XcUi7\ʱ+ǦrdTQ9F>k1&ǣgrq&Ǚgrq&Ǚrq)Ǚorɱ&ϙCUy乓N;y䙓gNcO?y乓ٔQGy?0dR-yK-yN?yows'ϙ䙐gB y&䙐gBP 7fzLϛ yC~ϛys?oy7!zvȵn}krk~u}w+l3*Ϭ9dc.Xb&Xx ן1K L- \,p |+|qhgbgbog[>{3Ϫ .p .0 .(—^x}X]tӅpZɀֵBA4AC냂>(h6(|SxX7tCA7tCA74CA;tCA7tCa&8 Z c PC k/p -iIK3}8ĩ%Ĩ%.-qiiqzoq~痆|GZr;ع%~.sK\bCX%F.1s gϞ,&/qxK^bx%/wK,^b{:c/}s%/qxK ^bO%^.rK?#{{߭%ҫ]~m-ҏyFȀ{߽G,x{tʒNY)KdI,%UtʒNY)K:e~Y3KfI,%-ct#ko˒~Y/KeI,%ݲ?%]k̒Y4K:dI,% 1?6_Y0KeI,%{s?FX+j(j(j(nz /2"Ë."'z#wcF{Q EP LJ?*8E}QEQ EP EP EP>뺡}ֵEQO9_|E=Qd}O(ꀢ(ꀢ(ꀢ(ꀢ(ꀢ(ꀢ("/"/#2^QEmQE}QE}QE Qůk(ꇢf(~]MdM{HQwuGQwuGQwuGQwuGQ[5E1k(ꉢ~(ꇢ(j(C=11/"Ӌ.rrE_dyE9^xl=梅EPwE^|E9^lDִBE^d{E^zE^dzE^yE6XdsE_|_hϷ Ccе}-2"O,r"+2ȼ"<,Ⱦ"+ȼ" ,v1+21㊯J<|u_s"L,2"'\," ,,{Cy:;,2"L- "l,",2"={x`L\f2e&.g>g2'9eV.? pQC[3e.s\1G9e.3s ]27'eV.sq\\2e.o[2̿e-3r \sFe..sq\\2̦e6-iMpY˼Z2y̶e.i:ǖ9̰e-3laϖY_|Z2ǖ9̩eF-2d21t̬ef-jOn-sk[ˬZf2o82̰e-k]Zf2ٵ̮ev-k]LYɲ0kA}Ne7knQ~ 7|g o~gD˚hktҲY7:eY,e=Wʲ^Y+ZfY,keͲ#5˺f;G|Y?gY,eϲY?gY,ke}o5ɲY%:gY,zo=g6&_sG{7 ὃ˖Vі5ڲF[hm!ٖ5ݲ>[g˺lY-?Q\-eͶϖ5ܲ^[qZmY-eײZ_kY-e>XyShV4׊Z\+fE߬}VՊZ@+iEhͳyV4ϊY9+:gEhuVΊY:+ZgEh}oVΊY8+gEhqVSO ΊY:+ZgEhuVʧΟZ8+gEsVtΊY9+:gEˬh-eV̊Y3+ZgEϬh [V4̊vY}ɀkgEhqV4ΊYyŀk/rCdȵ}jEWMVtԊZT+ZjEKVtԊZI+:iE'V4ҊFZ|*8\kmVtՊZU+sVt֊Zbe)rV V VX©u6h0m+\[9]p{+[ V½lc+[؊~Z V8-}n FQ5ʞL_a WX'W8px+^ W~8t y+\^ʏ"tVz姃Onh+LZ V~V«^jW+Z Vش¡iK+:s;J;J(i( %Q%Q%-QZaV)i(i(i(i(i(i~(1#K,'K>KZy'^ƀϧJ{y^ZJZJZJ:J:JJZ#{ZIϕ4ZItZI4YI4YItYIXIw~6tJ:J:J:J:J:JZJJZJZJJJJ:JJJJmJ:Jok6*б)陒)i)ҿE/uHY5HY5HY\{Hk\{tKY_uCY9_fwe&\fwe.\re&?$X{\de^y]qeZfoe~Ygev9'S2[l-Cnj-32cˌ-32cˌ-2O<-2O<-2O<-2O<-2KL-2O<-2S,2;,s2?,2?,2?,s27,2\,s2˱CI y[oeZfmeƖ[ke~YfdeO^fheZgesl˲W6f\ٌ+qe3ln9Q6\eBfil.ViIJyX6a2tl6ƲX6c٬+uel֕͹w]ټ+meslͽW6fe+we3cW6f_+}elޕͻyW6f`+b+}el;W6^ ,{el;W~c YX6 fa,,el²9X6o $f6X6e3}el6ƲX6a|,e3VͷՇܪj֭ufݪYjFwݪYj֭>"tl{fުGY\\5WUsq\5WU3pByjyjyjέqf9jέf#ߪj>=8~jh \5WU3p \5WU3p \5WU3p \5WU3p \5WU3p[5VͽUso[5V<7\!׾`uul]5SWUt]5CWU3t ]5kW_4 nXȺyjëׄUsy\^5WUsy\^5'WTp߽nBUu|]5_WUzՌ]5cWUu|] 몙jޞ|=}"kK}Σ#fjfjYj7[}{9ǪU>jO|Z= >9ʧUN2j:*VʧU>iO|ZYc*VʬU^jWZ*VyʫU^jWZe*V9y?z&VٷʾUo}[ekC[e*Vy:3W_l\*W-8f*Wۡc6q\\*WU.rq\*W9U2oy[e*V>?L2t ]e*CWU2tg'C/;׸5nLjK{x5֮was1w}OtQ'W׸5sk]{l䜹k qvk]kغֵ>"ػ5wk]g׸5qukl]{-yF5Vzk^5F1z\cs|k]>/5q|k,^X5yK3xk^c[غ5uK"k]cSט5fq-vuή} ׿_sr7;gk_k_״x&Xk`Mil\i5}k_c׸5Nqzakư=S=[=|]ظ56q:+vܷ;侽!j5f1{k^cX5qxk\U=9=|sh85q|k _cW Xgט5~k_ؾ5f1{k^c5~.X5vjk ]cG8"k_cg1xk ^c51xO1~k_cט5quk\]W׸L]YuƮ[]Cǽ3w]:kٻG]g:kYu?*uήw]g?hzo^:Cٸ'Y{J5n|?~Za}9r+uźXбX `}'d:us|'u5v2ZskuN|^g:Yu3{^g:yu6]C׿o=k_g:uίs}_Yu3_gk볮ֵBz`]]ku Yֹu)X轿9:a]'u}>X{)5ź^X za/#oyE":~K^UֵʺVY*Ze]ϺO ͲS6CBǺeCl<4tS6tʆN(dClh =S64Ɇ&$:eClh }%6Ćzb`7{opG 6j - vo{9g7X o| ]5'OO'pZbCKlh -cCcl }/6gE4džzcCglh 56t#zbC;l ݰ6tÆn _:䚦bCKlh 6K"/k m-6ņZbCCl0zCSlh fozCKl0{lHǃOo0{7ؽ nop{#:_ γufo|+ȵy1 o`7 no\8w+w'x6V<}~a{zϪ =z{C{n{=wnF}{/:hClh k6t͆5fCl蚍kzgCl蝍o k ݳ{6tφV*ZeClh }W6̆f,eCl }K6Ȇn$ =U6ʆ+zeCl Q6^wfCl =5d㷃 k O6Ɇ>dBǚcCslh ͱ96Ȇ`v cCwlh^-6Æ~aC#lh 6{} =aS3lMݰ65æf|=}twMn9ž09}zhSSljMMI6Y:dSlMC6uȦ!hSlj͏ ?:8$dSlMC6uƦ &75&7Mor}뛟ZgEukMod煎u:`Sl258~\'l>/Mor:`d&7ٿMor| |qhk_Zid_}^Y{Y5ݰ65æfwO6æf ZaS#laS7ljM65æF`3:|f.t'7əMldžf%8_3iLڬYɲMNm2|&6ٵɮMvmk]&6ɦM6mrkOLd&69gۿytI-rg;+w56Ʀa"?:}M}/6ŦbS_lM6¦^ zaS/lM6¦F `7}]Ͼnn]6u˦f*:f4̦/zdSlM=G6Ȧр1{uΦ9o kMͳw6˦v.>>Z^%md=4{=t[eK_li-w]([zdK{li-?ǖ[cKsl=.![:dKli- 9tȖ![cKwl-5tǖ![?Ϻ#[ZbKSl鑭OΟJp>kψ=;rMȖ6ZdKl-U4˖v0[22[fKl霭ZgKl-ݲ_t̖5[Ϗ\>5͖zApXsli-gtϖ3[:dKlmɖ6$[dKl-'tŖ[cKli-[˖ي Glo/wߕr-ƻionğp{L -4ؖ.j[Ֆnk[mKm-Rjoq6?MeKl閭z\li-=a̖q[hKli-a̖f5[fKlioq6[kg-|nY[ziW" E }϶4ԖQ[jKom-}~=wg-ѶEuՖVL[iKOmi-m֖Fsӳ{ؖ&f[38hCUtRE/UtSE?UtTEWUWEgUVEU\EU^EUz ^z{\;V:}}w ?VE'TtBE'Tt]EUtkEUtDQQ:QQ#MSپa蘊x蔊6hN4nQ~GV Qй>4#כwkƩhƩhed*X4MSGVHTbS?S=TQ S'}R'}R'R7Q!=R%}RR uAO}P]QPQ9+z'+s +:*Z*< +,e=}w钊ި0 S+L0 +p +=zp3 f6W9́m_ W+->Mq5ζ6h[mkmݳmmo}|&b{'Lf6÷_Ƕcg݌uos=]q~-?Ƕc[lm}5gwZe[lkm[/oϚn/Zf[lkmuζ/e[l:t-:f[lkmu>ru7\{#wk=i[/mkZi[lmccu̶62ۿ9s=f[_maXmkm_5ضd|mk^hmʹ5Ӷf^ UPIUTIU]!{~3>3tJo!WUoURUU5\UkU5^UUUU3U5Po\r*\ꨪf2*۫2G[*߫|j.ꂪ.j6ꉪjfjfjf9cPUPUMPU=PUW_UVUYQeE)UTRU+UTReQEUFVYeU~VYZehUV[erU?TEU>W\sU>WuFUMPtUmP)UmR.ǟ~|Q~(?׿v~ho?Q{ǿ3aUUUU'U&U&U&U.U.U.U9U9U4U6U:UBUBgйwȪƪwªwªĪĪĪO#  ?|5coUoUtUsUxUx_pݭݮ]]꽬=ݮбwFos=]}}]==]꽰=]G}?> aɃyt|ߙ;WwxWλw;;޵w'x>=y{@/-5s59zλ yߧ7<?ۃg܇G?]9g =y?BGx>ʟ#0>ԟ烃}3'#|q<ٟOI|Bpsl>ӟ >ݟOSy?<ݟT>ş<}' ?__񎳣w4ј;sGcCaGWT}pG?h1wtѝ;ZtGhmwfp{({}z}GSwt;:xGhݻw}Zy`,-#7<'n~wyo;~' ^;~GhwtN;:~GhmwίF~-X;{G;:xG裝? hvԎS;zjGh]Ý^Si s]=rȹz;oGh]]6gYIv6=} ?2tYv5®~Ua?:89kwY] v]2w˻wZ`.w9ˡ]2oye.w?!{>1!yR𜧏Y#.Owy]rvӻe.wٹύ3se./vy˭]nrf<.w]~ـL}k}}ɐ/axG[|}Wl.w]~zѻe.w9]Fr{Żl.wyݙѻ1w]>Njq!Xg.w]F2zk}ؾ5M5wY]r~׀.w9]r{W]2oy=sole.'w;ZC{{e.w.wwYm}ֿw˥].riK9.v0.w]6Аurmke.v9˶]nu?\ .wy]6t C1r7G9\}Sdo xwoϬvٽ]Qû.Ow]2~e.wx=Ih>?o=\w>=s^]מ&`F^u;Ktמh{lOi= >{gf{zmOi=Mܞg{lOi=MuݶtڞFf{zmO=՞v={gO=-C㧆ўT{:oOi=>mrM7==֞^{kO=m_O͵ 4&R{:aOSi=m՞I{a+_:{:aO7i=-%Ş{:eO+} {&~-2x> 9>W ݹg~yQ"ܛ.M{_g.{oO= #kӑ}qO'i=]fOݸt&ӈ{Zo|=tݞx{pO;i=]4vy{:oOi=WpM5ܰ/g/ޱNӉ{rO_=}tFӎ{rOci=͸!➞m{zoO=ݷ 5w -sA냾w{Gx/5 Ҟ.ӎ{sO=}>Ӈ{uOi=ͺmힶ{g|'?NY>?r={{O{n4{)4U{mO[i=՞V{jOo?p{=ثwk~Y`=O'=^|'{ÿǰߡWWtxMtxM׾pYn5]^5 ^5}^/ Vi.iߚiN6iiiiiiˆs5=Wy5MXӑ5=[Ӓ5\Ӄ5XйFi^鸚iƫiš.iZ_r=3k}{y=~Q;l̐ ~`OSִoMtn͠iКfi֚iϚViךFiӚ6 ]׷5][ӭ5Zӭ5-[Ӳ5ZӮ5ZӸ5Vӡ5ZӶ5WӤ5Ww5}Ww5}WӅ5Wӏ5v]v5R?5mUӇ5=T54G5_cM Դ@5P5P 5P'5=Q5=QMtFM^99k邚.邚.邚foO_ԘTcRI5nոUVy5v:jƻjk<ƯZ-ՙ? {~,c[EuUgYeuVgVYw:^{uvWgYi β: sζ:<ζ:,ί:ꬫ3δ:unRgR}unV7fx u:\u_X3OyXCON]7xݬu6y\7q=XRK N58`VI N5`To0a78`KE v4`G v4`FnCŐ0 h0hpgi_|i[liƋ36xKF|f3|f3W9o̗>gowߧg}}x栿Qakhk訆jhj,5WCs54WC75tS:e ]U ^ \ 6#뽽[5mV ]e ]e ]e P5tYC5tYcr l =dV\5[C5Y: Yn Mj \c54VC5\C5wk~k跆j讆khNkh>k賆>kh? ?9׉ Ј y u>k轆kƯG5[C5`C5~38t Ђ7ZC5[C5t\Ck5t]C#54SC_5tSC75TC#54QCS5QC'5RC754M4ڪq{:44Ѿv+:j_k}MIu˾ :b_Gk}/ǾFc_k} az{ݯggϹ?#wqгn{{̇g3½0=ޚ};{/b߻žw} A{'=b{ľ};{WjpY}{neɾ}'cnu7#{W=f̾Y/w}8_=d˃kz׾џ <㹑gDy ||;Ͼ}Wޯ6לž٫9n~Ã;:x__k}i5״v_k}k}]M7;=~gz@=s/ǁf9':о/GG|{w>^=u]4Ɂ8`s{0!}~?{`f>03>0,?0&t|:tn,8`3l?0`)tn~`3?0,?0>0>`?'z/xq~p88p 8`3L>0s88pp;F{˅.<~S8rp]:`v!C:^;W~נ{~:rϯx{y[у7~_ =?9h0>`Qs{e3}<^>ߧ}٫1Á~08@CpC#kPjC?N8|tu]po޳4\P;㇜?!?"C\й~8OsPjCpC2O |2i1wCC2PC~a=y΀gϼ1PoCjC=p8ZP~ɐ}/~y7;jZPjC}wk:ڷ}C]ӖP[jC-tuСkPC-sIuơ879oY5ҡ:9P?s\/jCq#u¡8?yCMp8 GZP j^ Cpe_xy#1GϚ>GH7# }{F>zvpiO#zutn=ҤG:H#z[k#mxܑ;{^|y#EFyztW_զGH#=| #_!#{>GH#={{QϚv=ҮGZH#]{66`M#{ >ꑞ=ҳGHiڣZn \GZH i#-|Tt呮<ҕGZHomo4>>GHsYӥG>Hգȹ9҆Gg=҇GH7#xt呮<ҕGH#x;t><ҐGHC#]y147\>?|M#zW<ҟGZH#zc} Fk#={stn=ҲG 18׾GC{zkH#}z_~=үGH#z;|j#mzGt=ңGZHqpgsmzSt=ҩG:H#y^j#zUV=ҩG:Hc\Cc3>~9}cV>1~9yε±N9 ZXKc{8f1Cz=zC=f1ߏ?.tcV=f1k{ɑu?}g XO׸~c\?1C9tcsq[:fsOs;1wxxǚu,<1׎_%'Ywcu;f1 w̵css|;q1gyc&<^ {;19ycV=FDG;w ~ذ;f1o|c6Ǽ=n>1|c>3=f1|cVsnjf1y~̾l<1xcsǯ >w̾clnp'ksa[g O8|p'L> _Ox{ؓDŽYz0'= /O{ܓ >2t䉡 3ꄭ'L=aE>!Xc N{¸<-ƽgY{zgY KO{f0'<< Oz|= 7Ozfg'<; NXx'<< Oxxn%݇!{(sy|p'>a N8s£֜5'<: O|np'? Ox|vp$9gInZ&> |x!+'\9 Ox.l7Nu¹T#l;a sNs£Q':1Nu¯֝pA'L:i: N8t¡0a' ; wNu¡=',: NrŸ|p}~$ƪ9'<:a Nxu¥\sC>nxOqh&ڠ&ߛloꅦhgsǟ~>}FhjiꞦijjjjꦦnjꦦnjjhjhjhjhjhjFi B皥K߻GzS:Z\s45GSs45GS4nijniꖦniꖦi&kiꌦhꑦFij6jj6jꚦhjhj\d}>^0`hꔦij&ijis )M*M]'M="M-%MM-!M](ZAkڤi7JS4uIS4GS4uKS45JS45JS45JS4IS4uJS45FSw4uFS[4FSk45FSo4KS45KS4s{_u:Z ZW:i>뚢끦hꁦh&;:#:#C댦NhꄦhjCkZM=M= M MM]M]!e)kOY{Ss ?5Opj~JiΟfʀS|8e)OqʐS2Ԝ?Ӽ?5OYpʂS)7NqʍSnrf)Npj柚ߧY~j #Y~j'~>5OSs<>5OSԼ>5Oo ]^ci2X7OCD띛9jΟ8)NS|=5WOS3 >5OS>5OSt>ri9qWe)O9SƟ2:Tywޏ;a?TߜS}soNͩ:ipMCȐkSzTOjSuV:A:T3SuN5өf:>7ݯNuة:Xotө>;`TjS vyNթ:Bw 8ctNթ:WzTcjSuNui4٩:Xcӿ?S}t#uO7\{ȐkZLWiw֙:QgLWi3u{Gi3u4ؙ:^gzLi3uδهOuי:_gL=q5vi'Ξ4`]ǝ}kLӝ=yȞGiij;~gZLógXV^ӖgZL73my)tn<Ӓgkɳ5-y)噾<ӚgLO3my~<ӏg:L_}yk_5ڽе+ X޺=>g/szk賦4f>gLi3{=gzL'3}{o=ӿgL޻fOm|w<Ӳg:L{3rtәF9Ӿg:Li3-veδv:4gLӜp]ۜi3msδՙF:Hg錝g!Й:CgOϸz3ƞL7qg>c8}3Ξqg|;Ͼ=sg\=3ѽuo8pϽs ;=gL@gj3=ryϙ9(gZLϜ3rkyx9ȾkLǜjpXϜi3-scΙ9>ZLi>̙v9$gL˜i3 t]δ˙v9.gL3}sot˙9X˜zL鎳#r/s=Z\Dε˹^9z\sk\srUεʹ9Ț.9*z\ksrCεɹ&9'|r?88-=!Yεɹ8z?Jε¹8zskss?g9Ϲs,?9Y~s>gs/=;9ιyo+u3L<9y7Yzs>oYzsSp;9xs'#k>{x{s3ݟϘ ݸŽ~A7\7s rA5ƹ8\sr_˹~9vz\לssuuϹyuywtλsޝwZ\s\g9ϙ|_ >__ >Y|_ s|L>g99|sVs=g9{ϙ|}ɀ?2L?9Ϲs֟s=9s}9=5=psXYZLoq[{p[oq[ o'[|o[loq[o[\o11[oq[\o[o1[loq[n1ӂcbz-vXby-x-?Ga|-:CcַX~-8z~K"纠[o1[/[o1KCk5}־[o|oh鄖6hq[oCkc!k{웊-fVKOxYa-b]u-VxXc-8b]u-ֵXb] >[2[hŕ3Zh1Ō-fbK]-vbW]-vbW}-~W_>-lŻ{ZiqřgZij:SZ;r١{٫.4х6M:B/] -sw.υ.BZrK\^BO] su.tӅnxA~tWFͅf8BS] s.хf=zBo\h q7.tȅ@B]h t.=4B7]hX\ rW.4ͅ3ZB\ ]re.Ʌ>;E憽}5{w-lwa.˅vvzk s.4υCzB] t.҅^Rg֚5\h v.م6fz:.܅VBC]h u.ׅ u.ՅOzBw] u}Y:B] u.؅hB]h v.4مbZ}5oF~Ϛ><:B\ ]rQ.4ʅn B\ =sI.4ȅ :2Bs\菋 6tkk^#A\#tQښ)ښ)ot__hik6ikViW5])Ǐ Z k{>m|6ln66m3ڏ?&t6O }|Bns6s|ms6,o6\l6+۬l36'ۜls6OLks͹6ڜk3|l36G۬l6ڬkͶ6lks͵6\k6|kͶ6lk͠6ڼk3ͨ6ڌj3ƴ6|k3ͮY6j3ͮ6kYfGommv6ftnmsmy657Ӯ[F:;{fDmnHo3͐6#\h͏6;t{,Π6?ڬi͞6oli3͑6G@7fI3z>kd%;.KY~ɇ?,8DL4/ypɈK3Ҍ4/Kd%#.?duv\|>6\̸dGg|4/YpɇK~\2G#ILd%.Y%k.9səK]2K\%W.rnwDqK\d%.vɬKf]2ad%.vɧK>]/ss%._:f˂O]q\d%.uɭKn]u%.YvɲK]I\ >O]2a%.9uɨKF]2cbpΠbɹK\K|%.sɦK\Y賯/YvɦK^Ul|d%.uy8`aYv]'/YvɼK]B9/9rɑK]G;ܹd%.uɥK.]|5csҜ4/uɪ_\%._YgEvɵ_3aYg%.7ΟK\)ΦK]2͑kGt:.wɛKV]29eϝYld%.{m~%8vŴ+]qBky>^1Wlb17Woxsš+]q늁Wzj˕e_WŇ+&]1IWXpń+\q3WXv}tř+\-WLbSqŚ+\}ŀuf\q+W\9pŒ+\)W|w^C/W btŠ:Xsŝ+]KW|7\p}j5^1YWldm.rkWLbtş+.]1sW {8xޞ{wź+^W jYw/Ʒ+&^1WL:Y?ន}wy^c +f^19gozŞ+6]犝Wlbxy+^Wܽb{}+N_}|ӳX~8~+^_qWbW:J\h|y}z/ߧ+]q;•бWJ?\+p 4vWኹW̿xWor]o\uȵAОgWJ;\ii+-Y=pkqO}H]"k:#::):Z5:λsޚ莎ÃGtKGtHGt4BG7ttBG;tHGt3Zo]tEG{tFGtCGWtMGWttEGWtDGOtDGOttGGOtCG?tC#k:::z!: >DSO -'9 =-Ț胎<5m mmwMya5 Wڡ.hh6h6h6谻>Cvwawg"r;Z:p;;l:찷N1 龙w}|Qk{Ig=(]>j5:ڣ|꒎F;ڤs|C1;Lp:::=:%::9o~ {OC?è:?U;CkGttAGt'd]qu4AGttEGWttEGWttEG+tabfvafvkvaywtFv8fvacvvaivRKvFd5uŴ ;0[;\p;\_u:=8_w]uSO]ueXK݇Ǽ격˦#"r˩.,벬˧. ˧.|~HO]>u12ˬ}l5uyeYǟƭ.Ӻk\첲.2˷Yg_{]&vby]ue^]vyYs]u}AƿWE_2`]&v`]ve_]Fvyb]v9e^y]ued}]ud].sskNw5ûfz7|]t K<2k~wY5߻{|]3kwͬ5fbL욉]3k&vĮY5ϻy]3kw9B ݽ7خ]nt5j׌횭]^t鮹5h ]skv 욭]3k6wܮ5?\7WaOgG8{k^sf5y|k^nd f5WY{k__gu:Y}k&_3׌WYc#|f5ǯ|k_3\w 1}k^sל59}k_s:vTf5篳c_׋1ϯ9~k_3Lf5˯Y6ӯ~:5?ȹf5w{]{k&_f5ϯ[`Ztyh$X׼6x Ⱥ:Z\kpY5?9]Upk^Z+\D?:Oܾf5}om $BC %@`wBgBPCK$ز,I-ɖdYdI$˦:P">?極~뷖>}e~2Y?gL_y~}lkܯ3g,2YF?g5ijYmlcƾ>?g5YMyV#<jg,ße V<g5Y_ȹf3j,pe+ aA3,pg9 Z«Z''^#8f8-m ﯿ9{^4 b ]`›[ض~-k] \`;]0~>.0q |\»[`~-ki L[`XЅ{?p#.ps \`K>.s |\KGָ^.nw ,\#X~-mq \9c{%~~sb?c8~.pt \+6.q \;.pr \`.pr [ ׾gڴ.0w'O.v ?5v.v ^` 8.xq 3vWk1#` 2O'Ӿ{N/ ]`ع6/py ]XYcԔƄ}kk4/p} )sSq \`;'tp{8.q l\w}F.0r \G8/w ]`.q \Ÿ ]`W̅{u.s\"7EF.rs̿sόs~ɋ^"wYE~.rtL]d"s9ךcE-2o}\s{93oqߋ_d"E~/zߋ^"ٽEv/{L\"ȼE-ȵpf3}М׸Ic?xLx.?l=:ڇ̸3}Ĝ>vŸ#g|>n6zۿ OpZEgQ-j ?c\-jE]Ouʢ^Y.fQ,E}sˢvY.e y_<uѢ>ZIZgQw,jE]CȢ.Y)zfQ-Es̢Y/eQ,cQ,EcʢFX :a1|jE1̢.YbqkšXtbn)$:aQ/,Žsm1ƢX<9$ZcQ;,jE-)ŢXcQ,uɢXbQC,jE5u{zvY3fQ,jE]'Oy>{Gpߓ?gû)u35ݢ[xnQ-jE7#38wcl[ojGOXcsX%/1vK]Աk,^7'XߥϜ%&/1yK_ys>.}q%.rK\bWLX k]w%.tK<];X¥oy%..1sK\xĵ%-mmKl[bۖķ%-mmK?1rm|G%.1pK[طľ%-qoqK[bĸ_98x%^.rK\9G%~.s0XZ%.quKL]bҥ1qKL\|=ݿ1K^bSݥ9{ػܥ8v~ 8%/qxK^sX%.w%Kl]b XĂ%f-1fjޛc׆3==:sĜ%,1g9K.q<\2's>.q\f2yڻ93=Xg2/s\2;yef.3s%SYe>.q?z_t,]f2;ٹe.s|\2yϘpen.r\2/9ef.r \f2Yx寝reS}Ue.st]f2Kٹev.s['}ۄ5.3vߏv|v˼]2oe.st]2,8g Xe.p,\f2 Ye.p,\f2 Ye.p[f2󖙷̼e-3no|[#[f2c̘e,3f1ˌYf2gٴ̘e,3f)LYf2/7'\\YGᗎ)̦0| 3)̧0\ 3'̜0_ϟGs/̳0< ,̱0, ,̱0 s,Uc\ s-̵0|2-̯0Œ -̶0 s,̵0< -̴0L 3-̴0L 3-̴0L 3-̪0\ *̫0¼ s-̬0 3+l>6s|c:lVy6ì)s\gL|a=l96f||a=l6{|=]t a6fC a6fC a6fC a6fB a>B a.B a.B a.nsFC|r"̉0l!̆]~=Քބu΄fL+a`'?ƥ0\ (̣0| 3)̘0cŒ 3?3DaL1DaL1DaL5~DaHu yI'DxI'Dy6r̖["l%bG1#fr|CynFG7"fx,%bG;4#1ynGY1#yļ3;bG툹1#v̎s:bfGꈹ1#uļ3;bfG kfx쎘3;bfG숙1S#fjLs5bFՈ1[#fs 591_#kF<4c#nČY5s7bFۈy1{#28bF܈1#fp{f칿n>GwADXaAߚƆ"l!†"zİ>D1#{|=:ȁ3?bG1#f~̏3?bG1#f~̏3?bG1#f~̏3?bG1#f|ltk)SY1#lČ\ؚ9Eflݜ&DӟpYF>D$BD91#|Ĝs~Ō_1Wx빙b毘+b+k+fbƯ+fb+yb^up}ֵg_M 6i}srړo2c\[gqns+[a V¯^0lg+ [a V8¨F0jQ+Zaϸ}cyɔx+ ]a CW0tct+,]a 7W͕Ot+,]a KWXt+,]a KWX|at+_? SWf0s+Gغ0t+\s~poI+[ V¥.piK+l[a V¦|2jO+|Z Vش¤&0iE+ Z Vlg+<[ Vx³la+Zo>vk#ml?V~7s+[ V8¸ƭns+ V9VX¶mm+l[a Vض¶mm+l[a Vض¶mm+l[a Vض¶TF·ڄ5pkbƵƌk[9v6v>Ӯ?+\ 7Wqk+[a Vx¸ƭpmg+,[a V¾^0w+|\a ?Wx»ޭnw+[g2.ʸ(㢌1.ʸ(㢌2.ʸ(㢌2.ʡ(o|r"ʟ苂cD5ӣfx\QsjG5ۣf{Q=jGϹQ^Dg2"ʈ(l!ʆ(lr ʁBQD5Q?93DħOz}=NF9edQFFcQ&FcL21('\2(1(l~gpwǼ2('2:G3;3(?1(r0(r0(r0#L0(FexQFeeQGye)?Ϯ?(|vF>}QGye}ћQG ÑOGQGQGQGQGc?c̏1?ث?}Z!b:!b:!b:!b:! b! bz!b b b b b {c썽ur:cq:cq:#Ǽ1::cL<wc܍q7wc܍q7c|~xcq8c 18 #;c&ƛob&Ƶsb̉&ƛobq&Ƙا\WΪ\5v>w_5Yg1ŘYg1xW_1~W_1~S_1f8cX[1^ŸRY16ŸO16cSM16žb*ƫb*ƫb*ƫgbq&Ƙcb|+K#܉1+ƞ_b,&Ǝ+b"Ɗ+b"Ɗ3c|1^y3cy̏13=f3cfzL1n7z\qs=nu>n y7}ܼq>ny7}ܼq>ny7}ܼq>ny7}ܼqs;nF7f{ Wn7xqsn97|qs>#9rlN48@#c,9?=?3 6$ٞ0f{lO =a'ٞ0ya'0}¼O s=a'0z\O s=n$90fzLO $0bkžԔ kH#;H#;H#;Hp#1'Hp"'Hp"0LH\G;# $xA $X`B $X`AO pdWU2v\e*;WٹUsǫ<^*GWUvs\*7Wi#}}s}S|iȿͱ/VŪXbU_U}/VŪXzbU/jUVªVX ZaU+jկy{^6r6Y9ڧ{{BZhU jU V5k?0c:iGV5ӪfZKziU/UVҪ^ZKziUUʹV)M:iU'UVuҪNZI:iU'jUmV5Ъ>ZA:hUjU UM 3FU}V#ǚjU'jUVuѪ.ZEhUU]VuѪ.ZEhUU]VϪY>N&UΫcgcjUSjU-V~ZMjU;jUVӪvZNiU?Uc?V|jUmVѪ6ZF3rV5ҪFO̚YHkhMi5 4КZ@kfMi5kִ̚Y6k59ט556{ \2ko<> ֘6#o|u5f1sk\Oع5ޮuk|\51+X56qkb+>n:3Xڵ >~c~&|3ƥ5.f5kYcCxƛ5ެfkYcKטƜ5^q&qlIkLZcxƢ5hEk,ZcڗMƝ51a͌_35kLY35~ͬ_35~ͬ_353~͌_35|^3~z^>qaGvckXc+S_''â ƥ5qiGkcZ'wZmsv0Ny}I8Vy:v~6r|>kǮ1|k^3|k$Nr;$N2:$lNr9$,N8=sw³8|ns7Y/iywͺ1=;?I:I@Y=Z(z-Z*ђ)(((((((:(((4QR/%RR%QKGPR%P+FuQR%uQR%uQR%uQR%uQR%uQR%uQR%uQR%uQR%uQR%HR$HR$HR$HR$GRc$5CR$5@R$BR$ّ=Z!؞?oCc{~zS?&'}9~L3Z+z+++***** JjJjJjJꩤnJꦤnJB#))))))Z"$ۓNꨤJjJj$ǓNj$O8$C M7Nr6ٜG$QFؾYFbg͹ysI34PR$G. IݑImI=I I]I=IɿpǮ|ƽ/~Y#zd]0e]ku]_u\Ǭucu̺Y/e]uYʺ^Y+ze]u3)}9}ݳzf]Ϭuf3{^ ^gg\uZfXg6Z:5ǺX`]ku9u}l_g:?rus#\_SkuM)5źXipmҺXc]cuͱ5ֵƺX:b]_ku15ƺXzb]_uuº>X`]ku] 5>xmgkieܣֿ{{݌ix_?Yol}ֵݺ\gh]_kukuͺY|f]Kku}sкY:j]uuֵκY62}cl'_Dzi]u]uѺZF#h]kumֵѺ6ZFh]kumumѺ.Z >Ѻ>ZGh=|ju5ѺZCh]7uݴ5ҺFZHpNY9Qyy1IB<|97{s];um׵f\זݱX[ku]׵度\חZr]Ku}/u庮\וr]7uֵ[癔K麔K麔KȽ5 ҐW{[叼Ugy&R8Sz8SZ8#Ǻ8 S0 S0z^w돝ɔMiԛk˔Li˔Li˔6M˔L˔LĔFLi;z1Sz1Sz1Sz1Sz1Sz1Sz1Sz1Sz1SZ1R0R/R/qMۥt]JץteJۥ_Jߥ4\Jߥ>z=Z/RZ/RZ/c͗|)})ݗ{){){){)y)y/ 7FLiJ馔VI魔vJ}MSc4FJ;CJˤtPJC4DJstDJGtDJcDJDJOMJS4HJWtEJWtEJWtEJW4EJODJODG؜kz$GRz$ERZ$&Ii&Ii&IiHiH鐔>I錔I鏔HiHiHiHiH鍔H鋔HiTxx%8`]wtGJwRc:$AR'k$IRc$OR$MRIq&řgRIq&řgR`8ƞ{RI'URL1(Š;SJR,J(ŢR,Jq'ŝRI'Ş{RI'ŚkRI'śԟ>RJ,ųR|Mعy2oSmʼMykNk~f0w7 sw`Æy w07 sw0w7 3uì0G7 t gs|yaoan? szÜ07alm&17 3| 07 3|07}>s><6x 3~Ì07 3~07 {_ι~S~ޏs>b2hu2?{g>&x~n|?ᑿ~?7 .oxL`7 &ot z; `7 o0x[7غ n|[p>m}ssaW<_ __6e]lhoxO:eCl S6tʆN):eCl S6tʆN$dCol 76ƆzcCgl czcFa\lh -E6~uSlh MI6oǿk mM6Ɇ6&dClh =O6dž#zdC[lh !64Ć6c멱ȱ!8 =G6Ȇϣ>'dCl =G6Ȇ#eClfClh Q64ʆF(eCgl =76Ɔc=6ɆcCcl 36rš#}#;Һ#;Һ#Һ#5_9)z"'z"'z"'z"cO4FZc5FZc5FZc5FZcDZ;5EZ;5DZ?uAZ5AZjړ9~ii~i~i9ciF9CCgM{λ?ųX2w{r2ȴ^H32GǼL24z#IOkM74M74M64kӌM44[\Ms64W\Ms54W_4awi^N;ivOiffFiffFiffGYfI%iYfI%iYfI%iYfI%ifBiw饑g#͎4;H#͎4'H"͊t*X[6iNِDi>Ci>YfAi?m4fOi?m4 His?mƧ6f|ڌOi4o[f ~wg=5֜{OZKZJZKZJZJZ2X Z&[Һ%[Һ%[Һ%}-6lMmM6ɦ6&eSlM Q65ʦ"ZdSlM=C65ǚdSljMMI65ɦ&$zdSljM165ǦcSolMo2}L&W7~c=|}2ϛl&7yAsm+6uŦbS[lM#65Ħ:bSGlM5;cbS_lM}/6Ŧ`{`.%dSlM]K6uɦ.%dSlM]K6uɦ.#zdSljMMI65ɦ":dF~~kZeZfSljM-e6̦2ZfSljM-e6̦v,:eSljMU6ʦV*ZeSljM K6Ǧ46ɘMl2f/|̿@ߑ?#Cm&MoxǛ<&7Mnrt&7yMnpu&6YyW}}Oq_'\.d&_7ٺMnru&?7Mnnrs{{S3=pϼ~]?gؿ-o[bֽaW|x+=ŞW{s4kG<MxW[@[gKli-}ϖ>[gKli-}ϖ>[gKli-}ϖzDZso1K'l~=Fmd]ƎGȱ [gK'm-:bKmi- 'Ė[:bKGl-#>.aOli-MItĖ[aKgli- )X[/iʖ"[ZdKli--EȖ"[:cKli-5Ɩ[`KCli-S}ӌ{Ėn6[eK[li-M)4Ŗ[bKOl鉭os߷?O2[e;|<4і&?'Ucmi-]tՖB[ziKmi-MyȜ{/NfG[hKmEOؖNI[:iK'm--ؖVJ[ZiK+mi-#-M4ՖT[gKSm霭ڔu}ϖ:[ZgK'm-ͳu4Ζ``ƾ9 ן>՘7 ~CӞ7wۖ[[r뾹4}S^}7?fg}ϜO;n^-?gp[cmkmM#x~ϫǺk[mkmM׶_kE`š>~ km[mkmͶٶ5۶flۚm[mkmͶٶ5۶Fgl[mkmͶck:m[mm 5ض^zk[omؚ&~sMSmkm˶Զfzj[Kmkm-Qcj[mkmm#:k[cmkm5Ѷ8f[lkm-U?hmM#|#]zp[n9?g=r[Gn/9_<Ǟ/cϗ̱˧wۺw[nm5ݶtۚn[mkmM\Ӈۺs[#nkm5ݶ^ۚj[lmݳtж.Slkmͳy5ѶSKmbpuжAg[ mk;C:h[mkm ] vtk0};awxF0z;,Ww+s/q|;L;\wؾp};\߉LXcwp}'9v6ewXh=vN~\hmpv;gw8s|y;owxv1ޞw;鍝>y;|w>y;|awj:wF0zљgFYauљW9uguvg؝awNgau>gs6gapϙ7{ןq3p< g3o9r w3 : 3p8 3y{azgyϱ9}gxaygXa~gxygxyg8avgvSاs>gs>gtBF d8a~gavfgavfgavfgifxif`7̱eus9ŭ 2p'Ù g2p'Ú 2<˰,ò 2?0r̵ 2̰-ö 2l˰-ö 2|- 3+3/5&fa]O6faWwF9O=:2k-ƯhpeW&\ מ<7f|'C3 3=~oZ< 3l̰0 3p.ý^wexeuwea^yea^yea^uex]w~eW_sea]keXW_~eW_~eW_~eW_~eSO>eaXσYZe+{&˪,ʾ+-J#\r-˵,|)˧,u~eW_;YgYeyeYeYeٖeXaYe9XcYeYL3Yd_|&˚,k<2)ˤ,wɲ&˗,o2&˘,c8e=YdN;YdNYde@Yd@Yd9@Yd9H#YdyAYdyAYdyAYdyAYdyAYde@|Ϛ/־rܼϚY9k>gٜ5߳_?7Ygٜ5fsͮY3;kfg kfz<ϚY;kvgٝ=q\ϚYc3? 20,v'31, ,r0{3r`윓YeYeemYe9e`?9f^YeegY.f)?>s|0sL2Ǽrlq/ǽrq/ǽr˱.Ǻr˱.ǹr˱.Ǻr˱.Ǻr˱.Ǻr˱.ǹrq.ǹrq.ǹrq.dzr<,dzr1-ǴrL1-ǴrL1-ǴrL1-ǴǏ3.Ƿr|-Ƿr|-Ƿrl1-Ǵܧg1/Ǽr.ǻr1-Ǻrq+ǭr1*Ǩ7<Ƒg|sds0:s|1#s12s̱1r/ǹOXxcaG&\aGC#y^{9x]w9x]w9~i잟|#k9cc9>cd9Fcd9Fcd9Fؘcc96昘cb9Fؘca9xas9ca}9c>C+ǸKlϙ9=gKsə93>gr*g#~ϙ9~ٟ3sfΜϙ93>g3sxތ~ϙ9>g3s{ϙ9s>g3syΙ9s>g~kxf5wW >]s{5w]3{5w]z׬}5e.vY˂]2`MY מ)yñO]e/|} ke.svY˚]f&xvˤ]h}F}lU.v9˩]62iILe.vٳ˝]g=.wvY˗]d-Le.Sv?)w|?KǾӧ||M~G]wG7пʹg >ɴٳ|>{M8ߞwP蹟\|{|Ӟo߮]4ލv~ع].uv+z=g{ή]9svsz=g{?}ީv#zGi;Үw]Hޑv#zG=f{̮]Hމvz}f;̸CcGvz.]d׻Ȯw]6?5a;ʮw](QvzGe;ʮw](Ovz/ ׽{~G޳g{Ϯ];wv.{]hЮ]AރvF'y.]f׻Ѯ]3gvw{qϮ޳g;~pg|{vz{ׂ)ak{׮]]޻vwz޵k{׮]Wޯv_z~j;ծw]Xޭv[؞޻vwz޵k{׮]]޻vwz޵7ּzᙼwwww?qTTT{T;U޻T{UTT޻Q;O;O;O޻P{O{O{O{O{N{N;N;N;N;Nν_<&&&&&&%%]&&&:9l½6}֘gN9y䙖gN^5UӂO[s}yFFSy6ٔgU;N39TSyN9T &+ϝyOymyymyymy湚hyYgiy湙iyvٙggyvٙggyvٙggmyٖg[my~gdqycy]qy噖][Y]wXp̸<3.ϸ<˳*Ϫ<ʳ*Ϫ<ٱLɸ<g_y~O~9gKcyyGgygH!y9H#y9H#y9H#y9HyFHyYgEyyEy^ygEy^ِgC y6yCy>=dž=6a3^}ڤi{ǟÍW{屵W ǜ=qg﵃O1g1{|c[زS9&фMyضc<ǰ=1la{Ǯ=vkC{8ǡ=qhC{ kl))ǰ=1g'{i{ _Ǘ=e/{|_xǏOƔ=qd#{cg͔Ӯ}jS{Lc玝9ǭ/ mp̤=`{W{fYg{9g{9g}ǔ}yg{~lپg{fپg{?1ל3=s~Ϝ3~dKXǒ=d%{,cDŽ=&1a {LcDŽ=&1a {Lcǂ={yǂ=3{g{^)3[?g c >9=qp}{ܞǺ=mm{lcضǶʔ{ᾃx=>ş+ݧGKi=-%Ğ{ZbOC]Ǻbi=mw\{bOW=])4Ş kbnlM{i=;tǞ{cOsi=7ƞ߷_ϸ¾V`_k}} uNX aGþfn>Y}k}}o1e>y}~>9}s~f\{}s|>}~S}~|>پ^\ݰٺ`=)*c_S}OOoB> |y3Fg<xϝgz볂?<{.sy;'{O=a߻}{?~`{w}|_s5&.}aw} {w~`߻~`N8>~ľ}'O{>}b;ľw}{>}`_OqOy};w{ޱc_[k}mz_Wk7:{_g} ֣S3r~_k}=3u澨י_}Et_k kt_k}Ku.ץt_}-Eס:t7rI5&פt_}7צZt_wk}͹?uGj5Aמ)ܷ.}[ K K C :C :C ڳ= ڳE ? ? ڳ= o45=ZУYНYМYМ7 |ƵuZЩZЩZШ-ZxsYxqp#뚴I I yA4OY߂[0 o-k)`6*`>炎- Vss`n킹]0 vAdA^g-R0 fy^0 fzL/3`>{y_0 {/|ؚ9_`D'ń5&P`B &PA &P`B `Y_0 f|/3`_0 f|/s3s~F?{w~>~w?͟'{G4|2S L-0S L-0S ,-#\-pW ,pBLS L-0 ,- +0 +0 \+p |+p]`\q2ܔ3ϸ' ,Be5xZixZixZi~Yi8ZhY`gvY`9?,[lvZg{;b½.|" .2" .2" .2"{-\3Ɣk.2".r"-ٌk.2"L.2"L.2"-"w-r"w-r"w|-"_|-"c-2"c-2"c-r"W\-r"W\-E=PE=PE9^dx3a_OX`}s&ܯ둢)ꑢ(ꌢ(ꋢ(ꉢV(j^(ꃢ>(ꃢ>(ꋢF(j"G(rȍ"7(ȍ"'(a/1a7Ly4s"늬+2Ȼ"+Ȼ"+Ȼ"+2-+"+Ⱦ"+Ⱦ"+Ⱦ"늜+2ȹ"NJ +2ȯ"+>'``}EkƳ1\-r"W\-2"SL-2"S<-"3gu{'"s-2";," ,," ,,2ȸ"uuS{*/wM){7tQO;uS>=b{/ܧ銚x9붢n+궢n+궢n+궢n+궢+j6+j*j*ꯢ*j+w3% V`% V`% V`% Vz{ZIkXIoXItWIwtWIwtWIwtWIwUI[UISVIWtUIWIأ_JouS>%Szع*頒*Ȟp]'tRI'tRIQIcǮin*馒n*馒V*iV*餒N*}Ԅڪg?zz`<)~=}{կ%ZҮ%ZҮ%ZҮqMזlIϖ'ْ,iҿp;K9K9KڴMK1e]tkInI4jI4jI4jIiI4j jIjI_4cIt`IiGgIOtbI'tbI'tb;'Mګ'Kz'Kz'Kz'Kz'K:!K!KKڱKڱK=K?#;lI~z5[Ҹ%[Ҹ%}[ҥ% YҘ%ZҨ%Xҿ6OY%=Z%MZҤ%[ң%-Zҡ%ZZ5K)tdICGE՜Є O IKIKzEKZEKZEKZrMt`I? X@umT:%S:%]UH%Q'%MS%]S%P%P%-P%-P%-P%-P%}TҊ%=PStAItAItAItAItAItAItAItAIA%@ 0h^mk8W~&]q+tŁ8@W]q+^4q;8x79~cp4Áf8 @7p.8z@=pt/\sf|Ks.p透l:`tpCg/xuF|98v6K\:si3}gqG1_:Ou/;/9xy;Xw;f9|{;c6p{ǎxăx.p[:Xt0G9wsp?,;`s_ >ys-\9Oxr9NNJ8[Xp`0`g='{Wg8uNE{#\:0tP9fup|U:`XuVU:<:xvg<;NXcwml;`vml;`_;vkx39d!kYsȥC99d?}:{_m^A :|s|Ql:d!tȦC6Ml:d!tȠC͔Sn:_<wȵCml;d!xȾC2i;!9uȩCFMl:d׹w3m,;d!9vȷCf:tȧC>rQ:d!yvȔCnyȊoq!|C.͇L>d!|C&2ɇL>d!|C&ˇL>d!|C&2Ç\>dOYՇ>!Y}C2:)k|;|68Kc#硑 ,>dax?Y{Cr=!C<=!G9zCX2聵` J#y{Cv񐟇!}CNrӇ>!9}C>ч>d!2ˌ.2kˬ-2[l-2_L-#Gue\se&\~`}| ]v '2,/6#.2o˼-2o˼-2oL-32w-s2w-2o˼-2O<-3G>pe[ne[fgevYfneYfleZfhOskˬ-2k ,s2\+̧2,*3̌2<(l_6f|ٌ/3̑2G}ټ/elޗY_6f}٬/el֗wͱe9P@e`|:K,)̒2K,)̒2G<)̒2K,)̒27(s̋2/ʼ(̌23(3̇2(eL΄y_6f{l/e̗2G~٬/sl_6f/esogdl(l^.OX3+L7v8a>RK/e_Y;YNWe^yQEeN9QfC3v;;gI%eYRfI%ep:_l)̓2O<)̓2O<)̓2O#1GL=bSz#qGL= y#G;b`^Vg G\?x 8#G}L48b8GG?b׏~#}sG?b8b>o#p N8\/G:H}u ѷ]G4r#t‘^8b^8;u q468GzH#}9Ǐx~#qG?G?uqG?GZ'Ǯ5p.8GG?bۏ&8GH+醣S,>ų~ktѳs<~œ GzH#rWtˑ69θuđ8#GHi#]s[ˑ93GH=}̔ё^9GGZH铣Hi#]r54ȑ8G:H/#-q/tǑ8!GsiLӞG:EXY\:X/>rѱf:NXKkq\UzXOkc=uԱ:S:X+kctұ^:NXc]suα:IǺX7cMuԱ:Y;3Ա:9qyXcvÎֱ:Soc]vˎuٱ;bǺXoc-u5ֱ:`[&ko cumXkc]v5ֱ:c:&ic-q5±&:DXOct5ձ;b?2Yz}> p?;s#SOǿu/?9?;{9sػϱwȱcNޏc'ν{o9r{ɱwc,Y{g9.s{ϱ#o؛׻αwc:{9t|{9^sбcCޑ3y9nsػͱw㫱sMucIXc|>=/c}}]̱>5߾wN>'D{h=я5F?':D/hxO6>'Dgmz5O=ў'Dh}x=O=h |IO4>=Ѥ'D]{_OF=i'D7hMzOOꉎ=)쉶;3gO|ຆ<3_':D}Ot>ѭ'Dh{qOt=Ѹ'_] u^>'zD|Q{OV=Ѩ'D۞h{O=ѿ'DÞړ/DchM}Otw 'l8aÉ=Ѿ'Dwh>?':;'9։F?aɏl; gN8s«^{¡]zOt>=т'zU'ZW'L:'L=a NƉ9'ZS' ~od7ϞY߿u~}3~{oxr-<>'D/脓ȹ&8'z'?a O4 O}0'L? O}0phdx윷'=a O}6'? Ox֟hG<<6Dh0':Dk `3' >a8 O?^;a_OZ OwsOXő/񜿜riN_)6:TSr}N髍Sq?Nǩ8):Tۜjם_Nɩ9&TSrGNɩ69TSpNué^9zTOjSpNʩv8 1>ck䔯=q]ׄY>e)O}ӏS~Tp1.8|>)OYNũ>9 T˜O;g~ʜ{ڧAN5ȩN9 Zt)OY~GNɩf9*T2TTS=pNu©N8zT?TS pN)O9~ N{?e)OuV8n8)O~S?)OplϏ=gL_SjS]qN5ũ8T;_ >/k_;OkSTo\<)O|S.rti䘉<)Ox8e85MpSpN)_OuNuv8 ?)O+s8ۑsQ ]6脊6hh^hFk쯰 *ڡ*ڡ*/z 鈊hƨ臊芊hh[ih֨芊茊hh֨uQyaN艊~蓊hh芊|H*1*z+**!*Z s+̭'9+ +)#kk +p +\p +\ +0 +_ +|e5W]awvWx\uW]sW}l~W^affVYafW^azW_OqN0 +?9r + +|V[alV8[m&WZm{lVX[pUUpITTaREUVPCUxVY[KNXcZ~TPC>TxTQGfUXVVqvUU_2{z߽=ރ9~ӱ * +› *̩0 w*L0 O+'*,p *0§ʟ£ *p7s?8ʷo;vwZsUVarO*l2ʰ*3W\rUWYgUVY[emU&W\erU&W]ev՟~s_WTCUW_e~UWY_U-PeUW@UT5@UW^UWy^FU6WY_e}UMPK/U.UVݙƞ*̮OTYUeU0dYMU6UT5LZʬ*ʦ*ʯ*rʡ*lOvUUXuʩ*㪌ʪ*ʦ*>r#P;1󿞟*l:cg8tƨ3ޜg8g8sƘWs#g9{hg>z3&1g\8gLi3]pδ68gL3i/q g\׾xƵ/qg\?N8cWskFֿfºF8gL;}ȱ68gLc}cMV8gZL#3p%δ>8gzL/ir͹; ׾+S=wcOqϏ?=L/Dp~28kLi3rQδə.9 a=L3t̙.:Sۜi3ms~klMGi3s{sstЙ9>gZLi3sqtЙ:KLδљF:GgL3sϙ.:5gLiҌL?O?}8>]wtܙ9tgXם3Mw ܙ;rgLϝi3wܙ;ngLӝ鼳?9wg3u}o3 wݙ;g:쿏>#Wӄ9ӄg#kZojJ#kO5PMtNM4RM#4R5FRMKbMOմcMSմOM4QMմRM+WM4X=ocio|]j]jܯq9jli;MX 5V@݃5C5ט^c|M4NM >h%#zkܯ閚n}hu@&ؚ֨ii釚vi^酚^酚^鉚kqcܮfTS_58P@5Va5>X\n5[cs5Vx^~5x_|MAM+ԴDMtJM>-O;XGQhkZkڤk?>k1cklkl=Ӯs<翌웶_~Y?}Zjܯ1 j j: jZ#jڢj5Q =bo{EM_ԴDMcԴHMԴHM4J5ָZcr5Qcl5[cl5=R%5MR,5R,5Ro5~]wMg\{58]i5[o5>\s5v]y5~MPcg5׸^|5Z58Zh5[mcKk'҄4a=g9g|sƞ3=#=9sxss=g9#Ϲysv<<9yys6{&=ƞS}?5?{?qsx15ƹ<ׇZ\sMrI5ɹN9)\ssεϹ9>\ssεw@'oc;g\kss}εϹ9=\ss{uϹ9<\hks vεڹV;jZ\ksx^<{y)߯w.>z\Gks-}ϵG`α/y\ozں:Z뺽::뚻zzڽڻڻog}#g=/zfF2u/u,u7cGGMSS[IIIC=CC?KE9::AIIO2ު뭺kު빺֪kNأꚬ#{T]OV]S5]]wյc]սoԽԽ#V]KյU]s5W]sյY3kkgMy}AE븺kk뺺k뚺뒺fk&뜺Ω뮺֩k֩k֩k>kkΩ뜺Ω뉺뉺N]ԵH]uN]'I]uF]uM]+յM]_ԵG]w~\y0kީ띺&듺>oaaZ5.k6k6k6/ϸ~MԵM]ԵJ]ԵK]ԵJ]K]uK]uJ]uK]ԹQ1u9Rg[/uRO?uԏFYT7뼪Ϋ:3δ:ꌫ3μ::: ,&κ_gj68fkON9Qu9RHeuS'o쨳Ύ F\0sΙ:g. n\-l#xձkf9za^. s 0/ ^af_{ržo3 ܿ0/^m=̺`3.q \;ܹs.=ls9ps/u ]|`.w ]a `3/y f^p삅.8w ]0q|.v ]p9~~.v n]e:k.xt f]u7ƹ`o`}|-|vhy9<>{Yоsϼy~CzzZ5rڪzZ/:ZڣYڦzzZeZe:c:<|֤3s> o~#γ M4yE;7v#hɏ&KhɌ&+hɊ&SLi2Ɉ&7hr3Ɉ&O4YdO=lp!{6dbMN69ټ;s>6eMf6bMV6YdhM69ټw-vbW]-bLcͿo=ϚgbW-z`k-68gu-fg-XbZs-vxUW-bb\{)ep͂o?c?[/[xu-Vn-bUUz`o-]-8`-ֶXbh{-bZc-ε8b_q-ƵZo-εb[m-X[-Yg-xss90 ae-VXg-6bj-fd-F~o䜛-ֵXZ;fa-Nbe-VXba-c [#FS[LmqŽ'[,l?[lſZi?ZLj1Ť!Ui-fxbT-bUU-~QG-bX[-bSM-6xSK-.2[3K-.]UW3k={5N^2S%.9Wy+ϸίK]_}{ld%.ywZ#k;c<% /sɦK&]o%'/YtɡK]2뒋ld>p/.9Kf^o|d{^|%/yxK^r򒓗4a'5^Yd%G/Y{33Ɍ=3f7sg03Up/Y`zx6\ns6n6ۜosڏث:|}ftnjcw1w;| 1W;kl혹cvοqncv܎1;fmǬ3cwɎ1W;j\혫scvՎ1;s옓scv֎1s;h;f\7#;fc옟cv؎1c;fl| Ntud 0){ &uK 6taCntN/>taJvtaG翌nt8H).t~}oMYgG!taL1VtE^txaK1t1;x$>aC 6taP!t#,pÅN!XcLtaE X;[D13:cpwaDNt89ts=9 갦Ög:0Ì_:|×_:|æpνxQގdS#t8H#t8e?3teJQ]kweJ)]teK7]tO]ft9H#]teM cntYeQE]uyE3]t9L3]vt9eL1]t>X 2ˍ.+ˏ.O鲨~.f˃./~]nt?48=CÂ'{?<8?fQלr˓.Cl2q|r˄.r˄.C 2ˏgqˊ.C1Nx:/貢ˉ._|~~p#/p7ݯqueTA]NueS]vt9eRq]uօA3]9Dz.˺벯ck,첰.ۺ벭˶.ۺl벭{ouŨ+F]qw͸+^}Wb^}fp+]W?f^qW/ 08f;xy+^^Wb+285.^qWbOrŗ+\q7Wܹb8tŪ+]qkWxy+^^Wc{+_1W b}#1WZWJ]i+-q%ĕWZJk\i+-rCtȕ6*Wb~+_WzWlbP~+qKtɕ.+WJ\i{^7F:;,r=/~ =O`G/w]y>sg_[[\y>s}}o8t}̵k/k9\y~r}ڻ{s{ɵ|{ϵk/U\{wr;˵wkU48rfk{c&o?rNc׽\؞'!xwk}־C׺Z_kk~᯵󵎿/;:Zg_{7Z_k}~ϯ>ןOz'>]|׽G\{opڻʵk +W\{Wp}{ĵkן5vƮy>q;}=7{\yp#_=r;ȵk\{?qkcʺwk55fp{ĵu~5 Z]k~ݯv?\)׵NS??3럝qg\f'קyF#w럛Z_j?=Z_k}p{#{Ư/] c#[\{/qڻӵk\{p}ڻµwk %\{7np:==ڻµwk %\{p=;õwkf^kk];s})ZZKgBGDOWtEO/tFO;BO;DO[Aڡ zZ)z#zS`ºiii鉞豿z.iՔ=o=M= = wzڡz:zz:#ڢzz/ 5D=clOOֹn=V=mc{=:{<뱰 {,q'{1G{{L1{L1{ڠ zڠo±)Ms~6{{6eۧk{Lj#z1Lj[z 1{zz z zZǡzǫ3{1ǚwz<7{6گϸ3ǙgzqǩzǤzqǭ^t#=wǿzǻzqǹ{mq3a=xc_bz<ǵz\qzLXaM=6RK=.cW5z1 >cB =&cB=s903075>c]=㩯{ǯz,uok}WF>G#<볭ϯ>|fɹ>|ϧ>볫Ϯ>l3ϩ>sϱ>,sϜ>l곩ϥ>o;rΩ>4rY}9P[}nYgQE}^ygTA}/8~O}f_|rϘ>곩Ϡ>tɫ>g3ϔ>S鳦Ϛl}so>/fx}^>3x}so9Uk}=Y 3|=i<}3y} y}&8{kGg}~{_ 3>{ >̱g\)Ϙg艾kF뉾OYt^땾vkk:?Gݾ~닾듾k>ls>?;v^k>k>K\|}9} }x: ﳼ>kF끾vk&k>{s>>낾.낾^s> 3[cx}Mc}6g|jdyv5nݿ y_}-gw`~w{w}^y=`;`F=g=gX<&<`fhl6<`.<߃7Y{˱u;6x=ָ>`vuʽ8?`>X=`>`?n=~=`v>f:<|| |szLsz`N=0aL0aL0aL0aY?0fL~`nY?0<ss`ń907fsy7/z~. ~Lp``~48ssSF> 0s`?0|a;c?0f0bY>}`N9=0 0`A9^gȀ. 0l^ <`<lϸƊY?0\pepb'pb?0\pe+laL0c`<97\sz`fn?[NXszp?>0fL3}`0`7zc׿}&ℵWƊ4aOZcͫLXgͫMX'8t_skMX{ k3au'&hLX{ ka oxn0y7o5r1nXvôpy7̻a oXx'sk7\a nv.p7\ ox.|##yG==,a go8{|ʔuް78:o~p7a koX{ް7< oX}v߰7, o~p7< o8}N}p󕏸kFa o~íߍ_7̼ oXxp7 ouSᾟ|Vް7a ko~vy~4߇|Cxh>Y;4k\Cszh<,,Cwhۡ<4f C3yhY;4|Cswhࡹ:4WfмC3sh֡:4sfCyh>ɜ{<4f2VY3fLCxh6䡙<4؆CshF9:4GмCsthMnl=3xh9&r-o|[ߦ渞pٷ-o3'o9~e-o|[6߲ͷl-o9|[>߲ŷ|-_oz[Ƿ<-oYx[2ѷe-o|[޲˷<-OvǷ;ow,gnyx{!Coz[2gu_=7swc{{;qw{9w|};v߱wlc};߽[k̾c};1w{5ܾo{;F1\{י{;&1 wLc{ackcKXrǴ;ݙwf~ǥ;1{wLKG0l3qǍ;nqwܸϱKÐ;~ܱUwgxsgFߙw|gߙwoXsg}`XrNJ;q,3Xpgߙwf+q'w5o=3{uǬ;fs&_ |kmA)mӤ鰛i}ڴÑ2 " Ȭ22"N $Mtskoe{~/k^+~˧|̫|̮̹̩,̢/ _2.2.2."1]fef]e]e]~mnYwo9xWyu}ge]e]e\e]fwDxuguܿl̹̻̺ ˜˼ae&^__2/4tܽN_eF_feF_t2˟ g":c,/s2/,l"׬\ 3tᅡk8^ue_rp]pcF?ze[fIe.GqXf`eFYfkeZfkeZgtuxE}~7<#ʺ;11ڣ+1ʥSuAYuAYuAY[EYwHY{GY{GYuAYuAY5DYCFB}ww9z?eS-eR%e]R%e]R0eQeQ eP eP emQemQemQ)| kK#ckR)emT~EpеN)kV)k)k*띲)i(k(뎲(k*럲N*\}R~k0GK5LYϔLYu@Y7@Y @Y @/ιZ~)#c".2zXh)k(돲(k(k~(s2.2xl/s2˼/kF(놲(닲(둲N)ߩM~w~F|*kV*렲*륲>*룲>*뢲v*kvtH'UQE+U4Qe4tN覊np +\p-*l2yWtNE#T_~ECTtLEGTtDEGTtDET4@E#TAETAETt@ET4AET8_ >y_-P-P`f1Vx[EWTtEEWTtEEWTx\auET\tW\s-PyE3T_zѕ3畻0O>UTSs^V]sW^UxUUyfUc[]Pa`UW_p¹ *\pµ *̫<=^VXYy|g{ݻ,3+̬0¿ * » *0 *ܫp½ +,p *Ҁ~U8YdVZahn0rVxZiVXb+8g\qVZhV8X`cUWaY{UVa_kUWajVZaVYfUUaV}U8Xe^V8S]U>1ž *0cp¦ *0¿ *Xc+,Xg+يubX+ * pbMb}X_+׊bͮ.[+劵bX\+5b έtz]NWkvZ]VWkt]{M*u]WUkv:]VUt:]VUqz[MFSkuz]^WUo[VUku:]NWUt\6WUxz\FWUktZ\>WUszZVUj\VUn\Yh:\WUku[VWUu՚\FVUkdY.Wocܺ]VU]:WUUkeZYVVUkr].Wmey݂wpGaI+UTQWPe@YPEU^Tvεʎ*;򪵾jmZ۫jZǫujʓE[ujZ5jMZ*'>=Tϳ?sλ;U>T)8f<'4nZjZ=*/<0888gA_eDU&TPe@uU',ʋ*/2fͯXtK,ʒ*Grʐ*C?gޛ"sReUxot[/0"o`UVZehUVYg{w`>\ο{s*y|FT*KT5IUT5JUTuJUTKUT5MUT5IUTIUTJUTKUTLUTMUTuHUT5JUT5JUT{铪^iꘪfj~ꙪꙪΩꘪvETL.knUʶ1:f{(2oʶ^;ۚf;0e[lφ;\lkm]˶v6f[lkm sλNM5ZZCmmuҶnM7 uC:׷\_5-B*4ֹu6k͵Ͷ׶Zۺl[mm͵}SwmmǶ׶!:d[lmȶ/ۚkνۙk5Ͷ:ۚg[lm Q5ʶF;g[lm̶"Zd[lmݲa5̶4:g[lm]cu̶f,ۚe[lkm-%Ob[Sl3|`[l[?lkm=5Ķ)Zf[lkm=/ C/:f[lmm\lkmͲmMI5ȶ~Eq㯌{ox^msokm}5ŶF~K1}͗mle[klwE6u6ٴyȽöͶm^mqwیfGqlg,6Ƕy͵mmlg\swwwk1ckqck1ckL1Kk,qƳWks]X[c_}5ոVc]u5XW_5&Yg5~Yg=5XcQ_5.8TcT[5՘X^SFݢ|f8VXc58V.cw2Ƶj1ƘcjƾjqƗgj̩1Ơj1ưj̿oLƮjLƺj?qƩj|="tB?:t1s>Xc5fQGg5RcH!5ԸPH#5RcH!5RG5^8Yd5XZcl5[o9V{Ve`,w5_A5fԘQcFG5nԘTcG+5ԸUcQ5nr=[x]{55 ^w5֘WSO5n8Vc`5՘Wc^y5ѹ̫k<1ưjlƿk 1ƿj7`'xׇd5xXh5FֹWWݤiVd|(4:C s:+lCXcuy^g_uyXau~Ygu&X[r蓛uUV_uչUg\qu;&q:Wg\S Ny&uVYUgUA 5V[>LkjkpGlh\i_i_,jLjpSY`M5 4 |zްF7xа7 }zA}4xsmgLikigOv4xI/ 4x`I) 4`I㿻{WzW{oog\qekpoK;\ܾIm 5:9È0`;agv8ÔbǏ0dšk0d%;[vÏ~e-;,_vË^0e;a v8Áiݑ{[vÙf5;LaKvXÒ0f!;,Wv;5~5{ھc_#ן\w"tO:=pcCc;vOvxcݱXw;lSvXcޱ^Xw;,رXCw;kNg vtnN׺yW!dJ)M5;瘩7iɌ&3i2ɔ&_ i2ɐ&C i2ɚ&kioZyǽθiorɍ&7hZ6dewM5y]wMn6yeM6cM59XcM5|fq5d`M6d[uMF6Yd{͗ǿ&k+#cl&|l2&l2&Llrɺ&뚌kɼ&ךk29^M&6Yd\qM5_M66dcM6`M5?|~,QEM5Z]MN6dXΙ0ɨ&|j2ɰ&Ϛlkɽ&k2|M7?2iILsQ.v˨]^riOe.vˢ]jaO3Φ]F2miLe.veu=b.vy˻]2ow.v˾]m]Xˢ]&rjYe.v˸]2pe.vGxsg~X˵F >ﻆ| Mto3=r<пxMw*-;Ͼ'Wsoy/;omWpWozEʿ[_y]wg*S_Ew5ϿεܻZxWj]kwuՓrW_];w5ե3u3|"~VݻtTwt\3?u#һ˘.Z}W]]irm m^kO7myߕy?{_vŞŞƞ̞=ȞǞʞƞ}ɞƞŞ}dq{9g#]eOgoggϲgg?g_gg߲gg/ggg]̱Dog]mn7f̋3<7wG9Ϭyo)wd/oc?ggg߸gggws#f9{{{{{{{{1={={={o 9   v|uz3{/]{{{{{{{{{{?h9{{?<:;<~4޳w{|:|q====={={={====۽_={gO=s{{{{{{{{yv9/s~i`s{y9s^yf2漏9^e%1==ݻt{xaO+iW 8OcكW7cG3i=Mg߲'3-{osJ{<ؓ﹋m<===ݽ9>_ܳٳ?ٳO9"4f^ffffoCƮ}"{ga{xOi= 9s>}}tž޳{}O=u4~{zuOw=+t垮ӕnd_[k}m-徶זr_} 5׎:poڳ+_D~ɗwu_}ݽu{_K} ]5ךpu9:q_k}]|j}u{zo_ߢ}u9zp_}MBq_}߾o_} uܾVYzi_/} ̿λu E~U{^ w=wk}77r=ןs_c}ݷ#o_?uы4׏q_gk} ۾~}n_k} }s Zw ǻӧt_w}從}K]ȜgFgD]]5~וq_3k} ׁ:p_}ξWg_쿠ϻykC o^_w|9w_kk}?eLk}mGۺ}}SFuסzt_˘fטZs_}]]"Hs_}`LOq_/}1u꾆׬u_k 8/0Wk}OuоEi_+k}ԾW:k9 ߯w#p_sk}߱u4ف6;4Z4۾vp@;ȜA5rΜ_O8O]zQ\06 z#&=Ж@khy_t쁞=еZ@7hy;4V=У_qo}y7t>=РZ@׃1禑9@hMzM4n=Ь{ܿSWqe9w3G[6w0w~k9@C]ypwف&+s̹oy};u?92/1`>~~5='3؛?3!2fp`p?z>>>η8x5gޟQ>2༏8ȼ-so)rmq3/:999999lq{{{/N,+*******\`NϜs?POC{Cmnr4?4ҁ}ԁ=Ӂ 6^P&w#]z{Fwy̡}̡}̡=ա=ա=ա=ա=ա=ա=ա=ա=ա=ա=ա=\Uc}ԡ=ԡ=ԡڡޡڡڡޡΙ׽;YCCCCC{Degeeewoc#m9w]`w>g7~[Z`d^|CzUV=ԪZPjCzOu>:|ݿ˳ <'_knEU>{}oݞ}U7WE8:8898<9c{9?''udHǂ{Tp)}ооо^^~^О~~о~~>W/0oxhqhsh_thshshshshshshrsoڧڧ={C{C{C{C{CCCCC78оо~M}Ǹȡ=ɡɡ}ʡ}ˡˡ}̡ơV?>P_s\{C{C{CCC{CC{CC~{  c޿gW+7CKS3;v:KB{zPCiNC]x%A=ךP{jC=zQdp=9|vuV ?sߣи6>GHi#|R^<ҎG |p+<қGH#=zKF=ҪGHmE5><҉GzιI>!Xw7ϙsstKi#{k-BcHi#-x ᑖ<ҋG:H#x34"s` `~ߣ;aU}G0_+#p!=CHi\?rs}\#r_̑&:GCZBH{qG|>ˏ|#1G>88b|dOLpGL=bcX{#1GL>byΣ\ųy?w >*{5|8G:H,8ipSWi>5Ǒ8 GZHi#p4đ8GHg#qkq t[Opő88G?bˏx}#G?z>?|#}pőF8b{#GzG?b#~}dzι=/d9HC}.GZH#-p&8 GH#]p48GHG?|#G~cvvw.8f1~cOgdh\?>Ycsl?f1ۏ~c\?fJ+>f1y|ա5B׼E}=1s̝c3)Ƿ`mϹϰcF3Nsv>yws?<7s_y\os9y9;hcp5ñf8 zᘁ=~zZ sl'DhsN4ω94''Dhg:DJds#|>a #/'>'?a sO{GN^|Ο'>;Nt O^:g O4 O^:g Ox~f',> O{F'>sY}'le)O<{|g}S-tNu/ww{@蹫y"7>Ӈ[<}z|Aw|?m99羾=ʧ?kS{OSu=\>=ֿTjccz?34+~>}Vd\'jS]|k.>ŧzTS{O_TjS |Ou>սwŧT#jSm|O5=տTϞr?8~o ITGw.v?ۃߧO;tTwjSyNylzvs>5ީ?3OC/9s7Ԟ|6=ձT\S9TS{Ou=իzTSzWO&=բZTjS{aO5쩆=հ`,|]=mFV=ոZTj S}M홾=ӷgLߞ3}{o홾=ӷgLߞ3}{?t=Ӕg,g\㳛5"L;i3}t.>ӾgLǞi3 {a4Ϲs{wD5r_?}K:cN=c.]~f?gL73-{t>ӵgL3y4ٙ:eg쇂Omw9s533ZzZzZ2]ƞeL `K{`K`K`K`K`K taK^KӵtWKWK{WKWKYKõ4\se-f- `- `- g-a-a-a-a- `-`-^-^-V-mzZZZZZzZ:ZsOYKtYKw4V냡sb-c-Z-[-[- J-=B-C-=C-=C--B--:-.:Z:Z:Z:ZZZZZ|ꡖ>ji&j顖j顖j顖h5---:21Z%.Z&mmGmmm- mmm mfim[omfkCmYfQEmyQGmyf{Im&fRk"|jͦ6ljͦ6lj}pͰ6ڼjͪ{ܻ}>ksͰο5Ƿ6\ks͵6\ks͵6w`|;8g_ۺ޶yԶVmk|ۺض.mkpض6{gmvzgz~dha1klUwmkt?mmlۺڶmkhIm-m[KҶm-m[KҶm-m[KҶm-m[K/fpXgض畱޶mm[o [wݶumm[s۶{CF[mn[mn[5m n[ȵm-n[mn[2wyin[5xvzioʿιϱ6 ?sͱ6ksͱ6=Gι6k;6kfbmخtcWyffmfٮwhmfff #QGG·8Mw|Mڭ>C79&S#v3`9sܟsy~qɱ8yg|1tu+(:=:np;6%:qS7wqKǭqq;;sF9u>n]}U9?/::%/;x9_qygG5/pE;^x]^x7-+tێqnWG_xus78x͎8V:6xOt]w;x};>C?sÎq|񷎏;.XdΕ{ = _u{ttSO;ogu|qG0/:>r8/9.;r9ꎆct:ǡ1(ca834IJ! leC6Ĝ! 1g9Cbs3ĥ! qg/Cbc2đ'C<K83Ē! d C!utȺ8˩̷YsC!uv:;dU{-{ܻygsrZ?dY뇬C!k~Z?dY뇬C!k~Z?dY뇬C!k~{O~z?dYC!k5~zϼW^}-04Co2ȵN C:aH' i? 88 C >uÐf CaH3 i!0S7 !i!q|C bÇ>!~>CbW3|GϹYtȐ(CcH 鏡:ιI>}5Cz1ņ>c9ߡ4Ԑ~OCjF+]nwvy^ "s;c.k!6׆ڐ^kzmX ` s2;;9QzrXOa-9%䰖֒ZrXKka-9%䰖4sg/8_a:\ka:W갮.c.sr]4&֤ÚtXka ;Ku.֥útXam8FֈqX22oe֑:rXGa9!>ևpXa]8 5&քÚpX]{;tֿw<]W|W<׫zv``Wka95օÏ u>=iaa:CN։:qX#ka8z_+5~֖rX[a 9 㰖֒ZrX'a8փzpXka-8eúl7<դÿzAYϹg;ܫxf <+WzX?a=?_|ja=Çun:yX'So<5ú{Xoa=5Ú{Xkka=ֽzvXka:EnzzXMq;cu찎ֱ:{Xa=9 5߰}e3ް{zoX3ka7?5{nX Zpha7φܰFhmX ka3 Cc:? u҈Fh#:iD'4uFtˈ0#y,ӹ6#fDӌh=3gFˈ1m\\3sF͈2#ZfDˌ,0G3wFΈ;#zgDh3wFΈYp=uЈ8#gD.2yFn?#FЈ~cd~^ۇi2?F; 0r9G>]16yD_y{wq~#\=0F/2w'NJ#zgD 2AF4ň#bDShG7Fƈ!#zcDoh =13F4ň#zcDW]1+F~&r1F4ƈ#bDghm1-F4F5¾Zq F5ʯQ~j_e(F5ʬQf2kYO\kW(F5ʏQ~cl(Fy0ʎQf>/1} ?7NJQVae(#F^w_/;ysF9:]]9>c}sЙ_}qovy]? >3tqcw>]gt]~o~SHhT9tFuѨ?gT?2FѨNIi=V}o\Q=3gF̨DhTjQM4FԨEh#k4FuҨNYZfTˌjQ-3eF̨>=tuԨGhTQ3wF5ҨFgTjQ3}FϨ2:hTjQ3qF5Ѩ&ΨCgTi13i4͘4cgL׌1]3{ƴ͘6cfLیi1m3mƴ͘6ceL12Wʘ^+czeL12C4ȘcdLi11;ngcjLi15ԘSczjLO1=5VcjL3i1 5tӘV~=]5t{ics }x{gӇcpLi13ƴ˘v{9{}M3=Ǟgsޡtәc`]8;54C:1-5stcucpLuuksvL?zcox;1tc<OX:1sc{w:1uclc[:1tc<Ƙ6uy61wcc'c+9DZ ?\w6tc?+4KX:1sc?8161c\q1XJkWo^q-_c>ٹN]駽ؿǘfif鵘ViViV鳘>鳘>鳘>鳘>鳘ދ%y=ӃKӁ1\1@1 @.c*b(b(b(b*bZ)bZ)vй6iV願Ή闘~i~6=蜘Ɖi.}}љ{`֊iV駘Fin飘>飘>韘}OZ#PLŴPL4PL4PL4PL4PL4PL4OLNL4JLoĴCL[Ĵ@IW܈~j?_ͻoczc12:`\q0?ƵS]89?qns{l`8y?qޏ~l_ ]ƙ?q3Lg8?q[}m}}M{:c\_q 1 ?q]0qΏs~8ǵĸ wkq0u:`\q0qz`,hܺ>n [ǭqCOk5~?nm8ƭqk`#=,g#4ΠqΌe%O ]e-l8_ƙ1Θq3di5_Y2ΜG2Γq3e3\g8?ƹ2ȼ^sg#}3}9g8Y7ιq΍jgup{893Χqsm?<g8Sy2Γqd'w:~sg8+e8/y9qVrsn3p<8?9qs8?9qnrg8#9qF3r|83yw0^N >/37%㟺0e\kq2au˸n'd\q2޺t͸L*gԄPjB+M 4&D,2&ӄvNM3FFFG:iB#Mh 4&4҄CzhBM -4&Є/f⫃O4M&Ʉ6&dBLh 4O&Gʄ^+ZeBLh 2S&n:,eBL 2S&tʄN):eBL 2S&tʄN)e=i 2q>ꗉw&]`s}P>]wޭ&ք֚XZkBgMh 3&4̄0eBLh 3a&҄x9?zЄ?gBLh 4s&τ6gBLh }4&ф<ZfBcL 0&įƞ{vd3ZdBgLh =27&Ƅޘzceg7ΧΘ dBL Oy⍑{Zd5o܏{9Ͼϳs_ݿ_~Cp{g^IzdBL =2E&Ƅ֘dBoL草yO?3o; 3&:C]A`7&4݄s2&G{M74[`~oRMI7&ov}M8'ы19'uNԉ:qv[GƵVԉ:qR'NI8'6o`7sxѳwr:wRNI8'ugpԃqRNjIM8 '5NoE㤎ԐsRGNI9S NjG?XhL'NI8'uԃ?c\GNI9#'u䤎ԏqR?NI8'5FԈzrRONIM9)'䤞ԏqR?NjIm8'FԈqR#NjI8'5FԈqR#NjI]8'5&WjRCMjI5&k#ciI4&uҤWziߓo >9>I=0IM3I=4IO2}Ld$'>&>INOrzӓ$'?I^Oyϓ|$'Oyϓ|/8<$'y>ɍIL`|d$_&<ɄIL~s?w_p{'6eAdưddew/[kۙo&knz=o^+ns;mgncwuQ\5Q|,tkkkk렸k뛸&Jp#"\kƈkΉgνиkkf냸6k냸nzU:&S:"8 3:8s88㌎8~kx[ 읺<<}_;oy >ou ;賝;_;[_o5|m{F|׿s7kӸkӸ&kҸ&kҸkии_sZ5U:5Q3E3_2a4M4M4C:4C:4?3?3?3O4C:4SƵh\Ƶh\Ƶh\Ƶg\{Ƶg\{ӻ|dLƟeLul\ul\ul\ul\ul\ul\ul\ul\ul\ul\ul\ul\5k\5k\uk\uk\uk\uk\uk\Ƶk\5k\5k\5k\5k\j\5i\5iOuiٸ"e=g{o1-q-q-q-q-׷q}״qM״qM״qM״qM״qM״qMןqB?\k|^Gǵo\5T\ŵj\m\R\5^\5L\ě]ƴO9q׃q};et̔2S@q35i>N;ȽN3oQS:jJGM)5tԔQS:jJGM)=4ҔZeUSjJ7M)4Ҕ֙:SZgJLi)3uʔnUy6q _5+9>5|5|-#_)O}Sc#c\k) 0S4˧X>u92GGL}{y:`SNod]:W2;ʔScJcLi?@pAdJLi)M2I4ɔ&"SZdq =&2Wʔ^+SzeJL)2StʔNSs9?y3w͔F(SeJL)}2O2Y4˔fz~y0SfőkM3g̔3SzfJL)=3gt̔1SfJL闩u^70z͋`SlJ[Mi)m5ՔVSjJ[Mi)m5ՔQSiJMi)3ДQSiJMi) 4]4є&DShJMi)M44є%SbJSLi)=1'5r_"s?y~/SeJL)2e>1SfJL)3ct̔0SzeJL)}2U1[͔.SeJLi)]1u=gNM: >   + ]  x::% ]#   = 'xp܀2]؞kq %Eq N&tFsb{>:" ,L0 ,L0҄H&8gc %x^s %8TS F%8`TQ >%1<g ; [̿~[u| '=# s:Np6kN6CMp9{M7Mp7w|N7sM05}2:D?ϻYxs;v n'xu '8x v'؝`w V'u >'؛`o '^s9x^/1   ks2Np8wMaC|N09 9lN9 N8MM~{C"rknߠ O?LN09~ C͍ m m m = M M = M M M ' '{ '؞`{ '{vdZ Z Z Z Z O?$Or?$ӓN:$N:$|N.IN'yqI'9\\tIN'9tIN'9tIN'ٜtIV'sI&&d]ϭ$Jr)ɥ$J2(-}s*Ι|K.ɷ$ӒKr-ɲ$˒,K,ɱ$,J2'ɡF|D?uΙs4xgwt.3猇yes$_K2-ɴ$ӒLK23ɵ$ג\Kr39O]?14$L/ɿ$K/ɿ$K.ɻ$1 ]|v&ٙ^yIn%|Qk.&54ƴ$ϏbCKr/ɽ$Kr/ɽ$Kr/ɽ$Kr/ɽ$K2.9K.ɺ$K-ɻ$ےK#si02$\L22$lLr1ɶ$|Kr)<3K,ɲ$˒,K,ɲ$ I(w}}427I6%N7I$yM7I%8J2(ɠ$\3)ɤ$LJ2)'\Jr)ɥ$LJ2)ɤ$;JJ2(ɠ$ J2(ɠ$ J2(ɠ$3͟iL?7ͦi6MiMlft*lg<4Ϧy6ͳiMle,f5ۦ6ͶiMlglf4Ӧ6ͱivMk]ӥ9æ6ͰiM3la Yg,f4˦96ͨiMsjSӜ#nsp^qo 45ͯ;2yws98iNp,f4 Y8iNkӼ4G19498gg9?|@A?|צ|Ox4ͣiMh9̙f86ͪiNM3j)3'~ss~o~#e4kY;i&Nr,f439i^NrN3p f48iN3pӬȺRK.źRJBJ+ŮRJ+ŮRa)bX[)nV[)nVY)^xUW)^bTW)N8g)W+)Fsp%[w>n^{o[_})ƥxUg)VΙüS L10S L10S L10RK1.ŸRJ=02#SK11ŷ[SK1.RK=2rͽCRH łR\?&4)N8bH)VCe)FD)N8D)N8D)N8D)N8bD)FfF)f8C)FbD)FbD)FbD)FbD)FBEYbD ) ŇƧ)zȵCsq#ʼnNt`I,2ve5Vy0g53a kf83Ùe/3a cfz<;s#g6ë^jW3 fx5ë0kE3,ax5ë^jW3a kfX3Úpe3_c3a Gf0Å.pa#3\Xg3̝Bsi9y/3|a cf3Øpe+31vwD3tΥ0e'3< Gf82Ñ0c{>d~}.0^w܋w3cFkhm1'fČ3bFg]1+fČ3bF?0f/Fꎙܧ 0I?q?~N3iF7hm4fЌynd\+褙gƟ~^9 =f~%[3zkFkh5f֌֚X3k _=nF}7г/Vс3oFh]7f4݌NyS;Buzq֎3:qF'8 g>c\7h8g4fщ3zqF;}8g&8hZ7|,tgtΛ{3:pFCM9-g4ߝ3#s5ޜщ3qFC9g~йэ3_ >݌\3:kF 7fLow=yv?tw F}.|;-3ZvVYM9Gg6շuVwN\&йձrVgY9Sgnկ:vVjY9Cgՠ\Y9Ag&զuVwٯ >աsO7Cg.]#suF=8 g5VՌqVCY=9+gns5NՎpV/{:w\OY-4f'.c ]Y]1/f 8;:bVgjY-1)fìbVYm1%f5Ŭe,guĬbVgY2wza)9GgY;Yrve󬮘/f>=f>Yϲ|VjY0fu,g>Y|糬,g=YNϲyӳe{BYr}le,gY=ٿ>3v,,gOO0َ`ypos;9fύ9&1zsX<9vscx<9Felp9wy=9αws8=9Nq|λـx>w d-xc=9fi90n~ss`scs<9>1{s4x?܃{#.Z~w\mxϵt{g*hƹ^|_^ٻ_9}8|v㜞ӒsqNK9m8#t֜{|dL[ɹ2:tNi99й6stNi933k4ҜөsiN3iw nNoi9=87"c13ӜޛQskNW95˃s-5՜WszkNwNq5t֜ΚYs:kNͽϽ7^^g}yK{oNi9}7+(ցs:pNi97еusZnoNͽ/ttߜΛ~seLi9]6Ԝ>|sbN+i9m5t؜as:lNioy}.4_€k^oۄ j9M<=74ݜ֛R4ΛӃsueL#5kt`> 9t\uΜәs:uNN9]9^׋r^ck|2 %Bt\Gym93Ɯטq^Oky91痻y-9!伦_2ټאzs^kym6ټtۼvrs6mBm^ky65ܼ^qL[m^y7y1}3γsy~{o>>y6wl<=^Ŝw>4>8Zmu~:?o[Y3ϚyhG,gs_xipm%Kx㕎W8/:2;]/ٯ_{:^ǿȽ7g~:%{K֗/٧_;6;/ٯ_zs/Y/uZ"P~zz:zɚzɚzɺuZ{ɺu>G4t۸55uvddF8q}}}ɚ}z}z}Z}Z}Z}Z}Z}IC_3"0Ry>W\uK u f\%]%]%]?,pb |Y;x,b Y`Cرv,pc1 |h,e'8,0d+ \YgΙsM mO[ӝeikڟާc9H m=M[kٴu6m N[4 5>mO[ӜHOϭExn.,oH/Ϣt2xz>ҥEiCiffH}!͇͂k9HifH7iޤyC{Hs$͓4W|Is&͛4w,J(͕4WҜI&͎4[lI%͞432ΐ4WI%͚4c1i֤~P؃#O^OiSOGF"\Js)ͭ4\Js)ͬ+J3*ͨ4J3)ͩ4LJ&ͨ4I(ͩ4LJ(͡4,JRp̈́4ҌIs)ͤ4ҜJs#͗4;ҬI$ͧ4H$8gMifyKC3Js(ͅ4{ J)͘4I"͉4Wo#m-N[괵:mN[ﴵȀE~,rf;lXd"/yȋtC\Y"cٷȧE~,B.+k.jYYd"#ȍE,2d1Z3g=>-jWl["YȖE,rcKYd"wyx.\Zd"s9ȡE-iMYd"{ȗE,ri7f"GYȔ ȚE^,gKY|`"Xd":Xs&-2hE\Zd"_ȕEV,cXd"[ٲȖE,r` X"'ٱȎE,d3Y"g cO E.rt\]d"+E.t9{g"gE.2u[d"#E.8;_c{suwz"h^dCc]|}Ek5њh_/89ȐE,2dUY;{ƹȑEN-rjSZ"3}=]W}~Cx^9YE.m;=C?~/|۳& ׹o \>7|n}gˢVZXgڢn[SgQ,Eݳ{5ҢFZHbZ?-Eb%t5Ӣ6Z:ZgQ -E 2%3ޢZBhQ-jhZ촐NZIAE?͓BB-@ @ =ݓ-ݒ??]8'72$[2%o2'> _e\7etLFdn|j蚌蠌蠌62c2&i2z&a2&i2w\k#c>s:HݔF͔KKMFF픹wS;eRF'e4RF3e|jfhsm>-<;ݓND4QFe4RFKe4NF e4QFeOFdP93hVh 3?}-gBFd4QFeCF;dvO= MgFƞeY3p;n舌芌̯sYFjDeİ%-1hAKZ2p*é%6-qiOK\ZĨ%^-DS5Öİ%v-k):ۖضĖ%,jeKL[Ģ%-kK[˖Ě%,iMKlZn{ossxĪ%&.joK<[˖%tͯ;[xij%~-}{d컺}G1-qnwK[Ľ%-1moK|[bBܿr}#%.1pyK >Ļ%-puK :tps6.qpK\bx%V.1t_KZ=.1igK[طĽ%.k9Ǧ_ n.==3gsk-Ow}^^ޯ%/nKl_b~3to_b/%>.vK]:rK:aK]7غ%.uK]?8%.mK]Ӗxĵ%-1mK\'ǥw 0]H䙿 =_\3}gؾ9%/逥ODu4'O/q~Kz`߂s]B,^bؼ%N/q{Kl^җˡJp%6/yKL_jvcϗ:2{K9%/1?,β;%v/;,2<,dz8,β9,Lβ9,s6,Lr:l:92;,ﳼ;,۳ nٙegYvfgYgypYfyehYfekYf;{ C/;ng~,32:,=,ӳz ,׳\r=r<, ;, s:,lβ9,,Ͳ4,KͲ7,<2;,<,/26,g26sYFgِbYVdye]uYVfYس#\2)ˬ,\r/ˡ,7ɾ}e_~es{ݾ6>׹s9cYffkiYeٗe_{Ye^Y6feeYfx?cum2s\r:'''˰,2*2˲,˲r;˹,\30˨,L,Cc2,˶?e^Sk~eYe]kYe?c_{r.˭,ò2.˼,8]ƙb{WwLaYf9` /̲4ۈ=3v08ٺe.stggl$82oe&/'O.sw \2wټb{u ^f2=1x_߈Ϭuy|վ>4_,keͱAuDzX'b{<_y{7qO,߬ǽ[w>E{jY{,eYw,eݱ;ʲXgY,eMWŲXzcY,k{ȲX-˺eY{,ke]˲&Y&cY,e}7DzX˚dY,?˸VY~X%:eY,e-e˲Y dY,e}}<`^O=Y1:f .>/ y߮<q-u:jY-eu˲nY,jyY/eY,keͳӖӲY~A0]h~ǼޥӖ5ӲXzbYO,ke55Dz~Y!:dk]7DzYZgY,%weL,AhL_-ǽNY4˚fY,kt{od]4βYCzfY,ke}G5ͲYG˚h+i\,2U˲~Y/˚hY7-^gSZ=˟ke]bq _]ug|?;{9_|Ou_uвZ_ZnYS-e]uղ[;˺gY3-ke\ke|\N骜雜iFuI7b}韜颜.餜飜q9s\α<s)s 霜isq9c_}9xi9>Xck9瘟9縙c9v8ce9Xce9>%2v.cwݾ{sq5[sͱ4w98ch9ؚ9\3/gsq6s\q1Ȝ9g}Ys|1G=:tC#r,ȱ8džrq$Njr|ȱ"Ljkrɱ.Ǜ#sO?gKr8g 0K_}W۞Irl=+ddI9&ؕ\96xc9f8cXu9嘖\9Xc]M9^cYs98\U]cN{~t4ǹ3s|55/s\q1os̱7ǵ;sq.ǭr.ǻṟ4_3网99̱5,11Csʱ.3s1"džr\w:W) YT_C>ysx.;sp.sXcaO.縜_9~帖Zk9x]if|'t:Xr1.ǿr˱.{+Z Vx¾a+ [a V«V0mw+SV#[ V8¿o+ZY3+\[Yp^\ 08wu+v蕕+^a W|+,_a WX^= Ư0~+,^a WFpx+^a WC#c^ Wp~+,Xa V&q+\a ;W8ήpv+,_a kWX0+`E] V\}D|{|Y5+?O'\w<G\_~%_o1z_{{Õ_;|`bb_b_bb/uИ}ۊ=ي؊ۊۊڊڊʯVVVVVVVVVVVVVV^ySS؟؟gww؛{Oؓؓ_1tmϵbbbObb>lŞkkŞk~kk^gžjlihhhhhhhžim^h>hžh>iáVAV7VVVVVVV>y}{9g}̊}Ί}֊=ןVeVuVVwVqVqVgZǪ1{{{{{й=Њ}ъ}Q^%o ;{!{>i^j8g'ʏ3w*4{O0Ͼ,oOy}W~,oߕυyX#o{䗻?-y{}N+o7e̳#Ey}L>'йN^'oߔoS2y{=N'oJyO&o۷[>y{Lޞ'kK/ykkښ歭y]y=.tݹxyVYyyyy-y>np|G7gw{gmys4T22wyn_`^9^py pNk鸂*h*hkkk+h*詂N+贂N+覂n*覂n*B"qO[4WAIAKAKAtKA/4XAoVAoVa333[=)^mZ : z z ]ߦ+z :  pе&+赂^+谂*h+h]Cz ګ zpy뤂*h*h&+h&+ƒ9}=i3ޑwy8?8;xy: ' :  Z z# ?垶,h͂,h{<߹s׬YС]ZХ]ZЫZЫ[б[Т-ZТ-ZТ-Z~W~MXЄMXЊXЊ-XА YЇ}XЕU\-Xb-VbmVzVc Xm=Vb RVmVxMsW=PjQPPPxSd(hv(h)h)葂)h&)h(hf(h(舂(荂v(舂N(GkPP}P}P =Q @A4@ACA?4FAc>?FQ`DFQB#Q`MA{tE4HegX|GgрsΙs<T`k&X`bE^yYdhűs"l(Ȇ"L)Ƚ"|,"|,bw\D=.f/;ϳʿZO_;4CQkY^xjpڢ&("달/"L/".:8gx65.r".".r"."s-r"Nj\.rȟ"rQϳ"ϊ<+rȉ"G(Ț"O<)2ȸ"㊌+2Ƣ("'(2ȱ"<*2"O]ϟ\3Ȩ"|*rȪ"*rȯ"*|]E&TdRUEVYUdX_EyϺ<Xd`EXd`EW_EWdaE9Xd`EyW_yEyXdSME6V]wEYWdb DzOgޛBs:0=q~{;w}=:3ڢ-ڢ-ڢ.czz:#:#Z5ZGZE:sy-S2ƿ%O܈.`wh*ꮢ*jtaO:ϊ:Ê:}VjE}R.ER`ER3E-S2r0͊zeZi-TfESlEWgUjUݳWV5ЪYXëL^e*WV5*WUjU2}u8W=ƵR{_e*W5 9WU}﫼_Xe*Wo|2|_Bc}Z`_ȘX__SU֯z׫^X`UjUV}]3gt꽮oUt}q_u g*WپՎ_aU3jUͰ-VƪXcUcjU-YV5˪fY,:eMF+qckUs _ǿ/qw|FoпqW&]ӓkrM_˵XZci5ޚv\ӚksMw˵нTb{ <7{<7C4]ӥk:uM#5{Zi9G0W5}>^ӹk_ckk㵛u^kxMO}sh\7o {;:s^k{Mi5mmu9׍krMW=t3vկkuMi5-v}+kZ}Mî5=q״횆]ӹksMi5-E״]ӻkwMֵG 8W{5-]~$2etߚf]ӳkuM5]tړs5MCt\ktMi5Ct\ӦkqMO5)\{^p\ki5ݸ't~\{iu{y1M?\ykvWF~'r'䚞\ӓkzrMi5ݹY\ӟkzqMCϜ?`YӚkrMCi5#t{o.]@{?=tܚ[qk:nM5ִ8Ʊ5qlck_ט5f1sMìqsk;;=tۚ[mkmMuM׭5 AtG#{F~߭g>5we^}\{onou}}%^k~coԪ/RkW[z-\uؗ?}#|N~9ױ/G]w_?wJWjJou=Y t_uj+y5ZXfϫ͍=wr֟-]NJ|oЫzoc1ZwsߟǞcq8q;7a1q 9nb8s>GǺ<pL:ǔc֑pIǜcڑq,:ҎKB0 eǒ#Xq_jW9u 5Ǫ(86%7u|9n鸅֎[9q;mq|Nou|wtMor{wu|.;;qw;G2]oݳ˼{;帏{sq:~@>#p<0Cq?xA':qs㱎u /q厗ׯtv*k ] ;~&ov.ǟ:;xxp_8!p>{q|y8Î8`}~ ]q{^g:יu}!`[ٺG9uV3yL^gX^:'uv]:9uv~<3={U~_vw>ϳ?w_3NMi5ͺnYc]ku]SuʺNY(c]ku-Auo5˺X):e]uݱA5Ⱥ&Y$e]&2 ]hu3uƺY!:d]uSޟwg>X`]kuuĺY(L[g:יu]GO7*]g:kٴޱ,]g:Cyuήs{]3{[/_Ư3yyg>uߦu #/~N3{ϱ}$x_?{ߩk}ֺY^ZiClh ͳ}6z4X{ZjC m袍Xp= =64҆I.s=ІHiC7m =64jRȽl^ww|wG5opw]'7ДrCn 7^ЋZqc+ss4ƭsV=}9߹s m]7ކУZuCnhՍo ݩ=}ոZr.}k [7ЪZtC?n }'7֌ZrCknh qе|oCmh1E7tfЎqCn } 74↶РzpCn 74{(O<羆=iyѶjCCmt64׆wnCsmh_qOmh 64׆czlCmh_rOn 6ن6fnCmh 6tچFhmCm*t6چ\kCmh -6ۆNi:iC'm ]6t܆gjCSmh 6tԆ]zmOC{O06ֆXgCmh 64؆H{kC+mh o6ц>GeLcmpuzeCl n0x||pξ moRZj|7t7عߍ{97vs6.'aC/l0;K,s%ޖZds%Yh):ga%w%ޕXYh%t]qculqRbKC%֔ZI'%XR&Q旸Q ƾ˸5Ĕud]/YKĄuĕ;Jؒ5d.YKd-YKڒ5d .YK5dM/YK풵d.YKߒd.YK5d-YK έ%kZ%kv遡kuɚ[ޖ%kr釂skt[%koɚ\%YzVg%kuT.K%RɺUm%kbYƖ%kcɚ]ٟ 6zW}=k-/YK˒d.YK5d,YOKޒ5dM,Y?Kϒd,Y?Kϒd-YsK:s%km[%kZޖ^e̺\%klZ[%qz\%iɺ[%n];cz̏{KԒd-.YKd=/YK5dM/YKϙ'aI w^y"ϰĝwJ >RbH!%SO?%XUI'%9r͢sJ<)qo]?T;%攘SbRO%.TRQG%XUR]ƫ=8J*ĬJ<+ĸJ+1Ŀ69ɱ6ٶɶMmlk96YɺMmƃsl2iWd&{6ɷMmrlcd&6y >ɡM.mjSl\hC&6:2ƲMlkA_\_d&6o\3j+|d&6ɶMm2h_LۼCp}86YɱMm2l_w ]3mo\kgd&6Yy޽{ǾMnrpwd&7ٷɾM.nnqd&6Mmnyشo2cyd&6M>l>!2sQ==&|9O:>6ɬM~mrsiLd&6y.8FpMm2no\|vY57yɻMNmrjS\d毇:&69ɸ`d&6ٵɴMm2mid&6yɳMml)d&k6YɚM6mrhC8&79ɩMms_whg<&6yɳMmlc&7YY9.qt:=7-nu_y-nnr[|݊E'k8߭|R䚽[u:r1r\3{[b->nq[boX-o}[Lݺsu`[`Klmv!6zw-3G{li-4غcٹ [zaK#li-o1~Kl----o1~[`[<[oh\;li--oi ?(8[[Z`Kl=$t4ؽ-nw[<oXB:s ?.=>܏wyؕ'O[`[l-o1}[`Kli-`ysÖza;{g4Ŗ[bKSl-o[[`Kli- !4Ė[:b5~7–V[[z`K/l-_;#Ͼ5g{[liWu{Vl1u[ b->nyު.B!B "1 ~_1HHH $g= Y{O}OO}OOݛO O OmO]OOmO~7g||j|j|j|j|ж/K}k|||j||j|j|ֶZ:6AMͧͧͧͧ/QSSjރZGO 7m?ﴽ{m?)GnP5AmP?uAmmO-SԢ>^y35}!?$5EjQZԬ5EjQZԬ5EjQZo>?SZ?wZ7=~}\עƵqmmy-j]ZעֵOlQZ{Q'[x\5?xx^MmQc[ց?S[5EmQs[EkQ+[ԻuE nQ[uEnQZEkQ[uE]lQ['. 8:xk:ۢ޶-jiڢv}HjiC~uE]mQC[5E mтQW[uE]mQW[ElQ?[ElQ?[ElQ#[ElQZE-lc~>iu|)1ߣh-z=A:ݢ'hQ[E?Т>-z5E oQ[5E oQ[EmnQ[uofs~}7KާGh#-jwEnQ[5E=oQ[uE=oIoQ[EMoQ[En5EТFZ -=C/CzzzzzzzzK ;R{^j~/5K}puwDqcK71^CKM?襆R{zLKVR{~m{j{¶^^j}/uZKK'R{^j~/5KR{^y/K=漏R{z߽^\/u:K륎RK{wԻ^]/KRzӽ^_/KRz}^j^/KRzq^j`/5KR#{ԟ^Pg===z4>EQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQEQ;z4b{ޓlO=6佲S-_eǹ?M؆=6<^qrϮe6MYloe?γr^hX.u=b?_ hLjϑlFw5a 9QV[1c JֈjkK߬}A5\?VRu5׾-5cb=vu׌꡵{Q~,zZG/UGC/}MjnYLcmReqb~:Qck5cklmU_t1lc3^ǔZ^9R}yR;s95zLzjCU5zRzعޣ(b3y!?Ǟ:s>n[J󵯆u{:_e/eE,EgC5 tԩDZ>Hy/Ogr> <+K彲,a5+|c]!!W=/BՉa,9ӌ*uLcU]KSUco1}E/Yl&Ma{{=ϳM{ YŹQbrm):S'r龨ZXjBlHW!J똾Z]/6vc4v ɿؾ>m_3|hkԩڔuɩks苭{L!^\/5w Ƣ庡X߹93%NBK-vW[l)>7UsPsSESt]k] K5L'Skiȵ~1UK9ʮ3gy)qkg_rƱ֞ޫuy!ZkeVr[urLIJsB5%yE&RlcIW;繱}a3ޔ~/EF}=]u߳Ӷ ז}Oeulzu^![{^͊z u1{3.|z鲹O7|фTֱUU][׭UU\yWEmVڵc|:g3"^LߕBb2buXNf'ε[}YvzNkrq*??1f -@!equ!6se}cZ2/q景 iXc&hbJ^19[keU5c}hסBr/6cPwRl?Ug1Ӗ5k{v!5YڠBڗ|,NxƖZ)5"mqēuzcŒhϹtkkk]Se1>Pϥ:66V}W,˽L[t/sKƒUgh b?͡>t Heoct{ekA8z\EVs?jҏ|^c~ҧY{^ҧAY^Yu+޳<;9>$~]qyZe]|eyh b"m q5ROcuGEgʓ*ZUll=*{eWKesr^uBb?&蚫G 7U>o2Gwl/gv^qh  ggzbYXkk1}o 5yh/7?#w]|55'lOٖ̱rituZuֱvq!} }6׵o9&_]s\'N@S3uWњ-UjW{o<1T5̓\=ZLY᛫Y:F)!ֱSt߲#kBJjkh۠\|T|?~)cq-9CU~'bEkn~6!]f7_ݷ֡Y瓳6Z|ZVN`.Ǽ99 3e1\i@Q΅ESG}+BӢ.?~Ս=LbX->-zm[HU=صVv2Zw>kX&$?}]UܩĊKssDCBtdN;WwꈗԿ-"T8KC _mk[ڵ<:B/s2ehZ9NƞVnS-]}t^KuzN?'ϝYle6dk-c^ȶ%lKؖ-cc[2+l+Vb[Ͷm-۫lֳ폰ﲽƶm#&lMضlG٫^MZN~2 WWN=lgCMZv<<){&zT⿔g2}U>g9|ݍزlݟW.-p~2 [5r/t,ϱBtjͨ뵫&,rkqcSOSc5sX Oٟ1Bcg_k}MK>=ѤG~neXe`m\ Ww/}E9}Wؗ=1}OS}yZ![WX}ZӖ-k);>?b]:tLRB9[#G̕zǩ1sn]jѝwȵsu f]n91R]ױ}X]Bb!t,UwbǪ(CRj먞_\uW^H_Xwho}b5sW5*u\J]>^zL|֚"-ug_.<*kG33ݠv\]j@JކW=Y]=^l3zdykֲu|(zgAy1vNYϷBXU'uA,sR'uk Wo yUNoCrʔXO-ĭERz:3c!f[b 9zƓzGe._||^Ze;fZkJj/z*&z/>'1cWHOVUvUF7ki~^vEwScѡZj|k,׶hQJzn}s'r|^^δDžQ,>|x? l;߸ʮoy]YcUNQ[2wCi˷y{\JAuQs8xfs6m_k[eԜzWVC4"32ߧĵ+~|gCh]O#˞Z?~Uǡ!!yUVsrL:eui!+BM!Yj6Y点js~ɧE#,|"ԦX ]tZWcuՕ>uHnjVj_TWLBւ)k#K~ Z]dwǘ~*$B[_U4uW=bTG sυ]5.9k5r&З!,߼| ^1uҷZS,ױ%GbʚO@nO?R?#ɱU:%w}PEL懥֕=wê|I޺nIʘC;~ g 1=Sݭ>pjn[y7U%5VS9{;TSr}ecX֔\qc el546b޳\{ƞU;S GN-IE9󳝪>Kv =6ekN90&uFVkjz=:Q묩15*w+}|1*;?M4%7!=u5q9KzZî{rjC,c__LιO_ձnECb/4%Vr0<4/Yr-&﫮wjUcsn,;ue:USR/\,ӛ[߳%l*F\jߡ}^uyQ Yzn_-+W/U˹)vhZH}~f[c#{eu˱k\=K?,=C~U|]-RR K1eՐǷϧ5ڪSuRCՐj}SY\2$Uޣ}uޖjBk{ZԳYcɉZlsN|5kq=ſc6m*lئw}M׺}T{N\ᩢ(ޥleMSr7!良+Bc6wNY]}W{=u)>7oZk]'G^"+EhOZ嬷:sGJ>u,yL'?)_-pD9rz^Uy5,GXzXܪ}ckIk `ۇcE딘5K{jz?v^dZ˗+8 =ƧZ3v 9]}[cu+9kt7-ubjZdվu^ګXi}WRkleگZb Կ!55s=O#BgО.9Cu/Tc΍иr 8SrCX܋>oQc*\gxN]*kpP #֬T=wUO칾uS5}N>w\:XuNc}i/BIN?XR<֩26wjh.Yqگ7)|}J?BkOc\v9E#:;;CݛX+\qb=CzCk ױ13X,*йλg!vUtΝ8cu)hѣzl^W FU>0֖>#D#k\J7׮ܽCfoeB}mYҟx.VW SWm'Kq ,~iru?)YLkYOYmK릞Ush^zx{1-vrcSqc.-wq9H5+wc*}'5B:މ1O;UsEk.9eױC !uhlh2s`{}!˖!kB9Vuz2gWτħ/b4LWBh>.͵\w>;2Gk,^s:խ> u[nVqlYu*/_Bz92K1ݤt9Gu{b*=z;s]~߿=ק#)@I!g퍝On'rFwhUv|1z˞L+7m T+_]sxhoK<K׾]8]f!ָ*6bkCJnOVͿh*K䚛ſRx>-K_)MɟoL޺zԚC9)v1\85B)džֿИև#wj"/dvQeu.{!u GXz"Xju11\fR_S ZthX{Yj>_] ~JQNO⇘ʲh^ųZ嘘*fYYks|y~_Tsct }rgj|0v!kb)|&\hXٖt%?R[^O=}^E[7iQYpQ\+E3ԁN#lS[N .eEξ3ujqU w7{>|l(ͥOu7V}:髡'K}*zNWoj9*)3F z=P~K& c7=͜}p35lUQbe7gͻ^V׫)\xK9T3smnȧ~zLZ߇yk}Ec~>uun76tLU_Yor'5,TVR{B_xr/sccwt^]k Wڿ":elEz_uo~-S~9rߞ(`{?,^U4ssx-:!}kz*1zZfmo5u۵,yY>Jh [9!=EYsϢ;;?cߥ/0YlMkX̡=VH,Eߞ)Gabncsm1rvP~_\6_[!hiݺ?'^ϗ #W)9ktlwb\y\911^LfWo=K^z >SL_cʞk]]MѶg2}qwutUSݬ yԚ0Dsԑsrgct+G>թuhM']cr/ڭ,{XsG:c^<׼;C|$q 4!ǴWqe:\eѸv[\\?k =5nN5:9Q=}}LȺZ'~o{rOL?M{ X幵߯,^zWͰ{ѩrUk}k 0ЮmV3!T7qi/kGYz*K}^.n>*uP.{Ըˡ67_/w}m^k\\e>[`juL<]RsUuhvX4*o\hEbjvR>ߢ)b?Km'%O|ZgC֏xٚ巜1Wv3{BJ䨩 у~|]/:rb7zYG_kUFhU:f>J8/4bbwbk~]u/!ߏ3sKB54oAħzXi׬qwc?^xes}-9b!w/sꮉ)@ȵqLb:^xΚﺆkv{뾏E`kQR˵.NBusgek*T5*?[r\^#׮9>]ks-:O}s"ƚ˦x/뜜s3FKpl>ջ[Gi!Aﱕ8> ];ب/潢!=Ps^9ew\H޸|SWvQuϵ8,KvU5wLl>]gyLw:&a*d=V;us˲>k gߵ})Frg1ZCo[YզXyx(^/4v}9ι^/澡+ssVƋeƸ5XTy/s?gw= MOBb/:!31u%d_Xrݐ^*k- Nˮ['ּsݷh&}]x\}>LթkM1rmӸTmjhjm]o|c ɭN~N6PʵC>N. !1ltXjkإ\5 .X7P?3crmKpiO,}LlQQ62U=lSe,~ !ʱy\ͬ6*)k_}Ma[^L,YP{֭oCͳĠJUWsFNvs[Tm mlg62m{AsM2nLαZUq}!:$f|å̵unu2oS593Z)kZYVαW,5'fk^U !xvvz꺗fW|vy?Ʃ A{{nW}_7UM9ǪU>hhm_=gƕ=W nznrLH/3(~ݜӗ_]R̨r^/TR0<([ˮ~kA_yN_꒵OqǪurUazfX]N}:|]>cs 95Jgza ZR[Bmv=&6|.gWUn~^]{!~|Z\y }C!glUg9S+_4#G/š~>SNL>YvLγ I r뗫Լ]{\a_2W E_o~EO}qheo7>ޢ[]S!58&d[K[eH}竔.mw.}ͩ{\Gx]UNղ}!e}j7~^Q=ێPi_W|7/nuCkOCT#߭b=ϖZkSjUc}Ko+>]~n:5N[M25>}qcjc]GC=M7];놱>W,hLlv?9>}}Ǹ^#?˩!Vgl15FYY_\Ѭ=uQUsĎ8XR;|rB&Yl+U/T;Bl󅯧ט*}}_z\VCu1c`kz-d[b%lKٖyer!ɲ{A1]Z Ru"gul02tJ N;>K=?SzP+嶵o+Bl]֗Xo!;yL)T{\~iC\yX:2}:^r-lީ-=E4ֺt 7m;Nt*X굻_9[亇%C:~B޺xk]0_ Sk}?rtLhG˽rZ7)qCsNp;9?[۞uͯ.OwKr sHoc~[{b>e=ЭuR!9P};6ks5zuZ;'3m_ZH]('F7stGUkv)A:[s3vꖱp秬RM'Q97ZeBâ7Ruļ{*l156CZ9?Vy5&X,c4 ƶt.u1R3]|q+{+qÒWΙkWo3=TQ,sKr|j#tqR CO8΢1UՂ[X`[Qpţ+}K]]t{_սc㫢*+}xnhk-Rs%fXz$KmqBch♱e}EQQs5}M:uvpQbQ1E*-OckfUZZCjt\|e:4-&!kN*z\)]\ zW\}R0dQ6Xjcbθ7Kb{iLHX{{W.XtQ'1+6Szuf:kަh~SsQxݿ)u'ćU|s;sckKs|Z窴cn8׿%eס5H|BL+[b u ==So1/=[Ɵ;CssF\ꏬcՔt~}Zg"MκW.Tmͩ1DŽ8U>J)z._mRju[,d:[z?-ݹn9Շ҄cf6<[٫bEs*gWL[ݕ9^שkkZj z]wXKѐ娵bHN4e1O&郥@~|9c>9m܍}qY߳hi(,sUGRۊ諩UZ}km峟7MLU׭=9.ͪ2]Z3^,>zv}Ϫo ~[3ć!5Ɨ. w]b~Q1eU ,lr[_V|{V/RW}: ~Rb,T;$טk9> kK/{~)s]D6 k ?ZD]+\s+{[2\34]sqmCk/峷!h%$]s\{`w$\rò@Log15[X&'q2_{aמT'=̧{怵0UNϺ}]7G}/ӗ>'t,xh]t׏׉!Nư9E+\q\ |#䳦n|ڍi![Սk)r+3w|ugjZҔ zus}=,}hq!]/lR/vԹno R{:{ܿ;׹+}1n!~XrڒoUuZ1L_wz+f.{6|e]KTIU|:wU,5T-T߽TfC3G_BCaBuKfA&Wk~hѝbQ\=+vcr(go߅6m l3^d6m\yl]>nW7mqt蟁zss̷[4s딝:}s7b"+/{kM^؁z;5NWmF]}TȪZۏ 惺g=ï~8 3BٺzUtw<˹9m]B(cA=<ȳخ׾0!X|`Ѹ\q^L>6_kbu/?\E}y彐{1)zojg-raUݨ۪Ի{\?g)w s^GIՌr(f~0݋jI֗v]WUWU n< ͻxO}mUTri_7nBHcy*WYt橞4_tϭN)Z}jh/[3jTBm 4ΪAh[zmd?_Yzتص+v};r!sHFhy^#~6u1T:63*ORtR'zԾ&TCBk~V^,YBXubZ߬[ Ghg֋МP\Ӛ1s1uEmڤ]}alzXk/~ES:%w^kiLn_9Zsc ٗڗW]mCkO-:{ޖ;{uNٶtYo[6kױ6\8T|\>7׺eױ%Ʈq亷57y7?\Oia, 0(shN5܍9/d,>X^u/}R+z(]1ӡk#e^ >>LkXߑHR:PTД/&VxXeuң^!ė6s4q|TcpcSLRR[4w3*JU{Vxruol;RϵѳD BQfU?V-K;tؗ!mvh?nڿ\Gϖk\ ZoҵyJb&v.?1æּ雥[H5}!ZE[ 3CjwzkXZ+rjش3t|uLrڪ?(٘^Ȣ>+E5'V}}U=)M}euêe匫P{Vi*Ɛ!Z'UsC>?s,93 υ\E!UZKOZוּ+%!єl_56%s#Wޗ[zccr~бwz1V}vάZǪŪQ<;}n?9s><ޝw7==W-X{z7Rs@kKbbsgW:׋1oQO_w{#u_E_;/Q~\r~5F]G#@[+BuZ#\ s( 9E-YkKB?CoB%Nb<64_Cg'kͮj-z>Pwx;WS5KucB3[;1[xY|ZjyQ=t;텬y56Y_R e#ttq< y.?YcH7 !X*XccZfSuB{sd~N_mjϟShMLMOљ~7X?'W߾ڣ(w}z-:wTˇ\#uT=qro91:bբ!mO5ѲNs.6!:zO1NY'YlVt\J=bܒuntnYLXkSsZx: _ s0U]_sm|~|מ^^'5]ȹcX;XKcs:Fc[~/:kgR9A鵺V7c{p.~-vJZ}kv}ex}RGm~(6]רiffo.{XkճX6R["-ujMr׺\ߧkE\ΩϹY8}~1}PzY>pXUˡ1XգX26K:GWXgx9ç!񓣏-nַkOE6I)J9ޢz K.ܘuUoCTO5߻mVhΆGޫ9jdHW?Vc=Bx >˭mU!KQSce&EsϷsLRպ{T:hM-->i%R^Erfnv˵SQ!1ݐ9 Wސ)4!Ts߭a֞٧1]URz& / =ZcBeq9e}-r5>{*kQ?3 "U}BlK)Wiߚ &'-&nV{ԓb\NZXB^[7ChGHsuXdn{R"-rBjg}rje국:)ZmKɜVm[laX;>[({?40t9XcjPHmuicʞ_jtN YV;)@3׮þ\oR[k jk j_ѽuťMяYaCq1%-ӁL(iAR=>1͕)W|z69b/WjySDŽRk>;WR>RU1ޟ3헪{cJtxu/g^꒏rCz~zlH9l[l\ҟYwm_d|6M-ld|uw|g8{ZО$Gxn}9OzRB:Tџq gl}JɵukeWg˘g93S]5S5&zT_nXz:R7-+]ӪuMc11.1;6Ի䂯Gb]Zuuo5o*;u?qgH_sMحLJuk _Bt?d_j},-=S]ct5}tu[sӚUcv"=랟OSu=V\iK:7MCoݽ?瞧.M ]#ZU^e5[2cm˴"67-jo ܪǺƛ+|}BLn8sF:Wp7.䄫~뉯{8Sc_ oK C:K2w_,:VˤŚʥ1X4G/w>r>yVKͅʥ{.[Xtckhogjx l&Mf6yilf6.Ǭ.K7W{ :PVc<~__ڟCs=[p,u%t(5*I]#n5>c =R(>WQgM[֕1l]/27U[bȦ1ֻ EU9T7!. )OS] ͧX;zTP:/wsUi^v ^Z!W 9ץ sԖ~x/Y/5%TRXpѪuu_Sb(Wum9s,s+'(ůqҁXdmѠn~Pwr_k%ǭy k|耵&Xu~H11sNYb:olW_e )7h_h\~"g>>]>6d)qSy=W/SKѕ<(̰hP7)L y]U_eR73ǔi/b53'kg eݗK6BBkAu?XR_#e9)B3֬F\}JF֩1Y~Ե_"|p1=8\ZWSt5VQ:Y} Y'T;1=XϖR9B#TCߧ9>hG:;g>JuuнtGu[Ucu妯J)ŮibTKwZoU;}{wbhnɇGʼ1컧ޡq\B43usbCPu=nǗ[Nj\5/Ybu{W&+<ƻ,To-1}M6KnԩО8W ]Krǒ%r;_Z4srp!c=hMB}D+?>Sk곏G6uA#ww o*{]vz]ek)^u-ɔruEq 579)=r3LwY jUSCyxNtu|҃^ɡS/K~_"@:uLYSSSSa6m>[be[m%N:ߵauʿOWXsۦh]ҫw3Su_w>ޢg> u,wqL]kw1 @ؘHHۢk3˺-d=|lWvc?e }9`[xsrNjKQihmr_E5|ZSuRg]|O^Wcb:uK5#䙋k-iXob֦0fZ?VQ]}oYcN=u{oV~oyEsoȹ{x.WEMz鹴]V=n8οW .uayWl>SkqaHӋzEC\k*R9fMֵsk|kжNߍq[uI!L5BSv/Wթ>Ouԯ 69bfՑzxGJNĈK|]ة矝ؼI]<߽sZjW,dOJ?fWt?WTUc|!1;'o:iP_z$ݭesHo҃ļn{H_rps" v;VƐW1ku{A[W/RRrIHl il+KYu<kx˱l}V)\ZқU1-:Uʶn[9kZgusݿe~/zgn:wlI_>[<>XƖr/_CӉZ勗rcL,uv=-cz'WhWqVUS~YUC6tofk԰T<+Ɂso_賬XGQZƚa=屒 k ϱWCstOk[-x`?YˑzCB"u;;9c1G:*ϷԂԍ־l1l-kRt ~9auNǧ־o*UW9cSnںf7˷S1~s.wu{`S};&%n|R6PZ{.Q+9h[~.e딟]ZEHX{tC|'%GCH=NWk.)ks(g0~cF>>-,#un_JטZs\Vv\Nw#BlѼA%EP{EWBs[֬gZ -bYƑSO}k*7RO묕kӆc)bٗ5ܾʭO):c>-R_>[Pߩ[gꚥw-Wjҫtڢ[UCQ?kWU1OK nV11Ծ-gԱ?d-92oʡݖcCjIlo Y=9?'i]ZǾRu-\#^MԽc{yo^kMBޏ^§;?1XӺ3=C&>g'_LSR9us\9l٪u/ES=UuƟK\qu)qkw513m*Ojx/S&X+~}6iWr۲Ij-L}/eZ:9zOZu!sNhcLݫs옸#c?ՇPMlUϭo.>c W,5.goeu>O7nFL0Z9>V}~uD>Y|T|0P}]]Gڋu}ߘBD~2uZ+Clߍ~$W}/%&b Tkv:| gwR:6!sֿssWEDJ 9k[l:W/n9{yHj@|/)t6wͭY^{/]uϪkoB⣪%殝)v)Yt5sŪ%-q|$+>W1{/ C>H]oVqM߱ƻ\; Z*:%և\DZssZoM+~Sr\8sORbzظw?k~s\ۤheUԶZ}U`jX~rKjnȝv}DͭBOcɟ2 ){'C?"1v{_hoʗZڿ:j|ηėdQJP}#r]cL%U֚3XrÄS{V[ZS7RzÐBb'VT]GEscr-W,`mW Go<>(W,cgU\W-}v"kñ؜hiϮ|JB^ 34Bc*T?>^B&&jmu#!e\1.Ӝw]B.Z:yը9^ڶ2M,Ϋ"w-ul>mw u[}.z]ezẞ+A}VLku?_}2ݲ̿[CJϧUW[笱b'VW]8juu?>[SYa1[kf84biOl?e[Y͢ )Suk_-=u5/z틭1J6xϲTa{XU{+CʥO19#\zQîS6GKOX6V_*xчm9j t-R[Yd2֋Tbm}֐Gur}_h NsbsSyI^t[5QCׇr 9Ծul-q]uFH]<_ ]틍Łޫn^s7cRhxG%6]߇GLORu/Yɘ{",lsc clz-n-Wi35<N FUEwv]gcuQG z{_!Z<רR?bSWmn*Zu:cuի_W\iG ]66ӵi^fnW]DwbQ:W 笾1 w~~T:^~\ kK73uwLv{=mO>*̭N;[嘫~(VjmQz(6Xuשq[2ǘC1 |^[]ޠ͵lyꫲǭ{3x|YlbkZu!9ǩǶj`ji؈1v9hEuF!2ն}ܱaP{ ]߁~|~V !Wul'{#RRsޱ?>';9s:sC{n1c\}GJo+91V_=BzBl1tե>X>FU5WϪNzwb}j=wHb2jGN?#ptHt顯XEr6W} 𙃵hKե r|u%볐u[>m n.{6guZs,QvG\YU8Н(U#})}Z7.嚖cޯr7u:џwb]";vk.hyW?k\_ 9&Z;}b뭵 =qqKC]L5(vCjN&UGXlnnvhɘ]߷yr9ymLϒzLh2cb^ݚiBW.{Z:G̔_9tFTb[Ø;.t>g)9~N\em 2Kԛuqcbˢ19?z)f?Dobs쵫7 ]>r, YOhon]6|* $gRj ɹ\}sgN.*Dz}5wTOw136Z19O]ȔKT;|S|> 7bSjH-X?[uZs<.qNRzG-Z'sg|bjPɽԱNdw'}jU~s=)j_U/etiO>!޲?GO~5R=YZn]Ԭ/= ]~HYuq1Ui}/Cz]oU]]έu!ssoWxқ &WklՄ[Wo?xn19~~-wiՙnbȳ\Vu 뭵6,5LW}}fQoZ|I5G!黨uϳ-qV)1m;U5{5k]i9UYyct]#|:m^"2-}[?DBkL}i#UGk|]un׌2^z~r=Sq\_upe9jH\YQ̘BkZ y?|/El`BVgw)k]=>Ts)GV9\{l> qeUZtsԾi*[~=V{̥~1YA'> Ϳ\!k:kժbS^;?6]G<~/aJր9{l|^lZnYurZ5Bcu= JKSzV_/ZwCS}>p=+]o%v2_wSU؁z͐~;DCBjg:wT>:N۩}^o_+D(c1R}c=ZKB Y[]>?_b;G9 ]^|>jq7̿ί2sk_]3&kPsQeUu]b"[1Ng-=}#_@ٽqPճ|s_Ok\Xk9vN\;4W,q 6sU!ZC-c.Cܪsjct:vVG }lSئ2=H퉶X{x?{1saU]H_t[γWh[Ѷ3F5зr]_19:ܱ,\#$,uu^(C}no^ʽUԭPXU-ceʹ_!F>#uqLbkXm}ykN!q6Bb8oX;Wo׾|cz\һN!h] ^`Կ\}^Tto<}lKktӵ-zj?s=s~%!QlOWh]e|z7czwNlBzRz7x rP^}5ߒ[y\ >[ks=hTXBmckbU]q!>U֕C1RH\rƧe}k9c> Մ.^kyr~!:l]}=o}`YwǾ:G_aժ~-{ YCkyپި}ϣt\&r)TrʖX`kW9͍cY0_OkLMK%!6yk5,w5!WC>8tesk5%FxPE^lɞg6m l3^d6m\yldM[/ۂ:lt8 4[qwV qjʓMꆱtc\뵐u ]˗= ]=dzߔua]"Pv|{Ů_V{[ed,U5Sg%e+F:'3GbW]S(32+W!*uK>t9G +ŏy}gƧk)z:ws}ƞZCcƒnɮUQ߸bcɢ>$5,$R[uZo\Tv8J񑒿zF=شR>hG:$Z!\kgy/ՎEk}/zove'UL rKZgNXRr=OyT|?5Vg'-?pdYk9WM1fٵ9'f_k_SvZg!}5U\v}6rlN?WnunKVH}r-MW.[5d޹lۡ/&R^~ZZe;fB1bj{׮{SL}*c|ηjUBL&:/S\b4(.ɝ{!qk9! ;]c\~1xs޾~6Ey!ZUEc!0c}^kU:[TG\U]ƾ1:}1Yt^}}p{)CZ2ߋBV״cHٵ/bkv!3T_t9_l?&.+KޕңܦS+0ZV~Ǝ5|cV^<y[c{c sg}J'ZQBK~*(o7 x>_}o^ȳkVo}}Ƕb]sԵY'v[ϟ $4b*X ɣ5%ޫwyr=Ů-;=̺s,_rأN(e=A&kn<%Dֿ^&GW'jpߣ}Vyeuqb֠#}T}_ɟ۷::qǤ 9|s9K3fc2\g_fːukgW5:о?W_)toXkNֳ޷ojhcQRʵ,?K|+eM(筵7Po!G/ĜWCC2 !=VV>X^Bu9?w_=9u) W_6keWѣԡc}d9u]Wv弲/Z!.K\|wOClWr~Γ{@\7 ?s~\8qv_ŗWxW~~S<Κ'>{EY>sFپ9wo| YؗM[ċ nLZ=}%bcz@8.Vb~nsCFLul_箚җoh}ԺԾSq) "tZcB`w"1^K1j5ƫ։v"ƺϡ#*>?5R{~h}{u<)UsĪ}`Kc?n\iG5G,~PT-kϢv擻7_m &Y٥ehg!:1gתoUSGNċ̽MרCt8dž3X-]8YΉ)K[4âS9{\]O~>{Xm]z:vmkީziY{Z99b꫘~Z,X{>J1Uo;y\h4̥ Ϙz9-#ZƖXs\r/K2ʎ5u6=|u|zmC[k}ykMK /)\/VW|z1滿UX!uc,VܗgV ѴXmM2YcŕϮKr]߾Ԯ^͕[eu:lTyݸ̷1'.ؔ5BP-կqXKѩ2R\r}ʱ)<5cr"NU3ĕПsH}YSvk.YTM~^U;Ụ,vr;ʩO{1Ԛڿ_@H_?uj_SN~xn?9Nw×:O~ϯrogxk'k~g-ON;=`;A'֓^c䯳>tܒ7xߋY;ObY~p~;Ҷ{ȃ{;g>9wmØ:C|}/AǶ'i=ğcN7<'jϒg{|pi[{zgi;tܡ 80G r.O~?O.xȶQX7L7qÁM!9pȃ-spc~=Iſc}ܷ8z.g'N:vߛ؇2m|Kzm.[mKl^f[l^g>>f{0Kl߰baA)fGQ`_SlcE۟g&3 1AZl 1Ak^e#lmbSl_1AOlk63 bT'˓ROO2'ɥ'˓/O.bc>O2'ϓ̓'/Ȇ$ΞOlo6_O7l}{?ES)q6b)blSSoq>`ÞO/Oyaç`ccl)l?d#."Ol)?FC!7B>aClcB^a|Crzz6_ !.C!r{R؆2ΡPrb(q9JN %yCP{(؇CP|2_ %7CP069 %W %^dCdžC`#^⫡Пl(JoCPw( %bnaCP4`(g(vCPw(q;Gϰy9>ÜAyAʆ>a\ac\ϐKϠKwوg33?e#Ѐa05 _2gӳYv2gɉgggӳ.R?E E e~RO^>{ {{y:m6bYrYYóYrY,~y<yY,9,y,y0:0[g\éѫpp4y84>F '3hpy8? 'އS驆p;&4qp0=N G?ph8<8 'LJklp|3 gs9r9jss9l9949}s9{_?v`#> vF#hHzS͑#kG3#b$ul$2xVD+G2E#đHtg$q2>|$8&D{F#‘H<I; I܌Ŀ#Hl09d~#H4~d>#Hrw$s?Gϑ/KQh(g4El"F1Qh((rb91 E>G BGGQGQmlżF1Qk:n?"G(0&PW& Ԕ ԓ q-'P'` l:ܞ@L` l0L` 'S>O '0 ;=]&D5ቌg.6p"DnD4}ȸ&D|47Z0N_D|6XHO7M$&&Dp&R&2԰ԯ}"D>w"x'I`q<8/&OB7'Q&Q'9Icl;Z>Lbn&aIqz9$bc11N"&ЎII$4r2:5xDNB'׿IɌi2=d5>c2cLMF 'sdl2y6؟&?NFO&L9ؙLLF#'&ɏy2dk2q>b2vL~Mƶdjd4p2k{21 '듙dzhdl?ON֓ѽԥ)h=mnLSt} s|;S)i y09M'Bݝܦ0)i Z9>k :29M!_M!%Sn 0L'BMA7cS)|5[M&O!ާS)a >BOM!ק)n >BMaS ~N!)ts )GST>JM卩w*~:`*\kSST}*JMJ.Me^ST5ʜ'Sm*a*STi*soSTjT;JNe3L%gg牱Ɂњyby4y4yla:kt|:l:s\ӇN'3:N_3M'Ӊ 7@+g ucA A ~g |5<̠^͠> Gg3 |4\A͞A`N3Ш 65 89Π~w3ԃبY3pA fq\g3p9A3 |7fݳgE??xgQgaYq5 .Y qg{Bg1Y,? "6g1Y,r=,3 -f1Y,;El".g,psE9E΢E,¾l7M,&fќlba6q9M35l3_&gsl|2MΦ糉lt6sfѝu6MfԊk6M&>flx6l6y6ͦFf39g}0_ss|4bF͡ǞCo=ؚ092홃̡V̡AG!9hxC|!`9q4xpc s\l=qs\\<K%2\Ծb.8ؚF̥?N̥<os͹Źh\tw.kn.q.n.}\d.8]⧹s\4u.c.97E2ǹ\9{.scsh\rgsCcy<<͛Ǽ1y{|kO<|5|sc)Фy`6 1y{Ǽ1yyZ1XǜM9X̣'G<5?|n>OΧ~Χ4з5ul` @GM6` A6s n ޠn ` ̹̹A6oi01 W̷hMyM4E|.-zqޢ{nW-BZ-ߢh1zBZx j1shM-[z+-BZq^⽗XE{]/eXF^rX%V{^rKeܽԺ^tߋ={U6ۋz_ԮdyZ@N-/@K_ rk{-` kZ0hƶZ@<- ƵxZ S ȣ칀.,@?_ `j 0ro^ka]`x{`l:澀zZ C Фhzhm!Z]--G ѤGK Brr!p.vZbg!9YH.$ B[bl!9-f Bl\H߲[H}YH\be!yYH .D{-$bBrn!|ZH/x\H<.F Dži!us!B=Z^/G]bͅ9 O hBt{!5j!^aEfY^/BGE"j""|M^mɋK"j",-bݲZE"x="첈ڴ,"aE"l]ZaEE"4h|],B9;͋EbX-o."g1痘K%9~{ xKK%KKȗ^G/Q ^B^/aO^b%v}X| }ZL .&7ӣ,FccوԁŌa1kԁx1]L-Ʈяbl.Ɔbtn1z[̘b-nY-_YL,Fcbbtc1u0YPKKz%q z XX,aͰq/A3Kȝ%4x sYp Y/~/APÖCK%{ 1-~/!NKKh s]B^-aK%Ԃ%w 9/A?Kk k%` /!~?KП%Դ%WKX.!vPÖ7Kbf yZB^-!SK%tg Z-]BYB-KY1Kɟz)^bϥq)[ݖbi)6Z9KRZJ-Ecbh)YJ-6,EsR KR气1/e ^J/EKRhRbq)q~2zeg>[qex[˰24ls6]F^.Þ˰2rr9 ZF]^F m_Ƙe2켌~ay [/ex]/C˰2rsZ\|ae2浌y-c^˨˰2 [e˘2[F-\Ɯe2r}_=Z{YG}w}G}Ç}CZ؇/YzчOe>|G+}\#WmG>r\}Jv#ȕ>⠏}hlGQЂ>jQ_ }ԥ>Gn}WcR}ZGwCȽ>|Gc}`~}Xy؇#}ȩ>-/}}]G. }?>|ӇoM7}>|чAg=˱r.ǎ˱rl-&˙r涜/gˉhrrr4`9]N?[N.'?}A.'^˩喣˩˩Yk/'&S[K,ۿF/Zˉ˙rt9q9.'ޖ3e2v~L}_/L>L2{mz2ez/S^f/S_f26~;^!^!~^!v^F''W+h+h+ z½^`W^`WW++zWm0W0W/_]A̯ fWs+p bn1[v`+ }߭@W+h ^8W#+ 촂'XoW+V?+o+ V`K+Нk l9g^AO@W+ 9`+ 湂i~^.Т b|^W e_A\ W+Jr%>ZI>$W+Օi%6[INDW+Jc%5}%YI\$WbJ澒XI[\W+ڕy%:$W⻕k%듕g%J߭$_W2J9D'W2Uh*o9BVu*tmy9"WeбU*b}x_|VU׫ի* ?b.ѫU{^E bКUqUԓUWQW1U*g\m1[-Qqu6[Gܬf:ƲYz`ۭ#f/눕uum9{#& ȓuc~_X1uum5YG#w֑7 țuh:캎Ymב7:lMYGϳ]Y\p}ztd=6^Oy'gϭ'Fczrc=q_|֣멋шԾ?3hzr~=6]Om[O߲g.z칞9'֓zby=c^Ϙ3ԃztp=um=yqG3ߐ!>~CM r7oЃ;G?w8;.~߿u^&^o1k5b55jk5b5z85jkhkk1Q_#^ׯкטk5kk5ƾ@ۀ_6Зo@6pt}bmlo` @mۀ6 j񷁺yl@6Зn`>kryv@l`n W60 v@\nm 6` mo4zsȜ6R7ѬFo#kFj#sHon$7җloHH?=H|nHO|ۈlfmD6{s#\7Fbx#n$62ߍF漑uFۈ~m$Fi/{61M)X?lbnM&Mqy5&tx}Z nBK6g& _n"7&4x܄/7ϛ&| _n—Mh&| lЛMwz ]܄M6MبSȓMh&݄7ѳnB7Q7aM8&y6لm&&rv~t o6m&_7~3~ߌm6ԫh3fflxL/L Loffjftw3>f3mm&>6p3fbd39[n&F6cfm&w7c`3ZLLnfg6S63fbb36L=یm6ɛftw3Ll&_Gg_gί3ייݯFyx~z z8ubu(3׉Ը^Go^'_g3hu: zޠWzA\}`Mv}]`Lo077h }y{]oo`77ȗ7ȕ7ȓ77o`-ta Bl!>~B lA--v z-d i 5w =ۂ&la[n[о-ݶ[z-{ ƻnna[M[ƽB߂0-u ~Bo[bMM&~X~MMbMl&5Mla{ Iz_I>I}X|I^I^INILI&&&:&&&&Z&Mj oRcdoQoR[ޤEEnEq| [E\Řfo1gߢ"¿ooQ&oa[[܇Kl[VЭo+Z\J~n%[V|m~[ѵi+i+>ڊvm[a+܊.m%bVn+ڴ{l%?o[V{lJJ>l_طϭhVbq+j+y+j+|5hm6멷oocǷocǷml66q6}MM.>M>FFom66~;NnGOCngۙv潝ym've.wŷRg%EeCE% u]]4]b]...q..1.Ȼ].q.1.=Ż]b]r]..~_Kir_ wP7wPvbv_;rZ\؁~;rcA v;c v`blZہwPv`bjk_ߣ\c=sy=l1zyq{h{o} a{=lq:yc|[GlNǘCߧzOm1'n~{'^g}>6{|~\~zOާߧz1G_ߧf?'ǧw_SGki'}'~IDgvw'I܉줧I\d;Nr'qIDSwRwk;vbhNs'}Nrj'zۉw۝w'ua'cމv;ђ}'Z}vNk'5b'~߉mwhN| ىwbҿb|}~@ 9}~@-]bî0? > ? >}=? _>@> wo.{¶].lȟ].j.pqم}wa]t].].lڲM^&NwSov3nrd7ͺm71f,ɕ|7>xv 즆f='؍w}7cݍw˻%}7~MA_P'P'0=hrm9ރg{=htqڃ}{C6콇\܃CL!`=lC~A{mvxڃ e{=b{bnsCa{=}CMC!w{!ܳ|ދ ;Ek{{^|ۋVŷ{{y/k^z{/Z!KB{^l6{?+%{ͽj/q|K-K|E bh/1^{^j^`/Z%^C%Fe{у^l{=>qCa}>c}>>첏:>l܇CX>>bf6GOGG;#n7>bg>G}>fهC>촏Z܇>;#S}>ivG<#O>e#?}m?6ۏv'v;əc?yGS3~c?}ڏ ذ~;'N'~z~~z~c?s|3w?un?~漟O|gɡh~bc?sOO<ُNG#SwIpM8`^|~\8@;<?yp `||y`eï?|r<@ ;@Ճ 5 y$wRR;׃Ԑ y|=HdѱA c:bAl{ =N$w:H88AzɻhAAt =.N$M v>HѣA t<D^&B1CC+ȕC;1C!rqtrb>va40>;ìI[at0ysyfNat=f>aaar0u0t8;L-:̜3a0~<<#ar0>=LsFKG?a0r\::0t|:0q_9C!s5C!9!z!s?}V~H\~H}H!~uʇ·ÇC4C!=里CrC|!uCb#r#b#zMᄏG#4#zG!>"?b}gƏGG##z=GGԐߏߏGET|~;y=˜GЕ#z#1{;!VGGк#~9BGȹ#Gд##}q!0#t~9˜#rx>~:B{\;JGGQjQjQ(:s(s=O+GQQ(>8ݏǘ141x|;ƜF?|;FǨc1|rz~ ;A@[N9ubpg''З |w|;Ɯ vO`r-=A>Am8OO'.a' r}=A' v9N_9AV'N' z z{\?-O O' z=As'_N' O_ccl1cl1q 6tcbcjcc/ب3cc11~1z11~?$fO'IIt.d,'I|wW'I$?Ob$>IndL'Ib$}Ib$v>I|DORNbӓU'ɷhI$~$IZvd'$s8I{-9Elb̧)yu ;;OQNaS)qs;EbS)q9Fb>S)uX:n"?OQO1S)b=EBCO){ Sw ["O)y|x4:t;M&'Ohi4y&Noɵԉi4;Nc468O34s=\O34<|N3i4c?O3i|~9FgO3i|~קi4u4s9M~&wN3hb  {yX8C=9COz:~y!,f#6sN6b z|yag31g3 s?CgY,:q<|Rϒg,Zzze>gY%gY|uX_gYr,x\=⿳s;}9u9ǼΑ9|uzs}9y9~'=o>|Q7Q79j9}:Gc9>G|cn9byߝCks9bs#&QϱV:s}9<1yM:Oa>P>O>a|kOa: zuظ@~]V%. ?X\~a9|_ /[ @^@.Э bZ{ؾ@\. hsgЪ /P.W.tlu;]Fjrq SzOOOߧSrSrSOhǧ#bO>n}?Ŷ˟ß2O駌SS))v\}>%n?%n/ҋ"롋E"{^$.b/ɿ"=Es_\d{]/.=Ӌ"5":tc1g3q33r3q}}Fl|F-[oߢEK~_~K-%V~K\ト?.'ȉKԴKu%j%tD\\Zˆo.%j%^".%uy]b^ȏK%r/.1Kv_B/K%bu%zK%px0Us9sbs9999y9 >G+>'>'>'>g^ssbss9q9s|N9q9y999cs999y919~_ ׾|AO}A_~?`_K__{_P`=z l>^ z/hԋ/__////7_~A |~_Ǘe|~?_Nheu2|]&//ˬ/ce2yq /21pܻLLvL]fΗezeb2x-/eb2sL\f\Ɨe%%ؗDG____2/_2/Y|IN~}I |I%cX?}$%1~O_2/c_b/ц/фWWWU_O_w|}¶_K_aӯW++t+zW++։_I_aW<_}E||__㯯\kbkj__SۿFf_sьѝͯk5s5~M}&f_K_㋯77ԘoȽoo'0o77!a poЇo)AA!!7? y 6m~o7aLo7l q Z c|C|!!7a,+zW}^A++ B ^aW4 q zp_&_Wȝ+VWЁ+\%^RCW!?W ⿫Ur**9_e-sJ]?2U*J _eW2Ux]eNWUt*v~?FOq^E2hU{y^esͻJ^eWUt8|۫4s MF]F^\ßЂkqy<]ÿІkys^C߮kh5V\F\ȧk5bq [\ȩkרпkԎk5q]#kԎk}_ïЕk5k5zkq|^Cϯkk5zk:q|Μיu:w-N^gNיuq9\gтub:c~ _^v_gц:=u|z9\'יu8ש_ub:Z~^~]Ǐיu|y]'.3Ԩ:u|x!Uznг@o7 j 5>AL_7 j bo` l}w[ߠos797Б x`|77В 4 l}`|7 &{n2֛l&:|>&qwMr&:x_ܤd7M&vXOn҃'7M|q?ܤ$nS7MlyD'o7ɩM^7EnIn3mw=oŷm|um}|oNFn3m6&oSշɵ6vMx/m|r6~&nSnSo6tt:=1==Z=y==6G3'~'~>c{zߣߣ}3h{= ==h{r{j=j_p;?wOw;~PK0;0;A`;ow~aw}}ow~!wr1x!w;?wȓ;~|Cͼ?~ @.@|@l~ ?@~@`?3?Po1~`McqX~wq@bCg҇EWwɓh]4.u.r/wѕ].K\%2ԓul.qrKOwɗ.K7wɑ]r.>K ERGGw]b.&enwwс].K}\w]l|#=hӏG#H\H,8$~$~~$~~d|?GHX~$g$n~$V~d,??R~$$~d?rG#6z##=ǏGrG?R~GNCa{qpa{{=p?=};#.a{=ma{sCca{:~u=bq8v#Va{G~=Ɇm"n~B7~6DO| Dkȱh~"~"~B~"fB~Ž?Qc~w ] D_ ĸb?1А?1O''x}'3GNOOwX=5}b>1|OtOl'&h}SYg'6ь}j}j}xg^}}b>sOܧg.}z>x>ϜSn333338LL<FO~&g9LL~&n~F&v~Ə=\*C!rJyWtQ*ɱr>:9uvp6gaa36FىP墽=~u.>\˟sq;W叹5sc.΅\4\^i.<ꮹ7ם8s;й<4tkv [O!tA0aA/a.!nv K x9.n#.tm 0s;nfe7 \~ 4` p) h5|[<Vlw<"-:O_lw-n7S<F{'@y @}+Vs ~@Z@ȿ$Np Q li=@>Q a@M <u ,ݿ@ PGy40O/͓hzy|;niyyynyny}MyG7fɩyvG v?ϣyyf'yrΓp;>9p4_>?e|;4|sͧ<3_.G|͇|:0'|;A md \==A<Aprɯ ~_A7H~EOn og2Huh8H#H. ;!R.XZقO\ `> 6C0m`8`w ^1XF 41X&P| ` ` `+Lt `KLKtl`81-S:,y*)o !;B|{b"cCh1_!x {Cp["!).CF|Z]k!)D;C"GB{;Dg܄=Ğ!aȃXvX@ ZZf_@S ̿@.u-- ̿< @V, &y2v=cXrvuc\]̣_@w > pg P-м ͺꁅp]O zZ\H B^w݅j!o/U n!.4B\ pZH ip!BZ[h4ʩPN/77o27 `=?S7xo93o27s73fot x{(C}'Cݚ< P5c(]o4To9Ci$ܡ2'ޡnPz(C{r,m PYPx;~C*_BD(C tjPw(C;CeB!M7CE(Pp(#?avs=f0- a4&:a<F;an0{#Fa0A av _a)^a#LO0FWax atf0 ga+g|0FCar) av 0Ynp#OfK8n p pwp|H,p: p&\.λx { s8..}}Q?s8.NN ]pm i8L*7R8~a.Y8la.eB]G"4!"`!"ܹ,x7NwE1!B>E9f#G7¾aDh-F~5BFE"^ZEEX$E_E΋e>\Ep^E~wɩE~w,"."ZE2`M-rs.O".Ez,Ef]E]$Qv"/".choxN\Whm1_-ˑv^[rob{s1 b,'}_-ebz\4.ub7bZ\ 2|1|h>\7e1,{1-f]KKXBK.=K%]³K-qw,GKhv \]%]";t Ls .w>8.[JKaT-eKKyw),ɥf^j沈ٗEʥ2f)-5R.-KݤKuR-2t)-5RZXJKͻԬK`9icKyl[aRT,2YLV.32.ӹܯkyoo|{`.q2:_e {]}|Xe]fe]&2;,2/e^eH[$FH)"X$]Fe$]Fe97$}Fg"i4iH[dO~FV"Hc$?GʔHE"G"Dv}xH7I$Gx8m##.ɷU܉woH%ۖ}[i9O,r:[8\8\0Xner}]r=\W,rur}܎yt9.qiq9.ɊZfXro_aeWV :X3V W [A+yml=YA+`Vb%G+JJ]RׯJ[Wڕ`^iku2v%.VgVi%^V.ZfYI+ͲR~FxGdcQf{-,Q::`%$Qp2_|h'n%dW9UUQpQ(7k[*`(XEM=JFE)wTԿsRa-M7Ѻ5ڷM4G9Ni$/-ǣ}oGH4DL4z{6.2-=M/z/?f<oѸhymhmhFF4^$ZG7ZE%'vxUUr`ͯ2nU<*\E*ܯ*7*\EU*WUnU0][ojwjXռ}ڷjڝWXM,\cejjqYVղ`5Vj|+k|[k{ko~^#9Gkd9FkqL_#ָFkkk|_ߚ%Zkv\ob]w-Lk-ֺ:8s::_u`[kͮzz\Z~_~7 ~7 ~7~7~7~~wM~7M7MIGl &9InnMt ߛM:aV٤#7A7ɨM|'6&w&Ioۛ{nvLq7fG7q̛\uf=Ymf^̧uf.͹ٌyv6t3n]ao7f3nvn}m]Yfn<r70ެ6o =o[̾ElI[d[tmsmߘ[`[eF[V[a[dʹo 8n-#c#b"FVh s3111x4F3ǘ911[btLybtL *F)FZ#c|,7}5oL3Cbu},c,ǚ?.c8&ϱtGgXXZ9c cuLl[l]5w|5{,cqX!vCXǺibvb}w6v[&d[.m'G|o8g8v#N+83qv8ӥq5vh'N8{8;85N-~Mg8`ܟݶUlV^*?{VYW[eVUmul[eVߋ[VZJ?[}lV*#ʅJ[{g+Mo5V}/[L[ͽ׶ڪ?unNVfmnmt]MnlIh|l3663msne6yɈmfF`m&i}l6|ovy>vlSݽ]Omv9]/mworx;d;nwluv|evm0NgypN`; lcn؎a[bYvo7vNu;xNwȭa;;ds;A;C%;x;N;Í;̾;;̾_ww0|f݉rbo|NNs;ͷSN;;N;ͳSt7=\;uN ۝anةvꆝ<vqvN++'p Fd.ۅ]v.2.3쒧m^w.I..o `wqlM?}nۿݭvyj7n=6vݲztloὛwݼon{ݲr7?1n߶nٷ'{G1ٰ}'{8졙=:p\أף=ze\؃=؃=8=|l1s5{{h|{dZ#+ȵ=b}Wi{ͽ3p/]ՙ{yw/^_^<'{Wq{il/s/˿{^^|Q{}ʿګn׎{x/nꮽً8kq.kt/}x؇}xg}}vه}z{}죝}V>/>}fGx`>G"<ߛlc>s3>~kg}}g}vuf\Cc)ލ/Gx=񰎇uHtL%$O2cJ$J6giai? _A8H'~<eAqЬA-C!=DˇzHna}{حtaz9aɇi=0r0^-S"SNR;E(E'VR܎)4B):=?)SdNMN9B)|6OY }"KSSb\WRS R̞B[)IM)J{)Rt (oKTyjTDR8SᜊTKL3vKKT\bLTX*_cSʩjTH|*RΩ0H*ϤRjTnT>JcT T=*SajT8i}Sj#?G(-ueGv/Q:G\:*(QwT5Qv׏2&MdO! ipHiNs[<̒f4ܧ5̑vTK;in4xə4ܥZ`! _i4͝Os[+Fh449cc31331>c:& 1:;FO.??;n<#1w-x>8.˒qt|ܾp\q=qqy\qםq9r6~;Em;?C]o;04 :?a0: \ \4}VN yGOt}q/O ٞ}ON^OI't ;!{OON 0 8eyx8>= v9)N$N]N$'eItNʠRޞr9i;i4{RIIx~'yo:礞h8E_)\2):v;NeNN͞S)Z:{O)[4tIUKt7MMt7y;~鴐N tNc:v:=;}'--.ᗮGtYJ Ntt7MtfK͖ky$^tNtZNgui;i>n8n: Ӳ4O4~O4OpWgܯg'gd g< {g<3:쌜<#; qqߞgܷgh ͝3p<yFug`zF1~;cȟ33tyg`{gh o3:[gA/t 8eHʠ  A0˰{ʐ2&v:(wf}3J eMd52`3Avpd g g g=CfQ{'~A+4a 9 eD鶳nq&Yy{geYxOgeYs;+ʇ4~֌geYwYY| geYY=΄o\˔ۙr;SdʴL:4{&d3ɣvTTɫ|iLe22Y0΂qe,ʲG=̟e,rdə,-Yvɂw,Y4N̲S=Y%-͢,,^Ȣ,e,]%Ɂs=gs4|oszN99X9;s9~s|w9Z<'9B;GelfR2ݔ-+D;%![?e7[d.[f7풭y#l7q6f2lfeo6}f˱l7s6f'9[?g-/EζG6Oe>]-aM;[gC]i;./6S6}d?޳eN6dldK6dlɖ2)[g+7}celfUlɖټ-'t l-Ӳy*stnˡ 94#r4G9 GsdBF縏s#sti.͑9z-9|ri-}#rܙ9r6Gȡɡ99*Gp͡㜖ozΡ\m#sdEoZ[(Ƿt/GZˡˡʡ:ȡ~9 9r!r)'rx1GTMQKHm &98qsp898qsp8ǹx[.^rq\60ͅc.ra \xʡ\X庳sy1W)N:W_\ʤ\9˧u#\˳,Wk. sy47sl~ȕSsuD.ʒ\-Wa.ry/r[|C pݖg<{^V얧trɓy&ώy˳[dzK= -'kG}ty'Klɣ<ݑG yvʳOLs!OɌ5߾ͷo>~,+<|||L>N>L$GC*|~ɧ|w[>qӃU[8^n||?v|B&eu>||7M>W~aɇc>0j̗|Oat6y8?/[ ϯz]^~yl?|{W L O/N//l / @r.xA]po_ r}.m_0_p3\Уpsdw./Ȭ rꂜ .]^?x/c( 2@f(g;n l(i()0W\A 覀n Qs 言 IRN {M dLa z-{dL)r@W^.0([o+y[,_!⯐' W VBSB*B] aS(W SByZBT!\ eO! }£ ej!, eP \C-Bix-GXHXG4YB8i =TW22MRhBڿPڿP>ꗋnH~Q^:"/e/ʐtxQ\{ѾEh׋r" \E7E<_E^EE]E"n/ʉnk<]E\Z}ѭtQO^݋f޹$K/q.%;\%]d%;]ro\u-pI_r\K뒹..K$.ɭKv{./DO`xIn]EtSE^$~/".QEdt;HN":*k-ESERDE+r":(znp[d"SDE-"^/"wez^ueex]˰l ˰.lLL~/pY^ .᲌ e,.ˁ2/2=\evl˰g/t~~ueھח2^t{nItP,NJ_lbZ(v㢘y']lb(vb[lb/K1\(4]lb\pL+b>.k*i<\bZ/v[˰bۯ T;} Ș+z^Ӯ+b+b+)]l*MTRwTl*RYP*K骔KRRY*3KU涫խy-rWU_Wi*-]*4s/ʝ4|WuUsU^Way^Wy\*{2ig;L^ɠ27ofx e2le:F̌er6>`\ƣe-ehLǔzxLɕ2Z(+eP>*2]SƗe*5e0-2Z)g>-Ce en2GtA2:*2{_x=ɡkpn嚼&k:̿fk|}vO_knk:隌G5&|k]Oz]_35fk8FM\kzyu3_ף}Nu>#u~n::_uοtmt]^u]Yu]^n:O\]ui:?\:/\nn}˲밸2:\uwuZ=uþ7xް ]qþ7d z7 A7߰ o x7 rþ7w7 {yo7p7 7 sޠfA7ݐO77{w7vCy7vo7'/i?4|yW?l?O\Ig?iO<)48IOsSO')t[՟'SwIʂ?eП|Mۿh/,/ x/xe޿h/7_2/_K/O_tI7yzo݄Ms7M}7i&oݛ{nꝛ&np)oMXM޼閿 nV 4yozM|Msn7vn7q}7Mכ4{ۿio-;Ϳ}-3˿io{kvsmyoXo8meێxo{-wſt}ʿep[mݞ˛ioG&GCc?8ZqS[c|G>vs#n-[pnio[[0[ln9o[[fo-~Kr{rߢ[e[z.d-ҟYzˬz xߺyyz^iދ^K7 y+uf/yI^w Umvn+yfWǫ===>y^O}Xo7ֳn~vz#^ws%g`~?ޭn=3.^W3z{{fY3&zftG/ sg-xXmS@/=GwT'^vx<{a;=<݁;ycg;yîwsLo-{c֣;b<{Awlvx4y^/C^GwpzG;!"oNO|ثN{Y;{g#.;}۞xwFx۝x3<<7u' Iwn=ỵ;|y+JCW-x/_-<k5?{<_go;y.s7ͻp;s^_w.~]pk7]+[0]˼j.k|:ɢr^dzwѴXnx7Cwˡxw?n;gt7lУv7m{4{l.wn;ӻw˻zwGwgxwˏ{d=`{c{hG&߃{z|u?G={<8Kv>h^ދ{r/ ݋{eսp߽滗^yuoGk^^^Wk{i^y{>߇N3}M=zN>u߽On'7}r>}݇})t߿'}g~wNː~~޺_O˴{0_o~z?=G=]Й4h|}<`L}W.x@_< od?@7t}ȟ0xδA;?Xӫ5hA m<(yAzP?M9;r GyQ:z.Q=J |TNmeVy/ϯeey/<ݗ[}YBy-ϷR_^oy:(/?Aycy7_y87[yEy/S^+ا}* v[+n_^h^h+qwSVQVл譂]++{_AUsUdW]+ +uE*x%7h%S*JrWJrmTJJPTޕ蠒;*Ṓ{:2VٕVnݨeue;T^+w*veHe`eR+;y*C*tY+樬W*2+ü2=V6WeHeS6+ÿ2}Vy̗Ne7eWv/V4Zw^TO{TqUKTѿUS^ VqKTS_U[nع ΪޯBUh WƨBU`QEVqcT*"ê . .*4[EUlUEVe*" * -VwwZU*ڹ;}ʪvj|Z.Ui*U5oU>jƪz*oU5[Ujf+ꊪ*ʤcU鯪kUq\֪ZUWqUvUZU\U\UV}RխPV] /P]] ] xUo5VӿYGl&WjtX \M'WjjYOj2Tjr&\fj8&UA5P :U}uW-Uƪz:-UKu;T7u3yûnvnvn毮ü:WCuW\i.˹fN?yQuNC^ݭ]㢺=j4Tnjȳ2 aQ?j5Z g|!j୆;Ԑq5ՠ2p5hkஆkؽa:jط}kȓ5UCא%5dx ]C~װ 9R5dH 8!Cjؿ !? >c8} 1y>s<<|cvLF<cr1}7c s<^{s&h?oq3>n~\.=7קq8?|W8-=n8~qy8<a8q9&ksMXքeMX֔5,#5ZOjkk·ۡ]j]M 4W5&k»]kYM8W5i &jYM~ [\jkٵOZxeZveZvE3PojɽZnWjԒZjO-y]jᷖeZZT=YK~rԒdE-;y-F%jΫ;|Ԓյp^KfԲK-<׶Cm\)T/6k6mצ>MsW[Ֆq^km4X[6[m\[ڸQetmSqPۍ[um\ں̫PkomPkۣܫMe_mBv?a'h '`Oȝ' ޟO'~ ' x='O' ?#O::;ԡ:_uh::\:4R>ȕ:4R&Cudk::t_G:n:8CudkPȘ:C:^w/ƃsZc:4_^ؿȌ:zܨ:p~:#l:𩃏:[KcuuQ]ߓuݣuy+?«N붩|n+3ꧺ9ʉ8WuVnu.W]T~u鶮. ±.嵺|VY]F]z[]Kuy.,4SWV9u]֥麼WQua]·.L´.ׅe]KuI]uVWԥݺTVuJ> '|$|˓0yOғ2I]yRV>I/OƓvzOʌ'iI]'I{ҼOIY=Hh߯'=ӗhGpTOwՓpR'pROG=|ԣz8's=S=YR]ϷG=B=Y^뙽{MדQ\V뙻m֣zXylö]/nϟ_io>ԇo}XV/A}S_׽uL}[|>՗qZ_Շy}קVMTOk_:Y}o2>nr5c;6cj`;]8l ୁ?5A 4K l^i W50h@S p@7 dl\5UW dPY`0i k ఁj@ ` `@w59 @7mih| qP7wCwHCP6# qܐnkC;7 P77ц8oH P6C:m(iC7]CZmtАjCא£!6 aP.4AChh4ѐ߆4 =Ӑʉ4А]C{6_Cy=n踑m$nFm$#~᷑]ṑ٥۩)Mh'#u#;4׍gpH5FmdFl#s7FnFnᦑnnF:kDOɹS4rc>şOSv{J<çݧr?etSz)7S{nO)9>EOȧdS{wS)~ɧh)\MOާӺi}/i]4> a4> ]OӧiZ{Z>#랱3MqC>#˟3r%-=ghzgu̳,/< 4y<7߳x{՟Y>C!gymxVV>KϚYo*¡T7M}Mה\o xn*ƦMqMdS6oSkߦr)6iMedS:mǦo)5MuzS;6wG:n&fiF=֌^fmp~ 7s4s6}3{7w34{37hM7I37fG3=L5E3   辙nofilכft݌ٿٿsr9{='W#9Z~s{9`9{Lϙ9~[9Zzd x\/Y{/ d pyac/._ \_f}"_G//ʫa"Ͻ(_/Ë0}QH/^iE}xIFۗ}_KtK^rd| /Ɉx%ܼD/ɈKr%K2%z}^ٗh%{ /%$^g  B т[ฅyZyZN ohA{-ނ[[ȹoK-觅kapksZZZإoar]Z}ZȻr2Zȹ~-BpCA l!WZy |w n!WZx lnix~^~]G^7ruX.^x}u~xlu^:_7q:}|+^V ߭J2w+֊_ZV8o%Zἕ}ZV8iV8hV=m%;[٫\oV dF+ҊZl+wa+~c+\V4JFr [p7X+JfpڊvZɎVxmZɐVmVmVmE_ípJfrY+mfi[ y\ހ<ސox|Cg!; ^}oȑ7:y~o}C  ^o7xo7tyo {gtɳoʚ7&7&t{i7M|o7M^}Sּ{oM{?oM&74MܽɿoM|xơt&ߒ#o[-=x o-ނ[4-ナӷ`{o~ oɴ3oK߂[ooɏ-|7[z-<\:-6 ymMo˻e0|߆۴6,߶۴mZ?56kxߝ>_t>p~_~}@ȋ?4_|@ȱ@|>:@|`t@$~@Ȝx&>C9!>.a!|;CC|eׇt!~?_, mex[A[=mݫmW[hKmu[hm-wm-uk[ummqmy{D[;me@[mܖĶfoKmT[~i۶r-ں!c[ɶ9jn߶n:-o-_[V{;g;ogvvlَ^;]ߎ|;|vWc;A;7h;߲tLឞnGk;=gpՎ&ٽkgvNss];`Ў,۵#h=]=۳=kڞ}˷^i=klo_{r]˖t؞G|^鰽۫=N˽.mlϻ؞۱۲=r{}^s{=޾&^Ʒwn|`z-wpu:ػ;ฃ;?wpuUЁ;pdl|vpu\@跃\꠫:س<:ృ:إ C;v0=wF`tTځ^;k\vWQfuݎȯXG{veqUGv!ܑ;|Ѯy# wݎ#v#;hGQt}QtgG|vӎӎ83:#vtWvsG:h׎n??Gf]9?ˏY?r~dΏL>2Gr#G[> Go}ߏ#\?|ӏ#?w?潏c1}| ic1?v'~wccvkv.|]]]  \3ȕ.0/ȗ.0"Wȕ.Evqtqu. }uWEw.EWt.--Ev. u.v"?ؿ.0.r v.]dhMЕڵ+ڵή<ڕ/ڱ+>گFW]ݫ]i+ڷ+w+]Օ.tW_WMW{vԕVꜮ]uOW L򧫝ⷫӮ37nx&wA7tG7\un4ͷN7:&wz7u[7tfwn놷nxFM?t_7u[7{uӡg79 ԍɌn.nnnv&ẛ.&Kn8&ٿ\Fdp7^[@7FhFO77`7B7ws7u进|Fh\FOh:?' }O?Op}?'DBOx?I^Oh}?۟K?O;v7Gw|vgw>n;>~Nٺˊ]u_q]vw鱻;㰻;ˮx߻;.ۯ;v4i;vkw{ww towvmw~>>.;nn{/; ywkwv0eZw7qw֝r\:;L?iO~>?)O|T} Oa]?|>OiSY?IS;|JSTjOSJS3{S~jO}Ӄo{lCom==dOӃG{ț|Co^xaf2YzYz;{gyC+==h9{=j=x{HO͞fitݓ.{µ~igޞzl)'{^O)'z%zHO\|O ۞z·'M>=y]z1z2'{ڥ']z|Oi^4ыz٣C/[Ћ>z^xgdg/yKr/h| z]/c/z^^:S^r\%{ɓ^֋wzN/x^Q/Q/I/7i/s/yKG4hn{zᷗ{|z]dR/؋wzˢ|6Mq[֋ߛ6{fomz0 r7,zXo[^}~[F:={qo=ЛzBo-+z۹-z۳{㿷\M[6tЛzBoǷFڇt:>C}B#OY]GF}pG}a{>x#௏ث>>౏y;>vf>^co\>~~~nȝ>ڻ//}[o8 8K}i/\_ +}_y_/}uJ_=wW>}}y/nʭ/M_k|ޗ/⺯ʾv2/ʫpN gM|_f>gL;3ZL~&>gxg>?gnLw}&>3gt~>~>g~,p\~|N>s9>w#~~t9}NCsf2s:F>749|ne9>s9.#Cn~r<'<' ɂ~Џ_~L٭]Uhۿ[,~roK?~]ᾟ\'٫o~~itx7wez/?=fn꯫?^?MI菗_O /~YY֟zOew>O;_?g;[OeZ:x돷mml_0z_ ܑ`1 ;| :O <=>/:lm=/oxa 04ȥ/t: a/_v_ȕ/t~ ~_/e_/t~ ~!?_ ~!;/ ߃_Ȏ/|!;BG| _g_ʁrht4@8䁁o @Z@w@ze M @^@hρn|1Юa:POԑݝig\ ݗ@mz  r A|/ԗ|%쿄|L%}[_u~C9y !7Cm ;D !c'!46wwZO!b!0&b!|4D79DF CP; Cc(} CuPXPPu呡*Kϡj֡ơ1ԬCP啡pJ#C;Cp>[N[zݰ0i|nNcy8j<l8 z8 ~=k8m pp.}8 p6LJ׆n}nlpy6m;ܮq5Oep~Kep96ep]5wY0-0 7Bp##2Bo#`3F0#`4Bzk-#w6BG#p=#9·;#vaaxoGsL6)Fl$4Hy6l#q7RH91#r9GGH4='G=FH=R7(](Q9JόrG0JvrO([{ F(;(=͗hF9Fy}Gm8mѴ6uh|h;hhhў͟hvq -FhKo4m;poѾFl;|4uhy:Zh-SGh|9Gdn11<85Fߍ12j -2 >c>c`2&cxp ͏M5F181|8c=.c| #xчcx1n1<܏3c?Fc?cxw 81:q<c1;2ca̿ˢ|<&X9=ci,Xy4ǺWX僱+XxXKc{}؁-X܏kk2z,X;;wX{XY5u,ݏSc;Vuˌ2֞c9sgqqnqfa>8qvǿp98Su8w8_8qyrjgq<}3q|qh;affɥqt=Ν0NsK8k8ߛ<he&DD'c̝(O&ʒt83QLh׉nӉnre"MtN6&$>$['I:fMrLI$K&coIDd$:dI7INr?LInIDnMInIpć0ILIIeM:IN$_&IvS&un'Ire'䮝$G'wMIt~':d}'w]'&d:v'{'{n'&d߮d t1Y&Ma2YN4?6b2oNdLd |8}Ld 7YMt1YMdO&ɴ>''ds'dY;6ud.a2|&ˤ2i2]LIÓy`:v 6_W+J~tWndWW_WdWJ|%w⇯x+{}>||e~epW+~[+~Wnt~)b)b)8b)BSw4EVN36)f):Wȝ)rg N1LсStz):EL>^b)i _N)go}_|mfξeײk3MG_p_k3K_վ'_ks}-K6rk~ ӯ~kna8m*OTMT:VSq9UVOS5TwT:_e* T2UOt=Sy}q{bi:ujG ST6UMr|*]LuGNzgcr*=OASa9>ש42UO:v*mOyST8Ozj*O{},it4ɀi#40MOipFd4=6fdivy^&4747p4}OOi441ɻiv:MO4MmdtOtnNKyw:N̳tk nxa:MwWMtt;NtOtNe6q=a٧t94ˡ47]&Owoz羟N y]ug:~7x} #7^o 17f&ot777t -}co179 _~CO79o7no q#|CGo~t ~Goplo-|#ȷo[~˻ʷr[V'Wobo-|Kߺ?ߚ[Pf޿5:[|w0v;7w;3~Gdww<ɹ;s|=wNn/~[;zN|p8^|o=}O{~{|~/f&^|C=\7ߛ{o,ޜ{ߞex=~~w?<~~?zw?6A`s?3wote/ry=0 >fj}zbOϠ8Ao3v\ri-4fu>:c̀ π ;̰ ; >a.!g z{t]gOfa !f <̐3 !fȉ3>3xqΐ3 >f ڞA36/O余4S^̤45av3}&f6馛 Ǚ0fLͬęv&΄L;3ybfgLwLL̈́LẌ́LwL̤Ù0fL;ϴLL98'fʑYYmngYY~农eY2dzeY2yj~ggx`Y|3|hs,eY8YnY<2]0&gc_4 b;qYx% gwΒ۳yggc>fNfgv-glZ4<]=yk6ClWl90[nΦٺvgllIa01-=[ΆlM߳qoul}5gb6}Ϧcl2d6fl7l͖q5[͖[s5?9c945g}Z99450GΡ9Wr=]0.sp9Wri=Ț9vc992g;tN'y3GG̱;̱98ˏGQGGXH?#G~Ǐ#(/ˏ4Ifߟ`$~OO<NO'tOI.W?' _?ɟh'?'s^|?'\o~?YNlq~ig ~g3ϲgwY. ?ןn43L?ˡ_EBȠ_/0,/Ȝ_ܗ/t ,~_x:1/_zf/rzŷ//t _h;N/_eU _zW=+~5ϯ:WXk_ͯ+_kOuG[W&_ͯWx*c~篲W3~sj.Oͅ\s5\sͅ\3ͥr`.坹k? sf.̅\7\7_fj.\\uu΅\5si|.oơF@f gw ,lx 0We\ ZY9@>-f0w<p3>o Gz'd|n+@m (eE @@: e9з~ Ni6P6%P%ށ8 I ?H m=_ m%i87v{;*G @5@ k ;зQ S x@qh@<^'{ͣyS<8OΓ=9O8hxs3|#q1Gs+e||d>|<̧vOk>ihܟonn44~= x;` : 2{?A 3Q   AD?A D3A |5H3ȜA|D+A/HL&G`A"oA=H_)W$oA8 O4 \P  Y Qп; }V34,C݃y)X`YL:(Xwy)4 `</n`7N.vj0f0ː`M0,,ۂ,#6@=}~i2؞4L`ߺ2!ؾ k qzBh(DOBܚ!bVB"B:D+D''!!OCxaf0087^a 0 0f0Fav p^}8n#xC7_ei8.y37F=eh8>ݑnpv .=N pNkuCop{i*\ք˘p܅}}eM}5m 6ܷJop^xo~#x""96##:&4BvE"#<7Z#N"E"UpF#v#tf#tf#<D;#pK"hw]"{-"/2"] o-.EhM.ҍpH.iɠEp`Eg~-EfZdE_dXn.?yh1b>Z,u1?-eb]X,cn_,bz\+Ŵve%_£K𷄎d^[%vYBcK`D6,YKm[%]b%[%v{ -%|D.%w).wi O.RZj4i-e)NR/KqߖRR;-KZKmYcKuR:ZSK6K^KR4ճRwKyg)R;,wRYL.2>ZYCloee<̎t2ZY&Keˆx]rp- f+pBmor~LXzm [7W 7V Yo+^VJO+JNVJwJ^wWVf_ XI++ᰒWЕrs\4+i{%]?Wk%ϕf[IS+RtkGPJF(2{{/ʷgVW|F5xY5n5^#o5/khl[k̿Fk{ wk찆Ț5X#Y^kd:[Cgkp->khk;h M}Ʒ5|i]|XkeZXkeZk͵Zky֚km-za-=ךm-M5Z.Zkw-ͯ5Zݵzmݯ3:]':XgursmsC:Xu2g[` YhxZ\Ghw|Y:ܯ'rl\gutt:#Lʹ^V66sM:il߄Mrc$7MnM7ɎM$7&Im&ٱ&|m:MIn}hhOlMo3lYmf9Wq36l^l͸۬_7ٌٌvڌtg i}7;6f;l6ffYlAqgfl2p=6aٷjB[̽[do-M=3o1^-n-rz"Z[dYŌ[`-4E?n-f OlEl[dv¯[9Em-fߢ{ mI[E&mC1|1WbP Nbx)bcPlKډ{w L[ bNormkܰ r|L ߝ2a[w'S;a^;k'LwN;ͻ_v<;ͼvw'䝝SOQ;ε{mywN4N>;fv%wc'줙fifi]tK]]]v.9 /ƻw춫E̹ ̹wsrLͰvn[7nw-w w˿8[f7|vr7|vnwwzm-wx7-nݲfv˚ݺa7/ aۜn ܻb7]nn{`Gfqq {̳}o=fك=٣k{{x{}^^ ^> p }{^}W.函ʽW^]^^ k߽|>g}l`O~+VOF>^'}^>Or*72 ^?r8e@;(^?/e@e܏O}#~_f~Y_Vw׳~~37CfK{"|euNqHsMo"O'A͓s|(ݠ(u"͔͕D}hDww"%K"921v3H#qNp;L8#:8p:`09p8 :?zh<[<9x]yh?p;@p{@np}8I&ɯ$'=I'<ɍd$X'$x'%$7s̓d\|%ɶ$'w;87pIO$ZNMIyx=ܙI$$zNAO$\$GOGݓs/'$Y$;'' ?LIC2vqldw%d2&˭dld8KdJd3ɲ;_HW2>ld,wy37)Yn%#ɾےݑɼLS28Y%K]񖌳dH[,:ă8;hv:hrA;quO=AA}wxoyAiz ̓NOŃv9xw MɃ:(k؃v;v;({!yz!{!;!7!!sHCv8_;Cx:c!;!?Dt!C8;Dx=dCxH.C4y{9gCuCz9=/0Ovoa{avR[*NR*SA*~ReB*]ʹT7oS횪gRZ*VS*S&~GxWGd}~Gs?GxL8b#2#ȷ#;b#|sx^G<G{##;9+Gy}D6#z8s>(ՙG~ԭqT5Q::(^(GqrG}Gy⨹QuGuQuYQeGqpGaGy䨎=cأ?Gov8f:v9Vc8FGpr1:&{9cr=1Yp-pLsc:F_xq>n||\?N?;NGq>GS݊{ܽx\q=ry8=U}Wq~|8Qeqq9.?|kAfx!KЯn?p5'h:a '|BpK Z?N=O͟='uO ߿'d {r:i|R֞=ix8 >i2$O4rR>9̓'i$n>I'{.NOI7I=I'uIs 'ax'u)o|ߜSSNN)>eSx:%/OS8:t)9eSts :NwOS9eSϧWO4͜vG4sZӾO˘|zZoi^=+ݮzi{i\&8Kg{Κ,=|zY?+?Ϛ,f,g^<ϲCg!Ye,2{hs:s8:s8:s|}79s윬=gsv?sqs9ܜs?s9{ h眝9|s>gsz8ϹUϹU9wi{"[f8MMٴ}ddv#ec=혍l{e'˖Wl[6=fP˦lփټ-Gy>{'͟C)휃=s4u9^q)r`cx;G+9ˡ3O9s&r&_rS>rpc>r{4#r`&r`KSz.4K?n\7|el;".|o |ͷCuB\7c>G>}8tO'߼0|sˠ|zȇoaz}s^ΟMwv}w۟yz=/+?/+o< {~ˊ:>=[8/3y=//y~yyΛ<]y?Oy^p\sA_p{>/./]0zA_]0\_0tA__ |ux^`{A_3_ /\z.O]3P]ZN/ȫإ2v(T`T} dU W @o@V hU@tP\ dq `^o2/@B-K! P⣐ tS-I-C! 餐 P^B@(B._!ڱ/(v,_ VhBڭ^4]BʷBRW TW THKtThBYr>rHhދsf.ʲ"]ߋHrQ^4E|wN.w{Q/^E3_ft7E^#i"..;LnK{ %Yr>n.ɓKvK\r#_ґxI_K񒮼/%9ɭ oxDd%y x.%>.K|t Vd%%^%]%K2.Kw.%sjV$+x_d">*[EܣEv+ҳE";᱈UsUDE*r_٩NE)K*"~+ _d"YQToEv)"z,K=xHHVo`{E+cE8-e]pY\e8,/|S^qwَee]e<]wtY_e>˺ⲽ.ee{]e~L|n/y/eZ+O<^ bs-+z2NjS b:*6G1ln1L~1b)b] b[<ۃaobs1>ŴQnbQ۠Wm1r1 yVi劎WpŮ+4sw\q]2W7^+JZ]Jo yɷJxO%v,Q /cJ]Jd[ ~JhDO]JhDN৔KyԭSR.S)U)/گv,WJyK <\J8)O:~Wϥv,[)]JuKn)_)aoRRJXKKtXRUR+O]*Kex)b)-b)JTgd}ʭtxW{ծWqxծW誮JWxޮ~*?_U]U~OWU_ՍWy*ȫnjtU^Uy s s soW}\孫uWʮvǫy.꣫ͫty7U]w7\٭L>̷XxLVadX.s&-2e.mep(y|ɖ2T&d]o2z.O`T2W2,{ /2k[<<}λګWa/Ǝ9͞~ }~ܿ.f_F~ ~|;k5|5{5rk5kkkkl=__ޯ=_ѷ_f_c~^f d7ȡoدoأoؗoQA|u|a@`'}aW@@_߰oo߰oX77777 { ~~~>7d7șoاooeE~~ }~=--t-t--:[tBߢ_E~,--[-goob|^}|[[-9~ .W~~~{CϿvϷ~=6߃<9g~'~|;r;;;dww;ا؛a|Ǽ/߁A!۾=<~/޾Gg~\}O߃9o}?~y=t=2{~{{={~{x{x{? #~`?? ~@Ȁo?[?`zZGp#t#GdڏGx<#?bG?_?bȺ~ny/?b BNBm'k =՟௟OM?! ~wN~O~~B'ĺ~~Ͽ_o?OWx0?`ys7N<9ȳyχ<?xQu!CGs'k#G?[~uGa_<s#Ͽ?#pG`\,Oϟ@{ۿ__-<3Ͽ__C<=p1E.t t .Gx[oy--喣<'yX-wy}pz< {|e<\rw<---Jt kšnaMyX--h~[Yǭѭ{x[a=>4v o[y۠ې!+o;xm<<~dmȨ۠bNwwA#ww:}s?~&Cw^cc#ö%%/a%KK_K/5~.%{K/_"; ~Y}<'w;;῝w'^d;Nxoyo'Nm% dv;vȓ;Nӝk'ɼv'xd'rp' 䌱3Nxg'|D /D&;E;᫝ŝÝNxk'v.t.h`t Bbͻ]Ȥ].d.mk>n؅^b]uk¾?킟v <.yBoBBwbX.ָb}X.l].xmrj킖w!wwa'>vA]KwC~~~~d~اC3ٓٓGng~38r~u?x܏ܿm78ލ,؍mFnww76nj7~w3Zndnln7s7nd7=9wяEnmv#v# v# v#wCȭK}7܍]ZvCww@{=>{!{{ַg/߃n: ?a{y{[ K=?{'{3W{=b2pzxcw{+   {=s@{{=ho|ۃ\a?{p@?<}v@~>>8x<~9rtsy||=z={=zy=<Ğy9=\wrz 2Ap AtABw"G rA࿘|x=z{9>d"{D<=<=<[!!C!{x=Ĺ!C?b!S{z!!!dC!tCؐ1B<_¹#G#|#GG#Go@? A>œaΏ aޏ0}>d>m=ڇL߇]cw؟}>jkv9j>ֲ5fڇ{ie}>ֵ܇.݇Ǟ7ac=}gaCc؋}}}>lG"O~}= < }> ]> M> M>Z.F|u? m>ʾ= O?=}y{{y((ߣQQhQQ(|(x=|x}yx?x x} } gccȐA'AA'!GccȓǠǠV8>?C<} } ?o?x  z ?<| =tky<~CF?Z8|~=|5<6OCCC珃DZ)G<??6g3عCc<q8t8<88sy{8{8{88{8rqdcȥ' ''''ؓ' `?`?@~>~ z~ h x x ~I~IhI~Ip$“|II$ dȃ''''']OO'd/ޞD<^> < ? o?ɺ#sogO#S[a?{=GW7#SûCȢ~d~d~d~j?؏ڏ: 퇆CC~hh?~~w?:v?s؏Lڏ=#SݧǧXSߧSSS)Ocb/Bf=Bn=~>B<_=OAOާ˧XS|)x))S)lWOO?O?OAOa=?ZB?> Źi7fOCO39= =}4{444t4ȝُᙧOc3< =< o? o? M<~<fO/Os}9>46iti4x~8=w9ȡ::s89@Ahx;:O|`g@7K~9Mp:k8gr9}\u5 | 63p | r < k}~|{p 333x xy }|u<0g33ȯgg3Ȫgg9G= > ΟnbS?e2gEb=|=? 枅eϢ\< = o= =? Į>̓Ax 4w8;oBo9dA |}=ȺσȄA x9~9ȞDxAAuyq<YAl ;\= k<[ѱボb"C ~r9h9~\?=}>ǚC&> |5?Ǿ>cM!gc1s9Σ1!ȩ7Cσ3 xS<Ȼ=2@6{fe[cW5t6ZkFkF֬c oY=f\#+؇kd~_##К@CkxfnX5ad .Ȓ5d͚׬y_C7k]f_Kk5g5;p`3m؏ a?6{xXziú6Ԇm ۰ kֵAo `so7ȝ am{oAn {'6نڠ6݆xcolSָAFn yڰֺamލmD?ȺFhmdF|DgΈ Y =#:ddoG0GsD.1#nF2kFxm#f#p #6Fp2be/#7" G2#Gp3B#4#~]>"G?#zuBMȑ =Nkb'wn't^'huV'0Ag 2!&vb' >!&4A:k&{b]}bmkXĚ&̄XO BNĚ&4 3 2uM ??&dȝzg3>fafg~fgz3x͌:gv3YynfYLə }Ȥ5nffl3{6ft5Y9Û3^أ;kA,< hA/\M-}A.yvj~07?΃[Л x[z <m^Bϼ^^'/A///K/1[/1+/A /!^ž} : xK%8z ]ttr%x%h%zK%%h%%%%!!lC!:_bCCz?BGBb#]C43!!d!t!{?mw=ubC!B7C!t!hpu!AX!xk=Z!#~eeee22s}e+exelWWW+++++WE _A&?}{{Z_a@WG@'@0WWW`=Ly| j,ܽ o^{N{ܽ M ^^oB "^wbx*t*z[U(B Wëë؁B^_^e_6yUUUhUݫUWwb㾊 }}5cFV06aa0k88Cˇa= Ma0gì0k93aȖa0t}>; M.CYa؋Ya06aaah020:̞fmᇡkkȤXkA3___cqy  {55x5x5k5lk߯aǿƾ^^c?_^^_Cz y 6kk5k!__c^c]!^y 13O?p'Ɵ?~ կ___AWW__aί_7ۯ#wwA>> ׏#8<^9A&G{Gl#s9n@+G#hx: 3wG##><ڏ G#GGБG#G#pYy8]_GXx4u[t>>.#s:sGكr?Mx: "w+G(88 B+GᕣȕQ}?ZGG͏QwQx(k: oeGYQqsO躣ΣQt(6QdQx(tv(k=.8 EFBsGؼGQdQ(Qpq9q< MGQc1|u ]31r ;tq Y| Y| F!A#ǐǐǠccc11t1d1h;x 999_C>w1v &aǠc;x<ccȔcx:^q;=.8cccȖc1x8<7C8k;?|r8#CG73 ǡqh86qhǡ8k:MpG8Mv:?Κ O"WOOO'ك䓬$:$z$$$|v99~> > ߝ~O{'ݓ螓$$r$9>N{'ὓI$:${x9r|y;88 = .NȈ4x << bػSتS)k;y2;8l<ߝbSv)vB&b X)lSȏSȏSSS#NASȏSȏS)xty ^bONNϧYiilӬ4vp=>nO+Os: N_ipq\fO4888>= }Yt=<xfݧٳӬ4{v{4|w]yz>\< ߝf}YiwO'ON#OË7ili445}~z}x.vݻ]wwYӻһwYǻwwYûȢwB_B_##ﲖwYǻwѫgeoe "{ϲY,v5eg٫YtY)gᑳYt^9=˚.? βgYYtYY,k> oβȪ,|,,u;˞egџgџg٫Yw<==qr=Stǟ2?oSOSkkkktFokhȑ__ßs9;o'ϡαCΡ9s9pvCo7琉9:1ssyܜc砋ssȕs92tqu~=.AS98;ϱs94|?qt:==ﱾS!scﱾ!+caS~z}~|_wcAA/1{==1z>x|Y>x|{\\G޽>>>sy>}h}>>s{}>8~=>}}#;G/GvއG6]{>>t\}o|=Ψ >>`> >@6>`?}{{|{4>Z>}=Ϟoy; ; g]<{<}[<L\`/س Ȯ ,y]s9!t!ԇٟٗ'G>D~}Ț>܇QrN!rCtChC!vڇȅu!>A/1 !>f>>y}|}||<1#x#x#|vGGG###??1w!>?>F>>>bM!>B}?|~Y#cǬc12cd鏡i3Ȗ-Yc>,\?fCc} ~?wÞ 7ea\ do8o 4YAu7o߰Ew"}}__D]d}YEx"k]F/ƋEh"s]_.GEx"r_7.7/EdE"x.g9;^Lu޾o\/.YEE"vEdEx""x~\d/B[.e/-oYoQEȂ߲ߢ~oᅤ_~3gX?9v~9spȍ?>sן?Y_o/54V %8K/5 O%r/ǿd]Wֿb+t_a+pW_3毡F5rꯑ}_C  ^/!/E.KK} q .1K%d%:޼y ޼ \bK%t%x22k w//!+/1K%r ھ]_G.!/<2| [8^_Y :'ة@ߟG >, ~ ZzO^ | k= 'h'O'ȗOߟ0O˟@70es:]F^FN^6/Ãe2r^fo.×2t_F]/eequ\fˬ2}\._٫˜O/Cceh2{ts24s5^ƹ:/>e>{?e>BGBG2O[BB3COϧۧOS<ȌOOȿOb ~lY))| \}|>'ǟ۟۟!>!>CV}o~곿\|~l 33~3gϰE?>?CO~m^A^M^aW)Wth sM^_W+ w޻+ l}^_WWE+u|]A^]p^^^tq+ {ڮ` \'yЙW| 2*2*t~9vMp _ίU*4}_Ŏ *}z BWcWͫؑWٻ蠫*8 wWؒWȢU*t}Z<~^E\E\7WѧWWW׮BSWѯW=W*~*<}s9{={yYǟßϙϙsϱ>g>GΞ}>G.~w`K~}0ϙϡϡٳٯ!C>?g>g>>~99<\cϮAX5uL^C]c=دkoدk{u35^ǯAא=k4{y z s_~wػkؤػk5d5xv565{x ھl]\p5~ >t q =r._ίAk} {4~}kk?_/////Xح_` }:`m_@_/X dG_ 羀w@|}~|ھ``_ o`_@_0///8'||>}]^goٷu:6ux:{vq޿ο̹]GV^G_G^^gYu:Ξ]߮_Yuwڮ{Yuv޻9:::r:w=_ίcCYuuluuz=گCYu_ކ.md6m̴ lC62dنm6nچmhj] ]mcnC[6 m?ȢmhnFnS6 -ncmçȫm6 mnïȭmmt6چf?mxyFmcGm#Ӷm6v6tކ׷qmN66\߆Ȁm~6is64 oC6t nC6t mCk64 lC#6{z\|欳- oCm|FmC ]M&v^dnG7Mp||w7Mpwg7Mpt|7MpqDd7u77YMx&k, ބWoŸ7ǛMx&ڌ&n˦%AsykT ޠΘաQPw(@^v?&9vjq41Ju^y Yt2V'j56Zʻ*;4\=F7ʉeo_< jy3401zkcLmT2a‘Zb(( E似Cc5SoyKִ,u~#PXi+w2WiQIW^P錌_ JU2aϕ c$T4֦oǤef9VT>Ƌ}'z{/#0qvo͂ _[oWk;ABX{`c]A} *J:?_)Q HPceKӍ @w'SIk]h FƵ}C}\rU?v-ʑ-wddZ֐T.6A\ETG-hc4-;/|7:\w Og̷y$?9*fz ųwaŢ\Eo uǦBu;6dTMLĪ7mŲpcd[ʾnoԓ!"ztUڬ 2& ]wsZ@EFz=w"K B]zy6Wc<&d-y-]fy;%*\[qZjͷd¬WF2[5JU;ԭW\RU5wX-e]cC,Vkϫa [ f9IP]u u' cP塵M|i}Q .YӺ2M4vC?ˮgd-{m>dt5ccs玵u5Wvv0rx"M|4؄&auSkjj7(!g[f` ]U/lLl[ȃ/Ɣ]:~6&k E ,zBa/۫R\R5zZU(@ՌT/@2-.Q-8ZJP"bzh34@[U LPǥʉ>mhϗNU\8iqӠ IrK#ꩯ᎔+PSԨqN2BW [̫hz|cJ 5TQ 3*ՃPuG~1JEnw閮ZN(RPd3Z )lԋqZ^'t 9y,rS#PJy56r$Kʉ%STFu(dmUw(@Vs]8 (YK1Jpskʝ *H{R`uB'LPQN^^l|^d⤜&$H;%v6,I(~PͤEVu զ*P6(9 HANX:;_v>HJg+FVƹ&}LL[+5-%f@ھ1n7u Na}hT@gI,Ώj,ɻ訇눃i!r*ARró-ѦbO_q/vѺ'G5@V`:I1g$_MLEoIzj[߲ªo{$6w8@ i|yЕ.J"Øu~j('\yHi]Ǯ^勞.7 /sZ}H[%H<,ygonZL:vtݐ5al}~ }Xt\)DshGF-6mTMPE-2rLRR9-.zq+rV'gUS5r.:ƖUL\O.y1o|rII7~]JjqřFAUZ 9zR~]:"vX]^x;KMj\ϵӽ՞`cvZPh|&3AhsxqkyhT% hKT)JzhTPtbĐʼn!@+to\Ź"sE,5 $~QPIdS*Jj,QI&_\knA/s%:&r&U<͹U JKL}5U3Gyj:A!;aօ yQ 5%"Y5Jk 6Rk3$H~`jl(ɺUpPͰ6Cė6~1{ri%Zb!](y P^R+8dkNj )g/r6,:ɽ6Q5ȧ11"c.(XA{֘o=+@kp=+F gyF\ڬML;Ҹ#Ij쐌bVcj +-Qx$4՘62)YIJ V]-Ic!ۯAJ~쭑]iqR%U_:rTC2Y*}[^5.AFUlgl=4۳5O ._= EzAEVoa! }qB碪}Q1:WYjEaXb_v~*c(ƠZ V)^"3HSmkkzH/!k5&!|-0.HaIk!:c'aZ썪21m붹fx%[ay;5557wH"&2j)邭EMOb+a5Jj8!@FaUQe\vʼn(+t4F; {Ŝ(vJ%TW[_l3r QFauV\J&*{ FU^.Ucju*%5 pBdjYXPD>R0ӪVD &ռQO*F`v truϵ;16+Gȩ.7C Mp`!'@YGݵZqb|V+(`aU3"N RV4yQaX/ك0SSir`&ַ\[kUm*TR-y61"[GYc]c5J,@Ni2&t~ܸbϦ}Ȩn|9ŵ֍Ķj4'HBA #N*{ՠ)B)RaNz YmH'Hi1U}a]C=JZwl1_5$~6@DF{jbnrtXezh V$Uf(?`Em4dLX%6&o͹V D4+4@'oZ5U~Qw A%XW=@* X9JwN+y]5VaCe @}t~$[&vW} d*I(\geWGL BtM8_+k,"=/J ҹ5;t^)>@Q83Sc($v e_rg/kfU@)@BLq*oƵmb4gAơߞy%DxaC&jEE{@DgkFeY}(CyMu%ɷdc zuw (u*RJU7{\Fǭ^1׈VB72QFt#*~k5[.UسȍѠZjUsr|,v.v!./VsŮE^2ZNs=Fgm\>xS'ȩի[$S{ЯyٲUij%gVy6+^"&;8Κo|(TJuN5Z yx[ ޒIzV*Qa&Y8#jQ[ -6S3+W7@F M5$@Q&PUG7Q1wh2Tm$@Sox]wx%{ k,Y|2*It sڛ'?/6AvP$e8ЮFD9ժTp*,n DUtq\M=2"~zȭ $Aƪ-Gʻ(j1/v ׇkjHA :QFuƇMkdL T"_NgN_t_p|L;Vjlu]\OWj}tl"[.D/Ƌi ̹[mZ5a%Փạk%;El$HXm(%M7Ջ-@Bamϖ\52_?[D_T E. inO2ة]]4׎P:5s5lx͇Q.٘&(vSW#[r!ִ|MkՇ8A&&Z%N/|JQ[t O7C'ڎ3 ZхA}<ۭZ##CnҷT&@N5Uktj9CC"A09JVLNW/NgᲒ $d;ݝWr6GysyV5&E#ǦbMLݣD]媶1gz5kx>zӟC,UUs ģ^yUrƋ$A:xZ|%چj(F\b cfea Mb y|ю슉lŠ\ACjx(7*Gyl)-@b>e4 &kb[O1awwm^ ž.%HBa1w,V[UQ O*@e}itVPGӘK|q~srZ#"hidsXlb,tYrvOI8OǶI#Rii`q "óEAr,5K2V_jop>osHbn~^5@DZf<Z*sͣruRPs7:1ZQTɤk\K?ik/Ƌ7m`gz5HG &77v P ʋh G ׮hkwH!rE=4BkpjZ!Ȳ}ڙ3 zL*ZsRa#e|{#ߪ96[IN#ƄUW1s cU]픓vz$eYE"SD;#Ϊ>(#GW]7e^|CcՏSm)2u!KAK!5E7;uvh2V=:PkC]ͭLX:'v ,]PTQ b嚣=A 9Ƿ'vNԼ0@Fb( >NwNjBTje̳5~Q),];]ms M^V 9Q&OyﶢR:t>Bu5kq|vМרsG+?( cɤm2,z]n4NMjxWcs+kb\W-6 QX) m2pO{yﺚ͓ R)F9ҩj K^NNM3] Xz:\5Ԉ{lb9m 1+ν[[[fƋ kT%:1v51"#`}TJW3)Z5M]0J*j!&-& *zi/ kU6{y6!>,m+I1_6k(QYakrs%Ҝ{کo Vѕ( u*D[q9cN#L;Vm3[s:z롁/e7jDv$~ ߬ RMC ju<{%5H;AƳ1@.n.jUtUUX9J^[} 2lMFV* G,57A&ryr>?v ۷֟H W4 Wc+ 1ڂЩ_f.vTEvfW{հ|t< vlՆ#@^..;ik- N\SǵpkX2rt0\NQ5O\?:d,* 2dǬ(Lv ˟ #q5M6sjJd. PAtT8*>>_+͐ߒ]MLdb=O2/羧J 2uޛJoEӗ.T;ǀw 9Zk׮ "Z+?/C 䄥&$HrBgή&t&H(o}E;NV?_,`AͶcXac(Zfh 5FH5$`#".@4[NbT0jύ)6HT͂DY>:EdZPL1kt:ķ/J5HTe7P֢ػvŨˮb(ݮE-ceK'Q])WuU8?F5@^vuQ/Q&9 龁]{|1 ژ276/֛w7?dy5"eֈyoy27iV,AZw%S`t4 668zSM65:eȵmBGdojuf[!ojHktNԦ+TJg n7>zkn-R@HWա jZN2A_ 'U*v+sb(O~ѽ$]3uphdǡ fتrT NVu\l$h62*HZd(ˎX8Ob0H%jZ(}7@L8[)3B3U QZ5Uc͕*' _lLr*Jp7FytfC+5Jj +~:r4DT/SlhcՉ(gvx8'9׃V'y50aZu6bAL%}Q᪥2EY*;\=JgȘhZΊ|vL'VTOb5zƂƨF- ՍZW2GV% J-5^T2JƼ\AKmh;0E T£6Qt T/_JN76T:/שt'^*1JwXQ^y\rBS^A -5mκl PW 哴Ε;O׍zִ%r})Nj A{5oI~M^%(OU>ڴ .R9SL_ɿIh$ӤNj/I 2svrgIaj|2(N1oǝj MO0d4YadplR, jEuB ^44r3rۣrYbfTM؈hԡTob3J Cˌ qC+HUnm=7ҔZ%G9lEc-.Ƕh mcͯMLTGP?6p|5+%fcThtXq{ƋZPI5FEC^-Eɠ2q j[J]-gv/6&!$BTQ%@ PoF;}oZ'pDɢ+jK HP /[܉Q5lE U˨1r:c1) G)iV3+@r3lT:[MԖy-NgokMHOWfG(jHUW39A^Pz >dQ#b5Aqnsj[ W容5q|dLզUexFU @ rI\EM$Z6(@eb hQ4׿Wl)(>@m{WN -hSSQbBw3[/:P=p ; >oLXB >~j(Ρծ@ЖN1ӵ|Czmo=@LU-vD9uFK==mt=I"F5@ groXIn|T׸*Ȗet5R#UAcM :8wR!j\FT޷5L䝉$ʩUqVZBbA25e2v R [~A1U`0^qřgq2HIUVZR\-`ƼE<䄨UWŨƷ<V}($ANZT:@!P68s⻹EUFz{9JF.ĥWS@k*&Hǭy/G9NI-(#Z5&5yQUS"cwȒC P" 5eZF ,MڑsTC/¶]/MŅbFrwKüu[$W+UE{ƼPjhd5lœ sm b _\lArՒ;@ƄK SRdU56z 1ʳW Iʌ2 ҤFGµ͂6 Ժl5v{U]~WiiAvb 2Kc\'fx i@/փ (&Fu+Tur=;o"#\4 $ ozxZ$5'6A\y;toIԓs~EF<1aV>>,6z_VUDcW͂T$SkL 2JREg<1amU#-3,*tJQV틊( ݫAU=uZk;t^&Ap[F0}KF~1ҥ>?2M(sYF ,%BL̀F3rk[&.fTg~R5F k!*ӑ*|  U{%,#t6}U`MtYy\"RymA5R)F)EƄH]3+KE/J|QLJzcߒRנ,Xlw ֎2Wj]pۂdrF$1{3bWwY SZ8Aζ_,V5V_LT} MN]+CU2EU43@I4伏Y9WwqTݢ8nqNlpaA"ߚћ FuNs@ 0fiQw-BAU;6YzR5|țZuP .1 -8yq󲱰q9k5w+AI_t\b}N] DdűëiIRޮ?&HT?~Q5Ie4M4.U"*\mK]޵1[9sc %YJ@C׼]sEennۯOqs+M2]j8dxh_q5J;jwY Gw 7*D+iԠ I{_ y[)2j ӄF_,ZմU "WR>M9vߪbsGG tWԼh wQĚ T1 %fU-7RBGoלꨥrq()i'1J'b{RM%F50aϓӦ9E-:VA9 kV嗚oYph:Idb9au_K$BQnI>ٍ:215P諙Zu!$MZ!AQ*HKEaxZec:hU="ЮZ#@6'EkPI cR>AƽZ#AEr/ oG bR /} /EWFh$*9(ѽz?HU\׺w,E0XRQ0O"T)P/ X3cF7Z,t]7 N&JL9>,>wxiAK"~}]+LFwd&nU7V4e|ڃeNV W]EM;Ec&$WKDirTEO k۫Z1l2 n墚Cp3T|uJP[:I/iqL XFaYˮJR(li"ࠢ4RfT#ܴZ)g\dhV;chZ]5\@:@iPd|F2RgD&=ڷyܪR]먾X>WX j=l hm7XFrUMJPL$#^>C*V`Q Y7 Wy5 R+z@;Ӳ5-5*!T"Ӊ9YYZ@)Q. ƂhX0ը*>Aot~QSJ QY1[cBu-FJو2 =L*ᠪ Q RnX`ځ,ltv_}[Ftk;E=/*.օM5YJʔUf;Z >oX !%[9Z {*jQےAޕlKQ^PiX|5%AGjvJ7l!OGVy^ZUשfhO:ywքWwU aU=z*c{I3m_kveQ-IQ:zR91ƋrlRt(ӄp~ &˶ZC kfʉRR«j~jM|x1˶1?ύ+Iʳmقox'bk8nɷ՘Jf upbZe:A„TSm !r Zv)@ ّnxU!oVm9Pz QdzjbEKy]-ll$mgJ|ȷޝdo^L9('ZL7\*5}}kT'qՠTs#ͬu`y6UR`:A9*0 smN'ֵo hCY<1VB1rd镝s)KEi~'/ed[k C,/6Ttt*Ml?bJGUh@] LjT &@*:Wvf*U9@J7Hע +ȳ, ϾJyH މ53@5 E g_5&@z钲JMe]TpS"w`6N:(6p~XmM-9,Un$TΦfoD&F$JMC2U}Ti,Uٵ Gr,Abs ȸmTF|]c7-WMtIPvXKd`q۠|WBr=ԥ(>U# X&ȷH:,' uEElZN RN X1%H `_wcWX}$e[SPk eD"2z~TU"]p}KY9dtɸ>:\jAU9AMa;ŪU3^ߪ"msr㾳o4L-uGGf} ;Y CgکE$ǜ]vtFڵnG$Y{53vN69ˍ5>=D|^Wj+=z 7^lrRUZ.+:w>-$ێn>\+%kjmc$|lLioyW(\nv帹dƋFasj)C7{k41<*E5Y;B5o' Y5<[\lkk\ ugWkXTs蕿U+0]sv철!q˹PƍCeLV H_UHkv/-"=ʔ#"m^^~9DUKϧo[qo$*~v5lߑ%S>u{5#r{,ƨ/ yj%"j^2?d F'Ȕc\Ug%j#RQ ϾDgߐ9jY)o eԘ]sU l׹(TPѶWljD$ s=hv?ucjNFK!n2;scuLv]|he-k2;y E h,f$&LL>xvkj_nrT%bbRn(6ddъk_RTpc}rbɉSM̍drbYS gzh;5.gkSY5JZͩZX)W[_l*MV&4 ȤJxQĤ(m~[$m!%bIN;IS}#"dڢCt^vW/ϦFԹOݝ K j|^vR䤜& jY5y֫e|KwT|›nm&ĩɩ;.J39g9? 2HeujHENJW@K ϙ0ja`өf#(oC?Fy|[^εB/Ok?9cirT3jb"A(oy*еq~T%O?IH%)G\y`zה [ϛ-F9 *O% #6AG٫bW@T];|ϛEky"ѻ G/2VU[۞>9aerOo9f/3 ƌYR`V=yJȩzr]ĩH*娴HpUH.G66΀n~˸WƾƦj&H ӗW$AZ;LmIZڭ%AqhL5ɰmeLgh(X5_luYȇy %$}zL||ň '܅aj Ej\e`Z5ƊjM.q䊉Mn5T%񋞽/$N*jR:arPsT[^}jհjRm RIUcbOR17 #Q((xͩfH:jYCX/cj&5nܗreF ni䦝 Nn:ĶOMu69mnQ1P6SH{q>eOܑ b RWc^~>!#b=/\]nRnMjLLҔ5_!:&7@y}kH|X5*ilTp[FWϵMl͠[9arBT"{|ez0Yݟ75FA^R[LO5;2uX:>Rǀ1 2&#ѻ]۪2!4 [qmT;@bc1--v4.v4.h];W%.բ1@N|ȨDZz>&C-yp СƯBÇF-{L1j26/Le󩆘' u uOQ^P=? dETظmܞv95HIzFf}9M Nj׊4}z<]\cTq?G +{ jî9 V-YYT\䪩qi\#@jЪ`Mη\59kV Y#@IeՑ/rV>d}uJo }Z|=02nd~#AՉwLRηH" ZYJ \Z _ZI] (w1f}Cq)-=&w 1dm8]Ke8=iy3_7/j)4/oOQhva@u$Ovb豚>YwإEҖ([kPh\@^v 0G[/CcEΩn̠љA2"n-cDFZ$W;s$Hj)E#G(Sq5J r p0"k_n8c큓 э9FgW>ZR̍p=яN>2eDc)foGs^SG(gjZSD2eb9-]80 ;2V;9 K&HC04eGhGP-ȘfƋV宽6E )Xax5G]2r@[в֫ӬP0rRk=E*"^1/I[ 訍-bG9|Kh::qApW\&Yo5eRW׫z C5W$AƄII]< :!):oFgo75ltBuU: t=L9vLХqٛCZG'a53UQcMӯSyތikpZ\ Mb]v6m1+p?@ؘ֦ept.ͤTym3Q]LiK , o|kS@hKwn߰-4ݶĬ!m!:7jY˔zGj|K7(96VFΪ7y'!My'ŷꦵM_L,m~5처UΨfOtPWI>5*~>(_\fD ʥLz(rU&H]{_ԗ2vHrB/TW'AHIPTrLt 8wiofBm3P S+QZPQzHu&fH/jLͤZ j2aZ+,BT"fC*%D֌5*%S_eiU{-ģ##I(^9@p6b G GE׎hTQYjd^;@bhZ|(~QK\x9I6H"W8-@ +'Uu$k(A*<]%1zUu= ˙zB"58UU*"f\|lbpG`k[m v0MKzW"앟׵XB>ȈvCWUvZr.A񵾻 'X+h oZ \a:WW1/˺4RU$mT*CXƋrU@dX5%8 mԽs=F@gr WPŊ©uqrYںZjy**Zar.x͒L*By]eZ| rS!]R6Wz5Lr*.y⠽Z+ANxlUpp]5ܳmi▐*KվB!k|t_:粕ںV}Z&_o N28* {}tkLҐ_fsԞ }Te,\GMD[r7Z{.[ۋFaZ+'FyMWbjtA鋭R[%HbqT1AƗOS$:P1 y PtP ^:J_ uSՐyԐyUՐyՓt<{;I=A" ev56*AZrw5*A OU%OI#eW;;&HΎ3 UrqۣïGrf6:{t蔵|F{75 eeXXzbMp!v!v!v|QSX(UzEn5V_sȡï n)}^\oVXx*r9Rah׮Umv/@j] Twr]UG7ڌ/GUkEƑpvMgRM1g<{;2ԣ| G\NԤԌr3Yةl1J.@BF>>>"9?@ y1VR<sߪR٠Mrε\hD=uQ@mUZ%d#/z;䃙]n|ys k HXUa@ 9#zZ*eVFcJE-%/z m?feD55AQb)Fk䆆i&UB  Z2!g%2J-e[H!Ȩ_xz ާu+E*(c# cc$@UUZ,A\SiU (e.bjVN?UӲvsu:Gyj55F)j=$fU &EG9 }wI wbdV| B5Z\K?Bȉ;jYXՃzNU(?fƷvs;% dN49>*,@՛>J9j*v ]fnd_`y>R- ߭-&`vEy^.fV2$j.ym՘ Nm`WwU"-ckk+:q=}u jleKTGVk+Dp@~絵|((aVCjj #Ǟ4=C \\3 K}uuwG4 R *UpyTc#@vHIo(.mv7aΠB*[ _FvY7}ҭfw$DVTZl*.VmcmڕKjmedlk6.A" ޾ s*|& U0Y[~$[R5>oZ]DykJאk_}Sou0/yN<ՌHU>+cGu!t_>QJcQO٥وjMfB*儚G5F !5'B V,#3LÛ^e-yjg6jXۍ\;"JH0X4Ԅ5>R 5XX䎂^nannpH`Aw1 u^)eɯ| %(xHP#ûm-Z2о>\FrdZN'iA%-F>_\g5ƋJM(ctR/JQ U)eX0J*%_Rs#Ro~yO&cQEG k|tn(tz# u\ԨBVI(TQ=TZ+AZz+& OªEUW ^ P;>W7EcBxWbTk^vU1[dJuC%FNy뚫oĕ]9 [ŷ?鳮m Ʒ' !ފ$HU/JI8:zƋҢNb4+)ZUzjC%Sj8l kR؈*L/zD&D@0ԋG85>deivdfxkZ(?1FT)4@^Vhԁ%AE8)>_N7#GUm5շ"wPy;@iCC(XE?܃mNj u T}ktC$R<5 TUBYf׵g>P%\{gٱB/ZTx:QӠF}ؠ FQ~3AL͵o`$jyB2s#% UO8}wvYUc!=J7ʵK͛ Pdu\3☄ k¸i]VԘ!8L6k_a;՚hZpyS@mN'Ӣ_䌨Q  2L*Lje ^F y`&Mgb;:ՠ5Fy3&smjJwr,y`3&ߊL6դ /ٰjI2{6yOBeѐ„rbUEڠaPhy:t&MSMkyOa/Ჸ"Hn*ؕE}* FN2\WqrT8&r7ldQez\,TsL@2W5P(jF)ҕZ62ɔ] 936 Z7JN|7 o &uR31J'5. >iƷD.q59gr.3I>@Z$NV$@4^Ղ\)bt'BN.ᱲ6Ht5oK0VkxQ^u Ѫ'9RKt`mղ.Fy(hq7n.&a"pȷjηՉ&'WMjk ]OiSbeu/KaਔYFSX*X}7@}V]a.OT&9e 8U22/rRt{kɅw7Ks=bBǣnO az/s:rI EGM oLd$|QHXG[;WT$}(R1F  _5-u4f#eML.]|:5HKTܰޅЗOC5cz(_[謰U1a|YI*FyUTƋ&;IF{DF{WFR*vLo2r\a,ꪋ˭vummؠB_:l^)~i %k_ rH; >S,rڭ ?U¦dޮk'L5/G5UEک(㐧Ph@RsL55j#ykQG9Q~Sc9&r]ryW:vPQ^KԿ6Fk/sGw/0Q4򷫚 Z#/`q7wothjP @k[NjM[9kŒMVNv{sm'2g]DGgei* JgU|M{c 7vʀI&t]׭U5uϋW4 ;'gN=dXުbIZ [Þy5w [#hh404m폮J^&C稧AU$&N&A&fj ̠x *rrTco9ܠ{z`:G {, 7*Ɠ#շ9Ԋ:EǷWl2 РI@YY^2R]:pUsOdD[;crj& [ É Tu颖 ϾAo$唔h8r2ɩayrT,P߸YtF䬿u%& ~}S&*$Ëfp՘IRjE_6jR{[JF̆ޮC{ur{eI \jqSlgm=.Nmu422,Qܹ}r~.kIt?9j@@ɇjN]X0Cni; &c?~lq6cyQ|} .IeeA[U١MYo0{%vcڪu|X7}p%ڨoxkjOmVCވ^ժV9QFa Äk59[ 9Wo\Nmmԟ/nZ%N+\NN&;5dw+^|sGə3g9Vmc^^:s2ty8(9dHUQ54QiQ P[G{; ꏎ]u٪jv~KB+WVq@~QVCT>W FVj4z@w V4;Avw0ƷL,;ջ pK+99 sr$̈wPb#ڪu-!BHؚHYg>UOVqJh?T=&!#p] jxP- \-ژ4F*2rr%Nn0;U7C:j A*qޮSU z"Ĝ? aq©&NfkFVM n_jr>TuGl|K*aTEGc5↪]t n峻98byW4 rzV Rkc ::tt&L w;ڣ;VoJL^.1>ڈ-0zNPF 5I5C5AyGU9z|F"5F|eTdk0Xt"Ɏne7˭FZ1Va gY?:\_t{<]7Zt<蠄iK->-a-E9jqRo2UR-rTʵZ e>mpcmnosj-|ڣ;:6}Hҡltϳ68KP%jhLΛk\^VD+ AFed鮚cbEaGѭ=;S\)at =@ZcMLrG>50G5~QToEBmVHSUbJ<:=iH!&a!Q21SZ+$$a֍莀Ue+{3A4mm"Oޭ•em- QT ꆖdeدjYXqZ7,j'aB4@DNPc/]k6̳k|p%3Jy^>;dAY?ֳUN\#KVBmc)6;Ҍ28șˠ):QqWFr;B- Zd,,Uo蚃 b-Fbcm7>wM'5~Ѵ­(dUfF)F$ S -;Y]`v\kȥ;u54_T]St?hIKoUZ!R\"RvP뉦wŕ/LYdDk ѵ % j WI ~53;h¾Ⱦ&׹nsF%T0GIcۨn(9. A_6cn̏[lmXai@ mYtEGWԝ$ȳI9 us=־[ Lusr@}L]p[ۙV ~' 5(Aƚ? ;f$HwOظkj4kPU<{_4nOkyq脨hZ:A Gk+ywdktw}FolIݝkt9 }wrKU<{EN\56>QHc<{+V'WNU1ESa8) :mNsѽFsԝѩ;e[,; /8cMua2:ftK_{[([jwU&^vJV**nU[稂8@AA+0^Uͽ/*5JZ2qLOStDt} \FŌ צilKQDTu!FU+@^v j|KRuU&!@^cu3Lrd'Mj=FqΈ5)镼G(c'bT#4TӜ or&^^RcTEKG3VK!@!Q;N1D^r5ܵHgQՃ}Qҽ{(:\*;`up +ɺ$HE>btq+^Nֵud]*Ki@DpĂC/Fr\{Vӷ}$@Zݜ2bV#\xj.r憎[}-\FB'Ms b2^@fzMUG2Zgyj&F5@^vGȻmY㐣(XUZUXG8}0Yػ|1JeJbχ2yjdLX3+L1j'&HED!Y/JNkL*7%wo/V'bu;5%|MjZ7N0 Ͼ]]jtݨQ_T<:Gy۽ZȿX`1 -HMϫP$ v'OLh5,z1{en$5@Xc˪> C_CD׎T.^mLԏoIԳ{TJ'PYo{] 2Pl6C~K{+QaI==r t likݜiqqmaᮜ2@u1fif9ʘP\(QtKV֑Fy&V=8ytʬq 8ePr=Rf˖MOobu[3&^$H~Z&dmsYJk5>AҍThrgoմkUK'H2Xڮ.&I3 ZCj#_۵@f$9RqRC 7CFMxW_ԘŐ4@>fi6@ANvT3~ѩ;l5rErx %ʢult+?@f{׊A$sLCvz5`n<.NBJbԣc ^,%HujT>5(O*t-]SW 퐺(B|8]pP5jߒS5 vPK]'HUjDv$U*6@|59%I^ (Z_l)"eG3pz5'6U$$8Fb2PHu=LPcFC- QuC9Qkl\jrR<Q 'J F+'XبZ!C0t!QSqH_ɅS-I YKJq$og՚M"`O u A$6m'F5XP9y;[if r~G;Cs\S1Tϴpc{h੝] kQ]X˻&-cqC&o;jAed]j_h`0ZQ>TW7SyJ הihZsUR{hrNY_ N׼QTIݦ[bzhrZ}W§`/MvLZH%H˞TksTgzSuX<& _L4ʈ(D5.V:[ k"`LJILr—#x֏+JыӦFJue"lO:jݶs$EQ[()3R[^kPm /FԘ en%2t׵o`+0ZV K'U Qy_b WM~v[=dmsGj*йM# :6KQNYkb[Ɨ3:#_l|^bmw^+H>04k>_h&ljL$gQyٖI ӪV 9V*ߒߤƒƋ^P @(,|h܁7૙^DKHRdm'HzN]JK՜;tl..ݿvcg3S@~Ecmlީp~D*l m{)@UMKTZ9HоFC=՚ Bi/z٭Ix5W7]57[XA(j! M26#LJ~eŷ q\m ]~M NPcެer ɯebjc&((\LC#YhUc4iV.S5FbF#⿑UsdFœ6 NPaPW˔K#髞n|9jvN(48npZ\jհjkd"ѽL&͟4 Ie=#G:mpP-9:5 :8tM4U*-j4٣ Ή WPY~ߡf&ȑjo';`* #lDZ%msKQ.Ag]vd 2 ie4U=^l|2GՕLC WOF-2ՠ E_e2ʓKlg~p4Vܼ_j[1q)gZB2jܧBH 5vѝ;U7AoRp UrjTA ]W{bU| j|3Խ N'h]ҹF2RQV\)le+h&FDAvQetvFt7MO4AJP%$A55Xb2-;UIs@eՊ=1Y|1t:8up]K-䗣L ) MIgiATE>oa1AU(̵QJl &-~ ѹ3ƇWw½҇/z>9@~p:ɹ[SJPET-œ /Q-\y7 lٖSQ95#tnXDc%P̩9JWkۅ.C*MNjnMK5ĽrEVZ5A)/C"+WT jҲ:7O`PB>jc?:^:#dRW\븙9Ԕ'伩?硡41V\l86$NtaUw!1U-ArVTUvƋu&~j\䳚*+d>Kf: B$MT@5=,>\69 QfdGD.z 5@'_5L!#fR!ewj6?&_Q2 ۾jB| &9'GU{ +n+#G_} X/z3OG$UPcm z rZd"TQP65%2_y:Y@^.]I&o4kJ\4e\dA6rlϣ:FıdAw:9J2҄Q`Lr씏Ut mW=F].61a v:œg7\q$Hpk˾mv5?AQ*ۉa:娳 ) 0Z 2 pq/cm4&\"YtHnLB^.3*=ӪQICzxR!?'}Bj7R[ƌwWikÛZ`dGn3͸mBZ] @Ji$HKF(@}WQE9G5^,XS/%,}V\5 oF99`rSm$BYhzq]sV\cMF M9?&Hej,F e)FH[FbqjԀA_.]Cb5^IoU¦O'jS@qV,V( {B!E*j:ڵ9Xp 2׺\ArSu8֬,`p4V 2? ȬskcMPcNVӡƋ*1.EzbM*h5w|J+pD f N(?n4s_R0r"/G'ʏ5Q>n2t uxj|Ѿ!'9tt 9AV5k9}0v~hI UwdL^;Y{R')1J!N5*8>o}[c| 5_>H786]:kWQ/ȷ-+v8_PRW &@~Q^@pu K(\4~QAsSHqTcõy$C;Ŝh*F&hƠƷ$ jۥpcYQl|jyo{ccޅZ9A2jz$M\PvM[("h(7ֺd ~RFb+EN3ycg ͂Z|/A&چ^$SXourώl{76VF&$68Q~po| ؁ࢦT(#h˨$̵d20_ZF^c(ɨ,\@5+y[XCcuFL^,< utԱcM6p.eR1/9kXq Z ૬Z$*2|MB*z]nMmu,; -ddBvս(yL /jr <ЅKr6v NKrN?tڂqXs÷msQCƗMkrXc wkݻ9(|&Gc5f/a?+y-ߓ\6ΧL_EU&Hqf6&Hg>_\}\H7TU#ٮs>]>,ɱ2&,\^c LU5_(4/W.+}-뵂C 蚫eٹu2uJ2$7bFRGv}TdRHY [7A6untmz'qzd)>+e.տky,eYXC}V^7\<\s\.8y_9MFT:(FUc^! ~n; ^e ša9:%rtJ䨔n*"s>ήBYǭ58p ]t$`UN䷺>~5m\vǍ7 yKlpUmX|Tڵe6.qJ|F9U|)tS"GD5%2A t~4Z{:)gS}&Nb2/}荒цAB6nL׸I鎵WaLTT^s2;jMpVJMLd]@йu|<֍s6bQ.#wE7v=Moj}̰V.M-st-" qOz"Dq<'avϦIH(eB rgשr j7E^ |·r*mgS$H&ۃ&ȷ:6rTc&ӀD&C ][^ᦞTD *͵/]VDoHјA{.#`N9)49o6.A&$d6joqGZ6N۸7/ʧU9xo$tŶqF}V/78xMMNPWэK*ʊO˳~6@:DynxNbnDjQ6Wl75>A Df7R$l)IA/\iGngqyg9/ToT\ħITwܸK&We%7%q/I@f=9s#@/pHmшŗvT# Z$;(P >J8fr(i3_Q3wl\=-/U;+++32" #I +KlOBTHH T@ o+_טe{B<[ɷV>c&9V+1 -_,{YweqZWS<[ }lAcg/T:>\<)S;>\Y!zO >%yRᗉD+sWA5dt~@ddܑd}Tù1 {m2.]!{8@V!ՐqKw%UJSC^ h@邗tkp)u\Y L➇n ly<=3 Y'8ooYC6+ }!rJ_IZY a! Q/Dv7pA~C:.ͨƎ5)T|F-T8j&쏏OV~isOnC8̲`4ܞÒ 4+i Ėh4#V {jgaBϵN^.Hn0^>NQxY烉!JBTC>TkPp:V`{ U^rb>iouVɦVF b3cCH .Cu'͞VPnE@5U*[}Se#~7 %z%bUfq.XZ<,2 2C/3*GYjlPd*CKr==}{'f !?4fFWkȢ>W2A&!/z&?hB¥=ZM [YWՖ9:]ϺhB,B2y+c*B5ǚJP5Zs}.);WM2bDӆ;.2/WM+-ڝ$,+!dkH]8]ҒڵfBغW.0U7}8M_PoN7vl[G~!?$VׁMm1|\&Vk('\h"kH_LpkX҆&mwʍJs!GҩԽƩ5%|IԾ*C,E!&B=F`FRqgDmğs7$54w%-lr]r. w^xIG7/i܏TW4 ٮWr{g9 /,oCY|F7l/j[*s`FAeա s_V9e,%ؐoK{|!#?9+{Ru{BF+I9 {6a! sԐ.oĜjQMMBOp=K TX_ε+B 2` _*/i@GGnZ*,E_CHE 9}-aI uԇ~1һ^\z>He`.kfC 뽔4_6AQɲ ܲ*9yBuڮAWCsc3A}b i]ZԊ%#n!`*fʇ^@ۑlnJUJW*sLn -+a.m;I?WVyqvtx뼡o2@9'kl{W'Bםg'嫽jw "Ur+w^Yy}}L-rJG}[{`PГ`/Zq"٫!'>[;VVrC*MG O",i{ ]BjLI7Dnѕ;c]=ɔ*eOSf_藆6T:DnW>ȇV=帴ȇEB[Qe_W1*&"؄j믝xdPSpߣ;]MBgqEP8 Y^02JsZ&5tԙ\뤐v &IvZߩ[Аs?kC+s}K'CkClV 9Q|Cz H<.ȗ6ޙ[ULw+'ܝ;rVבl+Ћ˺LWo9am3 u+PzU}Sf=fܪ!f2ΗzͨGB$Ro"C]hޖ6uru+y, dR5'Cݲ@nO|'G $TYʢZɲ""ʊ}/X BRwJ/VdɑZMť9LL e~lyhiV b4eҊoiŷ?+ݒ|LjVv"gg (_ aB!S脍X@ zHϸIg{ {ԧ`ۊe%GAChDtN_ZCxe-VA /` "w*q+;Y }aVx+S£[g.̧^ǭ^a~ʁd ^ KBރGVlET%;56J:x]hn] ¨BPPyD?*"rא)Y}`^!d*QA)N_[@C y(S"Ef!zU@@Izr/)Yo?@C'Lr"]neV>Yx\8@_(ui޽8dURC>#rT4DjĀApw?Bl! _#C 1sRk[{y):,տH¤VJ(XdʙBQvސ#o)e{pN="uґWo;M(@8rCdYͭ4Vڛesp2S< ֊ʚM E'VN7B9!N!fq<*WY[ؙU)[ YCUMhh{ح\4KC9 18C+IhohGD[9څP<2՚EDAnV"Ʋj+e~R!G]ٷs-,m>_@ ̒D#Y iuv$ 7 ;$ؐwv^@ MeRd,?ӐϨAix}:TM`>OC||ǙVǙ]Ck3ej}x VƑk41W.O*T!ڬ.Eu=}#sBzJ<)G*}#}//ҾzsO !je|X<N$˓ \,6Tcΐ9h #mKs$FMwb~U0jOcbunTZ#sRXsB <ׅLǠKmHl?яDZgC6 ߣr֭iȮ*mJ8ߑ50.7sj%W})OЊg|dg۝y݊XAA&)qwOY|lMk)GD¼AI";G\s:M' ͙'ڐzhm?\&bq_,!k =US.3L5iw8چh8f{Cqdf}CNrUc DĭZ(G*44T3?:ӥR҇dEAbT|bc5Z ]zS;Ӆu c-hOXj5bKnkNWJվ,'E^|i݊Y ʗkL[14}buT~YAE <2/*-!XyCvCC0X! k ]w$믆ޙQkHfǤV> Ζ9k%-LTYɮkh+U'zT\ 򑄨~?v.:SSk49}U$HZ^AH@>-Ӑ)a64to:׺O1Ou+E[*(|0}Jؙx2 u+.7z0 54ݳq뮸9at+GR?}/Ge JZ!$g(Bpu9^`*G4MPp}[.h5MܷUuCz̿Fvݼ%jq?SeBgʘ`2yp*!4Rc6ylZ^* vU}H3y_u)<@׆Vߞf.UQ !  $Kl(\p!s"Q̯IЙUz5VVugnIȷV0#{$Ǿ 3׺Ae7hV)īvh٪:)w/u+)9WC(Ey*o<`*u+utcM咆2\p* n ׽#7TzLV&?gdEaTYY8z 915(f B<5s7i zNThV4h[&Cw_9_e_o;_71ルxѐ/  aXyשE-4=x}*372a|=~Be0;85}%3'";_B^HC_}-o5P-^K40ӉmOYN88!@mm!bORaCCE7"5}uuMaCHK;tᆋjcS7i j-7k5d"|QCCW}nzZk7 Ulw kVz5@>c||}{CfG~7"^EBl;~FԿQoQgRB`Wm!*A( ֑! q`qF2olG0*?OպʁdMC9  >O*v/<="m{Vwbxơ9 ?T)j!rlTǂJK1O֑4lσS铕._x^I͓h8~? 5c'6|!GbLFJp:1 r'!hC}턊PZ^h譂p:_e>I{GK>֑Pj{Rỡ!s0Zo̱ևR\'2٭vabdX~ :a6Ěc ǚg+}dR7gv+}MېtL^jgTi/r"@OH$,5 tm~ɲK]?ͮ&ٱ U,v~JjE^l$5Ddm}QW@3!WΖY1ϲIdIW~C,ia<@Fۆo+k` ?)XUZ/$uڅOC''UPϨ6G'eAKSG>?p5S:cd<7^%0X+ !Kj2 9(F:ᔓĺ<ͥvqxng| &Fjl4'á1(H@VR 0L]p&>sN56>)ѐ|+ vTy/LgC NRH9HXt{ 6O)ie$ /ɪ[*9~>rCڏ rr /VvƩG'r­G2_&TBvU_Ǖ<{tQ&F &t'%Ap/GϔwmFo\x?܂7}lH9{;#A9x&U Gp׭/FXIٖX^y, ϻ BcGGy l(d-.˼mU[C)}˃TC"pٕZ) iy}YӸ{y޶k~6츧 Pqdv~lMؕ&ٓI2-mT0 A!<9؇ء!bjGm@;Ln2~mC c hI y/cs7:3YJ9=+,h orzt@vkhž3]հ?[|j1aeynE'TV t g̅}*H6$X7d:gIJ4:jPE1}{_o2^deΖ^(Umc/MwN0DPz)hiJgxвRr[9Pj"b0]Җ&E^ՁQ2ZW_% ?Xzǧz-R uP!V[H?yCu ,Yt!/t ;>zV&rݕ~潐!L^_H\e$}n[yDJF\qu,+&!I9Vý8X!04ܪo۽Cݝ,rT9[]sU@Kí!\p;ş#uj"CR>O_چ<v /wxȩ|ȃXG'ޝ/U:3Ҕ+}V @}Ltnx 9}8`O.slP]sV2!)u?I{u$726\6 /k}`B(XPxWVAZñYVV`H=@C_z1d#~L݆OSЏ[S|/tBBHr,j] ߖ{ra7@&  աnU&2,K,~0b\'܉xd3'_RW~rv+\` r~Xb{}% !MvW^)АSJnoz2@~8VR9#_YEVPHƴ+/YSv.}DVNYvK]K]ϕRyⰸI ے@j+ 6oJj;Mқ^8\:@>7/ĭӭ~9O\{u%nWXr~NqYD/ٗU+ 187襺Ee}SyiyQUq!L U+Rv)(I WׁqBdA8 _n޻t )^u'ՓmȠނeK>ߕr2!ӬчB/[7$3Hf>7$vEO~!tQ 2eBO˄g(м2VFn?\a%K&\.YK^Cޕ2PGmM2)+DUٙ5ƻpOI2pye;Y}/TG3y+99%j%_JrhC9'a9'^3 u`w(|nH$!! Ǣ:[}! {Jq`,}{ǷP`V'bˬ2K嚬҆:/Vo+>e,3R䂜V&Laf4DA!59=/*ZJZ~,/ye,!R`P؜/jgsV4"I!-HۢBI pP" R~_1xN\ɸ,[LS[ Hյ8Ӯ˕!G b7OT4tyY!UN$ 2g"}v?T*Q]kGt_mWKx{^o( fž=vO9;h4cJ.eA&_rOQt)JE2-sJ2GwB~Gn;˂? ~Xlz89i7o(5S. gŶI~RUPWk$qf˾ϘSN%'k/ ^,0{Y`b.t(kEgRx&#_Jly\Mڐ!I(Y2p0 i -7txȠlG }Fμ肮Ѯ_g tjG[WV4m`GvpCi$ԄvAnB=֠20vm7}Nkɳ[(彐nMo?'oh%R8|ΈL:њ38\e5*Ysh͆d_db?X˙{ԍyȼچXɇTT&,Hq!ۏ!0bAv p|uuLsn(䗂bU#T Loh`@dKbIrBCxCr~ 1}NR {j,Vtq{'{qXMh6 -,ăc^8@ZxV|Veѕr챆VV߭5Gdž%–yy`k(ܭ{ w+vٽ!6wI Tx/q޼ &s )J~ 11e",6!^e‚S/G/\%лBߣ+ٕVmkhŭmi[^ӝ5䜸V8ܤY}s{FoeV;}g!ET~ +(b}:q_ U+"amlՉփtr!ıq[:u^ri–뜚'!9nJKB#腜0~0w䂆؈Iih=<ַ>+3vnҁA,=vK9K%5dnT_H6|RH˻e/7hDU)bM՝fACxNjp{Z$"" d.Ȉ6vyT4˝ӷ!ǬҐh9;KĹ ݊Nd.CCZ# hzozmz 3VQnlmū]fPD1l 3_ot[&J&Ʃ\p _6` d@C~0d=imHPLh WAǮjLo3NNB6(BIj{{!-o+TX*zH ؑVjhHsڪ@Y!odl'̳ee_{TZ|nD26Vb'.ďήu,z::n/VrR Yl7)Qːte/ukp=,V6WtPFE3u|^;2%r wJ|rv=j08encŊIw؈UY-dG6 7GX.3߭t; 3Q[m{0W2YGHoRn no!4J }Sy/t=nyKaeU>}_f)~{z2z:z-sHMu0 w*w"yV&. ZvUexQݞwi63}iu%i4cʰ~ ! 6|*ܦTϨWBtwLuDLqȠ:3]m &)1B|S|Gsm=22\7hoeX} {A % !R)~L3 m;q鈔}{p M ٤eJ#SCƹ}ۭ)T/Um nEo_ԡ 5DcWx}C4,eYi(ڇ5\q6i 1fx!VCqT?b?z?18#K3?ʡd*$_Zpuߒ _[M;%ˋBz@CH۷!,-GIndP=PdvrW6&VV&{m;DAxX2mi}2UƑj8}!G{@ĹlZa[(헏=*™ iXtQ׌>!e| 58 zґݐn@=Ihv-@Rz߆Pݺa.O3߭)*߭:ѐs}c|;%r$!?+T +hsҴܚoV( FSPLViu53=ߡkUARTAdmj!hnGQ Jp.M JSq ݹ "/,խxi{ ]CwOCyQq.dFcdf*e Pp,1`^C>eht÷9SK؋p{T +H/RxN޺МׯO&䧐;_A=B5B{$OJa藊cd726wY >"g4RC ߙy r;š :8.|TxǴ3'Ⴄ@xNV 0s(@E5n=!B>C[ẗuFs,Vޅoυ!<[^B>W&hCˁ-wwXł| G5`(e}Ҵ޶hgpߤԽ]wVNA*~/ PV+i٭rw'aX6TnoN'>y8ͽ v*96ߜ;>cw$!F1b`{9b  [| &}+t+wy l !/RƫIFH ;bcIqrc8H)#Qi#w Hof4ąaC 1W(r u^ !*/5Z9D[7)(vk+{YB˓4* jM( [y_K?eBhHmj<D9bI_,q[{@*dA\8x}2!a*I\q%; =2ׁkvھ%!Uhu/L6fFޅ#E ~1=ㅱu~aC=,܍bՊwNdACRRmEb #]T={߭RZw; 4ղ2i#W+CNrZnh;ԅ= xU+Hچ:8Hϑި={gu`IGݞ*Nu&yz @_7*gr?*hEQGDI ]_j?-c.cV5tPu :?>]Hc@s=P/+ȑP+85\i@ Q YAق =|i˗|i+_ZCf.EFe{h)yUG$AZ岽QbZ1%RDqOu-7zi 1MN]@Nt!D Z{Es@;\Q1Ӊ{2sp&x 2ȝ!8 P)G*4dՉPep {f.ƑjI[{{7LW{\P4:xA!o_.|Y!WAvBMI58Bn3U& _{i$Z?Jd+wTmr;AH(Rý`S>Rm! J}npݻt rW` n?csq%w44a37LL +C+Ko');BC>C>C>C~O^f'73lnoHL<\:",R; ҇LA36$kh_I/'&\;&K3lw nIAn_nzC77n|Нoj[4ķm6 vQq Wptu$5Z&Sfd_$!zT ÌNFoCCT/2\<}HEP1Z1}wg]ݾБz00/raˣGr7wI$\ ۙya5<&Ff7!^v+_GVojI6D'nj[iҲj@[7vN0C"Ab)ȑ0.lC99cve]'R~WkJ\_ȂB]x t{' 7P%efD#h~imu~dybLTcJE;UC4B OrbCT'M  >r=/$Y#ۧ$ӻ 8֜+Th؉K9'7,Q)aE 3Z :R)1' +brګ>#Mr;ˇ|!^Ӈ"_xl_Ϙi6$4Cu;`̙'pِosWdt+ey•r~% ю[6!GcrπDAZ9Φ}h2!e)`i 8\?~f{j0'0ΗZ )}Å dPzίV7[EE U=Oj47.ɳhdAΌwFQ!^G9$T%ViTb}lMˏi4Ъms].LL[qDRԚAqb˽'J%00.5R! ]q-KyH4H(+VlS!:SK\hd^t+Oo D43JE+\ug=ةQߐhɪ ԹmBcsa4T<4>׉!?Pg2y< {9RNeN`Ei͠Aua t3K<[PNjxU{ ?fţП'5 Kr5x?H?1_qx!^;8R彗EșyBJ4hFxQ B 4K jnԝeg3JnCC+s݆W+΢`VpA 4jd@BgDrkY(h7748(^)Pe~!֭m#rIzRCmGģSJѩ)TTet&BdϨM.RtJ):**J)\S9fI@̙S݊QMKT=ni6D^P/SR{ jF)Аř r{e\ ,5E49eTO)3)|)juEO-Rr;(xME$9\B$BgV*)a]r%Ό?6/|I;Z*jsr& dj)| ɗ򷧣̍32LI]IYy{/w"y2._"[4䔋[ RlױTۣ㶒,ԁѣ[֯킼N>bV.9-i y{ϵTP֫!'ίENi-gZ*%S˙L <J$ o}iw^3!+s5avۯk Ny&r nɤ:pJ:}Cn"&eE:e^zՐ\fΕ )g^a*aG !!"`p x#m66$)δݷU-Mu ʖ#8HY^!Kv>fi=( kAriFѭ[ >cJxe"am5z!>4[ܑ`קpJ1aIv\R"s>jTm-WV!-e_AjkJ#HR3!&Cr V$,R2VVEihb'*JC|șbp{Q;Աarз=ZҦ3)=sœeWOtޔ ko+Z;Gϒ,ra؈GDW22*1Jz6FPJfϘ+Uc%  RHБ{\~ikihq'\/I+I @;VZқzAI{݊ ?]jU}_M 9$ `ކd{`Lf$=]I~i5š!4N/̨;sUD + 8drV ˲8K2YuYteqẗTY]%)gIy!Si%g!ED,5Kn͒[,5Kn͒[$Ҭ'JFw$ۿ]xʢ an,;ȥԦUʟcU:pj5D$e/V`L(}ۛ3NY,Dݭx)'YF e I,֬,YT͂a 9ZCY!'հFю>mmvp 1Wɪ+ȮYc%!&A)YY~9I9{~V x"Bb$!ړWP*-_TJ* AqWsjp4L\' ybucLO]높d@Y0{XM-5Ylg`]]v?.ɈcI{GbJTRIX:hR;pbX*i%26 \Z= LAL VC]7eWCuIBC4CB+Ku+ \^VR^M~Z4}dd=&۠Ծy|08(XYOYO)NRR+S 𪖇Z Ø ~&l%֐D GIr%M2㽮؜sEZ^dZNɴ4\\ |ƴAa%!9 d+ d<ޯC+K83PdA*|0i#~ =h ʪo+gJr%A^JD_-%yD>/-{Me佂07 ÛV stdoD T "@U,i)V !7 YQ;czmSwd1v}j/չ `*cS\ߒⷦ~rgb Dߒⷆ4)~Are]|xjCò%.36 Lʻ' B,H֢$]. duK $5JXC9-Ȁ*t7_uH}!*kh=mhx}$U 5!|쏤7K D2!Sc̰IK՞>uV~z Y/k]<Ox!E6y}Ӆa[ {P(a^ӑE!axAv]4 !npdLᅩ\*}-_{rX"phc/4]wI\rj fRˢ!6W 1%\ޯ{ZC aRwΪ)et:|+A Ҡ1^VjRݷ1sA^ftSJ{9)-'_JG*=O¡b_+=$:\} ՘ ytr`z鍺\U&j/捆ȩUk ʚT 9=5PFE BMk'VY]R.)X.WVj&%m{tdgʹTTRk!CHIAÅL>v{=W9p՝IMke5XZ)uݝ nR{p6&L=-R( o~ ؟pzknpɈWz%I ,dIrW*ƕne\']א#3U*5m} IkkE_>+}]{}~rWַꭉ6xﲘUJN>dܪ HUl7֧* eF`CCX C KAE-sDZ?cY+)2 @6@R ~J|(g*v ,6^ȫLtll*_IP,ETv%]w%Q%Jw 6$O$/SCW%w]zC+[?]OjbB(uY|֕qf(ʄJr4}[VhWI}3j35ƑpQvb;_R֮ 5Ӓ֐I${UCJP |A0r rïTnH&G'6kQ4~ѱy7X0.d]&^ZZHj*Y!,vɤ,vAzCZAB􆆬,ܭ WBUU.ILyifWH7C'b *} r_p< =c+unZO,濐1iSMekV։Vr%&U_C*$2(UC5T]6ue8L<[;^Xgd|]W\֤2y -tnm+}VXm4URdN"¾p/>P6dW]\ɭih脏6uKqh`S$w+{O'ֆiiQuo:q;RYث)sבI_hn͂Ljd'0ɻƩ0p. JXMIC3BC ԫUn99VCAKQݛ;ɡ BLUQtT2Ʒg{^Z CnE)je '@z)#B:qSlzQS0НFIen@f16a픇Yݜ݊O~kB}]x.}{ߐDӂ{v}b>F1PJȬ6*QC>c91dX# 4LToCz]==eZd<=՝'Æ{Vf{4]Jn*4VR !=6ӜM'K'L|mȑFZa3RVC&?/o/dn\M*uІ/0t.V'/tTXS<4<֔|F,j ;[:ߌcTCpW+L)(uAGu/Ї '-}!`3Qk ^% 2CChA}.'Vސ]͘NA#efqRiA W_"/͐_V[?x /J^Yg\?A JAvP 4O-|GE;yUۜ 爔"ϔ]ᠨbAn:@ eˣ;N} Noȑ spԅzD<=,]6)Y[H64S̷3?aG#{I/FWʱHfAN lvvvOfR2]"5anp2V̯L*ԅ= 6$]LR40~`QݤԾ]=Xp/:Ď.%[pD5ƂE3=5% 0M_0ns&v3f_!,_2zoՊ{(jD EDvM=U,~!iu U|[ų'[ b#YZ؄w+즫狼W™L1ĭbAG2$xjPvi{u7Y "ː[R{=F[|מ+o2HVSI"/!eBQnhp8#kPoBiY!"XV%lㅀ{!n (?͌]=WpA9;d`UZΙ{ЖZbe&W(xAҎ:ܿSlP)r>:H_,G'{$EyC} 1w6ws;w54"3G]Q좍ڈeV5?=>ӊ.VKSb!,9͢TEp/N}7ㅆ_ w{ {vN*X(\պ"7s}!6RT1VD+s스r ;9[9*ٳ'\-ۧڤUl͞|4S8![^nū5ql,08tY!;?+!W skU׷'.y*; b4ZoK&apnϔ{7E'7Od44zRuLˆ B[VyA{!BU 54}Pwm2Wf 4#kb 0}_gd_ycdzz% W݉󹠡_l'f]8V~Vzj2 -.x;|\3/ᅆ_t$!'%*w} B؇5^hɄtXJۑ|8bd{/G+Hrط  ߞ$u~f wtUOJv<#/D0T^J%hnC2wR$6by)U֠w+bu)ܐ4PY=0D8ԍ:Ԇ!ܤ0X0iA{ҟS#U+N`\C[, v#?Ną 4}//6"|k:R~V>|cx!!e#2@Åz)_I/g`2?,pXBna嗶O[rj;V{!CiKμx ͏8q>{E{ZIEZ98,Ozܺ^Ea ]ѐó‘ :CơaY\r5Gn'%lK Fב4z⬐EMr淡b͇/3k;(B$S er~({ɏdQdՠaàCԂHiC Q=mhŜPd ㆘_Gdb?9R R)T{0x!,Ƕr3bxq\p r޻+XsȲ8*~2Ѯ[]B~il8fтo;GfVH~amN{ U}?Ԇ?ԙ?T?Ԭ?T??ė,T `Y BsE ,Zy xᄐOJyҮ\o'4;Kk ݃Mv>{0波iߋ+%Ȳkl=gVGVCڛч,SkV;oA7s&u+~(~{C||m66#NrːQmjbTTk3oC^kOP7"HEj'&5%!{ⵐsxyBWVonǾ}_tuW1(7k;8;s/O"k|Fe%ƻܻ"T 2t<\ýUVUTܕ`A{ip0(v.2. djphLj9͚gC5*GV;hȅ};e vIUG7t 1-}3f++;(yѭ!3h<쏖\@??>$)g+ۊ.YC5G !n(J.>p@P r+|5Lapt+mj" Fޭxdͼ*Etv KD$O9yj_W=۠.DTAK"ҿY@ aG2J#KZ^CVC3 w /[ <\אRbہ8ZANȱU+g4$9\G;ucԭ9R[9Vy|iALo U9N%&{f?\AL9CFd53Ri@/t ڷsl9ά !YH jԿ?gG xaAP"ZQEC΁qA|(\]o؛Gbx3R@{!!R#QSJ6 D;m⨦h[gFjfΆk6h}sЪ+OtgOjM~ȣaџ ²:t`` & ´F on$,]p{!RT+/!39Sƽݑi#C+v3_ZR*INIRC$_"~|;[әιㅘ;vv"e\1iT24rR>s')f S2!]j$}f{CC'|i'd5KsqJwu;庝uk\wn }g2] M\SFܙ,ېHؖIU%efjOrx'Jәq񜩼Ԑ#+t :Ԑ3fbCv)| \bO 264tgV$2h d[4up9͡||ŇL{Zs:!rf,5t=e ]cq'sB|iBʜa:\s*dC~)Pp64(s{+$HX!dmymɽ>S)U\=.KK `=N9sdÌN5.L'oC\rp(o-g龝Ni*}P8Y 窵y2M!ڦNO:I7P6W*;]9JZd+CF qy^wg r0G{ 2NAg2(W;gT4j(WB(R ^(2{@nu(^Ņp3xf"[0\2pMCz ]Ͱk ڈmXAy/iinii;aCgY~EqQx5~\`\VI&UCeTwy*ONCHX鲠ҕ* 5e+;5Ӑdz/4u=I{q2 ]iT2UWupt{!ZqkYcpJ(8P'0YP $d' R nj"/PpT3 U-ӎ+czRA$%UVkișF 4wrqW bzL8,CCZo;t+DZj-=鸝4`abV'Onai:R,-0H ]1-vXgU [9 }d!40mJYg. Yt!^`g7|4& vP|ivT/rݧ6~ ~eHH I!n!pA8,%T:/%SșR 3V!\Ҳx/CC+o*u!Ȓ{*h }C]RCC^N5l`Y*97TS>iQS)wrN9尜CoVT@H?KCm0qo a$,[XjT7(ܣx©$ 18_dLiiZ CWɑ}PQKYU',{f N %ӥ[58@ZK>LFz!B |F F|("UjmgykޚwIiph]V"O4'SCÅ,0+wp([NI!fJo9AgV)H;:+Uz޻G擑V4|_(XҺ-1z)1r&䭍8lsT:@b["Z3 _LS{TL]5}e|[ja@2V2>mHƲ̙chx vƤ_P.ۇ3T8yOh(;,2h,ʪ(} OsÅ&^hBgšK~!/>8{[9M@v^>#^3@W۫0 {!gNQe$"4Ҳ:IJBᵵ3%,LVқ[S: Ii"ZsBmc"$,4+4m`F% +¥s "׆ԝUۺP [wj 5Cm λYtVrJ@r b4*K8Uge%x]V:ّGP`CŶ?wVi2߭`ft/^:oK}2 5U]/!>TKVk 8WݤTJXX>)7CW]MNuφdR\!41L{{A1,z<ϝ} %e[eȖ"eqbZF{ x2Lݭxr muZ `%˨U7A P22VZV渭^36 qԕ@N5,#tSCuTQs_ԐsC$jȷ ~یeKVR+JQŠƼL4l~wX;e@}}Ƥ8Xj742ۙ*&!r!(e #>2rm9eѕek ,+@C| icv+~ѻ r<װFAِIAkYD'pgH뱠ѿ!_·O-ɕ/rJ""3UÒP;) K:ĺt\YdzX@!l!{-ƚVZC6w?^*6ǭn5ޱDSQe.@nv+1+YU!ިHnבj $Oen y(2B.|/4=dpU1_Y!OWL7˻rchcGBמ.D-)3 w$paUKs2,66/5__%`%IlAt^@1hýoF~ÏR}''IW;"+ 6x04hc-B2&NQ2[EQm ή۔UWwrKW3wO"H ece8rD۾a bGtV銀7| iAprº[n OJn鲸ht+H>#*uceLmSxZ Yb&!GšPVZ|iG'j\1^K훪 C %}db`kZgpvQybd[,V-fxl܆]4uLu:ald9o(!TN kH05 ™m^Gfׇ[ ]C:2,V~t>7ĹGvA[Nu→1LmHxIW76:oea~>hOھPj=oȢ+o+։eٷCf2Vؾ&~$/ JB_臬 Qʂ| ]Y(!޻Ґceg0jCW12!;U8il7 6fr"'**Eecr*(o=OtJFeuՌ_qSs^WB4qHs6#74_op{+ +UF\%]08n]Ij7*E7D ez"ҺʗU{ 6MjB+Լ kPmEv+8 ___VmL~ayeiJjNhOHb 1սHWOmN/V*dBNr9=+RnBu\0% ?Z|<bF+5"WakEJgWC^g:cPnR/Y !:w2 VG=D!b}v:rbJ󕑌Bfw9ɳk_匾їi mҷݭ 'K/4O¡f3>0u&KQ{m& W4:&4q3q%M UW(r,`-.k[\,wqem>De/xW%qYJHYU\֚/_rE4f%*H$s\֣QV-1-doM쵁8|l2&Q^ .V]h%H\4\C9r{B OsB?>U5$^{J-;L>wt+!҉mrI RǚP- rS3,0VOF~H-0&ɕAR񕔊K*ʕy}i#چ<_#?>rYP`T+w5ub55tToj"5%GgŪG7gDm [0}iw<"5K˒j E^C|CF,CB|imE*V eq.V\Ź,se j~ەzWrSvU̠+A}@!VH,xs 6mG"5.!DBh=5Г-p/{֔f*IG1GMqK- 9kYE!CO!_ute(GnY)iTxNt9M9bI8ߐJ̸h(X yBJt <*N$FNr} o{x*ڥ,{k̟s]ʓ3!:n}Ԫ{"Q:' / sp І{9Yݹ[kB?#|Cr<~RX11?)߭2=cO6OC#pLZ'Jnh>teǭP6OT+FIg4!r_ŧd;MVpkI$fRc^ܭH7Ǧ_iCY&L6kI'+Mt+ͨ<"VX0&P~wVj1&Zz?Ihȏ 9 z:{Ϣ~d=< ?Vp_%-$Zh-v-H.ee.FC826$|iɷjgz[s;l9'HfPV%1!\}Y|!+:xO1&Is~!|Vz[O`AE93Yg~pU*d6@y],Ǐ{|G|^܍"#iIjkIoy4ɂ7 JZBKS ccIU-R [8#9/"> +6UGVCWWW%P>h=cckd3!$XG̯/\v: =U+_ǰ~ [ӂ|wί >_ ם3zgXBYN*}-Vb*J4.Up꫊4c薲zUez}Uy b\TxIV9@9a<@V> , }t7CA;c:/၂03ܭZ} 9&h!KWa/Mh_?/,qGr1#v I Qh|.l'u{']z o<ni5/ (G smAPV<# {h%Ł '9 a!9{CyýBk\5\螖Gzii$o*ݥH'^LO.tgEKAjuiMӁ^hY ?P 5{TF s8/Tٹ(%W Xgw51}nA F\y e[SXEܪ=6JaD^)^]ž!{>2ӭ$ q=2S!GTάLV%& rp(?T3wu.d~OCl݊ _vЁ6g irLJh81`ЉXNجTlj4d+s Hnn5(T o-}ɜmDE_Y 0b2SI7֙BG07A/r g֗=,wyh StnVR3z]vd>yCme%fWQgČVװwP2 HJ- ǭ 1ӲVL/G#B=X`=bd`gQ*~0}&+Ҩ9 94,2x.)? ɻ-/TS8}~x zͬ >Tjg} 3LiWL)rF(.Pp~ԥ rTc*{i[sGCRa!KO0o7QXPq FHԗbVMJdOgjCdCR!҉[);.0oȠt{#+cދNx*?sO+?yy((9|ɑ{q~[I QA}"SVRZ }tn ~J'2B$>Г[fIkh$̆ P6;Պ/-+~7J#d7Dat^qbMZLJ}={T>Sy nșyw#_\C&Y Hvr{ =ow}6Ԑ(, PNazL R Щ[b%ߪ/ݽV9GucwB"יp/?/>B<U6WDO\rW Քs\;>Ԝo{ Ws:Bͨfm<\JJVa|졫dYPکED_d%)k_͡bN媂Vku Nz3#<*]$srbNF]>UʽQ.H$KڎyA%vm;gpU:|;ʗF 98b(|(%Yx蘒 e탦cRH!#T1jcq VZȮ)ۭ{]L{veZUvp@V}{36(XNV?3y y/O3ح&.VIl)YjI biZ73f<tvK%L] 1td~Nɱ]9$)KD4 hx q2Zw{r<"d"[ȺjeOf {>BD ])Ʉ :$)ЭX'T8i٭C*}/L˽5Q?x}҂i[!&/'_$|/Dtv)Vؐqm> mCkҽz_k23DvОCrBu/fɹbCչ r~MG j{rce}}' 9y ,b݊ bOjr$HzٓmQ{h9ϑ+DΡ.XV =ZNpm K ӅÁE㞌:åT q*a>0 ␑ņHJKw(pz'!ߣτrzY򐱒P"NP2`^H1rN_7o0 ב<^(H ޽G|xXgF'Hέ,Dݐ>>O:IlEVH,zًlDI!}ݓhZc*_z;? rۻ 9V~XsL߳t cS?aZ |}چ$OP4\}f(:9ܞirӧ̡J fcP;s]m}bk:9ȿaVB{7xM/t<]1OcT!6“"n_w @,x~ hCTv{9 9,.G@aDk܂\}ZBg=ݚN3 zjZb`W|{1M.^_O)gR+`ӒqJnsC39RjQirN"N"NnԌ(L5d=9Hn|+ *']=MMW楝dZv+T{;<8<$ڡKqOOj ĥC:+'_M92!M8@Z$sT+?䱰 tNٚҿ4aO[5bp x*OvgːԞ)}oHW:Y[9^aR$,--j((||g4;d)O}%Www[^s rnT:./:,Khfq ib:iI|l4F J/َ.FZ/BNҎ:8Zߴj+vRHk!kPA {]U9څi 5d4|>eyOYgvN1:%~j NbnojV+>2+oבZj߇!DȨND2v8[/ MCEc]}a_|H׬fJrU_Sr)^.6H9/ۖ&+QL~Lԡ7&{C~0|U$79UP̠ YS910v;RP5{9^NNNNNV*v+9Dӆ@VL4+Oa?)אc8%!$U 2 LHpEIܭ$J?ۜ V;sg?q~tyMӟOGtNߐ׹UN35dWNJC*{ğ|9cʩ䗐~&Ϳ!gv lgfC0&Rn \O2]S}lEf E[!1IAL$DISIZ[IHoV9^HLnmb-%m}%m/T^sUݘa7? 3Fz;/rEƾ  KWAOcW -vFR2ar{'bY3mZJ /Ʋ"Z C8KzD1^(d*jNKDDZwV^{oik7R̆rNߏ͒b5Fɒaa>C 1_+~Q!V>܋y7B Sf[@؅+\g5*VBo!'ƃe5WV=F,,$//<4ČNw٫Hd%_dey/5#$b )+:pIxım[@'ĶĶ]_7~!V-R ~~`C2٫[ɛ[GX Y/s_sU౿k/oK:]1O3X)qK;> nwcPO 3u4t%ּ\e(g4;)r A)4ec'iXrYref#waΏu&ZlocmHV~C:BgC~ רqYpBHȌnlDm-ɥ] ސ%%W,cW֒Ea=de!P]U!74tգCr79j&6))TU^vJ7ٝ-MymNUÖy环oF=Z5_$N*!\}S -тxwb/H#ոZ5ε1x%uGa!› -6hzP _ȃP.gދ<7MyD D%EC^ vca+/4V!MV9BYyR3>LA2$.V|=" לa¥5Ͱ~CiFi6Zx*H oSvhVDo+)AT!(V<ĜhH (r{-pæ(ӯI' ^P.{.V]> $'4D>_ۖ6 rm&o&չL-(6'ie/k.zҐ @s?"m7[ٍzF]喺++ın)zǤ%1,NvJCtYm2p7JUOa8?!Vl[/!un_̕M?fxB~<3PP.J :Uˎvҭ| ER[Jpϻ`OچԀ]bzD2؃XM>V</*2<7xI쏔] a,Y‰c[nˢw&5y ܺQL<Ηd8aNFrIb~-8<TVýe!>ŖXm,Y\~Ck//LTbT3G;q{!bm3`fW+G\-_.U\V+&+BoQ[Èۛ8LLե0(RUi „}N%Պ-,jcfX5(+/ٕvAyl|&NbN,d\ھw 4ʳS~˟P ϵLCJjx?Q㥅,pd^!k eQNf5mXB8زT:-Ynl=Nrav2yߓΈaN(XYP鰀f2Ζ"Icye5\~S̪ -b niy쵹fvm55T뼪0ݷslɖܭ*&{aZaŤ-wnE8cr~`wH }i)]QMTCLn5/&x13٭H7B&e6P'ګ̠MЖ,ޥ!R%iIFdRmɷ:{SϨ8x1#Ґ2.jɫTBS!#C>@Q&?zpCҝw,~lݏgѯB%_ȗmöQ k!ʵ=\>kXjY oXM\ɭNنb;[yQip]@WDc'FQ㕔n*Q9.tF\QdKim8e"+~pPIܬIYj&ORNr5欕6.|-mJAawQR<[d^*9q~ =A˼-5ex'/P *vCC+V KD5 n#,߃gUm# ^l0·-0sj}ܤQ%rF 9VZMVzqp4o EKM̗u=Z=i\fQ(@}@#%=}}{g>̳ܹ ce;Ū|s B4c[pfmHΓt3:7582!ix,N ɗd{Za*fX8ϚgU 5c~L^SS.ds_pʐ,HkTmhgmn\>Nhkq~Zih962aa4(R*&@CR' ՝pQٳ4KUr-d+̂"G$ 5d w W"#~GjBV$ gq*fA&K%{2,ʮRm7yGJ {!ѻCTo_3,eJpdʽlo+]Y[ p/)S-4+?\Ͻ[Mj:˞ڷu{ˏr{AjKthe>@fcձcӎYl!dzo+GK<ɚi~%&9'%Oj*ߣll(-JEZ mERBꦗ*fSmWmtٳ>LCC'|_p]-!q( "yIoo)ZgpB vLt/B5zwk?Y4!'=+W4tYZ1' U5̳].lϸhoNz|SSʮƞd$ٓ~ ;je3,rC+[ڮˮ̞1U- my4o {IxOVVCǤ`5dtDWlZ=rLh{[ ɤD_8@{].Gj7[n.iP5vU,@UEN`Oj>6/oq_B2S_gtKvMp̟fvgjýLJ 2 N&6K#_b %]S"z1ۡC]b╻M;jŻLJTAF)s㓞'=}_)bG$N0 ~(Wć[ wj>T ;&17/cAsR5|OcCp{9{2^R+B;3;Cڤt54ɔU˳覄M{!)d l 90,5k.ƞYX@e!=uԖ"2cVvm}ۭÞ\`9<ح[mϬ^|lIӭKǙ=ٛ υoGr Si I ۳lghCZ>}٩VR9TY\{s)wu\\%(&&IPy99M%U@/E{2k2A/W+. Ɏg2g|Nen-t˼ q3SDb_h藩jb /T\3i 2tf彂3}h„=5tOINhL2xx{$ S 'Ά= 9sO4@%cg>snHfXNw319dsCh dUɨ||J=Xܑ̍vCG+d0(yLp]_XYв!E"|A5^3x6'Y}J>%kO'1f@k=(H̱O!yΙ2 {|[TLѻ *Rؼ!&p뙊eY&+!g(ehU!lqZ4>tP@V.s7w\)렠xCÅxN3нGwexx{tW ޳Vo2ɢ>gי~>RZYͼچpl_%FIt_u;vnLyC0vؘY[q АX֜V Wh}Wp!!45#N"N fJ,J,*%v=SrI<~(RSL=;ISՅ}<| ~B䀟Y޻!|{~ S!PUQ(]tGx©x™ ǖG y| tm:W63g&{RviR\S ⤴Lo"~ZHIdnIWC]3%@IC K ,a1mWC 1XTqĘ'O~/8j6=J/m#)r{1R!XH9BWz13%243ER-^Ό4ᒦR©R©R©,9{AnА7fY_bE 3 &V r$Y+, V&9R~Q07@/휕f ~5mVz+Y\DKKR{兹m7WFĸ2!oo\agWXf ">/d']rlÅx0lqd/bZɊ:Qo+?XjPGuB#YVșZ[bF%/>䕟BIIrCG$&0b Cd@DCL(}> 1;N%In vwfӆ4%z K$k/S(W95˚_l" df/ʕBkqƖ~nc,ѐ2@>D$mwX!WK҆8g Y^m>xDNaZbY(XSC3!vy "ⰈRAN9RW2r~]f̮RfI_WVnJ=| uuyX) BkS[Νڅ{,HyXG7S=J,'v8*&@CbMZבBkj򱗥˖9+u8R N.&3{XbhO!/,`e]eJj$Z+{mCCWRohж-+嬤i8̢eA] ,$ U}k{-ků)tȎgt  {:#잒Mu{B ogC#9 iR]ZݤӐ]%OvQC6VV~iޓ.gWXH`Ui Z2\w~0f~Ⴓ[ົq< 64rw'#6U)Րc|mOxl>icn%}wD)ik!$ECX_jF,/ rͤⱫ{OCGAKF'w+G;ner k!:#kZ}FPe*gei5ZŅ5LrKI;h[@fזr#0TtUTU.x /ƞu!]5#Q|Q8$h ]jx-w3s™Q~T'] LvAK,r1Rn@S2)BvV`u{kn+<+|a # :5 93-JpA}a.C51|(řnυv4NkB|_d߉)3W׌W+}w^ZCځjArJrh~@CLr,^ ۍPCyi݊cp B9E=_)Y)|Vyh!n#}ج&t\Ginh7dՊܕ| R{C4k&7*;|V7{|݊UZ !ͬqo9)BDjI 9qx'! GՓ. a 2Oڔl2K_A\q-6qk^-*{<`KW)`mI*A qw2_sk UC-׭Hp0.̈́/4#`25 b@a8x%'Z)/z(8xr3/*AHB3@6fO_+8SQPw+/Ur/ľj%6a^7U[*4!uѩyWP/i4 2Vzz+`[ 74{4UW}_&|eqQ짬g;mDn/S* ]z"ZO;d}n`y{NsA>gxFP2Gh۫Қ,(_T8?sDsʎ9Z'V5g8ޑԺn o2B|GCTȆ``%v‰)w'6O[!V'lh0j|J{xir/3"}#\qde~3OH@X}u`GgbCFjDNuo{_zrWCl{!ׅ$i4T3-3z) > t`YWL"/Hqn},ӷ!oh7vPʙ6@C_.aY ʴ^ԣ6OA,pu r]tfM4W$G0 t+ [8NI_Y! gߞMߐ'5| \Gӄ-j3dOgB:쨗~23!ԏ˕ygxM-IDh?fsG0n{za{cC~ARh::HG`zϷ}T0OI:aOOK>>$*j \+\g00)t˶㥾It4bbO=_x>vn0k[7&{`|Vz9QjrmT??&ɯ~?7j_A'߾o~ϿOɿg?=~_/~f__Wi?/_o?Og@׿_/_?/~?`߾c^_/?eWO//~xÿֿ[7&;]ߝ$Qb~_?_WϿm_p;ack+_W1p?}?^W&g?ۿo~NG?_͟_/o]o_?ïo4/?{?7?_ş}?ͯ?g?_og?=O y~hmmϿC/?'O//x뜣w_ߵbVX,dF1֩EGenomicAlignments/vignettes/summarizeOverlaps-modes.pdf0000644000175100017510000014172012607264575024560 0ustar00biocbuildbiocbuild%PDF-1.4 %äüöß 2 0 obj <> stream xZK7 W9z, ؛]&-u撿_>4<?"%lÏͿAaLfuۇ៍&Sa;!Aq0_o6ƺO~kgTřm,8!VA 5O*XbfA <04bh> ^[bz$l=@jNgaTԢǍkXP ح9VMǓH3K S(xI*6FUx2;='9ÎM; U DE)bYeKM(J/KJqC1YP -.󞙟R]7[j2OOux^iev^Y`lt٤"Ǹ*D`OÐvwcr;Iv,’~$G>]Z1Jln ,Ch ԐujzQut@ .9p.QWځ=L>R.;A윃Ʈ䜨έcPvиNv+.цW.q]~g&cCT3eޤk9VTFѯS :a.ܣ:S,PDhX]gzUt|r@`}5(QDcDZ%- tHUjpunu aXSQxWS bR\ @CR^8a7YeL P,vtK endstream endobj 3 0 obj 1902 endobj 5 0 obj <> stream xy\8|<3><0+;CHx0;H!a 14Xh ֵ5uKCQ*ZXf~*moU;!j#Os9 gFz" ݻҏ~(Ba}a>[w}+>DCmOW!wv\_P#Tb'AA yߎ]W|Qz䓐3GI/uEe"!]z?= #I _;H}:ӛ{p{0<bgXN$HerRhuzCdXmvGŻD7CX\ȎP= v"3?m(s*CV#5ڇ_Acb2d"t'z]2 &kqQP*6MSJӸC W0Qd?Ⱦ/b_ZyGe?L}h+z_Fnԉnʸٝh:~jFDoN~UlSٷG0ꅑ>n'gEh1ZMlŬ ff_VxDJԁ>j΢/Gy IքFЕ {=Ÿ13f;OӸ ){(9[-fQ E/q ܰdjXa:^<~ t3́C.RBU =h/ pE->#r]):h@Khƾ4&yV< kv|߆'MF̸A8 KB$VH&yh PXCel,b**k:3̾=$ eˁ#aŸ p/|yUZ˖uz.C.=\R%zD5{lSZD (*C ?@v~ix2*t5:nyCG/_w>}Hufxď7oa< g1ۙ๕9ͼuv{'79q\VT эůHB0=S46Y4km/>1;Aa'w@wW`H{AZ_x6-tx<(,_?H;`m'y? O[w 1Â4 `Rzf9¬g;3O0{C2'Ygcl;~} O\6r۹kW׸7E.QhыbLA|qHĒVVUHR?h`ݧ.Ry xHT]¦EY7?mXf؝ٯ˘x#<.Q5 ݄7yg!IfgT3r׈3TS̷kkϡj=-=k0Ls#̕G}@z/anEO{oY/ *\Ƥ#qgMA_D~ O"bī%pkQJ0}?`'q1V}V|-ďЕIYvLtZ#hdA??,آ7D7FZD+oٌG%iP]=A2h_X {ab< ;`h&'󰳦P#57q:AOjܗ-SlFg)% l6TmArQ<=4 \^ 8/}ʭ{[rXaب`_F}Q=nm써#{oR>wOvU6f(•} /W>c #<_Aޔ)2=<@`EϢ]O@*]Ü.c`Bd̺}/EN .Y\:UUYQ^VZRLcHQ8 }^w9 vb6:FR*2D,XhwY'?+b$킂<-8Ir-XנXo?hx%\p3(|eG?;e{vnlN(^y,N*7{'y cn> yǭ8oodscnEq}w8.DhTO׏K4|Y ?:|Ӥm({=]ng0nBo>n${A~%ֺIc3e7 0s]q|Lȓu5Vm$%2R×wcl} Mx*{7{vo[WD:vI[/EOhu9PkR蝯mNt#JqL6{aMU$Ba5wVC^{~⒮|د}HɼA<G%4_dƽi- mڪ@|Im%symO !ig:I\q9~F?dhQ=M7Wߴtɖ|6X\Nx#N|0Qx S p"i-щPb;JO#߉86}},-JHHGE##RD.+b$nr.)tn0$,.u7 ɥJN0ثT1 6Ą& `0`$( cNp:̅bH,ħ9R{Ļ-Ϸfjk9 ];SO%:} aN3siq ֕TTqMfSi]^ZfPW ^o@WE`cUr>,y:>`Q]${yi`evvUo+b)I5LMKFcL<MNOpӏJUJeYY3x;!?LTN!?sc3L=#pƕ2NӞHKuc㨄J9 nU~71LytHYQ[;h3g۵Ӄ rPѥک %s d~|+2TVUT1bT.enat4.{D)LwhX큨Z\ "@"EEEW_}5ofZ=:nωŰd̄&OS<,lZ%I E+@c)RM*C$C*T,uE~6P^VYQQY^*J#)ꠏXE*w|~Mj&'Ə^fC/7kJcMz[q5=Ұjt^^_pFߡmO:^R8v-\75 $kԊrS SýןB:ew0Lm᝺;7MZ`-ćlE٢Pv޳%haMFb؏a֘&]p`6 FQ,F5 ӫld#$~WJ' B8sWj Zøapp 6t:9D|b ~}Z; 6s,#,֙S>3v!v*R@r8RQWziȽD67}r(fs/xۖC[K;nSߊ@/P6ފB9v⃝tp<ȕ)*] ^dZ 8 _(čA~".r\pdEGÓs_oVØhy }/ۉ5!}B!BȎK7~/Nkwht́:MsYN("oI;OHn gsUc`Q׵Fv5r;ҶFu%v쟹{b5#YS*pB &KTKFyrxR?a}4XXlv^]+>ء:@+i-ʭ.]Oegˮw{.;v{e.`I-V,-|C:%=-e]|=>fVwrv3]Z%9=][CXq2i4RMw*+fdi,^I/ mamA|Xh:#3BK db*;,#1xτs<k+y!2Ҭ% ZwDTZ@^#o!SB5)=SYV}עw-tJk|J 3`ߵ!pd:2'6j`N')`;4)Fk`MlBb;J*H1nZ9,֍ ؋ D8.v[Fg큖l(gZxQ"$z/3>xn.od)T7 Q#~eٷ ߔF&u&!͛vK()q \xTG_sO7ΉwT ʣJF9(0i ؒod];Mul.NSJm<6H2<fYE- PܦAL٘˱F*:ƐwZctŘq8Ǵ|L.E9͛ża,9DRp,$L#jH5 b 72bMB<ٺ5iA-O KBu5$/_eL-^-h\6cBg^ٸRg7 h.K:.|>j#+lZovT l+ pF<u̇;}iߘOZ}@"Q+%%e4Υd.i*ĭ2aGvOAkt7(JBĠ̒]}9IMm9STYU>IYѦl̂[-ӒYYYD W]$2MrҜ%C8, b D ]QyB-**Ykql}}.8mn&5EEf3PVw}1[sHXB`tX8d,t=bu܇ J}%UPc1X$*=W zAyRs@394VӌE9#3}V3' 8nuaKeë܆Kg*\r/L+_Z;]die +k_TSm'=U7eJ"uڶ(P^YtP,-ڣ4v;YCV`q]wXns|[p_W_>ŕ.[V"A_Y˹*(US3$ݡ?W'Wjnu. 陙3p/nѫ$M8犗+ K=kK˚5ŜΕK‹/i;qhQt$a{EM.ŜUƆ~$vo%s u&ڴ4,DBx`iI0֤;zej،=VtXUB\zQ)D|2lv\Jǿ<{: /?Am<HSEd|K/A;?.z({sߛ7B[]vۃ]v۫qٍn/*EZoz%ƢJzdڒ6l+T)Ԗ8qh|*~:ƣأQO':4^y_vsKv`t}MDs (6JQZTvo)ʛX8\!'8E/Bnޅ0oG;}J%CNM`W^9e3ϔn؃ͥ/Oh-ԕ-qkח2uE*0O+8^.;&e%/ɍ?z/PQ ydVm1znhxd}C]G4Fݏۿ 3"Y%^7Z68:NKqXaL7fy/$/Yߖu?-bf~F׍W3ʞ@1%n ' n)11-θϹUmoi%_&)$hA$B>UX*w)q8d -J"u4Ch A2RlؘV>jöI N91Fb'łX$?|>=3egPG;#Az;K.U`Irܦ' )VĜi% m*ADs u\aW߸K_/.r^ŗ{h2|ob[o`@"`rz}sv4:R>#_D8Ү~J{H]ŋ^<:$ݧVzm?eͥmee'l(7az(n :QX.mb # E]R쒏əN3r%aV`)3Ƅ9ܝ/6CEyjjm '%*, $'T*x\ͻς}a zUf,Pr}ic%9adW`[`×ސ~xUEĜj孕AQuZL޵g% ʼڟL};}Y&Eq-iQ}x[yͶ~4Ƣ'!{u?<-_^ si$^֙JtMOL%$Bb4 ]M"Y!|R\Q~`ѱd*q.<5"{Fh[m~J(:?,yJ"E@j*NC0hs8 \ME{ѨU­KzcitĺLc&NUL߹Hrq}>w#L\$4lbpҠ? х($H(U"RF9s|7.]p3y~tmg}-b.q1칸;Sھl6^?P/7ҩψݕP Kn4` uuJ]Ncң{c2X+a::"C~)ŃwJ&Y::w2NoƑV-&zX*k>מ<ñIo(2*zN{F}2VW\+`rԘPSj}˘{C NyzwgstMLvFjO䍣,0ƀr`rr[ ,4vdyK/ۋRl48LKɺ_CKO m.sKW\x]='2[VHCYe0o} !qt& 8$lbG۰-cmpfd>xSv (< !"F$z[v.@Xl[ W6 pH$7Ij"T)WHĜH|Yqb6N8͏ lrASG|UJd*IySojWsk33<̠fm3 zTܹmr Isqc")l.Y;TK7Z- ۣnz\فs6cO/?3,!T]vqnOw{]%nC.r1e_^f b]7x`ޓ=<=g;\w.hF8NPoanq;;҄Ct!v &]\v+xjIfJ0p fu^õCLIc6"NT#,Ȑ(0W;. 7eex;6xfJcݫ ( 럷Z3/;ѯvVIZ+??w)ՆKBo؉MU(GQHÅPXi-LW= +*ltX;lvH%RjnX1VѤiW:N^8:Vs0PV*U K 88ɻX֤3J-._ZQ^QI11R.^*W\Zzi٥VlT Eؠ zQ8Yg |wHHܙ|(1z;skUv4؏W1`C*a/pٝΧ IIHF.P*e h"b*1b)I :-uuoX$sIףΈVeh?s< Lay2,$=x8˰%oO#irg8I%"f5f6~,Hi>?Mv8w KJ "*+Ea 9 $!+)KBp,ըE~=M q)׉Awy 3n6vmwko#9#h0wTX4).IB]׷?z"KƍM~vQ6km>տc6\s6re.YRڴۮ[/-֙kl:9|[~\nu%Si)]5[b*,|ꆕ׽ T_MТKo\67_oX*%wٳ[QGm)ky?;}tmۡRrvW;TZ.W@4 l0?h~`@W*-h5n.- 67HFoߥ4?}Tw 3t:B" Ye!q\׵J6Zֆ)ho!07]o>`U6WWdRpf~90N5Zv(u"\ԸNk2{Ii(Of L l!0)H2b5^Db-X  (~xtaHVr !E Fb3rGR , MOOްwK`OZ1+~-+kŗ$cɹB,?( JA`!0`@l0!}a: ģs):&wakԆOO%ڦg΂NM[Pm9k֞'a:ٴ%w}GsZ(pAZ"R怹H1Ki grt*-P&NBj  0$1 cj]m$/ǂ%"/rwwU.tsËs?ʍ޿Q[EjlJ}_)/1{/hu5{KVa&4˒>?gO,ScŬLˢ(E*R,m-Dr<$wKGKŚI ^Q-ϼތw }m=;?zaQۨ}q(v$")yRk*;Lְ=zN_)U(*RQzEꇼKΡ K9t.wlG&sIltE9a16Ri}D*=zϫRp MDN'/>cZȕp)_uuO"fLj&q` ڬqKG|C5d`2<*otF_ΐnޖJNb=Ouo.pW$RT9w-篵g.6G(:ĥ8,u ^t IHs&b{_7t76 ֣(s=K5fwzn)[9r,(ބݾ6B5% YSXײ6bFT4RJS_ID=Ekʗ؛KC*j1a =LOEy=sNh&jU0 pNЫ``/39^/`9|&3tFq+ύw*qM]tEsNWgWŪB)7|IԦ;xٳxG dFKOI U+ƬǬX@)F0lx~dA?ˆAitcr$_y8hn)Iq0cX b bc $T [0,K~oB&K($ɦcV>c^&fm{ 1 pd`K%V(z̸23X+hcBV >1|A B-dv`'x0huh}|;}w @/m# bQ. 2|Tv\ȮS^WPѿl(!P:VB .hFFtc)93kH*Ta󄪧ՌsӜ6ACUy}΄T0)qw*119H9aZ1BM+ NH/;>m-[>[[][Hu߯XUH.`ӏ4`Jؿ(\(*cO<]>V.qX(˙r Slvjr҄N*4Tܧ4%[hr'q)HңW|Jc\p'8t,T,}N?[[YmhPԃ9 oi /л7{KS?oR+.2ry\6,+ָ_U6+M ޻𳳅BϷ%"kekV)E߯Ws*qu$ OmD7<vpC~IfcF*L0*-5BPA} |y2e h"N!% -QRyy-D= mx1GZfK؟p;EWD_k%zɟ:dɟSܯ[Q7kJ/?iYY^jlkϯЃ6#3LՁC)]nAr+0FNci/5vaEyїYyXz%ߏu5“Eq es~PJS yȓ6Q7ztCreiw9)C=Ahϝy?c-ysr>9Ipnܜt,20w-+T[4羋9#Qi!|ϛ;!94T*s y=B?n_~#TFKkv*/Gy\/x)]NRsoȜM^tOӄ]4l_^'<8Ƿ/J=ŶsBtuf^K=N0ޜw+yZ@ۜ=B)N1^ {W^KU|\Цп[XIQœg7`59KMC<|F&\Oޖ#wB ޼=.΍Q>樕[pޖ>Xׇh T ymk>޼%379?GN*!8 NUP$d0~@)W~ũT2QIm1<įY߷w_ӻ_;k#] ?T7fȤ%>ם6PhЊu?!~}wWWf'?߮n}aha5|˶mqkw?Իw4Ϗ؞Jطot۽fu]{Q~c_@_ݕ= d--Yop!(wmx/34wӽ]yIsek\=VwP+ݛ`;w}ޮ!woޞ8ϯw@֡{`W/?Gw 3F{SL/FmV?b ̇2ݔ[}&và پ^1ܻ{oO/,ptf $3пpbHzgȂv ptKd|%<8PrtC!ҳ7颲ߵ{ܗ#3H>~ѕ邾0p_u$ǟ4qxN{Ewo?Yp?־}0Ho\v7#Grru``EhW+v" ;`29 -4z]r={z3}dDb޽]yBAt;w'v 51LX!;2N*Î{{$.kZ֯\nʖ5|2~5k׬WUrw7 wP)@?fUZD {*ȉ,.wm6趣 5u ( ܻ{D r/ޜ& g@D`h@3;p)% pᅽؑSͭ֔ׄ ]PD+灊DƷӾ]==}dP%J[K>T߮vd_ t20(D>|8 4I5Z00 <& c㇥(wwn k4ذJ2WWŒeɤL eeWVJ/vݿ݌$ȣG!1 !qVq9 oSen'wqŞ`c4'/V>yɋO^O^|b+X'/V>yɋO^|b+X䋕n?.]C}z/y?f?ysMrn1ĩf :_{r߁,Ze#8>e0>xO>e8aZ> ;I>^<&VdF 4R_r'BG!%w ;Pn6i/{o8c&.myI,@t+V`1{ Og:i r)kKyZr HH((E_6WثU*hsP%|CW B!@!U!h?IA8Fr^c:^>rm?JjavIkaɑ 9"|!m{imIRhNvOC`P>e pl/z]vIv`".ـϳ%U@$l @WvҲQLD˺[˶"Vrqub\18ħgĢkwQXFөH+FV+ AѪ$XuV k!!APγAnt).r1i@*iJ5PִB脐׊kH Ԫ*ȩ Zf> Z! NbZH_+8ϒ0jjJDzu xo%r?W׆jބ?JϹ.+亟;WX=j.D$YBS&JMb8,ނ" .  1(} JC-: cD@ב򣴎@?:Q]RnXQAi8ghyK1ZNZ #Jp Uw[`nA: !Ы&b48v oopME'P|t\'ЖOGP >Zs g hx#TEV(V8rPzjqA@|"b ?{ ]"L G3tG4ۍ=cwQ勱@qgg,gl9%]g˨cw9{nK#-ب#iӞ]T4(S )i^@Ϧ"LcM@ 5 h8P&qA=F6L 62LTcHJE,"%*!)N)_f1=U" TJpN> ;wiƟ k[ePHAl,nnvfkw MMH˛VjVt^S{r=Uj+q tw1\su+]K9TN\IB;0sjrLY[@RTENt֮}`z> endobj 8 0 obj <> stream x]n0 em˺w)BZ[Fm ,rei!\;X*]hDIX'1r,#4B)&aV) \|d f|@.)LҹyB.c/??z%?9#J)c):HOS+?xS;͟eAm2'jl8}֍ v7;8a=꒸ endstream endobj 9 0 obj <> endobj 10 0 obj <> stream x} x[Ź9Z-Z,YeIG:lKE^ǎ+8$'8,NXKh-R(r 嶽 -iP(z9v }}C'3?o3sd;(Ң݈EBX C!l4/*$B*Ͻg![O rk#`4z=B@b.RBm{/ f7 E?\.ҿ=rXœlu_C쮱X M!HDtS>"d|0<PA ++*uFKoKȎPeH :A6_:fb>ZE[aQ3.B]H 1a"9NCGmYX:nA{p.Z<eEtLzF߇VKh-L=s }ݎӑ z0z( Q+BЭ@C#G%Y _A ݊BSxN&OrM`%թPԓw7%&Ы2o@e8 (at:FXۣr|MOD}hė9-?!; `}at/=Zv|}Uf] !q6q{`h2TF!| >:c?U@ ]Z{!:^g9>NUL#qso r(_xn_*P'>ZR%t& {`\/F:rj+A*f} gnVvx: ^WjcwNA[^<\VZR* y\/qs.#Ǟm˲fZ&Aj*B.c ^.M||kk4D4&8hj9'R4\L0>)"&6p6X5\gM<77M|78Mv 藺`pYM\r͉{{!MZ#M Ci5%!l`5Sl9a 69ҟ\dw oI ~EB(NP4&tn*YKla M SYg@u^;9k#ս{ov-uhX&wo L9bzfcJ`JJ\_o&-r 5{i/&{or'#(ۻw'|w)]75c8۹=C(Cz > Qt[,& \t*E޾*@O7Q~PBػPCmæ{kwo ϵMs~8k]lћ쉖u"qM=,˔ha?Pβ*!eO(M){#J!a6(+`xLm3`nc.d; G@lfS'ݭ]YzJϧ?Ojck1f:sz$'_Ots&wyә2s`9<?W@sX=|ՊR`]x+b\W ŝc*ҥdu~2|GVSn8Czŵ5OIqqi>_nz&WBy::OBzd={Pb4gfVTþ<_N]=y>)k*ÿ̩^mտ\la|u&~f}=\ܡqϜyɐ['=N3(Ȏ EՇ4jΦ愪 \kW/Y\°/>.6Wm?w2/Fr4+s.),|y7i9+SgCƬrҖ !ߜ️%M35aZJh)ްVرZg< ! }z ZNjX\5:G4Ȭ ZFjtlzz='KD=4L8.9Z-Jj>ޣ<%?z/3ʭS {yylƼ:S+mwy\*sm}@}f \0c4EDa BsZ7µ=e4 9 eo.#,+(~`s1\> amdLS @+RԌZ` ZΥct,D5夘0-3BpŠY1rd\^g) 9st*s!jO-Q;{=xNS➒bp+2>"Q_æaӦ5+a /;c䀹yx]:>CnAz:i"UOSU vZj @X/òl+Ţ3äg/<'zĘ!.-4)֦56}8j<+`{:YFaמA L99Ò(>{Nv-Uuƫ*ÔV>Nl m?frM+tc}ݺ}Y*@cJPS6YI6[IPw|{tϝzX*k(ә}WO<+_m=+/yoϼIfB-Tԧq&N3^9dd]v^I#JjO4!m,m.M2&ƹIt1)v Tt[# rh3(z)VϼyfYp7;]Xd~D`XkId W $kRen[B>>-C3f fr X#hẌ́:aY.8䚇v,!%gL˔ٜ!hd'ʘ8fز;.w X ^i3zywjX82 /ĕVyx>CCsݗv]uh}g_re-܂w?9EK pХ0{̣AK4kʬM6YYҦ-#`G=;i5^T&V28sdv_R>3Z:B):;w]2u(;)yBƧ֘1?]I;*USlh)3ÆE?hl:cX@NTrdZsI.S.ݺxg-98 NG=7#~qI%ŏ T`G1{%`6eu CPA+5g5y\+ש ,ڕ6BZTBw0. S؉s) _Y.vWv6q@ٟg6ݑWI (MNIc]F0Ybr >,<^J0ׄ7GaEؤWTJ"._p|Ots2M\' YaJ0U\MsJ,x=)30p>h 4h dH\>E)@@9F vҭ2End"өwΦ~71A$SDwo\NP o6~42 CB>$ZA̹A` XR0Ԟx;ESdq-û/zz!2xrqxIp" \E]̗4Ԙ91Ɲ6x_o)^^;x[pW>zhb0/ VzoqK_S;veU$~u|G^5V#~Qp!7_PouPHp~5;12v>y,׈%9Iس㓘a3X;ÒezۈiVF6B 8#G7}+)UJx|ΑǕX`JW?=H΄X~j jcux5&k5ݞ{&s~ʥI ?=zr_|jYZa= *Ju~/Ҧꦎzk,PDNdNmEuVE;ݬ"ʀ8Ko C1 E`k7 gT;&A*6+\L%spq.ŗ -M(ېdo)U>Fe;; KI"Pxyy ˗[kf<>,!fAH7e/421@aWIfWr&1Oϩ*b Yp0)f=Km^|,f(q}yEdj \;B~~*Ll,veטrs ű=rEo>.t=۩o}A>T098xf{ :ʮś6\>e6pˉ_'M&VUBة6 9^WPѓajJoy1J;8ېcza3u=VJT"ƚҫ1:Ǽӎ}NWzE=}[4!-"{,MՐݐ^Av 9zP{7GJr7+7vn<'ßɌr(2L2 fl0rD 89&qҠ2!)3|Tӛ?!Q/1&.c85I' 0|/s=lͻƺu<¬ars5|U6ݓrsa1ooFA%C8)ll}[`U=\Qt#%ƴ[[nޗliiL(,wZjr(90BG@ 7(XJ,%3`dV5sTU_ڬ&KPkL=dǔ/)z娒Q <`Bh`:/pg@Ɛ9?pLԹ9[K z^"d6sFbN=FjPd{HB5kk;x|-<1eV%W>Pg)|>m@$#\/]a(OVe>Po3'ƙ+.\ /97v@RL.t 6\BR@ŕӢ6 {^W>uוBx]ỷGxa,^W += ˜2@Z[ilRdg ֹVY՚׻ޟm;mێX^s{EA ҮcAV 2אUTW4p/m8hH45!Ȏ7 7y+8{{!\M9ɻXN `Aw pyC%vF'Wr|%"'V(l'BR'kkUS93ORV)1}KleZ6ZQuhZU ,ZiA=c+ Bπ;ҤBY,:JZkĺ^7H$C5r솉4W lgV,T|3tl3 ;&s  9yA9dwʡ)|Cㆍ:oe~pX<{&w}|Z4;K/M ^m>^qP_  6SHW %2Pu) R^GVTkJIa2*r}.nt@gJ")f-R(ΰ;K0%BIgXDu&AS;=km9Nu2pVrLAkEQDB-YJ$zZ|SJL^Af9m×[U}Nt_6PՅtPBt),L@~fJ悛V{PK͜mtYp }tcw(ۖ"%/ry~bH[rڗΜ.``Ŭ`pyἦ<6wɏf?P 9e8C#_`- ={f(UQ ~I8OeQYļgiE2Ԫjɝ'zGUL_fdk*1/Ek_75?ؾW4Ϳ-i\uet9*>˞_czk:ܓuYn!zivƚBOqoAKo7~ܞY_ʦ?7u+-gjE1)\st=ߌ.ZD܏QQsObY j!t@~PvΥoDjT-Tv|by.h=$وVB#P5{!nBfc't H0X~ ,<+ TKH _H]ϼ/in ֠ կ$XԭSVW%-26|_1K0d̢ cːxˑx+P^ Va$X2LFe/2La%ы.l? ڵ$X mRXM`Я%@Ǿ\Af C ZA?K07!ߜ@~wI07 C I0 ӈ/I0h7,C d- R8X~`PqN (cLL " (l&K0SNa /` seR'$?KaOI0Ź+%l Or ~{(ߖ`/Kl  Ha?OQ|DI$(j`_"ʏhZI;OTI3z)yShBc(PAɡ!m@nGhR\P#&&yڇ(-0&R -rơ3&qbF~nUUSTJ[`0`V!NGz1H穣Bi:IqF-Wy?{yq#kF:[lqu*9t` 4 >1Fxqٱ 5m8\ߥ#>6AWZ!5N@A%pLsGk| =@K8$@5Fy} O-¼1XQjo'jCM)2%aP-?N9I5[-D,H9P"wg1Aѵȇ@}/hJ24#]ɀ> 8mPZ&Q3(P]$an E)_#R9"vRms9*IP3%REaLmA"ֶR9EstsQShJ-Jm!Oѷ#Pm'|TK%,hDtdDI8)zDeFvPC2VF>Ad=!=m6a|L\ j9]./ڥ()+qE랤)MҵsvRZb#KJ'5BI:H.BgO)ODi\/HqO.D={&#ar4F%;$EOsNŅ8uɼ$vSIO,/.bO,۳-a5>[/cΞ bYQOГTzDZv)JjL\W+:k?P<ŖFiVG>,eQzro( qhQi?=w_\Q=WE>$gaY@O Hý0*nA^ ܖÐyCt!j0z\ wJ:Í$BwƅЇnD܆(>:2&qtblt"ƆH&bq.26H<tRe 5Dw"cщBnf987 Ź mqܪ87--$0 &0e뛈Rƀauh$2q;AXvP79򀡡hUĖ>ahhbtr 腋^ĆvDaQU&F ;&&'`Y6"}1nE$%Aغ8HqOi2FFvF'ƢH|<$,r;b)Pm`d"cZ|/m鏌Qn+YG0Y0薡L<96 H;QLetp}P9deh{dkdH4&ZD< QBG&%plƆ#SbcD|h0 vY]dNh0}8=NMh{lsqxdwF%!k6jYذa՚nM zUcsfa 4]E! PH c\j "75:IF@4YBzXazdD4JVuð(ktK< i;q@AI |[.%'D4)y/Y`#܎$ )X,_:</>/>/>/>/>/>/>/ {5Җ舕4;r\oCנow_#ZQ>gGlƉX4*?\N$0IOb=Tk_92NL(UrY|ɘO,f'F$K|g1ۤ3O %؈~s1x4/7 1#9;\*B(e2v$sJmprANfiJX!U"0Ԑ&C-H 0h:j&ǡyǘ0{fFQ*4ؿNH J$iH LKDR࿅8HY1 Ǵ.@"oddLtKJ;og؟#Ai(P>=3zCnMv 6-v*>*dhN:/mHc^AQb8<.vݖ,uqG{S}cF!4XJc_c!3`,K;BJfgԺ Zv9 bqIsy|Q&c W'-({ wwRUF]z\z_@3*E >sB}W/o&MP͛774"c_@! HN%AG(/=^^0ahjFN8"iʠhWhKcGk 1kVQ t)gd/j-rQ0pcnj*=TC#={ KA: >H!Ih` fH,wΤKGMtdz1J՚x(+gX{m#Yv$]$ &3U5G6 $բ4ΤtM1Twl-u1%_c,nh!/1Rv)tR Y 襠Rt XSJAbAmH zH =$$9m@{1 ~H P AnH Azc0bwCJ@z%;47XQ!BmB FxfeiôQ% dUԻlZPwYS375eWXMߴ~;kܯدd5haCx [Xt fA=VR[ujgҋo |+ ʅ"skl3;NX ` ^͘f%S4ٯ9Ih45bNq\qRBީU)v++(.eHY@ O@bnS@{ ?Ni1Z y1 @7:$Bm B+x2ȋޓ^&2s 5 tSy<z!y'xȋ <+ 6;!E!!Қr$r}&t,s{ X8"3 zv {;cnK6ےŢ쥆j. ;;)B)~$ ?8n3 xs;<gvA.AàLMFiy49dr2(f"I ZN\/hxyݏxݷy]CsB4 ^ݫ^S^7ޣ_#%Znʇq9}^t?t?twqnNW: l:5叄u=ʀlI=Re|1ұiIkUӂq'sI7@aO";>EFfWCp2q1ڤtkB y_I??(O8x/9]R| 0@99 _G,#1B9lGaTs9N|({W,+9P77C)(nOz|JVe,nd;0lA1l/b[gP %N[! ֍rI{O/Ad;I !ҠBp#9"$ŀVX.J69*2ƕo* ~!'+9P39 2YM2eL !\4@)!aY1z_UoPtݗ?`}``VU,K|]r]Sϸ.'Y]CuAXVovS?k}9]C]Ѫ::@G=]ТDF(g~溰{ x7 H* wJҩ4L**]UT*JbTH3;f e60w b(1mW$*mԺDU-켸_m>ԶKik7% 0 +9|v ]8EF\g'quwwY:cuKdRtsj-m8H98 367adבv< h(cj'1:,AÇP]"H4k(&q){nHM~&Hha-Ҁ*!_)^{;_7H,g}"Gg1o 3wtWoBMܴc0+{ !#-}D;hSbo-.ҽo:7tMf>=ӱjn\jCU:?{tw\dնnn:B+_k Io鵻Wd,sg]eT}HNh $l6.piҕN+en>F~g55|Ic1QYbG> endobj 13 0 obj <> stream x]Mo0 9v@HH 4B~m:smO$F9;aiƕ_eI6aM?KCnn᫣:x`ɫSԄY#+Ku[Ҏk]~Y˟X)=EN fJpBQr,]/?[i ە3%8%"xG>l#Hu<o"ID"&{&:ҟ#WTGNq ;]˛sa|0[6S;3* endstream endobj 14 0 obj <> endobj 15 0 obj <> stream x|{|Tյy&ɐ9a!dBy"` π%$H2̄Z+>ZE:mJm*Xڪh᪽,Vܵ9y z{~s^{zBB~ap{=3MQq2nIw!s{;/(7h]7ttPiye\ @r1;Ǿ}mAcz.gNl4ED R[^Wn6qv@NS6{8x:x> j:~4 yRE'3l#Y=|YMģ*'<9~ P ] p`wIjd/ÃK+H{9\  D>Mxgm̄JX ~\x=ed(#rWGc/:r ^|^Eo?q7 π !! "tDd B=BQ.G$\-T*G‘Hef{)&Khf}> $!-=0;$Zs&H\XW!auchP#~9 k5`-J(wz->[bA|Y~ +'+::Bq>mC{W>M OkgĠG!PSɷ[䏴n? WB7O?HY@VoNr5|C^!Ǵ6M) ?F knܪxqkcDnUסw~8 o>|H4$# |k!ZF3L|4@w}(>gB0Sp B$Q;yF@Gڹ@CSKym[zпrν7c7чVQz>;0➆I4Jr"rZfH ^c.S9iDm\G )r5 NvE}z!w{2M-=̡m_vI?"ͳ0,@Eț٘aVNAKCP8 *hNX宬tW,|aY邒‚ysrfgrfe:ffH4kjJrRbB|c2:F(GmvEc9`gJGKX®4aI)H%JB鞠$fJ5)JC%WjDjG>zq8AI鬖¤E nivGUqN.6F!X8ѻ$/"5e)M(Tꨮ :a!^:-#iNnTyap,Ǻ8 Tq6amUXH> *=4|ۨZ[\m6ưib<,.[NDdjih0\Xsx&)Ʃlj5p.ͪmEַHȍnkj mRb0dG i( Ŏ-pVfX`4Gڶ;WIuKG6[UhTD'gX &cDXJ(IuZ y { ~ G|aCU˰aM! 0<ǣh85.W8' }2.9GkBJ,͟|ZZը%hMw)L[ȡĵldh|dbz#y/&ΉXsR|MgY$}Ͱ׭qԭQnQm[0/Sp|UFU |r1k4F,n1*yj斥Jd'FΰY.sMo/֞&^!XpqpZaCCcT3g4rhMV0.90MśâsNn-&ZT;2 :$cx?}>?[28kokB[u9@ |jo:XZ(Fx@^9AP7/R\ʗ?-?Wb K% Gp >I<ޮvY  Pj:Ӂ SPwD(JQA"h6.\B>͌rPŕ7BKFb]»_s+5+{\;^ ""umضh$gSVkJN^Ԓԛ$$b4?`ff3`>6mbTۄrfMdckO鎢vbO*4gܙ9Ev]nNХ(ZϝXnsOAũs'*NqK\ii\鼹I_$k`1CaXtIIIs1S+\y /?;M&^8{۹wn1.Nf7Yz@'ƪGj%mhl(!3wLT5g)'4?$,gYN9gɗ2wt{~`}̔HR>z4f뫓=ٞ)*KsKs\zksM/Efe))!9?( #!ell:ۖS=fgL$F31BLMHf6OJ;fA,cM1{ +#s~m)9:vjJJ49+ef~AQ-k+T;oF[ߩOO\gO}Z~I@  sBߩ>fb~p͟_Ÿ"ݬE ) > IPDKH$sKK7A kn:8#s얛_i6$|Ζzؿskkض 1&kfg%M})}ֹ=m9Kwm-Xqh|FD,QP*m2WQF5τM":}E׫ݩA'ЅuttZR,54}z|%3!jH_bre%39-BK0aI`J[roa3Ļi^$?D]N}# w?VT)=;.O2I$>)J F IY)Edr($/2g5lXEktL"10HcѰطYK*Z`|\stKd)$n=z'"1VCDSrȅ Fkܦ" a"iI:@6` ϫd\M Ef-|{o.Ԓ#XX{- !o0Rєe*2U4 Ŷiqu[moB ͛咽?p:?RO8nؓv9}V+K6ݲ膘Mm1W]Ksq''XF4mt3w=tYY1[6@jLQ=+,2JR1'h }>%4L~c̍AaXw V*4d[yc?*7z_k07`ɝgb\1ט+JpM7|QE Mzӻ#.}֧?deеOo}Gӓ?=[vE ק[C3Noqx»-[U/_zנ.K B¥2>2̗0zI"9K%抯``|XFzkn3KKb-ϊ!zJ"IH5x\Zߡ:8L~zpN70CōBGAv}{x ]7a#*N@ct*.@K5mSq-_:h5ߠz7DzHţ`^Ή(?&Ac /%!"zt0$Z(u#. >JyMG)WqQ'*>J]U*>J8(u@Gօ*>zT}dGٟTq#_GfsQLYx41W43]fx5 sUhǹ. 2XKBtrЃR$~ J8=]8?j?\)B2 HOo yP\bgtat !>k5Df,ې*d#ȣ [-B)} 0 `){M=zqԏ~rfOYfNRԣ&[Oq2{niCIB\"f ی& J>_'W mAz6OULZdRGL^J*RuLQ;H'J;!{xKA&*.I[ynEB*J$xdXἦƋW]ec3LNWT/q=W2¤pyQޫzP SGs8R{نڝSZ ~!"^5RхpM[ŇWf5~cܢ]|>[5oVTMVB;]j]}u&>N[^ (]8&sjpB6כ\M^$u۬||;Ucď%ћUk++LfyWǽizST4ݾb;n. RNׄݼ5/D/UyۦŦ }?n~oؖx l MLveԬ즠eSU|"5[G'#Mƭw{xdnʃ!Ŋ!>\{y u9.[?B8Vgi>˞ߟc_y0+{)K*|˛'U{B(-&w+-;Oj_wJjo:9d H>ofsWM6IZ `HmG !5JOHrJ Ҋ<&]Ay&VB}Oo.Yx|=lM;GZoť.O0y}i u@3-(n&[`P zЂh$_&}=b/Ry|8RgŗNjj`  >4y/*({`ЏB\)ԥ=4 ur3tml6Q EBrO'#`-,ee˪*X..[VU|MTduMM}dlD[E Bܢb\LAifzY>R(_{:"1Oji +F834M,dt,!s;qR.BI'k0z[C45EYq0'L11Ei1BΓuR3G ^&5Њ=<\O[Feg\KBu}L!dMA%Hyyw[XG.%%XNrW{;I<(_=Bd |*+$iv,V l@؎AXa+A3|-$UV^U7\ޤzBV+R+\*bTp2IHc^, = !@d: vD 9$H#4āRF=1iXV D8p4}|ޣ!ջPa'A:.fdxLjXbwPGJJ sĕ",INSQۑfGH.sF \ V" "h{ `NZy Ax-FXF(=:\lL_A2k^L_o/yX/ۡ2 瘱6c=qHDرG@Xa;3GqȳpDH9xHv cLbİ)tRs=dccck3bpmD+6 İ4sd&"UZi4"`|&2~0횝c:@#CCdH&CגP9 Ȑ !7z,@S iRw :B$CA2$CYd( I=J3FW{*پE(cZ4:A,"DxˍDL853T(RN| ^0zaeC"Zoe,"FrqN#P">W^Z|_ɠfe^*lt"=NK 82JLaPiw0qZol}|2|E:R Nv1.}:;̵ 1l>gOlяm'd&<Kzy9J: q'ppgƶľde ܱ+Kqj[5+lWb6g}.Rv3uזNwnQB7_We4]>NoF^Ջz}hsE*JfJJ.pPG,&uC^kg8Fqac1 A]Wݨ.:\ V~q7!w4ao> endobj 18 0 obj <> stream x]j >aqB`ٲCд`t 1}uܶЃgᛱtѡxV訍KLڐSeExY8RDm-ΌiHsKݝ/^fK~u f02ҶT< ,f(PTL}s@9e" ^ HXK%`Կ\ɲd𱴌Uu#će T%>fƚ:3O|B,=jd1gt*Wظh7M .|_ endstream endobj 19 0 obj <> endobj 20 0 obj <> endobj 21 0 obj <> endobj 1 0 obj <>/Contents 2 0 R>> endobj 4 0 obj <> endobj 22 0 obj <> endobj 23 0 obj < /Creator /Producer /CreationDate(D:20110919112357-07'00')>> endobj xref 0 24 0000000000 65535 f 0000048860 00000 n 0000000019 00000 n 0000001992 00000 n 0000049003 00000 n 0000002013 00000 n 0000021369 00000 n 0000021391 00000 n 0000021590 00000 n 0000022028 00000 n 0000022322 00000 n 0000037600 00000 n 0000037623 00000 n 0000037829 00000 n 0000038194 00000 n 0000038428 00000 n 0000048006 00000 n 0000048028 00000 n 0000048219 00000 n 0000048558 00000 n 0000048753 00000 n 0000048805 00000 n 0000049102 00000 n 0000049187 00000 n trailer < <46F4C118FD5695FACD59C6662AF33DF1> ] /DocChecksum /EB3DB5A503E55D6801D44D88907DE7A5 >> startxref 49444 %%EOF GenomicAlignments/vignettes/summarizeOverlaps.Rnw0000644000175100017510000003255612607264575023456 0ustar00biocbuildbiocbuild%\VignetteIndexEntry{Counting reads with summarizeOverlaps} %\VignetteDepends{} %\VignetteKeywords{sequence, sequencing, alignments} %\VignettePackage{GenomicAlignments} \documentclass{article} <>= BiocStyle::latex() @ \title{Counting reads with \Rfunction{summarizeOverlaps}} \author{Valerie Obenchain} \date{Edited: May 2014; Compiled: \today} \begin{document} \maketitle \tableofcontents <>= options(width=72) options("showHeadLines" = 3) options("showTailLines" = 3) @ \section{Introduction} This vignette illustrates how reads mapped to a genome can be counted with \Rfunction{summarizeOverlaps}. Different "modes" of counting are provided to resolve reads that overlap multiple features. The built-in count modes are fashioned after the "Union", "IntersectionStrict", and "IntersectionNotEmpty" methods found in the HTSeq package by Simon Anders (see references). \section{A First Example} In this example reads are counted from a list of BAM files and returned in a \Robject{matrix} for use in further analysis such as those offered in \Biocpkg{DESeq} and \Biocpkg{edgeR}. <>= library(GenomicAlignments) library(DESeq) library(edgeR) fls <- list.files(system.file("extdata", package="GenomicAlignments"), recursive=TRUE, pattern="*bam$", full=TRUE) features <- GRanges( seqnames = c(rep("chr2L", 4), rep("chr2R", 5), rep("chr3L", 2)), ranges = IRanges(c(1000, 3000, 4000, 7000, 2000, 3000, 3600, 4000, 7500, 5000, 5400), width=c(rep(500, 3), 600, 900, 500, 300, 900, 300, 500, 500)), "-", group_id=c(rep("A", 4), rep("B", 5), rep("C", 2))) olap <- summarizeOverlaps(features, fls) deseq <- newCountDataSet(assay(olap), rownames(colData(olap))) edger <- DGEList(assay(olap), group=rownames(colData(olap))) @ %% By default, the \Rfunction{summarizeOverlaps} function iterates through files in `chunks' and with files processed in parallel. For finer-grain control over memory consumption, use the \Rfunction{BamFileList} function and specify the \Rcode{yieldSize} argument (e.g., \Rcode{yieldSize=1000000}) to determine the size of each `chunk' (smaller chunks consume less memory, but are a little less efficient to process). For controlling the number of processors in use, use \Rfunction{BiocParallel::register} to use an appropriate back-end, e.g., in linux or Mac to process on 6 cores of a single machine use \Rcode{register(MulticoreParam(workers=6))}; see the \Biocpkg{BiocParallel} vignette for further details. \section{Counting Modes} The modes of "Union", "IntersectionStrict" and "IntersectionNotEmpty" provide different approaches to resolving reads that overlap multiple features. Figure~\ref{fig-summarizeOverlaps-modes} illustrates how both simple and gapped reads are handled by the modes. Note that a read is counted a maximum of once; there is no double counting. For additional detail on the counting modes see the \Rfunction{summarizeOverlaps} man page. \begin{figure}[!h] \begin{center} \includegraphics{summarizeOverlaps-modes.pdf} \caption{Counting Modes} \label{fig-summarizeOverlaps-modes} \end{center} \end{figure} \newpage \section{Counting Features} Features can be exons, transcripts, genes or any region of interest. The number of ranges that define a single feature is specified in the \Rcode{features} argument. When annotation regions of interest are defined by a single range a \Rclass{GRanges} should be used as the \Rcode{features} argument. With a \Rclass{GRanges} it is assumed that each row (i.e., each range) represents a distinct feature. If \Rcode{features} was a \Rclass{GRanges} of exons, the result would be counts per exon. When the region of interest is defined by one or more ranges the \Rcode{features} argument should be a \Rclass{GRangesList}. In practice this could be a list of exons by gene or transcripts by gene or other similar relationships. The count result will be the same length as the \Rclass{GRangesList}. For a list of exons by genes, the result would be counts per gene. The combination of defining the features as either\Rclass{GRanges} or \Rclass{GRangesList} and choosing a counting mode controls how \Rfunction{summarizeOverlaps} assigns hits. Regardless of the mode chosen, each read is assigned to at most a single feature. These options are intended to provide flexibility in defining different biological problems. This next example demonstrates how the same read can be counted differently depending on how the \Rcode{features} argument is specified. We use a single read that overlaps two ranges, gr1 and gr2. <>= rd <- GAlignments("a", seqnames = Rle("chr1"), pos = as.integer(100), cigar = "300M", strand = strand("+")) gr1 <- GRanges("chr1", IRanges(start=50, width=150), strand="+") gr2 <- GRanges("chr1", IRanges(start=350, width=150), strand="+") @ \noindent When provided as a \Rclass{GRanges} both gr1 and gr2 are considered distinct features. In this case none of the modes count the read as a hit. Mode \Rcode{Union} discards the read becasue more than 1 feature is overlapped. \Rcode{IntersectionStrict} requires the read to fall completely within a feature which is not the case for either gr1 or gr2. \Rcode{IntersetctionNotEmpty} requires the read to overlap a single unique disjoint region of the \Rcode{features}. In this case gr1 and gr2 do not overlap so each range is considered a unique disjoint region. However, the read overlaps both gr1 and gr2 so a decision cannot be made and the read is discarded. <>= gr <- c(gr1, gr2) data.frame(union = assay(summarizeOverlaps(gr, rd)), intStrict = assay(summarizeOverlaps(gr, rd, mode="IntersectionStrict")), intNotEmpty = assay(summarizeOverlaps(gr, rd, mode="IntersectionNotEmpty"))) @ \noindent Next we count with \Rcode{features} as a \Rclass{GRangesList}; this is list of length 1 with 2 elements. Modes \Rcode{Union} and \Rcode{IntersectionNotEmpty} both count the read for the single feature. <>= grl <- GRangesList(c(gr1, gr2)) data.frame(union = assay(summarizeOverlaps(grl, rd)), intStrict = assay(summarizeOverlaps(grl, rd, mode="IntersectionStrict")), intNotEmpty = assay(summarizeOverlaps(grl, rd, mode="IntersectionNotEmpty"))) @ In this more complicated example we have 7 reads, 5 are simple and 2 have gaps in the CIGAR. There are 12 ranges that will serve as the \Robject{features}. <>= group_id <- c("A", "B", "C", "C", "D", "D", "E", "F", "G", "G", "H", "H") features <- GRanges( seqnames = Rle(c("chr1", "chr2", "chr1", "chr1", "chr2", "chr2", "chr1", "chr1", "chr2", "chr2", "chr1", "chr1")), strand = strand(rep("+", length(group_id))), ranges = IRanges( start=c(1000, 2000, 3000, 3600, 7000, 7500, 4000, 4000, 3000, 3350, 5000, 5400), width=c(500, 900, 500, 300, 600, 300, 500, 900, 150, 200, 500, 500)), DataFrame(group_id) ) reads <- GAlignments( names = c("a","b","c","d","e","f","g"), seqnames = Rle(c(rep(c("chr1", "chr2"), 3), "chr1")), pos = as.integer(c(1400, 2700, 3400, 7100, 4000, 3100, 5200)), cigar = c("500M", "100M", "300M", "500M", "300M", "50M200N50M", "50M150N50M"), strand = strand(rep.int("+", 7L))) @ \noindent Using a \Rclass{GRanges} as the \Rcode{features} all 12 ranges are considered to be different features and counts are produced for each row, <>= data.frame(union = assay(summarizeOverlaps(features, reads)), intStrict = assay(summarizeOverlaps(features, reads, mode="IntersectionStrict")), intNotEmpty = assay(summarizeOverlaps(features, reads, mode="IntersectionNotEmpty"))) @ \noindent When the data are split by group to create a \Rclass{GRangesList} the highest list-levels are treated as different features and the multiple list elements are considered part of the same features. Counts are returned for each group. <>= lst <- split(features, mcols(features)[["group_id"]]) length(lst) @ <>= data.frame(union = assay(summarizeOverlaps(lst, reads)), intStrict = assay(summarizeOverlaps(lst, reads, mode="IntersectionStrict")), intNotEmpty = assay(summarizeOverlaps(lst, reads, mode="IntersectionNotEmpty"))) @ If desired, users can supply their own counting function as the \Rcode{mode} argument and take advantage of the infrastructure for counting over multiple BAM files and parsing the results into a \Rclass{RangedSummarizedExperiment} object. See \Rcode{?'BamViews-class'} or \Rcode{?'BamFile-class'} in the \Biocpkg{Rsamtools} package. \section{\Rcode{pasilla} Data} In this excercise we count the \Biocpkg{pasilla} data by gene and by transcript then create a \Rclass{CountDataSet}. This object can be used in differential expression methods offered in the \Biocpkg{DESeq} package. \subsection{source files} Files are available through NCBI Gene Expression Omnibus (GEO), accession number GSE18508. \url{http://www.ncbi.nlm.nih.gov/projects/geo/query/acc.cgi?acc=GSE18508}. SAM files can be converted to BAM with the \Rfunction{asBam} function in the \Biocpkg{Rsamtools} package. Of the seven files available, 3 are single-reads and 4 are paired-end. Smaller versions of untreated1 (single-end) and untreated2 (paired-end) have been made available in the \Biocpkg{pasillaBamSubset} package. This subset includes chromosome 4 only. \Rfunction{summarizeOverlaps} is capable of counting paired-end reads in both a \Rcode{BamFile}-method (set argument \Rcode{singleEnd=TRUE}) or a \Rcode{GAlignmentPairs}-method. For this example, we use the 3 single-end read files, \begin{itemize} \item treated1.bam \item untreated1.bam \item untreated2.bam \end{itemize} Annotations are retrieved as a GTF file from the ENSEMBL web site. We download the file our local disk, then use \Biocpkg{Rtracklayer}'s \Rfunction{import} function to parse the file to a \Rclass{GRanges} instance. <>= library(rtracklayer) fl <- paste0("ftp://ftp.ensembl.org/pub/release-62/", "gtf/drosophila_melanogaster/", "Drosophila_melanogaster.BDGP5.25.62.gtf.gz") gffFile <- file.path(tempdir(), basename(fl)) download.file(fl, gffFile) gff0 <- import(gffFile) @ Subset on the protein-coding, exon regions of chromosome 4 and split by gene id. <>= idx <- mcols(gff0)$source == "protein_coding" & mcols(gff0)$type == "exon" & seqnames(gff0) == "4" gff <- gff0[idx] ## adjust seqnames to match Bam files seqlevels(gff) <- paste("chr", seqlevels(gff), sep="") chr4genes <- split(gff, mcols(gff)$gene_id) @ \subsection{counting} The \Rcode{param} argument can be used to subset the reads in the bam file on characteristics such as position, unmapped or paired-end reads. Quality scores or the "NH" tag, which identifies reads with multiple mappings, can be included as metadata columns for further subsetting. See \Rcode{?ScanBamParam} for details about specifying the \Rcode{param} argument. <>= param <- ScanBamParam( what='qual', which=GRanges("chr4", IRanges(1, 1e6)), flag=scanBamFlag(isUnmappedQuery=FALSE, isPaired=NA), tag="NH") @ We use \Rfunction{summarizeOverlaps} to count with the default mode of "Union". If a \Rcode{param} argument is not included all reads from the BAM file are counted. <>= fls <- c("treated1.bam", "untreated1.bam", "untreated2.bam") path <- "pathToBAMFiles" bamlst <- BamFileList(fls) genehits <- summarizeOverlaps(chr4genes, bamlst, mode="Union") @ \noindent A \Rcode{CountDataSet} is constructed from the counts and experiment data in \Rclass{pasilla}. <>= expdata = MIAME( name="pasilla knockdown", lab="Genetics and Developmental Biology, University of Connecticut Health Center", contact="Dr. Brenton Graveley", title="modENCODE Drosophila pasilla RNA Binding Protein RNAi knockdown RNA-Seq Studies", pubMedIds="20921232", url="http://www.ncbi.nlm.nih.gov/projects/geo/query/acc.cgi?acc=GSE18508", abstract="RNA-seq of 3 biological replicates of from the Drosophila melanogaster S2-DRSC cells that have been RNAi depleted of mRNAs encoding pasilla, a mRNA binding protein and 4 biological replicates of the the untreated cell line.") design <- data.frame( condition=c("treated", "untreated", "untreated"), replicate=c(1,1,2), type=rep("single-read", 3), countfiles=path(colData(genehits)[,1]), stringsAsFactors=TRUE) geneCDS <- newCountDataSet( countData=assay(genehits), conditions=design) experimentData(geneCDS) <- expdata sampleNames(geneCDS) = colnames(genehits) @ If the primary interest is to count by transcript instead of by gene, the annotation file can be split on transcript id. <>= chr4tx <- split(gff, mcols(gff)$transcript_id) txhits <- summarizeOverlaps(chr4tx, bamlst) txCDS <- newCountDataSet(assay(txhits), design) experimentData(txCDS) <- expdata @ \section{References} \url{http://www-huber.embl.de/users/anders/HTSeq/doc/overview.html} \noindent\url{http://www-huber.embl.de/users/anders/HTSeq/doc/count.html} \end{document}

HH"4x).kuַ7AKӴqo 3bȁ |Ӣ?S~Dq3Q7_7Q|w Б 6"/xXxA.9,[D'ɜyAϚtT0h_tȝc*h}JO.$I"F_c( X*.!A< m!  mN H .R kN6̦7Xi8W+|YaPTI&(6_$ T2*~ |t|u>,57ҊGKϖ,=9:.Ofa>134Wr60!Qw},'6KR"Xuc8֍y&zlxw'|6մoO9Z~;![,=ahέ)P*n $>,l9[L_3=HI$f*'7ՓJ EWzBLV+~'yb}p] հeSG`X}ZWR٧}\@`ӄ$b"&qCFHh=ybyNGm\:q&13@&DqV/~@i6PE{סHȏQ3& {0:#̉Hgwu4VT5Hрj8ʹeLVO5 m]l^WdEr瑰uds,-AN Z`V芘/%bEsj@l6cSχkImyh0h0m]J"YBkZc2=BPq^.zMr(I['[o=5'(( QsQ=pՓSr?>)N&DYע` Pעx֤vɶU'wK\R9 )ЀGw<M,Ŕ1s) 1cW^RHW|6_8lp,,Y<[vc8AƷBUrI4o=Ro{!wQJ^LIꭜ)fYMu?1 rXJ{KūhVŮ:Pb:+4CjʷA'!(F?uFe^s/%Cߏ"*@ ҁ8&*ZI\SfBޘQ :8 ]7W5O H1L: 9)Ada C%QDy5{SCarZDEdPX֎xc(D}"8l]WCmz*/N盫aB -nRNRA|@j$se~W'3v/6RΔ\\.ZWQq1Լi $PdyC߯;(HcQ7da+>(GNMro@+&F!&!"E@a4P$*J@QPHT~hk`XA"!+L4Cipܺ6EܛQQa1 laJ,%}nȥ&9B ,"e_FoN ma"y [0sM 5pBty3dQ&o+`aBf]|lO@ O؈,Ub^{Wt)|,Cձd?TAX݂tZO[EES-Idh_$qbž'(5{̹C _w㋤GPDAܸ"aYX,}e]ٮC`T$8 ߘH݂""rFȐC!k\B%,AL${j qZ`]0R;`u\/+A9]]w"r(Ҹc@aZ.Lk(x}ƛh0b8nD\iM֞-өb[dN|\'`SēՆ1[޹ =`'J-QM>t_Ị" '֪:2apAD&AY煃wGۀP`@vBQ6(6 ܦFtA$6?Jޱ8@ >֋Yq 2У(D 3:Ko .z3kY`(Lr`pL ,_ǾF,0!h-E@&:nuR&ŢRs _I*Yxzo񸿸TEqWֽ_&; 8k*Z:̰*Kxap٤[%\.ExF^)|>nū^ f$E %}ugM˱cglR*"?5x( +0ҳf~Mn@*A(kx91[:](]Fig̽GOFj)繐Wx]gEeYaٳ;3i Qx ;w/WJwIqJ qcQΆpX ꏯ8&0 y` m^=󼌦뎺1şg!:}²]#@<(m- ()+QtQIopTZ'!9#gamOaؽaDOJmoxaYՋkQnATCQ:,0J(ޕ|<տaH;p\;HYa6tEWKUR/'Qb;>1 ׍5r#+td%1|'n8@QTR78}:RzLc:lui0ċĺ7HBOA`UBO<UOI0k[^ԡG by8dʂ]c G|\* =0>Nx oK^y"p7_+5QMw rJuۤdfQSOUIX8<d}*YĴ⥢/hR+IQmvݏ_b.=(ߔʁܦa(K KPЋ'ד>P^(b(#҅K-׌aW_G=Zy%59hVKz3r49f/tx1¿ |b{% XԶ-efm&Q* p j#1BHDqIeAxFFYΕ؎hz襈( $>2@5d'/2PHd0?/v >ka~ae 5Mt0sBH]=),HAѽ$l`#2⪗{"?|+[zs)ER c>E,.I#FU~N?+4XuMBf0C{W~ZFG &bU]嫽)(`G! ׌F~%~ u*v"6wݶYaP )ZEgqx(P f \YERX1nHN<̒,PbfaA*v[4Cx^| ($]f]ڠ$(w@{U$i -3 fdxS(.?8 kA9 ?8W_0ԏ .f$WԱeuJb4P*\!NIi 240 ?k[AQP%Ԭz(C4Y}Sԙ^}z-(OAMJ]X9!!}X BbJN~ -2 8Ѥ]!JQxcuȂNʂ2I|DY)2Y FJ7IKw779*  f~*dfAlrxBlU(MODFy23-Fq+ŠBHsMngqX 0ro^qfɤxxcJ õaD8<9a n#D|C U ?XI(*E.|ta%۽2-x?@=ݏ}LoB,08S@9{H޸Dif\R鏿QK¼pf Qot0go$^'a(=9Dd ^6}$0)%L 8.qSY҇SN Cpu%s9+u,C쩭k1d[Hdy{b48OrO[([1]-(C?ԫY*N G8!tRDjq~mͪt){ų2E;kq`3 ?r%L kYp, 7lQv;_*+߄ShV'ج3u /"5DBksjYe"l`1_xS)V]90WQa鰕:Jﳅ Tl[( ȣ&ldڮ~ł8Ho$+c{,j"W'Ii5 '}( Ca3!o E]8krqh,Q, 5J A 4 2s4BFbÑF>+(+y *I"ʫr 6S0L%S?gtEGZSmߑP&i)@4 Ӵ.>iP1QoM2+A=cǞ ɱ񍃕hN L.69F,( ݥ4~E8 d_.ң2?|-=ΦL4F#^fG8'jc5B౦c[@u|W *"ē9Zh^]Y3&~qS4{P`ϓ@Lj+E+JEzՓ"8. ,,Y.xH Ƃ83,|ʛ ò uRς>ү%.@$*Qѱl"&'F)rqrp;E!>%o50ļ4 rX&b~N) (m{RNgha0ܧ|zuBi=mT'5GKb44 6ݝrF 7gl40\}?#qB1SȾu/X輎ea?S|C"4(3t r)fFMӫ6oEqyMr~xCo:=6?kO4!CG۬KbXֆ<b#bb}qwQ]jw EYrqLhSȀ<,x:«l@߮<@%K/&DKyǟ1 ?(1Cql<ֻz[\7~x;5,(^]| v"n׻nZ7wjTyf'o༩yZ 4ORD?"u+,Pt6ivwoC'6ދE<2 \V7ݬ݇]OMuxk-:DXW~ na#J hnw^/nux\״~ذDD'/>Y!RW4fy[ÙoAq1{-hLY3ӶGe]z󉊄G}y(F.ymz^mn_ܙaž j3 ΈǭZI?<j$y?=6z_cZ"R!wO ōqY7D/.YE10u5Zѿ@"W8,+>f7 1; [㋒['2>Zå_輦ؤf]k_? >b޷  vs7b}{BGk~H@mVb+FQ1m4cJ 9f2/g Qւ9U]n˧ xn;i+˯X5F(0:f6.mp4ғh2|F@KOR [{ t.2Xe7 mX{i"<3wzo!]:<b b\.bٽ{? Dvv˻Xα`2O ĢN[C|1=>{8y&.0 [`z۹|QkW5V2I"/:Ɨ;կ7ހvHG~fmL^v8w!/Xi (ʳb\ .\wrﮍ#.~hl`:4fY&4.Ow+]x˴tƣ>W}$|t/ mMi>wא1z/杩9oU5Dv];E]HЯ]i}}twא`2Qb^Xr'vΟrޮv׻f<$Va?~ _rd>&eats cXlˎE,%?Ye樑<|eO g^>__9SoS˹^˃eS(l\}5*=$oMcrǛr̀-8bD[!NkꊨD <nt u\7..OF2B \`qT#kXO~ÇqkqAߜ"Sݢ Ȼx#>Y }\l?n!]>46tF93kvۘ *~g/^AU^~'lGI!=b݋Lq~.iqy].w'dC:~r7: #6 Q_x:E}zy|o݅{}=X_/b|?>Aǔ[` .?3+fV,U!Ǹ?]Wxsټcc}R-W&,fA֑Vf+@p :oivL@ 4xl8fuJDOhQl)0),rvT]xܢ~q')ҹrq<Qcd.5踻U,j׫D6҆ ":fc rB[Z}/d:R˱C n cKM&s}jO//ŕjGUᆈ&$t#:d#` ɓuS9m+龯*ȕF|O>=q|T>"w:ֲ5o549, hjnJddѩjqѕ/jQas?+2]#{gg6#677zyg5 {}sn;( <[FcFx1X >um>bsɜŔѹ6܇>)#ֱɈcO,퀄SjӁ{2 OF !&VQ$4:}T6bd4/&kzY/:sűS|.׻nyq$:6ŏ)1Wz$Y[ƽYc5_AY^,bgQWKȿ{==ǬYV[H1toyCta8mckB!BŽ8QGza"ZJF/@:̠CzKW$rR$~!t2&$M,M4hfV*SyJng)D$&㭖W.4AL J0(VR(@ Bu2+۬&넭~CzmIFRN{ڔR-&N]av 4dDఉ6%:(#v5şL ?*͇W뼤஥r]^(jH@ꍾ?èRK-| *L4%jkD~[x=Z4|n"&TA$TnhS}J ]+,ZF԰aD Dk弗+Zc&2t'2 Ѭ (Ɋ;tZ bfȬs#xԸARO4pb2;~8jO)Om +r+wp/N 6LXŠ&Vԭ3Zk!b|~)jǭYWe{V [c&f&~7TeEG%yI͔^hp Y) \N"Ԗ@Pc,.$ I-,㠈C>Rc>%h$rbJ܀=SDA1{-h4벟H[?<*OTBLHBś(czIA5->P~@IbLVs3x+l!GaxSbẸ;nÔE@$f}) ]VhQ01QWZc(.Z]|&TgIa-22@mc:U75dC7|qbIMc@8#Q[!Ap6)7%&KrOJG8IVz!􀰾 1d*MGtdF֧ͣg Z꫌[G WH2yQ[F)vhFk(T ()"1&KaϚ8x qB>A bUO*xhlG秢b9mͬsr@%΋/N٨'; /eϰQ)wŒ1ڑ9@54$dC܈O͞]r0GhQImuȹ%Ɋ;-Daqu)tb?jԜi|=IٶqزK8OL4nLM{RQ)ÑƥЏPC48gG5twaqʘl Kj1m:ټ~FTCFXq#>CPͻdJqq1ݵkFϫYI@9EaGJdb2uWm%8+B 0M=q-æ&?5iHrp %8X-Mv^C~\lCHŬc0B*t A5EPҌd[yrם3/ 3UmlwQ ܊S*ZLafav6ū|zM!n9/ԴN UpbWq {^/WOv&Jmg@D҂'84И* \8Y9#'7S=(&ZygJ|?}eo+LnrBTʅ~W8uk/k=+qw_guf[ݽ > Ag+PnK/z] NeHH (/FeV1aQSWԥRIy8_$D?:Q1өLHo@(R+Q" ͬrN˃csRXEhXeUF쎀}ٍ2}+2'E*<ײ\]esJ:|ċ`O#k}]Xw\9n#jD~h%d4 `Ag,eWndDW {t<ċ#m*#|h Aq{!L>,F5xS_C_?>џCqxJ1S {f[{=TV%E Ѳ˪ӀemZ0Ř OtLH(!oC;R3_l˝+pbkkG'J(!#*;"^^JDEЍh.z?U<"llp.1-{1 "lL?uc/\.0)#mvjj2KN fN((4da4$Bd3ivp\"0"/S.~̢ <`GD{3 jZt幆̰L-#+!&#a^{A(H[LlT#NQp1Sw{Ieq5J NdK$(c4h<QFmAMs_p&'[6Ve2zh Pg>þSJ^`KčY[KqfS['UDìNr(|5&CI"ճv>d"żӥ~ar0:CBx4"BMH-jl8LjYA F4my3IY7~fNeQe߶$"p&Ɩk՞kv>~&2kX'04Snj6׎$ =F((@IdD; ž,U5'wA@U򐧦p-1ub1G:wᏆl| r~(NAwd8k, թ,$*P|4P)"jQbA/;>Q֔,5a愚p캼ݦ5'\F;$ɕZó"S]]G6m_L(A*G_%4$}`c;ZQ)ed6N//lbбaSv=tN buu6xW2O)4x'k-?OsOM~aKFq (8NO.zag%~9#u-fw0(7i: x6\<~Q@De"pތ!#s,s"ՃQ~Ikc9 Y{"Qcx5}x|b;3qIzRxנx_՘Zͧ*~GI]t]Dn Lrp~VhTD 6^U?2pQ mb8Kp&qրU t3x[bFTYסQ::(s^U+M:Y0[,m!`\Cӈr?Sš,cİ/a1@C3:xp%-q}>NHCO=mTj>2IǞzQjg <5?+(PB>s~U*jy.Ñd PCoV5/9Y$O4Thz*:8V*{7xBO ̄G9i8&? B֫v a0-.Bxepvt&zed^r*4?}>QXL8L<4#˒="/X$wZ1! IpÈ HYZw"8n(e:&=6r~9}=T+0$)}]|{_ D'}4qCz Syi9Mg8ᕡSڧd:p"X^ʴvAei7eԘH~fG'/&)W-ZRQ0M~j׳"JsO5ۦOl[QƱ26M<>h8c{d`F&/0 ӹ" T4D"R: FtQEf9F 8m۱JsD@\ ik}d~*]65 )4)(or_E^ISFe+ LDn{~$\iFTO~Fw뤇 O]S뇲{5?^OkO=?ɕDV\]G;(ln^kl7O2pLBJAo "Uy&Lw$D Ѻ+O wdWzt&O :穬 (?lxFU1|D3-{#{ĦOwy&ʡ [nco2"GՐ°yus~0xE,!ڔ+ģ]jnfOY& /Ă% SdHv'VgtԝGk݆aFfqx\FBh]E}D/  Pt$cOM5'Pjg˚e(LqT;Lj`a=_9g7}raG[׊Oйw$DY*edS;( !OQ+cLqC6H:wڎ f2~lOKCW#_<3)G@^O e0/HNSN4:(rL z(83aZQ֌=4{[;WkQyep-'WF{$/"#G=4}(=Sᾏ9=%IN&W[V̐7Z߉̎ܪ023_GZ-3HkQ"QaBJ>(#/T[6:q̒Ԝ$JHz=QkK! q\ؗZך&=/Z$6' Nr dQza]45:3 ;VͫDc|~Q7DiɊ\ou#Q'igd gAˉxeėݚQeaEf5‡YEl "UE2y}`ϗQ v/158{Q^y/3&oo( bϓF"{1,?-;)j (SF:aOF ,QR {2,b:e}[k,a@I22>OCNHi,6oheD>NVtZWjg'S FĶ+Cű۴F ,AZHkPԈp9.b4h1Л;&AϢ[l|(X>oBa1z*$tAYQJ_O Lmʎ^oDgGg$Nwpigae.{1 âT=Lz1m%ⲃ2PL&bE\UЋwDtl{CQ)&6dik<(cHZ#c6Q XH͟{Em&8 yHwƏ>'!R\͒k?(!zq /ӣq+C/('EWjFt:w $ /?*=yVnQPi~UFDxnc 8˹Dq2!I ՏH}z{BDE!t#u_" t8Si?dy_" EQ_L<=zvJ<fikmᆚ<"?Xe?m?=f3HIA)Nn(Fi &,0&xu[g^!c"2-Q%0<,IPDyZ9 A]WwmEuE-o -z',DŨ6"IAɈ? +BC/Ku "x\ܮ:z $޶nv(v)?(/L/ԐMZL7ȡ#a%,Zȥw9 .2j.X_\~/|cGϞ}>/컋 Q&I-D_>H"KӴ6C}>eAG(HYH&oq}82ʲ̛LD0VhJgj~#P*-;=z' Tl|L(>B>:&~]?k;}uViтZNhp1&Zh@Te1/sJyHx@{BiiTlʙE?2*gH,1lF!QJɧ)5DO'gͪgh3?GZH(乆f HŸI7$NCؔ0#_냇$ҢHҰ:6(dk$g-&ϓJjE|!cUԅ0q!dˉ <{^ 8_@Qm (E gKl{y faTY54Γ{f4|G^`CG2H11.,J\EQ%ԧD7e_Y0t)KoS01p<,H2DȊvBTx VFa /zHg52bUeTE"VF7z"x<Wmf+[m!QSMz<̢>GRFeMj\5ʜ )u؏q%H<MY$hEhߏCu*/"ϲ2+("XEo>9c N 9n!ZDme[烏7VO/&&ϻͯoA G ꈾ= "MVD +x#}d 5T̺Ӓ)f,풝#OP@/fIW!CX뇔S؈YkEb ,);j3VUCJ!SsVj5521 kVFӰ.< l͆'T5IqBʪ}G!2URyU~WU(> uǐT&g>p|˃U"DT:?vcAnπ`\`h>>DY!Һ'u/ MI ;>?]Fj Y(SHa"U (/&oN#R6I%?r,OTۻ7LjBDAY2L{$h@&Hg: [P,_vIM56E̪4Ijͦx^(x]nr).zz-cJyia|3iQKI< a(J癿rcȊ7,'ںW @L&@}Ry!Dd~0|=uE$*몬À'la 3c #!!r"Q@TTّUe,]TVMT2UZc" YʣoL"/piOw]ŗ׋˔++:|Y.Ýa0~w3kL~4!lTo1oDʒ-;@TUmY(1!)cZhh ˢkZ4"o.zO۟}瀤u9})"m.c8qe<J`>?YG. ږ!zԼ6v<__ z#IBQT=f]JtyW="iD,;/ 6gY:Sj5FEmL{XD_:DV嵎uG?򮢭f6Z2:OAX:<&/+eAv3 Z(O;KT9qYN'`t)Q{;HD+ok4A26ivŅ4Z`ljoy(Q> p:|!5lCڞF'q,O)zB8cX[/<y"i m^Zz(^ՉgO.ʪ<\()Vˬ46yWa~GW! joR_/X-'Z r~'?$b~Rl:cZOeRy=AX/Mح[Ȯ@3.Ã(t|BT5i 7 mU{}]Q<8]{#&=ŷ?gaQVWMS)2LDxWI&EQ6EנGVC=ꥎʬ4#׷//CL/,XQ,+*Qt]eB!'x v nˉDUMfjfl" #ѤYef"a˦!\Nu.ĩH|F>ќ۟@e=4 Ϻb>}eAqoKG4glDϤ~^ !?SL.'ɓIzkSֆڲ6Yo&&Ě֍ik~0;ldx~c!֩:\B AkO 1OȄDƻti7IQOgS ~cXjV)T!ʿ6$Xf, ,1גЁb;_+VyVL%ꭏ$R'Lݶ"aw; LB5smG{!@w8l|ZX$.[+k&4(n\rP%CN]#vH@v;io(%K1%2|EHerNj! {1aJL:eTdE&ʪQ؃)r8ZAQq쮒OiQc +e)Di&,=(=²fm-#IYQv$ةB^͖:ak9lc&#XT"9}L5QZ ZQTwlΔ m(ee*D'@:SMD" ÐmERNe>D;H2F<|QץDX4e%A=K-QԛiNA¹L̍U_R:|6fOdρ<^cR>+0jl2&&}CZӲ&&hC a'"~Ѥ}U_coqυdѣc%|@D?d$k*]Hh@H #\B܇ J+lI]H« 81q9H@2m#vR@͍XL4xf( 5Cc z!w.Fal{QVz4_FnrƧC4wtA/\j$d<m#<ݖ+"+r{L{kgIP9/dTWI5[hd/'*Qv˙DAHvS9xx=Q6uS7[/ r?{ Y=R' p8zj+2'Z7Ina!C#rZAYc&;Ҥ)QNF۶Kkjq41ίtasÕb GB#i.//Ye1gwO\>]f[DcJkkFcn ޣL5zgxBza:̷9H$MBzlvb DY  B[~,]6_+o!EA`r ‘>6le\IQ.D H*[VGjDuJ}pZ,ԡ4@T׵pklOU-=~uY(gu]ԩ)9Rg1傷u@KDTUnNeD^ϲ9$j7j_h@dciM@$&mYFZRY;D!#"¶ <ֺDjDBq@O$?j; Zən*G%*[Ѩ nD^C=EgŻHjvUgO_\{}sww֤͛Z>D]kHT >gcW9h[..w8/j珀LG[ i3% ڋxav,?\NTBk'AX9NuZ6yZzSn^95,}0 uVMw󩋌6xU56Z2qQS7&1aW# mp(r"QyU.n5F>}|rR"(1U˨#WrOם$* ^k3뻻uw{"޼zO֌ں!A& ?ߛj&~Vٮu!lf?-$lEJOwZ|a1$|BkH~GD[ziʢ~L~t6me ҟrƢ{K+ku "01u]D E lf" q'Dhy zSsMub^ubuseK޴jږ+? DsP#bOmy "6Yϻ",>5~! 9>;6gWiޔPRYD"&Gg'Φ~~Vi)dO4y`](!λ# YlZ&yON]KEE<";yyPb"1`>z+dEz4NyD!,Ȥ}AKivZVMWn.D8(~OKd{w9AD9@6AtՆDe!6.;\o3Н6.&ʓREa"bZ~}0 :Tgit&8 86!(^F P4/(:Hsڄ ݽXҦdԇ"< 2"JLd;G.p661qǃ}aHR;#ɤCxE7u ='YF(4]l; 'N*ew^@@@dž ،&%{DtޱQU__h\ڷDlVȟɗ:sGyږ}f1Q^WH)]VY]ڐNO4`:K #R۵-}GCd5X^>ȬF[|˴r&ȧxo<ÖK.u<YS]#y:ég%OV%aWfr{v̕ҟz)sŶ2+;$?u ~ܗ+e<\Y6"?y^c9O+-O_Уq`@l7t\WkX:V#!c׎\\jddO ,}K#kv v?}`)/#\wD"˦LO >8~ʓnvL 5űm;P2欗Q5u2 3Nq DE UL=9BĮ {'#Vʨ,2ONעeؓccٱ.xPk/yzgF\Pm1 #K:-*^O3aG| Aϖד vfȳeO:ڳ}<`W!Wcmt$ŁD${uec-5D"aR9 6Agq"#SY@$&OX5߭b/#X́5semoD.Ё:"pfuިe2x"0"_GZ"i5D<#bX""lˈzn[ie ͩzn?%E|!:>`3v801rX,r^ (yU+,{b@Է'vg{t~)e~ljRUۨ"r9x(#>lj`Mg6ظhDX?_6g'$:޼HxinMmb"@}?1:KNL鱛5 pO-J/$eWKtaoUIVdVZh)V I6#h|0H!$,vR9aD[ ĬL'Ӧ;Go2/~/O'!ʡkhK2XCO_! Nabt#I?ʌJP㶎!L"_%J ʼ1ˊʹD̕`kXg|MH$(΍D'TOkex= BleXGaj3$2kzri%sߒ-y<ǛA6-YV䐨@ cyd!,[ .'*+|j@GCFD8]q 1㻯|s-#ReWNw(MvS_M# G09RFydyet!-Õ _ɨ?5Jm+ݫO~ w7m;:Q1ЧfIw-yGDԖQ*z!oV% "ִc2_ HDjN2Fg$kQF?kww]O|ϿYW] sˈ֡5X̳Eu.W&q@`A!C<0IdeQuf"HuM9pC^hqpPG#rx҄fՆA`UV:!0:~՚>? `߱ .>2BN=Xů-'j2p"& |7.8LB"<-nz"& VPgw(#-'ʛ({2D̅p☫C%tωE#L8J;[EJyuNz֮oXPRůޝe$ӼU! [!{^+/e>+M|bon  mY_^FR!8ԡ*!fCGKj&/ϪE*ѢǺ-bF4AB54_cg(QS} @)UT%L{}I+"sul.$͈!q9m{x3򾦵U|+NQM{hD#e61~D(>9?@7(v!iljuQtv0|gnvM\VB ]DV Q@$6(hJ|R!3vJ7%M̦gJW16XfM޿5!<Eoۉ̬Vk3BtEۖb9,mkb˴^٩@c6lo-i}SEkhͫ[jQe±?>XߚRgyҿXudH~c :Jt(qZKEe۳-W_t˃#! VeW֫e=>:pem|'hmDe7R,H0 25ZH$cxuz!rlDZ1 GE[J*'SPx;gDj}~/gg kkb^CBP݄w5xzp8 1>{gyR7I"K.΃}EKVcx@$ߺ߀з;LkeD:{}6$feA( +2) b D8Wq~ DMSݪO{l @T!>Q> {_jwT/ EGCdOs3 }}^Q".<džWfр]cO/$'Ҧ &jhv0P̀DXeH9@9YB4Ԣ#]r\l?h7[Bpn~e>x}z}}FD<+Ϩ;ԱE1ќr%ƼC0튽|0~meFx1BL}cMQ%I;xTCt,vx\2Sh(m/h$dĎ|e~ntIy; MtE";>Quοs+DEUuetv͕v_Am,T+Ɂ~gM-:_?A4%ND8ˎA]^BCK,&uЧ~;3v6 L2࠻sAC ̟MnF^;AP@D&x ۉ-6ډg鮮g^j:uթS<C_=4?O'yZEٖmQ|.>>=9=={q“O|B[Q,暌z7~'k@YviJcu{DyD_BAGKh֨ף@2J/$M$DE;]kA@ bSj"iڤQOȄߏw`c ЅoH$"ʫ{Mu"S0\oB3z{-k(KN$Q#,T%B0}wO#eI7Ga/yDE]mDN/~2(ck?Ue]D;¹oN)sQD3&z.c=Nhί¹ᜟ^n⣻hg&!t땛n n=ABC]X;̪mCӲϟ=G=^zc }mӻt[fQZD]1סc%Q- oΛZ~h1!ķš2joDJ(RH(kN ;DKk3b(ج}TK˴,*%t+' s n}:AjEY +gԧc~689/scF$K?ˈ"_gxq[nEEeVUʵ 睈.oAckMQӍ1kHcqAB@>ݚp{).eXB@ϵ}5.٥ʣ!\.KfD@/ؤ-^"zD"UCD5#-0(ō6,;BJ0Vz@\JD y ݞC"ZGMYHݹ9.d_Ð;P=X2$Da,y7<]^_iGiZcg$yU5I kcL4URe mZ%Ʒ Ef VR $,n赚DyU͢AB@QҠ$re丮GyH@dF6jZv] : rd ?Ƿ/nJ"iꦯXInPY̰(OL 5V>+AD:oU9f 0H|DtIY"p/' "LqDlP# e_I tȳxr"%JB"Dl Dc"@o/ch5£,I݆@t-="Pl2}ΚJddCP5MdD)XfdR$MZ[(!D6~&{s!Q@<.Zؽd]Y(lbcCѾ")4UlB }kfb"tt)ѿ"X PiaڰfA(=Q)̋VI)"x4-G;2'KN#H`r VIw`B)R! Ӥ G:сlxhƋ5T~Y[-DFB49Ubnƒ1a~Y֐]y6qfOy.]j] F+|`Q)p.`+;F7%\w$D4nu'_MRdu65HeH\JOGyq^]@o4 ;"KDc7n\@+zi@7t 'FZϯ}`5Q$u?"'H+ v%.52` E+M[C9d`ۇ8ig_\'!Ey5JhQ#ۉ}`U\mU}" nIU#-"X=lg \/"UkMdQDlҁj*>Odto!Swy M*)P9pC4BVk˧UdjTvF qa1b^ wzSIRuz*3VO/]steDN z@E[Moe"lx#>:"@PfY_?x|Fǎ 22t\>%£ r|^FcmG{ˡD=c"ѯkaGCw^F*A| oϤD?(-y מ繄e4+MFR3@2?,X_ a,6u֝IMeT'y0 =˘muvHoNw3:()XVSMg>Sh@4|"ʼΆbt{]\/SvΣ.!DM}É G!v<`;DWD Iwc盓-(o6{h~4l[m=QЗUCM4{=QY-]D1G/{R0Y5Grw?''XjQܩS'N{oChSꒉ!<~LE+'9^Ӂ1:1ɰJY/˪8. z`x^^X%ug@S-^.!&dHDzųʦkI3|x'<16@RJ{3^<\i/EрDDOеKw?V1[Gt8y5 yVh R1$l@+uա /* *"ANCX'kI|(i.Fc6$?ʀ yFy-(VU:>M9+ }V]ga2~Kt-4e]=ѵH'Px^}{iƘm(Zn]nھT.,16|6WaZ.a28g#IHKp"'#EӦhzΟP!z< x5Oin^7<#ԃce1F'5֬/t zгp8V y)Oju5m[!HD Oi z] <',\;G }J&m֏-޸⣻HN`EOIn:%K4-dQǁ۠~^ G]w}0!l TƎǰnܱ@C%^D*Y-/DAE}?Ӵ鑠͟siUI:9y<[1Db(<8@ ' ^IY7՝π<*՝uDyYY]>\V@\~.5qkҋ,ϊf{$-%R==#&& j$M]`x 01ɂ m|Zmdm zm B!0DrVDK֔J5o>WL dz"TVڋ6tҶuq$6_2-]x%>aKEVJ+21l|vGhvZ9.-AN_N\2L\m:hg&[: /D$hI (i:O& hw| 1 |X£*+Z~s4y2bw8.;XISlh9JoMC:M^Z$yGe?OD3_ޤǺ`HOo%N7'Cw@t.'g0lz#ꆂRY3QVhG{'}XX\4YO*&{c@4'Cw%o^4JdX <*M[@֊(* # a$az_(1ZBWB ,RD /H[wY6'22)ºU?T@x8)9OvCJմi+>^Dh)D eY!!?2})EVCuUy1w}V+/\EdEFE>ǒIn-':IvIHavKf BڕF`aqm)]Fx%ERD,TJԍE靖gz<|_" .kwv*WE7tc ts?=8{kIMZϐ-]Bl%O^yهNov֦7=GЉ%`1qXOP_fḧ́h0b`aU`HKD>B-/yַR;1lE5V7{ݦy_?m~"He~*zs{JǦƀ9$qil3ѹyT@` gDD9C_/ x'*6)lYH.еN-,iudIxuz\;';5I)$iR2DDSmŽy|5NAJ)T< PX7ّ LOBJ(D)!B\k+gOeeZJ" euDBc,P{ De 탳DDR&6Ki> 9S|ycxcȺ˨JKi#v !y;ZFD˳׫m]9jگO?VO23bSay䯼M<'Ct R$[>`ʴ)Ji?ff/EFJ:mT"#A)a[_5bb*Ҿ[Jy۲(tdfj+9rUd2Ro r+lJ\)#.փJLU+" қ#"`VB043-"#t$`=D\{{~%6OD=>2-sb{E4dp"M֣nӤ%Ep3) 2n/rD{L8!k8IvXSjjƞFSdyV|š[ :C(xbk5ĎpSp.W"äm"Sh%FRTn;fDкq=Qɐg~5zҴ\ee575Deu qh\\|yDeҩyx6CA/>. ͹Yl ʉ .LBře``eDe[@52~1K5:iA?2-&0pCzlvdU*c⸝0tW8w<q5|Dmf$tb@$B<B]f0)7:|mɋ:TQ$Mc.#@^Y0@Dds:/3|2!H4vzWE~pY?::q ty1$cIX|xW!O2Lwyj3fbQdF 7eYSUY KuJyVJ>\7A/1͓CLTrKcZnSg\UJHV^56`m+)R`8=2w5 ޮNuQ& FRmD_;lxP5.#F,G^ö_Y_/١;R"16.ڳc _;b]ĄV=%ͷ\B|?=g BT%LgC]O^61*7g 5DcJFK۴ITJ:ZQQLzaln L_y dE+eD3)Ld$nӘ"oa̚ܕx6{p"v h. +$*2i3Ƒo|Ge3*)~Euv5ހ]yE_ U&ICdCW)uazgq|^u7wc 6'͛f^>6f?GRi;rIҦm # 0X7'\?Mv]JGB XʓЕ$ u/<47 y+;֓u"'䀚nl> H2_|cʒnu$ xjuR\g+z ߚ|^Eko -x4^ܒlЄԔe[-ZOmRJH@o]C))䥜d$sG2#:$D~"\kݼI&+ ڞ^-t(KB!~?W: Z{xJ*y#T$QvQ6^O$I7 D71c:|UdmoK62p=%:}HgFyCTtj b*|]X M3DAE]JJ"~ z˴ˍa`ln&]n4D>Dgr\|LCY # _V.8z۲+I3n #H#/] cYDlO^Uu1HlgXw\B>:Z'1YE]'d>j^{fn;Ik:&}Zv2 |ijɧ8lj_{溛[lct{7&9aQ r1ЗK۷ʉ#Du@,r P90+!ZQǶhL5A6k&IQu] Pf8]xL%A} 6%5@!Zd4<:yKD= 4$$)ƒ/>y^=+z,?hz'4i[dt4̉mX תQ3fF`; ~_'gcF'!c~S'R#t%Kkx{}!Q7:7Y#QOt:+.;F& OWVDK/+-LzmZW_,Z)#Ztʛ *["EVehf@`̃ 1W~&7l5hHBB>ŕD5-(cD.vHgm3Hzi#yaf /8h9 bFj”Hgک$ygX!Yxj8!ϻR5V|l; R5OL|ZA~-mouRgi9)'J0^OB鴨lPzd /5T1N] IW>,Q\i˳Sͻ^i#}WkϗE#{/Dw1z~g~m*蜂oFF  3Lq]-V|joc)*KoH{`,$ !!3.&`!'Rj6M2zʰ'?5z%Q7*=?Kb. (ug Uã4e[t82 7x  o{|ZJmBEoiz%%2+avThO2 8^:t/)%7P!O!P~_.Q^ERjcǽ#֔Qٔ=\o=x 58 !2r/Ȉ>!z%ڲ(JtkGj{q@<BCGenomicAlignments/inst/extdata/sm_untreated1.bam0000644000175100017510000027143712607264575023074 0ustar00biocbuildbiocbuildBCej0`k`cvr]M٭5mMֱh3 s.p`g{AlI{lVA4>B!!P! AB0v~ѵ:ι!kS[ն|47W;sZfBi$4x<8V&DSu2Y/XWhT{>Ua7c !G+K8x?oip?ϭTozp^~>oLBCjP{l]vt7]ԩs>}xjfz?۝LYH!A?ꪴ1؀"L xF BDJPBbd!YkOU۵owV?V?Ek?Eo-|~o-x9Y}5/&xٺ|movwιmv6 mlnbm J0i*pmQQZ0kθBÃH&BTɫS0h'y݂0m!e7M.9. %9*R׌k(SU Bó J 3j?N9$id2M&+G2v[1iRS=px(9DnCkd][PJe#? Kw|L^EX~@@E.Wi@/c*=ltÓhS9)NeIZ-'Ō ?E{(2~4?^4d0^q˲ūdW5@~y O$l^vn>˅rB9'q#2Hy:_-Fsǐmf_m'Sk|PߣYx1[nz/k~׊IР〭A*lFϥl(80$`O I1^/&׌2f50 4d9Ai6̠3x4cȴF Dkvʩ2AL> 28+FLPeY '+BV pjW@aoA*3(b:q1Gh[;?PT =XYCl9zo>+IB5 ( hd=^DcX-ƿИh2]OOLB4M ~Q7'G?pTRBj1'6&+n,]`ksPhӐ,sPuG3zj=-}*]mv7 ̛vwp倃V$7^]f9Z)o=_|30%fL,K"jWܰu GTj)(ѿֺ`},[jKT~ͩiξR}Gts󊱿DjHVLb ?1 29j խ h32~mn|ݞ |#mBpr 'Jy:Lb0cYV> ?_ti j5 Y#ʵ1Wid>O\C ih/08uC+D"f4ףCl}IKmP+&S쯱d`cFe7`t @f`MCen۫{/+ȕ,: 4.V:xHJ5pLHH>ՌQ\F˅w'f>3'>`jPaQ5}N_<:٧5:Id,e~&f/_*gf l ɱd5D5:Y2 'umNٌt3=;x-(8>lYQY5yX}kwtwyl4BMw gYٯJι(^Z Qdu< !7<bً{*YUo l N4 Xh$֜C=`nv5}\f:H"xNসݱmBv{/"u1eۯ#}+eԳ3!^LOcʉc`ܡAkCHw!~b^.> i*u8ZH+MK!NaJx=]w/U봵G"c1g*jnNkkV,T.LlQc5 36*z'r5e>TJIyTQ\`鸰BT]U0,r1L. !G OK90&W R}/!  ba CJN!Lj }&uۂ5|u@#]v ` aCd io!pox<a|7͑LV8Kozu[;vrmnb51nρ5~?@Ml8M=0}<07I#W4-{p]N>Lh98\?KT?0SZbsaN|u*$1b~Gil2דL&dU ,4 z60h|Yv~a]v+#-/GY=6ði(<..O 06SԶx&A^OFg%ϨCFqCo.z`coǵ߈ɫm9I(mTmZ7] Gbnn6a{;蝩t?\ƏS)IRNeh<-s >ЖGi`}q3hFwv 7 Y1S)RZ7w2k MV`Wj" NWwc&k)0S^KAe/K9|TeuX%(?$R 0+_qjCj8&}I ('Di VUڗNWäDj:H(7~#R,ۜ&}/5#T|ֻ}QM z)y;WS!#\b2 rYf[ r+$PRFj߹9ErDHRQ)mr< <\!uRz''(lx3PQL: d@ b5 umo:[0r`d-@g 1QȫcyFD~"2O!iz1ZGq,>/a>Jg-_.8 Ѿ_KVق|{q#H1Yހ U!jUy\/jg i|KG(2Վ0qKAZub d6 xoQ+8$^H{TM[C#L i_]N@͠X ZRK855d94k[#l`:[IuL\e!s݈*-|a *q=mnh)h $4*P¢pMW4-T2lο2eTW R^}5C'Ua<zvUŐ"= &Rz3F!&[$>3lPaH INjŤV;@(nmgzshϳ+w\8mz~J;h@J?.kL5&IΓY]A`iB^&Hpށo]Bcl50:T) LI*}.hN?yEx2n seCx.ē|m,-Џ{T|!)qS}d^nYw=HZM sdHs2fDp¿vZxGiŢr1ڰ@Y,(F u] 2k≀WJBűRae HMPJS&yIɼՌ%6 k3#"WTdAEHNmw#/ |5OeBuC ^s'ZRI.1[̧˨gq01"yPaGȽO(!|=HJJf58{P+*bbg9h]eZMuPHdzl^,֓dl -$%8Y\PӨC584_ n 7yyxO-|?ÉPn:Ϧ '@TdƚaY]Y~A-j#W̰2ʊ 6Z8.ttZc| 7f* 74L,#Yd(7D:Mʣl><^NI j+VqyɻIr x #kۉ!+/@mx إچ1>(8Tkz qOT+L4'I8ݴGa66Jk~]3i1Wl;l ۲npJ[wy#aOG*tR[?at[gǿ? 7@YUsQI1)/_N.-ZMcN fbՂˢ}Ņ0REIPɟ 8o U<Ջ?h <v/2Tt%7XNOh a*mY_xd\X.f,B~N;Ⱦ Q| 87Bǧ4+/1,}Rsi@F0 @4́z8> /F:b$N?]A[=hH|c#֞?Ѝ GO!Jb,֣8>lwy2kn2 DПn;鞔ݡ2T f֏0*򂲓ZZ9M`tvy=;#$؄rEϚGD,])py:^֋ >с 0l~gYv|֕8E$kZJ0g I'l*ifה?EḟNcntI ^{X 9 6:͝o%):jÝʳ=q_6ֵv6mSG>-?;iF>֧!/qզa֪3QIQ%9֊ Ic8 l>z:\I3uliPG4`}3ơ3ȁrf`"KadpN `DF3&Ik B>O- Sٓ_Db!QtU$ cyq֊S'Y-`-c3"dܙ,Ga Pi bۃ Zp,6 8w[DQ}53O%AOG(sh,ہ^x4(a&'uL,EJ;e~/ZbwDI\ƇjWMyPdPg0fYx;BZ#Vs_g 팡&X94_-{d 79IM~5=lh{C^(+feg,O!o4<:+-/Ki=ǵJ!S9~qS ƍT2g\0rʴ-/xϋg=5p[Q4nB. <;:V7-czX\&B}n`; / ^Â3% UUl5P! S?A!F [lr,d䷒qaضҊR3r 0lIt#54s78+1hRԕT:hq7] Q#9|`h?m (Aij|뽣ӷgaqS>˱g{>I"W\A+ PK_)1Zeq)*Qkd `2uj0R h2k7e*@Qh!Y0YBi 6ڵ.vӤ@^5O2"@R"̤!0Fe"cZS_qL@"!f nՂ~l\YDȔ"ZTg |I+<{XP]?􊢯:K<OG˰gõE%l1iVƅD*b%Ҟ2~.-Fy%i\C ;pĝCB˦GZ蓮Ѭ- ǻg4Ub[#޺+-Pؓ\ KYa6[q ŏ`nnrwE:w1 A녯X)N:C$1NBtZ)b]~;Ն7=C2@=?c9Meg̷||ߒ# R$I!ZæՍUuAX֬`h*pW(ZK7,9c] _ t_Eb W=J6;?|y{{ EJMkU|OPb n>"*1bXn=\eӗ=mG>!*L $T5h1A_d׈HNo)iDmx : oN!$`dH`_6*h7ZMÙqcv3=Po29up7Ŗm&tG|X;[Z.!pmi L38C6`{SK0a+}),`xbR S+e )+-X3R i2:eBCh푿C^~=]Sz^/0n>:ѰFԠ1jGvMTc(p*'NN' y{B$1FE4nQ[C9f;EӼF~҆ac 2;syB/+&cdijͥ FPlnGݥZW>@ Dܣ#T| C?wW7Z-ҢyEA{c$|Aſ 5k֢_P*yyA)Kuƺ^|;ikP ѧ@WZBF4c=G{A Mbthzk(!-eC޻klH e^BId,& r.aY4m4ުy&HzWŦs5.0_~]bLi|u~6/tBqk􏚼NW)ߐf'$S{Js$R#\Æ+E."ا؂ 4j B-v0!IWb96֯0>Lw%ᣍ?f߆Jco<}~)U|cЈ@1`1]+#AMF\z05i XN)8#i1aAlɊk-^1Qeѷg/0~ߗ8H'JaD_9G)vA}>vJQn nd ⽣]/qƹ]+Cށ:jxpqwicXOO YhhDLvV܅AnfbQ\ݵq9,OgGm݆e=7$xl?,cjq[(eSYúS?aLY/'x]>?gkg2.XC=`GY,Iqb8isg~M{X⺚ǾbՅSȿ=Mʣrf[H5J:S  (Mf>Q ՔtmOyw_et;~Ŵ+ 3L*UˬO1݉|ɲ-|{SSJn} U")&%z9hB( j\RO?2dze9LxC (7U~}yc5(nA҂b1G89zEa3 4s)ZdkTu;N=E^EF׸^S<bN)s(uF)c$ "zx{ |P8\X]Q9D0D[fwNx9Ck"W8;>/I/,eӎ`?Q)n-4}b: vr:ӗy0и2S IrhQ[^[U lPb1.+%ыߛTޚNƣ0"<YW@I"8H^dqƏ6`0Z[{lq^B4b{CN#p3 "*qeVICohl v@5[WPRh0[B~ ,t~k+-.҄wO?dpV!N%3/T4tE=LiPoo hd\j/}x:b VN}G{CFmr6~?&l=ƾxE]SX%OyW.ݬ4Cy\ݵ CXnj;|CIqڰgLugaR #Qg:Yl WYwGiRk%8G{Kj/nIt2ϨŬڱ/SMǎJY" ro_ Ik(s Mk`gu9r 1;|cG$>jXoUm{vKwNx=]iMgfalUd ,91Q2a!C) S|'uhW|dl#}eiQTLaj@Cvƹ'ݵZ^BS"t3)n]y(ͺRStN(-@(o}JwE2V17tt6,}U:996Qj}$IxIsYxs@URSd ; F%0ۘ4x Af-W?znx^[lÞ'Ӓ߆]<mySS'Y.Wȅd7զMJ8w_Š}+1N' EIwd7n{?l}kw6!BEy2J]V?Op]pjEu!͓VY{nn}뿅l]fAe\߽77H;dgEXYxORn"! TUOQ4p_NKf8*Ux6uޡ!O<} }qp=TFG*d]"c~}2bUQYRAq_rRN B^@*XhTYQ44 sMpnƏS52Y<=-gChw+3CR"0;hGZ^hs.ĒO%1Oay%&ȔՐF#bu;5 W$w ;I%9\q-M+lqh\J?ZA=TeS,tq=FBhtڇBr9a@VQ:J?R^¼Qp! -57h\i/iEjR~A|o@oq}.|t-+ =?NU $$I 1peXؿva\}q2I*CH  j+\!qYFƴugY;Id$4J~QVڕ}~AjJMp~x6L'')Nxvpl$к 퀐Sf,nTBńDK>ki?}33A3p7x:U/ECz^zB.l( 8$ʹQ&&A^r):Q56w).ޝߍ8kɤ_..8,bIri_hz@l3c*yv7IB^Np|q|PþEL`3%F~~O-7W5"{UTNb^y _y(6GG*/#h4$QP 4zc3 %6I C>/M>_àg"ڜ*FJƸ8^lxsⲃ`/P5mLZA$Zzw /Wic{I}T۰9Z^x@w mH +,*wK{,ixԒ6Bi'~hdA;O y$l>o~}8)@ۣfi~@ы4tӄ7(APpP?&?G w_Cd],| 2ERw9bWz)qy6IGK͍!ţa|jN)Mɟ҂D";͍ØmLIT9T: ߧw +V˪C8K <1rsd:/2[S&oci7&yl5lGa iK#ޒXnB|!Z .JT}w 6†%bor2kxV7m9n۶E=iPa>,N')zZCgn 9swH$;]Fڴ$*M5JqgD6&Ly9F…& "MCt(<۞m#byc1,B}Eyq7=c :`">g*uZU 3?OoH ,Ia+nMLQOCJ !twd2BKyS8:*ѹ~x>^C&]u؆hBN$C2/֪ O0 5\uthICDȆ;k߮1.,|@*dw lCu:F3a^>^mRmRɧ#1džlA_C<䷵]<{-C$| ߶+1cNOm_Z ;Rq8>{<Do$Nm?ϰ? "-3opAIE]E՞!z*%-Z'zЌ{fڲK ̈́W?СBJL M^ߝr R>A̞BYP$믯}jbMR=+P$O_%w'h4>ٰ9U@SZZVAJIs)^(*TFO3Lg:[t1?̇]̨]h41QE jXrZ3 FH3Qe`c$ް{&1;6v#QU) HL5ߠ*Bs96+ wc@S ݷM44?{+=ֵFƾRZM"eU&b>\}iź߅%O.{k3k nqmJw$%z! 4Qo[-uD6Px ]Yi#(< mu#e*AZh]Ulfjq6b̠PLGa d_ \&)ZFiŊ׼)U=I.PSǚ^ͫ1Aؗ*rU @ۼ(%佊GKɭI3\@t0 '"kY筴4em@\؀[;ߓԩ2\H,VxMD&C$ 5Ț9%|7W܂H-ktQtKkCZ2$ ֮-ѻX FD;ښyHf ciR@(yW{^[ ÒrB/ W%3?R8J{Tb5-s-ًh2y"gXQK{v(ƠesJ ,wxTv_XͶdH!{Zc5DoE4t56W*` 4S?xc(S}%,ۻ}~7=첇}{\`ra}WDז5Tբ7)R Rk}`zLx<on{h.je_Cޫ5he~V|N2~"~~5(r!>Y.lq.] -R +u͔(zLԃ`}V9+tv\W҈Z'E?dMf!LPᮧ^pS'!Fv8.HUʿ>|У|{ƿd0Ƴ4tS%@]][uV06M^OdUŕ ~ΨϧRvjwwW;(dex&ߩo5(‡|73֋Uc|y9O #-5~|cHZ\MSR4wx*D*A4NC7A)_W}g_T(M꿚ߚߤN|^䨂ru'@) $CG|xa0U\N( yX{^+y.$۫*S^8ꢄTJls&`f.:wwHn1 W$ :Ձj~%kX,*cNfL6#+OX㐲qg=;=|s7ͨ/ëևM|/"׮_5c>y'.pbc l$ho81^ 3Wy>-¸S29PȡS Ɇos7o([Y8y,4cڿS$z9(>7o4ZIS4h&V˛v+>ɆBq>u1B+֟9̂Iq _;NyOa]^5h~?%і1 D_hz$?k\U~ i}U/9]j=Ym "^kӯ!бbe5a (i*)!lo|uczܾș=c?&Wl 6EA9@ UO҈`J *Zgs]d];X%oK?K],A`Vmi1( k=G{gAE.!/=L}uڅ:=?XػR/!j v(aR^븉heuxM>"+i|:[J~ 8Ћ-(DJ?FF@aDrf,׳!𰸏'OL7&k.(A'lEږTY^29V7 4nG lU!p|5(_q^b} m i1CC"EQ?-H|7tc,x]L:M14TdTģ 6'SޕKi'}u:I1,o rQ/6c`= R~KSS  T^07Po;Md/D-A-4ɝ ]hֹHV/q[x+ ʲ'*Ɗa~0#ɮ9Ǫq҂eA 5&֢Emn %*]\ѠT qQ^ΊTYK NĬ m}FJliUi*jHiYK4t4cd˺wXy:ޱr~wMÿn"OhpOUc`樔?gx_P_aGwfǏ;>OI]ۘ% p-?1ԗtzC?OXOQ { a"a{_)߁C2^@_8ϢDQ"(dF .:TO//e=OI'|XO}H>=7&4mvn{ƥTؕ)4QC7'M.r@|&oa!ZAxOc{.va^) XjSṆq_ 6VKGI[gыN ^=l#OiϴlT_ ?yXwaƶ7/8hjӛ|ߦC|&hBs  8ܣ/`23 'g{,XœP6dJ=χxZ}|AD0*?xFR];۰ŵCW40/?w~R6ܔj=gA ӧ^^wzFG}RwVIg^GgGЁU_ϷLz?%!;hS};F ?=߱kT)!vW+8&:a4ۇc3ğN*&&k P|4+۲ws*m?91xE(W6oXwJ. 1:=ybc4MmVv ԮS;l4MR  Lsv:lnV~G9)> |++nbѝq3E&\.!΢ؚ__Kw7by'zaM(l[mR#@n dT)Sx K1}덴/z4xkS" +J~*Y/$ALƫdsV}ka-85̟Zt Mj'dC*K$Ř.fU Nls?(Kz:Pz<R2 r]cSb$sM(. \oQ;Ktm>(ѧf%̒6Kt\pVc_S8ڈ0Ou^țu{Mذm+˄=ixq]ۖy/agBd/×|د:epnZoAzj80=ҟG[wk.5_݄:d8YcO;zSq~/eyY z&*| }4p7ҚRѻnj(?'m?\$cBCJ[_vTW|}|iBF~*J0;P2`HB ]BfA"HW@'&!y% %`d@~ kNsj:]V߷kAX x?熓bh5.}upp߻+v/͇_}4޸v_7uxxϴQՑҺ?{oW/Gpdw^:Z缷 `ЀYXڱ3kM-lY ޼yh4/ @dnq }sp*xax-yy(x7CWanfB#PJ#NxHm66R6+#.u$;\yUY_<@A  %V~X g x 24tPe=^ m% A MRnP0%^Rh 6O:mf*lUG4UhGPpR5.0zQ~P; K'x:aSt1 (&-.-bPu e%@%}dtN捄}||z9Np;*>cYHW}z.8U(Kh,#νI1zO1Tn\,YfkG}^hf+Kr&)t\>@{0=tтvapmeAP S3;hS]VEyeS_8gMyz[\_?7WK`ϫEG_nޓ:ӾReV;u]*i&<{kGiS\e4׮(?̀6쫷5w iW\w\_e$;qŃ؉?h4]:Q#w/c_m[=h2'ッ}B֎4F5@1p%9Ґ+R$E ;]2d?>j||Sեy$]/ PoK9r6Z2;vv_ g?f;( /ïS 8յ5WuFO!ѭAV;{ߊvOO>h<:!Mh4d[հ>g)bd'zc&]ą{ kCT@7a; g>;[G kYQWAgxCfm.aS ֕dJzPr!IV[SWfg'?x{(ЕJCK (HJ`re`g9odD)6o |p<]q# ʢ$W9l |]=y7Jt+E]ʽoni?A#̐P*"0Do_6 O{3U#k04 l<]-^߷A)K0eir659d7C-U^4Ӽ,-<7p/& G-nK2/4 ,!Pti[ oZ'wE_0˲j+ߥ4?\g ~MԜ]{{Yj́0`0V 'ư ҕ93U9I?`g#!p維[AlFuw%ؿi19Gc/ӗ(\[^ƭV P3Gʁ+\!!n 7֭I:/8]uѿmAPFK;9,`W~&Pl :-+K-W3=/?.)mM(EX5(`ܘƼt3ͳ?|x5 ~.8dp (IX;W!OgbƓ{N{ƹX>vO?{nx~{ׂ<…( e06 F1`1k\SUySXUj3[<۵/MqNlEx)k1gFn[kNT+T"A(Al9|WlnN :TX%4x1/jހ@kj̮9p>^Lg//MP=4s0ഺE" LT1]sZ\ՙ%?Aa@c)N'A;V.#JX7kP6k3y$5 ]Qڿ${ .rNp,F%oH{Q _24b[+QZ۪:Eo0+^ \kSjQ(i?- 5{o6ICCfCR0+H,qZu]Tk$oe<YM"#Aɹw޵^([ur(ڮz@K9W'by;Ц5%1q YZ*@ʆZQ<1p͞/?G/-SK!d $8CV2g& Kͦ6-2;JPx@mNGc߀NӍ(l>%V^ɖR~ Sr ĊTt8&CWb1]FXFkKxQ5 G}#mT7!l9a_Z*Aأ k@k 9ಮ>?I<@q$T a(f@ @pPE6MY˘|ʧVIq&Ã߉| JbBu&F0aJ%"T0R fw5/OoGg>j,r@QX ]UPY+)bU#rNDШ;"[|yk~}S>–j @(X}c#\yW9gh2L;5OGy$ʳZ "ۏz|Z?rj8|@PZs Hi*R7BH #|R58JXZVaHl$T<e&fӉZ/ ~b=p5^PQnm馅M _{pZ΂%%Prc$F|f|_-#UAD9oů9HQ1&ỳ$XvNnA(Dчйa;Mgh~5wIn -VlSdg$ FOuT!ZbMBf&ˣ0e`Fֲ>[nY$Ua7[c1vX`Iѓ"ǷI'd .!B~J&n|~ sQ m4. Jkd y5PjEo0%b-GEkW>'an0xT$<4<)=:yV_c}Zx*_4"dbS4DżL/}j 9:==4RX=Bx)oOx[y-dUWRST)z#M-b4w\3\ ߇pрYLOh-rm'(I-?}z/ޚy^8岬E(+' 4zў3̷ l\D[L\\bhH.m׻氹CRUJSZґs9Fp|ˆK*%nj<0g=w1yma92m^.?c[m6Nl_λ̈́U/QDMݞˤ[Әa7:,5Pk!k5ɣ4?28A40V6.A3'8ۚ1,} ύ/ i*~A\ds1:bf7 2dw|D lQI.H3qL Fjr bmLUr|9'Bf9ta5^9t(b\ [Z) y]Lب#mO3co Nx:KLˌՓ0M@*@aUP9xژ ~I>#h]{]S!R1Ofxm̎*Z#cPA).sPh"TuVp}.q"+2 (A6 Fr0X8Zsyy# 6F)'_ yH<&XK6@sGuf P99*M 6tX}'k}sG,Pl$X g-y8ljpA: !/Rנ0y52'bS@zZ0'{pTejkex2:'?(HU9?Z"Ԙh6N,6yIG:e7(b2,b 6q}6V6L510q 77R}[F{&͠1R@mj҆J;7d%1*UIR~0ʘ& ثfN䛫W|`A<;3~Zk[JJ`Ϝq,e^f̨CHB 1E g 8!6thN`ȕZSG{431$ Ib1-MXbv>)Nb+]4cpߕ1HCp-1_cVd`eǼۅZ\'|Py^gZ+T%F4K{ny>}jURy\-Aťl>Zu`88tN5hpxIZZpf lJS̘,PM]8Ш 4Mb9.s\SQ8İC~J0~!6T)Bϊ~&R߁G6yٽ8m2~*)00&]09|5xӔ&K!X U]k2Pݒ-ы6PK} $3po+ـ~ˬ8}e%,G"tpE%}[yb5\눟[ZeU<x2HvsmaTQy?j6BqxQHf JXۤ8G)o4K,n|GSi:y<G\jYM>UaZltn0Rnn{w<2ANQo ,Ջ[i,'1T%z#ۀAFʅ$h4<9qj3LQR}A4vmp"\ bd2aIaV[=Ibv\VP@Z 4ap 9 2P I|ݯr ɘB ry w܉Fk"'Up |'iyd\wˌrp3a+5X""PwR / %5V֊_yX9Z')Pa+uާN'qJ:ǘ(YY2W,$}- /\c05* = Of  }]k NlQnttgcö1W6 t-FRyo$@f&oTYQ [ꎬ#! @s08j!}!cj1Y Y4>n_h:NmZl)8[K0H<.(F/zMWgy]Q{5ȏPUmHRQ0hNigt~ʷaeV\|ݜ} jj̙9tفP_Xa.>K!ϧ(NNemAW:H@? O/hcBgƱ!b4ॲJn0@wv u]~loꠢy!|>oajCyU`XOspNf~;\˶d`dVWylLhŕ:O͹.8nWP^嫴lܒVt7p黭!;yN(We.4A`c5`r@ncM $&`# MPp0u9Wcw"s?c)=msQp+H0(229„*c0˄9wKme.D?jnO7C/Ǐ9E@?dpUvQcY[d 2+F6IWJ^H~R:Dwn>rk*:ʁ./JA|޼kH ΀.i'k)8eW-rڜQ2n|d>ʡAXlu$=IF2xb6jM#1zN[}LZ us8.†4k,m[8Ƴ|+)"q8H<67dq1b+!5ѹ3k.*I!~u Ҁ4RGgxGyΩvkPwdtϦ6='-MsE0X}@ Ra1)N{v`k>/+ٌ%bǟ%ʀ)Ϙ,n46YFI'I <ta;)͖vtj 9? .2:p`]qX2>|̇ G@CEP8J]ATjOM5'G93{ej1|ZLM\Z0c5-ba_X<LwژZnuVC^"Lfewk/ġԊdŽ]%hXxmR+!o9슁8hrؗ14Oq~شjJRX-"*؄/%A^ƫYJXcvI!C:ϰszhN$!RIgK*A9V !/$A1-o6tC x^0f.(I_)Oq:h2̂H|MmudːLb(ʭygu<ղIJNk4e+.S8aeñ L5qq]ȥ:PmB31|KzltcK qjHgGR >.pzGIד a~SR &t^׺,65SaJkGCZtcꘇ۴)Oף,tPW rɽyRXcFB>:ug` ܌S]RD_N,ɘpR%2kX*_\0@EsA?(d~Ь@05d}3+妓y/O.P_]`ކDűj&Z/Շ:$XNy:` 3n_J+/Y}qsɅfAi4h ছ،c]#88`C*~e;)я"ǐ?x CJT\1TN], fi_{z4oi?)f7dZfܗ>&7]kԸ V{0%μ2_2C00^m!q>xS@ش hi$`50 πZsTynJk)F>)$kx0kၧght) ;p N73NO:,<΍Bx(@(:NX2u;EJm#f[b+ñQB)mFPXh: AP##M?HSsr$0.I!ec2(iU)%-5 ! r"5> FcAڮ jC;ATzer)T0ؾgn>3`z yiYk'+jD}KkS cl2FM$)Ӛ;:{EY;׈K` ^mzEңimkHy7$1PD(݁DcƇi*v9|p\)&m`jn K2S p$ m-,_Z Pz`{B[9Oj4ـjv. ݢF҆b3@j%. MnoxVp9iK&eUe#2)y)x֯.p*F̨*edU2:֖"> iC)HAdtAtAPϺPߕJ {@: Eզ"B!f}5/hh2J];vt/^ךژlsJPo&`qx(ElocځxyF?(D9APqdE9 ̏H(H*!Q_8C/z $ C;޲L(FؖkcpW+[rB0-bYq $# ;x={{AM&YVU8Gqrg _ yc #ȗ gfRXTlbɅh&q>MZu< [40Neܽynr^Uqؘ##U|4+.|4]7氖9 wo@mпr`?17:2O{U8BYnXim[⬨}P[7߿ZZNlwtXtf'(#Wim_߰~>V%s SLMOt5umHxVnAU۷^ b;woxǰ?l+oL_MJb9pcmZ,Rzͯ}A|Vv_ dSV~֣>Q=Pխ ':c3 Tp ʿfG ˫= 㩊 bM [ :ax 亊4OE12%i7[Mcy_(PiÅA}-Ypݵdt <cV̉WEB61qb]v݆mG>D WSv~)GN )t)*14&54tcڮ۞2'+[o<&4Vzn<'~e7 4Zbţ= lҢLR~^6mW '%EwcO:='joAK_^]ӭw777`C""w6GZU\s _zۂRBȷ8=wa3WVU}AWG_W.B_2yy2]g˛2ϳ{^ ('?QpR;hG {)1y"1VĔ:g9?Y@߿1T\Z+5ąڒ̶% v}9 +S?dZhK)ko|~syP.UvthqEGfK11TWs'~{g~4/Gp_cd\pq݌;"sqNZmǣnQD]?~RDO3qbnU\6m֙SdRk`ؾjiEGb?AX,i'=|?DB`>N"Hma]il^FC^/ih 埲e%?eV^eafGaz]M1Iшhio/vfs4>/GqTսCH}ĞIdN/r63P>#;d~,.(KA(0e-=p\"uI^K`wUx8YTMK"w N7j7ÌsGQAM}9q7Ґ 8 s@Іp|^J1-4 R8ہ!Egyhqchٵ]*؇.23P5m5M|~)|l9/]v(QQK6D a4L! a5>G0r{HM>2uʲWnh%APY<mSf.5" ߈_<7W1I?P\]{(_Tתӣ-goa<}6]-ve߯MuG)]W.jF-om(xc6fl43/}VSN!זC[~wɩk(Bk.08S=%Iv '][! MăV9}Pc; ybꊜ/pYŽrBlwG?/qDگ =E7&օfrycу]2]|Wt/|&ԏ9ݘ]w>/j5ԌY`R7&3\א%ڪzmd-~jΖƞ9^~{ڶ]U}8nal#5vr5^u s*ߨ~6(Aj:]YD Q,]+dr1CN :[_1 l?ү7&m\?44vDdky-pWA'&/pm |3C0)%s>ZvOK k:foyʊ]yOj4ُĚV31b,I(*#58$jŸ‹,Vۨc6c'fhj>~\?{ ۵W@ٹfO<,mt8]ٹ]S0sНH!~C!تz hے54^>ߌpbRC+9>x{-xFd.LPiFgjC8;PuSF!cBT޻ނa IH !̩py 3OWEI·5uCZ)VK#:_C̆b˲n(< SVa+Ϧ~U-  Y At,/Vƈ>aQ}Hk *s1 w(gBvC>}ֻrk+| ҰX}^x#ʶ* Ў9.W= ]zB{BC*>}Y$vVKUnabX\ -\!$oh 0@B!w^;zsGDUfWWeuOWUVgϞ /Ϟmx_|W򓲩zx Mw,gϞ}j6ͧml>|ɲM7ۍCgkh,>%h-G)F_=~~g?}집ǦG;?˗)$>Dh#b仝/*#TlO=¯Psx(3 ٨Z9< s? M eVV\hE&w'^Aru)jSCKꠣ息"a29>NqۚgR/K+/d8/quTu _5zX>[-x e(x(^6lыs/L0}o˲W+N'^ĆXGDWx鑌b.Vc ߺgb--dOl3u}u۲md%^p]/&f/P+C:L܅Non~Jj(JTT$#ٌZpVL\f;۱0["'w-2EK.}%Ǫ2[Zɢ*a;u_BsF82P:"c?[]X]t#@>'6?~s9T1ILxzg53d,="Dzp:'!dJ (6@yZ p`zrڿAzP^O?t7qMg˿/\;'~lN斞_$?£qf}W1J1ޫ6-̿$i~h˪cAA:f6+'ORn+4i$3Ԕ`(҉gJO}]Mj}"16 LE U 9^LACxa| P61'_x\JX3C/ۺ"E43^t!'MH ]tq1$ӵ}RxJԁ_,(uJ3R>UH˭^*`{K2>ܛ7DW \ش\+hEKrAx$\BM&U?@H;;l^Ş?嵔;8M?~<,ß!Z8(CeǪr_xQYODͨnҡ.Ãiv+у[ Iz RT~;?_Ѹg|32BqDYǓeHX U9MS )ڿy*U(xmv>ʶQ 4S>+c'69cxeȦCl9|]PLSer@2rNWӽK)^!g@%iI#.-i>*}9p!>dF5TڒM-S"뀙cW1>S8ccи0 uFۨ%\j.~SU-Z2 ߧ wwEJh;z|Wgf$ؖc,lV6)o]A%N[3DuVM߹O_v\v h8v`kоf|rzWTO?>Fmܲ,#;g~kMLUGgy 톙`Y)\\_>r 5?au1yvI!}}j{g?5mDv0hFyKAqG$I0ĕx [99ț:ku_=T#pi@ V;ˋ6 ڻ~WIOyk<-rUfG." _3J %X^1L>C9YBW5y7 ItU$l~,~[ﮬ%vY!b6**Hu,oF,ːܨSG7~V}Y U0TʐWf!%7ae+K)*}譺|y YPp{`'Fuq_MWn׹KIfʼ"W{<^a\pAA>-ǽ <'T;,Cmd_cOn7SdŠ4ǚ x_{,7Xc*3TYkz*`}]S{rs{7BM~7p 1d;i,J4r#niLψ<+/pu폭~+bx/9V)Xb`5N,E! 9(x,}M|7}eWgPBPխQk* <|eԹ,/JE^-Bx~wi(c׮WG8t:kRPigyE!U^<>w\O4_!HUuIRy!Yy]UZ;\Hd:<1"VHnO ]V|P;9 jR ZJ-6ɸڿ_ޏK~=401AP]C\<.5 VBd XMYzriBoq\tQ01Qf'ىGoxr>pumo POR뒌.3}Ps,`O+!cc1۱}-jDW8>s/uJ- <{x?orhLRMUE&*L]n^ N>~W#,1𧤺 w;l]X@T~ ~k!&DIB壱R|.+X`${h)3_5O  z*GRdГ1$*\mӠE Le4. H3 Ppt= Sօ-=uW8111c˓Vu|_0Uݔqk͵7\)TEbg_g4nBb݋^ԼŅ$g(4]GjEHs(N?4y* - }#5e4[yzJglz8hj7ԭ(Y 7cg>\nť.$ uGJ%`gbRكעРofu; \L17w_m{ -OAJ#^:< /]{ Vj=cXE\~T)N8R: I`H +uӶQW7R"gƬaL#8kN~#ᑜ*]J}"+x$MI#۝xc2qtalS7SHp(r`-lCb]?; W7:!iw1Aa\ZﬓY BA&nM䃳O z}ܺ<…KHiO 8IHsHM5]ar}4&. 앛uJLo)ޭ)ԅ4O0yM jBЌi%\ &NĆJO'\&܌ɧĘ /+3}HVtJW)]aBG932>}=4,**8wIt䶤*Hb8v])sIJ1A+a,/VW-~{7}C\7;mr8`Ow 1h2UhMa+.mCYB{KZ\zDf&ϯ_le{\ѭT IX5$O,gW?G Q 5ᓵΤ#ST`}>ocUE+Y(bsXYPW~߈s!9Ԕ& @%]]݋"9 @zR}ݵe2[uX$oɇ{u DeEg̺WVPMՅ֘e)!=37+aڶ]95Q 8u3Ua P6Xv SjM,-*g8M| ? rrC!BWYpt. ǺjZuD9,;0 GZq*t&ҏ+Gz2Xe7#\T1,39RWCl QuXNډL1\8褆 wWVk35Q,ƉO0\,*(#O|4VSECD{(.'-Ke`H`b` aG6ƨQgSZn` a[z:L~C]^SM{hX4 ŵõ}YG GLbl|`sS "B/=CA|="~?i[^yƈ-^FN_L1ahh܄4S/H~AHQ9?/+P~.%s.:ѓK# {&lsM -GFuv`rBP%K+ODinni$džRRzG`߂6}1I2yF($&Ŝכq&EO,Lfd{#N<燫Ex,2%fOZLy Xs?Sjhy2>[i-DcYvJkV<] W9/>GOKeI;]e(P 9Wov_'n^Q4>"-l8ɒZeδ M5W㾺\uQZ.G70bY]bB=b9̃[ly_'\l^Hr'6W][+<.$E=92ߗwg$}&6)#+UT\ݹ['{׺+|_kRͲ>z3˴ \#sf@oQ*Χ}?uiI[61YBl8G ["N.>6N"ḻɝ`5ySOt nnQI0}s<_uژ_~͊V*ROx+$;^$CqZjjJȍU;?Z]Só_LOo@G$P.a:6D>o6Nπctfџ\o*IQ?ZUӍVsOo'zb\F ̈."8O9VM|T *ܖ%htf RiKjGj& :W}ya7m? XK.c*)T*;!hqq])Xs;9HDPPJITgvY6+׫?f>O8q&bEAD8y49Ȕe4|hT ܩߡu:* [GKx1}*@Kk$؋k.E%7\B<x`t|9ݱTC |ߢqENud0KN*GldT`{C,e47IxM7:zΑ!E16R ج 8Z+pϘҜɧ~7m9n6{O薰f SWSxL}APO?} 7rIIwV(D.xi45<\BՆ_gū]|hs ,o1cݝ?OP-&=)ʓ$=yIW"Bh>w4ܔԭ zg";8ƯU=Н>nC$P)/e&1'G`a~ MuuK_IqU` F,e|LuZ_{CKyVA(tZRS’INOV3?=4GϹ?X-T1OSO~3tx黂O+W lMI-9+Umm,vGmBh{$J*E y]ϫL>9 X\Dh 翬leչFsnDd |V@jK%tfuL8(NՉC[{=O;ꝮJi. ;->qTS[]zXuVFʻ7>ݡo8}0Q؎I+|v8mY(3|- K+OX{dwSx҂F/8f들 l帜ssyGJHx^Y䛺V!7i*ʞ\(No_d<4:o X'@=3 t,v!Yd$PLܽ?Y\?^8><&ҥ 3~] Z1eg^ Y${+ { wdTm=|~yq`%R}.wʀI/v#NŴ! _~XW>D3U3U'Nw _VCXԼqox艳:uVifP s;I,&5q.k7]\Zjt_a U;EPRybs?DzQ3$*4lj80sVh/hze_~7 c[_qܠkc(Aܱ/cl+3.hB")t|\Z2u{"+|ˋիW>eio4.fwn<쎽d "#_*u-)(?r:gY!Nr8nb%8H7<~]UJr8# T@'u8 ϔS6SSxJI燊ϩu1)۶&ZIEwxTXOh~)ƅ$o8gwǟT.8.J|$tB cUgխhuuQ`PQᖒq.V[/Tx Vvxq6IZ(.7߆ثatE:r3h s3ZYLvb5jFMy.Nuί?!U*E.ppqۮ}\>\n=" xYDh6*{H1v.Ÿǽ Yڪi떦q UTv8UE& $Y8kBD["򤫫kIZ1gG<8XUQz?`tfxP%ZH}sK~%\աKf.*ߦ⌳k^$b S1m%v}͞(a2=S84!V*{DhB+ss%L/u^oh8%Έ4Q($zEʏUv!Jh7W`>^emU AqqG"SWj?xEԩGUش1m(DVtyUdfGEI,uzސ"u <ģi%i>>#ML*4ռ[gv@ NAm599ճ.iL{~M6bG1%mq h, #; 8}e+vڗfB%)\)%? ݱR &TwpYhb*Oʊ$=.yV 뮉sCLF9wwBȓԭa7עH~}1Tǿ]8}!YL*w Otႛ WJ?lfjz(&]3s,wW )7 m]ly[e֥[qRS&e͝a8SyOs7QHN7"cELY ,ޅoH:5L wCvAi$.Xv: g>-\ҊaBQ/_ {/۩cw|Ēca8ԣE>=pƩr1 {MRx{؇W>H+(JzF߰)g&%we~UPٍm"I)Xqu;rI"n L%@"f8ZGKs}Ԉ/"Iq٢9\x6U8U<dS9T ِRr;e )u 7#ꮎgXrZ oy) p)h?$& ~)?qv8~]^ 1q<%8[7v~ VC3-o 2xw_ rg{ ׈p ZU!ѳtkW:Oe+^>9{[n 6(`zغȮF߹3p5}@7 jh%v3!v;nv\HkLۇӅ=F'/+ݕHgqYC"㿬I_禅r۠k4xܪbNxB#C-T(N!L؞YCII#"/ʯ!ΥyxCbb__mP!>Uu}|f 7\0aګKʺi~ڭfffp娏prN+c䌥&U5w+g LewjRi}}c9~wΝx s;um4(ɋ Jɋ{y+<ŴnJ0Doʶlعۻ*: E'ZRv'(F$G\G_x[XT:*6xm嗀UtvL61r=ZNrW\@4##i̸ݎŜزb|<*8 4zD4M)m&L*iβ$g󥍯zҫN:oucss 8KLE&Xw0[8=rsɗXre9`.{폑7׆PSa!I)T!v.;c759%I_z/c2b+Gf;'W9)WAWرTȈߕq7A\@+KwQ܍:cI8uff9eLnވBM>ehesX}%f[3an !܂b"$,k ǡxqފ1Ňr=0Lk3;~MAC _nX^蟹YJ?l?۰iq5~ FaR˞q1/>VCX73IQ3987iژ2',w^_]þe2dF2wpc3we@cUUఴgt0ս;}?1?I A||.DR)+iGq\|UMٰPa0jQ+`)>dr2 8+<ƛ1[b҆4חnz-LtݖWKu4)^QL-?q ^#Y1*WCH9v(O|A`?WN#z3awSdꨨߚ3dIy$x8O՚8:i,rboCcEԍUaO+Pͅ/gtW Æbufv(AmhMe k `lwOJgubəxcS 4ʜC x>`"Oʤ|0BR%mr!gBrEx~2+,~݀O56C7,=dEQiɍP'[nF4~gEH.2+srjBCHΰMߵ],cY:Be椵 (!T q(_m90nQ<JN9.E qs\/r(]-;]apӛkK|3h $LsXjPj2xutSQRݨnOMn"/ q'RsKM'Ƒ GNigb'u۶jgqhհa9d+bI-L&,[Sٳ 7{+PG:/T:n B>!>OhrEmB,ۧH O:{)Dljܑ~C3¨[Kc?{q__* LؿAfoQyNeFTfvUfַ̺?|O?x1{f?y1y>bܯ7~k^_x1vTx~z;oC^Lg۩aROjZ/I+Oz!`B>̿OO؋{G߭00Ji8Om8t,nMؕs%UaQ*ϳ\˧~ݭ׫?)a8loH2 }dMG[2\;ϚƱ8tӿ$$<*Gl|zuEO;(G"<]\/#CX&^M f<$˻n!l};tobci Kels2L\כnl}ޙKvL œW:kzcH {C\~E?x_vzݜJmNًR$yTFleD=(;=WtQ)Y]^^*1٬ I p_?g$' ;d˴/L,ΐ(rO:}|$鯆KA+bY'o\a00 @U7 @ۦYmF>{#%*4D{Α2IG5G$njfœeviZh0+IIS KGv""LraOa^.Wn ~kazHqZ(+Axje yt᭿r0_^s&\}趔k[l7y2:d;Å( ހ G-K뢼Ttw:`ᣫսf D5VYRt ~8 ƹm(䬻tQ&|nr;,V0s#WmP#y_mH7c\]|t|( Sɿ,o3'GqFCk[ǣS ތؒEe/bmܿtn* "}rMgoRe+OkOcGWz >f B!Oa&hM5F*9>0?kͬɬ49]=`UrcǪ3R&NU8'q%y\rPZk\c GK=r PugdnH H 0|+Naa{8r |*)g;CEq?"ͼ),JFwͪuo5Nj'S(02J.e$j.&Z.m.Lr|k\!Ʋ!ߥ"8rQxV17@Vc qZȈ&`G5 WTFNJeqIT3~YG)l=äS¦:6 AK\Nc-zX/92+ᯗ$u۬Gtޜ҄Qew!A .mj |r:M9[k5S_iETFز&vȽלf'E }[HkNp*a= tYO_?!<`Pϑv`]ઌP7rUF O;ֻja9uj7$ܝ15 !<fߍ#lu#i>({4KМI雙O;׫z^r mN7DiGJ瓑BtjM>hiV#?n,8Xgm#@a p1:A-@5>̓gn'9R;>h|2vsUL?vkFyJDIJc胿'IO6;Lq跳 ~fmtRpZK7箨 g$sRW(mSm.f{O={?V7h0-5E r- R_OجN'g*#S#[CxܰA0V!3(qJx 9[qz fmlpj,ф- DW=ݭD7G$ io[@Ȧ,XE"C x:=է4N]6B 4 9ǓTЈ=V &*u)c%Ӆg,0I*ytu?4]Ve J= pwv`n- GTuKBkHse>&'2qiW猗Td<3yNr<2u *qYށ 03t6*Jr:j!B?yX!1 \Ye@^e1U):مy%g6˅qe^PL9#B0D~"V 2wL3[[܏vz"!3ӒRk6ŏJø(a ].d[m]5.3x_Ӫ,bE16{J3Ul2B9fG(3ѴS@ \j+i{J.&W3UI_g9XkȞHDphf=F{f<-ХsWW3GyWƪr.=~@'RSww׃-YIduW:<Ul`!p^ū[?~\'<$>Ki6p3 kL mM8}=g]0=)J ~* {Zz SZUBY!+'pҧavMs1>bL@b=)DZt( 2nt0\#ylMXFoS:j uV'OHE?:6fj?P ,+, { 2f3j\PXLS~@k$XW #Wam=c/N X#!>w y>fۤ07X+oP2qy'̹7KPbcJezsu!`vOMȴ E{ )*^Apc NP'LԨzi2]Yw=cf.n8kMpўٹ1|VC)fADȩ(*X5} !29Y(ζfrp J0@QˀGڈ20h zM\|[  %ʍI v]> s Ȥʉ)OJtph{iDzFkseP*vJ!tb'(|/uO eJ)t&D駿Y.V$%z0G˱UۻB-QblɑTN,J:l]H#LH"E^Hϟjo}$*Ta2Sҟsor)rDvrWJ=:ڞTcdzt$,ɿnZT . QGKRrRIvSqԲ5 C07[0v;f9k ht_+ 䍸|&p̪d$\ y<flGqvkJ"UƳCt~Ht Jpc򣮕πOlx DFsH[[XFV+MIme;u+45͞>DŽu ycTNۢMlݓ}krWf+n $: m~B2",>7(O{HG`IM+ć4I͉H+Q) )n7\].p'9C7M)wB"4.:z5!tA wC)=AA:CţX|2IA/w-!v;ˤ+1JV`yUWWi]eT9,QMŪ{R+1 ݝMeoU$*6[]GQXghؖK !ؒ.?nZ: V;| _\fr ~PjV4D%}!%ƐL)tI1̒EvM׺\g8|{+>>736@a \5G'.q-deY9yU,-*!L6EtDֻ}|I1 uU1{|>EAJߊ캘1{r/I|coǼ\vo말'IHNL=Ɉ;`Pm΋ #>?XSBs;N{WzA`pUaeSwtkɟ'!}z 䶨4o6!w'hO͸ms%(:3Q% DmECwt-7b땹x@;y*0e9'gw2=4v{mP\Ц]wnҁ#e, f{H9c%5QN0STTtW{osmghs'Sb$iR }'<8R#Kp~b`NCγz"/][FWp5yPcm ~`ij=a>Gѭ3Wlu), zLkEV\!C&-5Yg*N ΢ \"0'H0ptuE!\=e{WfixYe [q:]Kҗi+kZ%e%ޡe_Y[Ӈ?U=gΞ\WUM8,*^Q_ 2\<:e6V}#"M;-:>ہSCC@Dvb4]Nfe,䒟GƊH8#/28bE)8ܭ9ĭOB|2e|1qNb(%i|#t2#t-èw}N 3 )225ƥ\+L1hO ^Ka hWU+U/SRz >m[B:J Q7:)t!迼x|-Q3𯶋~;@|~l(|nbD1<[#\D<|f3 <#Y-n4zjd7}AY^}s䱻.)C;qt#yäA a?@]hΐ_{ɡ2IZvԶ݇÷߾C&W߉?D;DŔ4t"Y ?ɋ8-&1NXBAyD%Z?ϑ7fێD Rͅ,* nuSgeqFNn&tLsг՛2|6nڤŁJ2;Ulzz`.6c 'sBՏ6]1f'ΎI*+RAPi݈I3^ʥ#?yf#e=ܚ &IG|yɍ=-)[>bz? -[n7m"7cICXcq4-VklC0aJiė"M}Çp+no?"oImfd>G<:s!M1:otQy!W"8gqRE)}_|QO| ݳU=D6keѐІ|n'_zmy"{2+Yno㯆rwد>}"Β&ڸ.]H }u Aǿ-Wrx " (Q!| wy!u?1M4$s|wUvH վ%0,qPR1ݛKoZ;|=pEv}w7*VM ۊ@~ š(97 /]mށi::!NN -Ool8%uqu=it2QO=a#V _۩a&զ !!Q T"d*W_!+~9+'= m_M'xW[=#Hߐn j' Nn: Wޏ_mZMx%(Ļk]E<*MOq6 4bqI0CN=ycoh6 Nű6d,< %›g}t]/df À7~^:TeEOxUhG oTG՞%ȬÞ0ٯIfc׎]w& Eb?\OjNLs#Lrg3vM0o3NfH9[^ƕ곢N; Zcx'᳢I_cZQχԍ{RT-'ѱuD'oVo>j⚵tH&@uVPc)%ԕv\l ?Dn+Be՝!@IQ.3QjO7ᗨ$`6O8n{!3-0On\O3Kֱhʷ閫]|}ZFCfΕ.o'.-h8p:#GAsq`n,=I];tVyaob$Gƥ S3r8SP!@NSѶL$03sm,2v^)Μx-Svl=uqfF|~zfm ?| k,ؘ l*Vi&e4C;X/ww=a97xC?|odC,Gi\tWjhHړ!?,Xm!>W*)UaVIC.ĺ )`j y!%{WIV10̑>(ϣg C!y}5)Ӻ$A6;v/zfjX9&Mznm{ί"ozÑGA1?q|!eg)ǴKYY tz7=꫔^uYChaA7XŜuAh &@iڵ&u_Yuk*xD 5)Q{kۧTDYho5;UloEV?NZǐ'P;h j YTk|y|b5=\P29EI6rc“#5)=ZoV1Bkvhq,ؒR;ӴTJD#3nqXVQ޷iKL1%4|sR{=Cݮ4hE ŇDėh$”{rG垊Peia;ǯ8 Ռq΃LJ8>9+CW1rPTI&YgWdiWo߇wF1}+:fg[SG /{uI0tg47eR:pmj̖kV\ GB:+4܇m90|6j@xX %W*nE4V\fhTif6fl{𭸹9NlRd$ȈKJmx1Sҗ\[)u5 yi-axnw_t7 seoU|-Sd4fKғsԏЙcp9妔di0kK<Ĵ;Q[e.=/4rNSz*Փ o 7cA.6N ˩\DpBfJ.$QLZl6\fgSԵT0MQ@V\akgb8y)JیY)Ý+2ii9OZ̓ r8njTD5-pg_ڶu_H7pC plR;&㟊`z_YF u}_~` HzvQ,&Ӫ]~-ozM\gC r(߇'ia,wL}]\7&eօ-uHV|!bDCF^\'Pfuk' bF~*1WX]FDu ڪNBɈ0sa\^첨~ד0ҰH(<_>ٻqz#.E g;\8?'3rHA:rQ\D?#KcҒ!ur\NZUb7N\)6~3B`͓d+^? t=#sn[xSҚGNN,QehQ3`R[JHqlX'9e4[Yg;V|ښTOhyHCTչ\hy%LA+jZݗw~Xm.QPifJ:˶ԤV8vQ*J%f4k=Ii:Bo To~E^zVq Hq&٭75JKQr9;G3On0ܥkBDyu:~9P ],r\1 f90Ȳ@\ {ʗOGAI7ce|kQ,s5vL[mU&D]O ޯ>!#Kuv䲝/& W*njԮ %)qV^6jL׵ՠ Xdی W؁cOI2UȐ!dq,h#Id9YS]\-6(뜭u~\b>*xIwryyL"A3kz\:M/* m(<a1L~۵\kw{k(|ްi.4~)e>Ns ;SX}ƪn7*mZ ?Qk{[(DOF4v6G7+L#<]xۊm9'N[4vN ǃImKJ=oׇf B;ے!7*DvhRx$;ř+oQ;[Pל=?~En%]zW֡aއළ#0.a*-W0" yK)F(>9jGe)';ZaGWs 2)6R9B{ӋM),$yZžNٷ?$TU v&Iqm3ѐ}U$rYh O{bTQ :_9(Γ ̀}YqTb\h,&]08!jFIӜFmL?>i8D%Zug&$mO%"|@n$RBSrIqsQ:}Qw>Kg|iUjyH@ʹjiwɱ}xh $-@|:{ o/}h:hIlAPP}Y~ NCBNOh]+^NÚ}rXxznvԼśZbϵjm,+kj&T!Qlj ]y,Ou*6V! :71VZU*oB놲*lyBD|vx"Eq6*Ű9|߇氞nIcw׼<*?Wb PTor,I:抓-uv?O%4zk`%i9;P)fNıtPED K&89^Wښ#g7{6!lwݜa6Q2=R7XփIʗ'$REH[wow=LeH[Oxfwٜsn{@nD9\ua5wN_`lX9+}ś"fZCo?>ir,7r ъrC@EYti&Ź8aRj R1rbDV5.: Ǻ󸗥3qC(?t%$yN)+'dJ_T$M+cu˱DÆZ9B. QʟXm7i@yPcTMlřOSUE_LNq(1ORf8fpخx“s8Qsq)$rwmϾKS.$6]Z[}{ȉ|S_kL#% 2rFжf ;̬ SaD-I9̧zl}glm1 |XYj_6H×'IoMO;T.#fGX~}$|ح~繍*ͩ*p!ym4`=I\!,*o A rڑûmzfW:NCeO:` $|^*dZ7*am= l3(xjmF ȄkԤn6OO" K Xp䪁7~j Ow1qK5n,0i hCpkEy 54O罒qw},=r%ѹPsNL=Ө=NQ|a\U+8OUI%1jn#`bS voV|HS+q vN}S X,WrFt2^PWZU'31`I* S _Xʼ-6Q0ێ12Ę`4r r.Py'&3[}k[m>4z$/_$嵱f֖k8wzAǬ ėrFX+ əV](S#XIz_!$1빙rQk9[z(ORRFZ_R#_/j?G LŌ7)vTS *#@RKLY<߇Ägݮt!7;ҋ+)8[! 3G$UA^'^DEBN=HAUHiò2tJU((yzpZ칌rۓEĤ@Ny2h_yp7n9E & F(C3!1UqQp+.g ӵ V̫{;Yr䘶ΝsҤfYQO7<oHHᘐk~?ln OZG,G <I+24 SNG#o֫z1 >h}r]Ͻ!{ry+")%bWeƘ\Au:lJ;oJ:3Ev=)ns<וoqV8T (.HdvE[6 '̓έΑatjV ol,9ReƜ؋]D"|= X.=}jzV@u#\"&y\w\B{Q#Hg܇zڰ[rH~=Q4)Ŭ40Hq6 73SWDٶ_mK}8{qMUtYQβI_ җ9=9T$0ܧ=VE/}r,)0A^^3_N= KWR~&TH%" 5oE:'6]U7G:awwIV7i!&H I<\5X:ٮ6޹+)'ҝR=:~wXCKQ̋:#JK"fU&kDS(7΄Mcxac9C!z ~ w`K{U{N բ5tQ\.y7E%WwMVq;K.3Đo] $& $+H;?x7s=EsL+ΧdsL:Xz~hXUj^R?Li}fRorWY~&* ĺ"Ɇ k#cqfr̴29fpaՐߎ90)֒@6q_b~= .ұZ|m! ׻v;2yY m. l˭rYcHb쵉)*z-ÿ~foD*{q5#kH8f AdQ&sAj,PRiK)+6&73]6* H1-um)ۓg<suX6K|Ave]V])qV3WUK =]iDXyMW[OOaMyK9)Rcn?ƚ;YyCk }!/>-<4i U]e כ܆wf.tIa xD_&gRIɭ3ӹػYhF 7wQ'~sMbr8?*k%%znA0ۏ뼡2O!Oz̽*_btlv қ/H~L;ZR%sq g/1i<zݤ213}@j&D9K)n #tͣ,J59[C]m>hՇ_z ?kzV(vF0ɳ\@ \NJBco g:FdE&80+3I)<KTյ \W9D Ʃ%[3۞.e>č i2HB:xW^:mY(fO>l4^4-' 9\2Q>6!9`cNU.*s||O0w%Ոӷl.2<|i˧w؃?Dn#=Թ8ra[4wS^t` !g`pXSqHH(u}g̻֛ ($RN'zw%*];dn0VUEN72xc '<$;dÛghU٤}> ?'X'_ӡVx^υ{gi.va}A +"mAäK7_҆;^JZ7hع6Ж>~٦5DÄ$)0lc\VEC~J߯ 4|НjJ&/ gʆB˒ؑ!U"k_K/&E'O-Ϫ̔Ds,'}U%*`]9y4աIm1Dy'=ncNRBC_Eۏ$ԧ=.}OȌ y0ȼ7vyx?@B10ƶ, /6  |8{GFUfUEtUNOMUVk[ӫW^ÿ?UX ߿_zkVfޮo^i׷>2s/ggkkOxyֵ7uGO[üW޴V:~/~WG~/?#/Ŀm#s6ʿό_Gn=~<'. |xY'7m|kEĊzN߇$#v.MxB^(/QJI jٴ-;)"hmHSЀՉWx>8?BVmZ?73Ѓ.\> t >Q{!1C0^c{VWЃ$s; gҲ0x40 0: y< lԃ9%cyTMl۱syWG*pGU"[d VCuNnw&ڝq_++#[H8=w{/n|%Fx: R_1Eh,F\(JEO_ڃ4_J1e )+9~&$%$WIZmP`LL4n }.Q.΂Dɣ O@:)}n@AwޏBo6h?5wBkHHw‹tчڅFwl9RWha XQp`]kd)`1YO1;@QO*)8T D#| Ȅ5\МMuΧ'0%. Vy%^d1W '57|qSj|7 Wzלvj|ή~иd]2Ty-@ k ̠Hdfm<+Ls|ނ+3[x; W@xlXWt-L2*c/]NXم^i >`#{h6j9  rUH&T&q [;V/1unIeQ} ]\e> T ]9= (_^ p@ٳ‡Heߊ< N9: fS"~+!8e=~AyFX- x&aS9`r=bw"nkdk']n) 4&IsNg: }їiȍO6>X1ytt8Nq5N$<"+,&}1 <zqqϮg\9?= tƸ ޞXCqOiÄ0)`u(cizF4M@ORygV̈́(}ZKiYҿ1Bj`$ 8*5g  ^rAO_ozXTY%1^1/ M۵) \GnbLb"5߼L;OJ hw΃5C"g GRlʌ¿m7~5>ӒH҄֊gL t_@m tyeK+죟>PqxmC5ϥ55EC=eH&NE\o׻ם`Ҧ2,9WI}b sJ~%sg ż:P6z_UspX<C.:g㝊lW)i23] -^R a! !rXG.I kS2%v;(iyo,r:L@|H-V!z4A>f6S JM: O14(jTb^~5˥z UEٌ2Olm''ﮮ2"(d7g + '}ireM~ɤ.8!. O#XH8/ 1- ([dcc |p + A%tI%KQN-c}h|M\MY'R4LAsLŇ8]n)r|,,Vʹ :9J!ƘU,/gBXx 1?Zw|:oV; ؝~QڐIGflSC[}og`snj)=&[H,H?,/bVǠ%Cyd۷Jaz 6$k*{G!,.1zi9b~ Ohgگ5Ae$Jft9:2i? G"Z{AјN u 0='NyZ')4=}2!NO)~޴fzkg ]iC&YS|H?b*.%݆I=@?.z2נN;:Yo#'hXA$ j 8)r]TK9{jdo |mD{~&S]gMw>nc ѢXh/Wzym :W|&d몺Rox3āzԅ?BXS' o&F+="k0+n,TZ#\qa񋒞^X}sWy>?%}1@ 9'\u@#*/p}no oΤ&!2ST}ۭV>z\.Wűe  gEƮ`l,&Ymx2l7e;A=$D~-y0:u;,ŊL&گ6Ay{ ~50Oe?@~<EP)A.4n >߭~?ZynnzǸB+Kc oePlqJi+5!"*$] éن.?3DCu{8}\#Zwm7d$)~yV'l!nEGӖh)k\l:shȮKfo,O^SK@9EẾ0Z{a<S.nDfX\sZku8v+b'|$|lFDyB^W>H'Se%}  -j隆݂1 [-&tXa>ނ@O,Wv?0`1>5jcJ( "Nv)1p6r^["%v>$"=ا8_uloACc;ؖ&`|__i!9f᧑!>'m\&vq8<([>78$496L0Q g$i'!v!~O.-'|'fHdM9~FfFOLdA^,w?e s硾3coINX{Eז!Zbrgu{& np MfPu4:68e^~v]TPf%8ca4mc~-7a$k¬(8Ah(\*WZYa7?@T0THNq)Jߕfq&8y;I~xx{)~z.RQ1R!ܭ>(c־YF5N%VTd34Æ:%Fn@tlOv,=&?4N{v۶]ŦCaׁOc&7p7%dkͯ Y*DeF9#=&%2.;x>12rķ8y{YZv\˫`xu |^T|>[)tjwٴMjaztD\e'`v$8Q;>N"lf5'D=|eb,}pvc(=ԦcSKtz=Z?f` v6 K̿<7#؝}UD?f2|YbrᐙM9}*'iv ?eSfUpnp *L-:ż:,_V7UyULϗm7?q8+Rf3cTns]e+PVs+muSv w$n ?]))|kWr1&^Yc8qJ! Q+[\ڣ|J7pMml +ԘyAHW>XǙnӮcc8s%(f(agM|UQ&~g?0xl'3)gW؃([0ݤӰ:%GOOv\ugcַg#ц{VUr$tbqIeVI8pag~n<drv,C?ߓ珇2r lS@Y"b558ّo#:AqҞ3 Vm9.'j@ѲSYI?W7mlmCxgjДLY:*JiZ0>gpFQI7252~Aչ ^ԛ.LB!KSKucu9~狂IipڈK)̭\Y% ץ,eC xsVq:u n7rS#,3fMYe.Bq˘Uy9cfhvƔz-%gYJ뼪f3lk;<ގڒl7]|@?ίM /UQ/TcV]Tłgzc(/qX8\4N!'p*CUZG &5n2Ұ(:JrտI& wq PĆ*ke42XK`b)JOjuG~>jPVZqɹ6HNCc9*cQOc5cx ZI}K/YT&<t w*͎6|vY}қ0z1 99PFI+2Zh[\om~;>hfzK@=mY()8zihl74ㅃoO3YQ=WX]o X|@y>K|34lUC[ p/x<ۯH39٘O}. D;{\fYHl.;_݇^5)L{bNu{Ie3KiU(\U&0! [)IlmYB/N#@9zF0XoW8UUp&y,pKqz2ݪiWއ{~M'8j4s1 a9ڜM>}Xb/- ++% _$3փ]mqx?<.kb:8ϭ*%$`Y:u7Gziqۻ>::֤j Y@jq1֯=TW"r{]Ghx%JQЀfPWJ,,EٹR]-n Nv:锻ˆ?&Mӹv1g%Ƭγ7eu3pDe)? 1=f2Ƌ?Z-lTW մ ,k2V`W8xLOOGQmR3&=< A'RWҡt)mEBunj'(l /:F宾XnxD).sW(E.h,JXbS #nZbet [b}gZo@'4CnEE#@8ٮ6& fYN ~cBc7&Y#Lbp4xyD:Q6.d?<C\}МQuߴiCC8/G}K#ugbO;=B~D—a|p )SVBΤ1⪪UŊz>zbmzov (e@J.A ߐB Xuq"42`iLb,G7ix# ɺ*rU.U !c8ã)qė_ε3Xv,V*;**DaNPUhņ߭&Tl~T %%;V]9..sW3]e&ʂeRv*P)rvNYve(2.# `s9(\sA;<0+fdݢRJ(כM>wVE"gm G}U\ibށR -$.53“ĉ%/χi׻U:h\8TG] ֠hR Hv#9p4$8ԝG9)imz+DH+Ȟߵk St?_,,L7!sÝ<{҈BvM{(|/DCۭvI'\@*jhW#l|9Gmსs j}|ItA1>S;iU'ovu&Hg.}W}\+ .60) .tp ܝw܏4/kC]nJOZ:NEq8ј-.5r) { WP +#'򤖘MPsǻ@05BZ+܏(тT/*ïqr[c ۯ.zA6OcJ[BY5e|.v<XUѱy?H"99*jԸ*c^$"u3E/'} ]*?>gI{1049Y|Vbsm3*̠ uJ 6zv >엘a ri b?`$$KH%$ BGʇ}=l>Nնi~{|C]<]Sl RNb|uxWM'iV/3Grƙ,((}=9ca*53ӣ߇?9t|:CY\w}yu Ѹ^8Y<@A%jNĺ#͟M=hwn@/FN3S32;95WƖn0U֜-2{rs~d߮f51JaAi!|l>Sq%'[qw3 ˌ+y,.WA &=8` ί_ow&8X|t?z˹;6~Lp7M mB&4c Ҿ 685.,WiG~VfH/$5$RFRfCIǕn>gcClumF_豛KW3L0kardaoI0շ\;[q Kazw߭g@aI6U=ָ9`[ge}?>ĉrKqL8$"=e菤=TDݑ,ȟ>/m!(,U|5mP3?&ncPc~q/'}(=32ziPLW$+(MJeCD;&jSku ׎G"71'2}q1jdd^1SϨBZ+B%W^zf>gv.wG'&Սđ̴Vcv"|kw+`$|T$dyiLk])i#!$ӾxuKVqރ ;8Zh4. BnjF[MMMہGvnׇF辟7aS6c)U1'o~8z30=cgTgtbpF^c hsiv&9q R{-#b,8nAS0[0/afP8EkM 5j{_6m,>`/bhNK$<ҫKα uG7aċ5^5|; [#IvM/ [_sZ=3ڸ.sZfL>MIgpLcfHdȪDG~pno[]|?!YDž[i8boކM <.cwas侞 !5BFW^/Nn]AK]!@ThR4/mm>FIC+}ﰳ䲈0hnj=Ay\p5UAfZUraMS);x>_y=ct_QD/jpTV͹6 DNp[pi.2i%3I&<,s\Ө*^BB7kCR\i1}?-ϲ2O ՞c-s8\g<8<<}n q΅z.K|lek','g]Q;IX/3]:d;6ZCg$,:vq } v?~ H ^TyŁ(8:w~?ڬu\q3FsZJ@%a+x3T5SxLSe vf^zqIuއM6&Y{p$Bazc8ɚuN 5<Kl:R׸S1]=~AYY-)w}zX^~Z+Fɨ?*U! ])k Z6'Tx1$Z#*aA\հJn$1[Rܥ즪o7n]M. FcA[4\vhou/Ohj|{No?Ѕ>T(__~SЈ:>C; wߟgd&9vWs(8!q78VBh=Z:~w]H'Cǩ#ۂ*-bwx-ADy+7]tƅRGz& /`t)Gdo :s~ m۬G=XpU &^ܸ N7M W??OY/D V>x&r+d赛{bd..)-U`*ߴfkϜU3if}ۿsHq-ǙqCd4&ܺXh$g; vİGpzW>TҶ~K= 𥔁ݰ} x_]Zc]|6CpukM{hk|]aqZ'?=5;hccIИa:_nrQq.%D Nwc.Z̘EVIʗ)ee|w?Kݴó`TYx.fDLm}_?=?RZmbzaN7 K7h 㥷kʡVRQ3;>Co' 0X.EʳstIE ~}vO.t.3.I&msJGag(ljy^1PO@2}E}(&vu̿8̸mYnJCA:y?0 mt38RtQ|^*Ʈ q_I_[õ\1lrU`Ѣzkj+ 4n$ޫ'\6#5kd?Z"⮻3F(sT".Wۨ/vsXDmo#gό̐w9hah 1,OG9ՠUNqOISOώBtm\?TcTOUƅE7-C|qT\ESz<vdpo'v2MX?! c57ei*M" nihpakDmWŸIsɴ6!d]jNv}wpäWJп/ }m Ǩ:]ω|_ŬOO19$>\K|MVG|.^Jï@5]mSqHRws\./9%SB,K]RY!n-ƙ:6 6>}_`I,yZ)x&x"18KQJ !o|zMrtJKC$2M{6#J鞹\>S/#ύ`L|EM .Z_"ۧ|.B#3A(D/aҘ0Vf) #ta]U /H?B6YKN&E .7$8C6:Ѧ6m9 Rl'{.&ZQY!a S\2My{T0.1]3%7oF{D/zۼń:ZY~I]R/,ݟa?\9wG`gOwMsW>B4o5nrUXTᲛGQ(dhI0f*{$v^W񪭱lh ڠTdt169~"=~vm)_Kr4b;FrC^ \JS;:pއ;<6Ͽ}Jq}eO| BTΦLTm̓F'l'I% Px+tEjt  Ÿ?:o!ݴS/\BŞX*0 `nXatZ0 ې6r5Ix^s\aь'ZD%۠@\KF9_7َx%tۮB;>*b~S]yO4}q6S2|Dԕ R?\Q_S!Et٬)uA&$]2$!h\3z qэ;Rf*;vfm- Nt|LJN=SyjĸX^kԵd׵s^NJJ jeodow~yksoa# lkxK+6:}֦Ǖ`I * |2dH=jcGbEӳϔ9 ]ӬIn.3F7G&%,+9 ueJŝ e1~ˮVS,'EB#=|M:RݛZ۝Yѕ\c6D"4IVJ>qQgXe:= 5w‹ʼ#I7U9g8Z]E?.%R2^e^ ܦ^j!$ z@5'l6С2pw",c{r91yfXJ']EۗyvUυmݭ cX V51"k; aYE<x*++|}ssn6S_7eǗ2'rV o&mZ>B.K68Dqhu:ly\ 3")EQ `9j~nO>KF LXhK Sȇ). &ucIHAI:?nTMqi\iCyy6#Ԡ<Nr: ix}pXʘ&ԅ}GܸP5{?= A DRϬc}X?A953ե(IW_ﶻx8kJ;E)d SR6D04( SΟ Uœ;@"-zI#mJ:8}}7k܆F?ށtF̄bY/ᰊ̚Lꊝf.r]mvb_nGC䛏+|ߴz8ʃM *ZD P$8ߏ: >SQq% =L`"MԂ UN8 pjjӭ(0 fC]0`&?O=0xJb.V܉LWo~7~awC-09ԫCJa@j| E1s2CdF89vDlӅ6:vxNſZI7//B1KG;Ľ/M"FE%0Za+ִ}~q9m۶ƪ1yoMW)&\P IHѸ6zC_<&Sۛ} QGut*m^ ڈs1cTYp$x)]ߝBƅ*Ǩ~DօtY-.5ձ>K\&ċߜCߜ| }>U0>F-RZKi.a\U2p+d-]Gyv4)z'Pp+I=^r[fC`X9nCŧy_u/ ~L[o?SHNWh`4U=3jQ\?H8Ơ=BbM99vY])Se?7 Z[QY`W%MYkS[j)_$07]9^S&*~M=-|iw\m_gק>d8E}TclhO' %[*WO{_H[vwFf?>R7*iGMn6̍Ce::ҕ:N]# wIU wa`;s~ҝ4Bw66211:U2AkKnoC+-9bP[e87dWҸf鎅ϣ3$]-m v]"G2wzÓ┎L𣱡A7j-GEH]6ޒxpR!!:uImv5(+1xO*$5$@Ӭ)N T:+^٭>^C4*DqMH̅ u*x^2VT ş?pvcHvԂDxC&Oow5ő5p7в:" _YvTCi\X&hG!=8T=azf_1B+fj s.ʠ|P oRQ|7dvl [bժmf4DH%ez'쑌.ׂ>1ڳkM;.loB [8&!B* fw+{=hov wXq8O#A}\H}';?ўrr?g_>ck+HCɸ_x/W]i;scPBl_ tAqrP!t )U78=~OS'&桺_ך.1y=njmPf/ qA |; .Ɛ]Qc5@ݸ mm}yd}|%vKQ&ծweDA!fe]?W?V>>Ѕ&1  (iλX. Lg^{2=1} d8rڱxirѾ$4Y0cGχl.n7p6b.e9*=>61A'^߇_8+IW ]*Cw? +#Vݭ,XQغ#}3> ZX Z\\Wf1JwTIdBQS ݝ_kmfMfiAWU?Blouؽ?Be.6So](tşi!p%@(%73W2Z6$W"cEe:DBC ZMsDEI `vgtI~=J|`+#(KRIrي㲓TNrKgf+"wMXJoz^~݃/'w'^~<-I:_b^ ~l6k07pmm.Gf}_>f%cr;c|߳ c XmZ ^k½i C_SJ_!_ WOyC9.hx;!XI:98;$]cwvDk݈>ժ3Ƈ״1Ƹ ܀(u$%^!c1/t V:Vb01qk$nQ\{F'J^)!d JR~ 9RCz;ӐϻE`|(6r#ܕ^r`C-s_e3yJMj}c>5aBfƣFzȒe )C}nI/{|1Q|0c4?It/U>!|?nE(5u$'dˈҊE I)0>Yy8Xx=rY9;gcmz%[W}wk A>.K>eU-W]=`ųFۯzHZ8ӰA'* mO/{h|:u 5H#SD*Q)|y<eNH6ܹ[u?oyy,]i/Azx B IBAɇ%}'lv9a+&h=&|`c뎠i@"zڞkoͳG̋b5I35̱B tEy7L9vl!q)}{7E6}_L~KEܴͪـ`E.uelK_ZםlEB%ݪM/\R{-Ҕ'Ө . gq.Uނ_O}w "4ebpa$CzbQ>$'vSYg/VXA"Cg4tu-Qb'qi_;e5x0i@֡Alʱu餚YQ2_ͻ"3>]аDh*XZ5$&劈oZOnVyQ.{ST;EGXC٤Pnڠ^4~ZxWeH=S=VzW4C3Sj`r*n#6HAݻ!f9X!4[2BEpkO+$ayJV!z7~WXowy ™ h*$ќ"?YR >37$E ?Xp8wIMaV6ɬjFo*[yqj4eM5yVEZE?7%AGK S#0yhN7t o}Xh.DLi&US`a=EҚ|no_w8Zf~~doˌ5+3zЄ|V]oiXxTeOh4A43(v4_9?E9LhRT§|Qo;~'`5_?澮G$?m4 ~4nl`N%VѭQ\*.zU$-''(J HI-AH!D$*ns ? 8']4AZ.0T ++H#a'y>eYUY> mmi.a ×5 Yi=x/-]NJJ"ph!Ō"KKsE>;;S4|+"dʋgݑEyYh& S JNĀ'V>FE,Pyo.\ א[9P3:sRoЉ"u2ڡ݆w_-e{= Zsr0wKxP}uFZLidN 4;?׭rSLp݌}G[lX9H7k5̰m Ub+2hI#SG0sFݗ|( hmH?'BCGenomicAlignments/inst/unitTests/0000755000175100017510000000000012607264575020172 5ustar00biocbuildbiocbuildGenomicAlignments/inst/unitTests/test_GAlignments-class.R0000644000175100017510000000221312607264575024665 0ustar00biocbuildbiocbuildtest_GAlignments_constructor <- function() { checkTrue(validObject(GAlignments())) checkTrue(validObject(GAlignments(seqnames=factor("A"), pos=1L, cigar="1M", strand=strand("-")))) } test_GAlignments_seqlevels <- function() { gal0 <- GAlignments(seqnames=Rle(c("chr1", "chr2")), pos=as.integer(c(10, 100)), cigar=c("50M", "50M"), strand=strand(c("*", "*"))) ## Drop gal <- gal0 seqlevels(gal, force=TRUE) <- "chr2" checkIdentical("chr2", seqlevels(gal)) ## Rename gal <- gal0 seqlevels(gal)[seqlevels(gal) == "chr2"] <- "2" checkIdentical(c("chr1", "2"), seqlevels(gal)) } test_GAlignments_combine <- function() { galn <- GAlignments(seqnames=factor("A"), pos=1L, cigar="1M", strand=strand("-")) galn_c <- GAlignments(seqnames=rep(factor("A"), 2), pos=rep(1L, 2), cigar=rep("1M", 2), strand=rep(strand("-"), 2)) checkIdentical(galn_c, c(galn, galn)) } GenomicAlignments/inst/unitTests/test_GAlignmentsList-class.R0000644000175100017510000001144312607264575025526 0ustar00biocbuildbiocbuild.noGaps <- GAlignments( Rle(factor(c("chr1", "chr2", "chr1", "chr3")), c(1, 3, 2, 4)), pos=1:10, cigar=paste0(10:1, "M"), strand=Rle(strand(c("-", "+", "*", "+", "-")), c(1, 2, 2, 3, 2)), names=head(letters, 10), score=1:10) .Gaps <- GAlignments( Rle(factor(c("chr2", "chr4")), c(3, 4)), pos=1:7, cigar=c("5M", "3M2N3M2N3M", "5M", "10M", "5M1N4M", "8M2N1M", "5M"), strand=Rle(strand(c("-", "+")), c(4, 3)), names=tail(letters, 7), score=1:7) GAList <- GAlignmentsList(a=.noGaps, b=.Gaps) quiet <- suppressWarnings test_GAlignmentsList_construction <- function() { checkTrue(validObject(GAlignmentsList())) checkTrue(validObject(new("GAlignmentsList"))) checkTrue(validObject(GAlignmentsList(.noGaps, .Gaps))) checkTrue(validObject(GAlignmentsList(GAlignments()))) checkTrue(validObject(GAlignmentsList(a=GAlignments()))) checkException(GAlignmentsList(GRanges()), silent = TRUE) } test_GAlignmentsList_coercion <- function() { galist <- GAlignmentsList(a=.noGaps[seqnames(.noGaps) == "chr3"], b=.Gaps[seqnames(.Gaps) == "chr4"]) ## RangesList rgl <- rglist(galist) checkIdentical(length(galist), length(rgl)) for (i in seq_along(galist)) { target <- unlist(rglist(galist[[i]]), use.names=FALSE) checkIdentical(target, rgl[[i]]) } ## GRangesList grl <- grglist(galist) checkIdentical(length(galist), length(grl)) for (i in seq_along(galist)) { target <- unlist(grglist(galist[[i]]), use.names=FALSE) checkIdentical(target, grl[[i]]) } ## Ranges checkIdentical(length(ranges(galist)), length(ranges(galist[1])) + length(ranges(galist[2]))) checkIdentical(length(quiet(granges(galist))), length(quiet(granges(galist[1]))) + length(quiet(granges(galist[2])))) checkIdentical(length(granges(galist, ignore.strand=TRUE)), length(granges(galist[1], ignore.strand=TRUE)) + length(granges(galist[2], ignore.strand=TRUE))) gr <- granges(galist, ignore.strand=TRUE) ir <- ranges(galist) checkIdentical(length(gr), length(ir)) gr <- quiet(granges(galist, ignore.strand=FALSE)) checkTrue(length(gr) == 4L) ## data.frame galist <- GAlignmentsList(a=.noGaps[1:2], b=.Gaps[1:2]) df <- data.frame(group=togroup(galist), group_name=names(galist)[togroup(galist)], seqnames=c("chr1", rep("chr2", 3)), strand=c("-", "+", "-", "-"), cigar=c("10M", "9M", "5M", "3M2N3M2N3M"), qwidth=c(10, 9 , 5, 9), start=c(1, 2, 1, 2), end=c(10, 10, 5, 14), width=c(10, 9, 5, 13), njunc=c(0, 0, 0, 2), score=c(1, 2, 1, 2), row.names=c("a", "b", "t", "u"), stringsAsFactors=FALSE) checkTrue(all.equal(as.data.frame(galist), df)) ## introns galist <- GAList grl <- junctions(galist) checkIdentical(names(galist), names(grl)) checkTrue(length(galist) == length(grl)) checkTrue(length(grl[[1]]) == 0L) checkTrue(length(grl[[2]]) == 4L) ## empty ranges galist <- GAlignmentsList( GAlignments("chr1", 20L, "10M", strand("+")), GAlignments()) checkTrue(length(ranges(galist)) == 1L) checkTrue(length(rglist(galist)) == 2L) checkTrue(length(granges(galist)) == 1L) checkTrue(length(grglist(galist)) == 2L) } test_GAlignmentsList_accessors <- function() { galist <- GAlignmentsList(.noGaps, .Gaps) target <- RleList(lapply(GAList, seqnames), compress=TRUE) checkIdentical(seqnames(GAList), target) target <- RleList(lapply(GAList, rname), compress=TRUE) checkIdentical(rname(GAList), target) target <- CharacterList(lapply(GAList, cigar), compress=TRUE) checkIdentical(cigar(GAList), target) target <- RleList(lapply(GAList, strand), compress=TRUE) checkIdentical(strand(GAList), target) target <- IntegerList(lapply(GAList, width)) checkIdentical(width(GAList), target) target <- SplitDataFrameList(lapply(GAList, mcols)) checkIdentical(mcols(GAList, level="within"), target) } test_GAlignmentsList_subset_combine <- function() { galist <- GAList score <- 1:length(togroup(galist)) meta <- DataFrame(score=score, more=score+10) mcols(galist@unlistData) <- meta ## 'c' checkIdentical(GAlignmentsList(), c(GAlignmentsList(), GAlignmentsList())) checkIdentical(GAlignmentsList(.noGaps, .Gaps), quiet(c(GAlignmentsList(.noGaps), GAlignmentsList(.Gaps)))) ## '[' checkIdentical(galist, galist[]) checkIdentical(galist, galist[Rle(TRUE)]) checkIdentical(galist[c(TRUE, FALSE),], galist[1]) } GenomicAlignments/inst/unitTests/test_cigar-utils.R0000644000175100017510000001042612607264575023602 0ustar00biocbuildbiocbuild### test_cigarRangesAlongReferenceSpace <- function() { cigar <- c("30M5000N10M", "50M4S", "90=10X5I50M10D40M", "18M10I22M", "99I") pos <- c(101, 201, 1001, 301, 2001) seqlevels <- c("chr2", "chr6") rname <- factor(c("chr6", "chr6", "chr2", "chr6", "chr2"), levels=seqlevels) ops <- c("M", "=", "X", "I", "D") current <- as.list(cigarRangesAlongReferenceSpace(cigar, pos=pos, f=rname, ops=ops)) ir2 <- IRanges(start=c(1001, 1091, 1101, 1101, 1151, 1161, 2001), end=c(1090, 1100, 1100, 1150, 1160, 1200, 2000)) ir6 <- IRanges(start=c(101, 5131, 201, 301, 319, 319), end=c(130, 5140, 250, 318, 318, 340)) target <- list(chr2=ir2, chr6=ir6) checkIdentical(target, current) current <- as.list(cigarRangesAlongReferenceSpace(cigar, pos=pos, f=rname, ops=ops, reduce.ranges=TRUE)) ir2b <- c(reduce(ir2[1:6]), reduce(ir2[7])) ir6b <- c(reduce(ir6[1:2]), reduce(ir6[3]), reduce(ir6[4:6])) target <- list(chr2=ir2b, chr6=ir6b) checkIdentical(target, current) current <- as.list(extractAlignmentRangesOnReference(cigar, pos=pos, f=rname)) checkIdentical(target, current) current <- as.list(cigarRangesAlongReferenceSpace(cigar, pos=pos, f=rname, ops=setdiff(ops, "D"))) ir2 <- ir2[-5] target <- list(chr2=ir2, chr6=ir6) checkIdentical(target, current) current <- as.list(cigarRangesAlongReferenceSpace(cigar, pos=pos, f=rname, ops=setdiff(ops, "D"), reduce.ranges=TRUE)) ir2 <- c(reduce(ir2[1:5]), reduce(ir2[6])) ir6 <- c(reduce(ir6[1:2]), reduce(ir6[3]), reduce(ir6[4:6])) target <- list(chr2=ir2, chr6=ir6) checkIdentical(target, current) current <- as.list(extractAlignmentRangesOnReference(cigar, pos=pos, drop.D.ranges=TRUE, f=rname)) checkIdentical(target, current) } test_cigarQNarrow <- function() { cigar <- c("25M4D10M", "6S17M6I3M3S") ans <- cigarQNarrow(cigar) ans0 <- cigar attr(ans0, "rshift") <- c(0L, 0L) checkIdentical(ans, ans0) ans <- cigarQNarrow(cigar, start=3, end=-3) ans0 <- c("23M4D8M", "4S17M6I3M1S") attr(ans0, "rshift") <- c(2L, 0L) checkIdentical(ans, ans0) ans <- cigarQNarrow(cigar, start=7, end=-4) ans0 <- c("19M4D7M", "17M6I3M") attr(ans0, "rshift") <- c(6L, 0L) checkIdentical(ans, ans0) ans <- cigarQNarrow(cigar, start=8, end=-5) ans0 <- c("18M4D6M", "16M6I2M") attr(ans0, "rshift") <- c(7L, 1L) checkIdentical(ans, ans0) ans <- cigarQNarrow(cigar, start=25) ans0 <- c("1M4D10M", "5I3M3S") attr(ans0, "rshift") <- c(24L, 17L) checkIdentical(ans, ans0) ans <- cigarQNarrow(cigar, start=26) ans0 <- c("10M", "4I3M3S") attr(ans0, "rshift") <- c(29L, 17L) checkIdentical(ans, ans0) ans <- cigarQNarrow(cigar, start=26, end=-8) ans0 <- c("3M", "3I") attr(ans0, "rshift") <- c(29L, 17L) checkIdentical(ans, ans0) ans <- cigarQNarrow(cigar, start=26, end=-10) ans0 <- c("1M", "1I") attr(ans0, "rshift") <- c(29L, 17L) checkIdentical(ans, ans0) } test_cigarNarrow <- function() { cigar <- c("25M4D10M", "6S17M6I3M3S") ans <- cigarNarrow(cigar) ans0 <- c("25M4D10M", "17M6I3M") attr(ans0, "rshift") <- c(0L, 0L) checkIdentical(ans, ans0) ans <- cigarNarrow(cigar, start=3, end=-3) ans0 <- c("23M4D8M", "15M6I1M") attr(ans0, "rshift") <- c(2L, 2L) checkIdentical(ans, ans0) ans <- cigarNarrow(cigar, start=7, end=-4) ans0 <- c("19M4D7M", "11M") attr(ans0, "rshift") <- c(6L, 6L) checkIdentical(ans, ans0) ans <- cigarNarrow(cigar, start=8, end=-5) ans0 <- c("18M4D6M", "9M") attr(ans0, "rshift") <- c(7L, 7L) checkIdentical(ans, ans0) ans <- cigarNarrow(cigar[1], start=26, end=-10) ans0 <- "1M" attr(ans0, "rshift") <- 29L checkIdentical(ans, ans0) } GenomicAlignments/inst/unitTests/test_coordinate-mapping-methods.R0000644000175100017510000001166012607264575026601 0ustar00biocbuildbiocbuild## CIGAR ops M, =, X x1 <- GRanges("chr1", IRanges(c(5, 10, 20, 25), width=2, names=LETTERS[1:4])) align1 <- GAlignments(rep("chr1", 3), rep(10L, 3), c("11M", "11=", "11X"), strand(rep("+", 3)), names=letters[1:3]) ## CIGAR ops S, N, D, I, H, P x2 <- GRanges("chr1", IRanges(c(1, 20), width=6, names=LETTERS[1:2])) cigar <- c("1S6M1S", "3M2N3M", "3M2D3M", "3M2I3M", "1H6M1H", "1P6M1P") align2 <- GAlignments(rep("chr1", 6), rep(10L, 6), cigar, strand(rep("+", 6))) align3 <- GAlignments(rep("chr1", 6), rep(20L, 6), cigar, strand(rep("+", 6))) names(align2) <- names(align3) <- letters[1:6] test_mapToAlignments <- function() { ans <- mapToAlignments(x1, align1) checkIdentical(start(ans), rep(1L, 3)) checkIdentical(end(ans), rep(2L, 3)) checkIdentical(mcols(ans)$xHits, c(rep(2L, 3))) checkIdentical(mcols(ans)$alignmentsHits, c(1L, 2L, 3L)) checkIdentical(names(ans), rep("B", 3)) checkIdentical(seqlevels(ans), letters[1:3]) ans <- mapToAlignments(x2, align3) checkIdentical(end(ans), c(7L, 4L, 4L, 8L, 6L, 6L)) checkIdentical(mcols(ans)$alignmentsHits, as.integer(1:6)) } test_mapFromAlignments <- function() { x <- x1 names(x) <- rep("all", length(x)) align <- align1 names(align) <- rep("all", length(align)) ans <- mapFromAlignments(x, align) checkIdentical(start(ans), c(14L, 14L, 14L, 19L, 19L, 19L)) checkIdentical(mcols(ans)$xHits, c(rep(1L, 3), rep(2L, 3))) checkIdentical(mcols(ans)$alignmentsHits, rep(1:3, 2)) checkIdentical(seqlevels(ans), "chr1") checkIdentical(names(ans), rep("all", 6)) names(x) <- c("hit", "hit", "blank", "blank") names(align) <- c("BLANK", "hit", "BLANK") ans <- mapFromAlignments(x, align) checkIdentical(names(ans), c("hit", "hit")) checkIdentical(seqlevels(ans), "chr1") x <- x2 names(x) <- rep("all", length(x)) align <- align2 names(align) <- rep("all", length(align)) ans <- mapFromAlignments(x, align) checkIdentical(start(ans), rep(10L, 6)) checkIdentical(end(ans), c(15L, 17L, 17L, 13L, 15L, 15L)) checkIdentical(mcols(ans)$alignmentsHits, as.integer(1:6)) } test_pmapToAlignments <- function() { x <- x1 align <- rep(align1[1], length(x1)) ans <- pmapToAlignments(x, align) checkIdentical(length(ans), length(x)) checkIdentical(width(ans), c(0L, 2L, 0L, 0L)) checkIdentical(start(ans), c(0L, 1L, 0L, 0L)) checkIdentical(end(ans), c(-1L, 2L, -1L, -1L)) checkIdentical(names(ans), names(x)) checkTrue(all(seqlevels(ans) %in% c("a", "UNMAPPED"))) x <- rep(x2[2], length(align3)) align <- align3 ans <- pmapToAlignments(x, align) checkIdentical(width(ans), c(6L, 4L, 4L, 8L, 6L, 6L)) checkIdentical(start(ans), c(2L, rep(1L, 5))) checkIdentical(end(ans), c(7L, 4L, 4L, 8L, 6L, 6L)) } test_pmapFromAlignments <- function() { x <- x1 names(x) <- rep("all", length(x)) align <- rep(align1[1], length(x1)) names(align) <- rep("all", length(align)) ans <- pmapFromAlignments(x, align) checkTrue(ncol(mcols(ans)) == 0L) checkTrue(length(ans) == length(x1)) checkIdentical(width(ans), c(2L, 2L, 0L, 0L)) checkIdentical(start(ans), c(14L, 19L, 0L, 0L)) checkIdentical(names(ans), names(x)) checkTrue(all(seqlevels(ans) %in% c("chr1", "UNMAPPED"))) x <- rep(x2[1], length(align2)) names(x) <- LETTERS[seq_along(x)] align <- align2 ans <- pmapFromAlignments(x, align) checkIdentical(width(ans), c(6L, 8L, 8L, 4L, 6L, 6L)) checkIdentical(end(ans), c(15L, 17L, 17L, 13L, 15L, 15L)) checkIdentical(names(ans), names(x)) checkTrue(all(seqlevels(ans) %in% "chr1")) } test_ref_locs_to_query_locs <- function() { cigar <- "66S42M2I20M8I18D15M43243N5M1D38M1D85M1D115M139S" pos <- 525842L ref <- 43425L + pos - 1L query <- 238L ans <- .Call("ref_locs_to_query_locs", ref, cigar, pos, FALSE, PACKAGE="GenomicAlignments") checkIdentical(ans, query) ## out of bounds ans_s <- .Call("ref_locs_to_query_locs", start(x1[1]), cigar(align1[1]), start(align1[1]), FALSE, PACKAGE="GenomicAlignments") ans_e <- .Call("ref_locs_to_query_locs", end(x1[1]), cigar(align1[1]), start(align1[1]), TRUE, PACKAGE="GenomicAlignments") checkIdentical(ans_s, NA_integer_) checkIdentical(ans_e, NA_integer_) } test_query_locs_to_ref_locs <- function() { ## out of bounds ans_s <- .Call("query_locs_to_ref_locs", start(x1[4]), cigar(align1[1]), start(align1[1]), FALSE, PACKAGE="GenomicAlignments") ans_e <- .Call("query_locs_to_ref_locs", end(x1[4]), cigar(align1[1]), start(align1[1]), TRUE, PACKAGE="GenomicAlignments") checkIdentical(ans_s, NA_integer_) checkIdentical(ans_e, NA_integer_) } GenomicAlignments/inst/unitTests/test_findSpliceOverlaps-methods.R0000644000175100017510000002333612607264575026620 0ustar00biocbuildbiocbuild## TODO: Add tests for the following "findSpliceOverlaps" methods: ## findSpliceOverlaps,GAlignments,GRangesList ## findSpliceOverlaps,GAlignmentPairs,GRangesList ## findSpliceOverlaps,character,ANY ## findSpliceOverlaps,BamFile,ANY .extract <- function(x, col) as.logical(mcols(x)[[col]]) test_findSpliceOverlaps_compatible <- function() { genes <- GRangesList( GRanges("chr1", IRanges(5, 15), "+"), GRanges("chr1", IRanges(5, 15), "-")) reads <- GRangesList(GRanges("chr1", IRanges(3, 13), "+")) res <- findSpliceOverlaps(reads, genes[1]) checkIdentical(FALSE, .extract(res, "compatible")) res <- findSpliceOverlaps(reads, genes[2]) checkIdentical(logical(0), .extract(res, "compatible")) ## exact match to intron boundaries ## (no overlap between 'reads' and 'genes') genes <- GRangesList( GRanges("chr1", IRanges(c(5, 20), c(10, 25)), "+")) reads <- GRangesList( GRanges("chr1", IRanges(11, 19), "+")) res <- findSpliceOverlaps(reads, genes) checkIdentical(logical(0), .extract(res, "compatible")) ## overlap and span intron boundaries genes <- GRangesList( GRanges("chr1", IRanges(c(5, 20, 30), c(10, 25, 35)), "+")) reads <- GRangesList( GRanges("chr1", IRanges(5, 12), "+"), GRanges("chr1", IRanges(18, 23), "+"), GRanges("chr1", IRanges(c(4, 30), c(26, 36)), "+")) res <- findSpliceOverlaps(reads[1], genes) ## not a junction read checkIdentical(FALSE, .extract(res, "compatible")) res <- findSpliceOverlaps(reads[2], genes) ## not a junction read checkIdentical(FALSE, .extract(res, "compatible")) res <- findSpliceOverlaps(reads[3], genes) ## junction read checkIdentical(FALSE, .extract(res, "compatible")) } #test_findSpliceOverlaps_novelTSS <- function() #{ # ## strand # genes <- GRangesList( # GRanges("chr1", IRanges(5, 15), "+"), # GRanges("chr1", IRanges(5, 15), "-"), # GRanges("chr1", IRanges(5, 15), "*")) # reads <- GRangesList(GRanges("chr1", IRanges(3, 13), "+")) # res <- findSpliceOverlaps(reads, genes[1]) # checkIdentical(TRUE, .extract(res, "novelTSS")) # res <- suppressWarnings(findSpliceOverlaps(reads, genes[2])) # checkIdentical(logical(0), .extract(res, "novelTSS")) # res <- findSpliceOverlaps(reads, genes[3]) # checkIdentical(TRUE, .extract(res, "novelTSS")) # # ## multiple matches # genes <- GRangesList( # GRanges("chr1", IRanges(15, 20), "+"), # GRanges("chr1", IRanges(10, 20), "+"), # GRanges("chr1", IRanges(5, 20), "+")) # reads <- GRangesList(GRanges("chr1", IRanges(5, 20), "+")) # res <- findSpliceOverlaps(reads, genes[1]) # checkIdentical(TRUE, .extract(res, "novelTSS")) # res <- findSpliceOverlaps(reads, genes[1:2]) # checkIdentical(c(TRUE, TRUE), .extract(res, "novelTSS")) # res <- findSpliceOverlaps(reads, genes) # checkIdentical(c(FALSE, FALSE, FALSE), .extract(res, "novelTSS")) # # ## junctions # genes <- GRangesList( # GRanges("chr1", IRanges(c(5, 15), c(10, 20)), "+")) # reads <- GRangesList( # GRanges("chr1", IRanges(12, 23), "+"), # GRanges("chr1", IRanges(3, 18), "+")) # res <- findSpliceOverlaps(reads[1], genes) # checkIdentical(FALSE, .extract(res, "novelTSS")) # res <- findSpliceOverlaps(reads[2], genes) # checkIdentical(TRUE, .extract(res, "novelTSS")) #} #test_findSpliceOverlaps_novelTSE <- function() #{ # ## strand # genes <- GRangesList( # GRanges("chr1", IRanges(5, 15), "+"), # GRanges("chr1", IRanges(5, 15), "-"), # GRanges("chr1", IRanges(5, 15), "*")) # reads <- GRangesList(GRanges("chr1", IRanges(12, 18), "+")) # res <- findSpliceOverlaps(reads, genes[1]) # checkIdentical(TRUE, .extract(res, "novelTSE")) # res <- findSpliceOverlaps(reads, genes[2]) # checkIdentical(logical(0), .extract(res, "novelTSE")) # res <- findSpliceOverlaps(reads, genes[3]) # checkIdentical(TRUE, .extract(res, "novelTSE")) # # ## multiple matches # genes <- GRangesList( # GRanges("chr1", IRanges(5, 15), "+"), # GRanges("chr1", IRanges(5, 20), "+"), # GRanges("chr1", IRanges(5, 25), "+")) # reads <- GRangesList(GRanges("chr1", IRanges(5, 25), "+")) # res <- findSpliceOverlaps(reads, genes[1]) # checkIdentical(TRUE, .extract(res, "novelTSE")) # res <- findSpliceOverlaps(reads, genes[1:2]) # checkIdentical(c(TRUE, TRUE), .extract(res, "novelTSE")) # res <- findSpliceOverlaps(reads, genes) # checkIdentical(c(FALSE, FALSE, FALSE), .extract(res, "novelTSE")) # # ## junctions # genes <- GRangesList( # GRanges("chr1", IRanges(c(5, 15), c(10, 20)), "+")) # reads <- GRangesList( # GRanges("chr1", IRanges(2, 12), "+"), # GRanges("chr1", IRanges(18, 23), "+")) # res <- findSpliceOverlaps(reads[1], genes) # checkIdentical(FALSE, .extract(res, "novelTSE")) # res <- findSpliceOverlaps(reads[2], genes) # checkIdentical(TRUE, .extract(res, "novelTSE")) #} #test_findSpliceOverlaps_novelExon <- function() #{ # genes <- GRangesList( # GRanges("chr1", IRanges(c(5, 20), c(10, 25)), "+")) # ## 'within' intron boundaries # reads <- GRangesList( # GRanges("chr1", IRanges(c(7, 12, 20), c(10, 18, 23)), "+")) # res <- findSpliceOverlaps(reads, genes) # checkIdentical(TRUE, .extract(res, "novelExon")) # # ## FIXME :currently TRUE # ## Do we want a novel exon to be completely w/in? # reads <- GRangesList( # GRanges("chr1", IRanges(c(5, 9, 20), c(7, 12, 23)), "+"), # GRanges("chr1", IRanges(c(7, 15, 23), c(10, 21, 25)), "+")) # res <- findSpliceOverlaps(reads[1], genes) # checkIdentical(TRUE, .extract(res, "novelExon")) # res <- findSpliceOverlaps(reads[2], genes) # checkIdentical(TRUE, .extract(res, "novelExon")) # # ## region not 'intronic' in all transcripts # genes <- GRangesList( # GRanges("chr1", IRanges(c(5, 20), c(10, 25)), "+"), # GRanges("chr1", IRanges(c(5, 20), c(15, 25)), "+")) # reads <- GRangesList( # GRanges("chr1", IRanges(c(7, 12, 20), c(10, 18, 23)), "+")) # res <- findSpliceOverlaps(reads, genes) # checkIdentical(c(FALSE, FALSE), .extract(res, "novelExon")) #} #test_findSpliceOverlaps_novelRetention <- function() #{ # genes <- GRangesList( # GRanges("chr1", IRanges(c(5, 20), c(10, 25)), "+")) # ## 'within' intron boundaries # reads <- GRangesList( # GRanges("chr1", IRanges(c(7, 12, 20), c(10, 18, 23)), "+")) # res <- findSpliceOverlaps(reads, genes) # checkIdentical(TRUE, .extract(res, "novelRetention")) # # ## exact match to intron boundaries # ## (no overlap between 'reads' and 'genes') # reads <- GRangesList( # GRanges("chr1", IRanges(11, 19), "+")) # res <- findSpliceOverlaps(reads, genes) # checkIdentical(logical(0), .extract(res, "compatible")) # # ## overlap and span intron boundaries # genes <- GRangesList( # GRanges("chr1", IRanges(c(5, 20, 30), c(10, 25, 35)), "+")) # reads <- GRangesList( # GRanges("chr1", IRanges(5, 12), "+"), # GRanges("chr1", IRanges(18, 23), "+"), # GRanges("chr1", IRanges(c(4, 30), c(26, 36)), "+")) # res <- findSpliceOverlaps(reads[1], genes) ## not a junction read # checkIdentical(TRUE, .extract(res, "novelRetention")) # res <- findSpliceOverlaps(reads[3], genes) ## junction read # checkIdentical(TRUE, .extract(res, "novelRetention")) # # ## FIXME : hits a portion of the intronic region # ## but is not completely 'within' # ## region is not 'intronic' in all transcripts # genes <- GRangesList( # GRanges("chr1", IRanges(c(5, 20), c(10, 25)), "+"), # GRanges("chr1", IRanges(c(5, 20), c(15, 25)), "+")) # reads <- GRangesList( # GRanges("chr1", IRanges(4, 26), "+")) # res <- findSpliceOverlaps(reads[1], genes) # checkIdentical(c(TRUE, TRUE), .extract(res, "novelRetention")) #} # #test_findSpliceOverlaps_novelSite <- function() #{ # genes <- GRangesList( # GRanges("chr1", IRanges(c(5, 15), c(10, 20)), "+")) # ## single novel site, novel junction # reads <- GRangesList( # GRanges("chr1", IRanges(c(5, 15), c(7, 20)), "+")) # res <- findSpliceOverlaps(reads, genes) # checkIdentical(TRUE, .extract(res, "novelSite")) # checkIdentical(TRUE, .extract(res, "novelJunction")) # # ## two novel sites, novel junction # reads <- GRangesList( # GRanges("chr1", IRanges(c(5, 17), c(7, 20)), "+")) # res <- findSpliceOverlaps(reads, genes) # checkIdentical(TRUE, .extract(res, "novelSite")) # checkIdentical(TRUE, .extract(res, "novelJunction")) #} # #test_findSpliceOverlaps_novelJunction <- function() #{ # ## novel junction, no novel sites # genes <- GRangesList( # GRanges("chr1", IRanges(c(5, 20), c(10, 25)), "+"), # GRanges("chr1", IRanges(c(5, 22), c(15, 25)), "+")) # # ## query = GRanges # reads <- GRangesList( # GRanges("chr1", IRanges(c(5, 20), c(15, 25)), "+")) # GRres <- findSpliceOverlaps(reads, genes) # checkIdentical(c(TRUE, TRUE), .extract(GRres, "novelJunction")) # checkIdentical(c(FALSE, FALSE), .extract(GRres, "novelSite")) # # ## query = GAlignments # gal <- GAlignments("chr1", 5L, "11M4N6M", strand("+")) # GALres <- findSpliceOverlaps(gal, genes) # checkIdentical(c(TRUE, TRUE), .extract(GALres, "novelJunction")) # checkIdentical(c(FALSE, FALSE), .extract(GALres, "novelSite")) # # ## query = GAlignmentPairs # gal1 <- GAlignments("chr1", 5L, "11M4N6M", strand("+")) # gal2 <- GAlignments("chr1", 50L, "6M", strand("-")) # galp <- GAlignmentPairs(gal1, gal2) # GALPres <- findSpliceOverlaps(galp, genes) # checkIdentical(c(TRUE, TRUE), .extract(GALPres, "novelJunction")) # checkIdentical(c(FALSE, FALSE), .extract(GALPres, "novelSite")) #} GenomicAlignments/inst/unitTests/test_intra-range-methods.R0000644000175100017510000000315212607264575025225 0ustar00biocbuildbiocbuild.noGaps <- GAlignments( Rle(factor(c("chr1", "chr2", "chr1", "chr3")), c(1, 3, 2, 4)), pos=1:10, cigar=paste0(10:1, "M"), strand=Rle(strand(c("-", "+", "*", "+", "-")), c(1, 2, 2, 3, 2)), names=head(letters, 10), score=1:10) .Gaps <- GAlignments( Rle(factor(c("chr2", "chr4")), c(3, 4)), pos=1:7, cigar=c("5M", "3M2N3M2N3M", "5M", "10M", "5M1N4M", "8M2N1M", "5M"), strand=Rle(strand(c("-", "+")), c(4, 3)), names=tail(letters, 7), score=1:7) test_GAlignments_qnarrow <- function() { gal <- GAlignments(seqnames=rep(factor("A"), 8), pos=10:17, cigar=c("5M", "5X", "3M2I3M", "3M2D3M", "3M2N3M", "3M2S3M", "3M2H3M", "3M2P3M"), strand=Rle(strand(rep("+", 8)))) n1 <- narrow(gal, start=3) q1 <- qnarrow(gal, start=3) checkIdentical(qwidth(n1), qwidth(q1)) checkIdentical(width(n1), width(q1)) n2 <- narrow(gal, start=4) q2 <- qnarrow(gal, start=4) checkIdentical(width(n2), width(q2)) ## M and X checkIdentical(qwidth(n2[1:2]), qwidth(q2[1:2])) ## I checkIdentical(qwidth(q2[3]), width(q2[3]) + 2L) ## D, N and P checkIdentical(qwidth(q2[c(4,5,8)]), width(q2[c(4,5,8)])) ## S and H checkIdentical(qwidth(q2[6]), width(q2[6]) + 2L) checkIdentical(qwidth(q2[7]), width(q2[7])) } test_GAlignmentsList_qnarrow <- function() { galist <- GAlignmentsList(.noGaps[1:6], .Gaps) qn <- qnarrow(galist, end=-4) checkIdentical(qnarrow(galist[[1]], end=-4), qn[[1]]) checkIdentical(qnarrow(galist[[2]], end=-4), qn[[2]]) } GenomicAlignments/inst/unitTests/test_readGAlignmentPairs.R0000644000175100017510000002774512607264575025253 0ustar00biocbuildbiocbuild### test_readGAlignmentPairs.R # Flag bits summary # ----------------- # 0x1: template having multiple segments in sequencing # 0x2: each segment properly aligned according to the aligner # 0x4: segment unmapped # 0x8: next segment in the template unmapped # 0x10: SEQ being reverse complemented # 0x20: SEQ of the next segment in the template being reversed # 0x40: the first segment in the template # 0x80: the last segment in the template # 0x100: secondary alignment # 0x200: not passing quality controls # 0x400: PCR or optical duplicate make_samline <- function(QNAME, mapped=0, RNAME="*", POS=0, strand="+", primary=1, flagbits=0, RNEXT="*", PNEXT=0, proper=0) { FLAG <- 0x4 * (!mapped) + 0x10 * (strand == "-") + 0x100 * (!primary) + 0x2 * proper + flagbits if (mapped) { CIGAR <- "14M" } else { CIGAR <- "*" } paste(QNAME, FLAG, RNAME, POS, "255", CIGAR, RNEXT, PNEXT, "0", "*", "*", sep="\t") } make_mapped_pair <- function(QNAME, RNAME1, POS1, CIGAR1, strand1, RNAME2, POS2, CIGAR2, strand2, primary, proper, pair_id=NA) { flag0 <- 0x1 + 0x2 * proper + 0x100 * (!primary) FLAG1 <- flag0 + 0x40 + 0x10 * (strand1 == "-") + 0x20 * (strand2 == "-") FLAG2 <- flag0 + 0x80 + 0x10 * (strand2 == "-") + 0x20 * (strand1 == "-") line1 <- paste(QNAME, FLAG1, RNAME1, POS1, "255", CIGAR1, RNAME2, POS2, "0", "*", "*", sep="\t") line2 <- paste(QNAME, FLAG2, RNAME2, POS2, "255", CIGAR2, RNAME1, POS1, "0", "*", "*", sep="\t") if (!identical(pair_id, NA)) { pair_id_tag <- paste0("pi:Z:", pair_id) line1 <- paste(line1, pair_id_tag, sep="\t") line2 <- paste(line2, pair_id_tag, sep="\t") } c(line1, line2) } make_mapped_pairs <- function(mapped_pair_table) { if (!is.data.frame(mapped_pair_table)) { if (is.character(mapped_pair_table)) mapped_pair_table <- textConnection(mapped_pair_table) mapped_pair_table <- read.table(mapped_pair_table, header=TRUE, stringsAsFactors=FALSE) } row_groups <- unname(split(seq_len(nrow(mapped_pair_table)), mapped_pair_table$QNAME)) unlist(lapply(row_groups, function(row_group) { lines <- unlist(lapply(row_group, function(i) do.call("make_mapped_pair", mapped_pair_table[i, ]))) if (length(row_group) == 3L) { lines[c(2L, 4L, 6L)] <- lines[c(6L, 2L, 4L)] } else { lines[c(FALSE, TRUE)] <- rev(lines[c(FALSE, TRUE)]) } lines })) } make_toy_bamfile <- function(mapped_pair_table, filename) { lines0 <- c("@HD\tVN:1.3", "@SQ\tSN:chr1\tLN:2450", "@SQ\tSN:chr2\tLN:1882", "@SQ\tSN:chrX\tLN:999") ## Single end reads lines1 <- c( ## s001: 1 primary alignment make_samline("s001", mapped=1, RNAME="chr1", POS=10, strand="+", primary=1), ## s002: 1 primary alignment + 3 secondary alignments make_samline("s002", mapped=1, RNAME="chr1", POS=20, strand="+", primary=1), make_samline("s002", mapped=1, RNAME="chr1", POS=21, strand="+", primary=0), make_samline("s002", mapped=1, RNAME="chr1", POS=22, strand="+", primary=0), make_samline("s002", mapped=1, RNAME="chr1", POS=20, strand="+", primary=0), ## s003: unmapped make_samline("s003") ) ## Paired end reads lines2 <- c( ## Mapped pairs make_mapped_pairs(mapped_pair_table), ## p991: 1 pair with a missing mate (can happen if file was subsetted ## with e.g. filterBam) make_mapped_pair("p991", "chr2", 150, "18M", "+", "chr2", 199, "18M", "-", primary=1, proper=1)[2L], ## p992: 1 pair with 1st mate unmapped and 2nd mate mapped make_samline("p992", flagbits=0x1 + 0x40, RNEXT="chr2", PNEXT=150), make_samline("p992", mapped=1, RNAME="chr2", POS=150, strand="+", primary=1, flagbits=0x1 + 0x8 + 0x80), ## p993: 1 pair with both mates unmapped make_samline("p993", flagbits=0x1 + 0x8 + 0x40), make_samline("p993", flagbits=0x1 + 0x8 + 0x80) ) ## Reads with multiple segments lines3 <- c( ## m001: 3 segments in the template (index of each segment in template ## is known) make_samline("m001", mapped=1,, RNAME="chrX", POS=10, strand="+", flagbits=0x1 + 0x40, RNEXT="chrX", PNEXT=20, proper=1), make_samline("m001", mapped=1, RNAME="chrX", POS=20, strand="+", flagbits=0x1 + 0x40 + 0x80, RNEXT="chrX", PNEXT=30, proper=1), make_samline("m001", mapped=1, RNAME="chrX", POS=30, strand="+", flagbits=0x1 + 0x80, RNEXT="chrX", PNEXT=10, proper=1), ## m002: 3 segments in the template (index of each segment in template ## was lost) make_samline("m002", mapped=1, RNAME="chrX", POS=10, strand="+", flagbits=0x1, RNEXT="chrX", PNEXT=20, proper=1), make_samline("m002", mapped=1, RNAME="chrX", POS=20, strand="+", flagbits=0x1, RNEXT="chrX", PNEXT=30, proper=1), make_samline("m002", mapped=1, RNAME="chrX", POS=30, strand="+", flagbits=0x1, RNEXT="chrX", PNEXT=10, proper=1) ) samfile <- paste0(filename, ".sam") cat(c(lines0, lines1, lines2, lines3), file=samfile, sep="\n") bamfile <- asBam(samfile, filename, overwrite=TRUE) ## Should never happen. if (bamfile != paste0(filename, ".bam")) stop("asBam() returned an unexpected path") bamfile } ### 1 line per mapped pair. Each line will generate 2 lines/records in the ### SAM file. The pair_id field will be stored in the SAM/BAM file as a user ### defined tag ("pi" tag). mapped_pair_table <- " QNAME RNAME1 POS1 CIGAR1 strand1 RNAME2 POS2 CIGAR2 strand2 primary proper pair_id # p001: 1 primary proper pair p001 chr2 10 18M + chr2 110 18M - 1 1 p001 # p002: 1 primary non proper pair p002 chr2 20 18M + chr2 120 18M - 1 0 p002 # p003: 2 proper pairs: 1 primary + 1 secondary p003 chr2 30 18M + chr2 130 18M - 1 1 p003a p003 chr2 31 18M + chr2 131 18M - 0 1 p003b # p004: 2 non proper pairs: 1 primary + 1 secondary p004 chr2 40 18M + chr2 140 18M - 1 0 p004a p004 chr2 41 18M + chr2 141 18M - 0 0 p004b # p005: 2 primary pairs (some aligners seem to produce that, even though they # probably shouldn't) p005 chr2 50 18M + chr2 150 18M - 1 1 p005a p005 chr2 51 18M + chr2 151 18M - 1 1 p005b # p006: 3 pairs: 1 primary proper + 1 secondary proper + 1 secondary non # proper p006 chr2 60 18M + chr2 160 18M - 1 1 p006a p006 chr2 61 18M + chr2 161 18M - 0 1 p006b p006 chr2 62 18M + chr2 60 18M - 0 0 p006c # p007: 2 pairs mapped to the same position: 1 primary proper + 1 secondary # proper p007 chr2 70 9M1D9M + chr2 170 18M - 1 1 p007a p007 chr2 70 18M + chr2 170 7M2I9M - 0 1 p007b # p008: 3 pairs mapped to the same position: 1 primary proper + 1 secondary # proper + 1 secondary non proper p008 chr2 80 18M + chr2 180 18M - 1 1 p008a p008 chr2 80 9M2D9M + chr2 180 7M2I9M - 0 1 p008b p008 chr2 80 6M3I9M + chr2 180 9M3D9M - 0 0 p008c # p009: 3 pairs mapped to the same position: 1 primary proper + 2 secondary # proper. The secondary pairs can NOT be disambiguated. p009 chr2 90 18M + chr2 190 18M - 1 1 p009a p009 chr2 90 9M2D9M + chr2 190 7M2I9M - 0 1 p009b p009 chr2 90 6M3I9M + chr2 190 9M3D9M - 0 1 p009c " toy_bamfile <- make_toy_bamfile(mapped_pair_table, tempfile()) test_readGAlignmentPairs <- function() { param <- ScanBamParam(tag="pi") galp <- suppressWarnings( readGAlignmentPairs(toy_bamfile, use.names=TRUE, param=param) ) ## Check the dumped alignments dumped_gal <- getDumpedAlignments() checkTrue(validObject(dumped_gal, complete=TRUE)) pi_target <- rep(c("p009b", "p009c"), each=2) checkIdentical(pi_target, sort(mcols(dumped_gal)$pi)) ## Check 'galp' checkTrue(validObject(galp, complete=TRUE)) pi_target <- c("p001", "p002", "p003a", "p003b", "p004a", "p004b", "p005a", "p005b", "p006a", "p006b", "p006c", "p007a", "p007b", "p008a", "p008b", "p008c", "p009a") checkIdentical(pi_target, mcols(first(galp))$pi) checkIdentical(pi_target, mcols(last(galp))$pi) } ### Starting with BioC 2.14, readGAlignmentPairs() behavior changed when ### using the 'which' argument. Old behavior: the same pair was returned once ### per each range in 'which' that had an overlap with the *two* segments in ### the pair. New behavior: the same pair is returned once per each range in ### 'which' that has an overlap with *any* of the 2 segments in the pair. ### The new behavior is a consequence of using ### scanBam(BamFile(asMates=TRUE), ...) ### behind the scene instead of ### findMateAlignment() ### for the pairing. ### The new behavior breaks the test below so I'm turning it off for now. if (FALSE) { test_readGAlignmentPairs_which <- function() { ## 4 non-overlapping regions of interest: first two regions only overlap ## with first p001 mate and last two regions only with last p001 mate. my_ROI <- GRanges("chr2", IRanges(c(10, 15, 110, 115), width=1)) my_ROI_labels <- c("chr2:10-10", "chr2:15-15", "chr2:110-110", "chr2:115-115") param <- ScanBamParam(tag="pi", which=my_ROI[c(1, 4)]) target1 <- readGAlignmentPairs(toy_bamfile, use.names=TRUE, param=param, with.which_label=TRUE) checkTrue(validObject(target1, complete=TRUE)) checkIdentical(1L, length(target1)) checkIdentical(Rle(factor(my_ROI_labels[1], levels=my_ROI_labels[c(1, 4)])), mcols(first(target1))$which_label) checkIdentical(Rle(factor(my_ROI_labels[4], levels=my_ROI_labels[c(1, 4)])), mcols(last(target1))$which_label) mcols(target1@first)$which_label <- mcols(target1@last)$which_label <- NULL ## Checking all possible combinations of ranges in 'which'. check_my_ROI_subsets <- function(subset) { check_my_ROI_subset <- function(i) { #print(i) param <- ScanBamParam(tag="pi", which=my_ROI[i]) current <- suppressWarnings( readGAlignmentPairs(toy_bamfile, use.names=TRUE, param=param) ) if (sum(i <= 2L) == 1L && sum(i >= 3L) == 1L) { checkIdentical(target1, current) } else { checkIdentical(0L, length(current)) } } check_my_ROI_subset(subset) if (length(subset) >= 2L) { check_my_ROI_subset(rev(subset)) if (length(subset) >= 4L) check_my_ROI_subset(c(4L, 1:3)) } TRUE } for (m in 1:length(my_ROI)) combn(length(my_ROI), m, FUN=check_my_ROI_subsets) } } GenomicAlignments/inst/unitTests/test_readGAlignments.R0000644000175100017510000000450412607264575024423 0ustar00biocbuildbiocbuildtest_readGAlignments <- function() { fl <- system.file("extdata", "ex1.bam", package="Rsamtools") which <- RangesList(seq1=IRanges(1, width=100)) param <- ScanBamParam(which=which) result <- readGAlignments(fl, param=param) checkTrue(validObject(result)) checkIdentical(c(seq1=1575L, seq2=1584L), seqlengths(result)) } test_readGAlignments_missing_param <- function() { fl <- system.file("unitTests", "cases", "ex1_noindex.bam", package="Rsamtools") result0 <- readGAlignments(fl) checkTrue(validObject(result0)) bf <- open(BamFile(fl, character())) result1 <- readGAlignments(bf) checkIdentical(result1, result0) } test_readGAlignments_length0 <- function() { fl <- system.file("extdata", "ex1.bam", package="Rsamtools") which <- RangesList(seq1=IRanges(100000, width=100)) param <- ScanBamParam(which=which) result <- readGAlignments(fl, param=param) checkTrue(validObject(result)) which <- RangesList(seq1=IRanges(c(1, 100000), width=100)) param <- ScanBamParam(which=which) result <- readGAlignments(fl, param=param) checkTrue(validObject(result)) } test_readGAlignments_tag <- function() { fl <- system.file("extdata", "ex1.bam", package="Rsamtools") ## valid param <- ScanBamParam(tag=("NM")) gal <- readGAlignments(fl, param=param) checkIdentical(924L, sum(mcols(gal)[["NM"]])) ## empty param <- ScanBamParam(tag=("FO")) gal <- readGAlignments(fl, param=param) checkIdentical(rep.int(NA, length(gal)), mcols(gal)[["FO"]]) } test_readGAlignments_BamViews <- function() { checkTrue(validObject(readGAlignments(BamViews()))) src <- system.file("unitTests", "cases", package="Rsamtools") fl <- c(system.file("extdata", "ex1.bam", package="Rsamtools"), file.path(src, "ex1_shuf1000.bam")) bv <- BamViews(fl, auto.range=TRUE) rng <- bamRanges(bv) aln <- readGAlignments(bv) checkEquals(length(bamPaths(bv)), length(aln)) fl <- c(fl, tempfile()) bv <- BamViews(fl, bamRanges=rng) msg <- NULL suppressWarnings({ tryCatch({ aln <- readGAlignments(bv) }, error=function(err) { msg <<- conditionMessage(err) }) }) tst <- sprintf("'readGAlignments' failed on '%s'", names(bv)[3L]) checkIdentical(tst, msg) } GenomicAlignments/inst/unitTests/test_readGAlignmentsList.R0000644000175100017510000001717012607264575025262 0ustar00biocbuildbiocbuildlibrary(pasillaBamSubset) chr4 <- untreated3_chr4() test_readGAlignmentsList_construction <- function() { fl <- system.file("extdata", "ex1.bam", package="Rsamtools") bf <- BamFile(fl, asMates=TRUE) galist <- readGAlignmentsList(fl) checkTrue(is.null(names(galist))) galist <- readGAlignmentsList(fl, use.names=TRUE) target <- c("EAS54_61:4:143:69:578", "EAS219_FC30151:7:51:1429:1043") checkIdentical(names(galist)[1:2], target) ## first segment first param <- ScanBamParam(what="flag") galist <- readGAlignmentsList(fl, param=param) mates <- galist[mcols(galist)$mate_status == "mated"] flagBit <- bamFlagAsBitMatrix(mcols(unlist(mates))$flag, bitnames="isFirstMateRead") m <- matrix(flagBit, nrow=2) checkIdentical(c(1572L, 0), rowSums(m)) } test_readGAlignmentsList_noYieldSize <- function() { fl <- system.file("extdata", "ex1.bam", package="Rsamtools") bf <- BamFile(fl, asMates=TRUE) galist <- readGAlignmentsList(fl) checkTrue(validObject(galist)) } test_readGAlignmentsList_yieldSize <- function() { bf <- BamFile(chr4, asMates=TRUE, yieldSize=1) scn1 <- scanBam(bf) galist1 <- readGAlignmentsList(bf) checkTrue(length(scn1[[1]]$qname) == 2) checkTrue(length(unique(scn1[[1]]$qname)) == 1) checkTrue(length(unique(scn1[[1]]$qname)) == length(galist1)) bf <- BamFile(chr4, asMates=TRUE, yieldSize=2) scn2 <- scanBam(bf) galist2 <- readGAlignmentsList(bf) checkTrue(length(scn2[[1]]$qname) == 4) checkTrue(length(unique(scn2[[1]]$qname)) == 2) checkTrue(length(unique(scn2[[1]]$qname)) == length(galist2)) } test_readGAlignmentsList_mcols <- function() { bf <- BamFile(chr4, asMates=TRUE, yieldSize=100) param <- ScanBamParam(tag=("NM")) galist <- readGAlignmentsList(bf, param=param) checkIdentical(colnames(mcols(unlist(galist))), "NM") checkTrue(names(mcols(galist)) == "mate_status") param <- ScanBamParam(tag=("FO")) galist <- readGAlignmentsList(bf, param=param) checkIdentical(rep.int(NA, length(unlist(galist))), mcols(unlist(galist))[["FO"]]) } test_readGAlignmentsList_compare_pairs <- function() { bamfile <- BamFile(untreated3_chr4(), asMates=TRUE) galist <- readGAlignmentsList(bamfile) mates <- galist[mcols(galist)$mate_status == "mated"] galp <- readGAlignmentPairs(bamfile) checkIdentical(length(galp), 75346L) tbl <- table(mcols(galist)) checkIdentical(tbl[["mated"]], 75409L) checkIdentical(tbl[["ambiguous"]], 0L) checkIdentical(tbl[["unmated"]], 21227L) ## GAlignmentPairs holds concordant (opposite strand) pairs samestrand <- galist[elementLengths(runValue(strand(galist))) == 1L] samestrandp <- sum(mcols(samestrand)$mate_status == "mated") checkIdentical(tbl[["mated"]] - samestrandp, length(galp)) } test_readGAlignmentsList_flags <- function() { bamfile <- BamFile(untreated3_chr4(), asMates=TRUE) param <- ScanBamParam(flag=scanBamFlag(isProperPair=TRUE)) galist <- readGAlignmentsList(bamfile, param=param) status <- table(mcols(galist)$mate_status) checkIdentical(status[["mated"]], 45828L) checkIdentical(status[["ambiguous"]], 0L) checkIdentical(status[["unmated"]], 0L) } ## toy_bamfile read summary: ## -------------------------- ## single-end ## s001: 1 primary alignment ## s002: 1 primary alignment + 3 secondary alignments ## s003: unmapped ## paired-end ## p991: 1 pair with a missing mate (can happen if file was subsetted) ## p992: 1 pair with 1st mate unmapped and 2nd mate mapped ## p993: 1 pair with both mates unmapped ## multi-segments ## m001: 3 segments in the template (index of each segment is known) ## m002: 3 segments in the template (index of each segment was lost) ## mapped pairs ('pi' tag only exists for these mapped pairs) ## p001: 1 primary proper pair ## p002: 1 primary non proper pair ## p003: 2 proper pairs: 1 primary + 1 secondary ## p004: 2 non proper pairs: 1 primary + 1 secondary ## p005: 2 primary pairs ## p006: 3 pairs: 1 primary proper + 1 secondary proper + ## 1 secondary non proper ## p007: 2 pairs mapped to the same position: ## 1 primary proper + 1 secondary proper ## p008: 3 pairs mapped to the same position: 1 primary proper + ## 1 secondary proper + 1 secondary non proper ## p009: 3 pairs mapped to the same position: ## 1 primary proper + 2 secondary proper. source(system.file("unitTests", "test_readGAlignmentPairs.R", package="GenomicAlignments")) bf <- BamFile(toy_bamfile, asMates=TRUE) test_readGAlignmentsList_toybamfile <- function() { param <- ScanBamParam(tag="pi") galp <- readGAlignmentPairs(toy_bamfile, use.names=TRUE, param=param) galist <- readGAlignmentsList(bf, use.names=TRUE, param=param) ## 'mated' mated_galist <- unlist(galist[mcols(galist)$mate_status == "mated"]) pi_target <- c("p001", "p002", "p003a", "p003b", "p004a", "p004b", "p005a", "p005b", "p006a", "p006b", "p006c", "p007a", "p007b", "p008a", "p008b", "p008c", "p009a") checkTrue(all(mcols(mated_galist)$pi %in% pi_target)) ## 'ambiguous' GAList match 'dumped' GAPairs ambig_galist <- unlist(galist[mcols(galist)$mate_status == "ambiguous"]) dumped_galp <- getDumpedAlignments() pi_target <- rep(c("p009b", "p009c"), each=2) checkIdentical(pi_target, sort(mcols(dumped_galp)$pi)) checkIdentical(pi_target, sort(mcols(ambig_galist)$pi)) ## 'unmated': unmated_galist <- unlist(galist[mcols(galist)$mate_status == "unmated"]) ## unmated single-end, paired-end or multi-segment (no pi tags) name_target <- c("m001", "m002", "p991", "p992", "s001", "s002") unmated <- names(unmated_galist)[is.na(mcols(unmated_galist)$pi)] checkTrue(all(unmated %in% name_target)) ## non-proper mapped-pairs (have pi tags) pi_target <- c("p002", "p004a", "p004b", "p006c", "p008c") unmated <- na.omit(unique(mcols(unmated_galist)$pi)) checkTrue(all(unmated %in% pi_target)) ## Reads of this type cannot be filtered out wrt readGAlignmentsList. ## They are always returned by readGAlignmentsList but never returned by ## readGAlignmentPairs. bamFlag(param) <- scanBamFlag(isProperPair=TRUE, hasUnmappedMate=FALSE, isUnmappedQuery=FALSE, isPaired=TRUE) galist <- readGAlignmentsList(bf, use.names=TRUE, param=param) unmated_galist <- unlist(galist[mcols(galist)$mate_status == "unmated"]) unmated <- names(unmated_galist)[is.na(mcols(unmated_galist)$pi)] name_target <- c("m001", "m002", "p991") checkTrue(all(unmated %in% name_target)) } test_readGAlignmentsList_which <- function() { ## 4 non-overlapping regions of interest: first two regions only overlap ## with first p001 mate and last two regions only with last p001 mate. my_ROI <- GRanges("chr2", IRanges(c(10, 15, 110, 115), width=1)) my_ROI_labels <- c("chr2:10-10", "chr2:15-15", "chr2:110-110", "chr2:115-115") param <- ScanBamParam(tag="pi", which=my_ROI[c(1, 4)]) target1 <- readGAlignmentsList(toy_bamfile, use.names=TRUE, param=param, with.which_label=TRUE) ## Duplicate results with distinct 'which_label' checkIdentical(2L, length(target1)) checkIdentical(as.vector(mcols(target1)$mate_status), c("mated", "mated")) rng1 <- as.vector(mcols(unlist(target1[1]))$which_label) checkTrue(all(rng1 %in% my_ROI_labels[1])) rng2 <- as.vector(mcols(unlist(target1[2]))$which_label) checkTrue(all(rng2 %in% my_ROI_labels[4])) } GenomicAlignments/inst/unitTests/test_summarizeOverlaps-methods.R0000644000175100017510000003042012607264575026544 0ustar00biocbuildbiocbuild.getCounts <- function(res) { as.integer(assays(res)$counts) } quiet <- suppressMessages gr <- GRanges(c(rep("chr1", 7), rep("chr2", 4)), IRanges(c(1000, 3000, 3600, 4000, 4000, 5000, 5400, 2000, 3000, 7000, 7500), width = c(500, 500, 300, 500, 900, 500, 500, 900, 500, 600, 300)), "+", group = c("A", "B", "C", "C", "D", "D", "E", "F", "G", "H", "H")) rds <- GAlignments(c(rep(c("chr1", "chr2"), 3), "chr1"), as.integer(c(1400, 2700, 3400, 7100, 4000, 3100, 5200)), c("500M", "100M", "300M", "500M", "300M", "50M200N50M", "50M150N50M"), strand(rep("+", 7))) test_summarizeOverlaps_Union_single <- function() { ## single-end no junctions mode <- "Union" ga <- GAlignments("chr1", 20L, "11M", strand("+")) ann <- GRanges("chr1", IRanges(c(1, 10, 25, 22), c(50, 25, 40, 26)), "+") res <- summarizeOverlaps(ann[1], ga, mode) checkIdentical(1L, .getCounts(res)) res <- summarizeOverlaps(ann[2], ga, mode) checkIdentical(1L, .getCounts(res)) res <- summarizeOverlaps(ann[3], ga, mode) checkIdentical(1L, .getCounts(res)) res <- summarizeOverlaps(ann[4], ga, mode) checkIdentical(1L, .getCounts(res)) ## >1 feature res <- summarizeOverlaps(ann, ga, mode) checkIdentical(c(0L, 0L, 0L, 0L), .getCounts(res)) } test_summarizeOverlaps_Union_paired <- function() { ## single-end with a junction (behaves like paired-end) mode <- "Union" ga <- GAlignments("chr1", 1L, "10M4N11M", strand("+")) ga1 <- GAlignments("chr1", 1L, "10M", strand("+")) ga2 <- GAlignments("chr1", 15L, "11M", strand("-")) galp <- GAlignmentPairs(ga1, ga2) ann <- GRanges("chr1", IRanges(c(1, 5, 12, 20), c(25, 20, 14, 30)), "+") res_ga <- summarizeOverlaps(ann[1], ga, mode) res_galp <- summarizeOverlaps(ann[1], galp, mode) checkIdentical(1L, .getCounts(res_ga)) checkIdentical(1L, .getCounts(res_galp)) res_ga <- summarizeOverlaps(ann[2], ga, mode) res_galp <- summarizeOverlaps(ann[2], galp, mode) checkIdentical(1L, .getCounts(res_ga)) checkIdentical(1L, .getCounts(res_galp)) res_ga <- summarizeOverlaps(ann[3], ga, mode) res_galp <- summarizeOverlaps(ann[3], galp, mode) checkIdentical(0L, .getCounts(res_ga)) checkIdentical(0L, .getCounts(res_galp)) res_ga <- summarizeOverlaps(ann[4], ga, mode) res_galp <- summarizeOverlaps(ann[4], galp, mode) checkIdentical(1L, .getCounts(res_ga)) checkIdentical(1L, .getCounts(res_galp)) ## >1 feature res_ga <- summarizeOverlaps(ann, ga, mode) res_galp <- summarizeOverlaps(ann, ga, mode) checkIdentical(c(0L, 0L, 0L, 0L), .getCounts(res_ga)) checkIdentical(c(0L, 0L, 0L, 0L), .getCounts(res_galp)) } test_summarizeOverlaps_IntersectionStrict_single <- function() { ## single-end, no junctions mode <- "IntersectionStrict" ga <- GAlignments("chr1", 7L, "6M", strand("+")) ann <- GRanges("chr1", IRanges(c(1, 5, 10), width=10), "+") res <- summarizeOverlaps(ann[1], ga, mode) checkIdentical(0L, .getCounts(res)) res <- summarizeOverlaps(ann[2], ga, mode) checkIdentical(1L, .getCounts(res)) res <- summarizeOverlaps(ann[3], ga, mode) checkIdentical(0L, .getCounts(res)) ## >1 feature ann <- GRanges("chr1", IRanges(c(5, 6, 10), c(15, 16, 15)), "+") res <- summarizeOverlaps(ann[1:2], ga, mode) checkIdentical(c(0L, 0L), .getCounts(res)) res <- summarizeOverlaps(ann[c(1,3)], ga, mode) checkIdentical(c(1L, 0L), .getCounts(res)) } test_summarizeOverlaps_IntersectionStrict_paired <- function() { ## single-end with a junction (behaves like paired-end) mode <- "IntersectionStrict" ga <- GAlignments("chr1", 10L, "6M4N6M", strand("+")) ga1 <- GAlignments("chr1", 10L, "6M", strand("+")) ga2 <- GAlignments("chr1", 20L, "6M", strand("-")) galp <- GAlignmentPairs(ga1, ga2) ann <- GRanges("chr1", IRanges(c(1, 1, 20), c(30, 15, 30)), "+") res_ga <- summarizeOverlaps(ann[1], ga, mode) res_galp <- summarizeOverlaps(ann[1], galp, mode) checkIdentical(1L, .getCounts(res_ga)) checkIdentical(1L, .getCounts(res_galp)) res_ga <- summarizeOverlaps(ann[2], ga, mode) res_galp <- summarizeOverlaps(ann[2], galp, mode) checkIdentical(0L, .getCounts(res_ga)) checkIdentical(0L, .getCounts(res_galp)) res_ga <- summarizeOverlaps(ann[3], ga, mode) res_galp <- summarizeOverlaps(ann[3], galp, mode) checkIdentical(0L, .getCounts(res_ga)) checkIdentical(0L, .getCounts(res_galp)) ## >1 feature res_ga <- summarizeOverlaps(ann, ga, mode) res_galp <- summarizeOverlaps(ann, galp, mode) checkIdentical(c(1L, 0L, 0L), .getCounts(res_ga)) checkIdentical(c(1L, 0L, 0L), .getCounts(res_galp)) } test_summarizeOverlaps_IntersectionNotEmpty_single <- function() { ## single-end, no junctions mode <- "IntersectionNotEmpty" ga <- GAlignments("chr1", 10L, "11M", strand("+")) ann <- GRanges("chr1", IRanges(c(1, 5, 12), c(15, 30, 15)), "+") res <- summarizeOverlaps(ann[1], ga, mode) checkIdentical(1L, .getCounts(res)) res <- summarizeOverlaps(ann[2], ga, mode) checkIdentical(1L, .getCounts(res)) res <- summarizeOverlaps(ann[3], ga, mode) checkIdentical(1L, .getCounts(res)) res <- summarizeOverlaps(ann, ga, mode) checkIdentical(c(0L, 1L, 0L), .getCounts(res)) ## >1 feature ann <- GRanges("chr1", IRanges(c(5, 15), c(20, 25)), "+") res <- summarizeOverlaps(ann, ga, mode) checkIdentical(c(1L, 0L), .getCounts(res)) ann <- GRanges("chr1", IRanges(c(5, 12), c(18, 25)), "+") res <- summarizeOverlaps(ann, ga, mode) checkIdentical(c(0L, 0L), .getCounts(res)) ann <- GRanges(rep("chr1", 3), IRanges(c(1L, 20L, 20L), width=c(50, 11, 11)), c("+", "+", "-")) ga <- GAlignments("chr1", 23L, "5M", strand("*")) res <- summarizeOverlaps(ann, ga, mode) checkIdentical(c(0L, 0L, 0L), .getCounts(res)) strand(ga) <- "-" res <- summarizeOverlaps(ann, ga, mode) checkIdentical(c(0L, 0L, 1L), .getCounts(res)) ga <- GAlignments("chr1", 28L, "5M", strand("+")) res <- summarizeOverlaps(ann, ga, mode) checkIdentical(c(1L, 0L, 0L), .getCounts(res)) ## ignore.strand ann <- GRanges("chr1", IRanges(c(5, 1), end=c(10, 6)), strand=c("+", "-")) reads <- GRanges("chr1", IRanges(2, 2), strand="+") checkIdentical(c(0L, 1L), IntersectionNotEmpty(ann, reads, ignore.strand=TRUE)) } test_summarizeOverlaps_IntersectionNotEmpty_paired <- function() { ## single-end with a junction (behaves like paired-end) mode <- "IntersectionNotEmpty" ga <- GAlignments("chr1", 10L, "6M4N6M", strand("+")) ga1 <- GAlignments("chr1", 10L, "6M", strand("+")) ga2 <- GAlignments("chr1", 20L, "6M", strand("-")) galp <- GAlignmentPairs(ga1, ga2) ann <- GRanges("chr1", IRanges(c(1, 1, 20), c(30, 15, 30)), "+") ## single-end, junctions res_ga <- summarizeOverlaps(ann[1], ga, mode) res_galp <- summarizeOverlaps(ann[1], galp, mode) checkIdentical(1L, .getCounts(res_ga)) checkIdentical(1L, .getCounts(res_galp)) res_ga <- summarizeOverlaps(ann[2], ga, mode) res_galp <- summarizeOverlaps(ann[2], galp, mode) checkIdentical(1L, .getCounts(res_ga)) checkIdentical(1L, .getCounts(res_galp)) res_ga <- summarizeOverlaps(ann[3], ga, mode) res_galp <- summarizeOverlaps(ann[3], galp, mode) checkIdentical(1L, .getCounts(res_ga)) checkIdentical(1L, .getCounts(res_galp)) ## > 1 feature res_ga <- summarizeOverlaps(ann, ga, mode) res_galp <- summarizeOverlaps(ann, galp, mode) checkIdentical(c(0L, 0L, 0L), .getCounts(res_ga)) checkIdentical(c(0L, 0L, 0L), .getCounts(res_galp)) ann <- GRanges("chr1", IRanges(c(1, 2), c(23, 23)), "+") res_ga <- summarizeOverlaps(ann, ga, mode) res_galp <- summarizeOverlaps(ann, galp, mode) checkIdentical(c(0L, 0L), .getCounts(res_ga)) checkIdentical(c(0L, 0L), .getCounts(res_galp)) ann <- GRanges("chr1", IRanges(c(1, 21), c(23, 30)), "+") res_ga <- summarizeOverlaps(ann, ga, mode) res_galp <- summarizeOverlaps(ann, galp, mode) checkIdentical(c(0L, 0L), .getCounts(res_ga)) checkIdentical(c(0L, 0L), .getCounts(res_galp)) ann <- GRanges("chr1", IRanges(c(1, 1), c(23, 21)), "+") res_ga <- summarizeOverlaps(ann, ga, mode) res_galp <- summarizeOverlaps(ann, galp, mode) checkIdentical(c(1L, 0L), .getCounts(res_ga)) checkIdentical(c(1L, 0L), .getCounts(res_galp)) } test_summarizeOverlaps_inter.feature_GRanges <- function() { ## rows 5,6,7 from figure in vignette ft <- gr[10:11] rd <- GAlignments(rep("chr2", 3), as.integer(c(7100, 7100, 7500)), c("300M", "500M", "50M"), strand(rep("+", 3))) mode <- "Union" res <- summarizeOverlaps(ft, rd[1], mode, inter.feature=TRUE) checkIdentical(c(1L, 0L), .getCounts(res)) res <- summarizeOverlaps(ft, rd[1], mode, inter.feature=FALSE) checkIdentical(c(1L, 0L), .getCounts(res)) res <- summarizeOverlaps(ft, rd[2], mode, inter.feature=TRUE) checkIdentical(c(0L, 0L), .getCounts(res)) res <- summarizeOverlaps(ft, rd[2], mode, inter.feature=FALSE) checkIdentical(c(1L, 1L), .getCounts(res)) res <- summarizeOverlaps(ft, rd[3], mode, inter.feature=TRUE) checkIdentical(c(0L, 0L), .getCounts(res)) res <- summarizeOverlaps(ft, rd[3], mode, inter.feature=FALSE) checkIdentical(c(1L, 1L), .getCounts(res)) mode <- "IntersectionStrict" res <- summarizeOverlaps(ft, rd[1], mode, inter.feature=TRUE) checkIdentical(c(1L, 0L), .getCounts(res)) res <- summarizeOverlaps(ft, rd[1], mode, inter.feature=FALSE) checkIdentical(c(1L, 0L), .getCounts(res)) res <- summarizeOverlaps(ft, rd[2], mode, inter.feature=TRUE) checkIdentical(c(1L, 0L), .getCounts(res)) res <- summarizeOverlaps(ft, rd[2], mode, inter.feature=FALSE) checkIdentical(c(1L, 0L), .getCounts(res)) res <- summarizeOverlaps(ft, rd[3], mode, inter.feature=TRUE) checkIdentical(c(0L, 0L), .getCounts(res)) res <- summarizeOverlaps(ft, rd[3], mode, inter.feature=FALSE) checkIdentical(c(1L, 1L), .getCounts(res)) mode <- "IntersectionNotEmpty" res <- summarizeOverlaps(ft, rd[1], mode, inter.feature=TRUE) checkIdentical(c(1L, 0L), .getCounts(res)) res <- summarizeOverlaps(ft, rd[1], mode, inter.feature=FALSE) checkIdentical(c(1L, 0L), .getCounts(res)) res <- summarizeOverlaps(ft, rd[2], mode, inter.feature=TRUE) checkIdentical(c(1L, 0L), .getCounts(res)) res <- summarizeOverlaps(ft, rd[2], mode, inter.feature=FALSE) checkIdentical(c(1L, 0L), .getCounts(res)) res <- summarizeOverlaps(ft, rd[3], mode, inter.feature=TRUE) checkIdentical(c(0L, 0L), .getCounts(res)) res <- summarizeOverlaps(ft, rd[3], mode, inter.feature=FALSE) checkIdentical(c(0L, 0L), .getCounts(res)) ## read spans both features rd <- GAlignments("chr2", 7000L, "750M", strand("+")) res <- summarizeOverlaps(ft, rd, mode, inter.feature=TRUE) checkIdentical(c(0L, 0L), .getCounts(res)) res <- summarizeOverlaps(ft, rd, mode, inter.feature=FALSE) checkIdentical(c(1L, 1L), .getCounts(res)) } test_summarizeOverlaps_inter.feature_GRangesList <- function() { grl <- split(gr, mcols(gr)[["group"]]) mode <- "Union" res <- quiet(summarizeOverlaps(grl, rds, mode)) checkIdentical(c(1L, rep(0L, 4), rep(1L, 3)), .getCounts(res)) res <- quiet(summarizeOverlaps(grl, rds, mode, inter.feature=FALSE)) checkIdentical(c(1L, 1L, 2L, 2L, rep(1L, 4)), .getCounts(res)) co <- countOverlaps(grl, rds, type="any") checkIdentical(unname(co), .getCounts(res)) mode <- "IntersectionStrict" res <- quiet(summarizeOverlaps(grl, rds, mode)) checkIdentical(c(0L, 0L, 0L, 1L, 0L, rep(1L, 3)), .getCounts(res)) res <- quiet(summarizeOverlaps(grl, rds, mode, inter.feature=FALSE)) checkIdentical(c(0L, 0L, 1L, 2L, 0L, rep(1L, 3)), .getCounts(res)) co <- countSubjectHits(findOverlaps(rds, grl, type="within")) checkIdentical(unname(co), .getCounts(res)) mode <- "IntersectionNotEmpty" rd <- rds[c(5,7)] ft <- grl[3:5] res <- quiet(summarizeOverlaps(ft, rd, mode)) checkIdentical(c(0L, 1L, 0L), .getCounts(res)) res <- quiet(summarizeOverlaps(ft, rd, mode, inter.feature=FALSE)) checkIdentical(c(0L, 1L, 0L), .getCounts(res)) } GenomicAlignments/man/0000755000175100017510000000000012612017250015744 5ustar00biocbuildbiocbuildGenomicAlignments/man/GAlignmentPairs-class.Rd0000644000175100017510000003523512607264575022414 0ustar00biocbuildbiocbuild\name{GAlignmentPairs-class} \docType{class} % Class: \alias{class:GAlignmentPairs} \alias{GAlignmentPairs-class} % Constructors: \alias{GAlignmentPairs} % Accessors: \alias{strandMode} \alias{strandMode,GAlignmentPairs-method} \alias{strandMode<-} \alias{strandMode<-,GAlignmentPairs-method} \alias{length,GAlignmentPairs-method} \alias{names,GAlignmentPairs-method} \alias{names<-,GAlignmentPairs-method} \alias{first} \alias{first,GAlignmentPairs-method} \alias{last} \alias{last,GAlignmentPairs-method} \alias{seqnames,GAlignmentPairs-method} \alias{strand,GAlignmentPairs-method} \alias{strand<-,GAlignmentPairs-method} \alias{njunc,GAlignmentPairs-method} \alias{isProperPair} \alias{isProperPair,GAlignmentPairs-method} \alias{elementMetadata<-,GAlignmentPairs-method} \alias{seqinfo,GAlignmentPairs-method} \alias{seqlevelsInUse,GAlignmentPairs-method} \alias{seqinfo<-,GAlignmentPairs-method} % List methods: \alias{[[,GAlignmentPairs,ANY,ANY-method} \alias{unlist,GAlignmentPairs-method} % Coercion: \alias{grglist,GAlignmentPairs-method} \alias{granges,GAlignmentPairs-method} \alias{coerce,GAlignmentPairs,GRangesList-method} \alias{coerce,GAlignmentPairs,GRanges-method} \alias{coerce,GAlignmentPairs,GAlignments-method} % "show" method: \alias{show,GAlignmentPairs-method} % Combining: \alias{c,GAlignmentPairs-method} % old stuff (Deprecated or Defunct) \alias{left} \alias{left,GAlignmentPairs-method} \alias{right} \alias{right,GAlignmentPairs-method} \title{GAlignmentPairs objects} \description{ The GAlignmentPairs class is a container for \emph{genomic alignment pairs}. IMPORTANT NOTE: The GAlignmentPairs container can only hold \emph{concordant} pairs at the moment, that is, pairs where the 2 alignments are on the opposite strands of the same reference sequence. } \details{ A GAlignmentPairs object is a list-like object where each element describes a pair of genomic alignment. An "alignment pair" is made of a "first" and a "last" alignment, and is formally represented by a \link{GAlignments} object of length 2. It is typically representing a hit of a paired-end read to the reference genome that was used by the aligner. More precisely, in a given pair, the "first" alignment represents the hit of the first end of the read (aka "first segment in the template", using SAM Spec terminology), and the "last" alignment represents the hit of the second end of the read (aka "last segment in the template", using SAM Spec terminology). In general, a GAlignmentPairs object will be created by loading records from a BAM (or SAM) file containing aligned paired-end reads, using the \code{readGAlignmentPairs} function (see below). Each element in the returned object will be obtained by pairing 2 records. } \section{Constructor}{ \describe{ \item{}{ \code{GAlignmentPairs(first, last, strandMode=1, isProperPair=TRUE, names=NULL)}: Low-level GAlignmentPairs constructor. Generally not used directly. } } } \section{Accessors}{ In the code snippets below, \code{x} is a GAlignmentPairs object. \describe{ \item{}{ \code{strandMode(x)}, \code{strandMode(x) <- value}: The strand mode is a per-object switch on GAlignmentPairs objects that controls the behavior of the \code{strand} getter. More precisely, it indicates how the strand of a pair should be inferred from the strand of the first and last alignments in the pair: \itemize{ \item 0: strand of the pair is always *. \item 1: strand of the pair is strand of its first alignment. This mode should be used when the paired-end data was generated using one of the following stranded protocols: Directional Illumina (Ligation), Standard SOLiD. \item 2: strand of the pair is strand of its last alignment. This mode should be used when the paired-end data was generated using one of the following stranded protocols: dUTP, NSR, NNSR, Illumina stranded TruSeq PE protocol. } These modes are equivalent to \code{strandSpecific} equal 0, 1, and 2, respectively, for the \code{featureCounts} function defined in the \pkg{Rsubread} package. Note that, by default, the \code{\link{readGAlignmentPairs}} function sets the strand mode to 1 on the returned GAlignmentPairs object. The function has a \code{strandMode} argument to let the user set a different strand mode. The strand mode can also be changed any time with the \code{strandMode} setter. Also note that 3rd party programs TopHat2 and Cufflinks have a \code{--library-type} option to let the user specify which protocol was used. Please refer to the documentation of these programs for more information. } \item{}{ \code{length(x)}: Return the number of alignment pairs in \code{x}. } \item{}{ \code{names(x)}, \code{names(x) <- value}: Get or set the names on \code{x}. See \code{\link{readGAlignmentPairs}} for how to automatically extract and set the names when reading the alignments from a file. } \item{}{ \code{first(x, real.strand=FALSE)}, \code{last(x, real.strand=FALSE)}: Get the "first" or "last" alignment for each alignment pair in \code{x}. The result is a \link{GAlignments} object of the same length as \code{x}. If \code{real.strand=TRUE}, then the strand is inverted on-the-fly according to the strand mode currently set on the object (see \code{strandMode(x)} above). More precisely, if \code{strandMode(x)} is 0, then the strand is set to * for the \link{GAlignments} object returned by both, \code{first()} and \code{last()}. If \code{strandMode(x)} is 1, then the strand of the object returned by \code{last()} is inverted. If \code{strandMode(x)} is 2, then the strand of the object returned by \code{first()} is inverted. } \item{}{ \code{seqnames(x)}: Get the name of the reference sequence for each alignment pair in \code{x}. When reading the alignments from a BAM file, this comes from the RNAME field which has the same value for the 2 records in a pair (\code{\link{readGAlignmentPairs}}, the function used for reading paired-end reads from a BAM file as a GAlignmentPairs object, rejects pairs with incompatible RNAME values). } \item{}{ \code{strand(x)}, \code{strand(x) <- value}: Get or set the strand for each alignment pair in \code{x}. Obeys \code{strandMode(x)} above to infer the strand of a pair. } \item{}{ \code{njunc(x)}: Equivalent to \code{njunc(first(x)) + njunc(last(x))}. } \item{}{ \code{isProperPair(x)}: Get the "isProperPair" flag bit (bit 0x2 in SAM Spec) set by the aligner for each alignment pair in \code{x}. } \item{}{ \code{seqinfo(x)}, \code{seqinfo(x) <- value}: Get or set the information about the underlying sequences. \code{value} must be a \link[GenomeInfoDb]{Seqinfo} object. } \item{}{ \code{seqlevels(x)}, \code{seqlevels(x) <- value}: Get or set the sequence levels. \code{seqlevels(x)} is equivalent to \code{seqlevels(seqinfo(x))} or to \code{levels(seqnames(x))}, those 2 expressions being guaranteed to return identical character vectors on a GAlignmentPairs object. \code{value} must be a character vector with no NAs. See \code{?\link{seqlevels}} for more information. } \item{}{ \code{seqlengths(x)}, \code{seqlengths(x) <- value}: Get or set the sequence lengths. \code{seqlengths(x)} is equivalent to \code{seqlengths(seqinfo(x))}. \code{value} can be a named non-negative integer or numeric vector eventually with NAs. } \item{}{ \code{isCircular(x)}, \code{isCircular(x) <- value}: Get or set the circularity flags. \code{isCircular(x)} is equivalent to \code{isCircular(seqinfo(x))}. \code{value} must be a named logical vector eventually with NAs. } \item{}{ \code{genome(x)}, \code{genome(x) <- value}: Get or set the genome identifier or assembly name for each sequence. \code{genome(x)} is equivalent to \code{genome(seqinfo(x))}. \code{value} must be a named character vector eventually with NAs. } \item{}{ \code{seqnameStyle(x)}: Get or set the seqname style for \code{x}. Note that this information is not stored in \code{x} but inferred by looking up \code{seqnames(x)} against a seqname style database stored in the seqnames.db metadata package (required). \code{seqnameStyle(x)} is equivalent to \code{seqnameStyle(seqinfo(x))} and can return more than 1 seqname style (with a warning) in case the style cannot be determined unambiguously. } } } \section{Vector methods}{ In the code snippets below, \code{x} is a GAlignmentPairs object. \describe{ \item{}{ \code{x[i]}: Return a new GAlignmentPairs object made of the selected alignment pairs. } } } \section{List methods}{ In the code snippets below, \code{x} is a GAlignmentPairs object. \describe{ \item{}{ \code{x[[i]]}: Extract the i-th alignment pair as a \link{GAlignments} object of length 2. As expected \code{x[[i]][1]} and \code{x[[i]][2]} are respectively the "first" and "last" alignments in the pair. } \item{}{ \code{unlist(x, use.names=TRUE)}: Return the \link{GAlignments} object conceptually defined by \code{c(x[[1]], x[[2]], ..., x[[length(x)]])}. \code{use.names} determines whether \code{x} names should be propagated to the result or not. } } } \section{Coercion}{ In the code snippets below, \code{x} is a GAlignmentPairs object. \describe{ \item{}{ \code{grglist(x, use.mcols=FALSE, drop.D.ranges=FALSE)}: Return a \link{GRangesList} object of length \code{length(x)} where the i-th element represents the ranges (with respect to the reference) of the i-th alignment pair in \code{x}. The strand of the returned ranges obeys the strand mode currently set on the object (see \code{strandMode(x)} above). More precisely, if \code{grl1} and \code{grl2} are \code{grglist(first(x, real.strand=TRUE), order.as.in.query=TRUE)} and \code{grglist(last(x, real.strand=TRUE), order.as.in.query=TRUE)}, respectively, then the i-th element in the returned \link{GRangesList} object is \code{c(grl1[[i]], grl2[[i]])}, if \code{strandMode(x)} is 1, or \code{c(grl2[[i]], grl1[[i]])}, if \code{strandMode(x)} is 2. Note that this results in the ranges being \emph{always} ordered consistently with the original "query template", that is, being in the order defined by walking the "query template" from the beginning to the end. If \code{use.mcols} is TRUE and \code{x} has metadata columns on it (accessible with \code{mcols(x)}), they're propagated to the returned object. If \code{drop.D.ranges} is \code{TRUE}, then deletions (Ds in the CIGAR) are treated like junctions (Ns in the CIGAR), that is, the ranges corresponding to deletions are dropped. } \item{}{ \code{granges(x, use.mcols=FALSE)}: Return a \link{GRanges} object of length \code{length(x)} where each range is obtained by merging all the ranges within the corresponding top-level element in \code{grglist(x)}. If \code{use.mcols} is TRUE and \code{x} has metadata columns on it (accessible with \code{mcols(x)}), they're propagated to the returned object. } \item{}{ \code{as(x, "GRangesList")}, \code{as(x, "GRanges")}: Alternate ways of doing \code{grglist(x, use.mcols=TRUE)} and \code{granges(x, use.mcols=TRUE)}, respectively. } \item{}{ \code{as(x, "GAlignments")}: Equivalent of \code{unlist(x, use.names=TRUE)}. } } } \section{Other methods}{ In the code snippets below, \code{x} is a GAlignmentPairs object. \describe{ \item{}{ \code{show(x)}: By default the \code{show} method displays 5 head and 5 tail elements. This can be changed by setting the global options \code{showHeadLines} and \code{showTailLines}. If the object length is less than (or equal to) the sum of these 2 options plus 1, then the full object is displayed. Note that these options also affect the display of \link{GRanges} and \link{GAlignments} objects, as well as other objects defined in the IRanges and Biostrings packages (e.g. \link[IRanges]{Ranges} and \link[Biostrings]{XStringSet} objects). } } } \author{ H. Pages } \seealso{ \itemize{ \item \code{\link{readGAlignmentPairs}} for reading aligned paired-end reads from a file (typically a BAM file) into a GAlignmentPairs object. \item \link{GAlignments} objects for handling aligned single-end reads. \item \code{\link{makeGAlignmentPairs}} for pairing the elements of a \link{GAlignments} object into a GAlignmentPairs object. \item \link{junctions-methods} for extracting and summarizing junctions from a GAlignmentPairs object. \item \link[GenomicAlignments]{coverage-methods} for computing the coverage of a GAlignmentPairs object. \item \link[GenomicAlignments]{findOverlaps-methods} for finding range overlaps between a GAlignmentPairs object and another range-based object. \item \code{\link[GenomeInfoDb]{seqinfo}} in the \pkg{GenomeInfoDb} package for getting/setting/modifying the sequence information stored in an object. \item The \link[GenomicRanges]{GRanges} and \link[GenomicRanges]{GRangesList} classes defined and documented in the \pkg{GenomicRanges} package. } } \examples{ library(Rsamtools) # for the ex1.bam file ex1_file <- system.file("extdata", "ex1.bam", package="Rsamtools") galp <- readGAlignmentPairs(ex1_file, use.names=TRUE, strandMode=1) galp length(galp) head(galp) head(names(galp)) first(galp) last(galp) strandMode(galp) first(galp, real.strand=TRUE) last(galp, real.strand=TRUE) strand(galp) strandMode(galp) <- 2 first(galp, real.strand=TRUE) last(galp, real.strand=TRUE) strand(galp) seqnames(galp) head(njunc(galp)) table(isProperPair(galp)) seqlevels(galp) ## Rename the reference sequences: seqlevels(galp) <- sub("seq", "chr", seqlevels(galp)) seqlevels(galp) galp[[1]] unlist(galp) grglist(galp) # a GRangesList object strandMode(galp) <- 1 grglist(galp) stopifnot(identical(unname(elementLengths(grglist(galp))), njunc(galp) + 2L)) granges(galp) # a GRanges object } \keyword{methods} \keyword{classes} GenomicAlignments/man/GAlignments-class.Rd0000644000175100017510000004421112607264575021572 0ustar00biocbuildbiocbuild\name{GAlignments-class} \docType{class} % Class: \alias{class:GAlignments} \alias{GAlignments-class} % Constructor: \alias{GAlignments} \alias{updateObject,GAlignments-method} % Accessors: \alias{length,GAlignments-method} \alias{names,GAlignments-method} \alias{seqnames,GAlignments-method} \alias{rname} \alias{rname,GAlignments-method} \alias{strand,GAlignments-method} \alias{names<-,GAlignments-method} \alias{seqnames<-,GAlignments-method} \alias{rname<-} \alias{rname<-,GAlignments-method} \alias{strand<-,GAlignments-method} \alias{cigar} \alias{cigar,GAlignments-method} \alias{qwidth} \alias{qwidth,GAlignments-method} \alias{start,GAlignments-method} \alias{end,GAlignments-method} \alias{width,GAlignments-method} \alias{njunc} \alias{njunc,GAlignments-method} \alias{elementMetadata<-,GAlignments-method} \alias{seqinfo,GAlignments-method} \alias{seqinfo<-,GAlignments-method} % Coercion: \alias{grglist,GAlignments-method} \alias{granges,GAlignments-method} \alias{rglist,GAlignments-method} \alias{ranges,GAlignments-method} \alias{coerce,GAlignments,GRangesList-method} \alias{coerce,GAlignments,GRanges-method} \alias{coerce,GAlignments,RangesList-method} \alias{coerce,GAlignments,Ranges-method} \alias{as.data.frame,GAlignments-method} \alias{coerce,GenomicRanges,GAlignments-method} % Combining: \alias{c,GAlignments-method} % "show" method: \alias{show,GAlignments-method} \title{GAlignments objects} \description{ The GAlignments class is a simple container which purpose is to store a set of genomic alignments that will hold just enough information for supporting the operations described below. } \details{ A GAlignments object is a vector-like object where each element describes a genomic alignment i.e. how a given sequence (called "query" or "read", typically short) aligns to a reference sequence (typically long). Typically, a GAlignments object will be created by loading records from a BAM (or SAM) file and each element in the resulting object will correspond to a record. BAM/SAM records generally contain a lot of information but only part of that information is loaded in the GAlignments object. In particular, we discard the query sequences (SEQ field), the query qualities (QUAL), the mapping qualities (MAPQ) and any other information that is not needed in order to support the operations or methods described below. This means that multi-reads (i.e. reads with multiple hits in the reference) won't receive any special treatment i.e. the various SAM/BAM records corresponding to a multi-read will show up in the GAlignments object as if they were coming from different/unrelated queries. Also paired-end reads will be treated as single-end reads and the pairing information will be lost (see \code{?\link{GAlignmentPairs}} for how to handle aligned paired-end reads). Each element of a GAlignments object consists of: \itemize{ \item The name of the reference sequence. (This is the RNAME field in a SAM/BAM record.) \item The strand in the reference sequence to which the query is aligned. (This information is stored in the FLAG field in a SAM/BAM record.) \item The CIGAR string in the "Extended CIGAR format" (see the SAM Format Specifications for the details). \item The 1-based leftmost position/coordinate of the clipped query relative to the reference sequence. We will refer to it as the "start" of the query. (This is the POS field in a SAM/BAM record.) \item The 1-based rightmost position/coordinate of the clipped query relative to the reference sequence. We will refer to it as the "end" of the query. (This is NOT explicitly stored in a SAM/BAM record but can be inferred from the POS and CIGAR fields.) Note that all positions/coordinates are always relative to the first base at the 5' end of the plus strand of the reference sequence, even when the query is aligned to the minus strand. \item The genomic intervals between the "start" and "end" of the query that are "covered" by the alignment. Saying that the full [start,end] interval is covered is the same as saying that the alignment contains no junction (no N in the CIGAR). It is then considered to be a simple alignment. Note that a simple alignment can have mismatches or deletions (in the reference). In other words, a deletion (encoded with a D in the CIGAR) is NOT considered to introduce a gap in the coverage, but a junction is. } Note that the last 2 items are not expicitly stored in the GAlignments object: they are inferred on-the-fly from the CIGAR and the "start". Optionally, a GAlignments object can have names (accessed thru the \code{\link[base]{names}} generic function) which will be coming from the QNAME field of the SAM/BAM records. The rest of this man page will focus on describing how to: \itemize{ \item Access the information stored in a GAlignments object in a way that is independent from how the data are actually stored internally. \item How to create and manipulate a GAlignments object. } } \section{Constructor}{ \describe{ \item{}{ \code{GAlignments(seqnames=Rle(factor()), pos=integer(0), cigar=character(0), strand=NULL, names=NULL, seqlengths=NULL, ...)}: Low-level GAlignments constructor. Generally not used directly. Named arguments in \code{...} are used as metadata columns. } } } \section{Accessors}{ In the code snippets below, \code{x} is a GAlignments object. \describe{ \item{}{ \code{length(x)}: Return the number of alignments in \code{x}. } \item{}{ \code{names(x)}, \code{names(x) <- value}: Get or set the names on \code{x}. See \code{\link{readGAlignments}} for how to automatically extract and set the names when reading the alignments from a file. } \item{}{ \code{seqnames(x)}, \code{seqnames(x) <- value}: Get or set the name of the reference sequence for each alignment in \code{x} (see Details section above for more information about the RNAME field of a SAM/BAM file). \code{value} can be a factor, or a 'factor' \link[S4Vectors]{Rle}, or a character vector. } \item{}{ \code{rname(x)}, \code{rname(x) <- value}: Same as \code{seqnames(x)} and \code{seqnames(x) <- value}. } \item{}{ \code{strand(x)}, \code{strand(x) <- value}: Get or set the strand for each alignment in \code{x} (see Details section above for more information about the strand of an alignment). \code{value} can be a factor (with levels +, - and *), or a 'factor' \link[S4Vectors]{Rle}, or a character vector. } \item{}{ \code{cigar(x)}: Returns a character vector of length \code{length(x)} containing the CIGAR string for each alignment. } \item{}{ \code{qwidth(x)}: Returns an integer vector of length \code{length(x)} containing the length of the query *after* hard clipping (i.e. the length of the query sequence that is stored in the corresponding SAM/BAM record). } \item{}{ \code{start(x)}, \code{end(x)}: Returns an integer vector of length \code{length(x)} containing the "start" and "end" (respectively) of the query for each alignment. See Details section above for the exact definitions of the "start" and "end" of a query. Note that \code{start(x)} and \code{end(x)} are equivalent to \code{start(granges(x))} and \code{end(granges(x))}, respectively (or, alternatively, to \code{min(rglist(x))} and \code{max(rglist(x))}, respectively). } \item{}{ \code{width(x)}: Equivalent to \code{width(granges(x))} (or, alternatively, to \code{end(x) - start(x) + 1L}). Note that this is generally different from \code{qwidth(x)} except for alignments with a trivial CIGAR string (i.e. a string of the form \code{"M"} where is a number). } \item{}{ \code{njunc(x)}: Returns an integer vector of the same length as \code{x} containing the number of junctions (i.e. N operations in the CIGAR) in each alignment. Equivalent to \code{unname(elementLengths(rglist(x))) - 1L}. } \item{}{ \code{seqinfo(x)}, \code{seqinfo(x) <- value}: Get or set the information about the underlying sequences. \code{value} must be a \link[GenomeInfoDb]{Seqinfo} object. } \item{}{ \code{seqlevels(x)}, \code{seqlevels(x) <- value}: Get or set the sequence levels. \code{seqlevels(x)} is equivalent to \code{seqlevels(seqinfo(x))} or to \code{levels(seqnames(x))}, those 2 expressions being guaranteed to return identical character vectors on a GAlignments object. \code{value} must be a character vector with no NAs. See \code{?\link{seqlevels}} for more information. } \item{}{ \code{seqlengths(x)}, \code{seqlengths(x) <- value}: Get or set the sequence lengths. \code{seqlengths(x)} is equivalent to \code{seqlengths(seqinfo(x))}. \code{value} can be a named non-negative integer or numeric vector eventually with NAs. } \item{}{ \code{isCircular(x)}, \code{isCircular(x) <- value}: Get or set the circularity flags. \code{isCircular(x)} is equivalent to \code{isCircular(seqinfo(x))}. \code{value} must be a named logical vector eventually with NAs. } \item{}{ \code{genome(x)}, \code{genome(x) <- value}: Get or set the genome identifier or assembly name for each sequence. \code{genome(x)} is equivalent to \code{genome(seqinfo(x))}. \code{value} must be a named character vector eventually with NAs. } \item{}{ \code{seqnameStyle(x)}: Get or set the seqname style for \code{x}. Note that this information is not stored in \code{x} but inferred by looking up \code{seqnames(x)} against a seqname style database stored in the \pkg{seqnames.db} metadata package (required). \code{seqnameStyle(x)} is equivalent to \code{seqnameStyle(seqinfo(x))} and can return more than 1 seqname style (with a warning) in case the style cannot be determined unambiguously. } } } \section{Coercion}{ In the code snippets below, \code{x} is a GAlignments object. \describe{ \item{}{ \code{grglist(x, use.mcols=FALSE, order.as.in.query=FALSE, drop.D.ranges=FALSE)}, \code{rglist(x, use.mcols=FALSE, order.as.in.query=FALSE, drop.D.ranges=FALSE)}: Return either a \link{GRangesList} or a \link[IRanges]{RangesList} object of length \code{length(x)} where the i-th element represents the ranges (with respect to the reference) of the i-th alignment in \code{x}. More precisely, the \link[IRanges]{RangesList} object returned by \code{rglist(x)} is a \link[IRanges]{CompressedIRangesList} object. If \code{use.mcols} is TRUE and \code{x} has metadata columns on it (accessible with \code{mcols(x)}), they're propagated to the returned object. The \code{order.as.in.query} toggle affects the order of the ranges \emph{within} each top-level element of the returned object. If \code{FALSE} (the default), then the ranges are ordered from 5' to 3' in elements associated with the plus strand (i.e. corresponding to alignments located on the plus strand), and from 3' to 5' in elements associated with the minus strand. So, whatever the strand is, the ranges are in ascending order (i.e. left-to-right). If \code{TRUE}, then the order of the ranges in elements associated with the \emph{minus} strand is reversed. So they end up being ordered from 5' to 3' too, which means that they are now in decending order (i.e. right-to-left). It also means that, when \code{order.as.in.query=TRUE} is used, the ranges are \emph{always} ordered consistently with the original "query template", that is, in the order defined by walking the "query template" from the beginning to the end. If \code{drop.D.ranges} is \code{TRUE}, then deletions (D operations in the CIGAR) are treated like junctions (N operations in the CIGAR), that is, the ranges corresponding to deletions are dropped. See Details section above for more information. } \item{}{ \code{granges(x, use.mcols=FALSE)}, \code{ranges(x)}: Return either a \link{GRanges} or a \link[IRanges]{Ranges} object of length \code{length(x)} where each element represents the regions in the reference to which a query is aligned. More precisely, the \link[IRanges]{Ranges} object returned by \code{ranges(x)} is an \link[IRanges]{IRanges} object. If \code{use.mcols} is TRUE and \code{x} has metadata columns on it (accessible with \code{mcols(x)}), they're propagated to the returned object. } \item{}{ \code{as(x, "GRangesList")}, \code{as(x, "GRanges")}, \code{as(x, "RangesList")}, \code{as(x, "Ranges")}: Alternate ways of doing \code{grglist(x, use.mcols=TRUE)}, \code{granges(x, use.mcols=TRUE)}, \code{rglist(x, use.mcols=TRUE)}, and \code{ranges(x)}, respectively. } } In the code snippet below, \code{x} is a \link[GenomicRanges]{GRanges} object. \describe{ \item{}{ \code{as(from, "GAlignments")}: Creates a GAlignments object from a \link[GenomicRanges]{GRanges} object. The metadata columns are propagated. cigar values are created from the sequence width unless a "cigar" metadata column already exists in \code{from}. } } } \section{Subsetting and related operations}{ In the code snippets below, \code{x} is a GAlignments object. \describe{ \item{}{ \code{x[i]}: Return a new GAlignments object made of the selected alignments. \code{i} can be a numeric or logical vector. } } } \section{Combining}{ \describe{ \item{}{ \code{c(...)}: Concatenates the GAlignments objects in \code{...}. } } } \section{Other methods}{ \describe{ \item{}{ \code{show(x)}: By default the \code{show} method displays 5 head and 5 tail elements. This can be changed by setting the global options \code{showHeadLines} and \code{showTailLines}. If the object length is less than (or equal to) the sum of these 2 options plus 1, then the full object is displayed. Note that these options also affect the display of \link{GRanges} and \link{GAlignmentPairs} objects, as well as other objects defined in the \pkg{IRanges} and \pkg{Biostrings} packages (e.g. \link[IRanges]{Ranges} and \link[Biostrings]{DNAStringSet} objects). } } } \references{ \url{http://samtools.sourceforge.net/} } \author{ H. Pages and P. Aboyoun } \seealso{ \itemize{ \item \code{\link{readGAlignments}} for reading genomic alignments from a file (typically a BAM file) into a GAlignments object. \item \link{GAlignmentPairs} objects for handling aligned paired-end reads. \item \link{junctions-methods} for extracting and summarizing junctions from a GAlignments object. \item \link[GenomicAlignments]{coverage-methods} for computing the coverage of a GAlignments object. \item \link[GenomicAlignments]{findOverlaps-methods} for finding overlapping genomic alignments. \item \code{\link[GenomeInfoDb]{seqinfo}} in the \pkg{GenomeInfoDb} package for getting/setting/modifying the sequence information stored in an object. \item The \link[GenomicRanges]{GRanges} and \link[GenomicRanges]{GRangesList} classes defined and documented in the \pkg{GenomicRanges} package. \item The \link[IRanges]{CompressedIRangesList} class defined and documented in the \pkg{IRanges} package. } } \examples{ library(Rsamtools) # for the ex1.bam file ex1_file <- system.file("extdata", "ex1.bam", package="Rsamtools") gal <- readGAlignments(ex1_file, param=ScanBamParam(what="flag")) gal ## --------------------------------------------------------------------- ## A. BASIC MANIPULATION ## --------------------------------------------------------------------- length(gal) head(gal) names(gal) # no names by default seqnames(gal) strand(gal) head(cigar(gal)) head(qwidth(gal)) table(qwidth(gal)) head(start(gal)) head(end(gal)) head(width(gal)) head(njunc(gal)) seqlevels(gal) ## Rename the reference sequences: seqlevels(gal) <- sub("seq", "chr", seqlevels(gal)) seqlevels(gal) grglist(gal) # a GRangesList object stopifnot(identical(unname(elementLengths(grglist(gal))), njunc(gal) + 1L)) granges(gal) # a GRanges object rglist(gal) # a CompressedIRangesList object stopifnot(identical(unname(elementLengths(rglist(gal))), njunc(gal) + 1L)) ranges(gal) # an IRanges object ## Modify the number of lines in 'show' options(showHeadLines=3) options(showTailLines=2) gal ## Revert to default options(showHeadLines=NULL) options(showTailLines=NULL) ## --------------------------------------------------------------------- ## B. SUBSETTING ## --------------------------------------------------------------------- gal[strand(gal) == "-"] gal[grep("I", cigar(gal), fixed=TRUE)] gal[grep("N", cigar(gal), fixed=TRUE)] # no junctions ## A confirmation that none of the alignments contains junctions (in ## other words, each alignment can be represented by a single genomic ## range on the reference): stopifnot(all(njunc(gal) == 0)) ## Different ways to subset: gal[6] # a GAlignments object of length 1 grglist(gal)[[6]] # a GRanges object of length 1 rglist(gal)[[6]] # a NormalIRanges object of length 1 ## Unlike N operations, D operations don't introduce gaps: ii <- grep("D", cigar(gal), fixed=TRUE) gal[ii] njunc(gal[ii]) grglist(gal[ii]) ## qwidth() vs width(): gal[qwidth(gal) != width(gal)] ## This MUST return an empty object: gal[cigar(gal) == "35M" & qwidth(gal) != 35] ## but this doesn't have too: gal[cigar(gal) != "35M" & qwidth(gal) == 35] } \keyword{methods} \keyword{classes} GenomicAlignments/man/GAlignmentsList-class.Rd0000644000175100017510000003251212607264575022427 0ustar00biocbuildbiocbuild\name{GAlignmentsList-class} \docType{class} % Class \alias{class:GAlignmentsList} \alias{GAlignmentsList-class} \alias{GAlignmentsList} % Constructors: \alias{GAlignmentsList} \alias{updateObject,GAlignmentsList-method} % Accessors: \alias{names,GAlignmentsList-method} \alias{names<-,GAlignmentsList-method} \alias{seqnames,GAlignmentsList-method} \alias{seqnames<-,GAlignmentsList-method} \alias{rname,GAlignmentsList-method} \alias{rname<-,GAlignmentsList-method} \alias{strand,GAlignmentsList-method} \alias{strand<-,GAlignmentsList-method} \alias{strand<-,GAlignmentsList,character-method} \alias{cigar,GAlignmentsList-method} \alias{qwidth,GAlignmentsList-method} \alias{njunc,GAlignmentsList-method} \alias{elementMetadata,GAlignmentsList-method} \alias{elementMetadata<-,GAlignmentsList-method} \alias{seqinfo,GAlignmentsList-method} \alias{seqinfo<-,GAlignmentsList-method} \alias{start,GAlignmentsList-method} \alias{end,GAlignmentsList-method} \alias{width,GAlignmentsList-method} % Coercion: \alias{coerce,GAlignmentsList,GRangesList-method} \alias{coerce,GAlignmentsList,GRanges-method} \alias{coerce,GAlignmentsList,RangesList-method} \alias{coerce,GAlignmentsList,Ranges-method} \alias{coerce,GAlignmentPairs,GAlignmentsList-method} \alias{grglist,GAlignmentsList-method} \alias{granges,GAlignmentsList-method} \alias{rglist,GAlignmentsList-method} \alias{ranges,GAlignmentsList-method} % Combining: \alias{c,GAlignmentsList-method} % extractList() and family: \alias{relistToClass,GAlignments-method} % show: \alias{show,GAlignmentsList-method} \title{GAlignmentsList objects} \description{ The GAlignmentsList class is a container for storing a collection of \link{GAlignments} objects. } \details{ A GAlignmentsList object contains a list of \link{GAlignments} objects. The majority of operations on this page are described in more detail on the GAlignments man page, see ?\code{GAlignments}. } \section{Constructor}{ \describe{ \item{}{ \code{GAlignmentsList(...)}: Creates a GAlignmentsList from a list of \link{GAlignments} objects. } } } \section{Accessors}{ In the code snippets below, \code{x} is a GAlignmentsList object. \describe{ \item{}{ \code{length(x)}: Return the number of elements in \code{x}. } \item{}{ \code{names(x)}, \code{names(x) <- value}: Get or set the names of the elements of \code{x}. } \item{}{ \code{seqnames(x)}, \code{seqnames(x) <- value}: Get or set the name of the reference sequences of the alignments in each element of \code{x}. } \item{}{ \code{rname(x)}, \code{rname(x) <- value}: Same as \code{seqnames(x)} and \code{seqnames(x) <- value}. } \item{}{ \code{strand(x)}, \code{strand(x) <- value}: Get or set the strand of the alignments in each element of \code{x}. } \item{}{ \code{cigar(x)}: Returns a character list of length \code{length(x)} containing the CIGAR string for the alignments in each element of \code{x}. } \item{}{ \code{qwidth(x)}: Returns an integer list of length \code{length(x)} containing the length of the alignments in each element of \code{x} *after* hard clipping (i.e. the length of the query sequence that is stored in the corresponding SAM/BAM record). } \item{}{ \code{start(x)}, \code{end(x)}: Returns an integer list of length \code{length(x)} containing the "start" and "end" (respectively) of the alignments in each element of \code{x}. } \item{}{ \code{width(x)}: Returns an integer list of length \code{length(x)} containing the "width" of the alignments in each element of \code{x}. } \item{}{ \code{njunc(x)}: Returns an integer list of length \code{x} containing the number of junctions (i.e. N operations in the CIGAR) for the alignments in each element of \code{x}. } \item{}{ \code{seqinfo(x)}, \code{seqinfo(x) <- value}: Get or set the information about the underlying sequences. \code{value} must be a \link[GenomeInfoDb]{Seqinfo} object. } \item{}{ \code{seqlevels(x)}, \code{seqlevels(x) <- value}: Get or set the sequence levels of the alignments in each element of \code{x}. } \item{}{ \code{seqlengths(x)}, \code{seqlengths(x) <- value}: Get or set the sequence lengths for each element of \code{x}. \code{seqlengths(x)} is equivalent to \code{seqlengths(seqinfo(x))}. \code{value} can be a named non-negative integer or numeric vector eventually with NAs. } \item{}{ \code{isCircular(x)}, \code{isCircular(x) <- value}: Get or set the circularity flags for the alignments in each element in \code{x}. \code{value} must be a named logical list eventually with NAs. } \item{}{ \code{genome(x)}, \code{genome(x) <- value}: Get or set the genome identifier or assembly name for the alignments in each element of \code{x}. \code{value} must be a named character list eventually with NAs. } \item{}{ \code{seqnameStyle(x)}: Get or set the seqname style for alignments in each element of \code{x}. } } } \section{Coercion}{ In the code snippets below, \code{x} is a GAlignmentsList object. \describe{ \item{}{ \code{granges(x, use.mcols=FALSE, ignore.strand=FALSE)}, \code{ranges(x)}: Return either a \link{GRanges} or a \link[IRanges]{IRanges} object of length \code{length(x)}. Note this coercion IGNORES the cigar information. The resulting ranges span the entire range, including any junctions or spaces between paired-end reads. If \code{use.mcols} is TRUE and \code{x} has metadata columns on it (accessible with \code{mcols(x)}), they're propagated to the returned object. \code{granges} coercion supports \code{ignore.strand} to allow ranges of opposite strand to be combined (see examples). All ranges in the resulting GRanges will have strand \sQuote{*}. } \item{}{ \code{grglist(x, use.mcols=FALSE, ignore.strand=FALSE)}, \code{rglist(x, use.mcols=FALSE)}: Return either a \link{GRangesList} or an \link[IRanges]{IRangesList} object of length \code{length(x)}. This coercion RESPECTS the cigar information. The resulting ranges are fragments of the original ranges that do not include junctions or spaces between paired-end reads. If \code{use.mcols} is TRUE and \code{x} has metadata columns on it (accessible with \code{mcols(x)}), they're propagated to the returned object. \code{grglist} coercion supports \code{ignore.strand} to allow ranges of opposite strand to be combined (see examples). When \code{ignore.strand} is TRUE all ranges in the resulting GRangesList have strand \sQuote{*}. } \item{}{ \code{as(x, "GRangesList")}, \code{as(x, "GRanges")}, \code{as(x, "RangesList")}, \code{as(x, "Ranges")}: Alternate ways of doing \code{grglist(x, use.mcols=TRUE)}, \code{granges(x, use.mcols=TRUE)}, \code{rglist(x, use.mcols=TRUE)}, and \code{ranges(x)}, respectively. } \item{}{ \code{as.data.frame(x, row.names = NULL, optional = FALSE, ..., value.name = "value", use.outer.mcols = FALSE, group_name.as.factor = FALSE)}: Coerces \code{x} to a \code{data.frame}. See as.data.frame on the \code{List} man page for details (?\code{List}). } \item{}{ \code{as(x, "GALignmentsList")}: Here \code{x} is a \link{GAlignmentPairs} object. Return a GAlignmentsList object of length \code{length(x)} where the i-th list element represents the ranges of the i-th alignment pair in \code{x}. } } } \section{Subsetting and related operations}{ In the code snippets below, \code{x} is a GAlignmentsList object. \describe{ \item{}{ \code{x[i]}, \code{x[i] <- value}: Get or set list elements \code{i}. \code{i} can be a numeric or logical vector. \code{value} must be a GAlignments. } \item{}{ \code{x[[i]]}, \code{x[[i]] <- value}: Same as \code{x[i]}, \code{x[i] <- value}. } \item{}{ \code{x[i, j]}, \code{x[i, j] <- value}: Get or set list elements \code{i} with optional metadata columns \code{j}. \code{i} can be a numeric, logical or missing. \code{value} must be a GAlignments. } } } \section{Combining}{ \describe{ \item{}{ \code{c(...)}: Concatenates the GAlignmentsList objects in \code{...}. } } } \references{ \url{http://samtools.sourceforge.net/} } \author{Valerie Obenchain q2 + 1} for all \code{k} in \code{seq_len(L)}. } \item{}{ \code{encoding(x)}: Factor of the same length as \code{x} where the i-th element is the encoding obtained by comparing each range in \code{Qi} with all the ranges in \code{tSi = Si[(1+L):(length(Si)-R)]} (\code{tSi} stands for "trimmed Si"). More precisely, here is how this encoding is obtained: \enumerate{ \item All the ranges in \code{Qi} are compared with \code{tSi[1]}, then with \code{tSi[2]}, etc... At each step (one step per range in \code{tSi}), comparing all the ranges in \code{Qi} with \code{tSi[k]} is done with \code{rangeComparisonCodeToLetter(compare(Qi, tSi[k]))}. So at each step, we end up with a vector of \code{M} single letters (where \code{M} is \code{length(Qi)}). \item Each vector obtained previously (1 vector per range in \code{tSi}, all of them of length \code{M}) is turned into a single string (called "encoding block") by pasting its individual letters together. \item All the encoding blocks (1 per range in \code{tSi}) are pasted together into a single long string and separated by colons (\code{":"}). An additional colon is prepended to the long string and another one appended to it. \item Finally, a special block containing the value of \code{M} is prepended to the long string. The final string is the encoding. } } \item{}{ \code{levels(x)}: Equivalent to \code{levels(encoding(x))}. } \item{}{ \code{flippedQuery(x)}: Whether or not the top-level element in query used for computing the encoding was "flipped" before the encoding was computed. Note that this flipping generally affects the "left offset", "right offset", in addition to the encoding itself. } \item{}{ \code{Lencoding(x)}, \code{Rencoding(x)}: Extract the "left encodings" and "right encodings" of paired-end encodings. Paired-end encodings are obtained by encoding paired-end overlaps i.e. overlaps between paired-end reads and transcripts (typically). The difference between a single-end encoding and a paired-end encoding is that all the blocks in the latter contain a \code{"--"} separator to mark the separation between the "left encoding" and the "right encoding". See the "Overlap encodings" vignette located in this package for examples of paired-end encodings. } \item{}{ \code{njunc(x)}, \code{Lnjunc(x)}, \code{Rnjunc(x)}: Extract the number of junctions in each encoding by looking at their first block (aka special block). If an element \code{xi} in \code{x} is a paired-end encoding, then \code{Lnjunc(xi)}, \code{Rnjunc(xi)}, and \code{njunc(xi)}, return \code{njunc(Lencoding(xi))}, \code{njunc(Rencoding(xi))}, and \code{Lnjunc(xi) + Rnjunc(xi)}, respectively. } } } \section{Coercing an OverlapEncodings object}{ In the following code snippets, \code{x} is an OverlapEncodings object. \describe{ \item{}{ \code{as.data.frame(x)}: Return \code{x} as a data frame with columns \code{"Loffset"}, \code{"Roffset"} and \code{"encoding"}. } } } \author{H. Pages} \seealso{ \itemize{ \item The "OverlapEncodings" vignette in this package. \item The \code{\link{encodeOverlaps}} function for computing "overlap encodings". \item The \code{\link[S4Vectors]{compare}} function in the \pkg{IRanges} package for the interpretation of the strings returned by \code{encoding}. \item The \link[GenomicRanges]{GRangesList} class defined and documented in the \pkg{GenomicRanges} package. } } \examples{ example(encodeOverlaps) # to generate the 'ovenc' object length(ovenc) Loffset(ovenc) Roffset(ovenc) encoding(ovenc) levels(ovenc) nlevels(ovenc) flippedQuery(ovenc) njunc(ovenc) as.data.frame(ovenc) njunc(levels(ovenc)) } \keyword{methods} \keyword{classes} GenomicAlignments/man/cigar-utils.Rd0000644000175100017510000004365412607264575020514 0ustar00biocbuildbiocbuild\name{cigar-utils} \alias{cigar-utils} \alias{validCigar} \alias{CIGAR_OPS} \alias{explodeCigarOps} \alias{explodeCigarOpLengths} \alias{cigarToRleList} \alias{cigarOpTable} \alias{cigarRangesAlongReferenceSpace} \alias{cigarRangesAlongQuerySpace} \alias{cigarRangesAlongPairwiseSpace} \alias{extractAlignmentRangesOnReference} \alias{cigarWidthAlongReferenceSpace} \alias{cigarWidthAlongQuerySpace} \alias{cigarWidthAlongPairwiseSpace} \alias{cigarNarrow} \alias{cigarQNarrow} \alias{queryLoc2refLoc} \alias{queryLocs2refLocs} \title{ CIGAR utility functions } \description{ Utility functions for low-level CIGAR manipulation. } \usage{ ## -=-= Supported CIGAR operations =-=- CIGAR_OPS ## -=-= Transform CIGARs into other useful representations =-=- explodeCigarOps(cigar, ops=CIGAR_OPS) explodeCigarOpLengths(cigar, ops=CIGAR_OPS) cigarToRleList(cigar) ## -=-= Summarize CIGARs =-=- cigarOpTable(cigar) ## -=-= From CIGARs to ranges =-=- cigarRangesAlongReferenceSpace(cigar, flag=NULL, N.regions.removed=FALSE, pos=1L, f=NULL, ops=CIGAR_OPS, drop.empty.ranges=FALSE, reduce.ranges=FALSE, with.ops=FALSE) cigarRangesAlongQuerySpace(cigar, flag=NULL, before.hard.clipping=FALSE, after.soft.clipping=FALSE, ops=CIGAR_OPS, drop.empty.ranges=FALSE, reduce.ranges=FALSE, with.ops=FALSE) cigarRangesAlongPairwiseSpace(cigar, flag=NULL, N.regions.removed=FALSE, dense=FALSE, ops=CIGAR_OPS, drop.empty.ranges=FALSE, reduce.ranges=FALSE, with.ops=FALSE) extractAlignmentRangesOnReference(cigar, pos=1L, drop.D.ranges=FALSE, f=NULL) ## -=-= From CIGARs to sequence lengths =-=- cigarWidthAlongReferenceSpace(cigar, flag=NULL, N.regions.removed=FALSE) cigarWidthAlongQuerySpace(cigar, flag=NULL, before.hard.clipping=FALSE, after.soft.clipping=FALSE) cigarWidthAlongPairwiseSpace(cigar, flag=NULL, N.regions.removed=FALSE, dense=FALSE) ## -=-= Narrow CIGARs =-=- cigarNarrow(cigar, start=NA, end=NA, width=NA) cigarQNarrow(cigar, start=NA, end=NA, width=NA) ## -=-= Translate coordinates between query and reference spaces =-=- queryLoc2refLoc(qloc, cigar, pos=1L) queryLocs2refLocs(qlocs, cigar, pos=1L, flag=NULL) } \arguments{ \item{cigar}{ A character vector or factor containing the extended CIGAR strings. It can be of arbitrary length except for \code{queryLoc2refLoc} which only accepts a single CIGAR (as a character vector or factor of length 1). } \item{ops}{ Character vector containing the extended CIGAR operations to actually consider. Zero-length operations or operations not listed \code{ops} are ignored. } \item{flag}{ \code{NULL} or an integer vector containing the SAM flag for each read. According to the SAM Spec v1.4, flag bit 0x4 is the only reliable place to tell whether a segment (or read) is mapped (bit is 0) or not (bit is 1). If \code{flag} is supplied, then \code{cigarRangesAlongReferenceSpace}, \code{cigarRangesAlongQuerySpace}, \code{cigarRangesAlongPairwiseSpace}, and \code{extractAlignmentRangesOnReference} don't produce any range for unmapped reads i.e. they treat them as if their CIGAR was empty (independently of what their CIGAR is). If \code{flag} is supplied, then \code{cigarWidthAlongReferenceSpace}, \code{cigarWidthAlongQuerySpace}, and \code{cigarWidthAlongPairwiseSpace} return \code{NA}s for unmapped reads. } \item{N.regions.removed}{ \code{TRUE} or \code{FALSE}. If \code{TRUE}, then \code{cigarRangesAlongReferenceSpace} and \code{cigarWidthAlongReferenceSpace} report ranges/widths with respect to the "reference" space from which the N regions have been removed, and \code{cigarRangesAlongPairwiseSpace} and \code{cigarWidthAlongPairwiseSpace} report them with respect to the "pairwise" space from which the N regions have been removed. } \item{pos}{ An integer vector containing the 1-based leftmost position/coordinate for each (eventually clipped) read sequence. Must have length 1 (in which case it's recycled to the length of \code{cigar}), or the same length as \code{cigar}. } \item{f}{ \code{NULL} or a factor of length \code{cigar}. If \code{NULL}, then the ranges are grouped by alignment i.e. the returned \link[IRanges]{IRangesList} object has 1 list element per element in \code{cigar}. Otherwise they are grouped by factor level i.e. the returned \link[IRanges]{IRangesList} object has 1 list element per level in \code{f} and is named with those levels. For example, if \code{f} is a factor containing the chromosome for each read, then the returned \link[IRanges]{IRangesList} object will have 1 list element per chromosome and each list element will contain all the ranges on that chromosome. } \item{drop.empty.ranges}{ Should empty ranges be dropped? } \item{reduce.ranges}{ Should adjacent ranges coming from the same cigar be merged or not? Using \code{TRUE} can significantly reduce the size of the returned object. } \item{with.ops}{ \code{TRUE} or \code{FALSE} indicating whether the returned ranges should be named with their corresponding CIGAR operation. } \item{before.hard.clipping}{ \code{TRUE} or \code{FALSE}. If \code{TRUE}, then \code{cigarRangesAlongQuerySpace} and \code{cigarWidthAlongQuerySpace} report ranges/widths with respect to the "query" space to which the H regions have been added. \code{before.hard.clipping} and \code{after.soft.clipping} cannot both be \code{TRUE}. } \item{after.soft.clipping}{ \code{TRUE} or \code{FALSE}. If \code{TRUE}, then \code{cigarRangesAlongQuerySpace} and \code{cigarWidthAlongQuerySpace} report ranges/widths with respect to the "query" space from which the S regions have been removed. \code{before.hard.clipping} and \code{after.soft.clipping} cannot both be \code{TRUE}. } \item{dense}{ \code{TRUE} or \code{FALSE}. If \code{TRUE}, then \code{cigarRangesAlongPairwiseSpace} and \code{cigarWidthAlongPairwiseSpace} report ranges/widths with respect to the "pairwise" space from which the I, D, and N regions have been removed. \code{N.regions.removed} and \code{dense} cannot both be \code{TRUE}. } \item{drop.D.ranges}{ Should the ranges corresponding to a deletion from the reference (encoded with a D in the CIGAR) be dropped? By default we keep them to be consistent with the pileup tool from SAMtools. Note that, when \code{drop.D.ranges} is \code{TRUE}, then Ds and Ns in the CIGAR are equivalent. } \item{start,end,width}{ Vectors of integers. NAs and negative values are accepted and "solved" according to the rules of the SEW (Start/End/Width) interface (see \code{?\link[IRanges]{solveUserSEW}} for the details). } \item{qloc}{ An integer vector containing "query-based locations" i.e. 1-based locations relative to the query sequence stored in the SAM/BAM file. } \item{qlocs}{ A list of the same length as \code{cigar} where each element is an integer vector containing "query-based locations" i.e. 1-based locations relative to the corresponding query sequence stored in the SAM/BAM file. } } \value{ \code{CIGAR_OPS} is a predefined character vector containing the supported extended CIGAR operations: M, I, D, N, S, H, P, =, X. See p. 4 of the SAM Spec v1.4 at \url{http://samtools.sourceforge.net/} for the list of extended CIGAR operations and their meanings. For \code{explodeCigarOps} and \code{explodeCigarOpLengths}: Both functions return a list of the same length as \code{cigar} where each list element is a character vector (for \code{explodeCigarOps}) or an integer vector (for \code{explodeCigarOpLengths}). The 2 lists have the same shape, that is, same \code{length()} and same \code{elementLengths()}. The i-th character vector in the list returned by \code{explodeCigarOps} contains one single-letter string per CIGAR operation in \code{cigar[i]}. The i-th integer vector in the list returned by \code{explodeCigarOpLengths} contains the corresponding CIGAR operation lengths. Zero-length operations or operations not listed in \code{ops} are ignored. For \code{cigarToRleList}: A \link[IRanges]{CompressedRleList} object. For \code{cigarOpTable}: An integer matrix with number of rows equal to the length of \code{cigar} and nine columns, one for each extended CIGAR operation. For \code{cigarRangesAlongReferenceSpace}, \code{cigarRangesAlongQuerySpace}, \code{cigarRangesAlongPairwiseSpace}, and \code{extractAlignmentRangesOnReference}: An \link[IRanges]{IRangesList} object (more precisely a \link[IRanges]{CompressedIRangesList} object) with 1 list element per element in \code{cigar}. However, if \code{f} is a factor, then the returned \link[IRanges]{IRangesList} object can be a \link[IRanges]{SimpleIRangesList} object (instead of \link[IRanges]{CompressedIRangesList}), and in that case, has 1 list element per level in \code{f} and is named with those levels. For \code{cigarWidthAlongReferenceSpace} and \code{cigarWidthAlongPairwiseSpace}: An integer vector of the same length as \code{cigar} where each element is the width of the alignment with respect to the "reference" and "pairwise" space, respectively. More precisely, for \code{cigarWidthAlongReferenceSpace}, the returned widths are the lengths of the alignments on the reference, N gaps included (except if \code{N.regions.removed} is \code{TRUE}). NAs or \code{"*"} in \code{cigar} will produce NAs in the returned vector. For \code{cigarWidthAlongQuerySpace}: An integer vector of the same length as \code{cigar} where each element is the length of the corresponding query sequence as inferred from the CIGAR string. Note that, by default (i.e. if \code{before.hard.clipping} and \code{after.soft.clipping} are \code{FALSE}), this is the length of the query sequence stored in the SAM/BAM file. If \code{before.hard.clipping} or \code{after.soft.clipping} is \code{TRUE}, the returned widths are the lengths of the query sequences before hard clipping or after soft clipping. NAs or \code{"*"} in \code{cigar} will produce NAs in the returned vector. For \code{cigarNarrow} and \code{cigarQNarrow}: A character vector of the same length as \code{cigar} containing the narrowed cigars. In addition the vector has an "rshift" attribute which is an integer vector of the same length as \code{cigar}. It contains the values that would need to be added to the POS field of a SAM/BAM file as a consequence of this cigar narrowing. For \code{queryLoc2refLoc}: An integer vector of the same length as \code{qloc} containing the "reference-based locations" (i.e. the 1-based locations relative to the reference sequence) corresponding to the "query-based locations" passed in \code{qloc}. For \code{queryLocs2refLocs}: A list of the same length as \code{qlocs} where each element is an integer vector containing the "reference-based locations" corresponding to the "query-based locations" passed in the corresponding element in \code{qlocs}. } \references{ \url{http://samtools.sourceforge.net/} } \author{ H. Pages and P. Aboyoun } \seealso{ \itemize{ \item The \link[GenomicAlignments]{sequenceLayer} function in the \pkg{GenomicAlignments} package for laying the query sequences alongside the "reference" or "pairwise" spaces. \item The \link{GAlignments} container for storing a set of genomic alignments. \item The \link[IRanges]{IRanges}, \link[IRanges]{IRangesList}, and \link[IRanges]{RleList} classes in the \pkg{IRanges} package. \item The \code{\link[IRanges]{coverage}} generic and methods for computing the coverage across a set of ranges or genomic ranges. } } \examples{ ## --------------------------------------------------------------------- ## A. CIGAR_OPS, explodeCigarOps(), explodeCigarOpLengths(), ## cigarToRleList(), and cigarOpTable() ## --------------------------------------------------------------------- ## Supported CIGAR operations: CIGAR_OPS ## Transform CIGARs into other useful representations: cigar1 <- "3H15M55N4M2I6M2D5M6S" cigar2 <- c("40M2I9M", cigar1, "2S10M2000N15M", "3H33M5H") explodeCigarOps(cigar2) explodeCigarOpLengths(cigar2) explodeCigarOpLengths(cigar2, ops=c("I", "S")) cigarToRleList(cigar2) ## Summarize CIGARs: cigarOpTable(cigar2) ## --------------------------------------------------------------------- ## B. From CIGARs to ranges and to sequence lengths ## --------------------------------------------------------------------- ## CIGAR ranges along the "reference" space: cigarRangesAlongReferenceSpace(cigar1, with.ops=TRUE)[[1]] cigarRangesAlongReferenceSpace(cigar1, reduce.ranges=TRUE, with.ops=TRUE)[[1]] ops <- setdiff(CIGAR_OPS, "N") cigarRangesAlongReferenceSpace(cigar1, ops=ops, with.ops=TRUE)[[1]] cigarRangesAlongReferenceSpace(cigar1, ops=ops, reduce.ranges=TRUE, with.ops=TRUE)[[1]] ops <- setdiff(CIGAR_OPS, c("D", "N")) cigarRangesAlongReferenceSpace(cigar1, ops=ops, with.ops=TRUE)[[1]] cigarWidthAlongReferenceSpace(cigar1) pos2 <- c(1, 1001, 1, 351) cigarRangesAlongReferenceSpace(cigar2, pos=pos2, with.ops=TRUE) res1a <- extractAlignmentRangesOnReference(cigar2, pos=pos2) res1b <- cigarRangesAlongReferenceSpace(cigar2, pos=pos2, ops=setdiff(CIGAR_OPS, "N"), reduce.ranges=TRUE) stopifnot(identical(res1a, res1b)) res2a <- extractAlignmentRangesOnReference(cigar2, pos=pos2, drop.D.ranges=TRUE) res2b <- cigarRangesAlongReferenceSpace(cigar2, pos=pos2, ops=setdiff(CIGAR_OPS, c("D", "N")), reduce.ranges=TRUE) stopifnot(identical(res2a, res2b)) seqnames <- factor(c("chr6", "chr6", "chr2", "chr6"), levels=c("chr2", "chr6")) extractAlignmentRangesOnReference(cigar2, pos=pos2, f=seqnames) ## CIGAR ranges along the "query" space: cigarRangesAlongQuerySpace(cigar2, with.ops=TRUE) cigarWidthAlongQuerySpace(cigar1) cigarWidthAlongQuerySpace(cigar1, before.hard.clipping=TRUE) ## CIGAR ranges along the "pairwise" space: cigarRangesAlongPairwiseSpace(cigar2, with.ops=TRUE) cigarRangesAlongPairwiseSpace(cigar2, dense=TRUE, with.ops=TRUE) ## --------------------------------------------------------------------- ## C. PERFORMANCE ## --------------------------------------------------------------------- if (interactive()) { ## We simulate 20 millions aligned reads, all 40-mers. 95% of them ## align with no indels. 5% align with a big deletion in the ## reference. In the context of an RNAseq experiment, those 5% would ## be suspected to be "junction reads". set.seed(123) nreads <- 20000000L njunctionreads <- nreads * 5L / 100L cigar3 <- character(nreads) cigar3[] <- "40M" junctioncigars <- paste( paste(10:30, "M", sep=""), paste(sample(80:8000, njunctionreads, replace=TRUE), "N", sep=""), paste(30:10, "M", sep=""), sep="") cigar3[sample(nreads, njunctionreads)] <- junctioncigars some_fake_rnames <- paste("chr", c(1:6, "X"), sep="") rname <- factor(sample(some_fake_rnames, nreads, replace=TRUE), levels=some_fake_rnames) pos <- sample(80000000L, nreads, replace=TRUE) ## The following takes < 3 sec. to complete: system.time(irl1 <- extractAlignmentRangesOnReference(cigar3, pos=pos)) ## The following takes < 4 sec. to complete: system.time(irl2 <- extractAlignmentRangesOnReference(cigar3, pos=pos, f=rname)) ## The sizes of the resulting objects are about 240M and 160M, ## respectively: object.size(irl1) object.size(irl2) } ## --------------------------------------------------------------------- ## D. COMPUTE THE COVERAGE OF THE READS STORED IN A BAM FILE ## --------------------------------------------------------------------- ## The information stored in a BAM file can be used to compute the ## "coverage" of the mapped reads i.e. the number of reads that hit any ## given position in the reference genome. ## The following function takes the path to a BAM file and returns an ## object representing the coverage of the mapped reads that are stored ## in the file. The returned object is an RleList object named with the ## names of the reference sequences that actually receive some coverage. extractCoverageFromBAM <- function(file) { ## This ScanBamParam object allows us to load only the necessary ## information from the file. param <- ScanBamParam(flag=scanBamFlag(isUnmappedQuery=FALSE, isDuplicate=FALSE), what=c("rname", "pos", "cigar")) bam <- scanBam(file, param=param)[[1]] ## Note that unmapped reads and reads that are PCR/optical duplicates ## have already been filtered out by using the ScanBamParam object above. irl <- extractAlignmentRangesOnReference(bam$cigar, pos=bam$pos, f=bam$rname) irl <- irl[elementLengths(irl) != 0] # drop empty elements coverage(irl) } library(Rsamtools) f1 <- system.file("extdata", "ex1.bam", package="Rsamtools") extractCoverageFromBAM(f1) ## --------------------------------------------------------------------- ## E. cigarNarrow() and cigarQNarrow() ## --------------------------------------------------------------------- ## cigarNarrow(): cigarNarrow(cigar1) # only drops the soft/hard clipping cigarNarrow(cigar1, start=10) cigarNarrow(cigar1, start=15) cigarNarrow(cigar1, start=15, width=57) cigarNarrow(cigar1, start=16) #cigarNarrow(cigar1, start=16, width=55) # ERROR! (empty cigar) cigarNarrow(cigar1, start=71) cigarNarrow(cigar1, start=72) cigarNarrow(cigar1, start=75) ## cigarQNarrow(): cigarQNarrow(cigar1, start=4, end=-3) cigarQNarrow(cigar1, start=10) cigarQNarrow(cigar1, start=19) cigarQNarrow(cigar1, start=24) } \keyword{manip} GenomicAlignments/man/coordinate-mapping-methods.Rd0000644000175100017510000002704412607264575023505 0ustar00biocbuildbiocbuild\name{mapToAlignments} \alias{coordinate-mapping-methods} \alias{mapToAlignments} \alias{mapToAlignments,Ranges,GAlignments-method} \alias{mapToAlignments,GenomicRanges,GAlignments-method} \alias{pmapToAlignments} \alias{pmapToAlignments,Ranges,GAlignments-method} \alias{pmapToAlignments,GenomicRanges,GAlignments-method} \alias{mapFromAlignments} \alias{mapFromAlignments,Ranges,GAlignments-method} \alias{mapFromAlignments,GenomicRanges,GAlignments-method} \alias{pmapFromAlignments} \alias{pmapFromAlignments,Ranges,GAlignments-method} \alias{pmapFromAlignments,GenomicRanges,GAlignments-method} \title{Map range coordinates between reads and genome space using CIGAR alignments} \description{ Map range coordinates between reads (local) and genome (reference) space using the CIGAR in a \code{GAlignments} object. See \code{?\link[GenomicFeatures]{mapToTranscripts}} in the \pkg{GenomicRanges} package for mapping coordinates between features in the transcriptome and genome space. } \usage{ \S4method{mapToAlignments}{GenomicRanges,GAlignments}(x, alignments, ...) \S4method{pmapToAlignments}{GenomicRanges,GAlignments}(x, alignments, ...) \S4method{mapFromAlignments}{GenomicRanges,GAlignments}(x, alignments, ...) \S4method{pmapFromAlignments}{GenomicRanges,GAlignments}(x, alignments, ...) } \arguments{ \item{x}{ \code{\linkS4class{GenomicRanges}} object of positions to be mapped. \code{x} must have names when mapping to the genome. } \item{alignments}{ A \code{\linkS4class{GAlignments}} object that represents the alignment of \code{x} to the genome. The \code{aligments} object must have names. When mapping to the genome names are used to determine mapping pairs and in the reverse direction they are used as the seqlevels of the output object. } \item{\dots}{ Arguments passed to other methods. } } \details{ These methods use a \code{GAlignments} object to represent the alignment between the ranges in \code{x} and the output. The following CIGAR operations in the "Extended CIGAR format" are used in the mapping algorithm: \itemize{ \item{M, X, =} Sequence match or mismatch \item{I} Insertion to the reference \item{D} Deletion from the reference \item{N} Skipped region from the reference \item{S} Soft clip on the read \item{H} Hard clip on the read \item{P} Silent deletion from the padded reference } \itemize{ \item{\code{mapToAlignments}, \code{pmapToAlignments}}{ The CIGAR is used to map the genomic (reference) position \code{x} to local coordinates. The mapped position starts at \preformatted{ start(x) - start(alignments) + 1 } and is incremented or decremented as the algorithm walks the length of the CIGAR. A successful mapping in this direction requires that \code{x} fall within \code{alignments}. The seqlevels of the return object are taken from the \code{alignments} object and will be a name descriptive of the read or aligned region. In this direction, mapping is attempted between all elements of \code{x} and all elements of \code{alignments}. } \item{\code{mapFromAlignments}, \code{pmapFromAlignments}}{ The CIGAR is used to map the local position \code{x} to genomic (reference) coordinates. The mapped position starts at \preformatted{ start(x) + start(alignments) - 1 } and is incremented or decremented as the algorithm walks the length of the CIGAR. A successful mapping in this direction requires that the width of \code{alignments} is <= the width of \code{x}. When mapping to the genome, name matching is used to determine the mapping pairs (vs attempting to match all possible pairs). Ranges in \code{x} are only mapped to ranges in \code{alignments} with the same name. Name matching is motivated by use cases such as differentially expressed regions where the expressed regions in \code{x} would only be related to a subset of regions in \code{alignments}, which may contains gene or transcript ranges. } \item{element-wise versions}{ \code{pmapToAlignments} and \code{pmapFromAlignments} are element-wise (aka `parallel`) versions of \code{mapToAlignments} and \code{mapFromAlignments}. The i-th range in \code{x} is mapped to the i-th range in \code{alignments}; \code{x} and \code{alignments} must have the same length. Ranges in \code{x} that do not map (out of bounds) are returned as zero-width ranges starting at 0. These ranges are given the special seqname of "UNMAPPED". Note the non-parallel methods do not return unmapped ranges so the "UNMAPPED" seqname is unique to \code{pmapToAlignments} and \code{pmapFromAlignments}. } \item{strand}{ By SAM convention, the CIGAR string is reported for mapped reads on the forward genomic strand. There is no need to consider strand in these methods. The output of these methods will always be unstranded (i.e., "*"). } } } \value{ An object the same class as \code{x}. Parallel methods return an object the same shape as \code{x}. Ranges that cannot be mapped (out of bounds) are returned as zero-width ranges starting at 0 with a seqname of "UNMAPPED". Non-parallel methods return an object that varies in length similar to a Hits object. The result only contains mapped records, out of bound ranges are not returned. \code{xHits} and \code{alignmentsHits} metadata columns indicate the elements of \code{x} and \code{alignments} used in the mapping. When present, names from \code{x} are propagated to the output. When mapping locally, the seqlevels of the output are the names on the \code{alignment} object. When mapping globally, the output seqlevels are the seqlevels of \code{alignment} which are usually chromosome names. } \seealso{ \itemize{ \item \code{?\link[GenomicFeatures]{mapToTranscripts}} in the in the \pkg{GenomicFeatures} package for methods mapping between transcriptome and genome space. \item \url{http://samtools.sourceforge.net/} for a description of the Extended CIGAR format. } } \author{V. Obenchain, M. Lawrence and H. Pages} \examples{ ## --------------------------------------------------------------------- ## A. Basic use ## --------------------------------------------------------------------- ## 1. Map to local space with mapToAlignments() ## --------------------------------------------------------------------- ## Mapping to local coordinates requires 'x' to be within 'alignments'. ## In this 'x', the second range is too long and can't be mapped. alignments <- GAlignments("chr1", 10L, "11M", strand("*"), names="read_A") x <- GRanges("chr1", IRanges(c(12, 12), width=c(6, 20))) mapToAlignments(x, alignments) ## The element-wise version of the function returns unmapped ranges ## as zero-width ranges with a seqlevel of "UNMAPPED": pmapToAlignments(x, c(alignments, alignments)) ## Mapping the same range through different alignments demonstrates ## how the CIGAR operations affect the outcome. ops <- c("no-op", "junction", "insertion", "deletion") x <- GRanges(rep("chr1", 4), IRanges(rep(12, 4), width=rep(6, 4), names=ops)) alignments <- GAlignments(rep("chr1", 4), rep(10L, 4), cigar = c("11M", "5M2N4M", "5M2I4M", "5M2D4M"), strand = strand(rep("*", 4)), names = paste0("region_", 1:4)) pmapToAlignments(x, alignments) ## 2. Map to genome space with mapFromAlignments() ## --------------------------------------------------------------------- ## One of the criteria when mapping to genomic coordinates is that the ## shifted 'x' range falls within 'alignments'. Here the first 'x' ## range has a shifted start value of 14 (5 + 10 - 1 = 14) with a width of ## 2 and so is successfully mapped. The second has a shifted start of 29 ## (20 + 10 - 1 = 29) which is outside the range of 'alignments'. x <- GRanges("chr1", IRanges(c(5, 20), width=2, names=rep("region_A", 2))) alignments <- GAlignments("chr1", 10L, "11M", strand("*"), names="region_A") mapFromAlignments(x, alignments) ## Another characteristic of mapping this direction is the name matching ## used to determine pairs. Mapping is only attempted between ranges in 'x' ## and 'alignments' with the same name. If we change the name of the first 'x' ## range, only the second will be mapped to 'alignment'. We know the second ## range fails to map so we get an empty result. names(x) <- c("region_B", "region_A") mapFromAlignments(x, alignments) ## CIGAR operations: insertions reduce the width of the output while ## junctions and deletions increase it. ops <- c("no-op", "junction", "insertion", "deletion") x <- GRanges(rep("chr1", 4), IRanges(rep(3, 4), width=rep(5, 4), names=ops)) alignments <- GAlignments(rep("chr1", 4), rep(10L, 4), cigar = c("11M", "5M2N4M", "5M2I4M", "5M2D4M"), strand = strand(rep("*", 4))) pmapFromAlignments(x, alignments) ## --------------------------------------------------------------------- ## B. TATA box motif: mapping from read -> genome -> transcript ## --------------------------------------------------------------------- ## The TATA box motif is a conserved DNA sequence in the core promoter ## region. Many eukaryotic genes have a TATA box located approximately ## 25-35 base pairs upstream of the transcription start site. The motif is ## the binding site of general transcription factors or histones and ## plays a key role in transcription. ## In this example, the position of the TATA box motif (if present) is ## located in the DNA sequence corresponding to read ranges. The local ## motif positions are mapped to genome coordinates and then mapped ## to gene features such as promoters regions. ## Load reads from chromosome 4 of D. melanogaster (dm3): library(pasillaBamSubset) fl <- untreated1_chr4() gal <- readGAlignments(fl) ## Extract DNA sequences corresponding to the read ranges: library(GenomicFeatures) library(BSgenome.Dmelanogaster.UCSC.dm3) dna <- extractTranscriptSeqs(BSgenome.Dmelanogaster.UCSC.dm3, grglist(gal)) ## Search for the consensus motif TATAAA in the sequences: box <- vmatchPattern("TATAAA", dna) ## Some sequences had more than one match: table(elementLengths(box)) ## The element-wise function we'll use for mapping to genome coordinates ## requires the two input argument to have the same length. We need to ## replicate the read ranges to match the number of motifs found. ## Expand the read ranges to match motifs found: motif <- elementLengths(box) != 0 alignments <- rep(gal[motif], elementLengths(box)[motif]) ## We make the IRanges into a GRanges object so the seqlevels can ## propagate to the output. Seqlevels are needed in the last mapping step. readCoords <- GRanges(seqnames(alignments), unlist(box, use.names=FALSE)) ## Map the local position of the motif to genome coordinates: genomeCoords <- pmapFromAlignments(readCoords, alignments) genomeCoords ## We are interested in the location of the TATA box motifs in the ## promoter regions. To perform the mapping we need the promoter ranges ## as a GRanges or GRangesList. ## Extract promoter regions 50 bp upstream from the transcription start site: library(TxDb.Dmelanogaster.UCSC.dm3.ensGene) txdb <- TxDb.Dmelanogaster.UCSC.dm3.ensGene promoters <- promoters(txdb, upstream=50, downstream=0) ## Map the genome coordinates to the promoters: names(promoters) <- mcols(promoters)$tx_name ## must be named mapToTranscripts(genomeCoords, promoters) } \keyword{methods} \keyword{utilities} GenomicAlignments/man/coverage-methods.Rd0000644000175100017510000001273512607264575021521 0ustar00biocbuildbiocbuild\name{coverage-methods} \alias{coverage-methods} \alias{coverage} \alias{coverage,GAlignments-method} \alias{coverage,GAlignmentPairs-method} \alias{coverage,GAlignmentsList-method} \alias{coverage,BamFile-method} \alias{coverage,character-method} \title{Coverage of a GAlignments, GAlignmentPairs, or GAlignmentsList object} \description{ \code{\link[IRanges]{coverage}} methods for \link{GAlignments}, \link{GAlignmentPairs}, \link{GAlignmentsList}, and \link[Rsamtools]{BamFile} objects. NOTE: The \code{\link[IRanges]{coverage}} generic function and methods for \link[IRanges]{Ranges} and \link[IRanges]{RangesList} objects are defined and documented in the \pkg{IRanges} package. Methods for \link[GenomicRanges]{GRanges} and \link[GenomicRanges]{GRangesList} objects are defined and documented in the \pkg{GenomicRanges} package. } \usage{ \S4method{coverage}{GAlignments}(x, shift=0L, width=NULL, weight=1L, method=c("auto", "sort", "hash"), drop.D.ranges=FALSE) \S4method{coverage}{GAlignmentPairs}(x, shift=0L, width=NULL, weight=1L, method=c("auto", "sort", "hash"), drop.D.ranges=FALSE) \S4method{coverage}{GAlignmentsList}(x, shift=0L, width=NULL, weight=1L, ...) \S4method{coverage}{BamFile}(x, shift=0L, width=NULL, weight=1L, ..., param=ScanBamParam()) \S4method{coverage}{character}(x, shift=0L, width=NULL, weight=1L, ..., yieldSize=2500000L) } \arguments{ \item{x}{ A \link{GAlignments}, \link{GAlignmentPairs}, \link{GAlignmentsList}, or \link[Rsamtools]{BamFile} object, or the path to a BAM file. } \item{shift, width, weight}{ See \code{coverage} method for \link[GenomicRanges]{GRanges} objects in the \pkg{GenomicRanges} package. } \item{method}{ See \code{?\link[IRanges]{coverage}} in the \pkg{IRanges} package for a description of this argument. } \item{drop.D.ranges}{ Whether the coverage calculation should ignore ranges corresponding to D (deletion) in the CIGAR string. } \item{...}{ Additional arguments passed to the \code{coverage} method for \link{GAlignments} objects. } \item{param}{ An optional \link[Rsamtools]{ScanBamParam} object passed to \code{\link{readGAlignments}}. } \item{yieldSize}{ An optional argument controlling how many records are input when iterating through a \link[Rsamtools]{BamFile}. } } \details{ The methods for \link{GAlignments} and \link{GAlignmentPairs} objects do: \preformatted{ coverage(grglist(x, drop.D.ranges=drop.D.ranges), ...) } The method for \link{GAlignmentsList} objects does: \preformatted{ coverage(unlist(x), ...) } The method for \link[Rsamtools]{BamFile} objects iterates through a BAM file, reading \code{yieldSize(x)} records (or all records, if \code{is.na(yieldSize(x))}) and calculating: \preformatted{ gal <- readGAlignments(x, param=param) coverage(gal, shift=shift, width=width, weight=weight, ...) } The method for \code{character} vectors of length 1 creates a \link[Rsamtools]{BamFile} object from \code{x} and performs the calculation for \code{coverage,BamFile-method}. } \value{ A named \link[IRanges]{RleList} object with one coverage vector per seqlevel in \code{x}. } \seealso{ \itemize{ \item \code{\link[IRanges]{coverage}} in the \pkg{IRanges} package. \item \link[GenomicRanges]{coverage-methods} in the \pkg{GenomicRanges} package. \item \link[IRanges]{RleList} objects in the \pkg{IRanges} package. \item \link{GAlignments} and \link{GAlignmentPairs} objects. \item \code{\link{readGAlignments}}. \item \link[Rsamtools]{BamFile} objects in the \pkg{Rsamtools} package. } } \examples{ ## --------------------------------------------------------------------- ## A. EXAMPLE WITH TOY DATA ## --------------------------------------------------------------------- ex1_file <- system.file("extdata", "ex1.bam", package="Rsamtools") ## Coverage of a GAlignments object: gal <- readGAlignments(ex1_file) cvg1 <- coverage(gal) cvg1 ## Coverage of a GAlignmentPairs object: galp <- readGAlignmentPairs(ex1_file) cvg2 <- coverage(galp) cvg2 ## Coverage of a GAlignmentsList object: galist <- readGAlignmentsList(ex1_file) cvg3 <- coverage(galist) cvg3 table(mcols(galist)$mate_status) mated_idx <- which(mcols(galist)$mate_status == "mated") mated_galist <- galist[mated_idx] mated_cvg3 <- coverage(mated_galist) mated_cvg3 ## Sanity checks: stopifnot(identical(cvg1, cvg3)) stopifnot(identical( cvg2, mated_cvg3)) ## --------------------------------------------------------------------- ## B. EXAMPLE WITH REAL DATA ## --------------------------------------------------------------------- library(pasillaBamSubset) ## See '?pasillaBamSubset' for more information about the 2 BAM files ## included in this package. reads <- readGAlignments(untreated3_chr4()) table(njunc(reads)) # data contains junction reads ## Junctions do NOT contribute to the coverage: read1 <- reads[which(njunc(reads) != 0L)[1]] # 1st read with a junction read1 # cigar shows a "skipped region" of length 15306 grglist(read1)[[1]] # the junction is between pos 4500 and 19807 coverage(read1)$chr4 # junction is not covered ## Sanity checks: cvg <- coverage(reads) read_chunks <- unlist(grglist(reads), use.names=FALSE) read_chunks_per_chrom <- split(read_chunks, seqnames(read_chunks)) stopifnot(identical(sum(cvg), sum(width(read_chunks_per_chrom)))) galist <- readGAlignmentsList(untreated3_chr4()) stopifnot(identical(cvg, coverage(galist))) } \keyword{methods} \keyword{utilities} GenomicAlignments/man/encodeOverlaps-methods.Rd0000644000175100017510000002271212607264575022673 0ustar00biocbuildbiocbuild\name{encodeOverlaps-methods} \alias{encodeOverlaps-methods} \alias{encodeOverlaps} \alias{encodeOverlaps,RangesList,RangesList-method} \alias{encodeOverlaps,RangesList,Ranges-method} \alias{encodeOverlaps,Ranges,RangesList-method} \alias{encodeOverlaps1} \alias{flipQuery} \alias{encodeOverlaps,GRangesList,GRangesList-method} \alias{selectEncodingWithCompatibleStrand} \alias{isCompatibleWithSplicing} \alias{isCompatibleWithSplicing,character-method} \alias{isCompatibleWithSplicing,factor-method} \alias{isCompatibleWithSplicing,OverlapEncodings-method} \alias{isCompatibleWithSkippedExons} \alias{isCompatibleWithSkippedExons,character-method} \alias{isCompatibleWithSkippedExons,factor-method} \alias{isCompatibleWithSkippedExons,OverlapEncodings-method} \alias{extractSteppedExonRanks} \alias{extractSteppedExonRanks,character-method} \alias{extractSteppedExonRanks,factor-method} \alias{extractSteppedExonRanks,OverlapEncodings-method} \alias{extractSpannedExonRanks} \alias{extractSpannedExonRanks,character-method} \alias{extractSpannedExonRanks,factor-method} \alias{extractSpannedExonRanks,OverlapEncodings-method} \alias{extractSkippedExonRanks} \alias{extractSkippedExonRanks,character-method} \alias{extractSkippedExonRanks,factor-method} \alias{extractSkippedExonRanks,OverlapEncodings-method} \alias{extractQueryStartInTranscript} \title{Encode the overlaps between RNA-seq reads and the transcripts of a gene model} \description{ In the context of an RNA-seq experiment, encoding the overlaps between the aligned reads and the transcripts of a given gene model can be used for detecting those overlaps that are \emph{compatible} with the splicing of the transcript. The central tool for this is the \code{encodeOverlaps} method for \link[GenomicRanges]{GRangesList} objects, which computes the "overlap encodings" between a \code{query} and a \code{subject}, both list-like objects with list elements containing multiple ranges. Other related utilities are also documented in this man page. } \usage{ encodeOverlaps(query, subject, hits=NULL, ...) \S4method{encodeOverlaps}{GRangesList,GRangesList}(query, subject, hits=NULL, flip.query.if.wrong.strand=FALSE) ## Related utilities: flipQuery(x, i) selectEncodingWithCompatibleStrand(ovencA, ovencB, query.strand, subject.strand, hits=NULL) isCompatibleWithSplicing(x) isCompatibleWithSkippedExons(x, max.skipped.exons=NA) extractSteppedExonRanks(x, for.query.right.end=FALSE) extractSpannedExonRanks(x, for.query.right.end=FALSE) extractSkippedExonRanks(x, for.query.right.end=FALSE) extractQueryStartInTranscript(query, subject, hits=NULL, ovenc=NULL, flip.query.if.wrong.strand=FALSE, for.query.right.end=FALSE) } \arguments{ \item{query, subject}{ Typically \link[GenomicRanges]{GRangesList} objects representing the the aligned reads and the transcripts of a given gene model, respectively. If the 2 objects don't have the same length, and if the \code{hits} argument is not supplied, then the shortest is recycled to the length of the longest (the standard recycling rules apply). More generally speaking, \code{query} and \code{subject} must be list-like objects with list elements containing multiple ranges e.g. \link[IRanges]{RangesList} or \link[GenomicRanges]{GRangesList} objects. } \item{hits}{ An optional \link[S4Vectors]{Hits} object typically obtained from a previous call to \code{\link[IRanges]{findOverlaps}(query, subject)}. Strictly speaking, \code{hits} only needs to be compatible with \code{query} and \code{subject}, that is, \code{\link[S4Vectors]{queryLength}(hits)} and \code{\link[S4Vectors]{subjectLength}(hits)} must be equal to \code{length(query)} and \code{length(subject)}, respectively. Supplying \code{hits} is a convenient way to do \code{encodeOverlaps(query[queryHits(hits)], subject[subjectHits(hits)])}, that is, calling \code{encodeOverlaps(query, subject, hits)} is equivalent to the above, but is much more efficient, especially when \code{query} and/or \code{subject} are big. Of course, when \code{hits} is supplied, \code{query} and \code{subject} are not expected to have the same length anymore. } \item{...}{ Additional arguments for methods. } \item{flip.query.if.wrong.strand}{ See the "OverlapEncodings" vignette located in this package (\pkg{GenomicAlignments}). } \item{x}{ For \code{flipQuery}: a \link[GenomicRanges]{GRangesList} object. For \code{isCompatibleWithSplicing}, \code{isCompatibleWithSkippedExons}, \code{extractSteppedExonRanks}, \code{extractSpannedExonRanks}, and \code{extractSkippedExonRanks}: an \link{OverlapEncodings} object, a factor, or a character vector. } \item{i}{ Subscript specifying the elements in \code{x} to flip. If missing, all the elements are flipped. } \item{ovencA, ovencB, ovenc}{ \link{OverlapEncodings} objects. } \item{query.strand, subject.strand}{ Vector-like objects containing the strand of the query and subject, respectively. } \item{max.skipped.exons}{ Not supported yet. If \code{NA} (the default), the number of skipped exons must be 1 or more (there is no max). } \item{for.query.right.end}{ If \code{TRUE}, then the information reported in the output is for the right ends of the paired-end reads. Using \code{for.query.right.end=TRUE} with single-end reads is an error. } } \details{ See \code{?OverlapEncodings} for a short introduction to "overlap encodings". The topic of working with overlap encodings is covered in details in the "OverlapEncodings" vignette located this package (\pkg{GenomicAlignments}) and accessible with \code{vignette("OverlapEncodings")}. } \value{ For \code{encodeOverlaps}: An \link{OverlapEncodings} object. If \code{hits} is not supplied, this object is \emph{parallel} to the longest of \code{query} and \code{subject}, that is, it has the length of the longest and the i-th encoding in it corresponds to the i-th element in the longest. If \code{hits} is supplied, then the returned object is \emph{parallel} to it, that is, it has one encoding per hit. For \code{flipQuery}: TODO For \code{selectEncodingWithCompatibleStrand}: TODO For \code{isCompatibleWithSplicing} and \code{isCompatibleWithSkippedExons}: A logical vector \emph{parallel} to \code{x}. For \code{extractSteppedExonRanks}, \code{extractSpannedExonRanks}, and \code{extractSkippedExonRanks}: TODO For \code{extractQueryStartInTranscript}: TODO } \author{ H. Pages } \seealso{ \itemize{ \item The \link{OverlapEncodings} class for a brief introduction to "overlap encodings". \item The \link[S4Vectors]{Hits} class defined and documented in the \pkg{S4Vectors} package. \item The "OverlapEncodings" vignette in this package. \item \code{\link{findCompatibleOverlaps}} for a specialized version of \code{\link[IRanges]{findOverlaps}} that uses \code{encodeOverlaps} internally to keep only the hits where the junctions in the aligned read are \emph{compatible} with the splicing of the annotated transcript. \item The \link[GenomicRanges]{GRangesList} class defined and documented in the \pkg{GenomicRanges} package. \item The \code{\link[IRanges]{findOverlaps}} generic function defined in the \pkg{IRanges} package. } } \examples{ ## --------------------------------------------------------------------- ## A. BETWEEN 2 RangesList OBJECTS ## --------------------------------------------------------------------- ## In the context of an RNA-seq experiment, encoding the overlaps ## between 2 GRangesList objects, one containing the reads (the query), ## and one containing the transcripts (the subject), can be used for ## detecting hits between reads and transcripts that are "compatible" ## with the splicing of the transcript. Here we illustrate this with 2 ## RangesList objects, in order to keep things simple: ## 4 aligned reads in the query: read1 <- IRanges(c(7, 15, 22), c(9, 19, 23)) # 2 junctions read2 <- IRanges(c(5, 15), c(9, 17)) # 1 junction read3 <- IRanges(c(16, 22), c(19, 24)) # 1 junction read4 <- IRanges(c(16, 23), c(19, 24)) # 1 junction query <- IRangesList(read1, read2, read3, read4) ## 1 transcript in the subject: tx <- IRanges(c(1, 4, 15, 22, 38), c(2, 9, 19, 25, 47)) # 5 exons subject <- IRangesList(tx) ## Encode the overlaps: ovenc <- encodeOverlaps(query, subject) ovenc encoding(ovenc) ## Reads that are "compatible" with the transcript can be detected with ## a regular expression (the regular expression below assumes that ## reads have at most 2 junctions): regex0 <- "(:[fgij]:|:[jg].:.[gf]:|:[jg]..:.g.:..[gf]:)" grepl(regex0, encoding(ovenc)) # read4 is NOT "compatible" ## This was for illustration purpose only. In practise you don't need ## (and should not) use this regular expression, but use instead the ## isCompatibleWithSplicing() utility function: isCompatibleWithSplicing(ovenc) ## --------------------------------------------------------------------- ## B. BETWEEN 2 GRangesList OBJECTS ## --------------------------------------------------------------------- ## With real RNA-seq data, the reads and transcripts will typically be ## stored in GRangesList objects. Please refer to the "OverlapEncodings" ## vignette in this package for realistic examples. } \keyword{methods} \keyword{utilities} GenomicAlignments/man/findCompatibleOverlaps-methods.Rd0000644000175100017510000001054012607264575024352 0ustar00biocbuildbiocbuild\name{findCompatibleOverlaps-methods} \alias{findCompatibleOverlaps-methods} \alias{findCompatibleOverlaps} \alias{findCompatibleOverlaps,GAlignments,GRangesList-method} \alias{findCompatibleOverlaps,GAlignmentPairs,GRangesList-method} \alias{countCompatibleOverlaps} \title{Finding hits between reads and transcripts that are \emph{compatible} with the splicing of the transcript} \description{ In the context of an RNA-seq experiment, \code{findCompatibleOverlaps} (or \code{countCompatibleOverlaps}) can be used for finding (or counting) hits between reads and transcripts that are \emph{compatible} with the splicing of the transcript. } \usage{ findCompatibleOverlaps(query, subject, algorithm=c("nclist", "intervaltree")) countCompatibleOverlaps(query, subject, algorithm=c("nclist", "intervaltree")) } \arguments{ \item{query}{ A \link{GAlignments} or \link{GAlignmentPairs} object representing the aligned reads. } \item{subject}{ A \link{GRangesList} object representing the transcripts. } \item{algorithm}{ This argument is passed to \code{\link{findOverlaps}}, which \code{findCompatibleOverlaps} and \code{countCompatibleOverlaps} use internally. See \code{?\link{findOverlaps}} for more information. Note that it will be removed in BioC 3.3 so please don't use it unless you have a good reason to do so (e.g. troubleshooting). } } \details{ \code{findCompatibleOverlaps} is a specialized version of \code{\link[IRanges]{findOverlaps}} that uses \code{\link{encodeOverlaps}} internally to keep only the hits where the junctions in the aligned read are \emph{compatible} with the splicing of the annotated transcript. The topic of working with overlap encodings is covered in details in the "OverlapEncodings" vignette located this package (\pkg{GenomicAlignments}) and accessible with \code{vignette("OverlapEncodings")}. } \value{ A \link[S4Vectors]{Hits} object for \code{findCompatibleOverlaps}. An integer vector \emph{parallel} to (i.e. same length as) \code{query} for \code{countCompatibleOverlaps}. } \author{ H. Pages } \seealso{ \itemize{ \item The \code{\link[IRanges]{findOverlaps}} generic function defined in the \pkg{IRanges} package. \item The \code{\link{encodeOverlaps}} generic function and \link{OverlapEncodings} class. \item The "OverlapEncodings" vignette in this package. \item \link{GAlignments} and \link{GAlignmentPairs} objects. \item \link[GenomicRanges]{GRangesList} objects in the \pkg{GenomicRanges} package. } } \examples{ ## Here we only show a simple example illustrating the use of ## countCompatibleOverlaps() on a very small data set. Please ## refer to the "OverlapEncodings" vignette in the GenomicAlignments ## package for a comprehensive presentation of "overlap ## encodings" and related tools/concepts (e.g. "compatible" ## overlaps, "almost compatible" overlaps etc...), and for more ## examples. ## sm_treated1.bam contains a small subset of treated1.bam, a BAM ## file containing single-end reads from the "Pasilla" experiment ## (RNA-seq, Fly, see the pasilla data package for the details) ## and aligned to reference genome BDGP Release 5 (aka dm3 genome on ## the UCSC Genome Browser): sm_treated1 <- system.file("extdata", "sm_treated1.bam", package="GenomicAlignments", mustWork=TRUE) ## Load the alignments: flag0 <- scanBamFlag(isDuplicate=FALSE, isNotPassingQualityControls=FALSE) param0 <- ScanBamParam(flag=flag0) gal <- readGAlignments(sm_treated1, use.names=TRUE, param=param0) ## Load the transcripts (IMPORTANT: Like always, the reference genome ## of the transcripts must be *exactly* the same as the reference ## genome used to align the reads): library(TxDb.Dmelanogaster.UCSC.dm3.ensGene) txdb <- TxDb.Dmelanogaster.UCSC.dm3.ensGene exbytx <- exonsBy(txdb, by="tx", use.names=TRUE) ## Number of "compatible" transcripts per alignment in 'gal': gal_ncomptx <- countCompatibleOverlaps(gal, exbytx) mcols(gal)$ncomptx <- gal_ncomptx table(gal_ncomptx) mean(gal_ncomptx >= 1) ## --> 33% of the alignments in 'gal' are "compatible" with at least ## 1 transcript in 'exbytx'. ## Keep only alignments compatible with at least 1 transcript in ## 'exbytx': compgal <- gal[gal_ncomptx >= 1] head(compgal) } \keyword{methods} \keyword{utilities} GenomicAlignments/man/findMateAlignment.Rd0000644000175100017510000002620112607264575021644 0ustar00biocbuildbiocbuild\name{findMateAlignment} \alias{findMateAlignment} \alias{findMateAlignment2} \alias{makeGAlignmentPairs} \alias{getDumpedAlignments} \alias{countDumpedAlignments} \alias{flushDumpedAlignments} \title{Pairing the elements of a GAlignments object} \description{ Utilities for pairing the elements of a \link{GAlignments} object. NOTE: Until BioC 2.13, \code{findMateAlignment} was the power horse used by \code{\link{readGAlignmentPairs}} for pairing the records loaded from a BAM file containing aligned paired-end reads. Starting with BioC 2.14, \code{\link{readGAlignmentPairs}} relies on \code{\link[Rsamtools]{scanBam}(BamFile(asMates=TRUE), ...)} for the pairing. } \usage{ findMateAlignment(x) makeGAlignmentPairs(x, use.names=FALSE, use.mcols=FALSE, strandMode=1) ## Related low-level utilities: getDumpedAlignments() countDumpedAlignments() flushDumpedAlignments() } \arguments{ \item{x}{ A named \link{GAlignments} object with metadata columns \code{flag}, \code{mrnm}, and \code{mpos}. Typically obtained by loading aligned paired-end reads from a BAM file with: \preformatted{ param <- ScanBamParam(what=c("flag", "mrnm", "mpos")) x <- readGAlignments(..., use.names=TRUE, param=param) } } \item{use.names}{ Whether the names on the input object should be propagated to the returned object or not. } \item{use.mcols}{ Names of the metadata columns to propagate to the returned \link{GAlignmentPairs} object. } \item{strandMode}{ Strand mode to set on the returned \link{GAlignmentPairs} object. See \code{?\link{strandMode}} for more information. } } \details{ \subsection{Pairing algorithm used by findMateAlignment}{ \code{findMateAlignment} is the power horse used by \code{makeGAlignmentPairs} for pairing the records loaded from a BAM file containing aligned paired-end reads. It implements the following pairing algorithm: \itemize{ \item First, only records with flag bit 0x1 (multiple segments) set to 1, flag bit 0x4 (segment unmapped) set to 0, and flag bit 0x8 (next segment in the template unmapped) set to 0, are candidates for pairing (see the SAM Spec for a description of flag bits and fields). \code{findMateAlignment} will ignore any other record. That is, records that correspond to single-end reads, or records that correspond to paired-end reads where one or both ends are unmapped, are discarded. \item Then the algorithm looks at the following fields and flag bits: \itemize{ \item (A) QNAME \item (B) RNAME, RNEXT \item (C) POS, PNEXT \item (D) Flag bits Ox10 (segment aligned to minus strand) and 0x20 (next segment aligned to minus strand) \item (E) Flag bits 0x40 (first segment in template) and 0x80 (last segment in template) \item (F) Flag bit 0x2 (proper pair) \item (G) Flag bit 0x100 (secondary alignment) } 2 records rec1 and rec2 are considered mates iff all the following conditions are satisfied: \itemize{ \item (A) QNAME(rec1) == QNAME(rec2) \item (B) RNEXT(rec1) == RNAME(rec2) and RNEXT(rec2) == RNAME(rec1) \item (C) PNEXT(rec1) == POS(rec2) and PNEXT(rec2) == POS(rec1) \item (D) Flag bit 0x20 of rec1 == Flag bit 0x10 of rec2 and Flag bit 0x20 of rec2 == Flag bit 0x10 of rec1 \item (E) rec1 corresponds to the first segment in the template and rec2 corresponds to the last segment in the template, OR, rec2 corresponds to the first segment in the template and rec1 corresponds to the last segment in the template \item (F) rec1 and rec2 have same flag bit 0x2 \item (G) rec1 and rec2 have same flag bit 0x100 } } } \subsection{Timing and memory requirement of the pairing algorithm}{ The estimated timings and memory requirements on a modern Linux system are (those numbers may vary depending on your hardware and OS): \preformatted{ nb of alignments | time | required memory -----------------+--------------+---------------- 8 millions | 28 sec | 1.4 GB 16 millions | 58 sec | 2.8 GB 32 millions | 2 min | 5.6 GB 64 millions | 4 min 30 sec | 11.2 GB } This is for a \link{GAlignments} object coming from a file with an "average nb of records per unique QNAME" of 2.04. A value of 2 (which means the file contains only primary reads) is optimal for the pairing algorithm. A greater value, say > 3, will significantly degrade its performance. An easy way to avoid this degradation is to load only primary alignments by setting the \code{isSecondaryAlignment} flag to \code{FALSE} in ScanBamParam(). See examples in \code{?\link{readGAlignmentPairs}} for how to do this. } \subsection{Ambiguous pairing}{ The above algorithm will find almost all pairs unambiguously, even when the same pair of reads maps to several places in the genome. Note that, when a given pair maps to a single place in the genome, looking at (A) is enough to pair the 2 corresponding records. The additional conditions (B), (C), (D), (E), (F), and (G), are only here to help in the situation where more than 2 records share the same QNAME. And that works most of the times. Unfortunately there are still situations where this is not enough to solve the pairing problem unambiguously. For example, here are 4 records (loaded in a GAlignments object) that cannot be paired with the above algorithm: Showing the 4 records as a GAlignments object of length 4: \preformatted{ GAlignments with 4 alignments and 2 metadata columns: seqnames strand cigar qwidth start end SRR031714.2658602 chr2R + 21M384N16M 37 6983850 6984270 SRR031714.2658602 chr2R + 21M384N16M 37 6983850 6984270 SRR031714.2658602 chr2R - 13M372N24M 37 6983858 6984266 SRR031714.2658602 chr2R - 13M378N24M 37 6983858 6984272 width njunc | mrnm mpos | SRR031714.2658602 421 1 | chr2R 6983858 SRR031714.2658602 421 1 | chr2R 6983858 SRR031714.2658602 409 1 | chr2R 6983850 SRR031714.2658602 415 1 | chr2R 6983850 } Note that the BAM fields show up in the following columns: \itemize{ \item QNAME: the names of the GAlignments object (unnamed col) \item RNAME: the seqnames col \item POS: the start col \item RNEXT: the mrnm col \item PNEXT: the mpos col } As you can see, the aligner has aligned the same pair to the same location twice! The only difference between the 2 aligned pairs is in the CIGAR i.e. one end of the pair is aligned twice to the same location with exactly the same CIGAR while the other end of the pair is aligned twice to the same location but with slightly different CIGARs. Now showing the corresponding flag bits: \preformatted{ isPaired isProperPair isUnmappedQuery hasUnmappedMate isMinusStrand [1,] 1 1 0 0 0 [2,] 1 1 0 0 0 [3,] 1 1 0 0 1 [4,] 1 1 0 0 1 isMateMinusStrand isFirstMateRead isSecondMateRead isSecondaryAlignment [1,] 1 0 1 0 [2,] 1 0 1 0 [3,] 0 1 0 0 [4,] 0 1 0 0 isNotPassingQualityControls isDuplicate [1,] 0 0 [2,] 0 0 [3,] 0 0 [4,] 0 0 } As you can see, rec(1) and rec(2) are second mates, rec(3) and rec(4) are both first mates. But looking at (A), (B), (C), (D), (E), (F), and (G), the pairs could be rec(1) <-> rec(3) and rec(2) <-> rec(4), or they could be rec(1) <-> rec(4) and rec(2) <-> rec(3). There is no way to disambiguate! So \code{findMateAlignment} is just ignoring (with a warning) those alignments with ambiguous pairing, and dumping them in a place from which they can be retrieved later (i.e. after \code{findMateAlignment} has returned) for further examination (see "Dumped alignments" subsection below for the details). In other words, alignments that cannot be paired unambiguously are not paired at all. Concretely, this means that \code{\link{readGAlignmentPairs}} is guaranteed to return a \link{GAlignmentPairs} object where every pair was formed in an non-ambiguous way. Note that, in practice, this approach doesn't seem to leave aside a lot of records because ambiguous pairing events seem pretty rare. } \subsection{Dumped alignments}{ Alignments with ambiguous pairing are dumped in a place ("the dump environment") from which they can be retrieved with \code{getDumpedAlignments()} after \code{findMateAlignment} has returned. Two additional utilities are provided for manipulation of the dumped alignments: \code{countDumpedAlignments} for counting them (a fast equivalent to \code{length(getDumpedAlignments())}), and \code{flushDumpedAlignments} to flush "the dump environment". Note that "the dump environment" is automatically flushed at the beginning of a call to \code{findMateAlignment}. } } \value{ For \code{findMateAlignment}: An integer vector of the same length as \code{x}, containing only positive or NA values, where the i-th element is interpreted as follow: \itemize{ \item An NA value means that no mate or more than 1 mate was found for \code{x[i]}. \item A non-NA value j gives the index in \code{x} of \code{x[i]}'s mate. } For \code{makeGAlignmentPairs}: A \link{GAlignmentPairs} object where the pairs are formed internally by calling \code{findMateAlignment} on \code{x}. For \code{getDumpedAlignments}: \code{NULL} or a \link{GAlignments} object containing the dumped alignments. See "Dumped alignments" subsection in the "Details" section above for the details. For \code{countDumpedAlignments}: The number of dumped alignments. Nothing for \code{flushDumpedAlignments}. } \author{H. Pages} \seealso{ \itemize{ \item \link{GAlignments} and \link{GAlignmentPairs} objects. \item \code{\link{readGAlignments}} and \code{\link{readGAlignmentPairs}}. } } \examples{ bamfile <- system.file("extdata", "ex1.bam", package="Rsamtools", mustWork=TRUE) param <- ScanBamParam(what=c("flag", "mrnm", "mpos")) x <- readGAlignments(bamfile, use.names=TRUE, param=param) mate <- findMateAlignment(x) head(mate) table(is.na(mate)) galp0 <- makeGAlignmentPairs(x) galp <- makeGAlignmentPairs(x, use.name=TRUE, use.mcols="flag") galp colnames(mcols(galp)) colnames(mcols(first(galp))) colnames(mcols(last(galp))) } \keyword{manip} GenomicAlignments/man/findOverlaps-methods.Rd0000644000175100017510000001515012607264575022354 0ustar00biocbuildbiocbuild\name{findOverlaps-methods} \alias{findOverlaps-methods} \alias{findOverlaps} \alias{findOverlaps,GAlignments,Vector-method} \alias{findOverlaps,Vector,GAlignments-method} \alias{findOverlaps,GAlignments,GAlignments-method} \alias{findOverlaps,GAlignmentPairs,Vector-method} \alias{findOverlaps,Vector,GAlignmentPairs-method} \alias{findOverlaps,GAlignmentPairs,GAlignmentPairs-method} \alias{findOverlaps,GAlignmentsList,Vector-method} \alias{findOverlaps,Vector,GAlignmentsList-method} \alias{findOverlaps,GAlignmentsList,GAlignmentsList-method} \alias{countOverlaps} \alias{countOverlaps,GAlignments,Vector-method} \alias{countOverlaps,Vector,GAlignments-method} \alias{countOverlaps,GAlignments,GAlignments-method} \alias{countOverlaps,GAlignments,GenomicRanges-method} \alias{countOverlaps,GenomicRanges,GAlignments-method} \alias{countOverlaps,GAlignments,GRangesList-method} \alias{countOverlaps,GRangesList,GAlignments-method} \alias{countOverlaps,GAlignmentPairs,Vector-method} \alias{countOverlaps,Vector,GAlignmentPairs-method} \alias{countOverlaps,GAlignmentPairs,GAlignmentPairs-method} \alias{countOverlaps,GAlignmentsList,Vector-method} \alias{countOverlaps,Vector,GAlignmentsList-method} \alias{countOverlaps,GAlignmentsList,GAlignmentsList-method} \alias{overlapsAny} \alias{overlapsAny,GAlignments,Vector-method} \alias{overlapsAny,Vector,GAlignments-method} \alias{overlapsAny,GAlignments,GAlignments-method} \alias{overlapsAny,GAlignmentPairs,Vector-method} \alias{overlapsAny,Vector,GAlignmentPairs-method} \alias{overlapsAny,GAlignmentPairs,GAlignmentPairs-method} \alias{overlapsAny,GAlignmentsList,Vector-method} \alias{overlapsAny,Vector,GAlignmentsList-method} \alias{overlapsAny,GAlignmentsList,GAlignmentsList-method} \alias{subsetByOverlaps} \alias{subsetByOverlaps,GAlignments,Vector-method} \alias{subsetByOverlaps,Vector,GAlignments-method} \alias{subsetByOverlaps,GAlignments,GAlignments-method} \alias{subsetByOverlaps,GAlignmentPairs,Vector-method} \alias{subsetByOverlaps,Vector,GAlignmentPairs-method} \alias{subsetByOverlaps,GAlignmentPairs,GAlignmentPairs-method} \alias{subsetByOverlaps,GAlignmentsList,Vector-method} \alias{subsetByOverlaps,Vector,GAlignmentsList-method} \alias{subsetByOverlaps,GAlignmentsList,GAlignmentsList-method} \title{Finding overlapping genomic alignments} \description{ Finds range overlaps between a \link{GAlignments}, \link{GAlignmentPairs}, or \link{GAlignmentsList} object, and another range-based object. NOTE: The \code{\link[IRanges]{findOverlaps}} generic function and methods for \link[IRanges]{Ranges} and \link[IRanges]{RangesList} objects are defined and documented in the \pkg{IRanges} package. The methods for \link[GenomicRanges]{GRanges} and \link[GenomicRanges]{GRangesList} objects are defined and documented in the \pkg{GenomicRanges} package. } \usage{ \S4method{findOverlaps}{GAlignments,GAlignments}(query, subject, maxgap=0L, minoverlap=1L, type=c("any", "start", "end", "within"), select=c("all", "first", "last", "arbitrary"), algorithm=c("nclist", "intervaltree"), ignore.strand=FALSE) \S4method{countOverlaps}{GAlignments,GAlignments}(query, subject, maxgap=0L, minoverlap=1L, type=c("any", "start", "end", "within"), algorithm=c("nclist", "intervaltree"), ignore.strand=FALSE) \S4method{overlapsAny}{GAlignments,GAlignments}(query, subject, maxgap=0L, minoverlap=1L, type=c("any", "start", "end", "within"), algorithm=c("nclist", "intervaltree"), ignore.strand=FALSE) \S4method{subsetByOverlaps}{GAlignments,GAlignments}(query, subject, maxgap=0L, minoverlap=1L, type=c("any", "start", "end", "within"), algorithm=c("nclist", "intervaltree"), ignore.strand=FALSE) } \arguments{ \item{query, subject}{ A \link{GAlignments}, \link{GAlignmentPairs}, or \link{GAlignmentsList} object for either \code{query} or \code{subject}. A vector-like object containing ranges for the other one. } \item{maxgap, minoverlap, type, select, algorithm}{ See \code{\link[IRanges]{findOverlaps}} in the \pkg{IRanges} package for a description of these arguments. } \item{ignore.strand}{ When set to \code{TRUE}, the strand information is ignored in the overlap calculations. } } \details{ When the query or the subject (or both) is a \link{GAlignments} object, it is first turned into a \link{GRangesList} object (with \code{as( , "GRangesList")}) and then the rules described previously apply. \link{GAlignmentsList} objects are coerced to \link{GAlignments} then to a \link{GRangesList}. Feature indices are mapped back to the original \link{GAlignmentsList} list elements. When the query is a \link{GAlignmentPairs} object, it is first turned into a \link{GRangesList} object (with \code{as( , "GRangesList")}) and then the rules described previously apply. } \value{ For \code{findOverlaps} either a \link[S4Vectors]{Hits} object when \code{select = "all"} or an integer vector otherwise. For \code{countOverlaps} an integer vector containing the tabulated query overlap hits. For \code{overlapsAny} a logical vector of length equal to the number of ranges in \code{query} indicating those that overlap any of the ranges in \code{subject}. For \code{subsetByOverlaps} an object of the same class as \code{query} containing the subset that overlapped at least one entity in \code{subject}. } \seealso{ \itemize{ \item \code{\link[IRanges]{findOverlaps}}. \item \link[S4Vectors]{Hits-class}. \item \link{GRanges-class}. \item \link{GRangesList-class}. \item \link{GAlignments-class}. \item \link{GAlignmentPairs-class}. \item \link{GAlignmentsList-class}. } } \examples{ ex1_file <- system.file("extdata", "ex1.bam", package="Rsamtools") galn <- readGAlignments(ex1_file) subject <- granges(galn)[1] ## Note the absence of query no. 9 (i.e. 'galn[9]') in this result: as.matrix(findOverlaps(galn, subject)) ## This is because, by default, findOverlaps()/countOverlaps() are ## strand specific: galn[8:10] countOverlaps(galn[8:10], subject) countOverlaps(galn[8:10], subject, ignore.strand=TRUE) ## Count alignments in 'galn' that DO overlap with 'subject' vs those ## that do NOT: table(overlapsAny(galn, subject)) ## Extract those that DO: subsetByOverlaps(galn, subject) ## GAlignmentsList galist <- GAlignmentsList(galn[8:10], galn[3000:3002]) gr <- GRanges(c("seq1", "seq1", "seq2"), IRanges(c(15, 18, 1233), width=1), strand=c("-", "+", "+")) countOverlaps(galist, gr) countOverlaps(galist, gr, ignore.strand=TRUE) findOverlaps(galist, gr) findOverlaps(galist, gr, ignore.strand=TRUE) } \keyword{methods} \keyword{utilities} GenomicAlignments/man/findSpliceOverlaps-methods.Rd0000644000175100017510000001621512607264575023517 0ustar00biocbuildbiocbuild\name{findSpliceOverlaps-methods} \alias{findSpliceOverlaps-methods} \alias{findSpliceOverlaps} \alias{findSpliceOverlaps,GRangesList,GRangesList-method} \alias{findSpliceOverlaps,GAlignments,GRangesList-method} \alias{findSpliceOverlaps,GAlignmentPairs,GRangesList-method} \alias{findSpliceOverlaps,character,ANY-method} \alias{findSpliceOverlaps,BamFile,ANY-method} \title{Classify ranges (reads) as compatible with existing genomic annotations or as having novel splice events} \description{ The \code{findSpliceOverlaps} function identifies ranges (reads) that are compatible with a specific transcript isoform. The non-compatible ranges are analyzed for the presence of novel splice events. } \usage{ findSpliceOverlaps(query, subject, algorithm=c("nclist", "intervaltree"), ignore.strand=FALSE, ...) \S4method{findSpliceOverlaps}{GRangesList,GRangesList}(query, subject, algorithm=c("nclist", "intervaltree"), ignore.strand=FALSE, ..., cds=NULL) \S4method{findSpliceOverlaps}{GAlignments,GRangesList}(query, subject, algorithm=c("nclist", "intervaltree"), ignore.strand=FALSE, ..., cds=NULL) \S4method{findSpliceOverlaps}{GAlignmentPairs,GRangesList}(query, subject, algorithm=c("nclist", "intervaltree"), ignore.strand=FALSE, ..., cds=NULL) \S4method{findSpliceOverlaps}{BamFile,ANY}(query, subject, algorithm=c("nclist", "intervaltree"), ignore.strand=FALSE, ..., param=ScanBamParam(), singleEnd=TRUE) } \arguments{ \item{query}{ A \link[GenomicRanges]{GRangesList}, \link{GAlignments}, \link{GAlignmentPairs}, or \link[Rsamtools]{BamFile} object containing the reads. Can also be a single string containing the path to a BAM file. Single or paired-end reads are specified with the \code{singleEnd} argument (default FALSE). Paired-end reads can be supplied in a BAM file or \link{GAlignmentPairs} object. Single-end are expected to be in a BAM file, \link{GAlignments} or \link[GenomicRanges]{GRanges} object. } \item{subject}{ A \link[GenomicRanges]{GRangesList} containing the annotations. This list is expected to contain exons grouped by transcripts. } \item{algorithm}{ This argument is passed to \code{\link{findOverlaps}}, which \code{findSpliceOverlaps} uses internally. See \code{?\link{findOverlaps}} for more information. Note that it will be removed in BioC 3.3 so please don't use it unless you have a good reason to do so (e.g. troubleshooting). } \item{ignore.strand}{ When set to \code{TRUE}, strand information is ignored in the overlap calculations. } \item{...}{ Additional arguments such as \code{param} and \code{singleEnd} used in the method for \link[Rsamtools]{BamFile} objects. See below. } \item{cds}{ Optional \link[GenomicRanges]{GRangesList} of coding regions for each transcript in the \code{subject}. If provided, the "coding" output column will be a \code{logical} vector indicating if the read falls in a coding region. When not provided, the "coding" output is \code{NA}. } \item{param}{ An optional \code{\link[Rsamtools]{ScanBamParam}} instance to further influence scanning, counting, or filtering. } \item{singleEnd}{ A logical value indicating if reads are single or paired-end. See \code{\link{summarizeOverlaps}} for more information. } } \details{ When a read maps compatibly and uniquely to a transcript isoform we can quantify the expression and look for shifts in the balance of isoform expression. If a read does not map in compatible way, novel splice events such as splice junctions, novel exons or retentions can be quantified and compared across samples. \code{findSpliceOverlaps} detects which reads (query) match to transcripts (subject) in a compatible fashion. Compatibility is based on both the transcript bounds and splicing pattern. Assessing the splicing pattern involves comparision of the read splices (i.e., the N operations in the CIGAR) with the transcript introns. For paired-end reads, the inter-read gap is not considered a splice junction. The analysis of non-compatible reads for novel splice events is under construction. } \value{ The output is a \link[S4Vectors]{Hits} object with the metadata columns defined below. Each column is a \code{logical} indicating if the read (query) met the criteria. \itemize{ \item{compatible: }{Every splice (N) in a read alignment matches an intron in an annotated transcript. The read does not extend into an intron or outside the transcript bounds. } \item{unique: }{The read is compatible with only one annotated transcript. } \item{strandSpecific: }{The query (read) was stranded. } } } \author{ Michael Lawrence and Valerie Obenchain } \seealso{ \itemize{ \item \link[GenomicRanges]{GRangesList} objects in the \pkg{GenomicRanges} package. \item \link{GAlignments} and \link{GAlignmentPairs} objects. \item \link[Rsamtools]{BamFile} objects in the \pkg{Rsamtools} package. } } \examples{ ## ----------------------------------------------------------------------- ## Isoform expression : ## ----------------------------------------------------------------------- ## findSpliceOverlaps() can assist in quantifying isoform expression ## by identifying reads that map compatibly and uniquely to a ## transcript isoform. library(TxDb.Dmelanogaster.UCSC.dm3.ensGene) library(pasillaBamSubset) se <- untreated1_chr4() ## single-end reads txdb <- TxDb.Dmelanogaster.UCSC.dm3.ensGene exbytx <- exonsBy(txdb, "tx") cdsbytx <- cdsBy(txdb, "tx") param <- ScanBamParam(which=GRanges("chr4", IRanges(1e5,3e5))) sehits <- findSpliceOverlaps(se, exbytx, cds=cdsbytx, param=param) ## Tally the reads by category to get an idea of read distribution. lst <- lapply(mcols(sehits), table) nms <- names(lst) %in% c("compatible", "unique") tbl <- do.call(rbind, lst[nms]) tbl ## Reads compatible with one or more transcript isoforms. rnms <- rownames(tbl) tbl[rnms == "compatible","TRUE"]/sum(tbl[rnms == "compatible",]) ## Reads compatible with a single isoform. tbl[rnms == "unique","TRUE"]/sum(tbl[rnms == "unique",]) ## All reads fall in a coding region as defined by ## the txdb annotation. lst[["coding"]] ## Check : Total number of reads should be the same across categories. lapply(lst, sum) ## ----------------------------------------------------------------------- ## Paired-end reads : ## ----------------------------------------------------------------------- ## 'singleEnd' is set to FALSE for a BAM file with paired-end reads. pe <- untreated3_chr4() hits2 <- findSpliceOverlaps(pe, exbytx, singleEnd=FALSE, param=param) ## In addition to BAM files, paired-end reads can be supplied in a ## GAlignmentPairs object. genes <- GRangesList( GRanges("chr1", IRanges(c(5, 20), c(10, 25)), "+"), GRanges("chr1", IRanges(c(5, 22), c(15, 25)), "+")) galp <- GAlignmentPairs( GAlignments("chr1", 5L, "11M4N6M", strand("+")), GAlignments("chr1", 50L, "6M", strand("-"))) findSpliceOverlaps(galp, genes) } \keyword{methods} \keyword{utilities} GenomicAlignments/man/intra-range-methods.Rd0000644000175100017510000001214012612017250022101 0ustar00biocbuildbiocbuild\name{intra-range-methods} \alias{intra-range-methods} \alias{narrow} \alias{narrow,GAlignments-method} \alias{narrow,GAlignmentsList-method} \alias{narrow,GappedReads-method} \alias{qnarrow} \alias{qnarrow,GAlignments-method} \alias{qnarrow,GAlignmentsList-method} \alias{qnarrow,GappedReads-method} \title{Intra range transformations of a GAlignments or GAlignmentsList object} \description{ This man page documents intra range transformations of a \link{GAlignments} or \link{GAlignmentsList} object. See \code{?`\link[IRanges]{intra-range-methods}`} and \code{?`\link[IRanges]{inter-range-methods}`} in the \pkg{IRanges} package for a quick introduction to intra range and inter range transformations. Intra range methods for \link{GRanges} and \link{GRangesList} objects are defined and documented in the \pkg{GenomicRanges} package. } \usage{ \S4method{narrow}{GAlignments}(x, start=NA, end=NA, width=NA, use.names=TRUE) \S4method{narrow}{GAlignmentsList}(x, start=NA, end=NA, width=NA, use.names=TRUE) \S4method{qnarrow}{GAlignments}(x, start=NA, end=NA, width=NA) \S4method{qnarrow}{GAlignmentsList}(x, start=NA, end=NA, width=NA) } \arguments{ \item{x}{ A \link{GAlignments} or \link{GAlignmentsList} object. } \item{start, end, width}{ Vectors of integers. NAs and negative values are accepted and "solved" according to the rules of the SEW (Start/End/Width) interface (see \code{?\link[IRanges]{solveUserSEW}} for more information about the SEW interface). See \code{?`\link[IRanges]{intra-range-methods}`} for more information about the \code{start}, \code{end}, and \code{width} arguments. } \item{use.names}{ See \code{?`\link[IRanges]{intra-range-methods}`}. } } \details{ \itemize{ \item(){ \code{narrow} on a \link{GAlignments} object behaves like on a \link[IRanges]{Ranges} object. See \code{?`\link[IRanges]{intra-range-methods}`} for the details. A major difference though is that it returns a \link{GAlignments} object instead of a \link[IRanges]{Ranges} object. Unlike with \code{qnarrow} (see below), the \code{start}/\code{end}/\code{width} arguments here describe the narrowing on the reference side, not the query side. } \item(){ \code{qnarrow} on a \link{GAlignments} object behaves like \code{narrow} except that the \code{start}/\code{end}/\code{width} arguments here specify the narrowing with respect to the query sequences. \code{qnarrow} on a \link{GAlignmentsList} object returns a \link{GAlignmentsList} object. } } } \value{ An object of the same class as, and \emph{parallel} to (i.e. same length and names as), the original object \code{x}. } \note{ There is no difference between \code{narrow} and \code{qnarrow} when all the alignments have a simple CIGAR (i.e. no indels or junctions). } \author{H. Pages and V. Obenchain } \seealso{ \itemize{ \item \link{GAlignments} and \link{GAlignmentsList} objects. \item The \link[IRanges]{intra-range-methods} man page in the \pkg{IRanges} package. \item The \link[GenomicRanges]{intra-range-methods} man page in the \pkg{GenomicRanges} package. } } \examples{ ## --------------------------------------------------------------------- ## A. ON A GAlignments OBJECT ## --------------------------------------------------------------------- ex1_file <- system.file("extdata", "ex1.bam", package="Rsamtools") param <- ScanBamParam(what=c("seq", "qual")) gal <- readGAlignments(ex1_file, param=param) gal ## This trims 3 nucleotides on the left and 5 nucleotides on the right ## of each alignment: gal2 <- qnarrow(gal, start=4, end=-6) gal2 ## Note that the 'start' and 'end' values are relative to the query ## sequences and specify the query substring that must be kept for each ## alignment. Negative values are relative to the right end of the query ## sequence. ## Also note that the metadata columns on 'gal' are propagated as-is so ## the "seq" and "qual" matadata columns must be adjusted "by hand" with ## narrow(); mcols(gal2)$seq <- narrow(mcols(gal)$seq, start=4, end=-6) mcols(gal2)$qual <- narrow(mcols(gal)$qual, start=4, end=-6) gal2 ## Sanity checks: stopifnot(identical(qwidth(gal2), width(mcols(gal2)$seq))) stopifnot(identical(qwidth(gal2), width(mcols(gal2)$qual))) ## --------------------------------------------------------------------- ## B. ON A GAlignmentsList OBJECT ## --------------------------------------------------------------------- gal1 <- GAlignments( seqnames=Rle(factor(c("chr1", "chr2", "chr1", "chr3")), c(1, 3, 2, 4)), pos=1:10, cigar=paste0(10:1, "M"), strand=Rle(strand(c("-", "+", "*", "+", "-")), c(1, 2, 2, 3, 2)), names=head(letters, 10), score=1:10) gal2 <- GAlignments( seqnames=Rle(factor(c("chr2", "chr4")), c(3, 4)), pos=1:7, cigar=c("5M", "3M2N3M2N3M", "5M", "10M", "5M1N4M", "8M2N1M", "5M"), strand=Rle(strand(c("-", "+")), c(4, 3)), names=tail(letters, 7), score=1:7) galist <- GAlignmentsList(noGaps=gal1, Gaps=gal2) galist qnarrow(galist) } \keyword{methods} \keyword{utilities} GenomicAlignments/man/junctions-methods.Rd0000644000175100017510000004245112607264575021740 0ustar00biocbuildbiocbuild\name{junctions-methods} \alias{junctions-methods} \alias{junctions} \alias{junctions,GAlignments-method} \alias{junctions,GAlignmentPairs-method} \alias{junctions,GAlignmentsList-method} \alias{NATURAL_INTRON_MOTIFS} \alias{summarizeJunctions} \alias{readTopHatJunctions} \alias{readSTARJunctions} \title{Extract junctions from genomic alignments} \description{ Given an object \code{x} containing genomic alignments (e.g. a \link{GAlignments}, \link{GAlignmentPairs}, or \link{GAlignmentsList} object), \code{junctions(x)} extracts the junctions from it and \code{summarizeJunctions(x)} extracts and summarizes them. \code{readTopHatJunctions} and \code{readSTARJunctions} are utilities for importing the junction file generated by the TopHat and STAR aligners, respectively. } \usage{ ## junctions() and summarizeJunctions() ## ------------------------------------ junctions(x, use.mcols=FALSE, ...) \S4method{junctions}{GAlignments}(x, use.mcols=FALSE) \S4method{junctions}{GAlignmentPairs}(x, use.mcols=FALSE) \S4method{junctions}{GAlignmentsList}(x, use.mcols=FALSE, ignore.strand=FALSE) ## summarizeJunctions() and NATURAL_INTRON_MOTIFS ## ---------------------------------------------- summarizeJunctions(x, with.revmap=FALSE, genome=NULL) NATURAL_INTRON_MOTIFS ## Utilities for importing the junction file generated by some aligners ## -------------------------------------------------------------------- readTopHatJunctions(file, file.is.raw.juncs=FALSE) readSTARJunctions(file) } \arguments{ \item{x}{ A \link{GAlignments}, \link{GAlignmentPairs}, or \link{GAlignmentsList} object. } \item{use.mcols}{ \code{TRUE} or \code{FALSE} (the default). Whether the metadata columns on \code{x} (accessible with \code{mcols(x)}) should be propagated to the returned object or not. } \item{...}{ Additional arguments, for use in specific methods. } \item{ignore.strand}{ \code{TRUE} or \code{FALSE} (the default). If set to \code{TRUE}, then the strand of \code{x} is set to \code{"*"} prior to any computation. } \item{with.revmap}{ \code{TRUE} or \code{FALSE} (the default). If set to \code{TRUE}, then a \code{revmap} metadata column is added to the output of \code{summarizeJunctions}. This metadata column is an \link[IRanges]{IntegerList} object representing the mapping from each element in the ouput (i.e. each junction) to the corresponding elements in the input \code{x}. } \item{genome}{ \code{NULL} (the default), or a \link[BSgenome]{BSgenome} object containing the sequences of the reference genome that was used to align the reads, or the name of this reference genome specified in a way that is accepted by the \code{\link[BSgenome]{getBSgenome}} function defined in the \pkg{BSgenome} software package. In that case the corresponding BSgenome data package needs to be already installed (see \code{?\link[BSgenome]{getBSgenome}} in the \pkg{BSgenome} package for the details). If \code{genome} is supplied, then the \code{intron_motif} and \code{intron_strand} metadata columns are computed (based on the dinucleotides found at the intron boundaries) and added to the output of \code{summarizeJunctions}. See the Value section below for a description of these metadata columns. } \item{file}{ The path (or a connection) to the junction file generated by the aligner. This file should be the \emph{junctions.bed} or \emph{new_list.juncs} file for \code{readTopHatJunctions}, and the \emph{SJ.out.tab} file for \code{readSTARJunctions}. } \item{file.is.raw.juncs}{ \code{TRUE} or \code{FALSE} (the default). If set to \code{TRUE}, then the input file is assumed to be a TopHat \emph{.juncs} file instead of the \emph{junctions.bed} file generated by TopHat. A TopHat \emph{.juncs} file can be obtained by passing the \emph{junctions.bed} file thru TopHat's \emph{bed_to_juncs} script. See the TopHat manual at \url{http://tophat.cbcb.umd.edu/manual.shtml} for more information. } } \details{ An N operation in the CIGAR of a genomic alignment is interpreted as a junction. \code{junctions(x)} will return the genomic ranges of all junctions found in \code{x}. More precisely, if \code{x} is a \link{GAlignments} object, \code{junctions(x)} is equivalent to: \preformatted{ psetdiff(granges(x), grglist(x, order.as.in.query=TRUE)) } On a \code{x} is a \link{GAlignmentPairs} object, it's equivalent to (but faster than): \preformatted{ mendoapply(c, junctions(first(x, real.strand=TRUE)), junctions(last(x, real.strand=TRUE))) } Note that starting with BioC 3.2, the behavior of \code{junctions} on a \link{GAlignmentPairs} object has been slightly modified so that the returned ranges now have the \emph{real strand} set on them. See the documentation of the \code{real.strand} argument in the man page of \link{GAlignmentPairs} objects for more information. \code{NATURAL_INTRON_MOTIFS} is a predefined character vector containing the 5 natural intron motifs described at \url{http://www.ncbi.nlm.nih.gov/pmc/articles/PMC84117/}. } \value{ \code{junctions(x)} returns the genomic ranges of the junctions in a \link[GenomicRanges]{GRangesList} object \emph{parallel} to \code{x} (i.e. with 1 list element per element in \code{x}). If \code{x} has names on it, they're propagated to the returned object. If \code{use.mcols} is TRUE and \code{x} has metadata columns on it (accessible with \code{mcols(x)}), they're propagated to the returned object. \code{summarizeJunctions} returns the genomic ranges of the unique junctions in \code{x} in an unstranded \link[GenomicRanges]{GRanges} object with the following metadata columns: \itemize{ \item \code{score}: The total number of alignments crossing each junction, i.e., that have the junction encoded in their CIGAR. \item \code{plus_score} and \code{minus_score}: The strand-specific number of alignments crossing each junction. \item \code{revmap}: [Only if \code{with.revmap} was set to \code{TRUE}.] An \link[IRanges]{IntegerList} object representing the mapping from each element in the ouput (i.e. each junction) to the corresponding elements in input \code{x}. \item \code{intron_motif} and \code{intron_strand}: [Only if \code{genome} was supplied.] The intron motif and strand for each junction, based on the dinucleotides found in the genome sequences at the intron boundaries. The \code{intron_motif} metadata column is a factor whose levels are the 5 natural intron motifs stored in predefined character vector \code{NATURAL_INTRON_MOTIFS}. If the dinucleotides found at the intron boundaries don't match any of these natural intron motifs, then \code{intron_motif} and \code{intron_strand} are set to \code{NA} and \code{*}, respectively. } \code{readTopHatJunctions} and \code{readSTARJunctions} return the junctions reported in the input file in a stranded \link[GenomicRanges]{GRanges} object. With the following metadata columns for \code{readTopHatJunctions} (when reading in the \emph{junctions.bed} file): \itemize{ \item \code{name}: An id assigned by TopHat to each junction. This id is of the form JUNC00000017 and is unique within the \emph{junctions.bed} file. \item \code{score}: The total number of alignments crossing each junction. } With the following metadata columns for \code{readSTARJunctions}: \itemize{ \item \code{intron_motif} and \code{intron_strand}: The intron motif and strand for each junction, based on the code found in the input file (0: non-canonical, 1: GT/AG, 2: CT/AC, 3: GC/AG, 4: CT/GC, 5: AT/AC, 6: GT/AT). Note that of the 5 natural intron motifs stored in predefined character vector \code{NATURAL_INTRON_MOTIFS}, only the first 3 are assigned codes by the STAR software (2 codes per motif, one if the intron is on the plus strand and one if it's on the minus strand). Thus the \code{intron_motif} metadata column is a factor with only 3 levels. If code is 0, then \code{intron_motif} and \code{intron_strand} are set to \code{NA} and \code{*}, respectively. \item \code{um_reads}: The number of uniquely mapping reads crossing the junction (a pair where the 2 alignments cross the same junction is counted only once). \item \code{mm_reads}: The number of multi-mapping reads crossing the junction (a pair where the 2 alignments cross the same junction is counted only once). } See STAR manual at \url{https://code.google.com/p/rna-star/} for more information. } \author{H. Pages} \references{ \url{http://www.ncbi.nlm.nih.gov/pmc/articles/PMC84117/} for the 5 natural intron motifs stored in predefined character vector \code{NATURAL_INTRON_MOTIFS}. TopHat2: accurate alignment of transcriptomes in the presence of insertions, deletions and gene fusions \itemize{ \item TopHat2 paper: \url{http://genomebiology.com/2013/14/4/r36} \item TopHat2 software and manual: \url{http://tophat.cbcb.umd.edu/} } STAR: ultrafast universal RNA-seq aligner \itemize{ \item STAR paper: \url{http://bioinformatics.oxfordjournals.org/content/early/2012/10/25/bioinformatics.bts635} \item STAR software and manual: \url{https://code.google.com/p/rna-star/} } } \seealso{ \itemize{ \item \link{GAlignments}, \link{GAlignmentPairs}, and \link{GAlignmentsList} objects. \item The \link[GenomicRanges]{GRanges} and \link[GenomicRanges]{GRangesList} classes defined and documented in the \pkg{GenomicRanges} package. \item The \link[IRanges]{IntegerList} class defined and documented in the \pkg{IRanges} package. \item The \code{\link[BSgenome]{getBSgenome}} function in the \pkg{BSgenome} package, for searching the installed BSgenome data packages for the specified genome and returning it as a \link[BSgenome]{BSgenome} object. \item The \code{\link{readGAlignments}} and \code{\link{readGAlignmentPairs}} functions for reading genomic alignments from a file. \item The \code{\link[IRanges]{extractList}} function in the \pkg{IRanges} package, for extracting groups of elements from a vector-like object and returning them into a \link[S4Vectors]{List} object. } } \examples{ library(RNAseqData.HNRNPC.bam.chr14) bamfile <- RNAseqData.HNRNPC.bam.chr14_BAMFILES[1] ## --------------------------------------------------------------------- ## A. junctions() ## --------------------------------------------------------------------- gal <- readGAlignments(bamfile) table(njunc(gal)) # some alignments have 3 junctions! juncs <- junctions(gal) juncs stopifnot(identical(unname(elementLengths(juncs)), njunc(gal))) galp <- readGAlignmentPairs(bamfile) juncs <- junctions(galp) juncs stopifnot(identical(unname(elementLengths(juncs)), njunc(galp))) ## --------------------------------------------------------------------- ## B. summarizeJunctions() ## --------------------------------------------------------------------- ## By default, only the "score", "plus_score", and "minus_score" ## metadata columns are returned: junc_summary <- summarizeJunctions(gal) junc_summary ## The "score" metadata column reports the total number of alignments ## crossing each junction, i.e., that have the junction encoded in their ## CIGAR: median(mcols(junc_summary)$score) ## The "plus_score" and "minus_score" metadata columns report the ## strand-specific number of alignments crossing each junction: stopifnot(identical(mcols(junc_summary)$score, mcols(junc_summary)$plus_score + mcols(junc_summary)$minus_score)) ## If 'with.revmap' is TRUE, the "revmap" metadata column is added to ## the output. This metadata column is an IntegerList object represen- ## ting the mapping from each element in the ouput (i.e. a junction) to ## the corresponding elements in the input 'x'. Here we're going to use ## this to compute a 'score2' for each junction. We obtain this score ## by summing the mapping qualities of the alignments crossing the ## junction: gal <- readGAlignments(bamfile, param=ScanBamParam(what="mapq")) junc_summary <- summarizeJunctions(gal, with.revmap=TRUE) junc_score2 <- sum(extractList(mcols(gal)$mapq, mcols(junc_summary)$revmap)) mcols(junc_summary)$score2 <- junc_score2 ## If the name of the reference genome is specified thru the 'genome' ## argument (in which case the corresponding BSgenome data package needs ## to be installed), then summarizeJunctions() returns the intron motif ## and strand for each junction. ## Since the reads in RNAseqData.HNRNPC.bam.chr14 were aligned to ## the hg19 genome, the following requires that you have ## BSgenome.Hsapiens.UCSC.hg19 installed: junc_summary <- summarizeJunctions(gal, with.revmap=TRUE, genome="hg19") mcols(junc_summary)$score2 <- junc_score2 # putting 'score2' back ## The "intron_motif" metadata column is a factor whose levels are the ## 5 natural intron motifs stored in predefined character vector ## 'NATURAL_INTRON_MOTIFS': table(mcols(junc_summary)$intron_motif) ## --------------------------------------------------------------------- ## C. STRANDED RNA-seq PROTOCOL ## --------------------------------------------------------------------- ## Here is a simple test for checking whether the RNA-seq protocol was ## stranded or not: strandedTest <- function(plus_score, minus_score) (sum(plus_score ^ 2) + sum(minus_score ^ 2)) / sum((plus_score + minus_score) ^ 2) ## The result of this test is guaranteed to be >= 0.5 and <= 1. ## If, for each junction, the strand of the crossing alignments looks ## random (i.e. "plus_score" and "minus_score" are close), then ## strandedTest() will return a value close to 0.5. If it doesn't look ## random (i.e. for each junction, one of "plus_score" and "minus_score" ## is much bigger than the other), then strandedTest() will return a ## value close to 1. ## If the reads are single-end, the test is meaningful when applied ## directly on 'junc_summary'. However, for the test to be meaningful ## on paired-end reads, it needs to be applied on the first and last ## alignments separately: junc_summary1 <- summarizeJunctions(first(galp)) junc_summary2 <- summarizeJunctions(last(galp)) strandedTest(mcols(junc_summary1)$plus_score, mcols(junc_summary1)$minus_score) strandedTest(mcols(junc_summary2)$plus_score, mcols(junc_summary2)$minus_score) ## Both values are close to 0.5 which suggests that the RNA-seq protocol ## used for this experiment was not stranded. ## --------------------------------------------------------------------- ## UTILITIES FOR IMPORTING THE JUNCTION FILE GENERATED BY SOME ALIGNERS ## --------------------------------------------------------------------- ## The TopHat aligner generates a junctions.bed file where it reports ## all the junctions satisfying some "quality" criteria (see the TopHat ## manual at http://tophat.cbcb.umd.edu/manual.shtml for more ## information). This file can be loaded with readTopHatJunctions(): runname <- names(RNAseqData.HNRNPC.bam.chr14_BAMFILES)[1] junctions_file <- system.file("extdata", "tophat2_out", runname, "junctions.bed", package="RNAseqData.HNRNPC.bam.chr14") th_junctions <- readTopHatJunctions(junctions_file) ## Comparing the "TopHat junctions" with the result of ## summarizeJunctions(): th_junctions14 <- th_junctions seqlevels(th_junctions14, force=TRUE) <- "chr14" mcols(th_junctions14)$intron_strand <- strand(th_junctions14) strand(th_junctions14) <- "*" ## All the "TopHat junctions" are in 'junc_summary': stopifnot(all(th_junctions14 \%in\% junc_summary)) ## But not all the junctions in 'junc_summary' are reported by TopHat ## (that's because TopHat reports only junctions that satisfy some ## "quality" criteria): is_in_th_junctions14 <- junc_summary \%in\% th_junctions14 table(is_in_th_junctions14) # 32 junctions are not in TopHat's # junctions.bed file junc_summary2 <- junc_summary[is_in_th_junctions14] ## 'junc_summary2' and 'th_junctions14' contain the same junctions in ## the same order: stopifnot(all(junc_summary2 == th_junctions14)) ## Let's merge their metadata columns. We use our own version of ## merge() for this, which is stricter (it checks that the common ## columns are the same in the 2 data frames to merge) and also ## simpler: merge2 <- function(df1, df2) { common_colnames <- intersect(colnames(df1), colnames(df2)) lapply(common_colnames, function(colname) stopifnot(all(df1[ , colname] == df2[ , colname]))) extra_mcolnames <- setdiff(colnames(df2), colnames(df1)) cbind(df1, df2[ , extra_mcolnames, drop=FALSE]) } mcols(th_junctions14) <- merge2(mcols(th_junctions14), mcols(junc_summary2)) ## Here is a peculiar junction reported by TopHat: idx0 <- which(mcols(th_junctions14)$score2 == 0L) th_junctions14[idx0] gal[mcols(th_junctions14)$revmap[[idx0]]] ## The junction is crossed by 5 alignments (score is 5), all of which ## have a mapping quality of 0! } \keyword{methods} \keyword{manip} GenomicAlignments/man/mapCoords-methods.Rd0000644000175100017510000000370112607264575021646 0ustar00biocbuildbiocbuild\name{mapCoords-methods} \alias{mapCoords-methods} \alias{mapCoords,GenomicRanges,GAlignments-method} \title{Mapping ranges between sequences} \description{ DEFUNCT! Use \code{\link{mapToAlignments}} instead. A method for translating a set of input ranges through a \link{GAlignments} object. Returns a \linkS4class{GenomicRanges} object. NOTE: The \code{\link[IRanges]{mapCoords}} generic function is defined and documented in the \pkg{IRanges} package. A method for translating a set of input ranges through a \link[GenomicRanges]{GRangesList} object is defined and documented in the \pkg{GenomicRanges} package. } \usage{ \S4method{mapCoords}{GenomicRanges,GAlignments}(from, to, ...) } \arguments{ \item{from}{The input ranges to map, usually a \code{\linkS4class{GRanges}}.} \item{to}{The alignment between the sequences in \code{from} and the sequences in the result.} \item{\dots}{Arguments passed to other methods.} } \value{ A \code{GRanges} object of mapped coordinates with matching data as metadata columns (`fromHits` and `toHits`). Matching data are the result of calling \code{findOverlaps} with type `within` on ranges in \code{from} (the query) and the ranges in \code{to} (the subject). Matching can be many-to-one or one-to-many; one row is reported for each match. } \details{ DEFUNCT! Use \code{\link{mapToAlignments}} instead. Each element in \code{to} is taken to represent the alignment of a (read) sequence. The CIGAR string is used to translate the input ranges to be relative to the read start. This is useful, for example, when determining the cycle (read position) at which a particular genomic mismatch occurs. } \seealso{ The generic \link[IRanges]{mapCoords-methods} in the IRanges package. Additional methods in the GenomicRanges package \link[GenomicRanges]{mapCoords-methods}. } \examples{ ## DEFUNCT! See ?mapToAlignments for a replacement. } \author{M. Lawrence} GenomicAlignments/man/pileLettersAt.Rd0000644000175100017510000001061312607264575021037 0ustar00biocbuildbiocbuild\name{pileLettersAt} \alias{pileLettersAt} \title{Pile the letters of a set of aligned reads on top of a set of individual genomic positions} \description{ \code{pileLettersAt} extracts the letters/nucleotides of a set of reads that align to a set of individual genomic positions of interest. The extracted letters are returned as "piles of letters" (one per genomic position of interest) stored in an \link[Biostrings]{XStringSet} (typically \link[Biostrings]{DNAStringSet}) object. } \usage{ pileLettersAt(x, seqnames, pos, cigar, at) } \arguments{ \item{x}{ An \link[Biostrings]{XStringSet} (typically \link[Biostrings]{DNAStringSet}) object containing N \emph{unaligned} read sequences (a.k.a. the query sequences) reported with respect to the + strand. } \item{seqnames}{ A factor-\link[S4Vectors]{Rle} \emph{parallel} to \code{x}. For each \code{i}, \code{seqnames[i]} must be the name of the reference sequence of the i-th alignment. } \item{pos}{ An integer vector \emph{parallel} to \code{x}. For each \code{i}, \code{pos[i]} must be the 1-based position on the reference sequence of the first aligned letter in \code{x[[i]]}. } \item{cigar}{ A character vector \emph{parallel} to \code{x}. Contains the extended CIGAR strings of the alignments. } \item{at}{ A \link[GenomicRanges]{GRanges} object containing the individual genomic positions of interest. \code{seqlevels(at)} must be identical to \code{levels(seqnames)}. } } \details{ \code{x}, \code{seqnames}, \code{pos}, \code{cigar} must be 4 \emph{parallel} vectors describing N aligned reads. } \value{ An \link[Biostrings]{XStringSet} (typically \link[Biostrings]{DNAStringSet}) object \emph{parallel} to \code{at} (i.e. with 1 string per individual genomic position). } \author{H. Pages} \seealso{ \itemize{ \item \link[Biostrings]{DNAStringSet} objects in the \pkg{Biostrings} package. \item \link[GenomicRanges]{GRanges} objects in the \pkg{GenomicRanges} package. \item The \code{\link{stackStringsFromBam}} function for stacking the read sequences (or their quality strings) stored in a BAM file on a region of interest. \item \link{GAlignments} objects. \item \link{cigar-utils} for the CIGAR utility functions used internally by \code{pileLettersAt}. \item The SAMtools mpileup command available at \url{http://samtools.sourceforge.net/} as part of the SAMtools project. } } \examples{ ## Input ## - A BAM file: bamfile <- BamFile(system.file("extdata", "ex1.bam", package="Rsamtools")) seqinfo(bamfile) # to see the seqlevels and seqlengths stackStringsFromBam(bamfile, param="seq1:1-21") # a quick look at # the reads ## - A GRanges object containing Individual Genomic Positions Of ## Interest: my_IGPOI <- GRanges(Rle(c("seq1", "seq2"), c(7, 2)), IRanges(c(1:5, 21, 1575, 1513:1514), width=1)) ## Some preliminary massage on 'my_IGPOI' seqinfo(my_IGPOI) <- merge(seqinfo(my_IGPOI), seqinfo(bamfile)) seqlevels(my_IGPOI) <- seqlevelsInUse(my_IGPOI) ## Load the BAM file in a GAlignments object. We load only the reads ## aligned to the sequences in 'seqlevels(my_IGPOI)' and we filter out ## reads not passing quality controls (flag bit 0x200) and PCR or ## optical duplicates (flag bit 0x400). See ?ScanBamParam and the SAM ## Spec for more information. which <- as(seqinfo(my_IGPOI), "GRanges") flag <- scanBamFlag(isNotPassingQualityControls=FALSE, isDuplicate=FALSE) what <- c("seq", "qual") param <- ScanBamParam(flag=flag, what=c("seq", "qual"), which=which) gal <- readGAlignments(bamfile, param=param) seqlevels(gal) <- seqlevels(my_IGPOI) ## Extract the read sequences (a.k.a. query sequences) and quality ## strings. Both are reported with respect to the + strand. qseq <- mcols(gal)$seq qual <- mcols(gal)$qual nucl_piles <- pileLettersAt(qseq, seqnames(gal), start(gal), cigar(gal), my_IGPOI) qual_piles <- pileLettersAt(qual, seqnames(gal), start(gal), cigar(gal), my_IGPOI) mcols(my_IGPOI)$nucl_piles <- nucl_piles mcols(my_IGPOI)$qual_piles <- qual_piles my_IGPOI ## Finally, to summarize A/C/G/T frequencies at each position: alphabetFrequency(nucl_piles, baseOnly=TRUE) } \keyword{methods} \keyword{manip} GenomicAlignments/man/readGAlignments.Rd0000644000175100017510000004720612607264575021332 0ustar00biocbuildbiocbuild\name{readGAlignments} \alias{readGAlignments} \alias{readGAlignments,BamFile-method} \alias{readGAlignments,character-method} \alias{readGAlignments,BamViews-method} \alias{readGAlignmentPairs} \alias{readGAlignmentPairs,BamFile-method} \alias{readGAlignmentPairs,character-method} \alias{readGAlignmentsList} \alias{readGAlignmentsList,BamFile-method} \alias{readGAlignmentsList,character-method} \alias{readGappedReads} \alias{readGappedReads,BamFile-method} \alias{readGappedReads,character-method} % old stuff (Deprecated or Defunct) \alias{readGAlignmentsFromBam} \alias{readGAlignmentPairsFromBam} \alias{readGAlignmentsListFromBam} \alias{readGappedReadsFromBam} \title{Reading genomic alignments from a file} \description{ Read genomic alignments from a file (typically a BAM file) into a \link{GAlignments}, \link{GAlignmentPairs}, \link{GAlignmentsList}, or \link{GappedReads} object. } \usage{ readGAlignments(file, index=file, use.names=FALSE, param=NULL, with.which_label=FALSE) readGAlignmentPairs(file, index=file, use.names=FALSE, param=NULL, with.which_label=FALSE, strandMode=1) readGAlignmentsList(file, index=file, use.names=FALSE, param=ScanBamParam(), with.which_label=FALSE) readGappedReads(file, index=file, use.names=FALSE, param=NULL, with.which_label=FALSE) } \arguments{ \item{file}{ The path to the file to read or a \link[Rsamtools]{BamFile} object. Can also be a \link[Rsamtools]{BamViews} object for \code{readGAlignments}. } \item{index}{ The path to the index file of the BAM file to read. Must be given \emph{without} the '.bai' extension. See \code{\link[Rsamtools]{scanBam}} in the \pkg{Rsamtools} packages for more information. } \item{use.names}{ \code{TRUE} or \code{FALSE}. By default (i.e. \code{use.names=FALSE}), the resulting object has no names. If \code{use.names} is \code{TRUE}, then the names are constructed from the query template names (QNAME field in a SAM/BAM file). Note that the 2 records in a pair (when using \code{readGAlignmentPairs} or the records in a group (when using \code{readGAlignmentsList}) have the same QNAME. } \item{param}{\code{NULL} or a \link[Rsamtools]{ScanBamParam} object. Like for \code{\link[Rsamtools]{scanBam}}, this influences what fields and which records are imported. However, note that the fields specified thru this \link[Rsamtools]{ScanBamParam} object will be loaded \emph{in addition} to any field required for generating the returned object (\link{GAlignments}, \link{GAlignmentPairs}, or \link{GappedReads} object), but only the fields requested by the user will actually be kept as metadata columns of the object. By default (i.e. \code{param=NULL} or \code{param=ScanBamParam()}), no additional field is loaded. The flag used is \code{scanBamFlag(isUnmappedQuery=FALSE)} for \code{readGAlignments}, \code{readGAlignmentsList}, and \code{readGappedReads}. (i.e. only records corresponding to mapped reads are loaded), and \code{scanBamFlag(isUnmappedQuery=FALSE, isPaired=TRUE, hasUnmappedMate=FALSE)} for \code{readGAlignmentPairs} (i.e. only records corresponding to paired-end reads with both ends mapped are loaded). } \item{with.which_label}{\code{TRUE} or \code{FALSE} (the default). If \code{TRUE} and if \code{param} has a \code{which} component, a \code{"which_label"} metadata column is added to the returned \link{GAlignments} or \link{GappedReads} object, or to the \code{\link{first}} and \code{\link{last}} components of the returned \link{GAlignmentPairs} object. In the case of \code{readGAlignmentsList}, it's added as an \emph{inner} metadata column, that is, the metadata column is placed on the \link{GAlignments} object obtained by unlisting the returned \link{GAlignmentsList} object. The purpose of this metadata column is to unambiguously identify the range in \code{which} where each element in the returned object originates from. The labels used to identify the ranges are normally of the form \code{"seq1:12250-246500"}, that is, they're the same as the names found on the outer list that \code{\link{scanBam}} would return if called with the same \code{param} argument. If some ranges are duplicated, then the labels are made unique by appending a unique suffix to all of them. The \code{"which_label"} metadata column is represented as a factor-\link[S4Vectors]{Rle}. } \item{strandMode}{ Strand mode to set on the returned \link{GAlignmentPairs} object. See \code{?\link{strandMode}} for more information. } } \details{ \itemize{ \item \code{readGAlignments} reads a file containing aligned reads as a \link{GAlignments} object. See \code{?\link{GAlignments}} for a description of \link{GAlignments} objects. When \code{file} is a \link[Rsamtools]{BamViews} object, \code{readGAlignments} visits each path in \code{bamPaths(file)}, returning the result of \code{readGAlignments} applied to the specified path. When \code{index} is missing, it is set equal to \code{bamIndicies(file)}. Only reads in \code{bamRanges(file)} are returned (if \code{param} is supplied, \code{bamRanges(file)} takes precedence over \code{bamWhich(param)}). The return value is a \link[S4Vectors]{SimpleList} object, with elements of the list corresponding to each path. \code{bamSamples(file)} is available as metadata columns (accessed with \code{mcols}) of the returned \link[S4Vectors]{SimpleList} object. \item \code{readGAlignmentPairs} reads a file containing aligned paired-end reads as a \link{GAlignmentPairs} object. See \code{?\link{GAlignmentPairs}} for a description of \link{GAlignmentPairs} objects. \item \code{readGAlignmentsList} reads a file containing aligned reads as a \link{GAlignmentsList} object. See \code{?\link{GAlignmentsList}} for a description of \link{GAlignmentsList} objects. \code{readGAlignmentsList} pairs records into mates according to the pairing criteria described below. The 1st mate will always be 1st in the \link{GAlignmentsList} list elements that have mate_status set to \code{"mated"}, and the 2nd mate will always be 2nd. A \code{GAlignmentsList} is returned with a \sQuote{mate_status} metadata column on the outer list elements. \code{mate_status} is a factor with 3 levels indicating mate status, \sQuote{mated}, \sQuote{ambiguous} or \sQuote{unmated}: \itemize{ \item{mated:} primary or non-primary pairs \item{ambiguous:} multiple segments matching to the same location (indistinguishable) \item{unmated:} mate does not exist or is unmapped } When the \sQuote{file} argument is a BamFile, \sQuote{asMates=TRUE} must be set, otherwise the data are treated as single-end reads. See the \sQuote{asMates} section of \code{?\link[Rsamtools]{BamFile}} in the \pkg{Rsamtools} package for details. \item \code{readGappedReads} reads a file containing aligned reads as a \link{GappedReads} object. See \code{?\link{GappedReads}} for a description of \link{GappedReads} objects. } For all these functions, flags, tags and ranges may be specified in the supplied \link[Rsamtools]{ScanBamParam} object for fine tuning of results. } \section{Pairing criteria}{ This section describes the pairing criteria used by \code{readGAlignmentsList} and \code{readGAlignmentPairs}. \itemize{ \item First, only records with flag bit 0x1 (multiple segments) set to 1, flag bit 0x4 (segment unmapped) set to 0, and flag bit 0x8 (next segment in the template unmapped) set to 0, are candidates for pairing (see the SAM Spec for a description of flag bits and fields). Records that correspond to single-end reads, or records that correspond to paired-end reads where one or both ends are unmapped, will remain unmated. \item Then the following fields and flag bits are considered: \itemize{ \item (A) QNAME \item (B) RNAME, RNEXT \item (C) POS, PNEXT \item (D) Flag bits Ox10 (segment aligned to minus strand) and 0x20 (next segment aligned to minus strand) \item (E) Flag bits 0x40 (first segment in template) and 0x80 (last segment in template) \item (F) Flag bit 0x2 (proper pair) \item (G) Flag bit 0x100 (secondary alignment) } 2 records rec1 and rec2 are considered mates iff all the following conditions are satisfied: \itemize{ \item (A) QNAME(rec1) == QNAME(rec2) \item (B) RNEXT(rec1) == RNAME(rec2) and RNEXT(rec2) == RNAME(rec1) \item (C) PNEXT(rec1) == POS(rec2) and PNEXT(rec2) == POS(rec1) \item (D) Flag bit 0x20 of rec1 == Flag bit 0x10 of rec2 and Flag bit 0x20 of rec2 == Flag bit 0x10 of rec1 \item (E) rec1 corresponds to the first segment in the template and rec2 corresponds to the last segment in the template, OR, rec2 corresponds to the first segment in the template and rec1 corresponds to the last segment in the template \item (F) rec1 and rec2 have same flag bit 0x2 \item (G) rec1 and rec2 have same flag bit 0x100 } } Note that this is actually the pairing criteria used by \code{\link[Rsamtools]{scanBam}} (when the \link[Rsamtools]{BamFile} passed to it has the \code{asMates} toggle set to \code{TRUE}), which \code{readGAlignmentsList} and \code{readGAlignmentPairs} call behind the scene. It is also the pairing criteria used by \code{\link{findMateAlignment}}. } \value{ A \link{GAlignments} object for \code{readGAlignments}. A \link{GAlignmentPairs} object for \code{readGAlignmentPairs}. Note that a BAM (or SAM) file can in theory contain a mix of single-end and paired-end reads, but in practise it seems that single-end and paired-end are not mixed. In other words, the value of flag bit 0x1 (\code{isPaired}) is the same for all the records in a file. So if \code{readGAlignmentPairs} returns a \link{GAlignmentPairs} object of length zero, this almost always means that the BAM (or SAM) file contains alignments for single-end reads (although it could also mean that the user-supplied \code{\linkS4class{ScanBamParam}} is filtering out everything, or that the file is empty, or that all the records in the file correspond to unmapped reads). A \link{GAlignmentsList} object for \code{readGAlignmentsList}. When the list contains paired-end reads a metadata data column of \code{mate_status} is added to the object. See details in the `Bam specific back-ends' section on this man page. A \link{GappedReads} object for \code{readGappedReads}. } \note{ BAM records corresponding to unmapped reads are always ignored. Starting with Rsamtools 1.7.1 (BioC 2.10), PCR or optical duplicates are loaded by default (use \code{scanBamFlag(isDuplicate=FALSE)} to drop them). } \author{H. Pages and Valerie Obenchain } \seealso{ \itemize{ \item \code{\link[Rsamtools]{scanBam}} and \code{\link[Rsamtools]{ScanBamParam}} in the \pkg{Rsamtools} package. \item \link{GAlignments}, \link{GAlignmentPairs}, \link{GAlignmentsList}, and \link{GappedReads} objects. \item \link[IRanges]{RangesList} objects (used in the examples below to specify the \code{which} regions) in the \pkg{IRanges} package. } } \examples{ ## --------------------------------------------------------------------- ## A. readGAlignments() ## --------------------------------------------------------------------- ## Simple use: bamfile <- system.file("extdata", "ex1.bam", package="Rsamtools", mustWork=TRUE) gal1 <- readGAlignments(bamfile) gal1 names(gal1) ## Using the 'use.names' arg: gal2 <- readGAlignments(bamfile, use.names=TRUE) gal2 head(names(gal2)) ## Using the 'param' arg to drop PCR or optical duplicates as well as ## secondary alignments, and to load additional BAM fields: param <- ScanBamParam(flag=scanBamFlag(isDuplicate=FALSE, isSecondaryAlignment=FALSE), what=c("qual", "flag")) gal3 <- readGAlignments(bamfile, param=param) gal3 mcols(gal3) ## Using the 'param' arg to load alignments from particular regions. which <- RangesList(seq1=IRanges(1000, 1100), seq2=IRanges(c(1546, 1555, 1567), width=10)) param <- ScanBamParam(which=which) gal4 <- readGAlignments(bamfile, use.names=TRUE, param=param) gal4 ## IMPORTANT NOTE: A given record is loaded one time for each region ## it overlaps with. We call this "duplicated record selection" (this ## is a scanBam() feature, readGAlignments() is based on scanBam()): which <- IRangesList(seq2=IRanges(c(1555, 1567), width=10)) param <- ScanBamParam(which=which) gal5 <- readGAlignments(bamfile, use.names=TRUE, param=param) gal5 # record EAS114_26:7:37:79:581 was loaded twice ## This becomes clearer if we use 'with.which_label=TRUE' to identify ## the region in 'which' where each element in 'gal5' originates from. gal5 <- readGAlignments(bamfile, use.names=TRUE, param=param, with.which_label=TRUE) gal5 ## Not surprisingly, we also get "duplicated record selection" when ## 'which' contains repeated or overlapping regions. Using the same ## regions as we did for 'gal4' above, except that now we're ## repeating the region on seq1: which <- RangesList(seq1=rep(IRanges(1000, 1100), 2), seq2=IRanges(c(1546, 1555, 1567), width=10)) param <- ScanBamParam(which=which) gal4b <- readGAlignments(bamfile, use.names=TRUE, param=param) length(gal4b) # > length(gal4), because all the records overlapping # with bases 1000 to 1100 on seq1 are now duplicated ## The "duplicated record selection" will artificially increase the ## coverage or affect other downstream results. It can be mitigated ## (but not completely eliminated) by first "reducing" the set of ## regions: which <- reduce(which) which param <- ScanBamParam(which=which) gal4c <- readGAlignments(bamfile, use.names=TRUE, param=param) length(gal4c) # < length(gal4), because the 2 first original regions # on seq2 were merged into a single one ## Note that reducing the set of regions didn't completely eliminate ## "duplicated record selection". Records that overlap the 2 reduced ## regions on seq2 (which$seq2) are loaded twice (like for 'gal5' ## above). See example D. below for how to completely eliminate ## "duplicated record selection". ## Using the 'param' arg to load tags. Except for MF and Aq, the tags ## specified below are predefined tags (see the SAM Spec for the list ## of predefined tags and their meaning). param <- ScanBamParam(tag=c("MF", "Aq", "NM", "UQ", "H0", "H1"), what="isize") gal6 <- readGAlignments(bamfile, param=param) mcols(gal6) # "tag" cols always after "what" cols ## With a BamViews object: fls <- system.file("extdata", "ex1.bam", package="Rsamtools", mustWork=TRUE) bv <- BamViews(fls, bamSamples=DataFrame(info="test", row.names="ex1"), auto.range=TRUE) ## Note that the "readGAlignments" method for BamViews objects ## requires the ShortRead package to be installed. aln <- readGAlignments(bv) aln aln[[1]] aln[colnames(bv)] mcols(aln) ## --------------------------------------------------------------------- ## B. readGAlignmentPairs() ## --------------------------------------------------------------------- galp1 <- readGAlignmentPairs(bamfile) head(galp1) names(galp1) ## Here we use the 'param' arg to filter by proper pair, drop PCR / optical ## duplicates, and drop secondary alignments. Filtering by proper pair and ## dropping secondary alignments can help make the pairing algorithm run ## significantly faster: param <- ScanBamParam(flag=scanBamFlag(isProperPair=TRUE, isDuplicate=FALSE, isSecondaryAlignment=FALSE)) galp2 <- readGAlignmentPairs(bamfile, use.names=TRUE, param=param) galp2 head(galp2) head(names(galp2)) ## --------------------------------------------------------------------- ## C. readGAlignmentsList() ## --------------------------------------------------------------------- library(pasillaBamSubset) ## 'file' as character. bam <- untreated3_chr4() galist1 <- readGAlignmentsList(bam) galist1[1:3] length(galist1) table(elementLengths(galist1)) ## When 'file' is a BamFile, 'asMates' must be TRUE. If FALSE, ## the data are treated as single-end and each list element of the ## GAlignmentsList will be of length 1. For single-end data ## use readGAlignments(). bamfile <- BamFile(bam, yieldSize=3, asMates=TRUE) readGAlignmentsList(bamfile) ## Use a 'param' to fine tune the results. param <- ScanBamParam(flag=scanBamFlag(isProperPair=TRUE)) galist2 <- readGAlignmentsList(bam, param=param) length(galist2) ## --------------------------------------------------------------------- ## D. COMPARING 4 STRATEGIES FOR LOADING THE ALIGNMENTS THAT OVERLAP ## WITH THE EXONIC REGIONS ON FLY CHROMMOSOME 4 ## --------------------------------------------------------------------- library(pasillaBamSubset) bam <- untreated1_chr4() library(TxDb.Dmelanogaster.UCSC.dm3.ensGene) txdb <- TxDb.Dmelanogaster.UCSC.dm3.ensGene ex <- exons(txdb) seqlevels(ex, force=TRUE) <- "chr4" length(ex) ## Some of the exons overlap with each other: isDisjoint(ex) # FALSE exonic_regions <- reduce(ex) isDisjoint(exonic_regions) # no more overlaps length(exonic_regions) ## Strategy #1: slow and loads a lot of records more than once (see ## "duplicated record selection" in example A. above). param1 <- ScanBamParam(which=ex) gal1 <- readGAlignments(bam, param=param1) length(gal1) # many "duplicated records" ## Strategy #2: faster and generates less duplicated records but ## doesn't eliminate them. param2 <- ScanBamParam(which=exonic_regions) gal2 <- readGAlignments(bam, param=param2) length(gal2) # less "duplicated records" ## Strategy #3: fast and completely eliminates duplicated records. gal0 <- readGAlignments(bam) gal3 <- subsetByOverlaps(gal0, exonic_regions, ignore.strand=TRUE) length(gal3) # no "duplicated records" ## Note that, in this case using 'exonic_regions' or 'ex' makes no ## difference: gal3b <- subsetByOverlaps(gal0, ex, ignore.strand=TRUE) stopifnot(identical(gal3, gal3b)) ## Strategy #4: strategy #3 however can require a lot of memory if the ## file is big because we load all the alignments into memory before we ## select those that overlap with the exonic regions. Strategy #4 ## addresses this by loading the file by chunks. bamfile <- BamFile(bam, yieldSize=50000) open(bamfile) while (length(chunk0 <- readGAlignments(bamfile))) { chunk <- subsetByOverlaps(chunk0, ex, ignore.strand=TRUE) cat("chunk0:", length(chunk0), "- chunk:", length(chunk), "\n") ## ... do something with 'chunk' ... } close(bamfile) ## --------------------------------------------------------------------- ## E. readGappedReads() ## --------------------------------------------------------------------- greads1 <- readGappedReads(bamfile) greads1 names(greads1) qseq(greads1) greads2 <- readGappedReads(bamfile, use.names=TRUE) head(greads2) head(names(greads2)) } \keyword{manip} GenomicAlignments/man/sequenceLayer.Rd0000644000175100017510000003313212607264575021064 0ustar00biocbuildbiocbuild\name{sequenceLayer} \alias{sequenceLayer} \title{Lay read sequences alongside the reference space, using their CIGARs} \description{ \code{sequenceLayer} can lay strings that belong to a given space (e.g. the \code{"query"} space) alongside another space (e.g. the \code{"reference"} space) by removing/injecting substrings from/into them, using the supplied CIGARs. Its primary use case is to lay the read sequences stored in a BAM file (which are considered to belong to the \code{"query"} space) alongside the \code{"reference"} space. It can also be used to remove the parts of the read sequences that correspond to soft-clipping. More generally it can lay strings that belong to any supported space alongside any other supported space. See the Details section below for the list of supported spaces. } \usage{ sequenceLayer(x, cigar, from="query", to="reference", D.letter="-", N.letter=".", I.letter="-", S.letter="+", H.letter="+") } \arguments{ \item{x}{ An \link{XStringSet} object containing strings that belong to a given space. } \item{cigar}{ A character vector or factor of the same length as \code{x} containing the extended CIGAR strings (one per element in \code{x}). } \item{from, to}{ A single string specifying one of the 8 supported spaces listed in the Details section below. \code{from} must be the current space (i.e. the space the strings in \code{x} belong to) and \code{to} is the space alonside which to lay the strings in \code{x}. } \item{D.letter, N.letter, I.letter, S.letter, H.letter}{ A single letter used as a filler for injections. More on this in the Details section below. } } \details{ The 8 supported spaces are: \code{"reference"}, \code{"reference-N-regions-removed"}, \code{"query"}, \code{"query-before-hard-clipping"}, \code{"query-after-soft-clipping"}, \code{"pairwise"}, \code{"pairwise-N-regions-removed"}, and \code{"pairwise-dense"}. Each space can be characterized by the extended CIGAR operations that are \emph{visible} in it. A CIGAR operation is said to be \emph{visible} in a given space if it "runs along it", that is, if it's associated with a block of contiguous positions in that space (the size of the block being the length of the operation). For example, the M/=/X operations are \emph{visible} in all spaces, the D/N operations are \emph{visible} in the \code{"reference"} space but not in the \code{"query"} space, the S operation is \emph{visible} in the \code{"query"} space but not in the \code{"reference"} or in the \code{"query-after-soft-clipping"} space, etc... Here are the extended CIGAR operations that are \emph{visible} in each space: \enumerate{ \item reference: M, D, N, =, X \item reference-N-regions-removed: M, D, =, X \item query: M, I, S, =, X \item query-before-hard-clipping: M, I, S, H, =, X \item query-after-soft-clipping: M, I, =, X \item pairwise: M, I, D, N, =, X \item pairwise-N-regions-removed: M, I, D, =, X \item pairwise-dense: M, =, X } \code{sequenceLayer} lays a string that belongs to one space alongside another by (1) removing the substrings associated with operations that are not \emph{visible} anymore in the new space, and (2) injecting substrings associated with operations that become \emph{visible} in the new space. Each injected substring has the length of the operation associated with it, and its content is controlled via the corresponding \code{*.letter} argument. For example, when going from the \code{"query"} space to the \code{"reference"} space (the default), the I- and S-substrings (i.e. the substrings associated with I/S operations) are removed, and substrings associated with D/N operations are injected. More precisely, the D-substrings are filled with the letter specified in \code{D.letter}, and the N-substrings with the letter specified in \code{N.letter}. The other \code{*.letter} arguments are ignored in that case. } \value{ An \link{XStringSet} object of the same class and length as \code{x}. } \author{H. Pages} \seealso{ \itemize{ \item The \code{\link{stackStringsFromBam}} function for stacking the read sequences (or their quality strings) stored in a BAM file on a region of interest. \item The \code{\link{readGAlignments}} function for loading read sequences from a BAM file (via a \link{GAlignments} object). \item The \code{\link[Biostrings]{extractAt}} and \code{\link[Biostrings]{replaceAt}} functions in the \pkg{Biostrings} package for extracting/replacing arbitrary substrings from/in a string or set of strings. \item \link{cigar-utils} for the CIGAR utility functions used internally by \code{sequenceLayer}. } } \examples{ ## --------------------------------------------------------------------- ## A. FROM "query" TO "reference" SPACE ## --------------------------------------------------------------------- ## Load read sequences from a BAM file (they will be returned in a ## GAlignments object): bamfile <- system.file("extdata", "ex1.bam", package="Rsamtools") param <- ScanBamParam(what="seq") gal <- readGAlignments(bamfile, param=param) qseq <- mcols(gal)$seq # the read sequences (aka query sequences) ## Lay the query sequences alongside the reference space. This will ## remove the substrings associated with insertions to the reference ## (I operations) and soft clipping (S operations), and will inject new ## substrings (filled with "-") where deletions from the reference (D ## operations) and skipped regions from the reference (N operations) ## occurred during the alignment process: qseq_on_ref <- sequenceLayer(qseq, cigar(gal)) ## A typical use case for doing the above is to compute 1 consensus ## sequence per chromosome. The code below shows how this can be done ## in 2 extra steps. ## Step 1: Compute one consensus matrix per chromosome. qseq_on_ref_by_chrom <- splitAsList(qseq_on_ref, seqnames(gal)) pos_by_chrom <- splitAsList(start(gal), seqnames(gal)) cm_by_chrom <- lapply(names(pos_by_chrom), function(seqname) consensusMatrix(qseq_on_ref_by_chrom[[seqname]], as.prob=TRUE, shift=pos_by_chrom[[seqname]]-1, width=seqlengths(gal)[[seqname]])) names(cm_by_chrom) <- names(pos_by_chrom) ## 'cm_by_chrom' is a list of consensus matrices. Each matrix has 17 ## rows (1 per letter in the DNA alphabet) and 1 column per chromosome ## position. ## Step 2: Compute the consensus string from each consensus matrix. ## We'll put "+" in the strings wherever there is no coverage for that ## position, and "N" where there is coverage but no consensus. cs_by_chrom <- lapply(cm_by_chrom, function(cm) { ## Because consensusString() doesn't like consensus matrices ## with columns that contain only zeroes (and you will have ## columns like that for chromosome positions that don't ## receive any coverage), we need to "fix" 'cm' first. idx <- colSums(cm) == 0 cm["+", idx] <- 1 DNAString(consensusString(cm, ambiguityMap="N")) }) ## consensusString() provides some flexibility to let you extract ## the consensus in different ways. See '?consensusString' in the ## Biostrings package for the details. ## Finally, note that the read quality strings can also be used as ## input for sequenceLayer(): param <- ScanBamParam(what="qual") gal <- readGAlignments(bamfile, param=param) qual <- mcols(gal)$qual # the read quality strings qual_on_ref <- sequenceLayer(qual, cigar(gal)) ## Note that since the "-" letter is a valid quality code, there is ## no way to distinguish it from the "-" letters inserted by ## sequenceLayer(). ## --------------------------------------------------------------------- ## B. FROM "query" TO "query-after-soft-clipping" SPACE ## --------------------------------------------------------------------- ## Going from "query" to "query-after-soft-clipping" simply removes ## the substrings associated with soft clipping (S operations): qseq <- DNAStringSet(c("AAAGTTCGAA", "TTACGATTAN", "GGATAATTTT")) cigar <- c("3H10M", "2S7M1S2H", "2M1I1M3D2M4S") clipped_qseq <- sequenceLayer(qseq, cigar, from="query", to="query-after-soft-clipping") sequenceLayer(clipped_qseq, cigar, from="query-after-soft-clipping", to="query") sequenceLayer(clipped_qseq, cigar, from="query-after-soft-clipping", to="query", S.letter="-") ## --------------------------------------------------------------------- ## C. BRING QUERY AND REFERENCE SEQUENCES TO THE "pairwise" or ## "pairwise-dense" SPACE ## --------------------------------------------------------------------- ## Load read sequences from a BAM file: library(RNAseqData.HNRNPC.bam.chr14) bamfile <- RNAseqData.HNRNPC.bam.chr14_BAMFILES[1] param <- ScanBamParam(what="seq", which=GRanges("chr14", IRanges(1, 25000000))) gal <- readGAlignments(bamfile, param=param) qseq <- mcols(gal)$seq # the read sequences (aka query sequences) ## Load the corresponding reference sequences from the appropriate ## BSgenome package (the reads in RNAseqData.HNRNPC.bam.chr14 were ## aligned to hg19): library(BSgenome.Hsapiens.UCSC.hg19) rseq <- getSeq(Hsapiens, as(gal, "GRanges")) # the reference sequences ## Bring 'qseq' and 'rseq' to the "pairwise" space. ## For 'qseq', this will remove the substrings associated with soft ## clipping (S operations) and inject substrings (filled with "-") ## associated with deletions from the reference (D operations) and ## skipped regions from the reference (N operations). For 'rseq', this ## will inject substrings (filled with "-") associated with insertions ## to the reference (I operations). qseq2 <- sequenceLayer(qseq, cigar(gal), from="query", to="pairwise") rseq2 <- sequenceLayer(rseq, cigar(gal), from="reference", to="pairwise") ## Sanity check: 'qseq2' and 'rseq2' should have the same shape. stopifnot(identical(elementLengths(qseq2), elementLengths(rseq2))) ## A closer look at reads with insertions and deletions: cigar_op_table <- cigarOpTable(cigar(gal)) head(cigar_op_table) I_idx <- which(cigar_op_table[ , "I"] >= 2) # at least 2 insertions qseq2[I_idx] rseq2[I_idx] D_idx <- which(cigar_op_table[ , "D"] >= 2) # at least 2 deletions qseq2[D_idx] rseq2[D_idx] ## A closer look at reads with skipped regions: N_idx <- which(cigar_op_table[ , "N"] != 0) qseq2[N_idx] rseq2[N_idx] ## A variant of the "pairwise" space is the "pairwise-dense" space. ## In that space, all indels and skipped regions are removed from 'qseq' ## and 'rseq'. qseq3 <- sequenceLayer(qseq, cigar(gal), from="query", to="pairwise-dense") rseq3 <- sequenceLayer(rseq, cigar(gal), from="reference", to="pairwise-dense") ## Sanity check: 'qseq3' and 'rseq3' should have the same shape. stopifnot(identical(elementLengths(qseq3), elementLengths(rseq3))) ## Insertions were removed: qseq3[I_idx] rseq3[I_idx] ## Deletions were removed: qseq3[D_idx] rseq3[D_idx] ## Skipped regions were removed: qseq3[N_idx] rseq3[N_idx] ## --------------------------------------------------------------------- ## D. SANITY CHECKS ## --------------------------------------------------------------------- SPACES <- c("reference", "reference-N-regions-removed", "query", "query-before-hard-clipping", "query-after-soft-clipping", "pairwise", "pairwise-N-regions-removed", "pairwise-dense") cigarWidth <- list( function(cigar) cigarWidthAlongReferenceSpace(cigar), function(cigar) cigarWidthAlongReferenceSpace(cigar, N.regions.removed=TRUE), function(cigar) cigarWidthAlongQuerySpace(cigar), function(cigar) cigarWidthAlongQuerySpace(cigar, before.hard.clipping=TRUE), function(cigar) cigarWidthAlongQuerySpace(cigar, after.soft.clipping=TRUE), function(cigar) cigarWidthAlongPairwiseSpace(cigar), function(cigar) cigarWidthAlongPairwiseSpace(cigar, N.regions.removed=TRUE), function(cigar) cigarWidthAlongPairwiseSpace(cigar, dense=TRUE) ) cigar <- c("3H2S4M1D2M2I1M5N3M6H", "5M1I3M2D4M2S") seq <- list( BStringSet(c(A="AAAA-BBC.....DDD", B="AAAAABBB--CCCC")), BStringSet(c(A="AAAA-BBCDDD", B="AAAAABBB--CCCC")), BStringSet(c(A="++AAAABBiiCDDD", B="AAAAAiBBBCCCC++")), BStringSet(c(A="+++++AAAABBiiCDDD++++++", B="AAAAAiBBBCCCC++")), BStringSet(c(A="AAAABBiiCDDD", B="AAAAAiBBBCCCC")), BStringSet(c(A="AAAA-BBiiC.....DDD", B="AAAAAiBBB--CCCC")), BStringSet(c(A="AAAA-BBiiCDDD", B="AAAAAiBBB--CCCC")), BStringSet(c(A="AAAABBCDDD", B="AAAAABBBCCCC")) ) stopifnot(all(sapply(1:8, function(i) identical(width(seq[[i]]), cigarWidth[[i]](cigar)) ))) sequenceLayer2 <- function(x, cigar, from, to) sequenceLayer(x, cigar, from=from, to=to, I.letter="i") identical_XStringSet <- function(target, current) { ok1 <- identical(class(target), class(current)) ok2 <- identical(names(target), names(current)) ok3 <- all(target == current) ok1 && ok2 && ok3 } res <- sapply(1:8, function(i) { sapply(1:8, function(j) { target <- seq[[j]] current <- sequenceLayer2(seq[[i]], cigar, from=SPACES[i], to=SPACES[j]) identical_XStringSet(target, current) }) }) stopifnot(all(res)) } \keyword{methods} \keyword{manip} GenomicAlignments/man/setops-methods.Rd0000644000175100017510000000272712607264575021243 0ustar00biocbuildbiocbuild\name{setops-methods} \alias{setops-methods} \alias{pintersect} \alias{pintersect,GAlignments,GRanges-method} \alias{pintersect,GRanges,GAlignments-method} \title{Set operations on GAlignments objects} \description{ Performs set operations on \link{GAlignments} objects. NOTE: The \code{\link[IRanges]{pintersect}} generic function and method for \link[IRanges]{Ranges} objects is defined and documented in the \pkg{IRanges} package. Methods for \link[GenomicRanges]{GRanges} and \link[GenomicRanges]{GRangesList} objects are defined and documented in the \pkg{GenomicRanges} package. } \usage{ \S4method{pintersect}{GAlignments,GRanges}(x, y, ...) \S4method{pintersect}{GRanges,GAlignments}(x, y, ...) } \arguments{ \item{x, y}{ A \link{GAlignments} object and a \link[GenomicRanges]{GRanges} object. They must have the same length. } \item{...}{ Further arguments to be passed to or from other methods. } } \value{ A \link{GAlignments} object \emph{parallel} to (i.e. same length as) \code{x} and \code{y}. } \seealso{ \itemize{ \item The \link{GAlignments} class. \item The \link[GenomicRanges]{setops-methods} man page in the \pkg{GenomicRanges} package. } } \examples{ ## Parallel intersection of a GAlignments and a GRanges object: bamfile <- system.file("extdata", "ex1.bam", package="Rsamtools") gal <- readGAlignments(bamfile) pintersect(gal, shift(as(gal, "GRanges"), 6L)) } \keyword{methods} \keyword{utilities} GenomicAlignments/man/stackStringsFromBam.Rd0000644000175100017510000002131712607264575022204 0ustar00biocbuildbiocbuild\name{stackStringsFromBam} \alias{stackStringsFromBam} \alias{alphabetFrequencyFromBam} \title{Stack the read sequences stored in a BAM file on a region of interest} \description{ \code{stackStringsFromBam} stacks the read sequences (or their quality strings) stored in a BAM file over a user-specified region. \code{alphabetFrequencyFromBam} computes the alphabet frequency of the reads over a user-specified region. Both functions take into account the CIGAR of each read to "lay" the read sequence (or its quality string) alongside the reference space. This step ensures that each nucleotide in a read is associated with the correct position on the reference sequence. } \usage{ stackStringsFromBam(file, index=file, param, what="seq", use.names=FALSE, D.letter="-", N.letter=".", Lpadding.letter="+", Rpadding.letter="+") alphabetFrequencyFromBam(file, index=file, param, what="seq", ...) } \arguments{ \item{file, index}{ The path to the BAM file to read, and to the index file of the BAM file to read, respectively. The latter is given \emph{without} the '.bai' extension. See \code{\link{scanBam}} for more information. } \item{param}{ A \link{ScanBamParam} object containing exactly 1 genomic region (i.e. \code{unlist(bamWhich(param))} must have length 1). Alternatively, \code{param} can be a \link[GenomicRanges]{GRanges} or \link[IRanges]{RangesList} object containing exactly 1 genomic region (the strand will be ignored in case of a \link[GenomicRanges]{GRanges} object), or a character string specifying a single genomic region (in the \code{"chr14:5201-5300"} format). } \item{what}{ A single string. Either \code{"seq"} or \code{"qual"}. If \code{"seq"} (the default), the read sequences will be stacked. If \code{"qual"}, the read quality strings will be stacked. } \item{use.names}{ Use the query template names (QNAME field) as the names of the returned object? If not (the default), then the returned object has no names. } \item{D.letter, N.letter}{ A single letter used as a filler for injections. The 2 arguments are passed down to the \code{\link{sequenceLayer}} function. See \code{?\link{sequenceLayer}} for more details. } \item{Lpadding.letter, Rpadding.letter}{ A single letter to use for padding the sequences on the left, and another one to use for padding on the right. The 2 arguments are passed down to the \code{\link[Biostrings]{stackStrings}} function defined in the \pkg{Biostrings} package. See \code{?\link[Biostrings]{stackStrings}} in the \pkg{Biostrings} package for more details. } \item{...}{ Further arguments to be passed to \link[Biostrings]{alphabetFrequency}. } } \details{ \code{stackStringsFromBam} performs the 3 following steps: \enumerate{ \item Load the read sequences (or their quality strings) from the BAM file. Only the read sequences that overlap with the specified region are loaded. This is done with the \code{\link{readGAlignments}} function. Note that if the file contains paired-end reads, the pairing is ignored. \item Lay the sequences alongside the reference space, using their CIGARs. This is done with the \code{\link{sequenceLayer}} function. \item Stack them on the specified region. This is done with the \code{\link[Biostrings]{stackStrings}} function defined in the \pkg{Biostrings} package. } \code{alphabetFrequencyFromBam} also performs steps 1. and 2. but, instead of stacking the sequences at step 3., it computes the nucleotide frequencies for each genomic position in the specified region. } \value{ For \code{stackStringsFromBam}: A rectangular (i.e. constant-width) \link[Biostrings]{DNAStringSet} object (if \code{what} is \code{"seq"}) or \link[Biostrings]{BStringSet} object (if \code{what} is \code{"qual"}). For \code{alphabetFrequencyFromBam}: By default a matrix like one returned by \code{\link[Biostrings]{alphabetFrequency}}. The matrix has 1 row per nucleotide position in the specified region. } \note{ TWO IMPORTANT CAVEATS ABOUT \code{stackStringsFromBam}: Specifying a big genomic region, say >= 100000 bp, can require a lot of memory (especially with high coverage reads) and is not recommended. See the \code{\link{pileLettersAt}} function for piling the read letters on top of a set of individual genomic positions, which is more flexible and more memory efficient. Paired-end reads are treated as single-end reads (i.e. they're not paired). } \author{H. Pages} \seealso{ \itemize{ \item The \code{\link{pileLettersAt}} function for piling the letters of a set of aligned reads on top of a set of individual genomic positions. \item The \code{\link{readGAlignments}} function for loading read sequences (or their quality strings) from a BAM file (via a \link{GAlignments} object). \item The \code{\link{sequenceLayer}} function for laying read sequences alongside the reference space, using their CIGARs. \item The \code{\link[Biostrings]{stackStrings}} function in the \pkg{Biostrings} package for stacking an arbitrary \link[Biostrings]{XStringSet} object. \item The \code{\link[Biostrings]{alphabetFrequency}} function in the \pkg{Biostrings} package. \item The SAMtools mpileup command available at \url{http://samtools.sourceforge.net/} as part of the SAMtools project. } } \examples{ ## --------------------------------------------------------------------- ## A. EXAMPLE WITH TOY DATA ## --------------------------------------------------------------------- bamfile1 <- BamFile(system.file("extdata", "ex1.bam", package="Rsamtools")) region1 <- GRanges("seq1", IRanges(1, 60)) # region of interest ## Stack the read sequences: stackStringsFromBam(bamfile1, param=region1) ## Compute the "consensus matrix" (1 column per nucleotide position ## in the region of interest): af <- alphabetFrequencyFromBam(bamfile1, param=region1, baseOnly=TRUE) cm1a <- t(af[ , DNA_BASES]) cm1a ## Stack their quality strings: stackStringsFromBam(bamfile1, param=region1, what="qual") ## Control the number of reads to display: options(showHeadLines=18) options(showTailLines=6) stackStringsFromBam(bamfile1, param=GRanges("seq1", IRanges(61, 120))) stacked_qseq <- stackStringsFromBam(bamfile1, param="seq2:1509-1519") stacked_qseq # deletion in read 13 af <- alphabetFrequencyFromBam(bamfile1, param="seq2:1509-1519", baseOnly=TRUE) cm1b <- t(af[ , DNA_BASES]) # consensus matrix cm1b ## Sanity check: stopifnot(identical(consensusMatrix(stacked_qseq)[DNA_BASES, ], cm1b)) stackStringsFromBam(bamfile1, param="seq2:1509-1519", what="qual") ## --------------------------------------------------------------------- ## B. EXAMPLE WITH REAL DATA ## --------------------------------------------------------------------- library(RNAseqData.HNRNPC.bam.chr14) bamfile2 <- BamFile(RNAseqData.HNRNPC.bam.chr14_BAMFILES[1]) ## Region of interest: region2 <- GRanges("chr14", IRanges(19650095, 19650159)) readGAlignments(bamfile2, param=ScanBamParam(which=region2)) stackStringsFromBam(bamfile2, param=region2) af <- alphabetFrequencyFromBam(bamfile2, param=region2, baseOnly=TRUE) cm2 <- t(af[ , DNA_BASES]) # consensus matrix cm2 ## --------------------------------------------------------------------- ## C. COMPUTE READ CONSENSUS SEQUENCE FOR REGION OF INTEREST ## --------------------------------------------------------------------- ## Let's write our own little naive function to go from consensus matrix ## to consensus sequence. For each nucleotide position in the region of ## interest (i.e. each column in the matrix), we select the letter with ## highest frequency. We also use special letter "*" at positions where ## there is a tie, and special letter "." at positions where all the ## frequencies are 0 (a particular type of tie): cm_to_cs <- function(cm) { stopifnot(is.matrix(cm)) nr <- nrow(cm) rnames <- rownames(cm) stopifnot(!is.null(rnames) && all(nchar(rnames) == 1L)) selection <- apply(cm, 2, function(x) { i <- which.max(x) if (x[i] == 0L) return(nr + 1L) if (sum(x == x[i]) != 1L) return(nr + 2L) i }) paste0(c(rnames, ".", "*")[selection], collapse="") } cm_to_cs(cm1a) cm_to_cs(cm1b) cm_to_cs(cm2) ## Note that the consensus sequences we obtain are relative to the ## plus strand of the reference sequence. } \keyword{methods} \keyword{manip} GenomicAlignments/man/summarizeOverlaps-methods.Rd0000644000175100017510000006121712607264575023455 0ustar00biocbuildbiocbuild\name{summarizeOverlaps-methods} \alias{summarizeOverlaps-methods} \alias{summarizeOverlaps} \alias{summarizeOverlaps,GRanges,GAlignments-method} \alias{summarizeOverlaps,GRangesList,GAlignments-method} \alias{summarizeOverlaps,GRanges,GAlignmentsList-method} \alias{summarizeOverlaps,GRangesList,GAlignmentsList-method} \alias{summarizeOverlaps,GRanges,GAlignmentPairs-method} \alias{summarizeOverlaps,GRangesList,GAlignmentPairs-method} \alias{summarizeOverlaps,GRanges,GRanges-method} \alias{summarizeOverlaps,GRangesList,GRanges-method} \alias{summarizeOverlaps,GRanges,GRangesList-method} \alias{summarizeOverlaps,GRangesList,GRangesList-method} \alias{Union} \alias{IntersectionStrict} \alias{IntersectionNotEmpty} \alias{summarizeOverlaps,GRanges,BamFile-method} \alias{summarizeOverlaps,GRangesList,BamFile-method} \alias{summarizeOverlaps,GRanges,character-method} \alias{summarizeOverlaps,GRangesList,character-method} \alias{summarizeOverlaps,GRanges,BamFileList-method} \alias{summarizeOverlaps,GRangesList,BamFileList-method} \alias{summarizeOverlaps,BamViews,missing-method} \title{Perform overlap queries between reads and genomic features} \description{ \code{summarizeOverlaps} extends \code{findOverlaps} by providing options to resolve reads that overlap multiple features. } \usage{ \S4method{summarizeOverlaps}{GRanges,GAlignments}( features, reads, mode=Union, algorithm=c("nclist", "intervaltree"), ignore.strand=FALSE, inter.feature=TRUE, preprocess.reads=NULL, ...) \S4method{summarizeOverlaps}{GRangesList,GAlignments}( features, reads, mode=Union, algorithm=c("nclist", "intervaltree"), ignore.strand=FALSE, inter.feature=TRUE, preprocess.reads=NULL, ...) \S4method{summarizeOverlaps}{GRanges,GRanges}( features, reads, mode=Union, algorithm=c("nclist", "intervaltree"), ignore.strand=FALSE, inter.feature=TRUE, preprocess.reads=NULL, ...) \S4method{summarizeOverlaps}{GRangesList,GRanges}( features, reads, mode=Union, algorithm=c("nclist", "intervaltree"), ignore.strand=FALSE, inter.feature=TRUE, preprocess.reads=NULL, ...) \S4method{summarizeOverlaps}{GRanges,GAlignmentPairs}( features, reads, mode=Union, algorithm=c("nclist", "intervaltree"), ignore.strand=FALSE, inter.feature=TRUE, preprocess.reads=NULL, ...) \S4method{summarizeOverlaps}{GRangesList,GAlignmentPairs}( features, reads, mode=Union, algorithm=c("nclist", "intervaltree"), ignore.strand=FALSE, inter.feature=TRUE, preprocess.reads=NULL, ...) ## mode funtions Union(features, reads, algorithm=c("nclist", "intervaltree"), ignore.strand=FALSE, inter.feature=TRUE) IntersectionStrict(features, reads, algorithm=c("nclist", "intervaltree"), ignore.strand=FALSE, inter.feature=TRUE) IntersectionNotEmpty(features, reads, algorithm=c("nclist", "intervaltree"), ignore.strand=FALSE, inter.feature=TRUE) \S4method{summarizeOverlaps}{GRanges,BamFile}( features, reads, mode=Union, algorithm=c("nclist", "intervaltree"), ignore.strand=FALSE, inter.feature=TRUE, singleEnd=TRUE, fragments=FALSE, param=ScanBamParam(), preprocess.reads=NULL, ...) \S4method{summarizeOverlaps}{BamViews,missing}( features, reads, mode=Union, algorithm=c("nclist", "intervaltree"), ignore.strand=FALSE, inter.feature=TRUE, singleEnd=TRUE, fragments=FALSE, param=ScanBamParam(), preprocess.reads=NULL, ...) } \arguments{ \item{features}{ A \link[GenomicRanges]{GRanges} or a \link[GenomicRanges]{GRangesList} object of genomic regions of interest. When a \link[GenomicRanges]{GRanges} is supplied, each row is considered a feature. When a \link[GenomicRanges]{GRangesList} is supplied, each higher list-level is considered a feature. This distinction is important when defining overlaps. When \code{features} is a \link[Rsamtools]{BamViews} the \code{reads} argument is missing. Features are extracted from the \code{bamRanges} and the \code{reads} from \code{bamPaths}. Metadata from \code{bamPaths} and \code{bamSamples} are stored in the \code{colData} of the resulting \link[SummarizedExperiment]{RangedSummarizedExperiment} object. \code{bamExperiment} metadata are stored in the \code{metadata} slot. } \item{reads}{ A \link[GenomicRanges]{GRanges}, \link[GenomicRanges]{GRangesList} \link{GAlignments}, \link{GAlignmentsList}, \link{GAlignmentPairs}, \link[Rsamtools]{BamViews} or \link[Rsamtools]{BamFileList} object that represents the data to be counted by \code{summarizeOverlaps}. \code{reads} is missing when a \link[Rsamtools]{BamViews} object is the only argument supplied to \code{summarizeOverlaps}. \code{reads} are the files specified in \code{bamPaths} of the \link[Rsamtools]{BamViews} object. } \item{mode}{ \code{mode} can be one of the pre-defined count methods such as "Union", "IntersectionStrict", or "IntersectionNotEmpty" or it a user supplied count function. For a custom count function, the input arguments must match those of the pre-defined options and the function must return a vector of counts the same length as the annotation ('features' argument). See examples for details. The pre-defined options are designed after the counting modes available in the HTSeq package by Simon Anders (see references). \itemize{ \item "Union" : (Default) Reads that overlap any portion of exactly one feature are counted. Reads that overlap multiple features are discarded. This is the most conservative of the 3 modes. \item "IntersectionStrict" : A read must fall completely "within" the feature to be counted. If a read overlaps multiple features but falls "within" only one, the read is counted for that feature. If the read is "within" multiple features, the read is discarded. \item "IntersectionNotEmpty" : A read must fall in a unique disjoint region of a feature to be counted. When a read overlaps multiple features, the features are partitioned into disjoint intervals. Regions that are shared between the features are discarded leaving only the unique disjoint regions. If the read overlaps one of these remaining regions, it is assigned to the feature the unique disjoint region came from. \item user supplied function : A function can be supplied as the \code{mode} argument. It must (1) have arguments that correspond to \code{features}, \code{reads}, \code{ignore.strand} and \code{inter.feature} arguments (as in the defined mode functions) and (2) return a vector of counts the same length as \code{features}. } } \item{algorithm}{ This argument is passed to \code{\link{findOverlaps}}, which the mode functions use internally. See \code{?\link{findOverlaps}} for more information. Note that it will be removed in BioC 3.3 so please don't use it unless you have a good reason to do so (e.g. troubleshooting). } \item{ignore.strand}{ A logical indicating if strand should be considered when matching. } \item{inter.feature}{ (Default TRUE) A logical indicating if the counting \code{mode} should be aware of overlapping features. When TRUE (default), reads mapping to multiple features are dropped (i.e., not counted). When FALSE, these reads are retained and a count is assigned to each feature they map to. There are 6 possible combinations of the \code{mode} and \code{inter.feature} arguments. When \code{inter.feature=FALSE} the behavior of modes \sQuote{Union} and \sQuote{IntersectionStrict} are essentially \sQuote{countOverlaps} with \sQuote{type=any} and \code{type=within}, respectively. \sQuote{IntersectionNotEmpty} does not reduce to a simple countOverlaps because common (shared) regions of the annotation are removed before counting. } \item{preprocess.reads}{ A function applied to the reads before counting. The first argument should be \code{reads} and the return value should be an object compatible with the \code{reads} argument to the counting modes, Union, IntersectionStrict and IntersectionNotEmpty. The distinction between a user-defined 'mode' and user-defined 'preprocess.reads' function is that in the first case the user defines how to count; in the second case the reads are preprocessed before counting with a pre-defined mode. See examples. } \item{...}{ Additional arguments passed to functions or methods called from within \code{summarizeOverlaps}. For BAM file methods arguments may include \code{singleEnd}, \code{fragments} or \code{param} which apply to reading records from a file (see below). Providing \code{count.mapped.reads=TRUE} include additional passes through the BAM file to collect statistics similar to those from \code{countBam}. } \item{singleEnd}{ (Default TRUE) A logical indicating if reads are single or paired-end. In Bioconductor > 2.12 it is not necessary to sort paired-end BAM files by \code{qname}. When counting with \code{summarizeOverlaps}, setting \code{singleEnd=FALSE} will trigger paired-end reading and counting. It is fine to also set \code{asMates=TRUE} in the \code{BamFile} but is not necessary when \code{singleEnd=FALSE}. } \item{fragments}{ (Default FALSE) A logical; applied to paired-end data only. \code{fragments} controls which function is used to read the data which subsequently affects which records are included in counting. When \code{fragments=FALSE}, data are read with \code{\link{readGAlignmentPairs}} and returned in a \code{GAlignmentPairs} class. This class only holds \sQuote{mated pairs} from opposite strands; same-strand pairs singletons, reads with unmapped pairs and other fragments are dropped. When \code{fragments=TRUE}, data are read with \code{\link{readGAlignmentsList}} and returned in a \code{GAlignmentsList} class. This class holds \sQuote{mated pairs} as well as same-strand pairs, singletons, reads with unmapped pairs and other fragments. Because more records are kept, generally counts will be higher when \code{fragments=TRUE}. The term \sQuote{mated pairs} refers to records paired with the algorithm described on the \code{?\link{readGAlignmentsList}} man page. } \item{param}{An optional \code{\link[Rsamtools]{ScanBamParam}} instance to further influence scanning, counting, or filtering. See \code{?\link{BamFile}} for details of how records are returned when both \code{yieldSize} is specified in a \code{\link{BamFile}} and \code{which} is defined in a \code{\link{ScanBamParam}}. } } \details{ \describe{ \item{}{\code{summarizeOverlaps} offers counting modes to resolve reads that overlap multiple features. The \code{mode} argument defines a set of rules to resolve the read to a single feature such that each read is counted a maximum of once. New to GenomicRanges >= 1.13.9 is the \code{inter.feature} argument which allows reads to be counted for each feature they overlap. When \code{inter.feature=TRUE} the counting modes are aware of feature overlap; reads that overlap multiple features are dropped and not counted. When \code{inter.feature=FALSE} multiple feature overlap is ignored and reads are counted once for each feature they map to. This essentially reduces modes \sQuote{Union} and \sQuote{IntersectionStrict} to \code{countOverlaps} with \code{type="any"}, and \code{type="within"}, respectively. \sQuote{IntersectionNotEmpty} is not reduced to a derivative of \code{countOverlaps} because the shared regions are removed before counting. The \code{BamViews}, \code{BamFile} and \code{BamFileList} methods summarize overlaps across one or several files. The latter uses \code{bplapply}; control parallel evaluation using the \code{\link{register}} interface in the \pkg{BiocParallel} package. } \item{features :}{ A \sQuote{feature} can be any portion of a genomic region such as a gene, transcript, exon etc. When the \code{features} argument is a \link[GenomicRanges]{GRanges} the rows define the features. The result will be the same length as the \link[GenomicRanges]{GRanges}. When \code{features} is a \link[GenomicRanges]{GRangesList} the highest list-level defines the features and the result will be the same length as the \link[GenomicRanges]{GRangesList}. When \code{inter.feature=TRUE}, each count \code{mode} attempts to assign a read that overlaps multiple features to a single feature. If there are ranges that should be considered together (e.g., exons by transcript or cds regions by gene) the \link[GenomicRanges]{GRangesList} would be appropriate. If there is no grouping in the data then a \link[GenomicRanges]{GRanges} would be appropriate. } \item{paired-end reads :}{ Paired-end reads are counted as a single hit if one or both parts of the pair are overlapped. Paired-end records can be counted in a \link{GAlignmentPairs} container or BAM file. Counting pairs in BAM files: \itemize{ \item{The \code{singleEnd} argument should be FALSE.} \item{When \code{reads} are supplied as a BamFile or BamFileList, the \code{asMates} argument to the BamFile should be TRUE.} \item{When \code{fragments} is FALSE, a \code{GAlignmentPairs} object is used in counting (pairs only).} \item{When \code{fragments} is TRUE, a \code{GAlignmentsList} object is used in counting (pairs, singletons, unmapped mates, etc.)} } } } } \value{ A \link[SummarizedExperiment]{RangedSummarizedExperiment} object. The \code{assays} slot holds the counts, \code{rowRanges} holds the annotation from \code{features}. When \code{reads} is a \code{BamFile} or \code{BamFileList} \code{colData} is an empty DataFrame with a single row named \sQuote{counts}. If \code{count.mapped.reads=TRUE}, \code{colData} holds the output of \code{countBam} in 3 columns named \sQuote{records} (total records), \sQuote{nucleotides} and \sQuote{mapped} (mapped records). When \code{features} is a \code{BamViews} \code{colData} includes 2 columns named \code{bamSamples} and \code{bamIndices}. In all other cases, \code{colData} has columns of \sQuote{object} (class of reads) and \sQuote{records} (length of \code{reads}). } \references{ HTSeq : \url{http://www-huber.embl.de/users/anders/HTSeq/doc/overview.html} htseq-count : \url{http://www-huber.embl.de/users/anders/HTSeq/doc/count.html} } \author{Valerie Obenchain } \seealso{ \itemize{ \item The \pkg{DESeq}, \pkg{DEXSeq} and \pkg{edgeR} packages. \item The \link[SummarizedExperiment]{RangedSummarizedExperiment} class defined in the \pkg{SummarizedExperiment} package. \item The \link{GAlignments} and \link{GAlignmentPairs} classes. \item The \link[Rsamtools]{BamFileList} and \link[Rsamtools]{BamViews} classes in the \pkg{Rsamtools} package. \item The \link{readGAlignments} and \link{readGAlignmentPairs} functions. } } \examples{ reads <- GAlignments( names = c("a","b","c","d","e","f","g"), seqnames = Rle(c(rep(c("chr1", "chr2"), 3), "chr1")), pos = as.integer(c(1400, 2700, 3400, 7100, 4000, 3100, 5200)), cigar = c("500M", "100M", "300M", "500M", "300M", "50M200N50M", "50M150N50M"), strand = strand(rep("+", 7))) gr <- GRanges( seqnames = c(rep("chr1", 7), rep("chr2", 4)), strand = "+", ranges = IRanges(c(1000, 3000, 3600, 4000, 4000, 5000, 5400, 2000, 3000, 7000, 7500), width = c(500, 500, 300, 500, 900, 500, 500, 900, 500, 600, 300), names=c("A", "B", "C1", "C2", "D1", "D2", "E", "F", "G", "H1", "H2"))) groups <- factor(c(1,2,3,3,4,4,5,6,7,8,8)) grl <- splitAsList(gr, groups) names(grl) <- LETTERS[seq_along(grl)] ## --------------------------------------------------------------------- ## Counting modes. ## --------------------------------------------------------------------- ## First count with a GRanges as the 'features'. 'Union' is the ## most conservative counting mode followed by 'IntersectionStrict' ## then 'IntersectionNotEmpty'. counts1 <- data.frame(union=assays(summarizeOverlaps(gr, reads))$counts, intStrict=assays(summarizeOverlaps(gr, reads, mode="IntersectionStrict"))$counts, intNotEmpty=assays(summarizeOverlaps(gr, reads, mode="IntersectionNotEmpty"))$counts) colSums(counts1) ## Split the 'features' into a GRangesList and count again. counts2 <- data.frame(union=assays(summarizeOverlaps(grl, reads))$counts, intStrict=assays(summarizeOverlaps(grl, reads, mode="IntersectionStrict"))$counts, intNotEmpty=assays(summarizeOverlaps(grl, reads, mode="IntersectionNotEmpty"))$counts) colSums(counts2) ## The GRangesList ('grl' object) has 8 features whereas the GRanges ## ('gr' object) has 11. The affect on counting can be seen by looking ## at feature 'H' with mode 'Union'. In the GRanges this feature is ## represented by ranges 'H1' and 'H2', gr[c("H1", "H2")] ## and by list element 'H' in the GRangesList, grl["H"] ## Read "d" hits both 'H1' and 'H2'. This is considered a multi-hit when ## using a GRanges (each range is a separate feature) so the read was ## dropped and not counted. counts1[c("H1", "H2"), ] ## When using a GRangesList, each list element is considered a feature. ## The read hits multiple ranges within list element 'H' but only one ## list element. This is not considered a multi-hit so the read is counted. counts2["H", ] ## --------------------------------------------------------------------- ## Counting multi-hit reads. ## --------------------------------------------------------------------- ## The goal of the counting modes is to provide a set of rules that ## resolve reads hitting multiple features so each read is counted ## a maximum of once. However, sometimes it may be desirable to count ## a read for each feature it overlaps. This can be accomplished by ## setting 'inter.feature' to FALSE. ## When 'inter.feature=FALSE', modes 'Union' and 'IntersectionStrict' ## essentially reduce to countOverlaps() with type="any" and ## type="within", respectively. ## When 'inter.feature=TRUE' only features "A", "F" and "G" have counts. se1 <- summarizeOverlaps(gr, reads, mode="Union", inter.feature=TRUE) assays(se1)$counts ## When 'inter.feature=FALSE' all 11 features have a count. There are ## 7 total reads so one or more reads were counted more than once. se2 <- summarizeOverlaps(gr, reads, mode="Union", inter.feature=FALSE) assays(se2)$counts ## --------------------------------------------------------------------- ## Counting BAM files. ## --------------------------------------------------------------------- library(pasillaBamSubset) library(TxDb.Dmelanogaster.UCSC.dm3.ensGene) exbygene <- exonsBy(TxDb.Dmelanogaster.UCSC.dm3.ensGene, "gene") ## (i) Single-end : ## Large files can be iterated over in chunks by setting a ## 'yieldSize' on the BamFile. bf_s <- BamFile(untreated1_chr4(), yieldSize=50000) se_s <- summarizeOverlaps(exbygene, bf_s, singleEnd=TRUE) table(assays(se_s)$counts > 0) ## When a character (file name) is provided as 'reads' instead ## of a BamFile object summarizeOverlaps() will create a BamFile ## and set a reasonable default 'yieldSize'. ## (ii) Paired-end : ## A paired-end file may contain singletons, reads with unmapped ## pairs or reads with more than two fragments. When 'fragments=FALSE' ## only reads paired by the algorithm are included in the counting. nofrag <- summarizeOverlaps(exbygene, untreated3_chr4(), singleEnd=FALSE, fragments=FALSE) table(assays(nofrag)$counts > 0) ## When 'fragments=TRUE' all singletons, reads with unmapped pairs ## and other fragments will be included in the counting. bf <- BamFile(untreated3_chr4(), asMates=TRUE) frag <- summarizeOverlaps(exbygene, bf, singleEnd=FALSE, fragments=TRUE) table(assays(frag)$counts > 0) ## As expected, using 'fragments=TRUE' results in a larger number ## of total counts because singletons, unmapped pairs etc. are ## included in the counting. ## Total reads in the file: countBam(untreated3_chr4()) ## Reads counted with 'fragments=FALSE': sum(assays(nofrag)$counts) ## Reads counted with 'fragments=TRUE': sum(assays(frag)$counts) ## --------------------------------------------------------------------- ## Count tables for DESeq or edgeR. ## --------------------------------------------------------------------- fls <- list.files(system.file("extdata", package="GenomicAlignments"), recursive=TRUE, pattern="*bam$", full=TRUE) names(fls) <- basename(fls) bf <- BamFileList(fls, index=character(), yieldSize=1000) genes <- GRanges( seqnames = c(rep("chr2L", 4), rep("chr2R", 5), rep("chr3L", 2)), ranges = IRanges(c(1000, 3000, 4000, 7000, 2000, 3000, 3600, 4000, 7500, 5000, 5400), width=c(rep(500, 3), 600, 900, 500, 300, 900, 300, 500, 500))) se <- summarizeOverlaps(genes, bf) ## When the reads are BAM files, the 'colData' contains summary ## information from a call to countBam(). colData(se) ## Create count tables. library(DESeq) deseq <- newCountDataSet(assays(se)$counts, rownames(colData(se))) library(edgeR) edger <- DGEList(assays(se)$counts, group=rownames(colData(se))) ## --------------------------------------------------------------------- ## Filter records by map quality before counting. ## (user-supplied 'mode' function) ## --------------------------------------------------------------------- ## The 'mode' argument can take a custom count function whose ## arguments are the same as those in the current counting modes ## (i.e., Union, IntersectionNotEmpty, IntersectionStrict). ## In this example records are filtered by map quality before counting. mapq_filter <- function(features, reads, algorithm, ignore.strand, inter.feature) { require(GenomicAlignments) # needed for parallel evaluation Union(features, reads[mcols(reads)$mapq >= 20], algorithm, ignore.strand, inter.feature) } genes <- GRanges("seq1", IRanges(seq(1, 1500, by=200), width=100)) param <- ScanBamParam(what="mapq") fl <- system.file("extdata", "ex1.bam", package="Rsamtools") se <- summarizeOverlaps(genes, fl, mode=mapq_filter, param=param) assays(se)$counts ## The count function can be completely custom (i.e., not use the ## pre-defined count functions at all). Requirements are that ## the input arguments match the pre-defined modes and the output ## is a vector of counts the same length as 'features'. my_count <- function(features, reads, ignore.strand, inter.feature) { ## perform filtering, or subsetting etc. require(GenomicAlignments) # needed for parallel evaluation countOverlaps(features, reads) } ## --------------------------------------------------------------------- ## Preprocessing reads before counting with a standard count mode. ## (user-supplied 'preprocess.reads' function) ## --------------------------------------------------------------------- ## The 'preprocess.reads' argument takes a function that is ## applied to the reads before counting with a pre-defined mode. ResizeReads <- function(reads, width=1, fix="start", ...) { reads <- as(reads, "GRanges") stopifnot(all(strand(reads) != "*")) resize(reads, width=width, fix=fix, ...) } ## By default ResizeReads() counts reads that overlap on the 5' end: summarizeOverlaps(grl, reads, mode=Union, preprocess.reads=ResizeReads) ## Count reads that overlap on the 3' end by passing new values ## for 'width' and 'fix': summarizeOverlaps(grl, reads, mode=Union, preprocess.reads=ResizeReads, width=1, fix="end") ## --------------------------------------------------------------------- ## summarizeOverlaps() with BamViews. ## --------------------------------------------------------------------- ## bamSamples and bamPaths metadata are included in the colData. ## bamExperiment metadata is put into the metadata slot. fl <- system.file("extdata", "ex1.bam", package="Rsamtools", mustWork=TRUE) rngs <- GRanges(c("seq1", "seq2"), IRanges(1, c(1575, 1584))) samp <- DataFrame(info="test", row.names="ex1") view <- BamViews(fl, bamSamples=samp, bamRanges=rngs) se <- summarizeOverlaps(view, mode=Union, ignore.strand=TRUE) colData(se) metadata(se) } \keyword{methods} \keyword{utilities} GenomicAlignments/src/0000755000175100017510000000000012612051202015753 5ustar00biocbuildbiocbuildGenomicAlignments/src/GenomicAlignments.h0000644000175100017510000000335512612051202021535 0ustar00biocbuildbiocbuild#include /* cigar_utils.c */ const char *_get_cigar_parsing_error(); int _next_cigar_OP( const char *cigar_string, int offset, char *OP, int *OPL ); SEXP valid_cigar( SEXP cigar, SEXP ans_type ); SEXP explode_cigar_ops( SEXP cigar, SEXP ops ); SEXP explode_cigar_op_lengths( SEXP cigar, SEXP ops ); SEXP cigar_op_table(SEXP cigar); SEXP cigar_ranges( SEXP cigar, SEXP flag, SEXP space, SEXP pos, SEXP f, SEXP ops, SEXP drop_empty_ranges, SEXP reduce_ranges, SEXP with_ops ); SEXP cigar_width( SEXP cigar, SEXP flag, SEXP space ); SEXP cigar_narrow( SEXP cigar, SEXP left_width, SEXP right_width ); SEXP cigar_qnarrow( SEXP cigar, SEXP left_qwidth, SEXP right_qwidth ); /* coordinate_mapping_methods.c */ SEXP map_query_locs_to_ref_locs( SEXP start, SEXP end, SEXP cigar, SEXP pos ); SEXP map_ref_locs_to_query_locs( SEXP start, SEXP end, SEXP cigar, SEXP pos ); SEXP ref_locs_to_query_locs( SEXP ref_locs, SEXP cigar, SEXP pos, SEXP narrow_left ); SEXP query_locs_to_ref_locs( SEXP query_locs, SEXP cigar, SEXP pos, SEXP narrow_left ); /* encodeOverlaps_methods.c */ SEXP encode_overlaps1( SEXP query_start, SEXP query_width, SEXP query_space, SEXP query_break, SEXP flip_query, SEXP subject_start, SEXP subject_width, SEXP subject_space, SEXP as_matrix, SEXP as_raw ); SEXP RangesList_encode_overlaps( SEXP query_starts, SEXP query_widths, SEXP query_spaces, SEXP query_breaks, SEXP subject_starts, SEXP subject_widths, SEXP subject_spaces ); SEXP Hits_encode_overlaps( SEXP query_starts, SEXP query_widths, SEXP query_spaces, SEXP query_breaks, SEXP subject_starts, SEXP subject_widths, SEXP subject_spaces, SEXP query_hits, SEXP subject_hits, SEXP flip_query ); GenomicAlignments/src/IRanges_stubs.c0000644000175100017510000000003412612051202020664 0ustar00biocbuildbiocbuild#include "_IRanges_stubs.c" GenomicAlignments/src/R_init_GenomicAlignments.c0000644000175100017510000000221412612051202023025 0ustar00biocbuildbiocbuild#include "GenomicAlignments.h" #include #define CALLMETHOD_DEF(fun, numArgs) {#fun, (DL_FUNC) &fun, numArgs} #define REGISTER_CCALLABLE(fun) \ R_RegisterCCallable("GenomicAlignments", #fun, (DL_FUNC) &fun) static const R_CallMethodDef callMethods[] = { /* cigar_utils.c */ CALLMETHOD_DEF(valid_cigar, 2), CALLMETHOD_DEF(explode_cigar_ops, 2), CALLMETHOD_DEF(explode_cigar_op_lengths, 2), CALLMETHOD_DEF(cigar_op_table, 1), CALLMETHOD_DEF(cigar_ranges, 9), CALLMETHOD_DEF(cigar_width, 3), CALLMETHOD_DEF(cigar_narrow, 3), CALLMETHOD_DEF(cigar_qnarrow, 3), /* mapping_methods.c */ CALLMETHOD_DEF(map_query_locs_to_ref_locs, 4), CALLMETHOD_DEF(map_ref_locs_to_query_locs, 4), CALLMETHOD_DEF(ref_locs_to_query_locs, 4), CALLMETHOD_DEF(query_locs_to_ref_locs, 4), /* encodeOverlaps_methods.c */ CALLMETHOD_DEF(encode_overlaps1, 10), CALLMETHOD_DEF(RangesList_encode_overlaps, 7), CALLMETHOD_DEF(Hits_encode_overlaps, 10), {NULL, NULL, 0} }; void R_init_GenomicAlignments(DllInfo *info) { R_registerRoutines(info, NULL, callMethods, NULL, NULL); /* cigar_utils.c */ REGISTER_CCALLABLE(_next_cigar_OP); return; } GenomicAlignments/src/S4Vectors_stubs.c0000644000175100017510000000003612612051202021172 0ustar00biocbuildbiocbuild#include "_S4Vectors_stubs.c" GenomicAlignments/src/cigar_utils.c0000644000175100017510000007500112612051202020427 0ustar00biocbuildbiocbuild#include "GenomicAlignments.h" #include "IRanges_interface.h" #include "S4Vectors_interface.h" #include /* for isdigit() */ /* The 8 supported spaces. */ #define REFERENCE 1 #define REFERENCE_N_REGIONS_REMOVED 2 #define QUERY 3 #define QUERY_BEFORE_HARD_CLIPPING 4 #define QUERY_AFTER_SOFT_CLIPPING 5 #define PAIRWISE 6 #define PAIRWISE_N_REGIONS_REMOVED 7 #define PAIRWISE_DENSE 8 static char errmsg_buf[200]; const char *_get_cigar_parsing_error() { return errmsg_buf; } /* Return the number of chars that was read, or 0 if there is no more char to read (i.e. cigar_string[offset] is '\0'), or -1 in case of a parse error (in which case _get_cigar_parsing_error() can be used to get a pointer to the error message). Zero-length operations are ignored. */ int _next_cigar_OP(const char *cigar_string, int offset, char *OP, int *OPL) { char c; int offset0, opl; if (!cigar_string[offset]) return 0; offset0 = offset; do { /* Extract *OPL */ opl = 0; while (isdigit(c = cigar_string[offset])) { offset++; opl *= 10; opl += c - '0'; } /* Extract *OP */ if (!(*OP = cigar_string[offset])) { snprintf(errmsg_buf, sizeof(errmsg_buf), "unexpected CIGAR end after char %d", offset); return -1; } offset++; } while (opl == 0); *OPL = opl; return offset - offset0; } /* Return the number of chars that was read, or 0 if there is no more char to read (i.e. offset is 0), or -1 in case of a parse error. Zero-length operations are ignored. */ static int prev_cigar_OP(const char *cigar_string, int offset, char *OP, int *OPL) { char c; int offset0, opl, powof10; if (offset == 0) return 0; offset0 = offset; do { /* Extract *OP */ offset--; *OP = cigar_string[offset]; /* Extract *OPL */ if (offset == 0) { snprintf(errmsg_buf, sizeof(errmsg_buf), "no CIGAR operation length before char %d", offset + 1); return -1; } offset--; opl = 0; powof10 = 1; while (offset >= 0 && isdigit(c = cigar_string[offset])) { opl += (c - '0') * powof10; powof10 *= 10; offset--; } offset++; } while (opl == 0); *OPL = opl; return offset0 - offset; } static int ops_lkup_table[256]; static void init_ops_lkup_table(SEXP ops) { int ops_len, i; SEXP ops_elt; char OP; if (ops == R_NilValue) { for (i = 0; i < 256; i++) ops_lkup_table[i] = 1; return; } for (i = 0; i < 256; i++) ops_lkup_table[i] = 0; ops_len = LENGTH(ops); for (i = 0; i < ops_len; i++) { ops_elt = STRING_ELT(ops, i); if (ops_elt == NA_STRING || LENGTH(ops_elt) == 0) error("'ops' contains NAs and/or empty strings"); OP = CHAR(ops_elt)[0]; ops_lkup_table[(unsigned char) OP] = 1; } return; } static int is_in_ops(char OP) { return ops_lkup_table[(unsigned char) OP]; } static int is_visible_in_space(char OP, int space) { if (OP == 'M') return 1; switch (space) { case QUERY_BEFORE_HARD_CLIPPING: if (OP == 'H') return 1; /* fall through */ case QUERY: if (OP == 'S') return 1; /* fall through */ case QUERY_AFTER_SOFT_CLIPPING: if (OP == 'I') return 1; break; case PAIRWISE: if (OP == 'I') return 1; /* fall through */ case REFERENCE: if (OP == 'D' || OP == 'N') return 1; break; case PAIRWISE_N_REGIONS_REMOVED: if (OP == 'I') return 1; /* fall through */ case REFERENCE_N_REGIONS_REMOVED: if (OP == 'D') return 1; } if (OP == '=' || OP == 'X') return 1; return 0; } static void drop_or_append_or_merge_range(int start, int width, int drop_empty_range, int merge_range, int nelt0, IntPairAE *range_buf, const char *OP, CharAEAE *OP_buf) { int buf_nelt, buf_nelt_minus_1, prev_end_plus_1; CharAE *OP_buf_new_elt, *OP_buf_prev_elt; if (drop_empty_range && width == 0) /* Drop. */ return; buf_nelt = IntPairAE_get_nelt(range_buf); if (merge_range && buf_nelt > nelt0) { /* The incoming range should never overlap with the previous incoming range i.e. 'start' should always be > the end of the previous incoming range. */ buf_nelt_minus_1 = buf_nelt - 1; prev_end_plus_1 = range_buf->a->elts[buf_nelt_minus_1] + range_buf->b->elts[buf_nelt_minus_1]; if (start == prev_end_plus_1) { /* Merge. */ range_buf->b->elts[buf_nelt_minus_1] += width; if (OP_buf != NULL) { OP_buf_prev_elt = OP_buf->elts[buf_nelt_minus_1]; CharAE_insert_at(OP_buf_prev_elt, CharAE_get_nelt(OP_buf_prev_elt), *OP); } return; } } /* Append. */ IntPairAE_insert_at(range_buf, buf_nelt, start, width); if (OP_buf != NULL) { OP_buf_new_elt = new_CharAE(1); CharAE_insert_at(OP_buf_new_elt, 0, *OP); CharAEAE_insert_at(OP_buf, buf_nelt, OP_buf_new_elt); } return; } /* Make sure init_ops_lkup_table() is called before parse_cigar_ranges(). */ static const char *parse_cigar_ranges(const char *cigar_string, int space, int pos, int drop_empty_ranges, int reduce_ranges, IntPairAE *range_buf, CharAEAE *OP_buf) { int buf_nelt0, cigar_offset, n, OPL /* Operation Length */, start, width; char OP /* Operation */; buf_nelt0 = IntPairAE_get_nelt(range_buf); cigar_offset = 0; start = pos; while ((n = _next_cigar_OP(cigar_string, cigar_offset, &OP, &OPL))) { if (n == -1) return _get_cigar_parsing_error(); width = is_visible_in_space(OP, space) ? OPL : 0; if (is_in_ops(OP)) drop_or_append_or_merge_range(start, width, drop_empty_ranges, reduce_ranges, buf_nelt0, range_buf, &OP, OP_buf); start += width; cigar_offset += n; } return NULL; } static const char *parse_cigar_width(const char *cigar_string, int space, int *width) { int cigar_offset, n, OPL /* Operation Length */; char OP /* Operation */; *width = cigar_offset = 0; while ((n = _next_cigar_OP(cigar_string, cigar_offset, &OP, &OPL))) { if (n == -1) return _get_cigar_parsing_error(); if (is_visible_in_space(OP, space)) *width += OPL; cigar_offset += n; } return NULL; } /**************************************************************************** * --- .Call ENTRY POINT --- * Args: * cigar: character vector containing the extended CIGAR string for each * read; * ans_type: a single integer specifying the type of answer to return: * 0: 'ans' is a string describing the first validity failure or NULL; * 1: 'ans' is logical vector with TRUE values for valid elements * in 'cigar'. */ SEXP valid_cigar(SEXP cigar, SEXP ans_type) { SEXP ans, cigar_elt; int cigar_len, ans_type0, i, width; const char *cigar_string, *errmsg; char string_buf[200]; cigar_len = LENGTH(cigar); ans_type0 = INTEGER(ans_type)[0]; if (ans_type0 == 1) PROTECT(ans = NEW_LOGICAL(cigar_len)); else ans = R_NilValue; for (i = 0; i < cigar_len; i++) { cigar_elt = STRING_ELT(cigar, i); if (cigar_elt == NA_STRING) { if (ans_type0 == 1) LOGICAL(ans)[i] = 1; continue; } cigar_string = CHAR(cigar_elt); if (strcmp(cigar_string, "*") == 0) { if (ans_type0 == 1) LOGICAL(ans)[i] = 1; continue; } /* We use parse_cigar_width() here just for its ability to parse and detect ill-formed CIGAR strings */ errmsg = parse_cigar_width(cigar_string, 0L, &width); if (ans_type0 == 1) { LOGICAL(ans)[i] = errmsg == NULL; continue; } if (errmsg != NULL) { snprintf(string_buf, sizeof(string_buf), "element %d is invalid (%s)", i + 1, errmsg); return mkString(string_buf); } } if (ans_type0 == 1) UNPROTECT(1); return ans; } /**************************************************************************** * explode_cigar_ops() and explode_cigar_op_lengths() */ /* Make sure init_ops_lkup_table() is called before split_cigar_string(). */ static const char *split_cigar_string(const char *cigar_string, CharAE *OPbuf, IntAE *OPLbuf) { int offset, n, OPL /* Operation Length */; char OP /* Operation */; offset = 0; while ((n = _next_cigar_OP(cigar_string, offset, &OP, &OPL))) { if (n == -1) return _get_cigar_parsing_error(); if (is_in_ops(OP)) { if (OPbuf != NULL) CharAE_insert_at(OPbuf, CharAE_get_nelt(OPbuf), OP); if (OPLbuf != NULL) IntAE_insert_at(OPLbuf, IntAE_get_nelt(OPLbuf), OPL); } offset += n; } return NULL; } /* --- .Call ENTRY POINTS --- * - explode_cigar_ops() * - explode_cigar_op_lengths() * Args: * cigar: character vector containing the extended CIGAR strings to * explode. * ops: NULL or a character vector containing the CIGAR operations to * actually consider. If NULL, then all CIGAR operations are * considered. * Both functions return a list of the same length as 'cigar' where each * list element is a character vector (for explode_cigar_ops()) or an integer * vector (for explode_cigar_op_lengths()). The 2 lists have the same shape, * that is, same length() and same elementLengths(). The i-th character vector * in the list returned by explode_cigar_ops() contains one single-letter * string per CIGAR operation in 'cigar[i]'. The i-th integer vector in the * list returned by explode_cigar_op_lengths() contains the corresponding * CIGAR operation lengths. Zero-length operations or operations not listed * in 'ops' are ignored. */ SEXP explode_cigar_ops(SEXP cigar, SEXP ops) { SEXP ans, cigar_elt, ans_elt, ans_elt_elt; int cigar_len, ans_elt_len, i, j; CharAE *OPbuf; const char *cigar_string, *errmsg; cigar_len = LENGTH(cigar); init_ops_lkup_table(ops); PROTECT(ans = NEW_LIST(cigar_len)); OPbuf = new_CharAE(0); for (i = 0; i < cigar_len; i++) { cigar_elt = STRING_ELT(cigar, i); if (cigar_elt == NA_STRING) { UNPROTECT(1); error("'cigar[%d]' is NA", i + 1); } cigar_string = CHAR(cigar_elt); if (strcmp(cigar_string, "*") == 0) { UNPROTECT(1); error("'cigar[%d]' is \"*\"", i + 1); } CharAE_set_nelt(OPbuf, 0); errmsg = split_cigar_string(cigar_string, OPbuf, NULL); if (errmsg != NULL) { UNPROTECT(1); error("in 'cigar[%d]': %s", i + 1, errmsg); } ans_elt_len = CharAE_get_nelt(OPbuf); PROTECT(ans_elt = NEW_CHARACTER(ans_elt_len)); for (j = 0; j < ans_elt_len; j++) { PROTECT(ans_elt_elt = mkCharLen(OPbuf->elts + j, 1)); SET_STRING_ELT(ans_elt, j, ans_elt_elt); UNPROTECT(1); } SET_VECTOR_ELT(ans, i, ans_elt); UNPROTECT(1); } UNPROTECT(1); return ans; } SEXP explode_cigar_op_lengths(SEXP cigar, SEXP ops) { SEXP ans, cigar_elt, ans_elt; int cigar_len, i; IntAE *OPLbuf; const char *cigar_string, *errmsg; cigar_len = LENGTH(cigar); init_ops_lkup_table(ops); PROTECT(ans = NEW_LIST(cigar_len)); OPLbuf = new_IntAE(0, 0, 0); for (i = 0; i < cigar_len; i++) { cigar_elt = STRING_ELT(cigar, i); if (cigar_elt == NA_STRING) { UNPROTECT(1); error("'cigar[%d]' is NA", i + 1); } cigar_string = CHAR(cigar_elt); if (strcmp(cigar_string, "*") == 0) { UNPROTECT(1); error("'cigar[%d]' is \"*\"", i + 1); } IntAE_set_nelt(OPLbuf, 0); errmsg = split_cigar_string(cigar_string, NULL, OPLbuf); if (errmsg != NULL) { UNPROTECT(1); error("in 'cigar[%d]': %s", i + 1, errmsg); } PROTECT(ans_elt = new_INTEGER_from_IntAE(OPLbuf)); SET_VECTOR_ELT(ans, i, ans_elt); UNPROTECT(1); } UNPROTECT(1); return ans; } /**************************************************************************** * cigar_op_table() */ static const char *cigar_string_op_table(SEXP cigar_string, const char *allOPs, int *table_row, int table_nrow) { const char *cig0, *tmp; int offset, n, OPL /* Operation Length */; char OP /* Operation */; if (cigar_string == NA_STRING) return "CIGAR string is NA"; if (LENGTH(cigar_string) == 0) return "CIGAR string is empty"; cig0 = CHAR(cigar_string); offset = 0; while ((n = _next_cigar_OP(cig0, offset, &OP, &OPL))) { if (n == -1) return _get_cigar_parsing_error(); tmp = strchr(allOPs, (int) OP); if (tmp == NULL) { snprintf(errmsg_buf, sizeof(errmsg_buf), "unknown CIGAR operation '%c' at char %d", OP, offset + 1); return errmsg_buf; } *(table_row + (tmp - allOPs) * table_nrow) += OPL; offset += n; } return NULL; } /* --- .Call ENTRY POINT --- * Args: * cigar: character vector containing the extended CIGAR string for each * read; * Return an integer matrix with the number of rows equal to the length of * 'cigar' and 9 columns, one for each extended CIGAR operation containing * a frequency count for the operations for each element of 'cigar'. */ SEXP cigar_op_table(SEXP cigar) { SEXP cigar_string, ans, ans_dimnames, ans_colnames; int cigar_len, allOPs_len, i, j, *ans_row; const char *allOPs = "MIDNSHP=X", *errmsg; char OPstrbuf[2]; cigar_len = LENGTH(cigar); allOPs_len = strlen(allOPs); PROTECT(ans = allocMatrix(INTSXP, cigar_len, allOPs_len)); memset(INTEGER(ans), 0, LENGTH(ans) * sizeof(int)); ans_row = INTEGER(ans); for (i = 0, ans_row = INTEGER(ans); i < cigar_len; i++, ans_row++) { cigar_string = STRING_ELT(cigar, i); if (cigar_string == NA_STRING) { INTEGER(ans)[i] = NA_INTEGER; continue; } errmsg = cigar_string_op_table(cigar_string, allOPs, ans_row, cigar_len); if (errmsg != NULL) { UNPROTECT(1); error("in 'cigar[%d]': %s", i + 1, errmsg); } } PROTECT(ans_colnames = NEW_CHARACTER(allOPs_len)); OPstrbuf[1] = '\0'; for (j = 0; j < allOPs_len; j++) { OPstrbuf[0] = allOPs[j]; SET_STRING_ELT(ans_colnames, j, mkChar(OPstrbuf)); } PROTECT(ans_dimnames = NEW_LIST(2)); SET_ELEMENT(ans_dimnames, 0, R_NilValue); SET_ELEMENT(ans_dimnames, 1, ans_colnames); SET_DIMNAMES(ans, ans_dimnames); UNPROTECT(3); return ans; } /**************************************************************************** * cigar_ranges() */ static SEXP make_list_of_IRanges(const IntPairAEAE *range_buf, SEXP names) { SEXP ans, ans_names; PROTECT(ans = new_list_of_IRanges_from_IntPairAEAE("IRanges", range_buf)); PROTECT(ans_names = duplicate(names)); SET_NAMES(ans, ans_names); UNPROTECT(2); return ans; } static SEXP make_CompressedIRangesList(const IntPairAE *range_buf, const CharAEAE *OP_buf, SEXP breakpoints) { SEXP ans, ans_unlistData, ans_unlistData_names, ans_partitioning; PROTECT(ans_unlistData = new_IRanges_from_IntPairAE("IRanges", range_buf)); if (OP_buf != NULL) { PROTECT(ans_unlistData_names = new_CHARACTER_from_CharAEAE(OP_buf)); set_IRanges_names(ans_unlistData, ans_unlistData_names); UNPROTECT(1); } PROTECT(ans_partitioning = new_PartitioningByEnd("PartitioningByEnd", breakpoints, NULL)); PROTECT(ans = new_CompressedList( "CompressedIRangesList", ans_unlistData, ans_partitioning)); UNPROTECT(3); return ans; } /* --- .Call ENTRY POINT --- * Args: * cigar: character vector containing extended CIGAR strings. * flag: NULL or an integer vector of the same length as 'cigar' * containing the SAM flag for each read. Serves only as a way to * indicate whether a read is mapped or not. According to the SAM * Spec v1.4, flag bit 0x4 is the only reliable place to tell * whether a segment (or read) is mapped (bit is 0) or not (bit is 1). * space: single integer indicating one of the 8 supported spaces (defined * at the top of this file). * pos: integer vector of the same length as 'cigar' (or of length 1) * containing the 1-based leftmost position/coordinate of the * clipped read sequences. * f: NULL or a factor of length 'cigar'. If NULL, then the ranges are * grouped by alignment and stored in a CompressedIRangesList object * with 1 list element per element in 'cigar'. If a factor, then they * are grouped by factor level and stored in an ordinary list of * IRanges objects with 1 list element per level in 'f' and named * with those levels. * ops: NULL or a character vector containing the CIGAR operations to * translate to ranges. If NULL, then all CIGAR operations are * translated. * drop_empty_ranges: TRUE or FALSE. * reduce_ranges: TRUE or FALSE. * with_ops: TRUE or FALSE indicating whether the returned ranges should be * named with their corresponding CIGAR operation. * * Returns either a CompressedIRangesList object of the same length as 'cigar' * (if 'f' is NULL) or an ordinary list of IRanges objects with 1 list element * per level in 'f' (if 'f' is a factor). This list is then turned into a * SimpleIRangesList object in R. */ SEXP cigar_ranges(SEXP cigar, SEXP flag, SEXP space, SEXP pos, SEXP f, SEXP ops, SEXP drop_empty_ranges, SEXP reduce_ranges, SEXP with_ops) { SEXP ans, ans_breakpoints, f_levels, cigar_elt; int cigar_len, space0, pos_len, f_is_NULL, ans_len, *breakpoint, drop_empty_ranges0, reduce_ranges0, with_ops0, i; IntPairAE *range_buf1; IntPairAEAE *range_buf2; CharAEAE *OP_buf; const int *flag_elt, *pos_elt, *f_elt; const char *cigar_string, *errmsg; cigar_len = LENGTH(cigar); if (flag != R_NilValue) flag_elt = INTEGER(flag); init_ops_lkup_table(ops); space0 = INTEGER(space)[0]; pos_len = LENGTH(pos); pos_elt = INTEGER(pos); f_is_NULL = f == R_NilValue; if (f_is_NULL) { ans_len = cigar_len; /* We will typically generate at least 'cigar_len' ranges. */ range_buf1 = new_IntPairAE(ans_len, 0); PROTECT(ans_breakpoints = NEW_INTEGER(ans_len)); breakpoint = INTEGER(ans_breakpoints); } else { f_levels = GET_LEVELS(f); ans_len = LENGTH(f_levels); range_buf2 = new_IntPairAEAE(ans_len, ans_len); f_elt = INTEGER(f); } drop_empty_ranges0 = LOGICAL(drop_empty_ranges)[0]; reduce_ranges0 = LOGICAL(reduce_ranges)[0]; with_ops0 = LOGICAL(with_ops)[0]; if (with_ops0 && f_is_NULL) { OP_buf = new_CharAEAE(cigar_len, 0); } else { OP_buf = NULL; } for (i = 0; i < cigar_len; i++) { if (flag != R_NilValue) { if (*flag_elt == NA_INTEGER) { if (f_is_NULL) UNPROTECT(1); error("'flag' contains NAs"); } if (*flag_elt & 0x004) { /* The CIGAR of an unmapped read doesn't produce any range i.e. it's treated as an empty CIGAR. */ goto for_tail; } } cigar_elt = STRING_ELT(cigar, i); if (cigar_elt == NA_STRING) { if (f_is_NULL) UNPROTECT(1); error("'cigar[%d]' is NA", i + 1); } cigar_string = CHAR(cigar_elt); if (strcmp(cigar_string, "*") == 0) { if (f_is_NULL) UNPROTECT(1); error("'cigar[%d]' is \"*\"", i + 1); } if (*pos_elt == NA_INTEGER || *pos_elt == 0) { if (f_is_NULL) UNPROTECT(1); error("'pos[%d]' is NA or 0", i + 1); } if (!f_is_NULL) { if (*f_elt == NA_INTEGER) error("'f[%d]' is NA", i + 1); range_buf1 = range_buf2->elts[*f_elt - 1]; } errmsg = parse_cigar_ranges(cigar_string, space0, *pos_elt, drop_empty_ranges0, reduce_ranges0, range_buf1, OP_buf); if (errmsg != NULL) { if (f_is_NULL) UNPROTECT(1); error("in 'cigar[%d]': %s", i + 1, errmsg); } for_tail: if (flag != R_NilValue) flag_elt++; if (pos_len != 1) pos_elt++; if (f_is_NULL) *(breakpoint++) = IntPairAE_get_nelt(range_buf1); else f_elt++; } if (!f_is_NULL) return make_list_of_IRanges(range_buf2, f_levels); PROTECT(ans = make_CompressedIRangesList(range_buf1, OP_buf, ans_breakpoints)); UNPROTECT(2); return ans; } /**************************************************************************** * --- .Call ENTRY POINT --- * Args: * cigar, flag, space: see cigar_ranges() function above. * Return an integer vector of the same length as 'cigar' containing the * widths of the alignments as inferred from the cigar information. */ SEXP cigar_width(SEXP cigar, SEXP flag, SEXP space) { SEXP ans, cigar_elt; int cigar_len, space0, i, *ans_elt; const int *flag_elt; const char *cigar_string, *errmsg; cigar_len = LENGTH(cigar); if (flag != R_NilValue) flag_elt = INTEGER(flag); space0 = INTEGER(space)[0]; PROTECT(ans = NEW_INTEGER(cigar_len)); for (i = 0, ans_elt = INTEGER(ans); i < cigar_len; i++, ans_elt++) { if (flag != R_NilValue) { if (*flag_elt == NA_INTEGER) { UNPROTECT(1); error("'flag' contains NAs"); } if (*flag_elt & 0x004) { *ans_elt = NA_INTEGER; goto for_tail; } } cigar_elt = STRING_ELT(cigar, i); if (cigar_elt == NA_STRING) { *ans_elt = NA_INTEGER; goto for_tail; } cigar_string = CHAR(cigar_elt); if (strcmp(cigar_string, "*") == 0) { *ans_elt = NA_INTEGER; goto for_tail; } errmsg = parse_cigar_width(cigar_string, space0, ans_elt); if (errmsg != NULL) { UNPROTECT(1); error("in 'cigar[%d]': %s", i + 1, errmsg); } for_tail: if (flag != R_NilValue) flag_elt++; } UNPROTECT(1); return ans; } /**************************************************************************** * cigar_narrow() */ static const char *Lnarrow_cigar_string(SEXP cigar_string, int *Lwidth, int *Loffset, int *rshift) { const char *cig0; int offset, n, OPL /* Operation Length */; char OP /* Operation */; if (cigar_string == NA_STRING) return "CIGAR string is NA"; if (LENGTH(cigar_string) == 0) return "CIGAR string is empty"; cig0 = CHAR(cigar_string); *rshift = offset = 0; while ((n = _next_cigar_OP(cig0, offset, &OP, &OPL))) { if (n == -1) return _get_cigar_parsing_error(); switch (OP) { /* Alignment match (can be a sequence match or mismatch) */ case 'M': case '=': case 'X': if (*Lwidth < OPL) { *Loffset = offset; *rshift += *Lwidth; return NULL; } *Lwidth -= OPL; *rshift += OPL; break; /* Insertion to the reference or soft/hard clip on the read */ case 'I': case 'S': case 'H': break; /* Deletion (or skipped region) from the reference */ case 'D': case 'N': if (*Lwidth < OPL) *Lwidth = 0; else *Lwidth -= OPL; *rshift += OPL; break; /* Silent deletion from the padded reference */ case 'P': break; default: snprintf(errmsg_buf, sizeof(errmsg_buf), "unknown CIGAR operation '%c' at char %d", OP, offset + 1); return errmsg_buf; } offset += n; } snprintf(errmsg_buf, sizeof(errmsg_buf), "CIGAR is empty after narrowing"); return errmsg_buf; } static const char *Rnarrow_cigar_string(SEXP cigar_string, int *Rwidth, int *Roffset) { const char *cig0; int offset, n, OPL /* Operation Length */; char OP /* Operation */; if (cigar_string == NA_STRING) return "CIGAR string is NA"; if (LENGTH(cigar_string) == 0) return "CIGAR string is empty"; cig0 = CHAR(cigar_string); offset = LENGTH(cigar_string); while ((n = prev_cigar_OP(cig0, offset, &OP, &OPL))) { if (n == -1) return _get_cigar_parsing_error(); offset -= n; switch (OP) { /* Alignment match (can be a sequence match or mismatch) */ case 'M': case '=': case 'X': if (*Rwidth < OPL) { *Roffset = offset; return NULL; } *Rwidth -= OPL; break; /* Insertion to the reference or soft/hard clip on the read */ case 'I': case 'S': case 'H': break; /* Deletion (or skipped region) from the reference */ case 'D': case 'N': if (*Rwidth < OPL) *Rwidth = 0; else *Rwidth -= OPL; break; /* Silent deletion from the padded reference */ case 'P': break; default: snprintf(errmsg_buf, sizeof(errmsg_buf), "unknown CIGAR operation '%c' at char %d", OP, offset + 1); return errmsg_buf; } } snprintf(errmsg_buf, sizeof(errmsg_buf), "CIGAR is empty after narrowing"); return errmsg_buf; } /* FIXME: 'cigar_buf' is under the risk of a buffer overflow! */ static const char *narrow_cigar_string(SEXP cigar_string, int Lwidth, int Rwidth, char *cigar_buf, int *rshift) { int Loffset, Roffset, buf_offset; const char *cig0; int offset, n, OPL /* Operation Length */; char OP /* Operation */; const char *errmsg; //Rprintf("narrow_cigar_string():\n"); errmsg = Lnarrow_cigar_string(cigar_string, &Lwidth, &Loffset, rshift); if (errmsg != NULL) return errmsg; //Rprintf(" Lwidth=%d Loffset=%d *rshift=%d\n", // Lwidth, Loffset, *rshift); errmsg = Rnarrow_cigar_string(cigar_string, &Rwidth, &Roffset); if (errmsg != NULL) return errmsg; //Rprintf(" Rwidth=%d Roffset=%d\n", Rwidth, Roffset); if (Roffset < Loffset) { snprintf(errmsg_buf, sizeof(errmsg_buf), "CIGAR is empty after narrowing"); return errmsg_buf; } buf_offset = 0; cig0 = CHAR(cigar_string); for (offset = Loffset; offset <= Roffset; offset += n) { n = _next_cigar_OP(cig0, offset, &OP, &OPL); if (offset == Loffset) OPL -= Lwidth; if (offset == Roffset) OPL -= Rwidth; if (OPL <= 0) { snprintf(errmsg_buf, sizeof(errmsg_buf), "CIGAR is empty after narrowing"); return errmsg_buf; } buf_offset += sprintf(cigar_buf + buf_offset, "%d%c", OPL, OP); } return NULL; } /* --- .Call ENTRY POINT --- */ SEXP cigar_narrow(SEXP cigar, SEXP left_width, SEXP right_width) { SEXP ans, ans_cigar, ans_cigar_string, ans_rshift, cigar_string; int cigar_len, i; static char cigar_buf[1024]; const char *errmsg; cigar_len = LENGTH(cigar); PROTECT(ans_cigar = NEW_CHARACTER(cigar_len)); PROTECT(ans_rshift = NEW_INTEGER(cigar_len)); for (i = 0; i < cigar_len; i++) { cigar_string = STRING_ELT(cigar, i); if (cigar_string == NA_STRING) { SET_STRING_ELT(ans_cigar, i, NA_STRING); INTEGER(ans_rshift)[i] = NA_INTEGER; continue; } errmsg = narrow_cigar_string(cigar_string, INTEGER(left_width)[i], INTEGER(right_width)[i], cigar_buf, INTEGER(ans_rshift) + i); if (errmsg != NULL) { UNPROTECT(2); error("in 'cigar[%d]': %s", i + 1, errmsg); } PROTECT(ans_cigar_string = mkChar(cigar_buf)); SET_STRING_ELT(ans_cigar, i, ans_cigar_string); UNPROTECT(1); } PROTECT(ans = NEW_LIST(2)); SET_VECTOR_ELT(ans, 0, ans_cigar); SET_VECTOR_ELT(ans, 1, ans_rshift); UNPROTECT(3); return ans; } /**************************************************************************** * cigar_qnarrow() */ static const char *Lqnarrow_cigar_string(SEXP cigar_string, int *Lqwidth, int *Loffset, int *rshift) { const char *cig0; int offset, n, OPL /* Operation Length */; char OP /* Operation */; if (cigar_string == NA_STRING) return "CIGAR string is NA"; if (LENGTH(cigar_string) == 0) return "CIGAR string is empty"; cig0 = CHAR(cigar_string); *rshift = offset = 0; while ((n = _next_cigar_OP(cig0, offset, &OP, &OPL))) { if (n == -1) return _get_cigar_parsing_error(); switch (OP) { /* Alignment match (can be a sequence match or mismatch) */ case 'M': case '=': case 'X': if (*Lqwidth < OPL) { *Loffset = offset; *rshift += *Lqwidth; return NULL; } *Lqwidth -= OPL; *rshift += OPL; break; /* Insertion to the reference or soft/hard clip on the read */ case 'I': case 'S': case 'H': if (*Lqwidth < OPL) { *Loffset = offset; return NULL; } *Lqwidth -= OPL; break; /* Deletion (or skipped region) from the reference */ case 'D': case 'N': *rshift += OPL; break; /* Silent deletion from the padded reference */ case 'P': break; default: snprintf(errmsg_buf, sizeof(errmsg_buf), "unknown CIGAR operation '%c' at char %d", OP, offset + 1); return errmsg_buf; } offset += n; } snprintf(errmsg_buf, sizeof(errmsg_buf), "CIGAR is empty after qnarrowing"); return errmsg_buf; } static const char *Rqnarrow_cigar_string(SEXP cigar_string, int *Rqwidth, int *Roffset) { const char *cig0; int offset, n, OPL /* Operation Length */; char OP /* Operation */; if (cigar_string == NA_STRING) return "CIGAR string is NA"; if (LENGTH(cigar_string) == 0) return "CIGAR string is empty"; cig0 = CHAR(cigar_string); offset = LENGTH(cigar_string); while ((n = prev_cigar_OP(cig0, offset, &OP, &OPL))) { if (n == -1) return _get_cigar_parsing_error(); offset -= n; switch (OP) { /* M, =, X, I, S, H */ case 'M': case '=': case 'X': case 'I': case 'S': case 'H': if (*Rqwidth < OPL) { *Roffset = offset; return NULL; } *Rqwidth -= OPL; break; /* Deletion (or skipped region) from the reference, or silent deletion from the padded reference */ case 'D': case 'N': case 'P': break; default: snprintf(errmsg_buf, sizeof(errmsg_buf), "unknown CIGAR operation '%c' at char %d", OP, offset + 1); return errmsg_buf; } } snprintf(errmsg_buf, sizeof(errmsg_buf), "CIGAR is empty after qnarrowing"); return errmsg_buf; } /* FIXME: 'cigar_buf' is under the risk of a buffer overflow! */ static const char *qnarrow_cigar_string(SEXP cigar_string, int Lqwidth, int Rqwidth, char *cigar_buf, int *rshift) { int Loffset, Roffset, buf_offset; const char *cig0; int offset, n, OPL /* Operation Length */; char OP /* Operation */; const char *errmsg; //Rprintf("qnarrow_cigar_string():\n"); errmsg = Lqnarrow_cigar_string(cigar_string, &Lqwidth, &Loffset, rshift); if (errmsg != NULL) return errmsg; //Rprintf(" Lqwidth=%d Loffset=%d *rshift=%d\n", // Lqwidth, Loffset, *rshift); errmsg = Rqnarrow_cigar_string(cigar_string, &Rqwidth, &Roffset); if (errmsg != NULL) return errmsg; //Rprintf(" Rqwidth=%d Roffset=%d\n", Rqwidth, Roffset); if (Roffset < Loffset) { snprintf(errmsg_buf, sizeof(errmsg_buf), "CIGAR is empty after qnarrowing"); return errmsg_buf; } buf_offset = 0; cig0 = CHAR(cigar_string); for (offset = Loffset; offset <= Roffset; offset += n) { n = _next_cigar_OP(cig0, offset, &OP, &OPL); if (offset == Loffset) OPL -= Lqwidth; if (offset == Roffset) OPL -= Rqwidth; if (OPL <= 0) { snprintf(errmsg_buf, sizeof(errmsg_buf), "CIGAR is empty after qnarrowing"); return errmsg_buf; } buf_offset += sprintf(cigar_buf + buf_offset, "%d%c", OPL, OP); } return NULL; } /* --- .Call ENTRY POINT --- * Return a list of 2 elements: 1st elt is the narrowed cigar vector, 2nd elt * is the 'rshift' vector i.e. the integer vector of the same length as 'cigar' * that would need to be added to the 'pos' field of a SAM/BAM file as a * consequence of this narrowing. */ SEXP cigar_qnarrow(SEXP cigar, SEXP left_qwidth, SEXP right_qwidth) { SEXP ans, ans_cigar, ans_cigar_string, ans_rshift, cigar_string; int cigar_len, i; static char cigar_buf[1024]; const char *errmsg; cigar_len = LENGTH(cigar); PROTECT(ans_cigar = NEW_CHARACTER(cigar_len)); PROTECT(ans_rshift = NEW_INTEGER(cigar_len)); for (i = 0; i < cigar_len; i++) { cigar_string = STRING_ELT(cigar, i); if (cigar_string == NA_STRING) { SET_STRING_ELT(ans_cigar, i, NA_STRING); INTEGER(ans_rshift)[i] = NA_INTEGER; continue; } errmsg = qnarrow_cigar_string(cigar_string, INTEGER(left_qwidth)[i], INTEGER(right_qwidth)[i], cigar_buf, INTEGER(ans_rshift) + i); if (errmsg != NULL) { UNPROTECT(2); error("in 'cigar[%d]': %s", i + 1, errmsg); } PROTECT(ans_cigar_string = mkChar(cigar_buf)); SET_STRING_ELT(ans_cigar, i, ans_cigar_string); UNPROTECT(1); } PROTECT(ans = NEW_LIST(2)); SET_VECTOR_ELT(ans, 0, ans_cigar); SET_VECTOR_ELT(ans, 1, ans_rshift); UNPROTECT(3); return ans; } GenomicAlignments/src/coordinate_mapping_methods.c0000644000175100017510000002536112612051202023513 0ustar00biocbuildbiocbuild#include "GenomicAlignments.h" #include "IRanges_interface.h" #include "S4Vectors_interface.h" /**************************************************************************** * Mapping from genome (reference) to local space. */ /* Returns integer position of 'ref_loc' mapped to local space. * If 'ref_loc' cannot be mapped NA is returned. */ int to_query(int ref_loc, const char *cig0, int pos, Rboolean narrow_left) { int query_loc = ref_loc - pos + 1; int n, offset = 0, OPL, query_consumed = 0; char OP; while (query_consumed < query_loc && (n = _next_cigar_OP(cig0, offset, &OP, &OPL))) { switch (OP) { /* Alignment match (can be a sequence match or mismatch) */ case 'M': case '=': case 'X': query_consumed += OPL; break; /* Insertion to the reference */ case 'I': /* Soft clip on the read */ case 'S': query_loc += OPL; query_consumed += OPL; break; /* Deletion from the reference */ case 'D': /* Skipped region from reference; narrow to query */ case 'N': { Rboolean query_loc_past_gap = query_loc - query_consumed > OPL; if (query_loc_past_gap) { query_loc -= OPL; } else { if (narrow_left) { query_loc = query_consumed; } else { query_loc = query_consumed + 1; } } } break; /* Hard clip on the read */ case 'H': break; /* Silent deletion from the padded reference */ case 'P': break; default: break; } offset += n; } if (query_loc < 0 || n == 0) query_loc = NA_INTEGER; return query_loc; } /**************************************************************************** * --- .Call ENTRY POINT --- * Args: * ref_locs : global positions in the reference to map * cigar : character string containing the extended CIGAR; * pos : reference position at which the query alignment begins * (after clip) * narrow_left: whether to narrow to the left (or right) side of a gap * * Returns an integer vector of local query positions. This assumes the * reference positions actually occur in the read alignment region, * outside of any deletions or insertions. */ SEXP ref_locs_to_query_locs(SEXP ref_locs, SEXP cigar, SEXP pos, SEXP narrow_left) { int nlocs, i; SEXP query_locs; nlocs = LENGTH(ref_locs); PROTECT(query_locs = allocVector(INTSXP, nlocs)); for (i = 0; i < nlocs; i++) { const char *cig_i = CHAR(STRING_ELT(cigar, i)); INTEGER(query_locs)[i] = to_query(INTEGER(ref_locs)[i], cig_i, INTEGER(pos)[i], asLogical(narrow_left)); } UNPROTECT(1); return query_locs; } /**************************************************************************** * --- .Call ENTRY POINT --- * Args: * ref_locs : global positions in the reference to map * cigar : character string containing the extended CIGAR; * pos : reference position at which the query alignment begins * (after clip) * narrow_left: whether to narrow to the left (or right) side of a gap * * Returns a list of length 4: * - start of local query position * - end of local query position * - index of 'start' used in match ('from_hits') * - index of 'pos' used in match ('to_hits') * All list elements are integer vectors. This assumes that the reference * positions actually occur in the read alignment region, outside of * any deletions or insertions. */ SEXP map_ref_locs_to_query_locs(SEXP start, SEXP end, SEXP cigar, SEXP pos) { SEXP ans, ans_start, ans_end, ans_qhits, ans_shits; IntAE *sbuf, *ebuf, *qhbuf, *shbuf; int i, j, s, e; int nlocs = LENGTH(start); int ncigar = LENGTH(cigar); sbuf = new_IntAE(0, 0, 0); ebuf = new_IntAE(0, 0, 0); qhbuf = new_IntAE(0, 0, 0); shbuf = new_IntAE(0, 0, 0); for (i = 0; i < nlocs; i++) { for (j = 0; j < ncigar; j++) { const char *cig_j = CHAR(STRING_ELT(cigar, j)); int pos_j = INTEGER(pos)[j]; s = to_query(INTEGER(start)[i], cig_j, pos_j, FALSE); if (s == NA_INTEGER) break; e = to_query(INTEGER(end)[i], cig_j, pos_j, TRUE); if (e == NA_INTEGER) break; IntAE_insert_at(sbuf, IntAE_get_nelt(sbuf), s); IntAE_insert_at(ebuf, IntAE_get_nelt(ebuf), e); IntAE_insert_at(qhbuf, IntAE_get_nelt(qhbuf), i + 1); IntAE_insert_at(shbuf, IntAE_get_nelt(shbuf), j + 1); } } PROTECT(ans = NEW_LIST(4)); PROTECT(ans_start = new_INTEGER_from_IntAE(sbuf)); PROTECT(ans_end = new_INTEGER_from_IntAE(ebuf)); PROTECT(ans_qhits = new_INTEGER_from_IntAE(qhbuf)); PROTECT(ans_shits = new_INTEGER_from_IntAE(shbuf)); SET_VECTOR_ELT(ans, 0, ans_start); SET_VECTOR_ELT(ans, 1, ans_end); SET_VECTOR_ELT(ans, 2, ans_qhits); SET_VECTOR_ELT(ans, 3, ans_shits); UNPROTECT(5); return ans; } /**************************************************************************** * Mapping from local to genome (reference) space. */ /* Returns integer position of 'query_loc' mapped to genome-based space. * If 'query_loc' cannot be mapped NA is returned. */ int to_ref(int query_loc, const char *cig0, int pos, Rboolean narrow_left) { int ref_loc = query_loc + pos - 1; int n, offset = 0, OPL, query_consumed = 0; char OP; while (query_consumed < query_loc && (n = _next_cigar_OP(cig0, offset, &OP, &OPL))) { switch (OP) { /* Alignment match (can be a sequence match or mismatch) */ case 'M': case '=': case 'X': query_consumed += OPL; break; /* Insertion to the reference */ case 'I': { int width_from_insertion_start = query_loc - query_consumed; Rboolean query_loc_past_insertion = width_from_insertion_start > OPL; if (query_loc_past_insertion) { ref_loc -= OPL; } else { ref_loc -= width_from_insertion_start; if (!narrow_left) { ref_loc += 1; } } query_consumed += OPL; break; } /* Soft clip on the read */ case 'S': query_consumed += OPL; break; /* Deletion from the reference */ case 'D': case 'N': /* Skipped region from reference; narrow to query */ ref_loc += OPL; break; /* Hard clip on the read */ case 'H': break; /* Silent deletion from the padded reference */ case 'P': break; default: break; } offset += n; } if (n == 0) ref_loc = NA_INTEGER; return ref_loc; } /**************************************************************************** * --- .Call ENTRY POINT --- * Args: * query_locs: local positions in the read that we will map * cigar: character string containing the extended CIGAR; * pos: reference position at which the query alignment begins * (after clip) * narrow_left: whether to narrow to the left (or right) side of a gap * Returns an integer vector of local query positions. This assumes * that the reference positions actually occur in the read alignment region, * outside of any deletions or insertions. */ SEXP query_locs_to_ref_locs(SEXP query_locs, SEXP cigar, SEXP pos, SEXP narrow_left) { int nlocs, i; SEXP ref_locs; nlocs = LENGTH(query_locs); PROTECT(ref_locs = allocVector(INTSXP, nlocs)); for (i = 0; i < nlocs; i++) { const char *cig_i = CHAR(STRING_ELT(cigar, i)); INTEGER(ref_locs)[i] = to_ref(INTEGER(query_locs)[i], cig_i, INTEGER(pos)[i], asLogical(narrow_left)); } UNPROTECT(1); return ref_locs; } /**************************************************************************** * --- .Call ENTRY POINT --- * Args: * query_locs: local positions in the read that we will map * cigar: character string containing the extended CIGAR; * pos: reference position at which the query alignment begins * (after clip) * narrow_left: whether to narrow to the left (or right) side of a gap * Returns a list of length 4: * - start of local query position * - end of local query position * - index of 'start' used in match ('from_hits') * - index of 'pos' used in match ('to_hits') * All list elements are integer vectors. This assumes that the reference * positions actually occur in the read alignment region, outside of * any deletions or insertions. */ SEXP map_query_locs_to_ref_locs(SEXP start, SEXP end, SEXP cigar, SEXP pos) { SEXP ans, ans_start, ans_end, ans_qhits, ans_shits; IntAE *sbuf, *ebuf, *qhbuf, *shbuf; int i, j, s, e, nlocs, ncigar; nlocs = LENGTH(start); ncigar = LENGTH(cigar); sbuf = new_IntAE(0, 0, 0); ebuf = new_IntAE(0, 0, 0); qhbuf = new_IntAE(0, 0, 0); shbuf = new_IntAE(0, 0, 0); for (i = 0; i < nlocs; i++) { for (j = 0; j < ncigar; j++) { const char *cig_j = CHAR(STRING_ELT(cigar, j)); int pos_j = INTEGER(pos)[j]; s = to_ref(INTEGER(start)[i], cig_j, pos_j, FALSE); if (s == NA_INTEGER) break; e = to_ref(INTEGER(end)[i], cig_j, pos_j, TRUE); if (e == NA_INTEGER) break; IntAE_insert_at(sbuf, IntAE_get_nelt(sbuf), s); IntAE_insert_at(ebuf, IntAE_get_nelt(ebuf), e); IntAE_insert_at(qhbuf, IntAE_get_nelt(qhbuf), i + 1); IntAE_insert_at(shbuf, IntAE_get_nelt(shbuf), j + 1); } } PROTECT(ans = NEW_LIST(4)); PROTECT(ans_start = new_INTEGER_from_IntAE(sbuf)); PROTECT(ans_end = new_INTEGER_from_IntAE(ebuf)); PROTECT(ans_qhits = new_INTEGER_from_IntAE(qhbuf)); PROTECT(ans_shits = new_INTEGER_from_IntAE(shbuf)); SET_VECTOR_ELT(ans, 0, ans_start); SET_VECTOR_ELT(ans, 1, ans_end); SET_VECTOR_ELT(ans, 2, ans_qhits); SET_VECTOR_ELT(ans, 3, ans_shits); UNPROTECT(5); return ans; } GenomicAlignments/src/encodeOverlaps_methods.c0000644000175100017510000003700312612051202022616 0ustar00biocbuildbiocbuild/**************************************************************************** * Encode overlaps * * Author: Herve Pages * ****************************************************************************/ #include "GenomicAlignments.h" #include "IRanges_interface.h" #include "S4Vectors_interface.h" /* * A low-level helper for "superficial" checking of the 'space' vector * associated with a Ranges object. */ static const int *check_Ranges_space(SEXP space, int len, const char *what) { if (space == R_NilValue) return NULL; if (!IS_INTEGER(space)) error("'%s_space' must be an integer vector or NULL", what); if (LENGTH(space) != len) error("when not NULL, '%s_space' must have " "the same length as 'start(%s)'", what, what); return INTEGER(space); } static void CharAE_append_char(CharAE *char_ae, char c, int times) { int i; for (i = 0; i < times; i++) CharAE_insert_at(char_ae, CharAE_get_nelt(char_ae), c); return; } static void CharAE_append_int(CharAE *char_ae, int d) { static char buf[12]; /* should be enough for 32-bit ints */ int ret; ret = snprintf(buf, sizeof(buf), "%d", d); if (ret < 0) /* should never happen */ error("GenomicAlignments internal error " "in CharAE_append_int(): " "snprintf() returned value < 0"); if (ret >= sizeof(buf)) /* could happen with ints > 32-bit */ error("GenomicAlignments internal error " "in CharAE_append_int(): " "output of snprintf() was truncated"); append_string_to_CharAE(char_ae, buf); return; } /* * A special 1-letter code 'X' is used for ranges that are not on the same * space. */ static char overlap_letter(int x_start, int x_width, int x_space, int y_start, int y_width, int y_space) { int code; if (x_space != y_space) return 'X'; code = overlap_code(x_start, x_width, y_start, y_width); if (x_space < 0) code = invert_overlap_code(code); return 'g' + code; } /* * q_start, q_width: int arrays of length q_len. No NAs. * q_space: NULL or an int array of length q_len. No NAs. * q_len: nb of ranges in the query. * q_break: 0 if all the ranges in the query are coming from the same * segment (single-end read), or, an int >= 1 and < q_len specifying * the position of the break between the ranges coming from one * segment and the ranges coming from the other if the query is a * paired-end read. * flip_query: if non-zero, then the query is "flipped" before the encoding is * computed. * s_start, s_width: int arrays of length s_len. No NAs. * s_space: NULL or an int array of length s_len. No NAs. * s_len: nb of ranges in the subject. * as_matrix, Loffset, Roffset: if as_matrix, then the full matrix of codes * is returned and the returned values for Loffset and Roffset are * undefined. Otherwise, the matrix is trimmed and the returned values * for Loffset and Roffset are the number of cols removed on the left * and right sides of the matrix, respectively. * out: character array containing the matrix of codes (possibly trimmed) */ static void unsafe_overlap_encoding( const int *q_start, const int *q_width, const int *q_space, int q_len, int q_break, int flip_query, const int *s_start, const int *s_width, const int *s_space, int s_len, int as_matrix, int *Loffset, int *Roffset, CharAE *out) { int out_nelt0, i, starti, widthi, spacei, j, startj, widthj, spacej, j1, j2, nrow; char letter; if (!as_matrix) { if (q_break != 0) { if (flip_query) { CharAE_append_int(out, q_len - q_break); CharAE_append_char(out, '-', 2); CharAE_append_int(out, q_break); } else { CharAE_append_int(out, q_break); CharAE_append_char(out, '-', 2); CharAE_append_int(out, q_len - q_break); } } else { CharAE_append_int(out, q_len); } CharAE_append_char(out, ':', 1); out_nelt0 = CharAE_get_nelt(out); } /* j1: 0-based index of first (i.e. leftmost) col with a non-"m", or 's_len' if there is no such col. j2: 0-based index of last (i.e. rightmost) col with a non-"a", or -1 if there is no such col. */ j1 = s_len; j2 = -1; /* Walk col by col. */ for (j = 0; j < s_len; j++) { startj = s_start[j]; widthj = s_width[j]; spacej = s_space == NULL ? 0 : s_space[j]; if (flip_query) { for (i = q_len - 1; i >= 0; i--) { starti = q_start[i]; widthi = q_width[i]; spacei = q_space == NULL ? 0 : - q_space[i]; letter = overlap_letter(starti, widthi, spacei, startj, widthj, spacej); CharAE_append_char(out, letter, 1); if (j1 == s_len && letter != 'm') j1 = j; if (letter != 'a') j2 = j; if (q_break != 0 && i == q_break) CharAE_append_char(out, '-', 2); } } else { for (i = 0; i < q_len; i++) { if (q_break != 0 && i == q_break) CharAE_append_char(out, '-', 2); starti = q_start[i]; widthi = q_width[i]; spacei = q_space == NULL ? 0 : q_space[i]; letter = overlap_letter(starti, widthi, spacei, startj, widthj, spacej); CharAE_append_char(out, letter, 1); if (j1 == s_len && letter != 'm') j1 = j; if (letter != 'a') j2 = j; } } } if (as_matrix) return; /* By making 'j2' a 1-based index we will then have 0 <= j1 <= j2 <= s_len, which will simplify further arithmetic/logic. */ if (q_len == 0) { /* A 0-row matrix needs special treatment. */ j2 = s_len; } else { j2++; } *Loffset = j1; *Roffset = s_len - j2; nrow = q_len; if (q_break != 0) nrow += 2; /* Remove "a"-cols on the right. */ CharAE_set_nelt(out, out_nelt0 + j2 * nrow); /* Remove "m"-cols on the left. */ CharAE_delete_at(out, out_nelt0, j1 * nrow); /* Insert ":" at the end of each remaining col. */ for (j = j2 - j1; j >= 1; j--) CharAE_insert_at(out, out_nelt0 + j * nrow, ':'); return; } static void overlap_encoding( SEXP query_start, SEXP query_width, SEXP query_space, int query_break, int flip_query, SEXP subject_start, SEXP subject_width, SEXP subject_space, int as_matrix, int *Loffset, int *Roffset, CharAE *out) { int q_len, s_len; const int *q_start, *q_width, *q_space, *s_start, *s_width, *s_space; q_len = check_integer_pairs(query_start, query_width, &q_start, &q_width, "start(query)", "width(query)"); if (query_break != 0 && (query_break < 1 || query_break >= q_len)) error("the position of the break in the query " "must be >= 1 and < length(query)"); q_space = check_Ranges_space(query_space, q_len, "query"); s_len = check_integer_pairs(subject_start, subject_width, &s_start, &s_width, "start(subject)", "width(subject)"); s_space = check_Ranges_space(subject_space, s_len, "subject"); unsafe_overlap_encoding(q_start, q_width, q_space, q_len, query_break, flip_query, s_start, s_width, s_space, s_len, as_matrix, Loffset, Roffset, out); return; } /* type: 0=CHARSXP, 1=STRSXP, 2=RAWSXP as_matrix: 0 or 1, ignored when type is 0 q_len, q_break, s_len: ignored when type is 0 */ static SEXP make_encoding_from_CharAE(const CharAE *buf, int type, int as_matrix, int q_len, int q_break, int s_len) { SEXP ans, ans_elt, ans_dim; int buf_nelt, i, nrow; buf_nelt = CharAE_get_nelt(buf); if (type == 0 || (type == 1 && !as_matrix)) { PROTECT(ans = mkCharLen(buf->elts, buf_nelt)); if (type == 1) { PROTECT(ans = ScalarString(ans)); UNPROTECT(1); } UNPROTECT(1); return ans; } if (type == 1) { PROTECT(ans = NEW_CHARACTER(buf_nelt)); for (i = 0; i < buf_nelt; i++) { PROTECT(ans_elt = mkCharLen(buf->elts + i, 1)); SET_STRING_ELT(ans, i, ans_elt); UNPROTECT(1); } } else { PROTECT(ans = new_RAW_from_CharAE(buf)); } if (as_matrix) { nrow = q_len; if (q_break != 0) nrow += 2; PROTECT(ans_dim = NEW_INTEGER(2)); INTEGER(ans_dim)[0] = nrow; INTEGER(ans_dim)[1] = s_len; SET_DIM(ans, ans_dim); UNPROTECT(1); } UNPROTECT(1); return ans; } static SEXP make_LIST_from_ovenc_parts(SEXP Loffset, SEXP Roffset, SEXP encoding) { SEXP ans, ans_names, ans_names_elt; PROTECT(ans = NEW_LIST(3)); PROTECT(ans_names = NEW_CHARACTER(3)); PROTECT(ans_names_elt = mkChar("Loffset")); SET_STRING_ELT(ans_names, 0, ans_names_elt); UNPROTECT(1); PROTECT(ans_names_elt = mkChar("Roffset")); SET_STRING_ELT(ans_names, 1, ans_names_elt); UNPROTECT(1); PROTECT(ans_names_elt = mkChar("encoding")); SET_STRING_ELT(ans_names, 2, ans_names_elt); UNPROTECT(1); SET_NAMES(ans, ans_names); UNPROTECT(1); SET_VECTOR_ELT(ans, 0, Loffset); SET_VECTOR_ELT(ans, 1, Roffset); SET_VECTOR_ELT(ans, 2, encoding); UNPROTECT(1); return ans; } /* --- .Call ENTRY POINT --- * 'query_start', 'query_width', 'query_space': integer vectors of the same * length M (or NULL for 'query_space'). * 'query_break': single integer. * 'subject_start', 'subject_width', 'subject_space': integer vectors of the * same length N (or NULL for 'subject_space'). * Integer vectors 'query_start', 'query_width', 'subject_start' and * 'subject_width' are assumed to be NA free. 'query_width' and 'subject_width' * are assumed to contain non-negative values. For efficiency reasons, those * assumptions are not checked. * Return the matrix of 1-letter codes (if 'as_matrix' is TRUE), otherwise a * named list with the 3 following components: * 1. Loffset: single integer; * 2. Roffset: single integer; * 3. encoding: the compact encoding as a single string (if 'as_raw' is * FALSE) or a raw vector (if 'as_raw' is TRUE). */ SEXP encode_overlaps1(SEXP query_start, SEXP query_width, SEXP query_space, SEXP query_break, SEXP flip_query, SEXP subject_start, SEXP subject_width, SEXP subject_space, SEXP as_matrix, SEXP as_raw) { int query_break0, flip_query0, as_matrix0, as_raw0, Loffset, Roffset; CharAE *buf; SEXP encoding, ans_Loffset, ans_Roffset, ans; query_break0 = INTEGER(query_break)[0]; flip_query0 = LOGICAL(flip_query)[0]; as_matrix0 = as_matrix != R_NilValue && LOGICAL(as_matrix)[0]; as_raw0 = as_raw != R_NilValue && LOGICAL(as_raw)[0]; buf = new_CharAE(0); overlap_encoding( query_start, query_width, query_space, query_break0, flip_query0, subject_start, subject_width, subject_space, as_matrix0, &Loffset, &Roffset, buf); PROTECT(encoding = make_encoding_from_CharAE(buf, as_raw0 ? 2 : 1, as_matrix0, LENGTH(query_start), query_break0, LENGTH(subject_start))); if (as_matrix0) { UNPROTECT(1); return encoding; } PROTECT(ans_Loffset = ScalarInteger(Loffset)); PROTECT(ans_Roffset = ScalarInteger(Roffset)); PROTECT(ans = make_LIST_from_ovenc_parts(ans_Loffset, ans_Roffset, encoding)); UNPROTECT(4); return ans; } static SEXP RangesList_encode_overlaps_ij( SEXP query_starts, SEXP query_widths, SEXP query_spaces, SEXP query_breaks, SEXP subject_starts, SEXP subject_widths, SEXP subject_spaces, int i, int j, int flip_query, int *Loffset, int *Roffset, CharAE *buf) { SEXP query_start, query_width, query_space, subject_start, subject_width, subject_space; int query_break; query_start = VECTOR_ELT(query_starts, i); query_width = VECTOR_ELT(query_widths, i); if (query_spaces == R_NilValue) query_space = R_NilValue; else query_space = VECTOR_ELT(query_spaces, i); if (query_breaks == R_NilValue) query_break = 0; else query_break = INTEGER(query_breaks)[i]; subject_start = VECTOR_ELT(subject_starts, j); subject_width = VECTOR_ELT(subject_widths, j); if (subject_spaces == R_NilValue) subject_space = R_NilValue; else subject_space = VECTOR_ELT(subject_spaces, j); overlap_encoding( query_start, query_width, query_space, query_break, flip_query, subject_start, subject_width, subject_space, 0, Loffset, Roffset, buf); return make_encoding_from_CharAE(buf, 0, 0, 0, 0, 0); } /* --- .Call ENTRY POINT ---/ * 'query_starts', 'query_widths', 'query_spaces': lists of integer vectors. * The 3 lists are assumed to have the same length (M) and shape. * 'query_breaks': NULL or integer vector of length M. * 'subject_starts', 'subject_widths', 'subject_spaces': lists of integer * vectors. The 3 lists are assumed to have the same length (N) and shape. * Return a named list with the 3 following components (all of the same * length): * 1. Loffset: integer vector; * 2. Roffset: integer vector; * 3. encoding: character vector containing the compact encodings (type * II). */ SEXP RangesList_encode_overlaps(SEXP query_starts, SEXP query_widths, SEXP query_spaces, SEXP query_breaks, SEXP subject_starts, SEXP subject_widths, SEXP subject_spaces) { int q_len, s_len, ans_len, i, j, k; SEXP ans_Loffset, ans_Roffset, ans_encoding, ans_encoding_elt, ans; CharAE *buf; /* TODO: Add some basic checking of the input values. */ q_len = LENGTH(query_starts); s_len = LENGTH(subject_starts); if (q_len == 0 || s_len == 0) ans_len = 0; else ans_len = q_len >= s_len ? q_len : s_len; PROTECT(ans_Loffset = NEW_INTEGER(ans_len)); PROTECT(ans_Roffset = NEW_INTEGER(ans_len)); PROTECT(ans_encoding = NEW_CHARACTER(ans_len)); buf = new_CharAE(0); for (i = j = k = 0; k < ans_len; i++, j++, k++) { if (i >= q_len) i = 0; /* recycle i */ if (j >= s_len) j = 0; /* recycle j */ PROTECT(ans_encoding_elt = RangesList_encode_overlaps_ij( query_starts, query_widths, query_spaces, query_breaks, subject_starts, subject_widths, subject_spaces, i, j, 0, INTEGER(ans_Loffset) + k, INTEGER(ans_Roffset) + k, buf)); SET_STRING_ELT(ans_encoding, k, ans_encoding_elt); UNPROTECT(1); CharAE_set_nelt(buf, 0); } if (ans_len != 0 && (i != q_len || j != s_len)) warning("longer object length is not a multiple " "of shorter object length"); PROTECT(ans = make_LIST_from_ovenc_parts(ans_Loffset, ans_Roffset, ans_encoding)); UNPROTECT(4); return ans; } /* --- .Call ENTRY POINT ---/ * Same arguments as RangesList_encode_overlaps() plus: * 'query_hits', 'subject_hits': integer vectors of the same length. * 'flip_query': logical vector of the same length as 'query_hits'. */ SEXP Hits_encode_overlaps(SEXP query_starts, SEXP query_widths, SEXP query_spaces, SEXP query_breaks, SEXP subject_starts, SEXP subject_widths, SEXP subject_spaces, SEXP query_hits, SEXP subject_hits, SEXP flip_query) { int q_len, s_len, ans_len, i, j, k; const int *q_hits, *s_hits; SEXP ans_Loffset, ans_Roffset, ans_encoding, ans_encoding_elt, ans; CharAE *buf; /* TODO: Add some basic checking of the input values. */ q_len = LENGTH(query_starts); s_len = LENGTH(subject_starts); ans_len = check_integer_pairs(query_hits, subject_hits, &q_hits, &s_hits, "queryHits(hits)", "subjectHits(hits)"); PROTECT(ans_Loffset = NEW_INTEGER(ans_len)); PROTECT(ans_Roffset = NEW_INTEGER(ans_len)); PROTECT(ans_encoding = NEW_CHARACTER(ans_len)); buf = new_CharAE(0); for (k = 0; k < ans_len; k++) { i = q_hits[k]; j = s_hits[k]; if (i == NA_INTEGER || i < 1 || i > q_len || j == NA_INTEGER || j < 1 || j > s_len) { UNPROTECT(3); error("'queryHits(hits)' or 'subjectHits(hits)' " "contain invalid indices"); } i--; j--; PROTECT(ans_encoding_elt = RangesList_encode_overlaps_ij( query_starts, query_widths, query_spaces, query_breaks, subject_starts, subject_widths, subject_spaces, i, j, LOGICAL(flip_query)[k], INTEGER(ans_Loffset) + k, INTEGER(ans_Roffset) + k, buf)); SET_STRING_ELT(ans_encoding, k, ans_encoding_elt); UNPROTECT(1); CharAE_set_nelt(buf, 0); } PROTECT(ans = make_LIST_from_ovenc_parts(ans_Loffset, ans_Roffset, ans_encoding)); UNPROTECT(4); return ans; } GenomicAlignments/tests/0000755000175100017510000000000012607264575016355 5ustar00biocbuildbiocbuildGenomicAlignments/tests/GenomicAlignments_unit_tests.R0000644000175100017510000000006012607264575024360 0ustar00biocbuildbiocbuildBiocGenerics:::testPackage("GenomicAlignments") GenomicAlignments/vignettes/0000755000175100017510000000000012612051202017174 5ustar00biocbuildbiocbuildGenomicAlignments/vignettes/OverlapEncodings.Rnw0000644000175100017510000015776212607264575023177 0ustar00biocbuildbiocbuild%\VignetteIndexEntry{Overlap encodings} %\VignetteDepends{pasillaBamSubset, GenomicAlignments, GenomicFeatures, BSgenome.Dmelanogaster.UCSC.dm3, TxDb.Dmelanogaster.UCSC.dm3.ensGene} %\VignetteKeywords{sequence, sequencing, alignments} %\VignettePackage{GenomicAlignments} \documentclass{article} <>= BiocStyle::latex() @ \title{Overlap encodings} \author{Herv\'e Pag\`es} \date{Last modified: April 2015; Compiled: \today} \begin{document} \maketitle <>= options(width=100) .precomputed_results_dir <- "precomputed_results" .loadPrecomputed <- function(objname) { filename <- paste0(objname, ".rda") path <- file.path(.precomputed_results_dir, filename) tempenv <- new.env(parent=emptyenv()) load(path, envir=tempenv) get(objname, envir=tempenv) } .checkIdenticalToPrecomputed <- function(obj, objname, ignore.metadata=FALSE) { precomputed_obj <- .loadPrecomputed(objname) if (ignore.metadata) metadata(obj) <- metadata(precomputed_obj) <- list() ## Replace NAs with FALSE in circularity flag (because having the flag set ## to NA instead of FALSE (or vice-versa) is not considered a significant ## difference between the 2 objects). isCircular(obj) <- isCircular(obj) %in% TRUE isCircular(precomputed_obj) <- isCircular(precomputed_obj) %in% TRUE if (!identical(obj, precomputed_obj)) stop("'", objname, "' is not identical to precomputed version") } @ \tableofcontents %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{Introduction} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% In the context of an RNA-seq experiment, encoding the overlaps between the aligned reads and the transcripts can be used for detecting those overlaps that are ``compatible'' with the splicing of the transcript. Various tools are provided in the \Rpackage{GenomicAlignments} package for working with {\it overlap encodings}. In this vignette, we illustrate the use of these tools on the single-end and paired-end reads of an RNA-seq experiment. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{Load reads from a BAM file} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{Load single-end reads from a BAM file} BAM file {\tt untreated1\_chr4.bam} (located in the \Rpackage{pasillaBamSubset} data package) contains single-end reads from the ``Pasilla'' experiment and aligned against the dm3 genome (see \Rcode{?untreated1\_chr4} in the \Rpackage{pasillaBamSubset} package for more information about those reads): <>= library(pasillaBamSubset) untreated1_chr4() @ We use the \Rfunction{readGAlignments} function defined in the \Rpackage{GenomicAlignments} package to load the reads into a \Rclass{GAlignments} object. It's probably a good idea to get rid of the PCR or optical duplicates (flag bit 0x400 in the SAM format, see the SAM Spec \footnote{\url{http://samtools.sourceforge.net/}} for the details), as well as reads not passing quality controls (flag bit 0x200 in the SAM format). We do this by creating a \Rclass{ScanBamParam} object that we pass to \Rcode{readGAlignments} (see \Rcode{?ScanBamParam} in the \Rpackage{Rsamtools} package for the details). Note that we also use \Rcode{use.names=TRUE} in order to load the {\it query names} (aka {\it query template names}, see QNAME field in the SAM Spec) from the BAM file (\Rcode{readGAlignments} will use them to set the names of the returned object): <>= library(GenomicAlignments) flag0 <- scanBamFlag(isDuplicate=FALSE, isNotPassingQualityControls=FALSE) param0 <- ScanBamParam(flag=flag0) U1.GAL <- readGAlignments(untreated1_chr4(), use.names=TRUE, param=param0) head(U1.GAL) @ Because the aligner used to align those reads can report more than 1 alignment per {\it original query} (i.e. per read stored in the input file, typically a FASTQ file), we shouldn't expect the names of \Rcode{U1.GAL} to be unique: <>= U1.GAL_names_is_dup <- duplicated(names(U1.GAL)) table(U1.GAL_names_is_dup) @ Storing the {\it query names} in a factor will be useful as we will see later in this document: <>= U1.uqnames <- unique(names(U1.GAL)) U1.GAL_qnames <- factor(names(U1.GAL), levels=U1.uqnames) @ Note that we explicitely provide the levels of the factor to enforce their order. Otherwise \Rcode{factor()} would put them in lexicographic order which is not advisable because it depends on the locale in use. Another object that will be useful to keep near at hand is the mapping between each {\it query name} and its first occurence in \Rcode{U1.GAL\_qnames}: <>= U1.GAL_dup2unq <- match(U1.GAL_qnames, U1.GAL_qnames) @ Our reads can have up to 2 gaps (a gap corresponds to an N operation in the CIGAR): <>= head(unique(cigar(U1.GAL))) table(njunc(U1.GAL)) @ Also, the following table indicates that indels were not allowed/supported during the alignment process (no I or D CIGAR operations): <>= colSums(cigarOpTable(cigar(U1.GAL))) @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{Load paired-end reads from a BAM file} BAM file {\tt untreated3\_chr4.bam} (located in the \Rpackage{pasillaBamSubset} data package) contains paired-end reads from the ``Pasilla'' experiment and aligned against the dm3 genome (see \Rcode{?untreated3\_chr4} in the \Rpackage{pasillaBamSubset} package for more information about those reads). We use the \Rfunction{readGAlignmentPairs} function to load them into a \Rclass{GAlignmentPairs} object: <>= U3.galp <- readGAlignmentPairs(untreated3_chr4(), use.names=TRUE, param=param0) head(U3.galp) @ The \Rcode{show} method for \Rclass{GAlignmentPairs} objects displays two {\tt ranges} columns, one for the {\it first} alignment in the pair (the left column), and one for the {\it last} alignment in the pair (the right column). The {\tt strand} column corresponds to the strand of the {\it first} alignment. <>= head(first(U3.galp)) head(last(U3.galp)) @ According to the SAM format specifications, the aligner is expected to mark each alignment pair as {\it proper} or not (flag bit 0x2 in the SAM format). The SAM Spec only says that a pair is {\it proper} if the {\it first} and {\it last} alignments in the pair are ``properly aligned according to the aligner''. So the exact criteria used for setting this flag is left to the aligner. We use \Rcode{isProperPair} to extract this flag from the \Rclass{GAlignmentPairs} object: <>= table(isProperPair(U3.galp)) @ Even though we could do {\it overlap encodings} with the full object, we keep only the {\it proper} pairs for our downstream analysis: <>= U3.GALP <- U3.galp[isProperPair(U3.galp)] @ Because the aligner used to align those reads can report more than 1 alignment per {\it original query template} (i.e. per pair of sequences stored in the input files, typically 1 FASTQ file for the {\it first} ends and 1 FASTQ file for the {\it last} ends), we shouldn't expect the names of \Rcode{U3.GALP} to be unique: <>= U3.GALP_names_is_dup <- duplicated(names(U3.GALP)) table(U3.GALP_names_is_dup) @ Storing the {\it query template names} in a factor will be useful: <>= U3.uqnames <- unique(names(U3.GALP)) U3.GALP_qnames <- factor(names(U3.GALP), levels=U3.uqnames) @ as well as having the mapping between each {\it query template name} and its first occurence in \Rcode{U3.GALP\_qnames}: <>= U3.GALP_dup2unq <- match(U3.GALP_qnames, U3.GALP_qnames) @ Our reads can have up to 1 gap per end: <>= head(unique(cigar(first(U3.GALP)))) head(unique(cigar(last(U3.GALP)))) table(njunc(first(U3.GALP)), njunc(last(U3.GALP))) @ Like for our single-end reads, the following tables indicate that indels were not allowed/supported during the alignment process: <>= colSums(cigarOpTable(cigar(first(U3.GALP)))) colSums(cigarOpTable(cigar(last(U3.GALP)))) @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{Find all the overlaps between the reads and transcripts} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{Load the transcripts from a \Rclass{TxDb} object} In order to compute overlaps between reads and transcripts, we need access to the genomic positions of a set of known transcripts and their exons. It is essential that the reference genome of this set of transcripts and exons be {\bf exactly} the same as the reference genome used to align the reads. We could use the \Rfunction{makeTxDbFromUCSC} function defined in the \Rpackage{GenomicFeatures} package to make a \Rclass{TxDb} object containing the dm3 transcripts and their exons retrieved from the UCSC Genome Browser\footnote{\url{http://genome.ucsc.edu/cgi-bin/hgGateway}}. The Bioconductor project however provides a few annotation packages containing \Rclass{TxDb} objects for the most commonly studied organisms (those data packages are sometimes called the {\it TxDb} packages). One of them is the \Rpackage{TxDb.Dmelanogaster.\-UCSC.\-dm3.ensGene} package. It contains a \Rclass{TxDb} object that was made by pointing the \Rfunction{makeTxDbFromUCSC} function to the dm3 genome and {\it Ensembl Genes} track \footnote{See \url{http://genome.ucsc.edu/cgi-bin/hgTrackUi?hgsid=276880911&g=ensGene} for a description of this track.}. We can use it here: <>= library(TxDb.Dmelanogaster.UCSC.dm3.ensGene) TxDb.Dmelanogaster.UCSC.dm3.ensGene txdb <- TxDb.Dmelanogaster.UCSC.dm3.ensGene @ We extract the exons grouped by transcript in a \Rclass{GRangesList} object: <>= exbytx <- exonsBy(txdb, by="tx", use.names=TRUE) length(exbytx) # nb of transcripts @ <>= .checkIdenticalToPrecomputed(exbytx, "exbytx", ignore.metadata=TRUE) @ We check that all the exons in any given transcript belong to the same chromosome and strand. Knowing that our set of transcripts is free of this sort of trans-splicing events typically allows some significant simplifications during the downstream analysis \footnote{Dealing with trans-splicing events is not covered in this document.}. A quick and easy way to check this is to take advantage of the fact that \Rcode{seqnames} and \Rcode{strand} return \Rclass{RleList} objects. So we can extract the number of Rle runs for each transcript and make sure it's always 1: <>= table(elementLengths(runLength(seqnames(exbytx)))) table(elementLengths(runLength(strand(exbytx)))) @ Therefore the strand of any given transcript is unambiguously defined and can be extracted with: <>= exbytx_strand <- unlist(runValue(strand(exbytx)), use.names=FALSE) @ We will also need the mapping between the transcripts and their gene. We start by using \Rfunction{transcripts} to extract this information from our \Rclass{TxDb} object \Rcode{txdb}, and then we construct a named factor that represents the mapping: <>= tx <- transcripts(txdb, columns=c("tx_name", "gene_id")) head(tx) df <- mcols(tx) exbytx2gene <- as.character(df$gene_id) exbytx2gene <- factor(exbytx2gene, levels=unique(exbytx2gene)) names(exbytx2gene) <- df$tx_name exbytx2gene <- exbytx2gene[names(exbytx)] head(exbytx2gene) nlevels(exbytx2gene) # nb of genes @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{Single-end overlaps} \subsubsection{Find the single-end overlaps} We are ready to compute the overlaps with the \Rfunction{findOverlaps} function. Note that the strand of the queries produced by the RNA-seq experiment is typically unknown so we use \Rcode{ignore.strand=TRUE}: <>= U1.OV00 <- findOverlaps(U1.GAL, exbytx, ignore.strand=TRUE) @ \Rcode{U1.OV00} is a \Rclass{Hits} object that contains 1 element per overlap. Its length gives the number of overlaps: <>= length(U1.OV00) @ \subsubsection{Tabulate the single-end overlaps} We will repeatedly use the 2 following little helper functions to ``tabulate'' the overlaps in a given \Rclass{Hits} object (e.g. \Rcode{U1.OV00}), i.e. to count the number of overlaps for each element in the query or for each element in the subject: <>= nhitPerQuery <- function(x) tabulate(queryHits(x), nbins=queryLength(x)) nhitPerSubject <- function(x) tabulate(subjectHits(x), nbins=subjectLength(x)) @ Number of transcripts for each alignment in \Rcode{U1.GAL}: <>= U1.GAL_ntx <- nhitPerQuery(U1.OV00) mcols(U1.GAL)$ntx <- U1.GAL_ntx head(U1.GAL) table(U1.GAL_ntx) mean(U1.GAL_ntx >= 1) @ 76\% of the alignments in \Rcode{U1.GAL} have an overlap with at least 1 transcript in \Rcode{exbytx}. Note that \Rfunction{countOverlaps} can be used directly on \Rcode{U1.GAL} and \Rcode{exbytx} for computing \Rcode{U1.GAL\_ntx}: <>= U1.GAL_ntx_again <- countOverlaps(U1.GAL, exbytx, ignore.strand=TRUE) stopifnot(identical(unname(U1.GAL_ntx_again), U1.GAL_ntx)) @ Because \Rcode{U1.GAL} can (and actually does) contain more than 1 alignment per {\it original query} (aka read), we also count the number of transcripts for each read: <>= U1.OV10 <- remapHits(U1.OV00, query.map=U1.GAL_qnames) U1.uqnames_ntx <- nhitPerQuery(U1.OV10) names(U1.uqnames_ntx) <- U1.uqnames table(U1.uqnames_ntx) mean(U1.uqnames_ntx >= 1) @ 78.4\% of the reads have an overlap with at least 1 transcript in \Rcode{exbytx}. Number of reads for each transcript: <>= U1.exbytx_nOV10 <- nhitPerSubject(U1.OV10) names(U1.exbytx_nOV10) <- names(exbytx) mean(U1.exbytx_nOV10 >= 50) @ Only 0.869\% of the transcripts in \Rcode{exbytx} have an overlap with at least 50 reads. Top 10 transcripts: <>= head(sort(U1.exbytx_nOV10, decreasing=TRUE), n=10) @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{Paired-end overlaps} \subsubsection{Find the paired-end overlaps} Like with our single-end overlaps, we call \Rfunction{findOverlaps} with \Rcode{ignore.strand=TRUE}: <>= U3.OV00 <- findOverlaps(U3.GALP, exbytx, ignore.strand=TRUE) @ Like \Rcode{U1.OV00}, \Rcode{U3.OV00} is a \Rclass{Hits} object. Its length gives the number of paired-end overlaps: <>= length(U3.OV00) @ \subsubsection{Tabulate the paired-end overlaps} Number of transcripts for each alignment pair in \Rcode{U3.GALP}: <>= U3.GALP_ntx <- nhitPerQuery(U3.OV00) mcols(U3.GALP)$ntx <- U3.GALP_ntx head(U3.GALP) table(U3.GALP_ntx) mean(U3.GALP_ntx >= 1) @ 71\% of the alignment pairs in \Rcode{U3.GALP} have an overlap with at least 1 transcript in \Rcode{exbytx}. Note that \Rfunction{countOverlaps} can be used directly on \Rcode{U3.GALP} and \Rcode{exbytx} for computing \Rcode{U3.GALP\_ntx}: <>= U3.GALP_ntx_again <- countOverlaps(U3.GALP, exbytx, ignore.strand=TRUE) stopifnot(identical(unname(U3.GALP_ntx_again), U3.GALP_ntx)) @ Because \Rcode{U3.GALP} can (and actually does) contain more than 1 alignment pair per {\it original query template}, we also count the number of transcripts for each template: <>= U3.OV10 <- remapHits(U3.OV00, query.map=U3.GALP_qnames) U3.uqnames_ntx <- nhitPerQuery(U3.OV10) names(U3.uqnames_ntx) <- U3.uqnames table(U3.uqnames_ntx) mean(U3.uqnames_ntx >= 1) @ 72.3\% of the templates have an overlap with at least 1 transcript in \Rcode{exbytx}. Number of templates for each transcript: <>= U3.exbytx_nOV10 <- nhitPerSubject(U3.OV10) names(U3.exbytx_nOV10) <- names(exbytx) mean(U3.exbytx_nOV10 >= 50) @ Only 0.756\% of the transcripts in \Rcode{exbytx} have an overlap with at least 50 templates. Top 10 transcripts: <>= head(sort(U3.exbytx_nOV10, decreasing=TRUE), n=10) @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{Encode the overlaps between the reads and transcripts} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{Single-end encodings} The {\it overlap encodings} are strand sensitive so we will compute them twice, once for the ``original alignments'' (i.e. the alignments of the {\it original queries}), and once again for the ``flipped alignments'' (i.e. the alignments of the ``flipped {\it original queries}''). We extract the ranges of the ``original'' and ``flipped'' alignments in 2 \Rclass{GRangesList} objects with: <>= U1.grl <- grglist(U1.GAL, order.as.in.query=TRUE) U1.grlf <- flipQuery(U1.grl) # flipped @ and encode their overlaps with the transcripts: <>= U1.ovencA <- encodeOverlaps(U1.grl, exbytx, hits=U1.OV00) U1.ovencB <- encodeOverlaps(U1.grlf, exbytx, hits=U1.OV00) @ \Rcode{U1.ovencA} and \Rcode{U1.ovencB} are 2 \Rclass{OverlapsEncodings} objects of the same length as \Rclass{Hits} object \Rcode{U1.OV00}. For each hit in \Rcode{U1.OV00}, we have 2 corresponding encodings, one in \Rcode{U1.ovencA} and one in \Rcode{U1.ovencB}, but only one of them encodes a hit between alignment ranges and exon ranges that are on the same strand. We use the \Rfunction{selectEncodingWithCompatibleStrand} function to merge them into a single \Rclass{OverlapsEncodings} of the same length. For each hit in \Rcode{U1.OV00}, this selects the encoding corresponding to alignment ranges and exon ranges with compatible strand: <>= U1.grl_strand <- unlist(runValue(strand(U1.grl)), use.names=FALSE) U1.ovenc <- selectEncodingWithCompatibleStrand(U1.ovencA, U1.ovencB, U1.grl_strand, exbytx_strand, hits=U1.OV00) U1.ovenc @ As a convenience, the 2 above calls to \Rfunction{encodeOverlaps} + merging step can be replaced by a single call to \Rfunction{encodeOverlaps} on \Rcode{U1.grl} (or \Rcode{U1.grlf}) with \Rcode{flip.query.if.wrong.strand=TRUE}: <>= U1.ovenc_again <- encodeOverlaps(U1.grl, exbytx, hits=U1.OV00, flip.query.if.wrong.strand=TRUE) stopifnot(identical(U1.ovenc_again, U1.ovenc)) @ Unique encodings in \Rcode{U1.ovenc}: <>= U1.unique_encodings <- levels(U1.ovenc) length(U1.unique_encodings) head(U1.unique_encodings) U1.ovenc_table <- table(encoding(U1.ovenc)) tail(sort(U1.ovenc_table)) @ Encodings are sort of cryptic but utilities are provided to extract specific meaning from them. Use of these utilities is covered later in this document. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{Paired-end encodings} Let's encode the overlaps in \Rcode{U3.OV00}: <>= U3.grl <- grglist(U3.GALP) U3.ovenc <- encodeOverlaps(U3.grl, exbytx, hits=U3.OV00, flip.query.if.wrong.strand=TRUE) U3.ovenc @ Unique encodings in \Rcode{U3.ovenc}: <>= U3.unique_encodings <- levels(U3.ovenc) length(U3.unique_encodings) head(U3.unique_encodings) U3.ovenc_table <- table(encoding(U3.ovenc)) tail(sort(U3.ovenc_table)) @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{``Compatible'' overlaps} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% We are interested in a particular type of overlap where the read overlaps the transcript in a ``compatible'' way, that is, in a way compatible with the splicing of the transcript. The \Rfunction{isCompatibleWithSplicing} function can be used on an \Rclass{OverlapEncodings} object to detect this type of overlap. Note that \Rfunction{isCompatibleWithSplicing} can also be used on a character vector or factor. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{``Compatible'' single-end overlaps} \subsubsection{``Compatible'' single-end encodings} \Rcode{U1.ovenc} contains 7 unique encodings ``compatible'' with the splicing of the transcript: <>= sort(U1.ovenc_table[isCompatibleWithSplicing(U1.unique_encodings)]) @ Encodings \Rcode{"1:i:"} (455176 occurences in \Rcode{U1.ovenc}), \Rcode{"2:jm:af:"} (72929 occurences in \Rcode{U1.ovenc}), and \Rcode{"3:jmm:agm:aaf:"} (488 occurences in \Rcode{U1.ovenc}), correspond to the following overlaps: \begin{itemize} \item \Rcode{"1:i:"} \begin{verbatim} - read (no gap): oooooooo - transcript: ... >>>>>>>>>>>>>> ... \end{verbatim} \item \Rcode{"2:jm:af:"} \begin{verbatim} - read (1 gap): ooooo---ooo - transcript: ... >>>>>>>>> >>>>>>>>> ... \end{verbatim} \item \Rcode{"3:jmm:agm:aaf:"} \begin{verbatim} - read (2 gaps): oo---ooooo---o - transcript: ... >>>>>>>> >>>>> >>>>>>> ... \end{verbatim} \end{itemize} For clarity, only the exons involved in the overlap are represented. The transcript can of course have more upstream and downstream exons, which is denoted by the ... on the left side (5' end) and right side (3' end) of each drawing. Note that the exons represented in the 2nd and 3rd drawings are consecutive and adjacent in the processed transcript. Encodings \Rcode{"1:f:"} and \Rcode{"1:j:"} are variations of the situation described by encoding \Rcode{"1:i:"}. For \Rcode{"1:f:"}, the first aligned base of the read (or ``flipped'' read) is aligned with the first base of the exon. For \Rcode{"1:j:"}, the last aligned base of the read (or ``flipped'' read) is aligned with the last base of the exon: \begin{itemize} \item \Rcode{"1:f:"} \begin{verbatim} - read (no gap): oooooooo - transcript: ... >>>>>>>>>>>>>> ... \end{verbatim} \item \Rcode{"1:j:"} \begin{verbatim} - read (no gap): oooooooo - transcript: ... >>>>>>>>>>>>>> ... \end{verbatim} \end{itemize} <>= U1.OV00_is_comp <- isCompatibleWithSplicing(U1.ovenc) table(U1.OV00_is_comp) # 531797 "compatible" overlaps @ Finally, let's extract the ``compatible'' overlaps from \Rcode{U1.OV00}: <>= U1.compOV00 <- U1.OV00[U1.OV00_is_comp] @ Note that high-level convenience wrapper \Rfunction{findCompatibleOverlaps} can be used for computing the ``compatible'' overlaps directly between a \Rclass{GAlignments} object (containing reads) and a \Rclass{GRangesList} object (containing transcripts): <>= U1.compOV00_again <- findCompatibleOverlaps(U1.GAL, exbytx) stopifnot(identical(U1.compOV00_again, U1.compOV00)) @ \subsubsection{Tabulate the ``compatible'' single-end overlaps} Number of ``compatible'' transcripts for each alignment in \Rcode{U1.GAL}: <>= U1.GAL_ncomptx <- nhitPerQuery(U1.compOV00) mcols(U1.GAL)$ncomptx <- U1.GAL_ncomptx head(U1.GAL) table(U1.GAL_ncomptx) mean(U1.GAL_ncomptx >= 1) @ 75\% of the alignments in \Rcode{U1.GAL} are ``compatible'' with at least 1 transcript in \Rcode{exbytx}. Note that high-level convenience wrapper \Rfunction{countCompatibleOverlaps} can be used directly on \Rcode{U1.GAL} and \Rcode{exbytx} for computing \Rcode{U1.GAL\_ncomptx}: <>= U1.GAL_ncomptx_again <- countCompatibleOverlaps(U1.GAL, exbytx) stopifnot(identical(U1.GAL_ncomptx_again, U1.GAL_ncomptx)) @ Number of ``compatible'' transcripts for each read: <>= U1.compOV10 <- remapHits(U1.compOV00, query.map=U1.GAL_qnames) U1.uqnames_ncomptx <- nhitPerQuery(U1.compOV10) names(U1.uqnames_ncomptx) <- U1.uqnames table(U1.uqnames_ncomptx) mean(U1.uqnames_ncomptx >= 1) @ 77.5\% of the reads are ``compatible'' with at least 1 transcript in \Rcode{exbytx}. Number of ``compatible'' reads for each transcript: <>= U1.exbytx_ncompOV10 <- nhitPerSubject(U1.compOV10) names(U1.exbytx_ncompOV10) <- names(exbytx) mean(U1.exbytx_ncompOV10 >= 50) @ Only 0.87\% of the transcripts in \Rcode{exbytx} are ``compatible'' with at least 50 reads. Top 10 transcripts: <>= head(sort(U1.exbytx_ncompOV10, decreasing=TRUE), n=10) @ Note that this ``top 10'' is slightly different from the ``top 10'' we obtained earlier when we counted {\bf all} the overlaps. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{``Compatible'' paired-end overlaps} \subsubsection{``Compatible'' paired-end encodings} \Rcode{U3.ovenc} contains 13 unique paired-end encodings ``compatible'' with the splicing of the transcript: <>= sort(U3.ovenc_table[isCompatibleWithSplicing(U3.unique_encodings)]) @ Paired-end encodings \Rcode{"1{-}{-}1:i{-}{-}i:"} (100084 occurences in \Rcode{U3.ovenc}), \Rcode{"2{-}{-}1:jm{-}{-}m:af{-}{-}i:"} (2700 occurences in \Rcode{U3.ovenc}), \Rcode{"1{-}{-}2:i{-}{-}jm:a{-}{-}af:"} (2480 occurences in \Rcode{U3.ovenc}), \Rcode{"1{-}{-}1:i{-}{-}m:a{-}{-}i:"} (287 occurences in \Rcode{U3.ovenc}), and \Rcode{"2{-}{-}2:jm{-}{-}mm:af{-}{-}jm:aa{-}{-}af:"} (153 occurences in \Rcode{U3.ovenc}), correspond to the following paired-end overlaps: \begin{itemize} \item \Rcode{"1{-}{-}1:i{-}{-}i:"} \begin{verbatim} - paired-end read (no gap on the first end, no gap on the last end): oooo oooo - transcript: ... >>>>>>>>>>>>>>>> ... \end{verbatim} \item \Rcode{"2{-}{-}1:jm{-}{-}m:af{-}{-}i:"} \begin{verbatim} - paired-end read (1 gap on the first end, no gap on the last end): ooo---o oooo - transcript: ... >>>>>>>> >>>>>>>>>>> ... \end{verbatim} \item \Rcode{"1{-}{-}2:i{-}{-}jm:a{-}{-}af:"} \begin{verbatim} - paired-end read (no gap on the first end, 1 gap on the last end): oooo oo---oo - transcript: ... >>>>>>>>>>>>>> >>>>>>>>> ... \end{verbatim} \item \Rcode{"1{-}{-}1:i{-}{-}m:a{-}{-}i:"} \begin{verbatim} - paired-end read (no gap on the first end, no gap on the last end): oooo oooo - transcript: ... >>>>>>>>> >>>>>>> ... \end{verbatim} \item \Rcode{"2{-}{-}2:jm{-}{-}mm:af{-}{-}jm:aa{-}{-}af:"} \begin{verbatim} - paired-end read (1 gap on the first end, 1 gap on the last end): ooo---o oo---oo - transcript: ... >>>>>> >>>>>>> >>>>> ... \end{verbatim} \end{itemize} Note: switch use of ``first'' and ``last'' above if the read was ``flipped''. <>= U3.OV00_is_comp <- isCompatibleWithSplicing(U3.ovenc) table(U3.OV00_is_comp) # 106835 "compatible" paired-end overlaps @ Finally, let's extract the ``compatible'' paired-end overlaps from \Rcode{U3.OV00}: <>= U3.compOV00 <- U3.OV00[U3.OV00_is_comp] @ Note that, like with our single-end reads, high-level convenience wrapper \Rfunction{findCompatibleOverlaps} can be used for computing the ``compatible'' paired-end overlaps directly between a \Rclass{GAlignmentPairs} object (containing paired-end reads) and a \Rclass{GRangesList} object (containing transcripts): <>= U3.compOV00_again <- findCompatibleOverlaps(U3.GALP, exbytx) stopifnot(identical(U3.compOV00_again, U3.compOV00)) @ \subsubsection{Tabulate the ``compatible'' paired-end overlaps} Number of ``compatible'' transcripts for each alignment pair in \Rcode{U3.GALP}: <>= U3.GALP_ncomptx <- nhitPerQuery(U3.compOV00) mcols(U3.GALP)$ncomptx <- U3.GALP_ncomptx head(U3.GALP) table(U3.GALP_ncomptx) mean(U3.GALP_ncomptx >= 1) @ 69.7\% of the alignment pairs in \Rcode{U3.GALP} are ``compatible'' with at least 1 transcript in \Rcode{exbytx}. Note that high-level convenience wrapper \Rfunction{countCompatibleOverlaps} can be used directly on \Rcode{U3.GALP} and \Rcode{exbytx} for computing \Rcode{U3.GALP\_ncomptx}: <>= U3.GALP_ncomptx_again <- countCompatibleOverlaps(U3.GALP, exbytx) stopifnot(identical(U3.GALP_ncomptx_again, U3.GALP_ncomptx)) @ Number of ``compatible'' transcripts for each template: <>= U3.compOV10 <- remapHits(U3.compOV00, query.map=U3.GALP_qnames) U3.uqnames_ncomptx <- nhitPerQuery(U3.compOV10) names(U3.uqnames_ncomptx) <- U3.uqnames table(U3.uqnames_ncomptx) mean(U3.uqnames_ncomptx >= 1) @ 70.7\% of the templates are ``compatible'' with at least 1 transcript in \Rcode{exbytx}. Number of ``compatible'' templates for each transcript: <>= U3.exbytx_ncompOV10 <- nhitPerSubject(U3.compOV10) names(U3.exbytx_ncompOV10) <- names(exbytx) mean(U3.exbytx_ncompOV10 >= 50) @ Only 0.7\% of the transcripts in \Rcode{exbytx} are ``compatible'' with at least 50 templates. Top 10 transcripts: <>= head(sort(U3.exbytx_ncompOV10, decreasing=TRUE), n=10) @ Note that this ``top 10'' is slightly different from the ``top 10'' we obtained earlier when we counted {\bf all} the paired-end overlaps. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{Compute the {\it reference query sequences} and project them on the transcriptome} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{Compute the {\it reference query sequences}} The {\it reference query sequences} are the query sequences {\bf after} alignment, by opposition to the {\it original query sequences} (aka ``true'' or ``real'' query sequences) which are the query sequences {\bf before} alignment. The {\it reference query sequences} can easily be computed by extracting the nucleotides mapped to each read from the reference genome. This of course requires that we have access to the reference genome used by the aligner. In Bioconductor, the full genome sequence for the dm3 assembly is stored in the \Rpackage{BSgenome.Dmelanogaster.UCSC.dm3} data package \footnote{See \url{http://bioconductor.org/packages/release/data/annotation/} for the full list of annotation packages available in the current release of Bioconductor.}: <>= library(BSgenome.Dmelanogaster.UCSC.dm3) Dmelanogaster @ To extract the portions of the reference genome corresponding to the ranges in \Rcode{U1.grl}, we can use the \Rfunction{extractTranscriptSeqs} function defined in the \Rpackage{GenomicFeatures} package: <>= library(GenomicFeatures) U1.GAL_rqseq <- extractTranscriptSeqs(Dmelanogaster, U1.grl) head(U1.GAL_rqseq) @ When reads are paired-end, we need to extract separately the ranges corresponding to their {\it first} ends (aka {\it first} segments in BAM jargon) and those corresponding to their {\it last} ends (aka {\it last} segments in BAM jargon): <>= U3.grl_first <- grglist(first(U3.GALP, real.strand=TRUE), order.as.in.query=TRUE) U3.grl_last <- grglist(last(U3.GALP, real.strand=TRUE), order.as.in.query=TRUE) @ Then we extract the portions of the reference genome corresponding to the ranges in \Rclass{GRangesList} objects \Rcode{U3.grl\_first} and \Rcode{U3.grl\_last}: <>= U3.GALP_rqseq1 <- extractTranscriptSeqs(Dmelanogaster, U3.grl_first) U3.GALP_rqseq2 <- extractTranscriptSeqs(Dmelanogaster, U3.grl_last) @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{Project the single-end alignments on the transcriptome} The \Rfunction{extractQueryStartInTranscript} function computes for each overlap the position of the {\it query start} in the transcript: <>= U1.OV00_qstart <- extractQueryStartInTranscript(U1.grl, exbytx, hits=U1.OV00, ovenc=U1.ovenc) head(subset(U1.OV00_qstart, U1.OV00_is_comp)) @ \Rcode{U1.OV00\_qstart} is a data frame with 1 row per overlap and 3 columns: \begin{enumerate} \item \Rcode{startInTranscript}: the 1-based start position of the read with respect to the transcript. Position 1 always corresponds to the first base on the 5' end of the transcript sequence. \item \Rcode{firstSpannedExonRank}: the rank of the first exon spanned by the read, that is, the rank of the exon found at position \Rcode{startInTranscript} in the transcript. \item \Rcode{startInFirstSpannedExon}: the 1-based start position of the read with respect to the first exon spanned by the read. \end{enumerate} Having this information allows us for example to compare the read and transcript nucleotide sequences for each ``compatible'' overlap. If we use the {\it reference query sequence} instead of the {\it original query sequence} for this comparison, then it should match {\bf exactly} the sequence found at the {\it query start} in the transcript. Let's start by using \Rfunction{extractTranscriptSeqs} again to extract the transcript sequences (aka transcriptome) from the dm3 reference genome: <>= txseq <- extractTranscriptSeqs(Dmelanogaster, exbytx) @ For each ``compatible'' overlap, the read sequence in \Rcode{U1.GAL\_rqseq} must be an {\it exact} substring of the transcript sequence in \Rcode{exbytx\_seq}: <>= U1.OV00_rqseq <- U1.GAL_rqseq[queryHits(U1.OV00)] U1.OV00_rqseq[flippedQuery(U1.ovenc)] <- reverseComplement(U1.OV00_rqseq[flippedQuery(U1.ovenc)]) U1.OV00_txseq <- txseq[subjectHits(U1.OV00)] stopifnot(all( U1.OV00_rqseq[U1.OV00_is_comp] == narrow(U1.OV00_txseq[U1.OV00_is_comp], start=U1.OV00_qstart$startInTranscript[U1.OV00_is_comp], width=width(U1.OV00_rqseq)[U1.OV00_is_comp]) )) @ Because of this relationship between the {\it reference query sequence} and the transcript sequence of a ``compatible'' overlap, and because of the relationship between the {\it original query sequences} and the {\it reference query sequences}, then the edit distance reported in the NM tag is actually the edit distance between the {\it original query} and the transcript of a ``compatible'' overlap. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{Project the paired-end alignments on the transcriptome} For a paired-end read, the {\it query start} is the start of its ``left end''. <>= U3.OV00_Lqstart <- extractQueryStartInTranscript(U3.grl, exbytx, hits=U3.OV00, ovenc=U3.ovenc) head(subset(U3.OV00_Lqstart, U3.OV00_is_comp)) @ Note that \Rfunction{extractQueryStartInTranscript} can be called with \Rcode{for.query.right.end=TRUE} if we want this information for the ``right ends'' of the reads: <>= U3.OV00_Rqstart <- extractQueryStartInTranscript(U3.grl, exbytx, hits=U3.OV00, ovenc=U3.ovenc, for.query.right.end=TRUE) head(subset(U3.OV00_Rqstart, U3.OV00_is_comp)) @ Like with single-end reads, having this information allows us for example to compare the read and transcript nucleotide sequences for each ``compatible'' overlap. If we use the {\it reference query sequence} instead of the {\it original query sequence} for this comparison, then it should match {\bf exactly} the sequences of the ``left'' and ``right'' ends of the read in the transcript. Let's assign the ``left and right reference query sequences'' to each overlap: <>= U3.OV00_Lrqseq <- U3.GALP_rqseq1[queryHits(U3.OV00)] U3.OV00_Rrqseq <- U3.GALP_rqseq2[queryHits(U3.OV00)] @ For the single-end reads, the sequence associated with a ``flipped query'' just needed to be ``reverse complemented''. For paired-end reads, we also need to swap the 2 sequences in the pair: <>= flip_idx <- which(flippedQuery(U3.ovenc)) tmp <- U3.OV00_Lrqseq[flip_idx] U3.OV00_Lrqseq[flip_idx] <- reverseComplement(U3.OV00_Rrqseq[flip_idx]) U3.OV00_Rrqseq[flip_idx] <- reverseComplement(tmp) @ Let's assign the transcript sequence to each overlap: <>= U3.OV00_txseq <- txseq[subjectHits(U3.OV00)] @ For each ``compatible'' overlap, we expect the ``left and right reference query sequences'' of the read to be {\it exact} substrings of the transcript sequence. Let's check the ``left reference query sequences'': <>= stopifnot(all( U3.OV00_Lrqseq[U3.OV00_is_comp] == narrow(U3.OV00_txseq[U3.OV00_is_comp], start=U3.OV00_Lqstart$startInTranscript[U3.OV00_is_comp], width=width(U3.OV00_Lrqseq)[U3.OV00_is_comp]) )) @ and the ``right reference query sequences'': <>= stopifnot(all( U3.OV00_Rrqseq[U3.OV00_is_comp] == narrow(U3.OV00_txseq[U3.OV00_is_comp], start=U3.OV00_Rqstart$startInTranscript[U3.OV00_is_comp], width=width(U3.OV00_Rrqseq)[U3.OV00_is_comp]) )) @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{Align the reads to the transcriptome} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% Aligning the reads to the reference genome is not the most efficient nor accurate way to count the number of ``compatible'' overlaps per {\it original query}. Supporting junction reads (i.e. reads that align with at least 1 gap) introduces a significant computational cost during the alignment process. Then, as we've seen in the previous sections, each alignment produced by the aligner needs to be broken into a set of ranges (based on its CIGAR) and those ranges compared to the ranges of the exons grouped by transcript. A more straightforward and accurate approach is to align the reads directly to the transcriptome, and without allowing the typical gap that the aligner needs to introduce when aligning a junction read to the reference genome. With this approach, a ``hit'' between a read and a transcript is necessarily compatible with the splicing of the transcript. In case of a ``hit'', we'll say that the read and the transcript are ``string-based compatible'' (to differentiate from our previous notion of ``compatible'' overlaps that we will call ``encoding-based compatible'' from now on, unless the context is clear). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{Align the single-end reads to the transcriptome} \subsubsection{Find the ``hits''} The single-end reads are in \Rcode{U1.oqseq}, the transcriptome is in \Rcode{exbytx\_seq}. Since indels were not allowed/supported during the alignment of the reads to the reference genome, we don't need to allow/support them either for aligning the reads to the transcriptome. Also since our goal is to find (and count) ``compatible'' overlaps between reads and transcripts, we don't need to keep track of the details of the alignments between the reads and the transcripts. Finally, since BAM file {\tt untreated1\_chr4.bam} is not the full output of the aligner but the subset obtained by keeping only the alignments located on chr4, we don't need to align \Rcode{U1.oqseq} to the full transcriptome, but only to the subset of \Rcode{exbytx\_seq} made of the transcripts located on chr4. With those simplifications in mind, we write the following function that we will use to find the ``hits'' between the reads and the transcriptome: <>= ### A wrapper to vwhichPDict() that supports IUPAC ambiguity codes in 'qseq' ### and 'txseq', and treats them as such. findSequenceHits <- function(qseq, txseq, which.txseq=NULL, max.mismatch=0) { .asHits <- function(x, pattern_length) { query_hits <- unlist(x) if (is.null(query_hits)) query_hits <- integer(0) subject_hits <- rep.int(seq_len(length(x)), elementLengths(x)) Hits(query_hits, subject_hits, pattern_length, length(x)) } .isHitInTranscriptBounds <- function(hits, qseq, txseq) { sapply(seq_len(length(hits)), function(i) { pattern <- qseq[[queryHits(hits)[i]]] subject <- txseq[[subjectHits(hits)[i]]] v <- matchPattern(pattern, subject, max.mismatch=max.mismatch, fixed=FALSE) any(1L <= start(v) & end(v) <= length(subject)) }) } if (!is.null(which.txseq)) { txseq0 <- txseq txseq <- txseq[which.txseq] } names(qseq) <- NULL other <- alphabetFrequency(qseq, baseOnly=TRUE)[ , "other"] is_clean <- other == 0L # "clean" means "no IUPAC ambiguity code" ## Find hits for "clean" original queries. qseq0 <- qseq[is_clean] pdict0 <- PDict(qseq0, max.mismatch=max.mismatch) m0 <- vwhichPDict(pdict0, txseq, max.mismatch=max.mismatch, fixed="pattern") hits0 <- .asHits(m0, length(qseq0)) hits0@queryLength <- length(qseq) hits0@queryHits <- which(is_clean)[hits0@queryHits] ## Find hits for non "clean" original queries. qseq1 <- qseq[!is_clean] m1 <- vwhichPDict(qseq1, txseq, max.mismatch=max.mismatch, fixed=FALSE) hits1 <- .asHits(m1, length(qseq1)) hits1@queryLength <- length(qseq) hits1@queryHits <- which(!is_clean)[hits1@queryHits] ## Combine the hits. query_hits <- c(queryHits(hits0), queryHits(hits1)) subject_hits <- c(subjectHits(hits0), subjectHits(hits1)) if (!is.null(which.txseq)) { ## Remap the hits. txseq <- txseq0 subject_hits <- which.txseq[subject_hits] hits0@subjectLength <- length(txseq) } ## Order the hits. oo <- S4Vectors:::orderIntegerPairs(query_hits, subject_hits) hits0@queryHits <- query_hits[oo] hits0@subjectHits <- subject_hits[oo] if (max.mismatch != 0L) { ## Keep only "in bounds" hits. is_in_bounds <- .isHitInTranscriptBounds(hits0, qseq, txseq) hits0 <- hits0[is_in_bounds] } hits0 } @ Let's compute the index of the transcripts in \Rcode{exbytx\_seq} located on chr4 (\Rfunction{findSequenceHits} will restrict the search to those transcripts): <>= chr4tx <- transcripts(txdb, vals=list(tx_chrom="chr4")) chr4txnames <- mcols(chr4tx)$tx_name which.txseq <- match(chr4txnames, names(txseq)) @ We know that the aligner tolerated up to 6 mismatches per read. The 3 following commands find the ``hits'' for each {\it original query}, then find the ``hits'' for each ``flipped {\it original query}'', and finally merge all the ``hits'' (note that the 3 commands take about 1 hour to complete on a modern laptop): <>= U1.sbcompHITSa <- findSequenceHits(U1.oqseq, txseq, which.txseq=which.txseq, max.mismatch=6) U1.sbcompHITSb <- findSequenceHits(reverseComplement(U1.oqseq), txseq, which.txseq=which.txseq, max.mismatch=6) U1.sbcompHITS <- union(U1.sbcompHITSa, U1.sbcompHITSb) @ <>= U1.sbcompHITSa <- .loadPrecomputed("U1.sbcompHITSa") U1.sbcompHITSb <- .loadPrecomputed("U1.sbcompHITSb") U1.sbcompHITS <- union(U1.sbcompHITSa, U1.sbcompHITSb) @ \subsubsection{Tabulate the ``hits''} Number of ``string-based compatible'' transcripts for each read: <>= U1.uqnames_nsbcomptx <- nhitPerQuery(U1.sbcompHITS) names(U1.uqnames_nsbcomptx) <- U1.uqnames table(U1.uqnames_nsbcomptx) mean(U1.uqnames_nsbcomptx >= 1) @ 77.7\% of the reads are ``string-based compatible'' with at least 1 transcript in \Rcode{exbytx}. Number of ``string-based compatible'' reads for each transcript: <>= U1.exbytx_nsbcompHITS <- nhitPerSubject(U1.sbcompHITS) names(U1.exbytx_nsbcompHITS) <- names(exbytx) mean(U1.exbytx_nsbcompHITS >= 50) @ Only 0.865\% of the transcripts in \Rcode{exbytx} are ``string-based compatible'' with at least 50 reads. Top 10 transcripts: <>= head(sort(U1.exbytx_nsbcompHITS, decreasing=TRUE), n=10) @ \subsubsection{A closer look at the ``hits''} [WORK IN PROGRESS, might be removed or replaced soon...] Any ``encoding-based compatible'' overlap is of course ``string-based compatible'': <>= stopifnot(length(setdiff(U1.compOV10, U1.sbcompHITS)) == 0) @ but the reverse is not true: <>= length(setdiff(U1.sbcompHITS, U1.compOV10)) @ %To understand why the {\it overlap encodings} approach doesn't find all %the ``string-based compatible'' hits, let's look at the second hit in %\Rcode{setdiff(U1.sbcompHITS, U1.compOV10)}. This is a perfect hit between %read SRR031728.4692406 and transcript 18924: % %<<>>= %matchPattern(U1.oqseq[[6306]], txseq[[18924]]) %U1.GAL_idx <- which(U1.GAL_qnames == "SRR031728.4692406") %U1.GAL[U1.GAL_idx] %U1.GAL_idx %in% queryHits(U1.OV00) %U1.GAL[12636] %which(queryHits(U1.OV00) == 12636) %U1.OV00[305] %as.character(encoding(U1.ovenc)[305]) %@ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{Align the paired-end reads to the transcriptome} [COMING SOON...] %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{``Almost compatible'' overlaps} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% In many aspects, ``compatible'' overlaps can be seen as perfect. We are now insterested in a less perfect type of overlap where the read overlaps the transcript in a way that {\it would} be ``compatible'' if 1 or more exons were removed from the transcript. In that case we say that the overlap is ``almost compatible'' with the transcript. The \Rfunction{isCompatibleWithSkippedExons} function can be used on an \Rclass{OverlapEncodings} object to detect this type of overlap. Note that \Rfunction{isCompatibleWithSkippedExons} can also be used on a character vector of factor. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{``Almost compatible'' single-end overlaps} \subsubsection{``Almost compatible'' single-end encodings} \Rcode{U1.ovenc} contains 7 unique encodings ``almost compatible'' with the splicing of the transcript: <>= sort(U1.ovenc_table[isCompatibleWithSkippedExons(U1.unique_encodings)]) @ Encodings \Rcode{"2:jm:am:af:"} (1015 occurences in \Rcode{U1.ovenc}), \Rcode{"2:jm:am:am:af:"} (144 occurences in \Rcode{U1.ovenc}), and \Rcode{"3:jmm:agm:aam:aaf:"} (21 occurences in \Rcode{U1.ovenc}), correspond to the following overlaps: \begin{itemize} \item \Rcode{"2:jm:am:af:"} \begin{verbatim} - read (1 gap): ooooo----------ooo - transcript: ... >>>>>>> >>>> >>>>>>>> ... \end{verbatim} \item \Rcode{"2:jm:am:am:af:"} \begin{verbatim} - read (1 gap): ooooo------------------ooo - transcript: ... >>>>>>> >>>> >>>>> >>>>>>>> ... \end{verbatim} \item \Rcode{"3:jmm:agm:aam:aaf:"} \begin{verbatim} - read (2 gaps): oo---oooo-----------oo - transcript: ... >>>>>>> >>>> >>>>> >>>>>>>> ... \end{verbatim} \end{itemize} <>= U1.OV00_is_acomp <- isCompatibleWithSkippedExons(U1.ovenc) table(U1.OV00_is_acomp) # 1202 "almost compatible" overlaps @ Finally, let's extract the ``almost compatible'' overlaps from \Rcode{U1.OV00}: <>= U1.acompOV00 <- U1.OV00[U1.OV00_is_acomp] @ \subsubsection{Tabulate the ``almost compatible'' single-end overlaps} Number of ``almost compatible'' transcripts for each alignment in \Rcode{U1.GAL}: <>= U1.GAL_nacomptx <- nhitPerQuery(U1.acompOV00) mcols(U1.GAL)$nacomptx <- U1.GAL_nacomptx head(U1.GAL) table(U1.GAL_nacomptx) mean(U1.GAL_nacomptx >= 1) @ Only 0.27\% of the alignments in \Rcode{U1.GAL} are ``almost compatible'' with at least 1 transcript in \Rcode{exbytx}. Number of ``almost compatible'' alignments for each transcript: <>= U1.exbytx_nacompOV00 <- nhitPerSubject(U1.acompOV00) names(U1.exbytx_nacompOV00) <- names(exbytx) table(U1.exbytx_nacompOV00) mean(U1.exbytx_nacompOV00 >= 50) @ Only 0.017\% of the transcripts in \Rcode{exbytx} are ``almost compatible'' with at least 50 alignments in \Rcode{U1.GAL}. Finally note that the ``query start in transcript'' values returned by \Rfunction{extractQueryStartInTranscript} are also defined for ``almost compatible'' overlaps: <>= head(subset(U1.OV00_qstart, U1.OV00_is_acomp)) @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{``Almost compatible'' paired-end overlaps} \subsubsection{``Almost compatible'' paired-end encodings} \Rcode{U3.ovenc} contains 5 unique paired-end encodings ``almost compatible'' with the splicing of the transcript: <>= sort(U3.ovenc_table[isCompatibleWithSkippedExons(U3.unique_encodings)]) @ Paired-end encodings \Rcode{"2{-}{-}1:jm{-}{-}m:am{-}{-}m:af{-}{-}i:"} (73 occurences in \Rcode{U3.ovenc}), \Rcode{"1{-}{-}2:i{-}{-}jm:a{-}{-}am:a{-}{-}af:"} (53 occurences in \Rcode{U3.ovenc}), and \Rcode{"2{-}{-}2:jm{-}{-}mm:am{-}{-}mm:af{-}{-}jm:aa{-}{-}af:"} (9 occurences in \Rcode{U3.ovenc}), correspond to the following paired-end overlaps: \begin{itemize} \item \Rcode{"2{-}{-}1:jm{-}{-}m:am{-}{-}m:af{-}{-}i:"} \begin{verbatim} - paired-end read (1 gap on the first end, no gap on the last end): ooo----------o oooo - transcript: ... >>>>> >>>> >>>>>>>>> ... \end{verbatim} \item \Rcode{"1{-}{-}2:i{-}{-}jm:a{-}{-}am:a{-}{-}af:"} \begin{verbatim} - paired-end read (no gap on the first end, 1 gap on the last end): oooo oo---------oo - transcript: ... >>>>>>>>>>> >>> >>>>>> ... \end{verbatim} \item \Rcode{"2{-}{-}2:jm{-}{-}mm:am{-}{-}mm:af{-}{-}jm:aa{-}{-}af:"} \begin{verbatim} - paired-end read (1 gap on the first end, 1 gap on the last end): o----------ooo oo---oo - transcript: ... >>>>> >>>> >>>>>>>> >>>>>> ... \end{verbatim} \end{itemize} Note: switch use of ``first'' and ``last'' above if the read was ``flipped''. <>= U3.OV00_is_acomp <- isCompatibleWithSkippedExons(U3.ovenc) table(U3.OV00_is_acomp) # 141 "almost compatible" paired-end overlaps @ Finally, let's extract the ``almost compatible'' paired-end overlaps from \Rcode{U3.OV00}: <>= U3.acompOV00 <- U3.OV00[U3.OV00_is_acomp] @ \subsubsection{Tabulate the ``almost compatible'' paired-end overlaps} Number of ``almost compatible'' transcripts for each alignment pair in \Rcode{U3.GALP}: <>= U3.GALP_nacomptx <- nhitPerQuery(U3.acompOV00) mcols(U3.GALP)$nacomptx <- U3.GALP_nacomptx head(U3.GALP) table(U3.GALP_nacomptx) mean(U3.GALP_nacomptx >= 1) @ Only 0.2\% of the alignment pairs in \Rcode{U3.GALP} are ``almost compatible'' with at least 1 transcript in \Rcode{exbytx}. Number of ``almost compatible'' alignment pairs for each transcript: <>= U3.exbytx_nacompOV00 <- nhitPerSubject(U3.acompOV00) names(U3.exbytx_nacompOV00) <- names(exbytx) table(U3.exbytx_nacompOV00) mean(U3.exbytx_nacompOV00 >= 50) @ Only 0.0034\% of the transcripts in \Rcode{exbytx} are ``almost compatible'' with at least 50 alignment pairs in \Rcode{U3.GALP}. Finally note that the ``query start in transcript'' values returned by \Rfunction{extractQueryStartInTranscript} are also defined for ``almost compatible'' paired-end overlaps: <>= head(subset(U3.OV00_Lqstart, U3.OV00_is_acomp)) head(subset(U3.OV00_Rqstart, U3.OV00_is_acomp)) @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{Detect novel splice junctions} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{By looking at single-end overlaps} An alignment in \Rcode{U1.GAL} with ``almost compatible'' overlaps but no ``compatible'' overlaps suggests the presence of one or more transcripts that are not in our annotations. First we extract the index of those alignments ({\it nsj} here stands for ``{\bf n}ovel {\bf s}plice {\bf j}unction''): <>= U1.GAL_is_nsj <- U1.GAL_nacomptx != 0L & U1.GAL_ncomptx == 0L head(which(U1.GAL_is_nsj)) @ We make this an index into \Rcode{U1.OV00}: <>= U1.OV00_is_nsj <- queryHits(U1.OV00) %in% which(U1.GAL_is_nsj) @ We intersect with \Rcode{U1.OV00\_is\_acomp} and then subset \Rcode{U1.OV00} to keep only the overlaps that suggest novel splicing: <>= U1.OV00_is_nsj <- U1.OV00_is_nsj & U1.OV00_is_acomp U1.nsjOV00 <- U1.OV00[U1.OV00_is_nsj] @ For each overlap in \Rcode{U1.nsjOV00}, we extract the ranks of the skipped exons (we use a list for this as there might be more than 1 skipped exon per overlap): <>= U1.nsjOV00_skippedex <- extractSkippedExonRanks(U1.ovenc)[U1.OV00_is_nsj] names(U1.nsjOV00_skippedex) <- queryHits(U1.nsjOV00) table(elementLengths(U1.nsjOV00_skippedex)) @ Finally, we split \Rcode{U1.nsjOV00\_skippedex} by transcript names: <>= f <- factor(names(exbytx)[subjectHits(U1.nsjOV00)], levels=names(exbytx)) U1.exbytx_skippedex <- split(U1.nsjOV00_skippedex, f) @ \Rcode{U1.exbytx\_skippedex} is a named list of named lists of integer vectors. The first level of names (outer names) are transcript names and the second level of names (inner names) are alignment indices into \Rcode{U1.GAL}: <>= head(names(U1.exbytx_skippedex)) # transcript names @ Transcript FBtr0089124 receives 7 hits. All of them skip exons 9 and 10: <>= U1.exbytx_skippedex$FBtr0089124 @ Transcript FBtr0089147 receives 4 hits. Two of them skip exon 2, one of them skips exons 2 to 6, and one of them skips exon 10: <>= U1.exbytx_skippedex$FBtr0089147 @ A few words about the interpretation of \Rcode{U1.exbytx\_skippedex}: Because of how we've conducted this analysis, the aligments reported in \Rcode{U1.exbytx\_skippedex} are guaranteed to not have any ``compatible'' overlaps with other known transcripts. All we can say, for example in the case of transcript FBtr0089124, is that the 7 reported hits that skip exons 9 and 10 show evidence of one or more unknown transcripts with a splice junction that corresponds to the gap between exons 8 and 11. But without further analysis, we can't make any assumption about the exons structure of those unknown transcripts. In particular, we cannot assume the existence of an unknown transcript made of the same exons as transcript FBtr0089124 minus exons 9 and 10! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{By looking at paired-end overlaps} [COMING SOON...] %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{\Rcode{sessionInfo()}} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% <>= sessionInfo() @ \end{document} GenomicAlignments/vignettes/WorkingWithAlignedNucleotides.Rnw0000644000175100017510000003411612607264575025657 0ustar00biocbuildbiocbuild%\VignetteIndexEntry{Working with aligned nucleotides} %\VignetteDepends{GenomicAlignments, RNAseqData.HNRNPC.bam.chr14, pasillaBamSubset, BSgenome.Hsapiens.UCSC.hg19, BSgenome.Dmelanogaster.UCSC.dm3, GenomicFeatures, TxDb.Hsapiens.UCSC.hg19.knownGene, TxDb.Dmelanogaster.UCSC.dm3.ensGene} %\VignetteKeywords{sequence, sequencing, alignments} %\VignettePackage{GenomicAlignments} \documentclass{article} <>= BiocStyle::latex() @ \title{Working with aligned nucleotides (WORK-IN-PROGRESS!)} \author{Herv\'e Pag\`es} \date{Last modified: January 2014; Compiled: \today} \begin{document} \maketitle \tableofcontents %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{Introduction} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% This vignette belongs to the \Rpackage{GenomicAlignments} package. It illustrates how to use the package for working with the nucleotide content of aligned reads. After the reads generated by a high-throughput sequencing experiment have been aligned to a reference genome, the questions that are being asked about these alignments typically fall in two broad categories: {\bf positional only} and {\bf nucleotide-related}. {\bf Positional only} questions are about the position of the alignments with respect to the reference genome. Note that the position of an alignment is actually better described in terms of genomic ranges (1 range for an alignment with no gaps, 2 or more ranges for an alignment with gaps). Knowing the ranges of the alignments is sufficient to perform common tasks like {\it read counting} or for {\it computing the coverage}. {\it Read counting} is the process of counting the number of aligned reads per gene or exon and is typically performed in the context of a differential analysis. This task can be accomplished with the \Rfunction{summarizeOverlaps} function provided in the \Rpackage{GenomicAlignments} package and is explained in details in the ``Counting reads with summarizeOverlaps'' vignette (also located in this package). {\it Computing the coverage} is often the preliminary step to peak detection (ChIP-seq analysis) or to a copy number analysis. It can be accomplished with the \Rfunction{coverage} function. See \Rcode{?\`{}coverage-methods\`{}} for more information. {\bf Nucleotide-related} questions are about the nucleotide content of the alignments. In particular how this content compares to the corresponding nucleotides in the reference genome. These questions typically arise in the context of small genetic variation detection between one or more samples and a reference genome. The \Rpackage{GenomicAlignments} package provides a suite of low- to mid-level tools for dealing with {\bf nucleotide-related} questions about the alignments. In this vignette we illustrate their use on the single-end and paired-end reads of an RNA-seq experiment. Note that these tools do NOT constitute a complete variant toolbox. If this is what you're looking for, other \Bioconductor{} packages might be more appropriate. See the GeneticVariability and SNP views at this URL \url{http://bioconductor.org/packages/release/BiocViews.html#___AssayDomains} for a complete list of packages that deal with small genetic variations. Most of them provide tools of higher level than the tools described in this vignette. See for example the \Rpackage{VariantTools} and \Rpackage{VariantAnnotation} packages for a complete variant toolbox (including variant calling capabilities). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{Load the aligned reads and their sequences from a BAM file} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% In this section, we illustrate how aligned reads and their sequences can be loaded from a BAM file. The reads we're going to use for this are paired-end reads from a published study by Zarnack et al., 2012. A subset of these reads are stored in the BAM files located in the \Rpackage{RNAseqData.HNRNPC.bam.chr14} data package. The package contains 8 BAM files, 1 per sequencing run: <>= library(RNAseqData.HNRNPC.bam.chr14) bamfiles <- RNAseqData.HNRNPC.bam.chr14_BAMFILES names(bamfiles) # the names of the runs @ Each BAM file was obtained by (1) aligning the reads (paired-end) to the full hg19 genome with TopHat2, and then (2) subsetting to keep only alignments on chr14. See \Rcode{?RNAseqData.HNRNPC.bam.chr14} for more information about this data set. As a preliminary step, we check whether the BAM files contain single- or paired-end alignments. This can be done with the \Rfunction{quickBamFlagSummary} utility from the \Rpackage{Rsamtools} package: <>= library(Rsamtools) quickBamFlagSummary(bamfiles[1], main.groups.only=TRUE) @ This confirms that all the alignments in the 1st BAM file (run ERR127306) are paired-end. This means that we should preferably load them with the \Rfunction{readGAlignmentPairs} function from the \Rpackage{GenomicAlignments} package. However for the purpose of keeping things simple, we will ignore the pairing for now and load only the alignments corresponding to the first segment of the pairs. We will use the \Rfunction{readGAlignments} function from the \Rpackage{GenomicAlignments} package for this, together with a \Rclass{ScanBamParam} object for the filtering. See \Rcode{?ScanBamParam} in the \Rpackage{Rsamtools} package for the details. Furthermore, while preparing the \Rclass{ScanBamParam} object to perform the filtering, we'll also get rid of the PCR or optical duplicates (flag bit 0x400 in the SAM format, see the SAM Spec \footnote{\url{http://samtools.sourceforge.net/}} for the details), as well as reads not passing quality controls (flag bit 0x200 in the SAM format). Finally we also request the read sequences (a.k.a. the {\it segment sequences} in the SAM Spec, stored in the SEQ field) via the \Rclass{ScanBamParam} object: <>= flag1 <- scanBamFlag(isFirstMateRead=TRUE, isSecondMateRead=FALSE, isDuplicate=FALSE, isNotPassingQualityControls=FALSE) param1 <- ScanBamParam(flag=flag1, what="seq") @ We're now ready to load the alignments and their sequences. Note that we use \Rcode{use.names=TRUE} in order to also load the {\it query names} (a.k.a. the {\it query template names} in the SAM Spec, stored in the QNAME field) from the BAM file. \Rfunction{readGAlignments} will use them to set the names of the returned object: <>= library(GenomicAlignments) gal1 <- readGAlignments(bamfiles[1], use.names=TRUE, param=param1) @ This returns a \Rclass{GAlignments} object. The read sequences are stored in the \Rcode{seq} metadata column of the object: <>= mcols(gal1)$seq @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{Compute the {\it original query sequences}} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% Because the BAM format imposes that the read sequence is ``reverse complemented'' when a read aligns to the minus strand, we need to ``reverse complement'' it again to restore the {\it original query sequences} (i.e. the sequences before alignment, that is, as they can be seen in the FASTQ file assuming that the aligner didn't perform any hard-clipping on them): <>= oqseq1 <- mcols(gal1)$seq is_on_minus <- as.logical(strand(gal1) == "-") oqseq1[is_on_minus] <- reverseComplement(oqseq1[is_on_minus]) @ Because the aligner used to align the reads can report more than 1 alignment per read (i.e. per sequence stored in the FASTQ file), we shouldn't expect the names of \Rcode{gal1} to be unique: <>= is_dup <- duplicated(names(gal1)) table(is_dup) @ However, sequences with the same {\it query name} should correspond to the same {\it original query} and therefore should be the same. Let's do a quick sanity check: <>= dup2unq <- match(names(gal1), names(gal1)) stopifnot(all(oqseq1 == oqseq1[dup2unq])) @ Finally, let's reduce \Rcode{oqseq1} to one {\it original query sequence} per unique {\it query name} (like in the FASTQ file containing the 1st end of the unaligned reads): <>= oqseq1 <- oqseq1[!is_dup] @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{Mismatches, indels, and gaps} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% Because the aligner possibly tolerated a small number of mismatches, indels, and/or gaps during the alignment process, the sequences in \Rcode{mcols(gal1)\$seq} gnerally don't match exactly the reference genome. The information of where indels and/or gaps occur in the alignments is represented in the CIGAR strings. Let's have a look at these string. First the most frequent cigars: <>= head(sort(table(cigar(gal1)), decreasing=TRUE)) @ Then a summary of the total number of insertions (I), deletions (D), and gaps (N): <>= colSums(cigarOpTable(cigar(gal1))) @ This tells us that the aligner that was used supports indels (I/D) and junction reads (N). Finally we count and summarize the number of gaps per alignment: <>= table(njunc(gal1)) @ Some reads contain up to 3 gaps (i.e. span 3 splice junctions). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{Put the read sequences and reference sequences ``side by side''} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% TODO (with \Rfunction{sequenceLayer}) %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{OLD STUFF (needs to be recycled/updated)} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{Load paired-end reads from a BAM file} BAM file {\tt untreated3\_chr4.bam} (located in the \Rpackage{pasillaBamSubset} data package) contains paired-end reads from the ``Pasilla'' experiment and aligned against the dm3 genome (see \Rcode{?untreated3\_chr4} in the \Rpackage{pasillaBamSubset} package for more information about those reads). We use the \Rfunction{readGAlignmentPairs} function to load them into a \Rclass{GAlignmentPairs} object: <>= library(pasillaBamSubset) flag0 <- scanBamFlag(isDuplicate=FALSE, isNotPassingQualityControls=FALSE) param0 <- ScanBamParam(flag=flag0) U3.galp <- readGAlignmentPairs(untreated3_chr4(), use.names=TRUE, param=param0) head(U3.galp) @ The \Rcode{show} method for \Rclass{GAlignmentPairs} objects displays two {\tt ranges} columns, one for the {\it first} alignment in the pair (the left column), and one for the {\it last} alignment in the pair (the right column). The {\tt strand} column corresponds to the strand of the {\it first} alignment. <>= head(first(U3.galp)) head(last(U3.galp)) @ According to the SAM format specifications, the aligner is expected to mark each alignment pair as {\it proper} or not (flag bit 0x2 in the SAM format). The SAM Spec only says that a pair is {\it proper} if the {\it first} and {\it last} alignments in the pair are ``properly aligned according to the aligner''. So the exact criteria used for setting this flag is left to the aligner. We use \Rcode{isProperPair} to extract this flag from the \Rclass{GAlignmentPairs} object: <>= table(isProperPair(U3.galp)) @ Even though we could do {\it overlap encodings} with the full object, we keep only the {\it proper} pairs for our downstream analysis: <>= U3.GALP <- U3.galp[isProperPair(U3.galp)] @ Because the aligner used to align those reads can report more than 1 alignment per {\it original query template} (i.e. per pair of sequences stored in the input files, typically 1 FASTQ file for the {\it first} ends and 1 FASTQ file for the {\it last} ends), we shouldn't expect the names of \Rcode{U3.GALP} to be unique: <>= U3.GALP_names_is_dup <- duplicated(names(U3.GALP)) table(U3.GALP_names_is_dup) @ Storing the {\it query template names} in a factor will be useful: <>= U3.uqnames <- unique(names(U3.GALP)) U3.GALP_qnames <- factor(names(U3.GALP), levels=U3.uqnames) @ as well as having the mapping between each {\it query template name} and its first occurence in \Rcode{U3.GALP\_qnames}: <>= U3.GALP_dup2unq <- match(U3.GALP_qnames, U3.GALP_qnames) @ Our reads can have up to 1 gap per end: <>= head(unique(cigar(first(U3.GALP)))) head(unique(cigar(last(U3.GALP)))) table(njunc(first(U3.GALP)), njunc(last(U3.GALP))) @ Like for our single-end reads, the following tables indicate that indels were not allowed/supported during the alignment process: <>= colSums(cigarOpTable(cigar(first(U3.GALP)))) colSums(cigarOpTable(cigar(last(U3.GALP)))) @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{\Rcode{sessionInfo()}} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% <>= sessionInfo() @ \end{document} GenomicAlignments/vignettes/precomputed_results/0000755000175100017510000000000012607264575023333 5ustar00biocbuildbiocbuildGenomicAlignments/vignettes/precomputed_results/U1.sbcompHITSa.rda0000644000175100017510000044220412607264575026431 0ustar00biocbuildbiocbuilduU?n?t")ݝ"("]"t H݂"" Jw#! _Zkzq̚k͚s]~фO#3VԷcF} kҺE vi*WyN+3O$i돻Uoݱ'~L*慢<˧-ogηy0*P좫ON΁Ϟ?3xƗ_?gtFg|WQD_QDbz!~ 1'į!Xbq%!Xbu5!ֆXbk!@!8Hc!8~'oic"^!H"QC$B!RH"M!^ .DYBd -D9C 7DBXCT!^ z7B Q>DCT Q=[!jV!Q'DB44D-B *DmB .!> !DC|KCt eB|G!zo~!C|CC 1"C 16ĸCL11ĤCL cBL1#B !#ĢC, ,B&B!Bl #?!vbw=!b!8T!΄7Bjk!f!xۋ"^!H"q$!H"eC >DCd j!Jx-DBvwCA!hif!ZhU6!چh_&D=B'߇bha!FbT!ƄbJCL 1;o!Xbq%!Xbu5!6bk?Cbg]!b_!8D!./7B q+wB q/B< -]B$0DIC<"yB:DCd+DyC ?DC Q4K!x9D%Bd2! Q1DCT Q5DC Q;!x'DB~!hI!څhC|sCt IOC|kn!M!zB 7D߅>cBL1=?bQ!քXb]M!6b!8hc!8d3! q6ĹCr+!v{!xq'!"f!x.!HB!DBd%DB +DyB /DEB RCQ"+!^ z*!x+DmC >G!> 5!!bX!FbT!Ƅb\!&br)!~ 1-O!fb^B !(KB, ,Ċ+C :Bl#! 3Į{B /B q8đ'B q*BR!V!xaG!x[!b"N!H"Q$!H"y!RH"M !2"Kl!"g\!r@! (%C Q:!Q&ě!ʆ(r*!zBQ+DQ!he!څx?!> )D4DC3ķ!_!.?bX!Fb\!&bR!~ 1=B XbqK"XG2`}"`g"Gp b"Ep=܌Vw"G1vq"AD,"x>#AF= wy#A FP$A^JFP*Tb"AEP=AEn"hAEa"A>KDiE5#|W|AzFm#A`HC#FG0&`|#L`Z?E0=̊`vF0/,`qK"XG2U`K[#;`#8Ep<Tg#8.Dp9+\F"Ep?C#A>KDiE5/"2":o"AD]#>"D04`Lc#&D01IL`j")̈`f"E[D(`Uk"XD5"D7}@#8NDp.\b"nDp3[[_DuD0 "FE0> L`R#f=ĢC, 4IJC &B!Bl%+?!vX! ew!8H!8.Ep5܋A#x[TLň f"AF,C$BT!RH"mC >DCd 5D枬9D9Yfy5dYQ$Dgbxş3J>3J?gTQ%DC2DC >!>a!:(D,!7B 1,#B 1:B19Ĕ?bZBL13ĬC 17ļbAC, <Ċ[Bl WB +ĞBq8ĩ@̒r[Q掬Q3C֨ [T;J(Del $8J(Q<[T\̝-el-*fʰ٢rhQ2EvٲGw٢]\<|((xŞ3?3<3=3zFg|Fg:x3{Fg4|Fg4~Fg4}Fgum#h|A:G%O"4|AG#|A~`P#FG0&IL`Z3"fGsD0'e,`Mk#X6F)9%5-W`{`G.Gp%܊vw"߲ 8$4,| y e } C s K k [ G g W w O _ @`PpdT7eUojjjx/ 0(8$4,<">~c@@/==C##, ,, +=#ws WWwOOW_11 /RR2rrr JJ^ x#P&flBFn@@@@@@@@@@@ǁ.O>|2U7o}}Ffff~ ,X#($4,<2:&9-g`_@`PpHhXdTLl\bRrJjZzFv^~QqIj+^ A a Q q I i Y@@@@@@@@@@@@@@+W%eUU55o 44 4 4 4 4  |01QSs@zzz |!0(080$040,0<0"020*0:0&0.0>0!050-S`z`F`f`V`v/9_s~, , , ,   l ll ;O`g`W`w`O`oPhXDdTtl\|BrzFNn^~Aaj+F v n ^ ~ A k [ { G g W`PphXxD|Bbjv@@@@@@@> t|,y{wo_``A!1q9_sVVV66 l      888xxHHHx!"2*:&69%;7/P(P8P$P4RD@7eoj 4 4 4 |$YWo)0=0#030+sy  VVV66 l  \\ -]! "R R#-^DdFdE6D.FCDaAqR(&ʢʣ*:j6F4D#4A3D+F舏  >n_k1 1 c01 10300`~\B,b,rJlDTȳ%-=wN^a1i9\U\um=<7b!.# GrHTHtȄȉ\ȇ(b(x^(򨎷UFu%j[/ʻQGyyި:y̜7^獪yּQj.7*+2Ui33~ XXXXXXXX;O`g`W`w`O`o`_`@`PpHXxDdTtLKˁ+k[;{ǁ'+_@@@@@@@@uEݧ|Qh/.k%* 勚GEݧ|Q)_TqEe|QsN&_;/E|Q3H3u6_Թ:|Q/EO3>_~|Q/jE|Q{/j֞/jf|Q|QQQu7(QEI%*s2vQjc?*[%j`QfQ~a>blS0Kl&hJ\V DYT@u| > _'`(a8F`$Fg9X ؈ъ@y4g~0 ` P pHhhE+c%Va-a6c+E+I , <'ߢD+ q I ϡ%+(RxeQPPj&j]4@#tBVb7.F{%.!> !!1 )!r#!? `)n^ _?; 0C00#00c011 1?b*'9s1K˰+ k /l{ppGpp'ppg/E\e\U\uMm]}!1Fb &b!6 .!9$ HTHx ِ9PE2JD)xe&ʢ<*"*2*:B-:xuQ1Z ڢtE7|0 K4Z~iKpwqQ%Q :@]ûx :3>F|n33Va5`c6b3`+O؁vbvcbNN Yy\K븁۸xGxѢ[؈HHdx/ R!5 -^D:dB6dGBnD!F D]û ˱`/8N_F$AqME9GTD%TF{hhhh6hS|_ktGķ~?`cbFb`,a&b"nq2:@YT@%T[xu9ZZ ڢf`6c. nnF*kb & HHH"x /8JZwP0C1 0?b*~tLl90 ;,b,R,rJjZzlFlfl6;7Nn^~AaQqIi8sq qWq q7qwppOEh1q Iɐi 9yPPEP/^EIBi7Po,ʡ<*:jjm;zx!)9ZZ }|舏 1> W=ߢz?; 10#1 1c11 1?'Ll_0s1a,,rJzl&lVl_؎؉=؋}8C8888qp.2*:nn. Fj7b" .9DtG] >g _K|o=ߢzc@|01C1 1#1 1c111 1?b*'L ,s+b~|,X?K ˱+ k [ /l؅؃؇8888888qp.. nn Fb &b!6 .!> !!1 )9C4D#4F4E34G D+FE;LJ耎] >g/%7o }{񘀉S1 ?a:f`&fa6~0 ;,b,R,rJjZzlFlflVlß ۱.>!1 )8ppWpp7p qwqO4ZT<1  IGrHTH4H Y ّ_c Fba&f7,2*l&lie\h%: D/(xLDL031 3~yX؄-؆?U~)9 QQo DYCyT@ETAUTCuZQ.]{hhhhhhhhxCt@G|N茏3t/%=-z7/?; 0C00#00c0001?b~tLl_0b.7K˰+k['v; {qqqGq q'q q,<.?\%\\5\ -=<ģhU` cfb6~/0 ;bc a9V`%Vc a=6``+/l؃88#8c883p..*:n6.>!q-b"b#"#"# 9C4D#4F4E34G D+A[C{!:#>B'tF|Ost_k|^荾0 ` P p(XxLDL0300?_؎{qqGpp'p q,<.?\e\U\uMm]}w,XXXXXXX؀؄؂؆;7Nn^~A1 )8󸀋븉[;{xGx'x-j1 qR %R!5 -^D:GdD&dFdE6dGBnA>GD!FK(Q% ^EIBiME9GTD%TFTE5T[xuE}hFh&hfhhVh6hvh>DtG] >g _K| z[BoA_ 0 h8LDLL4阁`~\o a1`)a9V`%Vavc/NN Yy\K+k[;{xGx'x-UE؈HHHH<@JBjAZtH ȈLȌ,ȊlȎȉ\ȍ<ȋ|ȏ(B("(P /8J(x (r( J*jP5Q 6E=x M-m|舏  > ]9 |5Aw@O|^>~=~  0 L$LL4阉Ys0c~BEX%XeXXUX5X؀؄؂؆?c?؉؃؇88888888pqp7q qwqOEh1q IGrHTH4H Y ّ9 yQQQEeG D)kxo DYCyT@ETBeTAUTCuZQ.>C4D#4F4E34G D+FE;:#tBg|.3t/%=-z7/?{A!aQ1񘀉ɘ1cfbfg9s1a>w,XXXXXXX؀؄؊ma;vo؅؃؇8888888qp.. nn Fb &b!6 .!> !!1 )9C4D#4F4E34G D+FE;:#tBg|.3t/%=-z7/?; 0C00#00c0000S#bcfbfy c!",,2, *:l&ll6;7Nn^~AaQqIi8s8 q qWq q7q qwqOEŃh1q IGrHTH4H Y ّ9 yQQQEeG WQPu2xeQQQ QUQ j&j6FwQ ZZ ڢ}|:3>F|Ost_k|聞胾0  0 dL lyX?K + ۱.>!1 )8ppWpq7q qwqOEh1q IGrHTH4H Y ّ yQQEP/^Fq+x%Q ^(7QPPPUPPojjm;wQ ZZ ڢ}|:3>F|Ost_k|聞}{A!aQ1q I)030?y cc bcVb5bc6b6Ol؅؃؇8888888qpppWpq7q qwqO4ZTK1 qIGrHTHxY9yPQEe+x%Qu7QPPUP j&jm;zx!1)9Z%Z5ڠ-ڡ=>耎 > ]9 | z[BoA_C wa0`(aFbFc bc"&a2GL4Y ,,2, *Zlfl6l؅؋}؏88c88S83gq.2*:n6 F1q IG D*FCdDVdGBnA~@ABaAQ(x$J52xQQ QQoA]ûhhfhV膞~?`cb`&b~,/ K ˱ k[vo؍888 qp7pqwqO1qɐ/"#2"3 +!;r 'r# (^FIk(r( x 5Q o=4FS4C DE;:3>Ƨ芯=ߢ?` aa8F`$Fc,c&b`*afa~%XXUXuX؆7vb_yK+۸xGGB$B2@tX/Kk'1Dڊh #Ra3N.G{7)2"*!)9Z%Z5ڢڣ>B'|OA|^ȅ((jhNyXK+ava YK븁۸{xGx'x-\G+7QQ5Q Mm>zb&fc1bcVbVc a=6`#6a3`+c?؅؃}؏8s8xѢP؈Ȃȉ\ȍ<ȋ|ȏ("(P /8J(x (r( J*jP5Q 6E=x M-m|舏 1| _tGķ胾0 ` P pHhXxLDLdLi 131 3~0 ;,b,R,rJjZzlFlflVlß ۱.>!1 )8󸀋˸븁۸xxxѢZsX8xHDH$HdxR %R# ECzd@FdFdE6dGD.FE~@!FK(WQPu2xeQQQ QUQ j&j6FwQ ZZ ڢ}|:3>F|Ost_k|胾0 P pHhXxLDLT,/_1c~BEX%XeXXUX5XuX ؈M،-؊ma;vo؅؃؇8888888qp.. nn Fjb &b!6 .!> !!1 )9F|Ost_tGķ>01C1 10c0000?b*'L,_0b~|,K˰+k['v?8C888S83gqq". nn Fj%b &b!6 .!> !!1 )9G7|/7o }1a 񘀉ɘ1cfb~/_10 ;,,2, *:l&ll6;7Nn^~AaQqIi8s8 q qWq q7O4ZTk1q I y$ HHHx Y ّ9 yQQE^Fq+x^(7QPPPUPPojjm;zx!1)9Z%Z5ڠ-ڡ=:ct'+>_k|聞}{A!aQI)S1 ?afbfg9s1a>w,XXXXXXX؀؄؂؆;7Ni[xxYLA\G$Db$AR$C DZȀȄȂȆȉ\ȍ<ȋ|ȏ(B("(P /8J(x (r( J*jP5Q 6.]{hhhhhhhhxCt@G|N茏S|W=-z7/?;  0HXxLDLdLi 131 s1 ;,aqy\ -=<#B'|.3t/%=-z7/?; 0C00#00c000Scfb6~XXeXXXu؀؄-؊m؎`'va7`/a? 0(8N$N4_9˸k[;{xxZDlA\C$D$E2<)i ّ9 yQQEeG WQPu2xeQQQ QUQ jjm;zx!1)9Z%Z5ڠ-ڡ=:ct'+>G7|/7o }1a 񘀉ɘ1cfbfg9s1a>w,XXXXXM،?c?؉]؍=؋}؏8C8#8c88S83gq.. n.>!1Fj[b &b!6 .!> !!1 )9 ] _+|o=ߢz/?; 0C00#00c0000S0cfa6~/_1c~BEX%XeXXUX5XuX ؈M،-؊ma;vo؅؃؇8888888qp.. nn Fjmb &b!6 2!3# /!?  (^BqD,K˰+ kppp7pwp/ZDH$Hdx#9R %R!-!2"2# "#r"r#"  %(x$J4^xe&ʢʣ** -@MBm:xuQ>C4D#4F4E34G D+FE;:#tBg|.3t/%= }1a 񘀉ɘ1cfbfg9s1a>w,XXXXUX5XuX ؈M،-؊ma;vo؅؃؇8888888qp.. nn Fjb &b!6 .!>!9^@ D*FtȀȄ,Ȇȁ<ȋ|ȏ(B(x P% ^EIBir( *jxuP. Z%Z5ڠ-E1ZsG]cbcFb,a<&`"&c ~TLOY WF|Wߠ;z'E/FE? wa0`(a8F``,a<&`"&a2GL4阁Y W!1i1 q I )i/"#2! "r 'r!7 /!? 0%(x$J4^(7QPQ Q M ::3|o =~ 0 (XxLDLdLi 300?y c!",,rJjZzlFlflVlß؎`vcbN4_y\K+k۸xxxѢFh1q IGrHHx Y 9yQQEQ /8J(x GETBeTAUT[xuE4D#4F4XLƏX8p 7qw Z؈HdxRECzd@FdB;hhh|^A!aI1 10?cb9V`%Va5`-a6a Ol؃}؏#8c88S83u8HDHH Yِc7hF\GBFZCdD&dFdEv@NFE~@ABaAQ(WPMCTBeTAMۨwP)Zڠ-|舏1St/%7o }{A!aQ1q)cfa68N$b.PEP%>: >AOwq I)S1 ?a:f`&fa6~/_10 ;,b,R,rJjZzlFlflVlß ۱.>!1Ii8s8 q qp7ppwpOEh1q IGrHHxYQQ ^ś(jx :|~<K ۱GFw` pXxL$LL4L :l&l6;7Nn^!1Y*fln\•h]"%^(RhhhhhNO> ߠ;z'E/FE wa0`(a8Fa4`,a<&`"&a2`*'L ,s+b~|,X?K ˱+ k [ /l؅؃؇8C8#8c88S83gqq".2*:n&n6.>!1iR-b"b#"#ʢʣ*&j6Fzx ZZ ڢ>DtG.+>G7|/7o }1a 1q I)S1 ?a%`=6`6c+.!q\m 5^DzdD&dCvDnA+F[tK i9XUX5؂88#8888qp". nn F"b"!"1 )y$ HHHxY ّ9 yPPEP/^Fqh&hhhx#>Bg|._E/A_|c$`,a&b&c*cfb6~<߱K˰$ڗ< =r 'r!7   %(x%Q ^GEyT@ETFTCMBsDkA[C{D/@A_1 ;c9Va5c6a3b_؉؋8C838˸;xxѾ؈xɑ) i"!=2 +!r"7 /  ^(x o D9GTFTCuڨwQ M-mCtG茏S|˱[ ;qqWpp7q wpp}GrHTH4HȀȄ,ȁȅȃȇ(B("(WQ:@( J*x 5PPoA]C}hFh&hfhhVhhx:#tBg|.3t_+|聞}{A!a񘀉ɘ1cfbfy c!",,rJjZlflVlß؎vb`/1ir- #!!1y$ HHH ȄȂlȎȉȃ(("( J4@YCyT@ETAUT[zx Ct@GtgWߠ;zzc@|AaQ)iYs+bw,b,2, *:lflVlß؎`'va7`_y\븁۸xxx-D؈HHHH<D*FŋHȈLȆȉȃȏ(B("(bxQ%Qu2(r( ʨP5Q 6E={hhhfhh6hvh!:#tBg|.!aXXXXu؀M،`0(NN?\u܊9ȍȏ((r(J*:xM- m>=  ` P hXxL$Li 13W|,X?˰+k /l{ppGq qg/.jo_@Zȇ"x %pqgpWp?ZT鈖Y 9PPQJ5T@ETBeTAUT0 Hx؇8#88q*z I Q 5P o 5:Fw@_1 i_0bac56`3v`N4YE\m]#<'6"1CJG!F1(W*J^xo,ʡ<** :B D-ۨwP>C4D#4F4E34G D+FE;:#tBg|.3t/%ߢz/?; 0C00#00c0000S#~tLl߱` bVbVc-c6b6c $N4,.".2nn Fb &b!6 .!> !!1 )9g ~  0 (8L030 WGD!FK(Q% ^EIBiME9GTD%TFTE5T[xuE}hFh&hfhhVh6hvh>DtG] >g _+|o=ߢzc@|01C1 1#1 1c111 1?b*'L ,s+b~|,X?K ˱+pGp'/.?\%\\5\ -Ɲha<&b&c ~TLOY W<,",,2, *:l&ll6;7Nn^~1 i8s8pqpwppO4ZT;1q I y$ HHHHȀȄȂȆȁȅȃȏ(B("(P /8J(x ePPPPUPPojjm;zx!1)9Z%Z5ڢ=LJ耎 > ] _K|o=ߢz?;  )S1 ?a:f`&fa6~/_1c,b,R,rJjZzlFlfl6;7N>!1 )+k;{xx'x-LEXȈȊlȉ\ȃ:w ] _z7 2:D>&b!.!> # 9$ HH4xYّyQQQEeG R(7Po,ʡ<* -@MxuQ>C4D#4F4E34GKBkA;LJ耎脏S| _k|o 0?`cbcFbFc bc&a2GL4LLl9,b,R,rJjZzlFlflVlß ۱.>!1 )8󸀋˸븁;{xGx'x-E؈HHHH<^@JAZtH ȄȆȁȅȃȇ(("(2^(R(:@(򨀊ʨP5QoA=x M-m|舏 S|Wߠ;z'E/FE?|?`cbcFb`,a"&a2O.!)˸;@,$@b$A2D*d@fdGA>@1G)TDeTC-ûh1 1K + a8N$N E\e\U\u-=<#<<U@LBlEG7|/5Awķ胾0 ` P pHhXxLDLdLi 131 3~y c!",,2, *:l&ll6;7Nn^~AaQqIi8ppWpp7ppwppOEh1q I y$G D*FŋH ȈLȌ,ȊlȎȉ\ȍ<ȋ(((x 2^(R(:@(򨀊ʨx 5PPoA]û M - m>>D ,߱+'^A1)e=<<A$Bb$CrHTH4H Y ّ9 yQQuQ>Z>EWto =~ 0HhXxLDLdLi 131 3~0 ;,b,R,rJjZzlFlflVlß ۱.>!1 i8s8 q qWq q7q qwqOEh1q IGrHTH4H Y ّ9 yQQQEeG WQPu2xeQQQ QUQ j&j6FwQ ZZ ڢ}|:3>F|Ost_k|聞}0a 񘀉ɘ1cfbfg9s1a>w,XXXXXXX؀؄͸[xx-1 q I y$ HHHxYِ9yPPEeG WQPu2xeQQQ QUQojjm;z M - m|N茏3t/%=-z7/?`0`(a$Fa4`,c2GL4阁Y WB't _;z'E/FE?|10#0c000 #'Ls00 ;,b,2, *:l&l6;7vb`/8N$N4_\%\\ -}@ABaAQ(W*JJ57Po,ʡ<***:B D-ۨwP.=4=~PH8LDLdLi;,b,R,rJjZzlFlflVlß۸xmLLA"$FR$sx/ %R!5 -!=2 #2! "r 'r!7 /  ^AIBi7&ʢ*"*2*:B D-;x1st_k|^>~a0`(aFb4`,a"&a2GL&l88#8c8S838ppWq q7q qp4Zk-=2" +!? %Cq+(RxePPPQj6E}hh6h#tBgt'+ |{A!Q1񘀉)_1bVbVc b=6c+v?؅=m\ABa+(PPUP 5 ba,a<&`"&a2GL4阁s+b~|,X?˰+k['c?؉]؍=؋}؏8C8#8c88S83gqq".2*:n&n6.>!1ir-b"b#"#!1 )9C4D#4F4E34G D+FE;:#tBg|.3t/%=-z7/?; 0C00#00c00k[?؅؏C88 M۱GqM )阁s+bw,X%XeXX5X ؈M؊m ۱n^aqIiY˸븁;xxx&b &b!"#"# "Hi"!2!3 +!;r 'r!7 "*:B D-ۨw.=4D#4F4CsDC{0#1 1c1Kkqqp'q qqq7ppwppO4A D,FE耎 > ]9 |5Aw@O|^>~=~  0 (8Ltl_0b.~|,BEX%XeXX5XuX؄؆?.>!1 )8ppWpp7ppwppO4ڏ1q IGrHTH4HYِ9yPPEP/^Fq+x%Q ^(7QPPPUPPojjm;zx!1)9Z%Z5ڠ-ڡ=:ct ]9 |5Aw@O|^>~=~  0 (8L$Li 1`~\o߱``cVb`c#6a3`+O{qpGpp'q pnn> F?؈HH$Hdx#R"R# "=2 #2!3"#r"r#  %(W*JJ DYCyTDeTAUT[ZQu.=4D#4F4E3BE FlV>AaQIi8ѦFE<$Db? >C(ɗx~ o!2D K āăB"_@`ĐB2I) %|%t^2HF$%䐜KrK+BRXHQ)&ť')#egEIy TRMK )ԕ@J#i"M4򛴔V򻴖6VI{ tMH)e,e\VJY%eu^6F$elm]vN-{dr@!9,GrBN)9-g䜜 rQ.e"W\rSnm#w+~/(A,uߤ.mQ:I7.=O(d a2\FH%cd?dLI2Ut!3e̖2OBY$e,e\V*Y-kdA6*d쐝Kv+CrXQ9&儜+rM )ܗPy*兼WFA>?Y˿LFEJ4.1$ĖėPKJK$$TIrI!%t^2HF,Y$䐜[H>/"RTK ))GIHYEIy T*RMKM%4DJ3i.wi-mtEJ7.=GJ?/e 2LF(!3e̖92OY&eN(dlM)d쑽O9(rL 9%匜sr^.%,W\rCn--wܓPcy"O/RLKIAJˏ򓔑)'奂TJRYJ5!ԓ@Jci"MWi.-W*Y-kd=r\%#O乄J|YFbJl'%$ I,I$$BTZHZI'%dLYHV&%\[H^'BRXHQ)&ť')#egEIy T*RUIu!5Ԗ:RWI}i 4&Tɯ\ZoRZZH[i'tNYHW&ݥ^[H_'e A2XP&eQ2ZX'x eL)2Ut!3e̖92W|Y e,%TrY!+e5Vz el-Uv!;e=W~9 #rTq9!'唜3rVy \+rUO!$EJ.'TRSZJ+i#mQ:I&=>_P!cd!e̔2G|Y$KeUZ!9&\rE5.7ܑrOCy$Oy)%o $Đ+~TZY/ܐ򷼕w_f+ē@J"_ ` ĒTIrI)K*I+$ܒWI~) RLKIQHY)'奂TJRYH5.5ԕzR_HCi$4R~NK#d12Vx dL2M )d̕PbY"Ke,JV:Y/dlͲE6.;d=W~9 crBNi9#g\V צX[ZJ+(t_P.#e)2]fl#se-Uv 9)<m.1;/ G% ]H1)-?/RQY*dlO9(䰜SrF(\kr]y(' Ye$ȷYHT&%ĔX[H\'%$D#'("%$d\RHJ^RII+$dLYJ6!9%/"RTII)%GIHYY~rR^*HE$TjR]jHM%ԕzR_HCi$4f򫴐J~FJ;i/tEJ7.=GJ?/d 2D0.#d2F8C(dL2M )d̑2OY(d,L Y)dN(dlM)d쑽O9(rL 9)䴜rN(\rM )ܑrOy(<򧼐J^ N_=|!*DbAlq;!$D! $dR RCH =d 2C ;䀜 rC ?P C(š (TJP@UաԄZP@]4F@ShBshAKhCkhm:Ag]tB?`0 0  a ?` p18'$p98"\p57&܂p=!<3xKx [x||P/_@T!ĄX@\A|H !/?@ A0@bHI!$=ԐB:H #d̐B69 'ܐB> PB1(%$4?A( ?/PC2TP C 6ԁPCh14 ~~ ~B;h#tB7='B?` !0p#a100&Da Li0fLa̅y0BXa ,eVJXa u6Fa lmvNa}A8cpNI8 sp.E \kpnM܅{pCx $|  B 1$ C H C*H i -2B& Y +drB. y /P B!( E(PJP JÏ34Ch Wh-7h wh m-:B' ]+tzB/ }/0  C`( 0F( c`,?`,X `9 VX `=l 6 `;쀝 v `?p8 8p N8 <\p . :܀p n ><x 9 /%->? >C(Lտ@T!ĄX@\A|H !/?@ A0@bHI!$T@ZH!dL@V!\@^BP@Q(š'(egAyT*PAu5Ԇ:PA}h 4&ZoZ@[htN@Wݡ^@_a A0PaQ0XxaL)0t3ă90|X a,%rX+a5zal-v;a=~8#pq8'3py\+pu7܆;p}x<'s^Kx [x||P/_z o!2D C 6āăB"_@`ĐB2H) %| 5C 3d C 7䁼C(0P C ( ?@)( ?OP P*B% U*TPjB- u.ԃB#h M)4_9ߠ%ߡ5C3t C 7`0 0  `400&$ S`*L0f, s`.̃"X K`),V*X k`-6& [`+lv. {`/p!8 G(pN)8 g,p.% W*\pn- w.܃#x O)<' ^ ' _2*|BdQ!DbAlq;!$D! $dR@JRAjHi! 2AfY!drAny!P Aa(EP~RP~ (TJP@UաԄZP@]4F@ShBshAKhCkhm :C ݠ; zC ? 0 `80 F `"L043`&̂0< `!,Ű2X+`%հ:X`#lͰ6;`'ݰ>8#pq8'3py\+pu7܆;p}x<'s^Kx [x||P/_կ"7-D(At1!Ć8x@BH> ~A !@RH!!4Az!d,Av9!<A~("PAq(%(G @Y~rP*@E TjPj@MԅzP@Ch 4f+4V;6A{t.Aw=>Aa !0p#a100&Da Li0fLa̅y0BXa ,eVJXa u6Fa lmvNa}A8cpNI8 sp.E \kpnM܅{pCx $|  B 1$ C H C*H i -2B& Y +drB. y /P B!( E(PJP JÏ(TJP@UաԄZP@]4F@ShBshAKhCkhm:Ag]tzAo}0`Ca 0FhcaaLI0T3`&̂0< `!,%rX+a5zal-v;a=~8#pq8'3py\+pu7܆;p}x<'s^Kx [x||P/_~ o!2D C 6āă?@ A0@bHI!$T@ZH!dL@V!\@^BP@Q(š'(egAyT*PAu5Ԇ:PA}h 4&ZoZ@[htN@Wݡ^@_a A0PaQ0XxaL)0t3ă90|X a,%rX+a5zal-v;a=~8#pq8'3py\+pu7܆;p}x<'s^Kx [x#3B|H | ! Dhb@L!ą ćCBC$$ArH){H! t2@F! dlr@N!| @A(bPJ@IJAi~2P~_ P*AeUTPjAmuԇAchM ͡- v:@G tnz@O~@a a0FHa q 0&dSaL0flsȧbXKa,VjXka 6f[alvn{apa8GpNi8g p.eW\pnmw܇cxOG>g0W"C :Ā bC A< !$? H I )$R RCH =d 2C ;䀜 rC ?P C( Š8#e, @9("TPB55&Ԇ:PA}h 4&Zo ~B;h#tB7='B?` 00#`$08`2L0 `6́0X`1, X `5`3l  `7쁽80p 8 4p2\p 6܁px1< ß^+x o/;x#3B|TH | ! Dhb@L!ą ćCBC$$ArH){H! t2@F! dlr@N!| @A(bPJ@IJAi~2P~_ P*AeUTPjAmuԇAchM ͡- v:@G tnz@O~@a a0FHa q 0&dSaL0flsȧbXKa,VjXka 6f[alvn{apa8G3py\+pu 6܁pCx "0 `6wyOwywywy㎚y7y7ywysp?ñp܃g<8y.{pŃ[w=y؃' ^zʃozكP<ޱo=Az̓ х\gB]sዳs! ߸ Q\BBy璿K.RK)\JRZ#n2yP<(A Jz?yPƃd6pڼ}ڼͧ;ya޷ӗ+UüOfo !4_0Fh`L0f a6&G$3p.e <s>C(U$!ą >$| !@2HCH!dL@V!\B>P@U5ԇ+4V;N@Wݡ!0 F `L0 fLa.̇ VZX`#l )8 g\p]? >CW#7-D(Atq .| >/?@ A0@bHI! RCH =d 2C ;䀜 rC ?P C(š (TJPB5h 4&ZoZB;h#tB7=0`` L0\a1,հ8'\KpU܂p}xC(|ʜ_Eo[ :Ā bC AH>A ! T@ZHY +d AQ(š rP*@E TjPjB- u.4FB3C htN@Wݡ08$ `̆Ű X ` 8 <\pnM܅{pCx ~R@JRAZH!d C. y /P B!( E(P*A ՠ:ԄZP@]4F@ShBshAKh v:@G+tzBo}a !0F `"Li0fLa̅EZXa#l-v;a=~8#pNY8&܁Օo D CH 1$dRAjHi! 2C !P B!( E(PJP JÏP@UաԄZzB/ }a a0FHc`,0&dSá0bX +`%u6a]80 p >! DbB, q .| $D! $dR@Z!d,Av9!?P~RP~2P*Ae5.ԃB#h M)4A3t z@O0 `4i0f, s`.̃  `p182܂cxO7>? ako 2Ā x@BH> ~C(#e, @9ՠ:ԄZ+4z@a 100&$ S`*L0f, s`̇ X al-va}p57܆;p}x3~u=| 1!Ć ~A@RH!!4Az!7䁼 B!( E(PJP J P*BUա&ԂPAcZA{`0 0 F `"L)0 `>,X `9 VX `=l- $p M w.܃x 9 /%o#3BW7"C41 6ā@B@` 3䀜P~RP~ P*B% U*ԁZoA3tz@O} 0 `8Q00&$K`),VjXka 6f[alvn{ap187܆;p}x<' x 5_ͯB41 &ĂwA A0@bH!!4Az 3drC~(P Ci~2P~_jPj@MԅzP@Ch 4f ~B;h#tBa 100&$ S`*L0f, s`.̃"X K`u6F;a=~8#p 8 \p-xO$| CH 9=A  JP@UաԄZP@]h ͡5:B' ]+tzAo}0Pa,0&$ `),`3lpQ84p 7&܆;pcx5w_"A41!Ć8xBBC$$C H C*H i -2Bf9 '<CA( Š$@2TP C 6ԁPCh 4f;tzBo` 0 `40&da.̇6 `;}p <>GNT1 &Ć$|!!!CH 9,Av9!䁼 B!(š$P P*B% UԆzP@Chm:Aw70`#`$L0 `u6Fa lݰ>8Gp ܀p n ' _"C  H!| 5C 3d C^BP@q(%PB55&ԂPZoZCh ]+t zC ? 0 `80 FXxaL0f[`+lv. {ap8 p n- w.܃s^Kx/;xW"C41!ăB"@ĐAz!d,AA(bPJ@I(?C%u 4f+ :Ao}0Pa08`2L0 `6́0X`1, X `5[0p 8 4p2\p 6܁'A !A RAjH =d B ( ?@% UԆ:PZ@KhmNC `400&$ S`*L0f<x 9 /%7 o=|| a+g*|Bd!_@`ĐC H C*H!dL@V!\@^(E8PCh14:C` a0FHa JXa ->Gpy\+pu7܆;Kx>G>Ņx@BHA !R@JRCH =dLC 7䁼C((PJP JÏP C M)4V:Ag]>Pa4q0t3ă90 Xa l  `7쁽80pNi8g p57܆;p}x1<w>~eg@dQ!DbAlq!ćCBC$$ArH){H i -2C69 'P@Q(%$e, @9(2TPBchM4`:̀jX`=l 6 `;쀝 v p N <'s^Kx #WO"7-D C !>$@2H C*H i +d rCBPP JÏ3"TP jC >4+4V;6A{t C~@ C`(0 F `"L0fl a ,5q8'pE \[p]!< oBz bB, !B 1$ CJH!-2B& Y!bP~RPB55&ԂP@ChM Ckh#tB7=>A `80&$ S`*Lٰ:X`#lmv p 8 4 p x /%>G>g0l*D(C 6āăB"?@H 9=ԐB:H #d̐B69 '<jAmuԇAchM ͡- v:@G tnz@O~@a a0FHa q 0&dSaL0fl`!,% Vư̼̈v݆yow)g,Z8oqe+W-Y\aq05̼c7Hl"Ep[ܼϳsI/PAyTjPjAm#u4f4򛴔V򻴖6VI{ tnSzI+Ce 2RF2^&,-sd̗P(dlC9*'䤜rF99/ܒrG}S^[y'?HMbHl+%$_@ I,I$$򽤖4VIz(Y%ܒ7 P8%)p~ |8-*YTbQ͢E-h_ohh:nz^aa&Ͱv!{esr^.% W*\pnm=.х\\BÅX.v! q]H .B !.$v! I]HB Rƅ.s! ]Bυ.p \(BP܅.B)J ?Pƅ_\(By*PŅ.t ]B]ą.4s =\ 0ԅa. wa #]f0Dž.sa ]X*Vƅ.sa [\8apԅc.w ']8ιpޅ .\t ]UnpDž{.pЅ.s \8.pɅ.\q \ npDž.}-Y d1bPa#,FYc1bx -&YLa1b|E-VY`bf-[-YleqQc-NX8mqM[w,Yܷx`c,[i,xkX|ljz"EtX-Xĵg"EEEb-ZHo"Ef,Y-Yi"E^|- XlE9,*[TjQ͢E :u-YԷh`ТEfZtlŢE7=-zYcע,[c1b-&XLi1b| -Y,XbbJU-XXgb6;,vZcAC-X8fq,Z\nqZxo?,>[ZY|}c"E41,bZIJm"w,[ZY$Hb"Er)-RYHc"En5,ZԳoE#f-,~ݢE;,FZm1by-X,Xdb2+,XXgbFM[,ZlebCG,Z8aqi3,.Yܶx`SgZxi,xk,>Y|Gj"Ex-,-,,[Hk"El-rXeQ̢Eyj5,jZԲmQǢE=,Z4բE ,ZZݢE]-YeۢE_~,Y`1bd)S-Y̲m1bBEK,Z,XebZu-6Yljb,XgAC-X8fq),[\dqm,[[ZY|>"7ZDf"E,q,Z|g"""Er)-He"Ez ,2[d(lO?[bQ΢E,*[԰mQߢEc&YnڢE[v-:Xtd٢E7,z[kϢ,[i1b,o1b$S,Y̶X`bb%-VXXmb:,6Zllb6;,vZ\lq#g-^Xxm{->[Y|l"E,|,|-Y$Ha"E ,[(bQԢEq?X(mOe,ZlE9,*[TjQ͢E ,j[ԱgȢE3YnڢE[v-:XtdŢEw=-zY`1b`-FXm1,&ZLl1b-[Xib&;,Zoq)-.Y\bquw->XcEEŗS$o,l"El8,|,|-,-,[$Hk"Ef,[i"E,[(lQ¢Ei-ZlE9,*ZTlQŢE55,jZԲmQǢE= -Z4բE ,ZZnڢE,[iˢE,[ h1bp#-[Lh1bl9s-[,Xb%7,Xigw|xjPsF153Ps;'4a~SeBITBhd20o~yCjPC5;aВyC͛j~f_jvoٵ _C> mb}jc5ߵ;6|ΆMf=j@P3fC̆P 5jB|y 5jBͷYXcaBlY fw 9t0P0 A5!jr=j7L&PMz8c5 azj 5y>n5wzu0q׸g7LCdžuSt9Oxe26MjnPs=57wLLWLWLWLOLOLOLOLOLOLOLO 3whXb3t',Han1 ӕ0s{('a0s;'t(1an 3wJKf0sg=t)0oqRRy[[fɰVy[f:f:f:f:f:f:f:f޻0ӳ0ӳ0~*̼Oagagagagagacacacaf2LLLLLn3} 3} 3:|0=fffvsaf3̾ 3} 3} [fo0fvBN[c36[ '̞3] i0/̾3= 3= 3= ;f~~6aaaaaaaaa 00Ӱ7g 3 3 3 34/_L/^~1;/_L7n~1bt٥_3f}I`~1}bþ/~a/_L&9%RPJ1))?K9)/TjR]jHm+4򛴔VZJ;i/=2@`"Ce Q2F2GbY*kdQ66.;erPa9"GrRN9+\rI.!ܗDKy#o|YB%L H4.$ē@J"_ I"$^2I*9$',&_e>'Io%D|CH  #d#eg U)4;v:@G tnz@Oa 00&d"d̔Y2[:E sA| $tA ;H d;H rAdtAfYdwANvA^wPAAvPAq?:h砣8ꠛz8`9`F9`9`f:`9;X`E;X`UV;X`6:`v:`};8ਃcN889ઃkn8{;x>:AXĢA$8AdDwAlqu8qρ;H d;H rAidpA&pA.qPAatRJ;(㠬*8蠒j8頖8렞8h蠑8h꠹~sA+tpA]tsA=rA}s r0Lt0dSLu0twr+uzlr^pp)qp%\qp5vp]w#wG_""9"; Xb; sA $rρ)| 42: r8  8(蠐8(ꠘJ8(v𣃟qP9(J*;ꠚj8頖8렞8h蠑8hꠙ_4wAKqA]tsA=rA}sq0;`I:`f9`9`9X`V8X`:X` 6:`=:8c;8ः98.;n888xృ':xใ;DwA<8uA@A$uAzrA^wPAaEuPJ9AewPAETvPAUpPAmuuPA}M4wAkmtrA_ r0C s0#r0X8`&9`f8`9`%:X`V:X`5:X` 6:`v9`88c;8ःSN;n;ྃ8x^8xୃw|X9AQDwAL~;H l; "9(v2;䠖8렞:h䠉9h:9젋:`9`F:`I8`f9`9X`9X`V9X`9X`8`v;`}88:8༃ .:ಃ98xृW^;x/;xགྷqg"389qA`!;H R8H ,: | ;(J9(G?9(㠬sPA%TqPA5pPAtZ;h㠭vGc:GKF[G+#'}#/#0(#0""0>"0)S"0=3"0's#0/""+#*k"6"1"5"#;#+"p0"p8G"p4'#p:"p!#p%"p=7#(#,/#*#6["/#  #4i"6#!#)#%Y#-##9#+#'y#/#P #P(#P$E#P,#P"%#CJG2(#KE|*Db*GZGFjFVjGNF^GAFQGiE4@h#:m"6">"9]"5"=="3";}"/#0 #0(C"0*"0>"013#0? "8K"4"<+"2Ypօ)mlgg8;nc8:u8# X88)qɸ,Wk_Ŏm1b'2|!!y]C7_TR]jI]i$ͥKzK+d 2D0.#dLI2YfL%e̓A6&,d=WA9$'唜rA. )ܑL˟B^+y-o/y/䳄+ηKbK\NI|I G$P%DKI*$򽤑N2Hf"Y%dKrKa)!$TRCjJ-#u4fB~Q:Ig"]~_@$e 2JF+/dL2W|Y d,UF:Y/el][^'CrXQ9&夜rF99/\rEu!7ܖ;rW}y G$%T˿V"KT&%Ĕ$ėP|W_$P$XK2I.)$d,UIv!%RH K)*Ť (?I9*եԕ@Ici"M*7$]tCJ? e2Fx dL2ML%e̕HRY!kdA6.;d#rLI9-g\KrYM+|1{|5 c1G|Jfw]cC|~1>|91sc̭IjFMafϧa ||y1cŧaf7w|tߧapsw[> sWNn[ga:c:c:c:cc+xca` i c1X`,4-c217 }L>&;>l5c*sG\7n1g|C0[$> 5Œ/k _?#0oy}͛kA_L}M~׼;&C_k_<}M&?_k25 }Mv&7_W_ηaͷa|Mn&7_ͷ0k5\|M.f]k5||M>&_dkf̴kW|'&_k5oنF5sk59oņI_k!|wd0'=}7L d{8n0L5}/5}MƾF59}4^ s~4k5l-g/an@Ft̯[?3~q s̱̝c~~ 3~3gzg:gn?3~f~0<>>>>>33gzgzgzg|3ģyO?dg23g3lLn~&'?3;g3߄~;g73X~&;?ُ~&??g3|7F;o\0LN~dg̥d0gfa0~&?+gr3gfgd|6L~&Ws\M&Ohdovor7LM&Kͬ;̻̻ܺ7soXs=onPL?n4L~7{  Kfnnnnn}ov=j..]ovfW}oooovfofttt̺鋿s3fM_MGMGloͬY7{iMMMwMw7ozozo̻铿铿eaf̶mMwMwMwMwMwMwMwMwMwMoM7_'̬=```f>|HHF@3{+|7L&L&7`0yL&0o@w<M0AyL'LLLLLL^0}0wDD&w;쇀q=}>d`vD:q8d`206&s9`r0"d`0YL&q8d`20<70{#7.fw`vG&3&3fLƁ&@3f͜943hff6 li4?h49Y4o~@7?мf͌M&@wh@s7"hr 4 MN&@S)@S(dh2 4~4|[hf1b@=h1@ͽh@so]0|LA& k5 w 2;7 q8 s7d NLA& s9dr29 2d2yM&`w;l6yM&`w;x`967Zyǃ;lvx`Ӊ`Ӈ`Ӈ`Ӈ`Ӈ`Ӈ`3f6l`ӑ`߃MOMO~6] 6] 6jf]lv}6 6>(` YfM/M/M/n2̝lf?~`σM_M_M_M_M_M_M_M_6; `=ln`M6 6 6 6] 6= o[>t%܇ 6o@ {lނ`l:lvfgll~m6 6$t+`G;6$t-`]l|]yMM߂Mς> 6 6 6 6 6 6 6 6= 1 1 1 1 11o@yCb:b:b:bޅӍӍӍӋӋӋӋӉӃӃӁӁӁӁӁ{=bG!fobF!fobފqyCL!&g3b 1Y,CL!&c1bw!&_TLw0Lv0\™΂p(, gi8`JU-X`b,vX81t¥.vl.DbnDܛ׶mwݵms׶m%ramNR۶m{~=O~39/>ov8fsuCzs>8š_v&]":ɡ(Eu(CPLb9ǡs(C JPb8̡p(CJPZ;ѡeu(CPNr9ۡP^ ;TʡuCPe8T͡ru@=;4uP:ݡv}@90؁! u`#h<p9ہ8@80ՁiLw`:0ρ%,u`X:΁lt`A8فrG8q.:p)qUqPR#S<'V$Q$U$S$C0 C0dC0d C0a(a("a(a(((((RnX_1> S<;,r`KX V:Ɓs`8ف-lu`;^8pȁq'8i8pցswWun8pӁ[vw}:ȁ'rox;;|v_w~8Ӂ_vO2Dp @:́Xv  H@"9q @vr8Ӂ\v/8@%j:Pׁ4C0C0tC0 C0C0 C0 p퀇.p;0Ɓ:瀿s`:0ρ,p`KXrV;Ɓs`r ؁6;Ձmlw`G8.9pՁkt]9p߁:x&80ɁLw` Xf9ρqO×) db3qxL|&I$a2ɘL:&g 2EL18S)Td*1ULu.BGݡA0H .7_ ]i`8@KJ8 &se1Cy3ߙ̯Dcb01L&>I$b3ILr&IŤf0L&#dc39L18STfj05ZLm.Ӏi4e1͙LKӚiôe1NLg ӝdz1}~Ìe|_f3Le1Rf9Yɬf0f#le1ۙf/9Ȝb2sbn3w}yd^3o3d~1?5Dc3LB&1Iʤe1陿Y,e1˙Jf5Yl`62 & a0ۙ.fg0Ca4s9\b.3Wkusy0+bOL"2Sbj3uL=>Ӏiδ`Z2.LWӓ f0Capf3x2^q38f<3Lb2Ә,fY,gV0+u&& fB]f/9dN23Ys\f2ט 6sIɤb2LL6&e1LA0S)c3%L)4S)˔c3L%2STc35L-6Si4d10&LSӜidZ1mL;=Ӂte1ݙLO7Ӈc2 df 3Lgf2f>Y,f0Ke fлޓ\7#h碽vp.FEu< OsЮK>\gs~E4}{sG@07q ćAbHI!$RAjHi! 2AfY!drAn @^C~("PAq(%2PAyT*PAu]v\nmsm:A ݠ; zܴr.M7xn=" `!,Ű2X+a5 `3lpNi8 \Kp5 w)w>g; ~"AdQ!DbC )PB 6ԁB3h-%B; tnz@O~@a0 Fx0Ƃ SaL0flsȧbXKa,VjXka 6ACl-v;a=~8#pq8'3py\+p 6܁px+|~/< "DbB, q .ăB"H I )$RB*H i -2B& Y +drBn B~("PAq( rP*@uhm-:C}? A0F(  ^o? `:̀0 f `>,RX[a=~8p Nmw܇x 9 ^x = #|7?'?y#@D! Dhb@L!ąx@BH! $dR@H =d 2C ;䀜 r_B>CA(PJB)( e,JPAM u.ԃB#h M4ZAkhm:Ag]tzCa0 0 hxX_@aLI043a6̃>8G\{p#x O)<^kxo|Ow /"DB4 q .ăB"H I )$ @:! dlr@N/o PB1(%$PB9("TPAu5Ԇ:PA}h  4fZ@+ݡ^@_a A0PaQ.7?q0&Da Li0fLa̅y0BXa ,V*X `lMa lmvN {#pq8'3py\pn])< ^[x'_|~b@L!ąx@BH 5d,A. Aa(EPJAi(e PC u)t `0 0  `4x'x c|!a 0&dSaL0flsȧbXKa,VjXka 6ACl-v;a=~8#pq8'3py\+pu7܆;p}x<^+x o|OW_'T!ĄX@\!$$ArH)!4Az!3d C 7䃿!?P C( Š8P JC( (pN)8 g,p.% W*\pn- ~`,X `9 VX `A0l  `7쁽80pN8 <\Kpx1< x 5ÿ>O EAL!ąx@BH! $dR@JH! t2@F! dlr@N/y! BP@Q(šRP@9("T*PAu5Ԇ:PA}h 4 C h 5C3t C 7`0 0  `4x'x c`,/?@ 0&$ S`*L0< `!,Ű2X+`%հ:X`#l  [`+lv. `?p8 8p N8 "\p57&܂p=!<3x/%;x3|  7O"AdQ!DbAlq!ć@ H i! 2Af9 '<A~("PAq(%2PAyTP C 6ԁPChh M)4ZB+h m-:B' ]+tzB/ }/0  C`( 0Fx a 0& a, X `56F[alp18'3py\+pu7܆;p}x<'sx/7{>G |o~OS$DH@T!ĄX@\!$D@RH!T@ZH!dL@V!\B>C(E(PJB)( e,P*B% U*TPjB- u.ԇ@Sh͡%B;h#t.Aw=>a( 0`2L0 fLs`.̇X % W*܄[p] #pI2\p= ,ErCpQ8 px/%>G | ~ß!6$C! \@^C~vc|!a p,p, pcs8cG8vcw8x8Nt8΄|8.b8.r8Z8F8n~8q8yxxWQYM]3 Ӎ>.ۨ=E&jOwO{yӽӞvu{0tϴJPh=ܞvo )D=5K2,)GiOMP jBmhM:@G tzAo? 0FhO aL0 ra3;.f7c23Ysc3#:D`"1(LT&db18LB&+`r2L~S)e1řLi STa25LSӉta2ݘL'Ӌa2apf$3x1.ƛq3d0sEbf)Yά`V2f-Yl`62 & a63[6f;e1Ǚ,s9\`.2+U.yI$f0ITLj& IǤg20LLf& dgr0yLQS)dJ3eL9f?s9fN0'y|6b ~qK "D1j A  $4(hPȠAQ% J3jPàA 41hjڠA{ :t1j͠AO^# Fxx | &L1g0`"K l4ddlb`v; 5gAC 58fp)g 4ep=/ ^3` ~qk\ $6Hb A 2d2b AN\ 2۠AAB J4(ePƠA T5iPˠA 40hhؠASf Z2hm֠A{ :t6bՠAw= z6c`  0i0``S 3o`b%K V4Xm`z  B 61kAG 78apis .\4dpU <3xnGO ;-Ad(Q 0i A $1Hn A 3۠A!E 3(iPʠAe5 j2mPǠA= 42ǠA- Z1hkՠAw z1kϠ  5f0`HQ < \n1~ L4d0`"K 1Xg ` v1k)g 38op% 6xcwG5m ABD $5Hf A d0h A 2(lP A)e 7`PɠA 4mPǠA= 42ǠA3- Z3`Ѡ F6042px 51704g0`DI L5f`r5k 7``AAVm v5gc N48ep9 .\1jp]{ <4xdSg/ ^2xm{ >|3nù D7i A $2` A 6(`PРAQ 3(oPA%U j2mPǠA 41hj̠A  3dՠAw 5d0`p# 5153704g0`$S L3n0`,s 4``AA; v5gA' N68cpUk7 n2mp#O 0xeGo? ~qgH 0i Ax $2Hl AJT 22mo 2(bPԠAIe *T2kPϠA 1hfܠA z4c` 0i0e65h0` 0i0` 0Xi`Zm v4e`^} 48dpQc N18gp% 0ip <0xd3/ ^6xk >:+ATh $4Hd ARd R4He AZt 2d4d AVl r2mA>E 3(nP A)e 7`PѠAe* 0hhM 43hn A+m t4dǠA?  5f0em6c0`43 3Xd`*k 7``AAAf-{ 78`pg 7`puO <7xa{ >|1n/ A1 $4Hd ARd R4He A 2d1f AN 4(dPؠA  J1(kPΠAEU 2mPǠA= cؠAs- Z6hcѠAg.] z1kϠC  7a0`hO/`X_?@q &L4d0`Ti ,6Xj`{ 08hp 08ip9  .\1jpm;w <7xis}"D1j ALX 5H` Ab$I $7Ha Aj4i 7` Av9 r1ko"E 2(mPƠA9 *T2lPŠC5Pm8С5sC-jPk;urC}P?;4 rhCCF:ᐧC^v8&:4١)Muhly ,3Xm`z 6l1j`^} 48dpQc N48gpe+W \7ip= <5xa;h Ar) R6Ho A>" T0hP٠A55 j5gAm t0hɠA 0iˠA F 515704g0`DI L7a0`ly ,4Xd`Re+ V2Xm`z  B 6l1j`~CG \1ip=GO <3xi_ >|3no?` Ad(Q D7a A $0Hh Ar R1Hk A 0i _ 0(hPȠA 0(iPޠA%5 j2hhȠASf Z2hmɠAo>  642153704g0`3 f6k0`  V1` `6; v5op!G 58gp%W \7apmO <7xak7|1j ~;?Ad(Q D7a A\DI 2d6b Av9 0(dPؠA *T1jP͠A Z 1hl̠A'] t3nӠAo>  2l0`(^.oa ø0Ä0L ä0LÔ0L Ì0 ì0Ü0 ü0Â0, â0,Ò0, ò0,Ê0 ú0Æ0l æ0!8 !a-amaa]a=a}apa8GpNY8\+pnm5|||||DD$$$$$$ddddd-( ((($(,(*(.(#"+h h(h,h.h!h)h%h-h#h/$,"*&.!%-+ (,*&.)``G+ qIɂ)iYق9EłU5uCK+[ۂ;G7(X؂8xĂ$t ,|BR҂2 ʂ*ZڂFMMmm}}C#O[0F#LLLLLL,,,,,,6  v v v  N N  .. . .  nn n n  ^^ ^ ^  >~ ~ _" "  bb b    RR R R  2 2 2 r r r   J J ** *  jj j 44tt enPF+Pƅ2> L eR(CʴP   V!-#c ;{GgwQ1I))iYY99  JJ  ** j j   Z:: :  z   FF </K-p |?``````````````````````````_G'7wkHATA4ALA\AABA"AbAARArAJA*AjAAZA:AzAAFAVA6AA^AAAAqA AIA)AeAAUA5AuA AMA-AmA}AACA#AcASA3AsA AKAA;A{AAwAoAP0pH%ɂ)E%UՂu-mCÂ#cs Kۂ'gׂ7wOC= %V(CIJP,䡤%e(BIJP҆. d %S(CJP7|JP R0BH(EC)JPJR2Rb(5u--]==}#.XO/ &  ff     V  66 fv.n~A!aQ1qI)i5u M=#cS+[;{G'gW7wkX$AdAATALAA\AA~AAaAA1A)AeAA5AuAMA-AmA#AASA3A AKAWA7AwAAOA/AoA?PH(hSx ܂1O/ & & &  f    VV V V  6 vv v   N .. nn n n    ^  GDDDDD$$dddd-/(((,("(*(!()(- .!)/h$h,h&h!"!;nx_2J)A````````````````` X","*.)#+8(8"8*8)8%,"*&.!)%-/x,x)x%x-x'x/($,*&.!)%,.!)#+'/H H(H*H- ($,'[PPPHPXPDPTP\PBPRPJP^PAPQPSPKPGH````````C)c~@8xDdT\<"b *jA XCGWO_p@pPpHpXpDpTp\pBpRpZpFpVpNpApQpIpYpMp]pCpSpGpWpOp_@PHXTL\JZFV^52 /AA^A!AaAiAAYAyAAEAeA5AuA AMAmAA]A=AA#?ƂfN΂.^>~!aQ[0F'SK++kAfV6v>~ E%eu -m=C#cS3s K+kT4AtA ALA,AlAA\AzRޞB'_toy}IE'I'u“:9P'i4nMfM34nq7͸fM3ݔrw NBpS7n{7nꂛwS4nꂛM}pS7ͼF7M}pi7;M=p]wnnnꆛnipS?vc cCoz;PoPoPoЍ9&PgPgPgPgƤdR14 19 '䁼R Aa(Š8PB5JPjR' ~( BiJP$4 y(-BiJPڇ!Ρt G(CJP2( eh(B +PC e````````.3X al\\<<||||FD$$$$ddddddd-( (.(+!-h"h*h&h#h+*&.!)%-#+'/ (,"*&.!)%-W/ & ff f   V  NN     ^^ ^  ||||" "  ;ƇS|Շn$5|f{zz}Ḃ|BZ>7W>}t"ӅЛCow=C>|h~C|0Y>S|h<ЬнC鳈,%ͨJ!k:l&[м|\$>W5B r]s%4+>oSB.P|k>o ݳ>_7BRvodBYF#Ab$/|w75IC( n5_)%_|)<_Ǘ}{ߗ};Ƿ)M-Gʓ "D*׷*{_Ǘ}{ݗ}){_ޗ}bߖo`_a|[׷#}){_C|—n_|Fn_/ _z}7ڗd_XBΗ+}_z|'z|l$H0 !-zໍ/wMh}K=H'_ڹc}i!G}ϑR|C!_/uǗ{P|?_ڭK}iwRo|3|i~Rw|ƗvПG~#?u/Qo7~ Poh+~H^B7uƏ:WPO#~eÏG~Q'~ ~ ?uÏzG=G{:לP/~ ?G:G2(s?>]Gy}GGM"7нG~nh7^}G~h'.NQ'~AzG^wGQ~GQn~GQn~Moa?~(K?~1~eG~.n|(_?׏\i'Si%i7n|)_)_ ?}~* )[֟?O2]O9 % ٟr=O{?eO9S?z-OS?ͻ?|?eOӬ\ӝOLLMO߃)ookkkܟwnGOߟ?ܟ2)o{{yyyyf9Lh^Ӝ_%>lS/?.S?O3OS? 4{s .P444@Pye@@{@P\\PPye@Py444@P44ԁA{{,,wghNh(?hP(><=29(<h;>==?=f=f=hPwx@yPmiB; v{uw h.]@ :@(>=0}H>[ ?f?f?:HLJԃ@A ?| @D iR7i HYRe HHox 4ׁiw|lHoz x x x x x eHsH7] HH==H].Ү>Rԇ eL(cC /Pƅ2> L er(@I^ RO@ORGiR?`@(0P_@zi/R_i7Rg $Hl @p u8:HR1< y(/ByʛPއ!p p ۸HHaH,\|;Q,Q"%Q6Q!Q-5Q+uQ/O8i8y8Zm8څ}8:c8:s8{8zg8zw8ch8cx8FcT8< w8 81>1)1%1#31's1/ñ(ñ4ñ"+ñ:k±6f# bN3gse s 678GV{j}3D>/wH7xO R@JH 3dl$DR@ZH #d̐@A( E$2PAyԅ?C h .zB/C`( 0<` $SaL0f `,ERXaU6&`ݰ8cpNi8g p.57܆px1<>'_;?B41 Ć8AH 9t @.y0bPBEUTPZ@khm :C 7Ca 0Fhop_@aL04a , :X !6 ;`/pQ8$p% W\pnm<'sx/7{>G?"AdQ!DbAlq!>$Đ R@JHi! 2AV!'ܐB> @A(PJAU4fZ@h ݠ;A`0 0  `4xL0fl `>, XA ;a쁽80pNi8g<\p]1G 'BL $dRAZH #drB. A($PB9("TPA=h@Sh mtzB/a A0F?@aL)0|X`f;`'p!8 G(p N2\p ?'ϴ@t1!$D@RH!T@69BPAq(%4rP*B% uԇ@Sh-%:@G0 `8O7_I0\ `,e:A6;a솽8cpNI8"܄Kxo-~L!D(At q .ă@RH)  2AfY!drAn J@I( P*CաԄZP@]4ZB+h >` a0FH\ ncsȧX `5 6 `}p 8 pu6܁cxOW>' _+|~gFDQ :ĀB< !$ĐB2H)!5d,rB. A @a(ErP*Ae.ԃ@3h-%B;h tnzCa 00#`7? 043`&̆yJXk!a lm>80pN97܅x/|O~o "D C !ąx@BH! $dRB:H d,r_P@Q(%$2P*B5&ԂPB= 14ZA[ht  n0fl`>,eV*X `=l B`+lvn `?cpy\kpnmw<^kxo #|/w??"Adq!$ RCH!drAnC~(0bPJC( TPjB- u.ԇAchM4ZAkhm:A ݠ;^B?a 0F(  ^ >0D`)Uz !6 `pa8Gpn=!Y,b3K2f9YɬbV3kf# bf'a3#Qs9b.25:se3Syd^17[5'S2!Kr!o `rjvꆡ}:c:s{zWzOa@aH(Caa0x+ aC`1f3Y,e1˙Cxi!=dC A oŠ P*Ae ՠ:ԀzB3h-v:@G tnz@O~`Ca 0<xaL)0t3a̅y0BXa ,V*X k`-M[apq8'3pU7&܂px 97Gy!D B"H I L@V!\<A!( ERP@y2TP jC}h )4VB;h#t.Aw~@C`7aL)0t3ă90BXa), v>80p 8 \p SxG bC >$ĐB:H #d,r@N(bPJB)( 5&ԂPB#Ch ͠9 ZCh =t :C =' !0`2L0f, s`̇ZXal`ͰQ8SpY8\KpU7܆;p}x<'sx/7{>G |o~O!&ąx@V0bPJ@I(,ZB+h =t :C ݠ;^@_a A0aL0rX+a5zaA0f;`'ݰ> p18'$py \kpnM܅{pCx w?ˆ C q .ă$RB9!䆿 |7PB1(%$PBy46@_a?L0 |X a,% X alMa lmvNa}a8 ܀p }x%;xE!$DArH)!4C69 '䁼B1(%$PAy2TPZB+]+tzB/ }` ^70 & `:̀0 Xa ,V*X k`--vn,+pcxO<g ;HC 6āĐBz!;\|7"PAq(% rP*@E TjPjB- >4@[]+tzB/ } \ nc Da Li0fLa̅y0X +`%հz!!6v`7쁽18'$3p*\pCx f?s9c3')4s9˜c.0*se3O+-y|d>1OE`"2L&*`b2L&.I$d0ə4LZ&dc31yL~S)f1rLS4d10͘L+5ӖiǴg1ݙLoӗ `2f(3Ό`F2ьx3nf 3әYlf3Y,d1%RfYf0kuzff0A(s9Μ`17[C1yӐiʹa1NLg ӕb2@f3dF3b73a|?f"3df1sf?s9e1'Si s9\`.2+Us3?̟YDa2јL &&g2ɘL &%Ide39L S)͔a2UL &Sg2L ӖiǴg:0L7ӓf1 f03x3c1xf3La2Ә f&3a2 f5YDŽ0ۙ}!0s9Üe1 Ese1Gc y˼c32̟YDgb0LJ&-Id`0YLn(S)Tb*3ULu&Sa1LCӘi4cZ2L-ӎit`:2LWӛe1@f3 e1ÙHf3a@f3Lf1Kff `v1{>f?s9b3GIsxݼ]E{sUtӮuUWN\E;o+B7*whrݔhBo;EhϭՑ݊intC$ n5ji?:#D2Mi'F>[MPJA9TP j?Ash-?kAu5.4&Ash-t@W=0H  ^@_P*)+&(&*&)&+(*)+f(f*f)f+(*)*)V(V*V)(+(*)*)+()N)(*+.(.+(*+n(n*n+((*)+^*O|K(_CP~3_(D %z(1BJP,䡤 %U(iiY9)*)+ * ) +)+J(J*J)(**(***)*+(*j+(()((*)+:(:*z)z+()(*)(\KwZ=n :k~YAQIV(6+(v+(*))*+*)+n*n)n+()+(*)(*)^+U|SHHHHHHHHȠȨȤKGQ@QXQDQTQLQ\QBQFQVQNQ^QAQQQIQYQCQSQGQOQ_@\RJ^QIEUM]CSK[GO1@1P1T1L1JTx)\ o[1FXXXXXXXXؤQlVlQlSPTVQURVQUSWTRV\R\SPTVQU*>)>+(*)+~(~*~6FRDVDQDUDSPTRVSW$P$T$R$Q$S$WRQSdRdVdUdWPTWPVQUSWTRVSTTTQTUTSP4RRVtSTRVQUW R U S W ?"P1N1I1[1OPHDTL\BRJZFN^AIجئخةإحأثاد88888xxxxxWAIE]C[)"""""""""""""" O(C)"(!)-#'/h h$h/,"*PAfd;aB&z7%vmwjSw`Mg7%qBuIr&gYr\ W M7 M M7. =D] QGAԣztPwO'.#o[Bd{BbGD !bpB 'ޙ਄ޕ`Q0(vn0}7{0`J0$v]0u%8>. o`HpRP?L L.قESK0%L} nCԋ`E0":L3L^IB SG)[(