affy/DESCRIPTION0000644000175100017510000000416312607321332014230 0ustar00biocbuildbiocbuildPackage: affy Version: 1.48.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), BiocInstaller, 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 NeedsCompilation: yes Packaged: 2015-10-14 00:33:30 UTC; biocbuild affy/NAMESPACE0000644000175100017510000000425412607264453013754 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(BiocInstaller, biocinstallRepos) 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, featureNames, geneNames, sampleNames, se.exprs, updateObject) exportClasses("AffyBatch") affy/NEWS0000644000175100017510000001247212607264453013235 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/0000755000175100017510000000000012607264453012731 5ustar00biocbuildbiocbuildaffy/R/AffyBatch.R0000644000175100017510000007255712607264452014722 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)) 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)) 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) }) ##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.R0000644000175100017510000000576412607264453014776 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.R0000644000175100017510000001142412607264452014600 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.R0000644000175100017510000000610612607264452016154 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.R0000644000175100017510000000070012607264452014307 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.R0000644000175100017510000000204112607264452016235 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.R0000644000175100017510000000266512607264453016134 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.R0000644000175100017510000000333512607264452013447 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.R0000644000175100017510000000772112607264452014732 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.R0000644000175100017510000000754112607264452016076 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.R0000644000175100017510000002045412607264452015216 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.R0000644000175100017510000000051112607264452021030 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.R0000644000175100017510000000052712607264452020730 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.R0000644000175100017510000000127212607264452020207 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.R0000644000175100017510000000013312607264452022076 0ustar00biocbuildbiocbuildgenerateExprVal.method.medianpolish <- function(probes, ...) medianpolish(probes, ...) affy/R/generateExprVal.method.playerout.R0000644000175100017510000000217012607264452021451 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.R0000644000175100017510000001305612607264452014665 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(biocinstallRepos(), 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=biocinstallRepos(), 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.R0000644000175100017510000000062512607264452014007 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.R0000644000175100017510000001171412607264452014544 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.R0000644000175100017510000000276612607264452016212 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.R0000644000175100017510000002500712607264452014161 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.R0000644000175100017510000001305212607264452013721 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.R0000644000175100017510000000264012607264452016002 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.R0000644000175100017510000003440612607264453014763 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.R0000644000175100017510000000165312607264452016710 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.R0000644000175100017510000000217112607264452017073 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.R0000644000175100017510000001227012607264452017563 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.R0000644000175100017510000000506612607264452016206 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.R0000644000175100017510000001065712607264452016536 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.R0000644000175100017510000000755712607264453017076 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.R0000644000175100017510000000257712607264453016033 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.R0000644000175100017510000000060312607264452015552 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.R0000644000175100017510000000272412607264452015514 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.R0000644000175100017510000000113212607264452015517 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.R0000644000175100017510000000221512607264452015630 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.R0000644000175100017510000000043112607264452015346 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.R0000644000175100017510000000172612607264452015222 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.R0000644000175100017510000003335712607264453015730 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.R0000644000175100017510000000414612607264452013637 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.R0000644000175100017510000000344112607264452014552 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.m40000755000175100017510000000113412607264453014372 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/0000755000175100017510000000000012607321332013615 5ustar00biocbuildbiocbuildaffy/build/vignette.rds0000644000175100017510000000050412607321332016153 0ustar00biocbuildbiocbuildRMO0e ]j &~u1&xP mI{فmY@Őy73},Bl0l#X3X|.'al#/7-ds%O`NYvs2"u7倈9対fY'ؿ+Ι_aeBm,NLGzSz2vzioWKǏzZV E͸chЩk"MIFI#Jҏ\C2b.wd]є'+m%o^l !)JQ`SlZ5 [Y_4MG&š q" 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/cleanup0000755000175100017510000000005012607264453014100 0ustar00biocbuildbiocbuild#! /bin/sh rm -f config.* src/Makevars affy/configure0000755000175100017510000007614212607264453014451 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.in0000755000175100017510000000107112607264453015043 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/0000755000175100017510000000000012607264453013441 5ustar00biocbuildbiocbuildaffy/data/SpikeIn.rda0000644000175100017510000000316612607264453015501 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.rda0000644000175100017510000003346512607264453017043 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.rda0000644000175100017510000000032712607264453016126 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.Rnw0000644000175100017510000010542012607321332015657 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.pdf0000644000175100017510000275730512607321332015703 0ustar00biocbuildbiocbuild%PDF-1.5 % 128 0 obj << /Length 1246 /Filter /FlateDecode >> stream xXKs6WVrd7KV;ukJc"Q$(٦3͎@<vqpȖ. K..}aN [bTS(W7P,PtPf)˴>|͑.e cFɹR*$q b'0٠d\6Uaڥb8g ;/qv-+_#59'(}:AMYV64olw8M54T5UQ:)e+B%clH%eBY8NyȴCWG!_h9Euaɥttְ1ԋ([&ר㙛`K ҷ\=v3oDx uc|6*xR0w8zM!)xvKۺNPSAŰ NhϙlO2kB]?93oHqּ;|maJh yYOoR'6HK@<)oljM?]T1p #đ@@#aWZܷ2!ɲQk6}ًUD"P,Z?XQA8EBP}?JѤBZ:?gq[^]!:!nyw|ХxK?!IMzxKW =q-\{ѵ^8VlYy!:Y/2==pk|)B,BXRD?(ظ@`K!ʄ#9 ;55l8(mN_12RO i콐fSiq`$V`$ W[R[G6"p6&P"@,COq?uQ̧tlx|&]v\b Q vw%YKr#!c4`QeO5UYe.4{/FB&yϬlH$$hH8hA [=ӛ{1F +a9&#51 \}y*I&}^Ϲ`KjpۙO&0eжh>W`/ș8B|8|SG@TOuF~"/3p[޿a5w咞ETm{N%nE1FR;?H %ˆLXS59U6m:&$|MH HztBjk^ Hr [B#/q.l= 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ڵXI6WEČDZ @$h()A5oL~}FЩsA2)oB}]QLDU$Kf*c|>$Qff4aG5O~*{`,I TE4œ[x?_Ft42ӅJeKgEYHkI`z:Ĥ)Yf ©*%P# eY'L;ܭ)J >᥁.cZsDA@WL Nfeʲ̒LeY*i¯Ei]yLQK9BRUZqgQi+qJ"rȹZW7NZ~'6|Q>y[6U A%:6yA)h mYa?pnW+ @(dHjɋ㥵ٜ ڈ9NX Zhbhএ8{1-W7FK@26+k~6G Bi[*/XO~RiHD9̞?-YЂ_o m<==BaClHkm{1 %{ʃX[M%m+)DV"ӭl-jSuhY=J cs9 &oD鲰怜YA8į^3ˠՅ-ѵȔI.M> =m5R%թ SdNCΗJjg[~vi.,TYʴPK4\gkƳ`k^C0шKX_K/Z2Qbe)z n}zdl =׆Bk@Nݸ:o݊U6/G>ا)Iv_Al\=fyz\္t38S7TH_8 ܒETlk=.CVѠׅk=R,+:Ak,O.Cđ✶G:.G[o!Y*-#vDfhovW|ߠZywsX|aMQ%KGZK*SI7_0 ē44tLhζc<̲JܕE 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 3846 /Filter /FlateDecode >> stream x! ~82je 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<'0xpua <4\N,[F>БCW qs7=;9ފ FY*` 6[L혚cjx=nag; cKaH \;;qD idbqu6⳱-Ǣbo] L|~Z4 kȻMW*PhO`S:P*,*<>[&hQrY7kNΒm)>s]J7%GA&|^$ .U?u+o;@ (rTx6BTf9E !>;Lƍ,i(06\'7ȍ&fBàgAc*7nx9ǖZM|Vn?ZԣikpLI&f:)" ^*CSڤx(ء-0l͚2n&#|1[o/:p@)F-=䧕OdEȤH8ai33b7Zu8$Cl_`9VnSŸ$*Kg0]c8-S%~Nq|z|vj_y (ԗ~Նw>!z8Fg"sϠ,$ga˲hU5Uoީ|,Zű_U+zٹTGj׸qaV2Wq}X09פ ;Ye4 KϷ'[i%杄90sJ=5_wOv4-m;*h1jR)jSŇF3vlQ@LEؒ=Sim4R L4HR<˺ZtD1ʧvZtU./.vO]\ͧή|mƲ<37FC4;n} W`+_VԮSNUfz2T vO->@w >U1?Id!Lp#Ү/}4~wZeNVh3}QÞ.S4ްF4J^m%{iodSN):ySZ_G?7mElTa)w o< 0D @eQڑV|nVГą0i`{$D`LJ"oWvI#]h C?mt4B.rkjWhfD$o_ 'y endstream endobj 262 0 obj << /Length 1159 /Filter /FlateDecode >> 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 (./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 402565 /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?ׄrP ]׭~Fk\'?/߻y-~c2[n[?S1N~~ʛԿϷx5{st*;y|G?F~/uw:Gې}m^%3~BJNqnFΗ߿+UczqSuzT~S+P?W~G~_\~1>?/~tsoQ~s_G?QU__;mszޏz6?ߦU돿?}ok_c>k9T~?ϟݧ|k_3Ook~_ϥkקq8E397xw~uO<\F??.g2ٯOICvdw=!]zS??9OܿjO~~b'd4p::Il÷A?Z_m:W_1qŇm϶?ٯ~֣Z;ri.u:(-K 8%$de7O;_o*'Ev;!\v[7ЭhZtq ntqwyG3Z Z\'M..;hkU>o+\tD躯p)y,uDvh-tF>*rv}% '66xU k~+M#+h#BWUV>g>G'߀ӹ^eogkNמ=kNkNkמ.: ^{vBxڳ6te ʪgkNz g'gkNWV𛮬:!\Yu]Yu@@x V]tB;]YuBJphkNk=JVp!ot! BЕU\n=;F2p N2 ޯ= \tfglWoK:ݗNګwF z"z_"T:|E~?Q"lz)*n4U: >%"l|H0(AC&Hd2?e1P!dC`H\ 恂!0C Ȇ C2l6!0B.Ȇ@ !!0C Ȇ C*l6!0lbC Ȇ C2C Ȇ0 C*l !dC` Ć C*C`H@ f 6T!0$C Ȇ C2l  ^|!8!!8!!8 B!? !8 A6'!8!!8 !8 6!8 B!? B!? !8a @lP`hN 4aUG$# +AC@6[#_{iՊC)U|,,Xk*R u{!X{kD"8"T8"$'8T8#hC<# A~[# \vpDhT8" N5 0 N5 N @ N5  0 N5 N5 @ N N5 N@0 N5 N5 @ N N5]  Ԓ7( {L@kz L7Eo 5`7doP0yf &o 5`\ &oP0yBw ap_UhkFZX)6᧾֯!~^#TLWP/6a'rlV36a$| 6y[F&6AMM5MdP0

#&|k}M/O}D_`=_ N}k[=E&,Qw}^nD9"&,t#l?ڄzCEfl#m"l M0C l @&M0.6l A @l Md`H6a` @&M0.6ʻ A @l &M0.6l€&M0 6ʻ C*l&6M0lb 6&Md 6m!wA l &M0lb 6l C M 'dO6a+ 0ل=xdM '}'lW@/F<ԛHK|?Gb0~ˑ|!A#G0/>| 0aH_} C# G0/> Ay# @G0^Iʃ#2.!wGIF9d4n GhЅAk4`4NGh|V=\<"hr ë.z>`4>dV y~/zuaDwf(F>nDkxPşzAQhR$~ɸ8%F{GQ} 8F#@ H0y~T is8BC=a>xAsd!Ȟð=!iA9 s  ^d4*UBG6eyk*=_<QSt@ѐ0jѨ>l"h&gH2$AIF#V&|baHR@0AF8C$"9 !!ȞÐ {C9s60$ ȞC=!y0!ȞÐ {C 9s60lb!ȞÐ {C!Ȟ0< {C 9 I+da Ğð= {C aHC= {f s0$!Ȟð= {C9 s̞ck_ڗ9`[^R0y-})<ǖ׾4Eϱ/ڗ9a3P[^Ґ–׾4d/ڗFϱ/s-OǷNeΉliM? ȖW4CK.wd~lJ*[ڏqDյsK Ezޖ>/A1"~|WA|FQgMG cDg|(YU=29]g/@nlJR%omkV okVl~_K@aq~lid҉liUCx҉lyOCv"[^S09-)ȖWLNd+x6%'< Da(:-i b+x ɉlyOD`r"[^ӐĖW4d'< ɉlyOCV[^ӐĖWLNd+x &'< !;-)ȖWLNd+x &'< ىlyOfD!;-iNd+xɉd'bHND ;CRD ɉ08p))SuS?< ? Y?< wecHF C20l` IxdcHf`` @1$!Ɛ A60@l` 1$!Ɛ ̀1#Ɛ Cl`61lb#Ɛǀd#ư ! A60l` 1lb#Ɛ C20&cHF !A60l` Ix1$#f`` @d#Ɛ f 60l` Ix1$!F a(y"ٯ"ˠqm-$[C-5r![cLw4S'/C 2"/3v\wX Gˌ?VUxG{^RDf#ƽBOre۶Dԇey~]jYetPQ\De{ۇ4\_#epE} ^/zq VE C%$/|bE/?:%3ƑFE\F]ɵ$=A60l` 1d#Ɛ ̀恂dcHC ! A60l` 6dcHC !dc F ! A60$<1lbc F ! 1$#F a3Cl`dc F !A60d` fu^ lyWC60[^U0-* ̖yLf恢:lyWC60[^հ(-jc:ly-Op&l>JYl`˄5dž"c(4lM(ք^5ǎK^ P$ؚq~.x5[^?6ٚ-`ǎk7mF$ٚю~k>Qz[ꄶ~G}|?G^ c~^"֌o`{}5""@[(lM+m k-k,&bMښ-*DP: {L=x2H=I#XQ$I*H=ͣG4|6KG] e=O{hG"o9|OuD9ϗzcbD꺵˶i%Qi}q]a u [ A@dtd $Ȑ,Ѐ恂d dHE-!IA@l 6d dHE-!Yd d H-!IA@$] 2lb d H-!I2$ $H-a3[ C.ld d H-!Y A@d & O@dd $Ȑ [ C@l 0,!IA@l  2lb $Ȑ, [ C@l^@#2en@ =đ(2cy@`S$]v|H{8|O/G3. ϑݔݔ{^{o5jHR}|~F"oi}ϸb~7"{%G?9z'EZ:eAS"=ǒ_A3Vw./Ͼe"ێ{$ rWʟϱhv@ͣ$ < =,ȾG01\#N~FӟI2H=!1$"ȾG}!1#Ⱦǐ C+{61lb#Ⱦǐ C=#Ⱦ0| C+{ Idc ľǰ} C+cHG} f =W1$#Ⱦǰ} C={ ̾e#Ⱦ`={ &S0A+dS0;G0} 땂LG}O{)| {Y"l ʧdInHp # sYE vE "H@( #|OwpH=t%#3"s"sGG)|ϸLgyF}>~="Q|H{^. R=㊥5¾VRdT$p=u+R&3</o{ꤞߖ|xL{pqGPx4EȌH=ؤQCE/IH@jFHRdUdU,<%٥. ]h.Lv`K,s &$2`K]lJvI(٥. ) ۥ;v`Kyh &$2`K,s &T0%fd]* ˜;vIRd &$ ˜.LvIRd]* ۥ. ].md . ]2$$vI!AKd. a(%C9l.]dd vIuAHrNt*9'ArNS:rd@iGD)"3&Jt&GO5)GO ')2cak%X+\Vta"3JUAk5ؠ(j/ۺFZPdoǒՐCrȑl-_Fk^^$k~Vpu׺P\/[zr:~k"Zr##lH?+^js1ZU֪ydG ֪LJ0YfVZ9rZ)w UJM"3&ʑ&J6Ql D L!(A6Ql I2$#&JMa3(f 6Ql I2$5`0Ql @D 2$#&ʐď (A6Q@l D 2$3`0QdD 2lbeHGM (C2Ql D 2$%&ʐLTd9(C2Ql D deHGM!(A6Qe &ʐď (A6QdD6dex](2c!%8c1Q蔉rM+LE(CT13\ "|`rNͳ^Ȍsr[Ef"39 otR$8:YܶY7j~,8z`y,8:xclkSq:XpN=o9:q RJr4G9՛_wG./OrpN偶qA焋e+ӸU#HpNm#(]ƕX/:yuȌs䜚䜚s wS7;'sR`&* %Lu(A6Qd &ʐL (A6Q$~Dd%&ʰMa3(A6Q$~D0(A6Qy`DdeHGM (f 6Q@lD0(C2QlD62$#&JM!(A6Q@lDdeH&`6QK^gېMԒ6duZ:ۂD-ymdζa(%-LԒ6du ǒVgBKZB.+,i?<ʜZZnI+a9̮>"kiV KZx0KZxKZ-p{-ͺx"3W`)2gÖf]`Öf]𠶖f] Жn]z7ٰY<ذY~r%lXŅAV o/U1lX}J,/`<6z ?]Z#:SӃe9u&K9~~FІջKU0E P}EO/auຨX ze)qE؆RWx,-Ȝ [›dÚI4wlX6lIa9 lؒ [ҺySas6lI+Mц-yqCaK^oܐmؒL6l & [z@Ɇ-yqdÖ޸!˧%7n6l & [z,޸!˧%7.lؒL6l & Y>-yqCaK^o\0ٰ%7.lؒL6l [z@Ɇ-yqCaK^oܐmݗH6`6`6hNhN6hن06`6hNn9I NvH3 ;"xe Y4E\^Lx#2x3r{ uD&u uF{^:"^=Gdb%3† ,9"p@G$.Xrm=# W]#ulA5~c{=K2\U%:Up^#h"y\tD*Y=̟.?T :"pՓ5^5k=Vߟ#l}PX^#l  k:n\^"p~6\g:"댠j>f "pOuD& u uDjF5ߧ{gW>7@՟$֜MEKaͱ ñ Oؑ ;#; :#;!(#;!(#; :6#;a3:#;!(#;!82AvdDGv<;#;!(#;!(#; :6#;a3:#;!()Avd'Gv@tdDGvf td'%u@tdDGvBpdDGvf tdDGvBpdDGvBpdfG5OȎlkh?`rd{\ɑq&G5Olk09=~GɞsgM{Z%s0u2gWYS{ipƜiM?>Iެ)ޭ)lo֔lo֔xn/`TUuYm}$s6m׿|$svl^%iݽKXַ 5u܉Y_:dgfMy$s_9?-CDެ)O zdҤ9ۛ5囏Is5 ެ)ߍ0gqd{ZSpΆҤ _v@^YqMyhɆGМQȧOQl{\ɲq&˶ǵ,ת?!K=UBl{\ɲq&˶ǵORkk՟ת?`l{\ɲq&˶ǵORkk՟-ת?`l{\ɲq&˶ǵOȖmk՟(Y=UBl{\lV ǵOHM-!Y6All Ij e3$&Ȗm` @ed&ȖeSdƲ9–٘"3MlPu˦ȌeSdƲ9rݲȔeseSdƲ)둝Ddsf /RdƜ)̰~Ƒ9>^cQdƑ)2 l=7D>[E#a3n<"f3^m\Lޟz֟Wʑ9Biz^Ȗ'G66;x^GF;GuGȌ#s$`a.ٰmrGdbݰ#B6^^2D՜kW sd@ %ٰXȆ'?SrdGfHLpƑ)2qddG&Ȏ̐ ;2f vd II #3$G6`pd @ #3$%%Ȏ̐ ;2Avd@ ؑ #3$%5`pdّ #3lbGfHJJ ;2Crd ؑ #3$G&Ȏ̐YȾ ɑ #3$G&ȎL!))Avdّ a(82Crdّ^wdGB\wd82Eؑ#kF G Efl"36̑2pDl#e"a]Q$\sL ّU82Eؑ6܁uGȌ#SdƑ9rݑ)Y]Ar%#NI "ȾjzO:zq(Ҫi[Y(ɑ52AGVĭUn=E#k$zD#֡e~^"^"f/LG92Jrd#qd\wd82Eؑ^JpWe7u2g 9k?Qf̙"ɜ52c1g̘3GȜ ̙KI>-? ɧ5o)ȌOs 4Ai٧6OdfHJ}!Odf >M}!+Ai٧ O3lbf >M}!O3$&>M}a34CW٧Odf >M}!4Ai fŽN>m{}8`i[ ɧmq/&ŽN>m{0-1C@*ߚ}iMn߀fdٶfndٶf/pu{44gٶf/Aa[ΙY?-dζapdandζnu~6g[:0gGdΜmm(U9UIlt (ɜ ^9V~S$3T4gu~)S$zz_<"sl˫ߪ=-+9l9&)Y+I>֭֬Ο;09|#>mK-N-g|֬M=Ӷ:ɜ=G5wGTϖOs&lKkM:-?דlK{O\td[!ɑmq&Gw8!+-pBvd[!ɑmq&GNJj;w8`rd[!ɑmq&GNJj;w8`rd[!ɑmq&GNȎl;(9-pBvd[!ȶCoyCrd ɑ #dGfHJJ!92AvdGf ̐ ;2GuGȌ#s)2aGfxݑ)2s#͙"3Lsus6"9L,? SOl ɜ Θ3E9ki\7g̘3Ef̙#͙"9Sn^kD9\uDzsV?v'9G/`poGМHT^TM`Wmc=jWG6{ 5\K>mԱV`ɧ֝P >-ȱc>%O?W?&}ښwL>-u7ٚ0~ٖ"᪵ 9]=Jjy96;4Dmmveνi8ּsokA\O5GY_i?< smͻ&] {[.ּK!5R ۚw)LmͻZ.ּK`rokޥ@05R ۚw)0dյ] ٽyּK`rokޥ@05R`mͻ6%] ٽyCvokޥɽ{dfHMݛ 7CR] ɽ {07A6}$0>A6}y`XdgHbMM >f 6}@lX0>C2}l63$&ȦOM!>A6}@ldgH`2}h 3$'ȦOM!5A6}d La(>C2}l4G>EfL#OP$QTNO91}̘>G S$n>A6}d Θ>G>EfVsSd)2cn1}/un}ddZO`be\&M/fSMWğ2sTW}kV_3H2}unOjlҦOk{\I׻S$:_"p/%>Ud?e1}#2en1}\7}̘>E^7}̘>GWAUp9.L;G;Ef"dp#kNtzS$ٻY`{'8cwеw0ya{'ΐd ;Cw{'0 ;Cel I d{g ΰ ;Ce{gHN ;f w$ 3${'ΰ ;Cwl nY{'`wl &{W0;Aed{W0ٻ;N0 ۻw 'w4D0]{ǧxy:EfUE<]E<"3Np@'=]E<"(9;As!9hEL"3"sOW9W9ӧȌH2}eahaW^l;c$K>{0} o(uM_j ouM_zE}.3}̘׽}noH2}t"laWLJS$yj}:Ef֧IӧȌȜSdUL!9?0g*«^B!.̘̙̙>EcI/QE<ؤH3"sO_E &< 05 + Kd0Y@? zY`mdW0FA{m,l`3P@6LQF(ȶ`mlJQ^d &(ȶ`@6LQmcd6dK$hHQm!FAl I m4$(ȶq` @6d(8cn4ĶQ0n>3^ёMHxaG$xE:*b3B A4n1DG $H;L:r *2""3ёQDlDA\UEAO5NY_d񧞙FbG NJ$ 6cnI.t b~ؽ-A(A8vxِVd/ATd ȔAt b^w+q\w+4 q$WRҵ͹ДAt.L!&r\w̸BE^w$W_ +lFH0ۃ+q\w̸BE+? bs|SPWBAv I +4$5'ȮP]a3Bf v I \!BAv dW(ȮА\ Bf v  +4$WX0s LP]a &W(j`r &Wx 恢+dV0‚sPWX9WW̧QI IE漢" yEE+WgE+DEf =s"sQ6 obEfp"$Ȣ@#*"]6ȜWTN$H9^qSWEW\츣V/ mHu?c/ȻX3 I bE "3"lyHG &0Ċ8ŷy4f+ ⸛p[/6 oP==1C0ĂsQXdg bE bE "t`rj@ bEAl3H4Q& bE bE ͓<+2A ˜mH`a] 9ts!GIfygCyn&dE̤"l& &3Y0IAdX0ɂL 6%3) dd&Ya4l& &3Y0Ifd&YLf`2l& &3) dd&LLfR/Lfr'3iHfRͤ!IA6l& I 4$3)fr`& @Ld3)8c&n&11̘IGL ΘIGIEL &3ٌ@fS10uϴ"3f2|m!m(8c /Itmc(3ёQۨȌmtmץ smh~q$8z= kmc=Of/KH#xc=W?y$IT ۯ>m΋8 q\w$YzNHr2+Y_# pO;HZ6AGdA:rA*2 !)RpA:rA*ҐV1F)FG6{6:r6*2_"66FEfl#m"3Q](btxEEf"3^ё^QpcSmؔmTd6:BQm FC{l I mdh ĶѰm FC{hHQm Ff $6 m4$(ȶѰm FCl 6Ld 6 m4$(ȶQm!=Ad6la(FClgl#WQ$FrmTdfEfVstj8HG;HEA 8HG8"L6/ڔTdL*2c&!3)fҐ̤TdL:rL*Қo!L"3fRd&SGL$3y?Mta3yLH2u﫮y>d&y^= 5fd6[#Ea3I2S`&K%lO3u3H0{4kzfR`&ǭ/fR`&Iֺ?k_o5+2c&n&1#2e&n&1d3)dhHQpfdEfl#3ёQۨȌmtm)uۨHͣц׽"3^ё^QHݣW\xEEf#~bs+ƔWTd+:B^Q {ECx I Wdh ^Ѱ {ECxhH^Q {Ef + W4$(^Ѱ {EC +^q;W/`[E0y-"w~1E_Wܺ_{kv~ ([ omi? 6]bK (|V5t68if?fdù=J2[#ly!ĭ% q{l NEt)k b mySغQAo6_I!= >K/" +A qkx qxaȜA/ ny!3m~,zĭ%ĭEZݜGd n/Ali|n}C{+IrK{9ȭͥ9rvsgQrvsɧ0A6͜fwsqd>t[Őo%ns[ͥ'=Jr[KwA6S9-Mr6[K~n&mw~Lq;/,`[E0-"lw~1d_ 6nyd`[E0-bȶq;6%۸_ 6nyC[^/'x@'x@DxB{DxBD(ȶy 'x@gm<"6lHpsDmlmmlFGd6 xF3r6 xDm̯h}lAL8#x<"w]L2<"f򌰙Ld&K3yFL{6$3Ymʺ K[חW?I匰=H2p;0g䲙<"f\6G$ZL 3yF.#2a&e3yDl>fl&6_|m_[3򈠃#/gܦ"w~nsDlr=ʌt.Gdm:rm*26q\w̸MGMEfܦ"m6fs,x [XLGb di._6e)Hn#Sa3<OA6$ Ӑ OA6@l< I0 diHSa3OA6d<x,w9!5sB6k-xq&rw9a(5sd5tBk lR׸I]N@L&u;05tB6k @ɤq'I]N@'dƝ~-tB2lR ɤ IdjHRM!TA6j &Ր TȻI5$g1g"lG I }׍"3SYGdʃ:r݃*Bpx:rx*2c<{866 ߿u\^Y$YSXŬ+*c|?G,8~\gz$9֡׈.s$XdK}wjyͶJ"b$Hi s-j>uȌtGdb*2c1n1i-?G8rb*2c1G$Z9;u"3nvͣ$fܦ#ו"6 MEfܦ"3nSpb:rb*,f>u[NJGJEf|"3ґR\2$3Ld̘IGIEf̤"3fґfR3̤"3f2l&L 8Ix{3fR34lg3)fҐDLd3)fҰͤ!@A6l& L 4lb3)fҐ̤ IC2{ ̤ IC2l&Ld3iHfRL恂4$'fR$)Ұ(9HU! ;RS$]ٌ@2}+2+\#}e>+Ttf3=\_SYL[L;ƏHXLEb:s,b1 ^Qn[̺Z%qms$X]3}K-&\Hx#h1i#,f}9,pH=ZLG[LEbu֟uȌTdb3s,>[$Ί$Y)/ӑS9"SӑS0~_Ȍt}e JEW>뗗*2+a_>eM݇nnw>[>38byn>@;5c=w<ϻ+y { < ִN.kNs,NoɧXNK+62f yOo99Ȍ[~;w MyI+u\:Y5#8g״d׼ a3|kޅǐ%ܚw1d+]x\.< yd׼ ![5c w1d+]x y0YACl d+hHN!YAA+h VА$ [AAd 6d+hHVP!YA+Ȍt ɍȔtotTu+H!=ʌAT$ğcG%uH0* q;cnOG wQ$D;AUF$D4U>6dan4x" 7z`Ƿc1A\>#u1DE:(n1\7ZZQp:BPp*2#o {EE+ W4!DEf "3y)WuWȌ+TdfGͭHp`62 q\W$Wˌ+Td*2 aW>BCvr̸BG +dWhw\tw4B f\#jȮа] BCRsWh 79FG!ؿ,Ad)Ґ ;Hf v A 4$Y0;ߏ ALRd &)ʯ`r &yA 恢dW09ȂA ,`3PrdY09HAvdE"3t8Ȋ$Y09HfVdAV$9HY2QL4 ^qd+V$y:+}3Ri_GW|1I^$ Of ^QJmu{XzA8NܵS$y+HaW=(bw,+V\ooI^y]bEWIȌWHcWȌWȜWG&" yEEʊ𕉆3^"+ Yv=Dh}7J` 3o{ )"t+FW15ܖ푎6Fgdbq6jc$ic$m66jރs1B%_R%qqQ#,ϛ+F8Fzv+\Qϐ+jinĞ++j:&WT,\q䊊슯XNEmyEE~^8 b18br+*+\Q8Pr+*+\Q]oL8^}rEGrEEvEGrEEvEEvEGboFOk#I+ZrܨkamTdmt7q+ϷjswFm#-AsAHG5x-AΰБPca+tlK|騠F:**~kF:?E?E?OG;y:9gSds$y O_AAj jgAWk$"d R6)*&m߾ڨ66jS6MwGkhşVɤF:2iʤF:29Fz29FL/?dL Gg?O1:JV8b 5ұ1ҳBb H 5V8b*~?߳B|r[ugFzϗQq$#&ATk)aA.fE~c%TP#p#&1"I%1"IYƤp3t *H**H**XUPUБTPUБL1 }HRA*8GZ*B[* zŌkc6+vTP#"# ʀF:* zUp>-8 *%B'FPǂ8=Ϸ&)OR?>*8A F E-ADHPcbxKQ#A'C_^ w1 jy *8TP# svD'9 #ϕM#9=7>W)HGN7i_bi$8lt:D7ë5n<xw'=N7{Q;j$9ys:#+OWyaS$y#""cq 6=@lzlzMO#gc0[yLOMOMqdzK3b41=|PG6=lzlzQkL#lz=<9O9_Rhzm$ `kAb?#ϯHD|KGP5‚N D$Aߚ[D$_(Ӗ zQQ1 bq jm숻υ j#y.s%y.aATdAt$SdAt$SdATdAt,ĂXQ j#!A%GHYY?az,AHG=BYó * :>91D *v#Q#A" " # " cq DEDGDEDG ~(7}" + # ܊(; D$Ab?_,k{+twW\]qGpWDW\qEtW$Wt$APFFG!xHCHߊ #,}!KiHaË Kr${gm }o|K4o>6ZFXuy|Y Go#D]vk$HD>}I7n"?GOs|YH>e?>nY# [#A@oҷGXƧϥF_[# Jcg1H pH { PQWly|i+G HCcHGc\#+ "p+ *cq T *c\# #\# #+ *'P:*GVli|;G\Up* *FHci WD+pEV#XdFA1xWȎg+dGv3br3br3btH:ӽ"nzxƛIVLxƛIVLxƛIVLxƛIvd;$;+fgmdgA7]l+G:x6#pȊ=W<{E¯gW7=m<;H&O}w|ƙ MFzsiYABj$h%i#]G5wm(V{{E\#A5eGXPo\#A{#m<;HXgq|66n#Li x6o&Y#=m<}%Si+G6Šx[LVYm w䛉?MW<O]4]lxF+Ɠ/Lw|xgdgdgdgdǎ+-&Irų$gdgdOn4]񌷘sųy|xɊxɎX;쑎+[LH-&kgdgdGv3bcqgdOWfeL7^R$mt$mTdmt$mTdmTdmt$mTdmt$mThH_AmohGkFXYIYIYY YIYY6:>FtQ#mkbtRmsmHF#ϟmHG5F_##""s#-[WH2Uw~m"k"k#i"kcq FEFڨ6zqĞ6|I0GZڨ6z6jQёQёQQёpOёQQ1(hsmHG5#S?h#=ŨqE4n]#]Q#WsWHoKiaWqk$|~wEvENo ~u\=F+`䊿GmϷ%W˿F+Λ\#]Q#֯ߞUHH=5qE_#[#Y"["[sB#-+[axD+,B XG    *:>B+>l#v7VxZvd+< -+&+< -+&+< -+(nh ?x醖4m#+<-+&+<-+&+<-+&+<-;2ޖ toc#Ųb£yYQݯVxToG_K'/ M*#ݤA.0[Ѽ_e$A8{ӣG%=k$X_g[\>9v`[+.7{d|ޕryynIVH2?U0DtGo_##""s,#- F:*VA GYYIY * :>WAtT##vUw8 GV;ߙTw(&)=;SwqgJh;So#(}`Iߥ.AwzH]܃.A wރ2Gw{PMӍ'S:+HtʗwOnG~ ?D}%_bf|fdzwD1ޝo&QLwI%ӻ$|3cf$]L4;LL78~?3;LRnݽ#/1ޝ+QLwJ?kŨwkzW)ItIaA|ۈbr;6η(&m#tŇ.9]%:ݽm_ttttttttt#-8G;F9>w:tN#F; Hx\Br_>Fލ#7wAWc|Kz7#wm_N#AOe_rw׏zzyiwsw߰ziwywas$SdSds$Sds'?nE/1(("+#"+#"+"+cq V6@llOϕfDOӾ| g,gtT얜y乜i#gșG>_#˙#ə"˙"˙#ٌ-9s9HG4BrVͣ99T))9)9b9Sd9s|.gșGHFٟ'g3G3E3G3E3E3G3E3G3Ŏ͑y.gșG˙FXYIYIYY YIYY󁂜9>3$9˟a-9əb3i#HG4r\4ґ3<{i#gA9\+9Ë ,k$ˢaˢ͑dY?$ˢ<1( d^,A#}azO#Ư`|}t,k,k,K#lY1ҳ,t,k,5Ҵ,t,kS`#=#=HGHR+EVZJjĤVD#&1"+FRj5bR+EFZ)2jĤVŁZ)Jj5bR+EFZ)ZbTZ)E1'?"7J##=#=wLjj5bRZ)2bT+EVZJ8PR+EFZJjĤVŁZJVcVa{j5(#"#""#"#bGHKW+*>âZ}IE疥ei-ei$X²HF+Y`Yӗ,#hY.OAB#Ѳmp y9h$XGвpYFe&5, K}m-KpZ|m~zK5F'矷~Dz<3wo/cYy~Feϑey-+nR¥pi#\y.\ar$RdRdr$Rdr$PRdRdr$1c>P.E.G%E.G%E.E.@,\ŁXY YIf ¥Kx[5.t#/ߑˑKKˑ@i \$\,\,\ŁX YYIYp)p9>ߢpykĞpp9p)p9p)p)p9p)p9p)vkD=\4.<.p)p9p)p9p)p)p9()p9p)p)p9r|.\F:[5.<.$*٭^Gн- ˿4k|]._aL[Z.}  }$ (>j5P??çFRVg?ϳ%yV3_Sgi&?_>ؓi^#Iμi^1Iԙ7;DyӼ#ϙ7+&:DyӼb3owd9yG3oWLuMIμi^1Iԙ7;2iuIμ=^1Iԙ;~RL] IT)Qg=8XOμ=^1Iԙ+&:xG3mYδ1Iԙ+&:w$Qgu-ŁDy˻cGj{%M>H>>H>>>H>>H>H>b(h{$eN!QdsRdsr$sRdsr,HģH2'<7'g?#Qy.QHGKFHSUũ;DySUIE˴4RJԟFKFD+ABn#I-h xfм~  (|FSU@Oz_~𩹬kxa:~kI>5'%>=lH*<)wVŷҖZi7c9OϴaRGFاɧ٧٧ɧ٧٧٧ɧf >|J}ʑ8H}ʑ8H}J}ʱ8cq )E)G E)GO)O9Rdr@˧<>w|J#wdr$RdRdr$1#""cq )G E)E)G)E)@SS}J#=)5bO~$Q,Q$Q,Q,QD<,Q$Q,Q3D}@hN_"a""#"cq %E%GE%G%E%E%9͉~ikcN阓GF:6`'J#W옓GF:椑9y9icNas"B#ɜAse'2B91x `NF95w1j$?Wm9i$?a9as5)Uk$BiGF؜F{#t$#%J#,Q$Q,Q,Q$Q,Q?,Q,Q$Q3r HHX%ʱ8K"K#"K#IԌAYD)D9~RL]%Q!Q옓F:XIɑg`NdNlNlNŁ؜xٜٜɜٜ9)99>7's*X95#]wds:uG6#]WLtɜw]1ӑ6@ќ1ӑ7;9ycqdNGބtMlNGބHӣؚnMHϜt騶ӑgs:.uǞ9ݭQlMaNG5.AHϜbkӜbkz#oM׎Gp>H0'|J#ɜ~%s*^~0yx xF}~9o%4s:#9KmN4ؚ騶orMs:ſI?~RݏdNGޏٜݑ9y?ќ]1ӑ;2y?#ϑ+&s:~tdNGޏxݑ9y?b2#Gwd9MŷS]iNGwGț9y#ϑ7;9yb2#oBWLtMɜ ݑț%s:&tǎ9&!܄%nBiE4VDsZiG ќvsZIi| 6xVDsZiG0ќv,"ӎ`N+9"ӊhN;>6'$sw99dNFGn4<`N՟qW) #D}g5RJyHCI^aFD=% 4$J˵矵b[$#H1V'VcZK>cFDN=~I敂S#LJD$QXm$IxMu ̷ͽlo_/I1=XHM %K|lNk̩1SiE2uiGХQVD]ڱ8Ҏ9+.#"Ҏ@K+."Ҏ9+.cq ԥ.#`ΊK;.).c>ҊK;H%HbH6%Bڱ8*Њ@;( "*Њ@;BeETQvZh@@+@=_"Ό,;?l8wb2;n^1zdrǭ;ip1o ۷wdù%ùp}{G6;n^1Νo=b'w~,N6u5{Zs7wri'?M{sCkƱ2wɍ`HrX9GeDy_b'w ;5k$ ǝwr'dN95\voЄ8o#2;*۷ 2~r~q;oNx[>\.6ur=q;mꮿDHe1 ̝vrLwܳ#[l{WLr=+&kZg{|h-wܳ#lȴq=+&kqZg{G;ޑ{WLr=+&k6QKdڸӖld-w|b;n^1Y7_ȴq;qZzd-w|b;nޑ厛w,厛wdkӎ/N{.| ;(8((8m(8(1(X#ц"["[#Y"[cq EGEGEE2Gd#ϭE#ZPt4=S)sHG`4Z*y* ڮxe|v~_F_Z#l-HBNh$X 2GZ7o,Y GZN4HZ!G/?X KGZ׆[Fmx'k+lk{乵hn,tލG F:EEGEGEE@,0,0,0$03q HHXƱ8 " #" # ̌A`Y`(8x(8x((8bq,H1cGEE@,0,0,0$0,0ŁX`Y`I`Y`I`FL~;(8((8x(8(1(#" " # " cq EGEGEE3GZ\#I`?#0!P$kF 7{xIkskHZ4ұ5|La$kߒk$X 2G>5I#h-' 2՛d-:y_~7?Oh-rZ4# !ɯx乵hc-se-yn-XGZZZ6ZZZZ8m((81(X"[#ц"[#ц"["[cq @l-l-Dl-d-3kQdkq ֢HH֢Xű8["[#ƌZZZZ8m((8(8bkQdkq$kQdkq$k1[7rō;\q#Zxd-WHb+n$1(Z7wdkF%kFZxG+n$^1YHh- W8~\F굄]WSHeF=.s57\i#c㾫==LK^ {xaDh$L++HW=8ʻ}k=SC ~Cok^#I`Ɵ=sF??aV!$ɟQ`5.L#5ҹjtJ\ic+m<9xG+n^1 7抛WLs;\qs@Q`9xG+nޑ㊛WLs+&\qs W# 7抛WLs;2x\isqmI`w$0Wb+nݑ~wd\qI`w$0W# 7X( 7s]_" ̕/ "xh#09(v#o_#۟HG`PEGEGEE@,0ŁX`Y` PEG EG EE@l-ŁZZ6f H֢֢XőhCEőEű8["[#Y"[#YˈZ~ekQdk1Y"[ˈZFL֢ȴ1bEb|h-L#&k1Y"[ˈZ%k1Y"[ˈZZFL2bŎF֢hc-cg-XlHEɨF#(0$Hh'0y~FzF$3<CWUk$ )c$Lp1x_ԍP.dVI3z.HO`41X(0+FkQXYFZFL2bE(ed-Ł(2med-l-E1(ZˈZ6FL֢ȴ1b(J֢X(YˈZ6FL֢ZFL֢ed-L#&kQd1YˈZ%kQ,ed-LEed-#&kQ,Eicd-#&kQdk1Ybqd-#&kQdk1Y"[ߘh-d-l-d-l-l-Dl-d-l-3kq H֢H֢XEőEőEȆxMFXF:֢x:XZ4Z4ұ|bctT#UE#UsU#QUh!FXU tѴFXU hURHP|GXUO ?ڹVJ#IUgh$xoW@{;4Qւh$XKkCy_>`-.LzqyӐE#Zƫx<t#ϭE#=D7 0F# " " #" # " " cq GEEG8Qdq$Pdq$PdQdq,XFƑCƑf 0,0@A`Y` <Y` <Y`Y`8bQdq$1# " " cq GEEGE@,0,0$0,0$0#f9\G3oud9\$0gޘsycc>P3oULs捹,0gޘX( ̙7:yc# ̙7*&9sHsYl ?j܇ݍ̙6~l-/g-gژ[ύooeHhtnHZbcn3o7x gޘyHO ւWP3oud8\G3oULs捹I`μ1W1 ̙7:2xyc# ̙7*&9\$0gޘq捹 gޘsycb3oud8\G3oULs捹I`μ1W1 ̙7:yccq$0gޘs捹,0gޘ{KHHHH3c| 0,0,0$0,0ŁX`Y`I`Y`I`Y`Y` i GX`p$'m4<8>tF#A`<t#$0H=\`4L|.0s$ ]tx bAh$ <aM* S)A`pGa$w|yfi$LiWsHG`<\`49vqdkg[EEG EGEE@l-Dl-l-d-3kq ֢HH֢Xű8["[#ц"[#YˌZZ󁂵(8m(8m((8bkq,֢H1cGEE@l-Dl-l-d-l-ŁZZZZZFLr>8(8((8m(8(1(X#ц"["[#Y"[cq EGEGEE|*GXUH4B<8>$?):~5I#OhGx nUˣ5T}騊GiF̋~Vx o nRHP\ϫ*GU>.AU&$UiTeMU<\U4QZh˳F ]XQGP#ud8]G#ULr=ZGW1Yˑ:2my#[ˑ*&k9]d-Gޣȴq=LGޣ{tyb#ud8]G#ULr=ZGW1Yˑ:ycqd-Gޣr=l-Gޣ{$Y#Y"[#Y"["[#ц"[#Y"[ˌZ󁂵8m((8(8bkQdkq$Pdkq$kQdkQdkqjYG[FZ;֢֢hc-yn-!k@?HO<~BE5<9R5I~Bx.yH|GO?''A? ~/{O~MH#?s?HOPEG EG EE@,%ŁXJYJ &YJIJf RRDđ`Bđ`BDı8Kcq EG8((8b)q$Pd)Qd)q$)Qd)q,RRHRRHR2b;ud)[G;ULRr}IJV1Iɝ:E)[$%wwRr}Ły߭#ĝ:y߭b;]Kq_I4k1p~[eïwU6ŝ~lw?6]폥% .džߑblM.v]Iv1xDH#.9]2XwŊh;]v#Ŋ X#.W=.ŎnEh4Dc4Dc<~7iy,1^ߜHC4k$idhУk$I:GӵCk$,W#('L zh(^hHC4cX#I479 {;h|`+]v#Ph;]v"ŎŁ.v*XbE..vbXbG.v*XbE]XbE VDBbE.VD`E VDXb@h;BXbGE.VDXb@h;v"Ŏ`+]XbE.VDbd{}N&p$Pdp$PdPdp$*Pdp$Pd1؅c>P GE E G E @llDlDll@.](]8](]8](vB#dH.=Ocر 4IG.w}؅GIvAIvo1}Iv1W|a] Dh$ F.גV`v< k$8ع=]/ٖ]x]hcse!Pdp$PdPdp$*Pdp$PdPdp,vHTvvHv1c |`lDlDllŁ.](]8(]8]B1(؅"ۅ#Q"ۅ#Q"ۅ"ۅcq @llD3p$PdPdp,vHTvvHvvXB‘B‘blWd#7vqM+&&]\q.t|hWdb+n2ݑ⊛Lw,⊛Lwd*& tdWdJ;K]\i;vqō;]\nQv‚=ұ-ʿ]ic ]쪶U{5]\Q"*SyFs7l쑎]\QZiF]=vFHCOgr XiF]C"G:vqU[D7]\ic+n]17Tp͠;]\q3.tdW b+nݑ⊛Awvq͠;2\q3LW b+n]17⊛Awd*f.tdW b+nݑAwd*f]\q3.tdW #S7vq͠+&f]\q3.tG+nݱ8P+nݑ⊛Awdfп_{f..... ...f v‘@B‘B±8ۅ"ۅ#Q"ۅ#Q"ۅ"ۅc>P |`ldldH zOa"H. ڴ 6*tD#EC#sHG4HK4P E GE GE E @,ŁX4Y4 f HȢȢXEÑAECEÑDCEñ8"#"#ƈ,JgPtI1bҏ~(26CcĤC1("cÈI?FL1b@I?FL0bEƆ~C1(b>Pԏ~(~CcDǞsh1Y#=H9Hp|^#=H9HrzG9#9hF*xG_>FsUPpGbEvEvGrEv@  @9s(s8s(s8s(s(&s& ΁G;F9; D#s$ ty.IA\$ HFh[q8i9G999999999s8+(s(s8s1(8";#";#";";cq v@ 3Pdp ΡHHΡXñ8;";#Œ9999s8+(s(s8s(s8bPdp$Pdp$~Ep|8G999999f ÑXACÑCñ8;";#";#";";c>Pp|W$GMM IIu<t#'+FOF+a? y's~t#'n?a?!rH$?b<~BKE5 HEt#D#O2<td#'''''''''ŁO+OOOf ~DđBđBDı8cq EG EG(8?Qd?q$Pd?q$Pd?Qd?q,~XDđb''''ŁO+OOOO(8(8$Hp(vdD#'#&?1"sňOOFL~O󁢟(2Wd''#&?Q,d'#&?Qd1ɈO󁢟(E?1bOHO411opM?HOH{~hY#OSD#| E#O|c3!H 0K nHFXJi&$)_IJ(%؈FRiJFXJFLRR2b(2LDd$%#&)Q,Dab$%#&)Qd)y(%@QJFLR01bED8P@IJFLR01bEWR2b|(%#&)Qd1I"ĈIJFLRX(Ibq$%#&)Qdx(%,%#&)1Ibq$% #&)1I"KɈIJ%)1I"KɈIJYJ,%S=/Is)HGJI#DOd"7o*ig"wc5ȝv$%wyބRRR%yǪ#ȝw*&Ud"wޱL;V%Ud"wޱ&r@DcՑ ;V cU1ȝw*&Ud"wޱql"wޱL;VyǪ#ĝw:2AyǪb2;XUL&rDcՑ ;VDcU1ȝw*&Ud"wޱ&rŁyǪ#ȝw:ŎUc|I&&Bhc"!QdQdq$Pdq$Qd1c>P0G"E6E6G2E6@l"l"Dl"Dl"l"@D󁂉(8>$阈FDo-)HGJ<\J4Rؑ<$)mK =Z2GZR %GKFxO\HT)ma)oiHz#(%xF_LIJo?wh$HI%%H RHRRHRRRH0RHRRRXđ`BDđd %@AJYJ &YJ &YJYJ8b)Qd)q$Pd)q$)1H"Kc>PEG EG EE@,%ŁXJYJ &f RHRRRXđ`BDđDı8K"K#I"K#IɈ=)^JRxDDđ`BđDd %@AJ &YJYJIJYJ(8L(8L((8)q RR 4s)HGJ4ґ_~GJ<\J4BRER##y'I~BWx也̑h'y'GOhF_PkI~BZVG6+cu&r}LWq}DU1ȕ*&>VG&+cud>Vd"WǪLX Ց X\yb2+cUL&r}LW&r}DU1ȕ*&>VG6+cu,LXDՑMd"MD#""#"#"ȌD󁂉8A((8(8bQdq$Pdq$PdQdq &LDM9 hc"yn"阈F:&O&Rhc"I&Bk"~qI?θuŤgǺc>Pԏ3c]1q};Jq};26q뎌 gǺbҏ3cUq}+&8>;>KǺFzq6Yc q}!5_=[ZH]2{^x6P$kgsKI/8bK+\]#DƑ~=}I&R%a"gT#h"$bKkcG|z$iJYmiߔRr-+F)9>qIJθuG3cݑXWLRr}+&)9>q,%gǺc>P3cݑaXwd8>qIJθu$%gǺ#Rr}+&)9>q gǺ#XWLRr}+&)9>&θuG3c]1IXWLRr};qŁq,%gǺ#KYcYOЏ,y'GOOO+OOOf ~đBDđDı8"#q"#q""c>P|''A#ls?HO4_~O< )H-#,%p=HGKiIFf==4#(%H8 R2 5RKoKɟ6KF:R3D!<=&Rc"yn"a1#"#""#"#""cq 6G"E6E6G28Qdq$Pdq$PdQdq,&XMDMđBMđLd`"l"@DD D DD8bQdq$1#""cq 6G"E6E6G2E6@l"l"d"l"d"#fN~sHG?-`"vt;4DHgsG:&i &A#l"xFa)^K2o,H$ "6FBoD~zLR3tLd$yh"DDFL&2b2E&(Ldd"Ł(2ALdd"l"MD1(ȈD FL&1b2(J&X(ȈD FL&&DFL&Mdd"L#&Qd1ȈD%Q,Ldd"LMDMdd"#&Q,LD bd"#&Qd1bqd"#&Qd1"3_8>7tL#d"l"l"Dl"d"l"3q &H&&H&&XMDMđBMđBMDM1(c>P0E6&x义hc"阈GF pxQF:n#cj֏|C#A?XgL;1-hܣG1GW0$ Ð A@l? I6daHc`? @~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 7nH[1㱯\q;9m5y:֭N=[vO3nGyMގ$neq~woH8z5y9nQU ymƣSM̛ ~OA&1봷9?u{inʭG]/Uh[?)ih ÌyZ2~Վcݏm:~涿Ns>#ý~˼COGA~L}yo3dM* p_ ;xSnSKE^] k*蟽[% }}GXc~ /ףτqxfU~>5/uR=gOEߕ];RVАE ~noh_i4G9ק>y +x<SsϼOx97 Լ%rτgx<:~(now W=ط{h*G;~Ts\봇5I}Rpˍτ/}^oq3͞nlMCzק6_5uxI:%^7iI紇:{gNyM~&ݔ !g:'Xq~5=^>zx~Λqcx寃x\b瀷?8ʽxӹ=VO70b5O;\ VsI\_/q3n_gt}_vM"5܎7^Ozz\_|m<|=ן_G__&߿|\~{;.=~>i={oZ0:oǫJ3?z|n__?ׯsM˨Zp}]voUkzo?>ù:`)uߧOVEtz=_g]qg@[?siT_S^}ӗ9w5Oϟ}㸗S -?;g~9(n>s׿R?w~Rwvw#9&?::T~&Iu({ 3;~]SGu}Q?߸'IR_Ƕ/gxP6z@1z{?^leϏO@| t;N{!uB߿Tpx}^WN:`R?OSÎz\u@o 0^Lh=zVXzFp=zt"Z8P<=}#>Tl'S;!vp* Tlw !9vBTlwgOe;!v@x*6l'SSNe;!vB<Tl'SNe;!v@x* T;lSNe0|E 0$ . Av6 0Cނ z d` .] Cނ z d` .0\ CޟY  d` . Av恖\"T|*].@ԼG`U]^z;*vH: R<: t_G ]GՐ {").ۏ"2{]EV\,Gw 0$ .@]!UoAv 0lb`H[] Cr` .@]!UoAvT 0lb` .@]!UoAvT' .@]a(f v z d` .] C`H.@] f vT 0-.] f v f0 .`r\ &P0Av lJ.r.\ WL.@(f & ջ`r\ &P0p]@M .O%EȊ Hr &P0Aq &P0fzL.`r]`(r.\ WL.@(f & ջ`r\]@@6%P0A (\`3Pr@L.@ dP06% ջ`r ]0f & \ L.V$`H.@]!UoAv  0lb0apTRd .]a3AvTRd .0\a(AvT d .]!UoAv  05X_fd( V1G\3 "l+F"JfẺ"h)`Ǐ(lh4K4FFS 5w݌]lyc!-olLbF.ѐŖ76恢FCV[hȪ`F.Q0-ol4dU卍 Q0-olLbFCV[(Ŗ76 &w卍]lyc!-ol4dw卍]lyc`r[(Ŗ76*Ff.Ѱ(-ol,tcr.]*dw!܅ f vwaH@݅!Av. ]6dwaH@݅!Av. @]恂dwaH@݅! Av. ]\qwu]a! ZHp|Gp"^@vnbGsVO?Wg=5~n\~#t?`R6KE]|ֿGh׏R:>Ev;awq)-q;Hp:'9"]yE3E}YrC`8ây Xo)aKaHB- [ Cl) I dKaHb`) @R0$) Ȗ [ A@l) R0$) ȖR0Ka ĖB-!IAl) R6dKaHR``) RdKa ː [ A$R6dKa ː,El)dKQ0Y A(, [R6%Kqh)Y LB@d) &K! ,`3Pd)P0Y A(,`(Z _u]ρmaYϱ2A&U=Cy=Gri ##<z2Ѽ\DQ0ُf5ȊHl? &Q0AdP0ُ~8`yh? &!Ȳ`, &Q0fd?( ˆ~l8`E! Gd?Y6L`@~6%Q0A CGd? &! ˆ~LCeCd?(`3Pl?n0ُ#Cl? I6daHCa3ۏ 0$ Ðd A@l? ~0$ Ðd Ay`? @~0$ Ð A@+Ñ"1Cps8B: F[#l4354Eј t9FCWԨ{"P$:U"#HO*P$ <"l4>~9F~Wsy)hTzAQ9S$or~G8B*Fj? j"h+>]\tF=a+ȯ%h&ьF~yDѿH9sdaHZA= {Ca C=!iAs0lba ĞC=!iA& C=a(xf 9 I+da Ğð= {C aHC= {f s0$ Ȟð= {f 9 &ϱsdaHZA= {C9 sLA~d\#~|~bmOW| AQ7`?G?؏y֧˩*T%OW>d?G~4~גsyXr"8Gw"8Gȉd'bHND!)Av"D ɉLa(8Av" ىd'"Nİa3;Av" ى08Av"yD ؉1$!NDa3;f v"D IAL!9Av"D ؉d'"NĐ ;f v"D ؉)- ;ɉ(HDىLND(9F'" `r" &'R09fD) +ɉ(HD@щ恢) ;ɉ)HAr"@Y6%|8^aBIN`p"(NQ1#щ;~/U$8$Yq"Y9#đQ$8\ȚQq".O>?OiHuq NʷZHp"+ ")BRE;^:\;Fy!OINOrHLNy-Yt" N)ȊȚQHD &'"N`r" &'R09Av"ND0HDYALNDDD &'" `3Pr"dQ09AVN`r"yD) +ɉLND(9fD &'" щ)HDdQ09ɉ(`3Pr"lJND&'r3,5$'"NĐ ;Av"Dى608CRD IAd'b Nİ ;CRD IAd'b N0 ;Cr"D _H:ULI2G'3Mhߑ?H2EZR9BE0fZdIȊkqOF(O'2b| g駤Oߔko;?ϑ?Qdŵ8ҸR4Xp-s<~k#锒K]|(?=.THd^#Z\Sk}ZA2#ɵ4OZI$ג_Kk/KEZbt-5]KN%E1$#Ɛ A60d`& 0 Cl` Ixdc ư Cl` IxL ?s}eF3U~Eհ ) I^zT/"'/Ӽ\D/_ǢɯˠHW$yf΁d#H3 ^FL2Dd[#ȶƐl̈́恂d[cHrDm!A5lk 6d[cHrDm!ɑ d[c ưm C#lk61lb[#ȶƐȄd[#ȶưm!A5lk I1lb[#ȶưm!ٚ֌?֐mc Y?V0ٚ &[3XdkFkrd,GF+lcy`5#5d92XC##LfF[3XdkFG*aG5ŸB f'y#dvEfm7#\s8#ͥl4mFá (pFvu_pj-ks}ߟnK&|K5 . ΋l9&Eé- N=R%9/Hp8u.7~#pp"ԩE2Xp8)*Ѫ_E3}+Lr8OI_io쌼f)g*? Of#riF 4v]dFޮke,]Fޮ+,uy`@#o5d2v]C.#oLh]W0Yty`@#oLh]אu ]W0Y & 4v]dFޮke@]װ(YL^ 2$ $Ȑ [ A@d60X C.l Id d Ȱ- [ C.l Id d 0,r} cHG0:JWd8Qd8:E™=̓ӯASd)%o-{gr=Z{L:G䗟{{|O~'$Ӽ#oLA=Rd)b! 4a@d 2$"Ȑ [ A@@l  2$"Ȑ˄ 2 d H-!IA@l 6d dHe`  d d Ȑ [ A@$]6d d Ȑ,P`._@wh -:!Z;lB $A-t9!Zf @w h !H:!Z;<ZpHvF{mrFBOActd8$cԌT3{mctF zo[3B({&p+:#h\3,P2{4W4X@u ?z3/itK|SxHgg4Dϩ'H@͗:8Zyq+,܎\Ǜ竞"h"Pg$X:49M"kZy;{,Z:B,X3Bi^nW|=:!ӼU{ԊGt% F H@whNA-t9!Zf @w h !HA@'D ty @w h -6f @'D t ]!X:!Z;lB t ]Nh a3Zf @whlAmqt& 'LhO,7(!K-nPC.[ܠ|dAmq ;d weO,7( ^Y-Uv[ڶ9tni3ں ]@[9Ԓ`~yC#?[>Ar}6"+ȚGښt3qGa^!w=OQ|Ŗ73;x#}{]lf;gSϑ#͝F鶤uzz(GHe??EH|׭ .&~G qk634푶wY#Ҡ3<]kAlf+p6Q R~v)%E'Lv)3%ԼG2]j[K[,ڥ-nCK[}d.mq; ]v;lJviۡOC!˜-nC9[}d.mq; ]v;d'LviۡOC0٥-nC9[}l.mq; ]v&w2gۡ(٥-nfdzd>!%AK$s. ]2$$vɰ҄.ddH2G %f K@l.ddH2G %;pv1 "G9w?kH4F?E13u3Sɞ"hƹ|aacIƨyZcOa>vH2F*acD)럊c"+ƨ"J z^}F1 I4FM ƨ)kHctD1dcT0 ) LH(#fd &c$Ȃ`2F,hQd@ 6%cT0#A41*`3P2F@LH1dcT0 6%c$Ȃ`2F1dAS0#fd &c$ LxIȐ #C4l1dcd h` I12$A#Ha3#f 6Fl I12$A#HaQ:vr$=OIDGȊ]r}HKGAvN+ɑ?HڏDɑ?6#95?%9'(#*g$8'<tN ΉmZUqJEsT.u=>:mw]rRTw,".iE[/Kuw+vGO9v)]xAX`P)ڥ:v)$ԼF] g)5tKIVoYK%G^Rv)蜒RM (C?l Ide &ʰM (C?l ILL ("k>MV O{7p͑)*\5G;ɑ #;I"OrdőU$92#c#ӵZvd|4G/7O ^C`'9B7N ]ڟȂVHrdt#E**Ž{3sYݽzz_&?%92\x:晼AGUEYEV6B9*Bذٰ0E؆7dúB6p{U$y|䑼WS"+ޫ"{LKp{Ud{) ?@wQ^lOޫ`^ &%Ț{LK0`3P^dT0y{ 6%% WY30z/A^*`3P^ &U0y/ALlJޫ`^@{ .Hː {/CL{de k I3 2$$Ka3{/f ^ ^x/G{ x/EV#&\^3W #.EV #.Ep 2\IKåȊr .C2\.7?WB.ޓH2\ǿ?7LݯK`t~c|5~J0\ۼ6_)wr4\ϥT?/ "+ˑp=*Ep&EvYt"|/_oI+B V,EV\#W\"+.vYpe9R] ,]"e5upY+.K,AvYe:deHhe恂2lb%.ːԑ ,AvY@ e 2$u4apYe 2lbeHH] ,CRG e 2lbeH.`rY?!vrYe:d%.ː\ ,f vYeHH]!#AvY e6deR$,<p\Rde9B.k%,:.T]`pYxt$byZ)J0|Ŕ#MbkeRdZ)b-Zݽh5? ׄp+byp) W=O4\h n ; ^4\xF"pgAUweq ޥ.U\6|֛#.EG/xQR/K0\uW$Zϱ9*byp)†K0.tO].h.EpPҧY~"p5gpʛ%K6\l 7\$Õҧz{)Yl y#9 e&>͐Մ O3f >M}!+Ai ا6OdfHj ɧ Odf >͐ 4Ai٧6Odf >͐|ZF?o>m󆬯F?/|Oy`i#7d}5yCW#L>mɧ^|Z~y+!˧#v#6&YOhFvMG;H; {Ϣ{ͶY3r#m7\j#&yf5O7mOYtcuD{WEōn=ۻln4y}w#oU u҃y=Mwn)]Izڌ=G#r2oKwrL` s)G?ػw눥ڻq g'Hw^ρtdލc ?#WE7OY9kM57fNom@rz[fn~l鍴?okNo}kn-Hnknލߐe;yg`w#Ln,F/;yg`w#7dY6~Cw#Lnލ_0ٻw,yga3Pw#7lJnێ13${'ΐd ;Awd60;Cel I d{g uHrz;=ϜSd9Bg 8=EV#&N/߫KNO>sNp9% N+WTϧ\wE,;"+Nw>*RG&᧼fd)BFYqo{+J}m/1st"ի&zGнM2Fpy)g}q.LS$7< Nrk6/]MӴ{׷2u{z{:@0ucdɽ9-?ܛ#ltoI#W,#[6EV,"l Q'6J[6EV,"+ldEldeOlɲ5ïX6G޷lX6G?EP? F?dtO'Ȟΐ< {:f t I dOg Ğΰ= {:CbOgHN= {:f t 3$-&Ȟΰ= {:f t &O7#_y< {:CbdOg Ğn I 3$O'ȞN=a3{:="+NtcG"+NOHKxt{:At}#Ȋs\~βS$yYv+NO*βâ;db}3iXEtx#;=EV9NݓS$8=iHpz${+N{/OO~pz_?U ONiy)y5~#;=Eӫ~ntzu0=ܯ4Hpz>_bFӣf8S$8y'NO4s _9Eoa#gF..9E{KFnF#9EV"d槬;GPjuwSd9S$8NNN/?"+Nϑ"+NRh'Nϐ ;=f vz I dg Nϰ ;=CRhgHNO ;=f vz 3$&Nϰ ;=f vz f7U |UCVh#_UA09 WULNo*B F`rz#_UA09fFB~ |9 e+0C]l|] Mh7t]ȦFs&%ӗq5\yR3 {Țj O*r#+o/n4Wv~J2}Kɦ1- o^>hF.7Pǧt"hYW N,JcOOdpKh쀟ud:Oz+sE&zkݣ͕͕g͕슄rE)Fރa#]pz\ԑ+8VȊ+͕ p t x tef z\cz?;'gLHW#L_sw`dG Dao+QJ|% Fa3P#_B0DaȺm+QJ|% F`#_uW0lJo+Q6%7( &dgHM ?C M!6A 3lbgS$?zUOOȊs߄Kϑ"avEV>P 3[qBGoʹoY1sWl~F>G3^0D<#DEV #h%ꔼË$X"N^" ^yOLH0YO4( K ; |*\awC+T-+ܪ^??+vz>G߲'}AW8[W#d \XAG@C6}$2Y1}>GMd  w%ȊsTSd9Sd9壓hL_3؊Sd9雑`" g+(VА$ [AA@l 4$ 7ad 4lb+hHN [ACpl 4lb+hHV`|= C|= Cp|= dz ^4iii&+xMȯtuMOY3|Exmu:]l ^u:&\4:}hu:s ^wt7 ar\u: ;BА!AhbpA/hU6vW`qm1})bU62^LߵƘ'Oz jꚯuM_  E倊sytu*$W7^cD3y+*"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% az#7Dѭ gw 7L EQ7?=w)bMEMǟtdt,ĶȶHbMGMEMEMbAlDllDlł66m:ml>6wDۼ#Ph;mlsG; BTdۼ#hwmsG"zx II4sxw:hXg#p # G@<;yii|9=ij! Y=I<JC7rrWE8yǞAjcs$  gLdx|{&^S&52 wgIʲNHG&d92G#(1~a3ӾL;|LNHI 2S9B4729GL‡5d2QF*/)I2 쑞Lj#s'AJ{2L7?T{^׿>{0)FS9SL~O15Q9*=^Ub~\~h*F:\;GH1mΑmΑdL3&ۜ1٦e:&T,lsdLmSmsd3&T,lS)qd3&TdJ1٦bd3&T,lSmlE_MGMEMGDEMEMGMEMbAl+t$Tdt$TdTئGmS#6/GmS#H6=¶I4lyT(FH15ϽR#}&H+=rxGνR#䕎N^J{F++++ϽrR#ȹWjA/^䕯I^9GA?>c>շWj$xBuy55I#+=^k>c_x|>c+xGνR#+ #J+5J(GW_H+=BؑIˤFX&;2!u9i$IS-iɤG%ȤGiN#I&(cI2Ld#ߑIL$շd-F:G#dш2֒IAj ґO R 2 A*A: ґ R R ұX#""#"c 6HE6HbAld3&A:A*A:)A*A:A*A: b\1#"#"b =`4 z 58g? 6VfmThFHgrŠ쑤g-)&A,8z ;]1\Q#슊aI|'AhijsFA6Aj$DH0yk=>G_OX3dj#zi r}ٷt~IIȹAjcA՘W/6152HF:4HhFAvK緑AzNci[>u #HsW#ݑų 2E|݇F4NGιM#o5qEt\#qEF:vEǟD hĵ#瀪tocX:+j]ёO]Q]2+*+:\ё\Q]Q]ѱX#1""#1"c vEEvEbA슎3fW|rȮܑO1#crG<-g䊏xZ;+>i9;\Qށ=3t_GuyTgߐG:C'z'TtcO ,!X|¢LoZֺ#앏 j =|3tەGqN(b>3tg/ߴm>':Nk$'B$P(N '$|'ZzuX=s<9/^ǥ|xί2[W\|9yLIHX&,HG<:A<d$d'$|'?Q<OȷFx|4OֹGX< u1#ShF|3tTعR#=|T?[Av9[d]{ssGd{㠏:HA:ՏFrG:CDZ砏ⴜ頏 XXrba=}ēu'O19#crG:;&}ēuvL'ܑOֹc䠏x%}ēuVLuAAAAAAԑTԑTT9wPt#’ҟP;F:B:zn9wP:7A,o\<5Ot#⩑$%6;sHMd|;S#ȹbjqb⦂I9QC15s.1u6AŜɌo#A1eјOkϏT)zD?I1z0ȹbj9WLts#{]jAkIIy{!xj٦G6;Ms[|f5u/u:TW=ꊶ9WWtu#ꪑzՕ>R]uGOHP/]3,V#lX5,xHk9WWu-ޥDu-QW:dGG][l/#9?H#$39jc9752St#݇2S^#d|㹃j8GHHbpPGrPEvPEvPbA젎Ď젊젎Ď젎łAA:Θt䳄AG>Kȑq䳄|brБRL:YB#%:YB=YB( ls)OrM<#l5 (N# 9ӈm4`{G*ۤhM!<¶Ij$f{G:93tM錢,srGh[d:(igd#Qc4":bt[HzbtcQT,>ye)J^Y}Wt>_95H#=թAyaMS<}=?=ʑrLws4(f&#;TG4"GV̑O#RL9iD+F4"Ť#FX,()ȧ)&4"GFÑO#r,sӈ%4Y1/otMǟ~;4HHX,s $,$,ȹxjszGS#,I~UCU#W׵cW55UF:{G5|CF:s_HǢF:|_siU:j-֑,vŖzZXsHb=B^|^(Zl]bUL[,!Yldsӱ5wT#HU#uk:ꪑzx+uu$uUduUduu,DZbڿ|rG!h"k#i"k"kc \G7zd$u黣""#"c 6:*:**v#hQ4^6balmG΍W#Hx=rnke>h'1^皫ji?Ўz\s5ŸW츭GV#otV# -F"Ryv?V#Ih_O ~~Z@]Ox}ue0)5HZ#(xF*%#(xϰFЎ%9tF B["#B9Z:*v#Djke>Жj$|x#B[ w$UdUduʑ-'Y9 J{哬b|#[ORYUdU5-N*,*άV,Xub=ҙU*=•Ud^$7-*η ou|cbVYUoޠ]VՏFb|bj=VocWuUoE7y->*dcIt,*ηZcۻ^VYUo51ƽZ%_cabEow[+ԟz[= ;+x0k^_Gz{uϷZb{[VAM~hgWqUS+dz{zuϷc+YcSRt\t*$JSoV^t*$W:q-v$*ΖKIRXV#b/څ#l׃FŒz-v@z-Hgt,#btlULߴv#HGh=9ժYhIhWl G΅V#$ȹj-֑,V-V-b5ұXWW;HuG ;8FL߬dŋOL51SԑTTԑt`dllf`/D432St#DldllłLLgf߀l3#=3LgLff:c2SbAL_1"LLgLf:#[dޤ]##IGgF~cA5q9s9sPoyF:JsGFHr.JWοkπGQQK>F+OHidWy5%x|_yo6GW_|Wo֘ykaW^9G+{{z_}idu9~S#Ŝ#>m-vsS#3sbWiFoH'XXA5q9T)q3&UL$N9cx*2H;At$|js?G:9GmسMtlslslS#Mȶ9cm*m"fDFtп|o险F:f:Gzf:Gzf&*Θtdł*{fxwJfxn阩G(LLLLԑTԑTTL5Bf.UL:Z/;阩GT#3H2Szk$iU⽣InIFHR'9jUW_@ؑTΎ!JT옩F:zL5Ÿw;? TH0SŎz':vt#:HQ1h}uW߷vusut9ے??蒌?OrQN^U:;z\G55QF::sHGG5QF::w H7*v#$IgfrsfvL^993wd; J^993wd;2x̎+G:g1yH'8&옷^9y0or3^+bG&GqnKxŹ-v4m#=$#drXA2{$X} {29X+oI~1Xu4Q rZ#,K!'0 \||x͈ 9?w}$|DI~6%$ۜ{G.Fmmz65ls}ئG6m]I~ȹbjSq=r(GH1;VLs\#-+f~:Wbz\15ŠHhȊȊHȊX,SӑSӑsŖbjɋoyGνR#䕎I&xjHG&=,PLwR#9حWz+5Jt#퇟x+_:^AEJGJEJEJbAyNX1g)'9Mtl#Dlldlł6W HȶHȶȶX,mӱXۦ"ۦ#٦"ۦ#٦"ۦ"ۦmmz65ұMtl#dldll綩mz4ұMt>Qtl#݇l C#6q;ۦF:sHM(\[7ϴ6=y~} IGA#h &?\PGt`t=ws.I9%cȹxj$yL]sijJ<33G⠑xj#AJA=rI>Z:uX"hu/KiGT#tŤtT#łXGYG YGIGWl퀩s 阩GT#l3ΨH:qP\_qP#鈧Go#⩑xj#i? :⩑xj#!`Tdt$TdTdt<t}s|bG<=a`=I<|bb+أ'820^G+أ'(&=I<|b#Oqd҉=IG1yOqd=W'(6G:2y{I&"ݕq$|?x]o| t6_={4ȫ{bFzyuOH Ğ=#lW>Ǒ '(&҉=y=>3AwssmHG=BڨHڨX,qŠ{{łX6*6:6*6:6*6*6:6_#j6j!mTdmt$mTdmTdmt=I&$|bbg>Ǒ!Oqd|{L>=I&$|b#32'(&|V'_L>{e=G#=|{L>=I&ǎL>{GO&Չ=W{bFz2, `, f, 24Rzmcx8g"OKz޽Y3?} x,+睙c>צFW ;Aӂ4nz%2W>9>|G+X+9>oe+gtN$ ycO&Ğ~g:/K8ǧKהg:DZ'=I2'(&|{Y&bAI&Gg>ǑeYؓI&({S&{4dy,tގcguN,^ٛ2재L>'묑L>ueXXO&ddݑsӓg L>:,|bg:C/;dSdIOe;ɤOt$|{łXW HHڨX,ѱXk"k#i"k#i"k"k6#6j!mTdmt$mTdmTdmt>Goe5®HD F: zx, b:ȂD i GX‚ * * #[#ќ"["[c BbAlldld+P#+H^|K=raTdt$TdTdt<ȹ j騠GUpT#:騠GHI"a"I#[$Sds,zzxwGHfIIY YYIYޭΑLΑLNαXc ;E;G;E;G;E;E;s[#I#y-H~}Iz7>HлMC~!i$ݼoW~[#AHHһ>A+~Zzֻ;9)Ocy\4BzWD{C"{dolo|R#+[;-k)FHg-j)9j))9 bes,ʦHPHʶ"*c+~[se+"+#)"+"+(GΕM#eHGz|FڟIiAO/_%x|c~w^| y=- zE!0IN7Z~OO{WkzF:6Gz6G)MbbS4Q9S9MmƤll3&e1)bG^#Iيlsls$)"֌IfL6cR6bAI%e1)"+یIY^1*یlo1/- J6c0Eְ͘4L_iasasaa$zŦiasasa)h0EƧ͘4L5lƤał͘4Lasaa /4l8!i#i"k#"k"k#i"kc ְ9>)9>))9 b s,HHвYIYIYYJ#IHz)陋Oy}j>7FOh$;^1>Ϗi$2ylÇOi$*c~IݷS9JO!ii}?FFOMukS9)tvȹOiS!JWT!QGاߌOi}ʱxHSSSS>FZ>sHǧ4>H>H>>X,}ʱX"#q"#qЊ٧O9 bRdr$RdRdruG}J#Hǧ36$ oG[#IcuKGXXKOi}ʑ|J}ʑ|J}J}ON^H6H6HHłؑ#)#9(#9۬I1/(8c v$Ev$Gr$Ev$Ev$ǟ _?#bH1HG7?gį[H?LO_㌴{_J{F|~nzH{ʿE+#gw3~{Fڹ-2G#{+&yv=#Ѯg=WFޣݑye=bvXwL3^L&#葉gT{׏j/@G]F5-cRw7WL 4IFܑh%yws5Sw7@7)#)"+#"+"+#)"+c V9(9()9 br, H H 1/(("+#)"+#)"+"+i@ Hj =$;o| 528| G#!vZTh$|n>51G4 gſ{7z=Fai<[i$μgݸtA͝4 ?FYh}a?cݍܦh8O}A)~ƒЎYP S0t AéJpc# #h8w @&;숆sG0E6;숆sG pd#Ύh8w,sbAh8;dG4;(숆sǼ 6; B `8;숆sǟ _?osW;6f4Qd#h͎5;ܱXjGvD掠5;ܱXj͎5w<֚=&N?]q;ጸLFzd8#c21Έ@ߑd}d2>;&qጸpFL&#}G&1Έ@+FqጸLFl8#c2v$y5#옴_SGگٱ2ؙ9\3svk~eFޙ9Ez|2ؙ9(vf.3 XM_#Εxeh=\6sGe8N9ؙ6Gegv@? }M#eOXt?(vfF3s]*2o#03I3;&qg3Y`Fڃ-Eq;2xPuT B#*I HTIk9r*I?% کF:*姥*Iw;E[F:֢GEG EEG8kQdkq$Pdkq$PdkQdkq,X,EőhCőhc`-l-yAZ(8((8 "UyłHJD V &H&&&X,MđBMDMđLDMıX"㹉h$zGDf3|G6g LϸDq7GDc#I&2n>1&B`"cH0,޵wF4Ld^tcP_%mDGǬH4_}634go0gogoM*D;gs'=3g܉l"ϸ q'sHcg{C1]G:pF~4/awd#A?. moC#1GP?s fZ#I?f)֏3F#A?F:ԏlϝC#;#9";#";";#9NJ9s(s8+(s8+(s(s8 bp,ΡHHbpEvǼł9999s8 bPdp$VX18#9";";c vGbEvEvGrEvbAłH4"ŌlW_WT GR EV GBEV EV GR EV bA+p$Pdp$PdPdp,JX,B‘P@‘P@B1/((c^PP EV GBEV GR EV EV bA=Bb$@+Ek)GΕB#.4Q +FX)I)Y)Y)I)Y) Y)Y)I)V JB‘P@‘P@B±X+c V EV GBEV GBR(R8p,JJH(JJX,±X+"+#A)I)Y)Y)R8 (R(R8 (R8 bPdp,JHJ1cR‘B‘P@B‘B±X+ŊA) Y) Y)Y)R8 bPdp$Pdp$PdPdp JB‘P@‘BB±X+#)"+"+#)bG)49D#ȹRh‘BB‘B‘P@B‘bŠyAA)Y) Y) Y)Y)R8 bPdp$Pdp$X1("+c^PP bAłX)R(R8 ‘BB±X+#"+"+#"+c V EV bA3f1dPd1)"I)fLJJ1cR bAI)^1*"I)fLJ1cR bAI)%1)"I)fLJ1cR żyAQ)fLJ(0cR EVR̘BXPR EVR̘BbƞRh|q3GzJT ?sAVhs(IJ?R])4JAj$)*K)xA)c~c" Jfx+EHS)4JAj$(ET9nHO)4Q9BbƤ3&Pd1)"I)fLJJQ)R̘BQ`Ƥ3&1)błR̘BQ`ƤbƤyAQ)%1)"I)fLJX,()b3&PdxŨ3&1)b3&1)"I)%1)bŤ;b:R(R8 (R(R8R(R8 bX1(#"+#"+"+c V bAyAA)R(R8 (R8R(R(R8 bp$PdPdp$P(GΕbB#ȹRh$)Ŕ=JA[kjIJ>S:#JRx+JB#A)h-caC#A)(Ah$(ſ#I)֍먙*KWu©FH)GЦ9G8G(G(G8G(G8"{"{#yĊ#G(G8"{#]+G(G8 bp,HtbEǼł##_=B=±X{c EG_1x#y"{"{c GWdPdpEbAł##fL1^W###_=B=‘#(0>I)F'S1)d*&yLGFtdyLŤ#bTTLJ1>#J1>I)F'S1)d*&yLGV'#>|2dz' +ibTdRjLVQ$ħRb̠#9GP)$xcxؼ$Xߑ)c?'*=}25b}2RO#+d:2 ObR\1*d*&yLGFtdyLŤ#b}2RO#d:2 ObRTLJ1>I)F'ӑQ`}2RObRTLJ1>#J1>I)F'S1)d*&yLGFt,b}2%yR<^NI)I)Y) Y)Y)I)Y)R‘P@‘P@B±X+c V EV GBEV GBEV EV ǼyAA)Y) Y)I)Y)Y)R8R(R(R8R(v#JFZJsH^ R,9P R<{X2>*J=J1^m`HRyekFR]A@HP<|R h$(?y+J1#JV 6t#JRh9W R8R(R(R8R(R8 (R(R8R1/(("+#"+#"+"+c V bA+Pdp JX,B‘P@B±X+c V EV GBR8R(R(R8 bp$PdPdp$Pdp,JJX,‘bƤJR8R(R8 (R(R8R(R8 bX1(#"+#"+"+c V bAyAA)R(R8 (R8R(R(R8 bp$PdPdp$P(G]#-HG)J$?JڈA[ HjaAh$z1{G0͑Ghs$yČ=H#HEG̘HЄ7@7!||+&򮑎|>򮑊IF5R1iȻF*&MyHGxyHŤ #4a]#&k#_k#kȻF*&MyHŤ #4a]#}]#%MyHbAIF5rƤ _odGEGxWdMPdMp$MPdMp,ĚbGxWdMpwEEbA łXY]5.YY&8MPdMpwEGEEbA tȚȚHȚtBȹ&h 9t4A#I?h{d T_=r aM[44ej렑 cI@dք_k+9&8&ChF:xWdMp$MPdMPdMp,ĚH +Mp ȚH tȚȚX,5Xk"k#]+&8AY&8 bMPdMpwEEbA łXY}Š łX]5A5.Y&(&8 bMp$M1i?ywGGEGxWdMPdMp$MPdMp,Ě"jBz7⑟=FHU#{R(R8R(R8R(R(R8 (R8 (R(R8p JJH(JHJJJX,‘P@B‘B1/(GΕB#I)r#wF:JRxOoHG) Sx,I)'9)mFR+(U%GxcWKvk#+ŕwTLJq]#R\yHŤW5ґʻF:E򮑎W5ґQʻF*&򮑊I)kbR+(p]#kbR+ʻF*&򮑎W5R1)ŕwTLJq]#R\yHGF+Jq]#R\yHŤW5R1)ŕwtd򮑎łR\yHbAI)kI)MxR GR EV GBEV EV GR EV bAX#-aQH.=XcDh=ǒg?>,Nus,iVXLCKޞ)<ǒg &ϱ홂s,y{!{%o4Eϱ홆=Ӑ’g &ϱ홂s,y{`KޞiZa3 Y+,y{`Kޞ)<ǒg &ϱ홆=S0y%oLc3XLC KޞiȞc3XL9=S0y%o4d홆@s,y{a3PKޞY0yp$aHC=!iA9 s0l9F$ydaHC=!yA9 I+0$ ȞC=a(x9E8G؉?|"W"ɉVNNđϝ"t7?9g~\DXi~_i~+/9E8E؉d'bHND ;f v" ى1$'2`p"yDىd'bH B ;f v"@Dىd'bH bDى恂1lb'"NĐ ;Av"@D ؉1$1`p"Dى1lb'bH B ;CRD ؉1lb'bHN`r"!9Av" ى1$'"NİKNđϝ"ɉЙ#;E؉1$'"NĐ ;Av" ىd'"N0a(8Av" ىd'"NİqHH5C'ȉ)҆ElpsSS@+D+6%E)OusSSd'BoQ$8,'bFqs''ND+NDv" ىd'"Nİ!)Av"D ɉ a(8Av" ىd'"Nİa3;Av" ى08Av"yD ؉1$!NDa3;f v"D IA !9Av"D ؉d'"NĐ ;f v"D ؉)<;Av"dQ09ɉ)`35'F:P *r͉(rʼnT$9ɉ) ;ɉLNDDDYALN`r"yD@щLNDDDىLN`r"@ל"DoE'RkND+N"ɉYE'RkND+N"ל"DG9NRD*GЉk-N5';ڶ5'RDщ-SD^9}#(mP'<w9N$fD'Љt"~l( ۏ~LC(A ( ۏF!`, &!Ȳ`lJC(ُ~l( ˆFQ0dFC6d4 FCpsFC+FC+F4B+F4F+8AQT`4CYA=hKFÑύ"l4 hdaHA! A6l4 h@d!FÐƀh恂daHA! A6l4 h6daHA! da Fð  Cl4h60lb!FЀhd!Fð! A6l4 I 0lb!Fð!h cd` Ď ;C cd` 0 ;C 1cd` t18Ž.vPcPcpsǠ;Cr  H? \ MP$l6GzG>Ez{#lEM@H d 5i"&ԙy#h'0"l#E&Md 6ʻ C l&6M0.6Am!لM0 6ʻ C*l&6M0lb 6ʻ C* 60la3A T&M0lb` 6Am!M0$ 6Ama3C*l&Ryd` 6Ama3C MxUl&L6A{d & 6` @&0A.M^0ل&6% lBdL6A{d & 6A0mBdL6AmBd & t&(6!$ v(n 7do &o xT$ywhE7{P$x\z3"p=W^Hu[{Bޠ"*G+;4 8x$o@)ao  S;'^+rȥvsAn r;72,ܐڹ sAn@ r;vnH| @ r;72,ܐʰ sAn@ r;72,ܐ r;7vn \۹!aAn 6q;vnHex r;vn ܐʰ sAnT6q;vn ܐyAnNR;?2lHܐsCj D| R;?2lHܐ6Q;?f j R;?2lHܐ恰`۹!|/ÆR;7v~@ R;7v~ܐ恰R;?@nɑ!rzG>o|O۹#zCޑwvx##䵘l 8o[B?Do!5|I {q6&Mސ!5l&ِ!5|o&y l8R?lHMސ6Q?f j8R?Al0MR?lHMސ6Q?f j8o7yCjgCj8R?f j7ypv&?xyN Sv<059m;@.sڎw\059m3LM~N Sv}uyJ;>}uOi_aSWw٧@Oi_^S;?+rO;:Co=wj CJg?a!rOn٧f]٧Oirg;٧0u)m3L}J[(u)m3L}J[;`(v)m;@Sbw\0u)m3L}J[ Sg<-vyJ[ Sg;٧0u)m;@Sbg:>-vOirE>-vOiaSbg: W)m;f٧Rg;v:!uvAT rg7.ȝݰ;REnHY; wvf @REnHY; wvܑٹM/;ٗ):;]fvvAk}5ϱk}I;7rg_f:ٗN0u%oL}ɛ Rg_f:ٗΐ;7bg_f:CKLgyɛSg_f:ٗN0u%o3䊼t\N0u%oL}ɛSg_f:CKL':7 ξt/y3!W%o3ξt/y3`KL':7rE^f:fٗΰ(u%o+:{Rg7.ȝݐ* wvA6qg0tvCȂ " rgn ĝݰ; wvCȂ " rgn 0: wvCȂ rgn ĝݐ* wvABgn^Z S;sp^+W+r;W$s\[%튤vN+uX(sZ HjCy+rHhR;v.ܐʰ sCj6q;72,\۹!C;7v.ܐʰ sC*Â6q;7lv.ܐʰ sC*v.0ڹa3sAnT r;7lvn \۹!C;7v.\۹a3sC*ÂRvn \۹a3sCjS;70sCj r;vnH\۹a3C;72,ܐʰ sAn@ r;72,ܐʰ sAny @ r;72,ܐڹ sAn@ r;vnH\۹a(sAnsG>o\i\i`;kI|WmG ||vNW8pȕv\+|DB;7v.ܐڹ sAnTR;v.ܰ۹!aAn ڹa(sAnTRv.ܰ۹a3sAnTR0sAny r;72,\۹a3sf n ڹ!sAn Rv.ܐʰ sf n R;/sjڹ 󂩝 r.yL\(v.e`j\ v^0sfR;/ڹ Ⴉ r.y@ b;/ڹ Ⴉ r;/yR;2\0󂩝 r;/ڹ`(󂩝 r;/x+/W$s"ocGG)9-wo>^ Hhʿiv|"QծHhCyWZ;_# r;/ڹ 󂩝L\pL`j@ r.y0ssUZ{x~ѨߐѵQã%g<5_gq}Ͼi=^ߊw>gx, =NoWi}M~)O?0I3v~In?ޓjzƉ?kڛ2gྜྷ׎/8εƵ p߾r}&Lpx ޷/}[1áu[뾅} aLQ?J z޾o8֣zzvzlke^J=03ܮ~u<7^wgB>^|35W#/z!oS{~]z/q9_nUw)^z;NF$)ai,6s}E3iISM;MtV;~z޾Jm\sߕGLx=~ՂG8=~xv~Wƕ?~\u:v^2>O==M y_փ'-u9Cgk.ׄ >_B?5NjeP_7kxR֛?qm|9j61~:Jr|=SuCN_g#aW[xZcz&[g֯ׯ>s^/n3i_.?>V#kͯ9ڐ곋~y<__?2W=>}j+k9z뿶z=_.nUAY/._^uZ~;߷o>}o~8$t:2_vb6??Z\SXxw~7ni7y_!ou+߷^wwy}kkw^/^ݯ'uXw6n_R뮫ך{*as__wܯW;~}]c^d4/o:zi>`t=Ϗ18zF^ۧ޷v+/~.uUW;Sw߱w: x1>~y:~cv-{j~n]~nnߗïZ:rvWW՟`}>Vou6i>6|wx5}^/d4oz7=C! @d81O{ _%o3pzBgm>nx_K/42|p p_Dh%r~_pE7\v| ɐ2u8~.{9^ 'p:*'\Cqz1ɇWʇx9=oCg~xK| p7p"/psd$_Fw<7Xϑ_kƑj CYȲGn`v|kS ^[wY߷eC[/"p@_#uϖ9EH=+t-rK~2?;Pwg;\a?h^T􀋟Cz)]ezE_8?R| t)_{_Tٟ5C͋|k^ǟ3|޼erEp઴/ >.q2\.q.q2^ z/luIP/V?9/@xQ9|s'sɐ޹t1\U  ]'~5{* `zoK07| 9_Jrù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=,`CAUEjaw_IxgyWr$wQx_."l4u7;Ƴ#?hh$|$Qg"hT~k#h wF; =Gvk$ڏ|(EaH?6"ɉLND0DىLN`r"%7:ɉ) ;F'R09LDىLN`r"QD'"Et"d'R09Av"Yat"D &'"N`r"d'R09Av")`>F'"N`r"2`'"ND!9Av"D 4,ND ɉd'bHNdD ɉd'bHG0Av"td'"NĐ ;Cr"Dىd'bHNdDB;r"Dىd'"NĐ ;Cr"Dىd'bo ! d'b~xK'ʊ$SBꎠ)Fl)H #遼v) ^bq5ߑOF>_'z%֟]A[O98Bdg df\7|"O:?f?k:GȟuP"o?\a2דY;9~J'!lQOaZoٮ G%"'ԑO;=-?i&OWOɟa*dU0a#0#Ɛ C20 20l` _r d#0`` s F !A60d`  !A60d`,tdcHF |0 Ɛ A60p(\&ߓ  !    !A60;A40DC8m A40DC00DC00DA40;A40;#fh`vfh`vfh`6f``6f``6fh`vfh`vol`N6fh`vsH00tG@"Ps"N#遼cB- u=Ba#_n``貇=BfG_;f[1z)Bfnߑ``5aqk3N20*;s;W}Cr-:M]T7Ejl e*/>ڧTM[] = .n"Z-N{] hrޒ~`H9$k3GAM9G_Il`a.|?*[Ѫ0hU ZU ZUdA*;|5DC*DA*;̝s'aA*;A*;A*lUvVehUvVehU6Ve`U6Ve`U6VehUvVehUvVehU6Ve|{dR0YɪU)JdU٪LVEJdU &"Ve?ɪU)JdUV0YA>LV`*lU &"V`*UdR0YA*+V`*lU &"V`*UdR0YA*U) [ɪ϶Hr-+EO k'!T$y>W $/" e, ^Y#edH2A"e Pz+^&E<\tnrk$x }O2?nzN2?Ӹ+ Dٚq7l&ؚ:9[a[sw.[m)BQU#&"lktW-sl} )l ]G^wl`k]R{mM< &5lM'/TNE/>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߃o8#{ E໇H=(o!3i~na^=?7ΥVu3Uf;Eyԓ|>=.ܪ~=:?~{ԣ?{n?QX=2J> g|Є_s|[%E\6+%mlai B4[=UcDwgz"M!c4CUS$P{x1Y!c3ֻn_?{nţ`}swQؖ`l랿NN\#ly'|z1Xsѭe<.4޽}1acgޛvz\ !cV&c$ӒwuHc!H2FA/i ƨ9'cԼXDcĒi{wO4F/ 7oQ(K%nE`HK܊,="0y%nE`HK܊¢GZV &ĭ;dĭ;dĭȂ#-q+GZV &ĭ;dĭ;dĭLi[7<"o0y%nE!Lo?y$AH # GddHI=!y$AH #  3$k%ZhR]˾!,CrYe&\ane 2$%.ː\ 2$%.ː\ ,AvYed%.ː\ ,CrYe!w & e=n䲞y`rYϼ[0gm.wz݂e=n䲞y`rYϼې]36dz݂e=z݆첞y!g-\3(ϼېL~ꙶzg-Գiw>A} Yi=^~觞^nk~eowKy6{Cz>GOT[ ~ p} ~]r\{g|#g;x෺:Y7?)SxN"OUPt~]=^pEߧwSu'?Ht~VGT=~/t}2:5k>nJOEOwEF5"귛ŒUlm?3OJLa? LߔֳƓ«l ~*XgHV _ S$]V W>H9gw OUû DÕ31R왷 &z憹5Fz콞y!{gn>`^ϼ\0ygn.3o77d {=vs佞y`^ϼ\0ygnnH뾞4$%K!y/A^ { 2$%K!y2$%K!{L {/C^ { deHK!yde 3$&6LlXz wsGH O뽚>M04:s| 4Cit6"a!9 欛/3:W$3˻#lΨ ).Q$3\Mnj$sFAs6בm7gs 欶ͅaAswۍ+~uasF5ʊbD97*Қgk:GsVgxuds66~c9+j_d*R}(|D9>)4Gpo*)Eް礊$F#eÿt;ɲ"lkF:9jH2r8z"ѾGOS䊑ss#ȕkIײ7xlǵ3Gʵl|~-ۈD#>v"N[~a"W#9EZ#w{O5rc/Mr\@3tOT$u=NGdp;#h´a{,2iu FH0r4r( F;FS_H0rcwy:GȡS$9~Ë FyEFΐO2IA4r,9C2r`da#gHirt < {:Czoc{gH/TM!>A6}d L!>A6}d 3$'ȦϐL >A6}dd'ȦϐM߼4`2}dW0 +L LOM dW0 +L LOM_dL`2}l &'ȦoL_A^+L ~Hy7_O'L >>H2}|r$W0+9Cw|Z`) WF OlK@7Z"hj˯?%zϸg~~?.e<=.xw_.}Y#ͻK߼_E\#H\=:'E#Wd䚇2p+FNb.a#S˺v?G^2Jqz=mm߱z&oy,q ߑdB!#$^E O4r69O6r2rU$%)9|s";e ._v=]sR<]s> 9u oU3ĭjͩjw|wt:ѝ&{׍] h39?"O09=r/ڻ${'`wl &{hLN]d &{'`wl &{W0;Awd{W0ٻ Iwld{'ΐʞ ;Cwl0;Cwlޥ#]C6}]CȨ[ACl d+hHVP!Y w%WB:P]!BUw9Ÿ0nb=XzZ;9xzO+?Smt^ 4^ ^t #%~_Hg)8E3=h\1A3>j bI=O@0w ]wz&JW$?4E N膮/dcI28O`'Ao>}r" 6Gd:=} #hbCE tt "JGEA+ y!MyN9 W+ W5'} 6u ` ġ;!ĦIDD*s7DCn|W"∶4|wdC4$_)ȾҐ| JA+Wd_)ȾҐ| JC+W|=+W 4$_)ȾR}!HA+W 4$_9`+W ^|+a_iHb&a3iHfRͤ!$A6l& L 4$39%3H0JI:Pͤ!I:Q䊙Tnh +Od3)$;BfR0I:us3H߈$_ASpud7XbG P b1a] E|6#h1 ?v9>x`[NXUHztVeq9P$XL(Gb^6HypP>N>ut$<sȼi-i# T;b*rb*,&wGbzAEŬ)YL\Hv]oy9>Ŭ{Y,߿`1qAeħ"b[A9nx=-d1=OGbT$X1I|*,ft#xѼ&ٜ tiY:Ґ<`9/Z:$6s6 WG6]$f06OEOEl~ __)ns9"mdiHnSݦ MCr6 m diHnSݦ!MAv6 m6 &Y0MAv,ܦ W˂m ,f6m0MAv,&rI$)xZkƳ"x , WxLSgd<xH2JpQd<ϊisiS3~5gZL6iS3e[LwS3U@x!^ڍ ;fktDg*δ`rL &gZ09SAv3dgZ09ӂə 3- ;ӂəLT ;SAvLٙ 35*Ԑ ;SAvL Ԑ ;S+ԑϝ"LܑϏ\1I5$*&ՐL TA6dR٤IIUIuM*(&ՐM*+rŤ*rŤ:&dR vU"Ɏ9# 8Oagj3U3K׎:3U$8S\vn֤#lRxߑ+&U+&3lRbRA &1H0SdmsM0$EIҌ"hReqD1L*~"tM*GE:zdz~"I=_4H0u_m Tzw>E|&#lRK9\2\1|nRI&>4:q8ɤҊ&u|TAoW$8L*oT$T\?֣-ŸQ^jz\%z}Iv|zΧEC4 |"R0KDdhH.'"C4 ?)%"/P$Za"´5_43vJꋹ(ŭ$-$ŭJjB{N ^y$W䐅s^y$W0 :)LB{NIh-&UB! BZ,Ih:$UB! :$UHBN9/T nfq[Um*duHnV!Cr[mgr[U:nʾ۪«e *U# *Z!Uꪰ.֕uX"ua2[ґTU:S])$$I%ҵ*tf˻B.|qJT+,!jGI]AIڪI+]AI Wg%I$cU {:`|>K^Iz26s= 3c<ߢKRUH+([/tv ’[w]RUH+JGRUI:n!K*IRchTZJTڛ@ 7+,_0 +* +;JbUX]ٶUiX]ٶUiX4,V,6}+hK~U K a Zl]-vUT Z,n-VaXU KҾ+t*b[ [Ů0Yl>N[Y?n!BB--vU,DU-Gv+DCp! mWn{+DCpۮm8!km8!m8!km8!km8!km8!m8!m4!+ïbnVѫşVW?bVu`=4;flH{[8^qJ ^qJ^Ք-*Z]^Ŕ+Mz Ys4y!i[ӴV+ra@^iZX-*} -_'\Ōps3hD*flΫ9ckUzB{3^yƖVJhKڹPtnxZ*,aY/{/$ xx[(bzWPhiMpwl^{]+(NU B;t>ﳂB[==3JGhj ՜*Ah?l Uؚb_IM$W1ckn}gUi;pW:B{3^Ō-Z`*IhaUIB ZZ`*Ahc_Ahq^]A z[a]a[bpW>X խ KbVqܶ8Fue hW\B/BB{3BF4_;j;=Z'o!['oONB{y\5Dͽ&ͽ;$`$UȚ5!iB\Is:$UȚ5!i :$U4?@Th+JGs]\U: kC\PW: I[BGs]!UȚ4w-U1)k*in~9F-c4vD+ƫ C2^a~XXuuխ$%.ѰT1Ut>ʾҘ**do!*1^xR(KQbWRXƞ wDsmpT J<9ЦT⏵g+d}vHj:BgI>+d}vH!^ ӫ B2tTׇ~^aj+LMW$զEW ;~ʾ_kUد*a52~Zª]юjQmWHj;$՞aKU騶+TxѷT[sRmWU[Vm ;JG]a.ѠQmUjtfBka3m3wWZ׸dٕ}Vת4\dV׮_A _+qU_]A~U_[іk"]AF[״_'?KkvU_ gV%5b* ~MV%5Cu*V%5lU}WZWZ_J˯]߇B_תtZ׸d1kWP*ve߯U*v_;$~ MzVIUI&M dT'LѤI]a߫L8_&OI|1iWؤ|0iILI&=C4)Ju> Zj,iEB^WDLZa2nwLZ6id ٤I;d>Զ&>Զ;d>Զ&>Զ&>Զ_g_gvzzM}>ܷ,澅9mUz&}6羭JϤ8;&}ip8j!Cawqx>q>yr9ߤ#s~>>9e>S3NC3Mgg=vLSLIY̩ g5i,UL6:vM6:Vgg1լJcNݪ$쳘SLlΩ+>9us$?LzR֙}cs괵ܺ&f`I<:4q`㩼P%4 t3ͩsB,&ҍs<ǟx>($}|b5,&ҍ5^S|6'ݕ>Dgs"]ٜHwWX\gX>D糘HlN[.Ȯ>_jb"]3Om9\ gHI4鳘HW&g?ѤYb"]q&W4/&.NdI'M>uũ43ͩ/X&}[I&/IiN]}udžUx>{cTxj;8nT[sǫϯge_U騶+t?L~U!tQaoVTە}VڪtTTڮj$QU ]|~ͪj;쬞vVO+L||E>uunHJx҂~zjDT8 A+옴+?O>g-veߤU!~ QC`}a||A}./sh !sq8"3sq+}ve_U+ Y>;$}z'}V!BgI>;gUJk|ͫL^L2iV%4}oҪUՁuZTRp_UH+S~cx8;~ Bk3DvؑjWX󳔤ΪlUXvBAjv =]ٷnU:_oݪ5x{TGUuMynZ::d.`HTNutUSjiäyz[룚ԘRGVZ+Qd5ˮIWL:%ngG11\ Lp1pT34WXNתt&5ґ#Ojғ꣚ȒpqyRc꣘P(&5NsR׳R=ڍ|ƂTgDK:_j8+I|?$c>/$ո*Ac9Gz˟/$Cc\QLj%֮TӶժ$f?I59>ǎ9JxX>>ƛR}TItNjTŤ G1qPcnP R?=Q'G17qM>Iq*IbR#.v#G0I/&v>E^/ K5(G5g1Dfv>9aQYn%57JgWدDEWد4;HESbbXs[I}!ݫC(YsX\vH3($.gGj+$UMӺ<'yBnlɺu+dvH֭!^L#PұnU: [wuB֭cݪtq`ftvT[VmJG]!VQmU: BVm3 T-y갳ڕ$uJGUavHڪtTە}Vڮ쫶*՞jB3&.++k4J5](/ժtZTB<KTR-zU:R K5 J/Zx> K)Oj8+Iq*AqlWPqfUXX~TeUT#;{RJ_+/$)ժtZ ոǺ+RJG]ٗjU:R=+-vzދQyƢT[yH+RJq]U Rsqe_U RRM7V%H5+, !:uqRvXHCg%J|P%5- peWU_U:~ ^W-v%_׷QWe;kU_BǯUaa!u>QZ_~8kKvpɯ&kWȯ__Wɯ_+dvH~Z!CV~p߯UI~MyU_kԕ}_B~תtڕ}V׮Zm*VUjQmWHvT[jBU! j+dvH+ vLF.nڪj;$VQmU:SaGg+,O(UI~]XX]XRm|re_UIMݪtTqtTە}Vڪ$-WPǗ_%kV<*sD%6"*ڼ+ڸ4XڸVmZJPmpUj</ڼŵ*Aqź+ڴ*A'L||ƷTە}Vڮ쫶*՞jڪ$Ք+9GK[\TTm\LJRm+sJMU騶+ڤЪj+dҮjziUªlʾuJ|WQB תFveߺUX*ɺIt|]вnWȺv[n֭JǺ]ٷnUغgزnWh_ve_U騶*U[VmJGUI]uGU!URnVcݮuHɺ_yCW0Y+OTUL +M̯W12r_\zuBB&Yw4B+McC0;RnۮﶭJϺ_iuHlݯ4-aWgݯbcd5&@?U!?W*7+M累4aϺ_z*&@W:*&@W5UL'j$ +OLNt.C ,j$ '@q):UOʜ[y 9LG|^(M 'l ξH^ }'h~ _\H\ 8QW% ׃KS_\ ;Rs!U Ipg̪|nUC_y.dW17V*BέWUIN?rQ'b.dW12+ͅQ%xW+,V%8#+͐\aٯbZdPW-Dծگb.dqbU;'.3PdՁuv+q#4CaW1CfH懨iݯ4CxJ%ݶ@ YCR:OX퐥&@*Ww(ɠ ٯ_;$V~!Bk~JǯU+~=+-vZaǯUI~]uV_kWZkZxF.׮_+dvH~= ٯ_++~Jk"W%.>4j+쨶+V[aǯUI~Mo_+$~ Y\LTJK]+[TґjWZ$K*V#ծ\LRJjZʾTґjUTeB-ծTx$HTz|2wxTh8QdcqGI:ILz}VcҮ웴*/E2iWMZIoҪ$-U & 4nJ0i}-|84i8DIL:+f`V%4-V%4+loUIWY=+-V%I5S,Yi*Y.?[RJG]ٗjUHLaG]!}VgUX>++ BgJZ=]%6iɤC蘴+Gɤ_ݩ>_yC+OuTJ7zS< JS_4z&}Y;_R:2;_TVTWғ꫚R}Sq*t:5՝,W5Ց:T_ݩ$6TGlnN%*,կ_ "{ܕ:j<$^\%ߔ J5T%H5n J5nD Ku+Ouۮ_뫘pS#?w:;]__yc~iUMud~ͯbc뫚?_U ~}B?:Vv#W1Bғ+oL|ujUz |n_Ŭl%J5KUL | T_TW1ձ8Rz@S4>1Nk3__$.n%f=OZ\i!V;_96zT%YUz,$!hgU_ŬW\*&@V\Н_+dwH.]\!Crq]\qqW]|VZ. ŽB.ҤcveߺUaVpߺUI֝_[cݮu+dvH=` ٺu+X+֭JgUJkuVZ+X+֭JǺUX+d ;ʾuұYiY+֭Jg*u?.\A:Uu:'W[uұnW~^p&VcݮueϏIgt[`ݓ [u{$G{<ԾpVuG~ Z7n9Jn\EJnqW[`H[*V%X7n8ʾuұnW[!ҲnW[uoݪ$ TIM;{B֭0X7n| [7-Vcݪ$m?\S7Zx ~|B:WYi*j\PmaWaPmNUjŹ9[ת$._תtk_B~׮_kΖ_~p߯Uv_;H*,ZTBR0Iu%.#[!IBj,IT+dvHR!^LUT K5ܬjI U +3.nT-kUد_;kUȯBj$;& B6id3 &M!ŽI&ߩ-VcҮI+ &]BǤU &]|$Lڕ&&Iuq;RJj!TR]JG]aQRu\qe*I2^$մ+?/"TґjWX;?Z Փ}JaYA2}=G*AXfuyVP{}*Tz*A_azVKPJYz,K~t/GT%I5*A]AOxWrK]AƥtZT/ժ$.^I/;tzVZRʾTґjWPt$I T<]A.T;R͛R_R[R J5 Lj,մ0|VZRJg+tQ%FuZa|Ǝ~K*,Z ʼn{K]BI yO&g.N!}.ZJGUa}vH;(8+NKA[a}vϪtg;JǙw*yəGY!;309Bv&gVqQI5*ə9S_3<Esz`~x^uv=sJq!<*i]Aד0Ƀi߻L+mW%y׿RJ`$dWЃi+U L[C`؀zUO/uUOIYA^ci]AZV=`}}U: z0)L`WЃiUI_W_|-V%x0m|W=X`ue_~Uȯ+;+-U#ЩGu7ަIy?\%VQbWXQbWH;$%V8?AyK]a%WQnPb ŭ;$%VQbW`- Įt۬#LJ<¤ YGxI0)ŽJOG%)B^aiǪ0+o&;VvɎhͣBvvxT]a%'AM%V8W%*q>\B'4v++% v%.Qxho!iB\Is: Ys*duH5W!kC\As\ ;ʾ\Wh}Q'͏utNn[JcNݪwU:n *\ i[ﶪtvVm}U%-b*Ihi+BJX WMێR䶣M*a%0^mBZ|MJɥu5w|?5Ws4>>WO]a͝[/HsTPsfG:uUXs\AE5T%h.s j. *IsYU k.mYJ\>[a~͝A~>+堟G,i.q k?5WJZզ5~T5W溲t4Wš JGs]\U: ksšk*u570%-N˒ҶwN24:\UXsk*u%_'ͭB5OCx:d͗W-uexUIƛa:D-5ҚX~Қ_x/ovWo>*dU됌W!B6^d x*dU됌wx*dU됌W!CPƫ!B6^d x:$U1^Wx}:+hD ŁW߷WaxU+ƫ [BamU鸭+n }U%-JZoڮ%P%i.*Asq'>WJ\jr54vHTЅ_ӫ4we3P%i׿ux\U"ϸšKKTI;e|ޚ jyx4sA4wG5w^Sg~\IWPsQ@UIKΪJ\`WPsq U6ǮΣї4w~RM$-4}+/*Is~j$;78/ǼUh+JύsTh+J܏WR܏_KsUau*h+JGs]A}"f%inq4pN2xi*u5/U+hՁZ=inq\WHs:\U:+vg%͈+X4^IsjKsU!unjPVºBpִ!ͭ)r۷p_hU B[^#OSy$G0 푦9LB{ oYh4-d=6Ih[z?lb>+S%|1GvY}sۣ67-xl \+m OyIn;۫}Vm_k,sGv|AV n06 QgKr?੒ܶx^zn{p*mqwWmijUxsd*n?.O\Qg UJmb>[p#gKhzp*m$6UݙkKJmbZѣV۾t:Q6vOp#Gw*ab4-Wh$Q]4GgG5s-?M=IlEaShb[pѣV\FVi>[Qs4ar#\= m/in&-^>oێ'Bv[m*duHn!Bv[mg!Bv[m:o m*duHnV!Cr[uemg嶪t֕}U!Ž۪q[WV^Yz*$oŪ!WV$aV[mi*U㶮YUU+趸*U㶮Ѕ_OP%-ΣW%-A+kUO]A{%-R%PXty=Gnv|R=t[\Jpaܖ~ʾ۪q[UVJodKe*uuVqmn>QL򋌫Jg+JG~Uau/:9j0ypqɃq%v8ZJ +qvOJ\\NXRZ^ y$ Y~:=\\U3+QSs^ydW09L{hx4-d3x[ aZZ< z߽ad!Zl>c|{3_bYq,8kbmU!uu|*Uv/kD$u\WK#W5,BSRbYq]ڔ+0/Î ^iZdW@0'9d3ҬcW1UzBV1ϯd L:$3Uf!B6Sd L:$3a0Sd L:$3UfT!B6Sd L*d3UfTaL]7YiU#K*,IRv$U’J߾:gvT6Slwԕ ,UIo%L sotTdtyʾBf*AGqq*u.\Yt% (R%(*AGqGWPGUT :K\Aō4g%U%U=M9~܁Q :\!mTU :GU : hu+} :TI:JjJ2ouuwPupug:z?2]Fn*uuϿ|EmU ::?]a}OU3ſT8)HOIu̔uʹ8j*3uN=`T6SlsX}pAU ;?AG::8謴tP40UPWTvPA:$U!9BvPCzBy'ү$ Y<x:$T⩐!BO$ Y<x:$aO$ Y<x:l,I<x*dtH⩐!BO,I<vӕ}񜕖xOWSO$ ;JG<]OUX<Q<=S!}T#싧* iVs]OU4-reAU8*u.FAU ܮ'U{&J| ;(#+YI_7tT%8(n :(]࠸SࠈVttw࠸+_үG%9zxpeAU [{堮;*AihWAc-U㠮_AyWAXAUIgA5UIJnOǭ:+t~ TgAG(>(-UUaLU /.p[ KC\gZug_YhWU!_W* BU ;3TauuHꪐᾺB}aWǢ^|5&7}S^ԫ-+MI^yž^i`+3WřkLbVUX+MrؓԫzU>uTž^iV}*faU3ӫoiWU_7G3+=3|ܥ$WoCga9d_ԫ:LzU~a~]|T L:$3Uf!B6Sd L:$3a0Sd L:$3UfT!B6Sd L*d3UfTa2S?WtVZfJ0SteLUa3uHfctԕLU!3M'4ӹp̔J0S+hQ`\4S\J2q{|3efu̔!uWt{m3c84SW`8;4ş6o3->aϱ1SWTd+W4SVf˓'iM*WRRVXR&I-#ҒTU:ϓ=>u|UXRv$.uv9ueWUa_U|5_tE_WWUAR㋒/=[JGR]!IUȒ0Ijq|T!?$!t$UT$ YR*dIUȒ$$IUȒ%!IBT,V!KCT, YR0HCT, YR*dIuH%U!KCT,IR*dIuH0H*~~’J_4%>TH+ KCTARKZd(IR<!_y2C3OR$̓f%̓&I=d(,g 吿 <Ja3OR$̓&I=d(,g1xEIƳ U J[13πrfz3Ỳ¿M̔OI4*2i^Þi^ägw*== VZLU Lq*L`b2fU'g1/*\fżp1{vEaTDՕJRߛ d9@y2TԳ 4̓zP}WXRg1 7Q%I*U,&Cէlg18jf@9Lfzsshgw*LpAUaU~C_OWqPWTvPueAU8+ AWۦ*tlS!ۦ`jMZ ۦ}Tcm:$TȶlS!ۦBMhDwմ´ϻBx! Q<s(+DCO,wBx!|A8h5tUҷ]vUA]!:n;誄}GKD[A3UfzxB_aQ+:*IGޕm]JQ +tႠ*LJ2SX1*L|;}WtUwQT%)wZ`4鮠exU3J )mU*LiU fJzWL @W%)b+d8xiUVr0Suf>?̔(ҲU fJUf 6S*Li]a3įJ0Sl*L񎙮JL )%qU&0ӻm0UIfOH04ӷu4cuttUPGN2VuutUPGWѻ;+{Jz_ [B:Z_8 NB6;ﰡwtt+l]U /^EL1UA3C0! LWfz3=Ҭ0i?n'G$Gt,Gt,G$G0J=0I=!Cqq q q qi[D*&=T&I<8i=KAbR?K4~U8%A 9Kk]AUy5# :xN%9(m?zWAqUIxV:ػZy>~UOepq4/^hAJ˳UIJ[YtPtU^cxVAi$AWG5)7(/%tU/ũGAbRqt#Mez ;zCz4'-Jcf]+$!o0_6hTZ\%´J8iR2JtI<4S-d<ҜmVl3?`6W~aG1DUIyĉH+LyĉH+LyĉHwȊIotSbBS!+CRLI1b*dtH9àI1b*dtH Y1b*dTȊS!+CRL Y1b*dtH9à Y1b*dtH!y[2JG&]ٗIUx-°7'9/$,:du`}:{JGG]A,-W:QU:: BuH:u!BQue_GUauttTQ YG*dU:uJB4(>-$G^B:uT!CQIG*duH::àIG*duH:u!BQIG:$U:u!BQ3 :u!BQ YG՜ԕ}3Uc~]6Sn!L.ZaA]wPU::+iwee*8+>.nT M\AaGTyWTtT{MfyUҞwv6T%:(LY4lU J# :(k*KpU"B9 YA⩰#_(#L♏)ij խ$~clS!fq|af(t~JGjtPSr⼤堪tTS[0hq+ߺ1SWԣЁfZJ2|Z% Jjqi$ᾤґTU:ʾґTWHR0H|$!IBTIu%5?IR'3/~U: KCT,IR*dIuؑo[RG'ғTUXRG$uIR0IB&IaT,_aT,#L:$ YRG$U!K0IB&IUȒ:$#L%uIR~QRG$U!K*HꨤH|5|V?^*HUJgN+4æDT>UVF0*UIkRwTz ^Q驫*uΚTUzJG]G%+iqJRWJRׯ񧺪ʀ7*A]qZ+*A]#?V2VWjA]󮠺➬us*A]q+8Hs |V/'JRW"TWJRW*bPW%*A]waިu BTPW.ꚿTW_֫UU::*W٦~U:*_Ể'|7}uTW3WL*WMIί]H$U&I *_QR0I aLGgT!*d3a2&3Uo_3SU:fJL]!3Uf!] +d3uHfT!C23uHfT!C2Sl\!B6Sd L*d3UfT!C23UfT!}3Uc$3͟h;:ʾ«Ovԕ}U%8hu+HUF:+-ue_GU*uew3EteV*3U4St˫\a31SU*3}+ʾtb0D3%R%霜.QA3xJ2SB>WLU f`J0S\Y ê$uU[ǁIcﵽIK%WPRmHUaI񮰤-$x#GI?$ǻ/I_ث$5'Iſ$5'I-^bTU: IŽґTW%U’O<[JGR]S%-d3%Rc*yiq:fJL]7SU:f B63uHf!B6S3u4?LV1SUL*d3uHfT!_>3SU:fJL]!3Uf!B6Sd L:$3a0Sd L:$3UfT!B6Sd L*d3UfT!C23UfT!C6SU%)~1SWx)}$(KZJZgZJW]UU:ʾYiM{re7ӺU|JUZʾUU: ^䠯UWWi@Uj_Nt|Օ}_U㫮1JU JU\x kmiAN *9R%*-JUZ ]h) Bۛ$uc *ARلVs糂T :9\>bݷ K*t%?'J*UJ$ K*R 'QRJ[?^ґTW%U/ҒTU: dW qMj&IZ\D_&5խ$u- |U}x;ʾUWW0|!BU_u姯:dIuSRvT6Sd L*d3Ufcg1)|؞մ'~SiOyړdg0陧=)LfziOLn"I^g<:[Og1.@P<&L*dtH2e!ɤBI,I&L:$aI,I&L:ܗIU:2JI7W *Tc*te Uaa4| RBzU:ʾA+k1U*t/Fp9U Z4H* TI9DiW 4TIISa\aEj  H`4AOR%$+lc-c* U l ]&) w NU%$R%$Nr G, rދǨyW Lj%UA7S2xD4H5J2HZ= dsTIIZe2E(ê uW'Ktҕ9$̧A1g3BPLxP_TLWH1b:ߤ;Ց%NJ*7zeŃJU:^ yBtW:$T^-u :H+*dWtH]Q!CR8cɮH/QU+VqEW+*dWtH]!BvEg\!BvE+:O\ +*dWtH]Q!CrEg\Q!CrE]Qvt\rE]QCSaIvЕ}+Tp-+tRTB*Ѳ U:ʾ?U: W?Wc٢*h{LU: b*p>+8kV!?d1U!*)]Aw/=HU *]ATB~>+TAU oq+MW8xV݋wTtTЕ}T *쨠*^KIZX#}Ͱ%}9SPk } Y9W> JdzY?U1=W0C2=lz)dsHM!B6=lz9$SȦMa4-!ÞytG㐝pytG3tG09ݑ'8O#OqNw 8 ytG09ݑ'8d;tG09ݑ'(LNwpQL vp¹ߑ&#y ; DzT sD(&ՄS#MqD.ui&["OnW'vQ$r|]vgyL>D(UWXBgxw6WPJyL>3#O]$C]akkT "[T "(TD Z9޵R r7+$r'rG3G"goG([aWpaG1;(rG5%&7EHc&;<Z2QL~whӽ?Eaގ>"z:|qq:W)dsHN!9Bv:tf!9Bv:tU!;Cr:t )dsHNN!;Cr:tfNWPw/?nґ>U:U:s[\!SuzFU wzOBdY*Aqi+tJPAGU TR *H TĨTp*JV'&QAWX=`dV "T]*8~tPAU 2WPq̊*^U "B*XJPANWPqe*Aq,*AqHWPq.*A箰 Ҍ!U:*8+Qi+*tUvU*I'KU騠+ OVp U CX~J]aW'9epExQ\\rE k]Q^0ƴү86BڨqA6*dmtHڨQ!kCFI6*dmtHڨ!iBF~|}JI>do!BVAI :$T*U! :$T*U!}2*dtH*UP!CRAI *dtH*U! *!SHҗB\E*S\WO^O;ړWw҇*$}4U(,T&}TPߏW|3=pE*={3=<Ӄo{3=H^L-<Ӄ~7p=*u]A1 }T 0fzVU/+O T c;\A}#U c;\A T ;mJޏG{W}M{>_^դWq=Un%_>cOegroaG^i[ؑW1飸J>Lgz(L3=+hz/j"GqGGsWӻ+MWtWGtWޱtWsz]V~e[Zӻ+^צ]0]>slMӻB~e|⬐;yᐤ-dӻ&ӻ&ӻ84-dӻ8c8c888c8c8c8~]$SȦM!B6=lz9$SȦM! 9$SȦM!})dsH` 9$SȦLO!B6=dz ެDӣoU᷿+lzJ0=ww䣿z: IŽ/})H+ҧJꎦ_7ÖBt?P9D*U:ҧ I[:]rL+hzE驒Lؿ+lz9ת$Ӄ- ׿MoTJ09&bzȟgMxJ0=]!ßJ0=\J0=:WUauUX0=2oUzLW^kG_N¦: 8$~DӣuM/0G_4=$ӣu+I鑶1=WWB0];Ug-s:0^pft9y:ᐝ!" wL! @ǏO!B? )da? )dSO!C? )dsHO!CMO!C? )dsHO!CsHO!C?L!B? )dSO!}t2J?BWOtO=cUy L]awtTЕ}TT-DƎ|TRA;]8eO>kTH*aM^8=]R7fY}CU G?؜kUg]Mf%QKWg$wL(s$}LåxiU ҇J>ﮠUIWfiU ҇>+IB| T ҇?uWT⩒ˬ]ٞ*{tVυZJ|80?QO??O'9?U: |Eܒ>Wur>,}I9$S7 }I9$Sҧ!IB>$} Y9$S琤O!KB>,}g$}gq,}g$}g$}g$}gq,}gq,}g$}g$}g$}gq,}gq,}g$}g$}g1e#|Ŕ`)g1e#iF旳Qݗi"Þ;d;<ӽ;䌷#rgsF*M;ӌ Ij_A4p5tiwq9 cUzNw0U N.abFp,aw7R%9kęa@UMtg1 c'r:*h]ATaKv0WdU z75<z Vֻcz^_=i< c. wCZUʨwq0#.S%].޽?!SسeQeh9, Ag1:|z3ͽ~3νXa3M+(rgC9'g09'g!;'g!;'g(Nw+LNw+LNwwNwwNw+LNw+LNw+LNwwHNONI{Ij~~{wwed$ۯ1@$ZBy*ʫjw'C笾ve}EĽ*@t+$OȞ<] {@tN(<] {@tȞ.=]!y@t+$OȞ;#P$"jtxF>6+&ž.p5r%ž(wKX8#a7y{7}3b ;r'_/ȇU[#Hd &~.%n"+/ }F59#Y"Z#_7w4m4%"%e^#PL&")6&"oMD7Fznψw_t?܊?M&>Y_ӛN"f}dYXF ͬQ ^p%sPKd%BoY0+8{+؈b  d+XHV0  d+XHV0` [Bl  d+XHV0`!Y@l iJ[ @+V` [@d  d+V  d+V` [B ,$+V` [@d ޷gd &boYܷ \ܷ,d+81+8y+[V0+xF`#|QV%"kFӛB}WȊ+LN +6rDVz%b7r&2s}j]!4zF\a" vvBrR+vs+Ħv+jWt(1W[%AW&"\ID\!6kj2qxC{# Dmg\d0Wy$"p2.DN&%WLj};}gY񊍰W5֒WLd+6 BAH7؜%B_8A,o1+k5V8y؈b A dXH1 A dXH1 b B2l A dXH1 b!@6l ~GO(dIfw?# '}AB6Qq> ~GO4Ilw?飐 '}A@3Yr쓓>daN׾zG"kq>|V5ۙ4O]w>;cr}kp;*7H{>;}vz{Ț'gzWHdvG'gz`SDngzA6}(5ӷONӷONӷONm5},g.1}"w?mMQF׉ÃXӇG877&b6¦d&bn=#j~%jDмhiLdS&o MEL칈]ɺi3=DvGNB_ 'tLuzӛ|޾zzG#^BvzQNo;NNo;~zG9O(dv?#Мw@szQHN׿S^ ;@vz+$N^ ;@vzN(N^ ;@vzN/^!9@vz+$N;#K=Y9N/};@szKX9#vz^"+prl DVL_#M=8Brz+N/ӣ}ӣ1-W^#^"+N/vzpP"sY#G&aG{A0qzxn#fbNnmmLD޶9=j:RoN%"NqzĜd;=LĜO3KNtzU:=_"ӛ=ʊKd5r%!+${wBw }OWx%YttxFOȞ<] {BtN(<] {Bt dOWH.=] {Bt  dOWHؙ dOȞ<] {@t dOȞ<  dOȞ<] {B+$OȞ<] {@ttgD=M>xFME<.~aOaO7y M.A է h>-s*/4Fdͧ^FV|ڈDU6@iO d6'T>m@i46@iO d6ͧO|Z ͧ h>-|ڸi٧O d>J@i٧O+$vBi٧O+$>F@i ɧO+$>-}Z!@i}QFb"hj}Q̧⧑>-i+>i'>OK|?xز^}O+$(w.l~vw)E{CֈOh ŧksMKM|uZjDاiF31Fw6>m|4.ۅO!O[O .i$A60iMixSh"P&b>m4r4j4j4gd~J}ɸm{pcZ"f|BZ2g4_O&B>m2BV欐Y B2g'ss.dsVxߜ%bY1g7gFs欐Y B2glN(欐Y B2glٜ9 dsVH,Y B2gl ɜ9 dsVHC4Tfٜ9+$s,Y!@6gT9 dsVHb ɜ9 dsVH,Y!`lٜ9 dsVH,Y B2gl 3M#]Š#k#KY#k#KY}GȊ#KY!9G}G;#+$Gh/~ɑ5r["Ȩ[#%"f\-mO.G2J|x۹ lYle{ SF$l1YFزJ,k-eYBioo+KD~Kg#hp[Y"bDĜmҙ3n,odŧ=&'Ldi>%Oh0ylճ A6Y eY٣Y]Phe{)'TS ?'Bl)zѲ=&L>jch~JAYRPȖe{)'TS Ͳ=@l?-O)(dS Ͳ=@l? ,O)(x llٲe dȖ,[ [Bllٲe;XBllٲe dVH#X [@ldٲe dȖ,[ [@ٟSf#?mr +roͽєB16yȊ{K[!}{+$Yqowo{{-["+;Y"ٙȊek-͉XDV,[#-["bN'ek-6:#f>`yYlܷleNe-eCeY6"Z6,B6\Ǭ?Yծ&7^GAs#;4/;c 8cvN cvkcrޭȊ#;f pi}iȎȎvd+}crƀXcrƀ8cr#82vdl;cPlhO d 2A7d&"6 oLDl.0:c3a/0o0! ?j|\\a&0fm19c`2e ;VOh ;& LV\ ͑~n@9 8: ( ͑swcrnQGEGvЈW?7#;܀#;܀@sdhs ّ~n@!; 4Gv?7  5Fs.^ё] # :GvAtdDGّ 8 # :GvAtd/#ё] # :GvAtdDG.# :GvAtd/.^ێ슘#+K]Ȃ#"^+rۑ]G {6,ذ+`^6슠 {6,yĔWsa-6,ذW " 6,ذW Wd"n~ #KrEl+6FG"h+6bh+66z]aԥ!^^apF[_a0 [6 nLDmlX}E؆ b^6,܁yE zI˗|eu^W{ x zA^.?B^/x{]uE{AV\+ zApYD..+] ˺ uAtYD..e]]e zApYDuAtY/Hpg.+]V BrYe dUH.+]V BrY'UH.+]V Be.+]V!@vYe*$.\ e*$.\V ,+FDej"rY67B+pp5kڬ3"Jdp%boaUxp%" ˲DpaGKdp5raÅ]1_KDV W#hhN"K+3\oE;^4\E슰 51\'* a#hF+"ne"fƳ뭌.}ep+b neL mzEpth W\V"g:1\++6\ _+6\l p*$uB1\l ?B6\ W"d ezͷJP\V BrY e:BrY e dUH.+]V!@vY e*$.+]V!ֿ]{ ]{_\֮/h.k4kodkodko ڵe[vvvAsYֿz_P]֮_]n ];_pe$Yg|^Bڭ3v/Ikc.z/lp_õ[7bIo}1\}[_}[ ׾[}+bIo}1\>:#kgõOzS+b |EpឫDKDnjfox/Q>"|_{6F{6D{MF^lIoɘv_p*Y^uџІA^>k'g׷vA^˿y]ڵ_ ~Nڅv_hko+A4\o+AuYvAvYvAvYvTk ڵeeev`AsYv];ؿ ?IsYe d.\V BrYe:BrYe.F@vY e*$.+]V!@vYN(.+]V!@vYeFDV\V#]V"hv"+.rYfYqYgde5re%YqYwY*1EYqY|.q+?b"+.+}Ȋj:#겞vaw5. _qYA,qY!vY. Op|Ee-[6.n9Ld~ې,S˺YɈGsV>g>-DV\V#&+]sahkr ++6\l p*$uB1\l ?B6\dp*P Wׇbp dUH+ p dUH+ W B2\l p dUH+ W!@6\l pxfp*$Ȇ+ W!@6\dp*$uB1\dp*, W!`lp dUH+ W B2\l pP W B2\l p \1\7\FpM.lp%b!ba5y+wJde%aU.ڒ^%Y*De\mH\ֹEV\V#]V"+.۝YrY4K#De2j]JD\Qe&Fe&Deͅ˚+". o.l[|e&FeN] eM%ȊjJde%YqYwY \qYwY dUH.+]V! dU9*$.+]VW .\V BrYN(.\V BrYe dUH.+]V BrY e dU.k6_.k6h.k6_.k6h.k6h.k6_.k6h.k'TyGBvYw/dyG5vO\\V~&[!kMnKl6/+m^ѶV;'B֪pOm!?^5kM:‹V;7ukM:ej~۸ȚV;7bՎXmd6ZmmIGxCۤ#(:G1kE۩YV[Akun=m;U"b&KVY+Y+oZ8jt f&Y̴hIG|h62gu<ʚڼ{|V'bjl6_jf6hjf6_5Z{ڼ{![{ڼ Zm=ЬZm Zm=ЬZm=Ь Z|V%fZ*$k*U!Y@VdZ*$kuBVdZ*,U!`lZ dkUH*U [BVl ZPU [BVl Z 4kE*VlhȊJdZ5iLL%B. ޷VX3"֪JDZMnuY&UȻ OQQJDVT#o*?)܌ȊJdO5rDOQ;F3?~1?EScElJQO͞ )އȊj DODO~뉈-R0 [W%k[+3U#1LUኟj侟JdO5rO%~*pO5rO%~*T!@SN(~*TT^~T @S^݉*NT BS O:BS O d?UH~*T!@S O*$?~*T!_/@S O d?UHL BSO:BSO~F@S O*$?~*T!@SN(~*T!@SOj侟JDDag"+*VAk5{Xܿo0uFewYDV\V#>*YqYF>V6&15>ߩ? »ȒJde5re%". o*lħQVK`kmAkᯍX?ޤV==V_akŖVE*VEV4V,YFZM&V> =^DV\V#]V"+.aa.\V BrY'.s*/dUH.+]V Bez%(.+]V!@vYeP\V!@vYe*$.\V @vYe d.]zx?BvYh.e={s/d~=\zx?@sY^. y~=\P]zx?BvYYsYI?٣˚<5~ Xj?3ڹ=5kunM8{ Y1\Y?wvOI?wJ~GY.~xS"k1Ά1.,ǤXs7Ws#~lxT"bD=s;oJ kǤs;.d.q=1.z+1>Vz\šz̺OeO={ywc4?nލލs".4?nލЫûzx7BS^~O~O={wc/d?nލ=ûzx7@S^H~|O d?UH~*T BS O d?UH~ O d?UH#X BO*$?~ЁO d?UH~O d?UH~*TʽSFDVT"fOQOdΈB6Q~K&*}Ȋj侉JDLoȊjsMvt%boY1QFD ZF3&KdD5&(6Q,"~ eS"P65~j"&U|OvDOс/)l}?*YSo}?}?)IS'~*PVT"O d?UH~O~Nυ O d?U՝BO*$?~T *$?~T @SO d?~T BSO:z;:z;:z;:z!;:z;:z!;:z;: Oa Oa=pO<úcw]1˸cw}OMcw}rb&]KXVǬձڍkuLKx̺:&Zn좠^h~cw}|>1.]?oSǤx'?1]?uxu3G]4&jrf&((_(/1QaA&"& okMd{}T?uL:O&(SLI~R]š:&gb~jDO^KXSR4?ux/@SR?{~Nąh~^^ݩ:z{:z!{POK= OKOK=OK d?~T @SO d?~ O d?~F@S4 d?UH~*T!-O*$?~ O*$?~T ?}?) s(+1?sA?5{.ҫj\xWU ?%Sb&doEU#>/9DVS#K]sNsSв8p9%Y}tFS"+ΩvN$4{vNp+S"~S 5isB;'sHs[aC:'S"+Xɣ,DVLT#BvN}Ȋ]j.G $D1*$cƨ 1*F ((Q[b cƨQ B2FlN(ƨQ B2Fl1 dcTH(Q B2Fl 1 dcTHhG1 dcTH(Q B2Fl hdcƨ 1 dcƨF@6F41 dcTH(Q!-1*$cƨ 1*$cƨQ @1FjX$cFhYqCwCޥBbv)٥TxR"+n(7ԈKЗ,P"+ZТ6pDV|O#1%{{ȒID|Ff= @='jn)l}_T[߃[3iY=d%$\c)FǟC,P<\ŠJQd쉲1 GKXHG dTH)=R!yG dTxBr#G**L}b'@mM"+&[,d1[C->߱(Yq8|._$pa3D|Fo/iId47Ŝ%ȊiI?>L#p&JDn#j-aۈAۈ1Ct&"g2˜AȊiwMF~5;(bv DVN#fK1;dv)$f'N!@6;dvN(f'NXfN @6;^)HN B2;lv 9B2;lv  dSHf'N!@6;lv )$f'N! o\ ٹ sA4;/fhv.fyA0;DsA4;/# `DsA4;/fhv^\ ٹ fhv^ ٹtN-W|.8Wù"p^ЇMv8p^~\5WDl Um[sEl+r\[sEzE`Iz^2Q抰#ʯȂyEn{+"^"L"+^,xWħ%50KC]xwtE{EЍ\WD myE"S󊰁 d]42ٵ ,Wħgv-D^kyAp-DrAt-/S. kyAp-DZٵ\] Ʈ\]ѵW*Z^+v-DZ.\]K rAt-/Z.\] k kyAp-DZ.Z^호͵ h%]ˀZ4Ȯe@s-Z42@v-O%]ˀZ4#؀Zy\ˀZyQ;@v-k\K ͵kyBu-k d2@^ he@r-o ]4"b܀fr g""f`0Y؏y'WwL.aȚIQWd$pFdᮩ+p\oWd_+bvFx?4͈yp`wYs88gdገ9|zyE|3C("p&OTm"p+nk"pDU&ǿ6p3LF@u8>A.@u8+gDN">N9p hg@s8p439@v8 dp49 d39z'+ u8 d39@v8yN ;΀p h'΀p4g@s8p439@޾?p)$'N!9@v8p)$sBq8p),N!`pҢ6N!9@v8p )$sBq8p )$'N!tASH @b`aC D709ᒁi侁I pj`[20,tyE|6ג#qjt1B`#KR?q-tb+rߵ$ZaRxߵ$b@#Z~FrF\K"Z ޱ$s-B`ɛv_%"e6ׂ"4q-ﳺյXgh]ZN(]\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Ȯv @v-Zٵk)$ȮZٵk9Br-ZٵȮF@v-Z ɵk)$Ȯ%]K!@v-ZN(%]K!@v-Zٵk)$ȮhZŵv-MNw#h`DXIpFL#{\/ȊiWd4;ch3M"dk ^jZowk4rY)e1/3*C#1/%2e& ^'aztV -9oF`[+"^oJj JD}4^Ƈ%/ӈOb`N(ʎ҈OZٵz1"\K @v-Zٵk)$Ȯ\ ŵk)J\K!@v-Z RR蕊@v-Zٵk drBq-Zٵk dȮ\K Br-Zٵ'\K @v- ٴklڵQ[i ٴk ٴk ٴkoښM^lͦ]{/hfӮ/ȶfӮ/ȶfӮ4[i ٴklڵix/x@5lk  d[SH&mM!ٚ@5lk ֜PlM!ٚ@5lk i d[SH#X ۚ@5dk d[ȶlM ۚB5'[ȶlM ۚB5lk d[SH @5fkh5l"|R}[Ȋ9#K&[ۚB5KX5ܷ5ؚD|.TM$bF;DN^"+'0gDMdpQL92m~`GD>0pL"pK#pPld2[3PlM#>iΘ)#\I[J [B/;ĪU dVJ [@*dU٪U9X@*U![B*lU٪zM"Vk*lU ɪU)$VbU ɪU)$V%J!Y@*dU٪U)MJ!Y@*lU yx;?oYU9?oYU9?oYU9?o![U9?oYU9?o![U9?oYU9? ժޟy yvx@*-4rx@*u}%PvZpX]_\Iw];Ǭ?{Y*Ǭ.Iu-仅L;rL8޸V׶4rԣDV4Nu",8I\l;.DDp>ٜnRIDjG5oKs"I'rL^>&}t'ע)9)9cn!}>)9 njJh.lJh.fJ{B5%w- ͔7L]p PSrx@3%w-dSrxB6%w=û)9 nû)9 n!û)9 nû)9 n! o?5@6%lJ ɔ) dSRH$MI!-ٔ))$SrB1%dJٔ)),MI!`lJٔ) dSRH$MI B2%lJ ɔPLI B2%lJ iȦ$MI!@6%@ dSȦLIڹ}SȊ)9#K$2%HDV7?[(v"DF>DY=}SȊ)IdŔ4rߔ$bJaSB㌠))'2s"V6s"ژA9ԉɜ6IIĜ9͉Lu">.9F;DVH#>98B*ى+N$H D ɉ d'RHN$H ;Br"D ɉPH ;ɪH!9@v"D 'R8@v"Dى d'rBq"Dى d'NH ;Br"Dى&NH ;@v"4O9@v"D ɉ d'RHN$H!9@v"D ɉPH!9@v"D i d'RH#X ;@v"Dى d'NH ;Br"''NH ;BZ d'RHN$H!-ى)$'޷1v#'2yv">.ُF|]w&xN# J?iHd~$b?o?Y9Yx}"(8')"N[6Nq"#q"v"7'2!8N%'Ȋiħ\q"''RHEC ;Brʼn)AH!9@v"D ɉ d'RHN$H!9 d'R9)$'N$HWD 'NH ;Br"DN(NH ;Br"Dى d'RHN$H ;Bĉ d'Nû9l!;û9l9û9l!;û9l9û9l9û9l!;û9l9ûʞP]e ىUhw 4'rxW@s"w 4'rXW7No,IXu};f_\8%Ǥ'Q̉LEvHuML mosi>1SB7bJkutn)pL:Ŋ\9Sl9:t"x#L"DpG#DLp;}$"NDT1 ;fo9(D~LFh305qXBwt-ޭo'Wwi-@]Z~ޥ'Lwi-dqxBwi 4qx@wi 4qxB~ޥ5]Z ~ޥ]ZO.f?h.l?Z.f?h.f?ZH~dQH#G ۏBl? ~dQHb? ~dQH#X ۏB~($G ۏ@d?~8؏@d?~-G ۏBl? i#G!ُ@G"f?3;B"hxD(I~޷؏FۏDVG"+eُDVG#G"+#ܷ@qF~\IiW鯟& e21G"#G%'}'Ȋiħ\q"''RHEC ;Brʼn)AH!9@v"D }'NH ;Br"''Ns*d'RHN$H ;B(ĉzE!N$H!9@v"DىPH!9@v"Dى)$'NH ;@v">)$'N$H! osoN$H ;Br"Dى d'RHN$H ;Br"''RHN$H ;BىN$H!9@v"Dى)$'N ʼn)$'NhDى d'RH @v"D ɉ)d'B DĉrE#IdŔ$¦)IdŔ4rߔ$bJY1%|.>͔$"䬝3%)DVLI#MI"fJ94¦uw$b/ nI oi ʐDğVDğL/O&_d'>b?qdUc<!?y>)9B*%ٔD,$MIbJ ɔ) dSRH$MI B2%lJ ɔPLI ɪMI!@6%lJ SRu@6%dJٔ) dSrB1%dJٔ) dSȦLI B2%lJٔ&LI @6%:4ՉЌNnW ~M5T <ؽjOj?vZڏݻؽj!ۏݻؽjُݻPT ?BwS 4{7B~M5T ~MTOcnf?vhcnl?vZcnf?vhcnf?vZH\zdG ۏ@d?~"($F#F! o]6F#F!@6l4 h($F#F!($F#F!`l4 i dFF B2l4hdQHFb4h-F!-h($Fhl4hdQÛ(.1wAF".*4r]$..Yq(\:Z]Ȋh侻Hd]$..YqmgD:|8ۋ%~{9R#@合Y @͒HdR447YB>݉(N| G҂=}DOw#G]|D!@# GdQH>"}D!dQ9($>"}DGj^|D B# G8B# GdQH>"}D!@# }xQH>"}D B6Nh>b#6Nh>b#6Nh>b#6NZ>b#6Nh>b#6NZ>b#6Nh>b#6NzBw'-I yyw@w' 4yw@w'-dywBGlq 568*fGl>G!Wöq43ۤ([ȚyV{&fYoQ.ȷޢy ௎a.|L#ƫ6"ʷ5Ž?p[C"kat|G1жFVf]D 1l>1lw,)L> }an6YȎan6han'Tǰy>1lW6han6YȎan'Tǰy@s w 4ǰyBv w,dǰy@s w 4ǰy@s w,~|/XBr c($PH ~. 1r!9Br o1\t  1 1cx Br osXHt c :Br osVH ~. 1cx\c($?C!97: cxwC#C#[H0r osȿG7bW1mchov [">='1-21EE^Uc`9c85yq 9تЈ8co9ɐEx ;@v >c()L 1"<COa1"\C!9@v  1cdPH!C!9cdP9}c($Ȏ!C1 ]C ;Br  1c88Br  }xȎC ;Br 1&C ;@v <}}1 ha@s 409@^Bh!À4Ȏ 1cÀyC `cC ;1cÀ1 h!cC /4 1 h!Ày691cCoPC ;Ͻˍ9Ys Х-rFÈc\$~. ܿW-r^FÈc\q #Žaz p1 eD1]%>A"&o:c:cM 8Ys "|@s c)LCOaPC /4S:1"\C ;1 h!À4Ȏa@s PÀ?Bs 409@_c:1cC ;1<:@v cMÀ1 h!À4Û:@v cC o_7u 1cdȎЁ 1cdPH 1cdPH#X ;B1c($ȎC ;@v 1c88@v @ dPH @v  1c(Z ;@v 1& ibY PdoY M(\DVlB#w{>6baP6$"6@#lH  lA0y&L>f& jZBxFha AOK }ZopBdoPӒx@oPH A {B7($oޠ 7(( 7doޠW }- A!y@ PAz }xoޠA {B &ޠA {@<} 4o0y@7мA /4o`@7do  h`@< h G h  h`@ 4o  h h7ڀ 4o`@@м  h Ї7O hyYP Y# FļArY7}tSHļAjO 8#jU0Cp^ow4` QC_53C !x6+%f%f4C@<@^Bh ' 5!%@6! AO@j4CȆ`@3lP f?B3l4C0@Z f h fP A `@3l4CȆ`@3!M A  h 9rWCȆ A!@6l iYȆ A @6dN( A @64!(, A B2l !dCPH A!!dCPH @6@ dCȆ A BZ!dCPH AobN(h+ ~P wD~.$Ap aPñtd.OD\vh]Ce.`W@?'!`{#,$iYU W>H_蓊T'Ł\"U W,@/IE@ 䪿JU_U!U\r_胴Tf?B/?J_ÛT>IU!U\RU W>I_HU W\}?`\RU W 䪿@/RRU W4r_H#X W\RU!U\r_HU WTP@ iU!-䪿@ iU WTr_ÛT'hVSiJݓaPx$aP& Y ) ~#tKDЯ7<}! Po@1o(1o@' u {BZX7doPӒxBPA!-$ A/7doޠЧ% 7($opB ?'B 7(UxB_u7doPH A!y@'oPÛxB7($oޠA {@>7($o A!o: 4o{B: 4o{@: 4o{B:,do{@: 4o{@:,do{B: 4o{@:j(] \"v_>j3&b:%>j(U>j(n] ]w$"@>u8yގDL>0 ĝ^oڢ7حסKzA^Bֿ zNfvTh`NfvTXK;`NVC{@3w*, H ީ ީ0 ީjvTh`NlvTXȆ`N'TC{@3w* 4C{B6w*,dC{@3w* 4C{@3w*,#` A B2lҲ8 A!@6l P A!@6l i dCPH#X @6d!dCȆ A B2'CȆhl iȆ A!@6@ dCȆ A BP A!-`*uplF{DVA"s9hR!1!MD  !r?1X78#f$b?Mj3k`MSC@Y1!(%t BZB!dCPBP A!-$ A/!dCȆ' 1l !($CpB1l ?B6d!(B__!dCPH A!@6'CPÛB!($CȆ A @6>!($CȆ A! o_{!dCPH A BZ!($CȆ A!!($CȆ A!`l i dCȆ A B2l!dCPHb- A!-!($CȆhl!dCPÛ!(Z!H AO]FDV\@"`(bf"B#hP*$bB"bP*4†`(bvo bh O Ϭ*>O\@!W,䪿Ł\r_蓊T>HB iYUO*Rr_b ?BT䪿@ ?T\~\RU WfRr_HU WTrB }xЇ7/?B䪿Ї7 ?B63hU} ߼`U >Vog rտy@73hU}߼`!W,>Vog0Ъ P m>@ۼ`U >Vog U} yM JM (ؼ` &z&J߬zUۤ 0UVsYp VOvLGͪɧ~/7IXhf} /7(X ; Z}yG@7(h yyGB>߼`/߼`w,C; r}yGB7(h߼`w,ձw ~󎂅\oQ; P; Z}yG@7(X ߼`w ~󎂁VoQYZ}} Tr}}!-j/>@ ?Tr}}!`\} Tr}_H @/>BO(} @ h\r}_H} @ >B/MJ}_H @ BޖjFXN^"Rk@ٱ.mkv~=Pjv' 5Zo쓷gfo~͞JވO Rr^H@ iQ5{ >%H^S'\ 5{ 셾j@f/)Aj@ f䚽jJ5{RR5{ 셾╚WRr^H5{ Tr~B }xЇ7f/=kBf䚽Ї7 f=kBƲj@f/=k@ iQ5{!\r^H5 f/=k@ i 䚽F@f/=kBZr5{!\R~Bf/Z 셴@ =kBf/Z \R5{oRPjBZr5{oVcUT{%"5;VxX>yf5{"T[WV瓧$I59m9Id:o:/k W煴| (Xq{Y7C֛+= yy@7Ah=޼]!/>7AWC֛+ŧ֛ zt>tkmyB7AWȵ=޼]֛ zt>jmy@7AWȵ= ޼ ޼]֛ zt\[oރk{Zmy@7Ah= ix;/ց\[rm]Hu ց\[3kBںjJm]Hu ց\[ȵu!`\[rm]Hu օ@ :kB.R[rm]H @ iȵu օT[rm]H @.:kBޤ>օ@ :kBޖjF,G]Uܓ KFp,gOpa}(TɿA崚}iN?y7rfOkBf䚽\Ң6k@ }JЧO(5{!-jf/)Aj@ }Q+5{!\r^S\R5{!'=kϡkBf䚽WRWj@ f䚽j@O(5{oR&5{ Tr^H5{ \&5{!\r^9?߿w&oN~ok??o> |}T߯|9_ׯ/kϫ_Ϲ5?gl5?ˎ"8xϢk,u>Oï޷&ٯw5"KÏ~-~ *Oٳ?s3_Ox?k{?y:y}|*__?^[kL~^'~FMNjl|m ?g]Ex>~}±0~>S+"zg+Rxjk? yE8>1 |M?d>J??ߕT}\.hgDE/+I%߾<x~~yWs>|W??%|:k|W~|_boc|.|0}Yrz|+^Wx>0~os|m5'|˶g]2fb{)v\8H_|~|5_K'k8Q>Cߟ0pAxL`;έy0M1z~ٟ7)p*|Ϸ ~g8 &Y-'g1cm6>YGx~~~~.h;ט#1>'W#0F\j?G׹N9^⏗x ʫ)S1F˞No۹s|*_s |#׿|.y50g#R:_VLW8iBV=xWF|v>_E"={Y7,|?^z>犱eZ.~|c|o1i;FzEʀ?ǻ?'=\kYtێ_oZ>?Gdoe;~{SǸs1\}|wLx}}^s {\9bo1~{g?7q8Ϛo>gu=>\}Zyq}>}*c\8_Er#|}:ϯ=O线ף<'ѯ9}\{?OHw?|^?/sq_ʯOie9<__+ߎnƄ~v;d`A|q/~B/οר/οt ƝeiM_<6.J|d|o}L{cҼe̿\珯?v}t#FC%c>ԓ ֿOa#0,/9w<>-N3\^~F /?^;; Κ ~ep267;]aOswnN[}^v2^s2p~h~A >Gĭ<.O&$;J?d( Z:?уFKd|\ ꀞC ?_:)|!{ߴ /3|_gCk==Ízú\IM 3NADgc‘$_UwZzwXoVi 8۟\[8<>'G)4gO*^ 8<~'?}ckYIkY<{<[G!^a>{~~:gO*9B_g?8{9N)0T>9oޫN*?_}#G(dpH=B!{C#G(dpH1#G(dpH=!yB#G8CBС=!yG(dpH=B!{-X=B!{C:)dpH=B!{C:t0xC:)dPp!{C:t(dP0:G8$P=!yB# =!yB #G8$+W#LxJzV#*G]T#:>u Va82U~WGuOtGu n&d\{QߦB {Qb;W,x}IxGt PDz RTBä QaR R(̇ Y)*LJQaR &PJ RTB!+E\3E>?E#\ k'UP4E]UhJABD#(*(usk![EcUYE|_+${hu?牱h;p||WhIbI4Bzh~*(ZD ?e~hQE#8cUhYα.Ca>YΡ9s&P s(d09+Ρ at s('9sT 9*LΡ0F09B:Y%s8{"!9Bv9s8$PΡ!9s8$PΡ!9Bv 9s8$P 9s8CBv# Ρ!9Bvs8cBvX!9Bv1XC!;-СC!;|ᐜC!;Bv 9s08Bv ;_Hg_sZ!;]\A6Uss)TqV9Ct$ov/ 9^GB0U9:a|=ߕ[ vslu`؟a*[u,: 9VA/'xs&.v~|}l)sW9v\>9Us%%s>iv iDK3_2B6:GrUX?~8̧A?~(d|Sؠ Y?~8gA?~(da Y?3Ơ Y?SؠI?~(dpHa> !FI?~TC!GI?*L¤ Y?*LQaq&0B¤&PQa&0B>tTC!GP¤ Y?*LQa[~(cЏ ~(c6CB֏ ~< PȇWC!*LQa[~(CGI?*L0:~(d0GI?~TC!G¤ Y?**\dCIԏq7?t!_BkTaZ^ҏz?+:a{u1ΪZp~&|.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!J ^|9)(%x J JDm!T R1/_źBRճ=Wk[䧎Pk1~ UXJf,dxU|կO>ǟ IWV?d K L.o99Hcьw KO}]ߗ %Gl X\!)ہT R K /rS%Hw?I *AJ_JQJW\A)Y|Ϧ#خ=]z $y+* YU8gAU|jTE!CR*# TE!|&TE!|jT!BV*IU8̧AU8SG TE!CR* YU(dUqHUE!CRUqHUE!CR*IU(dUqHU!BV*IU8$UaP*IU(dUqU!(dUqH2*IU(dUqHM␎e YU8rȪ YU8̇*IU(dUqHU!QUҩ*ZZiqU rZs (H'WefU rUWֱTv]A tcY[]W}B.U?O}r+.UO짾wQϵB.YXTaϘxkWeGn]x|ydcVe~꨹;֨.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&yb0{e'a3@wVlXjT^aIF;.Ǯ[.TaID\@0؁dg=dg=e1],3aC6| 19dymGb4@gWagWagWag!30 Gy]p(;ϼ $;ϼ Cga>=̻:FOdG!ˎC,; Yv(dqHeG!ˎCqHeG!ˎC,;Iv(dqHe!ɎB,;Iv8$a,;Iv(dqe!(dqH2,;Iv(dqHqH2,; Yvn9dqH,; YvCGKv\+;O={ɳ0zOɒY+=tJBp(JXW;9DsUI T?R;>T JV [EV vQGDV:伽Rz'c[GJR:yshTOsy@Uq1O Y(?/ U?Si.RqܭWoV ޠRHh/ PV kT!c TKE [MoT%(‘+@Ҥ@GBT| hqCZe )ؐ*r%OR60OrH6mh )drϧ )drO 9$R6m!ِB!?ؐB!t>Ɇ )drH6mH!ېC!lCɆ )drH64`CɆ )drH6m!ِB!lCɆ 9$R6m!ِB!dC# 6m!ِB!lC 9cB!lCXm!ِB!lC1`CXmH!ې-lCСmH!ې|6D'j *lC ɆXv&1ZQ #:W%^Mb, !lCцJ`C8!\JzGJ!U X!WІp* ,~wTІp*D0=*kzbE^ڐ^ZABNRm!6YGB6̧ xB~ P=۽^s*:K`C_a+ *#\~_ Mie Milh՜l_dC0l!P>%ZO )L6І֧ %kRa>bH!9$1Rb0e1Rb01rHbH!C#,Fi#,F;(;d1:Y$FGAYa#0ёwPvbtyeI$FGAYa#;(;d1: yeIye,FGAYa#0ёwPV;(;cّwPvbt&1:#bt&1:&1: ye#O۲ F {0+Lbigňˏ~́_s`88˒#{>&H.#ru2J%^JJGsҥ#t;>^̪$]z=CTP1[uѨuX_"sG峞x,u~^]*YI\&Rab%WPp#U.)B_ nSuIUoٹXI% S%su Gt 7º7ƹ4vǾ7*IHIKbQ1R>F]:>sKtu)ԑvǣ9QDi^GދZa#E}{Q;ѧ|}{Q+L>u佨Oy/j"#ԑvHuޟ|!B)S ٧O9$R>|J!B)S# >|J!B)S ٧O)dR>|J!C)S ٧O)drH>5S ٧O)dR>p!C)S ٧N!C)S ٧ҡcұL!B)[٧ҡC!T:QJ:QcYe)*lY e+dY ; Y[J, pV /D\ABOR9)L>EOOTuUOѥ+}JΝqSq|J6yK{L?.zQOs)+ _QV>YZYe*K%"+Su L>0>5ˣܒ[SO}Tb:ȏ|+Sx*T >5v r} S+S8MS#Id vMrH>0T>>'Br}*U''aMÿ>1 5 QID9gAD9̗AD)dR$J!K|9$J!KCuʗ$!IB($Q YD9$R$J!KB($Q# $J!KB($Q YD)dR$J!KC(,Q YD)drH5 Q YD)dRp!KC(,Q YD)drH%J!KC:t0HC:)dRp!KÿtNJ):Q}?B)UaR|)V?O}N]!R)WЧE JVGIjEatVU92 U®޸~CVcz}Wขz[~.vAZX4UZ|kV ZUNPZ >UZ*ɧTacMZ!G>U߶?wOÁ_JzkL>UoV^|)JS+S_SHZ%~{R!{G%˖RO*-UOYUO->S1ŽO“D-D)drOQgy-R}jO)drO)dr/2O9$R>}!B)S ٧O9d!,B O)d0TɧOU|J!Tɧ*L>}FR>Ua O)d0B OU|J!TɧOU|S Ua)S0TɧOU|S &R>Ua O)d0B OU|J!:^a)|,0Tɧn9L>SUTUO)TUz>JǧB>OIj(I*LjgUk,keUز*LW ,,͓*LUeiY(=˪Jg)WxBAJF?㜸JP7D2,8J_r|n ZV}k[ȯJ:#:WStte%\c |p^+uYpU9֗~|\+(\㌱>ץVH]_d.._ \˕+$\|*Apڞ*Aec,WPp`¨J( 'R%J"忪ZH{Ukq,OYa& SѰ,k}‰~ aGFV!Y:UF )̗?QU$g Y*Lr$g&9SHrVF!əB3$g Y9$9SrL!˙B3$g# rL!˙B3$g Y)d9SrL!˙C3,g Y)d9sHr6 g Y)d9Srp!˙C3,g Y)d9sHrL!˙C:t0șC:)d9SHrĮlǞ=NT ` {CSHFsv̕r4WhВ3WH9kWXbHґ3W˙*~U ܿJ3l V_7s^UXx;.WHξ㳜펣Oǵz~~+K9}۵"|>+9S%Y#"hVXꧨS9UWPt5R rVս~T r6R=a8t1vGU5q-~+;0툏 rF%36UezU-Ɠ]9[P_TI2ӈTaOSȞ=mqWsʖQQ kSh)+$(BV6R)(CR6l Y)desHʦM!+CPG}"!( Qml3De;CP!( Qfvl Yml3De;CP!( Qfvl3De;CP Afvl Yfvl3De!*n9De;CP Afvl3De!*¡C!+±ll3l(YٰYA{;C80)?'=vmVvVPfm e;+mVYUk۬4ͰaogYi۬4ܶYIVoIg.@g%m56+hV'g o<+doryŹ~էQkJMkJqO_;םվgiܗ9+ {;+ho,zyG 6n֭k#۬{O~mog 77nrSA{gMmVկeYA{#W%K)mh6+hY{k;9͙`o4嬠-bho',ma_T|썸doG+tDnV"wVU Q0_Vȝ! Qf"w r3D;|"7C3dg"ŽϐEn{0֟a-?$r[[ Y䶸mqo&3L"ŽgDn{!?C-?$r[[I䶸G-,r[[I䶸 mqo&g"ŽϐEn{0WEn{0ܖ-[ڇ?7lqwnKgnҞx={-?Þmi|>-v_=/^ws׻miJ8e%^>k*s%_SȦ0_sHMO!C2=lzeU0=lzq=d3d{3LfL';03Nv8C6gplz8aq =d&{gȦΐM';03Nva2g03Nv8C6g0dz8aq =d3d{gȦfL&;|5s=3MS3M4G"ygCՍF+581k)^Y Zɦw]^J0OL﹘ L﹘ Qܥ¦W!HGs1"s1"3φl]3φMfMwMߟMTYeYAE|E|{y]A 4y.fCަgMv뛕`zϕ|L/3M \̑XN$[EMM/5Mٜ9qV'_㉑Q >Ԋ q >,&+|Y3LV,ΐ!YBBd :$+TV萬P![BBd# V萬P![BBd *d+TV萬P![CBl *d+tHV8` *d+TVp![C:+d+TV萬P![CBl ޷QA+LG:Wod ;VJ ]٨+3W𥐬!*JG] *쨠+0Gvg/-S}SݻGI*HUatP U:* -Q% .DQ% ^B*ȷ*I[{ $xk3zOrU^GnT*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+W6R=1OU%Y!H ZacL0?VJšC1.B!=p\Iq}:Vfm5#OұBU:V}+r UIVau~V [! [!-:T%X!* ǗdG VJBZ Z!.ET%XT!Za>Vϔ:d+g-+tPaX+$kO㊪t\ѕtFI6*dmtx"Yk '~ ެXn?dV:y,<sEA" \W:y" \zA^΄ X y,(W:y,<sEp+<\wr2H\J2Hfc1Wwp r( Gd4H@A$dGy,,NA..!Ai?B0SHA%gIxbdkhGMQ&0p|]+R8J@SWJW{*tWҙJg+w]Wr+Ux*5W֗$u쮐W2qnJW+WJ~c+2*RWJJ1ze>^0y)$\m̮m)*6WOlWo; b*(+SbŠx׺w+mSpQXh)tx_1U!W* ^8ly+˵蕋WRa+Ux+RW/ׂW*dt^3+<}!{垧(L^3 Wy{>㐽rgWy{>0y垧(L^3+<}!{垧(L^3 WyWyC=OQrg&+4}&Oi&M6Og{jgݳ}1&mdW!澘z =\s66m*dtHmS!ۦCMl6m*dtH9`6m*dtHm!٦BMl6m:$Tȶm!٦BMd# m!٦BMlm:$Tȶ0&}Gzd#U6m.}gs;WBGzT㕮ltB@ yKeR$7QL.%$B&EW Gغ\2_)UA"( 6t Q^}i+lkC'9$N[RcA>]_d> w r^*  q DWbAaZU ~q AQ^A҈UAJUAKkKUҼ4J ]o$[1\aU鬺 N+U wS!OVrWW{]^'sq3_ӕ|S!+CR*$tH!)BVLI1b:$TȊ!)b:$TȊ!)BVL Y1b:$TȊS!+BVL Y1b0(BVL3D} Í@\!U:QUXGQUXG:tttT_$//ԺW,IjzHRT`>k7TC+lٯ74SU:fJ0m,+Td6e3**L_4SZ9*Lq+T`y*L\4_4SΌrWR%#Z3]?\dtt徙1SWLiNU:f:*-3u寙:՜A՜'QW^9Lx1upճN[JA]!U!;^ A+L&UZarP&09BvWT!;hA+L A+LZarP&UZar *d09BvW ;ZV%9­U9*&砪|U*D U&UqW頪t*=JAUٺtv xVS!My{Y$GI⩰#U鉧*|UYpWgLtt㣎:JrPE*=UUhU~umtTQ\jJ:rh}I::}_+rt6/IGQg]^ :Z?g<wʹez$7T4SP@dmU险*hX0ӺLUA3RLi]UtWLi$3]|]:\-]|Ee ( (.T%h>,$ŵ+䠋:ޜSO]$tTx擠J4EUW1İJTarKZ!9诰#UgUzJG<OU%X x*$<^%I<x*dtH⩐S!CO,I<x*dtH9 I<x*dtH⩐!BO,I<x:, Y<x*$L_M :~`LO!)*l74S蘩+tfTaL]a3%Q!)wTa3U]ARh9*-Iu徤ґTU_$AKR]}U! ꯐ%uI]=t%Jx#:}_|5,W_F-_udxU:ULOr徺ҹVz_.תtUr_]U ꊾ +-S%XXx񓺢B-UtWHL&/QOR$UxzÎmVgU٦*lI*=Tmթ¶#G%f}tJ?.w{¶#]!LX`u~IuYmGQt QzJ6ls٦*h6lumfUmV2 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;kZn36"-{?mlpX&1̾Uߣ>Kݶv̵r۪Zԋ_59ߝJmU nm]&Uۺn[GܖBuݖ͍Jt[. -.cU%{嶮."rmU鸭*mi٩+趈$?npxnO ZY:*-u۪q[W* m*T*u1^W*U:8 Asg{3D͝!j5 Asg;C3UȚ{3D͝!j5 Asg;C3͝!j5wg;Æ\BR%F@8+xKƻz =JCs h Qsgܳr[sg5 jCt6v[U:n{Vn4vVn{V6|8D v$x~g7W!X ;+ o4*묐 a QRJCRg%H*-v9+(tA9+IRjYiH4$sJTZkwVPR f%H*FJzbڏخ1j dybIR۸q媖h}$a !Y-ҐԳr[Rg%I*0+ I=+%uVׅ֎^_$AIE泒$6H=+(t߽*IR’ :+IRVYIߖQRYiHY-ҐYiHYaI姳B0L"f=+xAJCRҐTU:zVnKI]IRWO1jVW|u _=+}uV{JWm_7!J}\Cxqqq q q qqq q q qqq q {zYXkf|5|Uin H2Yg#͚ac17kzzĹYgȾz Y3걘x?=_=sin0Iga׺0fa9LfzV{fzIVxzz,[S#ͷaLWW̪{ ̰bf-J9+|Yx,fVc1 ,GsfY걘YEk *ӑgV%:̪VǵBS\%8C/׵Z6w/W.XU gdzWzzU|X̬ z4gVJW< BUW̪~U}~|JUkԑ'Y%_=cIVGd0I*&qV14aTc1*H걘d8GI]$IBg%^^%I`K%4&TXRޗSRUIJ,_Iu1SW*Lqnuߟr{Ԭ3Ew徙P%)mCzVLNQfJ;]A3ŝ_Ta3uxLU阩+h$3ŝ3\o=JsU"cr{Y+}UJU}UrWUY ?c:SQWU:}uUXR|aG]8 Y]8 Y]8jI]8jI]8jI]8 Y]8 Y]8jI]8jI]8jI]8 Y]8 Y]8jI]8j=u=өwS0*)Tgc5jzz4SV#NaO]tGNuu=tXLZHI]:Qzz4S-~Fu=ĩ&u=ĩ3du=l_!뱚"x5.޳/T_!c1E*)R|u:;Sc1[*\XR*X̖Kܞ-5+==Vbl`bT#ϖ:$?{,fKm.R%Z츋~ӻTbycSlc終ȳkܱ5-X͖z*==f'bu^{C\*=yTc1[*-ۛBۛJZ\7 --QU%2ܱufK== -Sﱘ-54[ϼ,M6$Gi$Uiԯ#b):䵮 {z)R)RSc5E*_U6hN:+u=SV?~?_,u,!YBXd b:$U,V![BXd# ,V![BXd b*dU,V![CXl b*X+-vT*$WWU:TUT+ Wv|ūʾ}KU_uaВTU:*:$IUȒ%!IBT$ ;JߒTUգ}#lg Iꯐv.UQW*U+uT~ҕ*yQttԕ:JѱEG]$|,IG{ARASkRS%( ?+V<={%h=ܣtZ㠮wPU:JA]a%8W%9(-v>U%9(mJrlC}䠸rP^vJrrPW;*A/`bTUBUǫqPUBB09YE:U㠣Қ }U*dUQWR `qvut:8+TrAU8*u徃>#O{rH!9BvPA:$U!9:$U!9BvP A:$UT!;BvP ;} AwPU>rvAU8+ A&c+蠫!;]"ǻQW4i~4SUl 4CQ YG*duH:0 ::J'tttTQOU!3ҽ Aī.WyYIJOuœ.Uad?P%'*+,t׮*I<`WP>WXRu_̋;]AI+UI6/EpU*=I󢂤yQARú*ARǛUEe Kjލ;/$u:VIG=I /Ep*=Ip+,&}1/ 4[$FDż b^n J*&JOR4/jm%/HXT\JT޾"$u_L `)RxSR4[j}o3u#{85æ݉S }J=ϖrȒ/H-ᒤ.NQLdM3Ӽ_aLdGg{w^뀗!B6Sd L:$3UfT!B6Sd# fT!B6Sd L*d3UfT!C2Sl L* f.w⨴EґTW(U$aعtDI% S#*dIUH+;`' fz:f f:*hBkŽqPWU!9BvPA:$UqPU:}U%9h= CvPt ux_kWT%OTz).Az*A<_ޗ #3Ut|޷P%)Y*=3UcJ4,rw*=3J0Sl i̪$3]_f LJOGUa]/THU Y՟ /$dsoFzH>./rϺ~~\+(8BKxr_]A!Etfē`O8Ux# ÎmұMWۦ*TcܷMUm1M#l}TcJ <Ia ^z~՜WLUX1vӕ +JG1UatȊIb *&֪tRL Y1b*dtHS!+CRtHS!+CRLI1b*dtH!)BVLI1b:Vs* ^_ W.B+Uat吽!yBJ+W:?HW«9ޗQiɤ+eRI,L:$T2e}T%maTؑIU:2 O+erTZ2JG&]!TVsBg* ;)GtRLTWLU֊>ATLڢJPL=*I1Lq9d*A1i~鸂{Us\3;NyŠYxUb.%(8;~2%Ŭ/ԽNT%(f]VŠ+oŠI[۪PJPLܪӕ9*kż+!Ub"|QLWX1Uɏҙ J6Uئ+mSmұMW6yS6]*aNQZs\*uTaZ͙OѓIRqPW;* ;}UaCtȶcG}_c1)~Gw"+lG0'")LyH my"C#ODrȶyH my"dG0'"9dǸ9d֭JPqV%(fc1,|`b\=JP~0~LYgRƟLTz_(gyyb<3pZU֊IbM<3nX( y,f-`ìv=<ӈWiDA47*K'ʣ;H䕋Gy屘F8kM#R%yefkz屘Q8F\_4H3~Gw+VoOc1whz^yC%X#%}%DY o4dLer(g29C3! Q&dR!Ler(g29C3! Q&dr(g29CL! Q&dR!!Aΐ !jn9Dm j Qp!j¡n3Dm<8+I{N=fƳk&WO ҐIU:29+ <+ 3lY-29Ԡ2 C(f!gLJC&g%dSY-d429+ T%$y9+(4?{VX&qų2YI~\XI>+A&LJpz%[g%$ 9:+(%dßLɺ,cVP&}drVLˆ2Y)4drVLn9Ȥ;8$L/شWmWbJ+g%x5rV^9+ <+蕋sW^9+ Tgr( <+r 3{ dJ^Wz?^r[1g + Q1]|@ȕJ6]!Tȶm!٦BMd 6m:$aMd 6m:$TȶlS!ۦBMd 6m*dTȶlS!ۦCTȶlS!ۦBM[6m*dTȶlS!ۦCM:ұMU: _-tx⩐COtXT⩐}T#OU:J3ئ+msTZJ6]= hV:}TSaOVtxOW*TOU: 'M$&JϪ\OqVxҝgųN9z^C^*IWHAq oqz6mܳΤ~r\+,{S??^_C3"\*uW pU qDYADOU%d,{^dc/ H? a@YAR1HUAh  d*Mn+ R`' 2OA* z TcA:ot ҕmҹo{TZ}TcXbI&WґIWˤ*I&dr!aA&&\xA gqr&msiW^lQ WHT6*$m+ҽ|$W[]qُ*Aq6UXy8WxTFU6҄UZ k#aJFR-WP׷JC*AiYAm勪$mozz%hHo質mϘ4VPv_G H j#n.JF*IapYamgJF+Q6QҕڨJG]Am\O]x @ ꉑA:dmtx{ͬtѕڨJGG3ܞj3+Bvų*9oU鸢+]QvEWt+®0_WTȮs Y7;ugݸ®Y7 +ny֍[u0g8dW0g(LY7 +ny֍Cv-ϺqȮY7 +ny֍[u3[u]q˳n&Wm_ r1? $/_T%%3ɫ7UIYxw˻ >qAn<_%$[r P%2döjCóUi䶘jtp[LY3:S d>4 r[LYe6BSxT%䶘Tz =j $\1>?z2#/{?(_?a錠#Y1b7>f?}0Gn~L^1ac#7_͵wƈ_ r"IF\~H39 *(wcϿ/#+7FF4/oDD)R/o} 0k}k\%%5%5%%5(HҗҗHҗHҗҗHҗHҗҗHҗH7H_"K_#I_"K_"K_摥//މ,}$}+җmq:2¦Ȧ׸ydkW"^"^sˈ:_edyL_FV#3.mG|.}Y<-]FV#7fde3aGtY񿌘[ :2y1~}Y򿎰ws?/t{X7*/ˈq |+;eDo_8C'&3"wb7a/#|T5ysD(qE:w%}禗ˈl05%{~W#Y tszYqOG{36{fFS6:t +RQWseȊu乲eD ,#+seȊu +#{WYyʮ#le`y{/#w9lAe5b6|?zmAe&L)ۯ߾(Է#l܌umco}\2#l?+?dĔ#lK2lYQ U6ZבʖVeseˈ .#wrȊލ5;3rr#bz7_^ݗ6g2\GVnoaQ2boe#kz;zgFL|ӻo#wm=z70ee.$?#wDn!Oߏ;|InGPcwAfD*̈jFPƟo#wz'ߖwz?aT'̽OE#YɿhzY11fzY11"'2F3ӛۑ'Wm7eٻٻ#+;:wcdeG^F.#+z7FLYF4.nDӻDUR.nLIYIYYIYIYYIfk$KdKdk$Kdk$KdKdk$Kdk$KdKdk$Kdk$Q...qzHzzzHDֻFһȊun%s]"].Iww.#w ]һ]G]FV#ΎlsDK\ѻ%]GP,#wtw wûގuFL2Bzq23#tPGAӍq :G;C}hG;]Fiv9]G9*dN7N~?cϼb;=2qi]unzb0#t'>ʮ3ta=NqoKs:zKFU.9]G7sKNs:N\FVD#E.#$r+uedE2b"weK9-\FXfkDD#ZȊueED.E.ED.EoDYI^˔\#\"\#\"\"\#\"\#\"\"\#܌"r$r,r,r$r,r$r,r,r$r,r$r,r,r$r,r$r3%5%%5nYIYYڛ"H""r!do3}ʖVDV#+[#]fYY2#HϽ%YFLّr9s9#42dd:ŸpH>"{WH$9ldhDFV#ύ,#+F6F6[zMdFV#hd8OFVl 2}t~nDI>?(cDlk5F^͈>14%d#$;1?>~̈G)ߖbd팘J3 fd9bFzՑF#ˈ<ˆ#,#+r3?kl~pXИ3|GGPnk2brFvFξ>9G#,#+2"gy.ga9k|ΌȓhY<SBFniw~-qE:\2r6Ys9Ȋu ,#+F֑F6F2D6D6F2D6F#Kd#k8D"ȮFvF43]hdW#;#ȮFFvE03`dgD#"ΈFvE03]hdgD#"ȮFFvF4+hdW<]hdgD#"\eψFvE03`dldWΈFv#qF43]/ldW#;ゑ# Fv<6sdȮFhv Fk9vv,h9"vU/h96k5 hYx9vvkѯǟwC[0Rk51 |kհL~_#5,#+ּFk9ahx0|ZyldȂ#fd~1#^}z}9GH>o#kD Kd "k9"vvFҰF9uEp3{^gD߼{|hhhhhhhhսv}ٽv}ͽv}ͽv}ͽv}ٽv}ٽv{@׮oHT]^nk׭g4uҡ~Fq/9i7"׮ս7R͗@vh3{^쿢߼{t@̽ٽɽٽٽɽٽɽٽٽɽfj$JdJdj$Jdj$JdJdj$Jdj$JdJdj$Jdj$Q+ݫ++ݫqHHHHŽɽٽٽ7^tHdJdjKW#W{e܋N~aeFVܫ#kg"o~% s Ȋu5WYѰhXGXf-#atّ k5l{Is4s ˈh}P-#aa! ha=66\}iXFD%h6A Cʈh>԰q>إa ؜ɦaa 1̈i|A 'a Cs #Kְ֑D0,5g"\2"\9, WFyˊ{u{eݫ+kFqgzy+#MT#T"T"T#T"TdO%O5Mơ;>u+OS?ԡ;h>u+OS?ԡ;h>u3OS"ԡ;h>u3O?Q}Wd:tͧ݁FCw|Wd:t٧݁FCw'OS|g4:tҡ>u3q_ao\cq}F 5s:ڟ#ktlUvq?ӑs:l}.7{i9K^sdM$/{um6?GD7`gA]͏%|}9º/FPDWGP7dg]'83"t"$y쵿NV]bt쵟rcq}FuXk.7o.+{{WYڻD7oN4*Q7_Hݯbu{YöDC7'D$갭&Qm~;u3D=,QnND=t;$$*%$*%*%$*%$*%*%$jFFDDFDFDDFDFDDFDFEYIYY7,Q$Q,Q,Q$Q,Q$Q,Q,QtQ$e,Q,QGFt$D%D5C$$*$GCXG?)s#S+>Ց>_eŧ2SYkF*#+jS+"Z{=VyVaJ\Q;#+b4Gn(_^#(FI;GVĨ#$Fyﹲw1u?x#~#(Fw?kDh~o~~ %oƯ#䟌{1⟎Zy 5\2b"Fy.F5> dmOâ@@O";$;,;34$4iXd'eя";$;,;,;$;,;~<Idix$hȲ3Έ&;,;#$h3N";$h3N"Έ&;,;#hȲ3N"Έ&;#$hȲ*;#$h3Nd'e#hײMvYvF4d'/免ײMvF4I<$cDMvҡȲ3"NN"'NFV =a)#&;nש5#+3Fd'#gĞ&~R5{sC1I\1bC;;3A]1q}"|#=g槨ޟ1"h.#=񱎐ތ|#=SF{RO̼wg.׈x\l{1=OG{' zGΈk#+OtdEvȚD? haDMvQe'egDD? hsDMvF4Idd'я*;#$LvIvYvIvYvYvIvYvIvYvYvIvfi$IdIdi$Idi$IdIdi$Idi U"N"N#N"N#Ό";,;$;,;,;GF%$4ҵ,ed'e'e.34ҵ,e'eqȲHDDFt4$$4>߇Î<9$;Y dd#>79tN#L 'ꎠڌLsȊt]f32sde:e2b.]#2$2?e%˶2h:.o]ˈ >t|(#27b2:#2 ?1s?_˶:.sO]Q#f4V&qE`:]y^ddEU2ª'QQDVF?4$(HȪ'QQDVF?4$$4$4XT%U4$4$$4$4$$4(HȪȪHȪHȪȪHȪHDVDVF$4(ȪHȪȪҸydUikY"J"J#]YUIUYUYU1J#]YUYU7*tHdUIdUiKJ#J"J"JsUȊtUsD>''+t也d$?DD]:ªBW3bBdD]]G[KFZ闵t乵dD_66G#ϭ%#+q;Y.9ȈX8_$Ŭt$#b-MGZyglgŬkAkhxFZ;ZZ'֒tj}G)#2+.?0307%ȊdO55~i$IdQ&O55~i$IdIdi$Idi#hM"kM#ֵ&fDӚD֚MkF4IdѴ&fDӚMkYkQ&fDӚMkYkF4IdѴfDӚD֚MkYkF4Ѵ&/>#$ּj͈55#֌hZy4Ikو5#$lDӚD֚MkF4IK;$lDӚMk75|ѴfDӚDt$֌hZ3iM֌>fdEk# ZLjaj8#NFoɈΈf8+3F '#+3FpabFV gNFpmS1ásdp2b8c g<#l8I~1#_?ψ)x]_1J1q1"r?d͏ hhZ3hEBfDӚ?z3/j1Ij͈5~UIdѴUkYkF4Ij͈5~VIdѴfDӚD֚MkȭZ3iM"iM#iM"kM#iM"kM"kM#iM"kM#iM"kM"kM#i͌55555555555tIJdIdiO"kM#i͌55555G֚F%$4ҵ,&&.34ҵ,&qZHD֚D֚Ft4$$4~⌬hMGPkH;GTkԚҚȟMzIk:\k2ZZ\k25y5'LGLFV\#2Yr>az ##+.t|R$#2lnˌ?}|\Ȓv~{Ge~/2Kޏd1׿Fe^(#2#2\]^'s# X&ѴƯS5.r wLGLFV-ww;2n<77twީfdEv:B/Ȋ̑%sɈ#e'#&;6^q^|H'#";w=^|WFDvMBte?̗lk3";y.;sdIv:h4>xOFV#~FIdi3xO#yO"{ό===~FIdiCxO#yO"{O"{O#yO"{O{{о>F 7O8Ѽg}‰=N4}p#{{v'h޳>D 'Og}|}py{v'D 'Oend}pygT}py7=N4}p_:{v'h޳>Ӹ&;`97mf6|a@r/; _i\n0=ӑov~3=Fb|MF{7ׇL:=Fb}u#qG*#=F̕ߟ#=y_޳FmtɈxy=#=(#=C_}z,#=q춑EyS?{Gy͕Dgʼn=~ 2ﹹ맱n~RF/a{vth޳F?#8ѼgMǍ=o:n3zЮ޳D77=o:nC}gkHޓHޓޓHޓHޓޓH3xO#yO"{O"{O#yO"{O#yO"{O"{O#yO"{O#]{{{{{fIdi$IdIdi<4ҵ,'e====tQe==GFt$$4C'''Ѽ^G{Yڒkʈ(.*+P^>'& /+yfFDnɚ`PK ԑ 4G#~`6V#(#+; `SˊuO΢@@~rj$JdQ(O΢@@~j$JdJdj$Jdj(P G57mh}͉@kN4|_s)Y6 DS5'm9h}͍@knM6לh U6 DS5'm9h}͍|-|_s#+M6<*M6ܸy4|_s)ҡ DS57m#xvYΛ`;n33w_ؚl^Y_eM-7(>T'2b6D|:bCngneCngn3vgd͆괡*#bC 'm7qOGІ6>kDl_/fC=nhC@kn8\7WE6>|ak6'&6t{Ymu;tG<6vF?O m:lhЍlConۡ6vDͷC7 mjCongn"ц6tF3 ]lhCW:#ц66tE3 m`CgD"цΈ6tE3 ]lhCgD"ц66tF+ mhCW< ]egD:#ZvF+ mhCWKG"ZvF3 ]q6tEtmhCWKΈ6tF+ m芏m(#+6t,5؆ΑF9`CȂ ]#mYkmn)ϑ:GĆHm6t,|za5Ȃ elh& ]#lCG~>G؆kmh*;mk~zl!{1'z!sDlhFІ%^=u !WhCF؆gy5؆!5؆ΑF9`CȂ ]#~f:#<6tE3 % ]lhCW4ц|+ mhCW:#6tF+MWd:tن$}FC7IlMg4:tن$}EC7IlMg4:t͆$}EC7I_mMg4:t͆$6t&+ IfCn>Сh6t&+MWd:t͆$6t&3 IGC7IlMWKСh6t&+ I#>~XFԆ|菸@vkdEȚ7;~5:nvF7;i9@h>vF3- t쌦]#+ thSfg0;<ޝ/@ZkHѷ_(1{1*ٿFPh9@ngθ=蛟59lU:GּX}ya;e{M׈{$}E?#I=n"{ϡgdC7I_=n>yϡs&+]MWC`HޓHޓޓHޓHޓޓH3xO#yO"{O"{O#yO"{O#yO"{O"{O#yO"{O#yO"{O"{O#yO"{O#yό=====GF%$4ҵ,''.34ҵ,'qHDDFt4$$4$4>9=ai|=Yx'5m`Ȋdd{:{2=y=YxG9kdd{:{23:#Kz9=a/_ż,#=Yk4ВkegZ|Ы&zG9";!IdI\ ̑%sȊddEv:\v2";y.;YNG4,ȲaFDEvIvYv4,ȲsFDDFDF?$4ߕN#N"N#N"N"N#N"N#N"N"N#Ό";$;,;,;$;,;$;,;,;$;,;$;,;,;$;,;$;3$4$$4nYvZȲȲHײDFDDFt(HײDD#N#]:YvYv!HȲȲHȲ\vȒdeddEv:\v2";YʈFHvnDvCx1x9";>7?V6>#@7?}h,)PGXn~ȊuedE:\2@YQY(O΢@@@35%5Y(я@@@@@@~Jdj1WDVMYF4(hDSDVMF4JdzGUDVMF4Jd(hDSMYF4JdhDSDVMYQhDSDVMF4J<%lDSMZ6)P"+Ј@#%UZ6)Ј@GSDth 4)P_:TYF4(hą]#+6Y1b6bCcl#y5yOF{nּ'#=#y1aɈe'#(;scdMv##k8RFLvјkd?ZdYGPv:?m~se_؇de?5Ȋ쌑5#kʎ_eg^^";wƅwy]#uY3W gD3D?$hj8l8#$W gD3D?$h3N"Έf8~W 'fHGD6F2D6D6F2D6F2D6D6F2pppppppppppppp钔ȆH3N"N#N"N"N el8l8t-Kdi$IdIdiKnjb8t-KdIdi<4ҥ# ' /b8d8l8l8d8+ӑ[Ȓd d dde3sFVd#e'#+Ɉ|T&{}<'#+q7=Yپ3G#?sɈx8|{OF{o:ރߋx.TΈxj_F{{y=Y񞎰1K3G#=wy^#~VzW-sUxOG,ޓgdFD{{{,ޓvFDDFDF?$4ҡϛ1{{{{{{{{{{{{fi$IdIdi$Idi$IdIdi$Idi$IdIdiKR"{O#yό=====GF%$4ҵ,''.34ҵ,'qHDDFt4$$#ȎxOy5>W9. HGPF؆PFVl(#+6ԑ6!Zs󅭈QFLhlGQF~<Yӑ3"Fy.F1W׸>b#XGP~#\?d#Z#T1edE:\2"FY<9$Fy.F11uďKbԑbԸbCYyZl(mbCdClC3 5 % 5yZl(mbCdClClCdClC~Jdj % h664ЈfClC# % h64P"; % h64P"ЈfClC# h664P"ЈfC# %gDDwTl(mhD͆7fC|-lhDDh664ЈfC|xGDh64Pl(/# h6D͆F\1J|)9hCcjdS @7_ 5#k6#k6zn(qMƈ(/*>j5ȊSIoz,#+ 4FLwϿ#@"#@h'#@QGP?\ϟGPx1WAʷ=5` ʈ)\\T({dQ2h/K0QK0Ѽ[YgDD?#$h==#$YgDD?$h3yO"{ψ=~hWѼ'ͼ''''''gFFDDFDFDDFDFP%$4'gFDFDD#{O#]{{ZHޓޓH{ZޓӸydiKG"{O"{O_:{{{{đ4>9=ai|=Yܑ3BӸ";y.;YDXG[3bC&{=(sȊ̑%{B~aK1=AɈx9z>Q"}?"\v6#=sV/yOFV#Ͻg,yOG=Y{{:Bޓ=YY'===34$4Y'======~hIdiC=4$4$$4$4$$4(HޓޓHޓHޓޓHޓHDDF$4(ޓHޓޓӸydikY"{O"{O#]{{{{1xO#]{{7=tHdIdiKxO#yO"{OtdD#KޓLG+PFV#(#@+ ԑ *~$#+ S zP#@GYQ<#K ԑ S b2" K3B {2"ރK~:3 {pUKӑޓ=e6ʎDGHZCҚDҚ&~IdiL#L"̌222~IdiõL#L"L"L#L"LeepFvw07l9\f̉2`N4|s#;e6h.Dsw0'l]f̍||s;e6<;e6h.Dsw0'le`nd|s;gT|s;72`N4|s_:e6h.fw63{}cv6|U/f&.#K猐|Dt/\#0l7m6Zo}?73f3PowZl-fff33W#h-䷵l7'n񙎠ǥ2bCI ?ʈ +|V+#&0 f曟&07?U`71nv0| F*D?|DͶ"7l8TeMǍ~UU|q曎YU6t'QU77XUeMlj*o:ndU|qUU6tHG}2Ui$UIdUi$UIdUIdUi$UIdUi$UIdUIdUi$UQTT%U%UT%UT%U%UT%U.**tHdUi$UQT%UT%U%UqȪHײDVDVF%4$$4ҥcFQF%$4nYUґȪȪQFRDVU 3ªHϵ̸'Y<<ґ~?Is?Is?ȊdD`OKuFU [QW9*񣱨J"JEUIUYUYU$*Ȫ'QQFRDVEUIUYU$*ȪGcQFRDVDVFRDVF?$4*ndU9|Gp;MUhrFVw7#8T*N4U9|Gp#;qDSw'#xFUw7#8T*N4U9|Gp#_ȪrDSwϨrDSw7nMUhrFt#8T,fGxa;4}m_eQ`7>aqneEO%'lL`hDFV>Yԑ9n O#̱9#+slwNϑE96sl9|s0r*#"0l8#"0LGP`~/"01ˠ2bc&072L`n~65qZWmn-oN4k9lGZ|Z|r~F?7Ѭl-mZyr~D6j-meH֒H֒֒H֒H֒֒H2XK#YK"[K"[K#YK"[K#YK"[K"[K#YK"[K#]:ZZґH2XK"[K#YK"[K"[K摭el-l-t-Kdki$kIdkIdkiKnjb-t-KdkIdki<4ҥ#%/b-d-l-+<g`i|*sdIU2*y*YyKSG)#+ϵddZ:B7nY򕌈H}-_ɈXz{FV#ϭ%#+z%qEU2ϵ4>9'CI"IOOOO)~~gNFDOOO)~~`FDDFDF?$4!nO^﶑nO^6nO^﶑nO^6nO^6nO^﶑//wh~}'/w;6|m&|m6nO^6ngT?yDm<|m6CnO^7n\wGu#xm{ܛ/LFݸ'/wQJ>{O^wmsAY;[m,1}'}Y;[;[ݾ[ݾ[d<Ɉݯ"~2ckV2"~r"~2l@{~BWˈ >֑?y7tUry컽LU^7noEUyDSm&|mDUU^O*/wh}*/w'QUm&|m#6XUnh߿uAUΈrEP3U加*gDU"QUΈrEPDV+U匨*WU9#AUΈrFT+Up8#QU3\T%U匨*WU9#QUyDU"\ΈrFT+µ쌨*WU9#QUDV+µ쌨*gDUUp8#QUV+U nǪrS)W|'YsDJ!FXUn0y*SWYs劏#b-tw# Ϫ# s<sDf}k# ?8=y,0 G|l-[ m9GZj?JkpkUkj-Y5Z/L>tCsE`2"0׈Y`ΈsE?F\(0gDZY`ΈsE?\(0,0W9# sF+1 0gD9# A`ΈsE?Ft&&&&&&fFFDDFDFDDFDFt$$4ҥ#fFDFDD# L#]Y`Y`ZHHE`ZӸydiKG" L" L_:D`I`Y`W#|4||.1!2 9OFV#&#+|[KFV%#+ґ֒{5yn-Y̒%ksk[K#[ < sG5B4o Kґ֒k[ < sXKF+>W9*񣱨J"JEUIUYUYU$*Ȫ'QQFRDVEUIUYU$*ȪGcQFRDVDVFRDVF?$4߰**#$h2J"ʈ**#hȪ**#hȪ2J"ʈ*#$hȗMUF4UIKLj**飯2J"ʈ*#$nMUZ6ʈ*|-T%UeDSMU*|-TeDSͣJ"_:F4UT%/**#*YQ1b*EU#kU#kU# [pϑ-ZݯɢkdE`Ț攌qL6^#l-~Y{dZ2C|Hx&#+3FH`ZA[ ,=GZ/ͬeLG_?GZY&M֒k#b-w_YK"[ ֒?0h֒fDZF4kIZˈf-~>UkIdkѬZZF4kIZˈf-~`VkIdkѬeDDZ2YK"~ZH֒֒H֒H֒֒H2XK#YK"[K"[K#YK"[K#YK"[K"[K#YK"[K#]:ZZґH2XK"[K#YK"[K"[K摭el-l-t-Kdki$kIdkIdkiKnjb-t-KdkIdki<4ҥ#%/b-d-l-+43.}Z(#+ґ窒a KQ Ȋt乪ddEU:\U2"dDTv_\#~ZRo􌈪U?fdIU:\U2*ßI%?8,IFV#$#' zOȒt''~?i$?Id?Id?i3I"I9OOOf?i$?Id?i3I"IOOOOOO,~~Hg:F'4$$4$4%4$dFFDDFDFDDFDFt$$4ҥ#dFDFDD#I#]OOZ~H~~~HOZ~~Ҹyd?iKG"I"I_:OOOO\44_g3"&P:&rm&dDj3b"cdD2&2Ȉf"l"&[5D`&&2Ȉf"~TL$ϑj"l"#H"Ȉf"~TL$j"l"#h&&2HlDF4I3F2D6F2D6D6F2D6F2D6D6F2DDDDDDDDDDDґ&&HD6F2DDDDD7l"t-KdIdikY"H#H"H"H#]:fikY"H"HM.l"l"~i$IdI$̑%Ȋ~t~ddE?:\?2$#wȈu~4:ZdĜ>БΑsȊs̑%:>xvFvrsۜq?qs&uɌs4AahrHȢȢH1FKE4Y4X*HȢȢ@DF?h4h$h(HȢ@DF?h4h$h$h4h$h4TD#EL4I4Y4I4Y4Y4I4Y4I4Y4Y4I4fh$HdHdh$Hdh$HdHdh$HdhKG"F"F#]:Y4I4fHdh$HdHdh5!xنɏ<oL4!xFolc ˷F61O[#M^5OU*/*oL4!xFolS ˷F61O[#M^5[#w|kd#Ȅ `FFDDFt$4$$4$4ҥ# .,$3$4$$4nYZBBHײDFDDFt(BHײDD# A#]:YY!BHBBBHBBHB0A" A# A" A# A" A =БB! AdD;s!ȊtAz1!a!A!@Ȉ>^IGPng#υ #+BF?4$$4(B<DF?4$$4J OU"$,34$4J яy"$,,$,~!Hd!h}qa!/$44|BHB_II>+Q>o!h$!h$!/$u#FHBHB_:I>o!8# A# G-$$qHB_II>kY# G-$$(#nI>KG# A# GK G-$$4|BpFF[I>o!h$!h|.#,oj:bBc7hy17چnБn1ɂGϑw#@ 7>F ~/A}wlA7'{: :BnnA#A#GgD7~C7h$7~C7ݠܠ#Y ݠ#Y #vFr3|nHnnHnnA#A#Gnn0A"#$hnn0nn0| `Ds  F47HKLj#$cDsDvwT7 `Ds 7|-`DsDhnn0|xGuDhn0A /#hnuDv F47Hd7  F47Hd7 `Ds >5!o!h\1B1vq7>#w8b_1Bw}D#vv/7cwY#v4O~DOwD?v4O~DO3ߏh~&DQ~DO3ߏh~HDGD#}"z#F&}#'}"7}"7}"'}#(t|HDoDOFOFt$}"7ҥ#~FOFODo<}#]>Zt|He|GoKG"'}_:>>~FOFOFODo{}Ɉ}UG "gpw?FK:r?G{{G #r]?<뇗\vDɑ]} 'g&wtןw|Hw3]?&wtןw|'%OF?)]#']rHw|'%OF?]#']"7]"7MnP.|Hw|ןwtןwtןw|Hw3]#']"7ҥ#?.|ןwtHFQ?7|HײDOF%]#']"7ҥcFokY"']ґw|oDOFOFQ?g龪#3rןo'2#ftڑ #j;|/L,`{Q Et,, #b72s7Y4N,, - -,`FF?Љ$4N,, - -Obl~~ h$ Hd Q,, -Obl~ h$ Hd Hd h$ Hd hX@"[@#{r Hd , -`DF4 Hd ,`Dmzg0t|HYl$A8 dd 㴁WmnJ۸z"%"F .`r SGL.`r & ȧL.@O d & .`r e\ &P0A>L.@]@ & ȧF 粂L.@ar|(\@#Av (\  Xat dP0Av (\`T9"=PU t\@Ez.`DP?Yl-"XT$zV<| [> H(.~W鸀\@E L.`rV]`EP0<.@]@ & OL.@0ϟ dP0F .`ry]@.Av (\  ]t  Z 0 Cr d`H.@] Cr`H.@] C:u 0$ .@]!Avtd .N  \ Cr2d`H2Av \&.\ Avt0C: d`xː]!: 0̧  d`H.@]! d`H.@]!Av P}QA^rHZ#kW["?"up'Q~6`' !h~Gη~E>H`7&ocR&/MސXh t,4yCjOh '4yCj Mސ 7y< M^a&oHM^ 7yCj t,4yAn<{u druSuSuSu ?}y>y>y>y>Cnn!:y>y>yݾcu ?}?}?}?}|.{u ?}?}& &2LMLM3̧y>y>Cnn!7G^O05G^O05G^O05G^ϰuBur{ Sȫ c_hj~#_"gXp#|EzM1Yp<H?j~? }y:#'#gMW3ӱy><MWLMW3̳y>S;7Ӣ sCjR;vnH\۹ sCjvnH\۹ sC:ur;7s sAnҩC۹ sC:ur;7v>`h r;vnxː۹! r;7s sCjҩc \&\۹-Cntv.0:B;7v.\۹!sAn \۹!sAn r;7v.i玜op;sG4$s}nB+i#~QuvΎOs|gW$tvy\BwGwvE:ݑ< ];axnH]; wvCn'^ rg7 rgn9 rg7 rg0tvC <'tvAy:!uvA rg7W3=xgȝWLWLWLW3~+rgSgSgSg w|SgSgW3~+ ~+ ~+ ~+W3~+ ~+ ;=x':=xgx0u{^N0u{^0:bgSg wy;y;y;y;Cvt:=mg`'㊤^~ϫΎk+:;.vv\Q@UEzV3LW3ye:ye:C2ax~+W2`2a~+yN2`2!w{^0sbg +v{^N0u{^ΐ;=Lg'^t4ktnH]; wvC rgnH} rgnHAt..ȝݐ: wvC:urgnHA ];!uvA org7s wvAt.nH]; wvC:u :! rg7eȝݐNSG rg7.ȝݐ: rg7.ȝݐ: wvA;ݑ+]ӐVgwdXۈΎ;4W$tv\ "掜t:#y: wv< ݐ: wvA 0OBgn'^Rg.ȝ0sBgn9Rg>`yN +tvCRgn'^ rg7ײRg7 wvCRgnH]; wvCnH]; wvC:urg7s wvAҩC; wvC:urg7>` rgnxː;! rg7s wvCҩc \&ȝ];-Ct.ȝ0:Bg7.ȝ];!uvA ];!uvA rg7.쎜PgOP~a:#lEBgǟG$uɫΎw+:mx"cW$uv*|vvN;w$hB;vnXR;v.ܐ)Vh +sCjMh &sCj ܐڹ s< \۹abvnH\۹ sCj +sAn` rg7S wvC: rgnH];!: rg7S wvC.ȝݐ: wvA솷 ҹL; wvC: rg7.ȝ];!: ݐe2nHA #tvCRgnH}RgnH]; wvC삝vvƊ~ɯ:UvN;{"WHjx#Ωj+Btz"pAyz p< =ܐz pA =0OBn'SR.=0]Bn.R>`K d*pCRn'S r7cnH:A r7.=ܐz pA =ܐz pAtnH2A r7S pAtnH=|R.=!pC: rnH2A r7SǀҹL{ p[ !=\{a>unH=\{ pC z pC rnH=\0pSpI=ھ"O^۹"dq7+9B?"O9^mHoRp|gW$uv]Ngw: wv< ];axnH]; wvCn'^ rg7 rgn9 rg7 rg0tvC <'tvAy:!uvA rg7 y<.ȝ` ^0uvASg^0u rg_a ^0uvA>uL]eSg/: w `SgSG0v rg/:{o.粂L]eSg^0u c `Sge: : ^0uv|ꈝ];{ .ȝ`W;{L];{ .ȝ`+ xEBgJ+''͎`;U"O^%<]{xpE:="^^W{x% T ^0pA+=\0Ob/z`L.=`Ss .. r/z c^0pGS"S^GWK4zN7roé+~%O^%ti=|wg47|y|7|w\0Oo0h r;! b;ap; )B; b;! b;abq; Y5r;v^0sAnS;/ڹ 󂩝 r;/y0sAnS;/ڹ : v.粂L\yQ0󂩝 `jWyL`j炷 S;sY v.粂 r;/yԱ\V0󂩝 2L\OS;/ڹ`>uv.`jS;v^0sAn+`j v.`jS;v^_':URg:YCV䳳v%xvN?N;HhW |4yEz\nS;3 v.X r;/y0s<Ŋ`jy۹ 󂩝L\0hb;/ڹ`v.`j+\y&󂩝 )Vl v^0sAnS;S v.HSLܐڹ sCjR;vnH\۹ sCjvnH\۹ sC:ur;7s sAnҩC۹ sC:ur;7v>`h r;vnxː۹! r;7s sCjҩc \&\۹-Cntv.0:B;7v.\۹!sAn \۹!sAn r;7v.H~pNVZԭ ;BZ0tk#%:v뼡[O^ӭtkE:ւܭ |$tkAֆy!ukAւܭ [a n-0OB6n-Zan-0GB6n-zЭ [ r6Э[ Rֆԭ[ r6n-0OBnm9AO#W}}σ^_o?C??_gbo~:w97y%Ӵ3y=qdyC?ͿϢrsփ:r4@zN>t[gNxΙ>6y#|{-W9JN0Yk瀞;1s; {瀖R-~~&e<ԕ1ec 옣GP =G;턯/'2(h5_ exF_mum!ez#k~nRuc}Mܮu}.teӌUp>mvCkEp܎~'q:gQ?C|ɺt~&ǡkzhr[#2svcZ?Cos;UnC.kk^n?tʲ|Q^~°~0x6-{pfON}=D{\X.e_vݔ_8 ~汾0յSK:h_g=~1m&]?  _k[Nt8] |~Wx`7}>`jSWzV-9H_xBx\ *o_?=Ez~L]wk$/t^Y?&D["L^'pL_~zw$<0A \ׁN‰k5u]1YQ?-{-`䟛⚰O[3{} ϿU~K–MXs;׿k?O_Ͽsqs)|5g:6Kv?ƿ/{]jƻ'uCDZ >qe22w:+ ^j7_q['y+_}񮇖"}}G^;TTk{@k{/5w}ղş_/]R7:gGNlc7NeSy~C_yn1ԑuJYAK YcV/Vu^~N 9{T~{M9~>/Ϩߧo"u}55 ?};wzODyoeKn<dݞuO}/<5ީWxh9$wY(ǿǛf~_r𺣿=/=[im{u݇`cϯ_]:o׿xwW/^hvԟ5ݸW-z?{~>+klUenkY Bq1~_1~u?[.Ekc;.24-=?kivu j:C߇sǣ/oʱr/9_?ϟ  ?. bϐ~?i> ~{/xCү ܐ~!^Bl@ ϟ ~y@/~do ?5/Fـ~'{ \hxk^5t hk p .|Yn9E/"KC~^` 5^f, pQ& 2\8.j0|U/* 2W/9^5R/+2-G~: x%yy+_.zµa/?'7uͮκxx =Yǥr{BZ;Ls= }E1_-|27m+gFpg7eZǙ-OW?*zW` \U?*2e/k\d@Oyٵ7\v>_NtY/:p+\nx_ul@ \nx z Y.L…/tl@IW~ܕIy&L>w]l! Hm CCl &Md`8Cl M0C l Md`H6Am!A l M0$ 6AmaP d&M0$ 6ʻ A d&N6Am!A d 6Am!A d&M0.6Am-C Md`H6a` &vl"&`qmu&EMfX֑`*6#T5xf%-6^A9Cl½&O:í-lB{M=?"l qCgC`p[P :R>~;M@ӢH Q"&L>&/S ,ڄ  c :,! A̓!A6d< ̃!}A6d<y0 ̓!A6l <y0/A̓!y0 A̓!A6d<y0̽:\yd`Ƚz+APd & {51l &P0JA~dV̓ <EP0A6ydP0<r/̃ <ܿ&A0(A6y(̃ <r/Cd<LAp2d & `2lVCd<LACd & E`2yẽd@<LAkb?C.I>kk#)>""#j:ȷ{ H}:Dׇ^GEG,*뿿ByXT7,GK~/VaK~*zyEYQWRr-6JDHAl(b"bCHR(–`dKQ0Y AXa,_K!Ȗ` (Y A(, [R(,Ed)R0Z ך.{Wme|KY2syR1>~4ت|aw>"_fplU_*!Suhr_Uԁowyxo`Uj/dqY"zRX*ㆷÅ,8VnEUQU)J>h&2B*lVe~NCELEkYat-6 &"Ȯ`r-k (Av-k)\ ɵ(\KZٵ0AIZ9M$2n{zt-zI%nkL%4k !y%|B2?GkIzfD1$!Ɛ A601$#F !A60$<1$3`00y@1$#Ɛ A60/cG00l` /#F204 A60l` i 1$#F d1$!f`` 1 F !A60d`1$!Ɛ A60y@d#Ɛ Cl`dc8A60d`0A60d`d#Ɛ 4T$y:r;-YI^܎"ʘɫI ƑO3X2;WIfV͎`2;#hv9NE%DA(θa{, GAS8]x׷821;?F25;m>+Efv#lv*Roշ)f/qN}`uXdvpEEA۬H0;5A3}:H2;*MEٹl_Wˊ39ȥ]&{f=. !;|> f~JG"lv dcHfG͎!A6;lv 1$"fG͎!1 fG͎!A6;dv1",Rdc &S0ACdS0NP2;,R &hvLfG0()̎ LfGEJdvLf`2;y@)NdvLfGEJdv &#f`2;%S0A6;dhv &#f`2;lv &S0A6;{f"=ȭi*2D&I+AEᮢ:ɯt8 ,› fu4?۳e"=HT${_#=HTgvs|W^ejv>d"sH`vjj;J}a]㥎'3NV{$ 8FnK f\F`v?>,TH2;xhGLJC_2;l4;WIf',)̎ NdDߓ{s=x@xrCYDU$#A6F1dcT0 1* LH 1ƨ`2Fl &c$ƨ`2F1>$#,h1* e-Ҁ 12=$Ȑ #A6F=Ȑ 12$c$0(#A6Fd1dc$Ȑ #C2FlcdHH #C2Fl I1dcdHHd@l1dcdHh`1dcdHH #C2FcH0F8]uv*Eµ@X l(ߍ%GλInh* 7eO9!z<"s"(MHX;HX;g_RƇ:] Knrd^ ռsX 92qC[ nA7T_KMInh:_&DtWy|`ٵEA742HpCc˶[$!|n#Aۊ749ՂL1<{+ylGHx39["p0jv8e"dvFr| A={^d#Ⱦǐ|π#Ⱦǐ| C={f|a+1$QM(C A=d#Ⱦp^d3`={#Ⱦǐ| C={^dcHG} <{ dcHG}!A={ 1 } C={ | Oߓ*J%G ْ#W;IGrvZ )WN6`2F'G/#Q~d E1 H2Ft{#&R$\TuM.^mzaEjtۏ"%(1BH0F#21F1>]ܹȎD$pE:4FԯIh<|+1%AV1R$@] #ho1  r.H2FdP2)&JK0Һ@W &j*#]fDGy%JVW j-l [+E:VlZdkeHH [+CVke [+CVl Z dkeLVYk%x (Y4[+APd &k%{`Vl &kU0Y+JJ%QdV [Z EkU0Y+AVdkU0YZ $* [ZLJ0(Z+AV* [Z $*UdZLJs@^rYyQd? @+"ah &&رa 6,aVg*O$*ȫY &ųXEnhx_d[Hn6døF)ұak$ڰ*ɆY`BHaa_5IdJ<ޗvmؐZC 'mȽ.oHaW''9HaZy>F&6 36aǮ_Ԇ#WMRso#篟hu;+lX mG  SmXI6VW$0vaȚ"L ë 6,vP`ÂsSmX>'6{d&l\mX>'6DƚN HamI6L*ҳa +lXdنL6LSd &&6lц EV00Aa dV0ٰɆ fm`OцL6L\c=&fHd&6̐ 0CalنN0COl 6̐l 0<`ن dfH6Lm 0COl Ɇ dfl!0Aal Ɇ 3$&6Lm!0Aam"ٰ4#r#StdW L|߄ 9#d9͙!3A6gsȍ"asfxޜ)1gs-4g Ml*-sHǜ)25gl9o &`:K4g-}"aWeosٸ>irx6g#hta欎NSLA):q>lDZL`pzGnU!*kX2gOr2gɃ9Sc3GМᕪ$sFC;4"Sc#kAG6Brd+GؑrdurdygtdmaGfxޑ)qd#dG&Ȏ̐ ;2CRRّ#082<ّ#dGfHL ;2l#3J*82Avd`.zɑAtdDGCCDGCpdDGAtd;!td;%AtdvlvĎlvlvl6l6l6lvĎl6lvlvl6l6l &[iE6la ӛ-d߰#`Ñpd l6>td;D4Eh60g{v֜m4g;RMwt#݈"OMvrrz8kt`)BNLU:Osڎj"yӧH)1}7}#2}7}4E6}y_}}WS{M_ɔO6}-L=Fa=uOUa^ ]L_IPQL-ECm~{}$ӷ~.õ-cML^)H9rȭʣS$v+`>{GO*"Sw^n4e#E!ۨH6:r6Ht#xh銐m4L^zE$8}WHcɿ$џþ ^g8U9^e"A{Oyk}yAEWRh>/+֌2|`鱿{lC;Ͻ" "lDG kMDE:QAt ";H :rBE:*+fZQmtmT4\EJdE:+:rW*YAP2Tc&9o&IE훎Tc&!3)1$39739"-3y3IA6d&Ld3)f0{`&  fRͤ!{#ͤ `2=T0IA6,̤d%3)"`2+fRdd&󀢙,̤ ɂL ,dd&YLfRdd& &3)4tdELfQT++| ʂWLR}e+;"=_YT}%+|d[Wn0ɼM3ɂg8i&:ʂ=_HWV$v'_9PaÎHAV tlFE6F_tm# ʊ" 8(HA*>zZꋃHpc1ª "AtG+!R1uy7I+/t6o_V$ɚO^}yLH4umIEnIf"=3HLV$?Ɋ3);frrhIE:f"=3YTU:Ovc&+3k 8ȊՑXmHXҴI1OҚQmH6*¶`!l"h'}iƊ$X0FAmdX0Ƃ6 fm`{6LQ\e*6Ҁ6 m4=$ȶ!FA=Ķѐ m4$(ȶ0(FAd6md(ȶѐ FCl6l#hPHtBPc9oahHQm FCl FE:QmtmU:Tc!(رm')pW4DGnզ" ?7ɰcDG 2AbDE:6EA9oIT" c c6s}[$D-JX7o#hk`ڢvؖ`3{7?D4&= b}T.qyG bך\uDZQAt6t # "H :SPc9oợ;ZQ0Y &׺;Thsnlea+hx *BVmR)t#;O&F9!Wa+hi0v  +4&,Bì+dWhH& i@ dWhHP] BbWhHjN]+dWh\ BCr  +dWhHjN]!BAv Zv{#筠"l d+hHVPy+H *ұt#dlYAE:Osq` :r *VPy+[AtBzW v\"W?u.+4/+T 鬤yWH:®t"i p^l9"QU3+r —*\!]Bt\"WyWH:r*®P !W(\ҺPAAt b>?hq2KqrAT !.DE:ёQAt ` * lCA@ :74¼ 0P\ Q DǂA4.DA6Ǟly@A,  A, bd'{(DAvA\a4l &( bd LQ bd &(®`2l &X0DaW\l>[*1ڊ "C[UchHV dߴbgC؊+U' v602=[b'y"t|rUlK*ޖVڊ$C[H}G:"=C[`h5V(}|#hhq[$!j3ᅬc -=/G`h.wEFAC* m%>^ghH4u̬*?I`hBՍ_ "7$C[dhkHEVHVghAC;񇡭H0x]#C[2b_`ǺV$YWuHTZԑ+ҳtkEuJZuUY׊u}W'󫊰v,UE:~uV uےd[UuHϺ*ֵ`uN1ZW,9u- 9ou5 udjH{H!YWAl] '{!INAjHUaPl] ɺ u5$*Uk: 8(M],XE XMJiXGλXE:.Vb'bXG XGNur4p伋UbXGNbtXp]s\db_ [Iu6d]'U0X:ՑiHǺ:r޺*ұt#h]'Or .Ū#.0YWRBu`] ֵ>2u?cx_[ײcMV[WEuӛǰ{ZW\S`]h\SJEuCʵᾴ#h]"WEuJy[ZUuut#筫"HǺ:ֵ|8B%-y[WA筫"g59r*q#]lޖUN#]"X.Vu;Pv]"XU xG?~DZ.֑.VU$5lXE:.rbf\aV 5$XҀ 5=$.֐\ XAv=.֐ԧ 5$+.0(XAvbd+qw5dK.E \6chGehaC7ehIv*CH:BV `:v:֑VUchaCK3E|:vDb ?]a6>{V#XWGȺ v"ɺw=YDZe]9o]Iu-^%Y׼-YWu=E:s9o]XWEuMruRr}:1W$X:R\K4EغTk][WUALsZyЊ<"A &Z.Ã*ItӃVAAZ/A+<(z1:i֫#i-X'u~Iδ"?ۅg;Ӓ_!oHruq済nq4!ix+?#ҝ{}{gZk}8i}U5];)^Et3>8SE:tgZkm3#73"'Yt4 δ>;?HÙpL43};t4+JgLt1{I" GN-0[MO-0{Md4Li=&uhRw&u EIm/ v9LHÙn:{3" gGnљ0Av;̊љwLy@3- ə 3-iL'{(9SAV3]atL &g*iLٙLTiL "LV$<*A &5+3tLiTE:&"=ZIUcR+3I-LjIUcR+3tLjEz&"=Ȥ%kr3dgZ09SAv3- ;ӂə9SEnbEzTtW9ӊ"p ?jAaſ-I,xU=hZU=h)ZAA+rN޶jKzGZ簓ڥ% oe5Gf]t1"ۖPƼ{[G"NޗmIqXE޼ao{k_b$ob҅莜t#m;V\tְbage-;"b_yHǺ:r޺*ұu5t"y:"h]_yHǯ*񫎜t#"W0`]'uUc]9o]XWEumKǺ*ұu0XWuuӺ7)bXEd+qNXEkk (ҹ.Vu伋u],޶H*\X}Qϊ#bƥ}.Vu$X-iXq1/T$غ~R.~Ża6tQs̽E-K-25]#bXE A"Httձ" "_]"V:#b+XE.#b(/-\, PmU !ZA2/]l?\kx*q~XEC6u\!YWÎ_u_U$ɻt#W ~Րj_y/#"UAW = ~0Wٯ=|_L~`򫂼 &*~`_WYgL~uѯ _-`P_dZ0UA_-tjEz~UW*UE:~uD* ~u;;O#Z_UW+I~uW IhR'LUIlhϤVgRahR L"ZdR&:yIH2lR IÎUEnPWՊjEz~U_]#MHǯVa2=1 &\g!&u<äVgR+3I &&\KM/1&ux5a;6k-Ljwun]ncM*]H0{YnԲ…GJ+&5nEnI&">cHǤV$W,T\4AV$ _A:9I5Ll4ID:9svYHZa`*ɯNΜѯNՊ$*~ _j&`2ɤ@v7L{ gGa;hG;v"N6)ɫ5yPE؃L`E*c$~ 5 djH{H=!yPAA '{=!iGAjHT=aPA Ƀ 5$*TA9AxPG{PE:ORA9AG$xPTAly3tT$O)1W tu<"^%yɶ$:Xǃ:BtA;=h>D<"{PCH$уN^X{6tU"yOAJJ4O&E>dcfqLA{~8(ʼnǻ8|Sv|>izq>'ꠇfoǷf>8q;uyrK&A1զǤ8_ʤ8{%~sgfAl)2y@q{/29&EerMͤea}ə<+wM\&Q器L͙X_ʁ24KL2yɄN{_md|Lv29s3LL729qgL69fAdg l r&;dA}.;N&LNl2ItdrbIF&gI&~dl3y%w^ItؼrbJ{Dʉ+'6$v5^ItؼrbJ{}/z_2eҾјlddDDI$e2d2hHtĞFl11 2qA$n1d#<D&A<&+A 2b&Fl1D b "肘\4Abk+dL X0|B[aY!ѭ0ѬVHt+LU0ѬVHt+Lt+B g™4+$k& o>ZaF3 7d|JD?_scRr#n21;b~DD?/TD?/QO?1qKטhGt#%ۈG,hGtKThGtK4#ۈD?_b?D?b?&11Klgeg2H_&&}D>K_Iq#}| U%ebGl׿+c?&l/l/ǤͷZklǤ_3ټ8?}!eӞvˤ?_&*@L~~@|N5֠o?p1FLSeD8ߜ׵Ǥka.1eRRi_eg7d/&}&~՟0+D)LD*LK&}UXI_&bS3ye&cLn>QD?/1_&Fhč1_&G,/hGt#%v*hGt#%n_mfD&6#MlGtn&6#7ob?&6#Ml7P?wd3ͤD/q#}3IM&6#MI'KNoJ>f4#no&;ݷfޓv_(;+IB^(dgL6V8ΤY=K"E3)V8]sV8׼bo96)VfRPߒZa+G%+QjoW{;ΨvF+ޮjoW{;ΨvF+vr{c{;'fo?.rW|.r \sc9&.r %].r&rDD0%]#%]M.rDD0\E"\ELe\lD\E.D"GtK4#nD.wcw;2ynoLވnoDdIS6y5QeSgaRx-9Qe9IQ6{H9)foE&lv9)ʦ*Uq1ifW ld_Sp)ܯʖsecQ6&^dl4&Oc#l.1)Ff7?'ҮLmd%;&;x]Ǥټ5a1L^2῟ojdIY&dcdL]x1)F֟s#c12&#DD(&g_s#cFvbdFRD7D32э,ȈndD7D32YэFhFvbdȈndfdD72Yb7bdύI3W\1čЍ1l&Ȉ،F6fdD7ȈNRc52fd~@&6##MlFFt#،lb32fdD7&6##FFt#،lȘll&/-&#fҌF6эlb3ȈndwFD+YޗIiͤi5lbӰMÈ?(]vi {w61q .5l&~ğuƥp1LpLpۤ2q7c1)5J.&.\CfRkC^4weuX|X^> k~~s^m7gR^ Wͤ> .}1i¥CeRK%~ρ?&ᚉ WC4rf섋'yͻ* G\ƽf{&6"{Ml5怚{ݽ&6܋5љibsͽ^X݋^Dwͽ^{MlER݋qCɴ"+秔h•薕h1-+,EtJ4"e%ݲX,+,薕X-+,薕hEt"e%ݲͲnYD~@ŲͲnYčeeӲZ鯰LZ1qJ4"Z%Z]VVDS/OH$KiNKKD%Rѯ"#}76sb!&nCfCG6ԏoeCL66Ĥؐ^0ڐI_L܆fyƷIĆ+S2Q:޵w~:./8l(?']}W۱ҋ2Q72)6Dmhor`͆k~4Ř:Æ2ymƆ2q1)6dcC RR]̙G0i F2y@L\X(Ѕ h Dt"%+P) h DtJ4t!]MX(PQ +P)( DtJBQ(1(Wčw 4)Ħ@D'6"Ml 4)hbS Ħ@X 4)PUM@]&62)hbSM]&6h %L4G&$6!LlZC95]k&6!ּc՚Mk5]k&6شZ3iĦ5WMk^&扅LʿLpqi8L63 KhLnqgǽ~}Ҵf?ähM9fZ3_>֟O\k?S>'5sV@&MkLaZs&|2vc\FuŤ[0Ld2Le-L?ϙܺqMͿ|N6.32ğ.{3 ̤ ;V!:xLlCtfb5!Ll3 fb&0]`ޱ PM`.0]`&6u q#03 L ?$]`.0]`M`.0DD LE`M`.0]`M`.0&0D L&CtIT&CtI4!$x]`.0&0Děr!$]`M`XhCtI4!]`M`.0DWfgLL`LT`ԍ730iWd.caqLeAWaR\FN̤?se9s.3X^'e[לE\.äH&2,&22zcR]d2d.d2 4KҘl\&u_?Tf7V51&0q9b1D#N 膓xs@n8f8D7N 'ȄCtI49b1~@pn8f8D7D3 'B1ds!&n8 N 膓h1 ' CtI4!$pX ' 膓 ' 膓hCt!$ppn8D7~@ppn8D7D3N 膓hCtI9 7N ' pn8f8D7D3 ' CtI|1L6O/0N&? LVsa&Ge\vld'y>v^vI뉏Deg|&;3uN&*;(<ߏ/ey ";sk^Kv2Qg1)waeb:&{cҼg>% I1"cc3q&p|].`R g5c\TI12(5y~βcR g츢*wfR G5K&n8Lua<7&ay{&dc8<7&a1LdpN ' CtI9 7D3 ' 膓hdBt!$Nb?b8D7D3N 膓}Nsa W '>khCt!$kLtI4!ppn8F&D7#I4!$*CtI4!$pn8F&D7D3 'P1D3 ' 膓hdBt!$po 膓hCtI49b1N ' CtI4!p_=$Fk4?3y5dL~Nb;`wN&5zd5u40hM&5{xF5L0g5Sj>k_r¤h9"&~Du5SŽIs}:2|}N^2w1i.coe.ss\7] 1/_Ek Vh='뚼dWK5.L6Z35Qq\@;Ԛ4'L~jMefb.%nf&;a4y*0DM`.0LlC9&0Dթӿ|OUhefs4!˼cu2e&6!Ll.3 Cubg2M~6I"e"$e27L1]ee2ee22DwL1]&\.CtIT\&\.CtI4!$e22Dwěr!$eeX\.h.CtI4!eA2DwW27.CtI|2d2&aLd\vldN$]v.;&;DDe'E)Ev.;}]v~@LlCWhb&;o^&;DMvޱegbb?*;]v&6!Ll3!eb&;U!Ll3egbC&;]v&6!PMv.;]vޱ&;DMv.;LlCtHdgb&;ěj3q#;I?Ir3v͎)d=3icĽnĽ%Ϥy|ä{C4y[ds<ਏ+3{hKN&=(&{ʠL{7ǤyٙI}W&/)D縥_[M]4?3)sQcKIkW&IwCt^ؼ3y=ějCxLv30xLvd=3yL{ޱzѽgb{={&6ؼ5zJ{O${= {{=DěWȽ'xs==D~@{==DD{ѽ'xޓhCt!$*ޓhCt!${W=DD{O{{==G,CtI4!${=+D{OGěr!$>cLX&; ";zsaRdGosad績0&;-Yw&*;g&Ev6,k"&.;~?ގt\7Q@DeG'ŤȎ^/βcdG ͤȎށ:LxLf*?ٹ_dbO"n@ŤQo I3|e8LpX 'Ȅ膓hCt!$Nsa1&0N& p$N 膓hCtI4!pPIdR 膓hB1[p퀈n8D7D{n8f8D7N+䆓hdBt9b1D3Nb?b8D7D3N 膓hdBtI4!pI4!ppn8F&D7N 'pn8f8D7D3#!$ppn8D7D# 'գNpUkDGI;aњLk d\kѫl&}85vÕLTk&Mkr.Dx(dZbRFDFCvL轡9 qL^2;'1iZӿǪ؍4?Uk<1;ebZ%7.d2&aњLk 5xLk 0hM&5ǻjcEkl&};5Ll&Ek6eZ0iZcĸ߿uL]3yD]ͤi?&{b0iZcg_56dc8L6sa1L7#I42!$pn87䆓\b87_j87elL0qI49b1D3 ' 膓hCt!$v(ɤ 'ф 'CtIW膓hCt!$޼Bn8F&D7#I4!$*CtI4!$pn8F&D7D3 'P1D3 ' 膓hdBt!$po 膓hCtI49b1N ' CtI42!p_=$ ' pNb{Fk2Qѳ&Z Lk 5|׃I!ך?>>Vd5qS1q3eZ0)Z&k4G1iZϟe45Ǎ<1y5L6waњLy2wIs&aqL deL1]&\.CtI9 w.äLYL&27Gٸ 0qI49bqDs ]&\.h.Ct!$vu(. ]&_e~@Ll.CWhbs2o^2Dgeޱ ]fbsb?2e&6!Ll.3 dbs2U!Ll.3 ]fbs32e&6!Pse2eޱ2Dwe2Ll.Ct\fbs2ěj.3 ]e&\f&;aqgLv.32vC&2Ǖ-?\f&evqћ 3).QD] Le0Qo2.1&eΙlf\//*D]@efs&zM9Nklf&Eki]Fkf&IӚwZCtشZ3iĦ5ějZChL|u|5wŴKܸLv.32Dww.Ct\fbs2Dwe&6!vu.C R]fbs?32v@DwLBDwDs ]&rI4!L ]&PqL ]&\.CtI4!$e2$e22DwDc ]&\.xs@2DwDsLee22DwL1].]&e22G,.h.Cܸ 2vn0i.s~=i0i.s\ek2sXq&eƲo4 Fѧ eb# 2VLeZǤ~Isws&/蝈4?]&.d&&0i.sQ'aqL ͳ3y2LeX\&.h.Ct!$LOI4IXK&ϭI2棘+$$XKY ѭ֒hBtkI4k!Z$kIQ֒hf-v@D[KBDD[ ѭ%rkI4 XKY ѭ%P[KY ѭ%ѬBtkI4 $Zn-$Zn-f-DD [ ѭ%Ѭ֒xs@n-DD[KYZZn-f-D[Kѭ֒ѭ%Zn-f-G,֒hBX dZk@skark->i2'O<&Zf̛s>6äX^¤X>(lI{Q&j->cReZke򲉾3[ $e-_0XK&n-7L=)ĭ6¤X^i[́m%ĭZ6n-f-D[K$Zf-_OUIkU n"D7D3#ITL&h&BtI4!D1NDn"~G7f"L&2f"ěW bb3w&BtLf"D7Dn"Ll&BtL&2f"~@Dn"Ll&BtL1f"D7D7Ldb3f"D7w&2Mdb3f" &6L걙怚Ll&Btyj"D7;DsL0)&Re&DڀL6&2f"vKLD-+Lv&2b"zG&j"&f"_ꇾTc ~0y\~{L61~dL61~0gT9h?"wǷ &јIwAt@D1&ějAtјDcb &DM4&6 hc b?*h]4&6 hLl1W v@1QΨqF++tF+hQE*WyT4(pF E4Ψq~@.gTѸU4(qF3h\Q*W8U4E"gT8E4ΨqE3hQE"gTѸhQE"gTѸE*W8E4ΨqF+ QE*W|qśR8E4.W8B4I +<4ѐ0\ {S9i!rN\4&.;C鞓"v{k!o8'E4-%礈]LqMT4 AΉU4a4Ѱ&rkqC^_&vkq|}ssx5y,D_3+7n95ydsu;ΨqEq3sQ7qEq3sQgT縢9ΨqEq;sQgT縢89Ψq~q gT縢ſT Ml19_9sLlAys&6xDw9sLlAt؜19Dg9sLlAT19Dw9 sLlAt؜xs@9&6 sLlAtxs9&6 sLl19Yabs9so9DwwAt瘸s윃9fs&p&9$dL613~kq4x1v5Q(42čs'9n8ݻ嚼lb>'95ĝ99LsV=B9sL9Lsusb%nDc&M4&DM4.hLlA9&DM4&6 hLlAt@Dcb ;V 1Ecb &hz b*h|[D; E#^!FE袑x h$ ]4XD#D袑E#D袑hAt h$ ]4M4.D~@E4M4.DD FE袑hAtH9  FE#DE4.&DD E#AtH|袑xs@.DD#H4 nD(3jI ; Ec&zLhL6/Lh'5/{QI y9i!O&* L\4U4aJ44ѐ;\MEV4ꚸhoh0)s`LL4^3]|?"="G$<C]M.DěryH4y <]M.vOty <$<Cb?"DDCϫ<$"DD;gD; !^!Cx <$ډ>EM.<]M.&DC]M.D~@EM.DDC].&Děry <$<]MXh@tyH4y <]D@tyH|xs@.DD#yH4y nF2y.L6ɍ<|9f L ̤G)Ơo8&QL1]2yDn`3&n vi1̤qc 37&6c 1Ll@tc،1~b3f 1oэab3n 1~b3n Xf D7n 1Ll@gf D;7t3D; э!^!CэƐx 1$)=эn 1n f D7Cn D7~@n D7D3Cn f D7ěrc 1$1XƐh@tcH4c 1픞@tcH|Ɛxs@n D7D3#cH4c n2yn L6ƐBϤ4y2i`LDA=yG\d0_&El˃}!c&.~E&.vcR塿b<|L^6CyYd#<].&DD<$ډ>!@tyH9 D!h'DC<$*@tyH4y <$<].Cb?/@tyH&v@DCBDD!ryH}<$<]y <$<]M.DD;'<$<].<$<].&DD;'<]M.7@tyH4y <$<!h@ty <$ډ>!\.&G,h@l`g L4Iߘ3il Q>4!=7f4?oȤhg`%0i`fkB\&mMnd:IyH&5I0Asy`LL.DDCEDh@ty <$Ch@tyH}!Ey <$<]M.D~^]!y <$y]~@O1i0g~Ɛe2)ƠDA=2QcP0`b%&^i&d$ICLkrOFlF21y <]M.&D#yH}Cxs@.&DC!N.DD#yHTh@tyH4y <]yu~_hjhDty <$+DtyH4y <]o^!D;'<C!PC!@tyH}CCh@tyH}!xs@.DDC<]M.&DC].]ohp"&č<0C&F2y.L!@tyH9 D!h'DC<$*@tyH4y <$<].Cb?/@tyH~ty Ml0_M.w9i <'MJk {8'.zk {8'Md!`sA&]>I9Y5yD᜴gP45d!DpE7W1k"pF531\Qj Wc8эrJF5+1Qj W9 5+1Qj Wc8j gTcэΨpE131\Qj gTcb?vcb?wc8 Iw3D; э!^!CэƐx 1$)=эn 1n f D7Cn D7~@n D7D3Cn f D7ěrc 1$1XƐh@tcH4c 1픞@tcH|Ɛxs@n D7D3#cH4c nI398ačqUdd\lɭ<| 5y.L!@tyH9 D!h'DC<$*@tyH4y <$<].Cb?/@tyH~ovy Ml0_M.ޓ1dg L^2RnWqM60 L*n~1G 8Rv vn`Tor t5ȑ G 8bAB#/ h   A-/+ hAB s!_m!}!Zm!X,~m!}!BBB[`//4 `-m!wm!X./m!B0 `-`[@_B0_./m!l  `[@ `-΅B0,X `-m!=B0Ա-΅B0BB0G9rl!Bl[-#oϹ|-i[}z2u-@?ΑJHG`H#[}G`ϻ#';R9rl ȑ-`-`#[i[[`0ضз,X{mom l[s -`mom =0ضз -`mom } l[`^u {z-`mbv!зз=BoA@@;oAKoз-- /TзmoA@@ޠoA@@Be -- h -- s!@m XloA@-A@w.[[@ж--- h, >BB`Oȑؗ.kOW@?]ΑX G,9 C GBO#';G,9B_# A<p-//A[@_X9 A΅|!BBB hABB`ŲBB h   AoY=BBgB }!BBBy|!ZX-/~m!}!BBB }!BBB* A-/A r-/ BB h e!}!BB hABB ܹP[@_B0m!l  u!B0 `-`߯=B0B }!BBBy|!ZX-/~m!}!BBB }!BBB* A-/A r-/ BB h e!}!BB hABBh}z-A{>h}zw.}zAA=}A4}zO;+Z߃}Z߃GpHG}hϠnO}!Gg;r_~ןȘ#';=VV:V~ GYr-#m } } --`Ų-Aw.[@жззmoAKoззm+- /TзmoA@@t]з}??/| m pPжm GȶOmp[@ж- h[ oAn~ -;h[ oA`n7xm p[@жOmAn~ p;- h[ oAn~ Pm7xm - h[@жOmAnѶܹmAn~ Pm - h[ oǷi[yt ȑǷ#,)[(y| 9[Tz-@ȣ_[5ȑǷ#';"?!Gn<mǫȣ՟#V7x_AU WЪ?hտV GvЪ?h Y}V7x_AUЪCZ}oVAM=V7M{ک~/4تU?`~ЫU`~pjzd_V??ت?تlzlzd[j^[^AVAV΅Z[^ lz[=[O[;j?ت_V??تU??ت/TZ߃A{ZNA{ Z߃}ZN}\Z߃AK߃A{>h}z߃Ai:zw.}zW,}A=}=G}x[q~^7G.9R^~ ]Yw7G9}Wh}/?0G#';89xsl}{xA{>h}zAK-A=}zw.}A=}ABA=}A`ӥAc_h`{`#l}`{~=/T~=}?l}?l}zl} վ[[߃Ӄ[߃ l}z}?l}zl}zNl}:w.~=}`{~`{~=}?h}l%/y~+yhϑR9%o~sHϑ%9s?0G=GNv9oc=Gi}zl}z[/Xl}zl}\=}?~=}?l}?_=/T~=}?l}?Z9]~=h|H>hA=B};}r_} }Ӡ}B=}Ӡ=};}~}Z߃}r y߃AKA{>h}zA{H}ϑ#}#i}o_ϑiL}K޾~=J~A߾#GJ>GNv/yyaȑ뗊pKh%zɃ^A+yK>h%zɯXJ>h zA/yK>s!/<%zA/3%zW,%*%zA/<%z{p.%zSߖv!K#zA/yK>y-A/KA/`P)yK>h%zA/yK>h zA/yK>/TJ>h%zɃ^A+yK>h zɃ^A+yK>s!/yK>h%zW,%zA/<%z-A/yK>x%ܹ<%_|JV|J|hk{q^<^)%DH+yvxۗsK>)cz)9Z #fAo5;fW,Dك7;ܹ7{Кfك7{fك+f fك7{КfكHK{"fك^;_h5`kv7`k#ԚDl;`mvЛ}5;/T}5;>ؚfl>ؚDlzfl f[f[ȃ[샭 flzf>ؚflzflz"fl:fw.Ԛ}5;;`mvЛ}5`kvЛ}5;>ؚ}К)u^#Zy:O sԹ~:G􏯟Q|x?li^|9x9r#e5#ǚ#G}k9Қflzflzf[/XDlzfl\5;>ؚ}5;>ؚDl>ؚf_6;/T}5;>ؚfl>ؚEZ\}5;hEnk]fكAkvЛf|91<:lu>uz:luz:=[:[;ju>:luz/X|9u>:lu>lu>G5izf[f[샭z"f[fw.Ԛfl>ؚflz"flz/X>ؚflzfl"D>ؚ"=-ֵfڅ@ovЛ=hfAo#DW,fكBAo5;fAo%2fAo`Pi5;zAo%2zAo΅Ao5;f_4;fك7;DAo੣7{pB7{К}AkvЛfZAkvЛf>)ͮ_8#7;G|F#?'rm?~#Z%;ϣ^փ<6?DzsXq>Q[q3[qsу^A/snkqsV >F[qsу`+snkqsу^A/snt?7:؊ܟl}ύ\w.zq^A{@/7 zqw!/.Žb)7* zqA/7 zq-pA/7 zqJqA/nЋ;h zq-pA/nЋ;h zqw. zqA/A/7A/. zqO;V+Zq^ܠwЊZq^ܠwЊm!#)_#V:|_/:w: l#4:l>:yZzj[ჭ[Aჭ~w`w`pгwu`p;|u8sჭAw[ჭAჭAჭS΅Zzlz[[۷ȑ#)^B#%wu jq_޹ y5Gim=lm z[lm z[[[/Xlm z[lm \5m=z5m=lm=^5/Tz5m=lm=X)[z5h:hAo=Bu;uR^u ֠uuB֠5m5m;֠uz֠uZ[֠uR y[AkK[Aok:hm z[Aok:hm i͑eimm9#5G縵sD{w,'9Ҋ7GA/7A/7W,Vܠ7ܹwЊVܠwV+ VܠwЊ'Kq{ғ/RW mŽPRjqo}ŝGHjq^WPB^jq_Q{C-+JqoŽ%p7⾢Zjq__ȋRjqo}E) (ZWP;PRjq_QPRjq_Q{C- (ZW˯/K_O˕~o//oOrOyyvx}}Fˇ{?|5_Owx-oR7_|${Gs{<úï/4{Y9ˇvSelX>bey|e#w;|]ZpH|]u}._||{.6Rky\oM>/|ĸ|P~T~g~rdy}^y#%s}N@^~GsC =.RG~ mO |-3 |ܟ%\T˃?7k$Uv799.7s>/]G{\s}/o<oAx^Rc>֚AB޽/,9˃!0NۓļV#z^?=/_ץr^Zm?E^+/Ƴ Lv;.o _˟5oN7/v_o{m}iy\nxyg<.o /M>>/_ g;Nwdq}fyw{g'W޿7y[_~Yyۿy?yfwy0.o_<}_ۿmb˼ĕq+{YiN|]{k%W3m;͜ska-?&wn1pox-? }~}/>W}}/o g~y}^EO[;}.o//澗?^n_~/O,/y뿾9F| /lOcoGy}}{3ܼ|ކL^Z^ח_ֿym{{텗/^^kz}u2//[y5__4ŕop#/^/2sr^ve_y<<˯o_oop]cxWO_Q&_7o%,|=^FeAxy_B_~ty|_??y,|PLJy]w 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 2441 /Filter /FlateDecode >> stream xZ[s~!{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|m-㘈˳.:ovZy Tg#Oi%LȍB$K[͕{uwͧc3fI~?0T켲aeT;Q=)9Z+ ޸0` qvG8nВx{:`")ri;A="jXabIQ0a C!scI2kv/u2qU!H's܆auWbٽ*Y3[߯=B+nY:qBsZ\= -c÷_T0!Q: a?P 5Ak;(gɬNow7%^fu6lQ_ qV7e3.ˮiy^jv{RW_fUĴ Q"s:xB䔼*H1Pw7QYNINB¹瞌ׯjNŲY1']Zz뗿,Z.AΗVJߜʎ)5Tʻpmy ȢyAË6䞛>K}—/ٽ&n+W>s\+`y4^ #Na USKGBY=GVI#پ_rK8C=YJ>b-,59,IpEM?,;$w @\CP 1(4qZqQ>NiCyNJXBQll F#+aQzծ0VH,7Dt#_˴Rc]@D ncAĝp6Ǭ,B:RHO8x6\Z?Vuk&7n28: pCZ۷e~Y|]e !%ԿGbP;@֙u)-ojnOk=#v@HO(rc=-p@s0Dv8_f][fƊ|zz2U=_.X_˦fyG_,jq_*Qˮeݖ˫YMtlZl8k+`JQPXbQ/GVڢfr9(լXvhկ,WcM~RG*%w Q\ "ν}˪;a> 'e/ar]= 7XK5OhiDgbo v^G/z㻃Q'Yvs~%nf?NJw*n?X}'N' 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 (./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 (./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 3686 /Filter /FlateDecode >> stream x]M bɡI5A[@^ MKjDvש_=&85REI~{/ۏ[j[=͇}p_ιmw/>88Nu{x}?^~}ؼbsaV@v 6& PŸ{Ȩ\/aC8^`L{+C#tzSؓG=`B m3U}2l5˯Z7nno/7׷*C\| gIQʼ2¦YQ:k[CڣtzwNGqQ|ũ(ũ>=(NsWgm"qg=Nhx*{_ev)j>nOŠS=o'Gqϼe(=ՏTOqw?S=rgQ<ɱ:Dũx(NǀX9>Oi.x,V5WO,Zu-'S+M'v8|3Otw,I>NĆ*D>./ysO) &x,d7Q+ҝ?dC3^~s^g޽ŝPuYZ留hMU.F6с5x\Rcyp(J 'tπܬ$  c^= 4#^ /o1by7>9:X?~U6|w[ِ-@f`]QM]/(^NJƠD mmX #ب˧Bw^X7b /,B q(6=mf+VQ34 (<_b^?u]Dzs 6'l:Q|zE`A,_^/`l 68Τgt]#-CpVE 1+t@l uaOI֡m(+ [x@ :6VZRSB*1,=ݱr̀*٫``/d6k-{>VVy|T]5@  A\>{vFzbpYq8μ2:G&P7ďkX| 6&0V:Wʍ$/P 6I9O^+&Z)SȲj9w PQ1D$G]&~د›4mV6۳&xyuVϤ.ov R\[m% -WFM`Rdz7S]h6.ɼPgH"8U\dLrG;:y#4Ѱk KFK{g%;`ƀlwmYm[s`! m=N cxDX˾6"fɼcnz\P2fJ4 Sl>HzxY"l \,J;w,HNsnؒ@go;5B#u/_=$sgBT2 ̥q yGqwnv*G=!{'a *Yn6w`I!h ^7!d!\Ifve&]P3ً0XB&4gݎph.H{Q<.n>|09WxZ:HQQ0AYjf0sD}AB{Fub"Qs$G@p ' &div/S qB4n΂v9x-T@ra 3Kp+qB`|$Y'~$YWz%V|ۛ+ajxYfd477dM !?s9A*={Թ(X>4NfyK %}$E쾯|J>-q!{yr .D @py63T;~0X>A!}πivѓ*N4U,W \ m6qadJOVeZ9yMGOGd?fjQ(}xAL0~/1?:$qC$”5-L`K$2Y_ f[&2,ɢY! Xc4i,AE * 3GE$' Z*n/UMhĴ7Rmqq@*\S적TȀYX N).E ^2aYJl^0ڒy7N˄n398g%DrV*lͻ$)l&窷0%i|<\k!b cŮevsqYP0:o3)m&p<+eb;CZ&d1H3*lo9Ȁ0>^f d)mb]*Po6:DzDjrZQcelh7M2A lH% Fn( s\I4%/7M#y/Lx'+;S\^`7R_!`!pˌ6` V9fgqAT&9k >Bg,g&$aK2~" L EmBZO*.,>.9y > 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򤡊G>TpqZ|3˼7W+4{=X.?үOI=v+:Woԩ: 휅ƀG 1p]dRrtG-,P bX5,./t ~A%R _FrˁZMK[YDcDd*eu52JVJ=QfTnØ!Wh[$?L,w^~w] 6ˮ}l~dN6绚 ,}k޳Ji ]̎f6=kFmmS>[9[]<3+P EpV >cI&4mxl1Vc.N`%Z82gЮ_ͱf]7]; u=D^Gj~:5=՚?o_ZwG]% DNK5p, ^IDz$ttsרAxP:AֈQ`{wǦyEU |&Xo>Ugj ;Q`1:rėU`e䈆.ʈۿD6l^?,~֮oV3of{WVui:w'5ĩ۴j^ܴY&UԻ\JoAIHOaV@)vu?A}^d%-AJ DBM=()8:xzd> 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 1391 /Length2 6988 /Length3 0 /Length 7934 /Filter /FlateDecode >> stream xڍt46BN z%zeN`3̌^DoADD%$O=5k={_{{_=%mESA  ho;1"PBB2}F00@PTRPLHI2jh" utBiPp v`8@vT;(Nh?ŏ@:rh'>AzB(t? NP_ n 0 C 9A~+;lgpu}pG79= ވ{p&pC.@:2#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[hdD3ӈۿ'kC  P]ff_,oWIrbM5Zh{r1a;sh,a4Ut1>X-:8f9돣V+)LM=VN'ǀrpY>l]>\zQN_!N`LbI$$ V? $}>A| E|JG>?#`R>i| ?#俈Cgbod%[2~sn>L? Sǣ[x:Xa!`e>lQGBq|} ?l??9||YoAC5G~?Yg|,q|;?8oL.N?j hhobUX+ΰ?%b_#{ũ7t MMvЦӽph?8ݧUWF$gDo'  |^}@{)] $=&j8e_bbtK)spH\ah.=NK'Ʋyko=-xTeu%!C9J^.-.6#_lB6rd#Y/96-Gޝ 7Qڡ=QAk*{e1(sV>|򊮚v v9Sd ņ(Z((us`ho˻eV|>o#ijn0+iI;:Zg3 dFc,$|Pg_5FޭAbgd&6{޿=1 Z?x䨺lZ˴y"cU)I>1F )52Y@n~[H;8[6lZ#bgV|<{ru4LL%M#7qbGsz?]WnI0 R>hk*N0Y`U߽Eh]ڛ{.K#ym yF"j9 V6T$yak20Ŗr8O3-<qC;# N4eq As#bS+}%8-Đp{ S^jkDl~ܱxF;'g1M<˱ p3839d3@yJv3;iU&E.`b sI/B.ie)!6e @jkg`ۇ%IچɃe$?Ce}5ErX^H TxY9yUՋ B=Fz@gVTd,>[ <[yZ4} b`e'=dp!F }[Gw QŃmbb/ _IVfIΘXIuhA8/hmSu}(\T8i`L$y $3ʢb|s>3M/N7^.mr6V;;m=oqjyeӁy(lir/;8{_A>k;cia*,Ǻg8T-[mVU֛Iڒ!lV$:_oeU)0I^@05:i3'\kT\~A~#j5~h~4<ة !tPi OS9, Nu)eBq;ڠG Pd@1v'b7 ^M!τ0thjClSE MrtKM,Zq"y=| T꬗ |^-&AQVeâ~ 6wOwQh,&yI1}c󑔦.yԽ)J6'M;\ $|`tWsҍ)'PnVLN3 ڄ(4ft .~Txemr~< .gvEadw Ol!AM:E^)ʘ?^uؽC4`;K l-ʁfT:Y-%09̮j]k³ t EsmȪdh5:#k\ F oM/,S= 6vs$eV,or8+Y滔ӵ"&}E[ !Gt],8ݽM6|&AD6ah|NdnXHbKT잾 ҆~mҵ$|sO4̺"3u1쎭IE&u/br*3ĐLZJahztUf"* Y6z#)-IێX+iyq.kvc&1T"_2l25a`4I#E+H ; r#Y)É T% w U޵v$hRsSЈbQ(l8 ܴ &jyo*(!Uj~]/و X\"UCV+DFcjBt~{`oh.Ս[jujy͹kdn U5r%܃pcU95Hy )RI.*:*E 6yJVVp,^Ƭurt2-!mCfLl~5|\L\}U Q[v"@9-z1%xjsU (/7Cyo-zޭzKsO)$CW#$wFZ UxNxCͣȏ;a.?Qi$:LFۆPe/e$pA.ebm?As!z#Bz#ROKк 6k 6sܢh9\1 X\'WS+6a|HL8{ ;Gb;ÂnK 4)k_9f.`^*wu%N5{l(< uQB8D1I|ѷDn_ x#kXV`CŘ?v:+[%* $/W͢.{.?L%uaJU׳ݏ TP}IcbwM&6cV5ĈjA`u-W>눇wwa.K6 QKquǮCGց\xϊiYOLf'JWc0#K~˻N $5 w1f-g=r?ӑ9 4-'G/F"g3MX6νI{:E-4Em/ZaÖn4yez; (YDzɫH$:< 4afNuoFF\"3d|" wR`npMC| p #y2XȝE7(us7vX'$o7M}V; 섥]+?łK\{^4]Q^x߸+iGI)plkkkGi%g'n&` _,IXQըTݟ(]Z#ŋ7M|[^(@3jI޺כ_q?Mhɸ`D10lۮ6x:3;x]@5W&K319-$>eS"sY)uQTlPES$#qquvҞb~_\\LR֑TU%")h>|Z;=6E&S.}]r74!Q嘦(na+*f.S}_?g1rcg|s#SmѼӕTx\U[Ud1}NGyPV觖-'Y^l㼆E\~td{.zQbݍ$;k^{صA'NZgQ70 #xj ݇75XWq@$k^ysSf]*+όx"p#'")D/# Mwqm ug@ \2tW(KҐ/ xl/o?w)6ݧp~G΢- G_eֵH-f՘ɔYZ{ϽlZ?~4ٞY)2:u|;qN]\}.ٯ,g{.'iƴ|2Ynƶ854*z-H?2 ׽ᴏM?_=j\ACG2k, }lA!-\,y'tO'JGҸ㛇!'/ܢ{݇h1Q-Ԣh5uVh]zȩ|)52)96Sozo*9lI6D_AOh(RXu#;\؏w'rB9 x?qWO#y+%l'T7H5>9ó H&wޟ?Ƒ(h[8^v<%Md J8I)d63wd4|L5$9=Y+05!e$ιfPPISoVR1@d@탴g ݍ=n:OI^B5lSzķ:Y\.0Dآ.9,v4Kmɪcf bA.al3vs戼iOo?VnjE9auS d/ X9xtFLHE5 ̔ױl hp`MzfT$:Y zP_]ضhBAO>tc9QlkeHl/B\.5Hp@' 6_?.)}H|fJ\1BȅKp0N(nW޵֣5(Rt2qT6(bIXDh]~%L#Ȉ8*(a{2щsSMqyjPCԉQgv"yftRelj:5+rYoFZgQJ2 n]X}fYh ]>CMKHivHt6)6 ՒPMz4: J(pik!l025 ^!$ 4IFڸ.y+>f50Y .`@rO:3qbGQ&hBM|w ȘBh%%@$-'f)fXMWKv#Ct_ţBqмKceL^>($Iyz-El^O8b&!}Xh疩-1^svǷ\6!>xbWPb Tog:bsӗ7*^k(Z%:FҠ6%dLC7Y334b]4՗fgKh%]\LkWƳ}1ӣ^T$|GNkjxp8ݛYґi#CzT &  %d&+~r [x+ʼnэ>Ż0?Y~% R~g?% d]Or9WⶅMJ_\CKqՁYOlbV.RH ȗTTnխ)YU WN/$p8؞q+d%*7IgP7ɫ'(y ڌ/Qi|pc6^-BoOF4ecgWpB FU^[p,3ÉIo:%<0n/ߥP1=ٳޜ7_:,D)Iw?FB{ ҀUК;̈Q\ޕ;F M9fF3¹Ey_R xp_ԠP4BQqX0B|-3e7~*! 4eʰ{Lɾ^$7Q #-(7Fxh ]*6$ɋ]aXp]sQ 3ekh6q9x[Դ]iFZ4#߯vd)#Hh%1D J-5;0czd:5Dw1m%TM_d׹h%b.]-C1PNւff"Ւ_115,ŌUkR\ T"_``pκ2ew4wFB?s'lR/iY \G^V)02;9DBװB$܉4:߮=aglۈ-;}01P1݀:`]VDw6n{9R1((:;BxΕJ(-MYR5JO'6x/o5NzU1L}vkiТ;DF\(XQ( Dl7zxV ƾI=h~W8 ,= 4u=cShaئEb,ḍo*fUcxv0M%N /I1%92jg}/0r_|kGկG'Od*vH $srXP.B?H[R\UCm^,x%xs~!TR\$[5@rޑ7էhu,r_:eWSօ|9nj,b3!L=DK> Dꂎ>=PNb{NYis+cQݓK[5%_o*sD-lPbt>VD W2nKvUcBM>Ug5h*V ͽzsi)Iùy4" yB Ovs98RUhO\TQ&{PØ1KktgbȲ+4TuQCُS$s~wZ hGX|SJMHjc&k1Evr WEm^;8W v 2lMި5ܑyNɈBp ~wcW8SHQ*޺i\3$)ەνn >T aP Baqe9v+GKIfɻ%gL-"=tԜܡ^w#)&$#U)A¨{|?u0% ~Af Œ:NԤƵxѻФ3~Z跶jLsC^ymAG,@ Qtꖾ"S@~DqtS,-<Dá!T.?IlN?}XC)b8k$ q-X᡼AvE~12Ci>E:Ҋ`UYr/i-ڑP͔î)و1 ߫IQcA}?*rtkj^Ngu=&&Ur2e7`Ȯ_6䧜CRNPJk߱3$jMgFzz0DEhL`-R%q\tm_ȹY l HPeleGτrm<6/&i, GS3CrgK 4zkzKW{T[F͑V t%_O81ռC8=IK{݂Ԧd"0ҸYaQPXKtuH2 -<Yݚze'[yq39)_xfe'$ps_EMQ!Y`M}Q WOOQ9^(66S$(n'{id1V.UP~\ꋋsS+UHPb3)?~ \;:H%=h&M-ߝwЍK4œ"|ҵE!ltL9^]pƻMdwyFš4c 1reFO|{v_={]wv*5Gm r [o.,|U|UPeΚF5ۍg :[3Q <&_-{*S&陷.bwǢ4vj|*N/.å/aIǑZ:E-:3p0-׺SEZ!+GSv w:LcbMw_oݾF-*0G/t[1GbE"\ hl9D~?Ӈl\ # -:ww;QS7X~3%;O%q"K]܅*TLJ'E5,ԊLx>;ү;dj7VN3/J-Ueij˂=ꐻw0~6ḛ)d9=?a 7_IeYGLb2P,,i9dASn+Ij&y%{k۽oEݺZIFPg硕d?68VWtFa!mJoOZʣOm9 €XƑcJ6GݺԞ oeP,;wKmz~*KڽEM+ ۹f79 Ed MJk*.]W ånBJ'%J+Mɑ!gqIC끞m|+;zpm1hs`@NxAcKVU.+!\ʴZr3GЗx k4 ;gM'^ZwqcIqHsDy>0 aJ'q4JjXo&^FOw+B0қėj/翌1<>刧?hHgQ%y2|]5 ~T/jt1 s? {[X{@Lw BaD'Dr?PxIY.iwdęP|y@5hv(-5xr0;*'X; e7RuKj#`@Q2XۋXjh99l}ͼ;K;'+4a 'h@I;E=ao.,.«o_㤨rΞݣܶ<jY7~>ZsmRCyæ3+\s+DXl hrm}[SvZWt"h|A#%u]_|R*/Kv*d䎙jm07(=]H\ţ=;AQkfmTɍ2}LxE8"]nKEϚ䱇zxiNfM &b,xH7b2?t5T8 e; V3\] 0զBy` K?_o,9PS^Xd;˜O[b|9{

q^%߆Q%+c5!un#7&kJ{<^gkX8 ?cy»!$5-޳!v̶ثeB)If!/Zb3맰%nVզw)@?h+ua}@MAm)~T#N *N*9آ0ٵP!!n`ׅlcodQ|gH2CX[liᡘ]ʘlfֻeP ֳyXE!l чtލS;ܔ(GzK<1Wg or0&yW)4 fkqAjNwU]Rڬ+^XKPk5:5ѨJD.&Odk`e= ht5OL*Cq]c RrpGĵpQ C/ [xy= 섮`b¼+h@)  2lU@qb艽Zf\c ײNJy؆ԥ͢D#/6JMyn8|h <&)\=}K>];W=Q{d B. H,[8Bq%ةNrWaگU:R ^ޤr#,CR rҥ#smZGyU7g,!8K=Jp*)f=\hߟH:AWbKwQNWLcWO /H S}38kUbQqmipǞu:X.8'pGCͧ̍1ŌSBV7\q[U9>N7m[r֛Բ|uS%n~̕Aǻi#ypIǤ"YY2*sȽa[L/6=TsMr8d(0G3gӇ2xщk3KlRJ:A\>I$2S0UWy&箂-S[9{2 Ϥt %6%RȺs(Yx}Оۊ;mxIBU׌Oϵa-^GsI !t̒&& [5d=O9&Wr~+356ohTuI,RҏS{ahm*`X.􁿿uX!C x% x3BZkrzjuѷxæ&;@!*/3d,C:*Uqta>&*rc~\0ck/O۲OdK:hm":"C,qM|SʤVGNh86§.)* P`E5:]uTW/B8f!D}k}CɲupK1 |9ko:z\w{Z(a *;& L(<[K^ȕ pa~ZQ-GoKl 0ށnN3&ܷ!d`_ ܃NZ֑Bh{)3چIRXyF-Ө %B@%b=6;ʭBm|@H,#Mv>'gLJDʨCȴVzJѕր^/S]a}Lz򯿅 ]̓ad*&Sݙ*W]$9167:d?b6QfNXB\Nt5n;XME7,<;iʧ7x)+L9E w2,yrz:iI1V4gͫW4a| /1Y&H-"p O@a@uXV_`-7^ vOue9Z)[R Ol~a({ޚfGh =&U؊ r)R?IgB,ă.T!֊ g28#0[-z*ܾ_˻u'aDwYi(9xhN]͢&Y SeD\ o+Y}g8.P樕\0PץFu-՜9D'cQUDr8 AoaN]NtkUo joNNn+U7o|~!,5\-7Rܰ˴Jo_0&$!E!τ$vG30F9͇U(5Cwl'um9ݓ0W]T$Pa7RJg>q9I\ق5юcg 8:-':)i" N:*|f;V-Gf9󒔨a{E$b2n1SD۪\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,'x endstream endobj 423 0 obj << /Length1 1512 /Length2 8262 /Length3 0 /Length 9280 /Filter /FlateDecode >> stream xڍwP.8ݡB$;]8ŭx)ns{3Mf|}{}kτVSCjRB<ܢY55%^77'77/&#.G C!Cd Yՠ#(#$ " t[8P( uts0Y<""BҎ 0Pہ+-:P vp(;#b+p  d n'&#@ ˠ[ 0=BA.%U_쀿/tGN NO0`v4T9pv% of vztӺ%@AZ `o|0 ㄁~c!ֲPGGݟ|wOux#ـ!6aX:qAή %}Uقna!>aAq.c~u<m@?0K7 ߆0yx` `C0Q K~ `H?ϿN B_"}]]\!#? bBb!u!m5(Gf^I:Y * y;e/Wzo4xQرz7 q:n#B~ hK/&U^m#󺞹w&R!6LUbJWkfM39koM"ST;0 ,yǗG{j)6m?JPXG-Vs@6?>3.s=?}r',3MnZ|YA;k$<ІӮVLz/:Q@#N\,agVw ӋfEq“ԎPQ=|Cׇ ̶#9Cizm;K)zRoDG+Za"hI$k>\fM vٙO'`d[{'Bnp<,o6ϞyS:{Fb/ӄ[tϥ#mo6gL ,D`Pm)fڻM a|$qrx-ǜ/Leh3$@6! Qx-ٸAO wP_< rN4-Ȣ*,w'9i\V/-mt_f"0<8':)*\]߈vRĺuW L}7x 4,J҂~A“is>)-?cH-9(F)zog}|iM^4ν$HyVPtk=*Ղ1cv+ZB0I 1Sm5اm8|=1J:Q[FTym^e ش=ȝc9^%cDy_O h껼̣6)o쵿E%|x5_hν=+z`_?%𽮀g8-0CA xZḐSlB y1R\;^jop;)+6'>uS1dl2}a7^>B[Si]՝MA:n/󰃭&7' v܇ƃ*`x<'3; u^Cz*k{z5Me{xKM9PEs_)F&!mAJ>ޡdTdyAeR32$G2Ee׌Ȣd>(d~In +R~SۋFk7RhD~n>}Q2xXNʱ+5]0^DoF@H|ԟ7Rie ߹T;{F+&?]-FT)ȓ`~~ߘ ] U2 {9osQK kAe766r.YW-oܻ8D7*QIW#;VE+;v|6Tߚ ECZVٲ[ sh-qlͪ<}Ajy7:=ޘ{BVx~,j.0?ٖL<5ci,#$Qb#~9)bE1;UI8' .ac(?7hLPݳIIڥt\N>3GRjIնEpԚX8 n3Xj ~KO򅷱Qǹ/}u{lLUխJ@ dj6;cL.IG.,9v<:FnH# .PPPWq4-)OV*XBx/ZѼ'>^B?5%u*RKd13襅i(cRcy`gy TU y kե>V4$qe A|Ɵ_ގc1 'lz6 -He"Ν'#9)k4pQ6^[.xG)@}%m v2_ _^z}B&~sTc$qPdgYu/ R93g^3H$xP B > vO)i_>XnAݹ _@D w*LU\]<߬(:4L =v8Rzx"=e`|{*Kz+Ryb a{FQچxY_vkb~e%Q_6Ebrτ\dG4|䨘axTj4&evm85|Hx٥/0G6z~c [Yow0tSڐ2if2VvE w ?g0}a,؝[A9ev=SK9ql\>\pRsQ2.#^~I$adj58t]eџZ#]3SF/0A̕ m; DާOT T5(Hݻ>f\:OXEaEP/?s*xM0;-B\՛lƨ4G馋r[m f|_` qod.Ij3;$A-wQQͷϬSTqvz}1D*|5EZsL0]zwS1]}b]ټ煔s|pa?ArPC`pu139 ȷuMGNyo>q :!-v#mm$5c>{fA{?QONSH# AʸLM2U⃓^0& A,׋Gڑ2,A2s p/Qe>-V Lz~F\b SjJű&/򰡼—8sEsaFpx&&ˎVoHW0ٟB4ӧԺu~z?؟Yx5Sj*380 @ȁ:.12VtEGaS x2kSPfdMk%)}jxLD?O6QM˱̪wJKkOw}Я(,aDO'`U?4N;yTV˱`ԗIt{s| ߧgT-"{_Q~v= D;W5=z?ŏ!y^dx͖q2qP.2N+ Yr,҇#Y:A'+WUЩNcN2Y.f\FDh(Mކ>9i义#L5^[V_,YM{e%Ʀl}_h|vFAg5Ee3 g!}. BiN񤲈qZ_kOoKmC[xl9S'Zm; zZSTU__K!- cKN9%c6G^v.9 ʓJ >銟6F~(=!|^>NmmzµT8-yffai`oݠQm&/+Hn){drޭfWgԈszM d멚;f1}2aɵN_YR<63}`E (F[>M=1!fQ &l2s!}tR`jdc~k%łI%)ʾJ *_;*CuR<,cSnx.5GD4&zLk$ .hl./ ږ8y$w ~tT>1n5>۹}~RY渍HҙO)won3}KPJ)~gߊ H7ީ]}cZ[􌦁&l`/g_.YdRj= ~d^P_4'(O|oyДݹse1J*Ϥp*ߤizͣobjTp5PL n1rja]_IUrkJKcUY[R bUdD ?#P YnV&KHh e5~.MQhʤ6\Iin'%$<+uv;%&SQAg3;'vf㢘 V`&5Ènf_TbvaiU;:6eL66TJ]1`NOl5=ɵx쾯_ l@vyO< i,,I*7ۿ,+V!M<}126h-fޜAU>"KJ>wst!->4dӮq)*z|=rtzt.S:_3]l\_4hu]٦A#ZBRs)EHx+&bcw6Ap GT~vqs3cWWޏ0Ѐ"5\M޳߽/!.P 4W-V;pz$;XŇN hR|G>'d\̙"žԱZ2hu\~ Y_SZ >S4 j2fd[=V#` ?GF5?ɓ[ͪ@>El?wPZe:݆fVP5ƙ.:A,=ɧQ?( \F*IBEm??CXْ}Ef!Fn8uTU=rznٍT@b̄REt8kVBIyio*@> 2J Be_FBtPh5ax'9잳 G7/nK~"22AG˳! Υ Ua8=$芑 NŃ7/@}92Oܵ|f^'bs\MqD& _8UDTF#Sx/SE_fe>]3*T"{+']Cs3!~lr,]]eMp׍PxL& 䀄NlUn!<ƣǫ8vҼ1b(}Rչe4}3Yvc¯Cُ/"Ƥ?!޷g)kNˊ{e R;*Ycy3kb4ר^dleęK?Qab6FRWUXW;৅s,+n({ ϼ1aCӹrvQtF|ݚ`y*;gdY9^UsƑ1PڗiruvVb&'Eݘova'^ <ċid-H )\ãn~ʙ%HO<j~U.ɫ#SnDZPu' wrfIAۄ`Y .5 -puh:}%7z bN綾6QgV>M|f?{Py\sX\ ٗi~mۿhʁx߫_ԋ&CzKxFq͟+}~9~47 6KՋ$_jL&K5;!#Q] ]'q[q3a% KZ8ӽcX·0q_?瑆Def=$HU@u:i?ppu(kX3_NJZ8k;Y~Bq gh4q'|nYKLxGl!ĖD@]g=x:Ӣp8xW SB,VJz//}eۉ +6B𬾧mؐ&YG'31tJ~?6EQ@a5fч)$ +;ş ]T 5rmK^1,;{[d./Lxv U^pxJc^>?0MnK$~;ÐtjMqp_S-RWf&wjd"EnX$:=sSe <+YQ3|l95m#EP"㬖UO+"/er^.đ6% endstream endobj 425 0 obj << /Length1 1963 /Length2 15199 /Length3 0 /Length 16408 /Filter /FlateDecode >> stream xڍP .www஍ww;܂;[.9gfUVWuϲ%)IUEMR FV&>GV ; %-?bJM=_N@w˻= j `errXXxkh0q6(2A@gJq{O'kK+c1r3:Y&.V@Lljf@ A#`dbdd)Dpv|:܀?L1cB[Y;%Wpq7qf@+x?&Pv2VˀXX?Yt613s0yZ,ֶ@ dDU&Cřy$\rqF#? k'{=';?dn sWf +PV?&"d@' 7/;zY1^;_o{;  pqrz[`nm0ZZ.Zߛdcy=V deӖUӢ:11{7# ǐq?o _JULܿ"ʂ,qx/yg,h2=A}F_o67!)W[?4&vֶ1xeWP_5ʊ@skWu1y_QevXY5C{x[kPް{_8O{Tٛxl\''Oֿ#N7=m3N`aGG̲B<f Y `[jx&w?l7# +/`@{Wgo/`r'l`~c.|ӿ{W_wm߯ߓuG~l.HY#kIsW_ub}/<)̻;;-g[g9t|p|'/N_]xO_=kw^L3Wwb.^S_4CX7鸯%tg!8C{ɩ6&+hV4emuGFd6-I(^;dѱ"">/> [Q9`޻K{|(_SݯG|.u24{ ƅuv#wD.$[w-akR͹_c|[0UwxupѣU$!m-cm|u7/BM8TW֌eD]nR Hte!qcaa7,q@KS ]XZHNWtVz+|Di.Z@Y,4eghP G"]>gy>UJ] o\Joϋ%h3%{>Qg˙7p$)f+[$EY~F BP[bCB8B3WJO|UPaF$u |r4n^NN?-iEv!z؎5p}\GLv|F:tj)Q9&zq`r.`T}0\u䁚S}Ss2sIWQe(R dRqj>5o?~!"N5 d nh~XZ:_ ٨: kl7N=A4σKP`#t[FEJomuwe=biq#3#pֶϡFit'VP[3YQť܃bKx7^})q$_29[<Ӫ<ޯ\Qyoq]1Nb"Hy>6eʹj.Y ۧ$MnYHeiW8~:b%[?׺kbz^,]F;] @/r8fxcw[疹.UTe;O cΤJ7m"6cN2]ҟ,=^ 3{4LS"طly@|qBb<=LX%4zhz4.Og{}upA& KH](erL jg}w)7!+>%_ 7_k66Pq1Z*s< y#R`$?eg3ҹWQ:Y\8Tjs[5TJg4z?Ey|'4;{ǝ n3o88N1ӲRrɰPr3E0R!Z(;F>,oze^ӷ=2\ >:) 5ch:d}Ք^B)UkuCC%QqpQ76y8'zNř:7:@ߎHQw:*?5$ N^g䃻PeuUE~.mPfurSu=Ye#PϮ6]Pk;n3@)r 8p4"ycSUJDR+熟2M{ApNj VL4[#0ܶ+lp$]~t};sNn@ҥ ݍ:ߜgbx'x#‘Dy1i6&g!n:Z:|1`ֿ1I  ɧ/i?ǐg[0ɖQWhxn5l į>mpBR";ԕpRpaQEzO?җ5G *.<}k>˼.j#rf׫ Pf?4_EWpNh>eƩb71׎!X'evK ^p\= {΂j|d˧LǙ7/nCvLj;K$xI8H:7ߪ j]93aXKP]g_7cƷ69>ױV"$|`--y(K D~+>/l笀)r:nڕur-Zn!nZлw9'-_\̲91b5@ :1cy<vIyH$W78<^D~u2m]wˑ&`m(BǡBO(YԷ4Nf>V ^ۘ:1/|?~O d~l_vދ@@U`ϯF6d .s1xN?c #GD35.SN}bBLo}`k3Z{0"T;[ 6}DRc+[u2%rsJ0M5\[X`PJkZp}Ĺ\m}P3]"VE(JGzH=|W +_& Ry}ڏk-StÖol2 =S @/W~HwʼnSB'EW2*Qn#ol./C{%Oxe- ˲!&_1J%O 3"#[QF^!pf}~v8e T= .z5u+x io?gMRߞ=KkJ+38cWJm296A܂[EV><WzH 122sElhw;" Frs>immڨ_ŝ"qՇE-^ &&CGtΐHPkF{? x3M$"DO ,::2:[}ؔ߃%DmtE.Yh4_,Is=àCvwnOAm$}A?U)5uY~jI:ߩȢo7DX55:JvMyNV)fojӌġ w]I)q;DĘFsM.:[qR~F=19>QډC!"h\$!B|#FO#Bs%t,83dދp5/F\w, ǗBoT6JGi%#xP5i-1#ǰg6mȋ[kV#`:[E!vȪ|T!^>A s j|sv_{E͟! '}3o^Lz_C\d/f̥ˆuz0S5{\έA!t2Es=>> sjH꺀F6a3[:SU15Nްo19d}Y,Տ:v M˴`Vh(0ؑI;XJNU}:^aTNi6p./1K,y@yF5b=jri~GoS?%-Nɨpj0K`H*&,d }Υ3`Pmۇ2"9?/"_6/qp!~Eb4 R3T19 ܨPUwP-V5NپEK|p@`!PԐ@zUeu|>z_EY3|里 $l9p:RO]sEOpfvUx.882|@.uYS@ҙ5|FZ'Ya;@n(t:~T*w=|6{ִ9V DѤ^g'6t}JVq*{JP!\JmYx$1 -6{,,//֔>@iVStktYOwڨEsh VǓ%*sH(J'P+6py vn~Kw-y|~d:%,*3_k-,ԣr9F,yX6@=3?TK8 ^$J2`)6. vzGۙ7Ԅ7b9C:T" pJXDGA!t3XÊ9yaP[;`f1aOxLX6PPjo m#KEz"1Xq=YnvkψH7QqP"D7:L\u@KTlM_zknpH)bUIĨlM{Y7N}$Z+ނ|D; _0O&0)n|ŨLҤMBg:(Gmhîr؇Е:TU]]t%AG?e6WfP6nbR=V$VWAVՙD>Ǡͣm-c3$S!MSSʰ o:y b$>2 ze2>kii٨0D æwV@+}"LO(u;5^S2x^K{㩺& lQ:dOL%360mDH-cJhI1![MEPƗڐc̩QNs5l%t͆qAӉKpmNMIPL(m.5s^sسͪ"w4mxwJ:#߰~>)_I$&ZOO;Zy>dk.5uP[<Z*ytd|9vZ=:,b$d96HH|[zI+X΄ZC"/=@q ܘ5p6Yxkԝ ǭ䆆M!k 1o'{:7q"? TW$: ҏM^ظhovs>ž-VG$uod S۸ N\ 芾c!Fk@O ~ ysVH_m3ku苇4u0w Kx"$30z- ~8ŷo]_Dž7qMJY_#uVǗ:۵ngբ9eeOVɽR d-[09oD$]_s_^,ޚ B< Mb^[KHܔ&ܩrMs|wvl HQ!j|n9L5eL/=$M:ًZ*Ǝc]@o7dS+yIP𖝅 uxXKnbpV`ԕHq`>j?L۱""yX\E̓lcisKxtIgmX_:I␏15[d_wmI0'tAInB^3ؽMXM쉔}oqu0ƭ]ǀh RuϤFMoTY_cmJ=[p^3.mfl8׏tS݂*4rPo^|>Zi $ٟ-]0[Go.'x93Jq(l֍>nPUM2=Z4J1V <_ wss+3^d|<.,zb4+ U Ct0ũ[%_SDk(b r/Ÿz؇ Jp(V3hOca0}o޷ '^R2NV=_V|=:URىɫk7Is=3b"I6%y QCIyI`r!}~;^\h=j=!Pa.N 7cA@s'Zkb@[巼|z8vƄ•_ۉ־&h;ė }bf CByeW,| 'toN=ҕjq('4o[?_K?ʔ|Ƚ@s+Y>?wphBaA"`(+bɚN:yi)h^Vcd)U(~6CW ˔AѦ8vH02 2BBF î!֥)nf7Cݓq=guNXlcl{qJHA:U!]P[^7U֫d)b))USحrcc*PB&:g/c|(,US Y4Ð8,ڧ i-Tx8iSϑs_urՔD31UJE#>y쏶pټ9 ,Q,zr1[nE"r:?K)Cr'v||7iܛJn`:Gl&*$NI G76@(-?BFQ'>8)X'9tt"+IJ]ИtDa` a3B]F&܆؜S#3A5[t._yvbn`p6ߎ]8ЛS]*J{wWV"g3[X}n_61@oZH4p vSoT\z/6Rw!2Irt3얟Lj~ds E,᛿JB|069o%O,bnve[ju1HsY%7 N|R%z!~9DZv0+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+ endstream endobj 427 0 obj << /Length1 2676 /Length2 20437 /Length3 0 /Length 21944 /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+  o_I -Pw 7ha`6b[Q6wKMGmhcah]AW!g k&.6W+la[3h$n4Qp66{7Pxk [g @flz8f :53}wCGGCxfzrpX@jtkLv <#rrF $L$/b0"+b0I"6+b0I"W"@\^+qQq("W@\T^+qQ{E .Eh""W3|E ?W3qtv֠0A_#폡8Fֆ6Du|L쿡i@rX~ ^q6sq#J4s{s A[AM:kJY@-}r]zPvd@vQUك޸@1#utAAC׉aoG|ue@\윁&FIzo4G_cߣ}qyՃʎ71oA~:Y,, BA&gsGk ꡳ.@8]JXE+9P$Oߩ5vq ~?t/[w 1~H6&+pV8eʶͻ%gFذ$O S XE p  )\ %ʗBvj8eʿ3ĨEPe83E;wGF˝E,@#Kk5asRթW mlA4WiX,Mdj]y{K=J ^j\&H vDDuwK6#'zD_ \ <_s<`15iÔ1Sm8s( w͆btWGW1Zy >oeջK\H{~w=ܦ86δw2Ohj 8mOEÏj&tiÇƋ!KkckRD׭=Fɬ9p8(W+%\SǝZ' 9%1+)BZpQ{5uu[XnQ:]+G!^l:?_ㅷDT>0W_`)̿|N~7C'gKf4z*;ÐN \>\V,_u +D,*>qCz Lm`fYNrSC1C8}!Sy$}'NfhTpBL+ ehn)CݨXE] sf1J7vk%byNgdVJ& ]i>u}V6'g"SuZ-3s>2ڰ\s )FƝq;t%n-lԳ\ńNRbeCkФE(Spn.HqrRfALk2^f<M?L$4hVb|&~Jo&+".(KڽK ]ߚCCkGLOr]0GBSb_Aw ZezO" nֶssir} Tx8O>oUUkDbl/EJe,FOr%N;VHIbF #FPEDm)V3teF~$f$?6b7yF\z[V9e7|H=ɴWH1=63gՊ~W Zm&q~7ֆc]\o̍'"pUزTQjE9o&DC4߯ĺsOX8V뷈Xߘ3>-R6;#ks!FS ⯏Jb '1cI)%^t?ᄝXy-9g/]EQKMy2n]!\#TNY&5U7[Ǎ:k}N+TI+ZUf2ݜ>N/bU?I؜xG+cZ/bNS6ƓaӗYJamCջcmCDJkM4S8"`i?1ޚYZk9;}be-v^XO'qu >C>gF)f}4JrG N:mp}2Gx~#2{ZH[kZF՝0 0ݙ\Ϻl pR=EaZ$z(]nbuOGZ,l~eŰ3UA~ )˶.B|BZx(=SP5w:ރJƹuD,-0YvP=$Ʉ2xr_xFEL@^J B^yPhs*90aMR>ܱ_J^jwsպ84>W!ܨj].uϥ$5+09N"&De9%wKjK(R$E*MS{f>O<}0Y͹11/({T4 e-J;qJ%k*6UqO*q#թ?ZvtӀ?ۋdf n\R`?:l,b>Ŝ__QAz01E:=yZ`VH>6v Rሊ>"ȧ&9A=5(A4f1Agg t\J[H@j:{ڽ4 U%؞$ǐYjc\>lM}fMl,}@tcW b6}wt #EQbzvMbI[e@`[Z=q_7Ʒ:T nc#sc#x(a> :rl6+uڶ0d9"vO#!>h'+(Kw%'=k,[j$c)/Up5: 踷`%Y9qL >Ƌ;|kMRA` U0\Ҋzo"9fy,ج Zε92TST ܅SSY"vqe,fm桯#;nOӊ>Ќ : !Nk>X*>3[ȟĸg9@-o$Ix[L6 ;_E9*ᨒeeAu9=GP.n(Ҵ(g3]*1"v2}>xgZӿĺV[k15JAP95^u$ؿ.lws=iE0c7ePu7Ev=+|\$'(LRDf|Irx^ ?bT$m}DO`=nv MKلncG_ H6PV,kS#$otX Ʒn0K)d9s]8GTʒв \J0K  GNgy;Suq[]JnƔv0vxzI?-KcܕvWe!.*%PENA{Ӑ6H<랅~zlOW3]!]cFhڠч]9|лyA+vu2bU+93إŖotyM?*,]M8Nnkϓ!y2D7NF9,(y;lG|_v9Nyt]N sO{ \ڮsL^/st~&K q.9mDFr*Z;wA Z2f>LG&J@f/dzoē* ΙbRcM⵮w s熆\ʾ@m|->*^ẇ̗7{b9F&#zWջ|%5lpѺVN! 1eԾա#(M)SBa;MnV(D܀Q~&%3CcH*AM8U|z F`!PѹitI;KA[7KM1,Kw[P:UǿW;3٫DT|isq*O{yA y(1m<.X3w) Wp=LQ#Si,WÌ+l}&AwݵY@&I寮cR$^Vf|f29&rI>cD6%/(OݻOl]Mv./=ZfsZ64c])tvSĭ7p O)  $% e7rp&䨖1wn@j FK$$xa8[]s2P9{ßfcMe1ǭMV~ 82;zJ^Z֑ To~A*0t(Q>G&Odiȯ/b2'uZǭvLË 68^^Pz %Pp5фE`#ע]^j9RxxOS 8pm(t5 >!Y 5*w-vvvnyQg}2'@U{gz2pRp3G&ǔ0APPR|.>-'٩3y.2qI=># ϯE|F*ծ'O_=ƿm4 [8-D;Rg3!Q"de1ÓI˿$ZkOߠ]ܕ xKݥ\Ydӛ~=WMF$/!26_U!O%?4eO0<Η/!~? `ĭW蘡_/ lf[BC?P%'hQkEB?Vy|F E{vqIOT9X'ov?vn<TРsb#<3C܍PY,Wln x&`jan x*Ľ) Ʉ,xhE wѱ":u_K|*dC92ۊ.75w.R! N#a9RSU?2?/,]+ibw?;F^L-P }R:qCYiWgHąG9Jb,3x ?,`=|xa.vxN a<+%T"4Qi,|Nk+fu~d|_ܒD+ThdInP ~$_=~[ ˖DBssIu +){.D. nrd~iNDݘF^NE6&m0(ԑ\4XBߌ8?i ߲[e|E`Gʌ\ aAZc2cO  ە%Or6{k,~v+>w{ "#yPX#inX2o5!3m,C[9&/2lݛ^ +ϛqӥ5ק=ָN#/*Rpnc{B1&ε^/2rGc0}YR׶MF̻ ~(2D8JF -ݱqw\r$Ujz~=/+dhii8$-ALP ;KLOUiфMn $sכ7E a#T"e!8q8?_.Civy# ~ަ=>Єw<׌\ &CT(~wo(J6yT~PlTq݂e{8`]s)UbA1CI+;_hsB7%)ǏNfTMCCmPߔP -"]# QJV gq:u~J_*m;ˈL+U瘾-.Nbh@3Ji]~~rҙDGbi IHL&ŝJ/sdEhIL6?J@8z:WAT,ל @dfLstq'_yɷsIuhHcN/5Pu&5䍡OǏs j60rKuO)K>fX_tL~QkF`$0ű=ᩌjjzFs;;iy<yL6oh1}[ۖx˛k}/#BΣ[9Eδs˿M L!IcFq$^.8G/4WֈjI )i0mq9t a cbphM]<%R-M^#_E4ON7(GhYDEs2/?4uC p̱#y:n6w,G^?l6LT/~uQSճBjV1B=0\\{k۞b5U1a/͡e-F),|Q]6r~G[x6ʴV"RŸzBo/ͣMԄ} 2澏Hf;##mΉ=P:1@m"`HI->UJ@B %d,W͎ݪ瀯-c7 gH(NHMMɲG{SYwߧGyNP-kl8ffZyOX ]scoK'q0[KR9:߷ELX~ވv"x;JY( ;mjreΦs""ةOVAHXs[;ZːNX~we&T*ws' <:J0zN4ii|uq5m:6fTˇ < t]c4^*d}9|0C{nFٟy(rlmBg#*? 2Kxgnt)Be|5osMӨ&'EgNaVe"ɣTp7Ko ZC83lVw}P[2J3>b*#GӍ~H6$I9ʗs0C:JG?6M+<8ak6sz:ed#,[㡝-o\Z(0u7hpVE"da< ;QiM{"v߸| ea-}߾]w6ZN1WEXH{Z(`SM]W _ߌ| .8,M*zH۽StѻXG Zn/n 5OxϱN[vcT,P #KNz+4Bxހs+G:*cZF p1 ԎqAV"^;^I̿<А="6mh @7E?dǧoI'VaV, @$ A"2Q#j99C=̥y|dN檻im9zNI7wQ~p{ 憝-p3BTzpkɵ\H0PGgvy(mQ(w2vݟ+> BNԩv-@ِl)>Y~p3TiiѺSEldaYjia]xޓGRhcpo8<+wAHƒcIZ `,6.K_K }UJ\fVwg@ɩB&C<{e^BSa@Cyx#q *5kQ]'phRcknWadW;*YĶ`p.,g˒;:OvMΙ:gY#EdqCU}-V^Rk!KBMDR'Td$TVt=; 3 hm?-UnA}qR:@)Y"]H \q#YW\~L(FXI 2\],z/#_qE,">:+Y-51o3l jJ^)F{!5eOY3ݎ {d{\41A@S a {.[fKN(=xN>8\u:YmNj7_YNB?G~JӸelxYUZb2)0}f>^5(O' +hoRΥN}UŸnPfUSǦO2Dtn= 8SlPQR=03aHf-v na";P~箝/#^ })GB],sȅ}l*)5T8ULR(\m)pFm0`%Jt;ơ7ұxdVT7rn9+H^#o0̙7lʑ6oB㨄 #i!xˆLI쁤4l|ƴoF%(ۊԫBw5>0>R bCfU;>G1| jsIM|0{Ϟ% `.!9քl}ˑhSwGb| J.3)BBRڶ@;t(%BLrdϭ'33ho'uѩ"}XiZ0OTCgz;KⅢF:7ʇ\@Id~jiZtq CΏt؍^3h[&?>tZ:VKUJ?qZj]XkARSfU}U"4PtY.mYInq.8tS}:Dq_C6/&k s?GV7f qv*#J u}' at1'oEK^Ö6 3mWfYطAX>aU(u, dW7zC#%ozϿK{ WCV6Ql|3P?nգlSCyI~dO ߫)!coFD61<:m%O'ub"eNh%e,~?"hY &pyPqLӲ@}/QKg$'BXlOVm6~ae? 6J&{(wu  #?50a8RD͚ Glʎe_WiK!臜'hڮܕ1gYPdͦé}M5/೷)XA4BY!gtlK8~Y -BYkWޥ*ՖKx56x`hp0> {WNado>nֲv"_P ~~{>FM"C xlϞ h)T"o[8|}Jú7 C/Yۍ`u} P=j̘ K}TT6A@O:Q I,YSdb@ m~RACv88TTb>zaA"`}%Ӝ(fKwM05\Voע_xQ>EM@lK6Yl^pz,–Җo|2{ ۭ'HQvOyѲ2' %B*?fuY4@m g8ŢK Z҂;^sku+r ̪jop:ء뇴ʸc ݨB+t3ed/d|吨<~bױiW%"•YiR!B18U9~kx߻=)Ph8ҖD} V SLvO뜝~+jR,AbX*wQk C"4sYw=я/a=s#3je˪7Q75 VZ!_%)!Df93D˫ %KL2F!NA7]e 9dH"| 'zgH)i /|l7`Hk(t!5E͆HbJ7ψ:q\TWr&ja&L)%Nft 1PsXe! "lxl|K%ȟu;E3zX 'GheGų:1Ɍ2= {圕0Vmr'W@ƾ$Qf`+x޻|xCtԅV4%,7̡x6TJt:MX 2.{8CBV>T҉3whd=g]²X QMr bGNY`GgAy3Q=#5 CÓ&,-,kvM+|/'3aԦIEw4Oms_t)z*Dc߹Du˜@@jyȚ`8|EM΀Oj#exlH y}Ψ¾gMpQ˱gpIFe|$o/(CU w%" )ݠ3nϠ%ԁ{nIe0s=w0? E{Y9WtZa,Ro[G x3*N潷P *o-]kB3dພ`Kt-kD18A vbT+7:ĎERIWkMG1~'{p*jQy[iL؎ 5wuF|ʃi:.SA͌ ,H $W2G2Q:xq˓s?iƼ` 7] %Xi<䯍"Kؘ{Ф*">}4 a}X:|S0x:v8/D/ﴎ, !X%BKJkKG4/]Bag(0,a!7/f>D+R`NHlb&~eKQ0d، yoDJ؄_rk>,ȓ]Nə1riʃJ X '̒lr=],-GT#>j%5AK˞ }X`}c44w\.P if*I')R)ZD)0g0Zh5gn[KEmܞ~^cuQOV_;bqEqf|Db,7 ̶P*-8}_ m'e=ǭ*T|3Jr8: ޺CC))JM& 73M"5cCml ^NMZ}o(qIT>'>NR٨@"~xLHgZ/UzH k K}_n+eA–7hP"~"cCJ1UɃX% R0`DcHOjjsCtc&4E?[iZNfR2FVvU4Ug֠bԔW|܄q&Je-9LG+ЕoĞvǥD0lma\_]C}D.^!ŷq0׈1]7Lg;8 }/^$.PPʎ; Q܅xF~c:P*eĊKzQQwW)M7_[4%`j{f+IX Y3u&ZC#w1gPU6>~w G1K':+X[@ktVô*1Cϟ'S[5xdY`M7${,ٟb͒kF7?ĽP:doLߠv$՚ipǥD𕏝Mx*pAi&.vZG FSزU Ͻ#sIJaSȮ/K!blߠLδ<6>6n$~Tܩf8LebjҠC$ d¾QVUK|dm@7fz~"Wr'9C91ܝjEa 2ʠ\G'Pgvg[K>2 ü{o(OJ:@{:KT} ѓRvX"":qYܫ:Ȅ[V@(S$H#obĺչh-lD b #@:al{GoK 7CTV*t{aAg;_JnքJg{plK:f|8r봔}[G~zieȜx/V*m;S= +;յK}WW~V|59^>ɳ#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`L endstream endobj 429 0 obj << /Length1 1577 /Length2 8332 /Length3 0 /Length 9356 /Filter /FlateDecode >> stream xڍP\M-C`ܝ2 3wMpN!@pw .! {T9k[ڽvPR`!`Wfv6~:;ZjӌB tvA p>$\ `= W ę i(!` dm_: z;tda(W0h@,@@Wquuge`1spa8[ 3<@6u h El 5@]ba <A@s x^!PqV# go,3W!w [@@"+ l+on73s3\,A.,. _YyRڟ$hv/?N { @`K_$,Y '7!&l@W77zZذ*de~fqX=/o3w o ;;d 0Z(T6χ =kY^?ϗU\ROLR!ofNN37oU )(ܻh ?'!RQ!7WwCntπg%>Oy6c 7ʹ=O6\A@KUۃ@U ]`fgcY='.g|.)X;3gg3/gyqpsٟ[V09L`qFuyL`?k/`>;ٸyhȿs)A.s)V s)?}psv~/~+iߗ @YXքT{0 MS3{/:a &z|%<؍%Ew)D\ޒz`>ӊ07^/VKL¬)G;Ggmoבo^+>N1Պ1 ,3Ϛ%@pe&Eb9Ĝ"gD=x[웕rMN"*"}BRKIo)X9峌"Q_|SBֱs* ~vi/BaWljuTozq=l=5id\,<+]RMMZp `8 Ik*mޏk(V٠ܞҗiO8yYzkmė%Cp]*q#|zxM3wsfm+T#}(A0[wDS{FdCdb%BHIK^NGL)f,y?*ː;l:;9u>(QAҹL!$1u9fcKG'2Y$/˻MĠq{=?IH YΦv3"U]v`?;Z҈MOͧjV/`dn}$43uTBQwQmVjUô|%kW=G7E )1"]?7C}%3p=u),<·'ڄmn4j$rp]{2JdL2_+R8<:*߅0kVr k8Y/iˁ<#NC{KNoLBy7o_!.alfębs|P}l<q 9E2jgץ%ch$y1.EndYZͬ?/!.J,"zIkTx4Ŗ2Tϧ>i2?+#~u_a5أHGO{/x+ՙ̘#"w'lCU[&4M/jjɾrZb撻JZ WJ{Ip6':x晘%ML7rġ&Иb*ңOvhsK }!p{_vu޳) Ki.L /kn agU8}5֤/K-fǣФQD6+{7L/?+]\-hIFF32.tMz:tdW9؈g$zӮ"ꆇqx3] h 6u}'(6^A6%&סWn5ȼUvxq\ӯ`xd6$c ql<^ ,O\lEĸ]PId4)*nQt JF}"tÅ׾$Mz@~.!"t*tLzՋe kvKu"E xo6GY* w *l?KʼnA]Yjve{a9H-Wz^"YËJxD[KƟaSEDڗPdJPu#իM}AIn[,;mȰ kGο6`Qz s%۾ի_r=UkgT΋%}s/WlP^r:˘Mo1fMf:69GOp^fen_`{^f$iMuY.)&5 ӍWhQ0$ut~捖ck4(FH/?*Z6̺Zxh ՍhY3hnAUhՉ7〒Z8Z}rlmlt_.O1͌'[Th9O#)L8`<]؋=wHr)IMQD9K':(Zwؐ,)ns<. _ aRoSE|{(:|%~x쬝2l~oʣ7Umi TM~zߦ[݄ڕ ZZّ wׇ;)6ށ@ \s|< QRnb @wyVv28mڮj֥hfZQE5H]*+$pݍAP=IoGo4̾aPx-2/: PM@dKW-`2M⾄X*)){lzsiK"˜C4^tK#ӏ=JU"exxv,o䠞XRZ͜4b=-{O28Y7Nc$VDt hYǪ9O`VWO$[b\ Wa:s+kY^бvCl߈sO`7[*ugCs:\ "DWzeÔJ,ٶ#sz%_E]eX~&4sR*vLi.t[JI'Vw[H)aAS +{9md] #ôQE gtdD1 h> JF =?~^<|{prnm;Qf\~V+SSbw!b3")ZP2e\K8at<%9Fu4!/J He&eq!ꋟ}FC2:I}ysJcz/VgU=ˢvZ#EJT~c}Xi thv.ig=lK&n(5@buf3 O@NܯܼZ'az|_0sf1}|Vknm,/DWKA34%1aE|! [bm:R)w"(HlNhvkb6𥷓GqG: 0yX ,1erzՉ7HR~ktS)`*dtZ,*Rh1+h6̫] 5zwI jVHyҚHDzWY 7ZjsJB˖@fn6~=ZVVQ YQ.FQA<<0L{8@4jM1h W%.d 9@2ko3\ [;X#DH4Vt;$T-Dž qyi$YQQ QeT7KG ^l߸8z*\[EB\|mRNI|%lw0pۮ[a-g%N)*ъh DKJLa\\K;`:E$ .HSa-ᵚD%PtȗҎyk5La2 ^k'(4Btn@ +rW}og~"#d΋HJȗ"5?; ˮyY%uRq(DʲQ2ix;*s+k67O֐x& ;XG{aM|YE!_1|ΰPح4l2RRxdw 1s#_oywy&?DDStЧ+R s>vY:DWa=ִ̡jkK. W?Sle D]y*SzD)⊰)v&Xh*Ό]ЀW> .r?lzх]$L#o¸͝gJ6l 0컮qq }0f&X4ـ . ն鈌v M?(IZRFb-7*pIU W@zĨ騯Fж%{:ƖHMj}4J  Z^M0V,_$'/"[{{t́%|7ePv=t9o?ØR'iRg 22-J0ݥ񂡰 ^m~U("\qE 1D(HN4 #*V`-,G(@HWI(*ɨ |{26]:Q eBon`Ufo%kd2i%;|nz2MOeYCZ=`\A^WI 2{bO2! 7DF!Gg#C+5a>T`ACmׄR.?$л#5UW3jVJ@x:x SpJ3uRtP6 M%]r,~`95򞰽!"G: ] :*2Nargxu'w1 {=|B8*!xow7g=*3VgUʮSz([u UN .  ?}:*n KoRh؁* #bcN2N$ NcQ!rץ}gFsBtg{m?-l&3Gc(/sSbֈ a`)v0N%)jo/ZȸLEء\ 2m$>-2-ZsuF']N$ؙ*/?ʝ>6.+UQ^o2Wd\3ȸy.nm_9B7WxJN7L,v%I&[~2ACK)ԯ7}YgܳB 7*M-Pآ9ijLt6} <50fTwJX,n)0IAFyVf?wXI6Wcn7c'by,[L<+~BS+0̊kی+}b7ߠtbYc3DqW1d)@%lqGUa35(]8IjsZDn$^2; lG%>19"'3sJTOvIzDbqj'6p0f8tߤ52dDZf٫ 93ًOmb:bĩ;SXop:,Ѣj!'BC*]U|R_ܧؚhAQr>4dُ&wJSz)`!nwaV߻-D+Gwt'\goqzJ[ϒkXa]uoG^jr33ƍ&;=zhvh eºMЦ|[ơGd]LyWsGK4t<(l3Z<3^_$E<45m%VC:0rMy \$cPA$:ج!S䅴wYZu>#%ɽp0d&U)fV7]ǤMqbG:E}3Uƿx@ LTT`?v!SxWm0sa袐֜Ahjp= 'n}+ksZ̥H}zΤÈ}uC|oN!ssdnʩKV:F^ɍ$.nC_=T܃ANk kۂe/Ͳ Gi - ܌6F۫ض"͡].|07pj??Y6*׳(P!&_bw(L a qX`c[ l)OʥKLZ$_$b)W+"uẗ-vm=>KԮugdn.l;9OHU,j5+ !Hdwd5\l>䏣#}3t~!>0X:(%?+24 endstream endobj 431 0 obj << /Length1 1430 /Length2 6437 /Length3 0 /Length 7406 /Filter /FlateDecode >> stream xڍvT>%1:I(nI 16"(%) )H(HKHIHHR|ӷ~?ٞ㹯#Fa!"`Y EH{BQaWX("HBd`(,## T "@4 UE{cNX)-|0~ DFFJw8PA (> wǝM0$|rX,+uAcH3 D@Sg b@Q^o#ĝ 4pA!"+; =($ @5D~X! C}H7wP';/Bbw(GU;O pVWD9"~Qppm?=p J`)0 A{!`\h GDq?@/xÃ:"aX q w8A_W68m9Qnn.@OD7M**h?`PXT @DERE/QC(dF!@?(/>jq4Np ?Ka/YCףXH7?8{cq] >Vm,7('/饁;"0?Wpݐ(!  Cf {JpmFG`h_3'*! b0P0NGo]A"(4 "~JA7p{\@Xg ?0E7Zca14U( /.g N`OHR_gbS{h.(Mr׽#O6j8 :K2Zn2~x\A.ltt+a~o4a>o_egԧeגgbsx6E 98IoĉZ͉L4jaab <4t#Pe-MK`qLwQ<͐2)9dn+N?7k{QBQiW΅{HrlqUj>{.zP7S8w0&}8&95YʯG(9(5߅t"@#KZs gdB:eUXvllLLv\K \n5~ q!bEOW2J<*?;9m'} k?aYk{JLfիv~ %y@bj=XRʲy)i+|c[V3먩ˆy^_#/ާPC;[Ō-HפZ{ѝ%̪V23~4*rģ֩pqP;o4({"HUXLk~msECr9q yRLڙu lgk7M\\{l])Of`;KcZ)UUbz@Wd>^F蝖Z&&g?wv-lo׳ YHбNjgkLAKFz?Qs+|Ss6N&hvG={YþiQLгg.9Iɨߤj[iQxu߼ao >)|CBa HAыjpִ6gqe줕yŤ~[@qba#@ANkuNO\^\0Y؉٤K:GQ׶Fɔ#RП\**m7VxIL^ w6b;nw?R/֤9[\hRriZ}nahmKzT&iqP%eRD.aq8-?MEe]k ⌺]P>vSMط 'f6';hlੁvQS~vV"-¬ۘ7G KeԜ7H5;1ATOmEI_3T1#*թ\>^ʂYLz۪|6wNlYw%+yMvPl[urVTF% PG?O4Nve'Vy_sMfl9Nt>ǞEGp"y5y É~tIouJ.+.-s+p 56cF,Cr 1#&Gyvp<ԟ3 7Vp[ף5ࡳxHe1z&5mxVv_Mk-!+ca6t!0Μu&0ڶ-NZl}ڋU%|ϕMօ[kX`r_=TFGESwNNδm_fM+wtxʃ]k`%^ڔxNCKC=p}7 \.vDC.Qna|H\ߖ&8\adX4v ы<+ bٸ/0=!=_9y^(xl_WX*wKj7Ə(=nz#SYTEXq}+qmɮG(z4n*y hI<|z?rAL02yY7 Yh/aI+.">\dOpWm"hJrԃxs+ J59EHqyNQj4 ?Xs .輾=ݘDҘ쳑ܙLZŎs%Sܺ׿pB<(~PG936!+F?olAQ[t/S "-/^`6 /B#޼ F1#IغCcQ/-Ͳp^ԠRk;̳|4.Ei3vK*_yRTҘ[S_|c33p#V3bU[W߼kGxa+V  $Ov:Dz 68+Wn(vUtR~;"P.s+ޠ9lPFF`rBEnAi]6tmy=r$^.b I7T^Ochi󫱐R7.jn][s)K|ͮZkҘ{LX.b;҇e߆S4>8;k>;RFV}pmZgW"8Dg~;MB"3 n xɚ\>;qg0Gr@^HU/4SHFBqۿ"Bj-=Taui!hQ@R)X꒰Z1<-Mbǔ _*C8=TXNXr+dc1u.}1_3՜l 9#ܝlI͚ջJ[.Pf_/|Cغ\9iJkwksfN8eci].bPS)[psJl:O g/ϱ]/8T&Ёc+cnRP׳(J>-_(oO-3gy>) iO >(I$"Q諸ÃH8f0ó4D{ՅrͶft )Y7~ m(XHTvko") sP9FZ|W&r!3$*+ߞ0 f~yڶ*L=L^p2 ChlEG e[5-JVC <^JZ8"ќub]Jwr&Rh*AzBcGAsocIx3gm+ϋ9l*;VoH{%?2h+ܑM2IKU< 'P|ҧV5q 0EC.PV"ٳsD"b-oU8;bbg rQp5Ta_³3zG.8YVuU_7&7ҕ~i}5;ʕ_J3=~o8{Qg 7!Mj~@g}Bގk ZEDdv*w1iLY2 xf{޺{4鰈EX><{QLU Yի 2'R0rBwCh7}"L{,|r ,~ƻ{=l;p{ʉ/:]q.x )0ȝsw c.~!_XgԋKĚ10=%M5ܜ؏ g6SlV'9~>4Uj_z=Bh1ym60>eOLR8ޭlDDM(~绽1Q>m'ַo)KkܻsSx]2{M%9ݻ <1x g m)Wi(ը-|e7 od#vE?ͪꚒ/D۠m? D}M?.6}_=?ӼxNKA^)1Ãi 4Â*fIuy^^ m |Jzk⾼TLi\>[="&>!-N.':DjD돖K-]F9^%Y׵HƇ,u _N }K)u< ~ڋ/t\(VskfdUǝ[nb;y&)|cfa𕠛,isBn/E}AP|5TT)IbU>'<|J,KU_Ux9j endstream endobj 433 0 obj << /Length1 1430 /Length2 6424 /Length3 0 /Length 7391 /Filter /FlateDecode >> stream xڍt4]׶-z A ^G/D]0Øa F'w$zѻ &yYs]ξξae畳[0$/O@ '$de5 ?PBV#0I]@1 $M@@!PT(&) (XB|58 L*wtG@llSZ8@pYH[DAHxhD:J󻹹Y8868yn-@ F, l!pk @P sFl@ YWNgD` hsl(D!y0_Pg8:D;.$ @3qD:9CJdE< C:Oз05fe#! VU ـ1 @;=k47#tp#V` ɎѝG@P_WhmYaP7_KYo?B^AP@L ^x;ձY?Uapw ?5p}c0??4+"G mev]Є߮O & VUz2`6п/At HP wzf@g d~JѝmGG*@p_3'(" @ , эGD@pZQu 7 OA5 Kѯ{t h {Z@.z>k]_ߏ' Wv*xXמ$szN#\.H8_. Nz?}]Q8aVW\pue7@ek7NF^uk'/#{:5l'q3eTUglzQHÈo,3&hYp\(1&XnBH%Ęz]ȪȺ)wjJQr.6 )Ra]22AI%1[,;Vs/>~ٕ$30NՙGD߲iɫGE:==Q2 {}"R SreI ppǀnDv@P.ךTaXfrmjTt\m/y79eFWGo(ı .g*hWLj0cqcQh1N巸7jJ FZfMn[{ A7*FL1齲^#<}?o[*\D64}tt})J}Mg AU?7 '#lNlM(]nJ Nٞ oLďcq|KRVKms nF,Zpϓz=3/arӴnG6U'fy fI1TxLGvGX7bmt@}G M`₀ qRӔ@Lmt͝oD\J.eVN4gxm*9(7O*X>mr8cb>apzDi:Xh=݁AQ,;>Lִfniju9?[g\Y Kw mEtes%ذyT@E7dz=koJ4ճ54+*R >зzMd@PΎ-۽hs2z^w(`tL #g EޑHy-l %ɾ&7f0(jϓs Sbɵ=fe}s#r\ڪQ6-l$w9tHrU?]B:OimKG7Mv+c9Q8!|[v2<|J5#`0t<~KnM{'2T|U?LJC5wY_8ДTA2wIs1Y4;Hj6<7]zW.(hX|x#xK SNH);k^t?,Ejy׈qmϐJkl5RA'=:ž60Jгg] $G`Ƿsx:x(}?^*,F08IuMoNV&:gZܤb"~Vp+=ӅAW^l=c5z !{il"aAC/&=^" j{"OL Ldҵ2Z<ujn mUU#L+HcᾝF75k~’}W >cs~R]خU'HCK^#osW%Ƴb)t7|.rZ}w>E A^m湤欿x0NYfTN[!RJłZQG cWb*Aw&h#Ge+#eryuN 硃Ym2T6-%䰤>Sp$|D8) ʟl"KBrkMbR}Oj1lm);Z5`]|7I8LKtYkrdfɏS׿P= {@\W (uEVC7/$3ݕӂwk-sLEFGQw%šjע=-YwQi1LSPb7I;Ho6*2˧ok Bw)Q׃ƢGb9Ukܒۡ|plʃ'qS?ͯvݗ̯P5Cow*Zgq;$'|ߖԘ5,"Agꚵ=Ghٽi UX5zj W49{(H&k]3ZJx93j20c<&PrA9<$ e_tz UX+6ΗS~$,bh{;\vi՛^W|53?IwpPDFf6C_Ɣ^άÌ BSֳ]%gKU(iR *&:D]p0CZinRk׺,'|!>gw#]Y/j0JIA%nľ CuNⅬ=並Zþ,;}!3,=w<&| MaDGa͘M{,\? =882/S^r6%>Kr.RdSY"/vX'NͧH?UC'gn{'d_]ܲū/Gau;ciWe =@ ] 5vxIt?g^1(B`U*ŴNW[0}k%8&=_<黚_#` CeʢD#݋*G˿y[o& #˥ %r3jўrRa"]4)/>6# <0Z'Mlr~Ļ9|οqГ(YT~Bxj_lDoJklsI Fc(ACeb2w.dݷ!-7dF⽘n?bH^sL|麯\0!e^~yC}- {Mw :]ƭ:Q5٣*Gw^1'tc{f#u?3˘\WkE_ Gϣ?T6ܲ@ڋxw9e N[8-e&UeM"V{ԃ8!tAPe7\ΙVd=o݀b}oACD8;rE?~TҡsmT 0ޑ]1kSWf;i-K"ÿ%ei*S5Sw/{%[P3L=vU(gW|}z0wXHSL{_I#M~ #5]ͥ(j>6J6a?| UW-z.8.aQhixT}uz.sM "msʯWVM0;w/[Efh?jŕ,)hxoט$2NC2*nQ"p~ͰOWڌ࣫[~cڍdlz"dR\;jʲWq:'ޓtwj0|>@(@R* "4`cg]iaJ@={?sSLh'fQD%T7l Wr>ݦ"/x.d'M@J ncI6nVڟϳ 1Q~lbcH JQ*d'RrHH1- `96au5zZ4a_8~΍xQ,r\>`ϋ#wU԰(fE)s+n٩yO5Z Teӹ؋2u!m -^ 64\l؊Y)aN&˝H%mN@с)wA.}`0=l%UPu`6S@6*awc?)V*6/7 (dOeSo8$kqԆ9kq# R??-';ld\<^U1fu-e[g׶6R;t|P\s,"N wɥFloumg}xSSABX 2T^T"^ӢWLvX)Ie 9ZO/2BDSuOQ]{f|Sz}BwyRц/QNjo{0q V/ m#rX9;k R9/+2lx0tpїl,}ʼնì<܄~Wo@զi|Q;H!A&S_ْDWp\qf 8N)靤(lf7ؘbg^D ]Q{rНMdo)^50qrLݰ,^st-hx*FPۋt1 4w\ͯ-fR"u|.Dh2KaW8[J,KHx endstream endobj 435 0 obj << /Length1 2554 /Length2 16430 /Length3 0 /Length 17917 /Filter /FlateDecode >> stream xڌeT\-;N݃6%ww 4Hp ^{O}YUf %UaS{c  #3@T^UNM̊@AfbA:9[F hL266 ' 33N<1#7KS<#@@!jdinߟj 77_¶@'K#;job t|..@UZXoz`adNvdia#{[#;OK;s (!B03mhdl:ofdicd 2+y#2? M,\-m~dThq;SQ{[[3,&{2bk;{w;?7SW&u;KGW@"?2s @GĂw5O_Jb_o{ Bv6r\\V/B`aZv@1h ,=̠!d0K4gv6j4?Q{X llN.'7'SKddP7 P?Ao{X@y:?l_5XZx4خ.%m {偦V,v栁gfd[l,a4Ut1kxPK; ߦm5q5/`U&rp<Af))01ٻ@ }fN[`-qD .$qA\&?$ 6 Axr()>)A*(`R@lAܠxF,\(A Pc#kg#g?RQc'zΘ,??JKlmd{&Ll9Q @ɛ J j{{қ~mO!Aut$en/ 2q=ۏO(/;ж(_)nf&?I| 5(j?eg Zv&еfU":ظ襂9o _ dIU{?n9@Jg˟@w/_sqP\(_o &NEnӿr`EUOe@Ng?.=x@W_/@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^K7F} PTRM3%syh+|K!rwqɥvԞawmW_Յ޴{9~h|鈛دM-\2G_xU6Qö&Wb/\x}؝0 `$Ns7Ðs`6}.Qʀ} rbC-J⣁#qŗ6_h2$ȫNeJe*7'9}9tĹ+h,L8VwJv w疕L]!Yظ4 ҙJN"L *2D#8tL`N`)+t3{eb͸9KvhqҨ3lBt3)*بaCbS2ߖE"" ~)ǖ8>]'H RӋ2Τl,MN3w"eKA޼J NE~#31C<'YH 5,Q!Et>eis g)C;GɊw}N-:x2Kq?X8fv0Lq)ȆxƝ#>Fw0Ip*srϖ-̘B X[w'*ş]F OG[=s4HPl>?*CGOG!7 od#)~/IghI(ZOrśZbteTRGpa{#ѥ!A &h:`>Xr8\.LF\3Et,x=hONELӭ1o=NjD'Q:(Itn16囉DuM1N`#G]\oa ұ ڥPP{dW_jhq3-n+JNgA-OAr6}5rElю>­J} 6u2D, ]iυ?x櫟3G W&+G>z K%n4jaX'daP=$+p09GޢX-+ХzAa#|}uzJ<Z}d ( |%)_Y6ǁ,?._FX3iʐ+(wBy;PYwcTްh{ŌK Si$*.k)-1}zᄷ5;(qbKC1m9NcgKtu}teZCxsWL-k?K]Pr3\K5 o2C) k.24ע|`ul)I -[V6UcfbLL=* Ϲx=}u[7GB[ 2IkI1]܅=8Qp %P,55s":\Qו|60eў@"$!u T2h+\P̑e&[pW%ll>r`q:)x-GP/q#{zz|wQMu'))1q' `~\s;Uܝ"ckoZ^:@n#t"#" ҈w6j)$ q8R{G}^?䲤FBU~#rr5*5zuu`/ukn\ WtI/<4T&zWz5 &3b>|'NZplY5x3b3:+3yv<s7LI7 6oe$kyr嫉a9oUkl1fyJo0lм~i7v}IWVKctk;&i(9+%0Klۓtg;oVifgdBxWɐ(d\Ldu6a-ZyNû\ )+]KuJQPeV򇅚ST?:[\Y;lõj'(e/HtnYABjn q2fCfENpSIg.9駋 vIm~br:h{?{;7:l#l+[*ͥv>FnӯRuq=D\Vfo90B7|k-y!+𧲡k\2h%&vfQ؇-Oϑ3)YptSbD|>l&G<5rSQc w[jkc@!(^V8029AT)k19 %&"Av>{A;Ynӗ_U:}M/j6)Y]p;j&(} Y_<1~B$g^ )~Ƴz ޛ%|:Yvhg"yvqQyc|nR[=\W'*r%1$},=r=jT4bƶW7+޷xk/WS,41i2tb<ۉ0_^Te58kPX*y$[e,!j ƇSEK|KYZ30a-޵|<\Д9|·(3ȼ#N0mk:q)"VGSgOI1ݣT w584=̈́MXX~ NRI 2A|(/k7$2Y KT{;cg!ݻOp$=CP̑D)&|yҏQ6:[|6gRo~>܋DEYYˋqаl8俜 cQm{EXS֙!,(rަ#pz|QG&}Z}KiV_SkYF"`/"): 4a"D:b.<Sx=_eCzTlr)E^6seht{19YG>3[ t!#croK`'3=ZD 3OF- obɝHf|Zy[n PBҟBH;z 61Y6qD vo@ڡيq uLɆq VM[з:_H;>cP,\Z9rJb2jJ5{qlb`F F]z|n&"4E 9| +r.h{s5A'JW`HܻKax”zF}}#TAbnyL6p6HU}>ʙIwqx$$Km7 R <}3%BZ6Q0`[*dzEvB@A ;`=6? 'm5V[.ϸ]dA|%S'&2^yEVL)i\dz|sMȳ`DwbLt7j?N:YinMld:hC &!Ѝ=$RmF5-w{~ m@Q4ju{L3эyoƃ \g<&Uge!x@N+Vdž_QR!_Io1_|x'wӠG(yj/Ы|('Pqm-cʼ3 }D$0Uc\ѥ=NUxpVpP»6-S7 Ex (Ù9&xv>%b)r~z=ߊ-}ȉC,XRє|cX08Q., ~ja?Ci2W[ Wȴ )ІLzzF#7O˗7d_ (|N+i:1L[Gm5fbbfBsuʼn̒gK7IǗa6TeM g/̾ˉ3i>RiimwS\0⏂JLeN,0 *O^p.j/cJ+'R7O)Pc1B5ض_D8FO}X,~,Yq`tBqƽa%m]HIR@&܂` 7 М+n' os;USЉW[ݙ;PiU81r;Sj.rײEfc$ʹƇ`s^i3MGt%N"'`36*zn/$kV8('<Ff:jѹ >^ǦCgdNZoWaerUb+^%cY^E[;|-P82{ %'z*-X۪BL-aq@:g3}3%wEDN޳G9П'|'`W!bEl>[ѕUX#&y$̲ ]{1RN?>mç,B[tJ> eQygt%:䑙1Lx3vD*,$am{ = [f[ fYn~afU)>taHۅܰ8slVQCm0AQKnqc00eXWz:ف H@Ags0A):\ #ϔE]Hoa.Hh䳛R,;/!TT^H3ƲoQHYtJKm LaT;N9THDjQ]9_9P\R$tPȽe;Xş)^jvMZ=5HC~~݉ӔRy%W_,I)B+"4ĵIJeه>TtZ;sk@CKZªkצ<[`y Vy5ORgjLjap̓nNTuݑZR 4ΡaIg]'&F!42 _*~ĝ sѢ<, +A[-дʫ ;l.$3lvLLlh N }.4 e"X0~mE|s+>[0|k@s q1SUz_)VW<{E{{˂th㎷-Q(Cx1;QOt n&{RYw~<ڨz҂m^M~JاՇQԐc^ͪ]3R$Iߠ_hރ dݣ];ILJ9X2\n/\[xmD@2$&ѐQhq9D헆Ї3JpK,>4޼e9ϭ RwJ-vtD<4'-oY}kZA+9v|=3qY""F ETa7*!+̘fuѓ4okhme?-+ =[p2-SVUpJS3d]ܭR|g656U]WyD!55|'Yвqj!ٚfUw Y],T·E%!˲9\gӪ mr4 r`^4xP n˲{-Ť |;c&Lp :rGq߉Z Yem@- jqU 90rħO5*'G-cvնL[nA^&Zia;zf+B?Q5WATYU$978 <['mla\c:u.ViD[).s(d5 dƃ'~RNuQo*mD?&̪9̊1H47_[ ~+S$ߌ$O;8Дr8F\@Sim]E8), @ʳL^pWW_$rXbp b&{TtaW |lݤ;;)ׅZ7SuC~teni,vfFRP4{0C7$xsJ,5;URTU}|ڱXAvT:u5kC H*"tC^к2Eb*M%{JM'9j]:Z>0J%$Elv<?!C:p&&9l!DZ2Ѿ%a7o'O@`ꨤ\vy-&Ʉa6K|]P[JhǧZ<&OY|Bٿn5c-̍$v,+*+F3ieB(m9x|9q[K|P}OޘC!n>~"81elXӮ;vn{t><98 YtbX>$wșt~z^BڂFd+i`<=骽9%۔ x4xNt&cV"eqv?B0-8dlsrs2T\5TzB6>v3ΏQuQ).h|E6 q:;t0}XCϰ띲 :8-aTYx>#&0w jСj5^$RlgCBKaKpw6b+w|Hqq*5o AMoF+~KBE\nw23JޠeQNa{bwM W[$ÆѰd ɮ!fx v! 2 (:|GhHHі e7Jhz> N 2ICA.tjñmqۈIJ23*"Ln[J/~҇` orsf] u1.w?IGlZh1[~T@ JO=%ԙfZϺ>@"|lpFٿ[@~aP XzLdZbIJhw @g =]{s#|masQLmH9ťm&<|C:%g&tL4vwJ/ᜮ(&X[>AGzX򅬾'*JfDtT:'5pc]e&*FȺqLBZN5Y;`rv.edQ: :{Rzz@$HqT+x:-.ɳl,DMI0C"sv :.͜pq|[L2Gt?:n$ftUC*\S˒xGNRpua~ P{tS[(L-eevNY5|۽cI^d2:o Sr".j=4~lPo 075đۅ$mCJ]($x2!Y\7P+P}]CUOh'Ck:0;Rɔ&.v܉׿ཁO*r%F "ޤ͑NkT,OxE满HiC#v55HO*JxzJǔ8b4nbm"л{ tn%㺫E>кHCuүK7(Uzl㝣(RS7 t%ߨVԔ k ָ "{.XBymNB_xUXrLP cS\vV>|̂B> stream xڍxXm>"R@:7nc`lFwtI tHH(HIM}?;v}w{;DA@I@!Bvvc'd7z`Hx(y@h Fcu'D%Ab@ @! P{:M$"dWBzј:_ p#:`3 S\h %pxC( u AP d;Pho0„x"Lu6@Y/>@J'W"w0A0T>h> G!1`/0 8:`cᇂx( 4cVA8(!ܠ4aP}4Fr!pt4AzB5` cNP4@(!**@>g_}ݡa @w;Csb>Q`/( O?W AN0ῳc`_kL=`>+ F~ _W9 pn)2**"}B~ Q DoT ȨpD$"9xQן.g(B0oiWU#UO8/v}x`̆3!v55:P[5`̌( 0: Ta>P}n#Q_L_6A\1eMPd t5B"ؗJ̪$p 8"=5t!O^%䤀3d⃟)ÙG_Ig()5n겸xVe~7 qc'vD5lޙ۷RC)(^km˝4lXޥ&e)/1?d*LZhL>gK`!2MFBzP}ۧ2a-2!ʼn{Idk zݲI8·*t+DO5&_m)ZL.(0 (zP=iaBC%<6{*x[NˁDƬW{>Mg8Gj%$6T&V`|ͧ߈@VRCmtݿW>TT!圏^ !1 V&*~<&4rvl&\i.ڵb{Gp~tQPsr~$LUOzo|AftZqc,/DY$ͼ-2W9ҾZj]ZT'LQpvwx#/.t2樤g&Mc~H_˂UI XY5Kix o4XPZÅ8 uݿxc,ŰVtZ'{+ЪJdѸbMگ?lfRod zsݫD-m4?`W@j9fF׉N5^:ULfUbapSdETRy2#d"ʪV}kȡ4ܿe1_gLHG2-o˗?H=Gz:qo]ِCQ197g4l5V1$:(z4nU}E]P~7[=<*>g泑`FVg2ӆ]4w1/9E}*pM4MX7UH8#xAܱ- @kPުH\ 9dVR% [^DMꩾRCsk4}Pބau\{?5%9VoQфC-/[%vLT7UYݻLFK%10z!~ Hd}_6ӅI8r:.W[]ևӓ|xy!%7)lu_7^3pOUʇI>֛SPp[G5YWR lvmX[6z?3n#4NVshNJ#݆#Uܧ3h(}BCޠt&H 7SuvkΘw7ԡ9Q J^jD{xMBWu\뭦3_ʫbaZ f~K2X9+DJi{3?44/MiZF*`OmGoitr0]fnEa=u'U?~]he)bԏi| V$:vayePq'X&z؀L?BzM`wlt:t5Im2uxa['aWm97$no(- Rn!xKxh<*DԚkQ ^ڃf_|!ȅ+kX=oG O;;9',:q{ x{#3*e~T%sbylÚ_{hh X<_c{Ȇ$L`6.Xn=il雟WnĔp5;k]r{s0`uWgxxTl_𤛌SϹ|f,2.*=siVUs\UπT=gZ0e.`/bVEy1}Q0ZLg^lUڽbp{*RkUyʿ/eyzM;!ɧn:J2K~ڔȑ]frMHH2S '+:i섚k`/6s-XU`zM880cܑNޛ=L{xm +*=DI?"r$2 +7ӈ]IWS2?s0gzD{qP9_ʘ7xxB^T + ~!J=̬mz/Q=pnD1{k=wOJG#w_-Mo‹c.N8=w}GP}7k_ zqGqU^v:'Мv,`(,l6e9͇.tH]}NJ mkGwyF:+p7qb ۸CZ:{u94|&k-eX~ NMbuTI};W[Ҿyt~ҁClncI_ \Yu47ipQ &\rD+<*ˡ]̓uw~,TCHjB |9P&ۡ,]e○s5ʒ%/}bxq"l.Y'"{yA̔ނKuAgQШkr5 $V}8I{º8!j᩿J*pI#lr6*ӕMgztޙ++Z*#cKe-YYw'g j|Ύű_)t?t8a8n.;EnZ~R3nkV0ԍyϾpP_?418FK3Ļ Uq珌;g]Zc_@Va'@-:n*VVx<:TY>BOwbL0xvBS\܎0Z>dgqG'P>{$_JJ֭!N:u*9=Yw $ńW<_Uz΍S}#nyw WenIm6¦^͵JºXږoc}OjTGx݅~#^'5&׫~5gm꘲肊Q2a 9ڍRNxpYh'=0.銅:=(i]}п;|b2)jLucSz9c<ǭK2a=Ѹg gjZ AV-8ö;1!JG~KSәW7c*YMΎ땏lvax :ObOvVvOt*tIIQ{M$˺e*u+Bn*Al9E\qq @K32q?n_4 AF+ !D3(x9/K3Nn<8=/b /OCIDo 2@"fUJOL6ҵ{ļ3S)u)UIً9Eqm"jD,Z(I4yX:.~Cq[h_JY`GZdt8fV"*s'X=a}픦$~A TJ I"M[7mpODM$;? lp?b{l/Ae W ɗ=83Utlyu\Q7vN펐h/j<>NG|1NF61i 7%ҪZkFnZNFb-M:YI"9I|X|Ɠ0R2BOdY=»v"VǢ$;1j1 `;̏aGȜ@jFid7t-@ۗ];eY-4JZJ7랸QU}6z;iIJ O7RHՖ[A*iQRv8D^/5ڇZAXл$,WF|f$= R=-}m)_;U>|e=)}&jB[YYuc.ciHNpn

C!bQϬY眞T,߁ 4lfrdKjӛ"3,i$y7Ơ[i"e=?ukt'Z;@e둝XwrW=PWO3ñh}L[K *Yi< T"} u2cNz|ֲY6c ^ПȖBV(REl^SAMethܔAOŒS& B-C7ifmON&i9qWYp\-HۑnAxvhOA1!'w6.{h|aH9,'cuItat ڻoJT2qZr/H! ͷN ]D6_8}zH|w0Ize_P]u}جShvrNim6ώJ|U~iȧg+"K07>*B&~|4z"BN1מV-s.?F+wK~pD~R IbhۇmGri*RӺ'%e99g~honUZaO o?.ǀ`E[4A|f3&$2!8a7ח^9D}= =Hj0yJYb/o1"mwq{vwĝ!(>#rK jH@i8Zjx endstream endobj 439 0 obj << /Length1 1394 /Length2 5935 /Length3 0 /Length 6885 /Filter /FlateDecode >> stream xڍuT6-N etctJ#- ۀlS@AIAZB$$DBx~9{v04V((,T7 0X cĹ < F5 ԡ8|>pED`,w #Tz"@}PB`گf&7#OU e%%2@iiY`ge5"\OEm=(~xC ?4 ?ԷKa/oJgB=\\~7'Oe^h8Pj-e}^m/¢ o;{鍀"q0D{.HE|UsƿUr!w_  >1I) xY')@ çh Z%d"n$> Wi/}rLaN/ÛTX'd-xw)Ks]>Z_qVo붜4'8-ޣ6 8aP:=ffu#v劥³첕XO͑Ɗ{۲FgҚ:06<#C&63,@2̼J*cKafxS%UW{5w1mx2\zpvmeVH䈎0V|Sp牾+iE>rZ J3Dd~>U8HPGʵMw{""iʆÛ+[Z5{LQЮB[ůJsn0KxV{Ivލ!eAIb] 2"Db{#zW={`&kYMThW6&ah!Hc9c ,m>C$+CpII̛5vI:ga{+%^q V yegJ%m`R\=H%ss+Mfov' d݌ݦ6Ec.GopL.ot;Od4?8r͒-v6f)D/=)"Tjf0f8" Q8qF˗p@5e؁[[БK/ OXbf(O˒HA@:M;r7-%n=#NqvS8&7{ 9,K:ك欂 G5'mI:j𓴷 ~@GcYLeҫoݡ~>p萭まJ 2-~z\aN3 [n4\& HS%#%(\v- 38{P<0l1GɲۋpR2IB1BCc$d0x{D`Tl,b)봧oͷشcC!JЇFu2I&bwn칰]=/kg &%aE͆~&mhM]tai̧1C( K;g7~QWBE$7R9$ n "(cκ[ ˽3ZLiR;D! 9X q]vRꮪ⛌9f{5>;nQZ%MnՏgUѭT+ q.yfF*:b 3tVxEqCؿn?4<mOxuӓ$ _R 40NcEO\փ+Y;\aeG~3Z}<~ZJ2,0,!Φy3KG1C,jRk 3@i󾱱4TБ^}u1aB*tk܈xN<+NV;Ac{}ȹ?4HEsg!Qtʊ׮[/_v۬E,B I6]Q.:񄖻{w"w[Qk4'* W.W΅6Clɴa [DK MWm&*VQè(>~^@SnNV SI:=mxۤ {ˬ-H L/UqDV$3߾5'Yv/'Ofh /##ؖ) ܢor$>j.9G6iyKXg"jm"hW|c. 7I 'WX֓Ll4ٻHnJ~'dY_wJM_]g6>}8`>/AMUrKCqÃܓM6$/n쏛PEQ$0>/i7ΈD*X!.Z}9eDt겹R4kS*dX2-0o<=4C 5K 3ezh._B݃[+&n 7h$?5?^jԡFzO<:Yr—f[F聁| e6IKM.Q8$_ H'mvp~zr} z5HyBKtRuQp^%m" 'BӾWZYT(٣Fb@h$S츩Zߙͧ;sQN5KFjun((*[4`䰂Yaƶf?>N9Q];hUȐ^v#6 rchrɖ|#_7?vҥt;CtA5},UnG?K+kYvꅿꮳ "u>7est-lҒ4{269t6-/IKQ/Mle0KahU6xMyBqek0fwtRz y ˌ|ֶJ3iN\S]RY|sˆ#x (9b(i1_mnW"'K 2 b^@``P]ueԘLȭ:Ӽ~Y :^<)Lrb8:߻'f|~w8-?+;;YV[dž[c-$lM\MT FvT}Ua %ICj0X?*g ze]#t>^RD ,#r")x 5"VЌ(>Ŗ[$/lw[h_h{.'5#ļ!f  L#=Kt97}d9sإّtUՇL'ʖIW/zR vZ=U ,I!=&K%V_XQΥg:OY%ZR'r~&)lܪ::^ߗQ$,B>[}[ tHD:DԑQN$ 5JC&ӈ9$*9$m}ŵ>j-fj%rlbGU,E(w6lo,#.K}fp` yq`fjy3fՅY|͗^z=\I՘cFɔ ]t;,cd3XHK_jC5/s'ȇk!΁ e)"cɇng1zyi^&Z-M)}": Ms (nj:L H$-zj~dm4m:'J6\dҴSWLFyE9n3'گ囓nqC=Ysjȼ.[F UETqǣWГ(k?-wcS{8zrKUKXC6QU*dPQ|<_WgWU WO' } 8 ^n}OjȗfAnQ4GR_}Y-oUX'\E~kHroG8ח ]=fԽU0IZ>fOM5VGͥ;JPTS0G2s5{~5pF<*(9{Yt>ޅyS3^k7 d"(cI Nj$ry-S_xyHy&܇f! V>HɢkW_tq]C(?bx؛}۷L]ٍkyGTo;5<]&lͭX&\TQx` )XJ=w X?c OJM27ݴ_ QI6h-ع消/ގ햫Q~+f"Q޻&T絈aL>M O>)SxÝZ.CpK^0j&p8K *RDžR.'3C*f}pj_s /z EI}]DWv>R&=!9[ͭMFl ܂8aM婒=)%hP[ܳdէcq`,9ļH9!X endstream endobj 441 0 obj << /Length1 1520 /Length2 8457 /Length3 0 /Length 9467 /Filter /FlateDecode >> stream xڍT-w/\w) @Hp(kB")V݊XqK?;9ֽ+k%y3{MPK%UUpqrpq`20Ꭰ W B?Gxp p pqxB]Er@w5@ 0d^`[;cV,naaA?N WP@Nbvp' u`axvm  P:Ɓе @m@WA`)nk+;@GY Vr+w!0dCl6`G@CA g!ֿ@G1;-Pf v8``9yfy, 0O zw/οz@|lk4ݜ9 `7_G| 8KGr<87r~ u<m@?>0;wu;&77lXlTtl z7'GYC!^1bN}=E(z|^^sy~]^M 2 M/e06,}3psY=~q?/)]*=q?8 QnP>n?Z d vsߨ2#G)=A֚`ݟZ{=&yY9<[`##zܬ+Z^A~G ?$@)G~+ 8eXN,n.~'__c?&c㐡Ap?2;a!+7WǝCylx@ +̹ih}epe4Nj<|8ZbW'Yҭ?#Vwyj I̖}"DH6X_Tx~[BmI{=N&X]~Ll+1֕^1F@{*$ċ$T*S!=1٬L;ދ}}5ÿ=_Ȏ^MqV9Mّ.@b1 `hz91 %lPGN4UycXx#RY۶Ng+Yv# OK53Qos9޼LEED X c+9VŘS'rj4uN|fǬ0"\2M"g͗GzٍxJX 4xG7w|F$7L1=iNswӘai@lwUZg u‹5o R>FgaʘA 01]:[Ӈ*1wOo+~S BU DcdDYHh},R>\EKT339h]-tb^Bla ?JYkKֳZ~tT pXOS7(>-&cV:pKad^ڼuNJL,کGOLHeL?=eNj~Ragx'J4Gy佩ԍբf/@yl3攪]Ii2h my]ZO𗺗 @Xmu}tsK?\˓J}kupr%?VFCE9 S!`{[y#~Ҳ3Ori_GY**"R1>ua@g9eWAaWCz8ɸ5gRiI@\10XȈs122w,elFxi)J/vA>.Rj-8mC4m:&^tP"~Cu a]z<eHx,sow ~jV~ wo L8 ӞUt`2{./X8=-5YFyc,Dl)l?go+ ´t9rG=)k^^&|a ly|/ڏZGct ojE$u]xjC0NLIC+/v닛b X$,_E }vBR/j?2rJYa&F>aVQ_h'X k9z̞U4YAQw;oܐ-5RWLda5!&^ Mr*'3O?SNͅe{myo=7ϩ!4Y~.JL1HnT.@sY1ٲn}1sUlWLv!Zn}Vz.CG>K3,Y#yk'P>lFBOa_ZYr?)]M9ۥ\'!|Z"n=* {.tYv>\2&ZI*I;21+cws{̠CBpDuSəyS1Ң|Rwҁj<@) ~?v=f 5?EEP,{]iP$;[zEW4@KoZDbbYqgdXjSԃBg);4,_S=:l;HCw`$ ">5+=Jtɮrejd~g&륤¹DG|^zQ0PJ3 L#㿃%{-k1 !Ib=^ȡ-6.{#AeWKpA+,k nZP0z!5ƾٟsr@h&WȻ.s&6YRwh2Z߈gk[ZAH 6;伜%A=vIn7~O] u 7m\\ߛG!>3V6ɹq1e0LӘi2;bem'ӠOQCGXP;}S |2 -ߕ_\`偭Zk e͊NE ŏ4I/l] Q=2Տ .B_꿱)Vui l=kTWOT4r/^kŲPj"" Ћ41bh/>9$|H&=0 պ6$]KodHUj `[ɖњg#vnAz;)p-N SҟNut޿@M:p.Yz+哦zr%HcJ*%sJ~Hcσ^stҠJLu7^ԌXDHZTi|܉6OPVevw qfmm܅mp|[kMWBջ[%q4!(\˄!֏sX˺g3Ԥ~2XĚt_;Z5}pgS9R)Qn;?ÓKĈGbJgTB^,|n3Ϣƾ jACcmzP5( l/ 3'>$B'HpNݹȊ~-=[j"S}Y&g# 4kd{83r,|/2c][ղHEv>@P_0$C>yYl rcy9^aXo[ 41^U=[Le^ }i63 KpeCBG?<&iI:Nij4)6F34u;S(8Y䩪d˩gVUyu'~$ =|Ƀ|Y[` MJp냉XImxH jIR HiDXP#CLT7T{bM(1ѻ|f\K ŵW_Mѵy~(Â[AڥN\M7s4=>b=_ 8*MGћo.~P^{S; ͧ+UPrо5OEWS>IE%oI7llY{PSn }n՘snWkuN);nynXYwFu 4g9QʪJ,<78C#`9f{@+@&1# eɝ<:2A`&,.ss782H^];Ӭm-Oa9Mk‹>U**߻G m^~{=̧)`R(X Rb]c/ 2wbTVBT.ĹD8ss""lSC[R%,^ُH3ikYEӆ2zv2 anR0S|lJ5Q9+za`8Y䛮ZDUYxю9x'HEK6ltg稄{}|n}nICH:69tU_T"c"NBŞ]rϷ~_GKcDe[!fp=0ͣJ {OhNW? 5M/EH#U:j{wKsD%ŶlY\ T%oYs{~zbj> ,op tcQ{F7yqmliﭾ1Qg{$lถa(2<Q@[,-4+j!>Ū(#I  E, yOȅ,jAb&gS=vOI܌ Df׿u cyrڊ9ȰjnHcM@;e)рcmmLycp1z*2)顜yLJީƑ!{r]W*ۂ{Z3俔Φ.²L1~\'{]=fkH"C˛\BݲiUc!Z!"ߑ97m؆}*6:`J*W2-vb[vzwY+&GO}.D[uN,2VYm-^I9X3,g C`4㮱H;fixma.~\ZiGqTtrڄ BQT\Y^q}-O'sXO^]U,} e!QN+Q(->#aw8 Q0qePG,|wZ(D-ݫ,Rb="|8l%.^CCrRw|]Ě9_[{n5QX!kav2hG^I0l0h3HWgG25%OK֓И L'gͽusHvQ{Ŧ@dbMxwlLdLw0ɹ@xfp9m>M/y}H .EϳYgv+~y2b(-n7dTM9i~Nr~L!r_ݴ#,~q.U7f&UK `z΍;?-wnp=ܳ{-V$ sP|0|,6oL/ӌFGoO7N9Gf6b G_`hzə~0SBݥSO`]{V1wyTZ'牬l_͑g4vg%[*p6Ou,ϖHlPb&:r4Ԛ';QHGwyf-ѬY{;kPpp; ¯˒|O~%-I endstream endobj 443 0 obj << /Length1 2046 /Length2 15628 /Length3 0 /Length 16861 /Filter /FlateDecode >> stream xڌP\ր ޸[pwCpwn {>c-2"e:Ac[C=#7@XVEB KFbdL hnkC&ba(kkr0ع8̌\1udR6@GX2a[;wsS3< 40qqq:d ̀ ʶF@' AkdJo`Ho`jdP:\ƀZX=,@_ e['W C`enqpq1:>%ev@ˀ037ܿ dn󷳁) wrseh`hob`ne`aw1AEGɑ q̢6¶@'Gؿ1w};ÿ/?dbnclWv 6@I|`l\=fdWw;J=x{L>z?~`= \'g矊%X&&hjnO1_qn-Əc0? 3r+fVTSwU ٺ2CK1!f?Sb0CCK\d}3>:2/}l>?n~h~(Mo~4`_dh gٟ}XZXQG4?4??#q{NGG.GGnGG~n@#[# _5t̬7w0{.¼O,K]sO[%M_1-u7"1 M wiPOe;;5YlM1/* Ra_gz4h<.^%T+8;!Ix#0q/v?̶3RF j{r`'}y%GZ 0K#w,e][?2O%z_W=; NÔ_Z;9TlvwL3O u3yD'W 5fPiM;Ǵ+?2ڃ77bߝ/)?솝pv@7|9WfV-v٩=Ȟg9SG'wŝ 9 bE$e_ b* /YE>9eAa_>Y6H*އpe-^dջmٕ`kK&$I`ʣ.l}<@S}Ŗ"B<!U- D.Z YwNF@_6ǿKlg'] s.Y@׹bjM2T<Y6k<9(iۅC,^&zٻ*cO'RK_W=+L]YB(D'ooDx$7fn?yb(56 V.쵓d'^\nxGa% X)cDctN,Q{i~).yoxk G1q?!ugfQV'Trܮ+);U^m>u}*Tq:z8WT:15 \ *eK+<"9[@@p VΉ/2!:/+wS? L2.> oĺ /ho6V%t}ޏu9>X.e0M9ӹoO"Tί^0L)E*sFѫ0q! @)k;~aT0Ӡ0 m%#Ow7+2ӃX):#u)MDxp$) ߻3*9C&Gz۩tNJfGX!͸3Hsc )_zs TiٚէdxXwjHxљ zÚr EFǞ-`, R6ӗy wl=82iƐv8%EI(Haw#R .6~QT7:ߓ܋&}1WJӎh/ XPЍC)ʍ@ +8r:yw@[kª~N^ y܀T%KV|қMݵa -Ͱ瑪?EM0Um_5 p0`yWΐi02RVNf-:]m_ 8G;yJ4Ġ~CҸf8y rX*'lq={.Ao ͮh%fՙ otIzfY0^Qu4wMzcO06qaB`K3;&B7+pͺ^)g@0gs=ӷ{\L +AX+E L4GhI)g(Svѷ5:(ݫ*'czjK$_ fY7Z*(!PB*,u\љN-f?X }ĕ ps' lTaEhh9Ën>O)FTS~m:”cw xxRSgM@QryHJ{*f=7Uqb1-St+uLg?4-_ MZ*N~8KI|&Nǚr Ə!bqBT0 48AidP fˇ^V9!ޟEe2clGQ^\m!,Yw_R "命3Z(z$mk]n=UvwSU|0_T;yb Iv&<їwXykHVWnJzk]ާR5"7Iᝠ|'RN&-/'_TctNc!C[#c++n~PiTb̧" 09l|y"D tmso*jfIvYRGU'#=1Pd fWNn?fJz(3Zaj\Gʬ^8pi=*B&{C(UgFa.{c#h+YcAMl>gZ A=fp؉aWXijC̸hF7`.S9Ӥ&võ $ɴ+2;'KwXRY?UM+K3Ŷ+>M礱h^Kla)]=gJ9 i ALy}ig.t&5ͻ ;_&ٵc+ʼ O9OE "sҔ̢HH\ Ug{joy=žY:Ge!\O~8;Ѯ}[ k$ ҫχAqëܔmo*U}vj!f6t ʞ~jxy;3roQw&a]3 L^I%>K<h=JY=h~# !wx;ã@>Y<i/rz5>"49ե=JX&jV{:2qՏ$l52$S>2c].3uAAP ݿ|+}~!` =DZS/٭y^E=C0?1vV_Y/}kkvlY*a1az}=/'.GB#иVZY6vF|e BkV7Y0ސ5]*SW)1F7qܹ[Z0ݷ?)kјRHX22Z,A6?oѠ13߼:Xg;eF, ϊoie O ޅ{mAa"ܧy@^<*h Qb*6^QUMU]JWb:mLQ3g .E;'cadvDIp+Z_w0N 2C(%5.M-=&^ PxגЉkTs,;gw3OB0bd馐{1 :n $8r,{8h)[bш";MIg1ouGr1ڙjz@~6ooț.U (hw,i<6ss`{?{ws~  Z~v"t_#[BLBA1q(FZA4E6Dכì`RC@ m`gg cQDO9С_P]ԅ њ ,v}a&kh?LNQf]zY6dCv׾Ȳ#]9kXVfiPVմzUz 傁 #'8Sˍbb< aLNs_>^W`W*G Ug6h|VOJ27.yZ(8ZV TXatC)'~G&U`!IMi5y.F;VY֊ Bl\ zV^:x)qF̓H4}y]7}nqzKLd_QhjGZQA!cNN]vu`;t/`,)_iTD$ ڞҫoSl?|@JFcE_ku^72D;Y̰/Qtn  {u񊡒:8a1=#ϼ?{E6\qC̱jբkW{Jн ӏZ@Ge pPbekWy-pgdnYhooӵu e=L-"@_:-lbOOe>2տD=ϡ&6+%u[!*j\Q>: &O$4az(H F;~^9zR(Q^Rdx_1x&[0{?!kc w&VvTz:mn;#3Gwvؕ\~YmfrgY-TNzW%⼛<2[6d_Z^ 'ŖoyLqT9E?gQq.wsfL-!"ᓤ9B;!~&>+{:۞7qasN㝐>PhĶCXr mD(ږ*8Z-` %-hR@ 60{{0}Au}* Hua,Nb%~Y]صpY%´Pdxo%lL70@n qc6~װ@B<6fyth$8wMyNUW\t`ƸxpSSg|iq *ݲpkRhF ;fU?%)-4?޼ڂXV(2gVLMe )hˍrJ6@j/Q^ի[Bf23AvNQSNBS}Ul?B4CY: m 3G>W*}V+z& *.?ֻNR'oR|WhK%q!}#$X(W&p҉A%4sS߁D?G S=w?o %8#tHP̅YHy/PCv8>,9J,vRŌӉ隳{Y$ :-^P@s{m[%ZL$Zf )k"Nx-`U( _}>2ƷL3aɆQTu;PcStm Z*FS2Yt;;Bͪү" cfa#43+.`GR|Ү ^")`I ,Nmr>Mq,ڑ%QMx+resM!C6YKjMu-cy Q o LI2 $U=QG,mV_^"ifuV9g [/%2wAhU],|[D3iцv14z)֗vO:w'%ϝc$sUX*~c6z+Z{wyǕnXB_Xs3^GfʒrC L-PW>:yh8GSiBql:zYٷGO51exzi"Baxrh 6WD ЊG.ӂJ;!Ymb_ԤBأ .$hD&(0:qZ\&ebϻdCS_tHJVx]n2k#-Sh⺵wJ,V3t(`>{$ ȋځ:c'I4Gxцx;EVJpwJLdkE*ϰۋI>EpHT״7|z#X:-cO0 DCgoG 2La\N09š>ɤȫ%JTY:judW}XO G5}"sQ {AyDCC3:T#U/TQ"9ɱ&J)2xQw4m/yL;*-絵] Q?Dzk2d\<6ES'T1bQ l2lv t/ۯu̱ɛV5 ihwSˤS_jI=̮|exfy%kh">s0@ӥě_3u3o1e}qVppc} #woIVtq0}"|2wO:45:Yɑʰ(YL%(3$XY @-dAix-{soE/^{uk;,a$%_%~X!>69qG鄴?v#*ϥc3eDZbpPOFB6 rFk3Qw<; Hh&E^B~g C#M3S$ڤx' ýqV[iWzg' ;0k*`c-w32hgdĴA72XxKKkg)aȥݼsI^wI&[ƴ;;cb^ 4X#Dž]ԲZ% +`g̝ CKֻyC+%Tٌ je8<]HyEQ;q OcF>$41nM^K?rjɆu_1ǞL,' n ^zY9$hn[ʹ 0J>@Dֺp޺Ի'J ư ߾!p wQhk'0|p- @TsGoF-b^3!z#bH4%{lnQ2ij5m}B,e#G"Em]o06RGcnA/oHHs_tpH18csPbՙ_(FIrPgz{dw k}AhGu׿8`R@2woǒ36.|R9x@kG]X[z0pdpkcO[&\1۵~Ay\W\7v-bŬai8IwIe좞ޥy+n[*֋j_~XA9ٷ,,23pGV1g7}F>+Y@ l~?`H0h׺y;0(ym_K:w!A|#˕v=`Cdg~?mH驮[^ ӧV?dPUXfcg'O4wgP=ƕ:b7F-*N#WC,A֛=<0y!2YK>+4Q'_tj8,k9^/4wnV}Β,%ק:}J0n\)n){kU{X;DfO5+{rzM'.ŷ&d.:FQS=d"Vr@H\=|1!s~mWDQ`p]fe קˇGE<## >~VzUigcBXM/ R ک7?j:Aj$qPA`DiQ/VӪ1Ꚑ]Љx JmZHE~%?p՜V_ZG8Ui9x  (s plt}xf#)bULRIC.Bv3ce?uLUaj9>˳{tmjHceU0<蛁a,,(>]V0: V+ֱ à z$Eۺ&WhA8诘CfV&2~< 1H*U@M8oM-s n^r+&D=OW*WVNFUD8Ю!99yrɳEME x$0R/|.hEiC}S \o'64;Oh\C ,?1{wmWVʫuƇCzWs0`}#/ cd:C@LGW+^g(|ۡ: K 9Du'j,CR$譋zD%kt9]Uu=i g^umVQ:w%S=nkt#K%zE%\l]K`>Lӝĩ{+YեȕCJE5gP3<+gc1J9 ڥ N#TwR~D]pX<,*2Dnߓ/6rt \:A'rCs\8ףa '?pZ{Hk@% @ u*1N:evݿ`A.||6<~$a endstream endobj 445 0 obj << /Length1 1609 /Length2 9422 /Length3 0 /Length 10476 /Filter /FlateDecode >> stream xڍT-SܭPEKBp(.݋)PCHP8~Zﭬd93ga㔵Z.pN^.1>/Qwmd|C.bb@M$jB]jN^~Go"&PzBl\5 Qb su @;?VzP ,p7ٝ bxA]; nt&#@Cj Gvq pzmW˟d? '_ѿA\@PgW` q4p7}z!N@GGd՟;qsC~;]l`;)@``}\Gbc WnXU/Σ ?6;0 # {}\8y{sl@l?~@O0``; ?A<Qa6P'bnu-yYZ)'q 8!Q!@g{êuSuDlqv.XZVWЂ> `xy@_+GgOOt8xTq34TC x8W|Y; qWxmt p;A\:Pw?Ǖ9>) Q]Qz|B y qGmH? BaTTm'pA>h[~_m/(pCT pѣ<*0 zAG&?D8ο/ a~>^ܜa4d kEOc Y]Ȧ /m(,omD2Iwz dɾlC3 *N}-_n/[; { 3s±i&?t5~奱+xXViG;iL5T x`_Ez1r7\]q?zy))iYl Eb\Fm4=е|־Oڮc`,5-+t D:/qȩ`x0y:>P$- $0p;"3:6k nVa%E.{1L[_//&RUAkfPҡ I5nV4Gp~p;+zEZ6qn[z;}hYב ChshAc DRJ7LqX=;s8]mLkrIGNzt+_'J脴t=%T<\7MjeLwL I39LMDu:V:{\& FUh],g4gؼ[Hk3Ǥp`DՉ~< ]B2U:'teQ UEvuXb2\ "Yn.:tƌNʅaD%oeHe4oupcUF!Fꓯ?{T|,ls]LSXV (v}'BTɚ80=2nM|>ix$}81W,+:w3$ L7V pWbt!'GdhUD M%+Y\)ߗpf܇.'Hi"ɭ-q1u<1}ѽWd~S)FŢN(> LrX!r$½\r%6',yL0"m&| ?pJ.MՑ5B#KZ 3s3,uf<f|\U-1h=~e>]\!Ui9 R8ŝ@%R.7^Kc[`eWZ2lMwh->Y{Ѯg`}t PЅl2,fFk(jKz)@AeZ@OPrQyv}<4pb~#8325jEʘuUAtu9 >&_ zd\][s]nVR:j3뇻>2u'AfQe7t .v5 --K>STt7qwHgv6H\×l}k:F:ĮWM?xA,G~O57YIF( Os ->-.vzk"}uH}3QPro)ǸBgĨ?Y9OʻoqVJjڴ]UŊ\"Ųp+ ׽'58AV[5@qmDtV.*[(j6AImi ` % jߛ x|"fI妠1oЪ8e+sڃ/ws s CثY_4'JDJVLǢKHi~#|HD8v-w j6y ku<*V*׮y$ .HZA):ƹCJ^z'ڊ|2:UV2 ςrtaptToC}bgwǁ_29xճNORUHđ.-ZxSYۥ˿>X®@c}X&Qc_Y)銦YDžjXWL|JBeMdi;We`MJkm) 4ćatdvKPƉRS#4u5Z@q]0ѕ\~a$49[C#B!)NZ=Fq(5KFM. )>ۡmnܴ1f/d'u#DU:IAtTt(ˌ{2dݎ>},r>>!i{V1n9 mEz -c8~D o; Ism &d]XhC;0v&DhI&r qκxoX61?GTۂtۇNZIu;v>"s IN ذ˟,⿴HԼD>R-qXy,?DQ41wG%܅ \B"hc&O~(8Vc5vh;tf?]YboD7?rМ{Zy{RhHAo/4z5 ^Ri"!i"벱ݸTG橙|Xc{˸$A:I`}L Kt9Ր%=1c/=*,6)s]i*L3hi'Ʊ,l!V[? [S2 FW=^GLhR(r[7̵&~QR@w.iIT..N4B-#ްЄ:loJEcXf+rBFxk$0&tJQTC'NƈIF)1FyATK 5s@0~n,%,I7G PeM--Sfgἤȍܑ@f@6UL5]u't甩^9$)sF Snx,G?o" ,JK v*}:?j[KO EҢ'h!+vYmof O?"w 0VEW7 蘹<AqH\#n$[E'u.xƩ6 QyR3\)5S,|VHjmJ a>P\tTftn{ 7 })7$u HUFI"gck4sUkRz޾lПuw_>k,~6W鴍{^Oy,? %:G z"go.TP9_5dK3k_6{lTjO-c[):~~[TU|"C Ͷ!ٗk" b$v2dr*r7ν;+O}%ԑ<6H#;Ll]"֯v ?MUZ30DG2V1ڴ@[_$_+ruPFX.p?H|VUGRM{_,sYVj{ptxG.!?~`?d].a kـo4fo񙑬h&gOڑ;ʩ? Ū"2+s=iZ(撍HPL~^SǢiwBZFSO6yDyb7IHT>xiUDZ?Jő0q,^6cvJ8+zJ5QՀ'Uc ˩7z~4`9z:1@.x\1{#Là*7ϣ<}OsCQ_O֗^0I{I1 ^hn˟M=D˦tϙГB3}k:{;k!AYVP#&*=\H\B5LY v+Almr5$KJ.6Y:!5 iK;MGAht;Uy~C'ۂd+=Rw_ǣ8 37͑E3X\'w 7Q n> qs Lhc'̰|L46ūʷ,VfNvDiŇN');:54/s;SK5)2~P-i0h לݳS8$gU7x[z7Pf}y}8S&Trf-/<(FtvE1X0䖙ʣ`71vU3廉pQ*M爫ȳX˛wv_$ MK7ujb J[>L&1~yDqmO:@ҡYiQH` ͍h[ -ץo_sY[3/y tWIHx\.ΟEJ`#M/#о7Zgd2NU8*^A#8)Kn6d{f"?<Ӱ4L 21mS/D%g'_9sZTkxZ#d3WLRX`=u$ڠ!P$ \&PuYOCуAX@`9amZrM1^?ima SJNwK#*!yv~IDo4`W,4Ͱw#52mXYs&vƔ9Nw=hzݮ$ܹj$ 0x-a0g ñ8)5 vA&'` WŶLs"DLsN&2v%ms)J'17q) {ʏW.Y-24zESD6 =[/'dM{Ӗbڦ3z ' jwKFJ|*bZ\2Jx.Q/RX+! T (]9cU_+Ւd>ߪ:o}\nk$_'YkIɦ=O pupCb|k͝~02(^]%K(^r=vYC=4тo 򁈳ŧ! UrY'5X SZKGBh.ډ ,cphҎryB8.v< suZ1RM!⪉B2C L^[HrZ`q,T5!NOy"['f!Ԉ~_i G)٩ŧkD|$FU`BE-,~y#F[v&$utIW+XB^)]m[4Py  D Ueڂl&{)0/t-5͈L9+Wpm4w%`6)#KB.I+Ԩk,^r[32*//. W޺8s L/0fGv$)QfS&i@i:=* E Kr&0\^k]);1#(0Uz7C>սCWeQPE5uW%xG7tG!X ;qPap JCa DM~]_Ȁ+Q׽b3VvWSX ܄ K"-tKfmpy:?s|@nz  tlehn(\DH+:YI՛9V-z@Pަ_fԖus7eH"\Lvx5:t$㹾^&hSBnwS=$hX%SwLRªQ\ogB(mNLj[xA;(&]ҽ Oe87޼[aDfE YӐ$S)U~zJ7ܖWOoTa47w V/3rxxV.7n&%OGs&cobּ4:59~'6a^LY'Cgl ߳jLr;)nHz_U{_Zm۹\c"^@ɺTG+[:"b ayF aNKjJ.D$}tn'Qt{)_1!wqH[ʼnOإ&j] :L.Tϥ{iĆdG/bul~pB }ț;߬Zv:3J'e_\le-㨜װ;ܓ'qpJr |(h7H./*VB(o}Ds6 i)a걿2۝h-bv\ !_!V lB!Nr\e #%8?Q2I~ް =1.>(qS#'+7N{il _vvH^ &ڌ1d\ތU ! `]pQ~gvybqm˒LSl6VGV..ӇH%kfMG=G}R=M /ȊtoUFۍEtW*xӠE {g^YjҐ-Q!=l쒋VT?yWN+2*t`Kftyj|@MiwCꃋ>t4M>oސ΂4}q1oҌ˨X5~q9Ws1|F [CA5]j Ս^DM\W9|Uȭ u u7 x.[SOH?!3jƒh~m(#&sqI , 彛S5uR.O[ $U͛:CH~lѭz/@ҳB@/bҦ<D&S+5 t$4|Ty#V4i9P2V=;Y⛝mV6^)ft(ayZ_e>uxI־1}[Rs.nc{_zBU6F^Ovjaf>ݘ9)%:\GUj:q $Sw헊sBʝ-[f (!a"V+{V؅_!_o}1/27j3S| <~ |CaW#Hp͛ o LJ15™R8&jV ~"xlM޵BsgX稹d d$Y#E'4/4QP,Oѣ5О|oU!|V)kko l %i pi?8>潰T.6)o$Hwh|6(ΩZ{+vp,HU>HKߓaPwqP%~N8ܞE X%w,dN:Xh٥髀oGђW򬮄 0(#(~!ʚ XRjMO }h%E> zVݪU }%jnW{j_"9 k>KLi--;yX@Ӗv G@:c@퉛̫vwS?TFf}v:pԝ0Z!kTȷ o6>^yKG-< pjW|Ѝ> 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`'0lM d=@Bf uB@-p";@C^ m8 @_ ssZ,!v`3ms!A  aW `?'s8ى b#wDeR0{{0 w}8w?k A,!P 4,\ZP X^^fvqrr 5wM_Jb/A#@`3b 0[AXbqp;1~\ߟ!&7눁 *PW)) sxsعyx|ܼ~!>G%UA><w\04̀ f0~ 98W/:[_z ?z= 48#6C^ge ĆH@m$IP8[519Dt; so\C-NqB_*0b; f{ 8ʼn/n>>bG-69#\v>KE#~P RHGB̿H1 G{#D>{ȧ|^T"=BԸG=B !29 ,AJDBb{f  2#^?x=*-2! /o}Ah/AtfgG\WRzG"ݻ ey(Gj˟9&V@DU#j` aAl:D!Pܷ boE ׈ Ë qIՈ_OAqQ,h}M8fBH)p{^!̝i̝@N@Tr_.:[$D qDw2 <\޹@DV? 5#"yW_ X `;kjf.d9\܍}(CgEu]1OvDZmZ[]"N[ypaF4Ke6bWNJ.k--:)U,#ʣ#֞9a%43DN}(ُ@}\*Ñ`Q0w~׎g,*nb&ae\/ܾ-H%dmMNs}?s8St5YƸxs6ҹ'|y&ڡMsh^aIs>*^URyny cHM~aK)Pr5Auy"bbXLrug ͅi)U<<ɇ\E*dtX/׼^/Xi+H[Xo*3}THT!09Z 8b1W&6[ \w{LH'R$x^v݁Y=-iR~+4isq_Gb)>bS~++[׳@VeE>f` - DZ)➊{V(OVVH2y%+hm;ܨq2LACDS*AyYS6rRCn x RwyHRq-9ni`aVclF*4J͓ėL\?)P r 'g[TaJu }nw$n#+ʼn&&Clp*zNj֞05O'cKd ^'1vb2I0Uo> ;yf s0x?0mx$$ه7|ji]wK4-C`i"Ka[T$o>s  ( Xߟ6|G>Ok d(* dPx6d7bMa*Z%U3{6G&Uױ$s "H'Y^rĸ,>;J\0fJ+9 |UfE2EoHM*\O:6&Krz\_Sp#aBSX""Ey|i=;t$_'Y[9&{~ZU6|!)IӇß\Nj(rS <yBR;a(PX.- :XDqNzPgG:`i4@u2Qo,Nwd|yR~ryR$ϧ"]MaS0^sX7l{&Qdç?սT_y*=3-tr]it~ejFyo|$ <>\_Uz38d+M*uVHsNrA7 \Cgu=<q"DryC-Z*-ۿO7d}f!OBnW(V9+(^ hmo|-g :}-J喡!D5c#Av i˱E'fZ,5FVys[-h8hS T}_ kC;zw3/>*dz+ 3=-`duUfDmb,BKRqOLk_ 1/ Hbb*L5c~ys]++K2EL+OO3GK~FuɲkH br,}M_xq3o[PJFM*iMNZ(ԡM9i/C O zy %VG`E$}NRq[D3YeOt`$v9^+9XO|6^1=3|JOQe*ۼMX3^UFᙌ(s~[FLopb?=יXhw01< } XeZ_V7lO0D82rOf#zG4ym[ _T^7ltbg)DǎC vUOt(e Q]~|U<<.DIhNaMÉ1G=_co8zy)$1@B߷>ꅎ7h0t/:23.X<9E/j *"Y~k +e"9== $qx2cXI=LZHUs(o{3 Yh[,h/5"p/lS7"$΢EUE(ޥ'`;#K kV>h+қf jj=JgÍ{~3reɻ>GMJg@Sяo˺QvP0&Vm0!IWtӴ(#=U9C)qvavgC)v4a LeuQZT-3?Xf yL"i0ҐBՊ. /7+TB} `SkF:Z!wî}8=+WW{X6#%C6tŹ-"6T*JS.^3C ':m9t=R5las?t4ϩ yZzux";G *A(VQn9=z_RmIcsH`$\ʢ=M"AEh 0IڵK&6BRnJt?k}A*mmbpIs{s(yzc=~t1%텹-R/?aRf˙)f;{cH'-a)3NIl`eV@⍆Qև+6ZVɆ_A\jΒD.GSb62tJwsQ6%R,4T>4#SC!M!n j% ԶNЗp}6@l!EK%#M˺ڶ%pyg&8[$*k6I)35Co-N~ŎRӛ,z_ oVJvP,5$hcSb_ Mk(Zl?;z2eyDܛBsMx>ݡ@}~c99h2[<ā<11ɧI, j` hқz!pA7,ÔEmz"L.f}neʔ }]x sgxOd 9ƚ].JXm'0/I $Q#cO4 HRQ H+'Ftq 4*cRRl t._D XLIaD+7fha#O, bU%o_HV7RULɲLw}oh*s ɬX^0daĸxڼjZ9V{(> (:웝B\)Js¯\@]O(\µP,Z\m~= &k 8StE9Cx;^9j pyqv̧kdWFoR̞zױ=rIBaVϾ{ӝr+;hc_IӗyqJCy_,:5ĈrA9OKVw% 5/r`Ű=977hmjljFz2#s#FKHG=zG̭UOHE jVٯ<+7LaqӉHKu̠1APѡW,F}IkU"]*"*p0(}:t/L-닧VT>IsStϦ-^Dza))DU$jYw<_7ONjר}ڞYDŽՖ7Ņrl];m׋:b$*L=Z`ܖWOyQ :AqzA3^u"&)_ v1oM<6[> aιt0yy9= baiG'*%?c#\Kz#Z# y xT k!/46=1i0mi/.o/UEdd(P4wş}ٚVHأp|k -}n:VL] cu@ڽhZ}vmnx}!n8]&"ϙRXOG < WF5׽3p >ᅿ:w CGuw2kƬxW.:RMک{bĻZ kY}E\֠:@ 8]@+jV$Rz;j_^<9Хc7 {yb>6'65'KoIS>m3B;{_jxklu<&9'ܝgAaЀỠ%,)P1JGFRa,Eҝl/&wg4!,bPW ϾSsQOXUrإ7hATp[085zjMB0aT)*{ҬkJ5.`}L7e+?z ˯S(l]>i]/o0Y* 9 wք0J(`笺9Qz!ݿ״. ϔZ֝]m'3@jJ5=9㣖oeB 5^^ :ٸ-/!SrfȗQZ_g'>eSg''UJ~R lzӶgMjɄ,xǜ I j|71t޵N,v~DB/A9bnOtEt'%URM)+W 7\mlZ?J~QK0^ᣈ@pXr9$*BPl/)yn'Ԡ,Ղ3?,`#ţW|;i 1Z .UpK|ޗs up]g0zTy}&]cXa:ªnX%poj97Ե]V<5:.>Z㎂=ר8`6PnȹƚFE1N|"̅I<k4 [ ԩ2e[ | =dZ47/h iVfgۛfdLèB ,sK`~Q˄,GJXG_i+>0VZ|=[;7]j"P9wQcT+jM@7aٍgy83'>8&f[Ih5d0cTtޙaDEu}Q/TX$#GCۇ^ָ((H8dѱ=~=P|Iǝi8ƽ#=(]QU;%Ji{GF=&Y䠌b[eG%F͕ٞ"7CEM$n޹$nQ\W@N#tf|v)N_ ıEfxZXp%;g>6cS?WHd^QB pYlRjdrD,5'3ESa 0 R*@) #^tcNiQ-v!IhIVQERHUjBµ0Eې{AQUTW`D0sM%vHq#$<亃93^>  */,5&p\l}=I!PU6{e~a LO OD}n'8aG~M WD-|CM"uRsg1PѬi3v/?(uCi#dx?5AGlĕl\Ue1(g'uF a88|2mG3ee}n}ů%芍Xy!-U.g}SI.g&<hʤ?gd h[2-5:.q5A^;2 gDEٓEͤ>hfj'sEi֡J'x> jSuD#}uð4aZՎ}+ɞc-ã]=ܕSsSu 3co;(TyePJee0\pƷ94q僿Fy#y:Sk: ]9jQ צ8D pPKÿQqLDžd[SwA.NZv",N v"f2=ie)+H>= d DGݤ|;gXCSqgsm+|D]eI9>a+lTmxv}8WF\ȖwN>Xī?ǤRQ/Ox؜TuA*2Yr>jqxo=Ox?<;r kBN@{'X49['95G_ъⳙl cJ9U#t[Ia$ksqMmvR ̓]/%҆;RJ457\Q;SWE~^:g⅍ vh^*$ 334"湣aUsJQ,sX:ݢɚ<(f~0U~ȃXW>ƥy?.kė"{ɉoyH<{=wPXT!AnSS, ׽1]6(k8 _: '06/hCl|EjVZ2rs^̽i\P֯"!_ݾ,ma?gqlDhRF8gp)z z"׊=CVpm"B%T9-#5E{D~)6O.8OЋmNo Vەp ֖шOO#kѧ9v_WEDǗM>>XX;IQeT6RY,{?inyݯD; ]oPKNLIUZj-5~zmpkwΏ? sh;@YASYoT10f]i`Jf(ܢ=/z)'n֭BaҺf _Y5֬C1V QN07`CjBQ·#B:&o5SvnKєFq v@ESVd0 [pyҕ<1-ۍL`m{zqbO&Ne+Pj͢ݩR`أn0oysۥ ֹbm*|rS:-`u%т/M= 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.14)/Keywords() /CreationDate (D:20151013203326-04'00') /ModDate (D:20151013203326-04'00') /Trapped /False /PTEX.Fullbanner (This is pdfTeX, Version 3.1415926-2.5-1.40.14 (TeX Live 2013/Debian) kpathsea version 6.1.1) >> endobj 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 1183 /Filter /FlateDecode >> stream x%Kh]UysM$MN$mw&M64MGmZbՊNT"F:>LGBg-%(BĉE|}g}ss g#%"]BE,m4U%Mm4hhgH3  m4AB%-{цfH >qimm]@$-eh&HV*4i5AkF;EZ ցzh'IAQFЄvm4<>G;A- 6shCWюh Q @7p gz^hiZ>F_W]T0UR%VrĬ9W iY3DūZ%Ɏ@f=΃ "X+`u.X@+33 o; (W"~k`lZ? :): :>=`w+{i=Z8r6~3 ES0uš Ppl^.',@{zAbnU@l+_i3`{BJk Y5&cB῀ ^_Gwa .ˆoi X/`0E6 'JgY]/`0o{1W\_Xd_రl/(QXmgɭ?EϿG靱[۸fɉ @F5B~U]WvwCyAS ے7(]7őEϕ* @ `8@E/k^EoZJ#D@̢5Jw}D@MV[;6DYCMQP7S+,X$1g5ni$ :,A/8F@E|Q.x8M9 F-S` Lq40aE.> f-zP-*,)eUf,s{Y5ߙq \7|R5l8ƣ+_w~P-L-T}RK=HQRQ*t5E~VQo6+OZzCE,[QeVTo+jpg 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.pdf0000644000175100017510000046436312607321332017745 0ustar00biocbuildbiocbuild%PDF-1.5 % 120 0 obj << /Length 913 /Filter /FlateDecode >> stream xYKo@WhK/R71E;ʯgfqC`{6ޝ;f2=9=S #t4)uddR6fFߝi_hm ]gS6d5dCDnBQ=bc咁s*ٌTAU1y;Z/= upKk gSΧ_p*3_bG=)cOe(Z"aikY_6H.m.bڟFђe#ܵ@A"< =RzA9w?^5]Jᨨmvn<#ŧމזuqҭ W+yl3>ݬ}WW.ͭ}[2h kΏVZH\F;}ci_t͐p4.PxdTqaf /{.9 endstream endobj 135 0 obj << /Length 2703 /Filter /FlateDecode >> 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 1998 /Length2 13226 /Length3 0 /Length 14445 /Filter /FlateDecode >> stream xڍP\- $HpwBN`wm]An-{pwǑ{N{Ls͹6Xʁ "QʎHE qGH X[f!b9DA/V)G Ck;~( beHY[Dm\ &/y 50A AVY)%!dm;WZS~gggf= #` PۃF?( KԘʦJ ;0E`1[ٿ8Z/J29_20np{b3d 2C,9qfFC? Y: .0bG?¼YHl`G};K]Y>\s+kg+ c4mXT `Iѿm^DL.VVVn>v14e# O%66`O189=W7BdcA `_`A\Z/`ϛ˄Y[Ykh K~`?ʏ]L\&v.6q)A߈VHt?D ڿ׆/ ;ڬ\/%oHO=_=b<;:솬ˆXhma:Iˆ[XF8l$q04ks /- V`yk{t/;ghrؿ՟*JwJ1+Ck?v" ;eI.6B`lmljrsX>! XDA<ыN_ `xY,"v%?% __`1  |Ib/|Q _V9֎v9,A. 7RolKݖRo4 g7Ke6_e+#a TJOR7jl/)ux[^wp%oo%o۟F^y??` qn]Ye@M03 M$:&9f;T4+ᄾ 1 zc#H3)xP5U*Eiȋ*uS¥pa0hzSa[p)R%B7o* } ΁mj3cT* #]s=vmXݾ@%ǝD)RAߍIt@ds#kz"hcAц Tv-2Z13xrZqK&ك;,\ $pdwwyT={e7rjwܜzHX!|պP8T"e?]l.MT9#m6X" o/4+ufuVy1`֨P <b/nz@>])\~WGLbYh?J|[bh6 `ky걂]FqcGtCdJFlEj9m̃R̸3$I}5v@ufW}5 I*OeϧՔ1:G׵Ԁ"-BgzAuׅH-QJkӭC|$6QW1@Gi:QS~㽢sY yu?Ha&1-(ﶩ3H:6y Х7 K!!m@l dJDs+4]Fq|Lva64G,I)GLTE4$x1}~ږA@ /{W2ȩvg_'4|B_:J-iC~:f~Kq?KѤG|^h;nZma?[S(mNFI"y4< ctZo,kZW6V9cS}Vd*Kl/MTN)C>Qx{2-_ņ[LvKJ 8aPUp|׼ @΢g[ !fYWwlAl?J0L'=˲+>Unek0sFVMj(1^'A٭$$M&^70 !-9 'Rݢ^h2/ e/|xLz #p_ob,S [lPv ]EGB#QCЖ;1p`QϷ|ߝޛvoi񌸦9 aȢOERJ]EԡkNga7$.M}19HįA\$HlsCᾺgVkWUeqfQ2۷!~; #vbgd0 <;%A!bz_v) -V)ʸTu>,ܛ-k3ѩ4Myt:ri9u/WV&iȲsR3=0ggSVO1-\EJWZbX?mYnwQ4$aj-M g4M?|lSӧEXUI 7833pVQ. KzOQ M$ZZIspNpιQIipbLexOAaAF2>sr֑mPRN-I; -}}v)0R'A4y(q0{/ %ld%yJVߺ6("0tHhCNpn iIR*qsf+-4U(DBTFiY$@+3 SM"[sk~o=u$QORH4I>QF?Qv֧tҫƳ_AKrpoNto;E9)sv$79+SǗ;EW'Cs;Qj} +b|\Ee1>͞(D6M_H>hsq'Pl9hjTlJR%O.%TgtQ>}YJ@u`Quinp^CAڝnTh`5!xo^3f.F 'lQ|EaK**C*>f=C3p OfVXmw}@ V)c?7ygD9"+ջF([ 6ЬV~:@^cLwzXȀmQmtf[}p<?l0CVZ(&\ 9>1>7dBʁl><"\DYs݌ [Y%َ>]~"Tꌸw1&J̻ZM~M/tLw2^P@ڰL< +.Ck \ehmh6^]AiL}}oZecD6+/]ĖWƣм[>ϛF-P0 fl[J'>R: Q>=_eF'uĐM^r)f"SaڬO,#_̀BgYR.ǘ|+gٻDlLۊT>a[VRk?XmA?s va+g(O#fS'Px\^?_F>mg Pň<χH: +KmknR"24zԖ\,D#`OMQ޵RFcN /d%FGd bU#;]PCa_=UO<3AƎ 3 q`m$rS>އlPb?"%9d`_hZ|.7Xۘ{B7$/J  O)s&W EI@rU._ kd+o6<}bA@)(iqi/qЫ%9ZqWGg t*TWЛ ڨyD3{71E *,A[;s- aƍRMY-GQLBG:q$<(߂<׬gjiS˾B%,tVŮ)I\QdDU(EN zBvN[ɭ?y8A y0c٘SBw<}s!iY ,U7k@0`;%S0hwmπ9v׭Wc[/} 8{> x0A]Ζ]55Տΰs4\9}w &k9 AK64NߐZg9Lѱ$,$8Ds:Fx(^/wT9P#Aj8Br2D? 4AY$5,'HfR~PNw/ҹ/N d@C;pj&BMXnN@^6љ@AϨ`T3˕y&Y  q}T^0^fsqZ3{sL@D0q9kлn> gkQPaژw}S"6ޙ+ ]Wc19u> 4IGz, jC}},c){fUJORnHcAaS֦/Wyʸ kC)R҅d\tGRMn\ykTZ0Ν<+l<:ugS39?l ]s:6{Wq?}* v} mIhۇU,>y ,{]${`y[}$CV)fT\DHV+fVbƒȖH$e*K5Px;Rnx9aD:?}$+ Ho3_ v|ڤd1ޠ2T Zj"{MqŇFDsSNKaE&>R9Jz\0衩|S>21Bj1ؑV,Wt :e_1JFG70%k9Am ,3Ǽ_^3me"ap GvC";T|)}/v VVl–m=1*a*ZMt/*6{WGinԟA34$-Hc x{'6mC]$o.W C5ېc.YkJS@`cG;XV6qBF\>D,FA}M["Gg*;Z=7?7/^"I2iQx#0&Za87rj'.b*EyS] ɣ&ɲ3>;Ec?hr IsS/(\ˋ2B?ߵ^tuIv2xum4w<"^ z[I-U:脉.TfYu\]p0WTN_d1vVQKu>F`uKNm:3+ײ}~:6^;&Qv3LJ]M?rKl#>Lxk~S}U. UvVlɰP(~XƉ TrL&?hzZZR.+:/wRDg̯M@O-3.-k~&8檼,sr6?U'·?hm2yj 1tzk})X XZ vFbk<5&2kr[G&MζuBILicW~QDF5Tnοb9F!"^Dy-+]$\IҎk=X*_'o;5T-Ÿ?ѽ|"9TH(оr^K~jk8>hFg(" _{p3(n&Uij_鏑-q*$i/uGWTw2QK_GIÓsPVBKӲqu(h3*ΎlûT:ˇu]َq{ K.iן!C2j1."G .ȵ׮j%oU]L '˘^:ٽk^ Xop!jؕVSo4ϑaK GŽ{9<*4"6^׷l{k'Ԋ޵?oy9,捻؉S]=k,eRgR%ʆiǕW)Fy;7J⛆yhG{*%VK'=#ό'(m?d t=Q ݦr :bMW>>!hZyg/zVgAJ|IkCO+58/d._j@|t9+^|n:ieޯz[iS:uS.`]& $'tEIqavDh9`G<0m m8.0J:bQ&ǻ¾ZVT_~4Β5$@GZ)b -Xxo CS8ȭS8DGKuIޖ0cg]My'2sɼsԲY??A8z+@7a Bx&):߷8^? ?ցLZL<'$$ٱS G-iYϩw(Crऒ=V2-}NVŐEwj8ip{(>S=psN?<{fh&퐃iy+&(VUz R\~21iDWP(WH* mvJ'a!M\9cBldC5Y܌e Pxƅ2/6FWi9d+W)2+c1RGobvW_u^(GFϱ|d͢foDRYbW? GbZBhN푪%YFe"((DOJ8S31x%R Ҭ}Bh~ې +]U O%-RT @<})YX*a%d6y%Gނ"sjXSs6K9\VYʜژm,@oz/hZ/©Mg#3pY`6/wFZT>9jv"C*Pz ,uއ>!?[1kBܤB4 X'!o,cZ<2"e}"+ԕN'&i9MEY><Ϸb<˫M)E sC;ci<Sں9 }*i$\лDNl6idu m'ԇ*d6^oS#):G*!eeaTslƦ*>h)SG(|"PK4)F"$u]lķzax 4 O=Uv]e$ }ۮZty(w|7W{yM|D{_;רVߌ $a6Xګ`nר !ٮ_q&;KK;JGU'&CB i? \GDsRoj]vX5UiЅJQB2ߨ Qw<~Vԍt]_E]e Ӆ>~{æ%m@Ҕ_S1 =&QuQ=2gaL1`}ɵ<_s ذݹoqǶr96Y x=m<*_9utS"pHzΎr {˼{9}} ́<R>ykeJODWk\qb<2e`ǐnl͏dsƒ@g.wSµ9=hh}bք SKTq̉A(/ Wy'A Q?@pCRuq; U&hu[!:,y05da,|Թ!mv,(ʤqH<{6ۺ.uHo{eF YC3^$qkWEAlXv ƣ?'GزVڅSvkAR;c*=nO+|Q+,8V^a.[ȾC/{J4r|eL a4A;^3m#a4;ȧlC; Ӝ5N /2@Sxs:$<7I]ʜn)| X„ɞtoaXFrm힜MP^Fl؆>`#>aex-mMՊ7{NdCo\׀# 56SvM.|a,CnSBl(˄̋2wTuG %%ߖ`- |»5x։^E{Cyߜ_fu}2hbFq$Le|S$g5Dr:]7Pr&Ź+R66h<1Ɩ jY"^M6NO!~] s!:u0?q bvʡUP.-s/-6nZs<=lܬ"Oos k֖݁cRP:{wԊ#SXGOO9 u*6 轅r~PԅZB ;?5f !:_Rg"M%R;ҋHZ_iem]b Z?A.2P)cE)Ɩ<=0S)`DHXg"ʘEX!|kS c1X{ V ^ őC A&-~ Qؔ&hFiw} ~V}itޞw& gʏtyQj3avBH]?lr1a餰躳 JG}oN#U $ ê` w\59ʉL?Ө3v~sd4|jY 3P9-O1e/@m`f'ʼ[RXAȓ쒳c즍E${;.˿13ܜ@\.Mmܱ̈́ʟʦ}E(}@D?u:'S $oͨ]݁HY-y%}Ѯ( eɨAic)><+{jIdѴHogM'a[Ic֩&/A'B$T"L_NPz ȜY0@ЮS z3FD_oGC٫biS/~3lufcZOba2xכAnZ(hbdn{ႜjڙMk@JL,1U`&Ps+N++nMoC ?GqƬgwwn[%#+aA> Hʒtux< 0iu=YK8]ߐ~W43!`xI2 2|Z. ˒7Pdxt6Bd aOagAZH}`;yɦ *aIG/سرSQ\*R#ECL;= pyڎzsM4YoZn)-;EQ:?Jf0dN\Κ'KQ t>}=c,2^Z3b`!Qwj*:XXJb`Q zl8O[;WEp|^DJ+gi ~5Q%*w}cX#( 4ԑasj1DOAiqltbџ΃];%W rP0Lş] ʔ3I>{#LC A~#m{=ԯ4Kɧ溠IZɈS,],x 3.;'$ZC7K̰Pc[9!+Am r4h?-1Dнw-2zy*;]gfBۜ:[w9yUl>pywyʠI輀 !dhM䆀 =di~eZ:6 _\} GAj,vjW o ]vCʒ1ecj]GQH u k]7:gd~fnǑ^́JKP.52.cw"$O|@Y~&CDD/ ΁ex☣ƒg@NfZbߔ?N۱o1q羭q楚 poy+ IWiaEH4}ʂrĶ>=7|y%Q6V}cUlKm>zt[q6v4YZV(4yO4.Z;#b[ Bwt,%K(Y7Qz><{-#Zw'Aq;_qhc_yynƬG&S!dpbBvz3@pxW$ŝîZ[$pk秡P '21xqs<<<Jnp0BϠ:4K7tq ]^eywj,$"8b! F8 kM{zZl7?K=jo.S9~z; ۻe޵q' {D%qiLל`oTnZTMWpW0y&z-Zq(*1K<ئm*XK!M^cPv_(4`Eؘl#fT3h;b9#!5w֙'Zo7>=Z]Tց{(8 wraē:++rpOf =TmJ& endstream endobj 231 0 obj << /Length1 1480 /Length2 6407 /Length3 0 /Length 7392 /Filter /FlateDecode >> stream xڍT6L H %ޫ"!$B wiJ* R *(Ҿ{oe<3=3]06VuF8Ap0H(P7д@(FmCyBp[@0\ u$4(  )9e&"r ?` C}IAH GP"a0`FA0!`OO  { JB ` "΀_`/i"$s7_FB' b\P$`0"E9Hp;!7\`P*%Ý? ;ahB0o/F_a0Ǭ wVGxyA(__Ӏ!̹)Gr]~pAu5p0&\($PVLZJ @!nyC_fP7 @1?$h_?BAC"0 uIc 1}d0g3%5ҷԶ#?"J I  ߁sm5l!u._*0?gn`44J!/vk_Q;E`/gP0@`FTK_muy/cDj0>08 uA@`x`_L~CPT;&p5~bR0 "A9uno¸0B.$ɯޘ uA\?NKO?]Y~7F,! 11]?U7'roZ ~?)> OU^ P.k򝨼cDﵷw<0<po:I0I?lO+1VȥOEn;vmb? 4?^h>~:nndAJzZ8N]d wS,#'JH([7 mVfk|n10PAmgfGWpx_k+۞G.#GIxpM):XV S_jv4~z8Տ";gGnbO~mBٳ2uTf<%Oi:.t'U>sXoS=feuq%yW7Y2mpgbY>(>vw y!qcbղ᜹l^2]\tіY֒R-~z ;^xUb>=3lMA][ݧ `&26X^ebJs^6ˋ_5+v[ZY1Bq_3DJjZQ:N}Cߓk{}* La5V4őrz my*h8ЦJ QVBaO1wXKesv [ճ1R ן~4qjhW3x2_#ה pnZ ֿm;Isa2_ڧ(⣮ Cvԁr]Oed؞h'JyI< 8CtxK,TFfG-%ݽ[Ûm%f\+C'B8(#;p>}<>D kl.I ՚iDN,ω% )/oqb3[_פ9s@&FX1fB RKCEF^Bֹi?𛇫~ʞ,/NhV03/6'%1 A1|!9zφ6⒋ωdi$O]0ݾD\O"롦bYӄܘ xxZz2xQ=1c\J6&~+!:m2-}2XkqRx=mNtCxȿIw_%(Ir,k{~W84gW 6X'4ӈK#հсǍӵ !vdj0=C=V4b Reub`w$I%R.ߐ{]@&K§: Ы#[nEú9K\AO0,ݺF|PhA1%oh Ċ.fg@G?O;Edu.%eӞccr:% sZ:ft0o&1eiZ;+miexFlYEcns&hAaAh>9iuVFD:S(] 9e cd(CsDi&~ ^+ΊOe`ЌoIMo2Q >l\t"++v1e)aHQ37п>OnXue}IpfZ,Go;#LH" _*֑͡sd{v`̯Y辯*~C(m#,vbw2O3Mg]ۮ4K`؍Om~596})wЗ5j @3Qd}kuOV:Q-$b7̫.U?Jh! {WGkguDL(/4qŰw|4%Ƚme>n x:h_{>|6?z4@~2 ai69tR}ꊽl ~SӸÒAd"^ʺA*m vN͋Ih3ẂF.k +Mw|Шl1-OO'>-kqm$EȡfDXU MN*ׯTٱE_( NKKrD?fCUFMpQʹnHI`蛼kϊlQoa01g1; j[`31{!vG^;*M#yNZ<Tϔܱz)ң@Y %{ZbSИ:1$tj)3!1Dv~[dF؞7-0LsӢ,/kEII ۠$ 1DELwnd@.cĩ((nlqK*7vKc0Ѽq=ln4Hk1(LAOFgҏWFp즣5Ov=65PMk̓?:;~7Yxk^3)3ڸQY^#,USU: Nj"9X6LxG'NUrɞ,p vjxGq\gICO9޸Oބ@kC2՚Sxux d ]}|<^}] \#MA[iP\{wrzNF))8DwR*pf+%܌e8l#IZ'>729Tkj[GNȇkmij7E2Sˍ֟AnCʻl1ZkO)F)BʨOB}nHd۵堿wYq.~e)HR|?>[4γf9uSԧW8e\ޡU%V;r["u([`YЃl)I%SSa*9WVܽօt_i$: ٮ\k=6-.LpDM6v˕1!dGЇ1uG]n'(z;lj-&CY4x_=3e|fd8ɋ3MQN^$Z*`:8/M$S,H\0G Xi:N 82j38Ɋ_xw4(]=^lS;K2F瞵Ι [ Uհ֛7mLJIuSߨQqJC/Xu V(f+/̝y]c}b W R?VL hO9|&ʂzb~E:UyU*t1FȊ0XoͷּDc39[GA]x(z!>M,_";cIw;#0Z$g? ax^>«I'k7UMIE|,VwtuTr:\ Z-0%(e9Fe>T0yPSK= qd~#5.|dqasdBYd=j+Q H5n: F{Sn߭}@}5p!U"~[xSv`hDU&@vd4ϰ/d m3nեr-F(:N)VD.e'&恮o6h o_g <2('<8JU _E~6٠fqW|>2Ӹ40)'oT@\y2+R%$/ D qvĦ\Mj-I\ѨY|Wmf?s:zwc2ɝvw}g&˺˲UjRBqIh C[93 Iim#ьfa #ՍeuF}㹡xTXJJ5p Ez*˰,/ ӛHIRoWj#v$*4YGT} "gqFmoɉ&pXLWdtm|xOӁr먚X ʷ$NO߈]hFcFhnInD_pHq|z}JU')8AU ,-\駝֮q}"Z'e Qa䰣g%D1vE&ޭеqD1243}c0vo>O endstream endobj 233 0 obj << /Length1 1864 /Length2 13009 /Length3 0 /Length 14184 /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@rV1 RTA9'C; ` 2Zۿ8Xʒ2y_2>3G!Ɇ`+Ckd ȋ0@!tCk? - KC׀?G7 ) _dgY2,fm"ZCOd4~=wƿ/5?dmb FUkPRW?63 4Pqdl0}_!:;ۿ& chFh~;3@U~?0?^1ߔ;Y,Lf& VC1SQZ/&K。o 9𫠁dy L'?N$`iꯀWA;@^C"7TFM@V+ 1|]!kW310eً& _bmY?,&{=㯯2]Dȟ!fm 6c'Y9vv.xE75:y#5x0!qF?L!n'Q `%AlF'QZS뵦? _g_T6X_" 7k7_%^m^5?FW+_h/:B&Vu|6:ͫ&5ۘ= ^k̿X2p|O?0v{Ο *?n h0 6o]%D3{[~4O#6(]",g.'l;cum΅=Q/8[YPDenZEm|K!kCuD]_F&#sNA'e{WYxf$!,M/xHN"-<5'e/펕ӏ[4iY ߊw[\$f42wK/!!0 c-z,,Fv7:1F o|=yIm<Ʌ8^U]ۈ-g󆧮:JhCt˯}TwmCyFK9'coF35|2GH{?a{Aeom{O~{rt}q7϶H\M*7Bl>y#8KaAlb2M3f3;).ER,[( a&ݙ9T(%d<%|Yȥ{;_aQ@õy`K%[c(jc/1|k2jpӳjf 23=Jv+%{us `9Z'H%@11NNM0q wWr|<*4=h18Jm;ح-̇DŽEIL`)?O 9#fedߛpV>#N[*ME)bpxLWW+No9K*݋le"!SkD?, =Yd!]ޤ,s̷,hPmc߄&jcY}O30p̾2~kc4n!({罣4Ba㬓kd cD~A|uLݤ(3IyM}E(f5([~T8i( \*wu m\[S6$AY1‹S~0YͥAG=>6Jp3zEۼЁ1GQռ+s^pRRZ籜 O6˞*;?,R۩nbK(Y|&|rLVwf; J&$n::sSK8a)Eeﵷւr : E]}mƆK;_Jnq>]683ٮU3O5z?m"X* q9m0#$Vٱr,0AANN~`ou1rA3wjF雡`j*ɭ {MA2Qd:ꇘcM.}O4+fǿVi54 C{Izb.-pHqyM^:$X,IA>θ,}f^>6pnD[lEɕXis ;%. kWl|ǢX!Y+=`,Nx{UU;RǚAЭ1vavjKì Vzr1UL$%vт|G/225wKõb#3Wjt)>E,o%Oˤh+9OPG==e [E8J'zI>BBΚf[u ,syvȍ ~!C+hTY;oebDRf*ʨaӜǘqmGΨFzOa+Fm)>0zc\%L0.bJ1zӖe׎Dژ o%y{^'D'6p}UPF㝢OK#h9Q޹Mq3,b9H:Q)=sH J֞D(/{4K4p uE|֬'G9/ /Ҽ3UJ@/C @Nڣ&ǹ(vpQh5}3 nz ܓ 8RW4 q,EW웂$f\hy_o:֗n?eCtNgUZ`pgB/9^fGUrPJdze>ϒKΦ`|Z 鼙e!Ec{(`:ʪ_UVst :0[Cl,8y@CNlbo-]%p^ þ,!# FKmeY|ƮwJ":وPI?q`t2IXcq\u"Ih˾q1M$zCxGfͣU]in<#WI rDj1MSeX8?Ͽ^`+UH4"w{[sa5qJg_E;;*z>"Z_DZOLsy={#H | 3[$߆BT͝I'C=??*H`ʧCFK g<$UHc-Jm>Z1ދ@ϜS{:Q hP/Y)PA bn" %K\}33 Ktۈ*'crߒ$mYebM|^qͮ=[E2MfO狒y!V{0{h.ϴ.uy Y+on4 q4쀋~-Vk% ޽ꞷ/ ]BsAB;.*KE12-78DbbV܆5je I/~Vƕhc\b-n WM%d^ZR@az^ 7BPRn`Ͳe`{>s̈́+njߦb~BFb1p0,ٽs,ٛ'Ս$3\ ߩ4xNr2]g99/5# @žkxaSm>-M+{vzX.|Cg[{Xc1?-AA1ިZ/EZ_"P=*Y>K&|׬&)uUB  +R̒Jۘ|yZͬ=޳Kmu/bb_WsZXnLC] ۭ[3U eo7i~o gn+ -l{*bk]TqCN=]tڈC-,S~~qOKnmS .+j@D3zɨ۬2"J5LN>r; W]h:i~Tߞh֊|"b벉vI\?]02)82gJC5Krs;P995 ~{ϭCĊOjg=<Ɛ,ܴ]Ht3]9-m(CZ*fN{w,?G.ϡ[)ݤ@P+"# :XFP?==\4'cQP*gh<] EA5T碤{-r/_h5Iy"$mpb O E6cާ~B ;QW^YVuz2mO\U#6)SիND:(u.9[3+kn{pdͩq7*}%du3rccxi,?kɘc kz?p岙[N6Q/L8!r.|®os,)Vq=da>TuTޯux UP% `d+E|R*C_f~y?X.9'9mUi N*|`~W:4 yV"L1 f_ k7‚^>vz#epR֊94qeǒnl0MaxH!3ݱZdnu^e%M˸ Ģp)=dAU%L#;yulݫrwXmӔxBc%FHA/zɓʜI #sUBAߊy@]!yO ;B{KO1ΥgUwqE/=t'uPv`a W6ʋH.Q) ~Q\0 Ggk?  P; l7+N#t|: \O: hG>!a22ŵturo Y /lw/TGD%7B0de"೾Svqrf^3Ւ+ +>{sYC1aeVޢW?9 3Izh!E) UY :l,zɊ306&I|x?wl =NEu8$;iosme `3޾s1FuIm|!]-&L ۳`G\~9zoɛ&,*9F.ž!}RODiK~TP)_]Uwi6! Û߆`AbkJO?Udϭ6DbtVQPRܝ`6 Xy3 KC~:|K>:F@FYӽpQ6,,Ǿ;/8:Jw -2{'o:OKʈJJga%05wl%R/f< Fm#NS0&'(OQlyテ6p8mY;}E\C&5yP#>S vQXK#,.r9rsW82LQ"Q>+ROT|l(m"cAr˪Tͯ¬I=I.,~!G|? WxUa4X3'|4΅ D1[LA¼z4# _=UkBX2 =jXt򍻜~7,@r|X$G2jWެv;~N~=#LSWyht8CQP" E_jCt|ǔ`0 v/RK;vVx_.N}Wh[E%2.|4ˆ lV:9eRC@'lLs 2N5-ޢCfT \/{D L4Ԗ,a_~4HBIѰ#L}zꀀтP F.ALsJqdU%`xXC9|)\n):F(u/<ϛpZHRDeL[ &* IfqrNn"r?~b*zNb2?lh^Q;.61lPP2W:o較{CqZa&5ioٴe=9õ͂Ԭʭkȉ}oрN S_4?{ DgsR.~FdchH6N-f$"9±ݭS*X7 ) yCZ4*mGI,Ln#/G>R/Bn{[(B (oT!"d;I#: :f hvFELgpT_Xt԰:,<領>"Uܠےc,X Sk c^i~ns/@%XihZ~j2-y|1SRd8FO#ⱨM`t\@z#e4OˮZ0%xb/ل4fU\`;yL? 2~.[[eݺU93*A(.9(oH0i! O]rcשq\@ߓQݜtظP3MN[nṠv:ԯ_* QDp|/eC3:z!n}QCQ &dS@3L<(8 dJ4+@')n)L&}Q(S暛n f7H+Hx%TJѿu^n=JkfEVy\Ԥ h_&fIP?p_QYS_G-邊1C[52[1՘1+SOV4%&a<+yrkI.ǝ X뙵jP1sU&Ս 3ƈcQ\yœ¨[+C4I* t-B^ \)LX˱ oOe;AqԘGI-Fdt2ID jPХL;G(i߿Mɿ\^+4° +x/w.l!)η*% "̖!I a^-UT5fU+HbkSF]L," 68z]rXxxEd,?CW}V&f97KڤcN|$C?2,k [CBw" }y褩؊OqpY;;{M$ݵ-ixF_rӎgeȄo@WfgZ, \nwݩ[6y.lh+ggP <~/uجxË 7 _[Hp3kbMf,GoK_#PZLCt\iOb\Ι`*\DzıkYlWl1ڷJٌ~ājx,f9q8Fs_J[ gKXZ՚iUͮEKhsi@f]" y8е$wf>$"lߗx?qID G;I%ac[p^GIYv9#M; 2$ir44A4|Xfb ʡ(PD2Iӿk-R&Jp3U s1j[7? @w#~#fIl y
  • >'BFިv Ki9+N"c0ƙ~Nօ++E2߿p G2g 3?!f? endstream endobj 235 0 obj << /Length1 1481 /Length2 7087 /Length3 0 /Length 8082 /Filter /FlateDecode >> stream xڍTk5 RJ4 3!H 1JJ# J*HtHK+R"ߨ=}kz}2i"aJHkh@ A>HUv&d5H%ȻàhOi UgX@HD8@ hTUw@ca .Ⱥ6P@v`N:6p_-8$hWq~~///> n/0f  uAG wvh/; q8m`a s`詨\a?x O5#~Cml.Pa;ZJ|ho4uF!1PO(jI=9$bewEPp_ܲ"VCQSl0gN/Õw(q㳇 y8j rc"]v G臂zhwXm[ ` #qؘý Я1E"}I_~u-yU?Czx " W k8?UvHo_K3Đf ?+wuqRpv.pg0\@ctĨ񿩏`{oT Ca8/X$G)ap& pL`@adg00D^/QٿPD mQ" C}1X[[oH4CZ[ ~~21N#70mx`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~ͫZm۶mײmXlV-<׾7m~[9]ͭ Tw{vNV[8ea#A[kkc'G ;NZغxnَNX\&@`l0v34^%o1oO;[; coscXOG}cߊE #sC' @ɿ0pnMz 6^F6V/2:N@ I adapXrO@q[ǿZ?mJfR@Z,o ?[?j?j}ks+ i[m_SU]Պ;c4w1w363w24`x+sc9[Go fh |OGe = QgIxFĶu"Ǿ£'68xDfXu1Q<s՚Ħ [gxwY+z8GujT fI6},daC/QZCh-z~;uJD#kna.ǻTVhWw鶃F:If[˕S?Ɛ1zٙ,!czA2x5Ɨ.jE&UI+tMW30ĵ3/x¶+ #_2孀'Zu{Y *O}\(l}hKɔѺq2Gޡxb}K2={4c$. HjxkS SC>NVDexL7bf(DvA#Xx~ȗ}ҷ+YϟM56њ)8"^9ws-3^"(镊FST٣hJl XMS 6sU tv,ӳJ%* ?$R~\)*ZJ#S.x7;B)N`5KcԄa\lΎ% rQK۱"TjAj[*GA!Ї=s?^ ߐ5"f!3oc k>ZK1)7>6f8wfxZ ^֬].[˄wHo8">gJNSLc\v,Y+ݲÎ[618ANb%ߵx>Ըj=_̦ _m[tNWW hr{Yܖ\IelCbt ) bX,]s~PʍKE&#Q+ۅ#`(OkUBz-&9eY9FOk)/<;()WQ!T˚ը-N++|s7Ru{r!YlE|2ojNٷFq|ss #- A$ 5b0qط\P)\YEWB"l؉cVPݹ$y34pZWKV"HNNDUkwˊ~K}:ʹgIDQUՇʢLB_ɑҘ?d-RlXرAf&Һp욖ް/ݡdCnU6B,KjLUiV^YmQ>ZXi89L2q2:\ኤr?^"״J!xbns<WLRK V吜sG9!C9UnxgQCruDVʾ?Q;)j3>IO-KHgUXɤvb=#ΠJ'\G/~'qٔPjZ}bXw*\hrqk*N#˔D9}>#N8t߰F(=LŪ!#T>xg롐2dfo3 10~JϲЬ[SVy!A!2'Xn 0JYTi)$56a:K=hJYAhbXtV+ML'H"F'=n9Fۦr^ԍ)8m "Chl B ⵉ LFKR* XPgdaXb?*+=c[tsR>c #QSHG,tRr2k[١ObgP ?cHǩFMַGUtBN9˼-[MhEpC%u^Xc+*6e/@r.ל]`0(m˦/0!/m9$h?tZlVz˾?YoU~nxH{vjC7r,|10wMUG '1™rUu$gc\-ص<))b:ƫ۷|;LLz ȤZ r$';qvN:H,Uh(F֯Cء>rR֕:<3ܲ-x|9=Ļ EedÓ L@ h8#ҡWVۡ/'@ܝfp{JӋRI&m2DBX|D2VG7BQ]) }UL9 _ŪFoJlc4oCdb;oKX7,іa{ ,owD0P7XnλJM#!E'>歀s/YCaWE6hŴ4F+4І[o~ĩ0 ڴQfhmg.+H!_Áis61N%KP}Չ[&nQ?J[}00д J֥k65r'yR~ePgft VєцP덽zLY4 9A5]Ƶy{4TA0c.ZQxBNzytmq0_bo^g)x1F'LsE-ڠ1qދZĆLJ_&(EmSZY;HJ`AT rK1 Hmж\&OO[)ڷ&{O5l3!xyn_g& "ǚσjCX,}8:3\>sY\CKGcĚqɲRR)(G*C{ekKA!Ԡ94btr z>6cR*h7]մ%>sO zkQ޼A|YF@ *s@E =Hu8M}"37Cy'}Ϟʷ~ΐw5Cô 0o$@r(6{Iq!vsƻӴ O߰ VKJ? ߧ+<[rFW¸PVa"֙h:ƴbYt[B|Yn$n ӝj},UE#;,$~\I\EI2x`Z*q-x7~?eV7+P8Vˆg -"}VլbԜ DZ +?S/-=n+Psco?JQDIR@υqOFOO ĵzQ`K(vnZVqORxS~k 8kx>QT#!HeQσf8\y LP_yf_Jj(|,HBZG 6Z%If5^==@Ǖ}j|BIB5Oa%IN}cHwY$`O {~-h-e*;b_SWDW}QG8V-uS*.X_c fl0!X .ۦH{@Di3haȟe /Pn[c98Ԃ=-@@ΈzPg6b_¾2Q\-wU-bp/8g~Fj@O;. "0񚗴s22BfX^(W_Xf#hY($PCR3/o@fFO ,\ht$T G&']Ox+H; [D,w2n: գ}ԓu=ucðo@aGld![*L%3` f53]%;GX={ H2u͒B]^ b0&b8L\}OH hPl趙H[Yԕ$pCѥP)FĂy3KzH,Z[pg0}^1%0 \QM18\h Ϛ^^|O<{:riA]5iL^_0= q_, eu0wADx&mWCaF|٘.V)*&j6$7e"wɉG1VDTAS`U. vCHԔPT(`^tSX J71 . &>봉Y‹JdJGgkס*ŪB~4m⛎8g8+ 0cg'l.BEB ]f'JRYZ} 媄L?RVcM>"W /8E{!I@GRuH%h̾_0'!$΢i)~")8 P3iZl *FJ8kD2z7;i~YD0ӖU]3A*#&ÀUQ{~Q˼w.5oL_2%07ؖLd c$!oZe߄kxł *bw;#5@?m`bMc#d&67el lզt A./iMYl]9u2QKg.<)h=ڋt3#i_4@QZh SIZdW/YMʨ*V6B~oO.]][wClXdtm+򈨋E}DQ8<'8PHk;ɓ^VM LYfl0 у^.vR] x bZ2E{,#>MdTp#ZhH=e!(1*q: R#k""2Rh 6P}.]=|C{U-*X5oCZZQ2_ ӦSƔFB ߷RswS2Tíj TVJk;ZCxLFɅzC%Aa:WRJ.)-$wMv٢,^.Qh{̛o?kw)1!c`K %G,kѮ6of𯎱V|H-jzz~n/&IdyH_UiN%l՞[M 7)oP̪2O.Te:K.^;y ,D1:M tJE~=SYU~ 5 W%%RBO§-*ku/g%t<;&Hߌ56PexO|\jM`6eh1&`] ū睳K+]dYpQnsl:_Մixw;IK_D-4h9*9Fܑdv70nj/ )>:sO`4~5D+<`~3l@a(SJ%xE![V(Q &R=hd$`|DPǽv~jRxW⇉ qL G`Ԗ#}Sq+jؗ>ivTe$A5pݱ1 eTTƲxINǮ?6 )W>5j5VU8e+QWF@1.(m>fyFEn鉳a'u{Rl0C`@@!zNdCs[|i0V~';!I\3vY1 }ʃɶI#٪9* ko)\,wŤcI,Zq DadhC zI'hi5%%A3ZJ2VBЏ)-+9LޣQL{ς5:.3e1Zh!ܮf\r3BNA6O*ZOЊm`W^wq+X[K,Pb~eRKp]&s-~øI[!-BxBI=q3\U1+f,j;<5&lEݽzRy[$& ۹-Z԰l0Ga؇ , >wk\ETjo#C¡VZB+sB]T}ŽI@+Gk^(0WII|soZn=d {<s@[tʜhIfzD}:V#d5<-C鉬QÓ8xj(a!"U>I[ulND@}Ke(~^p%h2Z8v1XV,m^bV>]6Srt 3iZ3 6wXX1qSCׇn1fW3ݡ"͟M@ơ}סTj2"z@h]lcn?o9^ CDta #yYT%_[_mU3ީ$&jenX, [ ]Qlr5<@*gEk-NaD4#k`kt,5,Ab])Xglrp;<ؙdomc,Wۧ 9 8vd&tɎuoR;9ڈ&$!]sy22Jׅ/ve6TH׌y=ЌPVT\bTw14޵(Oi!ȏX[gPU' ה"z)Cet-%Mp!Zp+籟ɜerVؾ܇RCTe %vMV֕+tubkUN4[T{ڏsO(e%C\tY~_"wIfp΀^nn]""9ޚ֜ѢTR2uoVzi^ڷ>0SmH5ym`֘(ˠUaLS d3Z[fi= =tJ2䩻{NT',in,́2ؤݤ]AǭX80^~޼_u )ʃ4@smFhţ^J/ uuw+Y旮X8=˻@m@/ 3[.SXHߔ?W21uV0Ґ% M ռxTu\#ye",O CpZ@Q^JO,۱@K.0b;X$ф(k&md~3"T1eL)C0a g䢖 ݵW)& +V,R#z^TȬiO^?e'& SReCEa߄ɺ op:Lڍn7 \ w%h q.?EDL؊drp!uFBod`0ada<!aqn.Zq7|g殸@j5-%Y9ͻI Ʀ{x2/u0r* 2omUՃ6'vshvIK7T@U"Fw9!ˇ1TO2_#)̌FEd6괿; j8n/X=VN8qbQQ@aA-aEG-&ѯQ:F^0R8 y7Ųej\djvFaOG/0\ ⨤+aseycw"c87fqwRP)Pgk⑴GV ͳ 6M_#1ǭTmKA 9SmTIf07[dE'P'B ,Fuuvneѱ=#,[7X,怴XKud^Zs+k۸.`iZK-j @F^?QeQ^bl:o6F02E0T;=T|(&ci! UNt`pH::75͈cK Mn$6-PRYq)c 4N}Ce~!-6t|k }%G?o\[%u ,ևN/ki0ǥ-ֱF/V &ЃHV%Pѯ:12lZVX{+ʏFZ6MTF&挴WY5NEtm'g.+l-.Ru׺jfHj=âq`~Hxz7l9/kMFO +x.䂍t?ocޤbq彭 ^L朏Gڇhűpgk/{tI022 t:uܫ(߼;=O,A)PA'fn)BiWtJ}. ls؂0{yoQ43Zr>C t>Dx_d\gbj햭ψ,~uyw5|H@"gVNH]]$|Ȋ3D_6 k݋\1PUijʫ͹ڍd e=cΩ9ҧQϽwVG2!-vA mrW 1:>_rRr*;̳ڝk$ #T!ngFG3je@3ڢìSceyC.%j|w6UV3u^Gd80hCouplI 4fq~#dmT@ 郋[F,AU$f-c}]J!-A$H;;;.f.x׆SKx[ CEĈ>OExhr@~gX5"-HNB ʓVÝ'$]=(>~`φD$7Rk8@-m{|wEftL.S)JfYEy#IPO2`9(ڲ)FsGYfDEqر9ޣ4|=A NIwVeR4f>PCjYyVqS^ a`'8tHNwg = Qih4U=>A4e7ރ9)j.rbYB5 \jY 6jO^5 #2gN NlC'Fc{6茚yb-7/#8?wzʙ/1ttO .fBKԌ0s3 (lJA<Ų[7dO+Inml,l/eahƒVwf{FĻʅO?PEО\I R+_A0kxVyTw2h#\j䒯Ozs@F;>)@d'ٍ Q r3jw+sz%5]<_÷7YX rgfX4#/>}ZU׺5Ou}2QW.W'D@ZƙV%c5֐ER 6c9}0)L/ 'b/Qr9ju1ǙU)Ipܡ][rDn~ Zp7B2RGfM&z,#^MY *sl'BRhZIpUrCrWp+XB`RѥSp`EIZtʮ:>Z0L.@!B^= %N%p 5PMHpL2LO`g1*20T?ztOåf|/k7n ;?ڷٕv*/t$`vIL%mcq()}=_qyO)W X Wp%)m8ZYiwΰLԵ@8u^aU3E{}ko}!G\q ׻.,7'ӰXlđ9euw>fuw5@3}^OG.k^T{mDwgrO[m肃q}J[8nUElAC-0{XʜN {쐩5ŭiB|˾.ne2kWV^;ђ~ v K67y,|  " p;6x')_Q4|]2N*eyt!<(^KfZ Z7h?50Emcg։G{"x~XONQݜ. Xj07/tS엔xf(9g ȳlW:$VIVJ>~&lX *0ZA3DžmףnP^aꅌf؋vvhMSԅrʃ^w#E4fc c|eQeruI / LޚT(<|C\^~+_HN[7k[.d\p7LOv- srN(ImL6 25W'ˏ~wo{ u6栰>Ǘz7> #4ep0OMJ xcbvA;/Gj|/߼7&>D[ +L)3lLD7mEj 0 Ի z~5ą]a ], c8̊ی_e)~"/* , xhۼcoi )מ<&WV0'ʠUBT,'oE+wo,\*7Mjј+`⽸_'%[Ad8L \쮾˓sNqWEb \bɎp\_ kCoQ !솲 hjd!^n^z`JH#M4 l|CM5ss:it4-r&H:EƉ$͢oFūSLJsLeH>D?B]P;6}+Uы>^ e'8ʦoOU_Eb8خRB=`GaY*iAZ0*Snf;&u:zQj?)σT#OŪ:D>pry1=wVsvV1[%JԷ5ڊDo΄8Xy˙2G .>VK_?p2®6Ә{q*6Gb]<7`tP#ސ!t Ww1TqV_<]t"Ҫsk?+?b,qY"|M!vCA* $Q,nySD(vzN¯?Ԗ9tK"J V ~m2lr/>5ՊJ\gzD2D?Bb$l>* F~btpZ$XVuqws\։aEB1˙ ρ;e+Nr%+! y!KVyU;& ObKK[16apjq}O؛Sd5+yR#d^KrCR9 \==?!Nd>(+ )UpRخSR4IqʆoMeP%s!E} A|䭦|aq5=aCӺ/(|H=oR!1ghl?v˭aD8M+۝QLAM/Mc)x~":rjFXAдK2ٵp ^!'xjG}.!э S;+ҔkU{t!M3Q>TZ) %ߒh\,]s~8f^ܧע hot-YtC0zVD!Yxuທ,H:=> rr~)!X/O3w*' u"=Lp/EVo׍0_LM8"5"!N:y8n1[QI@s/a{ҒY>q ug8>h="X~N 8S N BNlb3DާNF4]\`20,<NSiOu$|Tk+4A~c@BM%T̴M_q]{;{B;d:YiKwŐ ;22Mh;,Wc"t0Y9b ELDTţyҥ;٩) vګ ,IK/<]9I\vld*[:y9/:Is\²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 呙3sWW]-kO5-%( 2$yll,ll( W{_fZm W3&i+K7GV-0 ('Wȋ 5 :658_8BV/"~ +; ;;d 0Z(V;<l/`e,!`{/"㟊C<>̜fn67,?fލB9 we(tL!77Yo/$fom+e\_B  J@Kz\^C lm1\A@KU͟#.ۃ@U ]`fgc˾Yؽ'./|Y.)X;3gg3/,%!/)y~+3} `mXFlVտߋ`q X~kad/_^N o2Ŭ6^6@/R_A_؝_\__E?_]psv~ؓq@ 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?V&SUX1 PJw{*d_IKGV+Sl@=Kt,]# '+ _h("+C>n(ϑu)Ĩ9cLQȀG2qlIm^Q6NV̬=F=Oq9~nOgX D9tޜNnXڼjc x%N32`56r{h$?b/?Ѡ^o!-;g0P*T;u'E>ބl=ObJǏd]oZd׾Ι:IׅۚM\eֹ巧,X:hQga`&R!̅Z.1>nBwRUO58gcvij"3~9rޯ>6-H)"Botn-i;x"c)ߍ9ѯ ->Kƣs2jku~"قA@gY.X  _$WGY :ۨA7WJrQr&ߑ8* FiZ@8-:Te]w #dTȚy$ WBcm%bÔfk R$/R">oP /+^vGg8Ą&1lٶ>KKŅĖ,ЬkD[yI5֧-Fr]W~Ud;jLZٶ#~ac8v~!Q#?>[X ܅o"Y2VbrV)N[YJ԰[t >6'wH$ ^j4ߔ4aq<sT7#!gqۦ'X6UH ]VUhq^H"/Kx#뵗[%Z$Bzq<0*$LtDɘp%ZT:P`X&*y.cI \@ [4zX24ӕ% ѩP(a7y؄@d)ASE'<s?79 ߝa T5jKPPy^}AI2J]s&q4W|Q31a! BRw 2WsbXtrL.OHB iLyw]+i(| !^-<^xW+q^Ԓ>`f. 5AƌJ9!eӨD(y Yҷ4`Y擠I=Ix ȨH((:9&(qck1-%+6,FzݒrW7g#턣̺sZ—e>6eRwqAͥ*]K#DKG'?.pWDeIn(W 5FbdW4{ш@zN+ρ`*Y-wK1fO:%綯۱V)Ēij ͹]ѻ oED+>=705 2QG(ofXKoj7ρ!צ3@?tAANmEբuȷG̉ɯ> \8D9FMh<.~0 d {LȦ(%yB2-iF y4~`YaM*+UgKK~n]{L܋IKA'FPN,T y}z@ܻHs򒾭M]nZV} ࢢQ8fs;5o${N6,aH7~9|b7+؉_n3@ZWH04ޔĝF]Mɭ ~7c9qg_{ ]巧jB^Bga莖:}/y+D ֭{@ɵ* <!x'y2*\OX0kp@Rz\(fKM=R7.(ѕ~.%,o7h;VL[(q<-xWw@Re9xHL$'AA 2 C3r΁ϣK{rWV6ׅ:ባEyʁ?UFPĸ5. 6"o{Os|KvhȅuM 02(pGmBQjzqL1#} ߋx>o#HSGb (_H8h>] (yidƥ~kH(K_#b nzW"dRt`TdٽP&*R$iTtX]E8sP8K)v7oFhZ &D*À\Df 4oC.χgFI:\ H9&Pd>17q{.0R-|w@0gp/9fj 9l]2%'# _:i~c_TqЍq}˾.1WނOR{cBY.M6䁏xQ)<z>!78x3}=YR^䯮j<,w#KFuWBW=WXĥ|~!5ɚCn bCʱgLBl8`ݶ>X*umJĮo,0Y!~T^Z@ָM/nEkAQ hO݇@Ԩ8W?9A}51ww]vDwq'Ҧ]gx'A/Qʹ1-X";՘){oQds[ G8 Kc`o?|f7Œ`nõ?hEA;g*NEł-F-- 0'C,)vdYMd U[ t~OwR#{p؋hPVC,AP0lqeƁfӯ#gh-a"Hռ> AJqwq$ 8#n?Tp endstream endobj 241 0 obj << /Length1 1440 /Length2 6342 /Length3 0 /Length 7312 /Filter /FlateDecode >> stream xڍtTk/]%H CHw# 3 H !-! J79{ZY?x¨#k)  /@NCW //¢F@@P<C+ J/+-H3 @ ??@_oC@l  8lg@nrv:\֖P%䄼ЃYA`d@8KyxxZ:yav9`=@l4-@?a  #ܠ6 Wn:@cǀW 05l@KQXBm~ZB0%bi4%@QV`;+煃! |d E~'vY#_݋wY0ϟ-jc3R فa~~~Qq yZ #q9l@~`[n \@~>[o ؀+Ot$ ##+ # [60(2246M?'O`A0?/E?ն?U0 ȷ_=׸p}& ?mo/oEֲRZK'0/=ȉЀ!ߦOAXdvso 9P; W{lk? w !`(HZ3 ?鐳f\%pd~@Q PkͯXZz! >@pڀ<5 C ]Hz~[+ޯz G9#WEBo[WVnHcA{-@ 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ڍeT-i$.Akpwkqwww!Kpuf}-ւUT>UuJ2EFaS;c3#+ P􃊜*+ @I v(AN`;[qDAF3(b derrXXxKsM2v '#4&@V^^nm@`#[#g $5P r4|nnnLF6NLv悴 @7PrtـZvؙ995d9bk rBU ۿr +?sw _LLll=@35 !45M4v7r5[CoVA4G#ى l[%05:;~'v@nރ[ڹzf`[SRL]l. i &9i,r7`Dh ^NF ߎEVV)h 2DAfc8݁:,!ddLl=j4?qعXl@.Vn /sUP Wƃ?C vil. ' .uo~G؂& k4F6`kp YvUwb{ "lkxF^&`' ;Tlb `[ddoSA6 8A Y*nkbg{8FFȨqrX!+k rkʁLvΐ#@B#wk8¿M#. dA@f?4x& o̦@fП d$ فҶ?HR?%@DZx[@? /c/.HֿhBOlvHh[b_R!!!/5?ֿ3O--B;g.b-B (VHTAȕ_Rǿ D_R_/ dvA&y;wwDn\j?_\H91L0}VeD7<)9b#:`CcݬxE:0B0a"Pi&/X >z|:#E)(:jN{<IEayZ^܇S)k_%>١.14dS2ȟo:1 濈r͆Jύʸƺ,:ewA0GQ_1.&RpVm%I̟H(ٻ Nͣ["[Hzr sHќ}ĜOR} ͗~&9a~ "|L:aW+AߠIq.`_UFbĀVAwPHě~&s<Ok{6bɗiW=ʽjІS eS~$zUoх& f H.fdhAUdh8M[G'g(3R>ڽP/£4p&izi8ej*l]Bէt͠4 M%91nGL '5ghMLP=Uj+uӾ6v15Q/{7 )'DGEdD߸FL4E=l' 9U1϶fD|xt[# 6 ߚV&__g+WK 02P0Z;}{ՕɁ|MFR1B~SʈiyAnAh.Q-ȱgnZ5|,'>Ru#@ 6ꃒ6?r"G;Q; 0CuڌZD9͘~}|=uUШ@wBJ$hd/TDovS)r't ]s`7žզ2a.g\/[!ȘN}ddf2ثҬcDi,* +! gudT}K)]7~+&!3ܥv25~A),hWTW`"qU;+ِV,X)Q4'Zzj!#q\ߨrt#/̗;]O["Cc#Oz?98sytOj*~cqB;"O\NHtC{1 c_@x 9Ҹi@,PMǠAϕtai2;C= &e %J]urfrUtUhX0L ?97rIv9vo2qЌ*7$'|X4Ꝟ)ت86O1yl7^ aOSk\4a-u=;j +5u,~s.(dSҜ%zKtEz+Ʊ Kum8 VYD[UfNdYeV3:|U]?cс$:{${49D]]0/[ϧqkV zrV2^n%Bᲄ 37}}DoU$A72hnㅒޞfgv>$~:]XWvN y򺔘@5[c^5 x }bޕXs%~dNmy:,̡Nu⛟_kb|!)H2[hɎ6d^2\O <?uAh|tD6%WzqHkX>-ԐQnnٹv؎=gӮm,AWsu \m܃7ET&? 4&TϞ{LP_y3HnJ- !p05yks1> Y3 ʑNQFG>9d̹'JpUt~gX'q7}ұ7u6(NmH^%ǐA$C]r,۩P0.Sf |wSےCA9ʌoy[hpazAI3rZP97;7@=&|wx2tF@ܠ"C#"yf+@{ HeHar,o@Y3Ɲw&5Iv.Z5u.fn yBckUW=XzTL&C?KߴF"|2 ]+Ǖ8<^!N xͯeI մ^:KhH"˞yqo&o7] "C41C> [H+&^!EtD7O')Wr$9|{-7 E/5= z$ * kIX/4>vf0d'U[]0@eRAr +l"Tk#3iћg_?6fi1 QBٽ8T+BF8^`VT;-S|ݟN0tоzȾJAUΚ tnRl $knDF{vNXv~4uENI/O@V rˀp٩; ȣ^ّ^:_69$>KH8sD$< 9D"ezH rǺZ xzh'u :.$XTܫ}$gq*k먰J.kt|$ZBUN@k : `qFܱ/[x#\y_:  /wxZP\f[:hA2|\ z_E/V"'_ Pz;BNGx\I>} ޳ʹl mPsTc!FqפlTH ;k(<&venaPĐ$O%@bl:9tongy(hWсtyReڐϫ;#0RUsaU]۝ xiGM367{zgWgDvv/$:c8Hl\-kr0Z&Ll3[nx Ge8W:m Wr@s+C~fc4 ;ΓAyoMP\UfE~u)\FN=_hاV5 m5v \^F@m.-i6?|_Wc:(rUMmyݪt|qbc&f&q6`ʳ;v.U"!7 c865/tzG"AmDFtb {6x̗Vn"〗(Tx_Wy4/eCa65fНm}JO'$P-F9ube%׽&c]|YX0o = >f ˼/F~"W^oT0gsB(O@*0ɔ̌ sWsD82 ӧ-'g7_dVB^rMq?2v{YK Ԍ uN(h}!uFcm:379\#̧ϵh u= Q!KӓbU#}EBj&R/2c`H>i[oAF+ w bLncLe_MJձqЂcv}(tHgr2[%Amj91J-hi .jJozb_ۧx 68\@j#("q#) QH1B..< *kbݥwn,On)r04J?rf LYÕ[&^ h}N4[xzLz~`5ub ^F)[2 E_eJ v|9v(+ǛXxZ"FbuD 4e+'{ \!asr" { =[ER$Fѳ7(%ryU_0N>#*\_4Rv+B,ThhU5pw1Rq䑼g3m tNJdQ+Oj.u\}JRgr*Ov c{S˭-)ڦ߯_ӂA]YJ3M lW^H&-2ђNC33pqE݀gnDR -A;zAlm@N#3#O9Ca6\" _6[>ǔ^‹YbJ*\W e,cȿzq$ȷx j. n!\* ƿ@ {Hp2knLR2.lh XC?J_SD[ټv&ޗ" <4_ԙHx 3l ŕ#{]&jOY}Y`ç] ~!%g*+} aumKehyHC3 -6q!Or ^8$^#WMhPR@Q]aVU.wHj>p]˽ݮP;-~s /-8tm..Ec HCکF8>#3j~ϰbUd/vB݁9. M8D7C(#9uFh_o|"Z՘1-G'y9kst 3 bE}w!iKfR/qP5nw jn1G÷X۾2IYGpk4v6.S]eX.vຼB$ / ڦ8v9 hԅƓOn8R"PeUa]62˫=ۄ8oGٹLw_{$w Mĵ{<pYA"PuNxeP^z)=Ѭ`sq$Joh0H<4?{~AiLV3*NuKEL4=YԖU6ܬ<\*2l Q˱lڈ|cjQ]1PT(DȉRLk>R%<4?|J8ԯXH篎0M7PS(ǝJ83oN<:\I<6nMI;d7>O)8u_!h 6%ʦqsE neho;} { #JzxH^ZSwVle6:MV+Ʒ>Uʉ+6N?Wsf&|sZ\}C-ͺsX)_CD:EMZIOsִiǧ" quj ,*dϴ|1A+"gF~ɪqC: F'qhVrZ;y>M z?]ۼLv`u'lhL1(Xb.IJpnk9Fr-.a&/RFH>LN.}8zz@+6JcWvxʅWsֳ6FʨN>]k71嘢H8ֈ#}uKAA|I3fS^?7S)}Xx"&>; nHeg4t¿>TlWp=97Vì# B# ǭԃs~ wW_:U*r;Sf94K.ܴ*]խ/_`R: Gf=uoI*, J[{MY-XIOl]S/NnW㸇d׀ӓ,$udjZ~\`:mTfuG47n~*[ WF\L%m aǙDIa24v_LHx2ucVA2^gZy],Ri[Dk&\Uh' Z=M7|Ml3ۥPmR*$)3h_j?RҾl̊c{շe{'s}ՉDλ=ȵ;Q0A4*jBR_RqGsؔ˭+/48G]zK=w;)Q`{OJV|-9Iu쭬py>YYJW/?>cOp (^xjx:kG3⯑8c~ V6m>oj3?O*_-22lo\bϭ|Z%Bo-tp.ڕ\n7*>Y-L(߿$*SYA\k"խ,-:5At:Wm u<#}eɺ$ۆHM]t@ )7r>*K5ƍ>rvujIEkKvO\!EQDX^E:ksJp-(`lE {L -nIa]a|׉uT^Pи2KxE?g|h%^#pNO'σYI=rzhI0B=[0`)^x;h{x52%N<>̗ c=D'`UF^|)59mۆShS6X1K*Z%Gj l7^nFS7[mLr &xz rW|5zӧ50$ld@tuewxGaO"#$9;XS\Ao% n:,#9 /©ֺt廻%‡j Ǩ]E1k!z.S)b=gIK&C}*N+z8ehrQT#`ͦg[)0+oe?MQxW^OY &ُG)?ޕy`q5_t$ XxtS&q%砪`{氿2Q#Z`"0{Opl1qdd-I{یe{w<),{~"&i'Vw3zfbFHS]ȞW}⏔OL4u +dKP(ɜt`cmN_q^ڈZZ)4h;K?%R_CĀO nkw}$8aؗ#X@|6,ۅm?'OW|`g(z%lF҂IsJ([3Rg8e9^)Q*=\$R|yDKvRU7 ?> UPAGWf>Nc [#PCH|Sѕ˧<wB 2>^cooM6`<ᶏ=gnlɾ߽/5iy< V_KE(Ϟpw(n) Lzɸ4qq $_`xp[URC("j5Ye$Vh%}Jd-@Y>hJ^ޝZ:;9SrPR0Ks1q*{y5}yj6[,2r f/ ie (׵t '_gmFݱ9 B!oS.rĘU[ o檔Gb6Z S>]i_JҦTz2~i {Z=ULESӻ3sugqB]*8f#=c$8c尧ڗP2UcV~rSP*+8J,%{uRA`-T1~ٝuc Q^ff,i{X1s&Y/&oMO>Wk7dsҹc9nP^ {.a8`covP endstream endobj 245 0 obj << /Length1 1438 /Length2 6136 /Length3 0 /Length 7109 /Filter /FlateDecode >> stream xڍxT۶5E:k{]J!A:H{G^w H EE{ɷj{5NFؘ v'(j @0?(DfE l&w$EwƔ@(6b@ @. PyB $`SDCP:?8\A 1yW; A('+""P)8:Pn^^^ W$?QE9 H'2@ C `Ee0D8@A8Z]7/gx /t%`;0@WEA0$Aa ;ףּ*~H; GBa8 J>fe"G! ~O GOs]/+( {7c8D]"7AD"c$𫀑7p8i@ = ~i@P`vG(05Po%-?A_OVh#0n>2*( ~|B> Q @PPP &&gz GFu  M28 th=C#~?e_;R~9r W(Z(lh#oWS_ zUBψ<s>P bE@׀A=AGeC} -m'u`A>hW"?ACK G!4Wc;/7BBh+Q:A `0aWut^|pW׺DPU+[>~:7x%]5gf]C?"'w0R7| T茥a5Û ";Zњ C4I-H v ŊD,[3EICM:wtmh@Il} ך[Vkq1yT+ +æb6t/ԞA_ka.5= 񹂨mtaBOKyc>/*3vΑc!tpYW^nR;2neQT<dž+!?a&Р [[UBNba%DЈlHk #S綹d| )1aËjѷϤCZăO'o)'och~, oYmd[ázmKV0>[)PahCQQC/[MGf QԞ o,3_Muqmy5}>Qb +U5'+~6iuuh>J(hy)`3zI{c%9 BFv6aIqr"dSɡ`&DUg5ᛪEzz!_%VIwO=tE#zmY>S nÍ2ZvJVd0LOXFhFNM[B-͏@{.GO⛩AriAV[ wԍLOGZdN/UNJk&x"aDWVҒ^N0zOYD(Ľ\K,={%:РUk&;hYft<ؗ3/ob@5c*$sC~%mg~_?ðҺĽQj5R K&+?G 2=e{RRsG nUu?bڜM=epiPD@C<#gÛ?D5KBNgےWҳƬlZ̦(WVu_ zOd71SopC҆v{N,lتŦ[(BpE#^rg, k#qyÞZ\'< 2`C$EX'YX8-SC{G42M+(6y8v*adgg;~dJNnee+|{5rPUT`9!V0tB6?U,m*ηegy 1NPL'RѤQ6e;o$ Xzn_']^v*iH\`p!!jRKqU8NJYUȱUUea |(bޮO-1f&pW{O=t|m̈́o0l'=t ]Gk-i'^/ƁGϚ&w1crJ޵k??k8g~l60QRsFm-\\Lb/ތ3<4EǴՁm>UΥ k6R ;kXF851fvʚB< %O&#'Mw/j.P XjE=O-U}C|&ByW<[um&'10M:ӻ+6UY8*FiJ9{G oh^oV8P9[Zd5~TÛ5VԶ](XwM%Q7r\!\/RPPڍyJMK <7w dXXg" !'=)cd:9cq[GWٷ$|q:>E) ' dF!2$b'f՟"k4/( o] ͽmdIc|nG7 :UB"d!b9_f k2IwTFE(ܵL~z/-M^3末F$Q~==tpٺ>Nc vDgiVHT='Rg]X@a-'UƲRuI!j^;0Sb6o[\|KnaWw\ƌkdDnFEleDQm*O lC\"P*nIy&J? &E^*Z$ٰOExmH.nV,{9uԞ.[QO59:_b,ŗC)Yʭj/1 4w zXOe@++ iptެ}` 0K*iJ#u̓)14l] 'L)vtEޚlQqN jjEhY̏;7"b܃Q2>ҵvXOPt0櫁Ҵ[/ 鵂1B RP( U_)MKgSqR-\,; Rzv_Q| ۣ!"j_Az#4+z]~x !;.2Yh&+iyu ` ~1W1i?Ϩ VQZqT-kBdF,]BSO  DڞV9Qe"AոՀ>[{ IQkoXvSOf"t:#dSbTq#<$^"I,͞RGYXg?>Vo4ֵ-O i~||.~kw"eD,+6DzeV$@~ߖs \/QT8jS[R햏灟mkЧ&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 1411 /Length2 5998 /Length3 0 /Length 6961 /Filter /FlateDecode >> stream xڍuP[-A@%Bґ.А%$ޫHQR Ht)"IQ{g$^Okp )v;hNH[J`1, 2A\.3DdW*15(F=\"b@IY)Y0( ՠH8PFX*tpEdd]$ AqWDh!8wd@PW,qPz!q@#DB]\@G$nyA1 pA(,G`@c-]'YO D_P E Q@{ G (D zB.P;|Cw PnA_0A h'@#??,a<~;@DGp@;;FY/Bx>y F~ Zia '$ HHED%RR2M7jE9?Ph_2|OkG` 0 %m%7o莇0"]|JKo#XYGzwT C倗8,Gb p$GH_~ 0@c8*0bxo,~xS{: r$@}`D*o0Kx@{4Z@aW$ K0HyB5 [m{LOarN/ÛY'%&ɲ+Z=Qrƨ}xtȑ ͣAo붜4'8Em6-8aH*=fzMb#v슕w+[ rnw8K6/wT 4H9a2P)gnv7+]l'_Rq„yq{zT)(>4x795+;8Je_JȎq]OJYEhd0̧fiL/nu`"#o]:,JW>+~aHþq'}`9X?@al.],vPT֖ܽ" N'72nU˗*qpcQ@T oSW`|+o_', h<{O'B2n`j ve(^Ҝ8/vG $X7tŒ:&v)Ko {tWs=֚5ȯEw}ălu"}"w6YjlQPF<"<0-;Yw5vY*gf{;%^;6znS+1@{JV056O@v)Mm(L ڗ\%f#X _m~p%[l0H\(.%@j(RrD"Lo84x6M"FU,O!נ.R>`Κo!rc>j~4@G˒PA8`:u;f27MEN}CN1V38&7|=dϬ2T;XT?[%ANZh'i$~@ʃGYKeRkP?8blPOr=bz aJ3 [i4XDZk%J&I/K vz n [@gqX;Y`Mc+z= b !Ju<1a$էX'&{lQ> 6*SyO9Zfk x^ O$lK|= Bd,91d?ؚJAamHOcPΕL3o7h%HPvP6hsIDP˔uu{w.~*w\r('fZww]E HC3s4C j}vEqZe bn൏U,ѭͫ #qsZݏUugh6sℰ~3{hB]y$y3ڞ'ψ#u1N#%O\kY&a4esZ=\~7h[3,0},-eӚdR#[tXIL0O[`5 NByIYxWJ!YhȍӥBf*tk܈AxjvE+nV;Ac*}sy 4HYcw1q|dAkekmė/mG=G^,=n&~sځd)H'4S}3;j ^Fg!=VQ7t_; 3|GO%Krj/vh < <²SvI $Km㽸jM⥴"4Mnhٺ~@dˬ𵰁o62~1%6Hڗ<IUx}*A,\Ni0.zmfB+RO@oRn| 9Pw^ފ2$N 1"G3꺓u'O^7[*i[|F"osſjkߺ;7f񌘉 }sC f_ eI~ϻH ip[ԥFM</n=af鮮MBR;zDEAk7t9Dct2)gZt!TthvtpqNU T=%jCTJϔ3aR&b0M ﭸ <86w81!Mr! Lu,o"6&c a~4gFEl{nB7H>J[6IyKXgTZԧq.Lj^{5  o.:<Ǜ\auxEWf5 &N¹s*Ko+d- 桽έhmtn~VQƒ>t IMQl%(-b6$7ڢVTk-r` K;M3b ֬[8eί%ާ['US^Kd;M*PҀ{z=ʷݣK,rtLN?]eDY8˸Py[9/\#! #cn-Y]XfN~[Qba଴&A=dn8b:f<Ґ"OŷS7=@46a{RYdC~(@l Of.abl.Msͨ/_o>KݿytDml II0QKTpmYuϭ6}j̪?B^e|M+UL[Zth,8P;r(!H~$A|.jqBfʒ!tR: ͊:YͩOqˌC`?y+rUw{bmy˒\xLo-Y#yH Ѽtӿlx8cH| ]N9AU˛{bm9]/a.WiR1bQ0f0BW5= /یt>tM 5^b4p99-Edm3K;/Ǔ-H'jށ$)}9HN3lMM  $4cUS]n L~&kQ?O 6G3MT'>u6a@U(ԘE<޳NY۩lJF!~~[fz$o>Q>Eс%cR$bL=t2^qA"= 'z[yiTkL0oT>g):\~6]N;x7U.ls[S(b P[9{ZTu EekTd$/Ȗ~XmO+&.h>dm6n߾ J!6Zlܴ[WDJyU)̢W]iԾS,d^}FF eETIǣ#W_#Җ~r[,ּ9z8jj[5X6Y1>:PY 9Q mLvcµ&~N*Jc_-,ܑ*kN]~."?@A$o1eZCW'ӷuo=Ad+$T]'ߡhBЙ_Q!tOx^S0G2{-{q-hF4* 18jgICw.f:{Q\k\7yqM]kefJIdrBg|h*r >oM!>q!,<%׮*jQ~vEhCo=7WvwnK~pK .wjx0s5bbRy\FFh! egY '+m᛽WznX^"5*:qŝd?9zKw"J:&/6{ z~ qW9>EM; endstream endobj 249 0 obj << /Length1 1888 /Length2 12861 /Length3 0 /Length 14033 /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݋˵u{8,AaȪrrIm&BGftpqN5 4*vXY߾|\L݁Wg7ϿKH + hr@'hݿ36~?>e6a`;bVmm=9Eƿ[R\ a0sp8lOJUMAWOD9K0&N?=t =3(g ظ^?]Q_V$fg/=oyvs} %ۆ8_Sm_ _ێ9X93; _r4h r5kso9@@U Λѽ۳T6J9-XAnۜqps|vXYo.`g?.*/CV*XKV *EQޢ('UzLzn_X-oVMi/|[V[EX@·o+[e#9_V?m1j[nᛇAܞ·^ 3Mt 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- ҥ"A`FCZJaK:CAS$%.Do{׬><ihsHY pKQx9xu(;ȿv=F+sA R 4)- w<8^>[7jzSO f i8˯a{:fG\\?#3O?_;vn"jvB'C >3j zP`H~_$)uXh@Q?3Aa 8c\\C-z яAOO-~F nx\h}6Q #~<a HX !dqln ASK;o?O! TAAt9_ݕoȏi uۏXoǏFn}'m\@nto墇S^ѽ:q ZȡwCd(_-p __]UBr/fDw]hvnA4?23wB &@k_sC spsʀ/R]8VxŽpQ;;;j[ ?[{>ypkfC7ϷN9"؞?t0 +"~٥}A:&C,W(Bi.|1^EG^'ţ% 3 GXU븰MovN{G-S*7HC֞-u Nvw4ɽn\%Tzpr5Y) sv$jIf\Ng&ym7rz)n LT00E#ӏ!Ys"') Ddj!gVp>RM6u]̂{{T,m1 |⫣5 z9xQZ2xCf:2QWǮslRu<vu}Z1ҳI.Υ _ݫR >{Ib{^[2͋Tt~._'ӱٞɘ$("u4 %ܒU7#V![Q+=^/jT~%sGtȹp-u@,=Rv58"x`r()+ +B/Af0DsʧZ/O]v*>7)9 K(P-NkRd rQB9rb>^2w~Rάsi|X4 q]/+bFU@HQ 뫂QG}W6`eՍaVjovţCjDERb,scSi:f{34ȹ:MwQ{ e³.7e#w; )d)َXS {F̶AZ) THOxe5k 6Z_1u`\Kυwz$Sdf;` zB,gHa ph+Nc%U/m> #s?E XLYů~썮=hJLA~njH=#&r^SDM8;' +O m'5nS9 {@9.$꽰5 2oۂugJ:ne+m)ɋ/oSo`Z2syꕛ$^£z|;3YMV4PhFmӚ4}mf+靽Qt>GLxrI'%FP:&*ᙣ/vJgjьr5ġG̺7z%|f5 gc>)JʰW^*((0 7oPWwQSݹ(hĊW$˛%#ȠqpfdQY&HQ|(!a3R[ *쾍j>&̫rVGؙY;̦4Y$цPP4n# 5)8"]K֪We+>׳[̱ em̧qēL}8SS_unm^΅F)u|GIKί E)T%i״:0x_-a$ALNcTLI-=y."ʄ s+*~HߏÛ\?L;Np1<>=~t6v(d>=SCy:Oa7&NSMoV6 @ 'Y"Дn]fe8`l 9*.~=0/ğSRj~f졚Iv !_8y-8(LH.(2{*5n׷;#D(ba1mBzbizx_c)X֬x(BQ2@N@`" A]ޒCio!D:޺Ǐ6<:]7|Q|gJ2?CT3Po8r@YAئmvXLjLw ̼o K@hAAyZcBEW|u]P7Y{X2u'TA]'/tQK0<,bX"7Go4;(nvIs⊨ U'S$ϋS]/~q=-cQˌۜ8ILЪs];l?v[)T2i+yF>]B }d>K׈-9_"-K-\rI7bR]F{<52NqOĽJ'&5y5tBڗ|جW@C-fGwk67N@i@uS35؂5luݸE. _WtNJpxMu2h_ 5;|ki-:_M:G#zȻ+Z}{iM_?Y: 9; QB4 m)IP*/3J9D%J(4^D+CB=* 6Fh1ĮwK1.%]\{hYO/.1nQJ2?UWG@RfޠoJU&psvHɝ:}&c>kSu$ϊbnJEW2yJ͆ETxnEZ04(ꧾb$Urٰi}'iaOs+sܟ6)P- \2|_ii^J& DZZfܔ1hx3}SVwu9Ck_= \\g$Mtyƃ!YLOeQ'y9o/7@Wkgf~X{1}6쮬OS]Mc䖶C߃_gCi_pISv#qr ƥ2DלeOܻA- Yw~|_ߝ0SvcRNw^ 9xFFfIj*-z :DbtfycSQEMi}a2l!<xf-> 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.14)/Keywords() /CreationDate (D:20151013203327-04'00') /ModDate (D:20151013203327-04'00') /Trapped /False /PTEX.Fullbanner (This is pdfTeX, Version 3.1415926-2.5-1.40.14 (TeX Live 2013/Debian) kpathsea version 6.1.1) >> endobj 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 [<88374EED6D723DB8C89ECF187D7AB57A> <88374EED6D723DB8C89ECF187D7AB57A>] /Length 644 /Filter /FlateDecode >> stream x%NAGGD: tڄ;Хƭ;ܚ6&v~͗WwWSJoN)H͉I(@Oю5 `F L& "!-`+XB;He1Q0l;И-cveCL"{#Nn4!9[.U 46]T:+%L8xfEh\!fh.]/8v=yPE@L̊|k: n!pw=p 0)MCη V89`GjTO9Z q|*50τz9U~XI9(88pl=&>Y-'QIQXQDQ:ٝxR$NdpL{NeGGYqz\W!*%l!l!l!l!,HNKDWEEWigqpIihdv **'~-_H#7MH^;jkLUGuGՈ"ޮ;E|_o-Dh1r姣v}+`~~~~~~qR£+4Ѐy"| endstream endobj startxref 157039 %%EOF affy/inst/doc/customMethods.R0000644000175100017510000000445512607321332017231 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.Rnw0000644000175100017510000001356212607321332017575 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.7}Mwֽ:I>HM׋PAL mVm!\>ꊷ7*~}w gj%QFMhQȴS,=WmCEe5&\-ϛ8N|+w+Y BcRHK%+ZMִd{BhV0d ^1)69z<6#("^֝<'єUjhᘟ `ˇYI+3,֜idNT.sH{rw1VT]b)*+U\nᒎ_=>vQ@f +rU4-v^yvxls?%2|ȃcv!'q{.|上ͧ4h7ChL; =ŻVL9 G9Y9]C)pη*Ef+}>IW5IL[e$MWCY endstream endobj 61 0 obj << /Length1 2291 /Length2 16525 /Length3 0 /Length 17878 /Filter /FlateDecode >> stream xڌP\.wwww ӸK!%!e#5>㓹)IUELR WFV&>+ Ro1qgLNsXXXXl,,1tpH[r {<hh Df& =@?!h\]=<w@?k ;++` !.Z 7>{>}2x/sQIJKQ_s0s8Y<<nNF/p[bbﳱ ( p{CSAo%QhL> 'mVQ[y}\߷B}7@#_4vZYWY.R֞@skW3Tqp0پ'.[|_M) 2s0k8&&^, a}_Psߓ `f9,('Y/ѿY0KAf"n`̲YzϠq E<T{L?=?=zgd[q _{?u |/Ki'_ 2wpsGwY9{XˬKo^wvﵱw5?mzPZ[ C:_ _q/d^T˟j;x]o?ދ^4,h?{x"yTfnUr~__@' am?Ԧ>w(tZF5.Gښm;є~=I[uF؈$Վ'gY/g CD5D}_|l!{(xPT 1{ J{6 UlL/p#>W3j.R,2a\x.-`ͼ%#e/Uͥ_crG8Uwŧxy2m kj>@Iɕ!  >3$짘vDRDMmO+6SD7e;N5DރǼcXzm5+gx^Jdсs,7-V^cI]z- ұMQK9H=:;,)s{|Cʦ`< DzO8 9Dnwm)ٙmM*#FgY5C#N*4+Dkyѿ~{hؙrÑ#J^xzܠER] I.S7W9^| Аq땯TBp@`="bYa?ɩWˆ0,^uZ{gIXT5>?ʭk+^![1kV-o&,V+>0Kl?'Rñ,9!SGB>J[^`WC3梅 vtCI'A͚tm$^$=ب=%{!)GS mXK/@rVYre/Rn{?qLlл„~KJ,xBγW~Lchl{?k byIX9ߡ咸NX+ls>KˌѺd\/${_X5 'bPwp6 =A 5&/Ϊ,7L D66KxkI*l^a;E 5ڄ1 /DIiV 3Eҽ=%F׌m܉[X"(m10*э4%Q+'y1LݸA R[/n'J![jy&I{l01ָJ9P1O:&K2 ,8aҞ}~r.J틸:i}vŭ!־qO?cm_'*FKM5HC|^gpcą}M6˾ilKLS]n;ũʨG#YCT݅H'ZxY4Z1*Ҩ4ch6[qĴ p-AF:Y}p6 JG /pȸKHtgicLlJyZur͋P*CΉgm^( 4Z}SGi^.mxs*GS)#L-$ ƦIc?6=`1ϻn(G!wr!P g.jɊEkXBfjw]W'uAV3r# By ^tԲ |JiE &ja]jYMt0A=C昶Z#~Vo2J΃2U -\ߋwf H³B•O=MǕ5r;hZHZtH jW6EV8F0~NPh4r^98r .a&v>* F;QL j~ړ뙿(bv6>>SPcEJǗ!8PTQ44&%!*р8jΒjlXVzji9G, \aeAhD ?I(9|FF?IӪԹ)Qٱ`|Lܸ})%+n>(Ib$\&"-A f8HX1.n 0ZᔚvˆcO^|Y'a IaW,L|گw2ICB'КGp84;KO BBM=H%{ðkS!Ж{pNTˎkSF/+saܹާ)q!i^ʀ~9+Z|ջu¢CG2R !I>pUl!Xm ~=xEe+#..  lZ;L=A[WA̤(P3MltA:, xW~D:@}A}wgMЄ`dc@Moρl7)Tp3:PZG[Q4*F28Q(z#j**,HqVo%$D^po,$񍴑 nzF5 *EmSS߆0*ij.mAKrL^~h&|-.aс(GʞVGTOxC*= s SeI־LG.Cb;˙Ml_оoLš9]m$|$`E %iN^6wpqDwyq-9~4 j|[ϕ [wESʻYMNL,&! Hf,3ԛ&6jf-_n2r6DJl8r MGpf `isZG3 ֤U<BfeқҶ4:C)?ra$ø@FsTD8)Z(U&4X}j»<+H$5d绕Mɜ\ST&$}[ \A̭#}t $-Gzحu,9Sl(/$s~oQ3Kst8BL)bO?y&Z~Er/vHx8U\֊B=VO7@1{(}}K=¬&C~BÃ2pGf%F?NbQ YM|b'O Q9IԱ}<7X-.,yǤ' }m6|UFߦID<'_Mi<4L)büxa)L;z*"k u>;2-Q'|u4eQfJfcBod㞖^vQ(W?6Q@Z;G5݁"ȇT`$`91|3"Xk}F+D0|B!Nn帕Ӱ),4~?q4a4ӲCUꂍ# c|^#=α3&p~ $*eMno Qk'w'pMWŮ+e ƺЙYފZl`##j8|6D, ͷvldkN VUl؋܂c.rDff%g(Ló(P*eNvMILxE RmE`v5so̟4~Q?Xz]#aݠopj]F"_ɁQm+FQBOfCN^q;/R((kcCR(wW٥Ŕy;PD0`΢SvChl9/lįY$h~ #Q-4J`mf}.X<ۡQFX;Թ3FhEBWakv-rb kes!iA|Wy~\ga+4}cŢy1N&ʓN{QvO )vN}[c s*> X_*h:`, 2$Qx$-8ޘ7ha}v#*̕Fl#6eSV!DWV~o[mh{I1Rհ `$vP!3Cmf5xYUJkn 4|X2TV?Oof=dcc~-K62׻nA Bb|ø[<~Zh%Ԝig[RKoCR::&$.E!hN"#'bj+/X<-&8v1L_LnmS>y4001yidIX!Z2My2ѻ:'Sc.10} N|@3o:Ȉva/veCd aۄl[6,![jsQ'-mD=#LTj HQ ܗWH!F!'y6wEBv%oΙP t%Hc|I0.䏄8?1qw}u, HJ"5:;]^,PE,K8ڝDC`/ߢJW]n3A2z(. Y(r>#S5x#vv3漣7l"lY ]x3 EPR8 )˕+gva``"$d#5RV< z8 3 i ?hʔJc D|_Ă.1$49@T0jȶG(n l5vTS|tkw҃?Mڗ.ҽfNl_N4_ ?cm&yRJiװV~ _z: VgJa|o|EFM]x 8gWiʠ(izב1ϥUT@kmI &R;cKЌ6ME|C? ٬4P%WPEqwƉ,'?,YE5Kb֑\v^-0,q%bOQG7(ӢY8-o_n}T PChA+5]Ewcw9mcn+?fSGcgߢ4F[;$TkVuLh;զ=e w 7BƳG~czۋ`V40}%DSթrSъES@)01з(a=#~ zU>oQ3R{΁<M|8_:ëo4hx~vsFrT] ˖P7d_fx؎K(OGyBYw@}T%|ωid53zXQ'C}qAG.lV3Ĺèڱz,٨+Xfg{|:fIN"/6ҍw58rrQh{eyzs=3%m|lS6D'kce|Pi?`:h` nBY9OY q[e8[Uڃ:;<`7UѺ^$Hj4KUв$EnCP&\Pk }khvlS<c|G1 .)I( cPq/{+vjmn2jnQ*Vf,r ,Ů<ko9XNcoD-Qߝ\8Ad\0YBm6v](AɵA8T]#[=nHY*!Ȯ9j7x";|bz?7w„>[88ꇒ`"`\t-DsnJJY҈7J2f^sk tEV7/jR=2 Sḓ}O.CiP1^lDDlR[t6o J|#+*Z""ւAGZ3xӒ}‘H'61 öѲv}\!oXx;u梡V0~xؼ"QZ*74s::>ݾͨlux]vic]x8*kN~ŕ#2\ìXZp=nc,^hKN/pcuQ\5K%f8A2hh\5Feښߌ*y/+K˴S;kĂ`E֥RW_F3zTT" `Q&z_ѐXh;7ц!41 $17K~bds,oz'S#ry'iǏF"SwcF2ܿez>'ZWP7 vK*p96Ig-JMDEaޝ.Ň*<X~4by3-^A7@zE@z VGF|Srev͕隣9"+\Qb*~lٹ)^uu/IS'_u"K*O8|[z r=G~dW3?߿s<3m'xʳcGWtd0Min)Qw1Ec΁Z[ LQ $.$7bijpN.P0Ð?Ȝݮ25BS!yӲ έVWUZzVfEYH0gulc'#^i4V̧y"ZO"-8uX+^*>y3P|ťCn& )=Fvm7nmu)'oi7-V #F/Bwc#M%,?bc0)֓: t{(y?LH@4%էC38p#Unpzd'(؍rWK?s\B 7Ktcی"n"noԋh!%Kxmѩj [9t`wֽ^ +Ȗʼn4~\ƁWBNP 2w]>+o2\ݝ 泑,$ B'gkz&X'.FKǐ7jAL .ى581^1ƦǝCNyuEfiFMM8Vlmka5[iAbmro1|q sR|7kŀ 楻)7AfvpG뭢)+| +ɳXi|tXty=jC%jz23I73۱[VNivSj P،t4]P*COŜmDֽ'5 嚷i]V2M O2/a @S>rSxB @_!hf(c3`)v/UvY5(7BJ#߅_#C(4|1<bz5tz7s!^)_ᅴc%.XFͻdQĔ6t[-3Gm iJg`xA!oC|hgOx}{e2N#k7DCAyFvG kRCBAnUA{FgCEEq23afO$` 3C I(`_h T^t.aI:/?yH- fz1yÍk~lЍ$duަryECjDZDq0EW01J/ݲHS5fcWR6U3nv"`[E,Kd#mjϨBm".{v&rXpcJ#T{%ZT/=4?j4x> up2o_@C*@.M*EE(C)wcXTLK :[NɴUMEM%.2E_ӱKTR#+٧P,гwǎ>=rఱ}:G[\b@y< xi*cgO)70?dzƂB=WVs~n,2B/^x8m1ŋe 0Rh8L]EX@>x{>ǝ<`%eqz)v-7WGόE$xq&̑mɮ+"^N rd*lPEGb"1#5ՄW+-c8^ԮJ!2"H.Bwy'lHfG*>>w+LҠA:26]汹QjI1l/!ȏ76ESz,-Ub팂Tf~ ~`# "T<d}}-bJpB=~O,%iLf7ReKwxԸ{ T;Up]qGlytڇq@Ik/|3˱ 6'0*ε Kˑ2+ (= U.^D{t>͐ ] /vRI1j#<]l!ˎt<@ڑ\zn { {4:3&'4MSkw)[LͽNS%2i|K BCQU y[+8.}(h%J+H_LBB;Ì/ ؐoXVyC\a]sT|rsKq U1А\q>'__n7GDi;`Ј5DlOh$ *pٸUн4Tߣݒͱjb[ic*Mq(" 8mgo)O0g5dΏVo>|s~Mn6.FO=mOe,bwh^Qna1:iZ_|%Gj'ͯAKIhU;HewHbl-`fx*:;f+6$/s lsGMbDGpxKEދWv! d=âӣ,\X3hּZWQmkCSɏUZ˭W_2&_?jgb2`p,lxu%-Rj8E—M^<1s)s&EA6`36tWK#Qbцon^)Xi 5MMPaK:T^3]rن`\TL`q8Pl fsuOGgG0 el=xe.}XOFE+ ąP׺mIx<=%KvY^4(ku?JFbt{xe+Ʊ8@6UCRFԉQوpyz]N` +?- b/l'ޟ%s=8Ł蟈Ð+.2': oo%C~Æv=-_^ȱȍDn|s{m,x_odj$aT7x_Hel[ƨ| k`\>WQU KswJOi,gSv5*A`?Zsu$C͟iE Z>6 mNn>w.sQ61د$\R/[Пt10NV.q& pqZuy+:XN(A1SJet._h'<t̟Μ4 (+K<2@5DSԟr53t`&r }bzl[& 0Z+ؿat 7Lي/ z!Ŷdg--5OkZliMUuV,]vp}݇Ak y, #9x!Tc}4{kU)jƪLID q~^Hja-G^qeOl/pY,t7_;!tb})).V-q ;թt'--۫zl%A ŷu.9ӧVSO< BCђX&[[J:%>%=Qi*B/|۝-%$KFn8MC%4v-yVДݳio8֛=CqHjT MZB( k̕TӁ/Ua#ߝ>Ek+Ďs-zI)$5 z wITJ-}?y/Q] n600G"cFòs) (__W k03.)h9Ӆ\Br(Z)#9M˿@E=-yP9uj^cڿ. /n;~)<r9q4tmu.&gw. e)&\ާExoV,ZYMl/y }鱲p!ujAIc۾K?hh0Sװ[cܪ^jHףog3RI-̢P.WI}v½`p6c,81QW~[ojFぜ*AA5;SwL(pr)|VZYWT6H8섩&r$|B6"5+278iY>X~LbY7rpyos'gjmZ|xѢl 5S;?? (,<<iN]mA#}i+MjVD.:bM g2`1⽍;@ہǞ~Jי0[+=D,@e#>~U+p]>ę,_|”k㈂ZZ[kE*2(C$ !"D:N-#5|@vٱMoEX,~uU2}jK€.>ƶ[qΨ*x?>縘ve+t#롩'rdh}g!)t%]B9XC=`lR >؋4˕56^)fKt8)RV;g-ǐ];sD*~{[M%c2 S TW.OxQ2͕R0ޟԑ$mn=)=L*wE$8jHnr%zNkW΀=njzeLP^,u:;+⭼ 4N]y)]KdkZ ps"CEpVr@Q+ׁ e[&R/)jt(l|˒_]LΝɒ7`Qd{``. e؇ֻ~ `wqpqGլiōJW;% .\<[ߜ(SJUʩ>(M>Mz@½|URd*Lц&C^Q̀́Sp"WC:;4' P ~]t1Er;؝۳h endstream endobj 63 0 obj << /Length1 1756 /Length2 10593 /Length3 0 /Length 11702 /Filter /FlateDecode >> stream xڍP-Cpikphqww K %[pMpwydf{Utg)(IEMv.L,1UV. ; %:R W&n`ouXrXXxh 7vv@gJ1{O'[ИXyxH@vcK[GSc)_%h-]\xݙm,i K*4& P4Ɍ n rӮfonl@@; W;39@MF3X_w`eb_ٿ H665u0YA6@< w[1-$ETolrpqfr-Kؙ\~O4}vO?'kmgn0ٙ&aartʈfBftppp%?o |o$ s ++ d0Zf߆|`y+_o2'2Hȉopq|1诳SP' TAbYw@66iƶ Ͽޔ oaZ?7Yhr_vY} gILbj36 ;3[`dea۾Z'o|[n)agjo{8=X f}[P303ٻ~O=Y`F,fYoi08ߐX~d6d0o_^vſ[cAN3_J5WߥoNh/'ӿ[_݇۩lo-<5JSW.,ۜxO@)Ҽ)_U}׻Zwq]tZF%ښuh+4$އ_aےT} Tv''E Յ|}4!wR;r(b޹Ky4 T U٫y/T1Q#F/t$g ƅuf#oD6#{[j:s7..5TYOhL#lϲ9G4}Vr=G7QT_3/ɯbp{Z:R=m*љL!to|\eJ3A&ȣ,k_b9a!jV2z-tYJ D:q7+H-APD]K46ڎ6.f^R]aqBLAb|gaSW#=N:,Dǣ0'saPhiI}, \.sv=8 Au㶇bҬJu-',#M|c}õ7XIaVI6OQܭFwu@o̶ :BTmrTNloBW;.RCg\Ϥ2~4<*2.<4+͉z#p"t_ߜVQ쭡D"ۚ2HB'UY|?rel}it\OojlIaB|'Qr NY^1 ECʴ*yoȦ C%O3@>Tq"Zg"ribjW9DXd齊P蓙Em->vZTد 7 B}nگIzU-瞴GMh8tHB:-('~DE^lT{c>:vJ x"*o|ݡf CXnc侽 u&h`{׍ |5ܞQ m2&6mᾉDg[y`kWr<\|A+8i/L=hEs0AKyZ ,fs™dtJq,deI-A=9*ayp6m7:B9e#K OXxn52iFX4!FM6Rr( `*\hTK09+/'[2MGydڡDf o?0%Za( Qfc6tC9z3!zaOEqRwMG[5#eZAUm:8ˉ}lx37߹Ŗ"8|!'k {4%=G/5Y3įj|[lOQ:% 9MfZ0g@wx<㮝Tsn=F_|#4<su3$H`\Lo<qabj um=[W: t$ a"[lB5u=ŶّٺqH@c^G'bV)`L}Ճr]6#&eC)F(LP!aWD.uas(3ׁQGʭLó5Rb6E\*_lX4ß"GqhOHWU/GĿrW=~@`iC77*!}4EȚe/ȯU7?#X%06<#:eyoyT}uG:.ۦgCljOli׽Aʣ3l5#Y(-@=X"ȧ}kufE ~|[(qt49 Zm$.7j PyiԊL֒>B80Cc!̓BfŬʑ xg&>+Iui5<9@%&Yf&r,7gzx(ȣG7 VLYm#s#۬x+P-9'ٚ%vX+Oj܃?mZÄٕZ . hQ] *"?7&'$;c;Z+V^Z>'Yn yAvz:vsOFl_hĹrtO"sotA~5*N]ۻ]eW=j2O@}3"Q9Asv*={Q)v-]O@7\h6 kK_lks`Y_+({/N W٨fR !Y;{|: |+^ ;P=ys È[0A%9xA[a)i)xTKewvN:S3,#mVmz0b‹n2HTX~s#W(y@]x¨OO* skaX4S~9DטXMI'Gɏ$ׂ{Yk)w$ra/a㉕a#! N+QJؓ:`{lepn,V?L!6 3@pڗ쯭:_BH5S$c{NX L1W˕V-R\ UԊVuCZ:@T(e71bj{:KhI}OARl4Eef@ 5R{(5n6Sm7ݹ~LT[D4d!1 StK]fg# qk!"7-F6Qڢ$2+zW- w8iY"T@:$0@+Yǘ;PڜG=W;Okӻ <@'5X5ouc5#qwD>z$G덋USI"; ) #8xZ3d`J#p74$ CBѸ8[ 끲pv^j$嗌WT!¿+~!fBw2u)z tX9TM?w |y,8ϭKHbX!;ڻQ3nhҏcw)tBD.x|3E 5Y{n=Xmd Sуc?5sp#S4>wI>aLrNWMu0*+*+W;N k,ܷ,~`+Sv"9[m4}c4Ew۠ nOOey[)vʃ+]h\6Arj)Ō _y},)6=z52HIQ~0\)x?~vI=C+-C׾4<6pJGBDhiW޶o)͆@{xhI<Ë)⪫śp/ANTгbjוW‚]WEFuG&"!lWaR1)b JO~IGy CExGr}""%+["zTdޡO4_Ϳ/UE_ * 0!oyTuS"a`~ؔCAZ2j7phۏ?{TR,\풊?|Oo.%bJGd48B/9EXaI UpE;˔F1țF:͌syAe9R!sVWߵW=SCXxSׅ9E)̿XQѱiTYZ3U`RſlhuU2)K8 2[-p]qX0;YX_|Wm.Ǫ(=x \>9})U*&P@)kRl N8}Y#nK̘\19A .liںFݍTSwzy%Ƒn)n2ɗkO5GX@1J> 8DZH_ {ES D]en3La,%Ԣ4oiWD)C\4 An!6-͸[% qF}_̂x4x8'/*y&UND~GP~җ&eoq lbf: n'kWWU 2{&<hZpP϶h]ZM^jEsc-yB$k*ϋZ*=Gntlvexsmn\a ԉ0;dgY>{9פM dqV=%m~\{ϝZ.yjbHβ >je<7C Asy],ŵ_? /eJUr&駱"Mq4ng1smdL~:oOu1|5Te?2˷;&~Q> *̻?wo@s@1@p~Xz󬤸>-Vl$gTJ_8CM?uOct÷&壟H 6+?+g75B<ϱ}Y2Qd1o놏4G̷Ϗba˔ C޷6L/MW65(VxMuG96,3I [ku$FxgM% 8F`6@]# -cɴ\/F sThW'SH LZ}M3]["Vg &lq,wgxhDK^!,d/^M!m)LjYe+Q#U ~T<":e;8*ZyaMjӗ9Hc_Bh.,?)1b 1I# 4\ލ)絆(PwZ=XN(7\!C64$ږɼshtޘ4{W{'i&L؍=GL2߆{c7UR ^ GLq ~|鮻a`}k67NekQ_jB+޹.f$ͱ3,dQZ4O󒟪i߅+ M ۼ;2F`M/4_YjAgzէf*80 cbM@qwK <6<_r@@ i H|EgM f7G) >;-sGg@6a*rB޻#rZ4$ װh;) þ2DCU$ 6yH᠏,Zm GvQ?j|:?v}TD@*Ȝmҧ HrL- rvRdQlw.bNj0ʞ^>+6Fw:S9`]ޓYnO`pj{J-8}ܲt/Ԝ xͤ?VϪ{_x\G!gb^%.pFpQ5EX ,OThbISbiy mCiՌȏRZ>Q_:w<[nPrVS?!NԊ/LBb'uc'@k=bt=K͙lgIu_@ڵnNc0ώBIkɿcsQx1D+W& #D/]ZR@)r{lڳ #P &<(|VEbyR0B=ǬC _coV;4p3Y4O` _-qd`ʌw`K(IpHͨ}}pou(Q%'J%O-`2\ÂR<',W6;JOlR^(3aėE0]C8> )(]Rz endstream endobj 65 0 obj << /Length1 2371 /Length2 14586 /Length3 0 /Length 15990 /Filter /FlateDecode >> stream xڍu\ JwK#0A:{0;$%;.);NNNAhc. _N}3"Cs8l4?7' tXm~[V`z8C7蜁 N>n4˿I˖xظ9l<<~.?  [7Uh0d|?aUt[`i } _VlIo $>;tIT Uqzv[ p\w tY$&M Ru{x[':`oSA7zdܠM.zuDn>~ 5n>>teA`￧q h!2C_$ P r84#o/EP=nEn-E\Pk@K2Lڿ\#//(@ӲA}[B7D޿(M!4?4 \b&T'OXm~G  (mZ1Cvk#I⯛aG#)o6Ԥ31?; ]8g8@~Z3g1@+q,p QF.hUL7&Hn@7?]Uw/lZV? ^5T-P|` z3~Z`KyH]]xm$8O/gJ^XmvUbR2k,Q*#xx7 d^BRx/"IO_ c0N^p&#N9?*i@'&=BD~kࢆDFQ_v0$D+C0p ]hd禩;ECxs}R|Ao^ם[ w}eө$0k͢2|R a{ 'HFntZ!VKlb9\x#+F{o@p0lm>!쐸+ǟhj@j02辁6[{ fEGtW1W>OV936ceП!tP,wyoϑ?UMq@egs!U#(]!n,aua4ɾh1;~?ɽF-ˤ}&I,^k/m)-Hy5AWslZDuW`rMűsa23;NBGupTMt&@EQ>u] owY5/HNkoϺݴ*b?x>bԪ† ڿ4LU>!e"}pM(sEalBo$`Ra240[»1y?*}C+i$Vmꁚ̂F}j Lݟe K/Fwz֑KXu~l}sP*fy韾@}s-!JKuGMJa/F 9k;-.}Rlx)T͇R΍&U#ت[,W7Q/9cÅXO#(ՁgiKy(pntHV?5/~BC?_ojf#wsgqJةiPN­x:)pa27[Th5A<̨L-^*ЊHFbw7!\` YVAmWL[yrIDiva3]m=؛$#- etWt..(aׂA:N;ї uXukJǒUE9ޓ]4k,Uf)(w}yoT\L^ #mJd1˗-hpZS3 绿s˨$b|qS;=eF-(9FV2PBC\L,dIS{Jh]2+0@ 1CoD𑮐J] -6:%j[ e/SP@02k/qo$}F$]!|t~Z\@Vh*G33&qU2A܁e3|$2fgA(vO,CGj씡Fa_7]ݒL/L=C@?aE(¡ }dg O!Uь33w_a`z>r^L96}@.`ki&0+?x'Ey()*ln@a={ asgWh/i,FjQ-͘êD&i)G_?>jr3gLIw8XLh=5x0Ytpw$j9#M40]!mbIᚯ46Kd.9~LiG<ǟ+SkRy*Z[XV>$/њm2fDn%ETKϞ; LЁ/CY)^t3m/yeo752zw`'@_G#z%?9Ul)$p-11m%Iތw~fl[H؅Vd ; ȯ0\Kw3,J5CEʻ[XPy)scVppݔ;ao^зTqGO/hM-#Ǔi;_|y{ 5+ϐN1p.\L~.Dwfo5eh!?:dfϸj'/E<2g~YNWPZcI.#;:Yy#d"[LEoR2SuIͲ}`])xR qz bH-[dAko`^:0XOט~E?ZH i/L>&}.R>ȱ=MޓU9/rƼgA`=sDxo#LZ fܸoc%Iŧ.R>o8"x,´֭2}"Ԡ?Ndm|n{ KGfza!˪9w[\כagw ~:UJ=!@S3d#o>J)!'|CCf} Qnn~rO\v0TEOL . ND" @ة=Dne0 ^0INΝ/6:q .h,e;V(7Rw˵'zydKu(=-v+|b .Xx6|lsߌs_\;] 1ԶjLcQÁtkHl{'$cl@f-k}6D"pr*ZZX1RCbB d Qg{RD do}!Zô3t{/R* /a$|@]VyiC|b\w-K7埯#^"E m Ow Rt=BsDƂFj7Yv[AN0@,?WqӴ:&EmwOoz.MT7 |\,1~<再Qj/7jZʸ;lܠ͋b &^4$ĥ0#M&쫺}ī-00B [ҺjޱYp~y ST%&+OD Oҥ_84'/} Ɨ=IEnIn$Q6"&oڿ}|g&v:1mg*DC1/?iE%.c A~5l*=5DPj6Ɲ`L} "u_`4g1>YU!:̒?I5W-5 8IUIж ;ҲJ^3y' <=Lڰd-hcg.#1l(oΜx;.^$>7Cò\~6ɲ_duH*V扨ȟ 9\({7Ks!q"gj=b. .hT> =[D/ڡDGpϯ q+v"ybjk:UmUD^j);N^?"u>ݝ%8<&_O^[qKBYAv^̄o T.FIja\'JI`1aFYc 9hl,vRT ?IʾJ|!8/5mJ|{$4Z:Q('}5gzø~3|w'^CBjM'ytuSf!u5ݾk\åQD*W>"S zKM BObCf8ǎxCP|'AWl88N/L6݂9*-/w#%}@׌[_]b{᏾ +b $A|j}6M4\zq(^11V x2#6,߃ǷM~(>hVzeV!@iX{`\$^ <G8I#;:uo2ROPSU: P>hρ-es_a{cY/5`׫? Fr7h dz?NJ$RRS{lHwW+XyIa?O,gv:BCE h+NZz{''l:K݄WL;GK{@"+Ja@be,K{5z4\q7.n?/C>a{]>5FRj-qn|*]QҰOcsFN C s>ct([Dm5:۟ Gpٚϡ Qo] D9»᳧l쾾ވ!!'YY7jwIkCq+UN 5+~v;)Ll/#PKq#L,K)njw!yM ;|LnwEw;gO&, ;Nzva@&ƏEJ4%l;^sxXO)h}4/l7~ S7QJ` Θ8mmlyӦV]!#,C/[5FX`3R(˶, Ұ. ΍,~ٖ\on^jmLY ^Ƕ8" 9ղA|$^887!w.CjM7,U!fn6b}o)!g &}7iv\;, 8}ЛO-d憽x 7e dQHD/~vi}1zADs_&]Ҟ^#Eج ll 2@ttBTظC.nRX~}S=AU~j)qO>w '",`kt?8| ;5F]~-}$=³׹DcßqCsne{MtO |.C8`TO5ED&K]=tUzn&DIf;>Yb63jOl->#4^aYC7|prQupdza&[@L cypĮ˛UaqZ/{&(&5^հ(MO^ƺ!P"p)|9O1Htݪ+&KUgʩ]Lj;F_0yCpj[ijRZ/gj/&r򩪣,ΛdqA-wv">m̘y6חMy\P765 L(FJQ$ VC#)Ù-hg[^OއH~L|f$gTcV~%3oB(䀱:EX ƎR\} ڽ ̖ 5!XX)6`uѸg?^Yn,TWgh8w_w Ϧ><`|ee&(,y&2nAǖxyu^Vo.*?kK⣺>ᡗA!;FKKΦs[ޔ$yIꔪXI GڵbZ<漆b\$pU4lgܴP'8UpRi.~fU+@CCI#QgRJ#:ߍ+l?4)zx즺NƏ/`/Qm0o)+qV S>ԚJXk-#\P>L7~z7QFʇY.ϧ|vnE9t_R8e^Ih$ISNŇspw\G9&R^A ŒC/IC%ƑRwu'YCވԫGa s1qīj8Cqw5~VhHkKeig3,T{ZRAGtaw[JzKțk}r=nN=[>J`aRl!b s8C#HS&^*DOune<ύC">i.r2P\[7H5~+buk1 9rAP])A֠V}/739)O4Vק^,K;14ZJPL t|\ Kݻ% M((' "T;![x c 7L,; ^S,K"E~?С7Zxv (e<\LK֣(5!@$F{ê X% {uƱ-Lؑ-9:gA'GɯL7-ot6HKƃW /pIDmF``sB|nM JJۅK2Wb@[\3?A1=080j-D_N_&w/t_%UˮZq#<~y/^$t\՟G~׬2.HB4|SKZ+jyPv~zm(fe̛LЙb&Г7%fRxչ)jr<]|zS--t^ KX&c}fWb=VBUZd A,DƕiB1oǕmtu=.rN[YJvqyT,J1& J@?@gf3dp[ 7;4\tA}Wa#:IH( $AyxL0D=+tN?s7DR>Mkx)/{}J&5%Bi^P!蛑J!~)>R V٠4IA-S6IdHN>%?=SےbCB7[u?[M6}ԡ eW l Ae:V_؄9cDkj(n[s>ݶ"#{*@!"&YUαBħ=h0~ƨ%QM(K-OPG-.'?MX`aCt'̯4E'j+;?.Kx0NiE/R~$~`i(Ѷv#ɽF%Ym.::"*]2;i+I۾j'5ESlE"YP?1 |h>MZx[t>S{՚"el{n ,݋{3mu9k 1'eUKߙ^,}Y1K"z ֆ;HW#bڣ>fh&T}grtxU(EܧUmmi$ʵI24P< qz~}`XMHL&)Egh#L_+v&EuFr?1^H?m2㇯ցX\eNƾ~^N iru&| Z i734!x2pTOp%h/ i4įv55̠G.HYs޽O8yOt{5Ǟp^AK,uYM sNxtBoVH^#?Ztw>JX/ jDfMwu5 tGqUْ.4OS1Ur%dkHvT,̆[DI&'eu{fZ P"mw $E`*/UG[x}Tt)&in#";@s}o)\`X3)P5bק+rI] >5bnc9;'2͍cU>>*64K{tזծLo).:cmFYά~uU'߃g"8́"e^UYm "kf*+-kZv2-BGl>@\1#و1R8* z'޸&9;v՛gBjd)Νܛ(n:jUeLwbFq۶7ѴnX\LkyXtkkػH _{m'\oTSM+~U]E4\FDˋ0-1XX^N6dқv?`ߩimVz.!K2T U弼I3C9¬;%_&iPs/P~2if{?fGP1h#Hٿq/—C즜5I"nhmv;2â" nr\$%sKf*n|X|?g\)93Aቪe!ũ4.AzCIh2p[l(w )\ͥ\(l{gnW+"^B|YBDJ97fO[Ir0  wo,jүЄqv?*N,baK@ǏS Aa[Ooec ;vV\?wEļ#D<ƅ?BM uۦg3Gq*_Am \+DJTE&dp|2Dr~ɰZөÛ!Ў76Ax*.ao H E.77!uti-cbZ1jLl\|qyQK#) i-e|Q-ET L)6Xz&RFGj56S7 T7  J;8odžmZ&G܋v;m]M;cVb_.#c,b (W≉ށuM%Yo))/5>qL)Ds9~>YO$h`zxji @Ъ f[|-@$2 Qvn i[m؀\TI惱)_u,CXSVEݏ=? "7QC\+TDȏ̫XTw}\I8R$D\-)32FeXWZ S* F~|e6> <)JՒkgLdO]q POB(x 6E?m8%TU x=@RV.Af~u].M: ލCۊL6B-fs_dIزT03]QTKy_>z;kF畳qWlM\$֜7ZzaᖼxQ؊#NJ}9=fxns,m,$}Xgm:]eU{A^VDG-#tg4/JYs4,vK.].842!!ň}A"MiXUؚ}? ~FJe#~//#|ՀU*Z)g-#GgCz!Y++=^lVke䚡aʘb)h WVv )̅#|ƽgn[}b@hⴻPY]_n@XKA"m4ScuS V bѿ3Dˁ=/QmI!%6uHIR$T kpTd5 \R©H: G+P-87  KqPa|HPK]0q2>Y]&\k~ZP}]c`ZKy Ah,v]y5^.;ŒӢ2Oۃ 5;2溂a_(sT> _ʷ2%idMy8,*z?I+}l{U2e'ɃMɘ_TuDEVhQ`&*0cfTPZ쯞DP=nUSԤj,Ω_c iů} ] ,YnSjiE'k:ڟL4PL|Zdh쎨pij-z4ɶ>Jߗ:΄p}"{{m"%#ћa Lv\)u+YNg3y?[S-%NtHXW2YVg x2-^!nl$B,T~ js+~ʑV5Ɂ Wϖsȗ&}&g쳊ע9DPDD]  [ hOzo`M1s=v}|>Pᖕ[MFC퍟ŷ4Iz)5JX0L0rđ1ş<BIR\eaO fsf^|gM3AfPV*gMrrы/MkVrG `W`;ctsM׶fj)aY"Մ/Dڤ/RTp(;Rld9'gPE 9uBJ{b˚O͛;?jgX /6DMA}@E)5I(fyӍ/G4Uhju?Sb=46[)'1|4x6G_ ;ei[RdrgÊkxf_p: =B;y T)AI=049pigl@{պsIm2Y!5#8"21YXMG'@ endstream endobj 67 0 obj << /Length1 1517 /Length2 7494 /Length3 0 /Length 8500 /Filter /FlateDecode >> stream xڍu4k۵N(ANѻ}u0e3zw-^{.ѣI99oZ3Ͼk_ϰ>x@Ap?/P /y@|V֧0/;>3K#B A @ lHJ P@@hTp(UFa C`8@v4t0(_%8Q( >>WWW^=d% pP$jE IáDB[ Gަ8-N:G܀?/rf*N# pw ` +PW ͇@`vۀG@Z-?!͝`($/f#߯2׬GC($)pmW_EفOst5m@ PL@u@̭~5xepXҀz,?H rrz{ofP+fvN07V~nf۹{|Ϟ髂@ #(@bt+$no/".*ϵ&VP7 oK;_UW~9{zvFvCBk@-` ;[꜇_(TA-PhaOHدm_3} oGݬU#,~qL@XP-Go% `E|_??V|[?8o|>?m)_l̝nn]P798\2Ȧ2Dʳ/ Dyq|Ee]+@^P07r2y@-PtSkG 5Jn4[$>F; 570[XQ~z$;I:,zf?: !FP#(L=hd ̂#cwOy`0jx5NZFr۟;KecHqzc o&}h8ory%yO:"hJbAP+r^G2Hk~jǝzW.1Oia%6U7\3:.%úsZNNSƝǸτ"f=GeLl8L2 kkxCdp*$^jh9Jpk ?bF $U_ RScj1K"gZh36}MzSGh #,&鴁Q0ۿ>㋆M g]{l5Ȯɞ&"fN4t.&kBRȠj`rgcf# agHk& ?ޟV32C_OYоm[P>1Y 1E^vMOm<] ?„CM!y\i/f˩5gRWԪ̈N[Ǽ-h,$Ezyҡ4yFՍGN$0w=ʶWbs\u>i:,<yA2Ϛ%͗1HA5*-eڻgRh7ݤ6]^_ӑD:$QKZ y-4Yiji3:ȕh қ/YFcޏ@oh0` ջ V!xTIpe)~O *Jygc{pD;S EU!tc॰nN Pc~Qr+Ȩ4Z2AdkjM؞ғtjԀJ8e9)Qz)nc;9O!ư3C])\:ȜTwPUb]l}N;q匴j{͇fN,ODŽpDygF @UkoG+ ⍘c~ #&(cXH^ I:eݹp`?'v!m,Ƃ dF 5iRO.ɫP Y|6B[5-}MY|/O'Do"yє' NQ4'Q9чWkXDGpgYZtW.^mr jg,XUi s(Q%2ة;vbϒQ3vI 'EdYՐC+}kqbq$ˇ 4Ī œӒo^B#;K;lU1 8:4`u"2yaABXC[s.hܱ#\&e=,*dry{%[m5) ͥlJA N@ڞpeA/6! +6FLOtPy9F |P.#JĻίQ͑-JG Q2IBoMGMkbg)X7aXFNc&_χP:&հœ2vX "A3 ywΗmΤ `.#n[4-QiЁ^D~TR*ܸv:~VXocϬ L!.&I4{0I8A|()4iEF&\SeE7V8Ls=YIk,:ZGt4Idjv2#ֽ fwj_qUfcQ~*Bu>F#b yto )nb7,:="IAE5oNer'C͏]XDƦ\IPXAv[v\Ѐ;7#*]hW?_;ģyi^s&}:r#ܶ؋*+x<;tuUo}8.M=>rvuޗ9K|DK %: r1vwduO2&?怤"+eKsX6h~Ch˲c]#2O y&7ˁ# t cq}JQHe-CRM'xz?+hr}}LȄJDFza~B^4_z&% rj=dm*/=Y7Bgyp<5(S$QDU\]h6 K9qԙ?z=׍.EYLQ6 f*ʛ 2R+a$Fm7uyr^HYeo'þO ίwUW(eG]iux|=;܁-]d.ԙQnK$e QӬN&+ҸECJ&>FXWC*37rQx{-]ڗC$Xa46yl3{ |XP,#%.0@KTpY鑞D-#Qk> Nj+CcJzß`1\,{VMϧ(G`SK&g8/ FfR򽩆Θ%! Oә%aj]ǯɸ,zkXMT/zFR7l^OGz SYޚyƳbp]>mrXGnP6wHxG*˨'Pgnhy[.mZ)ښ>%e]J_xJa6V@[bmЕ$$6ٹ{+ӌ-59#.LX_'uY}1Q2pbo}猟JFebǙ x9b'_ <T[ȱPC#%'Ad9cRR1.{[̘.w\S8eq^^"rXgD;G-_Tn(9/O$', uT? L45[>(VbmxűÐB5TNSԦs0CpIE+Ȑ"'GJ 7+c Z{/y1}3_&Z$4oNdEkal&L3# ͎J(<۰} *=z,-θƝ}a=z3*]FTS?)vǸ"ʂc &aEQ|0kM!wH=+f3"!"`FYlmBno%; h% _b~kĄc0*gdg&ADڴҕKfN?©©ϴfm^BHqT~!Ht f9!8θrN6y!^>>u݋Չί9_.\+Ɂ y t:"CC,mboyz[Q \BH~xʼc O䐇 S<̡ɻz"A^7nP NIYmz(r_ۥj7!9f}u&׵%yI D *÷Av9 Ԏ=·K  ROm| VH?ZΌwdN"ͯ#a U뗞YOPb[jB$ϗ鉍d-@xU:Ts­fvud$q,"-jniƧɷULSO,gG[jȠ7$:8O2 :Tv3t',ߕmehOO$%[oO'#"lwh{VBdTOUsbjޭiB :FA(ܛPMf +qZ#&ƍxp endstream endobj 69 0 obj << /Length1 1939 /Length2 6415 /Length3 0 /Length 7581 /Filter /FlateDecode >> stream xڍT Pa!f`fhiiD$E$iINIyFW]yk {}p ۡm*hN" P FH _; EQE(b0ަ(@QI$ @`I@ 扴 4 PD`8>~<DBBr@Aa(@sDw\C4'#& yyy \h ?9,㉰~Ht`_)8#G$!  G%(;kn?ZB~G"$bvu|(tUq8~sa0 t" 1H7Vt# QvhWW QrQh/߿dDa2F!=Jb&?6BB@xA?60qCtB~n=^i<_@;$"(?f? f0;4O+)۩ TH "V=Wm?Qh@ W篾54<wApi~+?%#"~?~+W=pFYap_:yDbU;=$c|v$ "7 ~7.~2 1zPQ|(~!6Dq%^?`PRQ$ $&8!(2CB7I8C=o?  ǿȿ__/BB|!(Ǎ?f7|RF=8_%@V_B-xx5!B?ū j|B|??`ߘ4qi/g _xCf:L繨(u-1"2q0}yٌ|svj$ͧ{Y}Zf !zA׎Z~KR5%ߊIVFE^:O(XP.aI:vKw5Ie *2zT_/iI*Ji|kUvmы7ڪ^e ԬV̩/z12X u|8/H9@VR7Vq7H (Qp(y'nR3kb6Q8|!s6wrH"?o>vP}Q5rnnu4==Cbk_g13 -[7ppO*J/ ]bP7EK:TxH9 i5GTQ?hI~8ѿh}k8j/'Bӿ/aº,x~VΥu"V-ÌGf ﯍&9[8QgZP(!ϙ^rj uܰkUf+µ<_]&D .}/>-\0<,pR ףڂSW^`v=Ȇ2%,<ssFcbv*=o|~R ByRs+W}]RO+:yP#Jr^OPcZr :x1df^#1`=>)ޞsJRKIyjBJbld앓:i}yh2X9Ur\a&/w+5M`Nê2D['رJ&#Ť-G͝$Wg"㺮1%-|h97ݝ)^O YՀkh+wIcćp> oBC#{|gf%tae7ݥ@sV̵Rށ=bTL{Hz58KgF|:r- w~ޘ$&&U9~߃yq&;mhզ!F^rY7hzU~1Bmۀ^'$z>nW /wu4&2(1xb2ן>e{Lvǥ"/F/Oz?kZs;CE3s6rR8+j~NQ-.oNf6֭o2"}ɇg4; R9]<7!M,HtnD̚諥~{3T|ts+լ*KTaJқ4QsַH$ ?YIZ2\<<1yކ1[<-{1BC'iNruppZ1#o.$%=P4>,/QbqXz-+25i([gM;x jq1Y\[>'QTP8uɠogmd y{t’sYP]uQ^gKP\#g (cte$}}ȝf LK* }.G ؋rM78hЭ֟V ܾٙNiZJeZ{w!]FW8+֔$|<pՈ{ﻓ[6E{N'[UDP ~L3X.v3 >1Ü_lZuzcZGWr '_XXվ6HdQdj&p#8l|@Kǐ:T@7?|.¯)fƜ>R4툋+|o#G:r=o{Ѯ[LvZQX G2du{&rHIlfhIptEp<]T׬A,[2@+#?Mc^mR#N4GkA&ga%vBGTy:{Dںե`N2Nq!LՐJp^a94^%FATё?}maX,"r$ڌiJQiΪRX2@!4C$L*SZXq}jKإHe Rt80¢/Z8u1j$!fr5qo7ɑN.87qn,G+C..҅OgqJ2"s_D"hߦT t6ۻ{+i3O"JjHnڱCCjJs4J6L۲=$LsGB];q;m(tXYže>}7 ju7|OOP|a(.mjwϗ+TAf&rnվA*wQD7 BZTn}cŇ>P D:jӕSkHd-p0wt0p3~ǼERk[l1%RIu7 RPu5E5UwS7 ,v9>Xv jGZcafEyfo dʲ%BռOWN`רJ٬K'^R^.91uqv qB.9؜rX< m"M%DVS¤Q-鈠K!P 5WX+^w+j4G,N!1-W@*L+혚FoM܂˄_c(N,}_ ӡDY$ȋvv:<>r$9K yUFN-JoąI阕{)T(4{" _Ã\j *?QDiGb= 7tw?O\En8ƜL YƅN1milNvVV?t=MkWRRMc| Hnl 0YE}ep%GI^β9h=789 {jB ٵOo-i O K޿^N_ I0+.beH]r͑Cَ<ûb#$̍TX拦'/ko~i*_ٟ#4wSܨXGg?ɂ'4Bi6yv%7x37(Ͻr[;oҺ4s{5a48Â*U S`1]{s T3tp/w~h6դzq3=yǷ;k,BX4mYk]ڎ\-LҴqrGYzY ߊ|4A"1{ϳ!0m 'Uy٥36mA)pl+n-7f L zk:=MȐ&ݦ[%]l٩ H@ruBT q={Q|S|\e6&`T;(yIeXOTB@G<[W#Z x|]̵ۤ`}[fKTև}#v_)/l#-㢍?ʶa5kr3Ds@8YR 6q%3aƝVŘϑҮIeb$ӫYv(nOJLW=39Ncx`)/򤧷ijS3O7}'Mk@y0t6N|u+Id{!$T*لsf$8J zu/@~}/H5:hғFsX7ә{e4'B%YEwh$-~wGPݗ$bj ʰYXh҂4okFAEWG)&zzMFX2F64K3徤Xf[{l$0߰:̘侸UE 6gzȝw:o,%_MZQ+. x.T{0It,\!&>3;J_wپ}ee>K%\pÚ- כo Vq@JTwœUۻߗ?{Q:oLabbeHu+-47ަMӾpu}Wm$ΈLaX:*UY rg]?cR%8b%j!!!7bI,e tuZ p|d0K#m{x0aT/>muhA 1ɿ(%A֗6s;bFs[G+WtɁ߯EX漫-ƶ:v' =&2̹'ZxS:hdž5+?PTiL~YJ{E In%lr^GzU7\%/aTиI-0jj|g<4z>D=u0!N'a];RZ+os8 B=p;E"Ck{@$mU Ɋ}nNg 75fA#DF XYBMv䂪 ^c"1:]V+Z2@ޝq+ RZ8/hR?Ve:. +lہpbd8cawh)0}̈94zU&wk XOC&[[E'-Z06-D,$_R(=3ŶQ[$xiAjoOu`wǣ:ɭVTT-gnf~C2)N-Ԁ"{Co3BpVO4L A^t/6=fȰL^-,giA]s`l@RI$.v#u_,gbJ3f^o<ҰCs|BqVzGZO]I+R%<.~ U;n^#O R-϶`ִ(V`z2NդtP&t(,+3Uŏ3FEBtэt9@ϓd,J7vlX׹0Y g7ojPfpݐ~~O'pSuNE)ao^нz|*r-f @H{?*$J&FbW7ֆjL$XR/m+(qyzXJ2~ug|?~uve80+GFQFSr6fE%Va,$y ׾3E ~Ԇ6C#<[xs<,ׅcQ_ERhF%:cMm;i禓x0n;EF߶ _uBnr~KU@G8Z\˱WO`^n0A7RY[O+Ҥwך0VoS}n&R@N5NX-࣏4LȟNF^Hu(֮`tJF8nَ> =7J^X 7L_niY$ rdQJ'm.xЫ N>Bc@Xk䔹@{?C%c\ endstream endobj 78 0 obj << /Author()/Title()/Subject()/Creator(LaTeX with hyperref package)/Producer(pdfTeX-1.40.14)/Keywords() /CreationDate (D:20151013203329-04'00') /ModDate (D:20151013203329-04'00') /Trapped /False /PTEX.Fullbanner (This is pdfTeX, Version 3.1415926-2.5-1.40.14 (TeX Live 2013/Debian) kpathsea version 6.1.1) >> endobj 2 0 obj << /Type /ObjStm /N 65 /First 488 /Length 2567 /Filter /FlateDecode >> stream xZmSۺ_ΙZJO m\mĴ8C ԁ(zY]VvKa*ei2 ) ń%1a Ǵ=1)YL9PYc<>cJ,$KM:)VN1ToI$[K @b$ ,1I#{{|221C4S,h-*!)3|+&͘hLP3tZ)k81,֦]|E(*| ʞT)O@l`!gx  \f$@z@ҡWxp^Q[Ԇ 0MX{ϟ3~d{6-ՠ%bGQ5)/nBJbULExXLOM){:#{Ǹ`]~YN9Q5ሰf/Kg-;% \&z`0L1mF%HI묷 <yo/=]N.I#wNկةLᐙI2V88iR@IYsB^>MRw"QMRmTIEK>~[l'0nóUm%ABM"$R'ʭA(ѻ]=pnĄX`:&7+T+nR b:qg)A?T؋pHM!'P'*?OoIfӉplp^R{UjMmJCJעN%8 # ($ D2+rTL?%ՏrJ&jȭ g/ab&wUy&EffgVW鼭y['$42B8:^Od e?@ew* vZF>u%x)$uIm"sܟpKp;JR@MqCSR̰)=.5G*Խ0j%z 7Xњh Sz[(hJ\MO iAݓ)WSi6֡> cP] :||K^ >>&E%FT{waƵW WvJ@EA݇¦3iDIWńtaYc`d#~tm,*]cI[|uw}o>??'X6r:?oh g\%;s8,>W6!m )l#/׃(tџGO1)6167;n TL#lm60mtqww@כ|ȋ0&&Wl+Ӟ\r=oѻ/·ѷ|:̧WyyON>;vvlPr4S#Ec,u<8ZJJ:Qv,yg^ e#s1\j;f+NֳhꄲՖq1OviE+Do!$0»gpv۴%ʹlxٝ#ZvE[ݒm/stddlx#v+ NjF%\[sOEnߔ^e;NPzL>7o\~|wTXX$^FdDD|AF?usR|c~A0qbj-u'7CMEd]TpYb"wG|q$ڙϭ,ˋ5-~8.F[1O-sT8 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 [ ] /Length 202 /Filter /FlateDecode >> stream x6aTNBYBĄ!c d"ko^'[~):U0$5L@ PIi46BpPyX- p\",2CJ*4ne1ۀMh`v`תTڷ1m}GuluhQGЃ> ޾)f endstream endobj startxref 90330 %%EOF affy/inst/doc/vim.R0000644000175100017510000000066112607321332015161 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.Rnw0000644000175100017510000000662612607321332015535 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.pdf0000644000175100017510000031141112607321332015527 0ustar00biocbuildbiocbuild%PDF-1.5 % 26 0 obj << /Length 1815 /Filter /FlateDecode >> stream xXKs6WpR3!7:cmN[]:IDJd: 9 ~-3-euJ-*3oja2WbR#< +]4ofvnV^4V/3]9Mn5{3镖XI 3>+-*%LXfkng;9xvAWZv[P4t'ЖSp/'(QR0(+^wMj|*8:C5+j 7s`Wnoi r^4X,:\A*La{4i &.KF~)P]פrqQI̹|m3F8]CIɜCכp @c ƈ!.yHL*b vbq};XV㺉Xf]pj` E02{fUD?RHDڦ[Dm>G\5fV騂ʿG1F>r/C:6@o :^(NTOq :BT|E6j('j1KaoiF r5i$C/y xUtU4tٟ;tH?BxK NXGz-m*a*h;/k*)"ђ»OB*+{.*4]1E'&Mq_ф{P1 cpRLJц(=|ऊZaBw-FcAQPp͇5aHEu/9O2s| Sb 10F"tqdN2';=\m\kpMOSw 3p u?l@20 f+mKCE\(#"ƕ[xȱ|o,&X*Vrr0X˜/ӗnv˰;cmS!5YFqX܆zh4%r $2l'*GIg’T%7ۘGg/ZURlOџR\#ߥ;IDDggΐaT+-o^ XpH⭂< ?~;/e,/@j~GuaբڣWW.\X|Kq]M_݈6`LKi&U"3 endstream endobj 42 0 obj << /Length 1817 /Filter /FlateDecode >> stream xYMo8W݋֬H]6@Eу ENur EJaizN^͟8sV*%&YI Sb19jl<2ɓ|k3sa"g*YԾ_Uuy׋Sف*fYMR]U+9wK@n'Ys,[TV%ә. fmU]̶[׈0{HfLL`ʲ"bfk|B(S3r\͌H9a#cUb2qd}hp ;'0ӒL8+NƵw8ےh 1<:ޑ'~`ΤR> Dž`ak-aQ(Ev0cnoS~E1#e2-J Y$cc65<0 8a&g85) N1dRDy۠]o$Mֱ4ܑD5wJ17e*̪'dƴv);fi,A ѹE\a* E䊥2qM_n(lx4 s댏3 H,0w!LJ+r3Q/^YpL[bDFѹ.au(vq-OΦܟBZ:D(lT(iUkuOea2!칫 ȯ)OMĺ`v?3%Eۼ 8fo>mN9|73$=~q1_d=G JaR!p_8ޑ.]SҿzJ5Jq6uܹkbNoSyob,o(GCدg!=\)BKo "d+'*-9*BCmȳl\71 ?Ү=/CMqG[|^EUÒ#zEۇot荾qt$ȓV>(׎wAzM 1];q{إmA0}~ma.}J`Qpvȭlc񜚡 3ΩB̂Cݺ;.2+YZ@pPш6U A25\=r?Ȋ K/ Z93io"78YҔ"Kj*L5r]ch41|)^ٸ*:-7w&eٹlwXfuY*&6YZee&>0AQ%UIݹ'8|fjCڦxx?m?WL^7f4t:,)]E:Z|e0vm!dx; JV|4r-1s'Î-. 9 [&9_'O`. endstream endobj 54 0 obj << /Length1 1890 /Length2 11542 /Length3 0 /Length 12706 /Filter /FlateDecode >> stream xڍP. Ew;]w$Xpw8w-Z bCKq˶{;Ig޵$jPs ] , `gbcgDՄځj] P,$Af2)3gCe@dgp cuHC,lV >`c nrX9\ fv _!@ ZqA. gw%3{Ph`_ 3,X\],A΀ y%#/c X7p{𧳙 ` ؁2Jl,3? \ff;3g?K7Ȉ=33ՅbGa,`) 9Qdw/߇kpYA,ar8y+xx ' ##O%g~>PG3  b:|~W7BXB,\ kʿџ ;C<`' :yku$ŕ0M?J ' ;:?jfc7 C`{mA< ÿonQɸg7ymKj s@6  ljBĿ A|ܿ =GQxb/E1-xuPV##@  >a/|VZPB~3ϼ^`ɞe;<Ӱ >Wg|.υZ&{}nM\Dϫ)sο\~97s~=~sm^$ 7g[]W: @YZԅv\׊xnn1,:wb %3dwOZޔfxDڀі$Q}jeaDxKRV;NAp Nnj8d=ʿm٩UD/fӊ5 *3JHJ̄}9{q93DȌ+GWJMN""}B2 ):yxb+2fNL3'݋##?L$17-lJ "έ+~0)@qyӵS5"@3"yb^^<QiwO8\ z}<^]ML: 08;՜!6B4=3V,nꅢ O*-BĖwn^Xwv ],7MͰTuQȯ5x?-a-6Z  )53+Lʧ'n>/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?]vAEڲtfXB]"%ʢ,㋯g|Ɉo2=uP}ѻZW=9ۿLvs:ˇH-?=p1g3,Z {ݜLDCK5"hZ$'l֥N-%(Zj{Swo[i$zSu*ѵ9MgSD0CZtHބծݳ۵YqΏK ޲5JxÃUբ%.оD2aB#V]i?Yaa; v;7e8hih;b{}Ǖ Z7+!1>tU"̨$'}Qr.eX)Al=޽-z[֢Mv.)KQK%ەlFF”Mx`Q@o^r8׷/#?c %G!z%),{SgݼиمVb>~ٯX8V %^t rѰb`~Xb+^(Pi%R6lo++֣7 ^u'&BpGe h'55w[2 KG FWG;*B0Ø2ԅ{n4Q _#U݅/6j|D"P//l6iogh@yB2,Pn!(p蜦EU^Lp2S>ycA?pCb`RWeЫl{+qժ! iCpezhOM(7~XoNֲB\qq-%c\_G勥,ouy..7lQC]XXT) g$xBlR_aGœBg!}:@/ݟIR:8\q% ܍Pb3^-L\? tQ6hȯ)irzqgk#̫ݝ:y?ny'Pjlqb`V%D-= M?g4½rAOIdT2 P66k {oOXMinH%U퇀Iu'tX[ܾ|lȨH%lw)]GѺ^)h*iq}dcl 81/PӎI''P$*qio"g)}'}F1Ey4)1V wULoHݬڂ F2=Rgq졧e@JmCFa_cbP"(z/rqon;8F:fDv\ѡ=%czOC86D->7I,lv7bH_XNmIz /ngLzF.#@Ǖ8?렇hIKEI:y~d 2d/ v8j-tJ~^w ێѾ'K>9 D-N-$-ojUgT^&Bl|3Ns Bh*?bš~>eT^^pz}Kz.oSrzF-UnV={|Co8alG#E [y^:pTU"47$;܎LP[};=*gL?6MU\ @2 XRԯ ±'_$g rߢݛUz}+' p`/eH}- o,or!LRc?p1&6k;~\?[%z$F)-HV25^G!/N{':MDC\Ƌ›1;R4,6, @]#8/ޛk9hr)(޴haŚiHk%~Z)B z:z;9%\3Q?߶N~jz߽tsåEHjDѸ0QqV.3+Q`,'CxqFs]䐸s}%۾>V ².X#/BLtОR~ isIy~[ON .>8ϤOҸ91H(\_aZ9ƮxVp/ß nJps~eeys#ݴ"!p 4a=O%v۫8kWsj΋EFM}t <~GoA?J.5 eZzaO0F5O ?h~D(k!FXMa&rwd׹E^yH"6Z;;4,~a\ c}>Ca_eaq`Sb A" /n7s=>[w7и>pf i>-w[J7|mT+a :O~M8Vn Kqj·20voR1"><5,_&d/bM2ׄ8!k{0gH[z܃79^ewL$g7!/yr>90 m@7'w";y4cPۡ_XW/i~ 06rGZ+~хC*bɑCbsTvJ7)̝;-j'=C+!FH}Q/t8}?〵Q,0 CpTn2>ʡVu璜*cĂrU2_tgeHVJPLC2$9:ጢwmB/L(_u㔳=HQz;FTDnfL;+O@qz5 _1YxƊ>ۂLQpL݊FMo鮮:H2qڮ;pjfs=aLuIFeuI_YQnk;ʉR>b[#+'OքN:dK$*fx}r|>lj;>G&|ؖӷIc":N> _5D^(FN{}g~rxx_婼aX!62fR(iMv(h[j[biah| Smg8%?-B=5˨JT_f#OO~6Ԥ( ̘3 "L~ld`2`@C^"rPQ9!lX)AmM!sǨT3 w^ /( +|BBAƞ+deC$xnlxsHfMsP ۲k {ⰽz)rvT"ni%ZY e},3ï ߔ?*A6LR=`_8M7xO.sS,c=NfL8ƋDњw˧^N`89=-V +4Aζ@!rTУ18Qv  47]0NmWm6CoQO?ȓ~wxHX9JitBE;v'Iļݻ4?YTԒ$jqRDdl„c 8%ٔAgC۫*ANZdژ~B!Sj3X) ܸy1uwٖ.hnlԴ$#֤ƋtUC{jJO0IіzYWH'2Q!m)!_.U'J>hXZ>l) (Se1=ܧx~H;eo?K";Zsoy/Va geEQ!Hm1C!bN9O? 2ˈvYda-۵!Վ[_5@fw9g]SwC"&C8oEE7YF=n-bΝF,%`S hEiR7̆Q1M<]=ns>K[#2UN'#ۼO\ON܇õMHٻ Gb{Z) .T͏v묶.yX:hX!c{pC"nhởI1<~p?ZSk4VPXCX[vŝݯy*|xEB ,ē?E"(nM#j5tTZXGJ8&/4v3oy7Vrf_cQy07s8SD#xB7](tmcВcɾh[{eU>e=\RtEd`~cUbmjK hwf_s Vsl4vU.mv;ynR/LX;7Vsg c q/%Ka?f"Nضܯ΢tDd4uN]a&HUC˗/-KX![mKG{"*r mǯB#]Vjmq.#OVj.@Wbdad~uu6"=,"w{K{"sDُ} ^ %ШJ}6U3V@P-zXQ{GsqJ+ǑBɅSW}wg)} >jPr0(ĬI͉v*#A< ?\Ȏ`Ϥ5DةG=e8EoّѤGBekyPAjJ iGѰ#m>=i6簞8ayפ؅L8%Kqk;d:DڙnTMU =vE7cgI x+˧f ={{^^miV|bߋMT}&mzA94 airBÊC:lOZhN*৙oC5%Quj5<4΍G<*odBZ}ݨk~oMfRoѓ埫ԌB҇D]n] ʠRlMAwOQX$0Q,nɱHhB.".m]SKR.J=e_ ּF8NV?21BHյӴ>{o"GP}LhG}-y1I8FgejCA5PKppc)WKMTNėAUMիDF? ӐZڢ}UWwںL2LY4OmDҺ0sV1zX/0E&0-> e IөEd3D\h9e}M~7=Rm}xHJmNVE?k;6 R.FSJʋSVXǑe[[3{}x.f-;b82>l-DB#$=܄ <āv1(RB/ G,O,3Zۓ-(R-ƅ޼qEB;vd|#? =;LHt4L,Aܼ(``5]icj+.a{&Yl{x0 ng@_9M.]Ǐῼf gW:hDw77Y="cel݌Otx`̌U+lCAF,!3T55!pPYݢbQMQi{[x"t^+WjG@$ZqJS킦Ƃ*c0_K6,|#A1oa4r)G|*_8}qt|l-rrTH~t+Pi9>r4JXҸ 54!_9+Xs:Y)^W7!E:Eێބ_ۂ& ~x$aH[vUF )y5]Aܿ,-L-1F_s1[m5kV$Xk] ~sKmo`A\K_O|ĺ\n=zLRWZqc*joy$e`h`I'NvP$sg5y#O(gPzc `^D@~+D#Yޗ'ȅ˸ /0X`(R^7u(*QJiͻs$}*갮ڴ$K_SYdWsw; <BQpoLx{DǨLeZ(JQwԱ|Na1AުZ:I0k$V eGb c~}M3 2#%ך<ǏUCd4g+X]L~ѫo5r?? endstream endobj 56 0 obj << /Length1 1429 /Length2 6400 /Length3 0 /Length 7369 /Filter /FlateDecode >> stream xڍwP[." Mz M$ދHd$@HBUC@zDP.H"zw;sd&yW_^MH@ t# P "@0 1 [Oe CHPAN9 $. @ߎH4@tK;9cpu~pCx )) %7 #:`3 Wv!!p_)e1wi!!oooAZrx1CA tn p?##p W8@B<P 08:HtEJGC H7w0p8]a=umAF@9]H\< w;~+8CCPpw Z wQW1!*H77&՟*W>@ Kp  T"GĀ"qUawGq0`pG 0(OX6["P8p9$dǩadQpG?'àH?G,cbi>@@X  V ;?5H\?(p7]B#4 b@ CoHa]}[$nEj:0(0nIN8 Dp:Շc 4p5\> uࢀvwq3cq=_2 jC AB8B}IpIbny0ߜ "\9D$@$-u0 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뚣J7ᰛ ܋3kxW$Hx2[lT[UfdŲf NOju bd{zʎ,cMؑBI~v M:* m!' ms26rwQJk2 XK:Z??Q]t[#}FzawY'\sܕchh„|oːAM5z53#PgB|8C=X}O$NQ@||mH 2^$݁٤N~vJX.{DBwn{l'fhvڒ+i9ĕ|nFB7۹[ g&S8z=0W48H71r2ѣ@2L9,H:C\tuh>eM `sgXhôu5<Z:)4S$QPʑyW5nzJXS* Eing6$e>zX. C/#)]4}=eǽȝ "o{xЩL:$5(BK0K-ڬՉBZ|.xaocw`3F3Ġ#nY-5p)@6|jmIܻ ƅkJ)T.rx[Q-Ĭ&Zb:* ?b%353 ޘUP 4?ìJl L!ֽ[VI*=] nklr[OAi7o@k7rlXAzsv=JiV9F].U*³fCř=EG\i5CK1;A=-_:fn1}\"Z9x5^Tk̷E6^5[,XX ۵S*XN*1Ҷj8$2u=NL'c⤿cq)1IXUeGx"%ϹFFHb}_H+\v3X禅wuȇlWs?wԯ3-x~%Ct+K#K'6YB) +]0;#RjpRzzO> stream xڍP.C`pwww ;Hp ];-hpwIpwxdwUT͜OgUԙE-̀R 3; @\Q ƁLMaFm@)ȹ9<ll66 SW " @tFwpXYC^@gN`e jۘkˍvus B YC nnn,,`L75@ - (am^f ^v6@ \PU(;A0 pydaXR ,wdhjojjcgj#sS*s68BYm~;K%A@w~6`K=X{/da GVM PV/ȋ fcc@wsk5<_*rtpX {9 ߆6O5Oe`w> l? _e|Y%4To; `M2ޗ)_+,g /Oт J/\7Qo߄\0aMm<P/_6UVZظUb +h,eP[ɡL% l0 l/ gAq~&> sߋ0M=_F"q_6, ȋ <DyUH3``KK#o? _" ]X!`?)-/E8 &L e{#< ?mK_>YZ״w&yP?qO CndyR}.?9S5šmRje >W3ON;\\iײ9_k*pvÉVIJn貕 Gz$t`_S)8 a24~ʳ,d—2('&نLJH:L6CmR+GV]Y#s<~pd0P~x*3Zn0Ws%.%+t! th껞\bOvj/98 |-c3'?yoEc$mէ7mh[{b_fUi<_e"~w.x1"L31"ah)H W/Rn 2:乹bnH#-sKV,bbԔ(]w~ӟTծ{dυ܅hs `5CKj;[s !6^*>6]ns"ӗ -$$6j, Ԩ+^.~).:.:kR0T]\yXzSY!t\9*CkP_A^%Buh&Z?s{qUGTz6&0Jb(&89[Ug"CiM6I ڷJ Γ d"AF$4\nXv(;TSn}fϹ_F Y L+& G4oJfTudV wч!y孯Yuߜ́pK.$vM<(1< qN\o&^_` "yЕ`O}Yel#ۄ=o!D9~!ugꄴFM[8*[_85AtlC͸N0Q 5hN213bAs[.;qxQSlӏw[orUػ}I0#(r C>ѝNQ!6UYya݋s+a2kzM\.>z{v/p4u?%E.B(Og/Yx@z&,6?,kH쯎~ SY=>bG&Rhw!0rbK3ͤ]Φ9 M3|kŇ!`Sܴ\ãuSt'Ӝ<>1lLi:jbM D]ZKE )2mGFݞH#Yjۑ~rpeg(2p3 FKT%苴S><~y*_N*մ֟'E<,䧝6t"Y4rdvehmJRaL+kVE]}95t Y|,2 ^\ÄClZ7l1Ư?U򌤾K/GGCTjj0^9H=ة?(N.[Düۚ*Sb[s+ƭE7LO`xg,7Y<F wf^mjkĽI6VZ~hɏa.7NSRbl3X>C_wEsö}zwSAQl ^+{ ۸wHȬ0A3{{,o`R[Desmй]>#O q3CEJf+2(^Ejj8e5bR+5"ԍsXR6s 3`uNð+H&u$'m,ըsIPyxz7/~kjAZLTަqV'DHP5Zx. jO BKZaqL)o͈ةn :VD1DeOqN-ɖbǷϳ9ϾC- iftBqp~ƀ%#Lrn\ |d$hFVk;]kxX"XW޿=h2.S<ϪɴfQdd%fԍXDַCG$`.BwïMo7ter;cfK b0)bT)vʞL\u8:UzFAT\f*o^ӞAhlh^dр7R`& <2|SjFETyvM]p0@>=sDKwFjfz~AלE1 KtA`Pft?,d.1g˖T%|^jdG>;7+NSkMKQ[ИDay7)ʽUCavJzg>= ӵa%]3'(=„35 srK5xonѽCm'DwOaOr]LdЯj>kĤ#'?~_ZxΜzաR˒:7MPg tdI&ELOz՞-#b^$Ej*@B=nXDf9[3_(?$(j!+Nl1i }1,]a$@pvY;_}[%|BD6gfǰ1ܸ o'~% sTgr'r.$Kbԣ>$_²A(ԦaIoMWm_hoBlr QT%rѼf+LF\| O];%Tov_˽/Co ~SYA[h?d P$Ota :17aZKx-Hg$Y+4e bL擲V&ˁpŷ C^wq3V3XOXHb"+*b.(}I}=LƆ.ar1=1Vͭ2xiE,g 0fj3HvZjTT&´ aC%=`$9,3fà2\q|.U">W3VT)HC8Esy(Bbb8DJf'SIJ3.nxZwh3UJV-q=łꜤ0"dh#6Gd$.z/!Ɏa , ݱ%.fLV~[*U>W"/8 VBMu_+Bn4:6n?{-w7bH!F}ϼ J ODNz|C0v jtR2>rY2'rXd|omX*"X`TEj]A&):(uTR-ߐ2,ۢ6Xٺ66 ;(ew1;&ai}mcc~d.WgZMCgW~>ָr{r/av2.o(cK޻CӧbUw$f:xFCr'FXTB'Lo3 [G+VG72䔑x8?qՄ7zGެWer)=kG}Q;I"A"F6+`^綜YUlF4۳Z:EXvhA7pX1CK@͞1 ݗ@Wl*r3J7~ϲAO+{o U`QB0(I xIA,Iu]ZT*Z0xeh$YXVtcVʀ]%VV 8#{]5݅~%ۦ|W(ǚV9sZVOSizfO:V~%ŀ-ZCL+V'4~F +޽k%̔Kڳ&pF x1%Zc~B"G2\aR;ۡ2n*[۳ LWO;>Y&t2cƟu%i[]1)J 4tc^H&1~F[Å#O'p6pX>U1|\*;s:yg+Vd#P5C)p-?MK;EKy a:Hʛ.I -)yudƠUH @^7s^KKZ5=ocy4:p@M-9,'q^a8jKbpDv>FuӁ¬G V)6GAʀ8 L[bhI^ZߞzԻ~'%FHl(cH5F_{r5}I7cKX-VOsFƒ;.7flѧx5J{z1uz"gBPݧARbro;7s /79G"Gpa$ * zqA; yK aIibd\YPAsB =nLwqcmG29 `FoWA]6b YaGK;ﬓ}zYz'.Kbsa,VIqgbb-e(k%H|3cJ% 1:+ÂʸaXXPֵ 8J2%𗨏{TN; _MogQ;uiDs4p [}LI$޵8?T PNAYEmJPj (8tgG78¯e=) =yD)sJ&;넬5Z;TWd Y_*D- dGv"wfr%g6ܪ0By8KyN3%ChmF.ϹQ2 d0& 8-g{4;L{̟hi)z`DJqL5&b-y%+TTЅy5+&Uє=J:$庇Pe3(]hUC&R9CGWK&0zTأJbT,~s)ud C;`}ܵhB#"h9uwIa֎ZۢZ,%%`ۡPqAmȘ} %ثì5.IUbTWPU{F~ltF\(&j+DTv1;Fs =(Xp eKq y&\Sw%JCV%'.% @7:NݫiH[ZOů>?#v m}_k 6 ^XϱV/ o;9eq2(G-W_;{??`C#ɘ: e˅^nTZe|Bvy2 kU pi,/"m`>wIEfJw_?8m 믏۔S4aG?>У4^ ӆCGIZReSVM&f2gC-<߲ܚ}6D$_,H@_b!]&zqP?I*4W7/TTl~4^=8ǬQKkyݽ@,O掣}_m$@0=*[ؤ@oO38$=+~K2f SݏQPa%#P+ *;k endstream endobj 60 0 obj << /Length1 2156 /Length2 15266 /Length3 0 /Length 16551 /Filter /FlateDecode >> stream xڍP  58 n!xNp9ޚ*fVڽzw? ʴƶ@1[ZF:.# T T 7#@4px8F6.Fv.mA\'sc,@hO*lk 275sx;??FFNNv@ @ hv@?J@ h9 XQFO P13Ǯlkl VF@ Gc v8@YR o'X01쿈mN6023q51[b2t.4 m ̭  &0x<{#=_y벨5DA@s66scD;ѫژqJfm3:X9Y/_*vxLD=Mo_N@<##`45f.d6{>6^ƶ6V_z ui a'$dpef22898 eh۪``om %mLlHxd8;n %O}e k32a<X&$heo߀Ivtx Y۷ݰ6Yhlho!hcj6ۋ Pg ybvWoGwLlmXYo j t{t6o)7y[_7 b Fz߈@/_o)q~7N"o/|7zc1"X|FVo /:ModLzii8濠 {æbo25&O7Vžpɰ~˵{{;XM~[5i;&7˗?lMoߞf jߦ8|Dže]W?ezm~.@#y[#A|g3)KNG$D uЭ`p/(ō2ѳqklp[b/'XvIoǂp*{_<|-![Hs8r );*UI# 0EuVqh΃{]\諬V=UԽVfpe`ֿc 3|:h /i S'kjYy }qW9T<̇/T7]<9Wr"NMY(t 6.Zg? fe*^Q 7GtzV1(Q^oGA{؝cM) Lk|\ .dLlv&fȡwO(PϦrWHjJ]5?̋F{RW{SȰY g)_ B96%a 8vE2 H4/FZ&&aL3-6pm:,i.ӇJc;4O*RՓ:q驴?a:U=yphF\C OeB~3w;E'z-K2x6/׷-Q/M=%@0..5{ ]//!k$Y(9B;g()#5EA "'`H?kڌܮbz%i\3?| U|U+O)1w&;n kn)p7K$l 3DSmj'PR,7\WhN,cofIVZigZ93ڈ@#F1N^f@k/8=`wܝ5)JeCc`MXwu}R~b4NW*|XrIk*.cg~ 23{J.9}āOĝJ !iT90];{9U"薋}xqj.tX`"MFNj4ꁖ$v+WW+Ƈ*]rfRF&r4PPqeF >*DV;@|l, feJ6<,ID>H2d5Fcy_bʩ_aw쓝pzڷcB1(e_jqv#Fms9[ Qu>Uq!Rix 3#6vQQ_P´)GXzJkVS7}Cc@3􌁎KYa~ WdڠsP} Hvٰ !ז!yrbmYƇygqʙǮou'V3(#TS>Qjs]#P 5V]KF ?dO¡|"B2K<7{l-l 78=?un])pᒵh;]ٵ'[(.ץ!g'jcm !Vk?bj`12$`Ў~,Zw(D/ =J`*;{'JYu##,@2Ulm'?;P/E%$2!mh/%|߃ !E6FK'c#y> xsy}QNgCe6!X4&s' qCX#P QJ:# ɺFc#x;KM4a0-`&/')+喙oCrelOy(ЮB.ba5hO&1%Qt!k%s^0 2uLw5y*eHōɩFwY]c9aڶ[.}2Qt<>#*E_C&̻uI2ﱇI9fbGlQiȰ*$#,~@(t{PPMRZrdo >(,9xpiwA\ AU5I~sޘ/ lX{"ӶVONaԨ$nJTy1ؔēoGVǂvIoڳ1t*x=VVg-o0ɎA rk %#:Mzbo~ᮟg<&#cl0}n-b(,ƖdËW eu=ue[(SsRTg_#<0]vEH DcܙTxgZ)5OA䡻Mr6Zzqtf8ۑs[\B=V}WVn҄Bv~uE/ZsxH4!^pB^`} kK.>_YSfߧ$C_6N %[ |z7hBCUShw)84 &aU,1fc~\ʏ9x̧! e_~kd4<0+1G19S摮2ְ&)]mB֋ ;f_˓:D\E+p觖Wh̿'%dyLTk# "<t+|Q`8=I:SJ lrFBelH[ yzF b&uZ(6O8Nu+I œ}g@䚱1([FeT 5]2S#Lo-MJ9~ ϩb%? 8 ǜݮ)OQ}3>Nϫg@;'. 4P{nͫ$$Oϣ0#5fiWޞi+ ;K)!0wС{5]C /r(}ֻeCIsƺ`Ӵz&.+re ZnnQoҕ_ٸ*(ūwpHLtH|[wqL:-ar7<B&_K1K(?>|_IEi8i\/T( L@GpPLjw*-䡱jW#.wA{|Uԕu|)M+y3Pץ9tz4>E WY M@O9M%S~BW /9yc_CSs63A}qon6^װˆp$Gh`$ |J\X_7WZphsq7 ьv .R;{t>)ό)M?06 T˂T*ehQ\*Qw"53xGl)YO YAO(~QF $$k[e7A'=(`nP$;>--ej[aq7˸w.a[*u1}v0=u9_ 99]F0:J3nµmmt{*Ip,c3,vu~*M񚠆&QޛZ'w 6R0.ԝ!Fu۵^D"⩪W ļ(D-o|L&'z9>v>fDڹ>t8+# 5l?5K@ tfԤϚD- 7pO ąŴ7Jj 68OwU@S R:}8C!Y 6fdRG5 ^gyG*{$K0W /5Ly//ү|`Ȑ;bt3 s 0 ~2ęDwXEiDl=q]\Ξ(@`le7CbqV]lnVtx\^j-CRhhOS 8vgQ$j|B1sjDZ"9+پ#i.,nZL8k1M/??ۯtG(2ߟ8BZBe9Re0R$.'X}oOS]5AtEU SxӃf=CvU ,Ur5wl^Uu M.bȅ#slx6Qp+l*~v0}%~L#-O2ّIt>)={  Tٌ`}Þ,}Z-^䬇QoBliD~YfcH"KG: Ǵ(Hk}-lo)^صmsmp61pps@j%~ l{dف5$eby(jn1SWrx1: "&sR9_عG|~& Fn$X߆r][yߺ @x."b>6h4EqjY FafR[B7Aii˞J%seB~|4p\1폐f`5_[bKm@8wWK ?pKrtuv))~9VR_f'tBB[`UdL=Ekl2KdCdj9(w,H ˢ~)6It a H v>RpΞH0>zˇzu:~ϠΎl#G/n6nR5 ]6@buT|Giĩ˵5~9qKǣa*ݰ\HGcзVg:9ো@$sd+EG08okJc|hs.²+pM\Ydi[]Co/F[Vf)nB)I O[T^c601 lƴr  muѰ=Aò~<]MQD)'OG0~s 1eZ(mKqs)F-چ%κj'S53#,-3BRGfQ2Urzz . ]?:&A$x4SAw xB] |:5OTоq}m%ءvJkӧ{k}"E2w^9U 3u9^_O<-`WWX8)v&JLl~nKtG"z)1!(G~Y4Dz,@LĞxj#s#Y3cyǤ0+^sZAL'C+} Ky}zHc1ANj: o9HW<ۚ( W<]<)6m}^IS#{3Mhr8]Io no$q|RaP[f,vvp' Y;?y(C*GK@߈Êit)jPK*g3a Ħ bmgX_MXwGVhn̦zPb仯NM:5Zǩ5-7C !E9RYe^G[$q1SZz#߱ӿSyhx/K#2jW߽YӮF+6d*NX ~pPy9u*g+MuPbH{j@+)}.9$p|)ą0~G0Ċuz ]N;nM&ٲt>6> 5肔w2KOyUftݯ<ώVSƺ NPA9k9[Op@3Vo)((HU/e,XzwPw5 mrviyS54\R8gr~:xB,Ȣac%Qa tM_ Q]w/ !Hv$ds?4bqϩPTܭ!nA8mpJ|D,-Hq`rs GIҗWʽ$,am<%%~5_͈NnbF_H;HZ o(#yM(˫zZag=qP!G*92k887Ijn15h)‘^sy]ɒBxzo[l`ɦs%,$LYī|w=E1P>6?}}2; neYjExg-uTq:c¯D^b$On,RQ0#I#[[j`qlP_~mJȃDm USeQ1ƶD| YgSj P@ 74ZIE]x"Y'u<,tOa,[@ӓm?=6ogR$MMꗣs:U6BzƼ' IHӂnjI'8gn#TF{Rb9XVZ-ۻAf4,,Z5"bs ikf"D3-5S=rf4+vO~&*-c5nbΏH&c\XPMK~i:pbvA')/"\t&~ V֭pq8#]VYڌ/#((N(p"&Iҫ{?RJf0rL%rܤzo>\gW_& ۞E}丳vS6Q`lQr ee08?5TwT[K)?QoMJgU1Q64Y9|W?{ZJ-9{gq̀lKS.Q>]{.CڥeM'!L*]^bRq\AD&'!xcaP 53h ^֒kīW=c]E&hѫF1B8Ha&m${&9rѝ*\Gp<8q_23v6{xv 5 1Fw< 0hBAo5#.3y5 r;G6`m&c>q\7FkS2e m>BσܔOHX36eEBPq']R|gu ܎oxQ!/,Gќbf `FI)N:IOWb{D u *Jw#[6jU瓆u;Jou 0h 3gUYaze,A5ѐ) 6eV˱y &9:$StSAF4)n-pĥ}: ~Yk) .TζaO`7[\ ?Qѵ"kJ^0O_obUQU3D}p)U.{un,n TYifR?!~!}9 ~shp}&-pZ&}}K:&E)mT)jy;ou2]]q\(SI=D.UTgń^#=Rwg+hhP+<F{~ r/~%Y8.0M`|.QwG=ISAݏqTL2~mR a¶4I(ByS|CKڢjiQ\ǟ Z4rpT3szj3;0*&¸8 q)r  1r;ޕ͜]<٨xdeMnUARz0a2xYģMq|\P>hP̈́i~!w,#bw)PBk'{g!SDmM7%Ė uhH׏%DfNU:2c*D5LJZ=ynBirﺱD}5gM;vf2Ӭ3" X|52{pI|Ixlg>t߳2 ץs:߫`j~} N<c5맑> ]_iH/TM`gud4j%{D^C{QŻ۵genjbT"rK\R5Q[ H|=ƽxy ;}.DШ.38Z#=vPAz/{umσG~ T] RjɆWrN)wr{z:n]MJ7&N=ZmNW'cK4nOx-E$UYyҨsXǯhD%Ј0eU|&C%;Sqȭ+m\4auL}gĨ1"% tkB*.s<_ H10AHesjHm|R ,$n$35D:.s^<6; f4M9j 9sI ]a[ zt=+ٯwnc$&E+)7Sá )K5jXYqYPGSr^:R9B-$Qk 2L0$/n_gW)\$ XW,L;vj]/Њ2-;݋vIf̥!21N'D/y:4Vrs aȶ,o-&|xLtdOsvQh `5fpVGƾ9Fdb L`VQ.7p HN[3Ȼ|ܴێtcCOJt!^bpUU L xkBdCޗv rotQ2/l`T%2׫VopTcd 唁Njy JI- JH f+dB{Uo/T\]EjajK}VgB9Wq'NUj>}&6pn V2"ӡ=0JzTw.LɖZaJCg$JqZȇ!AW Wcwb8/Ngɜ%TsIY.3w D#Kea+3$T)}d5'x;'آt  :Гo = 9HZqȍ#T:Vz"QS:'1b9fyO+V/h<SqVr˜=:gDZZ8 R  +i=ȊM[qJ߭f*hJwEf(A} BҐF5j)|z!3 w&z4ス͍IU7?gvٕ1] Aji`EaNFɷaݒj ΅1.5XGNXG9&Lzh"RY:{ aՅvwaFډD%vux| Qbf עx_ Oٴ?dx6Lh_}O~ #6~N=3rxIepPK,x@hr19a ~{TyįÈ1-Gڌ]3+' ]X]=9@bࡋA;zKA05htE%[-a;B<W>p ~ȼ0-ol\Fq' M︋;^7chFZn`I%1>C?ՓF{Rޮ'w'El  m`.-KDUq[[$3uӞW6L l3}l 7ȆthVʘGӣ{& iw-m~,@a㬃8HE[K2\= ;MְϬAj[#> &)㥻M SE";>4W1:U-o2uMj> ǢR-]y[i7y8!¢=1I;uv޼Sܓtd nilž!#JpAbXŸ_;ǰv}m?9hS "ma,ZFe9KXLU,gjVuwWœIbIV==|_ ԚVM.9)61ۏb0Rжbtv xG}^z2?~jHWS;rGir!?(WЪ[$`n#RgϮL%:bjwA¿&ȩQ 63<>|SL@T1W@H·֎9 Aʳ4N2? ,.U:TW#mz8V%L^PbK#'BJ^Udkp)VzŔ9NS\R/HWc;|}B&Pt5xG%-\mG653qZ\﹥' NB⓷(†ݢER\dbɤVlw)̈́؅3@j>NP|R +.zx=* a X?IuXQ[tәc>QuE^`I}V9@2[)[<[xreжkq*MZQR, q<ݐjGAQe6a!釣+}gԴTq.hwG|!_P27.3rc3ʪ08t(cZl(?Ha%*YQi$p_i8.{2&~Yg-ȼ#nwW{ Kg]2 jTg1cfC,KQ*8hݢ+  >[;+mX54npY uMv?^ЇS-Gy+ıMÒ:D$aQRabp: \-&`/;iyTɼFфF '*]a CFtĒYZ-:J^_=wM2n ݬ7G89ΑW iON@rЏ~Tam==:9RG V^PheJsM##@caqۦoTeI5`}B<@HaPI :E|9ezNW[嵎Yew{R׏*ߎ`~.% -\UR+Eyl7l"ZȚ=~Ƚ=⻺nBo}e'ֻ~ĜMno|PhX6;Z _f1Z7LjP53EG 7Yh5ey-֏xJ(Ӿ0Ȋc܌Yۦo52gey|à'ʚ_r9ڈrVq"*TBci,jR")4>f5QMj& :j,3]鴖5|.CW7%Sdp-ZnnSt> stream xڍP.kp I5 ]wxdwUU0_;}jxC b 1IBlXyb ,\ff6FffV7oN֠(o4A`-b c Ob uX8yYxN2DkDM1ɘ!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/`GZp3\)#_EaWT[U.v_RGZQ"c̳Xg2ҕngC9䋵^Ll~Dbu`IiBV fkєU`@h4I}*4}ji5'oQu~Kt+jM%4t2ڪl-m陇9s =*sVMD}"00^,*e_r*QEh.8 hEY%[f!Tͬ#8q4iU:QS{>D,/)ldIO3wk4{1&IjS"~$HػjdL-^2/WK$QU>~x8$NmFJ'IU9Jdx'TQJc%KKMA7 M&Ӛ.#/uPzE}<lHދ\eF}Xt\̨}MKFlcP@)|&B,{BX[-1A4Ե5x>[s!ޣ"H(BIP!6㣣AC',j2oYE NJ?abL J^ CQ|W=MܝxlTU]J%WFW<hX]:"HrW@ϙQ $VC_ONj,K*1O.p&-tš6!5ܖ9eMC 2-*4r˪"ZPq()z%]:ſN}-'D7wwhB?D 'p)P[ yHn^]+<HS0?KN*~jne*Aj9ƾ9Ju% Ӌva A4,Khb'x{WfyJ̅i)nL,|CriD>P4UT(+l8 !U*Э$kzRR_ۯ ؑ"_i=|il6 6V ,h[WaF|]WI}ܛ6:-?1_ó"VC7"~$1;Z͞qU*1Ѭ ^@<̈́n}یN?Ťp.pȀ73[sPU_6D8M&3-FI*!x T1Hp,5HF\{Na<2kީbn{NuwTQo¦ 1ho ZSUA˱aqԊܱ8EMu%#0|m77 ^v_)sm$w'&P "r8oWYZ84 JB p{w!%N4 q6:T?L$# 0;JdXbK3eIui77jR8M êڸy.|eFLkw?K6&GnoNI )-cvvs^\OYҹ1}P[i0gUb dzLd A8B]6{(`(ZY,-sYPkv2udTcZpAWx>GGZ[.umd00&6rĖzqޗF!~Fxai g>)N&}/3_wU(6)?Mguma(_ ??sZ=E6yp 7ɱnPGSTޢ7`VR_ lq&g G9iT+=ͨ%{T rzP&c]) bh>p۲`w*gIvv1h2t|3 UL I;i9Y63tMR\^&^`֢}\O}kVf&5BmW#)[؝(샯7k&h ?~s)*YЎ[$좗ЬAjdZ.l/ F"<|w$df\5w"],'8 f19~8 S1:ť"&ByƸ0T͊UG$xoܔ&t׹ kR#Γw;N' Zp7y*T{<2J*3mNK^;rx,lwv} cFɫ_\EնaA%ͤ5\̯by+X(} 1SeGܙNC8n BB)] C}aCr躽g)D!m'-N9I-, c3UHi\20CLJ4Z|_JY9X|6b' &{\L9n\\/RTeEjOKN% hua;b,WT9k㫈FzϾKO [L]>Kf#Q'({ylQHcu"S56V42) C7g}F o"Ю:_l e7 ͧrF{p= &/VڙF Ɏ=E9nՃHUB?XFfИ$gvCu!4`"5-~)Gs?o?{ecal ѹ Wo((yxŤxHgy8OY D 5Sp*pRHKF+DZ<ߌuo 79A,}ϼw;2OXB<#՝1.0'Sֱ\S֚fs$8oμ=Zky&F_(9I~/>_?00lJ|"Be,vn X PX*AZn$j>IvǦ6 }n.d=ޒ"9LC;&$0u d/Aj؉! 0Ra1hMU^@[yJ-?Q%2xZ7[آ=@rI17}a|8mDd]1̌+G!E&gIɊUBNY*\8=H zW^~G"9Sv?4td;EiGø2!8U(*^"4N=Bh!W<:k"gMm Q- V $b:نM8r@4mu9~3LECs/0>0bGU0h q|kV>ډڙ'T"H񡫠EK:)2F{ʬYr&qBS xr[75wq:,OhoSGjr2[bj*ڠmdMyV2 sG$98WBQb4.ϞGd]CQ% endstream endobj 64 0 obj << /Length1 1379 /Length2 5946 /Length3 0 /Length 6883 /Filter /FlateDecode >> stream xڍVPݳI HG~R*(WMZ$j&*HSAtE҉H"ERyѯ{=gﹻ{'M-$0 ' ( "#H-8V5ĠEpD Gt3Ơ*@啠 J (*Z@`,`&7DTQQAw8B`p0<(bF8\ȿ(DxpJ`pPP /zJAH'`G`n/ -L $ Xz"0[`qA0, |pڟvC`bnB@lP)tF"Bp A=wc$ I0/G? !}`D:fOup,/xh7M @AΧ"[.7vGIp [~}?=&?6@  _! xp/p'J@#pD8ށP $;ьpcO< \ @~}^9{ wqF ih` )-Pii@7j Cy6?hw %#Ϟs\Dg097m  C!}Bĉ]#N18tA17d?Q}8h/鯃 F"qp?}h)$`Y{b~C(;6q5sr '<8n} 1 1XЯz*`c1<%=D0/zy^:ObQI)*MyV vW=ザȎ$1~UlCYaؑsb#h|U* Rر_ oz\K {AUw1cfK iKޱJtQ<"xS'G-Ʋ8;̒3po, _#S?驥+='˻ xtx$c4 WBɗ^v_B[׋ЍLt,Q~—Lni}i?WRR艂ޫg# s++\Lޞ WJ87a0~Ap!od G #XUG4n)Nշx($AxhWy{y] ZiFF}A"eY5ồ89nQM\hvJm~V~>";K i.wզvYӦUS^Q}N]!x`7GVtmC^D5W1"n4Ȋ%ֽ}iJgX>NsҚYݦ]n%ZmEa~m.ڴ2q=Yh 3-7qfԻ\!t+%E s3C&WNr<-8+/7{T_JҘ%e`:ػ=6zd*~@3rdL;J%$X`4p̿͘NڞGف>Igjܠ _?>~hUs׊6iU\O*H""Tnk~=:j˽ ]it|jLٌQ|}/ iĝԍWa{Otymkz~ؼyB}0<^ֲ*7Dy>(oK >xgx`dAjUyZ]*?_[z;;Uy%wؓd0*DٍC&RՑʹ7j y;@b5}QQṔѤW*Έ[i 'OV6_P(q_P?#4V!.S5*Gg#kK !/iepJ򊵓9O /12->wv6ky51,Nx}P1[Fh:K) q|L{aWocrs b,/'1yj4?1~r .S|&[ ۦ:݋xLhi|4)~^n" ܛ؅i{*e/PTa% DAE;hcG4Sٹ2A_=U@:QMydl4HJ/>$riWH퉆tܳS% `';&[˰'W֤C&_-Uhz ri?Nv:+›OLx 6eq썋,b_k.U?/[sYٕ%BڻqkRc(Y%6 z>SyKҜ6IWtBjzn= fQeD/>9gαT#y,hWijԵoz^SےMj6vȹ]WLbQQ4Vp'Ø~E:3jJ()_p wp`?`3N`#,Un}YL^ےxҦ\@5%~q]H:&La뫱P\85݁Ԕreu'MC\_C@car͇fkֶٛiRE:oñ5!v8'GvG55Qkڻ5Cyۈҷ.W3| Wʗ<;7iANIjJ 3Ϝt$ڴ+I^h|֋$"OKPk>/zHrY`ս" m}_ja#}G{YjL󒛵ZEsM1b_K3C؏ seTRdHT8٪ޖq"c OQDQ\|ݯ2 G u/TD5S@yRiV]"wPTo;N.rK̠Okʭ+Am=5?4@em;OḟrNZh#7mRw6 {&6Uo*ܼk"}F'Fut?Kj̺}olZ9ΧAL^Ä$𲄝Z>i3Ql*lmÒ]?J8;eTGyn!X} aYܖQh?_?TmKAy r#|6$F' ɜ7f #ɸ]}i hfK/OZX3LR݉3SpI,׎Df_@ʃ$⋌}/_C|P7EK]qV)d[.{w[FDš8B[gFԡH-,\Yfj6󭀭GNkcn=+-Zh7U]ܴzyGWdxE"+;g=Iۻ%+fv%",5˱)stdgP="em`1WZS:(7-8jLNs8TW`)IIKĤ*YsƕyrUë Pؑgb zKBT^TE|FU?]#ˢ8E4& *nu:(To[%\X'wQ:S*2pf ԣ}LM@:MἵƲ޹\[(8b1\a^h` `,Պؕ|&%!\x+_Bn9*d,Wn-0(3# <~'1oqg&}EeTO"NegHţivK,՟MSZvw92Vl3yTL铋p$F]RdTZq|{pFG¨$뛱KD., ݔcLCJM|_ױS|>SZ:S`y|S31X`%?%0/ÒǜW,5#]7_C.X3JX9d>2ܓR.űAjU6zzK2& Ltd\V1A+3CVzIF/6gfLwي-@T6+ѻ ux̧PZvv6vzDZ  =jGGbI.YگԎA޼NQE/5= ӊ$7;)Տ)G.iڃN Pi;)1s}j`[=I2,lbih짌)5_:矀-c062s5ʄ]DBd:_\ur^Qb6ĉk[.Yֽ5ȑ>N=oߦsZW<'1+U۞S78P=MnP]|+ZO"γ]("?w.]`Po"m+j۰`ԩrՐV L2X§C紐>͟ Zb>[}GM.Xql `B?-Dz ]u+XN}^(xL,]w |vwSUS}˵,ME(|a䰢r]8?_>w7Z,CЗ>1rkzclH$(?(jj=Fyvoney _iN^q}_:;#4tXG6%ie#F^)ESOF*GSV z²Sz丠uN`0(HOװc`x /^:# QsO٫hܳjȋP^Qѝ$0ʒgu&ۤk`%L͡I U ByMUv\{Ew<]a:K{7X{蜢p$4F(җ΃Y-/K2Skx{- ~D|+K'F<]p}oG86tTrD K^Ky{oz4p#Ϋ{LN֤Y@, i-T4绖&_c< ";1VLb8}ܩ:휌린P[͚%UۦomEv[JiC&1S}}$* jWCYaDqbiU|Vo](U e|Rs0pb};2rZ[7IrA#~n{Y2^S^zﰷ1}D^8Ėw>$z H1VLӳ.4M[B$L:?|HCH7mO='THW.9?K&<]xư} );V_p LKoLLIݭcX?ݧvj1 3; SkQz6,fKV3osݵk)B|@ɁH:P,]Nj.2IA>keotՎSs7ɝ`ȓsq TGp}) W/69P*+O^?(yꅠW *NDqltFNc`FLH~Z/`h~}^#_yxi¿xQArb/`ɧt_l*άknj¢褹"W5bL '1&a:4Еۮ) F.Dƚ1.~$9Z`ݶwL &8A\3Y>eaޖ'UWLqsA]XHo yniV3`W?&J _Tf +  c/#=PTc* {ˀlFh7 endstream endobj 66 0 obj << /Length1 1379 /Length2 5943 /Length3 0 /Length 6879 /Filter /FlateDecode >> stream xڍTTݛAJ鐔sf`f.i锖nIQw97y>ea瑵[0_ ' `a1?,F`I7< Bm :LA@APD(*+(!M^F]{_K (..; F@l@0&vFwApP( >>^3 z`$ 9%`8@v( @0 Npقto@ #XnW.gBd v(Dq@0_ ( P5:A%Y]OtHEB*dE< C! ~O۠o݋X`pk;[7>C gD`WƁWq/oo3~>.pbF A` @-C`TGvѓG@<fh~,ܲà^.6oA0?/E/]oamA<?Uavpw ?9\8G `6M)U?hQrB{ zG V& >!bM-?(Z0{ߗA*A<:kP GB~=3 ?ZqB?%H~h)"nKs""@{5GShx~;8<|ꗑ_m~oe`isǪͧtfԗZ$_R˘F5KeTdLHH;ʆ^kʛHirIҲѦ[.;TxtNҨK'3CB<)z_Rۑ\*KQ_1>pޓX%9lE+IR`O<ƴ3=ɺv~0B "'#sW8~o*׌ n2hb(kt/h:qœv$^[@Pl.PU~fb'6X0S`f6a.@tSՓjĹ9嬏=F~I#wʃ[JPTgݶ{; sJg%Wک|{4a.K W-B&ÚqhD~ywy ;HrDr?m[0:vCB /4#2t 7F@Ut.Fu~?}j R CԴMJM cG>9^ '~\o4ƸE_<2[@c1,}Kpf9Mxk^j,]K=zwO@2 *Gօq2.z-M-{v}U@$Nd&`ޮRrQxNKvVm3oqf{̎w4 "~G<5lqnm9zƦߩ桛D=^ lH$Da#IaWvWkx-MX߽/҉# t6&4T9zӨNoɧ&.Kcӵabt?Th~1@=J"gt5ƴ1l%8+J:ҌM 2hlwod566B|Df~:]T/'[!YgnH7ݪsgr|˹l,~{MMwgH[AsRQd򱼢Z9ssSaQb Qs[/|vFqK חz1Fe׾'ä2]cȻ"i1'pKl3gUs7X1Y3ra:vL\=ֶl{cbOՅ>Ox].;gb ю Uc}&]7@hy05o8-D`q3#vMF+䍰B9%+G+&nQZ&fuXl(TS +wc#2ŞU=B yG} J֏%Aξm~t8H 4짾V2y)=~L-) PsŬޥpyӝ?-70#'~c'ֽ I&57*n{#k9JQ,a. 5S(t[l]cVHNkS}傁54,N6sl@~_M,URԏXINWM1;r"Inه;gۻtvӬL' S ,S4QGۙCbj> -l睛NٱBeRufNvrzURY T} H^HK|s5cn 錣 7n!dU&9l9XLb'J KX1X[FnM tlj'#@T1m\u(Zyᙒꍁr }Dt֔oR, /Lиr/M3S;yotlB'Ku} Y'mX'grr 9}j7Ks`$^[$Wiw45=A_N45+zJVlmVaq}ʋh \E³Jx@QMz`{ހ|F\䣶Z nU~I7`v7wwYa8-HQ%$u!NJr[zSI7+.וʃEG˜n}Q,ܮ2qY$J+:E;,26'Fhb@+E i:ꎝ}uRGt.sڼh] B6[~ DDץοVRyRZ \j\߳|rm(k$SL`OQmЎOSOcb/Q$Ld*+oc A o*b9o|x4C<,1P:w*qQPz&'ݿ 49y>22+N?(S+ }Ol-lis6Ww<R?z3k-l^|cv/c 6Y:QE|5wva*2Ux([-%0nl_[˾<ܸr14T~g~dq{>Z}oq"|0ȣEz{w]+PC."n}[CsW[s أW,کyG ~'- ~F`(.78wτh:Դ)}Ę}m'ׇF#-VdT 2ʨBi3+wnE0WT(oU?Lx5Q~:.zӒX|Ǚn ETLv3)A|靕OaTl`=uE18o=l*G=!ԑw)ϴVS>7;‹*lXoFh6;\ 9p"ִ/V_dffG|]}.&uNj{쭹Vyz@P?-G2E Kk }QNfV&2և?| ⤟B[H^upGKjQ7➶wfg)i6y»ƴbXebGj^ JMXd=llmcf<.`b(J{NT2|d*S?hI,+useĵ(m a|j2gwL^S%Sԯ`Հ3A8ulDr_`*B5v+Yq>=z, 4խkd:=at8J vfN}?i\'DݣڲC]3+Q}H j璒 Ф"=;=y,|r-°T ;# z An}aF[[~Z7Aiy# I_`\qJA1֨WLږ["K=] i<=2&?!0#g_ʃl4erGH^Eݏs6S$'+m ^/GW$=zonmoi1mW Zj?|opE3`o>zV#}Mςz?Qcsr8:ڶʓf|JmhYxzuv_''(-;;)I:;;Qǖ1agR;iofgw@/FXɤxPw5׮2yq_:vi+r08,ngaoUlJ ?^3]h\ }ĒP?w7r[=.pW:pzɓPNV^̃}d}l(c KKOf'uZeVP[|ճJ⎠5'4'*;o~!M9bQ2Oʹ U)&߃,-ɉ 'fTF7%GTz+t9X&t"yA\~AGC/2eYt2O-)GE6fPo4x2KS:>-fKf?ziT/ +WmEv)oқZ['P_X T/Jq*P6 +?ǻ]|1,t_)k}PȺfN^.Ji$z.Uoz-VRxM澄K8ekS!e42C5Z(S);qsGom&\%=AqJݨ.:o=3 olh֚;wK)bn.X ^ոso7~s8R}C>8-)u\xì۾U ,7S~j8BeeKX%4>#Ҁ] /{W]giKvͥ wO-| *uPp={Z}*d_zX(7C(xkGfN:U.cPavUiL7'IJ}Q#(9 *uFUSZ(QsEh@TZ啵'_ѭ΀m+.LٟevbY'`mO/(FmBr+D{4$U />Z&bVF(X8-U)ȊQaK ű*Lh\24Hr݆`sfȚYNgYgӶQ; wyXRw*.EGRQ"BWw֩t n7f~ǮNsߩ('( hX)+nSzxz1xW[%Uy >/S3@D .w=oZn-yk>mAAYI/nt:O%rr`k8XTe-%Qe{Cup ވNavnIĶ!Zݫq)z59΂3_,DlHdƩK@g96l+%vWpDV&Ŗ^Pe>!`XRݵ(ӶrS)gݔ,ؼLnvgBZ-ug> stream xڍuTC wwNpwR@qwmq-VJq)rӽ33/LYI(bbcf)ɫXY9YYԭAv?D*M8b.@X&nSnv67??++DG~9@ tEstr##֌9@bmfP0YLjf@}g9xxx0ػ2;X 1fN֮֞@sek_Gv*;ZLl=t 4_2CK/Fp0s4\/DVsq|+kk, \rsXD~F<?"aHA?"XA`;?8?fM]L̀v@ п\=~-31qrFb1o?p` xPA. |eae~ 'npv\OXvp7 X$v~K . rsGo t$';?9s[l`N_ek@W#ۿ 8cAp^7wfn.z@]/zBmCkE=95n_H9 wzl9nxSŕG! %xlSg;9;GZ.֫F,Axa|lQK|9vH6a2m\ƒ 3/M dd yN% j3,4&ױ/Ym~ڷFҎ&"&Hƽ|o{PQ &<pXעbfZb^IJD\K;2y3~|1#ۣXJ -Yʨ2ǎoͺ5nX ffԘg\);;39QY_yH*F"oÙ06-18-9 5 ]nҪJ|T>AH Ҩ?)e(}qK,wEmE"B@BjpӠc8CmYqg׬N{kIB_ }MR+"( ;]$0/z0,2$]j^^O3:5SjV}j?c2v|4>$~ÊvFN6 v~`N(AP :o9+){RN%RÅPJ"Ȓoa*Eol|m {$U}C:k\(#Y)y`r>+6#QJɭJ-d1cKpŁ*AwB{1n}t 2ʧCs6XK]h%eH"BGU)LxPԈ`&qW?/۔Qοؠ-S$^~.^ISAVm˓dWӞ7'h!лaͱQo[ \ٞz4g5`X]z9uE&y)|FOpG}5$gX@| :t6lNeà2-~3Xw,F^&kȨv5fDј ^]KRz#u7\] yYEp|`go抜|20SFm&:vW1JN泒f"=|SUܣ$:z1Bq>Zp#7fu1 ozxqa"wP 9LjS6ƻLH%5}ļRQSr3FuO/[[7g4xrQ=EAB_®rʐ5(W.ٛ,!ѩ}b<$F'zdKo*X 疛].T &Is:㯄?lH Vwi0.Jmu+U^&c \Jn<1|d wZ:jF{^8Jb}D#cư4.LR0hF\ nBpn stfcQ Ksb$gNw֭'$cYhrJYw(oy2*VY@_QjNWv @杋;bȇe--G76rvds &8i[͓#f*EwCg&5vݝ2 be&:nő^,;@dn3{&cFڀ̖JUE}@:;dʾAi=FeH6gZ#0yѳ24w1(Uag",ʲKnri*MIvEϗl79Kyskzl,x6wh ۏӋ*f \h$KBvD-$tV˽S(A QΨ3AB+%+ɽ)$f|{Wfu)6#n: N-]Jv7/Af/% H!&ar 8ǧDɐ|6Acǘfp7mO}J!0t!H} yu2KE|=Ȏx`$;Tґ jMFZ߬x[4ID A Vc@hecG;yd .x~GQ4IӤ50_{yz2C2X{[w,<K-+sJ5ðb(7ER< 䘕/j=VC+9R϶/8WfHl~G ,TXcu"ou뤠J XM 75(0ڑ"p Ehh̝rS?QG+&r>/b\lI)f 'ptMFg4b(C'\r&Ɉ@fT1#M%uaKGKܫ׶#6O(|#``*<|İ[3aK~opZ&nUzj"z}t{ho\0mCq($os笢SH,bI`53r#IyÜ +">9vQ}TfTd.`3n;@ MIVQ(ZSir|q$Umg^uٖ&Lj0Wl%&sEL>V"25 ?.dg> lC(j`<7עAD_e'i/騘+ qeF!- D?ϯ}v-~uxf|5OfzKI1CO{HzBIjxŗ)뫮5&:3[P{FG<ɰ'R:­ W_r|PtGˇޑb[grdbY $rK[zTd{MH9I֍O$3#q.!iGiةy&8Ix}F!_OfRj| ru>ێ Mc; z3s+YpHN폤~ Z*>zHsLH;, ԰u8-wS=õo~o WN9jey B9Kߕ7*pr 1VTUV BUmX Z"CO?Y%'*u*χW2q`5a -p8[жˊ1l"*L]xQ c&O^gS .n\sF؛"52u˚D$SiRa* H{oS$ ؔ H/翣S]ھHYb47'ªA'Rp׺TU'V12W鉎>I @NQWm#J|TzuW(P z+NSdXGݜj Y.6m7 J=_GkH":; `'G5'0ƹP0d%:gf8wd(O'i.HU\5]޲Ǧ6G<--;cvN9+?{r==cl-4QtoU秔G& xW&DS؃LIzSr|5'yi1lY;>RF [cdψX\\oE< ͭ\"&GA3p4$s[@%T_0 ~||LrrZaE|DcNrHq؞ç1sQC_jc?%rx}X淟wl A.t?d(U}o.ŢV}j:%.mbf\NWզ"3`%j1qdnIZkp+俺f~Г|f^er%*iLVsdmҪܨ8J;;֔ MJ#ySOP^kXlsɜP&y8Rk{.fɊywr`pHX淐~`KM3oiY<~s&K_(R+a1 CWD:]AAǙh8 sY^ʫ&NLM4frrvR= >ax Au7Ckex4ehc ;,L&ylЕS3zyؑ7|&ڰM2 /NM 0@+Әe[P7CYx6r_+ƆSz_ّw ? j}hhrȾnDK4Kd!׺&Ht$LB3 ߣǵ˿[`2ȝ 1z`sWrayp*X2s6BwcHR#Բ0K{Ygh!&&&ڤ[4iP셠a\#ɐ{:0v}b>Cٵvx!FVSZ(E"##vx(*RPCj=gzZnLվ7rd/ETYa+\FAi0fPlxcv#pRϰ$JN aԨ`5|uSb-b2Ff%JVg̓~Z(ort#p$,cȩ#~bUY;D[>xpܚU<[tn]$j 6pE$lC11׋c}ki[Fd%tܼ!yLzKZNR0W.4Me+5Oj}O`<8œM̖wX!.V} /`#Go{">Kw3D1M%55*sc`MXN8 W`MNXCpJN  f#Y2duw1EOf+@OuCŢGp̩c}|S!2J?i ~o9qڸ {毤Ԟ,YnT*VTW999VSRD ,S}p.Bh.?5(eIޮU8 VKc0CCO|\<{7XZ.2"w xW^rMXpLͤ"1oH صlm( ? V *Au]Lޜ\D]=SiŽD@G.Z2q_Qz@ӆCW\ 6< Ry-gl X=%}%2dfE(#qr&[}sVԃPtЌl94ہ9^sXw/H~奵꾉&H/|U yJ2CJۍOR/WSV7sc^4|?uϦ}Wu6vIH+wڶ.6bhxó~$)+.(o^uݫB,(?~q??L:{>6K90㆚OG[h*8w-!w x LP@n9>94)(GQo3\][$k'sb-T{fuɍ}ȕq yoD=<u5R!Ǯ*yA" mC6{FW Xm7&I/5sKP0\?ZǂK&'qL{'Xɯ&}(1o4xVɩ.ʫ\}OpEߖ4G[YPFUU'-}39e6Cה/o>)gXMWxw #_jchWv7Zy_}P]XL=.OX}p55 ̰g冻ZཆEeI5Fu['A+mP4 +ɲ !K20zZc F$c'9Ρ\K\8DI^:Y4,CL&g1 //~^9+jlyPoq~FbYnp WGIf|tKB\U?Kz].Uˆ?h{͘^vy[X3ȴuhښ%ҽKYB(.m0](\SQ _5p$`LSBf3 !4ՙV䅝"Xd@n,f*"ztˎʌi^nW x<*W)N TQڌ28(c֌d1]Q5Mspt(l%|{S{՗DXSbx(: {x%}rb%{H+%QG]uǵ3MHnc <"'$>\\X-B冎֣g#zky24NDA"eĦҀS='3YhP^-0 N$WR.oJ g؃gmv} ac\- \)W*EMKHH,*K{gk-5|#I 8gjN}Q`J-K7_҈KmW .#gbJd / HN4QI 0Un꺠 \<ү3Bx_ ܧ/>Z_`a׭X7>OPCnT0|rϬOP#*84u)`(UYC.Y/{Ԉ$P݈+KV;+ g6?or!?2hg'RR9U8>((}NxA(SX\IM~` ѰmҫR7HsrČC-=a=~5nbMQx 5*tQ/7C8m O'Z42~ f&` ji9蔍..FV#CuN 9vr.,l%<T6sـ] ڥ֕DdL1ㆉ#t.2U\ܕH5t3k(eq}n3rAj/m[㏋^a7? Z#OJieJw]j*$QQ /՟ibʹF|/Am5 Pw.LX~sWKu\Bolv{__aUSqesz>gX)o( %3W/VG5+_Mgh|.JzFNų b@uvΛ ]묭|G;I &jQTʴ =0i}8.QGpD_oق5. TiSMρ%ޓ~Wlj0FBASX#!kTGjsapVNMd~L ߗ:v#ҫޤ$G >u,-^G4hIP G]+ B6'xH#> C"|1ݣ?n.&](/@m⋣F7qLNh@'?. )H V}SrJm}+Hwto?f^`7,6+Y"(b}Q,ӌD 4.3" tM WXy<#)gsV6!v;ohv$}h֡g% nicjc<Ԕ{D߇ #ɼ5JUW-[ e1K nQ0ۥɱLQQf1vmb9#}[]Qu2B1l:%_Q}#%- Eז!zfSI\A;sǹ̼7fc!c)PPdsA G~/2r}W+E;j}ux@.d"wJ6@0o)[D+nao)qcf!$X'n@b9D9X1_ E0Q"oK)Rd:l8HͶk2hHE;J[<jdÅup׺RW8fApA M ^mGC" 5/tv7S:K:ʋ'ٵrva.f7<) e^?6HlPm&FJ?bWgVɧaצg~ylsG! FnH"QصO5I2IQӼkQ`Oԝ±w*-0{t̺޲͵> )|3p"ebXBЍ{H՚P¹ TTa,6ҹbj)@Kn<:)ڕ?L e~ a\1. 8lt nQz0p vl5ikW2]}s1N{ !Ym>Ք$>i?#vh":iUgP+i{e4@an~Ԕ Iۥ_+5 zU'*RbƮ,Ǿ L% @7{l? PDQρ)On]xD\n+I(Lgz)aVD.X)^ޟ30+.i=N𭬀"ͳAEoɏ[hTάXrms˼#yIRú$~9.heT:=~n E(;ea̮c?,D3(L!6WYT7(#.#cXmhklzv)=dt pzw׹5EYX|%E.X3̸6@j ^q3=7(褉TK>\Dia. ^WoQNb/pCQy݃RۃHnx4{NJEb 6{VtYׅ\O \t<VM-vS ؏2eƹBRYn鄻k7p_L=x)52D/jTV^Ɗ_L#X#J)'&,P϶h/+~iڢ%_3ΌhMW _Is{U0?%_$u { Y/&e`]#kܘ뒔[Ծ^s'G v4E=ʝvZx$:j0Gٮ?upp4wytqȍv} փkX §6/ V?xqN9)90]PaiS)#HēRAӸh=dx1;5ǗWTdTvoFAD츼o% Rc]D@*óR:x^qo(:I_?0Å$v#&¬e؜nI $TEV`vt/QGd(JCK$뻬D>`N{ i3;H)e!L4UL0WdQt赍|c$Yiqfc5jU~pKLy_NV3+^~M*օ[q(e̲"eL Ջ6)8Y^W'o ѕB~j,J]Kڥ Bգ㑮<+<6e.!PpS/<{_KGm 5gdXHh!&R7p'efhꝝX> stream xڍT6ltfHbAPi)AK@; i wzwZ<{?;s> &:Mm.i Twdutx~n>l&&_;6C( ŐEB!(ETG;'+$KD E9+PTp6, vF'j q H9C;@a:{' wF $875:AP dK76c sǡtv `3P!.p (@U (?Nܼ 17G;@0`  jΜnsB! E:P (9#aNN0A?ҠYn!'CBQup_d [Xa҅]r8(@5GO'3JDɀz,/l/'+pF@va0sg jcɎ2C-G#&Cy -- %Y_;ed// f_?دxS["$_Ұf(gyyQxWgHyb~gա0*;CP" }0';BlnsbTv;pxo.^V8. ڨV#,~=DBP;{za.`SxR*MƵ:'}v"O麮'+vzȟ>%:~xU>9'I"ӕf8 m9𭩶>[XՂ{ݎF(8WS6ŘkYaTosǸ}>?&锦b2ѱfeFZӤ~>밥$M<գMTL+_59 h9qѠE(}x[iDH-ner`FM~WBQ̀K>dGƪq$T~>˝I!V6~o^_AXVRKgSO2RU+?^ }K #f<{w~= 2d/կ4= # s0Hl:(gOpn*V&QQ&.Qpq8X@*M#d|mУQ":Ϲέ}៱Z>]ZqgT6CnҩU.&P=ohhCn\!R|Cc knDP鑨%q)T"naRiFU^ιW8&C^k/&1v}]ldWpT|r{iV˗F'_u+yg&+C1ZYtt\WPF5ѮRFc"7 z*,?lD%K+ì y۟I$ˉfHQj$ax;tW-_'>PUfQbkU';=?(LjlC\LVLC4*=Sx'{k5Uuwhj༧\ٺU!4;ߣ2O7?Q!~Ag:^U+ͦ62d0]1>8w]Ms÷1%M{RTͩu#UtɉckvW` Et )g-؜"TIcpǶ^UL'7vrc#+B|߈Y]Ve>b&¦=&v:[{\Rsbld̆PwnHUllp*3biˈi" \*ȍxJHS2*\=瀑i3wɓZOUDI/~fuo- z6np) wqՃ#̒qpLqCkdZ:/+nQw|˲-NJ%Y }hr+,r s|#3___K^_3&@|*{.1QFJuQo!mʆzuw1f[-d7|΄~%9~Bi-(kVaTH.˗I !\iÚ. _>cT|%E0$=["*|7/$<-YyFRl!P*p B pM fe *;0!U41nPt6V޻dWd$ C1|ܓbٛı8zyt7@zEq/4:R(293HE?fzS2PsbYd7$ [mjxxGۥDDZ0R,랠+*nP i-rfnfD9@Lڪ#3_օ4AҀZN_C#V K@ 5*r2qnT1W[3M`'Qu?8b;^M]7'ʅVx͡.&D+3Xo#ɲ=K93TI)oeHv( T63cܱӛhO\).-2IA"1q̶؆ -^gRm%P\[ +ң%4nFrdv@KZoXͨn/eY`-wt#șw+4teQLVez`Ԕgt1u81,47TwasYkӠ(sU,FZ^Ly1app[oB- cCyigTUwx_䑯BgX>0ه`\rA; VKIysV}z/]X vF.Aq.??5@On}mͯRg{8܄;ܖ*1v3; {pfjFv& **FQ ~H#,\h G>S^;KSz4,*‘%w B9[vs5eB\3aL]Z(L Co5~F`{.'}Am'ϩLwK=zs}l4dRfƈ`O_|dr{A4t7\\#5yWsX- ;55Hnr߿H{ @X߹/6ߪm[ZaIbE]JJ0q=dw,ڵ=:}7 \1 #=bvMOX1n9*yy&YJ1gFF3ЋmmF8RۯiKr`"U5v:Eab,^oH -APwˏ v0DRRqˎ.G/rMxZibYFp<)lL&~ ±sBC )gѡ> ncX'WCC`A+Fi%-)R&[Q~ #E&.XA†BlD'Su-}fEcJ-ULHI5TQ0ai]=xax@l#>:J|0a%MMT[0v#_H]r[b1y*[ׯ>]q"1OcBהFc>7焓/Gtʞsx{0 <>ՆƸ(]T8%։̐5㛢a^-ݎk"ǡ>'ׂ\}6;O̹Ve`8'ڮd~xCkeTKOLΘeӓ<1 c2ewellpܟs=75/gjE{>g^=c3^d%f,Fvd 1b }a]3e6.Jh|UzKjX%5E{z5 %:?S̄qTj{!6CգAy[R{-9#v_EÌ+^U^'.2][ KjZ3܎̪qA[;0 &n0Τ$jl3U^\[ @zpi__մz\\w'oJtWkDkiKl"g&@cZUoJe/Q%ז2^,CIP[c.5DzI E'Z> O/(OЖ=1O忧MkWiUZMwr*c U%<R9jvȨ4mFꆈO^AX8e7o}d搩Tc60e?D1k-_+>dД9(y;7qYE% HՌ{TѪ&;ͺM2Mg5LlEF/pu̸WM=E}h\/{&)8*Q+ܼ:*''?Zv endstream endobj 78 0 obj << /Author()/Title()/Subject()/Creator(LaTeX with hyperref package)/Producer(pdfTeX-1.40.14)/Keywords() /CreationDate (D:20151013203329-04'00') /ModDate (D:20151013203329-04'00') /Trapped /False /PTEX.Fullbanner (This is pdfTeX, Version 3.1415926-2.5-1.40.14 (TeX Live 2013/Debian) kpathsea version 6.1.1) >> endobj 2 0 obj << /Type /ObjStm /N 65 /First 491 /Length 2702 /Filter /FlateDecode >> stream xZ[s6~ׯc;&Lgl'ޤqv$?2mEWDҒm}H!pp. f1cYd2)X0Lj&ed(I)%zJ0mAJfF s3w)â@% #B'$RI8T$jk)Š8 حu(A zXz4y >Ovٞ l%d-`ѰZ/QŠCB:_NC EF1/ @1;V x}| =XFd4@-<Ց a~(8,x@py HYT á={+Ɵ'r0VB>e?{j04,<ZcV@FcYXB=R)LD6"嘈BވC1- yCI,2V6-yDL@f26PA*1ȵԕmHS/bμ0@GM.y~Fk\Ay^Ft%eDNF;1h#oZ# Z[IGi,;ZմK) H)>@ POQ"=?`sM(fT7Mn[a@1\߄Z)ƬA19 Ra,0Ohf(b]Z,>mZՐ,xE5cER-FAN,` mG#vX"rJnRZvZTPo)$zhj@Ԣ zQkJFHfw) ehd:utgB\BU?oQ,zJG)%i_,JhlT QH=_KA;!+/d-M֘3248>%6,KlKϾzlO"rǞ6$~⎔ci'qr-rʚ'@Z\H@tD+H $0t&s*V6{D{RUR>oƗj[Qr\E%[vcc^qPSIyNǤîUGaÕ6!ᶡ%_Fc]p@b$/z)Be \XCnGae!/Z(o9چ<\tVB*{LB^YV ką-ol -pfvZOH}m ^es3ʼ} ]ץ7ȥ2bi 76$ s]9 IQ'̱s;Ve*yKv:ҹrxyp^+sێWh8_J&zhV^9{S ȸO=_GQ5!Wn1__1x5. )'O쏊vX<Ћ7?}!޼P:{w#"giDmo>JkgD;,FW)CDͫBE&e"UNa?qrzSMBus Nl/>yHEC ѵеhKi 7@T`tS[Mw (_*z#oU-OJwo_< =ؓRO)&GǛlVDvFʖ3ttF)nw9iֿ)y64,%_ٲtn4Cۼ?B䗓\)I4eL$ gz7勭?{ *1WtgwezN9/M,~CrmJXןMZ [z 'FjJVuC\6;t+ձZ ~w mN>sΚѭ[歵P3MM#~{?Xs^P3-J}^}7%[c͈ BoUzx>]̯:og:%,o F[J[bu OWuwibźot;.>`ͫB@o=RKxc6ljŚ7 y59'~}A`^5S(ׯV]ʑᬣw5Dk.mWeCV{77N7d_W<ʗ,F*Zy&?M`wSwvV_Rm 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 [<5961179731F147C432325558821E773C> <5961179731F147C432325558821E773C>] /Length 205 /Filter /FlateDecode >> stream x%7RQE3# Fp"`dvD@>HY,]JpM~wu}IIDۓ n4`araXkHaJ0 c0P9K[I8S:\@ΡpV + 5Xu؀Mov?jzΣvϨ](WԾq`_N)mw= endstream endobj startxref 102721 %%EOF affy/inst/tests/0000755000175100017510000000000012607264453014647 5ustar00biocbuildbiocbuildaffy/inst/tests/affybatch.R0000644000175100017510000000230512607264453016721 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.R0000644000175100017510000000032212607264453017017 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.R0000644000175100017510000000144012607264453020466 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.R0000644000175100017510000000047712607264453020444 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/0000755000175100017510000000000012607264453013303 5ustar00biocbuildbiocbuildaffy/man/AffyBatch-class.Rd0000644000175100017510000002316512607264453016533 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.Rd0000644000175100017510000000374312607264453015507 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.Rd0000644000175100017510000000344012607264453014767 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.Rd0000644000175100017510000000340012607264453016415 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.Rd0000644000175100017510000000433112607264453017774 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.Rd0000644000175100017510000000306712607264453015142 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.Rd0000644000175100017510000000111012607264453016606 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.Rd0000644000175100017510000000313612607264453016213 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.Rd0000644000175100017510000000213412607264453020273 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.Rd0000644000175100017510000000211012607264453016751 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.Rd0000644000175100017510000000145012607264453015453 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.Rd0000644000175100017510000000415112607264453014326 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.Rd0000644000175100017510000000204012607264453015703 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.Rd0000644000175100017510000000052512607264453016473 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.Rd0000644000175100017510000000252112607264453016172 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.Rd0000644000175100017510000000022112607264453016025 0ustar00biocbuildbiocbuild\name{debug.affy123} \docType{methods} \alias{debug.affy123} \title{Debugging Flag} \description{ For developmental use only } \keyword{methods} affy/man/expresso.Rd0000644000175100017510000000674612607264453015457 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.Rd0000644000175100017510000000414412607264453016611 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.Rd0000644000175100017510000001047512607264453015737 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.Rd0000644000175100017510000000426612607264453020350 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.Rd0000644000175100017510000000301512607264453020326 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.Rd0000644000175100017510000000352012607264453021552 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.Rd0000644000175100017510000000242012607264453022166 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.Rd0000644000175100017510000000134012607264453014521 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.Rd0000644000175100017510000001152312607264453015261 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.Rd0000644000175100017510000000071512607264453016335 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.Rd0000644000175100017510000000164212607264453016203 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.Rd0000644000175100017510000000341112607264453014436 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.Rd0000644000175100017510000001300612607264453015456 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.Rd0000644000175100017510000000137712607264453016527 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.Rd0000644000175100017510000000223212607264453015471 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.Rd0000644000175100017510000000506012607264453017234 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.Rd0000644000175100017510000000216412607264453017425 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.Rd0000644000175100017510000000217712607264453017435 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.Rd0000644000175100017510000000435012607264453020302 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.Rd0000644000175100017510000000356012607264453016722 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.Rd0000644000175100017510000000716512607264453017255 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.Rd0000644000175100017510000000313012607264453017573 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.Rd0000644000175100017510000000462012607264453021115 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.Rd0000644000175100017510000000332512607264453016541 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.Rd0000644000175100017510000000121512607264453016271 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.Rd0000644000175100017510000000344012607264453016227 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.Rd0000644000175100017510000000233312607264453016242 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.Rd0000644000175100017510000000271612607264453015576 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.Rd0000644000175100017510000000303412607264453015733 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.Rd0000644000175100017510000000106512607264453017321 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.Rd0000644000175100017510000000101512607264453017323 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.Rd0000644000175100017510000001072712607264453016442 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.Rd0000644000175100017510000000326112607264453017042 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.Rd0000644000175100017510000000550012607264453014351 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.Rd0000644000175100017510000000113612607264453016550 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.Rd0000644000175100017510000000061212607264453015266 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.Rd0000644000175100017510000000122012607264453016527 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.Rd0000644000175100017510000000113412607264453015211 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.Rd0000644000175100017510000000735212607264453015662 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/0000755000175100017510000000000012607321332013305 5ustar00biocbuildbiocbuildaffy/src/Makevars.in0000644000175100017510000000007612607321332015411 0ustar00biocbuildbiocbuildPKG_CFLAGS = @CFLAGS@ PKG_LIBS = @LIBS@ PKG_CPPFLAGS = @DEFS@ affy/src/Makevars.win0000644000175100017510000000047212607321332015600 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.c0000644000175100017510000004355012607321332016443 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.c0000644000175100017510000000566412607321332017007 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.c0000644000175100017510000001173612607321332015345 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.c0000644000175100017510000002776512607321332014333 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.c0000644000175100017510000000567612607321332015616 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.h0000644000175100017510000000027412607321332015610 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/0000755000175100017510000000000012607321332014526 5ustar00biocbuildbiocbuildaffy/vignettes/EWSnap.png0000644000175100017510000014130712607264453016411 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.Rnw0000644000175100017510000010542012607264453016157 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.bib0000644000175100017510000002602312607264453016146 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.Rnw0000644000175100017510000002456012607264453020231 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.Rnw0000644000175100017510000001356212607264453020075 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.