affy/DESCRIPTION0000644000175400017540000000442513556146135014251 0ustar00biocbuildbiocbuildPackage: affy Version: 1.64.0 Title: Methods for Affymetrix Oligonucleotide Arrays Author: Rafael A. Irizarry , Laurent Gautier , Benjamin Milo Bolstad , and Crispin Miller with contributions from Magnus Astrand , Leslie M. Cope , Robert Gentleman, Jeff Gentry, Conrad Halling , Wolfgang Huber, James MacDonald , Benjamin I. P. Rubinstein, Christopher Workman , John Zhang Maintainer: Rafael A. Irizarry Depends: R (>= 2.8.0), BiocGenerics (>= 0.1.12), Biobase (>= 2.5.5) Imports: affyio (>= 1.13.3), BiocManager, graphics, grDevices, methods, preprocessCore, stats, utils, zlibbioc Suggests: tkWidgets (>= 1.19.0), affydata, widgetTools LinkingTo: preprocessCore Description: The package contains functions for exploratory oligonucleotide array analysis. The dependence on tkWidgets only concerns few convenience functions. 'affy' is fully functional without it. License: LGPL (>= 2.0) Collate: ProgressBarText.R ppset.ttest.R ppsetApply.R expressoWidget.R getCDFenv.R AffyRNAdeg.R avdiff.R barplot.ProbeSet.R bg.Affy.chipwide.R bg.R expresso.R fit.li.wong.R generateExprVal.method.avgdiff.R generateExprVal.method.liwong.R generateExprVal.method.mas.R generateExprVal.method.medianpolish.R generateExprVal.method.playerout.R hlog.R justrma.R loess.normalize.R maffy.R mas5.R merge.AffyBatch.R normalize.constant.R normalize.contrasts.R normalize.invariantset.R normalize.loess.R normalize.qspline.R normalize.quantiles.R pairs.AffyBatch.R plot.density.R plotLocation.R plot.ProbeSet.R pmcorrect.mas.R AffyBatch.R mva.pairs.R ProbeSet.R read.affybatch.R rma.R summary.R tukey.biweight.R whatcdf.R xy2indices.R zzz.R biocViews: Microarray, OneChannel, Preprocessing LazyLoad: yes git_url: https://git.bioconductor.org/packages/affy git_branch: RELEASE_3_10 git_last_commit: 82d96e6 git_last_commit_date: 2019-10-29 Date/Publication: 2019-10-29 NeedsCompilation: yes Packaged: 2019-10-29 23:33:49 UTC; biocbuild affy/NAMESPACE0000644000175400017540000000426113556116173013757 0ustar00biocbuildbiocbuilduseDynLib("affy") importFrom(BiocGenerics, updateObject, colnames, boxplot, image) import(affyio) import(zlibbioc) importClassesFrom(Biobase, AnnotatedDataFrame, AssayData, eSet, MIAME, Versioned, VersionedBiobase, Versions) importClassesFrom(methods, ANY, character, environment, integer, matrix, missing, numeric) importMethodsFrom(Biobase, annotatedDataFrameFrom, annotation, assayData, classVersion, "classVersion<-", description, "description<-", experimentData, exprs, "exprs<-", featureNames, "featureNames<-", isCurrent, isVersioned, notes, "notes<-", pData, "pData<-", phenoData, "phenoData<-", preproc, "preproc<-", protocolData, "protocolData<-", rowMedians, sampleNames, "sampleNames<-", se.exprs, "se.exprs<-") importMethodsFrom(methods, initialize, show) importFrom(Biobase, addVigs2WinMenu, assayDataElementReplace, assayDataNew, multiassign, read.AnnotatedDataFrame, read.MIAME, testBioCConnection) importMethodsFrom(BiocGenerics, normalize) importFrom(BiocManager, repositories) importFrom(graphics, abline, axis, barplot, frame, hist, lines, matplot, mtext, pairs, par, plot, points, smoothScatter, text) importFrom(grDevices, dev.interactive, gray) importFrom(methods, as, callNextMethod, getMethod, is, new, slot) importFrom(preprocessCore, normalize.quantiles, normalize.quantiles.robust, rma.background.correct) importFrom(stats, approx, density, IQR, lm, loess, loess.control, median, medpolish, model.response, model.weights, optim, pnorm, predict, quantile, runif, sd, smooth.spline, splinefun, t.test, terms, var, wilcox.test) importFrom(utils, available.packages, contrib.url, data, flush.console, install.packages, object.size) ##export everything that does not start with a . exportPattern("^[^\\.]") export(.setAffyOptions) exportMethods(show, boxplot, image, exprs, "exprs<-", featureNames, geneNames, sampleNames, se.exprs, updateObject) exportClasses("AffyBatch") affy/NEWS0000644000175400017540000001247213556116173013242 0ustar00biocbuildbiocbuildversion 1.41.1 o Fixed bug. attr(r,"constant") <- thisconstant * refconstant to attr(r,"constant") <- refconstant / thisconstant. Reported Aris Floratos. version 1.23.x o Populate new eSet slot 'protocolData' with information from cel files. version 1.17.x o Replaced usage of defunct Biobase classes exprSet and phenoData with ExpressionSet and AnnotatedDataFrame. version 1.4.x [under development] o xy2indices/indices2xy have now a (dangerous) parameter xy.offset. See below for more details. o a new package-wide parameter called 'xy.offset' was added. This is the first towards getting rid of the 'indexing-starting-at-one-and -not-at-zero' difficulty. This package-wide parameter is the only thing one should play play with to change the offset of x/y coordinates for features on a chip. o computeExprSet (method of AffyBatch) has the following (visible) improvements: - better reporting of errors - better handlings ids as parameters (does not crash any longer when unknown ids are given) o indexProbes (method of AffyBatch) sees the deprecated flag 'xy' removed for good. o mmindex (see indexProbes above) o pmindex (see indexProbes above) o ppsetApply: a function to apply a function over the probe sets that can be built from an instance of AffyBatch. This is done in the spirit of esetApply in Biobase (the covariate information in phenoData are directly accessible from the function (see example in the man page). o rma - the subset parameter now works properly. o mva.pairs - now uses a subset to fit the loess curve (much more efficient). also the summary statistics displayed are different. In particular the median and IQR of the M's are shown in the lower triangle. Previously, an IQR of loess curve values was shown. version 1.3.x Things done: 0 (wh:) moved everything related to Cdf-class from 'affy' to 'makecdfenv': R/Cdf.R, R/getLocationsData.Cdf.R, locate.name.R, pmormm.R R/read.cdffile.R, data/cdf.example.rda, man/Cdf-class.Rd man/getLocationsData.Cdf.Rd, man/locate.name.Rd, man/pmormm.Rd man/read.cdffile.Rd, src/read_cdffile.c o read.affybatch2 reads all cel files together in one big hit into an affybatch o the baseline in normalize.AffyBatch,invariant can be selected using a baseline.type parameter. Also changed "progress" to the more standard "verbose". Seemed to be an error since both PM and MM probes were normalized by only PM's where used to establish the normalization, now follows same standard as been introduced for normalize.AffyBatch.quantiles. o Most normalization routines can now be called with the parameter type which specifies whether to be pmonly, mmonly, both together or both separately. This introduces more consistency to the how the normalization routines are actually applied to affybatchs. o express() has been completely removed. Things that would be good to see before next release: o More consistent usage/application of MIAME version 1.2.x: o Autoload of cdfenvs on demand (uses reposTools). Can be configured through the options. o slot 'preprocessing' of the MIAME attribute used to store normalization step information [will be polished, list returned for the moment. Need for a class and check compliance with MIAME standards] o default methods for normalization, bg correction, pm correction and summary now in the package options [options exist for all, but only used by normalize for the moment]. o tuning of the MAS5.0 methods implemented (bgcorrect.mas, ...) [Ben for details. add URL for the comparison he made] o method plot.ProbeSet, an alternative to barplot, to plot probe level information. o parameter 'scale' in the method barplot for ProbeSet. All the barplots are scaled to eachothers.This is the default. o bug in the parser fixed (infinite loop reported with apparently non-standard CEL files.). o bug in the parser fixed (the 'sd' data returned were not correct). o missing slot in the dataset SpikeIn fixed. o The function express() is deprecated. It still functions normally but gives warning mesage. It will be removed in a future release. The function expresso() should be used as a replacement. o bug in normalize.AffyBatch.qspline fixed (thanks to people at Insightful). The expression data matrix sent to normalize.qspline was mistakingly transposed. o The default background on the rma() function has been changed. Now the results from rma() and expresso() should agree completely. o New functions 'xy2indices' and 'indices2xy' to shuttle from x/y pos to indices (like the ones in cdfenvs) (and reverse). o Reformating of the documentation. version 1.1.x: o 'image(cel)' scales to the size (# rows and # cols) of a chip. locations can be plotted over directly ('plotLocations' was fixed accordiginly). o 'write.celfile(cel)' to write Cel objects into .CEL files o 'getInfoInAffyFile' to snoop in CEL and CDF files o 'whatcdf' to get the name of the CDF from the CEL o one more slot in class 'Cdf': cdfName (will match with what is returned by 'whatcdf') o one more slot in class 'Cel': cdfName (returned by whatcdf) o new class 'AffyBatch': cdfName (returned by whatcdf) o extensive set of tests in the directory 'tests/' affy/R/0000755000175400017540000000000013556116173012736 5ustar00biocbuildbiocbuildaffy/R/AffyBatch.R0000644000175400017540000007261613556116173014724 0ustar00biocbuildbiocbuild##RG added a method to store and update the available normalization methods normalize.AffyBatch.methods <- function() .affyInternalEnv[["normalize.AffyBatch.methods"]] upDate.normalize.AffyBatch.methods <- function(x) { if (is.character(x)) .affyInternalEnv[["normalize.AffyBatch.methods"]] <- x } express.summary.stat.methods <- function() .affyInternalEnv[["express.summary.stat.methods"]] upDate.express.summary.stat.methods <- function(x) { if (is.character(x)) .affyInternalEnv[["express.summary.stat.methods"]] <- x } generateExprSet.methods <- function() .affyInternalEnv[["generateExprSet.methods"]] upDate.generateExprSet.methods <- function(x) { if (is.character(x)) .affyInternalEnv[["generateExprSet.methods"]] <- x } bgcorrect.methods <- function() .affyInternalEnv[["bgcorrect.methods"]] upDate.bgcorrect.methods <- function(x) { if (is.character(x)) .affyInternalEnv[["bgcorrect.methods"]] <- x } pmcorrect.methods <- function() .affyInternalEnv[["pmcorrect.methods"]] upDate.pmcorrect.methods <- function(x) { if (is.character(x)) .affyInternalEnv[["pmcorrect.methods"]] <- x } ## computeExprSet: ## - better reporting of errors ## - better handling of ids (does not crash any longer when unknown id) ## - use of the progress bar in Biobase 1.4.4 ## - cleanup of the comments in the code ## indexProbes: ## - deprecated flag 'xy' removed for good if (debug.affy123) cat("-->initAffyBatch\n") ## Inherits from Affybatch ## The accessor 'intensity' gets what is in the slot 'exprs' setClass("AffyBatch", representation=representation( cdfName="character", nrow="numeric", ncol="numeric"), contains="eSet", prototype=prototype( new("VersionedBiobase", versions=c(classVersion("eSet"), AffyBatch="1.2.0")))) setMethod("initialize", signature(.Object="AffyBatch"), ## provide a signature consistent with the new defintion, but that picks up the (implicit) old function(.Object, cdfName="", nrow=0, ncol=0, phenoData, featureData, experimentData=new("MIAME"), annotation=character(0), protocolData=phenoData[,integer(0)], assayData, exprs=matrix(numeric(0), nrow=nrow, ncol=ncol), ## se.exprs ...) { .Object@cdfName <- cdfName .Object@nrow <- nrow .Object@ncol <- ncol dots <- list(...) ## remove reporterInfo, description, notes from '...' if ("reporterInfo" %in% names(dots)) { if (missing(featureData)) { if (!is.null(dots[["reporterInfo"]])) { if (is(dots[["reporterInfo"]], "data.frame")) { featureData <- new("AnnotatedDataFrame", data=dots[["reporterInfo"]]) } else { warning("trying to convert reporterInfo (class '", class(dots[["reporterInfo"]]), "') to featureData (class 'AnnotatedDataFrame')", immediate.=TRUE) featureData <- as(dots[["reporterInfo"]], "AnnotatedDataFrame") } } else { stop("use 'featureData' rather than 'reporterInfo' for feature covariates") } } } if ("description" %in% names(dots)) { if (missing(experimentData)) experimentData <- dots[["description"]] else stop("use 'experimentData' rather than 'description' for experiment description") } if ("notes" %in% names(dots)) { ## warning("addding 'notes' to 'experimentData'") notes(experimentData) <- c(notes(experimentData), dots[["notes"]]) } dots <- dots[!names(dots) %in% c("reporterInfo", "description", "notes")] ## update phenoData to AnnotatedDataFrame, if necessary if (missing(assayData)) { assayData <- do.call(assayDataNew, c(list(exprs=exprs), dots)) } else if (!missing(exprs)) { stop("cannot initialize when both 'assayData' and 'exprs' are specified") } if (missing(phenoData) || is.null(phenoData)) phenoData <- annotatedDataFrameFrom(assayData, byrow=FALSE) else if (!is(phenoData, "AnnotatedDataFrame")) phenoData <- as(phenoData, "AnnotatedDataFrame") if (missing(featureData)) featureData <- annotatedDataFrameFrom(assayData, byrow=TRUE) callNextMethod(.Object, assayData=assayData, phenoData=phenoData, featureData=featureData, experimentData=experimentData, annotation=annotation, protocolData=protocolData) }) setMethod("updateObject", signature(object="AffyBatch"), function(object, ..., verbose=FALSE) { if (verbose) message("updateObject(object = 'AffyBatch'") if (isVersioned(object) && isCurrent(object)["AffyBatch"]) return(callNextMethod()) if (!isVersioned(object) || is.null(classVersion(object)[["AffyBatch"]])) { exprs <- slot(object, "exprs") se.exprs <- slot(object, "se.exprs") if (!all(dim(se.exprs) == dim(exprs))) { if (!all(dim(se.exprs)==0)) warning("removing 'se.exprs' with dimensions different from 'exprs'") se.exprs <- NULL } if ("reporterInfo" %in% names(attributes(object)) && any(dim(slot(object, "reporterInfo"))!=0)) warning("reporterInfo data not transfered to 'AffyBatch' object") experimentData=updateObject(slot(object, "description")) if ("notes" %in% names(attributes(object)) && length(slot(object, "notes"))!=0) { warning("adding 'notes' to 'experimentData'") notes(experimentData) <- c(notes(experimentData), object@notes) } if (!is.null(se.exprs)) new("AffyBatch", phenoData=as(slot(object, "phenoData"), "AnnotatedDataFrame"), experimentData=experimentData, annotation=slot(object, "annotation"), cdfName=slot(object, "cdfName"), nrow=slot(object, "nrow"), ncol=slot(object, "ncol"), exprs=exprs, se.exprs=se.exprs) else new("AffyBatch", phenoData=as(slot(object, "phenoData"), "AnnotatedDataFrame"), experimentData=experimentData, annotation=slot(object, "annotation"), cdfName=slot(object, "cdfName"), nrow=slot(object, "nrow"), ncol=slot(object, "ncol"), exprs=exprs) } else if (!isCurrent(object)[["AffyBatch"]]) { ## remove empty se.exprs, introduced in class version 1.2.0 se.exprs <- assayData(object)[["se.exprs"]] if (!is.null(se.exprs) && all(is.na(se.exprs))) { message("removing 'se.exprs' with all NA values") se.exprs(object) <- NULL } object <- callNextMethod() classVersion(object)["AffyBatch"] <- classVersion("AffyBatch")["AffyBatch"] object } else object }) ####################################################### ### accessors ####################################################### if (debug.affy123) cat("--->accessors\n") setMethod("exprs", signature(object="AffyBatch"), function(object) assayData(object)[["exprs"]]) setReplaceMethod("exprs", signature(object="AffyBatch"), function(object, value) { assayDataElementReplace(object, "exprs", value, validate=FALSE) }) setMethod("se.exprs", signature(object="AffyBatch"), function(object) { obj <- assayData(object)[["se.exprs"]] if (is.null(obj)) new("matrix") else obj }) setReplaceMethod("se.exprs", signature(object="AffyBatch"), function(object, value) { assayDataElementReplace(object, "se.exprs", value, validate=FALSE) }) if (is.null(getGeneric("cdfName"))) setGeneric("cdfName", function(object) standardGeneric("cdfName")) setMethod("cdfName", "AffyBatch", function(object) object@cdfName) ##intensity setGeneric("intensity", function(object) standardGeneric("intensity")) setMethod("intensity", signature(object="AffyBatch"), function(object) assayData(object)[["exprs"]]) setGeneric("intensity<-", function(object, value) standardGeneric("intensity<-")) setReplaceMethod("intensity", signature(object="AffyBatch"), function(object, value) { assayDataElementReplace(object, "exprs", value, validate=FALSE) }) ##for now, there is no accessor for se.exprs. we could use this to store ##sd, but if no one uses it... why do it setMethod("length",signature(x="AffyBatch"), function(x) ncol(exprs(x))) ##RI: assumes matrices setMethod("dim", signature=signature(x="AffyBatch"), function(x) c(x@nrow, x@ncol)) ####################################################### ### methods ####################################################### setMethod("featureNames", signature=signature(object="AffyBatch"), function(object) { cdf.envir <- getCdfInfo(object) ls(envir=cdf.envir) }) setReplaceMethod("featureNames", signature=signature( object="AffyBatch", value="ANY"), function(object, value) stop("Cannot change featureNames of AffyBatch")) ##geneNames method if (debug.affy123) cat("--->geneNames\n") if( is.null(getGeneric("geneNames") )) setGeneric("geneNames", function(object) standardGeneric("geneNames")) setMethod("geneNames",signature("AffyBatch"), function(object){ cdf.envir <- getCdfInfo(object) return(ls(envir=cdf.envir)) }) ##show method if (debug.affy123) cat("--->show\n") setMethod("show", "AffyBatch", function(object) { if (!isVersioned(object) || classVersion(object)["AffyBatch"] < "1.1.0") stop("AffyBatch out-of-date; use 'updateObject()'", call.=FALSE) if (!isCurrent(object)['AffyBatch']) message("AffyBatch out-of-date; consider 'updateObject()'") ## Location from cdf env cdf.env <- tryCatch(getCdfInfo(object), error=function(err) { warning("missing cdf environment! in show(AffyBatch)", call.=FALSE) NULL }) num.ids <- if (!is.null(cdf.env)) length(ls(envir=cdf.env)) else num.ids <- "???" cat("AffyBatch object\n") cat("size of arrays=", nrow(object), "x", ncol(object), " features (", object.size(object) %/% 1024, " kb)\n", sep="") cat("cdf=", object@cdfName, " (", num.ids, " affyids)\n", sep="") cat("number of samples=", length(object), "\n", sep="") cat("number of genes=", length(featureNames(object)), "\n", sep="") cat("annotation=", object@annotation, "\n", sep="") if(length(notes(object)) > 0) cat("notes=",paste(notes(object),collapse="\n\t"), "\n", sep="") }) # if (is.null(getGeneric("index2xy"))) { # setGeneric("indexProbes", function(object, which, ...) # standardGeneric("indexProbes")) # } ## indexProbes if( is.null(getGeneric("indexProbes"))) setGeneric("indexProbes", function(object, which, ...) standardGeneric("indexProbes")) setMethod("indexProbes", signature=c(object="AffyBatch", which="missing"), function(object, which, ...) indexProbes(object, which="pm", ...)) setMethod("indexProbes", signature("AffyBatch", which="character"), function(object, which=c("pm", "mm","both"), genenames=NULL) { which <- match.arg(which) i.probes <- match(which, c("pm", "mm", "both")) ## i.probes will know if "[,1]" or "[,2]" ## if both then [,c(1,2)] if(i.probes==3) i.probes=c(1,2) envir <- getCdfInfo(object) if(is.null(genenames)) genenames <- ls(envir ) ## note: the variable name genenames could be confusing (the same gene can be ## found in several affyid (ex: the 3' and 5' controls) ans <- mget(genenames, envir, ifnotfound=NA) ## this kind of thing could be included in 'mget' as ## an extra feature. A function could be specified to ## process what is 'multi'-get on the fly for (i in seq(along=ans)) { if ( is.na(ans[[i]][1]) ) next ##as.vector cause it might be a matrix if both tmp <- as.vector(ans[[i]][, i.probes]) ans[[i]] <- tmp } return(ans) }) ##pmindex method if( is.null(getGeneric("pmindex"))) setGeneric("pmindex", function(object,...) standardGeneric("pmindex")) ##wrapper setMethod("pmindex", "AffyBatch", function(object, genenames=NULL) indexProbes(object, "pm", genenames=genenames)) ##mmindex method if( is.null(getGeneric("mmindex"))) setGeneric("mmindex", function(object,...) standardGeneric("mmindex")) ##wrapper setMethod("mmindex", "AffyBatch", function(object,genenames=NULL) indexProbes(object, "mm", genenames=genenames)) ##probeNames method if( is.null(getGeneric("probeNames"))) setGeneric("probeNames", function(object, ...) standardGeneric("probeNames")) setMethod("probeNames","AffyBatch", function(object, genenames=NULL, mm=FALSE){ if(mm) Index <- mmindex(object,genenames) else Index <- pmindex(object,genenames) reps <- unlist(lapply(Index,length),use.names=FALSE) rep(names(Index),reps) }) if( is.null(getGeneric("probes")) ) setGeneric("probes", function(object, ...) standardGeneric("probes")) setMethod("probes", signature("AffyBatch"), function(object, which=c("pm", "mm"), genenames=NULL, LISTRUE=FALSE, drop=FALSE){ which <- match.arg(which) index <- indexProbes(object, which, genenames) if(LISTRUE) ans <- lapply(index, function(i) exprs(object)[i, ,drop=drop]) else{ index <- unlist(index) ans <- exprs(object)[index, ,drop=drop] colnames(ans) <- sampleNames(object) rownames(ans) <- names(index) } return(ans) }) ##pm method if( is.null(getGeneric("pm") )) setGeneric("pm", function(object, ...) standardGeneric("pm")) setMethod("pm","AffyBatch", function(object, genenames=NULL, LISTRUE=FALSE){ if(is.null(genenames) & !LISTRUE){ cdfname <- getCdfInfo(object) psets<- as.list(cdfname) psets<- psets[order(names(psets))] index <-unlist(sapply(psets, function(x) x[,1]),use.names=FALSE) return(exprs(object)[index,,drop=FALSE]) } else{ return(probes(object, "pm", genenames, LISTRUE=LISTRUE)) } }) if( is.null(getGeneric("pm<-") )) setGeneric("pm<-", function(object, value) standardGeneric("pm<-")) setReplaceMethod("pm", "AffyBatch", function(object, value){ Dimnames <- dimnames(exprs(object)) cdfname <- getCdfInfo(object) psets<- as.list(cdfname) psets<- psets[order(names(psets))] pmIndex <-unlist(sapply(psets, function(x) x[,1]),use.names=FALSE) exprs(object)[pmIndex,] <- value dimnames(exprs(object)) <- Dimnames object }) ##mm method if( is.null(getGeneric("mm") )) setGeneric("mm", function(object, ...) standardGeneric("mm")) setMethod("mm",signature("AffyBatch"), function(object, genenames=NULL, LISTRUE=FALSE){ if(is.null(genenames) & !LISTRUE){ cdfname <- getCdfInfo(object) psets<- as.list(cdfname) psets<- psets[order(names(psets))] index <-unlist(sapply(psets, function(x) x[,2]),use.names=FALSE) return(exprs(object)[index,,drop=FALSE]) } else{ probes(object, "mm", genenames, LISTRUE=LISTRUE) } }) if( is.null(getGeneric("mm<-") )) setGeneric("mm<-", function(object, value) standardGeneric("mm<-")) setReplaceMethod("mm", "AffyBatch", function(object, value){ Dimnames <- dimnames(exprs(object)) cdfname <- getCdfInfo(object) psets<- as.list(cdfname) psets<- psets[order(names(psets))] mmIndex <-unlist(sapply(psets, function(x) x[,2]),use.names=FALSE) exprs(object)[mmIndex,] <- value dimnames(exprs(object)) <- Dimnames object }) ###probeset setGeneric("probeset", function(object, ...) standardGeneric("probeset")) setMethod("probeset", "AffyBatch", function(object, genenames=NULL, locations=NULL){ oldoptions <- getOption("BioC") if(is.null(locations)) ##use info in cdf envir <- getCdfInfo(object) else{ ##if the user gives a list of locations let them use that as enviromnet envir <- new.env() multiassign(names(locations), locations, envir) object@cdfName <- "envir" newoptions <- oldoptions newoptions$affy$probesloc[[1]]$what <- "environment" newoptions$affy$probesloc[[1]]$where <- parent.env(envir) options("BioC"=newoptions) } if(is.null(genenames)) genenames <- ls(envir) p.pps <- vector("list", length(genenames)) names(p.pps) <- genenames for (i in seq(along=genenames)) { i.pm <- indexProbes(object, "pm", genenames[i])[[1]] if (is.na(i.pm)[1]) intensity.pm <- matrix() else intensity.pm <- intensity(object)[i.pm, , drop=FALSE] i.mm <- indexProbes(object, "mm", genenames[i])[[1]] if (is.na(i.mm)[1]) intensity.mm <- matrix() else intensity.mm <- intensity(object)[i.mm, , drop=FALSE] p.pps[[i]] <- new("ProbeSet", id = genenames[i], pm = intensity.pm, mm = intensity.mm) } options("BioC"=oldoptions) return(p.pps) }) if (debug.affy123) cat("--->[[\n") ##[[: no more [[, because no more cel class # setMethod("[[", "AffyBatch", # function(x, i, j, ...) { ##no need for j # return(new("Cel", # intensity = matrix(intensity(x)[, i], ncol(x), nrow(x)), # name = sampleNames(x)[i], # cdfName = x@cdfName, # history = description(x)@preprocessing)) # }) ##[[ we need replacement that takes an entry by the Cel in value ##[ subseting. can only happen by sample. for now not by gene setMethod("[", "AffyBatch", function(x, i, j,..., drop=FALSE) { if (!missing(i) & missing(j)) { warning("The use of abatch[i,] and abatch[i] is deprecated. Please use abatch[,i] instead.\n") x <- x[,i] } if (!missing(j)) { phenoData(x) <- phenoData(x)[j, , ..., drop=FALSE] intensity(x) <- intensity(x)[ ,j, ..., drop=FALSE] if (!identical(se.exprs(x), new("matrix"))) { se.exprs(x) <- se.exprs(x)[ ,j, ..., drop=FALSE] } protocolData(x) <- protocolData(x)[j, , ..., drop=FALSE] } return(x) }) setReplaceMethod("[", "AffyBatch", function(x, i, j,..., value) { phenoData(x)[i,, ...] <- phenoData(value)[i, , ..., drop=FALSE] intensity(x)[,i] <- intensity(value)[ ,i,... , drop=FALSE] protocolData(x)[i,, ...] <- protocolData(value)[i, , ..., drop=FALSE] return(x) }) ## --- bg.correct if (debug.affy123) cat("--->bg.correct\n") if( is.null(getGeneric("bg.correct") )) setGeneric("bg.correct", function(object, method, ...) standardGeneric("bg.correct")) setMethod("bg.correct", signature(object="AffyBatch", method="character"), function(object, method=getOption("BioC")$affy$bgcorrect.method, ...) { ## simple for system to let one add background correction methods ## relies on naming convention method <- match.arg(method, bgcorrect.methods()) methodname <- paste("bg.correct.", method, sep="") if (! exists(methodname)) stop(paste("Unknown method (cannot find function", methodname, ")")) r <- do.call(methodname, alist(object, ...)) return(r) }) ## --- normalize.methods if( is.null(getGeneric("normalize.methods"))) setGeneric("normalize.methods", function(object) standardGeneric("normalize.methods")) setMethod("normalize.methods", signature(object="AffyBatch"), function(object) { normalize.AffyBatch.methods() }) ## ---normalize if (is.null(getGeneric("normalize"))) setGeneric("normalize", function(object, ...) standardGeneric("normalize")) setMethod("normalize", signature(object="AffyBatch"), function(object, method=getOption("BioC")$affy$normalize.method, ...) { method <- match.arg(method, normalize.AffyBatch.methods()) if (is.na(method)) stop("unknown method") method <- paste("normalize.AffyBatch", method, sep=".") object <- do.call(method, alist(object, ...)) ## collect info in the attribute "normalization" preproc <- c(description(object)@preprocessing, list(normalization = attr(object, "normalization"))) attr(object, "normalization") <- NULL ## and store it in MIAME MIAME <- description(object) MIAME@preprocessing <- preproc description(object) <- MIAME ## return(object) }) ## --- expression value computation if (debug.affy123) cat("--->computeExprSet\n") if( is.null(getGeneric("computeExprSet"))) setGeneric("computeExprSet", function(x, pmcorrect.method, summary.method, ...) standardGeneric("computeExprSet")) setMethod("computeExprSet", signature(x="AffyBatch", pmcorrect.method="character", summary.method="character"), function(x, pmcorrect.method, summary.method, ids=NULL, verbose=TRUE, summary.param=list(), pmcorrect.param=list()) { pmcorrect.method<- match.arg(pmcorrect.method, pmcorrect.methods()) summary.method <- match.arg(summary.method, express.summary.stat.methods()) ids <- unname(ids) n <- length(x) ## if 'ids' is NULL compute for all ids if (is.null(ids)) ids <- featureNames(x) m <- length(ids) pps.warnings <- vector("list", length=m) ## cheap trick to (try to) save time c.pps <- new("ProbeSet", pm=matrix(), mm=matrix()) ## matrix to hold expression values exp.mat <- matrix(NA, m, n) se.mat <- matrix(NA, m, n) if (verbose) { cat(m, "ids to be processed\n") countprogress <- 0 } ## loop over the ids mycall <- as.call(c(getMethod("express.summary.stat", signature=c("ProbeSet","character", "character")), list(c.pps, pmcorrect=pmcorrect.method, summary=summary.method, summary.param=summary.param, pmcorrect.param=pmcorrect.param)) ) ##only one character cause no more bg correct ##bg.correct=bg.method, param.bg.correct=bg.param, CDFINFO <- getCdfInfo(x) ##do it once! if (verbose) { pbt <- new("ProgressBarText", length(ids), barsteps = as.integer(20)) open(pbt) } for (i in seq(along=ids)) { if (verbose) { updateMe(pbt) } id <- ids[i] if (! exists(id, envir=CDFINFO)) { pps.warnings[[i]] <- paste("Unknown id", id) } else { ## locations for an id loc <- get(id, envir=CDFINFO) l.pm <- loc[, 1] if (ncol(loc) == 2) l.mm <- loc[ ,2] else l.mm <- integer() np <- length(l.pm) ##names are skipped c.pps@pm <- intensity(x)[l.pm, , drop=FALSE] c.pps@mm <- intensity(x)[l.mm, , drop=FALSE] ## generate expression values ## (wrapped in a sort of try/catch) mycall[[2]] <- c.pps ev <- try(eval(mycall), silent = TRUE) } if (! inherits(ev, "try-error")) { exp.mat[i, ] <- ev$exprs se.mat[i,] <- ev$se.exprs } else { pps.warnings[[i]] <- ev[1] } } if (verbose) { close(pbt) } dimnames(exp.mat) <- list(ids, sampleNames(x)) dimnames(se.mat) <- list(ids, sampleNames(x)) eset <- new("ExpressionSet", phenoData=phenoData(x), ## featureData picked up from exprs experimentData=experimentData(x), exprs=exp.mat, se.exprs=se.mat, annotation=annotation(x), protocolData=protocolData(x)) attr(eset, "pps.warnings") <- pps.warnings return(eset) }) ##some methods i was asked to add setMethod("image",signature(x="AffyBatch"), function(x, transfo=log, col=gray(c(0:64)/64), xlab="", ylab="",type=c("exprs","se.exprs"), main, ...){ scn <- prod(par("mfrow")) ask <- dev.interactive() which.plot <- 0 type <- match.arg(type) if (type == "se.exprs" && all(!dim(se.exprs(x)))){ stop("no se.exprs in object") } x.pos <- (1:nrow(x)) - (1 + getOption("BioC")$affy$xy.offset) y.pos <- (1:ncol(x)) - (1 + getOption("BioC")$affy$xy.offset) for(i in 1:length(sampleNames(x))){ which.plot <- which.plot+1; if(trunc((which.plot-1)/scn)==(which.plot-1)/scn && which.plot>1 && ask) par(ask=TRUE) if (type == "exprs"){ m <- exprs(x)[,i] } else { m <- se.exprs(x)[,i] } if (is.function(transfo)) { m <- transfo(m) } m <- as.matrix(rev(as.data.frame(matrix(m, nrow=length(x.pos), ncol=length(y.pos))))) if( missing(main) ){ main.cur=sampleNames(x)[i] } else { main.cur <- main } image(x.pos, y.pos, m, col=col, main=main.cur, xlab=xlab, ylab=ylab,,xaxt='n', yaxt='n', ...) par(ask=FALSE) } }) ##some special handling of main is needed setMethod("boxplot",signature(x="AffyBatch"), function(x, which="both", range=0, main, ...){ tmp <- description(x) if( missing(main) && (is(tmp, "MIAME")) ) main <- tmp@title tmp <- unlist(indexProbes(x,which)) tmp <- tmp[seq(1,length(tmp),len=5000)] boxplot(data.frame(log2(intensity(x)[tmp,])), main=main, range=range, ...) }) ###hist if (debug.affy123) cat("--->hist\n") if( is.null(getGeneric("hist")) ) setGeneric("hist") setMethod("hist",signature(x="AffyBatch"), function(x,...) plotDensity.AffyBatch(x,...)) if( is.null(getGeneric("mas5calls")) ) setGeneric("mas5calls", function(object,...) standardGeneric("mas5calls")) setMethod("mas5calls",signature(object="AffyBatch"), function(object,...) mas5calls.AffyBatch(object,...)) ##like for ExpressionSet "$.AffyBatch" <- function(affybatch, val) (pData(affybatch))[[as.character(val)]] affy/R/AffyRNAdeg.R0000644000175400017540000000576413556116173015003 0ustar00biocbuildbiocbuild"AffyRNAdeg" <- function (abatch,log.it=TRUE) { { data <- pm(abatch, LIST = TRUE) if(log.it==TRUE) data <- lapply(data,log2) names <- colnames(exprs(abatch)) probe.set.size <- function(x) { size <- dim(x)[1] return(size) } max.num <- sapply(data, probe.set.size) tab <- (table(max.num)) ord <- order(-as.numeric(tab)) K <- as.numeric(names(tab))[ord[1]] data <- data[max.num == K] } get.row <- function(x, i = 1) { return(x[i, ]) } get.col <- function(x, i = 1) { return(x[, i]) } rowstack <- function(x, i = 1) { return(t(sapply(x, get.row, i))) } colstack <- function(x, i = 1) { return(t(sapply(x, get.col, i))) } N <- length(data) n <- dim(data[[1]])[2] mns <- matrix(nrow = n, ncol = K) sds <- mns for (i in 1:K) { data.stack <- rowstack(data, i) if(dim(data[[1]])[2]==1) data.stack <- t(data.stack) mns[, i] <- colMeans(data.stack) sds[, i] <- apply(data.stack, 2, sd) } mns.orig <- mns mn <- mns[, 1] mns <- sweep(mns, 1, mn) mns <- mns/(sds/sqrt(N)) lm.stats <- function(x) { index <- 0:(length(x) - 1) ans <- summary(lm(x ~ index))$coefficients[2, c(1, 4)] return(ans) } stats <- apply(mns, 1, lm.stats) answer <- list(N, names, mns.orig, sds/sqrt(N), stats[1, ], stats[2, ]) names(answer) <- c("N", "sample.names", "means.by.number", "ses", "slope", "pvalue") return(answer) } "summaryAffyRNAdeg" <- function (rna.deg.obj, signif.digits = 3) { temp.table <- rbind(signif(rna.deg.obj$slope, signif.digits), signif(rna.deg.obj$pvalue, signif.digits)) colnames(temp.table) <- rna.deg.obj$sample.names rownames(temp.table) <- c("slope", "pvalue") ##write.table(temp.table, file = "", quote = FALSE) return(temp.table) } "plotAffyRNAdeg" <- function (rna.deg.obj,transform="shift.scale",cols=NULL, ...) { if(!is.element(transform,c("shift.scale","shift.only","neither"))) stop("Tranform must be 'shift.scale','shift.only', or 'neither'") mns <- rna.deg.obj$means.by.number if(is.null(cols)) cols=rep(4,dim(mns)[1]) ylab="Mean Intensity" if(transform=="shift.scale"){ sds <- rna.deg.obj$ses mn <- mns[, 1] mns <- sweep(mns, 1, mn) mns <- mns/(sds) mns <- sweep(mns, 1, 1:(dim(mns)[1]), "+") ylab <- paste(ylab,": shifted and scaled") }else if(transform=="shift.only"){ mn <- mns[, 1] mns <- sweep(mns, 1, mn) mns <- sweep(mns, 1, 1:(dim(mns)[1]), "+") ylab <- paste(ylab,": shifted") } plot(-2, -1, pch = "", xlim = range(-1, (dim(mns)[2])), ylim = range(min(as.vector(mns)) - 1, max(as.vector(mns)) + 1), xlab = "5' <-----> 3'\n Probe Number ", ylab = ylab, axes = FALSE, main = "RNA degradation plot", ...) axis(1) axis(2) for (i in 1:dim(mns)[1]) lines(0:((dim(mns)[2]-1)), mns[i, ],col=cols[i]) } affy/R/ProbeSet.R0000644000175400017540000001142413556116173014606 0ustar00biocbuildbiocbuild ## A ProbeSet holds probe values for a probe pairs set(*) accross a batch of experiments. ## methods 'express.summary.stat' returns of expression value per experiement in the ## batch, and 'bg.correct' does background correction (in some sense... the MM probes ## were created to measure unspecific hybridization. People thought that doing ## PM - MM would remove background noise. The method 'bg.correct' accepts extra parameters ## through '...' (can be used to pass background correction parameters common to different ## ProbeSet) ## ## - ## (*) : a probe pair set is the set of probes pairs(**) related to an affyid. Generally a ## a probe pair set has 20 elements. ## (**): a probe pair (or atom) is a pair of PM/MM values ## if (debug.affy123) cat("-->initProbeSet\n") setClass("ProbeSet", representation(id="character", pm="matrix", mm="matrix"), prototype=list(pm=matrix(), mm=matrix())) setMethod("show", "ProbeSet", function(object) { cat("ProbeSet object:\n") cat(" id=", object@id, "\n", sep="") cat(" pm=", nrow(object@pm), "probes x ", ncol(object@pm), " chips\n") }) ##DEBUG: what to do with that ? ## --> with what ? setMethod("sampleNames", "ProbeSet", function(object) colnames(object)) setMethod("colnames", signature(x="ProbeSet"), function(x ,do.NULL=FALSE, prefix="row") { cnames<-colnames(pm(x)) if (is.null(cnames)) { if (do.NULL) { warning("No column names for ProbeSet") } else { cnames <- paste(prefix, 1:ncol(x@pm)) } } return(cnames) }) ## pm if( is.null(getGeneric("pm"))) setGeneric("pm", function(object) standardGeneric("pm")) setMethod("pm", "ProbeSet", function(object) object@pm) if( is.null(getGeneric("pm<-"))) setGeneric("pm<-", function(object, value) standardGeneric("pm<-")) setReplaceMethod("pm", signature=c("ProbeSet", "matrix"), function(object, value) { if (! all(dim(value) == dim(object@mm))) stop("dimension mismatch between 'pm' and 'mm'") object@pm <- value }) ## mm if( is.null(getGeneric("mm"))) setGeneric("mm", function(object) standardGeneric("mm")) setMethod("mm", "ProbeSet", function(object) object@mm) if( is.null(getGeneric("mm<-"))) setGeneric("mm<-", function(object, value) standardGeneric("mm<-")) setReplaceMethod("mm", signature=c("ProbeSet", "matrix"), function(object, value) { if (sum(dim(value) == dim(object@mm)) != 2) stop("dimension mismatch between 'pm' and 'mm'") object@mm <- value }) ## method express.summary.stat if( is.null(getGeneric("express.summary.stat"))) setGeneric("express.summary.stat", function(x, pmcorrect, summary, ...) standardGeneric("express.summary.stat")) setMethod("express.summary.stat",signature(x="ProbeSet", pmcorrect="character", summary="character"), function(x, pmcorrect, summary, summary.param=list(), pmcorrect.param=list()) { pmcorrect <- match.arg(pmcorrect, pmcorrect.methods()) summary <- match.arg(summary, express.summary.stat.methods()) ## simple for system to let one add background correction methods ## relies on naming convention pmcorrect.methodname <- paste("pmcorrect.", pmcorrect, sep="") summary.methodname <- paste("generateExprVal.method.", summary, sep="") if (! exists(summary.methodname)) stop(paste("Unknown method (cannot find function", summary.methodname, ")")) if (! exists(pmcorrect.methodname)) stop(paste("Unknown method (cannot find function", pmcorrect.methodname, ")")) ## NOTE: this could change... #m <- do.call(bg.correct, c(alist(x@pm, x@mm), param.bg.correct)) pm.corrected <- do.call(pmcorrect.methodname, c(alist(x), pmcorrect.param)) r <- do.call(summary.methodname, c(alist(pm.corrected), summary.param)) ##DEBUG: name stuff to sort #names(r) <- names(allprobes) return(r) }) setMethod("barplot",signature(height="ProbeSet"),function(height,...) barplot.ProbeSet(height,...)) if( is.null(getGeneric("mas5calls")) ) setGeneric("mas5calls", function(object,...) standardGeneric("mas5calls")) setMethod("mas5calls",signature(object="ProbeSet"), function(object,...) mas5calls.ProbeSet(object,...)) affy/R/ProgressBarText.R0000644000175400017540000000610613556116173016162 0ustar00biocbuildbiocbuilddebug.affy123 <- FALSE setClass("ProgressBarText", representation(steps = "integer", barsteps = "integer", internals = "environment")) setMethod("initialize", "ProgressBarText", function(.Object, steps, barsteps = 10, internals = NULL) { ##.Object <- callNextMethod() if ( ! is.null(internals)) { stop("slot 'internals' is for internal use !") } .Object@barsteps = barsteps .Object@internals = new.env() assign("milestones.i", as.integer(1), envir=.Object@internals) assign("increment", as.integer(1), envir=.Object@internals) assign("milestones", as.integer(seq(1, steps, length=barsteps)), envir=.Object@internals) assign("i", as.integer(0), envir=.Object@internals) return(.Object) }) setMethod("open", "ProgressBarText", function(con, header = TRUE) { if (header) { cat("|", paste(rep(" ", con@barsteps), collapse=""), "|\n", sep="") } cat("|") increment <- get("increment", con@internals) milestones.i <- get("milestones.i", con@internals) milestones <- get("milestones", con@internals) while(milestones.i > length(milestones)) { cat("#") } if (.Platform$OS.type == "windows") flush.console() }) ## to avoid 'loosing' the default update. ## (not sure this is the most elegant way to do this) setGeneric("updateMe", function(object, ...) standardGeneric("updateMe")) setMethod("updateMe", "ProgressBarText", function(object) { increment <- get("increment", object@internals) i <- get("i", object@internals) + increment milestones.i <- get("milestones.i", object@internals) milestones <- get("milestones", object@internals) touched <- FALSE while(milestones.i <= length(milestones) && i >= milestones[milestones.i]) { cat("#") milestones.i <- milestones.i + increment touched <- TRUE } ## the 'touch' thing appears to make it save 0.1 sec / 100000 iteration ## (which makes it absolutely mandatory :) ). if (touched) { assign("milestones.i", milestones.i, envir = object@internals) if (.Platform$OS.type == "windows") flush.console() } assign("i", i, , envir = object@internals) }) setMethod("close", "ProgressBarText", function(con) { increment <- get("increment", con@internals) milestones.i <- get("milestones.i", con@internals) milestones <- get("milestones", con@internals) while(milestones.i <= length(milestones)) { cat("#") milestones.i <- milestones.i + increment } assign("milestones.i", milestones.i, envir = con@internals) cat("|\n") if (.Platform$OS.type == "windows") flush.console() }) affy/R/avdiff.R0000644000175400017540000000070013556116173014315 0ustar00biocbuildbiocbuildavdiff <- function(x,verbose=FALSE){ if(missing(x)) stop("Argument x missing, with no default\n") cat("Computing average difference for",dim(x$pm)[2],"columns") avdiff <- apply(x$pm-x$mm,2,function(y){ cat(".") tapply(y,x$name,function(z){ o <- order(z) zz <- z[-c(o[1],o[length(z)])] #take out biggest and smallest mean(z[abs(z-mean(zz))<3*sd(zz)]) }) }) colnames(avdiff) <- x$chip.names return(avdiff) } affy/R/barplot.ProbeSet.R0000644000175400017540000000204113556116173016243 0ustar00biocbuildbiocbuildbarplot.ProbeSet <- function(height, xlab="Probe pair",ylab="Intensity", main=NA, col.pm="red", col.mm="blue", beside=TRUE, names.arg="pp", ask = TRUE, scale = TRUE, ...) { opar <- par()$ask par(ask=ask) on.exit(par(ask=opar)) if (names.arg == "pp") { names.arg <- seq(1, nrow(pm(height))) } col <- c(col.pm, col.mm) if (scale) { ylim <- range(c(pm(height), mm(height)), na.rm=TRUE) } else { ylim <- NULL } if (is.na(main)) { main <- paste(height@id, "( sample", 1:ncol(pm(height)), ")") } else { main <- rep(main, length=ncol(pm(height))) } for (i in 1:ncol(pm(height))) { hh <- rbind(pm(height)[, i], mm(height)[, i]) barplot(hh, xlab=xlab, ylab=ylab, main=main[i], col=col, beside=beside, names.arg=names.arg, ylim = ylim, ...) } } affy/R/bg.Affy.chipwide.R0000644000175400017540000000266513556116173016141 0ustar00biocbuildbiocbuildbg.correct.mas <- function(object, griddim=16) { nchips <- length(object) pm.index <- unique(unlist(indexProbes(object, "pm"))) mm.index <- unique(unlist(indexProbes(object, "mm"))) ## some chips have some probesets without MM probes ## which will return an NA in mm.index mm.index <- mm.index[!is.na(mm.index)] rows <- nrow(object) cols <- ncol(object) allintensities <- intensity(object)[c(pm.index, mm.index), ] # note that the indexing is +1 more than you'd expect because # the c code expects it that way ## (note about the remark above: R indexing starts at 1 and not at 0, ## that's why the indexing is done this way. The package is primarily done to ## be used with R...) allx <- c(pm.index-1, mm.index-1) %% nrow(object) +1 ally <- c(pm.index-1, mm.index-1) %/% nrow(object) + 1 nprobes <- length(allx) corrected <- matrix(.C("affy_background_adjust_R", as.double(as.vector(allintensities)), as.integer(allx), as.integer(ally), as.integer(nprobes), as.integer(nchips), as.integer(rows), as.integer(cols), as.integer(griddim), PACKAGE="affy")[[1]], nprobes, nchips) intensity(object)[c(pm.index, mm.index), ] <- corrected ## and what with the 'non pm or mm' probes ? ## answer: they are not used per Affymetrix Statistical Algorithms Description Document. return(object) } affy/R/bg.R0000644000175400017540000000333513556116173013455 0ustar00biocbuildbiocbuild####These functions take an AffyBatch object "background correct" ####the pms and return an AffyBatch with the background corrected PMs ### bg.parameters <- function(pm, n.pts=2^14){ max.density <- function(x, n.pts){ aux <- density(x, kernel="epanechnikov", n=n.pts, na.rm=TRUE) aux$x[order(-aux$y)[1]] } pmbg <- max.density(pm,n.pts) ##Log helps detect mode bg.data <- pm[pm < pmbg] ##do it again to really get the mode pmbg <- max.density(bg.data,n.pts) bg.data <- pm[pm < pmbg] bg.data <- bg.data - pmbg bgsd <- sqrt(sum(bg.data^2)/(length(bg.data)-1))*sqrt(2)#/.85 sig.data <- pm[pm > pmbg] sig.data <- sig.data-pmbg expmean <- max.density(sig.data,n.pts) alpha <- 1/expmean mubg <- pmbg list(alpha=alpha,mu=mubg,sigma=bgsd) } bg.adjust <- function(pm, n.pts=2^14, ...){ param <- bg.parameters(pm,n.pts) b <- param$sigma pm <- pm - param$mu - param$alpha*b^2 pm + b*((1./sqrt(2*pi))*exp((-1./2.)*((pm/b)^2)))/pnorm(pm/b) } bg.correct.none <- function(object, ...) object ##bg.correct.subtractmm <- function(object){ ## pm(object) <- pm(object) - mm(object) ## return(object) ##} ###bg.correct.rma <- function(object, ...){ ### pm(object) <- apply(pm(object),2,bg.adjust) ### return(object) ##} ## ## this function calls the c code as an alternative to the R code above. ## it should help end the disagreement between rma() and expresso() ## bg.correct.rma <- function(object,...){ pm(object) <- rma.background.correct(pm(object),copy=FALSE) return(object) } ## --- pmcorrect things pmcorrect.subtractmm <- function(object){ pm.corrected <- pm(object) - mm(object) return(pm.corrected) } pmcorrect.pmonly <- function(object) { return(pm(object)) } affy/R/expresso.R0000644000175400017540000000772113556116173014740 0ustar00biocbuildbiocbuildexpresso <- function(afbatch, ## -- bg.correct=TRUE, bgcorrect.method = NULL, bgcorrect.param = list(), ## -- normalize = TRUE, normalize.method = NULL, normalize.param=list(), ## -- pmcorrect.method = NULL, pmcorrect.param = list(), ## -- summary.method = NULL, summary.param = list(), summary.subset = NULL, ## --- verbose = TRUE, widget = FALSE ) { # JZ added this function setCorrections <- function(){ bioc.opt <- getOption("BioC") if(bg.correct){ if(is.null(bgcorrect.method)){ BGMethods <- bgcorrect.methods() }else{ BGMethods <- bgcorrect.method } }else{ BGMethods <- "None" } if(normalize){ if(is.null(normalize.method)){ normMethods <- normalize.methods(afbatch) }else{ normMethods <- normalize.method } }else{ normMethods <- "None" } # Default for this one may not be correct if(is.null(pmcorrect.method)){ PMMethods <- pmcorrect.methods() }else{ PMMethods <- pmcorrect.method } # Default for this one may not be correct if(is.null(summary.method)){ expMethods <- generateExprSet.methods() }else{ expMethods <- summary.method } corrections <- expressoWidget(BGMethods, normMethods, PMMethods, expMethods, bioc.opt$affy$bgcorrect.method, bioc.opt$affy$normalize.method, bioc.opt$affy$pmcorrect.method, bioc.opt$affy$summary.method) if(!is.null(corrections)){ if(corrections[["BG"]] != "None"){ bgcorrect.method <<- corrections[["BG"]] } if(corrections[["NORM"]] != "None"){ normalize.method <<- corrections[["NORM"]] } if(corrections[["PM"]] != "None"){ pmcorrect.method <<- corrections[["PM"]] } if(corrections[["EXP"]] != "None"){ summary.method <<- corrections[["EXP"]] } }else{ stop("Aborted by user") } } if (widget) { require(tkWidgets) || stop("library tkWidgets could not be found !") } nchips <- length(afbatch) ###background stuff must be added before normalization! if(widget){ setCorrections() } ## -- summary of what will be done if (verbose) { if (bg.correct){ cat("background correction:", bgcorrect.method, "\n") } if (normalize) { cat("normalization:", normalize.method, "\n") } cat("PM/MM correction :", pmcorrect.method, "\n") cat("expression values:", summary.method, "\n") } ## -- background correct (if needed) if (bg.correct) { if (verbose) cat("background correcting...") afbatch <- do.call(affy:::bg.correct, c(alist(afbatch, method=bgcorrect.method), bgcorrect.param)) if (verbose) cat("done.\n") } ## -- normalize (if wished) if (normalize) { if (verbose) cat("normalizing...") afbatch <- do.call(BiocGenerics::normalize, c(alist(afbatch, normalize.method), normalize.param)) if (verbose) cat("done.\n") } eset <- computeExprSet(afbatch, summary.method=summary.method, pmcorrect.method= pmcorrect.method, ids=summary.subset, summary.param=summary.param, pmcorrect.param=pmcorrect.param) return(eset) } affy/R/expressoWidget.R0000644000175400017540000000754113556116173016104 0ustar00biocbuildbiocbuild# A function that takes user inputs for correction methods for # expresso (affy). Default values can be missing, in which case the # first element will be chosen as the default. expressoWidget <- function(BGMethods, normMethods, PMMethods, expMethods, BGDefault, normDefault, PMDefault, expDefault){ methodList <- list() END <- FALSE if(any(missing(BGMethods), missing(normMethods), missing(PMMethods), missing(expMethods))){ stop("At least one of the method arguments is missing") } if(any(c(length(BGMethods), length(normMethods), length(PMMethods), length(expMethods)) == 0)){ stop("At least one of the method argument is of length 1") } if(missing(BGDefault)){ BGM <- tclVar(BGMethods[1]) }else{ BGM <- tclVar(BGDefault) } if(missing(normDefault)){ NMM <- tclVar(normMethods[1]) }else{ NMM <- tclVar(normDefault) } if(missing(PMDefault)){ PMM <- tclVar(PMMethods[1]) }else{ PMM <- tclVar(PMDefault) } if(missing(expDefault)){ EXM <- tclVar(expMethods[1]) }else{ EXM <- tclVar(expDefault) } quit <- function(){ tkdestroy(base) } end <- function(){ END <<- TRUE methodList[["BG"]] <<- tclvalue(BGM) methodList[["NORM"]] <<- tclvalue(NMM) methodList[["PM"]] <<- tclvalue(PMM) methodList[["EXP"]] <<- tclvalue(EXM) quit() } base <- tktoplevel() ## post -- hook on.exit(tkdestroy(base)) tktitle(base) <- "Expresso methods selection" ## Description text tkpack(tklabel(base, text = "Welcome to Expresso methods selection"), expand = FALSE, fill = "x", padx = 5, pady = 5) tkpack(tklabel(base, text = paste("You need to choose correction", "methods or go with the defaults")), expand = FALSE, fill = "x", padx = 5) ## Selections for correction methods methodFrame <- tkframe(base) ## Background selection BGLabel <- tklabel(methodFrame, text = "Background correction") BGDropdown <- tkframe(methodFrame) dropdownList(BGDropdown, BGMethods, BGM, 20, tclvalue(BGM), TRUE) tkgrid(BGLabel, BGDropdown) tkgrid.configure(BGLabel, sticky = "e") tkgrid.configure(BGDropdown, sticky = "w") ## Normlization NMLabel <- tklabel(methodFrame, text = "Normalization") NMDropdown <- tkframe(methodFrame) dropdownList(NMDropdown,normMethods, NMM, 20, tclvalue(NMM), TRUE) tkgrid(NMLabel, NMDropdown) tkgrid.configure(NMLabel, sticky = "e") tkgrid.configure(NMDropdown, sticky = "w") ## PM correction PMLabel <- tklabel(methodFrame, text = "PM correction") PMDropdown <- tkframe(methodFrame) dropdownList(PMDropdown, PMMethods, PMM, 20, tclvalue(PMM), TRUE) tkgrid(PMLabel, PMDropdown) tkgrid.configure(PMLabel, sticky = "e") tkgrid.configure(PMDropdown, sticky = "w") ## PM correction EXLabel <- tklabel(methodFrame, text = "Expression") EXDropdown <- tkframe(methodFrame) dropdownList(EXDropdown, expMethods, EXM, 20, tclvalue(EXM), TRUE) tkgrid(EXLabel, EXDropdown) tkgrid.configure(EXLabel, sticky = "e") tkgrid.configure(EXDropdown, sticky = "w") tkpack(methodFrame, expand = TRUE, fill = "both", padx = 5, pady = 10) butFrame <- tkframe(base) quitBut <- tkbutton(butFrame, text = "Quit", width = 7, command = quit) endBut <- tkbutton(butFrame, text = "Select", width = 7, command = end) tkgrid(quitBut, endBut, padx = 5) tkpack(butFrame, expand = FALSE, fill = "x", pady = 5) tkwait.window(base) if(END){ return(methodList) }else{ return(NULL) } } affy/R/fit.li.wong.R0000644000175400017540000002045413556116173015224 0ustar00biocbuildbiocbuildfit.li.wong <- function(data.matrix, remove.outliers=TRUE, normal.array.quantile=0.5, normal.resid.quantile=0.9, large.threshold=3, large.variation=0.8, outlier.fraction=0.14, delta = 1e-06,maxit=50,outer.maxit=50, verbose=FALSE, ...){ if(missing(data.matrix)) stop("Argument data.matrix missing, with no default") II <- dim(data.matrix)[1] ##II instrad of I cause I is a fuction in R J <- dim(data.matrix)[2] if(J==1){ warning("Li and Wong's algorithm is not suitable when only one probe pair") return(list(theta = as.vector(data.matrix), phi = 1, sigma.eps = NA, sigma.theta = NA, sigma.phi=NA, theta.outliers=NA, phi.outliers=NA, single.outliers=NA,convergence1=NA,convergence2=NA,iter = NA, delta = NA)) } cI <- II ##current I cJ <- J ##current J theta.outliers.old <- rep(FALSE, II) ##ith entry will be true if theta_i is an outlier phi.outliers.old <- rep(FALSE, J) ##jth entry will be true if phi_j is an outlier single.outliers.old <- matrix(FALSE, II, J) ##ij entry will be true if y_is an outlier theta.outliers <- theta.outliers.old ##need this to now if change ocurred in outliers phi.outliers <- phi.outliers.old ##need this to know if chages occured in outlies single.outliers <- single.outliers.old flag1 <- NA ##these will be false if convergence not reacher, flag2 <- NA ## this will be false if outliers respectively cuase iter to stop if(remove.outliers){ flag1 <- TRUE; flag2<-TRUE original.data.matrix <- data.matrix ##so we can get it back after outlier removal change.theta <- 1 #start with 1 change.phi <- 1 change.single <- 1 outer.iter <- 0 while(flag1 & flag2 & change.theta+change.phi+change.single >0 & outer.iter < outer.maxit) { outer.iter <- outer.iter + 1 if((outer.iter%%3==0 & change.theta>0) | (outer.iter%%3==1 & change.phi>0)){ #something has to change ##starting values phi <- colMeans(data.matrix) c <- sqrt(cJ/sum(phi[!phi.outliers]^2)) phi <- c * phi theta <- (data.matrix[, !phi.outliers, drop=FALSE] %*% phi[!phi.outliers, drop=FALSE])/cJ iter <- 0 change <- 1 #start with one theta.old <- rep(0, II) while(change > delta & iter < maxit) { iter <- iter + 1 phi <- t(data.matrix[!theta.outliers, ,drop=FALSE]) %*% theta[!theta.outliers, drop=FALSE] ##ignore the outliers c <- sqrt(cJ/sum(phi[!phi.outliers, drop=FALSE]^2)) phi <- c * phi theta <- (data.matrix[,!phi.outliers, drop=FALSE] %*% phi[!phi.outliers, drop=FALSE])/cJ change <- max(abs(theta[!theta.outliers] - theta.old[!theta.outliers])) if(verbose) cat(paste("Outlier iteration:",outer.iter,"estimation iteration:",iter,"chage=",change,"\n")) theta.old <- theta } if(iter>=maxit){ ##convergence not reached. might as well get out warning(paste("No convergence in inner loop after",iter,"in outerler tieration",outer.iter,"\n")) flag1 <- FALSE } if(mean(phi[!phi.outliers]<0)>.5){ ##for identifiability.. theta*phi = (-theta)*(-phi), i require that most phis are positive theta <- -theta phi <- -phi } theta <- as.vector(theta) phi <- as.vector(phi) data.matrixhat <- outer(theta, phi) resid <- data.matrix-data.matrixhat } ##DEALING WITH OUTLIERS ##we alternate removal of outliers ##if even iteration take out thetas that are outliers (as defined by Li and Wong). if(outer.iter%%3==1){ ## we start with single outliers single.outliers <- resid > large.threshold*quantile(abs(resid),normal.resid.quantile) single.outliers[rowSums(single.outliers) > outlier.fraction*cJ,]<-rep(FALSE,J) ##probably chip oulier, defer calling outlier single.outliers[,colSums(single.outliers) > outlier.fraction*cI]<-rep(FALSE,II) ##probably probe outlier, defer calling outlier data.matrix[single.outliers] <- data.matrixhat[single.outliers] data.matrix[!single.outliers] <- original.data.matrix[!single.outliers] change.single <- sum(abs(single.outliers.old-single.outliers)) #sum will be total of changes single.outliers.old <- single.outliers } else{ sigma.theta <- sqrt(rowSums(resid[, !phi.outliers, drop=FALSE]^2)/(cJ - 1)) sigma.phi <- sqrt(colSums(resid[!theta.outliers, , drop=FALSE]^2)/(cI - 1)) ###THETA OUTLIERS if(outer.iter%%3==2){ theta.outliers <- sigma.theta > large.threshold*quantile(sigma.theta,normal.array.quantile) | theta^2/sum(theta^2) > large.variation cI <- sum(!theta.outliers) if(cI<3) { warning("No convergence achieved, too many outliers") flag2 <- FALSE } ##single outliers in outlier chips are not longer single outliers single.outliers[theta.outliers,] <- rep(FALSE,J) data.matrix[single.outliers] <- data.matrixhat[single.outliers] data.matrix[!single.outliers]<-original.data.matrix[!single.outliers] change.theta <- sum(abs(theta.outliers.old-theta.outliers)) #sum will be total of changes change.single <- sum(abs(single.outliers.old-single.outliers)) #sum will be total of changes theta.outliers.old <- theta.outliers } ##PHI OUTLIERS else{ phi.outliers <- sigma.phi > large.threshold*quantile(sigma.phi,normal.array.quantile) | phi^2/sum(phi^2) > large.variation | phi <0 cJ <- sum(!phi.outliers) if(cJ<3) { warning("No convergence achieved, too many outliers") flag2 <- FALSE } single.outliers[,phi.outliers] <- rep(FALSE,II) data.matrix[single.outliers] <- data.matrixhat[single.outliers] data.matrix[!single.outliers]<-original.data.matrix[!single.outliers] change.phi <- sum(abs(phi.outliers.old-phi.outliers)) change.single <- sum(abs(single.outliers.old-single.outliers)) #sum will be total of changes phi.outliers.old <- phi.outliers } } if(verbose){ cat("chips used=",cI,", probes used=",cJ,", single outler=",sum(single.outliers),"\n") cat("Number of changes: single=",change.single,", theta=",change.theta,", phi=",change.phi,"\n",sep="") } } if(outer.iter>=outer.maxit){ warning("No convergence achieved in outlier loop\n") flag2 <- FALSE } all.outliers <- outer(theta.outliers,phi.outliers,FUN="|") | single.outliers sigma <- sqrt(sum(resid[!all.outliers]^2)/sum(!all.outliers)) ##in case we leave iteration and these havent been defined sigma.theta <- sqrt(rowSums(resid[,!phi.outliers, drop=FALSE]^2)/(cJ - 1)) sigma.phi <- sqrt(colSums(resid[!theta.outliers, ,drop=FALSE]^2)/(cI - 1)) } ###code for NO OUTLIER REMOVAL else{ flag1 <- TRUE phi <- colMeans(data.matrix) c <- sqrt(J/sum(phi^2)) phi <- c * phi theta <- (data.matrix %*% phi)/J iter <- 0 change <- 1 theta.old <- rep(0, II) while(change > delta & iter < maxit) { iter <- iter + 1 phi <- t(data.matrix) %*% theta c <- sqrt(J/sum(phi^2)) phi <- c * phi theta <- (data.matrix %*% phi)/J change <- max(abs(theta - theta.old)) if(verbose) cat(paste("Iteration:",iter,"chage=",change,"\n")) theta.old <- theta } if(iter>=maxit){ warning(paste("No convergence after",iter,"iterations.\n")) flag1 <- FALSE } if(mean(phi[!phi.outliers]<0)>.5){ ##for identifiability.. theta*phi = (-theta)*(-phi), i require that most phis are positive theta <- -theta phi <- -phi } theta <- as.vector(theta) phi <- as.vector(phi) data.matrixhat <- outer(theta, phi) sigma.theta <- sqrt(rowSums((data.matrix - data.matrixhat)^2)/(J - 1)) sigma.phi <- sqrt(colSums((data.matrix - data.matrixhat)^2)/(II - 1)) sigma <- sqrt(sum((data.matrix - data.matrixhat)^2)/(II * J)) } return(list(theta = theta, phi = phi, sigma.eps = sigma, sigma.theta = sigma.theta, sigma.phi=sigma.phi,theta.outliers=theta.outliers,phi.outliers=phi.outliers,single.outliers=single.outliers,convergence1=flag1,convergence2=flag2,iter = iter, delta = change)) } affy/R/generateExprVal.method.avgdiff.R0000644000175400017540000000051113556116173021036 0ustar00biocbuildbiocbuild## Currently, the input is a 2 matrices a pm and a mm ##avdiff is more like median than mean, it would be nice to actually have ##avfif ##added typical se of the mean as returned se generateExprVal.method.avgdiff <- function(probes, ...) { list(exprs=apply(probes, 2, median),se.exprs=apply(probes,2,sd)/sqrt(nrow(probes))) } affy/R/generateExprVal.method.liwong.R0000644000175400017540000000052713556116173020736 0ustar00biocbuildbiocbuildgenerateExprVal.method.liwong <- function(probes, ...) { probes <- t(probes) if (ncol(probes) == 1) { warning("method liwong unsuitable when only one probe pair") list(exprs=as.vector(probes),se.exprs=rep(NA,length(probes))) } else { tmp <- fit.li.wong(probes, ...) list(exprs=tmp$theta,se.exprs=tmp$sigma.theta) } } affy/R/generateExprVal.method.mas.R0000644000175400017540000000127213556116173020215 0ustar00biocbuildbiocbuildgenerateExprVal.method.mas <- function(probes, ...) { probes <- log2(probes) M <- ncol(probes) slg <- rep(NA,M) for (i in 1:ncol(probes)) { slg[i] <- tukey.biweight(probes[ ,i], ...) } return(list(exprs=2^slg,se.exprs=rep(NA,M))) } affy.scalevalue.exprSet <- function(eset, sc=500, analysis="absolute") { analysis <- match(analysis, c("absolute", "comparison")) if(analysis == 1) nf <- 1 else stop("sorry! comparison not implemented.") for (i in 1:ncol(exprs(eset))) { slg <- exprs(eset)[, i] sf <- sc / mean(slg, trim=0.02) reported.value <- nf * sf * slg exprs(eset)[, i] <- reported.value } return(eset) } affy/R/generateExprVal.method.medianpolish.R0000644000175400017540000000013313556116173022104 0ustar00biocbuildbiocbuildgenerateExprVal.method.medianpolish <- function(probes, ...) medianpolish(probes, ...) affy/R/generateExprVal.method.playerout.R0000644000175400017540000000217013556116173021457 0ustar00biocbuildbiocbuildgenerateExprVal.method.playerout <- function(probes, weights=FALSE, optim.method="L-BFGS-B"){ probes <- t(probes) nprobes <- ncol(probes) ## skip if only one probe if (nprobes == 1) return(t(probes)) ## I do not know to which extend the use of optim ## is really equivalent to the use of nlminb in S-plus S1 <- optim(runif(nprobes), playerout.costfunction, method=optim.method, control=list(maxit=500), y=probes) ##S1 <- nlm(playerout,runif(20),iterlim=500,y=t(y)) r <- c(probes %*% S1$par / sum(S1$par)) if (weights) attr(r,"weights") <- S1$par return(list(exprs=r,se.exprs=rep(NA,length(r)))) } ## The loss function: playerout.costfunction <- function(w, y) { N <- length(w) # Number of players J <- length(y)/N # Number of games (the number of games is the number of chips used) sumw <- sum(w) tx <- y %*% w # Full weighted score at each game pl <- matrix(0,J,N) # Loss at each game due to each player for(j in 1:J) pl[j,] <- w * y[j,] - (tx[j] - w * y[j,]) / (sumw - w) sum(pl^2) # Loss } affy/R/getCDFenv.R0000644000175400017540000001303613556116173014671 0ustar00biocbuildbiocbuildgetCdfInfo <- function(object, how=getOption("BioC")$affy$probesloc, verbose=FALSE) { ## cdfname is the cdf environment ## methods is a vector detailing how to get the file - one of ## 'library', 'bioC' if (length(how) == 0) stop("No available method to obtain CDF file") cdfname <- cdfName(object) badOut <- list() for (i in 1:length(how)) { cur <- how[[i]] out <- switch(cur$what, "environment" = cdfFromEnvironment(cdfname, cur$where, verbose), "libPath" = cdfFromLibPath(cdfname, cur$where, verbose=verbose), "bioC" = cdfFromBioC(cdfname, cur$where, verbose) ) if (is.environment(out)) return(out) else badOut <- c(badOut, out) } stop(paste("Could not obtain CDF environment, problems encountered:", paste(unlist(badOut),collapse="\n"),sep="\n")) } cdfFromEnvironment <- function(cdfname, where, verbose=TRUE) { if (verbose) print(paste("Attempting to locate",cdfname,"in specified environment")) if (exists(cdfname, inherits=FALSE, where=where)) return(as.environment(get(cdfname,inherits=FALSE,envir=where))) else { if (verbose) print(paste("Specified environment does not contain",cdfname)) return(list(paste("Specified environment does not contain",cdfname))) } } cdfFromBioC <- function(cdfname, lib=.libPaths()[1], verbose=TRUE) { cdfname <- cleancdfname(cdfname) if (verbose) print(paste("Attempting to obtain",cdfname,"from Bioconductor website")) ## First try libPaths libs <- .libPaths() if (!all(lib %in% libs)) libs <- unique(c(lib, libs)) result <- cdfFromLibPath(cdfname, lib=libs, verbose=verbose) if (is.environment(result)) return(result) if (length(lib) > 1) { warning("Ignoring all but first element of argument lib") lib <- lib[1] } if (verbose) print(paste("The environment ",cdfname," was not found in", " these directories: ", paste(libs, collapse=", "), ". Now searching the internet repository.", sep="")) if (verbose) print(paste("Checking to see if your internet connection works ...")) if (testBioCConnection()) { ## Check for file permissions if (file.access(lib, mode=0) < 0) { if (verbose) { print(paste("Directory",lib,"does not seem to exist.\n", "Please check your 'lib' parameter and try again")) return(list("Bioconductor - lib does not exist")) } } if (file.access(lib,mode=2) < 0) { if (verbose) { print(paste("You do not have write access to",lib, "\nPlease check your permissions or provide", "a different 'lib' parameter")) return(list("Bioconductor - lib is not writeable")) } } biocContribUrl <- sapply(repositories(), contrib.url) biocPkgs <- available.packages(biocContribUrl) if (! cdfname %in% biocPkgs[, "Package"]) { if (verbose) print(paste("Environment",cdfname, "was not found in the Bioconductor", "repository.")) return(list(paste("Bioconductor -",cdfname,"not available"))) } else { install.packages(cdfname, lib=lib, repos=repositories(), dependencies=c("Depends","Imports")) ## no way to know if we succeeded or not, with install.packages ##if (verbose) ## print(paste("Installation of environment", ## cdfname, "was succesful.")) } } else { if (verbose) print(paste("The current operation could not access", "the Bioconductor repository. Please", "check your internet connection, and", "report further problems to", "bioconductor@stat.math.ethz.ch")) return(list("Bioconductor - could not connect")) } return(cdfFromLibPath(cdfname, lib=lib, verbose=verbose)) } cdfFromLibPath <- function(cdfname, lib = NULL, verbose=TRUE) { cdfname <- cleancdfname(cdfname) ## First check to see if package is installed if (verbose) print(paste("Checking to see if package",cdfname, "is already installed")) if (length(find.package(cdfname, lib.loc=lib, quiet=TRUE)) == 0) return(list(paste("Library - package",cdfname,"not installed"))) ## See if package is already loaded if (cdfname %in% .packages()) { if (verbose) print(paste("The package", cdfname, "is already loaded")) } else { if (verbose) print(paste("Attempting to load package", cdfname)) ## Attempt to load the library requested do.call(library, list(cdfname, lib.loc=lib, character.only=TRUE)) ## Check to see if it got loaded if (! cdfname %in% .packages()) { ## package didn't get loaded if (verbose) print(paste("The package", cdfname, "could not be loaded")) return(list(paste("Library - package",cdfname,"is not loadable"))) } } return(get(cdfname, envir=as.environment(paste("package:", cdfname, sep="")))) } affy/R/hlog.R0000644000175400017540000000062513556116173014015 0ustar00biocbuildbiocbuild hlog <- function(x,constant=1){ #constant is where the change occurs if(constant<=0){ warning("constant less than or equal to 0. Returning log(x)\n") return(log(x)) } else{ if(constant==Inf) return(x) else{ aux <- (abs(x)=constant)*(sign(x)*(constant*log(abs(x/constant))+constant)) aux[x==0] <- 0 return(aux) } } } affy/R/justrma.R0000644000175400017540000001171413556116173014552 0ustar00biocbuildbiocbuild## Sept 11, 2003 - justRMA calls just.rma2 ### A user friendly wrapper for just.rma justRMA <- function(..., filenames=character(0), widget=getOption("BioC")$affy$use.widgets, compress=getOption("BioC")$affy$compress.cel, celfile.path=getwd(), sampleNames=NULL, phenoData=NULL, description=NULL, notes="", rm.mask=FALSE, rm.outliers=FALSE, rm.extra=FALSE, hdf5=FALSE, hdf5FilePath=NULL,verbose=FALSE, normalize=TRUE, background=TRUE, bgversion=2, destructive=FALSE, cdfname = NULL){ l <- AllButCelsForReadAffy(..., filenames=filenames, widget=widget, celfile.path=celfile.path, sampleNames=sampleNames, phenoData=phenoData, description=description) ##and now we are ready to read cel files ret<- just.rma(filenames=l$filenames, phenoData=l$phenoData, description=l$description, notes=notes, compress=compress, rm.mask=rm.mask, rm.outliers=rm.outliers, rm.extra=rm.extra, verbose=verbose, normalize=normalize, background=background, bgversion=bgversion, destructive=destructive, cdfname = cdfname) sampleNames(ret) <- l$sampleNames return(ret) } ########################################################################################### # # this function uses a different parsing routine # It was added Jul 7, 2003 by B. M. Bolstad # ########################################################################################### just.rma <- function(..., filenames=character(0), phenoData=new("AnnotatedDataFrame"), description=NULL, notes="", compress=getOption("BioC")$affy$compress.cel, rm.mask=FALSE, rm.outliers=FALSE, rm.extra=FALSE, verbose=FALSE, background=TRUE, normalize=TRUE, bgversion=2, destructive=FALSE, cdfname = NULL) { auxnames <- unlist(list(...)) filenames <- c(filenames, auxnames) checkValidFilenames(filenames) n <- length(filenames) pdata <- pData(phenoData) ##try to read sample names form phenoData. if not there use CEL filenames if(dim(pdata)[1]!=n){#if empty pdata filename are samplenames warning("Incompatible phenoData object. Created a new one.\n") samplenames <- gsub("^/?([^/]*/)*", "", unlist(filenames)) pdata <- data.frame(sample=1:n,row.names=samplenames) phenoData <- new("AnnotatedDataFrame", data=pdata, varMetadata=data.frame( labelDescription="arbitrary numbering", row.names="sample")) } else samplenames <- rownames(pdata) if (is.null(description)) { description <- new("MIAME") description@preprocessing$filenames <- filenames description@preprocessing$affyversion <- library(help=affy)$info[[2]][[2]][2] } ## read the first file to see what we have ##if (verbose) cat(1, "reading",filenames[[1]],"...") ## get information from cdf environment headdetails <- read.celfile.header(filenames[[1]]) if(is.null(cdfname)) cdfname <- headdetails[[1]] scandates <- sapply(seq_len(length(filenames)), function(i) { sdate <- read.celfile.header(filenames[i], info = "full")[["ScanDate"]] if (is.null(sdate) || length(sdate) == 0) NA_character_ else sdate }) protocol <- new("AnnotatedDataFrame", data=data.frame("ScanDate"=scandates, row.names = sampleNames(phenoData), stringsAsFactors=FALSE), dimLabels=c("sampleNames", "sampleColumns")) tmp <- new("AffyBatch", cdfName=cdfname, annotation=cleancdfname(cdfname, addcdf=FALSE)) pmIndex <- pmindex(tmp) probenames <- rep(names(pmIndex), unlist(lapply(pmIndex,length))) pNList <- split(0:(length(probenames) -1), probenames) ## read pm data into matrix probeintensities <- read.probematrix(filenames=filenames, cdfname = cdfname) ##pass matrix of pm values to rma ngenes <- length(geneNames(tmp)) exprs <- .Call("rma_c_complete",probeintensities$pm, pNList, ngenes, normalize, background, bgversion, verbose, PACKAGE="affy") colnames(exprs) <- samplenames se.exprs <- array(NA, dim(exprs), dimnames=list(rownames(exprs), colnames(exprs))) annotation <- annotation(tmp) notes(description) <- notes new("ExpressionSet", phenoData = phenoData, protocolData = protocol, annotation = annotation, experimentData = description, exprs = exprs, se.exprs = se.exprs) } affy/R/loess.normalize.R0000644000175400017540000000276613556116173016220 0ustar00biocbuildbiocbuildloess.normalize <- function(mat,subset=sample(1:(dim(mat)[2]),5000), epsilon=10^-2,maxit=1,log.it=TRUE,verbose=TRUE,span=2/3, family.loess="symmetric") { .Deprecated("normalize.loess", "affy") J <- dim(mat)[2] II <- dim(mat)[1] newData <- mat if(log.it){ mat <- log2(mat) newData <- log2(newData) } change <- epsilon +1 fs <- matrix(0,II,J)##contains what we substract iter <- 0 w <- c(0,rep(1,length(subset)),0) ##this way we give 0 weight to the ##extremes added so that we can interpolate while(iter < maxit){ iter <- iter+1 means <- matrix(0,II,J) ##contains temp of what we substract for(j in 1:(J-1)){ for(k in (j+1):J){ y <- newData[,j]-newData[,k] x <-(newData[,j]+newData[,k])/2 index <- c(order(x)[1],subset,order(-x)[1]) ##put endpoints in so we can interpolate xx <- x[index] yy <- y[index] aux <-loess(yy~xx,span=span,degree=1,weights=w,family=family.loess) aux <- predict(aux,data.frame(xx=x))/J means[,j] <- means[,j] + aux means[,k] <- means[,k] - aux if(verbose) cat("Done with",j,"vs",k," in iteration ",iter,"\n") } } fs <- fs+means newData <- mat-fs change <- max(colMeans((means[subset,])^2)) if(verbose) cat(iter,change,"\n") oldfs <- fs } if(change>epsilon & maxit>1) warning(paste("No convergence after",maxit,"iterations.\n")) if(log.it) return(2^newData) else return(newData) } affy/R/maffy.R0000644000175400017540000002500713556116173014167 0ustar00biocbuildbiocbuild##******************************************************************************************* #********** maffy.normalize ***** maffy.normalize <- function(data,subset,verbose=FALSE,span=0.25,family="symmetric",log.it=TRUE){ k <- dim(data)[2] ### Number of chips #### Create the transformation matrix t1 <- 1/sqrt(k) t2 <- (k-2-t1)/(k-1) t3 <- -(1+t1)/(k-1) transmat <- matrix(t3,k,k) for(i in 1:k){ transmat[1,i]<-t1 transmat[i,1]<-t1 } for(i in 2:k) transmat[i,i]<-t2 #### Find normalizing curve if(verbose) cat("Fitting normalizing curve\n") n<- length(subset) data.subset <- data[subset,] data.subset <- log(data.subset)%*%t(transmat) index <- order(data.subset[,1]) data.subset <- data.subset[index,] if( k>2) curve <- multiloess(data.subset[,2:k]~data.subset[,1],span=span,family=family,surface="direct") else curve <- loess(data.subset[,2:k]~data.subset[,1],span=span,family=family,surface="direct") ### Transform the normalizing curve before and after normalization scaled <- cbind(data.subset[,1],matrix(0,n,k-1)) %*%(transmat) unscaled <- cbind(data.subset[,1],curve$fitted) %*%(transmat) w <-c(0,rep(1,n,n),0) data.scaled <- NULL ### Normalize each array for(i in 1:k){ if(verbose) cat("Normalizing chip ",i,"\n") if(log.it){ mini <- log(min(data[,i])) maxi <- log(max(data[,i])) } else{ mini <- min(data[,i]) maxi <- max(data[,i]) } curve <- loess(c(mini,scaled[,i],maxi)~c(mini,unscaled[,i],maxi),weights=w,span=span) if(log.it) temp <- exp(predict(curve,log(data[,i]))) else temp <- predict(curve,data[,i]) data.scaled <- cbind(data.scaled,temp) } data.scaled } ##******************************************************************************************* #********** Select A subset with small rank-range over arrays ***** maffy.subset <- function(data,subset.size=5000,maxit=100,subset.delta=max(round(subset.size/100),25),verbose=FALSE){ k <- dim(data)[2] ### Number of chips n <- dim(data)[1] ## Size of starting subset, i.e. all rows if(verbose) cat("Data size",n,"x",k,"Desired subset size",subset.size,"+-",subset.delta,"\n") means <- data%*%(rep(1,k,k)/k) index0 <- order(means) data.sorted <- data[index0,] ## Init set <- rep(TRUE,n,n) ## Set-indicator index.set <- 1:n ## Indexes for subset nprev <- n+1 iter <- 1 part.of.n <- 1 ## loop while(nprev>n & n>(subset.size+subset.delta) & iter 0 parametric <- match(nmx, nmx[parametric], 0) > 0 if(!match(degree, 0:2, 0)) stop("degree must be 0, 1 or 2") iterations <- if(family=="gaussian") 1 else control$iterations if(!missing(enp.target)) if(!missing(span)) warning("both span and enp.target specified: span will be used") else { # White book p.321 tau <- switch(degree+1, 1, D+1, (D+1)*(D+2)/2) - sum(drop.square) span <- 1.2 * tau/enp.target } fit <- simplemultiLoess(y, x, w, span, degree, normalize, control$statistics, control$surface, control$cell, iterations, control$trace.hat) fit$call <- match.call() fit$terms <- mt fit$xnames <- nmx fit$x <- x fit$y <- y fit$weights <- w if(model) fit$model <- mf fit } ##******************************************************************************************* simplemultiLoess <- function(y, x, weights, span = 0.75, degree = 2, normalize = TRUE, statistics = "approximate", surface = "interpolate", cell = 0.2, iterations = 1, trace.hat = "exact") { ## Extra init parametric <- FALSE drop.square <- FALSE M <- NCOL(y) A <- rep(1,M,M) D <- NCOL(x) N <- NROW(x) fitted.all <- matrix(1,N,M) fitted.residuals <- matrix(1,N,M) pseudo.resid.all <- matrix(1,N,M) if(!N || !D) stop("invalid `x'") if(!length(y)) stop("invalid `y'") x <- as.matrix(x) max.kd <- max(N, 200) robust <- rep(1, N) divisor<- rep(1, D) if(normalize && D > 1) { trim <- ceiling(0.1 * N) divisor <- sqrt(apply(apply(x, 2, sort)[seq(trim+1, N-trim), , drop = FALSE], 2, var)) x <- x/rep(divisor, rep(N, D)) } sum.drop.sqr <- sum(drop.square) sum.parametric <- sum(parametric) nonparametric <- sum(!parametric) order.parametric <- order(parametric) x <- x[, order.parametric] order.drop.sqr <- (2 - drop.square)[order.parametric] if(degree==1 && sum.drop.sqr) stop("Specified the square of a factor predictor to be dropped when degree = 1") if(D == 1 && sum.drop.sqr) stop("Specified the square of a predictor to be dropped with only one numeric predictor") if(sum.parametric == D) stop("Specified parametric for all predictors") if(iterations) for(j in 1:iterations) { robust <- weights * robust if(j > 1) statistics <- "none" if(surface == "interpolate" && statistics == "approximate") statistics <- if(trace.hat == "approximate") "2.approx" else if(trace.hat == "exact") "1.approx" surf.stat <- paste(surface, statistics, sep="/") for(k in 1:M) { z <- .C(stats:::C_loess_raw, as.double(y[,k]), as.double(x), as.double(weights), as.double(robust), as.integer(D), as.integer(N), as.double(span), as.integer(degree), as.integer(nonparametric), as.integer(order.drop.sqr), as.integer(sum.drop.sqr), as.double(span*cell), as.character(surf.stat), fitted.values = double(N), parameter = integer(7), a = integer(max.kd), xi = double(max.kd), vert = double(2*D), vval = double((D+1)*max.kd), diagonal = double(N), trL = double(1), delta1 = double(1), delta2 = double(1), as.integer(surf.stat == "interpolate/exact")) fitted.all[,k] <- z$fitted.values } if(j==1) { trace.hat.out <- z$trL one.delta <- z$delta1 two.delta <- z$delta2 } residuals.all <- (y-fitted.all) fitted.residuals <- sqrt((residuals.all^2)%*%A) if(j < iterations) robust <- .Fortran(stats:::C_lowesw, as.double(fitted.residuals), as.integer(N), robust = double(N), integer(N))$robust } if(surface == "interpolate") { pars <- z$parameter names(pars) <- c("d", "n", "vc", "nc", "nv", "liv", "lv") enough <- (D + 1) * pars["nv"] fit.kd <- list(parameter=pars, a=z$a[1:pars[4]], xi=z$xi[1:pars[4]], vert=z$vert, vval=z$vval[1:enough]) } if(iterations > 1) { for(k in 1:M) { pseudovalues <- .Fortran(stats:::C_lowesp, as.integer(N), as.double(y[,k]), as.double(fitted.all[,k]), as.double(weights), as.double(robust), integer(N), pseudovalues = double(N))$pseudovalues zz <- .C(stats:::C_loess_raw, as.double(pseudovalues), as.double(x), as.double(weights), as.double(weights), as.integer(D), as.integer(N), as.double(span), as.integer(degree), as.integer(nonparametric), as.integer(order.drop.sqr), as.integer(sum.drop.sqr), as.integer(span*cell), as.character(surf.stat), temp = double(N), parameter = integer(7), a = integer(max.kd), xi = double(max.kd), vert = double(2*D), vval = double((D+1)*max.kd), diagonal = double(N), trL = double(1), delta1 = double(1), delta2 = double(1), as.integer(0)) pseudo.resid.all[,k] <- pseudovalues-zz$temp } pseudo.resid <- sqrt((pseudo.resid.all^2)%*%A) } sum.squares <- if(iterations <= 1) sum(weights * fitted.residuals^2) else sum(weights * pseudo.resid^2) enp <- one.delta + 2*trace.hat.out - N s <- sqrt(sum.squares/one.delta) pars <- list(robust=robust, span=span, degree=degree, normalize=normalize, parametric=parametric, drop.square=drop.square, surface=surface, cell=cell, family= if(iterations <= 1) "gaussian" else "symmetric", iterations=iterations) fit <- list(n=N, fitted=fitted.all, residuals=residuals.all, enp=enp, s=s, one.delta=one.delta, two.delta=two.delta, trace.hat=trace.hat.out, divisor=divisor) fit$pars <- pars if(surface == "interpolate") fit$kd <- fit.kd class(fit) <- "loess" fit } ##******************************************************************************************* affy/R/mas5.R0000644000175400017540000001305213556116173013727 0ustar00biocbuildbiocbuildmas5 <- function(object,normalize=TRUE,sc = 500, analysis = "absolute",...){ res <- expresso(object,bgcorrect.method="mas",pmcorrect.method="mas",normalize=FALSE,summary.method="mas",...) if(normalize) res <- affy.scalevalue.exprSet(res,sc=sc,analysis=analysis) return(res) } mas5calls.ProbeSet <- function(object, tau=0.015, alpha1=0.04, alpha2=0.06, ignore.saturated=TRUE){ if(alpha1 < 0) {stop("alpha1 must be > 0 "); } if(alpha1 > alpha2) {stop("alpha2 must be > alpha1 "); } if(alpha2 > 1) {stop("alpha2 must be <1 "); } ## Saturation: ## shouldn't be a problem with new scanners ##or those that have had an engineer visit if(ignore.saturated) { sat <- 46000; } else { sat <- -1; } pms <- pm(object) mms <- mm(object) pns <- rep(object@id,nrow(pms)) unique.pns <- unique(pns) pvals<-sapply(1:length(pms[1,]),function(x) { .C("DetectionPValue",as.double(pms[,x]),as.double(mms[,x]),as.character(pns),as.integer(length(mms[,x])), as.double(tau),as.double(sat),dpval=double(length(unique.pns)),length(unique.pns), PACKAGE="affy")$dpval; }); calls <- sapply(pvals,function(y) { if(y < alpha1) { return("P") } else { if(y < alpha2) { return("M") } else { return("A") }}}); return(list(call=calls,pval=pvals)) } mas5calls.AffyBatch <- function(object, ids=NULL, verbose=TRUE, tau=0.015, alpha1=0.04, alpha2=0.06, ignore.saturated=TRUE) { if(alpha1 < 0) {stop("alpha1 must be > 0 "); } if(alpha1 > alpha2) {stop("alpha2 must be > alpha1 "); } if(alpha2 > 1) {stop("alpha2 must be <1 "); } if(verbose) cat("Getting probe level data...\n"); pms <-as.matrix(pm(object)); mms <-as.matrix(mm(object)); # Saturation: # shouldn't be a problem with new scanners ##or those that have had an engineer visit if(ignore.saturated) { sat <- 46000; } else { sat <- -1; } pns <- probeNames(object); o <- order(pns) pns <- pns[o] pms <- pms[o,,drop=FALSE] mms <- mms[o,,drop=FALSE] unique.pns <- sort(unique(pns)); if(verbose) cat("Computing p-values\n"); p<-sapply(1:length(pms[1,]),function(x) { .C("DetectionPValue",as.double(pms[,x]),as.double(mms[,x]),as.character(pns),as.integer(length(mms[,x])), as.double(tau),as.double(sat),dpval=double(length(unique.pns)),length(unique.pns), PACKAGE="affy")$dpval; }); rownames(p) <- unique.pns; colnames(p) <- sampleNames(object) if(verbose) cat("Making P/M/A Calls\n"); calls <- sapply(p,function(y) { if(y < alpha1) { return("P") } else { if(y < alpha2) { return("M") } else { return("A") }}}); calls <- matrix(calls,nrow=nrow(p),ncol=ncol(p)); colnames(calls) <- sampleNames(object) rownames(calls) <- rownames(p) if(!is.null(ids)){ calls <- calls[ids,,drop=FALSE] p <- p[ids,,drop=FALSE] } eset <- new("ExpressionSet", phenoData=phenoData(object), ## featureData picked up from object experimentData=experimentData(object), annotation=annotation(object), protocolData=protocolData(object), exprs=calls, se.exprs=p ) return(eset) } mas5.detection <- function(mat, tau=0.015, alpha1=0.04, alpha2=0.06, exact.pvals=FALSE, cont.correct=FALSE) { ## CONSTANTS saturation.point <- 46000 # not a user parameter mat.r <- (mat[,1]-mat[,2])/(mat[,1]+mat[,2]) ## SANITY CHECKING if ( !is.matrix(mat) || length(dim(mat))!=2 || dim(mat)[2]!=2 || dim(mat)[1] < 1 || !is.numeric(mat) ) stop("Invalid mat matrix.") if ( !is.numeric(tau) ) stop("Invalid tau.") if ( !is.numeric(alpha1) || !is.numeric(alpha2) || alpha1 <= 0 || alpha1 >= alpha2 || alpha2 >= 0.5 ) stop("Invalid alpha1 or alpha2.") if ( !is.logical(exact.pvals) ) stop("Invalid exact.pvals.") if ( !is.logical(cont.correct) ) stop("Invalid cont.correct.") ## DEALING WITH SATURATION; COMPUTING THE P-VALUE ## According to the Bioinformatics paper: ## * If all MM's are saturated, then call present ## * Otherwise discard pairs with a saturated MM ## According to the Affymetrix whitepaper: ## * If all probe-pairs are saturated, then call present with pval=0 ## * If an MM is saturated, then we discard the pair ## * If a PM and MM are within tau of each other, we discard the pair ## So we're going with: ## * If all MM's are saturated, set pval=0 and don't use Wilcoxon ## * Discard probe-pairs when MM is saturated or the PM,MM are within tau ## of each other ## * Compute the p-value using Wilcoxon's signed rank test on the retained ## probe-pairs is.mm.saturated <- function(probe.pair, saturation.point) probe.pair[2] >= saturation.point is.retained <- function(probe.pair, saturation.point, tau) !(is.mm.saturated(probe.pair,saturation.point) || abs(diff(probe.pair)) <= tau) if ( all(apply(mat,1,is.mm.saturated,saturation.point)) ) pval <- 0 else { retained <- apply(mat, 1, is.retained, saturation.point, tau) pval <- wilcox.test(mat.r[retained], alternative="greater", mu=tau, paired=FALSE, exact=exact.pvals, correct=cont.correct, conf.int=FALSE)$p.value } ## DETECTION CALL if ( pval < 0 || pval > 1 ) warning("Computed an unusual p-value outside the range [0,1].") if ( pval < alpha1 ) call <- "P" else if ( pval < alpha2 ) call <- "M" else call <- "A" ## DONE return(list(pval=pval, call=call)) } affy/R/merge.AffyBatch.R0000644000175400017540000000264013556116173016010 0ustar00biocbuildbiocbuildmerge.AffyBatch <- function(x, y, annotation=paste(annotation(x), annotation(y)), description=NULL, notes=character(0), ...) { adim <- dim(intensity(x))[1] if ((nrow(x) != nrow(y)) || (ncol(x) != ncol(y))) stop("cannot merge chips of different sizes !") if (cdfName(x) != cdfName(y)) warning("cdfName mismatch (using the cdfName of x)!") if (is.null(description)){ description <- new("MIAME") description@title <- "Created from merging two AffyBatches. No description was supplied. The description of the two original AffyBatches was not kept." } lx <- length(x) ly <- length(y) phenodata <- phenoData(x) pData(phenodata) <- rbind(pData(x),pData(y)) protocoldata <- protocolData(x) pData(protocoldata) <- rbind(pData(protocolData(x)),pData(protocolData(y))) notes(description) <- if (length(notes)==0) list(paste("Merge from two AffyBatches with notes: 1)", notes(experimentData(x)), ", and 2)",notes(experimentData(y)))) else notes return(new("AffyBatch", exprs=cbind(intensity(x),intensity(y)), phenoData=phenodata, experimentData=description, ##need to write a merge for MIAME cdfName=cdfName(x), nrow=nrow(x), ncol=ncol(x), annotation=x@annotation, protocolData=protocoldata )) } affy/R/mva.pairs.R0000644000175400017540000003440613556116173014770 0ustar00biocbuildbiocbuild### ### ### Code for M and MvA plots ### ### Mar 6, 2004 - added the generic Mbox. It performs ### the equivalent of Mbox in affyPLM ### added a generic MAplot. Similar ### functionality is implemented in ### affyPLM ### a function ma.plot now does the actual plotting ### for mva.pairs ### ### Aug 23, 2004 - change the placement location of statistics in ### ma.plot ### Nov 30, 2005 - fix double logging when pairs=TRUE in MAplot ### Feb 15, 2006 - fixed passing of cex variable into mva.pairs ### Feb 24, 2006 - add smoothScatter option to ma.plot ### Apr 11, 2006 - fix problem with smoothScatter option. ### Jun 22, 2006 - Fix problem with where statistics appear when xlim is set. Add plotmethod="add". move pch to MAplot. Fix it so cex is passed down to plot(). Make adding the loess line optional. Make lwd,lty,col settable for the loess line ### Jul 21, 2006 - allow MAplot to have character string sampleName arguments for which,subset,ref. But then removed subset ### Jul 23, 2006 - added groups to MAplot for AffyBatch ### Aug 4, 2006 - fix small bug in how plots are titled. ### Oct 11, 2006 - change some apply(x,1,median) to rowMedians(x) ### ma.plot <- function(A,M,subset=sample(1:length(M),min(c(10000, length(M)))),show.statistics=TRUE,span=2/3,family.loess="gaussian",cex=2,plot.method=c("normal","smoothScatter","add"),add.loess=TRUE,lwd=1,lty=1,loess.col="red",...){ plot.method <- match.arg(plot.method) fn.call <- list(...) sigma <- IQR(M) mean <- median(M) if (!is.element("ylim",names(fn.call))){ yloc <- max(M) } else { yloc <- max(fn.call$ylim) } if (!is.element("xlim",names(fn.call))){ xloc <- max(A) } else { xloc <- max(fn.call$xlim) } if(plot.method == "smoothScatter"){ plotmethod <- "smoothScatter" } else if (plot.method == "add"){ plotmethod <- "add" } else { plotmethod <- "normal" } aux <- loess(M[subset]~A[subset],degree=1,span=span,family=family.loess)$fitted if (plotmethod == "smoothScatter"){ smoothScatter(A,M,...) } else if (plotmethod == "add"){ points(A,M,cex=cex,...) } else { plot(A,M,cex=cex,...) } if (add.loess){ o <- order(A[subset]) A <- A[subset][o] M <- aux[o] o <-which(!duplicated(A)) lines(approx(A[o],M[o]),col=loess.col,lwd=lwd,lty=lty) } abline(0,0,col="blue") # write IQR and Median on to plot if (show.statistics){ txt <- format(sigma,digits=3) txt2 <- format(mean,digits=3) text(xloc ,yloc,paste(paste("Median:",txt2),paste("IQR:",txt),sep="\n"),cex=cex,adj=c(1,1)) } } mva.pairs <- function(x,labels=colnames(x),log.it=TRUE,span=2/3,family.loess="gaussian", digits=3,line.col=2,main="MVA plot", cex = 2, ...){ if(log.it) x <-log2(x) J <- dim(x)[2] frame() old.par <- par(no.readonly = TRUE) on.exit(par(old.par)) par(mfrow=c(J,J),mgp=c(0,.2,0),mar=c(1,1,1,1),oma=c(1,1.4,2,1)) for(j in 1:(J-1)){ par(mfg=c(j,j)) plot(1,1,type="n",xaxt="n",yaxt="n",xlab="",ylab="") text(1,1,labels[j],cex=cex) for(k in (j+1):J){ par(mfg=c(j,k)) yy <- x[,j]-x[,k] xx <-(x[,j]+x[,k])/2 sigma <- IQR(yy) mean <- median(yy) ma.plot(xx,yy,tck=0,show.statistics=FALSE,pch=".",xlab="",ylab="",tck=0,span=span,...) par(mfg=c(k,j)) #sigma <- IQR(yy) txt <- format(sigma,digits=digits) txt2 <- format(mean,digits=digits) plot(c(0,1),c(0,1),type="n",ylab="",xlab="",xaxt="n",yaxt="n") text(0.5,0.5,paste(paste("Median:",txt2),paste("IQR:",txt),sep="\n"),cex=cex) } } par(mfg=c(J,J));plot(1,1,type="n",xaxt="n",yaxt="n",xlab="",ylab=""); text(1,1,labels[J],cex=cex) mtext("A",1,outer=TRUE,cex=1.5) mtext("M",2,outer=TRUE,cex=1.5,las=1) mtext(main,3,outer=TRUE,cex=1.5) invisible() } setGeneric("Mbox",function(object,...) standardGeneric("Mbox")) setMethod("Mbox",signature("AffyBatch"), function(object,log=TRUE,type=c("both","pm","mm"),...){ type <- match.arg(type) if (type == "both"){ pms <- unlist(indexProbes(object, "both")) } else if (type == "pm"){ pms <- unlist(pmindex(object)) } else if (type == "mm"){ mms <- unlist(mmindex(object)) } if(log){ x <- log2(intensity(object)[pms, ]) } else { x <- intensity(object)[pms, ] } medianchip <- rowMedians(x) M <- sweep(x,1,medianchip,FUN='-') boxplot(data.frame(M),...) }) setGeneric("MAplot",function(object,...) standardGeneric("MAplot")) setMethod("MAplot",signature("AffyBatch"), function(object,log=TRUE,type=c("both","pm","mm"),groups=NULL,ref=NULL,which=NULL,pairs=FALSE,pch=".",ref.fn=c("median","mean"),ref.title="vs pseudo-median reference chip",...){ type <- match.arg(type) if (type == "both"){ pms <- unlist(indexProbes(object, "both")) } else if (type == "pm"){ pms <- unlist(pmindex(object)) } else if (type == "mm"){ pms <- unlist(mmindex(object)) } if(log){ x <- log2(intensity(object)[pms, ]) } else { x <- intensity(object)[pms, ] } if (is.null(groups)){ if (is.character(ref)){ ref.indices <- match(ref,sampleNames(object)) if (all(is.na(ref.indices))){ stop("No known sampleNames in ref") } if (any(is.na(ref.indices))){ warning(paste("Omitting the following from ref:",ref[is.na(ref.indices)], "because they can not be found.")) } ref <- ref.indices[!is.na(ref.indices)] } if (is.character(subset)){ subset.indices <- match(subset,sampleNames(object)) if (all(is.na(subset.indices))){ stop("No known sampleNames in subset") } if (any(is.na(subset.indices))){ warning(paste("Omitting the following from subset:",subset[is.na(subset.indices)], "because they can not be found.")) } subset <- subset.indices[!is.na(subset.indices)] } if (is.character(which)){ which.indices <- match(which,sampleNames(object)) if (all(is.na(which.indices))){ stop("No known sampleNames in which") } if (any(is.na(which.indices))){ warning(paste("Omitting the following from which:",which[is.na(which.indices)], "because they can not be found.")) } which <- which.indices[!is.na(which.indices)] } if (is.null(which)){ which <- 1:dim(exprs(object))[2] } ref.fn <- match.arg(ref.fn) if(!pairs){ if (is.null(ref)){ medianchip <- rowMedians(x) ###apply(x, 1, median) } else if (length(ref) > 1){ if (ref.fn == "median"){ medianchip <- rowMedians(x[,ref]) } else { medianchip <- rowMeans(x[,ref]) } } else { medianchip <- x[,ref] } M <- sweep(x,1,medianchip,FUN='-') A <- 1/2*sweep(x,1,medianchip,FUN='+') if (is.null(ref)){ for (i in which){ title <- paste(sampleNames(object)[i],"vs pseudo-median reference chip") ma.plot(A[,i],M[,i],main=title,xlab="A",ylab="M",pch=pch,...) } } else { for (i in which){ if (length(ref) == 1){ if (i != ref){ ##changed which to i title <- paste(sampleNames(object)[i],"vs",sampleNames(object)[ref]) ma.plot(A[,i],M[,i],main=title,xlab="A",ylab="M",pch=pch,...) } } else { title <- paste(sampleNames(object)[i],"vs",ref.title) ma.plot(A[,i],M[,i],main=title,xlab="A",ylab="M",pch=pch,...) } } } } else { if(!is.null(ref)) stop("Can't use pairs with non-null 'ref'") if(is.null(which)) which <- 1:ncol(x) mva.pairs(x[,which],log.it=FALSE,...) } } else { ## group labels have been given ## check that group variable is of same length as number of samples if (dim(x)[2] != length(groups)){ stop("'groups' is of wrong length.") } ### group labels variable can be integer, character or factor variable. ### need to check that if any names supplied ### for ref or which can be found in group.labels if (!is.null(which)){ if (is.numeric(groups)){ if (!is.numeric(which)){ stop("'which' labels must also be found in 'groups'") } else { if (!all(is.element(which,groups))){ stop("'which' labels must also be found in 'groups'") } } } else if (is.factor(groups)){ if (!is.character(which)){ stop("'which' should be character vector") } else { if (!all(is.element(which,as.character(groups)))){ stop("'which' labels must also be found in 'groups'") } } } else if (is.character(groups)){ if (!is.character(which)){ stop("'which' should be character vector") } else { if (!all(is.element(which,groups))){ stop("'which' labels must also be found in 'groups'") } } } } if (!is.null(ref)){ if (is.numeric(groups)){ if (!is.numeric(ref)){ stop("'ref' labels must also be found in 'groups'") } else { if (!all(is.element(ref,groups))){ stop("'ref' labels must also be found in 'groups'") } } } else if (is.factor(groups)){ if (!is.character(ref)){ stop("'ref' should be character vector") } else { if (!all(is.element(ref,as.character(groups)))){ stop("'ref' labels must also be found in 'groups'") } } } else if (is.character(groups)){ if (!is.character(ref)){ stop("'ref' should be character vector") } else { if (!all(is.element(ref,groups))){ stop("'ref' labels must also be found in 'groups'") } } } } ref.fn <- match.arg(ref.fn) groups.list <- split(1:dim(x)[2], as.factor(groups)) grouped.data <- matrix(0,nrow(x),length(groups.list)) colnames(grouped.data) <- names(groups.list) which.col <- 1 for (group in groups.list){ grouped.data[,which.col] <- rowMeans(x[,group,drop=FALSE]) which.col <- which.col + 1 } if (!pairs){ if (is.null(which)){ which <- names(groups.list) } if (is.null(ref)){ if (ref.fn == "median"){ medianchip <- rowMedians(grouped.data) ####apply(grouped.data, 1, median) } else { medianchip <- rowMeans(grouped.data) } } else if (length(ref) == 1){ ref.name <- ref ref <- match(ref,names(groups.list)) medianchip <- grouped.data[,ref] } else { ref <- match(ref,names(groups.list)) if (ref.fn == "median"){ medianchip <- rowMedians(grouped.data[,ref]) } else { medianchip <- rowMeans(grouped.data[,ref]) } } M <- sweep(grouped.data,1,medianchip,FUN='-') A <- 1/2*sweep(grouped.data,1,medianchip,FUN='+') if (is.null(ref)){ for (i in which){ title <- paste(i,ref.title) ma.plot(A[,i],M[,i],main=title,xlab="A",ylab="M",pch=pch,...) } } else { for (i in which){ if (length(ref) == 1){ if (i != ref.name){ title <- paste(i,"vs",ref.name) ma.plot(A[,i],M[,i],main=title,xlab="A",ylab="M",pch=pch,...) } } else { title <- paste(i,ref.title) ma.plot(A[,i],M[,i],main=title,xlab="A",ylab="M",pch=pch,...) } } } } else { if (!is.null(ref)) stop("Can't use pairs with non-null 'ref'") if (is.null(which)){ which <- names(groups.list) } mva.pairs(grouped.data[,which],log.it=FALSE,...) } } }) affy/R/normalize.constant.R0000644000175400017540000000165313556116173016716 0ustar00biocbuildbiocbuildnormalize.AffyBatch.constant <- function(abatch, refindex=1, FUN=mean, na.rm=TRUE) { n <- length( abatch ) if (! (refindex %in% 1:n)) stop("invalid reference index for normalization") refconstant <- FUN(intensity(abatch)[,refindex], na.rm=na.rm) #set.na.spotsd(abatch) normhisto <- vector("list", length=n) for (i in (1:n)[-refindex]) { m <- normalize.constant(intensity(abatch)[,i], refconstant, FUN=FUN, na.rm=na.rm) myhistory <- list(name="normalized by constant", constant=attr(m,"constant")) attr(m,"constant") <- NULL intensity(abatch)[, i] <- m normhisto[[i]] <- myhistory } attr(abatch, "normalization") <- normhisto return(abatch) } normalize.constant <- function(x, refconstant, FUN=mean, na.rm=TRUE) { thisconstant <- FUN(x, na.rm=na.rm) r <- x / thisconstant * refconstant attr(r,"constant") <- refconstant / thisconstant return(r) } affy/R/normalize.contrasts.R0000644000175400017540000000217113556116173017101 0ustar00biocbuildbiocbuildnormalize.AffyBatch.contrasts <- function(abatch,span=2/3,choose.subset=TRUE,subset.size=5000,verbose=TRUE,family="symmetric",type=c("together","pmonly","mmonly","separate")) { type <- match.arg(type) if (type == "pmonly"){ Index <- unlist(pmindex(abatch)) } else if (type == "mmonly"){ Index <- unlist(mmindex(abatch)) } else if (type == "together"){ Index <- unlist(indexProbes(abatch,"both")) } else if (type == "separate"){ abatch <- normalize.AffyBatch.contrasts(abatch,span=span,choose.subset=choose.subset,subset.size=subset.size,verbose=verbose,family=family,type="pmonly") Index <- unlist(mmindex(abatch)) } ##we need default argumetns becuase they are used in this transitional file alldata <- intensity(abatch)[Index,] if(choose.subset) subset1 <- maffy.subset(alldata,verbose=verbose,subset.size=subset.size)$subset else subset1 <- sample(1:dim(alldata)[1],subset.size) aux <- maffy.normalize(alldata,subset=subset1,verbose=verbose,span=span,family=family) intensity(abatch)[Index,] <- aux ##attr(abatch, "normalization") <- normhisto return(abatch) } affy/R/normalize.invariantset.R0000644000175400017540000001227013556116173017571 0ustar00biocbuildbiocbuildnormalize.AffyBatch.invariantset <- function(abatch, prd.td=c(0.003,0.007), verbose=FALSE,baseline.type=c("mean","median","pseudo-mean","pseudo-median"),type=c("separate","pmonly","mmonly","together")) { do.normalize.Affybatch.invariantset <- function(abatch, pms, prd.td, baseline.type){ nc <- length(abatch) # number of CEL files if (baseline.type == "mean"){ # take as a reference the array having the median overall intensity m <- vector("numeric", length=nc) for (i in 1:nc) m[i] <- mean(intensity(abatch)[pms, i]) refindex <- match(trunc(median(rank(m))), rank(m)) rm(m) baseline.chip <- c(intensity(abatch)[pms, refindex]) if (verbose) cat("Data from", sampleNames(abatch)[refindex], "used as baseline.\n") } else if (baseline.type == "median"){ # take as a reference the array having the median median intensity m <- vector("numeric", length=nc) for (i in 1:nc) m[i] <- median(intensity(abatch)[pms, i]) refindex <- match(trunc(median(rank(m))), rank(m)) rm(m) baseline.chip <- c(intensity(abatch)[pms, refindex]) if (verbose) cat("Data from", sampleNames(abatch)[refindex], "used as baseline.\n") } else if (baseline.type == "pseudo-mean"){ # construct a psuedo chip to serve as the baseline by taking probewise means refindex <- 0 baseline.chip <- rowMeans(intensity(abatch)[pms,]) } else if (baseline.type == "pseudo-median"){ # construct a pseudo chip to serve as the baseline by taking probewise medians refindex <- 0 baseline.chip <- rowMedians(intensity(abatch)[pms,]) } ##set.na.spotsd(cel.container) normhisto <- vector("list", length=nc) # normhisto[[refindex]] <- list(name="reference for the invariant set") ## loop over the CEL files and normalize them for (i in (1:nc)) { if (i != refindex){ if (verbose) cat("normalizing array", sampleNames(abatch)[i], "...") ##temporary tmp <- normalize.invariantset(c(intensity(abatch)[pms, i]), c(baseline.chip), prd.td) #i.set <- which(i.pm)[tmp$i.set] tmp <- as.numeric(approx(tmp$n.curve$y, tmp$n.curve$x, xout=intensity(abatch)[pms, i], rule=2)$y) attr(tmp,"invariant.set") <- NULL intensity(abatch)[pms, i] <- tmp ## storing information about what has been done #normhisto[[i]] <- list(name="normalized by invariant set", # invariantset=i.set) if (verbose) cat("done.\n") } } attr(abatch, "normalization") <- normhisto return(abatch) } type <- match.arg(type) baseline.type <- match.arg(baseline.type) if (type == "pmonly"){ pms <- unlist(pmindex(abatch)) do.normalize.Affybatch.invariantset(abatch, pms, prd.td, baseline.type) } else if (type == "mmonly"){ pms <- unlist(mmindex(abatch)) do.normalize.Affybatch.invariantset(abatch, pms, prd.td, baseline.type) } else if (type == "together"){ pms <- unlist(indexProbes(abatch,"both")) do.normalize.Affybatch.invariantset(abatch, pms, prd.td, baseline.type) } else if (type == "separate"){ pms <- unlist(pmindex(abatch)) abatch <- do.normalize.Affybatch.invariantset(abatch, pms, prd.td, baseline.type) pms <- unlist(mmindex(abatch)) do.normalize.Affybatch.invariantset(abatch, pms, prd.td, baseline.type) } } ## The 'common-to-all' part of the algorithm. Operates on two vectors of numeric data ## normalize.invariantset <- function(data, ref, prd.td=c(0.003,0.007)) { np <- length(data) r.ref <- rank(ref) r.array <- rank(data) ## init prd.td.adj <- prd.td*10 # adjusted threshold things i.set <- rep(TRUE, np) # index all the PM probes as being in the invariant set ns <- sum(i.set) # number of probes in the invariant set ns.old <- ns+50+1 # number of probes previously in the invariant set ## iterate while the number of genes in the invariant set (ns) still varies... while ( (ns.old-ns) > 50 ) { air <- (r.ref[i.set] + r.array[i.set]) / (2*ns) # average intensity rank for the probe intensities prd <- abs(r.ref[i.set] - r.array[i.set]) / ns threshold <- (prd.td.adj[2]-prd.td[1]) * air + prd.td.adj[1] i.set[i.set] <- (prd < threshold) ns.old <- ns ns <- sum(i.set) if (prd.td.adj[1] > prd.td[1]) prd.td.adj <- prd.td.adj * 0.9 # update the adjusted threshold parameters } ## the index i.set corresponds to the 'invariant genes' n.curve <- smooth.spline(ref[i.set], data[i.set]) ## n.curve$x contains smoothed reference intensities ## n.curve$y contains smoothed i-th array intensities ##data <- as.numeric(approx(n.curve$y, n.curve$x, xout=data)$y) ##attr(data,"invariant.set") <- i.set ##return(data) return(list(n.curve=n.curve, i.set=i.set)) } affy/R/normalize.loess.R0000644000175400017540000000506613556116173016214 0ustar00biocbuildbiocbuildnormalize.AffyBatch.loess <- function(abatch,type=c("together","pmonly","mmonly","separate"),...) { type <- match.arg(type) if (type == "separate"){ Index <- unlist(indexProbes(abatch,"pm")) intensity(abatch)[Index,] <- normalize.loess(intensity(abatch)[Index,], ...) Index <- unlist(indexProbes(abatch,"mm")) intensity(abatch)[Index,] <- normalize.loess(intensity(abatch)[Index,], ...) } else if (type=="together"){ Index <- unlist(indexProbes(abatch,"both")) intensity(abatch)[Index,] <- normalize.loess(intensity(abatch)[Index,], ...) } else if (type=="pmonly"){ Index <- unlist(indexProbes(abatch,"pm")) intensity(abatch)[Index,] <- normalize.loess(intensity(abatch)[Index,], ...) } else if (type=="mmonly"){ Index <- unlist(indexProbes(abatch,"mm")) intensity(abatch)[Index,] <- normalize.loess(intensity(abatch)[Index,], ...) } ##set.na.spotsd(listcel) # set 'sd' to nothing (meaningless after normalization) ##cat(cols,rows) ##need to use MIAME ##for (i in 1:abatch@nexp) { ## history(abatch)[[i]] <- list(name="normalized by loess") ##} return(abatch) } normalize.loess <- function(mat, subset=sample(1:(dim(mat)[1]), min(c(5000, nrow(mat)))), epsilon=10^-2, maxit=1, log.it=TRUE, verbose=TRUE, span=2/3, family.loess="symmetric"){ J <- dim(mat)[2] II <- dim(mat)[1] if(log.it){ mat <- log2(mat) } change <- epsilon +1 iter <- 0 w <- c(0, rep(1,length(subset)), 0) ##this way we give 0 weight to the ##extremes added so that we can interpolate while(iter < maxit){ iter <- iter + 1 means <- matrix(0,II,J) ##contains temp of what we substract for (j in 1:(J-1)){ for (k in (j+1):J){ y <- mat[,j] - mat[,k] x <- (mat[,j] + mat[,k]) / 2 index <- c(order(x)[1], subset, order(-x)[1]) ##put endpoints in so we can interpolate xx <- x[index] yy <- y[index] aux <-loess(yy~xx, span=span, degree=1, weights=w, family=family.loess) aux <- predict(aux, data.frame(xx=x)) / J means[, j] <- means[, j] + aux means[, k] <- means[, k] - aux if (verbose) cat("Done with",j,"vs",k,"in iteration",iter,"\n") } } mat <- mat - means change <- max(colMeans((means[subset,])^2)) if(verbose) cat(iter, change,"\n") } if ((change > epsilon) & (maxit > 1)) warning(paste("No convergence after", maxit, "iterations.\n")) if(log.it) { return(2^mat) } else return(mat) } affy/R/normalize.qspline.R0000644000175400017540000001065713556116173016544 0ustar00biocbuildbiocbuildnormalize.AffyBatch.qspline <- function(abatch, type=c("together","pmonly","mmonly","separate"),...) { type <- match.arg(type) if (type == "together"){ Index <- unlist(indexProbes(abatch,"both")) intensity(abatch)[Index,] <- normalize.qspline(intensity(abatch)[Index,], ...) } else if (type == "pmonly"){ Index <- unlist(indexProbes(abatch,"pm")) intensity(abatch)[Index,] <- normalize.qspline(intensity(abatch)[Index,], ...) } else if (type == "mmonly"){ Index <- unlist(indexProbes(abatch,"mm")) intensity(abatch)[Index,] <- normalize.qspline(intensity(abatch)[Index,], ...) } else if (type == "separate"){ Index <- unlist(indexProbes(abatch,"pm")) intensity(abatch)[Index,] <- normalize.qspline(intensity(abatch)[Index,], ...) Index <- unlist(indexProbes(abatch,"mm")) intensity(abatch)[Index,] <- normalize.qspline(intensity(abatch)[Index,], ...) } #set.na.spotsd(listcel) normhisto <- vector("list", length=ncol(intensity(abatch))) ##need to use MIAME for this for (i in 1:length(abatch)) { normhisto[[i]] <- list(name="normalized by qspline") } attr(abatch, "normalization") <- normhisto return(abatch) } normalize.qspline <- function(x, target = NULL, samples = NULL, fit.iters = 5, min.offset = 5, spline.method = "natural", # c("fmm", "natural", "periodic") smooth = TRUE, spar = 0, # smoothing parameter p.min = 0, p.max = 1.0, incl.ends = TRUE, converge = FALSE, verbose = TRUE, na.rm = FALSE ){ if (is.null(target)) target <- exp(apply(log(x), 1, mean)) x.n <- dim(x)[1] m <- dim(x)[2] if (is.null(samples)) samples <- max(round(x.n/1000), 100) else if (samples < 1) samples <- round(samples * x.n) p <- (1:samples) / samples p <- p[ which(p <= p.max) & which(p >= p.min) ] samples <- length(p) k <- fit.iters if (na.rm==TRUE) y.n <- sum(!is.na(target)) else y.n <- length(target) py.inds <- as.integer(p * y.n) y.offset <- round(py.inds[1]/fit.iters) if (y.offset <= min.offset) { y.offset <- min.offset; k <- round(py.inds[1]/min.offset) } if (k <= 1) { warning("'k' found is non-sense. using default 'fit.iter'") k <- fit.iters } y.offset <- c(0, array(y.offset, (k-1))) y.order <- order(target) fx <- matrix(0, x.n,m) if(verbose==TRUE) print(paste("samples=",samples, "k=", k, "first=", py.inds[1])) for (i in 1:m) { # to handel NA values for each array if (na.rm==TRUE) x.valid <- which(!is.na(x[,i])) else x.valid <- 1:x.n x.n <- length(x.valid) px.inds <- as.integer(p * x.n) x.offset <- round(px.inds[1]/fit.iters) if (x.offset<=min.offset) { x.offset <- min.offset; k <- min(round(px.inds[1]/min.offset), k) } x.offset <- c(0, array(x.offset, (k-1))) x.order <- order(x[,i]) # NA's at the end (?) y.inds <- py.inds ## must be reset each iteration x.inds <- px.inds for (j in 1:k) { y.inds <- y.inds - y.offset[j] x.inds <- x.inds - x.offset[j] ty.inds <- y.inds tx.inds <- x.inds if (verbose==TRUE) print(paste("sampling(array=", i, "iter=", j, "off=", x.inds[1], -x.offset[j], y.inds[1], -y.offset[j], ")")) if (converge==TRUE) { ty.inds <- as.integer(c(1, y.inds)) tx.inds <- as.integer(c(1, x.inds)) if (j > 1) { ty.inds <- c(ty.inds, y.n) tx.inds <- c(tx.inds, x.n) } } qy <- target[y.order[ty.inds]] qx <- x[x.order[tx.inds],i] if (smooth==TRUE) { sspl <- smooth.spline(qx, qy, spar=spar) qx <- sspl$x qy <- sspl$y } fcn <- splinefun(qx, qy, method=spline.method) fx[x.valid,i] <- fx[x.valid,i] + fcn(x[x.valid,i])/k } if (na.rm==TRUE) { invalid <- which(is.na(x[,i])) fx[invalid,i] <- NA } } return(fx) } affy/R/normalize.quantiles.R0000644000175400017540000000755713556116173017103 0ustar00biocbuildbiocbuild################################################################## ## ## file: normalize.quantiles.R ## ## For a description of quantile normalization method see ## ## Bolstad, B. M., Irizarry R. A., Astrand, M, and Speed, T. P. (2003)(2003) ## A Comparison of Normalization Methods for High ## Density Oligonucleotide Array Data Based on Bias and Variance. ## Bioinformatics 19,2,pp 185-193 ## ## History ## Pre Aug 23, 2003 Two years worth of stuff ## Aug 23, 2003 - Added use.log2 to "robust", ## added ability to pass additional parameters ## to normalize.AffyBatch.Quantiles.robust ## changed pmonly parameters on functions ## so that it is now a string argument "type" ## the options are pmonly, mmonly, together, separate ## Jan 31, 2004 - put a check for an integer matrix and force coercision to ## doubles if required in normalize.quantiles ## Mar 13, 2005 - Modifications to normalize.quantiles.robust including removing ## approx.method which never got implemented. Making it a use a .Call() ## rather than a .C() ## ## Sep 20, 2006 - fix .Call in normalize.quantiles.robust ## May 20, 2007 - remove the functions that have been moved to preprocessCore ## ################################################################## normalize.AffyBatch.quantiles <- function(abatch,type=c("separate","pmonly","mmonly","together")) { type <- match.arg(type) if ((type == "pmonly")|(type == "separate")){ pms <- unlist(pmindex(abatch)) ## Change to faster computation of noNA - SDR 11/06/2003 ##noNA <- apply(intensity(abatch)[pms,,drop=FALSE],1,function(x) all(!is.na(x))) noNA <- rowSums(is.na(intensity(abatch)[pms,,drop=FALSE])) == 0 pms <- pms[noNA] intensity(abatch)[pms,] <- normalize.quantiles(intensity(abatch)[pms,,drop=FALSE ],copy=FALSE) } if((type == "mmonly") | (type == "separate")){ mms <- unlist(mmindex(abatch)) ## Change to faster computation of noNA - SDR 11/06/2003 ##noNA <- apply(intensity(abatch)[mms,,drop=FALSE],1,function(x) all(!is.na(x))) noNA <- rowSums(is.na(intensity(abatch)[mms,,drop=FALSE])) == 0 mms <- mms[noNA] intensity(abatch)[mms,] <- normalize.quantiles(intensity(abatch)[mms,,drop=FALSE ],copy=FALSE) } if (type == "together"){ pms <- unlist(indexProbes(abatch,"both")) intensity(abatch)[pms,] <- normalize.quantiles(intensity(abatch)[pms,,drop=FALSE ],copy=FALSE) } ##this is MIAME we need to decide how to do this properly. ##for (i in 1:length(abatch)) { ## history(abatch)[[i]]$name <- "normalized by quantiles" ##} return(abatch) } normalize.AffyBatch.quantiles.robust <- function(abatch, type=c("separate","pmonly","mmonly","together"),weights=NULL,remove.extreme=c("variance","mean","both","none"),n.remove=1,use.median=FALSE,use.log2=FALSE) { type <- match.arg(type) if ((type == "pmonly")|(type == "separate")){ pms <- unlist(pmindex(abatch)) intensity(abatch)[pms, ] <- normalize.quantiles.robust(intensity(abatch)[pms, ], copy=FALSE,weights=weights,remove.extreme,n.remove=n.remove,use.median=use.median,use.log2=use.log2) } if ((type == "mmonly")|(type == "separate")){ mms <- unlist(mmindex(abatch)) intensity(abatch)[mms, ] <- normalize.quantiles.robust(intensity(abatch)[mms, ],copy=FALSE,weights=weights,remove.extreme,n.remove=n.remove,use.median=use.median,use.log2=use.log2) } if (type == "together"){ pms <- unlist(indexProbes(abatch,"both")) intensity(abatch) <- normalize.quantiles.robust(intensity(abatch)[pms,,drop=FALSE ],copy=FALSE, weights=weights,remove.extreme=remove.extreme,n.remove=n.remove,use.median=use.median,use.log2=use.log2) } ##this is MIAME we need to decide how to do this properly. ##for (i in 1:length(abatch)) { ## history(abatch)[[i]]$name <- "normalized by quantiles" ##} return(abatch) } affy/R/pairs.AffyBatch.R0000644000175400017540000000257713556116173016040 0ustar00biocbuildbiocbuildpairs.AffyBatch <- function(x, panel=points, ..., transfo=I, main=NULL, oma=NULL, font.main = par("font.main"), cex.main = par("cex.main"), cex.labels = NULL, lower.panel=panel, upper.panel=NULL, diag.panel=NULL, #text.panel = textPanel, #label.pos = 0.5 + has.diag/3, font.labels = 1, row1attop = TRUE, gap = 1) { #label1 <- chipNames(x) #label2 <- unlist(lapply(history(x), function(z) z$name)) #textPanel <- function(x = 0.5, y = 0.5, txt, cex, font) { # text(x, y, txt, cex = cex, font = font) #} ##labels <- paste(sampleNames(x), unlist(lapply(history(x), function(z) if (is.null(z$name)) "" else z$name)), sep="\n") labels <- sampleNames(x) ##y <- matrix(intensity(x)[, , seq(along=x)], ncol=length(x)) y <- intensity(x) pairs(transfo(y), labels=labels, panel=panel, ..., main=main, oma=oma, font.main = font.main, cex.main = cex.main, lower.panel=lower.panel, upper.panel=upper.panel, diag.panel=diag.panel, #text.panel = text.panel, #label.pos = label.pos, cex.labels = cex.labels, font.labels = font.labels, row1attop = row1attop, gap = gap ) } affy/R/plot.ProbeSet.R0000644000175400017540000000060313556116173015560 0ustar00biocbuildbiocbuildplot.ProbeSet <- function(x, which=c("pm", "mm"), xlab="probes", type="l", ylim=NULL, ...) { which <- match.arg(which) if (which == "pm") f <- getMethod("pm", "ProbeSet") else f <- getMethod("mm", "ProbeSet") if (is.null(ylim)) ylim = range(c(f(x)), na.rm=TRUE) if (is.na(xlab)) xlab="probes" matplot(f(x), xlab=xlab, type=type, ylim=ylim, ...) } affy/R/plot.density.R0000644000175400017540000000272413556116173015522 0ustar00biocbuildbiocbuild# matdensity <- function(x, # ylab="density", xlab="x", type="l", plot=TRUE, # ...) { # x.density <- apply(mat, 2, density) # all.x <- do.call("cbind", lapply(x.density, function(x) x$x)) # all.y <- do.call("cbind", lapply(x.density, function(x) x$y)) # if (plot) # matplot(all.x, all.y, ylab=ylab, xlab=xlab, ...) # invisible(list(all.x=all.x, all.y=all.y)) # } plotDensity <- function(mat, ylab="density", xlab="x", type="l", col=1:6, na.rm = TRUE, ...) { x.density <- apply(mat, 2, density, na.rm = na.rm) all.x <- do.call(cbind, lapply(x.density, function(x) x$x)) all.y <- do.call(cbind, lapply(x.density, function(x) x$y)) matplot(all.x, all.y, ylab=ylab, xlab=xlab, type=type, col=col, ...) invisible(list(all.x=all.x, all.y=all.y)) } plotDensity.AffyBatch <- function(x, col=1:6, log=TRUE, which=c("pm","mm","both"), ylab="density", xlab=NULL, ...){ Index <- unlist(indexProbes(x, which=which)) x <- intensity(x)[Index, ,drop=FALSE] if(log){ x <- log2(x) if(is.null(xlab)) xlab <- "log intensity" } else if(is.null(xlab)) xlab <- "intensity" invisible(plotDensity(x, ylab=ylab, xlab=xlab, col=col, ...)) } affy/R/plotLocation.R0000644000175400017540000000113213556116173015525 0ustar00biocbuildbiocbuildplotLocation <- function(x, col="green", pch=22, ...) { if (is.list(x)) { x <- cbind(unlist(lapply(x, function(x) x[,1])), unlist(lapply(x, function(x) x[,2]))) } ## need to use nrow - x[,2] for correct y position. ## use image width to get nrow, which isn't ideal ## but follows assumption for this function that an ## image already exists nrow <- ceiling(par("usr")[4]) if(nrow == 1) stop(paste("\nYou must first generate an image of an array", "for this function to work!\n\n"), call. = FALSE) points(x[,1], nrow - x[,2] , pch=pch, col=col, ...) } affy/R/pmcorrect.mas.R0000644000175400017540000000221513556116173015636 0ustar00biocbuildbiocbuild############################ ##MPM Changed delta, Affy SADD states delta as 2e-20 pmcorrect.mas <- function (object, contrast.tau = 0.03, scale.tau = 10, delta = 2^(-20)) #function (object, contrast.tau = 0.03, scale.tau = 10, delta = 9.536743e-07) ########################### { all.pps.pm <- pm(object) all.pps.mm <- mm(object) diff <- log2(all.pps.pm) - log2(all.pps.mm) delta <- rep(delta, nrow(diff)) for (i in 1:ncol(diff)) { sb <- tukey.biweight(diff[, i]) pps.pm <- all.pps.pm[, i] pps.mm <- all.pps.mm[, i] pps.im <- pps.mm j <- (pps.mm >= pps.pm) & (sb > contrast.tau) pps.im[j] <- pps.pm[j]/2^sb j <- (pps.mm >= pps.pm) & (sb <= contrast.tau) pps.im[j] <- pps.pm[j]/2^(contrast.tau/(1 + (contrast.tau - sb)/scale.tau)) ######################### #MPM SADD Need to substract the PM-IM, I think this is the culprit pm.corrected <- apply(cbind(pps.pm-pps.im, delta), 1, max) #pm.corrected <- apply(cbind(pps.pm, pps.im, delta), 1, # max) ########################## diff[, i] <- pm.corrected } return(diff) } affy/R/ppset.ttest.R0000644000175400017540000000043113556116173015354 0ustar00biocbuildbiocbuildppset.ttest <- function(ppset, covariate, pmcorrect.fun = pmcorrect.pmonly, ...) { probes <- do.call(pmcorrect.fun, list(ppset)) my.ttest <- function(x) { y <- split(x, get(covariate)) t.test(y[[1]], y[[2]])$p.value } r <- apply(probes, 1, my.ttest) return(r) } affy/R/ppsetApply.R0000644000175400017540000000172613556116173015230 0ustar00biocbuildbiocbuildppsetApply <- function(abatch, FUN, genenames=NULL, ...) { if (! is(abatch, "AffyBatch")) stop("abatch must be inheriting from class AffyBatch") if (! is(FUN, "function")) stop("FUN must be a function") cdfenv <- getCdfInfo(abatch) if (is.null(genenames)) genenames <- ls(cdfenv) ## e1 <- new.env(parent = environment(FUN)) multiassign(names(pData(abatch)), pData(abatch), e1) environment(FUN) <- e1 ppset <- new("ProbeSet", pm=matrix(), mm=matrix()) r <- vector("list", length=length(genenames)) names(r) <- genenames for (i in seq(along=genenames)) { ## use mget to get NA when genenames[i] not found probes.i <- mget(genenames[i], envir = cdfenv, ifnotfound = NA)[[1]] if (all(is.na(probes.i))) next ppset@pm <- intensity(abatch)[probes.i[, 1], , drop=FALSE] ppset@mm <- intensity(abatch)[probes.i[, 2], , drop=FALSE] ppset@id <- genenames[i] r[[i]] <- FUN(ppset, ...) } return(r) } affy/R/read.affybatch.R0000644000175400017540000003335713556116173015735 0ustar00biocbuildbiocbuild############################################################# ## ## read.affybatch.R ## ## Adapted by B. M. Bolstad from read.affybatch in the affy ## package version 1.2. The goal is a faster, less memory hungry ## ReadAffy. To do this we will shunt more work off to ## the c code. ## ## History ## Jun 13-15 Intial version ## Jun 16 Verbose flag passed to C routine ## Jun 17 New method for checking header of first cel ## file. ## Jul 7 Added the function read.probematrix which ## reads in PM, MM or both into matrices ## Sep 28 changed name from read.affybatch2 to read.affybatch ## and cleaned up some old commented stuff ## Apr 13, 2004 - fixed problem in read.probematrix ## Nov 15, 2005 - add functionality to read the ## stddev values into the se.exprs slot (non-default behaviour) ## ## Jan 24, 2006 - JWM: added cdfname to allow for the use of non-standard mappings ## Mar 6, 2006 - change .Call to reference affyio. that is new location for parsing code ## Dec 12, 2006 - added checkCelFiles() to ensure all filenames are celfiles so unintended ## arguments don't get passed in via ... ## Apr 19, 2013 - JWM: added warning and error messages for Gene ST and Exon ST arrays ## Sept 26, 2013 - naked .Call() to affyio replaced ## ############################################################# read.affybatch <- function(..., filenames=character(0), phenoData=new("AnnotatedDataFrame"), description=NULL, notes="", compress = getOption("BioC")$affy$compress.cel, rm.mask = FALSE, rm.outliers=FALSE, rm.extra=FALSE, verbose = FALSE,sd=FALSE, cdfname = NULL) { auxnames <- unlist(list(...)) filenames <- c(filenames, auxnames) checkValidFilenames(filenames) n <- length(filenames) pdata <- pData(phenoData) ## try to read sample names form phenoData. if not there use CEL ## filenames if(dim(pdata)[1] != n) { ## if empty pdata filename are samplenames warning("Incompatible phenoData object. Created a new one.\n") samplenames <- sub("^/?([^/]*/)*", "", filenames) pdata <- data.frame(sample=1:n, row.names=samplenames) phenoData <- new("AnnotatedDataFrame", data=pdata, varMetadata=data.frame( labelDescription="arbitrary numbering", row.names="sample")) } else samplenames <- rownames(pdata) if (is.null(description)) { description <- new("MIAME") preproc(description)$filenames <- filenames preproc(description)$affyversion <- library(help=affy)$info[[2]][[2]][2] } if (length(notes)==0) notes(description) <- notes ## read the first file to see what we have if (verbose) cat(1, "reading",filenames[[1]],"...") headdetails <- read.celfile.header(as.character(filenames[[1]])) ##now we use the length dim.intensity <- headdetails[[2]] ##dim(intensity(cel)) ##and the cdfname as ref ref.cdfName <- headdetails[[1]] #cel@cdfName if(length(grep("gene1[01]st", cleancdfname(ref.cdfName))) == 1) warning(paste0("\n\nThe affy package can process data from the Gene ST 1.x series of arrays,\n", "but you should consider using either the oligo or xps packages, which are specifically\n", "designed for these arrays.\n\n"), call. = FALSE) if(length(grep("gene2[01]st|ex[1-2][0-1]st|hta20|mta10", cleancdfname(ref.cdfName))) == 1) stop(paste0("\n\nThe affy package is not designed for this array type.\n", "Please use either the oligo or xps package.\n\n"), call. = FALSE) scandates <- sapply(seq_len(length(filenames)), function(i) { sdate <- read.celfile.header(filenames[i], info = "full")[["ScanDate"]] if (is.null(sdate) ||length(sdate) == 0 ) NA_character_ else sdate }) protocol <- new("AnnotatedDataFrame", data=data.frame("ScanDate"=scandates, row.names=sampleNames(phenoData), stringsAsFactors=FALSE), dimLabels=c("sampleNames", "sampleColumns")) ## allow for non-standard cdfs if(is.null(cdfname)) cdfname <- ref.cdfName if (verbose) cat(paste("instantiating an AffyBatch (intensity a ", prod(dim.intensity), "x", length(filenames), " matrix)...", sep="")) if (verbose) cat("done.\n") ## Change sampleNames to be consistent with row.names of phenoData ## object exprs <- affyio::read_abatch(filenames, rm.mask, rm.outliers, rm.extra, ref.cdfName, dim.intensity[c(1,2)],verbose) colnames(exprs) <- samplenames #### this is where the code changes from the original read.affybatch. #### what we will do here is read in from the 1st to the nth CEL file if (!sd){ return(new("AffyBatch", exprs = exprs, ##se.exprs = array(NaN, dim=dim.sd), cdfName = cdfname, ##cel@cdfName, phenoData = phenoData, nrow = dim.intensity[2],##["Rows"], ncol = dim.intensity[1],##["Cols"], annotation = cleancdfname(cdfname, addcdf=FALSE), protocolData = protocol, description= description, notes = notes)) } else { return(new("AffyBatch", exprs = exprs, se.exprs = affyio::read_abatch_stddev(filenames, rm.mask, rm.outliers, rm.extra, ref.cdfName, dim.intensity[c(1,2)],verbose), cdfName = cdfname, ##cel@cdfName, phenoData = phenoData, nrow = dim.intensity[2],##["Rows"], ncol = dim.intensity[1],##["Cols"], annotation = cleancdfname(cdfname, addcdf=FALSE), protocolData = protocol, description= description, notes = notes)) } } ###################################################################################### read.probematrix <- function(..., filenames = character(0), phenoData = new("AnnotatedDataFrame"), description = NULL, notes = "", compress = getOption("BioC")$affy$compress.cel, rm.mask = FALSE, rm.outliers = FALSE, rm.extra = FALSE, verbose = FALSE,which="pm", cdfname = NULL){ auxnames <- unlist(list(...)) filenames <- c(filenames, auxnames) which <- match.arg(which,c("pm","mm","both")) if (verbose) cat(1, "reading", filenames[[1]], "to get header information\n") headdetails <- read.celfile.header(as.character(filenames[[1]])) ref.cdfName <- headdetails[[1]] cleaned.cdfName <- cleancdfname(ref.cdfName, addcdf = FALSE) ## Allow for usage of alternative cdfs if(is.null(cdfname)) Data <- new("AffyBatch", cdfName = ref.cdfName, annotation = cleaned.cdfName) else Data <- new("AffyBatch", cdfName = cdfname, annotation = cleaned.cdfName) cdfInfo <- as.list(getCdfInfo(Data)) cdfInfo <- cdfInfo[order(names(cdfInfo))] read.celfile.probeintensity.matrices(filenames = filenames, cdfInfo = cdfInfo, rm.mask = rm.mask, rm.outliers = rm.outliers, rm.extra = rm.extra, verbose = verbose, which = which) } list.celfiles <- function(...){ files <- list.files(...) return(files[grep("\\.[cC][eE][lL]\\.gz$|\\.[cC][eE][lL]$", files)]) } AllButCelsForReadAffy <- function(..., filenames=character(0), widget=getOption("BioC")$affy$use.widgets, celfile.path=NULL, sampleNames=NULL, phenoData=NULL, description=NULL){ ##first figure out filenames auxnames <- unlist(as.list(substitute(list(...)))[-1]) if (widget){ require(tkWidgets) widgetfiles <- fileBrowser(textToShow="Choose CEL files", testFun=hasSuffix("[cC][eE][lL]|[cC][eE][lL].gz")) } else{ widgetfiles <- character(0) } if(!is.null(celfile.path)){ auxnames <- file.path(celfile.path, auxnames) filenames <- file.path(celfile.path, filenames) } filenames <- c(filenames, auxnames, widgetfiles) if(length(filenames)==0){ if(is.null(celfile.path)) celfile.path <- getwd() filenames <- list.celfiles(celfile.path,full.names=TRUE) } if(length(filenames)==0) stop("No cel filennames specified and no cel files in specified directory:",celfile.path,"\n") if(is.null(sampleNames)){ sampleNames <- sub("^/?([^/]*/)*", "", filenames) } else{ if(length(sampleNames)!=length(filenames)){ warning("sampleNames not same length as filenames. Using filenames as sampleNames instead\n") sampleNames <- sub("^/?([^/]*/)*", "", filenames) } } chkSn <- function(filenames, samplenames){ fntest <- sub("^/?([^/]*/)*", "", filenames) if(all(fntest %in% samplenames)){ filenames <<- filenames[match(samplenames, fntest)] } else { warning(paste0("Mismatched phenoData and celfile names!\n\n", "Please note that the row.names of your phenoData ", "object should be identical to what you get from ", "list.celfiles()!\nOtherwise you are responsible for ", "ensuring that the ordering of your phenoData object ", "conforms to the ordering of the celfiles as they are ", "read into the AffyBatch!\nIf not, errors may ", "result from using the phenoData for subsetting or ", "creating linear models, etc.\n\n"), call. = FALSE) } } if(is.character(phenoData)) { ## if character, read file if(length(phenoData)!=1) stop(sprintf("'phenoData' must be of length 1, but is %d.", length(phenoData))) phenoData <- read.AnnotatedDataFrame(filename=phenoData) sampleNames <- sampleNames(phenoData) chkSn(filenames, sampleNames) } else if(is.data.frame(phenoData)) { ## if data.frame, coerce phenoData <- as(phenoData, "AnnotatedDataFrame") sampleNames <- sampleNames(phenoData) chkSn(filenames, sampleNames) } else if(is.null(phenoData)) { phenoData <- new("AnnotatedDataFrame", data = data.frame(sample=seq_along(sampleNames), row.names=sampleNames), varMetadata = data.frame(labelDescription="arbitrary numbering", row.names=names(pData))) } else if (!is(phenoData, "AnnotatedDataFrame")) { stop(sprintf("'phenoData' must be of class 'AnnotatedDataFrame', but is %s.", class(phenoData))) } ##get MIAME information if(is.character(description)){ description <- read.MIAME(filename=description,widget=FALSE) } else{ if (! is(description, "MIAME")) { description <- new("MIAME") } } ##MIAME stuff description@preprocessing$filenames <- filenames description@preprocessing$affyversion <- library(help=affy)$info[[2]][[2]][2] return(list(filenames = filenames, phenoData = phenoData, sampleNames = sampleNames, description = description)) } ###this is user friendly wrapper for read.affybatch ReadAffy <- function(..., filenames=character(0), widget=getOption("BioC")$affy$use.widgets, compress=getOption("BioC")$affy$compress.cel, celfile.path=NULL, sampleNames=NULL, phenoData=NULL, description=NULL, notes="", rm.mask=FALSE, rm.outliers=FALSE, rm.extra=FALSE, verbose=FALSE,sd=FALSE, cdfname = NULL) { l <- AllButCelsForReadAffy(..., filenames=filenames, widget=widget, celfile.path=celfile.path, sampleNames=sampleNames, phenoData=phenoData, description=description) ##and now we are ready to read cel files ret <- read.affybatch(filenames=l$filenames, phenoData=l$phenoData, description=l$description, notes=notes, compress=compress, rm.mask=rm.mask, rm.outliers=rm.outliers, rm.extra=rm.extra, verbose=verbose,sd=sd,cdfname=cdfname) sampleNames(ret) <- l$sampleNames return(ret) } checkValidFilenames <- function(filenames) { ## Returns TRUE if filenames is a character vector containing ## paths to files that exist (directories don't count). ## A suitable error message is printed via stop() if invalid ## file names are encountered. if (!is.character(filenames)) stop(strwrap(paste("file names must be specified using a character", "vector, not a", sQuote(typeof(filenames)))), call.=FALSE) if (length(filenames) == 0) stop("no file names provided") if (any(sapply(filenames, nchar) < 1)) stop("empty file names are not allowed") finfo <- file.info(filenames) whBad <- sapply(finfo[["isdir"]], function(x) !identical(FALSE, x)) if (any(whBad)) { msg <- paste("the following are not valid files:\n", paste(" ", filenames[whBad], collapse="\n")) stop(msg, call.=FALSE) } TRUE } affy/R/rma.R0000644000175400017540000000414613556116173013645 0ustar00biocbuildbiocbuild###################################################### # # rma - RMA interface to c code # # the RMA method implemented in c code # # this code serves as interface to the c code. # currently # implemented (version 0.25) background correction # # Background correction code has been added. # # note this function does not leave the supplied # AffyBatch unchanged if you select DESTRUCTIVE=TRUE. this is # for memory purposes but can be quite # dangerous if you are not careful. Use destructive=FALSE if this is # deemed likely to be a problem. # # UPDATE: note that the affybatch is now not affected if you use # destructive=TRUE and you might actually save a little memory. # the destructive refers only to Plobs, which would be destroyed. # # History # # Feb 22, 2004 - activated subset. In is now possible to # do the entire RMA procedure using a subset of probesets # # Oct 26, 2007 = makesure verbosity flag is correctly passed down to C-level routines # # Oct 28, 2007 MM are no longer passed to the C code # # Jul 2, 2008 - change how probeNames (which is really probe/row indexing) is passed down to # c code # # ######################################################## rma <- function(object,subset=NULL, verbose=TRUE, destructive = TRUE,normalize=TRUE,background=TRUE,bgversion=2,...){ rows <- length(probeNames(object,subset)) cols <- length(object) if (is.null(subset)){ ngenes <- length(geneNames(object)) } else { ngenes <- length(subset) } pNList <- probeNames(object,subset) pNList <- split(0:(length(pNList) -1), pNList) if (destructive){ exprs <- .Call("rma_c_complete",pm(object,subset), pNList, ngenes, normalize, background, bgversion, verbose, PACKAGE="affy") } else { exprs <- .Call("rma_c_complete_copy", pm(object,subset), pNList, ngenes, normalize, background, bgversion, verbose, PACKAGE="affy") } colnames(exprs) <- sampleNames(object) new("ExpressionSet", phenoData = phenoData(object), annotation = annotation(object), protocolData = protocolData(object), experimentData = experimentData(object), exprs = exprs) } affy/R/summary.R0000644000175400017540000000344113556116173014560 0ustar00biocbuildbiocbuild###these are summary functions they take matrices of probes x chips ###and return expression and se (when applicable) ##DEBUG: appending the se to the expression values in a same vector ## is too much hackish (I think)... we need to think about something ## better avdiff <- function(x,constant=3){ e <- apply(x,2,function(y){ o <- order(y) yy <- y[-c(o[1],o[length(y)])] #take out biggest and smallest if(length(yy)<2) # SK, some genes have only one probe mean(y) else mean(y[abs(y-mean(yy))detecting normalization methods from naming convention\n") ## this could move into the respective methods of AffyBatch later assign("normalize.AffyBatch.methods", sub("^normalize\\.AffyBatch\\.", "", grep("^normalize.AffyBatch", all.affy, value = TRUE)), envir=env) } .initExpression <- function(all.affy, env) { if (debug.affy123) cat("-->detecting expression value methods from naming convention\n") ## the first one is deprecated (well... "should be"...) vals <- sub("^generateExprVal\\.method\\.", "", grep("^generateExprVal.method", all.affy, value = TRUE)) assign("generateExprSet.methods", vals, envir=env) assign("express.summary.stat.methods", vals, envir=env) } .initBackgroundCorrect <- function(all.affy, env) { if (debug.affy123) cat("-->detecting background correction methods from naming convention\n") start <- nchar("bg.correct.") assign("bgcorrect.methods", sub("^bg\\.correct\\.", "", grep("^bg.correct", all.affy, value = TRUE)), envir=env) } .initPmCorrect <- function(all.affy, env) { if (debug.affy123) cat("-->detecting pm correction methods from naming convention\n") assign("pmcorrect.methods", sub("^pmcorrect\\.", "", grep("^pmcorrect", all.affy, value = TRUE)), envir=env) } .setAffyOptions <- function(affy.opt=NA) { if (! any(is.na(affy.opt))) { if (class(affy.opt) != "BioCPkg") stop("obviously invalid package options !") BioC <- getOption("BioC") BioC$affy <- affy.opt options("BioC"=BioC) return() } ## add affy specific options ## (not unlike what is done in 'Biobase') if (is.null(getOption("BioC"))) { BioC <- list() class(BioC) <- "BioCOptions" options("BioC"=BioC) } probesloc.first <- list(what="environment", where=.GlobalEnv) probesloc.second <- list(what="libPath", where=NULL) probesloc.third <- list(what="data", where="affy") probesloc.fourth <- list(what="bioC", where=.libPaths()[1]) ## default for the methods bgcorrect.method <- "mas" normalize.method <- "quantiles" pmcorrect.method <- "pmonly" summary.method <- "liwong" affy.opt <- list(compress.cdf=FALSE, compress.cel=FALSE, use.widgets=FALSE, probesloc = list(probesloc.first, probesloc.second, probesloc.third, probesloc.fourth), bgcorrect.method = bgcorrect.method, normalize.method = normalize.method, pmcorrect.method = pmcorrect.method, summary.method = summary.method, xy.offset = 0 ## this one is for temporary compatibility ) class(affy.opt) <- "BioCPkg" BioC <- getOption("BioC") BioC$affy <- affy.opt options("BioC"=BioC) ## --- } .onLoad <- function(libname, pkgname) { # where <- match(paste("package:", pkgname, sep=""), search()) all.affy <- ls(environment(sys.function())) ##a place to store some variables that need to be accessed .affyInternalEnv <- new.env(parent=emptyenv()) assign(".affyInternalEnv", .affyInternalEnv, envir=topenv(parent.frame())) .initNormalize(all.affy, .affyInternalEnv) .initExpression(all.affy, .affyInternalEnv) .initBackgroundCorrect(all.affy, .affyInternalEnv) .initPmCorrect(all.affy, .affyInternalEnv) .setAffyOptions() if(.Platform$OS.type == "windows" && interactive() && .Platform$GUI == "Rgui"){ addVigs2WinMenu("affy") } } affy/aclocal.m40000755000175400017540000000113413556116173014377 0ustar00biocbuildbiocbuild## ## Try finding zlib library and headers ## ## R_ZLIB() ## AC_DEFUN([R_ZLIB], [ have_zlib=no AC_CHECK_LIB(z, main, [ AC_CHECK_HEADER(zlib.h, [ AC_MSG_CHECKING([if zlib version >= 1.1.3]) AC_TRY_RUN([ #include "confdefs.h" #include #include int main() { #ifdef ZLIB_VERSION return(strcmp(ZLIB_VERSION, "1.1.3") < 0); #else return(1); #endif }], [AC_MSG_RESULT([yes]) have_zlib=yes], AC_MSG_RESULT([no]), AC_MSG_RESULT([no])) ]) ]) if test "${have_zlib}" = yes; then AC_DEFINE(HAVE_ZLIB) LIBS='-lz '$LIBS fi ]) affy/build/0000755000175400017540000000000013556146135013635 5ustar00biocbuildbiocbuildaffy/build/vignette.rds0000644000175400017540000000050413556146135016173 0ustar00biocbuildbiocbuildR]O0kl,nMb|hڒ҉{م =bH˽ܞ{i}0,vMòf For some (mysterious) reasons, save(..., ascii=TRUE) is behaving wrong on my linux box at home. I saved it with ascii=FALSE (portability could be .....) LG ###why not have a slot in cel.container denoting the default Cdf ###then change all functions so that one does not need to pass Cdf ###with this and some methods we maybe able to get rid of Plobs entirely ###maybe this is a version 2.0 task. ----> Yep... mentioned in the file TODO for some time now... Yo, Laurentz takin' the mike now: - fixed a problem with CDF.example.RData - updated the documentation for the normalize functions (should keep 'R CMD check happy') - introduced a generic method 'normalize.methods' (Plob and Cel.container) - variables related to normalize.methods (normalize.Cel.container.methods and normalize.Plob.methods) are created. - changed the methods names 'normalize.Cel.XYZ' to 'normalize.Cel.container.XYZ' (more consistent). Documentation shoudlhave been updated accordingly. - removed image.Cel.Rd - fixed the method image for Cel-class. Added better ways of asking the function to mask areas. updated the documentation accordingly. - did a bit more with affy.Rnw (in inst/doc/). Now it goes through Sweave ok. - update the file 'TODO' still talkin'...: - cleaned read_cdffile.c (no more warnings) - made something usable for the documentation of 'normalize' (hopefully) - various fixes in the documentation - Did a bit more with affy.Rnw - the example in generateExprSet-methods.Rd is commented out... seems to work on the command line but fails through 'R CMD check' (??!?!!!?) - the 'normalize' part being done (apart of possible bugs), we reached the version number 0.8.0 - started to finish the part about generateExprSet - accessor function sd in Cel moved to spotsd affy/cleanup0000755000175400017540000000005013556146135014106 0ustar00biocbuildbiocbuild#! /bin/sh rm -f config.* src/Makevars affy/configure0000755000175400017540000007614213556146135014457 0ustar00biocbuildbiocbuild#! /bin/sh # Guess values for system-dependent variables and create Makefiles. # Generated automatically using autoconf version 2.13 # Copyright (C) 1992, 93, 94, 95, 96 Free Software Foundation, Inc. # # This configure script is free software; the Free Software Foundation # gives unlimited permission to copy, distribute and modify it. # Defaults: ac_help= ac_default_prefix=/usr/local # Any additions from configure.in: # Initialize some variables set by options. # The variables have the same names as the options, with # dashes changed to underlines. build=NONE cache_file=./config.cache exec_prefix=NONE host=NONE no_create= nonopt=NONE no_recursion= prefix=NONE program_prefix=NONE program_suffix=NONE program_transform_name=s,x,x, silent= site= srcdir= target=NONE verbose= x_includes=NONE x_libraries=NONE bindir='${exec_prefix}/bin' sbindir='${exec_prefix}/sbin' libexecdir='${exec_prefix}/libexec' datadir='${prefix}/share' sysconfdir='${prefix}/etc' sharedstatedir='${prefix}/com' localstatedir='${prefix}/var' libdir='${exec_prefix}/lib' includedir='${prefix}/include' oldincludedir='/usr/include' infodir='${prefix}/info' mandir='${prefix}/man' # Initialize some other variables. subdirs= MFLAGS= MAKEFLAGS= SHELL=${CONFIG_SHELL-/bin/sh} # Maximum number of lines to put in a shell here document. ac_max_here_lines=12 ac_prev= for ac_option do # If the previous option needs an argument, assign it. if test -n "$ac_prev"; then eval "$ac_prev=\$ac_option" ac_prev= continue fi case "$ac_option" in -*=*) ac_optarg=`echo "$ac_option" | sed 's/[-_a-zA-Z0-9]*=//'` ;; *) ac_optarg= ;; esac # Accept the important Cygnus configure options, so we can diagnose typos. case "$ac_option" in -bindir | --bindir | --bindi | --bind | --bin | --bi) ac_prev=bindir ;; -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*) bindir="$ac_optarg" ;; -build | --build | --buil | --bui | --bu) ac_prev=build ;; -build=* | --build=* | --buil=* | --bui=* | --bu=*) build="$ac_optarg" ;; -cache-file | --cache-file | --cache-fil | --cache-fi \ | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c) ac_prev=cache_file ;; -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \ | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*) cache_file="$ac_optarg" ;; -datadir | --datadir | --datadi | --datad | --data | --dat | --da) ac_prev=datadir ;; -datadir=* | --datadir=* | --datadi=* | --datad=* | --data=* | --dat=* \ | --da=*) datadir="$ac_optarg" ;; -disable-* | --disable-*) ac_feature=`echo $ac_option|sed -e 's/-*disable-//'` # Reject names that are not valid shell variable names. if test -n "`echo $ac_feature| sed 's/[-a-zA-Z0-9_]//g'`"; then { echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; } fi ac_feature=`echo $ac_feature| sed 's/-/_/g'` eval "enable_${ac_feature}=no" ;; -enable-* | --enable-*) ac_feature=`echo $ac_option|sed -e 's/-*enable-//' -e 's/=.*//'` # Reject names that are not valid shell variable names. if test -n "`echo $ac_feature| sed 's/[-_a-zA-Z0-9]//g'`"; then { echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; } fi ac_feature=`echo $ac_feature| sed 's/-/_/g'` case "$ac_option" in *=*) ;; *) ac_optarg=yes ;; esac eval "enable_${ac_feature}='$ac_optarg'" ;; -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \ | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \ | --exec | --exe | --ex) ac_prev=exec_prefix ;; -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \ | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \ | --exec=* | --exe=* | --ex=*) exec_prefix="$ac_optarg" ;; -gas | --gas | --ga | --g) # Obsolete; use --with-gas. with_gas=yes ;; -help | --help | --hel | --he) # Omit some internal or obsolete options to make the list less imposing. # This message is too long to be a string in the A/UX 3.1 sh. cat << EOF Usage: configure [options] [host] Options: [defaults in brackets after descriptions] Configuration: --cache-file=FILE cache test results in FILE --help print this message --no-create do not create output files --quiet, --silent do not print \`checking...' messages --version print the version of autoconf that created configure Directory and file names: --prefix=PREFIX install architecture-independent files in PREFIX [$ac_default_prefix] --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX [same as prefix] --bindir=DIR user executables in DIR [EPREFIX/bin] --sbindir=DIR system admin executables in DIR [EPREFIX/sbin] --libexecdir=DIR program executables in DIR [EPREFIX/libexec] --datadir=DIR read-only architecture-independent data in DIR [PREFIX/share] --sysconfdir=DIR read-only single-machine data in DIR [PREFIX/etc] --sharedstatedir=DIR modifiable architecture-independent data in DIR [PREFIX/com] --localstatedir=DIR modifiable single-machine data in DIR [PREFIX/var] --libdir=DIR object code libraries in DIR [EPREFIX/lib] --includedir=DIR C header files in DIR [PREFIX/include] --oldincludedir=DIR C header files for non-gcc in DIR [/usr/include] --infodir=DIR info documentation in DIR [PREFIX/info] --mandir=DIR man documentation in DIR [PREFIX/man] --srcdir=DIR find the sources in DIR [configure dir or ..] --program-prefix=PREFIX prepend PREFIX to installed program names --program-suffix=SUFFIX append SUFFIX to installed program names --program-transform-name=PROGRAM run sed PROGRAM on installed program names EOF cat << EOF Host type: --build=BUILD configure for building on BUILD [BUILD=HOST] --host=HOST configure for HOST [guessed] --target=TARGET configure for TARGET [TARGET=HOST] Features and packages: --disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no) --enable-FEATURE[=ARG] include FEATURE [ARG=yes] --with-PACKAGE[=ARG] use PACKAGE [ARG=yes] --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no) --x-includes=DIR X include files are in DIR --x-libraries=DIR X library files are in DIR EOF if test -n "$ac_help"; then echo "--enable and --with options recognized:$ac_help" fi exit 0 ;; -host | --host | --hos | --ho) ac_prev=host ;; -host=* | --host=* | --hos=* | --ho=*) host="$ac_optarg" ;; -includedir | --includedir | --includedi | --included | --include \ | --includ | --inclu | --incl | --inc) ac_prev=includedir ;; -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \ | --includ=* | --inclu=* | --incl=* | --inc=*) includedir="$ac_optarg" ;; -infodir | --infodir | --infodi | --infod | --info | --inf) ac_prev=infodir ;; -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*) infodir="$ac_optarg" ;; -libdir | --libdir | --libdi | --libd) ac_prev=libdir ;; -libdir=* | --libdir=* | --libdi=* | --libd=*) libdir="$ac_optarg" ;; -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \ | --libexe | --libex | --libe) ac_prev=libexecdir ;; -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \ | --libexe=* | --libex=* | --libe=*) libexecdir="$ac_optarg" ;; -localstatedir | --localstatedir | --localstatedi | --localstated \ | --localstate | --localstat | --localsta | --localst \ | --locals | --local | --loca | --loc | --lo) ac_prev=localstatedir ;; -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \ | --localstate=* | --localstat=* | --localsta=* | --localst=* \ | --locals=* | --local=* | --loca=* | --loc=* | --lo=*) localstatedir="$ac_optarg" ;; -mandir | --mandir | --mandi | --mand | --man | --ma | --m) ac_prev=mandir ;; -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*) mandir="$ac_optarg" ;; -nfp | --nfp | --nf) # Obsolete; use --without-fp. with_fp=no ;; -no-create | --no-create | --no-creat | --no-crea | --no-cre \ | --no-cr | --no-c) no_create=yes ;; -no-recursion | --no-recursion | --no-recursio | --no-recursi \ | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) no_recursion=yes ;; -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \ | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \ | --oldin | --oldi | --old | --ol | --o) ac_prev=oldincludedir ;; -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \ | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \ | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*) oldincludedir="$ac_optarg" ;; -prefix | --prefix | --prefi | --pref | --pre | --pr | --p) ac_prev=prefix ;; -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*) prefix="$ac_optarg" ;; -program-prefix | --program-prefix | --program-prefi | --program-pref \ | --program-pre | --program-pr | --program-p) ac_prev=program_prefix ;; -program-prefix=* | --program-prefix=* | --program-prefi=* \ | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*) program_prefix="$ac_optarg" ;; -program-suffix | --program-suffix | --program-suffi | --program-suff \ | --program-suf | --program-su | --program-s) ac_prev=program_suffix ;; -program-suffix=* | --program-suffix=* | --program-suffi=* \ | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*) program_suffix="$ac_optarg" ;; -program-transform-name | --program-transform-name \ | --program-transform-nam | --program-transform-na \ | --program-transform-n | --program-transform- \ | --program-transform | --program-transfor \ | --program-transfo | --program-transf \ | --program-trans | --program-tran \ | --progr-tra | --program-tr | --program-t) ac_prev=program_transform_name ;; -program-transform-name=* | --program-transform-name=* \ | --program-transform-nam=* | --program-transform-na=* \ | --program-transform-n=* | --program-transform-=* \ | --program-transform=* | --program-transfor=* \ | --program-transfo=* | --program-transf=* \ | --program-trans=* | --program-tran=* \ | --progr-tra=* | --program-tr=* | --program-t=*) program_transform_name="$ac_optarg" ;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil) silent=yes ;; -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb) ac_prev=sbindir ;; -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \ | --sbi=* | --sb=*) sbindir="$ac_optarg" ;; -sharedstatedir | --sharedstatedir | --sharedstatedi \ | --sharedstated | --sharedstate | --sharedstat | --sharedsta \ | --sharedst | --shareds | --shared | --share | --shar \ | --sha | --sh) ac_prev=sharedstatedir ;; -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \ | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \ | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \ | --sha=* | --sh=*) sharedstatedir="$ac_optarg" ;; -site | --site | --sit) ac_prev=site ;; -site=* | --site=* | --sit=*) site="$ac_optarg" ;; -srcdir | --srcdir | --srcdi | --srcd | --src | --sr) ac_prev=srcdir ;; -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*) srcdir="$ac_optarg" ;; -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \ | --syscon | --sysco | --sysc | --sys | --sy) ac_prev=sysconfdir ;; -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \ | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*) sysconfdir="$ac_optarg" ;; -target | --target | --targe | --targ | --tar | --ta | --t) ac_prev=target ;; -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*) target="$ac_optarg" ;; -v | -verbose | --verbose | --verbos | --verbo | --verb) verbose=yes ;; -version | --version | --versio | --versi | --vers) echo "configure generated by autoconf version 2.13" exit 0 ;; -with-* | --with-*) ac_package=`echo $ac_option|sed -e 's/-*with-//' -e 's/=.*//'` # Reject names that are not valid shell variable names. if test -n "`echo $ac_package| sed 's/[-_a-zA-Z0-9]//g'`"; then { echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; } fi ac_package=`echo $ac_package| sed 's/-/_/g'` case "$ac_option" in *=*) ;; *) ac_optarg=yes ;; esac eval "with_${ac_package}='$ac_optarg'" ;; -without-* | --without-*) ac_package=`echo $ac_option|sed -e 's/-*without-//'` # Reject names that are not valid shell variable names. if test -n "`echo $ac_package| sed 's/[-a-zA-Z0-9_]//g'`"; then { echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; } fi ac_package=`echo $ac_package| sed 's/-/_/g'` eval "with_${ac_package}=no" ;; --x) # Obsolete; use --with-x. with_x=yes ;; -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \ | --x-incl | --x-inc | --x-in | --x-i) ac_prev=x_includes ;; -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \ | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*) x_includes="$ac_optarg" ;; -x-libraries | --x-libraries | --x-librarie | --x-librari \ | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l) ac_prev=x_libraries ;; -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \ | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*) x_libraries="$ac_optarg" ;; -*) { echo "configure: error: $ac_option: invalid option; use --help to show usage" 1>&2; exit 1; } ;; *) if test -n "`echo $ac_option| sed 's/[-a-z0-9.]//g'`"; then echo "configure: warning: $ac_option: invalid host type" 1>&2 fi if test "x$nonopt" != xNONE; then { echo "configure: error: can only configure for one host and one target at a time" 1>&2; exit 1; } fi nonopt="$ac_option" ;; esac done if test -n "$ac_prev"; then { echo "configure: error: missing argument to --`echo $ac_prev | sed 's/_/-/g'`" 1>&2; exit 1; } fi trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15 # File descriptor usage: # 0 standard input # 1 file creation # 2 errors and warnings # 3 some systems may open it to /dev/tty # 4 used on the Kubota Titan # 6 checking for... messages and results # 5 compiler messages saved in config.log if test "$silent" = yes; then exec 6>/dev/null else exec 6>&1 fi exec 5>./config.log echo "\ This file contains any messages produced by compilers while running configure, to aid debugging if configure makes a mistake. " 1>&5 # Strip out --no-create and --no-recursion so they do not pile up. # Also quote any args containing shell metacharacters. ac_configure_args= for ac_arg do case "$ac_arg" in -no-create | --no-create | --no-creat | --no-crea | --no-cre \ | --no-cr | --no-c) ;; -no-recursion | --no-recursion | --no-recursio | --no-recursi \ | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) ;; *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?]*) ac_configure_args="$ac_configure_args '$ac_arg'" ;; *) ac_configure_args="$ac_configure_args $ac_arg" ;; esac done # NLS nuisances. # Only set these to C if already set. These must not be set unconditionally # because not all systems understand e.g. LANG=C (notably SCO). # Fixing LC_MESSAGES prevents Solaris sh from translating var values in `set'! # Non-C LC_CTYPE values break the ctype check. if test "${LANG+set}" = set; then LANG=C; export LANG; fi if test "${LC_ALL+set}" = set; then LC_ALL=C; export LC_ALL; fi if test "${LC_MESSAGES+set}" = set; then LC_MESSAGES=C; export LC_MESSAGES; fi if test "${LC_CTYPE+set}" = set; then LC_CTYPE=C; export LC_CTYPE; fi # confdefs.h avoids OS command line length limits that DEFS can exceed. rm -rf conftest* confdefs.h # AIX cpp loses on an empty file, so make sure it contains at least a newline. echo > confdefs.h # A filename unique to this package, relative to the directory that # configure is in, which we can look for to find out if srcdir is correct. ac_unique_file="DESCRIPTION" # Find the source files, if location was not specified. if test -z "$srcdir"; then ac_srcdir_defaulted=yes # Try the directory containing this script, then its parent. ac_prog=$0 ac_confdir=`echo $ac_prog|sed 's%/[^/][^/]*$%%'` test "x$ac_confdir" = "x$ac_prog" && ac_confdir=. srcdir=$ac_confdir if test ! -r $srcdir/$ac_unique_file; then srcdir=.. fi else ac_srcdir_defaulted=no fi if test ! -r $srcdir/$ac_unique_file; then if test "$ac_srcdir_defaulted" = yes; then { echo "configure: error: can not find sources in $ac_confdir or .." 1>&2; exit 1; } else { echo "configure: error: can not find sources in $srcdir" 1>&2; exit 1; } fi fi srcdir=`echo "${srcdir}" | sed 's%\([^/]\)/*$%\1%'` # Prefer explicitly selected file to automatically selected ones. if test -z "$CONFIG_SITE"; then if test "x$prefix" != xNONE; then CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site" else CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site" fi fi for ac_site_file in $CONFIG_SITE; do if test -r "$ac_site_file"; then echo "loading site script $ac_site_file" . "$ac_site_file" fi done if test -r "$cache_file"; then echo "loading cache $cache_file" . $cache_file else echo "creating cache $cache_file" > $cache_file fi ac_ext=c # CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options. ac_cpp='$CPP $CPPFLAGS' ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5' ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5' cross_compiling=$ac_cv_prog_cc_cross ac_exeext= ac_objext=o if (echo "testing\c"; echo 1,2,3) | grep c >/dev/null; then # Stardent Vistra SVR4 grep lacks -e, says ghazi@caip.rutgers.edu. if (echo -n testing; echo 1,2,3) | sed s/-n/xn/ | grep xn >/dev/null; then ac_n= ac_c=' ' ac_t=' ' else ac_n=-n ac_c= ac_t= fi else ac_n= ac_c='\c' ac_t= fi echo $ac_n "checking how to run the C preprocessor""... $ac_c" 1>&6 echo "configure:530: checking how to run the C preprocessor" >&5 # On Suns, sometimes $CPP names a directory. if test -n "$CPP" && test -d "$CPP"; then CPP= fi if test -z "$CPP"; then if eval "test \"`echo '$''{'ac_cv_prog_CPP'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else # This must be in double quotes, not single quotes, because CPP may get # substituted into the Makefile and "${CC-cc}" will confuse make. CPP="${CC-cc} -E" # On the NeXT, cc -E runs the code through the compiler's parser, # not just through cpp. cat > conftest.$ac_ext < Syntax Error EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" { (eval echo configure:551: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then : else echo "$ac_err" >&5 echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -rf conftest* CPP="${CC-cc} -E -traditional-cpp" cat > conftest.$ac_ext < Syntax Error EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" { (eval echo configure:568: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then : else echo "$ac_err" >&5 echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -rf conftest* CPP="${CC-cc} -nologo -E" cat > conftest.$ac_ext < Syntax Error EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" { (eval echo configure:585: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then : else echo "$ac_err" >&5 echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -rf conftest* CPP=/lib/cpp fi rm -f conftest* fi rm -f conftest* fi rm -f conftest* ac_cv_prog_CPP="$CPP" fi CPP="$ac_cv_prog_CPP" else ac_cv_prog_CPP="$CPP" fi echo "$ac_t""$CPP" 1>&6 have_zlib=no echo $ac_n "checking for main in -lz""... $ac_c" 1>&6 echo "configure:612: checking for main in -lz" >&5 ac_lib_var=`echo z'_'main | sed 'y%./+-%__p_%'` if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else ac_save_LIBS="$LIBS" LIBS="-lz $LIBS" cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=no" fi rm -f conftest* LIBS="$ac_save_LIBS" fi if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then echo "$ac_t""yes" 1>&6 ac_safe=`echo "zlib.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for zlib.h""... $ac_c" 1>&6 echo "configure:645: checking for zlib.h" >&5 if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" { (eval echo configure:655: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* eval "ac_cv_header_$ac_safe=yes" else echo "$ac_err" >&5 echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -rf conftest* eval "ac_cv_header_$ac_safe=no" fi rm -f conftest* fi if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then echo "$ac_t""yes" 1>&6 echo $ac_n "checking if zlib version >= 1.1.3""... $ac_c" 1>&6 echo "configure:673: checking if zlib version >= 1.1.3" >&5 if test "$cross_compiling" = yes; then echo "$ac_t""no" 1>&6 else cat > conftest.$ac_ext < #include int main() { #ifdef ZLIB_VERSION return(strcmp(ZLIB_VERSION, "1.1.3") < 0); #else return(1); #endif } EOF if { (eval echo configure:692: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null then echo "$ac_t""yes" 1>&6 have_zlib=yes else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -fr conftest* echo "$ac_t""no" 1>&6 fi rm -fr conftest* fi else echo "$ac_t""no" 1>&6 fi else echo "$ac_t""no" 1>&6 fi if test "${have_zlib}" = yes; then cat >> confdefs.h <<\EOF #define HAVE_ZLIB 1 EOF LIBS='-lz '$LIBS fi trap '' 1 2 15 cat > confcache <<\EOF # This file is a shell script that caches the results of configure # tests run on this system so they can be shared between configure # scripts and configure runs. It is not useful on other systems. # If it contains results you don't want to keep, you may remove or edit it. # # By default, configure uses ./config.cache as the cache file, # creating it if it does not exist already. You can give configure # the --cache-file=FILE option to use a different cache file; that is # what configure does when it calls configure scripts in # subdirectories, so they share the cache. # Giving --cache-file=/dev/null disables caching, for debugging configure. # config.status only pays attention to the cache file if you give it the # --recheck option to rerun configure. # EOF # The following way of writing the cache mishandles newlines in values, # but we know of no workaround that is simple, portable, and efficient. # So, don't put newlines in cache variables' values. # Ultrix sh set writes to stderr and can't be redirected directly, # and sets the high bit in the cache file unless we assign to the vars. (set) 2>&1 | case `(ac_space=' '; set | grep ac_space) 2>&1` in *ac_space=\ *) # `set' does not quote correctly, so add quotes (double-quote substitution # turns \\\\ into \\, and sed turns \\ into \). sed -n \ -e "s/'/'\\\\''/g" \ -e "s/^\\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\\)=\\(.*\\)/\\1=\${\\1='\\2'}/p" ;; *) # `set' quotes correctly as required by POSIX, so do not add quotes. sed -n -e 's/^\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\)=\(.*\)/\1=${\1=\2}/p' ;; esac >> confcache if cmp -s $cache_file confcache; then : else if test -w $cache_file; then echo "updating cache $cache_file" cat confcache > $cache_file else echo "not updating unwritable cache $cache_file" fi fi rm -f confcache trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15 test "x$prefix" = xNONE && prefix=$ac_default_prefix # Let make expand exec_prefix. test "x$exec_prefix" = xNONE && exec_prefix='${prefix}' # Any assignment to VPATH causes Sun make to only execute # the first set of double-colon rules, so remove it if not needed. # If there is a colon in the path, we need to keep it. if test "x$srcdir" = x.; then ac_vpsub='/^[ ]*VPATH[ ]*=[^:]*$/d' fi trap 'rm -f $CONFIG_STATUS conftest*; exit 1' 1 2 15 # Transform confdefs.h into DEFS. # Protect against shell expansion while executing Makefile rules. # Protect against Makefile macro expansion. cat > conftest.defs <<\EOF s%#define \([A-Za-z_][A-Za-z0-9_]*\) *\(.*\)%-D\1=\2%g s%[ `~#$^&*(){}\\|;'"<>?]%\\&%g s%\[%\\&%g s%\]%\\&%g s%\$%$$%g EOF DEFS=`sed -f conftest.defs confdefs.h | tr '\012' ' '` rm -f conftest.defs # Without the "./", some shells look in PATH for config.status. : ${CONFIG_STATUS=./config.status} echo creating $CONFIG_STATUS rm -f $CONFIG_STATUS cat > $CONFIG_STATUS </dev/null | sed 1q`: # # $0 $ac_configure_args # # Compiler output produced by configure, useful for debugging # configure, is in ./config.log if it exists. ac_cs_usage="Usage: $CONFIG_STATUS [--recheck] [--version] [--help]" for ac_option do case "\$ac_option" in -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r) echo "running \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion" exec \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion ;; -version | --version | --versio | --versi | --vers | --ver | --ve | --v) echo "$CONFIG_STATUS generated by autoconf version 2.13" exit 0 ;; -help | --help | --hel | --he | --h) echo "\$ac_cs_usage"; exit 0 ;; *) echo "\$ac_cs_usage"; exit 1 ;; esac done ac_given_srcdir=$srcdir trap 'rm -fr `echo "src/Makevars" | sed "s/:[^ ]*//g"` conftest*; exit 1' 1 2 15 EOF cat >> $CONFIG_STATUS < conftest.subs <<\\CEOF $ac_vpsub $extrasub s%@SHELL@%$SHELL%g s%@CFLAGS@%$CFLAGS%g s%@CPPFLAGS@%$CPPFLAGS%g s%@CXXFLAGS@%$CXXFLAGS%g s%@FFLAGS@%$FFLAGS%g s%@DEFS@%$DEFS%g s%@LDFLAGS@%$LDFLAGS%g s%@LIBS@%$LIBS%g s%@exec_prefix@%$exec_prefix%g s%@prefix@%$prefix%g s%@program_transform_name@%$program_transform_name%g s%@bindir@%$bindir%g s%@sbindir@%$sbindir%g s%@libexecdir@%$libexecdir%g s%@datadir@%$datadir%g s%@sysconfdir@%$sysconfdir%g s%@sharedstatedir@%$sharedstatedir%g s%@localstatedir@%$localstatedir%g s%@libdir@%$libdir%g s%@includedir@%$includedir%g s%@oldincludedir@%$oldincludedir%g s%@infodir@%$infodir%g s%@mandir@%$mandir%g s%@CPP@%$CPP%g CEOF EOF cat >> $CONFIG_STATUS <<\EOF # Split the substitutions into bite-sized pieces for seds with # small command number limits, like on Digital OSF/1 and HP-UX. ac_max_sed_cmds=90 # Maximum number of lines to put in a sed script. ac_file=1 # Number of current file. ac_beg=1 # First line for current file. ac_end=$ac_max_sed_cmds # Line after last line for current file. ac_more_lines=: ac_sed_cmds="" while $ac_more_lines; do if test $ac_beg -gt 1; then sed "1,${ac_beg}d; ${ac_end}q" conftest.subs > conftest.s$ac_file else sed "${ac_end}q" conftest.subs > conftest.s$ac_file fi if test ! -s conftest.s$ac_file; then ac_more_lines=false rm -f conftest.s$ac_file else if test -z "$ac_sed_cmds"; then ac_sed_cmds="sed -f conftest.s$ac_file" else ac_sed_cmds="$ac_sed_cmds | sed -f conftest.s$ac_file" fi ac_file=`expr $ac_file + 1` ac_beg=$ac_end ac_end=`expr $ac_end + $ac_max_sed_cmds` fi done if test -z "$ac_sed_cmds"; then ac_sed_cmds=cat fi EOF cat >> $CONFIG_STATUS <> $CONFIG_STATUS <<\EOF for ac_file in .. $CONFIG_FILES; do if test "x$ac_file" != x..; then # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in". case "$ac_file" in *:*) ac_file_in=`echo "$ac_file"|sed 's%[^:]*:%%'` ac_file=`echo "$ac_file"|sed 's%:.*%%'` ;; *) ac_file_in="${ac_file}.in" ;; esac # Adjust a relative srcdir, top_srcdir, and INSTALL for subdirectories. # Remove last slash and all that follows it. Not all systems have dirname. ac_dir=`echo $ac_file|sed 's%/[^/][^/]*$%%'` if test "$ac_dir" != "$ac_file" && test "$ac_dir" != .; then # The file is in a subdirectory. test ! -d "$ac_dir" && mkdir "$ac_dir" ac_dir_suffix="/`echo $ac_dir|sed 's%^\./%%'`" # A "../" for each directory in $ac_dir_suffix. ac_dots=`echo $ac_dir_suffix|sed 's%/[^/]*%../%g'` else ac_dir_suffix= ac_dots= fi case "$ac_given_srcdir" in .) srcdir=. if test -z "$ac_dots"; then top_srcdir=. else top_srcdir=`echo $ac_dots|sed 's%/$%%'`; fi ;; /*) srcdir="$ac_given_srcdir$ac_dir_suffix"; top_srcdir="$ac_given_srcdir" ;; *) # Relative path. srcdir="$ac_dots$ac_given_srcdir$ac_dir_suffix" top_srcdir="$ac_dots$ac_given_srcdir" ;; esac echo creating "$ac_file" rm -f "$ac_file" configure_input="Generated automatically from `echo $ac_file_in|sed 's%.*/%%'` by configure." case "$ac_file" in *Makefile*) ac_comsub="1i\\ # $configure_input" ;; *) ac_comsub= ;; esac ac_file_inputs=`echo $ac_file_in|sed -e "s%^%$ac_given_srcdir/%" -e "s%:% $ac_given_srcdir/%g"` sed -e "$ac_comsub s%@configure_input@%$configure_input%g s%@srcdir@%$srcdir%g s%@top_srcdir@%$top_srcdir%g " $ac_file_inputs | (eval "$ac_sed_cmds") > $ac_file fi; done rm -f conftest.s* EOF cat >> $CONFIG_STATUS <> $CONFIG_STATUS <<\EOF exit 0 EOF chmod +x $CONFIG_STATUS rm -fr confdefs* $ac_clean_files test "$no_create" = yes || ${CONFIG_SHELL-/bin/sh} $CONFIG_STATUS || exit 1 affy/configure.in0000755000175400017540000000107113556116173015050 0ustar00biocbuildbiocbuilddnl dnl Configuration things for affyR. dnl (http://www.cbs.dtu.dk/laurent/download/affyR/ dnl What is below (and in the other configuration fiels dnl was taken from different configuration scripts for R version 1.3.0. dnl dnl Acknowledgments: The author(s) of the R configure scripts, Kurt Hornik for the tip with autoconf. dnl dnl Laurent 2001 AC_INIT("DESCRIPTION") dnl dnl Are things (still) the same ? dnl (taken from the 'writing R extensions manual') dnl dnl tests the zlib.h dnl (the test is found in 'acinclude.m4') dnl R_ZLIB AC_OUTPUT(src/Makevars) affy/data/0000755000175400017540000000000013556116173013446 5ustar00biocbuildbiocbuildaffy/data/SpikeIn.rda0000644000175400017540000000316613556116173015506 0ustar00biocbuildbiocbuild՗oUnln5#M4F`)6! eigLKKgi;-RZVh$PUm@@4$j"~ DbH$DN]ipyϹs{y]I\,ˊBcBѡQ?5uUZ+*fƄ躚пCOweGvF5kla3үDe#BЏ9KT`[X19/{џ]>_`yN٭΍]52q;O~%*O7r౔QגEpj]I*o z"k~&q:U^;~ܥ)]s ?Љʑ3|gYd97?eo&Ogߔe[K[xffaoՉ|3# Zԉ7?4ᦫ=.ag#AX?EXn;VYN}_T~ ȫͱN^/#V煻|L=md,,=pE#Ė<\BcJ+BW5z[('L zj|tek&NN{lNL{I;9y9nN؄#ɉyF&1C' 5c-HڰJsE"8 Mٮ߸BZ9*$-UƖͣpK~ Ykfr}YeM ?)m%jSi5(|}~9o ÿRstgSL3r1WHWƕ SD-^3-{{T;^wMN&ϊ?$࿒+w_taM^ˉo].?Y+}۴u-e=]YWO)i̺㶳S?' rԚռg0]Wkc5qz3:QEuS_x`ٴ.w q=3ZU\JLi>LeVʏ#?-7ģT- #uLv7|O/x$e;QAZa^sUῆ̗la=0dph}oIa|vp]ɾpU"cR8Ga”׬EE=J=Pk=~ʔ̆M4\)&DMT+7!affy/data/cdfenv.example.rda0000644000175400017540000003346513556116173017050 0ustar00biocbuildbiocbuildwew]7Q좎(jpΊ$*("*J !1ɶnΝ;{]}E,sw{WN^>o|9k7>++p)WߓOk㳮㮷t?9^?ٯ|EU|C᷽=#yΥG~ Zu7o ~ V >l/? __ (|1z c<=Ԇg^:`|Y~_r[o_7:c`8/O_ > >>~9|&| l> p?_WkKᵏ;|?/}.r7x[ν`.% W*\pn- w.Do߄$]{?^r8os}1\u?|=q'O7Ÿ?|>C0<‡1xG`|Y8hzؽWkKeUk-8ow;]Cnx6Ov@Mc8<G!CIx N_ ;7W``6`F0-/,d % ~ p >!xn~n- w., `s0 K #i2&#i2&#i2&#i2&#i2&#i2&#i2&#i2@i2&#i2&#i2&#i2&#i2&#i2&#i2&?d=&֤ϚdzBÚ<ɣ<Ƀi4OwF4EiQz:ivZ=+o(kPY0Cϐ3kO>6×ftg_}o;hG/`6*]C#Y=4 MFgP _ % qxtm`' 6pٟp' g|f:nskcw4]C 8Q&+heqLl`+#e­2WWJҦ)+mJҦ)+mJҦ)+mJҦ3'{xzʮk;YB]Nu׵m5on(7xyC0n؆I\a0qk5 \"Aiȼ !6dކxd_'*rU!nu uwUf]6VeUn*Buՙ{ѡYәYӑYSg3ԙk{!950d5uMf]۫3}0Yg r2pIa&kPl|s߆A/Cg.@>Cg጑CF%#d>/PY󧬹SWtg]ks5W%T f01#kȒ3WGQ;'kS@1,zۜe?+ϪOgեY1pVYQIAe,`fI[ &Bƒ)H,F4AA4AߑQ(su]X8L,v1w̱s\Dc1yQr(9&scs2C.v]7W 6R3ToFh83Bmy!7#~ 'A/vFs;hng43y5#f'{eV*  2*J R:6oUGTNTNTN{kշACjP5y:é:é:OvP|_eҗY2K_2^&Vebe/+ˣP^{萗C]q+q8ƒVx B++ M}@rUmݓhD$Z'9IMmRԜ'E1(NړdSڔ6%MIjSڔ~JY?sg>tF ;#`!03ݦR)ٟHsR C)%DhJ4aI+ф%hw/  MX 4a&,ӄeLiKONVɘ%J, y-@=[,4ۀtYuY(%cd vrm`6k|;tC bO a`LPu `LP (TD 4a 4v`LP0&( c1AAuTPTGQAuTЄ)h>}/DaSfimE쮨s+ReE[+:\:\*:V1 T*c@XbbbרbǨbbb}HW U[ S j!PW*EHG?'SEhhU*}EnN;YӷūB:Eע[$_~o~-:[|hu6GZ ? 9 3_ ~2p׷o҃<É޲[^K@oQz-E[`KoQ-E<|BgZ?"%W_?m/mOn MA)X4]HP(Hj<"#UyDDHPHPHPHP Mfxe!/MbSmԤۚj&Hk"6jMBSWUSj&Oi&h&Oh{c| ~||:|7o A^Wڕjho+Y+X+W+&Iފfa*ꃐ~][WUmU[VU5ڪ_u{!J=t_BOYr%Yr%Yr%G*b)*)jUZE"K."K."K.*/*I_}xJ$ȼ (ϒ*}~oMϻ:0p Fr,7uCYr;Ǣs93ȱݞc9j'sNN0uppppCΣ9oNśst{Q;9j'7}o>.rȝr[".En^ܽUEk|d[WW0OUywHHi1-54JZ I i70EZjL#;-5ƴr'ͷ|*͗|(w|&W|$-5EqQj\EikOťD7 2n2#@dlEetFȸAB Sҵ)Y"+@d DV Y"+@dme),|]' c9!<2SYy,<>?Yyn}ހ(40ծjy輚s^kk^7g^g^f^f^f^gLfqGɾPY+TY?l UVlZʺ,ez Y7uYA U`*BhfmIHHH xP}q!%bXU̮,j\ëDbU1J$VY~HU"#j/W͗DbHU"J$V*X%DbHNvC Fv׎p#ZU /j]afa:ݽ0v.wvv[V.q⺾~>Ế\wsO@ҲnJ=TP:yCHKX5_#j,&\x@MQ5F=ԨPӲiYմjZV5-UM˪eUjU}1f'z_* Lk+bmbmbm2 V*V*THJE{_ޯW+1}JJJJJJJc'zl"T\99l<#\VL9Z0(R`7`7`7g .xFfjA3ZL-X*S) >d=2t춑6=$ oi;Q;f7;tN Ύ]a8kжkvy.Oa$5Idòaz0]sX9uXuX;,`擇apxt_l&j9z$Gt|'9",rX^e9刳#r:ACy'+{ʞ'+{ʞ'+{/>CI=R(-mom[,l^ Hlmzdoۮ:={eMmmD6f ی`o;m퐷l]糗vIXIWlB:b;nZw6Mn)w^FQ~s<{6EMwKRknDl@lGOI};thޡYW+֕ArQ=@6"62#*"'v$GnNd݊$!"!   3D~;Ct? ?1lr&nҷMELm^nSSI6UM&ߤrTNiR97o {o==z'O)S>]$uz.n4ㆲA'7rCݠ <#<f1 YLNNNNNzrzrzrzrzrzrzrCUs &3O+Χ|ȦOӔȤtRM:crS͔rmJ6kz5ɚdMo7YӛM&kz5l6g YashnE} =RBJ )%RBJXF'D(%QK<$%KH)!RJ&% |$D_K~I/'w'RMضbܦ)mjM1~SmAJ}ST.mʟ-~KRo)[ -.ϖiҖ!!!!n}iߟP$F:68 ` }߿;|߿ow| ?C!=!)nn߿}n߿z/*}:ߞ0~L$.N2~֓L$O2ݓ$r'ɕ9It,Ą85!M;2Lw>UU n#7n#7n#7nc&m~%}GxQ?=Џ(c?: Q4t?}s0{N9s9L#kas,F$9NПSюs8G;юs8G;m;Km Y泃f洃fC0 ;Hޥvi]oۥvi]IfWrٕTv%]IdWؕ4v%]xm{ <1>^O>@}t~#Axqt, C!~!C:!>zoⓇ˳Ԗ湎ɱyLcrl1MCzN4'MsHi6jg㸍lyõZ0-iNNNNNN>ĺ2 XV.e2XV /A2Yyʲ̒Wt WtW̃V́V>+&+WVl^Yb{eEkEkEkn}I'?Sh9S)\c:xNAquNi9-ٝNKv%ӒinMI>3%NISꔤ::S35m۶כ$p{6d^E(j΋g#)#1vSl7vSl7vSl7vSl7vSlw,>: ?.e\˄nY&/^`j2/Myo*j2SQU}e_EWQUQUQUQUQUQUQUQUW>W^}WFBlj(T/@*VҪTZJܼ*VyNU*rTZ]RRRRJkRiM*I5&֤ҚTZJkRiM] {mPW}bcbʘOcùEbj2cú=σ,6~X__ __ Q:cO\®oZ%ޅy,^"ϓEL乲H<_ ;"'Y$ E;gQ&64ϡF^}~zMl5F^m;5z7A$8INƓgPgƠL 9:g?g?g{1q\gTgY)T}VsVsVuuκt>JwMq$7MpSp6M#(l $[Rfm!iKoKŰRR!lI[RT%nQ[m[m[m[m[m[Dua'vUPUUՔU\eTtW,*PUMMMתתתתתתת6UUOqB,q KqIaPƒCXBҗeYv(UKʩ%){I^e)yY*^e;*eYv>كHB"/d!C"3d!RC"7d!CP %,9d!KYrȒC%,9d!KYr(RnX>_|.E:Hg%"QtFQ*E:ZЊvbgQ(E:Hg"Q3tF(E:QQG*y704@Y\idFnidL`z ꡧBQAh wE9fG.Ey"O[abh҃Q,=pHKԮ5Pʝ@(wN,=`KXz'/8lJ4EOStu88S$b$S$bʡV!H m4^0^0^0^0^ HqD\ HqD\ Hą_>ÃO0j懫9[s(5zpjtm!êѹ5VXu/^Q zYG:^QuԽ.F5/  rj)Ȃj5TSXTxƲj* XZMXcq5}Dxng a3 |VgVfVaV_aV`uf]g2i&EPe̺]1n.c֙K]Ƭ溌YG~]ƬYOA(ce̺Y12f]Ƭ˘u.ceِ̺12fCl|iA{ ~%*k¯_~#@ԈmٱX[;ESѱmX;UKb5c5Mb_g;7sppLE \kC߃&iL:14K,A,R@,VbOl5*6|#i3MP8 X xN3p򐝌FbCk)NjLbX_*aUNk_Cn~?//?GRx-| L"Kz(]YhB#H8 #uhdG#C(;7< YhB#MC((51&Y^D8ox7ΓMRIj7I&݌` 5Mۦⶩm*nۦⶩdHvdHvdHvdHvdHvdHvdHv >یw6d7dÆ,ؐ^Ckr ٭A4.@ҤA4H Ҡ3el6 y@ن76H 鹉&hzn鹉uкZw{ 4Ȓ%dUBV Y%dUBV Y%Dt]p,ٖ*&lMUFVYedUFVYe لl_6/[h.e1|}'wE߅1އmz:tl\񙱽-{1?5Kխ&ڪ9H4:EzPex PbQ"Ma\iӕ&xڔ%6mIiQqou]guu-׋(- pۢPzْ,u' P"j,-pen*0\0dـEM@tD@tD@A(dlp B5PC6m^Qql#~r'('I֑zmt ' :'uONNQ8(S S)y0p יxn4؟y!o$/@}'Gl y1A1O6Ƃ* }}}mAC[С-qAI\n_Nے;C$C ?<ãwj p :]ayuNȈ'dćeće8c1yLx<S<&>:xYOod 8`pCLRBQ ; Z]j 8d!pȀC2?Oh?O聊lzB^VôQ[eqB*Uw c!"ա6̪tU1]5Y]*^Ug*V JU`U)@@d. s \@2d. svud. s \@2̅_I-:iIvȒSh=ShxO3ӗA\u ۮhTTH ^!+HBWY!+$x BW4H*$BWH ^!+$xBWH ^!+}u`b1όk}>Ò3S}gcj1x*I2 x((㡠L}a$R,.Kq)vJS)( psRBI  k!-8^P/GE#x\y )EOd)ĘEb̲,ϚdS0 y@#Y1sbRY9kg0kg0kg03 /0 m^؛hoFwmc:f#:_s}~ϯԑ|~o)x7@}~o->YS*ve+KG~b~'G?ߕ2r=uGQuOGqpԽQ(n TWI4q.w=.cyӚɥq.x+<?m6KJ %9 9LE#usGstgsNru\gu9s9i{NyZi^&} ]gu&0affy/data/mapCdfName.rda0000644000175400017540000000032713556116173016133 0ustar00biocbuildbiocbuild r0b```b`RL@& `d`\)i~ @( RWZ[ 0640O40]s2SAaGaq!T5hTl`pm(Dilution)) ################################################### ### code chunk number 15: affy.Rnw:515-517 ################################################### gn <- geneNames(Dilution) pm(Dilution, gn[100]) ################################################### ### code chunk number 16: affy.Rnw:531-532 ################################################### hist(Dilution[,1:2]) ##PM histogram of arrays 1 and 2 ################################################### ### code chunk number 17: affy.Rnw:548-550 (eval = FALSE) ################################################### ## par(mfrow=c(2,2)) ## image(Dilution) ################################################### ### code chunk number 18: affy.Rnw:566-568 ################################################### par(mfrow=c(1,1)) boxplot(Dilution, col=c(2,3,4)) ################################################### ### code chunk number 19: affy.Rnw:591-593 ################################################### deg <- AffyRNAdeg(Dilution) names(deg) ################################################### ### code chunk number 20: affy.Rnw:597-598 ################################################### summaryAffyRNAdeg(deg) ################################################### ### code chunk number 21: affy.Rnw:605-606 ################################################### plotAffyRNAdeg(deg) ################################################### ### code chunk number 22: affy.Rnw:620-621 ################################################### Dilution.normalized <- normalize(Dilution) ################################################### ### code chunk number 23: affy.Rnw:667-671 ################################################### gn <- featureNames(Dilution) ps <- probeset(Dilution, gn[1:2]) #this is what i should be using: ps show(ps[[1]]) ################################################### ### code chunk number 24: affy.Rnw:687-689 ################################################### mylocation <- list("1000_at"=cbind(pm=c(1,2,3),mm=c(4,5,6)), "1001_at"=cbind(pm=c(4,5,6),mm=c(1,2,3))) ################################################### ### code chunk number 25: affy.Rnw:696-698 ################################################### ps <- probeset(Dilution, genenames=c("1000_at","1001_at"), locations=mylocation) ################################################### ### code chunk number 26: affy.Rnw:702-706 ################################################### pm(ps[[1]]) mm(ps[[1]]) pm(ps[[2]]) mm(ps[[2]]) ################################################### ### code chunk number 27: affy.Rnw:725-737 ################################################### data(SpikeIn) ##SpikeIn is a ProbeSets pms <- pm(SpikeIn) mms <- mm(SpikeIn) ##pms follow concentration par(mfrow=c(1,2)) concentrations <- matrix(as.numeric(sampleNames(SpikeIn)),20,12,byrow=TRUE) matplot(concentrations,pms,log="xy",main="PM",ylim=c(30,20000)) lines(concentrations[1,],apply(pms,2,mean),lwd=3) ##so do mms matplot(concentrations,mms,log="xy",main="MM",ylim=c(30,20000)) lines(concentrations[1,],apply(mms,2,mean),lwd=3) ################################################### ### code chunk number 28: affy.Rnw:771-773 ################################################### cat("HG_U95Av2 is",cleancdfname("HG_U95Av2"),"\n") cat("HG-133A is",cleancdfname("HG-133A"),"\n") ################################################### ### code chunk number 29: affy.Rnw:777-778 ################################################### cat("HG_U95Av2 is",cleancdfname("HG_U95Av2",addcdf=FALSE),"\n") ################################################### ### code chunk number 30: affy.Rnw:785-788 ################################################### data(cdfenv.example) ls(cdfenv.example)[1:5] get(ls(cdfenv.example)[1],cdfenv.example) ################################################### ### code chunk number 31: affy.Rnw:799-802 ################################################### print(Dilution@cdfName) myenv <- getCdfInfo(Dilution) ls(myenv)[1:5] ################################################### ### code chunk number 32: affy.Rnw:810-813 ################################################### Index <- pmindex(Dilution) names(Index)[1:2] Index[1:2] ################################################### ### code chunk number 33: affy.Rnw:817-818 ################################################### pmindex(Dilution, genenames=c("1000_at","1001_at")) ################################################### ### code chunk number 34: affy.Rnw:822-823 ################################################### mmindex(Dilution, genenames=c("1000_at","1001_at")) ################################################### ### code chunk number 35: affy.Rnw:826-829 ################################################### indexProbes(Dilution, which="pm")[1] indexProbes(Dilution, which="mm")[1] indexProbes(Dilution, which="both")[1] ################################################### ### code chunk number 36: affy.Rnw:841-844 ################################################### opt <- getOption("BioC") affy.opt <- opt$affy print(names(affy.opt)) ################################################### ### code chunk number 37: affy.Rnw:848-853 ################################################### opt <- getOption("BioC") affy.opt <- opt$affy affy.opt$normalize.method <- "constant" opt$affy <- affy.opt options(BioC=opt) ################################################### ### code chunk number 38: affy.Rnw:859-864 ################################################### opt <- getOption("BioC") affy.opt <- opt$affy affy.opt$compress.cel <- TRUE opt$affy <- affy.opt options(BioC=opt) affy/inst/doc/affy.Rnw0000644000175400017540000010542013556116173015676 0ustar00biocbuildbiocbuild% -*- mode: noweb; noweb-default-code-mode: R-mode; -*- %\VignetteIndexEntry{1. Primer} %\VignetteKeywords{Preprocessing, Affymetrix} %\VignetteDepends{affy} %\VignettePackage{affy} %documentclass[12pt, a4paper]{article} \documentclass[12pt]{article} \usepackage{amsmath} \usepackage{hyperref} \usepackage[authoryear,round]{natbib} \textwidth=6.2in \textheight=8.5in %\parskip=.3cm \oddsidemargin=.1in \evensidemargin=.1in \headheight=-.3in \newcommand{\scscst}{\scriptscriptstyle} \newcommand{\scst}{\scriptstyle} \newcommand{\Rfunction}[1]{{\texttt{#1}}} \newcommand{\Robject}[1]{{\texttt{#1}}} \newcommand{\Rpackage}[1]{{\textit{#1}}} \author{Laurent Gautier, Rafael Irizarry, Leslie Cope, and Ben Bolstad} \begin{document} \title{Description of affy} \maketitle \tableofcontents \section{Introduction} The \Rpackage{affy} package is part of the BioConductor\footnote{\url{http://bioconductor.org/}} project. It is meant to be an extensible, interactive environment for data analysis and exploration of Affymetrix oligonucleotide array probe level data. The software utilities provided with the Affymetrix software suite summarizes the probe set intensities to form one {\it expression measure} for each gene. The expression measure is the data available for analysis. However, as pointed out by \cite{li:wong:2001a}, much can be learned from studying the individual probe intensities, or as we call them, the {\it probe level data}. This is why we developed this package. The package includes plotting functions for the probe level data useful for quality control, RNA degradation assessments, different probe level normalization and background correction procedures, and flexible functions that permit the user to convert probe level data to expression measures. The package includes utilities for computing expression measures similar to MAS 4.0's AvDiff \citep{affy4}, MAS 5.0's signal \citep{affy5}, DChip's MBEI \citep{li:wong:2001a}, and RMA \citep{iriz:etal:2003}. We assume that the reader is already familiar with oligonucleotide arrays and with the design of the Affymetrix GeneChip arrays. If you are not, we recommend the Appendix of the Affymetrix MAS manual \cite{affy4,affy5}. The following terms are used throughout this document: \begin{description} \item[probe] oligonucleotides of 25 base pair length used to probe RNA targets. \item[perfect match] probes intended to match perfectly the target sequence. \item[$PM$] intensity value read from the perfect matches. \item[mismatch] the probes having one base mismatch with the target sequence intended to account for non-specific binding. \item[$MM$] intensity value read from the mis-matches. \item[probe pair] a unit composed of a perfect match and its mismatch. \item[affyID] an identification for a probe set (which can be a gene or a fraction of a gene) represented on the array. \item[probe pair set] $PM$s and $MM$s related to a common {\it affyID}. \item[{\it CEL} files] contain measured intensities and locations for an array that has been hybridized. \item[{\it CDF} file] contain the information relating probe pair sets to locations on the array. \end{description} Section \ref{whatsnew} describes the main differences between version 1.5 and this version (1.6). Section \ref{sec:get.started} describes a quick way of getting started and getting expression measures. Section \ref{qc} describes some quality control tools. Section \ref{s1.4} describes normalization routines. Section \ref{classes} describes the different classes in the package. \ref{sec:probesloc} describes our strategy to map probe locations to probe set membership. Section \ref{configure.options} describes how to change the package's default options. Section \ref{whatwasnew} describes earlier changes. %%%make sure to change this when we get a publication about version 2. {\bf Note:} If you use this package please cite \cite{gaut:cope:bols:iriz:2003} and/or \cite{iriz:gaut:cope:2003}. \section{Changes for affy in BioC 1.8 release} \label{whatsnew} There were relatively few changes. \begin{itemize} \item MAplot now accepts the argument \Rfunction{plot.method} which can be used to call smoothScatter. \item \Rfunction{normalize.quantiles.robust} has had minor changes. \item \Rfunction{ReadAffy} can optionally return the SD values stored in the cel file. \item The C parsing code has been moved to the \Rpackage{affyio} package, which is now a dependency of the affy package. This change should be transparent to users as \Rpackage{affyio} will be automatically loaded when affy is loaded. \item Added a cdfname argument to \Rfunction{justRMA} and \Rfunction{ReadAffy} to allow for the use of alternative cdf packages. \end{itemize} \section{Getting Started: From probe level data to expression values} \label{sec:get.started} The first thing you need to do is {\bf load the package}. \begin{Sinput} R> library(affy) ##load the affy package \end{Sinput} <>= library(affy) @ This release of the \Rpackage{affy} package will automatically download the appropriate cdf environment when you require it. However, if you wish you may download and install the cdf environment you need from \url{http://bioconductor.org/help/bioc-views/release/data/annotation/} manually. If there is no cdf environment currently built for your particular chip and you have access to the CDF file then you may use the \Rpackage{makecdfenv} package to create one yourself. To make the cdf packaes, Microsoft Windows users will need to use the tools described in \url{http://www.murdoch-sutherland.com/Rtools/}. \subsection{Quick start} If all you want is to go from probe level data ({\it Cel} files) to expression measures here are some quick ways. If you want is RMA, the quickest way of reading in data and getting expression measures is the following: \begin{enumerate} \item Create a directory, move all the relevant {\it CEL} files to that directory \item If using linux/unix, start R in that directory. \item If using the Rgui for Microsoft Windows make sure your working directory contains the {\it Cel} files (use ``File -> Change Dir'' menu item). \item Load the library. \begin{Sinput} R> library(affy) ##load the affy package \end{Sinput} \item Read in the data and create an expression, using RMA for example. \begin{Sinput} R> Data <- ReadAffy() ##read data in working directory R> eset <- rma(Data) \end{Sinput} \end{enumerate} Depending on the size of your dataset and on the memory available to your system, you might experience errors like `Cannot allocate vector \ldots'. An obvious option is to increase the memory available to your R process (by adding memory and/or closing external applications\footnote{UNIX-like systems users might also want to check {\it ulimit} and/or compile {\bf R} and the package for 64 bits when possible.}. An another option is to use the function \Rfunction{justRMA}. \begin{Sinput} R> eset <- justRMA() \end{Sinput} This reads the data and performs the `RMA' way to preprocess them at the {\it C} level. One does not need to call \verb+ReadAffy+, probe level data is never stored in an AffyBatch. \verb+rma+ continues to be the recommended function for computing RMA. The \Rfunction{rma} function was written in C for speed and efficiency. It uses the expression measure described in \cite{iriz:etal:2003}. For other popular methods use \Rfunction{expresso} instead of \Rfunction{rma} (see Section \ref{expresso}). For example for our version of MAS 5.0 signal uses expresso (see code). To get mas 5.0 you can use \begin{Sinput} R> eset <- mas5(Data) \end{Sinput} which will also normalize the expression values. The normalization can be turned off through the \verb+normalize+ argument. In all the above examples, the variable \Robject{eset} is an object of class \Robject{ExpressionSet} described in the Biobase vignette. Many of the packages in BioConductor work on objects of this class. See the \Rpackage{genefilter} and \Rpackage{geneplotter} packages for some examples. If you want to use some other analysis package, you can write out the expression values to file using the following command: \begin{Sinput} R> write.exprs(eset, file="mydata.txt") \end{Sinput} \subsection{Reading CEL file information} The function \Rfunction{ReadAffy} is quite flexible. It lets you specify the filenames, phenotype, and MIAME information. You can enter them by reading files (see the help file) or widgets (you need to have the tkWidgets package installed and working). \begin{Sinput} R> Data <- ReadAffy(widget=TRUE) ##read data in working directory \end{Sinput} This function call will pop-up a file browser widget, see Figure \ref{fig:widget.filechooser}, that provides an easy way of choosing cel files. \newpage \begin{figure}[htbp] \begin{center} \includegraphics{widgetfilechooser} \caption{\label{fig:widget.filechooser}Graphical display for selecting {\it CEL} files. This widget is part of the {\it tkWidgets} package. (function written by Jianhua (John) Zhang). } \end{center} \end{figure} Next, a widget (not shown) permits the user to enter the \verb+phenoData+. %%See Figure \ref{fig:widget.pd}. %% \begin{figure}[htbp] %% \begin{center} %% \begin{tabular}{c} %% \includegraphics{numcovariates}\\ %% \includegraphics{namecovariates}\\ %% \includegraphics{assigncovariates} %% \end{tabular} %% \caption{\label{fig:widget.pd}Graphical display for entering phenoData %% This widget is part %% of the {\it tkWidgets} package.} %% % (functions written by Majnu John.} %% \end{center} %% \end{figure} Finally the a widget is presented for the user to enter MIAME information. %%Seen in Figure \ref{fig:widget.tkMIAME}. %% \begin{figure}[htbp] %% \begin{center} %% \includegraphics[width=0.5\textwidth]{widgettkMIAME} %% \caption{\label{fig:widget.tkMIAME}Graphical display for entering {\it %% MIAME} informations. This widget is part of the {\it tkWidgets} %% package.} %% % (function written by Majnu John).} %% \end{center} %% \end{figure} Notice that it is not necessary to use widgets to enter this information. Please read the help file for more information on how to read it from flat files or to enter it programmatically. The function \Rfunction{ReadAffy} is a wrapper for the functions \Rfunction{read.affybatch}, \Rfunction{tkSampleNames}, \Rfunction{read.AnnotatedDataFrame}, and \Rfunction{read.MIAME}. The function \Rfunction{read.affybatch} has some nice feature that make it quite flexible. For example, the \verb+compression+ argument permit the user to read compressed {\it CEL} files. The argument {\it compress} set to {\it TRUE} will inform the readers that your files are compressed and let you read them while they remain compressed. The compression formats {\it zip} and {\it gzip} are known to be recognized. A comprehensive description of all these options is found in the help file: \begin{Sinput} R> ?read.affybatch R> ?read.AnnotatedDataFrame R> ?read.MIAME \end{Sinput} \subsection{Expression measures} The most common operation is certainly to convert probe level data to expression values. Typically this is achieved through the following sequence: \begin{enumerate} \item reading in probe level data. \item background correction. \item normalization. \item probe specific background correction, e.g. subtracting $MM$. \item summarizing the probe set values into one expression measure and, in some cases, a standard error for this summary. \end{enumerate} We detail what we believe is a good way to proceed below. As mentioned the function \Rfunction{expresso} provides many options. For example, \begin{Sinput} R> eset <- expresso(Dilution, normalize.method="qspline", bgcorrect.method="rma",pmcorrect.method="pmonly", summary.method="liwong") \end{Sinput} This will store expression values, in the object \Robject{eset}, as an object of class \Robject{ExpressionSet} (see the \Rpackage{Biobase} package). You can either use R and the BioConductor packages to analyze your expression data or if you rather use another package you can write it out to a tab delimited file like this \begin{Sinput} R> write.exprs(eset, file="mydata.txt") \end{Sinput} In the \verb+mydata.txt+ file, row will represent genes and columns will represent samples/arrays. The first row will be a header describing the columns. The first column will have the {\it affyID}s. The \Rfunction{write.exprs} function is quite flexible on what it writes (see the help file). \subsubsection{expresso} \label{expresso} The function \Rfunction{expresso} performs the steps background correction, normalization, probe specific correction, and summary value computation. We now show this using an \Robject{AffyBatch} included in the package for examples. The command \verb+data(Dilution)+ is used to load these data. Important parameters for the expresso function are: \begin{description} \item[bgcorrect.method]. The background correction method to use. The available methods are <<>>= bgcorrect.methods() @ \item[normalize.method]. The normalization method to use. The available methods can be queried by using \verb+normalize.methods+. <<>>= library(affydata) data(Dilution) ##data included in the package for examples normalize.methods(Dilution) @ \item[pmcorrect.method] The method for probe specific correction. The available methods are <<>>= pmcorrect.methods() @ \item[summary.method]. The summary method to use. The available methods are <<>>= express.summary.stat.methods() @ Here we use \Rfunction{mas} to refer to the methods described in the Affymetrix manual version 5.0. \item[widget] Making the \verb+widget+ argument \verb+TRUE+, will let you select missing parameters (like the normalization method, the background correction method or the summary method). Figure \ref{fig:expressochooser} shows the widget for the selection of preprocessing methods for each of the steps. \begin{Sinput} R> expresso(Dilution, widget=TRUE) \end{Sinput} \begin{figure}[htbp] \begin{center} \includegraphics[width=0.5\textwidth]{EWSnap} \caption{\label{fig:expressochooser}Graphical display for selecting expresso methods.} \end{center} \end{figure} \end{description} There is a separate vignette {\bf affy: Built-in Processing Methods} which explains in more detail what each of the preprocessing options does. \subsubsection{MAS 5.0} To obtain expression values that correspond to those from MAS 5.0, use \Rfunction{mas5}, which wraps \Rfunction{expresso} and \Rfunction{affy.scalevalue.exprSet}. <<>>= eset <- mas5(Dilution) @ To obtain MAS 5.0 presence calls you can use the \verb+mas5calls+ method. <<>>= Calls <- mas5calls(Dilution) @ This returns an \verb+ExpressionSet+ object containing P/M/A calls and their associated Wilcoxon p-values. \subsubsection{Li and Wong's MBEI (dchip)} To obtain our version of Li and Wong's MBEI one can use \begin{Sinput} R> eset <- expresso(Dilution, normalize.method="invariantset", bg.correct=FALSE, pmcorrect.method="pmonly",summary.method="liwong") \end{Sinput} This gives the current $PM$-only default. The reduced model (previous default) can be obtained using \verb+pmcorrect.method="subtractmm"+. \subsubsection{C implementation of RMA} One of the quickest ways to compute expression using the \Rpackage{affy} package is to use the \Rfunction{rma} function. We have found that this method allows a user to compute the RMA expression measure in a matter of minutes for datasets that may have taken hours in previous versions of \Rpackage{affy}. The function serves as an interface to a hard coded C implementation of the RMA method \citep{iriz:etal:2003}. Generally, the following would be sufficient to compute RMA expression measures: <<>>= eset <- rma(Dilution) @ Currently the \Rfunction{rma} function implements RMA in the following manner \begin{enumerate} \item Probe specific correction of the PM probes using a model based on observed intensity being the sum of signal and noise \item Normalization of corrected PM probes using quantile normalization \citep{bols:etal:2003} \item Calculation of Expression measure using median polish. \end{enumerate} The \Rfunction{rma} function is likely to be improved and extended in the future as the RMA method is fine-tuned. \newpage \section{Quality Control through Data Exploration} \label{qc} For the users convenience we have included the \verb+Dilution+ sample data set: <<>>= Dilution @ This will create the \verb+Dilution+ object of class \Robject{AffyBatch}. \Rfunction{print} (or \Rfunction{show}) will display summary information. These objects represent data from one experiment. The \Robject{AffyBatch} class combines the information of various {\it CEL} files with a common {\it CDF} file. This class is designed to keep information of one experiment. The probe level data is contained in this object. The data in \verb+Dilution+ is a small sample of probe sets from 2 sets of duplicate arrays hybridized with different concentrations of the same RNA. This information is part of the \Robject{AffyBatch} and can be accessed with the \verb+phenoData+ and \verb+pData+ methods: <<>>= phenoData(Dilution) pData(Dilution) @ Several of the functions for plotting summarized probe level data are useful for diagnosing problems with the data. The plotting functions \Rfunction{boxplot} and \Rfunction{hist} have methods for \Robject{AffyBatch} objects. Each of these functions presents side-by-side graphical summaries of intensity information from each array. Important differences in the distribution of intensities are often evident in these plots. The function \Rfunction{MAplot} (applied, for example, to \verb+pm(Dilution)+), offers pairwise graphical comparison of intensity data. The option \verb+pairs+ permits you to chose between all pairwise comparisons (when \verb+TRUE+) or compared to a reference array (the default). These plots can be particularly useful in diagnosing problems in replicate sets of arrays. The function argument \verb+plot.method+ can be used to create a MAplot using a smoothScatter, rather than the default method which is to draw every point. \begin{figure}[htbp] \begin{center} <>= data(Dilution) MAplot(Dilution,pairs=TRUE,plot.method="smoothScatter") @ \end{center} \caption{Pairwise MA plots} \end{figure} \subsection{Accessing $PM$ and $MM$ Data} The $PM$ and $MM$ intensities and corresponding {\it affyID} can be accessed with the \Rfunction{pm}, \Rfunction{mm}, and \Rfunction{probeNames} methods. These will be matrices with rows representing probe pairs and columns representing arrays. The gene name associated with the probe pair in row $i$ can be found in the $i$th entry of the vector returned by \Rfunction{probeNames}. <<>>= Index <- c(1,2,3,100,1000,2000) ##6 arbitrary probe positions pm(Dilution)[Index,] mm(Dilution)[Index,] probeNames(Dilution)[Index] @ \verb+Index+ contains six arbitrary probe positions. Notice that the column names of $PM$ and $MM$ matrices are the sample names and the row names are the {\it affyID}, e.g. \verb+1001_at+ and \verb+1000_at+ together with the probe number (related to position in the target sequence). <<>>= sampleNames(Dilution) @ {\bf Quick example:} To see what percentage of the $MM$ are larger than the $PM$ simply type <<>>= mean(mm(Dilution)>pm(Dilution)) @ The \Rfunction{pm} and \Rfunction{mm} functions can be used to extract specific probe set intensities. <<>>= gn <- geneNames(Dilution) pm(Dilution, gn[100]) @ The method \Rfunction{geneNames} extracts the unique {\it affyID}s. Also notice that the 100th probe set is different from the 100th probe! The 100th probe is not part of the the 100th probe set. The methods \Rfunction{boxplot}, \Rfunction{hist}, and \Rfunction{image} are useful for quality control. Figure \ref{f3} shows kernel density estimates (rather than histograms) of $PM$ intensities for the 1st and 2nd array of the \verb+Dilution+ also included in the package. \subsection{Histograms, Images, and Boxplots} \begin{figure}[htbp] \begin{center} <>= hist(Dilution[,1:2]) ##PM histogram of arrays 1 and 2 @ \caption{\label{f3} Histogram of $PM$ intensities for 1st and 2nd array} \end{center} \end{figure} As seen in the previous example, the sub-setting method \verb+[+ can be used to extract specific arrays. {\bf NOTE: Sub-setting is different in this version. One can no longer subset by gene. We can only define subsets by one dimension: the columns, i.e. the arrays. Because the \verb+Cel+ class is no longer available \verb+[[+ is no longer available.} %]] The method \verb+image()+ can be used to detect spatial artifacts. By default we look at log transformed intensities. This can be changed through the \verb+transfo+ argument. <>= par(mfrow=c(2,2)) image(Dilution) @ \begin{figure}[htbp] \begin{center} \includegraphics{image} \caption{\label{f1} Image of the log intensities.} \end{center} \end{figure} These images are quite useful for quality control. We recommend examining these images as a first step in data exploration. The method \Rfunction{boxplot} can be used to show $PM$, $MM$ or both intensities. \begin{figure}[htbp] \begin{center} <>= par(mfrow=c(1,1)) boxplot(Dilution, col=c(2,3,4)) @ \caption{\label{f4}Boxplot of arrays in Dilution data.} \end{center} \end{figure} As discussed in the next section this plot shows that we need to normalize these arrays. \subsection{RNA degradation plots} The functions \Rfunction{AffyRNAdeg}, \Rfunction{summaryAffyRNAdeg}, and \Rfunction{plotAffyRNAdeg} aid in assessment of RNA quality. Individual probes in a probeset are ordered by location relative to the $5'$ end of the targeted RNA molecule.\cite{affy4} Since RNA degradation typically starts from the $5'$ end of the molecule, we would expect probe intensities to be systematically lowered at that end of a probeset when compared to the $3'$ end. On each chip, probe intensities are averaged by location in probeset, with the average taken over probesets. The function \Rfunction{plotAffyRNAdeg} produces a side-by-side plots of these means, making it easy to notice any $5'$ to $3'$ trend. The function \Rfunction{summaryAffyRNAdeg} produces a single summary statistic for each array in the batch, offering a convenient measure of the severity of degradation and significance level. For an example <<>>= deg <- AffyRNAdeg(Dilution) names(deg) @ does the degradation analysis and returns a list with various components. A summary can be obtained using <<>>= summaryAffyRNAdeg(deg) @ Finally a plot can be created using \Rfunction{plotAffyRNAdeg}, see Figure \ref{f4.3}. \begin{figure}[htbp] \begin{center} <>= plotAffyRNAdeg(deg) @ \caption{\label{f4.3} Side-by-side plot produced by plotAffyRNAdeg.} \end{center} \end{figure} \newpage \section{Normalization} \label{s1.4} Various researchers have pointed out the need for normalization of Affymetrix arrays. See for example \cite{bols:etal:2003}. The method \verb+normalize+ lets one normalize at the probe level <<>>= Dilution.normalized <- normalize(Dilution) @ For an extended example on normalization please refer to the vignette in the affydata package. \section{Classes} \label{classes} \verb+AffyBatch+ is the main class in this package. There are three other auxiliary classes that we also describe in this Section. \subsection{AffyBatch} The AffyBatch class has slots to keep all the probe level information for a batch of {\it Cel} files, which usually represent an experiment. It also stores phenotypic and MIAME information as does the \verb+ExpressionSet+ class in the Biobase package (the base package for BioConductor). In fact, \verb+AffyBatch+ extends \verb+ExpressionSet+. The expression matrix in \verb+AffyBatch+ has columns representing the intensities read from the different arrays. The rows represent the {\it cel} intensities for all position on the array. The cel intensity with physical coordinates\footnote{Note that in the {\it .CEL} files the indexing starts at zero while it starts at 1 in the package (as indexing starts at 1 in {\bf R}).} $(x,y)$ will be in row \[i = x + \mathtt{nrow} \times (y - 1)\]. The \verb+ncol+ and \verb+nrow+ slots contain the physical rows of the array. Notice that this is different from the dimensions of the expression matrix. The number of row of the expression matrix is equal to \verb+ncol+$\times$\verb+nrow+. We advice the use of the functions \verb+xy2indices+ and \verb+indices2xy+ to shuttle from X/Y coordinates to indices. For compatibility with previous versions the accessor method \verb+intensity+ exists for obtaining the expression matrix. The \verb+cdfName+ slot contains the necessary information for the package to find the locations of the probes for each probe set. See Section \ref{sec:probesloc} for more on this. \subsection{ProbeSet} The \verb+ProbeSet+ class holds the information of all the probes related to an {\it affyID}. The components are \verb+pm+ and \verb+mm+. The method \verb+probeset+ extracts probe sets from \verb+AffyBatch+ objects. It takes as arguments an \verb+AffyBatch+ object and a vector of {\it affyIDs} and returns a list of objects of class \verb+ProbeSet+ <<>>= gn <- featureNames(Dilution) ps <- probeset(Dilution, gn[1:2]) #this is what i should be using: ps show(ps[[1]]) @ The \verb+pm+ and \verb+mm+ methods can be used to extract these matrices (see below). This function is general in the way it defines a probe set. The default is to use the definition of a probe set given by Affymetrix in the CDF file. However, the user can define arbitrary probe sets. The argument \verb+locations+ lets the user decide the row numbers in the \verb+intensity+ that define a probe set. For example, if we are interested in redefining the \verb+AB000114_at+ and \verb+AB000115_at+ probe sets, we could do the following: First, define the locations of the $PM$ and $MM$ on the array of the \verb+1000_at+ and \verb+1001_at+ probe sets <<>>= mylocation <- list("1000_at"=cbind(pm=c(1,2,3),mm=c(4,5,6)), "1001_at"=cbind(pm=c(4,5,6),mm=c(1,2,3))) @ The first column of the matrix defines the location of the $PM$s and the second column the $MM$s. Now we are ready to extract the \verb+ProbSet+s using the \verb+probeset+ function: <<>>= ps <- probeset(Dilution, genenames=c("1000_at","1001_at"), locations=mylocation) @ Now, \verb+ps+ is list of \verb+ProbeSet+s. We can see the $PM$s and $MM$s of each component using the \verb+pm+ and \verb+mm+ accessor methods. <<>>= pm(ps[[1]]) mm(ps[[1]]) pm(ps[[2]]) mm(ps[[2]]) @ This can be useful in situations where the user wants to determine if leaving out certain probes improves performance at the expression level. It can also be useful to combine probes from different human chips, for example by considering only probes common to both arrays. Users can also define their own environment for probe set location mapping. More on this in Section \ref{sec:probesloc}. An example of a \verb+ProbeSet+ is included in the package. A spike-in data set is included in the package in the form of a list of \verb+ProbeSet+s. The help file describes the data set. Figure \ref{f5.3} uses this data set to demonstrate that the $MM$ also detect transcript signal. \begin{figure}[htbp] \begin{center} <>= data(SpikeIn) ##SpikeIn is a ProbeSets pms <- pm(SpikeIn) mms <- mm(SpikeIn) ##pms follow concentration par(mfrow=c(1,2)) concentrations <- matrix(as.numeric(sampleNames(SpikeIn)),20,12,byrow=TRUE) matplot(concentrations,pms,log="xy",main="PM",ylim=c(30,20000)) lines(concentrations[1,],apply(pms,2,mean),lwd=3) ##so do mms matplot(concentrations,mms,log="xy",main="MM",ylim=c(30,20000)) lines(concentrations[1,],apply(mms,2,mean),lwd=3) @ \caption{\label{f5.3}PM and MM intensities plotted against SpikeIn concentration} \end{center} \end{figure} \section{Location to ProbeSet Mapping} \label{sec:probesloc} On Affymetrix GeneChip arrays, several probes are used to represent genes in the form of probe sets. From a {\it CEL} file we get for each physical location, or cel, (defined by $x$ and $y$ coordinates) an intensity. The {\it CEL} file also contains the name of the {\it CDF} file needed for the location-probe-set mapping. The {\it CDF} files store the probe set related to each location on the array. The computation of a summary expression values from the probe intensities requires a fast way to map an {\it affyid} to corresponding probes. We store this mapping information in {\bf R} environments\footnote{Please refer to the {\bf R} documentation to know more about environments.}. They only contain a part of the information that can be found in the {\it CDF} files. The {\it cdfenvs} are sufficient to perform the numerical processing methods included in the package. For each {\it CDF} file there is package, available from \url{http://bioconductor.org/help/bioc-views/release/data/annotation/}, that contains exactly one of these environments. The {\it cdfenvs} we store the $x$ and $y$ coordinates as one number (see above). In instances of {\it AffyBatch}, the {\it cdfName} slot gives the name of the appropriate {\it CDF} file for arrays represented in the \verb+intensity+ slot. The functions \verb+read.celfile+, \verb+read.affybatch+, and \verb+ReadAffy+ extract the {\it CDF} filename from the {\it CEL} files being read. Each {\it CDF} file corresponds to exactly one environment. The function \verb+cleancdfname+ converts the Affymetrix given {\it CDF} name to a BioConductor environment and annotation name. Here are two examples: These give environment names: <<>>= cat("HG_U95Av2 is",cleancdfname("HG_U95Av2"),"\n") cat("HG-133A is",cleancdfname("HG-133A"),"\n") @ This gives annotation name: <<>>= cat("HG_U95Av2 is",cleancdfname("HG_U95Av2",addcdf=FALSE),"\n") @ An environment representing the corner of an Hu6800 array is available with the package. In the following, we load the environment, look at the names for the first 5 objects defined in the environment, and finally look at the first object in the environment: <<>>= data(cdfenv.example) ls(cdfenv.example)[1:5] get(ls(cdfenv.example)[1],cdfenv.example) @ The package needs to know what locations correspond to which probe sets. The \verb+cdfName+ slot contains the necessary information to find the environment with this location information. The method \verb+getCdfInfo+ takes as an argument an \verb+AffyBatch+ and returns the necessary environment. If \verb+x+ is an \verb+AffyBatch+, this function will look for an environment with name \verb+cleancdfname(x@cdfName)+. <<>>= print(Dilution@cdfName) myenv <- getCdfInfo(Dilution) ls(myenv)[1:5] @ By default we search for the environment first in the global environment, then in a package named \verb+cleancdfname(x@cdfName)+. Various methods exist to obtain locations of probes as demonstrated in the following examples: <<>>= Index <- pmindex(Dilution) names(Index)[1:2] Index[1:2] @ \verb+pmindex+ returns a list with probe set names as names and locations in the components. We can also get specific probe sets: <<>>= pmindex(Dilution, genenames=c("1000_at","1001_at")) @ The locations are ordered from 5' to 3' on the target transcript. The function \verb+mmindex+ performs in a similar way: <<>>= mmindex(Dilution, genenames=c("1000_at","1001_at")) @ They both use the method \verb+indexProbes+ <<>>= indexProbes(Dilution, which="pm")[1] indexProbes(Dilution, which="mm")[1] indexProbes(Dilution, which="both")[1] @ The \verb+which="both"+ options returns the location of the $PM$s followed by the $MM$s. \section{Configuring the package options} \label{configure.options} Package-wide options can be configured, as shown below through examples. \begin{itemize} \item Getting the names for the options: <<>>= opt <- getOption("BioC") affy.opt <- opt$affy print(names(affy.opt)) @ %$ \item Default processing methods: <<>>= opt <- getOption("BioC") affy.opt <- opt$affy affy.opt$normalize.method <- "constant" opt$affy <- affy.opt options(BioC=opt) @ %$ \item Compression of files: if you are always compressing your CEL files, you might find annoying to specify it each time you call a reading function. It can be specified once for all in the options. <<>>= opt <- getOption("BioC") affy.opt <- opt$affy affy.opt$compress.cel <- TRUE opt$affy <- affy.opt options(BioC=opt) @ %$ \item Priority rule for the use of a cdf environment: The option {\it probesloc} is a list. Each element of the list is itself a list with two elements {\it what} and {\it where}. When looking for the information related to the locations of the probes on the array, the elements in the list will be looked at sequentially. The first one leading to the information is used (an error message is returned if none permits to find the information). The element {\it what} can be one of {\it package}, {\it environment}. \end{itemize} \section{Where can I get more information?} \label{moreinfo} There are several other vignettes addressing more specialised topics related to the {\tt affy} package. \begin{itemize} \item {\bf affy: Custom Processing Methods (HowTo)}: A description of how to use custom preprocessing methods with the package. This document gives examples of how you might write your own preprocessing method and use it with the package. \item {\bf affy: Built-in Processing Methods}: A document giving fuller descriptions of each of the preprocessing methods that are available within the {\tt affy} package. \item {\bf affy: Import Methods (HowTo)}: A discussion of the data structures used and how you might import non standard data into the package. \item {\bf affy: Loading Affymetrix Data (HowTo)}: A quick guide to loading Affymetrix data into R. \item {\bf affy: Automatic downloading of cdfenvs (HowTo)}: How you can configure the automatic downloading of the appropriate {\it cdfenv} for your analysis. \end{itemize} \appendix \section{Previous Release Notes} \subsection{Changes in versions 1.6.x} There were very few changes. \begin{itemize} \item The function \verb+MAplot+ has been added. It works on instances of AffyBatch. You can decide if you want to make all pairwise MA plots or compare to a reference array using the pairs argument. \item Minor bugs fixed in the parsers. \item The path of celfiles is now removed by ReadAffy. \end{itemize} \subsection{Changes in versions 1.5.x} There are some minor differences in what you can do but little functionality has disappeared. Memory efficiency and speed have improved. \begin{itemize} \item The widgets used by ReadAffy have changed. \item The path of celfiles is now removed by ReadAffy. \end{itemize} \subsection{Changes in versions 1.4.x} There are some minor differences in what you can do but little functionality has disappeared. Memory efficiency and speed have improved. \begin{itemize} \item For instances of \verb+AffyBatch+ the subsetting has changed. For consistency with \verb+exprSets+ one can only subset by the second dimension. So to obtain the first array, \verb+abatch[1]+ and \verb+abatch[1,]+ will give warnings (errors in the next release). The correct code is \verb+abatch[,1]+. \item mas5calls is now faster and reproduces Affymetrix's official version much better. \item If you use \verb+pm+ and \verb+mm+ to get the entire set of probes, e.g. by typing \verb+pm(abatch)+ then the method will be, on average, about 2-3 times faster than in version 1.3. \end{itemize} \bibliographystyle{plainnat} \bibliography{affy} \end{document} affy/inst/doc/affy.pdf0000644000175400017540000275370213556146130015713 0ustar00biocbuildbiocbuild%PDF-1.5 % 128 0 obj << /Length 1246 /Filter /FlateDecode >> stream xXKs6WVr&d7KV;ukJc"Q$(٦3͎@<v͡-]k_$ZxS ,'}PXrSiw 4},{ǛC]&zsBaUHr@tŢaJAɸMt ´KZ {qk;/pv-G+iUÜcy>&,j+Chq}76;(NrډjBu TK!!r! er+;a ~;_A^†|UץO9P'65"ҁVZP/l4K\7gnM/p[+OGHpu?̈́TgP9MgW!5qxdrngf0 5u \P -FLI/h-۾9ԟomg_ sIF,u~bL$,#M_Ʀ6~ZChEJ/1WN0Ay ;rvA}-#h@,fZX%A$OeZEU۫#.%ՏMʍ 36'%H uc{q ]T { ޤGtWUK]깁cɖ"Cx? Ja*'{O͗"$B,TEp+ Vc9k  FL83P#A ~_QމstŮ(S)*ؐ i07 M-aU A"NqU0%+qd#gc.2cZ%0Z|AdžlNae%J_awr5p$*G1?Iu_v[3iY4ZvBwb$d{*ȶLB򁆄j"cz9"Qpշg~% hD nw SVz1P>mk ,A :1"#ė3ʧ(=5/*=}DXW l2;qy8]s Z.YD6WTV$a$ D Pl(̄?e^#^f3 ?[VuÈ7׼+zՓfkBܴ,qkG@'vuY$w/d0HlH endstream endobj 156 0 obj << /Length 2641 /Filter /FlateDecode >> stream xZK ϯ-TEnTS8HV< &E8$9hLh4?bT\eݭgEY^qjSt;_䪊~M i\Fر˹.ͳ,7W`'>,DtɎk{y1+qjGBb嬈"Qweg&NSg 87lL;Z`DDMh%YZDOQ+ܼGU.sO-/z GTWG m@a0ZIDQ,(n$%Z^ S֐tbj{/ZrO=K_Iqc;4~y2V'_ CX#='K$8*tPno`9{1yia,5^~DQQr[!{>x$j= YX+19esR s6.M^E=GC@ى[9E"—,d[)-'LAPTpg|LgITg;2Y?%&MHc}M4en<2p6p^XWz`/HȨ 42}T[8!)暠W{!!` ޅzO !D jӁ cCdo9.o{ o1/ZHagT?'Y*,)e!w† OpEq(\ف0GkO4)Hgt],a?;ӛOːBxK99ЮZi-ƭXN|cXq1t/Ħ (5䕉+6@[R0u\j"-,*p@́gX(@޵E4 l^ғB%AJ<+D)!볈&Rayar8$_4sdh8O  gW\D}:NiOoȂV•l@\8 Sc\pa2$rj\c)dlxA}vQZj V.G`"Y*ƕp̠AK˟Vȑc}5SF&2ϰȄ] -|uɄ90;?&!|T-Xe cc,4]kӜ[%*n۸ 2i-heǦ=$9$#ʶ 26eGhZhSs@pQn?e*21'?1>$N><\5j+>R$Rƅ_Yt'W}o%7Nmrm.CͦLq'p;X=Msbt5Qz׻ΐʘt (h9i 8/,u`WGPR.}l ?فu=%z P;]/>j Y+'~Kccunm?7RF&6 =67~ rUN%\vFǛ8XtnkҕD丳-K 0?[Dpgo3 R2#ŌC3u=>aJy?Aͪ;t~йϓbW0lAwl\¢W y<_FF_t;jh; f8,)T\; ㏵ @.r6Rh8Ki.ȶb.8zȩo=C7>4 fJv2ё6b Ì%n'XExn:Prt$6{P:; ~in]n³]TA2ȮT ,R:Ղ5ҏJ1p~;3;{~!E+ T`)l!8Vn;֋\JSPT_t}R HYSWB([  !D=هS#އMpAeaǥq*LK&qzcp>~={s;>Ctl2>p^ ͹γk?3TI3s Ρ LOud;\o޽oQGF׺#r_Op3yQ re&=2 h`[ 3ۻ)S*󦰅^<pg*!O/xƖ.N"cRxMj%[ `aGfp,xO"}\ݖyl}om2NM*}60WtB6"ZܢXr$D1qZM}Qe 5{|w ?Te\Ad,ۛ~If+ N!a>ҴN0|7_dYWYuDЃϷkW)cqDey~wD2!2',zC2|h! ^e~ < endstream endobj 2 0 obj << /Type /ObjStm /N 100 /First 807 /Length 2196 /Filter /FlateDecode >> stream xZn9}W&%0f8@d fv=~HmYmZd~O('N v;j,"밭H##ɓu(8R )ƒT mH9Ҋt#Gp'{"n0i%r M$"+VWޢ#L^=9K@H1kJ@=%af%%I,(`MF Xt"lB(j 0JS=V,#1],YyR|a$lbr18&?I| #2`ٚX@Ng8C)71 yF1ãvHP`cV πZ'8j ntH֞8Wʎ̫8 8#HqX>$AǝFt>C-s8Z!Z7\!&7:8⌊_w /ɢtu3)kz_U lZ*//?S=usHJDjYU.F/U+:ʶmnmW4>V3]I]Cէ۶Z,0>ex'hw :)#:|.Yea7N l7a7v 8gH|2>#'>#25)̯/'u}}TΪjPsI'^kL ܌Y^] 55n횱dtgoOev佪]sՖ7DDy0nJ&͘LWDlǹը7Xr{\,vĽ#&;grƝUf!GN3Y)D'-<84jٲn0N-WZj+s:+{Ӵ[j>?zǺY.tCћxzFj9c6n  ?Y)GuwFŻϷoC. Z4ԟ|W'մ.t.7I_`XV9ZR`܆ܦUdnUnunMn=lOe{*Sٞt=镽=Jzl_yN_(^9L֤ƊQąfP"HBmLAQ 8 TV]r; =< Fyh+(gD<Pzk/"&p\$Ld҂hT?HFFbR JC$RbdR8 QxNž"l"iX@[yPĞ.ӞI GBB6=Y)4NH$$|1 jFqPHx{dhY@خ2::@6໌RW,F*umv1HnpA"5N HuFbَj'^XvWWJ: `%68w#PQ[}j (d0< JGĉێ"B)!DjpE׊./g=QOCZyėkFeA9h_V& sGT>uJoUߩ&gWդYݘnLV7&UͪfUcJَvlc\='JAw؏1dp8~O+ x;'qH?=$~Zyh@9QBFBaV^]6M9|_Y:L!SNpLj@lWϴ3X~Q&S)De I JNp)ϯa~ xlᛨ e}`CdX~(@8T ysQhYC57wx a.<тc=ةgUW0vZ)5ELq EʱQXicܡ0P<6 v_`oY97ͫ|(>!F^Gb|pЛ/}=Pߓ뮻}Vferӊ* +(vdk w] ǭ] endstream endobj 183 0 obj << /Length 2690 /Filter /FlateDecode >> stream xڕYIWL& 4%˱+ M`A0[W]q.a}W&sUi~¬2iR%$wt6K.Uk,<̳j6@Rol'XO[6_8:leS+a/Lg括-qf];]pjgp>&7k[<0;Ȓ; -cV|;D0~iec,2 -{?)Xa,vR6֤UllVu"ϼdx}$ŝimx(;a\OہY,Pd{}2$wxKo167MAP)n\^>ϕVK<ɘubNC؎]mOKQk$'(3RܶaҾ^,5)xId1Ip!ߓ"II'ә#*TUTz=ɮNg5 `/gSFukZ z哘?B 6lBfle`Sc>,XRa~2NBl,ijw{Q"XǣhNqPP '73CGvKy ]ň.dmD=-:y0ZgMx,MRjn5/6)HQ{ke*AU7SD|;v̪_%,UiWeC''[5J1eydV?61'T4-< FA7?.̯;oݤg6o|H,WЫC35⣀|ST:#8ӨCMO>ٜŽ &(4@Cq*t4%tkN\A*-h2^v+0!:[U̿Jt ];6@02?*}8VN{5ń1 4ƑX!6ncًpYE y^Sm>PWWxlw9lR/L N\ mgF0}5ڣA5[Xhχ -b[f&/E᪕pq%j)AwhWlR=/:ji9悡]4Ə]cktOuJ{02!@"^b }8]^S`f1a. \NOŏ+܅Jk?O&&+n"5%;[,U`Bb5Hłj W UC֟Y_U38wJ5!jfpʛ7Q.©;> [ӗ+ )qvk6_tunl qST$p³KbV*W<bxvQ֓ѷfd-߅-OEU"|3$&vl50I<kY3-` *KfB4h(;;SH sqDkGХ^zqR(yF(f_R,rIZ:ݟt}ؖnfꮢRR^#ƃְB\,5y콏:{ĉ-JkǑhaATsQd`֩Yz)? UKc1f<{LzPv#[)>;7F$1=%X _:}7,s;/Jr5[O5HonO7BUh†CJmU> stream xڝY[o~ׯ ,s3ע ;1"nYE ^.%%\B$wfr߹۲2wemgWYvVM0^~\>7/U v2װcOsf[<ǏsЉwx /ux\yÃ{ޙ|alxxhX" ?UU̎uuޙ"vތ)mWcaJ.ñ/gx덐~s4iWM^ pYLE= H|BAE '$(#MWU'VAeU"OŲ2%PՁ_[^z;W M4m>Yv`$ku^smA SYƹ?ڕ/'.q[og|u7S$w_F-7}b S@$K n$ %EyW )AI{{9 ']Pm&̈:/*O#0*iZI_+rɯ"qASae),65 KN"{ Jkta= )GǨ'p.:T^߷ވ/<.RSU%&Z||`p46:wzc0%fGlD}`)8iX&o:5,{T`h:o;V{SEy/ !vgXt4 bj?FG_3Twkح!..PV5VV.V k:VxYG ɞIBm{U VvY'ƹK!pے8&B铖t'đ[4Ezumyи e$˽]>Ճd+ɻ0E[kf;NC7nVaqVו )|^phk23Uh;qhɴ_PXtya|3!%.E? Ͽh& FnDhEyYk`Ԥ0,V 褟yoZ+*.4J_dnxXtK4,M[t2{u-[]"#b:%d%dىS$WR ݔyL2DF UU!~>MXqMnNӤv.̷&ЕYRR?T>x9RHyӢ5+P8̣^QGF}t>ZZ}؆T>H$Gi0WۍoTp%4 ֱxMA/4*2#0Յ/_Qzy[mZ=j*mQV[5gv/Aq,M0)yTgwȐ/ĘVuELXE=*jwy|v;ɗ~甐Bc!76x 'iGRNeoQF %[5L-1[4y>M!P3j/(C]͘ + h}}C?DwVϘ:t>(0ǑScܠ2_BES"[&wU;_n|1uHwiK+U9 ==_ǹ5!2 )W8e%+Ȯp_'h(Ąi-3Q3@HHg3@X,o w\ƻ~c ;E/#/H*Fj_j=襆yK_zK?bLJ7-S2%o2)*;;-i6u )'sMmᡇL{ġxP<3\ƁB2l~- 𕻮=Һ nKMb}85 j|Y:  4MZ.j[sS-D'Ue}hDmj8|3EȬF׊I"-d.`;[.G6-D3Ks>ti{gur*C>{rc~@J~s-gXdu)^qԸs1DW0kIͧ"` iwZ f endstream endobj 211 0 obj << /Length 1261 /Filter /FlateDecode >> stream x}WKo6W݋ \(mh.[EA؍l}Erd~_}3DkUZk&դTnIV䪈ad9+MgΣa_\\Dәɢvjej 7Uj ?{ {:TG=^O %ex6m=]PM\I(kXOϋvR"ukQy'Ÿ,IjX<ׂbl غn ,~C '8EOm4rH< Ӣ 6Z[oYEFPMpC XTI g%!klco'{jZF~;xpl^Ne- $$ c n5әF}g_YEb\GmFi+1FH[d'".xNtbE 3lJ` CB̧7ҰpsY*HAʡ>w5~v-Omu 3J=z%a{/muζ$p!AP 17oߏQ&NU:'eQAan-Qj (irX@u.qirgk;@Pk&~g9>ijC];'(O /Ӂzr>y243+1WpUpxE!RT;eP)_\-*-9>߂)6o Q䶜ޣ.PP1Y1LJ?0 q{r-L\=Ct^7g׬KVܹ[5w z W%C|SӠMG8򴕋]aa@|2@o,)*t§Y_W )~ endstream endobj 217 0 obj << /Length 1563 /Filter /FlateDecode >> stream xڭWYoF~#Arn MU K-:"q_ߙ^5AQ枕D*-VㅰIѐ4Ѷ/njw3I3<R4e&դnu'Tfkn{Ns4|5͍*p ~x1GnOk@9U6;ՎӸkq]nk囪A mQ2BPU U4BB7'/Yy_E'mY6WVPإ纩+T|1Uuv?-lN0QA@8-ZӁ׎G6n"ZUٻ5_%`oycY.:wK2(D֢,KԥtoF Ξ"%ZgTݑx){0O(K96hu@HǎĎ-%-Ezj 8 H P/GRNe)taI4-CmYB_ lI?g.. Js]$ґP7cxo#(j-3g ?>dAU)8Qv ;7r ih;$bq%!I4c 7A}Q mt9iYx6њz`ƺ!2ڻ8 ѡ?݃82˜x1P6A& ,{1w|ߡ\/܀+R׮Ma٤w2YGIa< oSy.>? ]N)2P:l\6Kss!m9cbBcF ܲDЛV+dx]m Ql% j􋤎+' L9'FMZ *@h(*i%EE<+?LliZreL6RjM-{ &$襉jMtt)hx ɼs5vhn]2xQe38F>1q0ͺ̍)8?Q[7>5a5juTr+Z !ρtX֑}FU05'q丱vXoS=XTqk\wn|BsFin 4|+=W5-U3xh Խ ?[ az]KZMR J}B ΍_D*4Z2Ua] 8G:KSSmҞPKS6˰4"U$g8?TMn 2Uq'Z=7Si'ٺI>fQpb$7QK% AyO+q$GaPA. z{ҢRFqkSɽ@d%QQt:)<΅"+@*^޿Áy KR{"<1;zD>Q-W }'oo%!9ryȗPgǮ|/Ym*Z 7sa 粟RPP&sh yg#u endstream endobj 214 0 obj << /Type /XObject /Subtype /Image /Width 428 /Height 389 /BitsPerComponent 16 /ColorSpace /DeviceRGB /Length 13346 /Filter/FlateDecode /DecodeParms<> >> stream xo}܇nӇVmښ)@@]zLH#4g'IWHD3d"CbDmNР4č6hT>Bq/Gu B]$))iϻ3{fvw:x ĉ=:|[U|%T* w¦^:SBz{?ZapaٵK*6O&+o§o_5W]+񘊂0xasonֳbr֥'>M|+!ݞmaIs[U_[U*|NEwE w|*@sAۧh~b(lqAX {W*>INg57r|jYΪȪ ^lx`Jk.@#t}t$*MY~v}|N{o[囗zw<%Z[-;Y{=!|мdZe/^GGD% 7om,׃hcōrbA8)JpL]VGeZO˗>]V;GѠ=HVꭎ=[p~w$(/K=;÷f/10g%Dq$teNaaO.I/h0SͽW^XQ"/)̯5I#  毅s-e߲i[ocǢG6= jo5_z9ۤ*4>/:}ƫRk'>rZ:zbhcX`)Cs7/Y~♵ZkOEYڡs9w֕+sYFhw}3Jו RT:wD/߉?W[lzV(r#ѓr'2/˼+Mڽ3Z]gwIi|I˒ X TwpCuzq՗Ve|UE=L떯ɶվk7_WHzP~òqe-\~3/-F%"Fv޳ ; Еҟo>nk=y| t3K3g|jnӘK̺R‘YVneom4*|b[2oR_[!m,K ÎHݨ~hӴdϟ2`gRw'UVjwL_Ud䙽eo-DGwhK={Vf<2#%'hWuI?y[?:,oW}|q]E{Ⱦoxzm}K^ a'#6nXZ|+zՙ돬33җ{[un:I^~*zo:""RH MKUTQऊbYYA^n޾q׷n^?"Q?>HqDYmMJG~t4CmiGgtڵEC>it$oY|Mz]j>#_RG:K+3+__QۧUOmK$/D[{swP/*X {z*N2"+3%ߩw]g%z߇%:}<[ڋ>YZϾyeʌ+ٹ@~O.IOo]?:|<*5SkΗ4&u.5KK7Ԟyrt< \=>#鍲 Dd[8[\U+򮲆m5|/v~EhsZE"rgerڹ?٩;Y }GuEHg/d8ݪÛ:FP{3$jH۬pӛLwzlFvG:Gѡ>IHm;-YLpߟn׺\}co,۪ՂS<(/X+lE|KV [(ש}P+1cO5}!y@-QY:S{S5e\>윙^/.N9\.IO\f_\G:ґ7Gtq;Hf$ٶƇ]xWW.MwGr1v-M:eYE=t^l;"wʬ̚]+k,"y 9ru>eq_+=Y؋cT97#_G$m]S7o_,R𹶵dtV8h25 S܎#'K)Iss7ghxiVշnz<BeYCҭg| ^0PwJfzDDDff,_73qqޡ؉:/v w~q6?&>y"K)>ٯz^OK]Viڋo(]Nw%fUְâ#_rZ%^'\EʾNݞܵ{=.⑕ȊSz!Sp0[O+ۭW:>öڧ}n۷BQ3=[/2r8cv%!ϣ>enIOǽRz |mOl\xuO>:Sүk^z\rC[w^DrD)÷<4|voGz"" $@dE5|!}yx{a4P}5:zg;ECz[0  <{XbmP_DKL}l=ߓgW0`>ͩ,M+koq[_v<2lUqH0 aIxϳZ#iOzWA4hVg~yު-qk5{ף-m$K{} yBkstP7=$w롭7*^gevkwP5)yoO-m+"KLZ}A ZZ#ec%4lIW]OtV"[__&d3I#}S ?[3V{_6Uzo@ᄄs(ozv}/zL'{ts&&3!}˘9dl$͊Ȭ3cҫ,3R̲峧FY l-^4ӟ?u'~|[ z憍ej4tOd;^zMѥOvǫi.vgGkoipV?\ڱn},[Vo.t}"rG~eѪc(:M{Ɨ˱A\^4eЪ`@&{E+C-3٣f.IWd{:0d3euLiOI#` avPRu?+ sLZA&I[@(N>Q̶A{$f@<RE%ݗLL/ mVB:n~!ebJz`N=TC@&]^Y6^G'՞4 @C4 @C4 @C46Ȥ!VIC@2u9k,>Z@kh4{Y˙A#tꝊYtm哧)]K& n@@bvиֺzm]QΞX[ƕ@14 1Wdd6^X# v@04 `DVgyPVe4JQ Gh4;P/(ϵ֮O=mY X!5oyuۧU$"/@h(U2yMgV-PQp=&tIy@1cc6gDp Totaab*An ԝ9L;p>Zap] E P E P5S SJV\׿fw̚ܬ@9Zeˍ+^9b&&bJ٢Gٿ׺JSƧbu*  ٞ\ֿ>9ҧ/{VPk]Vsɓ3 51^O u/mЖ @O+7kO=u< A h>+d~ z*~#pVIzj\we%PluYV̕'OAV[:_+45omVm`4M`>pjʲa/&=*& "lW0AU W ,}! }gD)kMse3*uV|/ o͘X=UvrVL ԛyoM]{v&1w5ߕ&upwֿ ^ݵ׮{+X1W0_$ _v6iY/e:kfYd>_/pKzW_אnhqjsW"Ŕ}Le r7b~TqUO4i7L Vd5dG{\ /Xߪ/~OtӔ/p^=z?|duS&F|)!OM\랿#sÎIA1W0M]VG\ CN=GxE"(}׷)5^IJS4)o_lAy@RMx ʃU [Y]c[4K veM^]Nv`ZWRh}?)9HVe GUd J*ہfۄ{]3x?ϟ'/)*aa\A׻7 |zӤYkoO6P*ڜ}`S̙!ӈէ=zLkҵR8Ml} TE[z.ǡ&O3eP|IJ Ur TWCîIƹVf+})9?V4yȥGu_`&a9߿>'{K/}YYLC|@J=}iiiK;-=W8Is110@;3Jp,2: @C4T#Asa>q+cshy;r4{\pvwGP\3AxiKqZCa>ic?9 =/H1r Okehu^ø @xNX>q9^>IjAg@44 @#hsZEAF}Ah.!hA4&ieh`e(sO_ An "ʽ5Oxh84_q-ﳉ__bR%io*X'><*&>?({]MIx\}6$g]xmXo'/t&<\o枰laK04Yi7!fE@=L`aԕkzR=>χP?k8'+yr3})uzvcU8n>/+~+D@>43~]䐦Kk׽i_;WM;YSW>ub\A{xwz_Sͪ&EOV)-%ͳE-U" E P E P E P:_spfK :_p,"|8AFPh"kZ'/ e9,zI.K\ᚽ<~[>4 &\(he \^k@r|j8>K6~ A$@R#P E P.A蓒@1 Z;T_2>kbWni^F3rZ5O[Zoeow'iZ4h[ CC:C1s9iJ+Mm$~|vLPW*ڜ2ΥG5f;țG׺<[mWvi7>$VP,% I {<‘l"{)5u~G&=ԬˆӗYI@ z}L~Ak0\G'7,>1r>4<\]߻kSםIKEs H*ǡOLZx&*MӤLU~)=v GGoyN1ו{k.':J}m8̛ܼ˙k2\X?X8 vFWi(\~~h\3'yS r!>%C 5@0į_:m:~%Gל0hXpEESÖ?5z<^Iky2?g;My;|zkCRsz9ɘe=dy"/f;ˋΧ& P2Iͪ :g:H \P=5_k\Gܻ"LʥGRLTlҜ w>_vI;/ǡ(>)5^IJKҔٶ$GI@sba͑K ?]a(C_ i\sħww}HDҕ{k./hh8G; C^1=JW0)/01)A׃>K*1}а,Im|GP`= E P E P E P9qSə˓V5qũ.)3|d?cC, >=%^I{hz=>}ff   ME*24B[ Bs*i݁1?5liN߫ \9hV("2o.1L𹶊'}|jPu#P E P::\p<AZ1A>"WJAWT. s4TMAw rw1!B7WJW>ϫ 4k\A3'y؁ts0 8\|fvobs ! @ zX$~ 8a_BL\z]a|2aa_Ҳ" E P E P E PSr@3hsZE !| ܷAW/+Psth&}uts.}_]yis kf&d`<=,?<ްOHF]VGG qɥGu_`\G?LDRN`hy|00@C4 @C4 @C4TAA*֟oou5D|#sR*Գ/!`K h8gso>rp*}XyטjP-kX3ã4Raou=m{}\@#/0M|k˳G2ԍA$]W / Ų&i Z̋ȼ3LX A s 4 @C4ThuY {B.ħ|~.ҋnVkm{0oO%W .U)̱GK stm_=EODb g#h:9y/+tWzN>0YY$> rʯ-`s k=fOAO ̙x=g;Y.=v`ՠN>Wٖ5^34 iCCl+ku1|j+J\^E|zx9@_;gO AAaMviWU-s d+Z9%8u0ۜeZ.u&P"_XW{U]OggiTW`(.mڧN?s`~+R+{SyK/M(3`1j)l԰%y@_Ҵ ( K=Shoƕn@/r%Ao0I]Jx=vfGP _jz/@uM V@0>죏.TW`GK&8@p˱Go9P]j W+S<TWW0uY F^=YB bQ,8\Q#akfAF_ *,Ex@אJ+l's'L @սd#=ٹ9$7kW0iT*|7&qK^&u=)W0~{[JkۿΩW_ _X7X7gusjusuhszibF\Z~28V[}`{MW|޴αnαn몠G@@jpuٳgρܹsg"E/ n8qG\WE}SWq˙huY}r`*kQO =+7>)4z Giǂ+*DQ+l[;| A{ ϯSS>vs9wv'ϘnfYvM\kpu)'ɫfze!>`~7ER#X0ے[p&k|?%C9ƿ {Jnf=muz;r,Ͳr&i?GD Rׁ+@mr3s&~2MctvoǻO@:3ӹ=dfh/w Qŧ4C:]i[e{ @H0&$*O8& 3aS,Shk>)m+uzHz}3\I=h0}?-ͅ<5{]uO<`ĵ2;g̹z?):\9ohh\9;g{v%a'e檳h0r ͼz6x-x2:2GD;*?Z(^1ISpOb?W/1fݯfvħiZz<*$B`xxjMZ!Kesϟ+&""g*{5arPD"ҒkzW)횈̙e=s_>mbeþ&7|y#,чmilӻ~q-l}dX{UCj|O5,Fv`vsfgmP# g07z3glኡ dA"hmNJ Aout#x~ܓ9Mg58@V*#xiW8V{7(="u;8HcHrt <~*k^Z:4OZapʼ̛y _KK; =vpO0X}< =. t! ;Tӣ@&cK SJjϞ={|?;wlx- #"Af,qmk/7"P[:8 z+mA C+^4=sfx@@lٽz 7`vǀ/!!z4 14 iG@I8k4),z@15 C^N P E P>ί{:F _xL;@#`hc"#2;GkTn hq h+ y7Vh ސah/uheut1]z?>3_YF.Ȕ过 4{4D> endstream endobj 221 0 obj << /Length 2161 /Filter /FlateDecode >> stream xڭYo}' XrǐE[ [ /h@KF2Q^Ι!Eo 29ǻw>~a [1nQ|oZfejm+W/?ֹ/'xZx3ۇ.[Xk$b휱gw{Z2=^qQ7+eg.  ~/|Jp w+ku׋PpϘy!u|ASP,毫$f1(>((*y U`tZW\24#M*0t('@9f d¶Ya S[!2jόGA0ErxL˓""a #G9{9 Ğ_UDPA@"Sf ∶]\7#󑎈HI/'Rӯn) 䣀Ty ,k?@ xW KNdֹX@eQH֩qeijY] *f3aOo]Wq`C4> v  01!AWkzOZ R[`xa]xԒd_(4NU TD?V5S^DCwB/Xԑa;ɖWz=qZ8rCCx=SԄqj&jm" !5I\w1_qqɽzXHIZo ( )D-Đ eKggĀGЎ'\E;}n$AvzTkqkƏ6[MiTIf}Zq)#y |$NE`^@ﵪoU7x3 9/>sAϸ^x|;xh=Cn ՚39p2o6$KD.ƈ16oM`wXH-\M!AX(U{Ǹ Q;CTҖu(m< YQLܚ,&4,T]>5ΨjL괬{SL]XA.mVd֚9] m~͘E3AZ3LK%c'uQ$SNBfL.VЙAa>L tKO:)f b=f-eA~6FARQlq&kof$3DGCh̢D 8k|N-0t@܌ BnL|*xҢi%\OڞJ;wCc)ES;)R8_XN> stream xڵXK6WE \( -4B%f;3(:$pf8̓~s}OX֚$օJ3;Ɋ\Oѧ8?lD9 VGxS㨛2 |o+x0qL3=f[wnᩦ7~}tRefreG"[ zh=8|6hI̲$ָv iZI)7tYu{Gx±!n+VxFpE kK!jen]ὛALF&{) g%Q}0ZЧd ̏߫~^R"˯Layi:3d0)~|5Y2~d#!xA1ZVbcu( 띤"l]i"?HhE%nflV7ȭndӁ@ e!:5qw4A} PRSHW*9fB $)>~|(F| |6Q}Ճ2P=˩f=⾀Q{pEChSB?=EΡ7{TX_~˯+Rz5L/EgG`^_?HHHER2VdM_W(eunC[eLŞ6iI8>s٢۾QsnG32rV+(/($HR;8s zԧq( y5Ғ@S|t}6˂T%m͚5+iB )V|lRcP:+c-o] fbe\H=ȆQN8٠ePR;eʤKM<}lKu5R%թd/L._&*.aanZ}?9]#\R#LSU$C R^ A#\@ʚX6P|Dݘ(k(HB ϑ:klsm]h iQw[J۞*)eB>wKP4K1le;˰6KWa0zR*}YI3qC.$R o<Rvv<ˊ&O:27m=n-|@&:'!XI*-#7ȇl"&^2ұv"K-,iҪ+nqxHryڛIa sMت$nݞ@p8փzjOt}8-TKOpBhnZDkݐF Wuri8q:{CU 9ʳkšK1EpIZq*ss7h,`giyF:FKX0KKI+pŻiJ6 endstream endobj 239 0 obj << /Length 1262 /Filter /FlateDecode >> stream xڭWYoF~ׯ ^<@AH~hP2]Qε%ӎ[ZGHW*#_8_"ˉ?X˹Je7Y&zN~?-S֝L'ZUޛhziB:<ε8sxY5Ijͫ$uo6<_DF ΅]MdzĔ=2  v rܾ=d$~*V(ԡ–9KٵF@T+1(u^yz$ڸ'P^Qei;[Y/X4)ɺl~Fw(ћ;-}x.$R G0ٚVtN,b,Nz_޶kp%BdAeuFN& J-B̰"~,O)_QQ}7Jb pAER啃fuʹ7ܮ$W1g*6m6[AdLzm>f\|(zm{7;A_~|8 ch6-ʭ50U 4eџHi#,S^.%\ y,@h0rX62qA;}Vd.NrךW,ʢa?d_'FGc|]pхqy.5)oԘ ˳R0xn3Z1@ل .3EQ__hj{܄`7hl 7PH 9r1ϝڝ3Q>ص!v R&3ÝM5>zUTf{dMA oCp)՜SFis>O8 wvXLnExξn@ptw0 T;uQ4زe= `O0Wgg?6BqA9E^NE"O҂"&5b _/ Bfz>)SNPr]T TfvgaW?օ@u/;f;׉W94ۅ7|>:_re@)[Z z@ < $$+5G+>:BgYy&K!PoѮ׈/1'x~tX -\ [1=WkA8끋!ZԠc'>U`ԕTb8kYqL!{l. +5*˒Ppr4o endstream endobj 230 0 obj << /Type /XObject /Subtype /Image /Width 1871 /Height 1054 /BitsPerComponent 8 /ColorSpace /DeviceRGB /SMask 241 0 R /Length 26992 /Filter /FlateDecode >> stream xݯga;GE ,Y\ە9BZ 2zXN !KŅ4bE6!nDM DAv=̜gygH39w^ޝwqx߷k ؋ [ڥO~Yu[޿}Y 0sh{ŗg%\gR"V co3`s%̅/ڞ'.b/b KW5nKﴃg`A޽xos{歔ܗn @{[we2uw ]k׷^|]ط߹u/l2~]ا.=`Mڮcky{} F˰w׽V{{^WW{^{^W@{^W@{^^W{@{^W{^W{^{^WW{^xc[!f=Y?VH^aw{.Pdu{^uH{;b++bw{^W@{^3b+9{G!lf+.˅݋\bwoYE|;z0 ?r-TϬRBuM#@cf~2Ϊl3> 5©gWXpLg5tz O,;g<2?Dcf9u W<,=h}b+b+b+b/+b/+b+b+b+?OY?͆n닽:yt3;x߁o抽/ܺ3۽g/^g|83U{1j3i]8=|(Xؘxݹ?jɺvXWfU]U8 lyʪ#+b+b+b b b+b+b b+&n 0FK0F.|h®7Onż`[E3 ?ɘYus뎽7N܂#bqJۘ _󑮗|Fu&w}] _=:5b޺/kw6VXWMU!c8\'d< b+6f%]w[=K7tS#[$ƓU>o\0q80> 8y[a]MeތŽSߒb+b+b+b/+b/+b+b+b+b/ b+b+b+Kτ2ĝ׈RҬGTW'ػػT8C_o(}V('b/+b+b+b+b+b+b+b+b+b+b [{u+_}Yb|bS/3m5unG>2~%ތP/^ yR'NXh& ^XW{^W{^@{^@{^@{^@{^W{^W{^^W{^{^W@{^W@{^^w|PhYow}dO>~h]&]׾ e{oҺ6ІK8f|dػ`Mԥgֽa}Kֽ b+ mcG+w.?r{5iVs_u/z]د޷߹re`1!W{C K'{wEݮ_v[{?z0b/ b/b/b/+b   b/ b/b/b/+b   b/@M>CGMXQlh) '7+=*+l~pV[tH\W1*2ܐ20zv ن"#.3zՄacV8 ][poz*4z]*lslȐk2ȭ6^ O:ksQh\ߪk N{ boz g5%Bwc+Y,`GG|1Fn /E"/ B*V]ǿ^W{^W{^W{^@{^W{^W{^W{^@{c^kco{҆hw7O}'툷t&έH.uíc<C#Ç=`YGqy0 wa5C'qU~g bo Ȍ/p[h0ߪY3{w\ ?UΪk<1ć3nBO&nħ߳,7&>8I r;βCs *:G-t  1 պN,P(Vx͐k툏 b/ 6ޮ{i>F>GxY;tVuboV.d߅N>9Mj# P!?2$n : !7柢 UNW.\h%BɱΪAF^{^W{^W{^W{^@{^W{^W{^W{^ o$|[F.[ m7żgUqVZ!jwBibP;{Gܹh0_udU䫒3ΪБ!kZ 8CT7f#^:W.\j8B[\a N{p ܈_ b/ b/ b/ b/ b/   b/ b/b/b/+b/ b   b/ b/b/b/+b   b/ b/b/b/+b  r=}Cdɣ=nfC[! ēہԜ, ogč]OVyY5{m8b/,Z b؋+b/ GepkWu{^Wb/ nr- b4!bo=fcU 7^`}w[b1.Seyj bO`zs/Ci{{^@{R^W{A{^@Eub+:Mb+"b/ b/b4a b؋+6nm?-ܝ*B\gWu^WE{^@^b.^앿{vp;S{^^W{AE\#^i+ ^ؽn:1){kZ0nU6t'OYW~1:f #qV%DX׬6ZlG΅ -Xg0Ĭ[-f`H\GSf[h:2Wy癩]ߪg+ 1xrɝ^l7\ q; 7n&2^&YWRQ+xЕ {N3P41 q0T)2pvV'OyA[iĬ"7tƿ\hzH܅;Eƭ6tӄ'8b%jGsG ۵G-y9s#| >bw zĩ!f@#CqUA˳l`쉽2^O{D]`(ɡZt+t1H5C=}&w|d(4*\_SXʺ]5+b+b+b+b+b+b+b+b+b#b+bo7:/߈yrcoKbކ4%[lU7qX!܅c3⅟#tmw4d0;2等_Ӛ򞴍kpV ߲Ug1ֵFo ]@Vxg|2"_Ƙq3Dqr0NFckV=c,S睽󿀬YUpd/}yB-t'ƏF Z{Gq:2:eWu ˔3>_ ĿCLu5b\1C4_j<$\xg+UϿYiƒMY? ǫ*t +M0 A` b+b+b+b+b+b+b+b+b++b+b"bc7_%3?7_uv^~3AĉGvG]qmR;^?f{slqIv~Wh0t2OWޮ!gΜ=;+=wŧ IG-=ˏޞػ z+brb[DqY֑Ankw^`Z]C߫Bܑ2iV[\0FwC-8"skco -ud(t_ao۳)vJDbvX  ˍ B ?Md(Jj][plW"O{3 WzboQ-iȿIkB[kyqTA:P92$>1^dxd|畸 yʃЪ,wd[ad܂u* z3fϯ_ib&jh`XtxXn͸;OPq95z(Wh\e f{^W{^W{^W{^W{^W{^W{^W{^W{^W{^W{^W-$|F{x]d;O6f5-[\ ^m?ZlYmn&{D bXYM{dH|EψurdH|O8. [`{RzCU=-X0tٝ7;展@-~] }`_0[}XV-t7Qh/sO9fw0w4Qe(1bN=!c+42_32<^{{@{/8O9{J@{߇4b/b/b/b/  b/b/b/+b/ b   b/ b/b/b/+b   b/ b/b/b/+b   b/k}b b/b/s'ĕk.{{^{{^{{^^Z=?C@X;/C@{A@{A~/>[KtΫw^~^^9~73L&dZ !d2L&Id2L&Ico^ |̇؋+G>/`k5CcOМT^^@{@{A@^{??ԳnormK|K읭{^^@{\۷X~6n/wV«W{^{^{{@E^^^f{r7^^^@{@{A@W{A@W@W{{^^{^{{@{^{{@E^WE{{@{A@W{A@^^{^W@WW@{^{{@E^WE{{@{C^^W{A@^ /8pM+A1ӎnݵB#gb b b/0Oyf&hw0b\[m؛q ȡߕmi*P`8*%RĈq3kڝ+{'rK ^{aVPK|)qV{0\`L\h0؅3>a#C]xa3#>ϸFu1v-` sb@]D.U^W{^W{^^WE{{^W{^W{^^WEuޘ:F1|_+#o-63rKw.TRno\n 3{|bo:ۍw$l57oxd{C.=`K@{^^XnM):#W 6f\WˊCt>\gV1òV{}ޙ+W{{A{^W{^WW^W{^W{^^WrNx9;ytsx1DcGGg{0[bػz4?&sgΞk ^ |$]b+ 5O^^]j4a^W]}1b co3r(b+ b+b+b/b+"b+b+b/b+"+b+b+b b/)Χe<#WXW1H{7㵺+VvBw.tY+ +b+b/b+"b+b+b/b+"+b+b+ ؛X'Z[ z4:4:Vߤ`g~}Z[ }̻[`xx@N|v[0UT[>f<#Ո-;[P^W{^W{^^W^W{^W{^^WE{Y4H"CG6bzL̗#,`bq0t]j) g53%]`w#y\ <_R읭EE{^^^^{{A@W@^+W{^{^{{@{^{{@EE{{@{^^^^^{^^^{{A@W{{^^{^{{@{^{{@E^WE{{@{A@{{^^^{{A@W{{^^{^W@{^{{@E^^^2z:jj~&ᜭx|n{^B9|k{{AWE{^WWE{^{W{^W^WlyÛxMl(!4b92G^^^@E{^W{^WE@E{^W{W{A@{^WE{^-;;Ǜ^ 6%海]bػ񧴚c b b/7ԓ mh{Y3b/ " _b؋؋ ""b/b؋+b+"ػ>зn6.^<m7ߪUǻt}P pzmZhVh?yt +lpV];N{-s9F-w mpINuboc#K{^^*ލ硲 Ïo,l̷UUj{7fTh]Sd<[07Yu8N-Gֱ ΅NubocU^WW{^W{^@EE{^W{^W{^@{^^`n z'5Ōq`"ÏO=oM8 km3l{4[oǭclc,؅ޡv0X9.k g&>0񔇄7>^Qз*aoДUzz0c -{SFػ-X0;Kb/b+b+b+ b+b+b+"bo|uA?v]ĉGڟ _Fm͟:y:ԬϮ&M;;|97okV鑣}[P{W{{^PM =0[e,{Ujjkco [P{W{{^W{^W{^{^{{^W{^W^WW{^W{^@{^{*ܥwco]b;~ģ[-21 b/b+b+b+ b+b+b+"b+b+b/  .+V'/h{g{ޢGe£hE b/b+b++ b+b++b/+b+b b/Լ}2%\ؽ|'Oǒ+N{as?Xg~ʵomyL&d297koHE@5L&d{A@5L&d{A@5L&d{{^c_y9phNd*b/b  ؋ b/b/b/ckVblW/b/b  ؋ b/b/b/b/0)䥻߻rm%"P.ZyG{@{A@W{A@^^{^W@W^W^^{{@{^^^^^W{A@^^{^W@W쵆b/b+ b/b/M8a~Y{r  b/b/+b/b b/+"b b/+"b/@9{g-$fڅťKT٪d*I mWr[+cb+"]hY3G~هj+bK̛jb؋ +"b + b؋ b/bʞ0_jvx&>,yŔdo%^^^iY5&e|1{vE{{^{{A{{^W^@E@읒I8K΍*uͭݬW):*zPV*GKax*{Vk9&x\{*=y0dMCk5=X%V\+!{^^ޢ5rZp]*E=UYژ9f*=Xq1㪝؛U%N21Se=Z ~VZ@W{A@{^W{^^W{^W{^W{{^ǎ=SU))>k9{O>}aq)UN;7w"ܪiW׷NUaS"^"M d YO=^hO=“|1X*΍ޘ覯#㘩§UֲfboGLJ >d 0Ŝ©JlUĴąU.,qpU*qtòCCͪ*q\U\boUTkU"^A@Db/b+b b/b+b+b+"b+b+b b/boJtnת [n{+5co;{P{^W{^W{^W{^{{^W{^ws@{^{{^W{^@{^{{#GgbC{ @{^{^W{^W{^WE{^W{^W{^WE@{^W{^@{AJ):yt|OoYX\J}rO>FKQ Pj W{^/7;NCk^{^W{^W{^WE{^W{^W{^WE@m'ͭUʺaT K.Z&boco[;@{^^@{mj(bۋ{@{^{^W{^W{^WE{^W{^W{^^F.2TT%=؛|y# 5c` w0{P{ks؋+}Y[5J\Zq~ޜKFTgvsS匆B{0" b+b b/b b+b b/b 0AgΞK>bhdt%:U'KXTYKݝ=eu}EH$SÑJU`8Ul(V<b-rNջ=Xt P3;=? 0A ^ G {{^^^W{{{^@{^{{{^^{{iLư8+  Jb/؋ b/b/b/؋؋+ "b؋ [%+  ؋؋+ +@{@{A@W{A@W@W{{^^{^{{@{^{{@EE{{@{^^^^^{^^^{{A@W{{^^{^{{-bo~k4dW^^ډY^i؋+b/b/ b/ ""{]- RdZ^{{@EE{{@EE{{@{A`JbaaF؋ +a! ka! ka!"{OI}o/" <{{{^{{^{h-^~3g~^{c "{{ o 4^ab/b/ b/b/ b/b/@9K/\Zʿ G׮w?xb/b/ b/b/ b/.~w}?齵wGE`c޺aaF?ǧ_|ސ؋ ka! ka! ka!"TW^Z97͉L؋+b/b/ " b/b/b @ŕ˯öÑY6Sb/b ֶ,iO ?b/++ b/b/0{k4?+"\쵀͹kY^^^@{@{A@W{A@W@W{{^^{^{{@{^{{@E^WE{{@{A@W{A@^^{^W@WW@{^{{@E^WE{{@{!b/b +  ؋ b/@~ّbo؛g@{^^ q#[=D@{^^@*{@{A{^W{AvM>9{"v'.l57wB@Ea[^٘0~YkT؝؛%y  b=؋؋+ T(+r=a%kH/=? b+"t6Z{@EE{{^WE^^^ZMfN]ݹqDŽOzvͭ'3Up岾_`r:Fn5N{hNU1{-Gѩ­ك W%S5t`xfh " [E8mLKܒfy&cp岾_`r:fDZSU4(z0S[{:*v:0j<3v{{A@{^W{^W@{^W{^W{{@=Y=%nWsaq)aGލcc=9{gΞkcҬ8E=X6ݏ53Cqc ^ڃ% +q?oux^p썼{]$\%ʵZ8m.`|Y@%.~qIJUg8bojI^{@{^W{^WW{^W{^WE{{^W{^@{^^h?6߳GC-;޾S;;ٷ b b/b+b/+  b+b/+b/b+b+b؋ [UV׷ӧ'_O#ɟyذcox=.bobo77Vdݻ>Z @7x4O{'{aFCV)݃T5^] N*ߊ[ b/b+b/+  b+b/+b/{ckG7}kjcص{^wwsk74 b/b [W*qy co7+ڃb+"+b++ +b+b b/{,du}{1<%r]X\J_:rkOI>vګ;7}>Ӟ9{Tb[r0}āuZk'[Ub/ 7Vяjb/P(9ţ9ZZRXQŠӶpq8UŃA{mboᷧsW@{^W{^W{{@{^W{^@{^{ v-"cܦ59[xvxF]%C[qKUț54mR8UŃV݃5 ,UUfF䙡e{wob/#&{{{KE{@@{^^@E{{W{A^^^{A3é{^^{AE{{A^^W^^W{{֮AeH[>@{^{{@E^^^^WE@{{^^^{{A@W@W{{{^^W^^{{@EE{{@{^^^W{A@^^{{{^^{^W@{/ YW@vboַW%"b b b/b/b b/b/b/kof` {V^^{{{^^{{{^^{^{{ϓ{o?>L؋+G^0 0~ W5 0 C0 0 CNAS@}ߋ#u``^^^^^^Z׮L=~^{    b/-Rݟ?^^^W{{{^@@@{^@{^^^W{{{^@쵞b/b/+b/ b   b/ b/b/b/+b   b/ b/b/b/+оӻ=;w&x=˧ ^y>4 c @޻oFOAb/babkb/ !! MO QcoUv t +0=踏>7*O@{{W^{{@w#{&?,={$^^KkϏ\yuG"ڴ0ZOc_] -oz?{{^?PVвτ{?ܮ]Z:b/b b b/ b/  b/b/  b/b/b/b ++ b/kW b/ b/ b/b b b/ b b/ b/  b/b/b/b ++ b/+ b/  b b +  b/  b/ b/ R # KD{va^W@Vtg b;sΰPb + Z+W{{@^{{du}{ye6v{/0bEp$-\X\JcMm O< eJ:{j.{{#fVӉb/b+b+b/ "b+b/ ZxΓNg mx3gωb Yw"b/ NR~+[+/&b + b+b=( b+"b=( b+bT(ڃb/ v9,ld==GNUƜd{sT΢b b/-睬BBNuhb;[@W@{@{^W{^^W{^W{@W{{^W{@¶!fB{hFIG{|;*1L5*f՘e/qjg^{@{^^W{^{@{^W{^W@{{^W{^W{@{{9du}{yeci@=3ώ9{Tͭ1WwnUtk&/W"ڪ,0bo_Αk稆{@w.$Z^{{^{^^^{^^^^^{@-";Tz^{@wW旿#  b b/  b؋+b/b +cye,b/  b/b/  + b b/  b/ b/ + b b/ b/  b/b/  b/b/ W@^^{@^@^{^@^{^{^^{^{@{^l^4Gv%o + fKkY?6-W?xhAwb/b b b/ b/  6S} bod콵w'={f b/L6rv  b/ + ~'+nu0wgvt +0=0~^0z7| @{{ {^{@0 0 ^{z;<~]Sb   b/ b/b/b/+b   Ec?@{t*&E{^ދ瞿8r埮%3 |}pwO;?Gӳ9r2.~J$ގͷo'޷8 "b/b/ "+"؋ [FbK endstream endobj 241 0 obj << /Type /XObject /Subtype /Image /Width 1871 /Height 1054 /BitsPerComponent 8 /ColorSpace /DeviceGray /Length 1934 /Filter /FlateDecode >> stream x1 g Ae endstream endobj 248 0 obj << /Length 1541 /Filter /FlateDecode >> stream xڕXKo6W,z"HmMHzhzw׎q_y񡵶ikQqߌURhV׫)iW+af#VY:׵nrN&'@navUw\&{âsh*lmd>u]w^UV-ڊ܆_=u^Y>g?;beQ7lS,\j+S0n6W!t] kd Lz.Lo9Tu >ecf[7@Tq1tQM]1YwqfCm'ss@ T+66t--܆S°\~3y&׎q6@+xz(a i/ bJ$d@d--lxM3Ɠ^> 6}0A)A;#X@0,#ayMr.0dzE?GLIi5 '>':αCNC'" }"{\2chB9d! A|=T[M+bC1S". Lj#͢S:~G}|P8r 'ɄKzescR5Y8P=08\%RdEїWG̉> d|S qslQe3 b4C]9d˱dNxH*C1H}ϛe DY-,;!kwZ#IɏTB(00y8#~&d#, To J~雎O7Z(^fffɨo;Bt>e=m -KqesٺjuzYG+l9Ӹ1sȔҺEJ@lbfFeWQxZMA+[ޮR_߽'U;9ET~hi!\q?lyޟm >[ힲaG!hLt1z=-Ov}W}`l)TmouI>/( è[eˡu|0pfb |3߅VL k18A`L8dfh )|2|$25u_p4P]H'p\8O%r.M+ H%?{uz@| endstream endobj 257 0 obj << /Length 2123 /Filter /FlateDecode >> stream xڭY[o6~dHeM ۲m[Nڱai_s#E9t { ṟЯ_|ye ]F;{q\TM]4\\/.~,ڸΎ<[f>ٛ-|:;mχ;oy\vϿۭqV~_^uu:g1u0U\]> f@^酾͙Md3SJ( _»#p,Xι([ oy!9:XWئyHK䀈,A ق'CT>`nڦp$eÄΔU$]$OHd^^{N[rCV"  ,̺OhۯQYx(t VB<'0xpuj#W0S, w~}0#qM41|8#lNC:ozvr$_TlB> 15{ܰ=xÊ2 wǖ<IɹvWwҮ>x'Ŕl6ygcQ+[4ϏEkޜ@hiRאw[  (U`Ho О,4uHQ+]TX,ѱ'UAyC|H5pMDUѢO o֜%/ SN}S1 o8J$2LdIdAW-fy]:v~yVv6 %|kRIɁQ娠r/m=3|r|݋C}vٙ+YPdabMmNnaM2FATUڧo0s- *jwI/CWG7DᘒMt"&]'*lS0E(UPIPC[XaL3$5e@L0z>O+e9 ɊI6Eq8fFugnzp'k5IF(<2 r?IDcU2.$`H4վ@P/ 6B9^}BpD>^1BAYHl\eѪj;N SYj'Acb$W.Hs3*HqdO >ı`r I 6FvdOhLGo!TO~g'K; s`zk|h[:!wT8c<5SԦf آ2.ڋ% {6EhP*;vAi0۫)xBuTBcOu%F骨]_$[]p'=O]3UQe5yfniw'9X!W,?w]_w$~^A) >7dZ>}ہ}c~콓D1BF]_iAʜx6f$ '=S]ܧRbiai(#:K-Tǧ'St򔧴8inڊpyN-k2k8!vkOZ*.\(pQeD `7|gB>wwkqza^\ۢV'w${{)p' W-}~M$ E;߄kLJ%='~SS~n|݌=?Y_HL+Nۥ?lED&Jrme،s$-8GtQu^e!!i`ړ,PB{ |> stream xڕWnF+(lW `&QNdD"S[s@D6_mZ6ۇHV&<'ELB9`A'yLHp\:KצL3>XZoyW|^ybnMs[XFɒ _&ՈDN$859DP=jFW7 q),)_FQlzoJ,!L©Һ$N9 ryF[;6Xu%`#w!j,/CZJ%mUnH7j'9zK 1fm?I먉\1)Y y'r+xB1{퓨j$hxGC#;']Eg^udŨ5"o(71b"GÀ߀uZUVcW\-ѱ@aj3XzlDӚ8" DOǻ.'^9F[Z0>TSQQX;Vl#Ih`ŽP; :`zŽ0 Ow#flqe*X'slE$^J_N  ~괤'˅~/߄Xsq}/>ݤڱ-I\09N tI?Aֿ#$('d_|qhcU e ԇ+UP^Mp`v>U&N٫`*(*0n+9c\g3jyЁ]$Pw*^cRi+3W*XÔul>p0?fA :VpQJt r I2Wއ(y?VBL^*[1J{X`$=V/ݘ[Q]c"JCsm4V$ ZV> (nRJyT=ң(Gھ_:y06\O4a,d^M'.v4)TntFrTP!; gy.af0 "_BPvd~P!\ɨC@No.3UxEjN'<&ǿGQzFUzᵉ-_m endstream endobj 254 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/RtmpplS3LW/Rbuildc0c4bfb861c/affy/vignettes/affy-011.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 265 0 R /BBox [0 0 432 432] /Resources << /ProcSet [ /PDF /Text ] /Font << /F2 266 0 R>> /ExtGState << >>/ColorSpace << /sRGB 267 0 R >>>> /Length 402533 /Filter /FlateDecode >> stream xO^*0$F@$9"׀A~Zk-d뜧NVK{>˟~x{|Y>?_?wo???ǟ?>|{zmG?޾ǏϷ?o_ۺGY+`矯m{|w<}~|.o?>ooOן7^\x/?oz7^Ѥ?Q_x?norvYx]_ϫѽe|_1o|ˏ1o|?_ۏ1o,ϏcѤ?||/돭Ob[ݪ?{>?]޶ﯯ[n?jg|~=n7;r/~WPyp9Y~st-@k7 5}?.9N~s tuݻ@ onߝn@a tl~-{=@Ǿ>}?F?~<uc3 * _Uf~RY@G( Y|<!_*w^z?FWQ(=uv,P>?w_/<5v?rz%W|_vOg8~>v.lښ@fw.~="pc6ݻ@nhZg)|%cn9hZ>fnn[7ڄK? p[nhښO@'[.9|p'@o@n{7н t-okwH' _!;l~@|֯IB>wH' _!;~yp֯YB>wHg _!6I*v-~:mQTN 4ީ,`3Qpx u} Q 8=cK槟,yE mߗ) pN(d pH 60Xy0iB>y0iBI6%MP 4¤ ¤ ¤ &MP05¤ ;W%B@aЄpS h*At?[~V4P5a̝n ~J`VXnbǹBӷݖJЄ{奞=/քG=c|aY:^Q x+xC˧[%T p_*?/\P%hBp1UXKԄ0 UIPa|^a &MxQ恢&(s &T4A!W4Aa3P҄ &(lJ(iBI3O+LPa@I6%M0iB>y0iB>y0iBI6%MPPa|^a|^a҄ &(lJ(iBIrI*LOޟay &MP 4Aa3P҄ &( &( &T4Aa3Pq sA ]!kC:yWȚ5a3kf քMpH' YɻB X6&(dMpH' YɻB @A恂&(dMpx]TaMpd`J2:R%fWuwayv_^+l KZ/s{1<ߗzގlWoݳNCTQIfc/w:MX1|y]K6$׹B'ُ矗m眗 RZ\Ac΋>/rP%j+l t*3ucPA!C:WA!18cpHg 18Szl 18lbcp Ơ!ҏ0C:WƠa3f 6l ^!C:WƠa30B>0C6%cP FcPȧ&cPȧ&c0fd 1TA!WA!Wd @恢1TA!/2&Pd n!AU1,U@ǢN%ƀ+pR`{)}*LƠ(fd &cPȧ&cPȧ&c0fd @*LƠO+LƠO+LPa2@6%c0B>0C)3Ơ0d 1(lJPa2|J_a2|J_a2 1(lJƠ0a{%cpH )B6l 610C:WN1(dcp A!C:WN1(dcp @NhUH?EN\-*Q)|H*A)6.kp=*A)n?] >_֠ +Ž~K| +cUq39JQ'#\:A#z<^*A)>DV R|HϺuieR]t~^< .y9M9JP ܗCx+W,*E~c@H )EvѾPȢDC!h8pH Y4h8$@PȢEC!f  @, Y4 0C, Y46h8lbPȢA!C, Y46h8PȢA!C, Y46h8lbPȢh(dpH0 @A4h8lbp ĢE!B  Y4h8lbp DEEcQ4EP4h!h!h!6ha3h!h!h!X4h +(Gx. E¢N{%}WWhk!Fq⨠h}^+A4heBXWX4nun9/ +,Mr>|zn_c}`,2_ GE:5UhQkEFwx,sEcw=1Xm9UP4(a?$m^ ѼhuJ{%FE#Dor,G Y#|)^APq{qp{q {q@{q@G αGc99c9@{q {q {αG q@{qp{q 90αG q@{q {q {αG qqk\ָ2+q==Lα,09׳k\ָ2+q==Lα,09׳k\ָsq==Lα,FXzV WsڗeMk_fXӊ-fz΁at΁Utvb-xu>5r>vb:#Jvzo29Ǩx'k^'6F,sN?^W,eB :Ǹs^0LAKti$ȿ9`yα3k\S3:WTc+mar59ָ2+q#lJαƕ6(9Wk\iָ2+q=Lαƕ609Wk\iָ2+q=Lαƕ609WTc+m!WTI8KPdU)e_]䨠-/R\TɪQgW|*xc+ p/{W߰%_**jJP}c9۽Te $Utc*AU20WPUw*͛JF!h2M +$0 gƕ߾e#(dqH8F!kf @5 Yk0hC5 Yk68lbQZpD!kC5 Yk68QZpD!kC5 Yk68lbQZ,B!kB## Z0F!kf @5 Yk(dqH8F!kf q5Yk2TF!HIk*LZ(if50jBƑ (d0iMIk6%Q ¤5 Yk*LZBҚ*|]CԚ@/J k bT%i ] iM>]R6{% nR fU WVQhS%XuC;`8_^I<[-sepN-+ʌ<+SpXHN g|y~Upjctl8Y`p0Wphܽ /q g} '% ʌT O|DqIvGS²Ld9Q!$; R*LSa@Iv6%٩0ɎBgeG!CJIv*L(Ɏf$;&QȐRa )&٩0Ɏf$; @Qv*L!$; R*LSa@Iv6%٩0ɎBv TdG!C30e$; (lJSa )&QȐRa (lJ0d&qHe!AB,;Xv60ȎC,; R(dq IJeG!ˎC$;k+= 7[U{зQIރCJLJsWx\zU:yq^ ڨ²îo`R%. cAU?.9=O~-<ލ{F/U4o}Qv\Aiް9/֫J0c+N~`8 g 4nj2~Jv\!HQȲ E!ˎB@,;Xv8$Ha) Yv8lbq IJe!AB) Yv8lbq e!AB) Yv8lbq IJe!B,; RFda(ȎB@,;Xv8$HQȲ E!ˎB@,;@Ivno`Iv(dqHeG!ˎf @,;# E!ˎC,; Yv68lbQȲdGB 0}Ue!D١s W!%AQ%. ݩ²wDd>ӣt]AUU C;:u; 6#;٩ʭ\A);7j> N=󣴲sgTz٩s;Jv5L+|U \RyȎ*3 N󂉲_IvugC]ObAv*iUe> x4oJQv2U r]vTaqx}ybU䏭¯C23 N3_0dUf "l8L(dq Ć G!C"qHd G!f 6@l8 p(dqHd G!f 6y`8 p(dqHd G!f 6@l8 pP(dQȆdp恂(dq Ć G!C"l8L(dq Ć0 gyo G!Ip2T d8 (lJ (d20B& T Ga3P2z«B *=*M3X R l*aU^/ƣJpLp,2HU T7=|f=Ƃ#QOTxlJHusޑN{Lz < \k땼eΑTqG7tGhs)GGwHx*"UIv$$GRx}gU#ϫH ّ*s$Uf*|?91R$F h*LbTa#@I6%10BgH!MI*Lb(f$F&1R@Sa# 4&10f$F @Q*Lb$F h*LbTa#@I6%10B UH!3b0Ũ$F )lJbTa# 4&1R@Sa )lJb0Ĩp%1rH@!B#,FX60C,FI)d1r bňGH r}qcU IWȆڪ¯IŨ$u]A³U  E ).U 5Ǧ>`H`Cc1U 66T1OXqX6T 6m~針%qS$ }%eq ԩPz }y=dC\YZ!DU rltm/T%;9 ߗ%l~O%l?ؐCl 6lH!PW؆ȮTaR8cC(drHmH!ېf !@lC نŌ0ؐClC ن6 9lbR6(F!ېClC ن6 9R6(F!ېClC ن6 9lbR6C!ېB!D1# 60lH!ېf !@lC ن(drHmH!ېf !qlC[^!S̖WqvU&* mygɆC-mh˫8+L6U&*fshG]qK@Q-1oJ{VΧ[t8ٚi֬/=!_`*!U#-//^z*֬/+?ŽK 2H[^_:9֬/X`KQz:֬/{ƦݟHtsq#}5[v:H+#BoK֪Y_Zγt맼^ɓ5K7/Huzƒ#Ut+Huk/ё> py++x{*6U#m8Җ֗~{(E1it $9R(^u҂cAsU&Yf$Q[^u!ϖWvU& DmyiIC-:g˫N+LU&#U2lyi ?[^uZa-:0IԖWV$j˫N;dg DmyF Dmyi@I$Q[^u!ϖWvU& Dmy D=GrH%!B(,QX6D0HC,QID)dr % G$Q\IE\*A +t`NxNJ0'\SR fj}$WiJ0qVys;$,~0:[=qz`N_Juds<_hNQ=N~_o8WМPTITaN\7'U95hN5@W؜E0':ҕʌ92cN\7'U؜mjFH+_#^BW4)(WXD5 D5uN g"lN ٜ6c99lbsR䐈g(dsRa3B6'D< ٜ(dsRa(B6'D< ٜ(dsRa3B6'$* ٜ99$a0'y`N ٜ699lbsR䐈G!C"lN ٜ699%sZ>zx99$Q椐a3f 6srHģ!B6'dN\idrx]T(Uf$ʕKU$B0I\$ KrzF%I[UGqb%UXtRy:S%H^ KJ(:u%KReFTI+,5#\_aI[-tRkO{7G}zR 5VϮ\/ Qзgt_ |,AȾƓy:$Q9*AՏ{'a9$wu$S KH*AFUWXUTIߔSeFT(WK*$Q \ajQ WJ9*%S>ʌO2SRݱZQXZS-!YB,͘lY ٲ0XC#lY ٲ6e9lbRȖH![C#lY ٲ6e9RȖH![C#lY ٲ6e9lbRȖ吤F![B,DG# 0,K![f ,@lY ٲ)drHt-K![f ,qlY[^!іwtu& emy]pɲ.CF- s$j1emjfL[Z-<̭ۚY-<|j eN\lG%ZVNعH,~Χ|U-qn5ښƒemjZxmvpWp׹iusIU-~Rg4[1JzwJUm}~.eEs-+֬,6~: Z^Jae_*35ښqFWвpUe7Iں$fp,-ajk-!R*T-!Hj|ij˜ZmyrV_B6CP`[^a3|-Xh+;d: emyrɲbdY[^!іW,wt& emyFbC-X0Y֖W,W,k++LlyrɲbemyrɲbfdY[^\a-Xh+;d: emyrɲbyɲdYe9$:RȖ-a3[f rHH-uR-KaZ Y{{ Bܫy^V^tRTIFD k\F%iҖ+t|o*AÆReF\ah+5L S%h8 jNI6{TA WR$JаqT_c+T V{=o%iX]ܪ10^R0QI׏4 t5^l9E sv=|0Uf4Lat+at!*3T0UўOpCZJpJ.$\ g˕¥ʌp, *Ao{A&_p9.\p9lgR@iA()dRa3 B.J Y()dRa(B.J Y()dRa3 B.7 Yp9$Pa.y \ Y6p9lbR@I! C%,\ Y6p9%ڞ$\ p9$PR¥a3 f rH¥[TaRYՍuy \[ \x%+(\ުUIU?WEwJ.Z$\*3 Wx,\̬UT.UfAH($\ \Az4#zBIQX|<{ W=/ &" rը$ eկrQ&»=U U=0׹…72#\+pŔpE઒k_LK#) W4u+ReFF%hC0I7) Sef=wUf4047U5B3 +n)$ Ku#S!B62dd=\7*ieSʦ!)BV6@l Yj)desHM!+f V6yl Yj)desHM!+f V6@l Y!)deSPkA恂)des M!+CB-l )des 0mjM!VI2jU¤l )lJ )de0)]¤l%OVfl 7)[Uu2lUiY*3Vl*I٘Tde\Q)[UfVsZt#V6UʜU%([IZT}WeJPʸW^s9KP9U VyEYGqr?=JP˷z ,s ol}ŭ^0jg}eoca%*݆)*l*I *ۏ=.2SeTaOi{L!YAΚorV99 ُpȪ2gd0(U4 aATѰ$ S 49 SA{e*S}2U4La3|0a& 0iBƧ )d|0iXI6% SVa0O& STaҰ )lJ(iXIT4¤a a0ya& S 4La3PҰ )d|0iBƧ U4La3P0qaaGaGa{v@aG 5D+hdGxBF. g쨰5e9+A^Ir_ ^r'/{%ܺW&\3Uf\2!g{%,0tTPə]Ύ ϧŒ Zڈv,Y=ʫW2UΎ Y$tr: gAS(ӱ9c\A9˽ rVyq;WMU[6V;*(gOg}}ƒ}j%ݲW&lLQ|}^r Vâ> ?f^ni#(pbrӱӂ6ǹNW~O NWV~t[~x^INW7-~r:Znk~. y{}KNG9[&#+ؤ-~͇Ť-~ݣ9ݒv)?ˣ-iHFN!܏pޖKôG-i? v)eNɽ J%]SG{׃2wK@at%~>E閸'^^jnkt&n*aһ%I&[ G n*(z]l*!cwUäwKUa-qW=Lz]mj*aһ%0wUäwKU-qW=Lz]l*!cwUäwKUa-qW&߽w 9$,Sza3f ֻޥ}W`=LzG\;UX+!%/\w:U{Y9W*A$ƕzʌީnnGn \^IzG'ʪ$GW*?UPT zG3;؞aʌ޹z7 zKz_~'WXPcn| ?Իwl`$[F]ACw5^ zGF;Z7ou?wx*3zJһ۟߷zGrJһ>6u/*I˔޹z<̽\;UXF8w)dsx]TaS8w\;UfΕzʌީ2w\;UX^;UfNwәM0=L6=lz*1=U9$BSȦM!B6=@lz@9$BSȦM!B6=@lz9$RȦM!9SȦMa3B6=Dh )dSȦMa({9$BSȦMa3f 6&WrLrT k7BUvW:=ޮʌrTaS8\beTku$#2tpT#NU 79- *P'O!C6 69S琸M!C6 69lbStK!B?m# 0O!f ?@ )dsHܦO!f ?qkCG޵!s#Z0#Z/?^wE{0&Ao f7Y?0£ #,,!Wpa>U|${|ï+x*6ƱG+'E7^xc\A+Dׯr~Y&d]A,g,_rX~Uٹ &Jc heUIwChKl]akUIǒ5oSw朗ve^S1#Z1I{,ߣˢ:V%Ya9i.\Å*sh?@A+6͹9{NFA|JG# >3iĠsFSBA˱ QOGޑCaGڑ/Ǜ h,#!wpȻw(L2Ȼw(L2Ȼw(L2Ȼw8dw{;&|;FewPdwp dwPdwpȻw8d|;&|;&|;*L2Yd!ABI$ Y&L:lIWˤ*329*S2 ɤ 5;3J0H,•  &ی]n$le U '+WQ:G%$^ >nLJIBUL֣.fte1S L[OKdE ?.fte/S%dIyc^WP&Z 2Y/^0L2y[cse\ۓTL L3JIeD ^?2Yh;_*A&ǎ[y$ą(UI2YxF$[}IUfdII]vUIWX&XԝɪW0/y%Z+JTe+]$lL2#\IUfdҕ.JId2Ufdtx]&UaT2Ldy2dRTbvH *FWH6*dmtxJUamtx]G%hBF{ Y)dmTa3kBFdi Y6:$aFy Y66:lbmTpO!kC= Y66:em~ڨq¤ Y+LXaF@sڨ jcʜ6>+Q *HsUU R A3\ʌAV%搒AV8gdU RwG A* U|VA>A lYdtC+3YdtC+luUII7T ov * qbW qZUAW^* c-s ~mzYrOT 2 1+ kaL2fK2`êAkl/r2HM[ e 2gAT5H|OټOdUA'Yd0ʜA2cUmX9Te 2gAV ;9T 5* d9gU3HU a4HoFV%dhTf9Te2&e*I&"5ITWxm99|VbVS!aI12V¤ b*lJYaRLlt&Ŭ0)BFgSa(*fI16%T ¤  +LѰ¤&T Sa()!BVL Y1b:lJIob*39*I1VLFʌbBpF1UQLW+*|Õ@62Œxr]Jzu-\ls$:_s^0r~_mmTJMZ`{۩¶I;]l:|*Hd*3UYĽ/&*3W¶?⦮tm¶9`ۦ*6whtJQ6SԤlaRfT%)f3b2 )Q1lSM3 /h:f~mvm:d̯)tlS!ۦt:תijyfsTx*dtH!BO,X<6x*dtHS!G x:Ta3BO Y<0*dTa(ޢx:$`TS!BO@3 '}2#2%\OUf@3JO@W*3Js3ʌxr]+Qu# m:d5&mS)[}ʌmVe6U!$dJnp5g(sωgUH<l0fsH6|6z6UalMUfl*sYOw,I<xYa x6+LWs6;'J x*d`0B xVSa3PO@I<+L⩐=$&T x*E0f$ xVS!cI<20Vij$ x*%\I<0*dtH⩐S!ftx2#2%\_S=]JNy\!T8#\OUX<xtb/TeF1]a$+D*3JR[W!LU KtŠIKtE+ERJ~UX1K$Ťi]$\rJ1]$ŬI1]~O*3JPL'/W+*i72ekftxij9|!f7ŒmBmSmrkU = 39*A<x:$`T鐀Q!BO@,X<x:$S⩐!x:Ta3BO Y<0*dTa(Z!BO$ Y<x:lOW*39*SuTGH0f3_M ٦tm¶m!٦tmlN$UMQ w;AތbB#x+x*+iU:<+CF+t*+}x/zFs:W+Kuf~ӦJQI^YO^iD|>eZN/rpz,+jXW+'"|Q&<te+]x+׽R54U ^ټOy*+GJUfrTIwϧUI^I[UQLUfU[z\JUfR v湙JW+x*|%*f~+*3ʌbr]1UQLW+*3 +늩ʌbBSaRWh*JW{T^xP!{CA +6W:lbT^4N!{BJă# ^0R!{f J@ +*dtHxvW^Bͳ3wÇokkP3œWi/!+fҎ|A1GI}_sͻu/(˖+3]Uϵ5(XJ65/S2'kKI\gwreFx]hI ˱OO$?S c#򡫷\Ac`Awm8Ttm2c2e\MUflӕʌm2c\'?U6Nm2c\\tlNT5ͣk<^=UflStm2c\UTe6]nئ+d 6ئ+d 6^Q m!QBMD 6m:lbt Ķm!ɝBMlGla(ئBM@l6m:$JTȶ(Q!ۦBM@l@6OCGhGh{y@yT.^MUflm6¶y`{l/&}=\ϽvO4{AyQ{eAʄʌW*Y<Jҽ. =*,'{eBOom uǹY_걞Tx&GųnY+QOt<*UtV*8+cٯ}+2GQU?r]GU :r]GUث}:oS:Ji:pAGGx]cJ=Jr1劮+*dWT\A θWT\1RzJ]!Sڨ!iBF@ Y)dmTpoA恂6*dmt Q!kC= 6*dmt 0;mF{&mTXa 6*lJQ6;YUYAm2Ux,&AwO?f`[*lŸ* 3*C\aZ-nse fQdʌU%ʜ2്^ *cTpKUa,v;yVAI@\ad-JP:큽~.A맿 *8^>OT0*erzƢ VT侾IGטT >[UAs>=ʜ V% *ݯ^* ">UfT*ARmU 򿋨ּN*3*X0|:L*uT8U?U߷ʜ r=UH!fIӫJ2 )d{Θ^Uɘ>Uf*IH_U椯*sҧʌUeNTa0I_sҧ!랸9{VU/FͤVa )d0f&SȺUa )mK+B F+0Y;LV0? +LVid *LVXaB@ Ɓ~?[BDs *d+TVh ]A+_(UfpT:$SV萬P![BB@3Vu+Te Ua+tHVpbr}gUfvQa>dȟ4Vx:[U%X!^ʌr U V ]+0 ]ޤJ럟\ `IUI*XTTA"U O*JRVpп@V0`~%잸tTP!¤S)?WߨSy/?Uf6 )ds !B?Z 9f?9$nSa38P-j㐹m˻8d6 myW?f 4=Qﶴäw[Qaһ-#lӻ-09tn/sfK;Q3&|fni?|ֱ]b~lz[G8w[Kл%Nf\ֻ%2vXw[XCp,CﶼDœ+w7[XZTOxFSS%]}o㚾\Az2ӓ\._Is߳`IgTyK% ]ܯӣ$*sz5{4bS|okxUӻmvUnkxi>Ӣmn.͗UI}[_ʜmi3;U2cz[CK&JfK{-0W9B6-eq= nkLFHz=S2Bһ-#d'GM{랰do[ŤFeۚ]Lwèl eRٶ¤l[!+ۖw1q m˻8d.& mi8*6iQٶ;LʶO&e'CF-x0)ۖw,}X9$Rҧo,ߴ9.})ds{x,}O!KC5,} )ds 0%sH!B>,}X60HC5,}I)ds 4#}\>UUu%BUfgOsʔrTYOt +xi* ]!,cHT%YaUNVJB\qE UIVHúVZJqIYsJbǹVD0=o:96(d~VȈ [ae]TJªv\BU1X+׭Pdt+׭P+Te ]A+ĵXUBW XLY+d :=dH oI\uTBWޡJ)\ 24?QVAIGT!`uz Qa3;Bv:םNv:םNv:t?B9sC{S8co\7Uf.lo )d{s !iB7loU\DN9,rC99"E!B9` Y9lbs"02y7 `k Ca50ܚpDn{Y8d[^Yּ$rk"3dmv5k"׬i 6tkFw,Gs5푑ϣfQVsQefQ{\q5;_#.c NamvIU N뗹NW/IY3ƅf>NXpqP~ӕ=ʃ~:ݚw*>/m;UM7~.ҹ{}55ONW`ןKr:t6tQe4Tsuv? U 6;g4oؓ"3#5Чn7؜ޭ.pM™\q53]ݚvޭi׊!ݚwP8wNݚwPn;Q8d[Nޭy' ,KkމBaһىykLz׼&nS(Lz)&[ ޭy ekޟ!cٚPnS(Lz)*Lzx))dsHXN!f ;@w# zN!C;w Y^;UfΕzʌީ2w\;UH~t$r|3"u(rtɅ+ENT "g\9U_>+ȝUI"G;2#rjä+,rkcYkENLh ܣ3"Dn|(@sEH7//$r5X+(~OQDwqE'S%mʌȹr]T "VN*3ީ2t t!BND ] p\!Q>w:>2co5Mu{CQe\i~lo u0؛C.lo 69lb{S𺽩BֿTDN9,rI9$a93{úr]T9W)dsH"Ea3B9E Y9Wfu{SM!ۛ;d{s`o u)d{sHԥM!ۛf 7qdop7D] u)d{Sa39${SM!ۛB7ho ̎ѧ*3ʌrTIW5̕s\9ʌӹrF%9+ gDN$r@m*\.rëqTI"Gr]TI"yWPƶ6s*I mT}0mnO9HL rcq繂"Wp_w0YI"Wzsϕ rkto \M=|$B\a#U)" +ENsȩD_$rwJTIW?y=#~=*gy.9$++Ӈ4w$k~3zʌ޹BzN!C²sHXN!f ;@w Y]Ի;UX9$SznA&O#sXL!;Bv:͘t9$YRNo߳stJTaSz!9dsw Y)dsHXN!f ;qwKY2UN!cYI*Lz(fw0Bֻ )d0]I]UNʜUeNTѻwt]UNvN ;]9SeF䪒DpE.W%\n7"7"WDv peFDPB2y+Z}SEO{q\AGכr'ozcU "B$uRWd$B\A?_"W r̉*3"W9SE.xSeN2'r̈\UDNʜ=+QΈ\U5Qx]0tU8t8]U朮*sN ;]3؜өNWar )d{2Ut )lJNWar:3NW9Se骒t *LNF09]~NWө,Var )lLN(9]!Ut V=t8]UUNCrNa~UN!X2Ut 1ޅ)dsHMO!f 6=@lz# LO!C2=lz ѧ*3 }2cz.eU1=W\Se\!=\GVpE^(u )\a#P%-tJ? W:{UUkex/$ˁ>Ou"/k\ >*ƙg3=o>UpQIW=Z\ W#}npS *hdU-<+yaPe\aS ~(b6?ʔ 2)LdLp _iJ]̨*3*uTeF]i~ά Y0CB8 Y6 :lbT*U0 6)TUP!CRAIGTP 6oESVoˣ *DAG`WTȮ\Q!BvEd^ +:pŔ+rUaWTȮ!9dWt )dWtH`]Q!f/bsR}DWtH]!1BvE6+0CrE+*dWtxUqEWʌ+2㊮\wEUf\ѕ뮨ʌ+B#Et0\E$T T8# ♷*ICWP6`UfQ x+(u_A$+,}?Q$%aC>O qS,j|R XoڦvαhS^cIFW *Ajȱo+Q m*AW 2+Hh~D7 Ufѕ남n\DUfqTѕ남 e~H6N_x^BUfЕJ2cX+׭P+tP![BBDs# VhN![BB@l :nX+׭PBl :$+aB wpt *pF]iU!BVAI *dt_4\ *dt :qPA  :$nS*Ua3Ќ ǜUQAp&TWaR *lJ*(3*U¤ Y+L*XaRA&S7\Q̩`U HU˺x 3W? UZ{V~3W$}I*(}'t/WŪ$/TF#U|+(}cSTYT ҇Wg1Rk6ԕi&O6>;, :mWJ|?WPtVeNT$飍U>UXڥ*IX>O$}ɏ*IԽª~gL*S{o=ʜ¦Gl"k2U =csW=rU٧ÕʜWa )dn{2U )lJWa?3W9Se *LF0_~W׼D\%`>? pA"bG7pEJ!ΞKdxJ-hoA4eC+boA?B[_ X[߂ ?|[F#vCvC7Da Bnn#_\wdD>wd'VJ8l'w| [APrwd; B(wD\4Bl;b.$|" WM|+{>B:+y_纮[D\!BDX|ݘ-"ƻ# ew?_JstWH7vwds`B8玘+1s$BXvpG6\ts?_;+e>E7ܰwĬ0#fG+8= +xG6;auF+xC V nVh8 V@hoV#V|lZ| X| Vd nlæ ã{ !!{Zl~ }4}7DߟR!k̦hbh hn@f4}5}/=+,^zVY{Y!74ҳBnhgDv_#+"~|1G-@3}ԐAG>8H䎈C 5қKLYF}sV(bW8%"/,kMJX?y:1Ӈr01}Ou{M|Gd5BO\ruݽ옾DvL_#hhA1?{spCmQN'K5+%bܑ/G#d _qz|;N) dWH I dW8 Np^ ;ϝ^"~ۻD+${+$흿و ܱw ó+${.]!@wl W];;ea{T_cwl I+${.]0;+to=つ dOȞp=]0{ +$OȞ<] {@tqG6Nx"{Dҵw;["ކGqo|ޮ[";-O;=ѝkA#7=}3rp1#G4rt#}׷} A#GG3r^9E½;ޞ?4rtE"j'uK܏uNܥONE%c1r[ߐo7&"Fx"P%BFpǽ5 Ȏ{kݛn+x8 qo{{Kdǽ5;"Mbnxv<]";̞.=]!i +$-Ȟ.=]0{a t w^{]"l d{WHb d{WK]kd]!ٻ@wl , d{W?t dOW OȞX {B`xF*; k^ .eقfY-hnAw@f}Awl4{nAw ܱw+BV<݂-t+b?ȞKd}E~~7l")ȞKdӭ޻F O_<ֿ#D"$V ?$b>mx>1b ٜQJϑ92^iDY2vdG+1GFvd?qdtd2g92Z>9u}YAGrG>-G{bgQGF%blUk^Y#krznMWGȎ#KdǑ5#KDD>#Ȏ#KdǑ5n8F>wd8+!Gh?o9DvY";Y" I3# qdit\";欑)9 dsVHb IT9 dsV8 pY Y"|i,vd ɑ#+$GvAqd I3#+ܑ%Ž,pǑ52 ώY ;@vddّ#+$%uAqd>8@vd@ ؑ#+$%ȎY ;@vd@;ي9gT ;BRRّ#+bGvAqdّ# dGȎsG_]V KmX ۰BD;6mX";6,ֈ?Qa۰D:2W8F>wd#,sdTzG|n>qd(#AG3$Ž/>JD\[Zזkη8.߿#p71G&"l]@s:tW湌.qdËl:6828sdKm,LdǑ58Dȑ?ߵȎ ksWdˆ5Oxrd# 96,aن ҵah8 .+]V! *$u.+]V0a vY eLD>nDp*$Ȇ p*$IȆ{-acgUH+ W B7lpPBH W a 6\@lpP dUH+ W aՈhAsY4a sY@沾@vY de˒_|+b.+peeYp4FP׊+".kzsY_P މ|~Kh"|W)mٹޫtYӣ˚\DDemˢw헾 >YAXrm"w]vY_+"$sx1%". 9h]nKD\"ScsY+".ktY+sOd#XȞZsYD\V";.kEv ".+HM\&Q5<3\1BiA3\ dõa 3\ dpPZ ׂfpZ W BA ZT0@HԂY,h~*pOT"O-h~jASl_4?@A_PT~jAS@O-h~*uЂY,h~jAS@;h6)+gߏCU!I@V$Z*bkU8 b Z*$k*U*V[DZ*$cakE?uYQdl_-OUjskȎjskX+lakE7j%cAk }W"bPu$":q-ڼAku>V|=oVKٸZ+‹kG4Bچ%"j}mZ%2[+ٲV3cٱV|nٱV]xU#˜De?VX+e}fGٱVXDvlsk[BDlZ dkU8 *U!I *$I*U0[a Vl I*$I*U0[BHU [B?l ZۉXk0<[BVlZ dk֪$Z@bZ*bk֪$Q [BVlZXFt=?DBA I d?U8 ~pO d?UH~*T a 6Q@9s 6ϝS";)Ԉ?QKiKl.?ɍ|HxFcN<-j=-Od#%"l~5oH׭r]/i+zuu%sHH+H1u{3i"F=Hw%1o[)&jxCThG>-c(1Fov5FãD dcƨQ a 6Fl I\PQ! @6Fl 1 dcTH&Q! @6Fl @bt dcT1JQ1jdQ!@6Fl ɇ1 dcTHb } 1Fl 1 dcTH&Q!@6Fl b1w{ Yw{w=Ќ{w{ Yw=Ќa{ Kfߚ^"cؚ.?3mM, b谭K]ꅲ'Ja;KY9ҿakcؚ.VߚUzkۢD#}˹WGl{#?#5o"D#HoM>/J<˺cؚVU})7=1lMy [ӇodD<1lMޔ# oJr=R!c؄>oەGïOyc؏> 瑎a?({腬mߏhMnh慬mn^nhn^=慬mXhX~AHo,/dsBH[=ұaxHo,4tB$o,4t G:|cyy7G:|cyy79|cy! 7G:|cyxתzcw7caM {B6#G*btAHm# dp=R0{@HW#F#L";)HӣGz$%y{=R";EJ1JČZ(W93FvύQ"fH3$"txx1Zݬe¾E*Ac]3FxR"bpy#l%"\#h{/) 0[ƨύQ";ƨ4FO%7"%vC [n~Jã~nٱ@{[(@$]*$ p-P [B. TH%-P [a @@lt d TH%-P [a @>X@@$RXF d G [@@$].( p-P0[@@$]^ d ph5cYޅ$]t d p-P0[ *$K [@@@l *$9HH$ wN#>Wcp=5/y/Ȏis/Ȏijv"eVJ/U[Jx\ˬ7z=^"eDF:Dˠj)7x2Ϳu[#ed%ck$¶lMΕ:͉ 2'9@V  d9͉ ԁ̉ڟ9BRD IA d'R8 Npʼnd'RH "H ;a v"@Dىd'RH!H ;BHJ)G"l? ?R4%b>%!ڏE"b?MWُH,ۏ ݾPg/qE~D~,S{W#l?ֿ5߿f?ñ.iu8֛HD c\#h?pp"f?hYL#ۏD~؏F~($sZٲ /ُaȎHG!Ɇ@$~(bQ8 #G!Ɇ ($#G0ۏa l? I6($#G0ۏBHG ۏB l? I6dQ8 pG ۏBl?~l؏BHG ۏa @l?~ldQH!G ۏa :ۏ~gdُٰ@ XG0ُa _PG ˆ~lXǂf?~XG ˆ~lXǂf?} >ЦXtON\!$ ُٳ{ 1A7c}!~++"㺺2-?akL~AqℿEA!^+bc}<.IDG~sRُH10j?~跥V+"o{kd~ُ~7 d';Vq"+DA'"fEȊ d9@V YМH09a s"  dՉXМȂD̉YМH +͉XМȂD̉@D4' bAs" 4'9a s"@D4'ȍAs"  dՉ@D4'8 dN$pȜȂDYA,hN$ĂD4'8 dN$P'r-N䁠 nN䁠 nND8 N@Dى< щ< щЉs[DпOsG̟WtO"OV5{DПHK;"d})s ?ÙA鉠?2OF h'B|On'?#OOi Dv'J㎘U۰*wdê*qC*qC*7Da *BrC*V 1nVhU8 V@hUnV 1nV 1nVhU8 V>[Uy HUy HU!ZUy0ZUy 8U!ZTV>[Uy0ZU!Zĸ!Zĸ!ZUy0Z@fU?ԪdRH#J [a *@lU.(V$F [BlU٪U)bV$F [BlU٪@bU } *_!8*$cUA2=ʎUIdǪ42X*tahOW#bU ;"VJyEЪ\l﷈X剠UAqEĪm@'@O ؟?)$]tE @'@O u 'n} Sw>uũ[ohݭ74r?9uwYW+NzC'nSwɩ[Ⱥݭd]q?9uwkSpϟp ͔pU9mWӶz';7w>4%e{Y<ݭӧNXzGĔmo6%=5y){^qn[~:牠)Y}]-¦oz"lJV;gJaw+^*=Sr=Sr[߱6i{^i_DO@~ wSwǩ[Zoh-74q8uK ~,N@ niُSǩ[Zoh-dpl8uK ~f?N-dpl8uK ~f?NzCni} wSǩ[Z~f?Na niُS>eé[ZȲ-74q8uK~~ldQH!G ۏa @l?.(dC ۏB l?~(bdC ۏB l?~@b? } t u"l? q"ED̉Pakh#Dha'gq"8FЉ/ϸ׷8u},A[qẺm<v::f7>5IĜ.7Jdlj4Idlj4BN$plj$D܉$32ۏdQH->=G {B 9 s(bQ8 Ğ#=G!i ($Ȟ#=G0{a 9 I+($Ȟ#=G0{BH5rG~N;bc]?qiߤ%ُ:>؏"l\=c]sf־4#e~H#xKW#ۏDvG#d?~H/@ B6Fe4B^F!@6l4 I (bFpF0@6$.(FB @6@l4 h($FB @6@l4 } 1l4 I ($F#F0a 6l4 dQHb4 } 1l4 hdQH!F! @6l4 h@n4NߦZm,NߦhFmf4NߦhFm,NߦZmf4NߦhFmf4NߦZm,NߦhFmTq6V3X-sMU9lSVsTEw6UbMwP6.a*ϐQ#=V#.`ϟ*fNߦX/sG"./cr봛E{D.Widr&oJſMV|#=wq6=wq6_ Mz0xusMȞ @nn=y8}iy8}iyV8}i!k8}iy8}i!kV8}iy8}sߴM Y+4'c?ʍD~LbzL#ۏDvG#ۏDvG"b?#a\ۏu(A^⊘X0ǚ# F~,cpsm%475w؏N#d,DvfIdgj#DvLI#DvLSRH$MI!y@6%lJ IL))bSȦpMI0@6%$&.(D @6%@lJ ؔ))$1ȦD @6%@lJ } 1%lJ IL))$1Ȧ$MI0a 6%lJ ) dSRHbbJ } 1%lJ ؔ) dSRHb"MI!@6%lJ ؔ@fJ{i^jJ IL))$1Ȧ$MI0a 6%SRHb"MI!@6%lJ ؔ) dSRHb"MI!@6%lJ } 1%>옒F>7%옒F>7%))'2 NW"DI6Idlj$"Nqmk8t"x$'s?q"YJ(G_G؉khGAEvH#DpUm"D~7:ɪϝH";NϝH";׉$bNH"|?L!:6%qE~dQH>G ۏB l? ~(bQ8 #G!Ɇ ($#G0ۏa l? I6($#G0ۏBHG ۏB l? I6dQ8 pG ۏBl?~l؏BHG ۏa @l?~ldQH!G ۏa :ۏ>dُٰ@ XG0ُa _PG ˆ~lXǂf?~XG ˆ~lXǂf?} >)+bcU$C";cEv6c?VĮa"DGs"+Da'wẺێD̉FvȊ:؏@$~ldpG0ۏ@~($pA>؏@@l? ~($dC ۏ@@l? u $f? I6($#G0ۏa QH!G!Ɇ@l? ~dQH!G!Ɇ@l? } >ЖHd~4Hd~4H]s&|n?[ldoe693~|P؏5m ~X+^xcM"b?Gq)s]\~:XJ{[ȎhGhsȎHd~4Hd~4H~dQH>G ۏB l? ~(bQ8 #G!Ɇ ($#G0ۏa l? I6($#G0ۏBHG ۏB l? I6dQ8 pG ۏBl?~l؏BHG ۏa @l?~ldQH!G ۏa :ۏ>dُٰ@ XG0ُa _PG ˆ~lXǂf?~XG ˆ~lXǂf?} >ЦX=ȎX=ȎX2F9VD<ǿDρ D1A8Aρ-qryX뱞#ey\푈y:ts1ϱ~7e"9pi"9oُD~ڏ=ϑKhMdh/F#ЇW}}A3 da 3 28 dFcA3,@ XЌF0a 3 d@ XЌF0@HƂf4Y ,hF#‚f448 dF#pȌƂf4/hFcA3,@HƂf4hXЌF h@XЌƂf4h@f4M I ($F#F0a 6QH!F! @6l4 hdQH!F! @6l4 } 1>ЖHdh4Hdgi#DvF"l4 ?7Fh1A$"FZG6_~F"b4+!4`s19ޤ4s2Ѹw9 ZVʐ_]C#h4-F#cx/*M {ѸBSF!@6l4 I (bFpF0@6$.(FB @6@l4 h($FB @6@l4 } 1l4 I ($F#F0a 6l4 dQHb4 } 1l4 hdQH!F! @6l4 h@n4^w@x@3/YhF;Kh|gi! ,-d򝥁f4^4ЌwxB/YZ;Kh|gh|giΉ-Ȏx ;KkYPMČkNu5l'u$bFNiװ:E z\hZDh7y IhWfOʿEvkN'%'"FC\kN:|'oװtk4]/8:שxn xn@s/-hE Y|h0-2wݢ.^[Uw*xn@s/-hE]|h!-dUݢ.^[4w^Pw*xnBV/-hE]|h-fݢ.^[.^[4wxn@s/-ZȪE Y|h 4wݢ x}陻($UTA @v@. ]\PE!@v ](bwQ8 "E!@v ](]@.V7{츋F>w3w1 .awQK".5OOH]r}?[RoM<sK\0F]H=E]RD]6ېAw&s[1w0.F]DwQvE".]~.qdwqAq.]R3dwTA a v. ]dwQH. IdwQ8 pE BR. IdwQ8 wTA BR.](bwy @v .(wpE0@v ]*dwpE$u3AA ]vw ]< 7,KqC|l4}h4nF nF@h4nF@h48 Fh4!A  hx0Ѹ!@!@!x0@n4Οd@ XЌF0a 3_PF h@XЌƂf4hXЌF h@XЌƂf4} 5> +g41+"Fcz2{bELS E".wD5pG]Hŵ*?1w6n-|M#.'B<̊8۹칋s츋s||8䎘dHƂ{F+F#ph@ XЌF hXЌF0a 3 dh@XЌƂf4hXЌF h@XЌƂf4h@h@XЌF h,hF#pȌF0hr__ЌƂf4Y |A5>h2@ dhԁhyB =$~($p~ldQH!G ۏa @l?~ldQH!G ۏBHGdcT>G";c̜ȏ?~K6G ۏB l? ~(bQ8 #G!Ɇ ($#G0ۏa l? I6($#G0ۏBHG ۏB l? I6dQ8 pG ۏBl?~l؏BHG ۏa @l?~ldQH!G ۏa :О냖ُG"l? I6dQH#G0ۏ ($dC ۏ@@l? ~($dC ۏ@>؏BG!y_ ]HHhDv|D#Dv|D#DFvJ"#s^Aq-X'>>MD|.##FGkKꏷS~A_-Ȏh|Dh*}H}D!~ط,E#SڱW-~.awQH]*XE ],h"pE0]r3_ł.Y|Au>]2w@V dU]ԁ]]v;h$FB @6d4hѸBl4 I dQ8 FpF Bl4 I dQ(h($F~Hdh4HČ(r5Dsw<l=zGs|sDk}"9Dsz$"cb{=^YxV|f;9|91G";x+Wn[#~($pG ۏa @l?~l؏B l?~(bdC ۏB l?~(~($dC ۏ@@l? ~(n#G!Ɇ (~(bQ8 #G!Ɇ@$~(bQُw~9aQHZ!=G {B9 s\P}tOG ڏNH ;Br";N$';8F'*7<&"yh؏^-IM^K˼ُDvG#h?~$c?ٱн(9~jy `cab4kIs9ss$žZ| {@sdQ8 Ğp=G {B QHZ!=G {a @9sVdQHZ!=G {a >x@sVdȞp=G0{@s($pA>x@@9 s($ȞB {@@9 u [ݢ;ݢ-hݢ9-hݢ-ZZݢ9-hݢ9-ZZݢ9-hݢTqnQt~=qn8l_h8͠R"i3(c :(Ȟ#=G!i@@9s(bȞsVdȞp=G0{@sVdȞp=G$#=G!i@s(bQ8 Ğ#=G!@9 I+\P=G {B QdQ8 Ğp=G {B 9 I+dQ8 ĞPq|UUQc4VČF h,hF#Ƃf4h|A5,4aA3 28 dFcA3,4FcA3 h1HƂf4h,g4VP)dw{r4žX1WD|41x;G#h4peQϿ]"AAρ$9Aq]vL"{cEvv69Vds$9Vds_QFc=ȎXWDGٴ+b#f?4ȲaA@f?48 d#pǂf?Y6|A,4ُa @f?4ȲaA,4ُa >ڏ~lXG ˆ~,h#pG0ُ~r_ǂf?Y6|A>ڏ~2ُ@ dُٰ~ԁN=>!(~$dC ۏ@d?~؏B l? I6dQ8 pG ۏB l? ~dQ(~$"[;$D!'NH9r)1gs~n?ٱK@aAk&1jwWDُ(oG"f?Wٱ؏F>dȎhsȎHG!ُ#qE*=G"9 dQHZ!=G0{@@9 s($pAs(bQ8 Ğ#=G!i@s(bQdQHZ!=G!i@9 sdQH->=G {B QdQ8 Ğp=G {B 9 I+dQ8 ĞPT{DsVdȞk}D"# mdQH?}D0@@# G(ATG(bQ8 >"}D!@TG(bQdQH?}D!@# GdQHm;}D BQdQ8 >p}D B# dQ8 >PrAo?d[D;>}\Oh>}#Nh>}\OZ}#Nh>}#NZ}#Nh>}TqNB+/4p}gzy8}gzy8}gzr?}g!zy8}gzy8}g!zr?}gzy8}<׳{= 蟾3{=<3{= W3{=/fNY8 dfNYE\OhfN빠~lBѿ!yx yC4BPoPoh8 @hnPo`nhyxᎠyyx"Po`nh8 hݑ pG6a\'_~yY_p_&{}0;kܑ qG6x"[;b'•Jv,AK@74K1< KqGpR<ПB۾!x x0x0!Bd@7DqCBa 7D@7D@7DqCB@} G< G< G}G#8 >@#n>Po>Po>#8 >:О.(G$> @#GB# dQ8 >p}D B# GdQ(;>"pG4B?}D!@# G~#!Qc<$"Z_y|yO\MV4A0<C ;a v @1RdPH>C ;a v >8@v T1RdȎpC0;@v Ԡ1c(JAq >8@v @ 1c(JȎ*} ;@v @ u v _}~rM?ts  \yCn| C7W>k+oh͕74op78ts \yCn TopL+1lqln|"\\@ m,4pM8mRFY(6A1p {'!ڄcs=ݟ}M:ǰwR41pL{'E60|)wN}"?B%yGK DKp5>CC !ȅ2Cp~!8t? \@.CC !ohB~~r!?t? fB~~r!?t? fyC3| CC !fa 3CC> !ȅ74Cp~!8t?=3TR!dCȆp A0 !(BȆ y @6@l !(BȆ A @6> A"|eA hw Br (x;%caC@ O A6뿿z>_#[ 2@t()1~TH#Dיw,iWyl~8utaZz~\@""~ O$&1;2; 6T1J/R{ ~t a q~_Hu Nr~_8 p} BӁ Nr~_8 ~t BӁq/~k @T/(~p}0@TR~p}9@ Z:Y~r^} /h>p}0r^} /h>~W{> Z~Y~߯H&V_W.-: &b[#Y $.7HDD>"^_ݤ~A{&yAk@&8 dM>pȚ8Am\&5a k@&yAk\&5a k>6rq^К| /hM>pȚ|05rO]К8Am>6Y&5@. Z⼠5Yԁ, 8r/M>|07a n&_H9|!@n q&_H9|!5@n } i>t@2y @n@ ?op;i`;_2Gç7|пFDcoy. XD.'tDvy".FF r;v^He8y0 J;/􁤝R vp a n q;v^He r;v^8 py B*Á r;v^8 vp B*Áq;/vg @nT/(vpy0@nTRvpy /h<v8 dvrE^:{ W/h=p:{0ur#]:"A>vYgξu@ Zg䊼uYgԁRE^H9;{ wa @/(*r wBȁqg/ȝ*r wBȁ@ } "rg/ȝ=;{0wBز'bn;;"q\"Sgpg_uD4/[HD:;ޜNgo2@nTR;vpy<n;y"Íp;mW9^Vv'b.o۹ߺҦvT{r/=p{@ er^H7{x0@@ r/{AT{r/^8 =<{x!@T{r/^I^H7{x!@ q^H-3{x Ÿ @q/=jo Bq/ԁAk A.zA.z AkA.zAk A.z.= rO@o+~V@o ~VBkFv9.οuh㦿T'"75oI>oËٸOoָOhMo\pOV8 dMo>67Z>}[!7Y>}[057Z>}[!7r=}[57Z>}[57r=}[!7Z>}[57]P 魐 q-q魐qڸOhMo@ָOhMo\pOVMoָOhMo Z>5B*ܸ r]8 čpqR ]H7w 7a n܅@ܸqR ]H7w 7BHw$;w!@n܅Tpqr.]8 č;P7^;ix=u#X9qKƍ]8ktȍ;w! J.qr.]8 č;w!@n܅Tpqr.]Y>~Y.ȍ n 7@n܅@ܸ q_Pw!@n܅Tpqr.]8 č;w!@n܅Tpqr.q@ҸqR ]H7w 7a n܅@ܸww#ظDqq76_koM5{z;ixA"ظ^?sw#T{r/=p{@ er^H7{x0@@ r/{AT{r/^8 =<{x!@T{r/^I^H7{x!@ q^H-3{x B^I^8 =p{x B r^8 =P_{x r]zY.h=v@n r;/v~Ai>BꞁRv^8 Z;{v9"3Wf#v_?{6v˰!sCjlv~@l R;eؐڹ! D6Q;7v˰!^ R;y l0ܐ|o{6vnH6Q;@ S;gܑ!vjҏHl ;9,]"<I_"eؐڹ!^ ?f jv@{4vnHaCjڹ! D6Q;7v?2lHܐlvR;eؐ|/Æ ?f j0ܐ|/Æ{6vnH6Q;@ ?iHܐ|/v@ ?f jڹ!^ ?2lHܐlv@v.e`j\ v^0sfR; L\p v. ڹ`3PjS;2\0sA.S;/ڹ`(s+oK׿>ZU?o?Ͽ?Oz[-=-f |?=׿ ?Mq?3N~ϻoc߿|~0TU>и1'*_7|̱J}R[>O}?󻏱%$ i[o K|oǹU$|}8g|~O{nǢXR~&q?C }m5;4' C˸|rgߓÿ=ꃿ^<6%|~?>5ۡXޟrzU\iznxOee:KWޚt|RO>v7$8c]=Y=9~n39iGﷄ~Ǽջ{{ :)O>~Rk}姺7~zG{db~ߓېPnq~ ?޾KC`>ZHWp|? /YI~Ɗ!;m` /[66]7c|{5uubm;}x̟k?ׄNgޓ_5V?1?y1ϫy~2ǻ}'ҬǼ]x|ﹷ^/~wwm_u\l5a^5ZO5>?~?-~ze_u::xUy G}K6֟Ɵ_~N<~:?u<-?>׃/u'(?W9 骟Ms=_py|g:|uq.ߟ:K_:u__A[NT?ߦU돿?}ok_8_s?ٿ?~_?/׽wu?SQe͎w|}/>ؑ^3c~_:_}üO~W:'~:}Oldx''I'^EY?_/B/(FOn"ݪl~՟~}՚?|O_u]| 'ynV_Jp.n'!-ýd: I..;]\vopo@nnhe'en@k2kr..;7]\vB쀷nnnW]sD py¥XgjpᢵpC;`<]Q+x>Sؐ5T0U7>]9VY9"llޯ'O˿xYמ=;!\{v@L=;a=;a=; ^{vBx RgkN ҕU'+מ=;!\%מ0מ=;!\Yuopeoteڳ6g'lZBnt! ʪte *=;a=;(Y …LхL' CWVpZn ]t.d:!\$x  t@gk2ѝHppZnh#V3kkL^} ~/u` ~ b:]0um 6~_0{AS:]0 b~_0{AS~_0 6QEnܠ*Z?݀uDR P+Zh>ߖu>/?n[`no W~q>vy_tO(P[~k߼oIP9Wr.\F .@0]@zL.@]@ֵq@r.\@aty & ջ`r\ &P0f (\ W  & .`r\ & ջ`r lJ.@(rL.`r@r.\@L.@( (\ u.`h 0$ .\ AvT d0`py z d`H.@]a3AvTnކT 0` .@]!UoAv 0lq`^Hr .etI .#t[f|$P[c=EէXD"u~>ERJU>_#hmu|J El5O`P*8M"e2͛(2cB.Ȇ !0C` @ !rA6d!0lbC`H\ C2C` @ !rA6T!0lbC` Ć@ !rA6d @ a(A6TR!dC Ȇ a3A6T A6@l !dC`H@ a3A6d!( $CpB0DCpB0DCp@4'B~@4'Cp@4lNbCpB(DCp@4'Cp@4'lBCp@4'B~@4'B~@4DCp<   h6ЫH2G$W3.?"l:=zG3BKҪ `SX!X뱶U*aCV{PEFuqD!pD!I Op\pF,yCG$1G$!+pDj78!x78aj j 78ajj j {78ajj j {78 z78a3zBM? z78!x78a3z78!x78!x7%7doP0yA7( 7(~'o @kz &o ޠ`@L@kz Lޠ`y @L@kz Lޠ`Rd(2c=xs]gl 6>~RmO}v)66n[Ա SmO}խ_CFN/5_mZgO&gm¸I#lB6!Mb٧m"36a }Pk' 6` yh & } 6` MlJ6A76` l0

fl"36 /$W`:6+"l3BS}r7$Sa~>G<=+kJw,/mqF<4ohXVie1 b00=x# Gq恢*'UO00=x# *'UO>b00=x# qr*L>b00=x# q*L>b00=x# Gq6%UO>b0}Wa#C# GdaH_}!Aa > A#G6daH_}!A# @G恂dax+,G-e](BFs,hz7Ѡ # Fh<"hf{,xDևW]|h|ʭaQ_/xP1Pg}ƉJUߋ?ˣ`H05qqKF  F^qF~'D`43:.p-!A2gӔp< {<|9 I+0$!ȞC=a3{C 9s0x|UzxD6ߣէa!a4AQ}uEѠM \Sd4H(FLF FÐ`2FqF#IEsC C=!iA9s0lbaHZA= {Ca C=!iAs0lba ĞC=!iA9 C=a(xAsVd!Ȟð=a3{A Ð< {A@9 I+daHC=a3{A9s(=ǖ׾4dϱ/ slyK9`[^R0y-}ick_ &ϱ/ slyKf9!k-}iZak_ &ϱ/ck_ '[Z3oi?<ʜҚ,9-i͗]>Ȍؚ6 cUӷkQ-o:|^bD(=>ݗ9ُ:y4ΚnLjAQBz/er8/^ؔv)="l?J ֬<֬$8JgɤҪ D`r"[^S09-)ȖW4lJNd+x &'< ىlyO2\2#Hw}ˣ my؏V~[SPD5(lkxs#EE /Q$ؚW,֮[^?%FYmMĚ5[ZU&ypGIgKapZm'k-l+ΖWLfg+ &m lye[~|E#}">ˊ3 fՒ5gޫy_}ZZA3֯w./35˫|0/8ŭ"{ Ef|ψ$|`G{piE謹?\H{Kk}$ȜH=#{V Lgx!_0I=-p "*⎠h~+ HS{ϱIߣŇ=\_Hd & Ԍ,P9 ȌȜY?< ? ?< y?KK]dt. ]*RdYLvIeNd &$ `3PK]dS0%AKwRd@.LvIeNdYLv`K@. 6%T0%A9w ۥ.LvI(%A9]* ۥ. 6%T0%AK]d ]߽.]ddHvI %C9l . ]0%I֪9` *5Bu\_%X+VkU/uj%EJ)䜚g!8'A;'j8'Ef)sHpNum_:[oJ& M"3&ʑ&J6Ql D L!(A6Ql I2$#&JMa3(f 6Ql I2$5`0Ql @D 2$#&ʐď (A6Q@l D 2$3`0QdD 2lbeHGM (C2Ql D 2$%&ʐLTlζ!%m&jl &uZ:ۂD-ymYx9õYݒV`sk]-|D&ҬNfaf9ZZuB'EfRdΆ-ͺ-ͺAm-ͺA-ݺnzaK.xaK.xiK$ذɯ 96^~c$ٰY^"ymAV~\>G C=Aur`s6l7Lrz w.aV#ס^"huQ6R⊰ 㥥A4zYZJ947}Ɇ56liV %ٰmؒs6lIٰ% ޟDuhÚlؒVϛ [zlÖ޸!۰%7.lؒL6l & [zɆ-yqCOK^oܐmؒL6l & Y>-yqCOK^o\0ٰ%7.lؒL6l|ZzlÖ޸`aK^o\0ٰ%7.lؒ7d [zlÖ޸!۰%7~/Ñl m mццlц ;am mц݆s#윑f vDʮi ދ$^Gd{ß^g:"Lx3댠"tD&G?"{ Jg \YrDŁH2\A5.z6\G$F.5kֹv{>dKYϯK2\urFpEH[U{[Sެ)ެ)?.7^"թ.o4g벢Il,>֯yƒ9WV^:›+H0gAyMj8rZw}IٺK0g/Ӻ{͗W}opk/~e?^#t͚tI,Ds6Z̙YS:"ɜIs7k7lOkΙYSaΜi8 ۛ3I3$6佲*цqM Y9ãO럢hVeZLmk0Y=UBZ{\lVeZLmk՟ת?!K=UdVeZLmk՟ת?![=UdVeZLmk՟-ת?a3Pl{\lV ٲq{k՟, [6CllٲdfHM-ۀ恂e3$&ȖM-u˦Ȍes-1Ef,"l Q3 "3͑M˦Ȍese)u˦ȌeS#;!]&^Ȍ9S͙a3#sY}^ǢȌ#SdƑ9rݑ)zܡ7nZ{| o5yGv.?|GêgryDؑ͐gY۸ݙY=??ϯ#sVӮ$.-Ollvb v="3̑LGI"dg]ag0UĺaGlaeޫ9-׆)=Jaͱ O~# ̐#SdƑ9rݑ)2!%%ȎL!92Avd@ّdGfHlّ恂#dGfHJJ!))Avd ؑ6#dGfHJj ɑ #dGf Ď̐ ;2Avdّ6#dGfHL!9ɑ}ߓɑ#dGfHL ;2CRR ɑ #082/zG6:2IGVCˆD#+mDБ5^"3rdᕴ#2!G&8qd#3~!"ndr2g~4g̘ͣ3E9keƜ)2c1g903)|Z~OkS>M+Ai ɧ O3lb&>͐ 4Ci&>0| 4CW I_ Odf >Ͱ} 4CWfH>M} 4f i٧ O3$&>Ͱ} 4Ci ɧ>m{}8!-pӶO^L>m{0}8`i[ cniU5Ӧ7 nݾ`ɲmɲm^|shiβm^˃¶3g[hk[\ɜmi%ȺÚɜmlζfu`ζȜ9ۚ9ۚKQ իAsF+8Q9+/S_ rY=ʭlⷧH0gx#hou RH0glyDٖWU Zo{4g[^Wsr9LS$sW%Y}PY?[?w`r$×G&}ږV7i[Zvi[ZYzΧmqu9{3lk ,-ߟL:-/ٖtd[Z߿'ٖ蟸ȶC#Ll;09-pBVR[!ȶC#Ll;w8!+-pȶC#Ll;w8!;-pȶC#Ll;w8a3Prd[!ȶC ّmyّ#dG&Ȏ̐ ;2Crd 0!92Avd3̑LG:2<9SdƑ)Ž#SdnMG3Ef̙"3̑lD93$s&Y~̙#$ٜ91g$sFװ9 ?n1g̘3G3E9uAs6ݼ׈$s6N ~uYNAsV_"9"կOy奜2g95 v5=#h>#{=`Q.^^sHcΆڞ?K̙#͙"3lD̙#dg̙#͙"3L6g͙"36gͣ+=\l$ˌeSdƲ)2c!6`l-"5Bl-~eñe$ֿ{df،Mݛ!.Avo Mݛa(7Avoٽd&Ͱݛa37Avo ͐ܛ 7Avo@ Iu {dfHMݛa37Avoٽ{+${3$&͐ܛ 7Avoٽ{d6`poy ɽ {qo{/xEfܛ#ݛ"3Mvo(fܛ#oTdƽ)B^#,!R~L7Efܛ#ٽ{qo$F9 a/͑MȌ{sHrou{potoᐆ{vgruHpoݽntoSrɽn{n{>E{+qo\wo$Vqb]>cɽ}[8m"U&[_ioȻ;rݽ)2Fdʽ9BMpƽ9rݽ)2afxݽ)+[6CMpƜ92=|0gSY>m2gΘ?Bs֏DL,? ɜ59S4$$HO9!s&̰͙ 3CUl ɜ ̙ 3m{ ծ>mmk >|(cOí;!K+|Zck@}Jj'v~yiO7֮ >mmgm}FاG|Ki_<=< X">o>m`=<|bM5< |Z;n Ι51`x-EUkrj{tZ(smmvhN&<=ʜ{[pƽyW)2f?湞tokڏZxۚw)Lmͻ&] YuyCvokޥ@05R ۚw)0dյ] YuyּK`rokޥ@05R`Ȫkͻ{[.ɽyּK`rokޥۚw)0lJmͻ{[.ּKAՓ{3$&͐ܛ 7Avoٽ{d6`poy ɽ {qo{S6EfZs云S$9<1T$f#ȌsSd9rȍH0r׍"3FN#+A6rt- 7dGL5WuHro{I0 vo\TƥOroX?Ojos,֗22UZ )4GнsV vy9X!m{\woyqK[voeroIw^~Œ{k~ܛ"3mD{G]n\MO{:NOuOȌS$x~)2t3DOלkL.SΑNpwiܰwd(#t9P6}l I 3$7`0}l @ 3$&ȦϐĚ >A6}@l 3$6`0}d 3lbgHbMM >C2}l 3$'ȦϐL_d~dgHOM >Ckl 0>GH2}ͣם"3Nϑ7s*2c1}\7}#LuӧH0}32}l 1}\7}̬uӧȌSd9r)2c_dmݎ+#2G "r˸@ML^̦2?UeNmZVfLd:K;M"34}$t٤M"36}u%LwӧH0}uE^_J6}|!"}w)2cFd9r)2cn1}3n1}|s]>w\w;E˃M9=G <u{HwͳNp)2ckatI)N!2Awd Na(;Aw$,d{'ΰa3;Aw$ ΐ ;Aw@l I d{gHNa3;Awd+ݲ6N]dL`w, &{'`ww`(;Aw+8gA{N*2giEfL_EL"3"s"sOWd{)¦vH2}|`*LP *Lނ?xӇ\(2g1} {)0/d6oEzw)¦>JH0}/t̬O7"OW9ӧȌ>CrzaUW37"3{C(2y?PÙ] 1}3}3}ǒL_pyIWg_E" =LyajYV$YAAp a>rmcd &(r`, &X0Ffdm,l ˽;Qmcd &( l ˽6LQmcdm,l Ƃ6 m6zIѐl FCl6dhHQm6恂m4$5'ȶQp6:r6*2cim`|d g#u"3^QǑ{ÎH/tT$yf+dhx *2c1A/IvtATdfE>Ef # "34xو$ 82k bv3< O=3ĎA{Il :r * "] {[&Q:q!" _)ȌA)3  aW(8  aWhx*2 I0ks)],'\a3Bp͉Mr+:  q+4 I0 &W،\a~W(8  q+4|Wh!@j\"3r dWhHjN] Bf v@ 0BCr 6+4$5'ȮP]!BAv@ +dWhH`v^ +,\ ‚LP\ L+EW(b`r\"3"sPO*+yEE+󊊰WΊW43{ b( bE "l A>+6#yŊ{EI^E"YGT$yElJ9>I^.4s"n1"+⦮ qG"^"lWn^/wf bĊDEf bE AM`3 qoh V$q7^"l* "ޠ<"S{z82c+2Ӈ#Ӈ`2 "3" ĊĊDEjC Ն́Ċ$ 6ghLĊĊ'y+Vd+*;9XdºKdsf= +2 +Bd$φxcLɊ̙IELLf`2, &3)"`2lJfR(ɂL h&LLf`2@L ,dd&LLfR(ɂL ,̤ _vOfҐ̤ IC2l&Ld3iHfRL恂4$3)fRpL:rL*2c&A3 6c&11\7Lf#|mcaiEf̤#d&FCZPp6*l#^Qfl#m"3QϯK)l#.`u8"6cIqzzZ_^hiDG*z~mI4"Aַ_}ڜq:rA*2  I"$R 7elWFA"3vl"3W1Ȕt亃TdA:BRt亃T!b(8c3mS4cm/mtmTdfEmlFGFEfl"3Q0yxEEf#׽"Ǧ,Dۘ)ۨȌmtl FA$6d(ȶѰma3FA$ ѐl FA@l I mdhHQma3FAd6m,lc}6mdhHQm FC{l 6 m0F6jVdL:rL*2c&GdL:rL*2c&!3)fRW1$a'ȶѐl>ȊFGgl#m"3Qu8"SёQdGợ {EEf#׽"3^QGa(8xEG+6,zWo)ȌWt {EA+d(^Ѱa3{EA ^ѐ {EA@ I WdhH^Qa3{EA+W,w~1d_ +ny`[E0y-b^q;&u;Qn/l+n8B ĭ9P2jkmp n~0 s{dFw]w#-C3[K[ ĭ x>7) bRM 񧾱u$8Lm~%B {|^>EAWA qE9=^A/Cfl2X2Vy3[K0[K#e 3yD&a39lᓙ<"L f򌰙,l&IfZl?σ3y'uA} ʗX/~4a3 {\d&v#2a&e3yD&l&H2糙<"f\6GdLf3|(͘3rL4'm&fAyB\{F0g'l&Ȅ<"f\^Q3yF.#d(+?˾L3rW _yD&|o~f,l1Ȅ<"\G$]I~p26Ȅ<#6n6O*6Wxу= 1у= A; =!x= z6=!h= z= z6= z= z0yiAكd*Ԑ {PCA 0#$ 66 n{m]ȌtTdm*266q\w̸MEl%X ^#2e1d)]m6nSF 珍 Ofx6l< I0!OA6l< x`d)Ӑ Of 6l< x 4$Y05sB6k-l<׸[\n9Ls05sOAYZAs=E񬓣Gvn1cϺ}ap IfzE~3x~;x9v\v\v\'9"sssmi>-\u<m&w9!k7O75<9n?x(s&uܱ猠ImIv;SI6;4ˤI]'w9#3&uܱLsFfL<ʜI]'9"s&um%\%ڽW8iR{5sdR״cOk=iR׸LLw:a3|2k ,.׸ ٤q'&ƝLw:`2k lR׸ I]N@'dƝN&u;֧[ dR٤Id*&Րĥ TC2lR &0L!iGA63&ՑwjH6cQE؎$OEf"3ӑȔuUE+*aIS`1iӠ#,8![|.S]ÏȌTdb:rb*Z̗pTdbHsvuEfܦ#6GIn3LMG+?Em^w̸MEfܦ#ttT$Y|6e1y\JEf|#}"+ M5e&If:湙1\7̘IEf̤#ͤ"3f2NIEf̤#d&L 4|v/p2x#$g̤"3fґ5d3i fRͤ!4$3)fRͤa3ICl&Ld3i fRͤ!IA6d& &3k:!IA6d&L 4$(fҐ̤ 43iHOͤ HRa3Pr!;HCvHB|eWdW*2++G$|W7"f{6"33Sw?"3ӑ;d1y$9Dѳt-Xb*,f݆u5^Ks=ۦHûg}ZL\R`1*IGbf?G$Yrs$Yᐾz\9x?Sg-X|I˝I~S^,#-"3sD,#-"3a3R_M|;񕊐|//UdW:¾yf|"W6h1`h1)ȌtT-3Ly⒯̯蔯Tdb3ry#2+\=d&2̘IGL d3i.0F fRpL*2c&y?PC6l&L0IC2l&L64$(fRͤ!IA6@l&Ld3iHf`6kwȐ2d3}\CLy!d&׼a(5;$zl&״l"3i ŚA\}|I˚Ekݬ>|} gqZܠ+|x7w(]kڱ0Yۛ{ǽyw ?#3Vp{\y\y0E fm)6?%YAN` dn#gޚv`m N9͙tzkN(W}i\fX&O3Wle~;3_kNs,sooǑv hԓVp;&+u ekoGp i?< yfd׼ !K5cVpͻ&+]x\.< yCkޅǰ(Y5cVpͻ\._]ژq>c]q#&WTdW1bq#&WTdW1"ߘ\q䊎䊊슎䊊슊슎x슎䊊3Wt HȮȮHȮX]Q]ё\Q]ё\Q鸢GiG #t\#]Q#슎QQ#=+0aW#wIHFh$"NtM]c4\\x]q0߲4G+\ 7Hpsm%HpǼ#F+53 XXp.GF:+zm.IH{<®8Mos]K|f+~oHG5W\Q#QڨHoVo1Hh+~BtP# ?Sqd#l}F ˟_H!#l?yA,oQԿdx͊G B+'k%X89~XG[F:VzH = 5ұ9jjc VX)+H =VY Vns.nXY?a1Xa:mOHK=\5Dt#N#`x:ڨdbAㅒA:v# M 7|ʌ-mHG=Bڨڨp_K=B`Ft#/ԑѱ8E~T4:sjKW)5q:)95R:;5nMEaSF';G'RGӍ]6n)}n~lHp<#tn NWk$8x:"O"zn㣼wHr1tyt8F:NNyits$8sH3kMOMiL/N6t0=^ui$_c+w8v*n)  ^]!Ott+\w8+^@|W# qdW]!w8+*+:+*+*+:+*+:+*v\q\#(8 bJ"#"#""#"#b5qEgG_ \ "jR#AyJ tC5D 6F:緘h$|W z-&IAt|.I5Q#,ItQ-A " b|AwV AHG=\HK=\5‚ȂH`ȂH`ȂȂXѱ8 " sAHG=B8cK5D * * :~Z % bzY; z: :gATdAt|.s$ b%aATG F:;EDEDGDED@,,$,$#A|PoqEAWDA\qG@QwA\!IH?~2XHcW\#++"++#;+HH% ~o4o4o<5B%>~_ GTҷGXC|5Ґ5҇>xI@J8Ki$I|mY_9Y*=5ԻGH|.#6oxE~q*$}pa|FҷFޤoOK῍$*;ҷFҧJbA^#ᶑvGc\# #+ P=^5ҸWds+66 * *FPWDnETVD\Up@;B\Up*F*G@;*F*G@WD\UpO,tTpP5P=BQw,*"UP##Up4 ƶ=~ +#@s+V#Xh;B+\pG W8# b8xWȎg+dg+dg+dŞ+u{E36\7\7\7\7ȌwƛIvdW<$tȊtHoټWdt\l+G^{x_St?nzxwL? p3Ao#5Ƴ.HFω_KFc<~k 8Qj#=F6ҕk$h#z6F6  G:xVw6$Alm$i# GX53AlLFzxJӆ+&W,s3mR]񌷘sų$cO7lx7Tƍ'iټd$W<Ӎ'_"3ޙ6xɊxɊxɊxɎW<[LϓguI>BxɊxɎVCio1Yg=B++;v6o1#W<+[LHxɊxɎgd@xɎͤ8jnPFڨ6j$i#!GX~FGzQiܺGF:箨ߞH=® Hpys$"[#M tE|Q#슊9>h:{fW+toK8绗W7}GF+g}_#+=+Α+z+jy;炨 zQQ#y|eI?nA+ :v#lseyna+Td+t$Sd+t$Sd+Td+t,VXPjc!+eXG   ?oܤG _y 5ұB||GBGBEBEB6GZVVX)lڱB)*:*:b+Td+t|n VX}@ GZohّ7VxZVLVxZVLVxZVYQ~> -+h۲G:Vx{[VLVx{[VLVx{[VLVx{[vd;-;dGehG~5ҳ£_WtʗO&_JMABSx;ʊIx;ʎ,THd*x4L#/1LY1LٱeGqgJG3JR3x=<)+&<); Δ%<);vTH7s WI_/I*H**H***H**H*Q9RAi/uZXyζB*+s|pG K){Hc5^¹|r3` V\o^# W+> 5x#e!+\1`*?*x;S :vzbVI]ݎw4nGh5HGv|FclyFfQ$=(e#B#y3Ax}FPͷK]܃2%H]܃.A Cݽe4N8&ߡwOtW쑎/7(&&L#,~4wJĎ$|Mӻ$|3b2;LL78JwIfǎ$I2$izwD1ޝo&qDgzw4{_G>_c2;WL8~R׊Q+]SÂz%2twmD19ݝoQLNwF]rcKt{׿r;N7GZN4q:PP6EV6GB-EV6GB-EV6EV6@lŁXY +͈V]}AY?~-9s9HG4ґ3||G3G3E3E3G[rriGOsd9s$Rd9Sd9s$9Sd9s,rr\4ґ3ؓ?O$g$g,g$g,g,g$g,g$g9#3<\4ґ3<3)9)9))9T)9))99s|.gIr?Zr3$gӆGӫii#gyN#9HG:F{sml|꯷uL#IWʛy췎4~șG˙F^~Dz<B-#-[Vݺ#υK#HG<\4H¥¥H¥H¥H5c.| \,\J,\J,\,\ŁXp)p9()p9pK1(" '?N#7k#\G>_# # " " #ҌAIYYp9()p)p9p)p9bRdr|E_# ׈=:_?'r$Rdr$RdRdr$Rdr$RE?zpi#\y.\aRdr$Rdr$RdRdr$PRdr$RdRdr \4.t#Ϸk#\y.\IU[#K#ɽY{[5 i$Oc{y^;0x{͑^F{Ey? 5y#^!_#] x_?v>Lv^^|y#^̣F:3\s#_{ɽ95ҹ#K#^^^^^^L^^^3r H̤H̤X˱8"#1"#׌ٽ{){9~O] W+{U^|^^^^L3r$RdRdr,H̤HXK{is{GȽFי;{y+#י+&:Vz^gJsJ~<՟BU@ѽpy# י;Ju Jg?uIμ~Fc+{9LFg:uOj+}q0~ˑ_(Ylu[ $ߚb+:^H#ɲae1MV`YgJϏy1gl^ny$b2:V?s|\ԙ;]:HRAPR}j> Vg~OV+Cμ>YgK>Vg?bӧb|MSg}ʱ'QgwӼFDyӼb3owd:yG3oWLuM3F:y$Qg4sM ?g4$̛DyӼb3owd9Ӧ/%L;Dy{b3ow@]Sj{|qDy{b3oWLu ?g%Di#c3oyWLu-Iμݑ%[%:wǎDՖ?JT%|ʑ|J}ʑ|J}J}ʑ|J}ʑ|J|j(QH>f˜uג|jE7}z}SUySIOU0Io-ordi5>)<)O9O)O)O9O)O9)O)O9O|1("#q"#q""cq )@SSASS3Rdr >> 4wOy}*jF:>ϗ>H>>>H4c)G)E)E)@SASSSSŁا٧F:>zRjĞD˛IYIYYxYIYfDМDE%E%G%E%@KK9KKKKJ_s$S4'Hǜ41'<7't#lNOF:Z;1'<7'tI#sssHǜ7'UGHGKFXIYYIY ~YYIf $J%ʑG%ʑG%J%ʱ8Kcq (E(GE(GD)D9Rdr@KÜjk:]99Gޚoxх. H0@;G5}|?`N4F9KT`NNsH^K0iZt[qG s¯ڜ iNG5=QmMt[ӋDU ?3]#ɜ]1ӑ;9y?#ϑ+&s:~9y?b2#Gwd9~tG&#GWLtɜ]1ӑ;2y?#ӑ+&s:~tdNGޏsЋo9TӜ&t/4ӑ7+&s:&tG&#oBwds:&tdNGބț9y#ӑ7;JtMs:MC4 /K܄#ӊhN;9"ӎ@<+9""ӎ@lN;"ӎ`N+9XiE4VDsiE4ќv|lNID;asAY# sZ#ɜ5i4i<~oilyZ#?%SG Jk󮑆D(l$;{$K,h$Hk?k 5~ I>Fb7>>O5!>#D1x-^ѷ(|j{D+F#,Q׏Z#IN鿱H*Aoϛ{޾^Dc{D$QJԗ؜Sc4)ӊdN8#ҎK+.cq ԥsVD]ZuiG%E֥XVD]0gEԥsVD]Zui@K;B]ZuiGQv]Rd]Zui| ֥QvtYtKtYȑlK, cq TQvtQdhETQv, #ˊ@+ "*ЎŁPVDS{DYv~op{d8wb2;nޑ[wdùViSc2;n^1oȆs;Js;ql8wܾb2;m?zN@%w;X~';mYk~Sn^#=N)=ice2rf.ϟN@wɍkHr;NrsHk$ #2p# .3>ͯ qFewUo\#e2wԝ.6uϷ}]l{2w].s77uiSc;6g{G;^1Yl{WLr=;q@Zg{G;ޑi{WLr=+&kqLwܳ#[l{WLr=;2miȴq-َZzd-w|b;nޑi㎛wdkqZzd-w|#[7_X(Y7_r_"[˝V]w$kQdkq$kQdkQdkq$Pdkq$kQdk1Xc>PG EEGE@l-l-d-l-d-l-l-ϭeDkɼG[Fh$2X$ h$X >i`-Bz_~n =k'OW$}8} ֢o+skHXk<t#$0,0,0,0$0,0,0ŁX` <Y`Y`I`f FƑCƑCFƱ8 cq EGEG(8Qdq$Pdq$PdQdq,XFƑc 0$0,0,0ŁX` <Y`Y`I`Y`(8(8w$Qdq$QdQdq$Pdq$Qd1c>PGEEGE@,0,0$0,0$0,0,0f#,0FJG`W$U)oH:֢hc-akk$Y #h-I%_AHd06}k$X GZN4e7]?.Zhui`-]So^#l-x3͟0Z䴵h$X GC0߯_#kskHZHZPEG EG EE@l-ŁZZ6ZZf ֢EőhCőhCEű8[cq EG8((8bkq$PdkQdkq$kQdkq,֢H֢H2b+n$ޑwdkF\q#Zxd-WHc>P+n$^1Y7rō;Jrō;\q#l-WHbX#ZXb#q*6kk Oٯj#q46\͍{]jn$#Fb}W{#0W{CoGHW=Wd 0:{8qʕwz2 ,#&}ּF?=d{,$BI?k$ \G:s5wks̕vga$0W2%2x\qs,0Wb+n^1 7抛wd\qs W#7抛WLs+&<9xG+n^1 7抛wd/Jۀ\qI`w$0W#7s +&\qI`wG+nݱ8P+nݑJ|D+m;_x8(8((8x(8(1(#" " # " cq EGEGEE3GZ$0ş|D\#sHG`47r$kQXG8F?x4<9ߤ$0yNI3 :< 0t  t=/_#A`V=Cͯ 06Q`X2GZxFFƑCƑFFƱ8 #" " # ̌A`(8x(8x((8bq,HH3cE| 0,0,0,0,0ŁX`(8xƑFFƱ8 #" " # " cq EGEG~SƑFƑFFƑCƑFf 0@A` <Y`Y`I`Y`(8(8((8>9zG F:<\`4^tF#,0$0 -HG`4R xh#0As%0 3W GF#m rFh7{_>]FX`6*z_F#A`ϱ$0<G F:3Gv]֢xEEőhCőEEű8[#ц"["[#YˌZ󁂵(8m(8m((8bkq,֢HH2cE|`-l-Dl-Dl-l-ŁZ(8mőEEű8[#ц"["[#Y"[cq EGEG֢2bEEicd-l-#&kyh-@Z6FL2bE(J2bE(ed-ky4E#k#=k#=kHZHZ4ұ1ٮd-|Q FP` ICoHO`4~#F#yDy!ICgxH#(0SHP(2mEicd-#&kQ,E8P(2mEE1(ZˈZ6FL֢ȴ1b(J֢X(YˈZ6^1Z"[ˈZFL֢X(Y"ƈZFL֢2b@ZFL֢2bE1YOZZZZZZ6ZZZf őhCEőEű8["[#Y"[#Y"["[sk#-k4ұt#ϭE#kZKuhhc-s-騊GF:2GB#;i?AUA" ?*.)4Ts#*tF7UHR*ޮwi*y*aU1sUHGUPPEVGB EVGB EVEV@*ŁXUYU 1f HȪȪXUőCUEUőTEUű8"#"#ʈIU$Uq$UQdUq$UQdUQdUq$PdUq$UQdU1c>PPGB EVEVGREV@*******UeDU19s=3mZ#$k)^hZδ17[ݣsʠέXݘ둎`-gޘodHμ19a? `-՟x_bzI#Zۻ9ICOh#0y.0aq|.0F/'y.0GH`;$0?{h#0a]`HF#İ7H x<CT4SIC xo+H2 ̩xh#0s$<֒϶#d-l-l-Dl-d-l-l-ŁZ6ZZZf EőhCőhCEű8[cq EG EG(8kQdkq$Pdkq$PdkQdkq,XEőhc`-d-l-l-ŁZ6ZZZZ(8(8z}6'kq$kQdkq$kQdkQdkq$Pdkq$kQdk1Xc>PG EEGE@l-l-d-l-d-l-l-@QU'ZhTű'y'a?q|'I~R-t#'kFJ[O Gk$ OAU4QP#oULr䍹l-GޘX(Yˑ7:2myc#[ˑ7*&k9rq$k9-zr-_bZbmг؂~y:-l-Gڂ?g-G7XQ rtwze4tF (vk9ݸF[u<x(v^kqP E GE GE E @lŁ.. f vHvvvX‘@B‘B±8ۅ"ۅ#م"ۅ#ň.tG+n2ݑ⊛LWLvqM+&&]\q@.tdWd#7X(7TpM;2\q.T1ŕv:&v/GwdݢcU{{cW[nQdUm@k\#=-lWE4UlŧH|_r |#,iE#A4mT鈆GF:碡h̑hxDCEÑDCECEÑAEÑDCECEñ8#""#ƌA4h(h8 (h8 (h(h8bp,ĢȢHȢH1c E | ,,,,ŁX4h(h8 DÑDCECEñ8#""#"cq  E G E GY4Ρ1CcĤ#&Pdl1"LjI?^1b>PEƆ~CcĤŁ~CaĤ #&1b>P|#&Pd1"Lj=:]cFzΡsFzΡs&s?GsVIT <|t$x7xHrz;FsnL9G?9neHrF1#Us8&`HG4HO4^#MH~Q4Y4FL1b Eh(hDc$Łh(2 Dc$,EC1(ƈI4FLȀ0bh(JX(ƈI4FLȢQ4FLEc$ #&Pd@1ƈI4%P,Dc$ ECEc$#&P,DCa$#&Pd1bq$#&Pd1"ߘE~#L)hPpEvGbEvGbEvEv@Ł9999f ΡCÑXAÑXACñ8;cq vEvGbs8s(s(s8bp$VPdPdp$Pdp,ΡHΡH1b994qs(s(s8+(s8s(s1(8#";";#9";cq vEvGbEvGbEvEv|@99Hԏ?'y'GOW>(&?A?kW4~«'$GFdy'iGOOOOO+OOOO8W((81("#q"#q""cq @''''3?Qd?q ~~H\~H\~~Xı8"#qŌOOOO8W((8(8b?Qd?q$?Qd?q$?1I8 ?QFOFL~2bE((E?Qd1ɈOOFL~X(ɈO+FL~\1b(E?Q~2bŎh'c'c'a?~'#D#?#=? =2G]F"zFГ!$%g>B\aݢ$%bLIR_iQJ$)$))65ҔDd$%#&)Qd1I"KɈIJFLRX(I"ĈIJFLRRQJ󁢔Dab$% #&)1Ibq$%ŁDab$%,%d$%@QJFLR01bED8P@IJFLR0QJYJFLR2b@IJ&FLR2bE(JR2bE(YJ览{^RxDDđ`BđDd %@AJ &YJYJIJYJ(8L(8L((8)q RR\J4u#,%F:W5BR% -1<7(vޓ&d" EF#D"I&BT6zF!Q &R!|o{^4LxM/(HD4L#sHG?HK?<_hGEEGEGEE@ 3p HؠHؠXñ8"#a"#njA?Y?~(~86(~86(~(~8bp,H0cGEE@ ŁX?Y?I?Y?I?Fǝ7:vNR wޛ{S7Ց{Sgq罩I?7U1ǝ:~yocqwޛp罩 wޛ{Sgq罩I?7ձwڦZShǝ6`I?bju~UNW{q;V~yǪЏ;XMq;V]XEh$o&]Xŷh$m||F0DoTHDbj0;X/=F#IJsbj 1KdUG6;XUL&rDcU1ȝw:J&rDcՑM;V󁢉yǪ#ĝw:2AyǪb2;XUL&rDcՑ ;VDcU1ȝw*&UG&;XudUd"wޱL;VyǪ#ĝw:yǪb2;XUL&rDcՑM;V%UG6;Xud#ΓLđM~1HDzdD#AJ <)EoK %> Rn=R2Ӥ$%(GPJ ]))~ZHCKJ4ґ9đDđDDđ`BđDDı8K#"K"K#IɌAJ󁂔(8L(8L((8b)q,RRH0RHR2cE| %,%,%,%,%ŁXJ(8LđDDı8K#"K"K#I"Kcq EGEG{Rr$%ϥD#)I"K"K#"K#I"KɌAJ󁂔8L((8(8b)Qd)q$Pd)q$Pd)Qd)q RD9h$H Rh#%ix乔hd}}F:G?'XF#Owx也h'y' ~H~~H~~~H\~H~~~XđBDđd'@OO+O+OO8b?Qd?q$Pd?q$?1"c>PEG EG EE@'ŁOO+f ~H~~~XđBDđDı8"#"#Ɉ]?Vǎ\-a?V'WҪ[Z\yKc>P+oiUL~r-'WX(ɕ:2W\yK#sŕ*&?\yKb+oiuUli w\Ŗ'WҚҖ[EOVtJ[ZoWwwG:~r[\ywk=*v?ݭOjw+UnŽ"=%IJ 6 RR)Wi$IZj$7*v?4*vPJo?(%+F>Vd"WǪLX ՑMX\yb2+cUL&r}l"WMX Ց X\yb2+cUL&r}LW&r}DU1ȕ:2A\y#ĕ*&>Vd"WǪLX ՑMX\yb2+cUL&r}l"WX(ȕ:\y#Uc?/DF:&2E6E6G"E6G2E68q$PdQdq$Qdq,&&H&H&&L1("sHDJ#A?M3A@HЏGw~hya1#"#""#a"#""cq GEEGҏ~8Pdp$lPdp$lPdPdp,XCÑAÑcƠ@A?Y? Y? Y?Y?~8bPdp$l1#""cq GEEGE@#~Y-ka"{LdE4DvXMdG0DDvbbE4DvYMd@h"+"Ȏ@+&c>Ȏ@l"+HDcY# Y# #0=(@BlH0v<650=D4150=DȎfx)^hZĺGXJ-JZ_ $eD)?C|&FDDvYMdG0DVDbE4DVDYMd@h";A&"Ȏ`"l";&#Ċh";A&"ȎŁDv,&"Ȏ@+&&"Ȏ@l"+"Ȏ@+&cq 4&#"Ȏ`"+&cq 4 VDYMdG0Dv,&"Ȏ`"+&2c뎚#gǺcG?>=q}+&8>~qI?θu|gǺbҏ3cݑXw,Xwdl8>θuŤgǪXWLq};v~?}ᗜulc#ӏLXC$k$z6ƻd|mIA;3HO?5%3^pŖVZF#\o{6LK&2DbK+=GDHŖǎHӔҚ)5L[ZWRr}+&)9>q gǺ#KXWLRr}+&)9>YJθu|(%gǺ#0q}+&)9>qIJθuG3cݑXWLRr}+&)9>&θuG3c]1IXWLRr};2Lq,%gǺb3c]1IXwd)9>%)9>YJθuGJ?YC#sHЏ/#Gya1#"#""#a"#""cq GEEGҏ~8Pdp$lPdp$lPdPdp,XCÑAÑcƠ@A?Y? Y? Y?Y?~8bPdp$l1#""cq GEEGE@#F?7bG?HO?41bҏ~(26CcĤC1("cÈI?FL1b@I?FL0bEƆ~C1(b>Pԏ~(vc$04я1ӏ1tcC#|ZF#D6w#h"sLJtL541L$ЃFD$;<&Rd"X2qI&Dl$6a.ޙ ıg"I&Dᣉ(Ldd"L#&Qd1ȈD%Qd1ȈDD^1b>P4(2ALD bd"#&Q,LD8P2(2ALDMLD1(ȈD FL&1b2(J&X(ȈD ^1"ȈDFL&X("ĈDFL&&2b2@DFL&&2b2E6g"^?.%q|n"阈GDDD DDDf &LđBMDMđLDMı8"#"#""c>P0|`"l"MD#sHD41<7A=t#C#A?p݄GiMHߑ#xF~x׀h7j$GqIA2GP?/~hq'B#t#C#3p$Pdp$PdPdp$lPdp$PdPdp,HؠM3ݶe?mBn3vfTHUJ4 DD霒P58֞1\qn㙙i^aHc`? @~0$ Ðd A@l? ~0$ ÐDŽ~0!Ðd C l?~60lb!ÐdÄ~d!ð!Al? ~0lb!Ð C~=0$]L`r &w!`rB0݅ ]LBE.(܅ ]*(E.@]恢(܅Hp().r?b)*f)aKQpRTdR(–{jEUcFb)*, [ :BRO Wp(,i"RЇPaKq/Z EV,EE,EER/ A~d̓`(M@HR8e?̠Hpx"Lqett" Pd(. Cނ& .0\a(AvT d .]!UoAv L\a(AvTRd .]a3AvT 0AvyRd`H[] f v@R0Cr6 0-.@]!Av@ d`H.`v׼Ґ]5|y`r׼R0kF)\5o4Ep( mya3Pr׼Ґ5o4}( mFp( midpM$ v!\\~H5pm6Ajw6Ar6 ώk /Ț 6 $5oV(\@.f$~tG~E 8idv״ r5q0k(\5qL.8r=y`r׼Q0k(\5q4dp{ @\GC׼ѐ5qL.8 &p{ =\y!k(\5qL.8r=\y`r׼Q0k(\5q4}{ \Gy`r׼Q0kh.86%p{ \GCv״Z d`H.@] Cނ  0@E9f]>@\Jߛ}>zKz>#{[ P$>?5bEe}o65~nS$=oL~ϛS?Cn#LM~]|ɏ_/lsYkٺq[=Z;7#IM?{u-n|Eh~?{ߏf^L^#m3L~zߏ_O0by`#3:=~=C#L~zߏ_O0rya(ry! ~?~=Gޯ' N_ϐSy`#3:=~=C#L~zߏ_O0ry! ~?~=Gޯ' ߏ_ϰ(ry!}wگ_! Ruڐ|O恰?:mHސ|`3{CNRuڐ!~@ ?:mH{C`3nw~!nw~yߟ~HpHs?ߖd{GBoʅ"{GsY|Cjkq6&_!5by l0Mސ|-Άk7&oHM6Qِ!5OM恰Rِ|-Ά ?f j!5Z ?&Bl`!5Z ?lHMސl&Rk7&oHM6Qِ!5 ?f jk7&_`j$R&oHM^ 7yC*΂ r04y=# CRp"7M'oEVz"vZ>\vsAn r;72,| @B;vnHeX۹!sAn Rv.ܐB;vnHeX۹!aAn 6q;vnHeX۹! C;vn \۹!aAnT r;7lvn \۹! C;7v.\۹a3sC*ÂR;vn \۹!sAn v~9R;vnH\۹ sC* r;0sDJ;wvHjTῒYP.=ܐj pC' =0za(pAT{R.=ܰ{!^A Oza(pAT{R.=ܰ{a3pAT{R0pAyRnHW{ pf @R0pC6q7+=\{!pA@RnH=`{f=| y`{&z oyM0=3o@y!=3ڻoyۄy`{fȵw y`{&z}jo6\NXW$pP#C Ӧ7q3#{EBbo7߂oMop7M0=ozL=|ϛ @yӛ`{fȵwϛ yӛ`{&z7 Mo0{7r7C{&z7 Moyӛ!=oz3Moyӛ`{fȵwϛ yӛ`{&z7 Mo\{͐{7 Moyӛ`{f=|ϛ R7C{f=|ϛ~z!pA r7+=ܐz C7nHW{ pC r7+=ܐj pAy @ r7+=ܐz pA@ pER?:="ӟN%xFgq")"pJJW$<5$ r7+=| @BnHW{!pA R.=ܐzBnHW{!^A 6qnHW{! Cn =\{!^AT{ r7ln =\{! C7.=\{a3pCRn =\{!pA xRnH=\{ pC r0p cy{`#oo3;6C#ooL=|mMpf{[(oކBWdf{[#mo}nw3bYk#moˍ{mqM057ry#!ܑ7MSy#`j#od3;F6Cn#odL{lqM057ry#a(67ry#!ܑ7 =F6ԸG& ͐Sy#`j#od3;F6C.#odL{lqM057ry#!77 =F6ԸG& qͰ(57ry#!77Lې 7nCj܂ܸqRmH[qB6+ȍ[!5nAn܆@ܸqRmHW 7nF%dߎf |}P>沍ۡq6n׭|ӱnuޒ;xn/vq{o>kv$q+&K Cr?l{>.q?m[`}~6ngޔox7ѯ _UL4pSn=zbE*MM@Nf|Ӓv~|~ۯ:y(; ushk o/vE>Nz^M1}Ϭ74~>.o;ͧt->^QUCѷ[% }}GXc~ /ףvg8yqZ 7f7rXwD[sy oob:޾Nu]>UPg߶^)_۫ɘ)>gM?o}>g^Sx]{uk>W-B9o |c/p;_/oCq{)s{v `oza=dy9±G1⫦kkgn[?n_Aۯ^nϒ۝x|]*׷z죾C@?uG]_zyޡ5?|u{oG_^ݎSǼ~vx{z~Qo#븨~;^/>;C`pn}?޲/R/_v̯?=??7'Oo~L}~R>ÿ7=G'6??TzeQ,gu:__׿/ _&]xtJ}ygA8G=D??^n1nq̇iWoOZ*p1~ߥb~/Ư1~[__̯Ŝn=uN;9޽n/+:rUBwsfG6;~w}]oWr{\տI~}|2Ɨ?㰄OC8xU'ӽN{!]uB<t/A>^wgWO:!u@x6^';N{!]uBx*T;lSN!9vBEy!+†v2[q?k{)088?W Oc?Eou7k?#l:̟E:WD2{׬䁂7do`H5] {f @ RMdo`H5] {E3BtA.*DƁ".FݖPyZyT<ǯzjԫݸEv;awq)-q;HpuNs;1Ef$.)pEd)yR(–, [ Ad)RdK!Ȗ,ńR恂dKaHR@-!IAl) R6dKaHR@-!I dKa °- [ Cl)R60lbK!ȖRdK!Ȗ°-!IAl) I 0lbK!Ȗ°-!YR\?K!Ȗ`, &KQ0Y AlJR(, KRLB(Y fd) &K!R`, &KQ0Y #t?⻞;ž㳞c?eƃL{#9p"9y0ɥU$x`HxZ#9tFrGd?"+"~(Gd?~LCeCd? &!~恢( ˆ~l(Gd?lJ`, &!Ȳ~LC0`3PdP0ُ~6%! Gd?Y60A(`3P, &Q0A lJ`@~d?~cd? ~0$ C!A@l?& Ðd C l?~60lb!Ðd C l?~恂0!Ðd Cl?~6G޷ }D0 l5Ѡ?+H4 Fcn756 ]Q!@`4^Wz" <@`4 =ϟ)_u$Q?sFEO`4j{~f F?tUz^JH0>]*#h4-1DtqIFOpFF#!F3B2F"F#IGsdaHC=!iA9 sLGp܋u~pW$z#5>}Se|>G?DHZJ9\`E')®eSJ./t-բRb#zyksu_O e^XiɌ$A/szt[Q~bGsAu9yCW ^*L=U.9Bb{9T ^W:Bb/H2 g$yj#eP}*L󋜼LrL~^&Z&/"]eE8F ,xA29BrDm C5[c Fm!A5$G1lb[c ĶFm!A5$G& Fma(f 5lk Id[c Ķưm C#[cHFm f 5$G1$9"ȶưm f 5dk f[3XC5#5d92XdkF+lcy!ˑy`5#Lf֌?֐c Y?V0ٚNmcil>Fil>i~  I0p=^?NS1ތVpጴ6l~Jr8W.Țfy~E8BcQ}--^$V$8:4s$;s'w8/BfiI΃ϧ'Lp8_J:"A_A D:#աiI_GͳcnOG޶@gd@}Or{ 02ߓߧV|=,f0=|OPDC@'D tB@wh -6f @'D t ]NA:!Z;f @'D t ]Nh-6:!Z;"- a3Z;rB@'D t ]N-6C@f wh7(0Y-nP>a@[ܠ|dAYlqt& 'LhO,7(!K-nPC.[ܠ|dAY,7(pmir>Ҷ|sK ,`nnښ̡lPfsSGٚ {YtFaK)٥-8ڥR3ؚ]8g.mq;]v&'LviۡOCa3PK[}dYlq;v&'LviۡOC!˜-n>aK[}d.mq;v;d'LviۡOC0٥-nC9[}@.mq;6%&yd . ]2$#vI!%AK@l& vɐd %C9l.6]2lb$vɐd %C9l.恂]2-%E]ƒNGXq"+v:ǩEV"+:MG1  +#쑨)uFeO׸:#lYNߟ_T6Fx{Q? ƨ<ʹN^3F1)s\qNi7E~$HiIΩ)9GqaW ?#9 sBHpNn4_Ԫu#P(Src=G9lަ# W#h(槺g vN+`m~]s/w_`PGHKK+*ڥa99sR$PL"+&J&jFL#(ED 2|?V)p/2$%Ȇː .A6\$pP0.A6\y` p 2$$ȆK a3.f 6\l I(M !.A6\l pPd%Ȇː .f 6\l p* X/.A6\dT0p * `3P2\KRdY(L`2\@p 6%U0.Wߥ+B+ (6 ٰ?@,((쀋L4g"+gv)YiYi$V||IkLGV䊬92EؑLL>ߧHrdy|#+"ɑѥAGSMWuԊ#㋧9B7~ yЯHpd>9uZPGZE#aG6/WGVvde 5#ӓG67͏})ɑ{GБ5EG:`**ʑGVrdpņUd͆Ud͆)6,!'akޫ"{#佚Y^Iޫ`^+ޫ"kKVGpa2\*`3|^dT0y/ALޫ`^y* k{LK(y/f &%Ț{ *WdT0y{ f*`3P^lJK &u9LF^{fd%ː {/f ^eHI!i&A^ {6deRd{9BKp{)!5r}1&byp)byp)†K M"7\.EV #dppi"+6\u>5vEsgau|t( W|]Aw$.#h$E:6 WK]q 4l7G7\å^!S~^`=H2\>cKsTdp9R `0\y"+6\Y1\2|eO)*r>Ej΢"7#Kˑ "lpoI+?O)6Rd{9|ن1F s>M}! Odf >Ͱ} 4CW٧6O3lb&>͐ՄOd&>Ͱ}!+Ai I_ O3lb&>Ͱ}!٧ސ} Y_^0 &6yF?oj󆬯F?/|Oy 5VzCO#mG#G#mMZl#opѲ>f~sw.v&E6m}fFvorDG5Mtkn4ݶ{wvh{7dFv? 3{#t/TR$ػp?c{GR?e<ߖ`p"R2f~w#K=:_w4 *]=Nh.Ȋ;a{~q>G˯0Not;𛟲r֚"kNoH7E7͢<آi~ MțלH[pٻ63HpCyg!˲w &{7~dF/; Y_0ٻw &{7~dFoȲllF/;yg`w#7dY6~fdFo ; &{c&{gHN!2Awl 3lb{7aw$,d{'ΰ@ J=Rvz9ȊsΜ\qz8=GM^W"|sK8*^wCW`O'byYv;EV"d } T09MOyȒS|߽)aVi3"^b@E{WM{~e^S{Sa7\Hpox"Rl_ݛ"ɽѧiA6o9eu^`Ȓ{s[~&/7Gؽ_H)).GHI X6G޷lX6EزNl^Õ& ߷lX6EV,#hٚ;nɲ979ʋ)l ɲ &˖`ek_loYl"+Mro~ ?& N=!y:At@dO'Ȟΰ=a3{:At& ΐ< {:At@ I dOgHZL=a3{:At@ LnG!y:At 3$O'Ȟΰ=݄dOgHN= {:f t{:EV<" I_ &#G.OEV<"+Α|C<#xCVtFN#-eHtg V<"+U$eEwa{GgdӰ4Gwz{s^ 'Hpz^I^yӛ8p|W|_2T%<>+ :EӫyIN^=Gr҄"|=NNOn#;=EӰ+w|WOgba#gS!>dIF.-Y2roY1r^bA+NONO;99_rz8=Gwz8=GHM ;=Crz 3$&NOa3;=f vz IM!9=Avz Bd'Nϐ ;=f vz +WU0d7U Y|UF`rz#_UA09` m* |UFB~Z ]v+0w8+0Fw]f57u&\4}.CsD7u >>|L_~E fFsI3|"ko5ב7+;<9̅nOOdѯUvo4Wvo4Wvhɋo4Wvϳ+ޫȚzt Õ*r=RGVX#+p4Wvh+#WxE+85E+8ҕE+8=4wg8Op=8F D \3}#]1h2}IF!Dao+Q&7(J@|% F!붑Dao+Q&7(J|% Cm#_°(Da W(~'gHO!6A 3lb7ad'ϰO]V?EV#?EV"+.?G-{Y#BE+ {l* Y+ :ATd *K^)+y+zEdĎoY1A@S/+ b:YzyX/X{%>E3Ӧ??# wg=E S$z/&8d2}WHp S8;®p;?{Lpyy˞"+u]9g XAG 4$+(bY4YlHd(bY1}p9B NKNO.Ȋs}ȊsG'57?fӧȊs}7# 3|4EE.VP!I8Al 6d+hHn` d+h VА$ [AA$ 6d+h VА`lzlz,z ^4i&+x0d w0d+xLV𚮧_*ꚮ񇟲f+\#?]taŵNG3ؚAtLhu:f ^t4wA6Wn>D \tt7t^wt?\!YAC>p]W_{>^<#]lw>\ec.S>-Sd]l̋eks1O`A5_e??<6Ӈ RD3y+*"sG+ld2~Y`^:?iȊmt}ۨHuXm"6 wEFЬ"6NQ/:e nO*l# JG޷8Uȼ9QN7 y(m'@|ǢmgmTd6:mT$|2OPTdA:{3 w\qL2 4d(by3 y_*b& fKfR̈́/Y񕊬JGotd_=alKyJGX;9XLAKnSvMEVܦ"6 I% di:!Mf v6 I%NK7#Kʬ}UeB^ eFgϝlC-)lSmSmӱXۦ#Q"ۦ"ۦ#Q"ۦc MEMbAld3zOyE6#hWmł66#6wDܑl3^#,:Gx_kų* #$]5Z=mcCI}<=ij! Y=I<JC2yL${syy,{!{$ FP&gڇ ^3sA,5/u[GiH%?c # FX&c{$vҪ(0-ڑsawdy,{gi5X&Hg2vrWkrdžW^#;WkWj!ycC&4GLnii5~ F?d$JC&HC&22y{0)FS9SL~O15Q9*=^Ub~\~h*F:\;GH1mΑmΑdL3&ۜ1٦e:&T,lsdLmSmsd3&T,lS)qd3&TdJ1٦bd3&T,lSmlE_MGMEMGDEMEMGMEMbAl+t$Tdt$TdTئGۦFm_>7Ht R#lD~ll?X, R ґo`dllł    A*A: bt$1 ґ R ґO R ґ R ұX     ;4H`# R#pH0HP1hcjFŎ6j/K{&W =1,6~D6$g]B#|ǣ#;ף++j]Q1>=x= H4Hgr4NFFA? 5 r" 5 r}^Z= u淑`LmM#K0gm$$}# R#|Ƽ*kAAzAjcAďfk$>hgt~G;鑟8{A~DX_ =4W};R1Y< Z4ȏ}H-mHk9i#>wEt\Q#WHv\#]Q#WOXsGXw4 b~Z瀪tocX:+j]ёO]Q]2+*+:\ё\Q]Q]ѱX#1""#1"c vEEvEbA슎3fW|rȮ\O1+crW<-g䊯xZ_++i9;\Uށ3t_WuyUgߐW:C'z'TtcO_ ,!X|¢LoZֺ#앯 j =|3tەWqN(b3tg/ߴm':*HOR#Iɾ=WqNW>Y'8Yg~~x:I<_:ŏe?œ>$C<_͓uW:C~]Jg/Q<_ q5B;U*vHO<_y;mxtW=B{te%:hMm~H65ұM<5ҲMu׺6+ڮF:g{乺jky騫GX])[z C ZxҖj-j-AI[<$ky ZKZ,auuɎ(Տ^|GR=| :v#P#3s3]#-3HL=}-3kԑu|8F:!:**:;ԑTTԱX;#";";#";c vPEvPbA젎3f,!GvБrdv,!#%t䳄|#;g 9|bAGqPx3=KH#䠎=ũAժ{9ҩA%$OG:a~(6GqP񐚶9YB#T9YBh3a,J }Ux_pb6GqFFP<;;zm>m4ch~QFY|GmG~mNGoZM<[#h;{Hn_pܟ`yG6kQFlsiD6G4"TI?6/BxmnH)F4"tlsg隶9EYX"ж6GuFQkӺT#6G:hiDy~Fz9iDC~#;T뉊9 C+GujP(ye]J^9@YB rT5rtO HH+G:K1Y<РśbtP sӈY1G>H1)ȧsӈb|c#Fsӈ G>ȱXPȒO#r,sӈfdL_6f#""#"c x:x*x:x*x*v#S#=\<5⩘ijXuG<5O<OtS#H#ϷHa*IGw?h~Zzʹx3HL=~S=X}+ʎz䧙kyt$#%uN{Hwlj5w#K۫ӎj$wtd_RөN#_kSGWn oߗrܟ{ ~ =o羪z乯jy~F(HW=W5|5hF:z~W,\Z}jcau$]e>j-9gjc!UdUdul/>Yl~/-.*&-,XBXi;z U#uk:ꪑzx+uu$uUduUduu,DZbڿ|rG!h"k#i"k"kc \G7xd$u黣""#"c 6:*:**v#hQ4^6bal:51^<7^tW#s]#-HG?oju|hF:hGkFsGd%;]#-HGh=BK| Taj$ _ B;:Тj$:l~jkFPhו6vK4^ x;GPh>[$UKu7GPhaKKh= By#TH%y.BZ`^WŎz9Qjauu|5ҲXthb5>_AO;**:>Xt,#-V#aGiOtړbG]=\]HK]5QWʱXP#d{䓬b|bb$⇨iGuUdGqfUdŪYάWYQd4$$7-H'YiGqUxs;{tϷHb|(η~4z{VYη=W|+#lQi$&=ұأ8jݏ9m{[ͧWaGqX;g;cL{Z%_붰`k;OX=\ŝǯbjs$gZ4m~ĎbΑbjsƞbRoZt*Mj5I-sPtt$UdJ19A.1gxΘs$ 3x~ĎmG6I1?A5ҹ#ۜ#6g٦F:9Gz9Gz&Tdۜ166mNxO#:_ h7tT#3#=3#=3LLgLf:c2SbALL=3};%3u|n阩G(LLLLԑTԑTTj#\f:tX_w_51S<7StT#L#Ϸ&X#LOrKR5BZ?W¾WUǎzDŎjs?GFS|' f1SDCǎz乎j$念I:J>1O6tt.μGPG-s{AGd^=AG:=B<{WItwlsHGGHKG=\G5QW5TPo *vT#UP# #VA d>*8=}\Y_T8/HPAR#L|A\O|c2?I绎yyGP(tTpT#UP#sHPAY#"G|.}IA6=wG VX}B``d+&+,Ֆj?QAg5U0?SIoaK5QA~G=*X8TP#!"#""c VAGR*߷2bGHO57cR * ΘTPXPRw*7cRAEF ΘTPXPRAbAIgL**8cRAEV{*8G ?Q=6XV_gsga+1Y"[ gYFXta] Α ďر9>u]'(3Q#,3Q#A#A㟂8Gz_{ 6]KD܌Q#A%:s?ۭ vGX羚uƑF k$ "}#wHO599%#|_a~mq9\xO\ZuGdA's$ " ;FȀ)s$ =AHGHDE ΘQq$ł ΘQn$,9Dt5q9s9sE|68y{{$iukqDu{n6O˶^?FP/c>o{侍m hFam3dj#Gڨ6^##3iڸGb# mFkAm"kc~hih5XjAwLژ6^m,hOQ  FA"ߎh;A^ rG4+ B `;A^ Rc{$dwlx<==k1Em,kwDm"h㎨;6^1ikcYX|6^#k666^#{;6^qGQX,񊠍+b+>wEt\#x슊슎䊊슎łW HȮHȮȮX,]ѱX"#ќ"#"cDzi!5\_=5qEt\#䊊슎䊊슊WsW~Q#Iq甘k+jyk HD]#䊊W|:oaFu$Ww~Gv6\qY8տ#=\n#ןuF#} Hv_#]Q#W\#s|zﮨ+zY{q鸢Gs;6AFF:+z+j$}:x,mksm\#-msmkbG=\5HڨHڨX,QёNёqΞ{;AzAjc Y-cF:鑟ߑ /K`T$+I^YH^Y趼R#Hw#ϽR#H+=B<^H^^^X,ґrƮWx3Gz^993;&+Wx%+2xGerL~ 6Lܖ #ۢȩ#пL1?.8x۲Gz^9s[? |nˎ=4}$t#?h0QE_152S<7SgQ:F**:*: bUdu$`Tdu$]F)<{cyna3U옩GvFEQǎzzxHHG<=HK<=\<5Ot#ijZXG<5Ot#,$,,?~ΘtG=# G>G1OQLy{xG#x{x$G>G1Oqd<=,G:1NɿGltͣxl$G>G1G1yOQL^y{WG#^ytOH+|bb|k#G:Ǒd#2G2ȏsAyIg>uY7 Hg3ȣ8x,M<'hgG (N쩞A{<y{ |bb2#3#3#|7q|hGYYIY6ёpOёpOQѱXkc FEFGFEFGFEFEFG z^M5Ft#ϵQ#msmHG5J 51HG1OQL2y{LG3x{L$g>G1Oqd<=,g>G1Yؓ2yV'=G#=<=I&|bb3ؑɳ8~dN)JO&=Y, fq9s|h#>^ym#ǑeN$Q)g$<<eL8&<3t'7dޔɳ{Fz2yvOY#MCǑeg(&<:yI&$g:o'=_$?eґ #)6*6:6*6: bm\1h#"k#"k"kc FbAϵqDm7AmMtQ#mi"k#i"k"ksmHG=\5Ft#ϵQ#msm\#>HhOsWHpy CY_8W\\=}]qJɗ|F+{#%0|3]w /WĽ=®H=®8tm9nO2"iGF+aQ>®+[vEG5Ŏ z j#G⫐+.,AsA\#-A b^XDEYEAtd+t$Sd+Td+t,VX,PБPБpŖjcɋoGFXYIYY./OcG=\5QAtT#UpT#:騠GHI?"a"I#G$Sds,zz\4;ӻ9)9))9)9 b[1#a"#a""c ;bAwwwwwwwn$rŷN#9";#9";";sH<4jtyt8G ~κHGz৑w:w]#w!nC"]#IO?hzkGX/rK4zHz?zһO%G,G${Sd{S䓪YѨl/\K4BV?hoPK͑PKMͱX+c V6EV6G*EV6GRQt][R6w}pʷi_G͑i__d3nOr?X=M#i_gixyI7MeHGHOHR6EV)͘mƤle{$e+Ʀ͑͑lZ3&eSdԚ1)یI%eS,mƤll3&eSde{Ǩl3}ļ X,(i،IYfL6c0ş ͑͑i͑͑ixIfL6c0Eְ) J6c0Ŏ͑i5Ӱ愤aaaOaaaałXV HHX,5̱Xk"k#i"k#i"k"kc^G Brdr$Rdr$RdRdr|VIjEV+Zi$zZi$UX:\#Ӛ4)O>H)$y[n#SO#Fا 7HU,{o#sAB#4aU$H˧<ܧ4#}J#Tabǧ<>f|J#SCbr$RdRdr|SkSySFا٧٧٧O9 bRdr$Rdr$Z1"c^P)bASSSSS?TBpsHǧ4)۬))Gz}(QX<#""#"c 6'E6'椑9y9o/zzyKHHHX,%j Q?,Q?,Q,QłXD)D9(D9(D)D9r HH\4$ _=E࣑$Q’D{DU#Qy.Qk$HbG<|0t$#%J#IƯo#A]<EMi$H|~A zg,H5{{o#A3a4$>3^6$ oG[#IkuIGXXK<\4$i$H4)<)t|J#SSSSSS?}jGvRdGr$QdGr$QdGRdGr,ĎX,IɑFɑfHHyA#)#9#)#)#9\P)CGr숑F:bBQ>"ِ"ِ#+c V GBEV EV GR EV bA@@H#y4c{Fޕޑg]WFޕ^1yȻ+&yWz=#Jȼ2+#Jg]+bwwd^yWzG救wWL3Ү;Fiy=#{F'ޑg}>y(3}⫅%)J{FO|U ky9}D=OG{s{FOd]^tyD ޳ fzQ:}xG<ރmi$y]k='kzϨϿMi|3*=՞=#){F'#2#b~1zH;&iȼ2+#Ѯg=Gbhwd^yvG救hwL3{Fa1y{;2bQ_?3󻷦^ati 4NIF\1)Ȼ+&ywsGVw7w,hn=:ߤ@@@.@@@@łXV H H X,ȱX+"+#"+#"+"+c^PP Ǽ@@@@@@@H#OqxFTK q$ϷP_#-#qp41bhǡI5Fv}x >rd8/ߧx g76 wM4ܪH#pm>ƥ} 7wH0g>†Zy V#H2sH2:sHp4†HȆHdȆȆHb0Ǽ`8l8D&l8D&l8l8łp(8(8 G 1/(c 6E6G2E6E6ǟ _?d8hc8!2Y1#""c 6G"E6E6G2E6bAl8l8 G#>S%á6= xa5S}\# g4 g\ gG4+숆#ppĆ#LvDù"Ɏh8;\X숆sE pdȆ#pX, gG4+숆#.~HS]К=КkpD抠5;ZsbA5WfGԚ+ZsbA5;\쑤5t}'Έ@_ g}d2>;&qጸpFL&#}E&1Έ@ g}wL3>Wd2q+2pFZ1Έ@ g}d2>Wdqጴ#GdigǤ5:~͎=hˌ_G(vf.3d}u[ueF3spQ\f;3'n#Ε=2 .C9_#2iIQL\#2d{;.CBHreF3s3]F:.3;Q\D) Gh̼G3I`Fܙy$0#|E`yAQ`FA #|EwP1 ̈;(fwL3Wdq+2xI`FAy$0#cwP"#ƈ;(fT;(׏b꫐ԯR2c?" H";&qI`F,0#|bAI`F,0#س6%Y#Y"[#ц"["[#Y"[c 8m(8m((8 bkq,֢HH֢1/(X"[#ц"[#Y"["[c GEEHT^w=/TE#*?G:VwUHR|ߨf$UYKeGXU| @\T:]|UO쑠*K:}U>~Gv8 mG4UerkGF7}Ivh$J~iF.N#ϭE#k[#Y"[#ц"["[#YˊZ󂂵(8m(8m((8 bkq,֢HHbEǼ`-łZZZZZ|bA$%l"D+q$QdQdq,&H&&H&&X,MDMh$zGDfw"w"w1w1w1w"w"w1w1w1w"w"w1wV&r݀wL&r݀q݀&r݀wL&r݀i_d"gڵ#Nu,v %go03or;yi^ǞNs뮖>&BH2y"ŌlW_GT GR EV GBEV EV GR EV bA+p$Pdp$PdPdp,JX,B‘P@‘P@B1/((c^PP EV GBEV GR EV EV bA=B<\)HK)4J\)4b^#HPca~pF:JT :7f8RxoHP ܦ#p JZ#I)p/]J}$(z7X#I)Ш#b}2RObRtdyLGFTLJ1>+FyLŤ#(0>#b}2RObRtd}2=QQW*OG:J1}2q@RHO)FO&+Ũd>OBܕbdy1]5/?bdku}'3d}ٷssAF4ϯWc9b}G֧ƏT FRʦRbbtHRTLJ1>#(0>I)F'sŨ#b}2F'ӑQ`}2RObRTLJ1>#(0>I)F'S1)d*&yLGFTLJ1>I)F'S1)d:2 O#+d*&yLŤ#b}2F'ӱXPRt,b}2gLJz:%p$Pdp$PdPdp$Pdp,JbP GBEV GBEV EV bAłX)Y) Y) Y)Y)R8Pdp$Pdp$PdPdp,JHJJJHJQ "JkFR]A@HP/-ysy˃#Ƀ"˃"˃#Ƀ"˃#]+<(<8<1/(ȃ"˃#]+<8҅"˃"˃c bA,,tH+yPdyp X,A.YY<8 byPdyp <8<(<(<8 byp }EEGWdyp,X,a$xGEGWdyPdyp$yPdyp,bGWdyp }EEbA,łXYB_.YY<8yPdyp }EGEEbA,$,,$y]vx'ğ<<.<xG{F:GxN{ayFG h$y}f#x'~C#A)謐kN$#I)@WDHV sH#sHP bt#ϕB#+p JJH(JH(JJX,±X+"+#"+#A)Y)R8 bPdp$PdPdp,JX,B‘P`ŠłX) Y)Y) Y)R(R8 bp$1+P EVR(2 ̘bƤ3&P,R(2 ̘BQ`Ƥ3&P,BXPRR(2 ̘BQ`Ƥ3&P JbƤ3&Pd1)ŌI)%Pd1)ŌI)Y)f)FP)e{$* J4Q9GgGk쑞RhsA 4N#A)RuG 95A{kh$xmB;~ro?M#~"\4ґ<$yȯ(򮑎|>򮑊IF5R1iȻF*&MyHGxyHGxyHŤ #4a]#&k#_kb҄wTL0򮑊IF5ґ/G5ґ5a]#&kb҄wTL0򮑎|>򮑎ł&kc #9c҄72i#i"k#]+&(&8&(&8 bMX1h#]+&8Ż"k"kc bA tȚH yAA&(&8Ż"k#i"k"kc GxWdMPdMp$MPdMp jiF:w!x&h y hF&)4Ri{&h5oHܖ# xF&T%iFX~ 3V<\4š7i hG]54A5A5Xk#]+&(&8&41/(h"k#]+&8Ż"k"kc bA tȚH+MPdMp X,5A5.YY&8 bMPdMp&8&(&(&8 bMpwEEGxWdMp,ĚȚX,54aƤ 4IY]5A54A5XkŠ ݈G~^ҧ<!yW!Hy4JJHJJHJJJH(JH(JJ1/(("+#"+#)"+"+c V GBEV EV GR EV ǼRhyIJAa4Q t#xzF:JV?bn-HP $RНIJQ<ՓbƟAϑxG+FX)+F:JRxP@‘BB±X+#"+"+#)ŊA)R(R8 (R8 (R(R8 bp,JJH(JH(bP EV ǼłX)Y) Y)Y)R8 bPdp$X1(#)"+"+c V GBEV EV GBEV bAłX)I)fJq=Y)#|TLJq=RyGERH;A5GRG529^I)bR#%{I:2 y/IGF#%{I{I*&8^GKґ{I*&8^I)bR#%Jq$?b^PS)(Q.bȠG5R7N=]#v~R JxqHR FR09il!GK5_cIJQw"\q"1$!NĐ ;Av"@D IAd'bHNdD @1$!NĐ ;Av"@D ؉1$!NĐĀ1'b ND!)Av"D ؉6d'bH bD ɉd'b NĐ ;Av" ى6d'b NĐHD^oى) +ɉLNDHD95EЉQkND+N"ɉLNDHDىLN`r" &'" `r"E'"N`r" &'"N`r"lDa'_HE9E8$'"NdHE9E8\s"_D*:KEA'28}"ל"Dhۆ"לHED'LE{*A)HlJN?;ʈN$Љt"~l( ۏ~LC(A ( ۏF!`, &!Ȳ`lJC(ُ~l( ˆFQ0w"$'BCDha'B~GD"9NdHP^q"#H>D'_bDC:Cl? I60$!Ca3C l?~00$1 9<"W<#{E稦{*NJ\|t\dq؉"sP$y)$Q7j=h$ϑcs4KC+9sVdaHC= {f s0$1`y9sVdaHZA= {f @9sVdaHZa9s恂0lb!ȞÐ {A@9 s0$0`9s0lbaHZA= {C 9 s0lbaH`szjȞc[O Y+y`sz*<ǜ ^s4-Pni351筧sy`sz*<ǜVSC sz*<ǜ=ǜ &1筧Ԑ=ǜ &1筧7\1|n4b4b4A;(b4AAhH04?ג*~)#h4G? җ#rh8P! A6l4 I 0$!FCa3 Cl4h0 w$wA+ b|]8P䊻pE݊UP$ $wA2Aw(n=q~"Wň\r|.awaHB݅ CR. ]dwa T Av. 0܅ CR. Idwa °݅ CR. I ܅ w c0$0`p sEM֪HkNwQ w986QP$$@K&aP#i*lBi:6{\ #r&8MPm!A l M0$ 6Ama3C*l&M0

` l @&6Md`H]m f @l&Ry0C l&6M0.6Am!wA @l&6M0$P0ۄW56AmBdL6` l & l M^0A.M(l`3P @&L6A{dL6` yh@&L6A{d&L6` @l"hBH o!k"60yA+ޠ`WAE7ao@V$yE77?+sE$oPe|& *rpb|Bc7H&yցk7P7H &oP0yA7doP0y6%o 5`7do @L@kz Lޠ`@6%oP0yA7䚾 &o @(yrM/A 7lJޠ`\W {L@(yA7( 6%oP0yf `z.!yAT70$o RMdo`H5] {f @ RMdo`H5] {oT 7X>]+`$xT opP$yoH7pso{C RMdo`H@ {f T70$o0`y RMdo`H5] {f @ RMdo`H5} 恂70lbo j {A@ 70>` 70lbo`H5] {C 70lbo`Hޠ`uI {C 7do` ` 70.@a3{f  70.@a(x|X"W!:B]:ajv Wڹ#sEv.ܐڹ sAnTR;v.ܰ۹!aAn ڹa(sAnTRv.ܰ۹a3sAnTR0sAny r;72,\۹a3sf n ڹ!sAn Rv.ܐʰ sf n R;/|_.|o R;7v~ܐ6Q; |/Æ R;7v~@ڹ!|/Æ R;7v~y lvnH˰!|o `3|/Æ {;7v~y l{erv~p;ޑ۹#CvHh簞ϾCw$>7y-AC &&ϑϛoHMo!5yCj^ {7&oHM{q6&oHMߛ`!5|/Ά8R7&@!5|/Ά8o!5a?f j8R7&@!5|/&Mސ!5l&ِ!5|/Ά!5l&M^pi;rvo\i&O׊;Mگ"ɯ?8!M.W$5淄&?VZ.p0(r;yW|#M rg7.ȝ];!UdA rg7lnHY; wvCn ];!UdAT rg7ln ĝ];!UdAT ];a(tvf " rgn ĝݰ; wvCnH]; wvf T rg7,ȝݰ; wvf >}uȝ}J+>}uOi_aSWw\"Oi_aSWg:>}uyJ+>}u}J SgҾ<}uȝ}J SgҾ:٧0u);@SWwy٧tWǝ}j٧f_|Q!t;5`!rOi~Kb٧f]Sۮ{]Smw٧OiaSbg:>-v :>-vȝ}J[0; W)m;@Sbg:>-vOirE<-vOiaSbg: W)m3L}J[ Sg;٧"Oirg;٧0u)m3L}J[+`3PSbw@Oi`?k;Iݐ: wvCȂRgn ĝ} " rg7,ȝ];a3wvf " rg7,ȝ];a(tv

`yREnHY; wvf @REnHyBg7l.ȝݐ* wvA@ rg7<` rg7lnHY; wvCȂ rg7lnH`KWgȝ} "/y_`KW': ξ}u\ΐ+ ξ}u/y_`KWgy "/y_`KW7`KW':rE^:CKW': ξ}u/y_!w%3ξ}uW: }iՅ4B\}u/;__qHܦf_]KWI.3p;;^̠ȵξtصξ}uȝ}ɛ /y3`KL':7 ξt@/y3`KLgȝ}ɛ @/y3!W%o3䊼t/y3`KL':7rE^f:CKL':7 ξt/y3!W%oL}ɛSg_f:ٗΐ+7rg_f:ٗN0u%oL}ɛ "/y3a3PKLg :7LzRgnHY; wvC :!UdAT rg7ln ĝ];!UdAT rg7n ];!UdA rg7lnHY; wvC @ rg7|/Sr9]8ȕvW+9svER; |F:,s9W$桼G$sCj r;vnHeX۹!sAn Rv.ܐB;vnHeX۹!aAn 6q;vnHeX۹!C;vn ܰ۹ sC*Â6q;7lv.ܐR;v.ܰ۹!aAn r;7lv.ܰ۹!󂩝?ڹ!sAnT r;7v.ܰRvnHeX۹ sf n@RvnHeX۹ sG}ER; v8WJ;wvȕv>"R;vnH\۹ sC* r;vn ܐʰ sAn 0ڹ sC* r;vn ܰ۹ sC* ڹ sCnjW$+rL\y v.e`j v^0sf L`jW۹`(󂩝 r.ڹ ႩL\(sf v.e`j\Wy@ 6v^0sA.S;/ڹ`3Pj@L\ c;v^0󂩝 6v.e`jS;2\0sf v. ڹ L|ZVjRv.ܐڹ sf nvnHeX۹!aAn 6q;vnHeX۹!aAn @B;vnHeX۹!sAn Rv.ܐڹ s'_>Dž_p',5uj'xUrΩzچno{lZ{ =~^kTBEJ>ӌd-LNkUz㗵Ez~KIuo׷} ~j~|ƒ]w>aLxxCk^u66jxT^/zSu6z,֣o`{~S}@z}ɲ:A3a^ gܾ&~ݔ/O?0I3v^$QWGf|=aoEP5M[ Q3DpkGXo^Zo_r}&Lpx ޷/}Pzuކ0zCqw=o_o8֣zzvzl/2/xL~ƁzNnb:wv3뿁>^|35W# ކez^8~=ދpzxvoʸ&@2xƿ&!Ꭿ}_#04Mu۹#4WݤTNլ:㎟ޟr OxZhrG'=دx!kk\ٯqStǪu}sHWz5|LxPV}!sMX5~޽cZ~Ƒa=}ZS i~}py֟_o-aNo3qmG\^?z\>G_{zV=Nz=]ϥeu޿ReXjus\z#tn-{>Atz+ys;ŧi:??K?On5?󼎥ag5n*kn'~;y>W~շϚuj:/{yux/52޼2=e}mzso ~>1G#~?{|=}U_[?ר˷[Յ@P?_uM?>Vy_㎾}=|͇ˋ`Tb=f^/sx_?׿xc8sס/~ߓѤ~ݞ뻹1+}~}﯏g蘽}We?iԹW=\_b=9_/zۿO1~>z_vdu_Cws-~NA]au4Oc_߇ӆoחz+}#M;ҟ Oh"@t1|c f8E:.8gv=a + 3 oV7)\fyYNp_h8UO/"4\|Dn/"H; op_dH[:|e/\a8E~8|x{۫Ejṡ3|?bo892/;Dt\ /5H|y?~W:h[-y?HW֝<~mzbپWkn2agREnpI0\z7ry+mzJԘp~I#O7K/WͪZDnp LCy\Fn[&8M/3|4oW`~gټ tҼ tt3|c3K2|2iwx:||sg]ܜ?Kɥ|\ R?>^ m :9 >Sa|X9@톏P٢=ù9-t%!]InuȇטRL`l) &KQ0Y A>/, [RLB- dKQ0YR`|+,Ed)RLB-Ed) &K!Ȗ`l)V-Ed)RLB-Ed) &K!Ȗ`|V0YR(,`>EKh)`̇7[+".r |?E"]C|#]jV+E=,bCAUEjaw񬗤~kSų>̫`9FOj׫W$1gr`#.ȭ F:gݍNf`44>aѨ3wsU`4XnH0A(FyRp>bvDh? sGs٦T$9ɉ ;ɉLND0F'R09Av"d'D &'"i ;ɉLND07DsN`r"D &'"N`r"+NDHDىLN`r"D &'"N`r"̇DىLN`r"tx[ƕDى1$'"ND!eމ!9Av"D ɉ !9Av"D &NĐ`Dىd'bHND ;Cr"D ɉ Ȳ]hGNĐ ;Cr"Dىd'bHND ;Cr"D -814Av"D oDYdJ\4%2P6%TU ~`!rt0.E?K,A2P;(§?+Y3#Ot+ :Gȟf7z#jx-uÇxY;)Bd#nzʯ6_ls\ %[؟yݮ_'s=uy?QORn^'ie:'p'K,慜 SG>[H'xL9"I>ƣ?I?$تU|ZR  C20l` ,',1|5dcHF _1%A60d`d3`00d`dl!cHF !A60l` 4C20l`¡pݚ|Ofh`6f``6fh`vfh`vfh`6f`` l A40;#l l l    ! !    ! a>dC8A  !8"abCeC:ezQ EH00l[ |޺E}unh^C,_#Luk)Q\=f"d`Uv:دw~fZu ==v-S9)Գh"ZP5mv-hts[$ik8t--\}H!\Ksy7 L~'aAe`,;تl*DVehUvVehUvVEѪmlѪ0w*;̝ѪѪѪU!X U!X U ZU ZU Z U!X U!X U ZAuJdU &"V`*UdR0YA*U) [$"V`*U#XdUV0YɪU) [ɪLVEJdU٪0ZɪU) [ɪLVEJdU٪LV`*lU &"~x ?"ɵ0A>m+H%@V L?E/Se4_2\&* z$/#'YT$xfe "ԯV=H놟.@#eB_{dL!/sѹQe{"e~9d"e~qW&\3^Dٚq7l&ؚ:9[a[sO.[m)BQU#&"lktW-sl} )l ]G^wl`kSR{mM< &5lM'/TNEo>z$S0]/ӌpT$Shv &#f`2;lvVNdv߈ dS0^͎`ELfGNdvLfg)̎ LfGNdvLf`2;͎ LfGX%#fG͎!A6;lv 1$#fG͎!1$#fG͎!L͎ C2;lv dcHfG͎!dcHfG͎!A6;lv 1$#fG͎!A6;lvLO6;c~ږL"W|"䛔|?+r8"`Q$Z@GO3xa߃8#{ EেH=(o!3i~na^=?QR:F ՝"{nyԓ|>=.ܪ~=:?~{ԣ?{n?QX=2J> g|Є_s|[%E\6+%mlai B4[3UcDwg"M!c4CUS$P{x1]!c3֧n_?{nţ`}sw-}=ӝwǝ<G}ס^Oct+?[,x\N1i|z!cׇ)H.}61:Bƨ{U&c$ӒwuHc!H2FA/i ƨ9'cԼYDcĒi{wO4F/ 7oQ(K%nE`HK܊,="0y%nE`HK܊¢GZV &ĭ;dĭ;dĭȂ#-q+GZV &ĭ;dĭ;dĭLi[7<"o0y%nE!LoH#Gd$ɐ< {$CH#G0x$CH#L=!# G2$$ɐ< {$AH#G0x$AH#Gd$ɐ< {$CH#3 GR:CS~K0QxH2Qt:"D5%^єo~$LT7B2QtگH2QGoGD@m`[)L^k"-L^(Ǣ(]QrڻǴ]s#dEDݪY?SLwcYB{z(%zm &q};GD} ܮ-Uve0Q5nuq鷰qy#dX0QӎasM"D 9{ASM~"D5dXI`swByH0QK.Gr~*+F?jޮ2z:>&H~? ~JởJ2lDdkeoʐ [+AVke;_Vl Z 2$k%j` Z 2$k%J!Y+AVdZ 2$k%ʐ [+AVtYϟdk%ʐ [+AVdZdk%ʐՀZdk%ʐ`l &J!Y+AVdZ 2$k%ʐՀZ 2$k%ʐ [+AV*p(B.+8oa%W3_U%WU~I.NfG$,:uO>L.!,ltYX . "x#'F߼Ip#p"e᧗ .G]x#x"eAU{UeDb1HpY2lyX~:."z\֭z|tYo .Kl|t7uza=eauC>zԯ4,ŊҶq] .9\$kD:B.;Z&:'BE?|(\V\`pYͻ"SoZ^=qZ3z]߂O=]v}g3~F槞^P^V~gmDuC>}#s&Y7_2gtjH2gwG؜QR$3\H0gƑS8Iv9;l##n w+Ym1 8̟WwuasF=ʊbD9*Қgk:GsVguds66~c9+j_d*R<%3L`|SLNn>x8~K0g֬oas9Bo^E؜M[{`p"lF$!#hƅ_s6}}3#tM`Κ#2g㒶e9#[R2gx}#hK^I,# $9),GfHL0838#'*0SCa}I@G֟s&0` s L͙!3A6gdٜ ̙!3A6gdٜ 93$s&̙̐ 3A6gdٜ9ds&̐_~lٜ9ds&̙̐ 3C2glٜ903C2glٜL͙!ٜ 93$s&̙̐ 3A6gdٜ903A2g}i4Ci0_sf> ORI>NAiW|#7 "aoX[{sRE{Iײ_dY6r5S#M GaQ$zOLdhߎ#)r9SʵlkƇjmD[R_t'ȭ~a"W#9EZ#w{O5rc/Mr\@3toT$s=NGdp;#h´a{,Uܴ:# F$99x# A#W)F/IV$1<#h)z?GE܊#׼##g' |Z!9d ]0r^2r3S49zft}N=!37vxrzK*¦ϐL >C2}l ϐL >C2}ldgHOM >C2}l dgȦo^W0 +L_dLOM_d &'Ȧo +L_dLOM_d &'Ȧ`2}l &W0>A6}dӷh &L IOLOMT$>>9SM_[+L_VЕs|!;>Hwz+ 7M6%OG09\#W\E촛ZkFN:NF"׌"Һt"a#7>Wپ4r>4X0rU u\4r5}|ߒ\}g3?ȍ2?|t_.}Y#ͧK߼_E\#H\=:'E#Wd䚇2p+FNb.a#S˺v?G^2Jqz=mھc4rL޾4X0r#w8BF.I#$"hl2rx%"lx#dH0r[R2rZEO*>]߿z y#}@s]Aުf[՚Sdht;M!ٻegVrz-|E`rz^wIN]dLn + ۻLN]dL`wl &{'`w${7Ǔd 3${'N!=Awd 3${7`wd KHG>"l ?"ґQd d+(VА [ACKvt6BCtxHV Q`6t&Dd2&ۊW`%#+ &Hu$DH-ƑϽ"+*\{I^q<+:ߪ@(Ua|pӓ |.rUaQ SqzE3=h\1A3>jH^Fu# Cם  q<_RDS"lRtCH2ͱ$D\H0G J9Y`o2C4x"lY::" ╃ؼ&ؼ]'؜+  +dh q0tНF، b$AM"\h !f+^Q}qDA;?@fWd_iHR} JC+ W d_iHR}!JA+ Ws+Wd_)ȾҐJ JC+W0JC+JG>4^14$3)fҐj IA6d&LT$I|'u$e(fҐ$(rL*Bf74^зl fψ!3)$:T$]HoDBp ũH:,YL|# (Y^.Tt"WCu;E_<0v-{,X*s=:8Eb(,&~#h1 ~S F$YLZEżu8Xz(G ::ߞ{9dtߴ]ёw*rɎ|n1b1 ͻ#h1q"bցGbJ~*,]*Ou=k S)޿q1YqYI|*,&~d|Osۓt,&OE#ħ"bkFOW[:'{oyI9@ٟ# S&ٜϬ~KroIn3wKnSpudElciTT$6 ?w\q#ܦ!MAv6m 4$)nӐܦ MAv6md)nӐn`rdY0͂m r,ܦ ͂mLnS dY0͂m!GHrWf<+ ςx r*gd<xLS /ϊ$金 ISH0s4dBAmI4EEZk"<"T\HQIGЃQA0uop\y۝"A׶\=#Z~?a<;=x<zNi>%:+ע(hݍ?zJ[u+~)t,z;Z7"J\kv"Ɏ>W)v[Ϯ""Sb.ww3MGpG>?*rŤ*&ՐL TC2lR٤IdjH&uK&U+&6tFTC6憒I=@JT0QT$;J笎7tT+tD.];TLQ*rQGpZzGI{\1\1PaT܆H0YEI"k;#hR=_]&)Lf|lAZo+&zdR &#hR>*ҙԳ|u$LQEIj[8GФ~')r;aZZt|rɤ*rŤ:IU$TGtB[C|''J+:G$=;cS[M*~^`RX0S`Rq"ɤcr4t5"6oɤJH05Z6|5#xBW*L*~_`RdR; G$ڜFؓ_~KoI~5wWsa 7ĶVX6TEէMӋ~~:"udjHU [WCl] ɺ udjHU!YWAl] ٺ.;u]wu]w&Lu#뒿ǐ뒿ǐ뒿Gu]7Ӓ({,[mI%OK!CK!CK!d] Cɺ.h]{4Yp)KmD$aIF?Ӣmn~pͿrU#xUk[o.ztIg􇩯yHQʮs}$xVE(u mKH,7"Vhs" rIv~i S$ZjcEUuŕC;΢ƥs mɏzͧ%z&o4S`h]oD*w:^Jߧ~K0U9B^bqg>?֣-Q^jz\%zz$C;ik⢡]oD vi)%#R2KFdh]oD v߈ 풿( -]H0o4a<"Z7H0P/e$Qt*gm'WÙG!~ڬگd%$B u<)*&"ԽHZY*Ah_$ mqz8BV )W#WT_E-n% m$-n'WTH+uRs&\',W䐅s&\'Ih[JGR]AIŅުt$Օ}IUk$ߺJGR]ٗTU:Jq+Iue_RUI:FXUIŽ \aI屪2$uދyOZ*$I̷;0iq̴8KfV%iu+Li*l 6LC`3u'id8DtttV:$U:tT!BQ YG*dU:tT!CQ YG~|o']! QGtt+DC! QGW:z YGttIG፾* +:* +:* ];:TUA3C0 %u(w#ҐԻ-X{W}uU*W[iꪠ! WW|Tޕm_]zҪVbv,l[4fVJb [,,Q]`c» [V%X,Y B]`ջ;X;HJXڒqUŎ~z`[%X, +hM9>m &X,X}UO }iU KyWbi[ ;X&wUjoMI;iX]ٶUiX]uUJbʶŮJbʶŮJbWaw-*X`]A-_·ŮJXZ{Wbh,zWb VW%Xlu+h JX]SU [J┐-vbwbq+ ]Zhwm,8`$Zl:lwH%< m+D]!ۮmWnBt;]!ۮvwn{ Y+Ln{ Ywn{ Y+Ln{ Y+Ln{ Y+Ln{ Ywn{ Ywn{ Y~s^,ܬxӴiam4c@+M!SVS~tVgoUղw4*t^iJ[Ț{[IsBž^iƖ4jNZjUi;pWXh:*fl E#W'W1c+\u^[ګ3UBx^΅s+̠Ua };N~y$dW%m+JDy3h7ջBKkrW%퀣ez+,]AwpBfJ1' ՜uW:B{U3Xh挭U B;1/eShbּS|Jj gl%[sÅ;îJc߁ګ*flUIB [JZU B;+z B m+ x U H|3hBn%mXp3I4C\-{x]_\Dܬ_Z|ګU\Ю0Z앦i*݁W!}Wb8yb8yZ?v+&%jgw0igw!i#iB\Is*duH5!iB\Isg4!i JGs]\U:ʾ\UXsg* !]OO: iB\3li*Iawe_sUI+v1oq`U#]7^Ux* ê:-/n%)quխ4wqWXTU!;~ QCĴ(וB]tXBjĪ4T+H%%kkJPρ6=C}%s?>+k,)1mh*AiJ<^sWrPb܇஠Ϥ cU{}<+J<?=: +QcLX$%ߪtؕ}%VĮ+*%Ītؕ}%V1?lU:J QbWXQbWX5*1-uaYŭխD;'$Ɏ Iurc\JijeǮ_ZJX[JǙUagVqfWY3Μe308Ct*88Cv,"3;̵`>x}Bg}ve_Ua}vHY!C?_WI>+d}vHY!Cg^UؤIצ+?> sT[aRmR%6}(BTkWZ_~p߯U VvT[jBU! [JG]aίŋڪ.jڪj;$VQmU: vծjTήg3s̵_; iת%ˮ*V1]"*vzm_ k=z܊,^ 5$mW>x^_z?>*U ~]Xk*ɯ_縭ۯU*ɯa껲ת$_תtzVZ~>tڕ}Vת%ˮ__*}(T+~JǯU+?!I[oҳLFJ2ifW$:a&M 4^M`b4| L[I&OI+ &]\LZ`խtLZ6IחNQ!v/ժT+dvH+h" ` IwcҪI;$V&M!0!00e:,8ㄷ;3l羭g1-|͹o39mUz&}ƹow13MQ >3MǣlΓ[&}.^I8>)sw9q>i\>+<칷g2gHObN]8?9uLg1dҴѱ+lҴѱ*=>9u4fUsV%4_gŜ`gsN]Y̩'iyܗ`_'@!g1nJGD?>ƪ&>Dgs"ݪtvAvR{>y"o f>DM6ID6i<&}3ڤ|1tq"L8mYL+NIiN]}4鳘^WJ2|YMLsCu+$}/IѤ8ytXOK~]< jiޯjPkg}|+L}|.u+dV퐬[![Bnd ٺuӓ V_^%ஐ+*we_U! ٺcݲnUغuWxغv[uB֭!Y [֭J;uG5Ywu`djGQmUXj+쨶*Qڮ쫶*՞jڪtT[ڴƕ}Vڮ쫶*ISjBڪtv.8y*AǓCƏGTa*?~T|m1A+j"jܪT}TmThUXo[6{<6Ɠ9?3T{q[?ښ8^M~=+JG]S==fj x/dڮ쫶*Vڮj-vU&MDJP+.#oVTag+zZaC/_sGrUJƓkӮT& tZ řf ZaǤ]y>o+& [\ > 0sq|QEkgQ%}Q[+JG]!}V!+8BgI>+d}vH>VZk^djteߤgeҮI+옴*ɤϕ}V%ʮ#ժtZjRJG]BCkWȯ_;$!ÎTR$խtVeR#ծT JuFǭtT[Sʾuڕ}V%X7qVj~\Noݪ! jf 쫶*vU6QڪtTەiQU: /UI=kǭ՞{Rc~Ty! | ˋ+I55T{1wzVd 6xҜib~Yi&c~iRc~i~c~ yžuT{t:xlusӺLFZaϤj&#YvMdC(tu+=>b(f2Ȍ}kWwV3ѕTyR#FXTդFȓTŤƀBG1q۔߿?n5z<#ZTpYIR=C% ?ǧxY&ƍHT R=?*(ͥX|Y&JbR#.vV%I5QLj9vIs3LJRj*=>Iq+,WoJQLjčCTIR|q+>ҤFI<}1/ziWXiD>9<'J5QY Kbbu+ɯi9U:~}t'*~}ىER\(}ÊXJ#MT!^]BpFJxLb=cGG!Ywq=>FV[!n}䩎;)Su+dvH֭[![CnlbJuұnWغ󭴬nV׈+lŭ7+ڪj;WmU: ŽjQmWHj;$՞aPmoP׮dT%u~_V: CRmVڮ쫶*ve_UTɨ0uq]]_QBɕ}V#ժtXthרґjUXyg\WP}Ѻ XJ9TYIRcU R[fR6RgܴG.Y ոjTwUTwZx''OV#ժ=]ٗjU:RʾTґYiI+,^5zC]ٗjUTϏRJj+RJj j D ո*A]a/}V_ɯB<+ihU_糟״߇*ɯi+V6kW𺾸h+׈**_x:~ _ѯQ'.תtZk!_;dί]+ׅsvH~0u_B~L~Z!Ck ٯ҅Bk~Jkzͫ_kV׮*vjӟT騶*U[jBڪtTRmIgT[!CRm]aΟIg2vq+VU!Žj?ĕ0uu;R=+])_?dYxBJj+JRmVڮ'Sڮ쫶*V%0l=^Q?G_RmZDԮjbjUjӏu\A՞[WRTmZLJG]a&VU[!6vUKVe W{Vudݸ:`V%X7*+֭JǺUI֝Ou낖uB֭cݪu;ܷnU:ʾu=ÖuB(쨶+JGUavڪj;WmU:JR; u+X*v'@*L uHɺ_ydݯbdx_id~M*Bԫ;W52?6ɺǦiݯ42?^iZ?nI_ݹtvvemUzNtE:d~iuH=~'iݯ4-ɯq|U _id>}{*&@VW1׶W12 ,bdu`=U Y_ydWw+tUMdU Y_ <Kg'Щ|RM_a::$BiRw? x`Wp'@fWx%'Fu@X sk -Da$Gݏ;Lz>'xLZd㙜c웴*veߤU &)IoҪtLڕ}V%4mqJ0ifWФqUIk!I!tLZd[14*ɤi*]axLZYiI*Ii7W~z8dvRMUzT%HuqْjU:RʾTBR0tud; B>_gWY>YaG]gUX>;gU.I+L&]BǤ]g=*L&}Y٤_y¤W谧W51כ|QWXI3+ztW5Ց*:T_TG꫘ꈋmTLut#W5ՑɯTGW~^.f,W5ՑNuT%I8ϟgzG*%gGI{,6)WкqUu*jUuoݪFweߺUX*qW[uoݪtuoݪtە}V%Y7mФJnnqkWغi*V%Y7m z߽ѺCdݤЮuS0jJKU)Uj+ bghjvT;'.Q}V%uuڕ}V׮_+kv:_sZk~Jg+?aGUav/ժtjI(Iuq IT+dvHRZ!KCj,bO$fWXf%ծT+LRMxJX]*IɐU R Jx*?[x[R J5.}W#ժtڕ}V%IuJNRMQ#ճҒjWZTRS%IuMR]|V Ju}CYj u ߒjWPaT;dҒjU:]L.5ʭ+ _3vp_Uav/ժ.N[R L-$}V{09sv Q%sqgU: C)DaǙ]u] \ }}VϮ>+$}vqfW:S#L< ٙGyə309Ž3JrfQIϙ*g4Yv3;i¤ i#L=1{Tzxi=sq=;VxɎюGX!qӎG%qѮ|0*Uή(珅(JOUDYUWE-xTO=]A;|ҳcU:v<*=;`jW.èTv T PF%׿$;>㉳n$;O;Vx.$;݂UIv<ߔc_ {wecU؎ijUұQٱ*; <ͅ?>[ݎGgǪtxTkWvUv/OHxV:v<*=;VcǣҳQٱ*#5n/Jeۤ*,zG%2-dV%rzkQ~"V'ʪtDyT(+W)ʣeUԣ:ϰ(0rqEY!r>7oJǙG̣sfUؙGY!;3MgṾsfU:<*=g ٙG8>^Ϭ'ʣBC gveUXGDyIϯ(Ey(wB(! Qp[W!ʫBбvB! юxh+D;ßqW -]!/fS~ { ɃC@%_~;+l}>Wawwe[WīNX 셱†`ت4f;|Q⻲=pUJ* %++D%CP0JCʶJPVPx %+9_FG;.nW#!( s O%l+l]ٷ/d َ;$;Vv!ٱBcl$g;FSO;^aK]!%VJ!}(d%vHJX!+CRbI+d%vHJ0)q~`v<ؕ}VTsؑ_U⇡+sW%ypq`Vt<`ve߃Ux<ؕ}V%y0]</\`Usʾ`U: ]~  j**ā*Qu:(o[](xTxհ=W%(qqJ`U؃Gint4\j?`ų!oj+ƫJ2| !oudo!͘V*L[<~x'ctו}W!B6^d x:$U됌W!B6^d3 됌W!B6^d x7B6^lx:$Uƫ!ŽKYAM -%d ;ƫJx]7^UxŸZ;nJm]w[Um*moVz[HC*u.^C^ǼG?*b>;MJ\rVUN49v5wx=jG%inw4W]A}UI{Ssg%i߹wu5w|=MJGs]\U*}nJGs]\U~~Z k}U5WaGs]\U: j.1+IsŤ+tKTh+}h*\A-IsB5Y;+iF\Ģ:LV[ iCv[W´ Z qmnH۾BJy$G琅&=48Ih4 a#OxsB{Yno! 푧)LB{m yj$G搅Syj$Gڦ0 -bj[8ԶipѝJ#MmsڣV<֭T -n%i.uԶpVtmx%=m!4(3#Mmssۣ(U6\R|my[BUzn{Qg Fpp]*m@_(9|Z|icPWmZW^In;^xҨKrq/^^ﳂnG_cm_?*#\·Jp[܆Aab>.V%mu_ێG1Osۣφ+U nnKWv(/{$#V>vۏqܖJmb>nxJg?^W:n{قy>[Bӣφ wUIn{t'\se]Uzn{3̵-Ӊ괱{+=3T;{Iloa*GuԵ$z9jg==khZQLb+. B{؂$24Hj6{Ili?YXo[=~Is'6in!} v<=m*duHnV!Cr[m*duHn;m*duHn!}C(dUnV!Cr[ m*츭+n;+-U㶮컭*mvVۺﶪZ(sO_T!} -V-/$ 6J\oK4T鸭*uݖϪܖ\AmT鸭*u.]hd}J*mq*m b\a] |+mq`*mBğo8zt[>WDWඈB`UV%m%AKpVBn9ޏ7rt۱DwnSbuvq_ο={t$:m\ʾ۪㿟Lr?2~YFU1MWV۪Rj.~#_-uexU+h8ksb_d\U:\ٗ_U: ˯}U!Q`ɃKC(+Ł%%RbWX{RrĪBV:$V/8$U!:Dͭ檒^ydW損s&5x4Ga2+Fs{)ho!)L{yg ^yޙdWw損^yޙdWwgW1,|\yޙž^yg$ͽd3f$ūaV=IsbZY6ie4JŽ^ŴHs 'W18^\ W5b.Yu+޺$s۫an{3̂\ 3\AJp[\JrA2=Uҏ]A1NEvc<2_ێGL;?Ln;/s+{+8Kම*m^ 3\tJUbQ%*a+&J*+(8BґTW~^8LfJfJ J2A-kP%5请N]A32~KS%w*Ņ`#hUO]A3Ņ3咮LU&)3+hTd +hWdo3U%k5񬠙3iV/d~ԕ}3U%i 4To$3ʹ]m*b4]̴8HkRᆰʷ’0IjqIґTW~d'a’#w˩+ +jZ : Z_|ْTU: IBTIRէ L%I-#:$IUȒ$U!KBT$W%IBT,IR*dIuH YR*dIUȒ$uAR*dIUȒ$U!KCT, YR*dIuH%U!KCTART(JGR]ٗTUXR* Z_H*Iue_RUH*Iu$U!I[U::+QRg/ Q$a0S\JRi+>.(ÙRcq1SWL5 Rs@*Lq@+l_~*L'JYA3QD 4S 9?*h47{2SIUfFU ff:Q`*Li7[WLԹ3^LefJ0SĬD3]˫4y/fJ2?ԕl92SUh9*3ueLU fZ|&3廲o3-NZVf0iu34So;8}UT!Qp_l,&CY?̓d)g $|VPR/&5+IRq*ARq+(bw?I|I#WXR<*'C%|=d(J@$7I1OI +( &I긕z&3YLNcYL­7\aI 9U0IRq(*ARߝb2Tܔ3O_’,U$-d3=PTL4a2ӳTCG3=sTIfzN;fziOxp*.%I=ӴuOR4jz$!DIXՔ3Mr$L3q. !iD̳yC63MrLrGW*+ YG:$U:tT!BQ3 :tT!BQ YG*dU:tT!CQ YG*+?utQweAUauH㠪$jWAB*yQq^s0tx0Fp7RUbUbVQLU:ŠI?W%)&]HQLW~^8(+JG1UIoϿ +&I*A1 ]YIT \!}~^bUzrُ *&2*A1qNUb"|$JPL\ +xU Y=Ȭ+ &(&+ZzVbfb8UbO8NGIGtӕB1S%(&n"JG1]zD$T%-V\'KUx泽YI/n%8ß'9tpP ;xŽ*8+JA]!UHBϷp6Uئ+d 6,.VmҢU6ۦ*Tm!٦BMd 6m:Dۤ'㬦XxxAU W̮+*I1i*I1=VLZѥJPL1b¾$Ť92sę3TK4y箠bҮ~5*A1)d?TL$IUbTWP1F¯JPLuWH1LRߟYA ?JPL\0=+Q1iY+)Tؖ㮰bBvUb#QLWX1'g"]AĿfQLW#*S4*)fq]*-Tl/-T#x*숧*a=hqKtU:: hu`ihq`JᾎQWHG0CQIG*+: }U:$U:tT!BQVQGiQ%(=ttQ YG*duH:uT!CuH:uT!CQIG*duH:u!BQIG:$aQIG:$U:0웩*3ue몰*uar ;ʾqYL{+?-STaA])qqJpP\n :( ;ZDλHtԕ}U㠪ttk2˻+蠴*Aa ̪wfJpPtWAi_Ua_Q1/G?!guGxVgOCtWPL.Zx/MTyF+(+x:QYU{>NYX,-Tl-WLUxNwe_1U(+ Y1gaS!+Žbb:WLU: +CRLI1b*dtQ}_usTz9*=TsI1GS!+b*daR&TȊFTȊ9¤#LsI1b0)b*daRL#L9¤ Y1GS!+WsI1b0)BV&aO1U(SbJR&TȊ9žb;sUb~UbSUGJMzmYXMZ &m\Jls|>#lGmұQ IW%&M*6MU6qY aV%׿*hFm#MR`nUmKWhgQ 9=; Y}AI# ',Z$2'.pV'_(]X 'mJOYtWX`x҂MWb/$?Y|W6sTx'$M ᏷OUXjy*3o$3-UU+l}ueLU!3uttwu/\PGU+:Jg*uuJQ 0+K$4JQ.WPGTI::*~5~WXGiWJUB:+5]$A뮠ʼnR$c +8H 08(@YJV$m]A㿟 ;hPS࠸+전-%-U㠪tԕߺgIG[i]6V*QWPRK %UґTW%UB%uARS IR*H+,1NZ/U ꊿ;p/ F%k*wyT5:^Q Z6}Q <(N瓯w髣|f|UanJt~JGRG'0IW%Uaڏ%uIRG$x5%uTW;f:*=3d LGT!0}31SU:f B6SlRX!C2Sl L0C2Sl L*d3uH L:$3UfT!B6Sd L0B6Sd L*3U%i@3uQWuT^}㠮;*A[FJg7Yi+:JGGU+W%)j+T阩*tTdX^ ?TRs_AWTdOqeLg%)*Lt؏ h>Ƌ7UfJJ0SKURWwV :?,HU%H*^R%/:ޕ}IU%H*^$?I*O$KAB :<Pwy|0Yu*gg1ש8CBtS3uZa+B/NL ({yYM82HI4aOb*Sژgʤ0i㙧29_QU J2X=&JIJ2H $-RdH@wAxr* \ak1T J0HdKW2Ia0H+hw* q.* q+h8bI`^F, 2A'ꮠAyUAqW$J2Mb毅(+.dGtV]g ߯=h_R㕮ϡW%)f>9èb:bϸB!&!,.qW:W+D,܎WJW+W0xE!yBJo!TA*$mtȮ\Q!CrE  KvEz\+B]Q!CrE+*dWtH8+*dWtH]!}*dWTȮ\Q!CrE +*dWtH8 +*dWt$W$S㊮+*dWt Oc[*l3lY+  @Rm?WO?W4:7gUIGc?WT I\AYE?OV!MH^8HVA^O x߿^W% AJPA ΠR%ڵYa TxE+]aon뮰 ~^*T쫠*tTPaGUO]JOzEso-S!"LJW_Sҧa ,.WP&L:BMo)dsHMO!C2=lz)dsHM!B6=lz;wi9Ip&;tG㐝p&;F;<!yCv#OQp&;<!;ݑ'8d;<GarbNp4'i.[aXW%һ(T9$rG1&iR rH3iyt&v?[$벣>Dg rG1}ĨD޸"G>û"Pg}9Ey /R%X^ X+XJ9آJxG1} r_WP>wԪ񮕪ý1]!Q2}>]A +bIÕŮtD(M;3-*=;=;ҜE8>9={;D ;;1ŭD;)1 )rG0ܑ8גQb T%+D-)r{vi. yC#Osqvi. indoG0ۑ8d{;loG0QL][ӹBNN!;Cr:t)dsHN7t)dsH )dSN琜N!;Cr:t )dsHN7Ct}zW{q+,}Oґ>W綨ҙ B^0ӫ/6TK{ΰe*$+t*p_U *K\a =U =TȕtTVA^P$FW{WAW >1A *8#TEVۇ T*cVTaTRV p*+U *cQT *;E*syT *8wUf QY*Hkt]aHU騠+K*UI*?[*JG]}xtPBVJXWBԭ]U: b>)+:ē⒤劮+*dWTȮ0_WtJ?a_0~!tF3 萴Q!kCF Y6*dmtHڨQ!kCFI6*dmtKWL)$+| I *dtH*U!BVAIgT!BVAQ!CRA Y *dtH*UP!CRAIgUT5}iMB/rU*_亲J?xr牪tS쫠*te_UaaK]VXO]V% "+(8RD ]xBUk{WotPd#=W q*+tdV(UZV׳V8nz-;{T yq+lN`3`U \A+n%Xau_kJBE+ho* ЉQ%Y!9+ $+̟c-+TP`'moUX+VJg*a<' bq / kg%Z!*l$vhY+d :W +⠂ y]CZW-$SȦ7`z9$SȦM!B6=dz 9$SȦLO!B6=lz4a2WD^y"dzT!obGq`a0:~\Ҥ/૘+U߫U`{PV~߫U%FU*fzhy`QI7~E Q%Jy4/IL_yoЧJ? J? nЧJ?isV~?ڣ@s?m߫&}䯸ҤbGu+C|*8C{ ;J>ŽIŅ@WgzVB4;[!MohzwB4;6=UЭJ2=+VwW@VؐU GMwe[V!}wODsUJ?8\Ɯ𿻒xMŽݕm[46Lﮠ4UAӻC6=X#* [dzpewW~[`z4lު4LoUioweV%׿KϿʶ1UI7hn|y]AӣѾLF4=ӣsL~e|W[ G"4=1ӣ-V%+hz$Ӄ_4=2UI{uLx'ӣUëLKW|&+>ƓߌʶJ2=XwWMoU0'9`4|Ŧwۦ*hzwmzD˗/lzwta VwM1 LohzwB4=lzwB4;[! LohzwB4! Lohz+DӻC6+Xa2+x 89c89c89c898989c89c89c898989c89c49Wt+JS6 ȕfo/+M}IwU9;L8jž]i"G>?Ҝ=Ҝ< =&; ȷ+!o:UNw3=UJW1#U}W1ӃvZwu7fwJ;(kUj]A1 ӻ+Ҫ >Jлc Yw4䮠ORW%-|[w5]_dzzX*fzoC׮J;ڊoUXp=]A"W%]p+/Iw{HzL/]MzW|G]L ]iG.6*QkEn>gk՜rWS/gS$}o!00ޕ8LwřwȦwo!w(w+Lw+LwwȦwwȦw+Lw+Lw+LwwH'B6=lz)dsHM!B6=lzfL!B6=lzL!CSȦM!B6=dz 9$SȦpf%}L]aӣoU᷿+#O }#֑>WHvϕ}SOaG\ٗ>UUw4"80?SՆ*N!J^Vґ>UHŸ'Sdzo]AÕ,tLOdz]aӃ͹V%lvWhLhz0=U1C|>+hz4cU@ tU7U!йب /sMzĂіyLcZ;wr\6=iW!%hzL?OfW%-S%^MMM鹲"O2=Aoީ8m+wՁXUxw߭J5~HJ>YI7!+(}Z$}O$}v_f,}I9$Sҧ!IB>$} Y9d;㔍&;㔍;d;㔍&;㔍&;㔍&;㔍;d;㔍;d;㔍&;㔍&;㔍&;㔍;d;㔍;d;㔍&;㔍&;)k,lK9)LS62L9L,foTw!i-ܙ&g;32Tiܙfd8L"wV0 ,a3NøÎӝishJpp {0ӝ4tg1 +t*X#< n;is896U NG4 :n ;]ru&{Jл1cWP.(YL|is`x%ҪxWFwxXwWQ|Apѝ*Aw+-tyž,-C˙fYd: Ձ_ȝiE}ȝq ȝi?>\E;4B89c898989Cat3NXar3NXar3NθCv3NθCv3NXar3NXar3NXar3NθCr_xr:t )dSN琜N6=+kvڃnUJJ lmN;V4UYge t+$OwBt+$OȞF@t +$OȞ.=]!y@t=1O$tVk侧Kd5򹸷Y1t3.t`G<3r_6}M_}ӗȌ;#fpq@"wUPG|X5r V0`!Y@l ,$+V0`!Y,$+V0`!Y@4 d+XHV0`!Y@l ,oȔLd 6r &2coa+8coa+XVp _KĬ^f`"l [Dfy{ޗBMo" q;`#]a"30;t`#T\s:闈Bj}W~B ~GO4IlW?飐 '}A\@3Yr>daN:{G"sq>|V\9ڙrA\gz_W::c\jw_Uto utzS*9ΞȜ[9ZxlhQ"so!o!oށ-Awdldz8ѻZw`SD\^4}{Ӈ"!Ǘ^'"bIDL>ܬ>>j>'9K|1C[w 3}OMϋ*`171}"o Mo!m3= vz'tb@:8cP$ל7;Xw[BvzqBuzhNo;~zG!;O(dV?#Мw[Brz/uz dN^ ;Brz;8Brz dWH#X ;@vz dN^ ;NLKdF;Df^#^" 9+]GͦKd5rD+$8;=W 9=*qz2>p5r%2aWN %"N;5rqz|i"3NvzK,qztz.qz6Not/FDeӣ}}, >m_"p7K FáYiD43A7X%9ѽ8Df^#^"3N/rzo] ۻBw'D{WȞ'xt=]"3.O}OȌkī\t +$OȞ +$OȞ.=]!y@t+$OȞ<] {@t<] {@t+$OȞ<] {@tN(<] {@tȞ.=]!y@t+$OȞ;#hId5žnp/p}O{O{eOWȞnӍ^8tp5r%Fb ިi)Z67lT%bgofF>ߥT"3qo{+qowogdʽ%" wT5 m%h^l7u{kZA6qox~p#Pp&" /MDnl2D̽y{-{|ͽaFн Eso1~821s{Kdƽ5r߽%bm\̽ ،{Kdƽ%[ Bro's/dVx߽%21FV-ֈWٽ{ dVH- Ž{ dVH-[ Bro ɽ{ dVH-[!@vo ٽ- ͽ[ {;@.h-ͽ[ { dv@so4y;{ dv@sohٽ[ 7Y0IvDĽɬȌ{;"s-vD̽P!̹#b-棇׽e pteE"s-vD̽P[ {;7Y%⃿7i{i&1ƺ.EG\Ȍ{;"s툘{ dv<vD["3m{o(#aFǢ&" l^7uGD^e7Ė6zŽDؽMq S-A&z{'90{*qoGܛ Ų I˖Ȍe;"s-:"pΧ94_L#b>-}ͧOۡO ͧ#2ӎ^Ff|ix5>٧|Z Oۡ@i4>h>-}ͧO;O dv@ih>ɧ|Z @i٧O+*}Z!@i ɧP|Z!@i ɧO+,}Z Bi ɧO dVH>-}Z}vFԧѬ4a6iiOK}ZOk}O+![B8avBiR\%b]]EQ"P5ZBi\R1F6D"3>-i}Z"3>>LḐѕO;>̧!OKO .i$A6z`Ӱ^#DħM|i0ii-i,ا}J}m{pcZ"f|B2g4_OB>m2BV欐Y B2g'ss.dsVxߜ%2c1g7g̘Fs欐Y B2glN(欐Y B2glٜ9 dsVH,Y B2gl ɜ9 dsVHC*3glٜ9 ds欐Y B*}ٜ9+$svB1gdٜ9+$s欐F@6gl ɜ9+$s,Y!@6gAsVhFБŒ#k#KY#k#KY}GȌ#KY!9G}G;#+$Gh#k~D̑QFOKDeƧ54.[]e<^ϕs%9k\#lH$2ca˶I"bcFXFزJ,k-]eYBioo+KD!zIg#hp[Y"bDĜm^ҙ3'eOÝO|+էߔ/iitay#3>18`0&O)|De{̞]ZZH-̲eβ=Bl? ,O)8ZRP9e{ N)ԓ18`aWIS Ͳ=Bl?-O)8ZRhe{)l~JA![Rhe{)f~JA! .8̲e dVH--[ [Bll ɲe dVHb ɲe dVH--[!`lٲe dVH--[ [Bll [3"eNCqo{ dhF̸Df[" ɽθFDؽP[!Ȍ{k{KoىLF>Df,[#l٨lNdƲ%2cov:/lبꌘe;uSdƲ5r߲%b:7–׷KDˆ,lElxtC"bFY67lUe}IJ቞e;җ-he[.<#jrF[Df,[#-["f|lx6eo!VH> 7g9 dsVH,Y!9 dsV9i9+o1sFN+3g1s6z`3;Ŝ9+$s欐Y 9+$s欐Y @6gdٜ9 ds欐Y B2glٜpf6?cg 9@3g1hl3 ٜm~@!4sf6?c g 9B6g1hl3͜mvՑmvn=g m_{3\uz pmff'B\rF{m; l쌁78ȶi:sd,iնixf#3l&f #Fg #g Fؑ^_l3Ēl3đm3Dđ᥍#c{bDm~o KDl^0 3axAf"brF؆ |Ć~DĆgl`Q 443iö)Sm6{@#Ll68M`td&Phls͑m~n Ցm~n@]hl {os:2L:m܀FTG6?7P#܀@sdPȎls ّm~n@9 4G6?7[ : #{ApdDGvAtd/^ё] # dG.^ё `DGvAtd/^ё] # :GȎ^ё 8 ##{En;+b V.ui"슠#{ApdpdmGvE&Y"7o۰+2aîȄ {En۰+6o۰+2q1{ ^υذ+2a^6Lذ+2a^'\  /1FLذWm+"6Ώ|EІWmņFWmm"bèK+B6 O"f+"6,"hsaS\m\N0ذ AnƆ"m`GJ/{dz zA^D{] ~Nυ^"느z^͸W+AvYD..e]]V uAtY/...e]] ˺ zApYD..^pg.+]V BrYe dUH.+]V BrY'UH.+]V Be.+]V!@vYe*$.\ e*$.\V ,+̸FDej"rY67B+pp5k3"Jdp%2coaUxp%" ˲Dpaţ%2cy슰sȌj ٘ϥ"34\C')Õ.m7\ᢝS."vEp=1\'* a#hB+".e"fgK_4\t)a5ʚ[W \ʘ.ڼ 5pθDlgtbg W# W"l'" W"lp dUHbp~Nυl Dp*oe5╠@vYe duBqYe d.\V BrYe dUH.+]V BbWAsYAvYֿU{_\֪/h.k/.k/.k4jo Ze[e[e[VAsYֿU AvYvƿZI\eZg|_7'U_pe~\zE#?IõNvEf jZpbAo})Qo}6\do+2gȌZpLu[ :Om߯.8AÅ{_S,^M^ok"Dt+k}QE۴aE۴5a{_cZ~ĩWd{Eb@{k=9j Z_{/?Pת_s.4ZB3\^ z^ Z Z Z}U;_\֪/h.k/.k/.k4j Zee&e dUH.+]V BrY e dUH. e dUH#X Be*$.\V @vYe:@vYe d8qYwYˢ-ۉ̸Fe=Ȍ:#S..+ȌjJ]V},ڕȌjsY{]qY̸FDf\V#]QraW5. _qYA,qY!vY. Op|Ee%K6..9Ld貾lj]De]Ь`Rk壹Z+3zD\V"3.tYLϮW 蹰 45x3+6\l p*$uB1\l ?B6\dp*P Wׇbp dUH+ p dUH+ W B2\l p dUH+ W!@6\l p܋n3\lp dȆ W B2\lp:B2\lpȆF@6\l p*$Ȇ+ W!@6\dN(+ W!@6\dpFDf W#llp%2c!8ca5x3WJde%2aU.ڒ^%2*De\mH\ֹ7Ef\V#]V"3.۝rY:"_4K#De2j]JD\^e&Fe&DeŅ+". /.l[|e&FeN] e )ȌjJde%2qYwY qYwY dUH.+]V! dU9*$.+]VW .\V BrYN(.\V BrYe dUH.+]V BrY e dU.k_.kh.k_.kh.kh.k_.kh.k'TxGBvYw/dxG9vO\V~.[!k].Kl2/+e^2Zf;'B֪pO-!?œZZ-\꺵ZG2V_6n$2gَXe#|#3ju?~Ze^2/rhtXGVkxx4Vֳ/۩k5X|ZDZQFZ 1Vˠ#`6k5Z fIk :IkXx9˨{^2=>Vw/dkxBVw4kx@Vu/4kxGBZ-=Ь Z-Ojfhjl^jfhjf^H^ dk֪U [@VdZ dk֪ Z dk֪F@V4 dkUH*U!Y@Vl Z*$kuBVl Z*$k*ЬF[DZj"3*kȧ217xZ%2cΈX*k5xe 5BUU~Df]%2\~nWFOfDfT"3~'&b~i7rO)?)}?)@:V_eS""~j\O>DfT#Ph&"~ H%b~.k_ODnj`nWغLYFZ1ea"d gT#T"3~~*S3~~*S O*$?uBS ?BSO*NTWwO d?UH~* O d?UH~*T BS O d?UH~*T!@S O޿O*$?~*T!3 O d?UH~ O d?UH#X BO*$?~T @SO:@SO d?8~*BE#XDZj^fv`5rDf\Uxe%2qY/.Jde%2\[٘ȌjJD\6{O\R7.NqmSD\^}uF\V"3..+qYxQa#>=V֫V?ڈ:&U鉈B[+-R-R .gdZ5j0iЬ^fZ%2qY}@vYe:@vYSy!BrYez%(.+AqY e*$. e*$.+]V!@vYe*$.\V @vY=\zx?@sYh.e={!s/d~=\zx?BvY^ȋs4~Ͻ]zx?9Ȝz \̹sw.opZ=fVYǨsjѽ\MȌz{z KUsL?FpqsK3\Q?w6\A?w~gdp=<Ǡs/d;%*yU"fXK>"Dp&Dp}xv.p ' ]VA:i֣!Ǩ^ûΜ7Ȍzx7@Sh~O~ ?'BSh~ [O={wc/d?nލލ=ûzx7BS^~O={wc4?n{e~*T BSO d?UH~*T BS'?UH~*T BO~*T!@Sd?~T BS'?~T BSgl侟JdO5rO%2?5z~)uFD?e1Q7Q̘FDD6̘F>eGW"3&&*ȌjM^Ȍj侉:#j8DfLT#l_5P"lX^5B EʦDOljE?MA?5Ta?_dS~*S'?UxO%22S3~~*SX#OTCS d?UH~*T! d?U9=*$?~*TWw ?~T BSN(~T BSO d?UH~*T BS O d?U~j6^~j6h~j6^~j6h~j6h~j6^~j6h~j'T?yBSwX/d?y9? :sAuۨ:/A7?5x槶Qk5xjQujucf72cA7v)Q7vV۠XmЍ]f Oq? ;}>6~~j]gu ڼﺙswF|U5xf((_(/1Qa7A&"& /kM`k}T? :&(SLA~jR=9? zGaOmK=OmK6^9ڼz{zu~j^6^~j^6~BSR4?y/@SR/d?y/BSR4?y/@SR4?y/BS d?~T @SO d?~ O d?~F@S4 d?UH~*T!-O*$?~ O*$?~T ?}?) sp/31?kA?5z.ҫj\xWU ?%Sb~D5rD%"& F|rN8F>1D-eqsJd95r9%2'L9DfS#H %"it/9VD9S 5isB;'sZ} D9vs!@\S)tF^LT"3&@!;@rNo]Jd.5i #GzQ"l1 dcTHb~Nl }jcƨ-1F^o1 dcTH(Q!@6F'cTH(Q!@6Fl 1*$c(Q!@6Fd1*$cQ3Fl1 dcƨQ B*1*$ctB1Fd1*,Q!`l1 dcTH@6Fl 1*$ctB1Fl 1*$c(Pact,޿(DẲZ$θDfP#P"wЇة]JgDv)ߥȌJd 5Cj) Ȍj{hC# .nLF32{߃=xY"{F¾'|K A߃%"U`#{ҵDּD {zDf|O#{|"=gd4¾' =Xg h;a %bnhp/hDΣCHG dTH)=R!yG dTxBr#G**LHkɑ86:k %:Zq-k)Z1Brw-_)ג7W,8I\Qk~0WD\ n~ID\MSB2@kAY]Z|3ׂG4®aq-'Re\K#>k dRňBr-Zٵk dȮ\K Br-'Ȯsb+dRH%]K BTĵz"%]K!@v-ZٵP\K!@v-Zٵk)$Ȯ\K @v-Zٵk dȮ[ _]K Br-Zٵk dRH@v-Z ɵP\K!@v-Z i dRH#X @v-Zٵk dȮ\K Br-'Ȯ\K Br-Zٵk dRH @v-ZpZ&b'ʻ40h"d`$8#S^۽hȌId4r+2e1&5C/Zlf`/sEfcJd:F{D}/sFˠGIL!{C/0j :DІD˜j}(2抈A/%2e2q4⓶)#pƵ4S@v-^k)$Ȯ%]K!@v-Z ɵk)$rBq-Z }RH%]K BTĵz"%]K!@v-ZٵP\K!@v-Zٵk)$Ȯ\K @v->k)$Ȯ%]K!ovE; E;^\ˢ~/he4ײhdײhdײh kY͵,ZZZ{As-vE;kY kY m4ײh/ kYk͵,h]?oY^7/֟׵b]{}AX/_*d+2gUg2d*l˜UYoXR'/]9Lv}Ef2+VeJct E\eеW2K]q-\ ^<}ˠk/nk] eеw-t-ˠk`DctnN2Q2;xfѮ4[hrFm͢]{/hfѮ/ȶfѮ4[h YkoښEOjk{A5v}Au,ڵfklklkfѮ4[h Yk Yk Yk,ڵfk{A5v}A~Oȶ&mM!ٚ@5lk )$[ȶ&mM!ٚ)$[ȶ&mM!`lk i d[ȶlM ۚB5lk d[SHbk d[SH&mM ۚB5lk iȶ&l - 1MB*ok5gd4r$2cka[SfflM#mM"3&5xD# U<á2'ȌiId4r;QCr9q8bL#p6p#o"pFs8&q8ͥv8EFS(f0bL(Seg RH -V%JbU ɪU dRHV%J [B*lU ɪPJ [ɪJ!Y@*lU &R5X@*dU٪U drB*dU٪U dVJ [B*lU٪&VJ [@*8Jv8d4ÿLf?ÔHv:DDq"+ND hd'RS8@v"^4)$'N$HODى d'RHNDى~NVD ɉ d'R8B(ĉ)$'NH ;)$'NH ;@v"Dى d'NЇ7q"Dى)mDى)$'N$H!9@v"Dى)$'rBq"Dى),H!`Dى d'RHN$H ;Br"D ɉPH ;Br"D iN$H!9@v"@ d'NH ;Bv"PND.ψ:Z7r*DfLI"lJ DfLI#MI"3$SLI"bJ)iM nHdƔ$2cJoJ1SBΡ6%5%'̟VD؟VFП ID nIDbdEV#͟ F_'>ƣ?17))R"MIObJٔz)!LI @6%dJٔ))$SȦL Ŕ)) ٔ) dSȦ 1%^g) dSRH$MI!@6%'SRH$MI!@6%lJ ɔ))$SȦ$MIobJ ɔ) dSR=V͔cM=V͔c5L=V͔cM=V ٔc5L=V͔c5L=V ٔcM=V͔c5L=VOdlJVZ {)Yj{)Yj!zSZ}nopƉ7jTYg{&2gJVZ8DAUq"lD:*NdȜYg{&"ND4:豊=Έ:(*hmID4'"mΫA$9':DXpΫASD\pyT~M˃ջcn^XjُջXjُջX ~MsZ*4z7@wS-AT~MT ~Mj?Vhcnf?VZcnl?Vhcnf?Vhcn4G ۏ@d?~($l?~8؏Bl?~F@l? ~($#G!ُ@d?N(#G!-~-G ۏBl? i#G!ُ@G"d?.(=U xDf"}D/Gd>|D @#G8@J!B#Gj^|DG($>|D ($>|D @#Gd>Ї7#G(m#NZ>b#Nh>b#NZ>b#Nh>b#Nh>b#NZ>b#Nh>b'TxwB^-ޝhw' 4xw@w' 4xwBw'-M}bG Y/RY,qM2C:op<,G1 zⱵ̙eh"sa|-ܜЈ"4Žx>]DF1nkHd1,.:ȌcXh9:cXg9Ż}"|n>cXg/1,3> 1,3>1,Y9}cXg9Ż} ]>1,> 1,hanYȎanhanhanu,$PH ~:Br \,c($?1OPH 1C!97,$? 1OPH ~: c($?hC!97 1Z!9Br o1cx>c :7x14r14r1E| p14r14B ~.F1|8?սw c-ŽsB#[d4":cEO1p[yh̃< j>Q5B5[s^H) ) 1Ex!97S:Br oc($PH ~Na 1OPH ~: c($?Br osJ($PH AC!97 1OPHPXH t c($PH ~:Br  o?u9@v  1cdPHK@v 1c($pBq 1c(,C!`1cdPH!C ;Br  1PC ;BZc(Z ;@v 1-C ;Br  }xpBq C"3!=!">@N9F;DfC" ?}ǐ.cxhP $b6s_[=jq ,S1@ t F90hc c@a9c )SZcdPS8B1PC!-1&!C/1cdȎC ;@v 1c88@v G!;Br 1 ]C1c($ȎC ;c($ȎЇ7q  1c($Ȏ!Co 1cdPh!1C /h!1C ;cdp@s 4#1v@s 4Ȏ11c89@v ;Tp@s @;9@^1c89@^1c89@1PC ;Ͻˍ9#2rK[9#b!s44rZk%s GCc8"A08#Ŀq gWa:?j;hSB#39Dx~@s 4S:@1PC /h!Ч0u 4pu h11c89@v ;Tp@s G9@v 4p@s BW+tu 4Ȏ11c89@1C ;cdp@s 4Û:@v 4p@s 4=1c($Ȏ!C!-1cdȎ 1cdȎF@v 4cdPH!C!9@v  1c($pBq  iȎh1cdPH @v  1c(M 1-p&$2cp&4r&$2caP؄F|ld&$6mm?HDlF&8#f8-6a>M|:& jH $"6@#:A {B$ iaޠЧ% }a-ޠA {@>-7doPH A!y7doP9Q7($o A[A {B 78xB& A!y@ 7(MA!y@ yx{ h мb м7ءz@4op@<мA `4op@ h мA {7doC4o 7мA {7мA {7MsyD|(x#2 yדGd$ހ'2M!>H!r?4!W \U'D  G Y)9C/hf}RC!%f}  AO@jh !ء! !8![ A A !dCp@3;TCȆf}xSCp@3lh  Aoj #W5l!dCȆŁl !dCPHb !dCPH#X B!($CȆ A @6d!8@6@ dCPH @6l !(Z @6d&b i8c؈h}Ȍ H]@\@"3.tKD\tB <%s"@#*s?eq 7H@/IEBT?T,䪿'/eTTrUO*Rr_HU WTP@ ?B ?B/5T\RU!U\PBޤ/M@ 䪿@/MB䪿_ݪ8r_HU W\R7B䪿J_HU W\U!`\r_HU WTrU!U\RB/Z W@ ?B/Z W\RUoRPBZZOI"3U#wOrl]@}Ȍ H]@rt'Hdb#P$b.$",U,1o@7`DGCmHļHļȌ7hց ia AOK }ZopBdoPӒx@oPH A {B7($oޠ 7(( 7doޠW }- A!y@ PAo }xoޠA {B &ޠA {@<0м 0м0м 밐0м밐 0м VuX {m^ Vuh`^ VuX`^>7Xa!/QWC렫@w5 4CrTXW렫!Θy,?렫T렫u5t zC x&3o{;o07wzi`^.Vuy Z7K;!XSa;!XSa!/WTX;Z ީ' 5w*,dCzB6w* 4Cz@3w* 4CzB__!XSa;!XSa!;P ީ0 ީ ީ0 ީG A @6d!(eq B2l!8B2lȆF@6l !($CȆ A!@6dN( A!-- A B2l iȆ A!@6>!8BZ!"$3T4CيxDxgArФB"bp3B#CMD  !r?1X78#f$b?Mj3k`MSC@1!(%t BZB!dCPBP A!-$ A/!dCȆ' 1l !($CpB1l ?B6d!(B__!dCPH A!@6'CPÛB!($CȆ A @6>!($CȆ A! o= !($CȆ A!-!dCȆ !dCȆF@64!dCPH A!@6l !($CpB1l iȆhl!dCPH @6l !(M -p$B .B#]@"3. C01{CR4(1C@R!1(aC01X7†_14FgV]|NV'B.BZr_H@/IEBT?T,䪿'/eTTrUO*Rr_HU WTP@ ?B ?B_3K_kf/?B?T>I_ÛT\RU!U\r_ÛTTrU!o >\/g0Ъ Zտx@3XU} _`U >V/g rտx@3hU}OU} yxB^-g0Ъ Zտx@3XU} }xӪ>@[}BY}E,g0p,R-R/}]b= e}OBX__<OTc;oVfUӎU$,~>ow,_`w ~񎂅^`OZ/QZ/Q0;  _`!w ~񎂁V/Q0; X; Z}xGB(XO_`w,~񎂅\/Q0; Z}xG@(XH۲״Vr}}!\r}_H@ >BO(}!\r}_H#X 4r}}!\-@ J}}!-/Z \R}}!-@ }xR-BЇ5{"VS{=PjvK᚝Df-okC}Dfj3U7rfOdfoħf/Em 셴 =kBf/)AjJ^H@ }J=kB_J^H5{ \ 5{ Tr^H5 f䚽Їn f=kB_J^+^f/=kBf?>I^Û\R5{!\r^ÛTr5{! oDzj@f/=k@ iQ5{!\r^H5 f/=k@ i 䚽F@f/=kBZr5{!\R~Bf/Z 셴@ =kBf/Z \R5{oRPjBZr5{oVcUT{%"5;VxX>f5{"T[WV烧$I59m9Id:o:/k W煴| /.vC+nɭ|Py.voЇnAWȋ{stV[/ރ.j{ZmxB^|.ރЇnAWOAh= }zt\[/ރk{Zmx@Ah= }0ztV[/ރk{rmxjmx@Ah= ^]!֋ ztV[/ރ.j{/ց\[rm]Hu ց\[3kBںjJm]Hu ց\[ȵu!`\[rm]Hu օ@ :kB.R[rm]H @ iȵu օT[rm]H @.:kBޤ>օ@ :kBަjF,G=0L*n,eñHOD~=}ѽP%fj5;= }J=kBZr^H@f/)AjBf?셴 䚽Чf/ETr5{O Rr^H5{ TPj@ ?B f=kB_J^+^f/=kBf?>I^Û\R5{!\r^ÛTr5{W?Oۿ_O}?Ƿ~ۿ^>ٿsVˎgI9^t={<}"gE>Gt~Xy^'|V*O^?g/vr/ůc '>g?OQv+s|O~>X䏏aoja^|'xߗOx,W^}9x?_zv?_(~><3x?/TyO9<[}|GWS==_GK/ze>> G|?/s}>Q{쟾GޕܧGʏ~ğ/_~>>gh"=_e|@}>ӗ%O-^-ۏ~>T`uD5|˖.9f?\,:wSy.~b1_ Fsy.m[L&|~a?`v8Vx@{}|La8>vmּ?`8l&˜|go.p{d[_竸}~Ήs_.0,{x|?Ϯ8k#:dm˷ *> =r^AQG}&ןh|gp;m |4_Km>>]y8eOxhs>f??&FpagSyW7?h<lD hqLP+ 8f7?N!++Gi;WH;:!ey>?W-4]&y\s{ql{vq<1Ƿq?}U>s'1+,6~>qq=n?3{?{~xGݧ~[[^sQϿ}\8y_;>4|%z.\wu//[}Y?]myAx?8eC|/{./[+/[+/~21;_/n[G oWp_"o쎲PE3=hdIEL /g7d?~r_CrJ]}Yc$OtV)?;-YwZN_y'믋}vap0ٟsI˵cqR9p/ZMsł3YTIO14,ýV#IcqV/sqR0=h ~3'sݯ3-^krr3'cq*i_ #G(dPtpHΡC!;Cr9FC!;Crps|UxBvtJprT ΁w_qԧPZAQGU9 +{]u ZVasԇ~Wsl*۵BαՁaNyslu~Աx~\+[]αכ(RT9VKr+j\!87BqX&{oT KJ\A@}T%8҈+&9҈*9fd(mt&~(dpOa~8$P57̧A?~(dp~8$P1 I?~8gA?~8̧A?~(dPC!| C!C><~(d0B֏ ~TC!GI?~T¤ Y?js Y?*LQamC!GI?*L¤ Y?*LQa|0B֏ڡ2GI?~T¤ &PDzs&P2mɇ&x>0B>U¤ &Pȇ ~TCa>tDPQaҏ ~(d0B֏ڣ3GI?~hώ~\BZJЏpѤ Ǹ`{ݪ~m~UX?:WQU{N|]qgU|-yTH?~P^ ONu R!x/^NUX?: 4ˏz_~uZE._?G}kyZA'~hyǫJЏ&~#X'`RK)G0UGW%pOV9ԏ)h" D*L&|.LDa>&|.LDa>&Md"0B6 (D*L&0FQ&Ra2 (d0|bMd" Ķ^d"D8$Q&M!B6d" D8$a0d" D8$Q&LD!B6d" DaF!B6tP&LdD8$Q&MC6t,S&M!8$Q&M!:FL!(dqM!:(dqD(dQ&LD!C2QH&h]+%[!K R=z~Q%H ^`Rg>*z[U| Wll|ZVa)yJ~_;AB >~*AJWQBRU,Va)߼sɥBR3Z`")g4ݱRO^Rיu+$%|;*AJTa)ERc)Y')A\Q%HK)J +(%ٴzە'CX=W8{>z$qTE!BVL4O(dUqHUeAU(dUqD(dUqO8$UQȪU!BV8BVtj\꒪8$UQȪTE!BV* YU(dUQȪTeAU(dUQȪTE!CR* YU(dUqHUE!CR*IUFTE!CR* YUn9dUqH2* YUұL!CR* YUҡg&UqH2* YUn9dUqH* YUCGP* YU8$UQȪTe*Sd-tj JQVٹ+E# ^B.N\aqT ..B.d.QT .S_ZKSUetM>We>be ov^ WW]櫞أG .YOj_k\^1-J2.Y1-&| d<1v .3^q<꨹;֨.gUXL9 \Q2#+2|c*epZWe"U \f=]&[F_e%Pk(Qc8(dQȆ0QȆ0qH gp(dq{(dqOă8$QȆ !B6D<B6|"{:dy=a< < < <pyOXl8ϼ'd8ϼ'd8ϼ'd8ϼ'C6g!3 03 03 ;h8ϼ'C6gVa2gVa2gVa2g!˞yOXl8ϼ'd8ϼ'< <&y=a&y=aCN>_{b&yb=̻*L̻:dy]p(;ϼ C:=o$;Iv8$QȲe!ɎB$; Yv8$a$; Yv8$QȲdG!ˎB$; Yv(dQȲdG!ˎCQȲdG!ˎB[YvұL!ˎBt,SȲdG!ˎBtat,SȲeCtPȲea>tdǕNTaQ㐼G!y?<{,yUC$+W{ҪU?x +CT 9W@+ZA›TaUTamWH~#>2 UǺG}@ۛ\!wyyb@/VI T'_u/IFeDˣ$kyJVzb(@_]Js}n}mz==#ˏ $v@UXx%WPdU>w?(P},9(o5JP MS@G-J!  Q'(CTh} 6cCtlȕ|>lH!ې|>l!ِBrH6ma>6ma>6lH!ېB!dC ن`C ن 'rH6m!ِB!lCɆ 9$R6m! 9$R6m!ِB!dC ن 9$R6lH!ېB!dC ن 0ؐB!dC ن 9r6䐎e ن 9cB!dC ن 9C 9cB!lC 9CB!lC#6 )$S`1R#WHFhF13pWX<_ Fx5 ^+ 9D`k*U ^WІp-**نT 6c\A5"*x rU `{U6T†/҆"|l r*lCI amz^+dC| }w(~ ճye,FGAYa#<(FGAYa#pa#0ёwPvM1:Ҿ$Ȼ-+ b $F)ёvf^QXH5 cs,9.޺kT ; 2"WXQ.STa]tt;>']:I3ŬJҥף>OuN;b+].#.yQz)*K]߾-eJ֥z+2R~$]_1 \ nyJ%=_Z!]m. -;+º]A]`]`.h0U.&UX8WPؗF%Rc?uX8*F]ިKGz}u)N.e:Nx2u佨Oy/j>ԑv/2Oy/jɧC#E0_dD:^"O9$R>|J!B)S ٧O)dR>|jO)dR>|J!C)S ٧O)drH>}J!C)SɧF|J!C)S ٧n9drH>}J!C:)drH>}J!C:t0C:)dR>p!C:t($Jg#Z9{@Ig#t,,:%U-Ka,:_u,KaDz\!a˲T W~ Zᅈ+VI:'ɧ)J)tOҹ3NS8`3:`T >U߆z|ǔW?=2u<ʧ>V>uY0JzR > Tdu,O.LO4(}u<:V%+S)կ~𩽎+# J)$-UO]/k\A;|G%n pS%Hv?j8]O)L>ɧ\ag~93aX9O D0HC(,Q{(,QD($Q YD9$R0_NR$x%rH%!IB(,QID9$R%!ID9$R%!IB($Q YD9$R$J!KB($Q YD0HB($Q YD9r$J!KB($Q YD)dR# 后e YD9r#S|yTar0| \A“OUا&"r|JaՏ>5SESzWȧv|)vQ%BR%QZu*UU~NLB7P%^.8Q®8HT+JP2o Uju!WV JR_§TnJ)9Uا>3&qO}O>U߶cTȧtӯK%T]5s&7_?>J)Xůl)$-UO=m޺TȧQI>5+SJKSrVSð~jqp >Sd6(Q Q YDS@Y^˧Taa)S ٧sS ٧拌SɧO)drH>}!B)S٧w>}S ٧*L>Ua)S&R>Ua O)dzѧOU|S ٧*L>}S&R>Ua)S&0B>|U|J!+>Ua)S&0-ɧOU|S ٧*L>}S&RȇW}J!*L>Ua)[O)TUz>US ;>UO񩪐OSҪZ=JR ZY*j$Zi*ApuUp-i.U%@ݫ^cy\R5,D 0iŽUe9^NtS@ [?J4 Ȳ֩6ULar$g&9SrVa3,g&90əB2$gI9$9Sr!əB3$g Y9$9a3$g Y9$9SrL!˙B3$g Y)d9SrL!˙C9SrL!˙B3[Y)d9SrL!˙C3,g YҡcAұL!˙Bt ve=4itJ4U-B4:s=pL^殺#g_B{|=+K99ke!gEytL g|Za9N1lV;W]A9`K%Y}VE;R%xJX1;lyT&z*i -N8|NR6U:6*a͙ÿ~ -es%_eS0_*esHʦM!+CR6lI)desSlg6CT3e!* Qmlg6CT!(BV3e!* Qmlg6CT!( Qml3De;CP!(BV!( Qfv[Qml3De;CP!( QfvpPvp,!* vV6~V33LߟYAe;6+ e;+lE6Æ6+IltmVvVfذr{ڬ4mVvVn۬${7椳F썶`oYA{n7mq<\?SkJMkJqOj_o4˜Et}ހQ Ǽˣ{7ֵmVTȶ[ ۛv79& _6+Wm64`o,xVwLJ7rVGdou|Rg6ðl*[>IF\wViţnQ:"7+ ;+*En(rg/XDn(r3D;CȝaTb!mqo3dg"ŽgDn{0֟a-,r[[ Y䶸 mqo&3L"ŽϐEn{!֟a-?$r[[_O-,r[[I䶸 mqo&g"ŽϐEn{0WEn{0ܖ-[ڇ?7lqwnKgnҞx={-?Þmi|>-v_=/^ws׻mi#3ϏkMn-.~MoZ[%ݻ{V`Y 76SӣL[J0=՚ChzqYA =LLvt;+lz&e2SU4=PrVtYa[}& rYwV%Loq 3LOhziz[&~dzhz5MoS fLoS 0_E│&│3d│3̗U8 ^*}|N9$SȦLO!B6=dz )dSȦLo)dSȦLO!C2=lz )dsHMO!C2=lzFLO!C2=lz n9dsH^lz )dsHMO!C:t0C:)dSLlT#*:(LG'HCr驒Lo: ŽrT阞+MoTZJ\oz4v;+Ma;2BU< ܦ;+sN׻7J;vVէz9 .R;:+AuwW%Z+wO}?8IY ]}^~wpPV*Iw_JG\a9w$yn=+ww;vV.T z V%? wCRһŁ/Bһ7!,^>J8e%^>k*s%_SȦ0_sHMO!C2=lzeU0=lzq=d3d{3LfL';03Nv8C6gplz8aq =d&{gȦΐM';03Nva2g03Nv8C6g0dz8aq =d3d{gȦfL&;|5s=3MS3M4G"yU">Uὼ?<!hoӳ¦J0\JHX&Fd|.H,N'-΢dzGO蚦lΜ8+|œ/_P(Iij?~d8b q >,&+|YgHVLV萬P![CBl *d+tHVP![C+tHVP![CBl *d+tHV!YBBl :$+aBl *d+t吭!*d+tHV!YBBl[ᨠ#+72+TclTs U+tRHVU}TWAUXvT#;܋?Wգ$U :\e*tUTT/]!Ta܋歽? $xk3G'X*X/OnT*wT*8E|= `ͽTAU .^ QAU:*}TܿOW QAWXIJTY.* `}]TJPAO "$TouUpU Q X`O* n.#ұQg*KU!\_B~ yB^{ 'ҧO/a+ Y˪ Y ~>I *dtH*UP!CRAI *dtH*8 I *dtH*U!BVAI :$T*U!BVA# *U!BVA :$T*U!BVA Y |WO#l+W63lY+d Z%I\+x WT㊮u,mT6*dmtHڨQ!kC#qx"Y^g+W*dtH^R!{CJ+W*dtH^9+W*dtH^!yBJ+W:$T^!yBJ# ^!yBJW:$T^2}OB!)BRJ6] }F%&]ASUmpYw:*dTQLW+*ts(A1WugHWۦ*.գxa6]!TرMWJ=/!_㨒l>sm: +I\tS8GVL7JPL\ )&ۏ*A1qcQ 9O~qk_ޗx+e ?;܋NU K(UI)~]+gǨQLWX1i5*A1lTWLUb$\+(tSUl}brv*TK+gǨQLW+*T%)&-t3_ZJRLCVL*A1n WX1GK1G%( )毐Raũe+]^E\ ;^J+]tҕ|R!{C=Oq^3+<}Fa=OQrg&{>㐽rg&+<}Fa=Oq^3+<}Fa=OQrgFrgWy{>0y垧(L^3{rO3i'8x =T? qڒ*t "'`zW aA r[ PJ4z. 5[`W Uu $Q%$.T%d>T%ۡAst ҕJ2H6HI[ΪQA\഼RpGQX1n+W/ye>yny+UHxbA1Q1u_K1]qA1b:$_BRL Y1b*dTȊS!+CRL Y1b0(CRL Y1b*dtHS!+CRLI1b*dtH!)b*dtW1ӟHT!LGx:z Q ;:}Uu}UuT!Q:JNWߩJLU阩+>O~3W/2KBT%Uz; jNU: Qi*i5Žr_RUT#*LJ7عr_RUH*Iu%C$[q%7$- )l]*(0:|ENZ1oTPRJs_$&c'F+o3Y\a3~i1SUnsd \o$3ȮΏ/3U%SLUIf"QIf˼]o33UIf䢙tfr>*La5ܕ3UIfJJgMW*3u͔Tc2SWC^TaX͹zu䠋#8Y]=̿堪trP Ae A+LZarP&UZar *d}AV A+L&UZarP&09Bv *d}A+LU9hU*ZZar { ;(W%9BtYUIZarP}UJAsЪT(AowX;0gI<x~$'UIx$ ;YxW)U w/~t(AG?>>$[]ڙNQU::ZV%(W (VJOGUAťv#V=ߗc!::~)}W棗%h}}YW+g/O,3;]a3Gs?M3U7P%is}~iUzf 3̴66SULTk'~2S@W`8 6SZ4:*L_h:~*AG_rQG::w: 7UI: IGq+$9+7*=TonW%'-,($('AAU1UtVH+gUzYxϪS| ų$ IO+cˀ$UX]y̻*I]3 ɕeא+U7LX JX.lxXUUbv\ LUIKT-}Uk+-aG]GZg}}_U}UaW]S`uuH*Lx~_u徯UWW*d_uȾ/ W+L}&_UȾZaU&_0BW}U!jW+L} W+LZaU&_UȾZa *d_竪t|U OBW||Uժ|U V|5*_JU_J {JW_ U*V4_]=J *d_] WU=I Iu1Ӫ3 '~#lhUz:է i$%Vܟ OOrرͪl*=Tm6 Tgm:U6y$۬^_%W6noU6y}+dl?u]~`Q)J:Gums(=TcU 9qlSkU {¶fUmV2 I` +hxK6W¶am6mH]aۤE$dTea,*uSG ԫJO, *A<UT!;h=JAU8hUz _@k<12< IjYW:$_UȾ}!BU W:$_aU W:$_UȾ|U!BU W*d_UȾ|UaU=u}fT*+}Ud`cWJG]]!uUꪰUauux#X]&u]Kur_]U ?>Q]/\R*d_uxWU!_K0)ׯct,,VdC߲XUbUЪ6QuЪ֤p]t֕nJr[ -ҕ*mqQ n;kZn?mlpX&3̾UO}9mpk}U%zԋ_59ߝJmU n3)ۺrM*uBU%-R%-m -M4\t[\ƪJpXm]A]|''Eu۪q[UҲSWmaUInKUmp6IU~uTZn}U㶮w[Um:$U=Օ{ 1^U:}Uc7^U:ƫ ux[s_q5 Asg;C3͝!j5wg5 Asg;C3͝!j5wg;C3͝!j Qs4w =+JڍqV'w( \C{]͝ΰg j\3lYtvYi4l(pr_! Ihmnz!=C6,vVpVYiYuUQY!uĩmIJTZrVPRrVeYAIVҐYiHYAI%瘕 &JTZ$Ĵ]+(c xbIR۸ZAIU-ќ+f%H*m:+ARiCr[Rg!g嶤JTuaVzVnKI bIRaY Jg%I*lzVPR{U}g%uV­$'~[FIXJCRmIJCR K*,?Ta1Y+LuVzVnґԳr[Rg%HOzbUz3lYثuVzVn4|ܾ qV..ţSΐSΐSfSfSfSΐSΐSfSfSfSΐSΐSfSfS#_SG5HsI ߼GXZ=랯qn Y#:C#NȚaWܬœ|XZ|PzY $G5C\:dG0[9&Y I걘oN4jQR3_] D_=3 %0ÞU(嬰e᱘Y*.`V͙Ugbf;+LLGY 3Zy  "z\%8C/׵Z6w/W.XU >32=+=_=*ovVzz,fV_=3fGY[JW̪bfw?*VW> __e|uIVW$j&Y9L Ia#Mr$eXL z,&Y-QR$5? J꯰cGY3#Na#ά!p=3fGsfլH3(A?Kpŕ{A?_'"A*duHT!;CrPA*duH:A*duH!9BvPA:$U!9K ;(YШU*\TLnTBTaA]sw X䬣 {::*JAU8+[ T!;BvP A*8*9Tg徃ҘCuVAG׎:}otOTWȶI~UWۦ*Tcl}e*6IQ\! g%@qmTmQ׫wmo( *6,GV6౏C/`4LjVmBPWۦ*tmұMUJǯZahŬlYY&lM\JMJU6Sbr_1U Ddۤ]c &.TmS6񐉶鰣WLU:9*A1WLU:}TS!+%Mk+Sx3G-txOU3o_JMd 6m*dTȶlS!ۦCMl 6m0ئCMl 6m*dtHmS!ۦCMl6m*dtHcmwب;뉄T鈧+Sxp-tO, xw+,7}RgSaG<]ӃSA堪tT/A*duH!9Y8+젋㠮u/SU*ZJGR]!IUؑTUXRޗTUz0w]t$U$ܗTUVz5WPRiYIZO$ zyc+$u^/:SӘRaIG/$Xԕc7SUx?+3uĩY f}3U%)niJ0Sچҝ͔wf;Ua30f𾙪1SWL@UIfJ;U f/rLU { IEtΥUW*_*_u徯ҹ^R"7H&G֎H~=SVO!uUS#MǏXLZ=)RGsY뱘""e߯Kdb:$U-!YBXd b:$aXd b:$U,V![BXd b*dU,Vab]o,V!Y𾺪ҙ juݞJW]!_UȾ㫮.^UUDX*+u%5?ґTWU$!IBT,IR:$IUؑTU֯ak?SUHRsŽr_GU*L]t3uuŰRQU/:}U%h?gI:Z? % hX*AGi(YA(G[%(Q+RUaA]tTJpJrPZ* ;h}(.JrPX}نԕ:*Aq٩+䠼T{堮wPU_\aŨa,W-U㠪$%tTarųtJAG5ʕ:JGG]!U:K6%"uqPW;*u徃qPU:}/$= ˏij&~yVp=h?$%u徃TrAU ˔]tT8vPڲtTZ ;( *AiU:}Ue頩nW㠮wPU:JA]+ :ztt-u徃t( AI<vӕJXzAWL蠿JG$uYuZZF{ݸOZo$'__ _ż@b^.U'b^.v%?/EfWPRq_UH6U֒zȾ$u_̋>\AIUIE-_ CUIS)R,4Ej}oJfKut$uOfؔԽ;qJ_OUIRYR5\irX;0€i{+龘 Ht΋zxL*d3uHfT!C2SlL*d3uHf:`L*d3uHf!B6SlL:$3Uf!` )}'Jk^*IuRUHRKMT0U: IBT$BF!?~`ׯc:of+*8*ue_A*dUT!;CrPU㠮wPUhkӨ:duJzPSxOWX0QO8 9(?s(44z1%\< 3uӕ OUX<OUx.5(u+J{#ŽxV'xVij$ Y<+L⩐ų$&T x*d0gI<xVS!gI<+L⩐ų$ Y<+LYaO,Sx*z6/|6ҳͪ$T0٦B mVlS!f6vl*=۬JM|U f6+LpaMl&۬0٦B)#RGTW<׿n頪VsPU:4*aQz:Z4'i(L3Ӫ3\iUT=3JLUiUksb )MxQTy=*L ?427-XYҗ]*h5K*Lq*Lq+h8Hdt+h=*Lq*ltV:fZd?f:>][E̔,Q1W%iLUfz]V%)s4hfU.e(?J2뙩*3JL3SULWtq4/F3}hŽV.%Q.≑ ϡW%9h=UUI4_A%]wAw:@;W*utT!BQ YG*dU:ttAG*dU:tT!CQ YG*duH:uT!CQBvPsu ]ttTQ[YG*dU:tT!:JzU:лr0>*D]{dIUȒp!KCT, YRޗTUHR׿}aEŽґTWHRv$Օ:*-IU#T!CR/THU YG]Xq97#gC$./rϺ~~\+(8BKxr_ϗ D7TL|U(+ Y1b:$TȊS!+BVL# S!+BVL Y1b*dTȊS!+CRL Y1b*dtx_1G%T@\a\ksb=Ubn~OqT%(f/w )f\7u*$\EO:z <'IaA]*8+TvP !ۦÎmiQ~qD݉Hmy"dG0'")LyH6<!'")LyH my"dGmmy"dG0f0o#M9UL=<"[WyFGQ䐽3vX(cf ;^yiDg#(R3&<"++erV2JIrVP&i~Lge^1ݓsybA&i3)3dn 4謠L~ K$uYTvL~$Wge}SYi$/rIwq._I&iYa_i}%m?9+KL^9+ <+ŜWJkx4rV^yV+X<+rV^J+ {Q^yV`} 29+(gl}ɔr#%֍gb *K;VbUL/+mSmBmS!ۦCMl6m*dtH9`6m*dtHm!٦BMl6m:$Tȶm!٦BMd# m!٦BMlm:$Tȶm!٦BMltWHu egb 8׷ k8~L TX6Y XgR k#鞧o&/x/&^dbb) r{0_E3=K?)xA gqr&msiW^lQ WHT6*$m+ҽ|$W[]qُ*Aq6UXy8WxTFU6҄UZ k#aJFR-WP׷JC*AiYAm勪$mozz%hHo質mϘ4s6+N.ɟF\@7U6H'Wk*mT+Q6ڸ8ƻ4$4#tTYh+Q6Jg Y=fVH슋gqEU+sޖ+qEW* ;}WT]a ]al˳nv\qκq]q˳n&W $T%db.~0XGǵ}y`8l6Hr@``b VibMm1fqL>+l04m1fqm䖦 YOQdbR) r[LYSF̏ r(MҤ_!x =ܺkT!F4}WW&+D K3"*8{㍖?FD|_ c)GP)ˌ _e/̈=*8󟯿S=B 74"Б*8GT쎠 \R 4_zKFLTn~l/b2yak$KdKdk$Kdk"Dƕ^8Wo_FF4/oDDF4Kd{GDF4Kd/oDF4KdoDDQoDDF4K<%h7_"_G4Kdq[;-sd-Y1b7_//u#hz[F/޺續5;.Y3Y31qeaGVLo^F@o#T >H?|SBG1MvdƈΑE~65#LAVϠcD_?|/#c?|1#eF^"7~P|*<#AGb3co}̸#`3cd2ǘ7Fn0k#Df*xsT_UQ/bƈ-_FVo%h7_"߈~S7_"A`׸"}!KdKdk$Kdk$KdKdk$Q/////////oFDFDD#K_#I_"K_"K_#]YIW/#+68ueM/MqȦHD6D6禗3=:Eu%;_Gf\6\2"}y.}![_Go&fŽѧ21ted:2b79a^oU^`#Wwˈ< ̿cq,OLfDo||_F;r/7WGk;PR_uK M/#+6xsaFkdKzG"ӻ>2tytYq8]G;]FFG.?=~DD.D#%%5%5%%5(HHHHHHH6["[#["["[lolotMd{k${K\х#do3.[G[F7lotIJd{Kd{k|2"vglholt+V#l359ۑʖe*WFlͯ]GX7k2"ʆ:|^FsdI:6knGŔm>6~?56L eY_S_}Q6|oGP1e#*ۼie pdFD'VW9~_/Ɉ)oGXedE2laelH#ϕ-#l+֑ʖyդ#lo~6P{k~)%5]ueĞӨ=Ow,]FV#.#+zs]#]"]"]#]"]*%5޽Kd.nDӻMYF4KdnDӻDֻwTKdnDӻDֻMYF4.nDӻDֻMF4Kd.UF4KdnDӻͣ]"݈w#%uzDӻDֻM;FDֻwT/aQƈ݈wGӻD$hz7]ލ5}6qe]FD0#kzֻwg<7Fn4Fѻ/am10ed1:zGd7F.#wό:rw߀1FD,~{Dn`/nI]DI2GH剬7Cǟ#w܎j3"z7;S2z͈>U;VՌލ?z7FN-EM31*¨O{ßz7F32bzcd2bzcDLOegd7##O ٻڤo5o?˳w3ʳw+z7FVvudEʎ]FVn%ލhz7]"݈w~z7]">5%5%%5%5%%5(zHzzzHzzHzzzHzzHzzzHzzHz7]"]#]"]"]..ww+z݌KzבzֻDֻ#]#]YY]FH>">ewwYѻ<׻]G~.#twߖt\ro#t7?.#t#>\G\FHWsȊeD7"("ws[("׈"w-\G6#+"s\#\"\"\#\"\%5Ƚޗ)FDFDDFDFDDFEIYYIYIYYIYIYYIYIfKdk$KdKdk<5%%5ҵ7ED.qE2B"fD{ϕ-#llGVF$%5eF<{K\#,#+r֑r6Gi8eȊu?z󅑲}D HrшYGYFV,#ldldȌYGqQ#edA#Í#|o A#g݈wٿ7}~PLj_y_zE,yZG{ZFFG<-=otvC#{n{i!aQ6|EjFL߾*-o#lY[2lͻ~Q닼kqv{Bə@lw-ܟ l287okҽxv[Ìin~Kiiw_yY/zokhdOm i!73|1#"gΏ{Q9dȍ}} s,YGYFVvedE:\2r3'92iyݜ ~/$Z⊜u乜elFr9,YFV#ύ,#ldddldldddld~#FF7:=qG߉pE03]hdgD#"ȮFvF43],`dgD#;#ΈFvE03`dgD#"ΈFvE03],hdW#;#ȮyD#"ΈFvEʞ`dgD#;#ȮW3슛G4+¥hdgD#_:ȮFv#;GyldȂ]#,# v<ְs5슏5YаsD4^аsdmk9>s5슏51 ?ע_#?y;Q {a VhaҿA jͅko Ӱ񽿏ƺ#aOl.FPÈѰy>vv}& ʯϷ#aj9b0x9ra? #FkXFV>y<ְsdAѰa~%Y5Α#;GcFvsW#,5.r}FֈvE0psD45쌤a uR5{5{%{%{5{%{5{%{%{5{(HHHHHHH5W"W#W"W"Wݫ++ݫ+ݫ++ݫ.3{5{%{%{5nٽґqFrʈ:EˌWGD*K֑ jݯaYѰZFL.#5,#+ckZi=ӑ0ZFL[:BѰ)TS{5llҰK 0zm50|.#a|K2"6߱97?MP);~?b0$5vOlI2"Dߑ6G4#5,#aa~Y@ kD^pedE2"usY^7sW#W"׌^ݫ W"G FDDFDFJdj䛌Cw_}Wd:tͧ݁FCw|Wd:t٧݁FCw|g4:t٧݁ECw|g4:t~ԡ;>u3OS?ԡ;>u+OSOT:tͧ݁ͣԡ;h>u+C}g\fہ߸&QXkt,?GvqWY3f=~#+tض5]:nsdMŽȚ.7{I$_޿l~.o< =4w͏ɛ#Ksu _8y. 7{񉮎.o5"4~OpfDtEtI8k󝬺uk?EE^,ұ1]:n6\Vp#ͯ&Qw:nߜhTn0_$&Qm,QnOT:l}Ia[M4vB%g4:t{YEP:t{vIT#IT"KT#IT"KT"KT#IT"KT#IT"KT"KT#IԌ"Q$Q,Q,Q$Q,Q$Q,Q,Q$Q,Q$Q,Q,Q$Q,Q$Q3D%D5D%D%D5nYIYYIYIYY1HT#]YY7,QtHdJdjKHT#ITI2"<R*#+>Ց>5GħW|#}*#SwʊOedŧ2SyS[ONYٗs񟹃T"9G> "Qy.Qaj$JdQ$$*%O"Q,Q~;!HH"Q,Qt;mHHHHH5HT#IT"KT"KT#IT"KT#IT"KT"KT#IT"KT#IT"KT"KT#IT"KT#IԌ"Q,Q$Q,Q,QGFDDFDFDDFt(HײDD#KT#]:YY!H"Q!)#bNH1ynNsD)qŜ:D댬SGSFȜI>sGʈ8$sG[޻x#F_Y}vFVh܊Q@GP4?CwQGH se&#z 9"bV~.#,F4UGP"n׈`431J^#,F70"Fs3_#(F?11b?A1ke(qE:\2Ÿk|nC!2HPEI>EvIvYvfi$IdiӰN"NEvIvYvYvIvYvx.ȲvIdd'egDMvYvF4IddgDDwTIddgDDMvYvF4d'egDDMvF4Idd'eUvF4IddgDͣN"_F4d'e#$h3N"_:Qe'e#hy4IKLj&;#$Ce'egDF3D4OpY3{diRFLvԯSkFVdgNFψ=Mt'&O*@kޓ2bޓ=cļv"wgʯ1bC/4#=d=#=E:#=$JG{OQ?cDz\F{c!1#=RG{i䡥ןyz\8>bٚƛ1b{qO@f5 '#+3FVȊ쌑5#&;~Vd'O*;,;#켣N"Έ&;~Vd'я*;,;#hȲ3NUvF4I74$4$$4$4$$4(HȲȲHȲHȲȲHȲHDDFDFEvYvIvYvYv7,;t-KdIdikY"N#N"N"N#]:fikY"N"Ne.,;,;~i$IdIdi|.;1y.;sdIv2";AAG|n8sFrDsOA Yqv. fdeȒtd\LGeIe~ˌKm?e>5Hu]ߺq|ڧ#2LQFenexuTGe/n_b2?mu],L pG iLtďLsUȊdUO**~Ui$UIdUQTT%UO**~4Ui$UIdUIdUi$UIdUiJ"J#}5Ui$UIdUi$UIdUIdUi$UIdUi$UIdUIdUi$UQTT%U%UT%UT%U%UT%U.>**tIdUi$UQT%UT%U%UqȪHײDVDVF%4$$4ҥcFQF%$4nYUґȪȪQFRDVDV窒U ^|)qO:OWs?I"I#$#+OtU6fTɈl<{/kskɈX ll,YKG[KFV#h-x=w\r-qHߋY .Z IFZI<k$ߋY_:ֲ04v!$O%k#&rkM"k͈55#֌hZZ3iM"k͈5#$ּjM"k͈5#$֌hZZ3i͈55#$֌hZ3iM"_|F4IdyG՚MkYkF4Ѵ&qhZײMkF4Ikو55#֌hZȗwTIkو5#$nMk1i͈5~PIdѴfDӚ#5|8ȊּG93pF\3X4$4$$4$4$$4(ZHZZZHZZHZZZHZZHD֚D֚F$4(ZZHZZZӸydikY"kM"kM#]YkIkYkYk1hM#]YkYk75tHdIdiKhM#iM"kM"kMsɈh ;ZCG9"Jdi|2Yqs)#";:쌛F 7O8Ѽg}‰=N4}p#{B>D 'OxF 7O8Ѽg}‰=N4}p#_v'޳>D Ϩ޳>D 7n{v'h޳>FtO8Ѽg}qMvr>o6)x>mD^`',w ?Ӹ=azf#+޳Wfd{otd{=F(Q \T \+V}>OL_*V ̌5 ?#h,)PGl t%(PG+PFV63w/@wꈟEY, H 4(P#)P"+PEY(/ H H GyQknd|_s#+M6לh DS57mh}͉@kN4|_s)Y65'm9h}3mh}͉@kN4|_s)ZFV5'myFU5'mqh DS57Ch}͉@kndl3G\f7wff>o7ᄚ5l3ȳ@wʚmw[o~Q |(#+OeltdņlCn=ˆbCngf3.Ț m7ǟiC!UFĆ5]ANnv;: m9}׈#hC7^̆z7?.ІM'. $llq^{o$6m|lh=OLlfCvyZmhЍ~V|;tۡن6iͷC7_mhЉfCond|;tՆ6}E3 ]lhCgD"ц6tF3 ]l(m`CgD:#Έ6tE3 m`CgD"цΈ6tE3 ]l(mhCW:#цyD"\Έ6tF+µhCW:#цD+µhCgDmp8#ц+ mhCW:#PFVlYk # 6tСh6t&+ IlCn>Сh6t&3 IlCn"Сh6t&3 I:QmMWd:t͆$}FC7IlMWk١6t&3 I:QmMg4:t7fCn>СC7IlMWd:lG|6 qEȊۡϑ5:nvF*k t:nvFӪsdM|#|f:|g)q3ZMFVѦ@hawFyν;?^Tb*;o0Q z9b tb 4U>юsdM݈q{=7?_ks,< tyϱ3YvF˚?#I~FV9t{$}EC7I_=n{$}FC7I_MWCzϡHS''''''gFFDDFDFDDFDFDDFDF{{{{{7=t-KdIdikY"{O#yO"{O"{O#]:fikY"{O"{O摽.==~i$IdIdi$Idi|=sd{2{2NkΑȊtdd{:{2sdasȊtddagtF#="sd{:3_?_yY>G{Zoi١%?١W{#";7M&;sdEv:BȲ";a!A#Kӑ粓ȊtddEv:\v2";YiXd'eO";$;,;34$4iXd'eя";$;,;,;$;,;~<Idi+FDFDDFDFDDFEvIvYvYvIvYvIvYvYvIvYvIvYvYvIvYvIvfIdi$IdIdi<4ҵ,e'ee,;$;,;,;tQde,;,;GFt$$4Cdd'e'ed'ȇ%NsȊtddEv2";y.;Ykddp:p2b8sD g|I?\#l89/AȊtdD gU/2Ы®|f?Zs2b3~?7G]#,;sdEv:[}n~ȭl|>GDn~.)YR*+ sȊuedE2@(P"+PEIYfj$Jdj(P"+PEIYYIY(/ Gb@@#%h 4)P"+Ј@@#h @@#h 4)P"+Ј@#%h 4)Ј@@#%*Ј@@#h y4Jkو@#%lDSDVMF4JK;%lDSM7@|hDSDt%h 4)P"+Ј oFVl=hCcl(qņGd#!j\󞌰yOF{F\1bx? -NFPvrϯȚGe'#+3Fd'#(;qУ1a*#";ɲu1~~١?~1#k#k3Fd'#(;B-ٹDv~/$; FY31f8sΈf8~UId ppF4IsΈf8~WId gD3D6p 3N"ǹ (l8d8l8l8d8l8d8l8l8d834$$4$4$$4$4$$4%) gF1D6F2D6D6#N#]ppZȆHȆȆHpZȆȆӸydiKG"N"N_:pppppW #Ϸ8ϑ%NsNsf挬NGNFVd#$;+Ly$OFV#=n{2}g,yOG+#+ӑޓq tU)#=w\ԾO9?5{2=arK3b?g,yOG{~,yOGp[Z^Y'===34$4Y'======~hIdiC7c4$4$$4$4$$4(HޓޓHޓHޓޓHޓHޓޓHDF{{{{{7=t-KdIdikY"{O#yO"{O"{O#]:fikY"{O"{O摽.==~i$IdI$oG~+2Ÿj|@sd]^!< 5>PFVl#m(#fC# [َ<,y.FY9#5gdE:\2"b4qs}*#"Fq*"F#,F7&F|9#&FmbD/ȊuedE2"Fy.FsdI:\2bbW%1ϗĨ#Ũqņ2bCP"PņɆنfj$JdjP"PņɆننɆن/66rJdl(mhD͆نF4JdlhDDwTJdlhDD͆نF4l(mhDD͆F4JψfClC64P"ЈfC# %n͆Z6ЈfC|-l(mhD͆jC|-lhDͣP"_:F4l(/jClC# fCY1b6S^sdц?! ħ1bn5#k64Fl(#+64Fl(#PQ!_ T |(#k #@B Yzw{GVh0şGP7E~G 4FLhNFDQK3" 4~<湞?}2" t c : o{'k t??S @YQȢeď=w_y͗`3xݗ`3y׷=3zψ=~FVIdѼ{{F4I3zψ=~hWIdѼgDD{Ю3yO"}yO#yO"{O#yO"{O"{O#yO"{O#yO"{O"{O#yό===========tJdIdiO"{O#yό=====GF%$4ҵ,''.34ҵ,'qHDDFt4$$#=#ai|=sd{2{2#7>gqEv:\v2򉰎S?tggļMzP(#+ӑޓ#K–#=c{2"ރsѯ|)#=D~=W1ERA{mF{z4_򞌬xOG{Y1z{2=#t'q{2=3xO"{O{{{fi$Idi3xO"{O{{{{{{.ޓH{0i$Idi$IdIdi$Idi$IdIdi$Q''''''.T==tIdi$Q'''qHײDDF%4$$4ҥcFF%$4n{ґޓFDsɈyG~+'#/"m3e #Yt#55MZ,+..gYqFrDveee,+..kqFrDvDvFrDvF?\$4z̍2`nd|s;e6h.Fvw07l9\f̉2`N4|s#;2Dsw0'lyFuw07l9\f̉2`N4|s#_6.Dsw0Ϩ.Dsw07ne6h.Ftl9\f2mff?"?n33/l^t5/L\Fn-!2w_GdaNn5 l#үnfe-ff63lwZb-ff|TGZƟokn63k3"O3AKe>W~xVFL`7?L`n~ǥ'n2b`f̍&0U~4Fl-mEn4U|q曎$DS77lO*o:n曎MU6tȪF?l鸑eHȪHȪȪHȪHȪȪH2J#J"J"J#J"J#J"J"J#J"J#]:YUYUґȪH2J"J#J"J"JUe**t-KdUi$UIdUIdUiKnj*t-KdUIdUi<4ҥ#U%U/***+V:gUkqO2'y'Yy#$#+~~~?Ɉ<ȍ*y*Y^'2Ÿ,JO٘Ў|#+.sd9lG\cuspGV#sm~߿,s`~TFD`ppFD`陎^D`cBAAeƿL`nelRk L㚵##XaۀZhrߏfw&#T~>Uk9|?oYyZS6Yf-mdk9|?oZH;ˬ%%%%%%eFFDDFDFDDFDFt$$4ҥ#eFDFDD#[K#]ZZZH֒֒HZZ֒ҸydkiKG"[K"[K_:ZZZW#h-x4?\UȒddEU:\U2򖦎<KSFVkȊtn2b-yn-Y4} +ґ֒k#f-ak$1kϡ|DGZC%1k#_֒z#h-w}GW:roւψYSkXf-7?vޛrK.3G\#~IdiõL#L"L"Leee,+.H..3L#L"Leeep-.H...H..kqDvF:\\\&]\&]&]\&]\&]&]\fFqFrDvDvFrDvFrDvDvFrDvFt$$4ҥ#]\fFqDvFrDvDv#L#]eeZ.H...HeZ..ӸydiKG"L"L_:eeeW\#]ߛ4G\&#+{t;FYqXKG[KFZc_2G#ϭ%#+Z|H%#l-,:ak+k=:!kɻuZ?nXKG[KFV#\K⊪dki|'sdO:`DF?4$$4S$Ϝ'''34$4S$''''''~?Id?iC6|m#&|m&|m#6|m&|m6|m#_:^6nO^vFmd?yDM4?yDmk6|mΨ~}'/w۸y4?yDmK&nʹu/wFۂ-7_qO^#}}62'}!/w(Yc^7nO^n;'}'}'}'}'/wɈ =x_EdǾ׬dDEd>2?/C>|#+~wo>"w{n| }*/wGcUM4UyF?|mDUU^6TnYU^O*/wGcUM4UyFVm6+U加*gDU9#AUΈrEP3U加**WU9#QUrFT+U匨*WU9#qFT3\.gDU"J"QUrFT3\qrEU匨*WkQUrFT3\.*WkQUΈr#qFT3\/*WU9#^#URO2'q|aTZͯ`-Zo=GZ^ak9GU9Gy,0̼)0c9G&#*0>/qz5X`Z\r}b-w6b-w[ 9"r=?Z!k䱵#f-7_|.ddE`?F~f"Q`ΈsE?~je"Q`Y`sF+(0Wc4 A`ΈsF+~f9# ' L# L" L# L" L" L# L" L# L" L" L# ̌"0$0,0,0$0,0$0,0,0$0,0tHdIdiKG" L# ̌"0,0$0,0,0GF%$4ҵ,&&.34ҵ,&qHDDFt4$$LGaidY\9bCdrLG LFV&#,0&#+>XKFV#ϭ%#f-sk5Z2%#Kґ֒Fx1k#f-!k6#b-7if-7f-72#ϭ%#+xYs-W|*sdIU:GcQDVF?4$$4ITT%UO***34$4ITT%UяƢ******~4UIdUia]UYUF4UIdUTeDSDVMUYUF4UT%UUUYUF4UT%UeDSDVMUF4UIdUT%/#hȗMUYUQUeDSDVMUF4UI<$lDSMUZ6J"ʈ*#$UUZ6ʈ*GSDth2J_:TUYUF4UqMU2*cT%qEU#2FT%#+2FT%#+2F# [p_eEȊ5#&0)Z l(FZ?'YȢddLFVf4X^{_Y˄|~?Mf-7?%#+2FZ0D%#~`VkѬ%j-l-#h֒SZ|֒2Y;$h֒SZ֒2Yˈf-l-#$YeDD:0 4=%%%%%eFFDDFDFDDFDFt$$4ҥ#eFDFDD#[K#]ZZZH֒֒HZZ֒ҸydkiKG"[K"[K_:ZZZW#l-d#akim-g\PFVT#U%#T%#*xUsUȊt乪dDTRɈ F൤*aU_7U^UȒt乪ddEU:?DK'wp'y5~B iϑ?Ɉ|X򓌬IGIFO@w_̑%?OO,~H~~~gNDF?s4$(~H~~gNDF?4$$4$4!X$t'tOd?i$?Id?Id?i$?Id?iKh"I"I#Ɍ'''''''''''tHd?Id?iKG"I#Ɍ'''''GF%$4ҵ,$$.34ҵ,$q~HDDFt4$$й#'xI#ɌK~?s?Ȋt也ddO2'y'1?E:O2b~BdO\KFDU8& .Ɉa1K, LG-BgdkIRO>wEJYJ+RHRRRKDF?]4$(RHRRKDF?4$$4$4qW$7RR2II"KɈ&%#$hRR2IɈ&%,%RR2IɈ&%,%#$hR2II"KɈ&%|ѤdDDthRR*%#$hR2IIѤ$e#hRײMJYJF4)Ѥ$/RײMJF4)I<$cDMJҡRR2IɈkR)#&%,%Rg1#+R2FV>ӑ)#kR2F֤$#+R2F֤$#+R2FDJr_嗔ddEJȚddEJȚG$#+R2FxJ#ȟ#F#f"7_}D#h"iVfDLסtM\Mɪ0fdDȚdMdD3DDQM$j"#$VM$MdD3D&2H#DDF4yG5D6D&2HlDDF4L$MdD3D?تh&H?.f"d"l"d"l"l"d"l"d"l"l"d"34$$4$4$$4$4ҥ#M$M.l"d"3$4$$4nDZ&&HײD6F2D6D6Ft(&HײD6D6#H#]:DD!&H&&H&G#;G#n/A1#KsȊ~t~dde{IFD?~/+ohu/Ȉ9}#ϝ##*+Α#Kt|"#&砷9#w677MDiq"#D#E#EDcFF?h$h4TDD#E#EO",~ h$HdјQDD#EO",~,h$HdHdh$HdhcF"F#K}ۙh4h$h4h$h$h4h$h4h$h$h4h(HȢȢHȢHȢȢHȢHDDFt$h4h(ȢHȢȢѸydhkY"F"F#]Y4I4Y4Y41F#]Y4Y47,tHdHdhKF#F"F"F#F"Fsј#*-3"w yጬFGX4n~/+oȊhthddesHG?ϑsz8##+ёoɈ8ݯYq9yahcƸ?7%tD#_A2"qM`qSE,FGFFX4I4Y4Y4I4fhcF"FKE4I4Y4Y4(Ȣ@FDE4I4Y4(ȢRFDDFDF?h$h4t ,oHmd|CjRM46ߐhF76hl!5Dc &oHM4|Cj#RұD7&hl!uF76hl!5Dc &oHM4|Cj#_6ߐȢD7ΨD76nM46ߐhFthl!5Dc Ec󭧍,1ѐv U]l .Ի/lM4].ԻhlP;Bh$vUadd.]Yم:GvvՒ!ܱ.UWnM:΁7Ɉ8(v7柬:`Xtsl7#sl 5ќcgT|i9Lα&Ds76PcM~6T|i9L96dgCu76aUcMo2md|iV96dHR}i#9G";G#9G";G";G#9G";G#9G";G";G#9njtHdHdhKG";G#9njGvF%s$s4ҵ,##.3s4ҵ,#qHDvDvFts4s$s$s4s$s4>w91砻vFZD6_5Gd 䎎YIFVktEnP3"!ш2WYygQѠotE!#& A@jɈo_DqJ NV&7?T4ϒhdED#E#EDcFF?h$h4TDD#E#EO",~ h$HdјQDD#EO",~,h$HdHdh$HdhcF"F#K8ȢqF7&hq4D&omd8|h#GM48hqD76hq/oM48|hGgT8|h#GM48hqD76,oM48|*oM48|hD&omKGM48Y4"H[DgTqET"ڸf;л/}q.͠bmm\to:rk{PSf(~ZbRB:JqlD)!Rd;JcJql8n6XT6R#R4є3R4є~T8|h);@dJqF?٩R4єm*;@JqDSw6Rяma`JHJJHJJJHJJHJJJHJ1(E#)E"+E"+E#)E"+E#)E"+E"+E#)E"+E#]:Y)Y)ґJHJ1(E"+E#)E"+E"+E摕et-Kdh$HdHdhKnjt-KdHdh"A"GV"#+nvFvȊt Q7;dD# #+nБnqsD݀vKv݀>yu# "# MeAM_҄<ׄ& d4#Oܠ ݠ`FqF?$4Oܠ ݠZ~7h$7Hd7Qܠ ݠZ~7h$7Hd7Hd7h$7Hd7hßA"A#^/ ^2/ ^2/ ^/ ^2/ ^/ݗ/}hnݗ3|e#w_&|ew_&|e#_^/ ^rFuL47xͣw_&|e_: ^2/ ^e[. ^e(IeäfäԼn6Lʭ7L&f$㎬fä7Ln6Ln6L n6L*"\!#,wb&7/B0 } )#kB яy*/hB򭑍,/<olc ˷F&|kdT^5OU*/hB򭑍,/*olc ˷F&|kd# ˷F610!xF:C A# A" A# A" A" A# A" A# A" A" A# "$,,tHd!h$!Hd!Hd!h$!Hd!hKG" A" A#]:YIf!Hd!h$!Hd!Hd!h<4ҵ, e,$,,tQe,,GFt$$4C `FDFDFDDz&#υ #+B!Ȉ>vБB! "#&F9bBT>;B@!:Bڑ%}} #"ɓ|. AG AFV #,~!h$!Hd!Hd!h$!Qяy",~!h$!Hd!Hd!hSA" ADIYf!h$!Hd!hSA" ADIYYIY'BB?B_nI>o!h$!h$!#54|W3|BHBHB_:I>^# A# G-$#t4|BpFF[II>摄#54|ײF[II>KQ>kY# A# G<|ߗFF[II>o!h$!($4|BHB\>FX~tĄn: :bn #Oݠ#c7# >?F :"n |^ 75a7ds1nOtt##vFrFr ΈnnHnnA#A#GA#GGgD7ݠ#Y ݠ##vFrFr  >  >"3 `DsDv F47Hd7 `Ds  Q `Ds 1A"#$hnȗ F47HKLjn0A"#$n Z6|- `Ds |-`DsͣA"_:F47 /#hnn0A";hnn0A"#|!#kBBиfc,#1d #+cd=n}Fqc~v/2F޿ ^nLj1v?F>iz#v~H>iz#vg"L|?߿'vg"|?ߏh|?'!MGD:GbtaMFODoDoDOFQ>.|H|ttHDoKG"7rt|߸yF%}"7ҵ,>.3}#]>7|HDOFt}#'}"7}"7rtt|߈xDY7DϷ\O]ud]?]?AAF~x#r/#?>#vOՑwY7M?gF?]"7M?OJrןw~RFO宿OJrןw~tFODoDo']#~]#]X???gFODoKG"7]"']#']#]:?ґwt?']#']"7ne|ןwt-KFODoKnjrHײDO#7ҥ#/rHw|ןwtןwt?']#']#']"7>ψ}UGgd?#|߈O dF6#- #+0Gw- #bw_X1"/Y7-Y@Fnen2ba hX@#Y@"[@"[@#Yb~ Hd hX@#Y@"[@"[@$H0X@#Y@"[@@'HH:DF>T0Y@"[f#$h0Yfl0Yf|, i{un;L'?$Q,6 22W^0<1zդ$kl (\@L.@O (\ : & .`L.@]@ & x0A>L.`r|.+\ L.@O+.@e (\-Q0SGt &P0Av d & .`r &P0 H(r~ Ez."a ٫uSQS鸀\.~.[8D>Hr>xA0Bw#|>‘ P]ȯH(q鹀$ 't (\@0<.`ryB] L.@0ϟ (\`?E .`r+.@]@) ]t &P0Av  & Hߵ'`H'VAv 0$ .\ Av .\ Avtd`H.@] Cr !.@]!: 0Av 0e.eҹL]!Av 1`pt.d .!C:u d`O d .\ Cr .\ Cr H8." ;ߑ<9i~G׮>~E:DRO@nl0֏O(ZCjoPO}ܑ<~oM0OB7&/M^!5C7ӱXh r7̳Oh!5yAny 7y< Mސ 7yAnXh y:3& & & &ru ?}?}?}?}y>C>u<}?}?}&ruSuSuSu \ruSuMLM3e#'#gO?}?}y>Cnn`jn`jn`jna?&&HH& W5d5F$6D^%4&}Gc.!6y1^^ S t,6G^O05G^ϐ#gc? }y:#'#gg?? }y#'#gMW3̳y><MWLMW3&+XlB!M꣞!,R&/Mސ 7yCjR04yCjҩC! r7&/MސNҩC!5C&oHM^ 7y[ \&M^!R&/MސN&oH2An or7S 7yAn!5yAn r7&?`h r7&/M^g7tvGwvE v:#y쎜t:`g8\*Hh;GO޻'oOlCjtڹ#yFڹ s< ܐڹ sAn 0OB;vnXR;v.0hB;vng4R;v>`hMh +sCjR;vnX r;7)u}vnHEAn r;7v.ܐڹ sAn ܐڹ sAntvnH2An r;7S sAntvnH|R;v.!sC: r;vnH2An r;7SǀҹL۹ s[ !\۹a>uvnH\۹ sCj ڹ sCj r;vnH\9v.iiHj#k/~VG$  \ήH"Ӆt:#y: wv< ݐ: wvA 0OBgn'^Rg.ȝ0sBgn9Rg>`yN +tvCRgn'^ rg7=xg'{^ΐ;=x':=x':=x':=xgȝW3~+ ~+ ~+ ~+rg q+ ~+ ~+ ;=xgȝWLWLWLW3s=xgȝWLW0v{^N0u{^a`a>u~+ ~+rg wwwwݵt{Zΰy;^gOV+I"WG;ךW$tv\츢"M'm:=bg:=Lg'^ttye:unH]; wvC : wvC rgnH]9ΞJ"`yN +tvCRgn'^ >ynϝ];{L` .ȝ`SgξL`|(: ^0uvASgSG .ȧ rg_aSg^0u 2L]eSg/: .ȝ`SgS cgsY .x0uvA>uL`; wL];{0v rg/: wL];{^gW;;>{^gW$ONb;ߛvvEB;Jx!!*tzxEz=" KS̓L=`W{`L^0p<=\{x ..L=\0]b^0.=`y{xd*pAS/z TSww b! b B B b!pA;AC8ul{\ACC8ul{NC7=|7=|wx{\AC8m{o{Nw b 2C8ul{0:zo{o{ r B B b! }j`REp% ~i==n"S V$JN?ynyc;Jj}-h{0hooڹ ) b;abq;! b;  b;ap;! b;vChvuL\eS;/ڹ 󂩝 `jS;SG0󂩝 r;/yov.粂L\eS;v^0󂩝 c `jS;eڹ : v^0s|\y v.`jWyL\y v.`+iIO^%t٫u"6gg7LKI~#v^ghڹ" v.g4L\0Ob;v^0󂩝 r;_alyy+sAnS;/ڹ`v^0s<\yW۹ 󂩝 MlS;SL`j v.XL\Xڹ!sAn r;7v.ܐڹ sAn ܐڹ sAntvnH2An r;7S sAntvnH|R;v.!sC: r;vnH2An r;7SǀҹL۹ s[ !\۹a>uvnH\۹ sCj ڹ sCj r;vnH\ ᆝƭ>%m绵"[Sv`XaG$vKuyCcJ[+֊t#ԭ[Hւܭ )tkCւܭ[R0tkϹ(=G5?Cz0Gy=ԏS,*;xl~W/y |Ÿ\NY~>_9뽍'b=GrY?h|.㹿_"k^c=|h-Gcc@ucSǛ:'|r5?}|o|k }?G|h)Rgy\!N]s[6@ώ9zs;NZl|~.]3.}\l]Ѧ\F[v7,U7ׄZYoWN[:X܆o=6a]D hoۺߟ{yBW sV?=y瀞AW}?gopfM~}|K&0*80>7𡫾a= _3tf?YO<$׸F{V;c@,w5?wg, {w< ϑ'hoc"h>hVį4hCu傿\hMj ^]:oz[}֓'v>j++]pv^D#egL!]SǾOu\NCٺo>߲i_}L) Ԯ u~]C׵]?O{RpF=?%=ֿן)ʁkSިDgpuO-}㷊_j|z~ou{mY[wcj{|]}/_*Ͽ#5[лӷU[~uZ]~-g~ex}[\c{QS`7_LGֿ3^_??'?\/O}~.Uoy1Ⱥ=o_xKS<>sH?sߏ7{wE~ߛyXw/7m<l{<_\Y/<._Fx?oG]ӚXߍ}e0Nߢ[JzL_;Kex<-]]/xN1~__zH_þߟQ~ֹ#B;q~N.OLϹ󃼆fW0޾}?퀫3{;z}8>ϟ<2\ ?/3 / Y ?ϟ oS?+ ~\?7__`/nH_ y .!4D.p ?>'t_O\?i4 ~75W~^C`HYɀk "y<+]d?/4,_E pQe6 5j-|\?y,ϫ, a@|#?p_#"/r^"m\/\Ƒ+o>p|SGnpk޿ϋW^.iy~\ȡ-.ty8\O"\*3ӆ n}4E&WMeZ~|Cd>QF>*2UE/" p^UEw~^vm˜6x ?/6ˮ_=ß' ׁɀ.:p+\nx_ul@ \nx 9"\<8Kx/t_0~^nx :O6)ۤ?IygcWM0 Md`H{Hm!A l '{m!wA `H6AmaP l &M0$ 6Am!wA d&M0 6l A d&Ryd 6l ɀ&M0$ 6l€&M0$ 6l A T&M0e6p2 l & l!MP$l3MΤH Ak:lSE&pwJ̵E&ܫ5HZPHv6_e!Vhx??KEx|5r܏>xj"l)z_[!zC/H:>jB*–BF)rHr^ " ERLbR/rAl(ұY ERL`l) &K!Ȗ5+Bkb)RL`%K!Ȗ`dKQ0Y A(, [FK!-Ed)RLB-Ed) &K!;xY DKQ0Y AർU4 Al) i 0$K!ȖB-d0$) Ȗb`) R0 B-!Y Ad)R0$) Ȗ, [ Ay@RdK!Ȗ, [ Cl)RdKa8[ Ad)R0X Ad)RdK!Ȗ [ A RNĖB-!Y0{vjERӸԻs#d)cuoH,5+_[-ŵKm9Fho=–V^e}wKɏfD@{Hx5#7P$XvE-#|Œ@H>-#l)-8" E]0$w!܅ 0$U ܅ Av0$w!B݅! Av ]0$w1`py@]0$w!܅ AvwaUAp. C Av]dw!p]*dw1`p.]w!܅ Cr.]*dwaHB݅ <. ]dwaHB݅!Av. ]0 ݅ Cr. ] ܅ Cr. ]dwaH@݅ [. 'bw!ŀ.Ҵ6T FHU$ ,B F(pMEhPƭJ=!V /v 8rb!;5iZ/Bxzu"l4~ZN#13aq7QW\?"TohDX~!^CH0?NQd\=RsjH0Ԇ#h41yNId4>H2d39o4 G Eh0$!FÐ 0$ FÐ  A60$!FC! A6$h0$1`0y@h0$!FÐ  A6aB0l4 ? `2=T0 A6(d%!`2+FCFd4( h(Fd4Y LFCFd4 &! hLFCFd4Y LF`2l4 &!8P2dQ0 A6+F`2l4 &!F`2dP0h2$gъ|3+B ;F'Ǘ9`?cG~Я쇕#A1~haWZ(p mG~TwV?X|#d?~j+o?Ǯa'/ڵЏWaSZg~l?~^Ec) ch*oRXó<DUI )LrE; cEN#OE~Zd?A BNLIA2%(`'+DuEOٟL`'%"`'?dR0A?) F"IOٟLDIO &"@'YWDR0Ac&bHd"Đ C'OٟNCO Đ ,c]KK :1j?*N:r\%R:d\:wٷ(\KuWtu]Kmŵ0}`YkK/Wu^jVZĎk'()\ >IZM|W9U"ɵmp-ɵft-!29Dג^ZHt-IόH00$<d#p2 60d`1$#Ɛ A60d` 0(A60d`d#0`` F !zHƐ$F !!A60d`1!60$<  !A60y@1$#Ɛ A60$<d#0(C20l`dcHC C20l` 'b#Ɛ C20#Ɛ C20l`$&$/CTGn%"Д24W$]3y58pKfg*/ߊLf~|w4کH0;#hvE7|dH0;x#hvjb5o`vG&fgtx_fgNܖcNE-63E7٩̵N H0;H#7c f#hvƽOIfg\߷H0;+juaCbY`v&P|U:ZEW5dϧzOpR͎!A6;lv 1$#fG͎!A6;$R1$3`0;y@1$#fǐ̎ A6;[cEJ0;lv [<>APdv &#{`2;lv &S0JfGEJdvV͎ ES0A6;dS0H)̎ LfG0(A6;)̎ H)NdvLfGp2dv &#f`2;lvVNdvLfGNdv &#f`Tgv54MEBpd"p%Hr8UA3Xt8U"Ex"g{[gv阝$S"`t{gv阝̎"3st.<ëL· Rdbv)NM-GI9/lv}}dvj\ uy3V8\ "|)"A (LJjIfA)|Kfgrfg*E4;D399ɿ{Y}|nBBn($c$ƨ`2Fl &cT0#A6F1dAS0 1Za4Fy@LHQdLƨ`2FهDc$M4F1$e=#C #A6F1dc$pdc4`0Fdc$Ȑ #C2FldcdHH #<`  1dcdHH! A6Fl  12 #C2Fl   #C2Fl  1dcdHHc N_H# 廱¶y74" M^%!B)P<@a7DgRs?#vX^ ks kk[A7Tu\atc =PLPw]~!G&np " UU۞#+vib5" 1Q+P*LpCZ"v¾#h[&p? ?Z0ɡ9A=}"|%π- p&gQFRNHd#Ⱦǐ| C+{0<{dcHG} l31z%A=d3 %cHd#Ⱦǐ C={NC+{ ǐ| <{dcHG} C+{ dc|!A={ 1$"ȾG}!A=dcHG}!dc{TE@i!ArC4[r`#)HNK!E#&1Lƈ#zD1ʯ^H0FXIƈn/qDՖ낊#«-W?,HZmnQ$#4F(3 ƨ;:D& f'V;92nH95"3poe0Fd#7jq4FcT ~c>M6F@"A1Iƈ̷#x5J&EDWIv)Ӻ@VZh*D^%]yDˌHSv(OwWIj*ZͶykHZ9BJ [+CVl I dkeHj` 󀂵dkeHJ!Y+AVl 0K`%kfk%*UdyLJUd &k%8CZ $* dkU0Y+y0gt̙"s3RUdvhG؜S$3st̙#t`rdt#fCH,##{;|OlrNl2l- ;2E:rdّ#dGfHJJ ;2CrdGf ;2Crd ɑ #dGf PpdYIG&Ȏ e]/9€6lv{hvl6l=l6Lmؑmmmёёёmؑёmmmёё#"cc;E:.{Y1q"3svX5~LYf=ٮ"'^Ͻn wHG9^W,K=rȭfwr2gmMal[}GN-\GN-+ym092pZ{.9isEȜm09)3:2PQ[$9|8-l[Б#" GG>|vld0jiY?l( { {d< voDCpoDCpoDAto;fbAto;d<d&*[yLM[ &&8Cɽ * {dV07< &&`ro &V07AV]{dV0ɽ ]{dV0ɽ {+ܛ ɽLM[ٽI"ɽ] ME{d6BϽ)qok$0sHroyDV07*`ro%&j:gn9EnhT$"OWfҸ7tt<iz:E:"i4xy:Eѵ4[$x:mɷHt-žGӍ=3|a'OWkur=F}h/~ttQyOzz1G[cHӭHtuS.1r^EEzNtu򇧫Htp #OWS[R;E:"Ͷg* NX=O{E:ϑoDZϑO3Hc=¦>0﫯o`j*wX}+R3)¦E(4}'i9 0kq+ir*갓ֶH0}AW~de~[Tp}_+%>Gn[y4}$Wn|la~o`I%[djߑӫmƽ{3_'HNx:G{:E =y5GPjMΜMFݲw${7wؖS9 No2?NS!&NO!93 NO!9=Avz 3*8=ìЂdgHg-Ҁ 3=$Nϐ ;=Avz=Nϐ ;3$'N0(8=Avzd'Nϐ ;=CrzgHNO ;=Crz dgHNOyHrz$n N,wzKgGWNfy7Nn9=G &7Bpz!t"H9r;}"od'w"NoDZNϑNOq+xaOT"Vv!BN=a슷Hpzfٚp N]_ !o[$8=ZnӫwD"9EӫY۶<AG-"KU\~;F*{-mi9=E:NϑD#qui*]ǵy#ƵHrzM_Uӫ9r)2}ZNOp"Ey[NOc9o>E:=NOsS wvg2}>GH þ!QJp4 A4$(ѐ DA6ُh]0l ُ=ly@A,  A, bd'{(DAvA\a4l &( bd LQ bd &(®`2l &X0DuW)v=//HV^ -߇%xŚQ]`#o "=wBmh繷[cA "o-iH *1AuGDG_WHBEuL6*ұ4HrWi݃HgAGJE:+*W&7t̤#ͤ"3H0}1t̤#d&;fRd&'c&Ge&9o&a3)fҐ̤ IC2l&Lf̤aL 4d~DLf`2 &3)f`2d&YLfrL ,̤`P4d3Y0IA6,̤ L ,dd&fR,8*t|eEd_Y0ʂW ,|`WV++󕊰~El F37i&a3YlG>|_G_Y+ʊ$_+gJҐ6lq9Ȋ"rMۨ+mdAYTd%9HEA'COK}q r,FXUU$8H\t(bE3D*u9FA?Vp. &iEA后ˊ3YK/rT4߿Z^fC]M3 "LVg&Ɋ$39G3Y`&"eGLNM3HLVg&+3JiÎtdEzfr|Y:Ұc+ҳIQc+BqS"6IZ6*ұFE6Lq2mTm㤏6m"Xd &(ȶ`l &X0FҢmr/Ƃ6 K^%FC FA6>2d(ȶp6d8`d6(ȶѐl FCl6dhHQm F|Y 'tdECLVg&+̤`LV$IA6uVRTG:f"=3 =3YTc&H4y`h&}%$Wa`=[̂bLS0;h14`nA(YLC [LAbd)pb4d9`d1b)Ӑ, [LCl1b4diHS- [L-ݦdbޏd1i>^39{tT$M8ns=iMGm^%ɫ4<6ME:nӑ[U:nr6ۜ|ZnsD4ī.nE:StTdnh-21ƳROExA.cgkt?C`a[N} vdG7b|lut#";HuvXnPw;y;Hǎ*U:vT";:"-;y;Hǎ:W bt35dg:BǙ:rޙ*U3Ζ3UL!(qt#鈴#yC3L'3UL!g*Ta6fE ;SC6eLy@3- ə 3-iL'{(9SAV3]atL &g*iLٙLTiL &g*Ȋ 9|PӤeEȯUȺ棔"yC.VHVb؊\"b &[0&%'슐gKE:"=C[Uch+3t iڊ}b\l=[td`Fְb+\dC;R$O.Jmy[Er;^# =C[dhCu!21ܱHVgh+ m c ]T9n~C;]mq( -H2Ш#hhbTE׵ǫ U8) XȴUdh+ m *1ڊ "hh?0 wch+B֐\ X׊$*رI5Z:r|EzUuHWIUc]+ҳu=Z/dC{~U֎{~"=Hǯ֪y[ulKӺ*ұYWEغLֵ`)F*%gu$x_m4 Al] i u5$*Udu5$)u`] ɺ u5 U!YWAd]ٺ uMGG>e:)Wc"_kI6"-yH*\dw\"XAvɾN.wt\"ɶt\#.v!@k|] d뚿=ɺΆdCٺ :BǺ:r;CXWG[WE:Uuud[3੶;B.V"ŢXu&JJC"և@UZ#g aZpjHczvA늫~*kk} wSHuHV9ܗVu+^HWI5oK˺*ұ UuuuUc]XWGغoGñe]9o]a*uU&GλXE:.vDrtIu伋Ubakx*qVbg.Ub!+qtgH:r*q$-H:B.V] Xl53XAvd0XC XAvd+.pd;`pb+.֐\ XCrb;.֑.VvbإHr!Æv 툴 #lh "N^chZG ZGv\:r*1t #lhiƣH2AЎH0|]᧋5LW';yjYWuU$Y':8#筫"ɺN%X٫$7e]!*8SHǺ:BU0XW|t#筫"Høɺ^u_3z_`]||\W{=FкZG]k[ןןqaJ*֕Zc~"ɺ֐j2{~#7uUc]9o]XWE:ՑUd]iG[WEغ u5ay=h>O'UH;Z`Ggvt2Ehъ"lG &;*v`sݳkiGъhEzvTHώ*v`/Q,#- g{`Gw ! !  N QA;;A;b;A;;A;;ALvO{(k[aGHÎvT#lG̵Evt$;wrǎn#`G7vt ;GN-Ұ{"^aGi;Evt   !\%Alx=r;;S"Rm#=ix-0sgi8=təvroǙn3#xEUI;&u6[aRiE&uIiE&uI웆I" GnMnaRH0%3#i8-X'uv[L8 3 :f#tYQ3 :|N `r3=T09SAv3-d%g*Ȋ`r+TiL3- ;ӂə 3-i3U)7Պ'YS"hRA"`Ez&UI]#MHǤVgR+3tLjEz&U6I-3tLjEz&UIHϤVgRA:?dR7xMδ`rL &g*δ`r3dgZ09ӂ=gȭ1SHϙ*t*=gZ3U'C=(Ez"ɃO~񠊰A+󠊰-A+NyЊJW]#Ƀs\UY?=hEzTHpyI4'mU=hHσ*yPEЃNfOMFHσ*yЊ$*yPE؃NށA'yPENrEȎa3-s!g MtL_`ǎV$׺iGъ"lG &;Z0Q22тɎ ^{|4 AlG i 5$;*vTd5$)vt`G Ɏ 5 vT!QAdGَ v#hGHtDsUcGQGiQGЎNޗUcG9oGQGX%N;S3usHc=rޙ*U3|4:T3u 68GȤ UNUN'C :Ed+qNKXGλXE b9)EUEEH*my6G|?Feot#罭"ێk[mx[G[~Tm=s^PkvrU$ ޶h,1ޖ.FU$y՘wo{[X@U$x0u ? ޶ț}#m/ ^lmW,z[ݑVu`*kv\#bbG] 0aZVrhR:`Eؤ&í "ɤV$gԊ:%+2;&5hъ"hR'R4i5|&`2hR'g3I+ L^%ə3z~"=ZWٯZ ٤L& tf"tϿ`!"lGW`ǎV$&E;:y={ЂɃLT0[Av`d~׏a4 AA i 5$*T=d5$(tA Ƀ 5 T=!yPAAك v<#="yH)Rt<#=jxރ*<(-!x22E:t*޴U$x٫$:ٖA'xPGȃ<`ǃ:t͇UAajHTA t:TA=zɫ5 svw爄W ϻMEµx"x妎7t#獧"x":OE&%t'ɭH0q !y_*}9&p1YVKYZnk9/x⒭$I8גd<ԥh7t#7/yX2_#獧"xW,__k/;ƓTc<9o<a)W_iU6獧"xWx:s*!9OdjHT= {PTA$xPUA!:`yh< m@d1_ JA+ 0+W/JC JAWd_)ȾpWd_9`+W_)ȾҐ| JC+;ґjR&G?^T+9+G$JCy-_Hn&&t,#5"bN6?YiJsiBJ0:fRtL v̤#ͤ"Lbq伙Tc&a3iHfR0_h&'c&9o&IWhN񕎜#|uG R+9"WLq}eiF}Y"_H}??J4V$_Y޲a_Y}$_YԚyߏ+L- u}%޷?"W_W:roJGWN>JE:R+qaGJE:;rW*ҹ]SA99-ĕK'OE:sDZ6D~MÎTc1!)Ӑ, [LA-"bN>bAnME:nriHnSݦ MCr6 m di]pY%)nӐݦ `r=T0MAv,ܦd%)*`r+nSf6,ܦ ͂m ,fT6+s|MÞŬHb*ұk$ZLŬH<٨H}ӴYLE/oHbV$X0Pc1+BOn0Ŷd1_৯4$3A0:Ȃ=Svٱ"XRCgO36#iV]k/㈯`ٿKd1ș r& nw9f g3H&I1ȻOGi?.rF4Ov2d#3)2y">Ȥ2Iq'"zf&Fsg>Ls+MLdro29.ldr&E&o~Ė2d#3i2)-er&;N&ldr&~e g IDź{Dʉ+'6$nr&;dʙr&;d^+WNl^Itؼ^9yĮq+WNl^IqcZb&NAi;>ֿ|4=8v_uCsy3Iq[x3oVT߸:Vu%LAjcRԯieRx_=sW93A3yL6dL;(fAlIqлeL7tIћO%]&d|/6i2Ǐer?dr&;ldr&M&?o3H&I3 g3diL69A2 >Ld'L\&'6$LNl29$q#3$Uʙ켒{;V$WNl^9y%ѽrbJ{WU$WNl^9y%ѽҾ~]2ihL62e2^cd$e2h2ItL4$Ld$e2PId$e2d2I4 숮v#\11PDD "q# 0L @+AdD&d\l1D "13k_"č f8L6O 2"d#L6 2\ۘy.rkcL*F]L6ɍ ~ fx\ !L 32),DQ IĹxXLTƯ9&M_AL ꣿ3QA7j3qAtD8=|ID5W&EUv3yɄM;q~| b&]?bd#L6sAdₘ\ 7sAdL "  f\l1d#L6 "1HtAL|.L ?ʵč2Xa&fG,VX!ѭ0ѬVhVHt+$&v*VhVHt+$&X!qc3YL5جV8YfD‰ NscB[f~@ '6+$NlVHt+جpbBfD‰ '6+$VHt+جp lp& oΤÝ gB&nNlVHt+B&nS+d'L68&7ęq&MAIĻf'L^ AN NlxsAg%D?/1)wJ7d_b?DD?_m_%kLtK4#mD#K4#%*GtK4#%mDD?/PD?_Y^e%6?2qPl/>Kѥ/ѤLTn@Ӓ21#6_1dL6kQ6sc[_5cR/ΙlA2yLiOe?/? &~?ov>'Pykз?I?}n&yL2fwoZcoI502)wuϯ2qp2iÿ}y>~oew{v&~U`]HH_&ϥI*/c1˙<21_&7_l/#4l/#K_hGtK4#MK4#7߯čd3iGxb?&6#:MlU7obm&6ob;cfoߗ줏K&}]&Fޓd'}L7_we3L77dL^ۏR[c3LvdÍ |ΤX^/ gB&+ gҬО%[?Ԣ+Bs9Q+k^}+G 3)VoDL#31,M5_4+3)VoR/_?/ 4cVxͿ™+,;¿aVdc3)Vx Z!ѭp ˫B&~`KAdb wV82q+جV8YfğVh*%:M4K4ޱP5nz&6ӛLؽす4ؤ٤,]Q^3]Q*}gT黢HU(vF>KEΨw~@.}gT黢HU(wF3]Q`*}W;JUȥ"}gT;Bc;' &qOK4ΨwF5+qaz1٘9Y5iz_I5/%%]ȝȝ&r7_"rw/yS]E"wN"wM]"wN"wN_w&E,D<sDnsWI9{65q9'EDEn.~)M#tI9{5Q I9lgtDE y.2)"ů?|¿.M8W?xߟ;Gw;' &E,DŪ_.rW;c6"wN|*r{glֿnoglvs| {&7ΨvF+QB]gT{;ވnoWvF+QbogT{;]񱽝t+>߆D.1وDz]M.rDD9\EEM.r]M.r&rD9\E.D"GtKTD.D"G܈\&EF2y.rL6"E.D"h"Gt#%7";1;qco<7&nofoD7[s{cx9[&G[&ޘ}ϕ혬-8'Mldl-cvyt< #'@&ފ2yɄy?&;{c=dgo3dgoL66r?IU.r7Ds"qco31{]&%<{iD&6O#MlFtq/^Ą5?~9/R6q3)u_/_}fRK C42)¥WeW |@pą!Lpn3Lv<]LpuWl d^3iսL{ݽ&6܋xs@ͽ^{MlEt܋4^DwwETkbs/^Dwͽ&6"vgEܸL{V݋dڏ_oiSJ4JtJט薕hEt"e%eݲnYG,hEtJT,薕hEtJ4"eݲnYfYD,[Vb?bYfYD,Ʋ2iYEWX&ՊFZ%Z]MVDWDS+՗ӧX$h%4DץD%u)tWU͑W 1D#VǷ!&bRlH/DmHXĤЁ/k&nC3@ۤq\bCL ) ;t?O  \6i럓M +\ EF 6479fCu5?bL aCd6dcC R~eLԆn~) }@fL#t4}W d@iZ3waRI3Q_'5p)o՚9y+o5vp&Ek 0Q9kxLkDw 1i.b\-K&Mfs&2L&eLn]渦?>'IsOI Lv=ϙF`f<&6!Ll3 怚]`&63 cbM`.0X &0DM`.0LlC:Pf&M`M`M`.0DD{.0&0D L &s"0&0D~@E`.0&0DD &hCt!$*hCt!$]` <.0DD L]`M`.0&0G,CtI4!$]`.0&0D LǍdc\3ic3L&&0G\ L&*0FLh m2q[0ٸL&2 +0).w'f\X9y2L9Q?x?2-k".a\P$u}SwDu1.cWbqL^2qaqLe썄L%iL6.ͯ^K]EsNUZ sdpN ' CtI9 7D3 ' 膓hdBt!$Nb?b8D7D3N 膓}Nsa7z ' CtIט膓hCt!$pLn8G,hCtIT 膓hCtI4!pLn8f8D7Nb?b8f8D7N 'ȄCtI4!$ ' 膓hsb8D7D3N 膓hCt!$zN&~lpl '?&+02y.;L6μbwer/;U¤NJd3_J>VdIǺd'ǗȎ7&a1Ln L6f?G4ÙK0> '55äaއ1qÙx8b8 k.b0)31.*D GŤ^μblzg13v\Q@3)%7&pL0<=a1L0N& p2yn8LpX 'Ȅ膓hCt!$N 膓hCtI42!ppX 'P1N ' CtIP '0i+py5I4!p5&$pn8f8D7D#$p!$ppn8D7D#N 膓N 膓hCtI42!ppn87CtI4!$ ' 膓hCt!$pn8poh5L؟<ךczU&? 'i0;'՚|=cњLTk:L}Hl&ך=<#C&Eku)DFĵ/9aRFo}~wN|S}aǤ>Is?>\>'/;42Q9~qn&eoa&.d2</0ٸL&]e2y2LeX\&.h.Ct!$L ].h.CtI4!eeX\&PqL ]&\.CtIfP\&0).s^\&q2.Ct\fbse&6\.3 dbsw.Ct\2Dwe2Ll.Ct\.32~@e2Ll.Ct\ 22Dwe7\fbs2Dww.3 ]fbs2A&6\걹 怚3i.D],]0iLvZd53i ךi]Nk5̤h47U 51fRP _[7D GsLጟ|>߁:MqL2LwÙǙl g&\čd53i dsL6Z35X82i ѵfbӚMk7ԴZ3iĦ5DךMk#LlZCtyǪ5~@Uk&6!LlZCtشfbb5N2M`& mn֒hDtk!$+DtkI4k!Zo^!D [$Zk!$ZZn-DD [KY ѭ֒XKY ѭ֒hBtkI4 ZZn-7BtkI4k!$X ѭ%Ѭ֒hBtk!$mZn-Zohc-L(dbϏ:bU;$nޛs?ap&I=dRd O21@Ǖ5}nBmI&Okq[d~bRDo+4?gk1i~ϟye}g;?ﱕ0i~~ '7?+?a~IQL6ObyRT&ϟd'<&'G,~h\At?I4?!Oo$ܿԪ*vkIi-!e22G,. ]&\.h.Ct!$vu(. ]&Q*.sE93˜Q] Q]2gT9o^!u+ Q].sEq3\e(.sFu+˜Q]2W9eΨ.sFu+reΨ.sEq3\Q2gTexs@2gTe(.Ct9eΨ.sEq3˜Q] gT9_=\eM`׵05y,0D &H\sNk439ZsRn)rML`xW||E`柱8'E`2D.z9'E`!DĤ _ sf.GA`lb/"0|'79j?޿M_F䜔w!.U19'e߸5y2D].sEa3\Q\2gT\˜2762~eʘ+S2qh ѵ抢5gT9jEkΨZsEњ3֜Q"\kqĵ挪5Wt0&6شĦ5DךMk&6!޼BMk#ּckĦ5~@Uk&6!LlZCtشfbĦ5DךMk&6!ZCtشfbkĦ5DǑMk&6!LlZC95]k&6!ּc՚Mk5]k&6ش82iĦ5WMk7ԴfbFkޓ0hLLi ?ɛNklf&;Iњ=@?j)]S>'Ek5QK9Iњ9k: ej]bsN؛qޘɯ5sRƞuM^2ѫIA&IӚ(8|.Ek_jLb&?&q231730Lc&0DM`&6!P LTpM`nL4z23ٹLeޱ ]fbse2e&6\ա 3Hue]$e2 ee2DwěW]&.s22Dw~@e22DwDs ]&.h.Ct!$*.h.Ct!$eA2DwDsLee22G,.CtI4!$e2 DwLGwěr!$>wcrL w>0D]FO4T\.ä(?ϋ|M39s&2 Ǚs\IstLe 22vk.3߀3+w ̼bf \]Lx!?bR滩 J`41}DJ`2eIq߳eLF`2y.0L\`X&hCt!$ LsaLK7e>el\L$e22DwDs ]&Cq e2%]42D&6!Ll.3 j.Ct\e&6!.3 ]fbs2A&6!Ll.3 Pu2e&6!:Ll.3 ]fbs5\.3 ]Ll.Ct\.32Dge&6!zl.C927.l{Mߵ,{NvZĵOfҴFnqM\kFd53)Zs!C?'54[^{9)ZKtN؍jjIj,I9)Zs*&;a14yj8D'pn8LlC9f8č̤Ϳps5pl g&;ÙI3;V!Ll3 gb3f8PT!v23фbnkhDt!$+DtI4!po^!7D#$p!$ppn8D7D#N 膓N 膓hCtI42!ppn87CtI4!$ ' 膓hCt!$pn8po 膓cXd"O>Fk71dZc~L6Zɍ|MIӚy9<ߒmr5r~j NJ0)Z5D}Nb0)Z&HL=O~O&j8zc |NEs~{ñj8j8s1Lp{d ^4<7&0q9b1D#N 膓xs@n8 pl '5 4ù7 ' ppn8D7D3N 膓؅Nb'b8D7D?߿$pn8 ppn8D7ěW 'Ȅsb8f8D7~@pn8f8D7D3 'Ȅ膓hCt!$*hCt!$pLn8D7D3Nppn8f8G,CtI4!$pn8F&D7NG7ěr!$>7cR 'L:Fv| I1j&j8z&p̗I1Uu>Zcω$5&p,xօLn2Q31)d79&pLK&8&pCn8ا-Kk>轿Qld'd#;LO&tN6sas";)DDe'\v0N&eFv2y.;L6e'dEvMv.;DDNe貓ݢNb";DDw>.;D?Mv&6!+4egbMv7PC&;Xe3PMv.;]v&6ٙd2egbMv]v&6ٙd3!ebMv.;o&;DMv.;Xegb&;DMv&6!:Ll3c5ٙdN[ˎ[̤N9Ife4[xdcaΒgҼg>aҽ!ALU2q9}pǁ=\ץxB'}G=zeP&=z˛cҼG̤x>+LuLSdsR&{.UL}({ﱥ̤x݁5N^z̤y;V!:LlCtؼgb5!ng&;{lg&;ag&{=X3y=D{=LlCQyz=Dӌާ{퀈=DD{==D{O+ޓhBt9bD{Ob?=DD{OyѽޓhBtI4!{I4!{{=+D{Oyѽ'{==DD#!${{=DD{ѽ'գ{O{{1YyO&n,bsI=0)0is\_|Iіc;}3";zLTvBvr _oG:xŊ(dbRdGDegy|g1ifRdG@K&^<&MvL3qoUvVLdFv2'P7Ob 7äNm2&n8G,hdBtI4!po '0dpl 'dc8LppX ' CtI4!$pn8]($v2)CtI4ӭf8v@D7NBD7D3 'rI42!N 'P1N ' CtI42!$pn8$pn8f8D7D# ' 膓xs@n8D7D3Nppn8f8D7N 膓 'pn8? 猪5_^äi0hM&ϵFk2y5L L6Zj>bIJ&5z5s9 |EkE2QwD1)ZWdZ!;&MkLou&/4cUkQLʪ5vk21eaqL deL1]&\.CtI9 w.d*&0ٸL&]e$L ].h.CtI4!e:I R\.e~@Ll.CWhbs2o^2Dgeޱ ]fbsb?2e&6!Ll.3 dbs2U!Ll.3 ]fbs32e&6!Pse2eޱ2Dwe2Ll.Ct\fbs2ěj.3 ]7.32寸4l\f&eΓ߾ܬ#d23ٹ ̤D%̤>IqLe&eX{Is 42vL^292D]23ٹ ur;2D}'T9Nkf&Nklf&Mkޱj qdbkĦ5oi q53iZӿggTLvZsf&Mk5XZ3iĦ5DךMk5LlZCQqjĦ5Duڴ&ZCtIWZhZCt!$޼B5#Dך#I4!$*ZCtI4!$]k5#DךDk ѵ&PњDk ѵ&ѴZh8Bt!$]koȵZhZCtI49bkMi ѵ&ѴZCtI4!]k_=$k ѵ&ѴEkk 0hM&ϵI{h^k+bњLTk8L㩘2QqQĵ޿uL胣4y{BgyIњFς<&;0hM&pbsR0ٸL&]e2y2LeX\&.h.Ct!$Lsa\۬\&wR\l\e$L ].h.CtI4!e:I R\.߯2D?e&6!+4 ]fbse7Ps32X].3 Pue2e&6\ 2 ]fbsee&6\.3 dbse2o2Dwe2X]fbs2Dwe&6!:Ll.3 cs5\.e2w.30ٸL3y p&;Is!uʖ.32vLe8L͆(e.Se&2MIs}2zGL^6F3i.ۗGe.s yd23ٹ Dd5L6Z35wִƮd53i ̤i;V!:LlZCtشfb5!nf&Ekn:Ukn>JњbZ%n\f&;Is;V!Ll.3 ]fbs2:T!v.3 YsD; ]&^!L ].x $eX\&\. ]&\.h.Ct!$ee2Dw~@ee2DwDsL1].h.CtI9 wL ]&\e22DwDs ]&.CtI|.xs@2DwDs#I4!n\Is;7]g49OJ4fe49.|2L ܹ| 2zcLe7L#LS2OߑIq}R&2Nc\f~~?Ƥݻ9MNDL.saywde4(e꓍0ٸL&]Yݙ:I110qc̙쌁I3?/I3{SC&j  fҌcзNf &.lW707fҌ1쌁f 1&6c 1Ll~J?эab37Ԍ0f D7~J?f D7w@Tab3f D7&6c 3j ~J_ab3ACэƐhэ!ь@tcHy픞pb f D7~@n f D7D3э!Nn f D7Cb?b f D7Cэ!Nn D7D3C1n f G,@tcH4c 1$1n vJOtc 1$ztcH9 7C1$17dc <7&cDWgRL< 4yg&fL<#.2qy/~"z߾˃1"i1_GP&/|Wy䁉Csy`LL.DDCEDh@ty <$Ch@tyH}!Ey <$<]M.D~^]!y <$yo|D; !^!Cx <$ډ>EM.<]M.&DC]M.D~@EM.DDC].&Děry <$<]MXh@tyH4y <]D@tyH|xs@.DD#yH4y 6y&MOyDb?I=-Įn nI1=ča^?wl!5!f v^Τ]~L1|b z#cҌkpuп~~1$>7&cČ@tcH4c 1$1X!Nn f D7C1$1n f D7D;'1X!P1Cэ!ь@tcHg)}1CAˠhb3 Ml@tc،ab3+Ԍ1c5f ~@&6c 1Ll@tc،ab3Ol@tc،ab3b?j D7&6c 1Ll@S&6c 1Ll@9f 1&6c 1c5n 1&6c،1Ll@|،xs@&6c 1c5ĝ1̤793i`Dd&;yN<sϙ䁉АIr>"+hp"<]M.&DCb?.O<]S.D?M&6y +4abM7POlU.<Uy0abM~?abM<]&6y0O'6y0怚<̤ȃr!L|փI&_c u MN&Ll0i5abkĦ X5'&]&6M4xs@M &Ll@tM4'&Ll@tMxǪ ~@U&6M &Ll@tM4abb?W@'U&6M ڹ?ﳂ v@DkBBDׄDk5!rMHwk&$&]M &$&]M DׄD;y'&$&] &$&] DׄD;y'&]M 7@tMH4M &$&h5!4蚐h@tM &$;5蚐5!\ G,h@h&d\1}b '_O4c3cč2cGcfƠG`Ҍ[dc 1(01c]Q4F2yoʤi!W&5I'^pQ6d#<].&DD<$ډ>!@tyH9 D!h'DC<$*@tyH4y <$<].Cb?/@tyHO5yH"<]"<$<].7C]X!!h@ty <$ډ>!@tyHT!@tyH4y <$ډ>h@tyH9 C!E.&DD!N.DW.7@tyH4y8bDFl!d#<&Ex#g2)pL\aLI1}B&cC"<'KyIe)3ܻ!n`XˤC]LvabM.<]&6yx*D?џ0&ěj@tyab&D?џab;Vy 0ab&<yub?ѯ0QΫr=Yr@gTy8:EΨpF+޼B*W3<](pF+ry8EΨpE3G 8RvG9؟/;8?=m7Ո#Gvy~7# A<p-//A[@_,, AЂ h   ApBm!}!}!BB }!}!B,~m!}!BBB[`//4 `-m!wm!ذ./m!B0 `-`[@_B0_./m!l  `[@ `-΅B0lX `-m!=B0Ա-΅B0 BB0G9rl!Bl[-#|\ssm 9b[@9R":GP*#} 8Ҷ9[ۑؿHy7sdG4Gm9̑ 8rd #m } l[`@0ض zz--`mm w.Զз --`m`a~ --`mom l[Kn`O -}ض]-- h[@жзз#[@-`a-- h[[[@- h[[[@_lA@@-A@w.[[@жзm -- h[[[@-- x[@pBm XXmoo-@%Gl>/`Yir{F5=Gt!X=Sr,r=G_8rd!]tXG-) >bC9 G|!,9B_m!}!BB,A r-// B h  AЂ h ²BB h   AoY=BBgB }!BBBy|!Z,, A`PY@_m!}!}!Zm!}!}! h   A9  A΅|!}!BB`aY@_m!}!}!ZO}!\- B B[PgQ#Gх@GBϣ#l/) @B#m!#̫GBǯ =%b>G,9B#?#Gvy~7A @ @ m7}7XXve:Avww΅|7nnn hnn`a Be7}7nn ثe7}7z_ޥnn0v `#v3}``P nn0vw Ll` n `m7}7l>v ܹP nn0vw n0vw `g` n:ܹP nna @ n0vОl  /s,xH[<8 pC G|!'EH[!i }3B0#e!(;Gt!oXG.s, rdGB0G-9̑c 9pB0GBB0 `-օ l  `[B\-/m!l  `[@ `úBu!l  `[@_B0W[u!l h{m!څ@_@_m!}!}!/#9R_@ GNvD#G?G~xG?G~xA~Ы?hzA٠WЪ;Z^WЪZd^WЪa`P~Ы?hzA~Ы?؛TGv~sB/sB[ [wVG` k^~ZAVW`VG`~ЫU`~_V??تU??تl?تl\U`~ЫU?տaVW`~ЫU`~#{U`~ԱU?sVA k^[^Ac?GZ|{ya9կ?L#8կ?Ş#߹sT~I=Gs=#VwWב i}΃}?G=Gi}?x9rH{~`{~=}?~`{~`{pBAA`~A```AׯA}z=}yӠA{>/TZ߃A{ZNA{ Z߃}ZN}\Z߃AA=}A4}zO; KA{>h}z8rsފ#G>Ggsd/}#GW_ տ~ןȘ#';X=^Z #Z&)#o- h[[[@жзmo } ܹoA@@-A@,,[@_loA@{- ӻloxy>p -mwm p;mwA[>nA_Hmwm - h[@ж;|Lmwm pB- h[>nA1m - h[\ȶmwm -m - h[>nAczm p΅l p[u - h[@ж;||~ ȑ<>qݑgy~ ;[ϒˑȏȑ緀#HH <#u x9pwdGG4[ݑg- |ysĪ?hZcZpBVwXAU>VЪ#;h꿢V iVwXAUZA;=}T?l?تGhU??تU?=[oXl lz[=[^[BAVAVG`VW`~pB[^A k[^[ك[ lzoXl?تlz9RGK͑cϑWsUȑV˿wGT#}9sXsdGJϑ>qNs౾ȑ#AA` k߃ӃA [[߃Ӄ[߃־j[߃[߃^k߃=k^[B=}GZ߃}pZN KA`P{>h}zA{>h9 zA{>/T>h}z߃A{>h9 z߃A{>s!{>h}z}Ӡ=}h}zAӠ};Z߃}ZN}~a`P{>h}zA{>}t{>z=l}?Gh=}?~==[oXl} վl}z[=[߃[߃BAA``{pB[߃A k[߃[߃Ӄ[߃ l}zoXl}?l}zZ[{pK޾#J#ZCs~wHϑ%9s?0G=GNv9oc=Gi}zl}z[oXl}zl}\=}?~=}?l}?߰=/T~=}?l}?Z9]~=h}J>hA=B};}r_X>h}zJ߃A{>h}z߃Ai>h}z߃~A{Z߃AiZ߃ y߃A{>h}=}=}A੣}pB}~a=}zA=}y9rs޾y#9R~>{s~{X>%oV_?r#%#';·h%zɃ^A+yK>h%z/,%pV<%ܹ|JV|V KJɃ^A+yK>h%zɃ^ީ=KɃ^A#m+]^A+yKh%z-A/yK>h%zw.%zA/R|JZɃ^|䃧^ yɃ^A+V<%Vؚfl>ؚDlzfl f[f[ȃ[샭 flzf7>ؚflzflz"fl:fw.Ԛ}5;;amvЛ}5`kvЛ}5;>ؚ}К)u^#Zy:/ sԹ~:G_S|x|`;Қ9srdGj2G5;G49s5;>ؚfl>ؚflzf߰6;<ؚfl>ؚܹPkvЛ}5`kvЛ}5;<ؚ}5;;amv_6`kvЛ}5;>ؚ}5;؋6;6`kvЊc+Azك7;yكȠ7AkvЛ=/TfZAkvЛfZ"AkvЛf fZ7{КfZ"7{Кf\țfZAkAo5;fAo%2zOك;fك KAovЛ=hzAovЛ=|s5Ƿoϑ盝#K)ͮ?.G_HkvyבCΑrdG9Қk7zpHsě=hzAovЛ=hzAoكȠ7{Кfك;fZ7{КfZ"7{К}ai`PivЛ=hzAovЛ=؋4{'rivЛ=hE}|5{.zA{@o5;zw!o%2;4{Кf fك7{КfكȠ7{КfكBك7;fكȠ7;fك;fك7{К}aivЛ=hzAovЛ=h zSGo΅Ao5AkvЛfZAkvЛfz[OqHΑ#ΑfoHiv y+:߹us9r#Ziun? GssxA9uzA9uyb:Z^ypB^As:Z^Aa:Z/,u*uzA9uz{{:.uz=/7:B[ :[:wV` k^热~Z热AV`V`s|`s_9u>|9u>lu>:lu\`s|9uaV`s|`scx`sԱ9sV热A k^热[^热AV热#u>GZ{qHϑ#ϑVS?}I9G8ϑVG+lG6)ͮ?GNvdr9rȱf#Ao7`k7`kvЛ}5AO7`k΅Z샭[샭AO샭Ao kB[샭Ao샭^ȵ[VAzك7;yكȠ7AkvЛ=/TfZAkvЛfZ"AkvЛf fZ7{КfZ"7{Кf\țfZAkAo5;fAo%2zOك;fك KAovЛ=hzAovЛ=|s4~|<9uf~}"f7s4hϙf#wCΑ;CΑ#o5;fAo5;ffZ"AkvЛf\ț=hzAkvЛ=h zAkكBAo5;fAo`/ȥAoy{?h 7{!Л=hzGț=h z/,fكBAo5;fAo%2fAo`Pi5;zAo%2zAo΅Ao5;f_XfZAkvЛfZ"7{ћ=s!ovЛ=h;4{Кfك7{КfكF_Xܟl}ύ>FzqsV`+snV%v!Ћ#zqA/nЋ;yq-pA/Vܠw_7Vܠ7Vܠ7*A/7A/7ܹ7V Kq^A+nЋ;h zq^A \Ћ:zqw. zqZq^ܠwЊZq^ܠwЊ:|u8>:l>:l\u`p;|u8aw`p;|u`pгwu`pԱu8sჭA kჭ[ჭAჭA}sHϑr/!s:KoGZqZO<ۚ#Gzlm z[[[[[փ7m z[[w.lm=lm zlm z[oXm=lm z[lm rm m=rnm ֠u!:hm z[G:h) z[/,mBAo렵5mAo력,mAo`Pi렵5m z[Ao력,m z[Ao΅Ao렵5m^XZ[AkkZʂ֠u:s!ok:hmu֠uok!)m֖͑9|[s|[[8Gw~ZR;x_O#PqsċZq^A+nЋZq^A+nЋ{a).A/΅Vܠ77^X;/TZq^A+nЋ,[JOl兩o(o(o(}E-+jqp⾡A/Jq_QB^W⾡o(}E-+jqPZ7⾢o/}C)+jq_QRW⾡}C)+jqpBZW⾡o( zq_QRW⾡}C +jq_QZ7ܹo( zqPZW⾡o(}E-+jqPvD۾\z=ҊC"^(ۑ?~Zim#HNGm-ȁyGm}Ci+j[PWԶo(m}EmkWԶm}Ý i[PWԶo(){Em+j[Pao(m}EmJ[_Q7m}ÞWԶO lm #4lm=yZ[7m z[j[[[փ[[Aoփ~֠`k֠`kkSv`kkz5sփAo֠[[փAoփAOփS΅Z[7m z[lm z[[[=9+3m#Krd*ݎԊV;Ve#*#G*zl zE[E[E^у7 z[Ew.*l=*l zl zEoX+=*l zEl F h=*F|Ut.zE^A{@U4 zEw!E+Tt* VѠWt*Wt*BVѠW4W4;VѠWt*zah+:h zEAh+:h zE^SG΅AURAh+ZE^Ah+Zr^+#59*c+:}Ԋa#PEsHEh+:h zEAh+:h zEA腥Wt*;ZE^ѠWt*Z^ѠWt*za`Ph+:h zEAh+:TtGkh+:؈w/)?W^w?/no҈k{wOx巗׭~\?+}{yw=m?qr0O9?}5ofk˿wxy)퓛_vt}>~gsG<]>`=5/_x5~ʃ g{nRo:rdϏ%s!?3s C^+/ۻv_~_4,IR=_=ˑy;mR<{e/5?@~Ϗeۧ"a{w=|򺞆lerVg mO |m3 |ez/y~]o[+~Z_ ΫV^gv_+?kި#ؙ._>> ziy\n~٫|0~w[G߯_*yۏ.}LN^+3Gm偿Mnoӗ75il'y{_@&3ǾӼK_}_~Yy ~T%&lo`ojR]}|A!Mjeqh}0%+K??5wi.O^+]ކ3O'o&6/4 ?py|oV!?/o˟w{y]^ooe>j!/? ?C=/_V֟C :/?^^}rV^^=y{c>ѿ~{5/O߮y^my޺棱\{_WY΋?1s󶻬7×}]~?ſ_ X/N]ޛ.7o??m"o_3|Q@l~˯Ewo_5Gs_^Qo1쿢_~y__~w > >[|ۯףu{]ޥn Sŏ׏r~oMo?o)˷m2m[^?r endstream endobj 269 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 272 0 obj << /Length 1543 /Filter /FlateDecode >> stream xڽXKo7We[lR A ~UR߇3CreiJKp^pȓ뷒τ`1rə}lVhn](ɛݵ|M_m+f_% Ϫyr. Dx %q ]Y:+Xp~ ew9GهU@v"[{[5-fZ[r>f]/<%RWQɵ]sr01-WOh)z)H >2NhzX#7$s`5 &+΁trns̹7F ,m+ʂ.'Y(cn̔5D]wդM_OdWyx1x9/R?<)1jRll8}{7#h5"HF wۅ0ڻ V? |p&,4$b:E7/PMH H"k5,  lB(dHҬ & Q,#ԨBp_k;Є$(]hs'QRAO3iɳ4t:fVrgK}\؄0KR-QaOfDu ס:'X+(3*C]LY$0ͣH,u磔qp8%+elPњZUR#0!vYiIT5.Ǜ#ȟ@N4B#AUVx)4O;ŠsJy,CtO:/D%)K@d!hCCԌɇ7\]ݿM] *)I{l\] %VMv@خz/@Yhlr-5v ։?Ӧ&kix7HU=[f7fZ^}ģ8q9q2tq& _[%|(:G]2?RLuevSi|BF| Unt)\(7ƗVgY97it=I M/j{> stream xڝYɎS(7 UX 8@aljm-LY*hZ}}Civ7 2:+xο],BϏwx\[Z(\UpzY[ΪR;\=$TRj= ! &h͖RnX,`A 7fw&!ER-i쬉K=JF8E viEe¼=4{-Xz3fJJ\ /9"zJBsjVҗJO[]*E#{oXJvۺ 3v)CkG+PטR_=ȧ*F]Peq2f XDP1|֔q!g4-sMPrF[)91c9+ M\*ծ-U}BfP$W3אCci>lWC]d=%Y%ɬa`V +t򗲆bŗ,Li[i$ʼq|$8]H|M _7(oJ&%E7*mTeۮ "{BKuPV;Dɨ!s(e n\iIr.6A-}I\WVZVi'AX.ŝB o(u-s> P:#u(̓VgVE`h0 ݁MkP@#Ӂ1Xy-{b$ |D@"et:hm;KMhe!k6Y~u/I8%HdutP7Cf}5ٹwڧP OYىrVUדtdq^f'4TC{O樉9C~jksp.r8.tA3ߵ'~Hz=cT~u4gz SǷ=?t1(gЩpW RKP2 ]:=rڎɱѧ8?2{!B}cyNFz26znϓʙ3%hTٵ$:&!O0h|5uXt>3Q|-(+v@8R{:=Kv n[*ؽfvP`Æ$gJB:ki .]B|yTawܢ&=X.bBt?qD}-IO&傺}oCt|17NGvhtP># /S&) ?_8G.gM_lFbL.60gYyJ؋b$Ҵ"Y@#r=,[t;\5O[z:p7C'߭vG:ۨD@}MJ@>ܒ R^d~秺 9i ;z* z X$%,m 8#w~%H >( /8p;?~Pqȕ5@}HHE1V=} s:%ȁ2?/9m|InE|L0P|H&q9&ja(RW+~`qbIC&OϰFHND$֦ P)RWUGbisȐ멑c:ȋ󔮴(Fg!Z&[{VPB`3F>|F1! e<ڦO=t:(l`SQsd'$)^V=܇筤mGLjP@Ӡ#珬_p-2 endstream endobj 288 0 obj << /Length 341 /Filter /FlateDecode >> stream xmMk1+B3]=P7AGZ}g N27oFm1Z9ZFpWhbV>Tҡ)?+(đ%޵//x'qO1$ъgq q .:*NtL-yR<M@j+QЈ]S}Kݡ1xY1ou)^7X6ZAd$M=*iЕvXڇ)svg W%[z^QӐi%x> /ExtGState << >>/ColorSpace << /sRGB 292 0 R >>>> /Length 6721 /Filter /FlateDecode >> stream x\KuQ_q0]=MH@[b%b Ys#ʧ xZ]U]_??~}QOq>z"46qg Y;ZBmigEgqhUg+Bh?,/QG{Y5jvc6R )S@'3 fYi`u0En,;´Coj[\KcL<ՑkP ŵ0QW`Pdq+ uc |>Z=bOңc; Gkus`Gn01.|Ġoǹv#{kɁ1]xll5 Z?oA\x,Haxzw<v,`wǶvͿWһhtVq(֧w͚x_8~7|: hi@tprL/7nwvX`I]9LQuok+M[Vʘ^w`tgt/$9l<5Ѱ͖c,BZcڈϭnx aÃ0!(i[?4lK ^öz=1plT벡ĝnվ>~8̗&pl<~]c%{q&'ZϲÅ%n*x7f(vobhw=מЕ%l{ 8_45_0pj$be/ƹ_O1LO㗐W7~^lQ ;f|b-@o.xh~(|B`[c"7D6<ca&mr#hE+?9b=q:k1M? $.&+1c+M\fbǴyuc߉o #TfE盘^RA|_}a aBoƟHLCL~3>=‡xWU[P߳?3 +/ixo`bLnMECM~?'&&\8UG!nK[(Xm> )=}Naf23&`hx>q >%Ob 7pC?=!Qf)%o}Drm<ú{[twxT~w5_^pt KW`M,čb>00![. {}`".91i|`o+[]/5|&H۲Zs^xe@.@ 81 Co_zrqo41x]W?0&ka}>C ^µ&&}́qz/^Cm󅆣 0,7J$&/1' ]&i5z7bf︿%~_"|AޯoM.1e}a&ow# 9M3Г/c 0t~ѐx(o/"6Snnп9q'RF~íߌŔQυ7IFzCQ nU:n"ˉ!Mf8'S&"OFؾD[|685ړ/BLd>!1Ah)9#}W;HRٽBsƤ! o '!tpn.)#= _]}bN N-QFL;|p~ZzVXm<N: 4 1Ԝ @VTB{PiP:\Je0-018ac'HHո PŁ43>dlRo/ ;M8K!ցW*D0Bj=Pi;FjsȓyމXQ+2K_aX’l{$ ȼdP%;#rUKI7w[-?X™0ԯ r<N7ŀp$\wxZ-ah07ԯ>_Pt igĠ~G v7q0YNȤIg6 ٩\Jˣ3UɒB^ YSض ~MKvJ^4cu­~u`_ݤ:Ewe E%duakuD.xnU]0U3l;c-8 z]yR_>vwV<2 3V2bWG $&Ӎ8qgtTi^:Mzv\:dlzꋊ6^L'+mtCqr\:Ddlu5A*e}5Xnuc5]<+Q>e#>]KRQtl.0W NeiwJDQ#.M|MGo["Y"<`R5a ?XW_9/;&(ߗa3MR=,S`!` CwzX}#+ԄSƪ΄>JP𨾨H/ZTuC­2yy -H.uU#, Cڥ"$ܚi<[կ[[U ™pkY);Kf,YվOmM}nVB\1n5*y,Y}*P|PŮ=yUJ;UzA.pdw~y|g?-Oϟ~gt'|_~?1~/Ƿ?s wBSߞYf׳|á/V{%)H|_~'wgWn}ig'/En䊶f"NjX[B'Kj*) #|mvU1/)ޯkqhnN$9s',>羯։7Tު3~.xL2s&_,8( UXR_xZvTS4wtcaR/L6YΦUUhRGt9[Gq*S5n,GKbU!crd yQV^(;h$#&(K\mK+q+~kEl˚ gwx;uͶ5/7M3<4f~5ohb#"0f+(TiVI 4XQUF͚. U5~`/OBթn7b5g]MQkU5#%#^^&6>U5iܿr4̿]yj^۠)b]fS1ԥWG 'ui28jlH3kdYeMSKS#ͺ7@~yhʢTT<~'2#[Uf5{4P9S9k3pͿҟ5",U'`*49Sc/+c:ȖY>cSզ/I#r?MXtXVSS؏mdH)fkCv&1Hk̐!y*o2DL}~4 ִ2TFO5Vb1J͝?J 9ZsXۗ0>Ԥ[5o*cNlBJS5K35NEi"񮊘aq~b@I;Կ>gi2Sĩ[$$OzF35a%Ô%>X>Lk\Nf))RcjN&tիok> pSk)J .$幘53Ki.f ۵ꩁ\#kH׶j:T<,jbk2qBcS~mecSGTmm 5U*nXafR3mkFp++F IC5kmǾs֝ĬqۮYsX>_Pro`Ƒ;e(5jzC--[M:2ߏ5Aj50j52+WSG!㿫+\l\0޺8EcY8=: ;Y9Q%%zUJy mԺA'lY'b 3J[D|7wZ&qi/[otjG>؂a5IMQ`X̥0X^H$'֤zjɩjzthi/Klο&l! U\e*MhWsw򛦫WإqOi/kw(f*eiI|/kz.ZON͞5f%C[fjҨXU^iMUjΊTSהr\9FQrw]=)=1GQ7rnIS.59_pK5e-הy煆GR+ۜA*?Kj\-9ST2h >L']5vMůCat8j-M8XRKes;)J~e'~)Ը!PdKbxcƇf}ֽYp֒ *I8uoPw[J08gR>eG2孒1 tdDCkY;55=[ t)ʬ!7Лp6d߹h)5U'pj\κIqWo$z,d+~ʳ*j;}y8ҳj-­^Iň0Ҙ,ZRʶ$3C;:5U\Z0^z,,FȈ[)qGHŕC5 ļeGbȼ>TX&E*{S>ZD +:~+rvLeCD924gUnKu$eZ:SbU$jiŕUqOU*)z$V#;jըʬ>5UU}–p͗J+YDuyVMyq+u穱%8)o!%SclgYXy~&u{0ȱr%[De^,/ S[ O/MU7 7 ZW7Kb {GW-R'd9 /U;m2EASq%~*{kj,*tP5헦K Zճʊ:"RY&uyuDT}ەώyRC (γ.~RʖZ.m0f\Jha.pъ:}K ,oB(}Bi?oAh?g2({6M}{q{|'5dOx^ǃҽxI|OU endstream endobj 167 0 obj << /Type /ObjStm /N 100 /First 878 /Length 2440 /Filter /FlateDecode >> stream xZ[s~G!{z42&ٝ&! E h;Q mIvϞL25S|d) yXpf1ѻaJj )"0i>BL˄dZB2mB@0Q1 QC-'Z`|hdQ,3Q6IJ#ڄ %6hXDK͌Wl 6*azV¬"bAPZ$zXAyfO  4H @- ƤDKj0Nu`NjS MipDf s_Bns :崉yECt!ʉ63$TbRXe 0oeIq{G=z1 MSӐOءv`os$"In[շoMھu}6m/bW|l-㘈.6ovZy Dg#Oh%LȍB$K[͕{uwͧ#bu3%I~?0T켲aeT;Q=)9Z+ ޸0` qv G8nВx{:`")ri;A="jXabIQ0a C!scI2kvu2qU!H's܆auWbٽ*i3[߯=B+nY:q@sZ\=-cŷ_T0!Q: a?P7 5Ak[(gɬNnv7%^du6lQ{quW8Oe״iE5ʽ} VXTbZt(d9|B䔼*H1Pw7QYNINB¹ׯrNŲY1]Zz_~e$KKdlv27aJŀ6)~3D*M_.D0D0&OR>Kv, Dʕe"%lBޟ5MnHS&CլTiR'PVulϑEHoPO#RX KEM K2oQbyJ_O!'K~(}P*r %f*vVc(qyԹSs^V+!pۂ uXƟ;0Lծtr==-5g2XFW5OetǘeQ_ƭG‘/PX ZnY}l q0̖djYWj_'m m}~t(bTtzuqdǹ$+ .ay ":|Hnz8{:ޕmUZPd"0#(QۘFP"qhy%1;:0n1=ջVdbEE%Ǎu N/O슊nT4fުf SlmҦmWkWjЧ/hZ;Q.woMX.uYűN≾x"MJJ Qq̨;PK_C^dWۢO+{m*&_A!p!oBH QudjJKvȴP/R2pܘo){t @z@z6e>RZ`Z4 vJ(1!b:rڧy:t̍Ncݨ2wLN2* Ao:%*7D+öGEWGyE%ct| vtاa䘽k\ղ{75]UK{aZ udԩ&4XTY}5RuuYL_e3u!QOћ%|Û|Qgge1։z\ſMWͪ~! X-T(]%ʺ-gٴE6sqV,1Ģ^7DE fMr~^YDs̫DY?$+e50dƚ:;UJ9b$^e#m7D;901UawHY}x_NP˚Y` zok1J#LŌw_(w$Oz{鳮oJ̢:L~? NrX}59 endstream endobj 294 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 298 0 obj << /Length 200 /Filter /FlateDecode >> stream xMOK +hDo_x0Z~lGo]a ͇]ɪewOƍX[Β,I\53A:Y Y `$x )<)XU+n d/Nq/sڝfʙ&˳^6&k?0a> stream xْ$Gv,۾/m{xlțK 4@ )C'A"#BrP;|9>s|9>s|9>s|9>s|9>/?O}w߽w4Ndw ۿ޿ww܇rPݿ|? ^Zݿݿ?ݟ?9xϿ&?x? ^O<à?C|_,xϿdWI"s|9>s|9>s|9>s|9>s|TZf9NYvBr[&\&[WMèAɘ\.Bp~q2ΎQ8;;+YtdJ |lE3!6h'/IL vLXePSn\-xkVojSkڔo6ݛy20cI[ə88ƥ9s|^p1rc>F͔LLur:,(/7W֤gcI-!sئczbͅnby…܉bp]QNr3+~&bvrtiκ^.47H e38ov{1`8+ۻ{U?{:||2vi)lN.*Y&^W-xcq#A/y': O>]|4eR1%}oyZ&̧i/ZyfSxINb񚇵K& z%m| j_kHϢw\^XSkj/NΜ 32nBҔ "AJYnﻹU.p]J@ qDJJ%d}Bx,p-ƤYӨU?dt'k_JZJV,pa29r qsfl}pBCnRw6u^I fUP:nXuǼzdX-lJ4,X l;1,7V`L.E}+KEX4^{S* ?% \Yn3oxFZF4)+K}0Fw5q5SEv"1tߊ5휥0U6N-\3_ {< ;Pk[Fe;߀>/ґ9J!+vd_Zp sεj (%ݼ{`ZI4񖚦R]MÛN<.J&&$_%d^o%}ZNWY `cv x)g"J6˓l=ن3ެdXn;aR@[Z}Z{q4'Ca]|TRDn%e2kf0ٝwuѨRv,0kñ B00H t ~qUym7fLrHc  @J&ccVlʌ az2#ƥݴEJD7/1McfB}@#Ā^j.v4aK.X!7G6=}û9<]Kz9儹"c;rNiWU$]m~f-R>96P6(*]3)r<,(T}N0mr޸c6\Ȁgjv%8k#c(Ǔ*-N(Gh(FS0&.(&#C>!454p":? ,SkGϴh7YB/I ˨brK6W".!"Űe1@~UfuY)!˘jd E=X‡5Eg?P\A+1 [h EޙyY|;7իG6'`fY1U{".`QFN(`$H$V?OˆcdNΝz#CDBwGWm#&Ny4J! 3~B3xI;J5tkɅuC;EuN h* ~!OZOP%hM\(t ޝ l`0js|}RWnU@kY\z/2MyHRLXkƬ U'le,DIBɠbMVM=#A",^ ,4+>m}2^ˆ| b0{I ГY}1UC㴧#CeQURz$ΠF3 q޻^@mΙg_ӏE?p[sbEf/)+dA3SȽ_EbW+D16cxSFCyp(pwGU9 gl9"_b8f|c,B% P'=׾GIH`?rDrM<[>cz6d Hnz x Wiu|:ɥy =/q-39GzHr~*1g#z@2=*dzGpx|GTlYKzg!%Lx@$ {G+عv\]TbKx.ĞK(^47Hy*eABpeR-͊+'eH/ag}X~H f:'GF{Oo3Y%tr"Xm*u4d:'߸.@PyWweB2BR0dJ(H11XC9i D{yh5!*im_)oڝK dXH'[ym+TP;<7_J#]Ӱ[^xK'Qb{JU۰` gޤ?CRBD֛ mō[ӄ\<֍NLd&=&DCkWmyUbpV4yJ\ /z ?v K .jT񜐤Xwz 1DPimψwxSD5^ l!@#,ٶH`jrZyqY{XfF ֤Y7uZ lurt>:H4y-(̹[ [^aA_<_na6-oGX=ϒӻ9k/:u-j9@Ӌ-]tỴB`i1iClc7VvsJFzpͥx7[ }f?9e'H>yV+ͼO0'm[pC}2i>$ N!iOG'{XLUH:, o"Ftv| A3R4r*eYI+,Wpui77dHG_Χh0Hܰs\U諡^}AqU I; l$$سh7P4ف.d`~066_[Q8@s^uc:L;w{ MU!Q搞MAs_ChkOzO*zw;CBYW~~\tH>nH[k߸.K$4X/2OG=ǁ9%ƞ'*YlPhX9Ĥ ֔3P.CώS ,!0@:fyb–0 ʡC8kr6}:~-d'ۄu|3upn#2 !˼3x\MNؤ:K`\(W " x)G^WMicRh^ oTsJJd%9nW]n sP>EmP-tGQHIe,5qD Ù$Mu&XN7EYgRMJSxomʶ/0`!&E]t5B^6CcXTBҊG&IaRǒz!#rg9cIhՄjB,yE)3>D&L+XxRƳkS%L ܆&$e(0k )A_EQ)w1Z@vXPo~Dk/!t^{C֮b6\o~eMN@@M[;C7o7_Jo\*7H—WZ'F羛_nyJ2g30H3i : >UD xP?3ۚZwthOn{T>Y9zoB1U'S AuJqfP|G KWг 7=fPp&yg&Z Xx`嫰΀?qCIΝV~ȘqPt2!^$#Pg" lE@c,BQ#ҫ3䫱jв&MCn#g@B>Ǒ _}\ 欨Z^r^DdN{xɊID\ N :gb Ӷ@t":FS HM+Uu j'].jԈ/:u0yH5ԃ+[.# 8X99:ϓK gm4wUlkr0MĎj?߹rS6,g(ݴ6H{^< Tܭ] #rm1 J'V^NSF! 1>Lj**EF0$9=$tRf,syeBZZOx(^I"s% Q)/M~ (';ŊfV$FH9ne¢'ѩ4c3Aߐ+L2:Ox2̒/I0G֛} hKrNU4(ǘf9a0*A$N=/,@FY`~b2nw蜸GDiá/}Pp+^"/#ıy Fު 메#I< 9Q,s6/0=^D5q'O*^ /{ S7Bp ͬR/% 5vuq'kmb*e1K0e?הkr{⸘kىڙ4`5,z4iwczl{H`UTG/II>^ラrI_ ikfq RD M&SS vVMCwdX8p#?7#B]X{x!Q/~wտUre@+ši+ЙЎs"Ӯ?5y: #ڵ;#:J|ty4%ޛ>k)˩ڸ/|dLGFjK-t9iUVKr{5Q7ne8qI12a3B~8/9KI͘Ay(hYKOG(F&y<#\a>V 6D bHVs('I] tڙGm`X0͊ -ѡ ]P v.|弥!艱7Y&T0˝r%z򯏬{,J NG aO.#aFfdeڙy}5 r6 VUh!K-x-rzĪ%4&5v'RB?3{ -oM]U-Yq0HGV6F۳Lٱzc (*C` MBXpdkk-txCA$RrD5_A8j{d?ZŠ[+*:67e0[N{?ቆZ.΃i%Eh2CA1/c"(`/p{|r?vtFN;nx=+]YOTƱgj5ur"ҁʹ-:1n']AKf`c -=`H3٧yOUjex LoK vTf}]y^JpǛT*oP~NeI%/FZ$R,\ҎX:\p em`q5=UϙNEş@Feѥl :+2ۅSa,5(, ?ϷA'<,։%ms)-K-hxo/ Y3"nض ÍA _BP?*:$b^qwY{JRa兺#t=r[8&i4Fn[&)c# iF{^ļ/]6!DTfGڣtmic6^|D.~U؂%d5 6YL'y뺉.5']!ڷ&"3C)ҞG=!Qe t ̵ҹ!Q`e %XPq@+N3s.:13Vyj?T-4:I zK3];/:P>O10XD=Nu^T_f$ k IKPR[ mlhV/-|pގJ 5 &19VT t gߖ4ox$D sAuTfӊ *NfTz諮wHŧMq-T bg^]HF{P%?GqK~]~aѥ6Z= Ub i2]S2_CIVHLx YPRBGkS^fX4&k'nj{r9"wJwPvK)'ZT{qymT=Ƅ8wYGC#,/A$ IfOS .~OÕlnhAQ"8Im.Kmsa?q,FH{kl?"XP !,VuPtq{D`9uQtSj{A0"G9B]S>-xt;?Q : p&187g_"H#^W WjƎa xYЕzO]":*Wh`|M68nt5%-uregsܿ qx4M#;wUꑖ.r +޳%x@}J:|}dz 5cn2  ɰAM}8uZN 8}Qi{<^_M$Y `W0{:6ARK1 %vLbBDho E8q9ub׈aL]tDK#y-^1,cb&7BkNTtR&Y`r1DzP%l&XA袟ސcS4y$ZߙbE~J=h&Ps[x#fսAe+mS:z7Lyc/wk1}5a^-vJP.E~b0Ѥ+{5]ʯTr)ઈԠG RDZ0SRL,e$1(f?Qh5y;k:Y;h#-UjH^h\nk脹w>*%Ln:#RH,6> }͎q VACN~aԊy$M> s?1U^͚8C%!`A KhgE›#lnvI2>oKŎUO!Z3Wo0-hs\C S(NᯍW uQmmG:N /tn?y9Q_,r!Beaj0O]|hIN75`D̶m&`A@<샄Rm(4BI가i*Ɣ[`J evx;so\n> i+h[Oiբx/.c yNjpJj4F>f].h8P+oNܪ!.1Lj݈]Xײ ,#I/IGZn.)86&izڶdNsaLCGœ2U$$;*/:%#d^>TDZE@'kCMwgXi.:hފ`, aP&ez?#^B^DUg[yX6tM], ru}^,_GD՘6^LY3KA6σM,Wkcձb9aQr?6+F}T>雥Ls!QCN}՚:fK;S _Q^A.N2(p t}#Rc&A$HTA>{_d12S"Z}z:08J$_3'&[tk7&s.0xg]HG=1'F=Ybgmʵij e2SM %J ̈́r27mU APX IU%>+JO6Tfhw^[Ý_[̪7^ uhڅlr`I"F,p U/54Pt>'7b8|hC7Oi?K xYiv^="`6DI`<F w+EM"H|kM}Z\mumtu_mPeڒڛ^[w FfpQfӮ4mͧxˋx]G{#`VY‹CxsZdfU-33\JmJc!ԝ7zW5KNGexF3@8դ^ =}> T$JTq^@BLHXa&v;Oegt1A8F0{shiI:PTA6nhɞ($D--DSUtP܊PDDd [ E4= ^\m^^*))}DrHtdbQ|;ҵT[D;U*R3( yvCNB.`\[ SХ}Oiu}ס.Έ)gxUrwٺN$Bb:]ca}öx=Wv\ʶF<"gQz^`2?ą-JXdTZ-~ND6r)"혹ƑN"S}Ay]r x_EOċE-mg% !P!ڄ84?2i^zX}V-W (zHTxe].g2k>;B*`^a:bsݵ#XMx'OaͽfKSSaqN RLx#㕀H`/JBߗ#B!0F=ݜ‡{lW os@W_BC.y$&ȹ`JmD\ﰽ ݿUt ғ,֣$-:K lǬ9(N)j1-0@Wh*i'z^ WH3((c*uh] s+䦨2n|2#s]cm\dX[NPh?@1v7$ wU; &_I8̡\RuxCJIUlumr{ҵoխN5J. ۫i&\unuFJCz/_uI,؍=m("R\ԍ51i3S5LE~˭ּX0Zl<NBTȧb17Nx3:MuDZ_uzlEO'ൽMux V@뤛tr\z4W49D;SԺQ1+/Em*sGу?CD&b٤ҔMiO݄:psd.[(ϛ0Ԁ7 ~مRS7RTOÆl-#DF]؀F焌ހMd/՚W|9sRj[y,ܔ. N>6' [!bV7CSL0&Ć^. cƩOrU2eOU/ J]}ybrYcG ێ ݊&߃tI:W8=pa՘"7@wBR:iQvG&.ZQ%Ћ:1|7w'r ^USl3x=v>)=$0L̴<^ؑ;tX;׆\sVsrZ;~sw`M~BxoV`Q͕ A/SfcdS/Q>ߵ h$Jr7Th"虢a Z 2#"1-I:":xgnӱP;jZe`Hr>.H-H@[`䉮 7q6];G) ORb2 8R K#dov]&u9-zfdmq/QW3/_S >7CQPL| v]+-xVgmG~*ʹ;؞Z: {dtӈc\…Wf{%I$Kp㜬sl"I&h,#$^*}2+#BMU17=Js,pdp]}  T,ұagkY;!ˋ "tRx0 m_Bַmank˨ h/N &1~6Z\:?O=*f ߄|t7&ą[^‡.:K =#*F.T,ł,E o-RK1' I6p]| +w+B%YͬMF)@$3nIt8К *(uaƊWa\D[Sx*$ujpԱBGiL Ĭ#qR=M}d^fa:4 $}H<<~wFv&"䶒SbU@ ![֌(+Ը*:|F,:; Lg,v[[n!{V$DϹeh/Po7ѥl|[JDJEnzh>nbE3jwoekλƸPU}Dg7;oMOWVpշߋkN_f=痷+M[VteU{tH[R|yV ToJCt4Ν@;ɆzK zŃJ` Iz9+U V3i@!4\䙐1_HP<ɏD"]7~N0K\CQ@e@=q}'BhXZ|:LI !;0)N_j&̯Uzp0"Z V%A7oMsb$tHKV㗿/}-Ej/bίfPlL6zyxLцwKowAHG4 DC +lr@*u4UR .2[Ӽ\?E\~%eg4;ƆYMiwcO}Lλ.YK-Z3rI*Mό_Pf-/KΖ+I\>+8KOuц3Zq:bmAp;FR kQ]l'.>֔P<8ӡք寠1ly>$9Z4 VZs5eKcuqkG ܈d5sI=ʯ8о=Y`Z.Ѐ 'ySVP6qjx:%A@5/x,Џ?lRVD^Z$Ԝ*J3YOl6lMS#k|$GVSZ&a4lCH"peZ#i')QvH^:K'w5LM sbe7OE[N<"ۋ5V3]4` 8ZFR(5tXQE.iEVdЫ=? Ǯ4v'? !ZkCU FzΩ|kRv+F >ˠJ3"F/2PA OP9id{-4)ː,q bбMf%fv|~/xUQ2~Zǰo FmH@5۹v:*|- ܏ɎfѠ{n|3I=}pS4t(W0씦:XGNmQsC黰,3hLb2L(ji|Іf6΢ǒIr5iB<3_]e[P$9UPs]sc=Ah|8EX_Q]JYMsWoô4bH@oX3Uf^ML 28]4=}h)d_x԰#lB{[4bImb`ԗ"xBXU\ͻ MzAm2&<4tzVND/u}]Ŧ݆&0-+C҆V7'5&=Nty4eHc/J !n1k%xER-yQ='ۯΦIf/k >՗3ԑ뷲QCra|}JSgsuY U6w宰V(:+vU wFr&x5;cimIa jE"+*Z$w ~[P4-ښ֊_m= V1[])OX\ts8wAjZAjHzBi4e,a(#AJDQ!]]|tXi葋hm0译3+i'ItHo۲MN 6#YRd3AZͼ^t밈.vcIb3WRW?S礡k+5,PҩCv<4+Ӡ–{e;!mю ZqF}˟]D2.DԁʹYo Z|rFK~emzzmMP yQԀw ]gsv4 Tuv5knҙ 3y,YNE๒/r{~`4c̣i3@7sE $[!݁T5t:5L/N-2.L06nT.Wv2.X/۵UKhHENc.\2&4;#)9$BRC RUأl};7E%QЌ5sUR"po*ܬ-)vѡYRq$)#K W RXEջ^;ZQDҕz7!r=Ǹ˟=Pymk]"ʟy>wδ[?k:;Ws/g l0ǔB WhR UlܯqK-yBw$߬GVʬ9U|R:[La{ggˮ%?YwCFxL&dRH߈몴I- #<8;>nJvN wjZQT$r:WQCetUA3lgDvj(LHB߂Z{<u*N| 5q_lFkf}V}g'1/`Yw" ퟑb\ԈYtt ’Б=YKSiYt+M67:^D>~=,)+e|6s W"Pt" Uu|*I\+i{#dg?T$*K )u#{}\lIʈ ؤpC51ꦄIc \jϭ*rD͊z*_x8x@A ͣl{uvzE}+PJ2xdf?uC/7_O 42ξZ=3Y'6Wm`g[]ztRX/><香4o{[R_@ ]-3PqR^eTAkii~(>v;^쵳eQCX&x`EMUن?eo4y$4|/H$(:? s*(E!KТhI`DLO~=  ऴWB!\yQ::~NIJC݄R5mȼ̓Қ֫fOՏv%aA'Mte||{bC`P@M ,hspZl=|sR4$O 8oxz)iZL|6'@Gh)͝.e /7O71VtZ{ B1LON4K rzI4-sV rZbѕ5-$6I%=wt,@cy?FQWS^;s^;:+zD[v.#wzQT: U6BEeS9_3EADh̴&okG QT)Z|ϐR& ~TA_ $sTj :W6JD+[>) wϒ?^O aQ3lޅzu"yנ$W VgS'|3qv jA(/oWyz663(ŧTCN\B x4& ҈q~jX2T``zH D8 -PW\8u﷕&RKӃj9!-RA҆5}^I;ԟLOYI鄹\/:rm64HlRjmlHNuJp 6ۯ%zB<~`Ezol^Ej>^ 6Cb` dQ^q!IN)8+?§tyჷWAA&Nymx5[nLH#kCZrHC/Mfh9|h`[ 4: *̻q}MNVQ LbaoF 0΁)U̸^?~8I`B_(XԕɌ r5-ǖafD۷D E^YGIW)Ba7?1vi嚅ͭI֫ț+u5#5I ߩ}SV.FKհp;MGƱ~F$u>3Էug/&lCe+ѪOJATrym;buݫ>5%uյʞV9 Ko|Sl6(>-~(?\PK v2 WKɾd(As3%5p3;jQ[I竿ATW˿"FyylԬݽZժJ+P%r&9 k7Մ! žt[% 4F97ޢI~^ ?"/kp)ؖF{JXٗW孾X^@:^P7N|Ob4S.9ehܛhF=娝? dBLbϴ_엺 XL֝?_P8n,ҀXo'xA-6ٰ 6ćh3P3k]1s{4ɘ驃H݊ 98:H NJo04^7>=ff ɂY9[KBtld5.3(pRsgM1HZcDX.L|G\$`[ّ kq.GNMsKΧ8)B\E{u_x}> 5eW޹EuL =C}4˛ = .ҁf ZEvT\ zDRQ[dj[s:'[13KմFBMn*PF^y&.\uMdՖ74ky` ;(P3/o/ to%֦CoIjZޒl}wI-5xvGXl8#N/y&u>]mkUB}f,0S"\eT*jhXEG}DbcM9&-pFݺ߅5ZjZiM`(aUZH5{dxQMQ3[OtxN}7d4V366|4&52o+5{gdXBeΥ)_S$S}rY)}4k+Xk{smYhvq(K;} qd=7,jWb"ӣqT:)eFnDGMtݮ,uADcWz@߶W[mzdn&"³tA@,gG{tZp/+VSI[<3aam[UIWNJrDyUi`GjVre^jt׸wdu92ܷ6ٓJ$eΒn}dCg~nònP$Sn:҇%w>\v )p֐be@1:/%=Pc#X'ЀZqIni\b%M6$.+^yjYuvN 3'W,?)jF4KZEѾ DHa>>vY*w`E9 vs7 "4fNLD\ES*/P|{ R5kjk3H5zk -uY+-&˰U&7DFe&:|-Hv Y.KܤZe)}z~ո s MZ`6qQqJIK{z4f6ժЁR: x~+2*Ko*5Bch[;T7j94,&j+1\%1p{umS*-K\0/ES9#cB⓴/mҶtԪv0a.Dg`|qGd ٻTU/uix4G5~P! ZOgo05g@jB0gV|I>E5g'@8e_fMմ`U('h߻bQ'Wh.;\wI~%E JUAHطW37ьEL@۬D $:}& R_]]DK&YJeon{u6/gcjv(㿩4gJ`D^*J^NS[V5AtPK;7Hz5fH6p#+RZbswcz/L&]NZY:4}.b et \~%O$62АL}æBz.RX/u!5(˾wƬI b+_\~˨(pl.֙wKyם373S Ʌ, ?r|JgE~s$-/ӆmzyd`l:KVt ν"pUI۞I9xL*g:Y{%So6'gE:_'L~$ʯr Ȩ ȏN1ѷVHa7lVjwm2 +7P}e|i}y8/y?gɝ4yCU^Xd ]Uy~R0 >]ӏ׵S&iQ_wբWtbAj`` LH.-.dHesY$i[Al׎Įji2=u^+Mf0cmS^V'}=u{Y^ܳ_sA]} wq3dFmNҧpqz$ ѭY-5'v$:V|at($ׯV` qҶ\qn_L fKD\hTQq!J7g7+fq.}N4jz<*lWpii.k'ZٸPS0nT]EZ'K~jTR(I!)v#qzmV\ǹ! ADctK$yڞ:/6PC[=#H/=RiMm_P`= h& P/uh2v z~ԅI¦ TlIs<__.έ!kp%y{tkPGy2#E237Y_nv:^̮n;&3|r, XPxKUCbob|z[} )E8u|}\ #94}y~m"o|#M%dnQ$g{n?hTl턣|_8{]$8L*KVHrb.d<)OPB*(iN0\vT|ujHyecgVP~54yya-"l~Yw_JNu ["- yKFSi_C"&k72;E4OmܙJSHeFd6 Ja}C5tm(e^W꯱S^-/âyEZ.~2@R1V-/ ޵dz~@UmbiRڹ7 w.Xhg#)k6; o Ybե%벮5^C'YA>Aө|# mmi2@ccwl&uwɧ&xdgQt,`M_ r4bJ2%2Qj%)A#DdeefV+[iMTA_8\@2[Ж@oDOڜeߍDɘhtfG}o': jyS"ێ4nq5Dזn,؄h< YAb+?Oݐ͕3ٹ`- ŶR^RGlI!SϠ42lG>e*2uU)YUc-tPz=( .]' ݣ̌pcs:P+]b萸lodIGPH"9Zb9)/p4q9!hK36#P F ͢bIE4Zq <+.3:EFEͱ:.c"=o2 8}H"5N]A˪G6>o땎Gddy$8; qIyi1R,}t~-)5#qТQ)vUv<|^u+u*Oի4M'R<-2t8$so\zs֫l c#砀܋~{Fn9};2?nmR?u@$D͓FħorigK̅?P%EsĿn#=2t$0 v']x. G$_$;o׀-H_HCAxʹkYwW2ڂ֢.]+?S_3݀<ISE$ohH7iAih$0 ^݀Rej.HnH?E,4>UرovmY}})8x;PgGtIǂw͔w F[ٴ5PCXHɊy[ONM1 ~ DzN_In\]?oR,Kz9mU:a_j&En@.j׍}>((T8I]t Քsm󝎁ch>T95`MH d$oQ]yevЭmPxa"Ϯ0R;Һu/(֊?y;\dq}2"Jv9tp"p)U4>&jJā_KCgʞ'޽o(nۉ߶p/byӾ#4 ~.7Mv-3jB~oQx]'p/P!FҀFC?&Ǩbɭ| KUc*1KmBd,m-{7F~F Sru UN[7_PUOR69/¿j6bQzP,R0^Bl5ql(@DwAkPΝ{&L748!tغ2pB=M{op.z%g:T\[d[qu0_v̋{{Kɏ % mz b5sV*xb2jPFS`/B5ŷ߻5QQ>&XyEv*kv4m־n=;5Ajup蒑PhI:[U&StL)«"JShMېAtt4R6EDZk 77]4Yz5H8=a2`Ǡ0e+pxFR3/4ŨR͊Ay>fIӡaPtsp*QilHOԣ ZRm)l)z/u+C ɣ7`m}$gj׵r˶Jk<ߟavavavavavavavavavavavavavavavavavavavavavavavavavavavavavavavavavavavavavav~?~O?D˿0җO߳??WK_˿^O?}ף?aQ?~yׂ'.???w@vavavavavavavavava/kdJ'q&ئNByM~z*ڲV޶whPN(əΝEzB\5\ BZ)6Z$x.a*4i~eZktkfNr~z)pTmy{:g3gk|cӧ|?e.yՅ|-4 rS`q{.`)0ޠQ?We(d6Wf2FS8=_Β/so'& 7זspBHzqֈe:e99/LL)\VaR QzVjZI\~Wl l!E4mnĥoanJ3 ?q6bi~WMlqXfK+nXu>m(;+4cůUia""ZܱĹc%VtstURh&fctStU`(J~'}Xu\'ʠ^SnnR\OMX`>p4BU c'D´iN'9airNs[Xd?{m,o|qI.7r3??}}yg|̓"Tyzopl8)>XMǃYlZ|,"7|L0t"o_ѧ ѵ?~n7?קo#,{2.#1 .{>yKWȫ]gXT6G?u1ދrhUYz5^4!?*m`]A˩o:_#n3W KtBMxm@$V1;4;7p$:hD:;Nmࢍe5;~E(&LyJ=Uz0=nkZ=NT/o#/ZBmR%&X)PRo]s !BEdDږvBKBNx!xݍwf,̉a1{uLl~F2fv rQA1gWk4,BMe(y?T8]9Q[](/EinM9cH>zWLC#ę5i|T6!T6x˩l/FX6&jEIM~uO-J$D,oR ume"?} q,.X b&db4ss*5kVT-"{ޟx4uNr,٫ua K]slçGa1uϭ9ӝA7-u)d"iyq.zلEl@AO'U%D #ݞ@N2WָxVҎlVeJF$Af@pUF,cI ”Re^L"N /[<+Ah\,N3-Nu\Wװ*7yojE*YtSZ6" Jd;/Hb"QSꂿ %- >}k+ fF P8[gr;/FJÂGk|5t7%ouĪsgXwCڈҀ.6`E$#!hؗCm3WQ)8To+ɸ&yUk[0%f,"^J}~Y?H$i>9PV )ZՈƑaQISReE6ooB޺# Ha^ w}4v_ʃ5zXeB"3B:b2E9&,3oVg4ڛVr$KS!r< `-JjIb4G5 UYf ֤KB! cЉq>Q6HI5=(6ET6R¥ '`4BL%9@0"A& "t` ix`K"i o"IDt=\ iH<ʐlHf#t `>7Rj1YhC1A d!cO |SعCQ(ŭ纯Y73.a!!Su ăXXr,lg5zz? kRɟeRc~m4[ \ ݦaúmR`M;{)^rvGY\d 4ő#꣕> F:Ƕy@/ %"#@PxU=&jJg՚*eZֶU!*6.V'{&>v @ Hߤ\*GΈ@igӞh/r<*ua4Α1HDYȞNI{%쨑+x7QxoB8tG Η&3Y۸""4.}|xAOD)JH?Wn3R[JML=% BAvjP=*(4bQC9kBGt+khT!2*4S)#E1 c/Ұ' oJ7dFUV qx*6i55LGY/hӦDW' ,<)+ Τ[AR hBQywYE%E _Hf 7Ӳ"|u&oWqU+%؛W%Ч@z t E ij|N5[qQV^ZNlwaC&=H+##i{0MnD3:~]K[ED.t% 搛sfjB/.TWddm3^m})<_hX m= z 2 TtMm["zD98%hP3BCe/:6%c=7ZAo+it Egـx~n*2m xk]hsF|5LVv+p>C{}fJm}VTƭ͋t" 8 51iJ :L.ԔUA2W5gw,w=ͱmC=3Bު'q48/lFhv M:vzImD؉jHFCMb` `NK (a0pڵT-l/PE.?jn'R3WЙ8W:ƁQs"jyɧx@ͪ=bE;"'Ђ䤐i$IBr54T葜Ih)=ɃDdܑ+{ hsh$qQ 1 /7N1!X |ҡ zT,YOb_^G|7~vKvc,@?1 ~Z(+>DW{1*R*1E"k\E0["`)5q;4TEnAbg'nIt)Y'UOՊx ަrY}VGJ&p1 Dp\, a즳I᷁B)#eW7^>3;A HwK7yo}cλWE?? 3>f3IP$:EyfIa*!Hيă#VrC+ROP[h3lI-2Gg*g!I֓;Yb3bAl,l`HD^qq#WM'{t NiTwDj\ZAd|TR#?C Fl*oRԠs!b ؅+8.9%F Ɛ}ul3iuL5h6)$~11.S&=IqيQh_ž 2_@1@3^SgQ7:t*Wy" KJ8-Ve<0<_e :`2>aH#I%c0*3|qֶ"48$Z %xmd:v.BMl?-Z"#=sf`ȫ8   |{c=la/ y`6,3w)FH7җYȹ@+$e$mRBscߨN::5 T/W!§R7ŞnY\k B|ll93sOOZ;f졮 KްIC~/Ulg:(.{Xx5py=ӟ 9Ƥ`|NmS$dnaa/LΟ\ڝ$=,|1v{Tx4 _+]qtGe¤i]N;g>Ҡ4R399P4bAT~X:ֹ$Pq <;^h|2e*%IK?pHEtFm_ 0\4tMM6dm%7<;ǂ0XRQDUqY`40UkѲ5T`C=%;9-]->tȃVCe"g\0uLKtNCK2ȫFJo~Qbd@Blb Kua-cPJ Yg6^UIꓵ;8UReY3Utu"YfE6cD~@JX#@*\kX!&WL|fCҦ"#V|[N1i8Dބ]_Y*k% ӥA:|22/m"1NwTR}Qх_37 _(aXfp,5Pz xԪG$H4t9f3Fdw M_EUJWM:N;U7M ѽ<&s A&f " {2UH3( m3U" o VﳅtU*d)|3\ϻ Z' $cCR2GA|D C_L EtTwWTAR+Ӵ(} տ3U9Yx@ڮ J]y&3$+ҧM_]&cX>Xp¨JR'f=$E *'}$SOPBULo}:TXY?Ip*Y(9 _~=c='wQxʊڊ݅&?9Bή! 9Wù30k5uQ׋Б // vt%SF#n,:ea#5D @-~PH"LAS2%mLt\Ԣ #*Gc˒mj|L ێ7!֨c^7:nKJ7,ϬWa |a?! v"md%rNY8&[3# HSG&!#UQC+^hqt?(^6.|veT>ףsg2Ջ}l])ؿ\|"™*.J, dj1J:̨rvYߚI5<v(XKGT\ۥ"Ϗy޽x>"grĪ8,reԴ"9] ipT~܋d*16t ~63uy) x }l~.]EzsUL{9d9Q*F_f8T\$iHշ`XH<7J85kQT} 9 VtHRp`*F,mj~IP.X%0 ~c4@ɁaPaoStk4]y>3럻dBC1 ,$0NnU9 R+~aZťp(`ۣ_L8l_8͆nfM{'dBZqfuүP<9b"vvtׄkTņUUcUYJCS+tT>S}|CDV,\<~tMeD'kyT_9 06XIi3aƦFn~U] mc8̌ {9KlN'z|ovNԜ5=ؼ^3N.UgB:TWc>;u+ L{66x.PK-?>栄ڳL0ZiJ$Qz7KXBqNKv6X'1yݘRޒSHHt3T|6*}YD/_:ZIֹSe xrp]+78NG)k]Ү5Z"}tSOWkd!1}W,|7[3XPu6uf+\ §\4yC{U _q>h1v! n4Qo HGJ% N/K[: OO | W`0NF"$X^Y)t52(iA@+M;vP2I@iEH\ j_:A-fT~+ft D6qY&M+Uj|*RqVN.GnAj!^ ^EVxvIلmBغc?; "ţ$Q{y(i.WˣZpHRKle5]QDdnY[ u0+.%pf"*_+&>tCvU EՀlv70^n[Z3he(q_f X`=znz @]Lc|7 Y|Qlo+i}}H_*OhTd/NMz\@ұ*z& y#=y$湅iD{GH =nUq, gA_]@JQNRJ3tB|~cN|PƈDz@~jUjEbćYc3d4fbCrSˋ )~x-⧇-3MqmJ^uc{/G>~4Pg%8Ӂ5h 7N;iRJUM8ﻐWIOM.wa/0 ?^- &L4Tge) <߫xc|nZe3*oGDf*._}cbIvd.:Ttq{j' ĉԝ!1ಎS#0{-י "ZFw>keH_MѨ$Ƶ+}t6WE\X\#]xxfJ#&#iWg=O,Mx@!Z= 1L _HPY ?Q+/.Q΅ 2$L{ET.9?7|fTzÖqeQ\}4& ?hDXv}4sIɋfF;>ٷVgQT7 :!jOJk gbϬM;CM e3)Gv]fj+17^1JNNy~dÛΕ@ĽI.IM!Z N{qVT{j!rcص,T/&@gOH {Б Dv[/ti! ꇩ+u_]&4_e+w@@.E:ERSsvTEo>Tt0|WߠmU=SBeģjҵR^`#]j ( N^5AUyqR<3]&_{u~ \ $H%l);ՓQmTiWſ^Λ7#2o:a2_RX8T47kq|z tbĽ% 0F[(' boF=hHm5ܖ*RˏR `;HzN.]5 r I1Zi  ltͼc'E ;!lˊ`3irNlĞQ3eO >%+Sb1R@P)%wR-rYs##Q(4W9*Xbb8;=nJ\D%ajQt A.bŃKP =u STi&ubH3s$6afC%C)+UiAo Nז#8TA@DyJsOdXP.nMM\b]QdX-HviīMF4X[RC2~ײ?'vh·~t}NJU.ʐ3ahP&^NRaFpb<ǭP~,x_1 Nōn6]f6q[ -/M t2o ?'쥚X ܕ1k HQ'I({n`w Sj2&H+SU=t?'6E7tJ̕x#7˶U7gN#"V-Z|{$)]68s/_G*ͽ ;b)u5 Dy&bjuһP.A3OL/aFd3m}(xw$GQ<}O Upk%ԱcؘvX`sΧ.WGmxnSlQeՌχT("H~=:}2;nT]F6WlBʉL;y!vN(|^]|}XQWRj=Fq|L¼>^/t vj4P5 D<D $8BW"FsEdPBCȩ*c|g m,LZ ޑ{'*^y>9E ;kLj?Mhg,1xlL<&~7 6CKEcy!%`Tvy2¥Firu)^[g3k_ZͰ5 ?Y+KÃ\/,;܍,6k1>aEnF@`~'Xi6i;" GSZu9 H\ `F7~~ǧoⅮSx oRW#)Xecq?*iү4X^-n힮|L:[$` YrMWAM膭w)ʁ,W˨)hPzyȋë}'EȽW $*@4Oelv |@ 蚩o4*3DF?8x#^ rͅ˼ZOzfd] C`r i5.YYae!2Sr ;бzr+cҋk~魊Y_ JT/vW X<<-NWOA5/êaԈr*]r ]d=4eԍS7ҝ r1{_V3nlT6lZ!QtC'ZBAy4 k"!_ 3( n2KE<* ^M8G(b{Tى_ꅙS"7y"FzBJ1{*5X!lhGBT<@2s@rd|l[R\NDoF3^wW]w(Zafwz͘- i.(\~ɱ);-u7N]YJ~S13NA vlnrT{Kh^.;@%K^ {IQ!˔if哃iQl*x'_,\=(oF!80LRs^74$I^J<ԇmw+7Yo^]:xEu,Wj0JJAU-}b ̐F9Kg64&I]L5ڙv5޻)J%<ǧ E+kP pwVGoLʳtDރKt`l|9 ˷N':Oh!`<{6UT d'h,0Eh3SS=&考fjl5Y^?N!Y+"cЪF$2SP^bu?QQ?YqBÁXʀ:H'F szƠi6BGr^4dNSZU6;~@SLTCM4اipu31lEZm2Jеc糑-ԯ~n#AvUQ&M!JHh$ntRLR+J$t%Nj~}|2#^F)a`j)~`syNpjtP(`/PJնxb,>CB椉[(0SR,˗!H)3RZdj֋|7A#"j,_n7ӌ<|aÇ|ӽu9}NbL?VnbZۙ9v 4> ?3dYFБD`ݚ6Û1k^3"F3b7T|GIs@Q>{{/ xC/:U.\6448*/ VaR+dt} HC\(>>z,u2'*?(T*[R;I!Ezx)&eTš;Π@ZêoNI bWcC/!MӼ46 IÈň=gy,M9̶֠Ә0R\y%dELgi\6e9&%H.4|YfDZ=0!Xdw:LO5#A铅Nf-3]y#ŝa:?ϟ>(" I-UoE[9zJ`U'2Y5j)6yt.14i9qƺ7+dC?{k?}C21#rX6"?z^ V{OQ=N1j=C r8๯IfEl\v΃7B\h%s8' 1pů.1je~Ǔ"N, Ui!uBA3tSꡫwM1yJj6 @ZO%iH=D{'S`rmt7K.aR>JܞuZbс^/E6O/l`/>[3{ȁM`mC:PgzRz]SHc5mE3RD 2uşp#N]9U*oN]3<ꍲc=|Ҍh|t~}Ҭ^?a^ͷo,n`s1W6:>!U5eagi:a Mc{d`&e+oDfה_2gx >;5ȄDg|۲L>Vc̱8$|lW:RCos/~ So*ďXt:M\,Msc4%QMbˁT=,!9n4Iq] µv=}Jh;BD ^녊dv#UD$+9Q@iDlAm"VqV`ZQ?5j#GRbOiҬJ4P5n THCw0 nBf|! E?j<_M6f<عH/n2;tCnl?bk/aT`u#I&bAWvvJ+L;/5/YEV@0'iFpIAOTO@t4SGrp~lbњg4^KK" J^R=4MA#{6^9@.t7nFCiS߇I^$l(Ђurᤑ^erT)XV3¡烷 4Ul͸͍Zwxo fm['.?oro* ._ciQf)~{{@%P!ɝ!6kа 3/6{Rh>7c/Mw-έk6|9ȧFQՋw {]9ZYY \[s%h4җ1&gw"[z%/%dž mtn aTq#,O0J׮>Ҽ$ڑ`R;tAL"ATCt֌@0TB fٟQ!Fakv|$u>I$Q?^9?z|OXX篅+⻫ xm^yN䥩9^i+j8Aσzy2^^sΫ/'m?BuET \.Jťb&db#6MT=NQ*MZ=V%>€xߥh4+IDL4H9ID ^MGy4o$w$P嵜QӬW)b^FE$  kD1R;;h!zJS &Qi@ppx7m=_3MM\_JiЛvrsuVLD#ؚ>1;K+\¦dKk42ï~8~@ 8I Ay|fՅL'UA2HؽЋ=M9[UD:jvh^U&>K+;O*c 嘼&*rp|)7 Džj%zBO\>^ˮ}$gM%C4 bW/}3ziيZO,?/DQಙA5ǫ /)]/IoB,MEhVas<~|,JL4@Ƌ.~P`JV>KYz)Uhi@C9?F6B)OZKI?|{[ h"_a> v9=ͦS}W? Q-6 U8[o{OUu󨶵-?6U8{ʚ^,^B4IZr~Rs01Zt)ੴv5;k YET Xh*Qm{K3.GB10/'x3\/;Mjw2+ `?,yZ 3զhIџWLD,N-"PDzr8N90ktFxc+VPrw-P%cUR CM<- s46 菁IZ_"篭_ehVa -&xF>7b/S(@ͅ~$wr=Nx5,ݏZؑ#&UB<|&ӌbۿ蕜L:p]ׯ.b{zɂ-oR沀kG!z=:\~:'/a*yǖFωX*H:Trno"_o^fqG LgVplY~yۮ-6NZM <6;:ۄq*]Hi4BNbe-w w[ң=Zb^E*ɪl+ظW=*L6 a7BīJN ;Z^;ր1:ASwVSMZy. rQ#7Zxk4N{a0ʍ _;S̤v ve՟cEZ)px+ G*IvF6PW4v&tdk /wpg\j&C`Vk;Y6Z%ƻ%/:j'Psƀ™XZ 81^ %l#؄D "@E%fZnRyZgz_nerlԦH\KcS𵚾:a=kywhW3~n19"q/{9~ljP0+uUgGp{gb4=+mL 0/bpFZ0PMq@1jF1ȱ>kU>gp~MNdNQ^`7Z#b"pՁ$ “>ә̫JVgygWֆ"ʉZQ)߼: @Z;e1jԖD[b)97R8 8.:_F < W 6.U@~l}vxYsSTSb>Y?yȊƾa?>hg,h|1p&6g3-9 1eX+"#c'e_8sS.o`q=X2ѼU4;j5Ԗhs^1 ƙ--&H=-HJ٫D߲NzQUWj@'9s>%ejx+()b m=x:=M/4Tͷ~TjWE d#vR9CkX:4b`oU>;XmdW[rHP OyDYAA||+4 B$1Ppc ;4ny7L,clE?یAAۺtX{mAD)2))&BRp O|i#W*]F~ sǷVO׳wV5iʇTD*qx[7;uAiUoQJ_1u%vUL9д4M.2ƣu}ׅUBY,p15ƩY{Z-: BNH>(by/~_3M*p,#Omp6·N<Qj UCZŊF.4p)5qyVS=0h 7^, XrK >r#S1O1Cc>v{ES:~,qaZ/^ٮ+rJL5!&e:]nʰ㼑=H"|ńwxЮ3"<OP0SEm.6`jRi >o) ŋ{X1bټy Jt7ʄS8\_kǎ_=9?ʡ]h 6ByÞW7S6kmKgaY^݀:Oo .ع=6`Sda;EZgGAs_5~Z5|uX)mD]qyRKK>4|&. xW_WәX_(:ݙ]5̟BۈU?[Qhߔ>vt>wtaI+)NzR4Q6EԲkyhv{_voRY <ncvvoBVu`ԋLn@ Dڈ }\qu4;KvWZڲeASY?Ģ'Mk1cfhg &PQllnoɓ0N(fmG &0X˳fx=-WMM- ECO,dnpm'##ౄ(*RGQn0+J\4ɝ›~j>'f݁|xO] 7u*F'~{Vj+iJbnoZ\ևD3(@YFOB3_5 FҺRMɋ= <朗Wu185NXv$?$ &P|ejp &پ&%{/Jbϯi>,sp%al%)ҮUaO:mhr<5sD0_!QS)RKm“uJ]%wP̂QRآpN]DP|7/hTIuaV&[a^QQ%U$A{vb4UH&sKJcI7Ռ+B k&R`+VRHG\:. hgo˶4EQx*̇U^a]妾 o[E(=y@Wk7e`Ϻz7tWÕKM@yGe1׈&k ,)}+\ы4ٰk3bx0kCCM UƳ meϳX!ul"00EaǛ^ۇLW7E(0^>nc}A5?J !!gx:sTb7.tqz$[K99?v2V5 ^-fW06֩r5F֫nL'bkvo} ǎhY5 kC|;N=Tf"l Ɣ?:ި#2t?Ϝ%; PjU$]I&w$bp͈w6w@NcP1==zgZךܨ2«ݢoaQXcJS1N#nE4 `o4yc*mW3ʖcuG\#+*S 7QD6RԿgTm08Q:tw֋WuèjͥPbo~#oK5ȗ7*!iLX]x8a/DdȖkpuy) eQ)XvN^Yzbgz%ş*of-֢19w+@“HQm56jUu`JDctPpҹs|DF(u~l=Rk .%l˭U#mdUjLQA29>HL{x]dٽ1V:{>2QnuL KKuccbc^{IY-[͔ vy5$Ù >39^`|{/vrV_Io.! jrjm %NkG'uzrD v3lœ/Y5<4a~c>h PLR،] lG}֋1] 7\ ( [`˅2t%L5PrӹmGꅇG uQiكSo8amb'2K}&$~jorLwmΘZ ceiiAM2w\.yUveA1c#!"L`6owTz:h _"SUn]˻'!57U7P7 G=sJCcE| IcrթU xEBaGk*>]@zv TE(޶;e\KT/cWEܖ(<ޙ p4I[<5}53W<?_ݒ^r6bn8iq^cɘS 6i::Xs٢]NNƾz{-<#^ao@'.1I>WBuȑq Kt뱶P%|ncwvC'ZF[vjQ^{-T)rbw`Ւ<}ӧp(yA ޱ{PMNB-a ϶*A/1hf?8?2[yaջV[1*EJݡ#fҎi2{Dn{: ގ@ꈺ؜5-Os%GS[/dLw죡-tOc~ΗIZ];A17E~ʮ$g{/ϡH&BΌa[e Zh fz_A$n @eݺ<]ޯ]L`r|dAt):dtipc.lWwe̟N%m(G6]c*Olx4ӡуC]"+Ed_(GIl/=kP}n!d6+Ш)TTSjx73_l'␺N:af+ذSyM+yCqfmrA'w?֡wa/oF7gbs*1؞gͲK \e5iU%3vV77&Q-(c/٭[MшN:ȻSCa'5]mWPo{m0{x7AaĈNPiD2OWjv3(Q4n{,y҃[sr>q8Qg߆IN|w4,*Y\hVIu!%Pʔ$Tvr׺s L6c4$vˮa(g̫nvuҫ"C"lD)û/BkB X&f9|SzS\%jW٫.b/+,)57; +E1ނg= |{g#/xN+Nr 11Wڌ@}Ķ&34،$[ĥPX ^;vgP KJm:4;|:dSx1סW' p{0|3j |st?P^ V;?Jovjʣ.znȜC?7%xLEcD iKʺx;lr S<|(9o%~5˳΋ Z(/'3ְA9}=l-W`P~0t2|`wKu6ҶSlC5~l[tgw&fPY4bbf-P5KoI׼K0axkK}T'}1(if%a4_ K/exy={6tltZk \oدK ivQusr-#Kz+nn#"-H,n\Zy&*ꐤ5q/+#ہD~^͋^ Yxbwn|e}~i..!@t]/xuV,L\;C0*"%CNi{I2R ۻC\b8v Iz&_ t%\iT_rdOa_ُ]K-u]OYgNihXD$ N vuWC[t5bX%TmVc 7/-5}Cc J]lre֍xoo|yKŢM^UVހk)aKfz1Uemw_lH57x#'NkD-eWFŌxUs;"ΘCbwY5#gf٢M[{eB7U-u1A 0 d \ri*[v5zzx;`FLb |js|d={i^k L;t@4BТ qF;6\f#ό1^ 8^6Dž :f]ҌpMIf[ _/0^,N$Qgnyhe_c W5"?2gUċ ^LcP߇~f]h3 >2{@r-l؀;n/,?ie[P1^7%efТuɾvD1*]`uKrdӈ }L {i.ǶlΕ_N>xn#\E4K, (wb+pz7;3'5aQWeL@gj2]Zrc#$b-a:ۉs֋Pn VgB2USXk"-J*s0^\ߺu j64Y.CE$돢_uށ[` fy1b8۪^0 c+i0EHײ~jg>-<ԭ_ݭ-qeAJ6^2ZVИ? 8s _`7>Mf!an8~0Ȅx4|B,cuTlXv(~^&O`?icTz/ͦbjyGHbE/*]\M<x r=71g}zV:ыYj0=vKh3C'"RqJϋ'<_7WzQgP褼\Oy5x;SHv;ۻKyo^83S'n~V'?~'<7=΄{G<$ڶ}ݶ!nQ[ohw)O -Y~klߛO v\rgRL8~ ?[sO{Ӟ=iO{Ӟ=iO{Ӟ=iO{Ӟ=iO{Ӟ=iO{Ӟ=iO{Ӟ=iO{Ӟ=iO{Ӟ=iO{Ӟ=iO{Ӟ=iO{Ӟ=iO{Ӟ=iO{Ӟ=?B endstream endobj 301 0 obj << /Length 233 /Filter /FlateDecode >> stream x!  $$$(((,,,000444888<<<@@@DDDHHHLLLMMMPPPTTTXXX\\\```dddhhhlllppptttxxx|||t endstream endobj 304 0 obj << /Length 298 /Filter /FlateDecode >> stream xuRKK@ﯘcfP zrjj$l&m1MMʊ-V>> /ExtGState << >>/ColorSpace << /sRGB 310 0 R >>>> /Length 827 /Filter /FlateDecode >> stream xVMO1ﯘcrxl>VBjH8 (*hx]o\Vz;3o#=<5 ڨ`s`QQxhW?A]}WM@* ,tV-pת.O6F6pP |)|V%w{`Ґ!XBBLD|8OJ#_ klUk+B (|1+Vωuߌ5cӐΉ;c Afm[QPrEfDZFi,!q/ CE)F{uO_V8iX}c;e),aTH-ooGѲQMaEIQQL*_9&G.㨑i;F[pbQ42NVjj>,tO 1o/x{GvR"xWG,O2XB"RV9Xkj -"O#(d4,ԞA+iBXk !OhYhC V3t'Sf y|p?OF̏'CyqKTe|G;^ы%~a"m+'77m2}[ւѻDPk8 4PǺn+w2\(7qSAV 8s@E^W_|T^ɥNm{h~1i2N֖ZvŚo{.͇ʭ*'_Cbv{s<#Z(xV/7sz#g%N^6N)+Gi 2 ?&zT endstream endobj 312 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 317 0 obj << /Length 1700 /Filter /FlateDecode >> stream xڭXIoFW>Q5}H(5Z -ɁhLjmEfҤ́,o7zuO .oRvˤJ Mn2Ɔ5X/W.b¬^n~_^Y0FU!XYLH,6KX l4ҘSJ54gEַsJD9Q3Eڣ-JzϬH 2Wևs*ؤRD#/ .K|j]~Ga욮ۋ-\\* }dVGRd5<ى&Ri \b};T{P/B9$$- P6Gm M}_⳩8mb4# '"FiqV`g@G_󋤪;$+ '&b5"kbHt)9Y#8r@3ѴfGXoqS+f&ou03*|a %P/VrWo:2Nw>oh t:]o6W#X e#7\T%*ٸ J8HN߉W_nU|J3pm>y,ݐφF~nA#qq6MС,ngHT mj(>1IvM7}i){0a;=*H); ) ; idJC%bMPH)j?5e,~Z+]4 #E;;q&6S8ŌVe@"A8:׮!*}sh& GA1 oCmCs׳QJ1V<[qetlVa *z;s/xEI9r 1UܔtHk"fҜsu&ȍOCb=$D}W [92[W -&W rV , % ʷU5w@Je]mg7߄. F(r!g+X6\|Jǽ1gcrRi4g>(E'byBԑ״fIJ /\*$}rH3N LbF|_rێ\aYc0KHCN. RW\a[1|iHEL6<UIӟ`a_3Z_Ei'8=,6sAn|&%#K vq*}\mE7UCIt VH^9qpr<8GqmbT.d\Qy#a;/}=?azQôwWaN &v 64;Xh䶁I?e\EΏZB4-{dl kf=ͅa3J#S=*A$CayVN݉MϋL|IOa^ ۡL&izdIwL4=hh$m(t@NJZtz&ת^8|;|,$5KFffZDb gi}zNL|z5H%J7֨ vksmvq#) CE/7ͷ5Ƞ)UVI+7!___ endstream endobj 323 0 obj << /Length 262 /Filter /FlateDecode >> stream xeMO1sZ:N$z0Q^dHPănyv>VMѦ p!5#C&>4V^8 SaS.!/mmlT6R9T^=S 4g\rr1eL)ZdoaP6GMUS&s<\;߇!΅U en1vП%[X6 kgAJE}mjs endstream endobj 314 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/RtmpplS3LW/Rbuildc0c4bfb861c/affy/vignettes/affy-021.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 326 0 R /BBox [0 0 432 432] /Resources << /ProcSet [ /PDF /Text ] /Font << /F2 327 0 R/F3 328 0 R>> /ExtGState << >>/ColorSpace << /sRGB 329 0 R >>>> /Length 798 /Filter /FlateDecode >> stream xKOA +|k{`JHzzdiAIhIGvc{ǀp 3&\:WWn~r hTU[e,p1Y0Og~o`r}pGTі,cdERvg_{j?!(m|_.{81GƩ I?]_n-~\L3A6=x᩼v߾Yp,m9I2<+c`q["9h1<8{n>_R<RWջoNf\k_d#C`vbxlF:B[@YŅ׶UQOA_Q_nA奘%{O#v1Sfb֨߂.]RaRcC ŘF(k,uLN2e|:St &ٸdOVOXEY.DR;T쫞ԙcw(ţ44^fțjmQ$dBɇ%dt:FY.ZZ͠@wG֨`, ʆlWdGi_L#7΍YY t6Ǥ嫀 ir)6H SB@N$R RX ˉ<x 7$ƨ$oH\T&X6% Kx Է âD 0/Kp+ ӌx>8 endstream endobj 331 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 338 0 obj << /Length 2505 /Filter /FlateDecode >> stream xڥY[o~У΅Cq)-vDXJtl\934oC̙3 /^ԅ5_\u[Eh)jӲZ,{nO= w_.-mUYW.66LUÛ{!wjryE8ܬlqg:6/g/VpQ0\m`i=1MyCG^ ] VPTGfmآM4>"H w^hJv .,J ~y9zv Iuj[H$A=zJMk= HU QU# :o5wlYRmdCHlg {6S L/ueǵun%(wܮRbܟ`%| {5|wʹk[a+$'%ƙ}>}%z.eYVtp(,v YeN_'س ̸'cǞE#k5u ]jۂ%C-k"yk}#ds&*v:;Zh:ڞ}6.{G;S)lh~ey.N46E ODkoZ9 C>4}bE OF(z[TDUIFK= dǍ|!Aņ&ُrMbv^AĐx5h Tb122C 0[*4zdQ_ᯄ;&!bDT81mۋ#0Ҡ4:~u9wA\cj"4TX J Dߡ-PԿ5fu@DB&ujZӟ $Al.+BiS P4I/ )P߲<2EAlEtYgld| dݢ Q~#ǀ]6Vid-=ߏf+(p*4#zi[v].Ŕ7{2(%Kq]ݬTo(|IInd|\k,FOtVI9ubV%Ԁ]$JL"o`ChcBKJK5#z -fZWDE*>_$kuط ekˆ+O)`R/ %"(ˇ`i25&uTb_$`>û}U Cc/ M?䇫1ZZ,j| ȁ8)A,L2uVl9U!o x9]6E\ $}LYb<1 EYVҨ́Tᢋy8c8G-\9bfQuA+.(WBRY0I]yiMQ>9|0,AYr׵_^|+upuѴmڴ( ǘ5C|QhHe1ڗ\Ia]VctM w)FFҜ3<4? mL%2)Beȋ8 %7`#0q8g2I(3Q2։qac0 .59'2 `fm/%MgP0xb.S1 9Z!"WIӌO[p{dw/W䳩iJpau ~F<ÃoS62!#8BU8?nQZCHɝCۿ^ߒ1H\?UӸ>4Hmy+S]޴int4:Rm0=~esk08mXDŽӯ0H 6do /LZ2/J^5MB$Z]4VUR~q"Yk4d՜}WEMLR?t s M30>BVtz ]!N.q/e$tO) n4iN|z4M7m+J`;(co!!͗?d]lZUm:+AVm==-?D-T2ga v-M]ek~)W0ѓ>g<кXHvxsZ/ XJ@pCy0af5H 6p.C?+_ {Yi5FM 6:|>k:jw;;G j\'{!RYYXH YG6!!WSd5ğ-WHiB^ՔeR endstream endobj 344 0 obj << /Length 2127 /Filter /FlateDecode >> stream xY[o~ϯ0f974n]>d)[2$e HEA&9ssՋ.]8NYטY9kڠoU:ו9_hm|Oxo}};.M}'B}`*Wa CNzZG )MEުqnA.T ^YG֢Ew6zhS ~0M5Sk)yMOHz:(kBTo%XKMpU@m'\#[O$ e͵r{+F_vr~R'Cj>$+ۚ51&ڒ< fUݥ"/ աarXR7zð~涶SֶSBޛ[Ij`O0FE[}"%20>~ hAWۧ]P^uD|u4$M,/ JIs[eB N;~=t/2^Kwj t`] _筄lnav<1hq(g2?EvLr/1[}_J1GLB{<> stream x˒>_#UeHU^ǛJʮw' CqQ=5;~PτGb1rčP黉 j=|26L ڟuhڗ.qɖ{p@Ǐ{^qQ=7hQt2!:5ACaP: #ڪSXHAv-A[UQO!=q@J'3 <φc$fA8έs t\Ov{V~!:M1ܳF(ΠVBi*H+C8ha B؝܁7\ ] E/!d 4f4 ?ӢgF"]?LI 1.w?2;$Zҫ=|L?@KXd{P{߳vbGKg*%mljPǹ4 d+̵R}Z-L,;5۬Hh{릊4O])u> wiyʺr o/DtI+u*P肜T91~^^e=pPD Y TW>ΛXA0:R -~1Bb~ppkzku^Ѐkjߡ^4܏I0IK&rH"5$;-ZUZ-Vͥй DY*HjI3*;tym);%K11QO x~Lm6ڱݝdԟ VťKJBvկr>_(Y.ZX p]I|nv1+g*%젞#MsgWᙖ^/P?)ß|u۶+Ig0j))J}X4J+vj)_&N\@2]ԥo@ pb'G !p?M~*?ٔtOk94Ŧa6=-En֮9!)`BWQ[Njw3/X!. \swqn%ԁ*MEH]p<+!u"扇Ip͏7`S,oXǛʠ/v> stream xV[o0~ϯK*5^lIMR4`Zwh']$PɷsΉ"8>rHI لr9IJ9 ߍ"E8P8~e P~4P;攏`u37Un;k .pZI "6FCs}Ȟ^3|h@Z3uG3\3tV#cke+0 0+--Bx,}+OHRV l'eA _Go_ܡun cl_.__9ٸd4]]Cuc}p>FyjO|SOnJkHqX-@u|*/^_ᨐ͐BѤQaTslluaIvRpZ # 'ɘ IfU39O3{AUNޯk"uOCCx%$ܱ}<]ݽ֣HpGQ""isK\^Ɖ {|;kxWWSChЭ[?YSpϰ8.un  endstream endobj 348 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/RtmpplS3LW/Rbuildc0c4bfb861c/affy/vignettes/affy-027.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 361 0 R /BBox [0 0 432 432] /Resources << /ProcSet [ /PDF /Text ] /Font << /F2 362 0 R/F3 363 0 R>> /ExtGState << >>/ColorSpace << /sRGB 364 0 R >>>> /Length 3679 /Filter /FlateDecode >> stream x]K bIs-`E[""uS4q{|:$85R$\=f-ŭCKBk{ n߾xuιm7Qqq#ݵzsöS10,g@*'TnCFz7 d3f^^*ӛž<*7SNhYqf7ٗ/?b^~גݾzsۿn~{_2 sn%ŷGG)8j fGmajY߽;%ũGYzjVTX8] n[,j ܞJ{~:e?OcQ̪Y= +Nzũ>xDV?S=ݵ(N9G'~zu8b? u^X|l^飓`Y.[O<$V.8_!~OpfX7_|< AcUЉ|Xԏ_v_\9.zSZX~onVD;}dC3^o~w?| }/[@\Q{ gRs3:V {ݡdgĊE+VMNKei }XǺ b$-[j]F-c))zPlXPfc ZGn2Vѵ=^n+֊.ߚMAW lB冠s].=V;XoGͬ8 g^ #5p >Wz+|ɫCF(D 'Jw[V~dYx;utu".s?\H NWN6+ICYw<ϼ˺g7;ێH.z H歶’ݖ+ #zf0n)wwƩ.gK \ed^3$GK* .M 2&9£H<yLUKhXֵ%f`%3’T@rc@rx\ {O6m-Sk9ОE'1z<"e_dDZ7=C(nv3E]X^h6$=<ڬaoPvK. h;x@$'9FU7^lI~ٳvD!y⑈/`  3!`q *xҸ{CM;7ZSpҽӰNr7 ;4 YU^d2`Q{x$M߲IT.|?L7 TEd,OCn84 B$=ahK7DMhpLz>rm+<`jWr( fzzl3z9] s=\:`1( HN9#i 8z`24Щ چ8!fdgAdv<* A%Wϕ8!pv|d ~!Y'B&.$Z0[ΣWł"NO=O:\|`z{s%`0.zE j`Rᒫ^af7n5l,ъL g(Q(L0gM 8z=yFqgWrmũ>agކQ[?!oC(qf8s\\`n fnQ3M\7Jߠ_ 8'(~$_(~q8ha|119J_\Gb!raa>ţ3:))N.[t~&uEcq}T~H0 dI? H0yiJ` ZNUWlVi8Z,"9i8"fWHdC$7}Ej"j󀍋uHHf BFpvJpB<^z˭`oOׅHT`V̻qZ 0p87Aő>{=(!d.'DDam5?L)>WmE)Iӧ˴z>^C4`+v,ਞ+ :1Y)I A0٦1^$.S(مO2!iD2APf;}AH2OX'L0l2 |k!-'RKՊ%"/ (8'EFi0(8@``KtE/(I0@IؘJBU Nw?,1h{:>`=^ܙ'+$ v] [ڰW0; NW*o,AM}\Q]s\2\=c>S/%Y4[QGHs`(j|l`pȐWuo^W ޳e‹(``Ki&gE= ^X2~9+$]>Y$0$}EY,6钜oي ׵{eaJFHwɞSmhxAIq5#-'|0 5V9oA]-"iOz#tEnhEA#<m@%g ~):XRp25$ͮ:sLH,Vj}H""yvKut G=_fֽy+ >ITru0 `|h<@`Fs]&0%iɨy_sgG;ZƔa2g=<{Bg~J我,w7ar-# H^Ia(rOvdjVp?zĻ@D!:}AV|nA=8]%ļ$#z endstream endobj 366 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 369 0 obj << /Length 1921 /Filter /FlateDecode >> stream xn7|Z> M=%FV[2}g]L9jzD.␧oε)%*b>**GyYRz6chSl9e;i}2~\'Ȧ Ƶ!@` ~537iFB!q@ع]1ǥF(7ף60*FOjh) re(L&7Hl41e) FeKC4-Hȯ\fso]JKr-z ?G8bERtW-Q054(=POɦ C ae789 ld(ժ ( QQy!\e`J;u k]!(KM~ĸslnH?2eH"6/KD| gtd67MJ}]0?aZ6#hy`v(ʘ@KN֚%iQ>&M)ܫ0\FAAj...e0"Z}NX$|l='Ҳ(V>BtQC0OytƜ|ZӛyUGŒoGo(]:6ȭ}E.?w랂G ;4hSp0w "ne QP~]zϡ4 5T|B7NU #pZK[*=:ɘr (* !a]u.%t\N=fOfE_Sl&*АN竐S2hc #v  ){Fh9j/Dy= -ʯ5UP8q@WW2gsE*~Yp=Ի^_)M^ cכ2] =Lt:CYӔ $ ܀"P]qFH[f]?~ L>=Fwd|VPUv}ԒpĖ}00it§ʷR_xB_ `yGZ{6/`NeT(輥z+d+ϴ½]u>&kӘp3X&SYa ?$ͻǚ[ X.ByL t`+!_>a{3wPtµ 6ǻ6Qn;?O ㄤT >c- 8z8R˄DJP>f3Ա Z)Zd7.&^g T8n}[XJbEbZ*UH5#mdPJEx\}YgMyNC&19㼇o6lNnhׅA5Ov4ҷ/X{|y[!XCK/V>.!7kWqϣJ~'Oz0G3Rs\n<5ʕ(:0[?KdƗܗ{A82njmhPe"K~#D*樍 H{#<i~V8eKyv@mr?':!_YTOUadզm_2[߂>z̥rp.};8:]"xTpTZ9?=E5<KI M)xV:Kzw\FmOZW`7t罿+ -b$!G.Plo>&6BtM1m]Gڅ'#㨝)qK^ba%v(Sӄ o. 36 endstream endobj 374 0 obj << /Length 1518 /Filter /FlateDecode >> stream xڵXKs6Wh<=P3C n=xTUle#ɱﻻX E9JH>],V8pou5 C|).TХu{]qTq ^o]X!BtdƦZl&c]6T"#tel 鰩z&36{Y li-Q@= 'ӡtb7q+u 6`w0\'?'bvfe]Lì(8m1]xA][x=5\#A]XLݲGrbCzD7q(n*pdk]'ڛfA sx] odm(1ml B|v˂Ajx'!>%(v%,EFga{+\!~(CKZLl1#>Q5Sl3=-8rv#< iىHA( zFV)q>̂=qVF5k='뾸֦;e 6L/;vg !U*K)ƽE8jƃ6rNRC`+ځD ޘ:K]s.B" 1ai_^wsϽ*7dXxCJp`Vɜ7+0tuJcvȒn.̩ȅd#=䦒tЍr/@p_JCu UwiJ$T% SحO|荝R)%ZV5)}4]ͶKG&Sy{_0!1*bӖaė| ;ΟYog^Ẏv|szx#.7+f"fh-TƄg&|uLuh)~ V@NX Dҥϡ 6oz gt~RNWgᄉPS"e$YσO(cﳲ1,P. ~7Ӏ\ax`ݡrKQV}:OLz{W\uΎ^+Kz q3UzyAgטҾ $Т 3OP)RծOcTiѯ^2AU,?tչ҆)|_+]jaou;p \(g7(Ȟӹ6jgFx"LA^D=ZsF5 0zto/狎[B1YTp 8rj e;ap:ܢ5 l:8Za]dXN~;K=/e{&r~[*<9ݰ;ʤO~PPʾ#Z±OR +_/Op endstream endobj 379 0 obj << /Length 1354 /Filter /FlateDecode >> stream xYKo6W,S$ ͡@ ~^Ϳ/g8#RquP$Qpޜ~>{R": ^ ⰹmUJt;KןoojY_O awE3uVN*51E<i5>;}2#M2CA:Ȏo,lI.Me%OcˁC5֨Om!'![xdzB)SΜ.hMbNV͏hUTduA:5CX*~dz-d2Mt5M/u$ 5B.3\)xlw9CoiK/:ztA(:Lm 7o3vj<ᆆH,-psjbTAph* z܁cY rC0Y J$ǛBpUN@3c Ze*Pܼi48|=&4@! v!%oڊ.l:H˱E3k&߫-9:6IP|MVȍUD^UHFVDS}BBW/-Ah!-js Crc aZQ UA#k,} >Bk&BJl:)zJ1oB&u1̗n19BhB@:XB(1F0zj 9TPD:7P]S kESdˣjkkɰ ]dºP su[|OBY)z?S%.5Vky'R 7ɲ+†K‰Wګq?9zʻҳ(Q["UoeήԷ O16^?^n{pxc*zx&ajQ$Z4-ԫ699*5Z炓Ovkf=BXW iVê%e'XLJ%Ͱl^ah+-w-zh}P}hOnfQ^2}n /ƒkp<Ex;<0jD).!5\5.Ԉ"'~Ԙޯ{SmB endstream endobj 383 0 obj << /Length 1697 /Filter /FlateDecode >> stream xnF( bp q"EhZ`tIڎ} 4-(p޾sޭ_yE*b]IYⳗ-WabrzM%Vw-r.bﶀ2 eyU O-^08V:XT$g*,nqȹZ~6*-<='t|Vu]/A* *^jHEݞ4O(#zP#Dw{>` %:ȈYu>[$\_$~gl/* 4`DBcEǝ`7<)N6$:'Ba3[?:T:^b94h#,W܉H)'8 x9GCy['#h<>/h\n w-dۣj`tjl E W'RHH2÷CFX^@i@VĠT/E#'wq'G&厼1(@d cC03Dc#$'ն"EV%) $,uӊ&_>W)`,&Nwq*h=JRCd©Dg$>y^0V:Osl28dlu[<喗22p~\0#q2Í&;Aեn;/ψ 7 %!9eaJHjq&~j3Aߎ&q`hOtMjz f&Id[APr3-mY)Qi4|.U.I Jw!T]h> stream xXKFWpd͌FܰʦR..8ģ GOi]J43=={*w#c{;-GeeE ,FDI~~*CYx̓tT56ѻĸa<2zyˡxf> fM'0;f23lMBlf4qj$FI-`z?G 6MCA w,K~\ӌ-{nx(hhz'&4cs: Am-6SOlp؞jApAZi׼aMnјm}{Oo:ۍfk9l}s$[a"+YqcEVsKfII]z%y63iC.~;2qSBւ'yfa9$zz[5y;L%JA"P \n%!3BH98ĚXp]RyF:28Duc6A}c*S}I2. +3mN (rOokCZF6|\$NW4S$8i FTDVw)Tw[=JyyPY!5u^KQt+[:a+؏K9c"xT=ӠR9<*| vUT*Ka.)A`͔?s&5<ΛWq^QH)Րii?0xq/ҪWVnfv5px\\Fܨ+1GJ=4ß8*i*uo݌;o:{\/8LE|;<ȌP%][3Ҳ4qi;ۧ";gC\s)]m? *tVm9.o g > stream xY[s6~ϯR3K$HJ4٦Ӊt<%sW=sT!\;^L2}v9+m[uf<.Y}*}|+s'Y³^ 3uEQ=||UcUR~t[q-tEx촆x(֩8}kRmtȡS:/TEA#Բ5L3.Hؠ;Kc]No'mhf_C;'wB=W6ɵWs=k1ӗwVyF$Wb$<:cRԿB U:rO٘83 "JE(4i2NUd#Lu\:d>ydgaRC!]g:G0=*\u"8c%3ǫc3;y ѸFQjJvU_r*,'n;m#Tz SfaΔMU0W:/*w],ۛqi\BIW ơFT;YjD{BP(:1$c݊V9 sHr `tYZheqò91n4r#|F|+QZxªla78 mIi}G7!U1u k/ Hn*uj ӹk{FJ2y?R%1_mbox]GH&x* , $SRn};V\~!/E_g]Hxowz&}7Rq~*Vz`*D y+R7,!аa {,AK [4h|(Bux*W^+ݩj0o3E_j)Y u}G| 1ߣ@aO=.|]9"+L'kB(?q R(T4. \q= &24Uj7=$i/nԽ.4܈bo@X`ahBAvMbp_s+zS .c"pSd%1*`0; \vK(̘7#N#łhUn@F?g+z0؅j~>&+G=>AX#tl.勃I]˽}Bꂧʼn ̎<#n8C:#!g)0\lc#Zk1"Z{M]M3N܎Z^kz^J]p#B'>k %1tW+XO&Ccޞ3 *㼚'U8/ _ jn[L*s *5wBrCѢJ9]hj]<]z/Ke`F &\OŶNQMCb]<ڣ]\&6?<;3)qgR\ endstream endobj 295 0 obj << /Type /ObjStm /N 100 /First 875 /Length 2118 /Filter /FlateDecode >> stream xZKs7WhK*YcU%$aDP-9:~)rEoR=LLB 0& ,Yar<ZxDVDm"8:l޳ IK1 ADh/: `L f.MԬGv,Eb!a# `Y`ELF  aH"G#BfT3P$- -xFDf6A5 FYvLt.3|t3EU`dIcɀ0шylD"dprD wIZ#6[иV~x:O 78<ޔB0֣jr5PY|jr4UOrZNL u5D?)eqjT7r6մTb8oJ5j<*u1u1-A%pXN5Ŭ)9Qy[ Q5w瓫b:FWC 7)[ OęZ%R;d>wRR2N4Pב]NKŋ߾`헋Ūk*i=|_6U=y-ԇs#6[cl f ԻrVϧ|$۩V,4&ৰ.sm ^]Kx *N9;ZeDTPy\vqሾ.ӲhzrR4xqhʤM&eu~Pċwiq/fJr_ ny`];q/'iQ\7j*jX Ms+`iU=m{NyHpHZ7k&?C˦ˆ9ROu4|z\/,\.%~>_1ğz:*VtިSu9 %I X#c"ȥ ZX cŰjJY\^lKH`绗4\)ƨ,9ȼUj>-e\B_{^̒+C1C0жIJa4Yrڵvm][{gH6l`|Wo-{V)62ٱܖgyݨ-M|g{+'w}}f $#Jr,Ʉ4 ^M1j`lܥ D g=M%_8wv(B4q[ەrh`v9^Mt2J̈́e6.딝 k+j4_t 4jG)sKez s-,>-ϛ(^,N]/ 1_f-N/wɄebٗ9K&f8]{rukg*Yx5\.yawݙ)"ԒlbNL15/%87dR_GXE|N{ lX-|e۔^ø{klG\ 9uHc}k~kߤ|Wki=uB39-ggͳ&lzM&{dUC}XI:D\MC[#nc::s ۆ ,(H.Izd endstream endobj 397 0 obj << /Length 101 /Filter /FlateDecode >> stream x3532Q0P02T06R06P03RH1*  2ɹ\N\ \@a.}O_T.}gC.}hCX.O Ƞ Hpzrr& endstream endobj 398 0 obj << /Length 129 /Filter /FlateDecode >> stream x3532Q0P04T0P06V03TH1*22ōRɹ\N\ F\@q.}O_T.}gB4PS,Ca`  pzrr$ endstream endobj 407 0 obj << /Length 161 /Filter /FlateDecode >> stream x337U0P0U0S01CB.c I$r9yr\`W4K)YKE!P E? 00(?;h0a$>z A?$h LF N8\ù\=Y endstream endobj 419 0 obj << /Length1 1369 /Length2 6988 /Length3 0 /Length 7926 /Filter /FlateDecode >> stream xڍt46BN z%zeN`3̌^DoADD%$O=5k={_6f]>{-DG %Jڊ@( B0v6cE%76e04=`Aa$%"e'D!(6%脾+ӎ (!!; ABp6qh vP)8h7I///~+txAN} ~ BO0tr ^`$pcA pMTh ?W?ѿAῃvvW70 w8@aCU? 0& 7߭ z̈́C!nh? 547׬WBBhHͽY ;Muh(ܘms@8x9 *`e! pu O?O{` q q|$` 7#0X@_g9?>@@%yt?}Gݛ{e?#.?s n p@C,%ws`W(↹h#no /*"`@ow(U7^s.ٍ~ Ct(O O/ߍ\n>NvAnϒ*p;/ lD}n|sz=7p&p3\$Qq2#y#ߋ!oNs z/A1uT.>iGsdWO' ɽmds*3LW~;5a./Gt (Tw23o_?vU٬ɖ!NKyա]Y4lb]o\Th/(qgیqZh>F|¬ ":Dm ǝܨMdžKydOBgc_8V 6\:Zl&9_^hY?1z-56?!G1&%Z<WK+Y=RvnҢZIHX$Y*^5#[戵wvL}B7BHkF"!^JgaSe4DrdeMFJ,Pl8(D &k?M?ekw{#y6{X y= 1Av,OIwg+cy@yw>6<`pbUa.?92Bk pnްoE{Q$>喿 h~>VK z+TzV^CeFO4\ޘ~" hl%àڱhl2v`\mI\W#j V7F%m+:kV%(@;E?kr4VGG\cqKbY 61Au\H+u1YjXoro+}I!4&VTjX p_t䯨PƗ0=V4.)ֲB?AOM&B׹Clfz3s:Ȧl9J 6W$}P/.iݹ8;(uK XϾ.4'K,$n'v#ԞY}twYƹ>"TΛYpcq 'JDj]+qlXiܷ#t4yK`6bT^)}0`~`M\}X#iQ17S'20 SCa1C|[YV:WI!UJDul$fgu"bKE㭨!M9Wt#q:jatb3k> l:I:m9h"l($V?=nR7[E:՚_J KUlC=zA/bӈt\vg1A+ZH(X^~sށ_*oQiXs?Z+#N*FS0>jv~jzbp\Vu0#g^X3i5] QjL[y݁q)?=!O6 lz,[ۡ>5^qI!JoWly鯜YBx{J\D)rt쫭!>i9i6KjZyϋe4"ۉc(YiFm?ZD}L̓v9Hi!yqV+ÙO$tWfi H>MGzeɍYe9ڻ}\ow[_2>6'=X+aS&DM1Jzo=~[ ^2XO3bw "RTG૴[w mU x;4{ecRoQh|Z&LyA>j*oOg3 1p<{ 7^+$_n`+["%Yo^WvC'ޫ&b?'8*%TtZYR]d] GB8 H`_;?#t3c{y0qV^L[ը w^{0YHdhr9WH~ռ;NHi2Ti#:q3E3msh-K%5@~”Ugfyȼ ''׾>\?XZ9C!-FѴ}i< ;/Kt?g1g#;C 36@>}3bߤUfV[#Ljr\}Yg;'|+HVXٲ^3^%abLRk@ˎLj}РHFUjP:dy68so~\Oޣ{{jM:Xjhs F *X"'ZSMJ"ǎtuo[ ' sou\u U2zW&b%RVFx`WFr9ɜ +fCw4Lv?# ^oၿ=Yz)rE+8 &B\E[eKP.D}.fmZ)qK5{,_rr'H3TU[vnAi-quׅ2ž%cJ  jk}% jJةn{Orb2Rh(w?*:1'bGjKg徼8e86o:XLM|_ 1ͥ.M@ /Y_/g_N&2T69Ǧ3^_|Vo̴ ݁cRPqqРD)]d 9;+Um52ڟU,fv5z4nd_uoEc5Π%Ft r-G Ć}j;9:(Ѓixw|1֞X ]\5Z¦_>Rb~ShMEBO,R[90I{)V!ynG(jJ+q- nGm4ܹ'ɮS >]li+"T,0d||@nE^sHmN@ʦ8eeɞR>b^A gwSd*[8R]q+M#nk^6ubV,Rsvڍ#Nl:oRLdU+] [< >>z;}ICי[ޓGP-RGp}d VT;1$8g~&i\ȦpgCVZ4{j{Ew#kamQ~;~56DUeoJ!C$_OR{-IfH[ Z/cڰuݟm``Tquh/H7qyjEZ`d,투yH܍Tۘ 'M&cig&x -k˶LO}7yr*j`W1q㖵?S<9+jf@A[+Rjrr`vcCkҟ_.2\[SдK?#rs.ξI<`cX=]=WR `:Dz]ܚ*ZjL ˚{݀%:yc%EDž/(:N U&395+!w3j<ķI^\+&v5Γ k-nw'(ZI}O#UNTVc&ӻ4 {ídLGae%uM%;t3 AŲ.0{VHUX`?XGpWg h[9!8)Gj7 +5\tCvE N!\@`kKSbne@̘Dfe"c[}rfWlY=̍veTo$\~uWf)M˺K%r!\~J2m7xs;Rn`V+X݄pl:Iϟ/BS2HXmTmiNNT~sw;7,ySfoq6Ͷ<){?uVqK> a ri\ r7_"h4A!:A> stream xڌT%| gd۞<6Nmɚ46'&dNvMzs?[}Wkչ{(HUM퍁v. ,̼Q9MV33#33+ ?r8 u?,DF.21#C9{; `ef/@ :Q;x:Y[|G ow- gbhbdP7xOj~ ^&&wwwF#[gF{'sAz@ trj od wkpU K)T\܍ P(8e,/z07ܿ di9PetpٙehdlofdicdawF a%Gř A-,&{2q,LjՁI(%o9:&L%PtdKу   ` 4C 4x'K' 3c3ʉɪ*ED= lV q,]_);3{Ͽ?%{ 4%o1@Ae`6yv7E[zl-m?#Oȧ_Oȧ}S>A&?#2>AM8>t&6O ;_[?%?G?>1(07Kiǝ/x]@?~<26?Z~'LJCэ#ג ?,:mD:|\?Ts~tq˝ީ?nއcu^  LJaOb|4nr\?xu(d=?hG$/ӿRω0qu#q?V=&p+&|!V! S?(5iW\#Adm: S}Z%~>ikoORxy1HT[v"0HKG= G"ѕI}@ңa|m"lq_順S|!V-F7d"8gʅyZ;t"i,[kӂJUV^\r\mB;YJoTi%xb3B.d#G:qc@rٰx cnWB8gW,l`!k3E_lBR8q yJ\f5w6@<z򝞖su&:B0Jf4bAexUcdZ,vLjnS `U}O`[K!˦:ٸL+^>;q(2VZc4J9 zR#oTx%SesǦ5"_|fgC?G!WWL.Xr*4 {#'fnz8 UqFOICpq+僆1"e h[[6ѥ׼_½4'}֐g-Vӽ?8 oeCE1@q+ Sly(4S,^1BnJ7t3P+H#+jQ47"6ާ8_J ;P:F;FVyw;k_laiq{1yģ ':3_?s9Cfm> dW>3(MVeRR ƨI(bY>B+~{[bS6v }Hx]Bhm!47ɽ j{Ef S,lOL~)v5ФLL+96X/d/@'D͂'nA]iO%jzYm"hb$pOimn^:,0lstWam)7ck76IiMНkx"YԼBG H}Pq8'ݘ/| {`4MB^kHiHՉW&pO"zfWFOv0f)Ԥ\d{HN\G<=tKI#@ )"hvMpRØ(JV@xEYF/< @J@Q$8-]IVS<`A+yޘp0F4"<5>:~@C`a78MR6`EB&}폓^UiKi:][)bigN~k\E@R(y\N%Ȃ[ل_`7kYDhf6Yx)Lf$*$IY*m&]K'I1t[iL+/“V >RRݨ{ܶ>̍K[ __vYc=-רB甀OiW )!~"HxU/3_WYTnR2?;~r{*3Ȑbft3S~:Tԯ0aR]zL)+׈yR)s!VDE#Z7yf_P8me"Q]_E__ߕ] w(ߦJdzYǭ4jgzIф(ay  9ö=R+Յ{kMg į DmIR"ӂB ih/;)uyz!,sO2̦ Fxf_Od4m1[RM0r_&,FЦ ~49g}R9"7r)pzkh`}1G)-ڈ,]^+a0ur5ܼ{l7>Ą00Ϛ~$3,@Úe ipYWNT'RǼq,ԊӯM~s}k Ou 7b fl& 9 *QCmǮUbK@\q,ZAT[b\PPvTuy=@ Iw4 omp `jCy:f\Lx&Xс0j\rӿ`xxw'lox\wӀiMbyrb)r6ׄaۙtsXB^6lFW.9M4OO+_@hTgfd1+2CAI+bQ P~/p' 8 2GY/eYtbY7w: `l |uBv$gUNXڅm}[[,KĵAvV8OvVrvfRʒ5jUZH5إ92(QzDH1.{Gӄə v)Lö:I hw3y00] Ts~e4#SBSJ=н/25ƒ&b@_VUsV)/=\^H"C! `A}ϸ~Ap=>Lլ 7i`Dan`{$1_qv z_=&VpO/[6VmB1وa{>0wCfk`kt8ϠFbӛW*R`q:kyG5?yZRMNʈ#R9$# _7EeY4EBz{1GZg')5Z Eܞq`*lIUUn?!v3̧_c+\Ny}PNE/lsBP+C4wZ ^uub֠ cmr:uz+wC)eH]i*P.oRlf25}F{[/7qX:x}g:97??[;]I_eUEdznh~jIr"nM6kX$%IgpޭL&'>%aHC uk]^R5{V\/ULq3kr=Ii1}x{k^cN1K`)77UieN"hnx')y:r"B2byЄqצ) R}z@08ʵQ*C|/ "ߐ6 sGkC J} gpw,Jkr1U&Hi]OQ \jVLG ܫ϶J5r!CˮSrF>=~fL w,3Ϙ6alkc:^CHL`גT#pݛNޣ6<~n9t$O\:y(ѠǦhT¥ϒwL~q$;yr2 -ڼy}J*1XI-*XSnmj 8zɗR;+]Ci36wI/xO2a(VTaAdy$茦~/uP7½xw)h9 )뚣_Hq4'R2枱{"O1(jsT3=<;Qx0kirlRH/3eG_YҴNHfa+>sΡHOCyTCޓڸZRFlkm %qJ8Uf *e4^Lft|>Hx+%_6g?M| CM-ZnNay`7IԖjk1voV  t=j7'mۺvc6[Ι\Gj:BVۘ[,=HghtPdYcL9}ր/ߍ! |4GݟlvHE"}!ᩓU\RՅmˏ)/jCG0/5x̿QV62,Rt {xgc5Rgĕx#Z\X>d I 3v][Lo=((\3"U.,L)Kmr(Y{ EEWo,42Kr'N8W;uO}!a( :(pM~l',gF'UVϦSÿ2(z`uFj|$܅jO q3شtfg_A':lbcX- դׯNؙЫo &/#3PB"@)Hj'Rc zx_3b $'4=3>)vToby[l. xP;l -1Nk؍VM]tIҞqbzbEt5X4+o7;2?D7Q`\.n@P85ovn3ՙ:gy|[!`-SwM,v%@v!v<7}9 ]/3 ŽUn$ kSj/M4t{U;.)~?#O#EQ}if} qVUn˄F}e<ۗsjK8=*EERw>Zjv~ *ٽ%o.<2dGk>pZAPBKfA@'[h_S MO_Wrɽ` u ?`xS@V/ǜq(n[4y˕8$7WED&fUR?(d|IE^ ܘuY5pBb o xmBVryN uz0q&:&ic*:f=G}Ͽzd”Tҧݭ@0ƭIyb"|8" Cc\qkASfɋج:vf} w*ę`dX~23:XS3 ] 3أ!=͉}BRD)xij$w?np) x] y/Ì])Ca$Дcom:C-_$zUa!yP*7jE E#.5iAy+ "9QvSlkiR@Sf wK Jysux0zyc@Х2hKbEpw_520^n  aMM{uykH3:0+mG2"V2CZ : G]=,3l^c}AMDіXZBNdIv6\j* /bՂ1 d-l(i&R-uo#S* BH_X̱.%ͥB(b\' ?,c_vAsg$D3ɫ|V.u6QI !ۜ@{e"QL!H۸#Kt*-4az N/DʝHqvƶhKY+ !) ()eOtm)3-⭃ +vq+OyЉ.:Y.&4CSc2t=@zq7QݛO.\@뱽D )Pup UhgRD>@J :vl;C>NU˞5~p<l`;ȓeT4ǚ)- ROā.jz9h⊇,ʄǸVϣrOƫAhZ%dwr%d/`m}T x[ɗ# m/!{j&l0"NP&y@FJ'>TU&feH2ߖR}4"C Ay_o4E߾mc*֊b\%qRƺnljt]=$`NH%q{޺f,\w1{z+t;)EcSs,K!$#ԉ~O\Ҕu!UtkHWOf]øTW_ɔg'-C?IdQeဂEI`Isnw_ Z]gxyK<>Q9B.Er* %Y$yS}J_"ױ季[pE?m]z˗6/B+.:sC]-@ӠJ.$D5+qoJ>V0/.:= 4UX_2OT6 %FwPwaNt 2q^-`W5V,dSuVmܫ;?GS / ˜!a>g#U!kh̥?Hee`98fAwF ),;2M#Ne[?8E!)L2wlOxǬVyD`11Ԅ6yj3Yd'>pUj&﵃sJ`ء*ZI(D!G}7{35Ύd`~*۞A5cK Z 5;(GFuhtV!_+cba"P.'SvjC~8D*+٩1 Oȡ$pfC4\Qj{ "UEpYMƪ1)n;5hUxVFzL(gƼcbr8%P03$w0@'Ʈt5 GEmoZ@Wi_;ӓ-Omz9YL&#UpȹMWы$P+ sE~Эo[~u_7xgVvB=%YkDwKpU_bc3Oʝ"vKFVq=c{ ~[w̥87 l1KY5؁.%1b^i@@3nTfbݩyXDX<)h!]KPPb&KwʔgTLvWiqXJ;.Yf`l\gճu{~n2^{&`qIZM-`_ذkHZ-Ge]@{|bˇ-_8WEUih\8~;aŰ.c%ڲ׫B{?ey r* &|g_z,J`௖ͧ@2/>\b?jT}US3C1{[?UD yءq2rD>epɔ96-}M~ja'qHx+kkIsr@Wɿs*V$~̥Q ͖C3}ȶ+=Ѣs<|w#!u={1o'?@ QCT'B]B%_ L{R_]͂OhNH*H#*cJFvnUqd9ޢYPnv,أkJzGkS 8Bc(=6p/)`xT/xd/&S ŒrC9fJ#Nk~јfrgQ\\NkH_ ޭj uxZIjM>auEG/at?<A&ҦKm`SVhbcbSny˼qЍ¹H8\U* sz8\:&4YtprT?Z訹Q}4)fͧλ۬#6Gxd4ti_uuL+w?{ԭ }YGPF3aiz֔(C&9-K(:<΂B筏8+u1iVR*L'PcIκ7 ֶq:5:vꞳ֜c®kil[-(ۻT)Rl \,[H3i[}Hzv_pvثVRcҭwзu˞n+ytHHd<5u7쏯NH?dL-_4@l|wLS!HU1fR:zoTt" #iA|Y|]rhÃSxv1jj@zU;*U37yAL7`>I/謼t Ft"Od!鰍7vGF A[C )f )Y>'ùCr2UJPv#U F+1RVt5,Vڧ̫dRBprpZSdS(&8`j""ڮF5N*=miˡu#Zܟg+5&5D?l:5W𪫸{K|lRf-.g,>5ŬnGuʊލLw[ZI!W!d:bZRlݥ.@.eҸd'B˯AVA ciG/~v4X }QQͻ̺=_F:ë+eO2բJB)iedtp1]*zKY `x)t[yt\/%gcJ[~rԞ5;P<3$fF5xy~ dZs)_I{Vd6Ѵ`"ƂWDq)&CW QCUpz_Xn5U{ՠSm*#xe[L=EN^LFp謼j%C_~9/ŀ,BrY} f@%IN(?=qY%Ya+k)%X ~0`x[/4O`Co01b\8p拖._Ubm_b*2VSBZg^;r31nDkǃaᥫ|FUӀ:w)qKҨ}H=Pc;=I8nal_f.,$--kFe)6~ [lfUmzrD1X2AJ;8XtWK%8;ID"-*]+ b,or_ \{?>z]6IkpfЉ$/1*ϦIfn؊QUO `m=u0]^}HLw8M rx-ߍTpsuM*.G/,SabweN`V4?yWh!%Zꅵe}~VSڎ/3P> AAkn@&V3zL,A_Ĥ ?m1HIp? %)J\k W;M~;۰NדN \.&, bh,(vj.0 Ye'؋e^_=1q *q- pmH]*,J4bH8$x*jBcUٵC~5IG 䒀IJ-@᱌#W:$}!wJx\%# MY!w1’9$)7!]:<ަuWusR34/,`Å `z5 ~eTzEz4f{50n7V%7KцowlPw!ymcNl邓 y;|S8u-m`uU%씚Ѷ%g9M-I[7X\~[f9➧Y d|L*%2E {o\aCK5.D(WHs46}Xl-Í64SFU&غTYiPM8PX$ia)Y3KzgqT6g[|R{gx4X\V9uSKc4Pߥz<%*z.ڤtTz^oBa᥃$qL@d{F2/^;rlXO>04 u]:~C< LгTK_!㞊@aS~0\-wBSrl·җq,D"-` Q\o~V5{#U(Hf1n'7MC)h\yoFN/2VN!ӕf&A3SZh*U LC˦Y 䯓śSD C;;Sukr*h8 2՛-LN ])Aa^[ /޾9+WٗQ ػ_ ߆$^\u\[%~j?'I,ibl2mUC[L󴛜cR %Wqaෂc2}@ =kDe9*vW2m$gB0->ʮ@]"TX[r,=Oi:kj+ $2dwM#~"*9yƄD:ɊL;aiU!hw]i 0uFٗ|ΔK [<Hbr9~O#VXo3u.Nif.o|d+ͅDW]6 ɹOc%T}³F[ 8|zǘl#`]p7*Rm,]H 4cKsf޼qKJi/, `T7il%Z ~YYoiT7YvS9aRE=!@ o ћ![i~_ɩPh+!Zn]Ez,"y `ٹ.ʢA<8Bnp&czX9Bբ7 Nޮb6j f"}ZajDfq%̲Kh /]/#ԓlZ`V ̞nz]ny8q`[_ ,8kmw/әbtN6S*7!U=C(3i95,}2kKr?. YĽdUB9Hf2m䭁߯\osv;u]L$#T愋5JHʓ4%׷oޭ6u?D;.I&!س(z'%Kvwȉ@vja3Y]ghZڳwpbY=~B95y'xz٣(Y閳_36 cP3/I G2n1SD۪\YeH8uvQm%0XMB"v"=Q26?Ǜvj:,CUy$FJHb]OY0BZ,%S̕à0w=Oy:s &f&3x,m=VB9u_ɻK'zʆ }l?R'tqfwj+Bz<&?"zN^l>^s8Qq}7fнΫ,ìOT#p&9$0@ٮO ,[z,g&xS(`|T~d*2LA0Sz](6ܨݩ?4R U+F*0N/ޗ6Y^Z؜VNw˰ml差6xֵ<3~#v֛UHC#L&4}}nqf+88Ig#Jhj9e@Yeن0?;Thn&}8x+]lWL|&__ j[3mA0 JB2XP.$og}]ZgE`hҌ]">Jrm?PHr"5Vm}]2˲#sz;?֡.}kX#95-7bo/0xpP;["qZ6uS!D[}@^-f*"-X #&%i@%= 7EIJ1ˣ.IOƁg* 2,'a endstream endobj 423 0 obj << /Length1 1490 /Length2 8262 /Length3 0 /Length 9277 /Filter /FlateDecode >> stream xڍwPڲ-'8ACp u`3;]'8-xnGrι5U3W]5:P+Ȫ)8y1up?~LW  _Y%'g A!eWGPGH-" t[8P( utg `xDDA.`%f 9>t@`?J0N\\0N ; h` 757e#oj];0쯀n<:@ w(4@_] l B,!`-h(r=Ko of vzi |d7?q9r.xkY#aO>'ߗuxcـ!6iX:qAή %1.lAp y~o~u<m@?0K7 ߁0yx` `C0] ~Q~<ߟLf 8x犹d_*M_A+ =.|%>>fAӳ"`{BXYL(]J7>~OM濫?):83?▎`Ͽu?q 5j kG }4?'7_~0LÁv/sC@P_)~|F`+d {9m?ֿW@`bxqLA @)Gξ pv\D\h/ /xhx\5<cG@WGbHyPX}]He4;8Q/h:W~{NVJg3Nu앯4 8hvli>BN𾠤,C-ZҋIׅ!im۫Èg.TAH9M4SR6j@wSyΚcl[t:+xxCK>E*m3(޿Zǹ)qO'R$%Qˣ&Ol>"5G3όK'mO.\ t LӅ۾_Vh>4Ir1:k9ǮN}j5ЈS?4KY'E#$#TT<9 bgHkkڤ^Βu ަ VH"ZbR"aYdBFvS YމKsƶ~8Ƴu^4s~[م#dC9'*Q/1T[nflf6CB1I7^1c SZ &?-MHBEj^} iz6nEkfSvsM hJ!8&IzNKh%]vǗ$~;9|# p!?>IAJ_ZS?$p& s/!R's0Zgb gL4Ƙ]ኖ8LRbLTzu6@| i_OEbL8{V?D^w[WY!6m-rXs{A")W(eQoy^S./h!n.M%{/DtQxI Fm A=Wh3کs/'yO ?,D! Tg olvX0K9"JF:'vOFYbGmኤ9nN7{WlmDЯxg&x#qB?$Z9# g2 L# X񚡖*f7[ >Pj%w(Z&am)22Gueְܓߗ.D՘ ƯSt&1-@$f**^ͩ?vK6d=z֝#8᮸Nv;RNu,J1D^Ŷ}zxzeH#Tާ6utH3G_)A Ѡ|8jg(NkA>zhgyFH\gB럭UlH.6KKu>"؀Z;kVFAf.(#K$IلOG1|+`{l73x,Eh¥>/&4P=qv5kt#NpJM 6AGݔ5?GG+9L_؍wZFu|u~ O $\2iw+ X3B`dǸ0WxڽV?子 {Mo: NŏĊ$DO=<}z;$@<3c k2NXgYڙRy+t>B;!(v'.|ZT%dJenm ^5"fr?g HRGVXem]5]8ޘS߫`l>)FRO*0i*Z.n.dt<`ɍFI]-$ q9:}25ɴŌg &EC}g8OlqФ^}Z{ea^}a(+AS(iR{w46uy6rQIsH0|wRwh=lq^PY}&ɑ>pQ.59(9ٻm[t _-$3=x#Oh|AԾL3(+r,JfCMc',Ln$/bE-ͬq1AZw3d,"UlENƞgg*uWngU 7d#3_G7uxr-n HG[?,hj{RoBZP |UE㛫>>.эJTRdǎ|]p=pਥ-շ&eBQֲe,Zo(z\%d=[*}}_h{aN7U0繨) u;O%'Of͘x6 =ITo؈@NXrLaiU gC s;ʏ ,wyRҠv)9W}LG-=ZRm&[ Vſ0}5?i.ssaK ĖdWW07#M6bf Mғ|mlqey7Sm.GhuR(0 ,!8}ґ Ħk΃mݾF;7I\B_W#X nwh*l!lC ҳxYksgʼnwN8A =*Cd;bTóĖ ^`Q&P_khj◗b) Iz\?!dVKBƷzyb : +^PBkdCSjZ()Emvwn`$Q :+Sl_&W"&7k= cs;N&A<0HbOmEnʮ@!g\;̈́&?P=aO$1C/#hh~$ʒTB؞{'Q~T ^ƃ`֗vrI*~6h\3!8/>9*f9gp9]NM-_:9;9^av>Q*X°~VV|y% fĔ6v`>/ftтbkE"/FLw,xX$1K7vVPmN=xϔRN['Dmw\Ԥa,ı̪˩l_R.IE46xb +FA;xY`0{׌> zw0s4B[΂(ч"~3Uw RN9!a!.xد},8$nG(ޡl'[S.RȬFBd4G|ra?ivNr v_MBa(yeF+B0QuLB'Wk*V3Kzbܯdg+Di& wYh->7ATj(LA$9%_S6턪pie&1*Q)\VBWXG܇ GڌFz=z-ɟoP˝|Tn6;}-3n:x}^_L-ߧnvM~.)* G~'mLlki@6oy!p}#2\P*(T\zno)`cSSO`\ NG]@-Hz=wϞyOT𓼣T$Bz2.}!%FgnջW$ |5DBPcîbvL3K 'l oTY?-yp2S+,QXÔRqlˆO<Mf}r,]m҃%]+ KQSI?Xw* ;nlN9re(_k*UvW`jx{B(tUM*u^Oc_GHׇ1^ehLlӊ`tNPUz0t}GL }$Q"Z0 yEzONynHcE?-SVU|=KD^jb')[}h_QeٰqpMC/o8LÙ@H h}E$Bp=ES<,bih['43^|FNI:8ֵ|e>8֦/zmHG˜ccRAoɘM푗{ RO$l⧶Mb~&#<0d_%JG}@qSh[p<gKYX-i[d7hTj ?f[ YGm\w+(F;jY;5/mw(C@>z掶Y$}LLuXrW-5?*O͢9c>XGwAQ9~Cdž~"QV|;!(bSOLaȆYmipԂ \{8G<)؟}|#A:ߚEzI+x0{ߩƱةTz0='B<"eM?_s;ŃoX/>a'`A xGi2>BhW呻2hRw1 l+5ٗcVp<C.ꍧM*_,l7̊Vhl-_Ï܃ĠnC/zqިVN̬}/i_],Z76Yj/1 %:./ gX~"B|v:Ȩ*EKj3a?cH#40Gup|47/xA]>CK۷8nWuVȼ)O9 _Y;6|:N,b>-0ibdVPǤipO~qEǰf_ ] ls-?6ꈦ Z*Ǿn[S'=<6yr58X|[l#͞9[HBMC}ݙ 6ou@)b:0ql+L@QA>%|Z)t_zt;^+,h! ݧX4nB W".J6fn 1c@/tq60U;/CoVIʝvp3a[_SQKeTGkTp /nb]t@<&U*qgx*mP&@|z7oey=AOO%6Yԗ*E+ b[|^:}634%lkaw\|i@e4D Jp33)7i^(㛘&<#ծ~(\ "ө[L9\5lbūjR{-mĬvU֖Tb:9XiDU{D{EEVbh):(c$BYbSTe'2M(j,-~Rچ[ vG= >cosFNfTAr̢rg](pU6O:ukjG!J]}ʆJYe@{Άj0[w͎p񂭝!61?I9vjfkϐК \/+ld9$X ̩'Jv5s452zBƱ$\X}d Cvs4pRnμw h c$&A'o zfq$>YxӊCXI0aWU]XmFՎM.ľͯ UoCf0ӓ8EMOrm&2]`B, b$0o(}Uw(w} ?8 0B7gDcR-k\#/]Hk\ $_c{=],TLjq,Sr> lCgViJqu8FO` "mߧ\3䑪*!m]Exi-ǿPԜEJv.ފ-د;ĝMFÑ8q 1Fش9uյ*- 4z&W}&ƪwK d-d{%.I's;3/pF/ % <#`#-s'ulL5;Zr8_rCהHwOͶ6ƒsB*r?)b:X9?ŽQwO$biiE*t*,ۏ,#x?T{NYU1T cq&j&h b$j8SD͋2;7Gb/w-;>|hac&yD㢯3N1 Xw,viv}ShEѤb؂DȢȢܷ3O+t:90!A비G\×yy!Qf"Y" ҩddGZ\9?ni<\]E =6ZN_P\M [i[<%3Q9PY$^δh><”P9 oGnFv{ÊM/> stream xڍP[-݃ w[p nA\|9UT<{u^{w$UQc57Jك\YXYY,,L,,l.@'gk{߿N@w;OsXXXXl,,CwHYr 321r3:Y&.V@Lljf@JA#`dbdd)Dpv|:܀?L)cB[Y;eWpq7q f@{+x_&Pv"+E`7V&;D֠?ML@ K-,0A4u7q351}'Y @JT`.oyfN.LֶHd#.K g?ꓰvo'_' dXX-avtJMy7!c8YXXy@G̊?z;;,E}-&n@+ߎFsk3)Ow3/~N=cϓ{{ۃl=ybڲrZ)OL`dddF2+ U6On7A \J] ,,foϭg_ )W[?4?n;k[Ͽ M>cT-_C4v^YAYg=*.fVu_v?TwZ0򽏖٧%t'翗ٛ1bl\''OC~GoY4zf&{]/ f0a xX* N?蝩 `6LAf?42 lf?h/{f@<6? n/^?}}Y~^?Xd p!>'wiyw:_I._9]Ÿދ|_]ן]˟W{!,ۛԇt׊3BB[t+2ҋ#Is#L}ޖlqzaq gpXFu}GO(]yPT 0= p#>dш:Ko=GHGq:{s;;F"@{^쭻0V܍OGy1>M-v*]Z:*PL̐ʈtȖYc1 W6ź&M+k2r"SƮi7tc$:[챰I`Y8qmdt.,~ytWKwV:I+L4r n-,ò[ 3IwЅ#v .t3v;+KFA5ǡj >Lt<3JPR/) ,,J|i`TCB[_$7iּx%#TS/ [9C:6Cm[i@Eq!Hjٲ.ڰ.svq2<%F΂%DPTFPL6c-H"X_u#Z!߭N!! ~j+%t*h0#׺r>9taA N/'z؟4"T;= lG`k>.# d>i#_:5(j R09r0>onx:@ͩy9¤(QKw2)8  @{U?YY|ڏ~74?,fXlT56f  _q At]xp] Lˀ-"s:ɻ?ehA[g4ȸTOzϿSo8okPp#4m+{p,eRQA1Wr<͛k/y^8AƎ/xSGiUmItN'1 JߕM}R ϛ/5d(HtYοUlZt XA)0X3Y]+(,.iyT`9OC^{=؟\,+RьO@p];.JЌ ȠԨ4ahuCKF8cکRys.`S*IMB PwU0K~X5|j$](:_X߂%iXGa:BĖ %Rn=Aw$-*&i8' FMyw(Ta#@M Wȥ*.\4RGT8^>}+&2U351Ka4Ӥc:)'HgefuJgr)͊%kZN2Ŗe `XW3mV(za V:{A~jN&E鲹)~b^PeӸ:`8Q"k4Y B}#26h;NALBS55ҪmRk3j/ӻR^C;f`"j2TogP@7f`Tͺr+*QROώz3Bs I[c%C;deUӰ$Z/Ϸ-:1 6C2]eF&bI\'l˵#P,P[ r \$UegT60bEk7(\85%_1^x۬BUQo֑5<̨x'H|-1pXqvY#R*eU+c=g˚\#} CxK5e^rh MP9HJq GpQ/b+8'4SFW2NmykosL,Ɠ2@I}]ZxSK.q=zgAFd5>b2SG̛7!;& ^%[g<$$yoUvGM5ҮFҙK%O.ѳ1X@FOB0喼VD" JsVC:9-e Av ]}C H/.fٜc1 I阱<vͤhj{Wo|"~z|6ŮHRr6GPp',M[ rnF_+n/mLxvΗJ]'X_6/ ]E |*OHW#2 Ϙs1!&DڷT0 =y*@  wCF-Jňj99%q`T.|-o,0n(5N-8[>\.6>h.{EutT"~k=$Ǟ >f|/ xt>LGϵ)Ga7am6xR̅ Þ)G}}+?)ntP|D[i(7ّDGf6Ł罒O׉eYӐo/OK%ڒ'_Sц~mvOɭqt/}8mLDsIPb?{k;2MR[gj7_3&oOp5p+_6 [FnP+t+B$\D"B6ZVƻBo #o~[SM 96mTNøâÇx/_ U|#f:og$5H=&A@"wBqzSxB>lAK~E6Wnc~B",4vE䤹؋aP !D; 6Ӿ M JAӺ,RNIGRfvz[XTdQ7"vK@%mզS{K/g ~5b97/&=e~!pcv3e:=)z]=]?. O:9S5Aou]@GT-fR'o}p7oGkeZp0+4thwCZ褝PC,%R>b0*\4~QsYqBc@_F8%Kd<D<#šVڞJDh4up?N#㒿dT{pkOuvFF0$ 2>oR`\Q oCZn/y8OY?Z"uJyr\ ~nTt;+}yl_Ud>UE Bzv(jHP{ X*O:> FߢՃׂ@>FCFtOQ?x8J)TvՀĢ'x *h{a<`aJG i : x,)M _JoO>|S\ZYUr Do~ H7U[y?*>=kUF]thR_:>^%O+8=J%?.a<현fP sHkJ wqM5;mԢ9rTIszN$oL% X}Sy8KʼL;p7 %ܻ<>?GC~G2J_vOFrՙ5̖ Ij|~Qn#X1DpO`rmL qTKa-腛+۪U&91aޞQvE ڟ|uF|&D@&ln_b%$^|Cc{"6wtybs [-dwN_LThGdr=*{OR_=O4t٢El|2a^saWj{B_ȟ9dEq9XnAn}Q#&\`$׶ zz'& ,g tOD:%PwLl&?Ns<,5&0*2v8!D rP%>&T$®fƤ`6%n؜OaHȤ.lQ gdb[+V~Otf9!vL4E/?tdexv__+~㎵) n}xaŜ0ls?h~0'<&y((B5"=TE SyBW7cG;׵gD8(Fr"ed\.ú`u p%BH R/I5pt7e$bT& =}>yiXsqo{x}>} a/F7bk&i& QYs3wxE#x6aW9FCO Jٮ .:Lɟ2|+3_s7wuM r aLo|EcѶTI )䐦 ee7<Fx\2Uom5 L_LٴlT~ha;+B>M'C B ~)<%T](2PڧfT||ۙUzȶv "Ovx%WI{AM͊ʘMj 6T B9Q` n#}-L4?$H&kXf sMnc9j[kyyU톌gk萙~2v1$\${Uy G6ΒB;*ة *2}Qa$ ˋNW%A w\P5mYw5mJ_|wS"(vmT|(vA6Iføqѥ Q8`6]dLM6_TI_fUAI;i~J^j ;%oXNcFД$IQwng-|'Χ-<efj ~:RM-<g}:2{i-~1sDi$q-b,YgŠ!yE8n皏ud8u[5ՈuЅVrC Ȧ5wZYnŷv=b8t+f{HD&/l\7f9`a+#72V ) m\l'A.btE_X e܉1P5Or'hY}?<ֹ J+cl ׵ʺ`\SE|ht;fV} 2&[&]E qB -bcDZ.2򩕼$(xB [պ`Gng:NXpwq7\n9gg]DJ7_>(vmXɫ38Ң} E# :zAXp&Cs\=In "'y+pFUVm~Rb(w̔Y_ջ[FKc'31jDY(^*HrfB",ے)E)c7Idx!2wCh6o$H3c"n- e<0pm4,ގ#"0 HY K׳`L*8!;4,MC r of׾_֌Mѣl(C Gz*uI lJ>tޥ{mӄꊯ%%C٣sa)S~M;>JccBbXJloc@k 4}gM#탦7T*/x̱6W-8QQ636lj)rnANb97tI/>WI-ٍ܈mϖ.Qѭ#˷~ 7 sۋF/) WK'y+ȇ/Su_OĊՊQ G$ٙ|n$鼄($ؼ$0W@>Lw.4pA0u'ձ N-51[^S>=M;cBJᏯDk_oK>1a]+W>:7P{J87F߃-~eFa>O^ 9Cml,;8t4O~U0]1BD_܀dyԼ4Ք4C1*Q~DLr桫eJ۠hSucHT}io[Gtn!!aOq7\!I3mptե7K~a!Jн+`a+VaDJ6}Șci;fAxl8٨ ɘN7fbbzåKPd^6@\:eэY#+A";}vo;=c}e@2 @n_SU:N"G#tdo` GѵՠV,5Q8}* 0tJ>s^͠ /:',gي?=8B% TO i|Rϐ.s/CM*UHzGt*B)VtC1I(!gsbr*^)zo,vaHӆd*lyPx>4M%gz`7rZ0EǣDz6^'$#  !ʌWSj,̜}:yBlbY}S.hLG:fB0oXE@!RQonDJxlөԙWD-K:v/<\h~v7q KPdY8no. ͩoyu=;AtJ++HV3 -J>NUk 7-\$ 8_;ꇩ7~ *W.=~AvEͻ~x9]vE5Nbg9AI"_%!>C{䷒Z'Swd7\-^R$E,ǒt'qR>ss=k"f-bx?v0+FWr綮Evٚ*s&G+9Ңg/5i"3r@W=[cӝ%A~hn#h8$+OUfnu-L*Cֽ pucaH_!@q+r`<~XJxL66};8w.q?MQM8O6O}MÁ ĺv[ǶTѣ=+C{RdE*ۑ-xZȟ-eړ0ia~?,^;xLSpŀ5a油t]Uշ0V'4є#)qQ=D"䍊g~؊|mv9Z75Mْ[; YR—0ӿb࢑8˥]vVʸwB!?!\bwDt[ˣKYg? WbT#6SfvcE&݇1 2,$j%EV], jܹ6eXRJcɃ9ҤˤCi]C.L5Sd|J Jny^W{m4֮_CsSTqd`t όvRXH le09O5 Edrr$lS 0"5RW|E(Y![?_~+xzK )1ʏ3ݠ`.J` RVdGLKj1gE' :ܥ )InvVwH?!}o.|@S<;D:Z]}jm|;B*YE?\a3VOG!ȷ$` dn kb b+ VM9!X9Ӎ ;(%#_LK? 3^nL(s( ɯǒ)Ị)rYAl/_`B}3i ;8uK{RqZ`S>'a̸r v|lTӡW_\l#10c2%YUFP #B o_qޏfʾN&fq9*>2{yu٠,Yև՞F]#U9o"3,E/$la,e+ Bpf@e&v1[ V۽$l֎㔙lt?Ry&M" QM=gP:k6)ԙZZo<# {HN(cgD* !5 Fs6" jos;դPjBb,rKXdEsLغ4Ta|Ɠ9{Z<.,L\ U§ i=0q1ѽzbHìt7aԚ4F$JF3ǭrIk͚9the>ns52F'~N C0-oE8A!{;0FNJ)nY;XZgU6C4Cʦ)%k6TWJK5Z!di 0͘jEaə̖%,gIS+በt~sSy"xX n˄Z7qʗ2K/6\g`Susz9n͓mgQu+ 1ZūOgqj¶t2$`ӂjhK4.n.^}Rnd̗4B~wEmU,͂Gl̃W(ӟ@N "g(o<:Z& ڐc/ҋeG&h. /FA D>Ʞ}9 :i&p[e pQ,٬*}FL"۳9t~Y+v!m\ׯD0{f };:dE -K'B]*),+YcF"t/h‰sT՞uMuV&} (_D:-!X3ڧSO66!b0j>R&Pp }9Ppyv3o H5Fd OXa[6rb~KT\&'Gլ__T)PôQJU:1)z.wq5K*AC${m3Fۅ%`R1HipKS #B{yўp )_53`єi4rC"(yөhչ^SHOdG6P:/@K(<i4S4AK\bDS[O,%gq.~"jԅ[8 -|e|vnj6zrQJ ĸQkO-ݴ0 Bv=;=Vf6"%ZOAx*3%|Sұ=j5q}"jh's"b8G/&]㜗c,s)?_guZVNH;j;֕CƌͦcO<9}gTkV[<['h*D9DS-_ *&e ZqagTts@XN.>@ 胒*|?ghZ]B K#-&LG|nFð-OSf 8!kWZZf'/ }ķ/(i89$QWpj )_rn'W |fΠoK2:Rqt%SL079n׶DWUG6zgk%z1ΛKIJ.O|*ɯ zE,$uJbUGUu5S[&H Ǥ0<,?sq_@=0A\Ye]ls5_/.HqviVI`D_=8X8~VCkf%Y;ᄶO'̟bAþ [ 2GLQW6a DQ+hutsk클M_/dKzV 4p 66gB3҉*kl+kEvOG떪cպtLqh$ntեduDeȰ]kJ`P_ HPano$-P vCMoq$]fEK2ۓ޾ s%  HBzLIdaM u۹1,#C!YNJK$%&"u%YĨZ"eLwKhQAZLl'r!\bq}ANS>2A5faͨt=*,5%UyUyG Yi[n"qa"!zar ('xu,C{˹-G_7rgyY%BIÈ`/WG OORd奲I01qȰݵl[C QU?f endstream endobj 427 0 obj << /Length1 2654 /Length2 20437 /Length3 0 /Length 21937 /Filter /FlateDecode >> stream xڌP\ и{.qwww'w! wvf2{UUkvMA lbguf`ad)Y)(T-)ԁNv8 A2QCg-@`eef23Α jjacH)D=-̝Ai@mL` lt06:m@ *v@g7wvebrssc4qbs4Y8N@GW wyCߕ1ST-ؙ:: 1 bktTd @ۿe6 #˿/gCcc;{C[ [35 .L05mhhd7t564 .0OyNƎNNֿKde1[;o~@cP=?w&.Lj.@)L@"W:LëzR*񲷳XAཛྷ ]gGן"x3hfa $Awph3vO2x5kL**b_v/6v+  oECX0Jٚx& 3nXv_w\oGKH/5_?uq lX_!mͬm;De[Ȭ-lvN*f]ȿT@7 c::z3:E_; `bs@LO$[70E\&W `}E<&3I$^+I^;Iȼ"W"@\_¿E("W@\T_+qQE .E|h"+"3-$%66U׀T.h _tu6r76#2kcd -H¯7t}%[㷹@f@PW젱{؛m jY? Tjkd- Ѓj{%rTnbmzڽN{k?$+b 41O Г_p=?`~ͫWvp@/ cazz=09;XcPppU*@P<_Ɂ"yNG#h\A?4@;~qΘ/ز>Vߍa4ŮGE.Ȱ)45Y뎷)#oWŨo-?{5†')u~OP_(:n #`P}`-MX~/0P<:W)T!F-Z'd"({ƙ -ڹ;4Z/b:x1l^ZN=Z87hcS^RJf>o$XP{+;^QRLR0AbHEEK&ڔ$°gHK]r9+$ZRjPFyKYIl@lF@^k63d:ʃl F,-pUdd}XjB{65q`޸ x ESSAm{J(~VC6-O>4^ YJVF^["n1MfAǀ}6FZ/ᚪ<,"8Iظ؇q,M^5MЂ+ޫ3Bf~r3(Z9 gz<}/%2ާ"Kasb9?:!?[2륹+ PiDtZ"zh(8Bm@` [X'b PQԳVnxel?o3v2b1 :|D#h;qr5CϦ2b]!6-K@uMFŒp'/Z6QQŶ](s:'cJT51M2HKⴹ??jQGKm ц23LH64Tq^s(wOoac,.*&t:a+/3Jc[|ArƵ++_&/F ssA {J4 bXb5hdUa*w$DC3OSz;-0q7(O L:Z=bzR9 5%^.2*x9Pp+ط- KcEv?LG%FZD3Y  }yr]%:sg{)z| U*FfY=7zʔ/awڱBM3beHI0 >/`'j?H?-VN+,3bs%<6M$AYKU7۲)4FIBZ T蝙8GVxzyzo3y'6zdn<ֆuƖu7P+y|E6!e!~%ֵtl`}±thXExGE:&c+bR[qws I2%)/ItptUM5aӋxӮECWFG ɫ NjPVAyP@~|sR᝜md7  !<%nk7 63BNbQ;q6g$ͫέ"sQxTo,ͱʕȾс'*41ܽ ڟΝaomG~56L^pVN8όKJ)&7 ';h͑8{)*Zj"kה=.Fp jpbb7I_e5 Gq1i :?cTZB Uӹ-s o~~GE'/< 9VC傘VdnB_6'=o:7ec.:M뽊L链ԥ[hN)vcuȬC["r6`Vo*~egE}mN=xyKE+=6638f4j (aaʵK)Ќs7/uTD~, hgnG$ 2[}{΂eWF]>.O͎@ nMy{Tv5']#>pY;&ʥ1{tÅ7(ۓ,Cɗ; 0=)bbBoq1Eӆҹ ɡj\aB(!VsjٚLi'R,ƦߕHcE_(#BA./խJDTHk>$ o}17#vsÍ$MfEsOo7Ǎ`?].'h j]4w&~Qa.68svh#GTeə|ThprLjbnx5hR]fqE1Utae ~OlXC$D[C*Y^s`0ʑ7K5vY8r=`۷kJK. !*Ŷ3罇C yyԑ e_׶ {¤ G;)_AX$+?P XcRc? KyڅGǽ5|hd[.9.cb1^[~nzrc5'Q>_RV{a7cHf]jOvϑt Jj`.-Ҝi+ca6k; 7} 1t+E|VYWfo0)!u\RџL0'E$]?ly&ObHXƇZd-Q G,+ <ꆚȾwiv8<@ E9Ra8q.y'c1;ӚՇ ֵڢ^9|)P tȩqb-'uaV/EI+,/j(4Bc&,R`^"IvH͍XJ!&̹#9RlP]VYZW>p: FŞޙcRr5cKziY nմr( qW,-„v ߛf*ڑ$kd7G7b? N'><,'{v?ܹ@G]c: J ya\JPEPCmuf@ w+-A+~|szPh/( Uq]i{WT"N9/mwڴS v+Mpd.7dا]DK/+ Rhos?GY,g{BLE7B>4U3u /_^ٴ×jw^.Q 8.u-|cdǼ Ήg/X52lԻJ@ @+]e]wJ-0l0I5)SPmDoаN Hi:t PF%30x(XcEDR j5ā盦#=_0R "M#MoXj *WߒLOYmaXʽtyZ?b)^%HC}/| $;FWyS2]C]eqnCɀt7he*)KIWz9%`qJsof)Df^фfX{,4 J_4IB-uJ=p/&20+|1+8'M#Ji-y@Q|}bsBobs}AQ2ӂtAtJ1נc'Ϟj nL$d0xBNHNO ).a.QVs3!GpWŜPS00^"9$\ 6ٲPl=d6;k /8nn .CV`Ƒ gTJ:pײM]|ͼ.b Pɀ~G92AJ'Hc=@~~Ӱ94:nնc^L4@đuw[(l&|H,n/%lHr4TFJ{"ZSlG9n ɊeQkɴ}6t˳*>{9_B;C[Đ[92>n #-u!/i9iN!͓`pð]OQI~-磵7"Tv=115nHi'ؑ: M!ŝ.4D&HZ%)-]R[cxuZ箤)#_.墴ϒ$-oh2~' i0 !~/+K}yq|y ;u'nJE *5d|IT`u7+.90E[Z+zS3j`(Oz̦̑0֘N':){CEB-:o]A-3"zO[z=C".,?t롓^9[^${W,-l\4C#$_F':1NPxITI:\5 hIkč%.n1b+E0piu(uQ4_ (07[䘡Ab}~5m V8IvWyw@%G/yxȗT9w)%rLCB{UL%' 'oibh3ǕGEsxA .,ծM25&[i69ҳnѪp g怖76fRSGSKh?受+VUܻSM787XPpiUA ,B1H\t[DVpu>_^cxΆ]=`;P[q9$iSo  e4y[t&L2.4=kbb"|%  .ZȋpAcTLXaݼ(}!FN&9{ޝV`[ތ`q2}a3gQ2'Йlě=cbȠRa6yO27 'fO4*,]VᎼjfU&mP ?R zI^xm< Dv'ywv!.qfL/YDHbk׽9 ְu}Pi,{6PwsD݋wt0imt%}֨>9(ܝ˲m V?7buM@. Ca'Q%}7Rhߔc%RVӃq|Y!'mw@˖HK!hXBg|F4hRXYb}jv>ߨzO&$hrC` %#޼)\>.[ AQYrJ#Q69&υ]Dݤ7/`fUH^7z nҞ@[M}CV:uäb;bץڏ[t(;vǑ-l낟L!jʎJL]YpB3\5/I9~p2j20w~o?mgdjxm`7|dRbP<ЉS5|Zb^@F .*;Um:9o6o飌[rsHjv?Ŏg'+li$E.՝$co _l8]S*-5]6 x2ޕ#yAFabii |o%LB$~'yh%gvSkT+ Y;F1T!/} LO'k./ Bݲmm3VDk*ɇvV?=+.]]O:8|H)BG:Ulđ`m&h_Õדp'ֶ&g_W6cby|%SzגN'^_:QS/$]_v'ĽJ" 8qAZ5%.T(/ du>$!'4eKvv"8CͲʷkEEj|82;Jh"7c;CHN]3UlDCj,szp3!o }"?~cPcGoN[*u? }*HY1k:x"6gZ\[7k&. OeTS8ֻ0q,MAMK'cy;Di/ץ@UjXܶ[\{\ jumI."EusXmbfZO5'񢴴w9zmFT;NLZHoM+ ie̹K[\Ckq-ݕjɷm\'* |rє`-D9 F3̂ *-}wNXmeq??cq?aezuR㷊1-2Lڻ]͆x n=(h1ZN `ዚ;³Q '* zc~im &k 5}Dx57otN4҉Ij!nFJjq(VRpXܵ%(!cٿ*hvtV-6>|5nq 0$/ݛJ̲'Tu猷t>u՘<"smY+Lf#8`6F0ֲPhߧ|Z`$x#]28م:p8DXJU(BeF AUGUpiPM+ _4v6%O$Xf7N~ȝBš)tږ^DgHYkBMV! Рڋt3E)c[l;8Qa^;sK*-y,kF59):s h(Mx_zc9=a";EQy fn4Cz!IByUܜcP:/nZ [q/#`,myBX헬A4.Y$S i)OJl"_Ů8p) mxx wy*Bؓ:p_E[jꪽPOf<Mp1anZV#Dǜsޅ:J w{w׵tk^'y{Uuܲ~rfYrXXd!,|턘'\&?iV4] iv j?DJd恆]l@c A= /Be$(8>}M:ˆE<^àFb)dM'V O @Uk̹a.ȳ##|5]v2WpN3oe͙vpMACPS07o K׃[K ĕB@?:JJN-r6i&+FXݘ2 3C$GC DP9Xb:;Dؖͯe3\]uˇ &jQ?'pdyp<5\w~Jkr9Κ0."#kZ y\m'<&뵏Խ ): pY=WElӿiyvsf}}JBj=eUX$owJ._3%RsG|uf%E1RJy!b{3O,bՉ\Z%lY~9x`d0MvTUM0ӵ}-~ʚveuoW#KL rbmS0ȧw2?\|pB esڭsDqjsWr9T=/sp`o ǘΪҚIc7E:دA9~R8}KsR,aWzݓ3FDMMe>l`iR2F ^cޱo&0gM LpʏJĘFSH-Ω=!xs;DR~o;QB&F/dE$5%ٽRmInxF@X_Fwr.-vJv5:6}ʕy. v3axřb<:F^1p C243.(mf n΀w ١;w|hOl=&`C.DEg[HTIcFcg>jDZbBboN3na/QЧ35عD7ξţ$ hV&7!>s1_AAd#aΔa[,V{G%TIUWM\6dJ`$uyd@7}3u(A!V^E M@y`4ֆѐ_HK77[D9<~v(.ƏA_UHj⃡ߓ,NPs Y&e[oG[;Zc,;]PrIfҶ}ڡ~Fqw(BeX-#{n=I@׏w@dDwk?N=Jׂ7x: Y/5ҹQ>ZLM"UHӢKor~([-n$6H9PΦOF+6=ݦz`\%7R(7]_R*&ޖؕZjqCELQ%"œ'!뽬adw)4arm1K`vhR:_{`'"g;%wR 1A(`%qn#1c\hJ`$#U&,$_N ' ;pZcC͑W9EMzknK>uy|8X n2s軬'wlROpSw#!b< y 7Yk@wn=z1cST,QRsl;içWbX6~v޳0gMG%x/^hW٨& bU%jlLh8bCPv/;OS] aF?d͚"@:P]h *l@JD 3 r +D1[:ݸ;lڅ鯁=‹w<,m@mg[TBf)dTƷHn>G {<=mu=i(R1;T+΢mbm^8ñ,(-_Ztމ[SX{``VU{cq]?U[FZI4%g(#{qGԠ%S.D .O0%mO(J;t Ʃbm%[ޕIG Lt'c*n`BfŶ~B^[}U{` WòWaXf&_-mP ~| L!W{.XVmrY\u3 A*yN'4 !Z^m(Yb1w au.[(l!kCf8Q;DJIsX|FXg)Eh.G]Cw  =,:|Kʛzw]ޯi4gi_vdYk,_{9 `w}6M .;ym*pL/@W BȾw΅'[RCL++vh@uGG2$T9/#ccEJ̣tF=k[G]=o jf,XU`AzP0&9 (ċc]!O378^8R.1Jy%mY*܃&U!H#y曂y%"7_~xud1$}^حh*"]\R_C]>Z!~I"hȤ [vDq?w} Z*jl*(3Ul%f9aRnIRh;)Quhdkm}vjzx~Dyp5Kڤ)>qFmDc2]`L E>b~Y*s-GGj\XH_vc_.g4A:0VPM"$ELz.aXBq#JCw%}VUӟ 30!(1JӪ,=p2Bywش5jI<{&C6~V*,ma(8Z~'6880>.%1 e%n#}8=&H 6(zzM8 x˭`Ww# sE8޶҅m'hۘm8R'4!r /G덇F&a:{ܹY }I($q܄Rvܑx|(g8E.Ļ7sh R/ Vl\ջ*}J!h:ս: ޢ)9sP3XQTLm̚3ђ|YM9 ǯ9Y:<ә%](^ZUEN~d?q|D7ݪ#k$cIpk\+l7!ἴ'|c #$L{h?.%Z|쌧lS^J;7qz>JXO4–jp|18{O*WJ ;*6Dv}Ycdfr]屉~Dq a;O`REN5CqGd((d]EV3"1/  ?2R]*#kS|81৽8 8?T-[Q:ɳ#o|7fHw >|EUw &`۵tt+?w-&\}-J8 ڴy9_NH8g6;VCBI^.1SOsOKP%`E>t|Yf񏧔1{< [k29}qzeEBZ bbZKx$N^Fa[-Xu̱ Qmty B ". =*fR}E݂4/Q͎47"*Q|q8kVy2C{IgȍpX옷KWN,Zoօj y}DDLo A&.9:p|@KM[`0].>>>rc^R*JBxGbsJ/ 5nAzݓU^F)c\˺b1բtd(-y7lMZݭR)&|jG We! FAPӐyS$-hJ\chRR ۨ]LMIRc-T +:E }˖ɨ0!6!x|VIU4-=D lAWFp!Tn]hzB@/spl6qxGJ#8A8(xT=XVYryr$Ǵy4̀kW!SJ-N`KrHR_i8LvV [VZ0^bfcy6G]$]@ֹ(7NFOi?DEbX`DWùFj>sv/!anEOvICnFDx5B.?,c[E ~?I(9F5" ^,7HIB"ZWRꙥOZgOLXi>A}:v0kPrlĦy]bٹzOД8>$lE{ߦ~/jYݮcN xEXN̑Ε4.c6+0^]ZC,𘦢ǃ_ŋ,dRVOih}i!kjai{˽NR}(Fm!ɀSU^NX).UyḊiړ Ȣw;'D+爦[\NH(|Adcq-w1= Zhyըn%)m8_'v$?IK %[ؾH Ŷ {ӳ]P sGy1Qnyt [v7.ѥ|mˈ⾠Hː_r׽Y~XXj,Pq¤xډƶ(m o,/@[5/b,K!Z"fɚ3۳ ERjb;-8";6 WsKa]Qvڗھ x),9&ݢ G?*bs4WiK%1٠zq+On)I9(˺H&trg6?<6;t$J km2Kk {$PuZ:e9Û47e/n='jPۚ9 LS;]A6/v;+s ؆t4GYڧ?e 3,4y"K7,r瓴ug6ըW%+vA( P#lUS; &jޅ{ CͰ$mZ}bW-pqחB&/>Si#tQn֓ {`a :BgGТB ޖ_-~_4kI6OU`jy.m95'̞KZRwU#k{:/ch~vgG!qSu+E 95yzݙGkpYgbmMhj)}~4* 6<ډ(&fTA32,Sxr$L.JU#/3NdJuIDE?뻋mhBxl>Bu^:Iz٧)N9#т`(-+dö vHˣǖg9KZ lu>aӷIti%!@Wʍt>֓M4Xު%J.9㤼bHd ^&%Tؔ6<8 Oc :٘U'`7g#LI5bq.$^G3 ٘6bL`*޵; 6'V-j$/<cfeĚNpjgGJ# B 2=䔔/#Uv=rМ$z|ap{bێɭ_ O!+5[>FՑeԇw`(_Ts pjWkĢV2!|F'cz?\h" ҰeQة{w?QMVr/o%ϐ+}Gv$qY:d E<L94#X"A32#'lfM;\g,ҼVP<ߝ@1 <6 1GF ^̈5lвd%I9uAMq=uu+2k39|Plv~ѵ܎eݴ:5o$<pLL 8p*dV֎WBn92|o+r,яžJI  !xl7k"akN\*%񧡦o,"N|aZ{? wsKRW&9GGg4u<}9tŴ+; _ebA5x" }B+r`}y \R7AStAwoX+P~kGR)8Oz^4}5q*T&is'qfhr͌q1=g>v3o!9}u O{E56 0fY7 k3pu]~~҅)EthbPuD[MG-ޡTx_ &>uShAaTߔBq!mB't $.sUXFEח:8薻竂 a)2a?#_Mv~e꾐(e.nظ m.QӂK1KOd4Z&SIHCI鋑5ON]<@ʹ 06@9W"P]}7|>~iٍ.EjwvZ @_`baė U-6-?2ZeE&vQBO 9Gka+-n}c߮y%X:jQl~=\ '^eʰ=%A)Ni_s1L.]ӭ6\)6B$Z^vSc5Q(̅Ѵ $'_ے *U&8ʳ\H$VI6tGsb8M k\w>&2m5U(7w} 8a-%uƻֲo|9kBJH[!&L=1 i0!x!Qgw^ ieH 4WCK` endstream endobj 429 0 obj << /Length1 1555 /Length2 8332 /Length3 0 /Length 9355 /Filter /FlateDecode >> stream xڍP\.C`ܝ2 3wMpN!@pw .! $sjW_׽VzPR`!`Wfv6~:;ZjˌB tvA H8\mf<% f`ggcpqH,J,yB-qrY۸>/O=w8@ 0\m+Z4  ׿R ڸ:zxx9@ W:*lS 5@Ǯr0s 9 l tqq'p|E .[A|6ܥlk6Υ y-@ ٸ,;O࿲4v@^5%3J@Kz\͞@ lm6\A@KUk2{ qUll{, Y]R` ~ 0sv6Ba{77y-5 `eC\C (N5/U7EcrXN@6n+^6+ |N`u|N7xN/n7o>7?5z-P !5!m7Ub;cB;:iދnw9_%vc-oI].?z7!$<īO,L"0k~ytm,OƋ{#Y[u$lnGۧ Sob f̳f )\IpN<1g.qrƟQ|r~_xw;f\åHgd[{Yb)N_ 5)a%R.潺/3(4;r=xuh8:#M 6MJW>ZQe ']SUd{/6yYu4^𴫇yr^ iGWZm$A{gu]5 wnu(|Uc?[ 2oվo+ن{%F0,j,XBu+.B~h-#[1.Anq~.9OVpi3UR~uQ|_fƓ@6(tWoKha^l UXa9R(<!(n~G#[1 P$Y opE\nǛv榧dCZu(mB(ϛ?ުmc=)*վD1Io⫆nrKt{+X's5\D,Y|֬;&91-B]ͪԾ} UM9b#S$h~reiz^TVYl+Z`(|)!MH^5uѠZȾaNcߣ^~Ό# gT3=U7lI*[w pU0U[+f<`+xDsbWJm(t NlϋP IZK 쬂7 ;O9MJGẊ[%i+yҠD%n ¤v[ P[q21_#8r섐(N Ecyǎk-|Za)ر|̗39_H ;\t=GI{ѩ9,E[E Rf-kxԨrj8,mB֪ ˓O"D :?SO$~<,Eُ}x6Rd~,*Bĸ^9 0vM[(SK~ UwD^3/rlx-[-O?$po&8Il@Dk.qFKݿj .Dbz]0i60(z,G'1ǛrJ4?CJ,yRqbcPwrz^nR}˕HzbR;֒'9)fbDT:me2YTytjSpPV5;o.2,F$Zđ X%mqTD^eBp?u9y3\ɶ/@Ɨph}Eڙo1bIK\2z[̾n`ٹMd%׵Yۗ0#AlYF4D)I!~cSzDʲIitZxy8$I];y%wZ2 9Q%ˏ"{"& olGu#@ 2G/["@-m'ivZup8$w[gL3+&6q*|J=2>X"6>0~׭*⻥|=!\JhRS+QʟV|y6$Km˃—F؁>zCz~xl(,Ϫd^Q%k8IEIp Hbu=(/3c$4Z:[.wB0 L Qⲵh$1Tu5qn6(^pXVpW;l!﹌9ـLmmDo^vA^H p۫Dh"e} vSq%+Qtrox ] >'J"DZo@q;ɱY`W^s$fQ+l 0=B@ `P~_< !R߼H'E]o)-(اҧ Gm\8b70kjK|$f&{6%Ha2l,Ǵ;K9'VVc37 )ds^Ǔ̀%{:MIjrֱjأӾ9IVX9o‡nhEXkΜZV8?2t}*h[7,o15卡oVlvݙl}7WH@,^10%& zƜ^}kDy~/? Fw<%M<SڥK6ݖRɿ:'{epJXa qyiYW0tTc2(i k'ZOc9@C?_(k;,.^:[ێa')+W@/UT&"a]1}H T- |ג+N{Od"vt-MrCn!FI*jY\g|8 /N)isAtF@k,X3s틭pU겨H`ߘi$VZ|5955KwO 0n/@M'PCk=njdP=+)7ɪ9~X;̜;wL՚ۻq ++}@ 6MDnj LX_H~wVXN#nGg)ŝ;:%Ӽ=X -|~w\N%i^vVDK A~ٟ^8vu Rmt;E_0`J? b)9z})ڟAg AWzwޝbR9nãڴ$Rfx2fVÍe㨚$P%m_$$otT($HdFi@Ԫ`GT' x`l7Nj4нZ6FqL.E(YBZ[* wV:OFxDq!Dx搤S^rr!~U:_pHIvɻfY'I `1hCQ+YCϣ=W;>|w+5v)7I0\!'qXBjX+pHw!=Bq DS7b-.~S/;ᅰɯY1 PwmTIK.DV+oB>It,_! '+ _hd+"˗K>n*ϓv+D9cMQˀG3qmgHlh)IB$j`fR t?E5g2,X":aoNmwcZ:׼eSL0Xje~Vgtѽ:lGZE)'M][B{w\SȞq8*L\ j'BbHӆs~~Ǫg<SYJuo}4&Gt4Y#xq*ӧ@iXe[;Rv^r+ֵ4#9mddLa"N J(a+:,-ȋ`Iikm'&(" V1ĩ~s=I ^cO|Tw!黨l[zB]c )8gU|܈N<>C,2i0΢& U˃q!C\^l"hGVԶwT#zT*1~>[7.; VP&)jE}d5_I7 \+0>kVGiYɳS v"Z,d5=EB|<ђSX$W9W5Ҏ)h.?­Ba $4R?綼T`Kjjx&Egz 1ec=htAZr4+SF7= 4#+xʀU!_s/"%{HONC}qk^V AT Q/lLZi͓5$^ Vў.iXl2_VEH0uk (3,v19^1]C}ELg\Ǜs{]a .<Gf3]0)wy(B9DÜ]/}jѕ(~cX5m:sZKkhՏT {3FExWJ"E ",f 'j03cDr@fb%4Oë}uE;^ta ț0.Dsg [qC" sghyL >M6`,$ +l-u:"BOj0Jnl CRՂ1*h:Q>-%G|D<ruZ?hM``rD,/$];rs`aMe;]O8(p0]a9@ۏ40IG:G2~٦ LLpDbwi`(lr_%t=u\2xTC1ǿ[*DlԺh,MO E:ŝ9>[ LE>B?qսYqnCXmh9i eAT& 16JGM7h-XVXGL:Q\hU̾)YJu [QU،x JNdž?6IhL)gcB0l!*Q O uA΃>?̜Rd8Փd_RXC0\(Y=07)d ġ r}!hj!FN`4. %lj}5q:!KZPPJW_W(i+0ZPĵܨOx? Al#>ɝT^ X,G}q؇.F 4 G(|웶zҖVX1GۑWZo5#q.v^,5ZpBh})")Vq(YrS">%a1;1: &&,q6;M~[\e޻L ?Oknͨ, Cȣɗ-]E,J9 `,AXCV0gnV€-AF r) FGsʕĊd@n+,l][G.GkA] NΓ0RUZi͊$EH#7xM%D=k"O"h.l߃ ݯ_O,-)JIU, endstream endobj 431 0 obj << /Length1 1408 /Length2 6437 /Length3 0 /Length 7400 /Filter /FlateDecode >> stream xڍvTl7%1:I(nI 16 A)IIIABEZDJBB:y?}glwg׍DU1Np- '  Me`,7G<;p7_zu,cPx!@Ṏ,mI1*QuS8ٗW?`# /ثvw-!rkbHʪrؓOzaxRGc)9)c[);Wcm^զv)ӅӪIɖSW,\0c+:!e]͕& Z'uS^)aHjD'9.;fUi[bȷW[R!MEM6:|{E9!`B~fcZ)o/nX6:Qo&2Uq2r0qszɥ`iU>]KƺU )wh6UfߏNg3IZRtUD*O›qmeÛm/h)WaƯ s5ΐ3Oou@8hXa4*n$h &}UH/iickfsWj Fv4A8Skn:-0&<N?aȅz_({|B[ݸj{F?w/U*Qd=cJSe-R$;G쿥P0MtM  Ki,$W,mf('hTyŗsW畐knmf3'I`/Td[ N/úo*ݯ; >Ex{+!ASnD6FC7("<`~͛./D42!_Q>Z⧱/+CQ w=$xΣY$KMwڵY٬D>,1֞p]ꦱ[6*\ gtVVe`(-s6Ϊ9mb}}Jߧlo(X aU(hHɽ}Z|= ;;btw9DO#8voZ`b +-rK RKg<1&TƎ%֦s$2毿{)a3\(RF6%aiFPzٌ#uA+i|<7GI5ϭ 01f{H Oʈ[rWl5 b٪uwsO=/q[3s-ZaЋ_P׵fGmeOҷqú#Mۄ}1v]kwWϺ܁:@{[yDxFXV_p? 8_t1} ΫdVDS/~Z*W{ 0`R+_(rޕf\7&ߕf)yX$+⠶E|[у]h]}o"JZn׶ݲݑ ^+-&VKLj04~o#&ŖS1 <EM +Vd!3 >#D=45[8ˬ|if{*g'MZcsv&:4+bihjOq CmyQAzsnzKGTlYgsn)ߖJN9y1t}RrV@X"Ӭ9^"Kưm}葑 I~l,:\Z6Ӽ|GO"xѵH8J%Y~tT h^$bZ\VZ!G,B,FGoyxqϫ20'V7+7 %U٭B+Jku ݦ "%OWblFp+(oo18֜ 13̥o!b>IF~sZN] BB7n8GZgыmHHn*bӘ ޱQz KJZCx fw3Ox7C& \ec&_?6- &,p+\T#+S賸 [BW 9UT05cWb]wg$gr3MhyO 䊼%XuZ#6ʁDj" Xp#!.$v4Wy"| -U|Ǒ\uqu.+K$+siM q#BMLm~YK3i̺o2'+[1gg)#Mg\2(M~FvP"50j|NWtd5[rT3>߬{'#%j%_iLQ0vЎGye+/*:K[_X%*fa1#S8JTݿ`*ZAxj"RGIٓݮlBޫf UJ❳ǔ=hyfh5ߎ:q?$t-"(r4j>5:TSXT,wпMBo]Mp{MN,۴$BFVaPq2Vj<̧1V +DnGRPsκ,˦:(ԁaTM"!..N?SԜ-qƘ;kE3بowN3O7*p}fl]HEAzy-$=wiv25Ki-4t1GkH0uˏc`]zwTZŴoJdd6LR=?=Թ͢aQL\4bi2@KtmE~jyDy2м~)0[ϯ'Eps] ,>; 5blGp\͝H=&ێ^M\bm «oDErʐ7KrNǃu#-,2c͓V"GTFv%Ҩx:\ Et@ oܠiV›RB=8"yƚx{<]n9 : f_]eB Q#E𼔁㋨[*K1:tI|z)Ss kMQ*b9EK3m Uӄl48i9$9pFiqwKk7/v:_dD?/)BȣF|Na=k,ɥ:Z'U7Z$yї_1ݼlcgs_w }NER 9ћN6 2_1|]YkL5б[C̈́fX&♫j if_@摘!fQK 5]m~GbCq] \֡B ٖ6-ҸɌݻ[͎y1[A?q(̠Tm"l)n6GԪr oHNy2\ʼn@Ka/&,r[_?Z[(@OmzXpL>5)oJN 7ڰQ3[䅔0gb pT*UO xhGY]uש*MbQ؈ZF]4YHEo_&zߍV/$PxFO|3Sm~X̒jenv mifہr(~@d"0[g -ɔHz闘7%/YNTp!FR7V:†:8-VP\ۣ1rΩP {X:H$(ip? QYv+^ec vv(!,ML57?w\g40P2ͼTD ;,Q 9~A./2p3RHrQEτs&h+st[E>}#;_.!zkL^8 > A&e'*#M[l~nnՋ@xm4o>C Rt|.Ii5B;|!L%>y_Eg>>p |uC z^M-'m퉭UΒjOK=,Ov҃S|#"!-9sIdWA =)UVxvǛS0psֹ`&~dpuMF>CY^MDUQ.:[X ӪDtnqiSdL-z/ODiG5 V7<9Hp;Dž\rzxYPn?M+e=]l*Ü\چِ V(=e{(JW7pərP 1}/J&П=m_urAi_]йfOV`;GKX宼xڰэ=/zI|;־UtjHỲlXJaReE*VTgoytt5|mB-o+! 6z8r?[n,pz ώ %a.*)n00 0LR)!u@\t{㹓MzWYȧ*՛v= MŸwu_T!|E'rnQ3EtښES/ 0٬&YkZM5NR-dfbmРfp7\ǒD tm /Iؼi8DBHCR)ed^lVy7 D'r%RQrP# O3,Za7B/UZKB?mb3`cqJ4Ifn%)h QbĢ~O{FcxXݱ2M-*Rx)uc.(!u_BZ4ѣ|Td]<a׻ѐ~]13'ovXP*u޽ӦyNK=.o[u UY ۍI~nIX[ E37:Nە ߈6iU|2S`ǎŷW^rC8{bަ3ˉH7[eWB)f#-,0<?e]佯ǙeS2/m Tt%aH5 b|hu<>&#?I4^^eix&K|¼SŐ#fns]YPpg7WxGxC-G><~òP:,NyRn'a=~>#TP9cy.V'n r Jݵl-8/tkAi'a(J-tᨵ oBVjJ,0\S"3`eoMq*oqW/KRBӈTGջ~`G7_U7啺rlg_"+b@{q`J֩5ZIk 4&q<,`(UXE²M =̺ȵ kv&WcZue*ٜ_ZS'?x9Nسp*v;rlKm'g0oYL0{~Eoҫ)2,G3xߎI8f)4@85,鿡iU碕E0g\WiܨN.O,2G$j5Q M}yhnndsFtNۗ[\bx-ʼn1mɊM'=W{s{rcVJO_ЧT_- gJU/ rh*4'~=~?'3Y endstream endobj 433 0 obj << /Length1 1408 /Length2 6424 /Length3 0 /Length 7385 /Filter /FlateDecode >> stream xڍt4ֶ-z A ^G/D]0Øa F'w$zѻ &{sk}ߚ˽˵oVf}^9+%X C$z!>ABVV 8L?)X fp@ @1IĿ I+ P΄pGw_Gs# @i v@ mHGI~~777> g>8' 聝WW- Y?>fÜ.0+0vk1w~;[@pG ;f@m% >$ Y2:%w%9]s! Hg>gW ;8aHg_)@`j_ g,-8`ǿ \@D4c( ;%(Z8@|uA GoM& ZUz`6пqVV:$U uΐ_ ( _:Vя3U`JEnkED;!zhI D~>vX)"ෆ ~a ?[Fi"FrA Л+D%^{0NOAR*_5Uѻ J=IF4\%p\@%~"q,;t/>^R72TP)~TNH3Uvgy)$z\/l-6u2+VY8 lcIQXz+ <Μ* R+lXЄA60 f;'@b>uxƙX E3 Coy Fdw^Ӆ4-R qM*_;f+aPrEy:Q4hprNnF)vP*mijpc-e9qvee5)swk-*7?=VnÉaD:??Ueb$"ڦd~HЌN&vs`Xmfӓ~]C&vy^.zTӁa z7dYw?N=c{<p~9~\ܮكNulvK>0vU ?г(ИG9L&ˡw5=҆_9j^br2sGRȭNI̙w,|RnCmρȩڨW …΅q4̸iUbD^>'sd<]:ZBn1CvV]…#Q52~b|y^~xv1ׅuϼ2Uv=t*F&UxFO|uS2+lMKޣ0]lARQ_wú`yDGjH`2 ػ|[_qCF/؆HmfD%p@T_3!\H)h@fTB ) Q:{4|ddfJbXv^*}x7? +SIg<*Aay͝3S8e_ӒWmu{zdD^QtAhʖiop݌3[+.xၠ\5>̌B7Ԩ ێ^or,TPc\ZU 3o5'+aƮ<` Bc'oq]ofՔ>[{]!&"`o'|}W;ɵK I̥ݶ#oTb{eFNyxy~߶T:A= l*i\9Rԉ7&)`wa3~nNZG ٮؚPgW#ܔ={S<9'.݌v1$UY$y'{f^¼^i܎l'v)ԫtO ]#͒b::"RgP?r[CVQqtoʥ܁)}_(|ou՛;߈(]ˬ,\ہh6. nU4rPo:UtfE}p`||̉tDѦ{Xv|N{i]9j+ݠg ?sxQ2?;7:aeϸ F13ڊD)\KaS{`og{Nߔ3pGigki*WT4|o2ɘ[{ efQP8L%F<&#z[Km3}Mn`Q̟'(k{.(5Y$| GtUmZHvs7S}钑&~ 6ޅt&ds/R _ۈvo:U)VrqVC02exP1jJG`0y|{=NeO$~_%˕Bkq)d/.;14Acr/'hpw̑j%N)mxjGo^ۻG[5dY'D9#(#Xɲ9Xk3'dp-xn5܂a)ī$F)W};2nj%9}Ƅ*v1]NfP3hxGT6箎Kg"S'To\|~7sIYla͒!,i5rbC<X+۵Ʈ T%M6G\IPqS?Ex;$֚FVcإڞٓSC9#w(]0=E~k~L="nq,x*W}7A4 *ؓz8E*ԯ>P4&n^Hf*+է$%[z瘊h}_ot1KC!|9E?{Zh>zb[o̓v>ő2lTdO&:MAÅ`Sb/E'r׸%cǷC/(YhYO0 _ؙ_ /Wݙ_- wk]/.}Tjӵ,v6'HuYNB|r`?F^ `J܈}8ɝ YI{ Sa{}YwCgjYzyxTݢ|5.[!jW{q^89f7yZ@p/ysr)<_+K:u}1.6f RH?k~>.8bQV2:fUi`|;JUs1wqL{xw5UFL/j6~fӕEFGU7,cPMS7#G"K?#DJ|fRU٣=y堕l;/ӭ'de%pEiR_|llya*Nq) ^Ews'QLGf>q C肠p/wo4no91|u3魰zxߺނpvV~C}ڨ@a#b֦˩vZZEKL 6Uϧtkx*;I_|%J8ff394f{. 3Pήt$aͧ0>)nFt3AFjH|QGKQ|l_= l =,50\?([n[]q]V#â4:])|EL5 _ ^ HEG'`v>_2~Ԋ+YrSъ, 懯1QIcE)ZQe4dU\Uҏk1.+E+=wa5џ5C3/#RGWs2cD_̥fwenupOY'9Jݹ`}PpO:6فj-T@D3i3om-ϸջfÔ;5z~0 w_R33[xR`mU__ Fv.sv@rn?^W/e|$agHS/UX,y!c٫mYy ]1$Z,߀M2|59;v'> stream xڌst;i8jln8ƶm66hF{z?ޚ2{P(2%\Xyrjj,ff6FffV 5Kގ_2N@#M$*ooqX8yXxwY2v@g Q{O'Ks PXR,MF.@[G#%LPY8013:3; -],*@g;m-(jT\܍h Rr3:@rEr S #?ې_F&&Fvv3K @QBÅ`dg[ofdicd +x#22t6qtpqft%o3Bۙ\~'f4Uޓ[ٻyfvfS1uu`RttJG DBC38? t=L,~;QtdM`04܀'WXX&.c 2o 'K.3hY̿?͙$AOED= V66' ,ȿT *cv PgOhkK4@yc`6a= o+?$jcE_F6 hAKaE5oj ,5kq οX@*Wq;{; 0rr2D` +@hgR2;!n-'I7o `L `q1$  `@#A ȟ f4ȦXX@:a|8.Ki-;Xв395?b_IL\?&ڻM@_g, 6A t2X8oPb.Rό&p6wwu@-rU]3L_TY?Y:f&NҺu񀎺⿞@aeބ7ت>Vߝao++1;B F~2|)9bJպ1\"]!Rx | :*UV+.pc?TSYc KCi}Al>èB7\\A*Ra]=h%+ K_OupM_4z"GFĥ pO.X:dmQwp^ YBJ7s8)Uv29/E}>c97aHŇZ M&9m~$"r{f'Ѡ^y1ye a_MF H(7o(k[HpC7C9~('.#J"E_~ghô, ]Bl'"i6@*rDTae܅D24T,𦝯j,'gHRm:}`oԞPՈ&itsPkT&˺zx/GZAi Vnc2V7Oɰ}$j +Qqa0=|Hj+=҆hH}PQPPFxf"'0ќDdD M4E=fp 96VKԯ΋rG!Gb*6 t@kVBy?OA5Uaҟ_aĥQe4]q#OdGa~="! )e@2pe8$5gsMTOwor[i/Ir0GGJQY_T%&;J1+ yƺUFEAE<զG5~ӂۏίº"%߾~|tOFv5r0( UjZVO 585QjTe5ZއV|00: zCtE7(w'3Zƕ f7[]+tud 6qG;;3uNXD8NΛn|{~7q]ШMO{B/dpϟ™B(V9jϾ%z[/+5LdRn}dd&CSiw:+Jmlf]GUId\1%FꢞatQM$X4~\ {BvN}4{ժ .PvzGFnF69C*; 0-"&Dħe7ø%t iF"75-iϗԅ1JĂ/;2PH'i7h9 "-;~DٚM}٦ӿeKuV_T3uOnDOTL/.71q+ bZ 8g]@*CǏ,/buǢnB7#ŷTc$2ᓞ)ܦ4u6c`hViW!r76zL-vBu̟]đHB=g<9HW=h8.By+b11.ѓdYeV3@t̋U4xyl 杉qmzC}V;BUyGG=Ϭ(@@5:7 iI~=B񪘵 ҇.!@z|*A w@eզKe}&YetAkM)1j֞Ccnue^ ˏ뇉-4#şH%}t7RB"Vŷj}N2ۈhȎ<"[bXSp&?* AQ%=L,G큙`dk\ȧpsED`>IZX1^K7M#Ѿh(IV)㦙<>%ؐQû\qj0|BoڽC4>tM|צŖo#/l_a[M|+Dv.Q >NSz\CIcK x#36pZr 0b!nByȑZIQAy@<9aȹAdԾ{B(e>Y9\Oo?!nk@ϑʸKOjD ix4XIU 2֛@ޓ:xvܕ ]4P& %wt;sZ&.i \l\l {c%W"S:&0'|m kAIDf\{go%;8i6!fR[tzh Oel0n{_1)LF_oK\"ꃌBdcK$r[)EEg@q6m&ghzB;ɲo\`ZI[M™O@!d}]먐" K:LA[2̴3Yʍ^ɡA۝#d;i'[<^󍥸uW,p;j&иndC<r#;$8{9gf̍bWle.#W짣Cgt9Becqzi$(P6lzj 'oː7N?3s$]oxɶ*Y38\MJQmr^sHcH<. k.}]{FU_g@qu SJXߕ>[3@8ʁ*!2 h]'b9YM-1V:pϲY*#80Αސ{S=׾=WIrZZ-й^ݧ’*Uɳh Kd=(~NDWT0\S';\?Z4_bK3﵁-IAjr:p2#lK:X$~/oxЂ8V lϧR*]&WO\- yڠvN,ciϤlDP3c ?< G U^!QkIJRu*S䧱m>PV6!Nt%_b5ڐ]@ ^%|%uKa5e}aM &[fW"gfD66 @W(QE"n$WV΍SrK&ь*XM/wJӷh`\VquU ^|ja: e"̆jx΅ k`/,Z@i  /#,ϙ_eJ~!;|[m1*oXbS%A)4͔̌Lz>^rp[ase1CS]֘WW%{:j :cy¾~2-Ma!BRE^q$hh+*pd~~3@\ wK& a&\\xl2hV K}V}:[N*]ASYz. a H2c-\V+ Ԓ6D9i J08ArYR#R!҈^Bq9jܺ::ۉ XHc z]V)O_(oV3`Dvr5y|y<%D {oM$FjPAHꎵ%LeX#]kUczV<^2DY^ѾlO8AWN_S>-ŕ5|+ jH@>ȷ}Nky$ m`@J^c#m-6i6=Wgˡb+Z&3%pQ𐮮IEJ'7]2;e*EI h9 N* z"?x4V(p_[  Wx՗(/ASL}'Vs[bx^"\HUU0]Aڹoi1lHAP3*߲-l̃c-&Unt+H G9jlk9iی,֙A*'x+SBd>˰L ZyS$F@ӱ5('OyCU.] #8u[rYU2$`7ʇ1Y6!xbtX VSj.H((?m`~;TUa&'Տsp*Z/i ]":[uj7Ga`ِEy-ҙKGb]r~Al3ZŞϞq̈́VJs+<|ݣ;|j?9,w̢P 5#bZK=`Jp|h3@^:Hdn/^Y媃n%#D!7O׏ٗHĮ0E}? u B]!OMWQ͞qE=XY"q+d̕xBG'"g7W9„4 F CUK~}ؖ{u]jŖZP> Lh6}ZLt6V!aiZEPb5֋mi:KىUG̩2 @3FelT\"OK˅ygY M2[T ZLn>1Ir2`3~Kfd3H{)u\ߎo"L~ɸbv**2y^WЍ>εk[Fqmuh8y#a ر(1g~E7ZY<לWh!+5V(b)}b^v醝*vP#oʭe%. hJcN/*1tAV-0kTo^Tt;玀n0JA'r pSWWAv~>R` eUc:.( /?cRr8#!|Ќh:͑~ QMxΈ]kI|8=fE(3}m| Ӱa4ILh+e^[>}}"1۠bSѳӏ6+)J-hq`Ra0AlYf6'Oxzya[ ]_~!}iځZV# if;^GT /y&g>c=kb RXdѵ;ZݤBDT`1Vky] U}-eucONH&*AGa Fʈ_g>6?p2?U{lp"d {Bg_X` nU[Xz|>f;}шKO!z{2@N6数{>p=# k!=@W7^ڧ *"I9T߄E\[tf2ÌB_t; 3LyչEWtiS8i'h?">=. kFބb‡?p,z O&&ffe(C#}}s"sdr1w_sŷ&}ZwW?:,ev4qvMN,jc͟0 &uE1JD a"N?GQ[~sp ٴؽP\6y|q"RMRqqrrX3B UzYD.9tBiYp farLc? p0G{ckqy[8ă:s0L+9xE aSD"ҟJn T͓j=XP W:νD5upPq/?"}aX m[W>:RPAI4 4犰I\Dp:1tVgwTZ!k$!BNLaܣ?D4:Δe -4\ax*oY}`٪\vUÊz{m$eCWeV6 uӊ OW8ݱUW`M̮%hNr<8q)~Ƌ)ϸ˃^pjaR1,x(VI$(&_ L-iCI6z&e:S}XF'=L_s k>9q+4 kIṍLSda} ۍ7qJBo0d/3SN?,%~ ӏOi. ]>'fҾB}Y>zc]ydF!>9J. v-}r^»l–eYuVzحYUE']X5lvax*7,/9.jԐoL|iPsqT>C~hܘ% ̪niUNuv P\)&bPb1Ci+Ho@:3egu<{|:@!~<[%mK"m/3T??/ui=R񌦅,"G9kR,ݽR=5b'.SX<ՎSj5m(oTGW0l631E0A #r/B>VDr#Ob-{^<)pLOfA=S;Vˡ^_.3﨩w?DJq ΆZ]V#nO Ґ_w4T$t |b<K4u|J qxuRp{;ݬ?k-Вֆjanŵ)}2oނU8Fkyԙ)1b*id([nFmxw&shXF{bYI0h-l~Q? C==_$q'\(4K;y;>FFK/4-hr?<}*B/ 4ۭ$`(fSC uC8A_{wp[/&܊־ <_)e)qBTUm!We9q#^g m 0aCg!gNB`Ta)46*BiWR?iDjy75XzEWChjehLI7e>7`Y(}Nx>)K:5h+ +Ɂ :~4$g|)Fm\8ozld!(ŭR 7opY>`t&s:G]dD?p ]95'MIǛV:V mγ]?_LauH㼑BkX p 3D{od$'Z`xdhrˊAp4pCm%"4LԯՆz\m2L<"YwߙMD͇MUrUQeH|E =_;IևlZt6qdžYUi;O1/6D˓^9!U}ZL "o@VW: wEyqQnIHDzl,ٴ->yr'|[20lXfW|4iA۲f>gy ,n1D:kl3;d€vw"(V)Hp.i>K),`A"Wx.`ՕVDk/ۢpu7NjJuMe]+0]i%[gkt7ԓ";fMvxO6n5o.h>{9w~-KR^ٗrtdu{=|s;cr_<Պi i!f~Qsu04ߩHcH^ml>i0M海:uӝ1 >wZ-kS Eeu֘Z^B3b]]}q[b-,vau{BfϬnɂ:Bf_XUU.v8bPgqĨq*u Pe3q]:LJSC]F˱IE2!f//ͼR3qԖZ} S_/oﹱ[ X ?s:K;DžʊLZzJ$z>@rut"֒$ml 7wO0魟+*NE pִ뎝#O3NG;D]րe~ ɝ*r&D<`*%Y?JGlj/uN6eb#3nɘ2tu2HY)Lu6;3œܜ̮5U4W UFޟ݌cT}/djTs &_BoC!"L3zBB}Uψ ùtZWp}6ɤT4ctِu4XR>1ɰa4l:%Bkݮh|/H (jZ?R%CD lR'F'xSc GP@f ]cڡplzu6"Ǧ V &#Xu[{Y{}jg lOQ&[8D̖_/U. P:ȶSp~2xw u$:ֳv=+4:ܮѽD{ ЦE؄1<,+,V3G;Zd)jC&P$pB<}cgxW^_[؜;jdRN9tqiI)N ]?]青K8kF(ʇj2֖Egk-'|!GJUIM8"AG:b້nE,.55VS "f\ݶKY)bΞ 'v\, $/N B,-6 Q{SǐȜ5i.wQg-Vk/}{Yj^ ̨_`&;5vѨI9nyߚAo  d6t'̦B,w nSA{g(VKؗ<:F"#Q 羂XE{Ur=4oIڢN"6*d6|l?ㆳ@M r1.>1vJKgWX*hsR'S*p'EhiI^"$LjYֿth=R&ފÚFh^Kܽ -I>ſ%* U7DBmcܳD_khV(@T1UQcnr5UлqC]:HDv৥붠@1yMY1ZE(a1WaVi/iAm\kfxmךj]) ՝[EK(K580~}|/n]2Ra9&J1l^G&U۬OQ7j5Va"GzhΈv JxqwF3àB#x6-\|MW9G O:mUgl<@T/cż_qn[9pI@onR uuJw0mȬ}uvIlTӁdOƻ n pM?.iWkbtiRhywO3?iam|P4M@K/>Qy|"h4;J74aڮ'_at((JMFgnKFA3g$\?4Sݏ6Y3neJ@gה|}$r]߯:" S|E@ ..fمfƆS~};)vX:Y} ”KZO+_p%c")M qva"I9w+PR iL|( T x9>DbdtPrlК̎}~2%Iˮw/xo3~|alぬG7)qsb^n(FcZ4?]MD ')xzJǔ8b4nbm"л{ tn%㺫E>кHCuүK7(Uzl㝣(RS7 t%ߨVԔ k ָ "{.XBymNB_xUXrLP cS\vV>|̂B> stream xڍxXm>"R@:7nc`lFwtI tHH(HIM}?;v}Wu{;DA@I@!Bvvc'd7z`H0<`4S1D$  QI$%&"=$`/@GD@QJHw_3KPpz `@va2Bp}KvN|o`EA=_-tn? a FHG7 p@a\<P&;HCEE9_x CvC H7w0p8P#~p`{ w`O(@z*%FO`W"W06<MP ? Do %DEE@C,+;7!pĴ 9B1(+BP'105=`>+ F~ _W9 p)eTTD$@G Sj %{ן3.\(BB0oT+*Hmn0Fh 1oՁ:<۪cAQ4?_8 :Tnk0T`a ⊹0mbfyUïa=<ƬD T:@}~ (@1.LGᯃ`O/7 ]4О2(䤫z[/mgRdV&gv= 1mKj3_c6EZZaxA/53k4B}s<^P u \|3EQ}8+ =;M]ϑ{|_ê!NZt D!B;svvR^j#7QEk!m򓦃 qۻԤ,%'XLI 猵7t ,$#BH(\*}T&E&C<8qtC`/~AϷ[6GB6Z]veɰ-E#٥&A '~{i9Șjb3cG ~XMr5^՜$Ҧq*jqڂֱ\zVʇʀ;k5:!8D1_'„fXΎ̈́p9EVlZ.܏z?R3 jAoI\O hw!rN+n岓"E*GBkBkZ+ ):ʡOv$٥]&֤ikY?kc:3)䍆+]XJK{#gἎy:wrփ`֕nQd`eZzCS,_LIՐ-zL*헬AOy{heӷM}jP-:f+B)ԬJ57]A6LnlxՖ*Ӑ~W*=^f,_ZYU֪o94 2Kp HmGH;]P';74.m+r(J4\ >ߓBM5*FQD{^ƭ [3hfGݑ^L|627lR#wڰ+3!E2G#B릊 go4;E} J[#bӟI" "Ԉ/S Q8nGOؐ+;8^/^Uٙ |5rT:]Z|>\,V{NV}W=U&pHGK4]e?iwd{KckrqxFKT+GDkU㍾0 JD uhkTVƕ Q,q bb1x &;~5rZw?8?fr`H`:cu<Z\k4_I[u̎V}j[-[ߨ6}>6 ȱ>ݒ#?GӲDS~xؖnmH6g1p?'xp!zZ2s{`kY•ȗ"7 !k;~<SkӼ QP1zs* pȾsW]&W[ ۮ xˆ\gmɀ W{nXcptmT5O(Ғ{ݽs\\ܗI|bf`.z>:4'jA_qK`UM4t ߺ T@*>7`ktrZy5\,Lˑoɣv_?g(s@)W7moF}!)^ˈXIUݛ-.[NWcެͷ(Dûԯ C}Pc:ELtP[JVԭ2$cGHZ}3 6> ^{P/DpeC˛¡iq'E2.$xA_ ϣ"rCbdbR,ۏ~N,1<ϐmXӷ\~-A'ky8}LpP <٭'6 :}#f`-Kn}nL?y-+`tqj9όEƅXg "תq.@?JL+wƾLWlELjh7//Fk LߋJW|O]X{*OU,Ci1v1MGpZ=sɯ]9(.JQGS`s5 %;cߦ,0ޥ:I yBs.Hg7n_x£?bHK|.dY޸e@ ˏI~N*o]<J3rK"OדSR/P:pm,鋁 kqUаѹ n6*"sD4Qc4y"]x9 <_y~ϝJtIMHta/J:d;TŶ ̠uR\Õ[Y$壯\ Ne5 Cdt/"ot#[pɲ.l=u-@]`}Ī'){^Xu2$S:́!GQO. xRv3T&%?]Pg5xXLБ>eS-plJ/~;R]U=gp@1lPMk^߹!HѪGcv'&D Șoiʑ`@z:3=*}SY4q.А4 }U]!W" SSLI0NNi֢\RBα7I3:)JrɑdYWnE(M%-3H_ѐ+`1.~޻yfb<VS4NEVqO&)||qu:`|>`gڱrT^Z,I GulY="7XWhH4.qjު/;p:%PݔA'AH\ܬJ>UɆ]Utbr8`*#6){1(tpYD͑Eec94pU?]v>wk}"Mw{ Y~\"U# (\̳w,*}OT吴}.5ď/$J)$U Q-hrYcdg.;»Yl% J6t!rvn09ߴ+?&nߩ!C3TYiГ/fI[&F6{GFG7Wl+t* `-k|z-:Ii&Uڲ{85b]%Mv4*Y;VY\0(vcz*߸#όA - cִg>8ED_(u+k1ѽvrv,5 ڍ~f!U&\elEDwaܲt9\Hi,Ux T:#Paώ?R?Y斯lQ̺eJ&+RUgI*ڋUY8|ڎnWD;w(Y\y35+`8EvQ;1tZl~zIuzBd=>ovz+:Mv\]UsZ4|gz=QCRWpFw8mt)t{KpbiU%+P'a 4U䂷oUfyIOYZ5Ӧ} ӣ:#3@2Rj]¸ͫsj<5 ?T2hXrdAhEv3&iɔ7Xɂ K-Um.b4%gB{y![< hcB? G34\ endstream endobj 439 0 obj << /Length1 1372 /Length2 5935 /Length3 0 /Length 6880 /Filter /FlateDecode >> stream xڍuTݶ-A@%Bґ.А%$A JEDtKA91#\ss~b30Rw(, T3b 0XeĹ .3DdAQ@mPDRVDJ 2"1@5'(v qmEdd]$ AqW0  C"p>(+ù {yyX'BF,㉀ uE 8"pc= A @a(8o4!PȺg_P E Q@{ G (/"C=Hs(!xXÂH_# *?eu\@ᰀ_!1}ܬ3 G{ -<%22@; sU ;( Ov@ 0 "#a8:FY/Bx>~ F~Z 17OH HKd,cEm\-=([1cϿk>?kEUG` 0 %-)77twwC].> xzCmo9ipGpPQx1 p$7@`$7e5$ a"[Y`9X.xs_u 3Q I x9OoH8 Og ڣ1_*. v a?J<0~+ֿ@x#` 4L.ܩ:RK{_Zb-%pܓu/gj܇]O3z92¿q8mݖ2G޵%w怸G3; I,Po>2IyB yl>q!.\Tpւ]Y RYpsZc-8YZS` &ZCg8#H|ƻ4< ɲHZ&:_m&GXn})L]#爠]8(S凛va#VbLj 춺g8Ј4G’g7WyH)Z$ vn+憯rǁw)e%md$"t2tթjܞwKT(]y7w{0!ט>Vxb quC 5~fҶfgwYߎkuz_<ٿ5v1vZ4[:mϧ)~x[~鞰0lFaP`y{s%I:|ڕiZxUH|V?*/}i;`R$1QKA^zCLtog;UD~+3 DEpd㧏h^@idJrM\UC4 e5k6AeLWwK`9w)B |E r!n+uw7NJUԀ4t/X 6L6 ^xV٩"j@ټ0;ŸkjXGLJ3=(N\G&7inzha?7r[:ikz|c| d#q2|PPgmKqS%PDYٯ{>o={1)]="&njyXE`9P^xN(e?>ޕ}@:G&*9rd٧Z6'b-*]m(GʱCИa `rv* RYelptcq>2h?|wBuuZT!<,z,w5IGj'ƒ*˟Oi8fsNCzorIw.`gd؟Kx^x0#ye)p6yIʗ4?{~rKkG#4 Gdn>y,ȼa<AҾ4PN""1 7/JI딖a f&l^- &v^^ao@ug(3$#5#x ;X{O>}:Ktxqqc Ng)6gAKig/+޾~c9ψw7A`P "E] nS̴SPTb)sc,RG0ϟGd6M~䗆(o:0X BEO>ȯ fMtCdh킻 `"y'*f:DflYd&eK.a Ob]^}2jD;"޴&:<ǛTnupEWf5³ &N9)+yi+Jn+d~= .-1桽έhetn~Z^ƒcXi_x-0=آKCIQ秛ȟĂmHnEOZd08vwvxg "Y;#6>ݲ&8a_bEvYi:,$#IzCmַ  acx9R]4naK %nS nQ'}o{uyKCiqő($I_c gng^ËՏ-'8Pzf&I.1 LRV,xF( ܋^R;}OX5s#(|ijCf&{=ɅĪx bO 5[2 !PǍD5=3eXUhRqS3g;j T PV3Q֟}+mфC#-_GFoQ;e:GuҢW!{YɶZ8n6#gَVe[<5߼S.%gpg'sPpH)TR{ )h/|/xEY'Q2n?իo#|$%um%=K_'S_v4ײyE8+m~!q(O4Uԍ~a a{ RYd]~S.(@d Of.AblMJ]fԗo7Ǐ]b5?i,/HH|ꄻ^ Xtl0ZЖQ$KC{kĨUqfb7Iv7}|j3VY9>#rUw{bmYˢ\8Lo-Y#yH Ѽtӿlx8cXl MN~e˛{r]^UҤb6`Lg.Okx1^|? Hm!UJtkѠu@RdavK"n,qqg1O̸.mSM#]ܛk="Z$IAua ( nl: ˯|b~(v:S4JigS 0b,ktm73%`SPF~F$ImtV:"3I˔ {0kHmťQ1QMsɬvEaRTE|!v//ˆvGEZ]U(*b P[9ZTu EݥTdU{$/Ȗ~!۞WLv}J&hݺ}N`+<`vsrN])AU0fv_Umۓn1c=3Y*ȼ [G^#Җ~|[,ּďpԖwZku>yIEmvc*|7tAZ#6qrxYh%Y ǜGqAzؐrHɢkWL%Qg (?"XۤY}՛y۷%M\ ٍizGTok95<[پԚSLB8*%yy#vm2,]Ֆޫ`Ik7,/*d~`N~D9IP|›<x'k"U q^C%t7J Wܠ/\hѩmn>ҋe{ŕOL>}7ڄ 1b!O7I0i.*'?2\E5ʰPi/U:Sv`nɋ5@OWg.4kfqqzqaEDBQR3}uPO{.pAOUћl֊J$v=g;`kՁ[p)\2'e WzVt<T' Ru endstream endobj 441 0 obj << /Length1 1498 /Length2 8457 /Length3 0 /Length 9460 /Filter /FlateDecode >> stream xڍT-w/\w) @Hp(kB")V݊XqG?߽{+k%g9sΞ@Bj RB/9Dj\..^..L]0A C!"bȺGHTB/ܼnnA..D@q^B! &,lkld# r[!5 X ЁZApJ,f;przxxp`PW[ vn@ k@'_q`2t?:Px48@c xQVh8 U$:7? #heurB[ PP{@o"}@G[f v8``=rNxkYaޟdx^]ـ!6۰vsԃ]@rqMق~...!!]@?g3 pW7Ͽ0`+8d `'d'~W'ף\?Lf 8zs)(ʰ?N'/?? <@_W2 s_\G ?S,W3IN`Gu?Nq K59j kzi>*7ߟv0L íT͟v401|Cf 8C]Wb=l<+ ?q*AC=l/V@)'p n.~'_P/{ u~d܏6ce?5d8(ۿO  œZW7^KSz1Ç}~n!O(+vu›1+:3jp'l7)Btk#:(.LՍJK/ږNTjTʶc]ES/lBBHM)M2cg WI]`HdZ3em>T^TH$90+ jEX.,>u")} FSg{ c "5 .l_;!-~|)p^؁@~t|.P?W`dPQA8xYKùPOa}>40W|9VvWu"\'{iY~ܰ*C_0j4qj仐 #LկS 5}Cz!91 !^ŠMt8VHK{Tqϻ˒/uZ* ;NUG13?SџӊEXBA8.*(tF#t{Uوd=+AGGݐx> %Do: ݂_o2&iU( 篿&I&U[Z {Ģ|Ą\SaO vz9]@jAÞq~$hjIޛJX-xgd7V?aNڕ(I։7٥5k.{VG7dmõ:GS[s ٞt 83 cX0).3Rȶ1(o&^4P!Yo"U8+(b۶[1)JV3lEw%Ҏ7=TG ѥQ&鎌g">M}Ǜfg~}&Īn j:Y%L &щrn]0jZZSe/qȚ>o8iBĖRs& +L[O(zDSؘBe@Ȗ%qy4 N`N9 F@_$JR'ߕ 1 tߝ8lg۽).Hb%[ZMg'-/.g롩4y,^1fbDc;_&lEv9>^E.I_Znex QR3,zH-\ÊBarO|T./'o]r2s>}\Pfז[փ|!B㼟nhyĔ#s}Ђ^9/1S(˦F~@9J @v#?n< OoT3k@5s9zq0; 0`Is? +lPi8a/ GһN)[I@ŨN=- ?qᶈIy8W&z/pŔkUW`wa2|;S!/ڛ5򧚧_ v"5y*(fx/TmT/Ք]U|§%֣ɣ ";ڽ|EH IVxR=oR~T&h% jnwK1aGoKo9 yg߾ ?aC#>"Ao$4g_$Ct@\> BgR; ڤ8P\Zha8jWAV%p$n{XOh1 :g(/x۰Zm"0$)=y-s ?* _ ONcI&?d\7dԷ9X>?wRsk(2!] {n`СRszk՚H''E} CBz'pwXOAN"wuܓH8rwd~ o[J.6k7 ڋAzu$]@U:.SpVK}$ (h7`EMKDsqdu#]ʾN|a\5^*4УC}5OaP>?|#07ZUG.g>Ցs6dE66ZQm(Oh1![Īx3PP&M,b3V8`e~Nʻ0hM38<}r k ٯ!ͶYwi*m0tHTy4gRT2ng(cHbtw,kFؽ?]uyGD-cউFI) 5uv9]]ooˉd2ckV͸rC#T>S-x2U7Syr64+1Z3"G-;^+Dܟ':ibRs>G;9hn<-{:[^`L~hx"ȯe~t苘ӂסo9}es yR& H[i<Q:1骉IG69h ِKHm ~"pVnH,?O ݫPQoWMC7#G5W/B#:[OCI]0ѓmB2'Tz,}~tP oznftԶա:qjV; \@΃QU"pf/*2(ۄŚbӆ"Nd'D)0JUhQ%8[C*Un<Y 1oHaѧ\1Z]o3=`umըK%+߷Sxi3IC; fqIYAL+h7 --UcBh^ttRǯi_u||Vm_IݑЭBWe+G˕!a14m./oC.(2 }77H :I 'G^7h0Z#-)ug*vX?tbcolPchSTE?^o舊ս& JXtE޽ ֩E,&xi`w+J:!?l:j:!A=X(t{SME<ՓSɶT ;^KزOKkD+b7RTvu>m W{/²FQ SLRcYx= wLf2'mb%e~g0k~Q[)x6vỵXUOpoCq]cve Џ[׽xަyq9Q 1ceS6)ô_0:v ){*-V6|> ZyNm89tdu L8(*В]% ʽ/ͯVؚϮVP&ݬLAi\PHݵ #S@"[ /To@)ha{2iUw<ܣ{IZ}1@utxhLuA(7eV, U&"2aO,')UҐWc"D绉(0dߌtMC zP#nғ}k\M *m͌Ɩ:ݢ]z.sɿM'5[d[ru' D|nevM^Aؓ}Lɦ5L!ѲO%ƕ}g*y-5G34\K6!EuJ^n}qBGgJװ (4+9wsz:j8IVi(X%0.#YS &xR3Սup'G~O4rK5s_yuh^X '`#(!c`ASj;-9uRJ"k(Τlw}aA霯 l a#͟@WibG٪s^]D4z;v\H1@\eadzhņ32N9c Vcez`bzDC{BJKS _[σ} MŋT tF1S"dcP+3 Mԋk$gktۇl&{r#qz/kbgcPkCصIZHHD-_׺R>i''_4$؏(_0 D=o<5G) PTw%I͈Md4zeOIƗ˝ieuP&_lwo|]hǷfD~닛-$\;~e\G3BbL8b;'΁%{=#j oMMzN:-uL ]Hś|X?yCAUw&=E#&ˉSXh8HҞȮ?:y"\<yA2!~2d Ըٝ+XGþ-29' Ujr1@#1?F&3#Gn,*;ֵU--~]dha#_ CB?-Z( JȖ :j竑f:u+U(A@_UxݳU/^]_)L̀ךj3pIo y=Wf> 'tDkF{ D8oN($aϊ$$f?@zN52}Eٴ]i;[>,h!K*];>jOY{zs8G#֓ }4YR'[. 7"|\%[jd^Tq}{gTH~P@svMX%*dRscP>t8 FkcqdB;ԩo([3B9 Yê#.xo~^2'}0'~c/ψ䵋Ye39=LT>!FިӴ&SŁx{0V>|/J/%5(^L} c~G-vMe%DUJb>1!zJK3J0~(RٮNx!0^=Z/UZR9#3fiUtI:mhX-3;l'BQ/؟?KϦP#kJQ߻Ɏ\6 Ey@T혃yTdhͦK Nw~J7QЧꦝ4dѯcCNJ]5O%P!*2v)B4+t1\E-|ku 1FT6ujBpa+;zc<*M`AmtpX_~~X44;1]yQIj=Jk^Rl ƱkBUZ/:G'[_@ M>&% >Wzm${!1 7Ɩ;{uWOkYm"csѲp[#@- ܈u2@09ES5"7s(UN>AXۯYIJ;炙סA3[$ J SWD"o?]*/RtKSGZA!˩e>jRaTuI& >`/S7uwԒFqF3VJπaKQuq])seR^K|>0c}nB~BcKͽZŽ:‘ P\8m,֯mr&8Փk$(n`Mdv[.1\:&y@!窭x 4=>A_ƛ Q:ʔ7/0="ҟʙ'|(ꝺn2W+pu"-(+Wk->qAKl",Wuء.3m$2)-iy_P<ƿO+ٺ{؆mاr`[ƮxE)bGy8 Q9q;,e˯׼}ќRhr^tBĺ|OXw_"ChⵞՋ;2};4? F8kCafgFǥx/}tNE-wM-Tzn`EΕU2ԉ̽o}:U!UZ"dux3"6} ?u gYV X}wq{_@w/tKt Gk Vф A~2ׇ$PR$ʼ_q"e,?MˣU'i2뫜> stream xڌP\۶  ޸[pwwqww-!9}WW]1k)( l²*LFFzFFfX22 gkaԀNvv:D ? elR.&;77## "&Yz- L3PS8h:Zd ́6 v@g͍ٞƉ-t:M 35zX2ӿvn@hbkt|f(K큶6-?`gox_Άv6fS k @^Lݙ`hk򗡡ݧѧJ7 * ?;ONƎNNWc5:;U#=sVvn^C&abϠjkͧo: %PK/{;{g@ S+,`4;hoG w61焙Z{m+fVTSOU ٹXtlL&&F#Q0OJښ]9Oɮ,ǒ\ Aadc4bg_/ h hglYV׍`a6F}_H1P rY{0yJJo;=sh{IƅPKˀ Ұ۽B։8/*+hszxH诜,`YBus󝒤Nb'cl崠;鸧YҎ{q sd_Q޷P9+RRI3i;uݗ `ᤉ:JIf(;IUf4JX?%Ktziv R!Xk|tB@[D-+X<#Aeizx>FeK^)gOt|G ev*5b`7]?f]%D"G) k*ִHBb(ViUʳiN)'<_U$:X#ֽl BHOPJDx@UagPCr6Us _j&/s!prj|S>ΗǁS Ќ-ˆA"Yg"! ʀ**qx V>y.N탥n0o~3:HgԳƹ@؊ R, ~҇XiseT..>a=8ɜX."hdP٪DR!+{2}۾{D^-1Y TOa5d#,Ȓ}S Z47!b̾-}7jy %rF!wq:y='}>#fou}$:aR0K16dyO(&r1K[%B_l^rJuk$Hy>N\k{Q]P<&&TfY)(n5֣?`$8p4{ш`_c@eM)Ȁo!RPLŀxd_Q/&mS+D~sV‰1B6;NJ VE7hiG5nJ{kNvZ;\RK S鰠 L<7`vtD"H&3Z㯂+xYvm=<Xq ]#%+-}BN3\]kD%ErY,ɜ *ZwHA[E@*ؼBlq#KxWj|tcO^T-}|+]ts` ǰ}CW? J\匿Us qrHeaH4ڃmąr])QNU.>΢"8bcEy%nÀ' ]hP(r Sw/|) cWrC|fV-zZ&(G01Zwȧp=y`l2%H( Ȉx];m꧜e.'sXB%WruWN0}T|U&lÉ5!j_۾޵Q e0>zd5|,\-'5U̒,vWw',8v T"4u^*wR+IǚkYK$- |f rJ d(}~r^>ڄ ީԲÚ@6qɐoZMzh"P=cO:028jսUa;v,Nain(IImJܞSԾ)s!Hkna݋ͪvov#.̾kF<#F A{{Ϝq>I2- j)س*G|A?fryn8UAB0ByP3E˶z*r"g_ E@%o'/d{W!l3AI׼OŒh5)70)E:#byPmګJ;k!|ATǢɓcGѥDROE_ tR&m%Iz#-O"B\\WV]ĞxPǥ'-(}%ěGe<~x_+ӸA9PYrq/F!!v 7B6|<Ԡ S`뾮G|WRKò!ߎ8oڋʜ _Ta`ԓهu o` YmV)ET?ښ YIӶّ̞c6yݧ̻[U$zO mEp \1޺DZ,w%T[A`DGҬLM .tR$GKIt2Ow^MvGc"تJDtfpՓ:X1{oʡ,B k#v<-}qVGSc4J&:'-ȋ3LQA3EYWx2Fg!@Msfҹ<'sU2"&V"wn LD|VRkiCAߓgUG%edž`a ӉxٸkX[&Eӏ!3B5А/= }WCrI1͝]ʬ&1A#7e?۫A^6hd{#j`^ۙ됙|kZز M*sZ#yG7|ʖb S>BOvCwr h< nYdڀ}fBS(q6p;yx\N;Xڄj\Cnֶ9Fz/T)9ZڱNXXH #ZrGM&ŢđY'^e;`., RW3W) lQV.82<ھ&8Sҥɖ(Hiq.cFRUwcW_6S4<ڏ@Va >ߜ/#rʏZj, $o}x:?( of_J?/U)knOwctJEK3uj@f[,LgM_CR&"*X dz j53ynw{7pC@,αu9^ŀ4^eIF5O>%oQnF" $(k7 lo|_)gwcz `n^Z JJɓPFYQ;-V4PI,ӧ` 櫹'[!<v֢Nl{]yWF  ,N\L>; șFv4 qbQNts{:kUr6 T0Gя8[]~m~>vb\ºa8c˷0܆B$c(Og cL9頼ro1SyM <@, e1w먠dH:{AY sdU9dI*W2EiA"V&i(:| S);l@!<|)Z;] @j>*DS{ixGbZ}IP^I'/ٙH-`Qkby@^ZUGlW?w@jeVLN(WCOa.GhyS ]cOL}5&wykKϓ n+z>[gxSM x UH))228}N'vYb"QXT07y90XCtc6P[i)"W(v nxi*ds 'A5cveBU,:xTDoAbnY|hIXR:N%}`cSH绥I{I-w5AE|AkHzl[8` yB饰TBֽwBK~xDځ qb+#e$dUF?m4Ѡme"W-/b°&V萆[[TYxn"{  }#'?pAN M=f^ġUT8\d.̑z-59ii{4bMF$\t|U)ʍz@}}kye4@m{Y 5ŗĴPB>TRs]9m^IoUD01P{ &M< zk 2D%UacL<0r1hQo.vPGl{ fB|}(|ydz6G>8I}2'i;"/=g4_WN8onBFq/q]VZa[zC^Wz&MRmr$==uy')?ȽUtjH cmbK8T9X% Hͣb15>x|"5$C3af6+ZYEճS'doWKaJ5s06-ņ[U&$v[{x,Uvo9ں2e% ~9.}Tl"'9&FՕkTD{y srޔqX[-dg*JP/?~*d5^֢ژ`8; X9V6_EthG0-D2v́LmzoKت&/aD3,Z7꾷NJ/ Ymv|.B:SᙋܯKdr Ae)PMq hoWQȦ2*dA۝%`x eGsxE/Afb+|U%e@f7xI D{bQks7.GeFPAn57c[)AUG3Xpz^+?l|v @E {ʻRzcsLIX⍿nw|J2۸_ZEkNrcjz:kִ2` FRoNv_>t,"H}&$΢O@AQMNj}%@һݑLefxIdssv<-#/EΨK \L2O"*lNKPiPxd)QuJ yj N"鷶펄Trx>*ri"(3*aMGT=:(ٓ׮YD1TO,~8Uj*9b!5d{Nn+&{J7ֈnEpja uZ#S_ժwyw-(o~ _{[e>}1pmGȢ\n^*eC{!|LcKǃ+ ps')?+ ,.k Z3 z퇨qYMsQ {yPœXv~X&=/G_&#}[*¥x q=j {KTbv:^8zzVD7QT{Cb*]E; h*ϸ9t]m ky&ǢyxL3 -w,/ޯQ%'aS8-p wUAȎоѰ5*iNq%0b?Fm4H)RhV(F;'y4&T¿50-'0f\B6IkyܢdDz4^WV《eNh^]#gM|ۇ wv.ܩ%揓ʛ@='|w X ZaS)T$jY̳KR^o0Ăxc3uܦ _qpܴ_aS+@n8j;`91f|2賎UUTإ(f <@Q$^I< oބݾ~2+jL_{ָ+U5F UlRPB=1Um -5G˰A>̲Ñ $Ʀ^ G{jCAB+OsFKGr$ !8ZQ~ДvPQg?"Ig}kZ6wv^&3g;?k}~oi;'"аW[w1k-0*$4`+ G.XOb$iU~IDZd(~; &=f {|5d;CcM]4BhicOnQӔj eAlm%ϑmK6@9h,4ڝqu&kNk e]CձfSX!7n_C`%į?Rf*ZnD. /ΆR~%NU{ǘH8LyҲt^ӝ /f~x؄{ݖֽŃd~8!]XޕX qPš<8ZђFB4#,ZƯJydRO?h /X =|kt@h%`Ħo{@hUeC+ h`tP:<JDS\ܷY:psٗVX *UtPҜQlj{攴 1`;^'cIi"ƒ5);oen`w=inA"@Q>x۲5Mu8B⸷WfXkzO=ubFy!cqSh*Wz:J]RDo/+'zJi?&`O c}AAK %J̭ ub?0z#ܩ~Njo"j)j±+"%I2 Ϣ1αZ^,ѯI{fⷾo?}4 DN 1)&ՐDs~roR¤cZBSD7YkvREM|GOhm#oҡ'1ųcȘmQ+wBZMǘ \Q GQ=Up!٭F J(TWT0@ec'+`N.a2΃"\RUJ, {md [i+"c pZ/š-xGpXG iQ\&|q$x}&0ЧJHH<+5}򼒛 `CМq=Rw箄&q 4UmVv*JRv;h~qE0dίƉ9 _҅AFSБ㘓kY NoPBcfH증ާ.0nP0J4KY6 m3G>-n+5M3OWt|iSw ~kR4A?$qo繐,_(qx|{B$BGu=miD 'YəXY ~U`B d $}^,~IB ` TzPCWRiqazz,!a;O^$@%8+sa&FCvۿ.MD̍Sj_YK ,*Y"ٻ5x%u7EW`O|}~ J7_)mD}j#.[zT}>ɇ-2腌R}gʅև Q`-Qֆ},΄Af[P5FWԝ g #>{-PyjvR/ 0 ${xve8Wz\d͡锡R}pjH% :5:,UUzEM_; %S9w 6ELՀfY-Kݟ>I,cSUi+[ɐTZU p.A9;9\Z?C5/wiK׸<" قeTVZn@F!њցC9nAi3Nȏ:nzωEHSG$O M;/hn>N4nPCvxt{wŰOǟc8~)vbl):,|Y ^)>A272N 7frO>=_VAj #`cX   8:Yg #q`-שiP@2%~E 50~^dvt;<4եy IxֱEBr>zl?|!H|oakKXv a7KL k7R@6; CnS.l(,G`G8jdڿ7;fT+ER&Bo3NZg$Oi'ݤg`}["GsXo`mF˔5fh]Q*,Իtbv0A-z1pA=A}Nvc03PPa-WjYt_l}3v?TWLN"h%᣿`:6_IK:R&t)bΈhe"fIe 2uvIU|vݣ㸂kk$S@tq὏J|czpNTGf8:y;& ma knM)tNw4B"+XIGh7n!/HE[A.{B7'8h:QPN~2h*5r]Zol + օi)n}u!莖ֺvK~-҈Ke4$޲LLYv}OG䂶5hF+텇UxkL3V6unqaO;폋T6JY[(O^{<Ԫf"qg+Ӄ{QrKǕ_}ݖ °}xo|Hh0bu P=8K71<^Ra?[O,a=rH>+ {l`UܵkC`~Յs(2kmp $OA@2e-ƿ{G*(馞>I"a]B9z` )?0z%. +cx,Q4lz֠EYV]0 c'"6 ,&OMRy8b'ALbL,3L u0(NmiKɋꫵ#ge;~G:Λ @aD%攸ů<,2"X/4SXj/IZm%3tcEuT_4|EO Pk^>3hWV)w/cV!;EP la?'`hphA{0hZq!wg|+U`[d K/lIn^3gS&;?ePUXg OtEdR=ŗa7E/e) 5TG@,E_=<ĉPxRcv*_#/iJ [NN6M͝U`,KYQ]y4-?lπ7b脪+whGΨm_KӭJ݌^OD4|:f}zL3Fo[ &$ua79BgB*|dxrlxLǓ1J/ &bB<Ǔ5 Q*A'v_gmgz$n= Ҳ>h0mrZF=Su|B+S:/U:$PxJp+癩PڳӎpPK ;Gp*MX:aOEm(@t?f)TGd a%Ug%s2in1oڴG5e&[6IPz$(J{i ns6T['#CW&Q6kXZ>@R ]4kg`Ƿ;!^)nKm8`rR}))!KW*oK}T?bsLt.Z8!Bup V/I( 3sʒ7o?-~0 z3^ \ 05` wވAn'l}ۀ&w2'bˁI~.}f-3&p?-m]|qc ,m*E.-o߻u)lќ8P~z0,?mYE;0VLش}lt?l&Bn*+z1|L)3)¡\nڔ[CG 㜢g>Uy㕿fH΋jҳ!2鴗!`!XNN\^Mn~QM}!B yKHʺhEȮugml_*ml&F7{\p ?n1Yj{rケmdRjoyz1s\KWbAĞv,Ŋf]{ZW*3Cʱ({玏řHt Z75"BqkY&q_=-|) `>WBmNxʶhJBb._zZ xwx0*:=RrRyc>MG40lO(A k:9l8:v\xր$sdsW-H8nAiee"gC :uh?rױV b!ݶ%F0%}fW2~:jS"¡~‡vIAӘ˥H$jb j#vsEP'-nIG4!7Zv0E|Os&Vh٧{~J^m4!T.̧ƀ˗;uCCv V8K9u'b o}:!z3-ri[D2+/9yKGWh+#m_w됗"ZOw6-Dsc+ǥLq'JD01)MZ%0@ύ၏9}mf<&r7>]S)uQ49w5Zp.u%.a7V "uƌ#XbAJ`tmR(Hdh`ֺ$Imܛ:]BUJ<`SOH3k V7 B-* !tN&e. R qc-1ߕs|l +q.Dgβ%_l)s uY[3܆zSQ?(5gT4](ql6?:3D<}S`{@hMrvWhk~SY8؎7;XزwuNl~+Ϲv"(%HSE0m戈%0#8$3Hs44N_ z?Rs.+'vŸ̡6,>z7`vt!1e&uaAQ0FxDW Jyo,crd+tz0j7mJBpN>:Փ˚4Y -CaDY#*|s9W׆ tj="4ǥKzA=HYn{Hk@% @ u*1N:evݿ`A.||6<~ endstream endobj 445 0 obj << /Length1 1587 /Length2 9422 /Length3 0 /Length 10467 /Filter /FlateDecode >> stream xڍP-S\ ݵC!8E ťE;kbšHq(<&3Ik9k:*Mm6)k%H cbȨpq89y99t0Gvt:= qC žl@Q Pvwp99ܜB!Pa,l Pc(CAnt2o(TF+&)'ltav V@G6 yW FQ;Eӓڊ3<0; Y~ P:cvӡ y lrv{ qwAOJ d? O'; 8ζ#!ֿ@G7S<vZ>hz>M|nVP ̍ {FiYZrO Y=7_ tـm~a¡ vu)y2f 899y WʎwoN}] .1@`AAv7BX`K-?ٟ ?C^c'q8g0k\1"_#㔖x|xl<<>?huH%g@fN=R_\'݂ ',WoG$@'_'ݺÞv@ Kj kz`]ru n`/&fe643G3Hظ89\VOۓ$pv+9[A/7?9zFk"p;C`O!6(+pX6V '񩵿-;p 8'Mr+p@.@^'$ȿq=e!psS_rB?Dt?( dub%j_vA̓mkBlnK?+5&'xz):܃)x!H5%U߽yV+)ɢhl:~\;]5=S/_ z]ïq_-V7$d 5 3f/ًGJDtXFkq7s>+:n]F$//Ǧ}wӔ|KcVr9V)F;U9_h[8 z1r-\k]HXl<=i4mE]EBYP!(5yQ'ċyMjZ-LIu]Ox ƌ2U|<=S&,)+3XU> _H*/YWKNE\uYز5D!45G_D)r,nD'ɍ7ϏUݝĊCb`n\CG$}?D ?97BwyJ~UB3W Ln2s;Iw\fZiloSߞP 0sz^pwr5tJVl|YOs1id_<-l2T~)o l>2oEɅ{=hdT+7fly?:ykӥN|JA[?W;Y񠽭 f}<&ۨ㞜 +Ķ$=7C NaTq!5*^wZ>M/p=[(zRo%HIjv%_oage0)ۊ2ĂL=OŇWZZ2ej~ ќKH J,2K& 03l"F=H+cAt S H8ҬoKwq&*䨳O[ݖYMYP3V08e޾PaQ٘bˑ[TgVQ–7[`;3#2e\ڽ'bwE2$;s z}Uu/:Rݜ@'F:X[_Ј*.Daa}W*@gknQj VŚJNROǓz-W.72/V .،bH\ۗou;+K95nu,}CITe*B:ٞ{lzQDnmc=-pc\qeMSdh$_GSWw2S8CFuuh8qm{7ḱ 9zמҁ3 "pm@Q T;dL;z1妶B0O_jyn#O }>lÂC0Wϟ~ĥ$o=dj5A>HYȇl(jPuU<  ʱ3 J,X' _SUWaXlS=Tǭwt1PaJv ̜?[>ֈ Pů  i>ŞA96 |y"A*|dQKj͇sHxk/U_)K‚ }ULB*Y1^pȹԤG g)>w%^u C3ZK&#+Ƅd %t{<ݑa=&sPpueʆɳ_Uug/WYQA/ңʯ3~v+Ꝏf vquBQV"xV?$?۲dU76qGULCuqz"aʤX֩5ddQ9*ߜZ2>FK_?pxSR$oj:5VH'9|̐|٬$^X6dcʫס 3]Wo6^6X6rд|z  :gǞqM*P,hrpEAr(ujhW9_Xs̠/,jE̍o_u,~ݖ O7, '˓5m]ur>篱G*Ǯc`7: Ϝ'J]|z2^=DES 'Xep8nNf?}#ƛ)EUa kPWp`irq13 E† r_ IrwU Yn[ gAj*r "/¸9# ?FҙK @ϒiԯR<]& D.J͊]qD'v)taqfdh,:Ծ`P=%wlPvBVm92Z >O rK xTA@ob|1s%q9FׁJ.JZ;MhD&id9_2p`S I/ncJ s>=ԧZv#TGCx$Io;ӻSvF4h.:Q;KNG_֗l|j)w% ]jcDm~twR>6Ա@BYDOS̘ ̫D!̞+n}81(6gpp3Ic^oZ,|O(d~5ZeL~D%pDgy " 9* {N^1DՀWu6Oԑ޵nH ?w/?dB;ȚeT ?8r n^q*EFh +pC'q }$VuYƷYR5[0dZ FŬU$ 0M  |^`VBrr>T6F B5qL_a8xD*iϴGu *A8GaeL$QÜ{Jc8h˶35\q A5ezp1 cMI#ۖSHkȤ 4Q S oXZI1fn +hMÑ֯ |urҎ n T}YsrzoQ:8*hczR`0 Vے9:354-{B[zAݬ([1>ՔojxxJlDs)J?"ir~g*#|Lƭ~bnƃg)"\wW2tϴDl ڱ0Us3AVՅ|G|Mz#>{`<572caANybF `: J 776a''"S g o\`7"DGi]yuТtB\f®dt &0 Y's_UNegJ i:< i"}yƓ=뗨R車 g^v4g҇d ױ56_5j0?'.|H+)ePQCeAEl)?. XO{LbY9a^}ŞQ[]Y^9-M1h;rWL=Ժi|kxXEc@P/)FWOj摑I 뜍&͐ ުF}Wvv[@w)Oxly~)-"kL} QlëU1[qӴ81(7 `ا̑ ZゥC~IY•MN\J"F}F2QAhu{sx-Џ|Wlo}ef&nRjX5ZM HdTx9-xoOU-%j+~=uGڄGvs 9=\"jux6`>B2.zz%|ǃx#hzp? vV|iڴ`Gѣ[ǔ1b0 gȴ{=LmC|߷so +yݚOh,ٰ_LLNѪcf6Ul/~&'~fj{Deb@@6r,,@^sa);ًL Ǜ|LaAOnkIu_^TŘG6)'t3?x|% <<cj~3^2~49B }܋P7o낏D/uG Dg[P[3dd8}%*G 6k9nY^77;1ұ=LFZB{eMzT/j,WRu;Sin[bCvWuH2nK>Om0 -ľΪt {Y:M,OEt'VfiW/.Ƃd&i`HHGv]sqV,J`6˽TwϧౕERNxFoS>,&:.M0:{(Tp>]F^k{ KH%XtPy!+K^>r.[iVq1[{h}8y=n: 1M-5o,*\+eodA.6M ?}ɎzRbWjBT|v}ZcᆹQ*YOI5 vATjlUFMLO-p 1x5x`CsE/ 1kE k^!nM]ZgGc6aUW&:HE֟7 ۘ)$s}.P OYBsb!H!) (C8}ř؟k|F٪GPg`Lw8LY )M!E8A DOwh:$(E*h™Hi|'h 29 q#?2&%lC*i{ۛ'L1fn{=kӞqkS\ uȲɂ56$Wg;V,A#UU8Hm,ߩJ+l 1M6׌f:=1%ľ!ݴ7ylcBU~gos'Lm2:Y6v'ޑ+mg&Ķ]hܪAx^2ZxOm{ hrj\޸Y}|]l=EC<[a@A]y_Vli!ig ͡\18%[w7JxY ܮwr\|.#78GAHєOH$\q j2tsYb"Knp7Q cL["2k4,Ka{lJ;j7/rr=7r%{L喃qJO3OvFt;yFX_JѵKN9rϜN`3ϘK+xlS%fȮ<vo´L$8d JKGlѥM8rNOImkN9'zhս tesW35C9t'ǧ@Fr kX֍d IyYVttabV~wr-HM>߶]۳mݏs:SZ8"r^ H|Pd\ҧQ˜y>!L?<Ȼ?@*R`*ʍZ> yz #,2 qzd}W9׺+Ǐ/$-F+,՟f@AgPEWʕC@cWvg]|Ԡ9,ܪJ Ȳ SCGc0"REUQ&ks~>Z?KQ*kS &oZ#'x/j[|{a6 yR*|=bE/fJ ^8P67)c*sy]W?׫8'y;]gc'({`(.]+%ӷ rm eaOEijhQ6A {}PءJh4K0Cf koY֞VRskH}0_v!ڏ)\ @tXuU]/&aIhj (fqk#Y0kۤ#%Y*6%:YeVvw"p益oʛU=R@nJxWRwJ NtO4A߶3ڞ^๯0q'Bnt/zhDŽp25 \hv\ 8ӥ$+^w{rs M&|lв'HvrNvI4dq__o Рc^flǕpf8-2d6Cŏo51|˒P\A_yi'[<88 |{Fb%`MHw͝ m$P"MYs 01&#u'd<,TW|q„C0Y_eo0QIɁh 3G5vQ!C29{^?i~ïЇ bIX\%_|е *< wˣƦjqx{i-PTLRc_~yPMGWTK}b:)1A8 {83vԓMe0WhpZX9(s$nt8bcگ'7 +riSEA)]0S =ڻuP9w $GZ6H+wk7jբޮZ\ /ZGԙ?fƿTSW7nƾv)ҟ L4,N;M_Ԛ򱲦;{c\3MS7gFhx[!Uf..ba|&r7j[ ϾU°v!E9"_LZߐq]TNn$WU, endstream endobj 447 0 obj << /Length1 2471 /Length2 10769 /Length3 0 /Length 12201 /Filter /FlateDecode >> stream xڍT6LH C7J#%9C H H)!!!ݍ|95k1ϻBO.a3 \)eMM.n''''7=&96AA4a \\<.~a.aNN7' apa4bP(`',z)be&sf_ {0bA`{DFs@f;{W&Qkgga ͍d[=gfA`'0l2OkXMk  vs0  y%lpqp߁ пA0{XBY%gwg6jdC\A;AY 5?9!NN=A,ۃNX듆=-@-,aԂB] DX2+3Svͭhz8Rr#zr9,m} ` p}T7X@̝f`+>:B #qp"Ə /#ĄYv1PVA^CEUJJ^\vn^7/_QTAZB`?3L3c! `sCN>NsaoGV$bgod1.ΈP!6:Wlq_3 P+8Bgsfo=@0'?:r"n'H#v3@aAXIxq!P3` c>R~>PoJ#P H p"qr|yx@{ȧt"߫ "=BTGԼGEB  {%"ٿ '@3^ 2# ?x=*avs رQ",H.,]ZB\[ s3j`  ,C.PSu7}YQJkDĄŅjDĻsGߧȋhqQ, &?.0g}q!pʅ(龯|s'čoZDNv '?B * q?іD qDqw2q@wnl"fD$O0 2w#u!A\a_ͱa"A6/%Wyq:N0tVdH]^K^dOJ_.<ο%5N &jD4[f|*v½Ңo"گSr;a&fs<\Kݔe+=/Ggx.DPJPDjSdh<ӑxJˤ^nB6dbIčodo2$LO̜~FYjn縨< ~^y9PT̽9u($;d/-4bjꣃx\er1<:=mY̼cv_B3Kܧ=ʚg)խ2  s'aK( ƒ&a"VNՎۂd\]Ok\!473c>E'^uoGJp=gNP+[{70gjlb4'-*N4(\-薑 `:[{:gVJ e-GnZt.8]'"8, =/SREv΅Y&9bOfi m 1<2'\oV>Z=ӆή`)e3a2DkN\En?XnXHYC{7 2UB6e-3fD;N^alwIJ˭<%, UI^v:t,eR_O mNb0/cmI2QVmGu'׭ b,Ei[: 'vE+dz˲&3b]_Gm4I~f;щUxilTC!'j.`gTIbJ1zC0^T&힞T5pz!B8@\@"@`>he!WwKIpF#tU*rh'8;vHQ$e,ég%#:?27VlMGA_ U5Y)7ENW y^\ZЦR(w|ٛJQKk7Z)(P7\P]~t%f]@#v dm[;2=>JK"is`X&q,Z\5&c\"tPnD4:Qa.Htb*o~#18@;4y(R$#풒/1FϠ8Oj[$zgvT9p39Oi¯ ׽[ sqJn{YE=/\R a9_U# C|U?.[2 @@2{btؾ2gHeD 1Z#snbQ Xu'7΄t"Eo8ȟٲ[&H<up$#v=;u=0 dJՈM1v#\b9 PLC^B& n˶6hY~ 2@lL7هitk.9ƪ$k)"b 3nvAD Bx˴T=sL8U JpcrL.g +)kА+cyU%k_|Qg[+ooޮSs'B$\7=ݢuҲtH{*O ^/ڇm[XLa$DvqqUbc"Ru Hi;&(ݒzW!^nBԌ_sh<<2d'Y(+\tbB.Z`kno9wU^Y݂6X36@E ?4Hz78өA֫P832 FVWeA>&["$WoʹV堬9,QBO$&}/-ΔX3v闚7bsɤOi, FzWlN~OzoL"[*2W~`I6FSz?X5}[䳂$S[j|2I;4|(gDQY,+F,&W;7i`ԤB(4oSj<0a{!00 ]Qbu^J*6ێj@B$}^o|LCo)=1re΃S{qypoOloR-Upᷯښn],sP9Mb)X{PQ'[yQ!3FyoTu?&7SL! YłYC+=oM7[6%|3)B,ZTU]z3bP6j5F"gl֠Sz6ܸGL:#w)ZkI>q|4ޤtkN}4>ecPi D^e^@8Mˌ2"Y<^s=$n_khW}FAzqy=bK4QVeL:\29se֪dϿ^*V3! Ɏ*TxX_O€,N"y3B%ǃqM);F/oR'C/*Sϐh'?z?MF̗sŤA8[c$BT cWG) Я2!%Qzm :" +]Y[xvQt6%ۑ1,JZ擀6EMfԡr1ڇSruŻGe`sZ;8Q>AnCW}"i#N5R;03/N\_65[Z}ɲKI&y&3e\bIҚp"ٜ}:W99ԽZr1S93}4 F,=D Tְ *;*_h]`b#4L-%vDG.)6ɘ!T<7R7OHoL?WMS^k-sI&aVm6mc;I>Dy.2蔤M̶n(Vfe$hxen}R`c`oU0l؜lx*Oe9LNHMq hH_J._qVX(,k׉jV ^l2WaG[Ś#4֔j]>EZnj*Q|G,`}J yk?EБK cE.8fRL]*jw UAHxsȸEHյN>t-qXoF\mu)`3Y"BACNCMc=r95B!ڄI-@VҀ^Am{@} חxicO ֡R4\2Ҵ+\]m_\wmLBl42*:Sc]>!rKk_*5bwI?6`5$~k}o;RCJ6=e9,6?A%dHL'_P@̽>+,4D~T͉ARJ'v&nQTJdDE0>5Ə%h7#n⾅3_}nKd2#]^GU"`L;(9j!qZdW٢LiLp]p:k(n!WsfU0 az0!uf-g3 IP Vv럲rhwn},'Tamg!dVXyv[,:jl QA!Jlӷ~^Ñ#![o>S?^=,J1HeMD]Ve#q lG/>;- $ D}w 7BSljKh "ޕƫFby(w.[А0V+NJO)Kq WM`sD=7Jhy Er4?q+D>_#VÀDckrs혴ΪҺ^$yEޏgNR^,=s'q )|D$-Yަ65" l~P|'Od=u:Np,nFpj23T[dTpX#Kuw\^ȧ Z2&3C8G8fmL~|w|6Pػ9--m׉D jՕI2`rQۈc cK '7e*45h-fcuJ Q;`w@xIk ,kw`cyK*{HU͟yZ*Y?Y͡cryYG wW ʳt13di@Wmlw9Wo3^TwB$`k*r]!1n Oy]"n|D.P]PƜj؀P" V ۓS~3}&6Ʀf+#:2:g8B׋1a\.ΌtSw#K@BvCcD2O5!Qy ymx`p?iah/]=hl( WKDg,'p]Nk&ʓ dz2%St\dlU񉈛ʳr0&p7([ X.t^  :QŒja(чn[V)r2a*RC҇cHL´вxiE$97Il*|x,FBTH"jJx3_2I^P]UDF eO |'Jj\Iۗ {k= ǷVn"@jP,y4cA}eZcz;^ۨhp?}dY)ûi:ǚyx좓ٍ,ޤ꺗\-v NŐ֘U^m S [ _@xls4i%?qZ@"\ƞ]5p%s ] j\&y(=P1̠SI[ݲB")=+l|Ie[:zvbS:|Ny}rb*\/VaJ:mq֔LXBz Ϳ`d|ݠwqZO]bMd-4#.LWDwRR%*y "Lr~e yuƦ䗨e JtS %l >- %wM.}IM綎xB ~R-8J1 >Qlz&iVH4(r<GULaMB}uF/ˆC:)ajѫcanμpӥ(e -|5Ft{}&KzKc9aꃃjbZZL >&@MEWFXLTQ9!B?{YIH2x>}%iKy 2oэCk#Xhs ŗt9fc;ғEUSrKֽz4atߓoKh2jE(Yz_i:̟i\Y,}?]ʊdAKRO8u4BmƇnHܝBq<%I PJkahZ2鱣(xfcS<6 HoJ%A^ސ &XʯM!GĒ\p>Zԟ> cZ>k[ T"0E7^蔶(e bd)Kͼ~Lhm_$dO^j&10*\^] IU\^Juu:yKmq;TbGP?BC;*!3UΏ듌멒n"\x[*i]{M٧9^P"u^eW`+Dĺ}ΎvyNѲϗy^WH :6B#Y0]t&I\)qjZ[U2pRgt0IC7hkq(K}?]V67 !aW (P؈G:Or[j^RMV!W?eTyFnƒ0)LsN%(R:|7[$鵣*AMT=Ip[8LqfOv=WF(?ktà&* A?U7 @q?>w+_GN= KUxܷy >ߢ8>lʎMY tYVg|SaM [W>;8m9?ЅO};Ȯ6K~=pmzC ^ w9%Ax\JF鹺ͦaʋ;f,S5H'O&YN"&?W ~=gāfW*bTL6?ŢzeⱆP[xrh󂆚q8G] a%#7nQ;e:)⺫eKkB6FjS{FTv9/*Lns'H;gѠG)|9d g&.tYͱA)>^s\Gbc48zXԱ͞o] ZZIOjm ā??}cu:]dOyJtq|QCXI*^N]FKi#ßE4FSM ;mEhdf-蘢1{f*&o嘵XQlj8oJ%sO NP?H?.%)|08_ ۫cV3ew/lMiOlT4ѝoEc 7Jh*] S*"ݘit ֶ'dRTY&= ,:ٝ*+6=i?0ZwYo<] Rh N'v}Ѧw-?1VW-H¸97 endstream endobj 396 0 obj << /Type /ObjStm /N 100 /First 925 /Length 4563 /Filter /FlateDecode >> stream x[[s7~ׯxOY3Vv+kuF2RLR_50Cpe bF_n4)BPBPH] eB@Жw<{̛BhBxm7T*_H+ uUЂXO܅(Б UJXhh&L*Kj@ cU񤂖RZZM+/lPUdVp:N.T@+[x!Ig oIqMb'T 'UY"_Ov" ARPLe:zaVP/8 Z A ! nBHSY rdhp^O@ Otf$KURQOcAi&50JzLdGWU9Sx)uQNDaX)`A 2X"n]YW vADO` PU7MSRGFo.Qʒ] 5(O?|>\0Ll^NÊzDޫPN_y8_s2c5fUpD<4ޫ:*7O:GVp:=)̡-EuFpNaAVXeCƉI bkeZz'd?kV@ڦo}xNblx|Kh: W6JTUN͐U1dSa╒/}UW&K`x?l`mhvǦ"{~slV7sQ؏m flCj[GZO9UڳZ%Hq<6(~N elM>[VޤumE$6DۭAKV|l0Ѵ##tp|ʫS6|(F I&pGp |$rx'"C *y2M7l(ߩ֫jXQQ|y;QlrAt.+:K괞 '|0z\O/>ѣ{`z2/fuAO廴HkJPe? cs[N^={$"GlQE *|[0jQy|P>,*?i|^Z(U,OWrR~,Ol1rRu OuyNT~S=/YyYt^rAUy5>_ޒ]|]SzԲ\wb~)ӲRYUU/Hk<~;rͳ1(¬+Q\scM%r<#D/ 8Үj;~[2FUca6lE| 1Ci4n@,&d% .tfqr㑱k) ڽ X՟'r:\};ـcw ~5^>8c!f4ߎdW8fFr?$qNc#\q`'''8^HsUn<pp!|Zwv,S{%??x+XGT e֖Ï_:y,;yXHPG8|%3NqxlRΩp4hФ)|'nڏKky?E-fyhŭ4WMV__~|"ړqgtw%iɃF]=U \ԝvF|9(׳jM9r޽~{–L݀{a΅a޼ZN/={7>xS&U5QF|Jr h:yiPJࣖcai&t+gͱIuHMc+A?yc5uF}SvIaS+7Ur⽲գ_)aEG"'|r/[hyc(xUwwov#6y1KEZ/^fCg%}/}/ބx7]rJ]/z~]zU9~+Q_V&[|җo.[/{ZїtJ-B_oE]Iٷm)J{ViC++Ⱦ|w}zD{ R_B/_8f^L.U'k:DeM0'3|*w/{`͢w~pR&z=4IDo=~PN vxJ%:4iD_aFe%^#F*T_-C\ p#3fٯzEڅ<&~y%ѮiVNwJQ~FX٬{/B7ZyiZwL ye?Z> ^:Jo;+M >OJB h+U= w 2EP|m>| @Z]fed3`m!vp%tr`e݅ͱty>oK"ɞp p+m7-x0״j|C nvM\9nֻy*x'F6nV]en0P+ceh­q62{H- rn-p7G:`DǾXq"O r EЃlE vO6pG&ڻ2[}䘯Stpqzd=YW||XP.ETp/egz9]h>U l(4U>GFd66@Q^̆hX+9{ X8 lc G*`j4[ Mѝ"U?N?5{&aЩlbrw1t9+щX$:ȸeL-6D5Peg{,NO/Rt m`zVc1fݖ)iWM$!*.JvşQnA T-)F'P2;D8),jH$7?3jf`{" cWo?R.Qoϓttm>GCDi_˔#2 ;Xq&blÌM"fVZ['1:yAI_\7*i_` endstream endobj 473 0 obj << /Author()/Title()/Subject()/Creator(LaTeX with hyperref package)/Producer(pdfTeX-1.40.18)/Keywords() /CreationDate (D:20191029193344-04'00') /ModDate (D:20191029193344-04'00') /Trapped /False /PTEX.Fullbanner (This is pdfTeX, Version 3.14159265-2.6-1.40.18 (TeX Live 2017/Debian) kpathsea version 6.2.3) >> endobj 468 0 obj << /Type /ObjStm /N 5 /First 37 /Length 230 /Filter /FlateDecode >> stream xڅMk!9&՝ato$MN% ]su!0Ґ*uB+Y6la#|a[@:h&,Q$/J%,Fw Vzy`ey6ec;iDҽMg?^bF2?'lӟG/S?wSL.fXj1Q׎G76rŸnE endstream endobj 474 0 obj << /Type /XRef /Index [0 475] /Size 475 /W [1 3 1] /Root 472 0 R /Info 473 0 R /ID [ ] /Length 1190 /Filter /FlateDecode >> stream x%MlE甖;^Ji/-QZ ҖRO-eab$# ] q1&3&wQMİ` 51FcbtQI>/'3;Ιs9;8!&JfH FmhHSD&M ZI,؄օ6EZ6 M-hChŠmVP66NZΡ'hHVi-CۍvlGkF!mh{ю6hhIw]h'цIiC`,i hE;6Hxer i;@S HNn^~EZ5c|ES%Ub^/GLsEr6K>u^듹:q ȬgYpsXe,L+Rt6Dԏd,%K]gQ'u>8Qu8Q'GGn4s?y[xehq3ıbOLqqx7qlF]\=eh6= 1Ut7`{b_ ;1`c4sE=7# EqX3w{E~A.b"] ZS_zqJhI81N{t]$KE  折+⿈"j)8,YL9 ,ucg~eV;mqRë"y@Fʙk Bz$?Ҕȷ o)-/7%(@`$ 6BOUi^[+ol'j}oQc8@TTZi^x17]2&N endstream endobj startxref 774684 %%EOF affy/inst/doc/builtinMethods.R0000644000175400017540000000167213556146132017400 0ustar00biocbuildbiocbuild### R code from vignette source 'builtinMethods.Rnw' ################################################### ### code chunk number 1: builtinMethods.Rnw:39-40 ################################################### library(affy) ################################################### ### code chunk number 2: builtinMethods.Rnw:48-49 ################################################### bgcorrect.methods() ################################################### ### code chunk number 3: builtinMethods.Rnw:99-100 ################################################### normalize.AffyBatch.methods() ################################################### ### code chunk number 4: builtinMethods.Rnw:175-176 ################################################### pmcorrect.methods() ################################################### ### code chunk number 5: builtinMethods.Rnw:199-200 ################################################### express.summary.stat.methods() affy/inst/doc/builtinMethods.Rnw0000644000175400017540000002456013556116173017750 0ustar00biocbuildbiocbuild% -*- mode: noweb; noweb-default-code-mode: R-mode; -*- %\VignetteIndexEntry{2. Built-in Processing Methods} %\VignetteKeywords{Preprocessing, Affymetrix} %\VignetteDepends{affy} %\VignettePackage{affy} %documentclass[12pt, a4paper]{article} \documentclass[12pt]{article} \usepackage{amsmath} \usepackage{hyperref} \usepackage[authoryear,round]{natbib} \textwidth=6.2in \textheight=8.5in %\parskip=.3cm \oddsidemargin=.1in \evensidemargin=.1in \headheight=-.3in \newcommand{\scscst}{\scriptscriptstyle} \newcommand{\scst}{\scriptstyle} \author{Ben Bolstad} \begin{document} \title{affy: Built-in Processing Methods} \maketitle \tableofcontents \section{Introduction} This document describes the preprocessing methods that have currently been built into the \verb+affy+ package. Hopefully it will clarify for the reader what each of the routines does. There is a separate vignette which describes how you might write your own routines and use them in combination with the built-in routines. As usual, loading the package in your \verb+R+ session is required. \begin{Sinput} R> library(affy) ##load the affy package \end{Sinput} <>= library(affy) @ \section{Background methods} You can see the background correction methods that are built into the package by examining the variable \verb+bgcorrect.method+. <<>>= bgcorrect.methods() @ \subsection{none} Calling this method actually does nothing. It returns the object unchanged. May be used as a placeholder. \subsection{rma/rma2} These are background adjustment implementations for the rma method \cite{iriz:etal:2003}. They differ only in how they estimate a set of parameters (generally you should use \verb+rma+ in preference to \verb+rma2+. In both cases PM probe intensities are corrected by using a global model for the distribution of probe intensities. The model is suggested by looking at plots of the empirical distribution of probe intensities. In particular the observed PM probes are modeled as the sum of a normal noise component N (Normal with mean $\mu$ and variance $\sigma^2$) and a exponential signal component S (exponential with mean $\alpha$). To avoid any possibility of negatives, the normal is truncated at zero. Given we have O the observed intensity, this then leads to an adjustment. \begin{equation*} E\left(s \lvert O=o\right) = a + b \frac{\phi\left(\frac{a}{b}\right) - \phi\left(\frac{o-a}{b}\right)}{\Phi\left(\frac{a}{b}\right) + \Phi\left(\frac{o-a}{b}\right) - 1 } \end{equation*} where $a = s- \mu - \sigma^2\alpha$ and $b = \sigma$. Note that $\phi$ and $\Phi$ are the standard normal distribution density and distribution functions respectively. Note that MM probe intensities are not corrected by either of these routines. \subsection{mas} This is an implementation of the background correction method outlined in the Statistical Algorithms Description Document \cite{affy:tech:2002}. The chip is broken into a grid of 16 rectangular regions. For each region the lowest 2\% of probe intensities are used to compute a background value for that grid. Each probe is then adjusted based upon a weighted average of the backgrounds for each of the regions. The weights are based on the distances between the location of the probe and the centriods of 16 different regions. Note this method corrects both PM and MM probes. \section{Normalization Methods} You can see the background correction methods that are built into the package by examining the variable \verb+bgcorrect.method+. <<>>= normalize.AffyBatch.methods() @ The Quantile, Contrast and Loess normalizations have been discussed and compared in \cite{bols:etal:2003}. \subsection{quantiles/quantiles.robust} The quantile method was introduced by \cite{bols:etal:2003}. The goal is to give each chip the same empirical distribution. To do this we use the following algorithm where $X$ is a matrix of probe intensities (probes by arrays): \begin{enumerate} \item Given $n$ array of length $p$, form $X$ of dimension $p \times n$ where each array is a column \item Sort each column of $X$ to give $X_{\mbox{sort}}$ \item Take the means across rows of $X_{\mbox{sort}}$ and assign this mean to each element in the row to get $X'_{\mbox{sort}}$ \item Get $X_{\mbox{normalized}}$ by rearranging each column of $X'_{\mbox{sort}}$ to have the same ordering as original $X$ \end{enumerate} The quantile normalization method is a specific case of the transformation $x'_{i} = F^{-1}\left(G\left(x_{i}\right)\right)$, where we estimate $G$ by the empirical distribution of each array and $F$ using the empirical distribution of the averaged sample quantiles. Quantile normalization is pretty fast. The {\tt quantiles} function performs the algorithm as above. The {\tt quantile.robust} function allows you to exclude or down-weight arrays in the computation of $\hat G$ above. In most cases we have found that the {\tt quantiles} method is sufficient for use and {\tt quantiles.robust} not required. \subsection{loess} There is a discussion of this method in \cite{bols:etal:2003}. It generalizes the $M$ vs $A$ methodology proposed in \cite{Dudoit:2002} to multiple arrays. It works in a pairwise manner and is thus slow when used with a large number of arrays. \subsection{contrasts} This method was proposed by \cite{astr:2003}. It is also a variation on the $M$ vs $A$ methodology, but the normalization is done by transforming the data to a set of contrasts, then normalizing. \subsection{constant} A scaling normalization. This means that all the arrays are scaled so that they have the same mean value. This would be typical of the approach taken by Affymetrix. However, the Affymetrix normalization is usually done after summarization (you can investigate \verb+affy.scalevalue.exprSet+ if you are interested) and this normalization is carried out before summarization. \subsection{invariantset} A normalization similar to that used in the dChip software \cite{li:wong:2001a}. Using a baseline array, arrays are normalized by selecting invariant sets of genes (or probes) then using them to fit a non-linear relationship between the ``treatment'' and ``baseline'' arrays. The non-linear relationship is used to carry out the normalization. \subsection{qspline} This method is documented in \cite{workman:etal:2002}. Using a target array (either one of the arrays or a synthetic target), arrays are normalized by fitting splines to the quantiles, then using the splines to perform the normalization. \section{PM correct methods} <<>>= pmcorrect.methods() @ \subsection{mas} An {\it ideal mismatch} is subtracted from PM. The ideal mismatch is documented by \cite{affy:tech:2002}. It has been designed so that you subtract MM when possible (ie MM is less than PM) or something else when it is not possible. The Ideal Mismatch will always be less than the corresponding PM and thus we can safely subtract it without risk of negative values. \subsection{pmonly} Make no adjustment to the pm values. \subsection{subtractmm} Subtract MM from PM. This would be the approach taken in MAS 4 \cite{affy4}. It could also be used in conjunction with the Li-Wong model. \section{Summarization methods} <<>>= express.summary.stat.methods() @ \subsection{avgdiff} Compute the average. This is the approach that was taken in \cite{affy4}. \subsection{liwong} This is an implementation of the methods proposed in \cite{li:wong:2001a} and \cite{li:wong:2001b}. The Li-Wong MBEI is based upon fitting the following multi-chip model to each probeset \begin{equation} y_{ij} = \phi_i \theta_j + \epsilon_{ij} \end{equation} where $y_{ij}$ is $PM_{ij}$ or the difference between $PM_{ij}-MM_{ij}$. The $\phi_i$ parameter is a probe response parameter and $\theta_j$ is the expression on array $j$. \subsection{mas} As documented in \cite{affy:tech:2002}, a robust average using 1-step Tukey biweight on $\log_2$ scale. \subsection{medianpolish} This is the summarization used in the RMA expression summary \cite{iriz:etal:2003}. A multichip linear model is fit to data from each probeset. In particular for a probeset $k$ with $i=1,\dots,I_k$ probes and data from $j=1,\dots,J$ arrays we fit the following model \begin{equation*} \log_2\left(PM^{(k)}_{ij}\right) = \alpha_i^{(k)} + \beta_j^{(k)} + \epsilon_{ij}^{(k)} \end{equation*} where $\alpha_i$ is a probe effect and $\beta_j$ is the $\log_2$ expression value. The medianpolish is an algorithm (see \cite{tukey:1977}) for fitting this model robustly. Please note that expression values you get using this summary measure will be in $\log_2$ scale. \subsection{playerout} This method is detailed in \cite{Lazardis:etal:2002}. A non-parametric method is used to determine weights. The expression value is then the weighted average. \section{Putting it altogether using {\tt expresso}} The function that you should use is {\tt expresso}. It is important to note that not every preprocessing method can be combined together. In particular the \verb+rma+ backgrounds adjust only PM probe intensities and so they should only be used in conjunction with the \verb+pmonly+ PM correction. Also remember that the \verb+mas+ and \verb+medianpolish+ summarization methods $\log_2$ transform the data, thus they should not be used in conjunction with any preprocessing steps that are likely to yield negatives like the \verb+subtractmm+ pm correction method. The following is a typical call to \verb+expresso+. \begin{Sinput} library(affydata) data(Dilution) eset <- expresso(Dilution,bgcorrect.method="rma", normalize.method="quantiles", pmcorrect.method="pmonly", summary.method="medianpolish") \end{Sinput} %@ This would give you the RMA expression measure, but of course there are other ways of computing RMA (chiefly \verb+rma+). The true power of \verb+expresso+ becomes apparent when you start combining different methods. By choosing a method for each of the four steps ({\tt bgcorrect.method}, {\tt normalize.method}, {\tt pmcorrect.method}, {\tt summary.method}) you can create quite a variety of expression measures. For instance \begin{Sinput} eset <- expresso(Dilution,bgcorrect.method="mas", normalize.method="qspline", pmcorrect.method="subtractmm", summary.method="playerout") \end{Sinput} would be a valid way of computing an expression measure (it is up to the user to decide whether such a concoction is sensible or not). \bibliographystyle{plainnat} \bibliography{affy} \end{document} affy/inst/doc/builtinMethods.pdf0000644000175400017540000046425213556146132017757 0ustar00biocbuildbiocbuild%PDF-1.5 % 120 0 obj << /Length 912 /Filter /FlateDecode >> stream xYKo@WhK/R71E;ʯgfqC`{7ޝ3f2=9=S #t4)udd ~ GL*> stream xڵrί@bv^;*JىR%9yII:M2C}5]. ک t{頌nvVYTfvy=0׋.|z~~a=tߛjj7-ML2[_ǵ_#`2|[uiwHO]h_ϟ Aw}/Dwa`&X 0ayz2}8\= dJ3grzBDiYj%\$[U5!m6„6L*Ft+ ~A*jtFJW<r;4]zMgfO|+ZW x+PeJIdjT}lt]HKT~(u HCքX2<$/wdkB(t|1z~'Ι:bCG^?3̙(ފ Lj e{u v~L+o[Szt`=idk/ZG~T u1BHG2t%!yq]/D-#Q9{dc.GnۂɨKTɤ{՚l]%ÐחAE%ʍ -.  ,Ko,U@>c+ڤ8@ۚoD{W(q9A[9|i.K50T۪V3FRڛ2Nm`1;H%0o rܿMtkeفb:ތ q(1!l%?Q*''Ɣh1Rp2?ͶpCcSX[ݟLR{3!^SC4-mQV7 o \CP *r%%&dH>(ǰQA՟W+A(6֚vv5a6_իkNYWG.S_;q ׮;BFi/UQn&Ѻ$Z%VZ=ANRFXnPٗvQhem#=DkrYO⮴}Z2MD],:hNkk,Sp{HHbTTkjшxt+0ʂ@:Aλ?=CS 閊W # )rd 8Q)pUWdso!eBzkZ6,9كaXix/^>2c WQ,ۢCT ]`N:Ῡ^J!j7]&cTA8majN?9'hۦ"B" rIǁ3s6 sxF@U勜 o>; U/8w7sM7b:A /Uz"116"zW) XdW| }&'c=ø{\QNHPPCƀ\吏uH><57ىnmBKaRϣd rd˕\ȷ C: P !"ȡ>ϖIԎi2^xQyH6!S3Kdv3* ˞WD1*.V\]acߦKRfW h\+A(gnc'Ͷ)M15v=YpUąQJq;: k $F5 C嵌<dV!&J!|;,>IhS]L0{i v=%q4uOc QKLQ`~0? |P<A+שiЕ5:B0ɋqb ~ WiBIt &Ӷ9+ ڸ OV= dQv1ףR͏HM%Mj&Pzo ,<{?6~.}6˟|Nxl]r+`l( )vw7$c'"}G_K //!զ.#^1P endstream endobj 155 0 obj << /Length 2790 /Filter /FlateDecode >> stream xڥZmܶ_q0P@deE"U&64A܇q {ڽmλ՞kw3CRZ~8DÙÙgHyWvfsZ_uվ۫*]_\m\)Um6W+k:xswJ{?}jEw# ;Czįwa {p}] U>2 1ڊAS6Uo%]5Fݕ^P` o8Naht1!{0#AFfe C(sxz;dpgf>^m57{ ~N>_aFQ*4b8c ,_FN̘f';id Ѡa[֪.*xUV=yΛf.q=".ȳGHAϠ/̾/yl`J>@ůKF R=)|۔'# [epj>OX2Q c:Ic lc@ǁR WkZ׽gB> G#~wGƀ%tH8Z3ǵ 5 NBQV}yˑ$ɻɁYNgqRgxDTeާ^h oI6 Kq|niEz5@h]ٺ(԰0qn>D3`$/WQ^1:wYi@uczG dḎɿ1uCUF AM-9РFP1ئֆtU?T/ׂ@ d^rvm`7G3; aǏ,M]#$e)ࠂ(Fq>Ju"iql`_䤐@}Lk13t e /ڶ{:RMʈ?ףyhv3 2k|MJ`4&Lap1M^oEzc; K?7 k R]NI2TҚ_N"p&B#gV̅2<.!@!=| dH|h7J(~-qpf+aHkSӫ8dgmxQ)f\;㑥`Qƙ̲DIv1]ƙ3w U7[ȩinTBߍ=dyCfA*i rYB0wߋ®4v *=da?B,w4 kI#Id\5)@< L!Mۗe= }e3Xo:rTm{ch :W{e>mk"Nw6Up=ֲ/>ąK{0SjfF\mswMKr9ZT;w(?·YN(*"z}BҁdӏB8=ka}.vNpv\ߨ ktT)RqX-l`B &ىk'UJC6 cO €.){[+e$n,{LB;(U6"&YNy^V˓Wh(~(u34v/;'ؘoTx*EG[BdȰ9D/Y'~AR,Ч'96va̅.»~&:  |ff+a=⹝sDrZ qT,љm3ŧ:.̨pHW ?,w^?ZY9@k b~Ju#D&mYbU^6_stu]o)fYuBLc8u>n/J(1(B|9`a:˚ZO*:U8 "2Qg٥Jd·.kQ6a~ 8=i:Yq%><ӵпо%r\;ם@)SrQ2Ab\:P|_|fm|8.^*kۛ\w endstream endobj 2 0 obj << /Type /ObjStm /N 100 /First 786 /Length 1864 /Filter /FlateDecode >> stream xYK7W1Yde ^AִB$Eg<ִ`w@d՛b[$ @lDb L ~e!s\o$ Bы'OI>G$^,<G}x{>B ( \)Z B/ bB)2%˳(A(擮<9c2cSu`L2֩8ˎ @B#H\F_@ a( g`E,^7AI*~v` E<9u *!W&LmRi@3]Xy}T>::H, sЋ "8 CK3t,; C;QBqy`(ЊU8 2Kn&C,C!Ņ3MDup0zN3h)j`Dʈ BLҽjYE zXR̪*5"v)5GGf.e1-}웟6sߞ$vgůnuۿvٲsMiG(y|wZJV:I/~闫v2~׏쯇YunUUE=wܒz4BovlG'ݬYr|AnY!Gd?›uY}b.WT8Gp},mGhy# ʼVݻ7~۟*kZ4_5i\f 0@V35ϗytּpRr~Κ`-*u xzzֽ ኻ{5l:oE|nCr:\GWG_GcccccǕW~\qǕW~\q~{ g5`󿖛_gͳn{ngSÅ^*p𵋔&J) *I1h=@=='"&#k!kq)tRI &YX'aRLΪh"V*'K2=&.XAhwmZP:PYNr/Od.$  8F<֣,Wk A 2MA @c48%^9h_hRP(g`"Kⲱ2Fr$arIӮ!Zy;o;`2<.4&d]IţK2}w ׍(Ě?^L3g3ZfgG ښq x%B8 e5/1^)C%< qbjgB%ʸ$arA0yOQ4`/l)Y16zWS0H08a`l9A m+7I]QW-X4/U ,)҇-_B]Оyu~Ѭ @΄ŕ3'ʼŲorIWO_}ALnD[jyDX^gt)\o) >?S|^YŃ^R- <||#A4$}_~/|C굆k L%Stz/"?mo?<;5T7hP\ QMB^C@xqrV?#p,TPX_@ڧdƖV#~(~䯗G 8Ś}8ّ7yȋN/3(}q(h\ue 2C oi~?w? endstream endobj 173 0 obj << /Length 1874 /Filter /FlateDecode >> stream xڕXKoFW>Q@Đ%y)  EID[B,e;(JEv a#dSQ' N}43"̔h-aB%i# Bb3sdM!\kj<-);7r?5_-p;p?|zZ! o HP*\@Œh6y=M wvZV|Z'{9lBMP3BN D־"vl4p,GM1o. !9tHl"Zo а'H]~h=ߑVQ| A.Ջᝄ8QK8He3l'TqMj Ӭm7(1վC5ZJ:P;M'v]Zq}#m *]H*M~[ W䴋w?2Bo$q FQ2)闞;a[G87 soh0?뢓~9{9u/KZ]cvCwtDpF.qZs!B30'mp,|t|,=/Qml˒-q5CϗiA9JY[6KT>0=$c*(0.+FH L=OQi*bn9kA(a/5!&bqaYj CB^֓3ȴw!&Q!2[ Z? '1*χ\Ͷb xHӷ#nY O#F;gF*1Ư8}xkGwp윗v^yO,w ѓ=,&ZDKQuˁe,: kZyY >m ƲYE/u-=2/ ڍ^>M«𘙈^i?&)(Ǩ/jS0# FߋBvɅXM:ao/MPZK(u=[ĢUg%3'7ͺo#:gCޒ$Xhi<R>3x{>5^ g,iދ "qTCwdukhMں?inmra_*\DX 2SY[)~K+3ڥK}P[5cԔlQR ~~/<{ endstream endobj 194 0 obj << /Length 1815 /Filter /FlateDecode >> stream xڥXo6_aIfV$E}06%6 "YsoFCdyk=9Tт2+ FEDzva!mi*J0։'D׍*CJx Ȥĺo~= {A{&=vQ&*Zc8m6UY@a(mYft^bw+~+u>@ȤWThixbRGrIM=[NKƱ;?pR$ (y@"%~ q*yl%A~A߬ M5{ɏSwYO)wő\(lݐC߁j&f{^dN#1[Kfz:g=Kpm1 pC8reK%JUjoTtJO_X"jr4:'iedg{c i#ʭ~#8Q 0YBT8rl1\g3#O%&U u^Blm)oi;6l cq8f_WoJha)hNi+qVfO؋1,zr"t0‰9C,+q 8|Ո&:ُ{5\&o7#zZ_qnw)vºpA=znN ^T^rŬNՄN+Y@ۤ\Rɕ&لLD/lC71&΍MZĖ!_& L|Bbr49fZ$W rWZh~GvM"#`͠{. I? +:,Bʕ jxU;,@:~꺙4âzaG-U [q$O\hޅ$m!qΉt E#+8:;F /Q;*ѱt #;i 8)}_h@* j6Ʃ{v-.HX $b9U$0ƾ12D1MuU:dpO\6rO&s:UX{d>ou6>vOmzja+S1C+.Vf8$}鞘ӔE@7 D}/}%O+s87Ek)m4SL'[fY@-eTY }޼_p!= endstream endobj 207 0 obj << /Length 2760 /Filter /FlateDecode >> stream xZo8_a5\E].@=uloHݦ GCp>~3O~x] ]+[7fqy2jϥS+WZpu =\Յq ܬuMZujqa3/['b+-r|N~/o~'wH͔~djJ ÷x<7p!p8x#Ͻg*W]3P_ 8nXA5- M]_ym eual:x8q%N]iuACgz׍]DA Y>a s:-͞Z)ұ"?QWJHӭySge-+]x RxV\˿⟆G~FhXF&V+ ]![[$T%vze*a:9Pڂ>H6OP uB'qZ؟Б'~JH*ۖ,>O0up2NF`Z<+`o769U$PFI%k7p:!2UI^i4 dw0p X 8LL]U2=e`*7Q}[EtS/y$68DaC׍}Y4/j j[+BIʀasef;Xj/e_T0W3^?Mk*}&_1@Wp0O/ѩ}y|0_2\ 9vpPvz((ktf[(/&)߶aR?=pa-9[mQMf>3<`\u %d5_ζJj2q^^&)$ *%_ܓ^Gyaa 1crRDߌI/7 Lk< [<ĭ~|G('PyH։U@bL-rFq6dL=ƞR L:2Ҏ` QC`}"3\j^?10 aGL8LԀWP?g 0}sWris*+xK*Wj|\8fCRbğ 1~/cV$*VƒF)WܥŞXRpm|A3F`-+]j2,o%F)aͻ-ظ(MAwhWNfwdd1zvdTn$}|8K^S(Ǭ"rR`L%vy 紎 QObX&LL +& s`pTI:*5#Ч U#>/ar;]SLud~QƑ;f^LEl/ǐ;(s?Br%n>88⺮:13ǣIVz=Σadi] Bă  ;7'v y`&Wo/40í "l N,6$#ehF ϢZdgmCPJc$izlw`ď\R^Zi "\z{ij54;ZB |Z4G/f rqLmrfIvJP^7HRεy0M AirPU} UQv&(g9J)l8Cvk0cC3H-<VT}p&~Gr%pA%~B,+Q9vCxdߨ!)-x!؈DŽ#, UjV%\oJW&m,^ 'YyʒBP1or>A[ ?S󴹤֒TDzQ'D$0L|h}'w_,Ϣ@1 Ъ66JrZtʻܬe<Ÿ>8'VYz@9fܴQΒ`]?#ٕFU;.Zsk.Ax!vq`Hc{Gʿ1G`.SI(}}׳R2^g;p@X69ha{)`BK#軁v (!']T"-]@l endstream endobj 213 0 obj << /Length 2566 /Filter /FlateDecode >> stream xڝYKsFWVo\\z IP cm''Ϯ_&fƄeƳYyZβ"ެf %@[L4Q[,Hbۈ4*@DHڝ,a%3Fqd_8Oh\^ũ6.pˀևVW1,wߪC/-Y+%c˵:!ˎLĘ^aY5v6Op?ow V`+}[mVEYӮS[D`H&߈{)7ăsfxB~Gd,8S!V+W5o#e%k,,!Di$G#*}-|N+xUj\ ne+^1 7 'm44=8ib{VIljgFoiP@,j}9$}==Zm+~^rHTutB1{=!a(Iƚh6\9OdQmĞmo|(dE /P Sq<6+T `|%yy ',ChD授R4 x!suxkB PյP@證96`p)84vDJ%~ 9wdHl!08K'1Hr2'1ߎ6?Hl$P`&KkXD슟Ρ H@V;x; Da^$+42RU 'Ӻ`L? F/BX!k`0cnQqv~l>qgjP<޵ ;YRjg͐L}TaxF7Mg*1J9Beo",ݫXB6V2Ng)]гonɵZZY5NT ;TZ~(gN^hLU\)W5.1C#GDV._> wo ܌J-4|Y2U[NM(ĴsXcBy|6*P(АTu-F5PTaS*CrvX^Nb n3)q4AX<|hnuOMH<=2EQx|hKϪQkS=ɭ:|9E.ĠZeSo;Gd)|t ِs * ;9(VIEz3 CWJx.>͓cp3ߜ\S1)eY_G^5QlRo7 cjD}KoL`3xWMh\-ZSnd0ދ{Ǿyhy~@KVծנ%#?݉}z2&{Ru_~' endstream endobj 229 0 obj << /Length1 1976 /Length2 13226 /Length3 0 /Length 14439 /Filter /FlateDecode >> stream xڍP\- $HpwBN`wm]An-{pwǑ{N{L[c5TdJLF`qk+&6fV~Gu6v++3++;"2;"*bm[b9Z[-l6n~6~VV;++ '@ emGq:W!t%bȂL/+,Jֆ0upgaqvvfY3[ۙ1!E= led 5fD*)/3 x1X@ V/)VF`;%I `orgQbg2d 2C,9qfF@K> IV^:?{C;==Y(bVF"֖`+{?B/[Y;[ChцE b;ńbeem`CS?Pvd҃ 'nr;!  /f_ .-X0#k+ gx @Wbw%ׁ!F{a}>!^A/Vqlqv{۾pUb&[[2myQ峱nJTu. Mo*lqK#=3EDhMReO90 cM^^M`fffO#^B#[xdPá<{prgۀKZ!Y.>qgYZ Sϑ +ZʣP}~6Swp_zK1 "`+VZP;_ un? ì*o:jǢRڭ^H߇Q+ek}Jh)4X, gPS}K ͦ!lrw-O?\=V0kT(cLp(s,ZiBT-C->-ypU{tD I@F0׃5yݟ"UNӬ4!Iɹt2WY$Vu\EvRXBݾ@6H%X5m`cSϑ&J~7h7M'Ѵ joWtx.]~2\7)l[$/a7^Wr6aIQ׆?48)$MM^L`p{hbk()3̆R#:;\RVS3: "ƷOR2eyo*UX9&_^KCQ%mhЯAo~i7Gy`5T/H M0xk V<(99_U"=gAbþ8_^+ !e S F*wlʹϪLeɓj҉65eG?jsOpbn}@fb_ "3+DVpU";PDQA`?%0 @dU[ "X慁E/Q" [/ad2 MSe dv8 ʮ"KPhpYh$jw]^r',*1@{S6=unט M<-a6״@:g!l#Y H*\[:tI,lķեs?&5kmx~4Wj~걸,l4Jf6{0!cAl^BUf8Pu$(DZLKԮ@#veX*:ENއ{tmb7:5I"NYn< gJԊVԤ0YvNj&=lj"WkyvsCI2JK,+𧍛".*ӛF|$VMi|!϶mj]s#J5A3ug&r*\oI)J`B^1I5A2  94>)0 N )<,^و=^BgN.TQJ˱-h*1eLf;3GdŢzes \O|c~Ln[+-.qp+0ǽQ-v&|܊R ބ7a!G2,yBH9Pч@Cd(t.Ra?+$q~ǕOĝJw=sDyWk酎nW&+ CazEԅ8bQx!ᙫ MM2mFѫ+=9MɔϲϢMrLTҀQC];{f喺 RURxw GyӈJƵs`s]/GP'2?؇? HU7K.Ŭ]3[d*LBSeW#5V,2XJw3/px,{wȓ^~i['lk*Xc--gna6lEq idlʕo Vhgm Yq<Հ^:?8!}%}~)b`mڍ:_jTDƵUڒe}Ֆi=ʻV r0{)s$Se〬舌Rjdyg"J`c@cs:lGY;=)zc|T2hؑ~dF!̶ Sn gy ^G>\p,+UOkSWv[膄bX^E Zc}TA۟)e*X( H㫒amP`l&'O :`h5E5-}:.M%zՠa<[=Jh 1pNe߿╪ |z3Cu<ȿybo&4!1C%wE]=hwgEa\5̸B )ke?wPZ@(IR>.[5L#ͱs*cW_(񽤀ej?=%闫> A6q~|_O0T `W=5`'g526<f,sJѺow/""$<-0f  }p*2M0jSv+U0]!cvOTg&ٲ 潦vF+!Dz-G8zcɆR+;):_(ܷcOE륵N*j$H>GT.Z&Փ臁f^"H8qq"Ǯh TOtTVjSir,Pزɮ%}ؓ^皶͇@_"ʩ.]:ۉt hhNDUIP_ yx_&:(S=Jwq:$ 3aa0n/kSc^lΑ=7n;|UkfOvNQ(q>.gz׍d:@r- */BSn rYd߆;s5aWKV1c,1X>ǺЧUvA1 [eAtv️%t,eolJsP* i>(lWڴޛ*/Tw[am(qSJp~7̒+ן{Hjcҍ+zJkƹg[]vj_}&GmkV&zo 8VPEO;-8 mprW~'{:^v?wVb ˶PxҊqLJX)_QLuIjoG 0/?9]=H総d]x@!)ma+6wގ/B,TվAkVMd7RyHhz{)lȤGo@][ȈsˇE(oOik\7[$`L`R^q؋-қh/Ŋ7cҨɘYvscЍO.&y,ƬRd7Ґܳ*bx_)z&Ulq6K ~\ }bw q/$iwqWolt3(}ؖcIv.O+oܩNm*^k#4pxs ڬK{guV[zʗv|>RSB6 G@8,?f:a XnVl]T9?7d*C(џ9+;MBlHm+KkY\\J=,/i9ޚ` ?E:|!FyM!t|B;|ӻ4a2|Sfxc&_|cTLba*Loҧz3nm}( fq힯I6lHI =yBXu+vԱԁθQ愲Ӂ>ZkBY{qNxl!}I/%e /soLnd'{J'J` ;7;\ikp -H\ _6(P7&EkBrB7Q4~!fG䉖Qs~pģ? P&Z~b:x ve7} )eEuyM,i\#I }~ԭ%| 1<ނVN 24Cέ. !Z:Jď@}T>m 3{F5ڔM{"3:A-%tKG } dJ_gbrpͭ}ㅿQscȤTQsB2YJK1ógmoB986wqI(kkiU@PN+'Ftbx g+nyq3,F6$Yک(_v g\(!|ixatCr)C2#ut/Y&j|UGܺ^ŁxktgH,Ql/F$.u/{p!-F+FZkT&Bh,د3>Ci]r( 'd(ˎ7 )PU!T"%k.H5Cy݇z}<t -{R1t 0НQaL'(cHlqjmwEor  T[SpzXv`򅒱O?h=Hi2tD0dzE I~$oCJxi_B|IM;KZn\;+ /7tYW2fM+\y:m1;V Lݚҙ۫jswN$kFg&Nvxi7cs7?n#Ph,^ZeLϋ TJ}ayiwĝJk&FfTn;IKY(~oD([‱u[%$LZ[׫l.h &iXdssAP;d-į+XopLDR 5H iiơ)tnV3cXGcб\EBۘkR]'ݢVJ9iٞ< H|b2F^&=Yw!Y0K LьEbhM~ ЙAF- ‚,$A]-t>xj"W +PUߝݕPXBf7Yr?-,b1!@5=UP :gyez qzˢ "H)xD{6>89h irgoEoڹPL#f*2=< 2BkY}hQZOͳ.NZHnP9U%rn!46%nEYE:<(jIOG%p耫O. &oM J*M܀uBb86~s*#-ryZ_'O]im|l⛖id!ZT[;)ɳ=|+v)_sДR87Jc;ƚFȣ^05#OߧH"[!Hdfc1F\vB}|MiNmC56%=3yj}4˯R_VZ6npIU>GʆalRzъJ:p$/+5Db'BRF|{VP_Mԓ \eUFM_ˀܷ k5|?qA' rwsgwG$;shh8@fïQш榿|:nױԻciio}Tzb]<$߭ݟ6(Qj8|D1'59挡69e!UcoNnO];P]$-$Cko}wZ?;koEH%`8?MU$;jZ2]c7lJ](V1^$د)M 5mUC(#Oq,TOo ֗\[ ^1 {ѝ{ݯ=|l+,h=^oѽ ƣbSJ:%T-/ڰ̛G#!:퓷VD}56Υ'3!S& v H;G= `, tqr7k )\˛S;1)sV (ƝoM05@0ȜB bz5 ]w2du7!u0\'^@]mc=g_|P}aa2<{mY!IW:g_>Ȗ 䣟^uoRA\CfGraĝL*7[ijnso0[lj7Pf`He:[,1MǸvUL˶eKjRaqB?_GtM#7Z&1fM#믜a51&<21Щ;L=A|ʶH?i8YđR-S=W;Cs$م̉Ǭь,LIG۩;eij$FpZ;HNӦpz2t~síKL%Ļ 0vHד5Ҽ ޜgyz$nmTkiꬽ1vl[Boz&J%#d25nQ0Ȏ6Ww]+"uS7;xu|XnFue/?M@ߠ簢e6``@؃+2FSQRhUvŌ%|n+yHcG-=2"ݕI %aZ~Fn85ϏOn g O9F\m TB/[*K]NPN\RM W(Na+ bT|4x±+'n /Omx+*-M}*_8QhdA|iވ=g6{sl1!|O@! :Ƈ]}Dgžm5t ߱IGʲf|gKɒ#.Qr)zYȻ́onWcyϞ<ö\ScvXxjlz2tC&Bkv%O(irzS|Bc!1#Ŝ{Ȩ4(M"Tg)wJ'gkwn)\PG=T}A.+тJyמWI EAϊ@XO#N 2_4ݞs"5+кdZ`ɛ}Z*Iٿ4iz#$!}h_\Nצv07>J "d]}&k(TvD;H |\esu 9~|Pc3a kd'N)j̒\L=+x>,tvrLȼH|.{G]w0~]R2jm Ұ'{m]3@~ڊi!Jmh=P7eZ/(on7NbtQ7EYCD*79!Ӆ,g["ec3il9 b6u/-k |'=>򸡮S(F(nZ52 ijIᶭ|=3+ʖ(q 9Ha/kmf>g\@hm)Y;V+3)q@h9>e~TnO3iP?_'ܯBm[,%A]ج% ^mF(z' No"!a~&DQ".XOFkj\)hQq.Р4"̼2Vtm/>bl9C3<vOuƛ,{ ^QDU—6: ~*pl|x[<dg;eLM`Bڎftnvo_ Xl՗F7yir mH}OG =1GzXv#xkC lHj 6>/ Yq-1(b@oYu0un@F{oMmqg[l5ش.˩RyGo y]l +Tŕ X;1k"ފor-kw&;>.n p,YoU 鸷XgXE%q|-::&ETRS} 1U ,}}6c 3.徿y`:bAí wRIy(b4n\dІs9%Fp2G8i"igtyyw?KoUQ?I%e3c6.ٞ-i -TyTSټ/gN ;;Btԟ="+[@°8 p p7EX31 #Ȩ8l=3:cm777IMç!0Rs[6f-p"i̻UJ. <,[.9{0nXԨL2(cRs> DL9{Al'Q[' Kc|Z ١/y2@Y::8ڌ5Nxޢ:W튒P*.k0v"jóO1M[4|/{f%t0f lrt"DL%Bd ǐY8?7iDJ5&}4*65!>-8f]g6( wh٬r(֬N먍gkK.ș+毝iT/o T[Sf~ 1NJH\ⴲrJjФ&:n s~{1}gZxFy}綥Y"o8^sLT,iIgXG# sVדպ:4J1L} wuH3?y$,# #jXyҰ,Y^?yU)MOg)O`}<vv.e+l گº&$[}ҁȌ=- P>e5̕!"5ki:k_4=ϴڣm ۑت툨7D z+Q҂>Sd6CUIyd a0JC736 c_5S`;V5 IsNHsWpkb_nJ G°CiD<KLO)oj߄*;^~l.. 7.i);qlSp| &Hpta|GNt4W>ks66l}.ښΒ%EQkh3ǡ3NdF*-<ؕk]r [^ݠL;$꣈w8r47;vsPIXK$ܟ|j d^Qś8uϒ~:W1>B54x + %;% ޸V GCo)\yQ*1AcnK{b?)s7ukQ8NX/͹U{kБ'_3Wq .BJnKCf WUSn@ɵJip?bFZ qIA(HQ0e7,Sv<ƩuՊ0Y2=ա|^~VI^gv@auU7;,"[^N)9}'"@W_?gr8IDT)X'9j,Y{d%*&PzM<魯/h@Swۺp8n^Z񖷢ܐTxem_|1Q1\9jLۧ,/;Glczݳ }睇qPBoc7^͖$ڶ#n9'M.wacˡLeBJ뢵qA<.A-N~GRԈrz%gsɓqoK:"~|w;$h>cu)1i1ZLΊmzd22M)&d1*yEr_ 0|Aa@2'|q~ z/+37ÓG}..T Lt lO7' [nKxF?@)=*`kx[Ѱ=̍GɨU϶X^ԣQx2N㧷[]kQ ITˎ_t F妅J4|q<m:|/2ުăm{ЦRy?ewB~Z96?oL5#3R^sُo/~دv'.euK `8*Rp`r'v,A<B*ls*AeJkk63D endstream endobj 231 0 obj << /Length1 1458 /Length2 6407 /Length3 0 /Length 7385 /Filter /FlateDecode >> stream xڍTk6L7H5Cwt0  1ÐCwH)-) J !-H}9}Yk׵}5l&NG ez E89Ma(v"Ns(Q7650ꆨz@ HRHE>D@$uߟ/$--) E `8@rz{L7.p'(p;D[`E s8?x vC O/0<w8< ]!TJ;"=|7`?0xC:lT>yQWcV;"<=pѯ`H(4^9Nοp6ü}j87&\(8PZDRB@ ¿60 A75^2!0g͋PH_hWD  A.08ߘol7|( /w4t-4PE@ E%@RR@`؟D wFxL/߱7҅xt[8ro?Uf0?n@q3 Z@]=Qmf.9H,dCA\R_v_C >_ @v3`F!{Ku8kD%`$Ht曕8 H'ho!ԍ ়3I =:T`.vA߭.J⋼QuSW-" nMѝ?7qnX ]?3y"?"O3_/(gD5ǵ?48` w陱O(LrU͡+˖KR5mNM#Py$1:*{*`slDW]ƓU='|&X.[+S4_ k@'dfbHQǒɢ2\v*wĥW~<$bhi[bG< ~'Yf%irB٤j~Z Xׇg dK8J+שŚu+?EJ͟24=sКϸ;j> O]рZv^jc`x޵tM莓J==(Q+H_@xy"K3*gqi`HNXInֿxxnU!6$)6~'#y|K(3']{'u"/+?S1EuLh5M?3Kws*3EXl<[-sh1$, !cO%e%x{{MYVoۨvw wA43. 7I|8XU RuKd~%+%j|ں!L *?8)|?e% Jږߕa{4y9nTaR-Cž}{Yo/OImomɾ:2N c|LQQmLAŕ{DPnuW.Rn06U=f|J.c0,oȌhF',oOG5m2צ֭ S`3hV72ks_ Nh)ɚmˆ>A7:lW;]=uQ}\ '_듕;G(>;{'wPu[zZ]bͭΕ6ݻ=AKEb$H]1`0n` K-֙%ݙ(Tes{uE q yΒg0íP35߽+A&BOw_%ɭ~k}WP7o5In=|-.+t-H؇-]})EQNl7\>=ݫYmA,۟//(c;b$+UŤN]x"wOuj$WqrL˾jګKS9`! ,zǎP25'Y9|dV}zx|ak9XE c6=OQ+\ f(gM<e^C4) Jį1r8$ DȨϢ>%8dc^.8UU*v+??|< _8.3g0 7|mV( ^kKOζNl)茏 w`yHM;z??`fM`^\6kS {) k瘸Ɯ|uvF8ZZ*rVqn}hԺZ0s8>ؖDçyLVr\(pF1#"0(G@Drb7Ȁ{)p^LQ+E9zexەpH;{e+C;Hr(D%&xh-5H峬tǑc c&I$'o1o8.ӠU<>aEev@czvb/L&ڷ01& ѦGhZ~8hdD׏3PfR1 cl/{",!BCضҶ=o!$POJ!6z;yMppu(3.qN=y:V:mB" =bqñ٘A*DbUױKH:,~>z.A%6!]x580{ݧ"sAdl r1AWzzN/6îfIvAb'– } @ݚ(jkG*"dTRPdtkҠu g4+ srA2yׇRʓ[⸅Y?xgh_ͣ[J ]p 84-<.q3QrDs#Yx*f1w޻hFsbl~/ |%>`l,H!RǪIkZe8';E.ȉƞ.Rp\- ӕOEdƢB]\f4SkpôEnvF[ˆFjMA>Bxj rc`RbM($vEFXA)nrcOz~;4ՠt 69#Z=q)O(1=SLv`?OPZm|eGՠS%;$U?TG}alO5w5pD#1OO蹩9,IW vÿ]b+LHf= )J=aaG' ,c"DZEqs!;hǣȰ}%A:Y(cZg7j;r&h:/W|qIdPMR [Xzl'CW6:gg'xgl[|᯺t"$j' }7'J gyf:z/O ńϸ̀05JBTT~6eJԚ-Y[nEG90Fl]:rVCbآ.$C,@"7C),XYVKXR۽*XEmI~a_4]=^0mޗ/G4J뾕֙0K5UՐ۽~[Ma6c)oU b)s9U|zq-Zˁ"3ofϼҺ[1O ?|ٟ#  h' $$JEc nTux [ԽSPl"yяuYƝuCn+řx~$)ٲѷQQ\е zҡ QLGW;~|evj)5+'Տ+[`׽EnC**2 KXlx Fa8a?W,#QEJQ"_@(>K^uLՄBإ/w%0FHYc8[W?8ZsQ*cIq;hgz4J:5P93=]!ǖߺ2,!Eo 7P^_X{i{4bS.O0P=B t =[jg/_?񆐥8׸z? XBbvRb\pQpؽ;9/3>6N8:nNv|WujNQxAaTJ"]Nó3pNg՛4,4{`H',"i˙d %+N7K Op\؊ Vf3&茢dvRC4*d׼x'Iv#o-hٓ (/者DM% 3  Nc ~:uk?sB`|iO ZxYᘚ|gDA$cPHy{TLIs+Mb'䢿N8ðKm/"5v%]e_^V++ ?Tx7^/Xijީ4#>FM'(vɑe˖6+'b kHU8 ֢N0FJ)[=B'ԣF\u?n4 z)z!LWb Zޑ'6*oUJl]-}u71jJV)P 'ESIY܉``ZD 2*O 9+ك[uX9N;n[DBDu j̟^j%|Cᅲ7KVEKVAJz6CV>ĖжEKь A8[y>]JI endstream endobj 233 0 obj << /Length1 1842 /Length2 13009 /Length3 0 /Length 14177 /Filter /FlateDecode >> stream xڍPBHpK-8]h4ҸwwOp-}-oLk(HLF@q5 "++`bbe`bbAPA,#RA`kE !6QCk, ` `f0s0s01X:L )5Blb23'ʘIg:@ h26B́V -`c?%!FF'''C+{5 1(v@+ ƀHP1PB 퀀W%hm`mv(Km@p -w@&l ]@fS% /.q M4:, ^ .0|@6{{;2QŬMDVV@k=Ư~;YMLXQd;Մ 3qqrq9 T\l:0f_!:;ۿ& chFh~;3@~?0?^1+), vѳ2YؙL,`{r%MzPoPjR:LLƯ?g?Qw"qK?T @.GR*Yo:/M@V+ 1|+A@/eWCp k|*3ؿr/ ^*ClX9vv.n̯25:n#5x` C9BBF"N&?(b0JR N?赦kMQ㿈5U>6X_" 7k_%^ڼ>)`kLVп _u,M53_mu\WMkb}M1W?&ko{ٿ7x*mZ_u?8 4>@3qaloQJ߉~g, h(S随s, hk*J"V;T4_|ܴ &B*vT7ؿM3Gw<&O Rm91(HCKY6D _$' G읆EZyJkN^9+{׷i P7q%ƹImTideE^CBaIZ YYnt'c3z.xTA q߫[Zk O]ujkц_!چr6sǿOR \>ߋR xrje?&|']ll]%Hrq\mD̽zͷř5;N_Ԇ-Ot(2 MJ_f2ScCҌ6c=' eKbbza&>xUXgiz zQ3sbprےw*ZW[[m -`ǙRR~y9s޵Gw& Q27;3᤭|F$pUᛊRN%i%2.OW-sTW' OzaD IC[ֈ~Xzȸ<'BȽI-XnoYzѬy^N W+`gMe\΍67ZjSPkILbVuYC/K:\} kMƲV#g`/}e /EA{iD& BP{Gi酖Y'AOՅ@ƈvE.xa4IUAIQXghP`(kP pQ T @H۸@lHƃb#0axkkK >ďz, }lL+gg2w)y3bԣ(6yUW沽4tc9mAl=1NAuC17ƚ\1hVVb|jio  n%½]Z*򚨽uI%Y|vqY̼<|m&m!ئ+\'vMK]<N'_:"EBVzXv{h5[c4UՖYAb8q k2HK]q׏,$_dej4="kpGf55gAS}*YxƎe0~g 'U]IMpT~Z[2<}?>KJBwE 6Ou@˽_>RTb4RƯLn -NxwךA󜗋3VQBO8Hr+,IUY"r?2x^Q˚tE#4+|3Gܰ'-0Ej}O=Sg }J"w1럾ICVr zz *;pkO|ԅ5u* VWXBlC<'rVȳwʸň.WUߕQ&'%91m? ێQ#ҍ(8'bW퍢;Sީ}t#a(ǞJ>a\Ĕ+pc-ޯ1JܽO2Om P;EAFo?s7 s|qiQfT=2Xrt֣񉍝坴G)MsQV=,jfBA['d_q2aiA}8/X 7cuIƹ8hs!N t/y agˆzΪ>;߿yM%3UPCaGI^kpuy_@ӷUM^+N!tZ8;ۚGc|HW:êrhr}1lB~a9zl~Fޗy:ݜ$?+o=!NqMϘ۱b$Ծ+\$ϧeԂR |w9dܚ]}şiAKoPe\ɵHX>~4BbbSܨ|Zu0 4>_@s u#22郂rRwOg*Jnn? l6dv!ݫ];:q?Gfc'MZ@Qg,@ڀ'˂d|"%/+{o R) 9R{=øt$ĮÃ4T{4\ 0?D\!.,?NTxFGĆa2Zo=_77#W6t& ;^Rwΐ<2j tsQ#qYO1JO˦x:e ^Ayk~oӌ(e (ڡdnϟĴ 5b\I Y | Ƥ%Z8.|ck179M;btz/Р^(hӳ*1SbĂߡݐl)DJp2jigf 4e?7{UNxE6BjN^/ܚF[Rjo =U TvD'Fn1u\6s^IT.S;xim%tumZŷ-9h ]y zE~a:ŸzI=p@^t%;oYL%r;Z=NweڥR*u2s&Kmà-T=N1~,`gM{mf@_Q?Nޗ! ?}]nKF^D~t$3`%UְX^G`8 r._%ݲ: :xwN*j̮3qXش E3ô*)| QU:CԭaI~K{LR2f/eeڗa%6Az7opo4?/JlZP`>N?Ӻ97d=ﯼo( 1 ]uKrmS,ݝ >ұps`tO$!B'k!M`># u1-Aqedlh̬ZM^*DU~3"~x9:$<Rq3qBvc@k–XE=XdlZ)C 589m``Hj2ld`{,6M~HX1}\~l59)!{AȎwʃnWKsm9 ۉ퉋r1 -?y= )DI "&QzLhsV'&N[l0f|nS'?sGnX*\ o,R։0{2ND+Ѡ.|[M7@x{޾Ӄt Y 5`,I=Xʘo)Wi=Zq֨Oβ'0FIXW. -F``&wX[禸C:_0ߥid_BJ'KYg|4;O2rO% W/%,w,w9,v3[d\l~ Uސ|d"G{G)s>U8.BZl0XZ1]giTKbqS#U~4w/elOƱ LCX&5;-^ѢȽ[R3 >aOza 1z:.FˈX*MF׈F3;+\ v}"NJ7TR}{Bף[+.Z3G&jwly$qltGP$ʤp LFSlD*{?)^o$,94@|/8=q+"V>מXuՀBtDَ@$"]wUؔrWdHrO`krb`ydˠk@? ے6vEx3>Q$19[> [wL5DB,uLNl]Vt 26!j ߩ9 &fcPdwn-׎A7&qkKV}l>dlf*İx/Nכi&#~s%yL\&?g2rw0oC⏳pv:"9t崴:i19}|4ScqlS!jsj@rќ=FFAZ^tPQ㟋ޮ1zj+$ Mrz 1lX[G]yfKZm^ha@f=QrUS0ڤLBWJ:wL惇_W׹l{JWTmÑ_4 ~{ǁ|$\-֍θKʍg}^LE`\GlpvjO'c5jÕfo;7DzZ:3FvP#X R zx$/V?åKY+`ӀBgպfKVa4i!;7s!Xt #\?k){{vv7 .&njI:U2ձwE+?˻OcMSCL=Bk b0a  %O*s&E2̥V O$}+r wIxzW_>E.os.?3:UF c} ҝtAٱ;U5r\(/"G,\WDKTs73'D,@4߬;5̇Zi53p=,^3F(ɵ#bw@>kg9X% a /w泐j*ZBFмWM:h k%X9N`MF zJ7*{IC eS^jb]%: 6GF?J^GnNrp*o; {E2]~Y+<^+\0BCw/{cE$eXzH&ݗ$ﴲ_JI;a辙T02:ڧWˋ7*=˃0lm[2SqDܐꐟYuԦ6oK];IKn@]xGˇ&OK0N`$ %m_0Q(1 {72Ž^nIXVyfGoxgdG "-[J'b&8Aiʵb̬q=w拍]K('n@#δٚ"gasadxs`\4z_]mFTv&rdOpGO*O<&6ދHq4(ǩFG%I.ek27[эT[gn ]/tY@6{R@^J 2 gY^ U_w\^Hۇ}QBɄͷZj/?1n>쟣eD+^.ԽREս˾T/yE [RQdoU-QH^hnLNq0fG (Dydze2iCY7KK&,_@ /`*4# &#۔Afd/ Zzn,XRe@6%ZokE_gApGaa~hX x% =ʫtJCI2 ;!洚ti+,YxƵVnĄQoE0ob؇/؊N ;{x* %'xϿc՝9Kf7o3횿^4vBsS!hWi7]'8BAOoH~6cz^tW4sVr/L.WPG;qp9'}|VC zEej7"ek`_ؚ>^hq/,;%tK"n! aZE3g}>ͼf%/W{W|(V#沆c$ʬ?TE`%$7~rRg,BRJw;| guY?=f ;!`mL/"~ذ4e=Z{6$$qf^Iv-HYCz*{+g}cLBVZOMFG1@g ?$ uA;s7=MX^UUr6\}?C5׻c; ER$'umĆ4)R H C}`nviT^NoZxXiZ]IpMbbgޑ޾OA_s^!|vv^[ep (P4]jUmb2;nEDqF_˴v05ÎZdw.:ϗm´DF~ũ_S ]-~;CS)/@E Xs%@j=WEGe7܊e^<=.1]<oT"'wEC.X'Nʊ% p7* ;ħ˽bl}=WQ`=mykɢ KO_e%oAKx̠q)wN""ɚvOIp/t|_x7)=.eD 񙶄AAMT Փ D~"TRd$~")SPGEk<=TƧLai\j&ů_U  -DcRk!V=%ԶߺpgcL-ykɨ>" AKV.zA rU0uh0E,T.N|Y[ kKW+ަi~x5/H\1ȜАmrEc[I2!Es@c[ TloS0r60Z:FIiRU,Xș?D J݂7wwG_.kS}_QPިJCE0jv1F:u"t<PBM]8'+(^ܱda5©awu YYxMi}DJA%X Ǽ\84^Kk$д!Mx+KԟeZ@]cߋ(pՍFcQ=<&:5F,Wh<3]/9U a K^ i+*v~@sej]6ķ2ː uO\9rgTP\@?svQ ae=B1*+"S~sO㸀$'91q^g:"KUt_hQUt_ʆfuBe M^ f xyzQ>q@Ɋh )VO:iUS :ZSLy|rQ57#;>o0 /WaK8q >z*̊_I/MݓС? H}ٵ[cjd0b&1icWVUhn JM. yV:P]֏;}iA3k,c21?3LgG#Ƣ>''MۅQ5ViHT"A[(ʭS/c83"޼H;9`#w⎥1)c! &[ 0Reg͉TKB w ʏQ,ViaPW_ \6%0C ,SoUJVD-oCüڧ[zk̪V<->Um$>X6Dwl6pJX~҇ bMs*o8ISifIeY.\ϷALerVD`3? W0dg~Bǟs endstream endobj 235 0 obj << /Length1 1459 /Length2 7087 /Length3 0 /Length 8077 /Filter /FlateDecode >> stream xڍtT6HSJ@5B^wC$@B]4 I ҥ+Ҥ|QϽk}Zo<3{f٬LzHk*H deՇa Y a(8!yw)@Pp`aq8Dp[@Y呮>p{4f-6t nE4h fG3@i}QCv⃺R</8 C=a_4.??~= `p@z*-WX|+W!8w2 E;3 ·F_@3 ɇzBPk wPP6pW4w5"2SVD#]\`4W pw }ܬ˰#l~ aoyT`\ah$*"(*`6~ܘ \; G臂zhwXi[ ` #qؘw{LA_1E"}_~u-yU?;&' x  D0цjw  98R'4 `>3(nHww C]>0@cG?Հ=\;b ǰ,㇣0[m8g ~ii#Q_ & F`6N!Q5a=E  ;ԇs cj Mm?Ƥ03YLcmA??LaTM 4h70L`0Hp7gղ^Ò{gFEnq˕$sjJJrng93G~k5>B'J[OOnL&1O4b?Jc/qҦ!m#c%g9vTID5Y4[>U][>uw*UϱfO53$[ H{ɺcBT=CY"d}t BxU?rKVrAI7LT8G5g&làYnjJ^Gyi.r./[epwNwaFKTΥz]^Z 2Y88ؕ!xdv)C ݽQLgSa(+ҌN =w#[z7?UX@wr"~# /begӬ;/)BJs&co!lFGMXdT|®~s".?#Ukޙr 8:Y/JޠKt#\RM[&~s,UU_ϴXQ{z 4EB O+]<.1靈ؖo{4;O^y}qA˘/O,@&OFX*;=2V.cz|(rv{RXАW?#W)w:*oC@k=m*\U W)~MY]f &m?-,r%a5s1S9Fw5)Cl<㉲A]Rߩ4g=s_ɭ1Ô[t\/LR ؟ ̥R"YM4wsj6nlD쟾Ϗ̤2)w؍vr6հ5pfDW9~`2:d<^z; ?S,;ٟ.x[ۉG߻mm?/D ִlD5w)؛BκN$!nOs̶Hg´h/R۰=t {9g@DʦRXO`:'0nx(q]G\A-Е'Xl|7v^Sׁ^^rS%͋|")YbIΥWp/@/ޛwp~Q^s2l8a9sҺJ {kNþ" /oW6jfN.(P%v|O*:_l^\ !q&B @m/^ui 7<,ĶX2 ϩYUnE҄(Q&t.Ge<[zcX\&_Qꅊ"/SYkK+؁)2C Bjl &WRIIfr"FX[<$S`n2ݱl۟.h (/AP mΝǭ̽z5p I Q[E qd][u"p~)h6?`kxAS1°fc`2Qu)rwfo 1 1a:N (Bs|SMagPr»e*2>bigJW#s7{< ~LR xg ZiR.(ؐ[N Kk=9wM#r]JOH A:rlu专 VJk%ԇ_?SY[\~yg52O⯡*]s$s+I۾X%u~HBr3< (U|vO~{4:>ޏL5irTք- dj?AEB7>_<U.?u߾;jS)g@3umi(l0Xb`ν .Ǿ_ xXn j/+$rZKv8Cfoō9 w7&K9Y.k)M<ީ+z T#͑^bgds2OɂYwgQN'YoiE|"+Bv4w?@8%n"lS`57!:Q;CW%y{2R0)J!k{ji^׻&}DJmg8)*d@Z H)lsY{]誊UC_-n~Hrid@ƴHᅨ>y[9ڝㄅ6?L{]Wݸ~\)Xӊz?C (Lm {NVy~9vTb 0zraVQ sm];-Je=x'= LZG82y'.+eC _]Na=&+ &:9II{yP,?\k*0)Gm_hf~[ .0@eaRݮ.T N, yf@FP~|W93Y|,{7nd=8א }> i&O[i:Wl'zF3w>?/!I+FZkJD>2<`V3WrhL+sH:(٨ёL VR;2(,WWP]Ei8${k?S5ߎmʛ9QZV8|46bB, 6_ZNs2Šzˇ ғOdu |t*>E6Ǒ9BeHҽԸ\DRu=6{}&i!. Yޡ[qІ?cX+p݇8/_c-U9l7'_ NJYf;^M9TN\QeI{1qP ) ƙXɾrՓvl|6+έw[Aܜa~7nGݽD3q~WǠʲU@tag-RӉu-=>Cd) y%v7TGf(oqoG|{Dqfb7]VֶIVAG&@2cwYjeWa~~M՛at2wmJ_x? qҖ}〚CIY Z/O!R(p=|-@L( 8_kT3z׊4@^!Tu+qv5`D9$aA;dUG$78p/q~lipֵq:d(]2VH>SOfԘpַ& x4m=-S1Z>Y8yDc1A /hi gGcf %3Q,oS!*J-"8ܓ]ش M;3uAKe$Q'ŽA?Z<J0k2.XisQf.V"I9靳F~߼I|(d-}YwU*Fgkp#(}\}+㒰EݪkDG3 8?Ixw;Y^{"MmY՘]3kjt+َ['rw`g/ zxr`]Tܿtw vBow_7i ;CY&I^<_K7e3eǦ4OJK> j:O?n- E:,vM+[_Y2.]r60 }7E?YHtvo݊nэ\emt>p+#b 6̳;T;MwC+׾DC6)> stream xڌT% &L6wk5ٶm۶4ٮɶ'ۮ&{sizZuEJ$Hodk`,bkD@K V``33’*;Y[ KbhnkP&H8[ lFzz:p]̍Ҵ [cGXRA[;wsS3'` 00pp};P dfl hoP547vrfNNvtt֎_(?\͝ Ǝ.F? ddf\UX8=mEq)?R|{6Z@6r74ӷq71[dEhܜ>m[9]ͭ \ /6 iͭH' p6F6N2w06ݝZغxiَNX\&@ BOO 0 ng/%1oO;[; coscXOG}cߊE #sC' {t \@= K'.LO غQc! {Upe34QZ%syYXh?P\!ϢLJSzF3yjl2<{+1:vc`k`ߡMy H`.zm8ctoY'1XRx(<8]됑NrR`cсGFm%X%@1g]Jl_8~M0bcQSqM^F`\GhSGVg:5h6́'mYD46$>w%1rCevyka;е?hdLsXݚ#GQ|т M 7]wGQu V\_U˞\#5!:)%JZs3ys]@CM[f(/c-'u1ÂQߋY"Ju.X +[۾ KNIJ|+ZљQpx960ưܝS3N>ƗUEjPA2#zEO__nkyF׳`S @<\3(ɳ9Jn&iF]$zA0"Hqw]rotd\ 2iEm4. 0 Y>A9ƭDL ]ڄ4He/Oh־TX6 _8~C_Sq^ŸKH߾1񽁠3S$ ggvݒ]ռCjy#ǐE9StcfsZݢX rcu3,ubttƼWi9Z7aj^s"\# 86)v-۠ SVİX:+f?ySFGم#`(OiU@z&1iY9ZO&yBUQUΨyjf>QyιuB$)Nm Htk,5e"kݘ/ٜ٘=taAcC$a}M1哰o׹RxqBω.9E۫D}Ǭ PuIgf_%RJZ!%E;ufU.+ y Ӫ%|#E7^DV%DLTǫceCŽ2QSeW?^g~ %kMt;kb)XZmbJjn MՎJ#ׁ 7vijٝ W$ȕޞᬺMVzW:?͓AB%KDNj?+Y.i8n8wcb;_68մJp wXdߑCr`V<) zi#v /̜7[eF33Tʼ݃Ka@>.k6)?^E%g6Ν \کyH"5 Ijw__-(وC4)7,*ʿkc?S_r'Ij0L)ی8~]L&̡OBl4+f$U~aHl[1 >̈R=6&"&Nw R"*UEFo,g 4BR,b{G%Ut%HUrnr㮔n9Ó#yFkATFzaOrAQ!46GUN EVdóƥ),FT0,qk̞׬\8pu)AH3N(c`W~D& : ngUS%1HQT& l#GhU=S2/wzKUQ7-|1\Wd@p<􂆊MYn~n %aA.5g`yJu۴#!LHKk1 Sfn}8/yě?z{_0v2gj=v>']kS/5wDDhA8W8U쒼L6rKX3P; %P}Xb}2,/ɦ!%I d_w©|"J<[4/g d5b;G@oL% Qzߪ6=^N"FdcQ.5;f(eGm.xPh)΃_t+cvK)9wvTȄry  .@TUHl@cx9EMWMj&"P-Ǥ* >MeD^k+  M:NKBHHXc~עi3 K@@ձ_#nk!}!piW–8 6lǮ@ۘm% `4e9Sqt{[%Ď-s #45{za0:'moFea%T!ksn&} ~"CȶL2UtOJo6JRT a?1$.dz.@T.^d!Qx4@=_XX\&e&|qSK^."AkjDF㇇-xpAgv#8!n5ɷ4XQ4#:4dK0My,MYS ^놴vs3ס~2\b4ڡۀmWL$ רLv׫ {ئ!CHQ"Ǚ"G΂jBY,}9_;\>}粸xSTjT@q|sG,F|D0)VpAܠ$3:L6\J-„*fc-TCtr~oRW+|C# i8%{]JݢOR0ͳWkR7\ysnRǁcd|̢9t`Ưx;ϐY]ġ49/ΪE^Jc;*;U&TA=c+:ܩ ,.4T{҈Ka7) *桼&Y' `枻bfp>4 1h|ާXJPJpҩAr5zvsayzQan N 2?6szy.Ƕ 0} $&ʾQE/Vw}Lkv24[4q)d_D CN/V9pl$(לͮ;ccr:BMF| ?xW4xO R?Cz]g4~vC$?WQ-C"Rc3NWkv|pJ?~A߽53d-A`G0BLk \JnkpR\ܱ.t-SclvR%(E-ww >o\10.r۔U;{rX&ڤN-{;XV&y(_rt'jw ݨRB?N,UG-$c7M&q-x4mH}?TI8P'K+oQk|vM̍u EJ7P A1+M<ԹGN 3{(WnJfUIr=iKqo9Q!8+izc^;F_!ַ&pg{[Infhp7qK?y\R8iX]Sض/AY #&65X5ZSBRs&Dk!0`3NeaS͍0UF%YK=*=Uxv ?<'bYB.ġqV[ɫoڙ>cSU:B:.t 'p21/\B%z:Z_`Mpy((7YB5s7-S;4G i j,? pX|GY?h RT@S 'QOe/w ![?Вg@ Gk`]m='l8!¬` xh+l>޳ާ%?̀e|%#Ɨ=2@ڵCliS DrP9#"ϳDy.{KpD5Tܕ5t`C=`m%h^"MjaGx\J|aezBB H>W3%0NܞtSO5OTTBNAEځƈ"wJc֊3 RZ=N݉zXWCaه6 {fD Y~6ֻh`!X=T2 nYio*s?8z٫ ''}3niӡ0;" T7e֋{Lbۭblfa8oN x vAѶDzTp1= ^qw4+#46P- 5'1mwoA'ž?eK=l=`9Kh c ^!|GiFmF0͚-mx勅pSM+ljvjًc{pH5LDtJ\$K"X>.*qkJ3Q?vѸsKsǟQYt/AUZ4¥Ӥ?R%J/**e2Qe3;Nک3Q؇S0Ch݋F7ϡ"v͟%{GDqE5GjOdb%l>kz{=n89+U(#ʞu ]РPp\XQ)m5^Blz/T3yJ~q#}9t7)_ue}ܻl+FH4 "جܔ '&hmuGP |:Mݵw ].ĺ"_N8IplƧיw '^$%T$P=>:;_u ^W*Vvi_H`9Y98H˺cKw1t*j73^:pKΊEc(W)d|uϵ {,vҠx{[rA1^mN'td(M@L9sr:r 'ƒ58Ί nLφ 4ӶI{Ks.zsӭ XU[2c3 8[zx_G ^?yR//Q q3mDRA:&Hr0FU6sAyUhW, ϯ0P"Tk6كewZ:bj ;M?ASɷaT'Ž6XUsO,2ae} ~]yDԅb^"h| Yc.($mB +?'h,d Bp6ET۩Ozܮ]Tb1- } JSUGТ= 2a YP*- 3Xo5f{φQQ)4b>X<ءRSJw+i3(cxZ(G޸u)TjW}VJk=ZExHA̓zE%Ae>SRL)vSAIMW| W[{YT!!v78&W]u.++\};'^;(嘭pd¿G#ZI"ܞM%x"ThN&l՜YI 7%W`Pª2G.Ti:K.^;y,D1&] tRE~-SIU~  5W% %J|OM*ku/gEtǒ|[FHU6PexO|\jgM`6j%h1&ا`]LڧzK+Ypny3lZ_)xw[ KD-4h*8ܑev61k. )J>9sc4D⌹7?_2Z7UÃji!M$X?-Q+y(IxΙrLN4K_ U>$Z=5P ):M +oDʸ?x#0bˑΥMyZ4;~2sdWI*8h(h2xcYd'_#_mzEp{˟W4e+|q攨sV"ep7vP=_6tڰMTRyɓ͞=*^!0 }wlsn=#!> )Y0Ow+}k$n ;]]ak^dK8Ƒl φ\,wcijIʊ DaxpC zi'hi&)xq<e&l7l3HZԵPG!7VZ;r!UvWUD\AxkyD=`'SHb-I:-)gl&#dħ>{"Avw|HiM`<ص@hx0O\|o)0DPύƽaűT\ b(L،F/pr>/եw{AZ]Jo2VB+8.MsbPLw/"1khevb4&@ 8uٷ]N;vJe.poW65m dPhP?x֡[%.;GV+e۳~'%fʤ8~AgLC)[W1׺{j1$BZv.+4,;BfdX6x+LQ;oJg2lA4ng:hCR/3H wEaO?ϋ(`߮~uRQ޺_o ]Aj IR ;&zb;\|aԇrwLJ;slȖA0W/I֚hWH<ޗ-#oen?͎Wgv<>Ւ; ~x4VOk%,B, iہo .5?\c?LR./8םCӫf*5C!ӇT~֌<mT+)i~} .s !r+T鳉?H2a78X =xk+mѓjF[uQDmB^m_ Kd_{AChDOj*' YpSM|^>ٟ ~KqЀXuWu/Q|n\IJcI?z*S \G 烽I8]c+Tv:6J "jH'ĬgE׬okBK1)w;2XJƼ]hFPvJ(+b*w04޴(Oh!vY[wQV' V"'{)rBet,%Mp!q˥)erSVؾRTe$vMהuubkT{4UEFۊgVrp!lwD>Bg.c3cda]?"aqÅΓZq`.?Gl1-%Y9ɿN rc=H΋GPwA&WCMvnzͩ=ui}*=(cWLfV2:w%Dt 61>TfvK婙~IFc'Rm yܗj#g<,^J(_"i% E34*@Gɿ;L.LpNGlZ{$_Q& 2׀)ø8*J\Zb^Z>GVq 8a=>Zz$'Jl,I`oy#‡w6Y.RLX]Z1U_c,=E %Px> fF]ű qItnme8 A!9 d<ΒqMYכ$jn\GKXbOjOnp9ର6j|3 1,x fM&9ZHZcXKV '~3ؽR2Ck 4V\ʸ9Clci3qM=Hyx 7?ZB=C_Qt濪yqI]of<""mt(`&0qif#H}q ! f.U T:l+N*۽B򳁖M%ѫ)3EV?*e~>CڣBjgش@}aXk)ϷXoaVސtMsh?Ixo֙C,l4VIiќh\0_-;noDҋCwX#(c -s~iu;qȜK s"%zbwz1GߤqoSҁK7)jj~ ϫ7k^^'NHEٱ8$ٴ; a[Y6%|CVY*70h<$!_t=\˨k e$,O֪,^?]F;W>wږ~d<M( :-2c5wOLи W5vg;lVyk9E}ђik4Oi#`RrYzS:6-NtA9 4IOjxD쭜<43-:'3@"gs$JmPA|):Ǻre!z}=arga_*/zzf6gגUװw'R|HGG>ܪX^ 4M̯(}JZ!mof~5Iɩx+jg\4Pcʹry@MjOMu5}4DpbPM2.dF[ז#Vϴ1 {9oC17QGx<Я2Wd EA5K -!i8EFRuGxd ,Dn:pWPjכz%u}i=p"QiE_~>woϻ:-G8Y Nq<3\?r"#( CDBԁ#a!/hŪhfMYǍw}{Z%%ү;gNIͪ.mL8O+sIG MyaLSy ^'rcg6"ٹȂc#͎QO]rTftFML|1L[VcGO1zԑk m;PEҞ^I R&f(A0kxZ\{<h#\jROz}@N; >)@x;ō Qr=jw#sr)(=U<_ͷ7Q XtgfX0%/:}ZQ ׺1Ouy2QSfO4!ȍ3`?wCX 2,6c!l>{woKrYwo#\Z揲a~fP#C=m);mػ"GL fhή_V+Pk"'سUvLmWo׾i2}pgok]ӍΙIv8˭JghOb@M"}ġE\D M )6q8*d[$,}r;:qxGNqIGYoDuӞǚmMD2w;gr/-٘1=J8˹ُE}nlAG0XʜN; 퐩5ŭiB|K. nY7e2Vu5^b$@ $mY"בEm!S"P5}]w3eyt!<(^WwfZȮ Z7h?50zmciӅ'{̉bx~XONѰ].Xj0)tOГxf(+[ҧ 3l_%HVapLX9Th"I5X@9$#2T_/=)q޾Qژ#]@]| ҀP?1uN]9aOUpq72[{q'->!'^XJLN!}=+iQ_Eh{xbabVVmdVGZ^B}B%4_M\c޴0RɅǙ<9G$^e-*0եMО67UJ!DPMZM09 yEݘR҈Mcb- A_QvN,=NĠ\{ɸ0R Fq"x`vl/\SST TCr}ᲀ}BJcӷ߬$s alS)Y$< u%F@%oCQ3ݠP䟜a*VޞbUrl"]4uǞ7uK9'ۮ7CKɯ6IPS=ss#[B!,Tt,8; zźY-_~če]W1TlL}*(hJxo߆F&3ScC,EcXD:`@U"/ R [^L]r(:rڳD&0 ICZ_THX߼'fP>_})sT7d?EE8hH9m+^rB/=c$2y/roe~HtPY&\+* XWIp a㮏 0aN4cd3AF &v8O:W V}ua؏A"슳DK 7LFHA2l2#$l ᴒWUlM|kV60fw2ur>066sڟz>Ļ~< )|PV(Rq'_]c:ʠJjӊ"2 R6#M1et?$.ShzN"CѥADau'LD𬟌=tɭaF8E+ەQL;AM/Ec)xv,2|bFXAдS2ŵި?A!'xr[}.1 S;+ʔsE{t!M'D,KE+Ѩo~\ltOA{!xA6%r^3;2|67[g pYMeA:3*HXk@ `{1h I?z¢%z}ŧU9V08&`ZU}n/b}žjYZePx#I%RjZIKN x=@֨}LB[$䉝ɺU"uĩ"o NzȄ'ގwE[;qbu <g!I t"J##Iă]kхOrncW쪚o`k[A)_%3M?X^/ᐑiaQLx !=l("aǣ[\$͓/4NLiP)V_UfNZzYsxBլ O_ >E9wK²qѨ_g/^u5>D( Ɲ:oA:v( 'RɉнGç26nYvJ 4'9yHw̔ t)@s&sYD}*u+05scS*r\zh/*S=0TF6ëC8̛jLIe˅0èEe6_6#:j֑6>baa,2܇g@%_ m9% L*UƷs Db!(AˏMO[qTE>13X_>;+VI@t)i%/ $M,hi&9$@Ϧ"OC7o*,~f(cbR(;inC[!=ªd.8׫K&ˎǛBs4y-'-yvo۟CY_QsigjaP w4ȵ^]cElgg.P0vwb?vǂg1vpR-֬N97͏2xTeBړo?Ǐ;gE|?G/RA2DGxW0נn9=;嵃[sC:Nq͍A. XY8&#NG ,g9 w5N=]qiX"?he8*'=C!6J;w"!e$^4JJٷ$>q9:][W;g.4vk+=Uéx2M({;erA5\[՗5u;e܇ q"nw~`?u&>RK _TÝ H,%/O?a`NBz|f6-s2W2;M+##yZւ@$(x<*Ȃ\m3, 8O@A`0OUCX X$2ge1jT(Ep !`NyYr'A )'aR͒f{KU7_ϵ3ؘBwۦYC.`wM|~WXa-2k`\SzZPfBˆYO`ᬉS1@ˮzQ)W` rl<"bro+Ė)> !0C #,l%W^Ť) {;fYg5\Hu<~uֵX$Fd/QuSQ0sBLnX[5Jo@ˬ;q+i ٰNB{y3g:ޫ{S7%~о}ϻw*x4c+`b)ZSn@m0P2ybykSjιrIĵދ~ПH~봶SUsxHD |(gXx(>ha f5X)oH+AK\9&G͟^uH &ګq r4 &if9!xk,)-E_{D( =JNф6'\=QXY'1~qp/u~ w>kb_N}f$ΙhJfM ‚r;A\UVT싵1xРZ<.~ʨK׈É=KtW [&ƺlOʪBb{CJCWgeЕa%礧C+^쭢&D#0w*ځAґP~aF-5R'AkѬ.; ${ Ե:[ck\P+r~0mUl0u߈<8!37@) lЩDH$5F!ώ^¿_򂗤kKQb̲(,ഖ_0ds*6`Zc8R+v<}?n1{bs\`Gxfw;4^wy}zl|HeN^tޝ -UJAJ|v Cd>8<~ cQ?^2%,k&/G Iu`V-mȻty~>o kiG|ey2Nj˲[v/?fAp\uz*Bg%b-ԛϘ=ΩT(JŶ\rнi\%BGئb7,l57ҥPLi+Ar;++DƟ& [s*Z?tw)MhV+&?뽼G3{+Km`? XysP?$coEXn j $oK@D?oa׮}{@}?gfX)%*kcRZ9SrQO̠I=L%T:J~ܨFdM/0MF,:q= ^3Lgn˖,JzK8BJGzqhpyj70'SM,)~Z+©TEmݒ;m}:ج덄A`#1g+هt"|sZB*wUj|> U֘2Ƨ`zg:=)(C D%ԇu>l4 ˯4v7CbN'Kl,Od7??Onhyg\b^DDžF ;\H":)j h# YINz3vz$cӃrz{>T8 o]-!C*j7ؠ>;4G& _@aV3+K{OHA=C:X]Ke4_N}xSY[fc[죉i՛ϭP0ֳ<]ݭH7i_V%8UTT 1F1$vCgKBZIrHuxq 3QQ|2Z&|*=˿Є˞kBN&8[ gݑ[E99H8P\]vM+R圌j^= Bh "%J ~@lm7]б-_k54LԧhEmx플G(En4!NB&eKNw69 OÎkZ0C.xI/rZTd=&WːF 7Ye=LՀ esɆ GY@C,ɸf(Pţ pϮ;(nhL%5ODi;qJ] KG3gۼ}4\E>J#^2@e3}-aʃ`wQ )\(da//mb$n[v-/q(łMߊOG=ҀPaݾ2fQ]:޽vI7CX2WRy' pzF:L`(7A\N7)GeC~LC!'F%X~_KVu`B7cEc"S|+]چ[M}׸&Z٫] QF =؎ 䆭l4Una?$_}14)ޮB뢸^bUsFGF^W=CT>.) ~mF3RǫS_nŠ5RɡX<}TK2Lþ =ijr5't!xG=+W @ѭH'Zݛ@"t^0'Js܋|VlbFOn8}k";!ZﮔTbTY `> stream xڍP-{ . 4ҍ%Hp `![p 呙3sUUWѽ}kRUYb]YJ<66N66ZZM=/3 6+@hb4s}SnvN[~v~66!I3w%@ ]Ph% ^ kח2 0s:,%3WKE 3{t/ :AWWG~VV30=jP݁ vƂB дi׀Xz9/{:^4*@0; te&H688@`kPVdqte-ٻ@^@f/ -0{i\,A.,. -ye)vuA}>I3ڽX XVtsd܀rPY]lll<|ia^?G#  b:|oÝ 0?/f՟e Oۋl?2z%lOePRVd}O3'' 7S*<-͟ݠ72E@?7dfx?R=n?므ͺ_  J@Kz\^@ lm5\A@KU͟bӮ{A`*U0e,^^E,[@,o[ ۋ8>/h CV0%Ҟ {oX@<<V/Uo3X-Fܼ/b,{ad/_^N oWV/G_lb //T.//ҵ?_Spsv~yؓ@ Y@mMhMN=ςsb2U+]XKRt>_#?>$Ol̏!2k>:j~&OƋZ{#Y[c8|v[m[ԇIwZA%Ӵ3DTdH 8'ӗWS8c (~8}8x/WhrtyOD{3(#;{ǩM?Q!2Uc$߬rʤY;Caޏd2i@TNJT|)C#u`clҩZL.1(D^/R 2C)냳ɺQ.?`f-zJiĥ']tXNjZ}Ucdn}$|eTAѶwmUi}f+iٱIަz2t-]fDQ }<8l݅׾$Mv @z*{EC+BU'p0 ՋekڊXpi6(`vO5 Jj{fPu:%ian{)MDr:-uGm@+y#gqɆN|/+C5Bhaz ܒη`koDFـ2rm / "Se01MTϽOyy%z1?AJ9:/L_Yj$t "j$ޜotiG](gN H]SG "SJX߽mEt2),y .9}Ē48}eYF"0G+=vJ9!6\c2+4FG0W@H*R<-zNH{%(T}:U=9LǒлYT8 O<0GmK7_0`Czo@LkX eh#v!bJ]Apjvah|v6]ɻ_2$;j'iLfl*#RCJ#.Zs#FP2TOR.ߠrr\(^֭O>øtD.p9!$/K\qBDgʡ70zs(<5+%xov,[rPϬB)-f E)o>M Kvt%1 ]?":a՜'G++?L&[\w*Њ!YU ee"{W/hq~"e8Q;Tpɀ!_Y9ck0J_f\VݙW.AW˽Jʘ,ٶ"s{%V/^g}I? |4sR*uLi.t[NM'N xБ89)aas +{9mT] +xaƄ3t**H"(vE5D#rl?hHvL]/y>]]tc3OFSRg^v? @Mdf㍩zcUj-Z@Hߜ'N{Od*vt#MrB$:2zI\ocq.^|W'锴T[>v o5X3slGsYH`UИi$V^|55=9,3P (n/@M'HCk=Ǵd3P=)7Ɋ9Ax;_7f̝{çۻ1 ѕ++}@4ȼ2ЄV ڝ@#nGg)H;:E{M,y݆f62(;.S24/BW 9_(]xU[:NQ/嗽F$&Yʎ@fSbQB3`^5ϼ^#w4[6}n@WZ<!XJ+F 4_$6Pr$oߎ$htT("LjUH" XCo=h$ 4]P(|f =@2k.Ȳ,V>Gɛ@FxDu!Dt搤S%J=1歊'VgPni8`Q=11R7Ia"\;̑3F}T7*=t6"s[iK E| 'O-C]E n a*uz8P;^Z\H^L^v?L"0ڱbH9TUȾޓF]K1V؀b{HYGN6V@XQHD"V,^}P#R։Qspj-ҹ .d ٪;Oڼ$m56M׫Y{ K+zџrΰ`r耽9ܱ굇y/@(K"g}eRkl,T^GGyTʵƋpS6K@:/) 2LZ]șq8*(Q:Gr%>~(]=w%anw;7^v7gsʧO50bzk 5], Wr8} &ZQ#m3쥰?`]O3b0,4DJ'iJe銎bVܮ_="pi|: }5H~ L_~mA:B[v<{aU( =[ݩvNz`))E} zi Tчd|U ޴Ȯ}3t$dK;=•-5 (s?GЭs oO))Ytt9Ѣ|^gSL~C ES9]b}܄c 2NjplDf0a=>!r&$a _#|lZ@+S%EV [vDS %Ls_sZT!V}'Gddp5E9Cs :β\")A-2nO˥L 9*oI(tQ.oxM3#qvU $%ٵp2Zt>0< ӧ@TG>5,ԕvIII7YJ+7ƝuWs[1F0h[ #V9UYZiúIATZ6 t:#whŴcirHr oXB&Q5K9;7J?Y{}E XK8FziG?tDfdPH{Bb0N^ZAh]}j5O[.Y庂{5M*wԈ#-m7GKpdBF>~|N yp؜vMJ?c_Oc%6u u%pMc7I 3yF* E9T,WfK=l*$ca'MT[^d2<$ !}nP dqn)@J  ږ/QQo\xz#Z+ՙaS&>/635cN4KZٍc}IE| d3>", Rau 6±ұxMU>\*idli4c+K-SQo.* #SaNy!q ,&;nr;$jN ݗ)99,>e%+Mi6Pg02bB{/ڥHe̱Z]r2j8xb-gV$Q)CZ yVn㼨%}<Ӎ^;\$j|rBJ4-Q`Qr~5= oU{i}='A7z r%ݑQ=PPt 'sMjqQS+LbZJVlY%*nΦG> G# u(=8,ii\6).#=)WT$`[b̞tJm_ cR*F%=s|w͍"W|zn)`28- k@?eP<=J̰ 4;q%9n?9CMgm.僂*Eo7׏m_a H}Lps>nx\a8l E*A$.&MQJeZ,ӌ}hÛ0UV|1ܺ$ NQj%ȃNjx W_s0]'7.zj*.1Joi $_=SYc-tΆe_kIڒ(칡C#UfI6Jk@rcg]o)|Y zwO4p_ %}[=e|ϻܴ:@EEO!q| vjƁIԱmX klkunrvoDWܶg*P`i);z˛[*5_wo2rΰoO9fլB_5T42i\SόH_y3t$2 ;sL,}"7"|cn? 2]^=e 7aZrԁ9a6V;m^s(&rٺeVaKPOG@:ufǾ%/ 3}]b(g6\(8m7ϥZ,Ry9t},)Cnpf{z 5_]xY"@Gꮄ0z6>.5\񯵉K08Bj5 &#cBks 5lu7*S +p{m}UΕ]ȓ+gYna*6~Cjd_ œӝq^W݊±$0О'QOq#~r؍Ƀjb>É>=zNM{p O^@scZD%w$1Sޢ̅% q4~o·կkOЊ4(vTHÝXNj[[f[2`"NȽrYR~ɲvn=#Y[ө~+郎GNX}냤8a""ؤ+ˌY͸ۧ_GJwZDx .>ky},.-3-tUIqF܈j endstream endobj 241 0 obj << /Length1 1418 /Length2 6342 /Length3 0 /Length 7307 /Filter /FlateDecode >> stream xڍtTk/]%H CHw# 3 H !-! J79{ZY?x~ooFm=YHEy%rb~~A^~~<}0\`T\A$&o@iU7(HE%\%`/@X`^`;{򖿏vkP\\;@ 4, '֖ Bx+#{Yà s{ # 8dU.@ 0^<=փ"<,]A$[p @ SQh9pzpy v99[BP;-h)"<K/CKtC,(,U쌀_ |d E~'vY#_݋w[0ϟ-jc7g>( "!@\[F s"KmA?<;puoſ%< `F@v`(?ё0+`$[60(2246]TO<><"a~_ <;%,UE }X0$cAn/oi_Q| Z_CkxG  96} 3 kUA`"d FX׀AP6 P<@~!4H>VC+0_% ,tuC) |1yf0 C ]0W_!/sF.(d02)>\ƈ߬A{@ kdCmHy,$t9VKBTˮ+3|koJiHl^5ѭ1| `x96@ol1>>\|w\f}&Mt7W!IgaQm=*29]7~s;3F$)9T0*TNAS5Aѩ$Ğh=vz,n̅ lBήoY4/J朎, j~Au})>ZY&^ݙ +Ju9RXU0N r-8Q~) qr. erŃ!?l5S|\iqeVl0Ρ&nԻL!ĂxwF~B |HL 1A6bY&12ײBt>X Bw'՝sR¼r\QV(]^les^JJ Q- yo2~Irj Y̋"VŀfeFҧ.v^#ؕI(E!Zq4>Nu=-58%M1hxq+xm%֞B5¥/[87?ѭW-3Wyk7OqȌ'Z1ԘqĒ:B탈7U# _bN$v}"jknULoL'yJæ{6y <:ICN0 g{FS)6 [*w+ʴϓPN3ݳRޔbBU xrelssrg~ 7SMJ/LYS&]*kAGɖ9ռ<|!#&#ftdCxcOg&_ܠ~nTKVQ~c@pQCx 1̹"$3h_.aef ƫ~}Oy2Y1LݝW˅WgXPj/f!s]Ye'ٻ#hajeGEܕNh "S'DȦMSƏ|JNjr;k'/AF^ݳ˕Tm]L.`Xx293)5VOaGȺdw_"a!ÞVjh-QWO0 d Ex(TlQuJ맠2hDS*6M\ȅfe6ФYƞw$9Lh:*$2)P2·I2iIPz67ӿsPg-ʕtExy>#vW<R?Iwrͬ_|cq/c%'2*Jop+D G'Lt2.Q8-PKڍL~zhiWQib9EOB *Ky0ѳ ZUA1**|;TԱb4G~ߕؒm~'yL&X K[v|[Uȡus{Ylu8hta!-}H gŒoi'Bmp '}' G[-H)Y<Ȫ f\y(*zmE2վ/V<;a=LhyجIJ%k"UPuO>ՉZAqtlKKDln (Mn#juR6N&Q,/=yd=F1suu5=%Q($T:nDtkIJM>:;+`ܚ{چzDyr[Mήɞ;uU |c4 @fٲ iN5:K"PDfu)qf} `o0LFs (cw#ޤZ5 ~P HadU&pNWQsԵnivӔ8`(J -&>5qM( G/{M?d_D[-mpS-YY t0bIfOW'Z RmU_M6/+Xԇo&mj264NHAq4@GԅĜh 2= ҉<|l^@'֗`-c3lR*m)߆>)\`\]~d5{5ܯ16{r/ z]2ǥBưYZ{Wgf\]6_'Ծ! tF}&,=6K FQc@'jB>l )!%ˋOE>FAXճ]~F9Ғ}tZ B,A:^d .`+j'StL'X=E:LSKG,G#+㚲(&#$)Kf~!^e4_2>% jwcfؚMY,)o6t%vO!@Z Y6;‰AG6ܮE ^JzJ[10̛;%.y~yU7kC)^~x;W.Y779Kt7y{Xg$Ι؝7uZJOtu:vJ\C%_w&J/[[?;RɌc=v\ R8K(xkq#;/"H(pD}C_EYV6C]YeJ8.%ETW!{QK3/Ê 3jn>tlZv{',1!tsj$Z5> stream xڍveT[-V$Hq/(Hq-n]{"~qGHKk?$SPf2581Xx"eUT@,@6&V% T;8Blmxq:D ^lmV@ eaց(j1~`Jڀ"v3sL1xxZ;@ m / ʶ3wrefvuue2vdu0eB́J`G m5@s.e[S'WC0`18,r1;_dv`ɲ ObbCcc[k;Cwbʋ2991 mL~ m_B ^oR vNL]2b6&"`'GD!`㗝wg-ml]m<`SVLUm `)^L?63`@9$*v࿜>=l퀦/!  @F`3 O3oPE ?O/:3rC렙4diГq9y8HBTw/?5G4Zǒ}0HG:,,/_o%Q?kwA?ah rEN/e(l7U@We,l^(q(@fcg+:B~_5@F ̚uο\Qb6ƶ&gh``y+2&` dfuzY|hj}@fߦ'Y2YJ . 4x v2ؿd6F/CxIm/d6q_%^4w30^l~,_SKVOE?ef{ mlm{\ `|)O/!^f++?ֿ9ٽLvl wuk#A/5z/%E/RK3KN$/ vlY2q|v&eD[Ao1[]s'g* Ti~#r`B Ƅ 'OQKk!>4";"p;3",b7y PKwP4x C߁K-ܛT,*>wC;fdXd.yUz89-Iss 25b@Q.7$OmȼzĸپdPKgqx=$͇٤oNh?i=c0+XyўiCc/ 2s>b*C-ꅂY^/S.Zg=U!&AG $.lBOmoЅt'fIϧi]dh8a}*SiIh2v8*d 56c>F`*8Q",WC& \/%"jӼq DTF&WSX*^d5n:_H;¼vy{x_]GQXW"o\Se"6sF~k* [Ryu®<:ClyoMԮtlэUug(LfɾM`Gcy:"#) .aY0rf8m'7c'{@gw' Y?WKZ^QW+Z'|Vj|f$/q ޲YmO4Ś[nʯ9>!maǒ/[zH+T4Cdξ%yoӃI(p6^I-tt:~K]h%KȂԯK~(t^ EIh:V;.5 xn6l/ge,XdEԼ9d#ņɃz?b#NSM5fEE{,z]J!| ZTp抹8Q]7a5Fpo_n$$Ow<ox>a ¯{-_ ʮ8,].`)ŧ'#EiByn9QA[;Z8&Q㨾hJ{E iCRd,TJ";kxye*P&*Q1~$=sKMu}rj$d`u$m }y]xpt\RyøP-GxLv܏MhӜ|o| 7YG- `pX#( ulCĩ8q>fɆ3-UxBU.h\Ηq|; xfɿXN$fںpn 7p:%bG[RP)dkn/y'I/!+2t.Sj,}{'(sK+k,xhAlR>y| UvP[W,+p+-CEEaXu.}Hw=_ݎƨp [zG;6jWM6kY|fmPB.'z8t{ tbe`1<>Xc.28( 14ͨbL=)0v` AuA{arMs\%*_W5Ǵ_@92'eNrE1k#4g */H;@7NtI5E8KbsE]FIC7Lh^O1#Ι6):0C`)Xp4>.292.q&jKUקZN1 ֆ}6 lN7`־?U -F~ԉ=z|O#޺l K\!>u=lK>b2SKjʑ-KۺN &q.["q.ffCWk9[9o )}֡Ah3I 9D74qgb%8lŕ\p+SEfgjxmy$bA^{5則-9ەv|:L}3} l>@Og-V`>O4&fmcOmT^ؕ"tB=8! AP]nTz094g!/bvEŒoqS``~j^Qrj.`+@-&lgh"d_L<]=nh e^%Y*geNPp5*DbeȶzL5 >9/9=uH 'q'#+]q;oRIm-oKzQN/aŝ8a"m^CF@4C܂69X\%ۂP b16E z.eo54^xxT*eG= Vk}mGvFGf( UQ=ҺerH#C]L|n:VO<ߔX ݻߨzkQ -\k>~Nْ`/g|/{+ʃo)wISΓ*F.{Xt秞u{ȻG+:J>_b2b@J5|Ӵ?)( 9ϛU0n01 aeg*ݎ3M$9[|yevH Ajs8]l*Hjmu,nb\(< &~#c]L7Gwأ,*@aA'#ZV Ṿ>~V~G,N;(vB sx6#1Ji~$[UP_|ky'(:?6-/1ŸJ7?vi\gIk#5K3jn+.j 8xT8" Sa_D#Gٛ>'cȻF}WNJ\K-Jd“6Tga|ENiƫO?tGMO`J::˴8B"!ۈ' AxoL(q? H 3m >2Tɕu\!{=)-}_l7,b!# lXgHdw s>|Wfn>A[[* XcN@x)k˵IM͓5&LNB uSEcϛSW% ;.46AhlăC9ϵD*~VdT/lYBٓ;Mdx ΗV@4C 1Dr ~3%[I$(yX!`C]+/0BUe;99iڄ;pvT}3E̕<θxx2`n@mu7JL-.dN~j?w(%<&$TN,OIGn[hTv]2-E #I8sݍjG_Jp3ql gvzR"#VzIsؕZ{즛u9R3}Z[tbW״mHg6/|O7Yx0qʅȕE@!]oê"TÓi$h0w'.Vxrz/ǮpQ8]oث,T&v=S[bGt2jq}:D 3%l!/C.aP-U{MBb9 A,V"X0m Rq;Y] J.5%R30zPCҾwBe}[5rlIF?;uW %'+eV(G RLdZU{fk,,:D;:Ff*iw̏paX&1XԍZ`vRysJV>J`fT [ہ(uc wC%Uk9z&ԥC$!OeTޕm:OR2F w~&knoL_³z 쳼jrmӓpl18DDZi)9,{g²>찄(%j jkbVD:yzfzfk ;R8J7ll; ok"J*mٍW},sȿzp$7Tfxhl"\ ( T Ľ+vG s@^wd˨Q;h)ȘNsc,ƫF49Oevlbjp`sPKʭ [0=,Wl9mfe^(O G?YRyd @^dr.X-huVNOAGT{He*h"eP>NlF9~k!6> A b:X#?~lH4̜9P1 <îƤQIiAQ( +ca 5s$fetM¤#(ǥo`obxoQA )a{24l;`M/>OᗲE ][2Pulw {$Sѻ[' )]q|zeL;#Ln=8:Cqg]8$4xs(:W',_"0\7B`ڡ{g;~(AbRW/$:C 'ꪹ<: XPƖ$`bÆ* nF.{%x_K|[V3->{'QpHhJOVKrEdO@/ ).n-#V!lMWW3rd@4o>WYtk7|FYpN W0"-_IllaA}S)</v^)oM~+}]nyEgݖگ8M彊SױO"s McU\E<.&W`xn.Ew>xV٣*IA4òn_t)/ݍu^>2&ǔJ;g(-ngu~xhϤ,'»͹:,K:<`Pܙ*2} |nsGQ z<3pvu͇!*?Pk鈗fu.0;Τg0Qym{[2Wf<_Z?1@9[")N~ۓ2Gk$}(e X}k`Sm﹤紕4N'3Qbntl6پ灭aQODB=G!Q<4^Ϝnbz5VEHDž.q]:F;apZ|R3q ֏Mf/ :iZ"7E Y1ڡ=/ 0ql,FQAT-t5U-Hv);X+±BaioR'e2n5ܭG=  v֖'%kYR@}O3NCs1/ZZCFVSTXh?F| hxZ&74p \5`|?JY;in7;TlDYȁvqj3[:\+7'5 0ؚ'szG剴j|.Սѱ &9%'&gH:bV CkyS=vt[n #=#b̞JsIw/`|sA lu2)T`vZy]JqJK&st5"kҟ+ݔEfׄQ琐K}Ѝدd`r*h{45$+i8#F%ۢ* #>нV0~5M2r>;/X]T󟙺e 6Ud 4;[q;F [ Iv0vMʹK-ii$-m2I 8ʉk!]N,dʙᱲgİ˺(7^3|[?xx6$]EAv/1yѳ$7%#Ns'fp&$ø'[ʊ|FM2A`e恫/1P/3Pau/]d"wŴas513tO׾ *VjJ WDj1p7풟k$aIVx9pn#Q(`Mh T2#y5f 细V"PnB}N1 p_ƕPC[NhX8%mAba?t6;,_zIp7]04;R6w_1)UG kC|bxk:5Ӝ`NY|#iØ~j"E@ :!Jv4 N/:[{%;ŗ",uM 2M۽ `5;WJ8x+Z0 U ۝71ג;X$Y{*#7!'^Ds;+@TP:JׇgBXIKBRP$?(M1Yݱ\xPjz;*)ww9IThNwé=+6N?-%\ g1  OF@S귫ú=O#u2yϭNCT*‡nCorV\cPbt{$DSmx&a*X_ZUMf Xrw#>hJmCHXU:՗Wҵ2ٔ-7)M}*hWXY9Em~ޢ쑥ݦaUլhXL;7^r>J$~gܖttH@C{/ġğk1uFInOl-d_,vm׸AU r贄9mǤ`f dq{fFŎ02zT$k<%yjsִC mP\+o~SD#Ji'|:#|[9+I$#(g@(o q H0ʪEBⳁޮ߉Xq rx:9Oɖ!&wﴱ҆eܡ0`mfV$>,q;c9Rfǐ.R¾cjd,ske2$y_jVjԡ=EsHVC ^PAUz"%qA>. %:9"ѫz"t '㲸G}a<8qF5}*P*CKW#U"]e8ŠP T=ڬAQ^K ke Amx#~l馤f#@ /Ta+5崞YG;ޮ\mynl"_ޘ)c] /Lx ۮY~ݍ h~SFт_^;KEARWG7/oXnr{ 8?hjl=3#Q!5 PQǧ\ԗپc8.rcu.z|G9OKCu^^476F'Z0W76dnߗw7r?di&"ReM8c6'<Zy91ܹ ob+S5n-ӗv5?J{0T`r0P l!ǀ,}Fw%!V !Aܩ0v5ܶtEiI -u\yguҰxqc@Vîl=)ٍLWV*Q] ׳JcAVuUo)OGu.ϒũݭ4i-b AgIErl6oW 5< \A1_Pl$;,qppG endstream endobj 245 0 obj << /Length1 1416 /Length2 6136 /Length3 0 /Length 7103 /Filter /FlateDecode >> stream xڍxTT6"t --1  3 )ݍ ҭҍ Z߷f==6!=EmCsA ،(o⎄"PtPhL Bp ( B@D$@ h4pMutB} s%$x]!P0 ` `C!(|BI xyy\wG.^0 !{: Wȟ FNP_C  #.p{;`u"kE  n p ]-~7"`H @vhAy}`w ɏ~(+ zWW$UFﻏu#~p{_m{ á= J8hߘ#J oF>n0?7$A!AP0 `q  CZ ' 0{o#4VR oOBGSE%{3\BT+*HmAPZ(h#гo)ՆC=\۪AV4~p(R ׃N/׼p A{eCAA?*_&$" |g^Si-f?B=V( B@+ <`(:/Ytm> ,!Ra/:>ᮮuG'D9ieN?V7P15O}x5unJZ Cy`CᘯpkG=qB,#z(Iے#t:\Wxn䖅PzAʜN|j̺1DOnankÇ7§E}54w}5Gh(r5Z "i,4%+Xb+g;=u>yр]91*@t59ډ.Ub$VVЇMm^=(+4\j{*lyޕm\vU4L|sQ=ۨ4-:}^/UfL)7#CDݤuwd&ʢzyD WB~LAA>^G$K0IټFmspRb KբoIJ,ORO ߸:X@ZɶLC ڼx`>|,6R8Іɣ_Λ ,`ѩ=Ӂ62tY gHVkv}La7*9VjNiW0Hml9CKz? 銾G>۲2}L݆e`, 3o8b9^1 '<3,<|0aY}UMPn/K-4"G@ϤYAF'2m=ٵ701Oyje=Ad*I\NpZѧq~idh.WX#Q5Pl4q0Uo)v"'ɔޟ?,ZWHݝ jp1)x泲^g3b慜Q<N+#-ͨ.?aOW?`&eČe|a{#z=٩8,-aZ q}ݚ+S spqa*ːP*a;0@^4KTAle_P?>uYAa%;558,W0>J| w/o4|$ҩ8rbC~9`ͯSl~6Y Ud[obڡ a)NI?u<{mp v6H$.oNls|-U`3(BCOդ&E4<Hq9̝<6c竪(Pż]>&7ZbMg;x %}zښ a N"{bSZ\iO:_5M .bVhk|~֜ϕq>2'm` [>< yDEʰ|^C%6gyhxi  ;. }xKB l@L}װqk(b~O5a>y) KLG0rK8xм;gtq5[s 3j7k4 mPqBK `ovC^4w3"ԡe)㕚 ~y%n(Ȱ#DCN{%>8S"c(;.us㲷#4IgIG ڳoIt|2R\ G=iOȌ)C0pdHO̪?-D8h^Px;{yBاS:ҷl#;O8NwBc ĂcEgG#+eX`ud~hǘqyǧ=`dq*0!-[К8.&*owP$WDwaq"+,6/[􁴛n.Gɘ">f Xc/N>`^ jTUqXUORW`Xczݒ0a mW~Ώ=s?z2~1C}w!nn*U_W2=ugb;dXܵtf_d:%V0($AR< ~\KɎ}uܻf&gon/&4ue%.kkX+Ao,K%޷ 2]1柃~I؞Ôqci韱3"z}l2O) W:DTݒ#LNcIL%iU$I`a&ڐ8\ܬYrnx$kka݌Su?w+yR5A p#fK1tcw.}(Qmn%TU^nfAF২t.B4\mikEW>97jmٖ*H˘;sUs-*YGʫG%G]M8X_Jߥ2+k/' "M'ޝ`P)ɗR3ES'x@' d@r\+>Jow®kÔMVU?-鎶v;ASCAOڑKO:Z/#=$*dgDݕ^SB*_X:4#"x:ͻ!b*δ |=]V krNsuX/R['$_<[3WcLiZPk 26ʦ!%xƪR.]MiԄVg* tGHРB$E悞SFVlݨ Ec#*ߕi[Τ^߲}UVYj`p$o)QyٺC !&Hx깶slꗫ=",;W}jUҔF.'Sb8i&ٺNS23~5u)f($>օd)wnE_id|k#7Xu aWig_. kcꥰP$RΦZZSMVR]A,bbgH QAȵ1n?[քȌXv'iT+73v kq=?r:SB7VD'Eq}̷uh\c6즞D1(OYI{$* /YR*l֍Zz:5{HڣɨG:!Qʡ$kr7^FkyaC9ӵB< |}2j]6 \pE-_YVl`ˬH-@_4LqԦ̷-?ی׾~Ч&5K?~`'VcfNh?Ƒ|wg_屹w 3Kf%?%̲w`cu_sfZtt 6xg?RpLZ1a_Jg>Ry=^M"+ aL8-72|-f0tPA2$Y䊧YfqAK-(u0 @" /' J6~ MG:w c¶7.wx7 &Bd |!ŒӴƋBS2ÂQoRXHzM۟|Jzz N2g^}0A+'Fj~/.|D}U%&M WmLߨýҨ0%sYVڈq#˶*3SO:ިMN'^6۞c>'k<;l{ol]>^94"=q3|`Xu>y?2^X|I~_lT_ONW#7Fi,:F, %]8D+\\ >;/yFyZH,o =atU?TEan\A>69fEY;|gǹYZ*BEqbb+z1VOGvR }779hGyn 'ؤHͫ2ѐNppc%S%Z$Yotb͹&(%}&V̦4yd -#h,,s~8$#AR%j]8uBZnןM ^يj endstream endobj 247 0 obj << /Length1 1389 /Length2 5998 /Length3 0 /Length 6956 /Filter /FlateDecode >> stream xڍuTݶ-A@%Bґ.А%$ޫHQR Ht)"IX9?ɷk 2mFD@`Y4 ..$p!0X$%Ԡ8A4B`Ok`]+d q^P \0 @ ~s.P CC=Hf*DN`hW7(r#]@; 7NE.X4> E@ߝCw P0H7EQW)hWW O A#fQh/߅=5Mt@h!0("܁o&>nA_0~?7?"iPO@?W  H?07kO ^^p4?+lnvJC~Bb`PDDZ(%% g(oj@?_{_sY.Z?"Ka/oN)W;..üGtK7oSL#=\;⍠rYHD#ws#?/ Q4݂+u;`h/JH I~"xC޿ 8| ?cV0PB@a7 `- |#Z68ፀ'0pMGU,^B_ߓ~d-|{9Kc]>zTIȄ? Ѡu[N\zעʶP^n0$H&}1YTJry vJ;-@9;a%;Kk $Dt0ptI|7;ۛݕ.Q)YID͖۟D0GK"qZ5{1 ix2\~pN6b%HԨJ@ 0naH.qQsg ;(*kK^m~}wYg ?ΓWnw cOHg(|P7Ꭹv0߷/S4L =|zd7QTpu0IGOC2MQK i]— #@߅|v\ܛ?CʂbIBD7 EG߽|_kKMעM;>ATXG6:ax>P;M c,c6M(#CpII̝,3M ueV `~[gEm`R\=H%Ss+ufov' xÔզ6Em&CgpL.ktڿHd6?8v͒-v6b.H} 5)" Rl7f<&?ur*'k`)gͷ9M^бK5?WX|T [£eI( Fnc{|0:3"OX;ApdpKV2KgVefA Gu'- ZJ^z? AN%|Ʋh^w16lx'qj9L^1=߅04i,v_ H]-%%_~- 38{P,0l1[ۋpRR  1ȎKS% ȺaPHsS,YOw=6(~Wާb[MDV-Xsa{d3Eŵ_J;"sajAmNuVDՆ?f*:b 3WxEqBXn=4<mO xuӓgD _ɑn@b{'yxAU,]IfRCaW.-O>DBis^|Q{Z2)ґ{:$&~jy-RsJ$Pʬ|+M%,tXOMTrR!O:ln [T<5"P֕cg71\h9<`U8di}i>2 b6w˗6ߣB Ip7]d?9p@mpj5i`(\ҝmYx%9^{;4rHiaY)\Mwr%Ϗ^\&RZhstt74_l ? OeZ@7W?GK $KWk$*RYà|PyRR@]NZSMR63mhU7C7^J ~;GtNg/oEru's`HuIƺ}ɓY'K̭x4ͭEvr>N_bTD"6wޏ-8Ky;VNu$8BsӰ9Cwl[.۲/rwNNsFavf!VyxbY*--J4 j$?e YGs8\!pheIk?gѹg:Ee;ӟ4od98̮y@KuFQSONEN}HgQafk_ d}X2o}iqhS]EgbyiL&*m}e>^F(_lDBN3ioc@{ZܴXL.a8_Hx'Cu bG0ʁ|C%yEu:(CQWkH(ty m| xeAԭY(µ@ڵ全)to,hkhR3j>69t.-/ICQ7Mla0MoUIyBqekVzEv)fET`꧸e!!qk[KikNdS]RK hu9yaDJ݂1T4C 3 F )bb4([;)"8bPP]~<W}]tsIF:FN mh˂(flѡb9~̉θq[_qm{>rJxh,c;x =1eI.g] .w'Ie=⶜算Wod4(3`+yamk:iZmzHUc&?/1t|H_Ɩ"N6|tI$ڍ<>|/vץɖ{bK`M~d E{@X'6р&ͦSτ]߀J*ǩf.WIp]7ߍ\rFz?Aha(ß_&ϓm:j0*Xjj̢VWbs,F6%# Yz?A-3=sQKKʉ7ekuҨ_"1 ZvBd&՞VB:i`8 ?z zX45&7PJ.?̮k'@Z<^l94nS2>yP3N_,{Z\+W !*PVںvc-\Q c֒"S({4G>WZy7M䖒(4Lǘśbд0@W47Pw[:2 4|'l^M "'ӎJn{D5?s!Qj͈ 8x$N.{h$+;ѵTK,R%Ty '`9"* }j~lރ[+93ܭŖZ^Ma-RWC}.UߋNdH,"x(G ) wU@1HU=-:" h j}A |dmvfojivzh˶']S|6to_nzn]Snڭ+"%ȼf̎}[|~j_̩} 2w#"*уϯKik?-wk]b=F5y]eO~rQ,pdAPʈa|OW({GU WOf&}? ^n}OZBf ?Xnc%N `Y}5R. y ۿ7}ۺ ]畇yV*P4EMQpr¯'<{m~4 @R\fWqcDISY53Ǥ;g3O`=Ԩ ].o5  d<8Έ.C逵23Nj$2y9m3_>xyhY ܇Az HkWLQg (?"XY՛G+;;%M\ٍiyGTh;5<[ݹԚ[BB <.#}q#vm2,]ޅնޫ`Ik7,/d~`Ns r~sݟޜq@;G Twb⽆J Xy79tmj zfhK\żd xZw 8lnA_!*xIIVBߐ+ Vc&mR}<۵tXZ E!ODN\!i˸-u*OdbZ >.TL(Tu)ȭyuѭ\a?>V]wo.n.bv[Ltob;,]fI;{"/*aXY;RZ3N}.-y5xs2(Q%6] hv=z8ݫQIRTb΢ &{~ endstream endobj 249 0 obj << /Length1 1866 /Length2 12861 /Length3 0 /Length 14026 /Filter /FlateDecode >> stream xڍP\րi=;whq ݝ ;$`-}>c.U5,f@i+3; @BISƁDM rGD;Bh&4u}3T;vv^66 ISw@ v QKAV֮oy@gN`e ft:L]oM`sB Y: zxxڻD Wk:2@wk,HMk_ 3&\\,΀ 9E#/cſ #OgSss ` TY\=]ڹMMAvfon Suw. GW=혥,$@W?9݋kpY,,h͑UM fcc@Osk?hz9T!~|k}!n@?+ sW O71/~{ O>ۄY1jk+)2`O3' foUSu+` U9dgo,et 7)#ߊe7ym6no[~k ku 7s5}1ffbaKry-TAM_r?Ta޼mmnS|ۡ+`c8yΦ^Hlo aJ `eqzXx<V?DUJC|V*_eC\V-?E`U8[eZ%([vj/|/ZoJRZ j/r`hvc& Ufdo[e${;|Ƿro]o·3r9r{ r{3@no韛6]?n h6 鼯#`ޝBFޑ"tW z,Zۋz:(}mc5% ki;%EэcOGτ UYz|&C!*3x(x>>N.j:ٹn9*IF9Wʙ AGG YG"i_yL;_?]wҙiDZ(&~8ߑ(zpj*5M_x->EX?D~tiuQPk rrT SrǪCt8 WC:#&|[_<j.zCK+'TBTE暧tG?| +uݶ2m:8 `;c%FdZN=S/1nXz!ʃ0Ju ?0 )X֦vD)1@^:Dx_3Աo &p/ %݊im6DRO$LةshF:OYa /0UZω״Wt#t9_{-KB &bO(YO墭jĵ?B5R"3oA%]UmЧ%>ᶌY/!EIZrL(I$I=a|~,J1ψ\FGK:N>7Ul%C$C_UcWWRr?fP7mW-tQ&icqm`Equ'֢#DhZL,[B`r{\ 96>ܤ[!3NL(k>ܶE3빿Bߕ9V~${^QFM#A_';jsX_.ZOǼZʙsJW˓eюjUWx(R8%֊(ǙǍ؅4rsc' 3 is1l57)Xa)E __v;W+6QW` CɄL'FscJu, Rm'(FPF/OuI( 2caٍ)L$\fee;#޻Cپ;fA.D @<Ehh ie0x{כ Zça+OAC/Fm+i6"ZķLLf,hOr!&9ͳ2US*Cm~]c$Ɂ)t0/T/姫r4EswʟO )<;=r#ה$2~< c0<ӋOlL(_Z+,I>XɥgB@1)xehi )~#=j9)Ωz@"m`?}Zf~xP4=LOD}PK2u=0!(孮<<︩Ez_lN-2Qim!V4V+]կbѿkL=C7d=D_eJDtu lS9(Rn椪6ƚs^6"P'G(Jg~v0k͟LuBUi}vI˙p(?mݺՔI(4fȤc̀@|Q9T=ˠNi@ zv%H6:nH9i'ܕ4#0g@dK(Nx.K=uE2ik1\0K ?( B"b%AB Kݯ`.%R *$̙ã4w;jPÞ6z6pV(/*oKw)NB5@1oBf-zBdL,_5.\υK5l  '8U߁[ц`PL.8:t~ϼ+IGL QqWvwؘq I:՜8;$D)Fk\TC/Vš~߄/TЧWRF>v!y1N7$H4)7[$KSDeoBqB;M@\sGC~%sEX(nKGDDثpK6Ġdd@#x5.nвu wn;er޲v,N 8}pO}H51)o_T Z60RDy0U}Q٪WFiE[׌%׊:rmnL*Q7k%3eI4)Z%"K]Lh!T*}7Ui~U;UŞQToȔ86 Q߇XPK^7w3WΒ]͇ϾЗtM#%?MZ¸9T#}).}Ƌ :Ρ^^UQOi$6q<>^IDEY// Ĕ2<%oAz0dc"<4K4n/@em`U4nZt*jN۩N &7U{/ YGBUm*)d0cNRh]19Fl2޳V$bm';<_LV&$k+:gĸלM!hwj1<^\믫%d^Q`36|29 }YUq?,t}h v) .T/>}2 !ܤvs!rl"rGb9d~աJz1^/en8Zb.lIhu% eyc2w9BdP.]3x&vNn@-ÂHk(L! BY,*959ej!4wݦAP@CiPB?y1qzԟB1`‰l lo);8 W>Z c<1hy{Aj GM[apK7Տ,ۡ)pϵvQ@"g;ѴvubK{v+nkbGg3}0vKrM%r%瘑MX3Pz#MO+AZ UIY 94͢2gl:ʔ5Z$1G_M}Kљ s cuA[q/ bic3/]o@t79L a e&Z|Uy{g+%]sLq#98i)b]\@}air4:]nH F IM#2-޾t콕nBq\g]Ic'&fvf!2d0k.^pϯUoQZ[ pHcMd]WHïYmQ^6b<x? ҼIzpl+D~E`(Bᮿ;⛁44r]{~$DxXCAXޙ3H}.@Gvf‘{$x/%U4nx̻,P_z==%JHk/'bE=3$eL17Ŵ' E!/^܍=ff탋p8UjQ#88< 1>>'"Չ-RJ|{t a #? t2zR3:r\aܚ~-R5"f|H"e0vx 1ʢY+-3y󛸡H5x3,żx– EZWdz<˙mx|{x-ӫS5g ͥm cbǑQ+V#jB^$zlO`<&)#k|.1շNuʘ_;\K'Y&t%Iu/u?sg6PZYp(t*1%LX(}/p6g@@Q<7!NY#8o!r`K}6nkw*@ix)v!ƣX}PUmQ(ѿf2Cwk>ĢUD,$cR3T\S4Jmhc/547qǶQEOi`_"8BsAMb'҄b(K} wQB~_bW.1""ĵBDqSּcM "ϩ}E+;Ѯ vWP:|*::ծ"͂ǑZL ZRrV81_İ6'4DO{_cBH`TXqȇ%>:b&G:ZitMĻlq# m")>b!VHrx*E١He/" kl):xMdFBצDW0tOt~ .V#gfe>F7K#9PnMGN`cwNփ(YvhS)녗Sp1@UVe83]C0?]8"`pZ-HȏŻ?,H/Œrr,q5q [dZSn.kexoJm~8:ϳ+r431SGXN^ {Q~D[@;FD^v/~? C{EzZS3~:Rf;ͰxY| tUOꖞge/u~GvFx|0IZDc+NG\%׈H<'}AL[JZ!?!藔!Nb5kz~*l?P6)#oPX/8fI|֑5 ް.ɓG-` Y'i_h1CLH!G!w>lᖺپ ]5>. Wv:g̤Ei6iz V;N!% .ǂ:i泩^2S{CCqw5X[>t?]P6jof05vkEY!|m:©kZVHnV Qs?1U&W*QIYO:.d9Į$ pPDS\)!}jVu "!uK@jT'ii)6G_<ܭ<3ύX~Qx/"އҿTa#™u&W2#@39FbH?0#JgT3 U^pS0Emb_{mg'F8Xmw5vj2r@Yu^Dja[Uh+}~|>?]@2"(h֏^ߟ%]NH f ^IidxD`ߥwXN[BH=:D0Ġ+__fm6`ĉU!rhR KRDޓL=TWx%f0f=ThD,Z/9[U#B奭`62sϏc}Wcтc@0e{CePnS#fP_}Wo 鸄*ůx1NrԸ?9mB̀܊/fq0vaN=N<yx`ȓYӿz:QF!~5*kuN^QL~Iyt[TR]8@~qk+Uō'\i9fI)  @KVKiC8ܒVsEgͩF2Dk).RpabHEmJB 'ԒhNp(S~ی*%n{} EM#\} #HІ^&^99'k*`+ Mg[BsnZ4`N sptnr.^g3t|YeXD{e #8S)I6_z#/SMȺ߼1Cİ4c\< l(,}mSxk~"*pƂMk|1!Eu8X{!2-:F 8~hyMɗ~Pvz ˏW7<8g76 YY>qHL?4[&e$8v?V )8yp42EШ4ΥU`4&|?À^/%MqPSW ?Kvd9/GrrQh}ꁁL\:3Ro`cAb郆n ,^t8$+)^97_>Lf'o)$e]?ib=p{"rcwf=i}?uQz4xҬ\;-Mi%D=lEvY(َD.اsCAOHhs:$4Ʊϱ?kQYxKfifѐz #~j}Umq:I}ř\ţnoofw M<EFo}ly ZkhMH$LE=gf㗣(>O#75?aGbM텽b`ZJ27G2?'w1l:L+BO5 \J~ǰQ /' ABn +ߚGG]+~ I6/;J&=Qz'l=WāWcewX\]wsYlVH+N *xA:tPYNxQ  M vΫ?kŬs B[ho;1ژf;ǍϹNv6(҆ b8b0J 2tG![ ./1N"¬ wJ=UGunw!3 4qP|Oo/T50qyFW1w=J B^ofM )Cn[PHG[] M՘eLh@wIq؈m?T>=ȿMlm@O)#:yi:4Y_+nχu#!zߐ03G4H<*7s#8bn[l'KnqvJ5\EC0-)=ЅAiFȳ^_ hqW@x߽7-G)̮^Tvo*S\\?SEjzR/YtuYdKV}_⎓!߯ȱ-׬ag˃)M4|x2aFB}B,*nFtkW[IÕfrq9W8&"s`!22f@s)7c)TD#P >kЩ/kE+m(I>q.٨\?%2/N{0 8 gB> stream xڍT- Ri)bf.NiI Ki뫾[5k1O=g?>{Rp3<dtty..^N..3j zP`,H~_$)uXh@Q?YǜAa 8c\\C-z{ ђ邠g'?_#`7<.xn4Z@\q(t fXx?Ti0xo$,267%ꏝ@ /7G״:G[|7G#7kAh.vAto 7r E/^k_%@!zANpV_//*Z\Ds ;vyٮA4; O;!]s5/!W9{hMU@ .k<|7ŽpQ;;; j_?[$yVɂgJTM5KvaRmϺJk)/ŠSVˑ+%DڦSCi'lN+±x J{]&])56ޢĀ<܍#yÿ=]Ď ]JuA(mAF-a`qCk4Qs/_#:AvC_DnժPq ʨđ֎`Q'Ѵ4NY2'ZỲC.d[ڪl$O)ߺL;0 +M~] !Мk!K瓞Y u+ѻRyQkf\Ffgf *vkH\iv,9"ؒGkqWұ(p8~8vCfht #D\CГ1Ɔ GXըwMov.{Gӷ*>aS%;O_H/ndZQϭZ}-,_/ӹՑŘ$$"m 4#ܚ]ir}WRp2 d?}:l4/Y@mh ;iv}KQT̓li'F/ _TfbXߚK 4YNkܟIq?K=$ϋOQj ꪧ7 F.? ϩ8Hܒ.g;jO/"9ɛxR!CK>]֛%h~ԁqu)["<<[OaSw& ,'!l#Q8yCUp(-bu3e3r7߇/7 c?ACTd zDBqu1TU2 jmXOI IͻeM4۸ zG*g+iR ǣ%|mL,A9M̏/soTЛ0H2 ثSx-3AO%߮)11Uޤևhg~ԭ-eAj;0UbwIXinC^#Er+w{C -Y%q31TA_42hO潃filsPUd"oڃ9 hb|\^qs~zf5@irW?Ti3jͨZ3F_}o{ %O4%%{犈IdKI-ת7cح9b_]Xr&,hP)I~tͬg&G\: (`VÐ~8 {El@ X~_`٭b/< ,!M/xz#=oje2Qi !*+>x$.mhj/v}}L(mdyDw%讎 XQ.d] ~'R }yb=~l@כAĖI_j?a%@z4RMX7^XE2zO9 m+Կ쟣[P`ߚ"{Jp ^F=t*)NĖC;6P[wN헻W#8n));G$s\_zVZ`LUl|0Ptpp^I5d89mlCZ e#BFc`ܴW Ox14ͯ3 0ט/?Xi=|f0`rd)=JjgNj˗Ic^T1~_D%l7W;$ Puhx>*0mf_V\~iYsbMxk"E]&?}l Rt+mQ(=}qm/dNֳzw[uW h`&~F߅61Wyw~>EMS- 33(IUdI[|j9&t0'įCm %Fqc)fe(+d~],R[TеK!kt~I;`0ΨgϨU#z>(Wߟz5?Kˢ&=o%ߪ͘#cq[V(JRl`icRtNQ%'l?L D# RV o<+5rrD,Ɏ5@!$WYX;ѶL/g0dX F%4Y=T|Y/ŨhƷ8^GkBo10]p~vLOLMDxSPL&gȋОPO$deu[{E^F>>ӊ3 !::> fUEjU,K΍F LV"'_^o-AkC"{ Lβ@ù {18GJpPamR[1a^:RXζ})|t$0gEG;CAѸ x\*([K0k^M5KB/=v]n3j0i1{O< HN{I׵÷w9 ͦ Ctkb6h"  %-9&GL:z?K^/N|Nry19P;7U6.g\Q9IjvA& S6_Q~B cО)τ}s!ꑽ}o<3xMmO I4gvksX#epد?&̥4bw 3r-=a%AfQykۥOMu24(e`7Snl-RUPd%\etHb^i5SO!pU 3bƃ_"e9H(g.Om$/%y{~^Lag>u%g/~ ӬoGHYflǎw4Vez@ʋKGb*81+{ *< &3hq_Dau-=4an9F"CtPkps5ISɓ>sTjz# zX˵Kc |eНl/_yǺ FLP19U{yW ZaN&;nK6][J&xgC1u,TF:%gVVYeK Jrve7P(Jܫtr,n"^S'$)GA-z4d9bvܙzX=5#O]È-l\Ƕ ސۋً[X"/b/%`U9 xz tgopwٶ2ЫSm5$4{5jV SE[sS)A5 DfX"C^Lq|_qdBMQ<-DSe]h-GOrIxHt]KjA>ߍ|G1=6޸Q? }@o/ w) Sv 3 c2anvDbliw/R||s0=r/q>Aܷf#ΐZ_WEzR˨&GJ/z m7!iZ}[l C,ܝ E1!gwݬhY6bu/8VɃ6s2^ 8V`,LYb繆S 0vdjԁ_N6e(eg`1|qe Lg#ܻũ玃ʜ@{w]uI^V+%Wy!wrKSWL#?+Qóq)^ulҨ@`jvQ{.{ܖsjElk& }ޖTMoeög`;uIF^>-}_s @7*(y+0r~84y*{ R;jqsj$͠wqOY\ި/!^ziUH'$]'C-^|׽N/1T. 2vhs3=;#Gc\^~{{d3_7|AO4}]Y(ۂ&-{\LᒦGzMHkwg;Fyh:20Z(Գ`*<''fqHtJNw^9xVFfYj=z :DbtfycS1E-i}a l1D:m|X튓$5w#=V]A 7G;՚ek8d6B) i.n%X\Mu_= I6)L> stream x[r}Wn}qR%rxx+?P2-J|=1 Aʔ([_R%޻gh*Ui+bոEσRcʲ*fXcwtH@3:X_𹲘l3[O6š:>D'k62J'̕1Te, Kx͙2sT&&Y`*9fL@RlJ j*D ]gWcgl@X2jGN09@c6@F\3`gD`$0([yk)Wy̎LPQ H|Fyt@!`AلGR9CP7脰c4!С[YqRBI'z ;sPn@A!@FC<ȝQ2;`?YX1`M)W> U؋V-ZS/-dH410 *0L[1&w '8YOg +m(6)RGױt&]!<;GRNɛi~<Vͣp593/4t8÷ɇ K3ovb䭅q|<n\M{ \]r U0Wov~G<9ݛdv8ns 7X ڟWMR5DJ֫ .;ݨ~jT͝Iܮ?xv}8z5';RÍU4k$uʥ>};IBjLGUV!~/jCԫ3cPJuDh& fU)ZE=BGAdHH 6s4]{r|@rqeAOrunjG5(fp(کs5K`lE$ݮ^FWUL5RrpX[o6Bf@k{[@X3] 魩 !p"bH-*!QtrVnL%aEaS |dp_h:2BoVz\ٝ|n%ǒSw->LJO%ӧSd]SfkY%29!ݻ+vCUi&E֠6qqy81J rWHGwtxP}{:,r,Mpڡ8uᘜ<` :R [JiՄBM2c̷OVK^,ʐHOFϒM}gaV|sr[e7ðwϑN<YXG_oKGPpuKbY% %Ho$;<3Ő6:mV1zw>$Y;6h+=9s go 3 8ա:6IuhT\ya.`nA6WS\ݕVyԕ&NTF?_Df =]1ܭ<ĢN~Z=^!1 -1eB/2[3U3g8{ӷW٫+ -h[4!vap[-Q_[^ x'ru64;67ZFo{ )z.z|E٭`=!mv4xVΣTz{޸%r1ܫnOWU'7ɊgL8_*wz<|C>@D dFMkJ}loֶ?ؙ*D8f Be~F^hQKIP} u&h; RBX5vi{DE#Ϗr(a%/9hM^ pF#QDaY+ mNb4hXѸ۞М?."mŘh+2(.k#エ*YGyO D8LBp4G@A=2&x*P=*g(ģ%# 8";ۚWvhXlbYK:EX+&j>5eͳT(dhâ0'9+Q" _)Zq2xXl(2DUqZirrZIt@7Y]Da . R&3&ѪO22q9ĒgCV:Jcs.ϒ_G)k'ooh$#/[湶RZ'-61KIw;_j<,5pO-1,b PN]a;mڂGp/ck,, |]9QKa̓̚W.A I)eJ:b4ea0۶!-uus: RIRgvՊ[ePP/R,ENm^mpN~jPd6Β\;B,jՖ%D?y[WR}tj@me ;N a'm MWVf2?,kgܨ|p*7?=W{;iձѥjYR%e})!,ʜb>o۞!ŘY-˭\ZZr73x1?ϋF)X&- KCCե-0<^%m-6mGZރwe;T-G.@$[ Utx8" V]e"])m T"H^|;b۸"U)0k?m9jҾxp?'O^ݸ×u m`<8U)׼O绍}~ [_Cܦp>|08>+< ;͋2 P8Lyfso4͓f5fؼkozis6}3nfLIs2&o?i3kfl<6f~8ߓCDzI{BOK8H-M]ͩTOfA 2s'2";᫈`yL90oepׇ7w7 ^zP&\`2<]'7 Fs܁ yyOi={ٟ l4k`:Gb9 99t~i{U1ʉ*t5ri(*W2\|gF6`䔾)0nEL#w $Oge (ѻL&Q qFio8%54^Ï'"6!ȞƧ3?O'۽@w7i3<aBtM2ZճDqmk,)oeAV}r@$[X|a9xoZՕx  \lS}.}r ɽO70>yor豩 ]iY Ny\G G-t8}٬uӣѻ nזs- Ù]*ֽ@_ng({z~)O{V76Gcĕ|t2^u w^6l%{$Wfh;\]*=۫t վ^M!cfwayk/עj ӳU\*޹qg9adXqxsc69Msoz!OgmsksEn~CX} A|s0ʗgT+b8OvGٜlVѽAwC=_/d}y{/9X_]-o?Ւ{}zuou/ZizZ_=n{/V-%' endstream endobj 270 0 obj << /Author()/Title()/Subject()/Creator(LaTeX with hyperref package)/Producer(pdfTeX-1.40.18)/Keywords() /CreationDate (D:20191029193346-04'00') /ModDate (D:20191029193346-04'00') /Trapped /False /PTEX.Fullbanner (This is pdfTeX, Version 3.14159265-2.6-1.40.18 (TeX Live 2017/Debian) kpathsea version 6.2.3) >> endobj 253 0 obj << /Type /ObjStm /N 47 /First 386 /Length 1378 /Filter /FlateDecode >> stream xڝXmS6_i;Yw& C!Rtx5M~}weYȶ-I>>+lpd\A2.KJU0aN3U=eF\34J8]s/A1kj%K`B`FS 'ѮO0~ 15׊ LD?-g1 N&DZǐR$@;O V$և+ g5r*b0giiarUHZah LZ  %(A k(=U(A ,\i8vWm[,N7%#/?WV޽zދ7rܵ7hoVvsBN 7 oΛ\={쌗|92 pGoyM~1|Z=/u~zGio`?$9LU9| *\ tW'J >@mbMKsM{R҄ W_oش5(̅F*ܯhj2PP2b$DB'-iާ1v{464r& iL)i|d`3QHgzR.}"9 Uc5}ߙu[*[gVQn%i Vs{5')uC0"GM (f"-3[FݞFr؈(3iReF{4nuU]$d"3O Ή^P(=J)Gj yԚ,>0?GfJ * b[ Gd𤺩{||V:谭op4t! 612 i'e@YR '⸹i4Ø8WfSu <>~FLwsO]UdLpGU jjV>p+l|'r1 t(S)͗wJMu2&8nY>Q~wA=*G4{IMNx@ ~3ja ĠU'-z u}IﯡЂ^fh`%v)z⹍%ɠGP( y|=93vꁛ7{O.xхQ5cRd쨆4*q8bl2W2PXR;c2vĊRQ:iLJ5n4b`H|$ضH-$Oaޫp.?7fyо'?q^]ߒ/]πj~ endstream endobj 271 0 obj << /Type /XRef /Index [0 272] /Size 272 /W [1 3 1] /Root 269 0 R /Info 270 0 R /ID [<59A9F15844BDD4196FBEB072AFA7D990> <59A9F15844BDD4196FBEB072AFA7D990>] /Length 642 /Filter /FlateDecode >> stream xKvAT3ʃA7$w",z&` XK KGCW4t4jq֩]:gןRJrJ9ElND(Ljd(Qюm[ af"UD-`XC$ Za1[0vqϰAcEp/  ,"KaEF@hNCrzGc rs@1\hlt W KfNq̊'E=h\!fs%4A _&AfEU0ap7Fmp`LDJg kDn7)v0@̂HM!I=%B+S`!9"XbkŜ*?{,e$͜YTCBYYx\x\8[^xV]ɬS}(((N<){'Nl8l&=Ӳ##n8=+MT PW'%Ӣ4˳D[4Yn[;&]]/t!盉l/5c\?5Gڨ_-Dh1;GK??;ZJGv}+`~~~~~~qR£+4Ѐ2y"I~# endstream endobj startxref 156968 %%EOF affy/inst/doc/customMethods.R0000644000175400017540000000445513556146134017250 0ustar00biocbuildbiocbuild### R code from vignette source 'customMethods.Rnw' ################################################### ### code chunk number 1: customMethods.Rnw:51-52 ################################################### library(affy) ################################################### ### code chunk number 2: customMethods.Rnw:59-63 ################################################### normalize.AffyBatch.methods() bgcorrect.methods() pmcorrect.methods() express.summary.stat.methods() ################################################### ### code chunk number 3: customMethods.Rnw:68-71 ################################################### library(affydata) data(Dilution) normalize.methods(Dilution) ################################################### ### code chunk number 4: customMethods.Rnw:129-140 ################################################### pmcorrect.subtractmmsometimes <- function(object) { ## subtract mm mm.subtracted <- pm(object) - mm(object) ## find which ones are unwanted and fix them invalid <- which(mm.subtracted <= 0) mm.subtracted[invalid] <- pm(object)[invalid] return(mm.subtracted) } ################################################### ### code chunk number 5: customMethods.Rnw:144-145 ################################################### upDate.pmcorrect.methods(c(pmcorrect.methods(), "subtractmmsometimes")) ################################################### ### code chunk number 6: customMethods.Rnw:151-167 ################################################### huber <- function (y, k = 1.5, tol = 1e-06) { y <- y[!is.na(y)] n <- length(y) mu <- median(y) s <- mad(y) if (s == 0) stop("cannot estimate scale: MAD is zero for this sample") repeat { yy <- pmin(pmax(mu - k * s, y), mu + k * s) mu1 <- sum(yy)/n if (abs(mu - mu1) < tol * s) break mu <- mu1 } list(mu = mu, s = s) } ################################################### ### code chunk number 7: customMethods.Rnw:173-181 ################################################### computeExprVal.huber <- function(probes) { res <- apply(probes, 2, huber) mu <- unlist(lapply(res, function(x) x$mu)) s <- unlist(lapply(res, function(x) x$s)) return(list(exprs=mu, se.exprs=s)) } upDate.generateExprSet.methods(c(generateExprSet.methods(), "huber")) affy/inst/doc/customMethods.Rnw0000644000175400017540000001356213556116173017614 0ustar00biocbuildbiocbuild% -*- mode: noweb; noweb-default-code-mode: R-mode; -*- %\VignetteIndexEntry{3. Custom Processing Methods} %\VignetteKeywords{Preprocessing, Affymetrix} %\VignetteDepends{affy} %\VignettePackage{affy} %documentclass[12pt, a4paper]{article} \documentclass[12pt]{article} \usepackage{amsmath} \usepackage{hyperref} \usepackage[authoryear,round]{natbib} \textwidth=6.2in \textheight=8.5in %\parskip=.3cm \oddsidemargin=.1in \evensidemargin=.1in \headheight=-.3in \newcommand{\scscst}{\scriptscriptstyle} \newcommand{\scst}{\scriptstyle} \newcommand{\Rfunction}[1]{{\texttt{#1}}} \newcommand{\Robject}[1]{{\texttt{#1}}} \newcommand{\Rpackage}[1]{{\textit{#1}}} \newcommand{\Rmethod}[1]{{\texttt{#1}}} \newcommand{\Rfunarg}[1]{{\texttt{#1}}} \newcommand{\Rclass}[1]{{\textit{#1}}} \author{Laurent} \begin{document} \title{affy: Custom Processing Methods (HowTo)} \maketitle \tableofcontents \section{Introduction} This document describes briefly how to customize the affy package by adding one's own processing methods. The types of processing methods are background correction, normalization, perfect match correction and summary expression value computation. We tried our best to make this as easy as we could, but we are aware that it is far from being perfect. We are still working on things to improve them. Hopefully this document should let you extend the package with supplementary processing methods easily. As usual, loading the package in your \verb+R+ session is required. \begin{Sinput} R> library(affy) ##load the affy package \end{Sinput} <>= library(affy) @ \section{How-to} For each processing step, labels for the methods known to the package are stored in variables. <<>>= normalize.AffyBatch.methods() bgcorrect.methods() pmcorrect.methods() express.summary.stat.methods() @ We would recommend the use of the method \verb+normalize.methods+ to access the list of available normalization methods (as a scheme for normalization methods that would go beyond 'affy' is thought). <<>>= library(affydata) data(Dilution) normalize.methods(Dilution) @ For each processing step, a naming convention exists between the method label and the function name in \verb+R+ (see table~\ref{table:summary.labels}). Each processing methods should be passed objects (and return objects) corresponding to the processing step (see table~\ref{table:summary.methods}). \begin{table} \begin{tabular}{|c|c|} \hline variable for labels & naming convention \\ \hline bgcorrect.methods & bg.correct.

(/(OiR {=, 5?F3τ^;kYW ?w{4zMQ,Ⱦ4E$uҔb@*aAl@rP:rrv~5#-)7Oԗݨ/7T+\+*O|> f#_؉3>p1T 6e/ J_Bf׵3 HN@q MtRc*x GDI29`5bmo2"69|m3ˋή B%WTkwX=@7gu!=a "81Nc +3## Ng^[FGdGZ\dDqa^#:`M KUTw-?}p aBYx)fGJq;R(۶Rhҭ gNtQX͠=rR[W<̼vX/esE(LfP)H#zvJ!J#rh?d endstream endobj 65 0 obj << /Length1 2349 /Length2 14586 /Length3 0 /Length 15987 /Filter /FlateDecode >> stream xڍweTk.^Kqw$8w"-Zk[q).Jb'{㬬fIԵ$A ɝS aFӶuw֠]l!NHP jq(z8x\\œnNN1 d ;@vC8Z۸C3W%KHHow#Pۀ---B0qwwb:C\ŘX^6M U6@8v4:?*- l-NnP''RP91Vǀع : 8:|lV`2;+=@ 9I Z*ttuvwcwuJ@-8:'c vއ#wx9VN Jy8s8ٺxdcY|Ѓޖ6%qK # C?܀`8O#4..`uB*[Sj 0!׿Ls8969ԤuX-_ `s Hh"*8YAB68{g'L 0{ލ98-o\Sk1cYm|caw:@KMl d @ZH:YCGM7nni#kl7ۿ'AwzAoJUk@WW't~\gVu|ɿD ~o$"ʿH8~#hL/ݠ umMk/FpZV#guGlv/{!Z忈=)%qtMc y @?,,;r>P6Cq:o"P +[OzwL_i\m~3vTfrBmoЪzh(zpNhםa=C rOpq>^hϜ<~svY8*\P]J7oLhn68@3]Uw/jV? ^5mo*H`R׵` 78s [-C,E;nk$ɼvyzu~>{P:nۗ^ fɨڈUþI dG{'Mz^JUq򂳗4qZΡπUO:11<7 [5$2JTy&!_5fd8B#?7M1(7ܼ3 }ͽ܂̠T@k3/N%./1X oihE]4c=)E2rcm j&^bvV^!Dž6|Jgr?N5EQ}Mm^̄|dk g]9DSTA ,`mE}S0+:+L(?$y@Y9m#Vw6beߴyw^ϛ ).R}ߓ PJvZ$I}<_3LTX8Q[\ǧg30e_}:Ī-*X@ FƤC4A N}%9ܟ^.4 ˰rg(XĈ{/0}j*(;ؘ ^.G7tca NE{F!(M6j7]&49Ob!2o]{l{O!niF+@h c`s$Lu*#h*k!v:b-vЬ۠2mzW^,Χ3*Q7lx/wn4鮢V_mb̀V9=`zqUWߠ.|AIt> M[C!sgE:L>~9b~S47;+TjN]Lv nCH ;!٢F d.UaF`2ͭ@l:PV\GG4 0K2jӼb$\4G8D]k]'K$BO j+$lKL(S7쾒̤sppA <-tu&)<읕n(]3Ǫ[S/=l(5"`i\fJ5 vM1Et߸ˋx#"b'jiclW&O^,oA#AnW=^F%.)4ji'G1Zw"`d`rbڔȅGgQ8f&HSBϐYϕt*N}#&tW:5Qnѡ%L(QUh\p$E/{yvT]Y{{#)oNn7ʎ0'i c^ݴBS91 !uœ,W#-N1;F~BgI:Rc 7r z | ?`r(~f*G/W T._FEP}X#< $_x z8Ufq, 2`}Tmv{]K0YA;.CYLw-Wt gsR{is,ͼ]c/Ο;=۸̽Bk|Lc1uyiēngn͕Ae'Iu"ocsY:4K| YV 7<Ιԏ? [[!rU z?&➉%a}#QBLq8IC'Ш5rt{YFw.z`PpQp"UW@NHD'zO~'t3,˖hYIOrr|щnp1\Dc)۱2.?F[->Nhx  jK(%kYQ,.|b,*On; ``x_2"`5_#44R 7tπttJe@1i-jUs~}3vi⠺_zg&$Kľ7I/7l P{W[Rƕ/ ,ޱ(g3m^l{o0!y$.=i=5 xg_%^goWEfؒU͂;ShO,1ަ\ZD{ŸQ&[bm]f=|X7챱EU"c.v BĘ>d7'?cf !Hu~#oƙ >c&ݺR,612>/L  >Ls}}˜>l1[W∟x4agE2 O8O[G+IrXWF.Ch0–7Hf68U {`s]Ujfsdg^СAXG: ǿ5p7ƌilnI]fӈ)JLz"S -. "UdyI4/}@,90vy gDMW $څR#1'74\\/g*{Ǎeq)8qٰoϪ?q=|aUUU-Hm XV?x-IJB UUrCt\!`=QH=N_a҆$SmA[sqt-'5FHJI"H0sFRAz4ODEHMBsF1P\rfA}PoΈ?T%s\(&7p@*aM"}%=0<|~mH[kUk_өjk"UKqS-,ad1=X&}ڊ[ J'PZMќ323D@ALfMfRIWU xAhSꆈU䓗0n%rAMrD>í t]>{ol%P;"W;n<Ďλ6?㠝*M5!$ۭ9]z."R*^Xb=nM"29v:~瓤\8 Ľ2f؇qzayUQ ny߿/Ff ONXk ¬ U볩nJsC񊉱Z^K/48f<}n2CF +p L{"^qHT*ڠplU+4h3z$1kZ?r VI4_7Kw2{C@KUGU)t~|jx1'eIqR6.c' 2Y7~E(R)aCǣĺ'|ROA㍼퓥yG@eSBR]p!nkk=d˛6 Q=pe) tԝzb71BYei53tqELpn f+̶zw:VkfzN2>if! s% ǹ s %RkI/f w7s{K )m8cP7 ^OSofal}- h! 07ų7X)[' WBG$R}!{tG@L뾿 >)s?;"LY':4$7ϤUutĿd[6Kn*@mm#.pBt-_leA';|oG?zx6#K{pSn&'qtKDr;d3#Q?J+!|B'u)z2P6vԆbdT#W%X`d^!\JѷS8BrcfI:x@ǹc;R[x6;+,3YFe)3q =,^zvQ鵧_[ xTD Q4ZZp6;t$|NPTŪMJ0ǽ8j|׮ 15+_Ɵz%ɜuBe;禭x>Aچ膓Jswi3;]98 JB OrAH~>u <sC&.not2)=BMN"Gcm'I\Bw.> u޸g:7 _fzI*^6R>YF4^> Sfv!O7P㼠ݿHc&TrsS%.Ӷ4FCz_] -K;%iGgC$": RR>3_E]䔻ut9|4kM-r0*^1*{Cn)Rp{?R78Xc\}yQ3$phў%so 1oIҙVEas>$kmrf3]:w $*&?0ٲtSztgFLZ~R:8gLKٶpv[bH*\\U }^d [8E:4!R!z*x脨s+1/n\BIGvėȇjdOe*Eyc\[Qȑ O Ұ~OIa~qg,>*@fYu]9BEſVfJ N~^޵/)l0lBA9)X ! xp[g!}fb,v񢘇xf!^)b"`dû`kqMG)d X^e DIoq$R% Lt4ڐ#VUg /Iثdw5m`zǎlqL9s :IT=M~`W}iy{hAX2xkN j3ڗ'}u<oWc߿xUrW.\B@[w_l 쁹Wk!~ p2v{>6{"/Zv}кx'{"hwtzUWZ㎫TD{`Uҏ 0I)}dW: ח uh ?Sd4!Z١Am墳ȆDGxIEBD@U Kc!Y٧p2pm0'r>YTn_gl^6XKy;>vU2(JN AߌT K8TwFoȶI hjI"Cw)) ږ7٪ϕDUޚl3eEW-lB$p~f` d('бe&Df/#Z+WCtۚ!)ֿ݋G5Puej_ 5,r">G[7Ft/!l=nBYjy u8lq9mzǚlUuX?a~qo. _>1w0U[p_{qL+z#AOCԌKK]?iM6*ɂh~w9Q9U\iݙHv^yNU=)b(R/9E؍HCHGi/#آcݫ$4 .esS` ^ܛ}Gtn##)dxXK1> -Z΄/8=Gjg޷`\9՛6)x7Eg=#E7C3R?ǫB@4.>hkK &Q5LziVӃxusòl2UvFgf2N) ?Cfr] 3)뽅7#Bl3O6?|5ƪ*kt2 k:ս`7wuI+ͮ30rhHL3d <~-aƷ ݊s@"U~ | Dd'ȭ2U`@/ .W'nqGڝR6%'v>zHzī]mytO#Jϫ @32 VeP{V=@dj>4*ʷ_ mYva6ڊ 0+8+| SvO_#+$ 8}/"wX" >1zjՂ\=A 4[ԟyi7 %ͅ cI׈00zLs"$.l&5w[g?xŷś/(8?Rڵ|hг2\9|b{.|AADgG+G{I&~u7ЮI`=rA͚ۍe~ő ?P̃xv̯$^Y? ZPd̺ /4mZx䜻v"{{(xFyNעk5Pb<\~|\P#2CGhC6gaЧ;͖u!%9xPt,a%#\@tLTew`6Z&J 50?@H87.3CJTPռ% n7K /S|>~w݊nӟ%ZK1OL{v;9ٿ{vH4ʌI3޾>]9pPFK8qsM8hnVY T.ȧve|L1t o7rfװX:-<iw)브<*jKp^C6WYnY֪дcuDi>b  犑FEđVIfT;5Y_ݱ<DWc&K٘mxw%DތDyu/P*]e[-÷0J|$ܶlusbd^_ՠ ^ X;%<_ DBl 5k?|XG؜Jo^R6.)2"Z^iY}¢p 6![lɆVNMNk+} uw Yل}5J.hL`u$n /MIf-2I;Q|I(h5'Ʒ,ɭ0?%A |A^͐}e74w _[pހ_h97uj^G"3qv](JpJqx~/K|eJ'Ki[.YEQd3`B>Ա\ÄE0k'C\+sЕdy zHSP֒W<[L'ݩ[$uAB7["c"⪋ۤ4"{& +o"(G./sKv"Ȟ@>|#DB?W&ey~P3+@Ua:0~bRwj!i;P%|E9˩mJrSAھ~U_|8-7]VJOk^ "꭪7Ttxӟ]cO3QSIK(aoXڛ bV7K^Xͤ *mgړAR5gIMcr!?deުL}r[BdoK4v&ĀMw` Rxs-ρ}gy3'#lBjFN\h7y~cBZ7jԵ_ZSD:}_'(\Llͤ^(^ ,?C&F.b ?|!ўtF@b|}IZ!$KXzHUKGr)uaPQlmnNq\Emѥd͖DD 6aew[" .d[5ǸUq"[~9J8w8x OT- )Ne0t oOZEbCahSHe U#4H?B%( T HD}RãMnf[X zݏ:;,f}Q"}NVCXۀR6Rnj@dAEڵΆ4-}yVq {+`@j-w9 Mk+ wVc fNϋXIgMky.㫏ڏo)ڥZeM6Y 6o>R!5e=Eh0%ڿ%NadPiHx;6l6i8"$^̄i+jڹp;go%W觵 GOLk0/ɢ?~kNIySeM&{)ϊ@ 'AGCMSӐtHOVe0u$k"al7v3WNǾhlz^J* 6McZ*=|~I*0Z"B~d^Umm+څz͋?=TatN;:Xx፼δ^s=L֭C:Odx,t=Y}Tz IkVwƾ$-KAmH.5?p`WoNwI8 ז2Ϋ_ڂj)+vi]6$Ǜ~:{uOXUF gSs@ ?(g`I4+.l酽s%*5IL&GnμX3q"nsS5$n6c9ɫ |X:G6E0.W켦z|3;ڈ@KCiUhYmΜ9\35c=ul;&>7$Vb`g _ٿO3nRM>ϼN)]=-x :hM!tH_sDDV: WDү8k/U.MZ6ǯ}IlH?` 5U+Vp:-cV' rI ,f­ˎ3R9z?#H1~v6wx/ļ' \NYi!"μ6$''6D_cGݣDIlpk'S|:cOJ‘& $2lIǞѧ0*úJL|f8:vVY0FO.,wI6OaOV\;Meb&0p}`$|ejz҄EK)RhS)Ij1UGo^Jv (5r!lЙPnlVgjj95"[N–%y_J8H\0*?^c'7:R'em"ľ:pvлNDh ŋjVq ~W>eD7t#5%clc%b>kә*;" j$/=jYu t%֦;0yQ*j帝egg]Lvmwe߬@Lu ݠ(FiZMZ/-Y3bET* C|^DL̏( zWN9 o9">3$j5/_^peZ+# % VLA<=lxϜUfHa.3u>cwPG]WWzzv>`R]%Px'l㶮j]{8`'t%\,G_\YxjL A.CH"wY;"ᲯzMON D°Ա7ef8Z񴇂6nqƹa V`\ڍw {3= G" W\;]q]7IZs€ꃷ֢^*W8 DxHDfSȫvّ._5̇T,ߑ7\ G#~/IRmE,I#hȃtaQQCI7Xc[:&.=yMlJƬꦪ# ֝GX/D N3P =3҇b$ )u&UgqN nH-~b`ɲv+UH.">!^ D4P>`bjo'C7gwDL \VkIiUq&%oa'+o)IQ aؕ-J9а6_8pT> ݚj)q@/A̲>fSn q4d )b24WkP3^S֏NLqz|͘@7i=39#eUԿ!"T&r%Xf:oD{3/|ӄkzX)C,kQ*o0jo,ťIBKѨWw2ui͘eɔ% x?/  XL* {P863ӈ˯<5n 2ހZ=W>hs C^|}Pl\J;"Wۅ?CǸ휦0Co/޸5SK # w-Ǭ&|!&o_|ivRF9ؑZg+%9q=3l&**uH2.WH[֔jtQ={Rn>-}&onX*J1IBE1˃%gnԗt|Y<*|@S3,O$O{x(ؗmUOѷ%J?Q=pЗn)o=\)s`M̤mTJ%ħ+<VX#$7ԉHQߟڙ}fwO N@ɁM;c3,M[OL/ln>` ]6I珹̚j!7 endstream endobj 67 0 obj << /Length1 1495 /Length2 7494 /Length3 0 /Length 8496 /Filter /FlateDecode >> stream xڍu4k׶N ANѻ}D QQf0{Aт%G=:s_֬5\{_{u~Smn%x9u0?YXt`({_q|=3! nc-Q||"@ pC\au E!=a6uz[pD~@PgPl+Z@ 6(8/ɃpP6-(  Ѐ8@ƃб!Hh#Png(6`‘%.pK3vu6X   x_` #[`PE5; ["B쑈z+f1%:@ni sD!y0_y=f G!O =w?/p{`pK_2,]yu0'(XOm5bnakG$߯/G#VfBB\ 량#|>>%0Zw C soaW̫g=Sw0_>skp+@ޞ_[v߽4΅6Phqu_;Rtg!0{?uAN:vM}ctա0΂Qio'#C*ܡOa( ?\G\׼Ч$ YݾEпU[ , 0 :_Hw;PfFŊx!B Q߭xY@1ߐxVX8;ߎoJ ~@P qDmepiƍ{_ يf١@n$et-llNhg2%N1U݀me=H&uTs_Smn~n&Hfiu,cSIcI..[!FLQQBFPFc{hy =Nq,_hs FEz%&Lj6aYiSxpxnՖǣgYtT}r?0h"ԟQ.x$7|FT9\a; %&WW>` ^OO|2'޺qۭudr9bK}ߵ91E 39DÅȿ_ze(=3cϕzW6)Oqa%.U7\=&.%,`æsZNNr\=Y*![ 42.^PFF A4%NO9j}޺S?ำw՗sTxq}qRHچa| p_{XTt(OuWCC~|m ]ҷ=Y6d`K5AP'O ҙ e<1Ś&p.2,zZ.Pf՘و,ACLA҆Q#}+{ُgv L`PS4or_p,6 TOJVDBvW]}}OW*?XSx/)7qڊ  1O nq ;I~T'%nQ5$'vp23 Cz=ѹc:kh\ l΂_ LcLdanc 렜RXߖXu7-4}nZ^ /ۿc[O8彡Zuy-Yiji3quLY,[c>@oQo4d{$տ Q!x\Ixe%v_*Bugc{9x;SѲuUAtॐ nN`S~Qr+ظ4Z"aTkjM؁ҋtjԐ﫽Ӟ$r8U9ˍQz()P@ȃn{?#"$h}#'; ~UM塤kCrn?K Nht|)Eq3;>Q Iwl#cll0H7  ׃󝌊n/i4\Whԃ=7tp7̱A_'h[㳿U9YVJ=)W#>yڡE&\̓uqDyfFŔ*68^iV&3rA8OL4^(D0ܑ>j^w‘8إήe̫ w7|C͚ (ѠNI:伾WjȚ0* r`ko:κ$g526%d_<b傜,r]:zdwguS qP 7ߑZ1d "z哹f|*ԘM706T۳W$6lj=}=i>/S@Hc/^ia%z}DA9_t7U 9%\c|ya}>(Q$SsNSmeSF4D1!Z )E{f5v%5 ᵱN3>W$VǘHggɞ켪|>D83I+${?b+a8ށ'qdP{a! xA6-[eCeC 6)MM>wTPf/}׍ps.Tݣ&Όs#m\H}%-d0fSG5X&]Į:K0b1R0$qH ҥu2DNmˑg;P(ɏ2j=B1 br3 \?D6_2ә⤶G=!$I7>NF_aur`A=|ұX^F9Su|).u\$"K^J:c%+?NgLvy)2!! f6Utp6+i k@˹AdL]o!NܪZeJˏ@B4vG̎IJo 3cj\_NIKL㕤?~}x^8t:a)C|r~iRQj7Ϝ/9SYF^((Ts_e[X ecǎCy\הS: H=KydC* tJ(?6-߬2EfehX_"HWtz~%M4^I2ixoLLTf 4{Jnu2XXG𚢴8wVzfTUvd ~j+qy>6!͆jWO_`xZ(ȺSmd%Cnx4kۃI[7V'EώV9}}]1O}x{i)Uߌ-tߵK͈zu4X<9aӥ Y[÷ lELRP))C;m}өU}Rx1=1_T""|x VNFLdNVr!&-!;fshAc^B2߹vx'_V_GЫvtĖA3?Fˤ0%&)c <FM}5"'uBaZ3,#lD=[{l``dæβ0]9>c)qg r!Vf6?Ow&7hV濗G_"v؞\ĝo~MǸH굝xtf]ESXh5)?79<<.n)O ]$m qv 0XiR}v>Zr_i::t( }O]g!gЬVNKh~;#"W(qJQЕ;:?2v]ۋ㵼+; [1pya~ kߔqcEa%=؂ XQe4/(amvhOrH:pE5{iy:ωM̖KENG&2Bl:c01/=BZtoꩵ\Jo͕ Ce*XH-ďD3:*^ipM.(fyI掃VQ=\ԣ`y[N+s„*f)?SIPgL|£h+\wKzdBc9^r~$08A-2{] O.%/n˵=eأg6xvr] k*MDDãAġlt\zT~p AEQ8 hИ]ִXv}cup^ܙKI1JO _Ҽw7q#WX;B6N"ɜ:='/T+g!9{;1т{;k59 b/D펨4+[5^dH@4Q> stream xڍT[ Pa!f`fhiiD$E$iINIyGWkb}V=Cy;-B @ B`0sA+0A`H4J/ E ˔`86hx!"* (,!# (W>,taH5~_2N@?SBbp~=3 (;eyQHw/D`ppGЏ|?b| ~nh7_iQaa@/Q@ lHşx1ƿ? X?>Y;rcA&:j::|JTP@{~@*$ @Q Q`_Yxр?o߄=uK[ͭ"`8(6ߌT<\\~1aH_g@"\m8~Q./UAz#8Glc\(Y?:poɟ*~v{2 1dPQ|(N~4!61Dqx_?`PxRQ$C $&8!(2CB7I`H!003qqBoW !>+(i[8//'q|"7 m[/5>1?j5W%% ߈T+^ bB|T___Bxj|B|??` z7s#8ŧ!4FSEH~<|/T29e:E`Em܈Чf4`SS#$i>U6,}.h67[hk :v>oL_R)VNU"x7*yFrMױ[rL*KPף ?2|zMs'LʗVQzM>\X n[l^l0Vr.[HfbN}s쎑XyAQ- ,VA\@9Cɻ\O]!_lZxyS` ʔ gxMԊ کqI?/ddHAӿzO@uJjAn2[LV˛yĀdz{)I-' )*Պm_[9 WN[yA `)VGVʕKs݂ 2ԛDu["/dO$=jp*{DoL ]xH0O:9]h]ư/̾DDC.sCnFsoŽbԤo5D!,:dUrn,DRAQsԙ'IA=:ݓv4$ K^)gmBuFy-AC?s^5ҎyTV5mOF!w%0.|/-`/5p"xJCZZpfg:i)iYw܅wY]ŪFZSFbb*:¹JKT# BNn}|#EYm20FFt`L4M2gSV&7)yt^\Z7A3iGqEs2y-+G*uN:{g2@n@j].'=m;v=U*)Ey̅`Aj)(aǸ8y7(_AIp- ~qs6'Ƙs~ɲUhm:륏i)])|c`W(xix}QsJDG\ bSȵh3)E9J"` q0kLN j5bnM/c"Ѫv#'K^ JhŨʑ !2&G:O;ġ+}-x K> -*Ɉ̝~}/}~:λSa.ٴFCl\<o+!ͻ5k +yέ+I0m8>0śY uiTh Z#sI,a\'yw"إ2zJ >MNTquN`$x45Җ%jӣޮWG0Y??7csmxR„'v?\gg ZKԆbހV'!qg~ jd==A sʆɫ =_’\TPoY#r!$G oVu[D4ijASgW@'!>PMWRL]MrXz A SѝpQ`k I!NlI}?ĔxLKS\'uݬ'HAiT,&ߡ3Nh7[%`'%RiABrgM.m#+w URV?]9]R+A8d.~x]Hy֝-8 {`s5jb0x춉5@37[yN%W Fӷ#WN,|NVB+\aMxݭt4u:PP_0گd#xVcj"5q .~zF: Jm~u((O>.eM / 'Ը|oS/iuů" |c ;R+5Pw?.=-a8˖qNò\<#&.?Z/[`aVA_!4R% j^?V,89`/5BFP?rfH>%=Tʑ4,sv+PjW _/I8(>s'cV.P=<ӀSЋ,. fs5웮{Dݗ UxT%elD>T>qR[sr??,31\fbN;Ŵ91]ZYx4]M`J1K5‚"'rCvO0urtZa| zci#bݗ/g[ui;r0IӞ cg g-|+bb>_".ҌC>y`b?φ7ô+*Wfk8t/m ^ ?ϯ&36y6!C2KovniƖt e" QuO2aGiFMq٘Q%b=Q !+o^h&_~um2~mI,}S=dZ8*}p2Sa|B6l*ۆլF^̍sLgJQḚꋇwZcN>GzKwN$7Lgs\d١Z>m*1Eg_Lx;a䦼˓.^O2π?aޤ{lR4uٴ:ձ$8z텐HzOR fΙ(M6ս͗ #hPIO6z͹b9HxOgɿr 68gyeS1Cu_ 6%&.V+ÖfbI ƇJ4/܈'E2Ek) %)98,XY:Qĺk֡UJ$Z_\WF΅Cn\ҙ_&RM#c,۝742?j}M8֬R4@Q3gu+i;w6,VR&yUyp}RRgB¶>&]Jf`IԞÄ86W w H keBJs|,6~ |»:w6oTү>BWi*ޛ&+j;iMΞ$H2R]=pfG4DnFd\*~o&nÉ؏iށSާ(\[Wv4J1#D7U#ȟnܭ1Xb= }:ln9Ot ϶kMش(wz8,~EKpN^dFm媧%QN?Ձ~& XQQj D>D:g0GSɢY^z>Ѭ3-yѽtF!2^<{i vy3v́JK&ϺsJ}־)ϘMzH92v.^ uƱ[i=MۂYJXn" l ; [Wng[$Bc3rhСT? ӥF7 =O1(Pƪ۱a]f]{&_siSvG`C}uC3>M99K,JyAds鶘%T!(C`^tZ1/`Iz xjuh}8Ec`V(#.gUA=`:/wە¬E!vNڔRK}l[Augo. *Z$\ڳ Qx +Q la\oEyBV_Ku-뻆qx87DN)~g3TJ -)Ur5h۳s)7/^F>mf={{݌3oHemf>K]klXqMH99|2;atL8g3!Ά;Ay!y)+G[v)Zhg;4@\L:+yybQ,.ܸ2n~u{ud07]~Ge(mѫA[;ԓ ic1=N\S- vK endstream endobj 78 0 obj << /Author()/Title()/Subject()/Creator(LaTeX with hyperref package)/Producer(pdfTeX-1.40.18)/Keywords() /CreationDate (D:20191029193347-04'00') /ModDate (D:20191029193347-04'00') /Trapped /False /PTEX.Fullbanner (This is pdfTeX, Version 3.14159265-2.6-1.40.18 (TeX Live 2017/Debian) kpathsea version 6.2.3) >> endobj 2 0 obj << /Type /ObjStm /N 65 /First 488 /Length 2568 /Filter /FlateDecode >> stream xZYs8~ׯc[&JM8$>6dqi[YTD*q%Qe>Jq4_( 2T,ӆe&R5 >}qLX&d1-lGxfLʤ`d8kb>úg"cgL)ed )Y)^C4iЙTBkb +${1Mʬ`:c25iYzUeFᩘ(@LV DRgYVb̂C'kSУ[V`T)(USH \0 #xN\%Yy>8 jKFK-U5㧌-Jw٫ֽr oWzT^CJbuLE7ݰ_TK+eDu7E G[TK簸=;' \&/:`0L1m %Hxnx ~:C}o÷U1 b|\^^ݚ;TLQ88iRcAEY,n8Ċik!_^ -QI*)XUBhyɧ1bp3D`_"@h3`P}hZj'{Pj8d9=sX?:?9!)mS&uEy`OFe=ϊzщ"HBR!)m`HM!JФqI (K/Kƍ> LF+X0SA)G Ԛ&B' JuhSp2(mF!]bD!4~׶=۪zS셼V/y~V׵V$V$"//ab&U|y&M冷Y[gpʤ\!)Dń}H,P:LCT8B*~p?Q!zeӔؼqwD' \q ,)u@MyC aKDCFXWF-|Sou#BM&9m4+28Hf)e Z*CoSvӓ)Ph6֡> cP(M:|=P{,LiWgO̔.bޓ,|y 6(TM,[>I xr }-8Viėv7BEGQJ4SfbTB< Ԅ_)Ŏ&*|.tӆ܂kfޙi< 0cJ&F uc}6ՍXyq;&!C5Ӟ)t MpSO( rpHMb^dӹ^o28'zR*ibڮSue;=qPjV ÜM*Th49r/A*7\{RI) PDIc6vO׮-<iM jyh+P^Nt-7Q<w9:<;۟@?`YVJGfn-waݽ`{~ȏ ?gOͻe˃5>=~׸!~;/_ zps /X6|XzʿK ȋ7(.FeV<ylV@E42ֶYa6Hk|u@:kbAcQCC=O!ݜ?;Àj)Hkm" Ԝ"\lٓ^y??"/Gy8Zā_zڍzXtޫG@:;r޷pOB|ɟ)S.Qջ}uُݻU?nɷj;~-lu´m/0J;R(d0ҿͭYǣ7GGUkNgtݬIKޙ7.tvi˜ON1ي2:v^abb\ 㛽ިi8ti <]շll{p. iK36rQ4Ek-6 b&>_r:_o+5'_B —-smτ?!|!M wK*?kޓ! s{5HT5 H>N!?$/dPk^;4G74'1zZ8r~G7'6py[v7O|To?6WȬN[mA!qnc\V[m?2}W/P],*_#pk~WhK@ 7EDB5H,5OeCtv>uQYeBDcK,o:?N ] /Length 204 /Filter /FlateDecode >> stream x9RBQsN@yspv`j\;pf;꯮{;iI'R"*jn@ 0WP"` a*< sp 'P#3,BU[jp aaJc6abր-؆hB va5GX/?Qmuh}:vGuGT.apCϯ endstream endobj startxref 90247 %%EOF affy/inst/doc/vim.R0000644000175400017540000000066113556146135015201 0ustar00biocbuildbiocbuild### R code from vignette source 'vim.Rnw' ################################################### ### code chunk number 1: vim.Rnw:42-43 ################################################### library(affy) ################################################### ### code chunk number 2: < ################################################### getNrowForCEL <- function() max(getPosXForCEL()) getNcolForCEL <- function() max(getPosYForCEL()) affy/inst/doc/vim.Rnw0000644000175400017540000000662613556116173015554 0ustar00biocbuildbiocbuild% -*- mode: noweb; noweb-default-code-mode: R-mode; -*- %\VignetteIndexEntry{4. Import Methods} %\VignetteKeywords{Preprocessing, Affymetrix} %\VignetteDepends{affy} %\VignettePackage{affy} %documentclass[12pt, a4paper]{article} \documentclass[12pt]{article} \usepackage{amsmath} \usepackage{hyperref} \usepackage[authoryear,round]{natbib} \textwidth=6.2in \textheight=8.5in %\parskip=.3cm \oddsidemargin=.1in \evensidemargin=.1in \headheight=-.3in \newcommand{\scscst}{\scriptscriptstyle} \newcommand{\scst}{\scriptstyle} \author{Laurent} \begin{document} \title{affy: Import Methods (HowTo)} \maketitle \tableofcontents \section{Introduction} This document describes briefly how to write import methods for the \verb+affy+ package. As one might know, the Affymetrix data are originally stored in files of type \verb+.CEL+ and \verb+.CDF+. The package extracts and store the information contained in \verb+R+ data structures using file parsers. This document outlines how to get the data from other sources than the current\footnote{today's date is early 2003} file formats. As usual, loading the package in your \verb+R+ session is required. \begin{Sinput} R> library(affy) ##load the affy package \end{Sinput} <>= library(affy) @ {\bf note: this document only describes the process for .CEL files} Knowing the slots of \verb+Cel+ and \verb+AffyBatch+ objects will probably help you to achieve your goals. You may want to refer to the respective help pages. Try \verb+help(Cel)+, \verb+help(AffyBatch)+. \section{How-to} \subsection{Cel objects} The functions \verb+getNrowForCEL+ and \verb+getNcolForCEL+ are assumed to return the number of rows and the number of columns in the \verb+.CEL+ file respectively You will also need to have access to the $X$ and $Y$ position for the probes in the {\verb .CEL} file. The functions \verb+getPosXForCel+ and \verb+getPosYForCEL+ are assumed to return the $X$ and $Y$ positions respectively. The corresponding probe intensities are assumed to be returned by the function \verb+getIntensitiesForCEL+. If you stored {\bf all} the $X$ and $Y$ values that were in the \verb+.CEL+, the functions verb+getNrowForCEL+ and \verb+getNcolForCEL+ can written: <<<>>= getNrowForCEL <- function() max(getPosXForCEL()) getNcolForCEL <- function() max(getPosYForCEL()) @ You will also need the name for the corresponding \verb+.CDF+ (although you will probably no need the \verb+.CDF+ file itself, the cdf packages available for download will probably be enough). \begin{Sinput} import.celfile <- function(celfile, ...) { cel.nrow <- getNrowForCEL(celfile) cel.ncol <- getNcolForCEL(celfile) x <- matrix(NA, nr=cel.nrow, nc=cel.ncol) cel.intensities <- getIntensitiesForCEL(celfile) cel.posx <- getPosXForCEL(celfile) # +1 if indexing starts at 0 (like in .CEL) cel.posy <- getPosYForCEL(celfile) # idem x[cbind(cel.posx, cel.posy)] <- cel.intensities mycdfName <- whatcdf("aCELfile.CEL") myCel <- new("Cel", exprs=x, cdfName=mycdfName) return(myCel) } \end{Sinput} The function \verb+import.celfile+ can now replace the function \verb+read.celfile+ in the \verb+affy+ package \subsection{AffyBatch objects} (scratch) the use of \verb+...+ should make you able to override the function read.celfile by a hack like: \begin{Sinput} read.celfile <- import.celfile \end{Sinput} The function \verb+read.affybatch+ should now function using your \verb+import.celfile+ \end{document} affy/inst/doc/vim.pdf0000644000175400017540000031075413556146135015560 0ustar00biocbuildbiocbuild%PDF-1.5 % 26 0 obj << /Length 1813 /Filter /FlateDecode >> stream xXKs6WpR3!7:cmN[]:IDJd: 9 ~镩2%JLV˜l^務_ |6+м{hYnkx Z-VT?@|V4 ǧWJdҔ8EZ[ZB[Тf-^„=nvYR[ Ϫ6H Buy ʸ9&.o IJX/'(QJ`PXYj'yKve5%`r Y#x΁q"_/-݂^*(aiy iYtd8*iZc:2/гB KDsǀ.w ע!Q0G@1|*w(=:ьi#hPbGVO!C޶l˅:ۀD=HBÙ4Han,0:ip#[22MeXp!Na;bQ!P2ˮQa0+]:oD5;emCREDn~?6_lp]Z!pnEơcM8Te}cĐza<$sKB$VAώԵ߆=Qf~Gkq}N<5Af4!ɘ5*Blq^N.+72꽚Z0l%֠忇M 1iKHdb,07qT"kI1l~GRڏH) `2r,)8+ I&Vĸy\` K)@[2lnTHa_! 0>@FQ5O<^@!O_!y2xdq&,IUnpY|T>|Ҩd .X-i)5]CJdJp|~ Iv*_ K^lysV0b רn jӨ.췳 rYeBRTK#5 ̗)R` _!JuRX|bFTǴcJ=P(L endstream endobj 42 0 obj << /Length 1815 /Filter /FlateDecode >> stream xYMo8W݋֬H]6@Eу ENur "%SaizN̟:sV*%&YI Sl99jl<2ɓK3^MIf\Mu3L),E}*YԾ_Uuu׫cف*fYMR]U+9wK@;n'Ys$[TV%ә. fmU]̶[0{HfLL`ʲ"bf[|B(K3r\͌H9a!cUb2qd>}ཏht ;G0ӒL8+NƵw8ےh1<:ސ'~`ΤR> ԇ`ak-aQ(Ev0cnoS~E1#e2-J Y$cc659<0 8a&g85) N1dRDy۠]o$Mֱ4ܑE5wL17e*̪'dƴv);ni,A ѹE\a* E䊥2qM_n(lx4 s댏3 @,0w!ߧJ%/v,pL[bDFѹ.au(vq-O^=tP^04Qt!->0-tkdݒ& C<5jXΔm![isaDkh%ٗT!.(x*h@ 5O^LZzxiJQ@4n(׍8 Lܛ%;bwK0l`|_`;ZhaJ`Qprȵlc_ ŎJQ(,84ѵ+*S P|!eyJgm (PhSEk*Ss-˥+#(|;=Ҡ1 aؾ:% 8Yڔ"Kj*Lr]ch41|)ظ*:-7w&eٹl7XfuY*&6YZX~i [[ԝ{!7a6Iyzm#Xض#~Ŵ5s.с]HCkvݎ:Y<~2Zmg6bpV^2u<}pY%+E>ZB9pgnӹaLK: ~&Ο 2_ endstream endobj 54 0 obj << /Length1 1868 /Length2 11542 /Length3 0 /Length 12702 /Filter /FlateDecode >> stream xڍP CŝNp. ݵ@)]ťXRҽ9}3Nf߳|YoZJ5 VqK9H.TssjB\@j] P?,$Af2)3gCe@dgp ,2sX P $b v}G#C@/w=baP6s3Z4`: lf.lPgkQF PA-TAƆB C\Vh@\=̜Ag` r)3y^dq݆#PY agg O 0wM/G_J|6@~+;S` p!(F ?ӏ'gYB5눁zJoiJ ' 7:w.yN)0 }f./ y-8?/,"7; !v^X<3y ϻMu@]͞wAc@\9 a/|VZ+!sB^`Пɞe:/R#o*DaY#awJ|0L#RbD-%uđ]T6:y֭;_=K&I,tRCJaCܪf0, mɇ8ݝqOxD9IE|&P?+ZN0bj#yIh}gf񽶔>kMJouΒbcc a~KSU~=^b%MY&wa.B$6rmA~T/Dv]qfۍ͗*=݂y%4c9 t;e-Qj3­¡۵1G\yeӗkQ8V&j?ke .DvpҐ:A/nl_ WW j^g Ha5 e@LHπ܌gs8L.u> _q8*6vCM~/$v>QFF],c+!\: AdgN8U2MW2V\mEW3¬n.a[ yCuS(i#(0erR]AIAhvt1A`-ws/.81+Mܾluc:  X/'i}ė;W6@ɯKY!djXܵVs̪&xu}apGZ'8{yw D/4U:5 =t.N'Gou ֗Af&;Ir)}GK஁Sfs 2[$VٯNo,S/=XiVD[ DAt^tHGո› *tD5'/(8ӷ?.G$T9(_u܌w+nU \T-@gsK{` Q)Hx ἝBTAJMt>"~j0Eߑ}]SY)~f> +Ip) 0ynDrLw04fPXuFz1ib]FAdy=̚a i݅ߐ+}eWqIoMIc\<`dEd0I&KIÁiB`yŮTëӭ~/U@iBo)#yT8))WN"M2n W@]FKAڌSTRQ&zSG _!A^R 4u|v:-17H\t3ӛh`W(2&mwhMR&ֽc+3ClI󘺒j ZDX|VFчqQd &LGRJ 鸘L eaV{d[yI@ۭD;8G?b)耑@iAJs:hc 2۠Pztȉ=uCShմm_;A[ f}x}Ǎ׮bGwKD B8}NNu2Sz PJfX"Z35>jb6F!;ذ r:0ݙpo_4+L漌Gi@~b!aq$zV8 W1W\~EDKy=CƢ/ssY3[We&JVq>3V"d {teL4g' C1uJ.{c3R9.U5G騝l0sʂCM~%a.,Ͱ MNZ a9pGUef{σV,T@.O5Bw)|@*(:m`ΚC Dk'^q}\u94|ca #n⫧x']_ 2/C"e7ܛL5@G162+`bsGV RW_GƝYZ IsMMBjKJvbj3Z]܀A"(Pr1A$PIeЮLSWW{=_LV̙ZQ_^qalzRt?QEDnR='Ęv/SԮ M7\:t1% gBq$~/UmJ4m̨)q6<_qXW:&esttUglɘi.h؝~xz7rE!&zƈg[OXlu*o\vdۦ^u-w e;0b=GӠ!7EZ7ٺydb=ԤzL ]uo$mM'ϴ@ !9!%j2 }/\z7W(iZƜ%*B*ni`Fi4gՊ[xn2 rz+Hy8y"ǜQ 3x~@gF5X\K OF[iNerVcqHM s,E]AZILP2&S*1x_93ۢ>@罙y?,8GrD33||7 ʭ 3kd=zX}h ylE9e}9VSoFfr;WI{O@ps~"S-5\d@MO9^I!Vo$O*, _/l:nșJhR+6v+0ӳaƆQS?Gmv5"Q\£6mE,]Tq7Q0zh((x~Y#lgRriIIE}8q[5v`D5|Q U '*.]]0t B]mƜ;"Dzn 7o=_e">YCM*7Yi'bvakk̩N ݑϙfhwN-(̭Q6X(;H[ɣ٣˒hW5ae\ڥgVKۦoZ7;tP3lf GS,`hfhB;dBӕ^܄2?ͱ5R &Xh WUVky\RIM Ŝ2 dDžy~JJv?2HߤwČݿ= |sOQgb_+;2?Jvx%<`tyN~jb h'; vźڥc?#, V,O2֐FҕTSWWW@ˤROT57uYP3C1EizǤm4eWs_ͤ1 ~W!.9lJ<̅G%/}6Qzd|Y.vPpYDCI ^ךGJ`-jp\nԓF?.à"mYr3,!AceQ3dķvSۺYy-ǫ_}G&;xWnjfmOCaٟϞdWE՘dxa酽nN[s&U"h4-瓌e6IRj-j@r=p);7s-Z g:ڜ&ڳ)"kd!b-]:X$o‚jڬ8G%X oٚ{D%wz˪DjQXWvah_"~R0mǬv^ݛ2D44蝌p}1l>ʆ -Dcq•~L:X|[f RҏE(9_2k EC^ b-zkQ@s}{r6x^#|a&<0(7@n9[ޟ1Ē=˩ón^h\AB^+t?Wi ׁ|hX1H?,uyKd/G4do)6r7Qś/sz~2oVc4bH;KZzX ¥^#I!naL½O7ӯ5_Q"Qa64·34}rߗ$kGF(\1_y&(4ה4[ o9Y8H5lFB[21B6sd}N Niwčn(~JPɴ7^>⓾ 嘢< \pC`*zanVmAP#ɳ8S2kh!~11a 7@ys WL3";`\oО[ O1=!"[ wb1[/^ MG6M~=čQ{c3&=#Gepf XUÈJU۟u|o%"$A~K?\eUif;BʁP%x?mh% Unϖ7}V3h*/k!6tW>fXXq!4wPu}?V2*/ J8=%Klj)9Z#͖X7ow=>l!FozlM06#w"녉H/o t8**Seg‰~nGj&(ޭ J&.`tQ,)WU؋/3uoQO*?s17Am>Bk@|4ر≎aF-4s@a}tkw=ǽV"&0R8# ?o82kJȅ Zv77miHk)X8yyӵ?Q.Xڟ߭WY#Ŕi$Qzg'F&!.E ЉfkO ` ˮǁklj͵oZW۰b4CR~?VYbc=w ZF E{CSܨYoNF'?5^:ѹR٢Du$@B"h\FsȨ8+(0“!:z|?sأyw|e2-'#P' 4V"q5\#\,ɦ0{UIMU9;ܢhyD<$e؝Bj0 M1>|ϡy8k)FҠIon̈́[9۞C-ػh\oomi3脉4^t_߶ Lɂ䕰x'& |+8VCjH} 7̘xW^Y/2]\&YOIkvǐ=[3-vn= ֜l۲;&EI Euދ9>I#>uZl? w'H^y"|W_'罾?m9錩3}?Ye%J*{/X'?(NafY3j~_CsYfL] k&CX?620O!S/ E6Hfq䔠&߇˹cTōov;헇QCa>!`z٠uc2!d}c[SXKAoԟi &)/rئ{<'ua)Kf M]3~Eh;Sk'N+Ԇ Xg[9*ØH(;m ٛ|6t7('V_II;J`$,}Ew4:!΢xt"o?<ºᢻ UNdI MC ӜHF5n'` )Q4$b]H*jqN8 )mt26a1ϒlJ]VȠT ٳ١Y{U 'QM2mLC?)ΙbWfn`=Pva$0n6ŦbS{EAy_I]@Ե/ vYM#tVlKz7hBjiǿzMkUsJm!~ً=QZ%OE'|hKkqra KM,ha]Ð Д/QWU4,Mh]_ES}ܬ>tYD]2MA~6'7xpFsy} ;VB*>u1֖N4 Tp+C=X#n>'H+5Ro :jII9u6:r$g&D DJ*frTuV[J;\I3Q^>5 Sbubևy;G l.dFgR" NN 䣞_"vHhңuSw5V~( 5l`4#hXˑ6T4sXO0WyE&*>mq=| mꆰ49!a! II'q-4a~CwURR'R B|˷!]M[њݨkaHEPUSZx:5  Kƣ @Yz72hl!n5&3] jUejF!DC"G.ePm);}'(͇s(gGwk7vX$ rwՎqgs4^ζ %)SRt^²B@k^#_'~!ڈiZ=7r#\O4־ؼ$2X(%8q1bpSV+w%`&LVt*@ubPwZc"~AiH wPmQ{NOEЋ⊪;m݊cW,'޶["N\Zi]9mxSQ=vPPbfӗjF)洜g Jm79[؉i'őȷA|–GaP 2zkVޤrD?v"2"f.˜2&?Tc)p`6><$P6O+|A5i~ĝl^)#D~)%)+2ڭ=vI>/>Rb:AIN9F$G?QYqi( 9%Ciꐯ,9WmˬsӢpmf |o¯mAf ?<C0w *#p⮂ NG_&ve对ƭI5+, .%Ij7Y~OrA_i.ү'Zb]q~sў|= k&+kt5ʷ204xzWOΤ' b;[aI KCNzl3(u?cbjo0/Xmz" ?} ,Be\Ǘ G}Fh0W):hl|Mn(h]9FuXWm ڎ/Ye,DJZa!gzPMȨX7m<=c{2vC;XI] oUY_[õEt2#MC[V҂M?վn&[mq \MMkMǪk2,nqtҮB|&7Vd? endstream endobj 56 0 obj << /Length1 1407 /Length2 6400 /Length3 0 /Length 7365 /Filter /FlateDecode >> stream xڍwT[." Mz M$ދHd$@HBUC@zDP.H"zwݻֽ+k%{f= SG"0 A4@EGG$ E@a..c8BÑPAOu}OWHIHa Po % P{A}$&RAN>/HJJw:@ C s8 ܲ -D9g! Cy_#tnF$;FHG7p ƥx"0;HSCk:Hre*GNC H7w0p8]a=umAF@h$.p߭J0n¿CCPpw Z w5Я2cVC@Unn0M?U8 _Fm9P_c@=݅LpO_ JJH`YƾA/7n@w;7,^0 ߁[$  `0'887񏍻`gecpTtL, ?Aee_@@@aqn:`_}D8"q={Ew1]$0?L!/7hݑ8]}B@⿡f?ՁAnĀqrPB8(-pT8/0}$+S1qOI"0݇R8B}Ip L0 "\ 7s "uђ!_?@M (u[0 B25D4D}SbX\X`Ėӣ6j%(7gZB} H啮Oˍ|E ;:<1} B4e2T>s,y'ԩLjV݆d;#t;:siL 1-oWĎ/%/=NbגA]Kv ^a+Q 5LkMg˼(4Tht HުYq\7wɉvN&٢^V I!".S?TvN0Qړk ˮ7:_rp8WW2uɨX & PzC7NZ4@>y=%&ѩdu݌$m{]֍'`J}$N&+1҃/R)SRShwlrn}_<T]fִ<:L기|Fd0&=c{ j{d+#QPQ~X+9·jڭ;?ǝ2W""H߾#ptʝE$l]_hv.z>6S7y*S@n1yoT`Xrڥ'8Ϸ5.X~P啮ޟbn @X:`!*t AJϼSh)n:9\!# u~,XN.YsAZ J׬CHJN9\ǞEY^spQ>(juc˧IKK?;RL#^㕊r;2Ϩ]N%dj_'"r  X6HZżAP7w@ \=<$󾂚JT<를&Z̄c6dޟݠzsZ%kq6vVmUt郯/-)Q7܎s Rzg(/L]t'Rc6{!N%͖ˍAJ4CL(q%d l9jL gM!1̣'Jrsz HC잾2p=Tu=dpO^SOwyVU︚m䜇ڇ갯]F<.E&SѪ:~#*%-3.cJn'-&΅A\0ә2 }FAM4vO>TpQtLX&W&ӰXAIg7U<${z$ȆǽuIuJ,W!uS'F}ʽKNa_{W(AME\stAgsj;}i"%r}u]iDoQm+N<+q]D\?%Pg U~xg1BN.Q.ܼSt떈wLl=KiWigK4{s((6/&|]mЏSgdr8Q.^3ѽiiI> LCI?u"VA~xx-+`7isBKPБ[MjmRW\݃۲G [.iZ ?f,>4TT'>|cX 30M ^U|A)U|Ę]6cܵ|D}3& BE%X[ˡ#lm0,{m]W#8ߞ[6foZ"5SK(ΫUVK.ǏawC>>}/dћ=wvyXLD,s4#R^?v.QER|vvfگz=TܸDuE׮ZWoK˵?z2 e#b ,@vwxpCy(Ǥ,>U?J4vhWE:ޭjL)aA}Fq 0:r8%bŧZiň]w0ĖXP2!V"Xw%u51PάuV 72@GocQȔo6(kҼTJx r2w3dr:oݏ05T,a6zŝ1{\" EwS^}x@.؇ ꩁj0ǝtjX{I;]_Y,b -ޑg__程m|'R G2 ֔RI]{XI{&}_G 5?Qq:gqS%/8~>Bm4d۾ "x7W$qpƞqs^iqO r5yBCnWXn/GN:(%{ٛ5̎5 Tq3fY4<1 *@uu=*4|Nx8…w縙-K9F6$gPٞ: ?1i^%Gztޝ/"G7REEHI^Э8r?-e|rmf*t}`^N}|.;7)DEA'.+亴+JS%kݺ>94gqy$6lR#GE*rz6żP ^fPd}|>tYЪdLݶ1k病r0oJcO^q vY";e+şS1m!Ş8vX22$:?]2f9Vxf̢zB\j9R맱F,|riIDƊ%+4'W!SNoK}%dۥs5I p Q@Q$R. o Y}ML~Ge$qB4gT~B۷}.Fc|5r|h +LjÙo4>葊CQ]&/rCt&ok0Z'Lciz5r⑜gܯ`-jXNF]2(Z9ɡi# }7qw&xхn&S#iEi`-K%`&|z|gT˲b-NF* CNxh8.Odؘ|U<y")Ӧ$dڥSߗn}m\E:Q^P'+3~ Tܴ )[/P?Ks@.6ass=|jl+^A9CRTKC)3O8ꪴ6ew *+wBIG1A7IW}o{y~O `˘QCS3YvGV=\N6"b ;<=ec9-}K(V(;evIŕwt үt뫣>_7_mgrwؾ%14iꙮzmپ`&x^dȣ1@|j<CRvQMmK'k|;ȂG{VN8#8 }*i#٫$"zH5JG)E6%"TN] Τ5ޯx\| YIxyDX oH5򥍏O/5ݜ7oYYP;S ~nXu %ᔙ r;a6֛?f-;gk k2W|V)g;c{1ٗ}lt!g?U\Zoc,esήHe}isk>^@EY):x0fJUgJi"}PYBX{+W7km>DyȆT/A(@6b"Ii/Ay f۩V뚣J7f7!gp- . 'e)l6藍^d^З|iu~vwZS'$FE*eWOf悋+r恕'И Nޖ!.P-~7kjgGτpgo1 9G6{*h9ױZH#~葈AdBH[I˝픰.]&x5>ܼLOfCl!2P%WHs+y܌nދs0 doLmgWxFVp5*M jaIz3MkU[LlǶ ;b9ZӀ'E c[kyra?Ot8#R*m>>Lw ˗ʞZ&r>qN*Sx|p{Ta01h.pnb>dGdt!rXt6tA="A|}}?y#UʕΰЮij:y9%,t<;RP?%i"…I#ۑpg@k!4z#U?OVmH4}.\^FR<# hzx*ǰ5CSc*Pxi3.h옅,_}ʎ{Ñ;mE7^1!2Etݻ:S%tHj2QQaZYr\+^iǮ6ff̉AG',Z 2kRmڒwQh j+%˕SV!\Z4Y+0M+&tT ~ kMKfjoz4,:#7{"^s\Tg͆3?{hk(c +wLzS[u&bEB_+=;7Hsj08ÙoljX+)_5k 5 U TcmpHdql{۝N&-Iǜ"[S7c~ˎ<(DX-K9sэ2֍<ˑ7Wf(M ٮ"^>q~_+fZJ ~WGN*j-m(0,ՙS@-Vɻ`v4FOޟx,>b~?2P|Wy05jǷ^^gͅU]s X2F0?̎+D(9:|ˤ -/>ԏ"6K8a2B-yt$׶u.}gft_8ui0 ߳#Ifͽ4;8I͆a5awja/MmB@HOeGFdHhTxXuy֠B0޲-]@wODŽ !Y>k em&\ endstream endobj 58 0 obj << /Length1 1572 /Length2 10209 /Length3 0 /Length 11252 /Filter /FlateDecode >> stream xڍP[-Cn$}܂CpNp ݂%yVݽW?CC"j`rAX8Xjvv.VvvNd 32l8h yIB^y  +'dgX ajcPd94`+k17gp1mMAES5DsS; _)腭!GA66777VS{gV{f t]? LwƊLаqۮ` q3;s 5d^* tDId+aXR w3dhjojjcgjJrS*s68BYm'%A@O}6`=ُ 7?da G6M PVʫ 6+ ':lkx8rr1v|mcc |Ar6u `:!sp,l!3 _@˿mU^ ;_6I- Uem;OL`apQ1Y:uLS?g9KU@Enn,B'M );?nS{;u.7U*-l\Wb +Yhb1[-5l l`y{]-󏯯WIn) 2wb<S0_u- r^X:ܨ/66@@~ݿ᫬lN.k`fq_S:*65^q)A׊<5's0U_?4Gq0d[(Imdyp[į 遫kѯ]KW" O^M-ޏƱj-sx}cy5oHX4Dv>6Arr}#^[82S+X%R3 p&,cBĈu>uu=m\. 0+Ko3nsLӹP kxKl/Q֫(oνI8s gZZ8uxc++qV|Uq1R8RHn)ziiD 0k}P<8r|;0]~Ң`i| dC(4X+L있c#]z',ʧT}m s 0%WGi5Iz}vdh:Uj`TP Z9DBY?u>tl`A@.VfK O*a8^]XPpuiigu O_u8+HlNw1:soFxw9Q\"+AC?+/=o8'M_U?gu-=j:rM",q`3mT쯑M^v=!XXZMԋwaϖa+n $UiS}Áa81*6.v2b|&L {w+8W :tW%>|f|_٪R0-JL dN(*T|?`@$=p$Mi:35l.lO,Utko+Y{F %P^|1UTZ32lCof(x?S{W8 &L gq{#۟6ͥ Zd}Z-G= ɇ <,x*Ӥ c2P hB)M>`y}TMq(xTZHyĤϵ̳9ӉAs2+~lsGܾp"UsE;oeѮ^ 37TJ.w7 tY ~2t2K{~lC&#X&Oͩ>T+BMm_Ap0 'B"失J0 &LavqU,!\qK eLma,@B+x1Z'W>Ϝͺ7H9ͨƁ[[N+uxcZ̘H6;ůMb--w"UGqwGw74=?&qW9 JWOdeK! qEK@* XXJ}"P񨟻L~̔-Mn.n~UZvkK 6V|ަvR}HtH9A^ |2}KX,R.@9-hm1]-%EB쓀5,F~ؒ6 ֽ6 [cQϘYh*/WAYw!8 u}c Y̧&;/"L%>/̪'o#8}zd%[XъLf!B^%oU[G>OEêPfU\an/! : ݚڽԭFCrlV@UEgƂٯeƽOwܪ߇}NZ8gG9QiH幻y3$ Q%` W%pEi>jYgx9+utܛh)sa7*#yQC!~+rhwnugkGƷh;rτl6ol1$Gɟz޴ u)/@ucU4sK`2@󎕀D$()d[BL|ynXF<#K{X$ߌnODQ'9L]X/\7)/ 2yN ;Tf';b bisHO%c#ܵ<0'2( <} ];2HCbSzXb_qA= "~JSߡ&r;~OH#E(]@ [v[;T0{ݦT.=4(eV`QZ`.b)ƒ% =#%qIP^:FR<_t%Z̡>8?q@H Z5G~3r<*)sxq:)1.AW]ZOUd]v~ Bޡ_Ce= @"ץZ4>MA_aPEw~")zKխ.}L3[;2Q5DZ4̆nzqԼɑL }9vwq[eLiyW|3|uꐆc&1D!.NoĪWxBÎBY3s rVIf0JUvՈnV˿w:ؓXd9QDn\-Y1-T+֫nh\ ~<{P+y Dd[m7"ꆾg`Rfߐ'fR5I%.KUq X+(M6M%v3s.c@9Ypˑ8rdΣt+POEΙ 8ފW-~Hsoc !/{{ :0}ۮkp51#R51S5Y+& $%[3:M2ټ7~Ӭ$g"s Rp"!h) ]q"ϢJ OogdhW盉-iB}H^,tS߹D^ۈ>aclQi$CGH}]]9[:!QӕNV7{iM$=h3LTqG L L'bܖKNA#^3B;+?V':SI G/pFsT.QqaW;:j$f6<0̛{qn4L&|Mi%RGone&`gPwSвHSEi%+މ#p.&1뫆(Xl=Ly*Bdp$pPx"&U,&VR .~?0XNlIy47|ٔ5QM~o;2I 6Jz/LE)<L;%VԤEІ"'w&sF寅xJZdN'E\6.e][m'tWׂё djˀxQ&KI 3FiI`ƘT .|' bS-7z pb\8YėV[ :okXO lͱH2=ѓݞtuv~~h["oCrܙ{}F l&Xhaa&ڇ%3s܈:MɈQ=wlL?c}y sG9ѮGL:G%zWyu+}.#@쉼{ImMIbAͮ?[ 0<)Y3-|t|9_sՈVTKTDp7νrcI8=c+̀ Nî"ԑTq'Cuzх/M~\8CPL&LsQ(得D0'Iyᣀeenq|aa"unJFEu dH${'hEPJw>hjAZzwMZNjB!{xCM 3.3nsޚ[cSm75uD/zݝY'b* +5۞{[amk-_fs_|ׁkGZrI:>>с=K'ܸ!0VIXR7DO7FSD(B)o:$ zd\x_T{Ɠ2T̄ܩȹ.ՇKl0i!rl_IZ+]ߛZ3l|3˸qh`V-ö)3RR='!x$2'u􂂨ӹ^%\b=m$%`:W`?B rybF(;.}Yy욺>je\?9z~]1Ɨ5Ns Ӊ$-9+b@iwࠖFYv:J9\.ϾA-tK+բ!ɘ聏n Va?q,l*p?[#:䧷:;4!JEoR{o=}r{kձ-K[ DNgNQ8{X4?ʥ,.?ޡ{#rLp+:&* \ɽߜ}ZIGN~LST"٩#Hf͑R˒:@mPg tdI&eLOz՞~Yv/"}5#5 v7,"~3G\ޭ/BN'6ab 4iw>.M8 B8>R!Z"Mԃ׳t_3kXsn\FHwK{Z39J}jKdHH%T1q/aYnUjFΰ䤷Ϧɾxrmy0&-}IˆI&3ٚKnh];F{AƷ"3yʼnHjڧn ۿZpUbI]4os@Uwb]bI1Hמt+\=`ߚծkEyM4$ ЋCY? uAD.o{hdaNƣ?'VorDjSVQ9Y:BtHr)lwP(/jI{ik:I4k~Y]oNf<"[񇹥me'4Mw2)#Z] TzEa"l?\ LX4U4-0d5\hJ.N>ţL*ggI[3͂x(52TH)A}`= $*'--,9h0tM[p Qf.5eqJxf1ߪ/ca0|VRy}fTt92VmnVEU*ub]o\BK ?\%AeWѠIC*_08yrͼqio|K*l!G!w>I&XZKu7)A{m< :_XC ~#Zm~FoQ6qIne1X"vX5+2eAE=snfHPӔ)SN6KEw0XK#m6`SHB}*%E cY9P)V˧=8tIhMVa26tӐ`iԖ?pw`nCO.Z,e8[1O^x@Rr75WR/ fhI>sܒWb0׊ȆdGrI T>}G~[./Lh&TMWڭPKw:s5j?KUJx:Όs}lXu1WkH # ~.${)/,-3Kdv;E, km}솇l6CX孔ac)דԎQX,haI  "JӌXF?!: N #Nh)TvPz!o//(PN L'E-7):(sMvچܭ,OUjfѷzdbIymߖ8?L%E .,COy, ku+aҰ#QqcP66FzuH "-Sx #s3E$X\>> į#132(6/U>1Ƣ:A>gZ)uD@\bu$C3XLNWS[G1\XPZMx/ϡgͪq\fv$ُS1me+)cd3CL IWfAS6rJ>b  4|R!1rg*1nP f-st)ڊLϊT5L2sqYNZkE?fy %XZ_he3٨ĊeVYۣj`q ['L (9.lrogt^+D8|+5BMXI(D"hd_ѝ73NjMm-Lm gȏ ONl(sbJULwl5X?;uw$$Gjs[N;ږv||["txnSIJ-C)yudUH@>9 ĪX yy^ &BS D IkGM~Kl~tQ|0,|F]+=1EĜQ OR AL)flӻ&jiXw' _M%_Lﮡznc%W;,xؠ]>T-_$z J*if ݎMy󙶰.?B%j.rHbgjc˟aQU],LPC`>otcIi}e}Xi2/ ߱ AKfN6΄Ϲ뮉^s}ѹPQ@]/!hP)z=eWђEl%iBa"∳F~n&ݟ/ PAVh#yh] g8M4Xi/]o;NOV'}騩H`/,*sX0W<"im=9\%]GWaԋ a37n^J7 KJ' O GnAwcXc#h·G>05hn45~_<Ь z:80q@k㝋}T:Gl:r_$=Ɖc{v*.RQG1=8]"MClCa"1l.1'+ e][Q$S@@p}JEbvfA{[F4GR}(IM -20Ly$Z4oUJ҂8|.vS5BAMP`Se'lyD%qզB')f3"DG>()PP-,@6缷:I[XVRGmxs# ܉s Z[ab@sXdb{U69ܧiڑ:. &Pʊ(V u&:n!;5;.9G(=V=䅆l+vYs,@l`0r>D) /Ø,TRT< ]*:;0g:|B I +1ud[pieXӋR/PC+lZR[ךQF[K'yܪVRJBm#l x*|UO ŗH5 _- QE*U]RUϻ'.DqΥ3בE4(\Y4iע a/= , 'Ea[;j0jMlvGh+$ӗoB)E!c9r. dl^$Ug6S]VwPB]%as٣0ehdRG/\Zbš!N/!<-)`r!OA񪿐( ^[z'?\u%Qit^%HCTժdx*~P[bVcT覌poڤ|@qT &3AϠ-:(Y })$g05k,{ۏM?.vSiblc1[s 鐂U(Y'EFDd}d/͊151~q6@iߜ$)i.B:B3 ~zd@#ֽir2* a9"GI<}5TʁN L+;b1fxxϾktzgۯ| 5>i旋wI &mīh\ݼzTYRRh{P2G -u6v^62<;~tla:=Fۯo =t3Lu?&]l#-kǕh"@, H endstream endobj 60 0 obj << /Length1 2116 /Length2 15040 /Length3 0 /Length 16308 /Filter /FlateDecode >> stream xڍP-3w;.ww N }NޚY-OR)0?ـYX>Y,,L,,lV(Ձ68 l@i'++;#+G 86 1@cD `fW:@hond8O42#3  - t; XVƄ@ P53wۮbcb`̍ '1~8@EJ` ,w߽2l`ddcmkr3ḼOL _V6VID `.m̭{%@b6@_Zl\@& cD;2휀Ry7!,,,ܼjd-_Nֿ {>}m@Vnur2Ҳ2+OT`dd9Y^͢h`*XJLlޥ)Oݠ74f\y7f_n?nks+Ϭټo~r@cs'r4xhhhhdmWkɬA@E*FV{,#'D|_>Rddc׆qr X@0 dx0GF8"F\f?,%Y̟ v)sA<f?S?4xk1Y H w{CO_f6d0&/.l#7"-ߕ]?zG#{*}b/Oޓm.=8^ ǻj[+'[`އ3ufG9]?=]۟:S݁s"9ٿ uף}l-;jD]'f)2z,w:=&Vgoߋ$J x6+|֋UoGX34Up*R?H OĨ*|bg -Mcă2 Z?X:tP%\6W3$ԷͶqdq0kқRܭ qo VʈOG4ut!f؉~bz*}H au^} Nӌ:uU5+iP]:+[t ck|]DFlqDzo8Ni9썊z_Oiӫ]BOvD+sx2 ?FG=6ClO8H(-Jwfk># ?S(*UVBln'.oC?b6:hϟ<+!e  Y: p;-Xt]O_5}:FݴF[v pjlIXTk?l ,z[̳g'=cryC'\!<JFxOL!wCH-ʒ}$ wfqѕwoB`hPuj],qM͔-^6x9⬙/9?޾zAȧ_N58[0oqi]vظBbp9IXܺ;Yw|F= t7ˑD=E[˞qs$joFUyG(%Vs>\3fi\l˛?cHHnv:=)iՇ[P/310: +pnRRݢ| <="ƒE-~%`=S"ss apu0 Lg͘QVһ&:Ohx }G\`G'ݘ;CGqed $ɉ5CMR'ՅZibnm ׶4{ȅan*be[V%qfoHV^U9 ֈsn- ""܀t6 /@^6U%4f /kJA)˚mc{Ma9Px}J!T%[IvSbWDB51 Vx;owʷ3`6 re /hz ggG9ZʥPEPk|Ɔ1eRJI;''i!=m+[IYCCq8v nU.R-R NU5>i*V : %*RMU׬~T.N%F^3i2v@:q$hײ eWLLH!}J!TIîU`K/ˉ/\va6t)LVZ9$fѓB ݨ?ۑ^״bE+Ka=U 9`jOK'VcrQPGt8!E5U "aRKD ;*Gٟv̔ [諌VE;"ahR;s-#ٰJ팚 Rf}֯\lJZd85CP9{6ƍZڱe꣱f=D=)F3 bC⾒7 YRK+Q 91$9ckT͞׭y h)lӆNiZ;VSv4oaI> eNCE"L IFEmءT?P~X&̭o4^5P5"50򂅉O[a~ (WfsЋyD9_]@¤!rXRwg-D2AR]dPECM@In y[$5|$#~1cWTb,%~8p= ޓxE%!'d$<]Ǩ?LU]) {B|YD01TťA6`J2 юwA /G%ِ* :KaC_o/%FE qE輭Ԧ0W=Z@{Dh7T`:u1Thsu^Hi kLc3(Xx*AZ05O!m^B#a7~!Ucđ)58:1N0%CRӻȃ%} %>]VHM7 x'e ULkes~>{vA2#p / `U0zoe([ōɩ_Y8by `vo[3t?y !)D2<_x'X{[\&d}r&R\.1PkEjgcF.x`Rftlsn7*uxaJDx Nbg}Ɂ)Bwj _pW,س.yO "x8)ꍠJRVKP[GPƓIMۺ`Ԟm _³?(Q P;7cKs)K&ߏ58[oR=g`}P |^c[|¤:@<Jr/AJ%=Dt(2Ç&߼HxEex'i21m|YZ[񪲠Qۦ`cYQA*4\J$'֑Mw|pJ)V/ꁽ>\i`J>2@3Kn $C]H>I-[|z/hJSẄU~Z`9$,pȩ?ϰUf&md+D~暟r d^޼'$/ 2 wPKv0Mm"3fՋ5켓ga9%tt-ap$[Nص4Xf\%!nx7lHwkn[|bBiV{te|7.JxgZL}EѭxV&"; Aۍ^M¡zSuoХ7_Kh'}k"~Rư륖f;C]};jD7M0X/G+wQgbft&ƺMPU&y z>jkyR>QqڷOvGq=,6Ǘ ED"5bƈi0@vD0JNj¸nq t$1l 猜S3~V5R)ׁܓ`v/MSv5M̜)AK|sKB oJV)V^$b+!y?i*r,RHQ΅qKFKL zVeŻP/nZ90ĒE.\P&&DN0c: d8 _dls{T,`2W c&\vCR`S~PlAdb bUpȨ *BDYi!̐Ǣ{Rp3;0N` 9ʧ(^#E46w_ϠG{zg܃"?`|O[od\5|GXnb|!V%W.#?$/+򬇻X-dHB*%el%H>Qn zq탩z;т)tEۼ&?4\a*X=_6s7 m ęDwXEg$#la?^ϝ)A ag~i$ S[jkVr|%Ԯ ,@JkԄT 9N-ĵrY\ 5&w92<⢽3ߖ2hA]h#Y@BRp+K˄ ŧڠW`-q#]18!:/MR\T9=gqSDa'Ԟ& C&͓*ٿMB}4;^Ʊ+QěK 3ns'''f.w/"!< ,%Uv3wnSsL+ȇ= T :6Yx/l&yFqɁ PLÆ?DۭL>93|*sf*}\Fao>{jcwb\D!U"9vcH"K'1{Lz\CW}=\_0)A}sz.8~}$cvz9bxϒ"A8B,gJ>wEP-< ͼT<\@k&w'\'j-_#[? dJo0oFQLQ6f .)s>ߤ g;GuS*5ӵ ?89ƌ_qEtXExFT79Nwu4gwG`X1(&:~ 9> 9,  ^Nh .Dұ:@rMse!EeIUՓ@p| r<ނQ:)O|``' ? P7!b: 뜶8!lǝ%{KSkZ6kQUSLzci?>:㍚_\C*=(qJo` PFvYi9Gr``h$JA$%gz^cv4g5mtL!l)y8 +; 2Kl9fQ'm \2grU4 #T+k.t$g/$Ի*i#LWEV̳$ɸWY(gn3%k'+^]Ȉ繝,ƚ`1o3Znq:?7u0d)MGNaZNpY9]ZbҊI֐b/2<%홱j@҅,H .l ڡizC%5`t9׆_6^JKW͵vZy!V[|& : [;6 Gnwx#)YIb yΣ$vue13jJ*(x>]"S7`]r#:eL/5U\c̆0i +V)TVTm7(EceKn~ +:^30d##Kp!DChTW󫻊EO\udoR*e'Bk(rYjfv}?sӜݤZ)@m/;o΂ٻ3Uv{KP<_eUe[oKd(~hFmD3iuAQ9UL)*Ah%F(Og) }y:3* ; v-iq^ ˔{iwK!x>w%HYWhh 3=[~jJ]!izڽs#21],&ir ^8ҥ臍T3V/04/!Hfb\kɉ ._>O ;TDL`s61VIj뷴ӇK=tu1ʔvEWGv;6ciUMeON$9*h ;4†3PvQ5[RP[`ISea\NPdTFj*iV=|g}rl4N>ԒZ>e|\>]E'Kk8rX^)@oHg6f7|R/#-XY/H_)6bR*-hw5еKdGt&prϮd|Uuxy|+F/"@5&  C?7{1-Ю>F) @mDZ CFXvq VLw(|,>ts>^ #iQDmFJG:l~2 u9k* F;fLC=3>k<gŀ@QXˏ8'%r1Q yp#6UƲa @C2dBaI߰ Yjt^Lq9,nB)њ4>zl7%?3H'U[hIz~Is?4];XGO#s󔣿q.wO0VZq-I-@nQQf{[HfƽF|v#40!tmL+* |QrW.Uiœ2S''JH[9as?03f ۯ=%-tsI H1Aޢr<߈^PjxP+]GYb͉$7ǥ9C Y [mH~(>oMj4_SQHeef2!=S0:9i@ї2 b<|$ Rٳ0Pݣx)8,TX)QIQycx/ qLF*I;"5&)g5ԁIF(t=0O8`~e*J`7[X1bV}N- <=X wڻeP}Gqk[նUeB+ڈ/[aVQy7VEi]&v.t"iJ59>\SJRp7l"~jh!83Q)'&WiNaiI)\ӄ4I8xJ: 7f-l` ɾGd5QccCU<ǓM:d]t ؂'BiqM,e57ыP+7NɖHcW{N:8Jn''xvD=^߶g{L/*(Xhc%-KǠЌ=WzSq6uhKƭCd"ţG!`tث2eѤj}ۄXMLkozvc&4t97n pjϞꇥ:'F bt< g~ȰGMMy+k׹:i ٣6_ Fh34?\҉N[B>ΕM7SRh:۔Mqtƞ"}XH:2;{xTׯn>gGF8!iqa 3!>e% E`68~8ٌxqwb  G1 Ii,Դ#~#'dѐ/6<̷ êv6>l A+694ퟂu߱.4ê,ǧ򤃉rdL5TW٫y~W6@;{$ӝ)4CJUf`s.SJ%ܱ)(r3_$23]L P:ٝqR{ZL8+j85ob7FX5Dq=90\h]*Y_ {W} YtH2s-L/jZ7>.LoN4 wٓT9{\6]BL5Pv^>ʵXBOYMȊ¡K*qf.څѦXK&yY<kSb:0QQyl$0-D{8p=U݈> x2= y(jZ!~wh5̀!)݌jDx["5lGL:g?_].b~N4w<[JC/9o{LoCVZ&ڐAupD:~x]%yTkJ+©N?c&%rdWŃ}&U3Aq8L cF)R!jxt 7M1췧fOݲdiRBmw*Pi+q +L_yE jאHJDQ2^ok}-@&+dV"!}*+ޢu(Kג) !2)KWu'P[ =s k"1K 8Vݲ&WjH^ hyY@]Ma-Vj<&?6{:ssY~3b9"Q{ɰ /@3n82Rɧɤv*O8y-Ww EP8},vl҃خ@M5,]u[o"U|۟o+ #g",V ߽m~V/bD8[ Cm& v61=|1Uh̟IvU@G۹GCA>x.e`ԑe,FOBӪrJ06@Q8A>!lX{w!3jS`q4p4JI&0-wݟ0TbW2}C?w/%}c*,NhfRRR 5 u%f8 eB58<%bKߘamXfᵠ 1- ܠ>DjĚ`_d:TvQh(؀E)40)p8yxBJCtAlm9++cXq/SzOtNxH|E`̦j2J(oi*g̱jZ79 OGF34*$H;햚p?sbͅXWnJǔ |Q`)@I83drbጾMqIg`Fu#O᱙8OY@Y]1nw5k8pbLpy0bLwtrW*&p|aiQNj-p P7 Q]|zw9B//J/kuF Z(\rO++i콆'!1L~3] r,!'RC7쳳"dSʱ^?no@M QP3t3O&?B\ ` 6)j)`,udY/V9TneB\el P?s`⽽%a|2Ov~0W\N*Vmw634O5#(ϩHsL8' ֱB%#cݰt8r{jYU1V"TQS To=Di5<EHX93o;Ѣ;.a/A&ȸVw!&T#c"KzՕO#k܈R 6=NHwӐEA.V:I rB6dY"c/Ƕ}rbzDEƴ7F(#UaK0_h`/e1ɹ;(tB:;Nf̈-7Q PŭUy6!~vS?gMĒ_wJ;L Z)_&vEdv(]wp ؽ:b]x_۵ɽLsH?4.f=03(63,5zc7LA- 4?zjq)8Jgnt%bl*CZoWٜ֭ca<=:ǹÙP@OTׇl4W72bWAܼegpjmU k䟱W0. 37ǀP%$&דV3ځ^1#H Bꬨ{{WLQ5ˤUA_mW*KڬvB)1R/5CY;4H1(^2(Ŝ/v}1I{yJ$^*4XxBUę>t0^{뜉5u)) endstream endobj 62 0 obj << /Length1 1661 /Length2 9784 /Length3 0 /Length 10859 /Filter /FlateDecode >> stream xڍP-kpK#Ik5 ]wdf̜^սUھWPVc1$!N ,̼1U.33#33+ʛ7`'k_b7 G0Ė_b cӋ l `app23XycqM Y-ln? -w  4(;Yl^2j _!h-x\]]m!悴W@rp~7 P4#OxX [g[S%9@MFdXOz_g`ad;_޿mp6!6vƶ`[sPgtrsۚ64vM^  )0~i`;'GFG~y9e [S1 w}`ݙ-/`55݄-$#ɋ9 @n@ @(Y~_:^y@/?(. 3ߊF(,,S0 `2ۢE 2 c~ 'zBl1cLr*o( ```syEWؚA<rJ)y!-@9/_,L࿣8I:[[CQۀ2xᬳ  /[`Z?wVd v_ؚ[}`GIT,5~/5 qU ,{,?T@ c;80򲊦 ?8 `b8^AP~O$['b0L #nv߈Eg70!/MG&A}m/`5_d!Kd/%ÿ _o2\/15K?ve<\x 2? Y~ j!vezL9|2=`J`7ҦͥAS-bhsJ˽ÇXՉDjHIԅw4`;dd;s+ܸJ.nTrʡ>N2DkDM1ɘ!Dpb E1}y55L.0Swr:c'!5.)%[OѽDY9HFaG p4~=cr]Wko@!m;~H<$[j"wuܺmTH X@Lݫ#ىT<sJSI(4~w2ϕ wA_U, Վֵ$h鬵;&&jVR]a~\XAfjkn]W-xE^tmneϓ!{Y$v#x|tvSkfmbu=T5m(?S{&K귉/2da_ ${V5kGҫ̐|C2ZaR7C â1#Q-}{"T}en@QYUm(٧?\Ȥъ.SYB/%LNB##r 2fWp0< ?4&lڐ`~B]{۶EiRヌk3?5?ߊ7I1Zm!2U}ķXc Jt< C09.8Q_i͊m M'bEjOmYl 8Җ| QN$"Ajޯ}Kr [=ߌ0&d 'Ηni/hQK"?!۲ 6BL,߶OF$X| li^ND$ߝ p433ď%0JtlĤY%QQT7O2'/,0;#%vuW0صHKG{?p؉kzb=" m w2_ ۛ,#.Kz%І˥duƅvεe4 b|f?wGIڱv}3\V~ȳBM)HJ[O5ts|΃Lޚ/Mr7W8/K/c"2T!FE+_4og q=M3Y"ЇS!{ S#Zy56 E/g-UN3U[:ښg5NAYa}Ne >brG>)铟l$g/?Wc?dC|#7H!00dQjL'!+&ͪ-FIecȱ";ͳg{kj wR6{tT{fDZlgL[3&\MB.uu/F8a"2 '9:Rs!װn5^@\9=<ԝU^yǛ񋑔gWc8cE $>w/(g%k_F@2xx,KxT3_HpՆD:\vݫF%^lX.Cjjt1UݢHGP8{I_YPᯗ[0l.Vʀ &aj5_E[IQfQw#:ԩL`Mrԇw6^GCydZDrb-) 8upO˙yx]š)[:sX'#_/蚸Q0C|ZPmp53۾Yp16gMFe1 HseK N%BE?ddA 79I:#?1ljHgɣFH.=* |"[7v tUInسlF7JШm' Nlfm;Xi`WT2mK6_q 7!(}Wa;z\`WʅhE 摚Dj"<;f'-qhKRo:'*W_s[@ c~Tzq@8C>>W]c*, Ee\; EIq[p+Sq<*|K?iQWIto5нcѯa֗ QFbʗG>iaGcV%=AfÌ[G5-j׾$\utk)ܔ$ hݸ_f44.K9Y7"]v׆(hm-wQ_mm"q#nSج].Y›׃cT6zsdц(3aoBU (e;Fz: sn%/e&~.& yB9 9+C is]ȏ8-N2)}zNau/`GZpZ "+i**~/)#u-ѨZ|1Y3fJ7YZZ\ 6?"|:pCq[WP+RhJ*0 Wv4 {Rd>gi>57:%:mt/[/qf9n"4p4⢬-a@EfKI8d*(u̩IZ"bUY'Y` FkbԻ5e׈燘B$o{)d?J$F]52Hڗ+%Ψ *~?jb{g$EY}2#>,SN.fԾp⦌ UysMRwTLh1( kq!v~x !- gOF<-9OQ$ Hq$HQ ǿUq,pŢzt mG0pNw%Ԍ /C(w>ޫ&N46GDYkW+v#sߤ>MYNCqk+śb?Nfω{ܸUrhV/Wfn mF'՟b[HC8|d9(*C/"&Uό$Z[$8VF$#=bxyGT1i=n;_ (gaSĆ47m*ذM8qjEuo>AIsΔNW؍9e ;Lumy, CF}WO%!f8߽ٻӐ'Qk8E|q&X[NNёq%2U,B%b㙁纴5O[ k}&p]aUm<Af2#wPc}xR#\7D`\RפHNWر};tB~P;9Q/',\>(ͭ4v}_2=I&2 !̏m=f0p~-,p9,B5y;:2I|*1^j+`Oe 3;.LG{e?ᄩR^Osۘ\sz)2#LPJW !Mw!NCۄ!>b!Q9t޳m$}AݖRgC*݃fc~H}ϡQQf%k/جjwayc>UV`=t.O7. eMg )O*NjDD"5?OOZg vA01LUD#Cdgߥˇ'W-G؃.%(<^y(WnD+OAqOgAF.}|eYS* yrC|~g`gptdӞW* 3bb50Z=?(eu*R䄣[2w5`)4v+98|Zf  I#6[E$NMgRsLߗzVE~*Wu7lv>;qN.U)H$ƬbTU2 mw"'ԣnNOx$U%'h`?'b ᴩĶDmHo~W(ZCW,,g4UWؿ|+ydY,x'y]ZBI!3>{sNhW/p_6hq2e9=8g+{pBL#dG"\*!f, # hL3졺\|0{ lJԣaķ׽2q6i\7l{FTbҎejdkCD[Cr󧬆})p8[LWύK8D)fr%SKf"- oƺꌈg z̧p,!ejד)X)kM3QHy·g? ]ٞr z-ܵ^D/Ei${l6%> ^2L;7y,x( ua-75e$Rcz퉾LHgCA2GoI\X cZoYs xDytV?b*i/{>Zy bU"2Z.pfՍl#א"v$d* Jy T.Þl+`?#Rʜ)TjfDAP2`t4#T]a\ ^תyynJ!׫ 5Fj6(OR+1lRd\9 6Fin&ڢwMnu{}*UJ85+ GD| LדK~čq* qUТ% LL#=e,N98_thO ĩ꭛8| m 'p4̀#5tjMji>p/b {9m,[iIA \c季OJ|;+v\*0[u(>PGVQ`io8ӵ4"N&._òۡL#^'t7zN#Dei YB_b<=sK@Z a3DYP@ou:JDM{%-ךY ͭb̦}#~VpQ F}2V~K(O1*U4FLbuM5_NS -Qd?dV{ȯ.91#)y`k` +"l`f_߁3e9'X^5P]_CoeV9 -F5EĊImPV6L2<+{Dl# +(_zX˳Y2K endstream endobj 64 0 obj << /Length1 1357 /Length2 5946 /Length3 0 /Length 6879 /Filter /FlateDecode >> stream xڍVT۲I HG~)JOBޫT)B PHQ MQK'"MJQ HE=w{kV|3g|^>oj!qA`8ID 46W )D$,ly#XAX?$pM,#ڴ`81 {P*UP@iD_ @R kb|Hw-(UTTX$a8x" X`H.)Dxp>J`p`` 'JH`C`v 1)0`caX@4x#1ij }#菃P)+;cP>0t0!U#)\N]9¼0xX s!:.訛0bu"}p~R~H_!^6UB!8?ЯXxcBc?k7$W >`+4rDA |D+e7e&naH7 ?w (pEq hF'E!DAȯϿWDnb.X@Hw440A^RZP4@\3) Wcn@O[WM_/ae!2Mp{Ni;c,oߨ/0;/Wj#Wc+>FԀ:ߗA!\M8[70!=($*#7 Gj_꒖`X,,D1q'D"~3K18b@l/ p`A)/#X,QVO<_F p~˛*y%J'M Tiϳfi=LEv&bRC͇AoWhx%-ՖB}CEzד_b0g "M[4[z.oH{T^U}dpQNJ$V0K)A8(lL!nVhȧ~\B\v|;,.5V 8>K Fe>8膏(\ F&_zM~~}Z m]/ZB7b2ұD 2#NN _KK' {0<ϭs1 {{2_e_w+| ߌ^U8 :#--pYږ2cU#ѸH8Wᢐpr,spp^-Q:Ly5p͖%'ՈNzRЪEq))飷Y[ȋhxu/%9߱{V޾gBO.֧VMyJ9uњiNH>~[ҥ y\iƈ< +PvQ)ݵVWrg6r+Q j-ZO mSuѦ= EaNB_kŌ5ಳp [. j-j2ٿry?g3畦1Y"s6|4~qjhiY!}SU,)+ׂڃkjӯGXf ="6O*{OVTbjL¸4LAیyy>HJʙs<;ߍDyfV5~`lsVUʫ)"Ž%M`kuu܏'t}ZGm6p5pQa5+ t4BmIw?57>pܘEa8㗺 vnYںM~:YW9OFU&5ZV(S7 ;~Ig,H!,B{=X@ 6_XPUmKog~|J2/:H{}{R \Ń(q^D:2wQ97K.VSU+(kMzVؙ<1  lP=!f!*7B6G qaQ<:Y] yO+QW9z\≀v%F]%f8& O:d 6M5=S'u E[!.òi6s>-p;bW.c<-rHrB*lsH:'n9ŗj>Űmܽp-$+!{ϷLsrvJ.j#ɽ]џ򹜑_.A[h*YH^ęう8vD# <+s-1{S%ޟt#PՔgWQO"Ǭ$hȘu=9U}Nc ;eMZ=d2[剦ܮ)j+(ȨfoG]nqJYތ$? )/(\c#/}H^VD_TnQϭgeW>h|gjƭILdfDHY3e Le-9SKs$ \UX ٫;>}O43uF})b t]aTnHpi/mC7)Ӟ `N;xubȃ]e^S׿2o={M5nC6ژyZ=Wo1WGF[1ϧ  c4M*be>ހFˢ\Fa#;A(T9e1^zmKeKrוu5#_ 0o=@qe,BvrPSʕe:Y(sMgeB \k>4su_f&Ukz9 ;Z\oipTlw^-]Y廦Z$-}l,q9+m̐x|Y(Q=˳sVzm2wAM2kMƈGm\M+ԫ/=Ż滺SRo-9 61^+ Fv0xz`t9 R]i^rf Vy\S G"-c&f:ƁG +2{R:N|6y:a5ɘUFC.Q.Hn`{{> -QMPTڪ7t0 >3Z4rƾF68JPSDxO_)Py7a)jN6v'"ldhz!ծ/l[:G&ԪlhFG>A*^M;ժ 7ZCHщk]1]z:҆4~z_w&n0!-(",adg#Llm' [qto_7/NNsUaj{[F>ʰ~,jn(WWX"&^ॠNadΓb\d\.4Itzy4p'-̉pus&k@) ^$}kK"/ NEBc}~ӗ^ӈ/|OOC>PîuԸ_CpT+F2 )Em9Qq(>Χ։'uHyg<'R q?K947-D.rZGf5f5#ǵzW ҂1Zbk-* ҮfnZURCyz.,vj Oj2+ӖZwWQ`g?Lf12Χ}Q5Ѵc%\&~tU-7cKKUA:_wզjuuxK 1V[/1"kMSɁO]1{CwJwa'%oM-kٜq+DQ}*EF_O{ǎ.F0 ^|R-hxv#Ua عyFbgCRn!!%VXpK}>n)-)``uGܟ{vaIc̐Kȑ.!cuQ%[2HytI) M *kO?mfRtV &:wFR2VGL6za˴48S]e'''MJnfzBesc.7)$]c@q+)/sBcE&B.>}jX@{KtV.v}${P7mTeK=>iOb0Ib21"1M;0bI<:7tg9%f.Ht[ lz+G3iv_Y = ݔq3EKe f]Z4}F6+5Gh7L VNr+*PZŸ4ҦC8u}}y4+3кx9.p9s>ǩ>۔2wN'(tw |cꂝI$eW5.0)<ۅ"mxҵ &6 N*Q i>+ù;8 X)|8j~I9)É>%w|TwﲿU ǖ! &jHЅ/`^wعbԇHxpWu@gw7U5շ\\"F +-8ku >;o3{|2~)h~?_G1dMj}gVVeiv0!<,/qNCLudSV6bb^d;fTrÐƌ䔀S=rS)A]Jat'@jY5v?YaY+S%cNҽ՞eW;Z?$,ZL<M3(2Ŕ[3ti5 [>3Jh2̝W\֫Q6ZRlA=G'[S. f"X+ʝ$@"_}$ gswVh7oUݶT`rZLBIi5b<1 BƳMCݴ%DT٬،4C|ޖsKuntd“مW#5,ݧ+o1D4pĔ:}i05j0ugMi8o50]n,gS z2޵?٬P?p XXϳ[&F\857Yw<)>gWBu4 gS,"8AV+BÊ);AŖ$|?ɽ+V%V~bCSE"^Ε/jQJ{ Թ>yXVUȭh;dtW?.$AKY?xɁŤVq^_~<7AV/=U"Jc3rB{7`B{p?CkGW7IsO gŋ {sM> `Sqf]sUE'ZxS o<`9jޏ1fޡPvySO\X4d{!"D]#MR6grh0A ɢvl( 8`Oe V}oJM}oDksKOQ2N1Wx]Rdg`\30@B@QMl/:oW1 endstream endobj 66 0 obj << /Length1 1357 /Length2 5943 /Length3 0 /Length 6878 /Filter /FlateDecode >> stream xڍTT]sI``[DR.iw޵];g}>y!REm 0!H&pEB۔@(6pP\JP $((/G8B pIȦwF@QSpr⼿.`hP` (n # *% rAx##`hU: $!0Z48\fƷb0meh%Y18Elbg⤣TYjTKr)bISɫхW[w8ռhAIo~K NG{{hD w=XfBn@{tj W^EʍV:ޡXSu"CSL@`^k*.U U&=_:Y GHr|NmGr-EKqM#ZV k Nl*.EYgj{M2d~E~aD >NAu-pAT &"b8.fSo/lx2yšq4AWHXb. TW}jb/6T8Shf>q.@|S݋z\‘լVqI+wʓ#GFPToG[Ls*6ҧd~Wi6{!t᭟.Mʂ5V$&ÛpiWƄ}y岄[,=y"cIp]!F.ڑzBPCV&7"7ke sM.@iX2:[HRg1"%<\S.5a„t`!P5[Qm5V'ټua*^eK[ǁ3j.;Ʌ(+,M1Tjz!نa齙5l`h:tqLC*⭱l1{'Ǒv16;[\Z8w.UkPJ9QjH4j僝SV߾cL/2H" t6&6VJ8ЩOo)&.2ta ? =Vj~>3J*ȩ2p7;ց\9rYrz:GOvU,'g# (T?{f{@Lgj%D y;j>.eHW88)+5 n& d&bŲ+~hJɀ+4"71 ^jg7 u5Y-cJ޼i}>= d5 ѫ@w= "ۍ2k}aa-/fj 6Fcc z4+"j/i|7֒B_pR+hG0dB[Ȑtm2 VbZjZRfwi%iǥ˘_zi5FGߵ iJI)9_*7Qw7!W~ٓ~BDyLM pd ͰvuyCk)zf#EZnF.Ne6]R9+]&(!_JIVv9u>T9qlKY˻XWd)K_3m=WsKރFW;u4̮SrV]'u,&8yFV{|yβ1?gL$HrM+8oƻ.Z:wI~- - ~ !Wvct5ǺV\=bB(c2xc=\JJ{!Q)J4{Ȱ:f,/ Z*.|f  huW*:Dpv>8?*ul"yV_ݞ& +>&mNc7:wL25&. W :TvͻaSSSw`}h/7p"J69cy ű939*ڈJu`xu,hrwwВ#pGmto{4;.R ihBfHPɁ-׻ls 2^jv)atgLǓHfܘ8@;RJZ^6rR`wX0IL2쾺=*_kת옕a1ݚ\`~t0\&8HikGG4Kz(c5IeSŎ(RUx P9nFW`. z4t$:3CՃ$?K1VD =u.n."iC  fS/qwQeTnx9RVv@l>jR#3~~d\eɥK6dËpu &]GUK[$|9 Q2FW[sd1Fb=)Mj stK5w{7j"n^x~c$ 8#5[ɺ ?hS3,>[[ b*v^ɇp3}03}?"ƾFZ[agY;".D͓-(Dז %56;  ]5!'lwY_ A!Y]y%2YA"<$n=YD3Qcf<䃶: ˄/mqT}~ϗaĎhtZ*2zN]^gCț1k'&>߬Vߨ~/-w\]/&0uX\-^>mޱQ"tm{i떥TϫQ\L܎L~rbP Wn`;N .Ny3?=^Y\- lQ(-3Tз,w7EJZ~ߖМkn;UL2h[[;>_άHگ#2 Ň5S=&'3uxe21jI`,9!H59;}rP`ŰWH*'G[5xc+i>ޛy>#bOpR\ ~K{jCܭ1q'H e zPv{*32SxXVu7q$#et#kxϧrxnsN}H;mz3zODwd1Ŭ&/ W3&' N.(NIT:bT[?xI<;uw²M{z 5W0?p[wLQ[ #WĿp@3I4slDp^`*Wy´w9e=IDlJt5kz= N)*R5 8}<i\'bDPo٣=XU$Q&`(FjSx<XcZ* P׈哇VwrB( 0O)mpXMRzJ.Qݪ1_ÄYtE Ŗz&c]z&?#ۄ0# btgmɇl6eǜ_Ƽُs6S(m ],GW&?0~gacok1k3W ^j)fV#c5]z1'?EQcs xmU'ׇ!7Tt.uݾJO`'gAyqzwRq_gGS`YLwv@*Y 7b5==&ge?tƵ& h]eVt@vWWgcpY"l0hٔ}f۰>L%!~* 5*n\J?{[r}}5%-QT6 {qiPQCR鋙NK඄U$kONv?Kfzb7?6cWД  PN.-)Hs3$aTEM7dGz+tEج'p#)<̐GC/rhp Y'vLJ"ˣ37wY"0ץnsIV^#`)J.`}|.2[a;WM{;BGP?XT5/*jPgI +?'_|3.v_Qh̾e^. Ni"7~&Uov-QBtMk8U[!BeWtrC:(鐘SsGomyJ5{3T:Q>]u>Ag>9NI쵷Qx_tח[ 0ݦh(t&x7!CHzR攕u]8@} 9Xu haҋy(,FQb;>q*.i]:}G:̢_pܭ$BߕzE|rc[gU̶=iTұe\  .|T#"fphh]Jɒ v{#+r&1-3"(i aN/J){g9enُnECjD~iժTP4?IO _^~%ј=&c0(DtaLM5^ x6G-i`x F&x "np5lgobjk郷 ] KJڨBOjuYj/'VjxC]#! aFǙr?6ы4n)?>)6Ө{99.Pu:ŨJ0gYx懍 *:siӹ9Acrΐ΢r3SJww?Ms:J;zeٵuz]njbxgX˿Vl7}*UfA $Eu*۞ [4hNOnL.\.VH6\6u1sа]y|= QT 8̊|ە9)g endstream endobj 68 0 obj << /Length1 2202 /Length2 13315 /Length3 0 /Length 14627 /Filter /FlateDecode >> stream xڍxeTk-E;ww(P];KݵŵXqww(ťMν?$sZ\ϛ@E$bh tt11X̬TT ; "&с_6b.@X&n*8:dl6n~6~VV;++:Mܭ YG+">hl||<D.f&hf yWwV ? +#dP]܁mM4njHPv[h0q;k3+mxll@99;8xY;X,%Iyf'``onbmgb 6x :t5sv2Zw% W[bm=|` ks߭9h8X;ec!YA.VVV^@O3+IԽ)~}89:,-7DWw " 0ZZ; -`X{X$d~3sG;?4nR6O!rqp]/xPS@=w,EG0?|gb5af_./]_cY[yLa7xKMoke@&qSo'\dfMk^;;kt]3_'`vW鿳J899v.n"+T\\6r=3v;X8 >Zn.o߈"X$A<?"qX ^?XT Χb-MAl.&f@;_b?lmG89|I 7rvmApb?`xLIn |9ˬOz~ܢ9Xvp7J X~K n qsGo L<$';?5sGkl`._m K_܁ǿ_\ןr _%xA=fKf6"L{}nqv;Pxey7ʣVBz Аቄq<|aPQ "N^$}>&}NVqC%$6@|{pGHRQPFp1 ?p8MpDlW.RfU|( Wl")NXUNnƢ\+Ƣ%yd JAh[bq18%'YPyt7A'EV?sxNgi?cLwYO7؃'\xo[N XRuuiU Qs}Ҋ`>e8Y%"ж~! S`F5iP1Ƹ3kVQ}ODOԵ?xc&)~l pO=f K.5p')5+n >5Z߇U1 ;Hkay?VaD;C#cT;?0[' e7ۜ^)v|m'n~)B(uHwdɃԷn76c=󪾡Q5.,PVQQ zSա Za.ђW$ !M{I Ja 1/fK|fRlZ%plhoqc$N띧|/ҕV2J<3( 9FtNE 氠=.i&<(chjO0um(_l)[ /?nYJr7j8!ܠg+ZI2EiϛOA4C0ب-[NlO^=ފۀ_0uW?|:"W>dzvHҳ?f H>:6'ҲaP?;#wq5dT|N3"Ch̿A%V)瑺A΂Wwd07sEN{éNRPgT+ivZ%_ 'YIՏCBJϪIIk=CA!8 ZQfl:7 =b^ᇨZ) #AX' <d%^| ~:S/yћY}t^8e1zGOԺ QK?QaǧN# ,/W9TsDzZ8;aƨ1vwϽCl"Z0}29oeE~X@"qwLʣF3oڝkM 'L^Q4{>>p0bimux_9 L~Y5#ETlj#xD_dj(doɉjY* 26;H9]*")xucG0=L|--ڳ gI E-Kl5F/ %OXjʊ>X1cXwd )qCe4S#?L.7!HuEv9ƈ@1AL%ĹzD1߳~s';d֓ ,4kVZK< s, (kL+j FUOC#V~9Z;9Gąj}-~3ء?|;NP{^2BHmH/ yh us27rQ[= 1c#mNbfKu> ŝO2e ؇2$KqUt@3Z-zJY;ӘVv}*z0qwx3]^ e٥lB9ôL&X$K6NҜ5=tp< e4Em3RZ.p%!;GT:A)eQE(gԇq  DÕ^Yx3ֽ3׺ip7d'.tESY;uAHj h$0uDrUd]>ʱcL3`6ç>djxAAq޼}%"aAdG`f<]k0Hl&#-oVzPB$" +u1T4Ȳ#UڝOaJ0 0s:e1rW>7s.BiT4R=SυRP`?أfe} iRA/=݈<JZ=exv!}M ,LBRý Ȁiwۭ; ʥYݕ9aX1x ͛") ⊋JzvFrʃ+g)gbuϗNi rl+}$6#r,\|1LnuRPRYЛ}AoHnon8"r4Nuo~9P(ӣ}pZ.)m tXM\0# B*|%nX^LX?X RI%'|0}Y2dwyW2!͎MJ^qj.{fe%үWXL00mvLatl $nAYޚm1Xsq|nKǞ#\ k^DYis[j)Hnqlw^8iQ1r/HNRLiW4{q (X &}v󭋙M:ND8'|=Ufl֤_9@8a<O xf/ Bf(d#_rqg^ºY;Ugn"EU-c=eg4h%w 5V:a=_C~U98sYj_wuĥMZ.X O}|0qL,@5m_J?Onwң" l"2oBhwymhȳpS:HԇVrL>\w9;"Ƥ[{z@p .wo/|%bQ\ARL 1tM/gW)ELΰ 4٣X3ZCG4$81$]0Cfq& ÜKC»> ݭ.#CZ8:¦XHE`p1w{@}N\9d} 3Ё&Ւ#DKZ ^%k[t'>j0]d|KpGB>b-K癰cnAa-|*=5_Ht>D=F4SI7M˶8 DqbbsVQy)S^ORQ$@uiaΤa@ qDLB>S*3S_0 7tޝDmOQ$]]a(S4}9ncwKD8*s6 o qO/úlKcjA"gq+|Tz|LBv3MkE6X!aX}sL0kQyݠi/ZtTz2^Ml"AXc>Q:rS' 3H$evj=$QH $5P<ǔUdUiKE-`=`#GdXb)k֍ۄ@+/Nr (ޣCH1@-39h2Gx_% bd1z̑F3"i:9D (-Wߎ Ǎ|[w@OP*v_I'U[+Z>-=x*2&e$ '844SF}J#z'Kqq3)5~O:Jmͦs,_8 pGR? مUk-K QxDLe&L_\kjغ{얻MER7?7+'2<Jqx{Z ՆMT+D*~V*Q6A,T_Gơݧ\+8Ce8-h[Y{eE`6Oj.L(N1O'/3)7j9Wr brMFe]"V)hbxI˴{0Q$g=a7ũRUlQl.m|$,1aՠ)|8k]`hAF+DGf6c%>e*=ӫVIt=pKv`)R 2fe nN҅UόAEyqHFk ak6VpڊWy$0ؓLsYU\(2s3ee]jz3Z;S4YR .ꮈloYcSy#UR\喝1;av'ߜV=LzuPas(ŪS#E+elrA ~ZpED$^ g9y4ڬZgv)`Kx-@gDK B,.7"EoЄPvy8T9-M|*/E]M>jAU&vW|9 "?d1x'J\tl]Ә/59O>,O PA :N֏tnbp> ԒQ ~13.vj 0K5e|̘82L5YhЁB_]N3qI b32|LG& U92{ 6xiUӈwnTJ JkJnd&yV)FƧZ(/\ IA,dN(xW]c(']FZ:_??RI%DL,eM䥯Q )u aos̈́!ᅬ+T"X Lpc4y9ۏ, U'}V@o{d39C9@;ssa bPq!2Lײhg41Ai<_JAm&TyrT iLgKNHC, X<|kXeK{cm=/[jȂѻ k>g4i9d_7f%l% [tk]$DI:TGq&ZL-Do0Nk=O+GϼO8a,mT9it^1POu\jYA%,3[zPJPnmR׭ffc4(EB0d= >`!ydZ|w#)M"Am;s oaRXϞ߳=-7&jݛbV"Z ,0ghfpZU#K_ô_ZnFEbnxQl6e1;e^8)gXy%'0PdjT0)_TWQ{d}ZFjaf+3TIZ^-p7wN|Ms98ey?sW-^F]<`8n*-\n`.qqtu8r" blv?֘ű5ٴ-#Dl:zPn^?wK}H&~tA'G)@+p2ۿ's>'0r ~ I&f;, YBsiޣ=ݥ "qn뒚bCS1F0]&S,PՍE|Ik+\&'b,T؍[fT%'E],hM2 :'Q'亡bQMأE}8Teyi>>HvBLDŽu8ym\ismWRj^_,e7*~L*R@ÜċC)wx_"Canթg !4DSMa2$o* KP!'r_L.ҽk,-hVi +K/9v&gfkf]Um$ȅZ66N+T .o {]"kv.ݩ^"c{A#-RxK۸(=Aiám~rej_SA3hZ}wx|"y\?Uezt9\UvvN H9KCmwM[^:hk6]Ew,ǻf$Du?ZUuDN*<%RCM~)) +̏~/RغgS>ޫ:̂ʻEm[t`sUxN{zaPrTz Vgz.N>ϧHb8ҢoKE,(I#CĖSB2kP͗7f+r PV΁/1Zo .,F /dxZE*LJ@_̏uB& | %`hFwϷ| =@L[ G3srH6lMNr p´Q2]V|',>8sPGfX3r]-Y^âۃ$}Z 6~({MdYYbCpÐv҇Elo=^1V#WXSIP%t@$n/,z|c&C3V— ?MD5M<7[M8C?iz,M78$}TY>OYEefq p ʥ}.X{*EaFݟE޽fgY/h;- ,GdZκ__ 4Qm͒`_ޥ,{6..Zꩨ}TI w 8 xb&SYo䊩 !3{LD+ ,q2ty B 7|M3=eee4RH KIt{usUW+ևtUHp҅`*(mF}@kƊQޘ¨[Ϧ9X8{: >ѽ)=Ku,)1Y}Xis=(0ǖ/iDťyzh+jSp4˶#Ég[2 p嗹<1$,dlUyY;Kgx M(6Q/`UUg< {#~'\XkK̃84eF!Pxv]@JXrtq\@ Kl2VaEmL6]w=51ZT> #M}= o4<@V_lLj`]e3;n̘?j溞dq`f 0('㧘m _t?W'*]VL&@0Gs~UTW-Xw%gO|.3vt[܄,Fedh>"u)㓧ۺtj,jfF*kP,Ck43ExfਇjdDB>Ci}ѶxЈ%\ic^avC_91}ݥHNUH%j|A7ҫ݆#ß=W;$ﬣ B Gsُ.u؟b>9~3 CDxr{_|g}jE4AǨIp, '4d}j+(mr +4u$?*,K5&us0 ~jj. &Dw"`nR%vL~զْrH=BAH\vyMMf&)JX::z拤Nq `\N4r!̶xOUZIb_?[2=wo33w\ 0ĽM4P,yjoWo sG>-(jjU(>1sowإ?WKpQԿmaVR,@{"j<=d]u K~dXǑY~3|m1L%2pKGFLk~ Z(֌\7u]Dm.FQF^tJ/n S/n0_i{T|؛b]m(ZסȿA7*`NQCVdg֧[x: ÔI0Gܪ,!ՎĬNjDkWpn%TV7CE3fsZ)T*R^ca\>r< Ab v{Vx),&?JIFh6xLHb)UțE$9FFbơŖ`7(<J:(`!]ŀ{ Eg}T}¶qE'yݓBd-CK3dDc PrwitFpnR:'w;9v ism*Ke|l@Z.ER~Jla"l2qe:s *.RhJhܚX:j5ȸ ZK Li>7ZM hI6٭@n|/0ٛd'w2.5Tb VnFOqX1?]# p[(;KKLQT,lsF^9%ÃQ.P`68ﲹIF{=``{eKՔ7ݙ+`+ۣ&34>_% i}#IB:;u͆.uTOp$CIz[q(z eT4ȾD(ţ{QWgHNilCrf촩I|L?̫DZ#){}މN5*#0la8+e&2m{?Klnou\:cB#$#V < ҡe]E> 7 .`y @6PZTǛ8&WxUi'_Ɠa E^wJK^?I҆rbpʩ`96վqڃ;÷wA3/ٛRtߕ,[1辀`N(G`niF"rф+<\9+BkwuTS֝74|S>4³Eeft4f5P|{jʽ ÄdX%*+-G'`|ě%i^JO4d}uT0&RBٟAE/lHgpU%}1@D&ЪI.˺m']\n#`vۡW+'7A5?L=Mg, F'=yɠ2[+ 4i1n AKEu3b)\䋕`,*ҧ|oZ:_*Z/3\T!TVb;~z܄l?u[n&:̀;=WfL1!v wO1DWHj>HKNH4&w(vu5rN!k:ʺ~60MVqW=lǗv'E7cc͸Kϊ*_j)ͬ0 ~+Qpq?9FqE.77,]gtHʨĴ!.NDK#5yUf*/"\($O9Cis䌥r(X &dN U;ҶF辭.(:bj{R6r(LْٖSzGkː=e3EER~)x$b. ѝҹ\fBy]{v1IC(d2kAϹ #_pk9> 쫕5>:ML~I}< Hw|2cލ;YNli zݷ-c7ðeg1|3xK,knS7 tW̘/"b(%WP)Gp^2IeXf۵w|A{G4ً"-ryui:kPP D צmnn{a/#]R!fp:W)e%CœWOJHm0l2X݇zWDw$66px#%1+3}+SMzɰkӳIVB 6乣Ȑmr#a7$e'ۤnĤui5Ň( ]V~K;T[={f]oZiL^P{f82V1XdyI!=jM (rYq*հ` Z1giDۥ~7WQʟpo&2?0 G KDm6:{FEJN~Bj(S=8R]i4 +>=IM\jjJ`t;w4*y3[(tt 0}7? jJ$үy_b=pЪek?)1cW}cےbv\C(}@'7."H .q Hh0"} ib YOǙTvJ'VV@ ~٠ǂg4*gqFj,Ze<$Xa݇t?THAZwtIYO4 2*w\n7Nl˅x~{20fױďn TE,{Z[ȑo둈1645E=q2:fTXHUA \h@v>"Hf\ d5GkF[KÃ}gZ͊t_*ep%jb.G~0GW~7('INT8f!pNA$7=LcER`ͽFp,YB\{F'.:b sEL)gjG]2Dd !C)mPtuUBKՇBLhFfxe*l+/N?c/zA%iyzB~QigW~vI 4 mݯgFפ=* M/H~:ˆQTǬIA?25nuI-W`kj_9D;uNH;Mf<5#ډ~lן:88JŎEjx,Ĵ8H3*?dZDڥc`K/ ƙ/&‹-_f`qCNfYIB2&naM ~UE}v,ю`w7BJ!xA?%%VRan!HWjz(Խ%ˣ6o2j,${Buu3MTyvN,L5(M;=#mL gip7Kr1 b.m8 䕍 '~I?jv endstream endobj 70 0 obj << /Length1 1906 /Length2 6397 /Length3 0 /Length 7545 /Filter /FlateDecode >> stream xڍTTmtRA`iqAPFZJABZB$^[}׬5s~s~0ijsI[ ̠ 3/7 sa31ȱBN0\/ Y$⌒AQ8bDxDxx> H@ Թ$p@¬QyyX^aa!Ο= 3u5bh#aPg`vvvܸ!N'sP'(jhxn б9Rh#, H(̡p' Pme5@ eˀ}8/7~{t# p A 5ngwgNasB! et @P spvv# {{( G}r0$u/p{C06,\@p TY JGfuyxxPGnn @SCXڀz,l/'+pF@Vyy 3`DG0w5~ϏϿO& @<| -- %Y-A^\ 'E]Oe%U,)^6࿱ Ps X1 9y(1ߊ\~Y{o ܺ8v@A-:bZegjVv$IЄ9[_b{fC5N7 ?:rۢn'HTAQߌpsŏ%@H6j/^6Z@1#Q.;oJ  _t!!$ ?$ %!BTC((??eP %aTe?4xP-!!_*+Y,B^ QXBdBT9v!*E_@:.hO#Ouuŋ* u Q!P'g]?4?x(j==0 )h<)vZ>;[t];= n[ ?HVⓤpFtKOO϶\T[Z -jnGRl)b̵ߊ0Xqo FcܾF@tJSLX2ӁN iRW?rLuR&QʦD{TQv/X|Y͜4_PYlh"kwW>-4"y `2zM0&Y\|(f%2#cU8GI*CKeĤ+7/xn,+zhu)z󥃳'gR*՟Q־et3D˽Q^nWVfKsCҳ'j?7 +v(}qk(X{8~8S, m}&rvt6Q(Sm^\ ־Xc-N֮tG-ܸ3Teu*G!{7ԈRKK?ܞr t4!I7u)1S5iG"HݸL*em7aD)4*u\a`Gg!?$/b7U]=D~[uRK6u.dbD7IѧB_P2L>$GL3'XK_W]\L u`L2. +on;_ʾ. 6+ K*>m4KQ\#/È?ɕ<3!s}w-E~,:i.w^\#hvMs)#v` HʱQۛQAfW6g%•aVMw_T${FZD3Шwght0<N~( *Jh(۝bmCG@L[q& |+!͈)p9t9S9Я%/e C̽lt{(`vֺJ7ԐWHe}Y:Eͻp3-ۖ~qD>SgO_| MPY[u?4k5I*$$ Cxhͅ.شaMm/1y*d>Q"S_-ca rnA.1DlX٩nXx}e~_M5O)S 5 I&7 ~oЖ,NVSX.?,px;CMk[.("0halڹ\fωOΩ-8>N$ olwyu¾BJJ&)\˟|^oI'$1TjcaLQvl7z &&%cV`rMZ>V[}Ē[Kh%-ɯ9םl=oZ|TW jKzr2v8Sb-fJ$Wq9B+UP'bv+5BƒXJQ!M28S:spHy3' { ȥ &r-h Πƚ 4)\Zk#T"Rɫ˳N-otί2ϕBvΗzg[MsoN|iEIP)7኿GB.9 imu?og//lZ}Z!N]I^ɣM%4,eu(cȿMo|pVW}Ϥ,ea,C}!=iͭmb,-=Sңd Fk7u,/ ;K%]ا}@6(BRPErs).:so~WLԴB>L%w|#ȤЦMVU}\ V}DAqg3YsmVɕ> I~%5f!{6K7Eoޫy +Qc<*}2*q0mQw[f9z@xTpѯtʻVm&Lt<礌=LK$ޣZ,O,Te=dۼl_ʸ^ CYC8[-5!# C1E^qB*_ ? 8+K_H'=tP$GC#w[]"zUk!_p$rĩO-!CTd bŷ$Uyyk8L!x7\<|N }#R-ⷻuRޜ}h{^x3ݴj!iPO1|Ǔ[E_ht{'tjY*G;71J̎wdZ]jIrʾ)zÇRH4 6ZBѺ@:W%,Ը^- pfH(8pDN"ݜ{nhP4׌l<~/48[=|lsŞ (xlh[s*5SR~aj6 Y4%~A;1I G}'0U5k:/(x߰k-mU6=Cєau#JiҞN/A#zJ2+ ^7E0b!=@c?6~~A;ZŊ_[u1vv T9ASpfC,TCef6BCVE#5 h ->׃SO>39[%WFՓM[Y{1">o2e_E9 >: "{MU bf8.V rCtMkM'$R-/R/8w.z[ĖVwXRdGR5C\6Y0 KvmO`c CE=$W>zHi,3]6CVjwJ{{^IVR~ټgp>hztL.bl`[*kwZcHUN{˻eD"RCGq/l#:.(T6F#ƴ$wVi2e&O [/:_9op윻G qt ۘ7ɕPtXQp|~IrVԱ_C0Hy>KVs':9щT]~K_rQxK.R?~,ULntDZeWO3^xG /zG0OC n@u7V%RרܖXL +OtƹHoӣ☦5e({9K?>8'?x9r4χ`1.JF!;=Neu"3dhǽWEh~mtqy m@Οs1E1 &!ټn1К%gY*R#S3oh-#wzɬ3i&7}r8bdW&Bb9'\Zfc5^7z5D+tžQ)FcrFHoٽ;6 Иa[6s}mً3|ԭ@=}~%Lp=:lipATVXpMzlRBiɾ%.oOSwik~ZvVJ&p"'(XÄhy3ǪԿfA'25M)v;Gë5R5DvjynLaSmzo=b/9wQjQ):kd1\#3bSOQ˞I wԊ'7/= z U:g endstream endobj 78 0 obj << /Author()/Title()/Subject()/Creator(LaTeX with hyperref package)/Producer(pdfTeX-1.40.18)/Keywords() /CreationDate (D:20191029193348-04'00') /ModDate (D:20191029193348-04'00') /Trapped /False /PTEX.Fullbanner (This is pdfTeX, Version 3.14159265-2.6-1.40.18 (TeX Live 2017/Debian) kpathsea version 6.2.3) >> endobj 2 0 obj << /Type /ObjStm /N 65 /First 491 /Length 2706 /Filter /FlateDecode >> stream xZr6}WqfLwj*U'޹sYm%HTiHZk_6U}9l˙a*gisÿ́bB&阰 @LìtL*aRr3IL H' dBz +^ѽL)jnEOp 1ۑ©4QL;KUHQ^2Ld@NiFS 61t)1 tI76w/u arF*ɜְWG *, uJ(|a0 r+ A ;ɼ%po-ü ;5p#! ! 2Np znj<)ɞ͋Q5.xξn|#L̯?vr |/&<&w// i}b`\ќ/mU1*՜IK٨SrŞb<+d9:,uA `ȶ;sdU"EJ/g)q/Ϋx8:{좘E⌿)QNϐHIiz6ˬ1`eIvgPQ̙uM&FBP3d4fTdReUAF(!#4J}xh#oP:#w*:5m4D[K%T@%>IO P?q袄<`^mӲ_tMm[#sZ(Z!9BfXϐҹY[cɍRi{Wd6INR68l2\؋ӢHPȧȰđf[J%%}qn-]Ya $ć@%h5^9ڧZDaخdCG `+>BxV܉CT$Q^ Hk49".eK+) MmXIW%z#_ZY~+=-YB)N*KE]-yӸ6d֑^qűPcKuGǯUGb>ⶡc~K;, -`ꏲ]3Jm-{5&o;mc }k-9(Zڅ.*r)\ř2{T#/ͬeKflW]ޘ;wIXQ0R*; 8cɕƚ ^%s۴} ]խӴHbZr s݃gxtkM<;DѡۜPyLm}L۶-/*UjSO*ZH: ޾*W׸ǵ"|] 'jR|GrRN/%g̯b>7|K^N ~oٸ3>(>OasC}M)AC} u@;B7YBH6B7v+o~<'xIav&Ǚem0uEY!tjbw=+bVv8}۽ys?@E IQys3$_!)~:F/~bUp;Yo'w<qupU)FѸ 5oJH %Hzʭ7''z6?Oȅ'[wo'O`ڦ2i,uk W^wom1=7`Yz駱nC[vk==њ=wSMw 7+~{U7(7k ӛTA|2S{&Vk,m F[Jk捱Nu;Փ>̊$mD^ {wb? f;Ӝl)-ɗZbNihS'ִg/q5UGr r{پG~8GtbW?ߌY߼%j-UdzSZA5  ~y5HYLhE2M?̋U-Q;׬V_rk8 endstream endobj 79 0 obj << /Type /XRef /Index [0 80] /Size 80 /W [1 3 1] /Root 77 0 R /Info 78 0 R /ID [<91D8DA33BAFDF69F95E543D0AEC741E7> <91D8DA33BAFDF69F95E543D0AEC741E7>] /Length 206 /Filter /FlateDecode >> stream xѹUB{( GԾ]:kQ M[{/_xKIM endstream endobj startxref 102435 %%EOF affy/inst/tests/0000755000175400017540000000000013556116173014654 5ustar00biocbuildbiocbuildaffy/inst/tests/affybatch.R0000644000175400017540000000230513556116173016726 0ustar00biocbuildbiocbuild## ## Basic set of tests for the class AffyBatch ## library(affy) ## fake environment ##it the below change the environment def must change too NCOL <- 8 NROW <- 8 n <- NCOL*NROW cat("---> normalizing an environment...\n") tmp <- sample(1:50) dummy <- new.env(hash=T) index <- cbind(tmp[1:10], tmp[11:20]) assign("gene.a", index, envir=dummy) index <- cbind(tmp[21:30],tmp[31:40]) assign("gene.b", index, envir=dummy) cat("done.\n") cat("---> creating an AffyBatch...\n") samplenames <- c("sample1","sample2") signal <- exp(rexp(n,1)) e <- cbind(exp(rnorm(n,4,1))+signal,exp(rnorm(n,4,1))+signal) colnames(e) <- samplenames afbatch <- new("AffyBatch", exprs=e, cdfName="dummy", ncol=NCOL,nrow=NROW) cat("done.\n") ##can i get pms? pms <- pm(afbatch) mms <- mm(afbatch) ## normalize the AffyBatch cat("---> normalizing an AffyBatch...\n") n.afbatch <- normalize(afbatch, method="constant") cat("done.\n") ## compute expression values cat("---> computing expression values...\n") e.set <- computeExprSet(n.afbatch, pmcorrect.method="pmonly", summary.method="avgdiff") if (!is(e.set, "ExpressionSet")) stop("e.set does not inherit from 'ExpressionSet'!") cat("done.\n") affy/inst/tests/bg.correct.R0000644000175400017540000000032213556116173017024 0ustar00biocbuildbiocbuildlibrary(affy) library(affydata) data(Dilution) meth <- bgcorrect.methods() cat("background correction:\n") for (m in meth) { cat(m,"...") abatch.bgc <- bg.correct(Dilution, method=m) cat("done.\n") } affy/inst/tests/expression.values.R0000644000175400017540000000144013556116173020473 0ustar00biocbuildbiocbuild## ------------------------------------------- ## routine tests for expression values methods ## ------------------------------------------- library(affy) library(affydata) data(Dilution) essm = express.summary.stat.methods() i <- match("playerout", essm) meths <- essm[-i] for (m in meths) { for (mbc in pmcorrect.methods()) { cat("expression value with method=", m, "bg correct=", mbc, "...") computeExprSet(Dilution, pmcorrect.method=mbc, summary.method=m) cat("done.\n") } } ## playerout alone 'cause very slow m <- "playerout" for (mbc in pmcorrect.methods()) { cat("expression value with method=", m, "bg correct=", mbc, "...") computeExprSet(Dilution, pmcorrect.method=mbc, summary.method=m, ids=geneNames(Dilution)[1:3]) cat("done.\n") } affy/inst/tests/normalize.methods.R0000644000175400017540000000047713556116173020451 0ustar00biocbuildbiocbuild## routine tests for the normalization methods library(affy) library(affydata) data(Dilution) n.meth <- normalize.methods(Dilution) ## remove qspline ##n.meth <- n.meth[ ! (n.meth %in% c("qspline"))] for (m in n.meth) { cat("-->method=", m, "...") Dilution.n <- normalize(Dilution, method=m) cat("done.\n") } affy/man/0000755000175400017540000000000013556116173013310 5ustar00biocbuildbiocbuildaffy/man/AffyBatch-class.Rd0000644000175400017540000002316513556116173016540 0ustar00biocbuildbiocbuild\name{AffyBatch-class} \docType{class} \alias{AffyBatch-class} \alias{AffyBatch,ANY} \alias{AffyBatch} \alias{probes} \alias{geneNames} \alias{geneNames<-} \alias{getCdfInfo} \alias{image} \alias{indexProbes} \alias{intensity<-} \alias{intensity} \alias{pmindex} \alias{mmindex} \alias{probeset} \alias{$.AffyBatch} \alias{cdfName} \alias{cdfName,AffyBatch-method} \alias{checkValidFilenames} \alias{probes,AffyBatch-method} \alias{exprs,AffyBatch-method} \alias{exprs<-,AffyBatch,ANY-method} \alias{se.exprs,AffyBatch-method} \alias{se.exprs<-,AffyBatch-method} \alias{featureNames,AffyBatch-method} \alias{featureNames<-,AffyBatch-method} \alias{geneNames,AffyBatch-method} \alias{geneNames<-,AffyBatch,ANY-method} \alias{getCdfInfo,AffyBatch-method} \alias{image,AffyBatch-method} \alias{initialize,AffyBatch-method} \alias{indexProbes,AffyBatch-method} \alias{intensity<-,AffyBatch-method} \alias{intensity,AffyBatch-method} \alias{pmindex,AffyBatch-method} \alias{mmindex,AffyBatch-method} \alias{probeset,AffyBatch-method} \alias{boxplot,AffyBatch-method} \alias{dim,AffyBatch-method} \alias{row,AffyBatch-method} \alias{col,AffyBatch-method} \alias{show,AffyBatch-method} \alias{pm,AffyBatch-method} \alias{pm<-,AffyBatch,ANY-method} \alias{mm,AffyBatch-method} \alias{mm<-,AffyBatch,ANY-method} \alias{probeNames,AffyBatch-method} \alias{hist,AffyBatch-method} \alias{[<-,AffyBatch-method} \alias{[,AffyBatch-method} \alias{[[,AffyBatch-method} \alias{length,AffyBatch-method} \alias{bg.correct,AffyBatch,character-method} \alias{indexProbes,AffyBatch,character-method} \alias{indexProbes,AffyBatch,missing-method} \alias{computeExprSet,AffyBatch,character,character-method} \alias{cdfName,AffyBatch-method} \alias{updateObject,AffyBatch-method} \title{Class AffyBatch} \description{This is a class representation for Affymetrix GeneChip probe level data. The main component are the intensities from multiple arrays of the same \code{CDF} type. It extends \code{\link[Biobase:class.eSet]{eSet}}.} \section{Objects from the Class}{ Objects can be created using the function \code{\link{read.affybatch}} or the wrapper \code{\link{ReadAffy}}. } \section{Slots}{ \describe{ \item{\code{cdfName}:}{Object of class \code{character} representing the name of \code{CDF} file associated with the arrays in the \code{AffyBatch}.} \item{\code{nrow}:}{Object of class \code{integer} representing the physical number of rows in the arrays.} \item{\code{ncol}:}{Object of class \code{integer} representing the physical number of columns in the arrays.} \item{\code{assayData}:}{Object of class \code{AssayData} containing the raw data, which will be at minimum a matrix of intensity values. This slot can also hold a matrix of standard errors if the 'sd' argument is set to \code{TRUE} in the call to \code{ReadAffy}.} \item{\code{phenoData}:}{Object of class \code{AnnotatedDataFrame} containing phenotypic data for the samples.} \item{\code{annotation}}{A character string identifying the annotation that may be used for the \code{ExpressionSet} instance.} \item{\code{protocolData}:}{Object of class \code{AnnotatedDataFrame} containing protocol data for the samples.} \item{\code{featureData}}{Object of class \code{AnnotatedDataFrame} containing feature-level (e.g., probeset-level) information.} \item{\code{experimentData}:}{Object of class "MIAME" containing experiment-level information.} \item{\code{.__classVersion__}:}{Object of class \code{Versions} describing the R and Biobase version number used to create the instance. Intended for developer use.} } } \section{Extends}{ Class \code{"eSet"}, directly. } \section{Methods}{ \describe{ \item{cdfName}{\code{signature(object = "AffyBatch")}: obtains the cdfName slot.} \item{pm<-}{\code{signature(object = "AffyBatch")}: replaces the perfect match intensities.} \item{pm}{\code{signature(object = "AffyBatch")}: extracts the pm intensities.} \item{mm<-}{\code{signature(object = "AffyBatch")}: replaces the mismatch intensities.} \item{mm}{\code{signature(object = "AffyBatch")}: extracts the mm intensities.} \item{probes}{\code{signature(object = "AffyBatch", which)}: extract the perfect match or mismatch probe intensities. Uses which can be "pm" and "mm".} \item{exprs}{\code{signature(object = "AffyBatch")}: extracts the expression matrix.} \item{exprs<-}{\code{signature(object = "AffyBatch", value = "matrix")}: replaces the expression matrix.} \item{se.exprs}{\code{signature(object = "AffyBatch")}: extracts the matrix of standard errors of expression values, if available.} \item{se.exprs<-}{\code{signature(object = "AffyBatch", value = "matrix")}: replaces the matrix of standard errors of expression values.} \item{[<-}{\code{signature(x = "AffyBatch")}: replaces subsets.} \item{[}{\code{signature(x = "AffyBatch")}: subsets by array.} \item{boxplot}{\code{signature(x = "AffyBatch")}: creates a \code{\link{boxplot}}s of log base 2 intensities (pm, mm or both). Defaults to both.} \item{hist}{\code{signature(x = "AffyBatch")}: creates a plot showing all the histograms of the pm,mm or both data. See \code{\link{plotDensity}}.} \item{computeExprSet}{\code{signature(x = "AffyBatch", summary.method = "character")}: For each probe set computes an expression value using \code{summary.method}. } \item{featureNames}{\code{signature(object = "AffyBatch")}: return the probe set names also referred to as the Affymetrix IDs. Notice that one can not assign \code{featureNames}. You must do this by changing the cdfenvs.} \item{geneNames}{\code{signature(object="AffyBatch'")}: deprecated, use \code{featureNames}.} \item{getCdfInfo}{\code{signature(object = "AffyBatch")}: retrieve the environment that defines the location of probes by probe set.} \item{image}{\code{signature(x = "AffyBatch")}: creates an image for each sample.} \item{indexProbes}{ \code{signature(object = "AffyBatch", which = "character")}: returns a list with locations of the probes in each probe set. The affyID corresponding to the probe set to retrieve can be specified in an optional parameter \code{genenames}. By default, all the affyIDs are retrieved. The names of the elements in the list returned are the affyIDs. \code{which} can be "pm", "mm", or "both". If "both" then perfect match locations are given followed by mismatch locations. \code{signature(object = "AffyBatch", which = "missing")} (i.e., calling \code{indexProbes} without a "which" argument) is the same as setting "which" to "pm".} \item{intensity<-}{\code{signature(object = "AffyBatch")}: a replacement method for the \code{exprs} slot, i.e. the intensities.} \item{intensity}{\code{signature(object = "AffyBatch")}: extract the \code{exprs} slot, i.e. the intensities.} \item{length}{\code{signature(x = "AffyBatch")}: returns the number of samples.} \item{pmindex}{\code{signature(object = "AffyBatch")}: return the location of perfect matches in the intensity matrix.} \item{mmindex}{\code{signature(object = "AffyBatch")}: return the location of the mismatch intensities.} \item{dim}{\code{signature(x = "AffyBatch")}: Row and column dimensions.} \item{ncol}{\code{signature(x = "AffyBatch")}: An accessor function for \code{ncol}.} \item{nrow}{\code{signature(x = "AffyBatch")}: an accessor function for \code{nrow}.} \item{normalize}{\code{signature(object = "AffyBatch")}: a method to \code{\link{normalize}}. The method accepts an argument \code{method}. The default methods is specified in package options (see the main vignette).} \item{normalize.methods}{\code{signature(object = "AffyBatch")}: returns the normalization methods defined for this class. See \code{\link{normalize}}.} \item{probeNames}{\code{signature(object = "AffyBatch")}: returns the probe set associated with each row of the intensity matrix. } \item{probeset}{\code{signature(object = "AffyBatch",genenames=NULL, locations=NULL)}: Extracts \code{\link[affy:ProbeSet-class]{ProbeSet}} objects related to the probe sets given in genenames. If an alternative set of locations defining pms and mms a list with those locations should be passed via the \code{locations} argument.} \item{bg.correct}{\code{signature(object = "AffyBatch", method="character")} applies background correction methods defined by method.} \item{updateObject}{\code{signature(object = "AffyBatch", ..., verbose=FALSE)}: update, if necessary, an object of class AffyBatch to its current class definition. \code{verbose=TRUE} provides details about the conversion process.} } } \note{This class is better described in the vignette.} \seealso{related methods \code{\link[affy]{merge.AffyBatch}}, \code{\link[affy]{pairs.AffyBatch}}, and \code{\link[Biobase:class.eSet]{eSet}}} \examples{ if (require(affydata)) { ## load example data(Dilution) ## nice print print(Dilution) pm(Dilution)[1:5,] mm(Dilution)[1:5,] ## get indexes for the PM probes for the affyID "1900_at" mypmindex <- pmindex(Dilution,"1900_at") ## same operation using the primitive mypmindex <- indexProbes(Dilution, which="pm", genenames="1900_at")[[1]] ## get the probe intensities from the index intensity(Dilution)[mypmindex, ] description(Dilution) ##we can also use the methods of eSet sampleNames(Dilution) abstract(Dilution) } } \keyword{classes} affy/man/AffyRNAdeg.Rd0000644000175400017540000000374313556116173015514 0ustar00biocbuildbiocbuild\name{AffyRNAdeg} \alias{AffyRNAdeg} \alias{summaryAffyRNAdeg} \alias{plotAffyRNAdeg} \title{Function to assess RNA degradation in Affymetrix GeneChip data.} \description{ Uses ordered probes in probeset to detect possible RNA degradation. Plots and statistics used for evaluation. } \usage{ AffyRNAdeg(abatch,log.it=TRUE) summaryAffyRNAdeg(rna.deg.obj,signif.digits=3) plotAffyRNAdeg(rna.deg.obj, transform = "shift.scale", cols = NULL, ...) } \arguments{ \item{abatch}{An object of class \code{\link{AffyBatch-class}}.} \item{log.it}{A logical argument: If log.it=T, then probe data is log2 transformed.} \item{rna.deg.obj}{Output from AffyRNAdeg.} \item{signif.digits}{Number of significant digits to show.} \item{transform}{Possible choices are "shift.scale","shift.only", and "neither". "Shift" vertically staggers the plots for individual chips, to make the display easier to read. "Scale" normalizes so that standard deviation is equal to 1.} \item{cols}{A vector of colors for plot, length = number of chips.} \item{\dots}{further arguments for \code{\link{plot}} function.} } \details{Within each probeset, probes are numbered directionally from the 5' end to the 3' end. Probe intensities are averaged by probe number, across all genes. If log.it=\code{FALSE} and transform="Neither", then plotAffyRNAdeg simply shows these means for each chip. Shifted and scaled versions of the plot can make it easier to see. } \value{ \code{AffyRNAdeg} returns a list with the following components: \item{sample.names }{names of samples, derived from affy batch object} \item{means.by.number}{average intensity by probe position} \item{ses}{standard errors for probe position averages} \item{slope}{from linear regression of means.by.number} \item{pvalue}{from linear regression of means.by.number} } \examples{ if (require(affydata)) { data(Dilution) RNAdeg<-AffyRNAdeg(Dilution) plotAffyRNAdeg(RNAdeg) } } \author{Leslie Cope} \keyword{hplot} \keyword{manip} affy/man/MAplot.Rd0000644000175400017540000000344013556116173014774 0ustar00biocbuildbiocbuild\name{MAplot} \alias{ma.plot} \alias{Mbox} \alias{MAplot} \alias{Mbox,AffyBatch-method} \alias{MAplot,AffyBatch-method} \title{Relative M vs. A plots} \description{ Create boxplots of M or M vs A plots. Where M is determined relative to a specified chip or to a pseudo-median reference chip. } \usage{ MAplot(object,...) Mbox(object,...) ma.plot(A, M, subset = sample(1:length(M), min(c(10000, length(M)))), show.statistics = TRUE, span = 2/3, family.loess = "gaussian", cex = 2, plot.method = c("normal","smoothScatter","add"), add.loess = TRUE, lwd = 1, lty = 1, loess.col = "red", ...) } \arguments{ \item{object}{an \code{\link[affy]{AffyBatch-class}}.} \item{\dots}{additional parameters for the routine.} \item{A}{a vector to plot along the horizontal axis.} \item{M}{a vector to plot along vertical axis.} \item{subset}{a set of indices to use when drawing the loess curve.} \item{show.statistics}{logical. If TRUE, some summary statistics of the M values are drawn.} \item{span}{span to be used for loess fit.} \item{family.loess}{\code{"guassian"} or \code{"symmetric"} as in \code{\link[stats]{loess}}.} \item{cex}{size of text when writing summary statistics on plot.} \item{plot.method}{a string specifying how the plot is to be drawn. \code{"normal"} plots points, \code{"smoothScatter"} uses the \code{\link[graphics]{smoothScatter}} function. Specifying \code{"add"} means that the MAplot should be added to the current plot.} \item{add.loess}{add a loess line to the plot.} \item{lwd}{width of loess line.} \item{lty}{line type for loess line.} \item{loess.col}{color for loess line.} } \examples{ if (require(affydata)) { data(Dilution) MAplot(Dilution) Mbox(Dilution) } } \seealso{\code{\link[affy]{mva.pairs}}} \keyword{hplot} affy/man/ProbeSet-class.Rd0000644000175400017540000000340013556116173016422 0ustar00biocbuildbiocbuild\name{ProbeSet-class} \docType{class} \alias{ProbeSet-class} \alias{mm,ProbeSet-method} \alias{mm<-,ProbeSet,matrix-method} \alias{pm<-,ProbeSet,matrix-method} \alias{pm,ProbeSet-method} \alias{show,ProbeSet-method} \alias{barplot,ProbeSet-method} \alias{colnames,ProbeSet-method} \alias{express.summary.stat,ProbeSet,character,character-method} \alias{sampleNames,ProbeSet-method} \title{Class ProbeSet} \description{A simple class that contains the PM and MM data for a probe set from one or more samples.} \section{Objects from the Class}{ Objects can be created by applying the method \code{\link{probeset}} to instances of AffyBatch.} \section{Slots}{ \describe{ \item{\code{id}:}{Object of class \code{"character"} containing the probeset ID.} \item{\code{pm}:}{Object of class \code{"matrix"} containing the PM intensities. Columns represent samples and rows the different probes.} \item{\code{mm}:}{Object of class \code{"matrix"} containing the MM intensities.} } } \section{Methods}{ \describe{ \item{colnames}{\code{signature(x = "ProbeSet")}: the column names of the \code{pm} matrices which are the sample names} \item{express.summary.stat}{\code{signature(x = "ProbeSet", pmcorrect = "character", summary = "character")}: applies a summary statistic to the probe set.} \item{sampleNames}{\code{signature(object = "ProbeSet")}: the column names of the \code{pm} matrices which are the sample names.} } } \note{More details are contained in the vignette.} \seealso{\code{\link[affy:AffyBatch-class]{probeset}}, \code{\link[affy]{AffyBatch-class}}} \examples{ if (require(affydata)) { data(Dilution) ps <- probeset(Dilution, geneNames(Dilution)[1:2]) names(ps) print(ps[[1]]) } } \keyword{classes} affy/man/ProgressBarText-class.Rd0000644000175400017540000000433113556116173020001 0ustar00biocbuildbiocbuild\name{ProgressBarText-class} \docType{class} \alias{ProgressBarText-class} \alias{close,ProgressBarText-method} \alias{initialize,ProgressBarText-method} \alias{open,ProgressBarText-method} \alias{updateMe} \alias{updateMe,ProgressBarText-method} \title{Class "ProgressBarText" } \description{A class to handle progress bars in text mode.} \section{Objects from the Class}{ Objects can be created by calls of the form \code{new("ProgressBarText", steps)}. } \section{Slots}{ \describe{ \item{\code{steps}:}{Object of class \code{"integer"}. The total number of steps the progress bar should represent.} \item{\code{barsteps}:}{Object of class \code{"integer"}. The size of the progress bar.} \item{\code{internals}:}{Object of class \code{"environment"}. For internal use.} } } \section{Methods}{ \describe{ \item{close}{\code{signature(con = "ProgressBarText")}: Terminate the progress bar (i.e. print what needs to be printed). Note that closing the instance will ensure the progress bar is plotted to its end.} \item{initialize}{\code{signature(.Object = "ProgressBarText")}: initialize a instance.} \item{open}{\code{signature(con = "ProgressBarText")}: Open a progress bar (i.e. print things). In the case open is called on a progress bar that was 'progress', the progress bar is resumed (this might be useful when one wishes to insert text output while there is a progress bar running).} \item{updateMe}{\code{signature(object = "ProgressBarText")}: Update the progress bar (see examples).} } } \author{ Laurent } \examples{ f <- function(x, header = TRUE) { pbt <- new("ProgressBarText", length(x), barsteps = as.integer(20)) open(pbt, header = header) for (i in x) { Sys.sleep(i) updateMe(pbt) } close(pbt) } ## if too fast on your machine, change the number x <- runif(15) f(x) f(x, header = FALSE) ## 'cost' of the progress bar: g <- function(x) { z <- 1 for (i in 1:x) { z <- z + 1 } } h <- function(x) { pbt <- new("ProgressBarText", as.integer(x), barsteps = as.integer(20)) open(pbt) for (i in 1:x) { updateMe(pbt) } close(pbt) } system.time(g(10000)) system.time(h(10000)) } \keyword{classes} affy/man/SpikeIn.Rd0000644000175400017540000000306713556116173015147 0ustar00biocbuildbiocbuild\name{SpikeIn} \alias{SpikeIn} \alias{concentrations} \title{SpikeIn Experiment Data: ProbeSet Example} \description{ This \code{\link[affy:ProbeSet-class]{ProbeSet}} represents part of SpikeIn experiment data set. } \usage{data(SpikeIn)} \format{\code{SpikeIn} is \code{\link[affy:ProbeSet-class]{ProbeSet}} containing the $PM$ and $MM$ intensities for a gene spiked in at different concentrations (given in the vector \code{colnames(pm(SpikeIn))}) in 12 different arrays.} \source{This comes from an experiments where 11 different cRNA fragments have been added to the hybridization mixture of the GeneChip arrays at different pM concentrations. The 11 control cRNAs were BioB-5, BioB-M, BioB-3, BioC-5, BioC-3, BioDn-5 (all \emph{E. coli}), CreX-5, CreX-3 (phage P1), and DapX-5, DapX-M, DapX-3 (\emph{B. subtilis}) The cRNA were chosen to match the target sequence for each of the Affymetrix control probe sets. For example, for DapX (a \emph{B. subtilis} gene), the 5', middle and 3' target sequences (identified by DapX-5, DapX-M, DapX-3) were each synthesized separately and spiked-in at a specific concentration. Thus, for example, DapX-3 target sequence may be added to the total hybridization solution of 200 micro-liters to give a final concentration of 0.5 pM. For this example we have the $PM$ and $MM$ for BioB-5 obtained from the arrays where it was spiked in at 0.0, 0.5, 0.75, 1, 1.5, 2, 3, 5, 12.5, 25, 50, and 150 pM. For more information see Irizarry, R.A., et al. (2001) \url{http://biosun01.biostat.jhsph.edu/~ririzarr/papers/index.html}} \keyword{datasets} affy/man/affy-deprecated.Rd0000644000175400017540000000111013556116173016613 0ustar00biocbuildbiocbuild\name{affy-deprecated} \alias{loess.normalize} \alias{maffy.normalize} \alias{multiloess} \alias{simplemultiLoess} \title{Deprecated functions in package \sQuote{affy}} \description{ These functions are provided for compatibility with older versions of affy only, and will be defunct at the next release. } \details{ The following functions are deprecated and will be made defunct; use the replacement indicated below: \itemize{ \item{loess.normalize: \code{\link{normalize.loess}}} \item{maffy.normalize} \item{multiloess} \item{simplemultiLoess} } } affy/man/affy-options.Rd0000644000175400017540000000313613556116173016220 0ustar00biocbuildbiocbuild\name{affy-options} \alias{affy-options} \title{Options for the affy package} \description{ Description of the options for the affy package. } \note{ The affy package options are contained in the Bioconductor options. The options are: \itemize{ \item \code{use.widgets}: a logical used to decide on the default of widget use. \item \code{compress.cel}: a logical \item \code{compress.cdf}: a logical \item \code{probes.loc}: a list. Each element of the list is it self a list with two elements \emph{what} and \emph{where}. When looking for the informations about the locations of the probes on the array, the elements in the list will be looked at one after the other. The first one for which \emph{what} and \emph{where} lead to the matching locations information is used. The element \emph{what} can be one of \emph{package}, \emph{environment} or \emph{file}. The element \emph{where} depends on the corresponding element \emph{what}. \itemize{ \item if \emph{package}: location for the package (like it would be for the argument \code{lib.loc} for the function \code{library}.) \item if \emph{environment}: an \code{environment} to look for the information (like the argument \code{env} for the function \code{get}). \item if \emph{file}: a \code{character} with the path in which a CDF file can be found. } } } \examples{ ## get the options opt <- getOption("BioC") affy.opt <- opt$affy ## list their names names(affy.opt) ## set the option compress.cel affy.opt$compress.cel <- TRUE options(BioC=opt) } \keyword{manip} affy/man/affy.scalevalue.exprSet.Rd0000644000175400017540000000213413556116173020300 0ustar00biocbuildbiocbuild%%%THIS FUNCTION SHOULD BE In BIOBASE or SOMEWHERE ELSE... NEXT RELEASE %% LG: In such a case, I assume the long awaited agreement about %% normalization methods will be here and all the normalization methods %% will be stored together \name{affy.scalevalue.exprSet} \alias{affy.scalevalue.exprSet} \title{Scale normalization for expreSets} \description{ Normalizes expression values using the method described in the Affymetrix user manual. } \usage{ affy.scalevalue.exprSet(eset, sc = 500, analysis="absolute") } \arguments{ \item{eset}{An \code{\link[Biobase:class.ExpressionSet]{ExpressionSet}} object.} \item{sc}{Value at which all arrays will be scaled to.} \item{analysis}{Should we do absolute or comparison analysis, although "comparison" is still not implemented.} } \details{ This is function was implemented from the Affymetrix technical documentation for MAS 5.0. It can be downloaded from the website of the company. Please refer to this document for details. } \author{Laurent} \value{ A normalized \code{\link[Biobase:class.ExpressionSet]{ExpressionSet}}. } \keyword{manip} affy/man/barplot.ProbeSet.Rd0000644000175400017540000000211013556116173016756 0ustar00biocbuildbiocbuild\name{barplot.ProbeSet} \alias{barplot.ProbeSet} \title{show a ProbeSet as barplots} \description{ Displays the probe intensities in a ProbeSet as a barplots } \usage{ \method{barplot}{ProbeSet}(height, xlab = "Probe pair", ylab = "Intensity", main = NA, col.pm = "red", col.mm = "blue", beside = TRUE, names.arg = "pp", ask = TRUE, scale, ...) } \arguments{ \item{height}{an object of class \code{ProbeSet}.} \item{xlab}{label for x axis.} \item{ylab}{label for y axis.} \item{main}{main label for the figure.} \item{col.pm}{color for the `pm' intensities.} \item{col.mm}{color for the `mm' intensities.} \item{beside}{bars beside each others or not.} \item{names.arg}{names to be plotted below each bar or group of bars.} \item{ask}{ask before ploting the next barplot.} \item{scale}{put all the barplot to the same scale.} \item{\dots}{extra parameters to be passed to \code{\link{barplot}}.} } \examples{ if (require(affydata)) { data(Dilution) gn <- geneNames(Dilution) pps <- probeset(Dilution, gn[1])[[1]] barplot.ProbeSet(pps) } } \keyword{hplot} affy/man/bg.adjust.Rd0000644000175400017540000000145013556116173015460 0ustar00biocbuildbiocbuild\name{bg.adjust} \alias{bg.adjust} \alias{bg.parameters} \title{Background adjustment (internal function)} \description{ An internal function to be used by \code{\link{bg.correct.rma}}. } \usage{ bg.adjust(pm, n.pts = 2^14, ...) bg.parameters(pm, n.pts = 2^14) } \arguments{ \item{pm}{a pm matrix} \item{n.pts}{number of points to use in call to \code{density}.} \item{\dots}{extra arguments to pass to bg.adjust.} } \details{Assumes PMs are a convolution of normal and exponential. So we observe X+Y where X is background and Y is signal. \code{bg.adjust} returns E[Y|X+Y, Y>0] as our background corrected PM. \code{bg.parameters} provides ad hoc estimates of the parameters of the normal and exponential distributions.} \value{a matrix} \seealso{\code{\link{bg.correct.rma}}} \keyword{manip} affy/man/bgc.Rd0000644000175400017540000000415113556116173014333 0ustar00biocbuildbiocbuild\name{bg.correct} \alias{bg.correct} \alias{bg.correct.none} %took out .pmonly casue rma is pm-only %\alias{bg.correct.subtractmm} \alias{bg.correct.rma} \alias{bg.correct.mas} \title{Background Correction} \description{ Background corrects probe intensities in an object of class \code{\link[affy:AffyBatch-class]{AffyBatch}}. } \usage{ bg.correct(object, method, ...) bg.correct.rma(object,...) bg.correct.mas(object, griddim) bg.correct.none(object, ...) } \arguments{ \item{object}{An object of class \code{\link[affy:AffyBatch-class]{AffyBatch}}.} \item{method}{A \code{character} that defines what background correction method will be used. Available methods are given by \code{bg.correct.methods}.} \item{griddim}{grid dimension used for mas background estimate. The array is divided into griddim equal parts. Default is 16.} \item{\dots}{arguments to pass along to the engine function.} } \details{ The name of the method to apply must be double-quoted. Methods provided with the package are currently: \itemize{ \item bg.correct.none: returns \code{object} unchanged. \item bg.correct.chipwide: noise correction as described in a `white paper' from Affymetrix. \item bg.correct.rma: the model based correction used by the RMA expression measure. } They are listed in the variable \code{bg.correct.methods}. The user must supply the word after "bg.correct", i.e none, subtractmm, rma, etc... More details are available in the vignette. R implementations similar in function to the internal implementation used by \code{bg.correct.rma} are in \code{\link{bg.adjust}}. } \value{ An \code{\link[affy:AffyBatch-class]{AffyBatch}} for which the intensities have been background adjusted. For some methods (RMA), only PMs are corrected and the MMs remain the same. } \examples{ if (require(affydata)) { data(Dilution) ##bgc will be the bg corrected version of Dilution bgc <- bg.correct(Dilution, method="rma") ##This plot shows the tranformation plot(pm(Dilution)[,1],pm(bgc)[,1],log="xy", main="PMs before and after background correction") } } \keyword{manip} affy/man/cdfFromBioC.Rd0000644000175400017540000000204013556116173015710 0ustar00biocbuildbiocbuild\name{cdfFromBioC} \alias{cdfFromBioC} \alias{cdfFromLibPath} \alias{cdfFromEnvironment} \title{Functions to obtain CDF files} \description{ A set of functions to obtain CDF files from various locations. } \usage{ cdfFromBioC(cdfname, lib = .libPaths()[1], verbose = TRUE) cdfFromLibPath(cdfname, lib = NULL, verbose=TRUE) cdfFromEnvironment(cdfname, where, verbose=TRUE) } \arguments{ \item{cdfname}{name of the CDF.} \item{lib}{install directory for the CDF package.} \item{where}{environment to search.} \item{verbose}{logical controlling extra output.} } \details{ These functions all take a requested CDF environment name and will attempt to locate that environment in the appropriate location (a package's data directory, as a CDF package in the .libPaths(), from a loaded environment or on the Bioconductor website. If the environment can not be found, it will return a list of the methods tried that failed. } \value{ The CDF environment or a list detailing the failed locations. } \author{Jeff Gentry} \keyword{utilities} affy/man/cdfenv.example.Rd0000644000175400017540000000052513556116173016500 0ustar00biocbuildbiocbuild\name{cdfenv.example} \alias{cdfenv.example} \title{Example cdfenv} \description{ Example cdfenv (environment containing the probe locations). } \usage{data(cdfenv.example)} \format{ An \code{\link{environment}} \code{cdfenv.example} containing the probe locations} \source{Affymetrix CDF file for the array Hu6800} \keyword{datasets} affy/man/cleancdfname.Rd0000644000175400017540000000252113556116173016177 0ustar00biocbuildbiocbuild\name{cleancdfname} \alias{cleancdfname} \alias{mapCdfName} \title{Clean Affymetrix's CDF name} \description{ This function converts Affymetrix's names for CDF files to the names used in the annotation package and in all Bioconductor. } \usage{ cleancdfname(cdfname, addcdf = TRUE) } \arguments{ \item{cdfname}{A \code{character} denoting Affymetrix'x CDF file name } \item{addcdf}{A \code{logical}. If \code{TRUE} it adds the string "cdf" at the end of the cleaned CDF name. This is used to name the \code{cdfenvs} packages.} } \details{ This function takes a CDF filename obtained from an Affymetrix file (from a CEL file for example) and convert it to a convention of ours: all small caps and only alphanumeric characters. The details of the rule can be seen in the code. We observed exceptions that made us create a set of special cases for mapping CEL to CDF. The object \code{mapCdfName} holds information about these cases. It is a \code{data.frame} of three elements: the first is the name as found in the CDF file, the second the name in the CEL file and the third the name in Bioconductor. \code{mapCdfName} can be loaded using \code{data(mapCdfName)}. } \value{ A \code{character} } \examples{ cdf.tags <- c("HG_U95Av2", "HG-133A") for (i in cdf.tags) cat(i, "becomes", cleancdfname(i), "\n") } \keyword{character} affy/man/debug.affy123.Rd0000644000175400017540000000022113556116173016032 0ustar00biocbuildbiocbuild\name{debug.affy123} \docType{methods} \alias{debug.affy123} \title{Debugging Flag} \description{ For developmental use only } \keyword{methods} affy/man/expresso.Rd0000644000175400017540000000674613556116173015464 0ustar00biocbuildbiocbuild\name{expresso} \alias{expresso} \alias{bgcorrect} \title{ From raw probe intensities to expression values } \description{ Goes from raw probe intensities to expression values } \usage{ expresso( afbatch, # background correction bg.correct = TRUE, bgcorrect.method = NULL, bgcorrect.param = list(), # normalize normalize = TRUE, normalize.method = NULL, normalize.param = list(), # pm correction pmcorrect.method = NULL, pmcorrect.param = list(), # expression values summary.method = NULL, summary.param = list(), summary.subset = NULL, # misc. verbose = TRUE, % warnings = TRUE, widget = FALSE) } \arguments{ \item{afbatch}{an \code{\link[affy:AffyBatch-class]{AffyBatch}} object.} \item{bg.correct}{a boolean to express whether background correction is wanted or not.} \item{bgcorrect.method}{the name of the background adjustment method.} \item{bgcorrect.param}{a list of parameters for bgcorrect.method (if needed/wanted).} \item{normalize}{ normalization step wished or not.} \item{normalize.method}{the normalization method to use.} \item{normalize.param}{a list of parameters to be passed to the normalization method (if wanted).} \item{pmcorrect.method}{the name of the PM adjustment method.} \item{pmcorrect.param}{a list of parameters for pmcorrect.method (if needed/wanted).} \item{summary.method}{the method used for the computation of expression values.} \item{summary.param}{a list of parameters to be passed to the \code{summary.method} (if wanted).} \item{summary.subset}{a list of 'affyids'. If \code{NULL}, an expression summary value is computed for everything on the chip.} \item{verbose}{logical value. If \code{TRUE}, it writes out some messages.} % \item{warnings}{warning when something goes wrong} \item{widget}{a boolean to specify the use of widgets (the package tkWidget is required).} } \details{ Some arguments can be left to \code{NULL} if the \code{widget=TRUE}. In this case, a widget pops up and let the user choose with the mouse. The arguments are: \code{AffyBatch}, \code{bgcorrect.method}, \code{normalize.method}, \code{pmcorrect.method} and \code{summary.method}. For the mas 5.0 and 4.0 methods ones need to normalize after obtaining expression. The function \code{\link{affy.scalevalue.exprSet}} does this. For the Li and Wong summary method notice you will not get the same results as you would get with dChip. dChip is not open source so it is not easy to reproduce. Notice also that this iterative algorithm will not always converge. If you run the algorithm on thousands of probes expect some non-convergence warnings. These are more likely when few arrays are used. We recommend using this method only if you have 10 or more arrays. Please refer to the \code{\link{fit.li.wong}} help page for more details. } \value{ An object of class \code{\link[Biobase:class.ExpressionSet]{ExpressionSet}}, with an attribute \code{pps.warnings} as returned by the method \code{\link{computeExprSet}}. } \seealso{\code{\link[affy:AffyBatch-class]{AffyBatch}}} \examples{ if (require(affydata)) { data(Dilution) eset <- expresso(Dilution, bgcorrect.method="rma", normalize.method="constant",pmcorrect.method="pmonly", summary.method="avgdiff") ##to see options available for bg correction type: bgcorrect.methods() } } \keyword{manip} affy/man/expressoWidget.Rd0000644000175400017540000000414413556116173016616 0ustar00biocbuildbiocbuild\name{expressoWidget} \alias{expressoWidget} \title{A widget for users to pick correction methods} \description{ This widget is called by expresso to allow users to select correction methods that will be used to process affy data. } \usage{ expressoWidget(BGMethods, normMethods, PMMethods, expMethods, BGDefault, normDefault, PMDefault, expDefault) } \arguments{ \item{BGMethods}{a vector of character strings for the available methods that can be used as a background correction method of affy data.} \item{normMethods}{a vector of character strings for the available methods that can be used as a normalization method of affy data.} \item{PMMethods}{a vector of character strings for the available methods that can be used as a PM correction method of affy data.} \item{expMethods}{a vector of character strings for the available methods that can be used as a summary method of affy data.} \item{BGDefault}{a character string for the name of a default background correction method.} \item{normDefault}{a character string for the name of a default normalization method.} \item{PMDefault}{a character string for the name of a default PM correction method.} \item{expDefault}{a character string for the name of a default summary method.} } \details{ The widget will be invoked when expresso is called with argument "widget" set to TRUE. Default values can be changed using the drop down list boxes. Double clicking on an option from the drop-down list makes an selection. The first element of the list for available methods will be the default method if no default is provided. } \value{ The widget returns a list of selected correction methods. \item{BG}{background correction method} \item{NORM}{normalization method} \item{PM}{PM correction method} \item{EXP}{summary method} } \references{Documentations of affy package} \author{Jianhua Zhang} \seealso{\code{\link{expresso}}} \examples{ if(interactive()){ require(widgetTools) expressoWidget(c("mas", "none", "rma"), c("constant", "quantiles"), c("mas", "pmonly"), c("liwong", "playerout")) } } \keyword{interface} affy/man/fit.li.wong.Rd0000644000175400017540000001047513556116173015744 0ustar00biocbuildbiocbuild\name{fit.li.wong} \alias{fit.li.wong} \alias{li.wong} \title{Fit Li and Wong Model to a Probe Set} \description{Fits the model described in Li and Wong (2001) to a probe set with I chips and J probes. } \usage{ fit.li.wong(data.matrix, remove.outliers=TRUE, normal.array.quantile=0.5, normal.resid.quantile=0.9, large.threshold=3, large.variation=0.8, outlier.fraction=0.14, delta=1e-06, maxit=50, outer.maxit=50,verbose=FALSE, ...) li.wong(data.matrix,remove.outliers=TRUE, normal.array.quantile=0.5, normal.resid.quantile=0.9, large.threshold=3, large.variation=0.8, outlier.fraction=0.14, delta=1e-06, maxit=50, outer.maxit=50,verbose=FALSE) } \arguments{ \item{data.matrix}{an I x J matrix containing the probe set data. Typically the i,j entry will contain the PM-MM value for probe pair j in chip i. Another possible use, is to use PM instead of PM-MM.} \item{remove.outliers}{logical value indicating if the algorithm will remove outliers according to the procedure described in Li and Wong (2001).} \item{large.threshold}{used to define outliers.} \item{normal.array.quantile}{quantile to be used when determining what a normal SD is. probes or chips having estimates with SDs bigger than the quantile \code{normal.array.quantile} of all SDs x \code{large.threshold}.} \item{normal.resid.quantile}{any residual bigger than the \code{normal.resid.quantile} quantile of all residuals x \code{large.threshold} is considered an outlier.} \item{large.variation}{any probe or chip describing more than this much total variation is considered an outlier.} \item{outlier.fraction}{this is the maximum fraction of single outliers that can be in the same probe or chip.} \item{delta}{numerical value used to define the stopping criterion.} \item{maxit}{maximum number of iterations when fitting the model.} \item{outer.maxit}{maximum number of iterations of defined outliers.} \item{verbose}{logical value. If \code{TRUE} information is given of the status of the algorithm.} \item{\dots}{additional arguments.} } \details{ This is Bioconductor's implementation of the Li and Wong algorithm. The Li and Wong PNAS 2001 paper was followed. However, you will not get the same results as you would get with dChip. dChip is not open source so it is not easy to reproduce. Notice that this iterative algorithm will not always converge. If you run the algorithm on thousands of probes expect some non-convergence warnings. These are more likely when few arrays are used. We recommend using this method only if you have 10 or more arrays. Please refer to references for more details. } \value{\code{li.wong} returns a vector of expression measures (or column effects) followed by their respective standard error estimates. It was designed to work with \code{express} which is no longer part of the package. \code{fit.li.wong} returns much more. Namely, a list containing the fitted parameters and relevant information. \item{theta}{fitted thetas.} \item{phi}{fitted phis.} \item{sigma.eps}{estimated standard deviation of the error term.} \item{sigma.theta}{estimated standard error of theta.} \item{sigma.phi}{estimated standard error of phis.} \item{theta.outliers}{logical vector describing which chips (thetas) are considered outliers (\code{TRUE}).} \item{phi.outliers}{logical vector describing which probe sets (phis) are considered outliers (\code{TRUE})} \item{convergence1}{logical value. If \code{FALSE} the algorithm did not converge when fitting the phis and thetas.} \item{convergence2}{logical value. If \code{FALSE} the algorithm did not converge in deciding what are outliers.} \item{iter}{number of iterations needed to achieve convergence.} \item{delta}{difference between thetas when iteration stopped.} } \examples{ x <- sweep(matrix(2^rnorm(600),30,20),1,seq(1,2,len=30),FUN="+") fit1 <- fit.li.wong(x) plot(x[1,]) lines(fit1$theta) } \references{ Li, C. and Wong, W.H. (2001) \emph{Genome Biology} \bold{2}, 1--11.\cr Li, C. and Wong, W.H. (2001) \emph{Proc. Natl. Acad. Sci USA} \bold{98}, 31--36. } \author{Rafael A. Irizarry, Cheng Li, Fred A. Wright, Ben Bolstad} \seealso{\code{\link{li.wong}}, \code{\link{expresso}}} \keyword{manip} \keyword{models} affy/man/generateExprSet-methods.Rd0000644000175400017540000000426613556116173020355 0ustar00biocbuildbiocbuild\name{generateExprSet-method} \docType{methods} \alias{generateExprSet-methods} \alias{computeExprSet} \alias{generateExprSet.methods} \alias{upDate.generateExprSet.methods} \title{generate a set of expression values} \description{ Generate a set of expression values from the probe pair information. The set of expression is returned as an \code{\link[Biobase:class.ExpressionSet]{ExpressionSet}} object. } \usage{ computeExprSet(x, pmcorrect.method, summary.method, ...) generateExprSet.methods() upDate.generateExprSet.methods(x) } \arguments{ \item{x}{a \code{\link[=AffyBatch-class]{AffyBatch}} holding the probe level informations to generate the expression values, for computeExprSet, and for upDate.generateExprSet.methods it is a character vector..} \item{pmcorrect.method}{the method used to correct PM values (see section 'details').} \item{summary.method}{the method used to generate the expression value (see section 'details').} \item{\dots}{any of the options of the normalization you would like to modify.} } \details{ An extra argument \code{ids=} can be passed. It must be a vector of affids. The expression values will only be computed and returned for these affyids. The different methods available through this mechanism can be accessed by calling the method \code{generateExprSet.methods} with an object of call \code{Cel.container} as an argument. In the Affymetrix design, \emph{MM} probes were included to measure the noise (or background signal). The original algorithm for background correction was to subtract the \emph{MM} signal to the \emph{PM} signal. The methods currently included in the package are "bg.correct.subtractmm", "bg.correct.pmonly" and "bg.correct.adjust". To alter the available methods for generating ExprSets use upDate.generateExprSet.methods. } \seealso{ method \code{generateExprSet} of the class \code{\link[=AffyBatch-class]{AffyBatch}}\cr \code{\link{expresso}} } \examples{ if (require(affydata)) { data(Dilution) ids <- c( "1000_at","1001_at") eset <- computeExprSet(Dilution, pmcorrect.method="pmonly", summary.method="avgdiff", ids=ids) } } \keyword{manip} affy/man/generateExprVal-methods.Rd0000644000175400017540000000301513556116173020333 0ustar00biocbuildbiocbuild\name{generateExprVal} \alias{express.summary.stat} \alias{express.summary.stat-methods} \alias{express.summary.stat.methods} \alias{upDate.express.summary.stat.methods} \title{Compute a summary expression value from the probes intensities} \description{ Compute a summary expression value from the probes intensities } \usage{ express.summary.stat(x, pmcorrect, summary, ...) express.summary.stat.methods() # vector of names of methods upDate.express.summary.stat.methods(x) } \arguments{ \item{x}{a (\code{ProbeSet}} \item{pmcorrect}{the method used to correct the PM values before summarizing to an expression value.} \item{summary}{the method used to generate the expression value.} \item{\dots}{other parameters the method might need... (see the corresponding methods below...)} } \value{ Returns a vector of expression values. } \examples{ if (require(affydata)) { data(Dilution) p <- probeset(Dilution, "1001_at")[[1]] par(mfcol=c(5,2)) mymethods <- express.summary.stat.methods() nmet <- length(mymethods) nc <- ncol(pm(p)) layout(matrix(c(1:nc, rep(nc+1, nc)), nc, 2), width = c(1, 1)) barplot(p) results <- matrix(0, nc, nmet) rownames(results) <- paste("sample", 1:nc) colnames(results) <- mymethods for (i in 1:nmet) { ev <- express.summary.stat(p, summary=mymethods[i], pmcorrect="pmonly") if (mymethods[[i]] != "medianpolish") results[, i] <- 2^(ev$exprs) else results[, i] <- ev$exprs } dotchart(results, labels=paste("sample", 1:nc)) } } \keyword{manip} affy/man/generateExprVal.method.avgdiff.Rd0000644000175400017540000000352013556116173021557 0ustar00biocbuildbiocbuild\name{generateExprVal.method.avgdiff} \alias{generateExprVal.method.avgdiff} \alias{generateExprVal.method.medianpolish} \alias{generateExprVal.method.liwong} \alias{generateExprVal.method.mas} \title{Generate an expression value from the probes informations} \description{ Generate an expression from the probes } \usage{ generateExprVal.method.avgdiff(probes, ...) generateExprVal.method.medianpolish(probes, ...) generateExprVal.method.liwong(probes, ...) generateExprVal.method.mas(probes, ...) } \arguments{ \item{probes}{a matrix of probe intensities with rows representing probes and columns representing samples. Usually \code{pm(probeset)} where \code{probeset} is a of class \code{\link[affy:ProbeSet-class]{ProbeSet}}.} \item{\dots}{extra arguments to pass to the respective function.} } \value{ A list containing entries: \item{exprs}{The expression values.} \item{se.exprs}{The standard error estimate.} } \examples{ data(SpikeIn) ##SpikeIn is a ProbeSets probes <- pm(SpikeIn) avgdiff <- generateExprVal.method.avgdiff(probes) medianpolish <- generateExprVal.method.medianpolish(probes) liwong <- generateExprVal.method.liwong(probes) playerout <- generateExprVal.method.playerout(probes) mas <- generateExprVal.method.mas(probes) concentrations <- as.numeric(sampleNames(SpikeIn)) plot(concentrations,avgdiff$exprs,log="xy",ylim=c(50,10000),pch="a",type="b") points(concentrations,2^medianpolish$exprs,pch="m",col=2,type="b",lty=2) points(concentrations,liwong$exprs,pch="l",col=3,type="b",lty=3) points(concentrations,playerout$exprs,pch="p",col=4,type="b",lty=4) points(concentrations,mas$exprs,pch="p",col=4,type="b",lty=4) } \seealso{ \code{\link[affy]{generateExprSet-methods}}, \code{\link[affy]{generateExprVal.method.playerout}}, \code{\link[affy]{fit.li.wong}} } \keyword{manip} affy/man/generateExprVal.method.playerout.Rd0000644000175400017540000000242013556116173022173 0ustar00biocbuildbiocbuild\name{generateExprVal.method.playerout} \alias{generateExprVal.method.playerout} \alias{playerout.costfunction} \title{Generate an expression value from the probes informations} \description{ Generate an expression from the probes } \usage{ generateExprVal.method.playerout(probes, weights=FALSE, optim.method="L-BFGS-B") } \arguments{ \item{probes}{a list of \code{probes} slots from \code{PPSet.container}} \item{weights}{Should the resulting weights be returned ?} \item{optim.method}{see parameter 'optim' for the function \code{\link{optim}}} } \value{ A vector of expression values. } \details{ A non-parametric method to weight each perfect match probe in the set and to compute a weighted mean of the perfect match values. One will notice this method only makes use of the perfect matches. (see function \code{playerout.costfunction} for the cost function). } \author{ Laurent \cr (Thanks to E. Lazaridris for the original playerout code and the discussions about it) } \references{ Emmanuel N. Lazaridis, Dominic Sinibaldi, Gregory Bloom, Shrikant Mane and Richard Jove A simple method to improve probe set estimates from oligonucleotide arrays, Mathematical Biosciences, Volume 176, Issue 1, March 2002, Pages 53-58 } \keyword{manip} affy/man/hlog.Rd0000644000175400017540000000134013556116173014526 0ustar00biocbuildbiocbuild\name{hlog} \alias{hlog} \title{Hybrid Log} \description{Given a constant \code{c} this function returns \code{x} if \code{x} is less than \code{c} and \code{sign(x)*(c*log(abs(x)/c) + c)} if its not. Notice this is a continuous odd ( f(-x)=-f(x) ) function with continuous first derivative. The main purpose is to perform log transformation when one has negative numbers, for example for PM-MM.} \usage{ hlog(x, constant=1) } \arguments{ \item{x}{a number.} \item{constant}{the constant c (see description).} } \details{ If \code{constant} is less than or equal to 0 \code{log(x)} is returned for all \code{x}. If \code{constant} is infinity \code{x} is returned for all \code{x}. } \author{Rafael A. Irizarry} \keyword{math} affy/man/justrma.Rd0000644000175400017540000001152313556116173015266 0ustar00biocbuildbiocbuild\name{justRMA} \alias{justRMA} \alias{just.rma} \title{Read CEL files into an ExpressionSet} \description{ Read CEL files and compute an expression measure without using an AffyBatch.} \usage{ just.rma(\dots, filenames = character(0), phenoData = new("AnnotatedDataFrame"), description = NULL, notes = "", compress = getOption("BioC")$affy$compress.cel, rm.mask = FALSE, rm.outliers = FALSE, rm.extra = FALSE, verbose=FALSE, background=TRUE, normalize=TRUE, bgversion=2, destructive=FALSE, cdfname = NULL) justRMA(\dots, filenames=character(0), widget=getOption("BioC")$affy$use.widgets, compress=getOption("BioC")$affy$compress.cel, celfile.path=getwd(), sampleNames=NULL, phenoData=NULL, description=NULL, notes="", rm.mask=FALSE, rm.outliers=FALSE, rm.extra=FALSE, hdf5=FALSE, hdf5FilePath=NULL,verbose=FALSE, normalize=TRUE, background=TRUE, bgversion=2, destructive=FALSE, cdfname = NULL) } \arguments{ \item{\dots}{file names separated by comma.} \item{filenames}{file names in a character vector.} \item{phenoData}{an \code{\link[Biobase:class.AnnotatedDataFrame]{AnnotatedDataFrame}} object.} \item{description}{a \code{\link[Biobase:class.MIAME]{MIAME}} object.} \item{notes}{notes.} \item{compress}{are the CEL files compressed?} \item{rm.mask}{should the spots marked as 'MASKS' set to \code{NA}?} \item{rm.outliers}{should the spots marked as 'OUTLIERS' set to \code{NA}?} \item{rm.extra}{if \code{TRUE}, then overrides what is in \code{rm.mask} and \code{rm.oultiers}.} \item{hdf5}{use of hdf5 ? (not available yet)} \item{hdf5FilePath}{a filename to use with hdf5 (not available yet).} \item{verbose}{verbosity flag.} \item{widget}{a logical specifying if widgets should be used.} \item{celfile.path}{a character denoting the path \code{ReadAffy} should look for cel files.} \item{sampleNames}{a character vector of sample names to be used in the \code{AffyBatch}.} \item{normalize}{logical value. If \code{TRUE}, then normalize data using quantile normalization.} \item{background}{logical value. If \code{TRUE}, then background correct using RMA background correction.} \item{bgversion}{integer value indicating which RMA background to use 1: use background similar to pure R rma background given in affy version 1.0 - 1.0.2 2: use background similar to pure R rma background given in affy version 1.1 and above} \item{destructive}{logical value. If \code{TRUE}, then works on the PM matrix in place as much as possible, good for large datasets.} \item{cdfname}{Used to specify the name of an alternative cdf package. If set to \code{NULL}, then the usual cdf package based on Affymetrix' mappings will be used.} } \details{ \code{justRMA} is a wrapper for \code{just.rma} that permits the user to read in phenoData, MIAME information, and CEL files using widgets. One can also define files where to read phenoData and MIAME information. If the function is called with no arguments \code{justRMA()}, then all the CEL files in the working directory are read, converted to an expression measure using RMA and put into an \code{\link[Biobase:class.ExpressionSet]{ExpressionSet}}. However, the arguments give the user great flexibility. \code{phenoData} is read using \code{\link[Biobase]{read.AnnotatedDataFrame}}. If a character is given, it tries to read the file with that name to obtain the \code{AnnotatedDataFrame} object as described in \code{\link[Biobase]{read.AnnotatedDataFrame}}. If left \code{NULL} and \code{widget=FALSE} (\code{widget=TRUE} is not currently supported), then a default object is created. It will be an object of class \code{\link[Biobase:class.AnnotatedDataFrame]{AnnotatedDataFrame}} with its pData being a data.frame with column x indexing the CEL files. \code{description} is read using \code{\link[Biobase]{read.MIAME}}. If a character is given, it tries to read the file with that name to obtain a \code{MIAME} instance. If left \code{NULL} but \code{widget=TRUE}, then widgets are used. If left \code{NULL} and \code{widget=FALSE}, then an empty instance of \code{MIAME} is created. The arguments \code{rm.masks}, \code{rm.outliers}, \code{rm.extra} are passed along to the function \code{read.celfile}. } \value{ An \code{ExpressionSet} object, containing expression values identical to what one would get from running \code{rma} on an \code{AffyBatch}. } \author{In the beginning: James MacDonald Supporting routines, maintenance and just.rma: Ben Bolstad } \seealso{\code{\link[affy]{rma}}, \code{\link{read.affybatch}}} \keyword{manip} affy/man/list.celfiles.Rd0000644000175400017540000000071513556116173016342 0ustar00biocbuildbiocbuild\name{list.celfiles} \alias{list.celfiles} \title{List the Cel Files in a Directory/Folder} \description{ This function produces a vector containing the names of files in the named directory/folder ending in .cel or .CEL. } \usage{ list.celfiles(...) } \arguments{ \item{\dots}{arguments to pass along to \code{\link[base]{list.files}}} } \value{ A character vector of file names. } \seealso{list.files} \examples{ list.celfiles() } \keyword{character} affy/man/maffy.subset.Rd0000644000175400017540000000164213556116173016210 0ustar00biocbuildbiocbuild\name{maffy.subset} \alias{maffy.subset} \title{Select Subset} \description{Select a subset of rows with small rank-range over columns.} \usage{ maffy.subset(data,subset.size=5000,maxit=100, subset.delta=max(round(subset.size/100),25),verbose=FALSE)} \arguments{ \item{data}{a matrix} \item{subset.size}{desired size of subset} \item{maxit}{maximum number of iterations} \item{subset.delta}{maximum deviation from subset.size} \item{verbose}{logical value.} } \details{ Please refer to references. } \value{ A list with component \code{subset}, the indexes for subset. } \references{Astrand, M. (2001) \url{http://www.math.chalmers.se/~magnusaa/maffy/}} \author{Magnus Astrand} \seealso{ \code{\link{maffy.normalize}}} \examples{ if (require(affydata)) { #data(Dilution) #x <- log2(pm(Dilution)[,1:3]) #Index <- maffy.subset(x,subset.size=100)$subset #mva.pairs(x[Index,]) } } \keyword{internal} affy/man/mas5.Rd0000644000175400017540000000341113556116173014443 0ustar00biocbuildbiocbuild\name{mas5} \alias{mas5} \title{MAS 5.0 expression measure} \description{ This function converts an instance of \code{\link{AffyBatch}} into an instance of \code{\link[Biobase:class.ExpressionSet]{ExpressionSet}} using our implementation of Affymetrix's MAS 5.0 expression measure. } \usage{ mas5(object, normalize = TRUE, sc = 500, analysis = "absolute", ...) } \arguments{ \item{object}{an instance of \code{\link{AffyBatch}}} \item{normalize}{logical. If \code{TRUE} scale normalization is used after we obtain an instance of \code{\link[Biobase:class.ExpressionSet]{ExpressionSet}}} \item{sc}{Value at which all arrays will be scaled to.} \item{analysis}{should we do absolute or comparison analysis, although "comparison" is still not implemented.} \item{\dots}{other arguments to be passed to \code{\link{expresso}}.} } \details{ This function is a wrapper for \code{\link{expresso}} and \code{\link{affy.scalevalue.exprSet}}.} \value{ \code{\link[Biobase:class.ExpressionSet]{ExpressionSet}} The methods used by this function were implemented based upon available documentation. In particular a useful reference is Statistical Algorithms Description Document by Affymetrix. Our implementation is based on what is written in the documentation and, as you might appreciate, there are places where the documentation is less than clear. This function does not give exactly the same results. All source code of our implementation is available. You are free to read it and suggest fixes. For more information visit this URL: \url{http://stat-www.berkeley.edu/users/bolstad/} } \seealso{\code{\link{expresso}},\code{\link{affy.scalevalue.exprSet}}} \examples{ if (require(affydata)) { data(Dilution) eset <- mas5(Dilution) } } \keyword{manip} affy/man/mas5calls.Rd0000644000175400017540000001300613556116173015463 0ustar00biocbuildbiocbuild\name{mas5calls} \alias{mas5calls,AffyBatch-method} \alias{mas5calls,ProbeSet-method} \alias{mas5calls} \alias{mas5.detection} \alias{mas5calls.AffyBatch} \alias{mas5calls.ProbeSet} \title{MAS 5.0 Absolute Detection} \description{ Performs the Wilcoxon signed rank-based gene expression presence/absence detection algorithm first implemented in the Affymetrix Microarray Suite version 5. } \usage{ mas5calls(object,...) mas5calls.AffyBatch(object, ids = NULL, verbose = TRUE, tau = 0.015, alpha1 = 0.04, alpha2 = 0.06, ignore.saturated=TRUE) mas5calls.ProbeSet(object, tau = 0.015, alpha1 = 0.04, alpha2 = 0.06, ignore.saturated=TRUE) mas5.detection(mat, tau = 0.015, alpha1 = 0.04, alpha2 = 0.06, exact.pvals = FALSE, cont.correct = FALSE) } \arguments{ \item{object}{an object of class \code{AffyBatch} or \code{ProbeSet}.} \item{ids}{probeset IDs for which you want to compute calls.} \item{mat}{an n-by-2 matrix of paired values (pairs in rows), PMs first col.} \item{verbose}{logical. It \code{TRUE}, status of processing is reported.} \item{tau}{a small positive constant.} \item{alpha1}{a significance threshold in (0, alpha2).} \item{alpha2}{a significance threshold in (alpha1, 0.5).} \item{exact.pvals}{logical controlling whether exact p-values are computed (irrelevant if n<50 and there are no ties). Otherwise the normal approximation is used.} \item{ignore.saturated}{if TRUE, do the saturation correction described in the paper, with a saturation level of 46000.} \item{cont.correct}{logical controlling whether continuity correction is used in the p-value normal approximation.} \item{\dots}{any of the above arguments that applies.} } \details{ This function performs the hypothesis test: H0: median(Ri) = tau, corresponding to absence of transcript H1: median(Ri) > tau, corresponding to presence of transcript where Ri = (PMi - MMi) / (PMi + MMi) for each i a probe-pair in the probe-set represented by data. Currently exact.pvals=TRUE is not supported, and cont.correct=TRUE works but does not give great results (so both should be left as FALSE). The defaults for tau, alpha1 and alpha2 correspond to those in MAS5.0. The p-value that is returned estimates the usual quantity: Pr(observing a more "present looking" probe-set than data | data is absent) So that small p-values imply presence while large ones imply absence of transcript. The detection call is computed by thresholding the p-value as in: call "P" if p-value < alpha1 call "M" if alpha1 <= p-value < alpha2 call "A" if alpha2 <= p-value This implementation has been validated against the original MAS5.0 implementation with the following results (for exact.pvals and cont.correct set to F): Average Relative Change from MAS5.0 p-values:38\% Proportion of calls different to MAS5.0 calls:1.0\% where "average/proportion" means over all probe-sets and arrays, where the data came from 11 bacterial control probe-sets spiked-in over a range of concentrations (from 0 to 150 pico-mols) over 26 arrays. These are the spike-in data from the GeneLogic Concentration Series Spikein Dataset. Clearly the p-values computed here differ from those computed by MAS5.0 -- this will be improved in subsequent releases of the affy package. However the p-value discrepancies are small enough to result in the call being very closely aligned with those of MAS5.0 (99 percent were identical on the validation set) -- so this implementation will still be of use. The function \code{mas5.detect} is no longer the engine function for the others. C code is no available that computes the Wilcox test faster. The function is kept so that people can look at the R code (instead of C). } \value{ \code{mas5.detect} returns a list containing the following components: \item{pval}{ a real p-value in [0,1] equal to the probability of observing probe-level intensities that are more present looking than data assuming the data represents an absent transcript; that is a transcript is more likely to be present for p-values closer 0.} \item{call}{either "P", "M" or "A" representing a call of present, marginal or absent; computed by simply thresholding pval using alpha1 and alpha2.} The \code{mas5calls} method for \code{AffyBatch} returns an \code{ExpressionSet} with calls accessible with \code{exprs(obj)} and p-values available with \code{assayData(obj)[["se.exprs"]]}. The code \code{mas5calls} for \code{ProbeSet} returns a list with vectors of calls and p-values. } \references{ Liu, W. M. and Mei, R. and Di, X. and Ryder, T. B. and Hubbell, E. and Dee, S. and Webster, T. A. and Harrington, C. A. and Ho, M. H. and Baid, J. and Smeekens, S. P. (2002) Analysis of high density expression microarrays with signed-rank call algorithms, Bioinformatics, 18(12), pp. 1593--1599. Liu, W. and Mei, R. and Bartell, D. M. and Di, X. and Webster, T. A. and Ryder, T. (2001) Rank-based algorithms for analysis of microarrays, Proceedings of SPIE, Microarrays: Optical Technologies and Informatics, 4266. Affymetrix (2002) Statistical Algorithms Description Document, Affymetrix Inc., Santa Clara, CA, whitepaper. \url{http://www.affymetrix.com/support/technical/whitepapers/sadd_whitepaper.pdf}, \url{http://www.affymetrix.com/support/technical/whitepapers/sadd_whitepaper.pdf} } \author{Crispin Miller, Benjamin I. P. Rubinstein, Rafael A. Irizarry} \examples{ if (require(affydata)) { data(Dilution) PACalls <- mas5calls(Dilution) } } \keyword{manip} affy/man/merge.AffyBatch.Rd0000644000175400017540000000137713556116173016534 0ustar00biocbuildbiocbuild\name{merge.AffyBatch} \alias{merge.AffyBatch} \title{merge two AffyBatch objects} \description{ merge two AffyBatch objects into one. } \usage{ \method{merge}{AffyBatch}(x, y, annotation = paste(annotation(x), annotation(y)), description = NULL, notes = character(0), ...) } \arguments{ \item{x}{an \code{AffyBatch} object.} \item{y}{an \code{AffyBatch} object.} \item{annotation}{a \code{character} vector.} \item{description}{a \code{characterORmiame}, eventually \code{NULL}.} \item{notes}{a \code{character} vector.} \item{\dots}{additional arguments.} } \details{ To be done. } \value{ A object if class \code{\link[affy:AffyBatch-class]{AffyBatch}}. } \seealso{\code{\link{AffyBatch-class}}} \keyword{manip} affy/man/mva.pairs.Rd0000644000175400017540000000223213556116173015476 0ustar00biocbuildbiocbuild\name{mva.pairs} \alias{mva.pairs} \title{M vs. A Matrix} \description{ A matrix of M vs. A plots is produced. Plots are made on the upper triangle and the IQR of the Ms are displayed in the lower triangle } \usage{ mva.pairs(x, labels=colnames(x), log.it=TRUE,span=2/3,family.loess="gaussian", digits=3,line.col=2,main="MVA plot",cex=2,...) } \arguments{ \item{x}{a matrix containing the chip data in the columns.} \item{labels}{the names of the variables.} \item{log.it}{logical. If \code{TRUE}, uses log scale.} \item{span}{span to be used for loess fit.} \item{family.loess}{\code{"gaussian"} or \code{"symmetric"} as in \code{\link[stats]{loess}}.} \item{digits}{number of digits to use in the display of IQR.} \item{line.col}{color of the loess line.} \item{main}{an overall title for the plot.} \item{cex}{size for text.} \item{\dots}{graphical parameters can be given as arguments to \code{mva.plot}}.} \examples{ x <- matrix(rnorm(4000),1000,4) x[,1] <- x[,1]^2 dimnames(x) <- list(NULL,c("chip 1","chip 2","chip 3","chip 4")) mva.pairs(x,log=FALSE,main="example") } \seealso{\code{\link{pairs}}} \keyword{hplot} affy/man/normalize-methods.Rd0000644000175400017540000000506013556116173017241 0ustar00biocbuildbiocbuild\name{normalize-methods} \title{Normalize Affymetrix Probe Level Data - methods} \docType{methods} \alias{normalize.AffyBatch} \alias{normalize.methods} \alias{normalize.AffyBatch.methods} \alias{upDate.normalize.AffyBatch.methods} \alias{normalize,AffyBatch-method} \alias{normalize.methods,AffyBatch-method} \alias{normalize.AffyBatch.methods} \alias{bgcorrect.methods} \alias{upDate.bgcorrect.methods} \alias{pmcorrect.methods} \alias{upDate.pmcorrect.methods} \description{ Method for normalizing Affymetrix Probe Level Data } \usage{ normalize.methods(object) bgcorrect.methods() upDate.bgcorrect.methods(x) pmcorrect.methods() upDate.pmcorrect.methods(x) } \arguments{ \item{object}{An \code{\link[affy:AffyBatch-class]{AffyBatch}}.} \item{x}{A character vector that will replace the existing one.} } \details{ If \code{object} is an \code{\link[affy:AffyBatch-class]{AffyBatch}} object, then \code{normalize(object)} returns an \code{\link[affy:AffyBatch-class]{AffyBatch}} object with the intensities normalized using the methodology specified by \code{getOption("BioC")$affy$normalize.method}. The affy package default is \code{quantiles}. Other methodologies can be used by specifying them with the \code{method} argument. For example to use the invariant set methodology described by Li and Wong (2001) one would type: \code{normalize(object, method="invariantset")}. Further arguments passed by \code{...}, apart from \code{method}, are passed along to the function responsible for the methodology defined by the \code{method} argument. A character vector of \emph{nicknames} for the methodologies available is returned by \code{normalize.methods(object))}, where \code{object} is an \code{\link[affy:AffyBatch-class]{AffyBatch}}, or simply by typing \code{normalize.AffyBatch.methods}. If the nickname of a method is called "loess", the help page for that specific methodology can be accessed by typing \code{?normalize.loess}. For more on the normalization methodologies currently implemented please refer to the vignette `Custom Processing Methods'. To add your own normalization procedures please refer to the customMethods vignette. The functions: \code{bgcorrect.methods}, \code{pmcorrect.methods}, provide access to internal vectors listing the corresponding capabilities. } \seealso{ \code{\link{AffyBatch-class}}, \code{\link{normalize}}. } \examples{ if (require(affydata)) { data(Dilution) normalize.methods(Dilution) generateExprSet.methods() bgcorrect.methods() pmcorrect.methods() } } \keyword{manip} affy/man/normalize.constant.Rd0000644000175400017540000000216413556116173017432 0ustar00biocbuildbiocbuild\name{normalize.constant} \alias{normalize.constant} \alias{normalize.AffyBatch.constant} \title{Scale probe intensities} \description{ Scale array intensities in a \code{\link[affy:AffyBatch-class]{AffyBatch}}. } \usage{ normalize.AffyBatch.constant(abatch, refindex=1, FUN=mean, na.rm=TRUE) normalize.constant(x, refconstant, FUN=mean, na.rm=TRUE) } \arguments{ \item{abatch}{ an instance of the \code{\link{AffyBatch-class}}.} \item{x}{a vector of intensities on a chip (to normalize to the reference).} \item{refindex}{the index of the array used as a reference.} \item{refconstant}{the constant used as a reference.} \item{FUN}{a function generating a value from the intensities on an array. Typically \code{mean} or \code{median}.} \item{na.rm}{parameter passed to the function FUN.} } \value{ %A \code{\link[Biobase]{container-class}} of normalized objects. An \code{\link[affy:AffyBatch-class]{AffyBatch}} with an attribute "constant" holding the value of the factor used for scaling. } \author{ L. Gautier } \seealso{ \code{\link[affy:AffyBatch-class]{AffyBatch}} } \keyword{manip} affy/man/normalize.contrast.Rd0000644000175400017540000000217713556116173017442 0ustar00biocbuildbiocbuild\name{normalize.contrasts} \alias{normalize.contrasts} \alias{normalize.AffyBatch.contrasts} \title{Normalize intensities using the contrasts method} \description{ Scale chip objects in an \code{\link{AffyBatch-class}}. } \usage{ %normalize.contrast() ## currently maffy.normalize normalize.AffyBatch.contrasts(abatch,span=2/3, choose.subset=TRUE, subset.size=5000, verbose=TRUE, family="symmetric", type=c("together","pmonly","mmonly","separate")) } \arguments{ \item{abatch}{an \code{\link{AffyBatch-class}} object.} \item{span}{parameter to be passed to the function \code{\link[stats]{loess}}.} \item{choose.subset}{Boolean. Defaults to \code{TRUE}} \item{subset.size}{Integer. Number of probesets to use in each subset.} \item{verbose}{verbosity flag.} \item{family}{parameter to be passed to the function \code{\link[stats]{loess}}.} \item{type}{a string specifying how the normalization should be applied.} } \value{ An object of the same class as the one passed. } \seealso{ \code{\link{maffy.normalize}} } \keyword{manip} affy/man/normalize.invariantset.Rd0000644000175400017540000000435013556116173020307 0ustar00biocbuildbiocbuild\name{normalize.invariantset} \alias{normalize.invariantset} \alias{normalize.AffyBatch.invariantset} \title{Invariant Set normalization} \description{ Normalize arrays in an \code{\link[affy:AffyBatch-class]{AffyBatch}} using an invariant set. } \usage{ normalize.AffyBatch.invariantset(abatch, prd.td = c(0.003, 0.007), verbose = FALSE, baseline.type = c("mean","median","pseudo-mean","pseudo-median"), type = c("separate","pmonly","mmonly","together")) normalize.invariantset(data, ref, prd.td=c(0.003,0.007)) } \arguments{ \item{abatch}{an \code{\link[affy:AffyBatch-class]{AffyBatch}} object.} \item{data}{a vector of intensities on a chip (to normalize to the reference).} \item{ref}{a vector of reference intensities.} \item{prd.td}{cutoff parameter (details in the bibliographic reference).} \item{baseline.type}{specifies how to determine the baseline array.} \item{type}{a string specifying how the normalization should be applied. See details for more.} \item{verbose}{logical indicating printing throughout the normalization.} } \value{ Respectively a \code{\link[affy:AffyBatch-class]{AffyBatch}} of normalized objects, or a vector of normalized intensities, with an attribute "invariant.set" holding the indexes of the 'invariant' intensities. } \details{ The set of invariant intensities between \code{data} and \code{ref} is found through an iterative process (based on the respective ranks the intensities). This set of intensities is used to generate a normalization curve by smoothing. The \code{type} argument should be one of \code{"separate","pmonly","mmonly","together"} which indicates whether to normalize only one probe type (PM,MM) or both together or separately. } \author{ L. Gautier (Thanks to Cheng Li for the discussions about the algorithm.) } \references{ Cheng Li and Wing Hung Wong, Model-based analysis of oligonucleotides arrays: model validation, design issues and standard error application. Genome Biology 2001, 2(8):research0032.1-0032.11 } \seealso{ \code{\link{normalize}} to normalize \code{\link[affy:AffyBatch-class]{AffyBatch}} objects. } \keyword{manip} affy/man/normalize.loess.Rd0000644000175400017540000000356013556116173016727 0ustar00biocbuildbiocbuild\name{normalize.loess} \alias{normalize.loess} \alias{normalize.AffyBatch.loess} \title{Scale microarray data} \description{Normalizes arrays using loess.} \usage{ normalize.loess(mat, subset = sample(1:(dim(mat)[1]), min(c(5000, nrow(mat)))), epsilon = 10^-2, maxit = 1, log.it = TRUE, verbose = TRUE, span = 2/3, family.loess = "symmetric") normalize.AffyBatch.loess(abatch,type=c("together","pmonly","mmonly","separate"), ...) } \arguments{ \item{mat}{a matrix with columns containing the values of the chips to normalize.} \item{abatch}{an \code{\link[affy:AffyBatch-class]{AffyBatch}} object.} \item{subset}{a subset of the data to fit a loess to.} \item{epsilon}{a tolerance value (supposed to be a small value - used as a stopping criterion).} \item{maxit}{maximum number of iterations.} \item{log.it}{logical. If \code{TRUE} it takes the log2 of \code{mat}} \item{verbose}{logical. If \code{TRUE} displays current pair of chip being worked on.} \item{span}{parameter to be passed the function \code{\link[stats]{loess}}} \item{family.loess}{parameter to be passed the function \code{\link[stats]{loess}}. \code{"gaussian"} or \code{"symmetric"} are acceptable values for this parameter.} \item{type}{A string specifying how the normalization should be applied. See details for more.} \item{\dots}{any of the options of normalize.loess you would like to modify (described above).} } \details{ The type argument should be one of \code{"separate","pmonly","mmonly","together"} which indicates whether to normalize only one probe type (PM,MM) or both together or separately. } \seealso{ \code{\link{normalize}} } \examples{ if (require(affydata)) { #data(Dilution) #x <- pm(Dilution[,1:3]) #mva.pairs(x) #x <- normalize.loess(x,subset=1:nrow(x)) #mva.pairs(x) } } \keyword{smooth} affy/man/normalize.qspline.Rd0000644000175400017540000000716513556116173017262 0ustar00biocbuildbiocbuild\name{normalize.qspline} \alias{qspline-normalize} \alias{normalize.qspline} \alias{normalize.AffyBatch.qspline} \title{Normalize arrays} \description{ normalizes arrays in an AffyBatch each other or to a set of target intensities } \usage{ normalize.AffyBatch.qspline(abatch,type=c("together", "pmonly", "mmonly", "separate"), ...) normalize.qspline(x, target = NULL, samples = NULL, fit.iters = 5, min.offset = 5, spline.method = "natural", smooth = TRUE, spar = 0, p.min = 0, p.max = 1.0, incl.ends = TRUE, converge = FALSE, verbose = TRUE, na.rm = FALSE) } \arguments{ \item{x}{a \code{data.matrix} of intensities} \item{abatch}{an \code{AffyBatch}} \item{target}{numerical vector of intensity values to normalize to. (could be the name for one of the celfiles in 'abatch').} \item{samples}{numerical, the number of quantiles to be used for spline. if (0,1], then it is a sampling rate.} \item{fit.iters}{number of spline interpolations to average.} \item{min.offset}{minimum span between quantiles (rank difference) for the different fit iterations.} \item{spline.method}{specifies the type of spline to be used. Possible values are `"fmm"', `"natural"', and `"periodic"'.} \item{smooth}{logical, if `TRUE', smoothing splines are used on the quantiles.} \item{spar}{smoothing parameter for `splinefun', typically in (0,1].} \item{p.min}{minimum percentile for the first quantile.} \item{p.max}{maximum percentile for the last quantile.} \item{incl.ends}{include the minimum and maximum values from the normalized and target arrays in the fit.} \item{converge}{(currently unimplemented)} \item{verbose}{logical, if `TRUE' then normalization progress is reported.} \item{na.rm}{logical, if `TRUE' then handle NA values (by ignoring them).} \item{type}{a string specifying how the normalization should be applied. See details for more.} \item{\dots}{optional parameters to be passed through.} } \value{ a normalized \code{AffyBatch}. } \details{ This normalization method uses the quantiles from each array and the target to fit a system of cubic splines to normalize the data. The target should be the mean (geometric) or median of each probe but could also be the name of a particular chip in the \code{abatch} object. Parameters setting can be of much importance when using this method. The parameter \code{fit.iter} is used as a starting point to find a more appropriate value. Unfortunately the algorithm used do not converge in some cases. If this happens, the \code{fit.iter} value is used and a warning is thrown. Use of different settings for the parameter \code{samples} was reported to give good results. More specifically, for about 200 data points use \code{samples = 0.33}, for about 2000 data points use \code{samples = 0.05}, for about 10000 data points use \code{samples = 0.02} (thanks to Paul Boutros). The \code{type} argument should be one of \code{"separate","pmonly","mmonly","together"} which indicates whether to normalize only one probe type (PM,MM) or both together or separately. } \author{ Laurent and Workman C. } \references{ Christopher Workman, Lars Juhl Jensen, Hanne Jarmer, Randy Berka, Laurent Gautier, Henrik Bjorn Nielsen, Hans-Henrik Saxild, Claus Nielsen, Soren Brunak, and Steen Knudsen. A new non-linear normal- ization method for reducing variability in dna microarray experiments. Genome Biology, accepted, 2002 } \keyword{manip} affy/man/normalize.quantiles.Rd0000644000175400017540000000313013556116173017600 0ustar00biocbuildbiocbuild\name{normalize.quantiles} \alias{normalize.AffyBatch.quantiles} \title{Quantile Normalization} \description{ Using a normalization based upon quantiles, this function normalizes a matrix of probe level intensities. } \usage{ normalize.AffyBatch.quantiles(abatch, type=c("separate","pmonly","mmonly","together")) } \arguments{ \item{abatch}{an \code{\link[affy:AffyBatch-class]{AffyBatch}} object.} \item{type}{A string specifying how the normalization should be applied. See details for more.} } \details{This method is based upon the concept of a quantile-quantile plot extended to n dimensions. No special allowances are made for outliers. If you make use of quantile normalization either through \code{\link{rma}} or \code{\link{expresso}} please cite Bolstad et al, Bioinformatics (2003). The type argument should be one of \code{"separate","pmonly","mmonly","together"} which indicates whether to normalize only one probe type (PM,MM) or both together or separately. } \value{ A normalized \code{AffyBatch}. } \references{ Bolstad, B (2001) \emph{Probe Level Quantile Normalization of High Density Oligonucleotide Array Data}. Unpublished manuscript \url{http://bmbolstad.com/stuff/qnorm.pdf} Bolstad, B. M., Irizarry R. A., Astrand, M, and Speed, T. P. (2003) \emph{A Comparison of Normalization Methods for High Density Oligonucleotide Array Data Based on Bias and Variance.} Bioinformatics 19(2) ,pp 185-193. \url{http://bmbolstad.com/misc/normalize/normalize.html} } \author{Ben Bolstad, \email{bmbolstad.com}} \seealso{\code{\link{normalize}}} \keyword{manip} affy/man/normalize.quantiles.robust.Rd0000644000175400017540000000462013556116173021122 0ustar00biocbuildbiocbuild\name{normalize.quantiles.robust} \alias{normalize.AffyBatch.quantiles.robust} \title{Robust Quantile Normalization} \description{Using a normalization based upon quantiles, this function normalizes a matrix of probe level intensities. Allows weighting of chips} \usage{ normalize.AffyBatch.quantiles.robust(abatch, type = c("separate","pmonly","mmonly","together"), weights = NULL, remove.extreme = c("variance","mean","both","none"), n.remove = 1, use.median = FALSE, use.log2 = FALSE) } \arguments{ \item{abatch}{an \code{\link[affy:AffyBatch-class]{AffyBatch}} object.} \item{type}{a string specifying how the normalization should be applied. See details for more.} \item{weights}{a vector of weights, one for each chip.} \item{remove.extreme}{if weights is NULL, then this will be used for determining which chips to remove from the calculation of the normalization distribution. See details for more info.} \item{n.remove}{number of chips to remove.} \item{use.median}{if TRUE, the use the median to compute normalization chip; otherwise uses a weighted mean.} \item{use.log2}{work on log2 scale. This means we will be using the geometric mean rather than ordinary mean.} } \details{This method is based upon the concept of a quantile-quantile plot extended to n dimensions. Note that the matrix is of intensities not log intensities. The function performs better with raw intensities. Choosing \bold{variance} will remove chips with variances much higher or lower than the other chips, \bold{mean} removes chips with the mean most different from all the other means, \bold{both} removes first extreme variance and then an extreme mean. The option \bold{none} does not remove any chips, but will assign equal weights to all chips. The type argument should be one of \code{"separate","pmonly","mmonly","together"} which indicates whether to normalize only one probe type (PM,MM) or both together or separately. } \note{This function is still experimental.} \value{a matrix of normalized intensities} \author{Ben Bolstad, \email{bmb@bmbolstad.com}} \seealso{\code{\link{normalize}}, \code{\link[preprocessCore:normalize.quantiles]{normalize.quantiles}}} \keyword{manip} affy/man/pairs.AffyBatch.Rd0000644000175400017540000000332513556116173016546 0ustar00biocbuildbiocbuild\name{pairs.AffyBatch} \alias{pairs.AffyBatch} \title{plot intensities using 'pairs'} \description{ Plot intensities using the function 'pairs' } \usage{ \method{pairs}{AffyBatch}(x, panel=points, ..., transfo=I, main=NULL, oma=NULL, font.main = par("font.main"), cex.main = par("cex.main"), cex.labels = NULL, lower.panel=panel, upper.panel=NULL, diag.panel=NULL, font.labels = 1, row1attop = TRUE, gap = 1) } \arguments{ \item{x}{an \code{\link[affy:AffyBatch-class]{AffyBatch}} object.} \item{panel}{a function to produce a plot (see \code{\link{pairs}}).} \item{\dots}{extra parameters for the 'panel' function.} \item{transfo}{a function to transform the intensity values before generating the plot. 'log' and 'log2' are popular choices.} \item{main}{title for the plot} \item{oma}{see 'oma' in \code{\link{par}}.} \item{font.main}{see \code{\link{pairs}}.} \item{cex.main}{see \code{\link{pairs}}.} \item{cex.labels}{see \code{\link{pairs}}.} \item{lower.panel}{a function to produce the plots in the lower triangle (see \code{\link{pairs}}).} \item{upper.panel}{a function to produce the plots in the upper triangle (see \code{\link{pairs}}).} \item{diag.panel}{a function to produce the plots in the diagonal (see \code{\link{pairs}}).} \item{font.labels}{see \code{\link{pairs}}.} \item{row1attop}{see \code{\link{pairs}}.} \item{gap}{see \code{\link{pairs}}.} } \details{ Plots with several chips can represent zillions of points. They require a lot of memory and can be very slow to be displayed. You may want to try to split of the plots, or to plot them in a device like 'png' or 'jpeg'. } \keyword{hplot} affy/man/plot.ProbeSet.Rd0000644000175400017540000000121513556116173016276 0ustar00biocbuildbiocbuild\name{plot.ProbeSet} \alias{plot.ProbeSet} \title{plot a probe set} \description{ Plot intensities by probe set. } \usage{ \method{plot}{ProbeSet}(x, which=c("pm", "mm"), xlab = "probes", type = "l", ylim = NULL, ...) } \arguments{ \item{x}{a \code{ProbeSet} object.} \item{which}{get the PM or the MM.} \item{xlab}{x-axis label.} \item{type}{plot type.} \item{ylim}{range of the y-axis.} \item{\dots}{optional arguments to be passed to \code{matplot}.} } \value{ This function is only used for its (graphical) side-effect. } \seealso{\code{\link[affy:ProbeSet-class]{ProbeSet}}} \examples{ data(SpikeIn) plot(SpikeIn) } \keyword{hplot} affy/man/plot.density.Rd0000644000175400017540000000344013556116173016234 0ustar00biocbuildbiocbuild%\name{matdensity} \name{plotDensity} %\alias{matdensity} \alias{plotDensity} \alias{plotDensity.AffyBatch} \title{Plot Densities} \description{ Plots the non-parametric density estimates using values contained in the columns of a matrix. } \usage{ %matdensity(mat, ylab = "density", xlab="x", type="l", ...) plotDensity(mat, ylab = "density", xlab="x", type="l", col=1:6, na.rm = TRUE, ...) plotDensity.AffyBatch(x, col = 1:6, log = TRUE, which=c("pm","mm","both"), ylab = "density", xlab = NULL, ...) } \arguments{ \item{mat}{a matrix containing the values to make densities in the columns.} \item{x}{an object of class \code{\link[affy:AffyBatch-class]{AffyBatch}}.} \item{log}{logical value. If \code{TRUE} the log of the intensities in the \code{AffyBatch} are plotted.} \item{which}{should a histogram of the PMs, MMs, or both be made?} \item{col}{the colors to use for the different arrays.} \item{ylab}{a title for the y axis.} \item{xlab}{a title for the x axis.} \item{type}{type for the plot.} \item{na.rm}{handling of \code{NA} values.} \item{\dots}{graphical parameters can be given as arguments to \code{\link{plot}}.} } \details{ The list returned can be convenient for plotting large input matrices with different colors/line types schemes (the computation of the densities can take some time). To match other functions in base R, this function should probably be called \code{matdensity}, as it is sharing similarities with \code{matplot} and \code{matlines}. } \value{ It returns invisibly a list of two matrices `x' and `y'. } \author{Ben Bolstad and Laurent Gautier} \examples{ if (require(affydata)) { data(Dilution) plotDensity(exprs(Dilution), log="x") } } \keyword{hplot} affy/man/plotLocation.Rd0000644000175400017540000000233313556116173016247 0ustar00biocbuildbiocbuild\name{plotLocation} \alias{plotLocation} \title{Plot a location on a cel image} \description{ Plots a location on a previously plotted cel image. This can be used to locate the physical location of probes on the array. } \usage{ plotLocation(x, col="green", pch=22, ...) } \arguments{ \item{x}{a `location'. It can be obtained by the method of \code{AffyBatch} \code{indexProbes}, or made elsewhere (basically a location is nrows and two columns array. The first column corresponds to the x positions and the second columns corresponds to the y positions of n elements to locate).} \item{col}{colors for the plot.} \item{pch}{plotting type (see function \code{plot}).} \item{\dots}{other parameters passed to the function \code{points}.} } \author{ Laurent } \seealso{ \code{\link[affy:AffyBatch-class]{AffyBatch}} } \examples{ if (require(affydata)) { data(Dilution) ## image of the celfile image(Dilution[, 1]) ## genenames, arbitrarily pick the 101th n <- geneNames(Dilution)[101] ## get the location for the gene n l <- indexProbes(Dilution, "both", n)[[1]] ## convert the index to X/Y coordinates xy <- indices2xy(l, abatch=Dilution) ## plot plotLocation(xy) } } \keyword{aplot} affy/man/pmcorrect.Rd0000644000175400017540000000271613556116173015603 0ustar00biocbuildbiocbuild\name{pmcorrect} \alias{pmcorrect} \alias{pmcorrect.pmonly} %took out .pmonly casue rma is pm-only \alias{pmcorrect.mas} \alias{pmcorrect.subtractmm} \title{PM Correction} \description{ Corrects the PM intensities in a \code{\link[affy:ProbeSet-class]{ProbeSet}} for non-specific binding. } \usage{ pmcorrect.pmonly(object) pmcorrect.subtractmm(object) pmcorrect.mas(object, contrast.tau=0.03, scale.tau=10, delta=2^(-20)) } \arguments{ \item{object}{An object of class \code{\link[affy:ProbeSet-class]{ProbeSet}}.} \item{contrast.tau}{a number denoting the contrast tau parameter in the MAS 5.0 pm correction algorithm.} \item{scale.tau}{a number denoting the scale tau parameter in the MAS 5.0 pm correction algorithm.} \item{delta}{a number denoting the delta parameter in the MAS 5.0 pm correction algorithm.} } \details{ These are the pm correction methods perfromed by Affymetrix MAS 4.0 (subtractmm) and MAS 5.0 (mas). See the Affymetrix Manual for details. pmonly does what you think: does not change the PM values.} \value{A \code{\link[affy:ProbeSet-class]{ProbeSet}} for which the \code{pm} slot contains the corrected PM values.} \references{Affymetrix MAS 4.0 and 5.0 manual} \examples{ if (require(affydata)) { data(Dilution) gn <- geneNames(Dilution) pps <- probeset(Dilution, gn[1])[[1]] pps.pmonly <- pmcorrect.pmonly(pps) pps.subtractmm <- pmcorrect.subtractmm(pps) pps.mas5 <- pmcorrect.mas(pps) } } \keyword{manip} affy/man/ppsetApply.Rd0000644000175400017540000000303413556116173015740 0ustar00biocbuildbiocbuild\name{ppsetApply} \alias{ppsetApply} \alias{ppset.ttest} \title{ Apply a function over the ProbeSets in an AffyBatch } \description{ Apply a function over the ProbeSets in an AffyBatch } \usage{ ppsetApply(abatch, FUN, genenames = NULL, ...) ppset.ttest(ppset, covariate, pmcorrect.fun = pmcorrect.pmonly, ...) } \arguments{ \item{abatch}{an object inheriting from \code{AffyBatch}.} \item{ppset}{an object of class \code{ProbeSet}.} \item{covariate}{the name a covariate in the slot \code{phenoData}.} \item{pmcorrect.fun}{a function to correct PM intensities.} \item{FUN}{a function working on a \code{ProbeSet}.} \item{genenames}{a list of Affymetrix probesets ids to work with. All probe set ids used when \code{NULL}.} \item{\dots}{optional parameters to the function \code{FUN}.} } \value{ Returns a \code{list} of objects, or values, as returned by the function \code{FUN} for each \code{ProbeSet} it processes. } \author{Laurent Gautier } \seealso{\code{\link[affy]{ProbeSet-class}} } \examples{ ppset.ttest <- function(ppset, covariate, pmcorrect.fun = pmcorrect.pmonly, ...) { probes <- do.call("pmcorrect.fun", list(ppset)) my.ttest <- function(x) { y <- split(x, get(covariate)) t.test(y[[1]], y[[2]])$p.value } r <- apply(probes, 1, my.ttest) return(r) } ##this takes a long time - and rowttests is a good alternative ## eg: rt = rowttests(exprs(Dilution), Dilution$liver) \dontrun{ data(Dilution) all.ttest <- ppsetApply(Dilution, ppset.ttest, covariate="liver") } } \keyword{ manip } affy/man/probeMatch-methods.Rd0000644000175400017540000000106513556116173017326 0ustar00biocbuildbiocbuild\name{probeMatch-methods} \docType{methods} \title{Methods for accessing perfect matches and mismatches} \alias{probeMatch-methods} \alias{probeMatch} \alias{pm} \alias{pm<-} \alias{mm} \alias{mm<-} \description{Methods for perfect matches and mismatches probes} \section{Methods}{\describe{ \item{object = AffyBatch}{All the \emph{perfect match} (pm) or \emph{mismatch} (mm) probes on the arrays the object represents are returned.} \item{object = ProbeSet}{The \code{pm} or \code{mm} of the object are returned.} } } \keyword{methods} affy/man/probeNames-methods.Rd0000644000175400017540000000101513556116173017330 0ustar00biocbuildbiocbuild\name{probeNames-methods} \docType{methods} \title{Methods for accessing the Probe Names} \alias{probeNames-methods} \alias{probeNames} \alias{probeNames<-} %\alias{probeName} %\alias{probeName<-} \description{Methods for accessing Probe Names} \section{Methods}{\describe{ \item{object = Cdf}{an accessor function for the \code{name} slot.} \item{object = probeNames}{returns the probe names associated with the rownames of the intensity matrices one gets with the \code{pm} and \code{mm} methods.} }} \keyword{methods} affy/man/read.affybatch.Rd0000644000175400017540000001072713556116173016447 0ustar00biocbuildbiocbuild\name{read.affybatch} \alias{read.affybatch} \alias{AllButCelsForReadAffy} \alias{ReadAffy} \title{Read CEL files into an AffyBatch} \description{ Read CEL files into an Affybatch. } \usage{ read.affybatch(\dots, filenames = character(0), phenoData = new("AnnotatedDataFrame"), description = NULL, notes = "", compress = getOption("BioC")$affy$compress.cel, rm.mask = FALSE, rm.outliers = FALSE, rm.extra = FALSE, verbose = FALSE,sd=FALSE, cdfname = NULL) ReadAffy(\dots, filenames=character(0), widget=getOption("BioC")$affy$use.widgets, compress=getOption("BioC")$affy$compress.cel, celfile.path=NULL, sampleNames=NULL, phenoData=NULL, description=NULL, notes="", rm.mask=FALSE, rm.outliers=FALSE, rm.extra=FALSE, verbose=FALSE,sd=FALSE, cdfname = NULL) } \arguments{ \item{\dots}{file names separated by comma.} \item{filenames}{file names in a character vector.} \item{phenoData}{an \code{\link[Biobase:class.AnnotatedDataFrame]{AnnotatedDataFrame}} object, a \code{character} of length one, or a \code{data.frame}.} \item{description}{a \code{\link[Biobase:class.MIAME]{MIAME}} object.} \item{notes}{notes.} \item{compress}{are the CEL files compressed?} \item{rm.mask}{should the spots marked as 'MASKS' set to \code{NA}?} \item{rm.outliers}{should the spots marked as 'OUTLIERS' set to \code{NA}?} \item{rm.extra}{if \code{TRUE}, then overrides what is in \code{rm.mask} and \code{rm.oultiers}.} \item{verbose}{verbosity flag.} \item{widget}{a logical specifying if widgets should be used.} \item{celfile.path}{a character denoting the path \code{ReadAffy} should look for cel files.} \item{sampleNames}{a character vector of sample names to be used in the \code{AffyBatch}.} \item{sd}{should the standard deviation values in the CEL file be read in? Since these are typically not used default is not to read them in. This also save lots of memory.} \item{cdfname}{used to specify the name of an alternative cdf package. If set to \code{NULL}, then the usual cdf package based on Affymetrix's mappings will be used.} } \details{ \code{ReadAffy} is a wrapper for \code{read.affybatch} that permits the user to read in phenoData, MIAME information, and CEL files using widgets. One can also define files where to read phenoData and MIAME information. If the function is called with no arguments \code{ReadAffy()} all the CEL files in the working directory are read and put into an \code{AffyBatch}. However, the arguments give the user great flexibility. If \code{phenoData} is a character vector of length 1, the function \code{\link[Biobase]{read.AnnotatedDataFrame}} is called to read a file of that name and produce the \code{AnnotationDataFrame} object with the sample metadata. If \code{phenoData} is a \code{data.frame}, it is converted to an \code{AnnotatedDataFrame}. If it is \code{NULL} and \code{widget=FALSE} (\code{widget=TRUE} is not currently supported), then a default object of class \code{\link[Biobase:class.AnnotatedDataFrame]{AnnotatedDataFrame}} is created, whose \code{pData} is a data.frame with rownames being the names of the CEL files, and with one column \code{sample} with an integer index. \code{AllButCelsForReadAffy} is an internal function that gets called by \code{ReadAffy}. It gets all the information except the cel intensities. \code{description} is read using \code{\link[Biobase]{read.MIAME}}. If a character is given, then it tries to read the file with that name to obtain a \code{MIAME} instance. If left \code{NULL} but \code{widget=TRUE}, then widgets are used. If left \code{NULL} and \code{widget=FALSE}, then an empty instance of \code{MIAME} is created. } \value{ An \code{AffyBatch} object. } \author{Ben Bolstad \email{bmb@bmbolstad.com} (read.affybatch), Laurent Gautier, and Rafael A. Irizarry (ReadAffy)} \seealso{\code{\link[affy:AffyBatch-class]{AffyBatch}}} \examples{ if(require(affydata)){ celpath <- system.file("celfiles", package="affydata") fns <- list.celfiles(path=celpath,full.names=TRUE) cat("Reading files:\n",paste(fns,collapse="\n"),"\n") ##read a binary celfile abatch <- ReadAffy(filenames=fns[1]) ##read a text celfile abatch <- ReadAffy(filenames=fns[2]) ##read all files in that dir abatch <- ReadAffy(celfile.path=celpath) } } \keyword{manip} affy/man/read.probematrix.Rd0000644000175400017540000000326113556116173017047 0ustar00biocbuildbiocbuild\name{read.probematrix} \alias{read.probematrix} \title{Read CEL file data into PM or MM matrices} \description{ Read CEL data into matrices. } \usage{ read.probematrix(..., filenames = character(0), phenoData = new("AnnotatedDataFrame"), description = NULL, notes = "", compress = getOption("BioC")$affy$compress.cel, rm.mask = FALSE, rm.outliers = FALSE, rm.extra = FALSE, verbose = FALSE, which = "pm", cdfname = NULL) } \arguments{ \item{\dots}{file names separated by comma.} \item{filenames}{file names in a character vector.} \item{phenoData}{a \code{\link[Biobase:class.AnnotatedDataFrame]{AnnotatedDataFrame}} object.} \item{description}{a \code{\link[Biobase:class.MIAME]{MIAME}} object.} \item{notes}{notes.} \item{compress}{are the CEL files compressed?} \item{rm.mask}{should the spots marked as 'MASKS' set to \code{NA}?} \item{rm.outliers}{should the spots marked as 'OUTLIERS' set to \code{NA}?} \item{rm.extra}{if \code{TRUE}, overrides what is in \code{rm.mask} and \code{rm.oultiers}.} \item{verbose}{verbosity flag.} \item{which}{should be either "pm", "mm" or "both".} \item{cdfname}{Used to specify the name of an alternative cdf package. If set to \code{NULL}, the usual cdf package based on Affymetrix's mappings will be used.} } \value{ A list of one or two matrices. Each matrix is either PM or MM data. No \code{\link[affy:AffyBatch-class]{AffyBatch}} is created. } \author{Ben Bolstad \email{bmb@bmbolstad.com}} \seealso{\code{\link[affy:AffyBatch-class]{AffyBatch}}, \code{\link[affy:read.affybatch]{read.affybatch}}} \keyword{manip} affy/man/rma.Rd0000644000175400017540000000550013556116173014356 0ustar00biocbuildbiocbuild\name{rma} \alias{rma} \title{Robust Multi-Array Average expression measure} \description{ This function converts an \code{\link[affy:AffyBatch-class]{AffyBatch}} object into an \code{\link[Biobase:class.ExpressionSet]{ExpressionSet}} object using the robust multi-array average (RMA) expression measure. } \usage{ rma(object, subset=NULL, verbose=TRUE, destructive=TRUE, normalize=TRUE, background=TRUE, bgversion=2, ...) } \arguments{ \item{object}{an \code{\link[affy:AffyBatch-class]{AffyBatch}} object.} \item{subset}{a character vector with the the names of the probesets to be used in expression calculation.} \item{verbose}{logical value. If \code{TRUE}, it writes out some messages indicating progress. If \code{FALSE} nothing should be printed.} \item{destructive}{logical value. If \code{TRUE}, works on the PM matrix in place as much as possible, good for large datasets.} \item{normalize}{logical value. If \code{TRUE}, normalize data using quantile normalization.} \item{background}{logical value. If \code{TRUE}, background correct using RMA background correction.} \item{bgversion}{integer value indicating which RMA background to use 1: use background similar to pure R rma background given in affy version 1.0 - 1.0.2 2: use background similar to pure R rma background given in affy version 1.1 and above} \item{\dots}{further arguments to be passed (not currently implemented - stub for future use).} } \details{ This function computes the RMA (Robust Multichip Average) expression measure described in Irizarry et al Biostatistics (2003). Note that this expression measure is given to you in log base 2 scale. This differs from most of the other expression measure methods. Please note that the default background adjustment method was changed during the lead up to the Bioconductor 1.2 release. This means that this function and \code{\link{expresso}} should give results that directly agree. } \value{ An \code{\link[Biobase:class.ExpressionSet]{ExpressionSet}} } \author{Ben Bolstad \email{bmb@bmbolstad.com}} \references{ Rafael. A. Irizarry, Benjamin M. Bolstad, Francois Collin, Leslie M. Cope, Bridget Hobbs and Terence P. Speed (2003), Summaries of Affymetrix GeneChip probe level data Nucleic Acids Research 31(4):e15 Bolstad, B.M., Irizarry R. A., Astrand M., and Speed, T.P. (2003), A Comparison of Normalization Methods for High Density Oligonucleotide Array Data Based on Bias and Variance. Bioinformatics 19(2):185-193 Irizarry, RA, Hobbs, B, Collin, F, Beazer-Barclay, YD, Antonellis, KJ, Scherf, U, Speed, TP (2003) Exploration, Normalization, and Summaries of High Density Oligonucleotide Array Probe Level Data. Biostatistics .Vol. 4, Number 2: 249-264 } \seealso{\code{\link{expresso}}} \examples{ if (require(affydata)) { data(Dilution) eset <- rma(Dilution) } } \keyword{manip} affy/man/setAffyOptions.Rd0000644000175400017540000000113613556116173016555 0ustar00biocbuildbiocbuild\name{.setAffyOptions} \alias{.setAffyOptions} \title{ ~~function to set options ~~ } \description{ ~~ Set the options for the package } \usage{ .setAffyOptions(affy.opt = NA) } \arguments{ \item{affy.opt}{ A list structure of options. If \code{NA}, the default options are set.} } \details{ See the vignettes to know more. This function could disappear in favor of a more general one the package Biobase. } \value{ The function is used for its side effect. Nothing is returned. } \author{ Laurent } \examples{ affy.opt <- getOption("BioC")$affy .setAffyOptions(affy.opt) } \keyword{manip} affy/man/summary.Rd0000644000175400017540000000061213556116173015273 0ustar00biocbuildbiocbuild\name{summary} \alias{summary} \alias{medianpolish} \alias{tukeybiweight} \alias{avdiff} \title{Probe Set Summarizing Functions} \description{ These were used with the function \code{express}, which is no longer part of the package. Some are still used by the generateExprVal functions, but you should avoid using them directly. } \seealso{\code{\link[affy]{expresso}}} \keyword{manip} affy/man/tukey.biweight.Rd0000644000175400017540000000122013556116173016534 0ustar00biocbuildbiocbuild\name{tukey.biweight} \alias{tukey.biweight} \title{One-step Tukey's biweight} \description{ One-step Tukey's biweight on a matrix. } \usage{ tukey.biweight(x, c = 5, epsilon = 1e-04) } \arguments{ \item{x}{a matrix.} \item{c}{tuning constant (see details).} \item{epsilon}{fuzzy value to avoid division by zero (see details).} } \details{ The details can be found in the given reference. } \value{ a vector of values (one value per column in the input matrix). } \references{Statistical Algorithms Description Document, 2002, Affymetrix.} \seealso{ \code{\link{pmcorrect.mas}} and \code{\link{generateExprVal.method.mas}} } \keyword{manip} affy/man/whatcdf.Rd0000644000175400017540000000113413556116173015216 0ustar00biocbuildbiocbuild\name{whatcdf} \alias{whatcdf} \title{Find which CDF corresponds} \description{ Find which kind of CDF corresponds to a CEL file. } \usage{ whatcdf(filename, compress = getOption("BioC")$affy$compress.cel) } \arguments{ \item{filename}{a '.CEL' file name.} \item{compress}{logical (file compressed or not).} } \details{ Information concerning the corresponding CDF file seems to be found in CEL files. This allows us to try to link CDF information automatically. } \value{ a \code{character} with the name of the CDF. } \seealso{\code{getInfoInAffyFile}, \code{read.celfile}} \keyword{manip} affy/man/xy2indices.Rd0000644000175400017540000000735213556116173015667 0ustar00biocbuildbiocbuild\name{xy2indices} \alias{xy2indices} \alias{indices2xy} \title{Functions to convert indices to x/y (and reverse)} \description{ Functions to convert indices to x/y (and reverse) } \usage{ xy2indices(x, y, nc = NULL, cel = NULL, abatch = NULL, cdf = NULL, xy.offset = NULL) indices2xy(i, nc = NULL, cel = NULL, abatch = NULL, cdf = NULL, xy.offset = NULL) } \arguments{ \item{x}{A numeric vector of \code{X} (column) position(s) for the probes.} \item{y}{A numeric vector of \code{Y} (row) position(s) for the probes.} \item{i}{A numeric vector of indices in the \code{AffyBatch} for the probes.} \item{nc}{total number of columns on the chip. It is usually better to specify either the cdf or abatch arguments rather than the number of columns.} \item{cel}{a corresponding object of class \code{Cel}. This has been deprecated. Use abatch or cdf instead.} \item{abatch}{a corresponding object of class \code{\link[affy:AffyBatch-class]{AffyBatch}}.} \item{cdf}{character - the name of the corresponding cdf package.} \item{xy.offset}{an eventual offset for the XY coordinates. See Details.} } \details{ The Affymetrix scanner reads data from a GeneChip by row, and exports those data to a CEL file. When we read in the CEL file data to an \code{AffyBatch} object, we store data for each GeneChip as a single column in a matrix of probe-wise intensity values. The CDF files that Affymetrix make available for various GeneChips map individual probes to probesets based on their (x,y) coordinates on the GeneChip. Note that these coordinates are zero-based, and (x,y) is the same as (column, row). In other words, the x coordinate indicates the horizontal location of the probe, and the y coordinate indicates the vertical location of the probe. By convention, (0,0) is the coordinate location for the top left position, and (ncol-1, nrow-1) is the coordinate location of the lower right position. For most users, the mapping of probes to probeset is handled internally by various functions (\code{rma}, \code{espresso}, etc), and in general usage it is never necessary for a user to convert probe index position in an \code{AffyBatch} to the corresponding (x,y) coordinates on the GeneChip. These functions are only useful for those who wish to know more about the internal workings of the Affymetrix GeneChip. The parameter \code{xy.offset} is there for compatibility. For historical reasons, the xy-coordinates for the features on Affymetrix GeneChips were decided to start at 1 (one) rather than 0 (zero). One can set the offset to 1 or to 0. Unless the you \_really\_ know what you are doing, it is advisable to let it at the default value \code{NULL}. This way the package-wide option \code{xy.offset} is always used. } \value{ A vector of indices or a two-columns matrix of Xs and Ys. } \author{L.} \section{Warning}{Even if one really knows what is going on, playing with the parameter \code{xy.offset} could be risky. Changing the package-wide option \code{xy.offset} appears much more sane.} \seealso{\code{\link{indexProbes}}} \examples{ if (require(affydata)) { data(Dilution) pm.i <- indexProbes(Dilution, which="pm", genenames="AFFX-BioC-5_at")[[1]] mm.i <- indexProbes(Dilution, which="mm", genenames="AFFX-BioC-5_at")[[1]] pm.i.xy <- indices2xy(pm.i, abatch = Dilution) mm.i.xy <- indices2xy(mm.i, abatch = Dilution) ## and back to indices i.pm <- xy2indices(pm.i.xy[,1], pm.i.xy[,2], cdf = "hgu95av2cdf") i.mm <- xy2indices(mm.i.xy[,1], mm.i.xy[,2], cdf = "hgu95av2cdf") identical(pm.i, as.integer(i.pm)) identical(mm.i, as.integer(i.mm)) image(Dilution[1], transfo=log2) ## plot the pm in red plotLocation(pm.i.xy, col="red") plotLocation(mm.i.xy, col="blue") } } \keyword{manip} affy/src/0000755000175400017540000000000013556146135013325 5ustar00biocbuildbiocbuildaffy/src/Makevars.in0000644000175400017540000000007613556116173015430 0ustar00biocbuildbiocbuildPKG_CFLAGS = @CFLAGS@ PKG_LIBS = @LIBS@ PKG_CPPFLAGS = @DEFS@ affy/src/Makevars.win0000644000175400017540000000047213556116173015617 0ustar00biocbuildbiocbuildPKG_CPPFLAGS += -DHAVE_ZLIB ZLIB_CFLAGS+=$(shell echo 'zlibbioc::pkgconfig("PKG_CFLAGS")'|\ "${R_HOME}/bin/R" --vanilla --slave) PKG_LIBS+=$(shell echo 'zlibbioc::pkgconfig("PKG_LIBS_shared")' |\ "${R_HOME}/bin/R" --vanilla --slave) %.o: %.c $(CC) $(ZLIB_CFLAGS) $(ALL_CPPFLAGS) $(ALL_CFLAGS) -c $< -o $@ affy/src/chipbackground.c0000644000175400017540000004355013556116173016462 0ustar00biocbuildbiocbuild/*********************************************************************** ** ** file: chipbackground.c ** ** aim: an implementation of the affymetrix background/noise correction ** as documented in Affymetrix Statistical Algorithm whitesheet ** ** This implementation is ** Copyright (C) 2002-2003 Ben Bolstad ** ** written by: B. M. Bolstad ** ** created: Oct 3, 2002 ** ** last Modified: Oct 3, 2002 ** ** History: ** Oct 3, 2002 - Initial version ** Oct 26/27, 2002 - generalize the code so that it can deal with an ** arbitrary sized chip, also optimise algorithm so that ** when we call from R with multiple chips, things like distances ** are only computed once rather than multiple times. ** ** Oct 28, 2002 - added a couple of 'static' statement when declaring ** the functions (you never know...) -- LG ** ** Feb 5, 2003 - add in I(x,y) = max(I(x,y),0.5) but commented out for now. ** Feb 25, 2003 - fix up some compiler warnings by adding some includes ** and remove a declared but unused variable. (gcc -Wall) ** Feb 28, 2003 - Change background to be average of lowest 2% rather than ** 2% quantile following suggestion by Helene Boucher ** ** Mar 10, 2003 - Check indexing, see that it roams on x =1..ncol and y=1..nrow. Note ** that affy cdf files are on x=0.. ncol-1 and y=0..nrow-1 ** Mar 6, 2004 - All mallocs/free are now Calloc/Free ** Jun 7, 2006 - change distance calculations to be computed using floating point ** rather than integer arithmetic. ** ***********************************************************************/ #include #include #include #include #include #include #include "rma_common.h" /************************************************************************ ** ** void get_centroids(int rows, int cols, int grid_dim, int *centroidx, int *centroidy) ** ** compute and return the x,y locations of of the centroids of the regions ** ** int rows ** int cols ** int grid_dim_rows ** int grid_dim_cols ** int *centroidx - place to store computed centroids ** int *centroidy - place to store computed centroids ** **************************************************************************/ void static get_centroids(int rows, int cols, int grid_dim_rows, int grid_dim_cols, double *centroidx, double *centroidy){ int i,j; double *cuts_x = (double *)Calloc(grid_dim_rows,double); double *cuts_y = (double *)Calloc(grid_dim_cols,double); for (i = 0; i < grid_dim_rows; i++) cuts_x[i] = ((double)(i+1)*(double)rows)/(double)grid_dim_rows - (double)rows/(2.0*(double)grid_dim_rows); for (j = 0; j < grid_dim_cols; j++) cuts_y[j] = ((double)(j+1)*(double)cols)/(double)grid_dim_cols - (double)cols/(2.0*(double)grid_dim_cols); for (j = 0; j < grid_dim_cols; j++){ for (i = 0; i < grid_dim_rows; i++){ centroidx[j*grid_dim_rows + i] = cuts_x[(j*grid_dim_rows + i) / grid_dim_rows]+0.5; centroidy[j*grid_dim_rows + i] = cuts_y[(j*grid_dim_rows + i) % grid_dim_rows]+0.5; } } Free(cuts_x); Free(cuts_y); } void R_get_centroids(int *rows, int *cols, int *grid_dim_rows, int *grid_dim_cols, double *centroidx, double *centroidy){ get_centroids(*rows,*cols, *grid_dim_rows,*grid_dim_cols, centroidx,centroidy); } /********************************************************************** ** ** void get_gridpts(int rows, int cols, int grid_dim, int *gridpt_x, int *gridpt_y) ** ** compute the x and y locations of the "grid points". Grid points are ** (x,y) locations in the interior of the chip which mark out the boundaries ** of the grid regions. for a 640 by 640 chip with 16 grid regions the grid points ** would be (160,160), (160,320), (160,480), (320,160), (320,320), ....... ** ** there would be 9 grid points for a 16 grid region chip. ** ** int rows - size of chip in rows ** int cols - size of chip in cols ** int grid_dim - the number of grids (default = 16) ** int *gridpt_x - place to store gridpoints ** int *gridpt_y - place to store gridpoints ** **********************************************************************/ void static get_gridpts(int rows, int cols, int grid_dim, int *gridpt_x, int *gridpt_y){ int i; int grid_dim1d = (int)sqrt(grid_dim); if ((rows == 640) && (cols == 640) && (grid_dim == 16) && (1==0)){ gridpt_x[0] = 160; gridpt_x[1] = 320; gridpt_x[2] = 480; gridpt_y[0] = 160; gridpt_y[1] = 320; gridpt_y[2] = 480; } else { for (i =0; i < grid_dim1d-1; i++){ gridpt_x[i] =((i+1)*cols)/grid_dim1d; gridpt_y[i] =((i+1)*rows)/grid_dim1d; /* printf("%d %d\n", gridpt_x[i],gridpt_y[i]); */ } } } /*********************************************************************** ** ** find_distances(int x, int y, int rows, int cols, int grid_dim,int *distance) ** ** aim: return a vector of distances squared from a cell location to the ** centroids of rectangular regions. ** ** int x - x location of cell ** int y - y location of cell ** int rows - size of chip in rows ** int cols - size of chip in cols ** int grid_dim - the number of grids (default = 16) ** int *centroidx - x locations of centroids (length grid_dim) ** int *centroidy - y locations of centroids (length grid_dim) ** int *distance - vector of grid_dim length to store computed distances ** ** ***********************************************************************/ void static find_distances(int x, int y, int grid_dim,double *centroidx, double *centroidy, double *distance){ int i=0; for (i = 0; i < grid_dim; i++){ distance[i] = (x - centroidx[i])*(x - centroidx[i]) + (y-centroidy[i])*(y-centroidy[i]); } } /********************************************************************************************* ** ** void compute_weights_individual(int x, int y,int rows, int cols,int grid_dim, double *weights, double smooth) ** ** computes the weights for an individual x,y location: to be used in background calculation ** ** int x - x location of cell ** int y - y location of cell ** int grid_dim - the number of grids (default = 16) ** double *weights - where weights will be stored upon return ** double smooth - smooth parameter used in the weights ** **********************************************************************************************/ void static compute_weights_individual(int x, int y, int grid_dim, double *centroidx, double *centroidy, double *weights, double smooth){ int i=0; double *distance = (double *)Calloc(grid_dim,double); find_distances(x, y, grid_dim, centroidx, centroidy, distance); for (i = 0; i < grid_dim; i++){ weights[i] = 1.0/((double)distance[i] + smooth); } Free(distance); } /********************************************************************************************* ** ** void compute_weights_individual(int x, int y,int rows, int cols,int grid_dim, double *weights, double smooth) ** ** computes the weights for an individual x,y location: to be used in background calculation ** ** int *x - x location of cells ** int *y - y location of cells ** int nprobes - number of probes ** int grid_dim - the number of grids ** int *centroidx - x and y locations of centroids of sectors. ** int *centroidy - ** double *weights - where weights will be stored upon return ** **********************************************************************************************/ void static compute_weights(int *x, int *y, int nprobes, int grid_dim, double *centroidx, double *centroidy, double *weights){ double smooth = 100.0; int i=0; for (i=0; i < nprobes; i++){ compute_weights_individual(x[i],y[i], grid_dim, centroidx, centroidy, &weights[i*grid_dim],smooth); } } /*************************************************************************************** ** ** Compute_grids(int *x, int *y, int nprobes, int rows, int cols, int grid_dim,int *whichgrid){ ** ** figure out which grid sector each probe is in ** ** int *x - x location of probe cell ** int *y - y location of probe cell ** int nprobes - number of probes (ie length of x and y) ** int rows - size of chip in rows ** int cols - size of chip in cols ** int grid_dim - the number of grids (default = 16) ** int *whichgrid - a vector of length nprobes into which we store a number indicating ** which grid the x,y location falls. ** ** ***************************************************************************************/ void static Compute_grids(int *x, int *y, int rows, int cols, int nprobes, int grid_dim, int *gridpt_x, int *gridpt_y, int *whichgrid){ int i =0,j=0; int thisgrid = 0,in_range; int high, low; int grid_dim1d = (int)sqrt(grid_dim); if ((rows == 640) && (cols == 640) && (grid_dim == 16) && (1 ==0)){ for (i=0; i < nprobes; i++){ if ((x[i] > 0) && (x[i] <= gridpt_x[0])){ if ((y[i] > 0) && (y[i] <= gridpt_y[0])){ whichgrid[i] = 1; } else if((y[i] > gridpt_y[0]) && (y[i] <= gridpt_y[1])) { whichgrid[i] = 2; } else if ((y[i] > gridpt_y[1]) && (y[i] <= gridpt_y[2])){ whichgrid[i] = 3; } else { whichgrid[i] = 4; } } else if((x[i] > gridpt_x[0]) && (x[i] <= gridpt_x[1])) { if ((y[i] > 0) && (y[i] <= gridpt_y[0])){ whichgrid[i] = 5; } else if((y[i] > gridpt_y[0]) && (y[i] <= gridpt_y[1])) { whichgrid[i] = 6; } else if ((y[i] > gridpt_y[1]) && (y[i] <= gridpt_y[2])){ whichgrid[i] = 7; } else { whichgrid[i] = 8; } } else if ((x[i] > gridpt_x[1]) && (x[i] <= gridpt_x[2])){ if ((y[i] > 0) && (y[i] <= gridpt_y[0])){ whichgrid[i] = 9; } else if((y[i] > gridpt_y[0]) && (y[i] <= gridpt_y[1])) { whichgrid[i] = 10; } else if ((y[i] > gridpt_y[1]) && (y[i] <= gridpt_y[2])){ whichgrid[i] = 11; } else { whichgrid[i] = 12; } } else { if ((y[i] > 0) && (y[i] <= gridpt_y[0])){ whichgrid[i] = 13; } else if((y[i] > gridpt_y[0]) && (y[i] <= gridpt_y[1])) { whichgrid[i] = 14; } else if ((y[i] > gridpt_y[1]) && (y[i] <= gridpt_y[2])){ whichgrid[i] = 15; } else { whichgrid[i] = 16; } } } } else { for (i =0; i < nprobes; i++){ in_range = 0; low = 0; high = gridpt_x[0]; j =0; while (!in_range){ if ((x[i] > low) && (x[i] <= high)){ in_range=1; thisgrid = j*grid_dim1d; } else { low = gridpt_x[j]; if ((j+2)== grid_dim1d){ high = rows; } else { high = gridpt_x[j+1]; } j++; } } in_range = 0; j = 0; low = 0; high = gridpt_y[0]; while (!in_range){ if ((y[i] > low) && (y[i] <= high)){ in_range=1; thisgrid = thisgrid + j +1; } else { low = gridpt_y[j]; if ((j+2)== grid_dim1d){ high = cols; } else { high = gridpt_y[j+1]; } } j++; } whichgrid[i] = thisgrid; } } } /**************************************************************************************************** ** ** void compute_background_quadrant(double *probeintensity, int nprobes, int grid_dim,int *whichgrid,double *bg_q,double *noise_q) ** ** compute the value of the background in each quadrant, also computes the "noise" as defined in the ** Affymetrix Statistical Algorithm Whitepaper. ** ** double *probeintensity - the probeintensities to be corrected ** int nprobes - the ** int grid_dim - number of grids ** int *whichgrid - which grid does the probe fall in ** double *bg_q - should be allocated, on exit contains background values for each quadrant ** double *noise_q - should be allocated, on exit contains noise values for each quadrant ** ***************************************************************************************************/ void static compute_background_quadrant(double *probeintensity, int nprobes, int grid_dim, int *whichgrid, double *bg_q,double *noise_q){ int lower2pc; int i=0,j=0; int *nprobes_in_sec = (int *)Calloc(grid_dim,int); int *cur_n = (int *)Calloc(grid_dim,int); double **data_by_sector =(double **)Calloc(grid_dim,double *); double sumx,sumx2; for (j = 0; j < grid_dim; j++){ nprobes_in_sec[j] = 0; } for (i = 0; i < nprobes; i++){ nprobes_in_sec[whichgrid[i] - 1]++; } for (j =0; j < grid_dim; j++){ data_by_sector[j] = (double *)Calloc(nprobes_in_sec[j],double); } for (j =0; j < grid_dim; j++){ cur_n[j] = 0; } for (i =0; i < nprobes; i++){ /* printf("%d %d \n",whichgrid[i] -1, cur_n[whichgrid[i] -1]); */ data_by_sector[whichgrid[i] -1][cur_n[whichgrid[i] -1]] = probeintensity[i]; cur_n[whichgrid[i] -1]++; } for (j=0; j < grid_dim; j++){ qsort(data_by_sector[j],cur_n[j],sizeof(double),(int(*)(const void*, const void*))sort_double); } /********* This section was commented out to change from quantile to average (Feb 28, 2003) ************ for (j=0; j < grid_dim; j++){ bg_q[j] = data_by_sector[j][(int)(0.02* nprobes_in_sec[j])]; } ******************************************************************************************************/ for (j=0; j < grid_dim; j++){ sumx = 0.0; sumx2 = 0.0; lower2pc = (int)(0.02* nprobes_in_sec[j]); i = 0; while (i < lower2pc){ sumx += data_by_sector[j][i]; i++; } sumx = sumx/lower2pc; i =0; while (i < lower2pc){ sumx2 += (data_by_sector[j][i] - sumx)*(data_by_sector[j][i]-sumx); i++; } /* the 1 line following changes the b_k to average of lowest2pc */ bg_q[j] = sumx; noise_q[j] = sqrt(sumx2/(lower2pc -1)); } for (j =0; j < grid_dim; j++){ Free(data_by_sector[j]); } Free(nprobes_in_sec); Free(cur_n); Free(data_by_sector); } /********************************************************************************************* ** ** void background_correct(int x, int y,int rows, int cols,int grid_dim, double *Centroid_background) ** ** computes background correction for a probe at cell location (x,y) ** ** int x - x location of cell ** int y - y location of cell ** int grid_dim - the number of grids (default = 16) ** double *weights - weighting scheme for cell location at (x,y) ** double *Centroid_background - Background values for each of the centroid regions ** **********************************************************************************************/ double static background_correct(int x, int y,int grid_dim,double *weights, double *Centroid_background){ int i; double sum = 0.0; double sum_weights = 0.0; /* double smooth = 100.0; */ for (i = 0 ; i < grid_dim; i++){ sum += weights[i]*Centroid_background[i]; sum_weights += weights[i]; } return(sum/sum_weights); } double static max(double one, double two){ if (one > two){ return one; } else { return two; } } /******************************************************************************************** ** ** affy_background_adjust(double *probeintensity,int *x, int *y, int nprobes, int rows, int cols,int grid_dim) ** ** carries out Affymetrixs background correction ** ** double *probeintensity - the probe intensities to be corrected ** int *x - x location of probe ** int *y - y location of probe ** int nprobes - number of probes ** int nchips - number of chips ** int rows - number of rows on chip ** int cols - number of cols on chip ** int grid_dim - number of regions in grid. ** ********************************************************************************************/ void static affy_background_adjust(double *probeintensity,int *x, int *y, int nprobes, int nchips, int rows, int cols, int grid_dim){ int i=0,j=0; int *whichgrid = (int *)Calloc(nprobes,int); double *bg_q = (double *)Calloc(grid_dim,double); double *noise_q = (double *)Calloc(grid_dim,double); double *weights = (double *)Calloc(grid_dim*nprobes,double); double *centroidx = (double *)Calloc(grid_dim,double); double *centroidy = (double *)Calloc(grid_dim,double); int *gridpt_x = (int *)Calloc(((int)(sqrt(grid_dim) -1.0)),int); int *gridpt_y = (int *)Calloc(((int)(sqrt(grid_dim) -1.0)),int); get_centroids(rows, cols, (int)sqrt(grid_dim),(int)sqrt(grid_dim), centroidx, centroidy); get_gridpts(rows, cols, grid_dim, gridpt_x, gridpt_y); compute_weights(x, y, nprobes, grid_dim, centroidx, centroidy, weights); Compute_grids(x, y, rows, cols, nprobes, grid_dim, gridpt_x,gridpt_y, whichgrid); for (j=0; j < nchips; j++){ compute_background_quadrant(&probeintensity[j*nprobes], nprobes, grid_dim, whichgrid, bg_q,noise_q); for (i=0; i < nprobes; i++){ /* probeintensity[j*nprobes + i] = max(probeintensity[j*nprobes + i],0.5); */ probeintensity[j*nprobes+ i] = max(probeintensity[j*nprobes + i]-background_correct(x[i], y[i], grid_dim,&weights[grid_dim*i],bg_q),0.5*background_correct(x[i], y[i], grid_dim, &weights[grid_dim*i],noise_q)); } } Free(gridpt_x); Free(gridpt_y); Free(centroidx); Free(centroidy); Free(weights); Free(whichgrid); Free(noise_q); Free(bg_q); } /******************************************************************************************** ** ** affy_background_adjust_R(double *probeintensity,int *x, int *y, int nprobes, int rows, int cols,int grid_dim) ** ** Wrapper function to be called from R: carries out Affymetrixs background correction ** ** double *probeintensity - the probe intensities to be corrected ** int *x - x location of probe ** int *y - y location of probe ** int *nprobes - number of probes ** int *nchips - number of chips ** int *rows - number of rows on chip ** int *cols - number of cols on chip ** int *grid_dim - number of regions in grid. ** ********************************************************************************************/ void affy_background_adjust_R(double *probeintensity,int *x, int *y, int *nprobes, int *nchips, int *rows, int *cols,int *grid_dim){ affy_background_adjust(probeintensity,x, y, *nprobes, *nchips, *rows, *cols, *grid_dim); } affy/src/getall_locations.c0000644000175400017540000000566413556116173017026 0ustar00biocbuildbiocbuild/** * An helping function to speed up the computation of expression values * * Laurent@cbs.dtu.dk (2002) */ #include #include /*****************EXPORT**********************/ SEXP getallLocations(SEXP namesR, SEXP dimR, SEXP atomsR, SEXP ispmR, SEXP nb_affyidR); /* Takes as input a matrix of integers (the slot 'name' of a 'Cdf' object), and return a list of 'locations'. Each locations is a (n,2) array (n being the number of probes related to an affyid).*/ /*********************************************/ SEXP getallLocations(SEXP namesR, SEXP dimR, SEXP atomsR, SEXP selectR, SEXP nb_affyidR) { int nrows, ncols, nb_affyid; int ii, jj; int *names, *atoms, *select; int *nbElements; int iLastElementNA; int x, nAtom; SEXP loc_list; SEXP tmp_dim; nrows = INTEGER_POINTER(dimR)[0]; ncols = INTEGER_POINTER(dimR)[1]; nb_affyid = INTEGER(nb_affyidR)[0]; names = INTEGER_POINTER(namesR); atoms = INTEGER_POINTER(atomsR); select = INTEGER_POINTER(selectR); nbElements = (int *)R_alloc(nb_affyid, sizeof(int)); iLastElementNA = 0; PROTECT(loc_list = NEW_LIST(nb_affyid)); PROTECT(tmp_dim = NEW_INTEGER(2)); for (ii=0; ii nbElements[x-1])) { error("Inconsistency in the Cdf object (slot atom, element [%i,%i])! The atom value %i should be positive and lower than %i for the probeset %i.", ii+1, jj+1, nAtom, nbElements[x-1], x-1); } INTEGER_POINTER(VECTOR_ELT(loc_list, x-1))[nAtom + nbElements[x-1] * 0] = ii+1; INTEGER_POINTER(VECTOR_ELT(loc_list, x-1))[nAtom + nbElements[x-1] * 1] = jj+1; /* iLastElement[x-1]++; */ } } UNPROTECT(2); return loc_list; } affy/src/mas5calls.c0000644000175400017540000001173613556116173015364 0ustar00biocbuildbiocbuild#include #include #include #include #include "R.h" #include "R_ext/Boolean.h" /* taken from simpleaffy2.c in the simpleaffy package Copyright (C) 2004 Crispin Miller This is a numerical approximation to the normal distribution as described in Abramowitz and Stegun: Handbook of Mathematical functions see page 931: 26.2.1, 932:26.2.17 */ double pnorm_approx(double z) { double b1 = 0.31938153; double b2 = -0.356563782; double b3 = 1.781477937; double b4 = -1.821255978; double b5 = 1.330274429; double p = 0.2316419; double c2 = 0.3989423; double a =fabs(z); double t = 1.0/(1.0+a*p); double b = c2*exp((-z)*(z/2.0)); double n = ((((b5*t+b4)*t+b3)*t+b2)*t+b1)*t; n = 1.0-b*n; if (z > 6.0) { return 1.0; }; if (z < -6.0) { return 0.0; }; if ( z < 0.0 ) n = 1.0 - n; return n; } /* Given a double array length nx, rank it, and put the results in 'r' */ void rank(double *x, int nx, double *r) { int i = 0; int rank = 1; int ranksum = 1; int ntie = 1; int prev = 0; r[0] = 1.0; for(i = 1; i < nx; i++) { if(x[i] == x[prev]) { ntie++; rank++; ranksum += rank; } else { if(ntie > 1) { while(prev < i) { r[prev] = (double) ranksum/ (double) ntie; prev++; } } rank++; ranksum = rank; r[i] = rank; prev = i; ntie = 1; } } if(ntie > 1) { while(prev < i) { r[prev] = (double) ranksum/ (double) ntie; prev++; } } } /* a straight translation of relevant bits of the wilcox.test method in the R base library */ double wilcox(double *x, int n, double mu) { int i = 0; int j = 0; double *r = 0; double *absx = 0; int *xidx = 0; double STATISTIC = 0; double NTIES_SUM = 0; int prev = 0; int ntie = 0; double z = 0; double SIGMA = 0; double PVAL = 0; double nx = n; for(i = 0; i < nx; i++) { x[j] = x[i] - mu; if(x[j] != 0) j++; /* eliminate zeros */ } nx = j; r = (double *) R_alloc(nx,sizeof(double)); absx = (double *) R_alloc(nx,sizeof(double)); xidx = (int *) R_alloc(nx,sizeof(int)); for(i = 0 ; i < nx; i++) { absx[i] = fabs(x[i]); xidx[i] = i; } rsort_with_index(absx,xidx,nx); rank(absx,nx,r); for(i = 0; i < nx; i++) { r[i] = (x[xidx[i]] > 0) ? r[i] : -r[i]; } for(i =0; i < nx; i++) { if(r[i] > 0) { STATISTIC += r[i]; } } for(i = 1; i < nx; i++) { if(r[prev] == r[i]) { ntie++; } else { if(ntie > 1) { NTIES_SUM += ntie * ntie * ntie - ntie; } ntie = 0; prev = i; } } NTIES_SUM += ntie * ntie * ntie - ntie; /* added by Crispin Noc 2005 */ z = STATISTIC - (nx * (nx + 1))/4; SIGMA = sqrt((nx * (nx + 1) * (2 * nx + 1)) / 24 - (NTIES_SUM / 48)); PVAL = pnorm_approx(z / SIGMA); PVAL = 1 - PVAL; return(PVAL); } /* compute the detection p-value for a particular probe using the algorithm described in Liu et al. Bioinformatics(2002) 1593-1599 pms is a list of probe perfect matches, mms is a list of mismatches n, the number of probe-pairs. tao and sat are parameters, as desccribed in the Liu et al. paper */ double pma(double *pms, double*mms, int n, double tao,double sat) { int i = 0; int *ignore = 0; int totalSat = 0; int last = 0; double *dv = 0; double p = 0; if(sat >= 0) { ignore = (int *) R_alloc(n, sizeof(int)); /* saturation correction from the paper*/ totalSat = 0; for(i = 0; i < n; i++) { if(mms[i] > sat) { ignore[i] = 1; totalSat++; } else ignore[i] = 0; } last = 0; if((totalSat > 0) & (totalSat < n)) { /* ignore probes with saturated mms unless they're all saturated */ for(i = 0; i < n; i++) { if(!ignore[i]) { pms[last] = pms[i]; mms[last] = mms[i]; last++; } } n = last; } } dv = (double *) R_alloc(n, sizeof(double)); for(i =0; i < n; i++){ dv[i] =(pms[i] - mms[i]) / (pms[i] + mms[i]); } p = wilcox(dv,i,tao); return(p); } /* compute for all probes assumes that pm mm pairs line up in the arrays and that the names do to. Also assumes that probes within a set are contiguous in each array. pm, mm and names are all length n long, and are, effectively, three columns from a matrix returns with 'dpval' containing the detection p values for each probeset. */ void DetectionPValue (double *pm, double *mm, char **names, int *nprobes, double *tao, double *sat, double *dpval, int *nprobesets) { int start = 0; int i = 0; int j = 0; for(i = 1; i < *nprobes; i++) { if(strcmp(names[i],names[start]) != 0) { dpval[j] = pma(&(pm[start]),&(mm[start]),i-start,*tao,*sat); start = i; j++; if(j > *nprobesets) { error("Expecting %d unique probesets, found %d\n",*nprobesets,j); } } } dpval[j] = pma(&(pm[start]),&(mm[start]),i - start,*tao,*sat); } affy/src/rma2.c0000644000175400017540000002776513556116173014352 0ustar00biocbuildbiocbuild/************************************************************************ ** ** file: rma.c ** ** Copyright (C) 2002 - 2007 B. M. Bolstad ** ** created by: B. M. Bolstad ** created on: June 26, 2002 ** ** last modified: January 6, 2003 ** ** last modified: Apr 4, 2003 ** ** License: LGPL V2 or later (same as the rest of the Affy package) ** ** version 1.1 - Initial release to affy package ** ** Version History (LEADING UP TO AND INCLUDING AFFYEXTENSIONS) ** 0.1 - Initial version released on July 14, 2002. Implements median ** polish RMA method with ** 0.2 - background implemented in c with the density estimation still carried ** out by the R function density() ** 0.25 - correct background implementation, version 0.2 is broken. ** background is implemented in rma_background.c ** 0.30 - Have a copy and none copy path. ie we can either work inplace or on ** duplicates. the purpose of this is to reduce memory overhea. For ** someone with an interest only in expression estimates this should not be a problem ** ** Version History (AFTER INCLUSION INTO AFFY PACKAGE) ** 1.1 - Initial inclusion into Affy package, heavy modification to how PM data structure ** dealt with. ** ** OLD COMMENTS ** ** a c language implementation of the RMA method as given in the RMA.R file I ** received from Rafael at an earlier point, but assume already had background ** correction to PM's at somepoint (perhaps in the c code) bg will be written in later. ** Possibly another background method will be inserted in at this stage. <-- COMMENT DEPRECIATED ** ** Note that the normalization code that is used in this algorithm is updated ** from that in the affy version 1.1.1 (there will be slight differences in the ** expression values because of this), there is also slight differences in the ** ordering of the results. <-- THIS COMMENT IS DEPRECIATED. Quantile ** normalization updates will happen in the bioconductor cvs. ** ** Ideally and at some later point a more modular approach that can be called ** in a better manner from R than this will be written. This is a quick and ** dirty approach to get something that will run acceptably.in terms of memory ** and speed. From a software engineering viewpoint expect the code to be poorly ** constructed. <-- SOMEWHAT DEPRECIATED. some work should be done to ** clean things up. The user will generally only be dealing with the R ** interface. ** ** Input to the function should be processed from within R ** ** NEW COMMENTS ** ** This is the main c function for implementing the RMA method ** it provides c interfaces to be called from R. ** ** Specific Modification History ** ** Note that the qnorm code here will not be the development tree ** LG: what do you mean ? ** ** BMB: legacy comment, from when this code was outside affy, in AffyExtensions ** and before that as raw c code that was floating around. ** ** Specific Modification History ** Nov 2, 2002 - modify so that it will work efficently with affy2 ** Nov 3, 2002 - More modifications, remove cruft from old version ** Nov 4, 2002 - testing, check docs etc ** Nov 10,2002 - remove pesky debug printf() ** Dec 5, 2002 - add ability to turn background off ** Dec 31, 2002 - add ability to change to type 2 background ** Jan 2, 2003 - clean up old/incorrect documentation/comments ** ** Dec 26, 2002 - '//' is not a valid way to comment out (and some C compilers complain about it) ** (Laurent) ** Jan 6, 2003 - fix merging. Note "//" is valid according to the language standards (http://anubis.dkuug.dk/jtc1/sc22/open/n2794/n2794.txt) ** Feb 6, 2003 - change some printfs to Rprintfs this will allow the windows users to see some ** verbage when running rma ** Feb 25, 2003 - try to reduce or eliminate compiler warnings (from gcc -Wall) ** Apr 4, 2003 - fix up so that the number of probes in a probeset is allowed to be more dynamic ** Dec 9, 2003 - fix a bug in do_RMA (max_nrows in Calloc) ** Mar 6, 2004 - all mallocs/frees are now Calloc/Frees. Removed ** the function R_median_polish ** Jul 27, 2004 - fix a small memory leak ** Aug 4, 2004 - move the "Background correcting" message. ** Nov 8, 2004 - change how things are structured in do_RMA() ** Sep 3, 2005 - In extremely high memory usage situations ** R was garbage collecting something that shouldn't have ** been. This was leading to a seg fault. Fixed by ** moving an UNPROTECT. ** Nov 9, 2006 - integrate changes suggested/supplied by Paul Gordon (gordonp@ucalgary.ca) ** specifically memcpy, caching log(2.0), and partial sorting for median calculation ** Nov 13, 2006 - moved median code to rma_common.c ** May 24, 2007 - median_polish code is now from preprocessCore package ** Oct 26, 2007 - add verbose flag ** Oct 28, 2007 - remove any vestigial references to MM ** Mar 31, 2008 - use rma background correction from preprocessCore ** Jul 2, 2008 - now use different median polish interface from preprocessCore ** Jan 6, 2009 - fix issue with SET_VECTOR_ELT/VECTOR_ELT applied to STRSXP ** ************************************************************************/ #include "rma_common.h" #include "rma_background4.h" #include #include #include #include #include #include #include #include "preprocessCore_background_stubs.c" #include "preprocessCore_normalization_stubs.c" #include "preprocessCore_summarization_stubs.c" #include "R_subColSummarize.h" #include "R_subColSummarize_stubs.c" SEXP do_RMA2(SEXP PMmat, SEXP PM_rowIndexList){ SEXP Summaries; Summaries = R_subColSummarize_medianpolish_log(PMmat, PM_rowIndexList); return Summaries; } /******************************************************************************************** ** ** void rma_c_call(SEXP PMmat, SEXP ProbeNamesVec,SEXP N_probes,SEXP norm_flag) ** ** SEXP PMmat - matrix of Perfect-match values ** SEXP ProbeNamesVec - vector containing names of probeset for each probe ** SEXP N_probes - number of PM/MM probes on an array ** SEXP norm_flag - non zero for use quantile normalization, 0 for no normalization ** SEXP verbose - TRUE/FALSE or 1/0 for be verbose or not ** ** a function to actually carry out the RMA method taking the R objects and manipulating ** into C data structures. ** ** this function assumes any sort of background correction was carried out previously ** This function carries out the other two steps of the RMA algorithm: ** Normalization and Summarization. ** ** In particular the data is quantile normalized and then it is ** summarized using median polish ** *******************************************************************************************/ SEXP rma_c_call(SEXP PMmat, SEXP PM_rowIndexList, SEXP N_probes, SEXP norm_flag, SEXP verbose){ int rows, cols; double *PM; int i, nprobesets; SEXP dim1; SEXP outvec, outnamesvec; SEXP dimnames,names; PROTECT(dim1 = getAttrib(PMmat,R_DimSymbol)); rows = INTEGER(dim1)[0]; cols = INTEGER(dim1)[1]; UNPROTECT(1); PM = NUMERIC_POINTER(AS_NUMERIC(PMmat)); nprobesets=INTEGER(N_probes)[0]; if (INTEGER(norm_flag)[0]){ if (INTEGER(verbose)[0]){ Rprintf("Normalizing\n"); } qnorm_c(PM,&rows,&cols); } if (INTEGER(verbose)[0]){ Rprintf("Calculating Expression\n"); } PROTECT(outvec = do_RMA2(PMmat, PM_rowIndexList)); /* now lets put names on the matrix */ PROTECT(outnamesvec = getAttrib(PM_rowIndexList,R_NamesSymbol)); PROTECT(dimnames = allocVector(VECSXP,2)); PROTECT(names = allocVector(STRSXP,nprobesets)); for ( i =0; i < nprobesets; i++){ SET_STRING_ELT(names,i,STRING_ELT(outnamesvec,i)); } SET_VECTOR_ELT(dimnames,0,names); setAttrib(outvec, R_DimNamesSymbol, dimnames); UNPROTECT(4); return outvec; } /******************************************************************************************************************* ** ** SEXP rma_c_complete(SEXP PMmat, SEXP MMmat, SEXP ProbeNamesVec,SEXP N_probes,SEXP densfunc, SEXP rho) ** ** SEXP PMmat - PM's ** SEXP MMmat - MM's ** SEXP ProbeNamesVec - names of probeset for each row ** SEXP N_probes - number of probesets ** SEXP densfunc - density function to use in computation of background ** SEXP rho - an R environment ** SEXP norm_flag - TRUE/FALSE or 1/0 for normalize/not ** SEXP bg_flag - TRUE/FALSE or 1/0 for background correct/not ** SEXP bg_type - integer indicating "RMA" background to use. 2 is equivalent to bg.correct.rma in affy 1.1.1 ** all other values default to 1.0.2 "RMA" background ** SEXP verbose - TRUE/FALSE or 1/0 for be verbose or not ** ** Main function to be called from R. Modifies the PM matrix from the parent environment. More dangerous than the ** function below, but less memory intensive. This is a function that implements the complete RMA method. ie ** background correction, quantile normalization, then expression summarization using median polish ** *******************************************************************************************************************/ SEXP rma_c_complete(SEXP PMmat, SEXP ProbeNamesVec,SEXP N_probes,SEXP norm_flag, SEXP bg_flag, SEXP bg_type, SEXP verbose){ SEXP dim1; double *PM; int rows,cols; if (INTEGER(bg_flag)[0]){ if (INTEGER(verbose)[0]){ Rprintf("Background correcting\n"); } PROTECT(dim1 = getAttrib(PMmat,R_DimSymbol)); rows = INTEGER(dim1)[0]; cols = INTEGER(dim1)[1]; PM = NUMERIC_POINTER(PMmat); rma_bg_correct(PM, rows, cols); UNPROTECT(1); } return rma_c_call(PMmat, ProbeNamesVec, N_probes,norm_flag,verbose); } /******************************************************************************************************************** ** ** SEXP rma_c_complete_copy(SEXP PMmat, SEXP MMmat, SEXP ProbeNamesVec,SEXP N_probes,SEXP densfunc, SEXP rho,SEXP norm_flag, SEXP bg_flag) ** ** SEXP PMmat - PM's ** SEXP ProbeNamesVec - names of probeset for each row ** SEXP N_probes - number of probesets ** SEXP densfunc - density function to use in computation of background ** SEXP rho - an r environment to work within when doing density call in background step ** SEXP norm_flag - TRUE/FALSE or 1/0 for normalize/not ** SEXP bg_flag - TRUE/FALSE or 1/0 for background correct/not ** SEXP bg_type - integer indicating "RMA" background to use. 2 is equivalent to bg.correct.rma in affy 1.1.1 ** all other values default to 1.0.2 "RMA" background ** SEXP verbose - TRUE/FALSE or 1/0 for be verbose or not * ** Main function to be called from R. Makes a copy of the PM matrix and then works with that. Safer than the ** other function above, but more memory intensive. This is the function that implements the complete RMA method. ** ie background correction, quantile normalization, then expression summarization using median polish ** ********************************************************************************************************************/ SEXP rma_c_complete_copy(SEXP PMmat, SEXP ProbeNamesVec,SEXP N_probes, SEXP norm_flag, SEXP bg_flag, SEXP bg_type, SEXP verbose){ SEXP dim1,PMcopy,exprs; int rows,cols; double *PM; if (INTEGER(bg_flag)[0]){ if (INTEGER(verbose)[0]){ Rprintf("Background correcting\n"); } PROTECT(dim1 = getAttrib(PMmat,R_DimSymbol)); rows = INTEGER(dim1)[0]; cols = INTEGER(dim1)[1]; PROTECT(PMcopy = allocMatrix(REALSXP,rows,cols)); PM = NUMERIC_POINTER(PMcopy); copyMatrix(PMcopy,PMmat,0); rma_bg_correct(PM, rows, cols); exprs = rma_c_call(PMcopy, ProbeNamesVec, N_probes, norm_flag, verbose); UNPROTECT(2); return exprs; } else { PROTECT(dim1 = getAttrib(PMmat,R_DimSymbol)); rows = INTEGER(dim1)[0]; cols = INTEGER(dim1)[1]; PROTECT(PMcopy = allocMatrix(REALSXP,rows,cols)); copyMatrix(PMcopy,PMmat,0); exprs = rma_c_call(PMcopy, ProbeNamesVec, N_probes, norm_flag, verbose); UNPROTECT(2); return exprs; } } affy/src/rma_common.c0000644000175400017540000000567613556116173015635 0ustar00biocbuildbiocbuild/*********************************************************************** ** ** file: rma_common.c ** ** aim: a location for commonly used utility functions ** ** ** written by: B. M. Bolstad ** ** created: Oct 16, 2002 ** last modified: Oct 16, 2002 ** ** history: ** Oct 16, 2002 - a place to put common utility code, created to help ** the R package build. ** Jan 2, 2003 - Clean up code comments ** Nov 13, 2006 - moved median function into this file from rma2.c ** ***********************************************************************/ #include "rma_common.h" #include #include #include #include #include #include /********************************************************** ** ** int sort_double(const void *a1,const void *a2) ** ** a comparison function used when sorting doubles. ** **********************************************************/ int sort_double(const double *a1,const double *a2){ if (*a1 < *a2) return (-1); if (*a1 > *a2) return (1); return 0; } /************************************************************************** ** ** double median(double *x, int length) ** ** double *x - vector ** int length - length of *x ** ** returns the median of *x ** *************************************************************************/ double median(double *x, int length){ int half; double med; double *buffer = Calloc(length,double); memcpy(buffer,x,length*sizeof(double)); half = (length + 1)/2; /* qsort(buffer,length,sizeof(double), (int(*)(const void*, const void*))sort_double); if (length % 2 == 1){ med = buffer[half - 1]; } else { med = (buffer[half] + buffer[half-1])/2.0; } */ rPsort(buffer, length, half-1); med = buffer[half-1]; if (length % 2 == 0){ rPsort(buffer, length, half); med = (med + buffer[half])/2.0; } Free(buffer); return med; } /************************************************************************** ** ** double median_nocopy(double *x, int length) ** ** double *x - vector ** int length - length of *x ** ** returns the median of *x. note x is not order preserved when this function ** is called. ** *************************************************************************/ double median_nocopy(double *x, int length){ int half; double med; double *buffer = x; //Calloc(length,double); memcpy(buffer,x,length*sizeof(double)); half = (length + 1)/2; /* qsort(buffer,length,sizeof(double), (int(*)(const void*, const void*))sort_double); if (length % 2 == 1){ med = buffer[half - 1]; } else { med = (buffer[half] + buffer[half-1])/2.0; } */ rPsort(buffer, length, half-1); med = buffer[half-1]; if (length % 2 == 0){ rPsort(buffer, length, half); med = (med + buffer[half])/2.0; } return med; } affy/src/rma_common.h0000644000175400017540000000027413556116173015627 0ustar00biocbuildbiocbuild#ifndef RMA_COMMON #define RMA_COMMON 1 int sort_double(const double *a1,const double *a2); double median(double *x, int length); double median_nocopy(double *x, int length); #endif affy/vignettes/0000755000175400017540000000000013556146135014546 5ustar00biocbuildbiocbuildaffy/vignettes/EWSnap.png0000644000175400017540000014130713556116173016416 0ustar00biocbuildbiocbuildPNG  IHDROrD pHYs.#.#x?v 9iCCPPhotoshop ICC profilexڝwTTϽwz0R޻{^Ea`(34!ED"HPĀP$VDT$(1ET,oF֋oZ/K<Qt`)LVF_{ͅ!r_zXp3NY|9,8%K.ϊ,f%f(Aˉ9a >,٩<9SbL!GĈ 3,F0+7T3IlpX"61"H _qW,d ėrIKst.ښAdp&+g]RәY2EE44432PuoJEzg`̉j- -b8o׿M]9La.+-%Mȧg3YះuAxEK i<:ŹPcu*@~(  ]o0 ~y*s7g%9%(3H*@C`-pn VH@ A1 jPA3hA'8΃Kn`Lg` a!2D!H҇ dAP B Byf*z: @]h ~L CUp΅ p%;56< ?" GxG iE>&2 oQEGlQP UFFuzQ7QcYG4G۠t]nB/o'Я1 xb"1I>Lf3bX} *QYvGĩp( &q x)&gsF|7:~@&h!$&B%pH$D.q#xx8F|K!\H$!i.%L";r3EHK-AFCbH$^RSIrdd 3Rx)-))zR#RsiSiT#Wd2Z2n2l2d)EBaQ6S))T UEMSPgeedɆfȞ!4--VJ;N g%K-sɵݖ{'OwO%)P_RRۥEK/+))U<د8䡔TtAiF쨜\|FyZbU)W9.Kw+YUEUOUjꂚZZZCu:C=^\G}VCEO#OE&^WOs^K[+\kV֔vv[]n>z^^u}XROm`m3h01$:fь|:kG23hbabhrT4ߴw3=3Y-s.q_vǂbgբ⃥%߲rJ*֪jAe0JOY6rvvtXLǎl&I']$NϝM.6.\ι"En2nnn[g=,=t٪E2}4\j5loDŽǞ~q=''Z^utv&vvEv >mяN9-{ LOgsΝK?7s>xOL n\x }N}g/]>uɫ,u[dS@u]7ot.<30tKn]p;;SwSyoEV"E)C.m* UDma]4!{vl@2'1PlylpRrz!"Vw½9Wj}v܁ )KسARS%;@@[Y Vk+ fbuY=f?D&o(Ջ:(4ZU^zĘnM-뺸l7Nozy(Awv)v `Gqqt"VbYABl}[.96.! TVur>yo4m|;`OKfWu<`[?HXg4KسARS%ف ))@@@F` ~H,سARS%ف ))@@@F` ~H,سARS%b Q0 F(`Q0 F(`@<5dhj404uy W.#8q4`0Etx4PFQ0 F(`at~p3 };o y `[?Hi$Oف ))@A @ YpSR[sm=U lL`$bn! u30 <:O@e 7,4ޥ6׎.>h9 yֿ~w~Xسca D:v*Hظ(]sW+Ot;<Aea]iǫnqky뫔܁ )KسARS%ݡ Pta +/*4I %_=u^8PO_;`{7:+&K`+{vp)P?\ ;y<"}{w;o ` ~H,4 2_z?bF(`"+\烎Ms{3zcaZdLt@j 1v\>?H†ߡ 'a`P"?1|0z$?HWrW/S=ƲeQQ~vܡX! A{->T >(xCc;o ` ~H,;{a ,?@bH@MA"DŽrTF>(G5*at!MWlAA7hElʸ3 [k *yƭ]Z=ϧ8`nY.>>ǎ~9v?G]]eosP8tVkm+CΌ+o2ڡVʵ|8j4~Mm]>b"GlQjc#1GV>F(fol2sZ0p/EA ]vܗoCS 2|}P̛7ڃ"5bF(`!jPm\>Eh0uMhEwM)2s~ꏺ<#E  Ĥ#RtEct@(]$ϙvI5#ϖ$wh=?9zHWĄ`,kyEiؐ_BE@8G/JLJ#Mz>!5>.E]; F(` gw ~I `[?Hi$O1 PąeY ̫D!`?5L^VMKI;̴e({nrY-2\F4h3+ߣ]Vov1!{C~W\h]/;9kpV3;,X){w0QiˁL |>!L^HKI;&l)Gh;S7uUW56"b!BcA˞{Hh:Xp4qT`[?HXg4KسARS%ݱ 0 ?( Y.@pqo",鮉iC*egyRzKAR7{WUaSQ0 F(`GgO' &$Y[dPWzebJ."eBz1 HJcPTR Q0P(@ wRz` @q;5 F(`Q0|/(h {v `AqRAzpHZdІ/yY \[DnZy\s;~ @X_GzZ<*NHk`pk;o ` ~H,ػ[a0V Yṡ%A&8* ?qj6|S[\!_ҵ6gykŦ }Z'Wzm=} g?|j=@,{wlPtFrhDBEq>O+F-6Jmx0k*3y'Zq7xNܕR^Z^`[?HXg4K;%46%^ҕg!R@34Ӳj n*wy~kCvрbO0c6uSͻ^.zQg_1Z9Q$W2FIHݑ3Ĩ֏< 6=j_1i@/jO伶<`Q0 FMhoyp>ӦI$>pZWrh@8@?H޷?h}8O PMWC5"'Gr)7_=uӽLDw( 4Y[G#StVQ4M}Q0 F(`܁ )KسARS%; EQ;1kC)1~a@YN`T<3r\Լ^9S1RZ{&IzHROF!ey,ݯRa >26%ZUhQ-si|kYAkj8O4sL֞].E 0EQ $R޳A&ؽ S{YPu ]GmrYa*j~Χ66=9-Y]A͛%gs k+a?Z̨Jb=z- @-a`[?HXg4K9ca:kwGI뽭4v~1=~VuSC}U$,2hpQsywJ薨_8fI 9MsWb^QuI0KIVU ma_҃BԚ+q;;i^Lk~T;FA85չ~gWv@@H^%ف ))@v@!)bckn`u载(kP2̺w6@Ec1D!LB4Zf?ӔK}Q+-;w A $m/@@@F` ~H,سARS%ف ))@@@F` ~H,سARS%ف ))@@@F` ~H,سARS%ف ))@@@F` ~H,سARS%ف ))@@@F` ~H,سARS%ف ))@@@F` ~H,سARS%ف ))@@@F` ~H,سARS%ف ))@@@F` ~H,سARS%b Q0 F(7crkWg{!f}]r9upzvOfz]<7iy7D9j!:3ȉwlinl[Ѯ0}Vk~~I `[?Hi$Oݱ 0MF?ݵs5- n x\oMs7 RkyƴBgpx_RkB|LryC|U j@5c -zjm=Us$=`Jr?~9sKyMqo8ܔ3?^w)@th1Uehy$)jz'ڢlݟYu]zzo )u E;8(|~=YٰQ܁ )KسARS%ف ))@@he```cf& `\iُm[WkP(m #|j^jKwUݯϨQgvn="x}:gyw_ZG 0K@@G)@@@F` ~H,ػaEp^PRA*-(!5OxE?{GJl)-Tܚ ?fw8ͺ-;}VT綴;^]'۟ZW5zH#*v A#` ~H,سARS%tQ0 Ff?g2`ٓAGnCPPTaHJt4 F@.e']bb$%i`ޜI APQ0vG%`x{3߷}DHmu\0o`Q0 FU@ @/?ԥ?o\v)*7vїpWc59~ϼISx*;w A $m/@@@F` $Pݬ:K4,n:ah M6 PGəLuӪ˛sC/]YcPoR~1#͓Cuհcp]="C4؅4Ujץ?3P.XNҼp@,O|7'z7x`(`!'HFGאuҐ7 @\Uy$wuVaGsۤ!qO?GR:BE:C%R0y +%n?HM_=8݀$4ZUrpMq-&$ ҉]4Y/b|8l e@r }5Bi]B\״; F(``عAR i{ف ))@f@ֆ번vw7u?45Q50HIsǎuT5~@zgP쑂ѩXɍd#2d?+yo":fAfoɍTxbw Ǚ*e^14wO1#wQ ]c1fp A Ы9D'ZP(dMf0IciﲬBq羟*K,=sY5t ~I `[?Hi$Oف ))@@@F` ~H,سARS%ف ))@vnR\z"xe`[?Hyd,سARS%ف ))@@@F` ~H,سARS%ف ))@@@F` ~H,سARS%ف ))@@@F` ~H,سARS%ف ))@@@F` ~H,سARS%ف ))@@@F` ~H,سARS%ف ))@@@F` ~H,سARS%ف ))@@@F` ~H,سARS%ف ))@@@F` ~H,سARS%ف ))@@@F` ~H,سARS%ف ))@@@F` ~H,سARS%ف ))@@@F` ~H,سARS%ف ))@@@F` ~H,2`R+jPm:<0栮:p~s$mр`vh V.|]CI3V`A~â2\1$ N 6MA طARKسARS%ف ))@`hO ^ѡ=8dimyosB2qqX:9`^̞Ey]aLW؇Ggo<2Oف ))@@@F` 0\-; ?ukH|p1 @y'6 %<Έ/VS;o ` ~H,عa)*'&@c 8#D) b*U}qJ_Ky~UMb˜@z֢)B!_{AW FJ=$x}g'oٵuG1W%0ƬK`|fKir#ƽPdpiex%ˠă z 5ţЖ"D:"T..:s oZOy\"5~(Mh"JG@iFZ;O -ڞxoGjjDײt4T%C0ƫF.11r&d1EJ)y5 r.=ڻ79v qrw`WEŖ_9}j̱{1㠃uk ׯ?W@ av$[[oE) QXL y;kwek&H}88DQK>=ZJZ[+PEd`}`bayMu{?/s4FC2njr'?=uiE a(Z`w4_f c >m0'gY]F}jd.>>}bC,.C;Wȋv`Gy{oy.27`wgR7Y􏨼$ gQ=`7yC3[Sj?j9$ ˬuXns/3j]]9Cý̸8|bnWv@@H^%ف ))@v@(j%Y1!⤋J# )i ,8HQvp0:"մ1%}NisØI|YK륤Mk/}H}HC.QoGx$*Pb{7:X1Kje &O O ہ )S%ف ))@@@F` ޽xGq/!I4 MJ7op@b5sz}3yGvD{{N}A~\Z߱2[w@-2Z.wTfFZ޻X`[?Hyd,سARS%ف ))@y:ϙ<tngؿo;G8v|e4GdAw@bJ.h@aW@WDy09irw4Q@]\N`C}hAoB/[Q; vhZiFk6H)wif@+;ؿwxkih1  4lk F'O)Ih t1)!? *(Mbctwa޸ % ~ !;5")zQ[Gr#5hn4$;1().6na:$HG_=~ ΁*w@cr!SRH!R|" H!O{ F"&Bv۱r9 vhapՃ10 V[41nm@FJK6fXO]t;@z)ZNù;o ` ~H,;A'f,8h%t^;:c&W-V3w9H,ryr+#ň[/9Ttfyxuw2tCTp."rf8[R]]41VgYʮkҽ٫Ub3L ;U~14]{Qtkb/v'WU tq7@ԇouJ%ػc( G ^`7!!`Pn 'bl<]U(y#&3eYC?܁ )KسARS%ܡ AC!0C`~2 @7W _ܫg-"@; (C@w4P3\/Sc#;w A $m/@@@F` ~H,ػc"b0puH$< ~<Xg4KسARS%ف ))@@@F` ~H,سARS%ف ))@@@F` ~H,سARS%ف ))@@@F` ~H,سARS%ف ))@@@F` ~H,سARS%ف ))@@@F` ~H,سARS%ف ))@@@F` ~H,سARS%ف ))@@@F` ~H,سARS%ف ))@@@F` ~H,سARS%ف ))@@@F` ~H,سARS%ف ))@@@F` ~H,سARS%ف ))@@@F` ~H,سARS%ف ))@@@F` ~H,سARS%ف ))@@@F` AQsɓݘDܷה˨x};o y `[?Hi$Oف ))@hEWT ?y @{>gD0İP$+%pC7Om̼1Os%;w A $m/@@@F` ADDxͬAa&t 8kћzʥgٱArB fvKS!܁ )KسARS%1 @"hiI VZ lq[ Hl`N)y;?׫*~;:|w(Q1]0EfLjcmݺah>8(iCTO쿒OǞ^y[@anعAR i{ف ))@@@F` ÿ"LX &H$< FrjSL ~<Xg4KسARS%ف ))@@@F` ~H,سARS%ف ))@@@F` ~H,سARS%ف ))@@@F` ~H,سARS%ف ))@@@F` ~H,سARS%ա@@  2"۴ rN}*\7mY1º.ΒǼ&!+G"( ~5FH) B6Xi@93/MnkK|diؾjMT_C}R՗$w]߬%mdR_чֻ>h܍ϛz%2Q4'{f C᠇0lX(R/| l֮5ש!x6g˼$ӼcdNY}CS}?9kFvm 5[30>qDs }"x"܁ )KسARS%A 0E{ ` ; 3B!4$3,&lKɂ+%^H;~ή[2s}(QŨbL F祵 ))y =;ƌ[D͗Ek$.#>AnU*œGTwޕ1&`} c1]yy n(֧GOę!w=ov?DMDB!@ !  @`` (@0@a` p_ı/u")!$ YWwt$õ^.&zhƃoko.ot腁BIr02;iD}K01)t v6;0BW^D؋ïͪp"ȉJsg3 S pY;ݾ@n}>P#}.vb!B lw8\y ~I `[?Hi$O; i?16HÒ>2s†M ʻ)#ҎH$ݶU=_(u[ҋM y_m 1ZiG|WO͹;~̢=H_oLFv @E䚋(k: >OaCʓ>/: Vo{9er5"rd?:{7fNONعAR i{ف ))@@hgUq4ND,XB2N c{ N΋dǷ]x(dmSZY;ſpuV+XGu:`q(ޕiy yKGa!F%O>OaBaݺʠR4)j>fJ+.0,m.W sz`[?HXg4KسARS%1 uhx%5YB?mQˇK'&ռYԴwz]D4h œ7ζO]* $Ko};쭑@ 'v A#` ~H,سARS%A 0 EZ GH,3B!v4Oed; cK/{xu6QPli}'f{Q9Kj!#m5lo<2Oف ))@@@F` ;OG(` <¦f(tQhvü9}ؒ?Tܿ{ĥ+E pسc`P$@1"H$)qe4s@,سARS%ف ))@@@F` ~H,سARS%ف ))@@@F` ~H,سARS%ف ))@@@F` ~H,سARS%ف ))@vy~j%l̐HwIFسc@=^fO<<Xs@,سARS%ܱ EQWI aYAsx@%ф97B|0Ӏ#us6*O <xw+ODعAR i{ف ))@v@`H0Q%DRSf庭:o{>(99M1۪AG{kko=p  @"bp4M `B_ેwl(^ˬբw`ώmaNd4L`$;ɅgxN ;o ` ~H,ػ@(xУf"f{>L7!a5Q3G 3%\z)^ib\+;w A $m/@@@F` A|"d$DN@3%lwf{>jCIzk_>33uO*bLB4NChQ¹a2`[?Hyd,سARS%ف ))@qeBM0A" )\0zW˜BgJطARKسARS%ف ))@@@F` ~H,سARS%ف ))@@@F` ~H,سARS%ف ))@@@F` ~H,سARS%ف ))@@@F` ~H,سARS%ف ))@@@F` `Q0 F(:D5dhjDS7]r*Elݦã5xĉ3 F(@A~(I :T5-F(`Q0 F(ہ )S%ف ))@@@F` 0 n_VME[YR*ρtqYo<2Oف ))@@@F` EQOH *kx:P/t}y ˹Yv)B,S?~Hꦽ4˅<`ώm 4_HL!1K~/y)\fα1ں">s8˖܁ )KسARS%10 EY1d0APwVEbQކP3ٔW8How~Ҽ4׷gyTXz/K9e}=}ךp84g4<{>!b>И6_Y"W%WZ#tr-X<#&_ٿkZ)ޯWX` na(@zp%j\D0b)`|n5@ok3F5WsPO/-:Sc7=xTf`Lݱ Eق]SK-3 ڽO߈vWgp=3?rGr=X3ͺ>{ӳ]dvowZ`[?Hyd,سARS%ف ))@@1CJIfJE>.UTLr4` <5l\Ɣ?ᑉԴ-?; q*&&ItE<1ŸEQ@~BH+I>ի{P:]'PL2q>>'@itt55= F(`ЪDVg`httQ0 F(}4^[GmFWqv2Q'6Hl: E,#W.G)Ix2hr=pHB14nP<<] S47 1`ݦãPZL dLvQ$O ]hpMR"T&})'uL`Q@z6 F( `[?HXg4K;AR3-&+Pb\0V ^$YQ#5O)G{w7WQ =ޙ5{\6ƄuͿHݾGkcN4ZW~Ԇp-<qݦ)8|x/Û/|MM] `Q0 F(`Q@=k& 2҈I'1bPVQgPVVKꝎ`Q0 F(2 ?e-N\ "2t;0߽e8}(^5y)(|IY`ZĩG`< F(c~I `[?Hi$Oف ))@@@F` ~H,سARS%ف ))@vbGq r_.zFطARKسARS%ف ))@@@F` ~H,سARS%ف ))@@@F` ~H,سARS%ف ))@@@F` ~H,سARS%ف ))@vy~j%l̐HwIFسc@=^fO<<Xs@,سARS%ܱ A?4[̞6$˜CG{!g40Q@5* ͝_<(`DokO!>'E( ~I `[?Hi$Oف ))@`N2 bP@kRE%w`C _f}[N8+v A#` ~H,سARS%1 0`ht"Q@r' )qyYB};o y `[?Hi$Oف ))@! &b(o},{Jسc"b^(5HSB܁ )KسARS%1 @ nM`ބi6kس`bŅ+.k"p-`~SMnFعAR i{ف ))@ k.R^S=;a 8]{0 ($Sv8͊{3_Kv@@H^%ف ))@v(ߪ5(dnD !a}Dݽ>s`ώm k~J?5HFx3O>pJ3R]عAR i{ف ))@@@F` DAƐP 8>8a 3k`XG5ޱ)ړFCqSlK@@G)@@@F` ~H,ػca@t,u"k! n]N^w_|T )Ęivͳs/ike*s ~<Xg4KسARS% A&~ ep h‹< Z s9#{vL1y 7A< #Cv֨YBgZعAR i{ف ))@@@F` ~H,سARS%ف ))@@@F` ~H,سARS%ف ))@@@F` ~H,سARS%ف ))@@@F` ~H,سARS%ف ))@@@F` >Q4xABa A ء$b&bK6H譮}?1%a<1+O@@G)@@@F` ~H,ػ((Qc9P.`-װEGQ,׫MYmd]G=U? Lc eJWP 䂁yG$,~lgmǽ)2MPp&{v C0 ?b;fhr{IOT>v?[^}Ϝ(jhs?R~ 8܁ )KسARS%ݱ 0 `%DL) J΅] ?puݜzFvJӛ `n5̣ e  AvZ8!Lԁjj܉g8>iM;4yt.O_?cϲ܁ )KسARS%@0 qBNyEEW[_ݭ}oPks|ut|LyUތ/bXǥym)r1y~^ۘuݼVѨmm;CcŜfg퇎3:ed?:[Sv\]{|NJU_ݘ3YuGwwgmxIF~5sb?g1#gyVK`<(`Q0 MP:MUyx4MBLUt@tc0؁-m:L@c"ߑ GsZ-~*@OI$Gma E'R= ˕q/*~0d 5NÆ 'Id04"d|4]Q0 F(`P.$Ci_mQ0  ~I `[?Hi$Oف ))@`][I8f^S ֏vT/]Ϫƍd[}#?6 `#v A#` ~H,سARS%ݱ 0P\A\ (4f I&V6=+>}P}[Liw9\0缾>X PK@@G)@@@F` ~H,ػc`(㝱tpLAB.Ӊ^M+!`(%oh.y U-JS>e24Is~x4#NR ׮6t:E lsAT P= =D\-n$8T-@,xǤܡc;[*[}ڷ<=RrYül%;w A $m/@@@F` QݢaHئŐ- D+I{]߱o;:fS #SqoQ.zm_]:`m+X08j U뮿POjQusOr ! nq ~I `[?Hi$OA гծu07QYQ;QtfsơG5co wrE^*/-,︻OhnSzz/z]ﷶ=wsd_2 Q0 F(` luyh_:DLRnGS'>^9P[GԸ{~AOZ|Iftx4s H kPw4]Q0 F(`жS=; 6ݎ#;woN>WMa^ _DRV8q{Q0 ~p3zs@,سARS%ف ))@vNia~MZ ] svt[W@@G)@@@F` ~H,ػc"`B)bc] 7߿S%Oh9q`[?Hyd,سARS%ف ))@@@F` ~H,سARS%ف ))@@@F` ~H,سARS%ف ))@@@F` ~H,سARS%ف ))@v؇MC Ÿn ^}Z|h`ώi`FO%BޘP^عAR i{ف ))@@@F` D zHHァ='v A#` ~H,سARS%ݡ 0e tŠXPפ]K~W)Z-3pW@@G)@@@F` ~H,ػc@,БP6A; o=O }SX!`ώmAus}B֘įB;o ` ~H,عcOO$3ݶ'GG<=;&a ._<( ~I `[?Hi$O1 @ nM`ބi6kس`bŅ+.k"p-`~SMnFعAR i{ف ))@vX)f u_ n{yiFسc@ ؁'V"؁`0\ <x j>9 ;o ` ~H,ػc@`zq-kH4Pu"s+>ve=;(C*T <+BZ̔K>v`[?HXg4KسARS%ݡ @D h U`3냳2y A~ZKb=i.a47F`[?Hyd,سARS%ف ))@@hK@8ۉlJpNw)@RCN?Mb6E>ۺ`q >@! qwr&k<@SU?Eӟ{_GKCWc<s@,سARS% A&~ ep h‹ Z s9#{wL@п0@IJ6E )y)p] ~I `[?Hi$Oف ))@@@F` ~H,سARS%ف ))@@@F` ~H,سARS%ف ))@@@F` ~H,سARS%ف ))@@@F` ~H,سARS%ف ))@v@ (˸ kQ)YcC$yWwP0c\=9b.H+=;j`1N*!yu82Fcʎ򙽿7:+^2`[?HXg4Kعca(%K2),EV ^{+Z ^1L\R^{;.ػc"`RH Z+/y u}?^=4_s@,سARS%ܡ -C@6;IEMOTG$ɸf+`MBXKv!]OS^|!PevWls@,سARS%ݡ0jdn`7R,A@K L\VHKW* 48ZZvl?1wm3em[k#X=1|8ܟ+bڏG#+c<|6nƸwN,httQ0 F(ʠ*6qФ 6ƫg W.##Pwݿw;AB]CIxP#R &IC;vR1Դn?IW旑\&#P#Sj@ezL`Q0 F(`Z܁ )KسARS%; EQjWBd0?%1(#qm/yo :'}5ks=ݢ?c5/-k.2wL)%/iiVhcxg5hIkm%uZgZ΁.w{=}n^6ػa ÓqUKSv@@H^%ف ))@; F(`Q@c0o$w߁7pDБIAνޝԸT;G(=ۻa8]|O hGW/(`Q0SmĔ\+i)3`! w(0@`O-xϪAyo(d,O.V{Y{1z]Jd{ʹ&Y|eqڒ-]m>O^(|)]܁ )KسARS%!0  AmI ܇4Q &eIEMb{&{B/ZRw$y"b߿x)o/&[@(S4, F`  00VCQxϝ侨x PؾAJ437q7 ~Ō児 NfZ.ѵf\9xwbO4޹EkVrOJw>E/;'og0:x^8]NQ0 F(`DD@6Nܿw;m:< 0~XB4qJi L"9 RPr|>(|Iiy(5`Q0 F(~C|7F(;o ` ~H,ػA ]hQÕ0d>N<jkYOr#fU̻>/9W1jŘ5NՊ؟Dv}U3{wED?MSp^7_ @< F(`Q0 vLxdhQ0ʇ{3H#E8y8À:h@A@\>o`Q0LAP-çoqgbߦqd4`x-G)KAH 'Nw<Q0 F} ׯ?W@v@@H^%ف ))@@@F` RA4W* *PGPؐx5*};o y `[?Hi$Oف ))@` KDpS&u:{ ^wk~%ϘI)to}g4 ôpps !3OH8Q="o܁ )KسARS%ف ))@@@F` ~H,سARS%ف ))@@@F` ~H,سARS%ف ))@@@F` ~H,سARS%A   ?",%!0 lWIDJ61O 9ƽ܁ )KسARS%ف ))@ JX fCB ͝7m)G<طARKسARS%ف ))@@ ^aYЫl_w"l{3S>]9"Ҷ.xx~[T3ٱ @!^t?<+dT8O.sZٍ)Vb3`[?HXg4Kعc@,БP6A; /m{ }SX!`ώmAus}B֘įB;o ` ~H,عcOO$3ݶ'GG<=;&a ._<( ~I `[?Hi$Oܱ "*f(v @v# SuE١0I*4ξ})'n(0`[?HXg4KسARS%ف ))@@@F` ~H,سARS%ف ))@@@F` ~H,سARS%ف ))@@@F` ~H,سARS%ف ))@@@F` ~H,سARS%ف ))@@@F` ~H,سARS%ف ))@@@F` ~H,سARS%ف ))@@@F` ~H,سARS%ف ))@@@F` ~H,سARS%ف ))@@@F` ~H,سARS%ف ))@@@F` ~H,سARS%ف ))@@@F` ~H,سARS%ف ))@@@F` ~H,سARS%ف ))@@@F` ~H,سARS%ف ))@@@F` ~H,سARS%ف ))@@@F` NCQMBې'hqF9|%xociRk(W9Ͽ  i?N>g&@ tUGN Uy p 'rTWpc ~I `[?Hi$O+ P2#Z,0g{7ݾn{GV0~?se 1mjQ^سc``SH%t nA:y )0ҭ3cFj܁ )KسARS%ݱ 0 @AKG %^{?l/<3fՓ c֏]1`m +`p50$6+H$x=w'Ϟ[){ԣ>9O).'Z;c]W7a>t ~I `[?Hi$O! @Qa$$jz XBi8Cf l'ns(g4@E_H&8txO_y Wζ." 8=S`:Q?z`[?HXg4KسARS%ف ))@@@F` ~H,سARS%ف ))@@@F` ~H,سARS%ف ))@@@F` ~H,سARS%ف ))@@@F` ~H,سARS%ԡ DQDg ]TuRĐ@U{wHyG oxt>qQ~pCS`CH ]2<v7SxЎّ%>x Zs@,سARS%ݫ0 @jB@?bbR,8 YBTuZ2\'<, 91beU?./_3mcy7Zz+d{7:+X؈.`Z ,l:"~ =.$y tm} ϋRI4FUݸ^_εu>>gibnZ s@,سARS%ݫ @)4_r>o{Z-pѽg^x}eF  BQ>f  X[F~'x5;^ݝss> Zv<FmJb`g܁ )KسARS%ف ))@@d`a#: b+66`C94$&+J&Nfޏ(`Q0 F( $2|15'N;URsI2SgQ0x0'8S`ٱQv=L ۉ^&* LF#՟W._@+9V 3HGt͛=ÉhQ0 F(`r͍`^R( 7hc. rWR( z}:\$8^?[T6 ~I `[?Hi$Oݱ 0 ECSJAݸ䷌M T㲟-lޙ}E˻q=Ril=F/ػca)а(JCН 3si~rm*߷Y?c>s@,سARS%ݽ 0"(XbR6B 1Z?)uU cw=%T$A]ƺ*8y4sZw՝lg'ѶY paq(X(di<ӺiwEH%mĘwaOο: 4ᩍ.s@,سARS%ܱ EQ +zX9!0WjxzQRuy`m vD@ #{gO|)$?㧛_I;`?Cv@@H^%ف ))@X  Lbc?&0 i:ᜭSmS=;6^K8Kri  BV}Qc4uw6AA>5$* jQD^]u]rW|J,$Ο2'8~~:.5M]]o(w &;w A $m/@@@F` ~H,ػca NW Wp}J.K<k8M4'|ǒ⩿wo߽'zw*֜=Kl3OzGi9z7Oہ )S%ف ))@@@F` 0\]+)+SjOKi`D#?pC8y [yW;ي~:^6UF>r螞a4)/^"I3?D~e>l">/lJ-~g(0@u.κxKzB7EСAL!S~;=y:۶J9N]7U?I {y3yu%G~}!#K+7'vعAR i{ف ))@? XO8EЙ`^;lcVip:w gkH0ԙ``[?HXg4Kػca^_}#;w A $m/@@@F` ~H,سARS%ف ))@@@F` ~H,سARS%ف ))@@@F` ~H,سARS%ف ))@@@F` ~H,سARS%ف ))@@@F` ~H,ءC#@ ba05;ARj7OaسC&>s@,سARS%ܻ 0 ,b*Z{Tq@5^c0>a|:8g[Eඬ܏-\$BQ?\g6@ov)7)# !& Dk`px'}s7/v?(Z#.P0ȾUXcZ.吼);w A $m/@@@F` ~H,سARS%ف ))@@@F` ~H,DIENDB`affy/vignettes/affy.Rnw0000644000175400017540000010542013556116173016164 0ustar00biocbuildbiocbuild% -*- mode: noweb; noweb-default-code-mode: R-mode; -*- %\VignetteIndexEntry{1. Primer} %\VignetteKeywords{Preprocessing, Affymetrix} %\VignetteDepends{affy} %\VignettePackage{affy} %documentclass[12pt, a4paper]{article} \documentclass[12pt]{article} \usepackage{amsmath} \usepackage{hyperref} \usepackage[authoryear,round]{natbib} \textwidth=6.2in \textheight=8.5in %\parskip=.3cm \oddsidemargin=.1in \evensidemargin=.1in \headheight=-.3in \newcommand{\scscst}{\scriptscriptstyle} \newcommand{\scst}{\scriptstyle} \newcommand{\Rfunction}[1]{{\texttt{#1}}} \newcommand{\Robject}[1]{{\texttt{#1}}} \newcommand{\Rpackage}[1]{{\textit{#1}}} \author{Laurent Gautier, Rafael Irizarry, Leslie Cope, and Ben Bolstad} \begin{document} \title{Description of affy} \maketitle \tableofcontents \section{Introduction} The \Rpackage{affy} package is part of the BioConductor\footnote{\url{http://bioconductor.org/}} project. It is meant to be an extensible, interactive environment for data analysis and exploration of Affymetrix oligonucleotide array probe level data. The software utilities provided with the Affymetrix software suite summarizes the probe set intensities to form one {\it expression measure} for each gene. The expression measure is the data available for analysis. However, as pointed out by \cite{li:wong:2001a}, much can be learned from studying the individual probe intensities, or as we call them, the {\it probe level data}. This is why we developed this package. The package includes plotting functions for the probe level data useful for quality control, RNA degradation assessments, different probe level normalization and background correction procedures, and flexible functions that permit the user to convert probe level data to expression measures. The package includes utilities for computing expression measures similar to MAS 4.0's AvDiff \citep{affy4}, MAS 5.0's signal \citep{affy5}, DChip's MBEI \citep{li:wong:2001a}, and RMA \citep{iriz:etal:2003}. We assume that the reader is already familiar with oligonucleotide arrays and with the design of the Affymetrix GeneChip arrays. If you are not, we recommend the Appendix of the Affymetrix MAS manual \cite{affy4,affy5}. The following terms are used throughout this document: \begin{description} \item[probe] oligonucleotides of 25 base pair length used to probe RNA targets. \item[perfect match] probes intended to match perfectly the target sequence. \item[$PM$] intensity value read from the perfect matches. \item[mismatch] the probes having one base mismatch with the target sequence intended to account for non-specific binding. \item[$MM$] intensity value read from the mis-matches. \item[probe pair] a unit composed of a perfect match and its mismatch. \item[affyID] an identification for a probe set (which can be a gene or a fraction of a gene) represented on the array. \item[probe pair set] $PM$s and $MM$s related to a common {\it affyID}. \item[{\it CEL} files] contain measured intensities and locations for an array that has been hybridized. \item[{\it CDF} file] contain the information relating probe pair sets to locations on the array. \end{description} Section \ref{whatsnew} describes the main differences between version 1.5 and this version (1.6). Section \ref{sec:get.started} describes a quick way of getting started and getting expression measures. Section \ref{qc} describes some quality control tools. Section \ref{s1.4} describes normalization routines. Section \ref{classes} describes the different classes in the package. \ref{sec:probesloc} describes our strategy to map probe locations to probe set membership. Section \ref{configure.options} describes how to change the package's default options. Section \ref{whatwasnew} describes earlier changes. %%%make sure to change this when we get a publication about version 2. {\bf Note:} If you use this package please cite \cite{gaut:cope:bols:iriz:2003} and/or \cite{iriz:gaut:cope:2003}. \section{Changes for affy in BioC 1.8 release} \label{whatsnew} There were relatively few changes. \begin{itemize} \item MAplot now accepts the argument \Rfunction{plot.method} which can be used to call smoothScatter. \item \Rfunction{normalize.quantiles.robust} has had minor changes. \item \Rfunction{ReadAffy} can optionally return the SD values stored in the cel file. \item The C parsing code has been moved to the \Rpackage{affyio} package, which is now a dependency of the affy package. This change should be transparent to users as \Rpackage{affyio} will be automatically loaded when affy is loaded. \item Added a cdfname argument to \Rfunction{justRMA} and \Rfunction{ReadAffy} to allow for the use of alternative cdf packages. \end{itemize} \section{Getting Started: From probe level data to expression values} \label{sec:get.started} The first thing you need to do is {\bf load the package}. \begin{Sinput} R> library(affy) ##load the affy package \end{Sinput} <>= library(affy) @ This release of the \Rpackage{affy} package will automatically download the appropriate cdf environment when you require it. However, if you wish you may download and install the cdf environment you need from \url{http://bioconductor.org/help/bioc-views/release/data/annotation/} manually. If there is no cdf environment currently built for your particular chip and you have access to the CDF file then you may use the \Rpackage{makecdfenv} package to create one yourself. To make the cdf packaes, Microsoft Windows users will need to use the tools described in \url{http://www.murdoch-sutherland.com/Rtools/}. \subsection{Quick start} If all you want is to go from probe level data ({\it Cel} files) to expression measures here are some quick ways. If you want is RMA, the quickest way of reading in data and getting expression measures is the following: \begin{enumerate} \item Create a directory, move all the relevant {\it CEL} files to that directory \item If using linux/unix, start R in that directory. \item If using the Rgui for Microsoft Windows make sure your working directory contains the {\it Cel} files (use ``File -> Change Dir'' menu item). \item Load the library. \begin{Sinput} R> library(affy) ##load the affy package \end{Sinput} \item Read in the data and create an expression, using RMA for example. \begin{Sinput} R> Data <- ReadAffy() ##read data in working directory R> eset <- rma(Data) \end{Sinput} \end{enumerate} Depending on the size of your dataset and on the memory available to your system, you might experience errors like `Cannot allocate vector \ldots'. An obvious option is to increase the memory available to your R process (by adding memory and/or closing external applications\footnote{UNIX-like systems users might also want to check {\it ulimit} and/or compile {\bf R} and the package for 64 bits when possible.}. An another option is to use the function \Rfunction{justRMA}. \begin{Sinput} R> eset <- justRMA() \end{Sinput} This reads the data and performs the `RMA' way to preprocess them at the {\it C} level. One does not need to call \verb+ReadAffy+, probe level data is never stored in an AffyBatch. \verb+rma+ continues to be the recommended function for computing RMA. The \Rfunction{rma} function was written in C for speed and efficiency. It uses the expression measure described in \cite{iriz:etal:2003}. For other popular methods use \Rfunction{expresso} instead of \Rfunction{rma} (see Section \ref{expresso}). For example for our version of MAS 5.0 signal uses expresso (see code). To get mas 5.0 you can use \begin{Sinput} R> eset <- mas5(Data) \end{Sinput} which will also normalize the expression values. The normalization can be turned off through the \verb+normalize+ argument. In all the above examples, the variable \Robject{eset} is an object of class \Robject{ExpressionSet} described in the Biobase vignette. Many of the packages in BioConductor work on objects of this class. See the \Rpackage{genefilter} and \Rpackage{geneplotter} packages for some examples. If you want to use some other analysis package, you can write out the expression values to file using the following command: \begin{Sinput} R> write.exprs(eset, file="mydata.txt") \end{Sinput} \subsection{Reading CEL file information} The function \Rfunction{ReadAffy} is quite flexible. It lets you specify the filenames, phenotype, and MIAME information. You can enter them by reading files (see the help file) or widgets (you need to have the tkWidgets package installed and working). \begin{Sinput} R> Data <- ReadAffy(widget=TRUE) ##read data in working directory \end{Sinput} This function call will pop-up a file browser widget, see Figure \ref{fig:widget.filechooser}, that provides an easy way of choosing cel files. \newpage \begin{figure}[htbp] \begin{center} \includegraphics{widgetfilechooser} \caption{\label{fig:widget.filechooser}Graphical display for selecting {\it CEL} files. This widget is part of the {\it tkWidgets} package. (function written by Jianhua (John) Zhang). } \end{center} \end{figure} Next, a widget (not shown) permits the user to enter the \verb+phenoData+. %%See Figure \ref{fig:widget.pd}. %% \begin{figure}[htbp] %% \begin{center} %% \begin{tabular}{c} %% \includegraphics{numcovariates}\\ %% \includegraphics{namecovariates}\\ %% \includegraphics{assigncovariates} %% \end{tabular} %% \caption{\label{fig:widget.pd}Graphical display for entering phenoData %% This widget is part %% of the {\it tkWidgets} package.} %% % (functions written by Majnu John.} %% \end{center} %% \end{figure} Finally the a widget is presented for the user to enter MIAME information. %%Seen in Figure \ref{fig:widget.tkMIAME}. %% \begin{figure}[htbp] %% \begin{center} %% \includegraphics[width=0.5\textwidth]{widgettkMIAME} %% \caption{\label{fig:widget.tkMIAME}Graphical display for entering {\it %% MIAME} informations. This widget is part of the {\it tkWidgets} %% package.} %% % (function written by Majnu John).} %% \end{center} %% \end{figure} Notice that it is not necessary to use widgets to enter this information. Please read the help file for more information on how to read it from flat files or to enter it programmatically. The function \Rfunction{ReadAffy} is a wrapper for the functions \Rfunction{read.affybatch}, \Rfunction{tkSampleNames}, \Rfunction{read.AnnotatedDataFrame}, and \Rfunction{read.MIAME}. The function \Rfunction{read.affybatch} has some nice feature that make it quite flexible. For example, the \verb+compression+ argument permit the user to read compressed {\it CEL} files. The argument {\it compress} set to {\it TRUE} will inform the readers that your files are compressed and let you read them while they remain compressed. The compression formats {\it zip} and {\it gzip} are known to be recognized. A comprehensive description of all these options is found in the help file: \begin{Sinput} R> ?read.affybatch R> ?read.AnnotatedDataFrame R> ?read.MIAME \end{Sinput} \subsection{Expression measures} The most common operation is certainly to convert probe level data to expression values. Typically this is achieved through the following sequence: \begin{enumerate} \item reading in probe level data. \item background correction. \item normalization. \item probe specific background correction, e.g. subtracting $MM$. \item summarizing the probe set values into one expression measure and, in some cases, a standard error for this summary. \end{enumerate} We detail what we believe is a good way to proceed below. As mentioned the function \Rfunction{expresso} provides many options. For example, \begin{Sinput} R> eset <- expresso(Dilution, normalize.method="qspline", bgcorrect.method="rma",pmcorrect.method="pmonly", summary.method="liwong") \end{Sinput} This will store expression values, in the object \Robject{eset}, as an object of class \Robject{ExpressionSet} (see the \Rpackage{Biobase} package). You can either use R and the BioConductor packages to analyze your expression data or if you rather use another package you can write it out to a tab delimited file like this \begin{Sinput} R> write.exprs(eset, file="mydata.txt") \end{Sinput} In the \verb+mydata.txt+ file, row will represent genes and columns will represent samples/arrays. The first row will be a header describing the columns. The first column will have the {\it affyID}s. The \Rfunction{write.exprs} function is quite flexible on what it writes (see the help file). \subsubsection{expresso} \label{expresso} The function \Rfunction{expresso} performs the steps background correction, normalization, probe specific correction, and summary value computation. We now show this using an \Robject{AffyBatch} included in the package for examples. The command \verb+data(Dilution)+ is used to load these data. Important parameters for the expresso function are: \begin{description} \item[bgcorrect.method]. The background correction method to use. The available methods are <<>>= bgcorrect.methods() @ \item[normalize.method]. The normalization method to use. The available methods can be queried by using \verb+normalize.methods+. <<>>= library(affydata) data(Dilution) ##data included in the package for examples normalize.methods(Dilution) @ \item[pmcorrect.method] The method for probe specific correction. The available methods are <<>>= pmcorrect.methods() @ \item[summary.method]. The summary method to use. The available methods are <<>>= express.summary.stat.methods() @ Here we use \Rfunction{mas} to refer to the methods described in the Affymetrix manual version 5.0. \item[widget] Making the \verb+widget+ argument \verb+TRUE+, will let you select missing parameters (like the normalization method, the background correction method or the summary method). Figure \ref{fig:expressochooser} shows the widget for the selection of preprocessing methods for each of the steps. \begin{Sinput} R> expresso(Dilution, widget=TRUE) \end{Sinput} \begin{figure}[htbp] \begin{center} \includegraphics[width=0.5\textwidth]{EWSnap} \caption{\label{fig:expressochooser}Graphical display for selecting expresso methods.} \end{center} \end{figure} \end{description} There is a separate vignette {\bf affy: Built-in Processing Methods} which explains in more detail what each of the preprocessing options does. \subsubsection{MAS 5.0} To obtain expression values that correspond to those from MAS 5.0, use \Rfunction{mas5}, which wraps \Rfunction{expresso} and \Rfunction{affy.scalevalue.exprSet}. <<>>= eset <- mas5(Dilution) @ To obtain MAS 5.0 presence calls you can use the \verb+mas5calls+ method. <<>>= Calls <- mas5calls(Dilution) @ This returns an \verb+ExpressionSet+ object containing P/M/A calls and their associated Wilcoxon p-values. \subsubsection{Li and Wong's MBEI (dchip)} To obtain our version of Li and Wong's MBEI one can use \begin{Sinput} R> eset <- expresso(Dilution, normalize.method="invariantset", bg.correct=FALSE, pmcorrect.method="pmonly",summary.method="liwong") \end{Sinput} This gives the current $PM$-only default. The reduced model (previous default) can be obtained using \verb+pmcorrect.method="subtractmm"+. \subsubsection{C implementation of RMA} One of the quickest ways to compute expression using the \Rpackage{affy} package is to use the \Rfunction{rma} function. We have found that this method allows a user to compute the RMA expression measure in a matter of minutes for datasets that may have taken hours in previous versions of \Rpackage{affy}. The function serves as an interface to a hard coded C implementation of the RMA method \citep{iriz:etal:2003}. Generally, the following would be sufficient to compute RMA expression measures: <<>>= eset <- rma(Dilution) @ Currently the \Rfunction{rma} function implements RMA in the following manner \begin{enumerate} \item Probe specific correction of the PM probes using a model based on observed intensity being the sum of signal and noise \item Normalization of corrected PM probes using quantile normalization \citep{bols:etal:2003} \item Calculation of Expression measure using median polish. \end{enumerate} The \Rfunction{rma} function is likely to be improved and extended in the future as the RMA method is fine-tuned. \newpage \section{Quality Control through Data Exploration} \label{qc} For the users convenience we have included the \verb+Dilution+ sample data set: <<>>= Dilution @ This will create the \verb+Dilution+ object of class \Robject{AffyBatch}. \Rfunction{print} (or \Rfunction{show}) will display summary information. These objects represent data from one experiment. The \Robject{AffyBatch} class combines the information of various {\it CEL} files with a common {\it CDF} file. This class is designed to keep information of one experiment. The probe level data is contained in this object. The data in \verb+Dilution+ is a small sample of probe sets from 2 sets of duplicate arrays hybridized with different concentrations of the same RNA. This information is part of the \Robject{AffyBatch} and can be accessed with the \verb+phenoData+ and \verb+pData+ methods: <<>>= phenoData(Dilution) pData(Dilution) @ Several of the functions for plotting summarized probe level data are useful for diagnosing problems with the data. The plotting functions \Rfunction{boxplot} and \Rfunction{hist} have methods for \Robject{AffyBatch} objects. Each of these functions presents side-by-side graphical summaries of intensity information from each array. Important differences in the distribution of intensities are often evident in these plots. The function \Rfunction{MAplot} (applied, for example, to \verb+pm(Dilution)+), offers pairwise graphical comparison of intensity data. The option \verb+pairs+ permits you to chose between all pairwise comparisons (when \verb+TRUE+) or compared to a reference array (the default). These plots can be particularly useful in diagnosing problems in replicate sets of arrays. The function argument \verb+plot.method+ can be used to create a MAplot using a smoothScatter, rather than the default method which is to draw every point. \begin{figure}[htbp] \begin{center} <>= data(Dilution) MAplot(Dilution,pairs=TRUE,plot.method="smoothScatter") @ \end{center} \caption{Pairwise MA plots} \end{figure} \subsection{Accessing $PM$ and $MM$ Data} The $PM$ and $MM$ intensities and corresponding {\it affyID} can be accessed with the \Rfunction{pm}, \Rfunction{mm}, and \Rfunction{probeNames} methods. These will be matrices with rows representing probe pairs and columns representing arrays. The gene name associated with the probe pair in row $i$ can be found in the $i$th entry of the vector returned by \Rfunction{probeNames}. <<>>= Index <- c(1,2,3,100,1000,2000) ##6 arbitrary probe positions pm(Dilution)[Index,] mm(Dilution)[Index,] probeNames(Dilution)[Index] @ \verb+Index+ contains six arbitrary probe positions. Notice that the column names of $PM$ and $MM$ matrices are the sample names and the row names are the {\it affyID}, e.g. \verb+1001_at+ and \verb+1000_at+ together with the probe number (related to position in the target sequence). <<>>= sampleNames(Dilution) @ {\bf Quick example:} To see what percentage of the $MM$ are larger than the $PM$ simply type <<>>= mean(mm(Dilution)>pm(Dilution)) @ The \Rfunction{pm} and \Rfunction{mm} functions can be used to extract specific probe set intensities. <<>>= gn <- geneNames(Dilution) pm(Dilution, gn[100]) @ The method \Rfunction{geneNames} extracts the unique {\it affyID}s. Also notice that the 100th probe set is different from the 100th probe! The 100th probe is not part of the the 100th probe set. The methods \Rfunction{boxplot}, \Rfunction{hist}, and \Rfunction{image} are useful for quality control. Figure \ref{f3} shows kernel density estimates (rather than histograms) of $PM$ intensities for the 1st and 2nd array of the \verb+Dilution+ also included in the package. \subsection{Histograms, Images, and Boxplots} \begin{figure}[htbp] \begin{center} <>= hist(Dilution[,1:2]) ##PM histogram of arrays 1 and 2 @ \caption{\label{f3} Histogram of $PM$ intensities for 1st and 2nd array} \end{center} \end{figure} As seen in the previous example, the sub-setting method \verb+[+ can be used to extract specific arrays. {\bf NOTE: Sub-setting is different in this version. One can no longer subset by gene. We can only define subsets by one dimension: the columns, i.e. the arrays. Because the \verb+Cel+ class is no longer available \verb+[[+ is no longer available.} %]] The method \verb+image()+ can be used to detect spatial artifacts. By default we look at log transformed intensities. This can be changed through the \verb+transfo+ argument. <>= par(mfrow=c(2,2)) image(Dilution) @ \begin{figure}[htbp] \begin{center} \includegraphics{image} \caption{\label{f1} Image of the log intensities.} \end{center} \end{figure} These images are quite useful for quality control. We recommend examining these images as a first step in data exploration. The method \Rfunction{boxplot} can be used to show $PM$, $MM$ or both intensities. \begin{figure}[htbp] \begin{center} <>= par(mfrow=c(1,1)) boxplot(Dilution, col=c(2,3,4)) @ \caption{\label{f4}Boxplot of arrays in Dilution data.} \end{center} \end{figure} As discussed in the next section this plot shows that we need to normalize these arrays. \subsection{RNA degradation plots} The functions \Rfunction{AffyRNAdeg}, \Rfunction{summaryAffyRNAdeg}, and \Rfunction{plotAffyRNAdeg} aid in assessment of RNA quality. Individual probes in a probeset are ordered by location relative to the $5'$ end of the targeted RNA molecule.\cite{affy4} Since RNA degradation typically starts from the $5'$ end of the molecule, we would expect probe intensities to be systematically lowered at that end of a probeset when compared to the $3'$ end. On each chip, probe intensities are averaged by location in probeset, with the average taken over probesets. The function \Rfunction{plotAffyRNAdeg} produces a side-by-side plots of these means, making it easy to notice any $5'$ to $3'$ trend. The function \Rfunction{summaryAffyRNAdeg} produces a single summary statistic for each array in the batch, offering a convenient measure of the severity of degradation and significance level. For an example <<>>= deg <- AffyRNAdeg(Dilution) names(deg) @ does the degradation analysis and returns a list with various components. A summary can be obtained using <<>>= summaryAffyRNAdeg(deg) @ Finally a plot can be created using \Rfunction{plotAffyRNAdeg}, see Figure \ref{f4.3}. \begin{figure}[htbp] \begin{center} <>= plotAffyRNAdeg(deg) @ \caption{\label{f4.3} Side-by-side plot produced by plotAffyRNAdeg.} \end{center} \end{figure} \newpage \section{Normalization} \label{s1.4} Various researchers have pointed out the need for normalization of Affymetrix arrays. See for example \cite{bols:etal:2003}. The method \verb+normalize+ lets one normalize at the probe level <<>>= Dilution.normalized <- normalize(Dilution) @ For an extended example on normalization please refer to the vignette in the affydata package. \section{Classes} \label{classes} \verb+AffyBatch+ is the main class in this package. There are three other auxiliary classes that we also describe in this Section. \subsection{AffyBatch} The AffyBatch class has slots to keep all the probe level information for a batch of {\it Cel} files, which usually represent an experiment. It also stores phenotypic and MIAME information as does the \verb+ExpressionSet+ class in the Biobase package (the base package for BioConductor). In fact, \verb+AffyBatch+ extends \verb+ExpressionSet+. The expression matrix in \verb+AffyBatch+ has columns representing the intensities read from the different arrays. The rows represent the {\it cel} intensities for all position on the array. The cel intensity with physical coordinates\footnote{Note that in the {\it .CEL} files the indexing starts at zero while it starts at 1 in the package (as indexing starts at 1 in {\bf R}).} $(x,y)$ will be in row \[i = x + \mathtt{nrow} \times (y - 1)\]. The \verb+ncol+ and \verb+nrow+ slots contain the physical rows of the array. Notice that this is different from the dimensions of the expression matrix. The number of row of the expression matrix is equal to \verb+ncol+$\times$\verb+nrow+. We advice the use of the functions \verb+xy2indices+ and \verb+indices2xy+ to shuttle from X/Y coordinates to indices. For compatibility with previous versions the accessor method \verb+intensity+ exists for obtaining the expression matrix. The \verb+cdfName+ slot contains the necessary information for the package to find the locations of the probes for each probe set. See Section \ref{sec:probesloc} for more on this. \subsection{ProbeSet} The \verb+ProbeSet+ class holds the information of all the probes related to an {\it affyID}. The components are \verb+pm+ and \verb+mm+. The method \verb+probeset+ extracts probe sets from \verb+AffyBatch+ objects. It takes as arguments an \verb+AffyBatch+ object and a vector of {\it affyIDs} and returns a list of objects of class \verb+ProbeSet+ <<>>= gn <- featureNames(Dilution) ps <- probeset(Dilution, gn[1:2]) #this is what i should be using: ps show(ps[[1]]) @ The \verb+pm+ and \verb+mm+ methods can be used to extract these matrices (see below). This function is general in the way it defines a probe set. The default is to use the definition of a probe set given by Affymetrix in the CDF file. However, the user can define arbitrary probe sets. The argument \verb+locations+ lets the user decide the row numbers in the \verb+intensity+ that define a probe set. For example, if we are interested in redefining the \verb+AB000114_at+ and \verb+AB000115_at+ probe sets, we could do the following: First, define the locations of the $PM$ and $MM$ on the array of the \verb+1000_at+ and \verb+1001_at+ probe sets <<>>= mylocation <- list("1000_at"=cbind(pm=c(1,2,3),mm=c(4,5,6)), "1001_at"=cbind(pm=c(4,5,6),mm=c(1,2,3))) @ The first column of the matrix defines the location of the $PM$s and the second column the $MM$s. Now we are ready to extract the \verb+ProbSet+s using the \verb+probeset+ function: <<>>= ps <- probeset(Dilution, genenames=c("1000_at","1001_at"), locations=mylocation) @ Now, \verb+ps+ is list of \verb+ProbeSet+s. We can see the $PM$s and $MM$s of each component using the \verb+pm+ and \verb+mm+ accessor methods. <<>>= pm(ps[[1]]) mm(ps[[1]]) pm(ps[[2]]) mm(ps[[2]]) @ This can be useful in situations where the user wants to determine if leaving out certain probes improves performance at the expression level. It can also be useful to combine probes from different human chips, for example by considering only probes common to both arrays. Users can also define their own environment for probe set location mapping. More on this in Section \ref{sec:probesloc}. An example of a \verb+ProbeSet+ is included in the package. A spike-in data set is included in the package in the form of a list of \verb+ProbeSet+s. The help file describes the data set. Figure \ref{f5.3} uses this data set to demonstrate that the $MM$ also detect transcript signal. \begin{figure}[htbp] \begin{center} <>= data(SpikeIn) ##SpikeIn is a ProbeSets pms <- pm(SpikeIn) mms <- mm(SpikeIn) ##pms follow concentration par(mfrow=c(1,2)) concentrations <- matrix(as.numeric(sampleNames(SpikeIn)),20,12,byrow=TRUE) matplot(concentrations,pms,log="xy",main="PM",ylim=c(30,20000)) lines(concentrations[1,],apply(pms,2,mean),lwd=3) ##so do mms matplot(concentrations,mms,log="xy",main="MM",ylim=c(30,20000)) lines(concentrations[1,],apply(mms,2,mean),lwd=3) @ \caption{\label{f5.3}PM and MM intensities plotted against SpikeIn concentration} \end{center} \end{figure} \section{Location to ProbeSet Mapping} \label{sec:probesloc} On Affymetrix GeneChip arrays, several probes are used to represent genes in the form of probe sets. From a {\it CEL} file we get for each physical location, or cel, (defined by $x$ and $y$ coordinates) an intensity. The {\it CEL} file also contains the name of the {\it CDF} file needed for the location-probe-set mapping. The {\it CDF} files store the probe set related to each location on the array. The computation of a summary expression values from the probe intensities requires a fast way to map an {\it affyid} to corresponding probes. We store this mapping information in {\bf R} environments\footnote{Please refer to the {\bf R} documentation to know more about environments.}. They only contain a part of the information that can be found in the {\it CDF} files. The {\it cdfenvs} are sufficient to perform the numerical processing methods included in the package. For each {\it CDF} file there is package, available from \url{http://bioconductor.org/help/bioc-views/release/data/annotation/}, that contains exactly one of these environments. The {\it cdfenvs} we store the $x$ and $y$ coordinates as one number (see above). In instances of {\it AffyBatch}, the {\it cdfName} slot gives the name of the appropriate {\it CDF} file for arrays represented in the \verb+intensity+ slot. The functions \verb+read.celfile+, \verb+read.affybatch+, and \verb+ReadAffy+ extract the {\it CDF} filename from the {\it CEL} files being read. Each {\it CDF} file corresponds to exactly one environment. The function \verb+cleancdfname+ converts the Affymetrix given {\it CDF} name to a BioConductor environment and annotation name. Here are two examples: These give environment names: <<>>= cat("HG_U95Av2 is",cleancdfname("HG_U95Av2"),"\n") cat("HG-133A is",cleancdfname("HG-133A"),"\n") @ This gives annotation name: <<>>= cat("HG_U95Av2 is",cleancdfname("HG_U95Av2",addcdf=FALSE),"\n") @ An environment representing the corner of an Hu6800 array is available with the package. In the following, we load the environment, look at the names for the first 5 objects defined in the environment, and finally look at the first object in the environment: <<>>= data(cdfenv.example) ls(cdfenv.example)[1:5] get(ls(cdfenv.example)[1],cdfenv.example) @ The package needs to know what locations correspond to which probe sets. The \verb+cdfName+ slot contains the necessary information to find the environment with this location information. The method \verb+getCdfInfo+ takes as an argument an \verb+AffyBatch+ and returns the necessary environment. If \verb+x+ is an \verb+AffyBatch+, this function will look for an environment with name \verb+cleancdfname(x@cdfName)+. <<>>= print(Dilution@cdfName) myenv <- getCdfInfo(Dilution) ls(myenv)[1:5] @ By default we search for the environment first in the global environment, then in a package named \verb+cleancdfname(x@cdfName)+. Various methods exist to obtain locations of probes as demonstrated in the following examples: <<>>= Index <- pmindex(Dilution) names(Index)[1:2] Index[1:2] @ \verb+pmindex+ returns a list with probe set names as names and locations in the components. We can also get specific probe sets: <<>>= pmindex(Dilution, genenames=c("1000_at","1001_at")) @ The locations are ordered from 5' to 3' on the target transcript. The function \verb+mmindex+ performs in a similar way: <<>>= mmindex(Dilution, genenames=c("1000_at","1001_at")) @ They both use the method \verb+indexProbes+ <<>>= indexProbes(Dilution, which="pm")[1] indexProbes(Dilution, which="mm")[1] indexProbes(Dilution, which="both")[1] @ The \verb+which="both"+ options returns the location of the $PM$s followed by the $MM$s. \section{Configuring the package options} \label{configure.options} Package-wide options can be configured, as shown below through examples. \begin{itemize} \item Getting the names for the options: <<>>= opt <- getOption("BioC") affy.opt <- opt$affy print(names(affy.opt)) @ %$ \item Default processing methods: <<>>= opt <- getOption("BioC") affy.opt <- opt$affy affy.opt$normalize.method <- "constant" opt$affy <- affy.opt options(BioC=opt) @ %$ \item Compression of files: if you are always compressing your CEL files, you might find annoying to specify it each time you call a reading function. It can be specified once for all in the options. <<>>= opt <- getOption("BioC") affy.opt <- opt$affy affy.opt$compress.cel <- TRUE opt$affy <- affy.opt options(BioC=opt) @ %$ \item Priority rule for the use of a cdf environment: The option {\it probesloc} is a list. Each element of the list is itself a list with two elements {\it what} and {\it where}. When looking for the information related to the locations of the probes on the array, the elements in the list will be looked at sequentially. The first one leading to the information is used (an error message is returned if none permits to find the information). The element {\it what} can be one of {\it package}, {\it environment}. \end{itemize} \section{Where can I get more information?} \label{moreinfo} There are several other vignettes addressing more specialised topics related to the {\tt affy} package. \begin{itemize} \item {\bf affy: Custom Processing Methods (HowTo)}: A description of how to use custom preprocessing methods with the package. This document gives examples of how you might write your own preprocessing method and use it with the package. \item {\bf affy: Built-in Processing Methods}: A document giving fuller descriptions of each of the preprocessing methods that are available within the {\tt affy} package. \item {\bf affy: Import Methods (HowTo)}: A discussion of the data structures used and how you might import non standard data into the package. \item {\bf affy: Loading Affymetrix Data (HowTo)}: A quick guide to loading Affymetrix data into R. \item {\bf affy: Automatic downloading of cdfenvs (HowTo)}: How you can configure the automatic downloading of the appropriate {\it cdfenv} for your analysis. \end{itemize} \appendix \section{Previous Release Notes} \subsection{Changes in versions 1.6.x} There were very few changes. \begin{itemize} \item The function \verb+MAplot+ has been added. It works on instances of AffyBatch. You can decide if you want to make all pairwise MA plots or compare to a reference array using the pairs argument. \item Minor bugs fixed in the parsers. \item The path of celfiles is now removed by ReadAffy. \end{itemize} \subsection{Changes in versions 1.5.x} There are some minor differences in what you can do but little functionality has disappeared. Memory efficiency and speed have improved. \begin{itemize} \item The widgets used by ReadAffy have changed. \item The path of celfiles is now removed by ReadAffy. \end{itemize} \subsection{Changes in versions 1.4.x} There are some minor differences in what you can do but little functionality has disappeared. Memory efficiency and speed have improved. \begin{itemize} \item For instances of \verb+AffyBatch+ the subsetting has changed. For consistency with \verb+exprSets+ one can only subset by the second dimension. So to obtain the first array, \verb+abatch[1]+ and \verb+abatch[1,]+ will give warnings (errors in the next release). The correct code is \verb+abatch[,1]+. \item mas5calls is now faster and reproduces Affymetrix's official version much better. \item If you use \verb+pm+ and \verb+mm+ to get the entire set of probes, e.g. by typing \verb+pm(abatch)+ then the method will be, on average, about 2-3 times faster than in version 1.3. \end{itemize} \bibliographystyle{plainnat} \bibliography{affy} \end{document} affy/vignettes/affy.bib0000644000175400017540000002602313556116173016153 0ustar00biocbuildbiocbuild@InBook{iriz:gaut:cope:2003, author = {Rafael A. Irizarry and Laurent Gautier and Leslie M. Cope}, editor = {Parmigiani, G. and Garrett, E.S. and Irizarry, R.A. and Zeger, S.L.}, title = {The Analysis of Gene Expression Data: Nethods and Software}, chapter = {4}, publisher = {Spriger Verlag}, year = {2003}, OPTkey = {}, OPTvolume = {}, OPTnumber = {}, OPTseries = {}, OPTtype = {}, OPTaddress = {}, OPTedition = {}, OPTmonth = {}, OPTpages = {}, OPTnote = {}, OPTannote = {} } @InBook{dudo:2002, author = {Sandrine Dudoit}, editor = {Parmigiani, G. and Garrett, E.S. and Irizarry, R.A. and Zeger, S.L.}, title = {The Analysis of Gene Expression Data: Nethods and Software}, chapter = {3}, publisher = {Spriger Verlag}, year = {2002}, OPTkey = {}, OPTvolume = {}, OPTnumber = {}, OPTseries = {}, OPTtype = {}, OPTaddress = {}, OPTedition = {}, OPTmonth = {}, OPTpages = {}, OPTnote = {}, OPTannote = {} } @InBook{gent:care:2002, author = {Robert Gentleman and Vince Carey}, editor = {Parmigiani, G. and Garrett, E.S. and Irizarry, R.A. and Zeger, S.L.}, title = {The Analysis of Gene Expression Data: Nethods and Software }, chapter = {2}, publisher = {Springer Verlag}, year = {2002}, OPTkey = {}, OPTvolume = {}, OPTnumber = {}, OPTseries = {}, OPTtype = {}, OPTaddress = {}, OPTedition = {}, OPTmonth = {}, OPTpages = {}, OPTnote = {}, OPTannote = {} } @article{ihak:gent:1996, author = {Ross Ihaka and Robert Gentleman}, title = {{R}: {A} Language for Data Analysis and Graphics}, journal = {Journal of Computational and Graphical Statistics}, year = 1996, volume = 5, number = 3, pages = {299--314} } @Book{cham:1998, author = {John M. Chambers}, title = {Programming with Data: A guide to the {S} language}, publisher = {Springer}, year = {1998}, OPTkey = {}, OPTvolume = {}, OPTnumber = {}, OPTseries = {}, OPTaddress = {}, OPTedition = {}, OPTmonth = {}, OPTnote = {}, annote = {S, Programming} } @Article{iriz:etal:2003, author = {Rafael A. Irizarry and Bridget Hobbs and Francois Collin and Yasmin D. Beazer-Barclay and Kristen J. Antonellis and Uwe Scherf and Terence P. Speed}, title = {Exploration, Normalization, and Summaries of High Density Oligonucleotide Array Probe Level Data}, journal = {Biostatistics}, year = {2003}, OPTkey = {}, OPTvolume = {}, OPTnumber = {}, OPTpages = {}, OPTmonth = {}, note = {To appear}, OPTannote = {} } @Manual{affy4, title = {Affymetrix Microarray Suite User Guide}, author = {Affymetrix}, year = {1999}, organization = {Affymetrix}, address = {Santa Clara, CA}, edition = {version 4}, } @Manual{affy5, title = {Affymetrix Microarray Suite User Guide}, author = {Affymetrix}, year = {2001}, organization = {Affymetrix}, address = {Santa Clara, CA}, edition = {version 5}, } @Article{hill:etal:2000, author = {A.A. Hill and C.P Hunter and B.T. Tsung and G. Tucker-Kellogg and E.L. Brown}, title = {Genomic Analysis of Gene Expression in C. elegans}, journal = {Science}, year = {2000}, OPTkey = {}, volume = {290}, OPTnumber = {}, pages = {809--812}, OPTmonth = {}, OPTnote = {}, OPTannote = {} } @Article{hill:etal:2001, author = {Andre A. Hill and Eugene L. Brown and Maryann Z. Whitley and Greg Tucker-Kellogg and Craig P. Hunter and Donna K. Slonim}, title = {Evaluation of normalization procedures for oligonucleotide array data based on spiked c{RNA} controls}, journal = {Genomebiology}, year = {2001}, OPTkey = {}, volume = {2}, pages = {1--13}, OPTmonth = {}, OPTnote = {}, OPTannote = {} } @Article{baug:etal:2001, author = {L.R. Baugh and A.A. Hill and E.L. Brown and Craig P. Hunter}, title = {Quantitative analysis of m{RNA} amplification by {\it in vitro} transcription}, journal = {Nucleic Acids Research}, year = {2001}, volume = {29}, OPTnumber = {}, pages = {1--9}, OPTmonth = {}, OPTnote = {}, OPTannote = {} } @TechReport{affy:tech:2001, author = {Affymetrix}, title = {New Statistical Algorithms for Monitoring Gene Expression on $\mbox{GeneChip}^{\mbox{\textregistered}}$ Probe Arrays}, institution = {Affymetrix}, year = {2001}, } @techreport{affy:tech:2002, key = {Affymetrix (2002)}, author = {Affymetrix}, title = {Statistical Algorithms Description Document}, organization = {Affymetrix}, institution = {Affymetrix}, year = 2002 } @InProceedings{affytalk:2001, title = {Estimating Signal with Next Generation {A}ffymetrix Software}, author = {Earl Hubbell}, booktitle = {Gene Logic Workshop on Low Level Analysis of Affymetrix $\mbox{GeneChip}^{\mbox{\textregistered}}$ data}, year = {2001}, note = {{\small \tt http://www.stat.berkeley.edu/users/terry/zarray/Affy/GL\_Workshop/genelogic2001.html}} } @InProceedings{fang:li:wong:2001, title = {Model-based Saturation Handling}, author = {Xuemin Fang and Cheng Li and Wing Hung Wong}, booktitle = {Genelogic Workshop on Low Level Analysis of Affymetrix $\mbox{GeneChip}^{\mbox{\textregistered}}$ data}, year = {2001}, note = {{\small \tt http://www.stat.berkeley.edu/users/terry/zarray/Affy/GL\_Workshop/genelogic2001.html}} } @InProceedings{hold:etal:2001, author = {Daniel Holder and Richard F. Raubertas and V. Bill Pikounis and Vladimir Svetnik and Keith Soper}, title = {Statistical analysis of high density oligonucleotide arrays: a {SAFER} approach}, year = {2001}, booktitle = {Proceedings of the ASA Annual Meeting, Atlanta, GA 2001}, OPTcrossref = {}, OPTkey = {}, OPTpages = {}, OPTyear = {}, OPTeditor = {}, OPTvolume = {}, OPTnumber = {}, OPTseries = {}, OPTaddress = {}, OPTmonth = {}, OPTorganization = {}, OPTpublisher = {}, OPTnote = {}, OPTannote = {} } @Article{astr:2001, author = {Magnus {\AA}strand}, title = {Normalizing oligonucleotide arrays}, journal = {Unpublished manuscript}, year = {2001}, OPTkey = {}, OPTvolume = {}, OPTnumber = {}, OPTpages = {}, OPTmonth = {}, OPTnote = {}, OPTannote = {} } @Article{bols:etal:2003, author = {B.M. Bolstad and R.A. Irizarry and M. {\AA}strand and T.P. Speed}, title = {A comparison of normalization methods for high density oligonucleotide array data based on variance and bias}, journal = {Bioinformatics}, Volume={19}, Number={2}, Pages={185--193}, Month={Jan}, year={2003}, } @Article{bols:2001, author = {Ben Bolstad}, title = {Probe level quantile normalization of high density oligonucleotide arrays}, journal = {Unpublished manuscript}, year = {2001}, OPTkey = {}, OPTvolume = {}, OPTnumber = {}, OPTpages = {}, OPTmonth = {}, OPTnote = {}, OPTannote = {}, } @Article{dudo:etal:2001, author = {S. Dudoit and Y. H. Yang and M. J. Callow and T. P. Speed}, title = {Statistical methods for identifying genes with differential expression in replicated c{DNA} microarray experiments}, journal = {Statistica Sinica}, year = {2001}, OPTkey = {}, OPTvolume = {}, OPTnumber = {}, OPTpages = {}, OPTmonth = {}, note = {Accepted}, OPTannote = {} } @Article{li:wong:2001a, Author = {Li, C. and Wong, W.H.}, Title = {Model-based analysis of oligonucleotide arrays: Expression index computation and outlier detection}, Journal = {Proceedings of the National Academy of Science U S A}, Year = 2001, Volume = {98}, Pages = {31--36}, } @Article{li:wong:2001b, Author = {Li, C. and Wong, W.H.}, Title = {Model-based analysis of oligonucleotide arrays: model validation, design issues and standard error application}, Journal = {Genome Biology}, Year = 2001, Volume = {2}, Pages = {1--11} } @Article{lock:etal:1996, Author = {David J. Lockhart and Helin Dong and Michael C. Byrne and Maximillian T. Follettie and Michael V. Gallo and Mark S. Chee and Michael Mittmann and Chunwei Wang and Michiko Kobayashi and Heidi Horton and Eugene L. Brown}, Title = {Expression Monitoring by hybridization to high-density oligonucleotide arrays}, Journal = {Nature Biotechnology}, Year = 1996, Volume = {14}, Pages = {1675--1680} } @InProceedings{hart:etal:2001, author = {Alexander J. Hartemink and David K. Gifford and Tommi S. Jaakola and Richard A. Young}, title = {Maximum likelihood estimation of optimal scaling factors for expression array normalization}, booktitle = {SPIE BiOS}, year = 2001, month = {January}, annote = {affymetrix, high density oligonucleotide} } @Article{efro:etal:2001, Author = {Bradley Efron and Robert Tibshirani and Virginia Goss and Gil Chu}, Title = {Microarrays and their uses in comparative experiments}, Journal = {Tech Report}, Year = 2001, Volume = {1}, Pages = {1--38} } @Article{naef:etal:2001, Author = {F\'{e}lix Naef and Daniel A. Lim and Nila Patil and Marcelo O. Magnasco}, Title = {From features to expression: High density oligonucleotide array analysis revisited}, Journal = {Tech Report}, Year = 2001, Volume = {1}, Pages = {1--9} } @Article{astr:2003, author = {Magnus {\AA}strand}, title = {Contrast Normalization of Oligonucleotide Arrays}, journal = {Journal of Computational Biology}, year = {2003}, volume = {10}, number={1}, pages={95--102} } @article{Dudoit:2002, author = {Dudoit, S. and Yang, Y. H. and Callow, M. J. and Speed, T. P.}, title = {Statistical methods for identifying genes with differential expression in replicated cDNA microarray experiments}, journal = {Stat. Sin.}, year = 2002, volume = 12, number = 1, pages={111-139} } @Article{workman:etal:2002, Author="Workman, Christopher. and Jensen, Lars. Juhl. and Jarmer, Hanne. and Berka, Randy. and Gautier, Laurent. and Nielser, Henrik. Bjorn. and Saxild, Hans.-Henrik and Nielsen, Claus. and Brunak, Soren. and Knudsen, Steen.", Title="{A new non-linear normalization method for reducing variability in DNA microarray experiments}", Journal="Genome Biol", Year="2002", Volume="3", Number="9", Pages="research0048", Month="Aug" } @Article{Lazardis:etal:2002, Author="Lazaridis, Emmanuel. N. and Sinibaldi, Dominic. and Bloom, Gregory. and Mane, Shrikant. and Jove, Richard.", Title="{A simple method to improve probe set estimates from oligonucleotide arrays}", Journal="Math Biosci", Year="2002", Volume="176", Number="1", Pages="53-58", Month="Mar" } @Book{Tukey:1977, author = "Tukey, J. W.", title = "Exploratory Data Analysis", year = "1977", publisher = {Addison-Wesley}, } @Article{gaut:cope:bols:iriz:2003, Author = {Gautier, Laurent and Cope, Leslie and Bolstad, Benjamin Milo and Irizarry, Rafael A.}, Title = {affy - An R package for the analysis of Affymetrix GeneChip data at the probe level}, Journal = {Bioinformatics}, note={In press}, Year ={2003}, } affy/vignettes/builtinMethods.Rnw0000644000175400017540000002456013556116173020236 0ustar00biocbuildbiocbuild% -*- mode: noweb; noweb-default-code-mode: R-mode; -*- %\VignetteIndexEntry{2. Built-in Processing Methods} %\VignetteKeywords{Preprocessing, Affymetrix} %\VignetteDepends{affy} %\VignettePackage{affy} %documentclass[12pt, a4paper]{article} \documentclass[12pt]{article} \usepackage{amsmath} \usepackage{hyperref} \usepackage[authoryear,round]{natbib} \textwidth=6.2in \textheight=8.5in %\parskip=.3cm \oddsidemargin=.1in \evensidemargin=.1in \headheight=-.3in \newcommand{\scscst}{\scriptscriptstyle} \newcommand{\scst}{\scriptstyle} \author{Ben Bolstad} \begin{document} \title{affy: Built-in Processing Methods} \maketitle \tableofcontents \section{Introduction} This document describes the preprocessing methods that have currently been built into the \verb+affy+ package. Hopefully it will clarify for the reader what each of the routines does. There is a separate vignette which describes how you might write your own routines and use them in combination with the built-in routines. As usual, loading the package in your \verb+R+ session is required. \begin{Sinput} R> library(affy) ##load the affy package \end{Sinput} <>= library(affy) @ \section{Background methods} You can see the background correction methods that are built into the package by examining the variable \verb+bgcorrect.method+. <<>>= bgcorrect.methods() @ \subsection{none} Calling this method actually does nothing. It returns the object unchanged. May be used as a placeholder. \subsection{rma/rma2} These are background adjustment implementations for the rma method \cite{iriz:etal:2003}. They differ only in how they estimate a set of parameters (generally you should use \verb+rma+ in preference to \verb+rma2+. In both cases PM probe intensities are corrected by using a global model for the distribution of probe intensities. The model is suggested by looking at plots of the empirical distribution of probe intensities. In particular the observed PM probes are modeled as the sum of a normal noise component N (Normal with mean $\mu$ and variance $\sigma^2$) and a exponential signal component S (exponential with mean $\alpha$). To avoid any possibility of negatives, the normal is truncated at zero. Given we have O the observed intensity, this then leads to an adjustment. \begin{equation*} E\left(s \lvert O=o\right) = a + b \frac{\phi\left(\frac{a}{b}\right) - \phi\left(\frac{o-a}{b}\right)}{\Phi\left(\frac{a}{b}\right) + \Phi\left(\frac{o-a}{b}\right) - 1 } \end{equation*} where $a = s- \mu - \sigma^2\alpha$ and $b = \sigma$. Note that $\phi$ and $\Phi$ are the standard normal distribution density and distribution functions respectively. Note that MM probe intensities are not corrected by either of these routines. \subsection{mas} This is an implementation of the background correction method outlined in the Statistical Algorithms Description Document \cite{affy:tech:2002}. The chip is broken into a grid of 16 rectangular regions. For each region the lowest 2\% of probe intensities are used to compute a background value for that grid. Each probe is then adjusted based upon a weighted average of the backgrounds for each of the regions. The weights are based on the distances between the location of the probe and the centriods of 16 different regions. Note this method corrects both PM and MM probes. \section{Normalization Methods} You can see the background correction methods that are built into the package by examining the variable \verb+bgcorrect.method+. <<>>= normalize.AffyBatch.methods() @ The Quantile, Contrast and Loess normalizations have been discussed and compared in \cite{bols:etal:2003}. \subsection{quantiles/quantiles.robust} The quantile method was introduced by \cite{bols:etal:2003}. The goal is to give each chip the same empirical distribution. To do this we use the following algorithm where $X$ is a matrix of probe intensities (probes by arrays): \begin{enumerate} \item Given $n$ array of length $p$, form $X$ of dimension $p \times n$ where each array is a column \item Sort each column of $X$ to give $X_{\mbox{sort}}$ \item Take the means across rows of $X_{\mbox{sort}}$ and assign this mean to each element in the row to get $X'_{\mbox{sort}}$ \item Get $X_{\mbox{normalized}}$ by rearranging each column of $X'_{\mbox{sort}}$ to have the same ordering as original $X$ \end{enumerate} The quantile normalization method is a specific case of the transformation $x'_{i} = F^{-1}\left(G\left(x_{i}\right)\right)$, where we estimate $G$ by the empirical distribution of each array and $F$ using the empirical distribution of the averaged sample quantiles. Quantile normalization is pretty fast. The {\tt quantiles} function performs the algorithm as above. The {\tt quantile.robust} function allows you to exclude or down-weight arrays in the computation of $\hat G$ above. In most cases we have found that the {\tt quantiles} method is sufficient for use and {\tt quantiles.robust} not required. \subsection{loess} There is a discussion of this method in \cite{bols:etal:2003}. It generalizes the $M$ vs $A$ methodology proposed in \cite{Dudoit:2002} to multiple arrays. It works in a pairwise manner and is thus slow when used with a large number of arrays. \subsection{contrasts} This method was proposed by \cite{astr:2003}. It is also a variation on the $M$ vs $A$ methodology, but the normalization is done by transforming the data to a set of contrasts, then normalizing. \subsection{constant} A scaling normalization. This means that all the arrays are scaled so that they have the same mean value. This would be typical of the approach taken by Affymetrix. However, the Affymetrix normalization is usually done after summarization (you can investigate \verb+affy.scalevalue.exprSet+ if you are interested) and this normalization is carried out before summarization. \subsection{invariantset} A normalization similar to that used in the dChip software \cite{li:wong:2001a}. Using a baseline array, arrays are normalized by selecting invariant sets of genes (or probes) then using them to fit a non-linear relationship between the ``treatment'' and ``baseline'' arrays. The non-linear relationship is used to carry out the normalization. \subsection{qspline} This method is documented in \cite{workman:etal:2002}. Using a target array (either one of the arrays or a synthetic target), arrays are normalized by fitting splines to the quantiles, then using the splines to perform the normalization. \section{PM correct methods} <<>>= pmcorrect.methods() @ \subsection{mas} An {\it ideal mismatch} is subtracted from PM. The ideal mismatch is documented by \cite{affy:tech:2002}. It has been designed so that you subtract MM when possible (ie MM is less than PM) or something else when it is not possible. The Ideal Mismatch will always be less than the corresponding PM and thus we can safely subtract it without risk of negative values. \subsection{pmonly} Make no adjustment to the pm values. \subsection{subtractmm} Subtract MM from PM. This would be the approach taken in MAS 4 \cite{affy4}. It could also be used in conjunction with the Li-Wong model. \section{Summarization methods} <<>>= express.summary.stat.methods() @ \subsection{avgdiff} Compute the average. This is the approach that was taken in \cite{affy4}. \subsection{liwong} This is an implementation of the methods proposed in \cite{li:wong:2001a} and \cite{li:wong:2001b}. The Li-Wong MBEI is based upon fitting the following multi-chip model to each probeset \begin{equation} y_{ij} = \phi_i \theta_j + \epsilon_{ij} \end{equation} where $y_{ij}$ is $PM_{ij}$ or the difference between $PM_{ij}-MM_{ij}$. The $\phi_i$ parameter is a probe response parameter and $\theta_j$ is the expression on array $j$. \subsection{mas} As documented in \cite{affy:tech:2002}, a robust average using 1-step Tukey biweight on $\log_2$ scale. \subsection{medianpolish} This is the summarization used in the RMA expression summary \cite{iriz:etal:2003}. A multichip linear model is fit to data from each probeset. In particular for a probeset $k$ with $i=1,\dots,I_k$ probes and data from $j=1,\dots,J$ arrays we fit the following model \begin{equation*} \log_2\left(PM^{(k)}_{ij}\right) = \alpha_i^{(k)} + \beta_j^{(k)} + \epsilon_{ij}^{(k)} \end{equation*} where $\alpha_i$ is a probe effect and $\beta_j$ is the $\log_2$ expression value. The medianpolish is an algorithm (see \cite{tukey:1977}) for fitting this model robustly. Please note that expression values you get using this summary measure will be in $\log_2$ scale. \subsection{playerout} This method is detailed in \cite{Lazardis:etal:2002}. A non-parametric method is used to determine weights. The expression value is then the weighted average. \section{Putting it altogether using {\tt expresso}} The function that you should use is {\tt expresso}. It is important to note that not every preprocessing method can be combined together. In particular the \verb+rma+ backgrounds adjust only PM probe intensities and so they should only be used in conjunction with the \verb+pmonly+ PM correction. Also remember that the \verb+mas+ and \verb+medianpolish+ summarization methods $\log_2$ transform the data, thus they should not be used in conjunction with any preprocessing steps that are likely to yield negatives like the \verb+subtractmm+ pm correction method. The following is a typical call to \verb+expresso+. \begin{Sinput} library(affydata) data(Dilution) eset <- expresso(Dilution,bgcorrect.method="rma", normalize.method="quantiles", pmcorrect.method="pmonly", summary.method="medianpolish") \end{Sinput} %@ This would give you the RMA expression measure, but of course there are other ways of computing RMA (chiefly \verb+rma+). The true power of \verb+expresso+ becomes apparent when you start combining different methods. By choosing a method for each of the four steps ({\tt bgcorrect.method}, {\tt normalize.method}, {\tt pmcorrect.method}, {\tt summary.method}) you can create quite a variety of expression measures. For instance \begin{Sinput} eset <- expresso(Dilution,bgcorrect.method="mas", normalize.method="qspline", pmcorrect.method="subtractmm", summary.method="playerout") \end{Sinput} would be a valid way of computing an expression measure (it is up to the user to decide whether such a concoction is sensible or not). \bibliographystyle{plainnat} \bibliography{affy} \end{document} affy/vignettes/customMethods.Rnw0000644000175400017540000001356213556116173020102 0ustar00biocbuildbiocbuild% -*- mode: noweb; noweb-default-code-mode: R-mode; -*- %\VignetteIndexEntry{3. Custom Processing Methods} %\VignetteKeywords{Preprocessing, Affymetrix} %\VignetteDepends{affy} %\VignettePackage{affy} %documentclass[12pt, a4paper]{article} \documentclass[12pt]{article} \usepackage{amsmath} \usepackage{hyperref} \usepackage[authoryear,round]{natbib} \textwidth=6.2in \textheight=8.5in %\parskip=.3cm \oddsidemargin=.1in \evensidemargin=.1in \headheight=-.3in \newcommand{\scscst}{\scriptscriptstyle} \newcommand{\scst}{\scriptstyle} \newcommand{\Rfunction}[1]{{\texttt{#1}}} \newcommand{\Robject}[1]{{\texttt{#1}}} \newcommand{\Rpackage}[1]{{\textit{#1}}} \newcommand{\Rmethod}[1]{{\texttt{#1}}} \newcommand{\Rfunarg}[1]{{\texttt{#1}}} \newcommand{\Rclass}[1]{{\textit{#1}}} \author{Laurent} \begin{document} \title{affy: Custom Processing Methods (HowTo)} \maketitle \tableofcontents \section{Introduction} This document describes briefly how to customize the affy package by adding one's own processing methods. The types of processing methods are background correction, normalization, perfect match correction and summary expression value computation. We tried our best to make this as easy as we could, but we are aware that it is far from being perfect. We are still working on things to improve them. Hopefully this document should let you extend the package with supplementary processing methods easily. As usual, loading the package in your \verb+R+ session is required. \begin{Sinput} R> library(affy) ##load the affy package \end{Sinput} <>= library(affy) @ \section{How-to} For each processing step, labels for the methods known to the package are stored in variables. <<>>= normalize.AffyBatch.methods() bgcorrect.methods() pmcorrect.methods() express.summary.stat.methods() @ We would recommend the use of the method \verb+normalize.methods+ to access the list of available normalization methods (as a scheme for normalization methods that would go beyond 'affy' is thought). <<>>= library(affydata) data(Dilution) normalize.methods(Dilution) @ For each processing step, a naming convention exists between the method label and the function name in \verb+R+ (see table~\ref{table:summary.labels}). Each processing methods should be passed objects (and return objects) corresponding to the processing step (see table~\ref{table:summary.methods}). \begin{table} \begin{tabular}{|c|c|} \hline variable for labels & naming convention \\ \hline bgcorrect.methods & bg.correct.