seriation/0000755000176200001440000000000014724371602012255 5ustar liggesusersseriation/tests/0000755000176200001440000000000014203251670013411 5ustar liggesusersseriation/tests/testthat/0000755000176200001440000000000014724371601015256 5ustar liggesusersseriation/tests/testthat/test-zzz_seriate_extra.R0000644000176200001440000000270714706524257022147 0ustar liggesuserslibrary(seriation) library(testthat) ### use zzz in the name so it is done as the last test since it ### registers more methods that should not be tested with the other tests. x <- matrix( c(1, 1, 0, 0, 0, 1, 1, 1, 0, 0, 0, 0, 1, 1, 1, 1, 0, 1, 1, 1), byrow = TRUE, ncol = 5, dimnames = list(letters[1:4], LETTERS[1:5]) ) d <- dist(x) # Note: tsne does not work with duplicate entries, which is an issue. if(seriation:::check_installed("Rtsne", "check")) { register_tsne() o <- seriate(d, method = "tsne") expect_equal(length(o[[1]]), 4L) #o <- seriate(x, method = "tsne") } if(seriation:::check_installed("dbscan", "check")) { register_optics() o <- seriate(d, method = "optics") expect_equal(length(o[[1]]), 4L) } # The following tests are too slow for CRAN and skipped skip_on_cran() # this is very slow see we only do 10 iterations if(seriation:::check_installed("GA", "check")) { register_GA() o <- seriate(d, "GA", maxiter = 10, parallel = FALSE, verb = F) expect_equal(length(o[[1]]), 4L) } # Notes: # * This produces too many messages # * Python (keras) leaves some files in temp and that upsets CRAN skip() # only do 10 epochs. if(seriation:::check_installed("keras", "check")) { suppressMessages({ register_vae() o <- seriate(d, "VAE", epochs = 10) }) expect_equal(length(o[[1]]), 4L) o <- seriate(x, "VAE", epochs = 10) expect_equal(length(o[[1L]]), 4L) expect_equal(length(o[[2L]]), 5L) } seriation/tests/testthat/test-criterion.R0000644000176200001440000000506314706524257020367 0ustar liggesuserslibrary(seriation) m <- matrix(c( 1,1,0,0,0, 1,1,1,0,0, 0,0,1,1,1, 1,0,1,1,1 ), byrow=TRUE, ncol=5) d <- dist(m) as.matrix(d) context("criterion") expect_equal(criterion(d,method="AR_events"), structure(2, names="AR_events")) ## 2 expect_equal(criterion(d,method="Path_length"), structure(4, names="Path_length")) ## 1+2+1=4 expect_equal(criterion(d,method="Lazy_path_length"), structure(8, names="Lazy_path_length")) ## (4-1)*1 + (4-2)*2+ (4-3)*1 = 8 expect_true(zapsmall(round(criterion(d, method="AR_deviations"), 6) - 0.504017) == 0) ## 2.000000 - 1.732051 + 2.236068 - 2.000000 = 0.504017 expect_equal(criterion(d, method="Gradient_raw"), structure(4,names="Gradient_raw")) ## 6 - 2 = 4 expect_true(zapsmall(round(criterion(d, method="Gradient_weighted"), 6) - 3.968119) == 0) ## -1 *(1.000000 - 2.236068 + 1.000000 - 2.000000 + 2.236068 - 2.000000 + 2.000000 - 1.732051 + 1.000000 - 1.732051 + 1.000000 - 2.000000 + 1.732051 - 2.000000 + 2.000000 - 2.236068) ## = 3.968119 ## test stress expect_equal(round(criterion(d, method="Neumann"), 3), structure(7.787, names="Neumann_stress")) expect_equal(round(criterion(d, method="Moore"), 3), structure(11.539, names="Moore_stress")) expect_equal(criterion(m, method="Neumann"), structure(22, names="Neumann_stress")) expect_equal(criterion(m, method="Moore"), structure(44, names="Moore_stress")) ## RGAR ## for w = 2 -> 1/4 ## for w = 3 -> 2/8 expect_error(criterion(d, method="RGAR", w=1)) expect_error(criterion(d, method="RGAR", w=4)) expect_equivalent(criterion(d, method="RGAR", pct=0), .25) expect_equivalent(criterion(d, method="RGAR", w=2), .25) expect_equivalent(round(criterion(d, method="RGAR", pct=100), 3), .25) expect_equivalent(round(criterion(d, method="RGAR", w=3), 3), .25) expect_equivalent(criterion(d, method="RGAR", w=3, relative = FALSE), 2) ### BAR expect_error(criterion(d, method="BAR", b=0), "Band") expect_error(criterion(d, method="BAR", b=4), "Band") # b=1 -> Ham. path length expect_equivalent(criterion(d, method="BAR", b=1), criterion(d, method="Path_length")) # b = n-1 -> ARc expect_equivalent(round(criterion(d, method="BAR", b=3), 3), 21.936) ### Cor R m <- diag(100) expect_equivalent(criterion(m, method="Cor_R"), 1.0) expect_equivalent(criterion(m[nrow(m):1,], method="Cor_R"), -1.0) # this should be close to 0 set.seed(1234) r <- replicate(100, criterion(m[sample(nrow(m)),], method="Cor_R")) # hist(r) expect_true(abs(mean(r)) < 0.1) # test for data.frame and table expect_equal(criterion(as.data.frame(m)), criterion(m)) expect_equal(criterion(as.table(m)), criterion(m)) seriation/tests/testthat/test-seriate.R0000644000176200001440000002613214723702044020014 0ustar liggesusers### NOTE: disabled snapshot testing since the direction of the order is not defined and randomized ### for some methods. library(seriation) library(testthat) extra_integer <- NULL extra_hclust <- NULL if(seriation:::check_installed("DendSer", "check")) { register_DendSer() extra_hclust <- append(extra_hclust, c("DendSer", "DendSer_ARc", "DendSer_BAR", "DendSer_LPL", "DendSer_PL")) } if(seriation:::check_installed("umap", "check")) { extra_integer <- append(extra_integer, "umap") register_umap() } x <- matrix( c(1, 1, 0, 0, 0, 1, 1, 1, 0, 0, 0, 0, 1, 1, 1, 1, 0, 1, 1, 1), byrow = TRUE, ncol = 5, dimnames = list(letters[1:4], LETTERS[1:5]) ) d <- dist(x) x0 <- matrix(NA, nrow = 0, ncol = 0) d0 <- dist(x0) x1 <- rbind(c(1,2,3)) d1 <- dist(x1) test_that("test if seriate.dist returns expected results", { if (interactive()) cat("\n seriate dist\n") # for cleaner testthat output methods <- list_seriation_methods(kind = "dist") ### insufficient data for metaMDS methods <- setdiff(methods, "metaMDS") os <- sapply(methods, function(m) { if (interactive()) cat(" -> testing", format(m, width = 13), "... ") # check 0 and 1 objects expect_error(o <- seriate(d0, method = m)) o <- seriate(d1, method = m) expect_length(0, 1L) # check example with timing tm <- system.time(o <- seriate(d, method = m)) if (interactive()) cat("took", formatC(tm[3], digits = 4), "s.\n") o }) # make sure they are all the right length expect_true(all(sapply(os, length) == nrow(x))) # check which methods produce hclusts and which integers hclusts <- os[sapply(os, function(x) inherits(x, "hclust"))] expect_setequal( object = names(hclusts), expected = c( "GW", "GW_average", "GW_complete", "GW_single", "GW_ward", "HC", "HC_average", "HC_complete", "HC_single", "HC_ward", "OLO", "OLO_average", "OLO_complete", "OLO_single", "OLO_ward", extra_hclust ) ) integers <- os[sapply(os, is.integer)] expect_setequal( object = names(integers), expected = c( "ARSA", "Enumerate", "BBURCG", "BBWRCG", "Identity", "MDS", "MDS_angle", # "metaMDS", "monoMDS", "isomap", "isoMDS", "Sammon_mapping", "QAP_2SUM", "QAP_BAR", "QAP_Inertia", "QAP_LS", "R2E", "Random", "Reverse", "GSA", "SGD", "Spectral", "Spectral_norm", "SPIN_NH", "SPIN_STS", "TSP", "VAT", extra_integer ) ) expect_setequal(c(names(hclusts), names(integers)), expected = names(os)) # check all orders are integers ORDERS <- sapply( X = os, FUN = get_order, dim = 1, simplify = FALSE ) for (o in ORDERS) { expect_type(o, "integer") expect_mapequal(o, expected = c( a = 1, b = 2, c = 3, d = 4 )) expect_type(names(o), "character") } # check $labels of hclust seriation vectors remain in original input order for (n in names(hclusts)) { expect_equal(hclusts[[n]][["labels"]], expected = letters[1:4]) } # check names of get_order() equal to ordered labels for (n in names(hclusts)) { expect_equal(object = names(ORDERS[[n]]), expected = hclusts[[n]][["labels"]][hclusts[[n]][["order"]]]) } # check snapshot of some deterministic methods deterMethods <- c( "BBURCG", "BBWRCG", "GW", "GW_average", "GW_complete", "GW_single", "GW_ward", "HC", "HC_average", "HC_complete", "HC_single", "HC_ward", "Identity", "MDS", "isoMDS", "Sammon_mapping", # this use eigen() which gives slightly different results for OpenBLAS and M1 architecture "MDS_angle", #"R2E", "Spectral", "Spectral_norm", "VAT" ) # recreate with dput(lapply(os[deterMethods], get_order)) correct <- list( BBURCG = c( a = 1L, b = 2L, d = 4L, c = 3L ), BBWRCG = c( a = 1L, b = 2L, d = 4L, c = 3L ), GW = c( a = 1L, b = 2L, d = 4L, c = 3L ), GW_average = c( a = 1L, b = 2L, d = 4L, c = 3L ), GW_complete = c( a = 1L, b = 2L, d = 4L, c = 3L ), GW_single = c( a = 1L, b = 2L, d = 4L, c = 3L ), GW_ward = c( a = 1L, b = 2L, d = 4L, c = 3L ), HC = structure(1:4, names = c("a", "b", "c", "d")), HC_average = structure(1:4, names = c("a", "b", "c", "d")), HC_complete = structure(1:4, names = c("a", "b", "c", "d")), HC_single = structure(1:4, names = c("a", "b", "c", "d")), HC_ward = structure(1:4, names = c("a", "b", "c", "d")), Identity = structure(1:4, names = c("a", "b", "c", "d")), MDS = c( a = 1L, b = 2L, d = 4L, c = 3L ), isoMDS = c( a = 1L, b = 2L, d = 4L, c = 3L ), Sammon_mapping = c( a = 1L, b = 2L, d = 4L, c = 3L ), MDS_angle = c( a = 1L, b = 2L, d = 4L, c = 3L ), R2E = c( c = 3L, d = 4L, b = 2L, a = 1L ), Spectral = c( c = 3L, d = 4L, b = 2L, a = 1L ), Spectral_norm = c(c = 3L, d = 4L, b = 2L, a = 1L), VAT = c(c = 3L, d = 4L, b = 2L, a = 1L)) # Notes: # * some systems may produce the reverse order for some methods! # * ARM-based M1 systems produce different results for eigenvalues. # This is not an error, just a numerical difference. We skip that test for now. #skip_on_os("mac", arch = "aarch64") for (m in deterMethods) expect_true( identical(correct[[m]], get_order(os[[m]])) || identical(correct[[m]], rev(get_order(os[[m]]))), label = paste("Seriation method", m, "does not return the correct order!\n") ) # make sure they are all the right length expect_true(all(sapply(os, length) == nrow(x))) }) # check seriate errors for bad dist objects test_that("test if negative distances and NAs prompt correct seriate.dist errors", { dNeg <- d dNeg[1] <- -1 expect_error(seriate(dNeg), "Negative distances not supported") dNA <- d dNA[1] <- NA expect_error(seriate(dNA), "NAs not allowed in distance matrix x") }) test_that("test if dist objects without Diag or Upper attributes can be permuted", { # eurodist is an object of class dist from built in R package "datasets" expect_s3_class(eurodist, "dist") expect_identical(attr(eurodist, "Diag"), NULL) expect_identical(attr(eurodist, "Upper"), NULL) s <- seriate(eurodist, method = "MDS") expect_s3_class(p <- permute(eurodist, order = s), "dist") expect_false(attr(p, "Diag")) # permutation adds Diag, is this desirable? expect_false(attr(p, "Upper")) expect_equal(labels(p), names(get_order(s))) }) ### Stress test to find memory access problems with randomized algorithms #context("memory stress test") #replicate(1000, seriate(d, method="bburcg")) #replicate(1000, seriate(d, method="bbwrcg")) #replicate(1000, seriate(d, method="arsa")) test_that("test if seriate.matrix returns expected results", { #local_edition(3) # for snapshot testing if (interactive()) cat("\n seriate matrix\n") # for cleaner testthat output methods <- list_seriation_methods(kind = "matrix") ### AOE is for symmetric correlation matrices methods <- setdiff(methods, "AOE") os <- sapply(methods, function(m) { if (interactive()) cat(" -> testing", format(m, width = 13), "... ") # check with 0 and 1 objects expect_error(o <- seriate(x0, method = m)) # need at least 2x2 matrix if (m %in% c("PCA_angle", "umap")) expect_error(o <- seriate(x1, method = m)) else o <- seriate(x1, method = m) tm <- system.time(o <- seriate(x, method = m)) if (interactive()) cat("took", formatC(tm[3], digits = 4), "s.\n") o }, simplify = FALSE) # check number and length of orders expect_true(all(sapply(os, length) == 2L)) expect_true(all(sapply( os, FUN = function(o2) sapply(o2, length) ) == c(4L, 5L))) x_p <- permute(x, os[[1]]) # BEA method expect_equal(x_p, x[get_order(os[[1]], 1), get_order(os[[1]], 2)]) # check labels expect_equal(get_order(os$Identity, 1), c( a = 1, b = 2, c = 3, d = 4 )) expect_equal(get_order(os$Identity, 2), c( A = 1, B = 2, C = 3, D = 4, E = 5 )) expect_equal(get_order(os$Reverse, 1), c( d = 4, c = 3, b = 2, a = 1 )) expect_equal(get_order(os$Reverse, 2), c( E = 5, D = 4, C = 3, B = 2, A = 1 )) # check snapshot of some deterministic methods #deterMethods <- c("CA", "Identity", "PCA", "PCA_angle", "Reverse") #expect_snapshot(str(os[deterMethods])) }) test_that("test if seriate.matrix with margin returns expected results", { #local_edition(3) # for snapshot testing if (interactive()) cat("\n seriate matrix with margin\n") # for cleaner testthat output methods <- list_seriation_methods(kind = "matrix") ### AOE is for symmetric correlation matrices methods <- setdiff(methods, "AOE") os <- sapply(methods, function(m) { if (interactive()) cat(" -> testing", format(m, width = 13), "... ") tm <- system.time(o <- seriate(x, method = m, margin = 2)) if (interactive()) cat("took", formatC(tm[3], digits = 4), "s.\n") o }, simplify = FALSE) expect_true(all(sapply(os, length) == 2L)) expect_true(all(sapply( os, FUN = function(o2) o2[[1]] ) == 1:4)) expect_true(all(sapply( os, FUN = function(o2) length(o2[[2]]) == 5L ))) x_p <- permute(x, os[[1]], margin = 2) expect_equal(x_p, x[, get_order(os[[1]], 2)]) }) test_that("test if data.frame seriation works as expected", { #local_edition(3) # for snapshot testing df <- as.data.frame(x) o <- seriate(df) expect_silent(permute(df, o)) # defaults work with no messages/warnings expect_warning( permute(df, o[1]), # DEPRECATED: results in a message "permute for data.frames with a single seriation order is now deprecated" ) o <- seriate(df, margin = 1) expect_equal(as.integer(o[[2]]), 1:5) # columns left in original order oPCA <- seriate(df, method = "PCA") #expect_snapshot(permute(df, oPCA)) }) test_that("test if optimizes in registry is a valid criterion", { methods <- list_seriation_methods(names_only = FALSE) expect_no_error({ for (kind in names(methods)) for (m in methods[[kind]]) if (!is.na(m$optimizes)) get_criterion_method(kind, name = m$optimizes) }) }) seriation/tests/testthat/test-permuation_vector.R0000644000176200001440000000726114706524257022140 0ustar liggesuserslibrary(testthat) library(seriation) library(dendextend) ## Needed because it redefined all.equal for dendrograms set.seed(0) context("ser_permutation_vector") p <- sample(10) names(p) <- paste0("X", p) sp <- ser_permutation_vector(p, method="valid") expect_identical(length(sp), 10L) expect_identical(get_order(sp), p) expect_identical(get_order(rev(sp)), rev(p)) expect_identical(get_rank(sp), structure(order(p), names = names(p)[order(p)])) expect_error(ser_permutation_vector(c(1:10, 12L), method="invalid"), "Invalid permutation vector!") expect_error(ser_permutation_vector(c(1:10, 3L), method="invalid"), "Invalid permutation vector!") context("ser_permutation") expect_identical(length(ser_permutation(sp)), 1L) expect_identical(length(ser_permutation(sp, sp)), 2L) hc <- hclust(dist(runif(10))) expect_identical(length(ser_permutation(sp, hc)), 2L) hc <- ser_permutation_vector(hc, method="hc") expect_identical(length(ser_permutation(sp, hc, sp)), 3L) expect_identical(length(ser_permutation(ser_permutation(sp), 1:10)), 2L) context("permute") ## vector v <- structure(1:10, names = LETTERS[1:10]) expect_identical(permute(v, ser_permutation(1:10)), v[1:10]) expect_identical(permute(LETTERS[1:10], ser_permutation(1:10)), LETTERS[1:10]) expect_identical(permute(v, ser_permutation(10:1)), v[10:1]) expect_identical(permute(LETTERS[1:10], ser_permutation(10:1)), LETTERS[10:1]) expect_error(permute(v, ser_permutation(1:11))) ## matrix m <- matrix(runif(9), ncol=3, dimnames = list(1:3, LETTERS[1:3])) expect_identical(permute(m, ser_permutation(1:3, 3:1)), m[,3:1]) expect_identical(permute(m, ser_permutation(3:1, 3:1)), m[3:1,3:1]) expect_error(permute(m, ser_permutation(1:10, 1:9))) expect_error(permute(m, ser_permutation(1:9, 1:11))) expect_identical(permute(m, ser_permutation(3:1, 3:1), margin = 1), m[3:1, ]) expect_identical(permute(m, ser_permutation(3:1, 3:1), margin = 2), m[ , 3:1]) expect_identical(permute(m, ser_permutation(3:1), margin = 1), m[3:1, ]) expect_identical(permute(m, ser_permutation(3:1), margin = 2), m[, 3:1]) ## data.frame df <- as.data.frame(m) expect_identical(permute(df, ser_permutation(1:3, 3:1)), df[,3:1]) expect_identical(permute(df, ser_permutation(3:1, 3:1)), df[3:1,3:1]) ## dist d <- dist(matrix(runif(25), ncol=5)) attr(d, "call") <- NULL ### permute removes the call attribute expect_identical(permute(d, ser_permutation(1:5)), d) ### is_equivalent_to ignores attributes expect_equivalent(permute(d, ser_permutation(5:1)), as.dist(as.matrix(d)[5:1,5:1])) expect_error(permute(d, ser_permutation(1:8))) ## list l <- list(a = 1:10, b = letters[1:5], 25) expect_identical(permute(l, 3:1), rev(l)) ## dendrogram ## FIXME: order.dendrogram in stats adds attribute value so I use ## check.attributes = FALSE, but dendrograms use attributes a lot so ## the check may be pointless dend <- as.dendrogram(hclust(d)) expect_equal(dend, permute(dend, get_order(dend)), ignore_attr = TRUE) expect_equal(rev(dend), permute(dend, rev(get_order(dend))), ignore_attr = TRUE) # chances are that a random order will not be perfect o <- sample(5) expect_warning(permute(dend, o)) ## hclust hc <- hclust(d) expect_equal(hc, permute(hc, get_order(hc))) ## Note: rev for hclust adds labels! (So we only compare merge, height and order) #expect_equal(rev(hc), permute(hc, rev(get_order(hc)))) expect_equal(as.hclust(rev(as.dendrogram(hc)))[1:3], permute(hc, rev(get_order(hc)))[1:3]) expect_warning(permute(hc, o)) context("permutation_matrix2vector") pv <- 1:5 pm <- permutation_vector2matrix(pv) expect_true(all(diag(pm) == 1)) pv <- sample(1:100) ## convert into a permutation matrix pm <- permutation_vector2matrix(pv) ## convert back expect_identical(permutation_matrix2vector(pm), pv) seriation/tests/testthat/test-map.R0000644000176200001440000000132414706524257017142 0ustar liggesuserslibrary(seriation) library(testthat) context("map") map <- seriation:::map v <- 0:10 expect_equal(map(v), seq(0, 1, length.out = length(v))) expect_equal(map(v, range = c(100,200)), seq(100, 200, length.out = length(v))) expect_equal(map(v, range = c(200,100)), seq(200, 100, length.out = length(v))) expect_error(map(v, from.range = c(200,100))) expect_error(map(v, from.range = c(0, 5, 10))) expect_equal(map(rep.int(1, 10)), rep(.5, 10)) m <- outer(0:10, 0:10, "+") expect_equal(map(m), outer(seq(0, 1, length.out = 11), seq(0, 1, length.out = 11), "+") / 2) context("map_int") map_int <- seriation:::map_int expect_identical(map_int(v, range = c(-100, 100)), as.integer(seq(-100, 100, length.out = length(v)))) seriation/tests/testthat/test-dissimilarity.R0000644000176200001440000000360214706524257021254 0ustar liggesuserslibrary(seriation) library(testthat) ## FIXME add tests for ser_align set.seed(0) x <- list( a = 1:100, b = 100:1, c = sample(100), d = sample(100) ) context("ser_dist") ## Default is Spearman ## first two are equal with reverse d <- ser_dist(x) expect_true(all(d >= 0)) expect_equal(d[1], 0) ## first two are largest distance (2) w/o reverse d_norev <- ser_dist(x, reverse = FALSE) expect_true(all(d_norev >= 0)) expect_equal(d_norev[1], 2) ## x,y interface d <- ser_dist(x[[1]], x[[2]]) expect_equal(d[1], 0) ## Manhattan is 100 times 50 difference d <- ser_dist(x, method = "Manhattan", reverse = FALSE) expect_true(all(d >=0)) expect_equal(d[1], 100*50) d <- ser_dist(x, method = "Manhattan") expect_true(all(d >=0)) expect_equal(d[1], 0) ## Hamming is 100 d <- ser_dist(x, method = "Hamming", reverse = FALSE) expect_true(all(d >=0)) expect_equal(d[1], 100) d <- ser_dist(x, method = "Hamming") expect_true(all(d >=0)) expect_equal(d[1], 0) ## PPC (reverse has no effect on PPC) d <- ser_dist(x, method = "PPC") expect_true(all(d >=0)) expect_equal(d[1], 0) ## test correlations context("ser_cor") ## Default is Spearman ## sequence with its reverse co <- ser_cor(x[[1]], x[[2]], reverse = FALSE) expect_equal(co, rbind(c(1,-1), c(-1,1))) co <- ser_cor(x, reverse = FALSE) expect_identical(dim(co), rep(length(x), 2)) expect_true(all(co >=-1 & co <=1)) expect_equivalent(co[1:2,1:2], rbind(c(1,-1), c(-1,1))) co <- ser_cor(x) expect_true(all(co >=-1 & co <=1)) expect_equivalent(co[1:2,1:2], rbind(c(1,1), c(1,1))) ### PPC co <- ser_cor(x, method ="PPC") expect_true(all(co >=-1 & co <=1)) expect_equivalent(co[1:2,1:2], rbind(c(1,1), c(1,1))) ## test p-value co <- ser_cor(x, test = TRUE) expect_equivalent(attr(co, "p-value")[1:2,1:2], matrix(0, nrow=2, ncol=2)) co <- ser_cor(x, reverse = TRUE, test = TRUE) expect_equivalent(attr(co, "p-value")[1:2,1:2], matrix(0, nrow=2, ncol=2)) seriation/tests/testthat.R0000644000176200001440000000010214203251670015365 0ustar liggesuserslibrary("testthat") library("seriation") test_check("seriation") seriation/MD50000644000176200001440000002043614724371602012572 0ustar liggesusersb405738c0165d6cff01228d9772e8410 *DESCRIPTION aba60632f470eb6961688c20862a7d08 *NAMESPACE 416421b99dbb48365ebbaf261a52cd27 *NEWS.md d2573287b5979e7154ae86315123ee82 *R/AAA_check_installed.R ca60bb719fad9b4f7aedcb7c4bd55d2b *R/AAA_color_palette.R 356dd4c05eeda14cb5d82c0363775f11 *R/AAA_defaults.R 2a5188bd32cc14b9af961474326c2c7f *R/AAA_map.R c954259024b57877e97b16078861810c *R/AAA_parameters.R 7e3c72a3d4b885bb1e92a98ef06d317b *R/AAA_registry_criterion.R 9a247919388f80bbc7fb365171cb259b *R/AAA_registry_seriate.R c6e038ecd7ac07c6c9f1920a17b7f1b6 *R/AAA_seriation-package.R e2b12f10fa4743e4caa85efcaa2c7519 *R/Chameleon.R 868b1ae1b62abdacb22bca6c8be670b1 *R/Irish.R 539000b38f7f0db4ba117a0d5fbdeba4 *R/Munsingen.R 6d136ef3095c693010c121b69a88cff3 *R/Psych24.R 5ab47b238b5a37060f0afd1f9609345e *R/SupremeCourt.R d2b34365b3fdee65f789e421ff850e9e *R/Townships.R 3fb8aa35ca9d6cf5a86853bae3504401 *R/VAT.R aac9601d86df7af0ca23916a59ec4177 *R/Wood.R 9d63469253a2a569d4b52d1706bca044 *R/Zoo.R 092ffeaa4d61636fc395dec8df278c9b *R/bertinplot.R 901a5e494f966eebba114c52e97e74bc *R/criterion.R 9c781b1d0ac4f1368ab809473233db77 *R/criterion.array.R abc511e93129a605c9c69a57c21c6eec *R/criterion.dist.R 3894e871b6a23d9d647c9091e7165eaa *R/criterion.matrix.R 84eb8ce41c9bd056f138f302c19a9e32 *R/dissplot.R 216dc0b033f56cfe27241d483ccfd796 *R/get_order.R 57328ee8e4b7731f047da01fc0087f2d *R/ggVAT.R 60c2fd96da7fadbceb5a4187e002e4c9 *R/ggbertinplot.R a16c65981b5ceb559051ce3f67326468 *R/ggdissplot.R ad973f45b8977d15f5676fb0495f1b54 *R/gghmap.R 2b899c5e25d1f47007c5f0a441d2c8c8 *R/ggpimage.R c7b45baade6c4a3577561341539f9eab *R/grid_helpers.R 334b02d02c9621df149886412ece25b9 *R/hmap.R 8dbf63ad1c1e7648eb1399e0165348c0 *R/lines_and_ordered_data.R 67d332dcfddddb6dea2fa0460666e561 *R/lle.R a7f48b5716365f943cd4143bc3f12ef3 *R/permute.R 05bc387d63c91d5609ae09801e958226 *R/pimage.R 5705a5152f32a95496d49f92aa5ec3d2 *R/register_DendSer.R 9deb7480fa40d6952424a1271455902d *R/register_GA.R dcec18a2f87d9458fe474c4acdc9f30c *R/register_optics.R d645937c41697cc66bc909a625ea7329 *R/register_smacof.R 0a87bd49cdfb6d4577ab9cb1c8a53e58 *R/register_tsne.R f53ae52ac233f04d8d1c2db0ed4000e6 *R/register_umap.R 504c17da715ed1d7368c03a37c498201 *R/reorder.hclust.R 047d6273ce713dbcab8d48e5ae3f2c0d *R/robinson.R fc5b639b95d8b26caf1be2371c6a0cf8 *R/ser_dist.R e6c5f1d8cc543ddd85f9bb67d798cf2d *R/ser_permutation.R 71bee9922fb20d0e6ddba1b997757b24 *R/ser_permutation_vector.R 052d53c50f89f4a1ecce13af698d0e72 *R/ser_permutation_vector2matrix.R cfc48fed866f695ffb3c900f14ca91bb *R/seriate.R b088f6caa3a6a6d858b6793114fb6bcc *R/seriate.array.R 61a9f21eab45b27574b8f757e0acf4ce *R/seriate.data.frame.R 74efde08904877968ba102cd1d6203b1 *R/seriate.dist.R b32506e27e61d6b8994da91f8f79e6e6 *R/seriate.matrix.R 4d1b21ca87facc2a1c3fcf19aa151a19 *R/seriate.table.R fc066cf143398bb0c470ccf3851e9062 *R/seriate_AOE.R 16b1c717987b4300de37963090783a12 *R/seriate_ARSA_Branch-Bound.R ec6b76e8f94daa609bb90380eb6b5266 *R/seriate_BEA.R 9409172a9fc4c66d236660da87c18780 *R/seriate_BK.R d6e9054ec0d4c0b153cd7d53bbe837e4 *R/seriate_CA.R 755aba67e245b8a01b9e642f0c53447c *R/seriate_GSA.R 0756c0b125ab088dadeb7b3ada12f635 *R/seriate_HC.R c21abd5c18c9f1d76adbecd92ac9ffe8 *R/seriate_LLE.R 01d8ddbbab0fac60fa1871bc47e9d934 *R/seriate_MDS.R 2af06a2a15960991d2200235b6fd3636 *R/seriate_Mean.R 97b632e9cc81b6375f20ee0ef636d2da *R/seriate_PCA.R 2dfa1515b3447f3b7a58b0ed82a8d11b *R/seriate_QAP.R bf981f04c36f35c5df7de5286ea41fbf *R/seriate_R2E.R 220836cd994c20cfda87b3d12a9cdce0 *R/seriate_SGD.R d2ccd4308b6567a22f6c0c3c852960f2 *R/seriate_SPIN.R c899f262f9aa831495ac212e7fc7b04f *R/seriate_TSP.R 8ea17dfc9720865576f0b54daaef2363 *R/seriate_VAT.R 1912ff296c12a221a83fc4141711d4fd *R/seriate_best.R f05bb91e9c8708422951543973654efe *R/seriate_enumerate.R cb1b320fe165d064d01ddcf097682c9b *R/seriate_heatmap.R a1c781ca89906c41849f32bdfeca3b32 *R/seriate_identity.R 8878efdedfbf36a39df595393bf36932 *R/seriate_random.R cafbe8cc1602cd87b9bfb479d71ec183 *R/seriate_reverse.R f0d68c865e4ffaaa31e01a350c1e03d9 *R/seriate_spectral.R 4f95b5c084deaba14d6f090a47d52ea8 *R/seriate_vegan.R cc2568a6b382114feeb96ff9ce9558b5 *R/uniscale.R d646688325e2ff63f774ab560617f76a *README.md 76161b65639451c966be75488458b3c3 *build/partial.rdb 1a20f63b07a297984dd4cf4db02dc338 *build/vignette.rds 4f812e82bf45b34f8864e5cbbdd899e3 *data/Chameleon.rda 906d0bca2aedd0b37beaadb7a72e0e27 *data/Irish.rda af710936ee1f7dfa741e92b3a4db299f *data/Munsingen.rda 95b83c0665fba53e965c9f72bc02f696 *data/Psych24.rda e4ee428e26e80ce891fc72b1e3c41a54 *data/SupremeCourt.rda 2148e15ce50dd04ff7e8e144f3ebd20a *data/Townships.rda 443babf28bdc6f8d44c9afaa77829d04 *data/Wood.rda 691665da705f9af86930fdb1e4bd54e7 *data/Zoo.rda ad01d7162356369ccc5df016b3193527 *inst/CITATION 8b73aa25ca7cae2a620461f99e3aac22 *inst/README_files/configuration-1.png 966f123273aeef89b1bda347842f809d *inst/README_files/seriation-1.png e207ec176b49e825c0b507db73a5d690 *inst/README_files/seriation-2.png f1e76996d5bf0d0442cf16387ed5a260 *inst/doc/seriation.R 55763418c0359cdd507796bb8eb5192f *inst/doc/seriation.Rnw 3fb75f57f2a5d279f5182ec72fe5ab4b *inst/doc/seriation.pdf 56a4967cd38248d5b3dbcdcda17179dc *man/Chameleon.Rd f4f94a9ec04a357dc920be1397edca38 *man/Irish.Rd 3156e2ddf2eea5a3d7ea496a4368b463 *man/LS.Rd 5fe634b238b35a67a31bf51e0b04a5dc *man/Munsingen.Rd 58038905af1d1e376153f1a881e3f41d *man/Psych24.Rd 7a90237a1731c3561040cc3b8b592847 *man/SupremeCourt.Rd 1c9b2a97b0ff187f14252fece261ba5e *man/Townships.Rd 60544a0b859951900d4c46dc8e508f6c *man/VAT.Rd 73c7cfc925431aaa92bf3c64de797655 *man/Wood.Rd 5e2217df1d2d60ed8edcf5ef0771f3c5 *man/Zoo.Rd 28979067d6425076abdcc296e841ce4f *man/bertinplot.Rd f9a3a8e358e6a2171f27159d08ad6eb4 *man/create_lines_data.Rd 399be4651784c6c58904e806b7e72904 *man/criterion.Rd 111da54e6f58c336545e58083f076935 *man/dissplot.Rd c8949f771feb3a28e677ed9c369b2eb5 *man/figures/logo.svg 0fd8ee64e3568dbff3fa9e9880ae4750 *man/get_order.Rd 8e1a5014c68ce2c4219bda80e4c15539 *man/hmap.Rd 10d5ad032d6dbca8e6c564d6e0eaf5ed *man/is.robinson.Rd 66429c502068b3078d87ba7dcee0b4a9 *man/lle.Rd 6fafe4d95bb5835a717ff112f95eebaf *man/palette.Rd 6f71dd5ce181c294565efa78717d2a3d *man/permutation_vector2matrix.Rd ac56dbb9aa0ebd7098047bcce39e6494 *man/permute.Rd 6d2399fd78465637dcb807b4e692a38b *man/pimage.Rd 3ee9042163e4771465038ac5526d0ca7 *man/register_DendSer.Rd 4214675273ce584e48806c1df190dc9f *man/register_GA.Rd 3ac93a9ee9edf4ffd416191bdfd4e301 *man/register_optics.Rd 83eb068c0e8d2e787008e4d5a4d25bbb *man/register_smacof.Rd 3a2f89b71e3f593df499f1e302d2feaf *man/register_tsne.Rd 73b1bfc75c8155475d0f3e6f2b50d24a *man/register_umap.Rd 8fff6d16ecfd83be1b9a77f135382c30 *man/registry_for_criterion_methods.Rd 41b072124d832dae20c17ba2b979530e *man/registry_for_seriation_methods.Rd b0088fd373a2ee966f3cdb065ac6d494 *man/reorder.hclust.Rd 9e0514c007427c880296d2038b3af06a *man/ser_dist.Rd 37ed59f7817214f47cc8d35d285dcba9 *man/ser_permutation.Rd 2a5bf2fed1029cab3ed7d298f1b79520 *man/ser_permutation_vector.Rd be43fb651c8dfaa5206da5f42ad66a09 *man/seriate.Rd 7f11065c5a6a49efd270ebc1683083e9 *man/seriate_best.Rd c76b1e61be8fd2805abb733d404b4a23 *man/seriation-package.Rd 5e0ca8ac0c1d6a0c6a13f14c96e653a3 *man/uniscale.Rd dd4b979a72ea89fe013a9361bbab8526 *src/RNG_wrapper.c 26855e39732a907da8f87a8ea6fa101d *src/arsa.f 821afcc7f36b26b120cde12188f4e42e *src/bburcg.f ce5578e725f57ca6638efa034ce7f7b4 *src/bbwrcg.f 52b72e0f6c89df2d95b8d829425b5afa *src/criterion.c 26fb5e4885dc70097cc892e669964681 *src/dist.c a7602ecb2b2ab1701066b5fe3cebbb9b *src/init.c 1032823bb8bde404514d57f2575481b5 *src/lt.h 3be5cbf0956a78e67d099820e1ef55fc *src/nextperm.c e41139c44b6ae24b03fd76c6c95baea6 *src/optimal.c bc783b7ad9e91cdebb4d31ca80d9573a *src/pathdist.c 156ad4e438205d93941cc46a053842c1 *src/stress.c 4810997a63ce3eee7a2d3dddd06a05ca *tests/testthat.R 6da8e6a3e48d06a9f37097b2ae38cd68 *tests/testthat/test-criterion.R f8db49b2ece831c6ce453b62e23b91ef *tests/testthat/test-dissimilarity.R 864f3f7170c4b5a0c45de4aad8a90234 *tests/testthat/test-map.R c9d38611954c03ce316aafd6d38c8f59 *tests/testthat/test-permuation_vector.R 26a3a23b0435ae8ec344e5cda9b5a4fa *tests/testthat/test-seriate.R bf6492dc1a7c991b5499cb67143597eb *tests/testthat/test-zzz_seriate_extra.R b59872d48cf446767be0c79dae8900f8 *vignettes/classes.odg 7f67ca8c5483222bc0a154258388db86 *vignettes/classes.pdf 55763418c0359cdd507796bb8eb5192f *vignettes/seriation.Rnw 17446bf1c953326c0ee62c31ceae93cf *vignettes/seriation.bib seriation/R/0000755000176200001440000000000014720714416012456 5ustar liggesusersseriation/R/register_optics.R0000644000176200001440000000504614706524256016020 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (C) 2015 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. #' Register Seriation Based on OPTICS #' #' Use ordering points to identify the clustering structure (OPTICS) for [seriate()]. #' #' Registers the method `"optics"` for [seriate()]. This method applies #' the OPTICS ordering algorithm implemented in [`dbscan::optics()`] to create an ordering. #' #' **Note:** Package \pkg{dbscan} needs to be installed. #' #' @aliases register_optics optics OPTICS #' @seealso [dbscan::optics()]. #' @family seriation #' @returns Nothing. #' #' @references Mihael Ankerst, Markus M. Breunig, Hans-Peter Kriegel, Joerg #' Sander (1999). OPTICS: Ordering Points To Identify the Clustering Structure. #' _ACM SIGMOD international conference on Management of data,_ ACM Press, pp. #' 49-60. \doi{10.1145/304181.304187} #' @keywords optimize cluster #' @examples #' #' \dontrun{ #' register_optics() #' get_seriation_method("dist", "optics") #' #' d <- dist(random.robinson(50, pre=TRUE, noise=.1)) #' #' o <- seriate(d, method = "optics") #' pimage(d, o) #' } #' #' @export register_optics <- function() { check_installed("dbscan") .contr <- structure( list(eps = NULL, minPts = 5), help = list(eps = "upper limit of the size of the epsilon neighborhood (see ? optics)" , minPts = "minimum density for dense neighborhoods") ) optics_order <- function(x, control) { control <- .get_parameters(control, .contr) control$minPts <- min(control$minPts, attr(x, "Size")) dbscan::optics(x, eps = control$eps, minPts = control$minPts)$order } set_seriation_method( "dist", "optics", optics_order, "Use ordering points to identify the clustering structure (OPTICS) to create an order", .contr, verbose = TRUE ) } seriation/R/get_order.R0000644000176200001440000000762514706524256014572 0ustar liggesusers#' Extracting Order Information from a Permutation Object #' #' Method to get the order information from an object of class #' [ser_permutation] or [ser_permutation_vector]. Order information #' can be extracted as a permutation vector, a vector containing each #' object's rank or a permutation matrix. #' #' `get_order()` returns the permutation as an integer vector which arranges the #' objects in the seriation order. That is, a vector with the index of the first, #' second, \eqn{..., n}-th object in the order defined by the permutation. #' These permutation vectors can directly be #' used to reorder objects using subsetting with `"["`. \emph{Note:} In #' \pkg{seriation} we usually use these order-based permutation vectors. #' **Note on names:** While R's [order()] returns an unnamed vector, #' `get_order()` returns names (if available). The names are the object label #' corresponding to the index at that position. #' Therefore, the names in the order are in the order after #' the permutation. #' #' `get_rank()` returns the seriation as an integer vector containing the #' rank/position for each objects after the permutation is applied. #' That is, a vector with the position of the first, second, #' \eqn{..., n}-th object after permutation. Note: Use #' `order()` to convert ranks back to an order. #' #' `get_permutation_matrix()` returns a \eqn{n \times n}{n x n} permutation #' matrix. #' #' @family permutation #' #' @param x an object of class [ser_permutation] or #' [ser_permutation_vector]. #' @param dim order information for which dimension should be returned? #' @param ... further arguments are ignored for `get_order()`. For #' `get_rank()` and for `get_permutation_matrix()` the additional #' arguments are passed on to `get_order()` (e.g., as `dim`). #' @return Returns an integer permutation vector/a permutation matrix. #' #' @author Michael Hahsler #' @keywords manip #' @examples #' ## create a random ser_permutation_vector #' ## Note that ser_permutation_vector is a single permutation vector #' x <- structure(1:10, names = paste0("X", 1:10)) #' o <- sample(x) #' o #' #' p <- ser_permutation_vector(o) #' p #' #' get_order(p) #' get_rank(p) #' get_permutation_matrix(p) #' #' ## reorder objects using subsetting, the provided permute function or by #' ## multiplying the with the permutation matrix. We use here #' x[get_order(p)] #' permute(x, p) #' drop(get_permutation_matrix(p) %*% x) #' #' ## ser_permutation contains one permutation vector for each dimension #' p2 <- ser_permutation(p, sample(5)) #' p2 #' #' get_order(p2, dim = 2) #' get_rank(p2, dim = 2) #' get_permutation_matrix(p2, dim = 2) #' @export get_order <- function(x, ...) UseMethod("get_order") #' @export get_order.default <- function(x, ...) stop(gettextf("No permutation accessor implemented for class '%s'. ", class(x))) #' @rdname get_order #' @export get_order.ser_permutation_vector <- function(x, ...) NextMethod() #' @rdname get_order #' @export get_order.ser_permutation <- function(x, dim = 1, ...) get_order(x[[dim]]) #' @rdname get_order #' @export get_order.hclust <- function(x, ...) structure(.Data = x$order, names = x$labels[x$order]) #' @rdname get_order #' @export get_order.dendrogram <- function(x, ...) order.dendrogram(x) #' @rdname get_order #' @export get_order.integer <- function(x, ...) { if (.is_identity_permutation(x)) stop("Cannot get order vector from symbolic identity permutation (undefined length).") structure(as.integer(x), names = names(x)) } #' @rdname get_order #' @export get_order.numeric <- function(x, ...) { structure(order(x), names = names(x)) } ## returns for each object its rank (rank of first, second, etc. object) #' @rdname get_order #' @export get_rank <- function(x, ...) { o <- get_order(x, ...) r <- order(o) names(r) <- names(o)[r] r } #' @rdname get_order #' @export get_permutation_matrix <- function(x, ...) permutation_vector2matrix(get_order(x, ...)) seriation/R/AAA_registry_criterion.R0000644000176200001440000002136014706524256017200 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. #' Registry for Criterion Methods #' #' A registry to manage methods used by [criterion()] to calculate a criterion value given data and a #' permutation. #' #' All methods below are convenience methods for the registry named #' `registry_criterion`. #' #' `list_criterion_method()` lists all available methods for a given data #' type (`kind`). The result is a vector of character strings with the #' short names of the methods. If `kind` is missing, then a list of #' methods is returned. #' #' `get_criterion_method()` returns information (including the #' implementing function) about a given method in form of an object of class #' `"criterion_method"`. #' #' With `set_criterion_method()` new criterion methods can be added by the #' user. The implementing function (`fun`) needs to have the formal #' arguments `x, order, ...`, where `x` is the data object, order is #' an object of class [ser_permutation_vector] and `...` can contain #' additional information for the method passed on from [criterion()]. The #' implementation has to return the criterion value as a scalar. #' #' @name registry_for_criterion_methods #' @family criterion #' #' @param kind the data type the method works on. For example, `"dist"`, #' `"matrix"` or `"array"`. #' @param name the name for the method used to refer to the method in the #' function [criterion()]. #' @param names_only logical; return only the method name. `FALSE` returns #' also the method descriptions. #' @param fun a function containing the method's code. #' @param description a description of the method. For example, a long name. #' @param merit logical; indicating if the criterion measure is a merit #' (`TRUE`) or a loss (`FALSE`) measure. #' @param x an object of class "criterion_method" to be printed. #' @param verbose logical; print a message when a new method is registered. #' @param control a list with control arguments and default values. #' @param ... further information that is stored for the method in the #' registry. #' @returns #' - `list_criterion_method()` results is a vector of character strings with the #' names of the methods used for `criterion()`. #' - `get_criterion_method()` returns a given method in form of an object of class #' `"criterion_method"`. #' @author Michael Hahsler #' @seealso This registry uses [registry::registry]. #' @keywords misc #' @examples #' ## the registry #' registry_criterion #' #' # List all criterion calculation methods by type #' list_criterion_methods() #' #' # List methods for matrix #' list_criterion_methods("matrix") #' #' # get more description #' list_criterion_methods("matrix", names_only = FALSE) #' #' # get a specific method #' get_criterion_method(kind = "dist", name = "AR_d") #' #' # Define a new method (sum of the diagonal elements) #' #' ## 1. implement a function to calculate the measure #' criterion_method_matrix_foo <- function(x, order, ...) { #' if(!is.null(order)) x <- permute(x,order) #' sum(diag(x)) #' } #' #' ## 2. Register new method #' set_criterion_method("matrix", "DiagSum", criterion_method_matrix_foo, #' description = "Calculated the sum of all diagonal entries", merit = FALSE) #' #' list_criterion_methods("matrix") #' get_criterion_method("matrix", "DiagSum") #' #' ## 3. use all criterion methods (including the new one) #' criterion(matrix(1:9, ncol = 3)) #' @export registry_criterion <- registry(registry_class = "criterion_registry", entry_class = "criterion_method") registry_criterion$set_field("kind", type = "character", is_key = TRUE, index_FUN = match_partial_ignorecase) registry_criterion$set_field("name", type = "character", is_key = TRUE, index_FUN = match_partial_ignorecase) registry_criterion$set_field("fun", type = "function", is_key = FALSE) registry_criterion$set_field("description", type = "character", is_key = FALSE) registry_criterion$set_field("merit", type = "logical", is_key = FALSE) registry_criterion$set_field("control", type = "list", is_key = FALSE) registry_criterion$set_field("registered_by", type = "character", is_key = FALSE) #' @rdname registry_for_criterion_methods #' @export list_criterion_methods <- function(kind, names_only = TRUE) { if (missing(kind)) { kinds <- unique(sort(as.vector( sapply(registry_criterion$get_entries(), "[[", "kind") ))) sapply( kinds, FUN = function(k) list_criterion_methods(k, names_only = names_only) ) } else{ if (names_only) sort(as.vector(sapply( registry_criterion$get_entries(kind = kind), "[[", "name" ))) else { l <- registry_criterion$get_entries(kind = kind) l[order(names(l))] } } } #' @rdname registry_for_criterion_methods #' @export get_criterion_method <- function(kind, name) { if (missing(kind)) method <- registry_criterion$get_entry(name = name) else method <- registry_criterion$get_entry(kind = kind, name = name) if (is.null(method)) stop(sQuote(name), " is an unknown criterion. Check list_criterion_methods()") method } ## ## For criterion() methods, argument 'method' really allows selecting ## *several* methods ... should perhaps be called 'methods'? ## We thus have a getter which returns a named list of methods from the ## registry, and a setter for single methods. ## #' @rdname registry_for_criterion_methods #' @export set_criterion_method <- function(kind, name, fun, description = NULL, merit = NA, control = list(), verbose = FALSE, ...) { ## check formals ##if(!identical(names(formals(definition)), ## c("x", "order", "..."))) ## stop("Criterion methods must have formals 'x', 'order', and '...'.") if (sys.nframe() > 1) { caller <- deparse(sys.calls()[[sys.nframe()-1]]) if (is.null(caller) || !startsWith(caller, "register_")) caller <- NA_character_ } else caller <- "manual" ## check if criterion is already in registry r <- registry_criterion$get_entry(kind = kind, name = name) if (!is.null(r) && r$name == name) { warning("Entry with name ", sQuote(name), " already exists! Modifying entry.") registry_criterion$modify_entry( kind = kind, name = name, fun = fun, description = description, merit = merit, control = control, registered_by = caller ) } else { registry_criterion$set_entry( kind = kind, name = name, fun = fun, description = description, merit = merit, control = control, registered_by = caller ) } if (!is.null(caller)) { caller <- paste0(" using ", caller) } if (verbose) message("Registering new seriation criteron ", sQuote(name), " for ", sQuote(kind), caller) } #' @rdname registry_for_criterion_methods #' @export print.criterion_method <- function(x, ...) { writeLines(c( gettextf("name: %s", x$name), gettextf("kind: %s", x$kind), gettextf("merit: %s", x$merit) )) if(!is.na(x$registered_by)) writeLines(gettextf("registered by: %s", x$registered_by)) writeLines(c( strwrap( gettextf("description: %s", x$description), prefix = " ", initial = "" ) )) writeLines("additional parameters:") .print_control(x$control) #extra_param <- setdiff(names(as.list(args(x$fun))), c("x", "order", "...", "")) #if (length(extra_param) > 0L) # cat("parameters: ", paste(extra_param, collapse = ", "), "\n") invisible(x) } seriation/R/seriate_random.R0000644000176200001440000000370014706524256015602 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. seriate_dist_random <- function(x, control = NULL) { #param <- .get_parameters(control, NULL) .get_parameters(control, NULL) o <- 1:attr(x, "Size") sample(o) } seriate_matrix_random <- function(x, control, margin = seq_along(dim(x))) { control <- .get_parameters(control, NULL) lapply(seq_along(dim(x)), function(i) if (i %in% margin) sample(seq(dim(x)[i])) else NA) } set_seriation_method("dist", "Random", seriate_dist_random, "Random permutation", randomized = TRUE, optimized = "None") set_seriation_method("matrix", "Random", seriate_matrix_random, "Random permutation", randomized = TRUE, optimized = "None") set_seriation_method("array", "Random", seriate_matrix_random, "Random permutation", randomized = TRUE, optimized = "None") seriation/R/Chameleon.R0000644000176200001440000000210214706524256014474 0ustar liggesusers#' 2D Data Sets used for the CHAMELEON Clustering Algorithm #' #' Several 2D data sets created to evaluate the CHAMELEON clustering algorithm in #' the paper by Karypis et al (1999). #' #' @name Chameleon #' @aliases Chameleon chameleon chameleon_ds4 chameleon_ds5 chameleon_ds7 #' chameleon_ds8 #' @docType data #' @family data #' @format #' `chameleon_ds4`: The format is a 8,000 x 2 data.frame. #' #' `chameleon_ds5`: The format is a 8,000 x 2 data.frame. #' #' `chameleon_ds7`: The format is a 10,000 x 2 data.frame. #' #' `chameleon_ds8`: The format is a 8,000 x 2 data.frame. #' @references Karypis, G., EH. Han, V. Kumar (1999): CHAMELEON: A Hierarchical #' Clustering Algorithm Using Dynamic Modeling, _IEEE Computer,_ #' **32**(8): 68--75. #' \doi{10.1109/2.781637} #' @keywords datasets #' @examples #' data(Chameleon) #' #' plot(chameleon_ds4, cex = .1) #' plot(chameleon_ds5, cex = .1) #' plot(chameleon_ds7, cex = .1) #' plot(chameleon_ds8, cex = .1) NULL # link does not work # @source The data was obtained from # \url{http://glaros.dtc.umn.edu/gkhome/cluto/cluto/download} seriation/R/seriate_Mean.R0000644000176200001440000000315014706524256015201 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. .seriate_mean_control <- list( transformation = NULL ) attr(.seriate_mean_control, "help") <- list( transformation = "transformation function applied before calculating means (e.g., scale)" ) seriate_matrix_mean <- function(x, control = NULL, margin = NULL) { control <- .get_parameters(control, .seriate_mean_control) if(!is.null(control$transformation)) x <- control$transformation(x) if (1L %in% margin) row <- order(rowMeans(x, na.rm = TRUE)) else row <- NA if (2L %in% margin) col <- order(colMeans(x, na.rm = TRUE)) else col <- NA list(row = row, col = col) } set_seriation_method( "matrix", "Mean", seriate_matrix_mean, "Reorders rows and columns by row and column means.", .seriate_mean_control ) seriation/R/SupremeCourt.R0000644000176200001440000000267314706524256015253 0ustar liggesusers#' Voting Patterns in the Second Rehnquist U.S. Supreme Court #' #' Contains a (a subset of the) decisions for the stable 8-yr #' period 1995-2002 of the second Rehnquist Supreme Court. #' Decisions are aggregated to #' the joint probability for disagreement between judges. #' #' @name SupremeCourt #' @aliases SupremeCourt #' @docType data #' @family data #' @format #' A square, symmetric 9-by-9 matrix with the joint probability for disagreement. #' @references #' Sirovich, L. (2003). A pattern analysis of the second Rehnquist #' U.S. Supreme Court. _Proceedings of the National Academy of Sciences of the United #' States of America,_ **100**, 7432-7437. \doi{10.1073/pnas.1132164100} #' @author Michael Hahsler #' @examples #' data("SupremeCourt") #' #' # a matrix with joint probability of disagreement #' SupremeCourt #' #' # show judges in original alphabetical order #' d <- as.dist(SupremeCourt) #' pimage(d, diag = TRUE, upper = TRUE) #' #' # reorder judges using seriation based on similar decisions #' o <- seriate(d) #' o #' #' pimage(d, o, diag = TRUE, upper = TRUE) #' #' # Use optimal leaf ordering (hierarchical clustering with reordering) #' # which uses a dendrogram #' o <- seriate(d, method = "OLO") #' o #' #' plot(o[[1]]) #' #' # Use multi-dimensional scaling and show the configuration #' o <- seriate(d, method = "sammon") #' o #' #' pimage(d, o, diag = TRUE, upper = TRUE) #' plot_config(o[[1]]) #' @keywords datasets NULL seriation/R/seriate_TSP.R0000644000176200001440000000323014706524256014766 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. #' @import "TSP" .tsp_control <- structure( list( method = "arbitrary insertion", rep = 10, two_opt = TRUE ), help = list( method = "used TSP method (see ? solve_TSP)", rep = "number of random restarts", two_opt = "use the 2-opt improvement heuristic?" ) ) seriate_dist_tsp <- function(x, control = NULL) { ## add a dummy city for cutting tsp <- insert_dummy(TSP(x), n = 1, label = "cut_here") if (is.null(control)) control <- .tsp_control tour <- solve_TSP(tsp, method = control$method, control = control) o <- cut_tour(tour, cut = "cut_here", exclude_cut = TRUE) o } set_seriation_method( "dist", "TSP", seriate_dist_tsp, "Minimize Hamiltonian path length with a TSP solver.", .tsp_control, randomized = TRUE, optimizes = "Path_length" ) seriation/R/AAA_parameters.R0000644000176200001440000000353514706524256015421 0ustar liggesusers####################################################################### # Code to check parameter/control objects # Copyright (C) 2011 Michael Hahsler # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. ## helper to parse parameter lists with defaults .nodots <- function(...) { l <- list(...) if (length(l) > 0L) warning("Unknown arguments: ", paste(names(l), "=", l, collapse = ", ")) } .get_parameters <- function(parameter, defaults) { defaults <- as.list(defaults) parameter <- as.list(parameter) ## add verbose if (is.null(defaults$verbose)) defaults$verbose <- FALSE o <- integer() if (length(parameter) != 0) { o <- pmatch(names(parameter), names(defaults)) ## unknown parameter if (any(is.na(o))) { warning(sprintf( "%s: Unknown control parameter(s) %s are ignored. Rerun with verbose = TRUE.", deparse(sys.calls()[[sys.nframe()-3]]), paste(sQuote(names(parameter)[is.na(o)]), collapse = ", ") ), call. = FALSE) } ### defaults are now the actual parameters defaults[o[!is.na(o)]] <- parameter[!is.na(o)] } if (defaults$verbose) { cat("control:\n") .print_control(defaults, "used values") } defaults } seriation/R/seriate_VAT.R0000644000176200001440000000363114706524256014757 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. ## VAT: a tool for visual assessment of (cluster) tendency ## Bezdek, J.C., Hathaway, R.J. ## Proceedings of the 2002 International Joint Conference on ## Neural Networks, 2002. IJCNN '02. (Volume:3) seriate_dist_VAT <- function(x, control = NULL) { #param <- .get_parameters(control, NULL) .get_parameters(control, NULL) D <- as.matrix(x) N <- nrow(D) P <- rep(NA_integer_, N) I <- rep(FALSE, N) ### J is !I i <- which(D == max(D, na.rm = TRUE), arr.ind = TRUE)[1, 1] P[1] <- i I[i] <- TRUE for (r in 2:N) { D2 <- D[I, !I, drop = FALSE] j <- which(D2 == min(D2, na.rm = TRUE), arr.ind = TRUE)[1, 2] j <- which(!I)[j] P[r] <- j I[j] <- TRUE } P } set_seriation_method( "dist", "VAT", seriate_dist_VAT, "Visual assesment of clustering tendency (Bezdek and Hathaway (2002). Creates an order based on Prim's algorithm for finding a minimum spanning tree (MST) in a weighted connected graph representing the distance matrix. The order is given by the order in which the nodes (objects) are added to the MST." ) seriation/R/seriate_LLE.R0000644000176200001440000000325514706524256014743 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. .lle_contr <- list( k = 30, reg = 2 ) attr(.lle_contr, "help") <- list( k = "used number of neighbors", reg = "regularization method (see ? lle)" ) seriate_lle <- function(x, control = NULL, margin) { param <- .get_parameters(control, .lle_contr) o <- list(row = NA, col = NA) if (1L %in% margin) { score <- lle(x, m = 1, k = param$k, reg = param$reg) os <- order(score) o$row <- structure(os, names = rownames(x)[os], configuration = score) } if (2L %in% margin) { x <- t(x) score <- lle(x, m = 1, k = param$k, reg = param$reg) os <- order(score) o$col <- structure(os, names = rownames(x)[os], configuration = score) } o } set_seriation_method( "matrix", "LLE", seriate_lle, "Find an order using 1D locally linear embedding.\n", .lle_contr, randomized = FALSE ) seriation/R/seriate.array.R0000644000176200001440000000506214723676477015376 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. ## seriate general arrays .seriate_array_helper <- function(x, method = "PCA", control = NULL, margin = seq(ndim(x)), datatype = "array", ...) { ## add ... to control if (any(!margin %in% seq(ndim(x)))) stop("illegal margin specified.") control <- c(control, list(...)) if (!is.character(method) || (length(method) != 1L)) stop("Argument 'method' must be a character string.") if (any(dim(x) == 0L)) stop("All dimensions need to have at least one object.") method <- get_seriation_method(datatype, method) if (!is.null(control$verbose) && control$verbose) cat("Using seriation method: ", method$name, "\n", method$description, "\n\n", sep = "") tm <- system.time(order <- method$fun(x, control, margin)) if (!is.null(control$verbose) && control$verbose) cat("Seriation took", tm[1] + tm[2], "sec\n\n") for (i in margin) if (!is.null(dimnames(x)[[i]]) && is.integer(order[[i]])) names(order[[i]]) <- dimnames(x)[[i]][order[[i]]] perm <- do.call("ser_permutation", unname(lapply( order, "ser_permutation_vector", method$name ))) ### make non-seriated margins identity permutations rem <- which(!seq(ndim(x)) %in% margin) if (length(rem) > 0) { perm_ident <- seriate(x, method = "Identity") perm[[rem]] <- perm_ident[[rem]] } perm } #' @rdname seriate #' @include seriate.matrix.R #' @export seriate.array <- function(x, method = "PCA", control = NULL, margin = seq(length(dim(x))), rep = 1L, ...) { if (rep > 1L) return(seriate_rep(x, method, control, rep = rep, margin = margin, ...)) .seriate_array_helper(x, method, control, margin, datatype = "array", ...) } seriation/R/grid_helpers.R0000644000176200001440000001543114706524256015261 0ustar liggesusers####################################################################### # Basic Grid helpers # Copyright (C) 2011 Michael Hahsler # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. #' @import "grid" ## grid helpers ## requires map.R .grid_basic_layout <- function(main = "", left = unit(4, "lines"), right = unit(4, "lines"), top = unit(3, "lines"), bottom = unit(4, "lines"), gp = gpar()) { pushViewport(viewport( layout = grid.layout( nrow = 4, ncol = 3, widths = unit.c(left, # space unit(1, "npc") - left - right, # plot right), # space heights = unit.c( top, # title unit(1, "lines"), # space unit(1, "npc") - unit(1, "lines") - top - bottom, # plot bottom # space ) ), gp = gp )) pushViewport(viewport( layout.pos.col = 2, layout.pos.row = 1, name = "main" )) gp$cex <- 1.3 gp$fontface <- "bold" grid.text(main, gp = gp) upViewport(1) pushViewport(viewport( layout.pos.col = 2, layout.pos.row = 3, name = "plot" )) upViewport(2) } .grid_basic_layout_with_colorkey <- function(main = "", left = unit(4, "lines"), right = unit(0, "lines"), top = unit(3, "lines"), bottom = unit(4, "lines"), gp = gpar()) { pushViewport(viewport( layout = grid.layout( nrow = 4, ncol = 3, widths = unit.c(# space left, # plot unit(1, "npc") - left - right, # space right), heights = unit.c( # title top, # space unit(1, "lines"), # plot unit(1, "npc") - unit(1, "lines") - top - bottom, # space bottom ) ), gp = gp )) pushViewport(viewport( layout.pos.col = 2, layout.pos.row = 1, name = "main" )) gp$cex <- 1.3 gp$fontface <- "bold" grid.text(main, gp = gp) upViewport(1) pushViewport(viewport(layout.pos.col = 2, layout.pos.row = 3)) pushViewport(viewport(layout = grid.layout( 1, 3, widths = unit.c( # plot unit(1, "npc") - unit(8, "lines"), # space unit(1, "lines"), # colorkey unit(1, "lines") ), # plot heights = unit.c(unit(1, "npc")) ))) pushViewport(viewport( layout.pos.col = 1, layout.pos.row = 1, name = "plot" )) upViewport(1) pushViewport(viewport( layout.pos.col = 3, layout.pos.row = 1, name = "colorkey" )) upViewport(1) upViewport(2) } .grid_image <- function(x, zlim, col = grDevices::gray.colors(12), prop = FALSE, interpolate = FALSE, name = "image", gp = gpar()) { if (missing(zlim)) zlim <- range(x, na.rm = TRUE) else { # fix data for limits x[x < zlim[1]] <- NA x[x > zlim[2]] <- NA } ## create a viewport if (!prop) { vp <- viewport( #xscale = c(0,ncol(x)), yscale = c(nrow(x),0), xscale = c(0.5, ncol(x) + .5), yscale = c(nrow(x) + .5, 0.5), default.units = "native", name = name ) pushViewport(vp) } else{ ## ratio if (nrow(x) > ncol(x)) { w <- ncol(x) / nrow(x) h <- 1 } else if (nrow(x) < ncol(x)) { h <- nrow(x) / ncol(x) w <- 1 } else { w <- 1 h <- 1 } vp <- viewport( xscale = c(0.5, ncol(x) + .5), yscale = c(nrow(x) + .5, 0.5), width = unit(w, "snpc"), height = unit(h, "snpc"), default.units = "native", name = name ) pushViewport(vp) } grid.raster( .map_color(x, col, zlim), interpolate = interpolate, default.units = "npc", width = 1, height = 1 ) ## make border gp_border <- gp gp_border$fill <- "transparent" grid.rect(gp = gp_border) upViewport(1) } .grid_barplot_horiz <- function(height, name = "barplot", xlab = "", gp = gpar(), gp_bars = gpar(fill = "lightgrey")) { n <- length(height) ## these plots always start at x = 0 or below! lim <- c(min(c(height, 0)), max(height)) ## create a viewport vp <- viewport( xscale = lim , yscale = c(n, 0), default.units = "native", name = name, gp = gp ) pushViewport(vp) grid.rect( x = 0, y = (1:n) - .5, width = height, height = 1, just = c("left", "center"), default.units = "native", gp = gp_bars ) ## hopefully there is space outside for axes grid.xaxis() grid.text(xlab, y = unit(-3, "lines")) upViewport(1) } .grid_colorkey <- function(range, col, threshold = NULL, lab = "", name = "colorkey", horizontal = TRUE, gp = gpar()) { ### no color key for only a single value if (diff(range) == 0) { vp <- viewport( xscale = c(0, 1), yscale = c(0, 1), default.units = "native", name = name ) pushViewport(vp) grid.text( label = range[1], x = 0.5, y = 0.5, default.units = "native" ) upViewport(1) return() } if (horizontal) vp <- viewport( xscale = range, yscale = c(0, 1), default.units = "native", name = name ) else vp <- viewport( xscale = c(0, 1), yscale = range, default.units = "native", name = name ) pushViewport(vp) n <- length(col) #width <- diff(range)/n #xs <- seq(range[1] + width/2, range[2] - width/2, length.out = n) xs <- seq(range[1], range[2], length.out = n) ## do not display the part above the threshold col[xs > threshold] <- NA ## col if (horizontal) grid.raster(t(col), width = 1, height = 1, interpolate = FALSE) else grid.raster(rev(col), width = 1, height = 1, interpolate = FALSE) #gp_col <- gp #gp_col$col <- 0 #gp_col$fill <- col #grid.rect(x = xs, y = 0, width = width, height = 1, # just = c("centre", "bottom"), default.units = "native", # gp = gp_col) ## box gp_border <- gp gp_border$fill <- "transparent" grid.rect(gp = gp_border) if (horizontal) grid.xaxis(gp = gp) else grid.yaxis(main = FALSE, gp = gp) if (horizontal) grid.text(lab, y = unit(-2.5, "lines")) else grid.text(lab, x = unit(4, "lines"), rot = 90) upViewport(1) } seriation/R/dissplot.R0000644000176200001440000007661214706524256014463 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. #' Dissimilarity Plot #' #' Visualizes a dissimilarity matrix using seriation and matrix shading using #' the method developed by Hahsler and Hornik (2011). Entries with lower #' dissimilarities (higher similarity) are plotted darker. Dissimilarity plots #' can be used to uncover hidden structure in the data and judge cluster #' quality. #' #' The plot can also be used to visualize cluster quality (see Ling 1973). #' Objects belonging to the same cluster are displayed in consecutive order. #' The placement of clusters and the within cluster order is obtained by a #' seriation algorithm which tries to place large similarities/small #' dissimilarities close to the diagonal. Compact clusters are visible as dark #' squares (low dissimilarity) on the diagonal of the plot. Additionally, a #' Silhouette plot (Rousseeuw 1987) is added. This visualization is similar to #' CLUSION (see Strehl and Ghosh 2002), however, allows for using arbitrary #' seriating algorithms. #' #' **Note:** Since [pimage()] uses \pkg{grid}, it should not be mixed #' with base R primitive plotting functions. #' #' @family plots #' #' @param x an object of class [dist]. #' @param labels `NULL` or an integer vector of the same length as #' rows/columns in `x` indicating the cluster membership for each object #' in `x` as consecutive integers starting with one. The labels are used #' to reorder the matrix. #' @param method A single character string indicating the seriation method used #' to reorder the clusters (inter cluster seriation) as well as the objects #' within each cluster (intra cluster seriation). If different algorithms for #' inter and intra cluster seriation are required, `method` can be a #' `list` of two named elements (`inter_cluster` and #' `intra_cluster` each containing the name of the respective seriation #' method. Use [list_seriation_methods()] with `kind = "dist"` to find available algorithms. #' #' Set method to `NA` to plot the matrix as is (no or, if cluster labels #' are supplied, only coarse seriation). For intra cluster reordering with the #' special method `"silhouette width"` is available (for `dissplot()` #' only). Objects in clusters are then ordered by silhouette width (from #' silhouette plots). If no `method` is given, the default method of #' [seriate.dist()] is used. #' #' A third list element (named `aggregation`) can be added to control how #' inter cluster dissimilarities are computed from from the given dissimilarity #' matrix. The choices are `"avg"` (average pairwise dissimilarities; #' average-link), `"min"` (minimal pairwise dissimilarities; single-link), #' `"max"` (maximal pairwise dissimilarities; complete-link), and #' `"Hausdorff"` (pairs up each point from one cluster with the most #' similar point from the other cluster and then uses the largest dissimilarity #' of paired up points). #' @param control a list of control options passed on to the seriation #' algorithm. In case of two different seriation algorithms, `control` #' can contain a list of two named elements (`inter_cluster` and #' `intra_cluster`) containing each a list with the control options for #' the respective algorithm. #' @param upper_tri,lower_tri,diag a logical indicating whether to show the upper triangle, the #' lower triangle or the diagonal of the distance matrix. The string "average" can also be used #' to display within and between cluster averages in the two triangles. #' @param cluster_labels a logical indicating whether to display cluster labels #' in the plot. #' @param cluster_lines a logical indicating whether to draw lines to separate #' clusters. #' @param reverse_columns a logical indicating if the clusters are displayed on #' the diagonal from north-west to south-east (`FALSE`; default) or from #' north-east to south-west (`TRUE`). #' @param options a list with options for plotting the matrix (`dissplot` #' only). #' - `plot` a logical indicating if a plot should #' be produced. if `FALSE`, the returned object can be plotted later #' using the function `plot` which takes as the second argument a list of #' plotting options (see `options` below). #' - `silhouettes` a logical indicating whether to include a silhouette plot #' (see Rousseeuw, 1987). #' - `threshold` a numeric. If used, only plot distances #' below the threshold are displayed. Consider also using `zlim` for this #' purpose. #' - `col` colors used for the image plot. #' - `key` a logical indicating whether to place a color key below the plot. #' - `zlim` range of values to display (defaults to range `x`). #' - `axes` `"auto"` (default; enabled for less than 25 objects), `"y"` or `"none"`. #' - `main` title for the plot. #' - `newpage` a logical indicating whether to start plot on a new page #' (see [grid.newpage()]. #' - `pop` a logical indicating whether to pop the created viewports? #' (see package \pkg{grid}) #' - `gp`, `gp_lines`, `gp_labels` objects of class `gpar` containing graphical parameters for the plot #' lines and labels (see [gpar()]. #' @param ... `dissplot()`: further arguments are added to `options`. #' `ggdissplot()` further arguments are passed on to [ggpimage()]. #' @return `dissplot()` returns an invisible object of class #' `cluster_proximity_matrix` with the following elements: #' \item{order}{`NULL` or integer vector giving the order used to plot `x`.} #' \item{cluster_order}{ `NULL` or integer vector giving the order of the #' clusters as plotted.} #' \item{method}{ vector of character strings indicating #' the seriation methods used for plotting `x`.} #' \item{k}{ `NULL` or integer scalar giving the number of clusters generated.} #' \item{description}{ a `data.frame` containing information (label, size, average #' intra-cluster dissimilarity and the average silhouette) for the clusters as #' displayed in the plot (from top/left to bottom/right).} #' #' This object can be used for plotting via `plot(x, options = NULL, ...)`, #' where `x` is the object and `options` contains a list with #' plotting options (see above). #' #' `ggdissplot()` returns a ggplot2 object representing the plot. #' #' @returns The plot description as an object of class `reordered_cluster_dissimilarity_matrix`. #' #' @author Michael Hahsler #' @references #' Hahsler, M. and Hornik, K. (2011): Dissimilarity plots: A visual #' exploration tool for partitional clustering. \emph{Journal of Computational #' and Graphical Statistics,} \bold{10}(2):335--354. #' \doi{10.1198/jcgs.2010.09139} #' #' Ling, R.F. (1973): A computer generated aid for cluster analysis. #' \emph{Communications of the ACM,} \bold{16}(6), 355--361. #' \doi{10.1145/362248.362263} #' #' Rousseeuw, P.J. (1987): Silhouettes: A graphical aid to the interpretation #' and validation of cluster analysis. \emph{Journal of Computational and #' Applied Mathematics,} \bold{20}(1), 53--65. #' \doi{10.1016/0377-0427(87)90125-7} #' #' Strehl, A. and Ghosh, J. (2003): Relationship-based clustering and #' visualization for high-dimensional data mining. \emph{INFORMS Journal on #' Computing,} \bold{15}(2), 208--230. #' \doi{10.1287/ijoc.15.2.208.14448} #' @keywords hplot cluster #' @examples #' data("iris") #' #' # shuffle rows #' x_iris <- iris[sample(seq(nrow(iris))), -5] #' d <- dist(x_iris) #' #' # Plot original matrix #' dissplot(d, method = NA) #' #' # Plot reordered matrix using the nearest insertion algorithm (from tsp) #' dissplot(d, method = "TSP", main = "Seriation (TSP)") #' #' # Cluster iris with k-means and 3 clusters and reorder the dissimality matrix #' l <- kmeans(x_iris, centers = 3)$cluster #' dissplot(d, labels = l, main = "k-means") #' #' # show only distances as lower triangle #' dissplot(d, labels = l, main = "k-means", lower_tri = TRUE, upper_tri = FALSE) #' #' # Use a grid layout to place several plots on a page #' library("grid") #' grid.newpage() #' pushViewport(viewport(layout=grid.layout(nrow = 2, ncol = 2), #' gp = gpar(fontsize = 8))) #' pushViewport(viewport(layout.pos.row = 1, layout.pos.col = 1)) #' #' # Visualize the clustering (using Spectral between clusters and MDS within) #' res <- dissplot(d, l, method = list(inter = "Spectral", intra = "MDS"), #' main = "K-Means + Seriation", newpage = FALSE) #' #' popViewport() #' pushViewport(viewport(layout.pos.row = 1, layout.pos.col = 2)) #' #' # More visualization options. Note that we reuse the reordered object res! #' # color: use 10 shades red-blue, biased towards small distances #' plot(res, main = "K-Means + Seriation (red-blue + biased)", #' col= bluered(10, bias = .5), newpage = FALSE) #' #' popViewport() #' pushViewport(viewport(layout.pos.row = 2, layout.pos.col = 1)) #' #' # Threshold (using zlim) and cubic scale to highlight differences #' plot(res, main = "K-Means + Seriation (cubic + threshold)", #' zlim = c(0, 2), col = grays(100, power = 3), newpage = FALSE) #' #' popViewport() #' pushViewport(viewport(layout.pos.row = 2, layout.pos.col = 2)) #' #' # Use gray scale with logistic transformation #' plot(res, main = "K-Means + Seriation (logistic scale)", #' col = gray( #' plogis(seq(max(res$x_reordered), min(res$x_reordered), length.out = 100), #' location = 2, scale = 1/2, log = FALSE) #' ), #' newpage = FALSE) #' #' popViewport(2) #' #' # The reordered_cluster_dissimilarity_matrix object #' res #' names(res) #' #' ## -------------------------------------------------------------------- #' ## ggplot-based dissplot #' if (require("ggplot2")) { #' #' library("ggplot2") #' #' # Plot original matrix #' ggdissplot(d, method = NA) #' #' # Plot seriated matrix #' ggdissplot(d, method = "TSP") + #' labs(title = "Seriation (TSP)") #' #' # Cluster iris with k-means and 3 clusters #' l <- kmeans(x_iris, centers = 3)$cluster #' #' ggdissplot(d, labels = l) + #' labs(title = "K-means + Seriation") #' #' # show only lower triangle #' ggdissplot(d, labels = l, lower_tri = TRUE, upper_tri = FALSE) + #' labs(title = "K-means + Seriation") #' #' # No lines or cluster labels and add a label for the color key (fill) #' ggdissplot(d, labels = l, cluster_lines = FALSE, cluster_labels = FALSE) + #' labs(title = "K-means + Seriation", fill = "Distances\n(Euclidean)") #' #' # Diverging color palette with manual set midpoint and different seriation methods #' ggdissplot(d, l, method = list(inter = "Spectral", intra = "MDS")) + #' labs(title = "K-Means + Seriation", subtitle = "biased color scale") + #' scale_fill_gradient2(midpoint = median(d)) #' #' # Use manipulate scale using package scales #' library("scales") #' #' # Threshold (using limit and na.value) and cubic scale to highlight differences #' cubic_dist_trans <- trans_new( #' name = "cubic", #' # note that we have to do the inverse transformation for distances #' trans = function(x) x^(1/3), #' inverse = function(x) x^3 #' ) #' #' ggdissplot(d, l, method = list(inter = "Spectral", intra = "MDS")) + #' labs(title = "K-Means + Seriation", subtitle = "cubic + biased color scale") + #' scale_fill_gradient(low = "black", high = "white", #' limit = c(0,2), na.value = "white", #' trans = cubic_dist_trans) #' #' # Use gray scale with logistic transformation #' logis_2_.5_dist_trans <- trans_new( #' name = "Logistic transform (location, scale)", #' # note that we have to do the inverse transformation for distances #' trans = function(x) plogis(x, location = 2, scale = .5, log = FALSE), #' inverse = function(x) qlogis(x, location = 2, scale = .5, log = FALSE), #' ) #' #' ggdissplot(d, l, method = list(inter = "Spectral", intra = "MDS")) + #' labs(title = "K-Means + Seriation", subtitle = "logistic color scale") + #' scale_fill_gradient(low = "black", high = "white", #' trans = logis_2_.5_dist_trans, #' breaks = c(0, 1, 2, 3, 4)) #' } #' @export dissplot <- function(x, labels = NULL, method = "spectral", control = NULL, lower_tri = TRUE, upper_tri = "average", diag = TRUE, cluster_labels = TRUE, cluster_lines = TRUE, reverse_columns = FALSE, options = NULL, ...) { ## add ... to options options <- c(options, list(...)) options$cluster_labels <- cluster_labels options$cluster_lines <- cluster_lines options$reverse_columns <- reverse_columns ## make x dist if (!inherits(x, "dist")) { if (is.matrix(x) && isSymmetric(x)) x <- as.dist(x) else stop("Argument 'x' cannot safely be coerced to class 'dist'.") } a <- .arrange_dissimilarity_matrix(x, labels = labels, method = method, control = control) if (is.null(options$plot) || options$plot) plot(a, lower_tri, upper_tri, diag, options) invisible(a) } ## work horse .arrange_dissimilarity_matrix <- function(x, labels = NULL, method = NULL, control = NULL) { ## x is already of class dist dim <- attr(x, "Size") diss_measure <- attr(x, "method") ## check labels if (!is.null(labels) && length(labels) != dim) stop("Number of labels in 'labels' does not match dimensions of 'x'.") m <- method ## set everything to NULL first order <- NULL k <- NULL # number of clusters sil <- NULL avgSil <- NULL labels_unique <- NULL cluster_dissimilarities <- NULL ## method$a means method$ aggregation (default is avg) aggregation <- "avg" if (is.list(method) && !is.null(method$a)) aggregation <- method$a if (!is.list(method)) method <- list(inter_cluster = m, intra_cluster = m) m <- pmatch(names(method), c("inter_cluster", "intra_cluster", "aggregation")) if (any(is.na(m))) stop("Unknown method component. Use 'inter_cluster', 'intra_cluster' and 'aggregation'.") names(method) <- c("inter_cluster", "intra_cluster", "aggregation")[m] if (!is.list(control[[1]])) { control <- list(inter_cluster = control, intra_cluster = control) } if (!is.null(method$inter_cluster) && is.na(method$inter_cluster)) { ## no setiation if (!is.null(labels)) { ## do coarse seriation order <- order(labels) k <- length(unique(labels)) ## calculate cluster_dissimilarities for later cluster_dissimilarities <- .cluster_dissimilarity(x, labels, aggregation) aggregation <- attr(cluster_dissimilarities, "method") ## calculate silhouette values for later use sil <- cluster::silhouette(labels, x) } ## else keep the matrix as is -- do not reorder } else if (is.null(labels)) { ## reorder whole matrix if no labels are given order <- seriate(x, method = method$inter_cluster, control = control$inter)[[1]] method$inter_cluster <- if (!is.null(attr(order, "method"))) attr(order, "method") else method$inter_cluster order <- get_order(order) } else{ ## reorder clusters for given labels ## get number of clusters k k <- length(unique(labels)) ## reorder with average pairwise dissimilarites between clusters cluster_dissimilarities <- .cluster_dissimilarity(x, labels, aggregation) aggregation <- attr(cluster_dissimilarities, "method") if (k > 2) { cluster_order <- seriate( as.dist(cluster_dissimilarities), method = method$inter_cluster, control = control$inter )[[1]] method$inter_cluster <- if (!is.null(attr(cluster_order, "method"))) attr(cluster_order, "method") else method$inter_cluster cluster_order <- get_order(cluster_order) } else{ cluster_order <- 1:k } ## calculate silhouette values for later use sil <- cluster::silhouette(labels, x) ## determine order for matrix from cluster order order <- c() if (!is.null(method$intra_cluster) && is.na(method$intra_cluster)) { ## no intra cluster ordering for (i in 1:k) { order <- c(order, which(labels == cluster_order[i])) } ##method$intra_cluster <- NA } else{ ## intra cluster order for (i in 1:k) { take <- which(labels == cluster_order[i]) ## only reorder for >1 elements if (length(take) > 1) { if (is.character(method$intra_cluster) && match( tolower(method$intra_cluster), c("sil", "silhouette", "silhouette width"), nomatch = 0 ) > 0) { intra_order <- order(sil[take, "sil_width"], decreasing = TRUE) method$intra_cluster <- "silhouette width" } else{ ## we use .rearrange_dist instead of permute ## since we take only a subset! block <- .rearrange_dist(x, take) intra_order <- seriate(block, method = method$intra_cluster, control = control$intra)[[1]] method$intra_cluster <- if (!is.null(attr(intra_order, "method"))) attr(intra_order, "method") else method$intra_cluster intra_order <- get_order(intra_order) } order <- c(order, take[intra_order]) } else{ order <- c(order, take) } } } ## reorder cluster_dissimilarities for later cluster_dissimilarities <- cluster_dissimilarities[cluster_order, cluster_order] } ## reorder matrix if (!is.null(order)) { x_reordered <- permute(x, order) labels <- labels[order] } else x_reordered <- x ## prepare for return value cluster_description <- NULL if (!is.null(labels)) { labels_unique <- unique(labels) ## reorder silhouettes sil <- sil[order,] ## calculate avg silhouettes avgSil <- sapply(labels_unique, function(x) mean(sil[sil[, "cluster"] == x, "sil_width"])) ## generate description cluster_description = data.frame( position = c(1:k), label = labels_unique, size = tabulate(labels)[labels_unique], ## FIXME: this is not the average anymore! aggregated_dissimilarity = diag(cluster_dissimilarities)[labels_unique], avg_silhouette_width = avgSil ) } ## clean order from names, etc. attributes(order) <- NULL structure( list( x_reordered = x_reordered, labels = labels, seriation_methods = method, aggregation_method = aggregation, k = k, cluster_dissimilarities = cluster_dissimilarities, sil = sil, order = order, cluster_order = labels_unique, diss_measure = diss_measure, description = cluster_description ), class = "reordered_cluster_dissimilarity_matrix" ) } ## create panels with avg. dissimilarity ## a is an arrangement .average_tri <- function(a, lower_tri = "average", upper_tri = TRUE, diag = TRUE) { if (!inherits(a, "reordered_cluster_dissimilarity_matrix")) stop("a needs to be a reordered_cluster_dissimilarity_matrix") upper_avg <- !is.na(pmatch(tolower(upper_tri), "average")) lower_avg <- !is.na(pmatch(tolower(lower_tri), "average")) k <- a$k labels <- a$labels labels_unique <- a$cluster_order cluster_dissimilarities <- a$cluster_dissimilarities m <- as.matrix(a$x_reordered) ## blank out if FALSE or NA if (is.na(upper_tri) || (is.logical(upper_tri) && !upper_tri)) { m[upper.tri(m)] <- NA upper_tri <- FALSE } if (is.na(lower_tri) || (is.logical(lower_tri) && !lower_tri)) { m[lower.tri(m)] <- NA lower_tri <- FALSE } ## do off-diagonal averages by cluster if (!is.null(cluster_dissimilarities) && !is.null(labels) && (upper_avg || lower_avg)) { for (i in seq(2, k)) { for (j in seq(i - 1)) { ## check empty clusters if (is.na(labels_unique[i])) next if (is.na(labels_unique[j])) next ## lower panels if (lower_avg) { m[labels == labels_unique[i], labels == labels_unique[j]] <- cluster_dissimilarities[i, j] } ## upper panels if (upper_avg) { m[labels == labels_unique[j], labels == labels_unique[i]] <- cluster_dissimilarities[i, j] } } } ## do diagonal for (i in seq(1, k)) { block <- m[labels == labels_unique[i], labels == labels_unique[i]] if (upper_avg) { block[upper.tri(block, diag = TRUE)] <- cluster_dissimilarities[i, i] m[labels == labels_unique[i], labels == labels_unique[i]] <- block } if (lower_avg) { block[lower.tri(block, diag = TRUE)] <- cluster_dissimilarities[i, i] m[labels == labels_unique[i], labels == labels_unique[i]] <- block } } } if (!diag) diag(m) <- NA m } ## plot for reordered_cluster_dissimilarity_matrix #' @rdname dissplot #' @export plot.reordered_cluster_dissimilarity_matrix <- function(x, lower_tri = TRUE, upper_tri = "average", diag = TRUE, options = NULL, ...) { ## add ... to options options <- c(options, list(...)) k <- x$k dim <- attr(x$x_reordered, "Size") labels <- x$labels #labels_unique <- unique(labels) labels_unique <- x$cluster_order m <- .average_tri(x, lower_tri = lower_tri, upper_tri = upper_tri, diag = diag) ## default plot options options <- .get_parameters( options, list( cluster_labels = TRUE, cluster_lines = TRUE, reverse_columns = FALSE, silhouettes = FALSE, col = NULL, threshold = NULL, zlim = NULL, key = TRUE, main = "Dissimilarity Plot", axes = "auto", gp = gpar(), gp_lines = gpar(), gp_labels = gpar(), newpage = TRUE, pop = TRUE ) ) if (is.null(options$col)) options$col <- rev(.sequential_pal()) else options$col <- rev(options$col) i <- pmatch(options$axes, c("auto", "x", "y", "both", "none")) if (is.na(i)) stop("Illegal vaule for axes. Use: 'auto', 'x', 'y', 'both' or 'none'!") options$axes <- c("auto", "x", "y", "both", "none")[i] ## clear page if (options$newpage) grid.newpage() ## do we have silhouettes? if (is.null(x$sil)) options$silhouettes <- FALSE if (options$reverse_columns) m <- m[, ncol(m):1] if (!options$silhouettes) { pushViewport(viewport( layout = grid.layout( 6, 3, widths = unit.c( unit(2, "lines"), # space unit(1, "snpc") - unit(7, "lines"), # image unit(2, "lines") # space ), heights = unit.c( unit(2, "lines"), # title unit(1, "lines"), # space unit(1, "snpc") - unit(7, "lines"), # image unit(1, "lines"), # space unit(1, "lines"), # colorkey unit(2, "lines") # space ) ), gp = options$gp )) main_vp <- viewport( layout.pos.col = 2, layout.pos.row = 1, name = "main" ) image_vp <- viewport(layout.pos.col = 2, layout.pos.row = 3) colorkey_vp <- viewport( layout.pos.col = 2, layout.pos.row = 5, name = "colorkey" ) } else{ ## with silhouettes pushViewport(viewport( layout = grid.layout( 6, 5, widths = unit.c( unit(2, "lines"), # space unit(0.7, "snpc") - unit(2.5, "lines"), # image unit(1, "lines"), # space unit(0.3, "snpc") - unit(2.5, "lines"), # sil unit(2, "lines") # space ), heights = unit.c( unit(2, "lines"), # title unit(2, "lines"), # space unit(0.7, "snpc") - unit(2.5, "lines"), # image unit(1, "lines"), # space unit(1, "lines"), # colorkey unit(2, "lines") # space ) ), gp = options$gp )) main_vp <- viewport( layout.pos.col = 2:4, layout.pos.row = 1, name = "main" ) image_vp <- viewport(layout.pos.col = 2, layout.pos.row = 3) sil_vp <- viewport( layout.pos.col = 4, layout.pos.row = 3, name = "sil" ) colorkey_vp <- viewport( layout.pos.col = 2, layout.pos.row = 5, name = "colorkey" ) } ## main pushViewport(main_vp) grid.text(options$main, gp = gpar(cex = 1.3, fontface = "bold")) upViewport(1) ## silhouette if (options$silhouettes) { ## get and reorder silhouettes s <- x$sil[, "sil_width"] pushViewport(sil_vp) .grid_barplot_horiz(s, xlab = "Silhouette width", gp_bars = gpar(fill = "lightgrey", col = 0)) upViewport(1) } ## image if (is.null(options$zlim)) options$zlim <- range(m, na.rm = TRUE) if (!is.null(options$threshold)) m[m > options$threshold] <- NA pushViewport(image_vp) .grid_image(m, col = options$col, zlim = options$zlim) ## add labels? if (options$axes == "auto" && nrow(m) > 25) options$axes <- "none" if (options$axes != "none") { downViewport("image") #grid.text(colnames(m), y = unit(-1, "lines"), # x=unit(1:ncol(m), "native"), rot=90, just="right") grid.text( rownames(m), x = unit(1, "npc") + unit(1, "lines"), y = unit(1:nrow(m), "native"), just = "left", gp = options$gp_labels ) upViewport(1) } upViewport(1) ## color key? if (options$key) { pushViewport(colorkey_vp) .grid_colorkey(options$zlim, col = options$col, threshold = options$threshold) upViewport(1) } ## plot cluster borders if we have labels and order if (!is.null(labels)) { labels_unique_y <- labels_unique cluster_width_y <- (tabulate(labels)[labels_unique]) cluster_cuts_y <- cumsum(cluster_width_y) cluster_center_y <- cluster_cuts_y - cluster_width_y / 2 if (options$reverse_columns) { labels_unique_x <- rev(labels_unique) cluster_width_x <- (tabulate(labels)[labels_unique_x]) cluster_cuts_x <- cumsum(cluster_width_x) cluster_center_x <- cluster_cuts_x - cluster_width_x / 2 } else{ labels_unique_x <- labels_unique_y cluster_width_x <- cluster_width_y cluster_cuts_x <- cluster_cuts_y cluster_center_x <- cluster_center_y } if (options$cluster_labels) { seekViewport("image") ## above the plot grid.text( labels_unique_x, x = cluster_center_x, y = unit(1, "npc") + unit(1, "lines"), default.units = "native", gp = options$gp_labels ) ## left of the plot grid.text( labels_unique_y, x = unit(-1, "lines"), y = cluster_center_y, default.units = "native", gp = options$gp_labels ) upViewport(2) } if (options$cluster_lines) { ## draw lines separating the clusters #cluster_cuts <- cluster_cuts[-length(cluster_cuts)] ## remove last line seekViewport("image") for (i in 1:(k - 1)) { grid.lines( #x = c(0, dim), x = c(0.5, dim + 0.5), y = cluster_cuts_y[i] + .5, default.units = "native", gp = options$gp_lines ) grid.lines( x = cluster_cuts_x[i] + .5, #y = c(0, dim), y = c(0.5, dim + 0.5), default.units = "native", gp = options$gp_lines ) } upViewport(2) } } if (options$pop) popViewport(1) else upViewport(1) } ## print for reordered_cluster_dissimilarity_matrix #' @rdname dissplot #' @export print.reordered_cluster_dissimilarity_matrix <- function(x, ...) { d <- attr(x$x_reordered, "Size") k <- if (!is.null(x$k)) x$k else NA cat(gettextf("object of class '%s'\n", class(x))) cat("matrix dimensions:", d, "x", d, "\n") cat(gettextf("dissimilarity measure: '%s'\n", x$diss_measure)) cat("number of clusters k:", k, "\n") if (!is.null(x$k)) { cat("\ncluster description\n") print(x$description) } cat("\n") cat("used seriation methods\n") cat(gettextf("inter-cluster: '%s'\n", x$seriation_methods$inter)) cat(gettextf("intra-cluster: '%s'\n", x$seriation_methods$intra)) cat("\n") cat(gettextf( "dissimilarity aggregation method: '%s'\n", x$aggregation_method )) invisible(x) } ## inter and intra cluster dissimilarity matrix from ## a dissimilarity matrix plus labels .cluster_dissimilarity <- function(x, labels, method = c("avg", "min", "max", "Hausdorff")) { method <- match.arg(method) ## FIXME: Implement Hausdorff linkage <- if (method == "avg") mean else if (method == "min") min else if (method == "max") max else if (method == "Hausdorff") .hausdorff else stop("Unknown method.") if (!is.matrix(x)) x <- as.matrix(x) ## kill self-dissimilarities (which are always 0) diag(x) <- NA k <- length(unique(labels)) diss_matrix <- matrix(nrow = k, ncol = k) ## calculate avg. dissimilarity between clusters for (i in 1:k) { slice <- x[labels == i, , drop = FALSE] for (j in 1:i) { block <- slice[, labels == j, drop = FALSE] val <- linkage(block, na.rm = TRUE) ## fix for clusters of size 1 if (is.nan(val)) val <- 0 diss_matrix[i, j] <- val diss_matrix[j, i] <- val } } attr(diss_matrix, "method") <- method diss_matrix } ## implement Hausdorff distance between two sets from a dissimilarity matrix ##d_H = max{sup_x\inX inf_y\inY d(x,y), sup_y\inY inf_x\inX d(x,y)} .hausdorff <- function(block, na.rm = TRUE) max(apply(block, MARGIN = 1, min, na.rm = na.rm), apply(block, MARGIN = 2, min, na.rm = na.rm)) seriation/R/seriate_spectral.R0000644000176200001440000000541514706524256016144 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. ## Spectral Seriation ## Ding, C. and Xiaofeng He (2004): Linearized cluster assignment via ## spectral orderingProceedings of the Twenty-first. ## International Conference on Machine learning (ICML '04) ## Minimizes: sum_{i,j} (i-j)^2 * d_{pi_i,pi_j} seriate_dist_spectral <- function(x, control = NULL) { #param <- .get_parameters(control, NULL) .get_parameters(control, NULL) ### calculate Laplacian W <- 1 / (1 + as.matrix(x)) D <- diag(rowSums(W)) L <- D - W ## The Fiedler vector is the eigenvector with the smallest eigenvalue ## eigen reports eigenvectors/values in decreasing order q <- eigen(L) fiedler <- q$vectors[, ncol(W) - 1L] o <- order(fiedler) names(fiedler) <- attr(x, "Labels") attr(o, "configuration") <- fiedler o } seriate_dist_spectral_norm <- function(x, control = NULL) { #param <- .get_parameters(control, NULL) .get_parameters(control, NULL) ### calculate normalized Laplacian W <- 1 / (1 + as.matrix(x)) D_sqrt <- diag(rowSums(1 / W ^ .5)) L <- D_sqrt %*% W %*% D_sqrt z <- eigen(L)$vectors q <- D_sqrt %*% z ## look for the vector with the largest eigenvalue largest_ev <- q[, 2L] o <- order(largest_ev) names(largest_ev) <- attr(x, "Labels") attr(o, "configuration") <- largest_ev o } set_seriation_method( "dist", "Spectral", seriate_dist_spectral, "Spectral seriation (Ding and He 2004) uses a relaxation to minimize the 2-Sum Problem (Barnard, Pothen, and Simon 1993). It uses the order of the Fiedler vector of the similarity matrix's Laplacian.", optimizes = .opt("2SUM", "2-sum criterion") ) set_seriation_method( "dist", "Spectral_norm", seriate_dist_spectral_norm, "Spectral seriation (Ding and He 2004) uses a relaxation to minimize the 2-Sum Problem (Barnard, Pothen, and Simon 1993). It uses the order of the Fiedler vector of the similarity matrix's normalized Laplacian.", optimizes = .opt("2SUM", "2-sum criterion") ) seriation/R/seriate_SGD.R0000644000176200001440000000512614706524256014743 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (C) 2017 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. .sgd_contr <- structure( list( criterion = "Gradient_raw", init = "Spectral", max_iter = NULL, localsearch = "LS_insert", verbose = FALSE ), help = list( criterion = "Criterion measure to optimize", init = "Start permutation or name of a seriation method", max_iter = "number of iterations", localsearch = "used local search move function" ) ) seriate_sgd <- function(x, control = NULL) { param <- .get_parameters(control, .sgd_contr) n <- attr(x, "Size") if (is.numeric(param$init)) { .check_dist_perm(x, order = param$init) o <- get_order(param$init) } else{ if (param$verbose) cat("Obtaining initial solution via:", param$init, "\n") o <- get_order(seriate(x, method = param$init)) } localsearch <- get(param$localsearch) if (!is.function(localsearch)) localsearch <- get(localsearch) crit <- param$criterion max_iter <- control$max_iter if (is.null(max_iter)) max_iter <- 100 * n z <- criterion(x, o, method = crit, force_loss = TRUE) if (param$verbose) { cat("Initial z =", z, "(minimize)\n") cat("\nTry\n") } zbest <- z for (i in seq(max_iter)) { o_new <- localsearch(o) z_new <- criterion(x, o_new, method = crit, force_loss = TRUE) delta <- z - z_new # we minimize, delta < 0 is a bad move if (delta > 0) { o <- o_new z <- z_new if (param$verbose) cat(i, "/", max_iter, "\tz =", z, "\n") } } o } set_seriation_method( "dist", "SGD", seriate_sgd, "Improve an existing solution using stochastic gradient descent.", .sgd_contr, optimizes = .opt (NA, "set via control criterion"), randomized = TRUE ) seriation/R/AAA_seriation-package.R0000644000176200001440000000254414706524256016643 0ustar liggesusers#' @keywords internal #' #' @section Key functions: #' - Seriation: [seriate()], [criterion()], [get_order()], [permute()] #' - Visualization: [pimage()], [bertinplot()], [hmap()], [dissplot()], [VAT()] #' #' @section Available seriation methods and criteria: #' * [A list with the implemented seriation methods](https://mhahsler.github.io/seriation/seriation_methods.html) #' * [A visual comparison between seriation methods](https://mhahsler.github.io/seriation/comparison.html) #' * [A list with the implemented seriation criteria](https://mhahsler.github.io/seriation/seriation_criteria.html) #' #' @section Quickstart guides: #' * [How to reorder heatmaps](https://mhahsler.github.io/seriation/heatmaps.html) #' * [How to reorder correlation matrices](https://mhahsler.github.io/seriation/correlation_matrix.html) #' * [How to evaluate clusters using dissimilarity plots](https://mhahsler.github.io/seriation/seriation_cluster_evaluation.html) #' #' @references Michael Hahsler, Kurt Hornik, and Christian Buchta. Getting things in order: An introduction to the R package seriation. Journal of Statistical Software, 25(3):1--34, March 2008. \doi{10.18637/jss.v025.i03} #' #' @importFrom graphics plot text title #' @importFrom ca ca #' @importFrom stats reorder as.dist hclust runif rnorm dist order.dendrogram prcomp #' @useDynLib seriation, .registration=TRUE "_PACKAGE" seriation/R/Psych24.R0000644000176200001440000000252614706524256014047 0ustar liggesusers#' Results of 24 Psychological Test for 8th Grade Students #' #' A data set collected by Holzinger and Swineford (1939) which consists of the #' results of 24 psychological tests given to 145 seventh and eighth grade #' students in a Chicago suburb. This data set contains the correlation matrix #' for the 24 test results. #' The data set was also used as an example for visualization of cluster analysis #' by Ling (1973). #' #' @name Psych24 #' @aliases Psych24 #' @docType data #' @format #' A 24 x 24 correlation matrix. #' @references #' Holzinger, K. L., Swineford, F. (1939): #' A study in factor analysis: The stability of a bi-factor solution. #' _Supplementary Educational Monograph,_ No. **48**. #' Chicago: University of Chicago Press. #' #' Ling, R. L. (1973): A computer generated aid for cluster analysis. #' _Communications of the ACM,_ #' **16**(6), pp. 355--361. #' @examples #' data("Psych24") #' #' ## create a dist object and also get rid of the one negative entry in the #' ## correlation matrix #' d <- as.dist(1 - abs(Psych24)) #' #' pimage(d) #' #' ## do hclust as in Ling (1973) #' hc <- hclust(d, method = "complete") #' plot(hc) #' #' pimage(d, hc) #' #' ## use seriation #' order <- seriate(d, method = "tsp") #' #order <- seriate(d, method = "tsp", control = list(method = "concorde")) #' pimage(d, order) #' @keywords datasets NULL seriation/R/register_smacof.R0000644000176200001440000001204214706524256015761 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (C) 2015 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. #' Register Seriation Methods from Package smacof #' #' Registers the `"MDS_smacof"` method for [seriate()] based on multidimensional #' scaling using stress majorization and the corresponding `"smacof_stress0"` #' criterion implemented in package smacof (de Leeuw & Mair, 2009). #' #' Seriation method `"smacof"` implements stress majorization with several transformation functions. #' These functions are passed on as the type control parameter. We default #' to `"ratio"`, which together with `"interval"` performs metric MDS. #' `"ordinal"` can be used #' for non-metric MDS. See [smacof::smacofSym()] for details on the #' control parameters. #' #' The corresponding criterion called `"smacof_stress0"` is also registered. #' There additional parameter `type` is used to specify the used #' transformation function. It should agree with the function used for seriation. #' See [smacof::stress0()] for details on the stress calculation. #' #' **Note:** Package \pkg{smacof} needs to be installed. #' #' @aliases registersmacof smacof #' @family seriation #' @returns Nothing. #' #' @references #' Jan de Leeuw, Patrick Mair (2009). Multidimensional Scaling Using Majorization: SMACOF in R. #' _Journal of Statistical Software, 31(3),_ 1-30. \doi{10.18637/jss.v031.i03} #' @keywords optimize cluster #' @examples #' \dontrun{ #' register_smacof() #' #' get_seriation_method("dist", "MDS_smacof") #' #' d <- dist(random.robinson(20, pre = TRUE)) #' #' ## use Banded AR form with default clustering (complete-link) #' o <- seriate(d, "MDS_smacof", verbose = TRUE) #' pimage(d, o) #' #' # recalculate stress for the order #' MDS_stress(d, o) #' #' # ordinal MDS. stress needs to be calculated using the correct type with stress0 #' o <- seriate(d, "MDS_smacof", type = "ordinal", verbose = TRUE) #' criterion(d, o, method = "smacof_stress0", type = "ordinal") #' } #' @export register_smacof <- function() { check_installed("smacof") .smacof_control <- structure( list( type = "ratio", init = "torgerson", relax = FALSE, modulus = 1, itmax = 1000, eps = 1e-06, verbose = FALSE ), help = list( type = 'MDS type: "interval", "ratio", "ordinal" (nonmetric MDS)', init = 'start configuration method ("torgerson"/"random")', relax = "use block relaxation for majorization?", modulus = "number of smacof iterations per monotone regression call", itmax = "maximum number of iterations", eps = "convergence criterion" ) ) seriate_dist_smacof <- function(x, control = NULL) { control <- .get_parameters(control, .smacof_control) r <- smacof::smacofSym( x, ndim = 1, type = control$type, verbose = control$verbose, init = control$init, relax = control$relax, modulus = control$modulus, itmax = control$itmax, eps = control$eps ) if (control$verbose) print(r) config <- drop(r$conf) names(config) <- labels(x) o <- order(config) attr(o, "configuration") <- config o } set_seriation_method( "dist", "MDS_smacof", seriate_dist_smacof, "Seriation based on multidemensional scaling using stress majorization (de Leeuw & Mair, 2009).", .smacof_control, optimizes = .opt("smacof_stress0", "MDS stress"), verbose = TRUE ) .smacof_contr <- structure( list( type = "ratio", warn = FALSE, more = NA ), help = list( type = "MDS type (see ? smacof::stress0)", warn = "produce a warning if the 1D MDS fit does not preserve the given order (see ? seriation::uniscale).", more = "more arguments are passed on to smacof::stress0." ) ) smacof_crit_stress0 <- function(x, order, type = "ratio", warn = FALSE, ...) { conf <- get_config(order) if (is.null(conf)) conf <- uniscale(x, order, warn = warn) smacof::stress0(x, cbind(conf), type = type, ...)$stress } set_criterion_method( "dist", "smacof_stress0", smacof_crit_stress0, "Stress0 calculated for different transformation types from package smacof.", FALSE, verbose = TRUE, control = .smacof_contr ) } seriation/R/gghmap.R0000644000176200001440000000276414706524256014062 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. #' @rdname hmap #' @include hmap.R #' @export gghmap <- function(x, distfun = stats::dist, method = "OLO_complete", control = NULL, scale = c("none", "row", "column"), prop = FALSE, ...) { scale <- match.arg(scale) if (inherits(x, "dist")) { # scale and distFun are ignored! o <- seriate(x, method = method, control = control) } else { x <- as.matrix(x) contr <- list( dist_fun = distfun, seriation_method = method, seriation_control = control, scale = scale ) o <- seriate(x, method = "heatmap", control = contr) } ggpimage(x, o, prop = prop, ...) } seriation/R/Wood.R0000644000176200001440000000204614706524256013520 0ustar liggesusers#' Gene Expression Data for Wood Formation in Poplar Trees #' #' A data matrix containing a sample of the normalized gene expression data for #' 6 locations in the stem of Popla trees published in the study by Herzberg et #' al (2001). The sample of 136 genes selected by Caraux and Pinloche (2005). #' #' @name Wood #' @family data #' @docType data #' @format The format is a 136 x 6 matrix. #' @references Hertzberg M., H. Aspeborg, J. Schrader, A. Andersson, #' R.Erlandsson, K. Blomqvist, R. Bhalerao, M. Uhlen, T. T. Teeri, J. #' Lundeberg, Bjoern Sundberg, P. Nilsson and Goeran Sandberg (2001): A #' transcriptional roadmap to wood formation, _PNAS,_ **98**(25), #' 14732--14737. #' #' Caraux G. and Pinloche S. (2005): PermutMatrix: a graphical environment to #' arrange gene expression profiles in optimal linear order, #' _Bioinformatics,_ **21**(7) 1280--1281. #' @source The data was obtained from #' \url{http://www.atgc-montpellier.fr/permutmatrix/manual/Exemples/Wood/Wood.htm}. #' @keywords datasets #' @examples #' data(Wood) #' head(Wood) NULL seriation/R/ser_dist.R0000644000176200001440000003325114706524256014426 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. .dist_methods <- c("spearman", "kendall", "manhattan", "euclidean", "hamming", "ppc", "aprd") .cor_methods <- c("spearman", "kendall", "ppc" ) #' Dissimilarities and Correlations Between Seriation Orders #' #' Calculates dissimilarities/correlations between seriation orders in a list of type #' [ser_permutation_vector]. #' #' For seriation, an order and its reverse are considered identical and are #' often just an artifact due to the method that creates the order. #' This is one of the major differences between seriation orders and rankings #' which impacts how correlations and similarities between seriation orders are #' calculated. The default setting `reverse = TRUE` corrects for this issue. #' #' `ser_cor()` calculates the correlation between two seriation orders. #' For ranking-based correlation measures (Spearman and #' Kendall) the absolute value of the correlation is returned. This effectively #' corrects for correlations between reversed orders but has the effect that #' no negative correlations exist. #' For `test = TRUE`, the appropriate test for association is performed #' and a matrix with p-values is returned as the attribute `"p-value"`. #' Note that no correction for multiple testing is performed. #' #' For `ser_dist()`, the correlation coefficients (Kendall's tau and #' Spearman's rho) are converted into a dissimilarity by taking one minus the #' correlation value. The Manhattan distance between the ranks in a #' linear order is equivalent to Spearman's footrule metric (Diaconis 1988). #' For the non-correlation based measures, #' `reverse = TRUE` returns the pairwise minima using also the reversed #' order. #' #' Two precedence invariant measure especially developed for seriation are #' available. Here `reverse` is ignored. #' #' The positional proximity coefficient (ppc) is a precedence invariant measure #' based on product of the squared positional distances in two permutations #' defined as (see Goulermas et al 2016): #' #' \deqn{d_{ppc}(R, S) = 1/h \sum_{j=2}^n \sum_{i=1}^{j-1} #' (\pi_R(i)-\pi_R(j))^2 * (\pi_S(i)-\pi_S(j))^2,} #' #' where \eqn{R} and \eqn{S} are two seriation orders, \eqn{pi_R} and #' \eqn{pi_S} are the associated permutation vectors and \eqn{h} is a #' normalization factor. The associated generalized correlation coefficient is #' defined as \eqn{1-d_{ppc}}. #' #' The absolute pairwise rank difference (aprd) is also precedence invariant #' and defined as a distance measure: #' #' \deqn{d_{aprd}(R, S) = \sum_{j=2}^n \sum_{i=1}^{j-1} | |\pi_R(i)-\pi_R(j)| - #' |\pi_S(i)-\pi_S(j)| |^p,} #' #' where \eqn{p} is the power which can be passed on as parameter `p` and #' is by default set to 2. #' #' `ser_align()` tries to normalize the direction in a list of seriations #' such that ranking-based methods can be used. We add for each permutation #' also the reversed order to the set and then use a modified version of Prim's #' algorithm for finding a minimum spanning tree (MST) to choose if the #' original seriation order or its reverse should be used. We retain the direction #' of each order that is added to the MST first. #' Every time an order is added, its reverse is removed from the possible #' remaining orders. #' #' @family permutation #' #' @param x set of seriation orders as a list with elements which can be #' coerced into [ser_permutation_vector] objects. #' @param y if not `NULL` then a single seriation order can be specified. #' In this case `x` has to be a single seriation order and not a list. #' @param method a character string with the name of the used measure. #' Available measures are for correlation and distances are #' `"kendall"`,`"spearman"` and `"ppc"` #' (positional proximity coefficient). For distances only the additional methods #' `"manhattan"`, `"euclidean"`, `"hamming"`, and `"aprd"` (absolute pairwise #' rank differences) are also available. #' @param reverse a logical indicating if the revers orders should also be checked in #' for rank-based methods. #' @param test a logical indicating if a correlation test should be performed. #' @param ... Further arguments passed on to the method. #' @return #' - `ser_dist()` returns an object of class [stats::dist]. #' - `ser_align()` returns a new list with elements of class #' [ser_permutation]. #' @author Michael Hahsler #' @references P. Diaconis (1988): _Group Representations in Probability and #' Statistics,_ Institute of Mathematical Statistics, Hayward, CA. #' #' J.Y. Goulermas, A. Kostopoulos, and T. Mu (2016): A New Measure for #' Analyzing and Fusing Sequences of Objects. _IEEE Transactions on #' Pattern Analysis and Machine Intelligence_ **38**(5):833-48. #' \doi{10.1109/TPAMI.2015.2470671} #' @keywords cluster #' @examples #' set.seed(1234) #' ## seriate dist of 50 flowers from the iris data set #' data("iris") #' x <- as.matrix(iris[-5]) #' x <- x[sample(1:nrow(x), 50), ] #' rownames(x) <- 1:50 #' d <- dist(x) #' #' ## Create a list of different seriations #' methods <- c("HC_complete", "OLO", "GW", "VAT", #' "TSP", "Spectral", "MDS", "Identity", "Random") #' #' os <- sapply(methods, function(m) { #' cat("Doing", m, "... ") #' tm <- system.time(o <- seriate(d, method = m)) #' cat("took", tm[3],"s.\n") #' o #' }) #' #' ## Compare the methods using distances. Default is based on #' ## Spearman's rank correlation coefficient where reverse orders are #' ## also considered. #' ds <- ser_dist(os) #' hmap(ds, margin = c(7,7)) #' #' ## Compare using correlation between orders. Reversed orders have #' ## negative correlation! #' cs <- ser_cor(os, reverse = FALSE) #' hmap(cs, margin = c(7,7)) #' #' ## Compare orders by allowing orders to be reversed. #' ## Now all but random and identity are highly positive correlated #' cs2 <- ser_cor(os, reverse = TRUE) #' hmap(cs2, margin=c(7,7)) #' #' ## A better approach is to align the direction of the orders first #' ## and then calculate correlation. #' os_aligned <- ser_align(os) #' cs3 <- ser_cor(os_aligned, reverse = FALSE) #' hmap(cs3, margin = c(7,7)) #' #' ## Compare the orders using clustering. We use Spearman's foot rule #' ## (Manhattan distance of ranks). In order to use rank-based method, #' ## we align the direction of the orders. #' os_aligned <- ser_align(os) #' ds <- ser_dist(os_aligned, method = "manhattan") #' plot(hclust(ds)) #' @export ser_dist <- function(x, y = NULL, method = "spearman", reverse = TRUE, ...) { method <- match.arg(tolower(method), .dist_methods) ## make sure everything is a permutation vector if (!is.null(y)) x <- list(ser_permutation_vector(x), ser_permutation_vector(y)) else x <- lapply(x, ser_permutation_vector) if (!reverse) switch( method, spearman = stats::as.dist(1 - ser_cor( x, method = "spearman", reverse = FALSE )), kendall = stats::as.dist(1 - ser_cor( x, method = "kendal", reverse = FALSE )), ### Manhattan == Spearman's footrule manhattan = stats::dist(t(.lget_rank(x)), method = "manhattan"), euclidean = stats::dist(t(.lget_rank(x)), method = "euclidean"), hamming = .dist_hamming(t(.lget_rank(x))), ppc = as.dist(1 - ser_cor( x, method = "ppc", reverse = FALSE )), aprd = stats::as.dist(.aprd(x, ...)) ) else switch( method, spearman = stats::as.dist(1 - ser_cor( x, method = "spearman", reverse = TRUE )), kendall = stats::as.dist(1 - ser_cor( x, method = "kendal", reverse = TRUE )), ### Manhattan == Spearman's footrule manhattan = .find_best(dist(t( .lget_rank(.add_rev(x)) ), method = "manhattan")), euclidean = .find_best(dist(t( .lget_rank(.add_rev(x)) ), method = "euclidean")), hamming = .find_best(.dist_hamming(t( .lget_rank(.add_rev(x)) ))), ### positional proximity coefficient is direction invariant ppc = stats::as.dist(1 - ser_cor( x, method = "ppc", reverse = FALSE )), aprd = stats::as.dist(.aprd(x, ...)) ) } #' @rdname ser_dist #' @export ser_cor <- function(x, y = NULL, method = "spearman", reverse = TRUE, test = FALSE) { method <- match.arg(tolower(method), .cor_methods) ## make sure everything is a permutation vector if (!is.null(y)) x <- list(ser_permutation_vector(x), ser_permutation_vector(y)) else x <- lapply(x, ser_permutation_vector) m <- .lget_rank(x) if (method == "ppc") { if (test) stop("No test for association available for PPC!") return(.ppc(x)) } ## cor based methods co <- stats::cor(m, method = method) if (reverse) co <- abs(co) ## add a correlation test? if (test) { p <- outer(1:ncol(m), 1:ncol(m), FUN = Vectorize(function(i, j) stats::cor.test(m[, i], m[, j], method = method)$p.value)) dimnames(p) <- dimnames(co) attr(co, "p-value") <- p } co } #' @rdname ser_dist #' @export ser_align <- function(x, method = "spearman") { if (!is.list(x)) stop("x needs to be a list with elements of type 'ser_permutation_vector'") x <- lapply(x, ser_permutation_vector) .do_rev(x, .alignment(x, method = method)) } .dist_hamming <- function(x) { n <- nrow(x) m <- matrix(nrow = n, ncol = n) for (i in seq_len(n)) for (j in seq(i, n)) m[j, i] <- m[i, j] <- sum(x[i, ] != x[j, ]) mode(m) <- "numeric" dimnames(m) <- list(rownames(x), rownames(x)) stats::as.dist(m) } ### make a permutation list into a rank matrix (cols are permutations) .lget_rank <- function(x) sapply(x, get_rank) ### add reversed permutations to a list of permutations .add_rev <- function(x) { os <- append(x, lapply(x, rev)) names(os) <- c(labels(x), paste(labels(x), "_rev", sep = "")) os } ### reverses permutations in the list given a logical indicator vector .do_rev <- function(x, rev) { for (i in which(rev)) x[[i]] <- rev(x[[i]]) x } ### finds the smallest distance in lists with reversed orders present .find_best <- function(d) { ### find smallest values m <- as.matrix(d) n <- nrow(m) / 2 m1 <- m[1:n, 1:n] m2 <- m[(n + 1):(2 * n), (n + 1):(2 * n)] m3 <- m[1:n, (n + 1):(2 * n)] m4 <- m[(n + 1):(2 * n), 1:n] stats::as.dist(pmin(m1, m2, m3, m4)) } ### find largest values in matrix .find_best_max <- function(d) { m <- as.matrix(d) n <- nrow(m) / 2 m1 <- m[1:n, 1:n] m2 <- m[(n + 1):(2 * n), (n + 1):(2 * n)] m3 <- m[1:n, (n + 1):(2 * n)] m4 <- m[(n + 1):(2 * n), 1:n] pmax(m1, m2, m3, m4) } ### x needs to be a list of ser_permutation_vectors ### returns TRUE for sequences which should be reversed .alignment <- function(x, method = "spearman") { method <- match.arg(tolower(method), .dist_methods) n <- length(x) ## calculate dist (orders + reversed orders) d <- as.matrix(ser_dist(.add_rev(x), method = method, reverse = FALSE)) diag(d) <- NA for (i in 1:n) { d[i, n + i] <- NA d[n + i, i] <- NA } ## start with closest pair take <- which(d == min(d, na.rm = TRUE), arr.ind = TRUE)[1, ] #d[, c(take, (take+n) %% (2*n))] <- NA ## mark order and complement as taken d[, c(take, (take + n) %% (2 * n))] <- Inf ## keep adding the closest while (length(take) < n) { t2 <- which(d[take, ] == min(d[take, ], na.rm = TRUE), arr.ind = TRUE)[1, 2] #d[, c(t2, (t2+n) %% (2*n))] <- NA ### closest to all #t2 <- which.min(colSums(d[take,], na.rm = T)) d[, c(t2, (t2 + n) %% (2 * n))] <- Inf take <- append(take, t2) } ## create indicator vector for the orders which need to be reversed take_ind <- logical(n) take_ind[take[take > n] - n] <- TRUE names(take_ind) <- names(x) take_ind } ## Propositional Proximity Coefficient (1 - generalized corr. coef.) ## Goulermas, Kostopoulos and Mu (2016). A new measure for analyzing and fusing ## sequences of objects, IEEE Transactions on Pattern Analysis and Machine ## Intelligence 38(5):833-48. ## ## x,y ... permutation vectors (ranks) .vppc <- Vectorize(function(x, y) { x <- get_rank(x) y <- get_rank(y) n <- length(x) #sum <- 0 #for(j in 2:n) for(i in 1:(j-1)) sum <- sum + (x[i]-x[j])^2 * (y[i]-y[j])^2 ## use fast matrix algebra instead Ax <- (x %*% rbind(rep_len(1, n)) - tcrossprod(cbind(rep_len(1, n)), x)) ^ 2 Ay <- (y %*% rbind(rep_len(1, n)) - tcrossprod(cbind(rep_len(1, n)), y)) ^ 2 ## note: Ay is symetric sum <- sum(diag(Ax %*% Ay)) ## scale by theoretical maximum zapsmall(sum / (n ^ 6 / 15 - n ^ 4 / 6 + n ^ 2 / 10)) }) .ppc <- function(x) outer(x, x, .vppc) # Sum of differences of rank differences # # distance(R, S) = # \sum_{i,j} | |\pi_R(i)-\pi_R(j)| - |\pi_S(i)-\pi_S(j)| |^p # .vaprd <- Vectorize(function(x, y, p = 2) { x <- get_rank(x) y <- get_rank(y) n <- length(x) sum <- 0 for (j in 2:n) for (i in 1:(j - 1)) sum <- sum + abs(abs(x[i] - x[j]) - abs(y[i] - y[j])) ^ p ## FIXME: scale by theoretical maximum? sum }) .aprd <- function(x, p = 2) outer(x, x, .vaprd, p = p) seriation/R/seriate.dist.R0000644000176200001440000000422314723655024015202 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. #' @rdname seriate #' @export seriate.dist <- function(x, method = "Spectral", control = NULL, rep = 1L, ...) { ## check x if (anyNA(x)) stop("NAs not allowed in distance matrix x!") if (any(x < 0)) stop("Negative distances not supported!") N <- attr(x, "Size") if (N < 1L) stop("x needs to contain at least one object.") ## rep? if (rep > 1L) return(seriate_rep(x, method, control, rep = rep, ...)) ## add ... to control control <- c(control, list(...)) if (!is.character(method) || (length(method) != 1L)) stop("Argument 'method' must be a character string.") method <- get_seriation_method("dist", method) if (!is.null(control$verbose) && control$verbose) cat("Using seriation method: ", method$name, "\n", method$description, "\n\n", sep = "") # no ordering for a single object if (N < 2L) return(ser_permutation(ser_permutation_vector(1L, method = method$name))) tm <- system.time(order <- method$fun(x, control = control)) if (is.integer(order)) names(order) <- labels(x)[order] if (!is.null(control$verbose) && control$verbose) cat("Seriation took", tm[1] + tm[2], "sec\n\n") ser_permutation(ser_permutation_vector(order, method = method$name)) } seriation/R/lines_and_ordered_data.R0000644000176200001440000001505414706524256017244 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. #' Create Simulated Data for Seriation Evaluation #' #' Several functions to create simulated data to evaluate different aspects of #' seriation algorithms and criterion functions. #' #' `create_lines_data()` recreates the lines data set used in for [iVAT()] in #' Havens and Bezdeck (2012). #' #' `create_ordered_data()` (Hahsler et al, 2021) is a versatile #' function which creates "orderable" #' 2D data using Gaussian components along a linear or circular path. The #' components are equally spaced (`spacing`) along the path. The default #' spacing of 6 ensures that 2 adjacent components with a standard deviation of #' one along the direction of the path will barely touch. The standard #' deviation along the path is set by `sd1`. The standard deviation #' perpendicular to the path is set by `sd2`. A value larger than zero #' will result in the data not being perfectly orderable (i.e., the resulting #' distance matrix will not be a perfect pre-anti-Robinson matrix and contain #' anti-Robinson violation events after seriation). Note that a circular path #' always creates anti-Robinson violation since the circle has to be broken at #' some point to create a linear order. #' #' @family data #' #' @param n number of data points to create. #' @param k number of Gaussian components. #' @param size relative size (number of points) of components (length of k). #' If `NULL` then all components have the same size. #' @param spacing space between the centers of components. The default of 6 #' means that the components will barely touch at `ds1 = 1` (3 standard #' deviations for each Gaussian component). #' @param path Are the components arranged along a `"linear"` or #' `"circular"` path? #' @param sd1 variation in the direction along the components. A value greater #' than one means the components are mixing. #' @param sd2 variation perpendicular to the direction along the components. A #' value greater than 0 will introduce anti-Robinson violation events. #' @returns a data.frame with the created data. #' #' @author Michael Hahsler #' @seealso [seriate()], [criterion()], [iVAT()]. #' @references #' Havens, T.C. and Bezdek, J.C. (2012): An Efficient Formulation #' of the Improved Visual Assessment of Cluster Tendency (iVAT) Algorithm, #' _IEEE Transactions on Knowledge and Data Engineering,_ **24**(5), #' 813--822. #' #' Michael Hahsler, Christian Buchta and Kurt Hornik (2021). seriation: Infrastructure for #' Ordering Objects Using Seriation. R package version 1.3.2. #' \url{https://github.com/mhahsler/seriation} #' @keywords datasets #' @examples #' ## lines data set from Havens and Bezdek (2011) #' x <- create_lines_data(100) #' plot(x, xlim = c(-5, 5), ylim = c(-3, 3), cex = .2, col = attr(x, "id")) #' d <- dist(x) #' pimage(d, seriate(d, "OLO_single"), col = bluered(100, bias = .5), key = TRUE) #' #' ## create_ordered_data can produce many types of "orderable" data #' #' ## perfect pre-Anti-Robinson matrix (with a single components) #' x <- create_ordered_data(100, k = 1) #' plot(x, cex = .2, col = attr(x, "id")) #' d <- dist(x) #' pimage(d, seriate(d, "MDS"), col = bluered(100, bias=.5), key = TRUE) #' #' ## separated components #' x <- create_ordered_data(100, k = 5) #' plot(x, cex =.2, col = attr(x, "id")) #' d <- dist(x) #' pimage(d, seriate(d, "MDS"), col = bluered(100, bias = .5), key = TRUE) #' #' ## overlapping components #' x <- create_ordered_data(100, k = 5, sd1 = 2) #' plot(x, cex = .2, col = attr(x, "id")) #' d <- dist(x) #' pimage(d, seriate(d, "MDS"), col = bluered(100, bias = .5), key = TRUE) #' #' ## introduce anti-Robinson violations (a non-zero y value) #' x <- create_ordered_data(100, k = 5, sd1 = 2, sd2 = 5) #' plot(x, cex = .2, col = attr(x, "id")) #' d <- dist(x) #' pimage(d, seriate(d, "MDS"), col = bluered(100, bias = .5), key = TRUE) #' #' ## circular path (has always violations) #' x <- create_ordered_data(100, k = 5, path = "circular", sd1 = 2) #' plot(x, cex = .2, col = attr(x, "id")) #' d <- dist(x) #' pimage(d, seriate(d, "OLO"), col = bluered(100, bias = .5), key = TRUE) #' #' ## circular path (with more violations violations) #' x <- create_ordered_data(100, k = 5, path = "circular", sd1 = 2, sd2 = 1) #' plot(x, cex=.2, col = attr(x, "id")) #' d <- dist(x) #' pimage(d, seriate(d, "OLO"), col = bluered(100, bias = .5), key = TRUE) #' @export create_lines_data <- function(n = 250) { n1 <- n / 5 * 2 n2 <- n / 5 n3 <- n / 5 * 2 x1 <- data.frame(x = runif(n1, -5, 5), y = rnorm(n1, mean = 2, sd = .1)) x2 <- data.frame(x = runif(n2, -3, 3), y = rnorm(n2, mean = 0, sd = .1)) x3 <- data.frame(x = runif(n3, -5, 5), y = rnorm(n3, mean = -2, sd = .1)) id <- c(rep(1, times = n1), rep(2, times = n2), rep(3, times = n3)) x <- rbind(x1, x2, x3) o <- sample(nrow(x)) x <- x[o,] id <- id[o] rownames(x) <- 1:nrow(x) attr(x, "id") <- id x } #' @rdname create_lines_data #' @export create_ordered_data <- function(n = 250, k = 2, size = NULL, spacing = 6, path = "linear", sd1 = 1, sd2 = 0) { if (k > n) stop("k needs to be less than n!") path <- match.arg(path, c("linear", "circular")) ## size if (is.null(size)) size <- rep(1, k) else if (length(size) != k) stop("length of size vector and k do not agree!") size <- round(size / sum(size) * n) size[1] <- n - sum(size[-1]) ## create data ids <- rep(1:k, times = size) x <- data.frame(x = rnorm(n, mean = ids * spacing, sd = sd1), y = rnorm(n, mean = 0, sd = sd2)) ## transform if (path == "circular") { p <- k * spacing theta <- x[, 1] / p * 2 * pi r <- p / (2 * pi) + x[, 2] x <- cbind(x = r * sin(theta), y = r * cos(theta)) } ## randomize order o <- sample(nrow(x)) x <- x[o , , drop = FALSE] ids <- ids[o] attr(x, "id") <- ids x } seriation/R/AAA_map.R0000644000176200001440000000437314706524256014034 0ustar liggesusers####################################################################### # Code to map between ranges for continuous variables # Copyright (C) 2011 Michael Hahsler # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. ## mapping helper map <- function(x, range = c(0, 1), from.range = NA) { ## deal with infinite values infs <- is.infinite(x) if (any(infs)) { warning( "x contains infinite values. +Inf will be mapped to be mapped to largest value + range and -Inf to smallest value - range." ) min_max <- range(x[!infs], na.rm = TRUE) pos_inf_val <- min_max[2] + (min_max[2] - min_max[1]) neg_inf_val <- min_max[1] - (min_max[2] - min_max[1]) x[infs] <- ifelse(sign(x[infs] > 0), pos_inf_val, neg_inf_val) } ## set from range if (any(is.na(from.range))) from.range <- range(x, na.rm = TRUE) if (length(from.range) != 2L || from.range[1] > from.range[2]) stop('from.range needs to contain 2 numbers (upper <= lower bound).') from.range_width <- from.range[2] - from.range[1] if (length(range) != 2L) stop('range needs to contain 2 numbers (upper and lower bound).') range_width <- range[2] - range[1] ## if all values are the same and no from.range is given, then return the average range if (from.range_width == 0) { x[] <- mean(range) return(x) } ## map to [0,1] x <- (x - from.range[1]) / from.range_width ## map from [0,1] to [range] x <- x * range_width + range[1] x } map_int <- function(x, range = c(1L, 100L), from.range = NA) { if (length(range) == 1L) range <- c(1L, range) as.integer(map(x, c(range[1], range[2]), from.range)) } seriation/R/seriate.matrix.R0000644000176200001440000000233314706524256015546 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. #' @rdname seriate #' @include seriate.dist.R #' @export seriate.matrix <- function(x, method = "PCA", control = NULL, margin = c(1L, 2L), rep = 1L, ...) { if (rep > 1L) return(seriate_rep(x, method, control, rep = rep, margin = margin, ...)) .seriate_array_helper(x, method, control, margin, datatype = "matrix", ...) } seriation/R/AAA_check_installed.R0000644000176200001440000000263214706524256016367 0ustar liggesusers## This is a modified version from package rlang that only uses base R functionality. ## action can be "install" (from CRAN), "stop" (with message), "check" (returns TRUE/FALSE) ## manual can be either TRUE or a string with installation instructions. check_installed <- function (pkg, action = "install", message = NULL) { action <- match.arg(action, choices = c("install", "stop", "check")) if (!is.character(pkg)) stop("`pkg` must be a package name or a vector of package names.") needs_install <- sapply(pkg, function(x) ! requireNamespace(x, quietly = TRUE)) if (action == "check") return(!any(needs_install)) missing_pkgs <- pkg[needs_install] missing_pkgs_enum <- paste(missing_pkgs, collapse = ", ") info <- paste("The", missing_pkgs_enum, "package(s) is/are required.") if (any(needs_install)) { if (!interactive()) stop(info) if (action == "install") { question <- "Would you like to install the package(s)?" cat(info, "\n", question, sep = '') if (utils::menu(c("Yes", "No")) != 1) { invokeRestart("abort") } utils::install.packages(missing_pkgs) } else { ### this is stop cat(info, "\n", message, sep = '') invokeRestart("abort") } } invisible(TRUE) } seriation/R/Munsingen.R0000644000176200001440000000435414706524256014557 0ustar liggesusers#' Hodson's Munsingen Data Set #' #' This data set contains a grave times artifact incidence matrix for the #' Celtic Münsingen-Rain cemetery in Switzerland as provided by Hodson (1968) #' and published by Kendall 1971. #' #' @name Munsingen #' @docType data #' @family data #' @format A 59 x 70 0-1 matrix. Rows (graves) and columns (artifacts) are in #' the order determined by Hodson (1968). #' @references Hodson, F.R. (1968). #' _The La Tene Cemetery at Münsingen-Rain,_ Stämpfli, Bern. #' #' Kendall, D.G. (1971): Seriation from abundance matrices. In: Hodson, F.R., #' Kendall, D.G. and Tautu, P., (Editors), _Mathematics in the #' Archaeological and Historical Sciences,_ Edinburgh University Press, #' Edinburgh, 215--232. #' @keywords datasets #' @examples #' data("Munsingen") #' #' ## Seriation method after Kendall (1971) #' ## Kendall's square symmetric matrix S and SoS #' S <- function(x, w = 1) { #' sij <- function(i , j) w * sum(pmin(x[i,], x[j,])) #' h <- nrow(x) #' r <- matrix(ncol = h, nrow =h) #' for(i in 1:h) for (j in 1:h) r[i,j] <- sij(i,j) #' r #' } #' #' SoS <- function(x) S(S(x)) #' #' ## Kendall's horse shoe (Hamiltonian arc) #' horse_shoe_plot <- function(mds, sigma, threshold = mean(sigma), ...) { #' plot(mds, main = paste("Kendall's horse shoe with th =", threshold), ...) #' l <- which(sigma > threshold, arr.ind=TRUE) #' for(i in 1:nrow(l)) lines(rbind(mds[l[i,1],], mds[l[i,2],])) #' } #' #' ## shuffle data #' x <- Munsingen[sample(nrow(Munsingen)),] #' #' ## calculate matrix and do isoMDS (from package MASS) #' sigma <- SoS(x) #' library("MASS") #' mds <- isoMDS(1/(1+sigma))$points #' #' ## plot Kendall's horse shoe #' horse_shoe_plot(mds, sigma) #' #' ## find order using a TSP #' library("TSP") #' tour <- solve_TSP(insert_dummy(TSP(dist(mds)), label = "cut"), #' method = "2-opt", control = list(rep = 15)) #' tour <- cut_tour(tour, "cut") #' lines(mds[tour,], col = "red", lwd = 2) #' #' ## create and plot order #' order <- ser_permutation(tour, 1:ncol(x)) #' bertinplot(x, order, options= list(panel=panel.circles, #' rev = TRUE)) #' #' ## compare criterion values #' rbind( #' random = criterion(x), #' reordered = criterion(x, order), #' Hodson = criterion(Munsingen) #' ) NULL seriation/R/seriate_enumerate.R0000644000176200001440000000470614706524256016316 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. # utilities from package smacof next.perm <- function(x) .C("permNext", as.double(x), as.integer(length(x)), PACKAGE = "seriation")[[1]] are.monotone <- function(x, y) as.logical(.C( "isMon", as.double(x), as.double(y), as.integer(length(x)), as.integer(1), PACKAGE = "seriation" )[[4]]) .control_enumerate <- list(criterion = "Gradient_weighted", verbose = FALSE) attr(.control_enumerate, "help") <- list(criterion = "Criterion measure to optimize") seriate_dist_enumerate <- function(x, control = NULL) { control <- .get_parameters(control, .control_enumerate) n <- attr(x, "Size") perm <- seq(n) best_perm <- perm best_crit <- Inf suppressWarnings(m <- as.integer(factorial(n))) if (is.na(m)) stop("Number of permutations is too large.") k <- 0L if (control$verbose) cat("Permutation - of", m) repeat { k <- k + 1L if (control$verbose) { cat("\rPermutation", k, "of", m) } crit <- criterion(x, perm, method = control$criterion, force_loss = TRUE) if (crit < best_crit) { best_crit <- crit best_perm <- perm } #if (prod(perm==(n:1))==1) break if (k >= m) break perm <- next.perm(perm) } if (control$verbose) cat("\n") names(best_perm) <- attr(x, "Labels")[best_perm] best_perm } set_seriation_method( "dist", "Enumerate", seriate_dist_enumerate, "Enumerate all permutations", control = .control_enumerate, optimizes = .opt (NA, "set via control criterion)") ) seriation/R/ggVAT.R0000644000176200001440000000263414706524256013563 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. #' @rdname VAT #' @export ggVAT <- function(x, upper_tri = TRUE, lower_tri = TRUE, ...) { if (!inherits(x, "dist")) stop("x needs to be of class 'dist'!") ggpimage(x, seriate(x, "VAT"), upper_tri = upper_tri, lower_tri = lower_tri, ...) } #' @rdname VAT #' @export ggiVAT <- function(x, upper_tri = TRUE, lower_tri = TRUE, ...) { if (!inherits(x, "dist")) stop("x needs to be of class 'dist'!") x <- path_dist(x) ggpimage(x, seriate(x, "VAT"), upper_tri = upper_tri, lower_tri = lower_tri, ...) } seriation/R/seriate_HC.R0000644000176200001440000001350214706524256014615 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. ## Hierarchical clustering related seriations .hc_control <- list(hclust = NULL, linkage = "complete") attr(.hc_control, "help") <- list(hclust = "a precomputed hclust object (optional)", linkage = "hclust method") .hclust_helper <- function(d, control = NULL) { # Deprecated method control argument if (!is.null(control$method)) { warning("control parameter method is deprecated. Use linkage instead!") control$linkage <- control$method control$method <- NULL } control <- .get_parameters(control, .hc_control) if (!is.null(control$hclust)) return(control$hclust) return(hclust(d, method = control$linkage)) } seriate_dist_hc <- function(x, control = NULL) .hclust_helper(x, control) seriate_dist_hc_single <- function(x, control = NULL) .hclust_helper(x, control = list(linkage = "single")) seriate_dist_hc_average <- function(x, control = NULL) .hclust_helper(x, control = list(linkage = "average")) seriate_dist_hc_complete <- function(x, control = NULL) .hclust_helper(x, control = list(linkage = "complete")) seriate_dist_hc_ward <- function(x, control = NULL) .hclust_helper(x, control = list(linkage = "ward.D2")) seriate_dist_gw <- function(x, control = NULL) reorder(seriate_dist_hc(x, control), x, method = "GW") seriate_dist_gw_single <- function(x, control = NULL) reorder(seriate_dist_hc_single(x, control), x, method = "GW") seriate_dist_gw_average <- function(x, control = NULL) reorder(seriate_dist_hc_average(x, control), x, method = "GW") seriate_dist_gw_complete <- function(x, control = NULL) reorder(seriate_dist_hc_complete(x, control), x, method = "GW") seriate_dist_gw_ward <- function(x, control = NULL) reorder(seriate_dist_hc_ward(x, control), x, method = "GW") seriate_dist_olo <- function(x, control = NULL) reorder(seriate_dist_hc(x, control), x, method = "OLO") seriate_dist_olo_single <- function(x, control = NULL) reorder(seriate_dist_hc_single(x, control), x, method = "OLO") seriate_dist_olo_average <- function(x, control = NULL) reorder(seriate_dist_hc_average(x, control), x, method = "OLO") seriate_dist_olo_complete <- function(x, control = NULL) reorder(seriate_dist_hc_complete(x, control), x, method = "OLO") seriate_dist_olo_ward <- function(x, control = NULL) reorder(seriate_dist_hc_ward(x, control), x, method = "OLO") .hc_desc <- "Using the order of the leaf nodes in a dendrogram obtained by hierarchical clustering" .optHCPL <- .opt("Path_length", "restricted by dendrogram") set_seriation_method("dist", "HC", seriate_dist_hc, .hc_desc, .hc_control) set_seriation_method("dist", "HC_single", seriate_dist_hc_single, paste(.hc_desc, "(single link)")) set_seriation_method( "dist", "HC_complete", seriate_dist_hc_complete, paste(.hc_desc, "(complete link).") ) set_seriation_method("dist", "HC_average", seriate_dist_hc_average, paste(.hc_desc, "(avg. link).")) set_seriation_method("dist", "HC_ward", seriate_dist_hc_ward, paste(.hc_desc, "(Ward's method).")) .gw_desc <- "Using the order of the leaf nodes in a dendrogram obtained by hierarchical clustering and reordered by the Gruvaeus and Wainer (1972) heuristic" set_seriation_method("dist", "GW", seriate_dist_gw, .gw_desc, .hc_control, optimizes = .optHCPL) set_seriation_method( "dist", "GW_single", seriate_dist_gw_single, paste(.gw_desc, "(single link)"), optimizes = .optHCPL ) set_seriation_method( "dist", "GW_average", seriate_dist_gw_average, paste(.gw_desc, "(avg.link)"), optimizes = .optHCPL ) set_seriation_method( "dist", "GW_complete", seriate_dist_gw_complete, paste(.gw_desc, "(complete link)"), optimizes = .optHCPL ) set_seriation_method( "dist", "GW_ward", seriate_dist_gw_ward, paste(.gw_desc, "(Ward's method)"), optimizes = .optHCPL ) .olo_desc <- "Using the order of the leaf nodes in a dendrogram obtained by hierarchical clustering and reordered by with optimal leaf ordering (Bar-Joseph et al., 2001)" set_seriation_method("dist", "OLO", seriate_dist_olo, .olo_desc, .hc_control, optimizes = .optHCPL) set_seriation_method( "dist", "OLO_single", seriate_dist_olo_single, paste(.olo_desc, "(single link)"), optimizes = .optHCPL ) set_seriation_method( "dist", "OLO_average", seriate_dist_olo_average, paste(.olo_desc, "(avg. link)"), optimizes = .optHCPL ) set_seriation_method( "dist", "OLO_complete", seriate_dist_olo_complete, paste(.olo_desc, "(complete link)"), optimizes = .optHCPL ) set_seriation_method( "dist", "OLO_ward", seriate_dist_olo_ward, paste(.olo_desc, "(Ward's method)"), optimizes = .optHCPL ) seriation/R/seriate_identity.R0000644000176200001440000000351514706524256016157 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. seriate_dist_identity <- function(x, control = NULL) { #param <- .get_parameters(control, NULL) .get_parameters(control, NULL) o <- 1:attr(x, "Size") o } seriate_matrix_identity <- function(x, control, margin = seq_along(dim(x))) { control <- .get_parameters(control, NULL) lapply(seq_along(dim(x)), function(i) if (i %in% margin) seq(dim(x)[i]) else NA) } set_seriation_method("matrix", "Identity", seriate_matrix_identity, "Identity permutation", optimized = "None") set_seriation_method("array", "Identity", seriate_matrix_identity, "Identity permutation", optimized = "None") set_seriation_method("dist", "Identity", seriate_dist_identity, "Identity permutation", optimized = "None") seriation/R/register_umap.R0000644000176200001440000001056114706524256015457 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (C) 2015 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. #' Register Seriation Based on 1D UMAP #' #' Use uniform manifold approximation and projection (UMAP) to embed the data #' on the number line and create a order for [seriate()]. #' #' Registers the method `"umap"` for [seriate()]. This method applies #' 1D UMAP to a data matrix or a distance matrix and extracts the order from #' the 1D embedding. #' #' Control parameter `n_epochs` can be increased to find a better embedding. #' #' The returned seriation permutation vector has an attribute named #' `embedding` containing the umap embedding. #' #' \bold{Note:} Package \pkg{umap} needs to be installed. #' #' @aliases register_umap umap #' @seealso [umap::umap()] in \pkg{umap}. #' @family seriation #' @returns Nothing. #' #' @references McInnes, L and Healy, J, UMAP: Uniform Manifold Approximation and #' Projection for Dimension Reduction, ArXiv e-prints 1802.03426, 2018. #' @keywords optimize cluster #' @examples #' #' \dontrun{ #' register_umap() #' #' ## distances #' get_seriation_method("dist", "umap") #' #' data(SupremeCourt) #' d <- as.dist(SupremeCourt) #' #' o <- seriate(d, method = "umap", verbose = TRUE) #' pimage(d, o) #' #' # look at the returned embedding and plot it #' attr(o[[1]], "configuration") #' plot_config(o) #' #' ## matrix #' get_seriation_method("matrix", "umap") #' #' data("Zoo") #' Zoo[,"legs"] <- (Zoo[,"legs"] > 0) #' x <- as.matrix(Zoo[,-17]) #' label <- rownames(Zoo) #' class <- Zoo$class #' #' o <- seriate(x, method = "umap", verbose = TRUE) #' pimage(x, o) #' #' plot_config(o[[1]], col = class) #' } #' @export register_umap <- function() { check_installed("umap") .contr <- unclass(umap::umap.defaults) .contr$n_epochs <- 1000 .contr$n_neighbors <- NA .contr$n_components <- 1 .contr$alpha <- 0.001 .contr$input <- NA .contr$random_state <- NA attr(.contr, "help") <- list(n_neighbors = "see ? umap::umap for help") umap_order <- function(x, control) { control <- .get_parameters(control, .contr) if (is.na(control$input)) control$input <- "dist" x <- as.matrix(x) # we cannot have more neighbors than data points if (is.na(control$n_neighbors)) control$n_neighbors <- 15 control$n_neighbors <- min(control$n_neighbors, nrow(x)) # use different random numbers for every run if (is.na(control$random_state)) control$random_state <- as.integer(runif(1, 0, .Machine$integer.max)) # has to be 1 control$n_components <- 1 class(control) <- class(umap::umap.defaults) embedding <- umap::umap(x, config = control) o <- order(embedding$layout) embedding <- drop(embedding$layout) names(embedding) <- rownames(x) attr(o, "configuration") <- embedding o } umap_order_matrix_2 <- function(x, control, margin = seq_along(dim(x))) { control$input <- "data" if (1L %in% margin) row <- umap_order(x, control) else row <- NA if (2L %in% margin) col <- umap_order(t(x), control) else col <- NA list(row, col) } set_seriation_method( "dist", "umap", umap_order, "Use 1D Uniform manifold approximation and projection (UMAP) embedding of the distances to create an order (McInnes and Healy, 2018)", .contr, randomized = TRUE, verbose = TRUE ) set_seriation_method( "matrix", "umap", umap_order_matrix_2, "Use 1D Uniform manifold approximation and projection (UMAP) embedding of the data to create an order (McInnes and Healy, 2018)", .contr, randomized = TRUE, verbose = TRUE ) } seriation/R/pimage.R0000644000176200001440000004010614706524256014051 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. ## image method that makes a proper image plot of a matrix. ## the rows and columns are swapped and the order of the ## columns (original rows) is reversed. #' Permutation Image Plot #' #' Provides methods for matrix shading, i.e., displaying a color image for #' matrix (including correlation matrices and data frames) and `dist` objects given an #' optional permutation. The plot arranges colored rectangles to represent the #' values in the matrix. This visualization is also know as a heatmap. #' Implementations based on the #' \pkg{grid} graphics engine and based n \pkg{ggplot2} are provided. #' #' Plots a matrix in its original row and column orientation ([image] in \pkg{stats} #' reverses the rows). This means, in a #' plot the columns become the x-coordinates and the rows the y-coordinates (in #' reverse order). #' #' **Grid-based plot:** The viewports used for plotting are called: #' `"plot"`, `"image"` and `"colorkey"`. Use \pkg{grid} functions #' to manipulate the plots (see Examples section). #' #' **ggplot2-based plot:** A ggplot2 object is returned. Colors, axis limits #' and other visual aspects can be added using standard ggplot2 functions #' (`labs`, `scale_fill_continuous`, `labs`, etc.). #' #' @family plots #' #' @param x a matrix, a data.frame, or an object of class `dist`. #' @param order a logical where `FALSE` means no reordering and `TRUE` applies #' a permutation using the default seriation method for the type of `x`. Alternatively, #' any object that can be coerced to class `ser_permutation` #' can be supplied. #' @param col a list of colors used. If `NULL`, a gray scale is used (for #' matrix larger values are displayed darker and for `dist` smaller #' distances are darker). For matrices containing logical data, black and white #' is used. For matrices containing negative values a symmetric diverging color #' palette is used. #' @param main plot title. #' @param xlab,ylab labels for the x and y axes. #' @param zlim vector with two elements giving the range (min, max) for #' representing the values in the matrix. #' @param key logical; add a color key? No key is available for logical #' matrices. #' @param keylab string plotted next to the color key. #' @param symkey logical; if `x` contains negative values, should the #' color palate be symmetric (zero is in the middle)? #' @param upper_tri,lower_tri,diag a logical indicating whether to show the #' upper triangle, the lower triangle or the diagonal of the (distance) matrix. #' @param row_labels,col_labels a logical indicating if row and column labels #' in `x` should be displayed. If `NULL` then labels are displayed #' if the `x` contains the appropriate dimname and the number of labels is #' 25 or less. A character vector of the appropriate length with labels can #' also be supplied. #' @param prop logical; change the aspect ratio so cells in the image have a #' equal width and height. #' @param flip_axes logical; exchange rows and columns for plotting. #' @param reverse_columns logical; revers the order of how the columns are #' displayed. #' @param \dots if `order` is the name of a seriation method then further arguments are passed #' on to the seriation method, otherwise they are ignored. #' @param newpage,pop,gp Start plot on a new page, pop the viewports after #' plotting, and use the supplied `gpar` object (see \pkg{grid}). #' @returns Nothing. #' #' @author Christian Buchta and Michael Hahsler #' @keywords hplot #' @examples #' set.seed(1234) #' data(iris) #' x <- as.matrix(iris[sample(nrow(iris), 20) , -5]) #' #' pimage(x) #' #' # Show all labels and flip axes, reverse columns, or change colors #' pimage(x, prop = TRUE) #' pimage(x, flip_axes = TRUE) #' pimage(x, reverse_columns = TRUE) #' pimage(x, col = grays(100)) #' #' # A matrix with positive and negative values #' x_scaled <- scale(x) #' pimage(x_scaled) #' #' # Use reordering #' pimage(x_scaled, order = TRUE) #' pimage(x_scaled, order = "Heatmap") #' #' ## Example: Distance Matrix #' # Show a reordered distance matrix (distances between rows). #' # Dark means low distance. The aspect ratio is automatically fixed to 1:1 #' # using prop = TRUE #' d <- dist(x) #' pimage(d) #' pimage(d, order = TRUE) #' #' # Supress the upper triangle and diagonal #' pimage(d, order = TRUE, upper = FALSE, diag = FALSE) #' #' # Show only distances that are smaller than 2 using limits on z. #' pimage(d, order = TRUE, zlim = c(0, 3)) #' #' ## Example: Correlation Matrix #' # we calculate correlation between rows and seriate the matrix #' # and seriate by converting the correlations into distances. #' # pimage reorders then rows and columns with c(o, o). #' r <- cor(t(x)) #' o <- seriate(as.dist(sqrt(1 - r))) #' pimage(r, order = c(o, o), #' upper = FALSE, diag = FALSE, #' zlim = c(-1, 1), #' reverse_columns = TRUE, #' main = "Correlation matrix") #' #' # Add to the plot using functions in package grid #' # Note: pop = FALSE allows us to manipulate viewports #' library("grid") #' pimage(x, order = TRUE, pop = FALSE) #' #' # available viewports are: "main", "colorkey", "plot", "image" #' current.vpTree() #' #' # Highlight cell 2/2 with a red arrow #' # Note: columns are x and rows are y. #' downViewport(name = "image") #' grid.lines(x = c(1, 2), y = c(-1, 2), arrow = arrow(), #' default.units = "native", gp = gpar(col = "red", lwd = 3)) #' #' # add a red box around the first 4 rows of the 2nd column #' grid.rect(x = 1 + .5 , y = 4 + .5, width = 1, height = 4, #' hjust = 0, vjust = 1, #' default.units = "native", gp = gpar(col = "red", lwd = 3, fill = NA)) #' #' ## remove the viewports #' popViewport(0) #' #' ## put several pimages on a page (use grid viewports and newpage = FALSE) #' # set up grid layout #' library(grid) #' grid.newpage() #' top_vp <- viewport(layout = grid.layout(nrow = 1, ncol = 2, #' widths = unit(c(.4, .6), unit = "npc"))) #' col1_vp <- viewport(layout.pos.row = 1, layout.pos.col = 1, name = "col1_vp") #' col2_vp <- viewport(layout.pos.row = 1, layout.pos.col = 2, name = "col2_vp") #' splot <- vpTree(top_vp, vpList(col1_vp, col2_vp)) #' pushViewport(splot) #' #' seekViewport("col1_vp") #' o <- seriate(d) #' pimage(x, c(o, NA), col_labels = FALSE, main = "Data", #' newpage = FALSE) #' #' seekViewport("col2_vp") #' ## add the reordered dissimilarity matrix for rows #' pimage(d, o, main = "Distances", #' newpage = FALSE) #' #' popViewport(0) #' #' ##------------------------------------------------------------- #' ## ggplot2 Examples #' if (require("ggplot2")) { #' #' library("ggplot2") #' #' set.seed(1234) #' data(iris) #' x <- as.matrix(iris[sample(nrow(iris), 20) , -5]) #' #' ggpimage(x) #' #' # Show all labels and flip axes, reverse columns #' ggpimage(x, prop = TRUE) #' ggpimage(x, flip_axes = TRUE) #' ggpimage(x, reverse_columns = TRUE) #' #' #' # A matrix with positive and negative values #' x_scaled <- scale(x) #' ggpimage(x_scaled) #' #' # Use reordering #' ggpimage(x_scaled, order = TRUE) #' ggpimage(x_scaled, order = "Heatmap") #' #' ## Example: Distance Matrix #' # Show a reordered distance matrix (distances between rows). #' # Dark means low distance. The aspect ratio is automatically fixed to 1:1 #' # using prop = TRUE #' d <- dist(x) #' ggpimage(d) #' ggpimage(d, order = TRUE) #' #' # Supress the upper triangle and diagonal #' ggpimage(d, order = TRUE, upper = FALSE, diag = FALSE) #' #' # Show only distances that are smaller than 2 using limits on z. #' ggpimage(d, order = TRUE, zlim = c(0, 2)) #' #' ## Example: Correlation Matrix #' # we calculate correlation between rows and seriate the matrix #' r <- cor(t(x)) #' o <- seriate(as.dist(sqrt(1 - r))) #' ggpimage(r, order = c(o, o), #' upper = FALSE, diag = FALSE, #' zlim = c(-1, 1), #' reverse_columns = TRUE) + labs(title = "Correlation matrix") #' #' ## Example: Custom themes and colors #' # Reorder matrix, use custom colors, add a title, #' # and hide colorkey. #' ggpimage(x) + #' theme(legend.position = "none") + #' labs(title = "Random Data") + xlab("Variables") #' #' # Add lines #' ggpimage(x) + #' geom_hline(yintercept = seq(0, nrow(x)) + .5) + #' geom_vline(xintercept = seq(0, ncol(x)) + .5) #' #' # Use ggplot2 themes with theme_set #' old_theme <- theme_set(theme_linedraw()) #' ggpimage(d) #' theme_set(old_theme) #' #' # Use custom color palettes: Gray scale, Colorbrewer (provided in ggplot2) and colorspace #' ggpimage(d, order = seriate(d), upper_tri = FALSE) + #' scale_fill_gradient(low = "black", high = "white", na.value = "white") #' #' ggpimage(d, order = seriate(d), upper_tri = FALSE) + #' scale_fill_distiller(palette = "Spectral", direction = +1, na.value = "white") #' #' ggpimage(d, order = seriate(d), upper_tri = FALSE) + #' colorspace::scale_fill_continuous_sequential("Reds", rev = FALSE, na.value = "white") #' } #' @export pimage <- function(x, order = FALSE, ...) UseMethod("pimage") ### Note for matrix large values are dark, for dist large values are light! #' @rdname pimage #' @export pimage.matrix <- function(x, order = FALSE, col = NULL, main = "", xlab = "", ylab = "", zlim = NULL, key = TRUE, keylab = "", symkey = TRUE, upper_tri = TRUE, lower_tri = TRUE, diag = TRUE, row_labels = NULL, col_labels = NULL, prop = isSymmetric(x), flip_axes = FALSE, reverse_columns = FALSE, ..., newpage = TRUE, pop = TRUE, gp = NULL) { force(prop) x <- as.matrix(x) # check data if (all(is.na(x))) stop("all data missing in x.") if (any(is.infinite(x))) stop("x contains infinite entries.") # set default values # no key for logical data! if (is.logical(x)) key <- FALSE if (is.null(col)) { if (is.logical(x)) col <- c("white", "black") else { if (!is.null(zlim)) { if (min(zlim) < 0) col <- .diverge_pal(100) else col <- .sequential_pal(100) } else { if (any(x < 0, na.rm = TRUE)) { col <- .diverge_pal(100) zlim <- max(abs(range(x, na.rm = TRUE))) * c(-1, 1) } else col <- .sequential_pal(100) } } } if (is.null(prop)) prop <- FALSE if (is.null(gp)) gp <- gpar() if (is.null(zlim)) zlim <- range(x, na.rm = TRUE) # reorder if (!is.null(order)) x <- permute(x, order, ...) # mask triangles if (any(!upper_tri || !lower_tri || !diag) && nrow(x) != ncol(x)) stop("Upper triange, lower triangle or diagonal can only be suppressed for square matrices!") if (!upper_tri) x[upper.tri(x)] <- NA if (!lower_tri) x[lower.tri(x)] <- NA if (!diag) diag(x) <- NA # change x and y if (flip_axes) { x <- t(x) tmp <- row_labels row_labels <- col_labels col_labels <- tmp } # reverse order of columns if (reverse_columns) x <- x[, seq(ncol(x), 1)] # deal with row/col labels if (!is.null(row_labels) && !is.logical(row_labels)) { if (length(row_labels) != nrow(x)) stop("Length of row_labels does not match the number of rows of x.") rownames(x) <- row_labels row_labels <- TRUE } if (!is.null(col_labels) && !is.logical(col_labels)) { if (length(col_labels) != ncol(x)) stop("Length of col_labels does not match the number of columns of x.") colnames(x) <- col_labels col_labels <- TRUE } if (is.null(row_labels)) if (!is.null(rownames(x)) && nrow(x) < 25) { row_labels <- TRUE } else{ row_labels <- FALSE } if (is.null(col_labels)) if (!is.null(colnames(x)) && ncol(x) < 25) { col_labels <- TRUE } else{ col_labels <- FALSE } if (is.null(rownames(x))) rownames(x) <- seq(nrow(x)) if (is.null(colnames(x))) colnames(x) <- seq(ncol(x)) # create layout for plot bottom_mar <- if (col_labels) max(stringWidth(colnames(x))) + unit(3, "lines") else unit(1, "lines") left_mar <- if (row_labels) max(stringWidth(rownames(x))) + unit(3, "lines") else unit(1, "lines") if (newpage) grid.newpage() if (key) { .grid_basic_layout_with_colorkey( main = main, left = left_mar, right = unit(0, "lines"), bottom = bottom_mar, gp = gp ) down <- downViewport("colorkey") .grid_colorkey(zlim, col = col, horizontal = FALSE, lab = keylab) upViewport(down) } else .grid_basic_layout( main = main, left = left_mar, right = unit(0, "lines"), bottom = bottom_mar, gp = gp ) down <- downViewport("plot") .grid_image( x, col = col, zlim = zlim, prop = prop ) #, gp=gp) upViewport(down) ## axes and labs down <- downViewport("image") if (col_labels) grid.text( colnames(x), y = unit(-1, "lines"), x = unit(1:ncol(x), "native"), rot = 90, just = "right" ) #, gp=gp) #grid.xaxis(at=1:ncol(x), # label=colnames(x)) if (row_labels) grid.text( rownames(x), x = unit(-1, "lines"), y = unit(1:nrow(x), "native"), just = "right" ) #, gp=gp) #grid.yaxis(at=1:nrow(x), # label=rownames(x)) if (xlab != "") grid.text(xlab, y = -1 * bottom_mar + unit(1, "lines")) #, gp=gp) if (ylab != "") grid.text(ylab, x = ,-1 * left_mar + unit(1, "lines"), rot = 90) #, gp=gp) # it is always 2 up from main seekViewport("main") down <- 2 if (pop) popViewport(down) else upViewport(down) } #' @export pimage.default <- pimage.matrix # as.matrix does not work for table! table2matrix <- function(M) matrix(M, ncol = ncol(M), dimnames = dimnames(M)) #' @rdname pimage #' @export pimage.table <- function(x, order = NULL, ...) pimage.matrix(table2matrix(x), order = order, ...) #' @rdname pimage #' @export pimage.data.frame <- function(x, order = NULL, ...) pimage.matrix(as.matrix(x), order = order, ...) ## small values are dark #' @rdname pimage #' @export pimage.dist <- function(x, order = NULL, col = NULL, main = "", xlab = "", ylab = "", zlim = NULL, key = TRUE, keylab = "", symkey = TRUE, upper_tri = TRUE, lower_tri = TRUE, diag = TRUE, row_labels = NULL, col_labels = NULL, prop = TRUE, flip_axes = FALSE, reverse_columns = FALSE, ..., newpage = TRUE, pop = TRUE, gp = NULL) { if (is.null(col)) col <- rev(.sequential_pal(100)) else col <- rev(col) if (is.null(prop)) prop <- TRUE if (!is.null(order)) x <- permute(x, order, ...) if (flip_axes) warning("flip_axes has no effect for distance matrices.") pimage.matrix( x, order = NULL, # already reordered main = main, xlab = xlab, ylab = ylab, col = col, zlim = zlim, key = key, keylab = keylab, symkey = symkey, upper_tri = upper_tri, lower_tri = lower_tri, diag = diag, row_labels = row_labels, col_labels = col_labels, prop = prop, flip_axes = FALSE, reverse_columns = reverse_columns, ..., newpage = newpage, pop = pop, gp = gp ) } seriation/R/seriate_CA.R0000644000176200001440000000366214706524256014614 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. ## use the projection on the first principal component to determine the ## order ## use the projection on the first principal component to determine the ## order .ca_contr <- list( dim = 1L, ca_param = NULL ) attr(.ca_contr, "help") <- list( dim = "CA dimension used for reordering", ca_param = "List with parameters for the call to ca::ca()" ) # CA ignores margin seriate_matrix_ca <- function(x, control = NULL, margin = seq_along(dim(x))) { control <- .get_parameters(control, .ca_contr) mat.ca <- do.call(ca::ca, c(list(obj = x), control$ca_param)) rcoord <- mat.ca$rowcoord # row coordinates row <- order(rcoord[, control$dim]) ccoord <- mat.ca$colcoord # col coordinates col <- order(ccoord[, control$dim]) #names(row) <- rownames(x)[row] #names(col) <- colnames(x)[col] list(row = row, col = col) } set_seriation_method( "matrix", "CA", seriate_matrix_ca, "This method calculates a correspondence analysis of the matrix and computes an order according to the scores on a correspondence analysis dimension (Friendly 2023).", .ca_contr ) seriation/R/seriate_GSA.R0000644000176200001440000001276614706524256014750 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (C) 2017 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. ## Simulated annealing reimplimentation following 'arsa.f' by Brusco et al. ## can use any criterion function #' Neighborhood functions for Seriation Method SA #' #' Definition of different local neighborhood functions for the method `"SA"` for [seriate()]. #' #' Local neighborhood functions are `LS_insert`, `LS_swap`, `LS_reverse`, and `LS_mix` #' (1/3 insertion, 1/3 swap and 1/3 reverse). Any neighborhood function can be defined. #' @name LS #' @aliases LS #' @param o an integer vector with the order #' @param pos random positions used for the local move. #' @returns returns the new order vector representing the random neighbor. NULL #' @rdname LS #' @export LS_swap <- function(o, pos = sample.int(length(o), 2)) { tmp <- o[pos[1]] o[pos[1]] <- o[pos[2]] o[pos[2]] <- tmp o } ### insert pos[1] in pos[2] #' @rdname LS #' @export LS_insert <- function(o, pos = sample.int(length(o), 2)) { append(o[-pos[1]], o[pos[1]], after = pos[2] - 1) } #' @rdname LS #' @export LS_reverse <- function(o, pos = sample.int(length(o), 2)) { o[pos[1]:pos[2]] <- o[pos[2]:pos[1]] o } #' @rdname LS #' @export LS_mixed <- function(o, pos = sample.int(length(o), 2)) { switch(sample.int(3, 1), LS_swap(o, pos), LS_insert(o, pos), LS_reverse(o, pos)) } .sa_contr <- list( criterion = "Gradient_raw", cool = 0.5, t_min = 1e-7, localsearch = "LS_insert", try_multiplier = 5, t0 = NA, p_initial_accept = .01, warmstart = "Random", ## use "Random" for random init. ## try try_multiplier x n local search steps verbose = FALSE ) attr(.sa_contr, "help") <- list( criterion = "Criterion measure to optimize", cool = "cooling factor (smaller means faster cooling)", t_min = "stopping temperature", localsearch = "used local search move function", try_multiplier = "number of local move tries per object", t0 = "initial temperature (if NA then it is estimated)", p_initial_accept = "Probability to accept a bad move at time 0 (used for t0 estimation)", warmstart = "permutation or seriation method for warmstart" ) seriate_sa <- function(x, control = NULL) { param <- .get_parameters(control, .sa_contr) n <- attr(x, "Size") localsearch <- get(param$localsearch) if (!is.function(localsearch)) localsearch <- get(localsearch) crit <- param$crit if (is.ser_permutation(param$warmstart)) { .check_dist_perm(x, order = param$warmstart) o <- get_order(param$warmstart) } else{ if (param$verbose) cat("Obtaining initial solution via:", param$warmstart, "\n") o <- get_order(seriate(x, method = param$warmstart)) } z <- criterion(x, o, method = param$criterion, force_loss = TRUE) if (param$verbose) cat("Initial z =", z, "(minimize)\n") iloop <- param$try_multiplier * n t0 <- param$t0 if (is.na(t0)) { # find the starting temperature. Set the probability of the average # (we use median) uphill move to pinitaccept. o_rand <- sample(n) z_rand <- criterion(x, o_rand, method = param$criterion, force_loss = TRUE) z_new <- replicate(iloop, expr = { criterion( x, localsearch(o_rand), method = param$criterion, force_loss = TRUE ) }) deltas <- (z_rand - z_new) deltas[deltas > 0] <- NA avg_delta <- stats::median(deltas, na.rm = TRUE) t0 <- avg_delta / log(param$p_initial_accept) } nloop <- as.integer((log(param$t_min) - log(t0)) / log(param$cool)) if (t0 <= 0) { t0 <- 0 nloop <- 1L } if (param$verbose) cat("Use t0 =", t0, "resulting in", nloop, "iterations with", iloop, "tries each\n\n") zbest <- z temp <- t0 for (i in 1:nloop) { m <- 0L for (j in 1:iloop) { onew <- localsearch(o) znew <- criterion(x, onew, method = crit, force_loss = TRUE) delta <- z - znew # we minimize, delta < 0 is a bad move if (delta > 0 || temp > 0 && runif(1) < exp(delta / temp)) { o <- onew z <- znew m <- m + 1L } } if (param$verbose) { cat( i, "/", nloop, "\ttemp =", signif(temp, 3), "\tz =", z, "\t accepted moves =", m, "/", iloop, "\n" ) } temp <- temp * param$cool } o } set_seriation_method( "dist", "GSA", seriate_sa, "Minimize a specified seriation measure (criterion) using simulated annealing.", .sa_contr, optimizes = .opt (NA, "set via control criterion"), randomized = TRUE ) seriation/R/Irish.R0000644000176200001440000000121614706524256013664 0ustar liggesusers#' Irish Referendum Data Set #' #' A data matrix containing the results of 8 referenda for 41 Irish communities #' used in Falguerolles et al (1997). #' #' Column 6 contains the size of the Electorate in 1992. #' #' @name Irish #' @docType data #' @family data #' @format The format is a 41 x 9 matrix. Two values are missing. #' @references de Falguerolles, A., Friedrich, F., Sawitzki, G. (1997) A #' Tribute to J. Bertin's Graphical Data Analysis. In: _Proceedings of the #' SoftStat '97 (Advances in Statistical Software 6),_ 11--20. #' @source The data was kindly provided by Guenter Sawitzki. #' @keywords datasets #' @examples #' data(Irish) NULL seriation/R/seriate_BEA.R0000644000176200001440000000525314723660556014721 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. #' @include seriate_TSP.R .bea_tsp_contr <- .tsp_control seriate_matrix_bea_tsp <- function(x, control, margin = seq_along(dim(x))) { if (any(x < 0)) stop("Requires a nonnegative matrix.") # single objects do not work so we skip them if (1L %in% margin) { if (nrow(x) > 1L) { criterion <- as.dist(tcrossprod(x)) row <- seriate(max(criterion) - criterion, method = "TSP", control = control)[[1]] } else { row <- 1L } attr(row, "method") <- "BEA_TSP" } else row <- NA if (2L %in% margin) { if (ncol(x) > 1L) { criterion <- as.dist(crossprod(x)) col <- seriate(max(criterion) - criterion, method = "TSP", control = control)[[1]] } else { col <- 1L } attr(col, "method") <- "BEA_TSP" } else col <- NA list(row = row, col = col) } seriate_matrix_bea <- function(x, control = NULL, margin = NULL) { control <- .get_parameters(control, list()) ### BEA is just cheapest insertion control <- list(method = "cheapest_insertion", two_opt = FALSE, rep = 1, verbose = control$verbose) seriate_matrix_bea_tsp(x, control = control, margin = margin) } ## register methods set_seriation_method( "matrix", "BEA", seriate_matrix_bea, "Bond Energy Algorithm (BEA; McCormick 1972) to maximize the Measure of Effectiveness of a non-negative matrix.", list(), optimizes = .opt("ME", "Measure of effectiveness"), randomized = TRUE ) set_seriation_method( "matrix", "BEA_TSP", seriate_matrix_bea_tsp, "Use a TSP to optimize the Measure of Effectiveness (Lenstra 1974).", .bea_tsp_contr, optimizes = .opt("ME", "Measure of effectiveness"), randomized = TRUE ) seriation/R/criterion.array.R0000644000176200001440000000360514706524256015725 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. ## Criterion for the quality of a permutation of a array .criterion_array_helper <- function(x, order = NULL, method = NULL, datatype = "array", force_loss = FALSE) { ## check order if (!is.null(order)) { if (!inherits(order, "ser_permutation")) stop("Argument 'order' has to be of class 'ser_permutation'.") .check_matrix_perm(x, order) } ## get methods if (is.null(method)) method <- list_criterion_methods(datatype) method <- lapply(method, function(m) get_criterion_method(datatype, m)) crit <- sapply(method, function(m) structure(m$fun(x, order), names = m$name)) if (force_loss) crit <- crit * sapply( method, FUN = function(m) ((as.integer(m$merit) * -2) + 1) ) crit } #' @rdname criterion #' @export criterion.array <- function(x, order = NULL, method = NULL, force_loss = FALSE, ...) .criterion_array_helper(x, order, method, "array", force_loss) seriation/R/AAA_color_palette.R0000644000176200001440000001214314706524256016105 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. #' Different Useful Color Palettes #' #' Defines several color palettes for [pimage()], [dissplot()] and #' [hmap()]. #' #' The color palettes are created with [colorspace::sequential_hcl()] and #' [colorspace::diverging_hcl()]. #' #' The two sequential palettes are: `reds()` and `grays()` (or #' `greys()`). #' #' The two diverging palettes are: `bluered()` and `greenred()`. #' #' @name palette #' @aliases palette colors #' @family plots #' #' @param n number of different colors produces. #' @param power used to control how chroma and luminance is increased (1 = #' linear, 2 = quadratic, etc.) #' @param bias a positive number. Higher values give more widely spaced colors #' at the high end. #' @param ... further parameters are passed on to [colorspace::sequential_hcl()] #' or [colorspace::diverging_hcl()]. #' @return A vector with `n` colors. #' @author Michael Hahsler #' @keywords hplot #' @examples #' m <- outer(1:10,1:10) #' m #' #' pimage(m) #' pimage(m, col = greys(100, power = 2)) #' pimage(m, col = greys(100, bias = 2)) #' pimage(m, col = bluered(100)) #' pimage(m, col = bluered(100, power = .5)) #' pimage(m, col = bluered(100, bias = 2)) #' pimage(m - 25, col = greenred(20, bias = 2)) #' #' ## choose your own color palettes #' library(colorspace) #' hcl_palettes(plot = TRUE) #' #' ## blues (with 20 shades) #' pimage(m, #' col = colorspace::sequential_hcl(20, "Blues", rev = TRUE)) #' ## blue to green (aka "Cork") #' pimage(m, #' col = colorspace::diverging_hcl(100, "Cork")) #' @export bluered <- function(n = 100, bias = 1, power = 1, ...) grDevices::colorRampPalette(colorspace::diverging_hcl(n, palette = "Blue-Red", power = power, ...), bias = bias)(n) #hclplot(bluered(10)) #plot(1:20, col = bluered(20), pch = 19, cex = 4) #' @rdname palette #' @export greenred <- function(n = 100, bias = 1, power = 1, ...) grDevices::colorRampPalette(rev( colorspace::diverging_hcl(n, palette = "Red-Green", power = power, ...) ), bias = bias)(n) #hclplot(greenred(10)) #plot(1:20, col = greenred(20), pch = 19, cex = 4) #' @rdname palette #' @export reds <- function(n = 100, bias = 1, power = 1, ...) grDevices::colorRampPalette(rev( colorspace::sequential_hcl(n, palette = "Reds", power = power, ...) ), bias = bias)(n) #hclplot(reds(10)) #plot(1:20, col = reds(20), pch = 19, cex = 4) #' @rdname palette #' @export blues <- function(n = 100, bias = 1, power = 1, ...) grDevices::colorRampPalette(rev( colorspace::sequential_hcl(n, palette = "Blues 2", power = power, ...) ), bias = bias)(n) #hclplot(blues(10)) #plot(1:20, col = blues(20), pch = 19, cex = 4) #' @rdname palette #' @export greens <- function(n = 100, bias = 1, power = 1, ...) grDevices::colorRampPalette(rev( colorspace::sequential_hcl(n, palette = "Greens", power = power, ...) ), bias = bias)(n) #hclplot(greens(10)) #plot(1:20, col = greens(20), pch = 19, cex = 4) #' @rdname palette #' @export greys <- function(n = 100, bias = 1, power = 1, ...) grDevices::colorRampPalette(rev( colorspace::sequential_hcl(n, palette = "Grays", power = power, ...) ), bias = bias)(n) #hclplot(greys(10)) #plot(1:20, col = greys(20), pch = 19, cex = 4) #' @rdname palette #' @export grays <- greys .map_color_01 <- function(x, col) { x[] <- col[map_int(x, length(col), from.range = c(0, 1))] x } # translate all data to a color .map_color <- function(x, col, from.range = NA) { x[] <- col[map_int(x, length(col), from.range)] x } ## define default colors #.sequential_pal <- grays .sequential_pal <- blues .diverge_pal <- bluered ## define default ggplot2 colors .gg_logical_pal <- function() ggplot2::scale_fill_manual(values = c("white", "black"), na.value = "white") .gg_sequential_pal <- function(dist = FALSE, limits = NULL) { if (dist) ggplot2::scale_fill_gradient(low = scales::muted("blue"), high = "white", na.value = "white", limits = limits) else ggplot2::scale_fill_gradient(low = "white", high = scales::muted("blue"), na.value = "white", limits = limits) } .gg_diverge_pal <- function(limits = NULL) ggplot2::scale_fill_gradient2( low = scales::muted("blue"), mid = "white", high = scales::muted("red"), na.value = "white", midpoint = 0, limits = limits ) seriation/R/criterion.R0000644000176200001440000003563514706524256014620 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. #' Criterion for a Loss/Merit Function for Data Given a Permutation #' #' Compute the value for different loss functions \eqn{L} and merit function #' \eqn{M} for data given a permutation. #' #' **Criteria for distance matrices (dist)** #' #' For a symmetric dissimilarity matrix \eqn{D} with elements \eqn{d(i,j)} #' where \eqn{i, j = 1 \ldots n}, the aim is generally to place low distance #' values close to the diagonal. The following criteria to judge the quality of #' a certain permutation of the objects in a dissimilarity matrix are currently #' implemented (for a more detailed description and an experimental comparison #' see Hahsler (2017)): #' #' - **Gradient measures:** `"Gradient_raw"`, `"Gradient_weighted"` (Hubert et al, 2001) #' #' A symmetric dissimilarity matrix where the values in #' all rows and columns only increase when moving away from the main diagonal #' is called a perfect \emph{anti-Robinson matrix} (Robinson 1951). A suitable #' merit measure which quantifies the divergence of a matrix from the #' anti-Robinson form is #' \deqn{ M(D) = \sum_{i=1}^n \sum_{i y.} #' #' It results in raw number of triples satisfying the gradient constraints #' minus triples which violate the constraints. #' #' The second function is defined as: \deqn{f(z,y) = |y-z| sign(y-z) = y-z} It #' weights the each satisfaction or violation by the difference by its #' magnitude given by the absolute difference between the values. #' #' - **Anti-Robinson events:** `"AR_events"`, `"AR_deviations"` (Chen, 2002) #' #' `"AR_events"` counts the number of violations of the anti-Robinson form. #' \deqn{ L(D) = \sum_{i=1}^n \sum_{i d_{ik}) } #' #' where \eqn{m=(2/3-n)w + nw^2 - 2/3 w^3}, the maximal number of possible #' anti-Robinson events in the window. The window size \eqn{w} represents the #' number of neighboring objects (number of entries from the diagonal of the #' distance matrix) are considered. The window size is \eqn{2 \le w < n}, where #' smaller values result in focusing on the local structure while larger values #' look at the global structure. #' #' `...` parameters are: #' #' - `w` window size. Default is to use a `pct` of 100% of \eqn{n}. #' - `pct` and alternative specification of w as a percentage of \eqn{n} in \eqn{(0, 100]}. #' - `relative` logical; can be set to `FALSE` to get the GAR, i.e., the absolute number of AR #' events in the window. #' #' - **Banded anti-Robinson form criterion:** `"BAR"` (Earle and Hurley, 2015) #' #' Simplified measure for closeness to the anti-Robinson form in a band of size #' \eqn{b} with \eqn{1 <= b < n} around the diagonal. #' #' \deqn{ L(D) = \sum_{|i-j|<=b} (b+1-|i-j|) d_{ij} } #' #' For \eqn{b = 1} the measure reduces to the Hamiltonian path length. For #' \eqn{b = n-1} the measure is equivalent to ARc defined (Earle and Hurley, #' 2015). Note that ARc is equivalent to the Linear Seriation criterion (scaled #' by 1/2). #' #' `...` parameter is: `b` band size defaults to a band of 20% of \eqn{n}. #' #' - **Hamiltonian path length:** `"Path_length"` (Caraux and Pinloche, 2005) #' #' The order of the objects in a dissimilarity matrix corresponds to a path #' through a graph where each node represents an object and is visited exactly #' once, i.e., a Hamilton path. The length of the path is defined as the sum of #' the edge weights, i.e., dissimilarities. #' #' \deqn{L(D) = \sum_{i=1}^{n-1} d_{i,i+1}} #' #' The length of the Hamiltonian path is equal to the value of the minimal span #' loss function (as used by Chen 2002). Both notions are related to the #' \emph{traveling salesperson problem (TSP).} #' #' If `order` is not unique or there are non-finite distance values #' `NA` is returned. #' #' - **Lazy path length:** `"Lazy_path_length"` (Earl and Hurley, 2015) #' #' A weighted version of the Hamiltonian path criterion. This loss function #' postpones larger distances to later in the order (i.e., a lazy traveling #' sales person). #' #' \deqn{L(D) = \sum_{i=1}^{n-1} (n-i) d_{i,i+1}} #' #' Earl and Hurley (2015) proposed this criterion for reordering in #' visualizations to concentrate on closer objects first. #' #' - **Inertia criterion:** `"Inertia"` (Caraux and Pinloche, 2005) #' #' Measures the moment of the inertia of dissimilarity values around the #' diagonal as #' #' \deqn{M(D) = \sum_{i=1}^n \sum_{j=1}^n d(i,j)|i-j|^2} #' #' \eqn{|i-j|} is used as a measure for the distance to the diagonal and #' \eqn{d(i,j)} gives the weight. This criterion gives higher weight to values #' farther away from the diagonal. It increases with quality. #' #' - **Least squares criterion:** `"Least_squares"` (Caraux and Pinloche, 2005) #' #' The sum of squared differences between distances and the rank differences: #' \deqn{L(D) = \sum_{i=1}^n #' \sum_{j=1}^n (d(i,j) - |i-j|)^2,} where \eqn{d(i,j)} is an element of the #' dissimilarity matrix \eqn{D} and \eqn{|i-j|} is the rank difference between #' the objects. #' #' Note that if Euclidean distance is used to calculate \eqn{D} from a data #' matrix \eqn{X}, the order of the elements in \eqn{X} by projecting them on #' the first principal component of \eqn{X} minimizes this criterion. The #' least squares criterion is related to \emph{unidimensional scaling.} #' #' - **Linear Seriation Criterion:** `"LS"` (Hubert and Schultz, 1976) #' #' Weights the distances with the absolute rank differences. #' #' \deqn{L(D) \sum_{i,j=1}^n d(i,j) (-|i-j|)} #' #' - **2-Sum Criterion:** `"2SUM"` (Barnard, Pothen and Simon, 1993) #' #' The 2-Sum loss criterion multiplies the similarity between objects with the #' squared rank differences. #' #' \deqn{L(D) \sum_{i,j=1}^n 1/(1+d(i,j)) (i-j)^2,} #' #' where \eqn{s(i,j) = 1/(1+d(i,j))} represents the similarity between objects #' \eqn{i} and \eqn{j}. #' #' - **Absolute Spearman Correlation** `"Rho"` #' #' The absolute value of the Spearman rank correlation #' between the original distances and the rank differences in the order. # The absolute value is taken because a reverse order is equivalent. #' #' - **Matrix measures:** `"ME"`, `"Moore_stress"`, `"Neumann_stress"` #' #' These criteria are defined on general matrices (see #' below for definitions). The dissimilarity matrix is first converted into a #' similarity matrix using \eqn{S = 1/(1+D)}. If a different transformation is #' required, then perform the transformation first and supply a matrix instead #' of a dist object. #' #' **Criteria for matrices (matrix)** #' #' For a general matrix \eqn{X = x_{ij}}, \eqn{i = 1 \ldots n} and #' \eqn{j = 1 \ldots m}, currently the following loss/merit functions are implemented: #' #' - **Measure of Effectiveness:** `"ME"` (McCormick, 1972). #' #' The measure of effectiveness (ME) for matrix \eqn{X}, is defined as #' #' \deqn{M(X) = 1/2 \sum_{i=1}^{n} \sum_{j=1}^{m} #' x_{i,j}(x_{i,j-1}+x_{i,j+1}+x_{i-1,j}+x_{i+1,j})} #' #' with, by convention #' #' \deqn{x_{0,j}=x_{m+1,j}=x_{i,0}=x_{i,n+1}=0.} #' #' ME is a merit measure, i.e. a higher ME indicates a better arrangement. #' Maximizing ME is the objective of the bond energy algorithm (BEA). ME is not #' defined for matrices with negative values. `NA` is returned in this #' case. #' #' - **Weighted correlation coefficient:** `"Cor_R"` (Deutsch and Martin, 1971) #' #' Developed as the Measure of Effectiveness for the Moment #' Ordering Algorithm. #' R is a merit measure normalized so that its value always lies in #' \eqn{[-1,1]}. For the special case of a square matrix \eqn{R=1} corresponds #' to only the main diagonal being filled, \eqn{R=0} to a random distribution #' of value throughout the array, and \eqn{R=-1} to the opposite diagonal only #' being filled. #' #' - **Matrix Stress:** `"Moore_stress"`, `"Neumann_stress"` (Niermann, 2005) #' #' Stress measures the conciseness of the presentation of a matrix/table and #' can be seen as a purity function which compares the values in a matrix/table #' with its neighbors. The stress measure used here is computed as the sum of #' squared distances of each matrix entry from its adjacent entries. #' #' \deqn{ L(X) = \sum_{i=1}^n \sum_{j=1}^m \sigma_{ij} } #' #' The following types of neighborhoods are available: #' #' - Moore: comprises the eight adjacent entries. #' \deqn{ #' \sigma_{ij} = \sum_{k=\max(1,i-1)}^{\min(n,i+1)} #' \sum_{l=\max(1,j-1)}^{\min(m,j+1)} (x_{ij} - x_{kl})^2 } #' - Neumann: comprises the four adjacent entries. \deqn{ \sigma_{ij} = #' \sum_{k=\max(1,i-1)}^{\min(n,i+1)} (x_{ij} - x_{kj})^2 + #' \sum_{l=\max(1,j-1)}^{\min(m,j+1)} (x_{ij} - x_{il})^2 } #' #' The major difference between the Moore and the Neumann neighborhood is that #' for the later the contribution of row and column permutations to stress are #' independent and thus can be optimized independently. #' #' @family criterion #' #' @param x an object of class [dist] or a matrix (currently no functions #' are implemented for array). #' @param order an object of class [ser_permutation] suitable for #' `x`. If `NULL`, the identity permutation is used. #' @param method a character vector with the names of the criteria to be #' employed (see [list_criterion_methods()]), or `NULL` (default) in which case all available criteria are #' used. #' @param ... additional parameters passed on to the criterion method. #' @param force_loss logical; should merit function be converted into loss #' functions by multiplying with -1? #' @return A named vector of real values. #' @author Michael Hahsler #' @references Barnard, S.T., A. Pothen, and H. D. Simon (1993): A Spectral #' Algorithm for Envelope Reduction of Sparse Matrices. _In Proceedings of #' the 1993 ACM/IEEE Conference on Supercomputing,_ 493--502. Supercomputing #' '93. New York, NY, USA: ACM. #' #' Caraux, G. and S. Pinloche (2005): Permutmatrix: A Graphical Environment to #' Arrange Gene Expression Profiles in Optimal Linear Order, #' _Bioinformatics,_ **21**(7), 1280--1281. #' #' Chen, C.-H. (2002): Generalized association plots: Information visualization #' via iteratively generated correlation matrices, _Statistica Sinica,_ #' **12**(1), 7--29. #' #' Deutsch, S.B. and J.J. Martin (1971): An ordering algorithm for analysis of #' data arrays. _Operational Research,_ **19**(6), 1350--1362. #' \doi{10.1287/opre.19.6.1350} #' #' Earle, D. and C.B. Hurley (2015): Advances in Dendrogram Seriation for #' Application to Visualization. _Journal of Computational and Graphical #' Statistics,_ **24**(1), 1--25. #' \doi{10.1080/10618600.2013.874295} #' #' Hahsler, M. (2017): An experimental comparison of seriation methods for #' one-mode two-way data. _European Journal of Operational Research,_ #' **257**, 133--143. #' \doi{10.1016/j.ejor.2016.08.066} #' #' Hubert, L. and J. Schultz (1976): Quadratic Assignment as a General Data #' Analysis Strategy. _British Journal of Mathematical and Statistical #' Psychology,_ **29**(2). Blackwell Publishing Ltd. 190--241. #' \doi{10.1111/j.2044-8317.1976.tb00714.x} #' #' Hubert, L., P. Arabie, and J. Meulman (2001): _Combinatorial Data #' Analysis: Optimization by Dynamic Programming._ Society for Industrial #' Mathematics. #' \doi{10.1137/1.9780898718553} #' #' Niermann, S. (2005): Optimizing the Ordering of Tables With Evolutionary #' Computation, _The American Statistician,_ **59**(1), 41--46. #' \doi{10.1198/000313005X22770} #' #' McCormick, W.T., P.J. Schweitzer and T.W. White (1972): Problem #' decomposition and data reorganization by a clustering technique, #' _Operations Research,_ **20**(5), 993-1009. #' \doi{10.1287/opre.20.5.993} #' #' Robinson, W.S. (1951): A method for chronologically ordering archaeological #' deposits, _American Antiquity,_ **16**, 293--301. #' \doi{10.2307/276978} #' #' Tien, Y-J., Yun-Shien Lee, Han-Ming Wu and Chun-Houh Chen (2008): Methods #' for simultaneously identifying coherent local clusters with smooth global #' patterns in gene expression profiles, _BMC Bioinformatics,_ #' **9**(155), 1--16. #' \doi{10.1186/1471-2105-9-155} #' @keywords cluster #' @examples #' ## create random data and calculate distances #' m <- matrix(runif(20),ncol=2) #' d <- dist(m) #' #' ## get an order for rows (optimal for the least squares criterion) #' o <- seriate(d, method = "MDS") #' o #' #' ## compare the values for all available criteria #' rbind( #' unordered = criterion(d), #' ordered = criterion(d, o) #' ) #' #' ## compare RGAR by window size (from local to global) #' w <- 2:(nrow(m)-1) #' RGAR <- sapply(w, FUN = function (w) #' criterion(d, o, method="RGAR", w = w)) #' plot(w, RGAR, type = "b", ylim = c(0,1), #' xlab = "Windows size (w)", main = "RGAR by window size") #' @export criterion <- function(x, order = NULL, method = NULL, force_loss = FALSE, ...) UseMethod("criterion") seriation/R/seriate.data.frame.R0000644000176200001440000000231414706524256016243 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. #' @rdname seriate #' @export seriate.data.frame <- function(x, method = "Heatmap", control = NULL, margin = c(1L, 2L), rep = 1L, ...) { if (rep > 1L) return(seriate_rep(x, method, control, rep = rep, margin = margin, ...)) .seriate_array_helper(as.matrix(x), method, control, margin, datatype = "matrix", ...) } seriation/R/hmap.R0000644000176200001440000003771614724362261013545 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. #' Plot Heat Map Reordered Using Seriation #' #' Provides heatmaps reordered using several different seriation methods. This #' includes dendrogram based reordering with optimal leaf order and matrix #' seriation-based heat maps. #' #' For dendrogram based heat maps, the arguments are passed on to #' [stats::heatmap()] in \pkg{stats}. The following arguments for `heatmap()` #' cannot be used: `margins`, `Rowv`, `Colv`, `hclustfun`, `reorderfun`. #' #' For seriation-based heat maps further arguments include: #' - `gp` an object of class `gpar` containing graphical #' parameters (see [gpar()] in package \pkg{grid}). #' - `newpage` a logical indicating whether to start plot on a new #' page #' - `prop` a logical indicating whether the height and width of `x` should #' be plotted proportional to its dimensions. #' - `showdist` Display seriated dissimilarity matrices? Values are #' `"none"`, `"both"`, `"rows"` or `"columns"`. #' - `key` logical; show a colorkey? #' - `key.lab` Label plotted next to the color key. #' - `margins` bottom and right-hand-side margins are calculated #' automatically or can be specifies as a vector of two numbers (in lines). #' - `zlim` range of values displayed. #' - `col`, `col_dist` color palettes used. #' #' @family plots #' #' @param x a matrix or a dissimilarity matrix of class dist. If a #' dissimilarity matrix is used, then the `distfun` is ignored. #' @param distfun function used to compute the distance (dissimilarity) between #' both rows and columns. For `gghmap()`, this #' parameter is passed on in `control`. #' @param method a character strings indicating the used seriation algorithm #' (see [seriate.dist()]). #' If the method results in a dendrogram then #' [stats::heatmap()] is used to show the dendrograms, otherwise #' reordered distance matrices are shown instead. #' @param control a list of control options passed on to the seriation #' algorithm specified in `method`. #' @param scale character indicating if the values should be centered and #' scaled in either the row direction or the column direction, or none. Default #' is none. #' @param plot_margins character indicating what to show in the margins. Options are: #' `"auto"`, `"dendrogram"`, `"distances"`, or `"none"`. #' @param col a list of colors used. #' @param col_dist colors used for displaying distances. #' @param row_labels,col_labels a logical indicating if row and column labels #' in `x` should be displayed. If `NULL` then labels are displayed #' if the `x` contains the appropriate dimname and the number of labels is #' 25 or less. A character vector of the appropriate length with labels can #' also be supplied. #' @param prop logical; change the aspect ratio so cells in the image have a #' equal width and height. #' @param \dots further arguments passed on to [stats::heatmap()]. #' @return An invisible list with elements: #' \item{rowInd, colInd}{index permutation vectors.} #' \item{reorder_method}{name of the method used to reorder the matrix.} #' #' The list may contain additional elements (dendrograms, colors, etc). #' #' @author Michael Hahsler #' @keywords hplot #' @examples #' data("Wood") #' #' # Default heatmap does Euclidean distance, hierarchical clustering with #' # complete-link and optimal leaf ordering. Note that the rows are #' # ordered top-down in the seriation order (stats::heatmap orders in reverse) #' hmap(Wood, main = "Wood (opt. leaf ordering)") #' hmap(Wood, plot_margins = "distances", main = "Wood (opt. leaf ordering)") #' hmap(Wood, plot_margins = "none", main = "Wood (opt. leaf ordering)") #' #' # Heatmap with correlation-based distance, green-red color (greenred is #' # predefined) and optimal leaf ordering and no row label #' dist_cor <- function(x) as.dist(sqrt(1 - cor(t(x)))) #' hmap(Wood, distfun = dist_cor, col = greenred(100), #' main = "Wood (reorded by corr. between obs.)") #' #' # Heatmap for distances #' d <- dist(Wood) #' hmap(d, main = "Wood (Euclidean distances)") #' #' # order-based with dissimilarity matrices #' hmap(Wood, method = "MDS_angle", #' col = greenred(100), col_dist = greens(100, power = 2), #' keylab = "norm. Expression", main = "Wood (reorderd with distances)") #' #' # Manually create a simple heatmap with pimage. #' o <- seriate(Wood, method = "heatmap", #' control = list(dist_fun = dist, seriation_method = "OLO_ward")) #' o #' #' pimage(Wood, o) #' #' # Note: method heatmap calculates reorderd hclust objects which can be used #' # for many heatmap implementations like the standard implementation in #' # package stats. #' heatmap(Wood, Rowv = as.dendrogram(o[[1]]), Colv = as.dendrogram(o[[2]])) #' #' # ggplot 2 version does not support dendrograms in the margin (for now) #' if (require("ggplot2")) { #' library("ggplot2") #' #' gghmap(Wood) + labs(title = "Wood", subtitle = "Optimal leaf ordering") #' #' gghmap(Wood, flip_axes = TRUE, prop = TRUE) + #' labs(title = "Wood", subtitle = "Optimal leaf ordering") #' #' dist_cor <- function(x) as.dist(sqrt(1 - cor(t(x)))) #' gghmap(Wood, distfun = dist_cor) + #' labs(title = "Wood", subtitle = "Reorded by correlation between observations") + #' scale_fill_gradient2(low = "darkgreen", high = "red") #' #' gghmap(d, prop = TRUE) + #' labs(title = "Wood", subtitle = "Euclidean distances, reordered") #' #' # Note: the ggplot2-based version currently cannot show distance matrices #' # in the same plot. #' #' # Manually seriate and plot as pimage. #' o <- seriate(Wood, method = "heatmap", control = list(dist_fun = dist, #' seriation_method = "OLO_ward")) #' o #' #' ggpimage(Wood, o) #' } #' @export hmap <- function(x, distfun = stats::dist, method = "OLO_complete", control = NULL, scale = c("none", "row", "column"), plot_margins = "auto", col = NULL, col_dist = grays(power = 2), row_labels = NULL, col_labels = NULL, ...) { scale <- match.arg(scale) plot_margins <- match.arg(plot_margins, c("auto", "dendrogram", "distances", "none")) if (is.null(col)) { if (any(x < 0, na.rm = TRUE)) col <- .diverge_pal() else col <- .sequential_pal() } # dist or matrix? if (inherits(x, "dist")) { dist_row <- dist_col <- x o <- seriate(x, method = method, control = control)[[1]] o <- ser_permutation(o, o) x <- as.matrix(x) # dist uses reversed colors! col <- rev(col) } else { if (!is.matrix(x)) x <- as.matrix(x) o <- seriate( x, "Heatmap", seriation_method = method, dist_fun = distfun, seriation_control = control, scale = scale ) } if (plot_margins == "auto") { if (all(sapply(o, inherits, "hclust"))) plot_margins <- "dendrogram" else plot_margins <- "distances" } if (plot_margins == "dendrogram" && !all(sapply(o, inherits, "hclust"))) { warning( "Dendrogramms not available for all dimensions! Plotting distance matrices instead." ) plot_margins <- "distances" } if (plot_margins == "dendrogram") { # heatmap by default scales rows: we don't want that! # options are ignored for now: we use ... stats::heatmap( x, Rowv = stats::as.dendrogram(rev(o[[1]])), Colv = stats::as.dendrogram(o[[2]]), scale = scale, col = col, labRow = row_labels, labCol = col_labels, ... ) } else if (plot_margins == "distances") { ### we plot seriated distance matrices #pimage(x, o, col = col, row_labels = row_labels, col_labels = col_labels, ...) .hmap_dist( x, method, dist_row = distfun(x), dist_col = distfun(t(x)), o, col = col, col_dist = col_dist, row_labels = row_labels, col_labels = col_labels, ... ) } else pimage(x, o, col = col, row_labels = row_labels, col_labels = col_labels, ...) ## return permutation indices return(invisible(list( o = o, seriation_method = method ))) } ## grid-based dissimilarity plot with seriation .hmap_dist <- function(x, method, dist_row, dist_col, o, ...) { o_row <- o[[1]] o_col <- o[[2]] ## options options <- list(...) options <- .get_parameters( options, list( col = if (any(x < 0)) .diverge_pal() else .sequential_pal(), col_dist = grays, prop = FALSE, main = NULL, key = TRUE, keylab = "", row_labels = NULL, col_labels = NULL, showdist = "both", symm = FALSE, margins = NULL, zlim = if (any(x < 0, na.rm = TRUE)) max(abs(range(x, na.rm = TRUE))) * c(-1, 1) else range(x, na.rm = TRUE), newpage = TRUE, gp = gpar() ) ) options$col_dist <- rev(options$col_dist) .showdist_options <- c("none", "row", "column", "both") options$showdist <- .showdist_options[pmatch(options$showdist, .showdist_options)] if (is.na(options$showdist)) stop("Unknown value for showdist. Use one of: ", paste(dQuote(.showdist_options), collapse = ", ")) ## if symmetric then we only use o_row and dist_row if (length(o_row) == length(o_col) && options$symm == TRUE) { o_col <- o_row dist_col <- dist_row } x <- permute(x, ser_permutation(o_row, o_col)) if (options$showdist == "none") { pimage( x, col = options$col, main = options$main, zlim = options$zlim, row_labels = options$row_labels, col_labels = options$col_labels, prop = options$prop, key = options$key, newpage = options$newpage, gp = options$gp ) return() } dist_row <- permute(dist_row, o_row) dist_col <- permute(dist_col, o_col) # deal with row/col labels row_labels <- options$row_labels col_labels <- options$col_labels if (!is.null(row_labels) && !is.logical(row_labels)) { if (length(row_labels) != nrow(x)) stop("Length of row_labels does not match the number of rows of x.") rownames(x) <- row_labels row_labels <- TRUE } if (!is.null(col_labels) && !is.logical(col_labels)) { if (length(col_labels) != ncol(x)) stop("Length of col_labels does not match the number of columns of x.") colnames(x) <- col_labels col_labels <- TRUE } if (is.null(row_labels)) if (!is.null(rownames(x)) && nrow(x) < 25) { row_labels <- TRUE } else{ row_labels <- FALSE } if (is.null(col_labels)) if (!is.null(colnames(x)) && ncol(x) < 25) { col_labels <- TRUE } else{ col_labels <- FALSE } if (is.null(rownames(x))) rownames(x) <- seq(nrow(x)) if (is.null(colnames(x))) colnames(x) <- seq(ncol(x)) ## Note: we need a list to store units! if (is.null(options$margins)) { options$margins <- list(unit(1, "lines"), unit(1, "lines")) if (col_labels) options$margins[[1]] <- max(stringWidth(colnames(x))) + unit(2, "lines") if (row_labels) options$margins[[2]] <- max(stringWidth(rownames(x))) + unit(2, "lines") all_names <- c("", if (col_labels) colnames(x), if (row_labels) rownames(x)) options$margins[[3]] <- max(stringWidth(all_names)) + unit(2, "lines") } else options$margins <- list( unit(options$margins[1], "lines"), unit(options$margins[2], "lines"), unit(max(options$margins), "lines") ) ## plot if (options$newpage) grid.newpage() ## surrounding viewport pushViewport(viewport( layout = grid.layout( nrow = 3 , ncol = 3, widths = unit.c( unit(1, "lines"), unit(1, "snpc") - options$margins[[3]] - unit(3, "lines"), options$margins[[2]] ), heights = unit.c( unit(3, "lines"), # main unit(1, "snpc") - options$margins[[3]] - unit(3, "lines"), options$margins[[1]] ) ), width = unit(1, "snpc"), height = unit(1, "snpc"), gp = options$gp )) ## main title if (!is.null(options$main)) { pushViewport(viewport(layout.pos.row = 1, layout.pos.col = 2)) grid.text(options$main, gp = gpar(cex = 1.3)) upViewport(1) } ## plots if (options$prop) { widths <- unit.c( unit(1 - ncol(x) / sum(ncol(x), nrow(x)), "npc") - unit(.25, "lines"), unit(.5, "lines"), unit(ncol(x) / sum(ncol(x), nrow(x)), "npc") - unit(.25, "lines") ) heights <- unit.c( unit(1 - nrow(x) / sum(ncol(x), nrow(x)), "npc") - unit(.25, "lines"), unit(.5, "lines"), #space unit(nrow(x) / sum(ncol(x), nrow(x)), "npc") - unit(.25, "lines") ) } else{ heights <- widths <- unit.c(unit(1, "null"), unit(.5, "lines"), # space unit(1, "null")) } pushViewport( viewport( layout = grid.layout( nrow = 3, ncol = 3, widths = widths, heights = heights ), width = unit(1, "snpc"), height = unit(1, "snpc"), layout.pos.row = 2, layout.pos.col = 2 ) ) # data pushViewport(viewport(layout.pos.row = 3, layout.pos.col = 3)) .grid_image(x, col = options$col, gp = options$gp, zlim = options$zlim) downViewport("image") if (col_labels) grid.text( colnames(x), y = unit(-1, "lines"), x = unit(1:ncol(x), "native"), rot = 90, just = "right" ) # , gp=options$gp) if (row_labels) grid.text( rownames(x), x = unit(1, "npc") + unit(1, "lines"), y = unit(1:nrow(x), "native"), just = "left" ) #, gp=options$gp) popViewport(1) popViewport(1) # rows if (options$showdist %in% c("row", "both")) { pushViewport(viewport(layout.pos.row = 3, layout.pos.col = 1)) .grid_image(as.matrix(dist_row), col = options$col_dist, gp = options$gp) popViewport(1) } # cols if (options$showdist %in% c("column", "both")) { pushViewport(viewport(layout.pos.row = 1, layout.pos.col = 3)) .grid_image(as.matrix(dist_col), col = options$col_dist, gp = options$gp) popViewport(1) } # colorkey if (options$key) { pushViewport(viewport(layout.pos.row = 1, layout.pos.col = 1)) pushViewport(viewport( width = unit(0.5, "npc"), height = unit(1, "lines") )) .grid_colorkey( options$zlim, col = options$col, lab = options$keylab, gp = options$gp ) popViewport(2) } popViewport(2) } seriation/R/bertinplot.R0000644000176200001440000003315614706524256015000 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. #' Plot a Bertin Matrix #' #' Plot a data matrix of cases and variables. Each value is represented by a #' symbol. Large values are highlighted. Note that Bertin arranges the cases #' horizontally and the variables as rows. The matrix can be rearranged using #' seriation techniques to make structure in the data visible (see Falguerolles #' et al 1997). #' #' The plot is organized as a matrix of symbols. The symbols are drawn by a #' panel function, where all symbols of a row are drawn by one call of the #' function (using vectorization). The interface for the panel function is #' `panel.myfunction(value, spacing, hl)`. `value` is the vector of #' values for a row scaled between 0 and 1, `spacing` contains the #' relative space between symbols and `hl` is a logical vector indicating #' which symbol should be highlighted. #' #' Cut lines can be added to an existing Bertin plot using #' `bertin_cut_line(x = NULL, y = NULL)`. `x`/`y` is can be a #' number indicating where to draw the cut line between two columns/rows. If #' both `x` and `y` is specified then one can select a row/column and #' the other can select a range to draw a line which does only span a part of #' the row/column. It is important to call `bertinplot()` with the option #' `pop = FALSE`. #' #' `ggbertinplot()` calls [ggpimage()] and all additional parameters are #' passed on. #' #' @family plots #' @param x a data matrix. Note that following Bertin, columns are variables #' and rows are cases. This behavior can be reversed using `reverse = TRUE` #' in `options`. #' @param order an object of class `ser_permutation` to rearrange `x` #' before plotting. If `NULL`, no rearrangement is performed. #' @param panel.function a function to produce the symbols. Currently available #' functions are `panel.bars` (default), `panel.circles`, #' `panel.rectangles`, `panel.tiles` and `panel.lines`. For #' circles and squares neg. values are represented by a dashed border. For #' blocks all blocks are the same size (can be used with `shading = TRUE`). #' @param geom visualization type. Available ggplot2 geometries are: `"tile"`, #' `"rectangle"`, `"circle"`, `"line"`, `"bar"`, `"none"`. #' @param highlight a logical scalar indicating whether to use highlighting. #' If `TRUE`, all variables with values greater than the variable-wise #' mean are highlighted. To control highlighting, also a logical matrix or a #' matrix with colors with the same dimensions as `x` can be supplied. #' @param row_labels,col_labels a logical indicating if row and column labels #' in `x` should be displayed. If `NULL` then labels are displayed #' if the `x` contains the appropriate dimname and the number of labels is #' 25 or less. A character vector of the appropriate length with labels can #' also be supplied. #' @param flip_axes logical indicating whether to swap cases and variables in #' the plot. The default (`TRUE`) is to plot cases as columns and #' variables as rows. #' @param prop logical; change the aspect ratio so cells in the image have a #' equal width and height. #' @param col,y and x in `bertin_cut_line()` are for adding a line to a `bertinplot()` (not ggplot2-based). #' @param value,spacing,hl are used internally for the panel functions. #' @param ... #' `ggbertinplot()`: further parameters are passed on to [ggpimage()]. #' #' `bertinplot()`: further parameters can include: #' - `xlab, ylab` labels (default: use labels from `x`). #' - `spacing` relative space between symbols (default: 0.2). #' - `shading` use gray shades to encode value instead of #' highlighting (default: `FALSE`). #' - `shading.function` a function that accepts a single argument in range \eqn{[.1, .8]} #' and returns a valid corresponding color (e.g., using [rgb()]). #' - `frame` plot a grid to separate symbols (default: `FALSE`). #' - `mar` margins (see [par()]). #' - `gp_labels` `gpar` object for labels (see [gpar()]) #' - `gp_panels` `gpar` object for panels (see [gpar()]). #' - `newpage` a logical indicating whether to start #' the plot on a new page (see [grid.newpage()]). #' - `pop` a logical indicating whether to pop the created viewports #' (see [pop.viewport()])? #' #' @returns Nothing. #' #' @author Michael Hahsler #' @references de Falguerolles, A., Friedrich, F., Sawitzki, G. (1997): A #' Tribute to J. Bertin's Graphical Data Analysis. In: Proceedings of the #' SoftStat '97 (Advances in Statistical Software 6), 11--20. #' @keywords hplot cluster #' @examples #' data("Irish") #' scale_by_rank <- function(x) apply(x, 2, rank) #' x <- scale_by_rank(Irish[,-6]) #' #' # Use the the sum of absolute rank differences #' order <- c( #' seriate(dist(x, "minkowski", p = 1)), #' seriate(dist(t(x), "minkowski", p = 1)) #' ) #' #' # Plot #' bertinplot(x, order) #' #' # Some alternative displays #' bertinplot(x, order, panel = panel.tiles, shading_col = bluered(100), highlight = FALSE) #' bertinplot(x, order, panel = panel.circles, spacing = -.2) #' bertinplot(x, order, panel = panel.rectangles) #' bertinplot(x, order, panel = panel.lines) #' #' # Plot with cut lines (we manually set the order here) #' order <- ser_permutation(c(6L, 9L, 29L, 10L, 32L, 22L, 2L, 35L, #' 24L, 30L, 33L, 25L, 37L, 36L, 8L, 27L, 4L, 39L, 3L, 40L, 38L, #' 1L, 31L, 34L, 28L, 23L, 5L, 11L, 7L, 41L, 13L, 26L, 17L, 15L, #' 12L, 20L, 14L, 18L, 19L, 16L, 21L), #' c(4L, 2L, 1L, 6L, 7L, 8L, 5L, 3L)) #' #' bertinplot(x, order, pop=FALSE) #' bertin_cut_line(, 4) ## horizontal line between rows 4 and 5 #' bertin_cut_line(, 7) ## separate "Right to Life" from the rest #' bertin_cut_line(18, c(0, 4)) ## separate a block of large values (vertically) #' #' # ggplot2-based plots #' if (require("ggplot2")) { #' library(ggplot2) #' #' # Default plot uses bars and highlighting values larger than the mean #' ggbertinplot(x, order) #' #' # highlight values in the 4th quartile #' ggbertinplot(x, order, highlight = quantile(x, probs = .75)) #' #' # Use different geoms. "none" lets the user specify their own geom. #' # Variables set are row, col and x (for the value). #' #' ggbertinplot(x, order, geom = "tile", prop = TRUE) #' ggbertinplot(x, order, geom = "rectangle") #' ggbertinplot(x, order, geom = "rectangle", prop = TRUE) #' ggbertinplot(x, order, geom = "circle") #' ggbertinplot(x, order, geom = "line") #' #' # Tiles with diverging color scale #' ggbertinplot(x, order, geom = "tile", prop = TRUE) + #' scale_fill_gradient2(midpoint = mean(x)) #' #' # Custom geom (geom = "none"). Defined variables are row, col, and x for the value #' ggbertinplot(x, order, geom = "none", prop = FALSE) + #' geom_point(aes(x = col, y = row, size = x, color = x > 30), pch = 15) + #' scale_size(range = c(1, 10)) #' #' # Use a ggplot2 theme with theme_set() #' old_theme <- theme_set(theme_minimal() + #' theme(panel.grid = element_blank()) #' ) #' ggbertinplot(x, order, geom = "bar") #' theme_set(old_theme) #' } #' @export bertinplot <- function(x, order = NULL, panel.function = panel.bars, highlight = TRUE, row_labels = TRUE, col_labels = TRUE, flip_axes = TRUE, ...) { if (!is.matrix(x)) stop("Argument 'x' must be a matrix.") # add ... to options options <- list(...) options$panel.function <- panel.function options <- .get_parameters( options, list( panel.function = panel.bars, flip_axes = TRUE, frame = FALSE, spacing = 0.2, margins = c(5, 4, 8, 8), gp_labels = gpar(), gp_panels = gpar(), shading = NULL, shading_col = .sequential_pal(100), newpage = TRUE, pop = TRUE ) ) ## panel.blocks has no spacing! if (identical(options$panel.function, panel.blocks)) options$spacing <- 0 if (is.null(options$shading)) if (identical(options$panel.function, panel.blocks)) { options$shading <- TRUE } else { options$shading <- FALSE } ## order if (!is.null(order)) x <- permute(x, order) ## note: Bertin switched cols and rows for his display! # change x and y? if (flip_axes) x <- t(x) ## highlight if (is.logical(highlight) && highlight) highlight <- mean(x, na.rm = TRUE) ## clear page if (options$newpage) grid.newpage() ## create outer viewport xlim <- c(options$spacing, ncol(x) + 1 - options$spacing) pushViewport( plotViewport( margins = options$mar, layout = grid.layout(nrow(x), 1), xscale = xlim, yscale = c(0, nrow(x)), default.units = "native", name = "bertin" ) ) # shading and highlighting if (options$shading) col <- .map_color(x, options$shading_col) else col <- matrix(1, nrow = nrow(x), ncol = ncol(x)) if (highlight) col[x < highlight] <- NA # map to [0, 1] x <- map(x) for (variable in seq(nrow(x))) { value <- x[variable,] hl <- col[variable,] ## handle neg. values if (identical(options$panel.function, panel.bars) || identical(options$panel.function, panel.lines)) { ylim <- c(min(value, 0, na.rm = TRUE), max(value, 0, na.rm = TRUE) + options$spacing) } else{ ylim <- c(0, max(abs(value), 0.1, na.rm = TRUE)) } pushViewport( viewport( layout.pos.col = 1, layout.pos.row = variable, xscale = xlim, yscale = ylim, default.units = "native", gp = options$gp_panels ) ) ## call panel function options$panel.function(value, options$spacing, hl) ## do frame if (options$frame) grid.rect( x = seq(length(value)), width = 1, default.units = "native", gp = gpar(fill = NA) ) upViewport(1) } spacing_corr <- if (options$spacing <= 0) - options$spacing + 0.2 else 0 if (col_labels) grid.text( colnames(x), x = seq(ncol(x)), y = nrow(x) + spacing_corr, rot = 90, just = "left", default.units = "native", gp = options$gp_labels ) if (row_labels) grid.text( rev(rownames(x)), x = 1 + spacing_corr / ncol(x) / 4, y = 0.5:(nrow(x) - 0.5) / nrow(x), just = "left", default.units = "npc", gp = options$gp_labels ) if (options$pop) popViewport(1) else upViewport(1) } #' @rdname bertinplot #' @export panel.bars <- function(value, spacing, hl) { grid.rect( x = seq(length(value)), y = spacing / 2, width = 1 - spacing, height = value * (1 - spacing), just = c("centre", "bottom"), default.units = "native", gp = gpar(fill = hl) ) } #' @rdname bertinplot #' @export panel.circles <- function(value, spacing, hl) { ## neg. values are dashed lty <- as.integer(value < 0) + 1L lty[!is.finite(lty)] <- 0L value <- abs(value) value[value == 0] <- NA ### hide empty squares grid.circle( x = seq(length(value)), y = unit(.5, "npc"), r = value / 2 * (1 - spacing), default.units = "native", gp = gpar(fill = hl, lty = lty) ) } #' @rdname bertinplot #' @export panel.rectangles <- function(value, spacing, hl) { ## neg. values are dashed lty <- as.integer(value < 0) + 1L lty[!is.finite(lty)] <- 0L value[value == 0] <- NA ### hide emply squares grid.rect( x = seq(length(value)), width = value * (1 - spacing), height = value * (1 - spacing), default.units = "native", just = c("centre", "center"), gp = gpar(fill = hl, lty = lty) ) } #' @rdname bertinplot #' @export panel.squares <- panel.rectangles #' @rdname bertinplot #' @export panel.tiles <- function(value, spacing, hl) { grid.rect( x = seq(length(value)), width = 1, height = unit(1, "npc"), default.units = "native", just = c("centre", "center"), gp = gpar(fill = hl) ) } #' @rdname bertinplot #' @export panel.blocks <- panel.tiles ### hl is ignored #' @rdname bertinplot #' @export panel.lines <- function(value, spacing, hl) { grid.lines( x = seq(length(value)), y = value * (1 - spacing), default.units = "native" ) } ## add cut lines manually to a bertin plot #' @rdname bertinplot #' @export bertin_cut_line <- function(x = NULL, y = NULL, col = "red") { if (length(x) < 2) x <- rep(x, 2) if (length(y) < 2) y <- rep(y, 2) ## find the bertin Viewport if (inherits(try(seekViewport("bertin"), silent = TRUE) , "try-error")) { stop("bertinplot() needs to be called with options = list(pop = FALSE) first!") } if (is.null(x)) x <- unit(c(0, 1), units = "npc") else x <- x + .5 if (is.null(y)) y <- unit(c(0, 1), units = "npc") else y <- y grid.lines( x = x, y = y, default.units = "native", gp = gpar(col = col, lwd = 2) ) } seriation/R/robinson.R0000644000176200001440000001100514706524256014434 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. #' Create and Recognize Robinson and Pre-Robinson Matrices #' #' Provides functions to create and recognize (anti) Robinson and pre-Robinson #' matrices. A (anti) Robinson matrix has strictly decreasing (increasing) #' values when moving away from the main diagonal. A pre-Robinson matrix is a #' matrix which can be transformed into a perfect Robinson matrix using #' simultaneous permutations of rows and columns. #' #' Note that the default matrices are anti Robinson matrices. This is done #' because distance matrices (the default in R) are typically anti Robinson #' matrices with values increasing when moving away from the diagonal. #' #' Robinson matrices are recognized using the fact that they have zero anti #' Robinson events. For pre-Robinson matrices we use spectral seriation first #' since spectral seriation is guaranteed to perfectly reorder pre-Robinson #' matrices (see Laurent and Seminaroti, 2015). #' #' Random pre-Robinson matrices are generated by reversing the process of #' unidimensional scaling. We randomly (uniform distribution with range #' \eqn{[0,1]}) choose \eqn{x} coordinates for `n` points on a straight #' line and calculate the pairwise distances. For Robinson matrices, the points #' are sorted first according to \eqn{x}. For noise, \eqn{y} coordinates is #' added. The coordinates are chosen uniformly between 0 and `noise`, with #' \code{noise} between 0 and 1. #' #' @aliases Robinson robinson #' @family data #' @param x a symmetric, positive matrix or a dissimilarity matrix (a #' \code{dist} object). #' @param anti logical; check for anti Robinson structure? Note that for #' distances, anti Robinson structure is appropriate. #' @param pre logical; recognize/create pre-Robinson matrices. #' @param n number of objects. #' @param noise noise intensity between 0 and 1. Zero means no noise. Noise #' more than zero results in non-Robinson matrices. #' @return A single logical value. #' @references M. Laurent, M. Seminaroti (2015): The quadratic assignment #' problem is easy for Robinsonian matrices with Toeplitz structure, #' _Operations Research Letters_ **43**(1), 103--109. #' @examples #' ## create a perfect anti Robinson structure #' m <- random.robinson(10) #' pimage(m) #' #' is.robinson(m) #' #' ## permute the structure to make it not Robinsonian. However, #' ## it is still pre-Robinson. #' o <- sample(10) #' m2 <- permute(m, ser_permutation(o,o)) #' pimage(m2) #' #' is.robinson(m2) #' is.robinson(m2, pre = TRUE) #' #' ## create a binary random Robinson matrix (not anti Robinson) #' m3 <- random.robinson(10, anti = FALSE) > .7 #' pimage(m3) #' is.robinson(m3, anti = FALSE) #' #' ## create matrices with noise (as distance matrices) #' m4 <- as.dist(random.robinson(50, pre = FALSE, noise = .1)) #' pimage(m4) #' criterion(m4, method = "AR") #' #' m5 <- as.dist(random.robinson(50, pre = FALSE, noise = .5)) #' pimage(m5) #' criterion(m5, method = "AR") #' @export is.robinson <- function(x, anti = TRUE, pre = FALSE) { if (is.matrix(x) && !isSymmetric(unname(x))) stop("x needs to be a symmetric matrix!") d <- as.dist(x) if (!anti) d <- max(d) - d ## pre Robinson matrix can be perfectly seriated using ## spectral seriation! if (pre) d <- permute(d, seriate(d, method = "spectral")) unname(criterion(d, method = "AR_events") == 0) } #' @rdname is.robinson #' @export random.robinson <- function(n, anti = TRUE, pre = FALSE, noise = 0) { if (noise < 0 | noise > 1) stop("noise has to be beween 0 and 1.") x <- runif(n) if (!pre) x <- sort(x) if (noise) x <- cbind(x, runif(n, min = 0, max = noise)) m <- as.matrix(stats::dist(x)) if (!anti) m <- max(m) - m m } seriation/R/seriate_reverse.R0000644000176200001440000000344314706524256016001 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. seriate_dist_reverse <- function(x, control) { control <- .get_parameters(control, NULL) rev(seq(attr(x, "Size"))) } seriate_matrix_reverse <- function(x, control, margin = seq_along(dim(x))) { control <- .get_parameters(control, NULL) lapply(seq_along(dim(x)), function(i) if (i %in% margin) rev(seq(dim(x)[i])) else NA ) } set_seriation_method("dist", "Reverse", seriate_dist_reverse, "Reversed identity permutation", optimized = "None") set_seriation_method("matrix", "Reverse", seriate_matrix_reverse, "Reversed identity permutation", optimized = "None") set_seriation_method("array", "Reverse", seriate_matrix_reverse, "Reversed identity permutation", optimized = "None") seriation/R/AAA_defaults.R0000644000176200001440000000107014706524256015055 0ustar liggesusers### helper to determine the default criterion get_seriation_kind <- function(x) { kind <- class(x)[[1]] if (kind %in% c("table", "data.frame")) kind <- "matrix" kind } get_default_criterion <- function(x) { kind <- get_seriation_kind(x) if (kind == "dist") criterion <- "AR_deviations" else if (kind == "matrix") criterion <- "Moore_stress" else stop("Unknown default criterion for type: ", kind) criterion } get_default_method <- function(x) as.list(args(utils::getS3method("seriate", class = class(x)[[1L]])))$method seriation/R/criterion.dist.R0000644000176200001440000002437014706524256015554 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. #' @rdname criterion #' @export criterion.dist <- function(x, order = NULL, method = NULL, force_loss = FALSE, ...) { ## check dist (most C code only works with lower-triangle version) if (attr(x, "Diag") || attr(x, "Upper")) x <- as.dist(x, diag = FALSE, upper = FALSE) if (!is.double(x)) mode(x) <- "double" ## check order if (!is.null(order)) { if (!inherits(order, "ser_permutation")) order <- ser_permutation(order) .check_dist_perm(x, order) } else order <- ser_permutation(seq(attr(x, "Size"))) ## get methods if (is.null(method)) method <- list_criterion_methods("dist") method <- lapply(method, function(m) get_criterion_method("dist", m)) crit <- sapply(method, function(m) structure(m$fun(x, order, ...), names = m$name)) if (force_loss) crit <- crit * sapply( method, FUN = function(m) ifelse(m$merit, -1, 1) ) crit } #' @export criterion.default <- criterion.dist ## Wrapper to computing the length of the order under a distance matrix, ## e.g. a tour where the leg between the first and last city is omitted. ## that this is a (Hamilton) path. ## ## Note that this corresponds to the sum of distances along the first ## off diagonal of the ordered distance matrix. criterion_path_length <- function(x, order = NULL, ...) { if (is.null(order)) order <- 1:attr(x, "Size") else order <- get_order(order) .Call("order_length", x, order, PACKAGE = "seriation") } criterion_lazy_path_length <- function(x, order = NULL, ...) { if (is.null(order)) order <- 1:attr(x, "Size") else order <- get_order(order) .Call("lazy_path_length", x, order, PACKAGE = "seriation") } ## Least squares criterion. measures the difference between the ## dissimilarities between two elements and the rank distance ## (PermutMatrix). criterion_least_squares <- function(x, order = NULL, ...) { if (is.null(order)) order <- 1:attr(x, "Size") else order <- get_order(order) .Call("least_squares_criterion", x, order, PACKAGE = "seriation") } ## inertia around the diagonal (see PermutMatrix) criterion_inertia <- function(x, order = NULL, ...) { if (is.null(order)) order <- 1:attr(x, "Size") else order <- get_order(order) .Call("inertia_criterion", x, order, PACKAGE = "seriation") } ## anti-Robinson loss functions (Streng and Schoenfelder 1978, Chen ## 2002) ## method: 1...i, 2...s, 3...w .ar <- function(x, order = NULL, method = 1L) { if (is.null(order)) order <- 1:attr(x, "Size") else order <- get_order(order) .Call("ar", x, order, as.integer(method), PACKAGE = "seriation") } criterion_ar_events <- function(x, order, ...) .ar(x, order, 1L) criterion_ar_deviations <- function(x, order, ...) .ar(x, order, 2L) #criterion_ar_weighted <- function(x, order, ...) .ar(x, order, 3L) .rgar_contr <- structure( list( w = NULL, pct = 100, relative = TRUE ), help = list( w = "window size. Default is to use a pct of 100% of n", pct = "specify w as a percentage of n in (0,100]", relative = "set to FALSE to get the GAR, i.e., the absolute number of AR events in the window." ) ) ## w \in [2,n-1] ## or pct \in [0 and 100%]; 0 -> 2 and 100 -> n-1 criterion_rgar <- function(x, order, w = NULL, pct = 100, relative = TRUE, ...) { if (is.null(order)) order <- 1:attr(x, "Size") else order <- get_order(order) if (is.null(w)) { w <- floor((length(order) - 3L) * pct / 100) + 2L if (w < 1) w <- 1 } if (w < 2 || w >= length(order)) stop("Window w needs to be 2 <= w < length(order) or pct needs to be 0 < pct <= 100!") .Call("rgar", x, order, as.integer(w), as.integer(relative), PACKAGE = "seriation") } .bar_contr <- structure( list( b = NULL ), help = list( b = "band size defaults to a band of 20% of n" ) ) criterion_bar <- function(x, order, b = NULL, ...) { if (is.null(order)) order <- 1:attr(x, "Size") else order <- get_order(order) ### we default to 1/5 if (is.null(b)) b <- max(1, floor(length(order) / 5)) if (b < 1 || b >= length(order)) stop("Band size needs to be 1 <= b < length(order)!") .Call("bar", x, order, as.integer(b), PACKAGE = "seriation") } criterion_gradient_raw <- function(x, order, ...) { if (is.null(order)) order <- 1:attr(x, "Size") else order <- get_order(order) .Call("gradient", x, order, 1L, PACKAGE = "seriation") } criterion_gradient_weighted <- function(x, order, ...) { if (is.null(order)) order <- 1:attr(x, "Size") else order <- get_order(order) .Call("gradient", x, order, 2L, PACKAGE = "seriation") } .A_2SUM <- function(n) outer( 1:n, 1:n, FUN = function(i, j) (i - j) ^ 2 ) criterion_2SUM <- function(x, order, ...) { if (is.null(order)) order <- 1:attr(x, "Size") else order <- get_order(order) # this is sum(diag(A%*%B[o,o])) qap::qap.obj(.A_2SUM(attr(x, "Size")), 1 / (1 + as.matrix(x)), order) } ### Note: We use n-abs(1-j) since QAP needs positive entries in A! .A_LS <- function(n) outer( 1:n, 1:n, FUN = function(i, j) n - abs(i - j) ) criterion_LS <- function(x, order, ...) { if (is.null(order)) order <- 1:attr(x, "Size") else order <- get_order(order) # this is sum(diag(A%*%B[o,o])) qap::qap.obj(.A_LS(attr(x, "Size")), as.matrix(x), order) } # Spearman rank correlation between distances and rank differences of the order criterion_R_dist <- function(x, order, ...) abs(stats::cor(x, stats::dist(get_rank(order), "manhattan"), method = "spearman")) ### these measures are calculated on similarity matrices criterion_ME_dist <- function(x, order, ...) criterion(1 / (1 + as.matrix(x)), c(order, order), "ME") criterion_Moore_stress_dist <- function(x, order, ...) criterion(1 / (1 + as.matrix(x)), c(order, order), "Moore_stress") criterion_Neumann_stress_dist <- function(x, order, ...) criterion(1 / (1 + as.matrix(x)), c(order, order), "Neumann_stress") ### register methods set_criterion_method("dist", "AR_events" , criterion_ar_events, "Anti-Robinson events: The number of violations of the anti-Robinson form (Chen, 2002).", FALSE) set_criterion_method("dist", "AR_deviations", criterion_ar_deviations, "Anti-Robinson deviations: The number of violations of the anti-Robinson form weighted by the deviation (Chen, 2002).", FALSE) ## set_criterion_method("dist", "AR_weighted", criterion_ar_weighted) set_criterion_method("dist", "RGAR", criterion_rgar, "Relative generalized anti-Robinson events: Counts Anti-Robinson events in a variable band of size w around the main diagonal and normalizes by the maximum of possible events (Tien et al, 2008).", FALSE, control = .rgar_contr) set_criterion_method("dist", "BAR", criterion_bar, "Banded Anti-Robinson form criterion: Measure for closeness to the anti-Robinson form in a band of size b (Earle and Hurley, 2015).", FALSE, control = .bar_contr) set_criterion_method("dist", "Gradient_raw" , criterion_gradient_raw, "Gradient measure: Evaluates how well distances increase when moving away from the diagonal of the distance matrix (Hubert et al, 2001).", TRUE) set_criterion_method( "dist", "Gradient_weighted", criterion_gradient_weighted, "Gradient measure (weighted): Evaluates how well distances increase when moving away from the diagonal of the distance matrix (Hubert et al, 2001).", TRUE ) set_criterion_method("dist", "Path_length", criterion_path_length, "Hamiltonian path length: Sum of distances by following the permutation (Caraux and Pinloche, 2005).", FALSE) set_criterion_method("dist", "Lazy_path_length", criterion_lazy_path_length, "Lazy path length: A weighted version of the Hamiltonian path criterion where later distances are less important (Earl and Hurley, 2015).", FALSE) set_criterion_method("dist", "Inertia", criterion_inertia, "Inertia criterion: Measures the moment of the inertia of dissimilarity values around the diagonal of the distance matrix (Caraux and Pinloche, 2005).", TRUE) set_criterion_method("dist", "Least_squares", criterion_least_squares, "Least squares criterion: The sum of squared differences between distances and the rank differences (Caraux and Pinloche, 2005).", FALSE) set_criterion_method("dist", "ME", criterion_ME_dist, "Measure of effectiveness applied to the reordered similarity matrix (McCormick, 1972).", TRUE) set_criterion_method("dist", "Rho", criterion_R_dist, "Absolute value of the Spearman rank correlation between original distances and rank differences of the order.", TRUE) set_criterion_method( "dist", "Moore_stress", criterion_Moore_stress_dist, "Stress criterion (Moore neighborhood) applied to the reordered similarity matrix (Niermann, 2005).", FALSE ) set_criterion_method( "dist", "Neumann_stress", criterion_Neumann_stress_dist, "Stress criterion (Neumann neighborhood) applied to the reordered similarity matrix (Niermann, 2005).", FALSE ) set_criterion_method("dist", "2SUM", criterion_2SUM, "2-Sum Criterion: The 2-Sum loss criterion multiplies the similarity between objects with the squared rank differences (Barnard, Pothen and Simon, 1993).", FALSE) set_criterion_method("dist", "LS", criterion_LS, "Linear Seriation Criterion: Weights the distances with the absolute rank differences (Hubert and Schultz, 1976).", FALSE) seriation/R/register_DendSer.R0000644000176200001440000001625614706524256016050 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (C) 2015 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. #' Register Seriation Methods from Package DendSer #' #' Register the DendSer dendrogram seriation method and the ARc criterion #' (Earle and Hurley, 2015) for use with [seriate()]. #' #' Registers the method `"DendSer"` for seriate. DendSer is a fast #' heuristic for reordering dendrograms developed by Earle and Hurley (2015) #' able to use different criteria. #' #' `control` for [`seriate()`] with #' method `"DendSer"` accepts the following parameters: #' #' - `"h"` or `"method"`: A dendrogram or a method for hierarchical clustering #' (see [hclust]). Default: complete-link. #' - `"criterion"`: A seriation criterion to optimize (see #' `list_criterion_methods("dist")`. Default: `"BAR"` (Banded #' anti-Robinson from with 20% band width). #' - `"verbose"`: a logical; print progress information? #' - `"DendSer_args"`: additional arguments for [`DendSer::DendSer()`]. #' #' For convenience, the following methods (for different cost functions) are #' also provided: #' #' - `"DendSer_ARc"` (anti-robinson form), #' - `"DendSer_BAR"` (banded anti-Robinson form), #' - `"DendSer_LPL"` (lazy path length), #' - `"DendSer_PL"` (path length). #' #' **Note:** Package \pkg{DendSer} needs to be installed. #' #' @aliases register_DendSer DendSer dendser #' @seealso [`DendSer::DendSer()`] #' @family seriation #' @returns Nothing. #' #' @author Michael Hahsler based on code by Catherine B. Hurley and Denise #' Earle #' @references D. Earle, C. B. Hurley (2015): Advances in dendrogram seriation #' for application to visualization. _Journal of Computational and #' Graphical Statistics,_ **24**(1), 1--25. #' @keywords optimize cluster #' @examples #' #' \dontrun{ #' register_DendSer() #' get_seriation_method("dist", "DendSer") #' #' d <- dist(random.robinson(20, pre=TRUE)) #' #' ## use Banded AR form with default clustering (complete-link) #' o <- seriate(d, "DendSer_BAR") #' pimage(d, o) #' #' ## use different hclust method (Ward) and AR as the cost function for #' ## dendrogram reordering #' o <- seriate(d, "DendSer", control = list(method = "ward.D2", criterion = "AR")) #' pimage(d, o) #' } #' #' @export register_DendSer <- function() { check_installed("DendSer") ## seriation methods ## control: # cost (default: costBAR) # ## costLS, costPL, costLPL, costED, costARc, costBAR # h (default is NULL -> complete) .DendSer_control <- structure( list( h = NULL, method = "complete", criterion = NULL, DendSer_args = NULL, verbose = FALSE ), help = list( h = "an hclust object (optional)", method = "hclust linkage method", criterion = "criterion to optimize the dendrogram for", DendSer_args = "more arguments are passed on to DendSer (? DendSer)" ) ) DendSer_helper <- function(x, control) { n <- attr(x, "Size") control <- .get_parameters(control, .DendSer_control) control$cost <- DendSer::crit2cost(crit = control$criterion) control$criterion <- NULL ## produce hclust if (is.null(control$h)) control$h <- hclust(x, control$method) control$method <- NULL control$ser_weight <- x if (!is.null(control$DendSer_args)) { control <- c(control, control$DendSer_args) control$DendSer_args <- NULL } permute(control$h, do.call(DendSer::DendSer, control)) } DendSer_BAR <- function(x, control) { control$criterion <- "BAR" DendSer_helper(x, control) } DendSer_PL <- function(x, control) { control$criterion <- "Path_length" DendSer_helper(x, control) } DendSer_LPL <- function(x, control) { control$criterion <- "Lazy_path_length" DendSer_helper(x, control) } DendSer_ARc <- function(x, control) { control$criterion <- "Arc" DendSer_helper(x, control) } ## This is not Least Squares! # DendSer_LS <- function(x, control) { # control$cost <- DendSer::costLS # control$criterion <- "LS" # control$h <- hclust(x) # DendSer_helper(as.matrix(x)[,1], control) # } set_seriation_method( "dist", "DendSer", DendSer_BAR, "Dendrogram seriation (Earle and Hurley, 2015).", .DendSer_control, optimizes = .opt(NA, "specified criterion restricted by dendrogram"), verbose = TRUE ) set_seriation_method( "dist", "DendSer_BAR", DendSer_BAR, "Dendrogram seriation with BAR (Earle and Hurley, 2015).", .DendSer_control, optimizes = .opt("BAR", "banded anti-Robinson form restricted by dendrogram"), verbose = TRUE ) set_seriation_method( "dist", "DendSer_PL", DendSer_PL, "Dendrogram seriation for Path length (Earle and Hurley, 2015).", .DendSer_control, optimizes = .opt("Path_length", "restricted by dendrogram"), verbose = TRUE ) set_seriation_method( "dist", "DendSer_LPL", DendSer_LPL, "Dendrogram seriation for Lazy path length (Earle and Hurley, 2015).", .DendSer_control, optimizes = .opt("Lazy_path_length", "restricted by dendrogram"), verbose = TRUE ) set_seriation_method( "dist", "DendSer_ARc", DendSer_ARc, "Dendrogram seriation for Anti-Robinson form cost (Earle and Hurley, 2015).", optimizes = .opt("ARc", "Anti-Robinson form cost restricted by dendrogram"), .DendSer_control, verbose = TRUE ) # set_seriation_method("dist", "DendSer_LS", # DendSer_LS, "Dendrogram seriation (Leaf sort)") ## criteria DendSer_crit_ARc <- function(x, order, ...) { x <- as.matrix(x) if (is.null(order)) order <- 1:nrow(x) else order <- get_order(order) DendSer::costARc(x, order, ...) } set_criterion_method("dist", "ARc", DendSer_crit_ARc, "Anti-Robinson form cost (Earle and Hurley, 2015).", FALSE, verbose = TRUE) ## Already in seriation # DendSer_crit_BAR <- function(x, order, ...) { # x <- as.matrix(x) # if (is.null(order)) order <- 1:nrow(x) # else order <- get_order(order) # DendSer::costBAR(x,order,...) # } # # set_criterion_method("dist", "BAR", DendSer_crit_BAR, # "Banded AR cost", FALSE) # criterion_method_dist_LPL <- function(x, order, ...) { # x <- as.matrix(x) # if (is.null(order)) order <- 1:nrow(x) # else order <- get_order(order) # DendSer::costLPL(x,order,...) # } # # set_criterion_method("dist", "LPL", criterion_method_dist_LPL, # "Lazy path cost", FALSE) #} } seriation/R/seriate_best.R0000644000176200001440000002345314723652404015262 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. #' Best Seriation #' #' Often the best seriation method for a particular dataset is not know and #' heuristics may produce unstable results. #' `seriate_best()` and `seriate_rep()` automatically try different seriation methods or #' rerun randomized methods several times to find the best and order #' given a criterion measure. `seriate_improve()` uses a local improvement strategy #' to imporve an existing solution. #' #' `seriate_rep()` rerun a randomized seriation methods to find the best solution #' given the criterion specified for the method in the registry. #' A specific criterion can also be specified. #' Non-stochastic methods are automatically only run once. #' #' `seriate_best()` runs a set of methods and returns the best result given a #' criterion. Stochastic methods are automatically randomly restarted several times. #' #' `seriate_improve()` improves a seriation order using simulated annealing using #' a specified criterion measure. It uses [seriate()] with method "`GSA`", #' a reduced probability to accept bad moves, and a lower minimum temperature. Control #' parameters for this method are accepted. #' #' **Criterion** #' #' If no criterion is specified, then the criterion specified for the method in #' the registry (see `[get_seriation_method()]`) is used. For methods with no #' criterion in the registry (marked as "other"), a default method is used. #' The defaults are: #' #' * `dist`: `"AR_deviations"` - the study in Hahsler (2007) has shown that this #' criterion has high similarity with most other criteria. #' * `matrix`: "Moore_stress" #' #' **Parallel Execution** #' #' Some methods support for parallel execution is provided using the #' [foreach][foreach::foreach] package. To #' use parallel execution, a suitable backend needs to be registered (see #' the Examples section for using the [doParallel][doParallel::doParallel] backend). #' #' @family seriation #' #' @param x the data. #' @param method a character string with the name of the seriation method #' (default: varies by data type). #' @param methods a vector of character string with the name of the seriation #' methods to try. #' @param control a list of control options passed on to [seriate()]. #' For `seriate_best()` control needs to be a named list of control lists #' with the names matching the seriation methods. #' @param criterion `seriate_rep()` chooses the criterion specified for the #' method in the registry. A character string with the [criterion] to optimize #' can be specified. #' @param verbose logical; show progress and results for different methods #' @param rep number of times to repeat the randomized seriation algorithm. #' @param parallel logical; perform replications in parallel. #' Uses [foreach::foreach()] if a #' `%dopar%` backend (e.g., [doParallel::doParallel]) is registered. #' @param ... further arguments are passed on to the [seriate()]. #' #' @return Returns an object of class [ser_permutation]. #' #' @author Michael Hahsler #' #' @keywords optimize cluster #' @references #' Hahsler, M. (2017): An experimental comparison of seriation methods for #' one-mode two-way data. \emph{European Journal of Operational Research,} #' \bold{257}, 133--143. #' \doi{10.1016/j.ejor.2016.08.066} #' #' @examples #' data(SupremeCourt) #' d_supreme <- as.dist(SupremeCourt) #' #' # find best seriation order (tries by by default several fast methods) #' o <- seriate_best(d_supreme, criterion = "AR_events") #' o #' pimage(d_supreme, o) #' #' # run a randomized algorithms several times. It automatically chooses the #' # LS criterion. Repetition information is returned as attributes #' o <- seriate_rep(d_supreme, "QAP_LS", rep = 5) #' #' attr(o, "criterion") #' hist(attr(o, "criterion_distribution")) #' pimage(d_supreme, o) #' #' \dontrun{ #' # Using parallel execution on a larger dataset #' data(iris) #' m_iris <- as.matrix(iris[sample(seq(nrow(iris))),-5]) #' d_iris <- dist(m_iris) #' #' library(doParallel) #' registerDoParallel(cores = detectCores() - 1L) #' #' # seriate rows of the iris data set #' o <- seriate_best(d_iris, criterion = "LS") #' o #' #' pimage(d_iris, o) #' #' # improve the order to minimize RGAR instead of LS #' o_improved <- seriate_improve(d_iris, o, criterion = "RGAR") #' pimage(d_iris, o_improved) #' #' # available control parameters for seriate_improve() #' get_seriation_method(name = "GSA") #' } #' @export seriate_best <- function(x, methods = NULL, control = NULL, criterion = NULL, rep = 10L, parallel = TRUE, verbose = TRUE, ...) { ### data.frame/table? kind <- get_seriation_kind(x) # set some default methods if (is.null(methods)) { if (kind == "dist") { methods <- c( "spectral", ## 2-Sum "MDS", ## Moore stress "QAP_2SUM", "QAP_BAR", "QAP_LS", "QAP_Inertia", "TSP", ## path length "OLO_average" ## restricted path length ) } else if (kind == "matrix") methods <- c("BEA_TSP", "PCA", "Heatmap", "PCA_angle") else stop("Currently only seriation for dist and matrix are supported.") } if (is.null(criterion)) criterion <- get_default_criterion(x) criterion <- get_criterion_method(kind, criterion)$name if (verbose) { cat("Criterion:", criterion, "\n") cat("Performing: ") } os <- sapply( methods, FUN = function(m) { if (verbose) { cat("\n") cat(m, " - ") } #tm <- system.time(o <- seriate(x, m, ...)) tm <- system.time( o <- seriate_rep( x, m, control = control[[m]], verbose = verbose, criterion = criterion, rep = rep, parallel = parallel, ... ) ) attr(o, "time") <- tm[1] + tm[2] attr(o, "criterion") <- criterion(x, o, criterion, force_loss = TRUE) o }, simplify = FALSE ) if (verbose) { df <- data.frame( method = names(os), criterion = sapply(os, attr, "criterion"), secs = sapply(os, attr, "time"), row.names = NULL ) df <- df[order(df$criterion),] cat("\nResults (first was chosen):\n") print(df) cat("\n") } os[[which.min(sapply(os, attr, "criterion"))]] } #' @rdname seriate_best #' @importFrom foreach times `%dopar%` `%do%` #' @export seriate_rep <- function(x, method = NULL, control = NULL, criterion = NULL, rep = 10L, parallel = TRUE, verbose = TRUE, ...) { if (is.null(method)) method <- get_default_method(x) m <- get_seriation_method(get_seriation_kind(x), method) method <- m$name if (is.null(criterion)) criterion <- m$optimizes if (is.na(criterion)) criterion <- get_default_criterion(x) if (!m$randomized && rep > 1L) { rep <- 1L if (verbose) cat("Method not randomized. Running once") } if (verbose && rep > 1L) { cat("Tries", rep, " ") } #r <- replicate(rep, { if (verbose) cat("."); seriate(x, method, control) }, # simplify = FALSE) # r <- times(rep) %dopar% { list(seriate(x, method, control)) } dopar <- ifelse(foreach::getDoParRegistered() && parallel && rep > 1L, `%dopar%`, `%do%`) r <- dopar(times(rep), { if (verbose) cat(".") list(seriate(x, method, control, ...)) }) if (verbose) cat("\n") cs <- sapply( r, FUN = function(o) criterion(x, o, criterion, force_loss = TRUE) ) o <- r[[which.min(cs)]] attr(o, "criterion") <- min(cs) attr(o, "criterion_method") <- criterion attr(o, "criterion_distribution") <- as.vector(cs) if (verbose && rep > 1L) cat( "Found orders with", sQuote(criterion), "in the range" , min(cs), "to", max(cs), "- returning best\n" ) o } #' @rdname seriate_best #' @param order a `ser_permutation` object for `x` or the name of a seriation method to start with. #' @export seriate_improve <- function(x, order, criterion = NULL, control = NULL, verbose = TRUE, ...) { if (is.null(criterion)) criterion <- get_default_criterion(x) criterion <- get_criterion_method(get_seriation_kind(x), criterion)$name if (is.null(control)) control <- list() if (is.null(control$p_initial)) control$p_initial <- 0.01 * 1e-6 if (is.null(control$t_min)) control$t_min <- 1e-12 control$warmstart <- order control$criterion <- criterion control$verbose <- verbose seriate(x, "GSA", control = control, ...) } seriation/R/ggbertinplot.R0000644000176200001440000001263114706524256015311 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. #' @rdname bertinplot #' @export ggbertinplot <- function(x, order = NULL, geom = "bar", highlight = TRUE, row_labels = TRUE, col_labels = TRUE, flip_axes = TRUE, prop = FALSE, ...) { check_installed("ggplot2") if (!is.matrix(x)) stop("Argument 'x' must be a matrix.") geom <- match.arg(tolower(geom), choices = c("tile", "rectangle", "circle", "line", "bar", "none")) # reorder if (!is.null(order)) x <- permute(x, order) # change x and y? if (flip_axes) { x <- t(x) tmp <- row_labels row_labels <- col_labels col_labels <- tmp } if (is.logical(highlight) && highlight) highlight <- mean(x, na.rm = TRUE) g <- .ggpimage_empty( x, row_labels = row_labels, col_labels = col_labels, prop = prop, expand = geom != "raster" ) if (col_labels) breaksCol <- ggplot2::waiver() else breaksCol <- NULL if (row_labels) breaksRow <- ggplot2::waiver() else breaksRow <- NULL # put col labels on top (message about replacing scale for x) suppressMessages( g <- g + ggplot2::scale_x_discrete( breaks = breaksRow, position = "top", expand = if (geom != "raster") ggplot2::waiver() else c(0, 0) ) + ggplot2::scale_y_discrete( breaks = breaksCol, position = "right", expand = if (geom != "raster") ggplot2::waiver() else c(0, 0) ) + ggplot2::theme(axis.text.x = ggplot2::element_text(hjust = 0, vjust = .5)) + ggplot2::theme(legend.position = "bottom") ) # add geom # raster does not use highlight if (geom == "tile") g <- g + ggplot2::geom_raster(ggplot2::aes(fill = x)) if (geom == "circle") if (highlight) { suppressMessages( g <- g + ggplot2::geom_point( ggplot2::aes(size = x, fill = x > highlight), color = "black", pch = 21 ) + .gg_logical_pal() + ggplot2::guides(fill = "none", size = "none") ) } else{ g <- g + ggplot2::geom_point(ggplot2::aes(size = x)) } if (geom == "rectangle") if (highlight) { suppressMessages( g <- g + ggplot2::geom_tile( ggplot2::aes( x = col, y = row, height = x / max(x, na.rm = TRUE) * .8, width = x / max(x, na.rm = TRUE) * .8, fill = x > highlight ), color = "black" ) + .gg_logical_pal() + ggplot2::guides(fill = "none") ) } else{ g <- g + ggplot2::geom_tile(ggplot2::aes(height = x / max(x) * .9), width = .8) } # TODO: do not display facet labels when row_labels == FALSE # no highlight for line if (geom == "line") g <- g + ggplot2::geom_line(ggplot2::aes(x = col, y = x, group = row)) + # Note: facets display the lowest level first so we need to reverse them ggplot2::facet_grid(rows = ggplot2::vars(stats::reorder(row, rev(as.integer( row ))))) + ggplot2::theme( strip.text.y.right = ggplot2::element_text(angle = 0, color = "black"), strip.background = ggplot2::element_blank() ) if (geom == "bar") if (highlight) { suppressMessages( g <- g + ggplot2::geom_bar( ggplot2::aes( x = col, y = x, group = row, fill = x > highlight ), stat = "identity", color = "black", width = .8 ) + # Note: facets display the lowest level first so we need to reverse them ggplot2::facet_grid(rows = ggplot2::vars(stats::reorder( row, rev(as.integer(row)) ))) + ggplot2::theme( strip.text.y.right = ggplot2::element_text(angle = 0, color = "black"), strip.background = ggplot2::element_blank() ) + .gg_logical_pal() + ggplot2::guides(fill = "none") ) } else{ g <- g + ggplot2::geom_bar(ggplot2::aes(x = col, y = x, group = row), stat = "identity", width = .8) + # Note: facets display the lowest level first so we need to reverse them ggplot2::facet_grid(rows = ggplot2::vars(stats::reorder(row, rev( as.integer(row) )))) + ggplot2::theme( strip.text.y.right = ggplot2::element_text(angle = 0, color = "black"), strip.background = ggplot2::element_blank() ) } g } seriation/R/seriate_QAP.R0000644000176200001440000000726014706524256014750 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. ## QAP 2SUM seriation seriate_dist_2SUM <- function(x, control = NULL) { ## param are passed on to QAP do.call(qap::qap, c(list( A = .A_2SUM(attr(x, "Size")), B = 1 / (1 + as.matrix(x)) ), control)) } ## QAP Linear seriation seriate_dist_LS <- function(x, control = NULL) { ## param are passed on to QAP do.call(qap::qap, c(list(A = .A_LS(attr( x, "Size" )), B = as.matrix(x)), control)) } ## QAP Inertia seriate_dist_Inertia <- function(x, control = NULL) { ## param are passed on to QAP n <- attr(x, "Size") ## inertia uses the same A matrix as 2SUM ## we use n^2 since A needs to be positive do.call(qap::qap, c(list( A = n ^ 2 - .A_2SUM(n), B = as.matrix(x) ), control)) } ## QAP BAR .qap_bar_contr <- structure(list( b = function(n) max(1, floor(n * .2)) ), help = list(b = "bandwidth (default is 20%)")) seriate_dist_BAR <- function(x, control = NULL) { ## param are passed on to QAP if (is.null(control)) control <- .qap_bar_contr if (is.null(control$b)) control$b <- .qap_bar_contr$b .A_BAR <- function(n, b) { b <- floor(b) if (b < 1 || b >= n) stop("b: needs to be 1<=b n) stop("BAR bandwidth is not between 1 and n!") control$b <- NULL ## inertia uses the same A matrix as 2SUM do.call(qap::qap, c(list(A = .A_BAR(n, b = b), B = as.matrix(x)), control)) } set_seriation_method( "dist", "QAP_2SUM", seriate_dist_2SUM, "Quadratic assignment problem formulation for seriation solved using a simulated annealing solver to minimize the 2-Sum Problem criterion (Barnard, Pothen, and Simon 1993).", randomized = TRUE, optimizes = .opt("2SUM", "2-sum criterion") ) set_seriation_method( "dist", "QAP_LS", seriate_dist_LS, "Quadratic assignment problem formulation for seriation solved using a simulated annealing solver to minimize the Linear Seriation Problem (LS) criterion (Hubert and Schultz 1976).", randomized = TRUE, optimizes = .opt("LS", "Linear seriation criterion") ) set_seriation_method( "dist", "QAP_BAR", seriate_dist_BAR, "Quadratic assignment problem formulation for seriation solved using a simulated annealing solver to minimize the banded anti-Robinson form (Hahsler, 2017).", .qap_bar_contr, randomized = TRUE, optimizes = .opt("BAR", "Banded anti-robinson form") ) set_seriation_method( "dist", "QAP_Inertia", seriate_dist_Inertia, "Quadratic assignment problem formulation for seriation solved using a simulated annealing solver to minimize the Inertia criterion (Hahsler, 2017).", randomized = TRUE, optimizes = .opt("Inertia") ) seriation/R/seriate_AOE.R0000644000176200001440000000417414706524256014734 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. is_correlation_matrix <- function(x) { if(!isSymmetric(x)) return (FALSE) if(any(diag(x) != 1)) return (FALSE) if(any(x > 1)) return (FALSE) if(any(x < -1)) return (FALSE) return(TRUE) } # AOE for correlation matrices seriate_corr_matrix_AOE <- function(x, control = NULL, margin) { if(!is_correlation_matrix(x)) { warning("x is not a correlation matrix. Using method 'PCA_angle' instead.") return(seriate_matrix_angle(x, control, margin)) } sc <- eigen(x)$vectors[, 1:2] o <- .order_angle(sc) list(row = o, col = o) } ## Angle between the first 2 PCs. # Friendly, M. (2002), "Corrgrams: Exploratory Displays for Correlation Matrices," The American Statistician,56, 316-324. # Friendly, M. and Kwan, E. (2003), "Effect ordering for data displays," Computational Statistics & Data Analysis, 43, 509-539. .order_angle <- function(x) { alpha <- atan2(x[, 1], x[, 2]) o <- order(alpha) # cut at largest gap alpha_diff <- diff(c(alpha[o], alpha[o[1]] + 2 * pi)) cut <- which.max(abs(alpha_diff)) if (cut < length(o)) o <- o[c((cut + 1L):length(o), 1:cut)] o } set_seriation_method( "matrix", "AOE", seriate_corr_matrix_AOE, "Order by the angle of the first two eigenvectors for correlation matrices (Friendly, 2002)", ) seriation/R/seriate.R0000644000176200001440000007632014724357421014250 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. #' Seriate Dissimilarity Matrices, Matrices or Arrays #' #' Tries to find a linear order for objects using data in the form of a #' dissimilarity matrix (two-way one-mode data), a data matrix (two-way #' two-mode data), or a data array (k-way k-mode data). The order can then be #' used to reorder the dissimilarity matrix/data matrix using #' [permute()]. #' #' Seriation methods are managed via a registry. See #' [list_seriation_methods()] for help. In the following, we focus on #' discussing the #' built-in methods that are registered automatically by the package \pkg{seriation}. #' #' The available control options, default settings, and #' a description for each algorithm #' can be retrieved using `get_seriation_method(name = "")`. #' Some control parameters are also described in more detail below. #' #' Some methods are very slow, and progress can be printed using the control #' parameter `verbose = TRUE`. #' #' Many seriation methods (heuristically) optimize (minimize or maximize) an #' objective function often called seriation criterion. #' The value of the seriation criterion for a given order can be #' calculated using [criterion()]. In this manual page, we #' include the criterion, which is optimized by each method using **bold font**. #' If no criterion is mentioned, then the method does not directly optimize a criterion. #' A definition of the different seriation criteria can be found on the [criterion()] manual page. #' #' **Seriation methods for distance matrices (dist)** #' #' One-mode two-way data must be provided as a dist object (not #' a symmetric matrix). Similarities have to be transformed into #' dissimilarities. #' Seriation algorithms fall into different groups based on the approach. #' In the following, we describe the currently implemented methods. #' A list with all methods and the available parameters is available #' [here](https://mhahsler.github.io/seriation/seriation_methods.html). #' [Hahsler (2017)](https://michael.hahsler.net/research/paper/EJOR_seriation_2016.pdf) #' for a more detailed description and an experimental comparison of the most #' popular methods. #' #' #' **Dendrogram leaf order** #' #' These methods create a dendrogram using hierarchical clustering and then derive #' the seriation order from the leaf order in the dendrogram. Leaf reordering #' may be applied. #' #' - **Hierarchical clustering:** `"HC"`, `"HC_single"`, `"HC_complete"`, #' `"HC_average"`, `"HC_ward"` #' #' Uses the order of the leaf nodes in a dendrogram obtained by hierarchical #' clustering as a simple seriation technique. This method #' applies hierarchical clustering ([stats::hclust()]) to `x`. The clustering #' method can be given using a `"linkage"` element in the `control` #' list. If omitted, the default `"complete"` is used. #' For convenience, the other methods are provided as shortcuts. #' #' - **Reordered by the Gruvaeus and Wainer heuristic:** `"GW"`, `"GW_single"`, `"GW_average"`, #' `"GW_complete"`, `"GW_ward"` (Gruvaeus and Wainer, 1972) #' #' Method `"GW"` uses an algorithm developed by Gruvaeus and Wainer (1972) #' as implemented [gclus::reorder.hclust()] (Hurley 2004). The clusters are #' ordered at each level so that the objects at the edge of each cluster are #' adjacent to the nearest object outside the cluster. The #' method produces a unique order. #' #' The methods start with a dendrogram created by [hclust()]. As the #' `"linkage"` element in the `control` list, a clustering method #' (default `"average"`) can be specified. Alternatively, an [stats::hclust] #' object can be supplied using an element named `"hclust"`. #' #' A dendrogram (binary tree) has \eqn{2^{n-1}} internal nodes (subtrees) and #' the same number of leaf orderings. That is, at each internal node, the left #' and right subtree (or leaves) can be swapped or, in terms of a dendrogram, #' be flipped. The leaf-node reordering to minimize #' #' Minimizes the **Hamiltonian path length (restricted by the dendrogram)**. #' #' - **Reordered by optimal leaf ordering:** `"OLO"`, `"OLO_single"`, #' `"OLO_average"`, `"OLO_complete"`, `"OLO_ward"` (Bar-Joseph et al., 2001) #' #' Starts with a dendrogram and #' produces an optimal leaf ordering that minimizes the sum of #' the distances along the (Hamiltonian) path connecting the leaves in the #' given order. The algorithm's time complexity is \eqn{O(n^3)}. Note that #' non-finite distance values are not allowed. #' #' Minimizes the **Hamiltonian path length (restricted by the dendrogram)**. #' #' - **Dendrogram seriation:** `"DendSer"` (Earle and Hurley, 2015) #' #' Use heuristic dendrogram seriation to optimize for various criteria. #' The DendSer code has to be first registered. A #' detailed description can be found on the manual page for #' [register_DendSer()]. #' #' **Dimensionality reduction** #' #' Find a seriation order by reducing the dimensionality to 1 dimension. This is typically #' done by minimizing a stress measure or the reconstruction error. #' Note that dimensionality reduction to a single dimension is a very #' difficult discrete optimization problem. #' For example, MDS algorithms used for a single dimension #' tend to end up in local optima (see Maier and De Leeuw, 2015). #' However, generally, ordering along a single component of MDS provides good results #' sufficient for applications like visualization. #' #' - **Classical metric multidimensional scaling:** `"MDS"` #' #' Orders along the 1D classical metric multidimensional scaling. #' `control` parameters are passed on to [stats::cmdscale()]. #' - **Isometric feature mapping:** `"isomap"` (Tenenbaum, 2000) #' #' Orders along the 1D isometric feature mapping. #' `control` parameters are passed on to [vegan::isomap()] #' #' - **Kruskal's non-metric multidimensional scaling:** `"isoMDS"`, `"monoMDS"`, #' `"metaMDS"` (Kruskal, 1964) #' #' Orders along the 1D Kruskal's non-metric multidimensional scaling. #' Package \pkg{vegan} provides an alternative implementation called `monoMDS` #' and a version that uses random restarts for stability called `metaMDS`. #' `control` parameters are passed on to [MASS::isoMDS()], [vegan::monoMDS()] or [vegan::metaMDS()]. #' #' - **Sammon's non-linear mapping:** `"Sammon_mapping"` (Sammon, 1969) #' #' Orders along the 1D Sammon's non-linear mapping. #' `control` parameters are passed on to [MASS::sammon()]. #' #' #' - **Angular order of the first two eigenvectors:** `"MDS_angle"` #' #' Finds a 2D configuration using MDS ([stats::cmdscale()]) #' to approximate the eigenvectors of the covariance matrix in the #' original data matrix. #' Orders by the angle in this space and splits the order by the #' larges gap between adjacent angles. A similar method was used by #' Friendly (2002) to order variables in correlation matrices #' by angles of first two eigenvectors. #' #' - **Smacof:** `"MDS_smacof"` (de Leeuw and Mair, 2009) #' #' Perform seriation using stress majorization with several transformation functions. #' This method has to be registered first using [`register_smacof()`]. #' #' **Optimization** #' #' These methods try to optimize a seriation criterion directly, typically using a #' heuristic approach. #' #' - **Anti-Robinson seriation by simulated annealing:** `"ARSA"` (Brusco et al 2008) #' #' The algorithm automatically finds a suitable start temperature and calculates #' the needed number of iterations. The algorithm gets slow for a large number of #' objects. The speed can be improved by lowering the cooling parameter `"cool"` #' or increasing the minimum temperature `"tmin"`. #' However, this will decrease the seriation quality. #' #' Directly minimizes the **linear seriation criterion (LS).** #' #' - **Complete Enumeration:** `"Enumerate"` #' #' This method finds the optimal permutation given a seriation criterion by complete enumeration #' of all permutations. #' The criterion is specified as the `control` parameters `"criterion"`. #' Default is the weighted gradient measure. Use `"verbose = TRUE"` to see #' the progress. #' #' Note: The number of permutations for \eqn{n} objects is \eqn{n!}. #' Complete enumeration is only possible for tiny problems (<10 objects) and is limited on most systems #' to a problem size of up to 12 objects. #' #' - **Gradient measure seriation by branch-and-bound:** `"BBURCG"`, `"BBWRCG"` (Brusco and Stahl 2005) #' #' The method uses branch-and-bound to minimize the #' **unweighted gradient measure** (`"BBURCG"`) and the #' **weighted gradient measure** (`"BBWRCG"`). #' This type of optimization is only feasible for a small number of objects (< 50 objects). #' #' For BBURCG, the control parameter `"eps"` can be used to relax the problem by defining #' that a distance needs to be eps larger to count as a violation. This relaxation will improve the speed, #' but miss some Robinson events. The default value is 0. #' #' - **Genetic Algorithm:** `"GA"` #' #' The GA code has to be first registered. A detailed description can #' be found on the manual page for [register_GA()]. #' #' - **Quadratic assignment problem seriation:** #' `"QAP_LS"`, `"QAP_2SUM"`, `"QAP_BAR"`, `"QAP_Inertia"` (Hahsler, 2017) #' #' Formulates the seriation problem as a quadratic assignment problem and applies a #' simulated annealing solver to find a good solution. #' These methods minimize the #' **Linear Seriation Problem** (LS) formulation (Hubert and Schultz 1976), #' the **2-Sum Problem** formulation (Barnard, Pothen, and Simon 1993), the #' **banded anti-Robinson form** (BAR), or the **inertia criterion**. #' #' `control` parameters are passed on to [qap::qap()]. #' An important parameter is `rep` to return the best result from the #' given number of repetitions with random restarts. The default is 1, but bigger #' numbers result in better and more stable results. #' #' - **General Simulated Annealing:** `"GSA"` #' #' Implement simulated annealing similar to the ARSA method. However, it #' can optimize #' for any criterion measure defined in \pkg{seriation}. By default, the #' algorithm optimizes for the raw gradient measure, and is warm started with the #' result of spectral seriation (2-Sum problem) since Hahsler (2017) shows that #' 2-Sum solutions are similar to solutions for the gradient measure. #' Use `warmstart = "random"` for no warm start. #' #' The initial temperature `t0` and minimum temperature `tmin` can be set. If #' `t0` is not set, then it is estimated by sampling uphill moves and setting #' `t0` such that the median uphill move have a probability #' of `tinitialaccept`. #' Using the cooling rate `cool`, the number of iterations #' to go for `t0` to `tmin` is calculated. #' #' Several popular local neighborhood functions are #' provided, and new ones can be defined (see [LS]). Local moves are tried in each #' iteration `nlocal` times the number of objects. #' #' Note that this is an R implementation repeatedly calling the criterion function #' which is very slow. #' #' - **Stochastic gradient descent:** `"SGD"` #' #' Starts with a solution and then performs stochastic gradient descent to find #' a close-by local optimum given a specified criterion. #' #' Important `control` parameters: #' - `"criterion"`: the criterion to optimize #' - `"init"`: initial seriation (an order or the name of a seriation method) #' - `"max_iter"`: number of trials #' #' - **Spectral seriation:** `"Spectral"`, `"Spectral_norm"` (Ding and He, 2004) #' #' Spectral seriation uses a relaxation to minimize the **2-Sum Problem** #' (Barnard, Pothen, and Simon, 1993). It uses the order of the Fiedler vector #' of the similarity matrix's (normalized) Laplacian. #' #' Spectral seriation gives a good trade-off between seriation quality, #' and scalability (see Hahsler, 2017). #' #' - **Traveling salesperson problem solver:** `"TSP"` #' #' Uses a traveling salesperson problem solver to minimize the #' **Hamiltonian path length**. The solvers in \pkg{TSP} are used (see #' [TSP::solve_TSP()]). The solver method can be passed on via the `control` #' argument, e.g., `control = list(method = "two_opt")`. Default is the est #' of 10 runs of arbitrary insertion heuristic with 2-opt improvement. #' #' Since a tour returned by a TSP solver is a connected circle and we are #' looking for a path representing a linear order, we need to find the best #' cutting point. Climer and Zhang (2006) suggest adding a dummy city with #' equal distance to each other city before generating the tour. The place of #' this dummy city in an optimal tour with minimal length is the best cutting #' point (it lies between the most distant cities). #' #' #' **Other Methods** #' #' - **Identity permutation:** `"Identity" #' #' - **Reverse Identity permutation:** `"Reverse" #' #' - **Random permutation:** `"Random"` #' #' - **Rank-two ellipse seriation:** `"R2E"` (Chen 2002) #' #' Rank-two ellipse seriation starts with generating a sequence of correlation matrices #' \eqn{R^1, R^2, \ldots}. \eqn{R^1} is the correlation matrix of the original #' distance matrix \eqn{D} (supplied to the function as `x`), and #' \deqn{R^{n+1} = \phi R^n,} where \eqn{\phi} calculates the correlation #' matrix. #' #' The rank of the matrix \eqn{R^n} falls with increasing \eqn{n}. The first #' \eqn{R^n} in the sequence, which has a rank of 2 is found. Projecting all #' points in this matrix on the first two eigenvectors, all points fall on an #' ellipse. The order of the points on this ellipse is the resulting order. #' #' The ellipse can be cut at the two interception points (top or bottom) of the #' vertical axis with the ellipse. In this implementation, the topmost cutting #' point is used. #' #' - **Sorting Points Into Neighborhoods:** `"SPIN_STS"`, `"SPIN_NH"` (Tsafrir, 2005) #' #' Given a weight matrix \eqn{W}, the SPIN algorithms try to #' minimize the energy for a permutation (matrix \eqn{P}) given by \deqn{F(P) = #' tr(PDP^TW),} where \eqn{tr} denotes the matrix trace. #' #' `"SPIN_STS"` implements the Side-to-Side algorithm, which tries to push #' out large distance values. The default weight matrix suggested in the paper #' with \eqn{W=XX^T} and \eqn{X_i=i-(n+1)/2} is used. We run the algorithm form #' `step` (25) iteration and restart the algorithm `nstart` (10) with #' random initial permutations (default values in parentheses). #' #' `"SPIN_NH"` implements the neighborhood algorithm (concentrate low #' distance values around the diagonal) with a Gaussian weight matrix #' \eqn{W_{ij} = exp(-(i-j)^2/n\sigma)}, where \eqn{n} is the size of the #' dissimilarity matrix and \eqn{\sigma} is the variance around the diagonal #' that control the influence of global (large \eqn{\sigma}) or local (small #' \eqn{\sigma}) structure. #' #' We use the heuristic suggested in the paper for the linear assignment #' problem. We do not terminate as indicated in the algorithm but run all the #' iterations since the heuristic does not guarantee that the energy is #' strictly decreasing. We also implement the heuristic "annealing" scheme #' where \eqn{\sigma} is successively reduced. The parameters in `control` #' are `sigma` which can be a single value or a decreasing sequence #' (default: 20 to 1 in 10 steps), and `step`, which defines how many update #' steps are performed before for each value of `alpha`. Via #' `W_function` a custom function to create \eqn{W} with the function #' signature `function(n, sigma, verbose)` can be specified. #' #' - **Visual Assessment of (Clustering) Tendency:** `"VAT"` (Bezdek and Hathaway, 2002). #' #' Creates an order based on Prim's algorithm for finding a minimum spanning #' tree (MST) in a weighted connected graph representing the distance matrix. #' The order is given by the order in which the nodes (objects) are added to #' the MST. #' #' #' **Seriation methods for matrices (matrix)** #' #' Two-mode two-way data are general matrices. #' Some methods also require that the matrix is positive. #' Data frames and contingency tables ([base::table]) #' are converted into a matrix. However, the #' default methods are different. #' #' Some methods find the row and column order simultaneously, #' while others calculate them independently. #' Currently, the #' following methods are implemented for `matrix`: #' #' **Seriating rows and columns simultaneously** #' #' Row and column order influence each other. #' #' - **Bond Energy Algorithm:** `"BEA"` (McCormick, 1972). #' #' The algorithm tries to maximize a non-negative matrix's #' **Measure of Effectiveness.** #' Due to the definition of this measure, the tasks of #' ordering rows and columns are separable and can be solved independently. #' #' BEA consists of the following three steps: #' 1. Place one randomly chosen column. #' 2. Try to place each remaining column at each possible position left, #' right and between the already placed columns and #' calculate every time the increase in ME. Choose the column and #' position which gives the largest increase in ME and place the column. #' Repeat till all columns are placed. #' 3. Repeat procedure with rows. #' #' The overall procedure #' amounts to two approximate traveling salesperson problems (TSP) #' where the distance is the -1 times the ME increase. The BEA algorithm #' is equivalent to a simple suboptimal TSP heuristic called #' 'cheapest insertion'. #' Several consecutive runs of the algorithm might improve the #' energy if a better initial column/row is chosen. #' #' Arabie and Hubert (1990) question its use with non-binary data if #' the objective is to find a seriation or one-dimensional orderings of rows #' and columns. #' #' - **TSP to optimize the Measure of Effectiveness**: `"BEA_TSP"` (Lenstra 1974). #' #' Since BEA is equivalent to a simple TSP heuristic, we can use better TSP #' solvers to get better results. #' Distances between rows are calculated for a \eqn{M \times N} data matrix as #' \deqn{d_{jk} = - \sum_{i=1}^{i=M} x_{ij}x_{ik}\ (j,k=0,1,...,N).} #' #' Distances #' between columns are calculated the same way from the transposed data matrix. #' #' Solving the two TSP using these distances optimizes the measure of #' effectiveness. With an exact TSP solver, the optimal solution #' can be found. #' #' `control` parameter: #' - `"method"`: a TSP solver method (see [TSP::solve_TSP()]). #' #' - **Unconstrained Brower and Kyle seriation**: `"BK_unconstrained"` (Brower and Kyle 1988). #' #' Reorderes 0-1 matrices to create a block structure along the diagonal. It iteratively #' reorders by the mean row indices of 1s and mean column indices of 1s till the orders #' become stable. #' #' `control` parameter: None #' #' - **Correspondence analysis** `"CA"` (Friendly, 2023) #' #' This function is designed to help simplify a mosaic plot or other displays of a #' matrix of frequencies. It calculates a correspondence analysis of the matrix and #' an order for rows and columns according to the scores on a correspondence analysis dimension. #' #' This is the default method for contingency tables. #' #' `control` parameters: #' - `"dim"`: CA dimension used for reordering. #' - `"ca_param"`: List with parameters for the call to [ca::ca()]. #' #' **Seriating rows and columns separately using dissimilarities** #' #' - **Heatmap seriation:** `"Heatmap"` #' #' Calculates distances between #' rows and between columns and then applies seriation so each. This is #' the default method for data frames. #' #' `control` parameter: #' - `"seriation_method"`: a list with row and column seriation methods. #' The special method `"HC_Mean"` is available to use hierarchical clustering #' with reordering the leaves by the row/column means (see [stats::heatmap()]). #' Defaults to optimal leaf ordering `"OLO"`. #' - `"seriation_control"`: a list with control parameters for row and column #' seriation methods. #' - `"dist_fun"`: specify the distance calculation as a function. #' - `"scale"`: `"none"`, `"row"`, or `"col"`. #' #' #' **Seriate rows using the data matrix** #' #' These methods need access to the data matrix instead of dissimilarities to #' reorder objects (rows). Columns can also be reorderd by applying the same technique #' to the transposed data matrix. #' #' - **Order along the 1D locally linear embedding:** `"LLE"` #' #' Performs 1D the non-linear dimensionality reduction method locally linear embedding #' (see [lle()]). #' #' - **Order along the first principal component:** `"PCA"` #' #' Uses the projection of the data on its first principal component (using #' `stats::princomp()`) to #' determine the order of rows. Performs the same procedure on the transposed #' matrix to obtain the column order. #' #' Note that for a distance matrix calculated from `x` with Euclidean #' distance, this method minimizes the least square criterion. #' #' - **Angular order of the first two PCA components:** `"PCA_angle"` #' #' For rows, projects the data on the first two principal components #' and then orders by the angle in this space. The order is split by the larges #' gap between adjacent angles. A similar method was suggested by #' Friendly (2002) to order variables in correlation matrices #' by angles of first two eigenvectors. PCA also computes the eigenvectors #' of the covariance matrix of the data. #' #' Performs the same process on the #' transposed matrix for the column order. #' #' **Other methods** #' #' - **Angular order of the first two eigenvectors:** `"AOE"` (Friendly 2002) #' #' This method reordered correlation matrices by the angle in the space #' spanned by the two largest eigenvectors of the matrix. The order is split #' by the largest angle gap. This is the original method proposed by #' Friendly (2002). #' #' - **By row/column mean:** `"Mean"` #' #' A transformation can be applied before calculating the means. #' The function is specified as control #' parameter `"transformation"`. Any function that takes as an input a #' matrix and returns the transformed matrix can be used. Examples #' are `scale` or `\(x) x^.5`. #' #' #' - **Identity permutation:** `"Identity"` #' #' - **Reverse Identity permutation:** `"Reverse"` #' #' - **Random permutation:** `"Random"` #' #' For **general arrays** no built-in methods are currently available. #' #' @family seriation #' #' @param x the data. #' @param method a character string with the name of the seriation method #' (default: varies by data type). #' @param control a list of control options passed on to the seriation #' algorithm. #' @param margin an integer vector giving the margin indices (dimensions) to be #' seriated. For example, for a matrix, `1` indicates rows, `2` #' indicates columns, `c(1 ,2)` means rows and columns. #' Unseriated margins return the identity seriation order for that margin. #' @param rep number of random restarts for randomized methods. #' Uses [seriate_rep()]. #' @param ... further arguments are added to the `control` list. #' #' @return Returns an object of class [ser_permutation]. #' #' @author Michael Hahsler #' #' @references Arabie, P. and L.J. Hubert (1990): The bond energy algorithm #' revisited, _IEEE Transactions on Systems, Man, and Cybernetics,_ #' **20**(1), 268--274. #' \doi{10.1109/21.47829} #' #' Bar-Joseph, Z., E. D. Demaine, D. K. Gifford, and T. Jaakkola. (2001): Fast #' Optimal Leaf Ordering for Hierarchical Clustering. _Bioinformatics,_ #' **17**(1), 22--29. #' \doi{10.1093/bioinformatics/17.suppl_1.S22} #' #' Barnard, S. T., A. Pothen, and H. D. Simon (1993): A Spectral Algorithm for #' Envelope Reduction of Sparse Matrices. _In Proceedings of the 1993 #' ACM/IEEE Conference on Supercomputing,_ 493--502. Supercomputing '93. New #' York, NY, USA: ACM. \url{https://ieeexplore.ieee.org/document/1263497} #' #' Bezdek, J.C. and Hathaway, R.J. (2002): VAT: a tool for visual assessment of #' (cluster) tendency. _Proceedings of the 2002 International Joint #' Conference on Neural Networks (IJCNN '02),_ Volume: 3, 2225--2230. #' \doi{10.1109/IJCNN.2002.1007487} #' #' Brower, J.C. and Kile, K.M. (1988): Sedation of an original data matrix #' as applied to paleoecology. _Lethaia,_ **21**, 79--93. #' \doi{10.1111/j.1502-3931.1988.tb01756.x} #' #' Brusco, M., Koehn, H.F., and Stahl, S. (2008): Heuristic Implementation of #' Dynamic Programming for Matrix Permutation Problems in Combinatorial Data #' Analysis. _Psychometrika,_ **73**(3), 503--522. #' \doi{10.1007/s11336-007-9049-5} #' #' Brusco, M., and Stahl, S. (2005): _Branch-and-Bound Applications in #' Combinatorial Data Analysis._ New York: Springer. #' \doi{10.1007/0-387-28810-4} #' #' Chen, C. H. (2002): Generalized Association Plots: Information Visualization #' via Iteratively Generated Correlation Matrices. _Statistica Sinica,_ #' **12**(1), 7--29. #' #' Ding, C. and Xiaofeng He (2004): Linearized cluster assignment via spectral #' ordering. _Proceedings of the Twenty-first International Conference on #' Machine learning (ICML '04)_. #' \doi{10.1145/1015330.1015407} #' #' Climer, S. and Xiongnu Zhang (2006): Rearrangement Clustering: Pitfalls, #' Remedies, and Applications, _Journal of Machine Learning Research,_ #' **7**(Jun), 919--943. #' #' D. Earle, C. B. Hurley (2015): Advances in dendrogram seriation #' for application to visualization. #' _Journal of Computational and Graphical Statistics,_ **24**(1), 1--25. #' #' Friendly, M. (2002): Corrgrams: Exploratory Displays for Correlation #' Matrices. _The American Statistician,_ **56**(4), 316--324. #' \doi{10.1198/000313002533} #' #' Friendly, M. (2023). _vcdExtra: 'vcd' Extensions and Additions_. R #' package version 0.8-5, . #' #' Gruvaeus, G. and Wainer, H. (1972): Two Additions to Hierarchical Cluster #' Analysis, _British Journal of Mathematical and Statistical Psychology,_ #' **25**, 200--206. #' \doi{10.1111/j.2044-8317.1972.tb00491.x} #' #' Hahsler, M. (2017): An experimental comparison of seriation methods for #' one-mode two-way data. _European Journal of Operational Research,_ #' **257**, 133--143. #' \doi{10.1016/j.ejor.2016.08.066} #' #' Hubert, Lawrence, and James Schultz (1976): Quadratic Assignment as a #' General Data Analysis Strategy. _British Journal of Mathematical and #' Statistical Psychology,_ **29**(2). Blackwell Publishing Ltd. 190--241. #' \doi{10.1111/j.2044-8317.1976.tb00714.x} #' #' Hurley, Catherine B. (2004): Clustering Visualizations of Multidimensional #' Data. _Journal of Computational and Graphical Statistics,_ #' **13**(4), 788--806. #' \doi{10.1198/106186004X12425} #' #' Kruskal, J.B. (1964). Nonmetric multidimensional scaling: a numerical method. #' _Psychometrika,_ **29**, 115--129. #' #' Lenstra, J.K (1974): Clustering a Data Array and the Traveling-Salesman #' Problem, _Operations Research,_ **22**(2) 413--414. #' \doi{10.1287/opre.22.2.413} #' #' Mair P., De Leeuw J. (2015). Unidimensional scaling. In _Wiley #' StatsRef: Statistics Reference Online,_ Wiley, New York. #' \doi{10.1002/9781118445112.stat06462.pub2} #' #' McCormick, W.T., P.J. Schweitzer and T.W. White (1972): Problem #' decomposition and data reorganization by a clustering technique, #' _Operations Research,_ **20**(5), 993--1009. #' \doi{10.1287/opre.20.5.993} #' #' Tenenbaum, J.B., de Silva, V. & Langford, J.C. (2000) #' A global network framework for nonlinear dimensionality reduction. #' _Science_ **290**, 2319-2323. #' #' Tsafrir, D., Tsafrir, I., Ein-Dor, L., Zuk, O., Notterman, D.A. and Domany, #' E. (2005): Sorting points into neighborhoods (SPIN): data analysis and #' visualization by ordering distance matrices, _Bioinformatics,_ #' **21**(10) 2301--8. #' \doi{10.1093/bioinformatics/bti329} #' #' Sammon, J. W. (1969) A non-linear mapping for data structure analysis. #' _IEEE Trans. Comput._, **C-18** 401--409. #' @keywords optimize cluster #' @examples #' # Show available seriation methods (for dist and matrix) #' list_seriation_methods() #' #' # show the description for ARSA #' get_seriation_method("dist", name = "ARSA") #' #' ### Seriate as distance matrix (for 50 flowers from the iris dataset) #' data("iris") #' x <- as.matrix(iris[-5]) #' x <- x[sample(nrow(x), size = 50), ] #' d <- dist(x) #' #' order <- seriate(d) #' order #' #' pimage(d, main = "Distances (Random Order)") #' pimage(d, order, main = "Distances (Reordered)") #' #' # Compare seriation quality #' rbind( #' random = criterion(d), #' reordered = criterion(d, order) #' ) #' #' # Reorder the distance matrix #' d_reordered <- permute(d, order) #' pimage(d_reordered, main = "Distances (Reordered)") #' #' #' ### Seriate a matrix (50 flowers from iris) #' #' # To make the variables comparable, we scale the data #' x <- scale(x, center = FALSE) #' #' # The iris flowers are ordered by species in the data set #' pimage(x, main = "original data", prop = FALSE) #' criterion(x) #' #' # Apply some methods #' order <- seriate(x, method = "BEA_TSP") #' pimage(x, order, main = "TSP to optimize ME", prop = FALSE) #' criterion(x, order) #' #' order <- seriate(x, method = "PCA") #' pimage(x, order, main = "First principal component", prop = FALSE) #' criterion(x, order) #' #' order <- seriate(x, method = "heatmap") #' pimage(x, order, main = "Heatmap seriation", prop = FALSE) #' criterion(x, order) #' #' # reorder the matrix #' x_reordered <- permute(x, order) #' #' # create a heatmap seriation manually by calculating #' # distances between rows and between columns #' order <- c( #' seriate(dist(x), method = "OLO"), #' seriate(dist(t(x)), method = "OLO") #' ) #' pimage(x, order, main = "Heatmap seriation", prop = FALSE) #' criterion(x, order) #' #' ### Seriate a correlation matrix #' corr <- cor(x) #' #' # plot in original order #' pimage(corr, main = "Correlation matrix") #' #' # reorder the correlation matrix using the angle of eigenvectors #' pimage(corr, order = "AOE", main = "Correlation matrix (AOE)") #' #' # we can also define a distance (we used d = sqrt(1 - r)) and #' # then reorder the matrix (rows and columns) using any seriation method. #' d <- as.dist(sqrt(1 - corr)) #' o <- seriate(d, method = "R2E") #' corr_reordered <- permute(corr, order = c(o, o)) #' pimage(corr_reordered, main = "Correlation matrix (R2E)") #' @export seriate <- function(x, ...) UseMethod("seriate") #' @export seriate.default <- function(x, ...) stop(gettextf("seriate not implemented for class '%s'.", class(x))) seriation/R/seriate_SPIN.R0000644000176200001440000001463714706524256015106 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. ## SPIN (Tsafrir et al. 2005) ## Weight matrix ## pimage(create_x(n=150, sigma=20, verbose=TRUE)) create_W <- function(n, sigma, verbose = FALSE) { w <- function(i, j, n, sigma) exp(-1 * (i - j) ^ 2 / n / sigma) W <- outer(1:n, 1:n, FUN = w, n = n, sigma = sigma) ## make doubly stochastic for (i in 1:1000) { #cat(i, ".") W <- sweep(W, MARGIN = 1, STATS = rowSums(W), "/") W <- sweep(W, MARGIN = 2, STATS = colSums(W), "/") if (all(round(rowSums(W), 5) == 1) && all(round(colSums(W), 5) == 1)) break } if (verbose) cat("It took", i, "iterations to make W doubly stochastic!\n") if (i > 999) warning("Weight matrix did not converge to doubly stochastic in 1000 itermation!") W } .spin_contr <- structure( list( sigma = floor(seq(20, 1, length.out = 10)), step = 5, W_function = NULL, verbose = FALSE ), help = list( sigma = "emphasize local (small alpha) or global (large alpha) structure.", step = "iterations to run for each sigma value.", W_function = "custom function to create the weight matrix W" ) ) ## SPIN: Neighborhood algorithms seriate_dist_SPIN <- function(x, control = NULL) { param <- .get_parameters(control, .spin_contr) W_function <- if (is.null(param$W_function)) create_W else param$W_function sigma <- param$sigma step <- param$step verbose <- param$verbose D <- as.matrix(x) n <- nrow(D) ## weight matrix W <- W_orig <- W_function(n, sigma[1], verbose) energy_best <- Inf for (i in 1:(length(sigma) * step)) { if (verbose) cat("Iteration", i, "... ") M <- D %*% W ## heuristic for the linear assignment problem ## (second argument to order breaks ties randomly) P <- permutation_vector2matrix(order(apply(M, MARGIN = 1, which.min), sample(1:n))) #if(verbose) print(table(apply(M, MARGIN = 1, which.min))) energy_new <- sum(diag(P %*% M)) if (verbose) cat("best energy:", energy_best, "new energy: ", energy_new, "\n") ## was energy improved? if (energy_new < energy_best) { energy_best <- energy_new P_best <- P } ## adapt sigma if (!(i %% step) && i != length(sigma) * step) { s <- sigma[i / step + 1] if (verbose) cat("\nReducing sigma to:", s, "\n") W_orig <- W_function(n, s, verbose) ## recalculate best energy W <- crossprod(P, W_orig) ### t(P) %*% W M <- D %*% W energy_best <- sum(diag(P %*% M)) if (verbose) cat("best energy is now:", energy_best, "\n\n") } else { W <- crossprod(P, W_orig) ### t(P) %*% W } } if (verbose) cat("Best Energy:", energy_best, "\n") o <- permutation_matrix2vector(P_best) o } ## SPIN: Side-to-Side algorithm ## this is the weight: pimage(tcrossprod(1:n - (n+1)/2)) .spin_sts_contr <- structure( list( step = 25L, nstart = 10L, X = function(n) seq(n) - (n + 1) / 2, verbose = FALSE ), help = list(step = "iterations to run", nstart = "number of random restarts", X = "matrix to calculate the W matrix") ) seriate_dist_SPIN_STS <- function(x, control = NULL) { param <- .get_parameters(control, .spin_sts_contr) step <- param$step verbose <- param$verbose nstart <- param$nstart X <- param$X D <- as.matrix(x) n <- nrow(D) ## X for weights W = X %*% t(X) (column vector) if (is.function(X)) X <- X(n) if (!is.numeric(X) || length(X) != n) stop("Invalid weight vector X.") W <- tcrossprod(X) ## X %*% t(X) .STS_run <- function() { if (verbose) cat("\nStarting new run\n") ## start with random permutation o_best <- o <- sample(1:n) #P_best <- P <- permutation_vector2matrix(o) #X_current <- crossprod(P, X) X_current <- X[o] #energy_best <- sum(diag(P %*% D %*% t(P) %*% W)) energy_best <- sum(diag(D[o, o] %*% W)) for (i in 1:step) { if (verbose) cat("Iteration", i, "... ") ## permutation matrix that orders S in descending order (break ties) S <- D %*% X_current o <- order(S, sample(1:n), decreasing = TRUE) #P <- permutation_vector2matrix(o) #X_current <- crossprod(P, X) ## t(P) %*% X X_current <- X[o] ## t(P) %*% X ## calculate energy F(P) #energy_new <- sum(diag(P %*% D %*% t(P) %*% W)) energy_new <- sum(diag(D[o, o] %*% W)) if (verbose) cat("best energy:", energy_best, "new energy: ", energy_new) ## was energy improved? if (energy_new < energy_best) { energy_best <- energy_new #P_best <- P o_best <- o if (verbose) cat(" - update") } if (verbose) cat("\n") } if (verbose) cat("Best Energy:", energy_best, "\n") #o <- permutation_matrix2vector(P_best) o <- o_best attr(o, "energy") <- energy_best o } res <- replicate(nstart, .STS_run(), simplify = FALSE) energy <- sapply(res, attr, "energy") if (verbose) cat("Overall best Energy:", min(energy), "\n") o <- res[[which.min(energy)]] o } set_seriation_method( "dist", "SPIN_NH", seriate_dist_SPIN, "Sorting Points Into Neighborhoods (SPIN) (Tsafrir 2005). Neighborhood algorithm to concentrate low distance values around the diagonal.", .spin_contr, optimizes = .opt(NA, "Energy") ) set_seriation_method( "dist", "SPIN_STS", seriate_dist_SPIN_STS, "Sorting Points Into Neighborhoods (SPIN) (Tsafrir 2005). Side-to-Side algorithm which tries to push out large distance values.", .spin_sts_contr, optimizes = .opt(NA, "Energy") ) seriation/R/seriate_ARSA_Branch-Bound.R0000644000176200001440000001300414723654467017377 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. ## Brusco: simulated annealing for the Linear Seriation Criterion .arsa_control <- list( cool = 0.5, ## Brusco: 0.95 tmin = 0.0001, ## Brusco: 0.0001 swap_to_inversion = .5, ## Brusco: .5 try_multiplier = 100, ## Brusco: 100 ### we do rep now for all # reps = 1L, ## Brusco: 20 verbose = FALSE ) attr(.arsa_control, "help") <- list( cool = "cooling factor (smaller means faster cooling)", tmin = "stopping temperature", swap_to_inversion = "probability for swap vs inversion local move", try_multiplier = "number of local move tries per object" ## Brusco: 100 # reps = "", ## Brusco: 20 ) seriate_dist_arsa <- function(x, control = NULL) { param <- .get_parameters(control, .arsa_control) A <- as.matrix(x) # SUBROUTINE arsa(N, A, COOL, TMIN, NREPS, IPERM, R1, R2, D, U, # S, T, SB, ZBEST, verbose) N <- ncol(A) # the Fortran code has issues with 2 objects. if (N < 1L) stop("x needs to contain at least one object.") if (N < 3L) return(seq_len(N)) if (N*N > .Machine$integer.max) stop("Long vectors not supported! The algorithm needs n^2 space.") #NREPS <- as.integer(param$reps) NREPS <- 1L IPERM <- integer(N) # R1 <- double(N*N/2) # R2 <- double(N*N/2) D <- double(N * N) U <- integer(N) S <- integer(N) T <- integer(NREPS * N) SB <- integer(N) ZBEST <- double(1) # these cannot be NULL because of the defaults cool <- as.numeric(param$cool) tmin <- as.numeric(param$tmin) swap_to_inversion <- as.numeric(param$swap_to_inversion) try_multiplier <- as.numeric(param$try_multiplier) verbose <- as.integer(param$verbose) ret <- .Fortran( "arsa", N, A, cool, tmin, NREPS, IPERM, D, U, S, T, SB, ZBEST, swap_to_inversion, try_multiplier, verbose, PACKAGE = "seriation" ) o <- ret[[6]] ### ARSA returns all 0's in some cases if (all(o == 0)) { o <- 1:N warning( "ARSA has returned an invalid permutation vector! Check the supplied dissimilarity matrix." ) } o } ## Brusco: branch-and-bound - unweighted row gradient .bb_rcgw_control <- list(verbose = FALSE) .bb_control <- list(eps = 0, verbose = FALSE) attr(.bb_control, "help") <- list( eps = "Distances need to be at least eps to count as violations" ) seriate_dist_bburcg <- function(x, control = NULL) { param <- .get_parameters(control, .bb_control) A <- as.matrix(x) N <- ncol(A) if (N < 1L) stop("x needs to contain at least one object.") if (N < 3L) return(seq_len(N)) if (N*N*N > .Machine$integer.max) stop("Long vectors not supported! Algorithm needs n^3 space.") # SUBROUTINE bburcg(N, A, EPS, X, Q, D, DD, S, UNSEL, IVERB) X <- integer(N) Q <- integer(N) D <- integer(N * N * N) DD <- integer(N * N * N) S <- integer(N) UNSEL <- integer(N) eps <- as.numeric(param$eps) verbose <- as.integer(param$verbose) ret <- .Fortran("bburcg", N, A, eps, X, Q, D, DD, S, UNSEL, verbose) o <- ret[[4]] o } ## Brusco: branch-and-bound - weighted row gradient seriate_dist_bbwrcg <- function(x, control = NULL) { param <- .get_parameters(control, .bb_rcgw_control) A <- as.matrix(x) N <- ncol(A) # the Fortran code has issues with 2 objects. if (N < 1L) stop("x needs to contain at least one object.") if (N < 3L) return(seq_len(N)) if (N*N*N > .Machine$integer.max) stop("Long vectors not supported! Algorithm needs n^3 space.") # SUBROUTINE bbwrcg(N, A, EPS, X, Q, D, DD, S, UNSEL, IVERB) X <- integer(N) Q <- integer(N) D <- double(N * N * N) DD <- double(N * N * N) S <- integer(N) UNSEL <- integer(N) verbose <- as.integer(param$verbose) ### eps is unused! ret <- .Fortran("bbwrcg", N, A, 0.0, X, Q, D, DD, S, UNSEL, verbose) o <- ret[[4]] o } set_seriation_method( "dist", "ARSA", seriate_dist_arsa, "Minimize the linear seriation criterion using simulated annealing (Brusco et al, 2008).", control = .arsa_control, randomized = TRUE, optimizes = .opt("LS", "Linear seriation criterion") ) set_seriation_method( "dist", "BBURCG", seriate_dist_bburcg, "Minimize the unweighted row/column gradient by branch-and-bound (Brusco and Stahl 2005). This is only feasible for a relatively small number of objects.", control = .bb_control, optimizes = .opt("Gradient_raw", "Unweighted gradient condition") ) set_seriation_method( "dist", "BBWRCG", seriate_dist_bbwrcg, "Minimize the weighted row/column gradient by branch-and-bound (Brusco and Stahl 2005). This is only feasible for a relatively small number of objects.", control = .bb_control, optimizes = .opt("Gradient_weighted", "Weighted gradient condition") ) seriation/R/register_GA.R0000644000176200001440000001403514706524256015004 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (C) 2015 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. #' Register a Genetic Algorithm Seriation Method #' #' Register a GA-based seriation metaheuristic for use with [seriate()]. #' #' Registers the method `"GA"` for [seriate()]. This method can be used #' to optimize any criterion in package \pkg{seriation}. #' #' The GA uses by default the ordered cross-over (OX) operator. For mutation, #' the GA uses a mixture of simple insertion and simple inversion operators. #' This mixed operator is created using #' `seriation::gaperm_mixedMutation(ismProb = .8)`, where `ismProb` #' is the probability that the simple insertion mutation operator is used. See #' package \pkg{GA} for a description of other available cross-over and #' mutation operators for permutations. The appropriate operator functions in #' \pkg{GA} start with `gaperm_`. #' #' We warm start the GA using `"suggestions"` given by several heuristics. #' Set `"suggestions"` to `NA` to start with a purely random initial #' population. #' #' See Example section for available control parameters. #' #' **Note:** Package \pkg{GA} needs to be installed. #' #' @aliases register_GA GA ga gaperm_mixedMutation #' @family seriation #' @returns Nothing. #' #' @author Michael Hahsler #' @references Luca Scrucca (2013): GA: A Package for Genetic Algorithms in R. #' _Journal of Statistical Software,_ **53**(4), 1--37. URL #' \doi{10.18637/jss.v053.i04}. #' @keywords optimize cluster #' @examples #' #' \dontrun{ #' register_GA() #' get_seriation_method("dist", "GA") #' #' data(SupremeCourt) #' d <- as.dist(SupremeCourt) #' #' ## optimize for linear seriation criterion (LS) #' o <- seriate(d, "GA", criterion = "LS", verbose = TRUE) #' pimage(d, o) #' #' ## Note that by default the algorithm is already seeded with a LS heuristic. #' ## This run is no warm start (no suggestions) and increase run to 100 #' o <- seriate(d, "GA", criterion = "LS", suggestions = NA, run = 100, #' verbose = TRUE) #' pimage(d, o) #' #' o <- seriate(d, "GA", criterion = "LS", suggestions = NA, run = 100, #' verbose = TRUE, ) #' #' pimage(d, o) #' } #' @export register_GA <- function() { check_installed("GA") .ga_contr <- structure(list( criterion = "BAR", suggestions = c("TSP", "QAP_LS", "Spectral"), selection = GA::gaperm_lrSelection, crossover = GA::gaperm_oxCrossover, mutation = gaperm_mixedMutation(.8), pcrossover = .8, pmutation = .1, popSize = 100, maxiter = 1000, run = 50, parallel = FALSE, verbose = FALSE ), help = list( criterion = "criterion to be optimized", suggestions = "seed the population with these seriation methods", selection = "selection operator function", crossover = "crossover operator function", mutation = "mutation operator function", pcrossover = "probability for crossover", pmutation = "ptobability of mutations", popSize = "population size", maxiter = "maximum number of generations", run = "stop after run generations without improvement", parallel = "use multiple cores?" )) GA_helper <- function(x, control) { n <- attr(x, "Size") control <- .get_parameters(control, .ga_contr) if (control$verbose) cat("\nPreparing suggestions:", paste0(control$suggestions, collapse = ", "), "\n") if (is.na(control$suggestions[1])) suggestions <- NULL else suggestions <- t(sapply(control$suggestions, function(method) get_order(seriate(x, method = method)))) if (control$verbose) cat("\nStarting GA\n") # fitness function f <- function(o) - criterion(x, as.integer(o), method = control$criterion, force_loss = TRUE) result <- GA::ga( type = "permutation", fitness = f, lower = rep(1L, times = n), upper = rep(n, times = n), selection = control$selection, mutation = control$mutation, crossover = control$crossover, pmutation = control$pmutation, pcrossover = control$pcrossover, suggestions = suggestions, names = as.character(1:n), monitor = control$verbose, parallel = control$parallel, maxiter = control$maxiter, run = control$run, maxFitness = Inf, popSize = control$popSize ) if (control$verbose) if (result@iter < control$maxiter) cat("\nStopped early after", control$run, "iterations with no improvement! (control option 'run')\n") # solution may have multiple rows! Take the first solution. as.integer(result@solution[1, , drop = TRUE]) } set_seriation_method( "dist", "GA", GA_helper, "Use a genetic algorithm to optimize for various criteria.", .ga_contr, randomized = TRUE, optimizes = .opt(NA, "specified as parameter criterion"), verbose = TRUE ) } # Generates a mutation function which mixes simMutation (simple insertion) # with ismMutation (inversion) given the probability. #' @rdname register_GA #' @param ismProb probability to use [GA::gaperm_ismMutation()] (inversion) versus [GA::gaperm_simMutation()] (simple insertion). #' @export gaperm_mixedMutation <- function(ismProb = .8) { function(object, parent, ...) { if (runif(1) > ismProb) GA::gaperm_simMutation(object, parent, ...) else GA::gaperm_ismMutation(object, parent, ...) } } seriation/R/Zoo.R0000644000176200001440000000325414706524256013361 0ustar liggesusers#' Zoo Data Set #' #' A database containing characteristics of different animals. The database was #' created and donated by Richard S. Forsyth and is available from the UCI #' Machine Learning Repository (Newman et al, 1998). #' #' #' @name Zoo #' @family data #' @docType data #' @format #' A data frame with 101 observations on the following 17 variables. #' \describe{ #' \item{\code{hair}}{a numeric vector} #' \item{\code{feathers}}{a numeric vector} #' \item{\code{eggs}}{a numeric vector} #' \item{\code{milk}}{a numeric vector} #' \item{\code{airborne}}{a numeric vector} #' \item{\code{aquatic}}{a numeric vector} #' \item{\code{predator}}{a numeric vector} #' \item{\code{toothed}}{a numeric vector} #' \item{\code{backbone}}{a numeric vector} #' \item{\code{breathes}}{a numeric vector} #' \item{\code{venomous}}{a numeric vector} #' \item{\code{fins}}{a numeric vector} #' \item{\code{legs}}{a numeric vector} #' \item{\code{tail}}{a numeric vector} #' \item{\code{domestic}}{a numeric vector} #' \item{\code{catsize}}{a numeric vector} #' \item{\code{class}}{a factor with levels \code{amphibian} \code{bird} \code{fish} \code{insect} \code{invertebrate} \code{mammal} \code{reptile}} #' } #' @source David Aha, Patrick Murphy, Christopher Merz, Eamonn Keogh, #' Cathy Blake, Seth Hettich, David Newman, Arthur Asuncion, Moshe Lichman, #' Dheeru Dua, Casey Graff (2023): UCI Machine Learning Repository, #' \url{https://archive.ics.uci.edu/}, University of #' California, Irvine. #' @keywords datasets #' @examples #' data("Zoo") #' x <- scale(Zoo[, -17]) #' #' #' d <- dist(x) #' pimage(d) #' #' order <- seriate(d, method = "tsp") #' pimage(d, order) NULL seriation/R/AAA_registry_seriate.R0000644000176200001440000002542014706533255016636 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. #' Registry for Seriation Methods #' #' A registry to manage methods used by [seriate()]. #' #' The functions below are convenience function for the registry #' \code{registry_seriate}. #' #' \code{list_seriation_method()} lists all available methods for a given data #' type (\code{kind}) (e.g., "dist", "matrix"). #' The result is a vector of character strings with the #' method names that can be used in function `seriate()`. #' If \code{kind} is missing, then a list of #' methods is returned. #' #' \code{get_seriation_method()} returns detailed information for a given method in #' form of an object of class \code{"seriation_method"}. #' The information includes a description, parameters and the #' implementing function. #' #' With \code{set_seriation_method()} new seriation methods can be added by the #' user. The implementing function (\code{definition}) needs to have the formal #' arguments \code{x, control} and, for arrays and matrices \code{margin}, #' where \code{x} is the data object and #' \code{control} contains a list with additional information for the method #' passed on from \code{seriate()}, and \code{margin} is a vector specifying #' what dimensions should be seriated. #' The implementation has to return a list of #' objects which can be coerced into \code{ser_permutation_vector} objects #' (e.g., integer vectors). The elements in the list have to be in #' corresponding order to the dimensions of \code{x}. #' #' @import registry #' @name registry_for_seriation_methods #' @family seriation #' #' @param kind the data type the method works on. For example, \code{"dist"}, #' \code{"matrix"} or \code{"array"}. If missing, then methods for any type are #' shown. #' @param name the name for the method used to refer to the method in #' [seriate()]. #' @param names_only logical; return only the method name. `FALSE` returns #' also the method descriptions. #' @param definition a function containing the method's code. #' @param description a description of the method. For example, a long name. #' @param control a list with control arguments and default values. #' @param randomized logical; does the algorithm use randomization and re-running #' the algorithm several times will lead to different results (see: [seriate_rep()]). #' @param optimizes what criterion does the algorithm try to optimize #' (see: [list_criterion_methods()]). #' @param x an object of class "seriation_method" to be printed. #' @param verbose logical; print a message when a new method is registered. #' @param ... further information that is stored for the method in the #' registry. #' @returns #' - \code{list_seriation_method()} result is a vector of character strings with the #' names of the methods. These names are used for methods in `seriate()`. #' - \code{get_seriation_method()} returns a given method in form of an object of class #' \code{"seriation_method"}. #' #' @author Michael Hahsler #' @seealso This registry uses [registry::registry]. #' @keywords misc #' @examples #' # Registry #' registry_seriate #' #' # List all seriation methods by type #' list_seriation_methods() #' #' # List methods for matrix seriation #' list_seriation_methods("matrix") #' #' get_seriation_method(name = "BEA") #' #' # Example for defining a new seriation method (reverse identity function for matrix) #' #' # 1. Create the seriation method: Reverse the row order #' # (NA means no seriation is applied to columns) #' seriation_method_reverse_rows <- function(x, control = NULL, margin = c(1, 2)) { #' list(rev(seq(nrow(x))), NA)[margin] #' } #' #' # 2. Register new method #' set_seriation_method("matrix", "Reverse_rows", seriation_method_reverse_rows, #' description = "Reverse identity order", control = list()) #' #' list_seriation_methods("matrix") #' get_seriation_method("matrix", "reverse_rows") #' #' # 3. Use the new seriation methods #' seriate(matrix(1:12, ncol = 3), "reverse_rows") #' @export registry_seriate <- registry(registry_class = "seriation_registry", entry_class = "seriation_method") registry_seriate$set_field("kind", type = "character", is_key = TRUE, index_FUN = match_partial_ignorecase) registry_seriate$set_field("name", type = "character", is_key = TRUE, index_FUN = match_partial_ignorecase) registry_seriate$set_field("fun", type = "function", is_key = FALSE) registry_seriate$set_field("description", type = "character", is_key = FALSE) registry_seriate$set_field("control", type = "list", is_key = FALSE) registry_seriate$set_field("randomized", type = "logical", is_key = FALSE) registry_seriate$set_field("optimizes", type = "character", is_key = FALSE) registry_seriate$set_field("registered_by", type = "character", is_key = FALSE) #' @rdname registry_for_seriation_methods #' @export list_seriation_methods <- function(kind, names_only = TRUE) { if (missing(kind)) { kinds <- unique(sort(as.vector( sapply(registry_seriate$get_entries(), "[[", "kind") ))) sapply( kinds, FUN = function(k) list_seriation_methods(k, names_only = names_only) ) } else{ if (names_only) sort(as.vector(sapply( registry_seriate$get_entries(kind = kind), "[[", "name" ))) else { l <- registry_seriate$get_entries(kind = kind) l[order(names(l))] } } } #' @rdname registry_for_seriation_methods #' @export get_seriation_method <- function(kind, name) { ## catch deprecated methods if (tolower(name) == "mds_nonmetric") { name <- "isoMDS" warning("seriation method 'MDS_nonmetric' is now deprecated and will be removed in future releases. Using `isoMDS`") } if (tolower(name) == "mds_metric") { name <- "MDS" warning("seriation method 'MDS_metric' is now deprecated and will be removed in future releases. Using `MDS`") } if (missing(kind)) { method <- registry_seriate$get_entry(name = name) kind <- NA } else method <- registry_seriate$get_entry(kind = kind, name = name) if (is.null(method)) stop( "Unknown seriation method ", name, " for data type ", kind, ". Maybe the method has not been registered yet. ", "Check list_seriation_methods()." ) method } #' @rdname registry_for_seriation_methods #' @export set_seriation_method <- function(kind, name, definition, description = NULL, control = list(), randomized = FALSE, optimizes = NA_character_, verbose = FALSE, ...) { ## check formals if (!identical(names(formals(definition)), c("x", "control")) && !identical(names(formals(definition)), c("x", "control", "margin"))) stop("Seriation methods must have formals 'x', 'control' and optionally 'margin'.") if (sys.nframe() > 1) { caller <- deparse(sys.calls()[[sys.nframe()-1]]) if (is.null(caller) || !startsWith(caller, "register_")) caller <- NA_character_ } else caller <- "manual" ## check if entry already exists r <- registry_seriate$get_entry(kind = kind, name = name) if (!is.null(r) && r$name == name) { # warning( # "Entry with name \"", # name, # "\" for kind \"", # kind, # "\" already exists! Modifying entry." # ) registry_seriate$modify_entry( name = name, kind = kind, fun = definition, description = description, control = control, randomized = randomized, optimizes = optimizes, registered_by = caller ) } else { registry_seriate$set_entry( name = name, kind = kind, fun = definition, description = description, control = control, randomized = randomized, optimizes = optimizes, registered_by = caller ) } if (verbose) message("Registering new seriation method ", sQuote(name), " for ", sQuote(kind), caller ) } #' @rdname registry_for_seriation_methods #' @export print.seriation_method <- function(x, ...) { if (is.na(x$optimizes)) opt <- "Other" else opt <- x$optimizes if (!is.null(attr(x$optimizes, "description"))) opt <- paste0(opt, " (", attr(x$optimizes, "description"), ")") writeLines(c( gettextf("name: %s", x$name), gettextf("kind: %s", x$kind), gettextf("optimizes: %s", opt), gettextf("randomized: %s", x$randomized) )) if(!is.na(x$registered_by)) writeLines(gettextf("registered by: %s", x$registered_by)) writeLines(c( strwrap( gettextf("description: %s", x$description), prefix = " ", initial = "" ) )) writeLines("control:") .print_control(x$control) invisible(x) } .print_control <- function(control, label = "default values", help = TRUE, trim_values = 30L) { if (length(control) < 1L) { writeLines("no parameters") } else{ contr <- lapply( control, FUN = function(x) strtrim(paste(deparse(x), collapse = ""), trim_values) ) contr <- as.data.frame(t(as.data.frame(contr))) colnames(contr) <- c(label) contr <- cbind(contr, help = "N/A") if (!is.null(attr(control, "help"))) for (i in seq(nrow(contr))) { hlp <- attr(control, "help")[[rownames(contr)[i]]] if (!is.null(hlp)) contr[["help"]][i] <- hlp } print(contr, quote = FALSE) } cat("\n") } .opt <- function(criterion, description = NULL) structure(criterion, description = description) seriation/R/seriate.table.R0000644000176200001440000000203214706524256015325 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. #' @rdname seriate #' @export seriate.table <- function(x, method = "CA", control = NULL, margin = c(1L, 2L), ...) seriate.matrix(x, method, control, margin, ...) seriation/R/seriate_BK.R0000644000176200001440000000417214723676376014634 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. # brower and kile 1988 implemented by kbvernon concentrate <- function(x){ # step 1: calculate mean column position (mcp) of presences across rows mcp <- unlist(apply( x, MARGIN = 1, FUN = function(z){ mean(which(z == 1)) }, simplify = FALSE )) # step 2: sort rows by mcp x <- x[order(mcp), , drop = FALSE] # step 3: calculate mean row position (mrp) of presences across columns mrp <- unlist(apply( x, MARGIN = 2, FUN = function(z){ mean(which(z == 1)) }, simplify = FALSE )) # step 4: sort columns by mrp x[, order(mrp), drop = FALSE] } # This implementation uses the dimnames for sorting. seriate_bku <- function(x, control = NULL, margin = NULL){ old <- x not_identical <- TRUE dimnames(old) <- list(seq_len(nrow(old)), seq_len(ncol(old))) while(not_identical){ new <- concentrate(old) not_identical <- !identical(old, new) old <- new } rows <- as.integer(rownames(new)) cols <- as.integer(colnames(new)) list(row = rows, col = cols) } set_seriation_method( kind = "matrix", name = "BK_unconstrained", definition = seriate_bku, description = "Implements the method for binary matrices described in Brower and Kile (1988). Reorders using the mean row and column position of presences (1s)." ) seriation/R/ser_permutation_vector2matrix.R0000644000176200001440000000240714706524256020722 0ustar liggesusers#' Conversion Between Permutation Vector and Permutation Matrix #' #' Converts between permutation vectors and matrices. #' #' @family permutation #' #' @param x A permutation vector (any object that can be converted into a #' permutation vector, e.g., a integer vector or a `hclust` object) or a #' matrix representing a permutation. Arguments are checked. #' @returns #' - `permutation_vector2matrix()`: returns a permutation matrix. #' - `permutation_matrix2vector()`: returns the permutation as a integer vector. #' #' @author Michael Hahsler #' @keywords manip #' @examples #' ## create a random permutation vector #' pv <- structure(sample(5), names = paste0("X", 1:5)) #' pv #' #' ## convert into a permutation matrix #' pm <- permutation_vector2matrix(pv) #' pm #' #' ## convert back #' permutation_matrix2vector(pm) #' @export permutation_vector2matrix <- function(x) { x <- get_order(x) .valid_permutation_vector(x) n <- length(x) pm <- matrix(0, nrow = n, ncol = n) for (i in 1:n) pm[i, x[i]] <- 1 dimnames(pm) <- list(names(x), names(x)) pm } #' @rdname permutation_vector2matrix #' @export permutation_matrix2vector <- function(x) { .valid_permutation_matrix(x) o <- apply( x, MARGIN = 1, FUN = function(r) which(r == 1) ) o } seriation/R/seriate_R2E.R0000644000176200001440000000424014706524256014712 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. ## uses a sequence of correlation matrices and finds the first matrix ## with rank 2. The elements are projected into the plane spanned by the ## first two eigenvectors. All points are lying on a ellipse. The order ## of the elements on the ellipse is returned (see Chen 2002). seriate_dist_chen <- function(x, control = NULL) { .get_parameters(control, NULL) x <- as.matrix(x) rank <- qr(x)$rank ## find the first correlation matrix of rank 2 n <- 0 while (rank > 2) { x <- stats::cor(x) n <- n + 1 rank <- qr(x)$rank } ## project the matrix on the first 2 eigenvectors e <- eigen(x)$vectors[, 1:2] ## extract the order ## Chen says that he uses the one of the two possible cuts ## that separate the points at rank 1. Since the points just ## separate further towards right and left, cutting on the vertical ## axis of the ellipse yields the same result. right <- which(e[, 1] >= 0) right <- right[order(e[right, 2], decreasing = TRUE)] left <- which(e[, 1] < 0) left <- left[order(e[left, 2])] o <- c(right, left) o } #set_seriation_method("dist", "Chen", seriate_dist_chen, # "Rank-two ellipse seriation") set_seriation_method("dist", "R2E", seriate_dist_chen, "Rank-two ellipse seriation (Chen 2002)") seriation/R/Townships.R0000644000176200001440000000163314706524256014607 0ustar liggesusers#' Bertin's Characteristics of Townships #' #' This data contains nine characteristics for 16 townships. The data #' set was used by Bertin (1981) to illustrate that the conciseness #' of presentation can be improved by seriating the rows and columns. #' #' @name Townships #' @aliases Townships #' @family data #' @docType data #' @format #' A matrix with 16 0-1 variables (columns) indicating the presence #' (`1`) or absence (`0`) of characteristics of townships #' (rows). #' @references #' Bertin, J. (1981): _Graphics and Graphic Information Processing_. Berlin, Walter de Gruyter. #' @author Michael Hahsler #' @examples #' data("Townships") #' #' ## original data #' pimage(Townships) #' criterion(Townships) #' #' ## seriated data using an improved Bond-Energy Algorithm #' order <- seriate(Townships, method = "BEA_TSP") #' pimage(Townships, order) #' criterion(Townships, order) #' @keywords datasets NULL seriation/R/permute.R0000644000176200001440000002626314706524256014300 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. # helper ndim <- function(x) length(dim(x)) find_order <- function(x, order, ...) { if (is.logical(order)) { if(order) order <- seriate(x, ...) else order <- seriate(x, method = "identity", ...) } if (is.character(order)) order <- seriate(x, method = order, ...) if (!inherits(order, "ser_permutation")) order <- ser_permutation(order) # for debugging #print(order) order } #' Permute the Order in Various Objects #' #' Provides the generic function and methods for permuting the order of various #' objects including vectors, lists, dendrograms (also \code{hclust} objects), #' the order of observations in a \code{dist} object, the rows and columns of a #' matrix or data.frame, and all dimensions of an array given a suitable #' [ser_permutation] object. #' #' The permutation vectors in [ser_permutation] are suitable if the number #' of permutation vectors matches the number of dimensions of \code{x} and if #' the length of each permutation vector has the same length as the #' corresponding dimension of \code{x}. #' #' For 1-dimensional/1-mode data (list, vector, \code{dist}), \code{order} can #' also be a single permutation vector of class [ser_permutation_vector] #' or data which can be automatically coerced to this class (e.g. a numeric #' vector). #' #' For \code{dendrogram} and \code{hclust}, subtrees are rotated to represent #' the order best possible. If the order is not achieved perfectly then the #' user is warned. See also [reorder.hclust()] for #' reordering `hclust` objects. #' #' @family permutation #' #' @param x an object (a list, a vector, a \code{dist} object, a matrix, an #' array or any other object which provides \code{dim} and standard subsetting #' with \code{"["}). #' @param order an object of class [ser_permutation] which contains #' suitable permutation vectors for \code{x}. Alternatively, a character string with the #' name of a seriation method appropriate for `x` can be specified (see [seriate()]). #' This will perform seriation and permute `x`. The value `TRUE` will permute using the #' default seriation method. #' @param margin specifies the dimensions to be permuted as a vector with dimension indices. #' If `NULL`, \code{order} needs to contain a permutation for all dimensions. #' If a single margin is specified, then \code{order} can also contain #' a single permutation vector. #' \code{margin} are ignored. #' @param dist the distance matrix used to create the dendrogram. Only needed if #' order is the name of a seriation method. #' @param ... if `order` is the name of a seriation method, then additional arguments are #' passed on to [seriate()]. #' @returns A permuted object of the same class as `x`. #' @author Michael Hahsler #' @keywords manip #' @examples #' # List data types for permute #' methods("permute") #' #' # Permute matrix #' m <- matrix(rnorm(10), 5, 2, dimnames = list(1:5, LETTERS[1:2])) #' m #' #' # Permute rows and columns #' o <- ser_permutation(5:1, 2:1) #' o #' #' permute(m, o) #' #' ## permute only columns #' permute(m, o, margin = 2) #' #' ## permute using PCA seriation #' permute(m, "PCA") #' #' ## permute only rows using PCA #' permute(m, "PCA", margin = 1) #' #' # Permute data.frames using heatmap seration (= hierarchical #' # clustering + optimal leaf ordering) #' df <- as.data.frame(m) #' permute(df, "Heatmap") #' #' # Permute objects in a dist object #' d <- dist(m) #' d #' #' permute(d, c(3, 2, 1, 4, 5)) #' #' permute(d, "Spectral") #' #' # Permute a list #' l <- list(a = 1:5, b = letters[1:3], c = 0) #' l #' #' permute(l, c(2, 3, 1)) #' #' # Permute to reorder dendrogram (see also reorder.hclust) #' hc <- hclust(d) #' plot(hc) #' #' plot(permute(hc, 5:1)) #' plot(permute(hc, 5:1, incompartible = "stop")) #' #' plot(permute(hc, "OLO", dist = d)) #' plot(permute(hc, "GW", dist = d)) #' plot(permute(hc, "MDS", dist = d)) #' plot(permute(hc, "TSP", dist = d)) #' @export permute <- function(x, order, ...) UseMethod("permute") #' @export permute.default <- function(x, order, ...) .permute_kd(x, order, ...) #' @rdname permute #' @export permute.array <- function(x, order, margin = NULL, ...) .permute_kd(x, order, margin = margin, ...) #' @rdname permute #' @export permute.matrix <- function(x, order, margin = NULL, ...) .permute_kd(x, order, margin = margin, ...) #' @rdname permute #' @export permute.data.frame <- function(x, order, margin = NULL, ...) .permute_kd(x, order, margin = margin, ...) #' @rdname permute #' @export permute.table <- function(x, order, margin = NULL, ...) .permute_kd(x, order, margin = margin, ...) #' @rdname permute #' @export permute.numeric <- function(x, order, ...) .permute_1d(x, order, ...) #' @rdname permute #' @export permute.character <- function(x, order, ...) .permute_1d(x, order, ...) #' @rdname permute #' @export permute.list <- function(x, order, ...) .permute_1d(x, order, ...) # special cases #' @rdname permute #' @export permute.dist <- function(x, order, ...) { order <- find_order(x, order, ...) if (.is_identity_permutation(order[[1]])) return(x) .check_dist_perm(x, order) .rearrange_dist(x, get_order(order, 1)) } #' @rdname permute #' @export permute.dendrogram <- function(x, order, dist = NULL, ...) { # order can be # * TRUE/FALSE # * a numeric vector # * a ser_permutation of length 1 # * a ser_permutation vector # * a seriation method (requires dist) if (is.logical(order)) { if(!order) return(x) else order <- "OLO" } if (is.character(order)) { if (is.null(dist)) stop("dist need for seriation-based reordering.") suppressWarnings(order <- seriate(dist, method = order, hclust = x, ...)) } # modeled after rotate in dendextend. Copied here to reduce the heavy dependency count of dendextend. # x <- dendextend::rotate(x, order = match(get_order(order), get_order(x))) rot <- function (x, order, ...) { if (length(get_order(order)) != stats::nobs(x)) stop("Length of order and number of leaves in dendrogram do not agree!") if (missing(order)) { warning("'order' parameter is missing, returning the tree as it was.") return(x) } labels_x <- labels(x) order_x <- order.dendrogram(x) number_of_leaves <- length(order_x) if (!is.numeric(order)) { order <- as.character(order) if (length(intersect(order, labels_x)) != number_of_leaves) { stop( "'order' is neither numeric nor a vector with ALL of the labels (in the order you want them to be)" ) } order <- match(order, labels_x) } weights <- seq_len(number_of_leaves) weights_for_order <- numeric(number_of_leaves) weights_for_order[order_x[order]] <- weights reorder(x, weights_for_order, mean, ...) } x <- rot(x, order = match(get_order(order), get_order(x))) if (any(get_order(x) != get_order(order))) warning("Dendrogram cannot be perfectly reordered! Using best approximation.") x } #' @rdname permute #' @export permute.hclust <- function(x, order, dist = NULL, ...) { nd <- stats::as.hclust(permute(stats::as.dendrogram(x), order, dist = dist, ...)) x$merge <- nd$merge x$height <- nd$height x$order <- nd$order x } # helper .check_dist_perm <- function(x, order) { if (inherits(order, "ser_permutation") && length(order) != 1L) stop("dimensions do not match") if (attr(x, "Size") != length(get_order(order, 1))) stop("some permutation vectors do not fit dimension of data") # check dist if (isTRUE(attr(x, "Diag")) || isTRUE(attr(x, "Upper"))) stop("'dist' with diagonal or upper triangle matrix not implemented") } .check_matrix_perm <- function(x, order) { if (ndim(x) != length(order)) stop("dimensions do not match") if (any(dim(x) != sapply(order, length))) stop("some permutation vectors do not fit dimension of data") } .permute_kd <- function(x, order, margin = NULL, ...) { # DEPRECATED: Compatibility with old permutation for data.frame if (is.data.frame(x) && is.null(margin) && !is.character(order) && ( inherits(order, "ser_permutation") && length(order) == 1 || inherits(order, "ser_permutation_vector") || is.integer(order) )) { warning( "permute for data.frames with a single seriation order is now deprecated. Specify the margin as follows: 'permute(x, order, margin = 1)'" ) margin <- 1 } if (is.null(margin)) margin <- seq(ndim(x)) else { margin <- as.integer(margin) if (!all(margin %in% seq(ndim(x)))) stop("all margins need to specify a valid dimension in x") } order <- find_order(x, order, margin = margin, ...) if (length(order) != ndim(x) && length(order) != length(margin)) stop( "order needs to contain either orders for all dimensions of x or just orders for the selected margin." ) # set margins not to be permuted to identity and copy the rest o <- seriate(x, method = "identity") if (length(order) < ndim(x)) ### we only have order for specified margins for(i in seq(length(order))) o[[margin[i]]] <- order[[i]] else for (i in margin) o[[i]] <- order[[i]] # expand identity manual permutations (if any) for (i in which(sapply(o, .is_identity_permutation))) o[[i]] <- ser_permutation_vector(seq(dim(x)[i])) # check .check_matrix_perm(x, o) perm <- lapply(o, get_order) do.call("[", c(list(x), perm, drop = FALSE)) } .permute_1d <- function(x, order, ...) { if (is.logical(order)) { if(order) stop("No default seritation method for vectors avaialble. Specify the order.") else return(x) } order <- ser_permutation(order) if (length(order) != 1) stop("dimensions do not match!") perm <- get_order(order, 1) if (length(x) != length(perm)) stop("The permutation vectors do not fit the length of x!") x[perm] } # if we used proxy we would say: #.rearrange_dist <- function (x, order) x[[order]] # Note: order can be a subset .rearrange_dist <- function (x, order) { # make C call mode(x) <- "double" # as.dist seems to make Size numeric and not integer! attr(x, "Size") <- as.integer(attr(x, "Size")) mode(order) <- "integer" d <- .Call("reorder_dist", x, order) labels <- if (is.null(labels(x))) NULL else labels(x)[order] structure( d, class = "dist", Size = length(order), Labels = labels, Diag = FALSE, Upper = FALSE, method = attr(x, "method") ) } seriation/R/seriate_vegan.R0000644000176200001440000000652214706524256015427 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. .monoMDS_control <- structure({ l <- as.list(args(vegan::monoMDS)) l$k <- NULL l$model <- "global" tail(head(l,-2L),-1L) }, help = list(y = "See ? monoMDS for help")) seriate_dist_monoMDS <- function(x, control = NULL) { control <- .get_parameters(control, .monoMDS_control) r <- do.call(vegan::monoMDS, c(list(x, k = 1), control)) conf <- r$points if (control$verbose) { r$call <- NULL print(r) } structure(order(conf), configutation = conf) } set_seriation_method( "dist", "monoMDS", seriate_dist_monoMDS, "Kruskal's (1964a,b) non-metric multidimensional scaling (NMDS) using monotone regression.", control = .monoMDS_control, randomized = TRUE, optimizes = .opt("MDS_stress", "Kruskal's monotone regression stress") ) .isomap_control <- structure( list(k = 30, path = "shortest"), help = list(k = "number of shortest dissimilarities retained for a point", path = "method used in to estimate the shortest path (\"shortest\"/\"extended\")") ) seriate_dist_isomap <- function(x, control = NULL) { control <- .get_parameters(control, .isomap_control) r <- do.call(vegan::isomap, c(list(x, ndim = 1), control)) conf <- r$points if (control$verbose) { r$call <- NULL print(r) } structure(order(conf), configutation = conf) } set_seriation_method( "dist", "isomap", seriate_dist_isomap, "Isometric feature mapping ordination", control = .isomap_control, optimizes = .opt(NA, "Stress on shortest path distances") ) .metaMDS_control <- structure({ l <- as.list(args(vegan::metaMDS)) l <- tail(head(l, -2L), -1L) l$k <- NULL l$engine <- "monoMDS" l$noshare <- FALSE #l$distance = "euclidean" l$trace <- 0 l$verbose <- FALSE l }, help = list(distance = "see ? metaMDS for help") ) seriate_dist_metaMDS <- function(x, control = NULL) { control <- .get_parameters(control, .metaMDS_control) r <- do.call(vegan::metaMDS, c(list(x, k = 1), control)) conf <- r$points if(control$verbose && control$trace == 0) control$trace <- 1 if (control$verbose) { r$call <- NULL r$data <- NULL print(r) } structure(order(conf), configutation = conf) } set_seriation_method( "dist", "metaMDS", seriate_dist_metaMDS, "Nonmetric Multidimensional Scaling with Stable Solution from Random Starts.", control = .metaMDS_control, randomized = FALSE, ### it is randomized, but internally does replication optimizes = .opt("MDS_stress", "Kruskal's monotone regression stress") ) seriation/R/criterion.matrix.R0000644000176200001440000001073414706524256016114 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. #' @rdname criterion #' @export criterion.matrix <- function(x, order = NULL, method = NULL, force_loss = FALSE, ...) .criterion_array_helper(as.matrix(x), order, method, "matrix", force_loss) #' @rdname criterion #' @export criterion.data.frame <- criterion.matrix #' @rdname criterion #' @export criterion.table <- criterion.matrix ## Bond energy (BEA) criterion_ME <- function(x, order = NULL, ...) { # ... unused if (!is.matrix(x)) stop("Argument 'x' must be a matrix.") if (!is.double(x)) mode(x) <- "double" if (any(x < 0) || any(is.infinite(x)) || any(is.na(x))) { warning("Bond energy (ME) is only defined for nonnegative finite matrices. Returning NA.") return(NA_real_) } if (is.null(order)) { rows <- seq(dim(x)[1]) cols <- seq(dim(x)[2]) } else{ rows <- get_order(order, 1) cols <- get_order(order, 2) } .Call("measure_of_effectiveness", x, rows, cols) ### The R version needs lots of memory #if (!is.null(order)) x <- permute(x, order) #.5 * sum(x * (rbind(0, x[-nrow(x), , drop = FALSE]) + # rbind(x[-1L, , drop = FALSE], 0) + # cbind(0, x[, -ncol(x), drop = FALSE]) + # cbind(x[, -1L , drop = FALSE], 0))) } ## the interface to the stress functions allows for ## arbitrary subsetting (see the wrapper in C). ## (C) ceeboo 2005, 2006 .stress <- function(x, order, type = "moore") { TYPE <- c(1, 2) names(TYPE) <- c("moore", "neumann") if (inherits(x, "dist")) x <- as.matrix(x) if (!is.matrix(x)) stop("Argument 'x' must be a matrix.") if (!is.double(x)) mode(x) <- "double" if (is.null(order)) { rows <- seq(dim(x)[1]) cols <- seq(dim(x)[2]) } else{ rows <- get_order(order, 1) cols <- get_order(order, 2) } type <- as.integer(TYPE[type]) x <- .Call("stress", x, rows, cols, type) ## does only half of the matrix! 2 * x } criterion_stress_moore <- function(x, order, ...) .stress(x, order, "moore") criterion_stress_neumann <- function(x, order, ...) .stress(x, order, "neumann") ### A MEASURE OF EFFECTIVENESS FOR THE MOMENT ORDERING ALGORITHM ### by Deutsch & Martin (1971) ### Correlation coefficient R for matrices. criterion_R_matrix <- function(x, order, ...) { if (!is.null(order)) x <- permute(x, order) M <- nrow(x) N <- ncol(x) ## total sum T <- sum(x) ## X_i = i/M; Y_j = j/N X_i <- (1:M) / M Y_j <- (1:N) / N ## X_bar = 1/T sum_i,j a_ij X_i X_bar <- 1 / T * sum(crossprod(x, X_i)) ## Y_bar = 1/T sum_i,j a_ij Y_j Y_bar <- 1 / T * sum(crossprod(t(x), Y_j)) ## S_X2 = 1/(T-1) sum_i,j a_ij (X_i - X_bar)^2 S_X2 <- 1 / (T - 1) * sum(crossprod(x, (X_i - X_bar) ^ 2)) ## S_Y2 = 1/(T-1) sum_i,j a_ij (Y_j - Y_bar)^2 S_Y2 <- 1 / (T - 1) * sum(crossprod(t(x), (Y_j - Y_bar) ^ 2)) ## S_XY = 1/(T-1) sum_i,j a_ij (X_i - X_bar) (Y_j - Y_bar) S_XY <- 1 / (T - 1) * sum(x * outer(X_i - X_bar, Y_j - Y_bar)) ## R = S_XY/(S_X S_Y) S_XY / (sqrt(S_X2) * sqrt(S_Y2)) } ## register built-ins set_criterion_method("matrix", "ME", criterion_ME, "Measure of effectiveness (McCormick, 1972).", TRUE) set_criterion_method("matrix", "Cor_R", criterion_R_matrix, "Weighted correlation coefficient R: A measure of effectiveness normalized between -1 and 1 (Deutsch and Martin, 1971).", TRUE) set_criterion_method( "matrix", "Moore_stress", criterion_stress_moore, "Stress criterion (Moore neighborhood) applied to the reordered matrix (Niermann, 2005).", FALSE ) set_criterion_method( "matrix", "Neumann_stress", criterion_stress_neumann, "Stress criterion (Neumann neighborhood) applied to the reordered matrix (Niermann, 2005).", FALSE ) seriation/R/lle.R0000644000176200001440000001075614706524256013373 0ustar liggesusers## lle is a simplified version from package lle ## by Holger Diedrich, Dr. Markus Abel #' Locally Linear Embedding (LLE) #' #' Performs the non linear dimensionality reduction method locally linear embedding #' proposed in Roweis and Saul (2000). #' #' #' LLE tries to find a lower-dimensional projection which preserves distances #' within local neighborhoods. This is done by (1) find for each object the #' k nearest neighbors, (2) construct the LLE weight matrix #' which represents each point as a linear combination of its neighborhood, and #' (2) perform partial eigenvalue decomposition to find the embedding. #' #' The `reg` parameter allows the decision between different regularization methods. #' As one step of the LLE algorithm, the inverse of the Gram-matrix \eqn{G\in R^{kxk}} #' has to be calculated. The rank of \eqn{G} equals \eqn{m} which is mostly smaller #' than \eqn{k} - this is why a regularization \eqn{G^{(i)}+r\cdot I} should be performed. #' The calculation of regularization parameter \eqn{r} can be done using different methods: #' #' - `reg = 1`: standardized sum of eigenvalues of \eqn{G} (Roweis and Saul; 2000) #' - `reg = 2` (default): trace of Gram-matrix divided by \eqn{k} (Grilli, 2007) #' - `reg = 3`: constant value 3*10e-3 #' #' @name lle #' @aliases lle LLE #' #' @param x a matrix. #' @param m dimensions of the desired embedding. #' @param k number of neighbors. #' @param reg regularization method. 1, 2 and 3, by default 2. See details. #' @returns a matrix of vector with the embedding. #' @author Michael Hahsler (based on code by Holger Diedrich and Markus Abel) #' @references #' Roweis, Sam T. and Saul, Lawrence K. (2000), Nonlinear Dimensionality #' Reduction by Locally Linear Embedding, #' _Science,_ **290**(5500), 2323--2326. \doi{10.1126/science.290.5500.2323} #' #' Grilli, Elisa (2007) Automated Local Linear Embedding with an application #' to microarray data, Dissertation thesis, University of Bologna. #' \doi{10.6092/unibo/amsdottorato/380} #' @keywords cluster manip #' @examples #' data(iris) #' x <- iris[, -5] #' #' # project iris on 2 dimensions #' conf <- lle(x, m = 2, k = 30) #' conf #' #' plot(conf, col = iris[, 5]) #' #' # project iris onto a single dimension #' conf <- lle(x, m = 1, k = 30) #' conf #' #' plot_config(conf, col = iris[, 5], labels = FALSE) #' @export lle <- function(x, m, k, reg = 2) { nns <- find_nn_k(x, k) #calculate weights res_wgts <- find_weights(nns, x, m, reg) wgts <- res_wgts$wgts #compute coordinates y <- find_coords(wgts, nns, N = dim(x)[1], n = dim(x)[2], m) y } find_coords <- function(wgts, nns, N, n, m) { W <- wgts M <- crossprod(diag(1, N) - W, diag(1, N) - W) eigen(M)$vectors[, c((N - m):(N - 1))] * sqrt(N) } find_weights <- function(nns, x, m, reg = 2) { N <- dim(x)[1] n <- dim(x)[2] wgts <- 0 * matrix(0, N, N) #intrinsic dim intr_dim <- c() for (i in (1:N)) { #number of neighbours k <- sum(nns[i, ]) #no neighbours (find_nn_k(k=0) or eps-neighbourhood) if (k == 0) next # calculate the differences between xi and its neighbours Z <- matrix(c(t(x)) - c(t(x[i, ])), nrow = nrow(x), byrow = TRUE) Z <- matrix(Z[nns[i, ], ], ncol = n, nrow = k) #gram-matrix G <- Z %*% t(Z) #regularisation delta <- 0.1 #calculate eigenvalues of G e <- eigen(G, symmetric = TRUE, only.values = TRUE)$values #skip if all EV are null if (all(e == 0)) next #choose regularisation method #see documentation if (reg == 1) { r <- delta * sum(utils::head(e, n - m)) / (n - m) } else if (reg == 2) { r <- delta ^ 2 / k * sum(diag(G)) } else r <- 3 * 10 ^ -3 #use regularization if more neighbors than dimensions! if (k > n) alpha <- r else alpha <- 0 #regularization G <- G + alpha * diag(1, k) #calculate weights #using pseudoinverse ginv(A): works better for bad conditioned systems if (k >= 2) wgts[i, nns[i, ]] <- t(MASS::ginv(G) %*% rep(1, k)) else wgts[i] <- G wgts[i, ] <- wgts[i, ] / sum(wgts[i, ]) } return(list( x = x, wgts = wgts )) } find_nn_k <- function(x, k) { nns <- as.matrix(dist(x)) nns <- t(apply(nns, 1, rank)) #choose the k+1 largest entries without the first (the data point itself) nns <= k + 1 & nns > 1 } seriation/R/VAT.R0000644000176200001440000001125514706524256013244 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. #' Visual Analysis for Cluster Tendency Assessment (VAT/iVAT) #' #' Implements Visual Analysis for Cluster Tendency Assessment (VAT; Bezdek and #' Hathaway, 2002) and Improved Visual Analysis for Cluster Tendency Assessment #' (iVAT; Wang et al, 2010). #' #' `path_dist()` redefines the distance between two objects as the minimum #' over the largest distances in all possible paths between the objects as used #' for iVAT. #' #' @family plots #' #' @param x a \code{dist} object. #' @param upper_tri,lower_tri a logical indicating whether to show the upper or #' lower triangle of the VAT matrix. #' @param ... further arguments are passed on to \code{\link{pimage}} for the #' regular plots and \code{\link{ggpimage}} for the ggplot2 plots. #' @returns Nothing. #' #' @author Michael Hahsler #' @references Bezdek, J.C. and Hathaway, R.J. (2002): VAT: a tool for visual #' assessment of (cluster) tendency. \emph{Proceedings of the 2002 #' International Joint Conference on Neural Networks (IJCNN '02)}, Volume: 3, #' 2225--2230. #' #' Havens, T.C. and Bezdek, J.C. (2012): An Efficient Formulation of the #' Improved Visual Assessment of Cluster Tendency (iVAT) Algorithm, \emph{IEEE #' Transactions on Knowledge and Data Engineering,} \bold{24}(5), 813--822. #' #' Wang L., U.T.V. Nguyen, J.C. Bezdek, C.A. Leckie and K. Ramamohanarao #' (2010): iVAT and aVAT: Enhanced Visual Analysis for Cluster Tendency #' Assessment, \emph{Proceedings of the PAKDD 2010, Part I, LNAI 6118,} 16--27. #' @keywords cluster manip #' @examples #' ## lines data set from Havens and Bezdek (2011) #' x <- create_lines_data(250) #' plot(x, xlim=c(-5,5), ylim=c(-3,3), cex=.2) #' d <- dist(x) #' #' ## create regular VAT #' VAT(d, main = "VAT for Lines") #' ## same as: pimage(d, seriate(d, "VAT")) #' #' ## ggplot2 version #' if (require("ggplot2")) { #' ggVAT(d) + labs(title = "VAT") #' } #' #' ## create iVAT which shows visually the three lines #' iVAT(d, main = "iVAT for Lines") #' ## same as: #' ## d_path <- path_dist(d) #' ## pimage(d_path, seriate(d_path, "VAT for Lines")) #' #' ## ggplot2 version #' if (require("ggplot2")) { #' ggiVAT(d) + labs(title = "iVAT for Lines") #' } #' #' ## compare with dissplot (shows banded structures and relationship between #' ## center line and the two outer lines) #' dissplot(d, method = "OLO_single", main = "Dissplot for Lines", col = bluered(100, bias = .5)) #' #' ## compare with optimally reordered heatmap #' hmap(d, method = "OLO_single", main = "Heatmap for Lines (opt. leaf ordering)", #' col = bluered(100, bias = .5)) #' @export VAT <- function(x, upper_tri = TRUE, lower_tri = TRUE, ...) { if (!inherits(x, "dist")) stop("x needs to be of class 'dist'!") pimage(x, seriate(x, "VAT"), upper_tri = upper_tri, lower_tri = lower_tri, ...) } #' @rdname VAT #' @export iVAT <- function(x, upper_tri = TRUE, lower_tri = TRUE, ...) { if (!inherits(x, "dist")) stop("x needs to be of class 'dist'!") x <- path_dist(x) pimage(x, seriate(x, "VAT"), upper_tri = upper_tri, lower_tri = lower_tri, ...) } ## calculate path distance from iVAT using a modified version fo Floyd's alg. ## d_ij = smallest value of the largest values of all possible paths between i and j #' @rdname VAT #' @export path_dist <- function(x) { #A <- as.matrix(x) #n <- nrow(A) #for(k in 1:n) # for(i in 1:n) # for(j in 1:n) # if(max(A[i,k], A[k,j]) < A[i,j]) A[i,j] <- max(A[i,k], A[k,j]) #d <- as.dist(A) ## make C call m <- as.matrix(x) if (any(is.na(m))) stop("NAs not allowed in x.") if (any(m < 0)) stop("Negative values not allowed in x.") mode(m) <- "double" ## replace Inf with large number m[is.infinite(m)] <- .Machine$double.xmax if (any(m < 0)) stop("Negative values not allowed in x.") m <- .Call("pathdist_floyd", m, PACKAGE = "seriation") as.dist(m) } seriation/R/uniscale.R0000644000176200001440000002056714706524256014423 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (C) 2017 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. #' Fit an Unidimensional Scaling for a Seriation Order #' #' Fits an (approximate) unidimensional scaling configuration given an order. #' #' This implementation uses the method describes in Maier and De Leeuw (2015) to calculate the #' minimum stress configuration for a given (seriation) order by performing a 1D MDS fit. #' If the 1D MDS fit does not preserve the given order perfectly, then a warning is #' produced indicating #' for how many positions order could not be preserved. #' The seriation method which is consistent to uniscale is `"MDS_smacof"` #' which needs to be registered with [`register_smacof()`]. #' #' #' The code is similar to `smacof::uniscale()` (de Leeuw, 2090), #' but scales to larger #' datasets since it only uses the permutation given by `order`. #' #' `MDS_stress()` calculates the normalized stress of a configuration given by a seriation order. #' If the order does not contain a configuration, then a minimum-stress configuration if calculates #' for the given order. #' #' All distances are first normalized to an average distance of close to 1 using #' \eqn{d_{ij} \frac{\sqrt{n(n-1)/2}}{\sqrt{\sum_{i 0 && warn) { warning("Configutation order does not preserve given order! Mismatches: ", mismatches, " of ", n, " - returning initial configuration instead.") } if (!accept_reorder && mismatches > 0) t <- init_config #cat("init:\n") #print(names(init_config)) #cat("d:\n") #print(labels(d)) names(t) <- labels(d) t } # normalize the distances to roughly n*(n-1) / 2 so the average distance # is close to 1 .normDiss <- function (diss) diss / sqrt(sum(diss ^ 2, na.rm = TRUE)) * sqrt(length(diss)) #' @rdname uniscale #' @param refit logical; forces to refit a minimum-stress MDS configuration, #' even if `order` contains a configuration. #' @export MDS_stress <- function(d, order, refit = TRUE, warn = FALSE) { d <- as.dist(d) o <- ser_permutation(order) emb <- get_config(o) if(is.null(emb) || refit) emb <- uniscale(d, o, warn = warn) d_emb <- dist(emb) d_emb <- .normDiss(d_emb) d <- .normDiss(d) sqrt(sum((d - d_emb)^2) / sum(d_emb^2)) } .smacof_contr <- structure( list( warn = FALSE ), help = list( warn = "produce a warning if the 1D MDS fit does not preserve the given order (see ? seriation::uniscale)." ) ) set_criterion_method( "dist", "MDS_stress", MDS_stress, "Normalized stress of a configuration given by a seriation order", FALSE, control = .smacof_contr ) #' @rdname uniscale #' @param dim The dimension if `x` is a `ser_permutation` object. #' @export get_config <- function(x, dim = 1L, ...) { if (inherits(x, "ser_permutation")) x <- x[[dim]] if (inherits(x, "ser_permutation_vector")) x <- attr(x, "configuration") if(is.null(x)) return(NULL) if (!(is.numeric(x) && ((is.vector(x) || is.matrix(x))))) stop("Unable to get configuration. Supply a ser_permutation.") x } #' @rdname uniscale #' @param x a scaling returned by `uniscale()` or a #' `ser_permutation` with a configuration attribute. #' @param main main plot label #' @param pch print character #' @param labels add the object names to the plot #' @param pos label position for 2D plot (see [text()]). #' @param cex label expansion factor. #' @export plot_config <- function (x, main, pch = 19, labels = TRUE, pos = 1, cex = 1, ...) { if (missing(main)) main <- "Configuration" o <- get_order(x) x <- get_config(x) if (is.null(x)) stop( "Permutation vector has no configuration attribute. Use uniscale() first to calcualte a configuration" ) # 2D if (is.matrix(x)) { graphics::plot(x, pch = pch, main = main, ...) if (labels) graphics::text(x = x, labels = rownames(x), pos = pos, cex = cex) graphics::lines(x[get_order(o), , drop = FALSE], col = "grey") } else{ # 1D x <- drop(x) n <- length(x) plot( x, rep(0, n), axes = FALSE, ann = FALSE, pch = pch, type = "o", ylim = c(-0.2, 0.8), ... ) title(main) labs <- names(x) if (is.null(labs)) labs <- 1:n if (labels) text(x, rep(0, n) + 0.05, labs, srt = 90, cex = cex, adj = c(0, 0.5)) } } seriation/R/ser_permutation_vector.R0000644000176200001440000001665514723672463017430 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. ## ser_permutation_vector represents a single permutation represented as an ## integer vector or a hclust object. ## Constructor ## x can be ## * an integer vector ## * a hclust or dendrogram object (leaf order) ## * NA represents the identity permutation ## * a ser_permutation (list) of length 1 #' Class ser_permutation_vector -- A Single Permutation Vector for Seriation #' #' The class `ser_permutation_vector` #' represents a single permutation vector. #' #' A permutation vector #' maps a set of \eqn{n} objects \eqn{\{O_1, O_2, ..., O_n\}}{{O_1, O_2, ..., O_n}} onto itself. #' #' __Ordering Representation:__ #' In \pkg{seriation} we represent a permutation \eqn{\pi}{\pi} #' as a vector which lists the objects' indices in their permuted order. This can #' be seen as replacing the object in position \eqn{i} with the object #' in position \eqn{\pi(i)}. #' For example, the permutation vector \eqn{\langle3, 1, 2\rangle}{<3, 1, 2>} indicates that in #' first position is the object with index 3 then the object with index 1 and finally #' the object with index 2. This representation is often called a (re)arrangement or ordering. #' The ordering can be extracted from a permutation vector object #' via [get_order()]. Such an ordering can be directly used #' to subset the list of original objects with `"["` to apply the permutation. #' #' __Rank Representation:__ #' An alternative way to specify a permutation is via a list of the ranks #' of the objects after permutation. This representation is often called #' a map or substitution. Ranks can be extracted from a permutation vector using [get_rank()]. #' #' __Permutation Matrix:__ #' Another popular representation is a permutation matrix which performs #' permutations using matrix multiplication. A permutation matrix can be obtained #' using [get_permutation_matrix()]. #' #' `ser_permutation_vector` objects are usually packed into #' a [ser_permutation] object #' which is a collection (a `list`) of \eqn{k} permutation vectors for \eqn{k}-mode data. #' #' The constructor `ser_permutation_vector()` #' checks if the permutation vector is valid #' (i.e. if all integers occur exactly once). #' #' @family permutation #' #' @param x,object an object if class `ser_permutation_vector`. #' Options for the constructor are: #' (1) an integer permutation vector, #' (2) an object of class [hclust], #' (3) a numeric vector with a MDS configuration, or #' (4) `NA` to indicate a identity permutation. #' @param method a string representing the method used to obtain the #' permutation vector. #' @param ... further arguments. #' #' @returns The constructor `ser_permutation_vector()` returns an #' object a `ser_permutation_vector` #' @author Michael Hahsler #' #' @examples #' o <- structure(sample(10), names = paste0("X", 1:10)) #' o #' #' p <- ser_permutation_vector(o, "random") #' p #' #' ## some methods #' length(p) #' get_method(p) #' get_order(p) #' get_rank(p) #' get_permutation_matrix(p) #' #' r <- rev(p) #' r #' get_order(r) #' #' ## create a symbolic identity permutation vector (with unknown length) #' ## Note: This can be used to permute an object, but methods #' ## like length and get_order are not available. #' ip <- ser_permutation_vector(NA) #' ip #' @keywords classes #' @export ser_permutation_vector <- function(x, method = NULL) { if (inherits(x, "ser_permutation_vector")) { if (!is.null(method)) attr(x, "method") <- method return(x) } if (inherits(x, "hclust") || inherits(x, "dendrogram")) { # nothing to do } else if (length(x) == 1 && is.na(x)) { x <- NA_integer_ attr(x, "method") <- "identity permutation" } else if (is.integer(x)) { # permutation vector # do nothing } else if (is.numeric(x)) { # a configuration ats <- attributes(x) ### preserve attributes nm <- names(x) x <- order(x) attributes(x) <- ats names(x) <- nm } else if (inherits(x, "ser_permutation") && length(x) == 1) { x <- x[[1]] } else { stop("x does not contain a supported permutation.") } if (!is.null(method)) attr(x, "method") <- method class(x) <- c("ser_permutation_vector", class(x)) .valid_permutation_vector(x) x } #' @rdname ser_permutation_vector #' @param recursive ignored #' @export c.ser_permutation_vector <- function(..., recursive = FALSE) do.call("ser_permutation", list(...)) ## reverse #' @rdname ser_permutation_vector #' @export rev.ser_permutation_vector <- function(x) { if (inherits(x, "hclust")) { ser_permutation_vector(stats::as.hclust(rev(stats::as.dendrogram(x))), method = get_method(x)) } else ser_permutation_vector(rev(get_order(x)), method = get_method(x)) } #' @rdname ser_permutation_vector #' @param printable a logical; prints "unknown" instead of `NULL` for non-existing methods. #' @export get_method <- function(x, printable = FALSE) { method <- attr(x, "method") if (printable && is.null(method)) method <- "unknown" method } ## print et al #' @rdname ser_permutation_vector #' @export length.ser_permutation_vector <- function(x) { if (!.is_identity_permutation(x)) length(get_order(x)) else 0L } #' @rdname ser_permutation_vector #' @export print.ser_permutation_vector <- function(x, ...) { writeLines(c( gettextf("object of class %s", paste(sQuote(class( x )), collapse = ", ")), gettextf("contains a permutation vector of length %d", length(x)), gettextf("used seriation method: '%s'", get_method(x, printable = TRUE)) )) invisible(x) } ## fake summary (we don't really provide a summary, ## but summary produces now a reasonable result --- same as print) #' @rdname ser_permutation_vector #' @export summary.ser_permutation_vector <- function(object, ...) { object } ## helpers ## an identity permutation is a single NA. .is_identity_permutation <- function(x) is.na(x[1]) ## calls stop if the vector is not valid .valid_permutation_vector <- function(x) { ## identity vector is always valid if (.is_identity_permutation(x)) return(invisible(TRUE)) ## valid permutations have a get_order function implemented perm <- get_order(x) valid <- TRUE tab <- table(perm) if (any(tab != 1)) valid <- FALSE if (length(tab) != length(perm) || any(names(tab) != sequence(length(perm)))) valid <- FALSE if (!valid) stop("Invalid permutation vector!\nVector: ", paste(perm, collapse = ", ")) invisible(valid) } .valid_permutation_matrix <- function(x) { if (any(rowSums(x) != 1) || any(colSums(x) != 1) || any(x != 1 & x != 0)) stop("Not a valid permutation matrix") invisible(TRUE) } seriation/R/ser_permutation.R0000644000176200001440000000712014706524256016026 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. #' Class ser_permutation -- A Collection of Permutation Vectors for Seriation #' #' The class `ser_permutation` is a collection of permutation vectors #' (see class [ser_permutation_vector]), one for each dimension (mode) #' of the data to be permuted. #' #' @family permutation #' #' @param x,object an object of class `ser_permutation_vector` or #' any object which can be converted into #' a object of class `ser_permutation` (e.g. an integer #' vector). #' @param ... vectors for further dimensions. #' #' @returns An object of class `ser_permutation`. #' #' @author Michael Hahsler #' @examples #' o <- ser_permutation(1:5, 10:1) #' o #' #' ## length (number of dimensions) #' length(o) #' #' ## get permutation vector for 2nd dimension #' get_order(o, 2) #' #' ## reverse dimensions #' o[2:1] #' #' ## combine #' o <- c(o, ser_permutation(1:15)) #' o #' #' ## get an individual permutation #' o[[2]] #' #' ## reverse the order of a permutation #' o[[2]] <- rev(o[[2]]) #' get_order(o,2) #' @keywords classes #' @export ser_permutation <- function(x, ...) { x <- c(list(x), list(...)) x <- lapply( x, FUN = function(obj) { if (inherits(obj, "ser_permutation")) return(obj) if (inherits(obj, "ser_permutation_vector")) return(list(obj)) return(list(ser_permutation_vector(obj))) } ) x <- unlist(x, recursive = FALSE) class(x) <- c("ser_permutation", "list") x } #' @rdname ser_permutation #' @export print.ser_permutation <- function(x, ...) { writeLines(c( gettextf("object of class %s", paste(sQuote(class( x )), collapse = ", ")), gettextf("contains permutation vectors for %d-mode data\n", length(x)) )) print( data.frame( "vector length" = sapply( x, FUN = function(o) if (.is_identity_permutation(o)) NA_integer_ else length(o) ), "seriation method" = sapply(x, get_method, printable = TRUE), check.names = FALSE ) ) invisible(x) } ## fake summary (we don't really provide a summary, ## but summary produces now a reasonable result --- same as print) #' @rdname ser_permutation #' @export summary.ser_permutation <- function(object, ...) object #' @rdname ser_permutation #' @param recursive ignored. #' @export c.ser_permutation <- function(..., recursive = FALSE) do.call("ser_permutation", list(...)) ## fixme [[<- needs to check for ser_permutation_vector #' @rdname ser_permutation #' @param i index of the dimension(s) to extract. #' @export "[.ser_permutation" <- function(object, i, ...) do.call("ser_permutation", unclass(object)[i]) is.ser_permutation <- function(x) inherits(x, "ser_permutation") | inherits(x, "ser_permutation_vector") seriation/R/seriate_PCA.R0000644000176200001440000000651314723677405014736 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. ## use the projection on the first principal component to determine the ## order .pca_contr <- list( center = TRUE, scale = FALSE, verbose = FALSE ) attr(.pca_contr, "help") <- list( center = "center the data (mean = 0)?", scale = "scale to unit variance?", verbose = FALSE ) seriate_matrix_fpc <- function(x, control = NULL, margin) { control <- .get_parameters(control, .pca_contr) center <- control$center scale <- control$scale verbose <- control$verbose o <- list(row = NA, col = NA) if (1L %in% margin) { pr <- stats::prcomp(x, center = center, scale. = scale, rank. = 1L) scores <- pr$x[, 1] os <- order(scores) o$row <- structure(os, names = rownames(x)[os], configuration = scores) if (verbose) cat("Rows: first PC explains", pr$sdev[1] / sum(pr$sdev) * 100, "%\n") } if (2L %in% margin) { x <- t(x) pr <- stats::prcomp(x, center = center, scale. = scale, rank. = 1L) scores <- pr$x[, 1] os <- order(scores) o$col <- structure(os, names = rownames(x)[os], configuration = scores) if (verbose) cat("Cols: first PC explains", pr$sdev[1] / sum(pr$sdev) * 100, "%\n") } if (verbose) cat("\n") o } seriate_matrix_angle <- function(x, control = NULL, margin) { control <- .get_parameters(control, .pca_contr) center <- control$center scale <- control$scale if (nrow(x) < 2L || ncol(x) < 2L) stop("PCA angle needs at least 2 rows and 2 columns!") if (1L %in% margin) { pr <- prcomp(x, center = center, scale. = scale, rank = 2L) row <- .order_angle(pr$x[, 1:2]) } else row <- NA if (2L %in% margin) { pr <- prcomp(t(x), center = center, scale. = scale, rank = 2L) col <- .order_angle(pr$x[, 1:2]) } else col <- NA list(row = row, col = col) } set_seriation_method( "matrix", "PCA", seriate_matrix_fpc, "Uses the projection of the data on its first principal component to determine the order.", .pca_contr, optimizes = .opt(NA, "Least squares for each dimension (for Euclidean distances).") ) set_seriation_method( "matrix", "PCA_angle", seriate_matrix_angle, "Uses the angular order in the 2D PCA projection space split by the larges gap.", .pca_contr ) seriation/R/seriate_heatmap.R0000644000176200001440000000761114706524256015746 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. ## calculate distances for rows and columns, perform hclust and reorder. .heatmap_contr <- list( dist_fun = list(row = dist, col = dist), seriation_method = list(row = "OLO_complete", col = "OLO_complete"), seriation_control = list(row = NULL, col = NULL), scale = "none", verbose = FALSE ) attr(.heatmap_contr, "help") <- list( dist_fun = "A named list with functions to calulate row and column distances", seriation_method = "A named list with row and column seriation methods", seriation_control = "named list with control parameters for the seriation methods", scale = 'Scale "rows", "cols", or "none"' ) seriate_matrix_heatmap <- function(x, control = NULL, margin = seq_along(dim(x))) { control <- .get_parameters(control, .heatmap_contr) if (length(control$dist_fun) == 1L) control$dist_fun <- list(row = control$dist_fun, col = control$dist_fun) if (length(control$seriation_method) == 1L) control$seriation_method <- list(row = control$seriation_method, col = control$seriation_method) if (length(control$seriation_control) == 1L) control$seriation_control <- list(row = control$seriation_control, col = control$seriation_control) if (!is.null(control$scale)) { if (control$scale == "rows") x <- t(scale(t(x))) if (control$scale == "cols") x <- scale(x) } if (1L %in% margin) { d <- control$dist_fun$row(x) if (tolower(control$seriation_method$row) == "hc_mean") o_row <- ser_permutation_vector(seriate_hc_mean(d, x, control$seriation_control$row), method = "HC_Mean") else o_row <- seriate( d, method = control$seriation_method$row, control = control$seriation_control$row )[[1]] } else o_row <- NA if (2L %in% margin) { x <- t(x) d <- control$dist_fun$col(x) if (tolower(control$seriation_method$col) == "hc_mean") o_col <- ser_permutation_vector(seriate_hc_mean(d, x, control$seriation_control$col), method = "HC_Mean") else o_col <- seriate( d, method = control$seriation_method$col, control = control$seriation_control$col )[[1]] } else o_col <- NA #names(row) <- rownames(x)[get_order(o_row)] #names(col) <- colnames(x)[get_order(o_col)] list(row = o_row, col = o_col) } seriate_hc_mean <- function(d, x, control = NULL) { if (missing(x)) stop("data matrix x needs to be specified for leaf order with mean reordering.") hc <- stats::as.hclust(stats::reorder( stats::as.dendrogram(seriate_dist_hc(d, control)), wts = rowSums(x, na.rm = TRUE) )) hc$call <- match.call() hc$method <- "hclust + mean reordering" hc$dist.method <- attr(d, "method") hc } set_seriation_method( "matrix", "Heatmap", seriate_matrix_heatmap, "Calculates distances for rows and columns and then independently applies the specified seriation method for distances.", control = .heatmap_contr ) seriation/R/register_tsne.R0000644000176200001440000001431614724357421015466 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (C) 2015 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. #' Register Seriation Based on 1D t-SNE #' #' Use t-distributed stochastic neighbor embedding (t-SNE) for [seriate()]. #' #' Registers the method `"tsne"` for [seriate()]. This method applies #' 1D t-SNE to a data matrix or a distance matrix and extracts the order #' from the 1D embedding. To speed up the process, an initial embedding is #' created using 1D multi-dimensional scaling (MDS) or principal #' components analysis (PCA) which is improved by t-SNE. #' #' The `control` parameter `"mds"` or `"pca"` controls if MDS (for distances) #' or PCA (for data matrices) is used to create an #' initial embedding. See [Rtsne::Rtsne()] to learn about the other #' available `control` parameters. #' #' Perplexity is automatically set as the minimum between 30 and the number of #' observations. It can be also specified using the control parameter #' `"preplexity"`. #' #' **Note:** Package \pkg{Rtsne} needs to be installed. #' #' @aliases register_tsne tsne tSNE #' @seealso [Rtsne::Rtsne()] #' @family seriation #' @returns Nothing. #' #' @references van der Maaten, L.J.P. & Hinton, G.E., 2008. Visualizing #' High-Dimensional Data Using t-SNE. _Journal of Machine Learning Research,_ #' **9**, #' pp.2579-2605. #' @keywords optimize cluster #' @examples #' #' \dontrun{ #' register_tsne() #' #' # distances #' get_seriation_method("dist", "tsne") #' #' data(SupremeCourt) #' d <- as.dist(SupremeCourt) #' #' o <- seriate(d, method = "tsne", verbose = TRUE) #' pimage(d, o) #' #' # look at the returned configuration and plot it #' attr(o[[1]], "configuration") #' plot_config(o) #' #' # the t-SNE results are also available as an attribute (see ? Rtsne::Rtsne) #' attr(o[[1]], "model") #' #' ## matrix #' get_seriation_method("matrix", "tsne") #' #' data("Zoo") #' x <- Zoo #' #' x[,"legs"] <- (x[,"legs"] > 0) #' #' # t-SNE does not allow duplicates #' x <- x[!duplicated(x), , drop = FALSE] #' #' class <- x$class #' label <- rownames(x) #' x <- as.matrix(x[,-17]) #' #' o <- seriate(x, method = "tsne", eta = 10, verbose = TRUE) #' pimage(x, o, prop = FALSE, row_labels = TRUE, col_labels = TRUE) #' #' # look at the row embedding #' plot_config(o[[1]], col = class) #' } #' #' @export register_tsne <- function() { check_installed("Rtsne") .contr <- structure( list( max_iter = 1000, theta = 0.5, perplexity = NULL, eta = 100, mds = TRUE, verbose = FALSE ), help = list( max_iter = "number of iterations", theta = "speed/accuracy trade-off (increase for less accuracy)", perplexity = "perplexity parameter (calculated as n - 1 / 3)", eta = "learning rate", mds = "start from a classical MDS solution" ) ) tsne_order <- function(x, control) { control <- .get_parameters(control, .contr) # start with MDS if (control$mds) Y_init <- stats::cmdscale(x, k = 1) else Y_init <- NULL # default is 30 (reduced for low n) if (is.null(control$preplexity)) control$perplexity <- 30 control$perplexity <- max(min(control$perplexity, floor(attr(x, "Size") / 3) - 1), 1) embedding <- Rtsne::Rtsne( x, dims = 1, is_distance = TRUE, max_iter = control$max_iter, theta = control$theta, eta = control$eta, perplexity = control$perplexity, Y_init = Y_init, verbose = control$verbose ) o <- order(embedding$Y) attr(o, "configuration") <- structure(drop(embedding$Y), names = attr(x, "Labels")) attr(o, "model") <- embedding o } .contr_matrix <- structure( list( max_iter = 1000, theta = 0.5, perplexity = NULL, eta = 100, pca = TRUE ), help = list(max_iter = "number of iterations", theta = "speed/accuracy trade-off (increase for less accuracy)", perplexity = "perplexity parameter (calculated as n - 1 / 3)", eta = "learning rate", pca = "start the PCA solution" )) tsne_order_matrix <- function(x, control) { control <- .get_parameters(control, .contr_matrix) # default is 30 (reduced for low n) if (is.null(control$preplexity)) control$perplexity <- 30 control$perplexity <- max(min(control$perplexity, floor(nrow(x) / 3) - 1), 1) embedding <- Rtsne::Rtsne( x, dims = 1, is_distance = FALSE, pca = control$pca, max_iter = control$max_iter, theta = control$theta, eta = control$eta, perplexity = control$perplexity, verbose = control$verbose ) o <- order(embedding$Y) attr(o, "configuration") <- structure(drop(embedding$Y), names = rownames(x)) attr(o, "model") <- embedding o } tsne_order_matrix_2 <- function(x, control, margin = seq_along(dim(x))) { if (1L %in% margin) row <- tsne_order_matrix(x, control) else row <- NA if (2L %in% margin) col <- tsne_order_matrix(t(x), control) else col <- NA list(row, col) } set_seriation_method( "dist", "tsne", tsne_order, "Use 1D t-distributed stochastic neighbor embedding (t-SNE) a distance matrix to create an order (van der Maaten and Hinton, 2008).", .contr, randomized = TRUE, verbose = TRUE ) set_seriation_method( "matrix", "tsne", tsne_order_matrix_2, "Use 1D t-distributed stochastic neighbor embedding (t-SNE) of the rows of a matrix to create an order (van der Maaten and Hinton, 2008).", .contr_matrix, randomized = TRUE, verbose = TRUE ) } seriation/R/ggpimage.R0000644000176200001440000001461714706524256014377 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. ## image method that makes a proper image plot of a matrix. ## the rows and columns are swapped and the order of the ## columns (original rows) is reversed. #' @rdname pimage #' @include pimage.R #' @export ggpimage <- function(x, order = NULL, ...) UseMethod("ggpimage") ### Note for matrix large values are dark, for dist large values are light! #' @rdname pimage #' @export ggpimage.matrix <- function(x, order = NULL, zlim = NULL, upper_tri = TRUE, lower_tri = TRUE, diag = TRUE, row_labels = NULL, col_labels = NULL, prop = isSymmetric(x), flip_axes = FALSE, reverse_columns = FALSE, ...) { check_installed("ggplot2") force(prop) x <- as.matrix(x) # check data if (all(is.na(x))) stop("all data missing in x.") if (any(is.infinite(x))) stop("x contains infinite entries.") # reorder if (!is.null(order)) x <- permute(x, order) # mask triangles if (any(!upper_tri || !lower_tri || !diag) && nrow(x) != ncol(x)) stop("Upper triangle, lower triangle or diag can only be suppressed for square matrices!") if (!upper_tri) x[upper.tri(x)] <- NA if (!lower_tri) x[lower.tri(x)] <- NA if (!diag) diag(x) <- NA # reverse order of columns if (reverse_columns) x <- x[, seq(ncol(x), 1)] # change x and y? if (flip_axes) { x <- t(x) tmp <- row_labels row_labels <- col_labels col_labels <- tmp } # plot g <- .ggpimage_empty( x, zlim = zlim, row_labels = row_labels, col_labels = col_labels, prop = prop, expand = FALSE ) g <- g + ggplot2::geom_raster(ggplot2::aes(fill = x)) g } #' @export ggpimage.default <- ggpimage.matrix ## small values are dark #' @rdname pimage #' @export ggpimage.dist <- function(x, order = NULL, zlim = NULL, upper_tri = TRUE, lower_tri = TRUE, diag = TRUE, row_labels = NULL, col_labels = NULL, prop = TRUE, flip_axes = FALSE, reverse_columns = FALSE, ...) { check_installed("ggplot2") # reorder specific for dist (we have only a single permutation) if (!is.null(order)) x <- permute(x, order) if (flip_axes) warning("flipping axes has no effect for distance matrices.") g <- ggpimage.matrix( as.matrix(x), order = NULL, zlim = zlim, upper_tri, lower_tri, diag, row_labels, col_labels, prop = prop, flip_axes = FALSE, reverse_columns = reverse_columns, ... ) # reverse color for dist suppressMessages(g <- g + .gg_sequential_pal(dist = TRUE, limits = zlim)) g } ### Note for matrix large values are dark, for dist large values are light! .ggpimage_empty <- function(x, zlim = NULL, row_labels = NULL, col_labels = NULL, prop = TRUE, expand = TRUE) { check_installed("ggplot2") x <- as.matrix(x) # check data if (all(is.na(x))) stop("all data missing in x.") if (any(is.infinite(x))) stop("x contains infinite entries.") # deal with row/col labels if (!is.null(row_labels) && !is.logical(row_labels)) { if (length(row_labels) != nrow(x)) stop("Length of row_labels does not match the number of rows of x.") rownames(x) <- row_labels row_labels <- TRUE } if (!is.null(col_labels) && !is.logical(col_labels)) { if (length(col_labels) != ncol(x)) stop("Length of col_labels does not match the number of columns of x.") colnames(x) <- col_labels col_labels <- TRUE } if (is.null(row_labels)) if (!is.null(rownames(x)) && nrow(x) < 25) { row_labels <- TRUE } else{ row_labels <- FALSE } if (is.null(col_labels)) if (!is.null(colnames(x)) && ncol(x) < 25) { col_labels <- TRUE } else{ col_labels <- FALSE } if (is.null(rownames(x))) rownames(x) <- seq(nrow(x)) if (is.null(colnames(x))) colnames(x) <- seq(ncol(x)) # convert to data.frame with row, col and x x_df <- data.frame( row = factor(rep(seq(nrow( x )), times = ncol(x)), levels = seq(nrow(x), 1)), col = factor(rep(seq(ncol( x )), each = nrow(x)), levels = seq(ncol(x))), x = as.vector(x) ) if (!is.null(rownames(x))) levels(x_df[["row"]]) <- rev(rownames(x)) if (!is.null(colnames(x))) levels(x_df[["col"]]) <- colnames(x) # plot g <- ggplot2::ggplot(x_df, ggplot2::aes(y = row, x = col)) # axes (row and col labels) if (expand) expand <- ggplot2::waiver() else expand <- c(0, 0) if (col_labels) breaksCol <- ggplot2::waiver() else breaksCol <- NULL if (row_labels) breaksRow <- ggplot2::waiver() else breaksRow <- NULL g <- g + ggplot2::scale_x_discrete(breaks = breaksCol, expand = expand) + ggplot2::scale_y_discrete(breaks = breaksRow, expand = expand) # no axis or legend labels g <- g + ggplot2::labs(x = NULL, y = NULL, fill = NULL) g <- g + ggplot2::theme(axis.text.x = ggplot2::element_text( angle = 90, hjust = 1, vjust = .5 )) if (prop) g <- g + ggplot2::theme(aspect.ratio = nrow(x) / ncol(x)) # colors scales if (is.logical(x)) { col <- .gg_logical_pal() # colors for diverging } else if (!is.null(zlim)) { if (min(zlim) < 0) col <- .gg_diverge_pal(limits = zlim) else col <- .gg_sequential_pal(limits = zlim) } else { if (any(x < 0, na.rm = TRUE)) { col <- .gg_diverge_pal(limits = zlim) zlim <- max(abs(range(x, na.rm = TRUE))) * c(-1, 1) } else col <- .gg_sequential_pal(limits = zlim) } g <- g + col g } seriation/R/reorder.hclust.R0000644000176200001440000000740014706524256015552 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. #' Reorder Dendrograms using Optimal Leaf Ordering #' #' Reorder method for dendrograms for optimal leaf ordering. #' #' Minimizes the distance between neighboring objects (leaf nodes) in the #' dendrogram by flipping the order of subtrees. The algorithm by Gruvaeus and #' Wainer is implemented in package \pkg{gclus} (Hurley 2004). #' #' @aliases reorder reorder.hclust #' @param x an object of class \code{hclust}. #' @param dist an object of class \code{dist} with dissimilarities between the #' objects in \code{x}. #' @param method a character string with the name of the used measure. #' Available are: #' - \code{"OLO"} (optimal leaf ordering; Bar-Joseph et al., 2001) implemented in this package and #' - \code{"GW"} (Gruvaeus and Wainer, 1972) from package \pkg{gclus}. #' @param ... further arguments are currently ignored. #' @return A reordered \code{hclust} object. #' @author Michael Hahsler #' @seealso [gclus::reorder.hclust()] #' @references Bar-Joseph, Z., E. D. Demaine, D. K. Gifford, and T. Jaakkola. #' (2001): Fast Optimal Leaf Ordering for Hierarchical Clustering. #' \emph{Bioinformatics,} \bold{17}(1), 22--29. #' #' Gruvaeus, G. and Wainer, H. (1972): Two Additions to Hierarchical Cluster #' Analysis, \emph{British Journal of Mathematical and Statistical Psychology,} #' \bold{25}, 200--206. #' #' Hurley, Catherine B. (2004): Clustering Visualizations of Multidimensional #' Data. \emph{Journal of Computational and Graphical Statistics,} #' \bold{13}(4), 788--806. #' @keywords optimize cluster #' @examples #' ## cluster European cities by distance #' data("eurodist") #' d <- as.dist(eurodist) #' hc <- hclust(eurodist) #' #' ## plot original dendrogram and the reordered dendrograms #' plot(hc) #' plot(reorder(hc, d, method = "GW")) #' plot(reorder(hc, d, method = "OLO")) #' @export reorder.hclust <- function(x, dist, method = "OLO", ...) { method <- match.arg(tolower(method), choices = c("olo", "gw")) ## no reordering for less than 3 objects! if (length(x$order) < 3) return(x) switch(method, olo = .seriate_optimal(x, dist), gw = .seriate_gruvaeus(x, dist)) } ## wrapper for reorder.hclust in gclus .seriate_gruvaeus <- function(hclust, dist) gclus::reorder.hclust(hclust, dist) ## wrapper to the optimal leaf ordering algorithm ## ## ceeboo 2005 .seriate_optimal <- function(hclust, dist) { ## check hclust merge <- hclust$merge if (!is.matrix(merge)) stop("Component 'merge' of argument 'hclust' must be a matrix.") if (length(dim(merge)) != 2) stop("Component 'merge' of argument 'hclust' is invalid.") if (dim(merge)[1] != attr(dist, "Size") - 1) stop("Argument 'dist' and component 'merge' of argument 'hclust' do not conform.") mode(merge) <- "integer" obj <- .Call("order_optimal", dist, merge) names(obj) <- c("merge", "order", "length") ##names(obj$order) <- attr(dist,"Labels") hclust$merge <- obj$merge hclust$order <- obj$order hclust } seriation/R/seriate_MDS.R0000644000176200001440000001045614706524256014753 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. # MDS: cmdscale .mds_control <- list(add = FALSE) attr(.mds_control, "help") <- list(add = "make the distances Euclidean using an additive constant (see ? cmdscale)") seriate_dist_mds <- function(x, control = NULL) { ### accept deprecated method if (!is.null(control$method)) { control$method <- NULL warning("seriation method mds: control parameter method is deprecated and ignored!") } control <- .get_parameters(control, .mds_control) # eig = TRUE makes sure we get a list back sc <- stats::cmdscale(x, k = 1, eig = TRUE, add = control$add) sc <- drop(sc$points) o <- order(sc) attr(o, "configuration") <- sc o } # isoMDS: MASS::isoMDS .mds_isoMDS_control <- list( add = 1e-9, # to avoid 0 distances maxit = 50, trace = FALSE, tol = 1e-3, p = 2 ) attr(.mds_isoMDS_control, "help") <- list( add = "small constant to avoid 0 distances", maxit = "maximum number of iterations", trace = "trace optimization", tol = "convergence tolerance", p = "power for Minkowski distance in the configuration space" ) seriate_dist_mds_isoMDS <- function(x, control = NULL) { control <- .get_parameters(control, .mds_isoMDS_control) sc <- MASS::isoMDS( x + control$add, k = 1, maxit = control$maxit, trace = control$trace, tol = control$tol, p = control$p ) o <- order(sc$points[, 1]) attr(o, "configuration") <- sc$points[, 1] o } # Sammon mapping: MDS::sammon .mds_sammon_control <- list( add = 1e-9, # to avoid 0 distances niter = 100, trace = FALSE, magic = 0.2, tol = 1e-4 ) attr(.mds_sammon_control, "help") <- list( add = "small constant to avoid 0 distances", niter = "maximum number of iterations", trace = "trace optimization", magic = "initial value of the step size constant in diagonal Newton method", tol = "tolerance for stopping in units of stress" ) seriate_dist_mds_sammon <- function(x, control = NULL) { control <- .get_parameters(control, .mds_sammon_control) sc <- MASS::sammon( x + control$add, y = jitter(stats::cmdscale(x, k = 1)), ### fixes issue with duplicates k = 1, niter = control$niter, trace = control$trace, magic = control$magic, tol = control$tol ) o <- order(sc$points[, 1]) attr(o, "configuration") <- sc$points[, 1] o } ## Angle between the first 2 PCS. Friendly (2002) seriate_dist_angle <- function(x, control = NULL) { control <- .get_parameters(control, .mds_control) sc <- stats::cmdscale(x, k = 2, eig = TRUE, add = control$add) sc <- sc$points o <- .order_angle(sc) attr(o, "configuration") <- sc o } set_seriation_method( "dist", "MDS", seriate_dist_mds, "Order along the 1D classical metric multidimensional scaling", control = .mds_control, optimizes = .opt("MDS_stress", "Euclidean distances") ) set_seriation_method( "dist", "MDS_angle", seriate_dist_angle, "Order by the angular order in the 2D MDS projection space split by the larges gap", control = .mds_control ) set_seriation_method( "dist", "isoMDS", seriate_dist_mds_isoMDS, "Order along the 1D Kruskal's non-metric multidimensional scaling", control = .mds_isoMDS_control, optimizes = .opt("MDS_stress", "with monotonic transformation") ) set_seriation_method( "dist", "Sammon_mapping", seriate_dist_mds_sammon, "Order along the 1D Sammon's non-linear mapping", control = .mds_sammon_control, optimizes = .opt("MDS_stress", "scale free, weighted stress called Sammon's error") ) seriation/R/ggdissplot.R0000644000176200001440000001116714706524256014773 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. #' @rdname dissplot #' @export ggdissplot <- function(x, labels = NULL, method = "spectral", control = NULL, lower_tri = TRUE, upper_tri = "average", diag = TRUE, cluster_labels = TRUE, cluster_lines = TRUE, reverse_columns = FALSE, ...) { check_installed("ggplot2") # make x dist if (!inherits(x, "dist")) { if (is.matrix(x) && isSymmetric(x)) x <- as.dist(x) else stop("Argument 'x' cannot safely be coerced to class 'dist'.") } x <- .arrange_dissimilarity_matrix(x, labels = labels, method = method, control = control) m <- .average_tri(x, lower_tri = lower_tri, upper_tri = upper_tri, diag = diag) k <- x$k dim <- attr(x$x_reordered, "Size") labels <- x$labels labels_unique <- unique(labels) # So we can add cluster labels later if (cluster_labels) colnames(m) <- seq(ncol(m)) g <- ggpimage(m, reverse_columns = reverse_columns, prop = TRUE, ...) # add cluster lines and labels if (!is.null(labels)) { cluster_width <- tabulate(labels)[labels_unique] cluster_cuts <- cumsum(cluster_width) cluster_center <- cluster_cuts - cluster_width / 2 clusters <- data.frame( center = cluster_center, cut = cluster_cuts, width = cluster_width, label = labels_unique ) ### NULLIFY for CRAN check center <- label <- cut <- NULL if (cluster_labels) { # Place cluster labels along diagonal # if (!flip) { # g <- g + ggplot2::geom_label(data = clusters, # ggplot2::aes( # x = center, # y = nrow(m) - center, # label = label # )) # } else{ # g <- g + ggplot2::geom_label(data = clusters, # ggplot2::aes( # x = ncol(m) - center, # y = nrow(m) - center, # label = label # )) # } # Place cluster labels on top as x-axis (needs the colnames set as a sequence) # this uses the row name not the position so no reordering is necessary # if (reverse_columns) { # breaks <- floor(clusters$center) # label_o <- order(breaks) # labels <- clusters$label[label_o] # breaks <- breaks[label_o] # } else { labels <- clusters$label breaks <- floor(clusters$center) # } # suppress redefinition message suppressMessages( g <- g + ggplot2::scale_x_discrete( breaks = breaks, label = as.character(labels), expand = c(0, 0), position = "top" ) + ggplot2::theme(axis.text.x = ggplot2::element_text( angle = 0, vjust = 0.5, hjust = .5 )) + ggplot2::labs(x = "Cluster") ) if (cluster_lines) { ## draw lines separating the clusters if (reverse_columns) { g <- g + ggplot2::geom_hline(data = clusters, ggplot2::aes(yintercept = nrow(m) - cut + .5)) + ggplot2::geom_vline(data = clusters, ggplot2::aes(xintercept = ncol(m) - cut + .5)) } else{ g <- g + ggplot2::geom_hline(data = clusters, ggplot2::aes(yintercept = nrow(m) - cut + .5)) + ggplot2::geom_vline(data = clusters, ggplot2::aes(xintercept = cut + .5)) } } } } # reverse color suppressMessages(g <- g + .gg_sequential_pal(dist = TRUE)) g } seriation/vignettes/0000755000176200001440000000000014724364730014271 5ustar liggesusersseriation/vignettes/seriation.Rnw0000644000176200001440000024055114724357421016764 0ustar liggesusers\documentclass[nojss]{jss} \usepackage[english]{babel} %\documentclass[fleqn, a4paper]{article} %\usepackage{a4wide} %\usepackage[round,longnamesfirst]{natbib} %\usepackage{graphicx,keyval,thumbpdf,url} %\usepackage{hyperref} %\usepackage{Sweave} \SweaveOpts{strip.white=true} \AtBeginDocument{\setkeys{Gin}{width=0.6\textwidth}} \usepackage[utf8]{inputenc} %% end of declarations %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \usepackage{amsmath} \usepackage{amsfonts} %\newcommand{\strong}[1]{{\normalfont\fontseries{b}\selectfont #1}} \newcommand{\class}[1]{\mbox{\textsf{#1}}} \newcommand{\func}[1]{\mbox{\texttt{#1()}}} %\newcommand{\code}[1]{\mbox{\texttt{#1}}} %\newcommand{\pkg}[1]{\strong{#1}} \newcommand{\samp}[1]{`\mbox{\texttt{#1}}'} %\newcommand{\proglang}[1]{\textsf{#1}} \newcommand{\set}[1]{\mathcal{#1}} \newcommand{\sQuote}[1]{`{#1}'} \newcommand{\dQuote}[1]{``{#1}''} \newcommand\R{{\mathbb{R}}} \DeclareMathOperator*{\argmin}{argmin} \DeclareMathOperator*{\argmax}{argmax} %% almost as usual \author{Michael Hahsler\\Southern Methodist University \And Kurt Hornik\\Wirtschaftsuniversit\"at Wien \AND Christian Buchta\\Wirtschaftsuniversit\"at Wien} \title{Getting Things in Order:\\ An Introduction to the \proglang{R}~Package~\pkg{seriation}} %% for pretty printing and a nice hypersummary also set: \Plainauthor{Michael Hahsler, Kurt Hornik, Christian Buchta} %% comma-separated \Plaintitle{Getting Things in Order: An Introduction to the R Package seriation} %% without formatting \Shorttitle{Getting Things in Order} %% a short title (if necessary) %% an abstract and keywords \Abstract{Seriation, i.e., finding a suitable linear order for a set of objects given data and a loss or merit function, is a basic problem in data analysis. Caused by the problem's combinatorial nature, it is hard to solve for all but very small sets. Nevertheless, both exact solution methods and heuristics are available. In this paper we present the package~\pkg{seriation} which provides an infrastructure for seriation with \proglang{R}. The infrastructure comprises data structures to represent linear orders as permutation vectors, a wide array of seriation methods using a consistent interface, a method to calculate the value of various loss and merit functions, and several visualization techniques which build on seriation. To illustrate how easily the package can be applied for a variety of applications, a comprehensive collection of examples is presented.} \Keywords{combinatorial data analysis, seriation, permutation, \proglang{R}} \Plainkeywords{combinatorial data analysis, seriation, permutation, R} %% without formatting \Address{ Michael Hahsler\\ Engineering Management, Information, and Systems\\ Lyle School of Engineering\\ Southern Methodist University\\ P.O. Box 750123 \\ Dallas, TX 75275-0123\\ E-mail: \email{mhahsler@lyle.smu.edu}\\ URL: \url{http://lyle.smu.edu/~mhahsler} Kurt Hornik\\ Department f\"ur Statistik \& Mathematik\\ Wirtschaftsuniversit\"at Wien\\ 1090 Wien, Austria\\ E-mail: \email{kurt.hornik@wu.ac.at}\\ URL: \url{http://statmath.wu.ac.at/~hornik/} Christian Buchta\\ Department f\"ur Welthandel\\ Wirtschaftsuniversit\"at Wien\\ 1090 Wien, Austria\\ E-mail: \email{christian.buchta@wu.ac.at}\\ URL: \url{http://www.wu.ac.at/itf/institute/staff/buchta} } \hyphenation{Brusco} \sloppy %% \VignetteIndexEntry{An Introduction to the R package seriation} \begin{document} %\title{Getting Things in Order: An introduction to the %R~package~\pkg{seriation}} %\author{Michael Hahsler, Kurt Hornik and Christian Buchta} \maketitle %\abstract{Seriation, i.e., finding a suitable linear order for a set of % objects given data and a loss or merit function, is a basic problem in % data analysis. Caused by the problem's combinatorial nature, it is % hard to solve for all but very small sets. Nevertheless, both exact % solution methods and heuristics are available. In this paper we % present the package~\pkg{seriation} which provides an infrastructure % for seriation with \proglang{R}. The infrastructure comprises data % structures to represent linear orders as permutation vectors, a wide % array of seriation methods using a consistent interface, a method to % calculate the value of various loss and merit functions, and several % visualization techniques which build on seriation. To illustrate how % easily the package can be applied for a variety of applications, a % comprehensive collection of examples is presented.} % <>= options(scipen=3, digits=4) ### for sampling set.seed(1234) @ \section{Introduction} A basic problem in data analysis, called \emph{seriation} or sometimes \emph{sequencing}, is to arrange all objects in a set in a linear order given available data and some loss or merit function in order to reveal structural information. Together with cluster analysis and variable selection, seriation is an important problem in the field of \emph{combinatorial data analysis}~\citep{seriation:Arabie:1996}. Solving problems in combinatorial data analysis requires the solution of discrete optimization problems which, in the most general case, involves evaluating all feasible solutions. Due to the combinatorial nature, the number of possible solutions grows with problem size (number of objects, $n$) by the order~$O(n!)$. This makes a brute-force enumerative approach infeasible for all but very small problems. To solve larger problems (currently with up to 40 objects), partial enumeration methods can be used. For example, \cite{seriation:Hubert:2001} propose dynamic programming and \cite{seriation:Brusco:2005} use a branch-and-bound strategy. For even larger problems only heuristics can be employed. It has to be noted that seriation has a rich history in archaeology. \cite{seriation:Petrie:1899} was the first to use seriation as a formal method. He applied it to find a chronological order for graves discovered in the Nile area given objects found there. He used a cross-tabulation of grave sites and objects and rearranged the table using row and column permutations till all large values were close to the diagonal. In the rearranged table graves with similar objects are closer to each other. Together with the assumption that different objects continuously come into and go out of fashion, the order of graves in the rearranged table suggests a chronological order. Initially, the rearrangement of rows and columns of this contingency table was done manually and the adequacy was only judged subjectively by the researcher. Later, \cite{seriation:Robinson:1951}, \cite{seriation:Kendall:1971} and others proposed measures of agreement between rows to quantify optimality of the resulting table. A comprehensive description of the development of seriation in archaeology is presented by \cite{seriation:Ihm:2005}. Techniques related to seriation are also popular in several other fields. Especially in ecology scaling techniques are used under the name \emph{ordination}. For these applications several \proglang{R} packages already exist (e.g., \pkg{ade4}~\citep{seriation:Chessel:2007,seriation:Dray:2007} and \pkg{vegan}~\citep{seriation:Oksanen:2007}). This paper describes the new package \pkg{seriation} which differs from existing packages in the following ways: \begin{itemize} \item \pkg{seriation} provides a flexible infrastructure for seriation; \item \pkg{seriation} focuses on seriation as a combinatorial optimization problem. \end{itemize} This paper starts with a formal introduction of the seriation problem as a combinatorial optimization problem in Section~\ref{sec:seriation}. In Section~\ref{sec:methods} we give an overview of seriation methods. In Section~\ref{sec:infrastructure} we present the infrastructure provided by the package~\pkg{seriation}. Several examples and applications for seriation are given in Section~\ref{sec:example}. Section~\ref{sec:conclusion} concludes. A previous version of this manuscript was published in the \emph{Journal of Statistical Software} \citep{seriation:Hahsler+Hornik:2008}. \section{Seriation as a combinatorial optimization problem} \label{sec:seriation} To seriate a set of $n$ objects $\{O_1,\dots,O_n\}$ one typically starts with an $n \times n$ symmetric dissimilarity matrix~$\mathbf{D} = (d_{ij})$ where $d_{ij}$ for $1 \le i,j \le n$ represents the dissimilarity between objects $O_i$ and $O_j$, and $d_{ii} = 0$ for all~$i$. We define a permutation function $\Psi$ as a function which reorders the objects in $\mathbf{D}$ by simultaneously permuting rows and columns. The seriation problem is to find a permutation function $\Psi^*$ %$\{1,\dots,n\} \rightarrow \{1,\dots,n\}$, i.e. a %bijection that maps the set of indices of the objects (and equally of rows and %columns of $\mathbf{D}$) onto itself, which optimizes the value of a given loss function~$L$ or merit function~$M$. This results in the optimization problems \begin{equation} \Psi^* = \argmin_\Psi L(\Psi(\mathbf{D})) \quad \text{or} \quad \Psi^* = \argmax_\Psi M(\Psi(\mathbf{D})), \end{equation} respectively. %This is clearly a hard discrete optimization problem since the number of %possible permutations is $n!$ which makes an exhaustive %search for sets with a medium to large number of objects infeasible. %Partial enumeration methods and heuristics can be used. Such methods are %presented in Section~\ref{sec:methods}. %But first, we review commonly used loss functions in the following section. %\marginpar{two-mode data missing} A symmetric dissimilarity matrix is known as \emph{two-way one-mode} data since it has columns and rows (two-way) but only represents one set of objects (one-mode). Seriation is also possible for two-way two-mode data which are represented by a general nonnegative matrix. In such data columns and rows represent two sets of objects which are reordered simultaneously. For loss/merit functions for two-way two-mode data the optimal order of columns can depend of the order of rows and vice versa or it can be independent allowing for breaking the optimization down into two separate problems, one for the columns and one for the rows. Another way to deal with the seriation for two-way two-mode data is to calculate two dissimilarity matrices, one for each mode, and then solve two seriation problems for two-way one-mode data. Furthermore, seriation can be generalized to $k$-way $k$-mode data in the form of a $k$-dimensional array by defining suitable loss/merit functions for such data or by breaking the problem down into several lower dimensional independent problems. To assess the complexity of seriation of $k$-way $k$-mode data, let us assume the data is a $k$-dimensional array with the dimensions containing $n_1, n_2, \ldots, n_k$ objects. If the loss/merit function allows for separating the problem into $k$ independent problems, the problem size is just the sum of the individual problems. By using complete enumeration the size is $O(\sum_{i=1}^k{n_i!})$. If the problem is not separable and the optimal seriation of each dimension depends on the order of the objects of the other dimensions, the problem size is $O((\sum_{i=1}^k{n_i})!)$. For example for $k=5$ and all dimensions containing 5 objects, the search space for separable dimensions is only 600 while without separability it is larger than $10^{25}$ clearly too big to be solvable in reasonable time. This shows that for data with even only a few dimensions and a few objects each, finding the optimal solution is infeasible and loss/merit functions which allow for separating the problem are highly desirable. In the following subsections, we review some commonly employed loss/merit functions. Most functions are used for two-way one-mode data but the measure of effectiveness and stress can be also used for two-way two-mode data. For the implementation of various loss or merit measures see function~\func{criterion} in Section~\ref{sec:infrastructure}. %\section{Loss functions} %\label{sec:criteria} %In the literature several loss functions are suggested. %We review the most commonly used functions. \subsection{Column/row gradient measures} A symmetric dissimilarity matrix where the values in all rows and columns only increase when moving away from the main diagonal is called a perfect \emph{anti-Robinson matrix} after the statistician \cite{seriation:Robinson:1951}. Formally, an $n \times n$ dissimilarity matrix $\mathbf{D}$ is in anti-Robinson form if and only if the following two gradient conditions hold~\citep{seriation:Hubert:2001}: \begin{align} \text{within rows:} & \quad d_{ik} \le d_{ij} \quad \text{for} \quad 1 \le i < k < j \le n; \\ \text{within columns:} & \quad d_{kj} \le d_{ij} \quad \text{for} \quad 1 \le i < k < j \le n. \end{align} In an anti-Robinson matrix the smallest dissimilarity values appear close to the main diagonal, therefore, the closer objects are together in the order of the matrix, the higher their similarity. This provides a natural objective for seriation. It has to be noted that $\mathbf{D}$ can be brought into a perfect anti-Robinson form by row and column permutation whenever $\mathbf{D}$ is an ultrametric or $\mathbf{D}$ has an exact Euclidean representation in a single dimension~\citep{seriation:Hubert:2001}. However, for most data only an approximation to the anti-Robinson form is possible. A suitable merit measure which quantifies the divergence of a matrix from the anti-Robinson form was given by \cite{seriation:Hubert:2001} as \begin{equation} M(\mathbf{D}) = \sum_{i y. \end{cases} \end{equation} It results in the raw number of triples satisfying the gradient constraints minus triples which violate the constraints. The second function is defined as: \begin{equation} f(z,y) = |y-z|\mathrm{sign}(y-z) = y-z \end{equation} It weighs each satisfaction or violation by its magnitude given by the absolute difference between the values. \subsection{Anti-Robinson events} An even simpler loss function can be created in the same way as the gradient measures above by concentrating on violations only. \begin{equation} L(\mathbf{D}) = \sum_{i y \quad \text{and} \\ 0 \quad \text{otherwise.} \end{cases} \end{equation} $I(\cdot)$ is an indicator function returning $1$ only for violations. \cite{seriation:Chen:2002} presented a formulation for an equivalent loss function and called the violations \emph{anti-Robinson events}. \cite{seriation:Chen:2002} also introduced a weighted versions of the loss function resulting in \begin{equation} f(z, y) = |y-z|I(z, y) \end{equation} using the absolute deviations as weights. \subsection{Hamiltonian path length} The dissimilarity matrix $\mathbf{D}$ can be represented as a finite weighted graph $G = (\Omega,E)$ where the set of objects~$\Omega$ constitute the vertices and each edge~$e_{ij} \in E$ between the objects $O_i, O_j \in \Omega$ has a weight~$w_{ij}$ associated which represents the dissimilarity~$d_{ij}$. Such a graph can be used for seriation~\citep[see, e.g.,][]{seriation:Hubert:1974,seriation:Caraux:2005}. An order~$\Psi$ of the objects can be seen as a path through the graph where each node is visited exactly once, i.e., a Hamiltonian path. Minimizing the Hamiltonian path length results in a seriation optimal with respect to dissimilarities between neighboring objects. The loss function based on the Hamiltonian path length is: \begin{equation} L(\mathbf{D}) = \sum_{i=1}^{n-1} d_{i,i+1}. \end{equation} Note that the length of the Hamiltonian path is equal to the value of the \emph{minimal span loss function} \citep[as used by][]{seriation:Chen:2002}, and both notions are related to the \emph{traveling salesperson problem}~\citep{seriation:Gutin:2002}. \subsection{Inertia criterion} Another way to look at the seriation problem is not to focus on placing small dissimilarity values close to the diagonal, but to push large values away from it. A function to quantify this is the moment of inertia of dissimilarity values around the diagonal \citep{seriation:Caraux:2005} defined as \begin{equation} M(\mathbf{D}) = \sum_{i=1}^n \sum_{j=1}^n d_{ij}|i-j|^2. \end{equation} $|i-j|^2$ is used as a measure for the distance to the diagonal and $d_{ij}$ gives the weight. This is a merit function since the sum increases when higher dissimilarity values are placed farther away from the diagonal. \subsection{Least squares criterion} Another natural loss function for seriation is to quantify the deviations between the dissimilarities in $\mathbf{D}$ and the rank differences of the objects. Such deviations can be measured, e.g, by the sum of squares of deviations \citep{seriation:Caraux:2005} defined by \begin{equation} L(\mathbf{D}) = \sum_{i=1}^n \sum_{j=1}^n (d_{ij} - |i-j|)^2, \end{equation} where $|i-j|$ is the rank difference or gap between $O_i$ and $O_j$. The least squares criterion defined here is related to uni-dimensional scaling~\citep{seriation:Leeuw:2005}, where the objective is to place all $n$ objects on a straight line using a position vector~$\mathbf{z} = z_1,z_2,\ldots,z_n$ such that the dissimilarities in $\mathbf{D}$ are preserved by the relative positions in the best possible way. The optimization problem of uni-dimensional scaling is to find the position vector~$\mathbf{z^*}$ which minimizes $\sum_{i=1}^n \sum_{j=1}^n (d_{ij} - |z_i-z_j|)^2$. This is close to the seriation problem, but in addition to the ranking of the objects also takes the distances between objects on the resulting scale into account. Note that if Euclidean distance is used to calculate $\mathbf{D}$ from a data matrix~$\mathbf{X}$, using the order of the elements in $\mathbf{X}$ as they occur projected on the first principal component of $\mathbf{X}$ minimizes the loss function of uni-dimensional scaling (using squared distances). Using this order, also provides a good solution for the least square seriation criterion. \subsection{Linear Seriation Criterion} The Linear Seriation Criterion (Hubert and Schultz 1976) weights the distances with the absolute rank differences. $$L(\mathbf{D}) \sum_{i=1}^n \sum_{j=1}^n d_{ij} (-|i-j|)$$ \subsection{2-Sum Problem} The 2-Sum loss criterion \citep{seriation:Barnard:1993} multiplies the similarity between objects with the squared rank differences. $$L(\mathbf{D}) \sum_{i,j=1}^p \frac{1}{1+d_{ij}} (i-j)^2,$$ where $s_{ij} = \frac{1}{1+d_{ij}}$ represents the similarity between objects $i$ and $j$. \subsection{Measure of effectiveness} \label{sec:ME} \cite{seriation:McCormick:1972} defined the \emph{measure of effectiveness (ME)} for an $n \times m$ matrix~$\mathbf{X} = (x_{ij})$ as \begin{equation} M(\mathbf{X}) = \frac{1}{2} \sum_{i=1}^{n} \sum_{j=1}^{m} x_{ij}[x_{i,j+1}+x_{i,j-1}+ x_{i+1,j}+x_{i-1,j}] \label{equ:ME} \end{equation} with, by convention $x_{0,j}=x_{n+1,j}=x_{i,0}=x_{i,m+1}=0$. ME is maximized if each element is as closely related numerically to its four neighboring elements as possible. ME was developed for two-way two-mode data, however, ME can also be used for a symmetric matrix (one-mode data) and gets maximal only if all large values are grouped together around the main diagonal. Note that the definition in equation~(\ref{equ:ME}) can be rewritten as \begin{equation} M(\mathbf{X}) = \frac{1}{2} \sum_{i=1}^{n} \sum_{j=1}^{m} x_{ij}[x_{i,j+1}+x_{i,j-1}] + \sum_{i=1}^{n} \sum_{j=1}^{m} x_{ij}[x_{i+1,j}+x_{i-1,j}] \end{equation} showing that the contributions of column and row order to the merit function are independent. \subsection{Stress} \label{sec:stress} Stress measures the conciseness of the presentation of a matrix (two-mode data) and can be seen as a purity function which compares the values in a matrix with their neighbors. The stress measures used here are computed as the sum of squared distances of each matrix entry from its adjacent entries. \cite{seriation:Niermann:2005} defined for an $n \times m$ matrix~$\mathbf{X} = (x_{ij})$ two types of neighborhoods: \begin{itemize} \item The Moore neighborhood comprises the (at most) eight adjacent entries. The local stress measure for element~$x_{ij}$ is defined as \begin{equation} \sigma_{ij} = \sum_{k=\max(1,i-1)}^{\min(n,i+1)} \sum_{l=\max(1,j-1)}^{\min(m,j+1)} (x_{ij} - x_{kl})^2 \end{equation} \item The Neumann neighborhood comprises the (at most) four adjacent entries resulting in the local stress of $x_{ij}$ of \begin{equation} \sigma_{ij} = \sum_{k=\max(1,i-1)}^{\min(n,i+1)} (x_{ij} - x_{kj})^2 + \sum_{l=\max(1,j-1)}^{\min(m,j+1)} (x_{ij} - x_{il})^2 %(x_{ij} - x(i-1,j))^2 + (x_{ij} - x(i+1,j))^2 + %(x_{ij} - x(i,j-1))^2 + (x_{ij} - x(i,j+1))^2 \end{equation} \end{itemize} Both local stress measures can be used to construct a global measure for the whole matrix by summing over all entries which can be used as a loss function: \begin{equation} L(\mathbf{X}) = \sum_{i=1}^n \sum_{j=1}^m \sigma_{ij} \end{equation} The major difference between the Moore and the Neumann neighborhood is that for the later the contributions of row and column order to stress are independent. Stress can be also used as a loss function for symmetric proximity matrices (one-mode data). %, %since it can only be optimal, if large values are %concentrated around the main diagonal. Note also, that stress with Neumann neighborhood is related to the measure of effectiveness defined above (in Section~\ref{sec:ME}) since both measures are optimal if for each cell the cell and its four neighbors are numerically as similar as possible. \section{Seriation methods} \label{sec:methods} Solving the discrete optimization problem for seriation with most loss/merit functions is clearly very hard. The number of possible permutations for $n$ objects is $n!$ which makes an exhaustive search for sets with a medium to large number of objects infeasible. In this section, we describe some methods (partial enumeration, heuristics and other methods) which are typically used for seriation. For each method we state for which type of loss/merit functions it is suitable and whether it finds the optimum or is a heuristic. For the implementation of various seriation methods see function~\func{seriate} in Section~\ref{sec:infrastructure}. \subsection{Partial enumeration methods} Partial enumeration methods search for the exact solution of a combinatorial optimization problem. Exploiting properties of the search space, only a subset of the enormous number of possible combinations has to be evaluated. Popular partial enumeration methods which are used for seriation are \emph{dynamic programming}~\citep{seriation:Hubert:2001} and \emph{branch-and-bound}~\citep{seriation:Brusco:2005}. Dynamic programming recursively searches for the optimal solution checking and storing $2^n-1$ results. Although $2^n-1$ grows at a lower rate than $n!$ and is for $n \gg 3$ considerably smaller, the storage requirements of $2^n-1$ results still grow fast, limiting the maximal problem size severely. For example, for $n=30$ more than one billion results have to be calculated and stored, clearly a number too large for the main memory capacity of most current computers. Branch-and-bound has only very moderate storage requirements. The forward-branching procedure~\citep{seriation:Brusco:2005} starts to build partial permutations from left (first position) to right. At each step, it is checked if the permutation is valid and several fathoming tests are performed to check if the algorithm should continue with the partial permutation. The most important fathoming test is the boundary test, which checks if the partial permutation can possibly lead to a complete permutation with a better solution than the currently best one. In this way large parts of the search space can be omitted. However, in contrast to the dynamic programming approach, the reduction of search space is strongly data dependent and poorly structured data can lead to very poor performance. With branch-and-bound slightly larger problems can be solved than with dynamic programming in reasonable time. \cite{seriation:Brusco:2005} state that depending on the data, in some cases proximity matrices with 40 or more objects can be handled with current hardware. Partial enumeration methods can be used to find the exact solution independently of the loss/merit function. However, partial enumeration is limited to only relatively small problems. \subsection{Traveling salesperson problem solver} Seriation by minimizing the length of a Hamiltonian path through a graph is equal to solving a traveling salesperson problem. The traveling salesperson or salesman problem (TSP) is a well known and well researched combinatorial optimization problem~\citep[see, e.g.,][]{seriation:Gutin:2002}. The goal is to find the shortest tour that, starting from a given city, visits each city in a given list exactly once and then returns to the starting city. In graph theory a TSP tour is called a \emph{Hamiltonian cycle.} But for the seriation problem, we are looking for a Hamiltonian path. \cite{seriation:Garfinkel:1985} described a simple transformation of the TSP to find the shortest Hamiltonian path. An additional row and column of 0's is added (sometimes this is referred to as a \emph{dummy city}) to the original $n \times n$ dissimilarity matrix~$\mathbf{D}$. The solution of this $(n+1)$-city TSP, gives the shortest path where the city representing the added row/column cuts the cycle into a linear path. As the general seriation problem, solving the TSP is difficult. In the seriation case with $n+1$ cities, $n!$ tours have to be checked. However, despite this vast searching space, small instances can be solved efficiently using dynamic programming \citep{seriation:Held:1962} and larger instances of several hundred objects can be solved using \emph{branch-and-cut} algorithms~\citep{seriation:Padberg:1990}. For even larger instances or if running time is critical, a wide array of heuristics are available, ranging from simple nearest neighbor approaches to construct a tour~\citep{seriation:Rosenkrantz:1977} to complex heuristics like the Lin-Kernighan heuristic~\citep{seriation:Lin:1973}. A comprehensive overview of heuristics and exact methods can be found in \cite{seriation:Gutin:2002}. \subsection{Bond energy algorithm} The \emph{bond energy algorithm}~\citep[BEA;][]{seriation:McCormick:1972} is a simple heuristic to rearrange columns and rows of a matrix (two-way two-mode data) such that each entry is as closely numerically related to its four neighbors as possible. To achieve this, BEA tries to maximize the measure of effectiveness (ME) defined in Section~\ref{sec:ME}. For optimizing the ME, columns and rows can be treated separately since changing the order of rows does not influence the ME contributions of the columns and vice versa. BEA consists of the following three steps: \begin{enumerate} \item Place one randomly chosen column. \item Try to place each remaining column at each possible position left, right and between the already placed columns and calculate every time the increase in ME. Choose the column and position which gives the largest increase in ME and place the column. Repeat till all columns are placed. \item Repeat procedure with rows. \end{enumerate} This greedy algorithm works fast and only depends on the choice of the first column/row. This dependence can be reduced by repeating the procedure several times with different choices and returning the solution with the highest ME. Although \cite{seriation:McCormick:1972} use BEA also for non-binary data, \cite{seriation:Arabie:1990} argue that the measure of effectiveness only serves its intended purpose of finding an arrangement which is close to Robinson form for binary data and should therefore only be used for binary data. \cite{seriation:Lenstra:1974} notes that the optimization problem of BEA can be stated as two independent traveling salesperson problems (TSPs). For example, the row TSP for an $n \times m$ matrix~$\mathbf{X}$ consists of $n$ cities with an $n \times n$ distance matrix~$\mathbf{D}$ where the distances are \begin{displaymath} d_{ij} = -\sum_{k=1}^m x_{ik}x_{jk}. \end{displaymath} BEA is in fact a simple suboptimal TSP heuristic using this distances and instead of BEA any TSP solver can be used to obtain an order. With an exact TSP solver, the optimal solution can be found. \subsection{Hierarchical clustering} \label{sec:hierarchical_clustering} Hierarchical clustering produces a series of nested clusterings which can be visualized by a dendrogram, a tree where each internal node represents a split into subtrees and has a measure of similarity/dissimilarity attached to it. As a simple heuristic to find a linear order of objects, the order of the leaf nodes in a dendrogram structure can be used. This idea is used, e.g., by heat maps to reorder rows and columns with the aim to place more similar objects and variables closer together. %For hierarchical clustering several methods are available (e.g., %single linkage, average linkage, complete linkage, ward method) resulting in %different dendrograms. %However, The order of leaf nodes in a dendrogram is not unique. A binary (two-way splits only) dendrogram for $n$ objects has $2^{n-1}$ internal nodes and at each internal node the left and right subtree (or leaves) can be swapped resulting in $2^{n-1}$ distinct leaf orderings. To find a unique or optimal order, an additional criterion has to be defined. \cite{seriation:Gruvaeus:1972} suggest to obtain a unique order by requiring to order the leaf nodes such that at each level the objects at the edge of each cluster are adjacent to that object outside the cluster to which it is nearest. \cite{seriation:Bar-Joseph:2001} suggest to rearrange the dendrogram such that the Hamiltonian path connecting the leaves is minimized and called this the optimal leaf order. The authors also present a fast algorithm with time complexity $O(n^4)$ to solve this optimization problem. Note that this problem is related to the TSP described above, however, the given dendrogram structure significantly reduces the number of permissible permutations making the problem easier. Although hierarchical clustering solves an optimization problem different to the seriation problem discussed in this paper, hierarchical clustering still can produce useful orderings, e.g., for visualization. \subsection{Rank-two ellipse seriation} \cite{seriation:Chen:2002} proposes to generate a sequence of correlation matrices $R^1, R^2, \ldots$. $R^1$ is the correlation matrix of the original distance matrix $\mathbf{D}$ and \begin{equation} R^{n+1} = \phi R^n, \end{equation} where $\phi(\cdot)$ calculates a correlation matrix. \cite{seriation:Chen:2002} shows that the rank of the matrix $R^n$ falls with increasing $n$ and that if the sequence is continued till the first matrix in the sequence has a rank of 2, projecting all points in this matrix on its first two eigenvectors, all points will fall on an ellipse. \cite{seriation:Chen:2002} suggests to use the order of the points on this ellipse as a seriation where the ellipse can be cut at any of the two interception points (top or bottom) with the vertical axis. Although the rank-two ellipse seriation procedure does not try to solve a combinatorial optimization problem, it still provides for some cases a useful ordering. \subsection{Spectral Seriation} Spectral seriation uses a relaxation to minimize the 2-Sum Problem \citep{seriation:Barnard:1993}. Rewriting the minimization problem using a permutation vector $\pi$, its inverse, rescaling to $\mathrm{q}$ and using a Lagrangian multiplier for the constraint on the permutation yields \citep{seriation:Ding:2004} the following equivalent optimization problem: $$\mathrm{min}_\mathbf{q} \frac{\mathbf{q}^T L_\mathbf{S}\mathbf{q}}{\mathbf{q}^T\mathbf{q}}$$ where $L_\mathbf{S}$ is the Laplacian of $\mathbf{S}$. The optimal order can be recovered by the sorting order of the Fiedler vector (i.e., the second smallest eigenvector of the Laplacian of the similarity matrix). \subsection{Quadratic Assignment Problem} Both, the linear seriation criterion and the 2-Sum problem formulation can be written as a Quadratic Assignment Problem (QAP). However, the QAP is in general NP-hard. Methods include QIP, linearization, branch and bound and cutting planes as well as heuristics including Tabu search, simulated annealing, genetic algorithms, and ant systems \citep{seriation:Burkard:1998}. \section{The package infrastructure} \label{sec:infrastructure} The \pkg{seriation} package provides the data structures and some algorithms to efficiently handle seriation with \proglang{R}. As the input data for seriation \proglang{R} already provides \begin{itemize} \item for two-way one-mode data the class \code{dist}, \item for two-way two-mode data the class \code{matrix}, and \item for $k$-way $k$-mode data the class \code{array}. \end{itemize} \begin{figure}[tp] \centerline{ %\includegraphics[width=12cm]{infrastructure}} \includegraphics[width=10cm]{classes}} \caption{UML class diagram of the data structures for permutations provided by \pkg{seriation}} \label{fig:infrastructure} \end{figure} However, \proglang{R} provides no classes for representing permutation vectors. \pkg{seriation} adds the necessary data structure (using the S3 class system) as depicted in the UML class diagram \citep{seriation:Fowler:2004} in Figure~\ref{fig:infrastructure}. In this diagram classes are represented by rectangles and different symbols are used to state the type of relationship between the classes. The class \code{ser\_permutation} in Figure~\ref{fig:infrastructure} represents the permutation information for $k$-mode data (including the cases of $k=1$ and $k=2$). It consists of $k$ permutation vectors (class \code{ser\_permutation\_vector}). This relationship is represented by the solid diamond and the star above the connection between the two classes. Class \code{ser\_permutation\_vector} is defined \emph{abstract} and only its concrete implementations (classes connected with the triangle symbol) are used to store a permutation vector. This design with an abstract class was chosen to allow to use different representations for the permutation vectors. Currently, the permutation vector can be stored as a simple integer vector or as an object of class \code{hclust} (defined in package \pkg{stats}). \code{hclust} describes a hierarchical clustering tree (dendrogram) including an ordering for the tree's node leaves which provides a permutation for all objects (see Section~\ref{sec:hierarchical_clustering}). Class \code{ser\_permutation\_vector} has a constructor \func{ser\_permutation\_vector} which converts data into the correct concrete subclass of \code{ser\_permutation\_vector} and checks if it contains a proper permutation vector. For \code{ser\_permutation\_vector} the methods \func{print}, \func{length} for the length of the permutation vector, \func{get\_method} to get the method used to generate the permutation, and \func{get\_order} to access the raw (integer) permutation vector are available. To use an additional class to represent permutations as a concrete subclass of \code{ser\_permutation\_vector} only an appropriate accessor method \func{get\_order} has to be implemented for the new class. For \code{ser\_permutation} a constructor is provided which can bind $k$ \code{ser\_permutation\_vector} objects together into an object for $k$-mode data. \code{ser\_permutation} is implemented as a list of length~$k$ and each element contains a \code{ser\_permutation\_vector} object. Methods like \func{length}, accessing elements with \code{[[}, % ]] \code{[[<-}, % ]] subsetting with \code{[}, and combining with \func{c} work as expected. Also a \func{print} method is provided. Finally, direct access to the raw permutation vectors is available using \func{get\_order}. Here a second argument (which defaults to $1$) specifies the dimension (mode) for which the order vector is requested. All seriation algorithms are available via the function \func{seriate} defined as: \begin{quotation} \code{seriate(x, method = NULL, control = NULL, ...)} \end{quotation} where \code{x} is the input data, \code{method} is a string defining the seriation method to be used and \code{control} can contain a list with additional information for the algorithm. \func{seriate} returns an object of class \code{ser\_permutation} with a length conforming to the number of dimensions of~\code{x}. Typical input data are a dissimilarity matrix (class~\code{dist}; see package \pkg{stats} for more information) for one-mode two-way data, \code{matrix} for two-mode two-way data and \code{array} for $k$-mode $k$-way data. For \code{matrix} and \code{array} the additional argument \code{margin} can be used to restrict the dimensions which should be seriated (e.g., with \code{margin = 1} only the first dimension, i.e., the columns of a matrix, are seriated). %\begin{landscape} \begin{table}[tp] \centering \begin{tabular}{p{5cm}p{3cm}p{4cm}l} \hline Algorithm & \code{method} & Optimizes & Input data \\ \hline Simulated annealing & \code{"ARSA"} & Linear seriation crit.&\code{dist} \\ Branch-and-bound & \code{"BBURCG"} & Gradient measure &\code{dist} \\ Branch-and-bound & \code{"BBWRCG"} & Gradient measure (weighted)& \code{dist} \\ TSP solver & \code{"TSP"} & Hamiltonian path length& \code{dist} \\ Optimal leaf ordering & \code{"OLO"} \code{"OLO_single"} \code{"OLO_average"} \code{"OLO_complete"} & Hamiltonian path length (restricted)& \code{dist} \\ Gruvaeus and Wainer & \code{"GW"} \code{"GW_single"} \code{"GW_average"} \code{"GW_complete"} & Hamiltonian path length (restricted) & \code{dist} \\ MDS & \code{"MDS"} \code{"MDS_metric"} \code{"MDS_nonmetric"} \code{"MDS_angle"} & Least square crit.& \code{dist} \\ Spectral seriation & \code{"Spectral"} \code{"Spectral_norm"} & 2-Sum crit. & \code{dist} \\ QAP & \code{"QAP_2SUM"} & 2-Sum crit. & \code{dist} \\ & \code{"QAP_LS"} & Linear seriation crit. & \code{dist} \\ & \code{"QAP_BAR"} & Banded AR form & \code{dist} \\ & \code{"QAP_Inertia"} & Inertia crit. & \code{dist} \\ Genetic Algorithm & \code{"GA"}* & various & \code{dist} \\ DendSer & \code{"DendSer"}* & various & \code{dist} \\ Hierarchical clustering & \code{"HC"} \code{"HC_single"} \code{"HC_average"} \code{"HC_complete"} & Other& \code{dist} \\ Rank-two ellipse seriation & \code{"R2E"} & Other& \code{dist} \\ Sorting Points Into Neighborhoods & \code{"SPIN_NH"} \code{"SPIN_STS"} & Other& \code{dist} \\ Visual Assessment of (Clustering) Tendency & \code{"VAT"}& Other& \code{dist} \\ \hline Bond Energy Algorithm & \code{"BEA"} & Measure of effectiveness & \code{matrix} \\ TSP to optimize ME & \code{"BEA\_TSP"} & Measure of effectiveness& \code{matrix} \\ Principal component analysis& \code{"PCA"} \code{"PCA_angle"}& Least square crit.& \code{matrix} \\ \hline \end{tabular} \caption{Currently implemented methods for \func{seriation} (* methods need to be registered).} \label{tab:methods} \end{table} %\end{landscape} Various seriation methods were already introduced in this paper in Section~\ref{sec:methods}. In Table~\ref{tab:methods} we summarize the methods currently available in the package for seriation. The code for the simulated annealing heuristic~\citep{seriation:Brusco:2007} and the two branch-and-bound implementations~\citep{seriation:Brusco:2005} was obtained from the authors. The TSP solvers (exact solvers and a variety of heuristics) is provided by package \pkg{TSP}~\citep{seriation:Hahsler:2007, seriation:Hahsler:2007b}. For optimal leaf ordering we implemented the algorithm by~\cite{seriation:Bar-Joseph:2001}. The BEA code was kindly provided by Fionn Murtagh. For the Gruvaeus and Wainer algorithm, the implementation in package \pkg{gclus}~\citep{seriation:Hurley:2007} is used. For the rank-two ellipse seriation we implemented the algorithm by~\cite{seriation:Chen:2002}. Spectral seriation is described by~\cite{seriation:Ding:2004}. Note that some methods implemented (e.g., the rank-two ellipse seriation) do not fall within the combinatorial optimization framework of this paper and thus are not dealt with here in detail. They are included in the package since they can be useful for various applications. A detailed empirical comparison of seriation methods and criteria can be found in the study by \cite{hahsler:Hahsler2016d}. %Over time more methods will be %added to the package. To calculate the value of a loss/merit function for data and a certain permutation, the function \begin{quotation} \code{criterion(x, order = NULL, method = NULL, ...)} \end{quotation} is provided. \code{x} is the data object, \code{order} contains a suitable object of class \code{ser\_permutation} (if omitted no permutation is performed) and \code{method} specifies the type of loss/merit function. A vector of several methods can be used resulting in a named vector with the values of the requested functions. If \code{method} is omitted (\code{method = NULL}), the values for all applicable loss/merit functions are calculated and returned. We already defined different loss/merit functions for seriation in Section~\ref{sec:seriation}. In Table~\ref{tab:criteria} we indicate the loss/merit functions currently available in the package. \begin{table}[t] \centering \begin{tabular}{llll} \hline Name & \code{method} & merit/loss & Input data \\ \hline Anti-Robinson events& \code{"AR\_events"} & loss & \code{dist} \\ Anti-Robinson deviations& \code{"AR\_deviations"} & loss & \code{dist} \\ Banded Anti-Robinson& \code{"BAR"} & loss & \code{dist} \\ Gradient measure& \code{"Gradient\_raw"} & merit & \code{dist} \\ Gradient measure (weighted)& \code{"Gradient\_weighted"} & merit & \code{dist} \\ Hamiltonian path length & \code{"Path\_length"} & loss & \code{dist} \\ Inertia criterion& \code{"Inertia"} & merit & \code{dist} \\ Least squares criterion& \code{"Least\_squares"} & loss & \code{dist} \\ Linear Seriation criterion& \code{"LS"} & loss & \code{dist} \\ 2-Sum criterion& \code{"2SUM"} & loss & \code{dist} \\ \hline Measure of effectiveness& \code{"ME"} & merit & \code{matrix} \\ Stress (Moore neighborhood)& \code{"Moore\_stress"} & loss & \code{matrix} \\ Stress (Neumann neighborhood)& \code{"Neumann\_stress"} & loss & \code{matrix} \\ \hline \end{tabular} \caption{Implemented loss/merit functions in function \func{criterion}.} \label{tab:criteria} \end{table} All methods for \func{seriate} and \func{criterion} are managed by a registry mechanism which makes the seriation framework easily extensible for users. For example, a new seriation method can be registered using \func{set\_seriation\_method} and then used in the same way as the built-in methods with \func{seriate}. All available methods in the registry can be viewed using \func{list\_seriation\_methods} and \func{show\_seriation\_methods}. For criterion methods, the same interface is available by just substituting `seriation' by `criterion' in the function names. An example for how to add new methods can be found in section~\ref{sec:registering} of this paper. In addition the package offers the (generic) function \begin{quotation} \code{permute(x, order)} \end{quotation} where \code{x} is the data (a \code{dist} object, a matrix, an array, a list or a numeric vector) to be reordered and \code{order} is a \code{ser\_permutation} object of suitable length. %The permutation for %\code{dist} objects uses package \pkg{proxy}~\citep{seriation:Meyer:2007}. For visualization, the package offers several options: \begin{itemize} \item Matrix shading with \func{pimage}. In contrast to the standard \func{image} in package~\pkg{graphics}, \func{pimage} displays the matrix as is with the first element in the top left-hand corner and using a gamma-corrected gray scale. \item Different heat maps (e.g., with optimally reordered dendrograms) with \func{hmap}. \item Visualization of data matrices in the spirit of~\cite{seriation:Bertin:1981} with \func{bertinplot}. \item \emph{Dissimilarity plot}, a new visualization to judge the quality of a clustering using matrix shading and seriation with \func{dissplot}. \end{itemize} We will introduce the package usage and the visualization options in the examples in the next section. \section{Examples and applications} \label{sec:example} We start this section with a simple first session to demonstrate the basic usage of the package. Then we present and discuss several seriation applications. \subsection{A first session using seriation} In the following example, we use the well known iris data set (from \proglang{R}'s \pkg{datasets} package) which gives the measurements in centimeters of the variables sepal length and width and petal length and width, respectively, for 50 flowers from each of 3 species of the iris family (Iris Setosa, Versicolor and Virginica). First, we load the package \pkg{seriation} and the iris data set. We remove the species classification and reorder the objects randomly since they are already sorted by species in the data set. Then we calculate the Euclidean distances between objects. <>= set.seed(1234) @ <<>>= library("seriation") data("iris") x <- as.matrix(iris[-5]) x <- x[sample(seq_len(nrow(x))),] d <- dist(x) @ To seriate the objects given the dissimilarities, we just call \func{seriate} with the default settings. <<>>= o <- seriate(d) o @ The result is an object of class \code{ser\_permutation} for one-mode data. The permutation vector length is $150$ for the $150$ objects in the iris data set and the used seriation method is \code{"ARSA"}, a simulated annealing heuristic (see~Table~\ref{tab:methods}). The actual order can be accessed using \func{get\_order}. In the following we show the first 15 elements in the permutation vector. <<>>= head(get_order(o), 15) @ To visually inspect the effect of seriation on the distance matrix, we use matrix shading with \func{pimage} (the result is shown in Figure~\ref{fig:pimage1}). <>= pimage(d, main = "Random") @ <>= pimage(d, o, main = "Reordered") @ \begin{figure} \centering \includegraphics[width=7.5cm]{seriation-pimage1} \includegraphics[width=7.5cm]{seriation-pimage1-2} \caption{Matrix shading of the distance matrix for the iris data.} \label{fig:pimage1} \end{figure} We can also compare the improvement for different loss/merit functions using \func{criterion}. <<>>= cbind(random = criterion(d), reordered = criterion(d, o)) @ Naturally, the reordered dissimilarity matrix achieves better values for all criteria. Note that the gradient measures, inertia and the measure of effectiveness are merit functions and for these measures larger values are better (use \code{show\_criterion\_methods("dist")} to find out which measures are loss and merit functions). To visually compare the original data matrix and the result of seriation, we can also use \func{pimage}. We standardize the data using scale such that the visualized value is the number of standard deviations an object differs from the variable mean. For matrices containing negative values, \code{pimage} uses automatically a divergent palette. After using \func{pimage} for the original random data matrix, we create a suitable \code{ser\_permutation} object for the original two-mode data. Since the seriation above only produced an order for the rows of the data, we add an identity permutation vector for the columns (represented by \code{NA}) to the permutations object using the combine function \func{c}. This new permutation object for $2$-mode data is used for displaying the reordered scaled data. The two plots are shown in Figure~\ref{fig:pimage2}. <>= pimage(scale(x), main = "Random", prop = FALSE) @ <>= o_2mode <- c(o, NA) pimage(scale(x), o_2mode, main = "Reordered", prop = FALSE) @ \begin{figure} \centering \includegraphics[width=7.5cm]{seriation-pimage2} \includegraphics[width=7.5cm]{seriation-pimage2-2} \caption{Matrix shading of the iris data matrix.} \label{fig:pimage2} \end{figure} \subsection{Comparing different seriation methods} To compare different seriation methods we use again the randomized iris data set and the distance matrix \code{d} from the previous example. We include in the comparison several seriation methods for dissimilarity matrices described in Section~\ref{sec:methods}. <<>>= methods <- c("TSP","R2E", "ARSA", "HC", "GW", "OLO") o <- sapply(methods, FUN = function(m) seriate(d, m)) @ <>= timing <- sapply(methods, FUN = function(m) system.time(seriate(d, m)), simplify = FALSE) @ \begin{table} \centering \begin{tabular}{lcccccc} \hline Seriation Method & \Sexpr{methods[1]}& \Sexpr{methods[2]}& \Sexpr{methods[3]}& \Sexpr{methods[4]}& \Sexpr{methods[5]}& \Sexpr{methods[6]} \\ \hline Execution time [sec] & \Sexpr{round(timing[[methods[1]]][1],4)}& \Sexpr{round(timing[[methods[2]]][1],4)}& \Sexpr{round(timing[[methods[3]]][1],4)}& \Sexpr{round(timing[[methods[4]]][1],4)}& \Sexpr{round(timing[[methods[5]]][1],4)}& \Sexpr{round(timing[[methods[6]]][1],4)}\\ \hline \end{tabular} %%% fix me: for the vignette we need something else \caption{Execution time of seriation of the iris data set for different methods.} \label{tab:timings} \end{table} Table~\ref{tab:timings} contains the execution times for running seriation with the different methods. Except for the simulated annealing method (ARSA) the seriation only takes a fraction of a second. The direction of the resulting orderings is first normalized (aligned) and then the orderings are displayed using matrix shading (see Figure~\ref{fig:pimage3}). <>= o <- ser_align(o) for(s in o) pimage(d, s, main = get_method(s), key = FALSE) @ <>= o <- ser_align(o) for(i in 1:length(o)) { pdf(file=paste("seriation-pimage_comp_", i , ".pdf", sep="")) pimage(d, o[[i]], main = get_method(o[[i]]), key = FALSE) dev.off() } @ \begin{figure} \centering \includegraphics[width=.3\linewidth]{seriation-pimage_comp_1.pdf} \includegraphics[width=.3\linewidth]{seriation-pimage_comp_2.pdf} \includegraphics[width=.3\linewidth]{seriation-pimage_comp_3.pdf}\\ \includegraphics[width=.3\linewidth]{seriation-pimage_comp_4.pdf} \includegraphics[width=.3\linewidth]{seriation-pimage_comp_5.pdf} \includegraphics[width=.3\linewidth]{seriation-pimage_comp_6.pdf} \caption{Image plot of the distance matrix for the iris data using rearrangement by different seriation methods.} \label{fig:pimage3} \end{figure} The first row of matrices in Figure~\ref{fig:pimage3} contains the orders obtained by a TSP solver the rank-two ellipse seriation by Chen and using the simulated annealing method (ARSA). The results of Chen and ARSA are very similar (except that the order is reversed). The TSP solver produces a smoother image with some lighter lines visible. The reason for these lines is that the TSP only optimizes distances locally between two neighboring objects. Therefore it is possible that in a quite homogeneous block several objects are enclosed gradually getting more different and then getting more similar again (see, e.g., the light line close to the upper left corner of the TSP image in Figure~\ref{fig:pimage3}). The second row of Figure~\ref{fig:pimage3} contains three images based on hierarchical clustering. The visual impression gets better from left (just hierarchical clustering) to right (first using the Gruvaeus Wainer heuristic and then optimal leaf ordering to rearrange the branches of the dendrogram obtained by hierarchical clustering). The most striking feature in the image for hierarchical clustering (HC in Figure~\ref{fig:pimage3}) is the distinct cross going right through the center of the plot. This indicates that several relatively dissimilar objects are caught in an otherwise homogeneous block. This effect vanishes after rearranging the dendrogram branches (see GW and OLO in Figure~\ref{fig:pimage3}). %' To investigate this effect, %' we plot the dendrogram obtained by hierarchical clustering which is used %' to order the objects and compare it to the dendrogram rearranged %' using the Gruvaeus Wainer heuristic. %' %' <>= %' plot(o[["HC"]], labels = FALSE, main = "Dendrogram HC") %' plot(o[["GW"]], labels = FALSE, main = "Dendrogram GW") %' @ %' <>= %' def.par <- par(no.readonly = TRUE) %' pdf(file="seriation-pimage3_dendrogram.pdf", width=9, height=4) %' layout(t(1:2)) %' plot(o[["HC"]], labels = FALSE, main = "Dendrogram HC") %' symbols(74.7,.5, rect = matrix(c(4, 3), ncol=2), add= TRUE, %' inches = FALSE, lwd =2) %' %' plot(o[["GW"]], labels = FALSE, main = "Dendrogram GW") %' symbols(98.7,.5, rect = matrix(c(4, 3), ncol=2), add= TRUE, %' inches = FALSE, lwd =2) %' par(def.par) %' tmp <- dev.off() %' @ %' %' \begin{figure} %' \centering %' \includegraphics[width=\linewidth, trim=0 80 0 0, clip=TRUE]{seriation-pimage3_dendrogram} %' \caption{Dendrograms for the seriation with HC and GW.} %' \label{fig:pimage3_dendrogram} %' \end{figure} %' %' Comparing the two dendrograms in Figure~\ref{fig:pimage3_dendrogram}, we see %' that the branch left from the top is almost unchanged. The branch which is %' responsible for the light cross in the shaded image is highlighted by a box. %' The Gruvaeus Wainer heuristic rotates the highlighted branch towards the right %' since the objects in it are more similar to the objects in there. Finally, we compare the values of the loss/merit functions for the different seriation methods. <<>>= crit <- sapply(o, FUN = function(x) criterion(d, x)) t(crit) @ <>= def.par <- par(no.readonly = TRUE) m <- c("Path_length", "AR_events", "Moore_stress") layout(matrix(seq_along(m), ncol=1)) #tmp <- apply(crit[m,], 1, dotchart, sub = m) tmp <- lapply(m, FUN = function(i) dotchart(crit[i,], sub = i)) par(def.par) @ \begin{figure} \centering \includegraphics[width=14cm]{seriation-crit1} \caption{Comparison of different methods and seriation criteria} \label{fig:crit1} \end{figure} For easier comparison, Figure~\ref{fig:crit1} contains a plot of the criteria Hamiltonian path length, anti-Robinson events (\code{AR\_events}) and stress using the Moore neighborhood. Clearly, the methods which directly try to minimize the Hamiltonian path length (hierarchical clustering with optimal leaf ordering (\code{OLO}) and the TSP heuristic) provide the best results concerning the path length. For the number of anti-Robinson events, using the simulated annealing heuristic (\code{ARSA}) provides the best result. Regarding stress, the simulated annealing heuristic also provides the best result although, it does not directly minimize this loss function. \subsection{Registering new methods} \label{sec:registering} New methods to calculate criterion values and to compute a seriation can be easily added by the user via the method registry mechanism provided in \pkg{seriation}. Here we give a simple example of how to implement and register a new seriation method. In the registry we distinguish between methods for different types of input data. With the following two commands we produce a list of the available seriation methods for input data of class \code{dist} and \code{matrix}. <<>>= list_seriation_methods("dist") list_seriation_methods("matrix") @ To get detailed information on a seriation method use the following. <<>>= get_seriation_method("dist", name = "ARSA") @ To add a new seriation method, we first have to implement the seriation code as a function with the two formal arguments \code{x} and \code{control}, and for arrays also an additional argument \code{margin}. \code{x} is the data object and \code{control} contains a list with additional information for the method passed on from \func{seriate}. The function has to return a list of objects which can be coerced into \code{ser\_permutation\_vector} objects (e.g., a list of integer vectors). The elements in the list have to be in order corresponding to the dimensions of \code{x}. In this example we just create a method to return a permutation which reverses the original order of the objects, i.e., which returns the reverse identity order. <<>>= seriation_method_reverse <- function(x, control = NULL, margin = seq_along(dim(x))) { lapply(seq_along(dim(x)), function(i) if (i %in% margin) rev(seq(dim(x)[i])) else NA) } @ The function produces integer sequences of the correct lengths, one for each dimension of \code{x} (\code{control} is not used). Since the function works for \code{matrix} and \code{array} we can register it for both data types under the short name `Reverse'. <<>>= set_seriation_method("matrix", "New_Reverse", seriation_method_reverse, "Reverse identity order") set_seriation_method("array", "New_Reverse", seriation_method_reverse, "Reverse identity order") @ Now the new seriation method is registered and can be found by the user and applied to data. <<>>= list_seriation_methods("matrix") o <- seriate(matrix(1, ncol = 3, nrow = 4), "New_Reverse") o get_order(o, 1) get_order(o, 2) @ Criterion methods can be added in the same way. We refer the interested reader to the documentation accompanying the package for detailed information and an example. If you have implemented a new criterion or seriation method, please consider submitting the code to one of the maintainers of \pkg{seriation} for inclusion in a future release of the package. \subsection{Heat maps} A heat map is a shaded/color coded data matrix with a dendrogram added to one side and to the top to indicate the order of rows and columns. Typically, reordering is done according to row or column means within the restrictions imposed by the dendrogram. Heat maps recently became popular for visualizing large scale genome expression data obtained via DNA microarray technology \citep[see, e.g.,][]{seriation:Eisen:1998}. From Section~\ref{sec:hierarchical_clustering} we know that it is possible to find the optimal ordering of the leaf nodes of a dendrogram which minimizes the distances between adjacent objects in reasonable time. Such an order might provide an improvement over using simple reordering such as the row or column means with respect to presentation. In \pkg{seriation} we provide the function \func{hmap} which uses optimal ordering and can also use seriation directly on distance matrices without using hierarchical clustering to produce dendrograms first. For the following example, we use again the randomly reordered iris data set \code{x} from the examples above. To make the variables (columns) comparable, we use standard scaling. <<>>= x <- scale(x, center = FALSE) @ To produce a heat map with optimally reordered dendrograms (using by default Optimal Leaf Ordering), the function \func{hmap} can be used with its default settings. <>= hmap(x, margin = c(7, 4), cexCol = 1, row_labels = FALSE) @ With these settings, the Euclidean distances between rows and between columns are calculated (with \func{dist}), hierarchical clustering (\func{hclust}) is performed, the resulting dendrograms are optimally reordered, and \func{heatmap.2} in package \pkg{gplots} is used for plotting (see Figure~\ref{fig:heatmap}(a) for the resulting plot). <>= hmap(x, method = "MDS") @ If a seriation method is used that does not depend on dendrograms, instead of hierarchical clustering, seriation on the dissimilarity matrices for rows and columns is performed and the reordered matrix with the reordered dissimilarity matrices to the left and on top is displayed (see Figure~\ref{fig:heatmap}(b)). A \code{method} argument can be used to choose different seriation methods. <>= #bitmap(file = "seriation-heatmap1.png", type = "pnggray", # height = 6, width = 6, res = 300, pointsize=14) pdf(file = "seriation-heatmap1.pdf") hmap(x, margin = c(7, 4), row_labels = FALSE, cexCol = 1) tmp <- dev.off() @ <>= pdf(file = "seriation-heatmap2.pdf") hmap(x, method="MDS") tmp <- dev.off() @ \begin{figure} \begin{minipage}[b]{.48\linewidth} \centering \includegraphics[width=\linewidth]{seriation-heatmap1} \\ (a) \end{minipage} \begin{minipage}[b]{.48\linewidth} \centering \includegraphics[width=\linewidth]{seriation-heatmap2} \\ (b) \end{minipage} \caption{Two presentations of the rearranged iris data matrix. (a) as an optimally reordered heat map and (b) as a seriated data matrix with reordered dissimilarity matrices to the left and on top.} \label{fig:heatmap} \end{figure} \subsection{Bertin's permutation matrix} \cite{seriation:Bertin:1981,seriation:Bertin:1999} introduced permutation matrices to analyze multivariate data with medium to low sample size. The idea is to reveal a more homogeneous structure in a data matrix~$\mathbf{X}$ by simultaneously rearranging rows and columns. The rearranged matrix is displayed and cases and variables can be grouped manually to gain a better understanding of the data. %To quantify homogeneity, a purity function %\begin{displaymath} % \phi = \Phi(\mathbf{X}) %\end{displaymath} %is defined. Let $\Pi$ be the set of all permutation functions %$\pi$ for matrix $\mathbf{X}$. %Note that function $\pi$ performs row and column permutations on a matrix. %The optimal permutation with respect to %purity can be found by %\begin{displaymath} % \pi^* = \argmax\nolimits_{\pi \in \Pi} \Phi(\pi(\mathbf{X})). %\end{displaymath} %Since, depending on the purity function, finding the optimal %solution can be hard, often a near optimal solution is also acceptable %for visualization. % %A possible purity function $\Phi$ is: %Given distances between rows and columns of the data matrix, define purity as %the sum of distances of adjacent rows/columns. Using this purity function, %finding the optimal permutation $\pi^*$ means solving two (independent) TSPs, %one for the columns and one for the rows. To find a rearrangement of columns and rows which reveals structure a purity function is used. A possible purity function is: Given distances between rows and columns of the data matrix, define purity as the sum of distances of adjacent rows/columns. Using this purity function, finding the optimal permutation means solving two (independent) TSPs, one for the columns and one for the rows which can be done very conveniently using the infrastructure provided by \pkg{seriation}. As an example, we use the results of $8$ constitutional referenda for $41$ Irish communities~\citep{seriation:Falguerolles:1997}\footnote{The Irish data set is included in this package. The original data and the text of the referenda can be obtained from~\url{http://www.electionsireland.org/}}. To make values comparable across columns (variables), the ranks of the values for each variable are used instead of the original values. <<>>= data("Irish") orig_matrix <- apply(Irish[,-6], 2, rank) @ For seriation, we calculate distances between rows and between columns using the sum of absolute rank differences (this is equal to the Minkowski distance with power $1$). Then we apply seriation (using a TSP heuristic) to both distance matrices and combine the two resulting \code{ser\_permutation} objects into one object for two-mode data. The original and the reordered matrix are plotted using \func{bertinplot}. <<>>= o <- c( seriate(dist(orig_matrix, "minkowski", p = 1), method = "TSP"), seriate(dist(t(orig_matrix), "minkowski", p = 1), method = "TSP") ) o @ In a newer version of the package this can be also done with the new heatmap seriation method for matrices. <<>>= get_seriation_method("matrix", name = "heatmap") o <- seriate(orig_matrix, method = "heatmap", dist_fun = function(d) dist(d, "minkowski", p = 1), seriation_method = "TSP") o @ <>= bertinplot(orig_matrix) bertinplot(orig_matrix, o) @ <>= bertinplot(orig_matrix) @ <>= bertinplot(orig_matrix, o) @ \begin{figure} \centering \includegraphics[width=15cm, trim=60 60 0 0]{seriation-bertin1} \\ (a) \includegraphics[width=15cm, trim=60 60 0 0]{seriation-bertin2} \\ (b) \caption{Bertin plot for the (a) original arrangement and the (b) reordered Irish data set.} \label{fig:bertin} \end{figure} The original matrix and the rearranged matrix are shown in Figure~\ref{fig:bertin} as a matrix of bars where high values are highlighted (filled blocks). Note that following Bertin, the cases (communities) are displayed as the columns and the variables (referenda) as rows. Depending on the number of cases and variables, columns and rows can be exchanged to obtain a better visualization. Although the columns are already ordered (communities in the same city appear consecutively) in the original data matrix in Figure~\ref{fig:bertin}(a), it takes some effort to find structure in the data. For example, it seems that the variables `Marriage', `Divorce', `Right to Travel' and `Right to Information' are correlated since the values are all high in the block made up by the columns of the communities in Dublin. The reordered matrix confirms this but makes the structure much more apparent. Especially the contribution of low values (which are not highlighted) to the overall structure becomes only visible after rearrangement. \subsection{Binary data matrices} Binary or $0$-$1$ data matrices are quite common. Often such matrices are called \emph{incidence matrices} since a $1$ in a cell indicates the incidence of an event. In archaeology such an event could be that a special type of artifact was found at a certain archaeological site. This can be seen as a simplification of a so-called \emph{abundance matrix} which codes in each cell the (relative) frequency or quantity of an artifact type at a site. See \cite{seriation:Ihm:2005} for a comparison of incidence and abundance matrices in archaeology. Here we are interested in binary data. For the example we use an artificial data set from~\cite{seriation:Bertin:1981} called \emph{Townships}. The data set contains $9$ binary characteristics (e.g., has a veterinary or has a high school) for $16$ townships. The idea of the data set is that townships evolve from a rural to an urban environment over time. After loading the data set (which comes with the package), we use \func{bertinplot} to visualize the data (\func{pimage} could also be used but \func{bertinplot} allows for a nicer visualization). Bars, the standard visualization of \func{bertinplot}, do not make much sense for binary data. We therefore use the panel function \func{panel.squares} without spacing to plot black squares. <>= data("Townships") bertinplot(Townships, panel = panel.tiles) @ The original data in Figure~\ref{fig:binary}(a) does not reveal structure in the data. To improve the display, we run the bond energy algorithm (BEA) for columns and rows $10$ times with random starting points and report the best solution. <>= ## to get consistent results set.seed(10) @ <>= o <- seriate_rep(Townships, method = "BEA", criterion = "ME", rep = 10) bertinplot(Townships, o, panel = panel.tiles) @ The reordered matrix is displayed in Figure~\ref{fig:binary}(b). A clear structure is visible. The variables (rows in a Bertin plot) can be split into the three categories describing different evolution states of townships: \begin{enumerate} \item Rural: No doctor, one-room school and possibly also no water supply \item Intermediate: Land reallocation, veterinary and agricultural cooperative \item Urban: Railway station, high school and police station \end{enumerate} The townships also clearly fall into these three groups which tentatively can be called villages (first~$7$), towns (next~5) and cities (final~2). The townships B and C are on the transition to the next higher group. \begin{figure} \centering \includegraphics[width=12cm, trim=0 40 0 30]{seriation-binary1} \\ (a) \includegraphics[width=12cm, trim=0 40 0 30]{seriation-binary2} \\ (b) \caption{The townships data set in original order (a) and reordered using BEA (b).} \label{fig:binary} \end{figure} <<>>= rbind( original = criterion(Townships), reordered = criterion(Townships, o) ) @ BEA tries to maximize the measure of effectiveness which is much higher in the reordered matrix (in fact, 65 is the maximum for the data set). Also the two types of stress are improved significantly. \subsection{Dissimilarity plot} Assessing the quality of an obtained cluster solution has been a research topic since the invention of cluster analysis. This is especially important since all popular cluster algorithms produce a clustering even for data without a ``cluster'' structure. %A method to judge the quality of a cluster solution is by inspecting a %visualization. For hierarchical clustering %dendrogramms~\cite{seriation:Hartigan:1967} are available which show the %hierarchical structure of the clustering as a binary tree and cluster quality %can be judged by looking at the dissimilarities between objects in a cluster %and objects in other clusters. However, such a visualization is %only possible for heirarchical/nested clusterings. % %\marginpar{Cite Pison et al 1999 and Kaufmann and Rousseeuw} %For the an arbitrary partitional clustering, the original objects can %be displayed in a 2 dimensional scatter plot %after using dimensionality reduction (e.g., PCA, MDS). %Objects belonging to the same cluster can be marked and thus, if the %dimensionality reduction preserves a large proportion of the %variavility in the original data, the separation between clusters can be %visually judged. % %Silhouettes Matrix shading is an old technique to visualize clusterings by displaying the rearranged matrices~\citep[see, e.g.,][]{seriation:Sneath:1973,seriation:Ling:1973,seriation:Gale:1984}. Initially matrix shading was used in connection with hierarchical clustering, where the order of the dendrogram leaf nodes was used to arrange the matrix. However, with some extensions, matrix shading can also be used with any partitional clustering method. \cite{seriation:Strehl:2003} suggest a matrix shading visualization called \emph{CLUSION} where the dissimilarity matrix is arranged such that all objects pertaining to a single cluster appear in consecutive order in the matrix. The authors call this \emph{coarse seriation}. The result of a ``good'' clustering should be a matrix with low dissimilarity values forming blocks around the main diagonal. However, using coarse seriation, the order of the clusters has to be predefined and the objects within each cluster are unordered. The dissimilarity plots implemented by the function \func{dissplot} in \pkg{seriation} improve \emph{CLUSION} using seriation methods. It aims at visualizing global structure (similarity between different clusters is reflected by their position relative to each other) as well as the micro structure within each cluster (position of objects). To position the clusters in the dissimilarity plot, an inter-cluster dissimilarity matrix is calculated using the average between cluster dissimilarities. \func{seriate} is used on this inter-cluster dissimilarity matrix to arrange the clusters relative to each other resulting in on average more similar clusters to appear closer together in the plot. Within each cluster, \func{seriate} is used again on the sub-matrix of the dissimilarity matrix concerning only the objects in the cluster. For the example, we use again Euclidean distance between the objects in the iris data set. <<>>= data("iris") iris <- iris[sample(seq_len(nrow(iris))), ] x_iris <- iris[, -5] d_iris <- dist(x_iris, method = "euclidean") @ First, we use \func{dissplot} without a clustering. We set \code{method} to \code{NA} to prevent reordering and display the original matrix (see Figure~\ref{fig:dissplot1}(a)). Then we omit the method argument which results in using the default seriation technique from \func{seriate}. Since we did not provide a clustering, the whole matrix is reordered in one piece. From the result shown in Figure~\ref{fig:dissplot1}(b) it seems that there is a clear structure in the data which suggests a two cluster solution. <>= ## plot original matrix dissplot(d_iris, method = NA) @ <>= ## plot reordered matrix dissplot(d_iris, main = "Dissimilarity plot with seriation") @ <>= pdf(file = "seriation-dissplot1.pdf") <> tmp <- dev.off() pdf(file = "seriation-dissplot2.pdf") <> tmp <- dev.off() @ \begin{figure} \begin{minipage}[b]{.48\linewidth} \centering \includegraphics[width=\linewidth]{seriation-dissplot1} \\ (a) \end{minipage} \begin{minipage}[b]{.48\linewidth} \centering \includegraphics[width=\linewidth]{seriation-dissplot2} \\ (b) \end{minipage} \caption{Two dissimilarity plots. (a) the original dissimilarity matrix and (b) the seriated dissimilarity matrix.} \label{fig:dissplot1} \end{figure} Next, we create a cluster solution using the $k$-means algorithm. Although we know that the data set should contain $3$ groups representing the three species of iris, we let $k$-means produce a $10$ cluster solution to study how such a misspecification can be spotted using \func{dissplot}. <>= set.seed(1234) @ <<>>= l <- kmeans(x_iris, 10)$cluster #$ @ We create a standard dissimilarity plot by providing the cluster solution as a vector of labels. The function rearranges the matrix and plots the result. Since rearrangement can be a time consuming procedure for large matrices, the rearranged matrix and all information needed for plotting is returned as the result. <>= res <- dissplot(d_iris, labels = l, main = "Dissimilarity plot - standard") @ <>= pdf(file = "seriation-dissplot3.pdf") ## visualize the clustering <> tmp <- dev.off() pdf(file = "seriation-dissplot4.pdf") ## threshold plot(res, main = "Dissimilarity plot - threshold", threshold = 3) tmp <- dev.off() @ \begin{figure} \centering \includegraphics[width=10cm]{seriation-dissplot3}\\ (a) \includegraphics[width=10cm]{seriation-dissplot4}\\ (b) \caption{Dissimilarity plot for $k$-means solution with 10 clusters. (a) standard plot and (b) plot with threshold.} \label{fig:dissplot3} \end{figure} <<>>= res @ The resulting plot is shown in Figure~\ref{fig:dissplot3}(a). The inter-cluster dissimilarities are shown as solid gray blocks and the average object dissimilarity within each cluster as gray triangles below the main diagonal of the matrix. Since the clusters are arranged such that more similar clusters are closer together, it is easy to see in Figure~\ref{fig:dissplot3}(a) that clusters 6, 3 and 1 as well as clusters 10, 9, 5, 7, 8, 4 and 2 are very similar and form two blocks. This suggests again that a two cluster solution would be reasonable. Since slight variations of gray values are hard to distinguish, we plot the matrix again (using \func{plot} on the result above) and use a threshold on the dissimilarity to suppress high dissimilarity values in the plot. <>= plot(res, options = list(main = "Seriation - threshold", threshold = 3)) @ In the resulting plot in Figure~\ref{fig:dissplot3}(b), we see that the block containing 10, 9, 5, 7, 8, 4 and 2 is very well defined and cleanly separated from the other block. This suggests that these clusters should form together a cluster in a solution with less clusters. The other block is less well defined. There is considerable overlap between clusters 6 and 3, but also cluster 3 and 1 share similar objects. Using the information stored in the result of \func{dissplot} and the class information available for the iris data set, we can analyze the cluster solution and the interpretations of the dissimilarity plot. <<>>= #names(res) table(iris[res$order, 5], res$label)[,res$cluster_order] #$ @ As the plot in Figure~\ref{fig:dissplot3} indicated, the clusters 10, 9, 5, 7, 8, 4 and 2 should be a single cluster containing only flowers of the species Iris Setosa. The clusters 6, 3 and 1 are more problematic since they contain a mixture of Iris Versicolor and Virginica. To illustrate the results of the dissimilarity plot in case a clustering with a $k$ smaller than the actual number of groups in the data is used, we use the Ruspini data set which consists of 75 points in four groups and is also often used to illustrate clustering techniques. We load the data set, calculate distances, perform $k$-means clustering with $k=3$ (although the real number of groups is 4) and produce a dissimilarity plot. <>= data("ruspini", package = "cluster") d <- dist(ruspini) l <- kmeans(ruspini, 3)$cluster dissplot(d, labels = l) @ \begin{figure} \centering \includegraphics[width=10cm]{seriation-ruspini}\\ \caption{Dissimilarity plot for $k$-means solution with 3 clusters for the Ruspini data set with 4 groups.} \label{fig:ruspini} \end{figure} The dissimilarity plot in Figure~\ref{fig:ruspini} shows that cluster 3 actually should be two separate clusters represented by the two clearly visible darker triangles next to the main diagonal. The dissimilarity plot using seriation is a useful tool to inspect the result of clustering. It is especially useful to spot misspecifications of the number of clusters employed. A more detailed treatment of dissimilarity plots as a tool for exploring partitional clustering can be found in \cite{seriation:Hahsler+Kornik:2011}. \section{Conclusion} \label{sec:conclusion} In this paper we presented the infrastructure provided by the package~\pkg{seriation}. The infrastructure contains the necessary data structures to store the linear order for one-, two- and $k$-mode data. It also provides a wide array of seriation methods for different input data, e.g., dissimilarities, binary and general data matrices focusing on combinatorial optimization. New seriation methods can be easily incorporated into the \pkg{seriation} framework by the user with the method registry mechanism provided. Based on seriation, \pkg{seriation} features several visualization techniques. In particular, the optimally reordered heat map, the Bertin plot and the dissimilarity plot present clear improvements over standard plots. A natural extension to \pkg{seriation} is the synthesis of ensembles of seriations into a ``consensus'' one. Such ensembles do not only arise when using different seriation methods, but also when varying data or control parameters to obtain more robust solutions (see e.g.~\cite{seriation:Jurman:2008} for a recent application of such ideas in a molecular profiling context). The \proglang{R}~extension package \pkg{relations}~\citep{seriation:Hornik+Meyer:2008} contains a variety of methods for obtaining consensus \emph{relations}, covering consensus seriation (where the relations are linear orders on the objects) as a special case. Future work on \pkg{seriation} will focus on adding further seriation methods, such as for example methods for higher dimensional arrays and methods for block seriation which aim at finding simultaneous partitions of rows and columns in a data matrix~\citep[see, e.g.,][]{seriation:Marcotorchino:1987}. \section*{Acknowledgments} The authors would like to thank Michael Brusco, Hans-Friedrich K{\"o}hn and Stephanie Stahl for their seriation code, Fionn Murtagh for his BEA implementation and the anonymous reviewers for their valuable comments and suggestions. % %\bibliographystyle{abbrvnat} \bibliography{seriation} % \end{document} seriation/vignettes/seriation.bib0000644000176200001440000004414213236106744016745 0ustar liggesusersThis file was created with JabRef 2.2. Encoding: ISO8859_1 @INCOLLECTION{seriation:Garfinkel:1985, author = {R. S. Garfinkel}, title = {Motivation and Modeling}, year = {1985}, chapter = {2}, pages = {17--36}, crossref = {seriation:Lawler:1985}, owner = {hahsler}, timestamp = {2007.03.27} } @INCOLLECTION{seriation:Arabie:1996, author = {P. Arabie and L. J. Hubert}, title = {An Overview of Combinatorial Data Analysis}, booktitle = {Clustering and Classification}, publisher = {World Scientific}, year = {1996}, editor = {P. Arabie and L. J. Hubert and G. De Soete}, pages = {5--63}, address = {River Edge, NJ}, owner = {hahsler}, timestamp = {2007.07.04} } @ARTICLE{seriation:Arabie:1990, author = {P. Arabie and L. J. Hubert}, title = {The Bond Energy Algorithm Revisited}, journal = {{IEEE} Transactions on Systems, Man, and Cybernetics}, year = {1990}, volume = {20}, pages = {268--74}, number = {1}, owner = {hahsler}, timestamp = {2007.04.10} } @ARTICLE{seriation:Bar-Joseph:2001, author = {Z. Bar-Joseph and E. D. Demaine and D. K. Gifford and T. Jaakkola}, title = {Fast Optimal Leaf Ordering for Hierarchical Clustering}, journal = {Bioinformatics}, year = {2001}, volume = {17}, pages = {22--29}, number = {1}, owner = {hahsler}, timestamp = {2007.03.27} } @INPROCEEDINGS{seriation:Bertin:1999, author = {J. Bertin}, title = {Graphics and Graphic Information Processing}, booktitle = {Readings in Information Visualization}, year = {1999}, editor = {S. K. Card and J. D. Mackinlay and B. Shneiderman}, pages = {62--65}, address = {San Francisco, CA, USA}, publisher = {Morgan Kaufmann Publishers Inc.}, book = {Readings in Information Visualization: Using Vision to Think}, isbn = {1-55860-533-9} } @BOOK{seriation:Bertin:1981, title = {Graphics and Graphic Information Processing}, publisher = {Walter de Gruyter}, year = {1981}, author = {Bertin, J}, address = {Berlin}, note = {Translated by William J. Berg and Paul Scott}, owner = {hahsler}, timestamp = {2007.04.05} } @ARTICLE{seriation:Brusco:2007, author = {Brusco, M. and K{\"o}hn, H. F. and Stahl, S.}, title = {Heuristic Implementation of Dynamic Programming for Matrix Permutation Problems in Combinatorial Data Analysis}, journal = {Psychometrika}, year = {2008}, volume = {73}, number = {3}, pages = {503--522}, owner = {hahsler}, timestamp = {2007.07.12} } @BOOK{seriation:Brusco:2005, title = {Branch-and-Bound Applications in Combinatorial Data Analysis}, publisher = {Springer}, year = {2005}, author = {Michael Brusco and Stephanie Stahl}, owner = {hahsler}, timestamp = {2007.07.04} } @ARTICLE{seriation:Caraux:2005, author = {Caraux, G. and Pinloche, S.}, title = {Permutmatrix: A Graphical Environment to Arrange Gene Expression Profiles in Optimal Linear Order}, journal = {Bioinformatics}, year = {2005}, volume = {21}, pages = {1280--1281}, number = {7}, owner = {hahsler}, timestamp = {2007.03.19} } @ARTICLE{seriation:Chen:2002, author = {Chun-Houh Chen}, title = {Generalized Association Plots: Information Visualization via Iteratively Generated Correlation Matrices}, journal = {Statistica Sinica}, year = {2002}, volume = {12}, pages = {7--29}, number = {1}, owner = {hahsler}, timestamp = {2007.03.19} } @MANUAL{seriation:Chessel:2007, title = {\pkg{ade4}: Analysis of Ecological Data : Exploratory and Euclidean methods in Multivariate data analysis and graphical display}, author = {Daniel Chessel and Anne-Beatrice Dufour and Stephane Dray}, year = {2007}, note = {R package version 1.4-3}, url = {http://CRAN.R-project.org/package=ade4}, owner = {hahsler}, timestamp = {2007.08.07} } @article{seriation:Dray:2007, author = "Stephane Dray and Anne-Beatrice Dufour", title = "The ade4 Package: Implementing the Duality Diagram for Ecologists", journal = "Journal of Statistical Software", volume = "22", number = "4", day = "4", month = "6", year = "2007", URL = "http://www.jstatsoft.org/v22/i04", } @ARTICLE{seriation:Eisen:1998, author = {Michael B. Eisen and Paul T. Spellman and Patrick O. Browndagger and David Botstein}, title = {Cluster Analysis and Display of Genome-wide Expression Patterns}, journal = {Proceedings of the National Academy of Science of the United States}, year = {1998}, volume = {95}, pages = {14863--14868}, number = {25}, month = {December}, owner = {hahsler}, timestamp = {2007.04.05} } @INPROCEEDINGS{seriation:Falguerolles:1997, author = {Antoine de Falguerolles and Felix Friedrich and G{\"u}nther Sawitzki}, title = {A Tribute to {J}. {B}ertin's Graphical Data Analysis}, booktitle = {SoftStat '97 (Advances in Statistical Software 6)}, year = {1997}, editor = {W. Bandilla and F. Faulbaum}, pages = {11--20}, publisher = {Lucius \& Lucius}, owner = {hahsler}, timestamp = {2007.02.22} } @ARTICLE{seriation:Gale:1984, author = {N. Gale and W. C. Halperin and C. M. Costanzo}, title = {Unclassed Matrix Shading and Optimal Ordering in Hierarchical Cluster Analysis}, journal = {Journal of Classification}, year = {1984}, volume = {1}, pages = {75--92}, owner = {hahsler}, timestamp = {2007.04.06} } @ARTICLE{seriation:Gruvaeus:1972, author = {Gruvaeus, G. and Wainer, H.}, title = {Two Additions to Hierarchical Cluster Analysis}, journal = {British Journal of Mathematical and Statistical Psychology}, year = {1972}, volume = {25}, pages = {200--206}, owner = {hahsler}, timestamp = {2007.03.27} } @MANUAL{seriation:Hahsler:2007b, title = {\pkg{TSP}: Traveling Salesperson Problem (TSP)}, author = {Michael Hahsler and Kurt Hornik}, year = {2007}, url = {http://CRAN.R-project.org/package=TSP}, note = {R package version 0.2-2} } @ARTICLE{seriation:Hahsler:2007, AUTHOR = {Michael Hahsler and Kurt Hornik}, TITLE = {{TSP} -- {I}nfrastructure for the Traveling Salesperson Problem}, JOURNAL = {Journal of Statistical Software}, YEAR = {2007}, VOLUME = {23}, PAGES = {1-21}, NUMBER = {2}, MONTH = {December}, URL = "http://www.jstatsoft.org/v23/i02", } @BOOK{seriation:Hartigan:1975, title = {Clustering Algorithms}, publisher = {Wiley}, year = {1975}, author = {John A. Hartigan}, owner = {hahsler}, timestamp = {2007.04.10} } @ARTICLE{seriation:Hartigan:1967, author = {J. A. Hartigan}, title = {Representation of Similarity Matrices by Trees}, journal = {Journal of the American Statistical Association}, year = {1967}, volume = {62}, pages = {1140--1158}, number = {320}, owner = {hahsler}, timestamp = {2007.04.10} } @ARTICLE{seriation:Held:1962, author = {M. Held and R. M. Karp}, title = {A Dynamic Programming Approach to Sequencing Problems}, journal = {Journal of {SIAM}}, year = {1962}, volume = {10}, pages = {196--210}, owner = {hahsler}, timestamp = {2007.03.27} } @ARTICLE{seriation:Hubert:1974, author = {L. J. Hubert}, title = {Some Applications of Graph Theory and Related Nonmetric Techniques to Problems of Approximate Seriation: The Case of Symmetric Proximity Measures}, journal = {British Journal of Mathematical Statistics and Psychology}, year = {1974}, volume = {27}, pages = {133--153}, owner = {hahsler}, timestamp = {2007.03.26} } @BOOK{seriation:Hubert:2001, title = {Combinatorial Data Analysis: Optimization by Dynamic Programming}, publisher = {Society for Industrial Mathematics}, year = {2001}, author = {Lawrence Hubert and Phipps Arabie and Jacqueline Meulman}, owner = {hahsler}, timestamp = {2007.07.04} } @ARTICLE{seriation:Hubert:1981, author = {L. J. Hubert and R. G. Golledge}, title = {Matrix Reorganization and Dynamic Programming: Applications to Paired Comparisons and Unidimensional Seriation}, journal = {Psychometrika}, year = {1981}, volume = {46}, pages = {429--441}, number = {4}, owner = {hahsler}, timestamp = {2007.03.26} } @MANUAL{seriation:Hurley:2007, title = {\pkg{gclus}: Clustering Graphics}, author = {Catherine Hurley}, year = {2007}, url = {http://CRAN.R-project.org/package=gclus}, note = {R package version 1.2} } @INPROCEEDINGS{seriation:Ihm:2005, author = {Peter Ihm}, title = {A Contribution to the History of Seriation in Archaeology}, booktitle = {Classification - the Ubiquitous Challenge, Proceedings of the 28th Annual Conference of the Gesellschaft f{\"u}r Klassifikation e.V., University of Dortmund, March 9--11, 2004}, year = {2005}, editor = {Weihs, Claus and Gaul, Wolfgang}, series = {Studies in Classification, Data Analysis, and Knowledge Organization}, pages = {307--316} } @INCOLLECTION{seriation:Kendall:1971, author = {Kendall, D. G.}, title = {Seriation from Abundance Matrices}, booktitle = {Mathematics in the Archaeological and Historical Sciences}, year = {1971}, editor = {F.R. Hodson and D.G. Kendall and P. Tautu}, pages = {214--252}, owner = {hahsler}, timestamp = {2007.03.19} } @INCOLLECTION{seriation:Leeuw:2005, author = {Jan de Leeuw}, title = {Unidimensional Scaling}, booktitle = {Encyclopedia of Statistics in Behavioral Science}, publisher = {Wiley}, year = {2005}, editor = {B.S. Everitt and D.C. Howelll}, volume = {4}, owner = {hahsler}, timestamp = {2007.03.19} } @ARTICLE{seriation:Lenstra:1974, author = {J. K. Lenstra}, title = {Clustering a Data Array and the Traveling-Salesman Problem}, journal = {Operations Research}, year = {1974}, volume = {22}, pages = {413--414}, number = {2}, owner = {hahsler}, timestamp = {2007.04.16} } @ARTICLE{seriation:Lin:1973, author = {S. Lin and B. W. Kernighan}, title = {An Effective Heuristic Algorithm for the Traveling-Salesman Problem}, journal = {Operations Research}, year = {1973}, volume = {21}, pages = {498--516}, number = {2}, owner = {hahsler}, timestamp = {2007.03.27} } @ARTICLE{seriation:Ling:1973, author = {Robert L. Ling}, title = {A Computer Generated Aid for Cluster Analysis}, journal = {Communications of the {ACM}}, year = {1973}, volume = {16}, pages = {355--361}, number = {6}, address = {New York, NY, USA}, publisher = {ACM Press} } @ARTICLE{seriation:Marcotorchino:1987, author = {F. Marcotorchino}, title = {Block Seriation Problems: A Unified Approach}, journal = {Applied Stochastic Models and Data Analysis}, year = {1987}, volume = {3}, pages = {73--91}, owner = {hahsler}, timestamp = {2007.04.17} } @ARTICLE{seriation:McCormick:1972, author = {William T. McCormick and Paul J. Schweitzer and Thomas W. White}, title = {Problem Decomposition and Data Reorganization by a Clustering Technique}, journal = {Operations Research}, year = {1972}, volume = {20}, pages = {993--1009}, number = {5}, owner = {hahsler}, timestamp = {2007.04.10} } @MANUAL{seriation:Meyer:2007, title = {\pkg{proxy}: Distance and Similarity Measures}, author = {David Meyer and Christian Buchta}, year = {2007}, url = "http://CRAN.R-project.org/package=proxy", note = {R package version 0.1} } @BOOK{seriation:Murtagh:1985, title = {Multidimensional Clustering Algorithms}, publisher = {Physica-Verlag}, year = {1985}, author = {Fionn Murtagh}, volume = {4}, series = {Compstat Lectures}, address = {Vienna}, owner = {hahsler}, timestamp = {2007.04.10} } @ARTICLE{seriation:Niermann:2005, author = {Niermann, Stefan}, title = {Optimizing the Ordering of Tables With Evolutionary Computation}, journal = {The American Statistician}, year = {2005}, volume = {59}, pages = {41--46}, number = {1}, owner = {hahsler}, timestamp = {2007.03.16} } @MANUAL{seriation:Oksanen:2007, title = {\pkg{vegan}: Community Ecology Package}, author = {Jari Oksanen and Roeland Kindt and Pierre Legendre and Bob O'Hara}, year = {2007}, note = {R package version 1.8-6}, owner = {hahsler}, url = {http://CRAN.R-project.org/package=vegan}, timestamp = {2007.08.07} } @ARTICLE{seriation:Padberg:1990, author = {M. Padberg and G. Rinaldi}, title = {Facet Identification for the Symmetric Traveling Salesman Polytope}, journal = {Mathematical Programming}, year = {1990}, volume = {47}, pages = {219--257}, number = {2}, address = {Secaucus, NJ, USA}, issn = {0025-5610}, owner = {hahsler}, publisher = {Springer-Verlag New York, Inc.}, timestamp = {2007.03.27} } @ARTICLE{seriation:Petrie:1899, author = {Petrie, F. W. M.}, title = {Sequences in Prehistoric Remains}, journal = {Journal of the Anthropological Institute}, year = {1899}, volume = {29}, pages = {295--301}, owner = {hahsler}, timestamp = {2007.03.19} } @ARTICLE{seriation:Robinson:1951, author = {W. S. Robinson}, title = {A Method for Chronologically Ordering Archaeological Deposits}, journal = {American Antiquity}, year = {1951}, volume = {16}, pages = {293--301}, owner = {hahsler}, timestamp = {2007.03.19} } @ARTICLE{seriation:Rosenkrantz:1977, author = {Daniel J. Rosenkrantz and Richard E. Stearns and Philip M. Lewis, II}, title = {An Analysis of Several Heuristics for the Traveling Salesman Problem}, journal = {{SIAM} Journal on Computing}, year = {1977}, volume = {6}, pages = {563--581}, number = {3}, owner = {hahsler}, timestamp = {2007.03.27} } @ARTICLE{seriation:Rousseeuw:1987, author = {Rousseeuw, P. J.}, title = {Silhouettes: A Graphical Aid to the Interpretation and Validation of Cluster Analysis}, journal = {Journal of Computational and Applied Mathematics}, year = {1987}, volume = {20}, pages = {53--65}, number = {1}, owner = {hahsler}, timestamp = {2007.04.10} } @BOOK{seriation:Sneath:1973, title = {Numerical Taxonomy}, publisher = {Freeman and Company}, year = {1973}, author = {Peter H. A. Sneath and Robert R. Sokal}, address = {San Francisco}, owner = {hahsler}, timestamp = {2007.04.06} } @ARTICLE{seriation:Strehl:2003, author = {Strehl, A. and Ghosh, J.}, title = {Relationship-based Clustering and Visualization for High-dimensional Data Mining}, journal = {{INFORMS} Journal on Computing}, year = {2003}, volume = {15}, pages = {208--230}, number = {2}, owner = {hahsler}, timestamp = {2007.04.10} } @BOOK{seriation:Gutin:2002, title = {The Traveling Salesman Problem and Its Variations}, publisher = {Kluwer}, year = {2002}, editor = {G. Gutin and A. P. Punnen}, volume = {12}, series = {Combinatorial Optimization}, address = {Dordrecht}, owner = {hahsler}, timestamp = {2006.11.29} } @BOOK{seriation:Lawler:1985, title = {The Traveling Salesman Problem}, publisher = {Wiley}, year = {1985}, editor = {Lawler, E. L. and Lenstra, J. K. and Rinnooy Kan, A. H. G. and Shmoys, D. B.}, address = {New York}, owner = {hahsler}, timestamp = {2007.03.27} } @Book{seriation:Fowler:2004, author = {Martin Fowler}, title = {UML Distilled: A Brief Guide to the Standard Object Modeling Language}, publisher = {Addison-Wesley Professional}, edition = {third}, year = 2004, } @article{seriation:Jurman:2008, author = {Jurman, Giuseppe and Merler, Stefano and Barla, Annalisa and Paoli, Silvano and Galea, Antonio and Furlanello, Cesare }, journal = {Bioinformatics}, month = {January}, number = {2}, pages = {258--264}, priority = {3}, title = {Algebraic Stability Indicators for Ranked Lists in Molecular Profiling}, volume = {24}, year = {2008} } @Manual{seriation:Hornik+Meyer:2008, title = {\pkg{relations}: Data Structures and Algorithms for Relations}, author = {Kurt Hornik and David Meyer}, year = {2008}, url = {http://CRAN.R-project.org/package=relations}, note = {R package version 0.3-1}, } @article{seriation:Hahsler+Hornik:2008, author = {Michael Hahsler and Kurt Hornik and Christian Buchta}, title = {Getting Things in Order: An Introduction to the {R} Package seriation}, journal = {Journal of Statistical Software}, year = {2008}, volume = {25}, pages = {1--34}, number = {3}, month = {March}, issn = {1548-7660}, url = {http://www.jstatsoft.org/v25/i03}, } @article{seriation:Hahsler+Kornik:2011, author = {Michael Hahsler and Kurt Hornik}, title = {Dissimilarity Plots: {A} Visual Exploration Tool for Partitional Clustering}, journal = {Journal of Computational and Graphical Statistics}, year = {2011}, volume = {10}, number = {2}, pages = {335--354}, } @article{hahsler:Hahsler2016d, author = {Michael Hahsler}, title = {An Experimental Comparison of Seriation Methods For One-Mode Two-Way Data}, journal = {European Journal of Operational Research}, year = {2017}, volume = {257}, pages = {133--143}, number = {}, month = {February}, } @INPROCEEDINGS{seriation:Ding:2004, author = {Chris Ding and Xiaofeng He}, title = {Linearized cluster assignment via spectral ordering}, booktitle = {Proceedings of the Twenty-first International Conference on Machine Learning (ICML '04)}, year = {2004}, pages = {30}, publisher = {ACM Press} } @INBOOK{seriation:Burkard:1998, author = {Rainer E. Burkard and Eranda Cela and Panos M. Pardalos and Leonidas S. Pitsoulis}, title = {The Quadratic Assignment Problem}, year = {1998}, booktitle = {Handbook of Combinatorial Optimization}, editor = {P. Pardalos and D.-Z. Du}, publisher = {Springer Verlag} } @inproceedings{seriation:Barnard:1993, author = {Barnard, S. T. and Pothen, A. and Simon, H. D.}, title = {A Spectral Algorithm for Envelope Reduction of Sparse Matrices}, booktitle = {Proceedings of the 1993 ACM/IEEE Conference on Supercomputing}, series = {Supercomputing '93}, year = {1993}, location = {Portland, Oregon, USA}, pages = {493--502}, publisher = {ACM}, address = {New York, NY, USA}, } @article {seriation:Hubert:1976, author = {Hubert, Lawrence and Schultz, James}, title = {Quadratic Assignment as a General Data Analysis Strategy}, journal = {British Journal of Mathematical and Statistical Psychology}, volume = {29}, number = {2}, publisher = {Blackwell Publishing Ltd}, issn = {2044-8317}, pages = {190--241}, year = {1976}, } seriation/vignettes/classes.odg0000644000176200001440000002551712606356654016436 0ustar liggesusersPK‘Œ28Ÿ.Ä++mimetypeapplication/vnd.oasis.opendocument.graphicsPK‘Œ28Configurations2/statusbar/PK‘Œ28'Configurations2/accelerator/current.xmlPKPK‘Œ28Configurations2/floater/PK‘Œ28Configurations2/popupmenu/PK‘Œ28Configurations2/progressbar/PK‘Œ28Configurations2/menubar/PK‘Œ28Configurations2/toolbar/PK‘Œ28Configurations2/images/Bitmaps/PK‘Œ28 content.xmlå[[oë6~ï¯ÔÝ>´dÝm÷$‹>å, œS èKÁH”ÍVµ”Ûý}Üÿ×_Ò!© eY¶’8—“ Åš‹8üf83"7»,Õî1+ ͯtÛœéÎ#“|u¥ÿôùc®ß\õ& ‰ð2¦Ñ&ÃyeD4¯à¯Úy¹”Ü+}Ãò%E%)—9Êp¹¬¢%-pÞh-Ué¥KRÊjŸNVªv…wÕTe.ÛÓEwÓGªvÌÐvª2—PUõ„NUÞ•©‘P@=+PE¬Ø¥$ÿýJ_WU±´¬ívkn]“²•e/ Kp[ƒ£V®Ø°THÅ‘…SÌ+-Û´­F6Új—UMÊ7Ùf“¡Axµ`¸˜.ÌiRuzñu¿š]÷«˜£5b“ãL÷Cŧ‡Š«ºªÖ#þ[).o»¸bÙÔ±¸lªˆ‘bò4¥´ªO)mMå r± sÙ̳ä½"½=)¾e¤ÂLNŠG(ZÄiv 4³-0ð=ùvq ÊÇ’ìV¸ŒGýóÇÛOÑg¨&ç… ’—Ê;dÊŒ¤“½²#A‹r29¸¬²tê4Ý« ×M!Ž/­–€6åÚ‘!VryýA®hqÕäg>ø•¶^–ï$s£Q Ö­qÕ¨®*Ö$jÈb¼<‰C*q\cÄb½yn­b @`Á¥Æ X&$ÈKš’Xï(lJ!•}ˆŸšÃë …Œ5eä(†(5PJV€Óo›²"ÉþPðžub‰ã×R=cÅèÖXc²ZÃúKPZ ,,ŒSÈ8¯‡ÌLü¼YdÜ·3ÀÓÜ$`0uïíOý•‚ÂFd^ÁÑÁ3N§¬ýršƒ Aª)Ç׿ )ûø¨HqR:»b›a$lIÌ»$ÉKè2#y«0‹²–VËqÒð _ ߈‡s1ÅClÿqP2ÁV$li-k)ªm|\ÄV04w†¢$²>´Ü—‡AÞIå˜ÿ8(h¯m·SpúÃ%”»žüVÛNQé-m[û쎦ñf>(X_ÞÌë7zKš/’£€4“lža@‡Šx£9çO:dòþ6Å»š=ÌA œæ„ž/3ëAyûòBèPTÑçCíq9qP†^ÌÀK~ó7=ÅðØ sÊ2”NŸãçAIæƒê/òçAm}´o&ÑTÍË€ú2ƪԌPLŠ ð””µçzVÜÚº*â{œÖ-íÝ&Mq¥I&§Ã uy+Yßñ¼Òÿúߟg­n¦ø šÿOû Pn&¿)1ôçy í¼¬ßÚž^™´çÿSL˜Œsn2ÊC”) ²@<'”aÞŸ<ÇïÛSt:Í[‡`žÍ5o!÷bÙ¦ó.ò.ˆÐü]"ä_ !ÇôÞ%BÁÅrß%>áåðy§yz~1„¼wš§Dè}æi{v1ˆü/+Q+ìºa¶F8kÆ÷íM}’yýAlãòóL¹¡+l~oëÍ®ï¾Ý*G¢‚š¡²ÂL„Ö¼ãmÒª;z'Ñš8·ïlJh´)›cšYéÞˆqIV¹‘Ñ+§$b,Ðu£\£mg­í6}og›oÍ NŠöü[ð‡n*y4P{Ö3]OdNk¶®¡ñóý†¸ãî÷Ü ¹ß‹pø}©EOêÈí DY>äÛõu‰Ù¯AÙF~¤v)—oÜ[Ôà|ÍÜcc…i†+¶†Ü¼ýåæi3ͱƒY}mÐØ0ÃQ…òU{"Õ>ªßÕø¨qåÛZ½÷­û;Ó~Ñþ#‚rà'»È­9$†—óø¼ÃÓç '˜N^ÖaÎÀa¿Þ¶”½k¿9£~óz~³Ïúmf†¡}è7XX¶£øÍ¡…â7ÛœÍÃÓ~ Ú4ñ(´Wé%yUòr2¯q“ŸäUÅVPTLø± hú0ÅÅœæÚshLPFóxÌÍзê@=ú´ ®¥y.ô˜_ݳ~=âÉÍˤïÍ[Ùbé-::‡kÏ‘¢É¯í@¬’†ª#É7D]CwâŽBT…ݳ!bõA™ÿÞÄøwÿAà)ñ?7ó^ø/ûåÃÿ&±Û(S£Q]òz“„£K¢{ÊMâh6|àŸ\-tÄïHÒ#%-# =‹Q1¢f?è HB0kŒ[E7‰º†ú鯗ªÿnDW[ž¤ý^ô$›]éÿ˜i¸Ç4ì#–sZÇ9Ôá0}''uRÑ=2Ø·ŽåžÖò†Ã¹ÚwܧõüC=¡Áñ=­ ôÏ‚Žt£§ã´^£ò3ÄmIä·n‹ŠzË €°±3 ™'Ù&ƒ0ÂG;É—ñئŠÁzz–öÇ陋É·ëWgþ¹öÇ3ÛWòˆkŠªú„îò+ä¼ÂLû?èz¦º+˜à®™?Èú‡î²g¦—ö×:Jaš_¶ŸNµ0þÙÒ<ÒÂ,L·+º¼…qÌÀqû-LØoaj‡í`Üùlã)DUxöØæiÉ@öŸŠX_ÂQ$.™;Yø:½Hþ(H³c ùo+®F@²Ó^Ø*JÍÒzHÁë‚”09P0 Px¶fÀ›‚3Ø’¢*5Ã7CW-ñð&ÎEÍèÆ½£»“Ó:»Cõíñêa auXœÃ%Åe~ÇtCwˆ‹ïõKé!,ÎEQñôëoÒê{þ‹îÊŠ¡¨úf÷ðûÆÀš·ÉÀZ@ y XŽé‰¥÷,hþ}ñÏ{OÀKÞðMçn¿›“ÄN¶ÕÛç¶FþôúoPKÂÈ0J:PK‘Œ28 styles.xmlí\_oÛ6ß§04to²$Çic/NÑ­ØÓ H»wZ¢l6”(PT÷KìqßoŸdGR([r¤Æ‰Ý@-PÔ¼;ñîÇãQ÷ ë÷Ýcž/,oìZ#û, ñja}ùü‡}e½¿ùéš…!ññ<`~áXØ©ØRœŽÀ8NçZ¸°2ÏJI:Q„Ó¹ðç,Áqa47µçj*=¢ÖÕ\)›Ö?ˆ®ÆR·f‹–ÝgVʦuÀѦ«±ÔLMóu5~H©2ÛgQ‚Ùñâ’øna­…H掳ÙlÆ›‹1ã+Ç›ÍfŽ’–û¥^’qª´ßÁËÉRÇ{N¡aºú'uM—â,ZbÞ$ÐÞª&§ áʼìö Ó¦–_÷«ÎÙu¿jÙ_#Þ9Ï”r=U.‚î©r˜¶ë–õ½r>PýóéÏ*¯xÔu.©[ƒÊç$é¦Ö6íc¥«Ò@ovåîÄu§Žþlhoªo8˜êþAuQ¿DœEM žç€†ïeÊ—qG„vŽt[’Ť3ôR×HÕ¼,ÖJñMQwu¹½¹–Uòßa>Rÿ—,¬œ³5‚äß¼ù=,,wäŽ&îèÂÕã}‘c¶'ÇÖ÷›åÜ\ëmàe4/ê#="ˆr»°V%kâ[…n‚8RcvÂ!(.Z$‹«2ÁÒÉ〘iUD“5²rµ$‹}‘©Èí ˆVJ¢„âB ÛK޵Tpâ‹B"³j¨±O¹-–…(dp(‘8Àgy@©§HGÔA"šâ2(ä+KR@Ài«T—qíE›¥Ø†Š°­&÷ePòÏ ’i A Kýˆ¿¢¿³Ñ-ŠÓÑïLú™â@‹jqh+{…c á/,Î"×4"|¨ ÷ˆy(U¦ä@3™&BQ¯2´‚¡@+ù,‹>|nš’ÅOs·xFºMŽö½.ä•t¿PÐAä9‘ÇQÈp GP!ørÛäšÜ¬?<1°ò)­¡•íÁ•*á•ÒýK„Xåmmë kîc] RâñÀzdwçŸÍlWeö!»“Ïa”º è!Ø<\?ª ç»ágWý±FFá_áp, ÇÒt_îÃ.–ïzëÖ`‹0—Ò&ãPZFPŽ”žÎf¾†j“$(ï¿6”9ƒ7¹”s‚%B/M2ŠC!%{NVkC¢q]£@$ä’ƒ6”þ û¡d]¸m!]¹ò/,®zí¥$­—øÔ0Õ(œŽT+ÛËŒR,FZ(Çál²ôG-²åÛÎÂúï߬¶’¹[oa‰o·Ñ’Q«O9ÕÕmzùFí€CîöfòX0ÆCŒ”:éì%†×(,—â­\ %‰HlS´›2S¥Ðùº8BÞxò*š¡«W‰ÐåÑšŒ§¯¡·GCèâUâóîxø¼Ò:}u4„¦¯´NÏŽˆÐë¬Óž{4ˆ.¬BmˆónÊikŠ’!07t"+°nò> ,Ú€ú¨n5êce—‘+Jcµ½çºorlq,[M[“®Ý!m®DQ"úA­ˆw@Õ0d™î”S"å¦Xs–­ÖvNíÇ,>=+â]嬈+<ã¢VEG¦=6ÂÊÀ3®Y¥¦˜6ùºÏ;onECa ÕVÈ¥ 1èð(œ1ÓÒl)o·EE厒5Ò‰eæŠ2ç˜悊¬y„¤a˯Ø" äj>·‘«)hTÄËÄÙ{­üS霱wÙ—Ñ)iè\Ï»Ã\.3©žï@Soéç„3¯÷$%*Ÿ…ÆùŽÈ¡JKŽëCפZ¿<—Ûç’[ïÊ'y¹dÁö”ž~7ÊOµ·PÝzGõ5K!5p+!ürѵ½CéŸ&Q²‚óFzKÂmÿ0õ›ÏÉ‚<̼î8yLþµ'eyN¯áo;ð¶o{6 ¼íÀÛ¼íÀÛž¡·xÛóâmëÄjJÇ°:Ó¾r:íÕWʼSÄÔz¡ÇÕ´IOŠfrˆ¢ÙîS4Ý›ZMzu]ŽIÿå˜<Ïr4±…nu¥©¶aèû³Ù‹®Á#=·æD½öäÌJçÐk½öÐkŸ BC¯=ôÚC¯=ôÚC¯}Þ ½ö õÚz‡íÞ’{-÷¤JAC›Õï2T›‹^?b]cÈ{B§oð>Gs:iƒsâuǨ_Z`tÆàt Õo WÆ`Ãý¡{¦îþl¡›6\Þ#6¹ÿTD#ŒÒŒ¿Ä~5¹ª¾W§*Þ£ºÕhW»2UY}ÇÍ’IÓ–vv¾’œ”ßû•_göíBPÀ¶ÂpªmY&j ÿõɵteÒáÛ±=¸[5_‘wi·kÕ»oî'€ã¤úm ã‚#b‚c„ОhA²Wïò_ aKûsp/—–È¿[q–Á*ëeZ2ÈîÑ›NNëRå‚¥B%Þ¶ú²9Ä$‡äá_}6¿{®ƒ–³5Ë+»èè»ki»ªùÉ= ‘ogY#•–³‡%Vb\[¤úµÕ¶¯r³ÊÜb[Wµ@®­Sa¼¥ÓüûSnþPKmý™‰EPK‘Œ28meta.xml”ÁŽ›0†ï} „öjŒ!É‚¬ÔCÕJ]m¥¦çе'‰[°‘mšôí‹M@õÀ‘™ïÿg˜(^nmüm„’eH¢8 @2Å…<—áã'”…/Õ‡BN‚åŠõ-H‹Z°u0H¥¡cª {-©ª0TÖ-jUÈIB—4õ…ÆÈ­òw^¬í(Æ×ë5º¦‘ÒgLò<Ç>;¡œÍ\×ëÆSœahÀU0˜DO¬ëpkSŽ]¶Ôi0C¶¶~(Û<–š¥—RjnÚÉÆøÖ“8Þáñy¢M+š­‹˜j»¡æ{³ši-E»ÕƱ‹®ï ZD5íß ª*ü¸Î A×Véêmð|[¼U”>}²¿ëÄÏN«_À,>dq»úØ‹†£×Ó€.ð"ç¸É8C1A$;BÓM÷Ý|àÂßbY¦Êî…Âk–÷ÚwU};’ÝkòüýA4çGYo@#'!>âVV†_äI$Ä[°d–nÃv36ôÆ]·±‚°zwë.°—v¸/À«CÁÿûmTÿPKø?ÏŽ¿tPK‘Œ28Thumbnails/thumbnail.png}Vy4Ô_ÿÎh±ï™B– EdM!KÌh([¶P–Ÿ-Â Õ ¢0T„Ê2c¯¬Ùƒ1Yбd¬ÉRcy¿½¿÷¼uúçž{î¹Ï]žçù,±f8ØDØà0ºh` p ¸³2ƒãÊ %€‡è¢ng,=w¿Áo.L'c´‰Y{Q0/”Ôu£x¢£Šò3 ÷MâP Ì€gÑЂ_·WeŠåµãÊÆ]ÃËñ±°6^x̃ú‰hVOÌõ®qwß´÷nŠÁiÓIõés,]KÝ´eZ7A£u™Årëýz™Ç§ÃJR—îÝ`‡á¸¾¸_*óz*x¨N Å`íf$Dô!âο7]ªr R¶î…çääH)ôú•iFÅ-ùm^\¸}Õn‡Ö¢ÊjŒX³nà§Xj“Ð'(LB[,µ7dð-Z;''Kæ›gYLµ'ÎLw&ç&œ Z”åBžC9]­ð”~Ÿ~:­+M±ÐùÕŒZ|~4ç‡r«ß/Q;?×ÛÙOy}R026N’ÐÇ_tqÉùÜ®ðµW¤zê>ÄW]x‹¥sƒÓÕùNÖÄ¿hݾZySÎô™ÊcÄiï'”ñ†ð;‚PÇê6 …ºñmÐKj)¸n]„¹|}goTz.Êzè3ïH"G]à R+EYú\áåJ/Šâ½ùo"tp¤KBbÅ{T±á_É8]Èö´öhE÷0‚!ÀMØ×_é¬Mgµ¬çÈcB¿­Ffv”ØÕN÷“¬þ™h‚dízµl×çžB­^( ¢Ç.$Š#HQÃ5þù ˜2QEÛò‹–VV&õœ5[K#v%=~üc¾ùÖ¼E9³\@3s–eáS)õ ;kõtÖûMQ’RSó&+ð¯ñ£•·Ò¹.š›§¥¤ð¯ïh.t,¿•–”lp87ðúƒYSÙ½ûðð׸°ý=»Ìsáò`b’’vî2¶\[´Å } YÉx –<Û^Õµ¯uÍĮϚÎÌO¤Ž|ýzC=l»Œ^\J÷ª gX5bKóšÉØÕÀ3LÂÂêžákÕñ‡Õ-M›¥ed ý¿œ ùî"07üÖ}àg…×`ªÇǼN<‚º-iWºa‰Q© ûi9Û“¥ˆ>¿ú¤[ßVDí¦ì•’krÉŠ· °sÝ¢{ áŒiz¿ë²×Ïï3'Pªï£W;„¼4”‡ŠlÞžô»Círlõèà®U÷†h/_““—·dt\VìèêJÞÛeœµg‚ÁõÛp¿B^­ò6ÚZE¿ØüÚ×ê,²Ä|«BÛ§´µ©ã•qks³³òd²4xWŸ¿ãQ3^õ#U>i4Ú%WßýÝ­,2™L¬ƒ‚¡)wövBbÅáx˜h± Ïù0t£5TH\MÍÚ›^ý"©Çû|Z/.õæ1;BFßúÿe¦+ÍiǤâÃæˆ|‚G[©]íìk×*Š(í·Šò.Lmàþ,Ñì0ñ{«•*5ˆƒ•«7Ÿ2³éÄð, œ|´ý‹´ÿOÿQÜUÝZe;ô®wTúrŸ©éâ9+@¢0/Šm„}=Fc|@©dÉýÍ1èÍýìù…QpªB •åÖñ|wdw{M¿-RºlG"E¾áëa @c*& ©.ô“$A¤Òh4K§ eº\PሱΗçã¤TUÑjÞtÙõÙ÷É>ã ¤²Ì¨òdÈ´ Åàsûv5¿Éè»@´´:v¯ŽÜÖFÐ`‰³ÞÍŽæ&·wŒ5¤©¡j½óÑ5ðm^«\·E³½ÙL¤fèÆ¡FO‡Y©2OJNF—6ËiBaÙÌó#U¥ý…WÌ+8‡‡‡©p8œ€¤[ÛæÚr;³-ê}%vgcRA†UØ´f®Ôæ­!3»°c_ñ<ÔÃÉ,ÝT>ÐËqgóTÝ?oáøDHœn¢˜ªlEGÖ?šZü.]ÓóÍõõuÓªƒ|G‰ïÙä…nЫ_³#ÏÑϘ fggǧüyÊf‘©jçÖØs]ºÛ±”±øÓ™#™@ÈU36wøø!¾CC:Ó_ (ñ@ä¯ é5ÎõÏl°IO´Úù+­rþ©…ÿnaÿ°i‡ ²b†(Bc~[r£óf%zŽQÿPK¼LK ² PK‘Œ28 settings.xmlÝZ[sâ6~ï¯È0}h§C0$Ù]˜„!a„‹I€7a+F‹,¹’‡þúJÆd ˜„•qg§<À`Kßwn>çèÀåן‰DôRñKjðGäˆyzñâü¢œþ"wž(}ùs¹x(|Þ~¾@g› †É¾ŠöÈÐaËC†aËÙ’’ &!WUaq°¤oqorZ<6ÇüŒR ÉU `ø&£dÛ¯àOsMôà[T±dß.ìæ"Âo¡5‰zo#÷RA‘ûÙwh‹&“3géQù e£LüCnâ,? ßTd‘µ ¸Cù¨áýîÑ€kŒ†êRSÈü?ËÂ]Z§˜îŠ˜>؆,£rõ¬ÃÛ•rN™|t4Ÿ›!Ä2£AG¸Å£PèP'S´x ¹qžÌ$56h }XÇÈ^XðE\;ho‘O£EDPŸâÂ])2Pgˆ‘y² “}|®™Þ¥Y”ƒ‡Bº°íÈŒRºfø¬¡»Tì¸ø¸*xhØk¶›ÿûÉ'M“z )é÷áu ‡{…×î*~`ï—<xS¶Å{Å.]¤DÞ/t*hÕ GB»”eÈÑ€„F]2KŠÃá+Çä?Ðc’-5ӊ暨^0‹Ó¢BÏ gŸRêÝ“„Îã€Úšpqsæ°ïv<ÆH^À¡8|^µº°¨hÿÌàÊô}¼qÈ@€ã75$¤¢– …Ñ ½gªòûàϘ Àãú}ÊéLUö0 È>’Õ©§¤j$hIÊ£¶”Qã®­™­GÚ|®ÍéhrÂ'`!i‡"¹•(–>lÄýó»&e3ä8¼º/ý4¯-›Ù á0ÛÊÑ ë: ÿTÓÒlMC`g~£pP­A5ÚÒF¸&λûÓæ¹kpÓqWÏò·@ØúÏÕ\·XÞAFL.}Þ ˆ-‚¬N\-Ífj”.0Ìf<¼IPö"‹ãé&Ç»ƒîÔ$²f3ãŒÐ›H¼×e¤'¸²¨âÈdŒq(ônVãíˆÁBfk' e"¿Ê 2‘j§]Z œ%x»0C«<`pDvfOq¥y`Ž)ðfÉúïÄó¡æ@¨'Û—> Tð  Öybì„`´ÎyÊ뛣«¹V4c„°ÕŠÄ…0$cê¼í„ò.ámÊ›wƒS<&BÏ’8Ñb<(…sè£T)Æi›¹’Å]EƒñÀX|H!_ƒTý‘Êô”z18{oŠÁµ…I¾j¶¨¨ãNö÷7ƒ’›º§IºQׂ¿åp§œqÏrêÕ›ðìçÿ5óï\âƒAšk‘a¶‡g½Mvã@’|6ÁsÃç-,2çOñ\Ú…üñ'.?PK³„ANPK‘Œ28Ÿ.Ä++mimetypePK‘Œ28QConfigurations2/statusbar/PK‘Œ28'‰Configurations2/accelerator/current.xmlPK‘Œ28àConfigurations2/floater/PK‘Œ28Configurations2/popupmenu/PK‘Œ28NConfigurations2/progressbar/PK‘Œ28ˆConfigurations2/menubar/PK‘Œ28¾Configurations2/toolbar/PK‘Œ28ôConfigurations2/images/Bitmaps/PK‘Œ28ÂÈ0J: 1content.xmlPK‘Œ28mý™‰E š styles.xmlPK‘Œ28ø?ÏŽ¿t[meta.xmlPK‘Œ28¼LK ² PThumbnails/thumbnail.pngPK‘Œ28ˆgEæj% §settings.xmlPK‘Œ28³„ANÇ%META-INF/manifest.xmlPKîK'seriation/vignettes/classes.pdf0000644000176200001440000007141714204252545016424 0ustar liggesusers%PDF-1.4 %äüöß 2 0 obj <> stream xœµUKk1 ¾Ï¯ð90SÙòc ƒaw³)ä–f ‡Ò[›„°)4—üýJ²ç•™n¡lâÕ燤ﳬ@£Õ[õ[ª¡1Ê× Òíןêë•úUiÅßëc°‰Jk×xõRiÓØN*§Étk”7Î]œÔSõpUâïËgÉáþn)Øóĺ¯î$DfßWº%–ÚDûêÓ Ñ$ëá[:Õ®##& Xp©fÃ$”¹> stream xœí| `Ušÿ{õUu’JºÓ“’T@›$rI7I!‰Is©h:ÝÒt·Ý"£(î¬ëŒ£«®#ƒxpÈ £  °Š Ž3*ˆŠÎŒÇ̸âîìnd\]'BñÿÞ«êt'DÀãÿÿoŠT½zÇwü¾ã}õ@#¡n/I!+ ›»Ë´¾¤’²Ÿšæ^Q’Æïúlÿ™ÁÙ\Üu<@æ"ŽÃ9[w.o=ËÖŽï8ž|¸ÃëòÜh1šó^ß•ª?ßáû]‘kíÉŸÌ%Ä¢à{SgÀíúsá†øÄ÷ »\׳/ðý~|Wü®.oîÇŽEøþ4!SMÁ@8r9yì! ûÙx0ä ^±¶­ß{ Ixû(^ì'›ö.€(“ää£)ÕlIK'ÿ_ýÐv:–¶“§É¿c{*Ù@ú €xµc/{n¡NÒ‹ãm8ó&ñfêÄg—¸‘8~£xIt,i#×`«DÜHŸ&»ÉG¸ú&z»4SºœÍ挭ϥé'ÒDa"Y v‰SÅíâMâvœÑ-¶‹7‘mxŸ(¼.Þ/^'¾&^G0Éh=ûer5t-&k„5´†æÐáyžË?®¡“¥W¥WÉ[ä-Ú„3·A¦/ÑOi9]@·ãªÏÉç´ßª„*z„þJ¼š¼ $™¬!wÐ4|{š@¹?"Ÿ’°ˆTÉÒ[ÂEÒ[äEòùö²„ xσ1Ò[x}B6“%ˆÌTÞ2d$Ší¤—þPØ$|A‹©€W-@4¯‚b«ø’øcEtÐåÆBLÇû•l†ô]ƒR|`h§Ëq»®C>½Â‹Â.ÔñYò>ê…Ü…+…ë„5ä}úÝr3}LlMhsÉÃq9°!¯ &ŽÇOÈO “ÏEùêi«¸™!FJ¤ç1 fÒÈ*:+ᇨ ä:’£¯P"=¯]8+ÑGV‰#áA”]VDq£ËÉa"´‘ûùu7ÝEî&»H˜ (}2Á ‰ PbUÌÛ„’:Ï6Ûe ”—ޱzUÌ Ê6Ҵ͸\ÙuâDÓ1WZ¸M± J·‰%Åœjðƒ1ÖÙM ”]t”£F'ëh­ÁΖØdoØýŽ>Ƹn“JðO]ë6ÅÝ¡Üj¾µxÒ­fï¤1ÌÓÕUb»´3\)xšˆ´a0ÐÒ'h¢ôcA$å{õ^L̇zõV¤[ -%…–Âv‘ Cî±ÔU ¦/> Fó`"KN|(¶¡ýF’÷l6cŠ`JŸ_Ï3Œ$Êã òKääü1“짇Čý™‡†­µˆkKöYVÊ—“ rHKn³)#¡©hÎ(ó±^d}Ø’6P‚ÃG{ÍêgGÌŸIËžXº&˜M[²'ê…EÛ“)]d»*))INJNNI6&¥JÅÃS†‡›†¥ZË’Êä²ä²”2ãhebâä¤ÉòääI)“Œ³“fɳ’g¥Ì4ö¤ôw'îNÚ-ïNÞ²ÛXb2˜L‰¦$“lLž`œ6úêÑI‹È"j)£ÅE†ÌŒ¬*fefˆ…E¥#-ùtlåøªq¥å´ŒV?¶2KÌ¿}u»{¶kMVýBí |¼béß’º®i}îè1÷;âTõ“ŠŠ±U•%'¯{tÇÎâbj7nÒÄŠrcbþ†Ÿoß’ÏrÇ‚J²È<4—TÛ IæïiÒþÄCÒÚú»akÓö¥¬‘›)$fI`L<¡;Ú»‘Ó`;lV1™X±³¶×2e® ºèk…™—¢˜YÙÐ[¾¨üÖ{Ô5´Ý±cEÚ…£ <+ó—??~LlÝå÷‚Äø5O$ê»èǦ„ŠD(ßËÜv*[…þŠcÏ>Ë2©:Oº å3“d²-/{=9h²¬—&î3­¦„yç'Û2DbÌyˆceåQæþ‡£€½æÃG*v6æ·æ#†%ýò1üŠ‹JÓ¹Gh> ¤1Ygíì~Êêç¯uïܾîºpxùò Çwäm‹Ô'Õãx=¹&übíÚ_l^·n3êðîÓ;Q¶â³ÎÍLKˆbH–ú®r°öå@2ÒR†™Æ´™¹Æ:åpo%;c¤‚ÚR FVŒl¹rä#™°ˆrˆÚ—¢ÛrÀ6oÄ™@Ü]³'øü>u5¥3Ú‚ºÚÖ¼8ˆ¯Ó]Ù›:ºŽ|x|ž0Ó8bxÏÒÍk¿#ÌܽôÿƒØºñêÖ æëÐ b+ÉAäsSДw3f¯6Ói¤§-µ‚‘˜‡sÿ­ÔT8\‰À[0TìlÍ]™‹ÈcÊÌël-䘔UèÈE¥ëh‡`²dÕ–WÒvuÍeÿÜõ«t§°%x…úqÙ-=¹Å¥[îF¹nCÛ¢#Lž\ôÕÒƒ$tÙ†›¤ÄTXo¡;×919IHB'0§™œÀ³·™WÌÞfa·4爷‰á=eï±){÷¦±U¾·÷è6zØ42-mûjNµ4 MДÙ*´‚–@PdKFÖdl•VYŠ-c-ÂXzzÇ¥WîRúåöíÒƒê 'ˆZÒ0áùå!ú.îF—=ˆ¿F‘ÑK°]˜d 9Éäì× kM-Êþ‚WG¬-Æ„šBгa˜1ɘ<µŒ“KY>ET™x×£Ç0¡þë‘ÏLLãag«/9U™Z8mäeNá"eQ¡_ñÞ ÜPy›r[áÊ…[•­…Ï(ÏfVæWTçÛ Zò› Üù­7ç¯,¸;ÿ΂ ùë ¶ço+0/Â, ˆ©´$j¡ªqŽºz–" ‚×\q™÷VêS6sçMý¦Ò¢7ÿáÿ™þK‹#ý¢~VÍœ»ºFßrü¦Mí‹^Ýðë]#æ6–•Qˈ¼¿rL0çi† ¾‡¶™ ï“âC‚D"1'šMá]ªÂ–Ô”ÔšLZ™$¢r3na¾Â~ÅÖ/×2Ô÷¢8K#çd’MÆØÒ ëÓÈú”}i«‡%MO­‡é™“‡™Y éÓ‘Š'&¤OË©M‡8½QOˆfW¼ Ï÷¬XÑÓ}ýõÝ´:Ô=êŸÔ?ªOÑZ¸îÑõëe¿”¨/«½x½L/¡x]ÒŸS¥4”%›TÙ†¡RT~7í`æ>óÅx©µ©f&ÏUåSÇ"&geË÷?†ôÈÁ‰UJSWÍ™31^—=ááá‘ãóô¾»üËGn½—Ç/†É•ê É$.ÇÌ9ŠÌ¶•ŽÀÎÜŸu(gmZÞú”ƒIûŒ;Š×§½CBi 1šl™ÊtÃäÑQ¿c>w¸—§QÜÆÙ¶Ž¹ôÂÖ Y.e¾AªÆ–ì« b±âáÜ4k{÷õ(M9н}íPUŸöíu_µóŠm{×_^ý³mWÒê¾/©ýJ÷¦cõSõC¥f¯Z³ W­Y»ñžUÓÄ4s‘¼i y¢$ yX̲¬€ò° *€üI2HXÎI"I0Ú¹ ‹öf³ê­Ôëéãs¢þ+}¼°ˆÚ®g¿/E¨lÂ<¡]X)Ü)¬¶é×sxÄëÏüú¯ ¿%Œ cu”NGÀp±”\@/‚Ñâx2ŽN„‰bEâ 2ƒÖAØšx­áú#¸Eú‘aV±÷½â=ÒÃfx‚>`†I/LB'+,À„lšE«µjØz¬ _®Ó|Šå‘*ô©ܧ‡ózÌ´ßxH^o×gcúž0ÝH2&c*Þ[urVE|†;àÕ¹7ær¯Š–AK Ü-ªêîn\õðëœ?³9·ÎW_W¡óhù‚G±Þy¯²âñx¼òbõÝ‚:fâ5¡ ÎÏ1ŽûùCCûyïWû¹å+üüÞ»£~nÈ8¾Yst—OòŸ$¡UˆY4³X/ç)Dj•‚ÒJIO!<}2þÖ«é0Z˜(ðûÈBfØF™ÉrR‚ˆrJ"H?·¤˜îOKL‘!É` I““Œ†4ó¡){+ßÃßlLÅÌ·ÌG÷Vâ¾giB nÒÈ1t‚„;E‰hPŸ ³êÕ¨Ûëi¿=BçˆÏo}ìö]êfº`×ím½ý º@Ýü— Õ©xh꼇·^:å3RÈ?I_¬º}KìKXÍK؉S’û8Æj¤KÍ‹ÿ\ôùœ_Àíâ‹d‰ÔEÀ§d‹ˆÒn²%qyDÚNÖÁ›$Wj' „gÉéF²û¶àø•Â+8o)ŸÕúظXNØgD)yƒŽ¢z-ý0^¸Aø=´Ámð†˜%^×1i†t«´YúT—&×ú¶™Ø˜ôŒ㓉2÷̨̫û姘ÓWëmç=¤·)<¬·qã Oêm‰¤—ô¶¤’7õv"Úø_ôv2_ÿ­·iP³Þ6‘qé[õ¶™$§ ·-DLïEŽTLB*Ò?ÑÛ”de*z[ ‰™ãõ6%óR½-bû*½-‘a™7èmÉÏ\¥·IQæN½L&e¾­·%“²ÌzÛD:&ÏÒÛf’5y»Þ¶ÄÉ/W‚ËC¾Åe”{´R‰)JÛreº/Ž„¼®.«Rçw—)öÎN¥™Í +ÍÞ°7´Ìë)“OZ:ž-uº–u- ø+Ó]§XXã]âš×_¨.ÿboXq…¼ŠÏ¯»Û:}nÅèrùüÑ9-.xz Ó÷ª õ>Ï û~¥²ìâ‰Ú7µ=àG!"¨SG$œT^îÁþeÝeá@wÈím„{ËüÞÈ >‰Ä”êÇAöz•6og gt™r ”)µËƒaÅ× „"^Ò t)öw™.J”¬[,ž,Ǹ£z.E­uyÌiä“ísƦUqö…e— ¹<Þ.Wh©hLE–›¼¡._˜ÛÀV:¼!/òZrùQu+êŽjá2D q¶*‘€âò/W‚h5\h‹ b>„À¥¸QhgF:¼QœÜî@W§³ ‘¤Ž({ýaD¯ˆCR4‰yW8pû\ÈOöÜÝ]^Äaò´û:ÑH£E¾@i ´Gzþ¢Ñ\’7 xºÝ^NÆãCÅ|mÝ/“A°ÀŠfvwv{˜$=¾HG ;‚ÂtùtFŒCHƒÉv‡q>SǪty™Ö2wp‡5އ•ñ,„”°퀳}(ª®þ ÖL8$d@Gd :Ψ§ë¤Ì íÝ!?2ôò…ž€X•pwÛ¯;Âz˜~íNt6¦;à÷ø˜áI²ìDr®¶À2/×@ó".@¿ø4CXëeV Æ<@S®ÎN¹Í«£†b`”¸èð£_„”®@È;¤ÚJdyÐÛîBFešPG»\Ë1Zp¹Ç×îcŽæêŒ ëa‰º<®¹ PWåêît…dÆÈã ûû¹‹µXÅEÌC]n$f+¢ò„sb$edÀsuM@_•#F Åów.W|qn.3uB^vØÏç²F˜Éì /úœ7ÄõBž°RÔ‡EŒwt@.ba[Ä!CËÔëñÒæÅHbT»Ñ “e_¿`Þk#1Š+ÄðrµuzÙ€¦;Rf 9f”WDép…‘¢×?æu1ïö(Ý~.pLT™ §ix:«†1ycTs³1#¹”N–=0V¢ƒ.÷R×bT ãЙ«~=§À ŠèílgBÍt(3œJKã ç|{³C©kQššçÕÕ8j”"{ ¾Y•ùuΙs Îh¶78*3{ÃBev]CUq,hjv´´ÈÍJÝœ¦ú:öÕ5T×Ï­©k¨U¦ãº†F§R_7§Î‰D|©NªÎшÍq4WÏÄWûôºú:çB«<£ÎÙ€4Q¸fÅ®4Ù›uÕsëíÍJÓÜæ¦ÆÒ¨A² u 3š‘‹cŽ•@BÕM ›ëjg:­¸È‰VÙÙl¯q̱7϶*H¬UnVø”2”i(ŽylqËL{}½2½ÎÙâlvØç°¹ Ú†Æ9yFã܆»³®±A™î@UìÓëšl¨Ju½½nŽU©±Ï±×2u¢LØ4M2[Pëhp4Ûë­JK“£ºŽ5ǺfGµ“ÏDì‰z.nucC‹ã²¹Øó¢,¬òü™Î°ãŸj.W¿ÕetœÍÎ~Qæ×µ8¬Š½¹®…YdFs#ŠËìÙ8ƒ{À\Ä“¯A——Ùˆõì8‹­Ö¬qØë‘` ;äsÑ»׺½Áóm=¸µÔÈÓ¨–;­Ükµ$€.\ëÇÀÕúx·%Œ,¾ëhÙ-¶a³íت¥^ž>лq'ÒR¯g™3`˜¥’@H°dÒã óHÇ-°+ íyJØÕ‰Ìp‹"> s¥«—…ûÅPrt3 †|¸¤'ä‹`2Q\ÝØòý@߆Cú6Å5Pb0.±ä Éò†ƒ¸Kù–y;——áÜÛ˸$>?Öj]ºê>wdR´Tˆ(‹9qO "cEW¦È2¯¸Î¹t:ÓÒöüÔA²V)gSɱ:H9Ë:H>¹Ò“¼›S G÷Œ! ÔXÁ"ŸK­¤Dk%ùûQ+Éš¾±ZIÖöœj%ù<ÖJr¬VRβV’ÔgQ+ɧª•”3¯•ä¸Z)>|”K¸Ÿc’8_å’¬—KÊ9•Kòqùwãù.™d@9ç’I>¯%“¬—LÊÙ—Lòà’I9›’I²dR¾NÉ$;íóæÌjdbÛgžUu$Ç4?—êHŽVGʹTGr|u¤œUu$Y)çR1g(ý…|ÊÂGù…|úÂG9ƒÂGæ…ÏÀÚá« šHt¾ r>ÊN{rUÞã[ê+÷a¹¶,Ø,×ÓØ ƒ4RM$H–“ñ‘ŤƒDˆBF7ÏJR×Xlµá …LÇ9Æßñé"Vì­#~œ_†-;éÄK!Íý´ÂüÍ‹O/®Y†wΔπëø~®Nä´ y-Á5~œÍäpᚯDZ[KpÝ<Ò3Ü8×Å©yù ×HA*~¼qNÒõá<×»‹ ¦Ó©„Q¢Î÷œbT9ãñy\ê0ò pI*Qö‹ÉÄ뢫Ɯ‚j;_«!Ñíĉ ^“H9^}þ2œ_†óø ¡®^¾6ÄQ)C^\3#ŽZ¥¨¥Nö6Æ÷rëyQºéÁ¹ÌVçÇŒR-Ž,Ç9|¥Ç‚\î·6C ÄW0ÿ`T— Be°1ëàa§ÒFÆk(Ý5ë¹°Úɾ.£íÎþ’Ï(~ÎÔmï˜Î>‘y+Â{˜—uq¬—b_-ðU²0Íš8½.N->.Sóêz-æ\üºÕ­ºÝ5kiÜ4ÓüÙÊå pëûùú k‡Rè>æÓ½ÀÅihHË:Í—b°?¹ù<æ‡õ(6[“]óe/\Í÷Šâ¼¤ˆ[Ž­õðg˜ËåÆ5.]?™G=´‹S‰ð‘(>íØêÔ#iT¿Œ1,×0ù#迚÷3Ž1LXOG9¸ùê¨4®A„ûZŽFø¨ÆC> «Ín”¬›SÑ0éá>ÐÁ³NDG¦‹÷ÅkÕ!4À+5i»9†Ö8ë°v·§fk9.ƒ„qµõzXûõ,çDᔵxÐhûtTZÿôZG‘Ó¤ ö{t„Ëóº˜F=®3â†vžµýº†Þ8Ž~g<¬üÉX‚3Üœž6'j¿v¾‡h™-j!7çíáûtI'ñètêÒ¹b€g†˜ âsQ “3çGôh˜•bñ9 ~ÂuvqÉež›úš††¶—¸NcÏßåÝö]üËgb‹߉ØÎéÒ5*€ÔéÖ2L–ë{‹ÆaÞÎeôèžÔÉý4ÔߣIÊ0õÄÙ<Þë¢;¨‹ïˆ>ž3:ù›Ü¯‘‡KÊìåCcñ€}UãÍ¡.î=šïFy Æ'ü•:E¥”u bæâ6:s òŒÇP²Yu{wòu¾Sds¹ß:!žg]<¯ÄèF{Âý—Á»‡WÏs^®E”S×ÊÃ× ±õë=x…ŒcÑݶ(ÎË´˜©´¿´ñxÄÉÚ­ÇAÔO–á¨oļäZ޳_ä ^ÚîåâÕÛ¿"ÞîšÌÑyÈHéà^áϰ.£—{Ò©ü$šë†Êݾø¹Ýãñ U9¹xžm¬†õÊ[Ñ5‰F[4’XåÐÙ_{„ô)¹G/ÅûbÝbÚ~ȼJîϪßd¦:µVmzŒDôý°½©™ÄÁù4’|c|ñÍIæcÙÌÇê°OÁ:®Gæá[ öÖp»Øù/âÑ8ÛŒb#™Ëii4šñÎh/ÄF[áïìm6Îo@Zl­ƒ,à<H­%kÄ6£={ëñéÐç±ÕØ3ßY»–°*Tã×€«œjGÚuœ“ßÊë#ÖnÐåÔkæÔFŒ2£YÕó7Ö;ŸM8¯…ãiç:kÒ6pfฦ‹ƒK YB“¨ŸMțͨE¹œÆÉ©Ï´r;2}jøzÆu6Ÿ¥IÖ¨[™µcTÊt,59þóú9·pýëñR¸þNìqrÛØ‘~”nÔwj9&·ÌјËõ³s9‡é|C‘áYßïqÍqV©æx1»1Ék8';G¤eHM¢Ôâ­3”wÈýj¹~ŽT=ŸÝ‚8:p~]æu\×jk¦æ÷šOÔÇ¡[Íud–½ ¹:tŸ²sìjÁì4ŸËÓB³€]¿WÇa³~ƒnݨZõƪ-wkßDñU¯‡×çZ î¯J¼ ôW&=|4¶§õ³“À€ï<ÆÙÅ÷~k?¯è^£¥Õ•.^-0ná!Ð<õ%Ÿôeäû½Æ¥‡·#zeÂôëÖç²þ úŽžÿœleHDuªrˆÇ?ÄíÔ¿¥|aVO–étC$ú]Ä! «u ²zÌûµIdð©Ã`qœä޵L´3:ÆSæù*zÆõÝŸ:ïSÛïÓy<àÍyÁ·s®$“¯{®û[§óy®‹·çJ§Ú}O}º¤}Ÿk•Ä÷ítI&O—†>ÝøvN—äÓ «Ä!øý>e’¹\Í|û§Lò÷ø”ItÊûÖý6O™ä¯ò9øœüÍvv'>r܉ÏéÎÎÇ Mä$ú6;i9öVvÿ檜ã²˹l^5•ñú5ˆ}«±Óÿ‹4öß7óŸ’ËÉ?ö¿VÒR¢ %Ä‚÷ h!Ê,Ñ H¾“,¼é}E|kUøxÙƒ÷|ä4Ž 9xÏ%ùxÎ{rø}¿gó{¿gÒ bBª™üµ¦óv¿§RYã©üµi ¹ ûŒ¼ÏHž#"M¡É˜3$>”ýûDšLeRŠ}lðnÃ>Ö4‰¯Lä÷’Âïl…aûÏÊ${:5p½$~ù,à ¼‡ò;±X'.U…c_Z¥c*|i…>þöE­ô·ðE-üO|®Âg*Uá¿÷À§*ü— Ÿ¨ð×|8¢Âǽ²ô± ½2ôÚÄÿüYúÏJøþ½þrW–ôþ­þµ>—T8¬Â‡*ü‹ ¨ðgþ¤Âûàý÷†Iï{à½aðîº|é]¼ó‡é>øC üþõé÷}ð»·3¤ßeÁÛo™¥·3à-3z3Y:¤À›ÉðÎx£^Gú¯—ÀÁŸ¦H‹áµßfH¯•Âo¤I¿Í€i°‡÷çÁ«°ï•=Ò>^yy‘ôÊxe¥ø²íÄK%ÒË‹àe›øR üF…_{`ïfi¯ /Ž€Tx^…ç~5Iz®~µ5WúÕ$xö™áÒ³•ðÌÓé™áðôžTéi ìÙ"íI…Ý)ð2{J…]*<™ O¤Á?«°S…*lφ_æÀ¶,xé<Þáã±>ØŠó·æÂ|lYªðH)üB…Í*<¬Â&~.ÃFÚ`’Raƒ 6ØÄõÔú>X‡KÖåÃZ|¬íƒQùGÀ*Üßé~î[³HºoÜ·R\sG‰´f¬±‰÷ª°½cµ ?+ƒU¸pU¾í܃KïQà§)p7vÝ=þ ÿ¤Â]ˆÃ]Yp§î(TávnSá'*ܪÂUøÑ-%ÒT¸¥þA…›UøûJøá*ø;nRaeÜ(à *¬Páz®ëƒôÁrz–m’zTX¶ º#¹RwDr!Ü¡p Á€U XÁß]}ÐÙKUX¢‚O…wŠÔQ ‹Uh¯¯G–¼*xdðØDw›,¹S MWk¦äZ­Ô"µfÂÕ2\¥Â"®Ä÷+U¸âò\é .Ç·Ësa¡ ú`¾ óðÝvbž sUpæCK4_–#5÷Áe8pY45æHM}ÐØ`‘s Ásò¡~v†TŸ ³gY¤Ù0«Î$Ͳ@ föAíŒ ©6fd€£jªMRM*T›`º½DšÞv¤i/Û´Tɦ´KMÒ´T¸ÔS§¥©Y0Å“=0I…‰p‰ Òa|Õpi| T˪†CÕsâ8Ù(Ë€q+ű•)ÒØ k+SàâŠMÒÅ*T ýŠMPžeé0Æ:IÓÖÌÉ: .òÀ…­Â¨L™m‘FæC©%ùpA1pÑùPl"b”Šú 0 m¢’2äçCÞˆ)¯F¤¦K#r`Ä.Ìw‰¹Fž3[¾riÎl¦B¶²[Vdb_f dx Ýi*XðÝ¢‚Ù©&³”š©Ï‰&3˜VŠF1öAJ%$£jÉY¼R” ÛÄ$UHPÁ É’AIÉ&Š}p• bö2JÔÄtõÜ|;½èÿò] ð þä‘ÿ•Ãé endstream endobj 6 0 obj 8718 endobj 7 0 obj <> endobj 8 0 obj <> stream xœ]‘Ënƒ0E÷|…—é"Â& BJIXô¡Ò~±‡ÔR1–qü}=ž´•ºyÜa¸“Öí©5Ú§¯n’x6h£ÌÓÍI`¸j“ˆŒ)-ý=Šo9ö6Iƒ¶[fck†©,“ô-Ôfï¶:ªéIúâ8m®lõQw!înÖ~ÁÆ3žTS0„9O½}îGH£jݪPÖ~YÉ_Ãûbe1´Šœ̶—àzs…¤ä¼beÓT õ¯& ’\ùÙ»Ð*B+çûM8‹œï7”Ï·‘w òŽò9§þòžòQ{ Þ"Ô#Äò#qœYŸ‘OÄ{äsä,~«¡™y`Á©w´~@¾ï_#ÓþÙ1špÿ[´ïõc3“7ç‚Åñ¨Ñ[tUø½»,ªâó fÝ—Ð endstream endobj 9 0 obj <> endobj 10 0 obj <> stream xœí| t[Õµè¹÷Ü+YG²,ÙòœØW²œ¢ØÆ™°"Å–ã[™H–5Ør¬!’ìL MHÇÔ@¡JCJË”—Ÿ¶úøá‘ÿ -tø„×Ò-‹týõZÃãñC?ß$7Ÿs¯;N’0¼õ¾Ý{ιûìyï³ïNV±Q?2 ­#‡7ä‰ÖH¡Wâr½c iן⿇ñŸàw( ½öñýo!„wÌmƒ#?œûÐë uöù=¾­ÚÕ™ŽÂóC°p§¼M‹yÌ+‡B‰ ?Ðüª æ˜_>ñz)z!æ_‡¹òlˆ¾-¶ 0ÎÞ¿âÿx̆ÐÛ£‘xân·ŒP7Ý/EcþèÇó~„ĵ°ÆÁ—~ 0ÔÐ9Q£ÍÒ½!Ûˆþ+~¸ ®– ps¹úú7¶ršÀ—¡‹a5À¹Ñ8·Û"¼&¸Ÿ¡çПa}·S³ZÓ þvÖr£Âqá5ô&ºv ã®öu ]ü.®™+æšù׸]Üeâ/Å_¢7Ð\z¾ëy{Wpû¸ ô7ô7®fóùù|)÷¿¸¹è>ô[¼BµP\@âÜv´ƒ¿X|½„ÞE¿ƒu„†9®3ññ ø~ˆGÃh½Ëñâ‹Ö*øOÐ8¿‡ÿ$äá›Ë•ãrt-~Mè^n¹@p€¹¸/†ëj v¡w5n#ÀÐïf 0οÄà_Co÷@•_Íoæw¡·¹§¹ç¸\X¹‘{Z³KX> £ß2i{˜´·¡Û úwpýÂãèE€­_´j¯Òä¢ÜUÚíx!¬nF?GsH|QùD–f&Ú òü–¤6ÐkÜF¾=ˆЃènî:€âYÊÿ‰F0Ï!»dÚËWµùö:®^!½²Ò:Ç>e*™´Ò^Ô³7{£tàäÉžB©¸r¯8c/®ÊÚ+TU¼{º‡ïα·÷¬öþÉÕ¬buõ7ÃZß Ò,ú«yB< È;…€¸2†•8 Â;Hó—%^Í ¨öÐáñKéðøáñº<³Õ\e5[:Ç¥Çÿ,ïÔ?ù(¦™ 1j9ùž°´ÚíhÈ6ðF½P^–¥ãµD(+/k$ú²r³Ü•_Ñ ÝÅÝ' Ví0÷W—‘r}©–C¥v£ök¶jÓáö½Äݾ7Ͻª}¯Î½jųÈvòà¥+üÁƒæÜø7G?6n’?þ ·°¡dÒšŒï› ´ìºÒÆ9Ê‚ºa2¬..–†­Úþ¼~K~Adö˜e,_»­áp WaÓä[ ʹ2.ß"Xm³.Ê+ãæÖ/˜?oV-WÃÍŸWi­/6ÏþfÍpÜq­óͧå_ÉïÇ?ܲÀóvb]ÌásÜÍ•rÚø…+ä¿ÔÏ[8·¬Òb¨¹kÛKG*+¹â†Æó*«ó ÕÞúü/ÊÕóU'ßËAG3AKKÕ¨ìAÎp—þ¾¬ÁîÊÁ¢9ýÕˆ+Õ_TÆcÑ ·õ¥¢17»Útlüð¡qsGUÀ0~Ô$ûÀôAC§µZ¨ÀùB¬*¤Êùó,\P9·^È·hª®Af¤Z1Ëpü9~ûöuŸÞºp»|â&yB~oÕòA®ü™÷8½^~ãþÞàÝñšM¡&4ÒÜ$ÿ¥®ö£··þ‡oÃ×?z­ze$»4»çÚxl½Î‡Õ ‡}۱벑ÇQ—†×È:]V£Ù¨×aá›;t›´z¢Õ QgÖÍÊÊÎ5;ú*Ès ªc2SÁ̪-Å÷µâû`M‘Ù¦+mû$3Ç­qTHHâ$£”#™ÈÁ9ŒŽ‡ÉaîGý\¿±?§ßÔo6¯á˜aµØšgÕ^ ö,(fV]3ï–Kùþ?pCµ¾qC^׿ìÝsâ¸Ðpx Ð$zr\ž)Xä#¦#N@¼`:ü*õþWë¸|ë|Áòéïå#/¼@m °ËÄaÐA*G;ÅE|I¡ˆù|ÎR bˆmçæñfŠáµ>K„>iD%fÑ‚K‚fK0 B€{o’ ‹Ï´ê±ÄK¦·Ž{72[k›>  ÊÍÔª3ÓTzÄ"`_ôU…­œªð­ô2‹³©¾^Á½—ïãæpCÖÞýkÿé­Î%«þ¼=þ=Îyë3Þ7ï½îÑû5d÷Àš½í˜ïúÖà…'_]üôP`-R|@ûGÿbtÒ±A*/›9£´¤8ËZ$æäŠ@1/×lÊ1fgåÑéBt6±¢²¢\âˬbeEõEüìYp¯+++­EùÙA³*u¤,÷áÙxGå&[©²YK‹ 5•:M¶ž>Í/È!UHSE*+²í¦c‡?<žÛ@½‡Æ½2¯ºüò£Ç.¯‡y›)zKi/ù˘* 4å2‡3ñ&lL¢IcÒš²L:1éMS¶ÉhÊ1™LæÚ9àp) ƒÏ-\ †ŒS¡—öEQè{=¶ó)îFùÞu¸dÑ‚Áå#ò½ñÕ ½ß™9Â<Ôê~a0±ï ?vgYç%'–ñKr¾^±ÐñÇN¼É/iï,¸tÑ3÷žxSèß}]ÿzj‹ÍWâB?*F¿utæåò³˜c4‰9 }јc$zÞ@'YZ8vD8‡x‘ãP£sæÄé¶ôgs›rP¡)Û Á¼ÆÌåÌ2rU…%4ëÜ4'C>ÖÓ‹^²éÅH/&zÉ¡3½äÒKËÛ…JÞ>j7Îe^Œ&1j‘”9Ҫϰ‡jn_])·¦”³b#§æ·<+¶.d~ 9î¶íÜà:ƒ¡Åy¤l„|S¾×ºúÑûÏâöóOžx¶¡§pQË“÷ó}úÈnOÿ£÷TtÑG+ wåŠß]Ýë¸ROt A-ÅA,¶pðCbq±¥Ñ"êóq°Û¤¢ì‚’â¢|‹1Û Ï‚“›CFÞl.1R+½*tû^KJÊÙe¦:0¤  84®ød¦;j3¼ŽÛ7;Ÿƒ£ ¤Td¾ ÆLÖ…yysóøw¯àÂsåo¯ðKž+¿þè4šÕ{/Ùw¥ø]ùŸO"y–©€ÔTŸDÿ°u†ÃʲäJzîTÀÙ §3"­ÿÛáe±*–ÃSÈÁ ü'p×fñ¨7èM9¼Ù Ù¢Á oÔiP±­ÐhÐèÑÎÂ{4ƒæŠ»lw–΂ìe(.¥Ê2ÎÀ³+° g[ì&8° «C,&s<Íaû AIcgÈdS®Š—Ùh(^:×Zgk²:l}Ö›×Úo»Çz§m·õÛ~ë^›q¾­±¢±²½¢½rUŪʵk+¨x ò‰Š'*³éaŸLz‹¸ª´UZç.L…h^2ˆùGoºåêÖð=ÅYÜö-ò®²‡â?ϵs—¾vß²9òÏ‚è_¯ÿ¿é¸Oú®¾¢åƳo>±mïºÇnÿ×÷f â⦚Π‡êc¶#OÌGAÃŽüþ25g6¶e—A™ql\).LÔí‹–öÌ㳂B %†M-10ºm¿g ü\Ù5Ëò_žø?ò{«—ù¸|¼ùøKч‚aÉG¾ñïÞ± ò‘ëÿ×ؠœâeÀK1ºÛÑ¥d¥tRJ¦,ä,ã¤d–‘®välÊæÒé*rU¤¬ì¨+h–J‰GOM9§9”c³”cñ7]êÙÅÙ7Ê÷¯3d·:#—«¹ÚûJèÇuüh–nè.t´´¿ŽV€ö*ø`þ t¬-¢m ¨öÛÐ~®ˆû&·‹/áÿ„Çð‡ÂÓÂGâ¥â^Is ã;ÙÏhñÈ„P"®.iZ)›Sy¹Oá˜]õ0ãÔ]ô}uŒQzF 0~Y‹óGu¬Aè¯ê8 A!­Ž!ÀÛ°2ÎÎ}ˆ«UÇF4/ïUulBzK’32Xô@‘t°Tg)TÇ*ÈoUÇ<*Ê_£Ž1ªËUÇŒSÇ"À¼¡Ž5Èžÿ¾:ÎB¶‚bu¬G—©ãìªÆ‚$#ºìulB—'y0£¢Ëç4E¢cÁÁ¡„Tí-Õ×ÕÍ•6J‹ƒ‰x"æ÷„ìR[Ø[#9GF¤^ —zýqlÌï«!§l]@·º=c¡áHxPZì:ÍÆfÿ°gÙ¨äò„ýqÉóKÁ° z%_$ä †“0}žp|qdÄ'uÃÃu£þŒeélÖ—ùcñ`$,Õ×\Ò ÀP9dòÎ@$ <&@ä¡D"ÚX[ëƒõ±Ñšxd4æõ"±AMØŸha`”c*sJMRuÜï—ü#‘õ³k¤³¯FjÙŠKÁP4Kø}R  IΘLe%IƒésTÑg&BÒÔAJ¤°–2 ™sÆ9Õ|gmyi å`œx¤DÌãó‡<±µR$0 !=þX(g¦Æ¥!Ì´cž0ˆnÙA,Ø=Û¥DDò„7JQ0lˆ $@cAPGòÓ Cþ¤ž¼ÞH( à 1ØAËþp´gc*±Íd>ÉG¼AÐ#¾ˆw4ä'< ÊO 8Fª¦Ù©/H¬õÛf3Nbþh,âõú_ Œ&ü”2iƒÌìõQNÖC‘Ñ0 ª„(…˜¢J@;x*Ž] ù©Ô„9H|ÈžAÃNiÖFbRÜvè °ªŠ?…4eÐF©¢DQ#´~ë” Ô ÑXúÙF_DŠGìR|t`ØïMÐ*_ 2ÎFòF¾ •#ÞHˆÐy"c~&âEŒ”„# 0C\Y¥V‰¦=@y&Ň<##dÀ¯j Ø€(ñL’3¿ˆI¡HÌ?­ØRbcÔð¡…©ÉOCž-°Ý ©£yFàz0¤ŸI®¨Ž¨'|Žxb„òùãÁÁ0ccP‰UØD=Ôã$qº#ÉO|*%Š’¦0ÏÈôÔ=I>ÒØ€½ðÈF)˜á愊óÓ¿ `°t§Š¤vI†‡|Îc›ÖGb¾¸dKÅ¡ÒN> 6¶6¦2°L‡/~ˆ$Šul@u2 ¦óoH@ÄHžhÂË30â§Ù3´Q†< iÈŒþð$P¯K{·O ûT†Ó¬Æœ"ᙬ§iˆP³Q#y¤š= V’€Qw­gƒ8 GuÕÏæT“HAÂý#ÊÔ—ÔÒÝå–úº[Ü˽.©­Oêéí^ÖÖìj–lÎ>˜ÛìÒò6÷’î¥n z]î•Rw‹äìZ)µ·u5Û%׊ž^W_éî•Ú:{:Ú\°ÖÖÕÔ±´¹­«UZ ûººÝRG[g›º»ÙVU›«"ëtõ6-©sq[G›{¥´´¹»'0×+9¥g¯»­ii‡³WêYÚÛÓÝçÍ€¶«­«¥¨¸:]  jêîYÙÛÖºÄm‡MnX´w¯³ÙÕéìm·K€¬Dî•H p 8$×2º¹o‰³£CZÜæîs÷ºœ–j§µ«»ÓEZº—v5;ÝmÝ]Òbˆâ\ÜáRxQš:œmv©ÙÙél¥â$‰P0Eœ´:ÝÐêêrõ:;ìR_«©@m½®&7ƒ݃&:»MÝ]}®«—ÂÀ%IØÉò%.FpŸ&Æ¿ Ä¥xÜݽî+ËÛú\vÉÙÛÖG-ÒÒÛ ìR{v·0X ú¤ÆëRù¥6¢k§z@Ñݪ€Í.g ì£lÀ™ ÞåÚàõGÔ·ÕàVR#K£Jî´3¯U’¸pkWYcC8– ²Ø©£d·ôMc»’zYúHI½¾1?dÀ8M%‘‰Ðd²>g‘G`(¢œyRÜ3Ä`"¹Ò3Ûâ)6'I†ÑX¶¬L$Ï(¬Æ‚›Ôc8¦SL)-¥’N ÿ1< §TpÌ?²±`cô,cœÃP«…TÑ™ú¼‰Æd©r_$A ¢«‘a×y—Ng[ù^˜:ˆ(ut.uI×AÒ9ÖAäÔ:HMò^†)ž<3¦)PÓ 9ŸZIJÖJä«Q+ÅŸ[­D”€=¯Z‰\ÀZ‰¤k%ék%2©.8‡Z‰œ®V’ξV"µRføN*—à<‡$q¡Ê%¢–KÒy•Kd»ì½ñB—L$‘λd"´d"jÉ${ÉD¦–LÒ¹”LdÚ’Iú,%q;—u^ÕMÙv.9§êˆ¤%?Ÿêˆ$«#é|ª#’YIçT‘i«#é|ª#ꬓ%UøÓ>Òg(|È™ é,  ŸÉµÃß/hIx+H ÜjÎØ¹ª]\¬ BÙPŠÖªiì4}6Ô„"(Š6¢ ¢A4„HBÕÈ‹fýÕÁw.ŒBB‹&âð‹!?ò ²Ãj | Œœh¾êMኳ™î~Ø3W@’³ º EÕ ”Æ€Ö0ì 4åÃ{>Åf þeh ¼ëaØül‡‡I$–0\£3xƒ'ÁþP÷°gSñô1,qà(ð>XéVw®ƒçþÓ@K ~“2óã¼d½5L“Ä2'…åL4 “¢Ç„jeª×h¥ÕÂ×§Â| ÀEàMùÙÞÓi àðÞ– lI'í|ª7ÑgÔn~f{?ðAë–ZúÂØbj…'fˆí ³(ã;Á|…j ÆvPï¢XǦheªiÿ䟧“†Àw:Ù[z`”©µS#…€%ÏýKÎ*ú.|ÌOoï´ÌAxBØ(ÁV¨—…˜®×ÂZ,ð÷x¡’õ0|!†-AÆÓ{æWådTªÕíªÝk)ÔSüÙÎøŠ0ë‡Ùþ¨y …`M¨>T½ÀÃp(š&*Îãbª?yõC{…VxW|ÙÏâXñ=[†—ؘåè^»Ç_^ØãQå#, ¼à¡!†%Áž$õ€ÑˆIÕ)Óh&¢ü'Àï§Ó:¡+Q5> àe»“Üø˜ ækð4Áž*4È(ØÕhög£ ‹¢“õ̆XÖI¨š ±µL‰’2Ä&y¥Âí(Ó¡=Ã:tböTlM22HvÛO#‡=%g-Ë ìă‚;¨ju²õÏ,uRs ·Ñ”G'_i¯KK´žé#tV’Ñ`Y;¬JèÏ ècWJÃÎîTÃáeø˜¤ýìDQ2[ÒB^FÛÇ8ªœ6²èt«Üyc„e†´ 2sQZ§f‚0À'ÔhˆO‚MÆJZc™9 sŸÄdö0Î ËÍ“}Mцr–xÎ`Ï;å$Õö!vOç³±E‚Dôäô¨ÕLÒÔ™öRlTÏ…:Õy€ñèS=i„ùi,µ¢pJuê˰y¦×%OP;ƒ,gŒ°IIäcœR{…3´18é\U(%s¨‡yâ»ISõÿ»2%¹$ªió0=“éLÕÇt¼ÙU{°}ÁÓds’²NŒåYË+i¼É•xÊ#“ñ2õôð«yÎϤHRZϤò±ý¶iÎC[Jî©;¦O'“Yá¶‹ÉÐÏY\ŒÅ GMpïÚ¢ør3-PJnÒÎìHåifû)Õv¥pÖ­Z™ŽÓXjT]*|Pý/KQîcòwÀWbò»aÅÍlãüI¼Ißie(ß„ic)“ÏÉôÐÍ(,fpT‹TŸ)ëͰJӵ弙Qr2ôM+I[¦u¦ó’¢ÐÊäs1Mu0è>У àÛR+Š?¶1Y›T]+8¿W|¢#C»MLFjÙ«ªKõ)'ÓÝd)¨–3þÓR(pª×¦ ¥­ß¥Z7É›QvO£•å,] ÊÉlÝ—Š‘¿*çKS–ÎKUÿìNq6Y¿É8JÂMîPp%iO¶`3ó§•þ”6r¼JîrÁ¹æeï9‰TÞž|rgVéj4³î´gäÚÌJ@É­ 64.½ª¼-)gVú]'³v›î ;ùv¬Ôòɪ7]}(¹[y'ʬz}¬>WjÀxª*‰°:0’ªLÖ³§é3=ªöN"“Þó(e;ûí)Zɳ(K©+=¬Z ÔâÓhóô'9åÍ0ÊÎ{…Êz6N¨• •oT…¥ë›¦¼ 'û?§Ú@šÖIY¦«2õcöŽªïRA¦aZOÖ¨xc(ù^–Ö Õ€ÒW M±zÚû(¶F4µ«@u0˜Á¹éš ¥GGi–¯’=®/¿ët¡{¾_¥~™ÔšZy}~ý 2m?Hú‚ûAä¬úA“+yoOé^Gòì:¨ÓuXÈ—ÖW’Né+‘ÿßWÊè+¥; ÿ9ûJdÒ ûåõ•È4ok_…¾™¶¯”–è‹é+‘3ô ¾˜¾AŸµ¯”þ[§ ÙWJÇÛä¾ÒéNßÓw—”÷s¥’øªu—šÜ]š¾»ñÅt—È´+ehð«Ýe"ÌÇN­f¾ø.ù w™È”.Sú]÷‹ì2‘¿Ûe’¾°.ù ]&ésë2¦ƒe€õ*Æ­¢m'<ÿâzGdZ›Y½#rJïHúÒzGä´½£tèóï‘ÏÐ;:ÞÏ·w”̬§?QNíøsèødvi.dLJœWÇçÔw¶sëøŒŽÏ™ú¢C“8¿¥; „Ñ¡³šóø7WµL/káWËx󱪩†Õ¯QX›\}¶φ0B'?†ßèšéþ÷µüVÇÉwdü¶¿U€ü¡Q<"ã?4â7}ø÷ÏãßÉø_ËðÅø°Œ_—ñÿ”ñoeüÿúWFñ×2þ•ÿò[Ä_Êø[ðÏ_¹]ü¹Œ~Pxåå•â+·ãW¶ /ÿË,ñ啸e‡ð/³ðÿñ¡ ü’Œÿy¿hÀ/nÊø¿Oà¶àºÿLÆÏ=kŸ“ñ³v|@Æ?ýI«øÓ-ø'­øÇx¿Œÿ›Œ÷ÉøŸÇ{eüL~ZÆO=Iħdü$ÁO:„'~DÄ'êñþá~|eø¸Œ0÷LàÇ`ò˜ŒwËøû2~tï‘"ñ{>üH~x¨L|؇¿ë8ùP•øÝ üP~€œÀ첈à]÷›Ä]|¿ ßw¯^¼OÂ÷êñÎïT‰;'ðwð;Uøž»-â=³ðÝßÎï¶àoçâ»`ý®™øN Þñ­çÅ2þÖkÄo=¿µU¸ãö*ñŽ5ø‡p{¾MÆ·úð-+Lâ-2þ‡øæ›Å›'ðM‰Rñ¦F|ã7KÄëñ7·›Åo–àí7äˆÛÍø†mñ†¼Í€·‘­2þ†Œ¯ÏÇ[rñ×e¼YÆ›d¼±o(Æë ðà›À£pÀ €O”â8Üâ[pLÆëfᨌ#2Ë8D°ã䈌×ŵ26âa‡Õ'ðì*ÃpœÀÕ10ûeìó>/údìX#zŸÇÞ­ÂÀò*q` p÷_W#öËøº|-l¼¶ ¯k$¼Ú€WÁªv| Ü®‘ñJe^aÂË«ð2/•±[Æ}2î•ñÕ2îé®{vâî*ÜeÂ2îq»Œ¯šÀmx‰/q-®=b‹Œ]{psS©Ø<›Jq“CXìË‚s vÈxÑ•vñJ;¾b_.ãËdÜ(ã†y±¡_*ã…õxÁ|".pœ”ñ|‚ç;„ys‰8Ï€ç\/ãK³xÉ\W[*Öùp-ÌjKqŒçL`ûÅÅ¢½_ kã¯ÁíkíxvµQœ]„«/"bµ_Dð,®ª4ŠUõ¸Òˆ+l&±Â‚m&lÍ©­Xâˆ(Õãò"\îÊf±,Ï$x†Ïp¥¹béN\ %>\,ã".”qA>ηÅ|3¶qÀäíĹ“ÛˆÍ26&çÀ-§ áflÇÙEØ c½Œ‰Žˆd'Ö¬sÚ ¬ña@ÄF,8J°Æ1\ñE˜#˜s¨s8ßwpIôe¾ÐŸ™èÿŸ¸ý endstream endobj 11 0 obj 8294 endobj 12 0 obj <> endobj 13 0 obj <> stream xœ]‘Ënà E÷|Ëtù;dYJDò¢ÕéØ0v‘jŒ0YøïË0i+u:3s/‚KT7§F+½ÙY´àø ´´°Ì7+€÷0*Í’”K%ܽ »˜:Ã"ïm×ÅÁÔèa.K½ûÙâìÊ7G9÷ðÀ¢W+Á*=òÍGÝúº½óhÇcVU\ÂàÏyîÌK7A\ÛFú±rëÖ[þ×ÕOCÐUÄ,a1ÛéXÇ//—Š–ÿfÉŽ,ý >;륉—Æñ>«<§‹9£~м œ_sêÇÈéOÈ{êï#ñù@šùH|@~"gÖÄgäy ä3õ³ðûñI˜ùOT\ܬõ1… ù`2JÃïߙ٠+¬oæÒŒ, endstream endobj 14 0 obj <> endobj 15 0 obj <> stream xœí{ |T啸wçÜ;™Ü¼fòàaHró2‰ I ¨Ì$™„¼œ néf2s'HfÆ™ 1Ej ˆÕb_Ñ*RV)*ø·”²˜ ÒZ©nÿÈn[µ¿õßíZ+®ÛÝÔ²]ìv#\ö|ß½ó "àcûŸaf¾ÇùÎûœïÜcŒ„e’N6 ÷€+X3sšDy….Û½>"ÕÏèûŽÅìªó8'û{û‡½Ãw|¶‘þ>BRgôÉ.ϳ—ªÉ؃ûóûpaŽâOÁù?⼬o rçýF !™8%‹ûnW“éé,œ/ƹ4àº3ø ¡…ÇùgéÜï_vâü.+Gn'Ïœ'dy7݆ä ÷4ÿÎ7"ôá‡oúJÇ¡žÎuÀ úCª˜–žÁ¨þ/{qóÈ(9ïÈ>²“Û‹3/.ß+»uÉ2ˆ+/r'¸íº9¸¶—œ&¯"ä6röñ„[Fæâ*!o:r†s’Cˆc!—Ë-LÑó„oçñ~”—?Iðaþ$ß͇¹¹ð˜°RØ‹Ÿ…ðc]6ù )"£Ü›$LŽÀoa.囸Lò&œ„}䤂öF;ȲyÉåd“nƒÎ+/ 'ÉÃøàþIn÷*rw„û"y<¼n)ÙŽŽr $_§núå\ùqÄó“0O„×9‘(ºÙ¸†Ü#­ö]s„×Ùû4Ù„”d~TŸ›RŠT¨Æör/rãú¯“ÝäUø,Ü¿ä¶ð¥ü“üR²CÕt“ˆûazFïå†QvúÞ@±ë†ønnù-ßÒƒ¸L%Bš‡t”ÈKŽâgHoD™q[`;rJw ÈÉ”e| žG )QjB0¬ÅÑò 9HæÀÙ˜˜¼úÂñäNþ-”yw¿îä$4‘*âåßC]“\BFy6E/ð ãˆY2ЕÛ=,·Þ&ýíêâ9æISɘ" 2†¥Ñóç;oãó…Õ„Y Üp€//}ëb›oÍ1/ï¼M:pÎÖ¤aµu7áZ×m8¤3\Æu[Û£DåøÏÞ}@r÷I÷ï-­¿×(×ÏAµ¯2Â{…=˜RÈu–tþ¢ÿ€3›t<©9þÚøÄøÚøkãµ9¦bSy±©ØË“³aÈ?ûŽ2’’ù§?„ôUÿoÏ ¿ä÷=i³Ü Û vûœÖÍõnè ¿q¨ªõÜöy]/<öü³7}¹ºz_EÅYª«#¨«=ú\’Ff‘›-3a,=+ulFÞ}Y£ùÎ$ÙÙ-3Òõ†ëš ¨QêΠÝkÆO9NS{¸»psáîB@>;*«剘Œ:äµ"¯Ô4Þyâk_{‚~Î}¥þ{^!çÏ¿²á{õccºšï¾{?:‡Ç¥Uþ„ï£.Ï“È Gç߆—цä]ËâŒt]fZWQ¡!U—"v6ˆi…E|ÙÊmçs·æmŸ1fâÇÊѨ•…bZQ~ qä2S ¹%¶JãÙã訧LÙ RÃO¡U•÷ß3¾ÿ^¶æ^ÆÌß™¦/Laß«K’ Ž[c˜%ÎJ›•^jÍiæôE©‹ÄEi‹ÒÓ$"qeºJ±2톜šÜš¼¦UVUIUÅe[Å­i[Ó·fdÓt¯ÓéE}¤CdBa&\ù0‹/H­¨©ZRõ—U›ª6W=Pµ»êtÕŒ5dÍ\^5§j±ˆ+äòrõTó Q›óÑÜ5\5GM_7 ¾ÜþäíÛ·÷|cÉñïüç?Üþb¿÷%×Ý÷Éû-ûúõßyñKž©¬t:-öâ̾µ}çáÒÒcóæ­¾uygyVÙ7ïÞõt!»ŒÈ4þ„]$‡Z=S0dÁSÄÄ5lÓPË<1³3›sgÇu,$ÆÏ,>>NãöàwóPGœ©8¯Ø”;m—Gýt®‰â6([–‡ŸþõǶmv)?Úqn÷öö‡¿ýs]÷î•ö¼–¡mM¤Ö’«OK!¦4Ø–9šz4EÔˆ¡9›Ú¬)¢­Ž¿ö š®öPgηstHSÕ‘ ý*9ÿtXVd7ï|bl¬þÈ–œêYp(ÛtâØ¹ƒ|÷3^· 0zw /½‹ôf’%–|ô™{øÌ­÷ˆÔg¦£Ï\—’A–æÚ®3ž=U7u‘3ÔEj-iYùÆüÍùäïÎ|ÌFh•y4 ÑÕI1ZåÝöG;¿ÿÒKßï|´½í;kÎ)¿àæpúñóžž=ûí“'ßž={_YG&—ÍÕ—2¾âù±Ã2[¿“è1C ;1?âÝ®ãô;½NÇ5èÐ’{"E¯+ã M‹Ç“¤–Õ3dÎ<ަH,&^§+5{•šÃÜ¡1ÿÆ(£¹}¶%SŒÿ9ª8Oš 9ÓýÙq”Þ˜jIíLíN ¦¢ô9s™ÞK_ÅßýÁn}îo5{¦ ~KÈí–ëõÙ©3²ˆ¾ %/}[£ùGgÑÂYƒ¾ÓdÈêœ5ÓI)M'gÏžGÛ"­Å‹O©¾ECÒ’S[ÖY,{ l7¾PöfÙù²TT=37µ¼šlš/ðU¶ÞýÝcc¡Á{ÇBC÷ï`øóûaû]ëßÿ͹ÏêvýõÎc{ÎmÓízì‘<~núHoÏ]„é䈲’߃21ÞbÉ¿nŒdæŽ †ÑÌû¸çáh);­e:F….!Ob©ð8ºIªš ]ÈskÊcii0)=†ÑScYPws47>y/!rÿ¦eG5fâ6+y–<¨ã ¤™GNhXÖZ2Œ‚E躅 pZЫ†B#ésÿkœÊ†þÏoBÙrI> ZÊH—ºÕp÷'Œ¥sÏÍËM¿oV~žÎg ËuÙY¶YˆcY‡†Ã)#ÞƒÆ3ïÑP´T-)ì.øiÁéa YÂ-Ñ-É[’/˜Sj 5˜.$Àt¼@~*&5 ™b–ÃX´H4ZP/),ŒRøMg¦Ÿ|víË=SÎ(/sUgÃ¥Œê¾sÏÃc™ºÏÝ~ìå›nzæ3w3'r9\£ò«ãzf—æs¼eÊ!óñÖJ%Éé·ešFÓŠœÎ@Úé½Nó׸zi-¦–bîu¨;ïïóh&™Ê<£wÝõÍ§ÇÆ¾?øÂKº=Ôe¾½‹º ºŠìù={¦ÑÕ>~½o犿ÌZü>)2°ÚþÅy÷ïWúÊÊ”´!†xñ2 $>Lz<ÈÂÊÝ«?DÞàß%„\r„Ÿ5g)YËpì%wÐ=ÝBòBÊ r„îÓ1?N.0ö>‡Ïî´®ZçÕÔ½ÓàNø[øg¾Ÿ )µ,R‰¾ z»‘X(w|>«­û¯Ãäåé¡ÖicÂ=®×ŸÐÆ<ŽjcŸ÷ž×Æz¬¿~¢ ˜ë_ÕÆiX_ŸÒÆÙrÑ'ÅLrSÎ.ml$i9?ׯ&Âçü )r|*2T›ó–6æfm¬#†¼ m ¸^£yÛ´±@fäý…6ܼ֓°66’¼mÚ8Ôç=¥3ÊëóÞÖÆ™¤oQ66’i‹¶hc1,z¤1ùzû"R¥»Jª«­+õ K ¾H8’]fÉîwWKÖþ~ÉA¡Â’CË¡õ²§Z¼àè|zÔéZ?°6àï•\}9Ø$¯u­IJÝåï•Ã’+$K>¿ìé÷¹%O`ÀåóGaº\þpC °.aš0\)‡Â¾€_ª«¾q¡ºœà ø‘j…è‹D‚õ55\_?X †Ü²7ê•«ýr¤™Q¨1Á¥Ê°,K=r`¨ªZº Ž«¥–þá`_Xò ¡ˆì‘¼¡À€d Éë5V¢4˜†U %’Å8u”Ì%©¬ÅÔ,ιäK¼Ð —mKie_XtI‘Ë#¸B뤀w2Qì”C¾0S¿/,õÉ!iõ†\~ÝŒ²£Xx 5†z6K‘€äòKA4ôDPc>TKr#Ó"BFú䨞ÜîÀ@Á)@¤±£–eµWÂTRR…È<’+¸}.¤'zîÁÙqE(?^_?©’bd¤®€72„ê/©bœ„ä`(àtË Ç‡‚ùz#2åAL:`F3»û=”“!_¤/0Af|!J!¤ªÑ†žŠc–d*µÈ$ÜgN a¦4k!),£Ú‡¬jâO"M™C´Aªèˆ¨ªŽêCǺà5ƒw0äG‚2;è Há€Y ö¬•ݺBåóúÑÙ¨@î€ßã£r„ëEщè\=õ2“@õ"Æ@Ì üš!¬®R«ã îIá>W¿Ø#kZC60J\Irüè!i ’§[Š e¯ U«L%︆1Zð¸ÇçõQGsõGÐõp€H]“\U PWùìw…DJÈ#‡}½~ÆF¯«xˆz¨ËHÂôD”ŸðdJ¥ˆ˜Â\ýS#ÐÎDùˆcCöüýÃ’/ÁÍE*NH¦ÝIKaªHj—hxÈèsrˆ „Å&­Ås+É B¸ÖŰÉì„‹I$!?~¦ñúNÂó¤îb{“ñt1,aä(€ïuÙzu%ã0ŒxŒjòy#Y˜=5/;¡ÊÑ,Ae çõ¤ß ~=ÂW#\C(ÌΆ˜ÜÕˆCÆ3Í Ø¢zˆÚâB‹Ó=ª[™ÙGF-ÈÂRk\SL-¸3Œ0}ì¤÷‚Œï³'Õ@ˆ @±®Ÿ¤•ÉrÄ}h0ɇ.&ˆï©dWmæÂQ¢Ö.ôf‘Ì¹Š·xYríãrj{ÇeöáŽÈF¶B½l€éz®ÐŽ*Y'Ã7À°Å½ßÇxêc{²&W/£â׬nÖì®ZK¥¦ú˜êÏfÆW€YßÏεS)kDó1Ÿæ.†CÕ´¨áŒ0.&û“›ÁQ?T±G1Ph•wÕ—e¯ªï•$xI ³=ëa¿aÆ—ϸ4ùDnôІ%Âv¢úñâ¨_‹¤Êq 4¯Pþ#迪÷SŠqЕ ‹Rp³ÓQn¤^%ƲêG™©..U#í>ôÆ4µ”ØÒŽ3J§gN² ëH۳㚄uœwV⬠W›˜]¬l‡î—°h\…cбƒ¬`¸Tü¦¸Wã Å-±9-GøvÄEÏÚÈmŒ† ±u!g8¦¸Ûpµm=ш++pNÇ-„V¡*½v<åd±CÏQ^TN¸§šÌ•QŒrÖ†3â_ªíZ·á£ü›Y}DÇퟪæ ;ÕÅLq6"G­lFWWào'Âu1}Z™Ì*·íL†fÜWe±1TK¨5âo'Ò¦-È—“iRrjffG*O;O©.gP*gš•é8Ž¥ZÓ¥ÊÕÿÊå.&+¾%&¿WœÌ6VÄÅõ†ò-2m¬`òY™:…GµHõÙó8G‚U™¾¨Ý(çMŒ’•i¤kJI¢Ø­3•wˆ1 -L>ÓT+ƒîB=ÚÞ[QýÑÎdmÔt­âTý^õ‰Öí62©eoEª6ͧ¬LwÉRP;­büÇ¥P-`Õ¾t·~»fÝ(?NFÙ9…VV±X´1(+³uW,FšYü¶iœ¯ˆyX<¬Ðü³#ÆY²~£q…»œÜ¡âŠÒN¶`ó§Vî˜6TñxÕÜeÃ{ÍÍžs"±¼|s'Vñj4±î4'äÚÄJ@ÍÂ- v`\|U}ZRï¬ø³Nbí6ÕvôéX­å£Uo¼úPs·úL”XõzX}®Ö€áXU`u` V™ ±ÝøÔz'¤ç¦aZOVkxC$ú\× Õ€ÚW˜dõ¸÷QlõdrWê 7sÓµHÔ¥)²|íq}ò]§kÝ—ý4õƒÄ¤~ÐäÊë£ë‰Söƒ¤¹$^V?(¹’w'ðïuD!/¯ƒ:U‡EüÄúJÒ}%ñÿ÷•úJñÃÿ̾’˜tÃ~r}%qЧµOC_Iœ²¯—èãé+‰—è|<}%‘|ؾRü¿:]˾R<Þ’ûJ»}/Þ]RŸÏÕJâÓÖ]IrwiêîÆÇÓ]/¡])AƒŸî.“È|ìÂjæãï2‰Ÿâ.“8©ËÖý8»LâŸí2I[—Iü]&é#ë2‰L+ë2Æ­ªm+î|½#qJ›R½#ñ‚Þ‘ô‰õŽÄ‹öŽâ= ¾w$~ˆÞÑ¥ð~´½£hf½øraÇG¼‚ŽOb—æZv|Ä«êø\øÌve1¡ãs©¾ÃµèÐD.Ào!ñNƒÈèÐYõUüÍU ÓË:üÔ0Þ<¬jªfõk×’«±KÿÍû–Ùëü~r;™â5ªÛl9ÿ¹ð_åð§:øÏøc&¼¯Àþ£þ ÿ>§Ëá÷÷Z…ß+ðÞünÆ'àß&à_øm=üK¼«À?×Á;§º„wFàžê‚·S#¼=¿©·øµoÖÁ?å¯Fàøe6ü¿ðÆsð üÁ±^­Ex}#¼Ö¯þ<_xUŸçÃÏø©¯Àß)pr^9Q(¼¢À‰Bø¿uð^Úb^š?žÇxQ)ð‚?Tà SàyŽ*ðœGL0¶µ\S`ôÙç„Qž=¼Fxö9xv3øoÊ…Ãk,çá°…ÿ›r8¤À÷Gà ßSà€ßUàüŸLxz¹ð´öïËö—þlx ™~jžTà ö*ðlØ£Àãe ×Ác™ðר »GàÛ ìz4]Ø¥À£é°ó‘™ÂN<ò°Qxd&³8KøL6,^”!,¶œÏ‚EP¯ÀBn^+Ü< æ…¹0^š0ßóÒà¦B˜›u7¦ u ܘµ5iBmÔ¤AõœT¡ÚsRÁ\³o(f{à†ªlá†r¨Ê†ÊŠr¡Ò åp}yšp}”§A™¥ ”dA1ÊYœ ’Š& E(ô@AÌB ÎR ®k€™8™©À LGMMW`š6òÈU GlÈVÀ„²šÀ¸²<©@Fú4!Ct„NŸi ˆFHUÀ€`RrAï7yô€<ÀUP@‡sÝàŒ@àF9Ï–û¹Ùÿ^ä“fà’¯‚ÿ“é‡ endstream endobj 16 0 obj 7754 endobj 17 0 obj <> endobj 18 0 obj <> stream xœ]‘Ënà E÷|Ëtù‘W#Y–RÛ‘¼èCuúÆ)R& ÿ}&m¥.@g˜{ÑpIª¶nöÉ››džÚ(ótsxWmX–s¥¥¿Wq—£°, Þn™=Œ­¦¢`É{èÍÞ-|uRS,yu œ6W¾ú¨ºPw7k¿`ãyÊÊ’+Â=Ͼˆ’èZ·*´µ_ÖÁò'¸,xëŒF‘“‚Ù N˜+°"MK^œÏ%£þõ²-YúA~ ¤Y¦é¦*ç‘÷ò†8GÞF>lwÄ[ä=qÔH5tgƒ|¤ó#ò‰¸F~"oŠ\Ñyœ¡&Þ!7ÄM|È}b|fþ—7çBLñcb>˜Œ6ðûwv²èŠëáÄŒ+ endstream endobj 19 0 obj <> endobj 20 0 obj <> endobj 21 0 obj <> endobj 1 0 obj <>/Contents 2 0 R>> endobj 4 0 obj <> endobj 22 0 obj <> endobj 23 0 obj < /Producer /CreationDate(D:20080118113641-06'00')>> endobj xref 0 24 0000000000 65535 f 0000028266 00000 n 0000000019 00000 n 0000000679 00000 n 0000028409 00000 n 0000000699 00000 n 0000009502 00000 n 0000009523 00000 n 0000009720 00000 n 0000010099 00000 n 0000010336 00000 n 0000018717 00000 n 0000018739 00000 n 0000018948 00000 n 0000019305 00000 n 0000019532 00000 n 0000027373 00000 n 0000027395 00000 n 0000027589 00000 n 0000027945 00000 n 0000028159 00000 n 0000028211 00000 n 0000028508 00000 n 0000028592 00000 n trailer < ] /DocChecksum /BF659B2F14228BD45261F1C57B60F30E >> startxref 28771 %%EOF seriation/data/0000755000176200001440000000000013056304344013162 5ustar liggesusersseriation/data/Zoo.rda0000644000176200001440000000253012606356654014434 0ustar liggesusers‹ÅYïŽÛ(wïÚ[ÝI­úýÐg¸'¸OÕ}Ã6ŽQ°q'Í=|ïf7f`Æ8ÙU‘èÎ0ÃÌoþ0ŽÔ¿ÿúþíã÷Y–í²Ýþl óüó!Ë>=Áßý?BÀ¿_€ü ûOØô*~Ù™C»gY€÷WH¶tò·ä'ä7†w æž5¿k6StB>Í2µÙ²Rjàû½ÅîŸj/„'5·1!»1ý”Þùµ‰õ¹Ï‡â ½…µ>ÜêÇ×Y›j+5wKýËÅ–ü{ï1Ó¶æîž9ûÕVJÝÞs¦ù÷~ÇL[ª]l†-Õ1Ÿoï­Ö=3-V—[gšoo©ç·ö\Jœ¡;[|-Õ;ÅßÖš)~ÌrgZÈžo+6K³l9'!YJ¿ÅêËSJk÷bïvmö…ðÇâ Ñþ÷&eû6|Ÿ)}”û’ŸØ¥ZÚú&¶ô®?¯Y·Ôf Û–^NÍËZl)±¾ÅŽùIá·äÈü½åwZ¬ïÍÇZ¼[j»&ÛŠÕs)W)>R|ßò;힪ë{ÜykÛ¾ÞRÞj?¤{ïï´Ý-+ÕϽ+öþ×î¬é¤ØK‰ËÔ&ŸwæÐî™{¾óÎç3Wwçœíf÷¾nôC~®¯Ü³ëŸ•ž­çÇk)þÝlËÍ3 œ=8¼Óœ»Ø=™ûnÖf¡î®”Yíëº|ÌFL/t/Åæ­;–§Ÿ’'÷Ú÷féÞÚÚ¢³6Þj®­ÙYêƒßµ¶üN˼/[ê“%ݘNlÅúØÇºÖ_©ï嬱·ÒqÎ÷¦6f¦ïÚ=sÏw3ÿàìwß¡f® ®í<`×ç—¾S³o¯ñõàÙr·‰©Ü÷·ùv¸Ø 'îÃï|.o0óöãts1Û}õßnœž(W@}ºZx9}"ýØ±Š‘a>È+&C·Luæ:­õÌýÁ†•šV’hj4zÒ÷„Ï\!騧Їše@<‡ór³%µ¨_¾ú@zjÔ?ÏêyG˜œé²¥DwT*#£‡Ò=ãG£W*!:óù1Íj#%mÈËX f#®H}¬Þ.+ùâÖx*Ot½˜Ðs Ù24§‘&Œ›;€Ð,„¢&Z±©—¨Wéx’âüÕM "D6'"m¸ƒ¦\ŒFžW׬_iJ$Ò颚ږpaD5á­¥åèà¼ö….(ê(Õ¤³,«t@Ínªæ¤GZs^}ye"6tC)bmÄÁQ–C£§Fœ0òfª1+”Ó±ƒÔ`ó 60ä–S‚´‡™~x¦¿á%91]c¤80IÚýË‘P-?犌stu˜¸¹Rt¤i"¶WÆΗÔÒg«F¥„@ ÄZõRQjùIÑ–›:åGvfFÆIs¹¾ù¹]mœŠ‘8"&‰ÊÆ/ÃOûì†#Ò‚#Š^@ª…¢V¦±Î=cv ƒßR!F¡Ô„Ý"äå'Š”–¬6FJÀJŽÐF<Òá0aW”cG‰²ÕÏGvÄq0B‡Ž *Ó'6bxåȉ¾8˜F«¶µÅpAU!GÁl”ãÔ[³“R{¯¤®æ´”” N“ç²Ãv,U vmþKEI'¤u<öÐ3ýZU ÄÆ ü™(|ÏêÈúÞ:UÇÉ:åâ|s¯øt@ÚV¶PyûPKõcbRRœtJé¼Và¡Wá¡£©3Á¾‚žê™Æ°´ 8„a"äk+aDg/_³ì×ÿ•>ª³#seriation/data/Chameleon.rda0000644000176200001440000076547112606356654015604 0ustar liggesusers‹Dýw`Te»ýSTA, HõAŠ]‘M -e2i¤NËôLËô$SA*"*ö‚¢ˆŠ4±+Vlˆ`6T, ¯çûYù½Ï‡ƒ$3{ß÷UÖÕÖU:½êì^U½ºtéÒ­K÷®Ýºtëþßÿ{X·ÿþO×.‡u9ò¿?ûØÝÖ¦Fc0Ðàh>·K—îýÿßwért—.C ÃtÚeƒýï\k´zïÝõÅè#Œù¥c»nzÕb$f¿ÿïæãw‘7ßíRuÜõÆü ¿Ë}ÿ—ר¹âç•7ûn3êÖ¾¼iÛµ¯ñsöo|òªãð‹ÑúÒ;†õûž“·wûŸáY¸bÓ’{ï3Ì×ܵ«éé)†ýƒ“Vlˆ¿b˜N~qÅ•Ã>7RÉãrCb}ô¿mŠ·gd×½¼qËðbÃöÌ7Ù!·¼edÇœº»Ìs´Ås”wM~¶tlЈߵcȃ7þbd—ßµ4ùƒ‘ž·s¨ÿ²~F6·ÄR½æA#>g]ÃUãLFÔ½ÞÒmʼn†÷Íi+Y¾1b¿-߸í©E†¯kñ®‰Žj£åÖs&¿ìÿÞ0á¨/òüd丳¯]w‘‘jxÆR48l¤Fð½î»goºïA†ÃÑ1¤ûÛ3ü’[ïüÃGF̸)ûÈùGÅ‹ž©?or›2þw¿÷E£ù÷Æ|›ïod¾*ërvÙ^#÷úÑ M¼ÕHÿ8~ÈÎï>2’ËxŽèŸ•=ÿg˜í6ô¼Çˆ_?{ãm¶;ô±G[rÍU†ùÅ+_ÝÔa˜ÏZ¶òÐñ^ÃzÂŒ}¶ÄHGø³¢gdÓÞõž w ]w„ßðœ¼m—õÔFìà]»Ó§?k4üøÈ°¾'w1òWó}¶cÖN®û¥‘ÿèñ!¿|¹ÄÈ'‹wm¾íD#2 ¯åÜýÿÞñÜKúÏ~¯zÈÛ+Œ™ý½ëÈcšp[íÌ0¢Çñóî_x§å¬¡·ïøÓ˜÷|t½7ó—s‘î¶ü3ˈï^=dݘ1Fæmî«ôš¥yÓÝŒâý¼w¸;òÓz÷Vw?çi¿¨p×Â/ž0<Û'gÕÉÝî8ò÷Fàå¡›<{ÿ6*ûÐõ£_ß5r—ó~–Iƒ7=é*7?˜v,KÙ;.ºà±Fñ%çMnÝw­¹lCnŠKü¤Óv÷üæ‰ÿÞwoÃïGî4š~þï”ûÜg‘;æm1oà<#§sÍÛ^ßtÁÒ㌪†ÖÝÇ=cØó{±›ª†Úþ—Êñ\þü™?wü÷çËäPU•‘ë6xÓøñ7¶áÈepm¶Ëÿ6>lx.FÞó–²ïþ¶ÖhÅ÷$ÎäçZ—ÍÝTWºÙÈ^Às•^Ñ{JÅçFôrÞÃwÄ:˲å¯Ùk ûòzÃýõâÉöç^ŸîÿrÎ-w:Ï]v^hŪyåFö~ô8QʽÆfLÎõÛõ‘úžïOÍÞ5ùƇ÷ðÜÉÂE“š4š~D..ž+å8kÈuþ¬á¹rëŠV^l„VüôÚj#QÎ=–û8ŸÜ6Ëä߯9ÞH<ÃçÇŽåþ­Ï×½næF£ýÎ-þt¿†o¢w©K>rà„yFܤ׬/ì|ìAxÏ>Õfœ5+a¸žÝsf/#5ˆóðäú`øl×í5yQûk†÷ÐÊMÓO/2ò‡ÍÞ4ü–#ßë‘¡Ý\h„ç»s¦W¾Z~Ï?…ûÎÝ’ùᕆûòlº!ßuÿ£(×1â¼%ãŒú:Î#¿ê¦Ü¹MÿéÙqßäÆôšcxvb7¦ÚÏ™ö×è÷ŒìañM%Ï]näF~—Ý}ÅOFìbÞÛ?ÉQÝfÄÛùÞø—Èeúꥹç>gä‡ú÷…‚åFrŸ×: ý ¯Æ?¤f¾µ{øq#ÔÈk-Çœ[bX_Bîl“9§ðóÅ» Þ}ψrÄ]×Õ5k§„zhä|uãÁ7¼½Ó»Æ½9Ôˆ]‡½ÆŽDŽçüówØ4úÐ#õv(ô7ß“®äÜC—󙛢—¼á6*R'd^Zx±‘ûûÁßxp áÛ—Ü•.j1’K+Sì|æ¶}wœ°¸Î0¥ë§¼·ö#éÃ/„ÿE¬QìŠÍ?É}ǹ¤z\`LÚù˜á+@<żgcô¸c~—ÿûŸÑ2ûh7ß?âÔFÙ¹È]â\ìeú*ìO¥?t=ô•eÊ¢ Œ\=Ï‘x¯üß=Û¯2BG¢G¶gÐcçô%úþ5}rç» »~Ÿ{ }ŒýŠ\ˆL}‰ÿËm[¹ñ¹ŸþóïÏãóå|o˰®ÿ>‘»ÇÈÖý½ûøÌ>ÃïÂn'jøýH¯í]zßp‘Îó^a3ï¤wO¼ä#ôï×ap¯¡IÜShÁãCSƒæ¹AØ…²·}–îö·‘ÛÁóXC~S»9ßü#›²û†Ž2¬ãý¹—.zÎp|ŸÊ%‘ïü­3î˜0pžá‡ÝKœ¸lÅ—çÇä/|žgðaCÿé*#÷&úåúá¸lÿÃo42ÿ^eœºæ£tïYþ}Ï)û>;ɨ˜ˆ^Ûïã^š[0dëf§‘ê\Ÿ>íÓƒéÿp@rø=nŸÞ­ËEëþ“OWíÐÞÇt3rçÈîŸ^‰ŸÆyeŸF.ãݹ×ÌBä#߃ï˜ÆùùïÄþdGÎ-래|çÃ“Ø î±íØëêë6ev¯~ÔH å¼rWíw¿ÕHýŽ_õ ¿w÷ËrF²¿Ÿ€ÌÝÏŸÞ5ØmSÕoênŸbD/·„Î’Ÿ¾ôŸ.s³ÕF蕺 Ýl$¾Ç&žÀnW|pÕäÓ¶%Û¿°\Õó:£õ!î=–C^ã 'åêÎ2ÂcÁ7¹Ë8ÏtÿßÞûáì"½oEëz,ß°eÖ1FÔÏ{ÅÖÞºâæ§¹§SwîÍnâ¹ì£ßÚuüÝößoÊ=³ªÃÈýÚ1´¯±Ép?Ç}¥‡#öñØãd%þµb9x/‘À¾Ú6ó¡«ø\›Á=¦ÌÈ}ë ÈoÛùàÏÔYÈu®ö?½ »mÝÝtÛÅŸS…Â/"Ç™Ïù³zˤ¼wÛööfìlëNüZòp¯eöÄwÁ §í<£Ô‹Ÿo_:%û’¥Õ°<ŠüäFóû%ئLzêg#»»œûéÅ;úÍ_aøöò¾¹¥îúøÅņ÷pªç†u_ð¢Ñt6~/u?Ïßy>Ö'‘ïœÃŸ›Ò½‹ÑvŽ?ûÌkÓ [û”oæ>SGȋȑcï?“²¦Ÿ2Âßâ ‘kß×È{Ý{à¡È8ä-qòf-".H]È9Ç®FÞZþÀ_yGóÜùÊÕC/±cØFÇJ/!ÞH^Ê}™ÿýqåß0,3ðg¶{ê'?ûÁã†ÏŽ?ò¼|¡¥ùÓÁFâ<ð^þ¾óŒîÿ+2œµà‡H-8(ôïWÖ =ót,ß´cdw#±Ÿó]Œ|§/BÞ:>ÀÞ¦pž© þ*Ü€¾v¬éeóÌåF¾ÿVrÏ»Š÷Omá=£+‘óР캭ûj{‚óMž…kÙ3莬ókÃ2”ç6Wgþé½ûiÃ>iK³ŽõÏ4¼´ç?œ| Ÿk=êÏbPjÍ£u[ocNä;ÃsÒg“çÜü ‘|ï9ÿâýûäýƒóöÝιÆãVpoÝy~Ç¥Èoþ̉–Óë·黸·ÜÅàëÄcœw~¿—Sš{ˆ÷‰”};›ï±¤Çü{ïw~#6TþÁ‰½ ‡‘Çôä$÷#¸7ÒŸ‹?Ç÷·œŽžÎ^¶cø[_YŒæqÈa¼”ÏÉ_€ð»`òY ŒÌwø“Ø÷È·wú•[Ê51ôÆ oOÎ3ÿ Ï®Å^ÛžÛÝx¦Ñ¶wKvåoÉ9è“mÔþM›.1b½Ð[š÷ó!ž.{}ßòCyŒÈ&üHöSî/ô?Î/2\µâ¿šê±ÿm¯ã×B+ÁIö,v2]L|‘}‡¸/ô¸/|)q¥¯·âàÓöçÁÍ…ØáüØÓ° {ž½½Ë‡ð#¾Jp@8Á=úòþ–gð_57É\¸mwÓÒ¼‘ú 9n;ùK-GU\H\Ò4 Ï ¹eŒ²c«†š5r§a·=Ÿ#ǹZüTê#ìRÞA×¶L¸ï ìsb"ö0w5çá¹—óóÏÜ”ûsÉ]F|ï•ìÉû»7;½î*»z›‘ìÊý¤.çßS§¢'ñ[Á[u—pÏ­÷+Nyl‘q^ú<Ã{;¿Ÿ+"Îsë{"Vî9%¹÷_0ôí3wÖ7øïð`øðNó›wDÞ~Ôè‚=Ï À®æ¯æ}#Ãðã¶<ò×ô òæraÒU+6vLgd'aw¢ïᯓOqe—€Ó×óœéIÜ»ûuås?q«ð¸—{.Ëc¿’·+“§ñ~ÑG¥ï>ùç6î©íJ¾7.qrùuøéÌÈgôtä¸| þ-z6øÔr qNnÏá±aßC9ô'æSœúñqüDÝwì@ãî¹T¸¹å ðò ÞßþÎê¡[o½Çȼ͹fþäM—÷­tü‘†PõÐ/4â/bO2ëÁþùü~•x,Ÿ/›óä¯<ô Þ?÷ïdžÙp?©x×D|Züë­Ë³Ž4ІƒƒÂ_!­-ؽðÉä'¼‡ø}Ï]ÈmKwá³áñ¯.xÍÈŸÈø°“þçø÷Ìø‘ÈLüW´ ¿ä;Vñåì»g ¿Ê=†$‡>å3ŸF®rc¸¿P)ù¶ÎøÜô¸6¥¼Iì1ðš)iúôǯºüç߉C‹9ßì Î?öò–ÿ‹û MSܱÿžû™÷­ˆœùkãüUññä J?ÇïÚv`«_×ÄNXl„ξÙ(ÍùšK¸Ï䇨çÔk:§…/÷ —(~é…ðü ~ôŸHž'ù¾äñä»õQånƘš§ÝyÂ䯴uàƒ²÷É7›×33ë±# /Œüvkƒ½…÷ÉoÛ¿iâÖw ÷K³^˜fxÆ kNãsí+xÇàê#ñ£gwáÜ À· Ûøùto>7wVáî>'‡Ðô!wç{÷°•+ßø#qLâò‰Ðãù×bK_#{žü@¬ƒïÏm þ {•sàWÚ­“þ﨑ý²!ÿ¦^6B«ÁŸùVpN¸Axò|ôÉsþ¹¨,ýYÁ#ÇöÓxÿô…È·‡~þ*þÌ^ ®I­ØÒ¼olrê~¯#?š{û™L`·Ë#è}M?ä#9‹8Ô ÞJþÅs¹¿_{/P¾çlòæÁÁfä¾í:ÉsTöçGÅ1 ò¨•ýù¹Ö8=ZÉ}yÆ?æ‹/lØwÕHô×'# ýI^ɳùNzÑãø5NËɯ\a´Œâçò‘§TƒÂg ×¶Ÿ¸ç¶oÀí ¡³/8t¸‘éÎç¶®ÅΆ§¢/Õƒ8ÿüì]i9z—y‰ø4ÓŸçÎ_%s4ú’½Xxëô&ŸWœ5¼Ù6»ÑöŒòÛÀßsïuŒ|é#õ›ê5_XŽxk»‘´c’;±‡ùRô,÷×Ð_¬¾ÄHMGÄœä‰s Aþ ? ¾ð¹·²‹òE惜Kªyo,›ñ{–¿ï¾‰u$ïäýÝYêÅïUz¨çY†é#p‰sñr¤÷ìñ{ù>èmöjpTê[âšdÉácŠÃö¡ïS.t×ÝOV ïs_'ëwç§¹-øÁ܇?ßqøÖF#õ(ræ[Fþ ¤üW~÷—݉}iþ†¼¢kzæÚªüîJì« y’ÜDppùõª ´M>õÃC†o+ñ[j•âÈáÄ-ácÐïÜÅä5=©^±ZyQ×¶]{k¶õì»m+zÚ6†÷ôê{}/‡KܨºÝ'|n!þ'äD^,c«†ôuæŒü ðš÷mî/ï‘ÿ¼i¥¿óh#=’shÚ,¼wççºýr¼ž -–ÿU½ ] žñ<‹H Àþøwåü½y~¥mçoW?}yâ´‰ø=öú›¸Qõ“…¼wl v#UAžÐÒ“ø t*ö¥õê Ò£ØâHïðŒoúÞ²€÷Î?ËyןH¾(r&~Ñúò3Ø›ä"¾'|”ê)½wÙS\n„å§Ã7ƒS?q~ùaà8ÏIÔÚ»ÔSù/¾*æ÷šKÀÙ½±Ïm_ðù¥fê!Ö>Š+N#¯«>>™?í6Õ•»oËU Îψãb%ÄC±œWþ|ô=ŸÁÎ%š”7¾³ U9ûžûü–ïý„qú— ïÊgÝ€Þ¤âÇK|Ô׿'ÿïƒ^µg9Og=j{Aõ[å¥C¹çÔ&աޏ3Ô%}{xï†'¨“d† —ù.èIÓâ‹Ò+goX²ÿtó¿lßš”¯NÜD\ß |œÏù×”#7–mèqº’ˆÝ'ñ árWräŒ`ÿ;ãÉì`ùŸJä´í9~.eÅßçî#¿nÎÚÎJ]§ó÷óÞ‰c„óày,ä¿ò5Š/C^£¯ÈNÏ¿ŽÏµfø³|wÞ³m ùÑ´<ÅóúëU\úñ<•gòs¹¿É7ÄVqžù)Ôó÷awb±G¡wõ\Ï#W6õsØn@> »ÿï½þÅFåœO6…Ÿ¶ä8×ÌËÈÿ.ä!û•ú ^OVåî„ûª¯«˜sÊ_IÜc¿Cþõpøeôºú%ä×Ò¦~ªN¿þ÷¹{˜üÿŸO¬ø~Ù/Fþò¶ÁÔ;²—‚ûüc°W¡8ÿÈvüDlø,/Z*ÕW0Fý*/9>;v¤‘ËçÆÞã=r&ê[¹€úBîGoS/â¯Ó.ìEõ@úÞl;ˆ›óÇós¥Šë|»ø¾dŒ÷Ì›‘›äµÌû'*¿û©ô:‹}ðš°SEg9´¤÷þ~Ïç…]ôuâ™O•¿ƒ?sKÀŸù ÈϹ>ÅùÏÇ?دåyÝ#•_L|ž»söäs“Ç‘çvßÞÝŒ^Xßà÷cNÞ'ñ¹üæ<ò”éfÎ3—à¾ÒÍàíÖÃɳzoÁ$v+N¾óÌ]'7€û*ÝÔÙ­×á?R1ücüÕiª•žÉsÅ/åOO'>ÝŽ?Š?޾¸ î)ç}ã»ð³ö½ÄÁUï¿ŽŽ¸Îö2ñIýë’s3¸jÆUʳ_Õ{òÖ‰ãŒùµàØÌ™è§µ¼¼ùÍ”poÎØ‰±R´7ãgsW`ÿ ¿ _­eù ûGÜWã‘Ø‹ü õ~Íûå~À>fo%_RÞÔ‹øÇôÑiŸ?ÿ?½þ j?XÖ«_i~(?ùË>®ô†Á¿6Õ¯b#x÷.Û¤þ‹Ýä-nú¯rk±7¹AÂÅͼwz!zU=ÖýõûÙèIüôªüÒƒÍ÷ 6Ú?G/³ªæ7Äï”]˜D¼eó Oîrž+þ•êð«^øŽìLœø âåùâû°où…ô¦g"ßÉ¥WÊóíAïó["#ñg‘ŸÖÍœ[æÕ7‹8¯øµè{û`üuá¶?¿X8o­‘4Ðë–’×ÏT6ô“êŸ ïùÕ?íD®Â?¢ß±…øáÜBž3jS¯ üœÛ‚Í å¹¬“ñ—é§8¯ªØÇæ¿È#y' §¹È—X€#*NFßSåÈO¢ö­½Grw—… ÿFä)—æuäCcÏ`íÓ×¹‘“òä‹}^ô;û3~:¶ ÿÐÖ Î ªCZÈ›Yãsò“°‡¾«x²‡ˆ3|§)Ñùs¿îäÿ²;‰+çoÕÏA\­¼Ûë²/c'<³°«©.Èaºˆó¯‹‚›rË•GèÉŸÎÑ|^Áä]Ó^Ú¾ÏÈ¥ÃÖ×Àm‰p`®X¸¦IqÓ8ði{÷ÞÌ~ÏyÙ‡PÏÉW"ß' _\5ò·[„¯NÅ^w\‹½-]n1£¾e?yõ”½ ߈ÈœÍû›ë‘÷öáÜwì2î§áò0m[À‰cðã^ö«Ã¡üпÄ)k•xEõÞ/ѳŽð„ùUêržsˆsÂ/ñóÞúåR_dìIê9Ž“Õ'ýzœmDÿÃ'¢G•kyîÜ*õw–`ÏÓ9왣ußÏ܃%E_ë4âÌÔAôÉò•òv÷ ±Ë…¿»¬ÌNù/îNœ›[‚¿wþÉÏ'ŸÓyŠÝNܨ|ïRäÉÛD¼Õß3¾Z¹¥®ÇT#ôŸø}Ëìâ~Kî¾uåc7ö5Òÿ¢ïù÷kû˜|nq¤ð‹u+—¹zõåü†·Ëß“ÛðÏe«8ÇȹÊ+l!ßµ`oÛ»a’oƒGr_‚{b5ê?ÒûûÇ7µóü‘ø¡äåèyò éO!÷ßÀóÆ^àžr¿«¿lyÜäIèUf÷cÝŒ½lºŒ|FáÃØ‰”—ç3ËnTvS¿r-vºáTÞ£z6uHß™ê#¾zmhrŸ»Žç‹\Ëó5­TÝå]ð}ÛôÐõ>~)0˜ø:>^ñÕŠS÷"÷ÉÕ‡Ççºná\ÂMÊ—o@Îã39÷Ô,üÎÔ·¨óúÜô‘´>Þ¬>äo´âÏñgÉcЛPyOmå^ëWqN†•xÒ¼†ó²+ocqGŸ¿Øw©ÿe‘úÿF?+£È—û~ð¦íÞ/7:¡_84þö-ñri» »eÈû‡W€—,À?©ýœw°x1ïP~=s¿—úûÞ½?x°qòŸO—[7ƒ ýMªÛýȽ4üC?A~ þgÖÞ¹¦7¿aäZOþæ¯Fn+ï?“÷Mÿ¡8cÞ.cPñÃõ~&߈¾ÎÿÜS¶žºoü]õg†¿Š u€óâŒìùõÛø¹øiÜs²™¼ìüm|¯õÏ4êqåMÈ£{è=™ï¯©#¿ç8D½$ªÏ+ÿž¿ ü”Ÿ'¹L©_TybÍGEß&þö U_÷#ª·$îŽ©ÏÆ£¾ûäNž7÷,~5¬x'þ xÄõì#ƒ\ÜÛÈü€—Y°?¡×ÉkÄ®À¿†_ÃŽxŽPýÎÍyçg!¹Õª?mâÞ]ìª÷tpusü«ónðLKþÉþ òÔð x?VM|ãú™¹Ó+ØqË ôé„BŠ+®w‡ýuú4r‘¯œó3ö%~ºú3à>FsNô¨x}¹®èaä8ä4R®zеÜG|~33†çŠ«ÿ2ð%Ï•±p~¹ÙØ“Èä1ò‚æðŽÄ~æzgÌ¥‰“ò«éS¯ù Ÿc9ƒxªìgò$Ž?9çìWš—½”÷JôW>fŸk[E_@ëOü{ËǪ—>D=6ü¡p|펡gm{Ô(yôŒn½g?c$4/á>‚8Ç~¿æ8>ÃEíª;}ªy—(uÇ™©W:¡/™à측ºáØ‘dZþy4vÕs òþ»“]Ïy4÷Ä^fS|Nóhá­‡‰GB¥Ä-顊ó—b/“Ü«e;Ÿ›óQK·ð^™‰èIh ö7næœ}ŠòÝe'’Î(l8ƒ¼@¤+òÝÉïÛ’·É½6wã'fX«oVóñ'Ðçùø÷|/âèüËô%å_B.r`§K· ¯þùèŸçJäÜ}8þ(w#ùwÓÑä«"5øÇ{‡ö¯i$Oà\r¿ƒ¿Ë8¿ô1ê÷1lqsÎÞ·¹ÏÚ;Á»þuÈ}þêH©_°Ÿ™>س¢}ãGt¿¨ÀpNÆ^…U.Û¾ró«ÜWÈ}üÞ»\sÞ™ñÏM¿cC—“GÈ_Ïs97‚«Â/ƒ/͇‘÷÷PÕRžÓu¬æ#žá9C¿soÞjðLê,paäp»ûþ=äQ<;Œs·  ªÏÑý~&ºQuáœÖÜsûò¢¹=܇éÕÏD®mïªïôeÎ?ôyë]ü^Í/ôƒ¶¨ÿΖú×òÄéaåmC[?}L|ÙÞSõ‘ÑûTûÙуþîð2ä9ÚŒ¿ËŒD¾âÓÈÓ•-Rýÿ p}Ô!\x•ôm úýÓÂaG §á#Áù³ðk‘­à„Ö°“–KÑGú?ÃÃ8¯Üpò:ù¡ÈiÚ„ß —i.v }™ÑÏÉ{¤¯Ö¼Ã/Ø“6ÍÙ[Z™crÿ\Ìß¼cðŠ‘I#å–-ä\}îÝö ÷Ù^~jq#±¾š«˜2¶Ë¸£ [Õž§–«“[‡ÞÏ_Æy%ʈ·|gÏG¿–\~øÄ”g¯<Çè8ž>ŠÜƒØëô6þÝ4xÀµ¹m¨_WŸÛðáyŠïMvÁžän✪fÑé± w€œc5¯ùö)ñ ú.Ž|½/å¿gžâ>ãë{oˆû™N?[7óMF8‚¾Xfð{mÇóù¾3Á§Ž¥àKïõ±+\h€ƒ²5¯—@ü#Õß:{Xœ¦îüWuÔã±¹AàŠüDâ½ÌìQÃòïS§¨ì«:ö¤³†¸ûb#½ŠüI`¨þû¥+6üÎÈÿC!Nkù¿b)¥o£ñZîËå9ÓóU¿ºüœîŠ¿Éù ßvô*2yHvpž™zP¶ ¼’yš{‹­¤Ñü«xbBµägÊîCîKùžÚžØá‘'Oiž2ÿ5x6!>ÿ“à¨ð•šƒ¤¹Èˉ›Å×Ûчzé™÷ Í‘_®ºFšñ+‘ÓÂÛë˜þ|Æè8?Ÿ;–Ïÿ„?ö7‹Çb#rúJ}%ž3ñ ŸŸ»ÿ•ú‡ó° Ž¿ûÚ¶9ª ê~_À¯;–‘ï‰8ð³îÛ° Þ)ÔO¾ì¬Wãÿí/¢ÇÙ§ñÿ­Çðš|}f#öÃô–ðu!ršÏ(³›8)Z5­$~tÞ¡¸à%á„WUïœçòO¿X²âñ¸‰÷öO “<½õLÁþÅC”{ø 5žucBUêï ¼ÀôQ†oBÅçáW_õDô,ï#ïkÿ\õï­ê³Òß³ïò¼ÑÔÌšÃ(ÿUýYeà¼Ö±ü{‰òÚ©÷È›fŽÂ¿EÆǾҼÆÊcú¸ÿ–Øç”ø'‚IÞ£òY>/Ô®‹G‘gÃU¨ž8Þr8vÜáä¾Â}±ƒ=5w}çþ‡ûC^"?þýàÓNþ°ä»à„ÌšWz ¹Ìžª¸ —æ¤N¥Žé}ÿ›ýœïÉý°õäÏÜPüKÓW¼GìÍ{Tò|þ5êÓÉ(o¸Šü‘#øÁô}\ÑíôO´Ü£{6}±Bä/ÙÎ=GOÔ¼uWÕA_F¾‚~ìDÓ›ÈMôüYÞ¤~ñÛ‘#ïA>Çíás¥àúðíê³þSq`‚s°_€>‡sØ‹¤ø(\ŠÃš›ù3ÿ!¸.2^ó»ð~ùc¹—¤úZ:Æ’o°_Êù%ÿ"ŸÙð>ù‹Ò£ˆObk9§’ßÐÛmª7Þ®·<¯ûüPI€¾ªø õi§Á Iƒ¼læ îÅ^¨>Ä{é7²~…?l9Jr<–zäôÆ/jkæÜoø~U¼Ñ®kŸIÓóyÍP)õ™äô"u-ø+õ-ø±uú\~A¯)wZ7Ñbž«éüR¢r—÷¡oUK¸¿Ø&ÎÛW‹ßð/ç¹#õêçŸ nͯÏgŽ“þß ž=;qTFóйױÏñ¯¸ß6ñaµµS¯öj>7÷)r_Õˆ_LçÜ;ýeæaüjd ùEß^úbh®- .u¿"þµúoÆÿänC[.•¿z€þ£ÀéŠgÜœ›c¦pÃÃÊ+ž…?Ë·“/M¬ç¿½«´R‡Í?Cü¯NöH͇L"~J?.^„jüF¾Mr[$³ ”¯¸Xy¿z~>úðuH÷Ú…{w>À縪Ô?v¾øÈžæýǰ?©:â©Ò¹ôùçÊ©Ó6Ld.×öù­ðåçÆªOy'÷œë˹¥ûOÛŠø~÷@õƒnÇŽd ȯ4ß®ŸÛ+>ÈÈ‹dÕwŸ{š÷1õÇÄ.ǾÅ"ăէ¢·ÖBæšÇ4?§9Ù¿kÿÕÜ“_ŸŸÊñßÃß(ÿsŽô[sŽôÔ4˜<ñ{ªïýͽ¥&ñü^áæÌåÊëžÇÀŽdFsnÕår œ{ôZìQ®þÆþv4wv'µTs5š3ý)>³¹çÈTä yz–.ÆÞ¦Þà^’#‡ÖûÁ‰ž°±uĦµàÄüà“Ì꟠>|Õ‹2âQk[£¹—Ý|ÛOØÅ°ðKHõgÇuàwz˜+@Oã>äÛã¦þéÎàßó£Á+¥QwN_Äý†Zñ«áA|~S¿h­Ä_:ÒªË=‡ž™ž ^oŸˆ¿uÀÒÿ<´a;JõLõ„ª°‰cä?®K/p½÷øªÌ@ÏÝK…¯gi>b5x%v4qGÎJ!ü˜xgîÀÅàùcqÞÇþþ9õßç¤x´BßsrÜv ú\ÝykLs/Ñw¸ïü—Ø£ä]ØÍŠMä!2_Ê®FÅ ·ùO>!¾­áæ>àܶ‹Å‹¢øÅÛœùïS~³¹ÍÝÏç¹Gª^¨¹óôHÎ¥C}£‰ãÈSälÊ/íw&Õ÷—{Œ{n<¹‹ÎÇ.û˨c{ŽEþûð_þÓÔï|vÉk€¦8OÝ9þ¤;Œ’WT;ˆ½IŠ3·žó©¸?ÝjAßJÄ·’¼MöïäÞÿ¸¸áCæñ|fð@@ó©­èQӱ⟺›÷ɬ%>y¾Öƒâÿ» ½~E¾ yð”ܘ;(?Ø—ïχ¼eÇq­rn'ïŸö‰_,Œ_оH^/6•çòö‡·qϳœäÑ¢‡äÇšÕ7 ¼œz@õ‹òð®«9¯Rñt$‚›ÂAñü\É}f6€ËÝ]Éó%ÅÇ[„>V«><½ ‹¼eîŸÖ•Ü¿ßÉýÇÆ) ¾‘ÄJòÉ¿ÁEG&wZƒ—‘[ˆ§Ã ømo¿Swüy½‘ͻҳùýÌõïŽÀþ;4×[ˆ&z`¬~¿u2ß—^ˆÿÉžÄóeÖƒ×|ÃùÞ¸æ³{T_z=´¨/;ö1~#}8çVq–êw˰¥õ’Ãç5çö+òà~Uw~µ¢NýDýÔO0Söd°ú5å<‡Àþë9?›ê¤¹£é#òœ‚½Ž†<¥.Ä¿µ¢ºûYÜwú|ž;ûxÍ{8 ~<~§ÍJ<ÔY×­¯˜òµ‰mȧÃÊ}Yס/±1ä’â›ÍMFÿ‡g³æ²/ƾäJ¨DʉOBNÎÙw ö½ã}ú “Gã÷K.ÇÞFFa§Ú¿ì䲸”¹ÛÄWê[1gÇèoø1ð}ümâ[HñÉåÔÇbwð¼ñ}¹cœG|´ú{¿>Ûÿª¸‹ÚVpCȆýõÁî8ä¾#šÿv?‚}N->ÁêÛü‰x£Èb›tÔ_G‘8ïü»à-³xwò~é6ááMàûô ¶”ߦuº~ÂèþFÙ`î;7CsÖ[Å#û5v/z4v­ÝIý)~-úÚ ùÏ>ˆœG?Z‰úz¿å|G‰ý ô'íB®=¼ì °7§ñ>a;çwÓ_“¿\ýÀ;Ä7Qùé{¸ïŽ3éÊßʯý3ìgÑ?7µ^¾÷V#s­øÚÔ·”2%×\úzÝûÉàæØâ'ˆ/µ>.}FÞ"ú Þãxô¨ízòÐ%Š#sïi®rQ§½Ä¯t<Èç&¾Æþ;&knïyÕÃߥßß©9ºÖþø—Fñ-Ù^ÄŸØw‘×m9„= †° y|ßbþ=ñŒú‚ÌÌ›5´“‡ôt¯äo >è £‡á0òÓ¦ù7Ë ñ”ÖùŽ¢®ÛC>Þ­ùÞdg}j"ùãÜvì±c:yšØ}Ò;ÅC¡'„Û.¿;8£/òØr…xFã7íᢗ±cÑ{¹‡økÜcXý¨…/üŸø¸èíšgkW§?ö·ìOø7¼ª‡$ŽÄ>¶¾)>Œ£7Î㜭;Ô÷ð7ø<Ò]}ÊÒG‘ÌÉoÞÍ9Ö7 ® ÔÌ&ÍU‘È=Ïü¾ß%~Ë{5׿ŸxÀ¼ˆ>§ê©ô†®U~í=êá×è}èWá[ØØ·Š#&a?ï 7>ñ¿›'*Ïô+ñjìÕ×Ï×ܧú²KÏ'N5§È/$Ǫî¾E<¹VìoxŒò?ƒóÝ£ä¿ïàçÚ‡aoÛ.Ö|l!úú˜ïwÌãÞs_¨ïz¥êºê4ö¿Ìx}ÿPñ O¸£ü~s v»¨¿ò«?óÉ¥Èã´ï¦-ÿ2ÿ›Ñºûåó‘¿É¶hŽV|ÍoÊï‹w!û!ö½­•ß+iîÿ½þ£:òRâÓõÌSÙÏfnÝR¬þ™Þ¼‡ß¥ºŽ[sÈâ/Εq_åÙSªo„'5ÏÅ.&ÄWï­UÞw¡êY§ïX_"oI‰ÏåXÅaW‹Á©zÔåÈCD|‰ï8¿ÎºcìüU¨ x"%þ ÿð»|Þz2yÛá@·æµŽK½æ^†€[:ãÄÜSü{ìp‡§Zû<|Ä¡ùñèGìmõ¯Š§.®xÖÜû_€äÄA‘~èCøvÍ÷ ǯFçýS‡ObAÞÇ{ò7Âeþcñ¿ñˉW½{Á‡fõ}´}¹85ÙÎóhλ´7¸ÕºNqjBsÙ[°s¡¥ØÇ"ðº} ~!)Ö°ø­…Ø—ö×4×®|xö<ñ[WŠ!®~‹¯ñ ¾4ç˜WH}«Í÷sž)ÊŸA>'þ.áïOä}‹',mû˜–ѓƗ:ûuµ·d ö,r±âäéCɽLŸaP|›É0ïaU=´ãiìp£9w%ŸdS½²Í†ýŠ>¯zÞÅàû.ú ãW¬×{µ/$'ò×v,ÏVîêfqõ…e?íØÇaªxÈû¸ —…ç:8psÄH]-þå¾ÈCt÷\ß@<˜ê+^¬ËøüüqÔ·}apGBsœm/OËU"?¦^ð(Ç¿ÒsÞÊý¸»c*÷Чb¿êã¨ßÍëAjîdò6ÍÝLJ)nˆ“_ª^ö3v,z©úwGkËÍô8žÒ¾ƒ• ê«(-'*v¿pý<þ)ê‰vñåÏÁžXϧ”Ï$¯|Œ÷ÏR½i#ø®¤?¸Â³ùOû•‡ÊÈÞý©º×5Ø…t¿ÑúzkûXúÝK<Ý·Vñ•ø»‰oé ä9³ûàóð|¦ÕÌÇç¾Bî[?ÃÞ7>ÏϧvuÚuñœÝ¦~ ö·õ1ͽÿŠ(È5Ò÷š1©¯ÕMŸKn q~ãÄ-©…ÈWI!zè-Çn[~ÄΤ~VÝâF~¯å5ò>Þ?‰§Ý? W¾1Ø—x+v¥üCòvù.àrÇ·š{^¼ïãðc÷`/‰· ù ]#~Þü@cWê÷ÁŸßp"|.äË‚O4v‹üÃ3Ä'ÍÏ)?3“z¿åå÷Zùws¸8ú«ö/<,^äõÒ£ßð—‰âÆh<[&ûôýB±ÞœOªv¢ý8Î)[">–eø½°ø×¼›é0}?l,.^œS±7þù_ÓͼWÛ9ÈiË.î£Xó_~lê ¯3}ÿŸÿÁžçŽ‘]KþÝú~%3ü‘ªÃO:Oßb úÙ)Þní¿ ~J¾ ãuÅ©‡a¿[߯îG怓4'è}F}(7óýqñ:„¢â¹¿zeýô…ZœÄoùÜsñað''¶iþ¼œ¸/¥þÜíE MQ¼ß—üEììejú”^¸»sÞûá= ùH^ª=)š¯ð'¾àÛ„³vŠŸ@ýÌÙ‰à$Ï{ÌÝÔ‘OõŸ/â÷S†æåºioXOñ¿B>0·]¼âGŸAädõ‡våÜZžAò”ñÎyï݉‹SïË;´k ö6œB¾)ùq¯)§:ÈcŠ3¿VÿÅ«š^ .i² ÷ÑOx¶žØ‘ù;©¶ùõý ¹ëütüp‹iýúºo60ìç`7çOen(þ.7—¸Í¼Œ:IþMÞ«ìpPÛìˆYóábô%±}‰Ÿ+<€/5r.ïÝ<]}þûÕÿV^Xn@ž]ÏÐWgŸV~•æûÿåÜÛ‡"—ù³ˆÏ‚!í³òЯåÚ‡œ”|I½ÂW 8{~Ý~Ÿ[ø¤êþ3øù¸ø´ò׫/«—öw½¦ù^ù¥tŠóëØ¤yìSÁ¥Ã8§DPq¨ö×e·)¾»˜|spÄ/4„˜“³nÇnÅŸ®;@?ÿüåäõÛß÷X.¡/$^¬zÆÓÈ_ŹÚߢµ¹­ÒgÑq |0¹—¹_¿úÁªúûh^»§ö«|‡¾xu±nâw~ý·ßF=µåiðVòJ>/WL¿­ =k|¿Õ2Sü7·ÚŸaÒ~¤Žͱ~Œ½,}‰~ÎD~³ýäÑžÆÔÿ¾§JTÏTßt¸Rù„ðˆUü0fñ FnE¿óõ¼·gö:7}Œ'O‘‹r^Ñš¹üky@|NËåfªµûjѼRè)pu²[s7~¸a%8ØÙÉrºðéõ—îâ=‹‚ҳ͜Wîä_‚ãy?ûsê;ù <“Õ>®©ÍÌ37õ&S4ÁôŰ;¿6ÚÕ×ßz+÷šœÀy‡GæÜÍGâÏò¿Ë|¾,ÛKQûÕØ{­âþßÅ×$>òüÎ¥my´Ê¹äŸòcÀ¥G‘4D^óiðSöìIë!ðkk+y„ÆkÔ7«=ÑÅšãx}²j.ÜÿñeË^ìDâ)õe\Ýjk×¼ ø ›/ÓÜU/þ»Eý‰±aèA\<¥–Éœª÷ïúsi—_ÍÌ NòDoS·áG¼ª ç¶s¯ùBå/4‡}9;ë‰ «úÚ ‹ï‰¯RÞd!v21†?ƒ3´GªBó—^úƒ“Wro±{…KsʬUÃRÎÝõ ççÚü˜óüÝ¢ùå©W1—o¿z©IsGKÈ'†'‚ÿ:ª›ê&ú’=‰—oþÑß[}· ÕÑÇNUŽd¾¸ãxüõ4ì‚/Ã÷µ\Šý°½Î =¤þѨêå5Êc|J|ïh"í©:ËaÊ«%UGù€üÁœûèï6)Ïù8Í«¾ì¤ø±Óåü^û^ü„»7ö=»ÿ[qšö¾Ý%ðþ9|ý:NíÓˆûù¼’;y¿äUœ[ã4íÁ𢹆ÞÚ{5E{¼îàý=O‰B¼Ë}ž¹6ú,3G(¯õqWú:ÍÙ€7›úêçÏÔÞдxR.â<⹚ԅsM_οg¿çsË3ä=+¾éª>Á“‰¬ È©çzÍE‰"ù™su ñ3‰ÀÞ“Ä'x ø'üöœ=B½ÕÛ(¾Í¿U'º‰x$âÑ^ óUÿÿZû ß_æïS=ô1þ,R}Óí×› ¸¬yÉÝO¼+ßnñ®[<©O”o|Bõ¡íô[9/ÓHñ~†kÕÀ_•v¿Y>ûŠoÃÎ4^£~õõ¤Åcw>xÓÿ$çëïÆßsŠO,ÍóÚÅ÷R<èôN;j¬áöðó¹SÑ»È0¾¯µYûnOÆù7©Oj ö&bÕü\ œ]&ÌáÄ9íUž~&û4Â!7髉ﳟ“·Æ©G[n_ãnò,¹®øAË\ݯ—ç‰I*4WPòq³åUüSâòk¯ß`)øÊ}üßñØ»ÙOÃ'g;µ³Ž«}MÅàÛ¸¾7<œø5:?bùBü°Úë•ê‡?²¨¯>5»Õü¬úxÕG™Þ‹^xÕQ>þ´Ð2äÒ?\óM/Ðïê=JyÚ&~nzׂå…SŒˆæCeà‘øÕØi—ú*,7‚«2ò\E~ö*$+OSÊ{»©_h¤öwâó,ß0W“Á½E½âÏ{‰<½Ó.øø½írü­í;͉=%Ü©½@~õ!´WcÛûÉÎô|¼§4×_©9ï•àäŠâyoÞxÏÌÙÚkíGŸóìDljÔá:ûRS%¿6í5zý«[A>¶Í§ðS»ü¥?]F\ìô+ï§ù„ÊöèeÅ;mGÛeâ1¾˜÷r)î¬ÿ“¸(·—{ÿ™}Mû Rª¯ÇÉZöPçHtÃÿ%7!gaïïÍ7\?ÿæ®׆Ç¹îÆ®§OSŒE}±{Ä›s+çàrñ|-}µZø(¿í²s'’gÊ&_Kòb©ã\íÓÈFÎ Vx¿P¦yŸú¸Êů`þ“:kEþƧn™C}9?½6!Ïâÿ‰ÀŸ…þÁ.XßBþ§Ë/ÌW?Ø!ì«¶æ=$“9K¼ õÈSçžÑö ê;èÉç9oÂúîÓܦø®rAú¨-C9÷„<@ö]pgã:~?X§=oñNò~üh´Ns‹ô¨âäÕõ°ö3òüÎÅï+òÄ«äq#ë´Çr ï—XÄ÷“ÜwÑæ¹£º¿¬úóïƒÿJêeÿ2Ò«›ð£å~ê§mw‹§¾§æëlšƒNÝõ{È÷'ƒÄe¡zô×–Gß³6p¯õjúbUê3löáøÝø;Ú1ˆûkÙ¬> Í%†ÏGÎ}ýxŽL q´y(¹ Þ‡Î|\ñCòO#§-߉O…øÑºª";4çúìÏc÷m_k.zegŽ<`ò'ì›ý:üSàjø°êN¥ßrÞ8ÞkFû’ÚÓ{Þp¯ùø/ÈŸ[¿Tža<ùvìRñÍØ¯@ú?vsî.ñoä^%ŸÕЗ{m›¨¹ðÈgù‡ÈWÚ¥½?eê' 9˜ØÁæ­è{øhñÜ5‹g{¨ø¤Ï#®±?¾ä³äS:¦ÓÓæU\ýzÛŒÞ×jŸhÉ0ô91Sûpßþ>à§Ö5øßÖïñ³µñ»ê¡§Åc0F|¶wpï‘ØÓüMØßÒNþ¸µÒׇñ“™(þ¼ùLñ©½ól¡~繿œÚ .JKÐ'Žê“ø\Çnõ9\Â÷—ÕÁTÔ91çÇ⣠¼azU6Kû]*Á!sZÖKxÏÀáØ1‹ê65ýÁ‹ÉoW—bïÛO¤¯Ï>|ž/ÂO'w#¯pα‹°£ö¥ÊµŠHû­ÓÈÛ6i¯Fò>äªaœx[V¢?•ýx¾éªÏ¤žãóÊýØÜ³àóü9Úvÿäü‰óÌ?–¿®ðý&>¤#8ÿD¡ö3|¬8î=ÍÜ!\×&~Zí7‰67w<Ž|ÍQ?QB¼Ð¶ÇÁ… / ¯%MäYS•ê§¼D<„cÅÇ<¹«¸åç•7ûn3¼'Ó§aý=¶­Öü±ööT®Ö¾›Ëðo¥d¶j_ñìGùaÚÏö¢æLŠÖ’ÏOôÇ>æNÿûKÔ7º’zTôwê÷ÕײŸàfï·ˆï²x;ïŸë‰'OâýÜ'j^e!òä)ÆÇ>МÖ~ò§aí•·Ê~¶=J])bV½lö¹õtî+z“öK®RßÙ÷Ô™ýiâ6×>â[kPu¢Ýôµ¥&Š'E{EJV¨®¢½Î+ñ7¶åk¿S~^sê}5¿Ø—8"܇x¦úKι$…|6Ã>›ç‘7/éBÝÐõ)vÉ5Zõ¯nz.õ…¶©/Ö¦<꛼§]ûj£_Š÷pø%Þ=ºá¯‰·ù»ñ÷¡ŒêÞ·K ‘¿X‹>8&5ÿÕp.Ï×$>’”‹sË?FÊ4v)ZËûÄÜgí¿à¦DoÙ¯›‘?ïŪ?ôѽþfð}‰·Á©Ùã¨û§Ôg–Íù†ŸÐÜà·êïz¼fMŠÇ£³^T˜ïºH‘ÿwîupju˜x&7ZsëkÈ'ÚkÄ·¿T}ùËÕPŸIFîZïW}½ ïo;žóʾ!>Lñÿx;Ä«jhï× â­äÉÈC¢»Ôx2}1Ö2ì[´œ3vïË{´Ñøxhê/Ê¿ÍÀN¥~Õvñ|øÏ@Bõ|ÎôRåú¡·6á­¼³sÞX{ó>Foâ%àÿ|›xÎÇ?„{òûîFêùÙ«x_›âFætSÚó>û©^“Bw}`ØKµçþDê^­â¥²xùÜä/Ê=žL÷æ{S·`Ê è(™Oþ8§}â¹ïá[.Eÿe~ú×2 ¹ …]4÷'¿”_¬º’>ÈÜ»ø»¶½Úçó÷m>A8ªþ5Ë5ØÏÈ¿Šg¶ó9UkÄ—¬½ÈÉjá„ü¾gyÄöCšïºCõØ£°Ë^ÍÚþÖ>‹+øýú}ä?£Ú׿¬ýôo"oöø{n0ñK¡x2W‚תçsŸ)?ôóŽ ˆ¿R/ͯVÿÿôuç¾_ˆ<(äžS5š—z½ôÎå\³§`weØÁ˜—ïo_H<YÌ{¹ _î£4'»‘|wŒöMWÿÛÝä%,Kãrm…ã¿WÚ‘ï¬âÁ\_͹.ÀŽù_%ï$L©}‚fpGæ(ÍU-ã9 Úÿ®ù§àÔÕ’ò㹑àX»ä×v ÿ=ôñ²c ø7h®ñxí\Â÷ØOâ¾§ÜÈÜjì5ꣵ0ß”N<ꬥž9™ûŽ_/Þé±ê†ýµìÑ<®öJä¿×~˜9‹Èûg?Àï¥ÔGŸ«ý‚§©Ï·7Ÿï8Sù¾nè}Ó>ñT6á“/F&ˆ¿·H{èÿâóæËVŠ/8öúÑü¾ú^Äã’¿Oóq?ƒßÊ/¦Ï#<¿W};zŸû»ë ?fú…þ[_vÃÿ¬x;®ãósWƒ{|'€Ã¢•š‡yOuô‡OûÏ’NÍϘÏÀ®Í»¼O›â×h9ïßz4ý …#ÏñßÑÇ2í·Ž~Èç6h¿ƒ5ÆïnÀ?篦ÿ ¼Kóƒi²ö(ØTG N@/Âêå8ÏÔoij´ÎWsË>ñÙ;Ä_ÚxuK·ös9®RëõuÏ>K{B|]Â?ùaØmïMà‹ö¤&+Ÿ¿^}¦=‘¯ÌVñîŽä½ì;4‡3zkö¿…øïWâ_zDõÌÚ4¹r_¥=KÚ[Z¼S}„•â'= r„æ&&pù[´·ò!õƒ¨¿¬ršxn{i¯…öR%üÚg<û˜Ü­çÙ¦y‰ï±Ï¹;±ÃAõ!;ßR]2¸Jü†šMøy¸ûá¸ÿÿUþùIä%ü<ö©s_ç<¼ícÅ“êG+y™~à²Bõh¾îz~¾Zñ\jÏU0 ¹ÄKÄ‘.ìv‹ø;›¯Ö¼òä…²ñóæœ[é'äý놣Wóü³·l~¬¯á8ûˆ#.ðõQœ[«½Æ×jßäûœCÙVâìÜ‘ÊGíÖ}õÆ”*>q~­<ô±ÈoS%r¯WJç+Îß§ù–;‘¿ÆÃ‘›øàâ«Åò*ÏÛ¾ƒx¥]{ì"Õâ;¬@~?€ûÚO’ß(Ö>Æ—°¯eoh?x»Ý¥èsM ò]:<‹izV¡yÅö·Á½ÍüW7€Ý£ˆO*Å~=ùŠÖß°w¹Vä×2½ñŸM¿_,€O¿nˆŸHŸVt ç×´‰?ËLØÔ)âØ‚üû—“?mÙŸkûG{Åï×¾;þ:=Nõ©‰à…Lù ‹øŒJ·bwf—1_á~€8¨á æ‚-·+¿ñ³úYžÑ¾nCuðS‰RÐ÷ÒeÕ‡”ùYöæ6ô)s6çîú ÜW~„æ†â­ã©3eÆà‡Â—«_>çm½ÿ˜ùFyƒÁ-^í“Î]L~&°_û… ÅO8PuäÃÅ·0 ük{¼ú˜çiÞ=w'çzÿTu<ç•T]$Þ†ÿ©×VpˆìÃppCæ}î7>F}•gjÿÖ\ì–s·êþàiȽŽÜ¸BêK„´+?PøOÅa–ÆŒèBÎÏs üšnô'œp5¸Ã3RulíÏÎýÀs\¿Þvræ(Ã.Þ"G‡øã2²o/ósÍÅ•|HŸÉyÅÚÀùù¿yîðwØ­³R]úUâ‡Ö±¼¯÷ ô99û.ÂÞekÑ_›ò£¹÷ð?6ñã×]¿où¡‡ïÃ6;ç¯yÿð[c9ŽT4E4—¡yþÎùŽÔHíÅt»¼âýÖ¾¹Lu'ϵø …O³OªîÝ 9VñóŸª|Äíª _ÌhÕɺ*.Ò¾ž„ú]â/‰¯ýþ¬9çSø¾´ž# שïù+úNK¿Ò> Å¡É/¥/ß)ÞùºBY õ!ßaÄ=®Õºßµ|^Y3vÂr¯ê`NúSgò^åêËLž¨¹Éýøí²sÀé¹Äë=–çŒjoKJý"ÞžêC ¨} q©mœú[pnm¿h  y^÷¹ÈKLý„y«æÈ:ë–Qô5Ô•ÿÞžFÞ;÷!e?Fn£¿‹¿¶ss¦4ö­r9òàPþÚ[Aß9_›úÿ2s3zeKkOðÿϵ«oq…òùEšÍϵ¹µÇt‚øŸþ'ý\ƒŸŒÈŸ§~בÈcfˆxâÇ_„»Š7ú\ìnT|%ùôqÚ¢²7ýÕ×½9˜Á-9ícMŸ¬8æ^Õ)ÞÀ_¥ª°sùš{ŠüHÓWèmÖ‹œÇ¶ˆGåIåSÔ'é}@û¯j¯T”ûóO]£Qñjd ý‡Eg»]rûJ#û/Ï“y…¼yÉðÐGŸRŸdõ$Ÿê¹‘›ƒì%ÈS‰ê«ñÕ⫚¦<úqÔÅRg’rkqD绞çq^«yÜ£4ç¹Cûkç1O•:AsׯüXðõ%vEÞ]GŠ[õê6í…ž…ž4ìW8Ï"èöˆŸw‹æÙSš³û;}ÿ2gŒúãá¹­K®“äyÛ.§¥ÖbGã'Ç/ŠR¯¯ž‰ýsm'DßÑüFzâ—_²üŠ~{P~êi̓äÐ÷‘àÃü0â/û:ôÕ~r–™<·ÅùùÀ÷Üõ>¿eê¿Q¯N|Ï}•|ŒÝÍç©‹ú®’žÐ؉èu‘ú^S9wË5àüYøÁJíEiX/~š.àK‹æñÛþEþ+4/e¿çŠÞFþ ôñ[ö9å;/Ån´m¯Ö2ü\²÷Òm“â@{?êý™ß5?7„yÌ\þ#"^„3ÀIí9œ|XÅí_@D÷Û žü!êÇ{š÷­ìäã?ƒï7×ÓŸfyGû‰V‹ÿn*ý±×Å{ÑB|_Ö9DZÛiõïÄÖÊ’ë8ïè<õ==«ïν•\K½¬í)ñõ—^}+Îé¼géõÄË–»ä&û"[Åó™TÝüiÅýò·±A<—s‰òAšƒÏ'ÁÇž#ðqéE$‡Ýs?¾y׉§îzpUÎEž<\†ÿ3îPûJî1qòž£¾ÕÁ™¹^œ{…òõñÿQ/u^ï¬k¥þQŸ@±xNw#ç?þ¥iú’žª¹³<ñˆ_}S%Ú“žQžã¼'ÖÏ_×í"#±RþUúèʽZÇÒonV¿åS⇴ƒü}ÉúÓ˄߯Çþ¶jž2ÿ#vÌv>xÍvºæpýœ³uƒú™¾ï§Ž¯ùÿ¦™Ç½¶ î uW>²Œ{õ(ïg™ÞLj'4yM<¯CóºÙÉü÷”K8ZûT2/ág ¿/Ï3Œù“ø §vîåîpô•]ñƒÛr—€_\ÚÝ&^ÑØâ ÷òþ¹ÙÈA¶]7¿˜ç‹Ý¥ý3Åâj§þ¹€¿y ñCzŒö¤]¢¾±çy¿ØÞ·Xû9ó-؋Ȟßb`Ê>Ì=ä,•ÄamâMnRÿÉ{ê y™8(z'8'ô2x7}2¸+ú‘ò…ík»yõ?Î÷DbgêÍNÕ?‘çvI¯g¨9YîŠ^Ëù5¥°+Î~œcì~ðÚ”ôÔæ°›AõÕ&©‹„•÷µwÕþ»áªÇß­¸þìfºÏÝ>UuƳy¿üM|OâVÕÁ€#Ò]´ÇË!{½|Ö6{Ô¬ºuø áñ6Ç^o4ïÃgªÁ•1«æ¡ç£ñÏx|Ä}æFúf£Äãr;ú]&þüžÈ}ÇUâiÃù¦¾#ï’ݨ~£#ÈÛùô§¤~ÖÜÞ`îפzy ½E~Âß[´7«ôQxÊ­Ú?VŠ:æ?… Gi›æ%fißömZ–“Ïo,>Æ_8ïòòê¹{¥_ojxds‡!>ñ h>9þ?ñø_ƒÝ/ àÓ—óþÉ’ËFͱ;:çÄÅÑ ¸ÞÀ^5ŽÀ%>#ŽËæx÷ÊûŒ$oYy.q £~Îý5rf±‰ÇòXÅËÝÔ—ü>ö¶¥]ó9fñµ«ÏÙQ¾HùáJ;ñ©« ¼ Èo\ÊÜJæ å4ç›ß¹t¾ùðši.öÄ+½w{°Û®»¸çðbõý¨ÿ3´¹,£~ÒW´?+ߤk«ö”ä±»Þ9Ì¿¤à«–ê_,ϵæ&ŠçeÿE~gÿJ</Âïqüd¼\{;û‰W¯Yñø=ªß_Œ‡oà?›úáÜñpóÉà_G\ýsψO25FÿYû‚Õ‡¿N|-ü~ø~.u¯ø ¿WºïäsÓçÈ?h¾¡œçY£½M§ ‡±´wO<ÒéÕä_â#õ¹Ÿi¿Ä0ñ:ݨ¼qä5»˜ßk¹L}7Oñ|%ïÃ?œœ‡_0Qÿ‰¯VÐ(ÙµGoá¿—÷@Ÿ[~ÁîG¶#·&åÿóïñ½¡¥šÏ/ÀÚµ‡>Íé…ú«þ°ž>Ï ¼¿mŒxf?À?dgbÏâ§€'}çr^>CóišÍ[%÷£ðs‘3ÑóÌ^ñº Ï·'Ö_ø»ã$Å‘Á×qéKl—ööª®Uÿ…øg¿Wüqy“ð}šß jþä.ž³ýRòõÚË`ù9p‹‡ß8ùÛCØIËÚ§ó'÷“﫹•#Á3‘G± ééØ_o õž¤æqÓÅä±³»Õû9ùŒ˜üg&Þk}^øõ-òˆ-Årßß~œògp® ö“××Ñ?ìI¶kŠò;â÷y˜{¯=)ïÝö_ÜôŽðßÑâ‹ÿý-×>1ï±àšÓNýÌòáåÿÅ¿Èið0í«Û@¼\ß—yÏÅœWøüb맪ã§|›Åƒôæ0ºƒ»=#°¯šóÏÅÅ×á#^ñkMþwñ;Í9ç¶Š‡OqWûâ¹z¹Š®¿tæsÛ'‘7Ìß©}äìËm»QŸ¿Uó’k_B)ö­}5yôØ|áÅäÁý‹ðwÓ´ÿYûÏüýˆKsÏjYŠx­qv ù¡öÐÍÅûžÿ¸Çiù…äwbÏ!çŽ*íñܾο ~ºØ«æGð·É3ЯøñÛ~)Þ°}ÈUâo¾/wùK¿€<¤Uçoœ¡yJ¯x¦P+ßßvŽödˆ—Âô‚öÿþª~™QÜCË,äÊzøÒø~âû4'·Z{¶ ¨³šOEŽ3]À‰ùfîÝý>ö=û*ïãQ_Y6@üçú½·/à\šcÎW"®-äóÓ¹ïæ™œGv¡¾g7y›Ìjì©K{ð,âÃq= nkíÂ÷VÚÕ§ýr’[Àïe’×K£:Ǖ꯿Aõ+õ{ÛÈIÞœ—µï—\¨þ*ÍÇ¿©ºØ>×tzoÁeKÄ“z çø‡ç |%>Ï~à¸ää,¶Fü½›ùœpZsj÷àâš¿Œ¿­ã¹ËÄw‘¹Ïm÷«¾ªýóŽÉÜ›o)þ°q€úúsïMÊïyoâ9ò~á²+{w«ìO3Ïßt¤öÐÿFþ´¢ÜÊiñ2ÝÃAôß~¼â˜Ašï8Sû†žDßÂÏ¢'Í>ôÒ×H=À/ ïPÎ/+>ï·àÕøR>·z>þ#–Ôüe‰ø_–p.¹óe‡ŠÏäü^öwáà°øèÄ#åû]{ôÞÅMò7Ê#YN¥þl{ {kbŠc“ó°+¶îÄÕ#8ÿÌÎ59OýÒ÷Óçú\yÍË›¨ïM¹¹'ÛëÔ:çP­QÇÊþƒ>øoã9Ú®¿7$É?ÆßS_Õ âÔðålœ_öaìKqß­wÙpªRŠ_ûÛ[‡‹®{“ºNóq­ÄÑÞ4y™²màÞt½ò³È÷»Þ'^®z‰ùÉÜ-Ø6ƒ{È«>˜³xŸÜâ•æFíÁúWýNqñØ‹ï$Z »zòþk_¬øîâê?È Ž¼OÖ¡xäÙ·°7±{±#é2ä;$ÞÜX“úú´OÕ­þÁøõ£¨=ÅnÍ­×JÿÅ|Kûijµ'py“ö4öÊr…òm¿¡çmªÇÅÇI>NÄn¹¿&ïVßAèå^ÁŸ8çqï®uøÑ¶Ù¼oHu¼Ð-ʃ·ó¹Á—Çüæ”’?ñœöð§[—ï6òµúžm¼¯ë4úÝc‚÷çÿ«}%ªÞ?Mu8íˆÏ¯ÄôÁù±øàÖKŸ–pÞ–éÄ{¹ó^±ÅºïUÚÏeRþìég­ìù<ôÆ{!v®8*¯üÀxí‹;ûݹ7±t8±ÃC}Ъ=0¡?Áó/¢nŸŒk_ÔAðL‰öÐGoÅäÖ‰/}÷Ðö)ÏY½ ½Ëª?ÉæP£œR;™÷ót_Á÷ø¡èÎѪþÜì~ðSîqQÑú,½WQ×ó­ÀO…MÄ©ÁÊcwÎñ Òž³‰Ï£âû-¿g²ö¬¼+^”£Õ/Ò >O•hŸð¯ÊGOÃ^×½ ŽŒ]Áùx.äyü7 ¿áq’sÅË+þ1= s&÷œyŠ<°'Kþ´|-qwò[í¯ËiÏDâÏ’wT§ÝÌs—¯¢ï±ÉήÃ.ØÄ Ÿ<û‰R'ó¼Lßxöá³O5W3 ¼4¤×ñY‰Ï<·Š÷ŽÞÉ=%ÝÄw3>ýó‹…óÖ®·4ǹHqÊxà⻕¸IýN^üW‹öú4ËÞg—qï%2_“ºüSÁDæÌG¢Ç¹Éêo·¡ç©¿xS³ú–æ‘/Ký¦ýЯj/Ú*å•çjëBôجýÊ5¹¿æUØÌWúýÉà–üM¼GRûel/ª/ÀŽë8^óʪcÅ×sÿáÔõªöº-AÏlç¯ä;´·ÂÉœY"¢ýëÑ#‡x/oT® ùn iÎ`>ïcý|P¹˜øÐ¹Oó&g!çé*ñ¦]¬½NâtˉÈqÅúé“ßiüÿ4¿¶¹²=N>aÎGÊÃ]A:ö³ø¶ÿƆ§§»^#Oßɽ[s×aÇcë°ŽÅÊG/Ëxú-íâ1ö´z:uïùÓxÞx çyY}äâEK9±¿¡z߯ß;÷ÛþEoÒ¿#_ ý˜wôš%Ÿ1áÈEÌ¿Æ|~\}$Ñ#Ð+‡öÅdÏBO,vÅ™ûУöõä÷Râo‹, /Zþ/ö'ºD}]â—ÉÕ7Ä´×"w#ý3å{Á –ÇåW7ƒ'ÃsÁ •ú÷ø÷œgÓ·àŒi/1_Úv~Å>Füöª/šh.k±öËœ­|÷ î¡öEòhù?Åów5úbû^û¼ÝÊ[ÌB/ªìÒ[ñç˜JáWðþN-?Àù”<¦¹âÞ¼oÙÃg~Æó÷6o.ù½ö2xžÂ§£váñܿĖèoèÍoÜCßThvÇQ†?tm/§/ОÌ:ô¢åÞÓbAÎæ>oSøpÕQ'þµÖ=MQŸÈkØKúÖ:yò¾È½f—ƒƒ¢w¡ÿYñWŽÅ>Ö˜ð^Í6MÆ~%ºi/Úðù]ö¯EŸÓó_©=·áOãóÅ'Û“{Ïß­»7v?VÈyf7h¯gÆYßíÛ ŸúgWÎ=j¯cäK/±zòà—<ç ·SГð…ྲõÊ׿ˆßh}üiîíð­uïí¸…sÌŸ _XM ¸­H{3Z¦ãïK}Èudz“Ä÷_ƒ>µI<ù4}ŽÁ·Éß´>JÕ¢¾‘èÛòKƒÀçÙWÔÏz†ö:4Ÿ= »Ÿ àïš³ÒóÀÉ~§£»øË6¨Ïà]ä¾üí?šüTËüvîCô$z)þØ3›ç íWs¾ö ÏD¯ÃWŠoÇvºæ~ßäüC·‹·Æ%œ¶[<¶¿bߊÜì÷¯Ržf,ùµüzž¯íVõ·jŸ÷¤Ì:Ûã­ ïtø`â7‰Wjr—úEýÑë•ÈáÇb·`ç}&õ Šç2å~Î=^¼"ÃÐûHr”¹Lõ Í‹¯ÆgQÿiê0ÑàŒöþà¡ìwÈwWv^ú» ŸÜ(<ýçà5ð?–7à=êì³vá¹½'ˆïàRÉïŸä}ü‰ê|Þ#³û–q¡åáÇÉÍC>šnÆn¦ÎåçZö«Ïí$Õ-¶*oqò]|òª/ÌÞ4ïkïëcÊ3©Ýd_ކ´ŸõXâ*óbòqá·9϶ƒØ“ÖQô*½Š¼Ip1ñcx*ÿŽ+nÀïYÎ'_¹9ªRòAô8ú5ù Ó;ÈwèUòÐù›è‡ 'Û?šã s®¶ëùÛ.Íc_ÅœkV{~Š?ÌÃÁë¹ÇpÍg_%ÿò‡êšwÑç•,â=r/ð½­/kólòsOo"ÓÈ% ¾/9œàº£s®<Ðt*ç~YyªuØ¹Ü ê?¹é|oÅê/þqô)tÖcs~øvZjÄÏV‡·÷T(ˆ½‹*ÏeÕ~ù’mšß™«>ž ù1_wâß–¨æYUgoùüz‘Ï©ßË{¦¾SÌpå/÷¨¯>åô“â#?D¾$Y ~K,oBím ½jc´¯áQò{añÇ”}«~ѽøÑÖ5ü^8">±÷µçeÏ“øRó!p߬cÙgÒ¼Tü$«”ŸQ_¿?R©ül¾óÈLBÃÏHOÅ7i»‚üQr÷oÝ NÊö¡Ž—{€úŠó⵨ûzû~@}¤ âW©û&¨¯¿¿’‹Ÿ]÷c’š‡)ÿžp6j¿Pô¯½?þµA|¹ÃțDž_ò?0癿ùJ¨<äëàöX¢“§Œ9ûtò”œ€Ÿ¯~“s ‰×(÷"÷¼ü–’½}JjJøLðºOü<ÑqIvv?}ö:vºìÃašþðöÑ~Kíù( ;d"O¦ÐgÛlž¿%Hînñ>!¿K¼¼~ì^å[̧á>SIñdý =÷÷jÿz7ì¹ çáž‚ŸÊÓ}õ?µuˆ?`¿Þo¿äB<ƒíMà¼ôBî)¶ûP1Wó™W¨ò&æBÍg£÷m«O÷+ísûRsqWpŸ¶øïI›pÿ}âÍþ;ê~Lszâs®Ôœ·x¬R'h/ÈѪƒgßÐí=Ë«îõæ*G!Ƕ ”ÏþŸê<¿boóCè7rLç|:\ü÷jíÝnQÞÉ·“x¬tÏ_æA>âjÇ…|¯Eý~¡í¼GÞ¡ù/ñäoâûìïÿä7ß«œ~Uk“úxë?Ç®)ïâ}¼¬7„ßC¾5ו¼ŸUûuœ ücäìдiýêÞºáQ#gæ=3mØ —x½âùJü¢}H»´¿"®~´qÄMÓ³œ×>ûâ™Ä#stYíSÈg4§·„yÜVñ\f^åþZ‡«/Oü.;ȯ[‡§µÖŠ×TuÚ¼_çüœöñöW=e?þÀÙ¦~íwtÇðí˜gÌh^+ùuùÒÓÉK˜ã\›Ó²ÇW1ç1'Ëä7s;z•Ü#¾: ÿ=ú ñf´X÷] Ž+í¿;&s/^Í1¤ƒ¼G›ä5ÿ†ò··ÎÝÎs¦–Š—,ŽóÜ«¸âuñ!ª¿(uy!ë0ÍÇuîw¯wâ~ÕÎáó²›°ï-=Ô¯ìãçÊÇÒŸá{ûSò$y2K'ïÙeÊDų3»Ö\hè ÷Ù\M?K~ ý+^úI‰å-üõvêØ%7ßg¿Àoº5š,Ïó#ÈK Jœ‘ƒw›7’ïO¾Ž_hîP]%‚œ•—רÏÄŸg7ç¼…}oÿ¾‡p ¢:j…úmg ïûo¢/ªî²y—1¨x‹á} =+ŸGž,þœxöÅg™ËÂÛšÒœr?¾Ï}-ý8áö3ü/çmQýæüzX¼ÞéJáànâ}/i.Ï>â¼øÍÂˉ Ÿ¨ßþ0å]UÓ~Ïg¹·¼Eù!í9n;QûÀbïMKè¯ñ÷Æ¿µn_èB=×eØ•Dõ»Ìåóuœ›ÓF¯]û‘Ê–wž&^ß­ÜKùälsˆëÚ'òþÉ•Ox†|S®Žç›1‘½±¡Éª7îD¬6ñÌÊëªÝ ^>M|Üpü°ëZê`&ñóæ{‰ÏIqMâõÕ¯&?ëÆïg7cg¬ïâOÊú¿äÓœGHû1ü½_~«9ˆâ‚Éè¡Iû*#‡kŸÈÓàâÆ×Ày¹9ÌçvàçóÅÌ_&€Ÿr—bWSg¢Ï¥Gc‡óãä~ä{BnõÏïÇú©þ}~$YG}Ü£>¶H_ÙÛÛu¯CÈÓdÿTœ>CümSñ áÄÛz5çí~—÷Ÿó=|#¡Ï…¯šãªÕšW½¹Hk>©EuOÛ™ÔãÚOæ9›–’ÇOkïoöp‚ÃÍ=Æ^ÐÞñÿá—K¯@^b×q¯uŸk?ð{襵œ|SlvxšìÄÜ'Öü~Ç'FH{Ä‹´ç3ƒ_‹ø5§ ïŽýJŽV½o¬ø)K5?8H|¾¿S§kkàüšŸ&.á^"SÑ«ö³6i?‘ýAå‹3ê;Qömˆæ­¦ˆj1ñ½ímá÷/ÑÏ–ŸðW¾näíZ;óÂ3Ôyç^x¹úáÃà3¯ú:½;óÈêÿߤþÂ'ñ7ó°ùsˆs[ëU?x]óÁ»¹Çèmà秊à¥ôDÕ£WROhŽñžmw˶¨ß3É{;5§ŸÜƒ±'Û’Þð¨6졞å?U}|cµßõXðpÛUÚ/·»ýR}EÍä{ÈK<÷RçnýVswåøÓä]ê›»O{ú½õÉÁž6B•èaãìú{ä¦iùÀtä$rz?;dß¡¾Ù_5ÿú‚ö"»ˆs¬Úà½Ks‚§§*Ž&¾îxŠóJ«/¯)«úÿNþÞq{Nãš3LûÅÿ¬9ÖÐâEÎù{/$¿ë]#>‘“ÐÓ—Ä‹¹MðU‡–ßèF\~ ?lþ.û‘xËÒÉÏ~vû–L¼Õz"ze ‹?çUÍ«vîG-'íßvæEáÜçÔŸû¹øœÖQ÷j;½²MÀO¤NÑ>â“À·î…䩊nƒŸ¤N} Ó¸Üå•FñÜ®³õ\ýÀ'©ƒêWS¾Ç³—÷´ý ¹Œ͇©N’zù°%èož@ÞĪ}6™g4‡zPsO¨¯\?ŸZ!þòõÒ«Û°¯ábü¼cõ–øáÜsýËØÕò!Ìqy“Ô[J/áù“O꼜k,%þ×=à’üÌ͹¶òêØ}xÞ¨öŠä‹ñKq/ïÓ° ܘKODÎ'ÿŠ?nó+oÔó ·i¿v-rØ*»V¾ûyÅu§a_·j¯Î0îgÚê‡vñ£yT_οš¾ÿÔv/v£ìâq‹ö€—kŸ–×ÁûÙ³œwc+ç•_Dò>Ǭ8>t)ÿÝ=Zy©¡ÚWö }ùÁ-ÎväØ'Þ6ŸŸ_ýrÌÂo%5®ÂFÔG`íœwüýKuã~ƒ«å–€â­ø%o#~Ãý þ¤ì-ñ®~‹ÿÍÎ×üÎåC6aÇmšOݧzÚïê{Ò¼°e‘x›_AÎ:NÕ¡°êª p¨g4¿×Ø}i|¿š i¿»ö;µ÷¬á/Ííª¯»âæC¼”ž¦|Þfî½ñ ô¡¹Y<ÉÚ÷ÜЪ<ã—äŸ?ŠBýLöø)÷=Ô‹£§ª<‹}èˆjæí­}9Ê¥9>ñœ9k”'¹ ?ë½@s]䯮¢~lÞOIk^y¼¾È]Û&ü›³œþ›êá™ÿ ÿÿÌçúÄsfr‚r_Óÿ®¯ªGyý{µï² ¹ÊŸK_Ú9É¥ :lC´æ;Ús_íÏ‹‡ò õ“Ì!o—Z*>÷Çè‡ =Ï{¶¢}x÷j>N}¸ùS°é“Ä4Jõ÷÷‘ÿ¦™è½Mûuš…{¢ËÐoË9ÄÃÍË߯'Å·u˜ü–~¯m<ßÛö¶xZÂêßJ“WL9ˆZ¯äû²w£ÑoäÇ4Ÿm™Äy[¼Ücõ^äÝs¿úmøÛí5Hm!N̾,>Ä[Ô×°@ón·(? ºpì5åÃpÞ¡­âÿ½‘¾ï\õ¯mCþ:î–>ÿ¨zÝNú²ŸªOé ù·øgŸæõÏþì?+7þd#÷¶öPþs*O]þæ`*ËàE/ëœ,Â^uöÛ¶]¬½Ú l½‚÷O‰§¹£ˆ|³ù2í1ZGÜ©&þLMD^Ú·ºQùå ö.=”û±k¿“YßÏ+OŸíeäŸÝßi/לöîÕÝ“üLòEüpø4õó_ÍžŠŒö/äG°&ò*ç×þù×ÝÊ¿ŒÄþZ¿"ÿRÞJ¾'ô6zヌºWòrYºT{°nV¾)ÎyWÆaúVÎÛy}XñçÁýõƒV-cAîKðJròè9šŸ·«O#+>:o»P´ê‹Úš9÷ÿç÷°ßíqìdö‡xßççuî9\Õ¹'¼á¶"Ÿµ7 Rš+J‹ŸÇwñiöõÏÕ ™ä ¦?r2÷Ÿ ¾(}[òáÜœYÞ§èâ}wŽ÷šŒÖBõ]\Lœ™»ÜÛ"žÞŸ‰ë:üø…¦Ó¸'ï=ºŸG©çDWjÎÔPßîãÒë}꼊Ïqj/DüîßûJÕgÃü½}/üÌ™·Tï½Y<÷}±GùÍÂ%è»WñOèöûJÏ#ÚûZñu/Gv¼ºAxëKÕ‹ªÁû3gbßܯGWj¯bâ5ÕcæhõšÿÚBÞ0­siûHû?»ižâWì™K¼“!ñ‡^Q~çlÞ+uçÜ.þÕ°âåŠù#ŸêÙÙN>ŒïkÇòSEâçl.ÞNÛB_œûê<±Íâß¼ˆÏw]"¾Š—Ôoôòž½Ž›ÄËþ·ê’]8ç9åì…˽"¾é÷ ñ¦ÚÀeNø¸Âª·äöS¿i8@¶ý!ý=¯f¥úücopÉKÁó™o•W=ˆü7]Š\¶ßH½Ö«½&ÎëÁûÉVî¥ðAwÝýdåv–ûoY,>àâu@¿SËNp­é*úÓÛlÊO™´wvõ•Ô;ø3GƒöBÝËùT<Šøv§D‰Ç²}sŒT°S<„óÅ'8½oüæ®À¿f.‡X¯Ã>µ\_)ï’Z*ž­à¦ähí]x þ6»êþ=ñ³±ÅÇÀžx_ßÏRð¬·;RÒ|D ;êøWõÊûðö"Í æ8ëñ­çž|Ú{~PñÏgøÍÐך۪|ÃÂgïàGÒIñn'µ7-¤þà£ÄãÓS|Ú#8oÇ òh‰“Ä_pò'ÏñÞ%g¨ï&…voTßc#~¥¡8±ñXìLÉvp¢¯»`ûÜjÿZs¼×4ÕÛLê?ŠÜ.iÐ~0kη>Hþ#ëã|Ë:x.³‰<_x0þ16Xüè'ò{võd^ÑÞ࿉¯’ïð½ß×y.F’YÝs™¾?¥¸h²ödžƒ\Vö‚;W…|ÔŠGß‘&H_ËÏ·=€Ÿª|‚¼¦S<;¹ ²¯6ò8áoÕÿ¸†íÐ|Û&ä6º„úw¿žo:øÌqþÞ³˜ü©m<¸;´\{Y¾Fè§+ø©u¶úªÄ+í?¼êŸÅs]¨>ÿðeš?¾Kyœ ÁåN+öÉ'>5×jò¹´oàHä¹p·úwƒkkÄœr"ÿmGñ9á/5goæý:.Rd.xÓ~zÛ>ÿ”]«}ð7b_[µo95†s ¾!ùӞɸò|1õ›zêT/o­ëõÅõÿ†òlîÛÀw¾]ª#Ž¿˜–Ý5í¥íûŒÈÑÄI³Ð§Ì=Üc~ sY‰õßÖŠð9ü·»“¿ùFñ²ü©yÌíÊ3Õk²êœMú|÷‘œWI£ê¸nòˆÉ[ćx ÷Ñ×ÜæaŠË~ç#÷©^uï3=ïîH h42Ûñ{¾©ÚS¶O{_ãâoQ@}Å}Ž]ô÷åšÈ3ÚÉÿT–WÅnVÀWâ =ûKI¾32 ýʯ©úžÃû‰Û" ‘Ãù{Ù_èçfÕgãšwœA] 7@}"&ê åC¨wºÞç<ÌÃà÷K®Áß¾AJþ‡¼Ä»‰íâùõ;·G˵oÞs zÔ¢¾Ìö±Ã©õø#Ç%âu™@Ô-^çÿÜùÿÓ§ä!ô3÷ò’G?[qbðÕ)z÷×\ÿ|í i¾K}nívúM’5êKW¾%¶Kûε×,.žûD!¸ªðRæã+ñljYêg¾Yûx^ÍßÜW[+8ÍöµæØN?Øgi?BBshKxÛ›â·/åçm«Á‘BÕÅÅ—ýÿÒÙoú™çÉצGa÷KKÀ©Nñc…´O-¢}Õ¹žÒ÷:ä%Uƒs]¤:”‹yÇÔ,ücųÚ?¡}+ŽÃÅ‹û?î³ú øò­q‘yŠ_5÷‘ö+¯þ8õˆxö,¡Ï·øâ0—ì^X<]¾îàV¿ö[‡Å£êÏy5ïãßãëÄÿý âC¯'.qΧ.oyKøíaíó‹×EyŒ¤ö0$¿AoÝ÷’í´o­ÛÅ“ûŸ›¸{TòúÙü~Åt+qTþVì^îWí_Ü€þV$½ŒûêÜÿÐ~%q‰x'w¯æv›ÄÇÕM󚻈±ÓÉ€ö¶ÿ.Þõ—‘cë ä­@ù÷•êŒÜ†^S?ºöefµ÷¹ãJõ‘§µ¤šû,«€÷ËTÎ=×?O‰­D|÷pNþ¾ü½ògò± 8Ør?ß—ê‡<”÷Á>£_ w ß›X…\N¾€9ÀÈåâ«Êy—Ž/Z‚{*¨æ/ENr-äç'€[îá¹2ø÷ÐÓäqš´ŸÕN=ë¿£9ºK—!†1…ö:igã(ñƒE8‚æÆ<’»¹ïÐÇYð4rl>™ºŒs3~¬.È÷ZÆ~ZµçΫþÐBñç9ŽÑ|ä6ðµëôØs#þ¹ûm:‘ç«Ðœo` þƾž0‹öP4kƒû ðgÅÏ<_ñ7L³b”‹79`pañyìèU•xÒ­Ïáoµ‡p6x d)?ßx;çTûrmî NÚ¬Ÿ‹ߨnÑÈ4ø©6Gß_Ý*ô}ÞÝØYûÉÚOÝ“8¥^¸ÚÒ›ó*û…óð>€ýqŒã¼Ê‡bçª2øyòž/À…¾©à~ÛûøÆòx”>:ÿNpCí*x+çÁ/¡]øðKø «ø&ì9ηôúpíûÑ˦we7ÞnS"<6ãcâCëiø«ÚÅØ —øÔl×p/áü|ÁËÈ]{mW‚êûƒË›ŠÈÔÞ‚^”Ö0waYÞÌôpïÎuèWE€¹ÖRí5·÷Sßì÷Ø…ÀpìÕ¼•âeë&¾ñt϶°7±0E\šÉýÛ'·¨= ;Qú‚ö ¨ÿqf?ô¤éAΧéQô|ÎUØù3“Ðûê«É÷7ìÓþ‹‹4¸ üО…òYà.ÛFô.´LûÛÄ×?ã/ìT¸rU{öÂq-úèüb»Šï«?ÿîZ@Ëù"ñ‡g8zkî§ùò*pKñŒ•[êzL5š^Gþjfð¼ž!àÖ'L4ìÇ/Ù—a_êŸaO{DóÌÎíÄ%ïbG”çrkïPuÞ»ðØïZŸ½¸ÝO _W3W{rG*0š>£º%èO°{Õ©÷ΜðÄTéõëø—ù’4ǹyÎÁùûRç³inÍ”£ÏÎчøÝ´} Eˆ Ì/ w^rYx!rmíOýÄ6–Ï© +Ââûž%9 ¤ÎçSýÁ¯:›ß*ý¸Byˆã‘ËÙëÈÿø‡¡O¥Ûù~O ràËr¯OGW¨‡Öo¸EùL¯ò£¡Mš7ªÇxïåÞÂê7õ¦fÙÇ}¹bØsÇCÒ7ú]°÷‘AŸÖ 0|‡‘‡°Læ}ªo¢>Ýð!rRÿƒö"zÈS”öÆž‡Êð&'ö(´üêýGþî=ü|cûéJž1äPÿ”xiLªOñóá¾Ä¡bâƒ:Í›»­â^Ãý…Ï/Àå¼_p8!<’ø­àgäqÎ"ô£Q8>¢}'ss‡6[ ûëÄO+þâèÿàé𷦯•'‡O¼øõ ÷Î[‘ck-ïXÈû7¼ŽœÎºœ[yçÛÐ{ãÑ~ëvÍgܾTžæà®Ú>¿Lvß­}ê1g6«¿Ý´º[éÝøeÛ"ðIû\<êÏ.[A^´Á"þð%Ü÷Ü áÝ= ¾ºÕØ¡¦ñCîžîãc-éüï>yOë?|oà|ì¦ù øÃœ_ OE)>×®}W&Í+Õ‹—Èq)çzšxÕ*ÞÖÐåÈsÍÅàøÂ©kÔïANf.¦ŽçùýñtQߣ Z/~KïõØÏ‘Ø?sxÒ¡§¦o°“û±ÿáEôxÄoZjA®5ª_ÌCê!¯íMs/öåÜ£i.|W?°c5És…4Çh)߀‹>2SWâ;ÿPôÛû ÷ä<ÜS¶ÿÑøy­ÐØÅÆ£‰\&òà–ãÑ÷pB}5/sl7 OmÈS@}èÞ_Ô÷õ7ù “ê!%¯QÇqÞŽÿ­¹žºDÝmÄE×2¿5+sSëå{o5Lâo ¾Ì9ŽkߘÉÊç†Gˆr(¸Ä{9v»j¿_2SÏ%^CÿqäÏ"møŸP7áç¹Ü»ëDìnóoÔA Lè¹E}våé›ãýC#°OÎvÉé‰è•ãYሃ U¹ˆ¸Äó?ç:•¯û]ûæ¿Až‚aðAÐ"Ü©}lÎ7Á™%*Þ5ƒÔGߊ|V?‚4‚«êßbnÞCÚtªâ˜~¨êìEáýÜ[Ewáêó©c:§+·\øªC{ç4G¸{bÍp¾_’§)ú†8¶á(ì„«ûkòQ—éÜ#R?Œe,þ©°–yÓRîϬ>*…ø¿äKÍÍAÿ]Ó8‡Ò ùÃÐ?̃ÌÚ‚žÖ?Žþ4ýƒ¿¨òâggªïÔýñbÕü—ýyðdSwôÌ»M}~êóô©?)Ü{åšÏŸóbðô8nU~­EÏßsiÞt÷Ã=Z~åRí7βîA¾ì— Çìd~ñ\è­Î{œ¸±4Ãs”©¾P»yŸýù>«ò95„ LæfÍD®¦¬¦/ ¾MçlìQOÓÃîüÚpïÄÿÍ;œÏ­Ÿ†=jè÷ÜûÀSó«É¯yր˭Úkû>8Ì~øÂ¥zTÙÅýÀæ eGÞÁ.Ù×ò{æÝÚ[wö¸ñ'ìLéÜ_ð9üu™¼þ,É[é—âË¥‚s7ߊýq$/h¹ 9j;ûY>EŽL —T!wM·©ïãFÕ÷/Â?uî_¯‰8Ï®úbíË蹫+~¦áQìWý?àn[ r9ú¬åOñ2I›¾â>\[ÉŸx^ÇO4> ýW«^6˜<›µ7òQý çtƒ¯çÄ{„§‚¯]ê;·_„ÜÕ‰k+ÞS¾önpNú¦Ã°;AÕ,íiS=¯¶?þÔ¢ýuþìðÔ]¼op'y=¯êwö?û<ìP¹âc×½²+8çÒ0ø³6«߼:ÄOÓôöÕ~ö¿pü„n ¸©á î¹1¢þÛwù½Yw ßh?iðDðcCop€ùÎÏ÷1ç0WzXyŸµÒ¿ièwu¡p­úå­ªƒ…‰÷à5åkûjñ@ê\N3v«L~¹éIüYc-ÏáúEñætåçá-›„Ÿ4Qì§/8<øß² =*ýˆx ´¿î¼y±ŽP>·œóõ<{—òÜ.ñ»ÙÄC=ó äÇ2ý˜W-½Ø£sõâ÷g7vr~æÈ¯Ms¡¯8¿Ð“Ô9kꨯ„§pþÁåâcŽ<²C|Ö6õíŠ×"t.ýV7~°ôJÎ˺=w‹ÜøÓÙ‡c—#éû,òQ‡² „g“· ÕÑ'UÛHýÒu!vÔý³ø¡T7-?¨üD_ìkà|äÄy>zSÚ‚êËù>åÍ/@ïÎÉ©ühd»ø3îF?šör_AÍy•o j¾ÝrþÖÖûW+áô_)9@¿y<ü‹ö •WBø¡ˆû.“œ6ˆJTÏò,Ä/5ö5~‰œÕ}Â{›¿!*ÿ†§—âéãµà³ êË×"ß³®×…®ÄßÛ<ࡆã”wVÿˆ'Ê÷D^cN¡@s;öŸxþ¦üÉüZüw£üjårê£á3É—UlÂ.ÍØÔ1â¼%㌚5Ú³÷§æ—j4Ïö0÷eV=ÁõñDãDþ4mQ¼ñöÅ$û:ãZòyfÍ¡‡Ï¹MªOŽͮš•—³ŽÂ/”Šÿ·¬ 9n¾Ô¹W F¾ß@_ë—Wz/;{qŸãÀ¾!ÂÉšãóÞD£ZñH¨¯ì¹•x¤Jyj›ì#‚ñ»ù~—öÈÔk»ý\ìO@u çÅØñ ²ÿÝæ ‡ ¿òڳݪV¢wŽG‘7³ö¯7™Åƒë¼Bz”¡ÇY†ò‡‰ßKgcB6ÎÙÜ›º“íéÏ£Ô¥mëÀQ IáìƒÂÕãTÇ^¦9óÏ‘ßiªÜýuöWßâ0âíàwÔék×€‹m³x~ëÎÅ«ykïpá å3ç^©s:Žç ,àùK<·ëåGûñ9níï,Çûm¡~Qª=N¦k˲1ÄuÃÀCUóÄó÷“úÛÕÄÛ•wª/·þx«*7©¾¶?aߌ¼+n÷Ý…ó~§}çÚ§àú|Öô.~9Tͼkð)~Þ­¾× üGã4íº¿T6ûQ{!þºÈÞ·_„½«½ýOB? w“ë°iOrx–Îm¤pÝä³ì<ô#ܹ©xFùÉ4ÞÊ{ØB~CÇc×k.A/CÚKæµ77}Bün¥Ïgöùªo '®µnGß o¼løíפŒjõ¹4!W…O7uî»l¼ý³lDOK…ì»É_6Šß>ãýK>¥žd}¿Òdç}+µg¯öú*gÏ{.Ç/ÖüŒíbŽ+TÂó›×ð9%ªëÚÎ$?U} v êtò[¾jõ£ìdòënAŸ›æ<Íê &Ÿ`êE߉s¤ú@gÒçi|-ùø¯ð¸CnŽüwϲW¥ø“­sO7õ\Ónž¯P}=žýü|ÓÜOd¹p–xöf…‘+Ïgô†÷kÏ…ú9=YÉ驊'oCŸfOÄ/¯×yœM\lÿŒ÷ _?‡ zTßûœ¯´×`:çnšœšûàïÊãâþ ÿráï—4ñ¸û:Éexz?÷ô£rç<ÿMü·ç,ü¼}v̳•Ÿ÷DÃÀ\ÞDzDøâuìqM¡æ"…3ç‹çί½0¡êHÅÇhÿÝbâ ˪¿_¨¹•®œgà{î¹Rüâ¡YÄÙfÍ»Vï–=y¼wãàš¢»ÖNº¤è'£ðô³äDì¼+à1´ˆ¤|$ø%0‹ï›%^]gýü@´ú™?æ<îAŽœ7#G³íœ©z5©ÿÚ+_Ýüÿçw)ã<«ÿV~Y¼¶¡~ô?º– Çá\oxÕ"žl׉ànÛÝȵCvÑ|>z[÷rÐð yÛmœïÔÛÙ¿`.¾87p~Ýþ!7¶Wè[rižÈܗωøy®Þ;ü?ú´íð³Oã¾üI~>´Ô¾âòYü½r*ø¦éRÎÙ»¿V¬=¡÷ˆ3«Îã}¼ˆs«¿á9ƒêó =Ã÷VôBÌš«+Ѿ—Î}PÓ…§ìwâ7gGø»(ö¿âBø§ß%~‰9šSÙ>­)ÀÌ¿Šø+PÄ9º5'aùáøèÊa/æ/'î˜Õ =p(Òž$óJìµIó‡sà›Ãœ«k¸¸xzey9s‹G£qy–ÐXä2¨ù§;:¯7þΛÍÙN_Gøò!ÕÍëÔÿnÚ*üÝGñÑà†Øgí¥Ðž]÷êÿÝwLáçíªoµpŸM?!¿%â²ä=\çß<_cGŠÿο¹ ǹרŸÃ| ù­P¡xöƒ—ªÇš€Ë&î½Ì v)OàÝÄ÷”,â¾Íiü|pEç^ ðXêœóµ®QyP/ô¸´Rõ¤qÇuL>c„öòžiœ{àðE]\û6¢ô 8þTþ@¸ÇÞ";ºó.ÈS—ñ}~׬ã}ëÇÒåÒ>¡ðxòÔ³ÿÀÏ×G®àû›~7…k°5ø¹âÀ 3•§)ÿ¹snQþ¬¼R°~ñÿeŒ™¿“¿sËyÕ÷Q#ý¶ÝŒ_s¨®X0Iùô­’óÈgøLü²ùð_íÍ·¼ÊyÖäÔwó–ê]ÓÔ/ò çhUÚ¤<]Ó/ê¿,Ï(ϵ?iUvÁhýœê®Uiä5x¥ôè/쎵»Ðô88Ù¼ûW>bPjÍœÿ¯N<ÿ0ì…í(âΆý*õÚcáù{`½“s.ú yòhž7°;6¯€}âÞâqL<5?DS±z•Û„¿3=Dºé~Þìü—÷.äεU¼”ÏòùÓVá÷ÜÚ¼žï¯è¦þØ(ŸW =îë°Á‘WNõÔ5âyz;ØB~`¶ê‚¡«ÕÇy8óöê›ÙªºÈ+Ä'M²GsëÁY}T¡'‹Rñú„´ŸtN%uĪ9ߦ)èMÑsây%»TAçŠþ—?…?·®!Wþ˜ðÑÚëØ‡|PètêÄE·ñþ‘WÅç=3ˆÛL÷pó[UO} ÜÒi÷*|øñ²‘ØÏù7½¬=x’?k\©Q|šW1Uª9§å_œÊ§9 (¯oõqes©ãThoEaþЬù‰p^_÷çºùŠ,äž;÷wY?Ò^§RÎyÞpâ^ßuÈÑìsÜáLÿýø¡Š9Ÿºßð/eâ™ëÌï7>Ã{vöƒ×õ ÏP'ûZÒn·­ßUùùïÊŸÏýxÎôçiUœæý›|žíhò$öuê¿ÝEßVÅ2ìAí-ÄAÅîÁ%ÞƒðxH¼ƒy__þ¨Iñ²õOíõΨÏLó¦µÊ{h.4<{WÚäy ?Ô%^w?ýŒ☩¹€àô'hYbï‚cŸëãýgÜDÿch£ö•Æ÷×ÎÃo/V_änÅ#¯«?¡¼Ÿæ§Bg©®¶Üdz9ô<Ÿm4TWé^³<-œàQ߀êò¶×ˆ;m«©‡Øûñ&íQ+íàÞKOÅ®:Nç÷‚ª¿ø„O½Ú#_#|î¯:òMøëÀMØÅ9§®·œ9ÊhxûÒü&ö­ÈÁ{›¾?…ß7i®³ñFì˜˩•]îo~”ü¨ÿá×uØFí5tçܽ/ ßÞó•˜M|Q³™øÀ³ly–ç¬í¡ý9úÒŇmÿ?P1‹úo`€î7þðÛÔø.ýÇæ“Éo…U½q5÷bV^ÄÑ»UræS¼äÑ^æ9Ÿ"ç“ÚÆÿ÷ £q»ê(â‹óÿ‰6MïÝ_܇å\ðga¸Í\B~*´¹:g;çÕð¯ìèµØ-÷RžÃü±âÙ“xß9ÊOÛ®GO×ÉîPßÒ‹øå€öû†jO¤ö Øz"Ç‘™s.¿»àÒšw'~hžôzvpCI±êÅ%êOê¾/¬xYû5]£4ßó=ù8ÓûêoU‚Iññ¼wá/–ß²ðþÏ[ÂÚÅßV7ûæ3‰ïÿB䦶¿×þE=¼d vÉò°x¸þÂùC܃ó0ú‚è›Is:5ªS›K©¿úKðõ©_l}0ÕŸª_B÷ü|àÊÏ{÷𼎃Ú'užæ†¿Óónä=ÊKµÏñ,â‚’Š£Uïw=±h_Kð3ô°rÏQ¨< ý̓JÝâ,ùQu?õ W}Ì{M]£9¹Ã‘³ºëÇÚÑWížË÷ÏÍÜ;ᙩ9çÞ§|0÷Û'NwÖ(‰ƒ'g=ü_ÔÑk’Q‘â=V¾·¬—úÍÄ[zœ1_y.¯úíKî7e׿L)X^Ø1Ũl£žcžšNÁßY¯!>p‹Ÿ·Nü¯¡ë™O<.<žæy›bâ¿ØG|kŸbCâó…šûý‘~©ò3^ñn4½«9¹ï‰×*d­ê‹ ÈNYåómÚ'kÞ+;S…<ºTßv_€½©’žÔ à9œsðåâ…½L]Ë"œº9)$Þ~å…æúñïÕ¥/ ¡EàìÀ@ì®7®y†8)<ÿ5Wv¾è$âÚjõgùŠðßп齄s³›UÇ{»V/ý*2èów/öÄü;v£®™÷­{ùtÈO•ÞÍs;4gfÿ ¼æþ?YÖÄß+~ÄÙkxî9Ÿ׆7 ühyRuñ%Ô|¯¸ã3pRýGœÇôKéóqôÀ¾×7ðÞž Šï ù9Ë\õ;¶’÷˜m!Omþ{ä:;c¹ˆó±ªV»Ž¸«x&8¬Dv¬<¢|÷b‡-7ò#£Tq¡eþÞzyÄ }~Ù¯è‡K¼&³5G!ÞGÏ!äÛúøKK‘û™ª«NâËŸÀNØß zD<7ŸZ•—Ÿû÷9Mq±îÇö®üÃHô8ø¸ªPý;Õg£&ÙŸ’Q<ßü¸üäjÞ˽Nû¾ÎCßJ¿D¾ƒ£y÷IÂ9Ç€ U‡÷&òUâyü”ø2\ Ž5'ñ'¡ïÈs•®ýƒ„¿U_ÙTõ‡ûȸ—ƒ×Êÿ$hŸI]@óV—GµVÈ«ÿÚß!;¨þÆ¢•ÊÛ—!׳lø©À}ØPòióU'©YÄùüØþß|G$‚}(»—x³dçàiç¹çlÀ[5ÿ:Sþ÷øëkœ{ýÙÊ#ªÓ¬¼GãOÈcêÞõšòÞö¯¹“xTųXÁçÖî×x‡Ñ—]3{/üÑä»JTÿ€úô›“ô}Ôn§Îo[Âù†ª¿¼Mû»sßAÍoÌ"¿4ë¸[—g?i„¾þ&pQ¡öØ5¶‹ýrÞÏ*œå¹Sy ýäÌe¼ŸEý…áYä,ýÖ¥ôCÕÙÐSqYÁ}Ž>ð9G OÁYªŠ/Ê2?Sÿuï§È™uúVð z\9ŽŸ5‚:Dp#þ¹,Œßµàs‚â©}X}½É{Þ ¿¢^õçìV@ü%£±ÏÖ9_¿ö¹5ž‡=õΖܭaÎÆòïmC}“s#nv>E¾*XO¼á òQwùF—öµö&¯]¤y$ún|µš¯GŸpéŸÈkɉäó"ûÅ÷÷Šø¢ŽÃîUUòï•Ô«Ô‡[ö÷;ó6ðŸuú%üÚk¢x®è5öJš´?ÕRÝììBg¿pí§âÿz@ý‰¯ X~÷wÕg¯EOCÒÇÚ 8­ìeòF•×IߞмÊQœ[ØÅœÝì½Ô%Ìß’÷+§zL¹}Ho¿ÜâûJsŒÇ0÷Vtr纑Ÿïä9 À~;îPÿ¾x_êôˆWÉ}©ò[]áÙqž¼ÌHÑÇXª¾° ö5جØCÓÒÎ<¬xꀳ\Wã?j2ÄM–"p‹E}A¾CÔ©œ‘Ã:;}ÇE£Éw–Î'Ÿé]E^?4Üæ´H^ìü=tø¬TóÏ–Jñn¾£}BÈGZk…ÿÇ¢‡ÎØÙà0ÍU<½hd‘»a}ý­¾|R}4÷\¬ü«[qqyƒòç“G YÀA¦ïñkE7àG,Nìölñ*ÌÕxÅóÜÛü¿øžP7æíOiŽ»;vÊ$Þ&¿ äþœ{¶_.Þ¾«ñŸ¡.ÔÃ^ò.ññyoå~£Õï!{ÔÉka¹\üP=±wÕÏ_•l_Åýª{v¥åxœ÷)ë~¬}E}[7Ñ_é8 üÓð9r_÷ø«±3Ïz'þ* =å¦òW…fæ_¬º—ðdæ5|óð›Îµ|¯ãV⛪½ÔmIîcÎæ6jÔÞx ú[­yõöa9«À×Añƒ‡û¡'Λñ;sëéGp½ÎçÎë3~D÷‹ G“òé×qÏÁÙä KÖŸÚÏA¯k5R¸™ø«îOâO‰ê_šG®ø†¸ºØ]ïÍüevbçl¦þºM}›z—úqUÔ*EyÕ‡g‹r¡ñüi/Zh˜Îó#ô¯úiò(Á»9W?üvÓ.Í™N@.ü«ORslâå)~Ü\’Ân—¥É£”µpž´øqžåóªoSœ¾‹¹öFŽóêÉ zÏÔùh¿ÙPí7¨ÀX†?Í«¡¾¹‡¸!p1v¼äNp¹çõKô ïîÂç6&ùÓ'OGWúMûÑÃêµø-‡òÁÓгšOˆ/«O_†íÚ+¹½¬Ñ¬ù·ãÃÇqo¥‚w*ºñïAÅî}ø‹º%øû€úN ÃêSSžÙó÷^áŸÔË¿{Ô‡]©:F¸ Q_¬¸hþ°ôAáÝEäÍæ}^™·‰øÜzüÑhέTqu³øÄóêÒ>’Î~£‚}¶aíQ>‹œ©þ[×£œoù=Ì5º“ÿ9Ü縋7¿ŽñuÓ¼ƒò»ûCÊÐ÷Q©|U?ð %Æs8ÄG¿míõäq«‡¡WaÜou1uºrð~øLìl¨¼S£~¹¦EøÕÐz⎚ïÁí pq¡|ƒEyâš èK©‹> Ëeø]?iU¼fRœP(?_õªøº¯S¿‘æ²›ë¨ÔhO޹7ßïÕÞ7OJ8hµæšW«Oùän¶xÑjÕÏï-¢Îîs"/ö4¯ö ~cîáô¥˜»G”?ƒ½¶h.Ê>Pý s>óêG‘Ÿ¨U~ºn.yÓ†7g ïï<|\Ä=¸^Á®7ýŠ=·úÄó³Eñ™ÄVõ‡4`v‚››ÎÆž‡<Ô½}â{íä—ñlÑ<Å-œ§éRáäIœk…æë‹^DK ð¡ØÅÂ×às°§÷{’ü£c±ú•ß(—ó/Ö?M¼Uv.8É-â«yÓÁ!µÚm½¿’X+9ßbõ“zŸÇŽW^‹]-ýÿêÊ÷7‰WÁÖ!^©‡ÉNÖü¥òAÕÓ|pŽïð}¥»ñ·æà.çTðKãÜÛÜýØYïƒßÞP̵ÜcX|Ü ÛÔ—p?W6½+ÊûÎ9N¼jc•ŸºèQ}¼)@Á»?Ps;ç}‚{3}Lpn¼d=ü畲{ðc–q¦Yó•#°çNñÕÚÿ%?阣:ÈZÍ=¾£yôß„7bogÍ#þ) . ‹×w¥øÕOÌßíšclþD~öú\¿wÌÇ®D®ƒzî>ì{ÓWä~­ß{û4u™ú@4g㺈ÏsÍ$ïTr'vÍÜÉóµN}mÛù½šÈi‰•øÁ÷#ñ·u±ú;ÅS:—óö,À>9Þ!ßÙiÿm/kïæQëŸFëf#ßÞ[¹—À/Ø“Ò}šê')õ xïÇŸÝĽø4çk]Ëýy:ãŽgñ‡¦‡©ÙÅ{ïÉ Ÿh»`5þÕ,ž›ðrpð|õ¸>ÃošÆªÿvziV_€³X¼çÇb¯Ü7â×ÊS^Wç^®>àv~®éÍk¾—JÿA™xÆ÷ þMÞ»P{°ª¿ÆÎX^â9§ˆ§áìb'Ϥ5 Î (ïoøûPô)x¼ð#âQ¯ÿk;½,S}ˬy3Óðg¥ò-Ö´jç\­þ™ÙÅ]ôúúQŸ nOÀýÌ›„µ?©ºˆó¬yDspÓðS¶qœ£õ^áÁ°³5×£ŸÍ»Vá§”·.U¿Š{7ø¦É¥¼¯ø‚ËO«ö¼xf`§ì¥Šƒ´Ï!ô ü5g gñE•©nV«=Æ%êÃûZÕ¯>(Мµxç GVÆÎ;¯âþƒª_†vko£ö®„\Êk'5rvpÖƒàõbõûWÜ 9±àöh~Ëü‘úÆ´ßiÖ·Ùn—ܾò¿8D|7ê_¨Nà·kç#Ÿstí!1õW=²y©º5Ä)‘‡À[eâM =Lý¯þUÕ»ÅË=ëôÌóšø¯:´oè|õ眀=­?Ž[|ÎfìBY7ñ`߯½¢ŠM¯b¿æ7©¯d(ò_ÿ?éýIÈŸ=JÞ¯ü3ò¯Å{Á]µjÿ¡â$ßãš'XÁû—¼ŠÝ¯~lûJ}Û¯hŽ¡;yq§ìZè1äÀ~r7W}°Þjñ•sŽÁ±Üwƒê–7À…ÕÇ(OQ¥½8“9§ÚõœGíVñú<„ß®œ Ϋ,~®~ÆÞÌßZÔÏ[Ú†ö@þÂê· Í"î­Ï·¹š{«]„}œÿý6¼¶Å3ØïÔÙ·£¹¸ËÀ9sÏå/‰ÿLuâù5Ø“²â!˜íúXý“øÖ¾±­|N¸¹¯ÉsoMê‡ _ˆj4£ÂE¡)ä7§Š¯jqf¥‡>Ä@!÷7ûKê;岫õÕ8WWÜÇóTÁoU]«ß÷pïÓÔ'jã|ë´W±d)yžÀ^ä¼ü.ávåûÃsÅgïW>Uý¨¶wé뮳pÞ>ípTýñdês:Ιö×è÷ »x£J>æÞªŠx~÷ÄG–W‘‹€úwìM•ö‘…ÞÆwîö(¾¨Öüwàzp˜ç>ß.}œ¶eIíé¿=oÔw2ÿ^âÀ²c…Suö_Ågó0ù=WŽÿTÁ#þügÅ6ñÌ*2 ¯94ghó‰¿Ä¤þ6åë\ÏinôXÍTÿÚéŠãNW?¶ø M÷#×s»ˆ'Á¡¹ŽÕè¯]õ߆gÁ» £‰ßª•Ïs‹WÔ~£øúžd^ R}…—àW ®W·a9öÌz€¼R­òs¥/r_³†‚oªÅÃQ<¼ÔX ÞÍ=Z•osuÎUŠg p:÷b×Ù7‘#w½òK©Ÿ4|‚„бÇešg™ÅN»6IÏ¿žíÆî•ˆ)ò,òâDæ]¬¾¡,zaû–úMÓwškÿŽÏ±½#¹˜Â¯ÏžwþՔĮ;_4i^¹þ3ìJ@yᦇð¿Î¥âÃÒ¼g™xhë$7ž„×Ç Ž²6¨oüCÍ'ŸBüஞ°íÿÁ‰Ø[³ê¡+©7—ÌgVr¯õ«ˆ‡.ØÎœ`ã ê·aíYó? u“üòXò´á u g_üè¼O±M5_ÇO„.#Tž |ý ~å*„ƒvοrŸêùÚK៼{'qˆ}<þ¬Âƒ׋¿9¨=4¡Ó%ÇÝ”· ƒç"ìCý,ò`aí¯UßʼçÞíÚ¹1çlðfiùÙ¦/c÷)Úõ }>óÄ \y‹pÑœoõMÂùcÅ£[ ^™ó<}ޫɫT^&ž›Nž¾×‘ëzÍYß 2ÿ(^T“ü¾ø®Ë§ŠŸW{Ûƒšgö¨ÿ¹Vñ¯u¢xHŸŸöB7i?o½ì…ç(εXüñsNÀnx¾Ã¿þÑ|ÞFpãÜçé‡unÀ»Ýê;ïŠ>„?¯Ïü›¾0ÏïÄí!~¦QûÿÌ⯲þ ~¹¾è‰÷jáë¡ø!ïY¼gÓ÷Š‹f`Oç‘ Ø9ÏFíëÄW¥}°WsTopmVßÇFì‰Oyï~Õ¹g!¿~í¯0×á‡Üc°ÓÞ&Î7ÔE¼ =ÁÍ)Þ»¦§ò ]Ñ_{Rü¼s Ò·Ò›™(ùD|Íây;]|Ä›Ä7xŸò&UüéžÇs4 ‡˜? .§¹”Î9¦æ³U'*çÜìây6åð¯ /`K¥G”Ÿ7Пιžrõ Y×€ë»b×ìªw–pöÃÔ¯-ž^Ë%à±Y߀gÃ+°»žåœ«»œ4´Lv¾08±æ÷;>1š¾Õ‹<Ï_~ó-öeèa «zÇžËÛÄùWnTžø7æ}ê»`O;ó$îÛÔOý¸£¾ ûi¾SóÀê÷*T½¯Ns±¡¡ø G‘ôèñÑž NM'Yò&%Úchå|B{Á%Î^Êï‹v‚üg£öY&kÅØ¥°ö’—ªŸÛv7ö°êvòî¾øOr]zŒø¶G‡F’ï8Ï]¥x32¼S¾{2_uýò®øaoNz7Iu‚ûÅg3Pyµ¼æÉ‡`—Š„^ñ bwC÷±È¥¾¼À©ø9çéä<Ïc7R+~·ôCs­¶c¸×ÿð ÁoÐC[›öT`Ÿ=ñÌSÝEþºâüXÓÓø%‹äÕ ÷Ðt—úøÏ®º†úº{8ܾ{î^Ž ¨¯°´B¼°3É4^ÂßMÃÕçåó‹Ã.Ú(ïò!~{öpäÛ\JÜTÕƒóî¬o„'‘? îS_Í‹ÚïrŸož(¾ë§Ð†à¹¢™çóÕªÏq<þ,t‰ø‚¶#7ε÷¤ó=´÷Åy¸ÁóŒøo¶cŸ[t?=¸·òjž¿ðp÷œN^•=ØËrñQÎ/Uã?â¥*SŸwPûGî7‡£Ïe¼Oµæqç WÅ:¯™cè#,ýˆø»i&ú^ê#ߨ€ÜOÞãü¿ÿáÄåªN×¾‡x‡œÊoÎÿ¥ÿ'Í%Ü‚ß.p¡7¡bòÖÎ>Ëß±ï%ƒÔçõ3{C/bwjćçмgíèAùp¯Iq@X~×âÁ®T]®þŽŸùý9»À-á/™Û©ø{j܉Ÿõ3ö¦ð™úIwþ±Á(n&¿Ù>¯—åLìYù·`;¸`îßôAºú“¿›À<ê›®WÀ?͵ڻ#ÇÁUâm¿]ûÌ»ªÞv”æØlà´Fía+ˆ3ßþKõø4|‡áª»kÿPM;áŽâ'M7hÿRBýªC„wÄ7ú˜óó­~ü«±›E§SŸ¬qK¾^Ò~“…äœçr¥[ÁIõ56¨NZIüä:¼;³T{¥©Ãø{ —%šOr–«Ï$ƒ\ØÏÃÞØŠÄÿ3LÊY‚¯UpáyæŠWµv8¸Ò¤|IÜàý[<çã‘WÏqø—ùâ¡ ý¶*Þ ]ÊóûË´Hü¿®”GUß~yoü}ú}·rŸ~ñºù6Šï}*ù8KçñtÅ–‹wÎÜ}¿¯=„ô½×3O1 õŠ¢mÜËÜÄ%CÕ¯§ùGçiÄ…e÷ÿ)ç>s¤öÄt®—’w?ý°žŽüÕíÔ\úûäÏê3«Û¨¾TåŸÂmØÏZñ‰Z•.s`G扮"£Ì*¾ß1,×\Rh(?|”çœW‰¼YMâƒ;¤øøEäÅ«¹8û7š RÝÖ}²úP~ä|ÍŸ¢Ï¡Ÿ˜ž×Œÿrj¯»÷{ü•û_ìVç\\XçU®Œ\Võ§9º`?jêÓ8GxIý€ â½Ü«½c>äa†òRáaâ ñ‚Cça'OW·aæTÓ·kêÜÇ®ºç,íWp "®™­þ%ËBõq…_vÍ?éƒô#Z>"Žœ·kù–_?`”µ 7‰?¸i6úTù5þ¶q‚øô=¡^š·ÞÉy„"êŸ8‚¸§j?õdÏ~õj?H‘ú ì‡kßȹšÑœ•]}>Þ1âGVÝÔ1Hñ«ú?ËŽ$î­íÉó™Eîʯ‡gΠHrSp>yüJñÃ4›µog98¢é5õËŸ=ž¡•ï“72߯=Ö.Åy[±g6í-o¯VÝ}à¨æZâÁö©ª¿*ßT"ù5¿„Ü[ÌÜOåùè§ýù“áä|šË.8Kñ_?÷gÎGϬáòËÙg`½ZyÆ‘›3wžuοëK Mâ+/T~6_}¦ê'¶Š‡¹í ìW½ö¸XN׿=t¦¾°RžÓ­ýÿgGÅçÒ:Q{=µÿ¨ùC>§rÏÑ6{gÛ€ßn›¤üªødÚêmÃþtœ«9´³çÕ`¯ÊO#Ÿæ9|\xuv{‘äó@ꤦœ{á¡ì;jy¿ïˇ/Ò»™¾>߉òs¥|žGûàZ,Äž-ê{raw}&øsÊO%Oï¯T>c·ð×QÈoîiÜãלûüH«xŽLê·w?ž)Ôœ­ëìM…ö¹•>«¹Êíkî0å‹_ãLâ3ÛJñ;ÏUžÊ¢ý»çh_Ú<ÎÇ©=^ÅåÄg­Ú·Q¥ø­|¥øóWÛ ~­P=µê*ñ˜kïPCšøÏÍëᾋg¢R¸0_óª +°·C4?­zjÎòhöwÏ â?Cýobg*¶÷œØKùm]¡zðdâR›ú°ld÷É¢/Ù}œíËÀ‡MÍ‘ŠwÃø1úç½{Y<\ï›I><ÿê Í™¶‹ŸÚ"9qަ®“/»ªqøÏ5ÚÛt%ß›»Tñ»æ´=iâ9ïKÌW¾¡¾ÚEøïâñøÅÍçšlاìþØríkð Ƕ'‘Cÿí|®ûí¥QýªýQñ#›ˆ«Ÿkþ¦“s,>{aSii5ïQU†œYÈKšß×xbÚsbäùJ•ï(œ(\öý`Yì¦5èKááàÍŠƒ‘ƒÊc•?[I]×òžò¹ì^òÞþÝk¥žPñ.¿_%Ф½¡¥Óð—U»Åƒ0Oukñ‹~ÉÏ·Ý…ÿ²­“¿ºs*ßOå…âãŽãW+Ä_9âµk÷Låçâç[†¢7-7sÎ-šïwOåkèu‘æcÚ>ÿ‘MsÝíOK^•öÏWØ¿äÛ¤OUeø™YMçåŽxò¿x¿Ss¤/©ß}¶kަRýšÆà“êTãÕ‡{¹ø54gʽvnĹèƒå$ä«húš§½+Óñ7Õ[ð“e{µ¿Õîë\ö‹OËû öÎý€ý­¡w!v»Ò•ÿÆÿŸ½Ž÷4ž„my¸´å~âãwâ‰Î ¿¾.þÝu¾âífâýܳy>Û»êÿÏîVŸ‡G}AÞÑÏvÅ­å‘O,¦:÷/øƒ,¨µA¼ŽùÚS5 ;Ð$^‰6õ¸ÇiNZ{Û*Ѝ·YaÚT×h9X|óšÓ©Ñ¾°6í·öJ¾íš·tž&Þéu:ÿƒÕ*^Æõcy÷cÞÂó8¢hõ‡yÏ®½y[ÅÛƒÚ«×Éý•þ¤¾ëÉI+qGk¹Xª¹†¢4o²¿ö|}vž®ù’ݪ7;Ù×h¿bãî¥n"º7p¿uâɲìŸ6MÞߢ9ñ‘{_×üo3x1OóÌ^ñ}•«ÞVØÊŸ¶Ùú¹ö"Ý¥þ‡1ðn4¿Œ]wnÇŸºÕ¯Ú>üÚbVþì ü®{}^-šªÑ¾{×ýèwÙxþthß‹}ªæ+n€ÍQ>ÄS®5ªºæAä³ZÿÆÎWJo­ïsþÖvåYÑ?ãsâ©Í÷ìa~Ѹ¿âíͼŸ÷Eú,.plëáªWŨ_•hŸQÛiâCü ùé¼SýÌðž–Bž§æGñŸ*Ð\B¼Ùq«æèFò5§Ç²Ý@žÃ¨¹×Võ?[—ðüVím¿_uôZpdÓ¹êg^„\u;xµdvÝÿ~²b<ú’­ûx$—eKÕ¢úM<ú–%²sg2GíÍ W®gñ­{Ä¡x¿L¼ª%gÂÿ[ý­xö¿ ßѬy ûYšŸ4‰oö;>/g6ö±i2ö£u=ÏßvþÀú%zYzq—sÎÕ¶šº™[óhí³Á/Víkn (îO¿¸U}Ñíßj>g;zãºM¿'¾6o·ö‹ôqÍ¡§ÙùŸú×ßùTˆgÕÛOo²ì‡ògž„ø¯rˆ/[ÞTž`þ¢z!8Ó¡úKŸ¼Œ·ŠÏk¿¹iý <ž×@§0IÜçÏ!î÷–kNW<~¹3™ƒ*QÿFþëðº{'Ó7Ùø0÷èÑÏ—'øÜ:ÍÛþÌËèi±úÂÊ…ë µ×¬ýþ½Cû|¹â7;;Tý ñJåõäçì“uŽ÷‰7CÏç:Hs•_a—ÊÏ“ËÁnTÊnYJÕGt4v¢y=ï]¬¾æÚŸ‰}"­%èUå2ñ/Ž!ÏX®ý¤–¹Ú“دúÇÝÈmåZòü'jžúpJâÿݰÃù‹‡Þ§ùë!âiR^Öøù¸¢?©×»ŸÐ<é$ü[ë Ø£ÊbpzÅ!ôš÷ MIųë„ë®'>lL>ßq5y¹ÕÛµÿÜyµæµOÚ;Tû{Ŀݬ9Ðl 4œWáû›ïju[%çÙ~6ïÝyþ¥¬TýʘÅZÿ zßðö'ß‹þVÞ¤}/âr¬R_a¹ü×Hð¥%¢xºþÚ–{ÀAíyœ³=È¿W*ÎlQÜZµ»d›ÇϪ~™»…zg»öQx;À5î_Õ·ºAs.«°çsTðM¥£èZíãBœÐQ"~ õu´§yCñ!Õ¤¾ñMTмVsRyÊ·5†Ég”ü†Ÿ4–‹_l8~Ô¾ûr=®~ 0y—r#º³{Ñ”?nÓ~¤Í×Nf®'ÛoèZ¾wŸ'ÿt¢x2^Q?­ìù"ðrënÞ§-OöüQäß$Ü\þçP’µšÛjP|Øâskµ·¼@þ¼lòb:[¼0oq~¶ýÀï¥âqîL€G*þF_‹Õ—Q©9Û¦yâ U}²¥˜ûèü ù®øD}51øïê嚟AOJ˜Ÿn[\‹—Ùª}†¶½|žç@òv­3Äÿr#úYõþ³R}¾¶ç8¿æó¸¼ÔïòòV¯øÆòs,}PóhŠãmâGô¾MÒ’àÇ"͇Wx”·Óü¨ý=âÐö_´÷è_üvã‡È_ë‹â'Qüåñ¡G–[±_NÕ¿ÌãÀYÞIÚ¿-|î†þeíŸ]ýÃ^ñHÕ¯ÏòJªi‚úMÄ«5nÕéůÜüñM…øTŠ´ÔÚƒ¾ÚïЄmÊ_9¸W“ìdkTñÛ½â‹ËöÛŒ¦Å#~’l=¾óêž_U'\ ¼òD–£Ô¦ý?mâöžÏþ%‹xmª×i¿‚ž»q rR¨:¯C}¬Eš oQ=*;×¢þBïLíýKý¯Ó±;媯TüŠœWZÄ‹p¬ê„{ÁÎß9ÿJíɶª9çw°»žåª¯®"OgõÊ„|ØÆ« B\Ø‘åS{ý¨:@óLG™Ôè¾9¶V€‡mÓ8÷Ú ìIø JµÇ8Zrü&ý£‹¯Ä.çìV_§öÜ´Ý¥½“‚ÛKVpžÎ÷¸b͉5ùÐO_ý—yš;ôµ£¿.Õƒ•_·È^uª/Ùõy%¿¹Ç >¿óHüdÝœ§k¤x°-ø¿¼~âfÇümËœ¿å7>×ú¼ú°žâç[ÿå>=3ÀÅ3'—x“Ëzȧw>~éÔÜb‹æ×k÷‘?òª_Üýv3g?ò­Þ—øü"åµJ´¨y,xÊ”=÷Ës{“x¸6¢÷%ÃÀ¿®"äÙº»Ö žï&í—5‰­ÂŒ^WiÞÙ®¾v¯žËû&{Ð.ülÖÿ-QŸgÇâû ¿k»^û>5ÏÑ4P<Ýâ¡®¿ZõÑÈ{[œ8´B}(Mâ]/U½)7ÛO1;å[šÝ‡ˆ?¬ŠŸ¯S½£EûórÔP¡üW±êbíÛ±î>p¼ó$üD¡½·ß€Ý­ÿ¿`ž…¾HülÑ^ïŠ7Éó»Þ®7¿ŠŸÌ}ŠÏoÕÞ‹jå#›­èkÅ"Åe…ìuð…žz´Ÿ2;Ïšo#o¸]ý`7¢ÇîˆÓÿäù}ñ$‹ßßû|.Æ9ôy6jþ¦íJñ?§z‡ö€´¼¦=KÕïà³ä§MóÕžïù{kyÁöÍÜkÉå?„·*Ïæû|KÔ—zxÜ2Mû«®RŸôhñ©/ká{Äéñâzvâ_MÚsÖ¼Hû÷ö‰?÷/äÐY£þµã”O߀}q©~^q‹ìÌò’Ï+¹–¾ßêÖü—i¥ú-ÆPOlÒ|®ñ*Õy |ŽgííÕül‹öUº—q^-CÀ ¾BÍA´·ý~Þ1„ç-R}Í#ž,Ópv³pc6oê¨9ß{À?í_ Ç¿×+ø¾h—ðVÍ_šgú’ßkøø)gSø“—½oý‡»ˆ/ë´—§]üܶáèÉÄÁ¾1âÕÜ`ñ\åÅÿê¨ÆåËîøþ¦Îz§ú™>Ö<¦öºz‹‹Îñ؃Rís.è\¬üÖõ…*ŽòưÇöƒµ—àBõÃ˹¶h¯AÉ“¼gžøMÚñ‰öäLÂ_åjŸTã ü_S÷ìÉ#¯Ÿ«þÊ£´ç{:rÝQM>²x8yq·ç0)ß”ÿŠò ?©žé%>m°ð}Ö:äÄh&®n¼—ù³Õ­ª7.ÕÞlÛñâÛYŠÎÿ’z©M{âê´ïÛýÏÛxžæîn$_hU_nóÕËÞß”]Om©ö÷º6 OQ?øêS×¾©Ê5Â3£‰‡›Oßî à÷sâ%*B/r4ïP•æ÷ê·J/ÔO]ï›· ¹qðsíâ·5+>ð ?CT<´²ÛùÑkO}K«xÑ´_Ç-pgÏeü@óõ“±÷Þg4£¸Ãñø¡Rüsµ_+®¾¿šÝgTæ ã]Bþ®d¹øÛ•}\ª½5_ ¹¨{5'ä›Ç÷,±j†ø&<Ëyï‚^òY-“ð'î¡øjáÃÖØñ,ÿHÛ}âcyš¸²ä Å­k™c¨;é?e…êõi•hßoÕ¥ü}ý4ñIvª®8Gs(/¨¿bç³$ÿäV²örñCªÓ{û¨÷il*ö¼üòC&õ77Š_¾l-þjáíà×à[zé=|hWÇ)¼ñõ8ÄŸUñŽêC3ÕÇ«ýbž*Ùí*cC÷ï:BöäLõ›^$û¾Eçy$Ÿ³´X|Oš£q¨¾aÆ=˜{ÐÿJÍÑ[§éÜ¿Ñþ‰;ÑËñzt¿æÃ5Ÿ­½D£pó‘Ô‰Üoˆïl8x¿îqê§ÆÇôŠ¿[çk®{;¿ß¼ »¾èKâý:ñ9¹ÿåÞ|;àß´iorûÇà_“æ][ ª·N·F¾ÂçGþë÷g¸õNîÉþ'u‹z}^ëJí¸žón®xÐŽÿ2k?VÛ$䱬š8Á1SûhTÿèÿp³Ÿ{°hÿRÅÙâ Ÿˆ5£¹åÉrÄ?_&Þ>Ólê§öG‰W§Y|Ù55ôMT)/ÛçÝ ÿ‰qx¹bšæùûyÿêEÄIžIà³Ê±š…_· &oR¤¹‰¶,¿‹òEÞ;8û<âH…ÿoYÈs—ˆïÙôrj¿_ýû¹øk×tÕÝ®WZq^…úœ,kÌëàû œ·I¼š6Õ¥Û´77k/ŠÏÅŸÚ/¿÷dñ܋Ϸä%òä5šKlÛÂóç|Ïž–‚aŠ;Ž”PÝtI ý_Ž*í÷IŠÏT{‘+2ô•{ßäžë5eÔžÛãÈwçnpˆ¯Žy€Jñî—i_”g?W±—¼mªòr)ò5KŠ4ïtþÕ¸ y*=—:¾UùŸŠ™à¤’CÕïÓ¢¾²™äM²ýâ¯]Èù•Ї·qr]á幚çɾ«Î©¾›Í…W¶a?kÐÿÅùš¬ œ›[/ŒEsô•óÈ‹9óð毹¿ åmlŸ“—õOÞÝ{öº¨\h¿Döiú 5Ð^ÉÇç5ÉOÚŸÃ>Úƒ“Ìšë«U@»úžÜN¾×®97Ë ò;%OÁ—²´’ºëìd«p~¹ú­½ÃˆkЛūz÷R;žó)ëÒ>±]Úãþú¨hÞTužœAØ£†[TOè㜲|­ЫêOSëcØÏ²WÐoçñªý ¹ãÁØ©ªäé[íš3׬jí=s,àœâèM¥ø![èo¾öÆ[Ýê¿Þ"Õ0öÞ±š¸ºh)v `2sJÆ£Å'ò˜æë7kžäuúóªá ð~€o»]ó¹ÍœO½ê® â±S¿C³xØâo²6á¿+´ï°YÏcü{ã;—<;#¾–߉ܯó>9ÕÂùÈmûêPÞûÅs.~ÓÒËÀ ~ð£Mû<⃮<{Òäs}êö½¯¼í©ªø8OÓËà³úéàìv£ü’ðs›öáÚúÀUÕ÷+ùy½âNüfýÉœoõ ò$ÍùÚï—·4ìÀŽ.Qq«Qü9‹l=õGë>ñΪÿÛ+^ÕáLšK«Ì>ŸøG¼?ÀëÕY©½Ð?b*_ENË…ƒš5˜cóvO”LÑ\aò† Ń?†û¶jŽøìþuÿ\Ùi°œÅûz-ÌUTœÆû-^Ã^ÓŽµü»û-ì€-‚?ÌÍ§þŸ´ø“Õ?Ñþ»âõ5š{`Ù…ä¿}¹Ìµt>£} ëÀß¾ñ îÈS_©ö€{=Úr$~Ì­>[S¡ú·§¯­ùλáü|¡öwÕŠŸ¸Uy%·øOëUsìÀYÔßßð³ê½à¾“xVi>å7õIkO}©ðMûÓ-a¯—ì'ž¸Éò?ŠïÍÛôócÑÛ3Ü[Ë"ìBÕ(õ‹íT^g†ö$ý,^ÛµØk-ß×(Q¾Û+ûÑöˆö´ÌÀzÄÑ\¢¹ñß9–ª®T%¾HzRõ1rRøö"·•=cMª·xÅWÑíÏ| ûìÙ¦ï»{‘ëBž\[Õo¿ßAÄÞñ£/Õ>„µÒ³;ÈËó»ÄeK¼Ì/啱¢àIò¾Î©‹Ô¸ñ;µµø7»I}²k}^‹xwó²sÊ»¸·ZÕÃÚÎD?­)O½†Ï¯V?¹}ºæÈcÄŸîÙêËP¿‹?Èÿ[*ˆ +n¥?%ïò •ÉÿxÄ›m™6]O<”{4ùNÓmØårñæŸ,|¬þ­‚?°¿e‹À-¾“”Ÿ>þ¸&+ö¯ùâÃJå)Zʰkîþ½\|Ä­=zßüMÇçê³­àýÛ5×í‡)×þg?úè½ú\秪7i/TӅʳ|'>Ûúl?ðÐ)ä—Z¯VSó3víµüˆ¼·µè}ªÀ—¾Ÿé7÷œ…]ì<Ÿù‡¦Ë°/Í>õŸ—iÿs¹øsÊV’Okx»P1M~fýAùOÒÏÖ²CñÎýê‡~ ;i›-¿µˆ+ä‡7‚GÛ¦¯±ønî­ô ügóðLä­£˜ç.Õ>6ËXìvûðd•ìfÛ«²×Ê“[ß/_3÷m¯Ñ\ÚsÙþñOÄ#x-úÕ¤çÈÕÞØ†Ýš£O’o)OüZþ.ŸãêB¯lò;•Ëy^ÇkàïÍz‹Ùó“å--Šu¥öOŠŸØ±NuñŸ•N¿æª+ÎxùqˆGЮyÑ–™š£»Eý;qâ/ËuÔ{½›ñç.ñ×6kªEü{­GW—¹ÅÇfÛ_û2Õßæ­¥ÞV¤}ŸíØ« ûÚò/ç[s„ÎWû€\?c¿JÁ>5ü¦½÷狇@uÌÒzÍ}¯Óso£Oºì"ðQÑ÷È¡w:uµŽvõ ˆß¤Ù)ÞÎzÕËÇð÷>ÍÃ5ŠÊr°â‡"ðA¾…¼ãR~ªAyj_1}­ù£•ßb³öÙ"Ͼ±|o¹ægÿ1¶¨ŸKûÚ³{5ÝÙ¾ûs4?çќоó£ðùâc­¡8Aü4¶Ÿ¸¦9š—í#OÆ}šƒÒœˆ)Ëg"yskïca'ò^ý8ù„ºˆ[š2ü^±úµ;7cÇ4ŸZ2XûfO”?_ÜÒOÁ¡¾à8ïËØ¥2ñÀ·‹§»c ¿×q‚äC}Þ›È+ÔÆñûíÃé#²RÞF–ï^ùöïõýk9g·æ!U^à.íÕ¾ó&ât‡þ¿m²òv—Êž'Ñ£¶nÍ…^,^„äñeõƒŠg U~»ø;꣭mà¢õÙz;Å{ò,~Öñ÷W>Û­~(Íãhsélä°¬‚÷r­ ?Éö7öÈÑÆ{·Š7ÝwyÍBÍ‹[>Tþcøéªr¸W«¼–7W¨¹ ‚<â§zí%2G4×4„þû²Ýœ[¥As×úOZ^À¾¶¨~Ò<ûÛþÏk6k>kv/?T(>òÕ(~z¿ì‰òyÅ'Ðç]ŸÁ”>JÛbÕ~‚3ÅOý™ö(iÞ«i²æ=Þâç[šyŽÆ{ð£íªw·ˆ×¢m&ù%ç>ô)ïwêå6űžG‹ö’X‡sŸ-×—çfûÜ5GØ^ÊŸÞcÅGoV_ÙCÚÓz~Ù©¾ü<ñ:·h?·{©òs娫¶Õglj7¸O|> g~ñô_¤½+§ªVûª>Ô|è8ôÈ*^Í&ñ<¹åošÄ–·,Ò\`[R{ýnãÿ;ö k_¡cŽúHTWrw©ÿ+ Íö%¶Šß¡:)õ%ñƒEýým³À¥õâ{¶&?×'ü¿% >²Jêþ-Úê¨çW~ˆÝóÚ…Ó¯ÁÏi/uÙš'Ô^Þ\écÛñÚû·æü.ÆŸYO!.r+ζïÃï*dµjnÃ">¥-àß"íÍ9ƒ¼Lë4ô²Xu”¼vâÁ¶9Ƚí2íÕ'¾ñ…k/‚]¼y­äÕ-ª—+ß–ûø nµxá¦/#Û'ÜÞÈýXçy[œâ•žiïCéÍäkÌg³_¹äýo”÷ ò¶5²Cwq/Þýȯx¿Æ®Xî—ý>˜:s«öÙNG·÷c/ËÕ—îË!Ÿç~—ûªS_ŽQõµÅûM_sîž›ÔoYOŸ¸µ‘sl%>ÆÔ;ˆ:ƒC{ÔZ÷ŠKý>áß$ôØs生ŽqœƒœWˆWºq÷Öz"ö ý3ô¸|?ôÞu»òÀFêÕ–‰W\kÿ´ø,ÂÇÅ≨îÁÏ6ˆ7·µJûL–ˆ§áô"o ý"¦CÔ7SõúoWþ·Uüdî;Áµ–?ÑS£øI«ÐÞô0ràÉΙéÏü äÉM«ÑßÞ+o1ûm]ÝâõcÛÿáâo¿ÈC?HÓ#Ü»E}ƒFÍÔº7Óùøë»â)Ѿ÷^p`ƒú0Kàÿ+÷ñ{Us¹7‹xŽlªçÉzÔÇã³sUosNK ®kýY{cµß‘Çï7šwÏ}P^E{}›ß ÿÃz&¿o~UvsŸæÅïUàwàÛίõåך´_8{®}÷Í}@xr¶öì_Ü„·ã\;´÷Ùñ´ê;O¨O<$û«ýÂÖJôÕ{ òP{±òönxjÇ€›wknLûO¬oòg›öY=ÚÏ!<ØDÚNG>›WÐ7á÷bÇ›µ¸Lõô‚¨sI^L#´ÏPñP•öÛwóï–ø ?ù²–]ආ'©×‹ÏÀþvÈÖ¹Ý#Þå—¿ÄŽY®#?š'Þ²êçÈWÅsPú³øˆG`§ÛlÂÏz”÷° O^/“5Íygù½|Vì}ò…ûˆwŒgâ§íëGnKHv²”üHå>ôÜw"rT :DÛëòëÚßaÔü‘wßÓ¡ýÜŽW8'×›ÈOᤲmnØa0f÷Gç/YÛ¹¿2͘ʰw–õõ©ÿËS„\¦ý _q¯^í‹®ù‰ß+Ì·TÄÉkÃØ¿Ï븋¸Ã¤=cÚÑ þ#ËÃâÏ~;|à•æìJóBÍû'Õ‡± yìXNÜÝðŒäþP>·q$rc֥ͭ9Å)åIðk^»ø&´×§¼‰x bv̲“ówWq/í#¸‡BÍIØÊÄÀß´ü :ù4ê?Uâ/µÿÃ÷—fyµÅìzNsf_r.ñ vì/žÍZòµoûMx×:¯dï‹q1y羿úwòŒ5ç‚¿=âÍr8ÁÕe7€ÓËü^ó?¼ýÞ¿i6ïÝT®ýW¡?eÚ¿óGñÈâÁоòë4g¿‡:àâç°MI „sT‡­U?ñì³E¼Yõ‘ço[ÍÏ5Ëy·{ñ•ÿ¢÷ž­ÜgóaØE³xKríâÙ~R}WЯâÞ‹½®ÿAüBŠ7[ŸÄ~Ã\WåØïš šüý=û­Ÿ®œ¹ûUC©êi­gpÏ­§jîêEáë•â^À}•å\låøy{ò—£^øà,â|Ëgü¿ó~Õù´ÿqÑ?ØÓéü¾åCì…ï8xZÊò‰šŸÓ¼åÓ¿kþmü¸EÚ¶T}l%³±×Uâ¯oYÅÏ»oCŽJú™Ÿ4ÞHÞ`IL|5ÚKì葽­"Þ2M _Ì»Šü‡C{$-p„I¼…µä›?ÇçKý´"¡9Š#ˆëêôA´6h¾U¼ùmê§i¹…8¿R{³+FbW;<øÓÜ#ÈgØ´w¨6Ë¿ò;}•Ãéÿ²€ *šñ‹öuØ›â+ÉÏ•³åˆ‡Jsv~°\û^CÄß þpÏ×Ê3Ûµ'eæ÷ßÖ-¿àÝüûRõçW>‡¨=TûPîÍ4ìYÇ$î¯æXíkú »ÕzøÞvêˆÚ»Ò|¤ú1½ÊCßÃsyªSûCM¿€_›Äã>‡¿?G|»Þ€æí5G]!þp÷çàöŽË°O —r®ÏÑ_é¹<†ýuõûK>ÂÍ¿á׋´ÿ°EqªýuìžçXäÝ9QýÀ»±‹MWð½…â¨Ôœ¨m5¸8ï-âÛ½âHç#ø­Ž;ÐOçxô®]ñ³[ûÄìšðI^¼ýgõR‘üä ‹?©“ùëËü\Ç_|®E<‰-Š Êåÿs†O¤q%õXËÑâ¿z˜YuÚ²SkÏ_¨½‘•ß#/%â9X2—¼héèýlí©^ .-XGÞªu÷Ûp˜x0´'ËR‚ü8¶ oRþW{Ç=³T·¾’ϵ‰ÿÜr¾ò¤+±'î‘â÷»ûê·%†ýh;B} Ÿ‹Wô*ñoýŒ^»®¦O&›_w\(¾è¹ÄÕÎLjJT/³5QªÐ>–*ÍqùNïÎòxM>òhmÚêÍåþÝÚ_í¹D¼Óï‹÷s5þ°²W< ÃoT©¾ùò§ég´Ç{x¾Dž;„ÿýÔ/Êf1'hמš’›Ó¹‰Ÿîåíg€[KÄ[ì~@ýx õëg÷…‰É1Üo/‰û ÍjïH“ü`¡âJÓ*íÝÌÙ¥>Ú›ºŠ÷·$þv¡¥Où©)ð:Y¿xîÇ.V=ƒŸ0Ìáó,S9ï*áô õA9r5ï¦|{Žò…Õ½§ˆ?ö%âeS™öÝ‹—Åò"ù9çvä¶]ü‡­9Ú·©xºn‰úc®ÿ-Ìòÿߤ=ê'ò>¾ZÍ#Ÿ¾hSŸE]Œ¼G©Mû#ÅwŸxájžI¼6­ƒ5:[y•Zìti³êü·kõjå™ÞÓ>sééÒ­ÔÙ<òkVí§ÈæÅ|«Tw?Eû}7)Ÿ§~ÜÒKÀ¿¦•à®Ærä³I{à–,âßsÅT£þTcòæª=¢;˜c´œÍù 7µœqŠÝ}æj=Ü¿]}–޵⟋ž›aŒ/ƒó,/ñ^KÅ7Тywœx¸á8Ù_íÏ®ºŸç¶Þ&þså½ògó͈³jæjNU|ÃnÅÿm♲˜ñk6ñY—-ý·k_|Ë{àá¦Vì󢉟)ôÚßË}TªÙþ7v¿IýxíÈgîçôA—à½[öS^ëú:ÅWÔ ý¾–Ã5Wó©øÏ.åsZ>7ßÔž½õúüç°+K´‡ØµC~xòSt ù²‚ìçrðbÓUòw7j/©öx_áþÔ¯Û<›ó~ÆVÏ9·nÃ>ÅÔ¿ÿ+v­â7ñÖh¿K‰x«= ñíô"?öÛÕw¶œÕü}«ÖaÚwgÕPí­iñ)¾ž‚¹VÏ2JöGs/î æTÅŸÒªŸs¿G¤I{Hê›+U?c‹GùMõÊ:ñ¢Ô°¯>ð—ÿ0ÍÍýß2&>§xêwvѧfS^Ãú;ïå¿j‘øò:Ï¡¡ísÅ©âÁóþA?@ù íwU_Lky¯[(~üwˆ·ÚWÈ?RUçÒÞŸn×<¹mºøóGp.9š·iúˆséü~‹æ÷ù=×s|Ž[ûóÊ%—E~沼͞EàzñÉ•I|ÕšàsÚ4·Òþ~¢¾‚÷òXÀ'¨ŸLûaÛ>E›Ugçʇ¡GÍ:oÛqʯÎVßÈ}ÌO4ý,y܃]6©?¼É©½EÚYûþÁ+^ÍìµÚ_Ä›#¾}{™æŸýàЪfò)‹O!oÖx öªCö³<Â}Ùáý—ªNܬüe•ög»Wq_&åe|Ú«WñvÁY¦=+Ú‡VôrÕ¼ýqÀ¹»Ä—jC«ì.åíú°ã.Õ¥ªÏGÞófWyºÕ×§}ÖeIì½ûrpe±æuKÖ=k/ƒ9%¾¿»°WåÚj_³7ŸüV]ç\ý)òÒ¦8ªùiñ“&¼½xÑñ zR4üQ¥¾’–SÁ¥Ë±Ãå6éõ)œÏÒ÷é·thÑ>;RU¡ºëtì]ÁEôS?‡æT]·Ên꽋U¯V½Ï± {güxÏùŠx)ß!¾mÞ‚]ì´jn–xøFIßWq/ÅËÔ§°XõÍáºÅOVs+ŸÛâï›ÎN¯¥Ë7;äºPý;ÚËìÒüoÓNäȵDó×PGk£ŽýÄ?±˜ºOÞ$ᣠò Óðùš¯0ÎoýßœwIœ[¡9GÏ·êgSß½e ø\¾BNڢϞ۰§–‡Á;u{ÈXêU'¿TÍ4åÉz4Ÿ0Oýë÷iX}ù•âKo}CýïÚGš/üéÕÞUïRò{¥õà·õC'ÑOå¼ ù3§ÉG:4ŸÜ| ö²Mudß±à¤VÅm•ÌËæhžÜw¦ú47`“5jÿNù¹â¯Gõ?ÚKu9߬=òõK5¦>ëÆOù³á(ͧ}€4犧$Šl{¹_óÿ²•âÁªªÂÿ¶?‹½°-×^ƒ^íW«ýì?o-™€¼v<Äs:4WV¨¹¶¦³¹¥+Œ·|ítk?uÅ\Þ¿±ûhÕ|žQöIJvË"žßIÌ+5­Q¼úø$çaæ[J´‡¬Vù_ŸöˆæüB]­Y{ûl‰7ç4åÝÔ¹~øE²y2çûšÓÃ}i?„G|ç%Êw47`GZÕGÕÜ©>çMêÃz ÆzåwâqmMéÃÈ™e;ßkÔÜåbñ/Ó¤>„¦—Ô/R‹mOÁÒ7ø¾êßÈ÷Ú Ç• ¯ªÿ»þTõ ñÐÝ.vÿ@œºô4úVªI}ζû5'û=¸±Ry®¦|î§ù'õ÷߀](U_`ãïØµÖQØëåƒ5kߥýXWs¯¶;°¿¥êÇt.¯xfjŸÅAô4 T¨»éüYóü}–÷¢Uq·õiÞÓ*¾ {»Ô¦ù•fõ›—ª¿ØëW¿²ú¶ì_bOk5çà>‡sµª F{óÅ¿Z¯z½Ï,ÕÞ/O¡p¶öp[ÄOœû0÷h©Rý®[~þXáÉ‘»MuEí#÷ØÅë÷ ø ýyÕ£ºÈs•ÏOöª§wàŸ²{»›µ¿ªvºöÈý©üæÛŸRŸ \Óv‡ôHϱh*þ¨(LþÊ;Q{1_äýmÚ繨I8E{ÍS5ÏðŸS{%~²á}ä%çðŠw{a|¯Óä¹Lï«ø5oyèìÞh÷ó¼g¹æï|Ãy¿öµäqýß;¼ã4§2’þ{ÇÈIçkÔMZ~kv¯íàÅ:å+ÛÄ3é8Vqê\õµ*ßѾsk¼]{ö•?^¢º˜ê^ÕÛ°{¦+Åkq¹üé>Íc?—×€ŸÈW­=sâêλ±OíÊ ø–"—í;´—ôHôÀ$~Ç(ñ(ŒÅµmSŸ¬ö˜]äƒU3jOžûfîÑv¨æ¼ýœ§I|6â?ljW®x@ª_@®L·p/O€›J¬â‰ú¼ñp–#ˆò\£xîòû¥fÎ¥é(í[<ƒ8²åñ%d÷d‹ŸÜÛÃ^ã*åiŒ§Q,“]kž‚~ÛÔ^ó{è+©ÒÜHý~š‹Ô¼eQü yÚoÚª¸¾ú{òUî—ÉsV)¿ÓMß•[?ï-b¼Esš¹oƒwjoÒþ’©àH×ôÖø8½\ø½YõYg§úHÔGݱ^\‰=i~‚ÿ/8SóM‹ÈËy¦àïœã‘“b³ú)5ÏÞ¢ú™ïPò§µª«V‹лOø@sžVí¿²o¿»Åf™F‘ÍÏzÞT_rq€ëä¿éSñ!ýÎ)ÍÖýWj_¶Î)çLú½Z¿¾}»U­ù÷ÚW ½:åêoö~"œ©¾”vñ[–kþ q*zÕ¤¾ŽJÙkï ÌÁ´‹Ñ[Hþ©Aúa ¹2ͶLà9*ŸÑ¼©ô¥ýqñk|­ý&—jOrT{ó&á:WÒïWЂ=h½»ë9?Y¦zƒ½‰sË÷p®nž#;Ïo=ÿh-7´ªÿ±uñ¶é#Õ·­ø+g«öu¹Ô/ÞCßX¨þΟàM/ßlxà­Õèg`°Îñ î­Fçá*’Ðþ—†Íä5|35Ot¤pÌíüœQõïʃÐÛV—òý¿k/ÄaÌ ™´/³l<÷£=|ÞÝðMTœÀs/ñŠ¥žúi¹ì†ÃÆù7©ÿÉâ'VWÿ³ø,‹¸ŸòǸϒû‘ŸQóL8ßæÃñCõ Ńا9‚>ì¸_{Ì[UG¯uhŸÞ}âyÏg.¼e•øœ6Þ«úáï¼oITûÞ.V^XüoMgPßrÁ¿uŸˆ'ë@â:ëçš¿üžû5=š·å½Ú'kÜômTÂ÷çü¬}/ßi^ñ8ü ñêƒÍwïjzŠólÎGßó/"ò6ˆÇT{Z¦âû+>ËÇ/.yJs,š§ëÞnÝ}·hƒå$ñ·^„=òWknÕû‘æ^ÂnVEâIð~«y-‹xÓÎÂïxó‰‡òî&o¯¯¸øiÚ6 ç¥âUðV 'jOªc1ö®\ü,Þ©3ú—ÐàDü×Sp>ŠÝ^zqvù…â‘K?í%ôÛxqª=@ü\"~G£æJ Ê{ß4ž§ä üzó«øk÷%ê ¯@¹âAïà§ÖsÅ»u(s®žéòãâSo¾ýèP?h£ê:‹ÅwnW¿UÇ`ìeùUÊcLÅz•pJN½Uø=w5çZþö"W}Øíê»vs­wiOR¡ìçwêK]Àý–©þ¡óÄ3Û®¯¸œ8ºÌ­zÕí+x—ç©¢²R~®fŒööeqn¯xØd/ósÕÏÿqŽ/—zI¸·([ç^@_ã•Êß·jßW3÷Ù¦þ¥ñähNß}’ölª/°U}u^Í)ç_O½ûV𦽗¿o»{`|šçoù‚¿oÒžOÇãâÕMcÇ<Úã×v‚ê=ší8Fùý“©wzÄgSµ»Ñ¹ÞŒöFüBùgØ·¶Õ´Ü˜åëR}ß½…{Ìò>™g‹h<{ îD.Jˆ* ‡)/kRÝÑòùAÛ+šCò`W МüëSœw6ëw‘_®?µý Þ¿Uq{s¹êÇ©¿ærþ¿ìKü­ý üLq3zïÿù2)ïç‹a_=`¯ ÅC]«~ÀÎ ‘—šõ¨/À2ŽïÉó!oíÈnÊ>U_LnO¿eíß¾ž½dÞ›ÀÏÕVíiÿ•o¾i;ž«ºy‹öÇÙŸä{mSñßí õç|ÍsšNç¾òoÄo} ®6.@¾š´OÊ®ý–¦{ð;î•ä‰rŠÁ¥%âãÏû‰¾‡Bõ×{U'·‘óNçkþYüÕš“ÏW}Ò¢x܃ŸÆ±=öDy¿²¥Ä‰5Úé½»Z¼—:˜/;á{ûÞ¬z„Uçn9As5ŠÛŒ—+s•gÉîqlÕ¼Š[|W^¸Å­>t»x@Û^SÒùŠŸŸÄÎ84gU¢÷l¯Vµø)K^Á^¸U?ìp½{á»wó‹ä[µOÃ}6v´FyY÷‰ê³¨àßËÕ÷ëZ®¹¦'‰ï*‹µï÷ñ~Z¹‡Zá=ÇúÚ\Êë´^¦="¯(_¹A<íÊ#Öj¿¸w y¨:q£ëIíñŸ„ùdí™ßC?˜Ãǹz?%ôÍÇ.´ÎÍW}´ìcì^å]|NícØÇJ þÖ¦¸Ðx“ö® Ílê­š#©o_éÉàX{çU–äsm—pO5Iì^íçØŸ¦Ûˆ3J5çíy\v¤J{6¾Ò܈ø›–ˆ¯ªŽs³þ®ú¼ø욇mZ(¾á›>ÿûèÿ~þ~üGp˜ö’ç<¢}ÙNð@©xãÍê/¬¦xa:¿W>‰çÎ;V{µ?¯|½âáŽH,~&bèXª}9âY)Q_GæÝ+T/kÐ^£²Ûxÿü—©3ùмµäÝýøÎ6‰xÁ¼ŠûÎSüíþMs$ó÷–ò•Ú³T©½ÉY{c¯ŒÿRpEѹðN8.ã¾kιA{ [W‰çòIä³0Áü§u¸ò_Gðü¾¹àX§öÛ·ù´¯m>zàS_FÞæ»Ü‡bwìÚ¿Y³¹k¯KÓùÈ™¥‡ïïX­>ª ¨ VEÁ­¶«ø}ÇÃÈw£—穯‰÷IøÅ¼Vô*7;ÖâæÜšŸ¿Åƒšë¼”ü®õíרÆÞ8Åo] ù;‹øŸÃÄïs18Ñù v¢=eö‰K ³¿Wˆß´Ù‘çVíµq­Ò^ô‰÷,)⎂?™Ç(8‡øÈãœmŸ`ï‹ß”ÿúS|¢³Ð¿êÓé£ó‹}±)ð~F>Ãÿ;zÖ:Tüâ[•_S·Qýr– ±o¦'5G´ùîÜÅy5ß©·f?î£e¤ò…à'ï$ž¨RÞÓú ïÛ6…{*R³§ÅǦúlûKœŸUóSmê;±^^–‰÷Ì:Vùuű.ñ;vÊùY¯CîJ_ÓUøÄ3ìÍ×üßÈqçÌ‹7ŠO·I¼;9›ÄCä½³sâ󈧳}â…â»¶h¯qËkÜ£û[äÒv¹úÇȯ nœ—êç^ülá­ÔùZVk¿Þ»èsA\^_A|`:˜:†ïlpXåbí·R=ºÉn2%øyˉšë¿•ùVR{Fæˆ×d þªó+õÓ-ÓžnέFüõmµà»ö«4ô¶úmvk­æ'›Äã;ƒ{³~§¸h9úÛ!\ÜT…×eë ê+riŸ »V¼ ç%ªK|TÕyÎÖK‰¿*‰@üŸžõÊ oЇ»Eû }cÑ ŸE|Iê{´\®}:Ãyßá-åQÿо†ì#Í}¶îAÿýƒØÃåî×\Ô4Õ;^!È­/À»‚|LÝä×¢®âvhèpâáæ!ÈQN5ù_oŽìïVαTu…Ž[À%ÞàÃh_©»A~Uý_KÅË´tçU ¾ä¿NóËȱÅÉyå¨?¹ñõŸÕ!/ ÊO;¿]¹µÁÕZUW.?ÓÕI¿A_jG‹Oi†äh=òÕª=îMÚ Ñªº´o®øgŽŸhƒúŸÅSœå²Iï|Kég«ÏCû_½Ú£U¿ Ä.6ÕŠëοLûa¼W§Jóð –Ø›Í#;–“'ñýDºs(8ªü]íiÉpMš;,W?÷Oä­þSí?úX|À‚ÇJGóJ«ÈÿøŽ¦ß Tüæ•Âù¾5÷S¯¾¹´¿Õ)~°.ìR§ö úÆk~Fs¦£‰3ërÕßô§öíjG­öe6*¯Ü<ÿÒòñ¤o2rW¥>°J§úB{Èwœ~vˆ§Û£=SН,[{çPí­YFþ»œÑö2ïUjTžbŸc±7F="ïkò’¾kµÇHs¾<ò Í7 =ªoäÍ£þÛyšö^(ÓØRõY˜—qï.åÉ+§’çñ<-žÏ÷·êé-ê3Ï›({u:çY§þ±–r¾ÏS¨:Ü%Y p|ËØÁ&ñ/4*Óx³xðć×ÜGýÑü&rÕhÿ»öu»åß³û€³ûÎ-;Õ½ ½Ê}=Ùý µâç²=]m|ŸÏQ?MM§ö˜hî «–“Ðc÷AšÄýÀ¯;µ×¬¨H{tæ*?w/rU =¡Ù|tåFü·Ã-~«êdƒ¹ßÒÓô0øÊ³Fûo§þ¿Ï0`ðÀÿ®k¿ƒ ûïÏýÝM®6ÿÿñ¿[¨¿Ü¯;ûËþÿ?Þâlòg<û—¶6š¦µwþ÷Iÿ¿Öé MË~ÃÁÿû†ÿ ¿ýûïçÿ«5üóÿûáƒ[lÿý¤³ÍãnlõÏ0`ÐÈÿ÷H2`ÀxƒÁ¬z\úÍç¯Qw¡q»æ·´·)Ùô™alÉfCÀ@ßjby‡`’º“_üÍ‘…èq÷Uü}ôì˜ñDìšórä5Yðhã _?`Èìw áÐG3†´qMl¦ëyCf÷å>ƒûë¯ùbþ›oÚ ñC”g~.Uü[ð<ø¹ïøÖÆ/?ÙÚqÝSÃ<» ~qvºX¼¾'“ÿ¯G¿ªžb2±ï¸MÛÖŸûüÇÅFö«¤.Aïú¯ .H|‚]HÝuvã÷·4¢êoJÔnÿuI•!1èÏàï“ÁŸ¡ ðc(ŠýrÉÆ¿_ÕøNφDš~åðœkçB¾7–7ï?w0¤­œkbíÊù;÷~lðÿŒ‡ìÔû{/a¾:¼™|_Ü®úÑ|ÿògàLõ¬½~Ü’Gž½ÿ‰ÿ/ôUô-¾$ú來ÐBp`‡=ôIÖú ö6ùÃæØÉœÿß=q¾‰Ñ·d%ïßw ¸¾ö#ô?TÇüi ~'0Œçè]ÍyvŸª}ÒßÔ;ÁM/÷¿bè^9nÓm¿ÿ÷žò|©Ê!Çxv—¡\u×ô,Þ×¥yÁxòýžüXøüsß`Þ'Ø„ž&@~½ûÀmýâ ŸÍ9Æï>ÿÙ9Ó Ñ[‰o­¿Ï^Þ‰¯aÎ-úù†.'õ®ŽÈ ”ßIþ'Oû2“ïìò=ÿªÏHüЉÆã†:ÐPÿ!ùµFñ3ù¾¿WH¾bâ}­Q¼ýmÕOÃü|ë;ÈKfÁO×ïÿl›!YË}…rˆ·B¹œwlQÎuß]ù³¡÷mä1ø+ç’ƒý¶¿€Šoäï×ušûJ4¡'Þ¬×/v5òù¹æSâ_"§‰mÜS¬{ýqç¶ì4”µ1_Ø«>zñ4mÀoDO$®_†ýN^´ç©9Ïþ''›8Ÿð3ȱûzpO×ÍÈQè<þ¾æüTò¸Y†A'RUäí–ïâ~ÓÓy¿Øpü˜S}^Ú;yGuÑCÔ»”º‚K{žz·!æÙØ£Tqsj;Ÿ“©ã½ºÎæÿ#çaÇ‚—ã+—\?{L¡!Õ‡©¨S?‚æ,*…—}ww…>ÄŽO"Þ ¯vˆœÄ›Ï3ÌZþŸ½>\dWožä 9 ;iÃþÇŽåûÛ>>îô×ï5ÄÍfÃÂC=ÿÙGü|¦»¸¼“x=­¼Lx+~>}ß6Ë7ß5”«3¶šû ßF_Áy&ŠU¼å)ðJl¢ô)j™ÿÛêQ†ñü†ûx¾PsPþ·ðÛébä3þïQô'úWx(ü)‰ÈºMOüx‘Áó1}6ÁùýĽ7~¶çÇ fí½D<_Š<§#7+ÀõéoñgKÄÓ'o’ ò~ñÛø~§âåØü ¹pñƒš'ÅŸNêüá tî#¸ïä <_õküœý3í»\b{yêŠ#‡©õéÞò„Iõ‰â_©;önÂÎÆ%Ÿ=}õ‘†6õß&Ïä>b£±û©gñÞMØûÔ+à‡âê3é˹ïÔ~.uËëŸ}Óð¬!²?oKÿwÙ‹ËR[ÛéÇuÓ\Cº9Œ}ŒÿŽíF¯SK$·‡QONäóœíkM}÷€aÒö¿ ©oñŸ©/±óÉ zãx\9=ˆLá£wà7üÏ‹ÄD½¾ÓLüxHãÞ9k ñ÷Ëô`úÏâÏc?|qú4_¡oÁ=èKw÷—œÉŸË¾Õ|x×Bâ )ï¢/£âLž;܇^¦èIÀŒÜØRÊ'kià\Í܆¿½Þ,¾z®ÿä#ô¦ê7êëKžŽþ„GÒ?¶H|O5Ú;äxY{V"Þ0?‹ÝßÉç÷~ ^ŽMÔ¹¬çïýۨץ·ßø‰w‘»ø œCzÊØëþœ>Åà~ƒ¸»ëFä+2ÿÕ!q«ýq4#_V«pÞ·ØÏôŒ©¦Š¡gv$%~äÄdpJèOž+yçM¡á½äcGrÞ‰‘ü\êÕ{÷ÄÀ¿ûó‘;ßüJÏoÔ?kç7«<Žù…n q^*Éý'Ö‚ïcâo›Næ=«:Á¦ì]æDžÃr9ï›ìÆŽ§¶íû÷¹œk ÁGøÜÄoØPŠ|LÚ¬¹‘eÄ¿©{ 6½Ì`Cº¿Ÿ¹‚çð?|'›ÀÛ‰%Ä¡¡«‘›Äñ䑬‹Ñ§Ø Æÿ¼}•¡çô!y!v¡üù¹íØÝh-ŸW¶@óMñüé§ñŸ‰!ààt?ö"<–ç$x¿"Í‹T £/ñ5x)˜Fïýw’'q’¯ª,'?`]‹œ†¼ä_SoOü|Ìú; ÆÁË÷cŸŽý@ä8ô¡øÂ5¿“ bÇÂïpábž«ð`âõô&ô®[{ŸlŸò¾±1ÈO¼€o¬#š#¾»þØUÿèA&ÍÏuˆ_*ý9xw™ÏµÏ¿¦ÒŠ#ƒœóH‹!tÏ›œ‚¿j=üj…Þ¦þ¶E_¹øC|JÞS¯j4DæàWľ±Ø©¥êCè /zàWü`ãiÚïx¿æÙÇ_Š{ñ+‰~ìŒëmí_ýû]­ýÞqø‹ÂAî%ÚŠ}±mC>RÝ’ÿýÐóÀ±œÃÒ³°{‘[“À‰š¼Mó?-œGÏñèY¸ <®P_‡ú«º>"Nïü‚©5Ø•¾Ûœ±ƒþógõø¹"ñGJ°‡ñgeG*ñK•ÃÈ3¥® ÿÿ• jÀ~¦È3F¦(P&þ,õ7Æ/ƃ¼GW>qHl&ö 8€ûhy"{ ß…œ•K.!¾‹ÚÉ_…[ÀõѧÑäJpUbø«Rûj­Ÿ!·Ý¿Ën×#geóµOnqmúì¡I<˜NõÏô­A?¼&Þ+ÁNÔÉ>ÄóÁC=»y®Äfž+\ƒžÅ5Wëüÿ¸ ûrKoçr¯ùâ•wžA‘©"z9I®R¿S'ñ•í:ô-}/v>s,÷½’~Aù›/ÁÃËNA_KwD"o¶ZêN±1Ø·âgØï½üOâ—ÀFÎ/íçýïS?°…M´coBÓ…¯"¾(U?pçñØ‘´òÑñ}oý»å“÷ •ÅÄ;ñÝÈqPöÀ±~ˆDŸyVóìÍègê-Ρ^sß ç”™ƒ]ìzüS5’þºÔVòAõ£v¯ÄO¤—Å Àg½7#ý—ðžNáÇü©ôèof‘ìÕoÊ/lÅïGºð‹±…Øek!ùêš³Èã5ªß(º‚û ‰—øLä<ÕÄ}%×à²ü‡ñZüTëHÍen£ ƒ»Äƒ™~žxÀó>úÓ={d>‡¾±T‹âÄK±?µ¿‚#—Š—&3^ñ–U{ŠoÆ¿Å÷ž ïPþ'oò›~ZùH~4~'÷cuRWˆ ^­úޏ/r2úïÆ~†K‘«ö2õìÄ_ûgñ¼á8ßš„ú•ŧ—ÜB¾ËQ¾­ ¢ïñ‹Ñ§ô.ðNtr™é#¿c}‹ü]Ï_üœõwîÑq#qeú¡G,#Û1„Ú±KÕ÷S‡ #Q#¿^—<úF[ÁG}£‡©aØãà«È]b$@°á0>'q1þ£g#ò;œ¸Ìv1õ¹€òû¡˜òª!ÞÃ.^‹Þ'ùûnñò÷¾‡¾¤ôüC¼Ñ,þŽžß¹ÇFõiº´¿%•Ígï@Ý.pY`.qYæzðxà]âH9üŽî­×LülÂ_FÖ!—ý³yŽ:õg4O›ªÃÞgñy±”ì†Î5™§ønŸØFì¹”¼eÑ\òر9Ä•þˆ Å,ÀÏÅLjOü}ä¦uý?Vìâ 𦳔:}ÆŠ¼÷ý þ ìMñˆÜ=‹¡¾¢ ±Cé÷ðW];ñ Ù¼Zü:>§ï/å½öò¡p~…öagÎæ¾Kij}}ëÚ_ùÀ„wn"éŸgPqBj5ö/qµx™&¡Ñ#¹ÿŽkyÎø|¯õ'âèÐ âÊ„Yû²n¥¯3¼{YW«½ÒâQI˜x®ÚÂÁð—éþ»±–øÆnQ¾JçZ…ü†›è_·-&¾ì:Rùüï¹Ç„ò²ñ“ÀÃñÕ¼OèhüYúMž³4ÆÜEì0âƒðHìRú9ä$ؤRøÙ'qoùÛÔQÊ“X‰·B¼vÎVìpç Èoõ®èƒØ¹ô{è[ÙÝÔKÿ`gûvË Eþú'€£­ØÝ°æ {ÁÏÁ"ò#}çñyîwøÞî¡ÄõïkUˆx,ÿ#â)×ëħ©[°Wuз`?„þ ÛRÅ›!G) çïW31 ½ ™ToÉÁÎvôÓ÷Ñ㿤nVþ·¹ õð\]·r.%êãí8Lü裉û㟂‡û>Á¥ÜÔ[‰ãSï‘ç‰-P>ªÿšþ»ß³y¯~àp}p,÷ß5œV«}{Ës±ç‰~"‘«ú‘pYú_prõ©š?¬#®KHÞ¬ö:âä\âp1síÉxî@=zܵ†çê:9ë¹yüÅÿ§®çƒÏÒ?Ö[¦ºÄoä_5?­R=I|”áSùûôñÄ7þå©oQ~b2v0ÞÉó¥–ñܯ…»3ØåžZÎÉ3:†£?åþE¼¹ŸÌ»Áóv‹ìpç–=ŒŒBnBµœCá`ö4$~âþÜWÆ´¶Û„¼ôŠ¿¿¯Hüe7cÇ"ŸUíô9N¥<õ÷Tï¥ï<¯Ž>ëôò[þ‰Òí—IÇ{÷Þ‹õM¢o*_qò2õU&,ä»¶àƒâÈÀ¯ö*ä½+OuùCÀOµ§!/Ní™ë¾{n«R¾ñ î3} ø×x=ö-õ?W9Ü€s²íŸM¼.^„#‘X½ê’ýÜ[ðpEp…ê¹ê²hžÓ?,#~ËÖ·ìgáÌ!¤Æ/†wpþ6›øªž þš I^Ö£¿‘©ØáH=v1q¬òCÕ7RÉßûÒ䇫縴Ç=ñç ‚ë×áì#™§KyÑGã;¥OÿÔ.¡ÿ-y&y&ó‹àŽðxÎ-{ÏÉQøÔNò8©gÈ›öîR¿ÈÄ‘ò} »yƒ?}§È߉W¸ïSìtàEòê¶-ê›3b]ó§)£zïàsû õ¹…ßkÔó¶ò9᫈'—’'(:yÎÛŸ[øvô!ð.r; ü¿ƒ¼~øtê]ñýÁñ!øg–§t)ø­î0ò‘ƒ±ÏIqFj-òœh Þº| ž ìÇœi—öÒ§*Ð?c~¬ìbòô‰3ñç©Àm˦O¾·û®‡§ª±…KÀƒþ«ðËS÷çR³ ÎgÉã·‹Á~2ø»a ø+$þ­Ðf℆گ÷ ý‹Á|ò ý?ð~±¡Ê¯E¾Çu§ê 1õUä‘·MUþm'ò^Œ\„¦ƒƒ6ìZüäÑâ¦ÏÅ?œxªý4÷c×O¢~7v<3PyÆzðCíðøåû¹ÈEzøÙn@ã)Þ#q=xÅ©=ké¿x¯È|ä°dýxq;yÌÀàᎋðÏ}'Q‡ê¿€ï/ÿQ"»'1~×]¬úöïÚ›É÷E_ÆžÔŠ‡½o;ò¹€ç¯u÷|ô·ÄDþ¨`v&³–8'îB¾âwà¿ýÛè×°ï/þí1‹ÿŽÇËò¤Ôö*zšH¨hr¿]uüï/ëxÇ2Aò±S±ÓíqHžÍ{Ç&#Ïî)د˜ú•ƒñ ñjž#ö3&†?æsœÈ[ÄÆÑ¿ŸÉ}ÆòñgÑaØùÈ—ØíØYø®4ß“{ø$|»ö北Aìnô5,þëè>ù³˜,¸ ¾ƒø`üzjö¼Xý\níݵäyC3¯ØnâÀíÄe“§¬= <Òû¬òå3°GmÿÐOÜu÷f¹Ô¡zWj#ÏÙÆNÛT/» ¹Í|‹ÞÄ:|¡:Ï#àüØÝèmXþ¡[x-ü ù…DqCâ)ðPé8âÈÞyÜŸÕE¿Ÿãdü]ÑZê,æYªž¤zâ¡êºø*ãÜ óØÓÿ 9 «ž; {hü»ºl1~6sy–6ÕE\š+Æ?¿#¾m©ù¬NâØØÉà¬Äü"ˆ^'–ðgê!üpت|Í&ô¤q'ušôØ£þÓÀ•Vñ]8ÕWamÇ.$.ÀÚŽ?»´?(¼™sH˜ð#¡EÜ[¢¸ª!ļFø.Ò#À=á?°çéNì{l ýX©uÊ÷‘·Ž#¹ß®ÉÜOv1"þ®ÔÍÈE<ž ÁÏÇg£ObçÍS¦•ïOc—’­|ob:ò`ÿއÆgã“ì•S<Èé9Wç»Ø©®MämŸA^òv Wá?é·ÈŒä=Ó \‰^;^']"^ðÔ×à¬T5ò›L¨ÿx zí¾“üvÕÇô!X?D`BšçKï圗]ŒŸMTžI¼Å]níÃ} .yyF{5´':q0öÍ›"ÿ\Ò>©[¡ºæä=~8zžz•çŒC¾ CüÔñðgî›9¯ä,åñ+°/þõÜGüÅÃo’Jw!Ÿ®'äf*:½J_E?Z|!÷=§¢×ØwSìãyíâ3ó¼Äç¤VpΑyèa‡öu*>é•â!²«ÎV‹ÜõF”_µóÞÍÚ|Þpõݾƒß¬êAÎìmàG'uÜêS±³ÝcÔ´Uó`;Ñ»® 8¯ôÍàÎàÞ+Q…]Œž‰ýv|‡ß¶ÞŽ…çEßC/cë5o{ö6<¿›Žk½9œèZô4±»ïXA?j· ù‹…UÿV_WëLî#ü ßú@ý±¯ò]â•ç‘vÈ”QçIïA®ÌšiøÛÖ#U›Ì÷Ô>Iœ€¼D·£—‰ËðCÑŸÑ—üxhy¢h'ñhÏ>§CýŽaÌ]Å&Éìæ¼].Î? ùÔÔeêGV¿c2ƒßˆ;ÈøÏÅõl¯%W‘ÏÉ,SúÕª5˜Å?V{5÷;Ž÷‰?€=÷C¢¿ƒ¸Á>H~o›úÇ+N.D¿;NÑ~Âùäi».WŸøÁàÜô¹È·yqt¶.Ô[£ù€ÇÕoù>çÕu3ò^‡³uÃp+Ï]¥%q1þ½÷b⨒#àõëýó.=ùMÜNžÞt3ñ`rzÿƒó.R½;ýò•Jž°óYäËþñ‰õ ô§§‰|eè'î¥[ýá\ñkoKÕÛô?Ôé›+Ußq¼;^_L¿¥úß[|Np&~ئ¹Ç|'u¯&ñÇ>Gï“iâËÌ@âôÄ.ìƒ}=÷Ö»{àoZêeÎÑ->;÷EœwŸúè2G£wÉyà¯esø½Ø»|~z x#9»ˆKFÞ#}úm‘]M6 g5qâÐÀ艿Ü[¨|ØÕ×ZyþP­úð4OŸZü¦æ¹?€oãg*_F^½{ ùͨô#p¶êPó]=Ķ-ØûBñýõÑP?„x$°< ýK­Ÿá~/Ù÷•>sIîǹôÞËÏ•ÖsnÁèaA=ïÙu v#iäþÃzÎÀ«ª7í#ÎÉ P?Ö³Š+/ÆÞ9®—„£àñؾ׺Wûõd/Òm؇ðzð`p_òPô3Úª=â…ÞBÜ•ø”8"ýïiËQÞîažÏúµæÑ_&ÿýÄ_ÁþôýCœíI!q#öÂ5 ykŸBôìTÅÉÔãRߣ‡Î$—§]1ž+>Yvu9ý7Õ^ú=ÚÇ>¼œ<ûK}Èï”ï0ÃÏÙN£¾Þx5qKT<#ÉË•?þ?f;›ø5BÿŠ´6¬ý ÍÛ5ÿž9UûËžÆƯW½ýùÓ_ùw›xe—Eˆ¯º×h¹x×ÃÎ'¨þ¯ô*âÊ®¥ÜW@}OáòYgýÈ|RÚ©:¨xÆÓwÒ·Až{é[ìîù™8>s†úþn÷¿?ì…¿ÍÏ¿S}déïñÛ]%èCx ùËíGmGkÔÿë|9 §ežÿÄBècS¾êZâÃvž&}…_ì¹Æc׌“© VjBU<Û~ÂÖéG_oè~½M#>2g¨Ÿ,…ÏÀ¯þóH!rÔ¢½î»é—MÕ+ÿ^CØäçkŸæ}ìÇg¤Û9·èâÐÞ»Ô­ŠÜèiè]õuH.SoËÿ<Ç}Vh/±í&ühèbî·g:v=|:qoüðCútî)ýµúÎ!îJÞí:‰|”ó2ä3>…¼IÖ>t•#ní¥1ªo=srßû§öT åߦ1/–ÜIü´€¢K8÷Ä𚻉zcú[Õÿ_TÍ›|_PsåñëU/|ÿž™ ¾ë¶€ÏÌšw¶mÄÿ„£ê«ÎnÇeE¯Ýwó½±c8‡ÈÑ<_ðbî/ý‚æŸnå½ìán3x<9…:vÏäéíÚ§œÚ*¾Æûµ/Ψ~ýÕà¹Ê°;•'Q'H<ƒ¾†š°¯âý°ö¶Æ—aÏ­ïb'Ì×ò{ÉÕç¡üL›ø~Òõùg‹ýÎi¤Îb9ûÕëÆï¸Åm½’ØÜ•~AßOؾÿ NŽ â{—¼EþÜ3 yÄñ}§ÿºéÇ%ÝÿÅáäíMFêʉmÜS£¹èxKCŸ„õä#¸¹óG¨›$FáWB¿£ŸýCÉ㦷¢×/rÒ= ¿ `gJÄ“×>‰ØaêoK<Âû§^B®ûzÐÇñlG>SÞàUì§m7¿¼bàqõü .ªÿK°ÜX­üMHyî“5÷5ù‚dæ.À[‘W­OŸyçÕ=ƒ>–î2¾'¾„8/ú/qfêÍ.= œ×z3óø÷þ .dè?OóÈŠ#÷ÇrHÿMÚCî<œÚ¦ú¸xç‹•7XÂûDwqÞ¹W\Òû`4$O?¹ö2$&ÏÖzWúlPÞå4õïiJ÷»ÈgûËô!¦š‘ƒètìˆÃŒM.$?;5yÔ%Çǹ<úÕËŸG»G߸öÊÿ¨®˜‹}ðÀû÷-W|zŸº“÷.ÜËç&7’‡–óóévðkÇJ͡ќT%8¾ò>òÀáaØë°—|JtzÐq¡âðì\øtôѯy={y¤ørõÿªúöÍä?"–uò‹Ú[mz<ãÖ~™äüQl¿×ó…úÖb!3œŸ¬P½ä(ìMú^~¯p³öÓÖŠ÷åx<âyÏð)Ègµöóù7ÒŸg;Š9‹ôaøÕp?è<ú¾ãâËž=à¨hqQê3êr™zÍÉVkÅ Øå†Á;uÚ/2aGçò=þ±Ïaííë¶‹¯Müé!²çŸõ5bß‚Gàç³|¹®‰Ø×Ž£xïÆ_5§þ½âüc”_€|FV©.|ún@`‰úÞ/ÂîDGá÷гmª[VÜGÝ:]-9Z­¼òôÄ8‰Ï‹IÏÓן¯æœ»¾SŸE ø(}1ñ`ÙØçðZp£=oÅNÌœ½tÙ¾¹þeâ‘8‘s©ü~žž^äÝv6oü0‘1Ä•ÝÇá_º:É+¥ÂE{UOiÞc>ñeô^üµõðNðFô$°’óIÊÏ[åþ’“°·};•oúüZØMÞ§î!ì’)Eüö7tã¹ÛÀ¾ôž‡œU/Ï&×iNüGúïû–qO¡È?$OQß×nÎ3rŽúý5‡Ut9ûàò ]÷k^o®x½Õ—øŽ8<‘ >èùBõ‚uü^Y‹x’”Ï3i?_ÏÓÜS`zÛ»‘ïµ¾¬=%+gV¼­~<·æ)SNñˆÜ¾Ž./Ê¹àš¨òÎqé÷RÕoLăžôÅ­=׉ƒyÞŽ©ƒÆo¦žk¼½t‡ÅÛóqKöïT žéÛ£¾ÕüßiÞö5üˆwú¬ÃßÙß'_zÞ`òº¡5dDN’Çð¼ÑôÓQžùaâÔä,úUjÎoÝÆsDú°™+±ÝÍÜÊž-ŒKÿ‰|Ž@^2‡pÎä¯NQÿìAªKÛ÷ÒSáà Vãoc5èÃ’Që6›†.ü‡SèÕ~¬â³W±¡ñ¿]‡"¿‘›Ñ˰]ù~ñ™,ìâ\Rk^§‚õî<Ρw6çÛÅ?½G\ßóö®H|‚¶oˆã¢ê'ýŒóð(¿Ô{zþIsêÃx¿Þ«Å³:9 À¹¦.Ç…oçùŒ;è¿J7ð>©MàãŽ:ê[î¹ÿûÜw÷‰ø­xßg»»¯äsý•ø3Ó"pÚ²ü`zx¶Âƽ٠³úL~Þq(õ²âK÷ý=æéNCcxÎv2ò^rx7±Œø&~1~Í1ür©ö&ÇÇðý}ñdÐÏ^%?å7òŽãûûWÓÏT<{éÃÞ†VK^:ð–$}_ýëÈû†oxNRöêy½fêÑõIøC£’äüiöû»ýÜKz)ñBâfͼ†¾¦¯ÅþÖìPßh#q¯û5êö±1’Ë2í;Rý,æ\â·"Ï᣺©ãwÑ«º$~#rœøœoGÿ2爿ãTÞ?“Âoùï¦O;zö1ü/~/r?ï_K=I¾+Ó ^Jü…K¡9Šsño™ü’[û¯ã§‚gÜ»ˆÇü÷©Ž×ÏyDG+®ü {Õ;Xuì×ЧŽ5âñâ¯â]ÔW"Ç€Â7à'b¿ó>ÛÔGrs_vÕãìšïJp.ñ§ˆë#NìªãGõ±k¾2eç¼]qÞ‘Ÿ‰g‚Ÿ#Ñ~p¸A{UBqôÛ>¼Ûx÷’y„ßOýF>ÏöuüÆ êo£¹ˆZÕ±ÎP\ZÄýÖî¯þ'x®L+þ-9Ly:+} x/ëHñü„üäi/„åñZN Ÿ’ “WÍæ3lƒÐÓÇü|ézì|`6¸ ògâ·â<ò}Éä;|ïó€Ããk²¼màx§Üá^Aþd‰æ߀—i>²`ùßÄ‹äûJ:˜ÃÌĹ.[Ž‹·|ß[mÈoÿÝÈU—?Õ¨¾—ÄÇêÇH‹oå î-ÔÆÏ'&^í-áy3ê3ÏÓ^Ïø§qDïË =V|+ß*_dçç»OÇŸ¿É>‹Èœ«ËîòßI¾%²G}%Ó‰S2åäs\—Á›êû†œôŠ/×REAª”çéy¿˜V\™¾Ž÷KN‡FrOUk¨Ó4Îã96Î%jÀ¾Æ*ÿü~.ð’òEÕÂ÷Ï“/ʬ÷öÎïÐýø§Ð ÄIÖ…|NM.ù{ß èip=öÃS"ÿßÀ{E?ç¤ÿÆ.¥Âįé<Ù·ãÐOßbîÅ~ }YµÚ÷—êEÎ’ÓÉsç¼­¾zñÇ®À>¦‘_¬£o(ü½xœÎä= 5ç’™Î}ÛäçÂ[4gZ*~’í=½Wûá&ðó½ ß)—ìVyäYÙ91ÞÃö{Òâ-òBü\¦:Ê2ìAàôÑ¿UýèOa·C¿ðs·°2s8qYß=ø/Û~ÌGÕ_Ô >ÇäÅšÿ8Wóñ¿þÕâ=|C|Ê7æjf¿öYWòÑRõ¯Îùù¿äOS>ûÇC}à Ûpáøü^üPòN©Ûð ©Ôý çÿ‰çxÀYeŸ¡Ï5#‘Kÿ"žÏõµ¾<Å“êcM…Ôç¼JùÒñ‡É_‘÷T…úö®ÑŠòã¥âçýáÀËõÇ“WNÎC.SçúÅ[¼\ñzèå7ÅÛ©ÏÄ4ñé¿‹]ËœÎù;ê©;uùÓãUÞìMÍqƒüÇû‰‡—ãwÒs•ß®I÷_~áÿ»²<+±‹.ñ´9v0g‡<•)ÎîPÞí`ð³_|Ö!úÚÃVìZ¦S=¹ }\õ~­y²‡ÄË3 ÿÚ³ ýöÿ¨Ÿ޼õý | ^´çãGã ùÓU}ácò™íÚ[ÎQËàÒ€ŸŸ OÔ\K=ö.Ûב9Fñ{ò û‰ßèVáé«ÑÏ®{åµ_ ¥zc~(üö&ü•ìsŸì‡úK»±ƒ™λ̨x÷NñL¢Ï.zƒø:†POI8—ªG9oçߨÙRñ¢§®æ½ú§ ç¸y¯Äà´ª âÝÙ«þ)Í•¸{딕ﭷËn½(¿py T†?ûNÀo¤®G¯Ã>Þ7ÿEö*ǧÊn\‚¿íAý&u)zîÉUÐVåKî‚o7a¡ò€ÿÊž+OX§>ßÛˆï’!ìp÷UÔ­c‘»®nΡn÷ɨnüòÛWþ _Äs[«ø^Ågßh¯Î¾?x•êë×â·û®ë;â#îBn"qìtpŒæø7¬ ò²÷-Cf2qeüXâøošCù¿ký œÖ1^|®çkŽó@ä ¾“8*Ñþ©×þä+Äéyê#¾W<$Qß LÖ~ö™Øm‹öaE—a_ºîoØ2ìhêð¾Cû–‚Šÿãw-mäÏÒqôÐÿràß«9¸"ñY¯à^æþQöÑ“'eH­¢¯3ºV}mâ7J|„}ll×üò[š«Û…<¦`·C‰s{vãï«ïÆŽu7a"â£Ûñ“éJürBû½S—17Þ±¼êÜøµqî1 ý»~í­±uW³ÝHÝ‹ˆÌ}”jO€ëKí9±àÏûNaÎÃý£ö¾Bbþ 9ñ{¹ôeø³Zñ-T S—2ý¦½+ôo/¾Š½[Ý~⌀ó5Í'œzùˆcÿŒ‰WìkÙ?þ-eVœU„}¬»~…øxâóúÝ7àg ×a_=âù|Vs&okð™ä Rϋ׾ yîþý©Í¡_Ì~êMç(ÿ™‹¿Zv‡ä¦¼rÞöõQŸPÏþ šŽ^˜Bä-VÞ36Møþ7üw‹öAÄæñÑ-⥚«¸æ_Õõrл¸Gqí½ò³o‰÷#õûuˆG3= h@ò,õ™~ˆý¯ÐþóÞù‹d\¼&ÍàžÞ㹿ø2Îôuæxx ¨„þä¡âC[Žˆß¥¼Ù+ü}òTô¾ãòúËGîSYžß‰äBò+[…›Ðg¿x¡ïGÚvP'ð/RÝáQä7òu—x rm_ 9½—¨G…æ‰OÍKý*üõŽÀCü~þ»ð4Ç{UÞÿ©ÿ¬Ü”˜Áç¹á}B+Ÿçïãhþoˆx¡ŽÀÞ[Ž#>œt‹ÿü+ä§äø¦7/»×Ð{(ù‰ò·‰³R>ä=#_`uƒ[ÛBï¬ws¿nÍ-§ÊUc—27Ð÷ùŠÔ5ä¥Lç!¡©øá®éœO×kŠS÷‘w \!|¼Ü[ZOßú¼Ñâ±÷h®t$qd둪Çþªs…”E¿‚²Û¡‹‘÷ôôШ=rÉÙ²;ÿ`ŸÍs?éñín"OQº›88u·òÏû8g«øVºÇ‰‡d6ríQ!u§pßœ£™â¨9ÊŠ ¹\øÊƒ¿I¿I¾ÙïG.‹;é?íùÿìÞ+^éåèèU¾?ý ï9L<·•Ê[ Fþʦ`Ç»$çß*ÿ¡8Áý4~`y’ß÷ÜG<×öòþ[ýÅ%ÔÙ3-èA(%\dçIà¸ÐŸò£Ú¿Ðûâäô®F¼J¡àùЫ|^ÛNpsr0ñŸk"ïÛ:›û±_C®û8ìl™ö!gfhÎæô¡ÿ ñ‚–ƒûÃWqÖ ±CÉ|_@ý7IÕ¥ýxús¸ßEª/–kœß«ý“¯»𷉹Ôw’“Àuæ•âÚÂ{n¤ßÂÿæâ6jnøQÎoéVæóBÿð\…eÚƒu9Ïë¿JsØs±ÿÉä1}2yZ£öIÛ=øé®FìvªOöïWò2î;Å¡~û׊³ú9×¢'Ùk\¬}ÉAà™˜ø;aOù,õs\®¯ºRü0ÏÐ_½ˆúbß7|oàä*ôyƒäJÝÛpõSÝ-¤9ÜCêõíb~=±PóáªS†—Qwiü Þ“èÁâ_\D=(>Y}n竟^ýKšˆûº^/ñWà·šÄÍW‚#Eâ½Ûxîµë Û4G1o:»ÿ sMáÄ{ý‡x¾Â/u g[U׎Ÿ!>Ž ªŸÞ€Ýë¾Byˆ-곪/i?½¿å™ÂßÇ'ß9Ïäþê´÷6ãåç´ç6¤¾ôðkâ/¥)4LqÅñ¬_§þ"3x+>A8D<ïÑ1âE\Ǩn0Yx¢F¼R{´—æî+qòß}=øÞ©~³ðùÚÛµ~x‚¢×ð¼f#ý[½× 7ËiïA@8ìvä³#ES6õ­}C“¯}-/ð܉ËÕß·”Š/¢ïi®&^0g÷žlVä!íkðïEÝÚ *^¯ô%ÊF½»úòrÉåà‡ÔâŽÄáœóìõ7~³eÖá†d5ùšð‘ØSþ5 ?‘|ü•^nêŽ>ù.&®õåpÞ¦ûµ—x3rÜ¡|PßNîÝk?ö|Aþ2|Šê___KVãŸ1å—¿Çÿ×l¯†ãǜڎxù3õ2~:¨8¿ö=ÍñÍ_xæˆl#çßx¯ø·ÏÖþ+íE¯ºN#_h¾û˜úÜ•9ùt~ÊçeRê—Š\D_@ޣߪÿ}*x¨_s“±³Ôÿz«ö¦Ì߯·£Wé:úÎýàÿ{þá|£»9‡@\öäåu^"ÞþÂó-ÈujÏcÑüràxÍ#Ý%>´ß„ˇé<µ/$u5òiÝN™ízò@qíõê¯oÉ»ÈIú=äÊ”¯:žö7–Ù3ÔÛŠ]µnä9Sùà©Ôùßw5/¹–ç뻺iêðxb–øÁ¯E·PwŠi/U¦]8h1v3àä¼ü‹7Dø¯[sn5âqn½ûÜ?Esÿ&ž+wõDc@ýŸ7¨>µ’sêSÝéì‰EÛYw!q2çè?N}ë7(¿?Oó û£ÏET8@óHG+?ý8ö9üÏç” £=v ñBø|ô»{öÔhàIä=ì߇öðÖ\M}5º‰óíjäç“Aò™‰ Úo°^ü%דµë÷bÇi©ùô¿ŠÿívPwòÿ«¾Ôë”×ù[} fò#çØN?ig÷»†|í…ÈΩÚ#àæÐ]èg&H~+üœâØ6Õ‹Wq?Ku/ õ;>T_g#~-ú”ðÿ+šoºû.ßÌÜhúô6x-8ªõ;αÎJŸ¾còŸúSx]ûœûÖ‚¿íãg£×’ŠåóLÂUökÅkr¤ú> xßÍ?*_×m‡ônÇŽ£Á¼–>,ÏÕ·oÓò.EâÍ*Óühü9ÍÛÃ^…·b_âÛ£oϽŠ~ôLìsb;òšX†¼ø´'î=ñ±ŒÔ|…æ'‡—ØÇˆ—|#ù¥Òß©“7=®úÃéâÑhÏEÚ‹0SuòÝÄ9éš·»Ný‚£ñoIþ:Ó.^È´úo½¼r;þ£ñ+üR°¿ß]„¾§¾TÿâÙ¸ŒóKV‚[\MØ¥²àŽ¡ºØ`Åò*ñ§°Ï;Èߥ$ì»M׿û›¯~ØÄ;ʇjÏ…Guw ùé ÍsÇÖƒ#?7EÓèWq–_öõ‡ž(ÞîÍàéªóÄ{x?òÔ׌?茪î·x †r/™Ó¸×L;š‹}Nî§}KqÍiÏ’|ïÑ^’ Ú§-¾ÓÈ“àŽCàýN<†œ§Å¯½`pUì+ìXàhü_Ò*¾§UøåX!ö¸èCö_{&ÿæ°q/¡}êû_¢}4Oz[µ¯ó/òË–!ôI¦ŠÉG'Ö ¯=‰k8þÉÌ\͇¯'}PõÙó±§vå›´/ɪ~îÐ$õ%Ïßa|AÉaØËŽåø ãëÔ2Ù=â¯KÛ•'Xɹ¥žÖž"z›,Ãn”þHßZb~Í3˜¼w½úÚóaËS^c.v»a5~¯ã)ìiO¡ì×\åýÄ'àz‡Ï‹‰7¹à7æq«Å7}V}³ÕÜgr~½ôêõ]_!—™«ùûzíµç\G±_§w!ýÜñ)ø­`ò›ÿ 8µ»?V·—{ø?žªøÓô—ÂíVð¤ëNÍÓµ!»ÑÃøjâ@¿øªâåÂÓÄã¡>×q7{Ì»œšÏY®zäñm¼LÝ.9Uyíoèš$^ÊÈSíLžßü ùà˜ör9ŽÀnt¿v–€“‚ÝêЍ~q‘æù_—…î×>² pˆ{¨âʰ#Θæ*ù37£=Ê3~„}ëÙNþ¡÷ñI®pj.3ýßÓ·ýˆÁާ®æ¼ÂÊ÷Æœâ!޵iR@|^Ö½ä]Š6jïèTõÛ| z‘›¾£ž_e¿ ðö7À%‘©š·Û%žé±ÈAèbòQ Ÿ‰ã¯c¯R?¿ ¼ ®ò_¡~¿§Á­á«¸—@òY2’=G¶eôõ¥ŸP•ø~ã¼ü¿jÿÈèM8Iž¡÷;>¿êBô#,»ºCó/êãÉ=W|9¯ƒ'?ñ{¡»T[Iý³çoð»õìL<Æ÷Õ/$].Þ¦¦°ŸîIض¸xµ|ôI¬²ßÊ“…ÀæB½¸æ'puÇŸâA¸Wszó^™8ö3_û}Ã;ÁögЃÖ#ÓÆbâ‚T¿È!žêofzœòt“Õ9Cvî êK½÷)®:—ó ^¨ýÄ— §¼}Ë\©½]êë|…ûò…´×tŸæ¬Wž³iÎÿ: éÝà‘½WÙ‰ØÔuØûmê#ƒÿ³6)?ù+çWÿúÞ Þàö0¤jð7Ë•'OªŸ0áÆ>W¾@¾®d}ç~sω >ØaHmМåzñ]hž7~çÕþôîý‰#ª?Eæk/fùÖ ø@û$.îº:»FùîGµ7áFñܩϪõYì½é9ú—Ç+oÿ­úþMà%÷ך#×Ü_ê ÍÿT‚»\›yÅÈuànåéÇr.™iÚ{*\8\|üÿ w©ýìŸ(ž-%þ(ÿVû”ç}ó¦éó÷Ð÷åÉá\ëϧ¾èÁ>)ÿ–<•ûÌϧ‘~€ÿïû‹Ÿ‹~ª|Ë$ì­Eü†áȧíRÍ£<Æ=D3ªÛé\­mø‡è#ÂÉâËïròyöaÄ9žKÈ—uSÖ²IûÎ$>L<ß)À¼QY‰ú1¾Whvþ;Æs™5ÇÔ;ýOÿ©yk¸!Y ~WÍs6jNâjübgþsù7ä«C»À99¯çóù]pÿ³Às])pY瑚»?‚sL$¨ÛØo ¯šÚ@~½x¢ö79ñ3™yò³&ÍÝ^„ŸtO¦^î»?çÚÉùe^ O–{}aözêæ¼(É2Å¿¯ßXKÈÃôßN^2¶=,z›||ýYÄU©Íœcù ürÏä?T«~˜(ý[Ž7¸¿ž}èa‰æÁ’Åâ5*¾w`W£1pÌzÞÄ·Ø)ø…COàïÓ‹ð§Ùý–Óñó‰Íà³¶±›±xv7‚§r×2ç˜q¨®[/žoÉ›§Ž¤_¯n#÷—Ýgm9˜%ÿ=ꪹuÄ'åÀÝ¶Ùøë®iš»ZÃ9õ$žýTé¥Ï=ê¯Ø¥è_WXû?Ò¾ö+èWÉ”¢·éßÃní󯑟>‚ºIJs¶ágÉX?"kT¾(yŸ™Þ ©}iìm] yXG™øËúxŸ’;ÙSù†ó÷ÿü.oáþì!ìM¸†÷«N\-ç•÷‘øW}*‡‹'̨xìzôº¸ÞB£öþEÕ'ÿ„¼U× Ís*žÊ½ŽÀŸ„ÿÂÅU'uí=sÎÇNöªž‘¸I{‡7ðýž½ü½5<[ãEnÍêSz^©yñIòmªËGyŽ,QæCáÍðz[¯oG?çgÞGžÄýÏ糩é|ñåÄ¿X+Åãó…x…&’/‹Mïþ±œûiNü£E|¸á‘ü|ÕS╾Lþøgúhzzñ7¸:< ý­ú¯_ým•œ{²œjñ‹ŸpøÃÛè#ð›ÁÙÆvô"õ¤øZ°ÇA훋^£y·´xe_7ä f>¯ò_Þ'd¥5Ù¨ùû •—?L}!•ØûU؇FÍ};«G=®«ÖÜ]²A}Q…Ô:jÁñàÿô)ªìÒþêÑÈ·3‚JT Ïéxëë²w1íE¹UñéiŠ«ÿ&upžs…_"_Ïhί™x:Õ¬¹óCᤏ§òò²~ùÈD3q I{ºâwH^Î7'”œ^—ìžï›Èy7LE_Oâ¿­Ú¯¾?òø–{îù •Ú@þÉÜÀ=–^ƒÜ¦Ÿïøóêµã'Ì‘±í·u—‹ð⽦N¾·'L^Àu¡æ+Æ*oïм¼ø9S¯a'!×ÑóзÐSêŸþ |÷ªžqqºýNô¿v'rQ¡û Ϧþ]¼_Ï _ñ×Zõ³Ç§‹Ÿèäßw¸®~vÁô>G‰cë>'>ëVXÄs4= üw«øu¿â‚ªËn~ü sr ví±^‚vÖ|Î9ä_ËÄnÂ?× WÔ]Ïù•ˆÊ/ñ«ê;ÈuúxñžYÑ«ú/ˆs>Qb»êsê#§óy]ñùu'0Ðó5rš™ªºÀ<ðS‹æv¬Apv¤_{>‡hßL®êviõ«hoÏØáî—„ÌêŸ~™÷(¹‡¾«ÍíUjΪÎE>±ï â±ô àâ>ñµ9„ÏÓgR¯Hž Þqò>±Aà»Þ5ê{›âT‹MÂ/´Øyþñ²F/Ñœá'¼O×Õäkòn¯(´?\ ^ô :?3rå<禣nšóÀAçèW¢{Wyù«Ð8íg|NyƒUܯMq^ÈÂ9úÇaçM?ŠÕÉù¸¶"Ç=÷óóáçðgÖ½Ôå&"=òÃðHމúk|òm#žK€÷k>;pÁ M› É!ع†+è[rZïÜÍsæ =u¯k>øPü‹åÍGÀáÝGðgÁàaëÇÔ*âG>Y8ûvâ¦ÄøƒÚ¸ïºÑäýú*°3©kµ‡òLõW=K¼Qû Ÿý¼èGÙÖjŽÕ$ž…¯Ð·²Zê$1í ‹\£sºL}w߃û“Ámó©Ç5Ÿå‚?.’«>Ê ö¤Ž^ô<Šß­ë<â—ök× †ß*Sˆ_HgÈßÄÓÄöyäËâÊ?¼"¹ÚIÜ–<üÈyÏ~2øð÷ 6D\Äï‘ôÈz­xnµ·,6ZóNçòÜéaäo«µŸã=ðdøñ6Þ~­‰_OÇ&ÿd›¡|B)Ÿëõ¡Çy¿0ü;ú¿ÕmÖ%êÏy:SÈŠ>Û4GqrމÏÙQF§aû­—¿¥ª¨‡Åç*ÎSݽKsÀ%Eôy%|¾ïüií)àÒˆ«OŠÇàPôÍÑ yí Êc”+¿åû"å|~ÿKàÞôûœ“q¸â«S·£ò\ùâký\ó!)Oz öÅmäþüý؇ø¹Âû*ßð5ö)S‹]7IïºëÉÛ§ŽåÒ^8Û Í§üÁsøFa‡Ê7Ô¼!;}­ö²ãû혫+ÌîuZ ¾¾ðB…ü~ªÿjû[s·ñ^ö)Н6c¿Sqðt:¢¹ás„ÿUïLüÅïµ¾¥þãvÓñ4yÊÌ0í±z?øQu«QšÚÀ½&êÑ£Ä,ñ’?Æ9u";q)õô»êËðƒ‹oDî °C¹â¡0×!63~,*žØ¾0þØ3G}/ò¦Ë¨sXz°¿Qå¥cês¼Jøü&î+¸üÖ9†òÿÎ-ôë†Âê›9 ¿º¼Pçs(ñVú*pvÇ)Êã¿H+Ý€†Ö“-{Eþ¶ ü”úHùæ+ð—ïà×ý‡‚“lïÑXw0¸49Yû‡w §ZÅoõƒêâ›\‹i.°zrfsЯV_RìáÍo™?@½#=C{o^d>5ûýâ£]µG¾§TqøÉôɸšðÁ¤üx‚x*o'{$N¦2µ’Úȹ‡T÷ª¸ <_|ù¸•û¶=C_Kò1ÕaøûÒQämüQõé¾¥=“UoÝ®¸åí8†¾ÈRí÷ ??¾ÎüCŸºe9¸ "Þ쥗ÀC]€-. ¿¬zÖØ¥å:¿úÏÈËù/ÇîØÓäG{o _Ù‘àsbw+?r¸æ[ª4Ǹ“<‹­”¾Êl…ý(ìB©öXGMâcø9Š5ç}s)©Šï×snŽqÔßCK‘ßR⿦»5ß§=©ç˜· ½F<änh8›|¨YûéBÊ?OBàæ²Û¨wOÒÞ¶*òN¹kØß×Û sUŠÏbïÌ_VÏ@_«°Ã sˆ»Ní™yKû<‹—{öÅq#ï›nÐÜß;Ä11Õ¿/#ÖŸ•¯8Eü'šG…Gg‰ç­¸?=Œ|h®æ•Â3£^úѳO¼¡ç"×aÔGKŠÀ­ñZÙ¥ÁÜ»³’°ºÀ{>ÍáY¬ÜWâwâáp­ü¡ÄK™÷ðS þµW¼ÙzKBüq¶°öžOî~‹Ïõ÷c·M“Èû%¯v¬GŸ"I}Þ]<âòiåâ?Öþ«5·]ý _„_­{@ûç5O’°a¿|?)/ûrœ— _®ïnì_ËZìQfŒö DóôÓOúྭ&C÷ñäŸCK97KùvûÍÊç¥Ä¿~4v3ðñ\±ö*;ŽW?Üeèc\¼X™kÁYVóª©É⃺œk< žÝ‚GèŸèÍåýmèã*lDóÀŠ5Û½ä{BEàýT˜üD£ƒssî§½zŸ§t½Œ>WawzÑ^Ïà­”ø&²û‰B²Ë¶4ß“R~/¤=]Åið‰µúæ;8×í×ên?îò×g)?ü‰xdþÖ<͇Ø3{ö>pöÒ7I}xOàg]RŠ©¿¨guÞºG´OêMì~ª†±Ý‰Ü»”¯Jÿ‚Z>ŸstiïúÿÂ-ª›hB×}Ü—ëmÍûW!ב ê󮫨¦¾Ôy½x o&ϯirrZõŠìòPÕ›¦ Ï¥òu“ñ£ñÛÁ³áÃÈ;X_ç~ü‹Kk/þ¥÷ô)Ñ+¾¼0÷Sõ'ùø;¼GåÙà§h¹Î}¬ò«FáøÙÈOa;ù×D=GZöýñᯇ4¬!¾°ß.ùB\jißç7ägºýØÅØî¡j%zÖóo{J8f?~>ÿý{Æ~j:Ê™€= =§ûi'¿c?Œ8=~'÷hé"¯·I^&«ŸDø(~)r’§=°¨ø$ñÄ>†ÿ·$žJÎÕR|r6v"3Px>zúÑCêK}zJê Å“káI‡±ïÙzÉ3øáîSÕǶ•8.Q¥zâ×à°p9ñ}¡öMס·Ñ÷k÷榬ª~ñµìLz·`"uߘ‡¸Ã%rÛ_C¾Ñ2 »Ðùœøô¢þ˜Gªþ{âá¤x-=ÚÕ8\sT9²óâ÷[‰üØZ´ç+Â}¨®W‡?×|ÓyÜ—s’ø‡ÎÄž„4÷œY¯9Æ'Åë«y–>ñ׸vaçêÇ’¬rB~%ë7#÷â']Ë%'¿hnîFâ7›QóH§hß{ŸæÔçk¯äÍøQÓxe{‘ÿøÃÊ׌Á§ÏßÊ—LÔœœö-ÄÆûM¿#oÕÛÈ—$G"wÝ=âîRÞöBÍKj^)o&üÒã…gnä^bGò½)åmz/ œ£õ~ìIûæâAÕà%«‹¼Ï2å){àïã3ÿ0Õ¦âÜAò8¡{²< äA ‡°OÁÿŽò+pbfz]·{kŒ>YÏ(üjú&â¼®ÃÐ÷èê—©ÖÜÆHpm­<¸öwÇ¥wÎ4åUñ ìiïÞ?qµø³”oÈ}zÈØe÷çÎxú?ô<ýC\ö?sœúFjTWzX<ò;ˆGìmêkœ N*[/O¼üX½ûśס=¡qõY¹¼Ä -/Œ{Àó¡ƒx_ã¹â‰->pu²“s>)þÕœoâLõß¿¢¾ñš;˜ %~H…À_áŸÀƒ‘£õA÷gùƒ¸ïäAÂÍ%Ø3Ó0ò©»±} ¡râÇ.í;nVÔâþ¶3™·(ïœs³Þïyê”eš[¨<‹¹šþ#4·ý0ߟP[ÿå¼gpñvp>¸,´=i<Ž·Ví?Q}ÓY¤}?‹÷ùEå•C~k¿$¿fÂù»ïUþ¢ý±I?aÇ«è±í-ì‰Mü¸ñ3Äw9’ç ßÂ{ÙŽÃ_Ç' ¯üƒ}m¸½-›ƒ‰jDPu¸x1úÜNž4™ÐÞí{ÀžÇÁ·%á¼ÍOßw˜!ö r›š‚|e&h?t£øaoÆn:'“¯L_ªýáIž3z“ø–öpoÝÇiŸöú&/Âß%’ŠWJÁ·ËßÃ…´Ojù`í­Ø§ziŸö¡µRçˆï!ßw£‡é}š=Hï=”ü…#ª}G_ ?¯ùÆIúÞÈ[íášc›Åç…/=ŸüqÊ"Þ çõçãüÙ¹CóüãÅË£x6ý¡ö´¥ÎöñA£ò%1͵ZïE΢? Ç«¸åUæqÒóÁ¶ÉÈIï/œ³ÁgK„Žj3TPÿOoÂÎ4 g¤OŸ%¾g|K?Gêî³ê&ì‚Sø;9€8ßµ¹Ll¥®W½õQõ¯k®ÈÁîŸ!Ï[Õ…\>CÞÝyÜW‡øŽ¬Iä·F|k)/v(t¿öHõj_ˆêÑîäU̇’)Ÿ‰½ŒÖiŽÙÂy{´Ï¯ñ5p{ªUüÛ±“Á£Ás½?3ºÏ Î?Ï¿7¬'®ZëéoIYTŸ+D/—žÉÞ›àAê7ø”y¬Ž‹‰3ºÏ"~È}ìæm¿¿a°L$ŸV³¿? ?~ ?ì¯& ôpß•ÂG¡øm·êOécUß~¼Ôõ¥ølsT¿Î·Ž/n7ö(–$N+>ì¸ÇgOiè¡<Þ¿ÙW‹g´›¾­¤žÒ½}*y½îöНâìy*¤yò×ŧ~2xШ>øÌAèuo Ú ~§ôê+ÿüð¹¡*ìvqv¾à"å!öˆ/®ZqfxyÑ@v4ý3çêñ+U€(©g¾¨á^æu\G£Í÷Ð_Îóõî ~[¦¼A­ö3&/§%î%Øó¥xcs¹‡®zÎ7pŸêÚw!%7ÿÏ Û éYÄ}‰G¸¿:ø/òr•§þ­ÀQÊã?š›s‰-$®­~¼Ÿ¤ýnô5=\ýn!ñi4ƒC<õÒ˹…VÒÏÖž sçêÒ¸5C>,t)ß›øómðÑ'™kfî(ïnpTïóäÝÜ;‘»ÔÝêOÿM÷?Dsv~ðpUyøÑä2µŠ·÷G;yÇ0ííRŸxf‰æ—³|'kïûSÔ/cèoÀHÈZ¯z­ú½ÂÚKfª¿{<ò×VGX ¾O}H<äïgf&Îs|.ïr‹oêOê}7¨úõáˆ?8y$úÕ˜ÎÙN~Ïü¾úxO nð«2lÄ¿%ßÅþ„×/G®º§bî£/ʾB|•qünâFÎ9<„¾Œ®§À]=êSi¥Ï+ó öT©?¹ÚI>+ìT~ö`pßyG‹¿Ú¢yÜ4·0P<éCÔo6¿R.²À`õ •`7bs³ÌaÚsÑ#ÿz v/éÓ|e%8Æ6š¾ãd œ`Õ¾ªP?ï‘Z ®Iߪ~Ú&æ^Ù½xÄ´HïÿrìøCqÓVðxì"íM¾ \²¡OùAâôÄjì­íEõ1Ž×~“¹×Ä>í½ê'·h'qsDr“ªÅ¯4¶ÑoËs¤Âœ[ýÇê·Ú‰¼ÔŠ×mùlíåþCûR³}r3TÏŠÿ¶XÀI]/óü¶uôI‡WâŸlåÔ?Ã×h×Ú#<ˆïudy‚§È®Í"_‘ “É DÏj{éÛë{ûãûUõnÍG].·¬ù¡ùšC{Lö 9êÉ¥N½Ã’ߪÞR®~Ê~íÍk!®ËG?mæ,òÑÞ¿rüƒ™êo½Py@/úš™ª¾Mñ¬5œ ·mVÿj¹+9\jŸžÿT}uºžó6å‘ï@Í)æcÊ·ªÖJ.ž£|Ò-à‹T—ú_ä|mâßH\ÝÊ9€zµcâ¹Èèsh¸(uƒö@×|Ó×à¡xò› ~Œj®(õœö.íåsbûñ~¶Np²ëñ¢mÒüßfñ[?¯¼Ö2ñŸ¯=òmäój¯‘ÿ;<çÿK<î7coÍ_¢·%‹Àié¯ójìÏCª[?.þÏÑC×Ûà@g'þÌ©øÝºC} K¹ïê›°ç-â‰ÜùŸåÏø•œ·ÿ9ä¯Urï¿Lüj~5@=:oûIýÛȇôV/†÷Óñ¼_sþÙ7<Ó¨8?zç™xIüi[°ËéÁ÷ÍǨ¾ãe«xz¾Ðé•oz’8Ïñ/qYÝò’Κ4rÿ]ÝÚ°yî:ûn_}_‹ßw8Ðz‰êƒÕÿë"ÿ4'Eüàß Î¬nPf”êŒ'‘ǬD7‘'^ÝÑä[gá'}—¢å»ÔDz‰ø/ZÊ=õüHÞaþ‘??ž¸åÿø’§Š¯?ËÿÄ{¥âÄùÑ ˆãzäïÃGkßk•ú;ø·úòÝ=ÜwÏ^äuöåÄuÝ«²ýÉÚ_¤þäØÉàÛ èKüpk™æþ{`ûÚ¬Ô>×jÎ+ñ…öâÌÏujŽwŸë¨ù¿vü§i qwz?êAñÌÄ’¼l§9ws_áèmÑãªo'%ËðÆ0óuÑbî)º^õ¼çT_Óü®/ÿcÚN¼ºûس”úSùî­ÂÛœO¸?Ô]&~»ú·Û¨ wíßõñ ~G§ö4ñ²ÄùXJõüpÏ‘ÉülçT:Ÿù‡ÔÃò7+Ä[òö3“‡ß.ÚK_æìÙs8ÁG±oÕÇurß«}ÝñâåŸ*{hÓ>Å÷´WzñÛ¿þéß_¼¤Ûy÷Lä¼AýIÑwxî®MäY¬k±¥ß×á»î„ÿ.:AûÛ®¦Ï:Ó.?PÊýw¼¦ºÇ3ÈUlö Á/{V©Î¿Yùˆ.æzâÓÀAîÉC¥.æùóÿbþ0y2ù$Û—è­;ž *>>s´Qÿr5gq#Ï¿ìAò]‘«°ƒÕ×a‡j/ÄÏ5¾MEiøßþ2öϦþ„¦3·¦Ãô·àPKzRöˆðRßþ‡÷O<®~Þ:Î'g¬xi—pî‘›”2ñûáƒÐÿÄÚ—#Ú*ñQvD.—ª?¨«[õŸä)âo’·L&ÎðkþÈ©úúbõó¡oî“賨í£î›nó¿Î÷:ÔGmYª½Þvõ±„Áeu7©Ïn~.ü#y‘èùœsêä¡ïüvãðñ¤»É÷Ÿ¾ltzÊÀᆪüªµùO½C?“ëüdædåGˆGëê]íÔ-b3±¯þìÞÙN~Þ¶@s׳Ô/uŸØÉ9šÈ…µO'½VsÃ[Áö1È£ãü}×)صƻÿÆ‘ä âÕÈ_‰xþSNᤠàæ.Í“ÅÅŸo<œóî=½4îRãMÞ;>“x;|”æô‹CËí%‰kŸÅ.õE}ÊÏÇG‹¯ô½,!ï‘Ëí_Ëß7ݪ=šãµ·í&ä+žG„ÿÔ>ƒ•ÔŸâŸ#7¡”ꃔg@œâY„ݨ: ~ëÒ³ð ‰ï±7.ÍýçYé À†ë8·øíàˆÚä ]¡½Wdç4xŽÄiÈwátá»rT§/£ákêåÑBä"²“sjxXu£´‡øMüRճą݅ÈwZx"¼Nõ„Jå\Ú3:œûlÖ=†Uíy¼k÷ã_\âOì"7žNþŒOWìoÞ«÷npuCœ=á|ÎÅßJžpÉ=|~Ô®rˆ—µõYÍMªŽ˜ÿ+ûHÒj®H¼©‡±W=?a§º%?±ÁØ©t+øÖÖL¾*å'Îì®:ßô©jv2¿§O¥–y1›ŸÃ/Å&¨ŸùråiîçW©ÿé$í%1‘‡IìæþÒUªsj%¬}{êÏÆý„´¯)¼V}ZÝÊû­×þ”çÒù„úèO×¼J%xÎr³úùQþÅH’n÷[7 ®ðãµO_Âsv?ÇýÓ¼O¢üÚ¬¹º´O|_/ËŒýYöòÖ^Î,_H¼”÷Μ-þøã‘{óXÍ}mS¿ÃCàâî¿´wìZõy¬ý´ƒÈ»Æ”ϸ‚{Œ Õü×éš3zž÷÷ïÕÞåjps`§æ& xŸÖiÄ™¡¼g÷#¼_<­}€G«>£¼E6NÉØ©gø'coBFñ.T_e#ònÜ‹¼ÇNE?÷¤_Á‹ª«ÿ®þ¹¼OèísÕüYß7’Õ“«ïÆ^gÆ«Nü/òùÈÎ…X·ë‹”w÷'rá—ÔŸx6x=õv§óKä¹ys›éüZüqú c#Á[öu…ø™Øµî œ£1NݲðNê!ÍsgŠ‘óîƒU×9úeõ>ü“ó4ÍëœÎý”%Áɶ Éï:§R7·]])ÚýÙ¢ÞýÞPöçœ>–8'¤<ŠÝ¤<óvì¹­ƒø,~y…Þ°x쇬ª‡ù÷¡wE/R—6o…ß¾ï+ñÑŸ'|ÚÆý…ÿVžg v&²¼PÝN?g`&ßoݼ÷î‡|غÄvu䆕ÇÑÞèðšKÑùE.RÞèTæEbkÀC%)xNâÅ<Ÿÿ^ä51–{©ÛŽw«^ž+^¬óчØPõ»iÞv¬âªt.!ÍÁ­=ÇhžÍ¯=ÖÚ3Vµ‹ø1r»ö~ß­yþωoŸcw2¥ÈyôÍW¾ n)/M·æ?Bƒ°#añ¤Z=ªw GïòíØ=ó¥ø7ÿQ|^Bý\‰zôÔ~šæoF/Ò»Áwþ2õ!ßN~ÅŸ/$OF>jOÇ¥îWŸÛ,íy>œ¾|~£uuïð¡ä)óèHÎÑý©ŸqáLä91CñN·øôËÁ§Á×Ñ;×½âCï|ôíÕs“? Š7,s¤æþxdbgi¿ï×ÂcÚ3]ð|nák´?]|Ñ®<ñklîËÔW2.ñødø3yþ¿¡‚~ÀŽõA*~‹}.~‹SÔ/8õþ<çÿñçôrßñjñ[6PgðíâóRâÙçâŸm_ƒ+sÁ%±cÔß]G\•,ãܪÅÏa^Åœ¡ù✾kÀ›Ö§˜;I|Šˆ yÏCßãëÄ÷¨ý^þB¾?aÔ~Rí2®¦o,õ«æ^¿Õ\E#çÞ={]lW€ üª¤Îf»–ü¦ñöpøï…ÿ)õö&nâyóÏ€Ç-ô›öÐܨý×O¨O¡9N¯×ÞÄÙ|¿éá¦Vñ¨j¾¢ê{êÂþð¥yèmb™äh»öÎýNÖíˆúí¥È£g8ñEDüéáø‘‚¨‹„ò½}ÿ*ïôñ»ÉC½.½½p©¾˜ x½_<ª±&p›M|Üñìg(ƒÎLãyK_S_¥öQÚæ·:”‡‹¬ÀNÄŸEoz•h~±ÿõƒþ¥¹ø ì@4^r‹—Í< ÿÔUªüÝ2æ}–‹/Ì|-v>=‡{ho!Ôóö1À¿×¿£x`*~²Lü?ÖRü‚G}~i/x¦K|ŽÕâIøEy臩Ã&çkŸîÈO¹?_òªøv‹ûlñP>‹þ…~!ɞ<Œ} oX·à÷{ï‡5jÏmàopy*ŒüYoå~’ƒ¸Ÿ‚Møãd½ðö@ò܉Á!¥¹èMùïä_{ö‚§jo$/‘ÞE\’ØŠžÛìè·ã,Í‘íSI‹ö’ÝÏùU¨O%wË®ðcsãÿÇÓ‘!~O«¯)»'! ½Ž+ÄpªpÖvä4qv³ópò¹^Íú{Äg´[ýƒŠGw¿o¾DûIoç^cǪOÝ…½ì>™û OÆNÆ_Åîúwââ‡àÇ»•íˆÿLÇÕs-zÖýï5ã3ö÷¦µïnY+ñ@éø¥t/86}þ³HüÙ™a|oètò±ꋦ'‘çðHíÍ;:ar2qPo ýì 9NН¢÷Zp¥÷&Å‘oç[àÚî™ÈƒãOò%¥væ¥ìýª«ås?~ñ>Å÷r^Á£yŸš>æfúU?ãfüRËל¿ëø\G‚+²öùñâÓí¥î=L¸ù+Íuc‡_¨¯¼Xòt«ôo+x'©ý»Ñnìú2í³¶–*>\Œ¿kz}ˆ_ÏsFÿ7{n¥ï¨ÊÉsÅ“ÐéPWsOñ;ˆû´GÂ?>Ó-ÄíΫ5_q"rà™Eslå=œòÏÇ''»¹Ç‘š·ƹÿî÷·!W®­è]êsͯlDîjÅ“”­÷&åz;Ѱ »”º }3„³ñ;ú“¨}®?+ný‰?ÃÃxÿÐ>ñ²~Oÿ„=~Ê}){M«Wˆ¯jŒðù"âûÀBõ}¶‚¿—ï‘ýß@|L ×a͹Φ|äý“EÊùÕoõ¸/=8ÄÆn¦6€?R^ò”µª{$zðƒ]nÞ'vú¢½šSˆŠw ôõ¹ºµ¿¢ÜO|oYŒ?´&¾ûjðDWL{ÛQÇMÚ‹fw¶NÖ|ÐCÜCaŸïÉò ¦•ÿ·cç\«Ñ§È[ä¡z~4¬øÏ=¿ø€Á{ñGÙâ\ÿ=à‚D ¸&ú»p_ñ`C|¼›ï‰‹ßÂ*úî ïÓv%ú™úDýïAü€MütÕ1ä/sùwóRä;ð%öÅ3=ko\ì0ñX|¯}^Óuþ»8—êYô-¤Ö‚+Ó=ªß®ÂÿGúÐçL=ñCÏçâ#|;ÑüLwr £?® ÄGÎ|í:]}¸Ú—.Àî¶&un/ƒÛüWò9þpGrrÔ÷¸"úý-±\ñ"ìä¹  >åüAû÷ÆaWíjÏ“x²Bg©ÿº}i\«¾„{äúo“‡OVbµüۧسÔœ·Y¼,á|žÃÌùXŒü¼Sóä±Ã˜ãˆFÁ]?dùwù¾àñà´ —¾þø`ôÁu }kýcg“FìC^Wÿ³ïsÁ_aík(»˜þs«ò³Ñ«±»ÅÚëýEó©ÕãºT-ãyûÓÿ >íéÁŽÇÔœìÔÉûÔoï_¼åŸL¿¡åxíêEžzÕç™z=HNÿ¥“8:qv©{€ò-cÅT¡9IâÑþU¹9þðRñçŽÏ‘ܘR~8Ô"þOƒx|Þ'ö×ô­ÀþìMÃO0Äûé¿ =¯|£øÇúŽ Ï·âDüŒm·æ·ð|}ÛxŽî‰ƒ#՚υ½ŒÞÉ÷6¼G^>t9úhßIåÿóìù[ϹÚ¦}IÕÚ×t4x¨ë[Õå|仂q³WP‡oJ]/o<•q¯ìÐHÕI>À^Ömÿ™æïR׊¯ß ùŸ3Ï…ÏÑ1ŸÏé;{µO¯x}N.ïÖžCŸrn%ø0÷Â?·¥ 2¤¯Uœö&çÛT+Ñ]šoæ¼ÚóèoJ Âþ9Šxî¢Nâ]û‘è[¦Yó¸(_šT¿ÈïÄ%±ã„ûìš÷| \TÑÎLwés6b_ÜW«ÿKüKmÚ/æ ‚ÃBsÑ×¾F䦿Qô,Q­ùLx;2B¼K¡Ï¶3Ñ;Ó¯ìK AOmŸ3_`ÑRx¢â·«ÕÏvv" ½?‰Tï>8ËS§~›Kgï—Ö6hS|ßæ3È·†§*8Aù†”æ‚èWÃÝÂQËÄ[ñ®òS3ðékÕ—¥½>Î=Ä]Á³Ä#3sŽxU¸{H߈ÝÃç¤nV_ÖEÚõr½›>ÅàAÊ“k>2³?ç›Ý¯nº\’<\¿¿<­=JVÕ·W‚+z÷מ؛ùwÇ|N¾æ—"ÇRw×õª®¿›ÇñªS¨Ÿ"S©ùß<á¿fþ½ûDì“É*ŽÓÐëŒ‘Ï ^È´«Í®H”‘÷O¸°Sá2ðù(ÎéÜSóþ—`3ÄLjÿä|òBÉô0p6qaüÍ¡ìæÓ6ÍíMߤÞ"È|Ký¡k¯êÊâ_HÝÁýö¢8ëAÎ5ªzV×aÜGý§â½¾N{œ/UŸè[8GsÝߢçþÓ4w(¬T}8- ¹FûñÈAýnò‹ÉQÜS÷õ_©O&«ç9Ïãzw¨ÎëS¿Î7ØWG ûëó}‘.Õí’øÔZòâMžÊ}ößHܸ”ïO=A¥Q¼ûáeG^ßÈ,ùçËÄ{xÓ£|™ý"Í#6«Ÿúmímàþºâôo˜Î¥_üôaÿkãYlpH\×ùqXìDäϾ8 ý˜ú]‡øWò|—ðóÉ™œSÇcàëì^ß®«äW5·ìwâwS/“oïTwòä#µ ;Ìs†6ËomQ=¿Q{.oÅž”Œ;"±ø™ˆÁu½ê™ßñœßò>ÞoÐ;ïhÅfðRüRåYMŠÛ6ðžFõÅ$ç }Û•—-ãsº“Ô3ljwr qd¯ö‚¥Ÿ%¯h½Ÿ Gï»Ñ§ˆösùç(>ÝL¿J|>vÐ>] ž*ogŸQôIí}K¼”ºŒ{t=Ìyö¥¾”úG¼Rãño•ÓÁ‡áG¤nλ{žæoû°“¡-ÔqìjÎI|/þ-òWCÅ#w<þ°äiæœ#§`G-ÕäiCIê+©Ùø/—ø4R«un=ÊsØ9ïÐ}ò³džh¾°\qéCŠÃçßå9Ýš¯ŠÅóò.ù¥ZùÔøí79_ú¶94G<ýAù¥?Wñ<ç~{˜ÈÓÞ–cÕÿTüø­øGóxúüº$’øU¼gS¿¢zÎñÖkŽ/¨zX¯ItÓWÐ} Ï¿¼›¼ˆ}ŽöÌMO¥¾%η~E¿]2Cî+|‘x4Õ†^¤¯Åþ-¡ÎR«ýóS5oû/ÏïBN²ø6v˜ø¤çª´ W3‚8¨ëOä1\«>[íq >¼ÿP¼õö©t#¼©­â'ˆoßWȯµFqÔ:ü‰Mýâ9‘/©zÿÖõ8£Ps* ñ}tCž¢Y^—ÛÔ'ô çgZ_KU©/ãô=¤|I–o4aßæ£ØýähΣöGÕ¯þoBy—øš—OAû§+ß®ü`£æ˜+Nãû+Ï ï4¼\_%žÔÐ ÎÓö«úa&t¤æê§RO½§ýÍê—ÊT“iXÂ÷•hËäÎ}œòV‡"çIÙÁT…öxÕbÇ‚7"?ƒ[ûž&¿ìߊ¶›É“&ïãüRvì[ú*S&>/SBý?ËOÕ½¿Ÿlw¦6*o;“sˆ/³è*â·êçÀ«i_ªüâ·h®{çë9hæl£ðGÑ ø"¦~R|õŸÄ‰ÄÓY~»d½î]Æ÷_C?Š/T)ß_{g³{ˆ yŽåó°ƒùø‘ñE§ÎǾ'ø¹ÈW²¿Ú?[û~ä½ÜUÔµìorî%_o¦ÎW?õ“ª»¢¸ý,Î3¸‡ï÷fxßþ šW«_V”{-<š¼aäâ¿è~Ø¿…Å«ð*þ$éã¾}÷â—Â?¨¾·ûÜY°Þ„ÿô\Î\EððÐyGáÿÃ7kOÉZñ÷|Nîûÿï®Ð­;ðuOhÏÑu™ Ø“dyÀœë¨—X÷?R[TÏÙ)†k¹ç ÕeCGhnôhä½|ç\q¼ú™»¸ÿŒp|ÀÎýU]/¼ô%x õ’æiJð#]ƒ×Ü%Þ(zT9ƒ:aü:úâQÿL¿†>ª`ÖÙÐ?Ú7ö/ùÇoôÙ×i/F'8£ß+þ¹ïÅ+ø»âÁ§çî'ÞGþ%èç~"¿q?Ñ~~ßúâò;å/cø§@T<.‡óù­ëÁ{ö^ኵéâ Ìþàºp1¿Ÿúù¶ d÷…eæñþ1ÕòŸ&ÖØ‰è=˜çêßiúî#VÕª½E?!‰eàÊÒÕ…ñ¼»¸ƒø‘ÓkÉs¸¥Îÿû°ì ~>o'û¼â…Ù=çêøà«>á zó>á€Þê+Þ¤~ç4¿ÎŸ$.Äž-{ ½‹}†½ôˆÏ8dÁ¿y»‰+Üê » ÒðçE¿o¼Lüj÷ò~=aGú¾Ã>ä̸¥W‡]ò;yƾcÈ«¥îRžÍ«yŠ·Á9“µòRÅgíøå¼ô¬p/so=˰7Ýç᧋ޡߨ{0þº\üIø§*Ì~o³übúütl$ñç²ä;r÷µ"†%äA¬ªsS½£¼å)¦.ÿ 97oFÏl—…ê·ò`çµÄçåŠ'ïeNÕ|J’{N¿‚^Ô|‹=ÌÌPýr=ø5pú噋ݩ˜C?DXþ7âsª®±¿êÿBl’æ4ÿÅ9ü}ò2ìu`;yÝôjõ±:´ÏRsÞÍëè§u©î•ŽóMÚÓ;†x P‹~Æ&ãL÷s¹O*ïu(ŸX„Œ¥9œ‘ÔÍä+z òš©ý!uÜà<ô8ú›âÁIšúN{Â÷÷-àycãø÷–Õ««^3LùгƒðDÍËý†]Ž>-ÓGØc?˜úiùƒêËiäþ+–POö·‘?t]¡wsO)Ù¡è§D/"6ìWõàø®9â¿Xû—žÃÎÇU>ixÿÄÞÔÏ…¢ËÃ9[ß%n *Ÿ¹l xÇj”ÿÜù•t`êW?¤=ew ÏÑÏÁ¹]o“oNÖÃSø»‚›¨Cäì`ÿggϳü<î·x"}¥þǵoðMÞ¿Þ ^îc´W J<”rޱÓÕŸ¹=‰ðý]oé÷WÛÖn'Ñ߃¼”|òêãû¿{ª!¾»¸’8-z¾ò˜níx…óL^Êû¥‡€³ÊåÞûó}b·+W éÜSâZñ£>.§÷.=´VcOÓ‰_Gâ'Ë2ÔAükÁ –„?w ¯¥ƒÅ² ½ÿÞ¬}»¸_ó~¯ÿ]õÑL 8L™Ìhìêrñà8?"~Îy’þÞd/z]xõãÞ·µ?ùUí¯9{ž|y¨Ý„ÿO½‚ÿvUIÞŸÃ.Fî¤_#òöñØù|×»ŠŸOßä1bÆž»§c'b7þ?¼ôŸ¨2`Àxƒ¡Ò@=¨LóèFu3ÓLίXx¤úÅ{ê"‹N£Ž[¦¼KÕÌaUíÏù^ò3ÆQÏ,¿“¼yEé%}e7Í64Ù³R¥y¶Šu´Ê×´Ö þßéרðaßkäù*êÑ¿Ò-ôU*ŸT9uWk_hˆ÷X|9zS}8q¤1ÃsV«_¡®ˆyŠÆðçå[É”üÈýV, Uù8òÚøquU!õì ·öešç|ë"CΠؓş£Gu7ñþµËé*^ oUó$ô¯ºžü^µü]ñ4~¶Nýw +ùÞ¥ ?UÚK=÷uê~ÆK¹çš½œ¡‚ý0 ®¤0»·²B¼¬ W‘1}Ã÷5|ŠÞ/Õù•ç’¯2æsÏõCñ¿u;‰‹ÉïUK=©¢X÷ü ò`Rž¢Bó ÅÒÜ?.éÿu‰¡p4¿W£¹¡êáÈCó2üVã ä¢|;úW}}ó-%\˯œÛ’¯à)1ÜÌbÅ™äÊÄDZ¨s®=Ÿ¸ªÁÃçžG ×pß¹÷ÏX´wò;†¥¹ôyUoDnÌšg)Ó¾s³xÆ_ä*ÖcÇjþ@¶Òoß°ùÍ/¦%Öǹ›ÄC_ò ÷“­Täçªâ>kÄ’[Î<ïÂà)4Ü]«ß…},Ö¾éRõyæªhÞEžºöä¦q öé.ä<òlžwÐÞa†ù¹ÏüŸèóÈÕ~§¢2áš:ôÅ<…ûjÚDÿþ’$óß•Ã[S¶ùÎûç®Z„}¯—]5>Aõì›ÖÞ¼­âCU=vôyÏUÿCÅî{òàŦÕÚ·öϻ؀òûKG/ýýÀÿ1تNDÎâ)\:ˆç.Mq.å[°'ÿ’'3_…ß(žÏâÒÍØ¥nüõ’Ékÿâ¹*/Àß,Õ¾æBñû—ï×-ý‰>÷…w ÇFá“öõÅgS¿;³h Ÿo)¹8ßË_«ñî/Gûu̧ò¾¹Wñþãëú&ì£élô×ò¸«é2ä6G{ºŠñ×U꣭܀¿*W£á1âݺùÏ5èg¥æŠZܼOåoØ÷гÉ×-ø›üwùVòfÙÁ<ÍGähÏIºØRñÞ/YažwÃOäçê½èSóؕŠCø¾êlj_?æšÇ²Ç¢~úÒð ?_÷0þƨ=:µkу†iôÝWßÈ\a÷´`yUóOØÕÿUg'Uݾ[D  D¥;ÎôlÏÌ™Îmb‰í…Í©µ°[ °»;1°»[PìÂNÔŸ~¯÷y^¯ßó°;sÎçs÷}Ý×½—î%Þ©Ÿ-Ö=”í)y·×r/ïêþÃ7*N¹˜çO\ s©J¿íìª, /×2Îy?y9N~Æ\ÄCÒ¯Ò{uÞoÕw~¥{ŠÖ ~Lö:Ú-ùà~wÕýy’~ǘ; ¼.=ñî ø:Ý/^—àV’cóe‡U׆= ^)ù÷ÀG”8Bö0@}5zõjÉYòVé›—ÔNÔ½§Ð÷›øÓàùð ﵫg†ÞÔ¿{÷Ð}VÝ¡{ˆý({Wõ”žßU'yõÁK—ž#;o¼¡ùËÌŽz®{œí—ß5w^åwFú%ÉgäKÙ_ßòs«d/¢ËÕoóOûîÐçˆCmO©ÿ»AñWòEý|l?=o '}Ëð<=O*>álÅC±i:¯DAïeå¯%Ë/‡öÔ÷:^T¼’ÙN÷Àÿ»àðÜ/94Ýúwïdù3ó<=—£¨½^ÉçdGìGIŽ‚ègz7ÝWé:GßÉOœõ4øÃàÚÒ9Éeü&}_˜÷Mœ¡89p“ô)¹{ˆýôÝ+ù2÷‘õ¿­?S/HÎke¯ü‡ëójnTþgÜ&8×н¶èÜSßIKíª;yB²ÿŽ˜ž£¦B÷ê„çÌEüå¾Zçæ"nIŽ”ý*£ß«Ï1“>¸˜¿Î`‡ÃÛéÏüÉW•ÖÈï'¯R<çÀÎ'ºe7¿(¿MÄdÇÍYèã6zŸà ÒëiM[ý™ôA#À9ýn—\ÆßRþš®V\Z1Yç’8Azcg6OJèEÝGu•äÏdÿOúåi‰ ôùÕ{’_ÚÉ#©ß„êô~އ•Ù¯Ÿªûyùç’doCɾ…u_©…äÿ‡Ê¯¤¾ý œ#ÿA/"/Ê$˜·¨¯¾€·OþóÈE+þ PŒäaš¯ùuoIæÖƒíòS)ÞKWÉϸ9çü2é«ôûɸ·uúÞ@^÷ÛI÷\TÜbg!lJîã¿H˦J^7¥WfLÏQI½!ð‚ì÷ɯ:wx³âL¯[{û|ÿÈ®…t/‰Ÿõ¹ º¯ÌræážÖý”¿”½"ûfŒªRý£ú ½o¾”’{×%>TžVu™ôª„>KæéM€ü1È{•ñ÷Áçå*nЇРùÇò«ôü™t¡™Ès‹ÎÁõ±¾?A.Y)9Îü$½J^¦x4Íý¿ªÞ`Þ#y×ùE?—þÖuàGÜìŽQ7 ~¡{·? 9ˆª{HXu̇•כㄣ‹";%]A½„üÊ\¢çŸüóju¬Q‚½NÐû”½"¿p)¯nÑÏ'Gë‡ë^4øR?ŸpKî/*.9ºBqH¦JòQI=)s¼KïKÉŽØ™óqÙõyµCÕðvéüªf?êð°\¡çŠ%;àºTö¾f'ìêol±ü•“üļCþ9N=¶QuÛ4uìõ1ÇÑ<ÿÁú}ÿi’ÛÒí¥žrÝwx¼ü€k¸âÕP‡Î9I?«¶KzœBœcW½Á¸Dñª‹|Ô·‡ê<‰¯ôž‚êÁOdïC²ó®Ýu>­ò—å¿¿{ðKŸü›çžE}æqùÅÄA:§ŠŸ—•ÊG2'‘o,¡~G3ð²ò¹DTrž›)½Oº—óC½×Œý>K¬/ûÙˆòyI懃·Rž!yO6*OóQ÷·¿J/;–`ïemHÏçß?T&9.ÝZò™x„<ÿuä8&»aÕRÛÉŸ•mPÜ»Dò˜™¦úŠëeñr†ö—ßwý&¿o£n\ÆÇô)’{Ç©²û¥çêùÏé¹ì-3·’½Jœ¥{Kz¤Ç¥ÔW¢äëò»<ÿ Ÿ]Éåð=ÿнÞAçv,÷xƒ½5È;ê½IÞÂìÁõ½Þ '¦À¦Ã_{õ¾3u©&ÕoìwÉñƒäGªKÕo«zCçR”ßr¾-\Oˆùµ˜]Ÿç­þ–|§|ƽ>ßO}Ê]T|í<@zåTÜšqèýMÎÕsu#ú†úµ7)OóžO¼V/{XµNyV`âqx¶#ûÒ¿9]õNs4ù÷˲«e§æUGMÒOráÇ¢Ô»]Kô=ŽÝ¨³±9}¸ìGETvÆñ·î#iÙMêíñÕÄÃÔ™3KÞl(O ^©ó|+9 ­—]³­óJ<®>Rú{ÉKŒ¸sþü‡Ž?íúwŒÊ3$׋… }-½öþ¨sM/»œ HRùup”â“ð-Š·lê9÷Ë&ëõ=ÎVùK“üÎUBâ*é[iZz\ s‰á¯\^ÅÝŽ”Þ¯ä#ùõÀiªCøÃ’Ëà}ºß”‹¸Ÿ¾fôiÅSf9üœô‹cÄ›É1ªS¸ÿÖÏ›ÜwàyÙ¿ø-Š2stŽÞ{…³3©/‡¶Õ¹&~V:LzV~‹òˆ8þ#UEæSÝoÙî²»éO¤wÞ?e¿‚Õò#¾÷gûéC§Wèóƒ²[F\ù|ÍäÑúþd­âó<ðùô{ÜVž¾€¾ÚÓŠw2èw]TzÐs¾P&ñ¾âTŸ ;õŠô4È}'‰ßÉÕì©çMnP}+yŸêÙ•ÛIÿ½Qé}ƒô-hÊ^ÔmÇ\({FÝØÍÌ_úü ñHèÝ¿—ºLížÄ­çJÊ_’ôâ_mCôsG¡þ¤ÖÒ 1ìûêü\»©ßñËß87êçÝKÿÝWê\k‘>Ûn‘]òÔë\}ôßÓSäì}‹MT\e¾M¿f”ê±Ýd7ªÙs˜Ä~Í»BŸç$ßòÂëí³éžJÞ’œšì‘q¢‡&õ1ûËzÔ]ôÙÎÓ=G©Ç§ŽÇn¼Ä¿“L¿¡zšÕ·©ÂÎùî’IÔË„æHƒôUãÇJNʉ‹§,Yåø7r0\?éþCés}Uÿˆôß[¥,\qaúÕC¢ýúÞ²{TôwHŸãÌõ&ÆÈÞ”u’O‡dBÓeŸ\CtÿV?ÌûˆÎÛö±ò•Ìv:Ÿh›êáÑøË¸äÔ¼Oö+4Nù]àgåáNòÇÈLé½|Öœ 8'öì˜ÿ"W:gù¥êc¥Ø'ê+J^¡ó´}¤:aÍŽzÎøÍÒ“ü$ÞHœ?—xðyGt­Î!C' ?Gé^:—RúsÞ³õÞNî!Ì-ÇÛŠOÓw+µÞ7=Mrg-½KOåDʼn¨¾×¹Y~ËÁþºTPrﺟú^^yDàðØûë’×Ä¡²Çqú‘ êçÊN”[þëVõ…ÜÛá×è—?,ù­kÞ)²“žÞvÚ/Xs¥ðDvòM³Œz ý¤ÀMúœÈj=WêQùøÃð³O0¹#ýºO%7•'ê^ëÆé^âà7…’çÿÿEòËæïÂg$K®¢ ’§²a:/{#åo‚ïy¿'oÿDçåš,?l‡G ¾Xz—(Ñó¤éG”ð¾®ûTßL±ÿ¸n+áx=}’ŸRæÆ“~ɳë3á²Ó¯* °×ÅÑý둚Œá¢ohåÁ&~¨ò}O’øÅ~Ÿâ‡Zð,Áç¾QöÇËÏGÎUbN‘=švìWà5ÙQGùZI@qƒÃ!ÜHh}Oâ/ù%s®ä´¬GupÿdÕ«cÇÈÏ¦Š’³ÈòÓ¥ éÙÌ_T’WP/šñæä#¹TçäCýÔ“ðä‡v—ÜøéËÀg!¹ôÛ姬üËÃ~º$û÷5'VN¼•X­÷Œ8©s­ü¹>Þ.gD®¿'kÔt°ŸïJìÒåúüøíäíŠCçè}Íçä]“ôù¡³”Ϻ‡þ·zidGêé!É9Aþ05 876KïoÇÞ{Rß Æ9yÑ=%™“‹îBŸ|…üŸ‡~E^–Úï…«<æÜÿ§ÔˆwKSÛJž |P ¼!{…£àÑ"§H}ä·Æ­øÙƒ47ÙOçã¯h_ªº™yžòÇÔ':¯`ñ}ÉRò÷à•ÄIðe‡Ž’ÿÍ¥¨S•í(½™;öÒ{_Õjx–1g·5õïeÊæè^l9“#,ùÊÌ—=¸õ{Éyò£ax{Së9Ê©s„;eϦL™Q[i¸ŸÔs˜—KbÑgøHöß}õò'$÷±7ä·*Á˜ÍÒS\–ÿ ý™™¤øÎâ‘M¾®{©yBç‘‚ï:Hjy?8‚0u-;}WOZñv²OyN鲯¥?PO§gö*oª®Ó\]ÍMªß”·Ò¿}ZvÒ¤dúä]ó_ƈ›¢ì±ô„égÞ¬ý–‘iØ¡˜îÛ3D¸ºÀ|ř既· ^®{÷Ü­<0½Eïm¬—Ý n/yJÎÇ·É.$éc™ÍŠOœ{ËÞ&·H¢‹¨C€‡ Ñ¿>lâXW ¼ÕÅÒËÈ(ù³^¿?9'ûPÜW1OuµØtžs®ê?Η©ÿbßüûKoCð :­ºl›úÔéKõ\®½%W6pÕÏèÏ9£•?ÆöEo½z?7{¾cq忉 ôxoÙ3©s³ðâ&}²’oõÜn«>»Eñ…ó)Ńñ_º¾×û:êÁ¥€ý_¼Áž87ûÑBmº·ê…W÷_ ¹Žm+ýœ¨óõ¿¢ç ž ?¨A.ðƒÉû×d®WŸ¦’z®¾àê3ôùVÿËAˤo> ¾® þÙ ªÓD.‘>&×(®ª¼¼Õ¯Š;]õ¾e÷€[yVþ$ Î"v¥©{ó»tß¾±òIúÁ&x¬LLyAœ:’g?}^éûìC?Qö3õ‘Þ7Uüî¼ ¿º9BòRQ®ñkékâ!陃¾IÙ¶:¿ÌHÙÓèþòs^ðUAî-F<hî" ÎĤOlK’g`O}{H¿œ_©ÞàKé}KŽç°Ü üU)âXÏ"pÃÉûíz'ydõŸÒ#?8¾!?XFþ~[yYå­ºßXöj }1êŽ~ð¾¥3”÷šà“÷êsœê¼Cuà/ýèsoð 5Gêû<ð+xv•}so¥÷)g¿|¿â︃8úoɧq/8Ýék]-o™¡ßik¥¿ø¡ž'†½™Mß`nµÎ3¾Vq“§|F­ì·^W?ýú@êxæ4ù“½àIê¹þÕÒ»t¸…?%Ïömôü™]ˆ7© zñW© }~æÂø¿ô ÅMá1ú{ãXõ}Ãó$eØëäk²³Qðê– ü¢sO°¯9}±â ÿ 8æ\çaÇoœÕÍ’?±³÷2ò˜ä"ø…Î1åÑï%Æ¿¶é\œíúyGúÔvp£¥ìé󯑿òN_ó5p'ôñ¢÷"‡Kuîî³ÐÇ‘Ä3ì/uÜE~G]ÎÖÞÑŽš89µRöÁy1u·MŠë*è3?Ð{&Ke·}ês&ûôý‰eúÛ2áÀ½’ó¸úŠoÿšÛ’®ç}¼²3Ž“ÀMDÈOÁóT(5_yîS\Rö¸úü&ó_iŸâMÇÓà™ˆûEåOó?ŸxØ+^7àNXùoøTñªa¿CùrùQªgŽÔ9¤‰àÙm»(þJÑ—ÌÒs8àUIí§ø+z’ꉑrÙ»ÐWØâ‰Ä\ÙãÔhùE¯Uÿ½Jq_Åð3Ü.}ðÞ­¼È••T‚ÛþªzLÊ­s Q¯L] »‘î–=pôé¹ãò÷éït^Aðu™Á_5ª¼[òUŠÿ ϹArœC½…úe˜º™ýkå¿að® ©oîüôgÄ1Ù¹è'ä J_’è}|oð{¿¨ŸP³Lñ_ Übæ%ún[Ë~{n#og/£}µê|ó¦ýkþÚ02«Áÿ€Wn'ÿc/t\OèpÉOêû½þz&þ~©ä=Þ¨8×þ*}»â‚ x¼*ð[¶­”'U¬Vþ[»IúV{¥òŸTDú$ˆå¿„×÷‡Zˆ»Á§WH.¬~ÿxúF7`¯‚Ò§ÉGŠªt®ô-ÿF|}FpAiðC ö™F’ÓØ.ò§>pNþAü+sÜ'›ûÀ}yô÷V¹üê:£õ¹ 'ý§Tg‰¥%‡‘éô®–¼yÁ±¤è¯DŽÓϹæËŽW8¨Ý¯g#Ø+}Ì€‡Kan>rÕÑzn繊GÌge_S;éymûS·"6wT¿§þ¾6#þ&ƒ¹YóÅ­±mèÿþ¦ï«¢ÅŸdlôž‘_K¾'ý¯8@ú——kÂ\ó4üìßáÇÞÓý•});8>-9MÜ,{ã£Nøš¼\{Íîòop:ñod¿MêøÉu’³ÔM²)âqïqÒ÷ý‡ÀËðÅÐGp.Tü’jÖó™OHÃ.ÅõÉ4ø®ge§<ðÇ»è/Íhü¿ÿòËÚMšƒ³_£ø"y1}7öüàâ}¥º¯ ¸x8Úp½ühwéjÉm„ú®­Lv|Ödù¯`ñâHÅ£fœó÷‹ß-q£âæ¸87ù¨ícêÚóeÿâïÈŽ$~“Ýp÷$?ä^©flòûUϫޞ¦s++èùCe§b§á7ž¤ÏP…¾ÐG Â#!½±ú«ž_”7”RGN¿ ÿØtUõғȉúoöÐáSž›|A~:ý¬ìBÔ¦úO~¥àS’‡ÒS¤G6òwó݇'^æjKê<ýé`ïšù .#î£ê%ÿµÃ;oûRÏ5±Ks#~ìšïö랣<ѵ‹ìXä7K†z^Ùcà¹Ø£~jÇÀWžê›#û~F¿ï.·ú´²·®3àqÝQýÄZâ–XNñJà-é™»™~Õ­ú¾4<é¥à죤—™Ó8ÿW¨»)}”ƒßŸ¨øÙu³~¯œø¡¼_ùsÉc¦Wv*ð¨ìVøÙQßgzÿò)ŠÜÔÿ=½z//|FÁ˜{¤ÏæW^iÍKœ/½ß&ûPYÊs‰óÁ§%ÉçìÅ2­9™ý¤¿µiîÒÕÍÜ~ÃdþÆÆÜ˜ýDÅÞ”7F¾w¼ŸäÃ9 óHOž.hžðÁy²«éCTw“'×îC^Ïœ•…»µÁwš`Ÿ†>J‚½ÁqöŒNkнX}ÇÔûà¶’|x¦ÊN…7)~rWÄ¿Å?'ûŸúrRù_ûäܼÒT᦬y,3¬ß²owÆ ÕýÂ;éÞ=zŽP™ü¥A?Òd¾®rˆúK«Î~%xšyØöƤ63ÿ¸­ä¾ê Ùos©önê>C5ÿ‘!>Ž0'\›~$E]4Cü™&/0Á‰•×* n ¾Dž[Fi‚(gš({XÉ>ò4õÓoT"H~nÍÝÚ¯•<Wé>K©+Kñì¡2?‘?w°÷ÂÅÜjM£ÞÇÙÌœí0ñ=d¨'». oÈ[„ùÇúÞÀ¯ŠÓfP—¶3œú@þÀÅ>*ù¸ûðJ{ë¼ÒNù±’wôsñù:¯4çc–37ãTü“º\÷§Ìe:è;×ê}3Ü·÷GÝŸ Þ%Ä>Ss„üGÙ×Èáã’gßíÔwÚe'Ó§HOô¯J°+ˆî; ^0—zÂ;Ìs€“7gëóÒ÷ÉžÔ0§lNxésjÖ|I|²âtçÏÔ¥ÀÔßR“%™u{ê´¶“õ\•ÔµLðlV?1q„üQ9}®rêMñŸ•L?¤ŸÏðœµc5OSY£~qà|æm‚Š—“gëÌ¥äóÏèyƒ‡Ñg_lâCðêG©Ï;ü7s«¨òµšÕâëIn¿põúÁ•ô™Næ|™W4™Gw\#½q3?çaÛŠæàaFødÉWM•ø2O\‰‡z~| }ŽYÊgÜ)ÞOÀûQ¿ ¼%»ä?ú[ö¸Œ9ê>ñ*•ì¬8/pþúæßÕ}ÇštßÉ ŠgCgÊo˜øƒÈ¹²ã©Ïu>Õ#Ù'ÞÜÑßN=ƒžO]¢Jõ\Çpáý3ãÀ o¹OÖûº?п›ûJ?¢;H|³ôó¾Çä_f§þµ‹x5Nß)C?@ߢ Üo€úGйÃè ²[‘ à×/§®ˆ¿)»l߾޽Š%ûJ^=Ä›¥ gÕ%Ôã/Pœ’ XI!Bý³–ü8ý0ó¢óo‡äÏä©üxÅwQž;ð”ð&ü)x­¢!É£íNégpOæÆQ/Þ|Ò;ÌW¤¯®ùÔ¥‰GÍëàC¸Ü~)}xêHãþ¿A(Ãi“Þ™ôÛGèÂÛëÜ;å?Ëö"^$o o#¹¨sˆŸÎ½‡ên¡½È¯ëûíÄŸ“n—qâ]óPÙ…Ø*ÝÿÑo_ðïÿVé£È£ÀÅ™eª'U€sµŸ£s©²goªü„<— Ÿª–äwJ£üns’ô.ž¢ ^ËôýúwßóÌï¯S|”dn'õˆú—¡?$Ç‘ïÔ¿°æ4œwÉUÝLþ’Sÿ$ê–Ê̕ߊÃ'¥þç¡^\@ÿ’þ³º|í‘⣠L%žbNÁ½òVã æ-ÞÔï{–«î‡gÁ}s®àÔÝÛ)Oö\Nœøý‚)²·np,©MzÎÀÔÙ¬:óÕeâÕëŽV<‘¡Ïì?8UöÊq¢p¸æÕ²?qx‚ý‹ä'CŸè9]»+Ÿ2'Ÿ`>4rŸô">5CßÈó‚ìJ”ùþÐŽð¢ì"9ˆÓg°¿yÁ §È•…žTÔó™ê‹Ö‰I=/’|e¬ù˜}®9„D½ Þ SOO‘§ºÏþθ…ù2î+ÍïEs¸î¡úJáUÌ÷™Ì#{FJkCà/™ûJÜ%ûmî‚ܯÉ­†àq‚·w3wæ{KÏ[²xfpöix,»fž¦sKÓgÎìÄœ>ý¤àÉÌá} xÇù¹¾' ¿FôFý™€ÇÁ—U¿Àâ=òÀ¿Rv€ä. ž%Å|Ž~¶p/ø+êàâ@k~ždo\ð”Å+$ÿµ¥ª[ôÓëˆ>–õÌÙ¸þÂ+7 ñIˆ>‘‡z]z!}®5Èqcœº¯çiùÿ*æ­ŽTÞ“z•y7æôRÄM%ð‡™ŸÉþØw‘_tÀ7a®ßó uXú>ž¤ä'Î|¡çG¿¿n¤•>årõI‚×Ó¿§b§~y@ö4Z Î1@ž\”çLbWËÀ]Í!¿µp )æ— æJá«ÚJqGíZñ:¨ÿ'©kWßW1-¡þ!ñÐlÝCÅ6Šgbìí‰À{ãfHä5É—<¯‡½{Ap. æáíÿ€{YË\$|IÑ™“ÀϸmôíOaŽñPæ“à¹ð€+ŒÖƒG£›`>Û3AòWE<.{åýNoƒ§,Èmß à¡^„7Ħ>çá?ÎéoôKê>àÔcBÝpñF§fH>MúîÁµŠ‚WèžÍïäÿc>®Tv"ä‘ý(+Q‡×3=Dç–‚%¹;øô>âêÕÁÝûÄcþS #q­â4ý¼}_ÏxìòtðRà¼MꛎeªÅבç>Dö%õ9x‹S_S¯¯¼»ŒºtÄ¥|'|F'è¾ì á]ðÁÚ‰O‚øÕÀ[œykpó-§ƒ›'ç/aPŽÿ¦Ï+9JrolQücÛOzW™–]õÃkf0:NïSîP=!1Eö.Ä|V9õ®Ð8p‹ùA+¯JÁ_‘a'޳W*¿¯-Çלּ,ö&uDZÒ‹çÅ3“yæ°¼oªÏꇟ+=NþÌdþÞ~óN/Ò·}Fv!r»ìS†¾Mp¹îÑ|ÅÖë¾üàú3Ô¹íÙ¯ÀBüß÷²ñë$ï¥wâG^‘Ÿp= ¯È»²« æÕð·…žUœSB}ÕâÙ °ç­túË{Çö¥^ÏŽ:ÕOð€#­Q|XÆkéxÕ/ÜoË_…î÷q†âr³Cz’&ïL?G_ÿzÙmƒ9ùJæ±=ï$|ÎqÒÇ’™ªÿ¦ÚÈÛv•ýõ¸Oø/ÕùO‡ªd^æ,Ée€¼.ˆJSï> çrŸÁ_ÈCÀ¿»Á]›1J?14J÷áCþWS÷c$NÝ7Q ¿Ñߊ—â;ÏSŸ²ƒ'6é§M¦ÎâgN;?é¤Ó4TÏMâVù¯ðþøW‹¯Ìâ9‹úÓÎzÿ ýÅp£ž#‚ü§ª¨ç[¸úþ[˜§º”Mç›ß/Ý@¹ðof¾à\xáÝ)±ê›=øqxˆ‚{ÂCL]ÝÌ¡G1¯PK˜º‰ œt†x-ô©ü–ÏŠó˜«nÖ=DàƒŽ×ûZ¼%ä·%ØÕðEØÉoÿ8W),ùüeм¼TžÄ$<Ž·u.^æSnðxôŸí?©~j’8ÞÃofîî)åãNx[#Ì¿„+d÷Læ6RìQMŸ%»W(¾¼±ðO8Kr]qŠä¨®I{;ðÀ%údWìä ~ð<~æí+–ª¾fç{3säcæM‘ËxJï3ÿý»?TbÔ,'¸Iö©tñÆ·:º•Â7¹,œògþ*»Ì%÷ø¿mx™[sÏqÿ¿ÖÛq®²úr>ùǺ]„ÇIŸŸÇýÓ— ÀWé³úˆôá’Ä1iòމ—þG³Ÿ‘<»~?ñ }þà:ç®Ê3'†Ÿz|HÕ­Fòjù¡Jâ|Þ©{½Âó?œçÈÜ ¡n’„ÌîÚ?¨÷õ"¯{˜+_)½w3ÇVÚ¢÷ÈOÚ˜ÏÌV>퇽~§òšª8uÒ©ÿ§ˆF ÞÉôÉòï6pý‘±ð²Í'®#7Øû潎yËŸ¨çßL¿“ºq`¶ìO‚ù¼ÐóÒ׊%ªo‡Çn1÷áÌÈÅ™¯õS_)Û ~ß.úëÁ¨óNsŽþÓuÞñ>½_à&ê(ß‘‡VëÃûáß´úRôãáµæ¤!=— ~ÐèsÒ“Ô­ÊÇÂôE+é7‘ßõ«Ä—²cå›ôûnxÚü7J,žÅÐÑÒKkŽÀý xöOô~x•;ëÞMê•ßH_ÏÂëF< Q÷|_rC>ã~ùe?õ½øŠÇүʎ¸üàÊà Ãs&{bþÂG?мFçU×{ZqTŒ½XóÞÒ‘‰N€?ênÕA‚?ë{‚èK?cœ.¹µæ ‚%Êc¢ðR>†—à ?O%x÷ÛÌÿVë=Mk_|½Ø‘ðKðoÜ©ûp®„¯æcéƒÅû\Iÿ4ø4õŸtnU•à·{u.àNÃ÷+¾©ø^ñX\dùq§ÿŽÂ{lQžè`ne1ó(ì劶€Ëæù=àãðŸÙ‚ç^æø…Š¼ØO?{S+áßIQ‡yÞ¨“uÏžsTor]osdøjïKSÛ“ÿï«ç¨'žé`Šø`_ÅóqË\"?›¤NmR }¾–¾T 8Ã0¸ikoe¤…¹Pðåðè¤æPwfïŠ Ÿ(| ÉMò_NbÞùT‹·Ozì~UyC ÞÝ£àûI¯Ô÷Î’~%6£×ïÈ.ÎÓ{èß{àmL¿`wém&_§Ÿg=LþÑõýê .xJŒ:=—>RÏE’ãô­ÊSBgIßʧËî˜×MÃ~½1²{¦£|´’þaå/ðÄÑß1;$'î3õß5Qí«JÀ#`î »ž¤ÿ’€ÿî5É¿5§kñ)ú០Á«?OÌ/Ò›2xðûÂûZfWÞçWŧ•«•„Ø›à†8.ѤÏã°úÇ>üî“ú/ø‘šmÄ3Wò,ø4ìE||š}piò‡ÄÌsR—žÃ¹Ú^K”¾T\£ ÿUþÚŠ—BUäcÔ<ðsà` x‹¢ãuN•â/ú&nê`Ip,æ$œà¯íðÔ{6›ý&yò5à[*Õ'r3?·>‡|ƒ~B9ø‡ÔÛàµá]®Ç7õ—ã÷½çµFr8üðÌ‹$¾%¿Ÿ½t²òMg øWæõÜÌ÷¹è“…軦w£.ä ?ú ¾6øLRVÿ“|&¯@ðQø×Òïy©‡¤Î×ç:˜Ë À^OFš:±sºð@©ßtN¾áÒÇxVyT‚9—staúœeÔ/Jà±Hôg€SKÁ‡ ®mß_ö.<ž|ç%ée}/¥w1ïD?.|¸üc)¼Ðñ² )öM…™Û›R®Ïu¢<«âj½OÚ¹µð‘ñr=æPù³ŠFò¶Ó8¯/ˆk˜W³‘§Íª?Gå(úÌêûÃí’·ü:‰›áŸg¿Fúmê,ð$ÿÖ÷¥‡©þácož¿Uu’âŽ${ÉSôU¼ìsõV³×e³ò§Ì8øJ>R¤ÿ]Å55ô»“M²+^üNà都óSÿ ÖÊE_%ñI½«äÇÂïÂÿB_»œù´™wü½Mß\‡a¾)¿y^ýÓtÜ5¼¢~ü_?o?Lušù·}Á”ÍÏƲ#UçÁómñÂíªÿv[vønæ2á³L<®{0Ãì7ù ÞøVmÔ;ƒÌ±ùÁÙ8á˶3W7ñ¢oå°/ŒŠc¤çÞÃñëìë²U_+O¤y¬Î³. ^êôæUâpò%G*.°üLd•ìŒYÂޣרg»‘/{]s&v¿šþÏ8û%¨«¹ÙOWóÞÄ1—¼û»áß ;îgßF%óÖ>ïöÔÍ·¯Àž’´)y±æšLøð-üŠoPzmŸ*¿g}nt!uxvRô¡SÂû‰¾ûÑ÷ ñrE¥êneô9¼wë¹¼ß+^MŸÈœõ Rð±™;ôyáQÈi“òV7üLîžZésð*ê/ÈUm¹ö÷ùßeÏǯÌu‚«K2WyôôÞÞëø£Œê¤â1ßÙ“8ù[è"êtË8ö%Û®Óù…°§þ—à3£Oë#_Š2÷avêžcß+_‰Àß]s»öü&É#,¿–JËÞ$á}ˆ_é‹UÁ›“~Ÿzâ-²+©é˾®xÖÅ|r \LŠº¦I¿Ãû¾òœD5üÈê¹Kà'©‰êýœo‚ü!póŠð­¥ ê½/RWbÂÓï\¯¾iš¹`ߎôUÿ‘]‰Z{B†ƒ×f¾//¡ß ^æKŒú±üVò0=‡Obäisšü5Lœ|D÷£Þá|_¿‚g"²EïëÍÃ?AÖä¿“–ÝÜKñVœ~—wWÕc+àNÃ7“:RïUNË»¦N“ßpW2GDŸ¢žK;<¥oè½*ÞÇO|dåõ²oÉç$oNêy)ö¾…ÎPü@ÎüôáýàmlKà?ý‰ø˜?KW(¾^ϼ>s úÄqê5â*×·Â FáçM?¸¯’ý7QœW1B~Ý£ós3Wã| p8ïcøiÉk¥Cy€ùš²aª»×,QV1ŒøþÓôíð–°7* ®®”½~îuŠ3Sì‰w‘—ʯY¼›f‹ô,ôªÎÏö¡ÞßO}&ö¬äªlŒò¯Ä>Ê?Ê­Ÿ#·øG"ðîÌJ¼ Ö>sAø±ì•:O«ÿã¼=¥†/ÞÀ ÿ³U5-~¹—Ùww›ì†§Oý™(óŽ#eRäyø”ÜøG[ƒì¿ÞH'óSö”Ÿ=<¬þß¿^ó‘¤Þçd³…¯ißAÅPp!‡‚›R=AþÌâ' 3¯ë|Vq–ë/Õ—jF³—‚øÏ1•ûí#>`O‘}øJò° uüÐÖ|}z_x`©+Ørà À¦‡7–ü?YŸÃùýræÙÒ/Ò¯'J$è§|A?j?ùÝ{s’Ìß™—ó2OhLüïT:,;µôä øÒ9¸àë2ŸgΫf¤ìMÍýš/õu)^Òw,·x¢èïYó<îAùy«/'n é|ãô 3ɱ‹=Eð“*Õp/×yÌ_°¤»÷âÆQ«žø¯¢jÄø=|£~F”}”öIÔ%ÏVÜY _Kx+kòbÕõj>6ÞÐÃK5ý,üèÄWO”½ôÖ>›Š2ÅeàSðwV1Ÿ™ˆ_ÄÎdÀïÖ^¬=á æ ½ÌsÇŸU4±> æ¾SôS_JŸçÿÖ:ÅOl²Ç²Œ¸ßÎÁÉ>Ûkz/ý¯ðv¼Ç Þßü”}%àTü7Pe¥ Vòú¼Kß½èEÍÞškK4ªŽ`¯D9ý¼D‹ìXåBö¡ö*^5È<ð,T€/qPÿ³öišð¼;àÕ)¹CïS³Vû—ç{#Áwegq¹îÝÚÏ–g`¤ó*|âàYRV_a®>Ç»òK¼fˆæS-\zu[öÑZû0¼âNê·¡ÅeUÇÐ?ÞK~Κ#È"ù-cUy®x$ópå} ÌoïH}±â3ÉgGÙ“0v&ò%û5§*αOÑ9ºÈçdçýðì$·Õ^«9#·Õg`~"Æ»|ñуõÞ¾àæîÕýYûàcàSÌž¬ïI3òÒw0Ù'÷äÙZç_B¿ÕvŒâuó ö;¶ÊŸT0÷ƒ÷­Þd?8ˆuÞd§òà©…7~ï\9Ô0¿P¿$Ž9=žkæ„\w‡nT²>ã~ʤï½LöׯŸ9\ö.Â*÷ƒÌñ‘/™«ußeô¿«ñŸ%Ï õ€û Í…º÷*k/}–À²/®0ý¹§˜ÈÂ;}§ì˜oû~™OJ&½ŠÐ× ÃŸìa;@!Ø ÿ6¼Âá•çxÿþ!ÉwðBɵ ïP`3ûºÀéF™ûM±7ÔÎÎ _E­Kñ›:ßLä>ý¼ì‘ž1ÛÑŠÏ_ƒ?½UýJÿϲ+¶«ÕOIsš•é?Iÿ_ÿ5ö€ô"OSpæÄ™çö“O›ì™ªƒOÁ|›øÊÚ‡žÓyU±gÙ$Î °—$E# M9ýÚZöŒúÙi{NúeñàÛØ¿[fí½´ôŒ9á#Û&ÿ÷?#m—¼y¬¸wªæ¯Íéð2ßáÂ?MüÍÿÎC‡úï~ȉ<§û¯¤ßùZ~©ê%åűÛõïé~úØØ“õ2/üAòÖø6̉×÷EwCnÈŸ§}&y3g—ÞÄçãoƒC˜+bŽØÎ!ýøÁÝÙ‡‡? ‚ëwnÑûx˜›,¥¯cÿxt¬â­ õ‘û *à…)»M¸ekŸœܪóÅK¥ä½o™ \VéŸ’ãø ô¼¶{ü?WµÄ(¡î_•ÙJòï†w-À~ˆªM̱ç0J_qî¾ÿ¹ç#3Tv&ù8æ‹ýà$¨Eøþ)uÞýín#0„ý‡G3×Kf€OIX|2ÔQüƒðí&½6Ÿ/[¾öVÕiì£óž"mXû˜O 2ßœÁ?ØàÛ œýx,ÉSJ™'68—Ðà­Ø“c®e28ë#î¯ÿ¯Pi¸±{f—ô*EÞ›€?0ð>¼ä÷ÓAþ½+ÙáA Œ’¼¥”½«¼Ozë½Iþ¢»^}³ì´Åoì}…>4<øiæð¦…Á^ü%9¬Y¤8?¾½â´ÐúFzëå\|õ’×øYÊ3?Û¿QÕíÌÍÃËš`OI铲«ì¿´ÁC˜| ûqÂè›I%=œÝiì{dY ü€‡:W¼Ëæ^²ëUð‹Yïo{Mþ²ò7}nü=òÏ%:÷yÔ?lœ¯½k•ÔW->aøó{0=¿Ê^TìÅžgö7˜ìqñÂVÆü†‡|"añŒ=<0y q¬WvÃñ¡ì®ÅkïgŽ:r‡ê¡“ô<~ò›æ‡Âw«O9:nävÙ“½iøºÃ–þÓßJÂóâGœ„§.žÅÄuä½ìkŒ¿£ºR˜>L ¸°T“╤MreX|ÕOÃ÷ð;óåÌç9˜³I—".Î×Dà‚_‹<ÆÇÉ£¾úïÒF^§ >ö`—dTïª" Âc²Oʼ“=‡°—k"s-ËÕâ_3^u3qûrýÌGޤΞÖi8GË>„ŽÓ9Eám›b¯œ¹LŸ›>Oy’wkå‡úÖ\a ¼ÄŽQª_g.¡O®ÓÜ\襺sѯ¤¯åMøê¦ú§×ÈnùÁµTRï ¼ ÿhgX€ùSGžØ©º·*ö€:Ù»[ò“òB{­úõiâ²ÒMì){IñAœ½.¡fÝo|ýÛ~Þç[öÂݧ~J>e˜ýI.úÒ±{ô÷Éå’_süÙìƒqî¢ø=hú~¿›¹væÎ©>¢îÚ¿}ÔÿL:e¿J¿áÞ‡«î›\¨zÿÄ?{áL³gÀOݧ‚=<棒;k/eú]p¢ã¨ãû4wšœÂž-ú·åìwl–|‡ÇÉo¥ ð}ÍÔ½FÆSg"Ï‹ÿA¿ô~Å‘QxÒðÄšð+x້·+*^Él#ÿc‚/MwÀ£éQ\ºDúÝ|}¼4ý”ÐrøáÉrü þY þÅÚså¤Oü¿¼>js‘â‰@;@ìÛ";Sa—¼%mª+”ŽS?* ß–Y/ûÁ/ØU¿ÎÁœ¥>bžuƒùë<™3ñÇÌ#Õ~Ë>fê^Áµú³ìxæ5™cLsÆ«ìù$® ž!¿z{|WÁ§O?¸ç$s¯æ_ðŸÒó\+<® œ}’ü¸‚úPù¯ÌÁ‚[‰°Ï>‚¿5/“¼Ûn§¾¼Bßy—:?ò^ù“â¬Ò{?̱ðò×ê¼Óà+ÂÔo“Ô5Ãà1ì+à‰Xû™x{ý·P—$~ËL“´±ßhÂaâ£#7»À‡p ÏOþø“>|ü)úƒÆ8æE™ÛI2o囩xËŽ0Nݾž:xz«ÿÂ>—Sõ³÷×»²sI M}'CÿpzêpxÑkŽR¿ ì9x,{q«Î!²øç”wÇoR<~•ùoöI%Ø÷é‡ ° žJpC®ë-ûKß”9º ø­û@Â÷ËÞÙè{Ä?Aøìì_‹GýÖ^¡øºüGék¸Erc¹‹ø×ÚgdÍ_š­úœôlâ!Î1tü3ûÉÏG§Kî}Ì‘Úñ#)êåa‹¯”9”’1ò_‹gû ý\ú{â]æd,|lâaÇä†ÿp2|çI£äË–Ÿ°x Bð™9?—ž¹Ù{…ݼ^´Ù;n· þÏì¶øöOU}×cªïûDr“a–É~ÑSñXŠý Ö^‘g©Ûƒ“q—Å\ìM¸F¸k>Ù€ ì+ÅáIê±ð7îÍÜñmò7nöM&ÎÖyNœ­:DÜdÚÚ‹˜Q>ä†ç6I6ÏP¤žŠØÄþ±ògWø;‚øØŸZ;»| ‘¡Š'Óß2Ç–T=Uñk9õä4¼ÁqöªÅ­y‡u¿á_àçaßEdŸº¼@ ^ô ¸ çHúÌ×ê{Ýðå…Ÿa^'ÀžøtfØ‡Íø±ñ#_V ¼òfc¿}ð«>IßæÙ͹ÚëO<µ\òâ@oʘۋ€c ÖƒGû\õ=7û¤Íƒe§âäÝ æº“Ç§’}7©'Un£x5Ež†Ï7x½ükàÉkp{Oì2½ä ü2¸£$sžæwÌ…yç‡0ŸçÂO%-žæE²Ÿ¶¯Å{á÷éýJ~6Lžf¿Aþ¢tŽôÊs¢ìš ÿ”ø•}Íø³s×V|;]~4ï}³êb^øé<0··‰>|ÐAö¦dËÊ[ÈG¼ðàGÀeÅÁùÇZá +î Ô°‡g4rJ\šf.$²”þñöèÙ ä%/»n0—`6RO7 Ï ²?:ÏL°Jñ„צ¾ÜÄøþÚfg$À¡›Ä}1kNàTê9ìß,¿YÎ\h Þ.“zpxküõ†©ä±CñZmÿñco4‚˨K;éç 'HŸ+Â`àÞ»Yú”¡çð°/Ò€ÉÿPÐ)?XW#þéŒ]õƒè}ðbYuYø·#èUðn}_éJåkeìR¼ð_ö›gî¼ ÞUq†‡½ð¡m$ïUôÁRì/Tñ¾ëáÝ烛sof¾K}¼bˆ9M7sæÝÓÊx¨‡'áŽJ]åý}s!ö[ºØó=»>âQsýÉâŠßÙ?L?Í©û¨£ßîîUZ^ÙÉûÁÇD_‡/ñõù\ðµÚ.fÏžM÷‚~'{ÓÂì;s[¸Õ;¨‡ÂGã‡ÿ,N*Æ\y‰5t€Î³äFöýÁóx™yløU“ô þW§öÊ?ÆoZ{ŸØ#æžÏ¼Cî/E*@ü`þ5 ~'o” _Œ³B}KžBà\ÓÔuì‡ËFŠÂ™ì î,»_Mý-Àþ£ú’dO¤Ïúûï©ûÛ™ç8–sœ_ê£Òo<²!ö‡…ÐÛZx•JÀÛÏgî=añÛí¢¿ÍQ¾¡¯hÍ“&؇Yù{zècÛ^‘½ö]È<õã4ü1 êRÑ«—yÙO‡¿1u>õ¦vôœýØ¡SÀm]!{cÕWRÌÛÄ™ uQþßïYàØ×S7¥Ï]òõê25÷J?¬ý.æ©­þ¹½W—é’g†àùªþ]øÔ2îÿpòùÔ'ôc¨S'Fªn÷-2’•Þ(½*¡žX¨|Ü!ýwøúÌX{g“ä±v‹·~Ã|ãrå(‘ÝMð>æÒ—èeÔÓ§Ëo»¬ýœó™k„ÿÖ‰[{艇Ì·øÙ£”,°'çD=‡§=…ì7§ëó’ï=ô}{öÇD{Á½,; êߣÄmvê\ñW˜¿"ßNÂs6ë3áLæ<*>µöÛZ{Ìô{ÁiÄÑìgN&ù±æŸ’ôâàl“ïë¾JÇ+¾KG¥©Ù©Cx^PŸÒù ußUôÁo÷jñ-‚CŸ÷›ø”“'°<•Ÿ¹Òxœ¹cøf-Ðû•Á;”žMÝåxÅ;~[’}})æQ‚/ÃOfÁûºcp àµÝà®ÒÇ2ÿ`ÍCSŸH0ß4µGuás¼.øn&Ò/e@Æšß‹ÉNì; Ðÿ+ «Îeî¯Á殺2ÿo³öùúÈðÃÁrå©^ð‹‘d—ÂÌVÒ_‰ÑÊ ÏæìÁÿ»ÊuŸ¼Â÷nRò‚v³ÇÜA_5ÉÞ÷oªÙ®d¿={­½3©ï';k»ŠùCöH¸ç°—>…m[á@+‡éïmHïB1âŠ_t(<í÷ÊžùØ_ù%¼_Ìc:èãÇ.dîãxæDVé¿c«Á±ÒÿœqŒä¶‚zªþ“öÚxÁ‰E­}ô3ÊÙ†w0¯uàuÙÿÒmÔ· [õjæ=3;Çv°â¸4ó²'¨kœ/Fœï•9Pv'¹‡ôª \€›z™ýF¡‰:¿’¯Ø7t&|¸ô™f&>K¬/ûù|ánô ¾Eö OmºAùsrªâëÙÈwœ~_äqÝ»—¹þÚÔ+ì;ßoÕgRWJïô‘¢ÜO©Õ_²é¹ ø„Ãð*ù>âóöWüX~:vs(3™§Ÿ ny#¼zìwJ¾¦ü"â`/=ùÀ¬1âÅN=N}”ùÉ$y^¢_y†µ2tó8ì¥ó°Êd¯WÉé‰~`óLý¼“y]|©á¤Î)I<¤.SæÇŸÍ”ˆ'õ¾)øÍíÌ…eØ¿å#>H2oø˜ùö†{àK]ÊþÝ›¨²ßÚÂw˜Ô—£ìÇt± lžæ#Ýɯû¾fß<¬µÌߺØs_ɾJü’~§íJöVÁGWJ"º5xÞ5²cô ~ ú{ñ*–ŒWnüÍ<ëÒÛJøÌÒgJO]Mð(Ó‰!7æoªoxá—’ÈëÞìà_]Ôu‚›÷•_øïÌlò\|<}ò‹¶Jp†Û“Ï%Ù7A<]ÉýÚ±›öW_n¾Òêm´çÀs„â''sú¤æßìZ¬úTà ì#8˜àbæ“èG[}”À^ú½tî#ÂÞ¸ÈròöÑE¨KÇœ’»RxçMkûÅÈÙ$öØ‘›æÒØïâDîýnÉ[Š>r齪·û’Ä#ð¬&¯†O™ø:0nÃv«üz%¼c6æBœ?‡d§‡G'Å^8«>aá\’ìëô³œIÂ?POÞº/}Õ··V‘¯Ø^“Þ¦]?ï†ÿ6HŸ&oTü(Ù÷$ü™¦Å›…â¹TBÿmõý½O1çnËO—›9/ü •ié£Þ:³Ÿ{|Šý²ð¦—3ïcÿ°É>\{ù¿¹êÓy™?*?µó{6žgÎ)ß1ÅHŸJ_€< L’þb‚=Òö!²Û¡kàýw®ôcéÕß4.Ã;vRñÃÃ쬠ncHoý7°×ÕÍüÑmŠëbó¤w|ðS—îÃC|2uÎIðc)x4-^'ñJÚâ¦|ßµò¶8<©µw¿ñÏ##7ü›§IŽýð—ü¢º|ä(xbàïK~(=RßKƒ#‹Gá1[­ó®èa_#ñ¹£ 8+ü¡ü@lwö{‹•Æ^Û­=ŠÔçÜÌ9f¨¿&®F¿Ïží üÉÃ\ò1êáìÁª&4úxÑÓø<âÿÄêÌݘð¯:™ß ±:ÈÜr(‹~£øÒËܧ ¾$“zŠk£ôÈEü^Ñ&x„÷f/¬9~uxEÂmÒÇJúÀNê” òõè\}o%y¶7Á|âaðµ³oÕ{£ôË7^ ®)ÞI<¹‡Þ+°›ä8úv¾Sq~CÅNÊ;#ð[Gágˆb/‚Ö¾ ðÈ.ø;੼¯©ü9´xpî•})³xÒÝÊ3’•ºç zVz< Äù~ö„Y¸¡ìjè@ù9?ûEà¢l샚OœlZ¼íCä'’Ÿ9ÙâÓf¿ÅÝ̧_¦÷ôwÂÓÛ¨¸)oCåù’?¿_òA}ÙâÏ`NÐ=^–ÿRÙ¿ðZx8Î$>‡g‚gŽÑ·Î°Ç$ð’ò!ƒùê &ø‡4}½P;öwŽø öu%ö–ÿL°# Clžä<žÖÆœQìHü û0K¾ žiñðºà䦚a^Àâ§2ᯫ…‡Ò=Qù˜g?õ ÒwâÏØ¯øSþǥųX±H}WHß&މö€eßf 1úŽ~æ*Sà‡ýK~lÔ‹2ÓÁ!ÿ¨x®âÕu3ð Ìà÷Ë~˜^öl ß){¡]IòqæoðHØ×ã¿„úÚQà@™73¬÷[¾þ¤°…³þF~!õ-ó²ÌW§àû <­û˜žúñÉa4ýk·Áï]*ùv€#/eþÕ ~)nWÞ6?ecþ0]£ûJÁåµêSVýú¬Ù#½ö÷{¬ý3ð:§àñ)Í) Àó¼þÇ-Ìi²‡%„Ÿr°g%L?½b­òó€A\NÉâ/OÌ‚'ˆøÇ@§HŸ£Ë~Åß“|ÙjÕ"ðöÅàç Zûæë=ðp„™CL¯x#äÐ=zÞñ}Mœ?y}`Þ)ðžÁ3œ„GÚd~mÜ}âS¨bOhí×ÔéÞï>‡øˆ’Kà×\*¿\sÝÜÿæ» çSÿ¨íqö2¿^Jþ]‡wæhx†âßž?WïâßÓðñFŽÕŸ1æüàÒjÏÔ¾‚ʵŠ?<+¨þ^ú9:Os¡á?™{a[ >š úG™aàN˜Çð­Ñ¹ùéËÙÛœŸ | ^ö—ºé‡†™O+aÃNÁ‰|U¨~¦¹•ä.ñ>û³™—ÇýØGøÐÍ%ßщ²úñMðk^~¬bÞ þÁ <ðöç$&ò½§Ibìõ« ß8¶(ù¶þfÇIŠûRgÈÔп¨~Iübøv\ðÔnî¡Tï#ÿšÔ¿ÎT>¼¾5ø’ó`©w·¥áã¬x}öÚëå/\-Ê‹<ô§#àͧwc+Èî”~O÷.Èóî6üa˜>¨“zïÕ«=ðcŘ0'’DZç,O‚yT}¥rpt®·lwö@‚·O’Ä}ó¬ygäÆ%¼åìÉpƒ« À»¢OYùŽâòØA:o»_ö7ö³ì¼7«{‰PŸ·úúvpáÞ§ô½å¯bWÀƒFÖ©nÜüs»iöàE_g†] ïȾ&üFú~œ¸3Üþ—|9¿@j?@ܼPúm¬b.=ãß$ïµ w»Àw»jÁw™K½œ¸¢*ìµ¹ûG?ÛÏs–¢:j^‹_9vº™ÐÏ¥—ê÷\àeBQųös‡¬½(ìåJ0‡eŸ¾>íÀß±ÿY«²'à!ÔCÁÖviÕ²‹¾%²ç©[-ÞGåK&ý|þÖ÷¡üerŽüŽõßÛrÎÌyÄ!·à6Âð`%ÙŸ¡Ïä§Ïeƒ5½Eï塞mác½ÄøÂâì'5—±ß 9 ðžìYò\éa~$3¾ë³¤ÿ©{Ùׯ_ô*öjÀ÷Z™ÅÞÓ¯K‚Oï­s±SGNeé7ƒ?OÃãeZ¸ òè pCNøSìy ^©Ïq‚O²ÝÏœa”y‡RêÛiöÏÚ±;ÑOÁ‘Ô*N Ã#h²ÂÂO$ß”~$˜›MþªøwymõEâß1GÌgójñ¤Ì¸îß?øe#ˆü8˜³pøÁc±_ÒÍ^ÀÔ ð¡Ã oñ¨„ðÏœªs7-Þ™ße7Ôç+Á/…/’­¼ž¨©ª¸”®`?iŠ}Óe̹¥FÈf°c ìp¾uœ<¨¤(ý*9 Ÿ-½šgÕswaß8†Š%ðŠzÎ |·ÁÍàØÿáÿP~0‚? þúà.ðû²O74_öÌò0<çžÝoÚ8ÿ÷åï–7~Þ öøØoᥞ–>ÞCöçzá ‰&ÿ…7/õ0¸‡G˜‚/ÁY†ý›Ê±´>¯ ¼ªÅ‹8†ýéðÚ8è»–Ð'´öÚ©§.g#8ô8x”ÅW¶ }\pm‹õýðð˧ÄwÔ9G¢ŸÉÜ^Š<'L¼‘ñÁW¹­Î}*8h?û;SÄ)ixâðuUÒ73á)ÏüÁÜvƒâÒÈZÙ—ÈÙzÞ|/qpO>æj¢Ã$_%u¯u»³wy‚νœý~åÇê~¼§²7}ªä§Œ}¾¥ð™&èûšð 'è?Fà´ y‰’vù›äÖŠ\ìÿ <ýÕšc™Ã°ôi•Î÷Èÿ+¯† ç¶ú½*æ üÌÝZüW5‹Ù' _`¢Yñ¡¿yb^¯âò ·~¾ä!xâÁßGÀ©xöP^]Ç\DôNöâ7DZ_üf"Á¼îÕ’(¼ .ø­ù*÷Töà0ß¿UïQÁ¾9—‰×Є?eVúÿô WTqM”:Pò =¯—}ÓUst.ÎÊð–À'ï:JñG‰•Ï×p.Äy©‹un“ý'NÃýûÈášÏsùÎ¥ï|Œü œ¥÷~ùëŠóôßÿÛ·•‡ßÿp½ÔoMæš“ôqýÖ~!ð,>öp¤búþ(ú_ŸLÅžÖýY{_pb[ù7y¨Åû^}x\âçêoÅàuÑ_K®Õ½{™§pÁKØ+ ž6Á?C]÷MŵÖû¹ónq¬Qò¼ìN ¡úœr€¹ˆsCUðêy`ÿì0p^Ô}’qkŠ=¤&ýs;{ULêc^?¸¾jö5„·S=¼ÂâwfÝ{“ì¾I=Ý[Þq+ôqƒâ%uŠªzøNàaôÐOòÀÓzÈ{™×ð3WPÉó¥â–8<¾ñý$óT‹Ñ/ª/:øÞœ†êì†Y ÝMðbmE|~³ô+t~åFxç+(ù-™¡¼²äS½‡ã0ýéZ'úzk¯ìk8v¨_çêÛ¢s.=Gñ]õó{e76L0ÒװצOñ]€~˜¡ìSy÷{ÖR£_»nWžÀÏ•°Ÿ#_大î˜Qk$÷83‹ß§„<,¸FòTsügð¢û±O%¿)N­§ûwÀój’×àÄ{Oƒ„Á ÞÖLs“ÿÕlsášóïÞß8ìQö®P€¿õmÏ!¼ýÍò7&üöòSiæ ÊvPŸÓÚ£ü\v9òvì*p^cÑckûcBÌk$é{9˜»)³â:æ·]àЭù¸š/5/\s–ôܽ“ø‰ìð†™ì=JÙ’ýšó¡ö0›à$½Èn…v†Ëäá’k{ˆ}IðZUϾøáwjøÙÇé<\þ0´€¼>–²GÅÍë>Bì…µm«ø Ž# ßaà;[%ý÷qnü+ùýŸÅ:‡¸©ô’‹ŠFÅíÿ^÷ÿù‡rkÞ^÷_ð³G•:Ù›ïb~ ÞîÀ‹ò)ö¥'^€Ÿp½ôªnø=Õ\ü¬QN_ÕÚÔ‚¯# Þ>Ä~1ó0ò_ð6µìiK€C‰}%¿<{†ž'Ó NçRxW†çœçޱW0ßA%ü~V=;I_Ýa?Û:Åo¾Œîǽüüà+Wƒ7;,öù¨Û•=$ù s/e¿É?¯À<}òIùÍÄÔ{˜Ërô*ž÷Þ¬:vf4ï‡ý [sˆKᳫ¸*†fžÿÆçÄ>€ƒHõ+Îsóò5èžC{éýSàËýì·K×evëþÄ]Ñðw3ÇcÏhн¿!pCAö _b¨‹ÁÙ¤>T±6¡x&È~ô-ŠJWË~GØ»£n‘?á„çqyQ)õð(xÿÍ’ï { Ý'é=ÊØÛYú£üwúKlšÎÁO}8 ÏXÝ|ñD§?e¿y”±TñvÅÒ“ý¤f/<éìïp]-ÿU–³?/Aª„ýUö5ú3”ÑÏY|~p³~xjʈcSÌs¥Á…¹àçqÁÇà§_b'ï©1õ&x¿ þE¯ì§}ÎÓ•/;Á'g3ÌÞêø£à"àƒ¯ùGþÙÿM uëJæ¨ØÕ}ùJ`¬=œU_Wî%ÿTná©;8Ñ·”?DÿÄß\dñ=<æ™1ЇÉžWýãr«ÍüP܈ïåï÷¥µÈMõ’î Ǽ8ư3O›¾Eq_uóó_ßz¬‘bÿKíOÚ˜IþGŸ7BÞSr‘êyÑÉÄUø[·üd„=©K¥§Qx½?ao,<â6øœð_¸ÒbLÙ_¸‘Dµô' n18ù„— ƸLqéΊÿ¢-𖳯±òqåŸaêíΠò™ò¡Ê[ʘW¶}¢s.a¤‡züÿêœûé<\±ß\ê”…Ê;Ý̧dÒùy˜M=.ÐÅÜ/<µ!x3ìØe/}]“úS‚¸´”¼&Hÿ1“Ò¹Ô}ì˜/¦1ùWñggãÿ;åGK¯Ò{$¿‘=ö07îzDý__»ÎÛØJÿ]Êó{¬ùXxðOÃ/D_1@§ü°É¼`?_ ûwáM·€{`®3:صú=§)»-•þfØKeîÀdNÓ ’ñgüOùa'}ó4~1I?1 Ž7x ¸9ú~ÁíØÕ.{dÿP\µ5wfïkj uQøÊ˜»¾È\ósð6$?½–s¯EàMJߤó­mÿ}’{òƒs­>~óšg‡mmøè‡Ùí Ïeí×NR7ñ%½Í4R÷]ÿråÍNâýПðÁ_é;Grè8†:ìwšùæ{g<·²×·Ü ñ˜½=iêéA}~Œù’$ñ[þrl¼ìH’÷Š}ªÏO,Õ9Ùà+(gc:Yòäy;ûçªÓÄæÊ×|5îŸ?a¤î’Ÿw>+;eùñHõXpì>êØ¡™ðo²ï/éÑ¿GßÖ{FááIQw ‘ßµøOÍ1à®àŸ¬ þ DØ_Ä>ÙLî%Ã=€{^ xôŒ¿e·*˜w—HoƒÇ±¿fó3왉LÐOK†Ù‡\#yv1Ïhí7 ^Ïœ?õ¬ ð¦Å{†Ÿ6Ég’ô1ë%>ø4Lâíê3û`K÷,£ ¾\Ç^ä]ÌÙf˜·¶?«Å— ¿‹ëå!Qp9ñƒÀëÞ  ^p'ýÿdQþ>t~‚{HŸ¤¾†·²Œþ×óª7¥Ø»Tz®ì¢›ùàªïä-Vü!Ù øÏ|Žiæ’Ô5ÝÌe:tnó~„/…þD)8k[þ¬>ü ó£vÞÓâ/Œƒ/„3ÌõlÔ=yÕçÖû3ï»PçjíÝ6ÇQ÷HQ§Ìøà¡øYqe˜ú°¿˜„×¹â}ë"Ù÷äW’ÏŠx'œàæ~£ô½:ª}ŽÉÝØ Šü60odñ ¡NÆüM’ósÏ–Ÿ¯ ¿<öÍ ÎÕÇ^àÐÙàÓ?fî…½ÍÕ%¯‰îy¶áyAñ­Ÿy¡òd'LyÌõŠGªÏ»k~äèÔùº×DNò6ñ÷½þÓ£œ¹ç4ó8/XžðJx*ýÇ2ß¿^÷â‡ïµ|u\âî|ÔÞû$ïáð5Çéó’Ø­À2ýií4gKßíÃÕç±Ï*ƒ?ñ·IoåºÇP^v7ôûzáåw°×½‚=Žæ ’¼„nâ8òÌdÙ]8åÄcÊ‹â%Ï:rw—î9Ξ/ÏhÕתMðÆØùèZæhØwšZ/çñÔ Á'ïÀ?ïÕÄÞsÏvKŒÀ¯:¿8uªÚ£àc‚?ÉÏ<¥µß³â 棩¯ÚÚTO3ÐûÄ‘ÿóÿNúe>ö8ÎQ¾ƒ/½’þQâbx–Ø'<•ýÖ~â€ðá’S7óZ!ö£n_¼øÌ±äì{LÀ7ÚsöNFÙŸ|YöcâMŠ?Kàgª?cÕâG¨.áaKâÙÙL9|f«bíŸM~ÃþZòÇ ñ«|´ >;'ü*©?õÞÆÓÊ;ËŸÓù…ïR•¤¿ŸÑjêÏÔ!RV]Þš Ïd_f½¶.ö¬ÕÒ'cïìseÏ+>g=ñ[¥O&¼!åà¬Ã-²†µ÷î<æõvÕ\CõÉðþ¬¾ÃŒ —öòÔÝþÍw¥ÇUðÂ{æ‘7ƒ«¯doMùÞ öõ>‘=LÐçaWºïÌ!ÊcÜìÝ‹±W#r{º¨wzLÅ?ááì›F>ãÉþÚ슷ª]ÌÍlM\ bº•¼ ܾ‹½ 1ö¦.K>›¿”ÈÊßÕÀKø[÷ƒ§(O_° »ä‚_tΞÄîÙz–‘b¾ÀÆ>M7~0°QïçzJöØ;]ýG­ìQˆ½ÎÄ{µ+FTOùñoÃϾíÔíìwc‰³‰} #àÃ|Iòå«x%NË„çÐýºòÆü"eìsŠ\œ×tÙ«)îæ9êî‡Ògª×ý¤Ï^Z<]á;uŽs髞ÿOÛŸd#øON¸ävþ†¾ýë{ÔEý{Ý4áÙƒÛ*ïŒ2om^/»¥Uò)|Qă֞˜$øÃ{C\Ôeì}>òƒÿÖŒ6êvÓç—²ÇÀâykÁ#š¾~˫ٯ}2{Po1|1|iøú#ì,¡¯m‡¯5u.û™3X}°Weo<ü{b´îÉ9þ ø`ƒ À£€ë ü¨øÂÎ<¼k#|䈫^£ÎÉÞ”’±²£UàÿÛÉ¿†Çè÷|·KÞ«ƒªSV²÷/L\íŒÉN¾Çγo²t|ÌíT0ï¢?—Þ|>üýîGÁý}Êžø’œ‡È¹†Jn#ÙͰIýÛÌåà:‡Kžç€“ñY¼Ú_ÓÇe>%öùs¸Ïó²åàDÊv•_©±‰Ç /…w3üÿÛ2ÏÜiàuÙç™UààÕý#9šÈœ¿‡}8qüº=O.š¸?_o|RøTâ>öŸT¼¤m°7ͤŽb/Cšúa”=\6ì„­\%óuâ½ûK xÍíùp½>;Яçô²wÒ¿õKð'aæo¢ì§‰´³ïëcðRGÑ÷a®,€þ™‹ÁeÀ3V»Tòa§Ü(ùË\Àü(<_U+É0oš¬ås.€_ú/ðËäõ“اâÜ ûô§¸%}sÐìpYs÷×3÷!ûSÌKѯ(yŽº¡…;8^ÞÇ/½÷÷U­†WÝ4Í;•qΙmtx¡¢ÌUeˆÏ,ÿçy]÷B£ìŸŠ_oÇpæy Åó–~WþF}€ù–äRÃÑà`üðǯ–¼[ØcòxKx£•äw+¾žvïÿþoµá=]qïúäeðeð‹Ø>“þúÀOÄØc{Iq„Å•„_8Ìû‡vR|hí=´úÕutþvú^‘Ûô½™ƒ²öfeÏ"Ô7Ý~ÙµÐðBÑ/vµËÏEÉ7k·º¯ºòÀÄoךӪ8‹9M‹Þ¬ÌÛ²£Ñoá¹eh<¸ÿ}žH/u´pµú©ÍÊâÔÅôÒÏËÏ:6‘—àç"ì™(ƒ.é¦>ù„¾¿Š¾ª›>ƒÝÚ»Æ=9Ù;[ «êÕ¿Òð‰Mxôÿöb ²ÍÖC†lýÏ¿Gõ°~ë!Û Ùñß?·ZaýŸ•ú‰¡ÖOlÅ?ìT_Ó^sLckÍÒýÄ6ÿýÄ.ÿ}ÆÈ­þÙøßbŽ¿õoÿû­]êþû K–/ËÔ·Mÿ÷c÷ø¿/2dø!‡0²,›Ê~/ðZ±éáoÆiäï¸e̼º/ŒÜçÙÞ1L£¦UJ¶dÍNóOÌ?k´í÷ãº;OiöTñtÀ#ãÒ‘üЈì0Ö¨Þ]Kɧ(ih]vÞÀMÓv4\õöACŸ0–÷’ŒRAî;ðZ|ôËá5Fø,)cókú÷@Us.Ùõà g­øÖè8ëâu/Ü}¢±°_ö=¿[öŸá™?f_ht­£HpýY$HÝ_+ØÍÜÉØõ¾Œ®¥eg¬) έº§zÆáF=äÿÕíúù®3t.+Ž”Pg/:xã>·\oÔÝ¡o¼VNn`)Eþr9ûÜNÛ;³ÃXQ¹8»]éÅFvûSŒCoŸgä›&ŽuÅ£m‘ŠÔK|ø‘-§ש¸¾]ÆràJ9ëå7}¿fàäkŒÜ'úÞÞÓ¤ÄÅãŽýþWoQ†¸²¿=ú×½ÊÜš÷ÿõe!£}‡;æ_vã|£zºî-wõKÞóp£pFtÌþ¯ÿa48t®Ëjåü{Hº‹;ËøÕß©? ó¦CÇVžÔômùèõ!ÃΙe¸ W­_©âAm^rÓwÖ^¯þ|—‘€ì­. psÓÞzßY)}áì'Öî[cÔŽûb`ôê—ŒB•ž¿ Bqºî»pDóÚ£Š»M,çY »ï±ÁÑëi4hn*äˆØ«s/ÿ†-Án£ú0K eK²OÎzÐh®ïÉ2ݘûþ­Fg¯î§ðãawøâ£öE=ò·®{·üQ#·ocõ~OŸdTÿ¢?»öT²‘! ͵ônؼÎ0ZO—üÖÞ=óEû寒st~­?+[ø¤˜'*©É>¬¡ÍÅ,µ*\.}ÈÅ%-ϫؾè~ÉóòKTÄhÝ_ïS?ïÐ žßÏ6§ý¼î;× £ø±~~`ý|ßy_ l<é;£f[-i¿Gz¹ò§¹W/éî½x£Qq¦@“¹ûK>xuÆèX}VÖ5åAcååZ~×½NAHnèñ£ÿYù”±ðOégÛ’ËŠày¾¯gŠmàÉê^Ãu‚ªør9½úÍÒÓº ŒóŠj=O¾å¦1C¯?Î(ü3÷ߣÝÈ'}Ë43óÍU5FÛWrRË\zâXýwìb7Ýs— Ü÷¬ÃȾµÁØ¿êQcÁYrº]=ú¾Î‹Ö¬+Ìø÷ù¾ÐûÌûKÃòM÷¯Î¶EE×<º`ªô¸»(½ÉFu…ukÞqùWFãD}_ûæM™ì£ŒìÎÉ1ÃvÝÚXIzà3ÅqG9æ#Î÷Ç,9~w£áÀüÏU¹ho£Ô*£yÒùFö¨©ÝS¥€Ù{~нdý+69n†ÑýlûºÓž_hO»t݃ßadº\Ô[;ÿзþ2j(~eO—~×gâìî’Üe?š=ü­“ž×X²KðR¬ÑçgÍÛFÿðñiFnð‹ìøJ ÿž4gþíæÖsw`ó·ß—yòÓ; ç%MÓ¤O…î˜ÆÃF[˜"¤qµß)XÊo÷/Ül4] Å? ÊÚÖIï:®h¦û2Ùž¢>gÙ—Ò“âùò7핇n .nøåÞÖù/ŽÊ?¾ÅO½¥{Ü«àhÉÕºßìöúùFž+›—̽›6ì».7Úf”¶~e,ÞãׇÇýõ®Ñ¼ŸìÓ‚ïä7sCew’ßkfx¼x‚ä¨#!¿dø½ð¸ìîòëùþ*v{ýþ2ä²£Uö«øö{ìùFÝEJânÔ2—Þ/tï‹Ð=å§Êî¶ï/¿”=Zöºy7Å=·Ë_6'åoºÎÕŸ…Ïå÷ Gé½[‡¸îš_ß5òóðsÇê}ë{x^–@·ß y*¾ ÿ_·£Èø;vçÜï‘Ü.cyj„âR×ñ:GŸZ÷èÁUFa»gÖmyç6£gý|þHsKîJÌSRÛh¨HšâYóõ?m€ Ûö–]j™{åÆc®­1šÓ}v_¤{ï©Ô{6ÿ*ýo-ùª=@Å»ÞÝþÜ8²ÿ£ºOþ¤ë›6.=+gô=,}è(ê=Û>Ùnôš­îù×®*¾kÜSòRxXç–·?¼×¶c K,³åos«ÝðÂD¿QÌ~8ÿ¥—…ƒu¯õ=K §Êµ›¿~ö1Æ‚ƒÇÿsõWKŒ®nÙÙúËeï|(ik¦ï[ºL~¾ø‚ünÏ’£Áa²SÕ[©É™+Jï²QÉCPzÛó´ì@ÛzÉÝÊñzßì»ò7~Š;Ù*Ù¿ê.ù ‹Ôª³Nò4ðò¬ÿé_,So{P÷PÜKÏ9°Yþ¨wPrÕÛ¤¸¥ë Ho ©9Tv¸ó/5ÅÚ–>:péÚe;+Þ\ø’䨪ظË~-ÆÒyJöWž+¿×üÅÀÞËïÖ=÷¤x¡Æ'»ÝñŠî­o¨þ½¸BñeË8Å#K¾’|fGðïØýv¯>·øƒìZvѦêí^zÝXY¯ûjÇÏù(Jd_Ð9„iùÞW‘·ï1çHÌ«Uôh=\yAÝéOn‰ìϼþXñÚ_?=µ²»='+ßÈÞ®8ÒNÒš«&IáoémíPé}oƒÞ£y‚>w9ÅŽÖÏ¥ÙÍ߯Ýv}ƒÑžÕù5•éß‹I~ljÑ\l‹?|Pñ}îpù—üúü·’ä¥ïHž–ï«8ÖÞª«¸Ò]/¹«›¢"lö\éë¢çd?"í,ì%¿éë“n[¨óî ³ô[Ù•ÖICÆ®»Ñ(8×¾Ö}æüÄÊî÷Þ?fݦ[æ ·ë÷š°£Å[Ïxè¯!F!©xhÅ£²7ÙgÑß9ò…SÎËNYú„1çH%ýãö_;Ðø¹QؼõY÷Ôý›OþõÏãž‹æ&ÏÚÖ—o6šV~VJ“fp”âÁÅõÙ¶NÖ½t“Ôî-y© ›?oh‹Q®»Cþ¥ÂPq¡÷Å+nÔï§°ÃÅAùöU|ØOòÞ»Iö²qWå×…­ªçÿrúHÃøDM¸$ ÞŠ3Š7I.ššõÞ=oëÞ{×éï³ÈîøivÍ;Yù_€ìF}_³OùXj{«Ú/–½]QŠÝ»bÏìèŽF÷ë²—mOIΟ)½ó³¬2ñä޺׺¼Î§á'Ù§ì±ÒH\vµ¡ËüÈÓ2¯õ|k¬¼WyÐl†£•zî¾ç4®Tü?a¦À¹ìäÊu†¿ûö–<õª_ù¹â–âÙ:÷Ü|ÅÃ…«äë·×}¶.?’5eÿªx¤à•ÝYö“ÿÃûÉȽ¬óÈ>¥÷ÌÝ«817TŸŸ½Gu¥IÏÛó²N@Ýo龊OK[ö×9Η^õœ­ÿöjé^!=ídYMÿËú¾$dÇù›õ}­Ã.ߨ}ÄýFÏ/ŠÏr›<{æ,£fªä¬ùÙ³*@^Ë¿”k9³dÝEµ— Ho쯸¸'"¹mÜSqqË®²Û V«ÞRx[ylûÔ1~Wþ7ç‹é³þ¹å߸ë/é[«ôºõ/ÅyŸÞ»0(9­KNsÉ»¿û |RXpù†¿ûûàÝ€Ïë”Íeø6“ì+*Žéú¢ìáTà#—–ßè˜wOæ”cþÍ÷‘}È&»\w¾ìa „ö‡¤§ÍŸ)ÞÈݤ{hi!?nÇ~œ¤ó,ü.û’;BùuçûŠïºÎT\“”]*~+{Ðý³ünýßÊÿ *NxB÷”aùAk§üïòJÝ‹{7±sïèó:½jg[ ò×Öw%Ï=ŸIÞ;®i^*}ëyQq`îÝSá8G $õ #¥_µïèsã^ Þ¸üÀò}Uw*œ#à‡üÞÍSá`ÝwwìÔÀ"åqH^{ÇÉÿy2ôW*?žÝ¬8&ç—œ î®ø¢ò]ŸŠ{)~h9¹¾N籂áïÄ4ƒ].ûÑó½>/¿ù… Ÿ%Ö]‡èüWœ);—{OõšŽU·hùÿYy6#ÝãÓ}.oR}ªp²ì^¡[~¿£Yuüó²Í âÝd§rÄ‹ù»”O •\·×¨þQø[ï»RúêïôßM,I̾,»¸’w_òºÅƒö>®ß[ò-z|¹òGc¸@¹ÉºïâÑ:‡Cuí·).î®’^7¨“ÛAç\¸B~£+§sk?_ñR{‘ef÷{G*þ«Û(ým»MñJn@¿Ì ÿ4’Fó»òK‹Íu8ˆß—þ÷Ÿ.ûØ4JÏU¤¼l!Ë;šY2Ànï?Ò×öûÑÏÙŠ¯Ú/‘œe¯Rü_øFõ‰I?«9ÞV%½Ê@†X¨Q<å-X,[/›©sh.*/¨çµÿ%²€Î œÿkªEhÊÙY Õ¸“ìH¦zaáhÙø?jÆ®“¾7ß$¿Òr±Þ¿ßGœþ–â§}TGÊ~Lׯ÷ZÒ¢ú\CD £\ó…küömÀ$(»^ò\lVÝ«0Az´„:Hñ™åŠûóOH/›~ÑppÛ§’‹Ô%óÖ Tï[¨&YsXç’:OöªîtÉyä:5W|$y®¾RòëyJ¿·ð"½Wúa5³º[õsýWm3úËÜF± ã/:¿¶ÏeGº²ú÷܉òcÝÊoä;Яfՙ沄¤¿T~7s–ìR’ep~êÓÅ*Å…¹ªß´¾,}lý@Ÿ×±AŸoÜ%poóoØ¿'W6î©|²>¥{Èï©8©m¬üÉÊ’Î1ÒûÎåÿ5inZß’]ï¿_zÚ7\r›¿FßÛ°µüªA|Üüœþ»r¹\Χ§YrŸý‡:â ŠcZºÿ¶KÔ·ªÛSõ©–—$¯­/é¹÷&Ÿxøkµô¼îAé×ÒfÙ§b•âúŽfùóÅuOÑÓŸ¶ï.»Õöƒü^ažþ´Ñ¿ÊÝ&¿°¬–{íT|QÃ’¥îVúRÕ«Œ)âjþéM÷]zÞFÀ|i½_¾‰zÎaÔë”W-œ%y^Ñ);V¬–ÿ*&tÏ>}^ÏfÅkµ_ÐÚEú”€„ ¸§üvõDÙÏzȽZz¾ÆwÏ÷¦ˆ“O–^ô-Ö{—É~çn“/;[¿_©÷/ÌÔs%!wÍý¬ø¨­Tvª£ÿp«î­—œ´÷K. Ó%_ÅŠ#‹·+îXrºêue² ­çêþz~Ð=4= û+C?æÅ™=vêÕ&C0·Œ—ü4o¢ÎÉÒáüŸz?Ó®ü¤qžÎ£åÅ-M$}g*>^¾…¸v£ôhrÂBFþÖ\)ûà;d7Z~Öy-ŒÑŸ¼‚zãyŠ{Úß—_ËÏÒ9å«ÿW ùTïQèÿHŹÕÙåþÎZ~ÛY÷\} ýÁnÉÑ‚ãÉ/åÏò/*^ÊðMöFÙç®#¶<¦çl8Bõ O‹†£Ú;ôBÖÑõ•ì䲬ô­a•äª °ÛŒ“£Žyf³Q}õ¯GUçl_ï7ð¢~>3KàÕîgäg{_•°@.íwë}Ηý^z˜ú•½€¦[¨GäŸr—(ÏË¿*yŠ=/ÐDî9Å~È•ëÚµAà›ì"Éo˾’ÏØ-ßÉNöV¾Øõ5úêVþÐò2uœÃ‰¿ŸÖß/£>GÇß²wæéI6%½w~¤¡­âi²ëñ.Õíš?•þ.éºHö­íÉaöDÙ«N²|¢âÏ%%ªÏVLP¾iŒ“ÿXvî«óP½Gîjå;Íè÷VPç:\òÚVà´öäÇ“´¾§÷h˯/úDúTÏ2©žËoôŸ1?»û†7Á­¥×¹›å§†ª^Þ•~6)ŸìþQò}ˆzûòùÌÆo1òÇéù—^$9ë¼\ñS¾\úçlÙ´ìù€A_9G½¡T}Ë¢[zãcYr9$®FR}óv‡î·e­ìs—_÷X,ºÖÎØ§ÜXÈ2Õ®ãõ÷m#t¹ ¥w¾Cä·Ûüø…?Yà°âO€y/ø¹0^òÖ}·ôhà$úPG¨îTøJçYxSqÝÒ»”‡çNPüÚÙhÝlåÑM;Ènvœ«sqãš2ªK$îî|–÷:¯>óán‡µo(ŸÈ¿"û\¸@~/?oÕü/þø7ÛUñÞ@BÏ™½Sv83 ²€ü4}þtÈ Ë.§¶¾ xƒî¹,¬a<“!Ǧëé÷ß?x>L}¼ã¤g‰WÕé< 7á¶Wÿ7»¯ðÕ©Ø7¹4Ñ?ª.Q²°YŸ×ö©ê+õ;QרSÝrþ¾û_h›yœQÄ~LÛüßñ`´|¤¸¬u#öùÙ•ÖÝåWjŽ•}+xT?Oø7f²7žÙÏÂ6Ê{eW[ý²ßÙgôý}KÚΔݩÞIõƒì²›ù-òk V gвƒêFM“å·QífH <þ»‚sýXò[¥{_±¯ä·p¢âŠ•ç©˜}Bï?°~ö`Ù«*†Sêj„‡ÉnRžÒÿ»òà≲¿…±ºŸ‰‡jȺã@Ù—ÖóåÇÝëdoëžAϧuoœ=oµÑ_¡|¢·^vnÙîįsõ|áúÅËÕk]@Þÿ¹ð'-òËËg-_'½XÀÒ¶–ëä?Ú®•þdC¾ÿÐ9åŸÖy´TIÎûÎÕ=õ—ê=}7ø~ˆ/âµÎ?uÞ3¦ Þ;Fò•›H|ø½îyéKôI•Z‘Ð}-h•î/û›ÿG¶ù‰Wþ=+c)Êä+F]1û޾´úˆÝÊ‹ZYþXó¹üÎÂ¬â”Ø-êsv,{’›¥:Co­~®µ]v£0Kq}®CñIËÕ²×m‡È¿åŸÑ9Ö¨^ïch´ïv=gÃ:ú¹SÔû¾pù}_áÙñŽ‹‰{Ç)nê™LðB=óûª{ L’ŸX‘T½¯ó{Égq™ìIã€Î/ʲû¯ä¤íüÙjÅÉ‹GÊÏÕü%üȼíÿûŸÑt­î¹ýJ⥰òœÂài†+o*†eß‹o*¿ï™­÷n¬ÕÏÏfH©£Av°0_}˜ú¥ó¶kN¹ËWeKäGú>—ÉPW1ñR’ëeŸ+¾m:Ýv’Ïä_mO*>+têÞжܩþL݃²{…ËäGr'éÏ–ä-£ï?Þð5ësÞ(ðeóµòQÈF¿­¿/Ja•ä5™n{%yßHù¯•7(ïÎçì¹I÷ÛÒJ–µ¯x§á3ÉËÄä²AéeÇ#’7c¥ê½ƒãeç¯S!(œº$k:ĨïTœÛ|§~p_Ý{[¥äfáÞz¯¶¤¹NìÔl÷‚Mª#nÏ6[ñSã÷ÂÛµ,Rý®ëxý™*= ¾¬ç«¢ßZ<^ùfËWÒ÷nÀê¹6ôn˜â6ƒáܾrùÝŠMêÔmV¾RtÊöÍ‘ÜTß®þöôIË® z²FóéýB'z{™p‡‰“5ÌV¦ç³ô0ÿ$}¬¿ôÅí×Ë_ä&+í8Rõ¢âêC<¬<®|Ó`Xþ¤íRÙ£ZHzgПœ§óíÙQúÜBÝ¡óyåUíce_š·Ñ÷»_R¿néÑäK,Oì;Tq÷4HÞW> ~nºâð¶ò7ñ„î«gºÞ³x¼ìD}DÏÕr ¸Ä‡U¿î:PòØ:Yz‘G| pñVùç• MübgÅëÿæÊ'Bo d=pý@¯âê%ß_»YïÑsõû¯Õ¯øNõèÜŽ’÷"ò] _ÅΪӴϒ¯P^¸äiÙËì7ØéfÅ;í¯Ê.¶lFO*ÀßÚÞ}ý¹?ùï®3è³Þ¤{Lïª8qùƒàón|ÖGeòw‚»:Fòî¿]¸µÐÉOÓ‡ŠCTïrRGië¹^ ¾x‚â€þ+u/Ù«e—ŠÓïÌ~Lx®šk¤ NÒù,Y¤çÊ…Õ¿/\ΩC÷]wâ­þ/õ¾½oëý„Ô×YÀKËý’ãöäŸÝ·¨®U¸TòYѯ!íëdÇêTÜÐÍ=eCúsùyº÷ðDå/…Ÿ%·þwúo¦—ߨ®!ÏüZzØ3_÷º¢TrÞó‘î­8 |(;Nõ§v¸÷vé]÷DÕ•:/Qý½x¢â©öãewz¿‘¿KAÊ`I˜÷Bá“êÞÔ9¶ß'¼IoxÖ«„ËžúÊ?/¿÷¦‘{EuŠú•w„XÙö‡î¿÷7ù›–gõÞý7V½O¾bdû_µž§¸iÅv’‡âKرyÊ+–ü!¹+ž£ü z‘ôÁØW$˜ o±\æ:†7O“ÿèY.?ع‡ä´ida[ §8pùÞ¶êµ Ÿ/œ$¸è*ùãeO(?êJ^ ·H/Úg¨ž›Ý\ö³²Õà†›Ž¦.0O÷Ûñ±üGvyÀýwçkÔ…WŸuáPõJYjg¸dÙ,ÕÁŒó_Wý$ÒƒÜBúmËeŸšXÊÔ°JòÐwšúHIp!½éþ«w¾0R¸ŠÂÞª›öœ ¾o'ÙýÅúHvÝWßkÒçÎbÉ{Ïöò³ý·)Þ(fžV5îTáÛŠ~Ýc—Ùj›Ÿþkñ éIóߺ¯œ]ñì‚çé/Íâ÷úþ¾Ó%_KoÒ{çN‘^嶦®Z·ÉžXùd³MçÓu¬î½ïzéqÉf욯û+zåï ”¯¸Yz³èCþý`é[û(òcÈVž-»ÛGý¤wµô¨g®¾·ñ-½ßB¯~¯Sž\1YÃ?¹=ew ?©îÜ5Tñ[ÝZâ—5² ï«ÞUØ]qõ‚wdorÏЗyWqJîisš¥¢+XF˜{FõÔ¶ëu^…ïu~íe²ãùWõ9Ù[¥ïEüK Ã÷ÈZòÇè¾³}OçÃêë´ÏÔç¤Xò^ÿ§ìvËþà NÕ}×¾ óig™sþFò¬{U¿·_®{iÊ+OìÔù$æCnÊPoû>ÂC&gkxµpµò°º_T×^qˆúˆµÄIݨ~°üIåŸËîÔž§{,L’=ï[-¹óÍBΑš=ŒºÙáŠOƒ?¨ŽÞû¾~?[­:cÓ=çbHVš·W¼Ó±<}Nöµm…ìÂÊfò¥U¯.lÔ÷-ÿDùTËÙª ´OR¾Øã–¿è/•]ë~[qw#Ë>úÝògÅ[”ç5S-žL¿9%?Ø~”Î¥õðΗ÷üÀ=±ä£ß-»gïT=k¤Ëôï›”§f¨?=›aúæóU®‡÷÷Cvi~'¿Ù¹N÷TÎ*·½â×ìéÊw J_ÎÄþÍN®X.¹iYÈÀõª«æûeçÑŸõû©îV?EùCKHùJëòãµ µwS‡o]ŸÓ{!þþúöƒê“GW1„ Vãéwá\Ù—ÔÕJï;:ïÕ²÷Ñ×…#É®h-ý›óu_…»•/%‘«ì Õ׺ÀÓuwë¼²<ß‚vò»«™'ÿ¹â$æªÊô^ç_çò™üNâDÅs-/É~õ?Þä#sãyª7ô¿®¼©ùLäê6ÕÚVIž–¼'?’»AçZ`H¹ÿpý^5KŽ¥ŸÑý§Ë_®øTòÝ|²ô³ RõæK¤Ÿ…+T_ÏÒÿ©;“ù³o%—½êÏüÖzŽZú¡ƒÊ‡Š%ô3×È®æ6IÏÚþÐù5~.¹è¼VßÓ5Sv<6\dÙëô¾KÚUÏ™t †Ê[oÓùš :•‡ßÒ{÷Ôó.a)Z[¯ô·á:Ùíù‡˜¿¾ðöÞFöyÙóìq:ÿÅûùM²³×äúå—zïѹåìê³×}¡ø´÷búj>ò‚½å,ûØT«>Röì|sIgª.VX©úFõÙò;Õ_'ïÞ…ùŽ^æé¬¹¿™zŽt•òžâ…ò¿ÖPjq;k¡[ö"7Rý·vÅ]­¿KÿóctÎ!ÈreÔ•ZïU¿§ø ÷(yËfð^ÉÔ­÷˜uõ†õÔS_Uü\øAñO›Cú3>¡|0—%ϤïÕãažä;½WsjK端Øt°ä©ö3ùú!:‡GñZ78¢Å#¥_Eì×°ޣÞ#[§¼vqLùJáÙÏ<$MCe·ºFÊŽ÷Ë)ÆôùK?WžP]'?»òÉIÇÌÝ)ÿ°|+=G÷UŠçŠ×*ìgžbžÎoe»Î·Ž¥>Å¿;(¯•è9šOÔ~¯>Ãࡲ›Ýk$o=¯‡_Å|ÁxÝËʽ”_ î+Vîpðw‚Ku#_Ðw¯¹SuÌþ7éã\‚<î&=èý ÜÑbùíÜ>êô·Iî–\©úÞbÈŽœØí¥wÉ¿¯¨×sõ>¡ßテ<ðféeû^Øg–ãY}±Ž}e—ÏV<ÑW ®âò¼éë/—|?aþíSìèz¿Î÷G÷/–Ýž³TøÏš•º·ü7à6öÕ}æ&+?YÊügötõ Þ–½µ§u¥•ÇÖÏ”¿oËêýŠôiê8—®O‰ûcØÙñ’ú•?žSžT¸¸Å¾Do}øepÑÙƒ¥_íGÊN´—)//Ó4Tzc|¨>QÏ6ŠgÌOô<éª×JÚfËuìñoÅÆý¶“ÿ­{VyiC}½â•à /Ð÷-{ùÑìM#JŒ®UÊGª·ïœO3±@õߎ-ºß¥ûPsi¿UqT ¤œíK®WÉ.tmîc²â‘ü¹úÜl÷øKçV[£úNnp4Ùͪ÷_‘]̦éß(-‘~ØoÒüyöfÅ5MiÙÏ®¹ªÃçéÏæÀØðÌM´ì¤snüSu¥âI²oሞ+ÿóßêü»ÿÐy/¹]K'Ã߉Üaä~–we_SÄ ‹±cd§kVKßêNŽ0÷yÃ|ÝSÇÂYX‘ A‚Ʋƒîgd·²²çeÌÁ´Ðÿž k8‰™«µÄ¸; ¸¦m+ù¹Ôòç=kåÿÒUÏ®{AybÏ^²?¹­È'wG§É,ØL};¬¸¨~uÃñÊ£êfJ¾JXR€w6J/ºQ܇Ô7[­úcÃ#ú¾äo+¿‘F©²àéS«WzÛP¦sì¹Tu¢2–ÛÇöP=tà*ùÁ¶ ì]ßöª·.¬”Ý+­†Ìž¹ˆØ{ª¯¶3ïžÚ¢ÿ.M]ýÉ]u¸õ‡ÜZýÙn©¹kÿHörùzŽz—ütÇ­ÒÇúë5—_#=X§ø+· yÄæx‡Ëtœ~Ú+;Þ;™xx¨ìJã&ùÏb›Î%ùð¬–ÃÞºõý”Ñ4Eö¦8]~gàæ€/Ôû¶Ø”‡µÖ*ß6YÒQìW]ÔZÆ[}yÏÝøëûu|¥ç.?Oøá\Fçb-%ï…|ÌÃrÁ%ŸHNzÎR}¦·[qQç8õÝZŽ×ó `GŠƒ‹ãð#Ä9­ô2¥t¿©{(¶ëÜ –÷Ô<¥ûÌ­µôZv¼ÍÐ}.ÝÞðœ™UŠ÷[P½¡°Fuñº4'™_)ûÛ¾\ÏÙ5V~¢ýsí/êwæ—Hnú.¢Nµ£Î©ð»ô¥8¨?[Lù¹–RÝ{ë_ú¼Âcºç)‹47bõ=*šöÌ–\äo£OÔÁüÈÝŠ;¢úüÚs¤_Ž×„ß^lhn¹°\vjåu’«ðǪ›.}YqSî õWŒ•þ4?£~¬ÜíÊgdïó9ÙÅ^+Ÿ€à½OèN–í²l§ýFø:>fÞ²GrÕó§ê5oEr•ÛKþª¿A~gñkÌS=«8$5^v%°‡È¿jo¦Ît)þ;d{¾úMí§Ë?žV>=°Lz‘¬•ýÉ%ô^ʼnz¯ÂzþU²7uk%O »Én/Y'}®?Jþ.·D÷wÔô“âãÂ¾Š {áãèÎKý—ë÷³›„OoÛB=ó5ÝOõýÒë·ê O«ž—]£¼'{ˆô´ã{åUõÔ;÷ÔsÄöV^Øwù½]–1¿š?V}…Âxù¯•vå3ž/”‡åfQ»AïݱDúZX¡ŸÖI_Z®eIÎjá‹ u®Kî¼µœ¢xÈ¿oIÈ®F1Gy·ðTÎT·¯¦NQ8…¹Êõ4¥ÿ*Éaï%ÜO‘åÜÿ‡wѹ÷=¥¼¾ÁšÙIö͹‹È¼zYrºâ~ù›¶‹”¯ŠÃÚ¾kž è0½_áhÉkÃC²Æ"ejžH}¨W~«ù;ò g‡vÎe>í>Í“÷ß ÷(Ðç+€7^8CuˆìZ=ßÀ6ô…ƃ+ž!ù鮸³ŒåZKËõ{½Ãe/=¯ªZ˜HÞäÔ9wŸ¬ü7º»HÓúfésÂ3§ùÈãU~Ôù+ó_'êœ{‡Ê~çFÀ·Uœ?û'‘z¶ý¤{ -’ÅóÓ1Tþ¢5'ý÷«8 ešâ˾ýýЇÀë@æß°^v¯n’êºK!YË6«ÎUÃÒõºéú³«KòX6F¼¡#¯-ü€þõ‘²Ûí·1÷Á2é?Õ7Ͼ¥ûË•=jDqJ{…üFçÝGù2ÅöE h¡û©ý˜zå,Ù“î üÚ²Qð(8§õ×+>øFŸ»|Gõ ŽþHË^«?—½+óÄ»‚Û]úš»[r|]òÞ|ªìÃ@\òÙGg`'éAßUºÏ²35ÄïoÈÎv,’jÄ5ÿ¡ú|óXÙ½ÜÇò‰V}Nä0ìÀiª?UߤsKCâÝr¨ô.[”ëHë–¼'ùXø¡ò¶¦ë‡.¾XuëÂjÅ—ÙñÄÍ×éy«¯c¹åÏú½ÂYÊ‹‹ÓèKœ"9í™.9‹ÇäsÊ“Z™ëèî“|4í¯>mÏ!Š£Z×Y¸!É÷‚mU§ð¾£8q)ýôâaäáIðøÇ0'™pÝ»:wóýü’Ý„¸R~=Z"<²½^¸Ó:æG‹§àÇ©«7=­ß똩|87Oý•Y'÷`iî©gÅ©}[Ëÿ6üNa¹ä43IùQÿ¥à‚òëÏ˯.ÿVršý]~$»\~±­HýŠåP½WëyúþÐ}U“ÇÖ$9¬ßƒù¤¡’ƒØµÂù7ÿïÈò„—T×ÍÍ¢oöìR—WŸÛö¶Î¯íÅÍÙˆÎ{éçú³ûnêÊ+åOZ!î[*üFG‡Î£§RñEõ\á0sµê ÇÈ6í¡zvËrv°ìyÅ“â?è…Ÿ§ðšÎ%QûêW-´üYdwÙ©£dÿ¨¸¶X¢¸)¿Vv´% sò±L£í^Å»…s©Çѽw*¹Îß'y˜W½ w4uÈe;âðû¼ d÷‡z¯¥ô}{Áß͇„Úû‡î«0¨þyÖÐût¿¥y†•ó™|Pñ΂Eº·öýT§ ô«ïß8E~gå\ÝgëzÙ]÷ÖàfNP|Õ¶^ßÛ}ê=Q–Ôõçõþí§ê{sn~îJpíºÇŽý¥WÝÿп<•¹ýJåI]KíR=¯óLÙ‘ÆáÂIt>ïØxñU˜Ø×ÞSe÷{™‹NòÜùMŠ›“ð¯u¾¥xaÙ#ºÏeàŽò_Èþg·Hjá}j»P÷Ùr0ùPZõž%§Ò§.»00ž¤sÀ<£:eß'zÞÂK:—E,¿hÚ_zRxJùF~ºì˜¾”ì­’ÓK` _Ëß/€¤}éVÂWä™[(«x¿½œù“ÉÌ#DÈ›Jõ| ûÈ/eT?Èý ¹¡:rßKÔ{·RžßîÔç ”*®Í5SW ÉÎVЯÊm­þÏÀ?Š{úOü0øììaÊï–ÕÉ¿­¸žÝ'Ž>sÉ€Ñö¾úë+vÃߔȮ­ÈËÿÎe©ô²#åOò½øë”,Y#»ÜÚNøq–C»¸Ù—IzN“F ¹n!+ܨûËŽ”¿«k—ôAF\O¾õÅsÇ §ß{%¸Ú{8ú„©:ÍÓ4œ¯:†=¡9…¶5Š;}ŸJ.—ÕËÏvÍÔý„çj¦ãÕ3.—9J÷Ñ >£%'»³èJåųuîËöV<9“½oÍ©~»b‹ä±ŸyÝþCáQ|RuÅâõÌ+Ü-¿6÷Àßÿ ´¢Sïš§:AÝ"åám÷ƒOþNþ)wâ9ËAÛVÜWó§â°¶ÉgÏSÌ‹Ÿ ¯RR~=Û¦÷Zñƒìdn'æË‚ªƒvý©ó‰YËE_ø²¤Ûð9qpx‡+ŽÍÁó þå[Õ™ú¿ïô>þñ4ù³es%¯!ú:Å#uÎKŠsòï©oÕwœò™ù–¤-¥~·ÞwÂÖä?0§Ü©ø¢8BýÛfp «¤w‘ ŠgXÆš)ÎØŠ|¶AòßMœÔŸhöùº.ÉInô¡áséýÊvù•øÙŠêÜÂU÷­Ý_¸“þ»e¹ä¤åmÅ•F=ú1¨|¥‡zS×)²Wî‰?P|Õj÷Ÿ«|Òö›ph ËçwÓ{ÎbÞò@p{ßÉŽÇËnšû«nÙq‘ž/^»ò áZb,Å\°^œ ú¼î—à©jï0‰¸yŽäba7}…Âs/ôƒübÞ©çi KNR?±<%/¿Õs¼:ÿþ^ùÅfxãråV.“?t½­<µa©ô=Û©÷‹Ó—É]);[ÐçÖŸ¹õ|ÍK? Oë^ó¾Åcå§;£²ký1Õ«Ü_+ÎL®U]aöÛŒ:«ý£¤A¼MÙóäVòµl“úb‘ɪçõQÿº¶RñC| –ؘ'îoÕ=ï‘ýîùIò¼à~ÙŸšõôÙBªWtIœ3>…=á=þ”¾å‡Äÿc™oY«çíéU¼Z¿Fï¿”åÌ]ÇIjU·(ìÇ\Àkús/ÅÉíuÔöÖ=,ØB]à>á4EdOZ×—4eazþÞ½•OåöV½¨×…þ}F}ì ìN@ñm×9ªk,íÑy~gþ¢Qõó¶Ä]FÝÅi£ùpØ÷êÜVüƒ—´vo=WãùÆFÉM@qMÓ×ÒëÂý²ÛµËþ´ž/¹ñ—üöÀcÝÌý, é:Fïû\Ý{ôA§‚Ï1õÞ µÒ“Âîzï<ó¨íçÃG›V<”]ö¶©Þ¿eþÚ—•wö½¨ºFcRø·ÜñtåF’^ ïä0ýw¶Lxª®_ïxW«NÙõ–üDÃnŠ?Z7êy‹^âç48ž8oô´u Ù •DŸ“ÿhß~Ù3u.©‚ð¼…sdGYGq¬ìb÷/úûºéòCn–{.’Ü.qè=ZÞ×ù»Y–×y¼ìQógó÷ÊÛ>†ÿ\dîWÕ3ò¯Ê¯.8Gx™î”?¬ôÁ ò"<#õsuÀcü†ä)r‚–jäý’‹þN½v=xàÙ9ÏñW.\ªºcþ$ÕC—Í N“-®¾õÀ.ª«u\¢ç.XýþK„Ëh¸DõÀZêÿÉû…,¤<¥ïåÙÍ?Ó7yOþ/ÆrŠ,õÚÜpÙÉËŸ¾S\‘-ÈÄ—*î]öâ¦ÌÃêÿ·Þ¥aŒê·ýé·þñ•Íú¾Á2ÉKÇ#’ãô¹}‡Áç:LqUg™ê–-fk¿…Y^×{†ôkáUŠ'“ýšßïÜJï7pž/ð¨p5ý-’ËB—ê 9CuâËóºkåÒáQŠ Ùóê4‹ÀõÇé'!¹ ²G›ðû,É]ni x TJß—…u_ÅÅìspƒ;¹Iõ¸î{t_ä§‹þP~0Çž­”|¤ÎR î£Uï×½Qþ,þñÕýÓÕ:ÿ‚KòšÝ†ùº‹dwÚ ÅÙ¹­É_V«–€‡ªg=¸Åd×z¶ÞgÁTùÙ¦­§:›•Ÿg“º†ód§kàwYFc1ûf¦4oÝío\Ç<"ó6u×ë¿mݪK ì¨ÏéþUþ°õ úUßés—³÷#¿Y÷œ:BüW6xâ–Á·ü•êl vUŸ8Ðy´î¢zYãC²;{ªOÙº‰ùûÏU·‹ žž¿èNà­£’ƒN{EþÖ}ÇYî¶`{Ù×ê]ôþå,̽À}Ì—½HõI>ûát²ì^ö<å#Õ«ˆ—ÿ=I~ }7ùÕžámÛOö#À\ofz!{%Jo;¶'Ϋ×ç7(=ëõЄÿ¶n8K£wÖ9÷½BÿógéGÿª7-xžytCÏW·?ËÔ÷ÔŸÝð-¥FÈŽÔo/æ(ù“ìÕ{z&Ç¿¢x­/>t_ý¹`{½WC¿êˆîS…¯Ë¿­úQH÷Pý­Îg`;õ½\ Õ`—܆à+4h¹S‚eÜÙÈë+U—*î«{j¯†7w±ìrÃVªæÿ–~õ¼"yLZqÒxÉMq•ì_þMé]ñeÕ9¢:§þuðÚN‡/óùÓü§²Ï©ýÜ;‚”çµû$§í̱$F«ïW½“êNƒ{éó*áù«{]KèæpÿÏ‚‹½;õ¢ò©ö¨7¿^ûDÕë[¯À¿ý!ûÞ·^ñMù Âý·½*¹Ë·ËØÎÒyv=¬¼°íxÖ”7÷ž¯úAý»’·šSô÷+?¡O¿•úÆõà•ÚJå?z?‘½Í­Q¾‘x°ik–zõêž]ÌG–H‹§Oß¡÷<Æ-ð¥.üypÏÀCxuŸüknªê¯E·ä­/¡|²Ù§ºKïŽôé7+Þh=„/÷¥ô7O]á<éc÷Sà^~’Ý\°‡ê¹qŠcž¯EËp%×ɾuäo«× ¿œ'ûÒz­ä­Ÿ¼oÑz¯ò³µ,³wìã4âJ–­…Þ£.fñè¡Ïs,\Iö§Ÿ¥…ÍÅ5½¨NÙîŸ9NçQ¸XuÑÂÍÓå~‘~u,<óÔó_ι}wÉE ÷Qs!ËkfŠïªs­Þgeû]ð–Þ©óé8^õŽÙÁ–õÒÇÌÊûÚ>Ð{Ôý"ÞîVênyxr'_¢¹žþ{dO»ÞVœÖ3\ŸSèfÎ2$»Ôs‹Þ;{‚ø(r}’ƒè™ò ífŸ†7äwxƒG(ïÏ‚Û̽¦ûè.½–ªÏŸ»@}ÄÂÍš8Nöºx«¾§uW=‡Þõ2âœÎaòËØ›b²´²0]õœÂÍŠçzLx1J™³­£¢~¯»[r´b,öæ=ôõbð&Ï1G¼Hç—^¬þE£Wv¡}@v°n<}Fò¹%σëê_¾Ž®ÇeŸB,møPÏgkQ^6p"}¢›dß꾑Z¼ƒò­%EêÎCôgÍz®æ¿d'Ä?W¸]v©äWÍëÌÞ¼íPå¹Ï±ócécºà;Uz[ø þœOå‡roªnÑ3‘[õIߊ£r3%ÿ½¿©W\Å>–ñúœ9à1:˜_Ëÿ(ÿØWüwÈà5¶×¼láAÕaZO îØ^zÕ1“¹÷füзò«ÍK×6í«þTâÙ£ây§&z•/« lÅ<òÑÔ!Øk²x;ÝwëCàIúU÷kݤ{ÏWé\çGÊž¸zó%ƤF½õì)øHøQÿXäv’ô`Ùùòëæ²S)xÚÁû ïv®OzTõø®»‘½[ºBÏW©ŸË‚‹nh~*üx»òÜnõ5cë4¿Y÷·âßI,Í…ôÞ¡%òõyx;èo¿þ1ß·ž—âò{ƒÝòo‘;eW–Ï*Ζ½ï=”y¾Wáõ¡8Îñ¢ðCnîõŶ÷´ç#ÿ'qL@s·õï(Ë¿ ¿ø_’óâ$½o;~w`’ìRö$á!rO±ç¯…y öÐu¬…oð øÏo¥p,¼mg€#?Ur”ÛGÏŸÏK.Y:Ÿ…‡n€>gÏ øÀûUÿê>O<[Ûêó±<|ƇÂ/†çævÕŠ»ª^]<•= àeW37Û§ïϯÕç/]v>{ŽêùqÔ-dÇZg)N]þ¤>§ýzöeÝ'üwî)}_÷E䥭ª­8Qú5ï-ÿ;>ÊÈîÃ>«¡Ø›ƒõ{m[)®Èî¯:nù·ðíƒ?<<Ë"ù³ŽOt>5ÝÂ1øJ„_°ÉngÇ2 oYö òÌwßdö>¢øˆþ;·¯¾·X¯8dp/å7ËÕ÷/\&¹Í=¡Ï;dgñzåžN¤>ˆ¾_ÁuS뿆81&½,>û<Z”Ç´}$;×ù¤~.|›pbmíàº$Ÿ‹é?î…ö4ýY|¿¾ (}‹ß˜W.Qž’d¯cÍ}’ø]p Y‡êÈ+G«ÎSw‹ìLáC}Ï‚U‡¨wãÛ¤ø%•P^tƒ“-¼^ÝåŠ{™wÝùs¦ðÎt}*}îyH÷_œA\Åœnû>äU‹%ǃ·IþªOn²sµòöí/,½_}ÓÙç‹ï«s1ru$¼ªqå3ÅÃ,Ü[u¨Ü-Š÷|ÃÔ×l`ްo¸ú¨¹ÉŠûWì¢ø®òkäï!ÙŸx«êZ]Ÿ3û•ä~ñ!г,_îvÙÙÁ~ôÂÆþžéðY¯§pµì^õU,醼óÝ{Ý2Í+æût^Å#•,nP¼Tx[ùVöÅSqæjÉ,:??MõãT³ì|bxˆ–]Iàdýû´ï´<{ô æ9Õ2#…ÇÉÍ×{×wÖÀŒÇFaGWßÝòMNÕ;[gáç'ëýÒÏ[ó3ù—e'» öh~¡¸¡<F¸Áà ªCV_Nÿèê@Û©žX¬’ jŠâ:x”½ª_®¸22UssKéŸ5 ~ÍâùßQvµm¼ò”¼CsÑ FÈ.þ†—`{õÍœ%= çdo–=Å|Éçò;d7z¶eïv|£>p^ù«ê Ò“Šã:¿¦î÷œž³³Ž¹!öI´|£þÍÀ)į{ë>23d—«wU|ÛǼfײwÂ/ñ;x‰ƒTÊÝ ÷¼"{;° xÝ‚pUË«©m€oñjå«ÍàK¿a>Ë¡çYì&^J+NÏN%n1¤× [K?û+U/˜€çs˜žoñIðÊüÒ1ðï`ñó½%ŠG;›©¤ºROµìèüOásý]ú5Ï­ý†¹ïôÞ¡þKßÌñž¢û^Q'9ê`v®ïÏzxË}äóO³¿ôTê,½²ç…‚î¡r+Ý[6J?;#9ªY/»Þ¾·úýÅS„ïÊlÔtábSýʼCqGb'æ^ÑûúÎ>»Jöµó`ÉM7|ÑÛÊ×~#;Õ3Š:ÛG’Ï…ŸÉ_µÞÉ~ª[¶UoÏÍf_á’·\­âÔw¤7+|ø•ɲ?KoÒÞø|¾·û,åãm³ïÔ~ ÏMÆÞ†/”/5¡üaæWš('¿[|á+ÒyµÞ";Ø5]õ«Þ*åo]ªÇ4ÿ¬ø¯i¤ð¤½•ò{óg'~Yûž±âÉÝÔçT·®þ[~¼ÞšK\®þ_Å¡ª÷ÞTÝ:²ò«ÖZÙ‹ öTvn„×q£ô¨÷ÙÏy¯¨ŽÒ3@=úaéÿVø»T‡È5éù—_†ß«ï™¢ïŸýƒø]sW‘ŸªïïÎÊ^Q¿¤§^ý¼¶…à‚.”ïýJqs²Gñ^ÿ•Š_ Ëoõ±£—¹²@‘½€›Ô?iýKÏoå½ù»%GÙ¡ª{„²ÿùW™Yfñ2¨0p™âùâ쯯–þÖFÀ|.ÎO}c õÆ_ÙßDüX8Iï™i?­;_ñM÷MÄÔSjþPßh <ÓãªÄ×^¿HuŠÖ‘ª—eÛTì¿ ^‘›d—ÚGKë>ß@ÇÒ·â©ì¡ü•óûG}…&¯î5ÿ¬ò¢•»È¿eÛåOVÉO´³ óö„í¡:l»Ÿ8x’üK/<`eð“x¯KϽ췇Œü}~9|ß¹ |ãØs{3þ¹0Zö¬Í¦ß[¸EvÜÃd;{€—ê¼»ç+~îûº¯ìú3ÿèƒFÓ~Š·Ò¿ˆ·n°\õ®Úߥ¿ucôý-Ô{c‹©Ï¶³ïhœâ‡ºk5÷–½Ž=yO«ŽÓÑ/Ù±zþîÙ'Ÿí¼zñÆ/ÍÜqPù§ïDå=…k©Ïž)¿Ÿšæ—ðéF¯ì³ÿDáC²£8^öfá8Å!uÔÑÛŽ{¼üFw›êi…;á-> Üùòé鵩.Ôõ°òòB¥ò½¥·‹¯hê}Ú+°b'öž‡å7»n—ÿI|¬ýËP|‘~œ!Ìç,—¿lÝ›úºð>Ùû°ÛyÝGÕ©ÊGZ?g±JrÙt¶ú™‘Š‹ŠçÁ‡ü¨â‚ƒ¹­&Ék´[û°ªÉ:Lêð ÖÛ”¿Q#R"žÎâvúýª˜î©éXýþÊåW[¶Â>ž©|³ýüùúþe?³¼Kþg ¿_}­ê$=O˾­ØŒÝ+{]¦x3?¹¯T]¦:­sj¬×çußc)û+†KN–¢¼,¼_·Ëÿ÷ï ξÏ9^?×üþývù÷Æ]7v¼I¿ï’G¹u„ÑìÐçä¿§Ž¹Yú°l/ÅAþߥޘ~ßø^v«¸Tv¡¿^Á—ä·–í>ý`ù³ê©:¿Žë7/x[õñâùß®T¨Û"9]0Y÷¹t‚òÄÂѹÁ3¦òŠ Ú[tÞ±¼ú±&û-òw*.íþ“{{„ý¶[˜;¹½@ÛÉî7ø‹ò‚•·é=œûhþ#·'{¹,¿ð·ìÍÒœðWEüaøë¾_¥_ÙƒT¯i¹Aö$}—â³ì?z¾ÏàÑxNñAÇíŠoòÉg„¹Éà£ì-(—Ÿi=¾£ï%WuKÙ×w·âšåϲI=wïìõ wœ­U¬eGêð?éÏØsÒ¿ÌFÍW´ý¬ø çZxfà ³xÑÚ÷—œ./Wí›Ì^Ö•ò»M[I^ʶÅÏ2¿Û¾§Î¿Ÿýœ…”üÃÌ‹ŽÜîÄãþ2VÎ!Y¬ü¤ã0úÁÍàŽ©ƒÆÖˆÿµj'æWKÎW>Lt¢ê>}Ô¿-z¾±,óPýŠ÷–PŸèv³Ÿw'ö{ïF=ÿÙÛÜUðñ6)OŽœ¥úmûì¼Wú8ñ=G_3s3þ‰pÅ>É[t[õÅ/…pgoÖÎ>c›êa…›úžÖ¹†û”Ç4ï®|Ñ¿=ñÝñôòê{å2²›m-ìá:NyKw ûÎ:•‡5/¹m8Mñ`í-²»Axãkµ§x)ýÙáàŽ~U3ÿ4õôµ:¯ÚïÙ÷Ç™žáŠËº¯P¾Õx…ìsáZxfÉf?VµîmùÉÖ¿eg˜Ê]ÄþͺOãáIÚØl—/¹_ýàì6Ê–üÉÜÛÓŠï²^G‘ýñ™ùÊSún—½ï[ ¿\ušöK% Íq®\'»™€ç²Û£óô}‚÷mS6ð’â›þ§¨NWhÐÅüå·ì×;qÅû5Ë7 Côû‹VÈîEwcg=}3æV¬y™y‰¥ªìgce«äÊœ*§î¼Î¡ºKydëx#þ&/=¼ð½ú¾Ægå7:FÁÛ;LŸß\)y8ž‚ßà­@®˜_è{Sz±ü8Õkœ:·StïËwS<ÕI¾å[ÕНêóÎTß³âÕËKñ7+±+KŸTþÓü­ò¢êçØÿ󢞫¾]y[-ýÜÖŸõ>5O+Nµ¿…|Ü¢¼}ÎË×þùÙ’UFçnìÛ.2U­¾dn¼êÈ똇úXr—MéâØ|®ìkïǪ›ä_–¨aËä£_,|^ycn{¼†Ãƒû“úh¥ïK¯ÏPÝ"ùñ ûª{”ÿîyEïßóŽì|ö#ÙߊŸµ·£6#9®yBqxîmö ¾9ìOŸu {&È~nRžÞý¤â–Zö´×#yçé{Kv`éo:÷¦ïïÖOWüÙÞ¡xvéÒÃÂÒ³®3àïøMñzÃA’ocœæXêzîÅó„#+¼ÀÅGõœùû°?#Õçh[÷[ Òð£ò(&eo#9å±s†©Ïß³—ìÆŠ>â‚/$WÍ#”ŸåÊß W¹’½î©Éª VÍ‘µx™Ï3e³‡Êé NR&÷©ž«>>|wáK{N`_Þ"éó’cékƒÏ^8UõŸžùþñªó¯ðKNCÔGKî!}¨ß${ÑçÔ9¶AåPÉoúåÍ+*Á‰ïªü¥8Y~¸8¼&{íó;ƒ+®Ó=µ\΢~Ë×Ï6U¶üméCþf_ñ õ ^åu0—‘|U“~-`_tö݃¿K}æ…÷ÿh÷$ŵݿê¼ëw–Þ-\óOËÁY·ï®~E{Rv­>zölŽVœRß ~ƤKÄ ‘?“}ðŸÈ/-fSþ6ò» ð}ÞŽxŒúD]W¨Þæ¿UçV?C÷׳³ôxáÖŠÛíïük––o䇪.Ô~Œðu‚ß›/ÿÛžWUž+°ZúÔ³Y~«ó1öUW<»þôÀ|á:ŽÐ½÷ŽaOÈÊÛ ª,h×=7{ÄSж·ä¢^·ì {ïú¹Âlð, áu¾^Ÿã…kîÔ=tl%} ÁŸ´ìù÷ðIêÛõø•g´ý Ú¡Š#Š(,ÜÊÞ{x]s‹d/—7)®¬/Jnjá©(ד¥_i\óóqöÊV6‰Çcpµü´{¦ärÁÅY½&ïë×ýöŽaŸÐgì}Y";Ôt°êd}—14\~©g†ò–†¸î¿åSú—÷«~”;ƒy7òˆ§ô×wŒúížÔW*^£{Îí;Å6æþÁñØîî¨?Úh»Kþ®0 ~·Uð!]¦ønÁ晢z²ú¶]­ð‹­ÖyUqNÝíŠÓºŠÈÉGôQv×ç,¨‘Ý\0Iö:e ÷ý‰ý™k',¾RúT¬‡'f-|Îïê½{fÀ{{+qíCÌÏm+=Yú|ÖG*/*î,|\÷¯òs“cüû¿ýõµžÕð燿/­¼¡a¹ä¢vó{ì1 0÷Ðy7û*žc¯Æ³ªÇ•¾«¸«yšÎ·õùÎ{Ùk¿HçYmЧÓ?Sq\~ |9ÓUï*^%»–ï!ÛAqk†ødÁxéUy@yÛÂʼnYê²¹²wö­õïÛ3§À|n±Bï»h„ô!›¦~i—=¨{GñxíÖÒ¿Æ]Àm~/?×° óåô_ScØÿS­ólÜ_Ç%ê ®†gîÅ ªtï…¯õy+?„ÇîbÙרÎÑ^´/¥¿/¼¥ßö)_ | ~ó+Õ¡ê_þÓñ™æ¾ ^áé·V½Êûªâk\áRé}n¾ ê%˧èžúoŸqšêÃ=/0×êVܺG}tóú…ewû§ôÅÝK+e¿®TüÒÆ¾Ò®^ææ>”_(ܬü®ûö§¬Õ=>Q¿"G|ÖuºüñŠ s@霺üì!ÜÌ^øNó¯7Fà/ûF÷Vs9qÞdæ4¡¿PÏyÔ‚‹éS?8Z©8»í'ÝgìÕy:Šzß•†ìMÓÉCŸWïÙ..7þ|øRìÆö”]™:ºSŸüj_Qú¿ìTødNÓùÎÎèÝý¡cñÇà·g)þØoú0á•ýð u¾®ø®óOÙƒ¶Oå_Û¶ÈNv«z{ûàó­½y¨~sð²»³V×Y8‹ý\1éOçFù=ï?¯çüò×™û™+}H~¤v@z™/“¿ï]¤8°gæh–ÉŸæŸÖ/IiÞ©ß%û±`GÅC×êù*+…íLÃËô€Îc ‹ù8;óÛÃ>NùÙ²uS=pån² —3s¦ê^?ùù’¿›Ám&ÕùfÜI\™KR³=«ÏçþÊ'Àó+¸jÑïRí óžÒråŸmßhîd¤xér97gîÓ¢½ñƒô¥D/ðûõ'Äv*ÎY þUê hßÏ5ª>©9ålíŸÒ>MÃìœçxÂý¢ú/+ÑËÑká—JXÔWæÿZÇ?X´O2öö%\Á¹gýBüY%3ëίâ÷‘w'|Su«ÄÏ*þÉlÕGkêx¾è/Ø]oö¡îŒpe?ìzõWèõÔç©{îã=j4GåÍC¿Kš"ŸŸ+_’ÍýºÕP+òÄ#âEê¡þõ'¥¿#ÉË%^"Ù!9šs-ù?jú”¸ÎæCÿR-±Æçn™”#¼ØFÎ5s)u§º[±ÏãÄ£—¨#OÒ0ßh¥ýTÁ'á]<·ýä m%úT7<쵫ÏzçnŠþûòÈK8cà”/U§ù ;X#ÿ_¹ùÍ’½/>¶‹GémÅUY¼¬¹°oW]ýu<©¹Ëa|OýBÎsÊPæ¤bùÚ÷½TqâkÈwì)ü_¤¹xÑZó^þ.ªËÕÏ+=¦½†ðóɘ·þ=|´*ñA¦s>&·æ°¼ÇÈù«ŽïÐ:)0þßÝÿçOȾ·T>ûWÙWí§­;…_Ž<Œ„T½t-ùûDOðIñGÜC|ýUÑO™OHªbh4†¾8óÄ£¼½=Cü2r8}MÞMØÒmšËí¦y#·êŒ—sÚ3íøùý7 ½þ™¤ÌlÎß÷3vÈõ)ùÎ íK ¾Âó‡·ÉŸN ÎNœ _\±¾k>»â—ŸÈ!ü’-Ks85ÄãëÉkV‹/ØT>Ž÷_F}Ky‡znÝÅq&ð¸{¨øUŸežÌuŽº`lç[0½OLÆÿVo„–b_F~Ã~Îhµú b‡£È_â{ñÑ^ÁûÖôãü ñ·‰¶ØÕ©Nâþªg¤GÉÜk@u¶’xad€þúà_ø9WršÆŽZ•ïtækÿm•æd³°+ÖÜcèSÕ_ßæýÁ¿¦ ào ìjƒº_Ýn⽈øC¼â÷£9·Oð9EšI^C^Ê—þ,>MhÿnÙvð»e«úF6¿xšiná)ô¦à1xïÜí‘ÃDö°8…¾ ò¦ÈKîoØïòÈwI{p$‹{ÍÞŒß35ôå¦kž½¿úTWŠvç{\ŸiþX|q±)È‘ïwÕ›V鞓ė~7Ÿ[û$xŪ}1•'¸÷ð5àøêåꟜJ~Ø|‰øhèÌ©Uý¤ýÞg‰‹jo”ì¦:ífÍm– _Ž¿48FysíÉì¯ý <,Q78'+‚)ÿBñøä-ÑXyzêôµÚWU¢y‘‘vúMŸr?‘ÎÄîCÄ%‰|ÍY.$ŽÌù…ýÕ!ñFǃâ7âýýˆ—Ìsö ؇šýØ?÷b¾Ç³KüþÇÉ?Å•ˆÿ­~ÑAÄÁñAèYìIÞÃ6˜ü@ÉoÚÏr5r›è£ùø±æ+”·üûo¹»}óòXÄS1Ÿü¹øßX¦æ-o_F4GUsžüŠ­#xÎ#~†„ökÕjÏÚ]ªÔþ =^“TÇùV¸mßW{Q<ïÕ¯¹ ;_¹=¶ö/ö)ðNôUâz÷_Êk/>‹¦¼Ÿ+ ùÄ_áY‹õå~LÊ{ ·Äk‘?÷«|¾É¦zÍËÈ÷ìnÝ ü¾ñ6ä©>‡¹“ x}£4/¶ÜWtöSvA~b•â%ˆà yê﵈ñ&þ^Ö;5θçëÞÙœ_Fݽöfî5ü‹ö?¥~‡ÎŠï¿"ž« žìÝà”ðøå\áÞDù+_0Åyîjïo¹‡?“†‰ŸíJùöâ3ÝŽßµ^¯}Ê/«ïñz탸 æZŒY[ ϵÿ°ùÿ}ò1ƒøX.á·BÚÿ:Î÷„ï'~vŸ¯ee.̦=é±Ùø1·øáêî?ÖLôº²üY¤ {kåÉ Ü¯÷Þß5B<®k°‹±‡±á}Ä›£‰ KCàŠRíÙò‹ÇxØêwéÅâYÈóÔ îM!¾*÷‰ç¶Žï+ž~ê=}¥ÊǯÒÞ™®Š3n¡Î¼[ýêk5¼ {ZuN÷½F}“èËŠžÀÇבŸ2<¯ù†]ØïHWÕ•ÿˆç©/® ý‰-܃šs‡k/ÙÔßÙÃyšsv§oÃR¬¼å‡Â'?Šÿ¢ùXßñ›=K|’/¾6ã·œOا|ùØê5òßM¸«x* _×çÜˆÜøè=ƨ.½’óô?†ÿ®hŽo^‰ò'y_÷büÆàŸþ%…ÿ?Poðˆõzî}âRõÛ}ªý)»5ç­ýržWÔµ?“7 ¿fÿSÔ‹=¨} <á ÎhÈË&®'¯_؋ϩG&ïVæ_\÷bÿ’ªÎ½oꦤêTðEZÞŠD”sµEÁi5;Ég§q^u'ù}÷WäÑr®ÏÀTì~ÆëÈIRù#ÿžcT”û/½»9 yÃãØ‹„|ûGô,4YsKœkm'áÎ…âÑœÉs”Þ¬¼ÕVü`dþÁט7{ÇÚ ¹ByiåMýÈ…ÚQˆhˆ7,|µ˜çŠýÈûå~€=5_\»~çç\Ç´ï·rëT½ÅÓ=s¿§ïóÒ铈vçóRƒ£«–(¿³’Ÿ7=ŽOÓü|_êÍŽè}õƒVýÿÃ9¼Wr%}§ñW4ï; ¿l\+<®~¢š¯À·©SµOn†ö™õoÒ›ä j*Ô=Pý%¿!w高×)©$nu§¨Îá%­>¬=J-ð+ÑÊô_ÓgŠóÚS/K[«n,>²rò®Åc°Ó%·‚SÝkT?YÁóeß@œç싞…5÷êtèyãêŸ{Ty*¯úfoFÿÒïC~Ã3±«–˜ø)Ú(ïªzsÎ"æacËÑwçrþÿ´¦ðZÖN ?Eßs:°°V|DVõ•zlÈuõ&ü´ÿIüTÝ{ؽ²}|žcy¯˜ßKï€^‡^T¿ÊÞÛ¸Ur¨Wñ´ø Ç(žðr/å+ðc#ï…'˼@¸þçmê€_ð­G.“ϪÏßBþÛõøÓ>Eû¹ìØË¼Û©Ÿ×r߯Y|O®xÁªJxžŠ9ÂYŸjïÆ8úk»ÐÏ,Þ¡ÅØ¡„ø¸ãÙzÏEØýºMà—KùÜ–ÜWÊ<úXb§¸ÇÜ:úµc•¼¿íVêFÖfÔá+è_¨û ¼Xu?Sû­æø[ó=Æ x.ÿjæ}=ª3×Ûñ{Cÿ¥/¸zöªtúå9‰½öµçÅ®T¿Êüwt¡öËœÃÞÆ#¾s}Š^'#7î<ô:z9ùÉèwäÑK÷bÿk´ºÁÞ›îÁVL NuÍÒþdñÔ½„÷•ƒ»|4w8”÷)^¡9¤ãšÿV8ñ¦xSꕟ™‹>$؃X„ø­®‹æMv×5ì]KÔð^ŽóœSfwúPªSÄ_d$ŽÈ>KÞÎ7x­f4ö=6ûéš›<‘¼AÕñr?¢~Ø<ú“êÁ)í©‰–c'cMõ<‡ÑWÃ+ðlÔíÓž‰×ÛëćŽíÄ£¡>šjL>Øš†ÞÇßмê&òS^3ý,% û ââµúRý­eÈ™©½êžÚP~ û›!ytNÞ˜ËÏÇÚ{ü†úý²ÀYÝÔ§?Zy£6:/öËOÇñŽ="=ËÄ®>gޏ´Xó-ëyîá‰g/.~¢íüiò`ÿxžâ—‰Ÿ‹¦—,¿ W‘£œíuœ“[û/cè—”S?¯øm]{‘wÇ È£g)q`´‘öáì—èk  ~Ë,~scâÙ°òÞU×jW[áÝ‹ÚûÒGýërϱ$ðqÝåô'z†kŽèiîß­üa•™îyÄ#ná&³xWh/]¼xøæñ{5ÛˆË>R\øùVK v¬ì0øÝr€¼[­}()Ú/ò­ú?=¼a>ú–ù2qO¢”xÎq£òùçÄ×þˆöp.ÇΆoáߣƒUŸ?§ýZåà‡Rí ±ÿ†vÃþ;П†<©çêc¾aš?Ö>x“æDK´Èv£ö kÞ!Vò.í¯¯u|„æAWkIû¤óµ¯0Þœsp¼ÈB û]!Þúl›ø´Ê4çúz™f£/(|Žïu­¥ãŽjö_<·ÿ&ú뎩ÿ}µö?þ5«ØEYù:üm‘ö4ºCà$K-ö¥~§ðcÎwäNú°âOitºö.¶E/¼ÙÊm”}^°d*ß÷.r^%ZP«x"Šý®~†É.ú뇪ßi‹ú&›è|µ&*Þ´ª081Ô ûæ¿_8`ϑێó/Fž ž?rf —÷øÅ[ì܆¦Óg[: }5©Ï*o¯æ%^Ôœö„‡ÅÃèn!>bì_mkìFŸ”º6ü‡¯ÞÔõ'þŽ5'¯0íaö@…W wÕ­´gt¤ðË]âýžGœh9Áó•<Œ\aÿÌÏ`—‹Ä#Þ£=v£õ}â™ ý¿ñ.Úwêïu\|€åßÏ«ÿû=áòŸÅçøxÊò q¬åˆú1¿FòÄë9%Ê>¢ššknÞ*›Ê½T¯¿•ú \Ûуºï¨ëþ&ÞsÌ_‡§ê}~ŽÈÆd‹8¤üOµæC{ƒ?¢§ñsÙ3¿ø/àðâçxþå o;šöçÇÚ%…{ðyÖß ÿÃØs£æºã=µç)MùçRí7›€^—ÇÑß’4ô7r+rP6»ý”{fkŸácØm“òJu蹚÷>«>àgÈ—&æpn…‡É3;.Q7/ž‰ýJìÓþ³<ügƒæn'ùœüL<@ü›=¬<ÉyΨվéOÁ¦k´gêSì·a,ý&™_0—1ª÷쟃Ýt?s••ÒGÞÑ>œûè Äáñ òåݾ›~‡Vކߊàß'÷&óNT]ó$ú\±;’í¤þ0©„}æe‡…_¦s¾¹5êü 9º+ûáú¸±sR½æÙ¢š[²]d>Íh ï'pT}Ø_‹'k,÷žlïÐp™YøÕ¡9òÄSèAâjúA‡ˆÏføÆ4â¼—¨ŸÕÝÆ{–ß„üÖ÷Î= ~ièã°_Â>WœSÿƒö¥Ç—¨BuÞÚ‡ÕâS|¸ »š0«>˜Ð\åQÔwW›æÕW«oã:Þ£üúë¬ä…nÿŸ[9·)ɪ·‰uôÅ~¾§úÜNôÇ÷«x@>åóÓ!7¥W ¿á߸דðzTñÿ ý¢~ŸðÐûÄë£eÞ%ò>râ;„†Ê7h‚7uÇé¯Óg›sùŸÚ9ó_¿ÕáGK®@nj>Ò>Ìä½ãë‰[-×bomkÈÿ”ƒ/ƒs¢.ñïnÓë3škÝEü癫ùñcô}x5÷Hâý«=ò§¯ñü‰tî©J|ö‰ú‰üKøwçtí¯Ó¾õÄzâÞpâæÐ“Èq®ò.(û§æ–Ÿ¦Ï¿2Ž<§k/W#Í;–'è½íò_ÒïUÛœÉB~ ÚeéI½Ùíá½JÄÃU»…ï ¶×œW åüÊc…Ð×xìF|«úÜÏ+þ›Œ|Ǫ°ÿÅò%±2ü´áäÀÙƒçÊý@¼ìÍÓè6Î%IûV-»ðcå«8ßò_‘‡ xFdž?ñ>øÂåÅU傪àËDä<ýí'·uù—17bºù®{Iù%íŠ,Âà¯ãŸáâÝÀ9ɇ©‡$æ‹#ó8¯šy›xVR“ÙÃåj¬zÔÇÈ#“|®K{cÊwn&ßäTÞ>ò¶êm· ¿÷|´ ëÙ×¢Iæë‘oËMÚ‡xœ~"ïSøiŸöQUÏÀ?&Ý@üù•óKŒB_ ÞBo*×+½Ïãçߡ‡óÿóÆhîü_puå^ñÏdŠÇöä£By³H_þnÖÞðäÂ{¼:垈úx¿×\®ý }8Ǻ+9·è*ò²æ»8o_ŸépõÕð[ž€ú5Ýê;IC?¢ú¹Ä«ä×íGèG›¼ˆ9®ðáóϱ—ÌÄ µ¸o÷›ØSÇHìFÃ~[Oú}‘WËy |2]|Fñ—Á)c¾¢.?½(û ;R?Ž÷L$Ôo6½«ùçHªþÏ1òÛÛxË•øC“ùN QǨëÀy–¼¢ùÿnà¨XÞߣ¸'Ú…ó¬y{ë¨ù—º‹³™ò]#_ÃdÎ+þ&x!*üœx—ç ¼G¼nzžº–å¢òªùýêAø_ÛÃÂÝ[øüÚ±k¡¥ø‰a¿Ð7[ÞW›ÀÖN|ÙNÍ›ý«¾‰"ìsáà—2ñéNa÷ƒÙø£ZñGí•›ó4oò'ï“È?Ý:îѹV{ÏiOj.rSã@¯ë¯Qnx²Ê¡¸,?{ù®k¡=@ò¾¥ÚIdÀ¹ÿ%*.$U®x¾;y©éì”k„úX}ȇ¥9úPüúíÛ šöûë]ÇÅ—0RyXqþ*~Þ5‚x£¤z8ø {5¦afb0òXÅ}ÆžÕ¼ç÷ò'È»[á9|—ñ\EÚoNÆSÀ½Dšh9 y P^¤“Îé%í‡vc§iÄï¦BæêRù~Û*ü¹!qØ íˆÝA˜„ILEßó.€·ÂcwÃéª#ý޵Pýy¨öŽ´"^1‰¿*‘©ýKªkE{ª?È.œÞ˜x¼Hý™CÕxù¨¼ ûøVù“·È_V¿§½ éà!÷MÚOè?ySí¯vŨGy5?U·ÏDÀŽTo¤.‡· !ÿã}{Vc•_Rx&Ï«!Þ‰VƒS+îG¿í8_ù6©¿±fŠxQŒäåë[ˆ?å5ü[ü%po­x»Ò{ð<ÑÙøÝ‚ñà—X*ñP|v6õQüOÙÛ⧸™¾%÷µšo¥}TVpaá\änÊWô=–‹×®¶-õïÀí}ŒÏñÁïñ7ÉÓŒºû25Èü{"ƒ¾Rßhò¤.ÉAäGž/Ð[óJGÄS”Mœe}‡ç.X ?Ab¼úTc‡"•û°;·½ÿ? žTwø2÷ñ€å€ób-‘«ú®š?ÏKÝyìf…~‚ÔOÿ1~Ö¨º—?ª<ï9Ùñ縯éê«.¾‘{ ÿ<‡lèåÄ3?F¶ «Kª]Ä\À´í—|9hhRx8ö"¶^}¤»ÈW6äoi^õ îeò&ø¼¢Võµ?£ýGx~óRpf¸üEüsä}JÃÞãwñ×ñ§´§ä/~Î=»i| ñMGíàVÿªnÂßMý‚<·ç’ìJ;Íg½¬ºÝFòµó5×cÆ^¸_UŸy}œñ6à ¯æUÜo€¢'9ß`ÙÏfàºd;ùµì癟Š$\õrš©øÖÖ“ýA‰ñœs8<ãY ~p×Rˆ¿…Ÿ(­PïE𘫑xÛûˆG<ÛFõ#Çöbÿï9¿l’ö%Å»—ð9Îöü¼û ò5…Ú«XMÞ¦t‹òO©~§¹‘Q[¨ÿ&º¢7õ›è/Lû;íyB<Ñ‚7óök^àògUyÔ}'ŠGºŸ¼¥”<©÷‚ä¾XuçyOK=yi×züoÁص¬Í䋊Ž;N?¢!Eõ ›ÅŸ=Ruæ§~DÿsÎ+_»˜çöþ ~­{ÿ;á&âeçÕE¯§yg)?³¿P°~Mwcí±È†¯uÀºŸ'kþ/¦¾ÜD‰æ¥ça‡ ?ðÿ§<†°¦p/É'Ô¯f?F¿ƒï ä=ôöŽü n­LVýÿìGÝÚß¼ˆzé½5ôZ’ÅÃй­ì2í÷©¥îæÖÜ»é:ìuõ‡Úÿ=Œ¼Z‰êFñ†½ GÅWø7qùèîè…å"ya[[ñµ¿N¬=¤yºvÔ“Üâ-‹iÏäFüm`.~Ô©º§u ÷`ØNXº »W7½L<¤ùȇÄùñOû¨Kµªn‰æV£'µ=ñçnñ0žæ¼K4§[ð v3rþÔ«ùµÔ‹Ü{búŸï!Þ-eЀþ„öËï=­=@Ó¹ÿ»®¹þDI.ñDº¨dMѾ÷wˆcª§ß0h¯Le;õSôÀžxžà÷Ýïá§ÂâMí÷ÔÜ÷líGÌÅ®{Ê”ïî¤9ß×Û »2ì·­9¯]6$©¦Zùšn|ÿŒærbR)š¬~οÁÅŽ·ðkñÚ%Æk^Ò¨}EWp/Ysˆ?&Ïd>ݳ: ±-y9ÇëÈãTÕo<ð§–?9?çcšÏ´cG¼^ÙÁ øqÛíÝݧy|~ñ.p§÷JüádíaŽÜÌùùW^í”öˆ4æsòVi>¡ŠÏIÌ&¿Tu#q¬YvtòÀ®ßô½iùß žÊ¯PA@õŽWéK48èqŠ·.n§ÿÅzX¼·Ïa'§´£~YÚ } ¶;ß f»Ü0îUìl@sŽÏ›»Œßï±ù¿hyÚ§I•3Ñ»ºÄGuÚîè^»ºˆ×ràÜ‹>»?Q^ËóF¿&ÿ™%~¯ºÏÀ[Þ-àZÿ<òFŽaàîñ¿S'‹>Oþ¢D¥Xºx)n›@zÝ)ñ1‰ß6˜®¾­3Ú ’'žíÍ6|D½5ú¢æ=KTožp”!ŸUŸ ·iOpÕ¿Ø‹²¦âã¹ÿ{ÁõKøœì{´'pz›¨×¾ž0Ÿ[:„Ïu?Êï¹ÕÿT¹ýŽ7×<žöJFû‰o<$;| »ëQt@ö¨nõË:ñöç=£¹¼ÍÊ»vÙK‘Ǻ½äS#ßð\ã–Ñ™ØÃûÆÆcMª»ÒÐ;ÇmÊõâükžR]â4v8|¹3=¢ù#?ø¢ä;ýý¢øß~%ÿY¦¾ñâ—Åsñrh×9Ç–Ë=´ÿ¹Vü,÷ª9›÷rµ%_Q=ýŠÅϦ®l#ù;“øvLÚ·Wý¶úúTŸNÌãÍ;Á©u—‘§ðnE(òÄwIeïªßí¾ß.þ‡O}‘S¸/cìcÝ9íÁ¹ :ïâ©‘ù?¯ì[ž’T÷ŒêP;ù9›6E}u׋Gþ_ülñ|å}‹4¶—|gÍ ä¡ú¤ö,L!ïmcGj?÷OßÄ;"þÕû‰‚?«¯c*z]ƒºÏòü%:÷ŠMØ«¬3Èeæpð±w~Ï(¾îØ#àèäÉ?´? özí½~^ñ¹úàîùöüÿNIõÉ &þ!þ2=¥:âRžs¨æ¦ÜeÜWÅëàËð úåê’9·zŵêÃNtÆŸ”«®Y·O¼¼Úy|ç×^™øPì^ðä'v ùÞÂÉ|_týŒÑÞÚßV«:uªx©úðûu‹±W®ð?u3ùœñÇ?àÏD+Î˯~…p ûYwšs´QŸÍ“êYn·6þŸB¼—è‚?È>€½÷-Ãß––ô„'34O<~â'*}Nü—³Ä7–@.½_cJ˵Ç\óùª/ÜÊçרˆ/Œâç·û¨ƒYµ- 9Ä<òËåKø¹Ì4ìQi.v9&¾±ºy1Ú7–X„ž!ß“¥>œ1ÂËàÿBuùîä ÝóÕgûx&5Jý"‘‚ŸK\¥~‘dôvF!úâ~Es°M´­ø¬¬/}5:çâ;áq~'¾á×…[Örò±w”w[¤ø¶ þÄ÷~Ç2T{ì_#¯”øVû ~ç=è׋Wò9‰uš;¾“º|°‰xE€·FÎËoßçýÓIeù¿x'ƒÕu€¼BÙ<ž§Ÿxx-qeåí½ïQÕnÕ+®ÕÌnäÉ5ˆót~ˆýŒÏ/¨YýìslñWY+䬾y zÍMF›`‡-{xï°ú\ÂW™òŸ"÷Þ?±Ï–jüJæd"ëÔ—ñ¬æ[5Ï_÷!ÿ¿Hüoî¿”·oÞÀ{á+‹}¦>œè}èAòQŽÀ±5{ÁY5Ú#ç*WŸ|çðhna»ø³«ÉÿýŸg!Δ·ÆyÕÝÏ¿ÇÞá|ýšóG/JÓwûGq‹úê´‡¥ÔÄÏ[ïTŸãp…r]©ý›î¿8¿©Ú—¸ 91†¨# ,d_@îuÌ¿çä‰GAssu?G*™£½¼O’w6%Ž8„+ª8×ð(ô.”£y°tpOüSbž!ö(ï_§=;±tò¤£Ûl>bú¯IéYôÁú¶OˆÌæœG÷†OÛ-¾RC;ÅAŸ‰GéyêvåàLë[øÿB꫆ƒä[¦oœ—ßã÷I©Ê?ÅúËn%Äã|’ø9±MýòS‘ƒ¬9ŸÌçTo¹FuÌJî£Ì…¾Åë¸'[ ù¾rñµç*Ž ·TëWðý1x ¢fñ™¶EÎÂ?!gáÛ¸G÷Óà3¿úUGÖƒŸÜ-¨sÇ/(l„þæ%OPröŸ?£¼”úKÂâרïÉóDVŠÿïú1LzŽú4ü`͕đžÜ_¥æö퉿ëZ‰Ö‰ÿ*;É=„ãâ#½ ¾’uø§òÝu›Åw¹ñuïôLÞËyƒxß?ÃOäŸe?åÔeâ'þù°Öa—³Þà\\9àã"ú\+„ß…üœg5ú^ß”óÍ™¥=²Ê³UÞM=5 ù麱ôæThnïðNq¯B ~nºöœÔ~ .3v"þ¨;H¼bÚ­~‰™âEœ¥½Å+Õ/¼U{ÚGóܹӈS»ÊŵR{¥kìèg¼3Ï1E{$âÛ°?jˆ kÛ çu׋oâï=·c¯ª¾¤:Ü ?m €++*ÉïUgªÿø,J¾Å>ÔíÆN&GÈ'½Ä9ŽœñcÙûûÑ'÷2ík;n3¯á|¿ojŸÁ¾•¬!¥ÈþmÇBØ ãVž×?ŸsKtOÕ¼¥û+ÁÎ'ZèÏå|P}Bµw+]¡}š³°cÙW«±^¼žw‘ÇÈ>ÏwüÅ×å²ÍkŸkèZí›ë¬|è×Ü»õJíyNÉnÍ‘:ï|í«ëÏç§>@¾,<]|˜gW´ÁßOž‹>—¬Q}k qm™úõ {Ñ·19ôä6‚½zµæºð9þ{¨ËÚ:ˆO®3y¥ÚˈˬfâÓZÎÛUÂïyÛÑG—¸‹8ï®]Öÿý÷¾Ó~×¥šgZ >tñ®XÞ Ž65%^-î‚=ÂsÅ‘çªûˆºKlòâ ýs›e÷ôø7âÃJäÌSI=&R 1¯þ Ú#“¤¹ï£Ú3=»Uuyž²»–˜Ë½…ïWAr;ª=‹šŸ¾[y[>×{=Ë3+¯@þâfü¢ï!ím逽­‹WY|ó¡ß9×ð{àù˜<ËÝPW,[¬9†eø»2íû3@~ëÆ‡Äg6ô `?ŠïBŽìõÄñLüpÉdòQþÁgñ´·â]ÍEG_cÔç¤9ÊêûÔŸ8\ö¬ç]þšx ûêv¡¯NðbÄ©=Ñlj«-GñkÆýÄ©!í¯­×üÒYð§iøÌÝHyŸ·xž¤U|NXñ®uv²(Móò©ÔÓ7€3œ)È{] rTú0ßïhDKüvü^°Büt­ø÷Ëÿ3n¡Ã“,²?‰5ŠëüÊ>£¾ÑVø1Oû2¤ynW¾üüHñ¿\†ýŽm%Ÿe3S_4}­ºÌ•â}|€üjìnñ ?–ˆW/û᱈ïm}=EñGw°GžÈ»5]2^‡¼Çšˆ‡öAìYd,ò:ðêÿ¿'6&%nÑÞ¦oÁ½9é+ŠÞM?Û°1̽šši?]y«hŒßˆÁÏU7˜psùÕ+¸ggwá¾|~òE~¿úFñšî?&vÿRõþ)-±o¦Ç¨¸¾¢ï±f‰ø]zk?d+pUè6õ€}(iJœHQæñÇL'þI\®¹„TõS߯¾ÌNÔ“-âïÏ›>†è‡š“ÏŸåwj«ê­Ùõê£ù…{O4Â~eöמ.ñöÄŸ•o$uf¯aÚãàùêä ³ÏRwn”ü-e~!Uyø²fª—ì#ïÉ#oÏàûCSñÿcTç­½<âÈU|3‰ú¬óz“¹Ozؘ~Ug¾ž[{NÓ²èßJÖˆèòñŸñw‡2•4}Qdæñ%IŽ/ÈÇ.jÿÅÞ+žLþ>ôþÃ0ù 樯÷"õ£Ä ÈUÔ!ÞnÚ_ëÕól!ÏmQs8ò9ð–7ïŸ÷ìÁ¤`kðRýTâ×ú¶Ô·J5×5e8Îù»ìÁ<íùþ;9¯|ŧؗÄLñ]æ)Ú"ÜQ#»”ž1ìäyâ—°ÏiÊöÝâD²I‰!Ø7æ>ü 'uË5_Ð9µ¼ˆu}½öOÓ>øðS´§ôñv_G:%“¸§_kΡf$ø+QŒ¼LQÞ#¾ƒÏ©ÖD¼%úPü£ìËÍ+üª¹ÊÎê[qnKòÊåßrN‘œgv#ú™«—Sߌ>Þø®À>[ÞÒÑ)üFv€9Õȵà]¾xÔg”ý¼Ý3´¯Ì¥¯Æþ„x&s¯u+”O\Éûe¾$ÿ?Ryj–í×^¶ x }®H×¼Q|äùG¸üNä*zVvà%õ#~Šž§‹_²žç‰6Õ|tü\¤}v“j˜Ë«ÓÜw…øhüÚ‡«ÿ ´’ —snÅÍÀëîSø#ÿœ×ô×ìyô…¤øêß±/ãs*ÇãokR´¯À6”ï·vÆÿÀ߯n{ÊÕ¿ÕœûôÎàK—£¿©èßôŠÏ7k*qrtŠæ º‚#bIØ1ƒøU|¹âݘ>ŽÿÂïn"Pñç\ý4÷]»¿X¶C<÷©ÿbv§äâgõËÝJÝÁ¬¹FÇn~nÚËÄ«á!ÚG9BõÞ;‡Êö£‘Çp4ðHâ9êvc—âE÷/ÜMø£º…ÚŸõq”¥ö±¨šù¥ÐtåÃô‡æO'U2—óawKö(Î)Á_&&"‡¥%èãOâÿãÌyÅ'÷8s†¡7Èse%mø¿\ýv,»”8?îÀO7ðÄD’ðSc÷RJ¾›½ÑÎkЫqŸÓ7Õ^«èäª>wL|ÚOk\‡û+ø º·iwñkü~§T{ºcƒ¹/pºeºú8ûR?%~Úþ…ʯ='ÞœÿóùÏoõãœÝ£Ð‡X”¼—Šò}È?ßA½1ªø®ªŸæ&6p~þƒÔ ýõÜkUwâõ”/U?é&~rñbW½‚¿M,ä¾êê¥çÛ´oça¾§Zs•±A· w¹ª·Z–¡§Å/c¿kÏ }G|ìê ®ß…\:S÷··$•ŒV~ ‡öN=‡ü†Ø‹ñÓ—]¦¹žØàeãØõšµŠûßäsí‰7§jïIívÍÇ+?`9.{”'½ûXü¹÷ãÇÓ'j¯õ@⚺}ä «?ú¿>—‘'•ßw©¾æ½‡¸³wÓÿ…!½“Jž&?_ƒ|¸ë¯ì·Ày—3·6p5<‡ÑzñX\ ^–MþÃén{\µìôŠ£§þLòß­xû}üW©úC*»©¿SûüL½Å¿šÉ=yê5‡âã<2inf‰ø3oÄ~ÕãJþá&þ ò¯ôñfwáÜ 7`w&•·xÿíT!i${6&M×½8©Äbª+œã{ p|ü>>pA†¹´Qß䫸ûämêK¼Gû³ÚwųœڞŸË ¯ªéô%8{RoÑþ’~šWÿTóg©Ö}L|S»{å­!oV?@øg¡òwhŸƒø™rséÇu?¥zX?å‡^E^ã³°»æç9ïÎ;vœù‰â2ü~•ú·Y NÊB?ÐøþšÉÁåŸc®2>]ü°ó‘ó@ =u§ã¯´Ï¬©øLTGwŸØ§ÄÏz/ioÒCÜ«³•xcæ‘¿ñÞAÆq=³5Öœ–ê©%ɧû±î„ê†sýß“—(»€>ÚZò~•ižécîË6€ºHYgõ•îÇž„Fó½žSÈoÞ$òyžÚï´”{¾÷gÎiìzìœû0yþúNà7ßEô©ôOìºw ö"~³æâ׃ÃË„bÚö vppL¼b1ò#)‹˜q Õ^»2puøŒìŠýé?|¾þˆ[kŸäëØéh;ì_M®êß#°éÏPJ¼‚} = ž¨ûXqéõ‹|¤ùõ»d7Îc'<)ª#q¿•^þô×#¿Æëƒºfš»¬{÷å<=K×áèä«îú®]صÂCØ ¿æ"KîïåtìæNB7Šwí-üר úã{8—JáûÒ[‰¿•Ú_uZ{L÷_9J•wL¥o/º–ñv5|ö=¶Cn‹o%¯ëLEžü6íI»Jûð´ì®^ÿ®ÛþFR^vÑÖ?•¾ùv}˽ei_@úuÄ‹•vñµÜD|U_|Yôžå7SЧ ÏUR÷Š÷+ñqUTû³âÕèóÔöÌEº6j¯³æ¢O‘¿ª//»xWg`¿ê>ÏU¹L7ó‰Tñ¢U°xøc#ðùóø•œOârîÛx•øï/á7,À+ÆJ>ßP‹¼ÇñžŽIâÉûA} ÷5ô×ñ¾ùw&¸fäpÍ#&0ÐÑyç’ÕG“œï ‡Žëø~[ÍçÅ_Õœ÷+š‹žBþºTuÙèÕÈ`ˆúG²÷]ñÎàŸÉ3迉·'ýS¼Á›±ÏÅïbwm½¯X5ú•þ9õ¾š%Ê›D5‡Ñ{bîÎß­o‘W®Y¨}¢/â·Ì«Á YÑà8Ä¿ûša—NìOÊ3ðä-!ÿão…Üzzs>‰ñâCÒþ€øaõñ ¦^ÿû`¨@Î-³´ŸíYõ_NÓ~œÁ|ÿeâŒÝÀç6ä“«ÕŸÊãý/`/Ê/¡ÿ©ó8‡òŽàºBí/ ”«âGüiÝOÄ!Ñ[ñ/éyÔÌï#çÓ9ׄpYÑVñ£>-½¿U|_ó~©à¶I»Á'ýþ^}4íÏO’L ·¥7_¤N'¾»áqñ¹“Õÿ“ÚšsU†3ŒÐ^¥|äÇQ®ôíþ?ÃçG7¢wéû¨ûÄ“‰§" ü@ÍiìW¿û©7æÌÁŽTß§9…râ8ïýêC½Ä|§£3uù²ãØw\|»[ЗjŮDZΛñS¥c—jþÂï†×a¿MˆG/â·ÜÊ›ç}ãW#ÿ9ïÒ¿hz’óª =³FÀwµÚ\ßMýYÄ7w7%n1ýÍ÷~!ï•©¾Ä¾¢P­ö}uåâÎwÌpú<#ÉÈkd%÷lz¹·—ïýŠ>g4ÇNV?„piX¢ vÕ=X}RAõÉŽ¡ßlœú'M¿Pg-o«=˜—Õ‰_¬fò†ƒ°fñ’Y?ÄÖ¹÷x vnJ³èiíVÃaä=ÇûàÇp/ç&+Þ¯ÝÇß=·+h$¿Üï/úãêóU÷ç9½O€o,ùàïXwìAØÉûZÞ#?Y}½æ‚F’NHƒs*x!Ö„øÂý&ò““ó\Gœã˜!(ÜùxdÏi®þ’üõô|üÜCæNp•E¼pž¶â‹ë‡ù <8‰vømæ·Ó›aO*Wpo¾¾ÚÃûqz,[øÇ©øî¸øªì¼¿±µêÜš¯øZýéâ±Jx‘ç}àq‹ö@9Wòs5=¨{¤¿§=£iàÛÉëj/ñ䊤Ü.Ø­Jõo;yµo'¶_ó5ʧQ?Úíò÷“‰+ý"_†‘â1ý|çøNû Ú#Öƒ8ÚäuËUÏr¾Š¾;Ä{Vmå}E¼¿å3üŒ;òl9ÎyLÓžÒÒ±_ž ¼¯ÿÍñœÏWSåË«^{Žc£Á áùÂÏC¹§þÏÜ;äÒ†IçÑóºKœK]3â£à§ÌDË©3Ô ïãgÜ»c‹æ îã}ýIª?„À˱zü†0ù¿ä×É?Å+‘;ûÎ1ás£gyþðJÎ3:Fy–nôõVmÇU?§9c ?‡úISð§ÞšwÜÿ3‹Ÿ:^Ϲ„nSöqì¿çså÷ÄÃàí¡ùï÷ù¹ðmÊ'è¹cCèg‹Ý…<$îÔ|WcÅùsÀkY꫼$<3ÿÑ=òDôI“Ûˆo^óK±tò[CºÂãm‹Ý­»=t.Ä?{Ò±W£k”·¼ þ€¿‰Û«îOÂHä¢VøØÑ|‹ö[Ô‚ÿ ÓÐÃ~Cÿ³ŠS~O²åïžä›¢{ˆ‡OÒOà·Ž=€ýŽ¿#{=Zø?Yö¦7z˜*ž¯”<á²ýÒu’xø©î ì·zQqqFb®øh-àöP8)–G^¼úKŸïw4Õy #Ÿ0½?•.^¤Aø¡ò…èe‰OZGݾr5vÊ!>üR¯êŒí7ûŽ|n´ þ$es0 +ö8}8'³X|Üâï ÿ¨¾¦^<¯÷ñƒ?¿¯ÑAócâÃ~Z{8S¤Ç͵×jq@ÉñæqnUM9§ØD}ÎvòOVñõw–ý¿<èê$þ¬yâ‰) ß7:‹÷©¹ëøRò¿‘{ù¾¢"ñî ~‹qnöÂ)þô¡G©Ÿ–£·¾íÂ5]ñ—%ßò·ñ«uIØËQ͕ފÿ*ià÷o¢þ͉Š'ŽÛKÀµÑ¼Ï 7µ·î qeÝ䤬“úB—¹Ú —ƒ‹"/×»‹T/+'/R+þ-_†úUW€Ë\[᱆ïI¼§¼q®ödþÌïùÝœ›©…öÚnÒœô·èIÖ!ÙÑqø›ÈÕ¡*8GÏ<>?ZN]ÂìGþkŸ"Ïå¦zîpbXüxá+xNäÍîG¿áÜbð>ÞàžÌFÔO 4¯)å<{·`/³ïúý⩼W‰æ>â'äŸïA¿Ë}Ä‘ õÑmä¼í%ȿψ߭y‰:@dŸ3v/õ0ӻرÈüqÑbú;ª›iïÇxð¶sv1T£=6Cÿ‘£fM¼îÍIIÉK•_íÉýf>ˆ|—¾ÅùÕuÄž[¾ÇNDR¹Ÿ:¯æë´/×ü>8.>òõøê]È¡§/rx ¼F<½‰~Ï ÈS`òŽ´·{7òV¦ù¸’Û¥ßvüPÝïà¬èýø“{µÃøƒxàˆ·(ˆ~„5ï¼’ú´ãGâÇÈzò)±¼—½;`„ÜŒ¼™ý/·*^ÈÙCÿAÖYì¡Ë¬~…Ûï!+ˆ3âeM\DŽ3ˆ‡òúҿ渿0#ý›´jèËW'Å«ÕçP¬¯æØ—ñ^þjñ^fàoî] þ.×ÜWçžïá¬êóŒ?OÃ;B<áIòç?s?i툓\åâ#N`g£Ct.'¨Ëøú¬K‘SÿãøÁâÛˆ'jÅWQÔ »ÌÔÜg†ø4óÀÆ?„V/8z(¾þûôˆ·ê¾ï€ùê¬=ÈÃÕoÏbn§Xû<¹Â­…O¼çí+÷üïƒÿ³ÓØã?ȵ©«ò¼ªk:sÄ“ýza>}JOÁ猻eFJRøgñzhÍø.Ä #×Ò÷fKÜWû ö£*ÀyF¦¢6ñÒe6¡?¤a/X¬{6îCø¨êv‘¿ª^ô¼HÎkÏ5FrŽ‚‡‹÷(ö¾øŽ®ÂNÖì@þ¬“¨ûZÄsTû®òþ‹yÿx-÷ez^þrøuòeš÷Ø¡üÒ_ê7;<Ä_ \îW]4@ÁÏð<Ö¶R?²ö^F†hžêeäÏõzÖÞPÇ%î·ºûœ/ûémƒ‹›À³Ž™² ì^ìä,Z§ýÎCG§ø¶]7sŽî\ô"çcò4†9ÊÎA_"w.;qGèWÕ·ò¨GæÞ«ºÚÄ%¿#–bÕÓ¬Ü{ÝXÎÑø‘æÌ©ß·{s#G©ƒ¨¯d«ÎR·“ùóNõÓuOæ|L½ÂÝ‚{ wä·{âÍí¯MªÉ/Ò^çöAÅ»Q¯Ó×â-ûû[ð r=¦·ò˜µŸÕ¯¹Ë Å»ãðW“ÒçT¤îd=>¥MbŽ?zQóZ;ÑïÄ0p™ûyì]ÑðF×ÿ,? —“ìÜU yœðµè«õ8úb»ûËi%žÒáô¿–i¿ýåš“¾GûŒVR—‰À¯…ê%Ág®§è«ŠãžEèIqöÖû¶âÞVÈ¡s¢òŠÏ3/×^ósÜwÜ ~(Q_`íeø±ò0?_ûšæã^GžlâÙtœáyGe±¿ ïïgäÓœãÐgÏlî¯b÷VÝ;ÚÀ{ç8Kÿ¹U|À‰ÑÊg\…òoÓ{ŽÄnúŸÿ÷ÎÑý#òXÕí?[FÜn¾¾…ý­ô¢Óïd~Ñuм ¯?ñ~]{Y‘ßXªøo6·[¯#žÊÓ\uÜ‚Ÿ÷šµOôMêÉΦÚW¶ŒïMd/†["ÿæ÷©×UC|ïýƒûõŸVzPsÞíÐÏhù¢ õc„zªO³öÆÛEó´oEñQícšïÙF>ÆSD\ßLëþVü_ó¹‘YèwD¼ æùàÁQß³OuÐ8朋¡7áõyUi.ÅÆžµêœ»ãNñíuÏÛDüBèUÅw’§(W¼›1‚¼èeúÌj¯'^´Å^¦tÓ¼òîΟä÷ÞS}Ä©~ýEøû’µêG©DŽ=¹¼×]ê“&> ÷[¯Tž)ˆ_ŽIÿ}šksµ@žÃÏòy©Š—&Ûé#›r¾»+©oÖþàiÍð£]þNzrRú.#⌠P¿Ç³âey“zXeþÿÛWtM£F··úO޵OÓð÷B‹Ï¢ ülËy;Õy6£/«àEññ,Åÿ§[Å ¿_ó=Y|¿G{S²ñC.å_Ý#À±¡}œjïi.Ϻ: ÁJür–ú)Ýݱ—N剫'ŠäV~Þý·æq¦jßûð„ûnìK`ø1RKþÑ»ýÍüŽþÎÀ§è—ógîßü!ö7y3q¥«ö9?¤yçù\£öÞÚLØy×fðpàpo õs‡æ#ùøðm|~p,ç6ý/p«ñ¬üçê?ÁSÊ+ä"çîtΩÀB>=ß§ýêÚ[_òžæÌ¾CÏ‚g9¿`>¿çÉ@åÔÿË9gópT°;öÇÑ|Láaú-Ëñ?^rmJW߸ûë˜-¾Û#ÄÆ'9'¯Aûaw¡?¹Ë‘ƒà>ßÒ‚s()¢~š½ ûV@nJ÷¢/¾6à6ï•|Ÿ©’sžadžÁT½ÿùªP[ìnJwð«_õÚÐƒàŸŒ…à‡P;›±Š¾ÕÔ/À‰¡WöBJšp¾7±ŸÛxO zàÈW¿ÚŸÈEp6x#í/äËØš¹ãÐô®ªT|Ñ}ˆ?,¯3‡í¬Ãn…ÛaM æ½åà–ŒqøßÜ?˜ƒ×*ßó0çá»s+ù¨, ?ïL—ß‹g½‚)þ \éœÎòìÿâYžÃýþ;|½ i_½§;ò¾”y˜àÍäkL ?^í·s¬æï–“È¥Oòï,GÎ\-Ó¼œ›!GýºµüžÿzäÖÙïÏy÷4)_Ü—÷-ÿK}u7hýyäÎ{ù ¬ÀÎ[âsZ ?‹!Uyqí÷È.Fîg4o·€^"匿Ó^ç v?r€sÊT>±R<ÉåЗÐ[Êõæ=‚ä0ï&ò-î™Ü¯ïôÑéßø?â\â¾¼Qp¶©÷8‡<9òÄëÛû(ê þ÷ð®÷(çú"ýá>øí¬"òoÙ‘Jß­½M½¹§*Í×;çã]çu·aÜ#nÓ<]2Ïgí.ôÍ'o鹑ó¶ÍíÙãAê;i©ýÝK5/ð¬úØIc¸+e¢ø›[÷ñ5Ó|²übN'ì‡ûwòai3ákËü=ôày¼óé»si¿iN68ÏœAƒ»÷fÑœåUümn+>Ͼ™Ÿó®—}œ¤syŠó²ZÐS{äËrxÏö=þÇÔ_ûðV#¯¹>üuðô%ו-ç9Rlš§<‡ý‹LÖ9yÑ»À~ò°Ö"ìP–C~ø7ñÛ¯¦¨®›¥>fß6ñBhoYHý |Ô3­Ç8÷òôØÕw•‡¯(ç|T9©³8ºpÎLüJÙ¼wå柃_"'‘ìj™ú4œWs¾&?8Æ'rð±÷uò¾åØ—ð[š³_ 5!,ÿTèü¦ýJÅ5ß wž£>\õx#½{죽Õ²Cuèë˜ñôÏ çÙï‰ȋaúãTŸ«½‚ÏË`w‹GŠh-çè«yoí *›ù'¸Ñ!žRÿ½|Oè9ÙóöøçÕzß|övßÐÿny¿”3›|®q&~Ëø¸ê‡§ÁñÎNâ ùÎ\#\w'òiÿ¸0ü8ù _GüGð ù"ß<Þ£ì*Î;|N¼r]ù9ÃßâámÀšg ½Ì¹–¨ᑞ½‚ß3FyïÝÔ­BcÀ‹¹g¨¯:¯ÂŽ[Ö½ÈIF ó(ñV8ê9§ñ-±cÎ'ø38ýJë½Ë8NYöæVݹȧe±öƹwOö>M}{'ïkj°g…äw|/¡Ÿ[“7÷jï­[}ZÆç´ŸäGþ=âR÷`W<×kûØÿ3ø‡Àyìzn*ø)ÐYs >ñÛL“¿_ƒe=‹œgÝMþ*û,zê~µþŽt}Ïýû\ª?g–|'Þ’WÀÅf·xg{iŽ÷GüMÊvä,¯öÉz”{q¾¾ýÄý:ºãï³ëxîùa‹ø-YšG¹½.߃Üú”çp” Oþöâ?ëEüi순:²x»æ¿Œ±gî쉷·üŸðe ùåÐDÞ×y {å}hîÎÖ·å*/V>}+éÁû8g¾×üÿÕ¼¿Y{×"ªW_P½ú!~~ÚµâIçù]]ñ…ï!çvíW-¾Œû6Nðsi©{÷‰¯H jn¿a/G‘öª—Ü üÖ7¼:©çwìoò|œäj…Ÿõ[лð ØÏP©ö«fóœÆ¯Ð“ÔAÌ[Îß‚â»2=Þ„Ž ç#Nü¾}^þI©qá—gµ"¹p¥rþ†³Ì9†Çóæñôå?J}Ý—‚]6\'¢y·Ð÷à›Îç…øÛÌÙØ• òQþ3z¾“Ø­ÐiôoÊfäÚ¤~œð ÕížWüü&wå}Ìê˲š5'º ½±‹ï¸r•êò‚ãrÈ“'Orv‹öB5Æ.5ì;RŸ©sÿîqwÐþ‚ì Ò»ðC^€ÿo]Gƒ×Ë9Ç¢—eâÙ÷õÁ¤Ï§æü ÈÏš^GΠ핳`½ÙØýÔw¨/Ùœà¢À^ò¸ÎIȱíSú«B]ÔWÿß®B¦õ ß9¡zñfõç?¦½×ò9ÓzÒÿo¹¹ V`ÿ³°îi:Çï4§bSݨ5¸-Gõbû<íþŒx9{?u>ãÕØç”oék4T¯ˆÄ8· öÖ„´oÒ?B} ±ãŸ‡ï$» úY•®|J?ìnEù Ídžp.Vñ®z)îºüï’|ÝÇŸæšSSùM£ö#¼*?TÎ=¥®BN*#?†íÄSñìø~ä|“âä#BåÂÛ9oß6ô$ø°üóä§‹—Ê©zµs‰úõíôÉù?àüaâÄðÈs¦ûˆ~äN1N/ûõ¿¸ <æ‘©xTq·C~\{È|êkôÅÎ;•_ å^*jéÎèÔõpñ—ÿÙAåœÎÍ~ˆçtýDœš3;cS¿Gñ^ä ê3ü€ñ9Î-e–òM¹?ëóÄ;E%Ìë”h/ªWùÜ”*ê‚¶gÅ#= ü| ü°àÇ%ÈeÕ:ü…á}õ ¸ß úUƒßcƒ{xxŸâEplkÐ#ô°ÁÞ¥|DÑÙˆx9¿ s•¾±·¾è]Nï“Öû0×s®RîÃs{žÖ;œñ­æH!Gé§9‡<åÅ‹Gˆ¯é.ô9½ÿ¿j/õ¤ ÕÅse/‰C{êó¦a7LuȯE{n\“‰‡‘o×TùÍÏUnƒžä‘ž¼‡|Øße>=Góê)ˆNóÕé÷h>t…ö¤ùìך›£Ÿ†YÄÞ*âãä'e"v°TužªaÄ—¡aà|ÿ~þt¬¥îê/Cú ò>YC—¿N¨èÇ=äkT¡p–¥'ñgI’x!´·É·@uÈÛÀu9¯QŸóÒ\š ¹4õ#Î(X‚ž;ºc_ eÇÒÂäj.ãop ïEpDn6ïY|„{‘É=;¯"¿V©y`K5¸ÑwTy, úã(~ËøS‹MqÿsÄ' ¼¼‘ èCÎXúeR¦ˆ¯d}|þ…ø!§æ'ŠgЇñ[ð‡!&?y9ùçZžÛºH{w÷àþìËù½Ðuœ_•âv—êy¦UâGÛ.>÷{Õ7¾™zCuôÊz”÷òÿƒ|E®ä^«[‘Ÿ(Ÿ‹|$÷ÄîeöÁ~†ºS—p4Ü«ö(¸w ¼¹÷“Ö¿\}r pþ¾{ù¹Àä>x¼ŠsÍ8~Éî?oi'âìâ Ú‡Þ •¦|¢3ƒ÷K 9Î_Ñ7wv,£ ¹qÞHœ4ýnø'L»ñ÷(ùßßP«/^}è—Qó4©Â£Ž3Ä£ŽÍä £¹ïÉâ•¶ âžúÍýïá¿­WPOóÜÏóøãÊ+žÃÞ´—!0ÿaÿw¥ð¢WyB{­pÕÔ«]+ÿÿ*zh)žøtÞ+ ¾[x sRõ9ËÅWù"ú™ßüå·þ@|¥øÙÈQîݰü\1Yñ[6rà±i_ˆú#¼&å»O(?©ùïÐïè¡Bx²1v12Ž÷‰ù>ã-èµ/¸¤ðö<ô)8Ú?@ó%ÓS½j™öaU¢—ŽbñFf£õ·…×ð¼Î[ø³ÜF½Ê+þ¡°Ÿ{›ª½iÓ3¢ß6%·£Oñ–÷‚ÕØeïc|~ê~Ï"^fG%÷=u}òA¯pÔãÔí"…Ê7FÑkóÃàFï!ÎÑù;ïmÙŠ}ÏP½_¼©ŽõäÇÜ×ß²æ w _Š‹¸+oþ³¡îí¬“½ZAý<£JyË©ø{_òo¡÷ðsÎüC¶ê„™£À!)ªÃ8~æsR‡Óî»ù.§ù õ“ WWÀÏ­ÈSe= ¾A^>Gó™×’¿ X¹Góøûté­¯›xo»pñ ÇOšo„{.x"ܽªî(ü½;çÍàžÝýc}§×Rÿ?¿žÿKî'Ø÷3Œ‡´WØývÎqv/»!oÿ·ö´¯Ð9õ« ÆŽ˜ÿT?P»ãû—{ò+Þ¯˜Íý¸RßãÓê'hÌùZÎ ôÆŸd=@ßH‘öìºÏ(¯ržç ]‰]4¦`üŠçó¯¤/Øô çbY§9?í}K¹OúwZñmÃ\ÞcøÒ‰ê/ÐÞß¿œÎãàç›â㙂ýÎ8Åœ´Y|‚¦uØyãàOµúüúòœ®ß‰Ó¬]Àï¡Sø#¯iÿ³¯‚ç0i^­èQÕA+•—¨¿á½<‡'W^¡ýªâ¡(ž¯ü|2vÀÛ[y.+ö?R‰]7ÿ«9]íÛÌx ýö‹‡"å$~ß;•ï-Ú î46„[ñ}v=Oøzôׯ}[ž[ÿH’ø|=·;‘[ø+îC¿rKÁËOiÓfìš»_ãÕ3ÿâVäÂqzï‹òü¡sïäкž80»ýs|Çý…näù‡ñ'¡îàºHqI¨Ž¸É5Kû¨ dד¹ÿVä,UùTçHÍIl¡ÏÑžÍ{[caÓî"?g¹ÿæ¸Aþ÷8÷”6}.Ôœ•w´ò‚9²ãƒ”ßÒ^ÀRí+øQ}øÓuÿÎDÎRU'-Wœë}Xsç÷ ×þ_5?µ y½˜ä9¬o«þ.;ùQ}y‰Gðk‘jÎÏq@}úg¨»š-ðÀ–žÔý< ùéZìFЃŸ) Rq‹_9÷[âÆIc¹¿ðÍØmÓ×Ä9Åw“rßɽZçjÞ±„oÅhJ¯´MTÄÝ:‡„ûK°Ÿ­¸'ï5ıþ°ó7ÀÉnõ‰†æ{Ò^` 7Ä0„¼ªÿvåú"o†Ýª'ŽW=_¼®'¯Šù<×´÷È”÷G#êë ܉½rQý·'s*ÉÈSŽð¨å÷íµã¯ì­9wËrÎ=w~Ê+<å=¡yÕ®øË´·ÀIS·§ÍRüÝdkÁÉm]’RËÈß9N㇚—ñß„ºN)¾ËŸ¿òv‹9·@šú¿Án{>á9§ïïâKÈ£Ÿ[þ ç¼…xÉó½ö±?#¹Ü&|w+}PŽñªK&ãÇ̪8µ×Ùcå<§n„—+æžì‘ß«£¸Ou´¹ØAÃyü‚ý:Í·¨Þ;–>‹ï¯Š¨N©¾³H-v×aAÎ\M©G5¿ìi£y¼Kè•·<—úqg¨1q¹o6~´Tõ¼ÐçÈ}Z÷¼‹¸"ex”†ÿ Ú°Ÿ~å³Ç Ùwk{)çä}¹´k_@h¿WÚX{n?‹ò’Ž¶È“'»àþ[ûЦ Gù-4¿´PûToµ6á÷ó5¼‰óì”?&»­=½á*ì©ûÍ¿/ýy€s6^K_–]ûCxÏŒwÈDþT^^|ùžªwœCÿý¹ÿ å;­ÓÁiázü›óÍk.ÉaBîËÿÂÏøÏ!¯–ñÈiEKô+ãGòfÙAåÅzñ9¦¤ù‹ÿçúI¸l÷8®¼„ò‘Ù“8_ëzüiÙiÕUŽ€ƒsnà}=ª‹X¯Qݦ-zå_¡½õ׈7¯:þãÜcÉÛü^ø#îÛ+þ”wúG:[㟳5Ÿä¹¿W2y®^Bü:(̼mðmðJ™êÔÙ]ÿ­ðV¥µã9ŒšC^¿bóù9®¤rñe}Þ›¯F®ŒTŸÚ¢ûqˆ—S{ý‚â7w‰·»üiÅ'Âã®§±ž^ÊCÏžûsîÍUçÛ¥>"õY˜y_ó#ÚOR¾–½¡~°*ðŒûέ¡_8åî±4ŸsöžÕù/”¿Úƒœg=€œ—Ÿâßs–°Å[¯þª¯µ§÷vô·ìS>?âT?Vö&íέª9÷]¥:Û£’;³ú*ñ×ñ2ûWùì’?;çîÚ„~–T?·jŸ°øt‹ÕäûSù|éQ¸‘~.Ey½IÈçJì›åò¾¾ÀÍÑ”‹Çqçâ9©z= ”qö‘âi¬ç=ÒJø<×5ØgûÕœSyï÷žä{|{ñC®µäÕ½5àWï*õÝÆ‘gŸEû›ghïy!¸Ð1€¼‚ñ˜êxšoqÿ«<òHí£Ð<´ÉC~ -ùÉ~‚~$S.yÛŠ"pdÕ+êÒ\™¥ÜgÔþ0ŸI{ÔÇcÿ~*Õÿ÷ðž©ëT'÷ ¥/Èî®áüý÷Èo/o¨Óþ‚þ䯺ÎxYÚ¢¤àìzU6v6K8lºø²œ÷G<§ÁýÖßék ÷ãç};x^[Sì|ê âš@þФ¼UéÛüžm‘ú½–p¿¾}<ŸUüþÃÚO5K¸Aü_;ToÔßCkÿ>ˆ LFßáÊ.©.ÑŽz‡CûÒ\ok¯êý­ sæ‰ÿü÷(.=¬yì¾Ìó଴¼—eú×é½ßážýÝ牬¢7¸Êá /ç½–ûɈ‹h¼úÄ?R?ÄdÅ5Ïó|ÎïO®Vþ£Üâš!^ߣœCp4ò]Jý>ü¸žëSò>¶#êo~Qqv+òaFñnyŸÇzåOýØÛtìuÊÈS`?—= »]QÄùTf¨ªöÑ#^Wí4^à|ƒ—s.ùÉäí7ãg,_"þ!ô ŸÃN_PÿaáÂý¼—çÅÍsÕï~¹ò…ÿ€ÓK¦+N< î· çãâeWþÃ5|jú#Ä]FòØšÿ*Õ^‰Š{©›ùµ7ðžôôõ7‡‰sÝ™àïÔtæfË.U_³Kûè3Ä æ,Òï·Qß÷-Ü«Eù¸`?ü“ûKå)W /¾ÍØó áxãqü²µ­æ2„“§ÜÀÜó(~Áó«önô&_éòrÙSynÇ@üFÕ]ÚG´N}±¥ØÝ/ûŠÏFû3 IØ=__â¾âgx^Ï;z¿ äåÂÞBžÃ0M¼„‹9Í?U­À/‡´ÿØø±Þoy4w}K/ˆÿéë'à°Üá«HW¿cέ|%òè+æ~Ò~Оô³ª§Ïçý]ñ7†àúàñØïGNÏñ}A£øË~Q¾Ô$ÿÚG}É»ÈÓºì|Ù ®Ï;L!ø'ú–¬ú¦ùÞÓ’,>måG,šÓvvQäô;н 摟ÌÑ>ì ñ*ÛTœ´|fÊ'_bRÝè<~.عö¯^n¾5socÏü}¼bN’AùðàwØÝÌò&õiça?½kЗÔÁä‰#°SÅâÍ*½ »äð¡ÁyøGÏLðW°­äÐBþ¡èZìxŽp|•ò÷yéSqЃ¾Ø+“ú0¬ø½`gõM¨ßÉý<ú•ò-ýž•ÕÈ[ú]Ú¿ºV|Œ£µTóy¶÷ñVÕL;‘‡)ê/v¦ó{®4—±œ|J¼âsï%n« +/XG^Ì»»hè—þ•¼°ù-pqQ˜>šÐ6ôÇ[!»Ø‰ß³j~* ~µœ2â÷àÓÈ!ÿ8OÞØXÃ{˜_&^óîæs³ÅçgþZóGÞß·Ux±Žû)=Æ=úBœgêS|¿+Èç‡*ÁÍ®žÂ•W ‡Æ¡Ø¯Ð•šS½^ó>eü|ŵšß}‘spOB®‚/òÿ}“°/EÈwøó}¥šÿ9HýËÃdiïÔN×ÇÇî¨ùÿý®“Ø+Ó ä¬òU¾×0]ü„×j>x’ðšö‘…ÿAnÇ~ï2`^Ÿ$£äfÆhö{y3ñgVí1oè§3ÎRßÏg¼·£ xŸÜ^¡xί8.hÕ$ÍÙDkÇtpj†xŒR—¡‡þ;‰7‰wg ç”®=\Î;”÷¯™Ù™n$_Ÿ}58Ù;„{ÎœŠ¼˜Åàoh1çš"^JÃ|ù‹G¤7]É –Š4’"ž/'qXÞxú’Âqõ_ý«|»ö†¦W¿ï½ŠçÄŸUþ8õW[ôÅ´8Þ’­}b?ã÷üâ­Hïˆ_3|ÄûŽÉX±½ Ùè$ÏFÞÇëÇ:Ë‘s—x{³¤7æ2õ§¶×œÓUäï2Ga/Lš£q¿C~²DûâÜC±Ëž–¼¯õåÏî ¾þ©œ€^¦bgC©èQÉìlê òѦûПÕ¹|^äÇ÷Œæ¼~¡¿%xT^«8Csh»°;öäۊ௟ç4þ$¾xíý3R_u3ô#/…÷Ín°=iÏ—¤úÚ$ò!é+8ïbåÉwbŸJ¦òùaÍc•Á}§üÁ¥ù°+¶ ò]Þzüµ/÷´D5çÑ\jžÉ½x^åù“¿×žÍ1ªxÞÜÞÄߎàxßûèGYò—ƒS§¾¡ýèoª÷wìkä^õG ÄOæd3Ƕ˜8Ðß•Ïsi?Phø!ÄkeÈQ=õñ`GÀ•C¨¿î'•Sßf¶øÝÈ©[ýaYâë ÔÞ„eà9×ý<_տȹg¹êÔSù\o9ç^ø&õ¦òÔQÊ‹•/ÿ>8C=ôÚô?ƒ{lå©nUÿo[ü£Jý„¹œWð}î=ð.ïYæäÞ³g’_s‹Þÿ¸*ò>õ¾x íFò‰VÕ5Z¡Ö‡°;ɯ1Ïâ; ~,Ïi¿TÞ1ú¥Lâã6Ž7‹ÑÃ<+}º¶”—jè¿è€ŸqÍλLýAäÛ¨ûs' Ç~Îóy#†Ýà{ÇZγlqQð3ͳ|ÂünV6ñû¨æïT>ýjÙÙ¦¼—ï&Î)í/ò'…DZ+yÈCá*ÝÏhõ¥‰—¯°ú“?šº~Æ؃2Õ•&Îfï“}»úMžçy]gÀyýµWx.çUx œàv`žú²×!ßÙ? W¹_ò^zíÛq‘ϳÉ/ægÒçYIœe:£ý‘o#Î'WœÂ®d$·dÉÏmTöâS«ø‹Íyêø½÷Ë®x2ñÇc7 ‰kgÁÅ[Á#£ê×¢§™êòþ‰>ypÎÖïÄ»p ?W:ÿ㯻»?ö+4Aó@Ï·È(Sþy¹øßµwÏqDóH¿«Þú(u-wðIø[Åq¯ðÿS¿8Îó÷i‡ŒlV—Tš©8!ϽQqáÎÕý…âé¶Ägé;8·pýuÝüæ. tôÄ.åß„ü”?K~%|=ñŸc1¸Ë8HøAó%®Wð«ÙwrNâ½sMç*c7¼‡”½È졹‡l½oÏ™2ëÞ1¦;oIšò y<ûð”ç/â?ÿ«Š‡JñûŽ™â͸›ów^Ž~…òÕy€ÏM~¾¼Ð=ȕ۠}gÀ}Ž>äM˔רõ&í;AÞÍ·•çÏQ~Ü´ƒº°ý=þîÿUý×eøï òîý•øÊû,òaO‡Kzœ!žœÐFÅÓ[Uoò€C{Õ÷ò z/hJ#Þ?s-~Þ²™óÔƒB£ðofõÓgwA.¬šó÷]Ô¾Âáš‹iL|_qJùícÜ£7 .ËJâÞœwàw3TO=Œ?ôfrO¦nÊ-W]÷VÍÅÏg¸³´zzXÉùû†coüüüðCìeM+φů︻a^¤}ð믩ɳˆs6‰'µ¬\y»á± ŽU>»JûÐÄ«mU_yÚãÌÁ»š‘ß7ÎÓÜnOî£Äîq­å^ÍiÁ]¥÷›=³Ø°ÇU}x~W>÷ë{{ît)/[ÕŒþ ÇÎÕØyq·àÜ훨ekþ¬*[üUüó­ÈwæÍØËnõãŠ_¦B|¾FøÀƒèiXs9icé+§b§KÄËkšLüé6ª_ÿgÍJãÄ ./÷à-å}3–â¯<·+š¤<äÕŠÅ#þŸ—¢¹[÷2©ƒæâ~G>?‰ëCìX©Eù$áºlíÉ _£>çÈoö•ØOÃdxBücÔ/zç¬Ö|­òŒfõGû*N n.8&ž¸WÔï5»\Þ¹Op®Sð}…¨7çi¾À­¾·YÒã>â5È®ýŒ|Mž ¸óì¤å¤ê8Î;ïoÕ ^¿TPÇ îÓ|ÈÕô¯fxÐ#û¿è»ã*á‰lì—{zÚÆ{NÚ ùã±à¯IMàc²]"ÞówVô%ò¶ Å;š7÷›µGxÅ’¢:ó­Ê?_ä\=j~¾—«üoI!y«Ðñº_ŽŸKýø8óp²£ZuÍ[гÂçÁ—5ØÓÐTìEÙ?àE³êw¡éâ×*À¯×"¿Î*õ¨ïÎ3»ê°*ÿõ~Ü‘.ž^Ã@ÿBÕ¹'jïí5o ~;€¾h]x5—¸"KñM¼1ÞRáó4Þ;U{à½GÅ×à§ñ^žÇ°;ÖÔÏð>ÿøåø[ù!ñ…ò>&ñKø_SþòJâüà ègp©äå6ñb¨^åø›¸ÙÒ‰û­g¸ñ{™ÇÀ·Ö âõ×Þ>kñÞŸeh?¢ïVõ§\«9„‘ܧ÷ïU=D|/·+oæáï¥Éè¿GóŒ{ç5Rboô»Hó #•<¨xêò•§{wÌÔ<õÍ¡NÇŽ{/W@xßøz*$άhÃûXè‰qþ/s%õHK>7cyœÜmà|O¾ðÚ*ÍGŽŸ4õ'^v—©>&|šÌçç÷·»Z©¯VýžâÃ06ðyÂNXìàI‡x-Š{3ÏÀÏä .)>‚?®è.ÿþñh’—|Sñõø¡âùš Þ„öŠ_;‚= VsŸ¦¦È·7÷;†ºKÎ`âGg+â(ëBžÓºžÏñŸÐüçdä¸x(xË0»R8™8Ãû«æ0¯âù—TŸ¯'_3å8|îFŠƒòé“ó?‚>oÇ|rD{ ÍC5?ò4þh܃ð·[pÿfñå˜gá_mEâî¤üøB¼"·S¯#ZšÏsNÑÞ‹úq½ÂÚ_“w |6¤è?ï×q}’÷jðpyùçóšc;Œþï#î®Z ºŒpB‰p³yz;ôcöQ»ž•ž5£Nœ~¸1ï&ô%ýMân÷àÿ íc)þŒ¼CÞ,ÉËáöÓÚ«{‹øêöÊŸõä}J÷¼ŸƒÃGÿ„ʺ<˜©5çXƒ]OÑZV/ä$ìÁ‡n㾪ö!OÆEäõ‚Ä«ÔZó†õÔÍ}ÀGžš‹ÓܧÕÉ{¸7⯠çÔ9ø!ó;ôÇR¦~ב«à«Øaÿ ü¤iŸò(uĉÞ©c¹•§Ëæy7oµpÂÛøébÍ {ϻʞ%__4Ÿû x±Ãnñ0$?Î*ä*ü„æ}$ïÙ?°7=tù»ø,4G ž*w˜z±}¦êÚê#tÌÇ~ó±Æà|Ï ä­]MÄs2û¼ ;T8ŸóÊé>syÉã9\šo} ?áÞŽsÖã‡&©NhÚÈ}æ4Å_TÕ¼C€SqtX}*[‘kcúC‹R}&S}(í8'ó"ð¦[ù–òýø}çÕÊöCnmvžÃòŠôü ì˜#„Ÿ¶ß‡¿ÔüeìÖõ,Ò›=øß´Øyûð½'ñfo\–öL[µiøˆé¿&Dþ‚)Ê'Hß½ò/^í±­”= ¨7ãìóÄßÀÏ ¶nä">âò4'ó'ïüÎOo§~À«ð›>õQô{yo¿W*Ÿ¸ü]}—øô´7#t?÷x8Çr9K=Ì9¤¶Ã?Í(g6’ ýŒ>…Lâ[¼‚:™ÿyÞÛÔ­G T5AùÉz~¾¸›üaC?Óà÷ü_À÷î*á5ñT4?êмƒûîÝëÁÎäª7W¼Ý!Å‘cµ_Þ±_yHõc†ïçs‹¡ÏþTÎ5;,Þ‰ ¼GU%y{ãÞ¯ø6JÁð8ù†´£Ø‹`oñ ˆWϹò¨-É[æ ¿ykØà–õFõÏŒ%ÿ—Õ¼g°ËïÇ®–ˆW.ÔDñçÚÛ©9Ùª«è—N×|€ÿò^þ=ú˜ÚœhËä¹ýc‘—œké§3f!÷eÊÛ¸òñ?©ßñ¾þ{Ôóšø¬]øûœ-ôÇ[‹±¯™‹ÅƒõxÏ?ûT1Œ¼‰÷*ôÀ0™9º´OøÞpOô:¥ñ³óaîÝô½âªüÿ4í ¨ZÂ}¹¨î|úÞü·…æÖÇq/Öœ¥úÓ¿ g;µRóâ9׊X|£×`G|ëxï ó§-‰Ï+Ò‰¼ê/ ÎQŸøªË®â¼ƒo‹§s=ù§ÿ|Cü_âGÊkñ)pih(÷oVþÔý&¸4Kóá¥Ä¥éêþ|oZð|ÅZâà饚§¹=tÔO´ ^O±"?…/¼kÞãCôÄp\qûÅ‹vü«c«xïæÞíâ3 ,T¾a›ögoÕ¼õIâó)âÓ´Aà|çU|ŸÿOÍ5jïhp—òç±Nõÿe4SݵŸâ´Ç‘'A¼3šï Ü®þþiªÓôùÐ’ ±3¹?“ì©ë윧|S)?âÐ>¥ÒZõÁˆ?Ð#>™Ð7à¹lÍ?ä}€œù$ÿçËçg5Wµ"oë¹Aóó!ô;Uy ÷^pVàuâølõÅû‡7è#öËØ†÷1Ÿâ‹Šä³Åë÷ŸïY®yêóÚ×]ɹoG›¶ð^¥ÚûíIÁ>•=¯úÚõ™;‘ç´øÏôÐêâ^]™è­Y< ²_ØíÊ¥ÚçhTŸ\¹æ—Ä;dÒœJŽö@Ù]衟æë;s¾íGr>NÏþûàùV~¸<å9€´_>8ú0'¼ c8Œ ôSÿ]ño>ŒÝg«j=r쟥9þ{ÔWü2òQy·xéíèq`þÈÑC}¸OiϨú¸³RT'j?nh¼òQâQN»^&çBð[¹xÿŒAî­ê ùôvè]Î)új=oƒÿ3^Bþ¼Úã‚])ý;fÓ\ŠCýÿárå |Úƒ°Hõ°6àø`KÞ»|=Ïç[…>„‚üÜØ¬«†ÿ‡\“,â2ýLÖ¶Iöd'òm~½«‰ÿò6VÈ9éËQÍ õAîíUÜ·åäÓòy ç‡Ü»±¥öT_ð@ì†áKä°¡®¢Š¼¶Qz|s |ƒ]t^¥½ç­•Oï$»4œãN“ñ#Á¹âÓZI\jG\æÝ„^Vþ Öc÷œêãË7*¯¡|ƒõ>ìlfñUæ äÅ ãÑ'ÛpÎqjÝçµ$Ù—‚[à ßWÂçïF?Ó•*܃_É=§þ۽ȋKõ1_ÕkT¿|ËßÓ6cÏâûrÇ®™'ŽË¸ûàÛÊ}æ” §‘ïÕÿgàù#wp¿Á$å½ëÐË4õåþ ~pÞ/Þ‰÷l½šÆò{&ÍÛÏ?Ö|ÜÏÜKv3ÉçÈGN{ÍõÀΘ:Н4¬ý}ù½Òš‹q ×ù7ðî<αx õÜÐCè¯a+qœYs®Vá.s˜:Näaüw7øÇ2“¸Ê$;îm©½±/ižä'>ÇÞ¶a›øãÔ§>ÆóuSÿßzì¤;Y¼–Ä¿æý¿çßmâÿ3¯âžCêCLù¼g~›ûqý†|”o"Oãº_u²çœ^ª~î‰ÈEyˆŸ3´EÝè©ïUñbÂŽ7p^ŽoÄËRˆþ¥L"o/¾•Øÿbí‡Ê¿™÷ þ‰\ûK”¯MU~¸úï|è©é´üÔ9Í-àüS7‚£SÎk®çœ÷/zø½µ‰OÇ~ç\þ(çâÿ]ýwˆÇj0çW¥:QygùmÍ3¥ÝNüÞƒœå¾JÜÝ‹çqÿͽÄOäT?b•™çç‚32^þM"Ïhñ³+Ú(ÿ¸Ku[±·‘ üKóÞ¯ñk®¶ànë+’oí?+ÚD=Ëüçn?TÈ«:êÇʃmÀî• †ÊxDöÛ¬…ýÍ”¿²Š* ~®†|œg÷4&Úyë žm’òµÏ£Tû˃¹²Kš“ ÎßÚÃW Þÿõø£Ð]¼¿q¶ø7´W 2Y¼Ûéïp.FÞ³‡i®s rÜþ•Í&/‘}ySÓfÕ_&_åúC<9ûÔ笾íÔ°å#}âžqÿ0¯äŒh®4Sýó«™/3”3G_tæu;ˆXy}Ëü›wvÞlÅ?ž'o4~ý !§ö$ –Ü‹gÂUŒ¼¹Gâsïã\ÌW€£LϨÏy¤xü׊ßäœú€6â'Š{©ÞsøÃàmà Øe‹ö?šKÔ¢:@†x‹œ“g·æ5Wò>®ÅuržyÓUüœ•u{蟮éoâÎJ}+š1~¡üùPô%óú}»ñoVõQ–îÑ=ý„?-<=ñÏ@>‡ÈÇ¥k>Ëõ„úënQB{ýg±»é)àtóAÍ7mWÝçJžÃ!>=Ó&òž.ÄY©ð«)¥Ø;«_ß—‡]LÏ´ÓÈç…´oܹƒÏõ7O†ø‡ú G«/©ò#ìªMùË4í-3àûr·Š÷ï2ü©i‚xC»ñ~nÈqÅ`ò5¦îØwó(ä3[|ÿy(¿4‰ss©?꺳ÿSðŸ«Hý¡ªÃUtAî2Ç"†“è[Hý³ùÊW4–]:F\=ýMxÙ*´Ÿ(¨=ÏÞýâÓÉà¾2›§Oý‚úU ŽW†æSމ¯èäÄ7yÊ{H|;µW:¼îz“«übùÛšÓÒÜwè¢òlâ›vh0û¤ö$î*T_lI9zš™A|ë¨B>r&×±ÏÑ^€~àk×gÜ«£;z[ù9ùžÀBô§Ïߨýž{䧺kŸQ+ïVðDa˜ºæšŸÛ ^ ‰§åS¾7g q©gƒìæ¿ü¾y3ug)ö¤ðÕ>S]Æü‡›¡÷9É [5X^«zÖqáÀK {n°gåÅÃøv3å5ò§¾–ø… ö`›3±ëæ5È}ªx€L/ñ{9ùäWÓ»ªwð¹aâ^ƒ|PP§>–â©n¤|z?Õ;•? Tˆ§evÃÝMüb­ñ_¥…ÜOö>ô8å3ä:ø)qŠõ)äÇ^¡üÍÍ%-RßÙ\ñ#ŠŸ!ЙçpP|ð·ök ÿ–ÅÈQ®ø‚s&³ßÖy¥øAÂâ;™¢>å^ªý¬zü"ô0PÉç:å_\_ªŸé î/¼9ž$ŽÊzœ¹Ûq~ßwP|GÅZÍsy^áûm÷iNuÏžª|£ò7ž§ÕŸÓLÏÓD{ŽîŸõ×â­²Š)Á½ºÚsu€:§ÿ:ûaÏóµŸ/ø®ôèÕ?Æ §|~¶r/©åÜ[X}նŪo¦hž°Ü6Î+ý,qQ¨œºHέØ%ø‹1ñ¼dMÙµæô“I_){»Uµ<^ù™æ5Tç˪¦ï¢²§xY:ð\½øÛ4ÎËÚš¸q²Ã8üê W&Yûqn^ò~Jöõ7ñ`‹§©üiìœé˜âÙË¿.Ñü}T{/¿¿ÒYì»ùjí·™,¾°_ñ[9ÐßjíŽ=­úRñÃdþf1y¢€Uü cøœÈ£Úˬ|ÛŸKYAŸgÎì½Ys8%ÃyžÌ‹ðÿxUW õÂNO|‰º±S{ÉŒ•Ü«k7þ0]¡gynÿIùå¹wÏCÜ“1Ÿs*Ò^ƒòkñ Ï9ß,ì›· }ËÜÆü‹óá šK¨R?ÏyôÄ­8/ô.òk˜…?NïF~WòòeÊ—Z[ˆÿüzñü߉žº<àEÛyò|YÕ|Î$ÇΧ®,êš”óšø·®Ãîd›¹?gTû,Î1Çš">‘°xzBAí³{\¼ÃVä!ò±ê×o ¿Ä‰{ËúiÄ‹ÈcayVW2Ï—¬|rP{¦Gxcñ“y½ìQõã­Ð<ü@¾7g¡øÃ?%²:ģлTò%õÍðyð¸{öÐry?ÃÍÚ³ù8ù†ŠFš«;Æy'=„ÿ0_'|Â?U”üR¿gòüLûCG-%øa¿øß mTÏ3ò9¡áèåÔ¶à±á›Å¿D­«Ñ?çôÖþ8ñRÕýºñ@¯àsªÄOž’G÷´çyÂw«¯d's!NÏ^!žñ·§NgÒù’öÏÇÛU¯ 7C/Í‚²ÓðEìPæ]ø·Èbü˜5ý s/Îoѧ¿Z§>l¹Rõ—Kè§]õ½Êä#‚?b×ÝEÚƒºKühŠo¦L$ŸÖ|KÞjÅ;n¾Ç|·p÷ ôÎpŒüDèìVøVîÏFü|OàçíŠÓóƒâ=VåoÊ¿;þR?avÒ_ÀïEFÐ×üCøæ-õÏ|¤¼Óõë>É}/ÃÿÙGÊf€Ë“ëÕWÝ¿í/ÅŸo'_ïl~Ù>áMÚKbü »äì‰Í^ȽÆ¡¯y}Ø¿:¥¾Ü}ÜSi !¿B7¶’~qßoŠK4gUVƒ?wP\¢}v&“xçr®Ž¡œ×¸?™— 5ÔqV#/¥ÚØ.^£$ý^kì·ßÅy8®%¨ÃþT½†ž_–?‡|xö)O¼F}¸Oó}Ó;‰¿ê,v´¡¾›1½ñ âýBg$e?\}˱IÅÑ'ëýäë]C¹çP@þÄ®½¿¿#§ásš¡ºµâ6ÿÕšzœóN]޼Vú8ÇÔžÄEžC¼g(HœcÚ¨¼Æ,pPDù ïzÎ%¸Nýµ%<—çJp§›ú@ÆŸð+©‹ÈcfÇз4íòh¿[à)Î58Yý vô?bÃ^…_Ä®»c—sÌäÝÜj…øCKcêXÇs —ŸÞ/\¼—Ï }ý-mƒ>v‚3CÍÈ£zÕWQüíP¿¼¯•ê>jÏlGñäåá'Òf‚O|sÀßvíÕö¾Çù”½®pŒœök]È—é2ñ£hnøZñP¾ÌÏM‰1W¼†ü`Þ·äµBÏ¢_UÀ…õ¦«Ï(o2ß矉C1Ÿé2òì–ñàøò'ÀÍc&²—Ñ÷‡êa-µwèzì§}÷܇]¯ú—{LÙ+ý·ò¹•W!7¡‡Ñ›à|pVáâO÷ïØ©”>ÏtF¼.GÅ{ú'ïãQ¼²‹âбءŠÍØ«òÉÁ+d'/p¾ÎUâ±ÛÆs›ÑÜ^Tóè—#޽Ü[¹xþ+]àýò½Š·ÞSßчÚ#Y†=Möªÿõ'ð·Mù‹’AêûQÞÕÑ•¸,9yµÜÍyzšsï!í¿,^„·Á‡åk=דWðŸÉ{„5j\ÌçyOq¹âm´ÿ«ý-«Á•å ûVjîÿ9þ=û õýižÝ?O{¥| |åÄŽóصìdä1ÃÎ4ÿBž)ô=Ï•þ®ê ê Ö^ÕŽèW±9óþ­~Gñšy¶/ü x±øÅU½ÌÜɽYáO¬s´_÷üwÅ>åÖ#ç¡”]§ùõTîÇzHü°ëÑoC­æîWð˜øx wo!ï`Ö<â”Û音ª?Ï­<´c…úœá7=K¹)½ûv¹|È„$Û[Ú§w/¸±ð)â·ðž7e›öY8Á}Χ±KNñæV^àýÒ~àüÂéšïŒWþÝÿ2ÏxWý,í°×E3áô߬>á ô²à#ñüØñgyâc4ö‡9Å ”U¯¼á`êý¦€úª_#~©Ž¢g¦ÁÃÞe­º“æ@ü½´þ-î#ðïks#—®ýôs²”çúVý÷—‘¯öÌÏúk¯ òëŽÍÕ܆<Ó‘“Š;ÉÓçøT÷Ú‚™ñïV~Ô™‚?,n¢zsñxù&ì¯eç\¯ùKí= VŸVv!<ülüGûº¶cƒÚ÷¢zGä­Hó‘ 8Ú¸I{ÝoÉóèOVKåEÛin³µæ“´ß#ø;ŸW®¹°²gù3r‡x¦2yÿªç5¿¢=z¦ÄW–÷ÁwÖùÜgúÓÂ-꽃³+δ?¦9»wÅÓ4 »3¥ëVc‡š«ÿؽ9qM$¿b.üY ¹æ^êWj¢<íþ4täóÊ‹•—Q°ÿ€öj‹G)óô#e*yêÀ¼†} ²ï/#¾Åè3[þüSí#j ¾ •ào*Ws¾ÞÈ—£ ÿžm&¯›þ&þÐÁþzk?±Q{[7òüŽ„úÆä¾R5Sq­ø~ÔOàÓ>åüóä-|[xîªß‰û­'¸Ð Êû=îó|‡¿›(>¾ôMà.ãåªÝ,ž›gÅ?÷‰öÿ)ûâ¢Ýü8¨l€æ‘¦¡—nÍAVK|]5g¼_u¢Üo`…ú=W¢·NÕIí’ã@öÔ±Zy#x`XÎâÿþ{<)¨ØúkÎÿÎ)­@ú·Rý·ÀÓ¢Èiv ùß>ßn¢®Z«}'šwMëKŸ£m)vÉùúO²ÅG|ö%}rm½Q|µ ¸Çò¯ÄÒù´®Ö~…_‰?¼ìXP<{Añ˺נ¿¥ß‡ehŸe®øœrö_¬GüaÃó;>Ô~'ñ_;êÕ§ú´âߚΠ'!7eïé^kîä}åëÓ8ŸŒžà ÷Zñ %iônú#‹ge¦ø?ÃΦþ¢xòäʶU¼zã‘+{{ì“KýÁ3š²‚w {ñŽIø¡à«è¯ó+åaN8Îj^ü=ÍýÞ'^˜¥âM:] 5¿»[}xKT/¾ˆ?HsRï*o¸#‹ó¶hÆ{\ó~ÇÄü«öÊ'ñ}åo!Çîï~yu‹‡Á£8ÀðyCßxK§jÿæFü—i7ï'þ=Õo‚êËš£=ȳ‘£ò™âWßPZ?ê î‹à’ì4ì¶S{´üoó^SúpëŸÝ™ .1¼¤~ºg¹ÏÀ íGî§=Ÿ*þx;P®:Fø{p—o–xÆG Ö|O0Y{”Û1˜Ö›¹•ò{ÄÔDóf ÈÆįQRH_§9Ä=–~D\ã›§{pa×s5ÏŸ%ÿ‘ö±ö*¿®Í¯Jx§ökÿHÕ äq3“U'ìƒ)~EûqF(/«x4ý7ü–ã+âÆÌ?473Rö[õóÒ÷˜_·Õ¾ÔåMæbGòWÂO;‘>‹òMÈ{_‹exÀ²Yó â -oEý)3O}Óð\¯sß–bì[Ñ!͹wBÿÂ!õ£½G<-ôàhñ›]þeÜK¿|¸“xn4ç¸AûhÄ/yãŠÕ‡ê¾Zý5Z‚Ü7ðÆ9š#jÜøÅç6y'u‹° ÿ`z’þÓà"pJèü@äy~>»uCÓDí‹m¡8f þ!KøØñö"ï=ñõ~J|V%»×`ÛÄË<¿êÌãüÇܼ±ã„BSRzwò›¶zðd–ì¼ý/Þ'¯»˜ýùé Ù³Â[sßUšÃï~3þË|JõïGÄ×üâMíiðî_J‘ö)ÝÅûf¶¥¯3kºö¬ìÔüÒò&ý™•‡½(@ñ½†¾$ßlIþ'X¤|~ü˜Ñ¦½èóÁé“èköÌ^ÿ[õªŽš¯6«_®;òRñ8)Uö%ýøîâ=1ÎDB6ô+íañoQþý>âߢ û=³‘ êŸþAô;„ö‘GLY-žüaØ5¯æÇ G«/Y}CåÚÛ`i‡=È;‚¾Ø? ?V\â>&þ­žØSìaÁåô‹„Þ/ðöâøÑÝX}ˆêãÎÚ ÞŽ|оO_ŽÕ¤½ºŸªTüÅéK÷ÛÊß¿:[h>Hû`ýÕ‡Ô]sÄŠWMꃷßH]¢òñx·Ò¾ªjíUïÎËÞØŒ~bß0þÝàO¥eƒ“¼^ñ)ü„~¹>ÄNU¼Þ±hÿ¬3G<Œ/h¿šæZ‹/!Ÿ) qú1ÕiÒÀß•Fñý]@îkˆCfØy÷³Ÿ“œËø¼|«úèÇ‹ŸNù®@ôÃôŒúd—Чqï㛯z§ú9RÄßjzŠ÷›r’ºjè<ö9§)ýËVÕB=9G÷'êÏEægôãOéOƒý´xºÞ@rÕgj¬>«ýª[ñ‹U+ðÇ‘4ñK¤3'X¶|íu‰'ëñ>ÂïfR¿¶´A^í‹9÷à:𑳠¸ÕI_û5ñsOŽZ†¿ ©®æ<Å}zãwrµ¼èCõïÆÞ•—7ïÿÂg¯knr9òë]„¼ØzñsÅᕃµÓ¬yû4ô"}#þ|ØLò½é_«Ïæ^ìeèúŸsLqú8å±7!ÿ† ôxegmÚÏy»–¼‹$$> ÿOšW_(¾–ç±ïá½Ê³ŸÕÞŸµè‰cÏå­WàiâÒÒzü¦Ox2ûvð‡«…ö‹— óy¿°|èÚ|XöRh^5rƒöV^§¹d½wƒÜ‡ÓÇ-Y@œáÏIXsíá%ª/?®8îåW]Âß+ÿñ¸«¢šû1¿¨}Ð-•ÿ\©ù›9Ø«ìsœ·áOñ$ÿÃy–Ű?†Ñ¼gÅ@ô­ê¢òñÛÔÿ¨=Iñô犟ÐÛUqâGŠÛOª?„§·QïÝäiÛ¹ÿ<Í}[«.½Jur¿âûÅú¼öŠgöcOKg´ÇË}†úå~ÞÏþ,þØïâþ ùè¡{=q³©9sžPÿÎTÍñŠ_Ëðµúõ/W|~P|’oâo}×Êm‘¼¨Áâ!.òŠWϤ¸·›x#êkj/~zÍçû·«^SÞüzõ‰Ž£_ÛÓE¼­‡9ŸÊ!ÔÛ­êãªîŒõ¬G.ý6p÷è6ÄKC~ܵæ?OñŸ½ÐçG‡•©j“x‰Ëµo÷*Î×Ý[&>kËdê¾°‹í IÛ…ÝkàUÈoÍ}ºkß³C|&>ιd#8Âûúà;„ß(Þ þ¹š£ó ÇþTg˜nqši¿\òi Ÿå“ÅoûLüuïƒ+²Öb'íÊ×»O¨^)^`‡ðBÙAÕÄèêÃß /ðžáÜK™ú;ýéœ_öñÛ—ˆ/ù*ìH$(ù¯@ñâ§ÔbEKìQð„üA©ö5Í/Z¿O»ÎògäjíLF/BÀÿŽbü^újâ¿à õÁø¹·Œ·5¿ }›å7÷gîO§öˆäLV?þpåsNjýzõ‘-Pü·\¼éãUMüå;‚ñíæ¾Üïò}ÅÕÇÒ›ïçÇxOkmKžÓöïçïŒÌmNÅq«ò%ßòù•SGq.Ö^Äz8ö:ú¬}Ê(ò€úãlØ¥”kÀÉö¹üéú–ó ¤¹Rò:ÁkПð“ȧùy Ç<ä3ôòcÓsú+çdk®¹^8ëïWœƒþÙ?G¯Bµ|Žy:ÏQz {æZE_öTx}´gˆ¯]yð†}ÇÞ„xCä{s[«°­òyVüVA v'sŽöLÏNWë•üž÷ üO¦öÓTì@¾<—ã§3o'ÎMJ¸õkí9mÎç4·äÔ>M¯æì‹ÅÛnÍį/R^ôòÛù¹¢ Í;Mo­ð°gˆò )Êk$ißãÓœs–CøgŒæu_ >™ñ>q{~-Ïú…sMMCÎ*5_æ9¨ú”öõd×óUϽ‹ó®ü’óu©ïÉ»–•¥ø}»x6Œêßê&޾ȟ{:h{*þ0[<3f¯øSg`'}ÝÑ#ËzαÊ(;#Þ=W8#ð'ñO¸‘âÙ ú^ÿX_Æ.dþA‰£¿ê±wy’?7¨ÿ)˜ _êŒßr>¬úˆâ2ïw²Ïó©c;FqžKà:ŸûX®:¶u1qeÑËÄá è¥}£övC¯Ü£Ä'v7z1c r¹I8ÁƒÝ³7Ôk^‡/'ÌÑ_.çâÔÜ“ýopQÉ žÃ2Hû6jÞ½¹ö}Ëiž%¸–ÿ_²‹sw©?µ´¿_¸›ºpåÇÂÑí z„|Žg›úÐO’—ñîæ¼SkOÓyÝS3õ/ïAnŠ È—ú…‹}áßÜgTg^ª~­ÝÂuo¢ÿÞCØÙ´§ÀÙY×á÷sþA^‹F‚;MApsòßÚÃzDsjoR'¶? Oš¡^{d4×›÷šx>äçŠ+ÈOºÛ¨?ì’òöwÑäZ¨~Ÿß‘‹â¹Ÿb»úõÔ÷¹[<¬Oò=¡eØ¡²±Ϊ³ ÅþÙ„WöK¤&iˆKÔçjl¢x*]ûRo&¯Wñ÷çé®9ôVÊçwÁn§Þ…½¶>%¾–<ñoˆïÞ½^ý^š_ 4ðú·Ò>²Tâ¬ÀdñØKþÜŸ¡§Ùû¨—Ïó¹–-ÈC =þÖ«ýã®^š?ÍT=»%qœ»çcŸ£9Š<ðŸÛÀ9¦ÌůUΖ½ØŒß¬ZŽþ†êãQ¿EáAÕïFîãóµ—Ç@ý@âëÍÒ¾Ê`>zcÑž@ÿ|ñ(Š7Ü:ƒxËTÄ{Û÷*ž» ¼XRŠ=·MÁN9üàÆŠ3øÇé÷WÔ}wã‹ÿáKÕqš‡¸Å«ò“ꆗñgá)Þ£Bü,¶{±ã“Oiü&í‘Rœ˜¡=Z¡Bä5/I¼Ã]ɳÊÿÄ´î^ògòá;Á{¦ýÄ<ƒs)ŸŸyöËò vÐu–úQªyu?Œ¾ØÔ^ÚÖà"û2ü­«¿ìïxä+ã~Ï0F{®Eæþ¦Õ!—Fíó2=)¾Äóš7<$½¸]ùÚ—ÉûÂÊç!?6ñä;¾g~%ü5ø3ÔA{É®&ÉѾy¿æ¿ìW‰túÝà¯}µÈ÷äGóó&?óN¯ÜãØqÿiÎ!«Š¼{fråÿTý‚ùª+?§xTªøVû-½Ûñ§¾µ7p*rLN£~Þ+5­y=g)~=çŒê[_ˆ& åö ŸÜÂï{§h¯“ø“ÂOƧðÛ¹É7¸®Õ>ŠBñtÿÞ6ýÞf™³MF]Ðÿ›ú_>Ñ^ÜÜwDv"]s#ÞQȵɫ½\絯ãåÍög»ÆÑ‡~^¼„âÅ“þ{sg®úp*Þm%žIí;v|޾•Þ¤øãcõñ\§ú¦ø#Ú7˜¡¹.×^íA(¯þÛÓÚ—>—¼lé È©o=ö)'M¼{8Ïð2pXÙØ£´ÙØçfÍÏL@®Ë{Ã}…/Š8ô ª÷¶—¸v€ÛŒµÜ§ï=îþ›ühe6úæ_‡ÿ=ü¤e2~{Zê´£¯­x")çˆößÜ¢=‹?áG\ý9?O½ô'^:5ÏíÏU½ÿ<öÆš£º—y¬ú]{}s©·¤ì žr€´kžÊÞœxÝ9í:#—·•§ÎÔž†ÏÀÎRÎÁ»ÿg(R>Oy=G7p}Ú`êìcÀsaõ‘s±s¾eØ ß,ñ ø±Si]un½©û‡ò¹ÅâÇÂïéS¶|Ìù”ÚµwønÞ×T¨½ìGe7´w4íæw›yÈ¿àÕO§‹ÇÀÞ?P:^8µˆóð¼Í9GÅû:»SÇ€{ú›y€ù;Gs͇Tƒç¬&í18¢y Úx†çeRO·‡´çvÍ$¸Š2õ‘ìà{,ÛÔ-ÒÜ×ÅsQ©¾¤˜òÃ?è÷ö‚¬}µw*ÁsDÔמq'ytOv4ØR}x%Ú_ý ß~‚ø¼êì˜ú}½„UO(¹÷5žT?‹æ`ò^¤.aûŽú€;ì:­þQñKu?ºïâ¿À0ìLÆvòvé‡ùÜðrñý«üU/áÁïÔ¯ææù¦L µJæ¨ÿÒ´9JÓüaÊ2âÓð*ô ¿\üìš_H^}4—ü£öÏnÖÞé±<÷äáçñn?m:¯ñä-ṫ´w%xŽó®RCè}¤UêóßP?ê?øKOylÇ؉´¸ö“¶~ìƒÜzã_2>á|rú'FŽ»ä7Ôà|OûdÊÅ çæ¼Ë¿ÇT}ÂßÓÕß×D<ÿݰ¿þ(ö³ ï~è_ÕÕ´çÍ¿C{oÍÄæå¼Oþ]o_ÙgÕªÔ¿QlÔ~@ßTÍI>ŽŸŸºš:©i2s0ŽæÃ\poðä!e£â¸tå;ÅÓS¬}h~ñ¬dm¢n™6K¼KÒcÿbÝÓ`å_5¯e|ýôºÅ³þ²xÌÜâ/›¢¾í—4Ÿð ê†â;v>‡\ûgOXŃnÛ!Þ¯‡´ÿîô!|µæFÄãl>¤½µUœGöô;XªåG²×¾…?«¨æ\}]‘‡Ìû‘{çtñßjÎ%£‡ü蛪#.àù «4~J|3Åï÷.spòoYg4×ôÏ9q8u^cîÓQHÜdm -WÞËù÷›¯>¸Àuê#7‰¯ä:åîÕ~<ñÜç•kNôUÅŸgÔ7–¢¹©Öø½ì%䊔/ ù¹C/åÏØ¾A. U༾æ°öSö«¿ìÉ©îÑW…þ™åg2#åÊ ßž*žOWÕ ç“/ôÔ"Wé…êÓß þá ›xiÊz‘ÏkÈó]/ó(Íq½Ës§TŸòì°y"÷kËŸÕ1Í$Þߞଢ!|¿‡ú¯~Pp?ñ9¾+~ì}âu¾ ¼ú›êW¿M|ÝÕ§kÒö&œG†‰>Àbúæ-èUñÄöGô9s¹wo½øî‹ï2‡ûõŸãþ-Fì†q;x=5‹8´áüLŸb72s•™ŽŸšÑé5ãÆÈ[Iò1ï«ï_ý‹þlεðsÝÇ\ñ<$‹ˆGÞº¼åÌÑ^‘ïU§Y¥} âU²ÜE\¼™{Ê>îˤ¾‚ÇÅû“L™M=?}´ø8o¦ïË{ë—ä Œåêˆ!7ÁßT'޵¿E¼gý\seOòÞ†ÝâÕ%~Bõ¥†šâÏOKÏSÐËàIôØPÙBâROñJ-W<ò‡ö,ô¿¥T‹ï~v1¯úƒ†Ï?¢>×uä­|/WæiÆt„{ŒÜË÷7â¿K>Æ¥ÿ >¾wó½9ƒé“¯T½!,þVÓÍß´Pÿï"ìw~Ox«Š·‹ÏNù#OwÎÉV.K–^»»jïÅB~ÎF?ÜÚkVùy£ðñ¦Ä¿>??×Ä©ð‚ŽþžyˆÒ—´§Ö®:Ü«ÈQ‰WqÉq½ÿJò*ÅApzC^ÆwûÖ¾ä€x«ó$‡™ëˆËÓ-ä]M~ìJq=zzœb5©Ž÷æÊÇ Y39çâ£üžû6íïÔmÏAðˆ³/þDZHûÏàßÚCQ(‘­¹xïhÕ;ø§†jüiâ\ï<Õ•ww Ûýòÿ!’Ü⟬ïs¾ û'BêŸ .Öž  ª£(ÏþñŒÇŽùBnsΉoè˜ø;ß7¥“=ø»c^‰_ðõáþ]h>=H|ç샧«0ûÎ;†œdj_ŠûMíqº=pæˆ'a6yÏð7ÂMy¾¢ˆ;ÜâÌÓ>ö²›°ÓcƒÐ/èoE{î=[{ÂÄñ¹êO ÎàóC„׺Š':]y•7G½¬=DÝ4G"Žäê(R½ò–ß”¸6[ùHïxÕËÑ\[‘ø«Qþ[ûÄ]÷ª_þuÎ3M<•ÿbç}Wrÿ3r·­À¿§ jË繿ãý«F‰ß6†?©\¬> Ä›îzõéhßEðÍû„ü‡o¯Œß ù´‡¤i¯jðç•ýòjUŸžOuòÐëš³½ŽxѤ:¯õ'ñÿ•ˆŸó_ò¸–°k¥Í™ç ¼Åógn£^º›ï ߦ9[õÓgµ¤ÔÚNù‚CÚŸð²üBšøÒµÇÔ=`0ð¾ÎNàUw­ø²ì|o^xÙ¹Gq£úXBÏaÇRž!a±i/uð„ø‚ ð/¡JäȘŠ2ý!~·›ÿЧº×´W¡-ºÞ?~PqͫȖòÆÚŸ}¿nøŠ÷Ì‹½ÍTŸÂ`ôĶPùŽwÄñ-þæó¤éê/*xƒû×½ÉÞ&^¤â˼|àÔúíS Žï‡öz[*ßpšùÏ ìtd¤ú!˱ïþÁà|ÿKâUÓ|wÕbí»I󨟋/aúQ©¾VëÛÚ—s@8%{QŸ»u¸ö«ïѼÙ.îÓ¹û¸BqâýâmQœé~Z¼è¹àãYüyØK߃§—ø5ŒÈqŽð†±/y´ôÁNÅ1ÁñàJc¡æ÷Ä#íZÎ÷xkoÙ ²[ò¾ÏåoÛÈþ-PÞa’Þw?ò7y4{7‚ïªo¶­ð|cð…åYÅw¯ŸÜ…Ÿ Ïî©å½ò6R_Éîˆÿ ïáó}}ÈU•á Õgç;Š?u/Ñû<ýËN×>Üñ&íIÓ^Iÿ"â$Ç.Ù·¡Ú×3ƒ>ûðÍéwäÏ~±,®ún6}p®ñâÅzûã] nqܬ½£?Ë„TÍÚÇó—ºå6*OŸ'žm+öÒ"Þû ꣙(žœuœoHõHŒïõ´×Ï‹§Üu{ákª<ðyêש/bï<ãÅv‚sQžOû¶|Ë8§€Wý-ŠïÓÊó»ÞŸÖײÁöd?Nƒ«¼?s/Vñ\x׊åþÌÕH{@LJ0æ)¿p•úºÓŸ1—9c 8 ¤ŸÔ¼™! û[}æhVã7«Ä/èÚ5Õ(T¥½¥35?£:¤9Cõ‚ÛågP=u»þœ ~íÀÎâŸÞ‚|Dš#wÞIŠãþÆe=Iþ5órü¦w ý*ÞoÅGñ88Äû/‹¿áz⽜Á̹øÅû“ÕUõMíOóþ¡>ñ{x7©oõkÅuÚ‡2ÖK£¥R}S{Å»)>-ÃYp²;ƒøaLþ¤ío¿Ø*É{«ú T÷ésMíÑ+»ì¥évp‰qräüEýòŠÉg»ÚáÓW“KïC¾Ê+ÞÐàÚk˜B}.ý-ùoíÁ6¸È—†Rù{žüHvcüqežxz΋¯â¤öbw勬à«ôgÀ£î4ð]ûBLâ;Ïz»dXJ¿ŠÉÁû[Ä›äÔ‘m‡úú"7ÅÈ]ñòUíK Ý'Õo ÄÇ›y¯ò×ԟq ¿ç½yŽhîÉŽ=¨z¿_¼{?A{šmêÚ–œWÖfü£¡¾V®þ&ùå±â3´~ƒÿtïo'Ωd°öšia YsVÊ£8~?ºÄ»eš Þ fr/qâÛ»Q{W€ï³xOS[ò×£ÞÔ<²ò{æâãôq^Á›é{ h?¸w‹ð¾øç<¨Ÿ^óm^·öÙßÊ÷ÑÞâLÙÇ*Íõ‰ÿ58‰ûÏ—4/.øXñÄ(ÕÕÕ‡¡ý$kÀ>;ö.Ø\è]ǹd\ ~· _™W;Ïižnšö¾29ÿ²7Ô×Ü•ó.Á>‡ª5W»Xû§zhN{›úåNh¯ÓÓà§ ;â^¡:ô$x:EùóríÇ2nÔ^êŠË§kBŠx’> Z<Ÿs¨PÿSñß½ÉâÅK±ì¯ÿvíi|ý 5Ïñ¯êŸè ~M¹DÞn´æ´\SÕ7“xÉ4[qýÏâ¿𾎉šKì²½ƒýwôä÷²eWŒ—á'­âí èÜ=ƒ9ßéÚƒ›²K}ìsÅ^í7ÿŸë;ô'Ћ÷J]¦øo¶ö±Oú~$ލzûèu!§£~…ÿÙõu›Œ{Tßî§=ÏâE3låü2´ıYõïø=gTü3Ÿƒ+½½x>{†øþàœGÀ )Ú[b.uiOuñ0ó#Ø?ßíàGÓ5ÈQðÉë;šÛÖ~˜”µÿQû î3_{îsS9ÏŠœ‡U<àX¯úÐ<ê×0|ËÏNhOâPâIÇnú¤íSùwÏjì­ù^ü¾©RùôècŽ)xž½°“s ì¿FZkþå~/ë2ò¼.Í/5Ôm\ê_-Ý îO¾H^4ø+çäìȽ†·ñgv ìŒ_{²¾ÿ‚üCh’øm´&ðq¥ñíwQ_‹E<¨þ$éÏWàLç@îÓÙûé{ûaýƒßs®C.,ч¬ÔÉʯø´WÙó:òâ_Ý »”ž¬º\Ãþcå-‚êwpÝŽÊÍ#h¦¼ykí#V¸k<~ÆÞ{ã8 ô\‰½ÉÖ>÷íËš‰ó‚÷ÓTßO??‹<¦þRíǵ.åß½ê¿òˆµê#í…úÿn|]u鉜sØ ~©¯°ŸßUçú‡|}ò>ž×¤>Yσâá½—%ž Ë.>ì7ÚŸ"þµ~…ݬV}ßp‚þ„`/ôÉ^£~Õ5Ã+À š³5>ͽù|èµmºx#¯S_”‹÷Ÿèã¾+މOÿ^xí<-ÁíMÌ~’¼Šáñ›.ä½|]%ß^åµv⯂=57­ùÐp#ä¤L<È–ñKNp…Í¢}ž›¹Gwê@¢á\ì½yçb5ªáIÍSiÎÂq™üìSü{¾ö^Àϸ+‘_öÚô׋ò_]±g¾1àÚÀÅ#oiÿăàÌŠãØGÇ%žÇ°Bý]ÑûÒW±U=Áwæ“ø—x?<óT?Öœ¶ù(?ï-ѼÔQá½#Úç2“/¹ùÇüÕôõgGµñzíwX¥½—iÞSý]¾>â«j!žÈ&Ô!ü¯i?Ê+²{½¸ç@Õc¢9#±Ï~õV”âçsúaw —ª¯¼â ž×ò³x„ÞQ¿WcòFéÛÉëy‹´g»˜û1FøÜ` ìDÕ7Ø•QùÄ«æ1â=øœ|Š·;ørBÚu{}!)i ÏiÔüÜØßÉ#zgk¾erlQÿ¾óõ%‹G5p…ö ç¹sZð<>åµS¶Q¿7kŸ–¥)öÖ.?í?®ùìí|¿I{<ÓçhøÝsT¯½…ï)íˆC>£e?W]Zü…ÿŠ?âö$uuá’_Ћò¯y^Ó)ù¥kÕ‡z¥æ¢÷ˆ¿¦Vý¨ýµ7üKô?åKü¨3 {lØÐMû÷à/¼Ú«fœEžÀZ+þì™7c½ÿ¶'ç“ÒìàÔÀñÖ³Ô¹ Ú›<+þo£xJ ¨—;‹´çL{8퉣Êw£Oyí­ð!ÿ óCLñ‹Žâ}KŸaǬ}+n;v>]<:•iâ7}P<ªë†OqÞ¦UÂ3WpOÅú»á3âmÿAÎ/·+8Ï©ý ¾ËÀ§ž…ØÛHæl®&?Þ£üÝ pgP}®ÁÍÈ…¯¿—ÙJ¼úOéœ6gjÿ¸Gq}ŠyTÿjéÓóªGy4ïñ™øÚ[)½OsðÏpŽå|~dŠx—žÐŸEä]ÒÅ»dì?Ê·O¤Ï&g+ïŸÜUò÷ŸŸ¥~Sǧª{¬ÖÜõƒ~ þNùÜ”±‹û¶½¬>)ñ­4VöQÃÞÕÓ§ÈPª#v8g(ýF®aâaºVqžxÃҌڭ>qó`Þï¿7ü¿¼›½=ù¡,ñJeN޿ނû•g8(“QÚËÓ°ÇTñŽøi~ÑJíϺ’~O†ò˜YÊ# }Õüsšø|\ËÈ«Ÿà¹ª²ÐÿàMš+ºƒyW÷íéÔo®xL24¯pŒ{=SM˜Cu”`y¨Tph‘úƒS°Ã6Í_—¿ƒÝˆÌGÌ}Ë Ù­ŒÓöM2FÁÉÌŸ¹&ˆ?ª3rѾäÐôÇ•Áß3^"növÂSÈ÷<*žŒÕ÷7Ž{˜tL<ôÅ_PÀs…}â;ÛB}Ó/¾š<ù!Ëí q(~ üå]g‘‡(RŸ„ÿ~Çß|âURpqQîìP°š8о»0þ«ãæÛß}')|»æT_±LåûŸ`/²•Í;Ë\j@¼îdõ‘oÃO {äß&ÕÃÇ$9¿WŸë(=ÏFñkÌOû˰ÖSø×q™cv Rý1 ;X¦<¿³jºê3°#þß°Ë3[¡ýkš—4Le~˜¬}šµâ•ê£9Já Kñ#¨o´žïußÅïY䇫”—ì ³­T=Ø©zð ŠÓ¯/û‡ §¾“|¯9y÷%«Ï§§øN6òó™]å÷~Ô|ê õ;<‡ÞúÅÓFžöÙ¯W… ½NþM|èßóý½•o8K^9íqþ,;.ÞÊ+É«˜Ô7ï~Œ÷õf OvÔ~mñu:ÅÛ›þß_ò„ú?!÷Ž‹ßíˆêü9ï”Þâ90b«6‹—´Jýy£À1¦Éøo×FñõR_ÏÂC±s6õ1„îÂÞÝMž§òQ>7Kq¬ÑÄóä}E~¨¸¥ö}õÀ.Tj~ÃÝOù¤å…Þ ß6M¼Ó©‘¿ôˆo"Ks)Ö+°—å[²·öÕuÄ'dUÿ ï#üDIqmà1å/"žòÝÌ{ºWâßÉø“¼åU.R½ëåsñï®ÍÚÇ|#öÑÏͳòSÏ`Çþ?ד|®;YyÒ$ììä,æ ü×h^Æ&¾±È—q*ñ•gçe‹P—™˜Èí¸¾ùÝIAñÄUiÄ7^uˆ*Í#juÚú2 ï‰_K{nüâÉ ¶D¿2;jÏÑãÄVv×Û‹ø)c>xͺ|X¬þ™pvÏXÍyxN)Ù yÎ:Hß­c-ú—>}JF?ƒ³38)Ü‚ø¾àê:¡+Ðk£‡z™ÿ!Ù¯[•'¯Ðž5ÍÓG~'oQ:¿›jC}»Áß)ïc§Sµ×Éù:çåÉÅNeŠ'įºQD|;³ìdƒ¾ý%û“Ί¯Ù—­9r'Ï1Uó>Ú¯`¹ ¼x?Šð9î2ÕÑ—Pm˜ãw]Þ„ï“Û#>~ñµx?W,Á¾fü)¾ZÙ‡bÕÇ‹“ÄËð?ü\ž©ý´Á‹ê—o˜ÙÏ=”Æ4/z’¸ ðæ“®äžÍê_t=Â}Ú®A®C²ÿ9oñþ í¹} /¯ü\ÍÿinÕW>ó]Ô¼Ð$áöîê/uª¯ú¢xàlÈ¥ã/>Ϭ}tâgönÀOç­âs=—s÷pžw7rŽ’sWƒÛ-絯vŠæu…Ï,¿‘‡ÌÑ|î}òsÿ"GcÔ×ܰϰìQâ–@?åùOp_î ö3½¤¹¾ÅÚ“ò™êïÏagjžQ<æÕóÌã×P}ÏÃùæ)ïây\dz<ž§}©Ÿrn–5šÛ}žË%p§çzáDíå %À·9£o>—xÀÆ“6Šï1t»ò üÁà |Ñîâ{ï«,õvòùÆv¼¯ù 캱~Ê;½.Ó¾OoíÓ½»ÈB.*•§ŽœŸ\œSèìæöÿ›£ÿiÚèÛˆ½6l/ØNðlHû|œËÅÛ0Xs¤µG,K{NkoÐÇØópkì”§Œswªïì)åìÂÑå<ŸW{È,ªw;›h~ê å“¿×ÜÇ\òãEÚ³ä×þKGœø·Rs9æÓäÌÅÚs }ꞥèUjcò/êÄ´]ýWÊs‡4WPüœøº)Ï0]{ËŒ²{ï oÁ(v·\þùIÃÄaηñ;¹_âÏ3¦‘§ ×=Þ†_tU€Ï½Åw0„'\r¿ÛÔ›%¾p/~>Ô\äY%¹])þ¬=ø5÷i~Îo”Ÿ­âÿ»[ƒsò[ðžáÍê|à½s‰h®Æ¼VûÓ4§dP'ç,òèŽÉèGüãmŽŸóhÍiÒþñ0æÑ>妸¯¬.š7üJy»»±ÏNõ­YîáÞ\}µi¾ú£¾Â~wŽˆçì)ÎÝpŸö¡­T?Ðà ¼<§ÿYî½ðsíÙ문ð åÓ_Ño7ñè¼Cê]Êûº{à ÅÇi¹;ìÖÞ÷ô±à@çÍñ|Æþø”¡¼oY_A2ò]XÝ2Ëÿ†Ö?ÔßUzZç¦>ÇšãѨS|Pþâ9i¬=9Ëdg>Ñ>õSdªŸÞ©ü›÷0ñá”ñØ«tÕ‘ö¡¹5çæ«Ò^+vØ7{ö>É}*5Ÿ|€û nÆnUï÷<ª}ŒÒ7³ö†dœR}\}½í8?{?Å…G”÷Õ~¬À#Ä™9.ú:L×p^¦yدòPáš³]Ny ¹qS¯4÷ÐüŒ}INuć°ï? ¿â5ó'óy¡wÑ÷ô¦øo_&Ÿ—®=Þ¦Úß÷x¢r ~±z4ÏáŽô†„ŸWªµ?FsÔî47.>äª àÚŠqâË9ÚÃÔ ~¡«<{]áÄþ»nVÞ²»ðàßÜCàïWöõžÑ×€‡,Ú§œ<\<iзġîñæ·TŸöCÚOÑýÈx;2jEÓŽÁ—&'MºŠ½[Å7s¯ÉâÑðŸS¿æ2䯸y2ÇâkÝ¢úÛ1ú«ŒÏ‘ÿõŠÞ!ƒ«´ê ñÒŠOʺ=¶Ï@.ŒÔ¼>ñ%©¯Í*¾¶àóÊÿ¤ý½UœoêAáäkÁ)y¯SG™ò0z]< {™r 82ógå=ÒÁc•škÅyW¼ª=yú¼PÏk*âóJaçÍ“¨—¸Å®â½­â³öho‰iqgÙóš35jß‹äÅRÍ=VÎBÿC u¶{ú˜°Ã¾·9ÃtúM¦iŸrv{ò©®â}<¨ýxë•GzO¸ø í©>„ý){ïñyûà«êGÏÿW|¨ý|%â‰K®æ‹w×,\¦}ïþ¨ê"_h߭攼³ñ)Úë•}Í8DܯùoõU:sUçÛ$|º\“rƒæ¤/NÍyFnCó[qñãûΨm¶úŒ«¨g™ÊÛ®yÄn§>"¸©â¿úSüg«µOüIÍ•ˆ9”‡vúx/ßñÍïS߈ò‡Å³Ñˆ=WiwñœÁçÐCWöiÚ@ñfüCþ¤L¸Éñ+÷3¥#û%¼ïc'üê³ò½‚\wEΧø>G½öøœOê-âÝÖÞlú ² 8WA~ë#ñƒü²¿®=ì‡É£Ù‡`¿ÜsÄy~Ä—¬ù†ŠÛ¯ÆŽÙ†«Þ4R<ç¹Ú·§¹ ð¿Ú›,»R¼K<5¯‰?ïvò~yƒÇ@cñÙ¾<;ûò9–):OÏá¹?š·?âœ%þã,üHÉmôfÙ‰ß\í5®ºL[üNäñÏLFóRñ¿!;çäÒþl¿Ÿ{ðg!÷©Ó±‹ÁœOÒxü„£¥ì¶æé\×iÿ¬Yû瀫œ“Ñ'|i)žÿwÉ„›©}qÃäEèS(W|UäIœ÷Š×;ø·Xóµi{©Yß&ž± eY¯¾é âáÿXûÐ…ÏMvêØU_€¯J6(®©Broárª©å±ÿ¹ú³ ð£ÎÂßwˆŸî äɧzvj9x6c7Ï›©ºWikòh¾‡ÄŸÐKçprdKþÒã>Ê5OáýŠ8Êò¶öJ°‹Å ó,éúý»ñC¦NØ /ÅŸQ·17V½-[ù·áÔq|‹ÄÿÿöÍüˆxÎÔ×¹O8p°x#Ïk^`œúäë¹wk=~ÃVм‡^WŸÕ4å[Ö!—Uê¯ò†°ÁÏúÀ_.ñ{†ŸP±;xÈ‘Ìÿ{õê£i~’Ô^몟ɳ™=Êë¿,¾­êo)<™§¹Cñ¹øÄ;œ1œš;RûVžÔ>õûÕ§ú’öàuæyGU³0EûÈ-îí¿'ÇïœRüª½­ÿ§ó¸zþß(•Z(‰h)i¯Ó¾Û÷ÞãÌ{Ÿ½Ï¹»ïsÞç$³d'¥Œ’¬! 4(Ù;)d%B(«ŸÏ÷qÝ¿¿¢îûœ÷ûõzŽë¹®§ý:ì·÷&ìŸãìB@ý-žÏÐ_¡¼ðnâ°²¿©OyÌü\ÙÈgE/ú¢ëЫâ.àUW?üCÅ Ú¿Õ 9*R?•cv9ÿ6öƾÊçGGkŸ“úª¿(ßô¾öܯïH&< ÖÕ1:ñÞ޽ͼFšãˆ<ØŽ g‰=q¤ŸÁÿ©cµ)jÁÿfÙyÛ ä}|Ï1?a¹@{…üäCìwcAä¹ø Þ;[ûCòÿåhŽÇ+þöȇª¿uïŸ#ù•½ +®ý ¾¤´ú'FjN¬·ê"7`ÿÊâä•J$‡ }Õçµy «ï§<Þñ¨Ý5=ñÖbÿCÔçµVûÞå¹b¯kïÎ.ñ4ˆ/;úò´{Õ¡}ñù:ûèUD{ÜËœÂO‡ÀñsXß@~bêõlïù0îÙ¿ûWd‚—&x«ö }¨þ'íCöÓœpríŠ=¯Okßý+â«O+?Ø yª<—~Àñ±dŸ¤o%p‡ðÿ1ñk‹.:ޏ+zŸö“mWp†úåËd‡_â½Ü—k~ÿ”ö #?ßPt=_¿šø&´ûÎï¢~¬¿y?ßÅäB°ïþ»´_R¸Ë®¸³¦«öž~Î/Äž«@Du³Î3Öˆ¼Ô¯Ážä ÓžÇü}¼•ö'_Oü‘«>O5õ‹ÀKœ_íð^ÄÌß[UÇ+ZJ^8'ȹ»T_æÌÊÞW}óˆpØxì­ÍÍ}ľÆ_ͱ2¿èÉsùÿä«Oà_ð–u¬ö%·Õоȗ£†ü»÷yî3>?`Éà>K6—ûòµg¨ ¸,®ŸÏ•_ñ*?äî¤ý›óÁï±yä½IõCtÐÜÿáYñ‰î§.Ê“\º×û´'ì/Ρî~Õs“Ÿ>D^#TÆs»Þ%·Ô“ÿŒÐ<`Hu¥˜x•×]…üÙñÜÑê‡/{èaüZé媷¿Ëó[?ßý}¼·çVò;Íü•SÄ>œ÷?¯} ÿˆPuAKóÜíø¡†.ø§Ù•{¶Üûîa“o&ñ5 çÛ†½Ê¼˜¹Â¢øÐ2äпN<Òw©nöÿŸ/~™¬­zîï±c±SøÀ³ÄyÁãê7,Up¬ò¿Uâ;û;ãÐþ¾Ð@á§ê§þœÇÙ³ÓЙüVý<ôÈýöرÜXY'§ýqÑwÀ±ÕÓµŸñ~ñÒàyýƒÑkÿê—9©ºû«Úk¼û($ǵœOԇݎivä~§üJê¾5Ò«ðHá¢Cèk¬ù¨ß 0ÍÝx(¿•Âo8¼š#×ÛÜ—Ýî ì£.Ó yÈà•<h¿òêj~&ðç®V]ö5ò¢ÞAâÝlƒœY;‚§².–]ùJ}-5· >ʬŽÊ·tàsœOQvœ-?ÛŠþ§ð[âwúB<$!þÝù“òO]¨‹ºi_ëù‰C‰Û ï¡ÞÅý—T"çó2èϲL“õÝ\Âê«(™¦}lGÕzç\¹Sû2NˆÏ&ÏÑ|c/¾¿VûØcÚ{R2_szçðïîÎ%°üèßÎó.¦ ú2poíxÕ3þ朅¼—Kz{E}áÇ4?[M¾g^6}J±'4¨ºS¤yŽŸsŽkÎËñ.÷`¿[{,’ª÷¤Ô/±ZuMâáÑÜu8þ9êDßâ-Ðï\í ¯U„=<ú7rNU#_s&’G¶ì i}»_¤|Nü]ìu‘æí²4S¸~VOˆók®_û̼¿óiñ­Èïøk°_ñ.ª“Íçþì—*¿\.]A^¶™O+×…ßñR¾ô ñ2‹ß(¸Qü ]˜‹õŒÏí/⣴¨Žþžø³Ä§ô1ï¸XñfvÛ¦>ƨøâJ ÔÏr#~Í£ýÖq+ö·´#ï“õuÇ|Þ#ï"íIžªýwmÁ­5¥šo’Ÿö8°[­Ê_Þ+>Õ§U‰«¿R<~Í;û[ñy•ʯ†”Ÿ£þØWøü|õ¥æm!l˜ËýÔ_®x`Ÿci n:/‰~Yï§N“ÕUu­ÑâsÑEs}»zçkÙ¤ûD¾¨à]ä%ÔU¸üQõõhþ3ö v½¦ 9³4óMÚ‰*ïáùòµw=2yÍmN‹]·ÜMþ5ú†ö{Kn£ÚO]£ýÀ•]É8–‘œÑ½¶½Fþ)ö%çjyDû[ƒÏÃâ‹ <£=š·5÷Gî|ãø½°æ[r¶Ãëã©íuž¢¼ÎZñªŸ2v©xkjOæW¼~s¿Þ_ä¿}ãeWº¨_GsÄsijä}EøC{Ô¢âûˆ×ÄUIx³P{§(¿íÏ¿;ÕÇ©_ç–ósy£àÓ /S߃pG¸@}áÚ³nù<nä~ Ÿ7xÞR¿Òjä,W~=?Ÿ|¯A}Þ[‘£øõⱪ/B.þ¢Xùsp_ùZðBðGâ÷†¡ØÂéâ¿ß¥¾Å±ûU“ħq˜suÃ=‡“èի⟘ {{‘ôcv%$Þao~.Ü›ŒÜ[µ""üP9»ë«=3÷k_WOõi/á¾ÍÍs¸Ô×)ûœ®=æÏ‹¬œÿ˜ç/’çN¢n}8›´Ï^uã˜=³Ü¥úÉümìé{)þ©v“öAär+r~Xó°W!÷•Ÿao ø½Èâ¡›€Þ:Ö`³ž¦Ÿ4ÞNþ´ ýQõ×^ˆŽ.Ñüçsâãš^,l­½·mUŒaWk—sîÅÛxŸœÃÔ9jö«d¿ö±%‘oïäòoæóCÇÔW²›çλŸ<ðœ+²¾¼äþoMÑ1ʇÅ?q¾äqÏmS]8¤x%ò“ð¢ö 8rÄÿøy‰°û›—_Å'ò~nõÉå©_ Þ÷‹Š¨^ûãÂ×+>Ü,{‘ƒþÛ]Ô‰³iüfñ0‹'¢pŸö ×üÿOœ[ƒAY©=×¥]á㉽…üE¯Ã®×V«OÜà<ýC%Ÿ¢Ž7[~²aºö2,Ö~KñÈ;´o³ìÎßוs±>,~ÁBí…w°Žx!ÒZxðGòÅõ 5§}ƒò_óï5ë8ïʑʗ”a×k/㞢~òA%“w´ÏÍù…¼WHv?Z/>°Oˆ Â{±Ÿ.õæWc‡Åss öÌ#}ôJŽËþÆoEsxϸî?ö¢ö÷4`']kÈó4ŒGÏjT >¤~€CòKqîßßUó‰Äçù$øÎÜQñ=ñIô^þ=’¡>þ²Ó‹•×^«Uó隃k~ŸØAþ,½EóºEÔ)BÉZêùÞè!âÕ¬ìP^[ê®دª&ꈡYä[‚âÁôíæ}*oäÞâƒTW¹= ¨¿$~â¼§Äkô þ=nQ?Í%šsΫZ!þ ÁÜ[ýTåÍÃØÇ,í»÷–©Oõ4ÏSÒ›>pïÏÈ¿V¸ø”æZ‰g"©:Èc²ƒß©¯äñRÃ2õ—œ"?âµhÿSþ§8AœíWÞÇ{ç’ù©êTŸò\ùèÿ P~í#Ý×­ÒÃ/ˆ Ü+ð7ÅÚ?ìïYÖ5àQëFìpúZ<ª›üÄûf]¼Ô?H|Zù4?—÷x7Òûèø‚ó½Íù„>¯vXû&þÝbÞ·`¸ö4uÅŽå¿K”C|´>ySkŸã{‰ó¬?‡û·ÆþØ×ñ^qí›rEÄküõ”ÊšW¹ý W_¥M}W}À•/kžøzX³V{îW[û#§ÁUÊ ‡ÌVÓ÷™ö¹|£¸ó)äÕ?žø¨4H\ëÉ[ÄÏáyQsVåÚk0Qügñ|9ˆùgñ)xÔ—7HsÎí˜ñª%øƒæG›ù†-ª[߬|üIõ½¨N+ÿ†§Š§æOå·úp¾…ê“‹ipöÏÔß›yõã{ÁmÎÖÂ[Å3}Žö'd‰eø _8=®øÑªù²ÚKTž‚.S^*~Š<ˆÃ'ž Ûµ÷ѧ¸1_qùiä#ö¥x@ÅKö©òSÙÅ,üPÕDúŒ"fä½Ö'ö¤ú§òÞ–ëµÏeß︫;ì¹—÷õ.%oi'\¥~]prø[ž×{úŸÿ yƒh…øºÊÁS±qÈgó|¾½\_ª}ekÉ‹”ª-¾d½;]@¯®Õþ‰Ÿ´'í„ú3Râ߯I<@~Äîå^-Ïðç܊ϧî~ÿ˜É±üxh5~ÝÚFóaŸÑ'â)Á>EÅ÷ꘅ^T ÇŸÔ÷ÓQÍûKG{1y†˜!{S@Þ¨xºpÌÕÈS®ö8Æû’¿ð,nîOüd­Ïûnî?z—>>ñ{î~ô*Úƒsçr?nõ[DÆîÛÈïöÓ¾”?µŸm–øïäÿÃgóïµ.ò•£°cÑÇÅ¿vÏkvïÆƒÊNQÿ°x¸låêW¸çìG/íÚàÿS¸¦X¼m׉—¾§úç?‰|ä}|äž©¼ÀUÈMQwòÖÑyâo¯úì¯Ä{AåKý)®M‰×}qA–Ÿ|ÎBøÊ»E¼‹1¾/þrÛ\¯È «žÚ—÷)˜J?Ax¦üäåu~'ûaŠÎ¢Ž\÷½úËÔK|ÝЫxgä,ÿ1æ«cÍjŽ­þ°ö³|¥¹‚ˆxƒU×µ6hÝ&å+3Ôw¿•|ˆ{‘öįWß§ {Qý~ÄqžæÕ>7~?çDä)vxޝ¸²¹ÿÐ Îk†O{-*?2_{›gƒË,#VñÊÆ&£î?¨3Æ>¿ë{ú^õS:ïB>+nPÞé ïÏÏÛ‡¡§ßR§ÊÚŒßnž§ Š‡Ø£:žï7õõß 8½ƒæš‹X?ìLäzV7[¼Ýo`W3Å渓<]4[xñ0Ï™§=á5ø#ÇÍñi?U¼ò ˱³¹ÓÔ·sþ"¨<®C}u¾ùzßõü|ø\Õ#º©_õÕ Å¡yaíùÎßF^o¦ö§y—‚¯Bysö´àÍÝ]*¼“ÏýÆ~æûª”ÿ-yZqÒ!î©Zs)öõâYNŸy™xóü‹þ8ߣ¹Wï2ò¹Ú§<`åµÊh^)0C|}Oƒc=WK® õÜ©¾‡züàlõ Û¡gþƒàŸ:ÍgyÖþ°-ÌI„´uAö/Eýš'?Ž=ˆ™yþò¿4Ö’¹f ¯VñzÆ"_^3þ'ú9y¦hWímºù´uÑÞ¤Ÿ°Ë•ͼ¨Ÿj_Ösèƒ÷nðEl<ò娝}›8¿h÷=[¼5Vøß¼·”‡û<ì™"ž»ÙÚû[…¼ÛÛ£-ógözú}›ûˆ¢o4óQb‹¾Å.ûJ”ÏÈP^i%~!PþZ<ÌæÏ‘‡àâ!Rü>ª#} öÃÚ»­}x-y¾ò‹uŽÏ—TýÉóÅ×)ŸÓþãÎâó\N?´}”öÍ«gSxðñ[½Mü\?ý¬ø—þý¢¯8ç\'õÀæ½6îÕ?1Lû:váGòG€kV«àYÕñ;«OûËJ¶Ó7ÚœßY8} NS_Vgíý'?Þ“s/XÊœ`e«Q~­Rs‘‡1ߪ~ÿ#u‹XJý'ßêþ5gkí«|íø;Û¿ÄËÙ'ð—uG‘Óê>Ú/Ú»U þN÷å#ÖŠgl™öœ$±“öƒÚ yôÞŽþ¾Ç{æ(Ú¤8gæÔÅ·i؅›Sškê‡_É~ØÄ7±]Ä•VõëZ_æ},×+_£>É ƒóˆ­Ðž5õXbœ—µ3r“óv±þlÎߟÉû[_%oé¡þ´|ì¢Å¬þ¡Õ<¯å¨öŠ'8g!y-§œdU>>¾<WÿµïeùûÔO4¢%í™_³ ÃN‚Çß•%^ÉWxϬ3eÇc£K‘“ÊAê“)¾= î.oÎW] =Úg#Ÿ•;ù<ç(ä`Bú Cë„3ÕO·I<º]T§ïƒ^g7OýÝùÞ²æyèWÐÿÚû8ŸØxüZLûˆ ÇißfåVù÷G¸ßð•à„ÊÎò›Cð›õЧQª9˜â Á^—æÙ§‚Ç {Êήgyï“{Œûôi_pÃ\ü¸»µxcîá÷l·kÞ¿œ~ŠªcØ9Ë_êhßï#š_¯”?¸gûˆçÉ9‡º‰ë°ækÄ? :çAúü+{‚/ úñÓÞarô}ü^üAìmàEÕû.ÏY´?)Bœ‚\6¨?õ-î;¾ƒçnV=¨ƒpîWÜWI+pCXuŠè#øÓ@%ö1øŒüo¦ö$¶#/bŸŠWsqsÇSWó^„þR=é}äÌz#x%»øÖvZù¥|ê?þ©úaä52Ï©^'â þÉ ÑêW¼ïuËœš ŒÊ_ÅmÊóMÿy–æjoRÖ ûàûJñ\Xü$gpÏ–Éà«™8·f€úΞ%thOrÝMàJÇjñÖ|n)é‚óéÿŽÖÜÕcšKÑœxÍø¿…í5—¦x´HûË£½u¯‹wã õM·ûö —lpMÃÚw³;z\q~Pû~ÐÜM%8½xrà݈\”>ª>Ž^ê[§ó;_u¸>èOüí…ß§y#ÍÛ­â1z™¼´m=râŽò Ržrý 5}5?8Os° ‡9ÅkÐ[õÙ±…âKË}þ6ÇIÉm ñr?(¾’ËÁññ^ÍõWÕ£Ö€·CçqO^íwˆßÎmÈäüê/‹‘ž‰‡5'Ȉï&ï2êù«8_Kù‡ÐJ~®v°øtNÍüžÁב³ÅÅ÷*þPÜ<ÿ;,û¹ø1oïåý</EÎ:8?û‡ÈEa3Ëò@îàÅü«À™Î p|ðžÃQÏ9ú´¿Ã~¾öƒUa§½}°;õ›w‰ŸÏß 9kÎCÚ®?Úô$Ôƒ|~ð,âïAòÅÁJÕE‡qžöQÄ-±‹±sÍût¼ÈŠÿÆÎÊ?ƒÿ¾?ïäů¾,ÇËä…ŠµgÙoçÞ £Ÿ"èWß~L}Oc±Ï^íwnø£ÙOr^nïgüôÄ#þ'Ïaá§gÀ‘iª¯YÁ»óU§°Ìn®R=|½ôý âûÝsL}Áþê·\‡½±hG¨'÷ôŠOj®ê‘ï!Ïõq~‘ò£­5OÛYý¶=äîâ÷Í9äUeàô"?8Ū9®˜½]ª¹oÍ!V­#~ ^Eýº`um˃⿈QWªíÏçû(_’§ºãnñf…ß·jÚÕ„]õÈïÙr¹‡Hä;¿Šï-›I]6ò±ö¡M&¾ÏVÛò+ïYþ¸æ±¾A/­½eßþÒs'ÔÒ¹Š®ÐùÝÂ9û®ÅŸÔš×“ußEß±§ò»—?mË®ÜJ»_<¡‡åNˆç#Š ÏŸ[{å7*ÏwRû÷‰Ït.þ¾9î jn?øºæÑ ¾'GóìU‚¼G±'EoÃx÷1Øýf^›‚ëÙ·˜…=wÜG^"”Í÷TþI<ذ•ç¯üJsÞiNø”öFxÿè%šƒý€9¶Jñ\–žÅ–YûN 5x–È}–Z™ ‹§¼/rœ­¾\§SsÏãßrÚaêžÓþ³ÄWÞåòÓ[°oþěݻVñ:ŸçŸŠ~xÄ 騾|/çÓ |¸ý/äÇþ2ç<óèSÍïÔÙÜkïH…êšçõϧN™ûö¸ä,ä®ê.ñÐ,#_ç?Fñü‚o5Ïë òïáø*[)Ï:‘ó«{Xõè ì\AZv „8ÐÿòV%žØüÛ‰‡ Ä/e9Íù9î@K.·VÕ’Ÿq{›ç´‰ï³š+›¬ý(}yÿð¯Ä—¶lõiçóÇ_³¥hs˱¦Èì[ü íýJcW£o¨®)ÛeàûµÄ}ÞÁ’ƒ ªÿý£x5žÕS{ŽjßZç¿°\|<âÿâÙ˜x»\7ó=îì‰ÿIì\üéãLá¯Zñ_Åy¿à ä§|uÅÀ|Íÿ Rþ¶\ñÓ¹êŸÝ¢<ÇÍœ[¸¥ø¡Óü^Y>/»yîìiå?Ð|×£è_¤-qªõ|‡ mñóÑpLävÕc}â9Wób¯ ÷n×¾—½àȸp]4û÷ׂNJŃc€Ü˜ó‘‹ÀjpOC{ðDõ4ìoÈ…†ãÇm«¸ÿ²ä§|Ú•Û‘Ïmè)ÜÛGõÈ3À yªŸ–k®ú'ô2v³xF—S‡(™ Þ›NâßU|ĽÍ^uêËkç>kª^ÍßþN<ìïeàþ¨<ŠÝŒ<…t©ß2xµøë=Ú8{Ý¢¹²Ÿ47T‚^”f‹Pü=®bì}àiñdE¢ä‘²•ÇpUrN¶°úÌ—j^ë0ñGTûúnâü¼/+¾:Žœ.Pžìõkœ . OU½Ä¿ž~ŽÝšèÿ±)»NûË·«ùäÌ­ý¥ž”Ç|˜çó`¥àÌÚê/©Ñsž‰üzÎäó¢‡Ð«æúS8Cñæ™ü^e_͹| çVÔÙ—sËù€xvοÜ_¨¸9¤¹>ŸÿéB|\)^¢š÷™+÷ý }« ÄçR#}Y„= ìâysÄ£õ£ÏáaøÙÈ<Õ]5G:Ñ.>]ñrF4—ø¹ôï¿ú'êã9Svc¯æ~Ó~8ñ[´'$ò%ò^àW=Pýcá‹Åÿó-8!Ñù¾%>°oO½ÎÏÙWq®ñÐdÚÈ'WÏS¿^3ÞéL¾4êÒþËRp[äjpNð]ì_¼»ü|c;“{r¨~‡vâ5°*ϹQy«~ø­èíê³Á{ŽW= 2…çýÄ9ÆF©N¿ ?èÛ¢¼ç(x_ÝÑŸœ½¼OíËœ¯û6ìCtxõ~оaÍyÛ¨.‘­¼ÿSœßÔ‡ÿì°T˜òLôyZa·¢â,ôÓ߯мRŸãº{lI^Éö¶òâÕIs¯E†ö‰ý†^”ˆg¶\õ´šäïš k®p¨ø‹ÐçJüD‹­[¶hÑòô¢ö?ײEëmÿûóŒHóDù‰VÍ?q†þ¡Ý° ©ôYœ~¢õÿ~¢Ãÿ>ã›dNŸþèøüË¿ýÿßê`«þïênW…Ý?ú¿íú_Ú¢EÇ-z›LyÃ0ÉýVú&„¿î³ô2V‘È„ÏÆ©Gš´„ç*‘GtTÑào¯PÄÍUq˾AM¤?c¼›ÆT[k1ÕŒÓ(’&Ú¿P±ûëM¦@Ky·r¸ º6nB˜=!Œañ‚êè]€Á‘‰WW<ôeî 0Ró'ÆÛ¬äoªœçtjÙ†=¨¥á·HD^‘xø¶¦­ÿ´0ÙîáùÜÏ5÷¨Y½AÉ£¾^MqnÞŸk™1 Œì-TMN7@GÒÁ¹:úñ\ÙI¶gÍC©Œc€™ˆšá '¿—6]xß©«š‚qS†–)}2øwk t7@@õ3ÿf=K2Îò7F#SI.c/ΧJ˽ËE¾Ü„ÓJ}2}õèsM‘ÜýKÒÒÿ¾†QÕüʸVLbØ*]ÈïÕÔñ¹ ¯Ä6ý¦¡|‘^„<ï&-u Ù1þÆ=8Õ^5‘ÿYKS`ŽšÆTs¸1.ÐÁqŽTÄPq z>Ï•¼GÃ:7©¹ê8Î6qϧ}†íÂdôÁÈ6}‹“LžajuÙ|SÕšï]¯cŒËdoGŽ|y€ßF@¬? (œù™çÛM0%îý¬÷× òL~Ð Œö¯œK²êõmò”)ÚRKƒEÂ^5IÎû,‚Ù†w¹¯‘bTÉX•¨yоDäHgÐ$V¥¥,þS8?w. ¼*“ !5OA×wù_pÞD0êÛ"»ñúšm/_f2^œyßË1%÷ð§-÷dÌåœs§¨‰gà­Ò†“®í‰ó­üy6Ö=ðù¯Çÿ5ù.VñIKTÇ-[ÿ×7õ7š¢ïòûî.€¼b«H¦?ÐpËe¼OêÔ„¦úLñ¯ÔüòH²çÆôÍ&ÐYµ;Sûï=åCŠân5ŸGO$e?Oðéyd£ñùoÛŽO˜,kXý,ýý]_šÏ|ë}Sñ¿kéï9—ÔÅÏNú̱Ɣ^Œ\W«Ùè\5]ŽœNi‹^ÖýB°æªÅN–i™\S9mRqÔ%gžuÅÛtß»×8w™|/$%¦Ï;Ô¡—×ä2°«õ=¡‰;~Ö$‘‡EÊ[ü6N7¬¦ÔÚ¶"þ†¤E£Š^þ‘œ¿iv*læyç?O’Å3MËUÏÆn¦—}nºpÁ˦!ÉëGÍÙõ°É¥åkõg ÷5­ñUZΜØyã¤ïþüÔd÷lwrîãsž¾æõ&×zä"µ`“銯þ6Eåû#óÔ´zZMW` ®Â^æOäy¤–P…ºSrÅ72ÔX1¦Ÿ°š’ªµŒ'VEx%·Ü­8_Ëe$±’¯ð¹µpnÞhÞ›ÛæËÒ’ÙëM†U~ï^ä-½¿ Iðlî53SdwZÂìÉQs²Š1%GþÝ3DÉž£¿Æ3òÃw¡?©«ñÞÒ‹u<÷´y+†ZªY_Ë LC¸7ïS$Ù­ÊMSÎu›¬}ñ‹Î·UkiŸGK“ë°CÆ.äËhË=†O‚KâïàÏS§TôÜÎóG{#µ7€§"ý%‡Z¦0/Ý @_’oÜ·½­û¨ÉÑJ8n#x%)½óQÑ¡/v!p 9Ï s޳žWòûê&ïÎÝiÚ=ë+It ÷˜š‹Ÿñf( r7Á¾3¢æÄï°©.o¿êª»MÕkw {^}Dqá(äÅç\Ýaä¼zïéZnjZË=¤ìÿ÷ýOZ[jMž=jžþ‡¢@ÍYØçMàÖ9É™+ç¥&›f¥˜©»÷2¾'&.MÝ}N'‘óÀZ‘ˆ<ÛsLdn6ΫÁL’1’)»wˆ8-q-rÖPŸÅÇùω1Ä–¾•ï‰lV³Ò'Ø¡‰Z*_|%Í©NឨŠhÑÎÈM<ÊŸî÷IÊ'jHþÈU¼š·wêʯ’¿™¢‹4¤§¦[ãÒa}º?8ÞÔøqü|‘­ÇWŠœã2p@Ö:pJd2I€–E[«yáî3µqÁç;îífÊ4 =^5º‚ Ê>7Nmj8ðºçSªßk<Š>¥ÕM{okò‹$ó~?¬e©Äåa%ã#}E‚ä׎[ùÿdRCÞ[‰ëª×$üoÞÑÙdÅ^g4›yM$¥êµ$­ºŠ¯ˆ´æÉÆpšû1þåÜS=eWÖ`×Ó_ò>“®eù^j«†Ìª±£†È3ŒÃø¡\5=F˰?•µèÉü<†F–ü_–ÒTà"yšÚ¢æ´éZ>yj¨ÆŽ›Çåe!75Û°+Yj¬¾EË¢5ÜR+2Î\-͉ÍGÌ?QlòŸnO¾ˆý|Í÷9/Q³úx W-‡ú»¡Ç ?uáÌr›)¾ìVŸ˜Üª…É·} ·ÁN75b“oˆ”ð]ò%¾‘óxkîŰ7ĤÈ퉪[C¦ñ0¸:µ]øªœSs1çéºYË•vbât_™†÷öâ²ö1ôökSÅ›Í]+;šŒ*ìÞÌ ~¶î~-C[ª¦‘æx7¨ˆ~Hø>' ‚½J¤®7ˆ0•©É¸TÃh!‘Yù¾En«µÜ3ÕûnFªYرGKD:Èïû~æ=ŠÎ¢™Ä©&㈚öŒBéÛ_à‰à-±×Òeo…†üá{‰ý\Ô&HjzEÖ•¾:r¨Åµ£M•ßÒtf\Æ9ÅÊñÛÆ|^°'EÐy7Ý8õ?÷^Å^V¬¾øÇM‰ZÖÕMCÂýxïàÎ/Õû´jx&¹úÓoøÐ”z<æýŒ¢¡Ñ®e‹±›m¦†eœm wHEù\Ë+Êkåh˜à:Ëã¯<>¾»Ôòƒ€ÈU-/jh«^ù¿E"SïÄÿ›µTvÔ!òUï$*Ou%÷˜î‰=´N$Î÷Í¿DWFÔdT÷"ø&¹”ŸLB~çÜMÑÓ’TSÓ@ÎÙòøÅh£%.ƒ±ßÉmü{ã#Ê“m$Nµªi1%nLnCŽÂK4äõø`Áaü¦³…ȃÏ%^Xø$ù—Ô¦ö“^7ÄdÜ,«¡Z§ìHl±–%× §‰*{ÅáÎýÿÉØs×ü^r y‰Y*Kݼku—¢ûL15-T…‰O³ ©ï×0‹ñ1ߟ-’´PWòÏ•%ć®?ñŸÕíÀcã6^þÑÆÏÊL5k.0îàüëæòÜ…Ûðwñ ÈKáÅ"§>¤¼Äiå?ÇNÄ|Íx^öìCâ¨ÄIä;Z¦|ùnìüüá4Gû.ÕÐâàB³Èoâ'ð§áñÈCr-8¾¢€|Ïþ«8Bþ$w8÷‘&ÒŠÞ4‰$Ÿã÷*ÅÔ Æîmx®ÔÈEÕ¥ü»ñ-_&ÒOûÅI¼+ˆ ÊŽ’7˜ÖHñcæ7¦§^鉖d~åjrtßЯQwÐ \&Òülå¥ý>5oÇf¦¹5±]Ë¢_Y©Šn;ö?ø~8tçêü”ïv^÷g2>TüQL~Ðò.MJá ±Ï5Oð|–Û”_› ~MWð¹ù"e-Õ™±ÿžú´ï[GLÕC¢"»­ÿ 9¯ë¤&àk4”§å;Ñ„Èv/™¸†_Ü÷`çkCë¯SÓßàAûx-Oú󞺜¢vh 8lFùÈ„È"“¡Ož·ñK©ПÀWªƒ$)Ö w{ïÓ’ÞÕÈ}ý pc²%÷éÐòec"ñWå2-‰ÕYj yÙÀ#ʇ=î½æ–€ÔÊïÏãóR¹²‘³d_ìMƒšQB;E‚l£Ù#º\K½êð[É ‹{ŸŽî1y_–ýý yñ~IœRù²êI·óY«&®sSrK›4 k,ÿ¦ú‘'MÝF~£²÷ºB8å%â‘Q¿¸Ι0ÍD³e~нVËF:àoSÝÈs§O„íj¶n…]N5òÞµ‚#Œqüœå ‘Lã>R/¨ûç7õò¸™ä+¥ü‰_Ë+ýZ–ãUþ?™'ÒFá,ÿ½ÈAÊÍ=¤J¨OÌ>‡x(¤%Äž*-/+ÄnŠÔ»á å·`·ŒnÈõä%õƒÓùý5¹„/áy¦ÜðŸØ¸î65í$Ì(¼má_l*Už/²@õ† äY-ɧOžŠü%Ã/8Íœ‡G¤s©îà*£‹pÍàï:òõY/oaßçþÈs&Ö#gUÝ•§Ü‰œ•=þ æà¯Œ·”¿ýª¿K¸x9çn¿]ñÀn‘â}$2Ö 8çì'ȃÇ_%?i™{Ñóàsëšák¯Qä-ðHáîcæ«ÊOˆL¼þÎ5pž–j¨¹¥aŠò/—`]f‘Ùä¹ À¾Ç¾%¿G?¦}€>$ÞGcj6‰´yYö8ðBõHðEQŒ:JäçïÞJþD\㙣ïRŠî% Õ,ô9ö#ù~´`«ÈÎûñûéÇÁÛñ‹Á‰³5,| ùhxû_";Ÿµ<T£_ÃöM ¿ÍýzoQÓÁ"~>4OËT>w7\«¼ÎØ‘ìæ%ß!'e§i5›~® µ%Ž0Ö"×[ô÷>p¼±‚x¶Rä ÝŸç1䳬IqõàJCùȆ®áÜjªÏúŠ8.p= khµyXCKŽŒÞŠOwœúü“]7š|Š,áIÞ3Ó†|Õ˜ùûTGôÇ®åéèWãNô9¶ýHÌEî“OkÈtöÒ¸“skÈÅo%”_ªÙ”§Œ{ËÝó$í“þúcÿÇ,h *®ðhyrøiäÍÈå‡xŸXá¤!ä­}»yO½îÙÂyÙº"ç >éRœ8Ùñ)uÔ@JKŒ7p©#äß‹5\™£e˱[ñzä*ô?_®¦ÔœßEu»kD•ÿ«¡nèÝȹ…5Ô4ûsÈjÒoë‰_Œ'ÁF!þ •Vó×àîüµØÇC¹ßÆ—‰¿][ðÓ¶Ø£ü ´äà.’8¹¤ˆºWñØÁÄì~Ð.ƒ“Ø7LGÖªž<@]>aÁO‡Zç¤Î}ª÷/_-5?ï&çÿgïásr_Öò‘R¹E*Ý$²@±šÝDŠ—ñû¡rî»üVêT¡‡Ñ[×zðC\ÍÏ¥nð›uv!: ;˜¸ðçÕm^u˜jŸæàÓÌ^ÊCmÅn%*ˆ£“fprô-ŸýKͤø¾9—Ún@/“¯—&®@_ҹϦ=¼_ nH¯¢nšòj£+þÕiã\C-øû¸‹¼Áôà«hìR@C]e—xïV³þA-qkÿ¨«Tž9B¾('ƒ¦°Š›°›ÉO±ç™j®N¾Às–ix=úöÍ#ÿgû;b|Ï{ù44›8n4®Ã>¤Sè]âvÐ=FKÄwâR_Nôÿè&SNw¾/k†÷CœodyÄÔ" AxÞHh‰Nq>vga5v¥ZÃŽÑLž«`8qñœáçþ9à=“ï"ä²dÍw!3vaþ]_x°¬»©¤y¿ä÷ø©ª±ä?ƒ~ì«9‡sO_}fŸËÆM©*pƒa£Qù3ö=ùfšYÂa{Ü2ñúÿ…'ÓLÆè¯ÿnÞ;–'’›B~®ÐÆsÞÆÏdt‡Ä4ò¸HÕ¶‘¬>€\§ÿÔ?èí3úØœµLì{ôÈu¹H®Öj2É}Ôþ­füqèw²H̵Ô.¯'ñi¬›†d_׋äÏ=­5´ý¸†ûÞEŽÃÏ¢ßÈ»Dr°#ž-øÅTîÙÛ–8 îW†pŒö¼G‹?Ùã?ïØ²½É²Tä"‘õëÿ#«U¿­W“w ~Î4ei鿽bªyçß­{E}g_j)ãØ±äAâžÈ½èOö ð]l-z•|9¿°ŽþiO½uàïÿÙçwT—»\Ý0<ÝŒK»”½uǦ÷ó½Ewòy5w"·±°Oɾ¿n÷ê;ÿÙ7êÂ)3ù ˽²Oã‡ÈdÅŸ Þ>àëô¥Äe?ø¿Â)õ=çSµŠ>•TWòE‘î ä¨ûu>}4Ìý(ràú|è¯þ³Qä›Î×rä"ä×uƒšt£ÜëÔRêuñ—Á}ÞõjöàÏê´<:tH8þ ÉOy)OÒô>íAš‘³ÀÉ)uþ†1Ä þÛÉsͱPŸ™ü9õÃÔìjHKÈœj¢n˜¥þ«ó´Tå!äËš]ÜÂû7g–ˆt)ùznšxWÃu߬0Ål"‰ãWSKð?éþØ}c%yãnÎ-qˆ{õ]©aÿsÕ·pö8ü¸~ÎÇô¥7–t&Q¢%5F û—šM<‘~¼äyXdÅ#Eª!òtã0~6ú¶†…UÿÆ âÆgoF/ÆÏzÊU×Nc'²'a‡Ý~éá…¼¯9¶W¤êa ·a¿®á|GÝB½.UŒ½ð„ñ3§´,MCmDZe>~/¥á‚áã ðCÖQ䨮 <›^ ’É"ÙCÞ&Õ95š¦rÿ¼÷èÕèÃäã}¶ŒÐÕäËßEoU¾t.÷S¤!ÿÚ.èiÝ“àµ*5¯ƒê‰Q8ª<ìD-“žv9~ò5‰$öjÞ/™Ïý„W©¾ß^$V9¿)’»ð0ÎuÞý"3öǯÓGàÛ…~•ŠÄ«¼¼VüŸA})ü+çæ?&½ w4ÜC|<ˬ—wlìdòw™È †·ëÎ÷ùþÖ’ôeબÑ<ŸÑžótÉß5Ôsžûñ+ª‡]þ]ä}Óä %ªyÜàú‚øÞû´–»h9BøsôÕ´Mz|òyù1æI¿ßr¾©VKІø8çÚJì蜅ï¶ôüziÌG·-JYû˜ÈUŽÎÙ˜¤%"S¹Gó&-ÃßGæª;B|’|MyÚ«ÑôÅÈgòcÞ³¶‰øsÜÞ]ë~Zù”ɽ=¬ü•|…Ñ?”ªÖÐZkž+´—s›œØRÛøçñ¸–Û×XEÝ7z)ï[óv¹öòUƒÁ ©Áš?é‹ÿóÝn©;‹û6Úß²[ nõ«n7ø;‰$9œì8 ÎŽsî »´þÈÒò& /÷Pï2Þæ<'ª_zÁ³ô”K¿MÂß=ø~WyN/â~*¯àþâ"óqo¶òû1v,[ùìúþêÏ™¯¾› ÁÇ ½À•5½D®³Sä’C±§‰ƒä³§Õ’þŽ6:#çÉ'ÿ9½sæJÓ¤Ô•|+šû€EN½O}`{è¿»æLHŒ]ä½R"Û ßŒ]O¹EÎ4ÜPù2þ [ynß2ôo~òTÆI챇~ D+õ/¶Å.F„Gnøaw%¤DcÃ.6Ìàœ<ª•³êg4´XÇ=äèçs¼¼×ÿ7îÓ’ò[‰¼»±«ÉIÈqõ|ž?½PKq:i¹÷úƒ²µl RsƽØ[Ûùèu™Òp‹û˾’ù£øåè[,÷²§þê±ø“ùIìræ\Õï¯åÞ‹xŸ1Ÿá÷ýK”/?‰þ'÷¨.UŸó!ôÇåÄNVŽÃï&먫%—“/Ng˧e+ófý¯ìi6y-ØÙ˜SùåRõ[¾¦%bÔÁ|×Quw"I¾Ð<—ÄÏ6Ó§fˆœ{kUÏø‹x©êUì¦1\C±«9O×fìm]sÿÅ~¾Ç|‹Î{µêÚ”·ÎäçŒKy>ãiäÍ3žó›æ¢4ù òZ‰Ó"ÇÔÐiê*ìo‰SK™6‹\{öfZ9qÒôVÏN˜8ÿ¸iÊã祦½Òhòü aó ØÏ±›®÷}Nܘü“÷«Ó²éÄôcr¼èŠ<%œä ›èK6ŽŠŒùcú­ÊÏÇMÞG½ÕÕEd—Èï&®i †-½[°Wn“Îey)ß—ÔWF^Lÿyz‡òU±›©Ç÷äbôܶŸ¼J® y.\¯aëJÍ-\E\¬Å¯úvƒ_f®$¾w¤&©.šëGë›/R¹/‰×‹niÎ+Êo¾Ž}LT‚ŠD¾ûNý+—¨ÝCs½–æÔ*ä99HœÄ_E²ÐŸ ¹Øƒ”ú5g÷¢>R}ž–ªz‘‡ª|üËÌ/èŒlâyÌG~fìh¶êÿ¶–Ê_%üÖBò„ú¯Šœ¸+yͺ2ð~io-e ŽJ~AžÄèˆ\×_Îç¦fa¯1Äã>›ð£ÈuÓ Î)ý5zþû;Žœ[[‘öiÁ#Äk5/+N¬~²ÏDÛw¦‘ÃF“O¬èRßz¤=òf9ýp?,’®&æs‹´ñð\x2ø¬±yq•ãÏ-Ы)’·Nö§¢ÉñsÆ*ìSáç0&rÁþsñÛAôb®òèÉü½9‹{t¨ïã9þL·â¼§«ÿuÚæÚšÞÅ9U÷I­ NjIwø:žßie–\=©aûõÄ© Õ/ Îk¥úWõ*úÌVòÖ1‘YGwEà÷KLä§*u/Wãƒu¼Wr }…»±ç ‘”2°sÕ!~Ïû¡ò£}È;”‹4!z¹¨n^¼Š{lX·¬fkˆß»úÃ×ñ| "ã‰Þˆž>ˆ|»Kä)FZõÕw7öÆÏ…Ð÷úeÄS¹/@®˜ÜŽNòW /ã9Ü&åA7h9w÷3ÞFÞÑèÅç«/}-úãxy¬ï¨¥&V·­¦Ÿ±é%üœÑ{êß­žÍïB‘,ké¯1¾ÿTî¦ù„üF4E^Æ¢зœßKü~°Fo‡–ã·àŸ‹ÊÁQãú­xèËœ“¦ªÉÄ¥?‘·÷h³î8ïï«É÷j‘+¬¥^=ü¿þÇ~ã-×}9(ùZu²·40ûš~ÒèàÿëDò+Ö2€Â…ëÉ·ûÆ '‹<¾áòÎ-ÿ "7ÙÓ™c6½À¼YæŸ,} lÓÒðxä¼ðnp“÷aäÐQ­åõ-Á1ÓoÀ¯y‡c¯êƒ_‚VõkYx\ùc¯úPœê;Tݽî9îgæAå7o™Ë…øÕÆÀYémZ>ý>rf®xäüŽŽ[a2.îæ­ÄNø.æ\ëªb«êÇÛUŸÎ‰±–ÀÆJU'8ƒ÷)?†ŸH·Òr阖ÏfwjŸÄï¹ï&~®šF_Mzuüxù–Yu"g ñ½MÇÁY"½4îÆOçA|›E\•Ã÷%¦ªÏþ çºOù‘·¸çH&þ¾ñ/äÚ¦¥Õ¡ƒÂW"¿«nϹ¸îÆÞ¥²øþ°–ħµ´Ð׸1ý=ùqÍјjîFª/ÅTO µWžçäÔ©%(…SÁ-.‘f%#F'õ³W¡‰~<ñ˜êéÃñÿUV-)Z†~&Š©›Ô_†HXÈ/ÖnAŽh^ª?ö:ØRó]ˈ§«Dn—ÿ 䫎 Ô->@~#òyð‡Ð˨úÂ<çòû™×a‡œò\ñœÇ°|æ «:ƒÏÒµØóyòss.ÒR¶<ÅC“É+¸Ö‰¬¦úX{‘ÇŒT¼o÷%÷á'¼-Ez2ˆs®U¿¿§ö¼¦‰¾^_ò;¦e ³Ô_Q/?û!õ´â9ÜOäÕŸ®$®Hæó® è«y•pÅzp ¥Ló°Ý±ò>M-ÁÕwB§¸·Òˆ[¢ês W«Ï°òUý3çîÜÎ*œÌ­þìEèGí|nÓïøÏ°–;ÆK±ßÍ}¦å"Gµþ$²È³•¯°ó{Ùç³íçó 3ù6»–:6ƒc «æòÄ—휇ޗÝž#ŽKUjid&xdz¡ø"Ê9¿š™ûaÞÔìÒ£–ˆDÔ·3y.}$ž‡ù÷øQä ù÷mÿÜ]3ûÒð¡pÃYZN¬å—¡'ùÜYŠÏƒ ‘WÕhî仺7ø$q8Á}LËG'`;S<ï)~›®¾ã$}©õW¿¡üXGô­Js"Éuø‰`•ìÌ£šCT'z<^ø¸¤Bqhú5Õ¡[iY¶òå%êŸ4^!oâÒÒ²y'¨G'B݆7¨Uxq(©¹íïŸõ@îC/ªð žÏ·œè^$r»Ùà¥|/ÿoì/ùÆ"oÓ/&[‘h&3MÝÂù¸n—'&¥fñžóîij9qÕSþoÊZµTÝ}€|@ÓBäÔï‘?ì º×å]éVb‰êDyø¯Ð6ìºkyJïOà…ÚéÈËÌnšŸ¸ 4«¹|Rõ´ÎøŸ|šºCõõe|îÄ+ÛXò¹ÂG…׳dÀWÄý}¼o Lxó­µ`çò—Ðg˜ÿ÷‘º?ë]©÷P¿V®HJ›ŽŠ¤±›æ½oäù‹^§/8zBËŠ/¡¿!ý-}JäÙyê]çÒ‡üAKñžöIøíø÷|θzꪥíù³^¤Šñ<‘.îÌÿ 2¼ø ägšjÔÛT¼;gX°{ùâ‘HŽ¿¨K GþA¿v2¹MÜ€~Ö]ޔ̓]Ü¡%ªŸa¯ ú&ýïi\Ï÷ZíèCU®úŽ;çû^Ñ2Áô¼j†òâ÷Œh¸=œu!õzßoØYsXýÁ=°wµðg–Kð+E›X –|»åœ\ùǪïðLÞ»Vçœ|’{ˆàÀz·òœO{¯¹¼ž«¸Àý~8PËçä_§euŸŠœôiôzÆÄó¾zÎÅR‰ÿ«8ÌX‚?ÈßËï'5Gð·âÎ"Ý}TýUëÁ»-W÷ÞÄÏù3”?; ð¶"ûûeÖœn¼%~Öv®òCEZ»\uáuÌŸxÏÓœP-ñTÝCèIð ì‡ñuÙ[ZR±•Ï©ÿù¬ºŠ|Oê<ðÌÌë©øóÁ…§°/®-«ûœÏ«2iCõ.û^üˆ±…Ï)ø‘¾‡P5y'K\óZð}‹Êþ~É~ y°íÒ2ê*ñ€Ý¦emÐïðØÃä4â–º¡šûnBÏÌ÷+_´œãª?L=ñàœùÔ2ˆ·êõ-+ŸØt–ì.À^&ö©ô >§â ‘\kî¦nx;ß½5ü$µ„çšûóoâÞk¨žü/ù?óIê#®áœoüFäÖŠGÈ1™{4áÏŒÎØÙò­ôÁåf*N,R|yøÞvkàAü­E¸`aKôܽƒ¸$¬8?~6v¸jvdµø…†ž|_ôlÍ!Ž£®V¾cç{jwo Á„~Õû~¤>Õ[C¿ ‡\£¾Û&Í6Ï+ý,þŸO±CÁ Ô‰\OŠ„üIô°éJ~nîåô×%·¿å|®«ì§¥XZºe»P¤Ë™øWçpòzÖ>Zzÿ7v1ÞOþmu*G7ìwz1y‡¢¿ñw¡vø±¦ÅZ"QAý¨¦çÐØ¨¥nª—•º™Ÿª qo™×RŸˆ'±35oÜÎÊ‹©ï »x9q\ìpÓB‘‡²4_{)økáàÆÌG±ƒµÃÔÿy/rœø‘>¤PùLæa¬©Ÿ*I>(°yžªü;š ÎOMÄYž†ÿ©xòíKŸHE7ê ~õ9f¼@Gü^Í›*ïf4óÖ¨Ž(ÝÒ{ÈÃ×nGO¶ü¼ÕÆ}$?Â4æ¢OÉ©øËê–Ø+Ï`ð›k+ÿvñsñnØák¨£{´È&ž-÷¨9Eä?3‰Þ”¯Æ/ÌKý0{­æŠwñ9¡¡œK SvPdÝÃÁaN‘§z#¯¾7¹ÏºÝà/ïä¾ö4ö. °h€ú‹~Ô|Î4‘‹‡å÷×ã'ã÷“çNm@J•oLžÞ™ùìž-÷¾{ØdoC´DKnܳàõL]¨¹õkÛ,…1®£®˜îEü”lտȧç;‘Ûï%ÿç[Ëï»CÔñ«6&ú“·ˆl—¥ŸB®fkù[(…<…ÅލþOüðÐï˜÷ð•j¹Évì¤[ü‘"ô.óK>oawð„ñ:úcLÔwÖR÷/ÔoúþgìYÄËEfâÞˆ– ÆcÈsjˆòeSŸN‰<;ëMìHq -_³_:cÌ DæbïçÞ¨¹®ZÊr v ÿ#üt\|È.õ§¤®ÃnÌý‰ù>ëjáØ -ú ;æMqîõ ˆ"Óx®q¶›àyàÃÿì2r–¸¿ÝÍçZjÅ[qµx*vhnj:ö°æUΡNó“ÎÕ§òä%àãÙ¥ÄQÆPÞ+ÒOËÅ[G8ÏD’àK‘ÛÔLü§k>}ÌÉmä%2ýØ_kOêœ%¿ÑW·Nó*¿pÿ^ñ—͸¹.ý?’«ezõo’‡š1‚|•ÑÞàåû«†«Ÿµ”9…QúÄâ6åÑ5G˜ZˆŸJ´ßâ•ê{m%žáqÈ[r;ù“ÔøO«EKš~ÓRølñV$þMõŸõåÈi~”¼Šãcðmt0þ²ø-ä#Ö@œcLDOb»±óUk•Y?ñ¼‡ß j)Lb3y,ÛLåi 9·˜æÉ½½ÉGÅfjnµšZŽLÝ Ž©éÎÿ'ŸFßÝ‹yÛkØý¼]àøð Êûžæû¦½¦þ!Ù£ }ÕªNò°–4ÜËù¦w#ÇÎ×µ|e<Ï›Ó?Ju7ä&÷væùÍ&âÐ0äªÞày+ßÓÒJ;çX yüÐýèw±ú]=#ÉÄ !ñ"ÄÏÏòõ1 p[òŽNú»;ÕœÏ šU¼¾ç$-É:“Ï­Y¡¹`7¸Á{-øÃHÓ/[ïFÏj¯FoKY¦™ŒŠ—ZuŠà#’¯ŸèûŒmBßÔ7ꋇµvc”øÐj_å¼âQñíï<µŒ~¤d%¸>ñ8®º€sŸ¢ÿÕ›æNS=òBêRŽþàîæ8Òv.rê®­n߉œÏÏy¿W_çʧ<­¹Ì[wÇwà¬ÄÅØÍèÙÜ_ÃÙØ¹ÐQî)•I¾/Ô\Ÿ8H½&1˜ûKu朢Ç5_úæåÕOX n½~§¨–Å{ÎÀΖä#ß•s´üw)zV?nòyñªÄ£õϹ¢üÃGò_³ÕPNœ{ÍŠ•ÿ)–iœò‘â;ukù^ô&ä¸z>ù[ö³r r\SÏ9ùÔ§Ÿ¥s ÇÐ'·–›º«þØUñç?b}—Æ*ÍgÜÇ}^"þª°xïC!çÕÍ<·ÓɯG‡s.SP_ ?§~© VôÔ(¢ßdhÏòg–˜êÚ`_ã[5oxù¬€–<Ï<—ù/£>Ë`­ðÃ'œkêõ5—kÉÔž#^A¾Ë:Žó.S¼Ÿ}5ý/¾ûègXx1Ÿg;„žz÷h¾Õ õÔòØ ä¤n spá¡ØÍü‰«}m4O{úçðp^5šSÏ8„<—ÜÌò¦p1÷YqÿÛ¨å[w›¯¾‰pŠç Îмf1}ªÁrñË:µ¼9‡ŸË˧ϭæ$ùçYë°3¡[‘ßóŠ{¤¯‘ûÁãe å—Ò§c¼M¿{áóÄ éçÅ»ÑUËÏ´¼4Pž½{ãË žÉ¿‡<‚yõºäóðwžM|‘nÝ*¸®E®,[ÑŸØ ž×u†úÕ†ÒOTyqxâKúeògiÎæpP™–by·ÉohiZ,@^±x¤xä¯Ç/;“‰ÏмâÜsjæï&~Š÷E\ñ ©Ÿo®øVl—à?"‡ÕG—},ÙÃ}yÄy êÛÌMÿÖMoþyà›Eí¸·Ðœ[Í{Z2=Ü–3‘ü”!^GÏ?è÷<äÎeç¼Ò!ôÔ&|ù„÷+´ƒGæh^=ùüÁ—ÚÓ8¸Zý¡Öá“*õ•Ž'¾)×ü†1HsôïǺZù\ÏJê£5gŠçk8ßÈDŸ#+nýMýòVúuË´ 9*¿kXÀû®bñtZ°;-Íõ¯äÿËž¢6Vˆ?™r?}P‹ÎÒr§}Øÿ7`ÇŠvÏבï­í%<|Ts~$ppT%ïgÚKŸiTs÷™SÁ}î¡ØéØ(î3ø§â“ š3™Êý×ÜnÕGâçþ2ÊàOܨº »a¹^ù÷'ù=ç0ò·U·ô?ÈMü2ì`ðoð“ë¸p»–v¥z‹×¬ïg¯Åÿ$O¡uøýÐ*ô<•¡¾ÆÇ´4k.yþi+ÈØ®¥¡ú Î?Õ™ûò=…ü6!î Ö‚Ÿ§ ONžöT»xŸª;5§:VËž¯“»“|¾íZ-ɺOKRÅçé» } ½¦¼ÀYàón¾·f?ù±ÄmÄ™góý©™øï¤Uóù'È«¥Ç`çÕØ‹ÈÞ«¶•–_iY±{9x2}†ú¼îS?ÊżgäÍM/¦çhŸK?äudãg»ü;SêaêE‰Ê£š±{±îÜÛä{è¶Þ®y -U­»›Oôâ9CšWô¶ã{,âÕÙ¬ü×Iñ‘í§Ï_O¡ôõ¢Ìo¨K¥ÿ¤ÞèySKéúkÊý²›ñ€i¿A¢ò?e~%&þËÙÈ·¤;Ç6œ§ý“ œT¿üäRg¢ùÚÓ’Cž¥áiõahIybýíi'~.˜/þUñ?æŒ"þ­zJ¼šg‘¿®zQª÷ب~÷Ô¹²'í•/¾^z¨8"5?Ô2vO7üªIüÔ‘?°óEÿЧëLüdúví­/îrüèÔ…ðzFÄ.¸û OÞ<⥂cÌYyžRŸÂð’¿™os#ö4ó2ê»#É+U^FÌ\n*ÈwT.Ô~ˆ¥øKw[ñuµPžÜEÜZ¥{xùÌÙ‡\øoFŸSÛ”oúžûmh. ©níŽ~Ú2ÀY3à¨ë…ýLM¤hZ>~+X#žˆ5§Ý‹{ÎLðýÆ"ÍgQݺžþFø;Ì©?VKöRšGŒd#ÿ3¯†§%¶}NŒÆ:^Qý?BŸ±crP®úoõËÄ;Åà{©ßËül±—8£r*úSþ•æ¥j9ÇšóÌÖQ'î=òv4ØKý÷š“©ÑRâ±!ø[æ½MßwðMìr ½ø#®¯l7åCÿ@N\ÚRÏéŽý4k¯PìZîÉA¾™G¨x»Ù­>õíÚï4ϯÍ¥®¡+çåý–ÏOìP]Sþ=±;0g{W‚šSô~Á{G.GÏò?Õßý#‰g#гšº"uš»Š~Àùå>FÜå}}¨+Oà>êö嚣5 Ä{þ"òZ§|Cx>Ï¿y-8>MMÃÿ,ì@þ³òWž+OóC®Wè3¶i¹où ì^ð3ä)\É÷–~ÿL-SBpÁíésõ\ð–ñ x0p=?oÔ‡xïÇ-Z  ,âySÊ·æjŸÉ1íÑj ?[T ~œµâFáD„|p™æÔSÓ°#UkT÷íý Íàs†ùOÜ.2%]¼ïÕÂ…Ó¦m±öj<Çä®zV6ñOãíâsk=ø^u0á0γâ6ñÊŽäžÌß“77‹w&õ>òX§½{‘­ØËŠ«…çÞ–^d¡÷Á-ÊÞÂy¦ZˆŸLs9‘®ü|™ð…o„êZÞð±ò§i©úgØñÔRòï©$ñ˨÷þm½pÂTSúEáâÅøûêäM#£”_~N¼¾-x®ä*üxè$ßWs5ý…;èûNnç~ªžS=k¢äׇýÈ8F½¿Z}ªsg`ç'üDï+×¾Ã[É«V«^䘫¹ÚŸÀ) {*ß¡=-‘µø‘øñIÎÓößÄ ÕâÏ-= =pÏ¥¾]¯x7¸ˆø0Sý©âãôxxï´ ÿîÕ÷†^¦ÏmÁÌÎ}:ÆLí%Ê¿[ä pœq¶æË&‚×Òë9ÇQ#÷wÞúÿì+8¢r<Ï~Ÿ~ Ç)âP–®'¬Ì ×l÷äLäyë'‘gŒ#ÿPó5ùº†‹Á÷µâ‹ä£o¶íäAÌ…ü}±ö &ßÕùiÞܘ¢=G½TG^«½$“ð«¾w°µÓù^Õ!»¨Î¡}<ã„SBš›stUÉWä1bZjž”]ª¬ƒ?­"¡=ßàÿª/ÃïÁ‰¡'´×nÿžê >'—øKgª/ÿ,úàŒp©õ ê®SeŒLÎÕAW¹AûÊþÕRÚÏynÏËØÝŒUøÕ’}ä«ÜÑß\-­.nàï=eØÕÔâq­ÆÿÙïQXsl©Áuíðs•KµGð¸¨q ~$Ýü—WÄ׿%|¾±HûÉþÅÿ¦žÿ˜'ß3ÞÆL|½Mހߨ¹„z\z Ï“Ÿ¥þÞýÈ«ïWÞ/ýöÆz‹ìY6|—Þ T·ò‹ïçþ7øç)Å—^¾Vk¯XËœ;ð'©Ä9©7Õ——â=½Ê»T¼Mž¶î<ô*ù€òÙC´Ô¾)ÙíÄô„Oò\u[UïüY|xvä,üߟuñ¼w28a‘“ϳ÷÷†ßæç‡µ„ýúì’È7Û¥%íSùýÐxío)ÿè<ì€q”÷½ ŽÉOr+ro?Sõ£îüÜ‚•Ä_Æ¿È}^„|@ÅIúfÒç0çá ^i'¸ÕT n¬Ü$>ªÈSy–«Oä8ù2×îyªåhËã Sz7Ï}Í'ôþ”8Ù}q…¿œÏ™½€þ‰¦Çé#öu7ïEl‰âÁ‹8Ÿª5ä}²Û5jÿY2ÈÜØ ñÞ t~¯rήÝà _–ò#ßh~÷Ö¸„üËìÐë9þów>“õ&ÉÕÙèŸGùÿ£ÄÅ3ž%n7´Ç´4ƒsÍ_ÏÌ*pžOû0³|ðZxâ/’[4OnðMEþœmÈÇ{µ7&ø‚öáþ­ûïEÞ¸ DñÚyØÓò0y ýopiO_1~4%;~OûN»×[©V_®²ÝD¿gþÚ¨Á¯W_˜hg^Ý8€_t©oÀÕƒ;æ·îa²ÝA\žØF¾)°Pû×ò<1õeÌê ^óÄÑ‹ÊK´×´7öɱ^ó?}ÈS%¶cÇCÊ#û;#ßí§ªšÍ{nEþç‚ËrU§hè„~8³¨[¥O9*x¾ÚïÉëÅ+¹¯ºá…«$g—ˆÿö#õ¡]¦9ÿ¶|#_s­]å¿Æ(ïø‘ê-+ù{kPû‰n£î¼ ¼¼õçb=´äZ͵ÞÄüKîIä3ø<ò–u9uÏkØa¿æfÜÇå×¾ |Oûh²ˆKVi_ÐÃÊì¿{;ü„õ2Í­^J]3üÏ.Ww¶øˆ¾å\G¿ˆ~œÆ>>cv0”ÂN¾AŸWqG|~?»#úÙÀ¹TEÉ«§Sª7<À=ç¼I¿§qH{g‹Åÿù%ï3½œºUy­þâG>-žß7¸§QKeÏ×òûÉ&ä6®ù÷þ—x›R%àܪ\ðì9ä,*þºåý2¡îf_‡WÈþνR¯æü(?ïŸùÝø§€æ+âqí?ú\ù„÷#c»âé$~û[æ[céGôŽ OQÇN”Þ§Æ‚-ÿpî>Í‘†zƒgâëy¿œöÄ™žñÈIv xØ7]óš]ЧD?ð´WufûýäÕõ¤½ô.üÖå-Áœ¤œ|{3_Iä)ñH=MŸZâúì¢âÝÎIPÿ+³ßÅÏÕ~æ³Óœ±øµñV&QO»r'y™ÐoœgÑ0äÙzvÚ}ùÞÜÍôi5L¥?9Ù=)¹„÷ŽÜK~vâ§ìSô/Ÿã:ÍE®ÒÞÃ[É›…Ø?K6yãðnÎfð`°=çæº]{«Õ_¶ 5}‘6Ôéí«Žù>çzš?›ÌòÃUÚ{ðò:w ó/S®¤ÿÆ%~Òª;Äïù8ñªé]Íh¿aà«æ}¿èo]¦òÒÓÉ×[íš|OßÛŽ{¬¥y-ùખء0Gê? þóM"¾ôÞÈó‡;«ß-‹83áã¾âˆo<ü:wý …ïkÀ=Üoî â_‹ü¿ù{üPòwíg~Hs§Ñsã=Î;>Š{Y8œóˆ”Ê~ï¤Ís7ö{Î#Ô7Ck°+޳ÉË{6ÓozKçP"{ÙIqÍkèwÑÄó5Ï‹î>íÍì'¾Ïä·è&Î9Жs ÜŸq.’©†…çžó ñuðNpfb+zžÑ\^à|²ó}E‡‰7Mƒ±+ñ*ÍeýFbbõè¯ÚGiàÿ#ÚË NdÄñgS'ƒ/Ý4Ÿð>vÖÙ…>_ç›àâà>übf/ò6«âÉ»‘{Â|7ï*úÀš÷&žâùÃ5àÇŠYÄ¿•±[M°OuúݽÍsYª«O×sÜ.là9Úo–$¾K>~qŠç`|ßÿKŒ›²;Ж¸™yÿFáž:Í×`?â3È'zþ&_¶¨ý˜¦8?4Js´×ã¿«ŧ5¿>‚Ýñ´ÅÏ4ŠßoJ5q€Q ¤þü]Ä_µ)Õ÷ƒ3›Z£ß}sþ ÌúùöoÂN˜ó´·è~ŵøÿžÿWNšÿAOSíÈ¿ØöÐÏx‘çö`7®ã^½3ˆóòN_úäê·+ŽW$ªÐëÍ¿D·ÍÕåÄòKñÑØ!w|±óŒ—ÃJœã›Â¹ÅžC?ç}‡½ hŽª¾ú”=Ï©š‚_·ÏPÞ\})Ny÷ÆŸñ#©{™_É >öîä<,ÚÿX³‰xÆúúíïI<çÝš³+rÔ°MûD[i^ä=ðgýügÉ&äzöOØõ —çO·T]è ò)qí²,?|øöÌà€ÐBžËgÓÞÒ'ÀQµÊ{åjN:û]òÉ“Ž-+ذ9aš¯¾"ËpvD{™B¯àçæÉ/¿GÖ_-~•”ýŒ¿¯ÝƒÜäìÏþ>êS‘^⃞‚žú­èeª}ÉhR¿ÞJòq ã±ã‘7‘×àý¼wðAíÑ ©‰äU¬òÒÉIÚ[ù€ìÊf>Ïÿ ~c²æIæ‹1ï0v3ÞK¼5÷Šß³?q£½û›Û…÷nß䇃âãÏ= _bàKü‚çzíO¼€¼ídÉQÓ¯z͸j4'TŸN|£=“É룰µß!GÑï•ÇUzúöÿšWâ¿c푯ª_ˆÛÓcéƒ,¬¿ÆaáŒ}¼O¤—ž{zZ"ý؆ݯOá/êþ$^Ž–*ý;ïQÿr—½öKg‚šyÈR5|_Î$õ™‘“ð\íÆ{8þ!?±¨;¸1q1ª=MQñ>·hÏ‚»Ï¦iòuô}®äß²½ÍßBd½úÒòÀŸõÏÇkvr~¡jùuåÉ-½éŽ^¦ýx1wÿHó>è¹å>׸Bqðyšç]Œ^ ŸI_l`0z» \dYÁù6”h¿Å5Ús&眲ˆ¿k%þÛÿx#5‹?íÈËT4WçLŸþ1R]ñbpAñO¼oÝ êczˆ84|ZûÕ~æùÒAô,>–¸¤òä½ö Í<ÀïEè¿#€òò íÈ÷dŸ‰ügjžÉ3Xõúüž§zê¾”ü¥Iü"ÁéÊ3¾ÈÏ•éý ¤w™âµL܃ý,xZuOv¡ y‘YèM-¦háJìvÓ#Ø¡è«ÂùãÕwr4ióÞ¾#àlÛâ1^¡ºçϪ} >Kin)j•þì ¿o“¿Í½Xý??I/ÎÓØåÅ­‘ɳW‰ÿ5­}9²ó©Å—WÞïáõKÀ«æk°[ÖÚ÷¼ýó†9Çèrž?S8£ÑÐ>¨ûðsyêëL=->ù›æg"۱ëpæJòÿÈk“pPº‘¼ïKÅC3¿+ÿÚ¡=ÉÚÿ úšzL}nÅËÿ)¿?íiìWx2ò·h糜ú·±]}ßϽN=ެþùŠÿø#â;U?“ù*í7Už)5\åy˜øÇòqc,œ^‘Æ¿·¨íEô®±82r”ïM]«¾Œ-âºJþ\ûÄÃ×s?Aí³µ½Ê='µ×¬hÈô5ÿ½±)5\‘Šb‹Å¿àœ\æh?SûŒoµ7i‡æ§€'Î!n°¥9½Xû;ö#7Ñ銋Õwæ.ŸöY¼·¥‚|“g©öC_IŸ@Ñ+ÜOr7þ'w?W¤ùåS£ª'2зxZ{·î§?¯ñkñT=KœÚ`çß“eÚǼš{±­Až|aôÙ}¹öWÆû•ŒŸÖLäÍ[Æ=„ZâƒõÈqíëàVû,쫹‚ø!ô*çþP÷x3ùÙAúô¼Ú´“ö,Ñœ˜ü×]Áÿ»ƒg/ÿ\pBέô¹×ªo&ÕÜ™ø€`*¾½ŒÚT[Èy‹ù¾@-v/œFÿæI¿+7—¼vÝ?ܯ]|¥Á¯ˆSüÚÖ'ßeÔ“ÜÚ ›ºúm¢…úea^²Ñ¾¨¾‚~²”ì¯C{ƒ¢mÀé¾ëxÿÚ•ÚsÒyŒåsSìJöÚ'û ÇõGþšªˆr§Ñ_4d<6ÍA½@_~[ù“Åosõiãy-ówô¯ØF‹×n•öÀ¼6~ŠuîÓ¹iŸaÿ gÙO¿RÂϽ Ć+^l¯½jWsŸ */õ:yŽ z’2“'v߃ß*ÕžŒä3œ³ÿ^ð¯»~%[sü~3ïm\þ¬ŸÄüXÅdòK¾·ùûÔãüÙÌ'oíÄ{yÞV>î!ú§_#/a7~-8„ø¶Ò¯9ÌGTÇÿ†ûŸTŸå>üvòCþòmØ¡º[È++Ãÿ•9èg.þù6^$n²ßŽ©Ô~ËßÌ·X-ÈKe>~¬B}C•½¤7}±óÆoÚϰŠüWz"ÿ¹Zn’žÿ¢æhSòB9CÉKEÄG‘¹›z‡q%¸À!žÐ䥚^Ïçw’Dz‡ŸÄØÍ÷6äþkµo#¸\}Š7âß*ã?Ƭø¦äÕ9¿™FŠÿ>*ý ‹‡©ôVð±[qU18Î{ŸöDyþÔgà©ÀÕă®ƒG»ð øóo‡Ä‡fžŠü3ÊñÓé—ðcu/b߃Ú3Wý‚ê0´Çãõ ïÅ?gÝÊý4´ÆŽ×4 ùªcg3×m|O_DüòŠÖÞÈWr/ób‰(úü<—q|†ö,_nKªþÑ`ø NsŽ)ñâ4´“½YLßVXñ@Ý4íy(ÀOû&c×ÌâËëD|–7N|´³‘÷ŠÛxžÈ=šƒ| ¹4·Å¯%>'¾H¼*¼ý þ«è8Ÿç-ÓÞ¢ÍÚóðñÍ<Ÿ±ƒü™ö`»Î¢ï¯ä >¿.þÏ jþ°#ø2°ŒùÈ{ÚW`ÓÞ·!Ä“U#Äcþv¿`0qhðUÍ竟:z—öFŸ“äÙQ?jè ¾Œ_4TaoêÏæ¾‚mчÕ¹ÂEès 5ïãIãÇò{P'sBýõ.â.ßjõKtV¥;÷S´ˆz‚ñ¶î·^ûâ3ÕçOj/B=¶ÌÖþIrbæü~$ÎÌßËï‡ï×¾Íå§gª\N>½>G¼ßŸSo3÷e~ HuŽd?ê¹%ïƒ Íâ+öÕ<ÙRü§Ñ 9*ßvþ‹àà3à*«ö™oÔÞߨí҉ĩ3zPmÂnež^¹õåŒsM±1šç<¥¾²oÀ#Y-¨K[·pþ¯æ;~¡ÏhQôÖÿ'rcôÅþhbö6xB›^çûâü^U/ñB÷dniÖØUË0â§Ünyœ:úíêT¸»Ãäïîuo·%>WùLù›œÍ_èùQž»ÄÌ{ýÕ?Ýü陌=(~œ|FjŽöÇ4ñ§]{[êŸÑ~‰òÀåYCÉcû¿ÁÞÇ´/na.òž .oæÍòâÜ\)æÂaõ%·ÖœÖ[ܧúá{Xö7$\ø8/ºMñçKš»iÁ\_…pød+¸4= ÜŸ<®¾Ö1êCŸ¥>¹Fò ͧÇz©~ùµðï_è‹k'ø% 9ú”{7¦óÑEoÎ6«ÀŽô•$Z`‡Ü/qN±+¸¯òwèo¨i ^7‡z]yóð$ñd‹ï¢¼3ß·h*þLjˆçev£Vù¿PJy‰s‘âeØ_)þƵ;è*!´ $_l¤/Ô«9>ï§È}ÕJâ"Ó*x+KWs?ž·Tg©Cï‹;ƒ+¿a/#šßŠ ·—÷Q¿`!qoäéßà4ÿ(éõEô¯&Á=ñ˜úâ߃{Õ×]>_|°ªxÚ!×åÂEµ{y¿Ø>p®sö§lzY¸:o•xèF{úü¯bóŸŸÿGç(®V8¹›º·7Gõä‹ÀIÉ,Þ§j.¸nŠú|ã™òo­é«¨¹Ö¯™“3/@úüYèAâ1x’;ÉxÖkþ3ʽ˜?Fž";éŸ(|ЏÛR†>Iþ=ðüÀ{–×>¼,Ùãûeïö«°'~Ö·œøÅ|/ùÄÈÕ<Ÿu…ò²Kµ? _ÕEÔ3B‡ÑŸâ­ä¯¼ß£7…?«o§y¾2F–ç1ñ¨9Çü9ù¡/KKf¯79”‡ìB^ŠÞÑþ¨#Ø ‡ú,‹ÅÓ]§¹¿ÜgÉ;·ó{qíSL\E)0?å³ò|s¢ÔMMaáÆlâ¶j—ö­ß„ÿ¯.À.ûßV=Vyê ¸/ëä,”F¾ü÷`Ÿc”G—\Ô TžN82ryO/YZñ^üG“s+u—澩`ò\¥ÙȳGq²÷ê qÿ Aäʤý[–aè…m0ÏkjžsÏÏUOßKâ)ñøï%I~(Þõ¹U Ç>&4Oý?jTj¯É½ø­è*ä³àlî!¯'y•üs5ÿüß^ƒüxÖ÷$?$™õ.q`…y‰U÷äç‚ßcsÀ‹Æ9ÂÝ]ù¼Èñ¼žæ~FL÷¿%S^Ÿ]€Ÿ lÏ”öy…Þ&Ÿ“ðÐwÓ$ÈŸÄ+3f ÇöµòÿËÐÇø—œê,Ρñú`²È3D¶kþç~õÍ6RWñý¬}£Mª#«žlkOS“p©SqͽªÞ‡¼4À®—Ü@?´ýwÍ“ÏÕ=‡XÕ—ìºU}|«‰;öñ§ù_ô¦ôLúEý«±Oæ-š£ðˆê{üîÜÕÄñ‰ØIßËÊü¦}3‘óèœßÜñôÙù.Ó^ Õ§¼ ÐoûµÊ×eb_ÌË4¯ø¢ú&ô»º»øÆ+_¬ü”ñy¤p_íÇÔ¼U´˜çsŠ©Nßãx ;^h¥~”þXxa±æ_ ï ÿ–²‹ 75mÈk&V“(Xƒß±ŠÆó úÃ?åý­ýÑ—z;ñjªŒ|±Y¼Á O‰U⩪ÁoÚg‚{ãŸ_šö'úî{<ບx+côo//-½ÒTfFþÓ)îÕ~žâc÷f™Ni<Æ{¦6€ïRùœObÏ•¾I¼/]y_O˜?z o9KÈ¿ÚoÖ¾š!Ú_¶°p!ô¢¯ ÕÄÿåwòžÖñ­Þ§ùÜÕâ»úó°?"^Äo±ž<õKÏ_•¸*yŒ¾š:ÍÛ%î$N¯>!ž2ñcÖhîÐV¯9ð/5§>;ºUùÎ|úfËÆh¿Ä¯êƒxX<ÑÚ§Zö¸"ù8,{”æ‚QÝûLðHA’<š­ óÙyKø}íOû”ø¬î^ÍA&xÇYஂƒðÏžä>fäÙó rÖžÏïâ¯ùMõ°·ÉOŽÊyö?ƒµÃ4¦ò»È{ÿœ0—÷:®åâêŸ,o‹ß-Ï07üT¹âM®|–ûÍݯþÂ!äq’-‰#ŠíÚ§ü8!¼ {\ûx1ØKs úW½ìmüqòÈ¥fì‰ë ô'_ß“<^Jœ&ÏQ—­<Öãò7ß‚¬a/†i_ïijá 0VñsQõ¯æo$ÞH¡/¯ªxEÏ×{žÓ~‡©èEr¨ê½ gaáv«ú Òk¨WLÙFÿJÝtò±{x®ª#Úƒò¼ö|¤~Ês´¿r…êCÇT'ñˆ/¯=OÄ_îBߪߠ?Â× q½öaE´º!C8¿yÎâ éË üºu ò»ÿlnžS^bò0ñ°õ¦¿'ÿ!ìÆØóÉ?8¿ç<¦ï'/ï™D>Àh§þ«$Oo+ÏüüÈkÂu‰CÓ¹Š¿ß÷—ê+Oh.©-r4`ýa‰[”÷^.~ÞvÚk½M÷øö!ñv¡"©¹=Ý«ã ü¡o¦öœMþ"u ýÅš_˜¡y®úBõcfaÒwwIÂÃû‡Äç˜Ù#_oÕUÌØŸô:òãÈ+4ÇÃâ§Û ^ÀÄÓÑ¿µ‡ý)~nê<ãU¼oµö¨/Ð>†‰âaØÀçÍ.¨7õØhŠD4¿üñYíFízýLnjÞ7O¾¢6ƒzKÅïøÄ^=À)u‰'ðä¡®ö©aˆæùØËô6PJ<¬úÎDæ´£wk¯ó]äæ5RŸ Oÿ&w k¿jryŠèêþóÉ Ï]£>°o—Ü‹|Y-ø¥äañóo%ŸT}”ü[h,òZ&þ¸ärì[:Ž<ÚŠÁ1©ä¯ã? 8±?‘wµïægäÁ±›úxªö¼öÍsЧö.äkê`å Îç½&.®5¬>ô.CNF佄¾Ìö©n,ž˜1¥Ì?Y-ô£8G`ó´'. ¾É¼øùœ‘âI»Vq~ò|¾åà‡ê_ˆ£Ã©¯¾ßÛ¨=Á‰çï$/ÿ]qn7ìeS¡ö–ÜJœl\ žªª¯Sœï³kO¹çô?~5y?ûßÜ{¸9 «3÷vÃx@üY“ }¨½”óÁ!ŽØ©âaÈMÃtå_s•ïÕ^ÖèØ¿ènñ>¯"nwÿÒÒ+~{ÅTÙ}°¿ÁçÛùœ¼Kèµß.5´¼äGÎ5aVG qD¸Q½y‹uGóe·š÷F³ñsÆ=؉ù¥ì›·¤Á©©Žô«yÅcÍЇØIÞ§Bùóž'µŸ÷uÆn{zñû‰Öäß}ªŽv6ö#y’÷ôõÃN™ËsØŽ'(¾†x»øˆúKÁ½±¥œ«wò¾°58ÖÞ¿Y§9šP5qHQWâïúRþ=±O<í´OUr›z¼GöÅ;âCÌžM}ÞRžŠæ«ïÿwò„õ‹Ô°^yìØ-ësÄQåšpÞ žÉ*ÿÜ’÷Hjï`¬ö×è£ysõ¤~Oý™š}F<Ï‘ë«Ì±dý¦=çgh£‡ïiú }*ÿœ%¥¸4ý)ö¶f83¹¿VÖGyñyÅãÄÿþ þ>¶ }Ýýƒ5ͼbå"¿Ü¢ý*‹ÔO±„ó ]†çäS²ÿJ]×ÿïÓ˜äÿó”O ´‡¥B|^Ó'ÊgL‡9oÓœI ÿ>Ÿx)®9ãJ¹‰·Ó|ÕÃä…æ¿GýθÜS¿ˆ{úZ¶_û˜o ýGûiG‹µø ­à°Ò·T=ú15{ѽ¿“'ðÍ×þ›~ä¥míáaLäP¯ ÚõïaòŽÿ?ùò™‰Ó¢NùÄÛ¨¸Ô{Žö¿}¨¾æ§Ô§ó"¸h–æú­ÚÇU£ýGYë¨ÃÅïä}êiê¼%?×>à·Ñ×Ú{ˆ›rï$š¨Ä&ßaÎ=:™zSX{x’=˜÷¯TÜj(.7Ê4‡– vÅ5wåÖÞÑQËÙO6y¼U©ÎøŠûù}_ôÈóœêÑ;5'ûxÔ¡y¬ÓWgÏ‘¾‡_ã| ÒÚ³ýêNu|nÁ}/\*÷ºú½ÞV‡ö"™KÀîáÔ;Â3TçêIݺáFñ/îŸÇëЋä•Ôemãd'~Æ^…†q¯9Ì×/XO³m>~Ø×ù4b—b…øÉÈ8ü›{¥x &!ÑðƒóæpŽÉsè©ü…|]BqÔœ›‰WʧIϦ÷…–‚—Sç«ÎªúIÖ@íS}»Ÿ÷~Œü¤Cgôaÿ¹¥œóôˆÌ|%ýŒÑ縇œïWô ŸHñç¼$|qî³AûÚ S·¶Nù ÞœD£ú[ï!Ži|ý®HýÈ_«ý°Ÿ G5Êk9ÞP|]M~cÀÿºº|Ošª%o‰Gˆ§fµ"ø•÷,¿ƒ¾—úö#“Õ³Fs‘Ï'f œºò«äo&ã6òéžøåD)þ!ïcêz¹×’·ä¢O¸ï&åÉxŽt'ü»ç5üGC;p€çÿ_<šºLÜ®þÌg´·K}ÛÑÛ‰Cr¾6Þ,žéašohr<™ž‡Ôu>ç™×Ž8 y?wjç6û3xbÓ]©ßÍ›.²ÜF>*_ûB3ÄŸ\§=b^ͨß7ö~É)^øä÷èåñ”§Çb‡µâ˘ü%ÛŠOa sîÕŸjØ=Ø£˜G}ú7£/¶7Ñ¿*á¥Ð¾§ê ÅÛè—‰ho]¸^õ†µäébŸj¶XyÂzê’¾/ˆÏ«¨/ŽÔü´ÿ&¾ßåÿ×ü„ýHÞÀû—>Çû—v¡níPž%1‘¼…ñøk²æËRÓÁá{5/±UýOâ -ž™8}&㟡_±éϼbÏå¹#Wc÷“6Å…•·{zêýLúÌxŠÏÜ®¹Òåâ—Žœ×XÀ±áëÀ«îè±óUøO ;rï¯th!vÎw»ßhÖ>híKs­Ñ>éþÈç¬â–ô§à…x÷Ÿ¾Í¹ ¿r‚;ýœCé‹<Lû¶Å|ïuÞ¿j ù¿jñÐæÎäs¬£¸äUÂG_â_‚ è—hú Üå|’üsòuõGOç{}Vô8^ƒÝslÕüâ~ú%صT÷ãëî·D¾æÚÁ+¿x¬FcâÄóq®æ!&"ÁšwXN~¯¤ŸæÍÏGO³K8ï;Ü]òeõóè_οœ¸$~&FØŠ©»…·SžÖU¼¢š»È´qϦ[¤[ˆ» äÌÑ©kgþ³Ë”Nª¿ô´ú_´GÖx\}Þ/âG§.À¯†ÄoåØªüyíK»‹û©}‹8Ïsr2çÒáSÿðÞÿßë[7ƒç¦ÐÓðƒš?ÓžDLó–Ý駘1<°¥¶ñOSl8?_¯|Xã_œ«ó'í}=—<ÅÔÛáðG;~V=÷'ææìË4ï4»Y‚-_Zb¶xhûÃ3ã/^ö!Ôª4_š-“‘/·ýkå¦Ò·à1ïÔ>ƒÙø³äùÁiªK™ÐÓh‚û3®Çµ¥/Ó÷0v8= |`n#ÿÜGŸ×?o|J¿HÓËü}…øˆ3/åþ=wñžÕ×·°ŸC^"®zÈBõ‡•·ÅÏ”|Çù ?¯·žüñÌø}ÿhüš9Bü7éCúSC·kŸ÷9ª›˜±G¡nâçé*>ÖgÈ Lû€º¤]ó¾ÆçŸŠ7a484uƒö¦Þ@ýÕl¯'7©ŽS"Þ‚7é[-Ï7M[N3®×ž¶ÈÍÔøwÇ[Ì{75ˆo1Ÿ:¼oò–ºü_ª9—Ðfž»ôâרâáÚMœÓÜ™äÊ./Û¥ùáô)ñÑ/åý+?¥~bÌž—Îç{k×Q×6&ƒG’_ ‡ÎoÀÁ…¯à¯m·6¬?DÆò¥êÿµ‰ÿ°¹ñdó>ññÚ;ý©êc·;z|N=G|{þ0÷tsî„´w¥Bü¼Eߪïy;ö¡x÷™ÜÎLtSâ=Õ_÷‚â½Àeíµ›ÿüðqíÅÌÚ‹Wúh›Fž6¶–çp£^Ri×¼þaå9>!ÿk~•ó¨~ÞЀ\¹K¹§Ôíÿ˜º ísÎ=§I{ö#gÉõä¯s¿Eï6Rïò_ÉóþÎt^¢ójÞ÷×[ó ï3Çê;„¿ñìÂ^D«ðgF/üGàí¿ñÐ'V}JsZ#Åó·H¼3{¨gÕ‰¯ÞÏ–SÞ¤=Ån[׾иöúL Ï`uðsöyØCçQ>¯."¼ÕNóô5šçÓ|줚ȑW˜"Ïp¥â¯jøEuoŸ®Ë¿Gý»‰¿0_øëOõ´oNõ/õ»È_¹ƒ¼¿õþ/QFý¡òøVÌêokü \?kYóv¢ðñ"œ/>’žê˸üc¼Èy¦†s_î§ÈK$ÏF_Ò!ül‰¼^þ­ðUåì'Îv&T‡ï´WõãMåï⪠ÂNUŠ7Ïý)}NÉg¨—ü)^†)øÁÊk‰ÿŒIêkOÝ  ù_‹úÛ=êSö?NâÒÜ^zrÜ£ø} ~ªúίÄ/”U#Ï¥âm±¨?½øoñ¥e"‡3ÞƒÏ/:‡xÛX-ú‚óÍ›OßLDý…µ×bÇb[Ô¯¸G¸Õª½—ß!OFÍS¾®ý·“ÇÊ#~•—Å1›ÏquRÜÔB¸¹’8!Os¥¾FpS²+õ_¯\e¼*^ÒÞÈkÝì†á÷ý€Ãš¦aWã‡Â_ Ï5)äÖ»;ë9ÆïUO§ÇsO±ˆðØÓÚÞ‹óŒïÀ¯úçs^‰Gyžúb囓_|;œBÎü,xØ?œŸnT_ÓÅ7¹çÔ8ïNòõgOj? æ‹µ2ùòdQ_‹í x=JÀûïi/û šãÈsY<Ü—]yÛä9S¼ö¡óÔ_z=ø¤æ9ÎÑ×Q{qóøùš±ôÅ9K…“óÁQÕgò¶h¦ûŸ¨üÔÕÛ’¼Oà7æ^ëšõåðj´¼nÂÌ鬸tú<õ í 9&¾O·öæžäûb×kã0üYðñÆíÀ>Ö?„žï£ÿËvx©øQέò*~®q ÷çôR¿©T\n¤‰+’¯"÷!í)Ý®¹¢[á¹´ÞÅíÈgX|ñ•_aOL_ðs‰'Ô÷¯¹òØßÊBßœ?‰‡ñ!äÅòƒøöUï4’ï¬ù9kü˜óu¿À=%ÆRÇËYF$úöÍǾ§vQ׎|‹_J“/kZO½.æ¹îsÈ“ÎîE=væð%”ÌÂo†^à÷Éä5ŒÞüY¢¾5÷*ìcC€|Ÿçaìï¢sÀ½Æpâ´àxô¸èLöZOÎ!^¨ƒ,òႯóûùÍu:õÉ,Ðoσš‹>„ÜÅŸ!?8jÇõ]¶Î24×ÙG]ËõšêJ;…ƒv‰Gþ ø¸ëÿÒ|û?6™µ¯4ù9¸#0¹Ëù9œ™_r^S¿‡«iߟgZýúà²È‹ÜGd¢æ4O)¾›þösÒ‹vò¬©q<—ã ÷Z˜©½6íÕçÙOöëyíMkÚø†|~CkäuÁMš7m…^G·Š×ò ÕŸÖ F žšêÿŽ+´/t(¸.•Ã{%>äœS]Õwu yiïºÿaüYL|Zñåâ㚤xâAú‰b­Á±çè£øyËíÄá¥xï€òL±¯´·VüíV ö+•M^¸Ny¯…£È³Eìü}É“à‚Ú3Ô'â÷³ËT¼Œü–M¼°á¯¯]ÉsF¶«^{7¸ª¸R|¸+È—d5ó©¼ â½êZ OÞßõ§òõ#•÷ùŠz™ÿ.õ‰a÷çì O8æA^YèmêNõ­ÿˆÜ”^IÜi¾žüVürüVÙåÝžÕ¼ï~ÝÇØÙú­âéF¿MaOòc/úuwûåu&÷^žÇ¥>ïÄà¬Ð üL°5ïUv¹«¾­>^7æ¡/>åñ#÷s¯ ç#?–ãâkˆè=®ÐœÜ¯Ä…Å~ì®e?_º“{óžT?i+ì^d­ú!¾!^‰ŸK:Ýjþò/ðiM¡æFÏÄ~•&…_êÀuËÈûÇ®WTGìOíuÜWê%ôÀß¿žðs/1íQʳR Ü«>¢[±»Æýâ#±Q'j߀µ5Ÿ[ü)ù¤1Ú»襾‰(ú”¼„slX¤½`§˜o6næ9GUÑç’êL?ÊÜvk¢ÿÇ&_•ø²·Q¯/O¦÷¸ú©.Ånç,Fo2߯‰ê¸á÷ˆïòï÷mÅN'â¿_¨o»¿ú‰Æó÷¾3Èë9¯D.#}©ŒVþÖˆ‚r~99ÇÞ†zr¯Ï£o Ò¯|Í—Ô bi®ù3pPékäß=~åýæR¿,?›÷IØÍÂ7µOq»ö·'ˆóŠÇàOóÛÚÏ ^κ´äæMîϳçIO#žiæSN=¨9õ5¾‡|ÞoEíG>E] 8Wxë$òîè¿x¥ø ½w"gøØ³…ÿ—c÷Ïa—·boRGVJ_&ßʽ%þå<­å'&€Oêö«ž4DxúuÚ÷-LŸ¡o¾ú3šåL|(FTü&wÖžO?…Cy´æùðx¿™Ù?ûI~r úé€}·nÇÅk›;Œ¾ÝPñ¹ñyï´êä¡ ï[³A}<%Ê“¿Îó¦ÐçûЇ&’WN-¥?Æy¸*ý‡Þã;ôÌW"ÞòÕœSÅWÚçmO±ñžÍÑdvU}oõë9ÊoŒ/¹úGïÓ¾«Ëù>û@Íõ}Ä÷-*# nâ¼ë”?ÎïÂ=FW㯽ê;Žü¡¼wö¤®}O¶Û‘{_#q‘Ù¤÷üWöàlø„Ó=yŽØzÙ¿|õWã׫qázäñ‡¼N~û~A|‡âám؈þYª±kþߑ߆¡Ê¿¾¢~Þ4WùœúôGj—‡Ïݘ˜¯¾¯aü|áZðžÛB\èÅ¿{÷qsæÂSœ|yL¬Eõúªk”æ®âO"Ÿ~Í]¦¼Ú¹„üEøyΡn0þÁ“ƒ~&ŸÕ~¾:âÍÊ™ä w¡çwP_õiïj¨žû+üJ}˜O 7Ö³©J…ËwÓ7[fQ^Rû²´ÿ¶:Äyí‰? Äu?ðg:“yúÈü~Bz—Êä¼Â·àk4ïî9ûÔøúXú y…D7õœÔ>‘qÚǘÁ½/¯Gä_ìX®~ªÏÀïaåÉóÄ2ÀÖÝäßKßa^¦øSä¦lŸ[¯>èâ5ØõP v)çædÓ‡ÈÃÙÔßW©}(¡ÒßùâÓÛÇ{F{‰WöBÍ™€ÝÏgîQÕå|ü{ü~ÏYªýº‚’âYÕ\Çרý›ö‡ÍæïSGdß÷ðù…â»1úƒOêJv¡ÞÞBžÄs9©{G< ½˜{‰‡‘?öŠåÄ{÷Š_úÏ=bê§BÑV&Üco¢ÔxE}&{‰¿—Ðw•÷ ùS‡ò^)·ê‰;yN£„x²ñ3â—øªg€ÃkŸÁÎF>Ÿ&ÿ"®¯x ^¾ú¿Å{fÖÜd[êXåsìåókŽ›¢¿sÏöès¨;ç`ï™{&þ qú–'þºêÁÊnÆŽê»—pu×Ò¯ïË=‡íøG‡øãܹàó/è}]T{¿yÃà_sž{æ ÜøIò[3.¥nÌQ¿}–x;.BîBÏcO›”HM׸¡Ç5è[ýóøé|Í!&žÁgàË«è§ó9ô#V«ý“³yïÐkü}•ö`_S½¬Hý5sȤÎà~ÒOWMÌO`ò­†G{?¡Ÿ¦º¿öEÄ‹ô)&6©mùP«êFFKͽ¤¹†¹š»ûŒ¾C|gù–¼T¾úúSOhËFòá¶èµ{ù¨þ¡º”ºw@õÏ.ìhñƒô«Ä¶g¨S¨~{?ç-úfå“,×hçgÄ_pî&ÍU84¯iÜÃ=O½"ëËKîÿÖÊÔ¼Oìaõ&¾Ïtö;ªýUqÕ»*Ï’_Ò÷ÚˆýLÆ8×⑚?z ÿ[õ+þÈ@ž.Õ>ß ì{X¼’áÉâ«Kgz?ã|";e×[sîž§yÎÀlüpÐ.^ë9ÚçW¥næ9ããøÜbåE#Ú»cR?“ñŠö¾ÍP<ÿ$þ>Ü»l$e÷ ìoê&í1˜®¼ÙµÈcÎOô[6ìä{Ó‘›ÌWÁ-Å)ìUô:ìBíiî£`Ï‘^,^£…êW;…Ÿ›|¼Ï–ѺšfV0ÿcÒ%Ó·Ä£ÑwZTÏ×übxÏïé½nè€>WÖ’w±ÿªyž úb"Uo:©¹§bíz9ž­ý“vƒ“#—¡÷ ‹ò&çPONþA:ª¾›™“çÈÔ\A,[s 4³9È9G}.ý4—bÅÎe¬ /*¸Yù¶qâáÑÞóØMÈ¥ç>ÞÏu½øã®Æ.:{`7æi?uðfò®ø‚2ñÂü£~ÌIâ Ã÷¤VÐGþ;Ó” Þ‹5óÐ߆<$?¡¯(ø¡x3Ñc_Gî#2½M­Ð<¤ö?碾XÙ_qù­ôK]Ã߇þàï«îäÞ.×Ù7ª‡*Ÿ|~¦å™C/Š×x?v5ö°òa×W/༓¢4ßWº‹y«©7[ŸjØfªý…¸Ì%|Swú:E{3\êïJôæ=£·h¤öÖ…‘«’s±Æ1ÞÏ;»^ žõq?2R2+ ¯¢yÇ›Ðcë ñÉÔcwª´ŸÖ§y7óKà¥&íS̼ƒº§Í¶}CÞ'µNóÝøÿIé?ñkžÝ}18%ãvêNY-ÀÓÑóЇôðúÆ /çf×7"âsIçžÞ5Î&ÿYxŽð˵Ê3KÿkÚ£×¾ó…«§©O?Wuó§Ñ»’ûéÿ2´ >Vù_í5«Þ«ýX7 š˜2aÏl¥ä?3´*dàG|cˆ'«íâÝH ®=þ%|TößÝŒ¼ <ç«à÷¹ê§k£ý,¿ð÷snQÿÑרçûªSïâ~=·RM¾NÿT¶Ÿó‰ìUþUzkÛ®þ9õ3[†PŸ0æá×ê×0¯bt%ŽO¬!Þiø{«ŸÀù$~¥~<} Æ9Ä'¥š+Œgkîïeñä–‹4 ¼çSük„|„ÛiÊ«ù¹þü¾íUÎo®öYØÖüNúW`Õ‹¿ð«yÉÆ‘¿_Ô ù0k{~ðS̪}ïâ× Z‚ëlÅØ‹xkõ™¥Èë´G,~Lûµ÷¯öEðat(òZt ye›—xÇiï…È[¹æÊ|çaWJE.J2[c/|C9¯àŸØ ÷åô—Ïûñ¼Ô´WM5eä²4W”šÆ½:"ï…æƒóß .‘\Ïç6ü¡ýŽuÈG°š÷Š^Œ{:‘g«þnã&ä>ûVå‡;‚3£Oƒûgïå)OŠb·_HÏ“§ýys.ÖSÈIêô¸j?8Þ½‘çºÐu×Íÿ!a“«}óÏâêÅ‹†Ÿ¬_£¹— þßò(q‹q…öšvç½¢š?ôŸ¾+~Í žÏkA¾G²ÏÉ®=®–EšK,ѹi¿qXúX*PŸö_¦Òä{RQâªäIðˆç&ò% êŸ6ßG^ húZ3}ŒjBªv"µý Tð|îo¨K—<‚Ü×"‡Á›É¯6׋Ýïj/ןÄÓÆ">/4»‘ZHOÞ1ì¼Ý«úÔÕ±å=â»=.ù^Xf¥ö×´Ã.'Å÷Р½ÃF+Þ³èmî{\êå³n¦@ö£zzoÛÎ-ûZ}GO*ßõ¢úÉ:oú&Ñ\úöÛ;Aüi'ÀûÕÃñGæKu?׉Gfv!Q βّïÏäÝœ«yŽÜ3Õ¿õzæ;¤=fü­ñv'ö*~´®?÷—|Vsxꯨ,—ªÿt¼úø¼…²oÏã_JçÅ[kÞ2;]5„:ib~0y®úÏžã~²Áƒñ2ð}ùqô‘ý޵Rýb'zU,ùlØN> Ô‡þø7hÎe—x'/Wžòiíg9)>Õ ³[À‡©Ð>-÷T7z›_{ÃG8WS ý`ó¬ƒþYÚ>br^Ç9׸ŃôùÛ‚äûço‡Þ¸…¸ öïgÿsÃXò…µš“ñLá¹ë硟þ/ÅcÕ—|ƒe¹ò]9× ñ=”åªïWù‹…ÙÚ/y;ñ€ç,âôX¹üÊ ìKü.Í›=§9ë¥<_õYÜOØGÜ?ª~à¥èIâJõÑWßï_šjÏå-äaLâ¿ñ\Ë}¥;’wI÷Áÿ.:¿i4‚û#—c·«&SO©/UÞò÷ïŠójÒ\³øs_§å= ÎõÎ÷ƒï×¾èË5wõ"qDõ»ªGˆ÷¤.€_¨¬!ÿ™©y¶ˆöF¤ÚñÞ†Yø«‘óœ§9$w7>§´”ÿo˜ªý+÷‚»¼Eâ3}”øÅh)~Jä£äyí<^‘æ¾ë…=Õoz/ñGâ'ìo8¼ùy©oÎ%Üi£~Õ~ıYâ}ŽŸp|'ˆQصœ^â÷S¿²ûñš•_WnÓþÅÓ¼§Gû…,÷aï}gò¼•ÓùÜ"éER{Cª_ Ù‘:˜1ýœ,žïÅ©–âi. OâzWüR#ÁóÞÔÁ4º÷4&¨Ÿ­3v(¨zVx¬â­œ_ÞÍÌKV>ßIuÐ^è7ˆÿBaoݰ·ž‰êû€ÿú<]±màáÈ•š§û—¼–e£ôwzº‚>2ϥę¶QÚ‹»VûN)?¦~ #‡ûô·B޳7˜µ˜ïõݪú̵ਙ#÷l¹÷ÝÃÿ?©?FÊö'yÛªñüþÔ–èIâ\î©éåõãÈ©¿¿œ=|~É ü‡¹~ÂóøÎ¹ºyï6ýÃÆŸà´øiͯÕ?ßÖÅÚ2ç.Sò4ñPµx£7(_ü»øù]|žõ1ä¶¡…öœ§üì¹üžëJñ åJo¾’]ô#©1’«3´—ÊÙ:€Û*¶`—“ñ©Æ‡¨x¢’ç"§uÚ‡YÔŽçŒæ)ß8øÞy9x:”©<ÒœcúÉYŠÏ5_Kÿ¦g¯úa´OgÑyØ‘š¿±—ÙÚh¬@Ÿf·çj‹©¸WüªÑ+Àû…ÁošJÐ'Ðô¢òv#èWre+/|Œzge?ðÉÍE>|‹û„ø÷nãsì;ÈïNÍKü³ÃRa2ý‚nú yªßÀïO¯¾máÞT¹‘Ÿ÷‹ß=^†œûy¡ÚǸ¯xz1KsÀÕÕÚeÇ^¦Ú#·™çbçBŠküíäÕ·›˜¨¹§–â­¨½8B~¬a ¿×Ü_˜uy5÷ä/œš7J¿=‹:8÷:ù›ä$òòî…øÀhüKÞüuΫ<¬=¿ï>E~Þ[­½ fä7µŽxwÞipöÌÖÄK–ûðÿ…ï·FÄâÖÞ­ÇÑOO{¾×?WüVá§‹x®`Wò¹þ.ÈQcûf¿ë{€ó¶æª¹“ø, ¹÷ô ÄiþÕÿY…¿²€[KƒøK˜çJÌ Ï¹»e~Du•K_Ío`·½ÚÛ×øöÀP†W|öÙšã¯:E_Bõ;ꟺ„yœÔì30機ï5árô¨¬9ï,;J‚+Ó½±;©\ñÆýE~?ö'v·à-úž³Ô—žéåOï?ø“`q˜I¼ºFƒò±ØÏ¼O4Ç–GœŸ| 9p^ɼœg3þÏzúZ?×ejïZà7ž+_| uÚ{•ã¢>g¹Š·­_Ö›ÊëîA®ü™ê'ý÷Éïmฤ©…üôî5â9ò Øë0ñV×ù3ÿócS‘ûÊð.íëHMW>ävê'5?ÊN/žøŽøiOLsF÷ˆŸî!ÎÏñ÷:fUè¹c“Ÿ3ÅÄï\ 9à¹<¿¿7zë»{9Éû6,D޽ê %ï›}ð«Þl<(zW¼ë>ä0|©æc’ª{Þ(öŽØá°ø®¦üÌû:~Æ?ÕÏø¿>†ÿLwÇ-zÿŸA~pÊþ»®ûf…)ãø6WrþU—‘¯ô &/±ò?´×n‚iþÍšKÊоû×xßñõDö©í/ì™ù0xaÞ§ôǹÅGb»‹s Ø´ÇòäÂ$þ›¯÷ìW~f3þª(I¾#óZô.¤}'Î)‡_×>Ž^™:’¿Ï™Kdÿý²ˆÏÖú}>Vñ>UÇÈz~nW;ôo†ö…{ 9gR¶â¹=açjo¤/ªþ1òúuq~>è$NÎV†+¨~­ૹS™û,}JýŒê* óy¶›ä‡V*®¸B|ijÁM…q/¾ª«Œ½w¾ ÈÖþÒð[ÔUƒå½ožVßò\ñþµ¿Ú:Uóiá‹>Ú·©~³áxWïYÿùÄàD>×;‘ø ¨¾Ôñøæ=Œþº6‘ß6[Ô?6ï³.æ=}>╼L~¾üBp³íYü§ëfžcF9÷ì!•WðœU_ã7&ÿ… tÃþæ\AÙqšøÒºøÝ¬ùy‡<­?|‚M÷9'”'¤}ªŽû u«êøçL s‚Ág‰WÝ6æ.ýïáÿ=—.Ø ®õNóTý{güd¸ZyyÍßÁoÇáWÂ/h.~/÷øWsjß\åñrz‚×û_ðßq¶˜2[çZïFž Z 'žiâS¾)÷Qñ{]«÷ù\ücOJ•ç¬K~¯ô1úoç¢Ïu[¹‡Èìô‚¯÷]uKÔTs¿çýXs&&Þ¯þ.~®t ß°‚‡<Ê+å4ÇÇÿðþyšŸ¯}þ1ÈÑÓÙ÷nßô\Ź–h.Ç“Ÿe«Åó-õÏà`ú‹Ã&äÉ;@ú÷8Ýw!öÈõ"Ïé¿•8qv-ûU3Rô«¸; ‡NCŸØ0÷VmB.óoo䉫Vq­¹zxÞ[Ø%Ÿ“y¼àâEó+ÔÁÊ…‡|WòùžÀ.ɇù+ä!p¥æRßVŸœâŰ ?äY¾«Þ¾õ´à=¦×‚›\vîÉ\Æ÷̰h/Ö2ñTh_²—ø¡þsñ ¿Å=f?É{NQÞ­:E|ìÔ¾!ç¾7ÐWýÔóÄ·¬ù©jÅ…¡ ñåûÔЉû3ko¥3P;–ü’_|1®¸æK´¯µt3qKd=¸Ä¾ »;ã»?˜•¡}!s¨¯eh?\¤vÇ™à\ò>âÏ ö²XJ呯v½+ù1 §įg‰GzV~{¾xXœnäcÖvúÕ*N#§³|¼Wd7x6s4z¸Žø'ÿyp¡ïîÇ7Sù‡ùü²]Ü“;GuŠ+T?/lEüâ¡·x!ò ò4SóÄÎw‘—*õI– ‚wÎEàðÌEØãÜ7±ãeÊsçˆg»jºòîVÙ¥Áøã:/8&K{¹*W‘?œ÷;yÛÌ¿9WëûØ9ëÜoM#u¢ð@Íc¼_¶ÑÜD•pÇ2ò‘ûµçz#þböÝçŽÅžÀçY#Ø«™÷)ou˜øÒ:Wý&ˉßòkd×/!nµª>šÝ} }'?>|T}Üó§ú8¬ÜC3ß¼g>8#ð:8Ç3B{\¾¯ê}èWfsÜ”ßHÎ#¿?}îAà]O)ño.ù§ÐíÚ×8?W;‹¼Y­òWþ÷‘O׳̟xзÑâ ˜ñ{8¼W!_>ñSWÖ`÷ªÔ.ãÜÃ׋÷s ç3Gûp­ÊsÛÒåmÏyø_ÁNfí×þWñÒ{»S÷*œ(þ够ƒÁ{Î}òW_/…ÊÉÛy»’ßqvãç·aœ­±w…³ÔŸ~#ñŸKû0²§ò9Y&î{¾xþCùèµõ>>¯z<î—¸×ùÐ÷^³ûð) ž™YŸk0z:ËŒž{ÿEÜ_a]-Ðïú=ê;ú~ÉŒqä²§¨yZ÷g*jÁsÚ›´Ø%¾§»‘ãÚ7•×OŒÍ_öŒâ9²§ˆ‡øðÿá—Iÿtù¿F “Ï«ýL?cG‚Ï+ï ¹ÎUðë4¿—í ô»fù¿ü½ü~Fšçô­á~íÇÅ»w{“ÿ0q‘µ½úþ™·¨q÷¸Å?—*_ë)?€ú‘"™Ê;ôã¼óÚ0¯T{5vÇÒ•>ú¿Áu¯*ß\{³#ªß+ÿ?{b¯“¿þûïÒÞÿÂ3CÁ³yy|Ÿ7 |SÙK}Ì_b'2ÖbªA¯jÔWh/ÿåàj›øÙ̽é÷ÞŠ^Ø>Q?ühñ¶N—ÛrNÕÅü™uûë^†ŸÈÚ <Ö³øŸò6Ü÷ܵøƒ¹£É÷g]‚õÎÀŸÔ?¨½Að|ŹèMÎÜ¿Oñ~ÕfÕaÔ/ë}…ü_x¤ø@öƒBs°¿³¯~ëÀß;Ÿ7…z‰ßRû¶½šo²\ƒÜWˆ—Üœ¯=[ï›ÈFöb¿}ïkßôVò¤ó¾C-㸷<¯ú"‡Š§âvæÿÚË\]ι•gÁ²;6{ùw[òHž(ÏkÞž¸5g[7H{SnEßrö+ÏÕ^sê³Î|ž:…õQõ_ŽX°Oõ­5üûÌ¡ô/׎!ßî‚?˜×™9`{@s¶c”wÿ±§{>8’õ¿…n¦ ö¢z/%No®+†z{ ß^G¾ G8Ôž}.§Sû¸­ùœ“o”êÚâ󎼀†Š‰Oý‡´×ð8ŸWv|Ý!^·àQßsü¿Y{¼,êŸð©÷fâ¨YƒÙá¿Høô®b{»=_pþ™›8G—xüMÄ)¡Wyžñ »oÄngˆ ‰Ú§¹½ æ˜½ƒÀŸåÇUTó>3_#¯k¯a`øÈ¹9óŸäý¬aÞÇ¢y ïØ—|ñÀXw£—Ñ×ä¿âÊÓèG}ÁNø…œ•L£ŸÓúm±öj<Ç4ùcð‡uß7o3}yw9ßÌwÁ7¾iÈQÍ;|^Þ!â 2õçTÌ÷ÛCþ}™œCö7õ—ì1…Ök¾®y§æÛæ/c/…õ_âkgê ÞÇ‘?ûÝèÁÌEÔ=ÅÈ›çbðeXüVá2Þ¿r4ßk½AýåÓS·æBÕœo¦òtUêÛôf+/fÖœy+åT y#_ÍpS¨UÃìÕ¹ŸO<–;:ÿôÓü\vþ§z•ð±æ ¬¿“Ç°ÝÆ¹Ì~‰ølÆ/ä!›å´HñxÐ/þ¢4ç_¸<[þ»ÌŸE¶S,}–|nèZìž¹Tyù;Àƒ®zpqþÏÈeè*ì^p"xɵZ÷Q¨üØ9Ücžö39¯Ùü§^®»M ´6$žUï õçh¾Þ©þ”²CØ ¥pF¼teÚ—×Kýâçi÷ƒüÜŒíð9{:‘ÏÈ>¡ùÿ+8O—úàf¿BÞ9k*ñbnOð×Låûôå\ç-á|ÛóàLû\pSÖbðð´{ØSê\NžÝ)¾Œ«åk üoŽ}Éùƒ{´Ö|ËÅÔWkÞPÿÐÍM<Â{eÀ¯®$®,wÐ?S­ý¡SèyùëÄás•oÓÞ5ïBá¬3°ÏxÃ:“ßsO!YRñæãœ×ômäÿ}AücÎ@üMÎBäÖ©ùÖzåƒlݸ§\íñŠßËr>/ÿ4üiäEì}ø8ú9Oó›Áãnñ9”¾Âùeê÷ª|è«Gx)ò þ($ÑÀìY¦ÁýÚ´×ÊçàœƒãÀ¾þªãîо<ñé”Ô ÷‘éœgñ6î;|LóªÀÿ¶ëÀ‰µ`W¦ÊŽ»†ƒk¬?‘7ª_/¾gõ•ä¾…œÎ’Ý ½ÉU½À3@~vvÆ·ZuÛÏù}ßëâ~”s›Ö\ν׽.µ>Dœ<]ûT{$o¿"ÏeâÅð‹'É7!¯gÝLü2CxÍ×™{÷Œ ŽÌÍgÎÅ¢=¨®&ä<ò‹öømƒÿ¡~+ýD…ªg×qN.›êcg!%¯3?\Ú¨y:åóÂç‚û-âE Vƒ¿ëVj¾î>ñ6ïi*àœ<Ý$·KÉgyÖ¡÷µkÑ;‹ö:—+®uj®,/‚öÒê±è¡3“ùz÷pû”-Úƒ+yty°ëæ5àÀʾÚ?§¾Ð™&쬯Qó ï!âuï•àñ¼jíå¾]‡­™¬zä×ø5{ˆçö\À÷¸Å#ç8D\¹˜|asþÝv>þÉ«þ¢°ö°û®Eߟª~´‰¿ìïú9œÿÌÄ‹Öþ­l ö:tìøÉ‡xžZ3uë¹Èi‰¿êoŒ%S<gsÏÖF~Ï{-÷“ûÕ±•ÿ 9+§ž•{¼dÖ|“·»ê*O`_ê‹Ñ7Oõ/Ô÷ës曉³Ì8ïØ­_§;Å»íÿƒøÔ3€:YÁc̳;“È£ëñÝŠ_÷œMÈÝ ûž³šºHdö®ê*ì—Mõ]Ï,ôα‹÷9™sœà>Ìâ¥õhOm¤Œ8tfÁ½f›‰£­Óµ‡üòSiá¾}EœÃlñ ;CÈÍ`ñ {nV˜önYlÜ{Å8ìªó|ù­Ãè§©Œ÷™Ñ˜s+xÃwçÏζ5ªÎ¾šx¾Ì…¿«[nðnå}fLÅže‹×" :ý¬Ôo™­©¿×'ÍÎ#N´!¾óÌ ’½ ½šû"ŸŸ«~©Ü¹ÈIžær" ?õ¿×EÞ ï垃ßp=ªþØÛÈozÆkOmwðÚ‚ï¨çØ´o¯Ò~®Ðüò,“ú¹.ÃîzoQ®“ê önØA›ø ½ËÄ3¨}y5¸Ïõí(Žçs_Á?TGþ˜xyþ…š»†sÏzšû+m®Ã?…]ÈQó_š· ìï6Ûíáà´ñÚÌ<\Þ ÍUŸù·ØÏñúÏ×þßÌîèßô£ÔcíÚ;çÍ!ßë)^ª‰ãÃOó}5g«_õfìl¾UûGžÏe5i®¥œ{ª[§þÃÏñ ÙíÕÇÖMs»ÓCÌŸLÕý[|O¦x Ýaú }Að¡§3ça©ãOÓRõ7ü Æ<õmšÿæý ¯záãÐBðNÙ÷Äï¾Fñ¸Ï!/S\JλŒ{žšÉ|ižx´‹Oº‰?´ ráÞÇûY´ÏÙ½ýk©N…»;LõuÞw¢ïÞý'v»Fqºo+z°k^è{ₜ8÷<¨x¬»3[ü0Ž‹„¿ï&>7«þáꊜUܧ½,OQï©[NþÅó‰ö -×~+òlWC3/®Ïªz¸æ¤*ïç9ÃÊO^‚½³%ù‡úÀÄ;ò¸Ï¬Jñ#÷G¾‡¶b¾;÷ á*ÕÛߢ—>7~.ržðÉRÞÃ¥îC¼_rH}¯o#ÏÁ§¿®$nò]¨z̳è‹÷=üoäôeï[é'œÁç´O½z ñŸMö'û+òe.Õ[B[©_e«%G}JS¦3·e~ |`û“û+܆~Xž#žËÎ “->DïíÚ÷¶;ú?ç]/žÐUà?÷k¸^{dÝÍûm­Ü‹ïê,E»À‰¹ùœ—÷Rìÿü-[}=q‰É+ž´P¹t š;Žó ¤ùÿõUËþû7ŠÇëbÕÙeOÂ[ñ£Y}ÀcójØûìÁ½—«®:¹sµ•Ü|¯¹½FÕSn•}ßæÌ èÿñ¶e½Á½Ö¶äÜ<ߢyÐ`gâŽð÷â_»¸ dîÅysÀŸYâ)t……ëšÀ[USË,Õ§ÊíĵÁ¯Ä+² Ü’QGè?F~!ëiòF!ñ£.x‰ºgè:䡲/~Ír˜øÆ[‹|åTüx‚Ÿó¿N²Ž!~k~ÏÐì¼¹/~×j"î°…Ÿ6 ?E>¥o94”:œg#ç™§½ê]¹Çü«°“cøû¼ŸéCÊUü:¯Œ¹|??Ÿ­~ÛÙCN}yíÜgMžÅøkï<õÝœœ†bÇ‹&co¼ò”á?dS´Urž¶Ø—ê+Ñϲf^¿YšwyàÙÉžö™"ÇÔŸ°?4ë6ú ‡îvùw‘÷MyëˆûƒEøƒë‰{üjnä[õ©hïF@{#mÏkžá-ü²õ=í;¿Vóÿ*ßûù‹ª‘è±¥ÿRõ÷6ÝÏ=ú—ðûó ȳJxÿP€|Jöaés=÷ù< ã×§·%ï9‡÷¨WÆA?"_k æÃê•Ï^Äï{z/zPûJ> Oà}|ì¡~“úœoз2'÷:ª¹“"ü»ï:ìRþeÔ›\Åèqp€xd›Š;±;®ñ›kz>ã ú^´w:¨ºD±ærš÷—N–ÜãžÍ)üLÞíÂóßhŸè8É×ÅÊ[ؘ£ðe¡7™UȵYü/s?_ùò‰6˜æª/¾þYü¦k9~*Kù·úŒòsî{Á/Ùcy¾Š,Î5ºü{…òþßðý5øõà Í‘‰'ö~â€ü"üqýdââ¼ÖÄ¡õà>Ûä¬Tü¾—Å7úë×>ððǼ—79óúÄC5€>xG'ð‘·z2ÈcÌí>Uã§ Õä¾?Ün.Ø ®&®¶ÚÔ/Ö@þ2ÿõ/Nd>cªÁ>ËÕqýâõ8‘{O-úár‚cÌ›øüðiä SeOò65K°Ÿæ¾è™ïäÉíÇy§p÷7î)æû½¹GßëøÁü—é;®¼Gùמà]¯æRAâÈ9¿â¿¦¯Ô¼Í òÓÄÃn¹KóZ§Ä·±üT«=ÞùïÜÚçU½9÷-àó]ê/ìSÞª‘ç(9­ú­úµ3U÷™¦¹†Ò.Üwø7Õ·\š·]€¸¯ÇÏxÂ襽•ò(Uø»9 ñcá³Éë…2©”öS×ì›ùùeåšóŸæÕ'ÐWá­çs"p¡ç”xZç¯DnjÏ@Þ¿‚7|³©ÍU¿j+}„V}Ó%G‘ ѳæ|gðcíAÐ~¡°êðe눻 ²øÞpWÕÛ/R}ùö숯Öùçd~·¹{ËÐ~{Žø@´Gן©º€xÿCOó¹.Õ2VQïŠhž0ôú^«y¡YÓÉ‹™_Ç.æ©^`ŽúSñ¹ê >¨þÚvà^—þ›`1~Ûó¸Þ›¢Ó;€óŸw˜¼PÖJ¾Çñ­òIwŠYû ¦ŸOß’·•òu±ÃÏÔo®}©ñr¸~o¢æ½²¥ŽæËWß’ú—ƒ[‘ãÐíÇ„ÜÏ[L?­»%ñ®{(ò\ægOmM]4|½ð¾C\‚¶^/Üw ?l­?û0õk·çýê¿„7ó{¾³”¯¸Ws7WáÌâÙó–s>³îÂÞº‰Ÿÿbòâ9ê£sç’?Ê QŸ´Õ×äjžÖ2Ÿ÷ .nÞOÿM@|¹ÂË׃ÇOj^luߌÞôay2ðgíA¬þ|9¯+{!¬ËT¿»ž|\i~?OuG¯ê劋²ŸoåÀ¯Z ä.ëoìüüyšV?Wè'ðUHv4 zcèvðÖŒQ|^¦ê»ÎjþÞÜIu´½znÕc²šÈïÚ¢¯ÞÊ—›¨kÖÎÅÞä>ι†š´ßà#ü¯»Rs yšg ׇzl4«ïKr €çJ5Ç7uD§ö®/¸Ž¾`o7ì‚MyÛ€xÉk{ o¨ï¤~3ú^%ü›½_û8{“?óÇ>:zÆ_ÆË/™Ü£ðße}ñÃ3Gñ¼³(к}ö3Ü›u<ö+¨¾¬óЫúÎÁ2’ó¯ÿWý=ªsæõÏU‰ÿÂv4ïCú@rÇò{sÄïìÓÜôô“ÔjÎç™Ï×®x£|£Õ§}&z§¹Yþ»Bsܹ?«N|x;׃>goÆ>,8É÷f—!_þwÈÌøIñÒæƒ2VS¬eø…ÈâkÛH~ÏÑUuÎÅ;Õ?³I|ÕuâÓ¾ƒ8É*¾*§úàëµ_äzîÛúqáü©”&é|„óÊšH&¯½úzá'Ÿý¿žÎJŠzÛúÌ"æDP@¹ ׊‰É¹ã䙎º§CUwWUbDEĄРET@Œ fô¢>E &L˜1 ˜@ÑÏ{{¾·Ö]äÓYú 7ª¯Rx¤s·ú4Vóž]K‰'³ã°ëîÔkÒËÙïÖgÀõñ~«~{Ïåܤ<Ókœÿø±œÛü±à˜ÆãÀëÆÖ­SúÒ9Í5ïâ‘ÎBú_àe»üç Ö!|‚ôÂîc¿º^”ÛQÄGæG|~‰x·ÃÒ•IßÁ9°¤¿fK"¥z¥µ’¼Qiï9ï£8ú)ö+7C:TâMÍÔñž.õ?GÎÀnkñÇ©•ô…4ï .mwc»zð é¡àÍh­ø §âÇZ^"NMªO86Zu¼­¬¯uûdŽÄŽÛ‹§õ|p¨ë[â'Ï­Ízò¿éñâ˜Ï9‰tqÞƒ'àgk[è_Ie8+Èû¤ºÁ ¾IÜ›Œ)\{÷1ü$ùíÀð‡õ9ç=´B:"7òÞ5ÊÇ9¯óûÑ£{ó|âKkƯäÏRoõªÞlÌÔ|¿xzß•>M;ø³¥ û™zDñ”ôл¿Ö|ؾÜgcõ½^>=£ŒzNzqjõཤ_¼>´/õø¿ÈÑÜ»àJìPÕ>ôéyÅŸ=Bük™5|nf¡òâñ‹I*˜Åޥߜïh¤ûÛ8˜¾\ã\ìs­ôH[Æ©ïsûè\(^¤ƒÙ7ïåü÷vñ)x÷"ï‘ùŽuŽìÏ~Ù‹9¯í—b'C[ø{ç2Õ Uÿ®¾ ÜÖ;÷•~_zíõʳ¼Âù‹|þ2OÀÿgUgÏþi½\û/>VKzóuǨ~öö0­þ'óâ¡öYÒí^€Ÿz ¿ßÛ׸EýÙ3Y‡®7És8›ÀïæVž3t Ïo|ŠÈ^@½5r¹æ3Ÿ!¯S^Íw“ò³ª;åCÒÉ~‘xøs”í`ýÌ>l þ9r–ìèÅü{xç:û)ñoپ̑ú:ÅÃÜk/o æ–îb¸ž¸4%~Yëñi#¶†fbýŸR—-žÂúÕ?Åß³õÑÍàçSšK8]:§©}{ëÄê7Ü"ý¸5œc×õà“2Í¡—ˆw/+½ÆÌFñM`ªÄ‡ÓãÃNu¿Á¾Zk±óâg ì_†o’]xƒ÷ö9Üä½âÍ9‘xŸý¬Óþûpß/vÄó“ê?£‰Ã÷ŠWîSp€kùºšÑØ©Ô^Ä™éw…W–‰oí<yû*Ö/ýŒòž=<¯Wý[¹Ëñ¿1ñK¤’ÄON#ç%°T¼ nλ§{Ûõ ¸!}‘x:¾çù“ò™~ÔÒš+ñ5rñ·˜£ô=Ogq^Ào4ŒÃ"ìv^ç¦^}‘Ý—¨Ïñ8Þ?¸ž¿[c‡Rûa7ªsâ«þU.¡¿ÈÈjޱŠç³áû½â+jQ~Úò+Û‘O¬Ø >é X…OU—v¾Ä®¤5Zz3qdf¤æ·(®šEþÓ_Ç÷”^¯ ÷lž?½‘¼^ûwà“–ã©C5 g]*¤kVŸ¡U«<_‰æ“uÞ¯Áß>S;]öIs£>Í…WaÌŒø•b|ó|žùæRF‚éU¨o1+Þ ûOìqÍ÷œ·üY¬kZ< ÍE¸%ôW ¾²£|næú6<—rÿ;4_Þ ?cüi-À´‰¿Ñ*OEŸb_ò§PqO§žÚþ­|šxÊ8ƒó–é$îL‰Ï)Rª>ÑÉâOÿœ~3g”tÝ£Ês‰o8e?:UÏ /`í Ê/^ÄûønÀÇ.$þ\!^Ϙ¯ÌŸ¥|`?ê@É5Ü#ó$ž¯¡™s|’óØ0…>Eçüc\}7F”¸04‘z„3Bù¬“„3ÄKbhί¼?e¾ˆ¿ÏÝ‹? } NnÒüLªø²~Ç/‹¼ò1òp©áâ+ÿ–Ï­x™¼Lê¶ÉuâÜL>!{ùo3EþÀzEuÂzìNÕ¥âÓüqèUõ³ÿÊý±?ÿÀר•:åÉGýLš“µBÚ·ƒ¤³">× xOêÔwVq<ûŽcÇJ›¤×v¼pÊ{øƒ¬ú íûX§ÔEâ¡öª.q7ù„ðìSDø¸íAêé<‡¥¾ãXâ¢àëØ‡Î‰Øs{§ðåíøûÎ$ûi æß©š¿û ?çTÈŸÌÃÎW¬Õ¾}$ý!å}Bo²>éÕl$nm[¡>Æ=8±/ÀY‘2âáT«úX/¯+¨£L¹¿ÙË+tT/yBóQRΈwˈë~¶ÑOëÏýjn1¾…ijѪy‡šùY'¥¾å2ò°áK578ß›’¡sßÓ¢y϶y|Od)ùÔP<šß<:мSV¸Õ{ïㄉª“}:»–ow£æ㊫Wñ¹Îìyçéš‹y¿ÙÔŸ{œ)Tàyp‚7Kühæ”grcÿ³×‚o‹þ?<¬>¨~¬»u(ç/9ŸûÐrç¡ë ~ßó#÷#2‚óS«óž²Tî$Îr¦Š÷¸hù¯l˜x(§ºV~°æj&«³Fvîsõ[íI>Ø?k×:ê©F=ÏëÕá›Æ=¬Ïr>Ó»dß‘¾ÆÙø±Äfù3ñ9dºÉ³eRâ›ø„÷hšù ÿîߟû–ëCþNñó¯âúµ\ ö$¿…<@z+sÆKØ÷´òPå)ú GùœÔₜW|7¨Îø%ïé–N qœøe$kü¿nÆó§ßÆôæwb u>WpºÄ =¿w/hž\ú}¦ôÌCUÜ»Ì ðRì6ö1£y§´ú5í•܋гªŸÌÅORø•É«‰‡+ªñW-Ï‹oïEõ}Ê~v]Ê9ýÈú™•œáÑ^^?ÿ“ÂûñS?Ëï›ê£05¯“ìQÜPÀ÷%o‚¿ˆÿª>¼AÌ}xa~Èù™ú¶1—ûTÝ­ùúë8ßž£À×ð›•}èɬ¥ÑQ?_t þ3~§xО`ýSx¯NÕ»ª‹‰#ó7‚¯­&Ö³ö@åO¦ƒO[Þž:I}§kɳ‰£ôoúˆb{)O~¼ú!NæçÒoòüöWâEÓœqû³ÄA éó¦·j~p–øÂWˆégü°» {`½ÅþU,ß6mÕ9—$,âÉÊ⟚ÙÔí«ŸÓ|î7¬C@ºö‡Ò Ÿî¯ø–>’òÄWÉ Ú/½wî[Õq–‚§ ŽÆLîGî-îGӣ꟒7G½·áyÙ“:Ö¹Eñ‘9Œ¾Œ^¾¡ô¬‹g8ù”Bõ×Ï*_g'¾ÿÙZüWëCœ÷¶ûyß°x:Zòøç$îEÕ|ìªOý¹Ö³Âc—oÖœ€]È~ÎßõäA«ùžœxóêÎÕ–ÃG”l¥î–z‹¾ ÷3¼‡5K}„iå> ?]-~ACüKe½}2åØ÷®¸G‰gÉËÆVÝÌ'ž‡C°cî—XïNñp‡OÕÜĪ/TF:oɵü~^sLŽŸøÊ-üQ)¿Rõ ÷¼óoõ¹<Á{Î$1^fß̱øQkñKÙD>§íNÖ=š¢Ž`¨ÎÖœv8BœÐîÂŽXûp‹®ÃÏ%Ϧ~Ð<Š%®r’ÒƒøûŸ¼üZ¥yÈ’ù0ÓËs·K¯ _½ _Ï÷ÛWsÛõ÷ÎGÈÃÖ:ê7Y,{t!÷ÞÞ*û|ç?µFø¯{b‹w³P|ÂùQ⅞Ĺ®Ø®Ë¿{o%^6¾’ðCÄ%{pO+_§Z¿qŸÚ‹Èëú•¯õ‚2Uܳåk§,…úÄËÄZ%Óž'”ç÷½§~òéÿÇÅ/h]ÿÊÄ~µÈ/úæ>Z/³ùâ%W?KúsüI›úK»Äo¹Ss0Ûø¹6å=åàÜœ\’ÿ¨[üVž¾ÜëVì}î鉯5®º¤Ñ…ßH¬×d7³¯“Ï& ªï£/|µ±ùüé^¤xûž§[}UÎpüse˜{Ñ¢ûîÚM<[­ýëÂ}/Õlë¡à&òZUâU±¾?ë*ÎK—pOËÍôÅg_GÄe3‡‘7É~€Ý üÜV¿W°Bó¹šWHÈϺTŸ«~|гهû”H^+7?íëÑ\’tãj{ÀÁ½|–AÍ?º«™ë.ïKŸXÃ(úÎs?(ï->)s"Oþ‹çÌn#~jS#x3ø7ÓÌþV®Çç¿N‹âw o›]ø’*Hˆç#û=ö¦f'ïiÜ Nv¯`‰¯Ê6s;ÄÿØpˆêf»‰3b“ÀÿÕ¥ÌÛæòä•Jûñ9éÕš³<€x:7œš8Œx¦$Í}5Þ§N‘9¼Ÿ=õ)ÿ•þ’ó™ÊùtïâžUkŽ$­¹l'Àçt©Oÿ”×þG¬SàŒ¤Ï«óKâØœøüÊç¹Íx¿m ~?y»ôy~o·^.Éü†½>ñɆƒÂÕo¸§âºŸà>Dúq."õ¼gyõ®JÍwúä`7ÜwP¯k½—ϳ^s­¬Onßï~ <)—øf§n%>]ÀyñÏV_I⦛ģûýü.Õ嬇ˆ7zuí3ëõ<Ç’7ð &ÿœÜE<ä‘_5{¨Ÿ4¨Ÿ¸vvËYκ¥€û:ÇJ'Ry ø ì{l<~Â/~+¾JïÇ=6Ô©üàpÕÙfà÷üGrÏÓ{€GÓ+Á ‘´òæxĹLõç·±gŽØ]³vê?ñùÛ®”ê˜÷p_ƒkÁIΞê?û@s)üQú]ú(zˆ‡;¤·hŒß¹”—IMe]³·itû빟{l\ N·Öϯ Ë•€ï¶úq¢š+¹Hyw¹éUØ=ÏàÔxo?ôóØ÷&õÇÔ‹7=¸Sü^KÈ·À/J_«yxƒä+³ƒš¿LcÏ]Aærï©Î$~zc}Åf‘êS“wi‘žDé›Ì‡Úÿ“ô™sã¹msäOÖÐP©~°„ê6m›Àu5‰Í¹GFöÛÙ—óíy™ui?³£s\%¾F[yiÏÍÒ®|°Íû4=u=À}*“ž|¸¸,™g?Œ“97Iéo9aÖ¿Qq¹9‡9°Ä<§òÞQÒ»tñ™(ûQ*šbéQ¥Ø“øGœ[ï3øEß"ú¨íÅôÛ˜3Å7:‰>^ß%ô¯â?ªŸÄ¯Ù!þn /ö±øO_µæ¸ŽÔ¹š,ÝŸà•t-v3o)~q“'°Oàœv¼~*R¿rvø®ùfæ4Bò«©aàå¸ô3=ŠBâÝÈ·W‡>fÿ«¦Ñ—c_D}Â0À¡÷ͺLz@C¥8»SþÙ­·_ôΨ‚îÁ÷_Ù#L=6i²¯ÎEêû8 û¦ü›êÕ¡{Þ&^øð5œóέÜw ¿ª'‡§ã;¤ãíˆoФ>¹Ùêw”®Orö¾|ý žý©/dWrÔÇ·‰uK,à\•¿ŽHŽÔœÌïÂCÄ-¾¹Æ:îY| õ>Ï/ÔÿSŠÏ¥Ø÷lµt÷çf/WÝh/¾×| œXz"}ÙéÄü÷µ¤Žþ3'ƒý÷®%Î}¨¼‘ü‡q¨ú ¿Q=W}+æä­ƒ8{KÖaÿÃÓ8¯Í³Ä›"]_s ç½x&y¥¢‰ä;s”,ÆŽŽz㟰âù¹ÿÄ™à;ãìyíÇØ_ãyÂ¥š›wñgÝaŠ›Å'Pù8v´ãwÎó“êþâÝOþbJWÖ¬äÜ&ÄKS=œøÆ˜Æ{WŽdÝ’÷³Þmâá¯Gº1é:€ã5àâÞû/‡[Ê_'/ãç¼â{ó±7]ûˆ§CuŠWTÿT½Æ£9Bc'ö9×Î4˸÷iÅÉÎîOFó “gÂÇ‘i"èR=(§>…šçÈ?fŽ—¾ˆÍüY/Ofrqåâ›o?”ôǃ£9'Uê{2Wèû‡+NkÆž¹ŽT~å%é ßþ­YËó¹o&Þaß: 8GÅý™{ ­U÷þ=4žû•Ê/ËnÆ~{ç²ÿ>/çßÉÓ×–›­:ÿ›ÒgS«fìPBõWóhÍW®£Ä;BxîpMåéä÷Z¿#þ«"~•[Ô#«š;Õ÷ÝWzqW“¯ÉˆG2v'öÔ­¹€@+v%®¸)7M¼eŸ³®ÑBáä—䗦˟O^Ýoš¾ÞÄ_:‡—™uâc]‚ýÍÝ€ß ¯„t²[^ÅžõΧùïîÄhpUø)ž·ë6ùé`gzÈCy‚Oìrú “#˜ïòœ~Om£®‘2¹÷‘]àdg¢x1§¿¢màfç}úÛÁ wÀq¥cÂKÔÿõýKæ|~>Þ,^šùâ;'?÷¿ y7ÚAü–eÝ3±ïiõW:š—ölç\×_M¼—>²¥”P?™y0y¢ö‘àZãdå…Ã1ü½rv Ѫøÿ=õ}™âÛy¼–^.Ί%pø8é&?bO¾»Süœ‹y¯bÍ3x¤aÏ&I*o’Y¤ütïn•ôš n.]Á¼J¥tëbbg‹o¤¯'}5÷¿XzÇ9ñdÖ²/m.¾7®tVæâgk¢Êiå}<§“ç/Ý nïåé3NU>k÷°¬/<2©à=_ž|Q©‹>N¯æZÖ¯¸N¥¿¨Tz‘·ðÇæoâÜɾ¶Wóy%ꧬ_†}oMÁ'uˆ7ìòuÒ%ˆ©¯#u’úÈžf.tŠôds_ò}AéË»¯TŸšø‚ŸKwü0캷I¼àGâws'*ÞzGõè Ô}›&²“¤·˜ëâÜYO²Ï‰ÛU_~\|Å]ÜÏЩêÃÑŸ™íüU¿3\ú®+Ôÿ÷ñ­Âþ‡¥h—‰Ÿ=¨:ˆžßµõÞÞºH^ùˆü7àï{ì‹OzR™ùàü¶8ך‹I_'Â/™C‰Kˆ›Ò¿òœu.áñ§É¯·«îÔõ2öÆõë܆m<åQþ58ü˜Ú?_ÙCǼûdP¿ònf»—©¿ádͧÞ>­º¹U{ªxýöâ>…·ˆOóvðpDóš‹sŠ}NŠÚ->(gOòî1ü÷öëÀ19íkñÛôË$Gi>ä$ò/ù4—0Fº«£°ƒUè‹uÅúø0W˜?œç‹¬Ã¾‡ìCè ¾?X„½jóßµ]ÌçV´3âL™ú³:d_Œ§ÈKF†°ÿ¡¥—7»èݼ׸¿vþבTÿ[uèë•?=?•˜Ê¹tŸ×AͧÄþ`ÿZ7ç‹À9-wáÏ›W²ž­6ö+ÚË£¼÷$(}’Ì_škïÇ~»ûKgBu·€æK”§híì_¦‚|Ž3„ºsüGîsÓIšïÛŸø3,}t{ õóDTÏ¢ý³÷â=rYιq³òø-ÒÕ/håäµÍ¯ÈgO!o[ÓMß‹qŒx“×€;‹_gª>ä÷Rš»rÄKí_HÁ?˜{™ý]<8?ª¯üvñ“­S~x 8®I|ù±×Äà¢>ãQ9zyDzw8×½u‘Lu"·x½³?€7Û_cßßþ’~Aï9œ¿Œô5ÝýÅsP'=ÍÛÔÇy÷>ŸÄNÙ/q>ÝÇðùÙ{´ÎŠ7ªÕœVÞ%ªþ-½† ç:¿‡úB_¦ß(÷…úÜ^!þ±O#?ØÀ9Ò£9ƒÝÌÔô€ÿü~ú ZîQÈÓŠ?ÀnÛò{v™æs„Oƒñ¹®g°³)õ=:ý¥Ãx%÷Ĺû`œ ~œáâÙn&ž÷g}²Cðóùx1÷“x½OQŸæ¼Wç4錛à—:õwFÇò÷` öÙ.Ö‡ôÁ}Ýâ3z\ú*O¹™ûZø y6w3yr£—¿åñ.ã¹CoãÒ«±G™0zÕgiÊ÷•)?i?§~剪· ãœu×wþLÍ î[.øwù½ñÛ·N‰w&} v¢è3òC¡Yà¼äÓšÇ8Jy‹ â•qˆ7Ïy^µòZöÍúûßjÏÞÓ¿Y¼6•|^‰ú²Üã®y²OÇŠ¯ÿõÝIÒTß±1Lù—™ä RnžÛþõâU-V=wŠæ¶þ”NŽo:q^mîÁð€1TüɲQñLš£ñ£¹¼àtóvö; Âàsà7×:úyëW‘wŽÜÌ:T×Ë7*>8ýó” G”جþÙyˆ€ü]óŠ¿û°î[5o)œd¼]ÉmÂÎfÞQ…Þߨ¤~5ñ=gÿÆOÔªo&s=ø°A<¨ž8ø2$Þ‰ê/ÈC4¦ø3?ƒs`æ”ø»”¿Š8®v8§xûß}#q_~žæøÕW+â÷늘Ówÿ¤WfÜÉs¤ÄÿÒþx%x ú´N¿Ï\ðEC+v¨àyñ ÜŒ¿¬—žL]~»þ@ò -Wï¶=Gþ·Q<ŒÁøÜ©ÕØ—ö7d—7G—þ‹¿×K7+ú‚ú¼<øaßhpWÌÄNK©†j•^ªþŸjí»t¡+–žãrõ“n&?Xö8uÔ€ôh2ÏP‡ˆ‹|Hþ&ý¤ú¶w‹7Gó®Î¥ñˆtÔj¥#qU‰0}·æÑÿÒü¶úa2ª{å¾ÀNgÅ?i6OyFâ÷Ú;YïêÓˆ+ŠÚ°ÓQé†T®ã½kÌÝZš“K­b}òG“WË.“úGÜAâôÀàð6éXåÞSÝ® »Õ=X}¿‰¿ä@âšIMÿ 'Ï/°wßÕL%ogþ‰ÿHŠG0"~5[|²ÅÒÉObÿË”‡ON%¿Tî!¯ß‘ädO•~žøŠU÷T½ôDâ\c%ûn¨ÿ0quû ê I_Dzw)õ¯{şиõÖªkȤ«ó4Õ¿…«ìU×>_óóâ]H~‰ª˜ÀyËTàcÀgæM®ÏÈkT)]ÙNöÍÈJ7øjêÑ¡±œ#ˆçð¿5§“/ÈßCœb5±>Á4xÇÚͽ¯ûÞ¡¼t}Œ ðœðsâLÅýרoñzñJo%Ïœ¼Bú—qâѰú@R¥âGÞÍO¾õ)¸Ð7M}ä#¤»2€¼ƒ¿ »šùQ|+»øÜjÕåÊ„3|¿ã-õQÚëðw“ÃÔ+_h&Î7€›’çKò_ìsõ)œ¿àÕÄyN£úÀö" n×[ÒãH¬ãž¥¾_ÛäíüDÝØ]C:&ÎÇü{doñý¾B\éO‹WDý5-iùÁÎã3Øô›œßPX:Pš+ðxˆÏ‹Õ·ù]:M×È?Là¾Ê/tîäÜ5.¯9>ò-Ò=sæ~yʰ)å_\_ð>¡÷ÉUœ…ýNK§Ýš# \»Ýr¼òÒó±-oP߈yÁ)ùwÔ—ß%} ³¹ç)áRú¨Ë÷¤?*²šºEÉÕôÑúй?¥½¼¨?«o~‘úÆsÿ*!ŸÙ´yÿÖþ+±Bó(?òüöïØáúš«¿ bïæù=Y·X·êbšW®8ˆŸo~‘Ÿ¯—Ý®WÞÚÒçåµ>ÎfÕ5Îß±ú*òÇa'‚›9÷©x_[:?é¹?™?°Û¹“9Ÿéõô9„¯_þäM¬síPé£4c·é&]Ò§Ý›ûx‰Gózû‰gíõJÏ#w´ò~×ó÷/çkR–>õT•xŒLõ£üÁýõ‹_<×)Ü(þ›fÕÛÜâMu€£¦î£¾3ÕO2Kd×ïÄÎŽϵw<÷-=žõ)\K߆y£ø€Åó’¾u _­¹ÆÉÜ¿¢çÔGv$qAîåÏ£.’H*¿§ú`ʯx¸HüçêãíÖ<ÜŽ]mñ¾Ù7À÷µ/¢‡~Nü†o±éÿÓ\T9u–¦7Ô‡©:XÛÁÄNûk¼O\Ô:¿Ÿ¼[ºuËÁ“Õ¯‘Ï Ì Îr‚¬[Rñ1ûœ+|Û¢¹´ ö¬ú>ú·rãÀöÁü÷ÄòÍx¿àkàïPâêVõ­gΟfŽá>EÒâýMúÜïb?ROakV³ŽEªîmp®¿”çÍÏ’žÜ¡àÙÌíØáŠ'yßòè_xKÙGk$ߟ?g§ôÚ¦‚3­VüŒù&¸ãܯ5R¡~né4ûOŸ–ê¹<ÿ½uoüsÅ*ôßá˜:Íë†Ä{Õ³ŸôÛ~"Ÿš+_àÙê×yû\*=ñË5o¿>£ tÉ­_°;ÎhñÌúÁUžûa úÙS܇*ŧEÒåÊÖ‘×¾J\±Õ¿·“x£ÄÁïmÇžŽY»ø¿ ©©#¨Ï=OµOPÝXsºÖ`âKϱÒkîÒü¯x2šã >Dþ7ŸDÅ¿\áÂ^ÙšóOH/#r˜ôÚÄov<¬¹®—©›u‹ºr/ú@\/ׯü—öevÏÿ9÷Þø÷õ_ÅýŽ[àM7çzÒÿs³fA¨•üaòð@pïQ8—|S`ö¶YùªàwÒqØÊ÷çv*o»•84ù~3ÑWqóïàž¼Í¾•}ªsóžú(?ÆžØÓÕg+œ[¼]sÊÊûÜž1w‰¯»Eû< ü⑞Ÿs’ê&ê#ëü ž¢þ盲·ó|n½G¹æìÉÿªwhnmç$5”9è“<¯ó…ôÀÏ9ó°gù¯Ug„ÝnÚ“så“î`þDê; ‹¸.“”}Ï€S"â“omÍpŸŒO4wZÄ÷VJ§¬åoî‡užøµÿ#¼$}zóuÅI.Õ³Õ¹‹q^&_+þ´ƒ4ç)Þóx#ûl}Ç:U]§þ˜ãÉ#óøž6åurEêóï\n˜ú`Q>åzòGQá=__ìÐTé49ŠçóQò¬öléxèxM~¾¢×¯˜Ê{¿¢~¯kù§WÿOºXÖFöà =Š þ!µ‹|@îMÍMìŸÊ_,Ý)å±ÓH×ø!ê`î#Y÷²©àƒÐGÒ?ßSHùëÈ­²{9Ö#ïQø-ê¤ÿíˆÏÌÓ(‘&ü_ævú|~åfÝSÇ`OÂÛÕ/·ƒ{“?€¸ÆxZsAâÅ0ìGæpGÇŸê›C /öÝ|þ&ãÞ'p,x¥øspm0É:zŽ•ãêÉ'eÎWßå\pyî"éÏ?K~=ýö#÷4ç)<û_u0çÊ{ï~‹çÎ;Ä3Ù ¤?>†x:ÒÉ{¸¥§é<îO©+â[ª»×‹ß~OâäúÍÕ´a?,á¿H)÷®ýáÎ78wSÏáÞfI?PuÃÅÝùOØÇ˜‡ç«+ý<é¡DNå}J5×X)=Öºä3Êî¡ÎËúšÇò~­ê>Õ%#åŠ×"Ò^¨TêðI"ÆÏõ΃W¦xBŸký N çù,á÷Ô{ÂW•™váöØÑªÏèõˆÿâ+îqúpò*†òiu÷oÖ6€ƒ“+ðƒéyœ›È=ØQ#Á=O%U¿>\º¡çIÒäÜZ7p󻤾/ÿÞðù£ØÅkG‹ðgÅcâ׳·gLÖ7a€Ó¼: ͳg¦a3×ר^ñ•y¥Ó^ͽª_ŠýÍÖï$Æò^Á‡ùù²Næ#éëÔ—ÿ-q}ÍÇôMº¿á܇d×[yBv´v:õ Ï%äšunÓ7‘§iHs½Äþ´¢üN!÷ òøÇ#]ˆå‘ì+¥¿¢çê­kX7jŽà.ÎMÑætì8ënοõ6õWüD?aèe鸔Ï$æñ¼ñ%ØÁò…øÑì@õ3+S1@s¤²Wù£À{é”ê÷ê×ñö縿å´ÜÄ9 Î$Îö=‰ß˜z´ô÷®Æž§äw›ŽÐÈdéߌý¬”žqþìU÷×cå§Jfqþ}mâ'NƒÇ¢¿ªõQâþú¹ÿù ~¦)úv½­ºKòµ7‹í\éÒH4>Vý/#ˆsÌNñ0bÚ¶¯øà³SjÖ‰—w#÷ d ¼ƒÎ6ìn£êe“¹ÏíêóÊÞÀ}3†ã/2—²¯Ý§h>e8ÐY Þ…3ÄCpŠx¢lñù Å~Ôh®Ä<–ß«;ƒ÷v/”]Y >L.$OÐPÇzzWPg4ŸϹ^Qßóª_O¢>Ÿ:Fñ÷Qœ+Kç v$þ½V|V¥ÊG·s|ÂY!Cú«÷ñœÁ韯“~¯½ƒ{ï]J\P<^ª|ÊÓÒ£nˆH­Vy‹ØÃêÿŸ©þàãè{­;Is««ð“ÆÄ빇ٿÜc¬‹SG=.ý³ú_6Ð_×p0öݶ؇ä̓_)>öG‰*‰«:.Áo”ìT?D±òÕGP—­Wù>éÐ Äžùk•Ox€ÏoQ–3Uú‡ ÊOª.’Ê~„Å?˜ŽVÆG½Ë{½ú@Ë9öã²s°ûͳY÷œøÿk5Gå]¤<ô6ðxþDÖ1;O|ÛêÏ34çé/i^ºhÉ£‰Cë^¯d.á{ƒŸ©æ;ð‰}‚tf/·2×o™r}+^›=ÈóXÏb¬ñà”´ø4º–€Ÿ;¤û6äæëÿ1¸£XGòyu‡2?c>‡2ÿb\kxžBéžÚg‡<ˆsþ£hÓåÃ︦§ />³ˆõ5·p¯³Ò1ˆÿt®ÿÇZìtõIèV4?¥¹ç¨“¤“ÜÃÈfñäúÄ£UÞ®NÜù\Úø¨âôKø¾ÔÍø³æ¿¨+]'~¬êA†øš/Ïü‘š××\wàU¾§#ŸŒÉóu‰Îó çËž/þ2Õ¹-é3Z'€ÿ‹©ø×<×aªWí Ž¨-įÛïrŸk¥+nƒŸm•Nºµ“<{BzçÝëX÷@#x=0ÿU^+^Éù5w*/¯¹sG:Åã š,,:S4§ô"¸´V< ÎMÒïÕ²ã`§¬+5¯zŸðÊUò»É·æã\åßUÿ©âÑ:ñVµŒâœ™ºï_ùwpø`ðbJºâIñ×_C=ÌXH>2óÏQ£ºqO y°âg4Ozç(¯9›ðž²C°§±Mä›ãaÅ­šSõKßɯjÝùÒ9‹øÅ+]ööIÊ·?$ž¬3°OŸ±Ž)éŒPNoÄO7}½ê­+„5Çì]¾È½Ê¹J‹§(¼ÿbïJ`çCªçU(oöê ’ŸrWŸ]âãMØáÎé´ˆç°ü@òäéZFTÇ5îäÜ(æûŠÏ†-÷<ëãþ@¼•§aç\^üGö~ü¹Õ­|ÝvéœHWr²ê!圛ðfî•k!~Ð÷ßE¾¨—¿¼êÊÿá»I¿Žýa@©9õp«ô“®Õ>,eSâ!ëL9 û0Eu’¨x¡s­êß9Œ¹çÔõ=£xý ì¿¥9÷Fée§¤{à•nDð+~®x”âé©v‰G¿ýlÞ7Z#ý$áÃéV¦¤SvúñÅ-å^&õ÷¦QÔg²O©Ï³W/&¸úS@zÖÆ‡œÛ2éfo~p–ûbÈ¿”‹GsæÞk˜sîX¬úö)à¬üÅšWKH'-Ͻtß®yç·gŽÎÿ*Ýñ:YýÅ«œÄ'wSŸ©ÿ¢±—ø5oâ^ä®â=½â±ižÉ9Žº¥px£Zùßàg¯pxöiñµ«§\y¹jÎoxNÝW©ïü"ø/œ³8×ÎàãjÍ»X-êë‹M)|-ûV(¾æ¨æ}[÷å¾™‡¨ëÃ/Ôÿ‰Oÿª|öóê—Ý.«â¯þM}x?€à€ò‰ß¬yª¨ÿÖZÄsõLGy'~«x|bà¢ÈÉŠ“•Ç5.$îm9•|lúOÅùŸ‹E}®ÆRÍ®ƒtf=ê_©ŽaGƒ§‚Ûj>^á‡Ò«\ÃùË ¾W`üDð\ý@ž7²‘õö›àÿMÒO?”5^úêß,Â.UIÇÁ}¨x84¯Ü݇û߃}0žÀØ;¤k»U~mû•×|Dêké]f5gQ(}ž_¥g¯z’íç¿'§«ýEþÝu™ôW4S¨ù…L@ó¬Ó‰‹ZÅß%¤›d7J· ýiPÔõ€ì¶øñ3µÄY™&᪠رÊè\fW³Ï~é›ÖŸDž¸õ6òæþªsÿľ‡úa½ÒÏM— ‡l õ»ê/U|_Í$åæOçp¿sÿGœY¡y¼ìxñú×7º¤ïQ1Gú⧃'ãÄŸÝW`‡óÅ‹ºSóaçêÄ÷Pöy×ì,ž«ç+ð¡=€<›7CßHW3q½ëügúVòu“¸÷¡ŸÅË0H|Ò¹…SÏ2?æsk5—éxXxÍýˆ÷"G2Çà¬RýXü©-‡rn}·+/ÿ'v1ö‘økÄ£~)þÆŽ¨oDz.aå÷BH¿1NÿªÀÿ7ž.ÝÝJ>¯e½ú[,ü|Ù«à Ÿö¿PõòÌ=38$!]âÉô3µ¼Ï¹‹‰oÌ9šóž÷É?Χ¦Ôft鞦°þéÛÌ<¬9ÑñÅxÉWî¦o'³Ÿú&_ç^&d§òÒ! ¾"ÆÔ¿Œ»ùŸxà ñ]4è hR(r"x7Õ‚=ÊÞª9µmН¯æ9ã/ðó]GçK5r?3…ꛯ±±›çq&JÿhqWú§)õS:cxþÄHÙçuàGïÞäIÂâ%÷)n·`‡ã×Q_jP=¸½Ró¹ï²O­Ò—t6bG¬«.ã¥~áì^÷x‰Gãâ1)y|ê9Pü‡_€/_Ç7K÷ÏØŸ{Ñ\·Gón)éÕ%£êÛ×üŽ!»úùÿß}ÈvJWþî{n)q°ñ"ñ={Y~Ÿã¿Iü‰;Ù÷ŽÝìoë4þ»ûTåÁ׋'¢ ÿ^6¼nE9÷MÒm¾F}Boà/K ñ·jžJñ™Ñ_|Óy_óOê«MŠ‹|Ïkhþ<¹•~ì´ú¤Câ7²¿À>Ùƒ£êî–Ê,ü7ßuL¼ŠÕ™,çÈŽtïœcµô·S•ŠßÒ\çHòfg*ŸxëîƒýlÞ[}õ‡iNrv8¼¸%ýˆú!”ïȯ¯gįu¾+þÀ§÷]%½¤«/î*¾ß×H|?…µøVp¾\¨Ÿ”圖¯¤þÓX,]m7ïÐsÄ5§;_õhév‘Ï0#œ£¸øòœ=Yçž!ìKçüi_¬õÐ=¥xL=ø:P¾Nö£´™¹kï_àJ÷¸—Ö¬_é`øp©ØýÜšÇÚŠýh:Vºn'pß½ëÁ+‰>œÏüéÏÙà®vé¼·†=­¯äÏŠ"øÄŒjîMý_ôiô\({!]û毉ӬoÈç[ÓÁçÕâE7ÄWšú[}¿ûaSׂ’ØÉ–KÀuÑéøyÏSâ{QI¦…uëÕÉjÌДSýÎúûf¿Ê}êØ¤ºëýàÏú«T}»ÿ[‹ø9C£Åï´\zí¯è>®Ç¯Lúž!Kuws1ñ„ç ñ»Ûø½ÄÕÒŋзêü´]¢þ¡ËT7ÿ ¿W×¹YyÒ2ð}æïâYÙqñw¶‰Wãzp5“>‰Þ~Ç–ûxžÜ ø­°ôBã?å 2gò|Þ?è±6q¾<š/µ ñ‡ªkK—+U†½Ô©Ž[û3üÚ±ÿGY‡s¾œ«¤û£:N`Ω»üHLyÛ¸w]¥¬w÷áø k÷!÷”üFæ*N¡ï$WªøAó&ÑùØYÿƒØÃôÞÔS²Åâ½ÚIüS{óV‰5Ç»ˆßëNž&”ľ$_ã¼g•×÷~E=+p4}Åsá‡M~%þâ±Òõ²¾Ötð®[óÇ™§¨Û„ŸÏo+qB“ô>‚³T/û ¿+.üJñå»àÇÎ^=ËJÅë yÄtòÍÊ'›`/ü9Ö±õVì·÷îK×FòYñÅÄ Á“Ô/=N: Àqöì»3ÄìíO>€ßKïb.Ò(S~ôémüûZlIOùVñGª¿Ü Îñk¾ }:}åƒÉ;Ô ƒw;öø&´šýŽçÜ[ËÔ?4†{ê~HJǦ{5v¤JüB¹aGÒ›Õ·)ÞøEüÝîVp ~Ïu$÷Ðù?áü|®ù&ÏŸ®¾ÙÓñ{éšC£õq?uÞ„½®Kφ ñçͲ.]»éóÀÜBýžœ‹øëŠW2œßrò5ÛÈgzú€¯ºßÁ¾”Φ¿`²æ–µª'kÎÑu5u·”xF2Š¿údìN÷øê78oåûQŸʾ]l%^‘uª³å9GÆ%ØÿÚè¿0¾?ÈäËW+¯ó?—®ÔÜ×Dp]ó}q?ùœ˜xº£ÒaO‰‡ÓiŸ·q_kŸÃîfˆ×½ÿ*ç¹ åÇÜK¹7™{ÉË–}NÊo“Ôå༘xIÊîãT®þ »Þö‰ô3ï&P1¿c+bH¯"·˜s[ôý‡iñ˜oƒ¬EœïÚ5øáÐ-šß^¯9€6æ8œ7©¤ÎགƒUVJýÖ&õá’ý.¾.ƒ{—Ô}Œmâsó·ŠÿP¼ÈÞÄ»IñϹæˆÏbø8½'ø¤³\Ô½ç¬Kü²öý|žÓ ^tŽÄ?õ'ØÉÞ:¦-~6»†u4ç©^3 ÿUÜ®Ïx)v>¼‚¼Qù]äíÊʰçiñ¿å7HÏØ£9‹œƒâëˆïÊÞ˜öÁ:ã­ç>Ö'*ž]×iÂcèŸëx˜uˆáü%r¿ÂO×™¿+o·\þxç3¹KñøÄñ¡aà¯Éosoã•ðùwÔþ:ØcûFîe¶žx³è{ú<­¯ù~ÿÔź!PÞ³¬Fý›c97áÂoâÏr¾Âny&Hß§[ýo­ä™ýaé¼”×tž‹°5ŸR•?·mßÍ¥âUW´ö{æèŒ±ä;”G o&~ˆx5ïó3û™Áýh]¤yÍ+'ðžÖRñ'Ý¢:Œø—zõ½Qñ â}GÉSįÑ|µÖ)éæ=rKÔÿ2Sz,¿{gпíªÇLÎ=tí÷4 tqïbéQNâ÷áä«ÂÈ>i>Ù8W:Ó§‚»üÒ' /þ„Sèl—½-çLõClὬ¡œgÃV¿¦pUNö!3“ïoš£8¦bþ"ú¨üýzÖ1ûþ6ÛŽÝÏÌçf4ÿ擾DòfÞ/3œ}Éh^+Ó—ûU<ƒ¸Ð–Ntñ—Ô ›{ymRäç!êH^¼Rûëß \ä«¿úòÛÙbÕ{ žh´³îµ xÃ`½³Iì•k_ð{øq5ïÒr9yö¢ äûƒ•wvÏÅö%..Ÿ¤¾¾¸a8¦g.ßk<&Ñ+‰×ò&ßë¿@ý[=â¥Ⱥ6ç¸ÇÒoºšuˆˆçƘÞŠïÅ}öl×ÙÛÁ‰08,û5þ"¼EñÑ*ðXg‹æ÷ž¥Î?;^¿˜÷0ÆHW!$Þ:·T¿_ÒOóÙ£¸/ÆléWèƒË—êü#^¶Ùܯâ½è+,¹Zú²ª_6*_7‘sÜz·)²Siò`ÖØËòCùýÄ%ÒḠ¼¨a?Ë÷ÕœÇ Í—Æ>æ×ð|F_éãÞ…=(; —üePóþ¸t¼¿Â…¥']{3ù.KöÞ)cÛ®g¿Ê¤KìzYùØVÙ™ÏÕÚ—ø+ݤù¬sYßîaàöÐàrësö¹óütúiìm@x³f“â‹§”O¹ûbŸ 9©Þ¾@Åæ¼ow¯Òïâß9DçâcòVöÆj'Ú­zWúdÖÅ]K§Z:G±À)]“ù¹øsàL×ÄUÁNðCì}õAåØOs!øªtxZ“âGQÞ(ŸP}c¶x»V0‡:œ¹Gº wÐÇÔ±ŽuÉ­$>ðÞÅ:{.¾šž-Õþ·çÔ§W³šx<=ƒó×)¹ìušÛouèoñ>eùïEÒ;èê­K©ß?ý±òyÎI´¿êι=Ä›Pƺ'À/•‰G·ý`ÎmúuüOô9îMh$øxÊjúÏìê#!\ñ§òœ¥œ»Í¿„¥Ÿš}”<½/럽B<½Ò!u\ŠcGðûå7áo#Àñ‘ë¤'+Þ‡ôÕŸ/¿úb쥽ëfÌŸÖDìAÍ.ÍŸHg¦Jýè>ÍÛ›±¯éo‰—[.Ὰ’êO¿Ÿ>ͪFü¡ë2é:§§¿Çß´É>Ô­…÷Î\¦~çפ}%ç%á¨L¼Öò<­Â¹[Y§’YÜûIÔ9û’®ã\IONó1ö9œÏªeè 䇀§ºÃþg7s½‰ý=€½ðŒÐ¼Õ!Êó_MÜyHsÞç÷dk4/¶†ó›èà½ÓéO M^ž+}ògÉ»dÚÄÇ;‰çɳÏÁ/”WU=?w>qF$M?Š_óŒ™vê ՗£X¿â~èœôòÙ–JOõ%üIh0ïçÞˆ?wIw*¿tD¤CžºŒ8?g’ îMSîsìz9ûÜz>ûkÜ N¯šO=ªóip_÷ûŠŸú`GrÒ ¾ 6‡á—ŒàLo‚õÉ÷ž:÷ë9“z {]üþ<¥:Cø ñª_§ó6q®y û“<üOóP½Ÿ‹ûYxóµVâÔ°xkr ìUñoà²\_îg,Až;øÏ×v.ùœØµªONO]Lüã¹'©1Ô}}Ÿ3ž£yè±âûHõxƒ}(x‘:¸Ó¦¾è·4?pö¬Xüà­À Ù¯…#¦ðóv’Ï­ŸyÛñ­¤^Óp#¼nFûÑ~5x53\¼Èçqo&.Pœÿ58Ù/žÿ9ªÛJ¯¹cç£íÙ³•ÜãÚÍàjãòL¡£¤o'½ÊÜ<òF½zȶxÞ#ÿQ\ºçé¯9/†Gzl§3Ÿm+Ÿ{œ{ì*£Î–ŽQcžuoý„ó辌õóŠ÷È5I<;ªwfÁÕ¾³5wµ?æ/'_•ŒoÍüœõ)ùÀʧè«=üdDÅÃx›æ­^Æ/˜%اn}F‘ÁÜóìØs«îÃØóBéuÏ•>ÃrêO®]ÄÖ:խDz>éâ/Ø?‹’ôK+^qÎû›…àh-ö$>_:ʽëü÷-^I¾®û+év«oÆúûšíŸ¦ÎWBý»ÆxþÞö#þ¿~½øµCâóÙOy‚cxž&ñ¥9o ?>#žÝRú;Ò—á7ª6‘'Ìma¿Kg‘_l«_žâ¶ÎEػȞ?°ÿÖù©òÙâ¥3~bŸâG‘ŠãçC5Äû™fö¥µQý$&v6ã}œ3ñÙ Å7@sð¿€Ý}ˆsšO§¾hÞ½ˆ›|žñ}UæsĿҊh^/y†šùÞ:é§[÷ˆ[<––-^_ñ,XÏs ¡Þ;{òW•Ìd쳨$ðÇÖ\õË+ÞÃî[l„æµW_ËØ›ÉÂ+Ý—K²¯â¯Íø3g±æð‡²>Uû€;B€ƒþ¿Î‹ô_j„'Òàg²=ÂÓGñ>ÖGê¯>—8;{çÂϹ¿Kþúö';Kóc{ó¼öýØñðFð½qú²Ö×CÃ9ÆB¾?ú-ñtÍyØÛä¹à‚ÊŸà— ëÞ‰—0'¸°ªšûëo¿“Ö\ä7ø/û#õ{^O|Ú¤¹ë„ôíRˤ/v'8°îúÀJΣ¿Â™Œ=Éo¡ÞzY8ÙCž{j~sêqÒ{ ¼Q{y¢ì¹â=zˆõIõ“.Ózö/ú4ñdæ~ìco_ovüð…Ò+)Ä/X¿JŸCs¡™»À uÊ{»†2'ñàgB?`góK?÷Uå».ß¼¯z§øÍ[9ÿ©”zìB/´»…u©—¾GÃ|âþbñ³%ççb’;ø^S}õ¦xëkLjqóI£Óÿc¯+ð|Nv—êGç‰×iÏ8[øéÞßó(çÉ×;—ÖGü݇âOGi^ãvìs¹t‚·b·Ý}X׌xSSCUïT¤}´æQµ¾ÖLÍ;¬$/uK¯äñš.áû²škq6ŠÿïCž«V¼4Á:ö1-¥ôÛà@v¥ûFp¬WùSÿ§ò—ª×–jTú`á+¤;PÆ=Œ>¨ûùHoœ¬|G ëÏèGÎih,¿—¸À¹Dº”«Þu¼æò{ë‹÷¤êJð_Î"›Ú>®VzËϲ¯‰ïCñ6¹ÀYš =,Þƒ‰Zï¾ÒÃë'ýŸ¯ÙçT?pFÍÍäK­OˆÓÊnbž·ü<øKý'±/nñÐÕ¦¾Rwµô{u¶§+çæ|Xûà?*6’穸Ÿ9‹è3Ê …ýñ–ƒÓ¯³Îõâµ¶O Ò±ýSzw¯c/BãO}ªçvœGý¥í<ñ®Ä¹­–®¹= ^Ý Ž¶þ-üy"ç¶âWüyâ7å’â]™N?RümöÃ/¼únìBèmùñj{ày’cÁÁ¿5_!ž´Pœ’Ö@>Å܃ü™Oúeö4áÕ¿Éß…ž{ú:õÕýÉzå?ÁKÀy5uÄ)qͽgnß¶(Ž3î%)G×7óÞÕý9O­ë¸7á7Õ_#>Ĩêqéò«>ͽ…4_›¼—ßS}_Wéª?Üß¿=C¼ˆ;4Ç¡þдæ&Lé;—Ëî|©úCŒsøQ¸ø⡺öÁ˜L|ꈇ/¾Z¸ônòJþšc)a›u+Åo˜yÿ™WÃÚ!Þïž×+ûd}þïhTŸ\_~?u2ßüÿ[»‚¸¸ýhžb5ñþÍ­ù„ÎK±5MØcç3Í)oÅO?ˆ¿ï|ö¡Szй7åïb½+êá5™´pÓN»§q<Ï—½Gùã=µŽš#‰* HÏ §:¶£Ey"ë{üuîXâãžãðÿæŸØ¿æê‚›°ãÉ'xްú­ªoWçToͯ:‹ú“ÂÿeÒ©É€0‚3£[Àß•š÷3îVxõì prP}.ƵàüøBübø.éâäûÒ£Ø÷´÷H"ÅmÈ?}D_y±ø0‚Ïã‡"òñ¾ú~õ³dg²Ni;›ŠÖ;(]JóUñ©=ÐŽO®/°ð`ðCÖÓõªÎµò½Æ¯øßŒœ˜É}­;ù‚´òí—ð|¶êÄqñvmÞY?inx¸2!¾ñœêÞ•môUøÕG[¶ ?„ýÍ^ÀzKW¤m©úÍzóý—ª¯æ òÑöžâ5X  {ÕŸSm.?׫ÿâyÜ’}Dó!g‰gª…ü]å;Ü“Üvéh®;SÍÏG^î„ÅCàlÁŸ¥ÏÔœÑXÎaþ9ðCù:p¢1 ¿^e®/ªy÷Ð^ª‹œ ¾ì¹ÜlE¹—Ö8ñWŽÃ• 7š‹ð'Þc¤·µ„î4õÑI.õ‹æÝ ¤3Gyzé>›Çb'ªË› êW¯ÖïJWñZ𥵅8½y ëÚ°„~Êöm¼wrvÃ;‘ókhÿí•ÔêDŽėä|(?ñÖ‹ÿ ³ZsêOjW?HNóÿñoÁ?©âSúUóžÛèo-qwMwŽh/ˆõòÒ“wH«?Æ +Ï«~p{ŽtYÅÛÒ)]žW‰çìY·àšÿÿ‰¿›õi|ƒøÒûö#2¿Ñ4‘s× îäÀ=Ñãå'_ßÚÒor®Á^9÷ƒcBaâìü«Ò)lb®?òoåu†°¡6úö#1üT¤Ü–Êiîs ùûpò5 Í™eþÖû«þ™éøãkÍm6rÞ¦Àç_„)|ë‘nWè[é4œ N7ûÒG’:ˆ÷mV½=3 »Y-=âÌdòXù«Å“ÿ£òò—]5ø'ü«cthîö°si?ëúˆzÜÍkø5¿—(¹{˜ü]|šßDŸU¿è0ñ J·Ãr4Ç}4ûœÉ}µO¦O®³[z[WkÞàîGfŒôÆÔÜ…x4ƒzÎÔ4åU—±nõ´iÞÇøÏë9P}@ƒ5‡ðø¡tì¸ãûŸUZ`ž*Š7ˆKŠ®cžÅT_œÑOóz3ñ±mÂï}°›¹WÙ§ ò?Îbö#$¤¶Ÿ°ƒAÍ­V7ÁÏVT¿‹Kï9óªê÷‡Ð7ã;мo]õ¬sÏÿ²ùÅÊ_ Aú«rßKÿå;ñ°]€]Ì-½åá"šk)Q^&¿—ôG”®P½¢¬¾ CzVùàÉÖõòSK©;[GêœJŸ/¹TüÆÊŸ™w`Ÿ¦N‘î C<í‘.›Q‹=,wÈsqÖÉzŠ8¥¹’óÖþþÃYCÜäž,]£¥àÈäÏœw×ðvzúkÆÊnɽ¨ˆpßí1Üï34™Â9Ém£Nk?®s¾ý/ü†¸­>Ê9I«Ô; û`ïù¬ ©ž»A<=1ü¦ïCú$Òân{@uª¥ÜGs‚xQ§ò{m&ö.zï]?ˆ{ZÍzvíÁ>˜‡ó¼Ý¿â-é±W>ˆË–QŸé¸‹u÷/{Týñs±§Þo±ŸM_b/Z^£Îl;à ùKûqâÎüôÿ†^TÿžæÄmà×Õ[úpÏÍ“À÷‘=É3{Oá}ŒÕÏ=WülßÔnÆ~› â½Ó¼§¡úNÇž²[ýØG³{ã®Òºt`§Sw°~­ËÀ_Þ·ðIéXæÇ_·}D+§¾–ð>êÓ×sÅF‡Ë¿ ~À à¿Ì;By$SÑj«Á`Fã‘~¶ÕæÑ{ý¶‡JïR"Q¤6mmQI^͌缇ñ µñûš­í·¿?¾sæ~ιçsι÷Ü{}\ýl5ü4H$’II…øU&þª(?cH$]uBªº1iÑ¡„F‡À6C̵­ŸzæˆCŸ¹ëyBRåw$Ô£bGÿW¼ïvCØ·+ÏxÙˆ÷žðìÛqâŒS?þ{ÄÉ2ÎÞ¿e׆›À?¿¹lè(ʬC±VY¤­?a÷L B¾VEÏ)ŪÛƒo#o]º’ëç)Çã ý̨镚¦Y¼ Ÿð¤ ¦ºöNÿð“—z¼×Hî›öüö²’ìš¶¢_ç¨ï_ö„§ »Šu6@µáœÇ“DHŸþ°ºÍ¢o»óö@bVpN»!âü7Âü\Xåíoõ{­þóª$jd’ŸÁ/hM-+_¤Yƒ–Â3I¿+A„¾úæƒà‘›.P/ÆA¢½éÒ\U]n_±-:” ±ùÞŒàê»ò=Lõ†Ht (oŽø‡«C&?ô€$ ?ýtÀZˆ&K´ôçAèHÿ•]a^c·-’¼á勇 íÔ);¿rˆ²¸Ì\<¾"~A–ôcÁ ´«v®Mñ†ôXCýü²“lÙ˜×1ÙÒù:DkþLZwÏ’d‹ ë{HèG/OXE¸¹ë“±7ZZNs.F˶ûÖ™¬ˆÞF½Oµ!uœ:tæçn´V¼±´¢’t¯› ûµÑzòMÀ w%´|}ådºñzH_¥çXxAÒ5ÁºÚ2¢’ÌÈ3Ý/ ™V¹öŒ›Äóâ”ø¢&pÒ¬ý¶I¨L‰j›y5ó¿ ‹ûÏFTqÖWß-Dõ¾8ÿK]ðŒsÑ,= l-n‘^ýET~ߦlXd‡JµN›gç¿Aõª8ƒud?p4%žµ>®í¹Shzh˜™ÎÛnWîšÛ;°ŠF“¢¼0Imp…3M¾ÎÊÑÏÆ×Ý)j.xÓÒwI;Ðìüà˜à%øOt»[µP^|ñGcû2°.ÔOt¸v•Ëfd õ†ãeÉû¤¹?£¡¬IU9–„J½{ÝSx½sKò…uº¨ÔY§6=AU^ãüíSâu_Ò³~‡XTLK=hPWu/;Ç;æ£ÆóØ‚ená(W‹/Q]d…*îW¾úq#^ùõ»°3D¨ x{ìÔ›I¨µØRz`ë5TçÞyäíá†&å[­—Þý¬ÒñoÛw>…ä,'òäHH‡ò'=›áMgËçö³ Õú Øëq¼º›‡qh9ÿb?ÿº-¤ûü W§d@ê~oö/'ØÎwì ôÁ›7Ëçߦ~àûº}sxÑ.4ÿ4OåqJ3¸¥½3â¯i£Q·eÏÁ?×ÿU)ùár;4ïÿn•‡Y'š‰j3‡ªÀÛ­ký¾]uâÎ;J›¬ÐšS©Ÿ–áùÔÉf´\ðHPª=éì]h‚2T5Ù k Ñ"ç“Ï&úQä,òm"öWÀÖF‡ZBUϱ¬?A¼}û´’ƒW ­¸iè°É­ƒ¯íVŸ „ÄÏž\(,$ðR‹ŠÆh¹QZût™ZC«Ím2óÐòcà>ê/9«ôÜ+ºÉÊøø;geÜFvöu4ÚûJÏe^««!Ãó* *{2[¥ŽúÌÙ»õ–³ÑX=hÛóµ·> =Wz¡hŸG8ä£_kú€óÁu¦ñ¢~ÔYê#½¾Ï&Aé¶Ä”æ1ó{#1>v9¼rùB¢súU:‰ó킪UpØ1ð¸¬m ¡¢_Daúœr |óTÞ‚È—þrcŒ ^+ú¦ÙiüÝ}³®¡nöš®ií`o×ùpL­üè_eë‚“mq|í¶bpÕ^ß]SÖñð¸¨3ñúÈJ³mJ)àÖ²Ü`ÙÖ}潂ÁÕ¨KÙÜDËvASNiîØæ¨#kuxyüöáþ õÃtYÑü:áÜüòrÔå/.N³½ŠfÍxå¥ ?‚Ï}+4qsê­ÚI\>$§^·™ìVÊ•Éö`’||YW&Ed²g»|ül“LŠ¥òy’l¹ìpÍ”ÉÎB¹ì —ËvW¹¿vw®LöÝì–ÛIåüݹrü͹ßö¹rÙ÷QÎ+,WÄi)OR,çíTÄ5(·ï©“ó½Y£Ð7Èy;v+xÆ™Êq9.š#çíUQÄŸ)÷#¬”ÛµåÊe—‘|¾x¯|^S^—ž»2G`»{ªÒ½SÁYmr`¯Ót°í­êˆ_„šuVÇìPC}Îп®¡ªÇrŒ8E5…:—NòPS­Õ»Ï •œÉ…-R{T'Îð÷ª·F »ïƒCI&ØŽµÑA ×Pãvócà ,›‰ËxLÔ–Ì?jàêÊD ›ú°i¨ñ%ŸoWêÅ«—æõÓÀI«‹Œ¢€c·=­œãˆê™áÝúf=`æ­z8µþï2ë³QóÝ÷Ós¶Í+Ñmò€J8c³º,£gU>võލ!»D÷N úxCA¼ñf°oeÝc¥¹€-»Þ Àzà =ÌɧãÅ| 8s Ø‚Åw¿«W BmÞàëûQ{b¼Æ†Á£¨ù=õÛpít°êÛgîl!ÎéìФ-†T°˜ëvÆB¿\ÍB§¼ /Í9ú'1Þo/ÞSÞ˜Ù¿|ð\*¿f„f¿Ç÷çVýZÔ`í´‘îÐô[7:ÓQçÓû{]}ØÍ¢"¼!(q5÷ç×õ^½›D_ÖiŠtm†ä£`ÓþqG þ6×Ù'E‚–wCöMf› Œ¦7Ï¢C\dѱ€ÜLœC‹?Æ‘] .ÈïÈ{€Ö² €ßpÀ7©HFŽ3„žv”ñàŠ.9–ƒOZ¿tUo+ñ^Y²Ó±Ò|CýŸ3@9µ“}h%¸áþVžN_ƒwÄ l²·6øCiWŒš€w}èr[xjÆ[o­X὜[w|&€o¬u‰”kAÜ{õaSw=·ÉhàÛ}a¼§²ž[ïžSLÐZÎ ˆg!š‘ÌT±øü7Wû%ôTpÏ̾Zùn “NO|Ý0Ü»ÑVoU+w¼ÞµcÏ¡ñž†Zë6EiÛÍgj‚ks"dj¯ê÷b]ñ>’”— þð³’N¼ÏXyÊÆmþáM*#g@bH]u4*¢¹¦äõ§C !Ǥi>„OUæu]šÑç·JÔ!ÙköØ{V2ÄžìðZ–VòÆ=ê/˜u1B` Á–;O5æ€kØ–ìG¼£Vž 3»•ü9Nž}@ð'êð¬w6ýšé™ŽîêRðd×ÏbðÝd^pÛoHo'ƒŸHþum™=‘WÐÅ 5ðBd‰úg5Qö€Ûg2Î+i ¡vG"Þ5 ¿màÛ2]ôÆB¬®n~*»ÿ‹Gºr-‚Ú¤áw<‰dA|ê_˜Œ#L")Ôh⿾ÂN÷/[Òx “ÎØbêN£‡S##·*`J%ÒÔ“I ¥D*PU:…IU Ô]ÌpÓ%”è +¼bBM]¨‘1L ý3… g0 /õ sòÿ1'3b¿0weDRC(tÁhÖœüw{ר:-ò çZ TÓÁþ7”QšQ”£áQŒ#¾e¡áûÒ¥ùß_d£©€GAÚ®±‘¦±>´Ï‹¢¹ŒBßBÙ:Úã4Ú›;•ÉÜú·"( Ñ±%öDÐ_ë­EpÑ¢MWSè#ÛDÛƒAeÒÿ¶þGQêy0"C‚Ì A¥|¦QõÅ©îIÙÊíLŒr¤ê9j®º#:ÁÙ¡Úd:-„aêA¥Å0e½!«éjZT•Iù"åQðè´Õ})1Tæp¨#uð¥ÆÿmH¤F´Œ¢‘ÔŸ†'…ˆšH;t$R}2-2„N5]ËdDQ‰nZ8¢çIa2i”‘ÚjûÐBBcLcˆÈiÁ#àXWZƒøÙf Ã`Ñ™.°q´8€Èˆö9ÿñŸ­fRâ¨#›Íà3ìI¤AQLþþ ZÝjå seriation/data/Wood.rda0000644000176200001440000001553112606356654014602 0ustar liggesusers‹]™yŸ?îü1wÎóž÷}Ÿ×9ç}ÞçÜÇu±ö Ë{È“H$ IŠL!Q¤ÄE*E|!“¨$¹ÿ€ûþý;ÅÕŠ$’”t,øûÎ×}2&…y­ºÕòÿ¶™÷fÎïÂ;×ï‘0^©<<}< ‡`§)0¾ì%¶Ò “5¾¼»ÙúŸÎòJ Ǥ½g”RWÀøþ-ôM|9|².®—‘òc#—W/ƒ¡{³Uößþpös\š "k™ÿJ0%³ôôm/ŒH;9´º&Ê[÷gµß¤ÉÖ/éÔæ‘yév †øÜ˜)Љ“­”C?ú]Ñëõs{1åõ®HÍä{P`Þk‘rzš6«œ ½…ZR¶´w©vÀ˜U“‘òV ²£¯aŒÂ4¶»ðÀ‡mQλ[#@TÃáÛ…Ô#NVlaÉJ­q8U*Àä(¾Ó×Ì1é£}Ñêmèý ?ž•‚7Œ]™÷ï õ+&©”T­G¢³uÚ9Å?"Õýâи2wó<ípàæ3ô[PM8¢ oXÈœ }Üoj³“«CW€ðÊÔG[?Ã()k“z µÎìIlgÀ÷Šø“ÿé!¾§vÝ4ê#Lyåæµ;Œ':{ÇB¥YÖGì'z-dÌhR¢ }>!1ñJhèð­"‹æMÀQÒ¹‹·`ÒÃh‘†Q YÈ3 =¿Á‚¼]•z±òf,‘a»ÂðÄM×}ûVèÓ¶¿¤:,d7ÊþãÁXÊ»’3ßË€»Õ~³º^Ô=ÑO K>)kWXZÊ{b’ùMµF<¦æŸ9UƒIiƒÊ—¯>…úÁ{Y4Ç,;ðõõÏÞ•hàÄeð»c ÷•sš‚Qƒöù?/Šf£ÑЗçdS6£–‹Ë:ß÷§¶—c’Ó-™²N{ĉ ¯U»Ñmñ?G÷YÈ8$¯ÔlAy/GˆÛO¬t­ŽA›“B^ÆäEßôËOXÈùÑË“vCãzÊF•‰H˜X{LQ¶¡äjUyÀ“fèo<Ç…ÁØ­…áÏ€+<ªfR8 S…|*&ß¹ 4í„ R«j¶|i¶·ú¯ô‚¡UÝnúÌ_Ðç’”œe‹Ióç¯N>4 o9¹ÔzŒÚwŠ­Ô?‹£;Î%ƒÈæK’oFÜ…Ÿû1™o¡rã´vʺðFÐxVØ/‡•0pwc‚²?ô¼ šòw´?Nƽ€¿Ê346<…‰:™×ïËA¿þÚgj]­ xwI3@·U4Y¬Ýfö˘*O¯;,I6…MÖûêa¢ëü»²{-¨ \gTœë!•©ßæG>Çä»·ž½³ØeA-_ú¾ø ¼TäÝéNÞ´íFöônhÓùK:ms.g¦„¡ãÞE¡ ÕåßP‚,HÆ]íß }J…{’ï@ÛÙì{Þ•0–잳Γ܄ƙþèÇŠ0ýÎh{4`—µ¯…¡„®‘9•˜LßÐøC8xkoÉvmÇTÏs÷å10•Þýøóà™ Å®ÇÒ[¬ÿÍì» Ãf}áÎÔ]XŠîŸï ýêS¶TÚ^¾ï ½;¤_¨tÍ:£n{,IåûâX&ÀAsÿÔPLZ_¹ÙÌét|-Èë7Ò„ñ{=ôú²P˽eOµôîbê÷Sê¦4ÄÏ1¼Yó#úƒß¥æÏöÀÒžÙO\z_¡öÙ¤{BL‰ÊöL?CEÕ[ÚªÃA´Ùö‹ë“¨{s`µõAÔñ}·‰‚=ª¼U廵E€IÁÌû•ΠÞkôÖï+ÆÔúÅžE‹’±ÌKÚʯw‘X'÷Èd«EH°ïÉÄôîH,m©<Ï%ÊËN а¦!öçì"yiý~PrÅRõ}3Ø)£õUæ¥ÇØÜ€š%Ž»œG]m|ǹ‹Qc:§@é1&Ç*é_HtÇÔcv‡~mŠak…ážÛH0ö íÅhHKMÚ¼7xRÑÊà{5Û09,"iï Tažf³·µLJ žùy-¦½É=ü Ú83z6^GUf¾ã÷d °\ñp`®ë7Ô›"•A£1ïc®Ñ/Kàõ:ø7ôþèÆñT`P¯]UÑ”ŠØßüjŠª1¥ÑÌ{ƒV6ŒÌC:ÃMQ£zÀƒ®8„i}Ï v*Âx݃]ɧÐSxÁ~³c7–¾ ö4ÏØµê˜»;Nfc™þÏmißGçuH)GSÌaé…í Ô»ù½ñíëÎH@ml,q×C¼±µ•ÇP/»vùòz £­1Ös£aÄX;¾tW>&ÏlÙø R¾†æZi‚QkÎïø4‚W®ôƒêžº„nÓÝ‹e'}l~hŸŠ2–X²zÕQ}ìóÚ£a²ÿÉý³÷@Ë»s$EÆTƒ†‡tÿI¦hµö%àUÌÊrZˆšW»¹žž÷›eÛOÜÿI5¡æÉ|L¶¼²éœ¥&[ÿûÝ"œ™fãômLî°€Ï,+ªY'ƒxv‰•õQ‘Å’Ñß7`ò»‹›=Æ=0U×ýºiíTT|nè——Ü7Ó^«¾t¡¾­¶kö\ýŠ¥TãIî#e¨ÜõÓúót1©ìãý'ÞmÀ‡ªHƒ§XÆFåçmËõ Jyï¸o¹2 /™òö—ênÔc@ñ»ÅÇrŠæ;gù}ÃÒÉåcÚc±,…Ï­C}Ó®¾2y±ÆU¬åuç`êÄ^ã?¾¶¨dËÅŇr¿bßjC_Šjܾ¿PÁÆjLû“ JÛï/Ÿmƒš³Ö‰–Qа´CTSxóÑs¼Ð‰©µóJ„IÏ ïUõ²:`ÃX¢fÕÏZ,åê§sÃsUç}(µp;ª£{Ï5ögb2+õ•ÚÅ'˜ªÎ`S„ZwðÕßßϯ`©ø‘M^µS±”Ź+‡`£]A>˜¶ÅêãÝÖÀ¹·ÑMèŽiëB– Å}0äû6!º¡ØÏÏ*N££ÖVàÄÜú‡¥Ø¦ÓOO^…io?¬¤(–bšG‰ؾÛâùµoUtL‡ï¤Ö±°$ôsWלæL2³µ¶¤K|w¸@‹éU§²ñþ¼ë<…Z€ÚþÜ£}ÒóÁÔ¥q{½•æ/uê£ïƪÀ÷Ó¦\m€Öˆ[úNVÏÑ÷/ÿ?zPëSÛÇ~Ÿ°TÐËI˜£Zù'àÑwL‹_Ö‰°ô³5!ãÙg0­DvqÖ¹ ègxÀÙwI‡1O²ì^ë…¥'i}|%hÍÞ¿þÜdw9&.>-œµsÚò[QKüôûå!øa¿ÔÄPá- ؼ͋¹†ŠA{ôæ„Á} ëŠãÒÒN´ o tOrŒk±jC™Áô–ÌK††E‡êçkb¹uz£p1Yó¼ã?ã|T©æÇ¾³ð dÝØ8kÏÇÔáÓ^Ó;0IÆš™üú(jÖì^úE“ýö°5ƒVÏZM›œdhîÙz«ý–>ˆtnkØ5–Ãàø¤Á„âµÐÖð5ǽ Z}³ÌkŽÆƒ0h¦×3M½ºþnx5ÿ[ÒW¹¨S–êŸ ÒèÇdƒ1wnœÜØå;g4 Æ›'7wDe_ô‚Ší0uƒ¹Òä®_о«×:gÕn,e|´|Z¥3Ê;´â%¥¼ÿ˜ÕžÎFå³åÜ/‰¢àK\ylšÅòÙ6ªZNèÏTŸg×w½T^Ùÿ„z§]3î¢Òo]$ÿ³ÐÁn© ÕÙØÞ î\éaêÇñè盡_:AeÝGM«Ž†ÕS1)Óñ¯ŠÔ"h¥Eæ·öE/s°½LT\··åžÝ'}‚þ@F„~±Úz×l†±÷Fò´| ÌRt¨êÓ†aˆ¿f&Õ Bõ=…Ý^ïAðCîkáJcÌ)“ g^ \ZLJ@Ôx2n/k Õ{}g¼OÃT}§oŽÖ˜¤Õ=_—rÕYû‘ìj€×s$¸vd9T†WðUrU0iê/u®”úמZ¶ K]Üd½µû#ŒÛí¸ÚÞU‹)˯ˆãf"Ê +x°Ýö¶Ò×¢¼SÚGèß|Åñyˆ]°½SÜVWY °ì£ ¯à‹NÀ9zÿn†O¡ø}"J¨àœ…¥DÎC×â¿BW Æê#f˜:uà3÷b‡ÿ+]-…Iܨ›é÷‡Pû.²`/C{rV‚æ&ÖŠ¼ q¨Ö“;|ö#&+.Oÿ¦¦‚®ÐHºúæ\à_X§´€£w‘ß!ýû'úÑž­€>fb›ÉÎ÷À[3xO- ºhí36t߃WÖÙ KFáï#©C+# Ñ€ÝÒxø/jŸtu¹ªï8´YÑÔ­‰@]µ½£ë§ñ€›«s"éD 4êÛÎ-¶CäU*¹ÇPs\cÜD“?üø—“òu–?´øžè¾œŠ¡¿£F! ´^ÌÝáš‘ÿ ·~->j¾ý5sj9ý}Û=÷ ýk¦äYžK¢Ê…ÓeïŠ×CMtØÿ¥å(­!öÂö tþr>$à õ<¬¹ñI#µíxíWb(>Ü /;dæ¿Ød95ŸIr½üéôø(~9Ë/‚ï^Ÿ§ô¥A)Ï@?=zoí7¥ª{‰ðCùø6Px—¾Õ/D9¢ø¹¾{ ÷®Ë“6^0ìžÒUÝ åŽî¸à‡)wo.¥WE-^+ü®åt@kG@ñÛ«6XFî~2-~!-c´KÓeû!Møg‡ ª:õ³½ëô ÔIåµoGÃà{¬ÔYPˆ©^ù|k©éÐ3(íÔ~cUc¿êºQ‡¡Ýòç3šjº¸vì†æY+}Žäaé›§3jŽÙ¢6õ]k—|íDìÊr÷Ü^×ÕòÜôsFVälµ9 ‚Ûfã‡Ð>ÿñ@ÿ@*°;Ò,÷ f=f¸»£®<…e†1õ˜2Åq%ëïKTK{v–üʪõ‡7=ï¯AhÃÆ ¢HTÂM˜§®ýü¨43ôÏ~ôkMà©"^T×2?›Ûœw‚ÈH| „f7„£‹ !¯TV÷àƒhÔ|3•]úDÊn|™S_šŒÎ/ÈÛ¢möäçÈè£_JÎ'3êQóF×þ„’&hžj¾ÿ9x$²ñóu"T=+þdINÔYüæ/ãsÞŒ'}AÍmuaÙ囡e™hLÞÇqN¯h‹µD šÃ¢²ûës3ösê‘£¨Ît««u>ztêWä9n6b-fÝg& ný=ï/ÜlBì w"ÜÕ ‘4ÿRfµ%ïX¯à‚ÚµÜXEÙÀ¼¹MÍ% ¹ÄŸ.Àí¨´uëDÿðZÄI¢,¨_5 „)_Ô£g"wf#î»2ÿÆÀM(+)îÊ.ånxb¸zOÏ 1ÝŽ?wøÔ¨ ^.\©y—Ýá…÷F;b0Il¼¹þð®êÒkkâv—Fž}f‰)ƒÊ¿ùC×\»ŠùB}`Ïݳ²4ÂZv&®X#ì~·4·0mEÄÞ¬ÂÓ,äÖŽ¢îà‡{>   oÓ«3mj05ïÌ¢—A`Ôéó5gÃÅ):3OÊMEÝ}=>Ú= ¨cúòðŠ<±.ÃOÒ×8h;‘ï]î>‚åŸ;)YV#AßžþôÞl4ظ”6(>'ó®>!ÍEÂîõäÏPÿ ‹Sö¥“ˆoÕï6FûŽ„o‚FØ1dÄû"¶ÄÖ wi<¹pZ„úçMl¹Zá„xwΨºñƒa‚ᷳ栭™ý 7ÑÀê¹A®ºHx¥.è‚Mê piýÓƒ2Öoµ 5šyûÆÂAw$ÈVón*QÐÓ+×€Û¦á&½­ þê3xqKõVÁ*W„F2•és7^ߪ§êLH^]ð“Ö|óØ CƒÒÖÖ·aÂóÅúʬ hàÐÝ 3y˜ÿ~Êsêß®"«Ùºñåè"*° ëã>÷`Ù¿Ö64å#aÐŽÒ÷Z$p±eUŸI,©¾5rl(³_ïš!ÎU'çMØëÂÐÛª‡û–6‚èýÎÝÇè˜V™rß`j–“š;+äÄfÄ«ðw[zr2ZthS…¸=Ìñ„æ.,¶ñ@gf#–¯{Y3Vª†xzÒEÛÏEíq÷V_˘ µaCî|mà~ÒË^yñoÈš}ÍÀÒ§gÙç)ÁÄí½© AòˆÛbåfkЋÉNüÃÛš…06}bw³K â9 çOIÍAÝ›ßÄv,è…–ŽE&)¿awO“¶õÊÎ_é20K? 5³Hù 㲓ƒñ«7nú‹½,Ô˜²ÞïѱT»]×Lnç=ĉ¨JcÈAÙüÝ2=Þˆ÷þ{Ò*ä ãoíDÏîíA}áQ“b­™XZ7èÊ.5C=­Ò;î‡iQy‚’NXz«Ká¥fÄ£?bVÔ†8rìÅ ŽDýŒ:çZ@{j‘×sçF,5ÓÙ¸šf€Úkí,ïÀðÉOƧÍ*Pïý—¶4f£Dª[©Ïñ2¯=ôIãÛe$x•rŽÓ£óîô.æ¶#ŽÕ@©v‹>ô(™¥iÅ1Ï373 e(ÖH¸”ç`‚اɖS§Æ öE‘·…øOvM{gŽø‹´ ñÙ½¹Uçf@KÙÖØcŒÍ»6d¬KÇ“ý¤Åâý@øÜzÓ+LUÜu_ûÊyÆ-*¯ŠŸ|ó›é˜úðnFÇ¿D¥¼º„™¡‹u>û"ç2êOq£ÑWlC#“sÇ„¶ahX÷ƒüÍ©Åçðí²ß&W¹ïnòÌ„ŒËÇ´·¹»C±¬±bö•Ç0±Nú`äê.+>Ø·MdåzG"K?Áð•s램bRùå!…¥Xê‰Þ;¥²µÛœ ôPz\_•ÛÁU¯£½õºw£ª™ízÖûPIû ¥¤©>hBµzAÉgL^§ÅIÛ÷S8çÏ~PY Ó›8ΧÀù!ºYup/¸Í÷éR»!Žsìè9"4¼Œ6€9ÁPù/E­{Ë£w˳¿Ë£Qe2ÙmL³Šd_£ú)ù¦õ#ˆíþ󼹦ø|¬²ê§ ±o5æo*ÐÁÔLÆKúðyÊuÇÝ¡'#â;Ö?ï~œÅQÁÒû¼÷[lî@ÆKùðɘªÅ ¿ý‚” è¨sÊPìE½ È]Uõ¤P%àémƒé—ÂúóÇ`Ì`ñ#áŒTÔ•.8­¹­S~®P=õ µ§Ç9%¿´DÕs'Ù}†©ù¿¬L>×C…7°ƒ€¼+`þˆ*<Ø$—öIM¬™£uP;ŒwFX*¯·»“®™PÑÈŒÊßZ“X¨Gøj‰o²!âÍe§/Tƒ®i±×-}+`°ÐùïáÞò‹÷™kŽ„^åæNغ7¾¤Seê|W䢜ÃE‹ì——Áð—•.¹qí¨±öòõÖ4(½<µø"L„<¾?oW3tQj¶NWÂR˃v$‰Âç·U|ue Õ2Ƶ`¢`†G¾CC#iÛÖÂízó©iW±ôÇ7k¸h Ð|fXÑaP|5oá*]8Ú÷íò‚ñ9Y˜ÁYczu»ºç‘9tô‡#›»íP*˺)û÷Ö-4âÁõÉÐ ÆÔðãeÒ¹¤öâŠ^ñ›ˆè¦’ÆþF*¦nÙóÆÆ+e¤+JAP"O’S²‡¦ÎWŽé'0Åb’AŽe«NC¬òY‰o3R;ýÄ ÿ÷ù†DŠÿ¤%LdÅ&Û|‰ËªÿµSþ?ÛÿÖ[:2Yt³ ˆlÈ ²±„½1±ÞˆnJd† ‘™D6•dc3ˆzLè &Ú›˜Ú§0‰ld@dSºí ™&DfK0±^|C‚ˆÌ$êcŸgõ1 ˆú˜Äñ¥KÌE7$²‘›ÆnDœoº‘„?#âxí%ô˜Ù”NìŸ)“ø¼)q¾†„ö† C"³ˆ,1ž †ƒÈÄù`0ˆz b|2˜Äød0MˆÏ³$žg™™? #¢½8¢‰L—°gý³Œ$˜èÏDb¼LˆóÏ0‘ÐgÊ$Ö›šJ2ASb½0 ‰Ì ècÒ‰óÅ‘‰ñÍ™Ø&‹IôÏ"ÎÓˆ¸¾™FÄñ`Iø—ˆg1ýõKä¦1‹AdâzbšHø75’`‰þ›ÆGœ~ˆLÔÃ2 K0S‚ýgY²Þ˜Ed¢º„‰üÆ¢3‰þéÄýA¼\ˆþtBÿYL:Ñ?“˜Y, {1ß°XúÅwˆldBdâ~Å22!ê725`âøJăxùý™HôÇ„b–¨—Ðg*áÏÔP‚‰ùŽeJÌW,S¢~#“ÈÄýËȀؾ8]Ù” ßHbýJ01?þgÃ'² ôÿÏ!Òÿ½O^ÿ¿‚åÿ «þW°ú_Áúñeâ?¿ÿÿë+*À"seriation/data/Townships.rda0000644000176200001440000000045212606356654015664 0ustar liggesusers‹µ’ÑJÃ0†Oº]ØŠ:Ý ä|ƒéÔ©sCd·! k Í)iKÙ[øÄb =°•j§h Í×?_s4ëéæ:ÚD@0d <ÿ`£Ð¯á+V6Ot–{çÌïðý`_p—Ç ß?ö¼Ÿø]u}g­ì7ýÿEý¾ÑöúzëÊþéÿ\°A¬S¿ÔW«ŽG~†-åÄ+V¤Ê_Aïy lBpCpK0%¸#¸'x ˜<<<Ì ^K‚Õ^Oõ<émÂs™ š&ºšl–¥)J' —ˆov.ÖB›Jìx^ˆB£¥xiwˆéá9Ñ›*”ÓV¸\ QèèKTÂ[›ÊõMŠž)zʉC·Eiìí£ö}‰².ñXZýpÊcN^ƒRóHŠJy£è™“W¯Ü3ßß(E”ŸšÊµ'EÏÜçQ”}Çúkîž[r]ôÍc*9@e}±¯¸øŒ‰“ïÜœªkì*±ž8<]2W.M±=ªÊõWjJµ%E¯^©ý/Š~‡Üsbûƒ%Žm¹qª$CÔµ·Ûµ¿Ý·­¯¥þrþRe»òàZ¼ÅÄm™Ã:U[Crš’¸øôŠÝ—¨{Ú¾%×Gn¾Q²¯˜rshj¹Mu9¥Ô\’ª¨åk—¸´«å18&N}—ƒÇ n^Ã9µ¦AI\úkG¯ürñtóÚÿziâ²Gä•Û? ¨ØúrjŽA¥.8´kS±µ(ÊuÐå—’o.ãrSœÆç¦¸ú­Z/*½ïî4þ]B<¹cÓ*rçŠß»“‹ïÏåæç²þzµ  Á2«¬ÏA½xD´@$)D‘Ad-­!Á`H0$ †C‚!Á`(0 †C¡ÀP`(0 †Cƒ¡ÁÐ`h04 †ÀaÀ0`0  †ìÏÉ´¹%Ó-™þ#™~" †ÂaÁ°`X0, †cé_þøIqztFseriation/data/Psych24.rda0000644000176200001440000000376512606356654015134 0ustar liggesusers‹í˜ùkœUÇÇXµÖ¶¤­hߢ¾î âˆ""Ç­J]¢‘ZDÄÉÌÓdJf&>3SkÝyPq_Q)*nÔšØ4I—$³%“dÚšXk)êûêë¾â½7çsÍ;ô‡÷p`–ç¹÷¹÷œïùžï9w®¾pùé³–ÏŠD" ‘†}÷1oósFƒùØ'i<Ð|М½%Þ~ú™fÆ\ó>_¾Ž¸—T®;ìµ™§ c›»îžŸ~L¶ûÎEÏlî–Ê}Mßµÿq2Üù\uÖy7I9·nå?×dXnûêÁö¬T¶Ÿºè©õ7ˇož2wÙŒHÙ>Öu·T>dfÞ)Ÿ,í}é?O¾)]ºÏàªþ·ÏYÞ(ãf‘£ »¤÷Þ“f_úTï¿ò“s×Iñâ7^3y‰T¯?ñû¸^ªOº…e<ý¨!;–Ͱ+KÉö”;äÞ“¥¬×ÿ”‚Ú5j¬}ôþfÙôëîŽûšñ<oìÆ¹6`y©¶„kò<³¨,zZ*[ík@Þ_ÞØzy鿲΅ý$éQ\yní®ÿëìˤË|.í}Y*6 ?IŸ3™ìãß¼*Ývø¥¯e¼•/£öZïˆèñ'àÝø±Óºûð]ò™…í™-ò©òw·ù0–IYÇGÜv+e‹âÀuQã1àÂu¸·{óSÎ~µslµ½±Äó{Û9 ²Ôløž«Êø¤Kïü†'à†Ýø±{‘ÛP&4o?·Ñn˜íã9¢|Oí(OÄóœKjwQíÜhó´Ïc'~Ú¬o½Bjš5Õ ô„|ÜZ§7àÝ>ަ ²KqºÍ9ìó¬ÏÉÊ 2r°#’ ºôm—^GŸ3o– hÞ÷(Î[·mŠ:6¦üÓýjš'è ö“—ðž€7vãǤ΃eÍã"û©ü×Hï ÷’Ò7¯ØˆyÝ!?‹ÊÿZ‹3Pªà qž°ò´zXF5.è7:¨zâó~ÃðÆnüØèsƒçù:Å‘ë‚êy7è`¹ÑÛKp½MyPÔ}vìqD“ Å¡¦vQwT¿½¢'ä%ü†'àÝø±Cíút*dü0'èž7”·©%/úMþöë€õ|AÏ Z?&”×ÔË uú¢ä%üö<Ñõ±?j Gh™TýQÞ ª_ðÚó^iÝÛä–»@Æ4ä)ù=®õu¨—Ýuþ¢ƒè y ¿á xc7~LØí^ùÍ×]p]¯}DQë':nÄyD×íWýÁOúúê<õýt=!/Áž€7vãùÕ­ö•ýä¡ö èå æ[8k<ЗÍú*ú_çµ^bú¢'ä%üðÆnü¨¾áðñvB”’M΀Ëf½_Výésé·¿ ©~“÷ð‰~ýèO¨óÔKx‡è zB^ÂoxÞØíûDÕ7â9¬õ«ß®~Ç/¾¿#ßàSAãJ_˜Oüêûê%uýô„|òüVžø|S»½ÆcW•œÓüyGñ§ÿ¦¥¤¯¢?¡Îgêù†¢'à¿á xc7~pnÜîÒ #‡ªêçKÎiäµ?|!¯ëê&ý ñ¤^RwÐot°þˆßð¼±Ûë®â ~ðŽy¬ëÏiÊÎ ôßô±ìG_E½F—©—ÔôÛ÷Oª'ä%ü†'àݾžÓ'Óo)ÎàÁù’þÞpngúXúAx@žÇÔKtýFÑx¿á xc·ï¯8éÿèŽï3UÏ9§qÞáÜécéÑyêŠ×‹?«¿è ¸ø¼T¾Á“Ñ:»Õº¿‡öM$SækNÄþƒ‰,œzÿÏ”™fJ:– ²æ÷רsíø¼eÉl>Öí ÂxЙKfÒ:°_S¾Õ=e/›cfBtE&LE[3±0Á¤%±6&-¸8H¡Y+™¶cÓ;´9ÆÚÂXg{4žIu†A{Îþ5¼ %Hç‚t #include /* compute the length of an order, i.e. the sum of * the edge weights along the path defined by the * order. * * note that the order is a tour with the leg between * the first and the last city omitted. * * ceeboo 2005 */ static double orderLength(double *x, int *o, int n) { double v, z; R_xlen_t i, j, k; z = 0; /* path length */ i = o[0]; for (k = 0; k < n-1; k++) { j = o[k+1]; if (i > j) v = x[i+j*(n-1)-j*(j+1)/2-1]; else if (i == j) return NA_REAL; else v = x[j+i*(n-1)-i*(i+1)/2-1]; if (!R_FINITE(v)) return NA_REAL; z += v; i = j; } return z; } /* R wrapper */ SEXP order_length(SEXP R_dist, SEXP R_order) { R_xlen_t n, k; int *o; SEXP R_obj; n = LENGTH(R_order); if (LENGTH(R_dist) != n * (n - 1) / 2) error("order_length: length of \"dist\" and \"order\" do not match"); o = R_Calloc(n, int); for (k = 0; k < n; k++) /* offset to C indexing */ o[k] = INTEGER(R_order)[k]-1; PROTECT(R_obj = NEW_NUMERIC(1)); REAL(R_obj)[0] = orderLength(REAL(R_dist), o, n); R_Free(o); UNPROTECT(1); return R_obj; } /* check validity of a merge tree representation */ int checkRmerge(int *x, int n) { R_xlen_t k; int v; if (x[0] > 0 || x[n-1] > 0) /* initial merge */ return 0; for (k = 0; k < 2*(n-1); k++) { v = x[k]; if (v < -n || v > n-1) return 0; if (v > 0 && v > k+1) return 0; } return 1; } /* Z. Bar-Joseph, E. D. Demaine, D. K. Gifford, and T. Jaakkola. * (2001) Fast Optimal Leaf Ordering for Hierarchical Clustering. * Bioinformatics, Vol. 17 Suppl. 1, pp. 22-29. * * this implementation builds on the improvements of a more recent paper * available at the website of Bar-Joseph! * * as input we exepct a matrix with the distances in the lower triangle, * a merge tree, i.e. two arrays holding n-1 indexes of the left and right * subtrees (or leaves) merged at the kth step (for details see dist and * hclust). * * returns a list with a matrix (merge) and two vectors (order and length). * * The algorithm has the following stages: * * 1) find a leaf ordering consistent with the supplied merge tree. * the order of the leaves of a tree consists of the order of the * leaves in the left subtree followed by the order of the leaves * in the right subtree. * * note that the tree (leaf) indexes must have an offset of one because * the leaves are coded as negative numbers. subtrees are referenced by * their position in the merge sequence (see hclust). this sucks! * * we compute for each left and right subtree the offset of the leftmost * leaf in the total order of leaves, and the number of leaves in both * trees, i.e. in the parent tree. * * 2) recursively compute for each pair of outer endpoints, i.e. a left * endpoint from the left subtree and a right endpoint from the right * subtree the length of the optimal ordering of the leaves. * * the temporary tables are stored in the lower triangle as well as the * similarities. the lengths of the best linear orderings are stored in * the upper triangle. * * for the improved computations at the root the diagonal is used as * storage for temporary results. * * the time complexity of finding all the partial optimal leaf orderings * is O(n^3). * * the suggested improvement based on early termination of the search is * currently not implemented. however, ties are broken randomly. * * 3) recursively find the total optimal leaf ordering. * * 4) find the merge tree corresponding to the optimal ordering. * * fixme: using similarities would allow a remapping of non-finite * values to zero and thus sanitizing of overflows. also for * missing values this would be a more user friendly approach. * * (C) ceeboo 2005 */ static int calcAllOrder(double *x, int *e, int *oi, int *ok, int *oj, int ci, int ck, int cj, int n) { R_xlen_t i, ii, j, jj, k, kk, h = 0, l; double s, z; for (i = 0; i < ci; i++) { ii = oi[i]; for (j = 0; j < cj; j++) { jj = oj[j]; l = 0; z = R_PosInf; for (k = 0; k < ck; k++) { kk = ok[k]; if (ii > kk) s = x[kk+ii*n]; else s = x[ii+kk*n]; if (kk > jj) s += x[kk+jj*n]; else s += x[jj+kk*n]; if (s < z) { z = s; h = kk; l = 1; } else if (s == z) { if (unif_rand() > (double) l/(l+1)) h = kk; l++; } } if (!R_FINITE(z)) return 0; /* error */ if (ii > jj) x[jj+ii*n] = z; else x[ii+jj*n] = z; e[ii+jj*n] = h; } } return 1; } static int calcEndOrder(double *x, int *e, int *oi, int *ok, int ci, int ck, int n) { R_xlen_t i, ii, k, kk, h = 0, l; double s, z; for (i = 0; i < ci; i++) { ii = oi[i]; l = 0; z = R_PosInf; for (k = 0; k < ck; k++) { kk = ok[k]; if (ii > kk) s = x[kk+ii*n]; else s = x[ii+kk*n]; if (s < z) { z = s; h = kk; l = 1; } else if (s == z) { if (unif_rand() > (double) l/(l+1)) h = kk; l++; } } if (!R_FINITE(z)) return 0; x[ii+ii*n] = z; e[ii+ii*n] = h; } return 1; } static int debug = FALSE; SEXP order_optimal(SEXP R_dist, SEXP R_merge) { R_xlen_t n, i, ii, j, jj, k, kk, h, a = 0, b = 0; int cl = 0, cll = 0, clr = 0, cr = 0, crl = 0, crr = 0; int *l, *r, *c, *e; int *left, *right, *o, *ol = 0, *oll = 0, *olr = 0, *or = 0, *orl = 0, *orr = 0; double s, z, zz; double *x; SEXP R_obj; n = 1 + (int) sqrt(2 * LENGTH(R_dist)); if (LENGTH(R_dist) < 3 || LENGTH(R_dist) != n*(n-1)/2) error("order_optimal: invalid length"); if (LENGTH(GET_DIM(R_merge)) != 2) error("order_optimal: \"merge\" invalid"); if (INTEGER(GET_DIM(R_merge))[0] != n-1) error("order_optimal: \"dist\" and \"merge\" do not conform"); if (!checkRmerge(INTEGER(R_merge), n)) error("order_optimal: \"merge\" invalid"); /* copy similarities into lower triangle */ x = R_Calloc(n*n, double); /* data + part order lengths + temporary */ k = 0; for (i = 0; i < n-1; i++) for (j = i+1; j < n; j++) { z = REAL(R_dist)[k++]; if (!R_FINITE(z)) { R_Free(x); error("order_optimal: \"dist\" invalid"); } else x[j+i*n] = z; } PROTECT(R_obj = NEW_LIST(3)); /* result list */ SET_ELEMENT(R_obj, 0, duplicate(R_merge)); /* merge */ SET_ELEMENT(R_obj, 1, NEW_INTEGER(n)); /* order */ SET_ELEMENT(R_obj, 2, NEW_NUMERIC(1)); /* length */ left = INTEGER(VECTOR_ELT(R_obj, 0)); right = INTEGER(VECTOR_ELT(R_obj, 0))+n-1; o = INTEGER(VECTOR_ELT(R_obj, 1)); GetRNGstate(); l = R_Calloc(n, int); /* offset of leftmost leaf of left tree */ r = R_Calloc(n, int); /* offset of leftmost leaf of right tree; * reverse mapping of order */ c = R_Calloc(n-1, int); /* number of leaves in a tree */ e = R_Calloc(n*n, int); /* inner endpoints */ /* for each tree count the number of leaves. */ for (k = 0; k < n-1; k++) { if (left[k] > 0) c[k] += c[left[k]-1]; else c[k] = 1; if (right[k] > 0) c[k] += c[right[k]-1]; else c[k] += 1; } /* backpropagate the counts to obtain the current * leaf order and the offset of the leftmost leaf * of the left and right subtree. */ for (k = n-2; k >= 0; k--) { if (left[k] > 0) { h = l[k] + c[left[k]-1]; if (right[k] > 0) l[right[k]-1] = h; else o[h] = -right[k]-1; l[left[k]-1] = l[k]; } else { h = l[k] + 1; if (right[k] > 0) l[right[k]-1] = h; else o[h] = -right[k]-1; o[l[k]] = -left[k]-1; } r[k] = h; } /* determine for each subtree the optimal order * for each pair of left and right endpoints * (leaves). this is done in the order provided * by the merge tree. */ for (k = 0; k < n-1; k++) { ol = o + l[k]; /* order of left subtree */ or = o + r[k]; /* order of right subtree */ cl = r[k] - l[k]; /* number of leaves in left subtree */ cr = c[k] - cl; /* number of leaves in right subtree */ if (cl > 1) { /* a left tree */ h = left[k]-1; oll = o + l[h]; olr = o + r[h]; cll = r[h] - l[h]; clr = c[h] - cll; } else { /* a left leaf */ oll = olr = ol; cll = clr = cl; } if (cr > 1) { /* a right tree */ h = right[k]-1; orl = o + l[h]; orr = o + r[h]; crl = r[h] - l[h]; crr = c[h] - crl; } else { /* a right leaf */ orl = orr = or; crl = crr = cr; } if (k == n-2) /* optimized search at the root */ break; /* compute temporary sums for all endpoints */ if (!calcAllOrder(x, e, oll, olr, or, cll, clr, cr, n)) { R_Free(x); R_Free(r); R_Free(l); R_Free(c); R_Free(e); error("order_optimal: non-finite values"); } if (olr != oll) if (!calcAllOrder(x, e, olr, oll, or, clr, cll, cr, n)) { R_Free(x); R_Free(r); R_Free(l); R_Free(c); R_Free(e); error("order_optimal: non-finite values"); } /* copy temporary sums to lower triangle */ for (i = 0; i < cl; i++) { ii = ol[i]; for (j = 0; j < cr; j++) { jj = or[j]; if (ii > jj) x[ii+jj*n] = x[jj+ii*n]; else x[jj+ii*n] = x[ii+jj*n]; } } /* compute best orders for all endpoints */ if (!calcAllOrder(x, e, orl, orr, ol, crl, crr, cl, n)) { R_Free(x); R_Free(r); R_Free(l); R_Free(c); R_Free(e); error("order_optimal: non-finite values"); } if (orr != orl) if (!calcAllOrder(x, e, orr, orl, ol, crr, crl, cl, n)) { R_Free(x); R_Free(r); R_Free(l); R_Free(c); R_Free(e); error("order_optimal: non-finite values"); } /* now that we know both endpoints we can store * the inner endpoint from the left tree at the * correct addresse. */ for (i = 0; i < cr; i++) { ii = or[i]; for (j = 0; j < cl; j++) { jj = ol[j]; kk = e[ii+jj*n]; if (ii > jj) x[ii+jj*n] = (double) e[jj+kk*n]; else x[jj+ii*n] = (double) e[jj+kk*n]; } } /* copy back */ for (i = 0; i < cl; i++) { ii = ol[i]; for (j = 0; j < cr; j++) { jj = or[j]; if (ii > jj) e[ii+jj*n] = (int) x[ii+jj*n]; else e[ii+jj*n] = (int) x[jj+ii*n]; } } } /* find the best linear order for each endpoint * of the left and right subtree of the root */ if (!calcEndOrder(x, e, oll, olr, cll, clr, n)) { R_Free(x); R_Free(r); R_Free(l); R_Free(c); R_Free(e); error("order_optimal: non-finite values"); } if (olr != oll) if (!calcEndOrder(x, e, olr, oll, clr, cll, n)) { R_Free(x); R_Free(r); R_Free(l); R_Free(c); R_Free(e); error("order_optimal: non-finite values"); } if (!calcEndOrder(x, e, orl, orr, crl, crr, n)) { R_Free(x); R_Free(r); R_Free(l); R_Free(c); R_Free(e); error("order_optimal: non-finite values"); } if (orr != orl) if (!calcEndOrder(x, e, orr, orl, crr, crl, n)) { R_Free(x); R_Free(r); R_Free(l); R_Free(c); R_Free(e); error("order_optimal: non-finite values"); } /* find the best linear order at the root */ k = 0; z = R_PosInf; for (i = 0; i < cl; i++) { ii = ol[i]; zz = x[ii+ii*n]; for (j = 0; j < cr; j++) { jj = or[j]; s = zz + x[jj+jj*n]; if (ii > jj) s += x[ii+jj*n]; else s += x[jj+ii*n]; if (s < z) { z = s; a = ii; b = jj; k = 1; } else if (s == z) { if (unif_rand() > (double) k/(k+1)) { a = ii; b = jj; } k++; } } if (!R_FINITE(z)) { R_Free(x); R_Free(r); R_Free(l); R_Free(c); R_Free(e); error("order_optimal: non-finite values"); } } REAL(VECTOR_ELT(R_obj, 2))[0] = z; /* set length */ /* the order can be found by double recursion. * for this we use a stack, one for the left * and one for the right endpoints. */ l[0] = b; /* push endpoints of right tree on the stack*/ r[0] = e[b+b*n]; i = e[a+a*n]; /* start with endpoints of left tree */ j = a; h = 0; k = 1; while (h < n) { if (i == j) { /* backtrack */ o[h++] = i; k--; if (k < 0) break; i = l[k]; /* pop endpoints */ j = r[k]; } else { l[k] = e[j+i*n]; /* push endpoints of right tree on the stack */ r[k] = j; k++; j = e[i+j*n]; /* recurse left tree */ } } /* adjust the merge tree to the optimal order * * 1) for each pair of leaves from a left and right * subtree the order relation is the same. thus, * use the leftmost leaves as representatives. * * 2) if the order is reversed we must swap the * subtrees at the parent. */ for (k = 0; k < n; k++) /* reverse mapping of optimal order */ r[o[k]] = k; for (k = 0; k < n-1; k++) { if (left[k] > 0) /* left leaf in left subtree */ i = l[left[k]-1]; else i = -left[k]-1; if (right[k] > 0) /* left leaf in right subtree */ j = l[right[k]-1]; else j = -right[k]-1; if (r[i] > r[j]) { /* swap the subtrees */ h = right[k]; right[k] = left[k]; left[k] = h; } l[k] = i; /* left leaf in parent tree */ } for (k = 0; k < n; k++) /* offset to R indexing */ o[k]++; if (debug) { i = e[a+a*n]; j = e[b+b*n]; if (i > j) x[j+i*n] = z; else x[i+j*n] = z; for (k = 0; k < n-1; k++) { if (left[k] > 0) l[k] = l[left[k]-1]; else l[k] = -left[k]-1; if (right[k] > 0) r[k] = r[right[k]-1]; else r[k] = -right[k]-1; i = l[k]; j = r[k]; if (i > j) z = x[j+i*n]; else z = x[i+j*n]; // left and right are int // k, i and j are R_xlen_t which is typedefed to ptrdiff_t so we cast to int Rprintf(" %3i | %4i %4i | %3i %3i | %f\n", (int) k+1, left[k], right[k], (int) i+1, (int) j+1, z); } } R_Free(x); R_Free(l); R_Free(r); R_Free(c); R_Free(e); PutRNGstate(); UNPROTECT(1); return R_obj; } /**/ seriation/src/criterion.c0000644000176200001440000002264414706524257015224 0ustar liggesusers/* * seriation - Infrastructure for seriation * Copyright (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * any later version. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License along * with this program; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */ #include #include #include #include #include #include "lt.h" /* * path length can be found in optimal.c */ /* * least-squares criterion */ SEXP least_squares_criterion(SEXP R_dist, SEXP R_order) { double sum = 0.0; int p = INTEGER(getAttrib(R_dist, install("Size")))[0]; int *o = INTEGER(R_order); double *dist = REAL(R_dist); double x = 0.0; SEXP R_out; /* since d is symmetric we only need to sum up half the matrix */ for (int i = 1; i <= p; i++) { for (int j = 1; j < i; j++) { x = (dist[LT_POS(p, o[i-1], o[j-1])] - abs(i-j)); sum += x*x; } } sum *= 2.0; PROTECT(R_out = allocVector(REALSXP, 1)); REAL(R_out)[0] = sum; UNPROTECT(1); return(R_out); } /* * inertia criterion */ SEXP inertia_criterion(SEXP R_dist, SEXP R_order) { double sum = 0.0; int p = INTEGER(getAttrib(R_dist, install("Size")))[0]; int *o = INTEGER(R_order); double *dist = REAL(R_dist); int x = 0; SEXP R_out; /* since d ist symmetric we only need to sum up half the matrix */ for (int i = 1; i <= p; i++) { for (int j = 1; j < i; j++) { x = abs(i-j); sum += dist[LT_POS(p, o[i-1], o[j-1])] * x*x; } } sum *= 2.0; PROTECT(R_out = allocVector(REALSXP, 1)); REAL(R_out)[0] = sum; UNPROTECT(1); return(R_out); } /* * Anti-Robinson Events */ SEXP ar(SEXP R_dist, SEXP R_order, SEXP R_which) { /* * which indicates the weighing scheme * 1 ... no weighting (i) * 2 ... abs. deviations (s) * 3 ... weighted abs. deviations (w) */ int p = INTEGER(getAttrib(R_dist, install("Size")))[0]; int *o = INTEGER(R_order); double *dist = REAL(R_dist); int which = INTEGER(R_which)[0]; double sum = 0.0; double d_ij = 0.0; double d_ik = 0.0; SEXP R_out; /* sum_i=1^p sum_j d_ik) * weight */ for (int i = 1; i < (p-1); i++) { for(int j = i+1; j < p; j++) { d_ij = dist[LT_POS(p, o[i-1], o[j-1])]; for(int k = j+1; k <= p; k++) { d_ik = dist[LT_POS(p, o[i-1], o[k-1])]; if(d_ij > d_ik) { if(which == 1) { sum++; }else if(which == 2) { sum += fabs(d_ij - d_ik); }else if(which == 3) sum += abs(o[j-1]-o[k-1]) * fabs(d_ij - d_ik); } } } } PROTECT(R_out = allocVector(REALSXP, 1)); REAL(R_out)[0] = sum; UNPROTECT(1); return(R_out); } /* * Relative Generalized Anti-Robinson Events */ SEXP rgar(SEXP R_dist, SEXP R_order, SEXP R_w, SEXP R_relative) { int n = INTEGER(getAttrib(R_dist, install("Size")))[0]; int *o = INTEGER(R_order); int relative = INTEGER(R_relative)[0]; double *dist = REAL(R_dist); /* w is in [2, n-1] (window size) */ int w = INTEGER(R_w)[0]; double d_ij = 0.0; double d_ik = 0.0; int ar = 0; /* AR events */ int total = 0; /* total number of possible AR events */ int i, j, k; SEXP R_out; /* sum_i=1^n sum_{(i-w)<=j d_ik) * weight */ for (i = 1; i <= (n-2); i++) { /* Rprintf("i2=%d\n", i); */ for(j = i+1; j <= MIN(i+w-1, n-1); j++) { /* Rprintf("j2=%d\n", j); */ d_ij = dist[LT_POS(n, o[i-1], o[j-1])]; for(k = j+1; k <= MIN(i+w, n); k++) { /* Rprintf("k2=%d\n\n", k); */ d_ik = dist[LT_POS(n, o[i-1], o[k-1])]; total++; if(d_ij > d_ik) ar++; } } } /* Note: total = (2/3-n)*w + n*w^2 - 2/3*w^3 */ PROTECT(R_out = allocVector(REALSXP, 1)); if(relative) REAL(R_out)[0] = (double) ar / (double) total; else REAL(R_out)[0] = (double) ar; UNPROTECT(1); return(R_out); } /* * Gradient Measure */ SEXP gradient(SEXP R_dist, SEXP R_order, SEXP R_which) { /* * which indicates the weighing scheme * 1 ... no weighting * 2 ... weighted */ int p = INTEGER(getAttrib(R_dist, install("Size")))[0]; int *o = INTEGER(R_order); double *dist = REAL(R_dist); int which = INTEGER(R_which)[0]; double sum = 0.0; double d_ij = 0.0; double d_ik = 0.0; double d_kj = 0.0; double diff; SEXP R_out; int i, k, j; /* sum_i 1) { /* weighted */ sum += diff; }else{ /* unweighted */ if(diff > 0) sum += 1.0; else if(diff < 0) sum -= 1.0; } /* second sum */ d_kj = dist[LT_POS(p, o[k-1], o[j-1])]; /* diff = d_kj - d_ij; seems to be wrong in the book*/ diff = d_ij - d_kj; if(which > 1) { /* weighted */ sum += diff; }else{ /* unweighted */ if(diff > 0) sum += 1.0; else if(diff < 0) sum -= 1.0; } } } } PROTECT(R_out = allocVector(REALSXP, 1)); REAL(R_out)[0] = sum; UNPROTECT(1); return(R_out); } /* * Lazy Path length (see Earle and Hurley 2015) */ SEXP lazy_path_length(SEXP R_dist, SEXP R_order) { double tour_length = 0.0; SEXP R_tour_length; double segment; bool posinf = false; bool neginf = false; int *order = INTEGER(R_order); int n = INTEGER(getAttrib(R_dist, install("Size")))[0]; double *dist = REAL(R_dist); if (n != LENGTH(R_order)) error("length of distance matrix and tour do not match"); for (int i = 1; i <= n-1; i++) { segment = dist[LT_POS(n, order[i-1], order[i])]; // check Inf if (segment == R_PosInf) posinf = true; else if (segment == R_NegInf) neginf = true; else tour_length += (n-i) * segment; } // do not close tour! // inf if (posinf && neginf) tour_length = NA_REAL; else if (posinf) tour_length = R_PosInf; else if (neginf) tour_length = R_NegInf; // create R object PROTECT(R_tour_length = NEW_NUMERIC(1)); REAL(R_tour_length)[0] = tour_length; UNPROTECT(1); return R_tour_length; } /* * Banded Anti-Robinson Form (see Earle and Hurley, 2015) */ SEXP bar(SEXP R_dist, SEXP R_order, SEXP R_b) { int n = INTEGER(getAttrib(R_dist, install("Size")))[0]; int *o = INTEGER(R_order); double *dist = REAL(R_dist); /* 1 <= b < n */ int b = INTEGER(R_b)[0]; double ar = 0; int i, j; SEXP R_out; /* sum_{|i-j|<=b} (b+1-|i-j|) d_{ij} */ for (i = 1; i <= n-1; i++) { for (j = i+1; j <= MIN(i+b, n); j++) { ar += (b+1-abs(i-j)) * dist[LT_POS(n, o[i-1], o[j-1])]; } } // create R object PROTECT(R_out = NEW_NUMERIC(1)); REAL(R_out)[0] = ar; UNPROTECT(1); return R_out; } /* * Measure of effectiveness ME (McCormick et al, 1972) */ SEXP measure_of_effectiveness(SEXP R_mat, SEXP R_order_row, SEXP R_order_col) { int *o_row = INTEGER(R_order_row); int *o_col = INTEGER(R_order_col); double *x = REAL(R_mat); int nrow = INTEGER(getAttrib(R_mat, install("dim")))[0]; int ncol = INTEGER(getAttrib(R_mat, install("dim")))[1]; SEXP R_out; double m = 0; double s; int i, j, ii, jj; if (nrow != LENGTH(R_order_row) || ncol!= LENGTH(R_order_col)) error("dimenstions of matrix and order do not match!"); for (i = 0; i < nrow; ++i) { for (j = 0; j < ncol; ++j) { ii = o_row[i] - 1; jj = o_col[j] - 1; s = 0; if(i > 0) s += x[M_POS(nrow, o_row[i - 1] - 1, jj)]; if(i < (nrow - 1)) s += x[M_POS(nrow, o_row[i + 1] - 1, jj)]; if(j > 0) s += x[M_POS(nrow, ii, o_col[j - 1] - 1)]; if(j < (ncol - 1)) s += x[M_POS(nrow, ii, o_col[j + 1] - 1)]; m += x[M_POS(nrow, ii, jj)] * s; } } m = .5 * m; // create R object PROTECT(R_out = NEW_NUMERIC(1)); REAL(R_out)[0] = m; UNPROTECT(1); return R_out; } seriation/src/pathdist.c0000644000176200001440000000274714706524257015050 0ustar liggesusers/* * seriation - Infrastructure for seriation * Copyright (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * any later version. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License along * with this program; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */ #include #include #include "lt.h" /* Calculate the path distance for iVAT */ /* Note this changes A! */ /* FIXME: INF and NA */ SEXP pathdist_floyd(SEXP R_x) { int *dimX = INTEGER( GET_DIM(R_x) ); R_xlen_t i, j, k, n = dimX[0]; SEXP R_y; double *x = REAL(R_x); double *y; PROTECT(R_y = allocMatrix(REALSXP, dimX[0], dimX[1])); y = REAL(R_y); /* initialize y with paths of length 1 */ for(i=0; i #include /* compute the stress measure based on Moor Neighborhoods, i.e. the * sums of the squared distances of a point to its eight (five at the * margins and three at the corners) adjacent neighbors as defined by * the row and column indexes (or subsets of it). * * this function counts each edge distance only once! so, if you * prefer the measure from the paper you have to take twice the * value. * * note that NAs are omitted. however, the function does not return * NA if there was no legal edge at all. */ double stressMoore(double *x, int *r, int *c, int nr, int nc, int nrx) { double d, v, z; R_xlen_t i, j, l, ll, k, kk; z = 0; l = r[0]; for (i = 0; i < nr - 1; i++) { ll = r[i + 1]; k = c[0] * nrx; for (j = 0; j < nc - 1; j++) { kk = c[j + 1] * nrx; v = x[l + k]; if (!ISNAN(v)) { d = v - x[ll + k]; if (!ISNAN(d)) z += d * d; d = v - x[ll + kk]; if (!ISNAN(d)) z += d * d; d = v - x[l + kk]; if (!ISNAN(d)) z += d * d; } d = x[ll + k] - x[l + kk]; k = kk; if (!ISNAN(d)) z += d * d; } d = x[l + k] - x[ll + k]; l = ll; if (!ISNAN(d)) z += d * d; R_CheckUserInterrupt(); } k = c[0] * nrx; for (j = 0; j < nc - 1; j++) { kk = c[j + 1] * nrx; d = x[l + k] - x[l + kk]; k = kk; if (!ISNAN(d)) z += d * d; } return z; } /* same as above but use a von Neumann neighborhood, i.e. the * neighboring points on the diagonals are excluded. */ double stressNeumann(double *x, int *r, int *c, int nr, int nc, int nrx) { double d, v, z; R_xlen_t i, j, l, ll, k, kk; z = 0; l = r[0]; for (i = 0; i < nr - 1; i++) { ll = r[i + 1]; k = c[0] * nrx; for (j = 0; j < nc - 1; j++) { kk = c[j + 1] * nrx; v = x[l + k]; if (!ISNAN(v)) { d = v - x[ll + k]; if (!ISNAN(d)) z += d * d; d = v - x[l + kk]; if (!ISNAN(d)) z += d * d; } k = kk; } d = x[l + k] - x[ll + k]; l = ll; if (!ISNAN(d)) z += d * d; R_CheckUserInterrupt(); } k = c[0] * nrx; for (j = 0; j < nc - 1; j++) { kk = c[j + 1] * nrx; d = x[l + k] - x[l + kk]; k = kk; if (!ISNAN(d)) z += d * d; } return z; } /* R wrapper to the stress functions */ SEXP stress(SEXP R_x, SEXP R_r, SEXP R_c, SEXP R_type) { int nrx, nr, nc; R_xlen_t k; int *r, *c; SEXP R_obj; /* Translation form character to int index not needed * R part makes sure it is int! PROTECT(R_r = arraySubscript(0, R_r, GET_DIM(R_x), getAttrib, (STRING_ELT), R_x)); PROTECT(R_c = arraySubscript(1, R_c, GET_DIM(R_x), getAttrib, (STRING_ELT), R_x)); */ nrx = INTEGER(GET_DIM(R_x))[0]; /* number of rows */ nr = LENGTH(R_r); nc = LENGTH(R_c); /* remap R indexes to C indexes * this sucks! */ r = R_Calloc(nr, int); c = R_Calloc(nc, int); /* copy and shift indexes */ for (k = 0; k < nr; k++) r[k] = INTEGER(R_r)[k] - 1; for (k = 0; k < nc; k++) c[k] = INTEGER(R_c)[k] - 1; PROTECT(R_obj = NEW_NUMERIC(1)); switch (INTEGER(R_type)[0]) { case 1: REAL(R_obj) [0] = stressMoore(REAL(R_x), r, c, nr, nc, nrx); break; case 2: REAL(R_obj) [0] = stressNeumann(REAL(R_x), r, c, nr, nc, nrx); break; default: R_Free(r); R_Free(c); error("stress: type not implemented"); } R_Free(r); R_Free(c); /* UNPROTECT(3); */ UNPROTECT(1); return R_obj; } /* NOTE: currently unused */ /* calculate the Moore distances between all pairs of rows or columns. * of a matrix. for a given (fixed) row or column ordering the distances * could be used to search for an optimal column or row ordering using * an alternating scheme. * * if the calculation are over the rows ncx = 1, otherwise the roles * of rows and columns are swapped and nrx = 1. * * the caller must provide the result array d and the temporary array t. * * the distances are arranged in lower triangular column format (compare * the R function dist). * * note that the edge distances are computed only once! * * (C) ceeboo 2005, 2006 */ void distMoore(double *x, int *r, int *c, int nr, int nc, int nrx, int ncx, double *d, double *t) { double v, w, z; R_xlen_t i, ii, j, jj, k, kk, kkk, l; for (k = 0; k < nr * (nr - 1) / 2; k++) /* initialize distances */ d[k] = 0; for (i = 0; i < nr; i++) { z = 0; ii = r[i] * ncx; kk = c[0] * nrx; for (k = 0; k < nc - 1; k++) { kkk = c[k + 1] * nrx; w = x[ii + kk] - x[ii + kkk]; if (!ISNAN(w)) z += w * w; kk = kkk; } t[i] = z; R_CheckUserInterrupt(); } l = 0; for (i = 0; i < nr - 1; i++) { ii = r[i] * ncx; for (j = i + 1; j < nr; j++) { z = t[i] + t[j]; jj = r[j] * ncx; kk = c[0] * nrx; for (k = 0; k < nc - 1; k++) { kkk = c[k + 1] * nrx; v = x[ii + kk]; if (!ISNAN(v)) { w = v - x[jj + kk]; if (!ISNAN(w)) z += w * w; w = v - x[jj + kkk]; if (!ISNAN(w)) z += w * w; } w = x[jj + kk] - x[ii + kkk]; if (!ISNAN(w)) z += w * w; kk = kkk; } w = x[ii + kk] - x[jj + kk]; if (!ISNAN(w)) z += w * w; d[l++] = z; R_CheckUserInterrupt(); } } } /* calculate the von Neumann distances over the rows or columns of a * matrix. * * compare above. */ void distNeumann(double *x, int *r, int *c, int nr, int nc, int nrx, int ncx, double *d, double *t) { double w, z; R_xlen_t i, ii, j, jj, k, kk, kkk, l; for (k = 0; k < nr * (nr - 1) / 2; k++) /* initialize distances */ d[k] = 0; for (i = 0; i < nr; i++) { z = 0; ii = r[i] * ncx; kk = c[0] * nrx; for (k = 0; k < nc - 1; k++) { kkk = c[k + 1] * nrx; w = x[ii + kk] - x[ii + kkk]; if (!ISNAN(w)) z += w * w; kk = kkk; } t[i] = z; R_CheckUserInterrupt(); } l = 0; for (i = 0; i < nr - 1; i++) { ii = r[i] * ncx; for (j = i + 1; j < nr; j++) { z = t[i] + t[j]; jj = r[j] * ncx; for (k = 0; k < nc - 1; k++) { kk = c[k] * nrx; w = x[ii + kk] - x[jj + kk]; if (!ISNAN(w)) z += w * w; } kk = c[k] * nrx; w = x[ii + kk] - x[jj + kk]; if (!ISNAN(w)) z += w * w; d[l++] = z; R_CheckUserInterrupt(); } } } /* R wrapper */ SEXP stress_dist(SEXP R_x, SEXP R_r, SEXP R_c, SEXP R_bycol, SEXP R_type) { int nrx, nr, nc; R_xlen_t k; int *r, *c; double *d, *t; SEXP R_obj = R_NilValue; /* compiler hack */ /* Translation form character to int index not needed * R part makes sure it is int! PROTECT(R_r = arraySubscript(0, R_r, GET_DIM(R_x), getAttrib, (STRING_ELT), R_x)); PROTECT(R_c = arraySubscript(1, R_c, GET_DIM(R_x), getAttrib, (STRING_ELT), R_x)); */ nrx = INTEGER(GET_DIM(R_x))[0]; /* number of rows */ nr = LENGTH(R_r); nc = LENGTH(R_c); /* remap R indexes to C indexes * this sucks! */ r = R_Calloc(nr, int); c = R_Calloc(nc, int); /* copy and shift indexes */ for (k = 0; k < nr; k++) r[k] = INTEGER(R_r)[k] - 1; for (k = 0; k < nc; k++) c[k] = INTEGER(R_c)[k] - 1; switch (LOGICAL(R_bycol)[0]) { case 0: PROTECT(R_obj = NEW_NUMERIC(nr * (nr - 1) / 2)); d = REAL(R_obj); t = R_Calloc(nr, double); switch (INTEGER(R_type)[0]) { case 1: distMoore(REAL(R_x), r, c, nr, nc, nrx, 1, d, t); break; case 2: distNeumann(REAL(R_x), r, c, nr, nc, nrx, 1, d, t); break; default: R_Free(r); R_Free(c); R_Free(t); error("stress_dist: \"type\" not implemented"); } R_Free(t); break; case 1: PROTECT(R_obj = NEW_NUMERIC(nc * (nc - 1) / 2)); d = REAL(R_obj); t = R_Calloc(nc, double); switch (INTEGER(R_type)[0]) { case 1: distMoore(REAL(R_x), c, r, nc, nr, 1, nrx, d, t); break; case 2: distNeumann(REAL(R_x), c, r, nc, nr, 1, nrx, d, t); break; default: R_Free(r); R_Free(c); R_Free(t); error("stress_dist: type not implemented"); } R_Free(t); break; default: R_Free(r); R_Free(c); error("stress_dist: \"bycol\" invalid"); } R_Free(r); R_Free(c); /* UNPROTECT(3); */ UNPROTECT(1); return R_obj; } seriation/src/RNG_wrapper.c0000644000176200001440000000052012606356654015402 0ustar liggesusers/* FORTRAN Wrapper for R RNG */ #include void F77_SUB(getrngstate)(void) { GetRNGstate(); } void F77_SUB(putrngstate)(void) { PutRNGstate(); } /* Note: R's unif_rand returns 0<=x<=1 while FORTRAN's RAND returns 0<=x<1 */ void F77_SUB(unifrand)(float* x) { do{ *x = (float) unif_rand(); }while(*x >= 1.0 || *x <0.0); } seriation/src/lt.h0000644000176200001440000000131214706524257013637 0ustar liggesusers/* LT_POS to access a lower triangle matrix by C. Buchta * modified by M. Hahsler * n ... number of rows/columns * i,j ... column and row index (starts with 1) */ /* R_xlen_t is for long vector support */ #ifndef LT_POS #define LT_POS(n, i, j) \ (i)==(j) ? 0 : (i)<(j) ? (R_xlen_t)(n) * ((i) - 1) - (R_xlen_t)(i)*((i)-1)/2 + (j)-(i) -1 \ : (R_xlen_t)(n)*((j)-1) - (R_xlen_t)(j)*((j)-1)/2 + (i)-(j) -1 #endif /* M_POS to access matrix column-major order by i and j index (starts with 1) * n is the number of rows */ #ifndef M_POS #define M_POS(n, i, j) ((i)+(R_xlen_t)(n)*(j)) #endif /* * MIN/MAX */ #define MIN(X,Y) ((X) < (Y) ? (X) : (Y)) #define MAX(X,Y) ((X) > (Y) ? (X) : (Y)) seriation/src/init.c0000644000176200001440000000516314706524257014166 0ustar liggesusers#include #include #include // for NULL #include /* .Call calls */ extern SEXP ar(SEXP, SEXP, SEXP); extern SEXP bar(SEXP, SEXP, SEXP); extern SEXP gradient(SEXP, SEXP, SEXP); extern SEXP inertia_criterion(SEXP, SEXP); extern SEXP lazy_path_length(SEXP, SEXP); extern SEXP least_squares_criterion(SEXP, SEXP); extern SEXP measure_of_effectiveness(SEXP, SEXP, SEXP); extern SEXP order_length(SEXP, SEXP); extern SEXP order_optimal(SEXP, SEXP); extern SEXP pathdist_floyd(SEXP); extern SEXP reorder_dist(SEXP, SEXP); extern SEXP rgar(SEXP, SEXP, SEXP, SEXP); extern SEXP stress(SEXP, SEXP, SEXP, SEXP); extern void isMon(void *, void *, void *, void *); extern void permNext(void *, void *); /* .Fortran calls */ extern void F77_NAME(arsa)(void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *); extern void F77_NAME(bburcg)(void *, void *, void *, void *, void *, void *, void *, void *, void *, void *); extern void F77_NAME(bbwrcg)(void *, void *, void *, void *, void *, void *, void *, void *, void *, void *); static const R_CallMethodDef CallEntries[] = { {"ar", (DL_FUNC) &ar, 3}, {"bar", (DL_FUNC) &bar, 3}, {"gradient", (DL_FUNC) &gradient, 3}, {"inertia_criterion", (DL_FUNC) &inertia_criterion, 2}, {"lazy_path_length", (DL_FUNC) &lazy_path_length, 2}, {"least_squares_criterion", (DL_FUNC) &least_squares_criterion, 2}, {"measure_of_effectiveness",(DL_FUNC) &measure_of_effectiveness,3}, {"order_length", (DL_FUNC) &order_length, 2}, {"order_optimal", (DL_FUNC) &order_optimal, 2}, {"pathdist_floyd", (DL_FUNC) &pathdist_floyd, 1}, {"reorder_dist", (DL_FUNC) &reorder_dist, 2}, {"rgar", (DL_FUNC) &rgar, 4}, {"stress", (DL_FUNC) &stress, 4}, {NULL, NULL, 0} }; static const R_CMethodDef CEntries[] = { {"isMon", (DL_FUNC) &isMon, 4}, {"permNext", (DL_FUNC) &permNext, 2}, {NULL, NULL, 0} }; static const R_FortranMethodDef FortranEntries[] = { {"arsa", (DL_FUNC) &F77_NAME(arsa), 15}, {"bburcg", (DL_FUNC) &F77_NAME(bburcg), 10}, {"bbwrcg", (DL_FUNC) &F77_NAME(bbwrcg), 10}, {NULL, NULL, 0} }; void R_init_seriation(DllInfo *dll) { R_registerRoutines(dll, CEntries, CallEntries, FortranEntries, NULL); R_useDynamicSymbols(dll, FALSE); } seriation/src/bburcg.f0000644000176200001440000002702414706524257014472 0ustar liggesusersC ANTI-ROBINSON SERIATION C branch-and-bound C by Brusco, M. and Stahl, S. C R Interface by Michael Hahsler C PROGRAM DYNAMIC C SUBROUTINE dynamic(N, A, EPS, X) SUBROUTINE bburcg(N, A, EPS, X, Q, D, DD, S, UNSEL, IVERB) IMPLICIT INTEGER(A-Z) C DOUBLE PRECISION TIMEA,TIMEB,TIMTOT,A(50,50),EPS DOUBLE PRECISION A(N,N), EPS REAL S1 INTEGER X(N),Q(N),D(N,N,N),S(N),DD(N,N,N),UNSEL(N) C Initialize R RNG CALL getrngstate() OLDM=0 CHECKS=0 C C ################################################################# C 10/13/01 This program fits an "unweighted" row gradient criterion C to a symmetric proximity matrix. Count +1 if the anti- C Robinson triple is satisfied, -1 if its not, and 0 for C ties. Only look at upper half of matrix C 07/20/02: Improved symmetry test implemented. C 07/26/03: Fixed the incorrect symmetry test, added an interchange test C avoid use of so many "IF" statements using F & D matrices C 12/24/03: Add insertion test to interchange test. C 07/09/15: Fixed memory issue (MFH) C ################################################################# C C OPEN(1,FILE='AMAT.DAT') ! Dissimilarity matrix C OPEN(2,FILE='SEQ.OUT') ! Output file C EPS = 1.0d-07 C READ(1,*) N ! Read number of objects C WRITE(*,*) 'TYPE 1 FOR HALF MATRIX OR TYPE 2 FOR FULL MATRIX' C READ(*,*) ITYPE C ITYPE = 2 C IF(ITYPE.EQ.2) THEN C READ(1,*) ((A(I,J),J=1,N),I=1,N) C ELSE C DO J = 2,N C READ(1,*) (A(I,J),I=1,J-1) C END DO C DO J = 2,N C DO I = 1,J-1 C A(J,I) = A(I,J) C END DO C END DO C END IF C CALL GETTIM (IHR, IMIN, ISEC, I100) C CALL GETDAT (IYR, IMON, IDAY) C TIMEA=DBLE(86400*IDAY+3600*IHR+60*IMIN+ISEC)+DBLE(I100)/100. DO I = 1,N A(I,I) = 0.0D0 END DO C DO 848 I = 1,N DO 849 J = 1,N IF(I.EQ.J) GO TO 849 DO 850 K = 1,N IF(I.EQ.K.OR.J.EQ.K) GO TO 850 IF(A(I,K).GT.A(I,J)+EPS) D(I,J,K)=1 IF(A(I,K).LT.A(I,J)-EPS) D(I,J,K)=-1 C for bburcg IF(A(I,K).GT.A(J,K)+EPS) D(I,J,K)=D(I,J,K)+1 IF(A(I,K).LT.A(J,K)-EPS) D(I,J,K)=D(I,J,K)-1 C 850 CONTINUE 849 CONTINUE 848 CONTINUE C DO 851 I = 1,N DO 852 J = 1,N IF(I.EQ.J) GO TO 852 DO 853 K = 1,N IF(I.EQ.K.OR.J.EQ.K) GO TO 853 ACT=D(I,J,K) IF(D(I,K,J).GT.ACT) ACT = D(I,K,J) IF(D(J,I,K).GT.ACT) ACT = D(J,I,K) DD(I,J,K) = ACT 853 CONTINUE 852 CONTINUE 851 CONTINUE C ZBEST = 0 DO 3500 JJJ = 1,20 DO I = 1,N UNSEL(I) = I Q(I) = 0 END DO NNSEL = N C 3501 CALL RANDOM(S1) C 3501 S1 = rand() 3501 CALL unifrand(S1) ISEL = INT(1. + S1*FLOAT(NNSEL)) IF(ISEL.GT.NNSEL) ISEL = NNSEL Q(NNSEL) = UNSEL(ISEL) DO J = ISEL,NNSEL-1 UNSEL(J) = UNSEL(J+1) END DO NNSEL = NNSEL - 1 IF(NNSEL.GT.0) GO TO 3501 C WRITE(*,72) (Q(J),J=1,N) C 72 FORMAT(20I3) Z = 0 DO I = 1,N-2 R1 = Q(I) DO J = I+1,N-1 R2 = Q(J) DO K = J+1,N R3 = Q(K) Z = Z + D(R1,R2,R3) END DO END DO END DO 3502 ITRIG = 0 DO II = 1,N-1 DO JJ = II+1,N C R interrupt CALL rchkusr() C R3 = Q(JJ) R2 = Q(II) DELTA=0 DO I = 1,II-1 R1 = Q(I) DELTA = DELTA + D(R1,R3,R2) - D(R1,R2,R3) DO J = II+1,JJ-1 R4 = Q(J) DELTA = DELTA + D(R1,R3,R4) - D(R1,R2,R4) DELTA = DELTA + D(R1,R4,R2) - D(R1,R4,R3) END DO END DO DO J = II+1,JJ-1 R4 = Q(J) DELTA = DELTA + D(R3,R4,R2) - D(R2,R4,R3) DO K = JJ+1,N R5 = Q(K) DELTA = DELTA + D(R4,R2,R5) - D(R4,R3,R5) DELTA = DELTA + D(R3,R4,R5) - D(R2,R4,R5) END DO END DO DO K = JJ + 1,N R5 = Q(K) DELTA = DELTA + D(R3,R2,R5) - D(R2,R3,R5) END DO DO I = II+1,JJ-2 DO J = I+1,JJ-1 R4A = Q(I) R4B = Q(J) DELTA = DELTA + D(R4A,R4B,R2) - D(R4A,R4B,R3) DELTA = DELTA + D(R3,R4A,R4B) - D(R2,R4A,R4B) END DO END DO IF(DELTA.GT.0) THEN Z = Z + DELTA Q(II) = R3 Q(JJ) = R2 ITRIG = 1 END IF END DO END DO IF(ITRIG.EQ.1) GO TO 3502 IF(Z.GT.ZBEST) ZBEST = Z 3500 CONTINUE C WRITE(2,3505) ZBEST IF (IVERB == 1) THEN C WRITE(*,3505) ZBEST CALL dblepr('HEURISTIC OBJ VALUE', -1, DBLE(ZBEST), 1) ENDIF C 3505 FORMAT(' HEURISTIC OBJ VALUE ',I12) Z = ZBEST-1 DO I = 1,N Q(I) = 0 END DO C M=1 Q(M)=1 S(1)=1 trig=1 DO K = 2,N Q(K)=0 END DO C 1 M = M + 1 C C CHECKS=CHECKS+1 IF (IVERB == 1 .AND. M .GT. OLDM) THEN C WRITE (*,6000) M+1, CHECKS CALL intpr('reached position', -1, M+1, 1) CALL intpr('with following number checks', -1, CHECKS, 1) C 6000 FORMAT(' reached position ', I5, ' with ', I9, ' checks') OLDM=M ENDIF C C R interrupt CALL rchkusr() C C main loop C 2 Q(M)=Q(M)+1 C C MFH: Make sure to not get out of bounds with S(Q(M)) - 9/24/12 IF(Q(M).GT.N) GO TO 222 IF(S(Q(M)).EQ.1) GO TO 2 ! REDUNDANCY 222 IF(M.EQ.1.AND.Q(M).GT.N) GO TO 9 ! TERMINATE IF(M.GT.1.AND.Q(M).GT.N) GO TO 7 ! GO TO RETRACTION C only for bburcg IF(TRIG.EQ.0.AND.Q(M).EQ.2) GO TO 2 ! SYMMETRY FATHOM C S(Q(M))=1 IF(M.EQ.1) GO TO 1 IF(M.EQ.N-1) THEN CALL EVALBBURCG(ZBD,Q,N,D) IF(ZBD.GT.Z) THEN Z=ZBD IF (IVERB == 1) THEN C WRITE(*,*) 'Eval =',z CALL dblepr('Eval', -1, DBLE(Z), 1) ENDIF DO I = 1,N X(I)=Q(I) END DO END IF Q(N)=0 S(Q(M))=0 GO TO 2 ELSE DO 251 MM = M-1,1,-1 ! Insertion Test R3=Q(M) IDX1=0 IDX2=0 DO I = 1,MM-1 R1=Q(I) DO J = MM,M-1 R4=Q(J) IDX1=IDX1+D(R1,R4,R3) IDX2=IDX2+D(R1,R3,R4) C END DO C END DO C DO 250 I = 1,N IF(S(I).EQ.1) GO TO 250 R5=I C DO J = MM,M-1 R4=Q(J) IDX1=IDX1+D(R4,R3,R5) IDX2=IDX2+D(R3,R4,R5) END DO C 250 CONTINUE C DO J = MM, M-2 DO JJ = J+1, M-1 R4A=Q(J) R4B=Q(JJ) IDX1=IDX1+D(R4A,R4B,R3) IDX2=IDX2+D(R3,R4A,R4B) END DO END DO IF(IDX1.LT.IDX2) THEN S(Q(M))=0 C ism2 = ism2 + 1 GO TO 2 END IF 251 CONTINUE C go to 253 C DO 151 MM = M-2,1,-1 ! Interchange Test R3=Q(M) R2=Q(MM) IDX1=0 IDX2=0 DO J = MM+1,M-1 R4 = Q(J) IDX1=IDX1+D(R2,R4,R3) IDX2=IDX2+D(R3,R4,R2) END DO DO I = 1,MM-1 R1=Q(I) IDX1=IDX1+D(R1,R2,R3) IDX2=IDX2+D(R1,R3,R2) DO J = MM+1,M-1 R4=Q(J) IDX1=IDX1+D(R1,R2,R4) IDX2=IDX2+D(R1,R3,R4) C IDX1=IDX1+D(R1,R4,R3) IDX2=IDX2+D(R1,R4,R2) C END DO C END DO C DO 150 I = 1,N IF(S(I).EQ.1) GO TO 150 R5=I IDX1=IDX1+D(R2,R3,R5) IDX2=IDX2+D(R3,R2,R5) C DO J = MM+1,M-1 R4=Q(J) IDX1=IDX1+D(R2,R4,R5) IDX2=IDX2+D(R3,R4,R5) C IDX1=IDX1+D(R4,R3,R5) IDX2=IDX2+D(R4,R2,R5) END DO C 150 CONTINUE C DO J = MM+1, M-2 DO JJ = J+1, M-1 R4A=Q(J) R4B=Q(JJ) IDX1=IDX1+D(R4A,R4B,R3) IDX2=IDX2+D(R4A,R4B,R2) IDX1=IDX1+D(R2,R4A,R4B) IDX2=IDX2+D(R3,R4A,R4B) END DO END DO IF(IDX1.LT.IDX2) THEN C ism = ism + 1 S(Q(M))=0 GO TO 2 END IF 151 CONTINUE C CALL BOUND2BBURCG(ZBD,N,Q,M,D,S,DD) IF(ZBD.LE.Z) THEN S(Q(M))=0 C ism3 = ism3 + 1 GO TO 2 END IF IF(Q(M).EQ.1) TRIG=1 GO TO 1 END IF C 7 IF(Q(M).EQ.1) TRIG=0 C MFH: Make sure to not get out of bounds with S(Q(M)) - 6/9/15 IF(Q(M).GT.N) GO TO 777 S(Q(M))=0 777 Q(M)=0 M=M-1 IF(Q(M).EQ.1) TRIG=0 S(Q(M))=0 C C WRITE(*,*) 'X',(X(J),J=1,N) C WRITE(*,*) 'Q',(Q(J),J=1,N) C GO TO 2 9 IF (IVERB == 1) THEN C PRINT *, 'total number of checks: ', CHECKS CALL intpr('total number of checks', -1, CHECKS, 1) ENDIF C Return R RNG CALL Putrngstate() RETURN END C SUBROUTINE BOUND2BBURCG(ZBD,N,Q,M,D,S,DD) IMPLICIT INTEGER(A-Z) INTEGER Q(N),D(N,N,N),S(N),DD(N,N,N) Z1=0 DO I = 1,M-2 R1=Q(I) DO J = I+1,M-1 R2=Q(J) DO K = J+1,M R3=Q(K) Z1=Z1+D(R1,R2,R3) END DO END DO END DO C Z2=0 DO I = 1,M-1 R1=Q(I) DO J = I+1,M R2=Q(J) DO 60 K = 1,N IF(S(K).EQ.1) GO TO 60 R3=K Z2=Z2+D(R1,R2,R3) 60 CONTINUE END DO END DO C Z3=0 DO 90 I = 1,N-1 IF(S(I).EQ.1) GO TO 90 R2=I DO 91 J = I+1,N IF(S(J).EQ.1) GO TO 91 R3=J ZA=0 ZB=0 DO 92 K = 1,M R1=Q(K) ZA=ZA+D(R1,R2,R3) ZB=ZB+D(R1,R3,R2) 92 CONTINUE ZCT=ZA IF(ZB.GT.ZCT) ZCT=ZB Z3=Z3+ZCT 91 CONTINUE 90 CONTINUE C N4=0 DO 93 I = 1,N-2 IF(S(I).EQ.1) GO TO 93 R1=I DO 94 J = I+1,N-1 IF(S(J).EQ.1) GO TO 94 DO 95 K = J+1,N IF(S(K).EQ.1) GO TO 95 C ACT=D(I,J,K) C IF(D(I,K,J).GT.ACT) ACT=D(I,K,J) C IF(D(J,I,K).GT.ACT) ACT=D(J,I,K) C N4=N4+ACT N4 = N4 + DD(I,J,K) 95 CONTINUE 94 CONTINUE 93 CONTINUE C N1=N*(N-1)*(N-2)/3 ! This bound is OK! The N1 is total C N2=M*(M-1)*(M-2)/3 ! and N2 and N3 are truly computed terms. C N3=(N-M)*(M*(M-1)) ! So N1-N2-N3 assumes +1 for rest, which ZBD=Z1+Z2+Z3+n4 ! (N-M)*(N-M-1)*(N-M-2)/3 +n4 C WRITE(*,98) N,M,N1,N2,N3,Z1,Z2,N1-N2-N3,ZBD C 98 FORMAT(9I7) RETURN END C SUBROUTINE EVALBBURCG(ZBD,Q,N,D) IMPLICIT INTEGER(A-Z) INTEGER Q(N),D(N,N,N) ZBD=0 DO 85 I = 1,N DO J = 1,N-1 IF(Q(J).EQ.I) GO TO 85 END DO Q(N)=I 85 CONTINUE DO I = 1,N-2 R1=Q(I) DO J = I+1,N-1 R2=Q(J) DO K = J+1,N R3=Q(K) ZBD=ZBD+D(R1,R2,R3) END DO END DO END DO RETURN END seriation/src/bbwrcg.f0000644000176200001440000003043414706524257014473 0ustar liggesusersC ANTI-ROBINSON SERIATION C branch-and-bound C by Brusco, and Stahl, S. C R Interface by Michael Hahsler C PROGRAM DYNAMIC C SUBROUTINE dynamic(N, A, EPS, X) SUBROUTINE bbwrcg(N, A, EPS, X, Q, D, DD, S, UNSEL, IVERB) IMPLICIT INTEGER(A-Z) C DOUBLE PRECISION TIMEA,TIMEB,TIMTOT,A(50,50),EPS DOUBLE PRECISION EPS, A(N,N), D(N,N,N), 1 DD(N,N,N),ZBEST,Z,ACT,DELTA,ZBD,IDX1,IDX2 REAL S1 INTEGER X(N),Q(N),S(N),UNSEL(N) C EPS is unused this is to supress the warning. EPS = 1.0d-07 C Initialize R RNG CALL getrngstate() OLDM=0 CHECKS=0 C C ################################################################# C 10/13/01 This program fits an "weighted" row gradient criterion C to a symmetric proximity matrix. Count +1 if the anti- C Robinson triple is satisfied, -1 if its not, and 0 for C ties. Only look at upper half of matrix C 07/20/02: Improved symmetry test implemented. C 07/26/03: Fixed the incorrect symmetry test, added an interchange test C avoid use of so many "IF" statements using F & D matrices C 12/24/03: Add insertion test to interchange test. C 07/09/15: Fixed memory issue (MFH) C ################################################################# C C OPEN(1,FILE='AMAT.DAT') ! Dissimilarity matrix C OPEN(2,FILE='SEQ.OUT') ! Output file C EPS = 1.0d-07 C READ(1,*) N ! Read number of objects C WRITE(*,*) 'TYPE 1 FOR HALF MATRIX OR TYPE 2 FOR FULL MATRIX' C READ(*,*) ITYPE C ITYPE = 2 C IF(ITYPE.EQ.2) THEN C READ(1,*) ((A(I,J),J=1,N),I=1,N) C ELSE C DO J = 2,N C READ(1,*) (A(I,J),I=1,J-1) C END DO C DO J = 2,N C DO I = 1,J-1 C A(J,I) = A(I,J) C END DO C END DO C END IF C CALL GETTIM (IHR, IMIN, ISEC, I100) C CALL GETDAT (IYR, IMON, IDAY) C TIMEA=DFLOAT(86400*IDAY+3600*IHR+60*IMIN+ISEC)+DFLOAT(I100)/100. DO I = 1,N A(I,I) = 0.0D0 END DO C DO 848 I = 1,N DO 849 J = 1,N IF(I.EQ.J) GO TO 849 DO 850 K = 1,N IF(I.EQ.K.OR.J.EQ.K) GO TO 850 C bbwrg C D(I,J,K) = A(I,K) - A(I,J) D(I,J,K) = 2.*A(I,K) - A(I,J) - A(J,K) 850 CONTINUE 849 CONTINUE 848 CONTINUE C DO 851 I = 1,N DO 852 J = 1,N IF(I.EQ.J) GO TO 852 DO 853 K = 1,N IF(I.EQ.K.OR.J.EQ.K) GO TO 853 ACT=D(I,J,K) IF(D(I,K,J).GT.ACT) ACT = D(I,K,J) IF(D(J,I,K).GT.ACT) ACT = D(J,I,K) DD(I,J,K) = ACT 853 CONTINUE 852 CONTINUE 851 CONTINUE C Run heuristic to find a good objective value IF (IVERB == 1) THEN CALL intpr('Run heuristic', -1, IVERB, 0) ENDIF ZBEST = 0.0D0 C DO 3500 JJJ = 1,100 DO 3500 JJJ = 1,100 DO I = 1,N UNSEL(I) = I Q(I) = 0 END DO NNSEL = N C 3501 CALL RANDOM(S1) C 3501 S1 = rand() 3501 CALL unifrand(S1) ISEL = INT(1. + S1*FLOAT(NNSEL)) IF(ISEL.GT.NNSEL) ISEL = NNSEL Q(NNSEL) = UNSEL(ISEL) DO J = ISEL,NNSEL-1 UNSEL(J) = UNSEL(J+1) END DO NNSEL = NNSEL - 1 IF(NNSEL.GT.0) GO TO 3501 C WRITE(*,72) (Q(J),J=1,N) C 72 FORMAT(20I3) Z = 0.0D0 DO I = 1,N-2 R1 = Q(I) DO J = I+1,N-1 R2 = Q(J) DO K = J+1,N R3 = Q(K) Z = Z + D(R1,R2,R3) END DO END DO END DO 3502 ITRIG = 0 DO II = 1,N-1 DO JJ = II+1,N C R interrupt CALL rchkusr() C R3 = Q(JJ) R2 = Q(II) DELTA=0.0D0 DO I = 1,II-1 R1 = Q(I) DELTA = DELTA + D(R1,R3,R2) - D(R1,R2,R3) DO J = II+1,JJ-1 R4 = Q(J) DELTA = DELTA + D(R1,R3,R4) - D(R1,R2,R4) DELTA = DELTA + D(R1,R4,R2) - D(R1,R4,R3) END DO END DO DO J = II+1,JJ-1 R4 = Q(J) DELTA = DELTA + D(R3,R4,R2) - D(R2,R4,R3) DO K = JJ+1,N R5 = Q(K) DELTA = DELTA + D(R4,R2,R5) - D(R4,R3,R5) DELTA = DELTA + D(R3,R4,R5) - D(R2,R4,R5) END DO END DO DO K = JJ + 1,N R5 = Q(K) DELTA = DELTA + D(R3,R2,R5) - D(R2,R3,R5) END DO DO I = II+1,JJ-2 DO J = I+1,JJ-1 R4A = Q(I) R4B = Q(J) DELTA = DELTA + D(R4A,R4B,R2) - D(R4A,R4B,R3) DELTA = DELTA + D(R3,R4A,R4B) - D(R2,R4A,R4B) END DO END DO IF(DELTA.GT.0) THEN Z = Z + DELTA Q(II) = R3 Q(JJ) = R2 ITRIG = 1 END IF END DO END DO IF(ITRIG.EQ.1) GO TO 3502 IF(Z.GT.ZBEST) ZBEST = Z 3500 CONTINUE C WRITE(2,3505) ZBEST IF (IVERB == 1) THEN C WRITE(*,3505) ZBEST CALL dblepr('HEURISTIC OBJ VALUE', -1, DBLE(ZBEST), 1) ENDIF C 3505 FORMAT(' HEURISTIC OBJ VALUE ',F20.4) Z = ZBEST-1 DO I = 1,N Q(I) = 0 END DO C M=1 Q(M)=1 S(1)=1 trig=1 DO K = 2,N Q(K)=0 END DO C 1 M = M + 1 C C CHECKS=CHECKS+1 IF (IVERB == 1 .AND. M .GT. OLDM) THEN C WRITE (*,6000) M+1, CHECKS CALL intpr('reached position', -1, M+1, 1) CALL intpr('with following number of checks', -1, CHECKS, 1) C 6000 FORMAT('reached position ', I5, ' with ', I9, ' checks') OLDM=M ENDIF C C R interrupt CALL rchkusr() C C main loop C 2 Q(M)=Q(M)+1 C C MFH: Make sure to not get out of bounds with S(Q(M)) - 7/9/15 IF(Q(M).GT.N) GO TO 222 IF(S(Q(M)).EQ.1) GO TO 2 ! REDUNDANCY 222 IF(M.EQ.1.AND.Q(M).GT.N) GO TO 9 ! TERMINATE IF(M.GT.1.AND.Q(M).GT.N) GO TO 7 ! GO TO RETRACTION C only for bbwrcg IF(TRIG.EQ.0.AND.Q(M).EQ.2) GO TO 2 ! SYMMETRY FATHOM C S(Q(M))=1 IF(M.EQ.1) GO TO 1 IF(M.EQ.N-1) THEN CALL EVALBBWRCG(ZBD,Q,N,D) IF(ZBD.GT.Z) THEN Z=ZBD IF (IVERB == 1) THEN C WRITE(*,*) 'Eval =',z CALL dblepr('Eval', -1, DBLE(z), 1) ENDIF DO I = 1,N X(I)=Q(I) END DO END IF Q(N)=0 S(Q(M))=0 GO TO 2 ELSE DO 251 MM = M-1,1,-1 ! Insertion Test R3=Q(M) IDX1=0 IDX2=0 DO I = 1,MM-1 R1=Q(I) DO J = MM,M-1 R4=Q(J) IDX1=IDX1+D(R1,R4,R3) IDX2=IDX2+D(R1,R3,R4) C END DO C END DO C DO 250 I = 1,N IF(S(I).EQ.1) GO TO 250 R5=I C DO J = MM,M-1 R4=Q(J) IDX1=IDX1+D(R4,R3,R5) IDX2=IDX2+D(R3,R4,R5) END DO C 250 CONTINUE C DO J = MM, M-2 DO JJ = J+1, M-1 R4A=Q(J) R4B=Q(JJ) IDX1=IDX1+D(R4A,R4B,R3) IDX2=IDX2+D(R3,R4A,R4B) END DO END DO IF(IDX1.LT.IDX2) THEN S(Q(M))=0 C ism2 = ism2 + 1 GO TO 2 END IF 251 CONTINUE C go to 253 C DO 151 MM = M-2,1,-1 ! Interchange Test R3=Q(M) R2=Q(MM) IDX1=0 IDX2=0 DO J = MM+1,M-1 R4 = Q(J) IDX1=IDX1+D(R2,R4,R3) IDX2=IDX2+D(R3,R4,R2) END DO DO I = 1,MM-1 R1=Q(I) IDX1=IDX1+D(R1,R2,R3) IDX2=IDX2+D(R1,R3,R2) DO J = MM+1,M-1 R4=Q(J) IDX1=IDX1+D(R1,R2,R4) IDX2=IDX2+D(R1,R3,R4) C IDX1=IDX1+D(R1,R4,R3) IDX2=IDX2+D(R1,R4,R2) C END DO C END DO C DO 150 I = 1,N IF(S(I).EQ.1) GO TO 150 R5=I IDX1=IDX1+D(R2,R3,R5) IDX2=IDX2+D(R3,R2,R5) C DO J = MM+1,M-1 R4=Q(J) IDX1=IDX1+D(R2,R4,R5) IDX2=IDX2+D(R3,R4,R5) C IDX1=IDX1+D(R4,R3,R5) IDX2=IDX2+D(R4,R2,R5) END DO C 150 CONTINUE C DO J = MM+1, M-2 DO JJ = J+1, M-1 R4A=Q(J) R4B=Q(JJ) IDX1=IDX1+D(R4A,R4B,R3) IDX2=IDX2+D(R4A,R4B,R2) IDX1=IDX1+D(R2,R4A,R4B) IDX2=IDX2+D(R3,R4A,R4B) END DO END DO IF(IDX1.LT.IDX2) THEN C ism = ism + 1 S(Q(M))=0 GO TO 2 END IF 151 CONTINUE C CALL BOUND2BBWRCG(ZBD,N,Q,M,D,S,DD) IF(ZBD.LE.Z) THEN S(Q(M))=0 C ism3 = ism3 + 1 GO TO 2 END IF IF(Q(M).EQ.1) TRIG=1 GO TO 1 END IF C 7 IF(Q(M).EQ.1) TRIG=0 C MFH: Make sure to not get out of bounds with S(Q(M)) - 6/9/15 IF(Q(M).GT.N) GO TO 777 S(Q(M))=0 777 Q(M)=0 M=M-1 IF(Q(M).EQ.1) TRIG=0 S(Q(M))=0 C C WRITE(*,*) 'X',(X(J),J=1,N) C WRITE(*,*) 'Q',(Q(J),J=1,N) C GO TO 2 C 9 CALL GETTIM (IHR, IMIN, ISEC, I100) C CALL GETDAT (IYR, IMON, IDAY) C TIMEB=DFLOAT(86400*IDAY+3600*IHR+60*IMIN+ISEC)+DFLOAT(I100)/100. C TIMTOT=TIMEB-TIMEA C write(*,*) ism,ism2,ism3 C WRITE(*,69) Z,TIMTOT C 9 WRITE(*,69) Z C WRITE(2,69) Z,TIMTOT C WRITE(2,70) (X(I),I=1,N) C 69 FORMAT(' MAXIMUM UNWEIGHTED ROW GRADIENT INDEX ',I20) C 69 FORMAT(' MAXIMUM UNWEIGHTED ROW GRADIENT INDEX ',I7,' CPU TIME ', C 1 F8.2) C 70 FORMAT(30I3) C 9 IF (IVERB == 1) THEN C PRINT *, 'total number of checks: ', CHECKS CALL intpr('total number of checks', -1, CHECKS, 1) ENDIF C Return R RNG CALL Putrngstate() RETURN END C SUBROUTINE BOUND2BBWRCG(ZBD,N,Q,M,D,S,DD) IMPLICIT INTEGER(A-Z) DOUBLE PRECISION D(N,N,N),ZBD,DD(N,N,N),Z1,Z2,Z3,ZA,ZB, 1 ZCT,N4 C ACT is now unused INTEGER Q(N),S(N) Z1=0 DO I = 1,M-2 R1=Q(I) DO J = I+1,M-1 R2=Q(J) DO K = J+1,M R3=Q(K) Z1=Z1+D(R1,R2,R3) END DO END DO END DO C Z2=0 DO I = 1,M-1 R1=Q(I) DO J = I+1,M R2=Q(J) DO 60 K = 1,N IF(S(K).EQ.1) GO TO 60 R3=K Z2=Z2+D(R1,R2,R3) 60 CONTINUE END DO END DO C Z3=0 DO 90 I = 1,N-1 IF(S(I).EQ.1) GO TO 90 R2=I DO 91 J = I+1,N IF(S(J).EQ.1) GO TO 91 R3=J ZA=0 ZB=0 DO 92 K = 1,M R1=Q(K) ZA=ZA+D(R1,R2,R3) ZB=ZB+D(R1,R3,R2) 92 CONTINUE ZCT=ZA IF(ZB.GT.ZCT) ZCT=ZB Z3=Z3+ZCT 91 CONTINUE 90 CONTINUE C N4=0 DO 93 I = 1,N-2 IF(S(I).EQ.1) GO TO 93 R1=I DO 94 J = I+1,N-1 IF(S(J).EQ.1) GO TO 94 DO 95 K = J+1,N IF(S(K).EQ.1) GO TO 95 C ACT=D(I,J,K) C IF(D(I,K,J).GT.ACT) ACT=D(I,K,J) C IF(D(J,I,K).GT.ACT) ACT=D(J,I,K) C N4=N4+ACT N4 = N4 + DD(I,J,K) 95 CONTINUE 94 CONTINUE 93 CONTINUE C N1=N*(N-1)*(N-2)/3 ! This bound is OK! The N1 is total C N2=M*(M-1)*(M-2)/3 ! and N2 and N3 are truly computed terms. C N3=(N-M)*(M*(M-1)) ! So N1-N2-N3 assumes +1 for rest, which ZBD=Z1+Z2+Z3+n4 ! (N-M)*(N-M-1)*(N-M-2)/3 +n4 C WRITE(*,98) N,M,N1,N2,N3,Z1,Z2,N1-N2-N3,ZBD C 98 FORMAT(9I7) RETURN END C SUBROUTINE EVALBBWRCG(ZBD,Q,N,D) IMPLICIT INTEGER(A-Z) DOUBLE PRECISION D(N,N,N),ZBD INTEGER Q(N) ZBD=0 DO 85 I = 1,N DO J = 1,N-1 IF(Q(J).EQ.I) GO TO 85 END DO Q(N)=I 85 CONTINUE DO I = 1,N-2 R1=Q(I) DO J = I+1,N-1 R2=Q(J) DO K = J+1,N R3=Q(K) ZBD=ZBD+D(R1,R2,R3) END DO END DO END DO RETURN END seriation/src/nextperm.c0000644000176200001440000000137214706524257015063 0ustar liggesusers#include void swap(double *, int, int); void permNext(double *, int *); void isMon(double *, double *, int *, int *); void swap(double *x, int i, int j) { float temp; temp = x[i]; x[i] = x[j]; x[j] = temp; } void permNext(double *x, int *nn) { int i, j, n = *nn; i = n - 1; while (x[i - 1] >= x[i]) i--; if (i == 0) return; j = n; while (x[j - 1] <= x[i - 1]) j--; swap(x, i - 1, j - 1); j = n; i++; while (i < j) { swap(x, i - 1, j - 1); j--; i++; } } void isMon(double *x, double *y, int *nn, int *what) { int n = *nn, i, j; for (i = 1; i < n; i++) for (j = 0; j < i; j++) if (((x[i] - x[j]) * (y[i] - y[j])) <= 0) *what = 0; } seriation/src/arsa.f0000644000176200001440000001740714706524257014160 0ustar liggesusersC ANTI-ROBINSON SERIATION C simulated annealing algorithm - provides an initial permutation C by Brusco, M., Koehn, H.F., and Stahl, S. C R Interface by Michael Hahsler C PROGRAM SANNEAL SUBROUTINE arsa(N, A, COOL, TMIN, NREPS, IPERM, D, U, 1 S, T, SB, ZMAX, RULE, TRYMULT, IVERB) IMPLICIT DOUBLE PRECISION(A-H,O-Z) DIMENSION A(N,N) DIMENSION IPERM(N) DOUBLE PRECISION D(N,N) REAL S1, RCRIT INTEGER U(N), S(N), UNSEL, T(NREPS,N), SB(N), Q, NREPS EPS = 1.0D-08 C Defaults C RULE = .5 C COOL = .95 C TMIN = .0001d0 C Initialize R RNG CALL getrngstate() DO I = 1,N-1 DO J = I+1,N D(I,J) = DBLE(J-I) D(J,I) = D(I,J) END DO END DO DO 999 III = 1,NREPS DO I = 1,N U(I) = I T(III,I) = 0 END DO UNSEL = N DO 1 I = 1,N C S1 = rand() CALL unifrand(S1) ISET = INT(S1 * FLOAT(UNSEL) + 1.) IF(ISET.GT.UNSEL) ISET = UNSEL T(III,I) = U(ISET) C DO J = ISET,UNSEL C out of bounds error reported by Rohan Shah (9/13/12) DO J = ISET,UNSEL-1 U(J) = U(J+1) END DO UNSEL = UNSEL - 1 1 CONTINUE 999 CONTINUE C ZMIN = 9.9D+20 ZAVG = 0. ZMAX = 0. DO 1000 III = 1,NREPS DO I = 1,N S(I) = T(III,I) END DO Z = 0.0D0 DO I = 1,N-1 K = S(I) DO J = I+1,N L = S(J) Z = Z + D(I,J) * A(K,L) END DO END DO ZBEST = Z TMAX = 0.0D0 C DO LLL = 1,5000 C Find initial TMAX using N*10 tries DO LLL = 1,N*10 C S1 = rand() CALL unifrand(S1) I1 = INT(S1 * FLOAT(N) + 1.) IF(I1.GT.N) I1 = N C 199 S1 = rand() 199 CALL unifrand(S1) J1 = INT(S1 * FLOAT(N) + 1.) IF(J1.GT.N) J1 = N IF(I1.EQ.J1) GO TO 199 IF(I1.GT.J1) THEN JDUM = J1 J1 = I1 I1 = JDUM END IF K = S(I1) M = S(J1) DELTA = 0.0D0 DO 1250 L1 = 1,N IF(I1.EQ.L1.OR.J1.EQ.L1) GO TO 1250 L=S(L1) DELTA=DELTA+(D(L1,I1)-D(L1,J1))*(A(L,M)-A(L,K)) 1250 CONTINUE IF(DELTA.LT.0) THEN IF(ABS(DELTA).GT.TMAX) TMAX = ABS(DELTA) END IF END DO C TMAX = Z ILOOP = INT(TRYMULT*N) NLOOP = INT((LOG(TMIN)-LOG(TMAX))/LOG(COOL)) IF (IVERB == 1) THEN CALL realpr('Found tmax', -1, TMAX, 1) CALL intpr('Steps needed', -1, NLOOP, 1) ENDIF TEMP = TMAX DO I = 1,N SB(I) = S(I) END DO C DO 2000 IJK = 1,NLOOP IF (IVERB == 1) THEN CALL intpr('Step', -1, IJK, 1) CALL dblepr('TEMP', -1, DBLE(TEMP), 1) ENDIF C R interrupt CALL rchkusr() C DO 2001 KKK = 1,ILOOP C S1 = rand() CALL unifrand(S1) IF(S1.LE.RULE) THEN ! INTERCHANGE / INSERTION / OR BOTH C S1 = rand() CALL unifrand(S1) I1 = INT(S1 * FLOAT(N) + 1.) IF(I1.GT.N) I1 = N C 99 S1 = rand() 99 CALL unifrand(S1) J1 = INT(S1 * FLOAT(N) + 1.) IF(J1.GT.N) J1 = N IF(I1.EQ.J1) GO TO 99 IF(I1.GT.J1) THEN JDUM = J1 J1 = I1 I1 = JDUM END IF K = S(I1) M = S(J1) DELTA = 0.0D0 DO 250 L1 = 1,N IF(I1.EQ.L1.OR.J1.EQ.L1) GO TO 250 L=S(L1) DELTA=DELTA+(D(L1,I1)-D(L1,J1))*(A(L,M)-A(L,K)) 250 CONTINUE IF(DELTA.GT.-EPS) THEN Z = Z + DELTA S(I1) = M S(J1) = K IF(Z.GT.ZBEST) THEN ZBEST = Z DO I = 1,N SB(I) = S(I) END DO END IF ELSE C S1 = rand() CALL unifrand(S1) RCRIT = REAL(EXP(DELTA/TEMP)) IF(S1.LE.RCRIT) THEN Z = Z + DELTA S(I1) = M S(J1) = K END IF END IF ELSE ! INSERTION C S1 = rand() CALL unifrand(S1) I1 = INT(S1 * FLOAT(N) + 1.) ! OBJECT POSITION IS I1 IF(I1.GT.N) I1 = N C 599 S1 = rand() 599 CALL unifrand(S1) J1 = INT(S1 * FLOAT(N) + 1.) IF(J1.GT.N) J1 = N IF(I1.EQ.J1) GO TO 599 K = S(I1) DELTA = 0.0D0 IF(J1.GT.I1) THEN SPAN = DBLE(J1-I1) DO L = I1+1,J1 Q = S(L) DO I = J1+1,N M = S(I) DELTA = DELTA + A(M,Q) END DO DO I = 1,I1-1 M = S(I) DELTA = DELTA - A(M,Q) END DO END DO DO I = 1,I1-1 M = S(I) DELTA = DELTA + SPAN*A(M,K) END DO DO I = J1+1,N M = S(I) DELTA = DELTA - SPAN*A(K,M) END DO SPAN2 = SPAN+1 DO I = I1+1,J1 SPAN2 = SPAN2-2 M = S(I) DELTA = DELTA + SPAN2*A(K,M) END DO ELSE SPAN = DBLE(I1-J1) DO L = J1,I1-1 Q = S(L) DO I = I1+1,N M = S(I) DELTA = DELTA - A(M,Q) END DO DO I = 1,J1-1 M = S(I) DELTA = DELTA + A(M,Q) END DO END DO DO I = 1,J1-1 M = S(I) DELTA = DELTA - SPAN*A(M,K) END DO DO I = I1+1,N M = S(I) DELTA = DELTA + SPAN*A(K,M) END DO SPAN2 = SPAN+1 DO I = J1,I1-1 SPAN2 = SPAN2-2 M = S(I) DELTA = DELTA - SPAN2*A(K,M) END DO END IF IF(DELTA.GT.-EPS) THEN Z = Z + DELTA IF(J1.GT.I1) THEN DO L = I1,J1-1 S(L)=S(L+1) END DO S(J1) = K ELSE DO L = I1,J1+1,-1 S(L)=S(L-1) END DO S(J1) = K END IF IF(Z.GT.ZBEST) THEN ZBEST = Z DO I = 1,N SB(I) = S(I) END DO END IF ELSE C S1 = rand() CALL unifrand(S1) RCRIT = REAL(EXP(DELTA/TEMP)) IF(S1.LE.RCRIT) THEN Z = Z + DELTA IF(J1.GT.I1) THEN DO L = I1,J1-1 S(L)=S(L+1) END DO S(J1) = K ELSE DO L = I1,J1+1,-1 S(L)=S(L-1) END DO S(J1) = K END IF END IF END IF C END IF 2001 CONTINUE TEMP = TEMP*COOL 2000 CONTINUE IF(ZBEST.LT.ZMIN) ZMIN = ZBEST IF(ZBEST.GT.ZMAX) THEN ZMAX = ZBEST DO I = 1,N IPERM(I) = SB(I) END DO END IF IF (IVERB == 1) THEN CALL intpr('Rep', -1, III, 1) CALL dblepr('ZMAX', -1, DBLE(ZMAX), 1) END IF 1000 CONTINUE C Return R RNG CALL Putrngstate() RETURN END seriation/src/dist.c0000644000176200001440000000312514706524257014162 0ustar liggesusers/* * seriation - Infrastructure for seriation * Copyright (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * any later version. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License along * with this program; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */ #include #include #include "lt.h" /* * Reorder a dist object with a given order * Beware: all checking and attribute stuff has to be done in the R wrapper */ SEXP reorder_dist(SEXP R_dist, SEXP R_order) { SEXP R_dist_out; int n = INTEGER(getAttrib(R_dist, install("Size")))[0]; R_xlen_t n_out = LENGTH(R_order); int *o = INTEGER(R_order); PROTECT(R_dist_out = allocVector(REALSXP, n_out*(n_out-1)/2)); double *dist = REAL(R_dist); double *dist_out = REAL(R_dist_out); for (int i = 1; i <= n_out; i++) { for (int j = (i+1); j <=n_out; j++) { if(o[i-1] == o[j-1]) dist_out[LT_POS(n_out, i, j)] = 0.0; else dist_out[LT_POS(n_out, i, j)] = dist[LT_POS(n, o[i-1], o[j-1])]; } } UNPROTECT(1); return R_dist_out; } seriation/NAMESPACE0000644000176200001440000000675214706524256013513 0ustar liggesusers# Generated by roxygen2: do not edit by hand S3method("[",ser_permutation) S3method(c,ser_permutation) S3method(c,ser_permutation_vector) S3method(criterion,array) S3method(criterion,data.frame) S3method(criterion,default) S3method(criterion,dist) S3method(criterion,matrix) S3method(criterion,table) S3method(get_order,default) S3method(get_order,dendrogram) S3method(get_order,hclust) S3method(get_order,integer) S3method(get_order,numeric) S3method(get_order,ser_permutation) S3method(get_order,ser_permutation_vector) S3method(ggpimage,default) S3method(ggpimage,dist) S3method(ggpimage,matrix) S3method(length,ser_permutation_vector) S3method(permute,array) S3method(permute,character) S3method(permute,data.frame) S3method(permute,default) S3method(permute,dendrogram) S3method(permute,dist) S3method(permute,hclust) S3method(permute,list) S3method(permute,matrix) S3method(permute,numeric) S3method(permute,table) S3method(pimage,data.frame) S3method(pimage,default) S3method(pimage,dist) S3method(pimage,matrix) S3method(pimage,table) S3method(plot,reordered_cluster_dissimilarity_matrix) S3method(print,criterion_method) S3method(print,reordered_cluster_dissimilarity_matrix) S3method(print,ser_permutation) S3method(print,ser_permutation_vector) S3method(print,seriation_method) S3method(reorder,hclust) S3method(rev,ser_permutation_vector) S3method(seriate,array) S3method(seriate,data.frame) S3method(seriate,default) S3method(seriate,dist) S3method(seriate,matrix) S3method(seriate,table) S3method(summary,ser_permutation) S3method(summary,ser_permutation_vector) export(LS_insert) export(LS_mixed) export(LS_reverse) export(LS_swap) export(MDS_stress) export(VAT) export(bertin_cut_line) export(bertinplot) export(bluered) export(blues) export(create_lines_data) export(create_ordered_data) export(criterion) export(dissplot) export(gaperm_mixedMutation) export(get_config) export(get_criterion_method) export(get_method) export(get_order) export(get_permutation_matrix) export(get_rank) export(get_seriation_method) export(ggVAT) export(ggbertinplot) export(ggdissplot) export(gghmap) export(ggiVAT) export(ggpimage) export(grays) export(greenred) export(greens) export(greys) export(hmap) export(iVAT) export(is.robinson) export(list_criterion_methods) export(list_seriation_methods) export(lle) export(panel.bars) export(panel.blocks) export(panel.circles) export(panel.lines) export(panel.rectangles) export(panel.squares) export(panel.tiles) export(path_dist) export(permutation_matrix2vector) export(permutation_vector2matrix) export(permute) export(pimage) export(plot_config) export(random.robinson) export(reds) export(register_DendSer) export(register_GA) export(register_optics) export(register_smacof) export(register_tsne) export(register_umap) export(registry_criterion) export(registry_seriate) export(ser_align) export(ser_cor) export(ser_dist) export(ser_permutation) export(ser_permutation_vector) export(seriate) export(seriate_best) export(seriate_improve) export(seriate_rep) export(set_criterion_method) export(set_seriation_method) export(uniscale) import("TSP") import("grid") import(registry) importFrom(ca,ca) importFrom(foreach,`%do%`) importFrom(foreach,`%dopar%`) importFrom(foreach,times) importFrom(graphics,plot) importFrom(graphics,text) importFrom(graphics,title) importFrom(stats,as.dist) importFrom(stats,dist) importFrom(stats,hclust) importFrom(stats,order.dendrogram) importFrom(stats,prcomp) importFrom(stats,reorder) importFrom(stats,rnorm) importFrom(stats,runif) useDynLib(seriation, .registration=TRUE) seriation/NEWS.md0000644000176200001440000004076114724356113013363 0ustar liggesusers# seriation 1.5.7 (12/05/2024) ## New Features - Added seriation method BK_unconstrained by kbvernon. - All methods now gracefully handle data with two few objects. - ser_permutation_vector() now updates method name. ## Bug Fixes - Fixed label order for seriate.matrix. - Fixed typo in parameter name for seriation method ARSA (reported by Brian Ripley) # seriation 1.5.6 (08/19/2024) ## New Features - Added registered_by field to registries. ## Changes - We replaced the FORTRAN implementation for BEA with code from package TSP. - ME is now calculated using C code. - optimal.c: updated memory allocation to R allocation. - stress.c: updated memory allocation to R allocation. ## Bug Fixes - Added two missing package anchors to palette man page. # seriation 1.5.5 (04/17/2024) ## Changes - Updated man pages. # seriation 1.5.4 (12/11/2023) ## Bug Fixes - Fixed MDS_angle order for different BLAS implementation giving different results for eigen(). # seriation 1.5.3 (11/28/2023) ## New Features - permute for dendrograms gained parameter dist and accepts now seriation methods. - Added method "AOE" for correlation matrices. - registry for seriation methods now contains the name of the seriation criterion and a description. seriate_rep now automatically uses the criterion from the registry. - all seriation methods gained parameter rep. ## Bug Fixes - optimal.c: use now the correct data type for Rprintf - Skip deterministic tests on Mac M1 because of numerical differences. # seriation 1.5.1 (07/20/2023) ## New Features - pimage and permute now accept order = TRUE to perform the default seriation. - hmap gained parameter col_dist to define the color palette used for distance matrices. - hmap dropped parameter showDend and gained parameter plot_margins instead. ## Bug Fixes - pimage/ggpimage now use zlim correctly to choose the color palette. - BEA for matrix is now correctly registered as randomized. - fixed col/row_labels parameter. - rev() for seriations based on hclust now reverses the dendrogram. - tests now also accept reverse orders for testing deterministic methods. # seriation 1.5.0 (07/19/2023) ## New Features - The seriation registry now contains help information for the seriation method parameters. - New function seriate_best, seriate_rep, and seriate_improve() to easily find a good order for randomized algorithms. Parallel execution is supported. - Seriation method registry has new fields 'randomized' to indicate if an algorithm is randomized and can be run several times and 'optimizes' to indicate what criterion is optimized. This information is used by seriate_rep. - Seriation for arrays (including matrix) gained margin parameter. - tsne and umap can now be used on data matrices. - get_rank() returns now labels. - Embedding-based methods now return the order with an attribute called configuration. - New MDS_stress() function. - Added register_smacof(). - Added seriation method "Reverse" for dist. - New seriation methods from vegan: isomap, monoMDS, metaMDS. - New seriation method "Enumerate" for complete enumeration. - New seriation method "Mean" for matrix. - New seriation method "SGD" for distances to improve solutions using stochastic gradient descent. - New seriation method "LLE" (locally linear embedding) for matrix. - Heatmap seriation has now special seriation_method "HC_Mean". - New seriation criterion "Rho" calculates the absolute Spearman's rank correlation coefficient. - list_seriation_methods() and list_criterion_methods() gained parameter names_only. ## Changes - Seriation methods for MDS are now MDS, isoMDS and Sammon_mapping and have now individual control parameters. - orderplot() is now called plot_config() and can also visualize 2D configurations. - HC-based seriation: The control parameter method is now linkage so it can be used in seriate() in the ... - Seriation method spectral now also returns the embedding. - Seriation method simulated annealing is now called "GSA". - Simplified generics for pimage and ggpimage. Defaults for pimage.dist have changed. - DendSer methods now return hclust objects. ## Bug Fixes - fixed labels returned by uniscale() - FORTRAN: replaced old DFLOAT with DBLE (reported by Brian D. Ripley). # seriation 1.4.2 (03/07/2023) ## Bug Fixes - pimage: ... is now passed on to the seriation method. - added missing S3 method registrations. ## New Features - methods umap and tsne can now return the embedding. # seriation 1.4.1 (12/27/2022) ## New Features - get_order not consistently returns permutation vectors with names (by david-barnett). ## Bug Fixes - criterion.c: replaced enum for bool with - Additional contributors are not in alphabetical order. # seriation 1.4.0 (10/21/2022) ## New Features - seriate for arrays (including matrices) now returns a complete ser_permutation for all dimensions even if margins are specified. For not specified margins, identity permutations are returned. - added support for tables. - added new seriation method CA (correspondence analysis) contributed by Michael Friendly. - permute now accepts more than one margin. - permute now accepts a seriation method instead of order. ## Bug Fixes - seriate.dist now throws correct error upon encountering NAs (by david-barnett) # seriation 1.3.6 (07/14/2022) ## New Features - ggpimage has now a zlim parameter. ## Bug Fixes - added register functions back to export (reported by thomasp85). - fixed viewports for pimage with colorkey. - fixed ggplot diverging color palette direction. # seriation 1.3.4 (3/16/2022) ## Bug Fixes - fixed length calculation in optimal.c # seriation 1.3.3 (3/3/2022) ## New Features - pimage and dissplot gained parameter diag. pimage for dist by default does not show the diagonal now. - C code now supports long vectors for dist objects. ## User-Visible Changes - removed deprecated show functions for the registries. ## Internal Changes - we now use roxygen for documentation. - added check for long vectors that FORTRAN cannot handle. # seriation 1.3-2 (2/10/2022) ## Changes - improved argument checking for ser_permutation_vector(). - ggplot uses now standard ggplot2 color palettes. # seriation 1.3-1 (10/15/2021) ## New Features - added seriation based on 1D t-SNE embedding. - added seriation based on 1D UMAP embedding. - added seriation based on OPTICS. ## User-Visible Changes - VAT plots now default to upper_tri = TRUE to show the whole matrix. # seriation 1.3-0 (06/29/2021) ## User-Visible Changes - Plotting - Most plotting functions have now a common interface. This changed many parameters. - hmap now uses heatmap from package stats. - dissplot shows now averages in the top triangles. - improved layout (less white space) for grid-based plots. - Registry - list_seriation_methods and list_criterion_methods without kind return now a list. - show_seriation_methods and show_criterion_methods are deprecated - Other Changes - criterion returns now NA with a warning for ME for non-positive matrices (used to stop with an error). - dependency dendextend is now only suggested (used for testing). - get_order now returns also labels. - hclust-based seriations now defaults for linkage to complete instead of average. ## New Features - Plotting - Major refactoring of plotting functions to provide a more consistent interface. - added ggplot2-based plots, ggimage, gghmap, ggVAT, ggiVAT, ggbertinplot, ggdissplot. - colors are now more consistent and all have bias and power. - Seriation methods - seriate for matrix has now method "Heatmap". - seriate now accepts data.frames and used method "heatmap" as the default. - added seriation method "Reverse" for reverse identity order. - Permutation - permute for matrix-like objects gained parameter margin. - permute for data.frame works now identical to permute for matrix. # seriation 1.2-9 (09/29/2020) - removed dependency on methods. - added DOIs. # seriation 1.2-8 (08/27/2019) ## New features - get_seriation_method now has better information and also show available control parameters. ## Bug Fixes - GA: Updated parameter names after change in package ga. # seriation 1.2-7 (06/07/2019) ## Bug Fixes - Added missing void \* to init.c # seriation 1.2-6 (06/03/2019) ## Bug Fixes - Converted print routines in FORTRAN code to dblepr, intpr, etc. - seriate.matrix also prints now method name for control verbose = TRUE. # seriation 1.2-5 (05/30/2019) ## Bug Fixes - Fixed compilation warnings in FORTRAN code. # seriation 1.2-4 (05/29/2019) ## New features - bertinplot: panel colors can now be specified in highlight and as shading.function. ## Bug Fixes - bertinplot: fix white squares when frame = TRUE (by Dirk Seidensticker). - seriation method "BEA" has now a slight code improvement (suggested by RichardKav) # seriation 1.2-3 (02/05/2018) ## Bug Fixes - seriation method "BEA" is now not longer masked by "BEA_TSP". Also the FORTRAN calls now work. - SPIN: making the matrix doubly stochastic now checks all rows/columns (reported and fixed by cerebis) # seriation 1.2-2 (05/08/2017) ## New features - Added new seriation method SA which provides simulated annealing for all criterion measures. - Added criterion Cor_R (ME for the moment ordering algorithm by Deutsch and Martin). - Added uniscale to produce a unidimensional scaling configuration given a distance matrix and a permutation. - Criterion gained parameter force_loss (default is FALSE). Merit measures are converted into loss values by multiplying with -1. - Added Supreme Court dataset. ## Changes and Bug Fixes - Default for seriate (dist) and dissplot is now "Spectral" since it gives a better tradeoff between quality and speed. - Seriation method ARSA's control argument nreps is now for consistency called reps. - Criterion: dist objects are now automatically converted into a similarity matrix for ME, Moore_stress and Neumann_stress. - pimage now suppresses the color key for logical matrices and checks for all NAs and infinite entries. - Correction: ARSA minimizes the linear seriation criterion (man page and vignette). # seriation 1.2-1 (08/06/2016) ## New features - Added new distance measure called absolute pairwise rank differences. ## Changes and Bug Fixes - The default setting for ser_dist and ser_cor is now reverse is TRUE. - pimage does now work with matrices containing only a single value. - control parameters for method TSP are now correctly passed on (reported by David Aliyev). # seriation 1.2-0 (2/22/2016) ## New features - RGAR gained parameter pct to specify the window as a percentage. - Added the lazy path length criterion. - Added the banded anti-Robinson form (BAR) criterion. - Added QAP_Inertia and QAP_BAR solver. - Added DendSer using register_DendSer(). - Added GA using register_GA(). ## Changes and Bug Fixes - Fixed RGAR (w needs to be in [2,n-1]). - Registry now warns and modifies entries with the same name. - Registry now lists methods in alphabetical order. - Seriation method alias Chen was removed. Use R2E. # seriation 1.1-3 (12/18/2015) - Added is.robinson to recognize (pre) Robinson matrices. - Added random.robinson to create random Robinson matrices. - Added seriation methods "QAP_LS" and "QAP_2SUM" (QAP-based seriation). - Added criteria "LS" and "2SUM" from QAP-based seriation. - Fixed Spectral_norm seriation. - hmap now honors zlim also in dendrogram-based maps. - hmap gained option sym for seriation based maps. showdist can now be one of "none" (default), "row", "column", or "both". - ser_cor and ser_dist gained parameter y. ser_cor gained parameter test to perform tests for association. - Added permute method for hclust and dendrogram objects. # seriation 1.1-2 (8/23/2015) - Argument (control and ...) check warns now instead of throwing an error. - seriation_dist, seriation_cor and seriation_align are now shortened to ser_dist, ser_cor and ser_align. - Method "ppc" is now faster and also available in ser_cor. - Fixed ser_cor for "spearman" and "Kendall" (uses now rank correctly). - ser_cor and ser_dist gained parameter reverse to indicate that permuations are also tried in reverse and the best value is reported. # seriation 1.1-1 (7/1/2015) - get_permutation_matrix added. - seriation_dist measure "ppc" (positional proximity coefficient) added. - Fixed bug with permute and ser_permutation_vectors. - Identity permutations (NA) give now an error for get_order and get_permutation_matrix. - Fixed imports for non-base R packages. # seriation 1.1-0 (06/09/2015) - Seriation method 'Identity' added. - Seriation method 'Random' added. - Seriation method 'VAT' added. - Seriation methods 'Spectral' and 'Spectral_norm' added. - Seriation methods 'PCA_angle' and 'MDS_angle' added. - Seriation methods 'SPIN_NH' and 'SPIN_STS' added. - Several aliases for seriation methods added. - Criterion 'RWGAR' added. - permutation_matrix2vector and permutation_vector2matrix added. - Identity permutation (value NA) added. - ser_permutation and ser_permutation_vector can now be used interchangeably, - get_rank for permutation vectors added. - seriation_dist and seriation_alignment to calculate dissimilarities between seriation orders added. - Wood data set added. - # Chameleon data sets added. - create_lines_data, create_ordered_data added. - pimage, hmap and dissplot: Simplified and made interfaces more consistent (all use now zlim, consistent default color palettes). - pimage gained axes and prop; NA in matrix now works. - seriation checks now control arguments consistently. - We use now package registry to manage methods. - reorder for hclust added. - iVAT with path distance added. - color palettes (bluered, greenred, grays) added. - Improved speed of C code. - Problem with testthat file names fixed. - bburg.f/bbwrg.f: memory access problem fixed. # seriation 1.0-14 (12/02/2014) - arsa.f: removed 0 flag in rand() so it compiles under AIX (reported by Lei Zhang) - arsa.f/bburg.f/bbwrg.f: calls now R RNG to be compatible with certain compilers (e.g., Intel FORTRAN) (reported by Rohan Shah) # seriation 1.0-13 (3/11/2014) - Fixed dependence on MASS # seriation 1.0-12 (2/18/2014) - ser_permutation_vectors can now be reversed with rev - get_order: removed the weird labels. - we use now testthat - fixed bug with intra-cluster ordering using silhouette width (reported by Bettina Gruen) - Cleaned up dependencies: TSP, grid, cluster, gclus and colorspace are now imports instead of dependencies. # seriation 1.0-11 (9/6/2013) - service release. # seriation 1.0-10 (2/15/2013) - pimage has now a colorkey and a range argument - fixed bug in ARSA when the distance matrix contains all 0s - added PACKAGE argument to .Fortran calls # seriation 1.0-8 and 1.0-9 (11/6/2012) - get_order: labels are now in the correct order (Bug report by Crt Ahlin) - Replaced FORTRAN I/O with R I/O for verb=TRUE - Fixed pop/newpage bug in pimage.dist (reported by Bettina Gruen) # seriation 1.0-7 (9/25/2012) - Fixed out-of-bounds bug in arsa.f (reported by Rohan Shah) - Fixed out-of-bounds bug in bburcg.f # seriation 1.0-6 (10/19/2011) - removed deprecated parameter gamma for dissplot() # seriation 1.0-5 (9/2/2011) - bertinplot(): fixed representation for 0, neg. values and highlight. (Bug report by G. Sawitzki). - bertinplot(): added panel.blocks and option for shading - bertinplot(): added bertin_cut_line() # seriation 1.0-4 (6/28/2011) - pimage() now uses grid.raster. - dissplot() now uses grid.raster. # seriation 1.0-3 (1/14/2011) - improved validity check for permutations and added check for dist with neg. entries to seriate.dist. # seriation 1.0-2 (3/13/2010) - service release # seriation 1.0-1 (8/25/2009) - added drop=FALSE in permute for matrix. - fixed reordering for labels. - added permute for character. - added different methods to calculate between cluster dissimilarities (min, max, avg, Hausdorff). - dissplot has now additional options hue, power, gamma, flip and changed behavior for averages. dissplot depends now on colorspace. # Version 1.0-0 (3/24/2009) - many changes and first stable release. # Version 0.1-1 (9/1/2007) - Initial beta release. seriation/inst/0000755000176200001440000000000014724364730013236 5ustar liggesusersseriation/inst/CITATION0000644000176200001440000000205414706524257014376 0ustar liggesusers citation(auto = meta) bibentry(bibtype = "article", title = paste("Getting things in order: ", "An introduction to the R package seriation"), author = { c(person("Michael", "Hahsler", email = "mhahsler@lyle.smu.edu", comment = c(ORCID = "0000-0003-2716-1405")), person("Kurt", "Hornik", email = "Kurt.Hornik@R-project.org", comment = c(ORCID = "0000-0003-4198-9911")), person("Christian", "Buchta", email = "Christian.Buchta@wu.ac.at")) }, year = 2008, journal = "Journal of Statistical Software", volume = 25, number = 3, pages = "1--34", doi = "10.18637/jss.v025.i03", month = "March", issn = "1548-7660" ) bibentry(bibtype = "article", title = "An experimental comparison of seriation methods for one-mode two-way data", author = person("Michael", "Hahsler", email = "mhahsler@lyle.smu.edu"), year = 2017, journal = "European Journal of Operational Research", volume = 257, number = 1, pages = "133--143", doi = "10.1016/j.ejor.2016.08.066", month = "February" ) seriation/inst/doc/0000755000176200001440000000000014724364730014003 5ustar liggesusersseriation/inst/doc/seriation.Rnw0000644000176200001440000024055114724357421016476 0ustar liggesusers\documentclass[nojss]{jss} \usepackage[english]{babel} %\documentclass[fleqn, a4paper]{article} %\usepackage{a4wide} %\usepackage[round,longnamesfirst]{natbib} %\usepackage{graphicx,keyval,thumbpdf,url} %\usepackage{hyperref} %\usepackage{Sweave} \SweaveOpts{strip.white=true} \AtBeginDocument{\setkeys{Gin}{width=0.6\textwidth}} \usepackage[utf8]{inputenc} %% end of declarations %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \usepackage{amsmath} \usepackage{amsfonts} %\newcommand{\strong}[1]{{\normalfont\fontseries{b}\selectfont #1}} \newcommand{\class}[1]{\mbox{\textsf{#1}}} \newcommand{\func}[1]{\mbox{\texttt{#1()}}} %\newcommand{\code}[1]{\mbox{\texttt{#1}}} %\newcommand{\pkg}[1]{\strong{#1}} \newcommand{\samp}[1]{`\mbox{\texttt{#1}}'} %\newcommand{\proglang}[1]{\textsf{#1}} \newcommand{\set}[1]{\mathcal{#1}} \newcommand{\sQuote}[1]{`{#1}'} \newcommand{\dQuote}[1]{``{#1}''} \newcommand\R{{\mathbb{R}}} \DeclareMathOperator*{\argmin}{argmin} \DeclareMathOperator*{\argmax}{argmax} %% almost as usual \author{Michael Hahsler\\Southern Methodist University \And Kurt Hornik\\Wirtschaftsuniversit\"at Wien \AND Christian Buchta\\Wirtschaftsuniversit\"at Wien} \title{Getting Things in Order:\\ An Introduction to the \proglang{R}~Package~\pkg{seriation}} %% for pretty printing and a nice hypersummary also set: \Plainauthor{Michael Hahsler, Kurt Hornik, Christian Buchta} %% comma-separated \Plaintitle{Getting Things in Order: An Introduction to the R Package seriation} %% without formatting \Shorttitle{Getting Things in Order} %% a short title (if necessary) %% an abstract and keywords \Abstract{Seriation, i.e., finding a suitable linear order for a set of objects given data and a loss or merit function, is a basic problem in data analysis. Caused by the problem's combinatorial nature, it is hard to solve for all but very small sets. Nevertheless, both exact solution methods and heuristics are available. In this paper we present the package~\pkg{seriation} which provides an infrastructure for seriation with \proglang{R}. The infrastructure comprises data structures to represent linear orders as permutation vectors, a wide array of seriation methods using a consistent interface, a method to calculate the value of various loss and merit functions, and several visualization techniques which build on seriation. To illustrate how easily the package can be applied for a variety of applications, a comprehensive collection of examples is presented.} \Keywords{combinatorial data analysis, seriation, permutation, \proglang{R}} \Plainkeywords{combinatorial data analysis, seriation, permutation, R} %% without formatting \Address{ Michael Hahsler\\ Engineering Management, Information, and Systems\\ Lyle School of Engineering\\ Southern Methodist University\\ P.O. Box 750123 \\ Dallas, TX 75275-0123\\ E-mail: \email{mhahsler@lyle.smu.edu}\\ URL: \url{http://lyle.smu.edu/~mhahsler} Kurt Hornik\\ Department f\"ur Statistik \& Mathematik\\ Wirtschaftsuniversit\"at Wien\\ 1090 Wien, Austria\\ E-mail: \email{kurt.hornik@wu.ac.at}\\ URL: \url{http://statmath.wu.ac.at/~hornik/} Christian Buchta\\ Department f\"ur Welthandel\\ Wirtschaftsuniversit\"at Wien\\ 1090 Wien, Austria\\ E-mail: \email{christian.buchta@wu.ac.at}\\ URL: \url{http://www.wu.ac.at/itf/institute/staff/buchta} } \hyphenation{Brusco} \sloppy %% \VignetteIndexEntry{An Introduction to the R package seriation} \begin{document} %\title{Getting Things in Order: An introduction to the %R~package~\pkg{seriation}} %\author{Michael Hahsler, Kurt Hornik and Christian Buchta} \maketitle %\abstract{Seriation, i.e., finding a suitable linear order for a set of % objects given data and a loss or merit function, is a basic problem in % data analysis. Caused by the problem's combinatorial nature, it is % hard to solve for all but very small sets. Nevertheless, both exact % solution methods and heuristics are available. In this paper we % present the package~\pkg{seriation} which provides an infrastructure % for seriation with \proglang{R}. The infrastructure comprises data % structures to represent linear orders as permutation vectors, a wide % array of seriation methods using a consistent interface, a method to % calculate the value of various loss and merit functions, and several % visualization techniques which build on seriation. To illustrate how % easily the package can be applied for a variety of applications, a % comprehensive collection of examples is presented.} % <>= options(scipen=3, digits=4) ### for sampling set.seed(1234) @ \section{Introduction} A basic problem in data analysis, called \emph{seriation} or sometimes \emph{sequencing}, is to arrange all objects in a set in a linear order given available data and some loss or merit function in order to reveal structural information. Together with cluster analysis and variable selection, seriation is an important problem in the field of \emph{combinatorial data analysis}~\citep{seriation:Arabie:1996}. Solving problems in combinatorial data analysis requires the solution of discrete optimization problems which, in the most general case, involves evaluating all feasible solutions. Due to the combinatorial nature, the number of possible solutions grows with problem size (number of objects, $n$) by the order~$O(n!)$. This makes a brute-force enumerative approach infeasible for all but very small problems. To solve larger problems (currently with up to 40 objects), partial enumeration methods can be used. For example, \cite{seriation:Hubert:2001} propose dynamic programming and \cite{seriation:Brusco:2005} use a branch-and-bound strategy. For even larger problems only heuristics can be employed. It has to be noted that seriation has a rich history in archaeology. \cite{seriation:Petrie:1899} was the first to use seriation as a formal method. He applied it to find a chronological order for graves discovered in the Nile area given objects found there. He used a cross-tabulation of grave sites and objects and rearranged the table using row and column permutations till all large values were close to the diagonal. In the rearranged table graves with similar objects are closer to each other. Together with the assumption that different objects continuously come into and go out of fashion, the order of graves in the rearranged table suggests a chronological order. Initially, the rearrangement of rows and columns of this contingency table was done manually and the adequacy was only judged subjectively by the researcher. Later, \cite{seriation:Robinson:1951}, \cite{seriation:Kendall:1971} and others proposed measures of agreement between rows to quantify optimality of the resulting table. A comprehensive description of the development of seriation in archaeology is presented by \cite{seriation:Ihm:2005}. Techniques related to seriation are also popular in several other fields. Especially in ecology scaling techniques are used under the name \emph{ordination}. For these applications several \proglang{R} packages already exist (e.g., \pkg{ade4}~\citep{seriation:Chessel:2007,seriation:Dray:2007} and \pkg{vegan}~\citep{seriation:Oksanen:2007}). This paper describes the new package \pkg{seriation} which differs from existing packages in the following ways: \begin{itemize} \item \pkg{seriation} provides a flexible infrastructure for seriation; \item \pkg{seriation} focuses on seriation as a combinatorial optimization problem. \end{itemize} This paper starts with a formal introduction of the seriation problem as a combinatorial optimization problem in Section~\ref{sec:seriation}. In Section~\ref{sec:methods} we give an overview of seriation methods. In Section~\ref{sec:infrastructure} we present the infrastructure provided by the package~\pkg{seriation}. Several examples and applications for seriation are given in Section~\ref{sec:example}. Section~\ref{sec:conclusion} concludes. A previous version of this manuscript was published in the \emph{Journal of Statistical Software} \citep{seriation:Hahsler+Hornik:2008}. \section{Seriation as a combinatorial optimization problem} \label{sec:seriation} To seriate a set of $n$ objects $\{O_1,\dots,O_n\}$ one typically starts with an $n \times n$ symmetric dissimilarity matrix~$\mathbf{D} = (d_{ij})$ where $d_{ij}$ for $1 \le i,j \le n$ represents the dissimilarity between objects $O_i$ and $O_j$, and $d_{ii} = 0$ for all~$i$. We define a permutation function $\Psi$ as a function which reorders the objects in $\mathbf{D}$ by simultaneously permuting rows and columns. The seriation problem is to find a permutation function $\Psi^*$ %$\{1,\dots,n\} \rightarrow \{1,\dots,n\}$, i.e. a %bijection that maps the set of indices of the objects (and equally of rows and %columns of $\mathbf{D}$) onto itself, which optimizes the value of a given loss function~$L$ or merit function~$M$. This results in the optimization problems \begin{equation} \Psi^* = \argmin_\Psi L(\Psi(\mathbf{D})) \quad \text{or} \quad \Psi^* = \argmax_\Psi M(\Psi(\mathbf{D})), \end{equation} respectively. %This is clearly a hard discrete optimization problem since the number of %possible permutations is $n!$ which makes an exhaustive %search for sets with a medium to large number of objects infeasible. %Partial enumeration methods and heuristics can be used. Such methods are %presented in Section~\ref{sec:methods}. %But first, we review commonly used loss functions in the following section. %\marginpar{two-mode data missing} A symmetric dissimilarity matrix is known as \emph{two-way one-mode} data since it has columns and rows (two-way) but only represents one set of objects (one-mode). Seriation is also possible for two-way two-mode data which are represented by a general nonnegative matrix. In such data columns and rows represent two sets of objects which are reordered simultaneously. For loss/merit functions for two-way two-mode data the optimal order of columns can depend of the order of rows and vice versa or it can be independent allowing for breaking the optimization down into two separate problems, one for the columns and one for the rows. Another way to deal with the seriation for two-way two-mode data is to calculate two dissimilarity matrices, one for each mode, and then solve two seriation problems for two-way one-mode data. Furthermore, seriation can be generalized to $k$-way $k$-mode data in the form of a $k$-dimensional array by defining suitable loss/merit functions for such data or by breaking the problem down into several lower dimensional independent problems. To assess the complexity of seriation of $k$-way $k$-mode data, let us assume the data is a $k$-dimensional array with the dimensions containing $n_1, n_2, \ldots, n_k$ objects. If the loss/merit function allows for separating the problem into $k$ independent problems, the problem size is just the sum of the individual problems. By using complete enumeration the size is $O(\sum_{i=1}^k{n_i!})$. If the problem is not separable and the optimal seriation of each dimension depends on the order of the objects of the other dimensions, the problem size is $O((\sum_{i=1}^k{n_i})!)$. For example for $k=5$ and all dimensions containing 5 objects, the search space for separable dimensions is only 600 while without separability it is larger than $10^{25}$ clearly too big to be solvable in reasonable time. This shows that for data with even only a few dimensions and a few objects each, finding the optimal solution is infeasible and loss/merit functions which allow for separating the problem are highly desirable. In the following subsections, we review some commonly employed loss/merit functions. Most functions are used for two-way one-mode data but the measure of effectiveness and stress can be also used for two-way two-mode data. For the implementation of various loss or merit measures see function~\func{criterion} in Section~\ref{sec:infrastructure}. %\section{Loss functions} %\label{sec:criteria} %In the literature several loss functions are suggested. %We review the most commonly used functions. \subsection{Column/row gradient measures} A symmetric dissimilarity matrix where the values in all rows and columns only increase when moving away from the main diagonal is called a perfect \emph{anti-Robinson matrix} after the statistician \cite{seriation:Robinson:1951}. Formally, an $n \times n$ dissimilarity matrix $\mathbf{D}$ is in anti-Robinson form if and only if the following two gradient conditions hold~\citep{seriation:Hubert:2001}: \begin{align} \text{within rows:} & \quad d_{ik} \le d_{ij} \quad \text{for} \quad 1 \le i < k < j \le n; \\ \text{within columns:} & \quad d_{kj} \le d_{ij} \quad \text{for} \quad 1 \le i < k < j \le n. \end{align} In an anti-Robinson matrix the smallest dissimilarity values appear close to the main diagonal, therefore, the closer objects are together in the order of the matrix, the higher their similarity. This provides a natural objective for seriation. It has to be noted that $\mathbf{D}$ can be brought into a perfect anti-Robinson form by row and column permutation whenever $\mathbf{D}$ is an ultrametric or $\mathbf{D}$ has an exact Euclidean representation in a single dimension~\citep{seriation:Hubert:2001}. However, for most data only an approximation to the anti-Robinson form is possible. A suitable merit measure which quantifies the divergence of a matrix from the anti-Robinson form was given by \cite{seriation:Hubert:2001} as \begin{equation} M(\mathbf{D}) = \sum_{i y. \end{cases} \end{equation} It results in the raw number of triples satisfying the gradient constraints minus triples which violate the constraints. The second function is defined as: \begin{equation} f(z,y) = |y-z|\mathrm{sign}(y-z) = y-z \end{equation} It weighs each satisfaction or violation by its magnitude given by the absolute difference between the values. \subsection{Anti-Robinson events} An even simpler loss function can be created in the same way as the gradient measures above by concentrating on violations only. \begin{equation} L(\mathbf{D}) = \sum_{i y \quad \text{and} \\ 0 \quad \text{otherwise.} \end{cases} \end{equation} $I(\cdot)$ is an indicator function returning $1$ only for violations. \cite{seriation:Chen:2002} presented a formulation for an equivalent loss function and called the violations \emph{anti-Robinson events}. \cite{seriation:Chen:2002} also introduced a weighted versions of the loss function resulting in \begin{equation} f(z, y) = |y-z|I(z, y) \end{equation} using the absolute deviations as weights. \subsection{Hamiltonian path length} The dissimilarity matrix $\mathbf{D}$ can be represented as a finite weighted graph $G = (\Omega,E)$ where the set of objects~$\Omega$ constitute the vertices and each edge~$e_{ij} \in E$ between the objects $O_i, O_j \in \Omega$ has a weight~$w_{ij}$ associated which represents the dissimilarity~$d_{ij}$. Such a graph can be used for seriation~\citep[see, e.g.,][]{seriation:Hubert:1974,seriation:Caraux:2005}. An order~$\Psi$ of the objects can be seen as a path through the graph where each node is visited exactly once, i.e., a Hamiltonian path. Minimizing the Hamiltonian path length results in a seriation optimal with respect to dissimilarities between neighboring objects. The loss function based on the Hamiltonian path length is: \begin{equation} L(\mathbf{D}) = \sum_{i=1}^{n-1} d_{i,i+1}. \end{equation} Note that the length of the Hamiltonian path is equal to the value of the \emph{minimal span loss function} \citep[as used by][]{seriation:Chen:2002}, and both notions are related to the \emph{traveling salesperson problem}~\citep{seriation:Gutin:2002}. \subsection{Inertia criterion} Another way to look at the seriation problem is not to focus on placing small dissimilarity values close to the diagonal, but to push large values away from it. A function to quantify this is the moment of inertia of dissimilarity values around the diagonal \citep{seriation:Caraux:2005} defined as \begin{equation} M(\mathbf{D}) = \sum_{i=1}^n \sum_{j=1}^n d_{ij}|i-j|^2. \end{equation} $|i-j|^2$ is used as a measure for the distance to the diagonal and $d_{ij}$ gives the weight. This is a merit function since the sum increases when higher dissimilarity values are placed farther away from the diagonal. \subsection{Least squares criterion} Another natural loss function for seriation is to quantify the deviations between the dissimilarities in $\mathbf{D}$ and the rank differences of the objects. Such deviations can be measured, e.g, by the sum of squares of deviations \citep{seriation:Caraux:2005} defined by \begin{equation} L(\mathbf{D}) = \sum_{i=1}^n \sum_{j=1}^n (d_{ij} - |i-j|)^2, \end{equation} where $|i-j|$ is the rank difference or gap between $O_i$ and $O_j$. The least squares criterion defined here is related to uni-dimensional scaling~\citep{seriation:Leeuw:2005}, where the objective is to place all $n$ objects on a straight line using a position vector~$\mathbf{z} = z_1,z_2,\ldots,z_n$ such that the dissimilarities in $\mathbf{D}$ are preserved by the relative positions in the best possible way. The optimization problem of uni-dimensional scaling is to find the position vector~$\mathbf{z^*}$ which minimizes $\sum_{i=1}^n \sum_{j=1}^n (d_{ij} - |z_i-z_j|)^2$. This is close to the seriation problem, but in addition to the ranking of the objects also takes the distances between objects on the resulting scale into account. Note that if Euclidean distance is used to calculate $\mathbf{D}$ from a data matrix~$\mathbf{X}$, using the order of the elements in $\mathbf{X}$ as they occur projected on the first principal component of $\mathbf{X}$ minimizes the loss function of uni-dimensional scaling (using squared distances). Using this order, also provides a good solution for the least square seriation criterion. \subsection{Linear Seriation Criterion} The Linear Seriation Criterion (Hubert and Schultz 1976) weights the distances with the absolute rank differences. $$L(\mathbf{D}) \sum_{i=1}^n \sum_{j=1}^n d_{ij} (-|i-j|)$$ \subsection{2-Sum Problem} The 2-Sum loss criterion \citep{seriation:Barnard:1993} multiplies the similarity between objects with the squared rank differences. $$L(\mathbf{D}) \sum_{i,j=1}^p \frac{1}{1+d_{ij}} (i-j)^2,$$ where $s_{ij} = \frac{1}{1+d_{ij}}$ represents the similarity between objects $i$ and $j$. \subsection{Measure of effectiveness} \label{sec:ME} \cite{seriation:McCormick:1972} defined the \emph{measure of effectiveness (ME)} for an $n \times m$ matrix~$\mathbf{X} = (x_{ij})$ as \begin{equation} M(\mathbf{X}) = \frac{1}{2} \sum_{i=1}^{n} \sum_{j=1}^{m} x_{ij}[x_{i,j+1}+x_{i,j-1}+ x_{i+1,j}+x_{i-1,j}] \label{equ:ME} \end{equation} with, by convention $x_{0,j}=x_{n+1,j}=x_{i,0}=x_{i,m+1}=0$. ME is maximized if each element is as closely related numerically to its four neighboring elements as possible. ME was developed for two-way two-mode data, however, ME can also be used for a symmetric matrix (one-mode data) and gets maximal only if all large values are grouped together around the main diagonal. Note that the definition in equation~(\ref{equ:ME}) can be rewritten as \begin{equation} M(\mathbf{X}) = \frac{1}{2} \sum_{i=1}^{n} \sum_{j=1}^{m} x_{ij}[x_{i,j+1}+x_{i,j-1}] + \sum_{i=1}^{n} \sum_{j=1}^{m} x_{ij}[x_{i+1,j}+x_{i-1,j}] \end{equation} showing that the contributions of column and row order to the merit function are independent. \subsection{Stress} \label{sec:stress} Stress measures the conciseness of the presentation of a matrix (two-mode data) and can be seen as a purity function which compares the values in a matrix with their neighbors. The stress measures used here are computed as the sum of squared distances of each matrix entry from its adjacent entries. \cite{seriation:Niermann:2005} defined for an $n \times m$ matrix~$\mathbf{X} = (x_{ij})$ two types of neighborhoods: \begin{itemize} \item The Moore neighborhood comprises the (at most) eight adjacent entries. The local stress measure for element~$x_{ij}$ is defined as \begin{equation} \sigma_{ij} = \sum_{k=\max(1,i-1)}^{\min(n,i+1)} \sum_{l=\max(1,j-1)}^{\min(m,j+1)} (x_{ij} - x_{kl})^2 \end{equation} \item The Neumann neighborhood comprises the (at most) four adjacent entries resulting in the local stress of $x_{ij}$ of \begin{equation} \sigma_{ij} = \sum_{k=\max(1,i-1)}^{\min(n,i+1)} (x_{ij} - x_{kj})^2 + \sum_{l=\max(1,j-1)}^{\min(m,j+1)} (x_{ij} - x_{il})^2 %(x_{ij} - x(i-1,j))^2 + (x_{ij} - x(i+1,j))^2 + %(x_{ij} - x(i,j-1))^2 + (x_{ij} - x(i,j+1))^2 \end{equation} \end{itemize} Both local stress measures can be used to construct a global measure for the whole matrix by summing over all entries which can be used as a loss function: \begin{equation} L(\mathbf{X}) = \sum_{i=1}^n \sum_{j=1}^m \sigma_{ij} \end{equation} The major difference between the Moore and the Neumann neighborhood is that for the later the contributions of row and column order to stress are independent. Stress can be also used as a loss function for symmetric proximity matrices (one-mode data). %, %since it can only be optimal, if large values are %concentrated around the main diagonal. Note also, that stress with Neumann neighborhood is related to the measure of effectiveness defined above (in Section~\ref{sec:ME}) since both measures are optimal if for each cell the cell and its four neighbors are numerically as similar as possible. \section{Seriation methods} \label{sec:methods} Solving the discrete optimization problem for seriation with most loss/merit functions is clearly very hard. The number of possible permutations for $n$ objects is $n!$ which makes an exhaustive search for sets with a medium to large number of objects infeasible. In this section, we describe some methods (partial enumeration, heuristics and other methods) which are typically used for seriation. For each method we state for which type of loss/merit functions it is suitable and whether it finds the optimum or is a heuristic. For the implementation of various seriation methods see function~\func{seriate} in Section~\ref{sec:infrastructure}. \subsection{Partial enumeration methods} Partial enumeration methods search for the exact solution of a combinatorial optimization problem. Exploiting properties of the search space, only a subset of the enormous number of possible combinations has to be evaluated. Popular partial enumeration methods which are used for seriation are \emph{dynamic programming}~\citep{seriation:Hubert:2001} and \emph{branch-and-bound}~\citep{seriation:Brusco:2005}. Dynamic programming recursively searches for the optimal solution checking and storing $2^n-1$ results. Although $2^n-1$ grows at a lower rate than $n!$ and is for $n \gg 3$ considerably smaller, the storage requirements of $2^n-1$ results still grow fast, limiting the maximal problem size severely. For example, for $n=30$ more than one billion results have to be calculated and stored, clearly a number too large for the main memory capacity of most current computers. Branch-and-bound has only very moderate storage requirements. The forward-branching procedure~\citep{seriation:Brusco:2005} starts to build partial permutations from left (first position) to right. At each step, it is checked if the permutation is valid and several fathoming tests are performed to check if the algorithm should continue with the partial permutation. The most important fathoming test is the boundary test, which checks if the partial permutation can possibly lead to a complete permutation with a better solution than the currently best one. In this way large parts of the search space can be omitted. However, in contrast to the dynamic programming approach, the reduction of search space is strongly data dependent and poorly structured data can lead to very poor performance. With branch-and-bound slightly larger problems can be solved than with dynamic programming in reasonable time. \cite{seriation:Brusco:2005} state that depending on the data, in some cases proximity matrices with 40 or more objects can be handled with current hardware. Partial enumeration methods can be used to find the exact solution independently of the loss/merit function. However, partial enumeration is limited to only relatively small problems. \subsection{Traveling salesperson problem solver} Seriation by minimizing the length of a Hamiltonian path through a graph is equal to solving a traveling salesperson problem. The traveling salesperson or salesman problem (TSP) is a well known and well researched combinatorial optimization problem~\citep[see, e.g.,][]{seriation:Gutin:2002}. The goal is to find the shortest tour that, starting from a given city, visits each city in a given list exactly once and then returns to the starting city. In graph theory a TSP tour is called a \emph{Hamiltonian cycle.} But for the seriation problem, we are looking for a Hamiltonian path. \cite{seriation:Garfinkel:1985} described a simple transformation of the TSP to find the shortest Hamiltonian path. An additional row and column of 0's is added (sometimes this is referred to as a \emph{dummy city}) to the original $n \times n$ dissimilarity matrix~$\mathbf{D}$. The solution of this $(n+1)$-city TSP, gives the shortest path where the city representing the added row/column cuts the cycle into a linear path. As the general seriation problem, solving the TSP is difficult. In the seriation case with $n+1$ cities, $n!$ tours have to be checked. However, despite this vast searching space, small instances can be solved efficiently using dynamic programming \citep{seriation:Held:1962} and larger instances of several hundred objects can be solved using \emph{branch-and-cut} algorithms~\citep{seriation:Padberg:1990}. For even larger instances or if running time is critical, a wide array of heuristics are available, ranging from simple nearest neighbor approaches to construct a tour~\citep{seriation:Rosenkrantz:1977} to complex heuristics like the Lin-Kernighan heuristic~\citep{seriation:Lin:1973}. A comprehensive overview of heuristics and exact methods can be found in \cite{seriation:Gutin:2002}. \subsection{Bond energy algorithm} The \emph{bond energy algorithm}~\citep[BEA;][]{seriation:McCormick:1972} is a simple heuristic to rearrange columns and rows of a matrix (two-way two-mode data) such that each entry is as closely numerically related to its four neighbors as possible. To achieve this, BEA tries to maximize the measure of effectiveness (ME) defined in Section~\ref{sec:ME}. For optimizing the ME, columns and rows can be treated separately since changing the order of rows does not influence the ME contributions of the columns and vice versa. BEA consists of the following three steps: \begin{enumerate} \item Place one randomly chosen column. \item Try to place each remaining column at each possible position left, right and between the already placed columns and calculate every time the increase in ME. Choose the column and position which gives the largest increase in ME and place the column. Repeat till all columns are placed. \item Repeat procedure with rows. \end{enumerate} This greedy algorithm works fast and only depends on the choice of the first column/row. This dependence can be reduced by repeating the procedure several times with different choices and returning the solution with the highest ME. Although \cite{seriation:McCormick:1972} use BEA also for non-binary data, \cite{seriation:Arabie:1990} argue that the measure of effectiveness only serves its intended purpose of finding an arrangement which is close to Robinson form for binary data and should therefore only be used for binary data. \cite{seriation:Lenstra:1974} notes that the optimization problem of BEA can be stated as two independent traveling salesperson problems (TSPs). For example, the row TSP for an $n \times m$ matrix~$\mathbf{X}$ consists of $n$ cities with an $n \times n$ distance matrix~$\mathbf{D}$ where the distances are \begin{displaymath} d_{ij} = -\sum_{k=1}^m x_{ik}x_{jk}. \end{displaymath} BEA is in fact a simple suboptimal TSP heuristic using this distances and instead of BEA any TSP solver can be used to obtain an order. With an exact TSP solver, the optimal solution can be found. \subsection{Hierarchical clustering} \label{sec:hierarchical_clustering} Hierarchical clustering produces a series of nested clusterings which can be visualized by a dendrogram, a tree where each internal node represents a split into subtrees and has a measure of similarity/dissimilarity attached to it. As a simple heuristic to find a linear order of objects, the order of the leaf nodes in a dendrogram structure can be used. This idea is used, e.g., by heat maps to reorder rows and columns with the aim to place more similar objects and variables closer together. %For hierarchical clustering several methods are available (e.g., %single linkage, average linkage, complete linkage, ward method) resulting in %different dendrograms. %However, The order of leaf nodes in a dendrogram is not unique. A binary (two-way splits only) dendrogram for $n$ objects has $2^{n-1}$ internal nodes and at each internal node the left and right subtree (or leaves) can be swapped resulting in $2^{n-1}$ distinct leaf orderings. To find a unique or optimal order, an additional criterion has to be defined. \cite{seriation:Gruvaeus:1972} suggest to obtain a unique order by requiring to order the leaf nodes such that at each level the objects at the edge of each cluster are adjacent to that object outside the cluster to which it is nearest. \cite{seriation:Bar-Joseph:2001} suggest to rearrange the dendrogram such that the Hamiltonian path connecting the leaves is minimized and called this the optimal leaf order. The authors also present a fast algorithm with time complexity $O(n^4)$ to solve this optimization problem. Note that this problem is related to the TSP described above, however, the given dendrogram structure significantly reduces the number of permissible permutations making the problem easier. Although hierarchical clustering solves an optimization problem different to the seriation problem discussed in this paper, hierarchical clustering still can produce useful orderings, e.g., for visualization. \subsection{Rank-two ellipse seriation} \cite{seriation:Chen:2002} proposes to generate a sequence of correlation matrices $R^1, R^2, \ldots$. $R^1$ is the correlation matrix of the original distance matrix $\mathbf{D}$ and \begin{equation} R^{n+1} = \phi R^n, \end{equation} where $\phi(\cdot)$ calculates a correlation matrix. \cite{seriation:Chen:2002} shows that the rank of the matrix $R^n$ falls with increasing $n$ and that if the sequence is continued till the first matrix in the sequence has a rank of 2, projecting all points in this matrix on its first two eigenvectors, all points will fall on an ellipse. \cite{seriation:Chen:2002} suggests to use the order of the points on this ellipse as a seriation where the ellipse can be cut at any of the two interception points (top or bottom) with the vertical axis. Although the rank-two ellipse seriation procedure does not try to solve a combinatorial optimization problem, it still provides for some cases a useful ordering. \subsection{Spectral Seriation} Spectral seriation uses a relaxation to minimize the 2-Sum Problem \citep{seriation:Barnard:1993}. Rewriting the minimization problem using a permutation vector $\pi$, its inverse, rescaling to $\mathrm{q}$ and using a Lagrangian multiplier for the constraint on the permutation yields \citep{seriation:Ding:2004} the following equivalent optimization problem: $$\mathrm{min}_\mathbf{q} \frac{\mathbf{q}^T L_\mathbf{S}\mathbf{q}}{\mathbf{q}^T\mathbf{q}}$$ where $L_\mathbf{S}$ is the Laplacian of $\mathbf{S}$. The optimal order can be recovered by the sorting order of the Fiedler vector (i.e., the second smallest eigenvector of the Laplacian of the similarity matrix). \subsection{Quadratic Assignment Problem} Both, the linear seriation criterion and the 2-Sum problem formulation can be written as a Quadratic Assignment Problem (QAP). However, the QAP is in general NP-hard. Methods include QIP, linearization, branch and bound and cutting planes as well as heuristics including Tabu search, simulated annealing, genetic algorithms, and ant systems \citep{seriation:Burkard:1998}. \section{The package infrastructure} \label{sec:infrastructure} The \pkg{seriation} package provides the data structures and some algorithms to efficiently handle seriation with \proglang{R}. As the input data for seriation \proglang{R} already provides \begin{itemize} \item for two-way one-mode data the class \code{dist}, \item for two-way two-mode data the class \code{matrix}, and \item for $k$-way $k$-mode data the class \code{array}. \end{itemize} \begin{figure}[tp] \centerline{ %\includegraphics[width=12cm]{infrastructure}} \includegraphics[width=10cm]{classes}} \caption{UML class diagram of the data structures for permutations provided by \pkg{seriation}} \label{fig:infrastructure} \end{figure} However, \proglang{R} provides no classes for representing permutation vectors. \pkg{seriation} adds the necessary data structure (using the S3 class system) as depicted in the UML class diagram \citep{seriation:Fowler:2004} in Figure~\ref{fig:infrastructure}. In this diagram classes are represented by rectangles and different symbols are used to state the type of relationship between the classes. The class \code{ser\_permutation} in Figure~\ref{fig:infrastructure} represents the permutation information for $k$-mode data (including the cases of $k=1$ and $k=2$). It consists of $k$ permutation vectors (class \code{ser\_permutation\_vector}). This relationship is represented by the solid diamond and the star above the connection between the two classes. Class \code{ser\_permutation\_vector} is defined \emph{abstract} and only its concrete implementations (classes connected with the triangle symbol) are used to store a permutation vector. This design with an abstract class was chosen to allow to use different representations for the permutation vectors. Currently, the permutation vector can be stored as a simple integer vector or as an object of class \code{hclust} (defined in package \pkg{stats}). \code{hclust} describes a hierarchical clustering tree (dendrogram) including an ordering for the tree's node leaves which provides a permutation for all objects (see Section~\ref{sec:hierarchical_clustering}). Class \code{ser\_permutation\_vector} has a constructor \func{ser\_permutation\_vector} which converts data into the correct concrete subclass of \code{ser\_permutation\_vector} and checks if it contains a proper permutation vector. For \code{ser\_permutation\_vector} the methods \func{print}, \func{length} for the length of the permutation vector, \func{get\_method} to get the method used to generate the permutation, and \func{get\_order} to access the raw (integer) permutation vector are available. To use an additional class to represent permutations as a concrete subclass of \code{ser\_permutation\_vector} only an appropriate accessor method \func{get\_order} has to be implemented for the new class. For \code{ser\_permutation} a constructor is provided which can bind $k$ \code{ser\_permutation\_vector} objects together into an object for $k$-mode data. \code{ser\_permutation} is implemented as a list of length~$k$ and each element contains a \code{ser\_permutation\_vector} object. Methods like \func{length}, accessing elements with \code{[[}, % ]] \code{[[<-}, % ]] subsetting with \code{[}, and combining with \func{c} work as expected. Also a \func{print} method is provided. Finally, direct access to the raw permutation vectors is available using \func{get\_order}. Here a second argument (which defaults to $1$) specifies the dimension (mode) for which the order vector is requested. All seriation algorithms are available via the function \func{seriate} defined as: \begin{quotation} \code{seriate(x, method = NULL, control = NULL, ...)} \end{quotation} where \code{x} is the input data, \code{method} is a string defining the seriation method to be used and \code{control} can contain a list with additional information for the algorithm. \func{seriate} returns an object of class \code{ser\_permutation} with a length conforming to the number of dimensions of~\code{x}. Typical input data are a dissimilarity matrix (class~\code{dist}; see package \pkg{stats} for more information) for one-mode two-way data, \code{matrix} for two-mode two-way data and \code{array} for $k$-mode $k$-way data. For \code{matrix} and \code{array} the additional argument \code{margin} can be used to restrict the dimensions which should be seriated (e.g., with \code{margin = 1} only the first dimension, i.e., the columns of a matrix, are seriated). %\begin{landscape} \begin{table}[tp] \centering \begin{tabular}{p{5cm}p{3cm}p{4cm}l} \hline Algorithm & \code{method} & Optimizes & Input data \\ \hline Simulated annealing & \code{"ARSA"} & Linear seriation crit.&\code{dist} \\ Branch-and-bound & \code{"BBURCG"} & Gradient measure &\code{dist} \\ Branch-and-bound & \code{"BBWRCG"} & Gradient measure (weighted)& \code{dist} \\ TSP solver & \code{"TSP"} & Hamiltonian path length& \code{dist} \\ Optimal leaf ordering & \code{"OLO"} \code{"OLO_single"} \code{"OLO_average"} \code{"OLO_complete"} & Hamiltonian path length (restricted)& \code{dist} \\ Gruvaeus and Wainer & \code{"GW"} \code{"GW_single"} \code{"GW_average"} \code{"GW_complete"} & Hamiltonian path length (restricted) & \code{dist} \\ MDS & \code{"MDS"} \code{"MDS_metric"} \code{"MDS_nonmetric"} \code{"MDS_angle"} & Least square crit.& \code{dist} \\ Spectral seriation & \code{"Spectral"} \code{"Spectral_norm"} & 2-Sum crit. & \code{dist} \\ QAP & \code{"QAP_2SUM"} & 2-Sum crit. & \code{dist} \\ & \code{"QAP_LS"} & Linear seriation crit. & \code{dist} \\ & \code{"QAP_BAR"} & Banded AR form & \code{dist} \\ & \code{"QAP_Inertia"} & Inertia crit. & \code{dist} \\ Genetic Algorithm & \code{"GA"}* & various & \code{dist} \\ DendSer & \code{"DendSer"}* & various & \code{dist} \\ Hierarchical clustering & \code{"HC"} \code{"HC_single"} \code{"HC_average"} \code{"HC_complete"} & Other& \code{dist} \\ Rank-two ellipse seriation & \code{"R2E"} & Other& \code{dist} \\ Sorting Points Into Neighborhoods & \code{"SPIN_NH"} \code{"SPIN_STS"} & Other& \code{dist} \\ Visual Assessment of (Clustering) Tendency & \code{"VAT"}& Other& \code{dist} \\ \hline Bond Energy Algorithm & \code{"BEA"} & Measure of effectiveness & \code{matrix} \\ TSP to optimize ME & \code{"BEA\_TSP"} & Measure of effectiveness& \code{matrix} \\ Principal component analysis& \code{"PCA"} \code{"PCA_angle"}& Least square crit.& \code{matrix} \\ \hline \end{tabular} \caption{Currently implemented methods for \func{seriation} (* methods need to be registered).} \label{tab:methods} \end{table} %\end{landscape} Various seriation methods were already introduced in this paper in Section~\ref{sec:methods}. In Table~\ref{tab:methods} we summarize the methods currently available in the package for seriation. The code for the simulated annealing heuristic~\citep{seriation:Brusco:2007} and the two branch-and-bound implementations~\citep{seriation:Brusco:2005} was obtained from the authors. The TSP solvers (exact solvers and a variety of heuristics) is provided by package \pkg{TSP}~\citep{seriation:Hahsler:2007, seriation:Hahsler:2007b}. For optimal leaf ordering we implemented the algorithm by~\cite{seriation:Bar-Joseph:2001}. The BEA code was kindly provided by Fionn Murtagh. For the Gruvaeus and Wainer algorithm, the implementation in package \pkg{gclus}~\citep{seriation:Hurley:2007} is used. For the rank-two ellipse seriation we implemented the algorithm by~\cite{seriation:Chen:2002}. Spectral seriation is described by~\cite{seriation:Ding:2004}. Note that some methods implemented (e.g., the rank-two ellipse seriation) do not fall within the combinatorial optimization framework of this paper and thus are not dealt with here in detail. They are included in the package since they can be useful for various applications. A detailed empirical comparison of seriation methods and criteria can be found in the study by \cite{hahsler:Hahsler2016d}. %Over time more methods will be %added to the package. To calculate the value of a loss/merit function for data and a certain permutation, the function \begin{quotation} \code{criterion(x, order = NULL, method = NULL, ...)} \end{quotation} is provided. \code{x} is the data object, \code{order} contains a suitable object of class \code{ser\_permutation} (if omitted no permutation is performed) and \code{method} specifies the type of loss/merit function. A vector of several methods can be used resulting in a named vector with the values of the requested functions. If \code{method} is omitted (\code{method = NULL}), the values for all applicable loss/merit functions are calculated and returned. We already defined different loss/merit functions for seriation in Section~\ref{sec:seriation}. In Table~\ref{tab:criteria} we indicate the loss/merit functions currently available in the package. \begin{table}[t] \centering \begin{tabular}{llll} \hline Name & \code{method} & merit/loss & Input data \\ \hline Anti-Robinson events& \code{"AR\_events"} & loss & \code{dist} \\ Anti-Robinson deviations& \code{"AR\_deviations"} & loss & \code{dist} \\ Banded Anti-Robinson& \code{"BAR"} & loss & \code{dist} \\ Gradient measure& \code{"Gradient\_raw"} & merit & \code{dist} \\ Gradient measure (weighted)& \code{"Gradient\_weighted"} & merit & \code{dist} \\ Hamiltonian path length & \code{"Path\_length"} & loss & \code{dist} \\ Inertia criterion& \code{"Inertia"} & merit & \code{dist} \\ Least squares criterion& \code{"Least\_squares"} & loss & \code{dist} \\ Linear Seriation criterion& \code{"LS"} & loss & \code{dist} \\ 2-Sum criterion& \code{"2SUM"} & loss & \code{dist} \\ \hline Measure of effectiveness& \code{"ME"} & merit & \code{matrix} \\ Stress (Moore neighborhood)& \code{"Moore\_stress"} & loss & \code{matrix} \\ Stress (Neumann neighborhood)& \code{"Neumann\_stress"} & loss & \code{matrix} \\ \hline \end{tabular} \caption{Implemented loss/merit functions in function \func{criterion}.} \label{tab:criteria} \end{table} All methods for \func{seriate} and \func{criterion} are managed by a registry mechanism which makes the seriation framework easily extensible for users. For example, a new seriation method can be registered using \func{set\_seriation\_method} and then used in the same way as the built-in methods with \func{seriate}. All available methods in the registry can be viewed using \func{list\_seriation\_methods} and \func{show\_seriation\_methods}. For criterion methods, the same interface is available by just substituting `seriation' by `criterion' in the function names. An example for how to add new methods can be found in section~\ref{sec:registering} of this paper. In addition the package offers the (generic) function \begin{quotation} \code{permute(x, order)} \end{quotation} where \code{x} is the data (a \code{dist} object, a matrix, an array, a list or a numeric vector) to be reordered and \code{order} is a \code{ser\_permutation} object of suitable length. %The permutation for %\code{dist} objects uses package \pkg{proxy}~\citep{seriation:Meyer:2007}. For visualization, the package offers several options: \begin{itemize} \item Matrix shading with \func{pimage}. In contrast to the standard \func{image} in package~\pkg{graphics}, \func{pimage} displays the matrix as is with the first element in the top left-hand corner and using a gamma-corrected gray scale. \item Different heat maps (e.g., with optimally reordered dendrograms) with \func{hmap}. \item Visualization of data matrices in the spirit of~\cite{seriation:Bertin:1981} with \func{bertinplot}. \item \emph{Dissimilarity plot}, a new visualization to judge the quality of a clustering using matrix shading and seriation with \func{dissplot}. \end{itemize} We will introduce the package usage and the visualization options in the examples in the next section. \section{Examples and applications} \label{sec:example} We start this section with a simple first session to demonstrate the basic usage of the package. Then we present and discuss several seriation applications. \subsection{A first session using seriation} In the following example, we use the well known iris data set (from \proglang{R}'s \pkg{datasets} package) which gives the measurements in centimeters of the variables sepal length and width and petal length and width, respectively, for 50 flowers from each of 3 species of the iris family (Iris Setosa, Versicolor and Virginica). First, we load the package \pkg{seriation} and the iris data set. We remove the species classification and reorder the objects randomly since they are already sorted by species in the data set. Then we calculate the Euclidean distances between objects. <>= set.seed(1234) @ <<>>= library("seriation") data("iris") x <- as.matrix(iris[-5]) x <- x[sample(seq_len(nrow(x))),] d <- dist(x) @ To seriate the objects given the dissimilarities, we just call \func{seriate} with the default settings. <<>>= o <- seriate(d) o @ The result is an object of class \code{ser\_permutation} for one-mode data. The permutation vector length is $150$ for the $150$ objects in the iris data set and the used seriation method is \code{"ARSA"}, a simulated annealing heuristic (see~Table~\ref{tab:methods}). The actual order can be accessed using \func{get\_order}. In the following we show the first 15 elements in the permutation vector. <<>>= head(get_order(o), 15) @ To visually inspect the effect of seriation on the distance matrix, we use matrix shading with \func{pimage} (the result is shown in Figure~\ref{fig:pimage1}). <>= pimage(d, main = "Random") @ <>= pimage(d, o, main = "Reordered") @ \begin{figure} \centering \includegraphics[width=7.5cm]{seriation-pimage1} \includegraphics[width=7.5cm]{seriation-pimage1-2} \caption{Matrix shading of the distance matrix for the iris data.} \label{fig:pimage1} \end{figure} We can also compare the improvement for different loss/merit functions using \func{criterion}. <<>>= cbind(random = criterion(d), reordered = criterion(d, o)) @ Naturally, the reordered dissimilarity matrix achieves better values for all criteria. Note that the gradient measures, inertia and the measure of effectiveness are merit functions and for these measures larger values are better (use \code{show\_criterion\_methods("dist")} to find out which measures are loss and merit functions). To visually compare the original data matrix and the result of seriation, we can also use \func{pimage}. We standardize the data using scale such that the visualized value is the number of standard deviations an object differs from the variable mean. For matrices containing negative values, \code{pimage} uses automatically a divergent palette. After using \func{pimage} for the original random data matrix, we create a suitable \code{ser\_permutation} object for the original two-mode data. Since the seriation above only produced an order for the rows of the data, we add an identity permutation vector for the columns (represented by \code{NA}) to the permutations object using the combine function \func{c}. This new permutation object for $2$-mode data is used for displaying the reordered scaled data. The two plots are shown in Figure~\ref{fig:pimage2}. <>= pimage(scale(x), main = "Random", prop = FALSE) @ <>= o_2mode <- c(o, NA) pimage(scale(x), o_2mode, main = "Reordered", prop = FALSE) @ \begin{figure} \centering \includegraphics[width=7.5cm]{seriation-pimage2} \includegraphics[width=7.5cm]{seriation-pimage2-2} \caption{Matrix shading of the iris data matrix.} \label{fig:pimage2} \end{figure} \subsection{Comparing different seriation methods} To compare different seriation methods we use again the randomized iris data set and the distance matrix \code{d} from the previous example. We include in the comparison several seriation methods for dissimilarity matrices described in Section~\ref{sec:methods}. <<>>= methods <- c("TSP","R2E", "ARSA", "HC", "GW", "OLO") o <- sapply(methods, FUN = function(m) seriate(d, m)) @ <>= timing <- sapply(methods, FUN = function(m) system.time(seriate(d, m)), simplify = FALSE) @ \begin{table} \centering \begin{tabular}{lcccccc} \hline Seriation Method & \Sexpr{methods[1]}& \Sexpr{methods[2]}& \Sexpr{methods[3]}& \Sexpr{methods[4]}& \Sexpr{methods[5]}& \Sexpr{methods[6]} \\ \hline Execution time [sec] & \Sexpr{round(timing[[methods[1]]][1],4)}& \Sexpr{round(timing[[methods[2]]][1],4)}& \Sexpr{round(timing[[methods[3]]][1],4)}& \Sexpr{round(timing[[methods[4]]][1],4)}& \Sexpr{round(timing[[methods[5]]][1],4)}& \Sexpr{round(timing[[methods[6]]][1],4)}\\ \hline \end{tabular} %%% fix me: for the vignette we need something else \caption{Execution time of seriation of the iris data set for different methods.} \label{tab:timings} \end{table} Table~\ref{tab:timings} contains the execution times for running seriation with the different methods. Except for the simulated annealing method (ARSA) the seriation only takes a fraction of a second. The direction of the resulting orderings is first normalized (aligned) and then the orderings are displayed using matrix shading (see Figure~\ref{fig:pimage3}). <>= o <- ser_align(o) for(s in o) pimage(d, s, main = get_method(s), key = FALSE) @ <>= o <- ser_align(o) for(i in 1:length(o)) { pdf(file=paste("seriation-pimage_comp_", i , ".pdf", sep="")) pimage(d, o[[i]], main = get_method(o[[i]]), key = FALSE) dev.off() } @ \begin{figure} \centering \includegraphics[width=.3\linewidth]{seriation-pimage_comp_1.pdf} \includegraphics[width=.3\linewidth]{seriation-pimage_comp_2.pdf} \includegraphics[width=.3\linewidth]{seriation-pimage_comp_3.pdf}\\ \includegraphics[width=.3\linewidth]{seriation-pimage_comp_4.pdf} \includegraphics[width=.3\linewidth]{seriation-pimage_comp_5.pdf} \includegraphics[width=.3\linewidth]{seriation-pimage_comp_6.pdf} \caption{Image plot of the distance matrix for the iris data using rearrangement by different seriation methods.} \label{fig:pimage3} \end{figure} The first row of matrices in Figure~\ref{fig:pimage3} contains the orders obtained by a TSP solver the rank-two ellipse seriation by Chen and using the simulated annealing method (ARSA). The results of Chen and ARSA are very similar (except that the order is reversed). The TSP solver produces a smoother image with some lighter lines visible. The reason for these lines is that the TSP only optimizes distances locally between two neighboring objects. Therefore it is possible that in a quite homogeneous block several objects are enclosed gradually getting more different and then getting more similar again (see, e.g., the light line close to the upper left corner of the TSP image in Figure~\ref{fig:pimage3}). The second row of Figure~\ref{fig:pimage3} contains three images based on hierarchical clustering. The visual impression gets better from left (just hierarchical clustering) to right (first using the Gruvaeus Wainer heuristic and then optimal leaf ordering to rearrange the branches of the dendrogram obtained by hierarchical clustering). The most striking feature in the image for hierarchical clustering (HC in Figure~\ref{fig:pimage3}) is the distinct cross going right through the center of the plot. This indicates that several relatively dissimilar objects are caught in an otherwise homogeneous block. This effect vanishes after rearranging the dendrogram branches (see GW and OLO in Figure~\ref{fig:pimage3}). %' To investigate this effect, %' we plot the dendrogram obtained by hierarchical clustering which is used %' to order the objects and compare it to the dendrogram rearranged %' using the Gruvaeus Wainer heuristic. %' %' <>= %' plot(o[["HC"]], labels = FALSE, main = "Dendrogram HC") %' plot(o[["GW"]], labels = FALSE, main = "Dendrogram GW") %' @ %' <>= %' def.par <- par(no.readonly = TRUE) %' pdf(file="seriation-pimage3_dendrogram.pdf", width=9, height=4) %' layout(t(1:2)) %' plot(o[["HC"]], labels = FALSE, main = "Dendrogram HC") %' symbols(74.7,.5, rect = matrix(c(4, 3), ncol=2), add= TRUE, %' inches = FALSE, lwd =2) %' %' plot(o[["GW"]], labels = FALSE, main = "Dendrogram GW") %' symbols(98.7,.5, rect = matrix(c(4, 3), ncol=2), add= TRUE, %' inches = FALSE, lwd =2) %' par(def.par) %' tmp <- dev.off() %' @ %' %' \begin{figure} %' \centering %' \includegraphics[width=\linewidth, trim=0 80 0 0, clip=TRUE]{seriation-pimage3_dendrogram} %' \caption{Dendrograms for the seriation with HC and GW.} %' \label{fig:pimage3_dendrogram} %' \end{figure} %' %' Comparing the two dendrograms in Figure~\ref{fig:pimage3_dendrogram}, we see %' that the branch left from the top is almost unchanged. The branch which is %' responsible for the light cross in the shaded image is highlighted by a box. %' The Gruvaeus Wainer heuristic rotates the highlighted branch towards the right %' since the objects in it are more similar to the objects in there. Finally, we compare the values of the loss/merit functions for the different seriation methods. <<>>= crit <- sapply(o, FUN = function(x) criterion(d, x)) t(crit) @ <>= def.par <- par(no.readonly = TRUE) m <- c("Path_length", "AR_events", "Moore_stress") layout(matrix(seq_along(m), ncol=1)) #tmp <- apply(crit[m,], 1, dotchart, sub = m) tmp <- lapply(m, FUN = function(i) dotchart(crit[i,], sub = i)) par(def.par) @ \begin{figure} \centering \includegraphics[width=14cm]{seriation-crit1} \caption{Comparison of different methods and seriation criteria} \label{fig:crit1} \end{figure} For easier comparison, Figure~\ref{fig:crit1} contains a plot of the criteria Hamiltonian path length, anti-Robinson events (\code{AR\_events}) and stress using the Moore neighborhood. Clearly, the methods which directly try to minimize the Hamiltonian path length (hierarchical clustering with optimal leaf ordering (\code{OLO}) and the TSP heuristic) provide the best results concerning the path length. For the number of anti-Robinson events, using the simulated annealing heuristic (\code{ARSA}) provides the best result. Regarding stress, the simulated annealing heuristic also provides the best result although, it does not directly minimize this loss function. \subsection{Registering new methods} \label{sec:registering} New methods to calculate criterion values and to compute a seriation can be easily added by the user via the method registry mechanism provided in \pkg{seriation}. Here we give a simple example of how to implement and register a new seriation method. In the registry we distinguish between methods for different types of input data. With the following two commands we produce a list of the available seriation methods for input data of class \code{dist} and \code{matrix}. <<>>= list_seriation_methods("dist") list_seriation_methods("matrix") @ To get detailed information on a seriation method use the following. <<>>= get_seriation_method("dist", name = "ARSA") @ To add a new seriation method, we first have to implement the seriation code as a function with the two formal arguments \code{x} and \code{control}, and for arrays also an additional argument \code{margin}. \code{x} is the data object and \code{control} contains a list with additional information for the method passed on from \func{seriate}. The function has to return a list of objects which can be coerced into \code{ser\_permutation\_vector} objects (e.g., a list of integer vectors). The elements in the list have to be in order corresponding to the dimensions of \code{x}. In this example we just create a method to return a permutation which reverses the original order of the objects, i.e., which returns the reverse identity order. <<>>= seriation_method_reverse <- function(x, control = NULL, margin = seq_along(dim(x))) { lapply(seq_along(dim(x)), function(i) if (i %in% margin) rev(seq(dim(x)[i])) else NA) } @ The function produces integer sequences of the correct lengths, one for each dimension of \code{x} (\code{control} is not used). Since the function works for \code{matrix} and \code{array} we can register it for both data types under the short name `Reverse'. <<>>= set_seriation_method("matrix", "New_Reverse", seriation_method_reverse, "Reverse identity order") set_seriation_method("array", "New_Reverse", seriation_method_reverse, "Reverse identity order") @ Now the new seriation method is registered and can be found by the user and applied to data. <<>>= list_seriation_methods("matrix") o <- seriate(matrix(1, ncol = 3, nrow = 4), "New_Reverse") o get_order(o, 1) get_order(o, 2) @ Criterion methods can be added in the same way. We refer the interested reader to the documentation accompanying the package for detailed information and an example. If you have implemented a new criterion or seriation method, please consider submitting the code to one of the maintainers of \pkg{seriation} for inclusion in a future release of the package. \subsection{Heat maps} A heat map is a shaded/color coded data matrix with a dendrogram added to one side and to the top to indicate the order of rows and columns. Typically, reordering is done according to row or column means within the restrictions imposed by the dendrogram. Heat maps recently became popular for visualizing large scale genome expression data obtained via DNA microarray technology \citep[see, e.g.,][]{seriation:Eisen:1998}. From Section~\ref{sec:hierarchical_clustering} we know that it is possible to find the optimal ordering of the leaf nodes of a dendrogram which minimizes the distances between adjacent objects in reasonable time. Such an order might provide an improvement over using simple reordering such as the row or column means with respect to presentation. In \pkg{seriation} we provide the function \func{hmap} which uses optimal ordering and can also use seriation directly on distance matrices without using hierarchical clustering to produce dendrograms first. For the following example, we use again the randomly reordered iris data set \code{x} from the examples above. To make the variables (columns) comparable, we use standard scaling. <<>>= x <- scale(x, center = FALSE) @ To produce a heat map with optimally reordered dendrograms (using by default Optimal Leaf Ordering), the function \func{hmap} can be used with its default settings. <>= hmap(x, margin = c(7, 4), cexCol = 1, row_labels = FALSE) @ With these settings, the Euclidean distances between rows and between columns are calculated (with \func{dist}), hierarchical clustering (\func{hclust}) is performed, the resulting dendrograms are optimally reordered, and \func{heatmap.2} in package \pkg{gplots} is used for plotting (see Figure~\ref{fig:heatmap}(a) for the resulting plot). <>= hmap(x, method = "MDS") @ If a seriation method is used that does not depend on dendrograms, instead of hierarchical clustering, seriation on the dissimilarity matrices for rows and columns is performed and the reordered matrix with the reordered dissimilarity matrices to the left and on top is displayed (see Figure~\ref{fig:heatmap}(b)). A \code{method} argument can be used to choose different seriation methods. <>= #bitmap(file = "seriation-heatmap1.png", type = "pnggray", # height = 6, width = 6, res = 300, pointsize=14) pdf(file = "seriation-heatmap1.pdf") hmap(x, margin = c(7, 4), row_labels = FALSE, cexCol = 1) tmp <- dev.off() @ <>= pdf(file = "seriation-heatmap2.pdf") hmap(x, method="MDS") tmp <- dev.off() @ \begin{figure} \begin{minipage}[b]{.48\linewidth} \centering \includegraphics[width=\linewidth]{seriation-heatmap1} \\ (a) \end{minipage} \begin{minipage}[b]{.48\linewidth} \centering \includegraphics[width=\linewidth]{seriation-heatmap2} \\ (b) \end{minipage} \caption{Two presentations of the rearranged iris data matrix. (a) as an optimally reordered heat map and (b) as a seriated data matrix with reordered dissimilarity matrices to the left and on top.} \label{fig:heatmap} \end{figure} \subsection{Bertin's permutation matrix} \cite{seriation:Bertin:1981,seriation:Bertin:1999} introduced permutation matrices to analyze multivariate data with medium to low sample size. The idea is to reveal a more homogeneous structure in a data matrix~$\mathbf{X}$ by simultaneously rearranging rows and columns. The rearranged matrix is displayed and cases and variables can be grouped manually to gain a better understanding of the data. %To quantify homogeneity, a purity function %\begin{displaymath} % \phi = \Phi(\mathbf{X}) %\end{displaymath} %is defined. Let $\Pi$ be the set of all permutation functions %$\pi$ for matrix $\mathbf{X}$. %Note that function $\pi$ performs row and column permutations on a matrix. %The optimal permutation with respect to %purity can be found by %\begin{displaymath} % \pi^* = \argmax\nolimits_{\pi \in \Pi} \Phi(\pi(\mathbf{X})). %\end{displaymath} %Since, depending on the purity function, finding the optimal %solution can be hard, often a near optimal solution is also acceptable %for visualization. % %A possible purity function $\Phi$ is: %Given distances between rows and columns of the data matrix, define purity as %the sum of distances of adjacent rows/columns. Using this purity function, %finding the optimal permutation $\pi^*$ means solving two (independent) TSPs, %one for the columns and one for the rows. To find a rearrangement of columns and rows which reveals structure a purity function is used. A possible purity function is: Given distances between rows and columns of the data matrix, define purity as the sum of distances of adjacent rows/columns. Using this purity function, finding the optimal permutation means solving two (independent) TSPs, one for the columns and one for the rows which can be done very conveniently using the infrastructure provided by \pkg{seriation}. As an example, we use the results of $8$ constitutional referenda for $41$ Irish communities~\citep{seriation:Falguerolles:1997}\footnote{The Irish data set is included in this package. The original data and the text of the referenda can be obtained from~\url{http://www.electionsireland.org/}}. To make values comparable across columns (variables), the ranks of the values for each variable are used instead of the original values. <<>>= data("Irish") orig_matrix <- apply(Irish[,-6], 2, rank) @ For seriation, we calculate distances between rows and between columns using the sum of absolute rank differences (this is equal to the Minkowski distance with power $1$). Then we apply seriation (using a TSP heuristic) to both distance matrices and combine the two resulting \code{ser\_permutation} objects into one object for two-mode data. The original and the reordered matrix are plotted using \func{bertinplot}. <<>>= o <- c( seriate(dist(orig_matrix, "minkowski", p = 1), method = "TSP"), seriate(dist(t(orig_matrix), "minkowski", p = 1), method = "TSP") ) o @ In a newer version of the package this can be also done with the new heatmap seriation method for matrices. <<>>= get_seriation_method("matrix", name = "heatmap") o <- seriate(orig_matrix, method = "heatmap", dist_fun = function(d) dist(d, "minkowski", p = 1), seriation_method = "TSP") o @ <>= bertinplot(orig_matrix) bertinplot(orig_matrix, o) @ <>= bertinplot(orig_matrix) @ <>= bertinplot(orig_matrix, o) @ \begin{figure} \centering \includegraphics[width=15cm, trim=60 60 0 0]{seriation-bertin1} \\ (a) \includegraphics[width=15cm, trim=60 60 0 0]{seriation-bertin2} \\ (b) \caption{Bertin plot for the (a) original arrangement and the (b) reordered Irish data set.} \label{fig:bertin} \end{figure} The original matrix and the rearranged matrix are shown in Figure~\ref{fig:bertin} as a matrix of bars where high values are highlighted (filled blocks). Note that following Bertin, the cases (communities) are displayed as the columns and the variables (referenda) as rows. Depending on the number of cases and variables, columns and rows can be exchanged to obtain a better visualization. Although the columns are already ordered (communities in the same city appear consecutively) in the original data matrix in Figure~\ref{fig:bertin}(a), it takes some effort to find structure in the data. For example, it seems that the variables `Marriage', `Divorce', `Right to Travel' and `Right to Information' are correlated since the values are all high in the block made up by the columns of the communities in Dublin. The reordered matrix confirms this but makes the structure much more apparent. Especially the contribution of low values (which are not highlighted) to the overall structure becomes only visible after rearrangement. \subsection{Binary data matrices} Binary or $0$-$1$ data matrices are quite common. Often such matrices are called \emph{incidence matrices} since a $1$ in a cell indicates the incidence of an event. In archaeology such an event could be that a special type of artifact was found at a certain archaeological site. This can be seen as a simplification of a so-called \emph{abundance matrix} which codes in each cell the (relative) frequency or quantity of an artifact type at a site. See \cite{seriation:Ihm:2005} for a comparison of incidence and abundance matrices in archaeology. Here we are interested in binary data. For the example we use an artificial data set from~\cite{seriation:Bertin:1981} called \emph{Townships}. The data set contains $9$ binary characteristics (e.g., has a veterinary or has a high school) for $16$ townships. The idea of the data set is that townships evolve from a rural to an urban environment over time. After loading the data set (which comes with the package), we use \func{bertinplot} to visualize the data (\func{pimage} could also be used but \func{bertinplot} allows for a nicer visualization). Bars, the standard visualization of \func{bertinplot}, do not make much sense for binary data. We therefore use the panel function \func{panel.squares} without spacing to plot black squares. <>= data("Townships") bertinplot(Townships, panel = panel.tiles) @ The original data in Figure~\ref{fig:binary}(a) does not reveal structure in the data. To improve the display, we run the bond energy algorithm (BEA) for columns and rows $10$ times with random starting points and report the best solution. <>= ## to get consistent results set.seed(10) @ <>= o <- seriate_rep(Townships, method = "BEA", criterion = "ME", rep = 10) bertinplot(Townships, o, panel = panel.tiles) @ The reordered matrix is displayed in Figure~\ref{fig:binary}(b). A clear structure is visible. The variables (rows in a Bertin plot) can be split into the three categories describing different evolution states of townships: \begin{enumerate} \item Rural: No doctor, one-room school and possibly also no water supply \item Intermediate: Land reallocation, veterinary and agricultural cooperative \item Urban: Railway station, high school and police station \end{enumerate} The townships also clearly fall into these three groups which tentatively can be called villages (first~$7$), towns (next~5) and cities (final~2). The townships B and C are on the transition to the next higher group. \begin{figure} \centering \includegraphics[width=12cm, trim=0 40 0 30]{seriation-binary1} \\ (a) \includegraphics[width=12cm, trim=0 40 0 30]{seriation-binary2} \\ (b) \caption{The townships data set in original order (a) and reordered using BEA (b).} \label{fig:binary} \end{figure} <<>>= rbind( original = criterion(Townships), reordered = criterion(Townships, o) ) @ BEA tries to maximize the measure of effectiveness which is much higher in the reordered matrix (in fact, 65 is the maximum for the data set). Also the two types of stress are improved significantly. \subsection{Dissimilarity plot} Assessing the quality of an obtained cluster solution has been a research topic since the invention of cluster analysis. This is especially important since all popular cluster algorithms produce a clustering even for data without a ``cluster'' structure. %A method to judge the quality of a cluster solution is by inspecting a %visualization. For hierarchical clustering %dendrogramms~\cite{seriation:Hartigan:1967} are available which show the %hierarchical structure of the clustering as a binary tree and cluster quality %can be judged by looking at the dissimilarities between objects in a cluster %and objects in other clusters. However, such a visualization is %only possible for heirarchical/nested clusterings. % %\marginpar{Cite Pison et al 1999 and Kaufmann and Rousseeuw} %For the an arbitrary partitional clustering, the original objects can %be displayed in a 2 dimensional scatter plot %after using dimensionality reduction (e.g., PCA, MDS). %Objects belonging to the same cluster can be marked and thus, if the %dimensionality reduction preserves a large proportion of the %variavility in the original data, the separation between clusters can be %visually judged. % %Silhouettes Matrix shading is an old technique to visualize clusterings by displaying the rearranged matrices~\citep[see, e.g.,][]{seriation:Sneath:1973,seriation:Ling:1973,seriation:Gale:1984}. Initially matrix shading was used in connection with hierarchical clustering, where the order of the dendrogram leaf nodes was used to arrange the matrix. However, with some extensions, matrix shading can also be used with any partitional clustering method. \cite{seriation:Strehl:2003} suggest a matrix shading visualization called \emph{CLUSION} where the dissimilarity matrix is arranged such that all objects pertaining to a single cluster appear in consecutive order in the matrix. The authors call this \emph{coarse seriation}. The result of a ``good'' clustering should be a matrix with low dissimilarity values forming blocks around the main diagonal. However, using coarse seriation, the order of the clusters has to be predefined and the objects within each cluster are unordered. The dissimilarity plots implemented by the function \func{dissplot} in \pkg{seriation} improve \emph{CLUSION} using seriation methods. It aims at visualizing global structure (similarity between different clusters is reflected by their position relative to each other) as well as the micro structure within each cluster (position of objects). To position the clusters in the dissimilarity plot, an inter-cluster dissimilarity matrix is calculated using the average between cluster dissimilarities. \func{seriate} is used on this inter-cluster dissimilarity matrix to arrange the clusters relative to each other resulting in on average more similar clusters to appear closer together in the plot. Within each cluster, \func{seriate} is used again on the sub-matrix of the dissimilarity matrix concerning only the objects in the cluster. For the example, we use again Euclidean distance between the objects in the iris data set. <<>>= data("iris") iris <- iris[sample(seq_len(nrow(iris))), ] x_iris <- iris[, -5] d_iris <- dist(x_iris, method = "euclidean") @ First, we use \func{dissplot} without a clustering. We set \code{method} to \code{NA} to prevent reordering and display the original matrix (see Figure~\ref{fig:dissplot1}(a)). Then we omit the method argument which results in using the default seriation technique from \func{seriate}. Since we did not provide a clustering, the whole matrix is reordered in one piece. From the result shown in Figure~\ref{fig:dissplot1}(b) it seems that there is a clear structure in the data which suggests a two cluster solution. <>= ## plot original matrix dissplot(d_iris, method = NA) @ <>= ## plot reordered matrix dissplot(d_iris, main = "Dissimilarity plot with seriation") @ <>= pdf(file = "seriation-dissplot1.pdf") <> tmp <- dev.off() pdf(file = "seriation-dissplot2.pdf") <> tmp <- dev.off() @ \begin{figure} \begin{minipage}[b]{.48\linewidth} \centering \includegraphics[width=\linewidth]{seriation-dissplot1} \\ (a) \end{minipage} \begin{minipage}[b]{.48\linewidth} \centering \includegraphics[width=\linewidth]{seriation-dissplot2} \\ (b) \end{minipage} \caption{Two dissimilarity plots. (a) the original dissimilarity matrix and (b) the seriated dissimilarity matrix.} \label{fig:dissplot1} \end{figure} Next, we create a cluster solution using the $k$-means algorithm. Although we know that the data set should contain $3$ groups representing the three species of iris, we let $k$-means produce a $10$ cluster solution to study how such a misspecification can be spotted using \func{dissplot}. <>= set.seed(1234) @ <<>>= l <- kmeans(x_iris, 10)$cluster #$ @ We create a standard dissimilarity plot by providing the cluster solution as a vector of labels. The function rearranges the matrix and plots the result. Since rearrangement can be a time consuming procedure for large matrices, the rearranged matrix and all information needed for plotting is returned as the result. <>= res <- dissplot(d_iris, labels = l, main = "Dissimilarity plot - standard") @ <>= pdf(file = "seriation-dissplot3.pdf") ## visualize the clustering <> tmp <- dev.off() pdf(file = "seriation-dissplot4.pdf") ## threshold plot(res, main = "Dissimilarity plot - threshold", threshold = 3) tmp <- dev.off() @ \begin{figure} \centering \includegraphics[width=10cm]{seriation-dissplot3}\\ (a) \includegraphics[width=10cm]{seriation-dissplot4}\\ (b) \caption{Dissimilarity plot for $k$-means solution with 10 clusters. (a) standard plot and (b) plot with threshold.} \label{fig:dissplot3} \end{figure} <<>>= res @ The resulting plot is shown in Figure~\ref{fig:dissplot3}(a). The inter-cluster dissimilarities are shown as solid gray blocks and the average object dissimilarity within each cluster as gray triangles below the main diagonal of the matrix. Since the clusters are arranged such that more similar clusters are closer together, it is easy to see in Figure~\ref{fig:dissplot3}(a) that clusters 6, 3 and 1 as well as clusters 10, 9, 5, 7, 8, 4 and 2 are very similar and form two blocks. This suggests again that a two cluster solution would be reasonable. Since slight variations of gray values are hard to distinguish, we plot the matrix again (using \func{plot} on the result above) and use a threshold on the dissimilarity to suppress high dissimilarity values in the plot. <>= plot(res, options = list(main = "Seriation - threshold", threshold = 3)) @ In the resulting plot in Figure~\ref{fig:dissplot3}(b), we see that the block containing 10, 9, 5, 7, 8, 4 and 2 is very well defined and cleanly separated from the other block. This suggests that these clusters should form together a cluster in a solution with less clusters. The other block is less well defined. There is considerable overlap between clusters 6 and 3, but also cluster 3 and 1 share similar objects. Using the information stored in the result of \func{dissplot} and the class information available for the iris data set, we can analyze the cluster solution and the interpretations of the dissimilarity plot. <<>>= #names(res) table(iris[res$order, 5], res$label)[,res$cluster_order] #$ @ As the plot in Figure~\ref{fig:dissplot3} indicated, the clusters 10, 9, 5, 7, 8, 4 and 2 should be a single cluster containing only flowers of the species Iris Setosa. The clusters 6, 3 and 1 are more problematic since they contain a mixture of Iris Versicolor and Virginica. To illustrate the results of the dissimilarity plot in case a clustering with a $k$ smaller than the actual number of groups in the data is used, we use the Ruspini data set which consists of 75 points in four groups and is also often used to illustrate clustering techniques. We load the data set, calculate distances, perform $k$-means clustering with $k=3$ (although the real number of groups is 4) and produce a dissimilarity plot. <>= data("ruspini", package = "cluster") d <- dist(ruspini) l <- kmeans(ruspini, 3)$cluster dissplot(d, labels = l) @ \begin{figure} \centering \includegraphics[width=10cm]{seriation-ruspini}\\ \caption{Dissimilarity plot for $k$-means solution with 3 clusters for the Ruspini data set with 4 groups.} \label{fig:ruspini} \end{figure} The dissimilarity plot in Figure~\ref{fig:ruspini} shows that cluster 3 actually should be two separate clusters represented by the two clearly visible darker triangles next to the main diagonal. The dissimilarity plot using seriation is a useful tool to inspect the result of clustering. It is especially useful to spot misspecifications of the number of clusters employed. A more detailed treatment of dissimilarity plots as a tool for exploring partitional clustering can be found in \cite{seriation:Hahsler+Kornik:2011}. \section{Conclusion} \label{sec:conclusion} In this paper we presented the infrastructure provided by the package~\pkg{seriation}. The infrastructure contains the necessary data structures to store the linear order for one-, two- and $k$-mode data. It also provides a wide array of seriation methods for different input data, e.g., dissimilarities, binary and general data matrices focusing on combinatorial optimization. New seriation methods can be easily incorporated into the \pkg{seriation} framework by the user with the method registry mechanism provided. Based on seriation, \pkg{seriation} features several visualization techniques. In particular, the optimally reordered heat map, the Bertin plot and the dissimilarity plot present clear improvements over standard plots. A natural extension to \pkg{seriation} is the synthesis of ensembles of seriations into a ``consensus'' one. Such ensembles do not only arise when using different seriation methods, but also when varying data or control parameters to obtain more robust solutions (see e.g.~\cite{seriation:Jurman:2008} for a recent application of such ideas in a molecular profiling context). The \proglang{R}~extension package \pkg{relations}~\citep{seriation:Hornik+Meyer:2008} contains a variety of methods for obtaining consensus \emph{relations}, covering consensus seriation (where the relations are linear orders on the objects) as a special case. Future work on \pkg{seriation} will focus on adding further seriation methods, such as for example methods for higher dimensional arrays and methods for block seriation which aim at finding simultaneous partitions of rows and columns in a data matrix~\citep[see, e.g.,][]{seriation:Marcotorchino:1987}. \section*{Acknowledgments} The authors would like to thank Michael Brusco, Hans-Friedrich K{\"o}hn and Stephanie Stahl for their seriation code, Fionn Murtagh for his BEA implementation and the anonymous reviewers for their valuable comments and suggestions. % %\bibliographystyle{abbrvnat} \bibliography{seriation} % \end{document} seriation/inst/doc/seriation.pdf0000644000176200001440000116471214724364730016507 0ustar liggesusers%PDF-1.5 %¿÷¢þ 1 0 obj << /Type /ObjStm /Length 4983 /Filter /FlateDecode /N 86 /First 731 >> stream xœå\YsÜF’~ß_·ñĆP÷‡W1%Yæ²%yBÍn„ÕÝÖ1óÛ÷˪B7ú$ؤì‰Ýh‚@êÈÊÌÊ«ª 3ž©LŸé¬(df2¡¤Êl&ŒÑ™Ë„×"ó™äZfE&¥ó™à™t %D¦„DZfªÐ¸«Lƒ|»/ÐB¦ ´ÍŒähØe¦ ÷>³šëL™õòÌ T’"sÒ t’9íL0œµ6“€Ã+¤Mæ9*K›yåPÏeÞZ¤}æ= Ë"+¸6™âY¡ €Yá,€”YX) ”+t§Ð9×9€Š[T¤áp瑃!ócVž<Ɔi08Ž €ñVc1<´,àÖ…Îe-K®xhY*ÊAËÒNB•,ЬFËJc8-« ´¬Ñ†…$úÚp -kkQ-käTc„™AËF`¸ÆÓš5„}X´lP-2P‹D ƒEËG€xÐF$¬¥,ÍyÐ -[ãO8NµÐ²“Þ¡e§‰Vhh¶ <@uhÙвhÔ.Ј#ò Âk9ŒÊ¯ z( ¬Be^ЃÙÑrAÕOQhàÖûXÀŒ·¢ .òh¹ v¼Gqaþë‡2öª¬{ƒ^݇€ÑO3öÓu9>ê×ÕdœýÌòžVuö¯æõ°—3pQÌ?é]–¯&ƒ2c?ÏÊÅÛ=Ãt eÞ|½Æûct1œ\f†^æõÕdšýpQ^\p®œÛ—Âåq \WŸs@Êu“‡»S1ŸÞ;¼”M™s¤SžÓ­z1Ï–©óVÔ_x_Ķ©n('bPNƶøBñ£š–=ÂÔã^]fß=þ^r æäÌïµÀí_8ÿË_S9Œ÷»—½7å»ìsU_eWÀËtZ^àõ‹òëçÉt0kðú¡;á%Áà©ï‹%ÌÎ4«[eDÊ˺TÎ¥q6ãmpòÌj» \\$\4ey«ì á]ï¯c$ð^¹ U'ÓÉ`Þ/«O^f?^Mfõ¬?­®kHœË\ ÌÙüü·²_gßáùMUË#¹˜nBƒw ¬•À—yà ‚õr ª—Þµ#Õ ýÉ4h½d– dð%Ï>ö‘”î áTdØðì–ån&ÖÃf¦Oæãšd5{QÚ)mÃáLº7iîñ¿OyñÉœî*ÜlH«ôB?¾Ÿ¤Q¸ëXN¥¾”ç©\J§zªHwÃÓ=¦5OåLìŸäp¸+žî1Ÿ4t¸ëŸHõ¡¦Ó8¼ ÌXJ¦AE˜…e>4b+J²FhÇ“šP(cÏ"µ!šÚ2õ$6¥K÷™\´~<×åA…E1ùªT½G“/hžZ‡ÊImk‘ÃPø@LQ¡ª§ål2ŸööäKýãYMK$¤°§è #åôtÒ?+k´ÍN?ÅàÊ/$Ð>lsc˜ ±*Ñ;‘5QÃ&¢&š&&ŠÅ[¢S"[lEÇVtlE&~“‰ÇDâ èÄt—[0fˆ¯î‚žÄ&6bb?‰ÙŒÝ·»OJ×"´ñwHšÍi&h"‚LD ]ÒëtODô6Ý1“%±:xOD“¾8`¬z³2Tg/Þ¾{òòÿýòÕédÔ ùàÑd8bÇýÉ _f 0y¦³úøª7%+:tý¸ŒŠz\¤Yö²—ÊÈRKuè™ú ±Û·Õ ¾"d[2ƒ (NVJ¨v "“rL¹ôÿ¦kµ>‡ñ‡‹ãB¾‡w¡O zPYîAgKf'T %17ä Ý=f4ë lÿ‘­Je Žâ])Ls‡Ò$SèðDƒ¥Ò[Ê×°Á5jèæò`º‡ -Xpí¬O  KFåõ³²º¼j’ qÄwìˆ=bÇì1{Â~dÏØsö‚½d¯ØOì„ýƒ²3ö†õØ9ë³þd8³+Yh†]° ú«XøûT² °»dW ÖÚU9fûȆlÄÆl S—MØÿ¯,¹j2`¿³ßç“ÏÔÖ”ÍØ¬ü„J³ê › {³+V³újZ–¬þ@ž"I–^ç³F ·¡T“ˆCj™ß–º£*Že¿ü/ÀYHbö¯r:é$Žè…@æÅœŒà–@Þ-';Ëd±_&Ÿe½á¬lJ-­Å ¡ýôìùû'¯[À¬™A®ã£ñ¬Zf,e·ö›Â;y1KƒHØŽÂÛÀÈÙwñô¿ýóÁO»Ó\†Ñk¡4{ËQ TöװrÖç±-|{ÇdkGciGÄY€kÕ4h3å:ûºÄ}ðåß°ðÞÃ>¥®×ØO¬³ßŠwå=ø¸Ûy½Kã×Ð_|vúòõ“G[½ÆþÚ¶ArçZ·Øä/—j¬RØsz»5«¸ËBôš‹´2>Ü©•mßÈ¡ÒíV<_Ê9 Ã=´¤ÂIÕƒ³èò¤?£Ím)bÂÂÙw¡,Ý,Ô¡ z§ÕÖPÿÁš¶Ëç0ª”#JiIæð¡ÝöPzœ0 àþËZKV:.ÀÚ`çÿ÷0sŸzýdE›·½“ú8ªàª“Ú½QÙÞÒq¹›âTf¡8å6Å™ü€¥äÚ)C:ëMÞÕ—yóöõë·ïÐÕ«^}›ßîÐ4Ñ—¥Ð2›B+ùdD Œ Læ¢è2…=Mßíùñ£.Hàh°ðà]¡wg£q¦Ë„7’ÄÄCÓJ›L r h ž„^Ë0Ö N"Í·VP®ÙœTܬLª\L*rðŸ'çþ´5U.Ø%-¹”Óf>”³Y˜uyU±ëнºD•m~8u´•¡AÂ[¨càYã߯×]ðï LÕ™‹í \<™Êi ¬…Yu"&P‚e)üÍÞ½ÿB,wÒ—ˆ?ÏÆóáÊ>T}ëS U¹.ŠLZ‘Sì”Ê=¥ÎiíñC‹§_Vã ”!¾¸l´<‹‘öáM« "­*ÛDâS,Ýn‰¤¦ ò=D€mšÇ‡NSí´Ð‘Ö\ ‹ãs[ØúBþ ü;Å}ÊÆÂW!½¯P{¢â€º¨‹í§u¤´d•VVÁ¾‡H{Û‚ß¶“õîéñ"w6ìë­Úd¯³¥7æ{Z^j;[®£^‘n3æ¼û×D¨R*ŦøB“Á,ok•Õ(Üš†ò¿vâ+A'¾9ñEÀ)h’µ`Óí4]dn½:‚¿ý–ž Ã)ÆtÇ0”Èò©Ù|U ØF À^ÇâeQ¨mJÀ¯+x¡« ßû7ìÅûçÏ=Û£åÙšI#”Ýä=¿Î{ª«£O|²N;ZáhÑ.&´;‡:*ë9&¥5Fó5rQ®Bk´Ø ïÄFG2¸¢«Aùêèõ«“ã¤ûϾŽÎ'ÃÙvô‹uôóÖ›ÅÝ%òù6äO~W}Ú•£ÓRúnz,mÃeÁ–R°à» k]ç²wû5wúÉ-L·ßO;ïMC`´\„H“_„Œª7–åhÞ¿ veŒŒŽªñ&æ|XW×ïÉΤîà) n³ÀS¿á™xÎMœÕY¢ÜT\òòѯ¯¿}ÒL¿‰ßmÏ:t\,yGâ塎PüiÚÖ#Û-Ú˜.ÞzjÿîÚs‹;7Ú–EßôžV?·Ö‚½üá––~²kÚ–¾†Í^p±ÃÒ×Îæ¡²:§H•‘2/àzZd+þ ýo›×¹„9j Ïi©ÚçÜ8@ªrÃŽB&7!…Ïá*ì€L›“m”@3&wú?4¸lªp hö/Lº?4%DÎÝ.Фt¹{!"0Rûœ¶’YesÍÕŸ œk+Í8çòB™oœÚ2 ÂÜa ÊÔ8òËað`.@d2§-t*h ô‰ U¨¥þ(Ø”0¹)v…14d†5z[¡r®ÿ0¼Ý[ѽŸ`3ÂCëoÛÁk¼Í­Ú)C”ϵ§ý<&'/L©œv›°×òÏ…Ma>rh¨6ö£Åš»Ã&šD‚Í.AótôA€šf×U€†ÓÁHa©œ6³jgrŠØÜ#T~*øD¹Ö»¨â<öO„Jq—{{[¨–å»_NOÿž¬Ï'_êr<«&;ËDÖVLcÓµÑë |Þï÷l’Lßn&ò›Œ5ï‹­ÿoú nÖ›ÉXw1ôЇ¡W r)Ê/K'ãQuy¹L×ËçQ5X&êk6›FáÀÁ š]{_—uù¥^ñ2 Sìv3è%æ5-w®ûÑë›)ÝÑÓ Ó££§ñöèÍÉ“÷Ôçd<ÙÎT‹“) S©Í@™Þ\€é¼+A.÷˜pÜȤ¼vê‹·žº·vX¿KøùZ¹Ûh6wOè•ÝК{WKw­•¾¥=O³~UÕÕpP²^}Ð&§àÃ_ìÚô—T‹H×U×61íÛ²´w½u ]0ëO¦å¾W¹˜ðvm§R|IKÖ„ôµ ¯×'üÎÉ×y«ˆ¹1F å¼-?þñèì—•e2{Ë`¹à›«°Mä䆠Ù6!@ëFÈMÖµ«¬’ Ö»¬Fõ¾rÜXAM¬ÑŬÓe?~:ÇÞ¹<ØR³ð5õ´Ý}ç9ÇX-Œp±J#rÇiã8îÖ~k+r?lÒÀjÁãΚûmÝ\sKÈÌ.:çL~Uì ž@!ÉÞÉi „VjmØ2W¾øöxƒÿëýNGîÕ&“¬a:† a«Ã´„7#ÝŸ 0£r›—´öw+ÐNé$p´‡š:òÕ,ŠžÒêqa?…MÖÆ))Í3nžéünz¦3¸¦y'µã3¼=Ù´SÐyŽæÙ후£óåM‚j›6”·fFÚ|®m.U±“ÒlH§¦yî°I*Œ&pwriºk¤Òàö]sDÿ²áü‹Èé”}¶4Nç]·',µÐñË×§¯kCËQøÓù°ú}^vÔBFnHW»~¸N+v´Do±Æ²ú³>nà1áTúîù:mJ ³a&öÚ>7°º(«Ã)¸‘ÅòTÀ¦…çV÷Ǻ¶š8¡rNŸo°.§#·¤A¸ë( »Bÿùóçü·YÝ«g“‹ü')YÅ€[9(eé5DŽXÌjY8ˆœŽ!Ø?nÚe(bLáEMß É EF…Êè()OÉ„n¶œjOÛ–·éúòÅ=³Ô-÷Ç|oÎNç= $x2 ¡i¶ÕÌ H(`=%rÎ!Æh¿Ð,–ï¸ v° ÀVsž´=LE›‹ðe ßßóDßÃ)Ór"R³Û@J“kŠJ)CR†Aš ´z%ïñ{FpÙ‡Û~{èÉF§íJa±¨‘XJGîÿ?±³[²H1w‹0ÐÂwŒ¥ßôŸÊËÞøpÖ-’‡o5ÁÁ$5g¬GºãÊàzÕ°ž|?ºê]͆åôoïÃ2Ÿæy9˜ E‘úÄQ–6ÁÑÆDúÌ7¹ñuEW”·AeÿnFpЂôe"ž î¨ ß’9/ŠûEóÇù´Î¯&ÓqõñoŸçy¯Ÿ÷ê;`Y€# ›ÖŒè[H ßÕ¿ïŠe’ä£^}•7ð²Ç°C1]˜œNÑê-è;]0ߺz\{ìˆ]îjW“‚¦=ÎÐãê⢜–cÚMûÏð…‹ \ma£ƒ£ô©V ”†á_4qH?a/bÜ4xO-Ú°±+[ÛЕ-vzÑÇ`–ÛÀÈyoo£ø@³qŒggË圬µ·,Æ$ÏáÞØâdVÝocñè1±ÄÊ¡ÜlõTn8¼(µÉÎ.†[é^4­…¦î^Zm[Y[£¯±´—Ñès)íõ6:“°²æFîz³LGûbW—ÙÂÒäúJÜ=Áþ g;¾É|¤…€ë*tÎÙ„Ù}UÄ •Å¥˜íþ/Qú7endstream endobj 88 0 obj << /Subtype /XML /Type /Metadata /Length 1555 >> stream GPL Ghostscript 10.02.1 combinatorial data analysis, seriation, permutation, R 2024-12-05T11:58:48-06:00 2024-12-05T11:58:48-06:00 LaTeX with hyperref Getting Things in Order: An Introduction to the R Package seriationMichael Hahsler, Kurt Hornik, Christian Buchta endstream endobj 89 0 obj << /Type /ObjStm /Length 3221 /Filter /FlateDecode /N 84 /First 761 >> stream xœÍ[[o·~ï¯àc‚"\ÞFm'n ØŽ!%MÚÀëÕHÞVÞu´£Úý÷=‡CÎp®ZEr ÎÎ…ÃùÎõ;‡CÁ ÀL`A2ŠáF:4sôcXžË°àH‡OxÚâàÀÀZ<‚—8’èŠd$ÞŠI¥p¡™4ŠÆ&Ç'„e2ÄÇS`5x¦”£1)£=½–)gp0SÁ L½Óÿ ™¶ÖàaÚ[ÀËŒtàPœ8Æ3£?f¬DÕWqÐëõU…¯ yÞm}Y±oΫós!tÂVB ³'ñ¯Y:F'¶ª¹nCº^=Ê(¾ -ÛÇã›`:d×—+wnJS$)Ì´É%¦øÐècöÆ2‡¸.fY[׌C¾œ/XŠùrqaó<7É­œãÎ ³<5bKrORªìðZÝ·_k7¢ÉÐ}Q'z…]k»Qæ‘VöÃGynÍ8÷¸Eì“lêE[`µ¶“Mf±ù^a¯¶XM…\&¶^œE[ß$ ß9,&©í]’aŠhM.é½o›,SSÒokMç.û)|h1WŒåQý8’’ gƒ°(Ïïš"l™f ÜœÛn«U@¼b”û‡§¸Ôå‹-£>#H¥ŒÎœ¦Òu—¬”9¯(éçá¡$J*.qšææùb&)ç4ýÚ7:üÛtìºû­³ÛB…ÁÊžµ£õyŽÄº­o"N“YdÉ’ÐcI¹À’-…öS!+ºWTøeŸÚKoB(-ÒÄžÆ4”SiÍiæ¡U?t`ªëÖ¹ì·)°å¸Úîê1"ΜÄ&IêVFËS½*\H.íˆXAOK•,´Ø=Ÿu>ÙO¶I_Q"æú¬ µ›e»mQ!m¥ÀÃ[Ô,Ê>YTdü.Ùw–pæLºî¶2ÐÂF/ú„ÁDP`e˜í¹M§çWŽ¢ ,Ð÷%,Ô¥5Aà±L¾ìt×Úœìíºh/‹±èsYK~Q‘FëÊô i<ǘÉešì´‡+f²(¶JÜ0×¶y¢Åýx·Û×*UcUZ n~múué×§ß;­M7¿~eúmæyC¹W£x¦M²áËêl»~²ÿ„)‚¤g^÷¡ çä_'Õa}µ©Œ>Û“¦tŽ®«ýæ´"•¯^û uEz}ƒRå%Ü×ë‹jXC¿:-Ö̘crÝ w¤eÊ-–›ÊôM ·Û4®åô¸~ï§Wt®Ëõ°iƛ䌢Á³ùýÉúPE ¯žÿòôÅ““¿¾xyºÞ@|õdyÆVßí6û³íî‚­~ÞîïÛîB$ì§ïÖWÌËÆL(Íæjû¡Þ_Å,-·ƒN¯ßÖÑJd+È&kÞÿóö¬~Gé°{ÓúéaC‚۠ѯÖ¾¯¶ïò)ÎJ®ðÅêä˨É8Rà|—닳ÆXßLþ¤s=kT|úMsçÙö²Rè§ÉAèÒ«õûjNÏëõåvóxwúÆ½Ü¨Šˆœ‘C­Nëêý?hÅ©­ÐJVúþꬺJˆD ™xÍIæ"MÅ}‘“8˜Â1¾GP1zBSÛLƒÌŒñ¥™Z^Âs§9xCã[ ¼Øîþ“QÆdpKpr NǸ3à”Æ §ïU.ð€a¯=þbÏA¦,ðpØtЪ6&ËWÐg“œ˜ø%5ŸxL ©¼8‰ßgó1}7ÎÇù|â´ 0_¾gZ+O’V´*U9 L‚"ç¼=(ú>;xLv Y‹”JÔ¦;V1ô_gId ÝzBxï°P»Y®c¬TÏ5ÀŒT`%†aqG;& ÆÔ‡dĭПÛ—±IflÎaÔ¸? œÃ°àçÀù>8%,èÕ p ¾Ã†!íÃçÁ6‘˜Á#7ÍZUé6íBûS`ËeJ—Ë”?ȨèÜÜ™çQoˆÁ ãiÚŒb±ÙÇDÊÂÇRYv‚E(Ó¶?bÁWH.¬Ú3ºÚ©tÜ€xD‘Õ…x^*¿§Ïkp)ÄóZô±!n²"¦B|B—Z#¯æµa<‹»SÛ3Ô¢uí™Å3ßžaykCß. ªí…âRøukz&­á¥õ7HërjoΉ»¡Ñ¸Iª‹ktGæÎrͰТõ4ڮ˱"œ-l±©Ç”i,·š6a¢ Èä6p£ïÔþÝ :Ô¯G‹SñÔÑæ±B3Ò#Ì;­ÕÜ <â'Ô’Bò¦T-iÓ+º¸ ØÉ¸‡>`éC®ÄÃÅïQ–ö‘+­Ž½;/Þ"ŸýþE)‰hñµ7T¢Ús…~,i¯b4P1÷»´rklTTC Îi¬bÌÓ'G·™í}<·5‡"`ýIK €V3ÚqÚÿ Ø4æSƒñ“±a{¡¼ý,Ø&Ú Ð\nvùBÓ,Zì/$RVÜuaSBð°àRÓ˜Áå¦ñVàŽ+wo·$6‘ú‰EcY¸éEÅÜ ÄžÈšþèaLäp_DîÚ]2· òÇq‚S¶úéäy«üM½ÝïšK_¼_o/ëý×›wWÛC½]ïøÛëÍ»zý·×|½áëúË8ñ¼ÿÀ˜€¨<0‹§w¶ÙL äþÈ…„q¿«ë_¯V?~äêj[Ÿ¯¶;£¾®«Õ¡^ŸŸ¯q~‡ÃŽY#xŠþ Š–Q&y|Ðw¸e¶Âmá£Þ·Ûóó ýƒâרl Z Ô h™ÿ‹iþØendstream endobj 174 0 obj << /Type /ObjStm /Length 2575 /Filter /FlateDecode /N 86 /First 791 >> stream xœÍ[]o·}ï¯à(Eò^^’@ Ž›¦@‹r¦-òàÈ›@­#–\¸ÿ¾çp8»V´#kª]­$ÎîðãÜïKòn,Ù‹¹$mqZÚê¬e´Íµf.VôIQð]ÃöÊ Ÿ*¾5ôUùÇx=¬1sTÁôsÔê’öáÍ%ãð\*X>¶èR~“œŒˆMœ$NØÔ‰¾ÊNrfgsb}Š“šÙ§:taŸæ€\ Á©$ÁCtª  …äÔ„¯ÄiÁ¬)¨Ó–±rÈ.ÇÀWær2¾*.kâ¨êr&ƒBs¹Dô%¹ôÁzH‰Éé&L4áA)@Î,ó•9«‘¯ ˜kU] ½Os%±Ö+ŠéXS²aÑ”\)ø—@I©àsJêjvή’[)™«¢|U\Í )¥êªè¸Z±N’àjƒ°!×¢`þZ¢@D\Så+uÍÀ­„ÙÑ—¯ òyRŽH ê3Ÿž„ià–HùTÀu0 ƤÐ#(ÌØ±c¹;x…8£(Ø¡X#æÀ~X#šq¬]ÃÌk@Üx yQñ6c È·X0™Ê€ Øk@”`U&UR–±Fj$ xêó5>A¥’a -þæ‹/ÜÙWWW×·7î]³ƒ;ïŠ=µ6Ú2Ú:Ú6µ4µq´i´2Úi¾ÜÙ××W·›+¬¢eêsö§Í›Ë×/®?`]Î’[ö¦FÙ1â»×ï0ÀM3œon®ß¿»ØÜ8"þ³u#éï¾{w}ñjs‹‰Î¾{ù;ûËæÃ-føòK<þ÷ßNõóElĵA\ĵ‰8šÕÔÆÑ¦ÑÊhu´y´6Ú²‡h9Ñ4Ò'MÓî ã .ââ .ââ .â¢í!JET,O"*Ör—qi—qi—qi—†äRí˜/ùdÌ'c>óɘOÆ|2æ“}Ìʇb–o‡®P»drGí¥‘KjÔcI…ˆi‘pxæ§ÚÔ¸pHÑê}ÑÂûâ6äž‘²‹¶2 NžGíä N®V_‘hÍàͼÁ¯Ü£P˜.,8“汇§‰”RU¼QÊöÑíõahÈ…½ ön±YƒýÖϲb¹a1õLø›o°Mì |A"vRhÈ|ænf‚–³ïùøç-–à…®+E/Ü8ÂEž9±D±kñQ>Âfâ›–ÏœD8Y¨~Ì ²µnµ!ð€ ù–ó?®"®Ú´ÍóH` ´óˆäWç(¡:‡Éâíûˆ¨º6’®ã“ÜçS–¿È'«žš’/ă|UáßT²·vX [ NCôJ¾pxöÜ)|à½-U Á*» Œ<'P˜ª"9)¶‘ñR˜äS„ö‡\ºÐŽl™ÎÔZÝL’'JZé&ÚùÌÓ5 ˆ¨G÷iŸ—‹Ï5íÀU8Þ&G·OªV¼…Ep{+ÑNkë9ÈgN‘µ([p9f {>Î=h±Šçéôßx¼œ\?)ôaõ¤Ø˜y—¨;pØ6ä”n=úÒ¸$UD=@/Ž$Tá™–ïGëB®G·Õ‡±%lUDã›bï—Ó:lwcü3†õÇo`šÐ¤†Í‰1Ó•¶ U«à¡üIýF H-B<ï|åõ¶UÖ»3X -“ñy-TCKF¤F9‚ù°Qt},€[-wàòsIÏNóêE…Ó¾V„5¤D !@ôk‡Ý¬Ç6âÔ nŽSÇ¥"–%CÂ+e¨DêH±`58¸¨Z޳䫭÷8‡{z'»:i‰>¬!bÞÏNVŽÂÑÔ7;Y8åÝ&"gæýtRèü©3 :Ûaƒï°\Žm¯ˆÊ|éR#B¦µòf#ïܼa @Ævôàô06ÞbD$ ljpkå(Øö]j^k-]jÀ |ñâî«N{âÌczŒJG·…‡Á)×0l l.rp{Žå³6ì(ÁUžxT®¾”]ªFïb‡=TXm8ž€“Oá@Õ5Êa³ÈÕØ"’VïlÁ¯!ësS8yd°Kà0khýn…`.O 'чGõÕà„Æâ§l·Äã€Ûc«Ü`¶°t½Ç+3©©ß®ôc™ñòJ žXë‰Áñö"Ú›„Ðï[ž Û'öÆB0Ò¯©(EJ9U^¡Áùÿíapðº`\ÛËHÉëQ°í1³È»Å¨?±1óVfà±§'ÄÈbµ“‚X²îÀe¨šåC€ûõ5|ÙaCvaàJ’öÐÆ€eˆ­ôãfaÅaÆðøã惾ܻ:ù¨FgPu kN5::U<­«1:·äâ´w/š>æÄŽâ{J:ª«tTWé(XÒQ°46\¬¢œÚQ­¥£Z+j­<­%YF«£Í£µÑ–ÑÖÑNóˆ…ÑŽy,vÌgc>›æûáŽpê!…#s L7öë…ó8K©w,…Õ>ªKUH‚A bFEjo¬SîÙZ/9 ³w ,²ˆFX¨,JË’!ó,$3¥ð¶ÙçÓá=fÃcÕàk—xÇ‹…Â2®Ü|…"‰fQÈãËk}VƒäçZ½×XÎeÏ!Øb¢T"kñÌ ¶A DÝÁ²Jõ´àjÅÎF¶àXÂ¥"Ç·'S±T°aÈKöjØdó¦M&1n Û ;ðaájpó~,NŒŠQ}ÉÚ±Æxؽâjl1òì¢ìÀÁxyºó\à 7YÞi…ŠÙ\Fš¯²ÜÝ8¿ŠÌ1éIå˜ûK0g–¼¾Ùôˆvöíæí6·—¯ûâú턾«‹ë7—W?÷*ôÑ[ˆ>ÎDôÑÿ!0‹+o%I_®K,N ×ýW0Úk‚Âb)ýw)اýˆ‹¶¸©D0þfYj› ý7EÀXú0¸”´oܶࠫ…¿žZnOV©¼+‚œ¿»«´ÂŒ,ÛO|×î+ô§Ïé?RÕ­Ržýõòê««›ËÝ//úiƒLŽ©#wöËåÕû8Q´íŠùþÙÌøfendstream endobj 261 0 obj << /Type /ObjStm /Length 3441 /Filter /FlateDecode /N 86 /First 797 >> stream xœÍ[YoÛH~ß_Ñ»¤ï Øq’=qì\›Ed™±5‘%GG&™_¿_5IY)KŠåq8lª›Ý_WU×Å¢öšI¦½aÚ:\-smïXWÏ"õùÀ”VÈ”“ôKbÊ£[ÉTŒ Å´B¿š&³hºÁô7)Q—cF[ ž+oi`d&$z*1“,fŽ’Y™ŠYíËX«ðx4Ì:Z+Zfƒ¦.ÇlŒÔåRW`N%êŠØ”£®Äœ“èJ’9o1sRÌEÚhÒÌ%Úi2Ì+ (ž`jL€xUͧe 1Ô݉ñôÛäÙé¤3)²ˆç%}ôÝècª}˜j&¶à×;b¦vwkÛˆkv%iöGÀ=錋ü¸øýàé˧o~9<:^uûÅUOÉG'ÅŴ߃îð¼7¸`â]oðx0îÝüpÐ'{—…ܱìãî¨w=޲åʨ;Õ Q§Ó³IÆBˆT ¬ò®w>¹,™k2-êNJöcÿ|,gr&$ë‰ö6’8Y¨'i3vZ•îÈ@Ò˜òJ¿Ô=x¬‚ÍÄ_Õƒû3þ»Ä9Råb¯sý¼è]\Ö· ±êßâXœŠ×¢#ºâ\â˜+.Ä¥¸ü~}Y DOôÅ@ ŵ‰±˜ˆ©øú&ˆÌ4ó# &ú‹1ÎSIÆ'µ(åNo|^ðcÙyÐë0àÑÞÄ?:WÅ:x1éô{Ýǃ‹~ÅQo<†dvegAœNŠ«·°€óüœ“ñ¾Ú»…/Ñ¿ýÓO^ÿ޵O;ƒñÖ¢u‹è¥%Ñ£AIž‡1jòÏ.òÏÎóïd޲f†wä#-ò‚MO/1Ã-3c%A6ä<œv>,î+89¿¯òöF.Ç=HeñeÚé‹O½¯•höÄÉã פ–úŧIÙÑâº?…”þ5ßÄßÅh¸ ªnFÛTôE2„%âøeâ<þp´ÿîi-©qkâ(½†:7‚ùøøùþÛ#,uÔ™\–ÓÇé$W¦9J—šBtCn*•äÙDí·Õ}*­ál˜µ [kH‹U>+l–Ï;ƒ ¿öLÀ]Ÿ“×¢;¼ºê@£õÄŸâ3tX¿³è\/ª/Û.àïæÞ·§åÈ„†TÜʪMEÊrƒ{Û“ÃWoÞ¼Ú«Eöɰ¾¡úªÕÄ‚¤ØeIÑ›JJÌ.Ï-2and"úuòÑò¼ ß\ÏílÞ>lÞ{ñEü=/ *Í„AÁ›• -A"d±ÅžÅeyXÁ’uÄ–L6áàùéñïÇ•ž~¿:öÇí£Vk39-bà—ÄÀl*•ªp¦É‹8xŽ1åíŒ1X©õÆŸ¯€_\õÓq›u[挤€;OµÄ–´Ì–5Ú”=ˆynWáÃÑy1ª°e“²‡Ußàr’)÷’ñ½ÿïF¡«6gO²Á´ß§qψ<î.†÷Ê)p·6q’<íZñ`hôŒ5‡½Áç_¶…e`Y¥¸ôj,Ämœbgk<·9+x"\6rv‹kr™ ¹‚·‡°ŸK¸8&$î%e‘w05w&3´9`ú—3Àµ°Õx ƒ³Zæ$ôJ/A*Umç*Iª‚¬áV Û¡›++]¢óUXUM¡x6N¯sÅå.+Þj?¸¬Ó2Õä+ê´Äû—gÒ¾©:³ô‹[ ·îÚRÄ\#šÉK©BI¥Æq7Mz¨Ô…¼ÝbÞPSp'ë(`.äp1W=·Ä.W?oŒD -ØF9ŽS¢Ø×^·8yö„h1M±#üúzÔŒsiK÷{½ÑRHáÊ«ý·G{§¿ìvÞN©f§r­o¢Õ Jj´7AIšI£\óõðÍ ‡8§€¬VÉœÖH…Js}ˆer}ZPä [JkjfÑá)º&G+†ü 0`‹wTmòoÔOç­´PAË|©Pš¯â0nue¡zhŸ˜‹Ot†¹Ÿ¬"ãR„R½†ß¿aÏ»/÷_-Ïûò¬ßûB¼¾K"F»–Kv—\ª¹³Ž> stream xœÅ[ms·þÞ_Ét‚Ã.Þ3™ÌØN\»µGv»~ ¥«Ä†&5$=vÿ}žÅÉ“ÈSHêX Ç:Ü €‹Åî³ Øº¬Œ²Þ( WRÖ&\Yùˆ²·*¹w*³ÃÕ+21£± (DE63 I‘w…¬(«l@£ w6bCh>°b’vƒUl §Ø%yåi0Å1£¯'BËÀ)e@[&áOÄ ª¡€¶œA§ß9F;;é4 \‡?Qž žˆÖ³•»¨œI¸‹I9€F!+g ß 礱DÊ/OX¹Dè'Yå²ôœœòÄè¸=¡ºŒQAâ©÷Vžd 6›òÁID¶‚BNÒE¶ÊgBËv0·Í^fyT(#ÈQ¡¶ÔJ*š³ P1*dÓRÑ”3¬";y…ùc̃3œñ* :g‚о¢Š‘¨˜!cg²JdQ˜’è†ÃøSD ‡ùHYjA& ÇTÃùØ«ì¤/Œ-iQT9'©Ý0Œ¹v”¥$2eh‡‘:&” -”XÔ Ý;Œ0E˜(¨¡Š¼…òÉ ÚGÖÊ[¨¹,oÑù(¥,%ˆÙYôASŽÉURu1.¢ mu}0j£ä¤dù/ß}§ªGÓél¹Pÿ**dÔYQ¹þ[UOfÓe=Å[Y˳êe}1=ž}Á÷?Ÿ½’äHcæQãÕhŽ ªi©:«³Oóóz¡¤§§h­hcy÷j>;]/ÑPõꇧªzSY¢…ï¿Gñ×µ4uYãöHŒ½€Ì-XHt,6‡û-ÈÔ^s¹Š 7WÚÞÞü_–{½-ë²6Êe<².vŽçùGà²Wõîçÿ­Ï—eEI…?¨hws{µíÕµWß^w©–h¶du>[gó‹zÞvj ´rCÍÍõBâVÿß½ÿ§òVG†edJšs9ý4™È·Ï HAv.5\ˆZ–eÍ0žYg¨¤ÆÒ”Ï_ú°,p^Œ§¿¯ ™ž[2Ú@ì°Ž:ÀèÀi›ÅniòÃBƒÒž:ØlÒ–ýIÀñ68ë¢f“zÀÁxi‡Å _V&ŽBÓ°XhŠ .JGÌâ›…þùS@³ÛÐ<´Ú¦¾9Ò ¤Ì!2Ö4 7Р‹-;MÂ\Zlðâ: ×ú¿`!Ô`k}kÁY]8f(sÈ&h!¢…+ëA±1AªÁ®±Ù IÈè °íX !gí@Ñz°ù¬ªY2¸‚{g€Ѷ,ÕݳÆêä7à,G:;8ZÝ´àÂ[FONµOf°³$–x‰Nœ×BÛ)Ë<ßk!܆ŮãÀRµu-ˆy×Ëw… \—XìtgˆÇhÅgš'$ž%µŒÞšC+³3‰æhUFG«çyZ2³ÅöBnù³ÙArü¬NÁ «“ ð V'ác?«ÛsmêL"t—%˜Dl«™ûTŸ–pÇ® FHŒ)—¨:hkîe4nÓ(z/ÃŽX2ïAÂR¯ŽE§ â f˜~Ä, Ɖmƒ!Dœq¬’Y Ù›•a݃r¿² »ÒkDáìúNÞå:º¥—{Ê)úœžÒ;ÿgrr0 KÅP^#Á1¾.éø§H{.ÆNØÙG±]>‰Ú+·×6âKmÄ—vE|qÐå•Bwy¥ž°âÖòºÏjê(+†ï½ÓN²»WÄï!,‚ÁÌ%‹eáa© Ôv?5½Cå$ûu" #xf…XÙ`é÷qY2øLgt(yŸIEÓØê#Åju유ØoçAô£íuáA³“äTÖ%ê$)NÄqÏè(oVySWy³9Ð7¤|oßpŒLÚ›„@"^†éªÁ'@´í)Ò¢C0_2´Œè E\EB”ŠªÚÙ=]à áAeA3ùd`˜É>7té¡áám&øE±TŽ1CÉ›ãš^zAu³äI%P„!MÂfeO.rä»æØ›UmÉ {2뻄;ZßeÉÞ¯î`y=­1€‡Kªå(&r'äm£xokÈx·!»ÓûÞ5ž#|Û>a3B˜†ÐfE-¸QqÖN–„ìÍÀ°¸];ÝÇ~¼Ÿ×d¦XÖ¹6^¶ð"hÞ½2yC€ÖY,A‚®HDŽX.zWr,a_öy|òXlr6}‘I›×f‹¯ccРḚqØÅu06È«ˆ6à¢Jɜ܎•­‡RõΪ§B¸×ààYøÍ!àv9*¬%ßæNör1]¯xز¬Î2ÊñFÿ› ªÖºŸkÝž£Á$ LÊnð†ËŽð{T£E]ªW¿ýôË«g}ñòlöq4Mߜ՗Ÿ&£9:œžÏ.ÆÓK|2ž>š.Æ›OÇóÅòɾr¹=9Ÿ¯—³yÙ/€^Œ:­'[°Ð R a|±¼¡zKq#êŹ#€mVOF×ÏêñåÕê­ÊP¿ªfÓú뢥å[ƒ'£Ë… Þ‡Ô4ÿx#o9aò*ožŽ'µÅät¤ùÓèc}‡Hž/G“ñù£é外¾^Ž È£ÀWr8 z½¬?¾U õñuD³%ü{ÿòÝ/«žÂÂÏÇ ?ÐI…/ ËÂÏ·…ß+’=…ý¾Âûó¯o½_õ”~Øþʈ¬…½§ô¹dˆÿ5‰Ûí_tÜ[G(º¤×Ĭ¯VžµÏ,%Q‰Rò¡<]½5倜ƒ‘S¾í_¾¾­=ÑÜÔžd»Úó¼zSªÕyuQÕÕªËêªW¿W“êc5­fÕuu]Ïdz‹j^-ªeõ©úÒQ¶oØ„•¾ÁØßT¶ò2!,7õ­=VÐÑ·^-ØSßf·ÂUïÚƒ’ßßÝ:PVû6[ÌÕÀÍD#$*”=!9b 4˜N¾³w78¡Õ.Ù 8k4ƒþî6u¦“Ìr^Böd—€ûh”-9j×A—˾ÕAèýZU¿ž=_p¾Ϧͣ¯®–Ëëo«êóçϺžÔåÍb<¯'£é…žÍ/«¯‹£îŸÚÁ›3˜+zÏ™!ÔÜhï{¬am _<þÇߟ¼Å2x9›Î±…·YÑÞ4€}ù·Óvõ> stream xœµ;Ëvä¸u{}ƒ•UX>-†xÞÍ8±ÛNlÇžÎÉb& ¶¤Vs¦JÕMR-Ëß›ɽ d©íîÉÑBÅ"pqßOÔÇ]׊]‡éÿÍñªÛÝ_}¼ôí.ý»9î¾}sõ/1z'\+üóî*n;tëŒÝ9)ZiüîÍñêûæ·ûë®ít°Ê¨ænž‡‡ûýµr¦í:ß¼y>ë6XÑ ùmþ4ÞÞ¿ÚÿÏ›ß_];ÕšÝ5€ ÂÑ·÷›=€UÚi횇!¸æw{%¶mæñßwmðÁ4·7ópZúf>åϦ™ßßÑ9@˜- “l…’@ÙüeÿæÇ5í¾5ƈ¸äûæ?÷x`ªéoöJ"²ù©ä@¿åK8€‰óa3Ñc®Üу²ÞÉfz¢cy›€RÀc$»îâ~w­ek èŽu*tªn"£„mÞ÷w‡Ì Õ¼îßO^tFÉæp7&„-ªA:À’ΰH”Ü] Žö>žñmUNt¡9=Òƒö2àqñ)2AuÆ7#JxLhþÀÞ°= /éIkn‹3†iÆÝ)iþ+òÅ@§>íq½&ç…·pÜ4Ìñ Íó~‹„h´Ú1Êþýqœ—@¹^ŸÆ‡!JÖ¨.½É#€#mþ{çéf/]´öäôyz,žJª6 Ò²º¢mÚ§¬‘Qƒ‚ëæÿ‡½€ÃÙŽê¦&¹Ðz-@“”m…“*Rðë÷ãP*É<ôÙ´€óß>FÝÂqd€ÐÜoëAgj5úÿf‘ñ>\`‘ú ‹þíÍÕŸ‘ ¹»Ÿ®lØ=¯üí• &iZ æxe¤µûk-–k~Ý—:ÉUá6£%àâsðå󙨥E £­|™$p<À'¾Çž2¶ŠkÎé=¨Ý[n`@‚FÞ÷ó Lù@¢Ž†HÿWo~ù=“W?—ÄŒ8— xº@ïˆ(;å)Ó”äõ`lð¹ab …Ÿ!N§CÔm ÈdÑðP¡hu‘¬îpHà;Éh+ñœ3pÙ äʲŸÏo§c‚çjF [ÈáÐwý‘½úD¡-Žƒ­ey~u`OÓDŒó£É.2µì_ØÃ6üµ¿©ÜK¤? çÙÙžèñ,Y‘%Ë—!œS$Ç d©Dµ_9í8x× ²£y3Ídk`dL 8ŽõJC¢I!˜<ìÓÞ €uöÃaå䋳¿öГ˜¼'Œ<'l˜lÁͪÿ€î¸mÍÊó#Éèן¢ZJ×Ü%>8Åm“K–¹›Úl!‰˜3D³2xj9Ð>&/'~œÿ|Â’ýŸã·Ò¾õªNþ#>we°^t¢N2îçŸÞžyHõ¨¤Ylå£p°j> <¦‚·ÒõÝJ‚e|¶Lúñ 2„Œ=$-¥q+¨ýÂÆÄ¿×t&ÆhòÞÚèJÚ‰Eqàÿ4”2J 3ä„z«*ìGm«U®ü¾G%RAÏßTÂW½½àyÏ åæ³ °Ä€*|àVb‚¥@êH €„D\•C»¤a›BI½ û#sh…(!èûµ‰Q‹Rj¿ˇˀªüÌr‹èg³?ÉØ ™_FU@ž‘€vè;È](ëªå)ÔvUJj¥QöÊnÄ¡›/ˆÆ´©TŸQp ¦„$ý8öKØ|>oÀœS“2ûŠY›îà‹ã‚RäÕSÂã¢@¹rüTe¸,ÿ› F\®R!¦†ñ[Ä“W˜L0øê.׫¿—qƒJ¬”£,ŽÖØcÉC(!ίB}omûXtÏKt,+ÃBå8œkÊÉb†ŸV%ÁgÔ!æøT”‡¯ÎñQÉ¥Áæ–YW&XšŠé–WUá3Bî ;"¤O« ûÃð7&’hŠ~­71´a:]Ê£DmøøxÉWL *”‰O,é¸Ùggñ>-Ñ—ÓÕá©—dÄm”ègÌ·¡*¤kÞì=æ7 çS–ÄÕÓlÌu.Q%þ\ë‰íà*Ÿ0K T(2t ; Ûq«äubƒªºØHíIQ*zH@uÌÏN—`‚‚ô%Ðòóa`¦~›)¹Ê èû ÈѺ@VÌ ©*è©òÖÜ,ñBE7KÐÝK1/_Ë­Á¤2²?ƒ~)‚3Ä.VK/`È€Àê·…¿ÔüÐÃ]žyÄ| ;^V%_„Ÿe]¶Ë(Î’7Rä…‡ôKÁ/È­«z»4Ž”¼9Þ{v­tÔHÓúN¦þì+Ï爭òA7O $† ÔhÚì>B ¯­\2ï_™S± e8¦Åzi_ÄþbÙlÌ…xä‡Ð¬EMýˆü¢gÛÏ/_%Ö…³«ˆÊÒUÐúWŽ£LÆÑÌ„ï9F“Y•Ñy iIŠ nH|Õë´¸Xâ°[“K,¡†(v?•‡Xªmî~æÇ—ºŸØmÖ­°ö§<:¿S2´èÙpŽ$ÀOš®ÃŒg<4eñiƃ2ÿg<Ûmfk &øV0wíó  G}Ï(Ü8kˆ½),ªbo ûĤº83q§N`‡•ª—25tâçcÜÀ@hœ…àí–FhšA\ÒНb1Z’n¿Xt|Ž0iܱe&"˜V©$ªi)$7¤JM8á³PÉ…x£‘ŸŽìÌyàÏÓ¦…³‘¢¥¢½Û›4ˆûøx÷pƒCÀ-)Á"m»·e>@M&¡Di›Ži&Ð%1")¨ˆÂ¶AÊøV¹4bÉ_äV.e?²ÏÔ9m+O@­\[á±ùØQYЧðu¶à´!¾ ü·×˜aŒ¥·îÎUÎz ­ÿ~H--ëùš|.gýâ LRAÄZ3ŸúïÓ­56"Íö6±R»¨)´â{êGãïbÏ×ùÐ+/7gÈ9ÂÇ—;)Kkec´=5„2[\K{®‘&QÍ£§EG†`n ®äí…§×¹œ.0Ì:P¾—] ºLôï <dz¿ÚÉ@I"±O§D±SPÿÞÇF€Žæ«è¤w„)jš’‘Z%bÉ@]z ¤ÚËH2q¯1¶Ã$³Ö±ˆ°ßòTgjj­ ïci“U P­j„š]ì&IèÀžn¸ûYED=%QO°xe²˜M2M'œ%ãÁlUâðœýpL¡Õ$æ>°*9ãŽnWD¡žÊÐq`à˜‰Á b—D;+'­£ùÅ%K§â"m>ÐM·ïqè¿8ÑÊ: ßçT¥‹ànc4êT´mxuÆáù`°²ßôÙy!Hëf~h–” Þ'1»ñò=’ R ÿ¼v'-öš\ŒÿߌLy†Ì5§×)1êuizK—¾¾¥ ¥‘÷¹_f¼/]€ÙFŒµuJ–ˆ7?ì)IóUôŽ¡ïJ³?|b.‡§>¤¾W7´VíÐ~ „«#®w¨Ý¡£Í¤xÞSct•ÙbSÄwrгNl©éj»èó"T¿|lSlz |BåY?–òÆ*­À=kCÁÓ±½° Mb~éb5CŸ%©ÃBÑ!Œ-ÿÑ v–øùs>LŸ>°£Ž©1‘ÑÖùÇã Ú6÷i%¤hž¦„3Ý”¿Ð¥ íÌ­*â|¤-¾þV~›Ya b=Ði `–øSÃÈ]fF–8ñB[š[žr»K‡­²" ¨*+–j<°bH¶¾s©(k6ë6‹~¦39Ôÿ°x I¼DQ»+~§×š©qH¿äÊ[wó61sTìæÊòO[˜ù4jY³‚ŒÆfCpÿÿ„ÑôZcÌü#‡è3šcÿSÔk×¾†–Ä‘JË[f{,‡çIðuéSNãM­IéÆGåWc{Kr­ª\ì<œýd–ˆÖK3’öpMO Xå-ÍqIíäV1± ÷¢\^¦ûB¡u]º°h"Óyi‚%y ÞE§k©!ÂÉ®}â’.©+õz¦×”„çk¶£vÌ–yÇ0P™79g‰ÃÙ²4ÊhêóÍ4廄±–EæÔ)"Zø^G/Æþw;˜))ö•r–^ñRŽgù)%ÂËË'TD‰ƒöóü=V×,Ÿ;ÒuH§cÜ÷Üýñ¸ª ¢0µ8·Äô…\• ð×]+¬Šjù-‹’S²Î¨¥4¸¤^ÙFÐÑpé»s²9÷¥#8|MÝ£++C‰éÏ¢VPf´Þ ÔÊ|…Za+ÚúÀ™Šy[çÚƒ‘FàØ11‘¼A¡=ïR«¯÷×¹ò½¤,Íuv11O±$PàE³%HíËQtò0÷Ï{O÷çUšÚ8¢•_íÿ -˹³,1©Z²=qF Ì8,!{ÉSÓ m;qØlÍÅ‘eêŠÅxHhªÂéBP/¯D.y&ýůCWü•KU] tU[ðˆsÂ{GÏñŠ’wÍ qº4 §¢±ûð;LÁ²¹)Óÿžz·é ¾îj¼ðK0Ù’=§™±Ú¼’n²Ò¢ŸÓ‹âJn–Íêð:b¾²‡ë$gwÄMƦsFϳÓ/BèÂj:Z4¼€šù9Ÿb_?cN=¦« ÞóÓ?O‡j2èG¿Ò‹ß*áw,Y㯽ŽôC1º—æ<²°ý5¡V”`ÊSžP Ê­£¦>„¯ð‰xNà/ïJQ-K:`ó^éMgÍZµ6PM´aMôqšÓÐ:ƒû"ºÅØÑ”XÕ‚J«;œ‚ÉZ³ÞÒ6•®vñ A’«YÎ!½*¯¨Eiש0ö9B¨sUK“bѼÎXw¹@< •{H˜Êx¿?„å×™ð’_•·§%Æž‰Ã.º!³¡‘yQ´¡¡š\GXO¼<š#Ÿe K—}è|ßܧ “XÍ}Úv‰Ó~5í)ÃÄPK—¤Âŵvyø›쥣oÑÂP^SwVèw%¶ùãp l4 º"#:-!–Šøsˆ—f·t8¯u·™X6†ÓjÚíñ>òy¾wº4X½MëÕÚ´ŠŠƒ=¡r†èœ_gBíËUX:#DDô˜<ÆÓ4]Ïýº¡ô;Û2OÅk”íJ7Îm•úÒK|œ†ù®à®#ìŠ;ìðwp`Ÿ¹:°ÙãKP…È9XÜr¿‡”™ëÙÖ½†néPd\´Y{AG¿jæõ¬Ï7¼5ÕUm‡ª"¶`é—ÌOé°°ž´%Ô¹=±žýñ!³Íñ%àf¹Ð0ê?uêC9Y!õtðÖòfýóÕÿ9endstream endobj 436 0 obj << /Filter /FlateDecode /Length 5802 >> stream xœÅ\K“7rްO;gßlGôÍÕvmá HáƒvµkiWÅJáåC‘CŽZꞢºšÑ¿À?Ûùª€zô 9´<°{D"‘ùåøeÓÔbÓà¿øÿËãU³¹½úåJÐ_7ñ¿—ÇÍ®¯~ÿſԡ bsýúŠ»ˆg\”Ù\¯*¹½þ ÚzW´µ®V{\ß\=¯þýÕv×ÔñÂ[_Ïû»-~5A{_ÝnwJÉ:„êúGú3tlBU¶é±‘ªƒ·øw°¢úöt“µ*f9mÿëú/³Eìe;ejo-Ó÷nklÝ4ÊUíá- ¨¥kt0(´4’lu¿•Úk[¶8½â&ð½z™ÿpèúá§êÜ¥Buæk/áKjbCu“3¢½í˜B;€Äz»sZ#Ǿ¾Ã>À ãÒXÜiËU#[ÚÓ©½ËÞò¯¶ÑR{˜—ISª:·/²f‡4 SÕí©¥õ9À9â„P%ó‰WºÆ¿ßï0&Rɪß÷‡öÿªîÅv'Q˜`cÚŽDª¤µÒ%^FééSg‹ÉÛá~ Uäæú›«ë}>ôtÚª¸ ÙviXR#iOè³å–¶/·HžV¢ú›0«»)¯³Aas´Ã¥W×[ÿ7NVÝmyz'¡å9¼‹|C¢‚Q³.D,ð¿íû·Ù/Ç7ٗ󾻋ãér€öÿT)jÿXRS|»£­6è§ù?rï˜Í¢ü¡‹ƒãñ€ó £6 ?U¾´.ÿÒÞ¯tœŠÊÁžÇ×Ȉ©´öxøøÝÄ¿[]ÝbßhÄy¹Í9ýÝVÝëØ^ËêuÖ¤íó3½ïò)žA—Ê(ÌO+…z£ôƒvÕÖÀøQI`ä)Mí³©g‡ÑÂà <ÓØˆFÝ)‡EÎEŠÚXù¡ú‚y&ô›•ïÜím!ý¹×Õ¦©øÔIàSNä©Ë)éÝí¾Øûö°MÞEÃ0hÖQ à 5ÞÒŒ_çîÏûö‚åñ‹»¥‚$›êi…;=ð**‹‹¼:.œ&×8:M…BÒÆ*äœøSG»é÷=5©ŠÁob7=‘ÿhÀØ"ó}Ülj°7,³ƒ=M%`Ñvù„âñß/-’÷ó.Ó/óÞG¦¡^šI Íí*²²zSh¨Br†&åo’ê?¶‘b¯ =B[¼S2°ÈM4€‚.À¹ù†“ú°U» V¼ù¿“¼ãùÒê”áÕáL“1ežÌÐOÙßó-½¹t™|U¹¨¦ 蓟V¸—öš§8ïÙ¬ iÊV‘s0"±d„þàÈÏL²XOñG?Ñ.|Ò‘¶u£ˆ&•¬¢©¾iÏ…¼žÑ‘ÿÓõÕ߮ٚÍéC­vPƒÚXÀ†ÞI„µÏ«ïº\J ‘ïóM˦ÿ$m®•T„¤¨J?m)ÞÔRK[Œ+‚ÙÈ:¤hÀÛ ©ÛgO§UW»’Ï«¿‡ªTx™‘=¶O`¼0¾ *>5÷…•µ nÂ}÷$–Lúa Ç û &@†°ŒQãBõ#$bÓ*Œ§î « íß”'õ&Îh&v¬-TÍi ³ëÂ4ïØ\š¸.Ÿo†ÙH*òpâ`3"l2nÉ6íÛsÄÿ Ê þ©÷ ¤ ± @þƒ-ôÈXô¬áli³Œ±èsäE‹‹®5à>FEá«õMê'—mAAœgç=àGnÝŸn\% &tØGj) +°¯óÝ:>E•KÓÔÞË|øO¢Ê¥15àŸb\ L‚*—Î"8+IÝÖ8âl4ý¶ÐFÈÀjãzëUgb&a¦âüå'ÿËÛRyd #ÆÂD‘Ú¹<`ŒÉèÁ†™S’pnб© kPÖHŽR˜ãí¡ç1ªh`àüç,×°¢ž {é€ÄH¿t~9±màroßK6éù§µß¹âè)¨ãè¼ÿ)ÿû¸œ4ÕÀ>zÄAWÄœtÂs®9qxÎg.M?ñv§ÚID½pžŒKÒ"?RZhP ›bmôźb¿f8A£œƒ;›/r‹![ì;dâ¤àlçc´…fŽ‘Þ"-¥¬EãSº;m@÷ÓU7û;Û¥±Jš¡l¼w†DÿÏ@—è4‹NO©v™]@m.ëùçþ•Á^Œ;ïéÔ´\þ¸(S†ãrÃñÕw±ŸÆ)î ²V—79莱ÐFU?·eDµŠqĦö0 Šä¸ý=µ+eì×}àÎvÝ] \ßÖÏâ’`Sò%)8kا¶°ózqk¥©}£>‰‘С–VoŒGÐÁù×E¢<* 0á΀Vù2wñ_¯…=OC9!u¨¾LAÙM!A´]î)vV7²vàXfK­>:ujkDÉÁ/³˜f¶„Õç,Ê!9óްé{±'sÂ Û %ç8dhŵ²ôÓn€y$›wøÏNÃ’XƒÒBhФ¼ù,Åmîç-I·BèÀáÓI·P¡Ö~c,l9mÍ·?÷…ùê­?ØM’\õ×ýšö?c+pïú¦8¥z™÷_º4%ÕôLT4œ}ÐÖßþËW-È|E¥ªŸ, ÊÀtàì,úa‹ nç¤$}x±<¸z²ÚoÉa" ©@yÔ…Ah#¢0SÍÎÍÑ_|´ãýdpNæÉ9JÌs4@­µ(+xÖäåJC3/÷qÆbIìµ€£$‡|q_xí™5†Üfv[×^é4À}ÓŽÙ€?F/Gé‹y/Db>À")ïd¡•OÝ1e­'(­Yþš(c-ÂÈŸÇ퇄xžê>³I€#´Ÿäøƒ[‹Ã¡£a=øü÷û<?fÙïÉ‹mеä¶ EÿY4™>¨¼h‡Z%IÙ@~Iõ? ¦ÃNþ©[¨d¡ŒL±A%ón¿pF߆\cJ%Ñráxýóš,ÿºŸå!bʼØÀbßÛþ|ÊÍM™ÞÌøéU¤FO ú)‘æ&ÐyÆ$0°‹›ZÇ9ð¥ªÁÊ‹ÿÇ=Ék*̔Ź3ÑÏ÷Gqöô.Åì ˜IpP[îÆ[ª(æ9 P ѾՈ}{î`ÜC —èÒû<ïûÿ.\«Œ&’8š±Û±fíèÐó°ª84ÏSuKô¹P [C‹úVW@í«þܞΩ/¸z±ºÂ‚?© ²(ýPŠÜ×N­¼’áôÿ‰2ÝœêÉÏÕºŒgh(É8ú¼àµ!!Z®í.õ'ñѼMK“$¼–0®Ø}ˆP¤]f¡XˆËMãµI<¢KÅ£q«KˆÙb ±‹Š?+Q}ÿ@N.ã{qTŸèºT Ùhk€»±”ëcƒ[Z‚¬çÑóŒˆÓ_üÒ¿Ñ‚U#j-d±`õ„cò@JW®xLñ¢öoè”U·§à‘ç?c¥BÔÈQuƒ!^©§:½Ûy‘û$J†3+øy žâþåÜöd+9(ºg (s³Oøj@ªàøMtUî‚G8¤¢W¢¨ˆì7Òåx î§V¡é¥ãþ”ÌŒBw؉|< ŒÙ7¿Ù*1y >m¾Jû”UzÀ¥r²Êi‘׊j9äJç&Qe5_Àhkq&ÎfiÁgà N5—EµÔšïöEÁeŸúè<VÈsÏxRrò’)~6“êjBÜøØÌ¡6ÌÉ2•q)õ)AÐ]rñ ¥w_–_:ö°ïW£Ã7‰pA',-h5ð˜ôº‹Uà_º·§;Bþšô 3G BÑߟAôgÐ.”QÕÐ Æ÷Ýëó}Ë)0­0ïb1}œ.Ÿ´Š £ÃM°,©_µùvö%¶¦È8Å7DõUw*Ò[?Óoz^)C:ØWÈ.­€9øh÷Îí¨K%˜í'¥«5Ž.ò•¥0XD½º[*ùªèXëôf§<—þàžJ¬^m,Óøþը˦¥“¯ŒŸ‡@œ©^‚+¤cʘùJž0u‘àêS ˆ™Ã«ãò¶]Ò:IëA'ÉjÌõfùÚÑî¼¢)´Km(ÄQ›.³f‘ˆ"à‰Há”|ðÄP«îRäBüzZ«ÎóQ„Ùˆ¦SqÞ×qÞ‚4Sl )Ïô-7 jÓ»†Zà~ €;Q[8ØÁKcéÚ)Ù¨MÖðyõù+çD>ÆRHŸMþÊ?|›d2R@®Å_NJdg¹rä o—øH ÂĘ–ì’h*×òÕû\kN«¹)mŽ­AØSàCMê+^@iÑ¢ˆ÷/I‹@Æ—ÂR®.ÔB¸Ažþni/„À)ÄcE®,î"Tç.0€"þÜï¢át pW±F5q¾2ƒcThË9±`éœ[õ×´±…-%ª‡à_õå"¹ªöàÚ%Šÿ k®jðEbÀ Ú žy˜‹ˆó0‰Ø;j¸ÿiib8DÖ6r“µŒU°.ƒy†õÂX™Ó¼áB)€ú0¡°ç&ˆ’ÎY4h¶ÂÁ^RhD¤HRó‹‚%kkͰ {:³ôÔÒxÖ1.o}<íTpć)K ö°O[ÜE'3p@,KÍ–êd¼+BÒs±@‡Ëý¥ü£DÌôƒ@ÐUš û]D8¡^ÚSäº6i.œ%W;+1µ$€ƒ×·1–Óžn †%3 1x§ ÔÒ ïr¢fxÑ^ÌÛ- S©e–?T¿ã`ßÌž&ò‡ ö,Ôv”®™Ûî€sC! ¹V4’ö`/Íc¹–u…‹’¸ØþsÁ<ÌhÉÇ0Bó”þOÇ;fÝYIÒ¸Õç‹úZÕŒü@’He¬tÍ Ô8e¸Ý’‹˜n>hï. ¨T½6e+¼ewϨô"ÝxáÒ ¼†¦%ÅÙÇJ"(ô³ëåx¯N &Æ( l³Ó矋7†ºúû»ØDÊ] ¶c°VÕUçûnwß¾çKwôJÈݫݱÛÄŸHîrÝcô³ÏÕbä™éÄ—SVmø«ÄP„çøY”O'´ÙŠ ¶Æ¡&°­DêªÁHDꦉ¾Ø@ò’4HÙÇêÀ9þ«Ã’ª‹µºzO!!›áIe›ªHŠràÐÓsAŸ$´Ä☇26«'}™¢ñÚ+¢ôÂs)ë ÅX§Æøaýéƒ ¥Œkñ&u­E+ªJ6’ïѯf4Ç”‚ágBÈãrènÝã¢)îrÁé[µ‘ åU³L5•m«$Þ<,Ü©ñÖ/¾Ú’÷IÍ2åõ3a~Òˆ ÑK€›à3Q\]Q>YÂæ•žÒ€¥—GËeÌJìŠä—ê¸O¡íò/«ÝoÛA»ÈÀ@N1kUª³„¨ȋh7%Vc*-r”žj)îõÓ>]š‘E5–?`•k áÕ¯$EgƒowÓ£L“0ÁGìZšÙÎEPÊÅ™&Ú!£oÅ#lýXíº$²8¾IeØÞMßøIå<m¸ ®Óp˜<ÓôpÀïãôñ¡ P‘™#mýgÄÝixÇ}®ß' YEøŸëƒ’Éñ„™R’I¿ø|_“:BŸaxp€žA±d§gíU$ÕLáÔÎ,¨",,¼©â¨èêËÐ çI.îf9• rÈáCwŸÛR)£¤ËÍëægåbË4‡é²b’…Yp}_§–ßzŸxÃV".˜^°éÁ‡(1=ø0× iúweùUšÖ®Vjöívx›ƒÄ?CÈŒiYâÍfÊĵUºp}ê­¹ÄàYçü Lbeïl´é6IhÆÛ$cOpÉ,ÂN×^›<)öóòXz.î´ÃvÍuO·fwƒºˆÐßX›T²Fd¦åžZª‘ÈKá»Ø߈ËÎp¬gŒû«M׉ë‚ ²÷ÇðÚ8;3lø½y¶±Y~n '¶+¡Ô•×À‚XÊâj"Ü Ÿ‚G|S=QäçOp0E¡ ƒ®·‚긪/ ,²Pç”B¸ó›ðãÞÄ;Lž !VÕîø3:‘«†êOÚ0^£Àozž ¡²« “BJêfæ;ŬÀƒÒŒ¤kXq°°k²%4›Ss[Â#:.€ÃóÓ¤M .Š¯å› ça ›`:]LÙÛaP}Ù/7饜‰K@`rªj3ö,]€´¥«Gd9z=njÀqáÍô×òAOÝXˆÇì2ÓªÀ$æþ0£ìô’^“o¼c*ñÑš¾;uÇD%¾÷3Á qÐ0}`!;T÷©dN Y^’85ÙØ¸[«€‡ÈósÅ5\W\j˜ya…u§bº¿]ý/ó’:endstream endobj 437 0 obj << /Filter /FlateDecode /Length 4230 >> stream xœÝ[Y·ò¸Á~˜ÇžÈÃð>"ø%‰a °8Z ?ŒwW«–ç°{F–ä_Ÿ*Ýd{ŽÝuà´3=d±X¬ócõO3JØŒâ¿ø÷f}Eg÷W?]1ÿtÿܬg¾¾úã?4>!Ž:6»~}¦°™e3£ qBÍ®×Wž_¿…±Öcµ!ÂàŒëÛ«WÍ—wó%TYfµmöûv3ǯÊIk›ûùBNœk®ßøÇ0‘º¦³ÃA‚8«ñ‡0A³æïÝm6ªX¥›wý7Ü„Ë[b·n¶PŠ(£¿æ«°…r»†H.¬[hþÕ„1®Ø¦$\2‡üµFÅÍa7‰Ê[_ Ž$ú««—j$Hj'€A|L,8ç„2Û<«;³ÄX“Žá¶r ŠhcŸ-ÑÔ)êmM–HMaDX®岨T&,ÛÆeY>Df9Mjö»•ð1ލr¤€Ã´,?ÝÄŠ$Š œyg#¡E>òymÕ7–”™€]HÔñ}0bi9Xt²H#µhºøÍ xR;%Áˆ’Ò%¯±CBÒq¡*j[–TŸs^ð‘; ›ü¼""°©5Hˆ;8ß‘vãb`u3­­#U™i. ŒKOŽér±NRe I´'ɉTÖ{Sö¬æ!ÀV8c¥ö‚‹)bt85¡ ž#œ).މƒ*a®f&ˆº8ð>à –¿ìŠo›9·ðÅðfŸü³“Í>÷âwá9 jvíº]-»v?çêæcü‘Úæ{°`ã]z*üX°Üæ=|*»›£'0VÊfW²ÙFJ"ÅÛ’‘aêMø¢ð^uÎdf×ÖC„½âI_—›l½Ûás:Çsâì”Që\H¡ä ŽÏyç (˜'(Á9QV68±d¾PÖ§¼yá·ªpT4wKoSðøáæž­0 äö:~Öº¹ûÄO’Ž2r³ož 6UÍÝæ.Ð`°;ÞdŸq›ÞTB†¡fÝ2 Íp'6¸õ7¹ûøË¶[·7^!¤5ÍŸÃ`9”Êæe&ø0y{ãÕS2Êcq n ým÷¿ä_‹ß:OžyìB@îà¤iþYä+û\Å2a\*®Àó‚f¢ˆáåqÒåÊ+ 7 ä<£|1I  ƒq~j~@B IN¡°(æ/pÞ\!o3þtxº™2ÑÛHDrt(8ž[£J÷ «HÉ´÷k:Ùäún®½SܽëüˆÚÞ/tC&j¾õ¹åÝ'0ˆYX Õµ}—†*8†_Àö⺥H$º‹~Ý×óa+Û÷¢aáR•ªù©DQJÌCüE™‚õoj™pl˜Mâ÷'3‡u5/Òå¾k?Ô2]¡ˆ´2-öm•0ŽY@”ÀçsŸP&P{«V£lZûC%ðiÂ…„$ÏyÃØ‘¨f×÷²‘Q!0€ÚÁñ× ¦‰˜S ÈÄ\÷‹‰¸iÌõ@UH)XŒ¾t`0H ä…ìAf Þx†Õ“Óã„s I¯)mAtrÎPý“äÓœT3ÞA€Ý Wàõ*r^µc,#6Õ"EBŃyÔ΢EœS¤P8‰ÊS”)µ öÏmŠ›©H)9Õà‹`“Y(¾rݱ* íºŒOø‘ažU2Z«¦ ¨z¨¦ÜÈb4fØð—™˜³M™Òòf Å±äÍ@S>ËG¾ª­ Ç NNŸ0¾ÃU§KÇ”5Ϫ¥#(‘¢`ìÙIŸ5År>Á—ñQ£,® ÎQWLŸZW7päš«'â¼wg=çZ.Æâ<, hª,ŸWuv¯Ð£ýZ"¯¼4Ï)#…BàÅb2êݱ­i(RQ’?¯šïæ 6å¸g&b ^ •”Yƒ}ÁËÔvŸªŸ¥@@)’ÒF¬O´ó‘ÿ&Ï ·Ì1!íÍÏ!³ä²©TFPØ5ûv»Ö©E iÄÁ‘øÅ”øSK(:ø(¯ÃΉ Î\m*ìƒØA¶î”:ƒùï1Þ›a<¯r¶Hs‰€A Ø_­u…/ e¸>áo&œc>)ÔÜqØÍ¡b½É6”…àF¥‡R¼õ©/Ö‘ RÃP¿ÿRྴ„€9ýmœ¦xÓ¾ŽŸÅ’]Bm¦á±†Ò,ŽÖ刕¯ “ÓZ¿D“Ó®Ù{¦9oÞ\‚Óá2&ÌŽÇZ|—°ÖUäj[b+BH¬ FXÇj¹ƒ±‰æwï²êe]–má1–«°ŽhöÛ„”@Ÿ‹H¶U±`¤¶9Ý.Ì›,”Úû7^48C쬰žïAöpÂcgßDŽû¶éu°åa÷'aÁ8Æ'¡ Qœ„¯È"éenA·á¹ÓÍ} Qî† ÞI.Wq$ Ýæf‹.€k¼qÞGúA /p‘øÙÕ²»ï¹3pÈPŽ£ÞM]uEÐ,»»HKºæ¾+<ÉuŒõ6r%A“·÷å±¼™2;o.¸\±Ân?ºÈ0¸e›\°·ü@Úå}qºËUî>’J|½Ý'jF—«,÷É[é‰åÝ´oùtbk­Oê‚G”®é™×#çúÓ»B·²I y,¢çˆÚ]‚Ž@¡=ñ<‚½v:'8€(´âCü¶A„…×ðƒåNÃð÷]»ßâK’Æ$6ƒE¶ø¶ñNfœnÀ&Ñ™á6î‘ðŒÅ¤otEä Ò`j&¹f„I¼"'LLÿàrtH$!›sTþFÐ{^á:ÎXÑ÷ôèŒÖcFÏà™ãèÌÃAÊitižY}õ«>á¼àìV0®V'q£CÎFø G0í8\€ÕË|Æ_X[V"¿ßaGÞÞ “sÄÉàŒê;m1FÈÿc‹ÉñÌ'°˜h·˜CÝ´ ÷,‹9gÚéƒÑ·SpE޾aQ›úƒÑ·¸óAè›(·æ-NJ ÊæÑ7Ù£oR0aGèÛ.OŶ¡ý}›§YP³r‰vês:.™¿Oçt87üxÔyiú.›Ý#u}ã‰A™‹7„žéÊh[ääëM¦®ŒýsØa7 •áû´ (ºÉ´Kl8Œ2T3H)Tð=€‚­q‰^x7Ïs°üæ%ï‘R‚ó§Ò3åËWYú}™î;ô ûEñ½<&ÁBΙ²Q p6ªÌbmžèôdàsY-QÂõ£ ÀPnºÐ€M¼%&À`Æ…KýÔ! YæÎ%¶=Q¦”¿VðE…. ¨²Fq@´2v„®ƒ3j£QzOv±& }/PßxpÕs)GÞjs·uœäÄ¡žà6µ;‹tT¨‹ñ³0ADÖƒR^3pO$Ù|H7/2ÜÉÄ)ª>D÷Ðv‘)z¤Ä㢈_êìè·Ý…õ«—ýÆc­ðªPóÔ÷*_æ(÷ÖXàhcXÒömKS¡à.RR2œž Xh=å|ŲúN+‚T¼.Sæá݃ÃÇ5TSìoÇÐè§rØQ‰wtÕåD‰¸µ»ýr2(°6[t4fŒ{ÿÞ Ûë]ÊŽšq<êZ÷qž>·Ën‹ûõ`¬‰˜=w> /o³ay³áò¦âBò›Aª{B“÷†][jy ÀˆB55w Ê=ð¯ÛRËÖÅŒú•ÜÓ¦‡b%[ø‰zÚ‘ºØPÃ)Uêic„CÅQÈÈG~TXñh¡}±¼îé¢Jžêƒ0C±n¥Çú¬o9Þf‡º{ª1Œé¾Aõxc˜èË—#a=¨Ö7†ñ'j Ó†Ÿ‰¹Ä‘é<±‘_•y ^´`–N„e?œÐãE¤°†HDÞ¹÷*¦FÁñUî)Fwx1Xõwxe™´à6üªRå»?EIZ7:EÞA`Ððàßçí$í{™Ç¡Q‚C–ܼH룺þuÆýd}oé²ËSE H HŸJì…È{$Äu£¼x‡³t¸É«íB¡Þa éi[Õ¬·»=*DšUM#”CM  .sáŸtýy¨n s‹Ðû㈮tʘµXÆ<{SG³JBTv”¯æµ4w?JSú;^}2¹ñ7*ZÜ †ËlSÆ´3¯˜ëžŒPryÂt¡L¾âF­¯Bƒ¿Ý0OàÝã-ÐÔ}8KŠïb M¬ øØ'SêY¯"ùW[4;ùj 3D ‰¯˜õm¥ëvÓ_“¨r¨¤&@›ç5„ –}+ì3–^8Á‘ ”Ä¿j‡¯É(s É^ä ‰-åÁ±ÿPaaÙ¾û‚Êz óE“ ª ¯g.Å´ç5MÅÀr6„öŽÑß/ï¦1§ÜG·u²Çƒâ椀!N‚•],`ŽÍ¦¹€WUTsžx¸DÀlÜ•Xu{ßÚû8ª+®am†˜g¼œ~Oˆ³á±½•¹•ÃÛª {;ýÎÞ ¿e îÄKù‡ Á¯ªoHIz°~Îåoû•(µF ­|ÙW%ªvôvµ =8žãïƒÓ‰€|±æë"R5æ2Ï–6aŠSöŒ‚ß÷pÿYyF@¯.L3uØ&!)•)ÍèŸíÓ øõD·—ó}¨L1bkZ\Ù;7ÇXAC9ƒ«ý£anG•ËtÇR=‚8±w&$n"AýÛf™G-ÒZPë¡åôb£¯ä Œ—yÃöu¹ÝƒXÏñmmîÎ öxisFsíÓÈßf´ïû0/ ÷âx¼d8šŠ÷õáÙñþh8büD8šP.~Û£Žâíhùë„£·Õp„0˜¿ï=+1ç㑌*YG&ÜG‡€”F>«)¥$Fñ tüÉò-v¹ŠslM*T|*ãzdJ;•q ùÔÿ Š;ÊÅ©xôø¢‹èñWõ nÐkïñ‡‘'ó¬£z­a$vz gªYU~sõwœendstream endobj 438 0 obj << /Filter /FlateDecode /Length 5719 >> stream xœ­\[ܸ•Þçþ “jßTKïÔóï&˜ì&A’i`Øû q·»k\Õå‘äKï¯ßs!U$%U·í\­¢ÈÃÃsùÎ…õ˦©Å¦Ááÿ7Ç«fswõË• §›ðß›ãæåõÕïþá<©Û¦›ë·WüŠØoj¯Û3®n•Ù\¯^UÙ¿ÙJüÛêê~ÛÔQN4mÕÝnwø—Þúê°Ý)¥ê¦QÕ]:lÀQ-¼m$ 0¢U²ÊÞí_à˺nDõßèUÓjÏG|.áíê‡SÿLº÷"~e«ÿH—ë÷øï˜šÖ´ÕËÉ·¼Ýz؉ôu£…­Ænû¿×ÿ<±MÊ¥l- ræúæªrÛ럯vZ‹ÍN¬Å§¯ª—§ñ–ò°”®§í'm,.Dûkì±ê9ÀÚVÆþ6ýnÂûÞVÇì›nH)/ÞŠª¸s’6NÔØê' 6k2[y`¯µU:å jU5žÂøröSz°‘œ³ÉÀ1‡RçÕÝáôS*?‘+œvv1Û9MaLõv›PÓG&À‚©LãEõ)}~:$ß»±ß¦“ª6º•›ë?_]ÿöð$CŠê1ˆ%î–)Ò^‚0û”wQa ’/ßVi’Fê*;·> ºƒíO*còAô®µ²3Æ A¬Aز •­«î1J,H~aJÉ@z´~B2hJ<¢€N %=œ†@V#d8 ž%Uå‡UQÙgRõïQÛÌ>9Wka6;ijcÛ–TòϨ’¥ÖÂ8i‚ξ®xD›Ù:]K8Û6ŒùçÒ$m­½j=yU½Þ"¿<š§ïy­Ù]CÃ¥â´ßY[¯á¼<¯jÓ§¥Å;][iœ‡}ëœoyþ~x¡ÜÂôM­´l!;)jï/°{S)!µ÷ÒG“õ½CÒÉ„­‡]J FL8x\¤6e¾ŒPøR×(‘Súó¥ (8F¥P¦oÖŽ¦gw@ˆÈq À >krZÀí~bFµÏ‰ZYà=¸±¦”å‹/G§CŽœíX³§·µ6EOÿcÂÐ3ÕN[ÅTƒé0W`9dLãÁÙúÂ6-‹î0œø¯ÖËE¯ÊÝ„A†*¾ 6£ OÁ“ÇŠkyó•Ž•'ƒý¤¯pÂiaFç^»êñx$Ëþ ÐHä›Àøë} ÇNÄU¯|Þ÷#O`‰6­[½™Û¡ 'qW€b^ç˜2¶;²*ÃŒº×s¾,¿=sÛD4hðÈÒ½ÊâQìÐ܆«o¡>…˜U:À}„âv& ­xD=¹p¹ï‡)’Ù¶åæN"Þ)¢VS(9€9t‘<€ÓüzŸP1 û4}pÈH¯C`fô¸§´•$³ÚÖÚ 'µÌ"Uow¦Aˆ^ýxÛï»à(&é8ÞŽ÷ä¿Ñ?™êf %¬ª—²D»¸„”µÃØ‹–HÅéð±Ìh¥í %jÄ•ÎæqÊÜ`ñ%DëïS0<ý¿Œõ¼IZX‰ÂŸ¯sõHóÏÔ§A÷‘§ &VÒ*˜|!‡Hi`ìiã֛ߋ÷ǰª‹§6‡;AqŠ<¦jûO˜Àûˆ Þ¤® ßuדœZOn}-“CC¨, ÈÀ2ŠšF¨ãȳ)ÀéÁR­èé¡Ðj÷éùý ý#fˈ ”%®ø~qÆãJfQG7ç+­À©Š¥¼ FJ¾‰¹–‡Å˜œÕ"æZNÑÉ‚¹ýyÍN½I¡Õ8ij2ñ¨K2àœ¹H…EÙhL¤âß”íršs3‰ïø´¬ÍÉœx%3SN¦[W[Ϧ›¤—ÍàÉçûÄzwYQà!iÑnáXTŠjÉÛàÑJOTKÃ`3sìÚ†xù,È\š^Duæ÷«.¾Q¿ÌvåÍ/À)!œäI `Îþî6|ƪ6„œDq%¦#N®Hð3ý_'Ka[™ÍN­Qs/ú¤–Œšÿô8§Š\õ>¬ØNáá2ΔðÅnCÚG“äÛÞ]¦ _²üì~4)†Ó1Nf ‡>.ä\„4ÙŠCx$æuæhº~Ü#£uJ”uÎy/Á‰pÊ¥1‚(N;Î,ܯí9CŽXzS¨(;G[H& QØóVëÃ^àåœÐE6Q–° Q3¯m.Y&#¤N¦µ§D Åhõ1õÿû¢üĸ ãÝå<ÿ9ÖQäfÖ_6Å ÑãŸE^+òàÜúP ï£DÌ5& bv–¶e)h]â¦@'Ùù·a¤¼\üóm‘¤\, üŒÜõÈØ¬Z‚³êÆ bÖ–![õ+`™xÜ4«5$3Ç[M+dÕ©ýØÍ]¿¡À´KSˆÈB‹>™óbÿ³Ô_X>%ë7+¼I¤dÃ—Ò D©Ÿp1ËT¸žFóÁZFðgÆHJ§Y.˜}¥…@§Ú‰+,nÀOŽï‹CH`5/­µp'ÕµxbòcÓ ¾š^?nEoçÀ,ìOéáÇd«W+ºRÅêë,{,ñçÈ?VúÖú£7X8ƒˆ6k|(d»}]qѦrÆÔÂˈãöq¿ ¼?>ÖÈù¶LŒÿ$àà´Â(ó%•Fº¿2ù¢œ¯-êdºšÙ€¯@;Gï, „ i*F¾"ƾ€ÿ¶%KˆUÝà™)†Ãº}Ø’½ÇÄËñ¶O#dp 1B¤VI€,—d@ÂNa×ßH‘•?/ªé<¦¼Ø¤Ò 1ÎlÐ,%Di\¦$1ò ÉÑ’ïÅ,µ™‡¿ a®™êkÌáë4ªúÜ»Þh©©-‚Æ€™b¹%©î0QÆ‘sáµZ0^¯¨çŸ‚I4X†HÙCâlºñÔ;2V`UѪ3Ô#ÕœLقູdæ'…Ëé>‹#H›ùúC2þ3“ ¥pmÒtÚ³,‰eyË“Ák£ w4ÎZ%x‘5zãæg†æZ—©ŒRp"XpÈàìB/ü¸´µ”çÈ9Â0Z =ô·TRnæDa ‘¼#}aGn=Q~ê§…6JV¯Ýr› âFçq+*ˆwgÆãg g)7Á2.¥¯(·í’ˆÇ¢Ï<ïƒs‰"+3Dª<…ŸôÀ^OÒ‹¦©àjÉ("ŒNZ¬ý†?‹¤OÛPÀÍúóTvRîRî“i³Õûs­ KÊ;ÁRÒ yàä°Æ©– f T¢ÁÄ LY«yV´rŽ8Ó¤e„ÍN3lötÔ!Mì)ÕÿD¸Á)”y¸Ñf0#0T'W`;Ëx:¼.Ë‹7”w8Мf7)6éŽTì´ìÑÞ÷[Cf 1}`îÂCØi‡í_w‹=ƒ°IÌgýG߈´ÇNú_°¡‚Ë© 6Þ—q»ÄีgFÜt—l’™/zsT;Œ$x¥o3ZÙZi—ïŠIŠíG7 ”˜ï pŽÒâ¾~JÎëáÍý®{¸a+F €3ö“=£ñç3ÿðp³Ü \rSãØ¯q¸B¸Z ½Aðì•b¼ì3<Ÿ[ÄØi8äô(wÌúp§nCçf¾©(e«”ì +ïØC%´Æ¯vÔi¡CÕ>¦Ô²¶Iê})½û]ßÍ›+%5ZÙ¢6s¿Y 7„ô(&fò÷cœL_tø+Âßngž·ópŸ7Ö,Ö#%'—¡ MhDõ ²8‹¢lõnÎ8CTÍš·è0¯ˆgï¸Z8SÉ¥NGì“RnKŽØ¨—„aµƒ±Y:ù/K›¯Ç^<Ö*ÁxÊ€jš";^´¥ZrÌ<)*ÔT¿?ä.-yªÍ¾XÜb+kÕŒ§Ùsú‹*áER–!f-—`xåÖI`ãóbµ&0@Ù˜PÐ~FÅÀ–“º !ç| ìÃVò¯‹\Ç´V;•TàºÖKýìà€›Ã~ž6ŸàSâŒ{ê„0T“Ìu%ì­Í­p7Œ/8Ù‡U¬v¦Íšô çg);ä;„çÇîsè1)|A™œæÀX.¯»—9û0mm½(LÛP„¤â­+«ì´A ) ›Óg­¥­ýq‹×Ыp¢‚àZ^¸þÜ]ÈLbä*M‰Ç—M6I_4øqê´U}!œ®Tô ì èoùÆÍl<·T2+›)#¢‹ÌÇá’(XSPOŠ­ ÄdkNeÕ\÷®Šäa¨}Н©"r Šv—,©ŸÇ|cFÝMܪ½ˆy]w’º0,h@ŠÈê||¨RS°›AÉX[ÁB•ç’òﹽʢѵçî+(‘”‡Ä!¯ÚfƒÒ#@¯Ør?Ä~š4”Ž=mꙑwXõݲu» SÃêÔuìù¦Óü¶j3ëÌ+ä€ZîÚ%9ÛåV"ú ˆïã¸Õö‘½p Ÿ+W´}$^c*—±äuÏWu›$õ LY =¿Käˆ*¿'5Œ‹™œ6v†‚¢+®È‘iÙ{Æ5J,¦ŸÎÕÌpò áñ»@BN ç0 'Fdâæ»S¿Ï¾=†o1³³†v+ÒªÝ,$•b)úaºõñaiy¯œàDv¡!¹h{¨ÝÙ®ŠÜ¹öCõšâðÕ•:RíÌSN³ÎêˆH)2-Ø1Á©l:Û±KîÇÅQyßb—…Ô âGÀWøÄ²|¾ð”LJªƒŸÛ…ž}iH9“‹7kM<Ùm$Æ |{†Q~ºÜ„oŒ jÏAo·¢¬*®‡¿”8sŽ"’¯5Æ–®EÍ´Ô_5Ñ"×:XǼœØ:°¶”¦M–WYãòjÞšÀ›º”4Ÿ+h…°Y—9Oàa…öaœªƒþÌÌ!”¶’"¦?Å;o ¥™ïãm:á’ÎÖ.Þµz ¯ùvбNèD)¼C؆¸ «„|WUMzgB/ÞØt—kÿáÖÜåÒ?ÓQÆÿÓ6Ë›¢a]0Xc™8/RÇr¿¨~8M½Ÿ¦Oeʈ:<Êèê3”šô"9ºì$I»ï†ä$_ëm¹i{nròVÔ4é°TïÁúõ¤AÌr½Ç4”þÍ*ÞKY¼Ö-[ÂN¹V4+Äàò³ 4)¿ÓšêÂEZ©I¨½Ü`Æ÷²ØÐõTËQeÃõt|¯´}†îï(Š&–ä]LÝØ…„_—£O½psr5ñš²¥,x¥Y¢úå ÚMìÊŒÍxY•ìˆ mÄ‹¿¸Öõ-½ÁÌœô¼ÕùT¤øXÄâŠÏM ƆËë†oÊ_ÈRð &õQç^ JYNY­†so ìZdÖš‰¨cOÛþ‡ ®ctõTJA7“vk'7%$•¿WÁMXDôC5Ó²‡ˆ‡ìrØÑyðï$½-1™>5MAë‘‚îršŸ¥Saç©5…‡xüäÇ©H0 ]B[p˜X7ŸÜµ¤–ª”7i0EpEÝ>Ç”!ÌÆÖ 2¾aöÜuC¦íóÖmœZ€Ž…X|{ªFû¶ÆŸN˜=hLž« ¹…,‡}âXÓïü“+ç‹§]êùé· <9øK¹›oÈÖÕÔÂbÏ«¬•1܃ðk´d(]ëÆeóRféëÛ\„±µÄŽæó”!±D?—`§ ô ¿G@-£òI¿jö,?Ò†»­Nñ§-~×…ÆX[^ÄñZu|Œ-_! ÊAQî5ã¯lˆ,ýÆ„™~dÇ?ÿG&‚rm²Ò 1Çx*y>ê4ÝC¶¡4EíDŸÂ…h¥Ûp™,ûI¬'å|wŽ{ñËŸƒ›~ŠË”ÀPQ3êZÉ>ãþafãèï&[ÚÞŸDüYœ@`dÁì^+B`U+“.„¼õ.5K¿ú@Ã÷Œendstream endobj 439 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 5885 >> stream xœY XW¶®¶¡«D\BÙЈVƒû¾D÷h¢â†#Š î .젠͢B³Ó}h”]‘MiEÅq‰‰»Æe&QcbtÌ$'=…—̼[€‰“dæÍ{ÔÇ÷5ÕUuï9çÿÏùÿBÆXtbd2Yw—‹ƒ<Ǽ=⃠ÿ Ò©Þ@R^e¶ÄX‚µ¬-ŽôîÓÙcßBëîçz0ÒÏä÷?š±yæ–YÁ!³·ÎÙ6Wê1?ÌÓ%|ý‚ˆ nrõZ佨Çm‰ŸÀ¸wÞ?aâ¤A½GŒ5æí±Ãôe2ýW¦?³ˆÀ,f2nÌf0³”Â,c†2Ëwæf8³‚™ÁŒ`V23™‘Ì*fãÌŒff3c˜9ÌÛÌ\f,3Ǽø0 ˜?1JÆ–±cTŒ=Ó‹q`8&€éÆtgz06 Ïô”Yɺ0Sh´ŒÃ<—m”5ušÝ鬼¯Ü(fániayÀò¥ÂGqžU°^œ%gèÜ·sµÕp+o«æ.‹º|k=Åúh×]ó»þÜme÷©=ºõн5ð­H›16QüÛ|@OeO?å`å1Û‘¶5vïÚÛÕ¨¦©–¨BUõªö>½l{r(@S·Êé0ãh³¸6TÖÒhkÎ’Ì–nq{õ»CÀ>ô qá$¹õ¥*n;胒‚“apáÅ~ã'PepŠõœ™Ý!(+%ŒÆ]Mh«ÂBÅ2Úr„FQil†j¨„¡Tϑ˘ $;Øk-»µXÒ¥ËÌ5æ`“ ÊQ†kQfÇgˆÍ¶fgÌc¿óütš±À{º`ÀN þ[25ÖRÞOƒ jrÝYÃoÀz´ïÁ}Xþ&2wš.) ™&²ß^BÃUŸ•ÂýÈ„ÅfÀîø5ö–·lÃJønÂ5Ò5û—¸ ÜãñwÈ8¡u’æEk³“FtWàÄ»¿W“ ø¥rÖ†¤³@†`1ÎU<+œºB}€ÜUºøL"¬@\ð#\EÌ'ÌZu·vz[ÇÄW‰½L²ƒhÙh-Ë0H‰£~ cÈøqýˆ-±{<Çàø? @¬3•€pDIl;ßk€ ª„¢£Çöšá,TmÎÚçËa•ÌpeF¿P Ñb¨YvÄä:yK4†)óã“wDGƒÎ ÄáD¹| ̃±{Ý.xWûàIî͆3o?Í<·»zT™Æ˜ È®Œ%j d‹!e›0}†Û‰9%ïƒ=‰%#ɲ‰x⸑Ånh¥¦E$ËÌ8À$ræ *›ç´Š©hmÇ÷¿Ä% #W÷P¿õÂI–o&ïÿRÁÖô?¨à¶t[}ð'ÀaŸ—_â@5±¶%f¸Ï×hŠüLcùž'Ž4åÕ8\:çJT4½òµ3iAÅfZÍþÈ‹½¥jÅGJÔ’áØ¸ ­;*8QKp0­¸¯šôNVé¼c¹÷jï5s|ÇG†ŠÍ8Tñ®ûY^îY°ˆ’f¸Ó¢&¦#:»*Y5-`*Êäâ×d™Òì,>ÙÄ.›àݸ²r.ÍÐïÒ—ô{ú.ªªÓ?<©&ky/+=¦¸Fú7á9tÀn8÷ù±Ik$œ<YgÆ<³ E…ëph®ÎŽÕ² ‹• -²i*ù€îv4ÖS|Ÿé9M]‡ŠéÑÃWÌÃÑ ¾G€i^.Ý~"£-[¢ñ?vÒ´X*ºýSvQ'-"J„{þürv¼£8Md•ˬšâã챓2M®à¯‘ ¿eÚmE9Ü…Z§q8å›Òp,vvêâ" œó4E”–šòkºÊ‰&&Þ„½*°OÅ¥ YõUÜ~U.AµNl1…îõ<䓺4s~ÖÂ,8Á]z…(Ol’#Ó%BJ±úk¶ÒvÄë!f‡˜¤‹KH ÊÛ”ê\ Ķ/öØv0A]–`ŠßGcŽƒ÷Þhк»ä5 ñû ÉÀi!i«š°lÄå¦!oŸ°¿à˜÷)Ø ö§ñ­l´—ð³uºÄ¡UfÑÆlC „ûÑ PeÇ‹-W1BifCôŽàÄÕ¨Ò Ó´´>84Ò?ÚÃàœ77 ùОå_?Öô‡Œâúï8uå‹Ü¦Zõ!¿³!)ÀeCfž5,Mg][aÍèjó#Ê<ê°+EE³h…=”MËÙ¹þ áJ±€‡°¿™ôG7Ö0xÕàÁIœ/íˆwÉA…Ó½­7nÕŸ¹E«#*”0pÌŒ{ÛH£Â;¨’·Ü³5;‰Í/Ìl Ø‹Žhä4/È^r÷þþ¼Ä)¶ÜøªèñÊ),œðÞ!Ç~{žvˆxÓf ušÆ7Úü©Í³ â F-Z°¼‰8ÿ 9wvÚÚ?MžXzZàUø=Ë—¿ùm4;èJàË’[p×,$ORtÇwt€~4ÑÎÖL,(›-̬—~xÐcxÑ-£Ek3±Ð°UƧPG§P¥ïàxžVj–‰—ÅJé.=xÂ;´àlYQBЭ&I&Qâ!ËÓfÅVý,Ø °¶ÐÇ^`qf«MF˜1¡ìó ݘ±'âϪ´Ü]é £M·/ÐRÞ¶@ >’æÑ"Û¶Åf|H?>1ZÝ—ì!,V[ž5+Bô®tþtçØ”ØÝ‘»bRâ3C !1J5," HWmÕϦWùÁ* O:ÇâˆÖ·ÒÂwÅ}E^ú¾¸Wõ‚äel“þ´/‚”Ô´½tì½R¥å§¤},í®S߯(Y7—‰}L6å´:žRmމÕEÊÂØ)¸$CsèÏ>þàû7’JcÒ®H´×­„m‚†­4~KÅJü­].HØ \yE±qÓÖ<‹%SQƒÚgíÉHÿRÚÇ(} h HÚGA!ÅJBŒ^¯7d0vµ¬{]žXJ¯à4Ÿ±8š,¦ã~PÔθ¸ @ïùÖXNx@OŸ¦Ý`LKW?EK”K¢Äx…¶Ý h¢×´óHä}M¸´‘¶oÌ’æ¬cûœí3âé#ðw]au˜§‡'Ø7GíßëØü‚ü‚¼}ËNëŽÒé*¼¸èt¥sp-,Ùä¿ju´̆M'vqÒ˜íâðɽuØ?WO%OÞ¨¼…k›HqÎÛiÁççH goV7ý& švûŽ©û1Û1EW›ÄKfY‘4>Ûiæ£O|M38‘IIñ†$‰f»IO¬hB³DiæÚF³‹,.hµ30!Ê^»ÖÏy$BèRÉÙPÍ™B üC´>«ë=>¹wêVý>}DÔœ]éÁ¾›˜D;hÇŸVrÑ›Â0[ÑÛ †¨!.lóœQt®ÒÖ?üعd´C»´sú0èõuRRäæ<E”Vïi¸GØÔ¥Äy•h,éýÝ(„c"—Fal1¬ïë$ jŸÓu^ev´UâÃj!b´$®õ°ŠÄ‰‡c(¿´tøÐL]QÀ6ƒaKb¸>ÔÜV¢Øøy›pø¢Mme7ƒBRw’¡ˆO'³XÚúr·.5:ìó!5swV´tR%KIW”ŸÃ!z<‡2 1 ªÄ.TŠå¢;®¤u‹uÚæFl€­À Q‘‘FHµ/ˆ†0üC¡#Ó-ë©ßÕ£¸G r°•ÑÑõãìC3`Ÿ vQt´tÑŠBQêêÊÈŽŸ'~ýKSYÞüÉZv[Áºrgšæ¾ÇGÒï‡wÑþtC©F½œå§¿´àËþäáéå@zò—©ð-ªVÜ´N"¤l!…èVŽï™l$A=ð1<¶ãÿ"n£õÌÝñÛ I‘ñ–ysµ«èB èpF§t§BiEÜí5 j:·=‹$õîbCŸÆa8ìØ‹|õ(´W’…±6¹¦°ª òp‘™v‹ J’Rwù–‰ªnéQÕ&³ç¡“¼¥¿U¢7p &!¤D¼ˆ:'ÜLGª&¼┣„Áº +œƒ}–h¦RîrpãÙU7þFEá§)÷k¯Ö_¿QzŽ*«O4åk,Ê^ƒèr²åCL2´|þ9¹8IüYYëU7s4‘o$œ0à}Í-òêÔÙ+T˜I—gìóËy¦,£AŸ*숎‰-·¾2|QUn½Ôr™6)˜[MíÚ¤˜–‰ÑJd†E& ­ÃÛ9¬ømëÌÅ÷XœüíWÏÔÄÉv.Œ'£¢Æ&T+pLœÝazÈšJ|ûñíJŒ¨ :dsðÞâøÁ‹Ô{v<LjubeIx¥‡ÆS®x¦ÄsC†»–¼7Ë?Ó³ÎGîM;¸¦xSávŽ¢ ‰_°uq/×KsÐ'Ý?uû›EåÁÙª’ù0‚a$$kÒ¢ªé JOÎÍÚsbËÈ•ÚÜé¿\o ¬ŠÊT—ç•ìÊ7&%PÿÉisÂöïÏ)(ÈÆ¡Ê5àÄ]‰}ßw‹0&t¨2Ý€SÜÓ¾÷É¡ÕRóBÁ{wŒúçmxý©¯G° {*£Š¶TøÐÌ¡‡g£Ç7zŸ¼g(rø1ûQŽšTŠ#•K ãÈdtÆ*ì¢Àñ)]i¡e:<“¦ñkìoCç&ážÛñ¥Xik^ cù³ä=)çÞ0K× Œ†yQ¢#¯Z!þ¤¬õ9¸ÑÓÏwƒç!ÿêÚJS”oj;¦™qùQt>*;ÿ]Õ=’‹çpµþ¶à‘•’>Uƒ‹’n@×h:×Üü`5±+R´`(è0IèÚæ’â’ Ñ1‚fepኚ¡t¢ô›6†ÈæT­ÎÙ©>¹ü@üó­O·eë‹´{"˃ÀÓh§‹±D]cÃ^H }í”\ÛRrrF¦••±§´ôã5÷"%3>úò‹æ»m’æÛ7´a|N}Ã0I„‰.ÊPê3¤%Ñtpd ,ý+ìÜÝÖoÈ0Œ ·4“aâ7wXúEúø ÒéqåÙˆ=Ì8W²`IÕØñYâ :C¶C(è’w¦$¦èrÈdôW¡ÍÙ™Y×$ÙµE ›` ¸ÁVIAg—$Å&Æ'RéEæ‘–¢†å ¿'?ÝXLËâÀ–Áµ€öbó²s÷íÅ®d´ŠŸž IЋ×E‡RáÛvGÉeé]#ä@„Øv,Ð/1Ä’îõÖPr´¨Yj™džÏ( Êà³°W´Á¨ÌäûÆû®uí¿vüÕWÚIöxÃIb1põl¿íÂö¯fç·a°|v×ö¬þ¿xvewO^8R´mêp®”ÿá‚öÖM÷©h{!(¹ I²•Ùš‡¢¢ÙGG5á“•ƒar¿ùÁ§Ò…&¸vo:yî˜â]¶\~Âûó‰\úE˜¦@qšRîáZ‹ˆZÃâ2cG'¢Â /¢}£YvíÑ{Êióñ£¾(Içº#:6n*ì a”‚–¹ Ê¿¼ÚßÛ£•ãgDE,‡Î¾Ì¼£ø`Uáñ:ÿBÿ]ÂÑãM» ig©Ÿ>c겞5 ¡Ñ1Ô0…ÛGˆØ×°­AmßÇžurH'ì´j°ýDÑQÏV‡Áß‘Qeß”}z¾ànϸ@ÔÄb¢ë¤5Û÷—.8^}hušPW{•fƒ{Ήkü<Õ[|¶è7ê£ ¡†D}|ÄQàD¤R³vBÐoÕZp"ŒvnÊ¡UjsFîA¨àjË=>nºG` Ç¨§K±;Nüâ¯O¥n·{ú¯Î£ `’÷hñéðþKV ë-‚š"+2ЋtùOÚðÿt(¤±F©K€OÝž£“ܶ…5óSîÉÃ%±IéÂ/3õ•yý‡7±{ß_ÑFŠÝ+û7X±P÷oiÁë:x¡{MŒÉ.‘þKÕõ‹€ºqbI†þ/,ÙðeO«W‹ƒ2 f‡–†§M+Ðq£¤èÞ>t'¿R^&t‹Ê]3pݾÌl…Ù e]+‹%AÖËS’SR’ÉéiY·­­æq> stream xœµzxçÒîʲµK aÈŠ¡÷’Ð „ ¦™^\0÷Þ‹\dÉIî½Ê– ²± ½÷æPBJ0˜@J ùÖ|¾ùï·²!ä„“sî¹÷>âáy,­v¿ygæwf$ ÌÍ(@`¹lù*/Ï ãǬrv pwðåßíï„u¯­1ÐU]Íkú µD/{¡{|Ù“2Ì;­ðÛeëáìâ@QÔ&Ïõó¼6Ì÷Þ¸Àçß…~‹ü, ü4Èai°ã²§å¡Û?s¶Ý±ÂeåÎU»V»®q³s_ë±nò”^S§ œ>ã£6kxÏŽlkÙ4ªÿè¶Œ‘Œg?~ÂÄI:÷c)jeKÍ S+¨¨!ÔJêcj(µŠF­¦†Sk¨”õ!µ–I­£FQë©yÔhj5ŸCm¤Pc©MÔ'Ô8j!5žZDM S©%Ô$êSj2µ”šB-£¦RË©iÔgÔtJBõ¡‚(+JJ™QÖT_ªÕŸºCÑK1Ô.ªÕ™êB= .Q3©®”Õò¤fSÝ)/ªÕ“²¡zQ–”˜ê-P T‚΂.Ôf.eN…P¯Õf3Í „C„yæÃÌ£Í_Z8XÜ}*ºH‡0ݧN‚NÛ;íï<²sQ—]¾ëšÔm]·ÝmºÝczë=Gõ<Økz¯’^ÈÒÁòŽørïdIOɵ>cú<±Zau^ê*m±`ÒצŸ°ß¦þÃû—~0þƒÌn²›Y$/ƒü>pÉÀÔAâA>ƒ>¼qð¯CŽi:nè…a¢aÃö»:¬e¸ÅðyÃa„ÅÛç?Ü4’yaTÜh{TÕ½5Œhƒ‘Û$huèc ¡m!"E^…Ý[-¤ñY )a*E|vjûQ²Þ)ÜN͸ӿè­²0Ò| ¥:MºF+;ˆ¬,ˆNà1¥VJkÕàͺÓ5ºë°Ü¥Ip€™£ÛÝÿÇl”Ž#ga”ë-‘Ù5ä|ÍJ\ÁUö1ÒëÀÔ»´š†‡`t¯‰Ès-\ ó`³½×ræWZ| ”[¸Ó×Sã6Êp½U‹ÉS…™óZ,‡2´ŒWüãÆéË—2ìV±8â«,L· Œ‚’ÖUÂV×>Æ`òÈÀ¤@#vA_HÑh‹¾rOe‹ÆÚHc¡Ê 6“ÎÚ®WëÀ¢âäX„gI±Ù%èâS!Ñ2õyû4Œ‘Þ©š΀ûè¤îô)(ˆ+ðB˰QŠ§ãøˆ -Ã€Ü uµp jTä [4¡eiºÄ” 4í¢‰8V«Ô)Ae Q¡ö<ÖÕº›<‚´3v4Ô¤GuFK$kFgŸÎ{a%>Ð*CK%ð팯°0óiÁµËð%óí¸{¸Ûfæ^"º¥•»ÈÚJh—ùlÖÏë/û#ëG-?ÈpOt_²tã4,dñP¤UiS±¨§H|ëiõÔµ²Ü,Y°nÆ÷mNH©’¡R´‚›?o»XÖSÉ Üx½ ¼ínrnÈU‚z…»á^#±÷Â’ŒBP·ŸŸ!1;=U.`°-`ë6Ï `ÛŠ¼úî‡ Pup²dÙÁCEõ°ö”Ú—ÚÃJpfÞ: Ý(l l 1Òî NjoÀ4˜nÈ ’+"• ž‹ðt8.´d]dH<ÀiâŒííÎȧ¯Bª<×íÀ?Jñº7Pˆjt7Èãëàñcô§g«ÒëdÈŽFvèóÚ ç+Áš ~c:`lcœ~Éyï¶ŽA’tH‰”ƒ"ZÍÆâÁf`0Ÿáõ{Ð1t­Ûs ZÆãa…2m¨²É]‘ EÓy"W*!*–Ý`³£fýÑQ`mñ< Ûc'4O@Ÿ¡iÏ 1²öÁkh´ž³6F,_]C¹ÍVâž\>r— ñÈçØ|–ö€ ¶‰?ÅCø¤¸‘¢Ø&kÛù6ÜÍuÈ⤘I§ÑIav_ƒºüã’Ȧ÷ÁÝ>™fãä\ØàÍF äG‹{«8Rq¬ßÍ “°§þìá~'p!wJ|E±X</'™=]ÄI¹×)äë)Ö¹ bÛÖˆä8À JA»¿AÓÉ'ˆÚ¬ÛpœÔkšE,ç "·ÆßQ^fy"_[ס Z…û¡ xÎûCØL„f"@+dÃûÛºl ò^µr0ÃÚC•ÛK›¢ù…è"\ 8¶`ߊ´)0‹Ï¡çß :Ò ØÓŒr¯ ¹¼VÒw&€vYîxécâfÐHÜ÷z: 1×öUèexÑ;àZ¸£»p ñ ð‹ŒpóÞ Ì¼ÏZº\oþònãäµ’€â:’S"Bc lM.–1‘ °h;ÿŸ¢·ø|I(oöUÓ«‡VâÅõ’TºWØÏsYlÁ"3žMeïcS‘®A=¡¨@Ú&!£F†ÆÒâÏ[¾NÑ‚Z˪ÔAQàÃx…ëó ™•,1Tsž7ô$ÜÔ¿Å©åN‹¯ 6X‰k¹ß¸MÓaþõ°"±FW}êú5À÷¦4t¥Å«FCVµ ©Ò?¥¿bZ´ë(v J‰?l‡¢«Ãê\Ì· Ô>”\¯-àXVFއý[‰§£6Ô['¢"Y•2:F©r.w„pâšî΋WïÌõ* Uú”+¾ˆ`Ä7õÊ{aóû®ßé4kšË™Á¬*K L$ąȰ”…¸Œ$¦ €ÕjA›_°ß်ˆä}ðó/H\{"¤‚"ŒÜP¯Lm¶ú¡x…¸;):SÁ…Jú‘N¾C¶”ÆæXãõ)ÞXm"˜ Uçû~^Èþ ¿¸UÚABø3<OÄØMƓЪ›wKÏí‘eÔ;e“©924®KLºB|(ˆûŽ’ÐÇA(Öˆ–Yþãñ`_âÁ×èê)9㻆¶ñpÞ±¾Ïc‘ 6âÁ|¥ì+RÏðð¡’  ÅƸB„{<‰ª¹Q~ã2Û./.Ñžöà?Nì´ïcô£góQÅ•Ð5ÚŒ[l‰Q´SeCJ§3Ì…:ƽ„6E ŽÄÇQäß_ó-ˆªu_’B¹¾‚jGÏ@9è8Îyÿ5í$+סhŸÑ½ñ­ùÔ¤E>‰M9"CˆïÃÃÿH“…ôäM‹æMS:Ί»¢´¸¡ýÓÛ š(Ã#éY0>½¿üb;&¨îêÿ†âú·ÑÃ>Fz¦ªÃz]ƶ”·l&±k;Ì4YVJßÑuX¦’Ïd}øSß!g®ƒ;§&$–È3 ¸!—Ä !ãŸà©ö‡É|i¬UgøC0Ä$(•ò¡8UŠÍQ¥" ¬Kë ŸG,Pyƒ“ÆCKÉ%HTd¹£!I“#´ñY@®LKLGVè¶4­8o_“†¤à;*@ÈÜ™è¹@£e2_ŠÌ&IJs6Ug,Q9À$p&¡[C?ƒÈ²¶Íô¸ «×²âA X.gñã™»Kk¼ ½dâ»"¶ÉÄ`sö嗛׿Ê`5©¤€ïa¸tC6\bÛk/1T`Ì1 ò[m„­«M¦S`,ojZž €„øÈñ8M:U*3Õ¼ («ƒBbé`•x¶Z ¹ é‘IŠ ”à)8^:Æg’'&¾¹– 2–°:}2U™nÈÿ&MŠÐÅòˆh““²F5Ò_pm¢œË: t’Q Ì‘3Û'ÊvÐëUŸ¨–yÌÝå»¶1bùGO}/5¬?TÀŠç9%–9êWt!ûþø˜D¬=×ÖŽÕGO56£ÉBa§óï„_«? k;LôØÃÐ)ZŒlRSOû†×»>*7ð&:mì"QH$o²?Ä@XttlnÂÇ¥èÆÿe*ΧƒÌÐ\”“ QÖÛ‰Zàîõ…Ûƒ?¬©`‚Ñ2“ÓX‰U\9²x…„hý+p_d#ݽwï‘’RcMCÎ!^uû$x¨}ÀÖj#5äØâE ©‘a}ÉÁ#ãËgIgýà ÃdkÈÉI+Ô0â,âiJ›5Þ|X\úís,‘n¶…„Í«6­\‘äN¥Z£¦~TIÉóçèâ²rú‚¾¢êÂ_—¦Ê³ÂHÔÅÄ„{«±ŠÔLJWuêÝ ÖoXåB#:§G;Iù]ÒŒ´D»êÐn>Ç¢Yö›CÂXtn—n&ji{b k.æø7nø¬ßh4v$Øzn twvµF¼c+¸”øÕ¹¦ƒ|9ÒPšŒÜºÓ§RKàÔø”8—:êV#QÐÊ  nbGIF5$¯pwLÂC>4‚¨ô$üDâñí¢i7½²d«Œ"ñ•Ëxpì·fuxX|óŸUX¾¨CN9èóÛf´,¸OÚ‘¿ò‘QJÚºhuB|Ô0¬–b!Ò+ÓIæ•ÖBÁ?ñÑabPöN4²M õ]°ÆkáR°ߊ'ÝWp¾11U¹Lip®P@¤ÇÖF—£—Μ)aÑnNé¥cš\^² Žøð…¬êq­Iâ­{,ä&¡.’ôhPNT$°žc?ÚÌÚIûÐ4í^㉴Kj—j™£JᑌO~PyiaÞî«sêfã^ã0…{âÞÏGØí[‰º¦óI•f|“TÊQN9ŠþFøZøžº†g‰|Ôq!Ø«í¼{pgbô*b‰5žõV ©hoØ<„—]t¨¯×‡À¡2W£¡‘â™%E&‘øµÎ]jbR·v“jÚnˆÞ$Z­îª©…ùjùÊÀ[®7é˸NBn(²%žŽÁ·a†è˜Î"d亦e˜H/+BX|“Hõ)Dª'ÿRP‹ÌˆB‰pe[·9$@¼uD qjýQ)OÑ)Õ|±$Ð4Y‰¹’7µ’û-Î}' ±;íYc_jÇ?zЇX‚ÅÏF Ñå{* ²%$©ÄB Aʈë6yl °ïG‚»Ôo¯Oƒê 4@­ö|Å"ãÞª“P áÆ­¡äT!ï´†ý˹åDR´×ŸN*܉çï—°Ù[Ö6‡Æ¯¸Ü˜Lµ&˜à=Û½B”…êu±J£†`¦­à_àžG'ÅkÔ‰ ntÛSiZ”FL6¤ȸ#tzɾ 0"4ÏÔÇ4uDX¬6>&A›Àî2¢a8íö¯õ8 MPàJ‘^EÏíž’¼cÆ !ÿ÷ýu$éº@ÂÙd-ÁÑ¢dôá}Ã`^¦ã~ÛeíüPÚ:ÝÀËÄm/…­Îè±ÙãQ¤_ü/ÂcðdìHÔÝX<-DŸ¢QhÚÊÉ–à|üÁ´q£pßïP6ÊDî6‹/Àiüñ'tL_Ðäû©z2ozü­µ¶öÔî¨ZûÉÔµYLÏt¿ƒoýMGðq'ÄÐß>¼_—q9l”2$|ÿÜ ²ŠœÂömÿ³·]2ZV¿„‡º—hõK+ño­æœBòlÄwø¿úk‹÷/ H šE£®ˆúæ…lHŸÍ@2s+vÅ,*nïZDh ÜÈO'°c1Zuö@qn1‚â¨bK4é+r³¯¬Ä´œ áFHò¢*·mS8:°b,¯rpÐô»páìmzgC ,2<Äv‚{–³1È6ÔÍœ˜ùÏ× î¨ó?ŽÝ®Ž8¶¾œ][¾>#¤fq·Ä@#T}UœWXçÕ *æÉµk·jÃj}‹e5{j’ò o[ÉR@§–+ãåÅ„fE妤³x¦$à­v ÷ò÷rf2¼(.ÓTædâËòÌÔâòú~ßÂp2kë"±[°áÃa 8¸·v¿Ž='zˆÌaJGœàµ/¯êôõ\…Áòô Òä¢ý/ÂôVb¹¼Õ-Z’òul´šUØ9xØÃfðÝãw™7Q¨ó‰¨7Õ÷/µ"mçÆêä´ 6gtö¸'Ä”Ùò_ õ1Ù@ô‹fEágœv;º˜õîöŽÞYÁš™]!6¿ (”AYhÀ7Y±õõŸ‚Sexn’ì vSëcæTUÕÔ;¬Ì½ Zw0Ì9~óoFƒÓ`›m˜ £F?‹ÞÌAÚ‹iÞ¿þ«Ñàÿ˜=èÏ«\#:¡GÇÛH´´z'I†ŒH9ÄÄôì ñ…{,âIä]iÈåUk ž–ܾ·™Ÿ°è>ÎâÏ߉i±çûNo¢:Ñt.Q„Õ»öº€;,†OÁ©Á™si8¥ØÝïvÞ½rà&Iú}„G°¤zfŠ 2õºtmó™+ñPŸ@r¾=±Ý‘à•åƒß>"ül@@À[¢Lª“qBZ|à1º’¦ ü¬k¿™®ªö¨­ÅÒ5ÜÏ’2ÿR]A^¾ÞÅ>»÷–Øvßžõ#šc¼`D• N_þü2ZvYÈ)Ñgx±äÞ´BÜÛ(]ž³ý$鲯Ÿ¼p}¬ÇÓ·&³(2:Úl´ÅԨƩÕQqìÎUŽ  A §M8ýļÛÞ² 屨ë¡eq»ãÊwù¤»‚+³`Ãüižs’ެeWžT]VרÓcAõ¦ÛÞlê¶S4ÚŒ@—Xu¸ë²K ©eî>Cf²vÂ#2%÷;ÎÏŒÓãc¿-!Ðüˆvlpræ!¹•ƇÍzkÌ”¥ñþåÃæ$fCSRèåä³î´×™¯.^þž÷ndþ>ˆH¿Bðÿ,­5 j (µ¥„­6ÜzI0?ÿ@¢`Ó\,MÉ©B£ J!=¡H rðgH¤ì‚ˆA¬“»¨A÷ $¯—Ð@âĉÙ{xUAœŸ˜¡-#‰|=Ç5Oy+›y>÷á³æUÓWMuĺf.•8~€ó ,F‹¤jm|2Q‰7Χ§^:Ö¨-âå³§*¼ˆê_®àås:]‘ETÿ@Ü]ÊùÓâê÷ç•@‡ÌÞæÕKúò©[WCˆup¨2˜5Iâ ¨PWIÜ`ä.µOf´¼4¾-ÚU¸ËÛ¢_ÐxÐÈGoÆ hËõú7G7D &wEô£'H”Çê ! êt“®‚¦Z-éh€x>XjKû´ïw~ö^Û„¦U:°u*é²[7 [=ßN }‹xY{\]äC´\¬J‘ ÀKÛ¥x5§Ud›úìŠ3`0 ¡ò1ù^×:£ð¶×Ò”à$Uä6))ùq¤ÙµeWù>[hc÷O‹i=ù·êñ­MÆÖwö$ßü‡{’#ï'Ãÿ0Í…ç)u ÷Ìèk¬1Zæ¿ö³¯­0!å‘à®öâ[búçêBW…*– 5²ÍQŠ's‘êÄ„dÒ§ï> ¥&¤ñHuç/O?Eé¢ÿDŠem6x 'Wëˆ Ó½÷â_Ab|æ´¹­Uª‹ÑEgA6hS³Ð .IŠ>jKnÓºý]F<­æîçŸÙ—^GzNEؾ¯‘  7ø=Æ ‰q8·‰.„ä°?KÃçÛvY¸£‚ɼ8±aùôl™úIZ¬Ä½{rvh‹u™ñS›ìÃvº°h-fŠ…Uq•ýPëßg%«’âdâN¶‹WÅl ZLê¯å[R6Åê”üðR¼wD4ĆÉð:b³S´ºäD6#·öä7p [RCrwh·-ºlýü¶ïðÙBâdÕ‰ÐsŒxî\µN§ÎèW•g() 5¸FìŒÛ"I§\‰ÌóËOHÌvçܹ¯h™ÍÕ ‘#÷PrÞï€ýÎoŸ<ïšÂìôdBðZ­†´J·¸ùË–Ë¢¢ˆTW1qIʤŒæ¯Qg­íóß|Í„$7¨¸ùûzƒeã#dóÈë‘•¸Û‚ìI'=ñ',\´cý¦ ¶„&u´gͱ’FÅ.=î[ÝKÂõ¹»ÓêÎo;<÷ÆýHûრ³à‰L| üIeHw½ 6„ºxØn!”¿ <Î+rBÁ]ÒZß®|ñ(÷ ,7²ù;`=läç;$ÖÞª$±²€ô”!­R VŠpwHÈR0¾"WìHÈ]—›v)+3%ù6d‘ä$ÂæxâÜÏË`¨u4l=x¤³Çh8¥;•z2±8ûáþ‹¨Z%Mã‡QELeÄ×´Ž‘Tyçûøx‡¸²um›4ášØL°N]’&©Ãã%~%žž~~žž%~%%ípµö0Eª£BÔL ÔÈ87…¥/­ÿ¢öÈqhbO<3~øG6cC´[7³Qµ¾†Ð•žSVÃfà/‹E?6ÿÆ.àÞªí›lwâžw¥[v+÷@sáJã›—×Íg‹Ú$›¹ëfL™±ùlåå‡XÔcVyð!øÌÚtŽšÇ÷‹/à1š`ØË;¯èêIœ÷â9Ô= ÒcúêÄ5C¶Ú³Ž[ý`.ƒ{}÷!2¿ÐÐx¶˜u£qäà-+Cí´{¼Ùý©yF¿œ€0˜í‹O:>@"Æû#7ٸǒé»F’.ÀJ[ÀýRH-…#pÕ–Ý›UMÊhÕ®¼­Œ˜¡2Ý—méû_äõJðð•­áºÿG|Ûü¯Øš¾ˆç"»¿ÿ²ŽèôŠ„/íÞÄz’NlŠ&C›šBJí¬¥6q±DùwþY§"Á–åÍÚ§ß<…f+ñÿkUñh¼KJ‹½ÝC||‹üËŒù†b-ìó—÷:ºO#j4Þ0èQ®Þ²±yï¥$ïtÉ`%~~¢ÕÍ4ë©’ôöiÚAC°ot|œZ%[3rë"ûµ‘9¤:° Ñ'Ï_ýšÄÝÁ°æËmÖ tHž_=‘?rëo°³ž|oÙóçöUÕ²×lÏ…†¯áÒíC’Sª™K]·‚¬;æ¶÷à‰ú«ïÔ5U·h˜63´B"¾/‡%Möóñ¾«: Fæ~}eõylI[¦déªåq^ÀL÷zò›=5'Ëô›s<ö-/ðªYW»ƒi7Y×£±õ‚Ó­cøÎú…¤0"ضŸDÁT92îQNÊðZsòY8Ûöƒ(¼ý³l÷“(›ÿ¬=0¸É|`ð<ùß“$ϵì+d$ø¢m×p«%¥¡e.AÑ «NHPó7HÈN¬LùâÒEY&O:&%>1^>}îl[²u_u~Y)϶ÿÍ×Ú—@8$ðuxàùY!ºã$D2jCóp/dé†VhÞ^4õ@½²:î£Ô)¢',Ââìzl……D“ÌÊÀÝNa‹ó¸ÇÃOÓINÔ¥ÈþtwFn߈t¸-GÝÖ [ÔcÊ•h`J¥B !²g#ÎàI€I¥Ÿ³ƒ´É=±ed;`ŠDerú£«H|Ž=†Ì2‘îó쌞róƒW8 !·[. ejh*Ø$E²¦‚´ÄÈ´Î’ç„Å%@°é£fä Ù9‘é‘aò¨H6ÏÆ=Ed$€¬Ãäá‘òÄØ¼X¸Ë–Ç(ã ÊÀ«ŠE~dz-³¢³r32³Øp4õ¤Ò©RÁ:7#'Kö—Å¢äåœ3Il/"çÏýó~©nî¿Z0u¦ø Sõ7+&±…áÚþÔ~gGÁ“Må­Dr¦ù¦MEà‰ÿ׫ ê]Åܹÿ¼¬ˆ“ÿÓ¶BÜ…È þSn2‘±®þõèzê\/D©X'©ùzôÓzüÁïát{~/DMõ¨)HÀYÔó®kÏp\‰ªDÙPÁä¯*\EG¼ÉjDþE@pa!d³¨ UÒYþöWKHÜRïÕÑÐ& Å)Ó´½£ÒØ2&LÍ'œu‚:"øÙ'²‰Ûž?¬¿¸»&Ú¿uLPxAãZYP\œ»ûÜšF›±¸Ëz,`±èÏc7¡ ÿâ·ÐDú`J¤£ ÿ©Oy§. ÐÂÛ4’Ë~ NoØ'';9=ƒÕÎôúlÛf…B­¥‰r2ïÜA4û®YJÂò¼Y.Ĩ§ïõ;í¢P‚Z£ÔZ»e;’n•„«ËþÝq]þô™…+7W‚]y0z>ùúà—¬x{”AyLŒ2,| $5> stream xœ=”{TgÆ'BfFE„ 1‚2ÁൺֶàqWê ¯ÛxA±j)7¹%Ê‚IÞ rE$JL ƒEÔzÙZ•U{\×c«]ëRÝmûŽûyŽ;pNw¾ÿæ÷y¿ßó<ŸŒrFÉd²ÑŸ®‹Š ž´$þËèÁ_>ýööÛUrps7׳ãY_Rž÷G÷yPƒŸÇâýIÉQ;wÍû`þ‚…³ƒçÌ¥¨‰T$µžÚ@-¡–RË(%5†RQc)Ê“RPåEyJR”+•LÝ“ie׆E»íò‰‹Å5ȵW>OÞNûÐ;é§ ài÷÷.»(Ð_·¥ÉÞÞ#LcHé[yö‰,8Þñp(/_GÌï^Õ§òB€MÕÐ8Üâ„ËpÖà-00*ÕEp”ëékÄ_>CC;,/¡ÚàGh5°ä!æ+‰–F[äîïeß× êýKÐô*Þ è~ÝU\ ¸JtU^Üм)l×–ˆdå ×O>Ì“k˜ëVˆV“ëË5 *,¸ vIx.eîG÷× =·Ó–ÖÜl«oã¥ñWª)½-Æ.޳)w1뮊ӊsÑO i­{OF7Ç”|\ù¹õOå °×_@í}GÜúbÞœn.¨¶ŠÔ˜Z(Õ2‚6šO¬Ü[² ØX2ˆjW]BÝuÛ^‡þa†]?Ö°¡³ eBbG_PUÀ&>YMdŒrZ áH=ÏNÔtÅô@x·àL@µ´dÏ(}¾02Mñ+ÒG*n@T ‡ò¢f3“¿n6ðØ,9Cü1RØþh`÷H\“&Ú»:ûúywñ²Þ+àêSdW4ápŒFZÅiÄ Ê†LÈäW™¡XŒaž-»E¦®#î‡ænoÕ6µØê¿:¥­1ò'Klæ `ï·F…¨÷1Ë Äš d ËeOGÝw„ö¯Žñ\è—°õ7¾›®«€F5ÙŠŒ’;=}VæþÍ»ZÏ!…sª.X$þÃ2¤ôvÑËŽký¥½Ð½T\‚8€IJôú™LY²%.-‰Ç.†„ýßàwS][s´º–ånå>¿áÙ8œúësT«‰×ÐÀúÄè¸[³c ¢/åa±ˆijínîÝŒ Äú~¼„Uݦp  gz£§Š{!îÇáʪ ÈÑ™Œ™|bÄgÚÍÀ5`@×eÀ1¨l­1*ÕÜzÝAcj®Ïïtž¶d-ÏÕ“ðÅ„!,ñþyÎÄù§µªÝÅ{RŒe‚¸%M†OvRwP6 L2MÆâøT“)=‹'ÿ~÷G¹Û‰Œ¸j‡å§¡fü0ÔŒ=¸]I€FÀri^vÇ78'ÛŸ£‡-Mч>Ñèó 'ª¸n± ·*‘ùè ŒÛhˆÑð8–9YPn<#ÝÞÿ(?n5–gLp([½.e£~„ÀÆÚÄÒ\‹Él6²ªI'£ƒÌc•…E‡­¼³ëRY;°Ï`î¢%@Ü’"Šû¢ÔÜ{asc»ÏÅG’Ò7定ÿý|É»y¿J  gOGçi–û/ÒOn /}™ôW2Œ ú4xMwz£­íØ…ž¨êô"¾¹ÑQnöiWxèòÝáaˤ'‰DefÒ¼u —/.¦‡Ì²aPˆ§9éx„ê ToG_@_LJJέPBoÜS2¥å»úþ>xÊ> ¹. Žüxå¢- ŽÎã¶³W6”2ó­'Ïnöï–•_dšˆj’^½Óh4˜rLÆгœG¶® Žòœƒ:G£ ¦nÖÀ”I‰›ŠN}¦>]zü8´³Ü%ª3¦e{ÔÞ„ÍÁ«QÉs~†÷¿þIíž].®)Åmõeå´0é‘ü×õñnÃO[,fsa‘Ùj=sÍÍ¢þQýÃendstream endobj 442 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 8057 >> stream xœÍzy|SåÖî.¡a30Ð î-3(‚2ŠÊPF¡Ì¥€¥è<¦mš©™³2'Mç!›Î´´´P±Ìˆ¢âêQáè9ç=žwçìÞã÷¦-‚~z~÷ÞßïÂBvò¾k=ëyžµV¼ˆ¡C//¯±¯oÙ÷‚ùS‚c¢B=/NŽdÿ»³½aF mž<7uª‹|Æ\x‚ðüñ]·:~MÂÚDߤuÉëS6¤nLÛ$ÞœòzFè–̰­‡ü·Elܵóð®èÝ1{b_\¼dé²å³fÏé›ï¹ç¼°pÑS1•ð#¦ÛˆéÄvb±ƒ˜Iì$f»ˆÙÄnb±‡x–ð'æ{‰ÕÄ<"€XCÌ'ök‰çˆý„/ñ<±ŽX@¬'^ 6 ‰Ä"bñ"±™x‰xXLl!–[ 1‘ð!øÄ$â)‚$†#ˆ»D,ñb4OŒ!ž ÆãˆñÄ“^#ˆu8ÄP¢Òë ¯‡ø¹ÅÉÊzÚ»Š;‡‹†%“+ÈcÃ+Gìqu云½£Ì˜9š?ú1acþüDÑÿûḼñ»ž|âIñ“wx ã'ÔMŒö™ÎÅ/š7ÉýÔÙÉEO¯{ú$µ…^ÿÌðg §¬›r{jØÔš©÷§­™V<](ë`—{ ’%AR ¤KrÁØÒf„Vª š5@Zr¡˜f×"=ÄE[ÑGÞø| —R'3ßéÅŒ?[|Ã|Цñrä ƒ6KMÉæl2MW_™Se« KO·£¡ÐK~²Ë¹oÙ~¿t1¥8U HƦ‡Š·â3ËrÀœ§×;ÍTñ’. « N*Ô¤«…ôkìi­R§ _jË*Í-²–X©6ô¢Ùi)3;ùy'A_T›_qìÖû@vÓ¶dGŠBiq”&Òȃ5Çï5¢9f üÔžÀ^u¢#./÷¤/8îe(žŸnèZcG£«ßû > on»ÌzQìe®PŠÃaƒW5dj@«ÑìS}mò(¥|=޼ç?íPH£O¹h*††}OÇ Ïy‹_™Ár)Ö‡{íÍVh>Á½“³>†ÞξÇ{vÅ4vÅ>Á£ÕbÌÑ[è¨Ñ½Æ½gy)‘ý£×“C‹†Ü@¹78Œ¹xÚvýEö –ÇNegN¿´åSôâáoEùáAPêôh¿¸]{÷îºÙS…8õgè– ÇëŽy¢æà6ü¹C.‰T—{¾Ë =û9Ç}Ò½’§7é-`"A—#H³©×W]ß^|6„fSY »ôÓ…ü‘:|¿K¥T€\CïeW²c7/rÉ¢³hêÅJôÂGh}í믻>ò‡æ¹/&ª¢AC{ê0ê‹LÔÀµØ=.4o5~os+:Âû‡ß ¿}AQq”¤707é1¡¡"žf¹}ò¹&LÇÏÆ U˜UÖj ÷º5ø ÷\ˆö‚%Çb­2ÒÍh¦5³2äN‡‰f£94;†ÝÀ“$ùîr»ì®Í¨7lt7Únk¼xûMàËÙœÀŽŒÛLv«Áåö˜Ùð)Ç]Èlâ¡iËÿÆò(öÊãÂä<mG;QJ¥—¶ò`[ë·xÖ¾kƒW9ý8 Šé±7Yõ8ßr?¾ÈN¤G3Ac‡ˆkÈrìb×ð\Ñj0ë-zšéÀWÈàÛå4"2^HIj›öÉrØìJW^èêi”ëŠãs„9qZ«$1Ъû¹ë¼ë3Zâòºè~•ã^ƒ€ç€³SJ6µ¥"7±‹ð¡F?rïë¨Æûsî5«0A¡Ë’ÇÑ •k$9`q Å&úM”0xµ\ ¨Å ISRékÓS—¹œ{él ýCc¹ˆ¨Œ]› k’iJ— RâS¾ÞTl Ê‘¯±J iÀï‹àfÊ Cl…Ò^gÈÕY4;©¯á—yc’¹¥ ×[ þˆâ}ô#>¾¤W•‹ÈIC_Þ.À`žs‡Ãˆ˜1¼S›‡×E¤ )éé°’ÃÿCv«³ÖÚ ÔT 7C¼Ï€o†(EJ5Ñ "ÅöôªbWþ—é{=îv¡.O˜qÜþL"ï‘+îŒ+:ÀØvÔmttkŽiÏÅ…“ BZÆ] ¶<Lô%döþ”{Åž•©âk:õ`\q}—˜)OvLz3˜ùž,‹uš •±V˜„)b%÷2Ê}áÜ8cÖ%kÒ5)´Nèý018¢y_`Þ{ë#ôܵ òç΢qoq˜§Ñ <ø|eqˆ=Þaƒ²¢ìÚGÕ-²0­–'€Œ”Z2+Šªr;ºBŽld‡‡Ìõ动FIuÊŽÉ`7°bzêvóI!uÒ 8 %â¼´”øÌÀ­½ï g[Ñè.üÝï|ÌHäbf Ò£åñljsvL”¢© 4)ƒ@ê€ÚÆÍƒ"]ž®LcÓÔªñ© µÒØø °]’C@Î[vñ{+Тçßñ⤠aþ¿#á—¾Ÿ‚¦~ýnWK-mOvF8À ‹Ñqíô±”r:Ìs`Æ1|½_–ù.ä/À$wžƒ˜A]–€.CNeì}m PYh…Bk ýêñ¾Ë-r æ|·Í6åƒ'²,Ó,K’¥a5cy/æf>(ˆ¸kØ6Z-? !ôÔÿ:9(­žå¢ 5zàèâ¸}±gQ€`;Øì6S…žbZmõ6Û%à—١ء0(…h Œ…cJñ/™t+«õf«¹ç‘ò÷=÷KÆ0om7º Ú5X­ØÔ<8›ãùôÛ¨ÒUs7²¥ÿé9˜ú¸ˆôó Îr˜ÞqÖéR•”hgúëQ@&Buþ@œo¢vƒׇ‘ïbqr-µš=¦Êm¶˜Ÿ{ÈÀìΆ _V^£meæ|(!{»‚ž‹dg+¸Ão¢l®ê?õéph“e ¢0:Ñ7qø“/öÆ9ÝXWWAïîP–@ ”U¸Š[sÏЕÌ@ è×[Ì6úª„—+Á°:¬‰i±Õ[ì×q€sú•S¬:‚Œ!@büôóHc-°×7ÍNîk—Ζo~Z6dH­Z«‡GÚévèдá@y´ëÖ`”\È?‹†ÿ‘ÃȘQ¼&‰+.%)%ElUXTE¢1»´ø¬‰¶[ÚÓÐ[ÿyõMÊ\h)xÌÄ,øÁrÁå¸sèå.ô¿«¨ÑŒ3ÕyåÏŒÈåuÿ;Ž{ˆ{Ï®4ÊGh Š „Fnoèt.·pýhžjÎòT³ZÄ’}á>é¯íðÝ!Y)o7è ¸ìÈVgce• /M³ ^Y&ôòý¯o}å¤Ñp&ÆZcµ~Ãsï‡ä%>È òÎÞ½€Öü‘ãÞò—‡Ðè©™!©þÑ!o l?j×W8:é£èe‹3§ ³ƒ5qŠŒšlº"^—†kO³t/¼—w¦ê=×'”µÄü¸á `'C"$@”-ª*¹>þ˜¦ê¡)¯îdAx[Â98GÛëÞ©»v=§ÉG 韱ëpþ{ _C•ðG´"J¥£Ò;¢ £î@š;ËN´ÑŽ}-iM?‡*»>'Þ²ü×ÜÙYé :…V‰Ì!>DôEw+Ç€ ÙT„^b•¸Ø‰è¯>èu4¿¼äÚ[W-|›>GE¤UmV¤%i …Š„CƨÞÚuf:_—«ÂDž‘™%³g»|n£›ÿïÇb«7ÓMh:¢q×ÀÖ[²@‹Å?úNì)4O-51B U‡{·Z¬É˜;=ì~Í£…¢kN¯ÓwPvY³!TQ /„)HÈ=Uáè°5ÒèéüSÕovß•P( •Á!äâäöܸ]‡÷¥Ë¨ÔóûlI@ÎÚÍNLéGè Ítõg§ŽàR®-I M–ì˧S7¥­ð¾’!3¿Îf¯„²*Í"NJJ;v4¥ëxCk]Uºã„´ ÈïN¢I¥?‘ ?ê…†½…°õ?8hýE¥EGQ7PÃÛŠ‹T#Óé4Ôl¹D'ÕA:_šùÇ ™F#jv­ÓÈBàÉÑõh8z7Aù¤Ãe·:íMµˆK[+ÀPPZÛÖÚØ ä£fþÇ!ÉK ‡9ÇqE:¶•‰N“® ¢±$»Àc,qå“™v{“%çcàç ¦Ô4ðæÈ`cèã`¢ßN¾Æub;i)zEûàœ~i$Ø`'zÍ¡q9 XM&Žÿ–Y¤áý™¡ôÃ/5£[ê· øÿ§bÑåªÈË£±ËV r¿¨Õ zƒUO»Ì¹ÕPH– Ôx³$L¹Ó¿=êÍï¿úî/•™D­· ô¦Áw9Lä÷<³Ü!Wët29µjþBu&»“Žõž®þ{ÕqºùJOÓ1Ì­Ç´!JÂØ:„åÕÎÖA-›4´³Ïmü=ùé_ zæMŸ¾ÿÕ»ŸùáM?v’F ]Æ+ùˆIw¡ù–9½’î ‹XËöºÇó:BÊCæ$±¢T;Ä{£'ØŒ”ú"wußpÉYˆ2/ûG€ ÒÒ‚:s~”’ÎŒaR’ 2°#­åûvÞlŪÂzÂ-Ê$‰•Üz´ØÖâ8Ý |”ió„±*Q2ÈÔbYaeeiõÓ袵 ]ry¹'|ÁqÇ1õ¼;ëûç§cÐóŸÛŒ Hïžç¢qè©¿¡áô¢j²æ:=Ž{ UÎ ?ãÞ8™¸¹úƒ%b³“™ê!^\x#^ç!/f“©;-S¿Ó’¤ÈãÔ”¨6¡÷©ìPv;›²¸{ý­“í¹¹tÚI€2->Šz [\1Ä@‚£Ô–[†]Q^vIbFŒ(,´%ãÎßß¿ú~ %DþØ„m]‰Ëk·ö}Çñ:4¼¬›®<Óy _é¼}‰œÖˆ¼ Âî¹ÿa%ãdj=€¹ûG'ê»ÃqoÖñ¬*³R®U*´TŠo@|8DArö+´ì&úò´žü5H55Ù¬e”Ü_"rWYx/"ÛÑn ìL*†ØAVϾ4C[¯|o »‚wì½¶!å¸ —+ÑÜ[hØ…{wß|ȯÏ-gGÒ¬°o/Y-Ŭ(…¶æúîÎ3ðF¢$:ù£´»ý“ìúÇŸdoˆŒŒ¡ÞEÇ“åØÙ}Ÿë´:)~«ÔžUR–Wä0RhÕàÛÞ¬7×—Öw\ºñÇØ&©N ÕÓNtÊ5ŽÉ@^_N_äŽøšgÕZÄbJ¢¡2wÆFcb‹ÕT×W+ŒU´±ÜÜ ep6òèÞb4µùÚçð.yûÕëìXŠ-ú t{Œ’c€?õ¾=»úÈoáû *ôF÷è)á‘&[´“–P‹ ß¾êBô¥;u?بyL8”êçvïŽ HYäL.~ÊZg3X |«¡J€¼üg˜?Hý úá‡qèɳÝoNÿºóó Å%ÌÅ’‹ôÕUy y-ôeôjN­_„ÿæ¡ÊðùQìÕCKdo¨º×o‰T)ÉÒ8E:»4|¶èÓ ?¬"äÔýô¬‰ÿL5É+ËrÆFGÇD§¦ÕÖ׻ꩽGªË½ Æ í¿†âRlBÙ<¨U´'Ö'¹$Æy5éæ»ÊUYíä'üñîýšõ«u u*¥y?œüœB¡L~T:4› ÜööZ½«ÌÖ ÿæïÜÓ›@[4Neú„ÈçT–MS”á9R!‚\°rÖÂ×^kþ¾Ü\mt`§èíÈÆž@ë ‰?{H«ÐipK¡4«-V½!ÇF9r«êsòZv_Î:$fš„Æ=¤c毞GÞA‘ç=!NÞŻnjÐM…ÏïŽíØ9{;Kñ 3°P•—Ú.âÏ©4¤f Œ0çöñtÊö«¯‚LÈÈirè›±R{ÈE—xRÔüéõ[·JplÑSîç~5¸—˜}Öå…Ö¸Gz¦ì±¼:´^o3“g@EõåpØé)3¶±ë}°`«ñWHsÁh2ÑH z}NU7šRS†x@6rËA­Ph³qÃÈNêkÌŽÌ–-ÂD=0ÊÊóÉÓF8IŸ‚3š“ýƒÏR‡ ²è,®b ˆ7ªLÅÃMbš|<µém†j(òûrÑ ¤Ë¶ÑZiÿ1ÄžàŒÅFj@²¯}œ7@+Ý—Ïa£œþ3¯$Þ›¾þ ÚòÒrkÞL›Ë@ypÍ·úu{y~YYµëÔ¹#]=@–Ø$@+T‘ ïïÛœ5Å­U{‚‚C£¨…ÂÈÌ¿1ó|(ˆüTg­±¨“è`‹êrlçƒÔö ì ×t'µt:J”³5ÿ}ÆÿDœ¢À[}T,öQ1ØGþMµe|¢YÞ”óôßÕø•Ó\ovÒefþ¾.{nßy4¤‚ŒÏŽº³þ>q< ©¦¾b† ¸&þ€kú‘øÑˆ™ÃÍ;êuÿ<5 F_¥•†R$eú¦ÇÿäUÙ±}ØVªÅßÓ~¼µ´º2*jÊ¿üS„tiîÅ8B‡Ü³8nÆý"´ir‚’¨X¢8|1Œ© l:ºPW¡À­ŠX*P+Ø£}Ÿ½L™wÝi}Nþ@‹© ÕÀ!* "‡B+Ágé1d'èó}}†t½ªøËzG1ú†yǧíí&G‹Ñ¦wî q;õÂùÁá»Që~ÌEíí¥|Œ¥ä×ýKÁöŽzãÿêÒörËj{:z¯Ù{³qÚlz›÷{úm‰ì_8®JCë]¥.æW'³šÃÄåóÌJÌ$jP˨ ER?ÒÕ Òw¢u>ývÊHV%ë5±ÊÄL5Ì._]Õ.ŽËá‡;21ê$ ±•#c/úßÝc¼â”) ê0;ö ;j-K¾Ì>¹ÐW­Qh¢3AHª­b›¥ ׿ ì6»õã>¬Iz.Å'œ£ö }Ôü´"UNIž£ÜBµ ™ ,À¯¹’W8èNRk°éûÓGmØ]º‚Œ79Œ •óz~`½· Âé)ÿ²âj×9בÓÇ/à¶­AAîW…(D¶ŒªÆâšÖžðZ¿e/옱†^ÌŽJe/™ì|ùã♊ž¥Øñìj^âà @n“\¬½Ý…Ò?ß ÉE´]b`«øF$;Y68 Ô¥1]Îî^h:“Êq{»§{à¤T©A£¦²á»ÃCC€ÛñM£ºU] °O¾}WyfR =;d©N'RPsÙ \\p2Xz=î>o¡_—5cý7+Šâ ã UEP¦|ëLv¹N{xãvSú3 Æ–]ZtÄ^ßh£\hÔQ4¾=q íº^ÓaÏÓÀÄ»?xî1•^ßö\z½r®à‡ÉFa<¨Ï®T+­a)¥9Þ{Þ#ßß|Ô—2kú¬ˆüø1e‘ëuÇBÙW^NŸä’{îâ`‘ž ?U€þěʎ]¯Ä¹³*¨W/gÈœPÁ¿zëê§ÞN­ê{’·bÑŠç7ì¸üî¹/þÒM}²®2µ<ùÎÔòÑ7Nf:N(ö¦+¦‡ÉâUšËN`'âdLegV²CѰómÝ.*qJ’ßÁi‰ûý·@©†T˜4ö1šú9…† .´ þA>²øAœoÆõï~°]úÿ{û3þvÁ+—&ÄÅÅÇ òÓ«kjkj)ä;´6àpûÛówû÷ˆÓ>ªíoÐï?u÷á¯|~ãžï£·ôƒ—´C™+çß+ý&ï9 º5•I³!tpí12·ØÄ’«ÂØ) TÆ|ïM·Œ¹ëX÷al:Å{"€ââ_4û:Ó›¾ìD3ÑŒêæÞAÏÞA3ïpÜ:Ï”ï`yPpplx:•¢ˆHb'¬ˆÛ€ÖÚ m…Öüúº(€ZMI–T—1ýºêrg}·éNvrôœÕ"J0Ý{£çÇ-¸bußñ±¿ZÄW&‹ü#á7éânšˆž¯£. ›ÞHÄ]Ï~'Z•¹YšÌWÉ"¶îLYùåæ’¨ì.!%5zo¯°õzï¹v'Uy¼àtÎéëè{Ÿv@Ëô+Ü¢;*iñœNÇÉ6lrª 0#E•žIý'¯¨*i¦F§:™5”l(tr#ÎŽ¤F Ý?j¸Ó¨7yþ)2YF"ˆÿ„LÂendstream endobj 443 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 3835 >> stream xœWyxSåš?!4 ,Š‘ô¼·.(\F½,*ÊEAËRJéBº¤M³5möõÍÉÒìmšt¡ ](`YDªŠlZ·ñê8^E}îu¼^/õëÌ/çѹÏÌóGòGNòåýÞßö¾­å´1¯)·Ë«¡š®õ©ãñæHÿñ=GŸÂ¢‚ùÙO| n71gtg´°•–HÇéµO ”9ln逃t¢&(“”ÊvoʽŠëGS“óïXIUw¢ÚÎäüNÞh>jÖ›]é&+H<×™¦×»y!`K°­V·ê@¯Ý­+(Çð]ÚB üÍZØéGK@w±¯¿ýçóßý×sOb:×j« €+\“›¹€¼iN[½Þj·kµÌê'õá¬1ĸ Wc Vã%ˆoC ÷5ô²§cÑM1_ekh7ç–ãü‡Ý¢‰\wÄ wpCÚpDYÒÈ?!Ë(¯“‡> ƒ¨Vš“32Îâ‚x9/Wf';D¾^§ÿc ›½ jÁB°²b±3ÍX7â±6P˜ÁfÓ³xÎX¯¾Àª# Jõäaœ,šåD³­iÞ ¤þsÂÅo~Öï’oø¯Ѧ¯ù£k’´ðŠUe¥¤ºÎcò˜€¶E;¡¨ì~I¦d[a!Ü®ŠŽ¡ƒõ®0{ ­pÇý}à7D5JƒÜÈX»ð£ÄXjS‚´`s˜¥ÛJ÷ç½>ˆt¹ûO¢él Ã†}¼¸oÇCx¾~\”\£›iûª¿³h_£½¤R[nT±Ùx²& òéEW ?Œœ„‘#Lësï˜:àC¸Ð:ÜýÇ.4N6NXn! ]G9×Cq^û tå?i¼ez›ÅhcŠç®©*:¯¦«›ˆ90Àv£{<­‰# vC3¨+7Ë+¡Š® (Úâ]MGÎl ½X¸Mªa*/¿ä/zÞf,¬LÕêur>ŽíþñrK7ÐÑý‹ûUk ð\¶fcaN6˜@ ²P‹;~€P·­Ú«.­””d–\îñ8™`AoÞ0Ðß!aK ‰vç-ôGgŸpYëõz»¹ÆÈ=’øé”¸ÿÑ&Мd_Нî烙Åã|ÐŒó€-Â6Ù|vB|‹ÝjÕàÙcÝ¢quÓªqé7±É\A38Àù˜¨Û çßT÷7k)œ?ví¡u10ÌOª’· ]aà žNá­«1©õŒÍlØoQÊ—‹vãµõžÕë@œ©è;y«ûÛx”œGp.éÛþ?qþúHé7%•:‰QÁæÞ«Ü »èß](=×ß9x©{Y³#w›¤(¿, ja·SÕß!ý>¢tg…K'-®Ù±} à­ï¿ÿ¥LYÂ…ûnõò§´˜0 EA94¹R c8Ùáëåü‚8áƒX@*" ì QŒñÆ®ˆžH^°&l !²¾G 7¿X¨Én²6•y¼‰3Ç<"]®ªd±å:»Rï±z»zœpˆí†^ë!¢ø9^ Fv³CƒÔ;Üκ;yLä\ýŠÓ8ˆ ÅðÜõɌѩäc@jFq´<Î;ñŠâ'Ÿùw¡ÇTo2Ûl³"ó@ôúϺ‚ŽÎ†óì  >àNépŸƒ0=ôYÌÇ>€WÍ?·â/hÞg?™È)œ‡ÿ ö2{ýè¡ïZ>ÙVV”êÒOÃTuëèï[x£ŠäZ!zô^Dáûñ~\å¸/C ûP!ªBåÈÀü®_«*ð¢ <}çóK7=tÆêA¢0ZðšÄ¾ó·¿œ!Yñé[ðý©Û|HÉ9z-Yщæ_oŠóo ·‰E¾::Cx"+±·hƒ2£”1ɬº*|ýìÏü²—+ÇXåªE/ƒØBÆEÓ §¯è„2¨”Uçï¨:úÆ‘s‡›˜® 4ÕQ?ŒFDW1ÿ-‘ý^8k·κ„ßõ}ÑHÃp&E•Ù]!¨ii“&ÚÚ?œš›Ðzª:N&§Á8:ÓyG²ý“î¯fÍ<::;yZE5ÏæåI$ÛJD' .¡°§Ùé:Å>GÄ€~ñ!ƒE¼±= @o3Ó¯|zJ t±1ÞßéyÍÕÅra. aøhmg…ÿ»8š2ßÑW_ij|X ×ÿŸÖ9³0OGD:G™úZ€Ew8ÑÌ›¡ûÙm<œÛáa/£¦44EðeÓ–Bµa¿IÊËõ §gj1…Ò!ô§žïÂä¾¼LÃ-aÜu÷Éð+Ã|Ô7š&ŒÕ6J+*$аª9Ñ‘è`|c²_L¾Ê ÅÏgÞš|=áÄy¶ÿ‡`;pþ6±7æsLîÂüÿÍpeF™EÇ$»1]³G'©+½«»ð^çûRE5^IqÅÿyÒy³®º¨ì?y/),Z©’–JKåášD[[k“ƒ/ Ý1ÒO'=”Ó³}þæ[ês8¢^¦åü‰óon²äH­Z‹Š]86IñÔÎÍ[@l5(}õ„ÿ1ºQ­¨,“íË=R}jä«Áo[RT Rúþ"xÓ5Ð+WÎ~ÅOÖýÊ8äÏH3³VÔz#®„«‘uEµüpiCûcΦ®®Dó©Á¯¼ pœ=h#ùiâì`çl;­ú<ÐÜÌz½þé¡ÝåY†å«˜¢ü¼Ü|õß’ËD)’>c°Iˆií ü¥áùcï[nƲX3ûB ¾ ‡qûŽ£ž–në§5°Œ`±êl[j7Øt$÷LG[c_œi ¥ö§ ãã×èôÔj3zýW«z[ɶþjµ9sŒ{ˆ¾”{låÊÌìmŒ=dí.o®yx 3yâÖòôIqçtú¸Æ°£Á‘žNQÿü„²Šendstream endobj 444 0 obj << /Filter /FlateDecode /Length 4788 >> stream xœ­[KwÝÆ‘Þs¥,¼ŠÜw/‚~è%iÉzIJ‰sr2æ, ’¢ÝKÈ$šù᳞ªênÜ® ë‘£…p~VUõUUó·ã"Çþóÿ_îŠã›£ß޽=öÿ]îÏÎþú²Ä7¹-¬8>s予ãZW¦Ê­2Ççû£LéÍù¿ q]±Æ•ÌkYB‡ó«£_³Ç×›m‘¦uYgãØÞn𧱺®³›ÍV)™[›¿¥×ª…Íx›©ÜÖ%~pJ‘ýÒ_E­Ø,ýæÏŸÍv± +Û*“×eéÖ÷‡ÔÐJÉlt‹Ðµ„µƒûPˆ*{-®y¿ÙJ‚g?«U03Ì k³°™*»Û@‹¢Ø€Æ(Ù=[íÀF¹ÝÈÚ+›¬ÕUXfX¥*LP™ 5÷þM<]3Œý‡èÅ%;’‘{OÀ’w´,¡«ìc»*÷+/åk’ìâ>HeuÝïq[JèÕ\nH´Zeïš7v)ËRVî@M(Ž[Ø: mˆšg×}ÛŒm‰d °SaKFÈ7[]@ZÅñ8-V, Ùc®¶»­ª‹\Zs¼*7ÚJ7v8®p•.U8÷…NÀ–ÐÊ£sÈ0ˆŒÆ/ÃuA ZX¶-9‚ÃHZg·|7‡e³)¼À -5Àrhú{?‚È®b zŸ}¬"ÀûQaر ÏðzìÜæ Ž8‡ mEf»vu3M?­·ë¯f­<4z/.XW|€]Ôy>ƒï»=ˆ €"ãF– tXÒ Ò6œE•5ñ(W3 Zf4*u}|þÓQönó—PaYŽ(u»¹…L6ªµ‚Ÿezb€í ì_Q¨ì鈭Ð슬٠ï“©ÏRù!t6YãG­Mv×ÎSk˜®ïRñZi4 ®o•uo|gu°‡^¯¼ûÏ:Ûs‡£$E¶{Z£d&Û‰€µlÿ̑¦òú;ýÂ…äöà}§X1ÆÃF“S9q&#/7×±‘ÈorÀž$àòíµÃÐîÛ]Ó·cË\É:À9¿ž»W¿TrYã°:…,¼„ë2»I±¢}³s}K3‹²}3ö-³)šdž“;°ÎyÜPÍúÆ2Ø®n{BìÐ>”â½»ý¤¶ ÒñlRëv唺‹Ud¹ÿ;LârÀ¡àñâ¡Tíóÿú5û™ê˜‹ªv擉{UÁν{öù3aOc‹Ä‘4aTû&Á›ºöHLêÐîîÃ"K.Í>ð" ÏÍœ¼Ð>Èâbu­œñÇ× ×ÔÚO}—?a´„9þ€§Ïsü&WRLŽŸ;rna"ãÞ¿ æü†¤<ß½ÎÀ`š¸"Ç€Òj¡½ú£ÀEݵ0 £»ÆÎ=»Ò8Ìá‚”É:f¦È~ö¬ÃM Nü>Ðp›XWGÇ´­³x\f%ÚaïǶú«(ãL[ª\Ê*¨ËY3¤HÒÎÑ"x¹•kÊsØÉf G¢€pȈoÁQ ª]ÕGKÌdŒA0£C´¥Ú&®ï£‹"ªrÁÊâÆÑ—l‡xäfç Ò4¯ó8¾IHqIÆrãÓe‡ûÛ‡µ @(¬¨ÉV? '¡8š~ôÆÞãýC¤gà°À?UPd· ÿâ¿ 窰‰ô¶X˪Ðh‹›š*-%¢.Áù ha¿®Üdk& ¤Š`¿`B÷M¼c¤‡`[ \PÒÖUéìŒ&ÄnF˜<j×a3b昩ƒ–«“¬ðgÊêÌ‹ ‰Áê”°Æ´ˆÖ0jâ¦wÌæ!Is´ûíÜC¾£¡Èˆ¸ÅKÍOÛ¿[RmÀÁ¨?r”Ó®Ñ{s š0Œ ´Ý­¥é¯ürvRÃ’í:…æB7ŽmQb P›š›¬ê÷1ÙZLvˆ`/eÐ.Z7x.•úë¦sc'óH Z¨™»:Ü'¸ºáÞÃaÁFrCɉúÓ°ó­ÒL9GÜïÄÄm7 2…³-ñ ËÁ¼«¢œzÉ@Tˆïwá$5F9ð˜=`v­[X«ÿľ0&@i[ hô'Ç„1€Ÿ”GFfŽ-óª&ˆ¿ŠF扄¾) —„Pf ¸ò™®Z›@–Äìc ?ªåÜ“fHçb }qÍÉ{#|-’B¢˜ø¾Æ ¾Q%±Ñ»UÝú>Z}: ‘„Y ô–=ÐòÑ÷.ÄZTêDZNTš„ê)Q“y=;½)p$1‚t] î„W¢TPz@=4bY$Âv•Ü¥3H77£ÐßÏŤ(^šgz„t¡OïæÇ¼æjfªïv¡‡I¸ÀÄ« ä\¤' ù˜'YK…R^n` ,ÕeŠ`ÅÈŽúŽË%3€V £o;t;&Z© aÕeváU³†‹D{íVšD oœít~ô÷#—b7Çý—¦Ö5ØÚÒØcSš¼¬$æ×Íž1G±gž‰ÐSQPöœK’ÛÁÞ§T©hn[Κ~לPx›½ STǦ۵ôR:7\ç›é› ÄÄ™ÌTxB&ûqS»€‚ma׬æv»ÀXµB…‰äù¥‚”ºÊ«Ê#s!*.2,T|ÛIƒ”¥fãJàRÑÈ_|Ì^ºrZ‘ki¦3™y0¹¸7b’ú•êáñPc¡”ÿ‰´$ð‰ö×»4Ç5Ì·˜¦ZÀMùþ#ª¨´)Ž pSy½yÒõ,r}‡»—dgÁSQ âvóÞ UšÓôãäHÝ¿Á4éRçÊ&ëF}w(oçm:É”è›6‘7+Ù_oR4,Žc_ÏÓ®nQƒšÞ;‚yÇ‘ÁªüÊT£°Ä ÞDªäCMÕï£Ý‡iKŽ Ìj´(™$g nõ磕$²=…„k{d²Jµ,ÊÚNØÞ*ì@²cð>,V”5À·”S]2¶Eb‰»)\ññ§H"~ÎŦìDŸ 2ÇL2[Syñ ¦Ý£„ëBº¸™NZÏ tKÙ †Î ßàþj—¦éBÌ^#jC’¢¶´æ78Uüèr€œR†ÏJ—’nìIp9"¦­²ym•³G§E™ä‡T=²U¦À®2àHn»¢Ü²Èîv×W7ûëÛ ¿g`ƒzù~ ©r .¸ úF7ÛyZw5±Ÿ†ùYfˆmCù‘ƒ£Ûï®| …Ñç;j#´rã—tûŽa†Þóá¶ßùF…Éž{ýWàvX{N¹Ü Xl8c—·Fg:ôB¥ Ãû„Í8li(—Μ‹y-·ÖÈVdpNPþ¿ý/5úó›'$˜"ÎkŒÁÆöb½:N¬Ò|¨&î²›,›¿ƒ…¶-õ\€ÉYþ`ÕZׂŽzå&‡Fyê2É*x¢SòÄkj'´Õ”Ãþ± ys£K,+Á¨Ùùç"*ÛcF¤¨À~ 8W7µBš@YcS‚Éq{*¥Lï¿‘=ŠÞŸúa0^[ç‰Ïôy'PÊ1–‚’ó œÞÏ Á´”Êðö>:® p½ßwóHχy |缆.Wâk˜‹Šn±®@À6޾YÖ¹yåí)oU 0B¨/“+JKâ¤ZkTÞœÓ5OÎݰTO6¤î55Df•ª¸~IUº®€Ÿ_¿9XUˆ®o/¯ÿÐÎFƒ‚…÷†ö´oâA;ÝHÊ^lj”pIïÊqþ'ñæ|¸fªô<ÇpaGf?=£gpÉÂÚ‚RvОHüƒÙmߪ¢ræã’álôQDÖ¯ÃÝ܇éMvº»éú–¡{øú’bZ-EeñJGËMÝUä‰óP5Ù‚?-&509¦Ô”°{º)BmóÑ£Gx9µ&.|¾©*—ì÷i,1ÝÍå!Û8ªs]/”#ɤ¢!xuCh¼ÞSôb¨ÚTãö$xLÂ]ùO`X~ˆºÝG¢|MkÁÔëu{=¶—ËyQZ˜K)žø´©âfËC¬šÉb1µ*a[zŠg›“ Ã*“eý]¥óQ6ÐX709„ë--Ø/ÈI¢|É“ºØ`¶ Ú8aGÆá¶t¸5‚"æ§·~pð”¿|t6-e™ýdúœŒïhH—ðƒ¡-Ät?tÆ—Ÿ¸(®Bb2XÙ)k³»ÚÁAÔÖ :­õiX*Øøþv;‰ð௸w,N¬ÖeZ¹BÑÈÀP>O®È·IãMöø¡ïm9/î¸N:£>JôDà\/Öo° 9"hI-D]ZVk±ì"øJÔ··x}ÕºL"éMø±Ö­†öûË!®¡.jŽ×U”±”•û˵ZPÄ\fæ»Rå^`ÿSªÁ="¡¥fàvby2oÖ.Qðøí÷‘SŒràþ¼pu/ÛS䞤b\¶±¢K_¬àó(RÍ83xÃNvRxýü,({@œSv=ÕJ·Ï:Nî8 ݪº¦´Ìÿà¨5•²‡üNE“þù‚ª-”‡¡?ÀóqûçŽnáØÛ?üÛ‰ûQ€C|Ö4ï\ø»ƒ¶ ýÀÀ»‘5X¹®HUšg~œ¯¡"95-³_’ëͤïôMd?9E…õæ_P‘_–®Ö-'¶×Õyζ\ø MßøhUY~k±åWœw¯Î06ðKUɽå²ÕŠs%׫ýß¶egm×Þ¾ézúÑS-x0ãó9ŽJT_ã¨äwÒzèJX!̱›à²ûg„&á‚‘XYÏéNK\¼p[š¬[ʃ†¼›¿W•RW~ ©Ý»L¨ ”y|{>KøŒÁ¤˜3|þ×ÑÅ‘jÞª»}sÝcwp)€§ÛK·d_û©¥/‚øG`ÞO›r L$\NOÝþý‡Ýõ’¯URçA>N÷·Àè¦Gì¦âÃüÀÖñF&‹çX(Î/8%·‚Iý‹U'¡0õI¿âKmÕwNÛ×Ç@O'güÃó“P³Óß¶ˆ¦ÿ«‚RqªV ëM~r<ËŸÿ9ýPÙ¿Š<àé²+öûºBí¸¬Ìžö,ÉÌÔä÷–ð þÀ2ýÉãÃù6ïߢ=‡XIRxØl%1ôZÏzàAÁU„ÅàV>Ù ôS4ˆÃšŠ( ê„nVR¹ª¦?¤p@!s¥Ç{/‘¦—è-8€Ç, xŸÜÊ#ªQ2œñqyI6xMUª¤€tN±NÖ³²À°k¸7÷«Ê¼žG÷_6ûG»ÛµÍ>à0{ F"ÁÄô—åóë!=Ýwcµ‹@ô:“íÆ1ºô÷÷£ÿÄn endstream endobj 445 0 obj << /Filter /FlateDecode /Length 4342 >> stream xœ­[KwÛÆ’ÞkåYh5³Ð²9G„ÑotΙ…,'Ž_¹º’’»ˆgÓÅ$€Š£ûÛg1UÕÝ`7DÊ’ã“…A¡…ꪯ¾ªêüqTü¨Äÿ¿³ÕAy´8øã€Ó_Â?³Õы˃ççÿR¸Òñ£Ë«?…UüÈj[8©.WLšÉåo0¸²Ù`+ŠJ˜pùéàWöj>™–E©+^™Šm6Ëõj§ªŠ-&S)EỼ¦?KËKÇò1=’…« ¾ð gÿè>%£²]ºÉÿ^¾¹÷Ó(ÙTê¢2&ÈwK«¨J€(ÝTÁk'{uŒÏ ¤3ì,”NX'R§Ï™8qMU±“³°¦ìC>êS2½/>LÂ$§` (KñaRÄÏÊõ]ÉÂÈ*êû2Yæ6Pšƒê*ø»µE)íh˜]YÉê?çM¦öŽEY*vQ§¯æýª^‡Ågga §Yû1·ÂA%íX¯?Åš½ÆAÊ ©Ù¦§]Ø/ «»e½Y¶ë~ç‘ ­ 8oÿmìÍmª„-¸GS. +úÏþs"*[(Ö6·‰@«9ZŒ*JËÑÜ k¯¶§¸K«FÁâÊE­ž&gÞ®>.×õ¦ÉXB9Þl–«å¿écv~ 6v8§” ${ ÒÂ•Š öÙ¨(·æcïeY±—m—ÚI— œáJNXÅ®i%Å Ûx£™ŠÒަBº :û±öN…ï›°˜“° XÉTrº’ì=>Z² 4Enѧ ßÂ1?;Yû÷f}Ÿè鯛ÉRä н°¬[®FÞßo*Î6¤O܉svÚ®n’/;éÛuIãñùGð£‹}~L+Hg{ŸcQ 9-É Ê¹#âäŠý0©À°º­tÿXãJ )ððqô8¥?»ŠÃ‡¾krÁ³5ç´&ª œ²Rx®2ž=¨°Ò‰åTʸ`æUåì_“Šà²¦£† ï¢mö²ÞÔÅ„K8èÒ²ÿØ Ú•Ô"á÷·àÈDÓjoà„ÃߥÏDÅiÅÀ)¹’ÑIœ-ŒÐOóa ©áýq|¶ìǶ['ž°ü=¾rì->jP¹ö¸në-°«*—X)øòØS;?Ûyº4Y¹á¿ƒ­œè±è/†qýÃjÏ;òC¿Ž´;GÔH£ÒÅ· ‘ ì#AHÖlgPs ñ$0ƒßëÅ< ²:F.G€Ð# óéÌ¥¬ £ÍÈÏÊBLÅñÀN~>Gyðσ²Ðćºýô‰ƒíàO\U…àüÈHS0i Q¿²ëÍææ»çÏOÏO~*ΧqÇ›®ým>Ûm·x~SÏðóþçòâ,‘âÉìMš²0ܦ»ƒŽ1¤ ëèÍÓ쾪ˆ ÝW–Ìf—ÝÓ0Kv_yÀðvÿ1aoP¤E|`ÏF†îW†â£#ƒzr­«d¡®î7Ýmò‡Y†ø·£ØIë—¼J#Aø6´ž,DÄña[ú@ÝMî>‘ +Å>ãk–©Ð‹ð]W.(f¡§n(–@Àìžþ^)Ë0"ˆÂà‘=“+¢†#E ßÖ~L~5Ù¤ƈŠHÙî‘Eíat.6öýf9›xî¨Ù–ivÑ^m>'0?ßíû ¡zÊË ¬ –öaÝ¢,?ˆDâ›qû­ÜW/¸u ÙäèXÁ«?þ\üÖƒ~zÐ9óŸB>_–…ÿJ?Ö\ÂÉl;ïǘYà›¯cy¨'®éy‡ûaú±'ƒÖ“AÈ ¦íÙËeßn€¯mÀˆŸÐp Ô»eÓnúïB†,æ$¬þ˲O½tK e —~¿Ò8дÝÀô4±ñà¡Ú±Cg7jãZ@–¼Ç{hƒÐ$ΈZ°êºÛ,7Y¼@aîS³˜œfyG¿Éõ¼Lõ¹ˆ.¸¦!RWK{ÐùNSèZÝÜnr⥄ÏÃüpÎ^% íæ]épãÌe£CïÉÊøÊ]Õ”1oãå^WÕv·«r&¥>”þMB”æ…¨x°lniÚHx0m"]j§iMèðvfÙ‹4Ë÷4Cõ_“yH¹ õ‡é!M¯È4ž.üéÙžêǼ„úK壯©üa|uâ¡òx–Æ|ò?JÎp:D¹×>ÕÒÄïö$'© ç±Óûî®a~d½ƒ$ü0@Ä„Ýï+ç1µ¨Ðá*ÏL‘ÍQª`›CsDîG®Tné'z“ÙÐl¡„»ïN@{\ÈelEø•„2Ά1’?!ŠYñ°ggð…®CYÈ)ÿæ…OUêH)È$´xja žxÿwÊÊÊBèL†€¬Ò z“}J>úJ¯¶f¤¼ ³AïШNÀNºúcê0ئÀŒ[Ô`ATqÇŽÃßøÈoR‚Òø¦D¨¼‰{ï0|_ÇÝY™Qm?2è´¶¯†ÝAÀ=ñi®6Œ@ ÖÕRôèÄá–˜ÞX%²Þ@XǰÉ.ðÂ1*E½¼KûM!Ò8ŠX}s%æ9ÄäAs‹Žþqg½ØMTÀK*còfDH¢´( Ë¿Ö`}gïÞà³ ÅUÄDUÒ¡>»ÈzBó0Q©ýÁ¼Yfª¼Òa?Kž%¦luºÈuxcDž5dªi»»0 °µÎïÿŽù¼>Uo²ßq äƒ?eb®2&ç5ó#±:¼Í»wt¦à}*pºæòÛ}Ÿµ*Ò³¿5’¶h#Kñ¿ò¼pz:¾…DÌ O ýXi-͈~QTà0ï¯åŠ4ä{7üËm§íkªtŠã#£Õ ^žÖ}üet"›Îö¹[å½3¯|?ËŽx'åz%8Nµß^º ãËq;¬îÇÕÑí!÷±¯¤ö;§…¡tÏ^@¼_ö×!xø7O |èósïÜdA{ªaJ•×8Îú»´|Ý6®ƱHí­r”_f•±3%vw¨Ê!ǤÛNzh;YØÉ<€V]3¢ŽS‡4û4>†˜g÷’DȸݒÄÅ,]1/]íš²0ÎÊ„,^Q`Oãg“Âz¿™wþNR4Pù¨ø4¡€qtO‰—(œJ‚”-=öžÇÏÞÕÂ~³§v4ùÁvÐØ¥TÀì‘t ýdï1;8{HäÆ3¼5I‰Øy1¼PbÜƒŠœ¯Â(²ƒõ-fÍíßb|B![âGÔÄyšJSEk”å¼¾N,¯yG®wæ &¨)JZ|ËåÌJ–§ m<$ +M$Sû , FâLti}°´1 À~~8 ˆçer„&4I=âvíq–îþà$ˆ¬'ÝÎUg¨Ø6-€HìàÇÜ2|½DÊã—„xqÅ¡‹_ÙQÝn™nÕßu:^€Ô_GyU§8ÑЋ/],:ÞéßÖXWÝqß%ËÌú~ù_³m÷>h°TE¸ý JC)ë†îáßá ~þñ}¹ioû8Öf¨qðn±Z Ç5‘׋9údh8¤ÍæîÎ’š\òÇ' ÚÕçãd$A.¡¨À¶áOüB’­×·Ôà†¥ qBí °Q ©G·ë«yàçx±b=óÂK²ÃXŸEèÌbã~T%º¦‚‘ãž â¬P¿š÷ó¨*x“ªªŸ]×WЍ,ØÕÿuqeËÞÞ;ÃßÃÑiî£Ç¼ø¥Mkå»/¹OYŽý3ÙEž`å%C,•‚:.¹ÎýtÁ^Ô]S‡•;ÞØ´sÐ6Ë0¤R÷D•^ÕùÖõv¥¸*ÎþÁ:X[F‡›zïõΦiã.ò%ßÞrðí C.¢!6‹lj»¹<͆7™©×é¸e³¤¬›Z7w$D¯Ó¢djPËŒûaµ£Yz¼M²Ú.\½uì¼NWûݧýz”= Ë(ÉÞAH.îÊìâîû¶%‡ÉôîFS‡ýýi§ÉMê½£‹_ºÞ ”+´Œ¼þŲ]®¯ÚŽÒ~ƒGr>tcu3A=ª©“·;…®…Ú¤\Ž.¢½Íz÷7Ô7›k>óù ŸU¸mÆõÝzê$9ž—0v6ÙüJð‡´¨Óµx·‹0¥ôOê2÷«=!üìí=̃°h#µOm·Kç5˜ d[±1ö:Ê êù!*ý+Yc*4Fyá$iå%‰±Uw¸¥ºçkš†¦*â{gQai%¤ÎÈmòc¿ënuz¾û8ŠP¶Í¢}žì}PâC½U<¾Hu¶÷HÌã_Ç©3Aº`‹pqK>ijÒpÏ!<+_ÎV%ñ³%1¢x«pOµßÚÔ?Êžóh¶}."ZY&¸:Àƒ; ̯F÷ÛÞí8ßp‘`Óaw_zÐ~ƒ7^¤¿#“”1±À¶çÚGÌ1Æí4é™l׌¤‚~->é¶Â.Ü)ƒï¹ó#PžzpB\!`œÑVƦ—Õü­a,é>îŽÚô"³ôÜ)à“ØZ»ËgŠî©0¹çnñ4œ«« !E–ù>ˆ¯A?ßðpëï:סD.Õ¾[Ǧ*ôàLé) ñ÷Ñ—‡ŠGÔwxUŽÒîw>teV÷¨ }e¨ ØÄEš¶×q- Á/þp!6Ho×Ê…+ýô¿©d—®þsÜÞ,Á¤¬·; Ê ­÷û‘¡ó7,üH0`EÔ!LkÌa·£›àE¾oî°˜1 î~{s¹cøè*ô—®€©&WÀ¸cßP…³:O:´O¹bïÀ”ŸÔ@ükŒÝU‡3Š¡dõσÿX)Aendstream endobj 446 0 obj << /Filter /FlateDecode /Length 4493 >> stream xœµ[KsÜF’¾óDxó§uõB½‰ØIÉ¢eQ–EÊÞ kPw‹„ÕÝà AÑœ¾çÍ̪ªÀn‘v̆"$4P•õÊÇ—_–þu˜gü0Ç?þßÙj/?¼Úû×§·‡þŸÙêðärïٻ›¬ÌK~xùiÏuᇼÐY¡ÊC«mVJ}x¹Úû׳‰ÀßF±ëIžåZZž—¬ZL¦ø«à…)Ør2•Rfy.ÙY7Û`«zk8´(¥`Ißö;«,çìÇ[êªKUÀûß èÍΚv ­?…O†ÆÃµõ¦««µ›M©Kvr}u+Qe+E–+nXWMþyù öÄäñžHi2®qg.ç{LêÉåï{S¥øáTÂ&ƒ¯c'éBºFÌK³WøÄ³òñ²,?L2˜–! Íö_¶ÕM43·UX,l8 -%Æ $‰0é*Þƒ¹/ Û*ËïÔÌ5Ë g?ÄÝ?EÝ´«ª«›0weÙÛøxÛV Éfñr“µo6u,þ*›pYÂiöMXµÂ¸! »ˆÿHoÙiÕΣ·pÄ¢´¯žc §^ç•;EЧÏÉËŠÞ¶d÷jÌÁÃ…s-”)§\fZ•ÂÞdªPK ›Ì&>ŠXþ">•z¾ë ìåÚ ÖŽ>Ù¥¸×&û09 º—Ú#L³È•ӽߨ»‰F2di² ˪y½¾ÕPð)犡â)U¢­ü€cÀ"¥fëOÃѺ––ý2‘ ùЀ՛ÛjëÊ¿]ÓmæÀ …V¦t„òðx-‹5/~Îpi€F÷¿;oÚ+·I¨m`õÕm¢™è1@óJÁ¦4Ѓ"³¥õçWn+o᨜G¥×^÷úÖI“ ‚}Œµ¥Þ\ï<ÂMð.#£I 3ë}P™èOï}À侟¸dp3mµESŠz“ülŽ|{zìàɽ¿ˆ¬ò÷SáÃ~ˆ‡?yº3>Õº0ùTK9-3·•½)ž 'êL¡u' „ÍÛ$ëó—Ogc5ªûñãý[»èÛϾ?ò=F†Õ%aDáî¹öR‚½ˆh¸ÜOþY±ç÷ñ™U«~(¥½Žùi4WmµZ¥p‹ã Šû)ÒϦ™¹ #>¯º¶þÃÿW÷–&i…{˜ÞÑÝ&Ûë’sŠ|©ÿ¸{c6¾OéÜŽ^jÅN?Ž6‰å$ˬº¦­«e˜³fÏ+¨ý Ž×Ñ$ªåý¦Þ``((|³ÕùI¡²‚‹àiÞnîc»¹nV ؤÏÛƒ¶)3%óÒí#ŒÙÐD&M2Yj⺕¾Mêì– b>0‰Žšâ?#/dG˜Îå"£©yåÓÌKáùKg^ Oâ»Q©Èn°¹ÖÎn4ÚÍÖ€" 2˜Þ{Ÿ´Q +ÁYÍ®§Õz>=in×sŒÔh·†÷Qâæ&‰³!¡º¡î€oèFªØû4êѬ>ÖëAMP>ÄE¯&Øœì±*ÙÚ$§™ñɃælÇi9ÎÓú³r‡Ûœq!GVwYÝMôÜÖq¹JMíë^ó6óá „*ŽŒ½{}:ò¯÷&Ⲹ/Ðh[ÀIo ¨JÐQ0¦‘a "/[?ï{§8®î6Mì/ ^_øN´®»tI˜"Óº·ÏË9ÁâÐ|Q—¾­æ-+Wu}§døýqh¼Z¯kúB“|K ØpÖ|Œ•a±ÚLÐæyñÿuþ>ÄÃÉý2AàZ1rÆËêj«’ÛT›Àôï”nG{àã•Ò"ô6zôÂÂälAa¹uÎå.œÁT¹å}§GF–£ÜkEr è•Ä’…¢¿ƒò5xf8U4ôG²A6Ù;õ ÚíqMSÑ#}©Û&^¯ÑF#¬o§ EóKsèš~ÇmŠ©®úÍPìåHРG3ÜÄÆøG¢,Éáƒþ6wJ´UÄš¢°šƒæ Š[0­æ[z- Ô½ýó&5ï‡Cñ}Àj#MIrÓx“/+Sð“[Üd…ìÃÆEó©ÃèÙoInò»Ò"•3ùƒ îù_ªõ,¸ÜåÎEÞ±7Q2’ >ÌÐþÓWÐ í®jû³ðþÞÏ)¡•̇ÉVœ“rqôðÞBR Å8?yü•`¯ÓÂXŒKãˆï’ö_¡DgïŽ ³¬(ó¬õubÞÉÛž¹£öX_£n²îº£€Ð¥…ivÖôÐüÎ=I=éË¥–XâYžf,Ò–ùtP¶ëYBÆ&°æ& ®Eöçuå³5ð˜°ÊQ%Ü¥iæƒÝl»Â투“Åuõ¥FìÄݹ`‰0ùŬ^¬@¶ØÁ¸ÙÌŠX¤h–qÙõƒiX•ÊBR-دuÊ›ß!„“üœŒ„SUžÒKè W·> Ï +¢(±ûÿÜ5)¶rucK.ƒí•§¤˜2Bç^¨I•w™ì(ûóSBC žŽšreE¹µ–b$5®t‰¥û¡ÙæÆñX*©h2›®%_Y8¯Ú´K¬!,n)5S|¢MIÍn»Z«L(Ó—<VÒô®yÖkñ"~"æÉ×^%·t& Ç^ËñüÇAµ#V´0d´—‘*Ü-Ö]lNÓoÛ 1]ª¯âj°iÅÖÝ¢]Sì5D@ʱ¯?-Ú>4ù(…1káÚãÐ.ë×uÏ«Ùu½b½îw *1·kXghƒÚU–O#Ó?í˜[öêëv¢¡¥¶±Ú<+¥q¯¤`e\ôØyG©ØéyØl'.u)1“Ú¦”Àæ«,íÀ*L`ÁjÈíÄnkÞÆº"×S“e’‹9Æ»TQ*<-—I¶9"ui 8újË5·å!e>”üÕ€à.ÛA›É•€äRË9ᦿT%7ie(¬»Ž9ú0óŸA²ëw¿½øÆ +§ac­ßË>Q~A›–Ó–Í’\Ë]eFP,5hã«æ¶%ëRÄ‹9NŸQñSv(4‚=áZÌŽè)Ý×k’E¦¹ ’x=¤¼Y²ÿPö‰©{ÁËCôÁªtéŸO>ïîî²ß7°X4åœ>-„“´"ñyì‹Ïê\aƒ¿˜‡rÉ‘%?Tˆ7QŠ~ `ÉÈ|cu¨ßÕ3¿‚à‡açHY¹ÌC'¦íÓ4)æ\.é.KuÒ2Íå‘ ‘ê¤mú‚ü]zE+2«Ô['M(æ}:òù ÊIÓbrŠøýÝ6Ìõ–·~cÞpéj\™Sia›$å¶}éü"¦`â„rºûí¬Z_¹#ÌM&Œþ•ÐmdX^$y¢¿dkõA)BýܳÍšMûm´Šøä>ùµ¡*]5ôÝE¨/[§öŽRTJ³Þ`9\S6mXRV5Rº<â‹ÿ¾0º3—[ná3ƒ}ãîø’[v ÅGÖ’(üC¥qW—ÄÑ ¶7à'Þþò·°¹}akíšÍ›¤ÉÝðáîÖhoÓ~vgןØë½Ë¿Á™µqÎ l(<öÿ¿$пC¼öîo™á *zαAcÕ6†¬ñJ¸ËÔgƒâa`ñ¦Þ¥¿ŸtA!Ú *wzõhMÇIo½ìÅíp¶=ˆt}íkE¾Ã‹¨ða¸b ð£Ã»óÃÁ¿eZŒ}éÈËèÄË@¸^Ðm¢Á£D|®« S[þ0ñ­Â¥`ƒ®Ç¥zG„]E¶ù+¦Uð)þJìF¨CjîÙe@"7Ù–ÿ¼÷O’endstream endobj 447 0 obj << /Filter /FlateDecode /Length 3355 >> stream xœµZKsÜÆ¾ó¤xK¥xJfS\óƨ*U¡^–dQ’—ë0UV0Iqab4€µMükó3rH÷<°3Ø]‹~•yö|ýõ×=ûíQžÑ£ÿùÿ/—ùÑÍÁ·Ô¾=òÿ].žÌNf…†7™É =š)ò4ž®­º¾*Wn5Fòd}u;¦€°"ËU¤/'ÿ™¿›¨<¶ ç*£-3¿: \OæßL… GSFR _EÞTnY¢`°Ê·¨<döÆ?SJ>j4ÿ0É&8¼’äÑi°#O›å]´ÆØ}j'ìC3ShòYòauI{”a÷ñÊÀ99­Â‚|Œ¦o†Y$yZÇÆëv¯Œy/ ¬ï»ªË&”0ˆ  æÕ©yóŒ íÌûy¯`¹\¯tMEh}Õ¬F\J»÷æ#>+;s¿¸¶ÃO95™<šRžIa˜ôÔ‘3á‡w‡t¶ó¸™Ì¨È™?îcLR N`‡\ÑÌ-¶CMQMÏ”QÔõ9+ÛKgfÃÁÔ¤é›ÖÁVj•8`{D3™2åNã…{Ìs‡¼B[äq¦,Ú=©±­ÆVÞ!Àxä{1Ûä<7=òÊž¶Ì­s½½µù:êW'—ÝcÀ~n,öO}ÿ‚’/càTÞã+¿9AÉé]Ô(v›¶)ýf Ul&D¢Ù‡B8Ay8¯Ó `¼×»»:¶ôµC’v)&·§yÞ7‰’’ËE ¼sé±(D&!á„ÝÁºÖ&×äêºN’#áÂÑ•+tJYØÃ{V5ÙOH(ÌpR«²Žà|Tu;ÁM™È˜z0¶ù.h«ŒiƇµ¨æDóCðL2ªãÙ£¹ÐBqàºvéã‰WÐ c0&‹ù±ÿó|‹³% goŸ`²€ç+Uÿc ›1]SÔ¾>ïÉEâ\Hvø!W”Ì/|#8uKæÌº5GævƒÍž%.ã?0Xœ’¦«œËÙŽ Ø0öú+ÿ^y´à9À™B‡>éa–˜©ioÊ8lU?Æ_½‹[΂þÍŸsšXŠ”ÒÄ'BDBQ7>(ƒ‘æ“BàH”ŒÌ`ZÉÄ“Àÿíz9Y?·üµÛ×s®Uð»»Á§¯ÛáqkÐ!™áðL˜«ó$`4)Ûáñr±Óã 8eôS.'•çÂò½ñDÑM<‘Q<¡dÕ!…exäÀ^bªs@©]§·Õuìí2Až´†¸*‘öáQØCÿëÉ¥¹TÆZâÑ»˜mûjY%¾¶uÒ8H‹~aõ+´´‡“å‚“wíÕ^Ѳ=ú™q ý7*÷û[çÛÓ\T¸’Ðûy4÷w“ ›ËÖ "¹ÛÞûþf·bó½ÊQ¿Ë}B(q×AºÌ{2 ý×qX^·V#+vQ`;Çé1¡Þ $S?8Hó XÒDæz(T a•Ö£ ðî¶K(¡'K>°nÉ™s ªÉç‰Ò¾ŠM>±ÈÏ)¨îÐÂç›dЛ‚9ph$"®}) J‰“a”¼ûÛ˲-ýþž„Gí|Æj-gxQŒ&ÍÔ 4¾sŒrr}ûãNâÒä^ƒµQI)7å¶jî¤(® 4>ßHè&Ö{ éÜm ‚byy[Þ\ïF@'a˜ÇHçÞ3wÊ‚ŠŒr:RÃGL +zLnãrÀ%^L tw]àÙ&ª ቮ¶ž‰sI^]mÇmÇ¿+») ²¸÷@Ð}Ñ A”àhwl%¬v— £M2‹}¯e¢'ï—Ë„ zäQ·S)C\7gVpĨM7u¨ê­@…ÓÑ4*G!i9v÷]zmsÐM}ß7A –ðÏ¥6’gZ |ö¬„TyYö>¯¶*¦öqEHò¾u© œÐ–-àåM¤‹–Ëju³›8ÍXþéìbH®…~PLaILaÔ2X,–P¸}ó*¶òyÐßš0xE‚‚iO1*‘ÒG icíD)00ßÌ%yqq†Ï(ÞmPcÝ¡ ˆ p‡ó­p¦rÁDAö+ÖÕ>´'þÑùy!ÚTCýlå_ræàÉøI>ÓõºÝìn–f&e‚åî“b8"çÃi½nÖ-¦¥S¡™ÍRPª ÍmPÆýà ,2€ÚZõ‹vˆDq›ƒ†Ù«r9)ëÔƒ¦ "5O5Ô+Û Ì%Y(ê×ýîð;-Ì'µº¦&hõý¢hSûñ 23òç!EF-=&õ™O—'*§³‰Ÿ¯µ\œ»Ã3ÒÕu$ud®àˆEeàŸ³”à‰A‘Jr8W~l`•1ŸÚ÷¦•V]ÛÔ  ö/ Èʺ¾+P¿HÞÛM·žbK¡ÙYhVL)¦<|=Ù® ŽuXÁ`û^Aµ²u÷ËTy4›‚âH}k›Õzls®zWõ–`çµ”kT€m,öÒÄ‘g|p¬ß«9`‘GX¤€B®Ø»½uÛ–.X+Œí?b%LâGò …:³‘^$Á¯OÂUÙ&àöý¯³çQŸãð^%Ô–Y]Ýù g¡C1h~·öï«al0eVØ(WÂñUѲxÏÊÇÒøv9Û“;f³3 ½¿PêD-z\ޝÃ*y™|Šƒ„½Ã¸%²Á&ÎU}¥¨Ý®ø `õn?D$[¼™Û¼kgAáp±O…×Û×ÜÃN…ãúX…ã…;{x…Ø_€.Ùã‘ópZHŸ;vC´9= N(7¡È¾šk¢ü8M˜îÖý~Qc2-^2Ýé…X2“l$ Oª7RñCØ}(Þ0ˆBà…©;ƪbGÂì„J‰¥ ˆ*ƒ÷Q«—§ÇöCr\Í­E¡¶•k2›¹g õ›{ªš±AP¾]{ôaÛAÛXI2ŸhíRçò‡fÕ,ï7 Øilà$ø¥—\àêq9†1#a3’.öBÂØ,v\µÛã‚M 1T÷΀„ÐTø<Öï«aX m¹-Û|©ºäÏ&ˆNlS1Û'Û·ÉyÆTW» &ax˜®GÉg±s7Ý¿¸:ðkÿXø*ž»w¤T N%RÙW«UÝ"¾‰ïZ¦±ï–i¸ò ïÿeõ`»RC·ŽÍŽÆ)ùWÕ­#¾+ë´èè³B; ÀnDÞXyYÝÄ&î Í ¯â²ø2áµÄLÁj¾¸n¿!.ú[{-ÉY²ã*,7Ÿº"¥ÀœAÜ,ÔìÛ&]¿›‡ëP±üœè.”%ìÇòâñ> stream xœWiTS×¾¯Š¨\Sr—¯UÛjµ>­µ}úœŠ8×­J‘A@0ŒP"I.ÙÉÍ@ˆ 2@œ°ÕÖ¶–ÖúZ;YŸVZÛµ|­ÏÖîÐãNªýÑ®fÝ••aŸ{öù¾ý}{_ ÀH$’°E‹—§§Æ¦­PŦeOÿÜò„$µ*6Ëÿ—HÜ/êÞH)BpPëИP|rðõ݃ÿK‘6;}NÖæyÙêØ…ñ‹7$,MÚ˜¼r“j,Ã,eF0¯0#™ÌJfÉŒfV1³™±Ì\fó2ÎŒg"˜ùÌf³ˆYÌ `xš Ę%S$®€uk‚ ÒH#¤²Õ}†õÙÅ.`¿ëÓ·³ß7ý7÷¿œ2`È€Uª±9äcD¼>©Wë Åçéƹ}MÙ¼«! ¬{ù&\QqÕîÍjå5Ui»—ÁlˆŒÙ°¸ú'wžŒÐT‚£X·–_OÜÛ£µ¼A…2›7´Pz„ß‹‹¤\ãÕ_œ>§|,‘ºåHâ^´A¥ ÑRšÇ™Hšv{°ÝŠ­7pè Õá7¸€Þ¸P^ñUøE")ÿÁõù¹³\ãWÓ¿$)ïÈ *éÙ§Z}ÒÄ;{ú$£v°›ý¿û†Ê¸läá§žÊïØpü§\»pÑd,yJvMöfÑq x$ãÞ¸îu«X¹,×Ì?u$,‹“ÃÞ|ëøŠŒ úêÇi#ØŸ ­õ÷H|VL‘»qÈÔÛdÁ@úI¬&òkc°/àÀ~ÿr#ÇN-•ë“t‘iëS£×¦­ˆwo9ºõðŽ·í­ŽvçëÞÃûŽžtwÀahW»b\1EËô ,EäÂFíí}Î+Aé­ÀÞ•X ·ì0; )¨&½P´‰Œ ÁS‰–YÑr;ObFµ¼ (ÇÉÓlI¨¨4‹nqXYª,-ðF0B‘fÑ,…ª5öä K¼B&&“˜dJ2—N Á¿¸¥IHŒÞ_Ë£ù*t÷\ ãžðÍô –Ûš2ch5DE¨c\ à"È“¿))çŒÞN9VÒ‚è#vÀ1hx›Wš#ãÆÎ(³·Öá8Eå÷gz>XÀbLj!Ó˜^ïj¨/·7ù30e2ZÅå{Ò%Á׎q<Ð7‡È§²ö•g4%”Æ•F–-عãMû¾æW h‚QÅêÊvšm.qXÕM±Êì?»J _c4ju!¥!ò„ÀÚˆ¢úåé5ê†Ìzýùñómš9Û_ŸìdÈ8c¼bÚi²A!˜Š…­j¢Py¦â2°Ù\ã²Ð¼Ý®¶Ø#&7`8ó~ù?h΃ŽQê°Àë{гô–Oq+ñÖ´ž0îVo%äv/(Ä˰Qäõ*i“ìk°h‹‹*¶ 2D— €Dî»ÏitóY`9ögød‚‘<ó[V¥ÜÈ* %VyW–k_4+³)úõQÀZËÈóÉ$–^È“‰¸Ü›àJÝá·œêæø2úu®,¥–]8[áh·ÚÞ?àÅ×m-¾”‹Û½¸(7ÿ~¾¬¶«v[m7 oã ¹óŒ4KÆuêVjf%&$•ßXªŽ¡W#d”`2BFÒ˜ü©ëžeÔŠ+²×Hcø¦ø Ðq¡ìÒ«£zÇ‹-¢Ñ=¦L¢oa\qo 5éfÙŒ»5Âr)×|{ì­Ö²OßCoŸ$Ì‚à`&$‹Ô>ˆ)T.Y;þ‰`–ûˆšÅ=¯àý^Ñ*~ ûß¡…:—âÁö‡q—»dëÉ®ß fïy¨Ö£õ÷â!¯ê`(q×@_†b‡óÿ¢”k#£Š#„ç¿ðʼÙÀOë±Ò.JËi¼ò è30 ùÏóYäÙÂéùãq,ð§áDCû;ù~ëñäy±òëãžP.Ãgè‘;OS u+Š–eêi‰§€õˆÙÖŒQ ÇA{{Z[J{Tå:˜ 3¢´ó ©UyuÐîݶ:K94¿fnÞ×YÖ' sCþó¬>qµð²0/•Ÿ–œ¼ºx=Ëi§|›õ®²NuÔc¹™ñÂîØcJ7¼[Qq‰%;åœvlþôähåZظ¯ô¤óÓ—qšÝ_ý}ÏRÏè•<à5“²úio6E$r­Ù‡y2¿Åœå,}§ó’™zB†° 2€O‚åâ§©ÃdÉ.Ñ•lÓéŠÉÿH—â^øS¬6þ9VqŽ•€C‰Ûªs–hxCêÈõ·£VñCºÆ¯ƒ™~4_o« ýð2κ=ŒóùæaêÃE €£ ¡I„UðÒ¡:œÔ€“{ž'¼cj¤éÌ´©%…†Ì]¹ P5U¶½,w䃲ðöJà L”C†|9 YÀÇ¡ ƒ-;ü:½÷ ”àó >×¥ŠK¿>* ª Å=DØ=w57]– `*ÚJºïœUA¾3ÙÔ¦?Ú!§Ü†ŒíQ#ï6Þ~"²–‘PzÌVÏ÷øZ¥fûO€X(êv_ÖR{þÔ;@a–¹sá`÷‹@;ðíð>´>ª€Ó^|É~PÈÂ/p9ŒÛ õíy¨†›¾¥\¥–<ýPID•ÝšPI“íG-yt‘çîÒ(”Á9èlÙÛ¤¯àf2”Ë…­¦’Â<–ë`Ö%¬UÇ(£aS]ÞþÜŽ3Žö¶ò³­G꽇š_‡}Б_]š%ÂÖ‡T¦ºq6mÛÊîÀû,n·ü,ê…í«FN€"X÷nkS/ë¦ÆƒM2ˆ º«¾O¸ág‹"I|6y¼çYjöç0Pt±ë‘—“"jz£¯Õ¶À-Ðeñ†ûBP×õN©•ôºðº¼cÈ |‘PsŸ$‚¼Lâ6RoBÆc8àÀpœØ‚ÑìÓòõ¤šŒ™üW -:øÚa¬8„å8áƒËð bn qú§WƒËß> stream xœcd`ab`ddòñ ÊÏMÌ34Ð JM/ÍI,‰JtwÿXùƒ›µ›‡¹›‡eýw&¡Ó‚'ø 0€cC ##‹æ÷5|ÿ™93<ú¾…ñ{ç÷-Ì?V~¯½åuÆÆÆËËÆæŒ×­[gÎÜ’ã+]øÃyÎ÷¼i²­âºÀ-ÇÅ’Ïù°§·§··gRooß Ÿs5Žendstream endobj 450 0 obj << /Filter /FlateDecode /Length 215 >> stream xœ]An! E÷œ‚ ¸Ó™VмI6Y4ªÚ^€±ƒÈd‘Û›¦ªºxHÛ’¿‡ýñpÌiÓÃ{]ý'm:¦*]×[õ¤:§¬,èüöcòú‹+jØ¿¹òu/¤[Åî'w¡áãy´òeû_]‹óT]>“Úƒ»QQÿJ¯}`‰: ØÔbÇ,3+`ÇV;¢0¬…¦KÓ§ÖȘ—¦Ó„‚13W§…¦Õ¡ÐÔËžxeÿȪý­VÊ›\H.ÀÁS¦ß#–µð”n¨o}mƒendstream endobj 451 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 911 >> stream xœ¥R_h[U>7©ÉmêVŒ$Ú݈a¨ÛØ ŒùPµÛƒ7m6VgÚN“tÍM›Ö5í½7îM¹7ïMS·Ö.[‡«cÙ† ¬¾ Å {QðeÛÓ879A=Y-‚¯r8çåûýø¾ï|ƒ:,ˆa÷ÁC‡##¯Nß ðÏ<½óÿðx`0ÜÆ¢5ûÒà´‚³c­y¦»¶a˃w¶"+ðÛzüЊü<ï ‡ýƒ88~b!ÔI†ÞÞõÐv„jh…‘EÇ™Q˜4rPu :ƒÖ™×™¸Åc‘,w¬£øã®¿¬_¢†£æ‚bZ 2€}nLÃPU(z ©$ÄeY’8â£ç(ö FZƒG%!ž•K’P`€ ˆ¢’„¤GÐ%½¨ª†Áa_ûŸ.æ•VÖHÃK¨É QÅù¿»"ÇIxFYBMöÁ8žšŠðÏË©9Y†$+è ßýýÆ-•ÃÔämøàÂj¥²²òU–-2:õ`Y¸ˆNÔiLí¤~¹j5ŽndEvÛÈc@ìÌâGXóÀý°Ú€·uÀVÆ=Øq÷‹÷ü }6²‡/Þ»™r» d{» ?º œÐfó­eœq›ç°ªg‹Y˜¿ß@% Ik}NÄ”$ÃŒfõTI6×É‚ÛHªÖ(Ñv‘7:(ç4תÛbÑÿ6ª9Ýènn9žs­*¾ê–Õx6¬$$f„¼2Ÿðši²Ú¢w&‘T@ðÐýg®áÏæ 9 ¾ùðÿØîõz®Ñ½zeÙVwÔ·pëá§œËZ¾¤©z&¯©çN„þ7šþ¶endstream endobj 452 0 obj << /Filter /FlateDecode /Length 183 >> stream xœ]=à …wNÁ òÓTJ¥ˆ%]2´ªÚ^€1!Co_p’ž¥û™ç¢®ƒ5‘àà…‘kcUÀÅ­8˪š+q'ª0KÏŠþ&ýûã‘§ÔßåŒÅóÜ\è©ÚLà.^i'd]YŠNkÁЪ¿V³F½OžZAÒ­®DB)H OAÖQ6´üX“ÿɉ€ÖÐF:‹bç´Æâïrï|vñ$öÇ_?endstream endobj 453 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 848 >> stream xœemLSWÇÏ)í½¬lèÁ\Z÷â[–ÅIâ˜Uœ«™›ñ…©è\6Úµ¡`[.ÐÒ‰ íyN[ es#e)¡$&3ÎñaKØL4ñ“K&‰™ÎÅÄ`â²Äh–‘[N » c#ûö¼ÿÿ#½aŒWïۿ߮ԾåW\Mu'7¿úÊ!WM³Ûî›ï–‚<í• õã0æQq¦|«,b;ŸaåÏ"ã"óËe{ªšš슶î¬kò¸íÅ\qù‡Ïþ±Ëí:¡Øêjj—±æø·ÝPç\ŒBH<öî†Öí¯#Ü‹C8Œ LqI9Ò#‚>oé^ÐEu7ÙW…s†Q/’gBS²þ ¬QÏþhò Ο›‹ -=½¼ ¤ìcAíWˆG¢ÐW}g³'2EÅêw[ N%ÂWº¦Úî¼?üé£ ViTàËك̂„„ºIüС¦sµÅÙ/²vž†n€’Ž$Ͳ~X(œÓ[bhö“«3¥ãx&˜ëÒ|;ß9ðZc°gw_¯Tì±úæ@B#ˆ•@ŒÐîÿE=T¬®˜¬íì$¯Ôt·°vCnRðⶨ8K8Ëîíê$aè}¢–™ÔÄòÖÆ<ÝÓ"/û¶³¿æe6ÊÓ!$ íTñUw<ÌÖ›†œ“2q˜î VÁm÷ºÆL,ÿ3VIû‹3{D¸ Éø¥ä¯ØÊŸã}”BRJÚCÐcæ _ÙÎ@­”û@„]`}oÓñ­GÕ§Îm $Þsïðƒ²/6CNK¹„ÖøvvdíH{†@JQš²hÄþûH}ŽóTÊ/šØ°˜&ÔcÞ;ïÓkáâ—’1óuaŒÒôÓéY] ^ØÈ8rsO¬EÝ#».ø›óVëm˜’TÛ’#Y›|Ãm~ÕsQF)Y*,gòMªUûÆòc¬š+Lf-¬ô{æV iõ%Ƕ‰PàN¾¯é˜w˜wûé™të£ë¾Ùöe”IÚÐÿ±Ië?Ô>Ó¡>sPàõ\ÚÁ_/iÿ]Ñ,ÀÝ;Ìv³çÞ_Ø9¨¾Ô§Z£T/¸±Ì\ ¯:iÌO Eh?E>ÿÚhDèo“"´Åendstream endobj 454 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 6454 >> stream xœYXTG×¾+p÷ŠÆÂÍ•ͽ‰FMl±ÇØDQ4"JDÒ{YÚÒûÐAzoKQ‚;±aY¢_\k4ÆŨ1јÏüç&Ã÷?ÿì.e󥵆Z@ÙQ ){ê]j-µˆâ¨q”)%£Ì(ÊœO½FñC §Œ©7¨¥ÔHêj95ŠMYPc(Kj,eB±Ô«”+eO\DR1”( —6mX‹ÄÀßà…¡‹á#£GôJú²ô}iºôg&c8;¼Îx™q½ñËå#~ÙöʨW2FQ£vŒ:;úíÑécÆN[nbm¢d׳—_úêΜsánŒ‹6nZ&-Ë‘=6s3;`>ÝÜͼÝüÅø™ãCÆwMX>!zÂù ÿûÚ’×¶¿ÿZÓk·y–wá3…Ó¯›Ã¾Qb-Rý[%¾!—4Áº§°Î@LnáPIÊÞØÜäìPð+bµ,á€"Óù¡(”à†_é«‘)PJNKNŽG1Œo#ªà_Еõ¨¥UŽÜ…ºÁBºn’‘»ùøÖ£Já]шZ¼ >â°Œþ|n¤ÝzTŽ*“Õà¨6eŠ…-\kŠâ]!šþù£ÃKW»x†‡ó¬º •íâ­è¨ ²\#*ŽâסÌ£KÉêšO ®°’f›ŸßYžf ¿m±rÑ쟬‚Û*É954¨ Dwðá`ì¬gØÎz Åì3` ûá)˜ðÖùÜ,{ KKû[¿¿|ùÚõK¶³y²@œJ,PIªáY –rû‚Q\BòKç“Þ^¼1³ü Óàíû¿ö^<»mq©™Õ‚˜vTS-€ -G ¾)ñI)|z*J òRn«þ1˜#V˜c[¼È+Œæ»Þ‡‹q ÞQÁ]¼Ž¨áuâ4™­±}ôÜŸÞØâáãɳϚÓKÝþª>å߆j'ݹãpBb@òãÀ Ö㦯´]¹ÌãÁ þ†”5¹pþôg7Ï[Íçµ*É=5T’óFÀæ/€iØŒÇ;V/jû¡C#²<˜>€×aY_G“hNOi0êÆf˜Ñ;ÖM­/ëÈÚû±#×L0è,ž¡«P­§Štãšw6:ïNžY<æÉ4våXG]€½¥ÑAõ°„.kÐÀ|®8Žsp~ï=KÛ«]Uß½ut¹îªW-âMÕGÕ[‰3:¹^©n«09o«!L¥;QTû~T[Å?ǦàJ³¾‰G¡û5±$žjMÞëÉ÷ §£50Õœ¼¥Oá;äQ Ùaûò Û½”ƒ™j0P£oMÙÙb”8‚«Ž=´è£5vŽü~){[»"Fžì+ܳxh¥t™&Š(ZÀ¼¿ùäÂSx…Ï ®7 ¦¶º¼©3/Íä…&ãˆ1b27`ðØ!÷õ)¼ô7KëFM'ð‚ ô_úby”­çˆÁ´º®‚J•è c9ôoÌÕxç®*–ùå¬*FŸ0m­?|]ê˜ÍgFfE¶öçƒZ›Á©Š¤t޵ƅ“P/ yÏý—‘BWâÝ´‰Ù³ÇköÖ Ew‚ø”ÊÔ¢@ÄhÂ%L“F¡ –ÂòÌŽb¾Ëýtº’ ynÛ×'m’Â<QI¨¡‘œ> ’¸â4ræ!::oÝ„˜ÅïSaæÝ_î´‚© !+2/¶ñ9–çÍ{´ì*ÛAŒù&m°Ý¿±Œ8w¨¥®ZEr¯`©´¾µö—›+*‰&æs‰Á„«D5^a‘|†½C|b–£S $À"é ëñ¢{ô *ß›¯«£ $>p=ýŠû›_îåõŠ©ä¾<Èú-º  C‘Ô?svÁàòǧQÁýë7ô)‚†F0bhV)£8,HŠº§ºC:jÀm0ËZm ³LÙh±°Uãqï÷h-ìþÀ"ž4Û5gq¬÷R´¯‡:éŸgÒÓÕÁ7:;÷*;xv«wf ªƒ.oÐùUW• œÚZZJT¥—†ò¨>¦ôÆ´ó4+U„‰Æ*I=l¾› Ä4ñM ñð¡£*i,Á·°n)õ7|ÈU-4HñãbÏjTƒÌªP*ÚRx"kôQêpR%)‡-O`‹˜+NæZ‚Q¥tD0Ù¦U ]ôf|Ò(ƒNmŒ9ÛñYZ‘Š'š–´ ó©r&ƒv‚“F]:¾AáÂÀÇkÈ&qoNHvôAdveVªd–f×2™t®Sž“XY‰ŠQÊ.Ï©½½²–šˆ’è]S™|ª†(RÃÅr¹ ½#>7;‘éµßà7·OFV¾5QõeÊÂŽLdfVg•f– BÄ|qÊg…€W¦áÑ›Ñt†³þÌöEGO~ëqžµð©=‘q`¼²–l…—ýÂí¶;‚aK"Ý]Pâxûû?éú®&ç Å´·6Â1‘„•°*Ÿž“š—‘…çÃÌG£‰Ù-H!ÌÓ„S§/°;®2‚ªZiÙÅMÕÅZ#´Ü48zNÎ 3ú1 ‡×q¶Ñ Ð¸5 mÁ6igìΧɋ8›²·Å¤~¼í¢ñ«°hxËè ]Ú4€º~ÜÔ¢&ÁrÊû?5’³kÜ©}2`ðAŒñ[x ^`´‹f߇á:|…!á;Ý‹Gù‡¤ãpí.ýUå¦ ŒTÂfy$þK €íŸó©/–£0RŸªøàþ?3?HÔ¬ÙCÕߤ*ÉÃW&‹Šnéб%CGŸbÏÐHIP W­W•¸EeÒ›ñê{` ›MYó¿K»°gÌžäˆ$³ :¥*¡&©j$Éþ:[i˜ˆˉGi™!ônLÃ&ù9º§Gg0(·°D`-"*ƒxöp@dDàŽý»ºžYQŽïˆ[ŒZôÊ™†Ën¨!¸×@ÜN釒£âÓåI|rLøVKÄ,üàê÷'”$ÃÇ×|‚„L*E=bêk*šoLB.Øbž0|2L@ØÿSE?šÞSA¹Êä\÷öî»Ý0¼˜²ubASòæE…´M“ì Xø „yS «±‹,Ö=Á/Ù$üñyPœž_„ˆÙ õ”À6“ìoãûRo jØ\3ø{ºÓ°ŸëÌ”m»„sb BJÜr“ò‹“ŠQ *-((ÍÎûòŠO3™}´f ­3Ùø{ƒþÐ&‚¤K þÜù!Éä†k¥pºjª3³Q…ÙþPÎãÇ´Wb¢—°M:(!KŠ/ã®0yFŠ4ó¬EU¼8š®ÍCÕ¨Œ¨AW4Ö'‘˜!óþ‚DæÒ^Í;Ë·6–L'êP`³ñ˜‡Ó~í>ÔÔ¬äÙµîHqï§ < ÞåØö .‹–¯Xw­÷éÕËW/ump‚ùãnë&BA¼­âú¬èŸAc;1-v_tv2[¥G§ÂýªÇ—¢& v}i%åȬ¥8û€ æ5H‡@†.~q^U™°âî~E$¦…'ñ¡mLðGÈâÓ¨ï8I×T¡ ×ü„ÇáÓ§âÑÛGý<8ØÀ¯€‰®¢Ko\8{‘î)¨ðMf°OéVC‰šœçàP˜Ûcû°|ª {°«m‚C¼u!‡ìÑŠ¸qÃæ¢y(¨&öÓØ“è>:‹zЕ¢c%Z‹ï¡[¨=¡Ì±x+±l-3 K*„úÇû¢x†»¸E-Y¾m>¿iêjù÷LÑ£Þú!Šž=0J/›G§ï|ŽZøÔÂÝíÕuåÊ~c§‚4m­K'G -¸Ç–±”Ç!'¼ÚÃìˆNæÆÃǤÔmÚn=Ò~¥Ÿ¶Þ¤-JÁòÜÙ‹ðþEß‹&ÍçÃÕjX­<Ÿª^Þ”C‰y¢Œ« oÝçœá¹g©¢(ªmãg®°X¸½Â«,\`%T\TB¨¯9ò( *Œ%UgŒ¥ Zg¾àåZx^}Ùó-ÏZ¾Ž:">ý¨)&GíĬ¤Q JÌŠFÉ(¶”a'ÆÅ•fÔ"s”“Uš³7;ý@HbݸÞ+°s-PKBs¤²¦¸>§$3/ .i/b*ꊛ¼p®®Nw?ͳ—sÏ9rêÌ¡­›x 0æ\-¶OjqøHea[[5ßP^ˆn ¦ŒÐA Rõÿ…HIÊ,âUxxAl*Gf…tYªÊ“W+$–DìO*9RYÙ^øUÞô9:ÆXgr»É¡Ñ[îËÊ22刉£(<%3-;E86×È›žƒäÊø3 'Ñtu£Û{O”œ­­~„z‘2²È¶ð#´ mìØ•–s$þõ¬ý ²SüÃ%ÅÿçŠBÛ<™Um£Þ¡®&ªè±ê1×F:}"Ù}3øÄô=‘þèØéÏPABÛR£(bØ—ÿê¨Ruš÷þ=lÌã•ÿ?]íu‡hýÔæÏ°¿×†¡ÐæÈùVyWø*£ö#æ³ú m-üÂ9»¬ŸÍ^×i¶÷Ñ‘· –æ›ÏMÀó¹±’0k¿8™8 ºñD½Ô3Â=ø½49¡;ìlfóu°Ò#¶L™üµ|¾¹Óö—ú;ç4íâw4¥ʨ̨Ȩôîïø°LÛòÕæ•¶ò}UQ—ˆˆa®?èí¤’h¼q¢dÏWx‰†®œh­¡‹Á’ãúfÒ(¹z¸ùUê‡b³¢³‰e¡|FRédz ïÿ„:aòÇ0òϾš)>ýK'éäsõ#òm ¦èuÚãuTh5D…§Á¬Oá¤wsa©×r“FöǾZWdG"»¶lèÞ múcìCã·aŒ©Q»^Û3KO‰Ñx!ža/uæØQUWŸÂY¯—Óëû¿¢ïÞ„øÝ¢Ö[ƃ¢˜à”â[jˆ#'­ïôwÕœ^%ÆOè×mœœ6Ùžúž´h4yk‹Ö²?ÌzFãÑ÷ßyþüþ#Íóé_´vîýý,7ÀÿAÔ&ö8ÒÔqzã!É’xW R™T‚žv_‚F·gX;YgF j–ã 1›ÂßOÚ®˜í© ÓD3»½½¦ßföÃÉ4û¸þÇÈ}{ÝÊQ32kBU¨°db¥ìãšËuW<§»a„æÇ”íK´ú·"žžë»3f·?½ß¿Ò y#_Ep(Ã~Õ’.Gã½éÁ}pÔ=¬¿2=ÐÅ–,"À*)ÛÕÛy¼³®4Ò–Ç iø@ùºõ‡Iÿ0EëoD?•IÌO€ù­0ß”},îÕès–êU-Ú—¸6É)߸'ùÒVpÎÈK¨ A ¤-•£xÒ–nÅ[Sì‰2E¹UIgœÄ×õÅùR]¿£D…B&}½¯Úˆ½í‘[ŠÇÙ··:;ÿ Ää$ jŽË‘™žÔˆòI‹ZrÛ¯‹Õ²¢¦ÁzL©Ä×ä¸ÙÝC4Z"lÑÁb¼¤÷%xòþt0JɈ‘ãpü»,!¥#9ãU˜ÔÊC.¦ìõ*ïê!ëìºÓihÕÊá ‚à…‘îî¨U T’jÈ ôîçå?acפÐ<8@’ÞUM-í•”à-à*i i«ÌÉÝ[À7µuVžG̽£V¶KV¬{×MÁY!7· U3Í!åaѾ »}³ a쳇` «³0¬ {H“`rúÚŠ/!õK'RÀŽ‹Þ°‘z^/æä¹Ó…/…7žÜ{€ö£ò¸Üò•Œ"˜àJycCuEK—û™iØœ|¿‚]p<Z=ãÙ‡ ùéI¤Ï‡lww©ä||}V=*ez.~úÅW§W[jöß&žWIލÏiV¿Æ_ÓÉå(1ž(4\ØÑ_Ū”YöÖt’+î™aå9¹¹y¨‚©¨ ’GúzW® ºPFJ÷Xpæ—Ýæ7:,Z¼éó›÷¯u_?¬ ‘—ó,Ó¶»0|…¹ÿd– Œ•ÀVkwDC®Ã·ÑÛ-ÈÇgOK`Û†ÖV_0üÓ{ä“¢Ç÷ªŠ)ˆËÇÁFäWQ~Iª2« /ŽJHËHPðøÞ•“ˆÂÍ™¹7 ¾Ãn²Ò„ìŒBÄ”W×iétõÞU‰)špí{H?Fª·bòðØ‡Šø.ÞGj)žaØî…byü;ëEžuhJò3º´ƒ<ÓØRð\ûTð„ðãí=;½"ƒªCZòó3Ÿƒ’ÃÓ>XºMHL‰OAQLD…¢´þW5˜hΖ–69T–”QŒÇ|³ Ì¢ç@óïË‹òsHYR臷c.Ä#ŽÍißÌŸ¶ºµ4æ¹ÕÚS|¬6€—pC0bÛCO7ݰèFLP²<1º()7M€EXR†6uðøÙÑñ‰)(šIÌ“74Ãv±BÝe÷I´_’#ÝßwÃJR“BîrJ™†âãyo·8O¢p¨i@ÁDxûç¿(Ư­Ò²4eŸYb»áWßìzz,/#ˆÂ+ð<›E¿ Fa3xýá7çš… Ê-vqؾuÇÅ;ß;{èè‘õ‹5,Rý6‰pdq‹|S²ÎømÌÐk¦lt•é?k¤>yñûy°dG¨¿*ùU1’ø¢ÝC³‰0‰.FíȃŒ&á‰ÒXò§G»&¾ñ$:y´·£öb&ÁDiq».¦H‡Ê)ð¬SíþÄuWˆ¯·[sо¼ü̬|>Ú~kTlj|ZD ©ÇÑe‘m/ÎÀ0=û$gwp¿­éWh6z’dÆ&ázc›Ák$ù¤]0ý=dê5ú¿LÓ$LÏŸóE£—hVÁ²\EÜóÛT®2ºBš“L ⬓¢2J4‹(‹¬®Í/+Éãáë߬óË3*0Ó|‚!0_C`þão¯q•‘¥Šà7¬±ÉòŽ=û*ë›äu¾IIˆOE…yUÙ׿<&äîÍEåCû§jø„„ÕOÓŽ­ ¦x6œªýÇàÚØ†ás0[ÞºˆÃoÙbãeËlÁÞ‚)êg7o\}OíW¤£T0ŠPf Ykm¿Œš-VО›Â»-tŠ OÊKGþLPeJYUgÞ#|ßâÙÒ!ÂÌÑ»"ÊÏäT/©ái¢O'רîÏãšsáäÓ[‡2ìãϺ]ºk#§Ü£°ñÒ÷îQÆUÔÔU(‹SJòù²cÇ[Ï‚¼½mÞJçõ6ŽÄk“SÂLs ˳¹ðˆf™ˆkHä8é]×[Ò Æê]Ä?\ÛzÁ¦¥ûcå9t†¹iõ9–â‘+·X{5(ª5–&ïMËæ[[¯inª¯|êîâí*x¥»§;¤F#äÇhÆ£Ù½ÏN®^¿vƒÝì]Ë‹ŽÆÎÏ#Œ]^í=÷Çõ¤`›~ûè±¶´ÚÂ}®<º<*.9%9‰÷õŒRY”XSS"¯ñDÈ?*$RíJ:ª,ª¼(/7/ŸoQ6–—¢½¤o,‰-‰©Ûš²¼®¢º¬¹U2£âŠÄŠ`YQN­2Và ýG?Pž—©ùÊ­ÎÉ9’¢þ§TÑ3endstream endobj 455 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 426 >> stream xœŸ`þLMMathItalic6-Regular‹û`ødù,‹ ‹ ¯ø ÓÎÊijJK '÷¬ÿ½™«ø«÷)vêw÷ئ×÷ðù£y›tpnqnr|¡«¤©¤¯üt‹Š™y}Іx…{XbOX‹y‚—£Ÿ‘š˜ªÇ÷*•”£”Ž”•‹œÃYªY%Zûu†‚™™Ž‘”ާìÀ¢§‹Ÿ’~tw…|‰„Wûn‹‰~i~m†~‹zX¹gÂð½÷¡ÿÿ’û`«øÙ«÷)vêw—ìødù©s•{krlsv›x¤¥©¤©bûÌ•Ž”‹™ÃY³KûEûx…ƒ™™Œ™’¨Ìÿ‹©’rr~‰}Šˆ-ü x@PXQ‹ˆoŒŽš—’›‹š«q’}pmufVÊ´Î÷ ±÷ ©v øC•––÷p « °  To ©ŒŒŽšœ•Œ“ S¸®endstream endobj 456 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 2150 >> stream xœmV{P÷ßãØu}²žÜ“(ÆÑ¦’hÕÑj“ à¨(FÊS^"ò’7ÈÁÝÁÁ÷¸ã¸;ÞoAPà8Äx‚cSË£Õ*NÆÇÄV5š¶FÓù®ócšî¢mœN÷¯Ùïîïûy|?ß•PÎN”D"Y°#àóäĈ¤Í1‰q«VúìŠLˆKɈŸx }Uø*€†9R˜ãÜ·pfŠ;ºÌ»ïzÅ/÷¤äÔ´ôŒÌˆ¨è˜Àظ={ÖPÔ.*ÚCí¥öQ_Pû©Ï¨ÍÔÊZEm¥¶Qk¨µT%£8á`ʙʧH:9;%;Ý•n’^sÞâ(tÚ›×#2pãŒhæ=¸AP$L¯ŏb8ÚbU~ÜΙQ@œ¡ç™GYÔ3í`Ò:ëåâLò¡˜>Þ«§A.}°==aâC ûzÊÈ.Æ|± g<„§F–$ È»÷‰ébÄa‡¢7žFé«|¬%[_K£¡¿c–O=¢}„(±é¿;(ìð-ô A)÷a΢‰F9#L$Ò“Í8›%> ò×*È\`W3#8L?dp.(wæ¯a…Ô$¡6\ñ ž¥Úpý³X[ì û_QŠï ô#ä<„èç/n7´Y#Ékű\ÕdHö¾¸yˉԇj¢ÚÓc¢ŠkóʔꃽñÇ5é…Ÿ«‚z>Æ-€«àÎxÕõü€xaÝͤ”g´û mUÕ,ç¦TW÷äŒz¡ LÞ¨¾m¾˜iUUÕ˜ª µ†2­¶¸´åŸ¤–Ôætxu@s“hÚÃ+dª…;ýÀ,¦–»¬¼h¶Œ_÷º…EÙž©¹2MtÄ%° Ï›Î[ÆÎA°ß1õÉm°W…‰âʦÃü¹à°»¸ÒýRA¸ÊƒëÂFqS0â—ÑÜ8ñ²aôòÛUOsóñcþ…¬òl’í„@tŒ&JÑ;èﯴ¿1²ÒÁÿkHŸÆp™eLy>«7þrŒyC˱ʣ¦BC|Mz¿yØt¡çòMÀe %‹Kcty!^Ç6{·ë›tBn+Š ¬ìXFÂ1y\Ï¡†Ý@æÁºÕÙĹ0°6¼åhw°Uu/£µ¸¿°¢ô|†é &²((Ál2£«^Øv床Œ7)žH¶½Iq3èt§Z{:å#á×Õ€ à/Ïšq–ØùPŠÀ Çá.xÐÐ; ½=¸'¯y?Y3jè©[LÑЦZîá|`‡™÷§îÐÄS gXÿ.⼇èH!ƒ=në÷üú#Ôª×ééç‰þB\£”È}û뿤^yÑÜõ·§ûé‘×ä¿Þö‚r0K‚בòñâ{›aNè[Ìôí$ÿkC;T&ƒ"W˜Ø‚¼)·©mr!…±˜6ýþôðü@1ЯeÉJA%rˆÁ ¢]”U| ÃZ,UŒczÏ~g–óÞä93{ô]¹AWiÔÕÜ3‡¢þ ñš endstream endobj 457 0 obj << /Filter /FlateDecode /Length 4873 >> stream xœµ\KoäÈ‘¾ëdŸ×„ñ…µPÑÌ'3±ÞÆc¯=ëñ¶µð¡eUšî*±»Èžîö¯ßˆÈL23I–J­Yô¡Yd>#ãñÅ#õîº*Ùu…ÿüÿ÷Ç«êúáêÝ£·×þ¿ûãõ¯o¯~ùSÛÒV–]ß~庰kfTi¤½®U]Z¡®oW¯Š?¶÷Ž¿µ,^oª²R¢f•-šýf‹¿ 3Ú‡ÍVQV•(~ßÄÍzle¡·âЈA +x‘ô=Ý`gYV¬øÃ{ꪬ4ð~À÷z¿ïNÑ í››ðI_ÅÓÚ~h›G·«lñë÷ÑW·i ì„›²’LC³ùûíÿMtÓD]2…”¹Ý]Ünnÿ m”¼f ÆUÛl¥d×[DÓ›½*TY—›­ª`ÊŠ¿i{š¨ÂyAÏÒVŒ±¢=¶‡æÔ3#ŠO°âZ••ÐÅÛC7,.‰W¥¬´¸¾ýæêöß__ö}Bƾo¤á@²‡ÍV¢w1¼ŽÞïñ=®ÄïÞGï›,Écj‹ËÁF(Õ})°²¶À ²è¾‹;4~nwrɺv¾¿¬þ1ËÄ'Ó)KøEVªè»¤áÐv~@ࣄ!û°c]|·Ùr çddº–äGGª¢ñ]‡©qˆºÊ§´nNÀJY …ÂÑD/uoc.½÷£ªºgø0]í‡x?nB͵æ5²¥Ráða8b`˜ÿzªø´ÕZj»ƒÃvÑžd¢(ÔtžîY„uXVÎÃ};¹> ¡ÈH{c€¥›Ã™¤F&ûä$Ýp©yÑö EÐèâ6Þˆ„›ØÄ=£à‹ŒØoáü€•Ì>$„k›ÃáS¡™ò½4+ºÓfÔ:CãH¡,+ßX¤O86?jU Ø!j¶ 5-¢ñãsŽéR¦0Ïb÷@‡æðÐbˆIvì7áüa©ÞF²{êÜÊPtw³•¹6ÉYコ–YŸ4)ˆÊåìkRßÕ¨×]«HX–½~ôÂÙ~MѼÒN·Ð _+“Ň”0]¢‚2…ï,ö“ËÏà§“ ë‡Óû5q• QºsÒ¥2¨±Ý9ý±NíG[ "Q+ã&Þj¢"¦$&Ré’;|Øù íC&&Azbr%ôÝûTÕÐdZ “éâ‡u!c Ù¼pƒûÍø šª”n›g0~ºç>lº  ô'¿KkÆhû·‰Ü‘>6¶.>M«vºJs°ž`|s-Kï˳9šdq¹Q£EIÏf»$Ÿpê÷±>NÚ N½MË(šÓ°/+Ó÷åCyC“þööêÏWø©ëÓ:àK‘Äø4êu­áØ$×ðýuÆ2#p˜Ð dö É"¡ÓÎmÍr›ŒÔ½c1nšÙZÄëîÂy­KaâuÿíeäàF–J§Ôø&—JÚpÑK·€:Õļ!ù K7ñ»æ°±•qa€ÖÞ¬!,>#œÔ§^8k†V|ÕÅHHšý+B2EçûX$4ò%$TL–µHIx·)‘ˆ>ðÛ–ÄÒr‡Ï¿Žº‚^1’ìUµ òU-4˜…hTpKûLàL  X¬}ôÏJ¥ú³{\ÑáëÈh _]Ö[ÏqŽ”¥çÞfºB„ˆj•ÛÔ’´Él(Ø´UÀzŸ«ùoüÂŒ->ÌApè³÷”F¨+qA?FìfÝ=ç–Ô4Âa®EÍý$|cÎG=ˆX¦çS÷pjŽ~`£ ¾ 3GÆý=„C¸´:_ï×8­&&ã…Ig27¡³î4àå%ÇÉ Ô3ê:J0/!ˆí99®à˜;ŽW&âýdv¼Ìœ~^×äâ9Ƥ5*tøŽaÆ:3›‡ä@Ýê=iÚDNú›ÍÌgšÄ[ž#Þ’D›daÍÍ¡ï|tÞ§óö¾/ £'”žE”Soï¸hæâÝÆ°§9 íî¼9L;ü\i €^Ǥ™g ¯—h—à2³„aË—€ýÔT2ccHâjaÁª˜Qqçùr4S®Ëο<ü»øÌ»˜^`‡˜6¥6u¼f€u/·å q”H†åp(ÑÀÏтŔ&¥îÝÆÓ´H3ɃǼº’\‚ˆ ®²8ºXÒÅZF±¢ß£ƒã¹qA¬œëD€œÑÏ<ŠØ¶øà.OÈ"³;‡LŽÆq|ø,‰rr®à”¬‹è½*¾ŠfýæÿúuôóOß.ÆßÐÎÈÐÿ 3…Äs3UÅ­€ãà<)»£ôý+$õjœ*°d*'f)@Až¢0’Yó_üYî|'ðŒúy„ÔÅz] •î¡ÂôÊGp>øÑy­'üó ”â8`è?‰(´’’r ,®)fë=Öˆ-݈iÄíá°wë®ÔóÂ2ž²M¬uCt*‹c7¾=š´xòÔ‘x†]¬«Rg018q4gh]5ºvö¹Æ`àˆ~<¶“o„P˜NŽy40‰Œ-='{;ƒÐPŸ%A˜$âZŠŸ< ¥ô É?2ÀX±füéÆéø¦+•郄Y1<–«Q«gŽL5£RMà4ƒ-࣡»çŸ›” þ®F¬‚1·Ó9œ:ïC˜¸Î6‹ª¬°QMÈï!Ž®åØ×­$‹g:¡9€h›!@J6Ÿ8¬îÍ8&ªË„.™—ëH´àu`oðŽM.ð(å‰"o2˜†\G" P4ñ’X*¥Î|p,Qd3NÎAM=K'3¤1j÷$l2dy3Eçæ!44w|ÑûÊ”)l—RhÑ•]ér%ÝÔ'gé  ½‰ æI™ß²‹•ûi S¤ÎäÏ.qʃ•¹mV|Å™—’+dÂò¨9‚}­•·¯ J>±d_)´¯½°"É¥xÜŽ™Ø*Y„±ñ¹RÁŠà‘Àã‚è´vswQ¬‰Ø9¾Y8§Ãí·9ùž»DaK0IX¹s Å{a†iš>Ÿ©£ô8¥—çacU" pÓÜ ú…V¯•kÈÕ¤b*ºÎ2®R›*JíóÛ; æïРLwj05íhse÷Ë¿€mŽÝ Ž¡uËÍ~¦W– ´Th#Ù8ß1‘P§-цúÜg–?\B é5¯—Á¿‹ßo%“¥Þø"VÖÞ1¨„’k~ÊFÍÆížÕÃÒY¡ æšÀgMÑÔcò9EUAp•ð4&\kJÈâë!Lµ=ö~\€òÍøE>åyÍâÞäì×€¤“Ì?Eõéô%i³IÇÒxJaþcF´qœ¢nL™êëh¸±TáÃh:2ýI hä¶m8±3~׿QBNºÊ+f¹k‚:—'O{ß 5ŠF¿ù”´úùe*~ViK–j·D¹äŒ†ÃÆ‚ l'¹ûÖs%öW¸@DAu ÞÕ¡!¹ÊB»€NhjýH©s”Ø7¢,ºõ%0,áVîk;èyí¼Ñ£ð-\cMq ||Zø¿G¡án)6<ò3ðj•¥Çgüì,œÍsÔíh`Åÿ‡E‰¼Ï ìùxhnR‡µ|tñs\ţ,™Ù¦’>ª}drÆ:ø ݃™›‰]ä3¥†3Þ5ègÍKf¸14ðÓöžF³&·÷7Á‰´á¥VB7&ϵŸ¶Ï‰'ÐòØpDùõ9ü.ê Ø»íÅgñ°„§ã…DjÔvî A†çyChõ¬ a@›»:°àG0ðI7[rZ2¥y Õ\µ{ÉÊU{žQÈt±[´xVXW€a‚•cHóa}¹YP¶Ô,”ºˆÃ~ A)YïðÑô~ÝyzÐ%Q #Ê¡º­’;¿d”·°cUÏB'îh˜ ܪ€ÊiÊ$p«ÿyžLÎV*ªl€EV_£äµ¥âÑ}kCÚŠRPµ'K)(ìøx&ØØ_='§Ñû‰lîÔyãåÃaN)£µÕç¬.…*pÎX/¿à*ÇYì(GYnÁNÃá,¨KýkªS ²‘ßh^'`854:vÉä!.á $ɩތøž¸‘êgfQeÆ87›¹XקͦÞÒ8±Iz¬]?3vÌUû]ZˆsöhpÀ@d„q9AÔ¦–¹(Gó·ƒÎ\ËX',ŸSx³¬eÀñ(+n.Ö2Lw¬eà@–r^89¹c++ŒæçNPóÐ8›k(Ûé ;fæµÅø¾RcVÁ½†ídÏ,E†)jJ£ÍK³ÜhóHÓØŠ*y׫(òjÏèÎehÿF¤c>M’üèÞ¯tVçë‘EÀ] >Jê-õaº˜(¿Fù .[Dsÿ½1®Âµa¥^ DeÞÈÇ&qÍgeF!sž„5]é)Ÿ±%½Qôìæìo£xǪ{yhãÈP*—!O¯EÆHi•Ò¬X¸àµZòÁU¯_ˆS\±À‚"ÂÖŸ›A®Æd¤˜^¨pÄà}{rB§®w“v÷U¶Ž R 1ôíIÑO)l=ÞFø¯ÍVqEr·ƒÑîŠ/p²/@M-8VQc·$Å%aÝ_mý3~yÕöX#ùî‡ýã]ñxê>ÜÑ·» þ» ‹¿o‚}‹†ÿø0"³4›àfú¶U‹CìÎ ±&ºó“D#÷Ãën7ýþÏ0š(¾Ø¿¿fÝ76³kHXmGÙlO=:% Ê夒„× ôbm Éç¢EѺäj¼ÚrAèOŠ)ëýD¶Áb$Ni#ºŠñXžª[¼GCBsêiܰÊ+h†eÓɤ(yú…CYØ"Øy8ž`bÅP›|0Q:ßèÛ/—b =†I î¢*ÓÖ\ÅÕL¯À8ßµðD­(|“É2_0%’îÓƒÇñ˜§gÆYvåíúcÞÀØtUÓ=ŸTM:—¤¯¸ÈK® FìÊϬ¾×ගڇ6M€áGK.í˜Z¬ö¾ËÎ7Œ#ˆÃCyIÌK+€ëR{Ζ‘ŒJnì êm¸åemE<Þ+Ø]ƒš«tQ*”‘<뜚 $ŠN €Ø±|ƒ…ðž#ýJ WL¦€‰H .OhŒ{Ó¾@å,«õ©Tîej]UKô5— Ž¥x±ZW (% ¨h6/É“’<Ô}€ÂvŸKáô‹r.î²¥/WåqaÖeW±©\¾ﮇ²E„4F²h„…« ”¢Ø„(ÞtðnŠ7‹ÎbYqXe€Û:&á–pדwçy (•Jä Kw_ cÄ_Öχ×~ë*G't&uñ&½lƒ ¶ª]±¢dHæuÎÒ•¾ž/âæ¬.µõ^Urž !ņW«Ü?G Ícœ/Є”ÔOx¤ó)áÿúµÒ ú„{T íҢƷ)ùiX›·®×Â¥†ÊOˆ`!‰¡Ò7X.ÌÓ÷aü1jG­4s¼•Z ùª…ty¾;󅸵¤|™×#.wœ• æ†oüë ÷ ]ý¸ÜOä72ÇÁÛUŒÂs«¶wÆŒB뉧øý†îÇ)£ VùgþLƒ÷ëÆ¥°€bQýàE@åê@Ü=J°I±DlòÇË—¬x½*žt‹²>{Oå¶I7‹#ZŸuÊÂ÷Sø¥ýÙeƒ[G·3Yöm¼ªÉ²è0M"æÆdP7Ìk‰Hꬎ^N`B"ZO…îT]òPå^”#ÞýóÕÿHÎBOendstream endobj 458 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 242 >> stream xœçÿLMSans10-Bold‹‹ù!ùJ‹ ‹ °÷TÇÄÁR3÷¬ÿ¾È v÷ËÓ÷uáæ÷$‹÷$÷÷,ù!©û>÷¶Êšê±‹÷÷Yûm‹^û„ôg€füêg–°»±•˜®÷›÷÷8û³™s–‹¡‹ÆŸœ‹©û+øfP}Uûû÷u÷÷ ]Iu¡ø^œ÷i§ŽŒÓ ÷  To Àž‘‘ŒŒŽŒ‘ŽŒ ¡…_£endstream endobj 459 0 obj << /Filter /FlateDecode /Length 2113 >> stream xœÕXÍ«$W_1Ñ] B¹ÓÕ÷ûã1™Àd2ã„ç£É óôÑÓ]ÓSÏþx©ª7ó".”(âÊ…³SÜŠ w‚. âRAF‚’?Ásï­{«ûÍ$ê&<}ëÔ¹çžó;Ÿ·ÞNqFRlÿšßù:Áé2y;!Žš6?óuzišLnJKÉ 6$ÞKü’j’*¡2ÃD:]'ˆáÑô˜µŠ˜Í4•°aºHî «ùhŒ3,4ÑR£º.6#û( ×-GcÆhf šÞwd¦6(æ©,ËŒ–ö…ß úJ¹¸¢SÊÑצ¯'¯M“` Ó%,ã&¥„ÈL·?ežÞN7Åa•ÊLÑ"L&”Nåðë¸\TU±.V³²¨ßI¯¯¶µEÆ+iàpîw7k‚)ɤN"ãĺcr“3–^ÞÂÀŸ¦Ë*aéC8øuø?E¯&ÃÀæ·Ì“[ƒ3%θîOdŒg\Ø/]K&¯ÞšÜ¼z)™ÜœL¾œ’dréú«©N&W&WVÉäòõ &×Ë|QÌëm ÆÃžíêt½©üxØ–UÊ.^L®]NÏ~²~ó;Ÿù6~æÅ7þð·[_ÿགྷ߼ù˯þ 'ß{æÂû_¸ý³õ¯žýõ?ýÖ£§øOßÒŸ÷éßÿ#ùÁ‡/êGÿþñ»ßý¾ŸýË{þõÏßþü¯ã¿¿_|ëÏþðw¯TÕñ£µºú¹§~‘¼v-½‘ iMufbá2­* Ï”è(«½\=óŒÏEA´ ™ZBÀÃHê(—b:–Ô£T¦XÈÔQz.J!‚kÖ%à²AÉê)×™«žëü 3Ì£ Á€„ý”fB2›"w9dg&"Í’ D{*sK !Þ3ˆžAöKÕgøYĈ2™–&XA °Ù{ˆf‡£>aj$dÿÿV &(ħ8¿jœ@ÕHõý´ÊËbVÛÍŠ#ŠC©‹]žTD†?ré6~Ò‹ÈнEdÈ´N¸æ4&*"»\=¥OÆ!–4¹:JÀ%Èê(—6d «£ô\ g:¬6=%àbÒ„­JÀ%±Èê(ׯÿ®0È8¬ÌþBÅôa_!QO($@ý ƒ"©a$ê ɨ$wƒ1ŠŠ>fÖÑÀ8¦,`pƒÑ•by0—0Á0 ÏŠ#s0 è ˜ éH³ c.ÑÃÕ~µN(bƦE85U0)`QX#¨+#XÌ9rfD¼b½ÓìÖ »¡úT ¸a"ššè5ÂÕáxÖiJѶ,–Í´æßÍVö¥=™•kK·C‡Š¬guYœµfI4 E.:S»øú³°:GA‰*?J*%UÈÖÕhR T´®G ˜&ÓéÉôÅ;Í[®©9׈t ':€Û ÑÎ2çùÉMjt:0ºB^4Ò/ÚÔ¢MѪ_^Û5XúÆ:ŸmªCtvT”EõRû‚#‚GÏÏW§UûY×)nèÑ_|¾Q%bjó’©vÃ푆©Za±¥-@hî‘2Ì>”yøä`X,Íš%f¨ª®ëœÁ¼|p}à;¡Ä­Zl N;°û¸u»aØÄmsÖÀ´Hê< jè¨=4Û{­Ly€/ãý«*Û6Í%ÌûË&·IDн€š° èQ°xÛ³Yˆ¡S–QŒ,#ͪf›Ù“ÒNÑ æk H†É+–.vŠ[»ž+¸Œ5 -]ÕP¹ôÙwk÷ªê¢¨h‹¡àÇ°Žž6Îÿ­[ýÁ7kãwÃå¸=\RMn ÙY‘tÖí­<Å%CÛЩëaŽp¬\$˜ÓACóB"ŠÅ9erR¥Œ‚ÎF¸?Øn¶ìØ´†!ð¡jr S–;~w"ÔGóŽÄœr«8ì’l¼ C÷ ^ö,+‚:âªaÒ"o¡?v[®ýÈïY…F›XÙ¡}Mò/Îãt6ëç!¢îKÊîPý쿾P(Ô~ɰÔ‘7q ÝîÏä®ÜùÞ¹g¶°Gˆ¡_vÒqoƒõmmO,óªmŸ:ê± h?öêuˆQ—5®~櫪‘ñór+Ž¡ÕK]ýìúù— ò%µõÉ~¦j…¼Üëð\táë»ù‰ëaí†qŠí¦ è›Ï5“$³=‰ësÌó€*v+^³e{÷8Ÿ×½I¶]´HÌW³ª•Â¥ÀíB2aü7=ô‚ÿì78IÀ…WÑð”ù¶\äpã;jÆ”£EhüQ“=NÐà0Jœ&{ÌÔ-“Ž»‘ÍÎÔmN¶æ- àm*H«ê %RDîCá¬GÛÒ÷4ÅÅÐižF³ê´ÌöF8ÔÇ,?¯ŠÌ{{1tìñ˜­÷`²9]ß…)ñ—;ßTÁÈyЯ‰ÇÃ`¦Ç£;;$y5/‹W½~*#pcµ8ÙV…¯o­t—]N ªŠoæ}Ì–Ë2_„¹8Ú‡=4œÙƒåQU¬îoOóºÎ ¨!÷l{KTN¸]º…+"Ê“€ã†U aØEôh¬tûÌ5û¢‚ö2i#“ö2) erÊT(“ "wËë%Â’äN;h*C©Z IeFö\bx/—7šÊ^¾r"­#­ñ‹ÈxÉ}X9¢—#9"°8FfüE]´ÿoÒ¬ endstream endobj 460 0 obj << /Filter /FlateDecode /Length 162 >> stream xœ]O1Â0 Üó ÿ i±T]ÊÂBÀRÇ©2Ô‰Òtà÷4iËÀp'Ùw'Ÿew½\Ù%èñE ¬ciòsD‚žÇ¢ªÁ8LÛTG„ìn:¼?`1]ç»I>OÇCYUk½¡)h¤¨y Ñ(Õ6Ö¶‚ØüI[ ·›³>·J-œý»’£¹Ä~pŽ‘8•¦¥I.à˜~Ïr ˆ/0åS5endstream endobj 461 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 212 >> stream xœcd`ab`ddôñõÍÏË74Ð JM/ÍI, Jtw?þ“‰µ›‡¹›‡eýw+¡;‚7ù¯ €ä KóKR‹3óÒsRõJŠ ÕÛ˜Y¾¯áû±ðûDzï»Ê…¾ç>¶?+.œðýø›¢ +ç•ts´±•tUUu–pOèö™âÕçÝSÜž¶©›cyïºòSÙ…zôšp grÏÔîÉ| Ó~8Oûn;­Û ® Ür\,!ù<œgOì óû'òð00þéM~endstream endobj 462 0 obj << /BitsPerComponent 8 /ColorSpace /DeviceRGB /Filter /DCTDecode /Height 150 /Subtype /Image /Width 150 /Length 2575 >> stream ÿØÿîAdobedÿÛC    %,'..+'+*17F;14B4*+=S>BHJNON/;V\UL[FMNKÿÛC $$K2+2KKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKÿÀ––"ÿÄ ÿĵ}!1AQa"q2‘¡#B±ÁRÑð$3br‚ %&'()*456789:CDEFGHIJSTUVWXYZcdefghijstuvwxyzƒ„…†‡ˆ‰Š’“”•–—˜™š¢£¤¥¦§¨©ª²³´µ¶·¸¹ºÂÃÄÅÆÇÈÉÊÒÓÔÕÖרÙÚáâãäåæçèéêñòóôõö÷øùúÿÄ ÿĵw!1AQaq"2B‘¡±Á #3RðbrÑ $4á%ñ&'()*56789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz‚ƒ„…†‡ˆ‰Š’“”•–—˜™š¢£¤¥¦§¨©ª²³´µ¶·¸¹ºÂÃÄÅÆÇÈÉÊÒÓÔÕÖרÙÚâãäåæçèéêòóôõö÷øùúÿÚ ?çù»mÇåÿÖ©’_”~=(™§Z¬NÌ€p£ß¥{ŸÅð—ÄÃõ§ùÃ@9ÇÞïOÞHÆj\JR4VQÄṢ¨+p9ÿ<Ô›ºsRâUËÂa“@›ÜÕ0Ç'šPßZžQܾ³ ÔÉ0Øk9[“R«§š—ܾ³ •&œ¬Z•Ô8ŽçCe0ùºöéW_sXöL~o®+}kžQÔ´ËÂ^zš_;ÜÕ ßZPßZžQܺ&ç©ëNYºrjˆ~{õ§üÔŠF;çÖ¡çq÷?H¿ê‰ã<ZL¤H§Ž?J†¡\þµ"Æ¡”{ÃöéW”ûÖ}™Æÿ­«W4–¦ˆŸ>ôïQ¥ÝQa’ƒïNϽBœJV:´S#µ޵`¨õý)Œ£×ô­$¬AÇZašœªúþ•ÑŽO¯j´É±ži¿6z“ôïSïžüSv§sÏûµWˆySßoaŸ»OSò›Ó¿Ö†TçŸ^ÔÎNÌútÿëS܉Tþ<úÔˆGù5]pzõªDaï¥&ŠLÙ±?Õu[Þ³¬|ùã¥]V¿¥rÉjl‰·{Ò†÷¨·_Ò”0õý*,2PÞô¡½ê-Ã×ô¥Ü=JVÂ7½°æŠV‡ê›/=ëFd⩲sW&UeúÔl¿Z°ÉQ”­$¬ÃŽõÞ;Õ–N*=œU¦+ÿ8¤+Ïʦ)M(3ß󪸬W+õæ£d:ž£µX)Çz“lÕ¦KEp6øÏ§Jzþµ8¦}Ï¥^älléç!ñíWEgií'áWC×$–¦ëbjQQ¥Qb‰AâPïãð¥ßÖ‹aOZ*%~M6»5§{ôªogÏßý+beàýj›¯5„dÊhÎk?öÿJŒÙÿ·úVƒ-FWšÑIŠÆsY·úTbí¿ô­ZŒŠ¥&+ û}=©¦ÓÇúVj&Z¥&+˶ÿÒ£k.3ætö­j6)ªRac8Øç3ô¨ÞÇòÓÿ­Tn*”Ù6FW:q`z¿á·ñ¨à¯ëF¤WÿÒ¨ò§ýŸå[¤¤®ÌÛåvEÿíƒÿj¨Ÿîô÷ª#¯ëFãžÜÑìâ.vih·¶:Òý¼·UÆO­g–8Û?­(8ôëK‘ÌÍ%½''}ÍH7ºŸJ*yîzTÃõªn9«³t?Z¦ýk͉ÐȘTDrjf¨Z´"'¨ÍJýª3V„4÷¨˜T¤u¨ÚšÆïQ·Ý5+µ”Õ "¨Þ¥"£qT„eê|²öÆ¥P<þ5S¯nµA³»Öº©ü&Üî{ƒž‡¥;¿nNzÑϹàõ¤äàn•©žÄ¬z`Zãß HÀívcÞ”gÓ?7qÖ¤²`À `ðH¢Ÿîç“Û­ž›08=zÕ7=úÕé—ƒÀëTÜsÒ¼˜,‡Ö£#“Ö¦aíQ‘Éâ´B!qQš•ÅFERÂ:Ôl*cÞ£aíT€‡Z¾é©Xu¨Û¡¦„DGÒ£|cµMQ?Ö­ÌÔ±•ÀúsTŒòãšÐÔ~b§“×úU1ýá]0ØÊ[-Ç ~ Š@FGÛƒJWÞô£½ÏëZ€ »qï€3ü©r2wëÎr?:@Ùn™Î=úÒ}ÌòÀ;}ßþµ Ø›+ÝS99É4SKÁ‘† ÇOj*lUÏUš1ƒÓ¯¥StíEãÄë"d¨Ê}(¢´D‘2œT{(¢­ÒžôÆAEІ2Ôl¼u¢Š¤"2¾õ©õ¢Š¤mðÉ9ªL>½=}¨¢ºa±”„q€1‘ô4c‘ן~´QVH¸§œí'9÷¦Èp$ °ÁÃtëÒŠ)²˜‹Î1ÓÛéEU¤¬fÛLÿÙendstream endobj 463 0 obj << /BitsPerComponent 8 /ColorSpace /DeviceRGB /Filter /DCTDecode /Height 150 /Subtype /Image /Width 150 /Length 8099 >> stream ÿØÿîAdobedÿÛC    %,'..+'+*17F;14B4*+=S>BHJNON/;V\UL[FMNKÿÛC $$K2+2KKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKÿÀ––"ÿÄ ÿĵ}!1AQa"q2‘¡#B±ÁRÑð$3br‚ %&'()*456789:CDEFGHIJSTUVWXYZcdefghijstuvwxyzƒ„…†‡ˆ‰Š’“”•–—˜™š¢£¤¥¦§¨©ª²³´µ¶·¸¹ºÂÃÄÅÆÇÈÉÊÒÓÔÕÖרÙÚáâãäåæçèéêñòóôõö÷øùúÿÄ ÿĵw!1AQaq"2B‘¡±Á #3RðbrÑ $4á%ñ&'()*56789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz‚ƒ„…†‡ˆ‰Š’“”•–—˜™š¢£¤¥¦§¨©ª²³´µ¶·¸¹ºÂÃÄÅÆÇÈÉÊÒÓÔÕÖרÙÚâãäåæçèéêòóôõö÷øùúÿÚ ?„ œûw’°ýÇ výÎÀ®Uæ\ P~BÑŒÇ^»u©àyÊBHJ`ž8ÇËÈqÓØâbxe¸á<¤*†#ËÁàÓè8õw9¶'8±µ³`f`v™=‰!AÏ^þ=iܸ;9 ýãƒótïÁÏ#圧”"^)Ue+†p3‘ÏÌ@ŸCÍ6XA¢–Lœ†ûØ<ôçzqžÇc¶¯îÿÑ_îŒçøùë÷y'§ëÔô.&öÀÀqÄŠ¤üJúЉ-”4gÌB cvþc‘“ÓœŒóß8ïOšÖˆ˜J#ŽCyR&?¸h’òŽ}¸ÇÜRŒ¯ËÎß÷ºNA, }˜)ÃÿÏÎ~oûëöûßáEÄe!‘-æXM½Lc”ô ¤ñלô Ò€´%_?þz|ßO¿Œt㯷ZÀ(Þ.3öÉ#Âõ2.ËÓïŽ?Ã¥,|;d>ü³$9è^Ÿ'Nøëò–Ä×Ü‚.‡Q8…Çsÿעϛ(iU£8rNN˜ÏBGéÔ@ƒ÷GjÉÍÙ€Ç_\qÓþøö;GÈ÷²‘p7¯Éþ×^üóÀùºŸâcÄRß̈CðAeã'ŽG _ËØáì²Aç¯ÈŠËó÷Ï'Û©äàûŒ€= 1Mºg˜íÆíÀíç¶ Çfëü>Å„+ƒý"U ÿ¬ó?Bwcëü]»Ì<ÇIŒ’å¶àû¶óž£§ >€‘ù¡…Ú‡ ÉózŽÃ=;ž;~#"@Ošû®d—ïËE ñ÷¾ñé×þÔu=‹3.N-Ë“ž˜ëÈù~èëŒgå)™žy — ‚Y¶™C`àc§¡z¾´ª¤-¦%cµwÎ1·¨à‘‚;ã©Å5FÞ”„y…ÇûÙÎ3ü9Î;g?-H™–hñ·êÿ´yzöúž´ÕGûâá Ï;ÏÞÎ3ž8Ïá׊hIRx¼»¤Â;D„sÁ=}OsÁÎi#®T%ʰ}¿½¿´T2ÀþZ츉YB€K0ÉçÏ<õëÒŠiyŠåœÆ5Ú7[±óŽ?Ö‚O¿ãŸï{šH|¨–XÝPÊ«‡aƒ¬¹÷|Ð+ ÄÆ[§ÞçŸÇÓ$«`””f6!s“ßxuäcÀã9ÇQ#XstVkIF#Œ|Þ^yÀ?JV‹’Y”‰˜ žˆ~`=°¨ãþ战ä±"@W!d;}Ú¶þ=iŒÞY<€ w<(ôìöî'’ +B-$xƒÌ£ù‰Ú§…Ø$=)?³î­¿}sp’Bœ²y…²>‡­4>ì äñ‘ó>œtôÆyÆ 8‡-,¬=$v*~ ¨¨¥¨hXÌv±Ø$-±ÿw÷¦Ÿ¼9ù¶óÛ§@8Æ ŒWs?»éýß»ï÷ºûñI /ì ¹e¶â)ÄjI!0{Ôqí;¢P<ìm/Ó'3Ÿ÷È?†zÔ±H¦éG•jß ?2!þ¼¸¨c~|¹r1»îžý}úuõùJ€%´_é ²lâÉü}Ñÿï¯sOií•cû $|(ùçßï/Þ¢ûŸ›cØ>f==qþKz²3‚‘|œ…É*¿7'ƒótôΓÆ_¨‰>Óop²¼1lD_œ Ÿ˜7O÷U‡ãŽæ¡KË%ýñ€²]ƒ‚:œg¾åü½ªV ,Ûc…>^ˆªù‡\1÷GöÉFãÝÛ`àcjmïÛ~>¼ö02+£ÞòÊYdò­ö±,ù(Ê9#¯p¤cßÞ›æDÑ-¢&.b%^LËœõ?3øg­9Ý|ÙŠÝpÍ÷3ÛŽñëìO#¨nïôuÂÆN\¼ñÜç$÷åG qž  ²@ÎØ¾PÊà}Ò6cïqøõ¡%µŠXİ«4l åO ~X¤Gù±¶,m'nÜc¦3ŒwëŒóœü´G(ó¢`l°ûê¹<ôå‡Ó¹ëL+Ú]P¬ckÜ·Ì¿’ñíÒŠF”„”ÆÞøÁäõþC§29¢@‘~í·îÓïg89»×ûÇ·ê}FYj„$™Š" ¿iÜß:õ8ÁÏ~yíš”:ùv+‘˜HY÷H1“ú+~TÛIc[c8tTÜm²)? 4ºÛ1‰_åaOîÛæUú(ÉéÈÇ·áG$ð{r8ö±×æ# i¿è׳ÜMòC"¶Æ=NGéMa‡•F‘¤ÕK!òVü©õB g'H#ƒÊ{@:àãÉÀq+HGð<Áü$þTlH6àÈ]—Ü0 ~¤~u¥¬ö·1Í4e!SËzõ«Nú“±©ÿ¢È6$ß¹Ædÿ®@?OÀÇ‚ÀmÇú¯àû¿ÜûÞý=êŃ­¥œ‰pB7×Ì'“Ϋ¯Úøû6>þxû˜þ|VKv_bõ°+r¹µ¿t£>KœüŸîÕXÁØçj(*0ÀOÈÝOCëׯ=9­+KûU¸@Ò¨"$ÿ×:ÎVW¶1dT)—ÿB T«‘D¸€eO˜œ0,Ýç€yïÿ>£3ž#·ýÌg ?å›sË|½9Ó¨Àト­`‰ZS°AÏcˆÇþÈß•YûD";\º’onz)/ƒÿΩ‰ 1Ϙ|”O—î„e ûÅë3éô$u ¢åÇú<\m;LMŽý±œþ½Ž,ÝÜC33ÄêÁn ôýê7òR dW–âãÍóËeE î gùÎ¥^Û¨Ù¹šSöx“÷„åb`z¯Žý=óQ}†!åªýïœ) ß)ä·CëœõéÍ[º¼·–IH¤ù»¸ôI?5VIô›xƒ4a•—<ƒå²ÿ2 öFŸë”ùQã òìoîtÆ3ŽøÆsÎ1Í$ D¶ÿ¸…ñ&I1±=zp;tǵH“Çö¥—pò÷3îí·ËÛŸûëŠu¥Ô½º»…"RØ>…²äjÄTdb"\LBIæ>ݺAÁÁâŠx‘¡fÈUGƒÆç$~œÑUv<Õ#`uÄ U0N8ùxÿ`}ìöëÈ,ŠxÑ¥$B"S÷w… Ž£=@Ç'œg#"€`Äx8cö÷¸Ïþ;ætÿ H…¸‰ïöþóþúúq÷sý9©²ç˵‰ná’2ò¯>^àØnNK;s€=±Ò’AüÆH¾u·ßêAnxë”8éÆ2 #ÀÏÛ‡ú¹ÛÃîóÓ=B:ïigOõÃÿŽïëÏãŠ,‹¾SÁûå ?ˆ€sÿ}vÇáÔ9ì­­Î’[nNFÑ(?†Iý*¹¸ œ~ë;~çðãÛzþ4m¼ý3ÛøÿÕôü9ëEŸpùÉ"i±º#¡Œ®ÂcÈø;rÇß9í€ybßíÂHüÃé»w÷zãoOnžüшD2 @&ÌÀ· ýÞ>îßoÇ5ÜÁ ecÛ ãþúÆïóŠ7þ· ‰×StŸlm&B€2çp)ŒcñÇ^hVI]àójðzãºzg¡=úg¾tgJ#ÍSƒ8Ý×g==ê(¼¬6Ñ‹£v1÷°õ˜ÿõf–Áž;X·¤‘à6ѳpöî÷éèræºÂ¦ˆÕe\2ÞŸ/_˜õ㯌Gû‘úXÊîùºuíÓßÌÿ8§¿ØvÄrùÕäíÿÙ:súÓÐD‚äβÈîr‹üd×weÐzóŽÙ¿!ÁÎæ;xnxéüþ#Û×9ã“dRo³#ÛûοÞ÷ÿgÿ¯ÙßħÈãn7}ïâ÷þïùÍ%nÀ8ß´òº³° ³äWžÉ×íÓ‚2 ‰Dƒì¥Ç•\“³®ÞÝÝ êOï‚:išCÛ›ûßwÝ}³ïúSÑü…ƒöÌŸ0ãßúßÛÓùfžÜ.<á"ïdàßÜ?ÃŽžÝ;gšh½XeDI:ì$dœ2§ž{ñøqBý“#Üm9ÿsŸßÏÿªˆþÀ&‹Î}Ã=~ïðãØéÏãE—`ÔXbPþl_(~÷FùŽ8õõïÓŠ)­äa|Ϲ·æÎ:çäÿÇ}?h§eÔ5$Ä¢K¼„[±Ny=}3ן^3Jâ\BѬ‡¡QñÖ'ò¥mBãõe•$dP€ï*…;PòÁ‰FY$‚bI"!‘ò¤1ÛœgðÚ´!YìŠDcstyýè_êÓŽ”$7"`VVo1/?/û#ùqéÅ64h™Épa=8_é¹öÇû"›¸¶ù'ŽFq÷U“ü?— ¨d3(ùr–ñ±û¼“§§^£ßÔÔ†6hˆŠ@ì‚oO”žÅz{±•håÂbOáxo¼:ÿ^™>£ïa #³’I-®H9 `dƒÎÇ=þŸž\U}ó‹5cŒ‡lœ®p6ÿùÍ_T”$¢F9eùrŽÚÁ뎟úÐcXgÚï$ù#°éŸ_éß 5p+[I3ÌÄTÇ# Äá8ëߎ¿áV"2Fh~RVN‡n2(àtïO1Ü \»œÜ3‚z}áëNq”ØárÍû¬’½qÇä鞇ðšLÀœZ—!8ƒ®92Ö£¸YÒ~vDF8 1òƒÆ:œE'üôùö‘Ðõõþ÷OÇ×åæš°Ìe£›€G7$uû¹ïžœúóEÀY¡œÄà,9S?"qògðëE#DìY°p0p;g=ý}8õçŠ(NÁaÁãárÿ¹r>˜õéòÿ³Ó·Ud- £`(¤Î8 ñȽáÔ?p /ËØ_Üù[ïzþ¼)õù…eψÑ8o•£;¾„óœu<òëРyvѬÿ2‰¨äœóþÉÿÇãÖ› ‹ïØuß‘ÜO§û>ý¹=V[† gX–.Ï*’Ç@2qžÜÃ¥#²•Oݘ'aù¾VäsÓ¾8à7àž`D±D ?ï“Ô?/^{çêz=ª@†VRs•##òEþb¥Ê+ý†Qz©çæ>nè:`‘Ó\ìî~É*`}é2Ê>£yÏåEÂÄ24v°È½F͸^ˆq·ûÞŸ‡rßÝ‹quóm?Åü]1Ó¯þ?þ%ÛlHÇ#l©¼ãåã¿=úô#ž0rÿf"Pç¦Ãåõþî»×ó£ w±GryÝ8á?ë ÿ>)±˜ÙäŒÈ ôî¼~xéÿĘ̘¸â[T8êÐò>^Ÿtôéþ=jXØyî6/û¡pß{Ïþ;שý XY¢¶‡'zÆuôãåý=>äAdmùõÚÙ#Ðcw¯oNS 'º Žkäô×韧¿C6ÍÖÛ‹8¡y•6ÿ78{ ùíž´„€±¯œŸ$AßäažŸíÆGq’"¾Mºt&lùGnУk2yÏä? >#ã#ÈÀþ¯Ów÷ëÅE¨ª†q2³6Hù>^~NÜöÇ÷Ï8Ïø“†Çî3¸ù¾÷÷¾¾ÞÞôí¢É-!’bèrv™äg»ñõæ§EQ;H&V9ÎÞxù÷}zŒtÿǰ¦„ŸgYuŸ3;Ý?ç֭£íR|òOBwŽƒýìwö÷ï`rh˜<è››¯Íþß®?¼/÷¶Ç$Äܨó"D?AŒ¿ìޏõîÌ}lÿ>Ø4À-—å“ËÞØùSòä“·§NÜ{熓l[b¶Š9mÒŸ•×o‚F=3ô÷$H‘Æ·/8œvÉ\tùƒcûÝF9¯®§€Îûó¶NKäciÏðŽÙçô8Áš5O¶J«‘(“æÉã;ÇðãŽqÜú{¦¢8͹í+·ÊÛ»ž›‹g®:ñ×ùâ’H£’_šåeUÚ=¹¯äsP*Çöcò¾Ï'×¶ò:ã×¾:qïMD.~xäÈTÉÝ€;ÝùúQm@ºÛH`gA»i'æì0?1Ï?†G4UyTym”rL×îñú}s׎”RHw%"M× ¿ýc·ü´#kýïO½ßýù¯qpæRAWt€‘ŽœןAŸ­)1¶³Éù88ǯ%>î~èï·"€ZV‹zÄAÚ»‰Ÿ—ã†ÁãÓŒœR×Ï$ºtùŒYvÿ¬}«À=à·y6ÆŽ6À«÷ÿØqÇŽzôê{6_- D³SÈÇ™"¶Y‡9ÎÜ·\ußšÉùFÆÈ@î¾O×%<ð;íÉÐ üÙÙó,§dhIêOsÓ·^•5íËËi",“ä¯ñeGâJàULÚâ[åqŒžœž§<ò:àZÛHÞ8.Wrr26Ê+ œuü³Ø+ˆå6ªžbgsg÷댽óíüºdfäk2Å8¸‘ÝÈùIÜ1ôÜ3÷Êž=| ÇsåíYe‚~oŸ8ãolñó~|wÃOQELøx‘@YÔã*GcӟÞqÒx¼Á{,¥ÇÍ&r$ñ¼GQôÀç¯Ý \Í4­ÃƒànÁÁäzí>¼qÎ2Ê圻Y–Ìq’p£ ùq·pàãÓ$ Ü6 M©O3þXíÿZ1÷ÉëÓñÏ^:ñL™&’õ£Hi€ÎƒŽ?*)Ù´ó¶à6Nwg$úçg¸öæ—d(0´¨8 ‚Äã'޼äúúóJãC)GV”?ëè¸çðÈüè ì90'n€›ónxüpx¢€(³åäHÆLG9õ8Ý÷{gí¦¢þò㔫gæ%ºŒçtÎqøsŠr‰H xòål|Ÿtm''×§Sè}MG•g¹O%mp»“žz‘“Ó>à–U"Õ<ý¢, ¥ØèqŸ7çøóHèp¸Û,mË mÃcØÝלg<í¥™$ŠÊ)m2€KŒ©È<x“G&ÐD.wD¡äícÇ·ŽœS@ ²OÝnQ‹·çOï cÛ8ÆyÎ3Æi÷ qä·š¯åãæó-¸÷ÛÏåQ¬2ƒýQ¾%$z–Qǧ^•5ݳGlζӂ£ ±fˆûé>æÿcóuïÛïcñçîæ YåK¬þí h——éÔt©aW73#F@à—üÛzõï©­6€lËûƒçy`oç{duoî÷û߯û48‹jîò2#Mü·ÝÏöéŒsÓÞ’u–;rVR$èëžì;ÿº?#êi¥ Å"FÁAò’FIã§=jb&ŒDb¸òŒ%vüÛ7ÔõÉÏMÝ;g¾*º¬>RóÍßíã¶zú{tÇzž'’Hn[äbª;žÝzgèbj°’q7Èó“åŒ1Ûÿ¨¡\ €€Ï&ÃñýÝý1ÏSéœ÷ôçªq ³ÎÞwÙÈêOËœã§öÍF’Ë%ÄŸêÈùØŒ ñx8ý JžcJÑá$#`_˜ Àrz÷ïÜç­&2%TXÿå“åžçd㎻søçýš6 ¸BÿgÏË»,ÄǧQŽ˜çךÎï1óä“»ËAÝŽ˜éÛ¼õ¨Y¦†â/Ü…B7Íýßäätþ_J­ÉØžEmœˆº.ì¿ÁÇéÓºóEG:Ê"¶rT ÆÌã œóÀU8òÇž}þ‡“è(¢©‰î'!‹ay&5_âô}yôÇBjºÊ›P– À>Rõútü{çž‚Š*VÃ$2)žP’ºÄ«ØsÇòèqZ3”ÄÚð/¼}2}sÔ (¦„È–EÞêØîØ3§OltïÖ£Y£Û‚’ËŒDî2Nƒ§J(ªÄñÅ lñ¡B«³;sœ g§~ztQE¢FmÙŸÿÙendstream endobj 464 0 obj << /Filter /FlateDecode /Length 1646 >> stream xœíXÍ‹E?Qšè̓‚P·ôH¦¦¾?Âa³ù4†l²$H¢0în²³™ÙIº'Ä€% ‚xòàÅܯâÁ› GƒxA…ˆ(ù|Õ]=õzè]LðàA–¥»~õ«_½÷ºê½šºAå„…¿ø\ŸdŒ\Índ¼BI|¬OÈòZ68ç, Ô3ÏÉÚ•¬ wš:å‰Õ–z©ÉÚ$»”¿4Zï‰Ð6*ßê1Ê´´œù|¸Ù뇖ãθ|ÜëK))c2?1Ä´2°<ŒÖH^м5¶8+ÊxþâÍj¨öÊ> ¸€Ñù‰i±ƒDG×6]&?‚§+Fål4Ü©­ñÚçË7Qoí‰ò<Ž2ÅM>ö^Y;11 ÇDJC¹‘YÛÈrÉ{kÛÙѵl5„T{K#JyMµ'Âñ¶y›ä"ÙÙ3ú’YâÀvÏ¿Pœ €¬àÔ2^‡eT–£Éh<,F³Ûäúx:#}RΆ;â'À5æx¾Q¹P›G„0–ZS‰6ïÜ9î帧ڄå18§” +S¾ rµÌÜIr ,:ÿÛàÄñ¬=TÏ%›g±™_˜Õ…/ÎUšÕÀ‚Ò6̺|29?8w|9\„¸°lp‚ðl°|öqÙàØàØ8¬œ]Zœ-67Fë³iA¸†1ÓñÍÉNY€Æ´(‰<|8;¹B^ÿhræ­'ßdûŸ?ýÝ/ç_ýãÎ|þò,{gÿÒ½ç.~2ùâé/¿üÂý}êã îÙ;O|û[öÞƒÛ}ðׇwÞ~×ê§~º{ÿÏß¿þôçþ¯÷Foüøàýo^(Ëíû{ü™}ŸeGO’ÕlÑ‘ÆÙਃˆU1X$M2ÅáK9GƬ„pK™«XB0X ±‚Xô…Á¬9‚XÖ•Ä3&$±$7œ*#Ì ·WTCÚ‚#C]¶óËùðr¯ãÈö„ ý蠟ôœ¼©¦î<0̶ŠÍrk:Þ˜Ûô­Úû@Ááú!õPÕ} xDóOÜhöy4Ï>Œyqèžµ¾!¥ÚÕ ãNVB|8Ûªõ‰•ÄŠ•±æbÅÊŽXs$±šÊžX A¬XÙkŽ V¬ìˆ5Gk1:8^‰µ÷سÞsÐUàÀÿõþ?_ï¥ç2ülJé¹ApÕW ÂæQÑoÒÞXRøÅÚ’Š.ûI*RR„xc©ˆàªŸ¤"Ð)Y…r|i\ô“Tº¤„g°L°ƒ ‚«þ\ª:¥ œ‡<.ú ‚‹~’Š@§”²aÅb©ˆàšŸ¤"Ð)%ÃÞ–ƒÁE?IE KŠ{¿°®Wþ$,õ(…_0GjÈľÎ>—ó×Еª ,¸¬¨}XTr_AŽ®âû‰b³ÊІ{r¤ï|«¦W`G~;p9Ô;›_GPðc‡ÓùÔ1-š‹ßòEkÊ ³Õ×B6XtŽ5B2]S.åýIëúf¸Ó¾î©ç–y ?ÙQÏl4݉’ç·F³­ØÒ¼J™µ/ùzëV ”³ö­QI!@áÚˆ‰xÞªcÇMîGÐÈ |mUl4óªÝã¶0¼Æ•ßåÛ†âÉ ‡¼ ß*T¦ZR°oÄ« +Õø^U ‘϶¯ˆ.z·ËKÜo©EÓÏjö7¬0qendstream endobj 465 0 obj << /BitsPerComponent 8 /ColorSpace /DeviceRGB /Filter /DCTDecode /Height 150 /Subtype /Image /Width 150 /Length 2799 >> stream ÿØÿîAdobedÿÛC    %,'..+'+*17F;14B4*+=S>BHJNON/;V\UL[FMNKÿÛC $$K2+2KKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKÿÀ––"ÿÄ ÿĵ}!1AQa"q2‘¡#B±ÁRÑð$3br‚ %&'()*456789:CDEFGHIJSTUVWXYZcdefghijstuvwxyzƒ„…†‡ˆ‰Š’“”•–—˜™š¢£¤¥¦§¨©ª²³´µ¶·¸¹ºÂÃÄÅÆÇÈÉÊÒÓÔÕÖרÙÚáâãäåæçèéêñòóôõö÷øùúÿÄ ÿĵw!1AQaq"2B‘¡±Á #3RðbrÑ $4á%ñ&'()*56789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz‚ƒ„…†‡ˆ‰Š’“”•–—˜™š¢£¤¥¦§¨©ª²³´µ¶·¸¹ºÂÃÄÅÆÇÈÉÊÒÓÔÕÖרÙÚâãäåæçèéêòóôõö÷øùúÿÚ ?ææž)$Uòy'¸¤ÎÞÍ{ûœ;¢™¼ûQ¼ûQ`¹j?¸)Õ rƒ¥/˜}«6™w4í¿Ô¯ãüêú}ÅúV}¡Íº¯ó«ÈÇbý+ž[š"J|_ëE¸Ó¢cæ †Qn”S7§•ãN q@­þáúÔ• v­K¸Ô1Ž«ªZ£¸Õ¸ùKS-†‰è¦o>ÔT òùg¨êiŒ<Ô²›§ZŒŽµí&q43=©itúÒ)ìj‰'Oº)ÔÔû¢PËFŸü{'ãüêòýÑôª6ñìŸó«Ë÷GÒ¹g¹´E§Åþ°S)ñ¬ ¢Å(ëIJ:Ô´áÒ›N) ž¸~µ%GÜ?Z’¥€U¸?Õ-T«pªZ™l4IET óyQsÓ¿¥F@úU™Pg¿Z‰“æã5ë&r´@ÜJLŽÿʤtù‡^´ß,{Õ]fààp(Üh•9=qMôÀرæÕ3ïüêòýÑôª6ñéãüÍ^_º>•É=Íã°´øþø¦Sãûâ ¢|šU<ÓiÉÖ RŽ””¢“Á÷Ö¤ÍGÜ?Z’¡€f­ÀtµR­Áþ©jXÑ&M”TŒãZ €H4Ç·ºÒe\ò¨ÝWDéýÚìR2±Gì¨z©â”YÆ„Õí«Ï ÿ|Ó‚¯¢ß4s°±œÖq–9SÒ”X@[”?_eÏ Óû¿JUQ»¢tþíì,Œ;©dµ¡ˆíq€zÒ­íÆÑûÎßÝ&©´\Ë»{  Äî= Þ)I¶Ó.}¶ãþz㢤†òs(ÌŸ ¬íÇÔÓ¢c¼r:n9µÍýÿÐQöÉÇGýgïoïλxþuŸ"*æÛn?ç§þ:)EíÆ?Ö㢳7·÷çJ±÷çG"cjÞò}‡÷ýKöÉÿ¿ú È·vØ~c×Ö¥ÞßÞ?C‚¹W4¾Ù?÷ÿAW »ŸÊ_Ÿôƒ½¿¼:¹níä¯Ì:‰AXišßkŸûÿ ¢³w·÷çEG"ÅnƒƒùTr}þ‡§¥HÑ>2HŸáV„'¯ò§¡ü©<§ç¥8DþÔÖûç¯OO¥ ÷ÿ 7óNŸáJ±¾þÝ('TÏ”ONÞ³äûVާ¤ü?ªNëÀ®¨=”–¤*NH#éRE÷Å3ËÁíǽ>0Sºz¶B' Ó|Ôõý(Þ§¡¨±w”Sw PF(Í¿Ü?Z’¡…ÕT‚{ÓüÔõý+7¹H}\·ÿRµCÍO_Ò®A2yKó~•2Z‰è¦yÑÿ{ô¢¢ÌfƒƒÍE ;úÕÇ¥G ûVI”WÁõ§}MíJ{~´î"³ƒæ{… ^ÕeÔy‡§Oð¤ 7ÿOz.. ›'>•Ÿ"üÃüúV¾£´K >Ý+6FMï_O¥tÁèg"³)Éç±ïHêv{ÿJœ•Éüi$ÛåžÏ¥É±G<àÔ‰Ö•£uZEFI·w"ÃéÃ¥G¸Sƒ T”J½)i¨r)Õ# µú¥ªµjõKS-ŠCè¥Å­ À¨ä”o©YÊ?3L‘Fþ½Ms«7Íá(£jóòÌÓ‚¯ üÍ=¥aú…_›ð§²®óÀéê}¨U]ý;zÑ úœ€Ï'áý+.GÇ×ü+WTAö‰>QÛ¹ô–ÿ{ÓOc) 2ŒŸ¡¡åýÙöÍ?Ÿ”~t¬ª8éïZhN¥0šVÉŒý}*PóÖ‘ÙDg¢Åb¿CƒO(g¥6Cµð8[‹bxþïãN¨á$©úÓóP÷) W ÿTµK5vßýJÔKb‘%QPQÓ5¼x{ó–ñïþ/ûèU—~ ùÔr?ÏÑ¿:äMšyäòß÷Ð¥Gþ×ýô)ûùèß8?³~tîÀàÌ?{§÷‡µ÷õnŸÞ+¿ï Ó×éHçèÝ=h»¨ÛÆf“ïvî+-í“Ìþ/½ê=«gPÞÉÃvïYnß?Fëëô®˜7b$Bm£ÉûÝqD¶ñùGï~cÚ¥/Éáºô’¿îÏ ùý*îɲ*crï¡éM(…HüêMüóö¨Ãçwó«ÔA0ëÓÔzQ4*IÆqõõ›£tõ¢Fäðߟµw "¿1|ª=O4y‡ÐQ78<­F©v¹7±'˜}[‚f/¨Õ˜ÕŠRJÃL±ç· ¢£¢³².çjÇÉýj9ÏÔô÷­'Š ‘?3QIþâ~f¼õ#k³×“úÓ÷?­[ò ÏÜOÌÒˆàþâ~fŸ0X¢ç÷‡“ÓßÚ}ÿ¼z{Õ׎0ü‰ÓÔûRáß÷S§©£˜,sú‘ýôœúJÊsóõþ/ð®‹PŠÜË&QsÇsY ¾ÿõk×ûÇÚºa%b3ÉäóØúÑ)ýÙäþ¾Õ|Åo“ò/CüF’X­ü³ò/ýô}ªù‰±“Ø|Çõô¨IÀ?1ëZF80>EüÍB#€’ .>¦´R%¢ª›©éK)äÿ]Hmóþ­zxÓž~v¿÷Ñ£™\,e°Î*2¿QZ,Jp¨ cûÞõœåW¦~ñ«R%¢˜npjÜ?êÅ(HT_ûèÓ]¶± Âö7pJÄ´T;ÛÖŠ›禼S`|ËùšŽH¦ß÷—§©¢ŠòÑÒTÿÞ_ÌÓ„Sÿy3E׆o4üËÓÔûSDSoûËÓÔÑE02õ¦ó¤ù—·síY’E6ï¼>÷©ö¢Šè†Ä1 SdüËùšl±MåýåüϵUˆ¬ÑMó/æj*lŸ™3E¢$–8¦Ý÷‡æi^9yù‡æh¢€ š9s÷‡OZ€G/?8û¾ôQT¶%Š#—ûãó5 Èzóg¯½U-ÄÆ(;sÛµQT#ÿÙendstream endobj 466 0 obj << /BitsPerComponent 8 /ColorSpace /DeviceGray /DecodeParms << /Columns 150 /Predictor 15 >> /Filter /FlateDecode /Height 150 /Subtype /Image /Width 150 /Length 493 >> stream xœí›Û’„ Dáÿ?šYo³¢àxP ZÝO–—æ˜ÄˆSŒ®P¾ôÂSæÂ"æÂ"æÂ"æÂ"æÂ"æÂ"æÂ"æÂ"æÂ"æÂ"æÂ"æÂ"æÂ"æÂ"æÂ"æÂ"æÂ"æÂ"æÂ"æÂ"æÂ"æÂ"æÂ"æÂ"æoú]ëû|,VtÆpi­yH´ŽÑ⣾]´–$6K³ÏlŸT“h­ÇË1ÆšÖV*W»¾Ö™ :D+/ |_¬¬:aýÅ#î“cÅ­0ü¼Ñ¶¶‚K¶oÿæòoŠå¾ã;¶}¢_´¶IŒN\½ž­ Ö´w[òýkkéì}±†Ìä^>Ëñ•ºüPWfj+ó$F}kuv3¬a#ìÓ8–TŸÙéˆe/Zð£¢~5Oe¬ô-+O"S‹¤ ‹(žÿ˜Ë‡ªµµÖ¢uNÂ"‘°ˆ„E$,"a ‹HXDÂ"‘°ˆ„E$,"a ‹HXT¡òÏõÅXuU‚Õ ‹/Š–3Œe®äM7ˆºÑ‹jKíÊ –ÕÚrŠQ}°÷4£I•Áq¤^Ÿæ’ËZt?Vv FXaZ:/¯òËž[t)ZÛ•ô÷Õܵh}ƒd%Z÷$Õ¬ä™.—ü’ýóK¡Ê±öÖý± ~ìzØËÇíVA/ã°G÷¦^endstream endobj 467 0 obj << /BitsPerComponent 8 /ColorSpace /DeviceRGB /Filter /DCTDecode /Height 150 /SMask 466 0 R /Subtype /Image /Width 150 /Length 3255 >> stream ÿØÿîAdobedÿÛC    %,'..+'+*17F;14B4*+=S>BHJNON/;V\UL[FMNKÿÛC $$K2+2KKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKÿÀ––"ÿÄ ÿĵ}!1AQa"q2‘¡#B±ÁRÑð$3br‚ %&'()*456789:CDEFGHIJSTUVWXYZcdefghijstuvwxyzƒ„…†‡ˆ‰Š’“”•–—˜™š¢£¤¥¦§¨©ª²³´µ¶·¸¹ºÂÃÄÅÆÇÈÉÊÒÓÔÕÖרÙÚáâãäåæçèéêñòóôõö÷øùúÿÄ ÿĵw!1AQaq"2B‘¡±Á #3RðbrÑ $4á%ñ&'()*56789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz‚ƒ„…†‡ˆ‰Š’“”•–—˜™š¢£¤¥¦§¨©ª²³´µ¶·¸¹ºÂÃÄÅÆÇÈÉÊÒÓÔÕÖרÙÚâãäåæçèéêòóôõö÷øùúÿÚ ?ææž)$Uòy'¸¤ÎÞÍ{ûœ;¢™¼ûQ¼ûQ`¹j?¸)Õ rƒ¥/˜}«6™w4í¿Ô¯ãüëÔôùÙ×¼ú¯+´9·Cõþuêš?ü‚l¿ëÞ?ýW$ÞÊ(¢¸ÍŠ( Š( Š( Š( Š( ™zަ˜ÀsÍK(ùºwõ¨Èë^úg C3Ú–‘‡O­"žÆ¨’tû¢MOº)Õ ´iÙÿDz~?νWGÿM—ý{Çÿ Šò«?øöOÇùתèÿò ²ÿ¯xÿô^v(è¦\¢Š+ˆÔ(¢Š(¢Š(¢Š(¢Š(¢ŠðéQsÓ¿¥F@úU™Pg¿Z‰“æã5î&q´@ÜJLŽÿʤtù‡^´ß,{Õ]fààp(Üh•9=qMôÀرæÕ3ïüëÕ´ùÙ×ÿô^Saÿ‘þ?Ì׫iò ²ÿ® ÿ Šó1GM2ÝQ\f¡EPEPEPEPEP’=£y)+)ØÌÊ‘Œÿ1Q=¸ÝÐפM§[ÃóF•$½ ïzŸÔ~5î­-`¾d“û.dÜ¢[Tàdÿ¶ >øÇÜ«™röT=TñJ,ã?Âk¿[{ Vm…b-WÓŸŸÔе“ÄbÓv ²ÙŒÿ}sÚ‡ˆ°rsq§G»Y[%¹÷P{ÿU>ÇH†îî8<¹ sn?–Gó®îKD›Têšqeˆî j¬xñdN:p;ðjÌmªÜç‹NvÙ¸F–¡[ëÉ<~ž!¤ˆób9tFk$,‰ÜUÏ ÄúúÕ¸ftð’j¿óõÿÓü+°Ð.e¼Ò`žá÷Êû²Ø8b;W—ïoïν#Â$ŸZs÷ÿô6¬+ÁF7H¸»³bŠ(®CC:üZÝEL“CÿD.W‘“‚‡;õÏÓ׋C\êè!ŽW+R<¶ë¼Ž8ädžœÖþ§¤O©D‹5ÜjÊe"`%OMþ«ß=zqšÈ×ôMNòõ$Ruãrü¸;‰Æ‰ïô®Šn)­H•È"V]ì騣|¡mÐäü£ÅÇnƒé“šßÓ&†ÖÜ —J\hþÈ@FÇ?u~¾Õ…„nŸ|éRW;—# Áî3ǰõãcNÐî4øŒq^¡ÄŸ4n9ÁÀÇóïÚ‰¸5¸+™Wrg_ÔJA,åàM±¬y'ýYä8üGëVôbÇÄ—¢•?pØ2 S Þ>l^¾ã>õ îu¨Ý2”XÞ$U‘˜áˆ Ÿâ'±ëžŸ?IÐ/ôíQ¤Ybòü²L= †ãžâ›qåß ks“ñÈð‘^ägîvÿakœsí]Œâ”ëמk+¿É’«´}ÅìI¬N€õàW¡EûˆçšÕ©9 ¥IßÏ/·ôøÁLè=ëVB' Ó|Ôõý(Þ§¡¨±w”Sw PF(Í¿Ü?Z’¡…ÕT‚{ÓüÔõý+7¹H}zO„?ä]´ÿÿèm^g槯é]׆¼A¦Yè¶ÐOs²DÝ•òØã,Oa\øˆ·pjçWEcÿÂS£ÿÏçþBð¢¸ù'ØÖèØ¦•Ãsêqù~ê*QE0F¢BùlŸöŽ;véØ~¾¦”¨.œ€GSËð§Q@iã0·¯9þçþ€µÎÈ¿0ÿ>•ÓøÀ¯öåÞØÿÐV¹Ù7½}>•êÒ~ê9å¹Y”äóØ÷¤u;=¥NJäþ4’mòÏ?çŠÚäX£žpjDëJÑ‚:­"£$ƒÛŠ»‘aôáÒ£Ü)Á†*J%^”´Ô9ê‘…Z‡ýRÕZµú¥©–Å!ôR⊂_¢Š+Ê7 (¢€ (¢€<ÓÆn½x?Üÿй¹o_ð®—ÆJ½wÜÿÐV¹·ûøÀûدZÀŽiî0Ê2~†‡—÷gÛ4ü~QùÒ²¨Lã§½k¡:•üÂi[&3õô©@SÎ?ZGeœzŠwŠý Æu$ª¿ôe~†Š)uB¤ÑËŸ¼:{úÔ9yùÇÝ÷¢Šµ± Q¿ß™¨fCП›=}袩n&1A۞ݨ¢Š¡ÿÙendstream endobj 468 0 obj << /BitsPerComponent 8 /ColorSpace /DeviceGray /DecodeParms << /Columns 100 /Predictor 15 >> /Filter /FlateDecode /Height 1 /Subtype /Image /Width 100 /Length 18 >> stream xœcüÏ@,`$Z%:d endstream endobj 469 0 obj << /BitsPerComponent 8 /ColorSpace /DeviceRGB /DecodeParms << /Colors 3 /Columns 100 /Predictor 15 >> /Filter /FlateDecode /Height 1 /SMask 468 0 R /Subtype /Image /Width 100 /Length 75 >> stream xœcd²_ÊÅøŸƒ‰‰•‘… Œ˜™Àˆ‘H2¸Œ`’ Ê‘ 6HD2ƒH4A—‘ I¬Æ vÖ{2 Õÿendstream endobj 470 0 obj << /Filter /FlateDecode /Length 3287 >> stream xœÅZmoÜÆþ®ßЇ4@x­å¾ïhH‹ŠÔj¾HAAëÎ'&”N!i;ê¯ïÌì.¹Kòl_ Ð‘¼ÙÙÙy}fÈ7UÉ6þ…ÿwWÕæxõ㣧›ðïîaóçë«ßÿSã“ÒUŽm®__ù%lcÙÆ(S:¡6×W…àÛëïØšŒØðÒr ®÷W7Å_Û]UVÊ2«m1 Íão•“ÖÇíN^:W\ßÓcaX劜¦G"Q:«ñ¿@³âÝ>¡Êvé¶ß]ÿ c\¥’í¢h;¡J«µPowÒp‰BÀ%×\n»cÊÐ#¦¶;çðÚU©™cã½`FÓ^L”J:¾¹þûÕõoo 3ñ4'KxŠ”§\¤ª¬ÊVI›Éæ”ù¸‰ |ì$ÏÒ•ÉÙJއTñˆ¬ShOƒ×È1É9y¦;neÆ–‡srSVÎF¾oúÃ~»S$«*úC×ÔCsz ¬+ÃýißOj·´|c8t»»öMÿ¿Ü~ö—B¦ö· /½c_xß¹ˆ* ×Nš—O‡»¡«[O:ã&Á‡˜}/·¦”Jnv£ìIЮž]ãý”Ô[ÃúØØ7}ß<4mÝ5Ã3šM,ŠúxìÇÑ.ð°âÁ._†Ð›‰ÀœyÍ'ªßWÃLÉ,ÏåÙjÇF s®Kθóg FZ® é‚+[Ë¢ ©Ã HEÿ&¡jc¶ò·G\‰Ü÷)ÉVíiÜ*ÈP}$bEœ8¬8mA³è¿ï…ðùŒ+ðkaŠ¿4Ç7 ×.Íh¨Ó¯®¯¾¹ò)\mºKS7ÊçÀ•†ÈÓ’ò7„-¨/𽘡ÖðŒ¥ oŠÛ¢¾Ý–k˜?k–Õþ¬än87ú™T¦@ºGrß4·©>zÒ¥c’É|MÐ=SÅ>-!“ã6^“$æ¦èƒÆ)ê.©OEõÆr\k¡…\Q÷Ó^ý©m’ýÐ@;Fa˲h¿)Ž]½åÙâ90³¼x•yÐvGÞ!UqG[‹Ê?øíŠ:õÁ}´°æÐ†uô´·pQdÞݡޜ²ðc}ŒK$/N¯¼jì÷¹É&sÛøz]ž™sj§CWÉ™eñ®feÞÿ$Y¾Sí• +î#‰(ÞãìüóÄd¼Žq…Bñ¨0 ³c›1Kü%(IϤmChƒIÞM2Ü/ôè=pV·°æ=Ôl$‡Û\Ÿõñ”š2¼§³ª8½×`ع/àóÊà Çû #R›âåbù›L³´šÁ­Yœžƒ»|¼%ú ÑFÐG».WzÐp—¨0Ðhÿ&““œ’ö}<:Ï…¬‡¨[<œºDæà—ˆ;¹‹a”?CePÕ‘¬öÔÏ" è4ùÝp:æxéqÑ XÅ8„ h;U†Š  å êþ9P1 ûø=©ôæ&Ea ÷‰¸û¥+ŽÓ¥UPq˜+ 3Ÿ^qðœF³”a¨8A;pî¥3^æ²´HšìÁ€³(DЦÎÔs÷as¤è§ßùD¨f=JÛN$ž TÉ‹ÝrÇå ZvcRÁªÃ*”] ru¯!½+ºöPÚ$Ïmr 8](ë¡Þ¬øìÿ êxBBA7RbÍA´fÖ‘=(S$¾ÔgØãuZ‘»‡ðH“A¯ad%׫ªÒ1s0U²!¸Ð¬ãì#w•§œã1GC$DüpôyövÊ­ø^¤›ä<°Ð6q‹Ó²¹ŠN`¤Ñ ¼ F'˜Ò ôƘ_‘¤‚{pN3d¿°›ÔÅ)¸ûÐO«¼¸OXÖåe¹?¥–ª3eg”¥?’.µ‹ÜËdß Vg‡ÅÍ-"2Qôms¼'¹¡uDÀ!,'}¾ÝØfXFBw˜((0eSÄ5zaÒ`íVDNu\Ca}snš9‚ëzWÇ£ŠÌÜÝ>ìX†1É fàhÈÊn–}› €b0:E2N~>êF/û:‘•Ë’mÑ’6x=ú®%ãßY¢Ù­Í4f­Ðê„23Ã仳'ì¶€ô¼Ò¤ ˆmeœ¡¯JÎÈÿæXFr¨ˆF¿¿Q Ë!yÕ – ÈÌF-2‘Ûkñ¯–iŸcìdª‰ò(a—fZrzWÊûŠv…†o:3_˜ÍŸY¾[û†ÂŸÛ‘×yyLžÂžÎ\çÁÝ÷a9Ë=c0os •1fø¬àìÓð^í„„lBÐê,cåæ ‰ \º‰y rÂçb¢RnepOh¼S§çÞ£ÿ'<¸jwè_Lƒ¦Ó¦–~{üa¢o!–on÷ôvúYŸ½œÍ­ ÆvÓÏÃ=ìtÎðÙ‹eîÿ]˜ÏD“D‰âv ¾ëO™G–?$‹ì¾~ ÉA˜¥ö0H졺Me‹yˆaÏ­¤„rÞ R1 (둞k.8Mp1Å€ÓÍIMAýÒS°’ ±Á¬fÝÏ9¹äÐxÊ!ç+:?·F1È 1W[»ž«—XæÛ«‰OV±•ŽfÒn¦Ò–áHðCLa­³”¤XxÀ;C5"øÿMòÌ&×2–>6ϧ³Y‰f¤Ù]ð}L!ˆ)m屘Á&MÇ´Íå¬QzŽ$)´ÉH_#‰Í‹pfŒ_%?<žKEûÀH¸%¦çóî"M)ß6Ê Q‘»E3S·UXèÓŒxJ¥'h\ùJý:%¢F„–ójí']Ó"ßTŒôuÉHKT¾¶ûçÊ.eµÿéÌÞÆUí¢ðÓ/Î^Ò|âLIø\1Ÿò’HØ¢ë‰o2fT‡;“Õ„ ®Ç!§üúIžX-§4‹Œ|3¯þ~jF˜üôà'Js=$ê:„­êÑ(cÏ–ò6¦YÑgƒ.4^ÐËpoLb­Ü‡án×ÖO~w'ÏÎ3‡‘KVÎæ– 7%‹Kf,¼Â÷­´ƒb>`–›k q›{JæëÑ® e w ä߬¼J°ŽúW \+PU7ñg%C'“Baê mC€±‹ÏrTœåß=Rk­Óy¤GI4ƒ×8ôta?â´ÉG2‡ú¤Ïžá¿úù[+¨Kô,Q=³dP,’:…Yü”÷ ØÐ P—þmщåèØo¥çMG@˜ ´ßu€)‡À¸¤Þ­vœ ±4"˜ßW¾¯ëÔ˜B‹]ç¢ã#á—³û(|îà5µLÂí蕨{m…ïgpJ¨x:~hÚ]çY Ò3? !/¹©¤y+µšY ŸûVaõ‰°xçá»4ÅÔ£¨®å³ìcßmÍ2q‘3µÔž!Àº}þÏã· Ku{YÙeÕ‘$WgÊ *E® IÎ1.¹4Ù» °eÌË×ù>z˜Rc¶¡}œŸGáårLS-ÞMñüñõ§vÁ¿y¬=õÁ¡¹œ‰’Ðõ«öpKþtôŸŸºý¡‹Ý³+Ôw/¦ÎoëW‡öv{óoÂÇÿ¦Eß­Ï’Râ‹þü%>äe+~AÂ'Yðûÿ˜¾á‰jºtÓ%›.åti§KãQ[úba–Ï鯩C÷Ÿ¸°xJA_ÑÄk¦'‰ª‰õÿ|¡ÍÛC×7w§Cc~x­™Æ¼Š2ú®) hV•³Ø?›R¼mºcóØÜÕô¹ºè8ë›èÌ£Ì"‘™¯;ôޱR*Å‚¯à«!´UêØŸŸ•Ïô'ÊçY;• !†8„Ø8ú =gÊ×>¸ÆaÞ™!%ÓOr0W•Fš „ ü¦~†!G¥K!tÊð&¯gÙ2Ïöà L„ÿ?s±k`ÀãÕ‹#,òS äŠï;]KÂk*¹6ɵôЦÈ`¡´é-‡)%RäcÛycHTAkÄ©r<–T~0Ø4ç?-ðsP:*?ƒ\ôöÇ™ôµáØIà‡ˆiÇqÏÊ‹—£åd}M('¬ýõäë§õéöHöµç3,j;ò–²èŸ|óßx¬}eâošÅ‹˜pܯ=ŒqôÑLöaC^Œ!YCƒ¦…YoT‘›¹´q¡Sjz9,™ˆˆ(ÙÊËa”QRÒIºdï‡Ób:û:ä)1OwZ{éæ­Ž8ó.4øAÓÚ'žò ƒ\~D4=‡ ¼sKçBP¤¼oy"I£í HóÓ0O€~PϽoà a£‚þvKãb5oû<ãøÚGⳕ¶‘0¶-¾¥òt>myhD ó›«ÿv.‘endstream endobj 471 0 obj << /Filter /FlateDecode /Length 485 >> stream xœSËn0Ýû+¼4U1~à×]µi£JU¤*‘«,¢,(7ª JÀôþp?£‹Á¨Í&bÌœ9çÌØó ¦LÏò.[@à#x4Dáò*[xaAv#§6ÄPh+0—P¨)TBaô-@\'ö§kµ+†5“¾ÀÁúò¤¡©–9×tÉô+L®5zLRÎ6Ù:„¹¢Ä =f˜@-§Ä\ )úÖ#ÔN¥Oîí׺HWg)XK9ûû4 çšy}3¸¦XE„@c”-&±É½v0IN%rEТ‹Ü0h¯€}w‡>¯vT.9zŠ8ŠÞµKÒp@ÝL¥r“lŽ e¨Š*þDƒégÚ ÛD‡ÁíÈN.cÑE4Ç(±Ö)40¹¾mz7ø&ÕÔdŽvT±#7ŒQ*i~…%÷¾ú¡q¿Ý|Ž„H¯´³Ðmt«ÿIÖfÕ†_g¶É¿_n‡Qèc°®G±¿ÁõÍvHb=¢ËÈvÚÍé0—\‚E¸ñýë B™øß†Pæks¥TX+Ö¤¬—k…ŒeíŠç%.Ü´=³Þ[6QŠsƃÄ÷›«ÃÆöv÷>&ÚQ×Î=²ì|>ãÕwÖ¸*k:ß“ÝC6¸¢ª²¹·×à/wCendstream endobj 472 0 obj << /Filter /FlateDecode /Length 5939 >> stream xœÍ\Is$7v¶}äÙ7Ï¡|š,*•Øi"¬ñ84¶òÈ<8¢Û‡êÊ‹%U•šêùõ~  ‘$›M;}hfÖ‡·|oAþ´z±ð_üÿÕîbX]]üt!èí*þ÷j·úêòâó#7}‚X]¾½à.b%¼é½+g\”Y]î.žwߌ¯ÖŸ­î¾_ý`”Cè¶oÖ|òÂ[ß]¯7J©~T÷õ6ovÄVz ´JvEßÃgØY÷ƒèþýgêj‚öðþ„ï%ôî¾Þn²AÇ>K?Ùîùt‡ñx·7¼š`B÷ÕÏÙ¯¼<ìDú~ÐÂv§íú.ÿ hb‡œ&JÙ^¤Ìåë‹N­/ß]l´«Y‹oŸw¯ilí%,q{ÚöëÕ0mÝ¿®=®.tùô‡S¾ÔHƒ €Ýa·?/`ƒ°:ëX¶D" D7nOã·l 6—Ñt›Þѽ\opÛVà”z€FNvWÅÜÌ×Ïf{=þ5Qüú:MdÜ'2†œŒÒÀj¥‹düÉXSÚBØ7yÞmnéhÄ »-—w¡ûÐÜöÚë{·ZàèÚÅÛöL„1Å[8Òø^Ènœ(ª»ú¹¯ëޮϴÙv±CèöoãŸJtÛæV„½ûˆ½tæHåzÌÕF¨Þè çl9î îÉúˆÜ“10ʰöHðn{8ñý¼@âÃû@Dx9‰ ¾4HSòL‚ßd?Üd‚=æWitÛsaOÛ—Ùãõ›ØxízÏZÅá ×ç»’eרpŒ÷8FZ¥ŒgÃåZæ¦ÐÙ8§DžI‘u@ðò¡ö^j¢ã\×°ÖäžÊ͹‹ºú4 ¿AdÛå´8ûÝþ0æë¼Jë436…+­•98ÆûÕå\\þÓóîÇŒûšògÚEÅëU±™=îv`õ·7±…¤ƒ¦­@cЬ“a³¥B{Om€É+HüHS8q¢fжcõ0(S)ªdCJ"»E=7±?(ÙMŒPt‘½d½jlµ”{:'¶ÃmX˜ì”V.ã!ÄCnϰ;ö¤EÀ@(‹ÚÏðríÑ‘Øa ë±=–ä>"#±#sð‰¿¡w°—d€ïw9_”œð HŠÒĨìRÔu07,ãXÑÙ`áÏ›N;l*Å`úAÙÿ3㡼 ÷ .“ñºÛz0õd-àhÅCt)Oð©àmމŽÏíçÌœìÒ$0w-×"ZÒó.“‘ÜÄU¶æÆYò%þü6r‘š³¦G3TÚw²Q t¥äz›12‹­–nÐ]ÎàiEN[ÅèÖž¶×ìœESÙý–Q’-Ï'@° Aë–Š=×ÔÛ¨Ú ¤‘æ²FÃÚ‡Ÿ¸lª´ïM®w ˜é.½:#dÒ²ÿß¶—Èdÿ‘ ¥•à’‹5¸Á§Á[Àî`®€ Óß»¢–7JZŠˆëÄÇWRj8^gü¶‘ÝÅŒh"ñ`YF2üïf,•Ý)¶JÔ Às.Y~½KÍ Ùvú[/v]<¾ñý˜?æ5šâc жI€ü«çŠ­Ö2À´ñ•Zßý¸8Í)í¬v}#©’¶»B"Þ¡YÑG®˜ƒI&'Í¿8<Ϧµ>c÷îÛõog"å{+µLR÷¢c±R­²¸e%M‚­ ŒÈrwÿ­R®«aXXÍj£zaÌàÏr –6jh#-¢07²÷¯á˦ƒ} ÆJ¢¦°ŒfÉ2ÏPñ¥L€ºÁÛUÖðy÷/Ö¨þ$pÏúßPt¨fb­˜î-.,1p&®–ÄŽ† ¥ÚŸâ{PÇJePí=]F×iÀ1ÛRšx°Fü– ¦#ö4îRÑün ‹3%‰vú»t/£# ¶öû´€ÐV‘ëo2‹|,|hR[àð‚Wwb|“›É¨ç1d×À‘Ü!_ „´‚p5îŽþVse…ïÞ`I3§8÷¬öx¤¹Û$T d˜c’†Õz•[¡Ó1öù sBk…»oE'ç—Fäcïg¸zK‘†ùü’hõ&Œ·%Š~±KzM9ÔQe|Û’oÔl Œ^ÒlmÝæÁ0¢Òz´nûU+´îÅš49`5upŠ>SX‰PSr÷/Û™Ñm|¦k¤Ù:'‡®Œº Ôa NAÝ—È^è9«ÎðŠhÙm)Åô\üjÐöàh0€Qóà˜ ´\Mñ1"Žy A ¹×Ž3`@¦T·Ö·`š)pˆ»P`= ƒñ*×·o"±l~N$i†Ø¾iz AÎ@¦w½ÐV<‰ƒ‡b 1Á˜þTW´¹¦§¦ €~ÄÝÝ~Ÿ‰_±?ÌH‘€ÌææxŒâ¿Š‰À€]#ÁÆ+I´˜@ÿ–#”¨Úæ°$×LXX*G¼`Ñ’C³<2G™5…6Ï“ÝõöpU«iÚ›%3P²;Ábhùî /… 8eØ7Ó×ì(L‹[Ož‚ˆñuÎ$ãU:GÁQÝx\Ešiš}f jÌžÊqý~mPÆÀ;Jô+Y9E›’.}ä®LmEp~[C4å4™å²'=àé 4—Ýe~tj.òIÁLᔊ|qjâ+øµ=ÅÙ9O 8ö-ç9ì tŒbżòžgDívpk-»‚t†4èÏóJsPœúí¹Í£ \7‘#Ô µ€{“Yâ5.Íb©ÜÌ—f=µ™4®3…;[°B°FPÅ3ø(çR b-&C]‘ÃFíì(ØÒÈUÍÁåÌFXOÐ~¦Ùqùm4N]0§»¿.ôÇÅñGµ£õå|oË92‹q_fº‘¸) ÍÌ}PÖë,Ä·â†LÁ6?Ï“çÊ"£4reñ˜o 9‹¶ Tì÷%Ÿs\§4pýmÌŠTœBRE÷°ð¿¸:§’fyœÅ~DîåœÛÞÄœ‘)Øj¼ÊŸH4)¦sG<ë8Î,10¯1Ìz3×óçF˜àŸmiðÑ+—ˆëªÚ!å—~òõ["WåI™ÿò¨2O§G Yf.ßEXî–Ûá!÷»¬W­ÙPÈK˯4h pa󌶤u^ÇiÁM\”‹¬þ§ËEŽ|³?rD¹JÄ>.’\Èž 8…cþ ËÑe\¬8Í×±‡3Qã‘GI<?`y6·,§¨}²44GƒJÓTóœC³3i ÞÖέ%þ€J3gÈ åñÌóÈé»]¥2‹²œÔÎEG§3U‘Ò?´P~€)^ü>c°;Ëk"g¢ÕÊšhQþS)5ÜÇQ¸®ù°¶Ê$•š0ð†‰$MŠö¸ç§YÀ´f jdä<ý Ç»#cø˜wNœüP¦íæÓÎíÁ¶3+`“0/Ƒ͌&FñÞ9¸¸hÀCãå íÜŽs¬½]h.­5U»”Èâf>¥ø.ð>ÅLjpÈLëaÜW™[jغ¦%«kg”ðœ¦_H¢çìy>“ãÙ’•‡•L™S 2Ç5%jš…é0¢bÊ, x‚>…”_Áâßn^t/ÖÍd±¥xE–Ôáeƒwð_÷¸Î­ê\ÒŸ./þrÁ5ŽfuX®m¬ü¡XÛˆ¾°Sb¥=HÆQvÆ•Ça?zˆèAË^ 3‚uc E4¸»ùü°_+ÊzÆçè{Ùîê°}=¾¹Y+AŽðéü r Š¡ÅXJ, ÔÑÑÕJ£Ò?¼9²­BÊV#ò,–3²ñùgÌd.Òù°+=ûÓàý\Kæx<Ž»ÜÝä–ùèàï¶Ðõ|f}»Ç|[™y‘¿'é³H4ŒåI¤RG¦Ù(!Å{B¯#Kðo4%YÉm„Û 'nJR ÷]e{iZÀ¯3ïŒéZúWõîsU»ÑÑ{擺­0ßY{ ¨aå¨vÝnÏå0^Öª!¶÷/ðiñéB+QðÃ~—úú¹ã#P{ 8ñ1­¢*z·Wóª+Jʱ׃QÙµë¿NdW—ºÊ Ýöºâ©·KLRê›è,*£eнKEà¡ÜœÆÍwkC¢6áåxs$ÇMs¢ rzSÎ@ÿh­¦‘r(yšE‰¨òw.C›ÃªS©ëJ„#Z®ãi,ü¸}Re*˜P¡X ‚…âßy²Âý:.èòž×›°L>oÌ|â~|è½vŸ<«O°L€µ¦$å! èxdØ,H¿ÿÀ“°± wf”«0ÅÂ^ÈR2wyÉæ\—–R˜Ýé/ÙýÀÁ6 foß5§ÔˆS¼{ð”mUœ2ÇÃT•é´B€ IpÅbe0¨Á| ´V.ÜË6M|Ë‚UâÛ6K ä¦;>÷œíÄ'Ï‘x’ãvm‚ °!JÿzyK"oiÿ´¼>ew󬙵O5˜su…bç~£Ù¾‚ +0qϋƴT!CøÛctd+ã0.ÍÖÝQ£5šqºxsN¼‚¦Îj <°óxvƒ“sÜÕ^–5R¯àPh ˹ӑäAÁ0ä!¤èm ¿]¥ïá=T ×ý1-]N±Æ…¶·ç¢ÅÔU TŒŠ]ÖŠ"×ãì–á¤ê[Á’ ?pøwVôä)Pø¼Ëó3%9.ÅzÉäR°ý‡çñ¨7rÔašˆW¦Ô爫âó&ZZºÓÚ¨nòDñT ¶4ÝnŠuZ./€Ä,LÔC?q¹árʨ5=ÒqÑìFÞnWb(@ÿ¥ÊG0C…òóSH1ÔI0‰D´,ÝÇ#ñÖ‘!g<Sz*¢™éžFƒ§ü®ÕwUÔ þ„îßOõ 5ëÆu¼*?XV<Öà®Î«¡aSÝåTÚ"Cjº¨ÆLmTYõ@/m¨j@gÉm)Í‹©ŒC{ºr{jzIvuVßé%É^‰É”ÌnÓlÚµêË[…E<øqrª¨}}™ˆ!0ði!S±fUòð 4¨É† ²àÑÅd#Ùí(D?»}K[g±¸Pɇ("{smGl Ê|–„Á±d&ä"’åø/I_¸&Ò ºÒÆ»)Vd´ÒM9;Ph9dÚÈ´M×*q{Bv•Vn²þíîä2 >ž#aì‹$ÅÛ´P]^f»>¶eʃCÈè·£”ìÛk .C“‹kÆLk)ªqbŒ Fs§uËø%Ð Zj¾‹gùÒÝŸ2Þ*/óææ¼¥ ³k÷±RøÀ9f£­i_.)F#å@ N0)ð1PdDûøEá+†;–õT¢äˆqe‰) cZŸ& b^Ý•â‹GØ •?Ís¼4èŠYÅt—NäÕÀ?å}cøS;4–¿YÒLÇ8A]{šÊlÀh—·µ¦ ÷¥-_þnH¡#§a¹¤‚"9Âäé%òäÖ›“LT½™sß±ÏtÕûÞØçcõ¡²½‡WÙªŸ$S#µè…ÒŸŸªº-EªK¿XO±ñmû®ÊƪÞzecp–? Ô}ÓÄ+š Mº²R¢ºŽ'R.§ {BoÁN5¸Ä5úrj6ò[0RõCY¡w`".øï(¥^(׸™½Á*tŒ{m¤B‡X?>~ƒuιî‹wM‚Ð`ðG4^ÑÁ}¼]aŠów{9ê+è|;ñ1EØM¥®â“hl…Ze-‹ûì¯[wÔñn4¾¼.ߎº Ü Ëûòt<’MòïÚç#{è>þ|´s¿Šó™ØõÞ,ÂDõyÌ·‹†õcNÊ=ô pg³ƒ ¤YkجNAtð©{¨jGLm—«.аZón)®7 |Té ±Lø¿m h-…WƸÉïÛ£øsae˜2øBÛ¬¡b€Å•¡ŠÜÿ`fŸ(xxÙÙk,ð.šèåêé¥MÍB¹¯ÆWW<âcnS-¦=ïÊvïÇýõ6­”î§qa,ß÷9b±ÅÛìG«¨n;ëdd¬,5—³áçyÚÒ „µÁ/\âÊy¹ZªùŒäá÷ã¼~ncdïyLJ+ȧ01¬Cw’èîÅc®aÄÎ|þÙMCèÞ{ô)g:~•‰7¿m¨ß+9D·NÞ}y’곆ŸµD†ŠÖ&‘Yšo‘]ºú(Ñ0¹®»îÈ̵èõ¹2âžÅœ7ÖÔx(¾FpC/ÝÄóó"€R‚©bÀºªTéõ\|lž_€Õ@ ÐÆó–Oç'”c]Ìiøð„Xx ¿R“¯úI°®òø JWŒû©ÅxÑÁ™’Àgv0å'ì®®Êbõä)`=ºk™‚Xùrþù .J°&LcªØÖe³|FfàpLßU[kXŠxÂÝþŸÄºÛÜÿkçË@ å}K”¾Óq'"hòp(ö¼û+^1ÁÎÓ‡fLƒiÑt(¦„óq¼‚½YÊSˆ%•õfªÿЂ¾¨‚b“¿i¦¨éÏóFвÙ\ké|®s9å½¾PÜy`x‰uéüz\Þ¸s@=üŠÉÖ¿½ Ô‘/ŸÃ@ÒÝð,(×à›¿ãs÷¬ù=Oß Õ5D.þH…‹Ãî4 À~yÆ`(Ó’•´Ï¼Z5 Ü€ýÕ$U¶—&–‡ 粆ûV²€øùaαŸ>õåý• Zr€¸3L.IÒn0Gjè£b¸+ö§&>«–¤É‡Šë¹s«çð‡ü6 /­Kü> stream xœÕ[Y“ܶN³!y˜GNì‰ð‘ªÄqÙN9ñ‘}H•”J»ZÑž‘fF’å_Ÿî@$¸‡Vq%¥ IÝ>¾nô¾\µŒ¯Züÿz}Ö®®Î^žqz»Šÿ=½^ýåüì£ ¾a¾õ|uþì,Lá+ÇWV[æ¥^_Ÿ5j}þ#Œu¶k,“gœ_œ=j¾¼\oZÖjÇqÍéÔïÖø¨½r®¹Zo¤Ìûæü9½†‰­oÊ1G$™w?„ †7ß.²QÅ.‡õ¿Ïÿ6cb“(ÛHÍœ1¾¯O°$wHáXäøŠ–WNÀ§íé‡%*ð·iNϳA—øÚãÍ¡[ “—ªyo jM³[ ÇZÅMó*ãöšÞrã›'ë Îæ&ì„u¹jöÏâÖdyè_dËlKêWð³;õÇgÙÈ·Q¾áé*®ÞêÄMx?pcš«Cw‘O±S`JzÙœÒJ¾yšØçÛñ H1pÐõð ˆäÂâBjFYƒpúºÐŽi/qg9¼)Tì)ТÉ^£ÚpÉ´òbuþÍÙù5¯ûý¶;]m›¹T¬5"±ì%žd9 :"Ÿ œd¤ž™U.ís>[·Íñ2_wY®ÑJ„kže+å2Ëi*¨=õûdXºé{SÍE©ãÖ˜-[1ËÑX»ãÇÉ&}á,¤a¶u«ÐÌZ%Ð&~r+¥õ¦¹2¸•æqÇ«)&”ð6¹ž_Ö|h0ÂOÖ`ý†ÔàmÕ9pøœÖã5Z"ZeóYÃòáŽYg}¤æÇ1p|²Ö·aH¹ŠcܨÖÄ!¿©­~º‘%¯2ÞÛUši-¹˜PÕ.Rõ¨9öWpòÕÆr”jí„:½/œ,1RRY0R=ŽÉÚÅqür°f)ø Žh„%7 }˜‰ú,Ç£@ûZ®! €u›Â®û«ç¥s£ñ­+GuÁi)ÉÁiÁ Ê­“G•`uÍèꃙw…ÃvNó”oö‡´Ž^nü ÎùÉàw߯—ïúÓ@øæî*Ø>WV€K=½Ê<ÁÄuÐ#›«þuˆŒfâ,†9îA¶ñ44ÑzÀD÷$—Û~›û»S¶o¿~v6ˆ;‡ ãÀ§ù°|Ô'Üà¿SìnÕ0Ò*ƒA_;+—޾xØEß«+Ђ‚o^¯5Š_Ú¦+¸-Ö‰1棴ZqŽj"ÈúQQ†Ð&˜`ën[ £Þ­ñ³ ôdó­fµÖp–û'ýîH[Á¾B4-¬…–Íåkšf î\ y¥NŠĉšù04’o„×9î LDMáb&#®¸¯ëZèã8ΑÛýñg~{Çøh”e îÒÒÛ ¾ÑÖZ”£KU#XQ„ËÀ— „Vk>-ŒÈ¦»Î¶‰Ê%uÈü¹ƒwo“ÀLŽé·X\ð.(‚Ä) Ò6×%;Ç\˜‡ÂÆ’ôÁ’»(& '±ÆZMô£BÝfgä–Gö{ep“,n¿xŽ5"@&†žf­ lyFJeN²Ä¡–&plûvízeÙ°zÈ‚œ@à)Ï7µm™ÒM‘·‹È§ùkmÏŒàcx«ÄTðÊ£)›õÁkÁ ÛrnäE9;.Ñ+8AB¸§9†?Á¸Ä}qVÿéO°(¥µ¶ùôÇ:Æ0L:X… ¦$Dòq rêvȸˆË)ÕÌXH:VÂ7ð ö?ÕCµ ˆlä£O^¬+’€ùZX\ÞHˆ‡aù* ³LĵÙÈx8 öµÍõÓÌ8–ûìñ_>ž{ÁôÅãAø´)„ÉR'ÓAõ.¥ÝƒNÊ[#Ág ¸ äœ 0®W陟¯ `½ŠÓ¥»Ú¾*"e>™#b¢l,eÜè¨ø2Z¸Ùga#ÍQ¼Ì³§îxîÇ8;G,…ãÿ»ùÛM Ã×5‚A5]¹`îÞ™^qS†SÚ{"˜ƒ†¼b$©¸+zÞÞXýjZ„yªé³BPM0 ¨ÝKå¦ùS¢P,°„©¼„ѕʼnbÓmÁ€)ˆdíHä~ Q2õ¦/T2FWÑZÐ?µrphѱ|\Hʦ<I(­—ê¾*Pæ•e¬ùírn›2Í;H)í'‚•ì!׿܎õx†žÛ§z{ºî-ãÚ®Ç ²ýu סíz†1ý}Ù¬Ó L±îm–·diù’Ñfì¶Çý˜§ –y€÷dlBQåÕR„(Œ&Õó¿v ¿âýÖ¤8FÅLÊ­½nf%ް‚^Hø›Ã1ém(*&¬Š†ý,ÎÆ›£éMÁ]í“Xçe´ÉÃÙ-ö.BDý>0Æ´jÁÀ{QDÇ*òTœq.S…ؽ‡L÷ÿìÆcÌÞ¡ ?¿ð@8|g¢„ô˜÷PAs,1 [ù”0 Ä)N–¹YûÆ¥‹sW«‡ûÈX³ç•q2ÈZïø^÷ÕÄQѽD ³L \À‹Ñ2+FÕ]÷ÛÓ~×(¶Š8}ѯ±ð ¦~¹»‚çÛªËÓ{U!5:ÃT=ì×úS`ÇQí÷º;úŸ“A”}p®F%ó¬–Ü tq¬šÄ£ŸŽÑg¨É½?h§Þç0 ÅóçÅeÜM†£˜úxòã´€²ù•nÎé2ŒÇN€›ŽÛâáŸlñöþ"î„?‡.çáùÍ^R𠩉„¼ ]50ÎL;øÀÏÆ<õqóx·t£i¤¦ &lš/ê& àS¶¥³¾´eWAʹ©Y¼*ãä:Ǩ•Zèj¶LǰSÀ = œ.@ö©˜n5¸¿BÑǸ]æ|Ô¥E‰Ò ¿!rÞÔ¾nöÂ39š5¿œ ÷V-F÷S_Á¼UØ—1EÆô^Nä[Þ†âÎ^O:gr#¿º­’%´¦¢m0èËjY²uK¨Xh¬(Š…“pÙ2¦½ÊGŠ…p'[™€ó në¶Iûº„NÃ]Ê‚‘N¯[ƒPk]?x†nÔ-g¢nåëÄ‹>ëuYK)\àðÛŠ\é*b~)×z4—Àk.ÖÂ|¿­ÖxcÿB±|õÔ,àiÁyõÔÚÙ© ºvDwÿà`aú$WÍãOŒšN»T…µ75àL/OUÉ™%]o*’µÌñ/d#Ëù åmúÉÅ* áS R¬IfÐÏo/C³¬7ZyKVJ1hZkz‡àvLuòù}&AíoðõÀ£Ñïvut›HñÆ|>’Rc°1 hèI°Â £"ÿsVÀK)Ù¡$B+¨Ë õÇJ‚BCl ÃÓ ñ®:V wñä6…Á—9^Q=Ã9m;Ãõœ&Î*x6¤åI"v Ÿ!ÒL¾Â0¼,õª|Ϯ؇ï£(`š²+¡át,q}•çƒOÂÅ’6b®’ŒeýUë‡Ô¸ or*Àq=¸¼ ø,ÐÏ‚¹Ï»C—ÃýŸ‰yTµ¡ŽôÝRqwm›ur3.Í ¤%5ôCÉ.³Rz¼fƒgÅoäYãÍ^hp‰x%öWÀÏ!t`%äwñ' ÄP4YÍ(cÜ;b+Z L¥KD¡ü¦]"HÏMÆ‘f*›8/]ÚIÞ“2$ú¹Yáû\#®Ò° † üë9b„Üyqº­B5Dã2¹¦%Erš&jú$[‡—šÇþTÀ‹ŸTzFІ¬Ÿ»òÌðzBµ.@ëy@Àã;wð'“IìC,ˆb;6ozV|aô)4.w¸ª'˜’ÙÜÌBeÚªàø±A#«û{a™Ì~)°I5Š–*æ%bl÷¥(le;ÑÍlÓ0 æ«iŸÓ¤r†t ­Ëð°PpŽSþ¶Sð3D©fŸ½SÝmñ[KâzÓ=8|Ó„žÁß+;ñ÷%˜Óaé}"I/вY 9t‚Bs -NÍÐzìÒº#Z'Æ”.d^-¹À).f˜iñ$ƒw3Ôaöc¸Æ’¶’÷ ´]t.t÷ŸOµ ™EíÀêk:Çùm¤¶UµÛÈØ)™w¡çmè÷Pú-Ýâ Fy1ÂɼKk©¶¤óaÊM½ë·è| A€6,´¸[ËtËé¶™ÅonôzÔèÅÁ“ÞTÙ-²£ÔY ˜ñmÈyvqk_à^.ý´ÚËl„ašÚ‹ÂF”m ¤SzløGÿÔš;5.r¦A¬Á™KÍr}…ÁÀu»”}Æ«7` c_;)îó?©mêçΦúñõM9“Üó"ø¸š†‚2ˆ·Cg9–¹°kÁBìcvù=•c”',t¿;Å­Ÿ¾‡¨ZvÌÎu[y*RÉI9ºµœ¥[´Ôr”£y¦b^ø^òØá(.,íe6зKÝföq†_¦&vI 3tI †ØÈ”ÏF½>7»5Õ#Z• ìºß…ØC)øqˆ/º%h2.N­VÛ-ȵ&?¹IKÀ¶yöj÷”\aE9”dÎeÈPOðáouj][cö†ƒÀÉåMýϬ¸SL£žƒ-I­o¿£ t€Ã¦Ð$ X´†€Uîüxø«ÅbEè¦!_ãá!‹¤…H‘%­\{øÐ§Ò!’ c&¨‚þJlˆ£IæÊuÅ)í ®óBZMϸsL8Žût ›yX¥{}¹ÍÖéw×9Ýý»üËeREèâ€wù±©ü$Ÿœ_„õy ÈêÉ6÷×Õ¢8^d*^D«ªu™ª•wÌQÏ$ê—EéyøPÈáºI$0çúÝB%?ÒE•Ö‡DíÁ:ŠÒ"g'%´´â÷gÿ¤ kendstream endobj 474 0 obj << /Filter /FlateDecode /Length 4522 >> stream xœÍ\K“·vUnûœo™M™“Á°ËÛq•“ȉoª\µÊa¬]¯F&—II–~}ºÀÀ`H®$»R:ˆâÑÝèÇמ}±èZ¶èð_øÿÉú¢[Ü]¼¸`ôtþ{²^|yuñ—[OZ×9¶¸úùÂOa fUk¥[eZ'Ôâj}qÝ|;<¹äø]Ëæée×vJÖ¹¦¿½\â7ˬ¶Íêr)„h»N4ßôé°Žr0[qÄ`„¼Éæn?ÁɲíXó—4U9iáùŸs˜Ý|³ÙÞ'‹¿|ÒÍWévÛa·ú{OS®ùòeò«çD: œpÛv’éfß_þ÷êï Ý¥2B·L¡d®n.uyõ †(¹` –U‡,¥d‹¥™i£®ÞÊör©:رãÍßîo·@ Ðb<ÐÍ“í°¿Ý›ûêŽ?ZXùÑÅÕŸ¯›/<ÃÒrà³O™Ì¥ë[à¥SÍkdwî‰Oëš7ñGàsƒŸñ±nVð™ÓcXú?Ÿ÷û8Æ4厴Ž2Í.ß}è÷È_Bèæyz›Ÿ’o«lâ:î$šaV‡ÓHOyCÔ8Rªõ¦ù9ŒàSÒM—™« _^6#¥Òd”®úlö€ŠÊ4ì{Oê«9èì]¤@5»u¿Z…¯N67©jîvÃzXõpÔ¤b°$œž7-œ¦çûêRidÍ4ýÊS+¹éd<\'p&‘ÎèLŸ¤ÏW›Ýmø ¾yáà0Í«McLNc·¹O ­_¡99AJ”Y*E:ŒŽØ?ì§2)fBÆ#µýön$…#çjdÚS©†g:*±q¨×(I¡’go"9.Ó‡íf6b¼öhA³¾ˆ4Gš*Ê}æ*"͵æ` AÅa?ÁöMó"~ U –ýnâO=;T|® ÉÑVd†åÒ­›õfi‡ßN⩇AÌ4›Ÿñ³—Íp?õ~ªwL´!º—qŽ:®ÌÈJØIE æúÄaÒÊ ífNØ7aĈÒíxÞåŒþ2i8¬¼òóÑQ”GÖñÖ_h "bÇÇ—!޳LàÙ‰þqæ3ýº XC0ÚÅpç2: pjfKˆ{Ö*G<}ëãlA1ká&„b8`ã2#[.9saÌ_k˸Vs Óñ¬rƒ¾¡ù<èÔÎÂt>‹V2ðŒ·Ú:KëÞûu ‡¼i`aÏ X¯ÕƯÿc™eÂT–ïZ!¹‘,9k­´þX) û{Î>gaHº3­ÑÒ.¸(ÂÌ R•±#~dÊt‚e´>«Ð*ª´çòÆ¡\™aþØo*LvË8h<ŒÇâweé’¦‹ëø"ù¬¶7(¶'èjkê³¼aÈGUècQ%HµŒi[ŒÈâäj![Õ œƒö\ÛK¶F0-Ëtä§U+‘]Ùh%Œ†Wh[‚´ºÓ€\Y+ð$ÞG\ª5Š›Sâ’¶c§äeX)ÒR`H ‚úh¼& ºŠrZ&#¯=Äd’R†R&N Ô!KOZIÓǹ³ñý.]k{ë§t²€¨Û0ŸM15>–¢ˆ¹û~ D‚ï[(éQÈ–­ÄLbÖò2~Ÿkn\m<Í9Ã5 UÃ-t¶ß :›Œ¼nî†W—1:Np!‰šáØF¤¨Š™ÃÏ÷”ƒ©€ ¥Àõ›«§™Ü£<5~öQ—ƒft¥ãž>TmI•ru@”„?…Ó÷ðm yüó Î|©1Í–Ín¨œ¿xöÖl ôñ9z¦“ë°* ‘Ú¢!‡ËdÕï&B'nyóz6‰·ŠA±ÉZ‰0}àô#YpVV †laåYÇ‘tï6Åú7a?ÈQRßo¥à•ü.¤*VF¥”ŸiÔ_ÏÕKt¦->}¡ÂF%•à ªºYûaýª `&¯Up‰´ñV%uŠG·àíà£tcŒ=À½(pz ÃçÍ Ï±ÿòD» ã”ùí J‘$RÕí÷™Ó%?Fj!1+F¢o +Ä4^H!u%Ë +ÄéŠM]8n♫ ©p°äFˆž'+¬ý¸i¢h0P¸1Qô?¼‰<Û©‹Ã…$ŸÇå¯)¹)Ðj ²zÊ8ÀodsöeŽ]zÎÌ4"›rš¦Ë•äqY3 oàäÒAbÓ™§ p4Ãú #¢Ñ#X7„•#ÖïS•»‰\˜©…!ð|›Mø%>úª±4||{‰:úÉ z,|OOÂæß¸äuÉB^¾ G(¬„4£a7Ÿ‡ïwhäã1Yÿ!«Ó,GÊCq—¹æiTbýŽ:–±ÚßÄœ)ñ£Í;cÔ)¡Tê‘¿`¡Js:‹l~{÷‰Ùà€ó/È×EH m2R‹&óñA·2æÁúZÎý´œbõïR}šTSr¡èVëxT¡:B~ÓÎ&SHD±©(2|œƒã *ò±bRÔ °`<Ð&JLs×?OÝðyøU¨~Ⲫ™ƒÌ]m Ë›0­gMbquHWD\³Ë."ûUVƹ‹û«tï%¸U±Ì#rUÁñæS«æQ†˜’\è%å¶Mr<ö÷…{Š¡¿Oé‚èñ‰wãà!¨Ú˜þãŽ\2FÕÂÒ×IÖå©–Q!ÕÊòÊZð^‘ÿa\5qƒ Uô9ô_Ð Žãµ(?›5ØcPõSÚ¡!×p?seÖ`ëúrÇH¹£¦ Ù9ºûîwûm «à:°n„üaíbU^<{–T^{/UÙKǤ{<Ýþf7øüˆöPX $‡ÏD‹xo¿Ù^Ö*€ÇZ+¢§;ïà4cý¼‰AõÀ{2tÏïù–jiÚ¹ˆAEõ:“Ç«÷dàdµñÏ.ÁSk’ñÑmà°±!nsGÍmó)~TT¨ý´xê?~v0!)ËC\+ WÊIª*¯Ãû"@‰IYVÒK%|Ñ‚cÊœ[3u2)N@bZåáx Y1g¬;S62Å¢B"q²@Å$°à"Š›+PI-Gõ•j¤ ÂJÖB•ÓǯpOÂÅ$ö‘L”˲WxÈâå 2έQl”ä䓸7døa¦b“‰MG!)’ßQèIMk´P*Ùp®ëLj6~›CK”wà„:Œ#ŸŠ¤`Ûˆ•@‹o44䚆²ñŒ2dåª-rVRµï…p5¦We îÚFÜ€'·}6KžïâÃåW²Ec`€1Õ¨Õ> Fw¡† ì²d¶_źŸ$¬K2 ?C7}6#c¢èò¥¾n±ï†È¥BS¤öŸ›}ìÞѼ‚à™ô8äçÐú#›¯gÌ%o*Õ£ÀÜ}XVº¶]IB¿¾MHb¬u’ 8Ò«Ó6­teæ.UTœê ¬jÍXªœË0:Õ5Þi“|èuê?ùY¿÷]oͺßo‡_«øÊaxÐ1Íùq.•Ãü5ÝÞ2Cûh% 4×åµÙN7zèи¥y«µ+2s‚×NÑÙOzìD“ëJ^ï¬öÞ o´4»;ZðÌðc"cw˜0cfWgbB3²ÝI.}W> j›=L®eöí˜mœZ†³ðf 8½3=º÷ˆJjE‰€óïPJä|_Á$)À‹’î–<¢(oÚÚÎw° é8JtpC[ˆ`³ŽÉ‡ðþu,Y&¾ü>V/÷‡U6I#XÕ¤ ~Ôü©ŠxªëŒ—2‘Ì4:¶":]ö"NJûO]ì„—¾ ƒ¬*¥!t>¤§‡.É1µ™“ÒÈÏC’RZpõ©¤”x‡õø„e—w\m'þ·eËÒÙ˜áñ%BRã_AüO¤Âÿ8Ra#öòºE±èäQ†nR QŒò*FÍ´ víýÕ|ÔÛŶßÍ,¼ÄïbÇFð†Übóv¢n²>Ë1Qp.믋÷v®Ò¿®örDL—G¾ÕÄÖŽÊÃ=ÛmG4È¢uØ£3];Ò‰oŸÄÎHvF÷·ý6ô9‚À~¸=P@-’ªùê!­åÅšTŽî3‹W¶8ÌLz¸êr‘ôæ.÷TMd?kúùqóMúÂÖ êÅ÷oiAà¼ì¢ç0á‡ÌZp%Eòvm†köo#Ë¢aÎhl]!’<®n˜’6ºXÀ7¿,ów4lš§ÑråëaU+/ªräOŒò= ©Ò6jªÄÄ=Úbò7zw³´—¨þ†ÕîÏÅ´ýùãììOvÖªHíÌ„(D”AñߥI‰m cA ¨ùæÿó“`îÓŒ:ïýª²ömIî ¢¶$—ìõ*|½ÿ}^¯*U‚kÅEözÕ¨¬TŒ±Óé£j ¸^¬þôÀ€]Ò x¹Š¯øs£ ɱ õ-7±AÀ\%øò‡—˜Pá[þ€¢¿Ûn~ZÝ®ß%p…_®˜{ÑÊ¥£»Qñh ;«¯BZ* }˜nÒŽ·ôL¨ð§"¾ì³¿ÒÐo‹Î]z/Ö⋱bËùöÿûr®ò/c•÷ ÒÑ+©À†õȯ’iœx¯VSpø2V©ëEßá™Ä¶×<ÚeYÉjr›è§WÞxÆóÅ?´px&¼ õ&NÒªŸ?KV©[Ãj]fÍÇ»!² ™>ÄÖe«C\ïÏö\kº «A2¹ÍŽŒ¢òDÚ˜ý$Î!©ç'Ó”åû‹ÿºœ5endstream endobj 475 0 obj << /Filter /FlateDecode /Length 5434 >> stream xœ­\[wÜÈq>'ü v|è§`b‹¾ÎÓ®½Î:Þ=‘µ|³ò‘ÔÖ G @â2¿>UÕÝ@WQ¡Ž}©î®ËW—ž_.«R\Vø/üs¼¨.÷¿\z{þ»9^~w}ñÍ+‹oʦjÄåõÛ ßE\ÖâÒW6Ê\^/ŠzwýOh[;ÖÖºR9ìq}{ñâ?ïvWUY™ZÔ¶.Ʊ»ß៦Ñu]ìwWJɲiŠëwô:VMÁÛ ØH•Mmñƒï`EñßýmÒŠÍÒïþçú¿‹¸Š”])SÖÖzú^îd]V †hû±k»+­-P$â‚a‹{jf­,>&„Y›¾»Ó}Àèì똮𴻒®¬*XùmòzÀÎð^¨â&]PGU¢x]qüZ#…ÔÜFÕÀ6ã6tÕ@ Ÿ ¬Î¿M:Ü'ϱ¹Rœâ8—uðXáw)]ñkëé´•–8AhT¹b8RšÒñ€ãŒ3±žr+a£]ñ6©1Öðã]vžHœ;‡S0õáÑÏ\ QœÞÆí°‹õM‘{„*näåõ×ÿþâp†oŽœË:X®Ô’Æ}KCéZ‰~\l­ÃØ7dnWY0eӨ⇑ŽvÄ%’óâ'|Û4•ȸþcø‚[7ùšH­ê|/Ïñu8ðµÔNÄsÏ.ݱCk/‰·á£6Äo~VØøtµx"þƒ*z6׿‚õÁÕã¤úN8m1ÛC²¢tµýéM:á8”A3})p1F¢fP¢Ô •„?kUJ8SU´õ×»Ïvaí@4ñJœÕÝ¡»G%æ È/N«’²hwéŸÀÌØ õÂ]ï? RâÆ@ Ÿ P¸;†A °†?¯¶8ÄªŠ“¢”fâÙŸÞ‹ûà´…-ïâ‰6( t òÈÊcxÊ娥¼ Çü¿)²ûØË,dJ6À^Ne‘òºL„ xÊÆ‘úlÃk˜à‡öØFÆB]{š*ÍÙ}OeJ·?¥<¾úÆ$Síû6-6åFlO­4gÌ_ÒaIÒÔáÎó?n@eQ~bjo¿›ÔL]Ç#kQ;!/#ð[sø u¥~?d¥.Š¡=0M1|ðÆrÒ^dã§Ëˆ…s5±êõÂ8ÇçéF^péÆÅsA^#uÄL¾o8  «&Su|MäŸúð a1ıZº§/tðuqýsÒîeòüzI'æÀã g¨j €êצ†m>ª.U+b¤÷©yÅ/„.îC£ÐøÏMnÃ{]?eôžs[cÛ߃ÐÙKC8ƒ?å€ätœlTº‹ì`ÛñÔ“á¡Ý¨tqJ·œ5J gìÛZ³Ÿâú3áþÌ¡ù™ðÐøZ23©C¦–5*÷å :Äï¯/þ~á±²¹ì¿#k'KYËK ä”@  (˜c¡ûùÛ 4ƒ„‚ƺB5a"`Í‘†–v7å’û­óĉN%·t¹_ºN¡U ûyi…)EÖùz*Â"ZÏ1ýÎ jÑÙb"® UJZQþQ_R#Tgð)õ\ÁoÔUëb`H»¹Bãñ#>ùˆŸ-…Þ êÌl´ã gä¦ #¢©Ü…!òkÀ€8˜QŠ\0¸"Q ‹";C¨öºãì‘ù‚Åg"h“ÚKV˜6LD™@°T|ê†nôZèÊJ<áù†Ì rí—~ Ø8%=0gg´¤ìC‹Fx Ÿßár êµåDljڀ°:Ú{'k”»‡8! fõo2©¦éµ9‹ÐÚ–p„o³ô ƒ#Ðñcrº}:î—ë‘­®—lˆšÙp•WŸ?ZôíÚ⯑XІK|BkÞtg@¦\º[qo®S¬øÛÊ‹X€LþC>ÀñuÄßȤC|É™úÂ’`3v»ò¸A%J!›7 È—*ÍÓ=A>U“ Þ<&ûz“6¼+W¡1H¶Q:ŽþÓÇq*¸qQsÀ{ô§êUcE¹4©®¦á”yºéB›d-‘|>%ý<ÐÈ¡±ž&Ÿ ae°¾§÷9˜¢.à·¼MÜêÓtr"ìþ•c­ÊTÄ6ÐÅ(›ÐNØç›N¦(1à áYyËÙö¿õzU€M {OBS»L°Ï1jR4emS K`”ëy “R—¢’l\Ê-ù‹‡Dì*žm"R:*ЛËÈH´€7œgßx­ÄûÑXܺã‡DôwþSp ?S—\˜Ž“ωcÚàê¡ÙYqq@™#ï©«÷«HJÎáj®Î(F/VÓF^M*!`ˆ€Ë×0„’5·$†Â”f隦CNàžo©=ÆL\ÑÞ²E$£f#ÂP<µ [&òISK£ˆS˜ÉR{wŒ”öáQe‹ê߆8›Ît¿ßn’½0aÑOGf¥À#`‡¸/9Ò,:<„Q`áÁí ðØÛ2nÎß&™Aú·×s˜Ÿ1ŒÙá}³a¶@ü„ ËíÇã­¦Ò`¦º11TkvÉŠf2{$Á4ŸKèX‚ Y{¬ .Ö¾ËØ"LÓ02]©@Uúi@P(pŸÒ&ˆ]›¸/þÅ7ᣀrlP±Q2;[Zg¦Ý`Ǫ£;´6%ëUS´‰Öj Ð}÷k ½a; Ê@ƒ“þycR sÄiQ²dM8%÷Ahßœ]OËÚPjTfšëy¿ €Ye9¾†"ß2]J ºêü–?Sÿ˜œ¨W…x½»Z@rÚ7gŸ©Gô}-, ±„öþÿ&*b›)Ê?… ñ}¬ûy/ •¨™EðMiIÎÄÃ&ø&4ƒÝ\B+šß-òìŠàøM :ÃZœØ•ˆ·ó2. nIíÖI‚=]Éá@Z2½üÍªÚ ñö„o”øýMn”nRý•óq©+çóTÈ’£óGö×á.t7ý;ò_jåTï€Û˜„sYø.‹)MásHQ¸º¸¨´¿B uö¾§©wªØgŽ%k4èCv:÷ðzz;ÒÍ_Î+M+‰âN.·Šbl”R„¯ºKb,À.®(ezòw73ƺðñ +ÁÖFTkÁ´ÿ5®C®˜?ïÀŒ)ùgþg;ÄH=¸Ò]:àš-Ñpv ¡Î©´·©u¢Ò„(^ƒjiJ-ês €‡‹ñ‹U˦ª`”8GE%]MVé÷xÛC(ñoú¡í“ Qxß׆ì>C«€¡­Hø âêME8aÞ¯ÇÊo™àжU@ Ïâ“Ê’¤ç’„5e¶„T2(»G+Òz‰Ã¤óêáÓÎ`£1¼ÉsÐ1ÖœïE%ßh;NAŒ yFfã¾I˜)%è¼d:jÛeim¼hÞÉÔð°+cMÊ)T5¥˜ØÑëªA`@zÂ3ŽÉ,ïmèi³ŒÌï¸_)>Ð*Dƨ?xx,ç¿È© % AÒS~d@ñØÝD‚e¦ ÷}{<.G¬épç<ßÕWڕƪKí,šVï¾þÀɇ¸UÊ-\z¯Eñ·¶ÿ7t hÊçxÿXà”åDQ–',}‹ @µ{.fagAœÙ6^E34¾LlºR.±)…ÁðxÉIØÍÌ]Ƚåu,½OÈHÒÅï<_ »Y²pëC/ZƒÝŸCÚ9Cª8ÅH(„nk¼äˆÇi%¹E¢HzŠ\¾¨ñ$_T—b‰¾°ã„ÖåcÍ•…P:]G3ñ¦ß‘Ír^¾ywÕÞß^Ý|W£‹+Šf/®=ìÁ1cÚò— Úû«HP©%üoeiÀ'#f}I›âÐùO?Ô éÁ˜°<ã,¥ÔÃÓç·¥{w²è—b—>{Éá¦Ó†p ý¶·æ²øÞØ1ƒ×b°6JxWÑàÎ7ð}0ƒø}ƒ¶É}rÞ‰uKh#]¦Ê¨Ìªd 34?“–®¾ï†Hçì¢êÊ«Š~Óè„ù°oC˜¼êí›d^A9²Æ×±£Û/-U½e¶ðß›µØ'QeõvƵÍ|Ñ1.Kl÷éöA3ÛDûaO@7,ÄMwÈë¡ÞD´µŠ`•úesÿ”ˆU¸r£²vcBÔZbiؤDp ûZ(È)ëKÐ\emŒW¯NC†fÊßãù£‚4`GV}€L¢ IBUÙX-ORK} p• 1/vaÀ÷Ð!n†Â?•þuÚì¤H®éÂ瞣P•Ô!ß/‚7ÂG3_÷’•{¤LÆÝã_Ã:j½Íp’>zãê÷ƒ„&dN„­¤q©¹-~\ÃVÒjZe ÞÿÆ#¿,X¿Oõáããßïfß;©½J<ò…%)C!¸¯ÄÛµ*07@L`>X?v‘>³ÄÄÊ(‰¹‰_[,l¯ä‹ÞRÏJœ5MÙ8ÉÉ%cm*MÞÊ·žB4]gx‹kË3ÙûÚy(ˆaÝ»0 lÏiJn”¡õŸ:"y ôˆš¶X>ƒ¡é00nv®¼GŠš6íL™F¬ŒˆUÃ!PWåµç‹êr"ɳ€1HX©,U‚{&óf©µ–¬¸ù´…YnCèOs—çù‚ 1×ãÔ¥j@°Ý,¨¢„ÛbÇýÊ`=©*>»ÎóÛs°ÄT#[ÉWI/+Ù”€–Ù¸TÞõÿO/+ƒ QsRAœ)ºÆ«§Aã6Ôöjª£F6í•TQwº¿ëœïîïúýc(sÆ3 þÒñ UÍ×kxeeÕ¥ßhJ{Kç=º ‰é«ëü‹P…§ËC×6-,9G"7_zy]|÷}ÒóÛÿø ö@jW:‹Vgа?1Uú§SA )6uñ~ÕË5uik5%,ïÆyØr×Ëh@¯È*f³Àh<Çl©_Â¥k9ü3&0ÿ }z`…+ÝPÁÀékšÆ„ªC»ÉKÁÐßa.BúÕkp``íÎE±c¢Çóë1 ® ÇF½¨ñÕ•¥¼{L …~|¼‰.S¼ MÈòpà!‰þÆ8Ã8¥ÿæ0ñéêazÜ9Cy5ê†5ü˜cLÛýu%Êcå®!. ‹S·cëƒfžŠ;äX‚WÔ"‡wí·% ΢gãw%麒ڣ;?ý´á}ã@L;Ì£3Ù9œxÂäð¸VŸ"±R°ô[v Œû±íÁW3jâi^‘}hyZ•*%Õ~ú C_HÛQœLúê‹PeJé!fŒ{ß¡ªÎx£žåÄífb?ÌWÍNÃÐm§Èb­b×e| ¶(¦Ô±ØÔhž[áùŸ±¨•öE”rPyÆSq˜©\¦aÃ\5}–6Šk›öää×¼úµrŸò6 dBùoxþykP!`eK_#sP¡x©0f)jvÊúYv±/‘jH¬ª‰ÓX˜‘^n\fÚcQY À—%ëÞý”2ó‹ð^ˆõR­eÍ@L\Qþ VŠ<ŽKáz­s㢨ò¸^ñ ¨½ÌnžRsLƒr•¶¢Ñ°»1YJßPlùBÒ˜´érŠÜ‡RßLhcBÀÛÙdÉÛµpß\‹]û;Œ£÷ôeí K2œúM±é}0М¬Þ#ÙÑt˜Ä”.s:¨By‘ëiœJžOýënÜ0v¶ržŽï —`§º:àÑPh9œBP ù»gV‚Õ¨ðòŤžÐJJô=©zeQ³¸êãn9‚ŸºÅ^Ÿ«6Ck5aØ…ÝA …\ ŸNŠaŒËÅ o-Z,õA¨ÂaÅÛ‡Ãi2 ÍB—m²2ªžVþ&JÜD0ùø)‚Ã#Ü2ëKŒP½ )ËÇU°Ìçshó%Ñïl\??Fè}tF?’ÐÓ©Ò‰)´ë~ [èÏ”´æN Öž€‡[&Ë»ö÷/`³A‚ƤÀ¦/õ¤øY$t±ÔÊ8n½ù]‰Î% n®7-;ÙE‘‘£XãçjwýØš@´'¸^‚è%)f,¸‚óhnÇu¡˜Èùb^ŽÓüÉH%ÊW)OèSØb ½›eÄÆªx,*S`ïa*‚¹Ë$:Õ~¼ü2ðŠªkt%óè!³n· û"ƒXCž)æ?puV­¨Ðs¦ÝÏR-Ë0ÔÝdáÔöÀ2ìaTËcMʡ竅ý$˜âðùF꽑÷£fFŠ'"9±“õ ’¶År T†%€ýÓò×3ˆNÓ8nY·I¤Û'£¨…Å[Ü¼Õ ýó‹‚(øoš½†`ŒtäîR“Õ¢Ü` £Z©@5­E¡‰/Äõ1’/Ú{?¢ó€PÂ[x"råF¶‘õ:§Ï–G]aZ—ÝP_+LOÙ›ñWLœ?¬ë„vŒ{‡Œz8¬Þ­§›Ñ̤oŠÑí«ýd Ÿ ïkå{±´×+šÉ ùhélƒ^1•W,³JžvŒ*O阷{UÍk\ø¯´Fé+A§ßÛAl~–ãa˜×’À…Zùµ°­ÿ±_¬´÷¸þœ 2–äÄß¼Œ&„Zð#Ý6œ~åÔ¿?H‚§”_è2d¡;q¼å²õ»$›Ø?þ(A³¸¸›NÀ8§ŠôWTÊŠîÔ[ÐgZ‰N&i-zmHhâø]ê>î êô§Šã7áðQË<”ñ6tö#kwqÒsey­å&.+'°Ìé/4ÞËÃ*äÅâm°¼œŒçQ¹-Ù8'æ~x…¥Vá<î¦ßÈo*¬_¸k—èfùò½×yÕæl·‹’Ò=eã¨NeŽz¨c„(˜”x‡®Eâ–,\¥J„6Ÿ U÷¦ÙûL˜è–^µŽÛè‚h`i’›?uÄvšøsªñ^Ù)9 Ð}ûÏ„J”ϵs™Æd?“³ê­xµŠÐÒê-¤è>Ð=;¡õ÷¯ÕÊUäà22QÜo×þŒÑ¢©lM±¹¿_üeÊS¶endstream endobj 476 0 obj << /Filter /FlateDecode /Length 2832 >> stream xœ¥YÍ«I_ ¢4£;ŠB„©;äöëú®bÄ$“1ù¸L<…ÎûJ'}o¿tßgòÀ…2 ‚¸ráÆÙ) nÅ…;A—âRAFD™?ÁsªªûVõ½÷M2!„×]}êÔ©sNýÎïÔ}’æMsüçÿîÍ“<=Jž$ÔŽ¦þÏÞ<½4Kvî #Y‘4&n M©‘™Eª¥Î .ÓÙ<¹O¾^íM¾+ANò,—\Ó¼ åÁdŠo†eH=™rγ<çäzŠu(UÀlÉ@ˆ‚DÁ‰æ¶çq²ÈrJ¾vb§ÊB_â8ƒÙäzÓ.¥Õãóý'E.‡ËµU·¬Ê…³¦¹t|u;…0“å‚*²,'ßœ½>QyèÎUF%zf¶ŸÎ'³GÉ›³ä6ºT:S&¢™0)3`¼.†¿íAz/]œéžÛˆ¢`a˜4YAyªi‘J1äJÕuÕ¼ªË¶Zž¦·êf¹2%eTóŒs;½¦lM¤ÂÀ«˜ ;w„¢é•¦À6YzÔ%"+•éSXú-øÿ¬½–¸™t˜Úkìÿ¶ÉÝÑ¢…€M03,ª h\ôÒdçòÝ;×.%;÷`³y²s=¥ÉÎ¥[—S“ì\ݹZ';Wn]¸°s«=دö–M›R sšúd¾èÜ xiÚ.å/&7®¤Ï~6û{Ÿþnþêë7ÿô»ßúÏ{oüîí_ã/yòƒW/¼ÿÅ{¿˜ÿ泿ýó'ßùàñówÌçßýÔÿ•üèÃ×}â'ÿûé»ßÿ¡–ŸùÛ{ü÷ß¿ÿåß§ÿ|¿úÎ_?üñ¾Òu>˜ëkŸ{åWÉ›7ÒÛ+بa¯nŸÌ¹€TÆÔ 4O¸T(ä0Ro”Zp2+%´ÊX(Ô2ZÁ¹¡Ð0²’â¹€3dB«†‘@ŠcâGRÃH ¥(ËòЬÕH 5Úu臕Ôö3`R-Dt¨È (4ÂCË'S& žNDð¬‚gƒÏŒ*Ô™Li&ÀÊÂ˜Ž§} à€ àÄÁI“ù}B'Si |Ò„Áœ\A¸“gE¦9 ƒ{`¢Å“(ó ±%ÝL`Ök‰Q€•\Ùwïö¤öi¥Ð‹”§Íi¦Å0bãÌ@¨Nu.É|éO$J ºr@©B]~Äê*Ëuù‘P×í­Ñ‰Ñ°Ž“ÁT–sí"sµ: ñµ\,°§ôÉ,XgˆYä½ä…)`¸&ÇD8øà5à0øÐ´=R‘m 6¯´GêÇ“±ù`1cJ9‘ûd:êO¹ˆë•[[’(ø²¬š…·˜Sò´Z>ô¢³Äí› ¨1aY t˸ìu^›)ÆÛôÊ`Ͱ¶ ΕäŽu"͉ÝXE³WIöõÏn!Ï5éœq üÄ4Yº´§JcòLanHÜÆmñ…ò*|¥5šµ3F%;´¥Ë¬:(†aY»™Ì^¿OfƒŒA(Ò€9„ NhU|Ö–è6‘ƒ•JöqKØq RÛÌÃ÷’.4¤^vNlý3ßà\«KF.ŠòVƒµìS/š« y‹º ‰Þw[’Eœe×ïö]ö†©H›(°G~8C>#Q,Zn<+\ç?û¬ -ÉyÑŸ•n^Öu”­µ?ö^x„¾€EM]æ™sÊÆÑãü )÷Âè-ÃÝ—µ+€´-ÒJÌÝYPy%ø¢$ʆ5`X˜ ¿Õ&ù*_Û<ŽAÀšÇigsƒæ#™eFK:˜?J{¦ú媮7^Ç5Šh8y-°oÄ̧(¹ —ká¯å²óìÇÁ‰ÞÞ-›k@á] Ú€]TB€]òÐÏ2ÎòÆ® ´ ¶ØoïlÊÚ„AZì@ÂFŒIB-ñ™[¸:bÝT./4…u½s‘Ù þ0È»&ªX^ü}~õR4.ûnW¨†ÞÆ kBYwM?ÕbOPM¢L-ÎÌï ØgãŸ!P[Ó®ªùK‹s¤éMõw=ø0ÚQ=9‰sqµÔ©ô‚Ü›,³ÚÞXHcÛ!R*¡$”û1¤`2¬áPå\ñ ¹ª%葾û4ÖyxäŒâŽð˜M"Ø)ëè5ÜDí<ŠJe1ªË(#"oÇ{·k*[ä0yáI‚â€Ô´ó΀SA“ðQ|6ñœ|÷…ôKd zZ[‚¢¨­‘5ÇÏ29ŒõÆÔ c£É}Ä!éw!\~-&'+09zè7…ø4F4R¦]Rû¶h …N&$<¾ê0JBx˜[:@¡*ž”‹n˜Û\¾;ù’7k“:X±;í’ýó~b]—ê®WákoÖÚíúrpålLе±´ê£ˆ’EÁ7ðXTáéÐxi&65{C ¡‘¶Óu—2m·_~mn-áÌgÀ‚QQZØ»/J‡»®³nÓ¶(”vo¡B ³!4–¢äÎßr.GÄvé÷¿ªÏV™m ½Î2š;"¸õ©_á ÈШí÷!Q1㵋´ÙNÝôÀ¨YÙó·0ò¥cÃG×:Ë<“Gb† ØïG X°mð…GÁ®¿©7iÇÁ¤Qû½9ü•ÏË5:„à'ø÷Ái¡j, X)†î1¹nz 5°)dÀ«4©ãòÐÖÚIòíª«„9ð‹Ž:öñЙŒÓÊÃñZ¶UTâuû"¬HäÙpI^8VèÁ{­îÙÝ 2/-/F)1‚øò¨YD‰é€ŽS‚n› *ƒÍdŠ|X̬˜qÔHÃû©Ÿ >ÝÐH;Jq×Glu …­´.ì¨bðh»av)c)ýõ ~®¾âØ¥•«YÛÉ÷á–:ZãdeME÷[R 8ij¯pcÙô ¨¸Ûê|ƒ?HD‹ÅhÑ;c=¨veÜ^œ5‘}ýtè]Ü凴½T f“Á¯'+o®±¾‰‡¦ÐãÀè•Êñ‡ÜXnªÃÖÓBYO„¨Ñï^Ú߃n‘ðÊ££p¼ySxœ`ØàÃ#´-³6 ÖíÖÆ‹Zˆ¹Í6;n C»Á,sVPª/lãR.Ñ¢¤í-°þÒ"÷Z(QFéíw>±ÖÙæªæX/~eÅ»Ê"gôaM[21«O‚IÙz™¹¡ñ:Ý0òU»C2oÖXæÈ~ )«Y–UÅA_¹FyÙ¬ðº\ÎÇEC£™½ Pî.ÇÒpœ dæ9È­r=‚¦n¥¯ì¼T®-oFÕ…K´øœ¸Z»äuò£8>‹—[oµµø×íe5ʺүûb¼e}1f7Nð…W­äúÛVß@9 Øpý"˜ÈØÔ̈%_žYRàæPþR GOIãˆ`ÿ+µ'-q–µ«šº­ßZûEzúÂT•ÑL㯨+ ¡Ã ¸ïÇåÔÐF:RËò—#ÕSÚ±¥“Ìõñ}œq¡ìÚ2c ›(9ÐhÇ`‚Ìsì/7 l•¬)øš HáÁ‹·“ÿÌ×\Ûendstream endobj 477 0 obj << /Filter /FlateDecode /Length 1847 >> stream xœåY[SÛ8~Ï_Ø— /+w&®%Y²´o2”(”¤å¡ì0nÁ»qBm—.ûë÷ȲƒŽë€Ã¥³—áK–ä£ïܾsò¥ø´˜¿êÿ$íýYïK–³ýêß$ío{¯O¤™ñu i|Ù³[h_Ñ~$"_sѧ=B™7þ«-Ž˜¯˜„ ã‹Þ'²7õE•T¤(’…g†B‡J‘™7àœùZ“ñU9Í#h‚×äf÷µ’æ…Ý )9Ê.œUè+™÷Ûø×Þî¸÷Þ\…õgyÏìïƒ;ïõÕ°’ö¥V¡Ïy?í fä«™yo´)2‘¯S}©”…ÚÀó‰ ç³e–îÍÒR²×'” tŒà¾KÌH:-®–[ü9-+8¾ÂöèÚA HÒä/ €Zø%û G kçù«ó\ C?€õÎt\ÄwØ®€Taè+áYÍ<ȨrTJ*†’¤T–wÕ}5‡;ƒÐÖh8#ñÂÙîÞmˆç‰ûnÖEQ[ÓÑp«ƒ¢’–ïZÅÄ™•4 !ɱ'q‘,õEB23@X­4¼+ü52áóV^$yÑ&߀GÒï(÷E¨™•s;‹]A'%Ô!<¹6<@€ºÖ1øì ÌN5Y~]ƒº³¡ ÄÛÛNvöº€¼—Å®0 sá1åQ­,›2p4ƒ(“‚rçf¹ÖB)lY™{ÎóA®Ô?òÓg‡œi¡MðI±ñç-HK&%‹Œ +Û<è_}"gä[ydêBÇ$³«ò…Ђè+Ý™w¿Ç8žÐA‰z k¿»ê¸ÊQ¡ ùr~c 3n²Nñe<:·qšÌ‹¥«ò,@iµDA>vó‘‘Á ;o(ΉƒÍå÷Ãg­º+| ¥±*ñ$i<¯i^IVéË*†!YVùß‚ŽÁ}D(?:8*¡.ŸÎód1›O·¼Ÿ«q|3Íâ™31Y¦×óiQάÓNø2”ú‡èÈÆÀÊqÀ"y‘%DÁžæ 5,BŸêúö{™›nl8g£‡]rðËßrÀƒêT"i…<ý+ªÆ ªRÞ`{xÒå ÛU. aÄj^ÛÒX% F†'uû€“Kçú`ÁÏþþbšIÜEüýXñÍ µ ôKyrËUc& %'‹u\ª0Y¤”KˆGw4¶öÚËdÀkt^yÉ´) C`”ÉÒu¤|ͧ´öC=®üzÓ‚‚[4YDFOão¦‹‹Ñ4k…@P&t1àRÊ͈?Ò›™¨Ø .Ù²8³(×*@”gÀ hޤ-ZI¹E´)»Sež·;ˆ˜Á3oLÌŽ·ôŸ)™WLè±Ø?…mc麦N±¬#U„l>O\–˜O+‡”ìžß¹Ú?a»]B×ËÃ嘥Ë|–YÑ(çJÛ3M€ã:%Â2©º "VY:ÐÜ};-IŠe=’w¶º}RIªvФðÝWsð+W»B3^>*#‰D|z›V¸£2:ÞwþîmM°Ìh4=È­êðõòZq õ êט0 J±(润8|ž”}5ÎhP6žWÓyŠp·ºÐmDB›6ID–—öY‡Ô4;8¢Üi¤@q»[  ±p2ö·îÕøv{?­eQݘs°½Ý@Çãé_¨3Ï@u¾t;óõÌã;ó,|ªªÎüö²­6‡À´û]+²­O3»­Cžz<·ØÞíÔƒ?| óÈ)•(, Sˆ€Ñ–ŸÐ×ÖÉMiË4`xÏ÷|Ïv7I¾.H ¥¦1¶n@gÖ5"‹Unví¬q~5²:©“K$È¡£ÄŽŠ8ïØ±ü_(é6-IDšPr·ÔÊbhЛx„XÖºÔb•ß9õˆç·yò@Šªz¼3\5cª>|9ùpƒU?°Ãr§#©Ìœ0XM<" šv˜€äfãß]v‰?[ŒY„eÏL Lú‹7Á„ÍO©;ÈγÍI>9¿5Û!æºîŠ›iükÓlõÁa r¨P¬­¹  .c%¡â¹]Œ†>§ªRF>­é™i1¶ø‘ ®_…3Sý”¢jö$Q×¶9×׸pË ¾4”=†JÓ_É´:QÐFsu–äã¬qòÝ÷Ï<ÿîó÷½¿õá~¶endstream endobj 478 0 obj << /Filter /FlateDecode /Length 5105 >> stream xœÅ\[“Û¸±~Ÿ¿<¨ö‰“²¸Ä•ĩʃìʼníJÖ““û”‹öÈcÆ’å¥d{žçÓÝ(4HÎhF“Ýòƒ%¾|}Áü¼¨J±¨ð_øÿÍæ¬Z\ý|&è×EøïÍfñèâìÛŸš~)]åÄââí™E,DcÊF»EmêÒ)³¸Øœ½(žvoÎ%~·ºxw^••Qµ¨\ѮΗø­mŠõùR)UV•*~lÓa;åàm#a€NÉ‚½Û?À—uY‰â¯ŸèUãt¿ïñw o?nûɤÝûñ‘-þ”.×w»}×~ðÔ8ãŠGŸ’§~'Ú5°Ù”•¶Ø·çÿwñà‰­Rž(eKa3—g…Pçÿ:ûîâìï8P.®vg0}³ø\þáÌYUêfQ+˜SºÅæÌTÖ–F¿¬ÏžÏ_v8ŠJ–JšE-U)t8Šgí&0Î)`ž'[À¨tXYÕ.нYíßm/‘öÑB²*ëZùq/Š ?‘nÿíz»ƒ³®Ù²’Åã”ý“Ï){‡órÅe*)ÅľÈ+Ñ4e#R^…_NàUåJájÏ«‡è„M£Š}·üiû:Ÿt3»m”]¤Ü->“°8!ùÏ~^ke±ßqß<üéÕêóêÃ~÷ÍçPÓiT6§q n&Îy R>5ÙR麪Y,…* è?Ü;ñ"=A&Ÿ»vßmÙkÇòár^þíxñ¨õ”ëFfbÊNù2ˆ²!æÕh“ê#˜7|;†!þô«³ÁIφú6Ý{7!âuU{FË, fzŠv—*~K³ô .ßN¼êÛ/7ó` ‡.žÏ9å>8e¯;€°3.ò–6³2}w[Ÿõäùoæ¹åòùwzYÙD©ûÖùüOOß°Ì6œa¤”.Âñ—»aS«RU?tRžqƒ“‚@iûvÿŽI ãï¾ûìýZ“CäÃþ­´Ô ÅÇ!ŧßý×ÌÕ¦Ý÷Ý/·ºTæö™MÚEã….þéö|‰C#U±=0˜°•õV¨›¢ ž`¥u²xí_´Þ;‚åw‡÷üÌ€8}lÐÔwO·@Ù«ìcw¦îhžFcw4OŸ±gLåÛÔ^Q‹,&Ì(ÇZÚ2†§ÉƒÀ\´# Ë/q$›Ÿ­>}þ‹ŒfD Wj“ZðË,ˆÂMÛ…‘²´UH;\œ7˜ÙƵ¯“#XWòΗZ#*¶ÅãÍÇlÔá¸Î†È Pq~½ hCœùv¬éCòçíÈ%øÜQ*oÒ·G¡«—x¥‹ösâ´“B"-Ì ºàÏò :'tH/Qª&$ÄFá(ñéR5Áòb©àCP“þ÷¼‘hr$ „n›*lL£˜—9Á€è±ÒY³ŸPس68·d÷C`£LGV8¿í:j¸ga²À‚IW| 3´é†ä  …¶a†€OsÇÀVº {Ô¨ûϘ¶IwØ {Q<ùèm„És•a_ ç‡9ça™'ÎJke=!#¤Æ>mký|ºvZYµÑ¥lìB»ª´ð?(kqÈS^—þ›Ï•µé|/@ú–µ2ÀŸ#Ú<Æl`ƒtM@û¨Àb ŸáÂXƆӷj„EÿÁ¶*NØj»¬Ñ5ÄXÝZ98³º`Pi³ ûw&k4Ò¨(Râ¡ßAìî¨Z b.Ø,µÐçVS jûõW¿6†S-¥/›ÚŸÏõè¿íÖmš¿Z'´’8ãÒ†: ±\AÞœK‹öLïÛ«53Û>ü.+t¡?$€ù@9³z»âbryÉм›'ñ"µž0º'Ç= 'gx1:6Uƒ Ûb×mhoà–fÝòpÝT­¢`IÅùHnÍ¢¼«°¢à…•Õì¹cmã ¾dѰ¾,ÎOW,@å ó`CKļ¨ útÙݛԨn±òÒ Õ¢øë<ÝyãçCˆé÷Á=(€ÛÊî.¯“|h|=Ô¬jsŸŒõmøè}òào}@bVá6ª´&fS.ÒEùqO•Ç¥)ÁkÇĘ‚»+šµºLµ²Õ:¯PY/Á:ÇâþäGfœ (`š9«JÄ–//Ý{Œ`%Fÿhê×<‹|G+!4lØ®%†³[œÎ*¡!¼oجí `X@v3™-²Zß{ BG`NcšÕÛÔ§ì»M»ŽÜS™‹ißâ2dÛ~¶¦ÜçÀ'C,ÈâKZ¡ÖƒK;€Øk\ZlóȵŠVÐ`§]_m!FOŸnâ&ÓÅ{ˆälS2)Á:u¿üËvǨNw=ªYÖÒB_ã”Ü(¯À¤j+ˆ³pd‡#,Oq…\¡´@~åJ…6÷c Ž,l^PÍSâ>Ìo)éÒ)£¬ƒ˜;׌ƒ]ò{ô]®‡ø»!‡>”Tb”Ð4&Cô+é÷ ¤¯RD§-„wrô²å¾Ã/Ûßó\؇8ZO™Û·W)Wˆ[† È÷”r> *ÔL¶:¾¬ã(ÌZvÔ€IK»ùô×° ñGÆ'­i–­íÖ™uŒ"¬Ã¬_äh<Ó-u³e÷uÊ¿:DŒ*]ýÒÏ3àì@êH q-àöD> N6p¿e@ÐóÅQpZ³P0nå QZáÇ6à (I²Ÿ,G…éØO™ž”;ÕGVº‚w©@³!\©œmb•ó¥ãVäúð;³Ÿ<:º!PÆÜ‘ÅàÙÓ"çeEf” õ{n©S"º>£"n;¯¦nÙk°_ñAú<+©9~–Í’‰Cð@Y§Ö.’d®MZ†øÀ[† ÷ä=œmè[i²ÞØCµIZžV¡“d‰B*.y"šq4ë;5 =`ûOÓ»"¡'2Õý}isË…ÎìQyãS~UQgT²Üý üJCxZ³ye%êP—Èn­å¤žûv"© =[B`!TŠE€Øé…Ò«¸æôµk&bãò¸Ô%ºò¼‰ÔTIJ¬ ³ÝÃIêGkcÙŸµe®Œ¬Ì[¶üô°±¼mÁïÞŽ.²ù€”"¼§¾—ËHrG8=Ù™§ÊŸ_[éâcªœÉ¨ÍÐÂÁ*zYç Mi¥ÞGa·&‘vBŒÕ®úͧ y“ΘˆÏ<•ñ²èИYE>x»éö£"zh9j¿ºzlbúšlbÓ`úŒJØrÊDøi%\à³oÏKåôo£¹í7ü:LŽá¢§ïúºë¸V˜²6A诹š¬ê|Al˜ •˜<ðÐÞýû9¹ØÈÙG䉱ØÑc6=Ò^z|ç®Bä›&XŽbäÎ‡Þ òK8ªo02`âéb5Ë#’¶–¼ßçü‚¡ÞOApß H+ð3XC„©\.s„¦ñ ×ÜÔØˆ‘{v»vh=Üp ýC˜Uå GƒÖL¤ä“˜€v ÞɬÊz?jº#ž8KK;²IV“αC®aÅákÎÉdÂp#kZoM TI¯fŽ˜DÃøä¯¯:dyÎ+véŽênd«t-±‡m6ÊLÆì¢Ð(l° ”?~{ƒÕ¢)cYë:£áJ#œK=*‘‹ =‰Ý=ÔEkA{ ]lã›MÙ˜ÁA߀K&qH­Kmâ_Àtç\UQ=ª©xÂ÷(]{òDxãòöV¿[g}ŽÖÁ¾˜4Ί׃Í9^&@Ké°ÙMféÇ9D®Á\bUûd1¡©|*ˆæ´¦‚ï´¦{u'ާÆ-Ÿþw›éÅžU'go]2K½l”Vþ‰x庈´›#nBPgF3Ÿù=c"¡Dk†lWå³|´ÌϦé~Çóô†QŠu} ÜÜÁÆœÔø\Ç ¨,hœ¸s#©½tœŒŽ„{¦€IUÈ9âÒÝt÷bö~ΉI°7 {Ë|·ZqJ5Nj]Ö¢N磻:áãŽÁÙ…({H&Ôö¾®\Hž¥ªïm‡”à0’ïð˹WÜ¢­nOyzqxg\qWR-½:&«“AÙ Â7ßÒð[ÞªB|ŠɺZ|Ð-4È€%=ÜÛȯÞMåä½*˜“³òÆÑ¡­Ð%„êˆRU"CDnwƒ}ørÕäº>éu›ªÔ¢Ž(^ ù«¹rÀÚéÁåß2)iŽ¿Œ!ÉÐ*ëkŽ yv•·éø&î†îãóæ]â§òɨà™ó¹êvûþ«ˆMH›Ì°Ñ ZdeRö÷5vZ¥øòŽ+ÝB ÛÅŒ? ‹bÿ¼GvÓ¾÷Ò(³®ktÍΣ«ÑÝ''I•çn:ŸN¥á†ò›vЏÀ«V»Žzãp5Á¯›¿pßÏ·K{ýý'œ]Ûñ½%ç³óñG8ÖIß›õÉ:ÿ·Ð8Yí5%gLmáÕNGRáßo¦®E…­ë.VM³½sNϕ͗)èBŸª |â’l‚æá ˆD™K¨WWÉrÉ»,f›Ž Œ€Èà`,ö¯¼Á€í¿ò€}N…t¥jê˶7YÀDÊ“ <¸®eÌÏðJ?rWBPä·#%ðL4‰ ´>+ :û5L‚—.CÄûšgF^9¶¤X! úºõ~I:MðâN—qÄ®CÝÿš¿¿ÌRiãˆîÁƃÂYªÚ蘴ÏC¥—Íä=GbƒÎméÑÛÓÔ4=ðI“ížÏfΔãÓÉärN«L—p4xîÏÝ”aÌ“ù…nÔÚܘ³’nÖ´4í#›RÀ™†ƒZw»±‚íf5LWe­õÝ|sU6CÄ¿{·ýr‹eU A·NÄEÓßêJ5+o×ÙA EÕÁŠR¸QQÿÖ]ª¼5Æ¿Ÿý?rÔ„ºendstream endobj 479 0 obj << /BitsPerComponent 8 /ColorSpace /DeviceRGB /Filter /DCTDecode /Height 75 /Subtype /Image /Width 75 /Length 1381 >> stream ÿØÿîAdobedÿÛC    %,'..+'+*17F;14B4*+=S>BHJNON/;V\UL[FMNKÿÛC $$K2+2KKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKÿÀKK"ÿÄ ÿĵ}!1AQa"q2‘¡#B±ÁRÑð$3br‚ %&'()*456789:CDEFGHIJSTUVWXYZcdefghijstuvwxyzƒ„…†‡ˆ‰Š’“”•–—˜™š¢£¤¥¦§¨©ª²³´µ¶·¸¹ºÂÃÄÅÆÇÈÉÊÒÓÔÕÖרÙÚáâãäåæçèéêñòóôõö÷øùúÿÄ ÿĵw!1AQaq"2B‘¡±Á #3RðbrÑ $4á%ñ&'()*56789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz‚ƒ„…†‡ˆ‰Š’“”•–—˜™š¢£¤¥¦§¨©ª²³´µ¶·¸¹ºÂÃÄÅÆÇÈÉÊÒÓÔÕÖרÙÚâãäåæçèéêòóôõö÷øùúÿÚ ?æÁþº–×þ>aÿ},–’°Ç”øÿvŸmÉ4LѸU`K8=ëÝmXâIÜÞ¢£ûD?óÚ?ûèQöˆç´÷ЮK3{›ZOü{7ûçù »YúDÑfĈ~sч «Þlß_ιäµ-¢›æÇýõüèócþúþu :Šo›÷×ó£ÍûëùÐ.¢M§—üϽ,¡þÍ>KcË9çØÔÊ¿)à~ZYWý~ú³üußRd1.ÃàâŸHãæþ®?¥ n@=H®³ Ð?ãÍÿë¡þB´ë3@ÿ7ÿ®‡ù Ó®Ÿ7ŽÁETQEh&—nWï?æ=éòi6ÆÞa¹ù»CV#Æ:T®“'À•bå+îU‘Ⱦ‹k»äüÅW“Fµþûóî;V˨ó>ïùüª¼Š8ù}ÏJéS—s7d­ÈÓ&û$_0a¼3óÏLqô©ÿ´¦þì‘ÿÌ×—ý1xþüÍEku»÷rðÙÀ'½tr)G˜ÏšÎÆÇö”ßÝò?ãGö”ßÝò?ãT¨¨åE]—´¦þì‘ÿ?´¦þì‘ÿ¥E¨.Îæ7LuþU32yOÏðOJÇŽ[ŒªÿÇêq%Áy]Aþ?jâq5¹UÊy½ÿ!P>Þ:÷ì=é̳yøò{ÿÏOþ½DÉ/ËûŸïËOsï["L]i])ã`íõ¬¹#ëÁü«¦ºµù‘v¶:nÍTk(±ÒºaQ$g(\ε¸' &sÐ1ïV©d³‡a¨ÕÀb„çæ›iê„®·ERÓFƒŸÿ5ec?cüF¢Œ8aÞ¼ âlبд}þÿÞ>´Æ„|¿7÷¿ˆúš¸Ê>ÑÐuþ´ÂÉÀþ/æiÜE ˜°Üñõª­ÁéùV¥È‡ª£ƒW&gËÚz~U“wSÇqŠß” ¦²/̼v·¦õ"KB¼a„g׊³Y×zvÊ­Ú;=º³žyükYGKž¶?ÿÙendstream endobj 480 0 obj << /Filter /FlateDecode /Length 5249 >> stream xœ­\K“Ü6’žÝcÿOlô‘µ«¢‰'Oø`{ ïìc´1!íînµ(UuÉdI²ö×of`!I°¤V+|p â‘H|™ùeB¿^6µ¸lð¿øÿëýEsywñë… §—ñ×û˯.¾}æZxRûƋ˫—áq)œ©ö—­ik¯ÌåÕþâyõýõFâo««W›¦nŒjEã«îv³Å_N8ëªÝf«”ª›FUO»¼Ùˆ­<|m$4ÐÂ+Y±o‡'ø±®Qýû;úÔxíàùŸKøºzzî³Nû7OÒ+[ý”7ôã±ïîÃl¼ñÕï²·a%Ú;X‰tu£…­ŽÝæ¯~™Ø&—‰R¶%susQùÍÕë‹­Öâr«@FÖâÓçÕ»c>ø!Œ¥„)ß½:ýÀþtuñ·‹°EærXß>ikTSKm/[)ëÆú¸5×AŒ^(«ŸÃ>î•vmõ&-‹mµñµqF†e=¯nAÄZÃÎTÝ.[J½ÉæüÐÉJáë¶ÍçZ½¨P‚“”¨#Šõ+|+³žÜ¥†ÝT‚‹õÅ„¢@U…®ríoãs-ªÿ”½øáÔ¾ÛüÝ S½Ì•cÀçxd•ëò!ÿ±ý%Óÿ>Ó ã(pÄnòÇîÉæñ ¦¥¯ec¸$~º_òc7 ÀU]>¹›¸4 §?—Ø/›-ª£±fvâQ/ûÕ¸´økiàžÔÒæÝ ï›G(–hZc>Ñ WJkÚÁn¸ËÁâ6¾i+LéZ#`oãsÄ©W…öªûÛº1—ÿ0µ³Õá%þ  ¨ߌoدëüDZxÒÀ°ð L 0W¶ ¾8E+ ȧ§馿¬×îÝÇ8'é0e ñžðXÀÇìyì a¾?NÝj<„ßNUGö×ÊÓYbnâ4´¬Þfí™äÞÕÕ-HnLb„oƒ5‰ñ÷ÙËã™É_ÜŽ`çÏÂVZè¿ñ—[¡jØeºvÒîØBøÞG™4ºBµñÆ1Õ‡Ü@Eó [4åЖaªåê-©%3(»°pè¨1 ˜‡ÔÌUÏ`¿äl‰ãá>ö ÚÁño;(# ÒØê—5ÉüÑšœžÃ_Ï· P¢´ªÆ‚•Ž*y¿–mÅly¬•Ö›IOþ6® ”i©ì´,—pÐò“‡ÛN›í þzqõ¯Ï«Æ…Î¢Ã£Òø¡ ]ÿ)Ù©…Ù¨¿‚Ù,¶V×­UãþZ8Z¶ “ãqèƒúB6ùP_÷xR+Ö/xú1À¯-?“ "¿lñìnûìØÊp¤GaƒÝBAñ9~wÈQìØïûÿË7¡;öx&©­â ‡\iv[Âdï/àS»pzÒ’˜ÍèîO0½O³Ý‘®›89>hᔇî>`r¯ú%Ò†YŸoW<5˜f µ „I»µ¦„ͨÐ4M\‚ýj¤®ØŽîâlcH€ˆÐTc·ãÛ'«|Ë¿˜:ïÊŒÛlãÏá7ºÕÕÿdŸýwöÑøbSo¶VH2GÞ8ü#Šó€³–Kî·nÿvUY Ó"hŸ+)MÅJ˜r–T°§á©˜Ï.¬œ€—Ù¾N3[5·šp =‹ÚlS;çcÔvçøÛg^äM|­\ãllòÏ¡ ïEˆZ Ÿb¿}l»ªtS“î8ô¿ÅÑZ>¡ºñ 0¡Ý?J]‘Km„څƵ+ªVƒW}ÈÕh„wŒæ¬á!³%™Y[Ð(.“ÙjšZdQ!óúc?)´%zôTÉôÀæÆ}!Í*ÍÁ’z‹sûߊIRå}¡??¹ÖÁü0€üð3̺ìE›v2¬oe‹HæÓð\Ñ iÚ4ü‡¥?‘ÜÝ4 ñËó‚LˆñŸ1ùˆV ‡™xE‡ÔJ»²ÔUàŸ\"ü€ðia7qs „i‚ Õ¶uB‚†ÖVÁ&SÃþõÊH¯a˜¬å÷¥ýAéƒ4WT€mn[ØÐ_ßÈü, ©.=*ž¥e¨ZXœßDfæQ(N¨¸tÖ7¼4¿‘µ@½Ä¾ßÄ9¨¬®­“Ê}/ŠZ óÃ>àÿZµžZþVX­¥ Ǽn[ ¯HˆoJ]¢)Ð"o¹Ö¥å]>¯^o¶ƒ)qâ€ãKrõÄ¡} Ë9Qò®pÚ’®/#À*×ÎÜù a×rLx÷ <ˆž|œ–WUþlš9}0ô 7Á£•i¡…ŸKñöœe»‰ËP³i•‘fÀ`2›A‘¢¢Ý^D˜ôB»„ýÆék`Üæ«÷=£A»]ŒˆKÓMìL è,%…>&‘Âh'ÌÃÀ/(P®×L•ò;a;|7tû'²©„ªðgä‚dT+9LÞÆ&ðü¼+)µ"|d/º˜ ‚u½Â&’äµJœ™Oš.‰¨åÇù¤í<í'8ÌÀ̉2¦â\ŸfA9ÎÉÀ:1®¡¾$¤0BF|ÑZ´Y±?¦iZ¶°CúRW#w2dÞñÒÀÒÞè¥E9‚Ú³LèŸ#yšôžoÇ0Rk.¢YinÙ“U6hQлØ÷°bðæaµ(|oÀ›+`?R£Ð•6âcèÝñØå)Üw“ŒÒ3ŠVÓÑê OÔcê3,ÓÎurØN\µjÕ]+üŒMßœ!×Ãô`Ù,vý»’¿3¤ù¢¥O/ KF?zHäBrtìõÛÄ“&ã“ 2LŒEö†X=MˆAÉÉKò,£‘¸Ö町—á ªPéÃjnŠšÉ#Úýû8j´+”Ç/°fŸH½è;q8ãqXµkG–ÿÏVW08y½0˜ôEO1Áýé ñ_†0øŠÙ 1‰0fu½]¢Ù\ø ’f…¡'žóô1fšâtÖi}W?)œhš¤ ÓäZ§ÕóEyCü€}÷6çŽð…¥3L޲³òSž¢?|RJü¾ „^4¦ní2ƒCËw0¹£a£÷,Z¡©'~Éò@>/.|Í®ßǘ!=¤YpÓ³ëd~ÑVû½ÁOŒÌò—€¦ˆÏBÀ´wÝdùe`„¬æ’Yøßï7†²pY}L¼‡]›ñÅ‘wsm)_Ç÷ u³Žž8,¤ºÒGÁM¶¶¦Ôïj:Ú…äóyøÒ.E„/0Ì--aŠÞ€Mü\˜’¢!Ðw¡L"üM¡VÐù»SO§}"Wrúb‘£À¤A[BS"ÔÔ—x-*±ƒË¥É! ²žù ¡¨V¾|Ú7Qtl0ÐËúáÓ?¹Þìñ®¿ÏYéégpfñtjÿ g¶¡(—ü2ç‹õÁaÃ{Ê!5˜>nU`¼ˆêQgi®º”#ñäü‘}°/­ð?j‰R¯þÒÃ1ŠÞ5tÄî¿ 9㟻îÍ›à#7õ¨:UŒG Ä ™¾ÎíñˆhY¿²iÄ#L «tø^Q­*Ê !k2y1Ÿ&/å g?ÌTkY»N»]V=…”ÁCX›á€ý‚-]µìÈl¥ji峂ÎEá-–#ú¶Ò —ÕÓnßïŽÌ™¥Ëg2–1¾e€””ÈЉp?äÿê1¥Bþ ãü´Nkª7!¼Ð+84·¹!*¥!§P Ö­CIO„ï=;|óc–¾‰=˜åׯóõw»ÝŒ%–ÈòõÓÄ–îEBÜbý›«v/—šÕ³CX(€MÄ$Ï`pÑ”v—ûlüvà0ÆVà³Ä{bôK?0Q “ãÇ”‡Ð F±› ݘÚîíîCÏf³O/e¤Ú©Cb» ¿švVÚ}8Sü[LOb:àc‘è£ú›*þþ«¶[©edú"jλÁŠ}‘ÊDïËô€vM À£vº4š´â6k/ÿÁâ °Dëµ9$¼¶]è(Á‹jU-—±vŒ¯é:DV¦ X¦¯ý:†Ãz2`OÚ–è»ÿ¤ûÒ4äÓ-Ý!|Ñȱ‚˜ø!×Lð>ç ͵v×-êEh]&™Š†Øá¥ÀŸvYªG29Ãé3Ú bÒ/k=R_]–Ê9LLÙ &’O’8ìD…hdvK¡!ÈYwÃg$ˆ¥4Þ]¿3Òm/jƒhúåV3Þ›zPJ6Ì „Þß1“ðûµb¡Æâ<¼Eî ³½9}žy¾àd6)ß'R÷ƒ>Ú6ëWîe\Sº€#ü[OwJ­÷X€ñKF8ïÒ @—W?štŽ]âÆÀ )S¥Xrß½Y°°*Ôj.а˜ÜÊÏG“t­@qeëF~ ÏžŠ÷>q>ä² /ž™õ›*ñ´–Ÿ¨Ä ‰1ù9•xÅ´Sz2@{Ì:Ì5,5"fÿ/í³î[…Æö!ÀŠASF–~Ùå‚?`Cþ€‹:p8%1çç‚Ú7+Lz®vË©áò*&ÒÚÕÄÙv¶Mìšã¢’—:P!¥  ®WlJÍêàô2{%·ê–\Ç’îÅV“îUÔ½¸½»4ø×>¦ À:ö»]\±+\¤ ¢˜+ÑËEiu²t¢Y†mù¦QÈ©1•¬]9Mé éŠb„UÀ¦›•㽄b]ð*ÃÕÅÃÐßõóLnúg™¸ù'¼ôB#Mõé{˜Úž»ˆ)•«­OÚ¸~3q ÏÏVÞ-.Eâí-¼/‹—%-loÍ|oa€bxŸnà ÿVÜ}Ø<…Ô6ëëû•«ÉF褔ÿRšôål+ ÓšÝ ®-)o>抓kemÓ­Z@~áRžTŠÚ66Iªe×^KôY±EŠH„k:qu¥ÉX°4œâ×JétP‰eú§R `Ò[Ÿ”ƒJl@ë”eÚº]Ái^Q·ø—¹ …¥êLpmÐeÚÎ#ßÓITDÕÏò0»ø]è"¡endstream endobj 481 0 obj << /Filter /FlateDecode /Length 4757 >> stream xœÅ\K“Ü8r¾÷?ذÃQG–CÅÅ›€#|ÐìzvÇ¡µ¥Qû¤ÙØ º¥îTuIÅjõ´¶3 €`K£–Ã1‡©&ñH$òñåƒú¸a-ß0ü/üÿêpÁ67/8=Ý„ÿ]6ß]^üþGƒOZÇß\¾¿ðSøÆòM§»ÖI½¹<\4œm/ÿƒm— îDk… —×oš?½ÛîXË´åÖØæ|n·ø§vÊÚæf»“R´Î5—?ÓcÙqæš|̈ƒdë¬Á~‚áÍž®“QÙ.§í_/ÿýâß./^]ø3ëÍékÎ*Dˌó¾iþà TVµq·NÙÜÎ/’më~ž)mÚüÔ ƒŸvÎUkœÊÖŒ‰dåß¼¤4­æ"çÏOÛíN wÉ›ñgäSR8Û·Dƺæ~Ä0…‰æœr³?‡©VÅ^Þ… jNýmòâ|![Æys|&k½:ùПOï$p&—ÉòVtÒKkó£h§7@rÇh„m¥1v¨­³4ìÖ+¸ÃZnvÉÈ7Íû„¢~¿,Âï ד®Dy?ð*æL´û1yS?ã­V*ªN-o¹V2jiÆÝë@–t9Gý=öÙ®¶O¡Mó>Þ-µÌIxÛ¬òF +p\3Œø›¡=¹Jço·Ââl8°ä‘)©š»µaÉë°ŒÀñû=þ…‚íÄçÌèæ“ǧñ(‚K’ç—³dÙübr)­4ÇtuŽdTz“÷8G€0¸œìúư7ÐÑGFÉ¥f £¨Y4^™F<ƒßÏ$›éaðÜÀ’Z4ßf$L—Ÿw.ä·CÍ4s ëïÐb€‰?þâ:¼ˆ‘DdÇ‚r½¸¸üç7ÄO%;¢1³)( ô¼F¼%a-&Qü;É›á<ÆÝòý @ôéŒjî‰ ×wŒó ç3Üdú(+›O~*p0sçxÕàV`»Îó…ˆp¢ä q‡™èÎÝ~W]sÔ…¾]‚5ð ÎsÑçÚË,]‚_g¡ä‰0ÓnHJi)óU†0íX]d½}œŽ£ÉôÑZÞôùËÂÒž†þ›Ð³ÃÕÑÍ›ÿ­]PË;Ç!—6>¸ôcÄã]3ÌÖíœ3¨tH󵤜üFD¯n6üá Tõ|ü&(ˆä)¿Žçóñ€pTJÌ"Ù‘÷‹I³¼9:n·f§Oçá*µý>ÒVô×aô6‘›ÖH7ù§çûl—c¦¢H wf”¬,fØë_ü²;{0-Uq¸Œ59bª©-kV—Î,<<îÙ-QFŠ˜æwɦ¤(‚N ‹:Q0y ÙÌàÍñE0WDhˆŽ¡«ë¬ÜW»«€_ 0.}üÉ›ýMžQ¸ÖâkpLþÊ0\ÏÌÿ9Èû¡Hçúépƒ E».Ó†’!Ò•…ÇOÉÁ”‰™Ã0%Ƹ,àäµe¿R ‰¢yÈ·OýÝ6×þm¬¡€×™ âÖZí­á:Gg_d½ ¸æÏe²“–Ѳ»Œ\S¸«ž’T·ëo´2`<õœTö¿œ( Tß'ûýqÈ‹Ct“ùÒ,á8|Új…†$:·]!t‚8ãøÆçqH•ìªv¿è?¤RŸÙsïX(y`1QhGÎWL^KÆÃyªT¢ZÜC<‚`ªÕ• .„…(¿,¨óW&Z„€=eµ1é6E5•ÊÆ æY¤Ð߆`޲l>dÉVòÈÇ)¶MÑÏjUé:Ð fó-!é0Gäi—•J‚qâ©’Îï|^é‘0n>°¯1`º­V\ñ»|?´®ÌS˜Ã?“k D}ž‡Îvh§à2›ÓRéÃP ^'±ÌޝƒŽ"ê(#L~¢ñÝV!3CžÞ i8BpðÂÃåÑç”2€áS°ºì>«€ßA ÍOÐðd5[I­)$äaØ÷L(pÊDÚP¦ÁÐæ‹Âù. ç_Ýõ×§žtÅãç#‘Àá†~+pšënïn·Q5À½sœbš—à™÷ï«a?`æ°ûwÇ섈ÖmÈ­—|ì %òö™žä%]¼’N‘¦¬„WYr}ÊÐuTg(*ÄC‘|‡j±u¸U%ûI„òÇc{ è·„|¸Õr' Ì¸ày0’H\æÆñH¦°†t{ÀŒsÏ™ÆÒøO‰ªEýÕ]üô©¥ŽR¥]ãóqùIÞ*0Qc:ÜÏÁ“¿L— Ìòi‘%³” yîWÏÓü *… ëýy6îs52[é“W/V†'(§ZUMº? ¦}ýN"TZ”›*×ô[ʦ¬p®Ùyʪ…#ýÇËdØ.«Kgžª°âeMó—¼u(K¤£íEÏ£§ŠY͂֬^²OÁᮤð…°W?¼ÜZ´^pûÏÂc,ês-]2oD«t$Š©æäQó¹m7õ³O ±\¨²@k–>Rmª Öjm‘LÙ²èuÙ²%¼‰Mbš}¿ÊŽ1ÐÙÊ1l r? qQ*‹Ct2\7«¥¸”ÔÓ0Ešd…õLèN0–wó‘Ryðyþ…0!/¬%ñ¾ÜZéË1}šÓ¿ÃŽŒVžÃí}Z‡+¯ÚЦð)”…k ^ÓGµJ—æ²Dq´™,.y]Rs)¾‰{âï/SqoaSx ËÝOC¦§‡1¬IY¢Ròw†O…Ié«–ŽQÕn|óãưÿF©0yØH쵡‹í»Lœ~ÉM‹ªùC‘lRkÆá’yfí%p}ôûãø,ÖR]“Uú®çÀ&uÃyÌJˆ{C A*¶}Bo„€€Ç]tižÙc1ÕJe„6§^7¬wt!ÚT‘qˆ¢gÔüP#Á-ÕaA1©{õ7ï"ôAýô»±ð0 <Ÿî®Îw³Tc_Îu˹Ù@Ü àB=H›Ì~@—6ƒw¢ç1;fõˆ¾2ì^R¡Tk,sq…!ÁñQ}¶Wù#sGÎ6M MYÞ#™ îæ3E<\¤Ö€€ÏµÉìWîc Ó`æónÍžËâírK^ñCX_5±lˆƒTÝà[ëñG¬Üº¢ï蟮ÐÃöðb(ÁUlÙ?ÄóçF³_ ¶r¤Eªj ¢ãG›gÔMaô-›¥è,…àZµ¬4 jc–á âìÓx+©µL§oÃÈlu*_™·ŽËˆŠP²E­—}«§ô¼\›ÖýØyágªý>Š•²€¶¹Â^ òE];D Ÿæ¾ÓëYy’ºÎL„uEz ,Vg7جÈÁ¹ÿS%—¼äféå„W‹Ž@lÄØÝ{àÝa—Qèz~ˆr×d(0C»ƒoˆ`¼SìÜ­_çZKŽqú1²†‹ü ;ôNá¯AÕ¸‚ ¾ñÁú¶ÿ‚Åà °î ?àÂüaqÙªë¯0ù¤kŒU„»¾c1P+ì€ÝƒLµf VMY]¼‘S2ò^Ù¯å}µ™4Ü™x÷¿Ô§L€òÅEwþ08ë'göP]°y§;û¹ÅAI¦Å1öS]ýFk®oV4ÂvšOÊ—Gn” Ä=ÚþtêªÊb)Íå‘­Ñ< üÍÊ‹Dh3ËàÓ·¶ìí:=ÛÖÌ1ÖÎD„1usìZ+™55œû‡pÛ¡’½ºOµRª¼EË?f¬è½Gn–8‚æ(¡9Ïú_¯M,Ö[@³p¼Ï(é‚¢xᲄëÄàŠˆ×ÁT€Ð.‚‹8ýíûÓá.à€ ²ê£ .¹ìÎ!u±Í.´qüˆÀ´Žo°±O6>"ØÕy½79ÍMÚð¿ÉE9ÁgD1 Ñ¥ç]¥½.€Þ/ƒj”"`øA[Ò$^”§)ŠLgD«‘ S­ˆÐÿ© a1“å0> stream xœ¥Z[oå¶~÷_H y‰NᣈWQEQ A“"E‹"©‘>¬ƒTk{½Úèøx%9¶û ú³;R"uñz7ðƒ$r8äÌ|sãûÓ"§þùÿ—‡“âôæäý‰ ·§þßåáôëó“/°ø&¯ŠJœž¿9á)âÔ‰ÓÒ”y¥Ìéùá$zwþ»2\ÊÜI ίN^e½Þ틼0N8ë²ahnwøh*í\v³Û+%óªÊÎßÒkUŠ¢ÊÒ1=Ryå,~à Vdÿ쮢QÉ*Ýî§ó¿-v±œí•ɵÌßÀ k'  ¢…F¢Y_ÂS©qaéòB;• éRo"¾ëËøS˜®azï Õ; Gèªì×±yQ¨2«›¶~Ñi#>^óÂÂfOþe¡³wÑàûèú!Œß÷Ñ ˜zLV•²FfC3ÄÃÒÑBeÿ XÆÂž`*H@–Y×ÔCs¼fAãao ¹.óBUÌ4ÐHN¦kü!Zi-‘ZÒÁÃ*IàDÓè )3žP™±˜r¼™˜äe¼\Ê6ª ¬`t%OÏÿ~rþ‡W~&«©Á´@ŸÃªdöÕ­×L£‚þU fõán&NWhé™eÒÇÎk³+³·$+•ÌŽ¬ e•=øy…Ɇã4¶¾Šˆ_yÀ"nÓó™˜~f¦³t7ɑ ¨jBšì*UfBe‰ëq÷¨^{äx·*²Ø2Ž[‚¹ò¬iå·¢²>a3Yw)½oÎO¾?ap3§ÝÇ‚šV:—­p¹‘l&WˆlžîG4"wBG_eÇ7~o`É¡7}M•Å:Sßñ‘‚¦x“¶íUYÐ"{asgʾ è¨GaE‹ÅÙÐù13z~$;3cå’RÃÏ_ꆼ?KY š"¦ÊdËì"»I¦ljl×$2¿ØŽ"Öª{2†£¥µoêË—?€ŽÇ’{¶ÊT§{i€œv|œw×Ýá~¸¾ÈÏv{#5¬nÀf¯®;`gÕÁ$t «˜ÎÃ쌉µRƒ–w1j¬r{.ov¦Ù#ûÛ™ÚÖ`K®F£ÜÒ·i 6чz¨Ãò©w«|€çu–ž«Í + &ÀíÈÊÑÂÏýnKÒ^Vìq8im+8iÐ`Ï/ìãP]ƒRРõèÛ{ðc¥MVww©Jƒ»qUBf<:¦Ò6äi«’À—¿è0¨r&»ÝmŒX‡™»ºôt¬/ŽððV¶ÎU†—óXNëÍ€sœM.`R2‘sr^)»d•cwµÔ-öA‰nÅ0[ß®#êÜA¥ eå_<–¥T±2¸-…’x:E Ü_w?³¹qL±²„«àôoÑ­É™Žh ^* “ša‡1tÑÏuܺIÀÎó"·bÆðüíÎ1γßÇãõiê¶ùo,·)Äby4+Ш,?ÝêÐzÞ_)Ž+J;ƒçº áœf¼â,$ìÿèÅ荒TËÉ(³ÿ­¢ùLÄþBX»ðAn|I\Ô$2šf<4þàH+VuSE®´WÍ»æ'w.h…= ™„¹ÃØr ”+ùâB‘Å%îèÈc$hdW#"gÞáp·Œs‰s1û¡N#§HÎ݇ Y¨*·Î[höüžT®‹È¡„@¾¢[h€¬[#Þ1ÆÅDÊå$Æ›®ŽIÅÞûølÅh3C¿°qô3È\èŽÌÅè³Îx«s|Ë!â.ÔËdíòJˆ2ì!Q¶þ.ÒÖýQ¥!gë1¨Ö=ÏåJïKé½>sˆ^‡9˜ÿôÓ{Ò\xŠ·±ßE¯;Ô.>.±ßÍ3l#¨1i52¦í…eÈÃñαs´Œ´aÏŸ)´Ÿ/fÓaÒé4Æxc’ĉhy4gû{[æJ‚Ò¥3óv Z&M}Bì¸êf©nQÁ Ñb¡Lá(T?oêáÞÏXíÖßzòiäÅ¢5Ì )0_f/ê¦[陿«¸ºp¹—BQýb\ýKóÙ3у‡,Ì]F?1SƒˆÑÁû"a@µc»© ÆE:'¿ÉÏeé=¤‚3÷r¨Ûö)xA»­e«§è¼9c ¶HtGØ¡çœ÷9ù”müUãæ-ÌÌIeU€¤Ü—ØR1+ˆ†*ûñbþq+Ú¢ó¹¡Ä¬* “–ËJ3xÍË^ÓC?… qz¿•ö±¬›®¦¢ÇñMz¿-éW`o~ˆÓ€%é_§ 34ëu†^ËŠ\K¯ú>uÖPŒÓ€b¿¡t¡\™kˆW“caEW/UtÈ¥ ^÷õ5ã]{¶ÔÝ:ïÄóê^i– êžê{ù,¬õ}shÚ8H­Bü0\¹ºkã*Õ°š×ƒÿ-Ë1¹A ’˜¢*vaÖ³µ7@Ot›±~j}H\K á7¦–[õÞØ,)¼Çñšœ4:/éJÃ%9|ÉêûÙúÃXj$H-Øä‘]«§ÝÍ"X<1ï-ï'ÙÏêâ»P2nØ‘¥,üiO"õÀ‹hÝ/Œð¼?ÄHäè½8R?ÿ‰€÷25󥜓rôjJ€¼#lP|‘ `^›@\>g¦Œrg6H±Ú I‹ÓÿM ¤ƒÜã®ÒRÀ÷д->•”vÄ}Šn£ {TO_{:Z-’KZm=˜’Kš Ñ_"Ùè‹XÆ{¥¡êù\_Ãæ^f18kžÏ&¢~Xå8˜¥…Í2šEFÍÌ„WÊù‰‡cÂ6"¼ì{›8ñÈØ3ëD¬×Á©x8Û`Aï@y”FU6·m…EªÒ‹DÕhaÙ7DSWÊ€úÀFÛkôÙ¥&?]ߢaÀ–Š>ÞݵÍ%yO X[¯wÚ²RåVj¹¦¿5­Â¬¶ücQ¥ŠGÙ}°3³\Vxa HÁ„, ÀZkÿ³€j¼:ÛÀC)V’&ZÔÍŽ|ɸ²ÐLÜl‘‡T !åÂÂ€Ç -¡÷:i×Õ=ÆWôň5Û¢Mp´Fìèí#ºî…ù»×%TEñ|³ˆ°”þ«Erê¥å¨4O%ÊÀe“c™¼qz˜¦Þ †%ÝÐ1úœ7”^RÖJgÌü€Î’Fi8…‡|Ñó˜´>ªæ,׊[Àm£Ãõ?®éV§ªè AÇ7Õ Ø¯r Á~t…‹&ZÃT$ï-¶R õUo0k”¿–©ÖPGŒ¥°ìˆ¡Z–c ÌWÝ“¨#­…¬ˬʼ ßXÐè! x©±=9Ÿ…xŒ>¤™5äeyÚ$ïô[/ÝïÂàì‡q K‚Ç~Í!n…Ž–Kfô›è–3ÕKäÔúÕ@Ÿo}øã7‹ØŽßƒaǺÄ,íb«š=†AnDß ·…N}Ï@€í+œíÌŸÌøÄaò-œŠã>â‚Ñi¦|•%œ¹0Ϙ®fuY|òëØ Lñä)´„hC¥±äÚvЍ¬2Sx^aÌï×±‡kº¡Ó‡Ùée „>§ãñhœC ºŽBkV< q‰ò§]D[WbmëÞ¨›E5ÈñU’‰êÊmäb†“H Û°•чxï ÉýÓ2Z¹È¾ë¦›6û×Vx6ûúÌ×ñ àøqǧâRéú´ñpl¹…§)çÚ*1ÿØt7‰W›;gq‹9ÿ¶ô 7ê*O¦í˜D”&kuHžôò§öù\mäc­Y#@ ”ÕÀã>Ë$öºð:—I>Êû,U¾—Yº^é]'m¤PK×ÉÙ®œ»Nl¿á5 Þ8Õ˜hB.™Zîa2ï5\ÞÊß>Q퉬˜56Ú2Š8÷Hh¬œò^”EnÊjæƒʲЄ¼EEY@ê¸Vkã^¿ýœj™øk¡¤™úí ~ï–©@’•ñ9Dœ]``½Õ¹<Ú§0Nu y–·)ñt–ÙÍ4èÉo5]˜Ò¬ÛpLÙˆ„.e5N‚4®?v‹. }3åì"¦?®OTÞ¯ä`¤µ†âɯŽ<¹O§aJÚ"ÇùÉi["ʺ]ɱ|Nùl¨ßo]'û&z½R~òæÐl^èïªYî—¶Ä?܇¨äÆ•›lˆn]FÉýñî£}éM, pã<ƒ‡ cÑ[ãq^å ¸ÕcèÏxýÌâµÍë®îž.²ÏûÄŸûÀy&ùhÒ¨ Ì@P ƒg#§ŸÚûËn4×}ÎÍé BäW{óS´˜YYjƒÐ㫞JK ´ïn¯o/²Ûîøp‘=^ìðïì§µâW¼…uºxˆ¬§§xŒj²¾®+ëTáY«ö¢ÚZGàB©Ôb? ‰*Ä/7>¬Ö”Ê¢j.ݯ¬gÚÏ}k¡"'¶9µ7šëzŒo¨BY¦ªM4·´¹°ÃAº›âËr³Vt»q©ËÁ2ÎM—ºð87ëÞTÈŽ§oúâþõÖþÝv-¹†ŸÔN¾š#f¸j¢ñª‰ž9ÕÐýcÉÞø² õÕ¾?ù?íÒÞendstream endobj 483 0 obj << /Filter /FlateDecode /Length 2899 >> stream xœZ[sÛ6~÷_Øž¨ˆKÜ`gvgl7Ó:7[Ý<8 c1 ·¢èJt\ï¯ßsp¡’ŠÝNB‚8œëw ÿ>ÉR2ÉðŸûÿ¶>É&ë“ßOˆY¸ÿnëÉÙâäWJÂJª3M&‹/'–„Lˆ©âz"…L5“E}r“¼©ngßsž|ei&˜$™NŠr6Ç7ET®’ÍlÎK³Œ%E¸m»4P ›ìÐŒ&íîó4#ÉÏ÷†Th®`½Åu ÔÉE³ÛL«ß^øOyrŠÛUû¶*¶V-trv|µ'áZÁI¨J3Nò¤-f¿.~›äYhÆò”´Ìbu’=[üö*ÂMsÎÉdÎÀjyŽûn’w—ïfs.©HDÆS=› Êu i–§ÔÊ%|")!øI€9h>Š)·@,¨<#£jQ’LN—'‹¿ß$?ÎÚ@'ͤ*¤…·­f`ߤØWÑ;îÓèÆÖ›úÎØ‰+ ì 0c³ ^ rÈž%?VëФ»Ð•¨ñËÅɇŠb²;‚ñ¹|Rpƒ¥\ÃÁrŠ!˜´½cû§ùqžÒŒ†ünüÉmôÁ91U Õ6]k+’øHLxß;6Mk÷@T'Í·_@P…1Y:bÉcÉ»ªó êÄÈ¢ºÚ´MõׯË,V£qV4çÉ&âÒ¯VöË _s’3c 9a©àšÚ0.¬QrA’¶š_5ŸC5"5¨d€½ÈûfrM/;Æ9MZ´/dÚîS⢽—` "•Rº,<½Z–ßÊ-šdŒ=I%8¯ÌžàÓÌé…Þ 5^á:¤&“ɾ¢7Ù{OÂßGG^{µÅÐÍ 0“4yÓÌæxL’cj–Ž çŽHtµv)O>-X.'@òGž9œGÉijçŽsØ‘ÎæR`À&ç. r ––ϛǙÂò î€\æ9ÁjÛW¿#p‘ARF}d(eíZ{µ%Ï™ç`‹„× Šß*N#F±º‹ä!èú •ØWÌ §)«]:QÁj7°Q+Ê!’¹‚ÄÛ=zq°§1ÏIù¯ª«ÿ…¦/øªoF­?%#£ÐdFrÑ®Ë'rÑmÃèÿjº$Ë´Î%žŒA‰&ɮؕÀë”æIÏxçbãÎɸÄl¢0î—›8ªÑé]°ýå¡2j H#µ&lmU©øMªŽë:_ð ¨ ­¾Ù­²¸õó i¾[ ;W°×Ž"Sâ÷Ø:`•Tƒ:àÖZóS%¡Þ•N\$‹ë`ÿ{·jï0mœI£ÆˆH$r†UÅ–—0dvÍÌgó·j £Š4c™È‡‹ XÄ•¬õ§&I¯Æ…:n°{£÷»"¼@(0ˆC(ʈa8Í ”£<ç½U ¬ŽÐƒ2ÀEÞ%H3Õ‹®±žÖ@ň)14Ê-T ¦ ˜¹¦„hðÞDBN!pkÛÀ¢ŠŸÞ)¨©íý(Dð®w2}´wZ÷ÚÞé¨"ήwf=aïÄ*®-\ü~«BÛfòG@P›£²8|7Eµ•;,ïµÓ£­ØŒ•¯Ãr`›É}ðÁg#Ú4Åc«”­;€p}:V(ÅǨ$ _Pk,¼T«á¹lôí=ñ°ý3j¶™x“ ÅG²ÒÐÒïgeŠˆA›ì½Šö­‹ÝêxÊseˆ†Àç%б*‡Z£F€YM$@Ø)‘? H¢©þ«‘`Eò§ i€N$‚¥meµnöŸCåÀµ“…>åZC,•¬;×F¥ÀQ¶‡ù7-ûp¢Ý´nÒÍÐ*‘#šðÈkû:5³—g]bV‡JÕ¥xõ»€—Æ"ç4–Ë8Ô²”QÉo7~Ú¦ÏÀRÆR½0«:U M{oh@£_fã^¥„·šá°ÔÕÁ'„àBÍôžNàÊã‘2H)‘e&õ® ;ɃLÊ5è†ìÀJ k  #T ƒX·åƒ{ ¨Ëö+‚gèJ+KH@::«#Œã^‡·Q­®·˜¯£xiûQbÈt„¸œ4Áãb½óÙqñÔDjZÊðm3^ap·V\4K‹YÁ‚ÒjGqø^È W§5éÁŽ:ÌÚPëNgì°îMÑŸ ÛƒÊyÌ»ØˆÒØðÊe¯hí+ {ï¤bäHÙ >Œ éÏe@–š|Âk!=,4cSÆM½…cˆ5ֲ¿𣜞_–‘èu&H;S!7ràæëÄáB-ÀnQ‰Ø×žúÙ¨7´¨U B,,<.çU”nJ¦¹î€ÿ>ªK>2º¥±„å$%:ïpBjÑ ™ÉEfÞºO–õ‹ÏÖ•Cpy´\¸G¨ÇÐl£‹¤þ-tk•*ßß:äÕ?ŠSU¹Å£æ4¾³u&‡ùãÁ7n§dÜ‹³gt ¯µÉqÎ9DÁÖ´SD¸¾’‡+d ¶3—¾2ë9㪦í%°4vÂv£ÄqPñà[?VŒ,ïEì þ%ÖÝ»G1Ù›§*hé²÷5²Tv®¤Þ­J[—:8‰ÀHò`Œ–ÑŽ"Ë:âœ(…СÚuòÅÑ©¯µøMj•LÄzÓ„åÇÙ_0ÑÞkæ:¸Û½sG#!>©þ^iôG‰7cÄD’Ù$žC%wGF[/Ù9’ˆ¾;‚)ZO_›mè§)xûhï<ïá‚küЬWß¿„wa›Mc½GyÞsh{[…u¾‚ðiüÖ¿œ¯‹ð6¾ïaQ?Æ—½ÐfªíUÛ¹Ž<þu¤‡ääxáÕâɦ2H7ÏLë6@álä‚"7± Ä^,À¼h  ªMñ¹_¹Ì~u4™˜§uäNtïXg1Ô4Š<Á ÏŽÃ'ïÇN7ØÚ¢KÍÅmX¨7 ÞÑñ•)7¹®Ð°c“kÝj ƒQæ0ïQ˜ œ„ºhwÕc2 ê²œû}©ÝBuÔ\çÐ,2›û_ Pû߬¨‰ŒåÞ÷٥ʫý§dŠ'›ÂÈ=ª¢H%͵p\s÷ëà ùÕüpÞQɇú)¼K)’éÙÙ/W篦î76xý¾¾ÜÞ×åðí´»Í>;oDÈô•ᙳ,ƒçø¨Á«ËâpX˜áq·6«·€L7eÈØôdÇZG¬?.÷0Cl#ÂX>ÀàŽjRxqÞ ¼8?4}¿³HÔ÷oó"´¥:(4§Ä2í‹…•HìëU¹m«öqÚEì ‘!Û7?\wFçe±{wù®û ϱކ%!7ÜhI„t‹šqÕ©j~ ~8}¿¤×¿¼ó#¡ÜyvzÕß_oË][ipíòº‹’+úr:vÛ}CuÈùªØ®šú@UÂy÷e'èúÕ9®ß¿~»|{˜‚Eþ2߯×Ýù®‹ºÆ,)îîÀÓpë]yÛîŠÍa«[Xn›]Jˆ\·¸~ßióŸÓE÷\íëU{x™¹ ²¶pÛÍAGKn“·WâߢŸS l zf5£Åàøn.™0óÄôìåiïui-ª¸¥Ÿ—÷ÛÛf P¬¨¶åjÜóQm87<•¹€,*‹ÖØìÀóHƬfíòòe`Ö¨ ¼)‹­Kx³õýy¤4¼v™†f7‹>øž_ºø|úÏö·@‡8Ò^Çc¢‡×ß™v[èã‘Gý;£ž£]ÝásàÏE>~9LƒåÏA~ªE2¨Í°!G.qÝýUk;4¨§‡æÒ#É¿ÏH6’ër˜¾O¾ð…«À#z÷þëð×!¶!Ë¡ØÓÈ䟇°2÷ã# ì·j» ¶0Òý-LJ“ÿp£Llendstream endobj 484 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 2147 >> stream xœmVyPgïafº[åPš«ÇsÉFI4èêêf½EQ<ðb¹däFEäæÁ€ÜŠÜ È5À j£–kT`ƒF-Ë£bjM¡® nÌÆÚ×ÖG­Û£Ñ˜Ívÿùu½÷ýŽ÷{-£6”L&s^é½V·;0bqèîÓ§y¬ ÕÆ†FYOÜ€l}=òµ·lå`«h;,Ã]Fõ;ô¤¬*B·'*:&6.08$ÔG»cçºõá3<(j5åC­¡ÖQë)_jµ‘ZH-¦–PK©éÔrê/”5ƒšIyS*Êžr–n@)(-õµÌ[ÖlãcS-gä!ò§ŠÕŠ»Ê…Êú0=ÀÌe^°_²:ö{›ìߨL1Q à1¡]ЙŸ"³ván‹ç…¥xŒ¹}Èm ZÁ_ÒÜS2?Y©azs!DMz—jt4¡£A)}Êpù(¿'œ/)OóäÉ /éÐÁ¤´ ©‘3ËêÐ W£“\ C Ç{>%cˆêó/Èd2éÙäÐõñCǧh`cÒΤí1ZØ¡•úÓÉMÐ- @W~cA[kU+tBSD~Xþ.ðƒ­ì;dƒ€ãÍ¢L³8>”€lD'n¤X†Ñ*tÿì[¢ð<±ïd¸A²ÄŠ¢ Ê¡0£ÌÉÏùš%ÌÉè–CmÀâðïã5qr&ã6nØ^2ÇR†sj¨i®9ãvÁ²‚8¨íßÈ»­Dö™ÁJäC¤¢½ ç#Nª¯|jý¶F/åOh®žÌù ‡mð5˜ £…¸Lª|ç*A¾ˆ ÆøúúÆ /Õ7FR©f,nüg£¬éÖË[Å·ä8„j\ o8P¼«I›”§)ð-€slÏÍ̲þœqY|fbVz9°ÕS¥þV›¿79^ŸrßW Ë v‘gÔø-'"‹©Ãڒ϶$÷oÖÇ?ÑQ„pmŸ~ÔhJ6RcÔDÆ$ÀáÒÜ,(*ås²æç˜,ºSpL¢È¡íæ+i˨T NŒÇ×Å;~‡´Fx,¸pÿÆïÑ^uIãËøîßá}e<6¢@ìp†1ÎÒúw鬖áþFNЄz×w·þ›nþ®©æÝB»kÍ¥_ ºËjPÆ;ÚÕ"Åp…dÅ/œú2‹v¬Z±ÒXy‘çlñÃu||zq¿®¬ý+|ÓÆg.£¥ÝÔñ8q² ³Äñ*‰Êˆ0FAdÈd5Lîi£ #=I=ƒÄMA“ò²@Q˜”š^' +ˆ,Ì(Ñ5]x¤Çâ+×#%¦#= Söd¬U¶€ô0˪p~´\Œ©VAyR–>Sc‚b¨`1œy¾à qØE\2¦´$œhh¬8ÕS |Ev^ÖI`»ký–©µ ™d .~0ý,ìNOGË™ >6<áOÑåEP­&^H«fzÅFÅt´¡ ºÕfY­sN²ŽEt°Èš¤Ž£ä¢'S=I‰éÆCé|J|슠…ðʽí{Ûg ‹íù´´0ÃPÂNÖï‡öýµ®-¨ýq9Œ#Ÿ ΕÊm@EáGZISpÛŒk¬rIý VÁëEóÅ^1\ õn߉âÃø·™¢%#Üç’OÈÔóPÞÑ^\׬b¸ùÔ ®]¯Ù®ówÛ5ÛôÍpUJ \,j9fiªé€0'žµR~«ÁjÕM8Çì(¥Î?žÃsî•è%a.M€´}iÒøèUkâ‚¥~ ÀQWÕh¢kr3ëiqùœ¨¦{Jè&ÿ0]pÌ™+ÔSqŒŠ¬¦¹2MÈô»=21Fr¼M£¯uèó:ðœà(q;a1z z¸p­¯iñ e³¾'¿ç Ñ<zä¡¡9ƒ©å1XÜ,ðZ ¬Àp·=0]itxyG¨‰‡3>¼‰ï‰çúi´ƒU3ÔR„’­fœ:Qfœ= 5k;k‘#r”#rΆ÷JÖ­Jl JÔv†òœB_¼9[çFì|–|¹­,¸>Fl؉ ÏÚÜÆr•ÔþÔõ1kÇl9ûg\‚Ó¯÷ÜÀÏÈ ,¿†ŽÌЬ„V¶*¿xÎõbJ±yïU7´¿rëÞ…=-I…ꢼÂì£ÙFCF$±QÇ÷ÖÖ/«æÉ†©ªM°jéRè=Ïs—ç_€ž7À{3?0d§ Ùµi¢{èٳݧá8ÿŒ¾×¹Ï_ýaûô]‚Ÿ óa¾«~µ€xnùbð ÖmbØOsYgèüÿl¡ÿ·ƒÞÈToÓù¥ÔãNsìÆéÄ)®KoÑá.“…ÖšWIe{“’s½!þKuj‡y›&,48°EÛ)4¶Y~öº^ÿÓ)ûj³åb:¨ ;álTsàåü?Tèrwæé³wG´IÜU}ùº—“ñ¡9¼)1GÊŠw‘Œ+Þfòa£16†ß³'¤iëñ50šŒZâI>'v©-~æäþت´ö¤#çbo† vKü²9‹‰m=ŽKá¥û>Ÿ½Þæs~ffe_Ww%àfJ;ŒFçë8ÜJug¤Ä€x_a=N¿ž,.UÅaªrè.GR•6¹G'`Ï Ý'c4t—é'¸(½?A—äT2F¼ßÅHǹ³ó‰œ}ϨøÈªÚs+•­X#)öÚánüFžwÿ’2AÜ/Ãfk†9 óPvW˜'þ‘©1æêö§AbOº‡¼”L#²O5L‹é;h‡è…vKÖJ“m4nÃN«¤Þ¾.”b©\‚´P5HJ?eìõ…¢O>úWÒÂpœ0‚®X¯³ÖdÊÎÌÊÎÌÍ-î+±µ¥¨ÿ’7…endstream endobj 485 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 199 >> stream xœcd`ab`ddôñ NÌ+64Ð JM/ÍI, JtwÿxøÓ‹µ›‡¹›‡eýw¡S‚Çù0€cƒ1##KÈ÷5|ÿ™Z¯2,(û~ñÄ÷‡_?ü~ëó¿b¿£¾ßú´òÜ¥î;’ï~3>ú­,÷»õ¯×Ã￱}ø}‘µüÇQï€ß\r¿U¾Ïø®Âöãl€‹<_éÂs¾‡/œ½í×Mn9.–|Îͳz€ ·ˆ¦òð00M“Pëendstream endobj 486 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1790 >> stream xœ•{T×Çg0gAÀÎk£&¬¦iÐÚøHCÀEÅ$@”‡°òX^²‹ØÝߺnw…e•‡Âò)*FÈ"ø &*©¦PS$±¡Øj‹Þ¡×žv6œ$í9íé9;ÿÜùýæÎï÷ý~î ááFH$Ÿ 7ggîÌ Ýœ²;?cg®ëa`ãôýéýRðvo_ͧ¾öE¤ÏgO}8×öˆÎK'⩬Eé™?~ég‹—<'_ºÌ“ ~A¬%b‰uD!#ü–ð$¼o‡ð%I51Wü áATId’ÜÂܦÜ#=¤ÑmRRº]:J>M¶Po ~Î?Ü¢" à‚ßçðE_Œ8ü™~á²O­WC/‡ò©;),Nx5OÍêÿH2·ð4RuÝRÇáz*A ëYõŽñ,´Bœw´ô·¯FRLÿÔïú?øÀþÖÿÇ\±f5QîPžDI­üD‹Ã÷Äm”56ÚáÏ$ µ¿—]̈¡v•–¤B_-‹’©û!çäaköDf6·8Ž6´+=œob»_3З.%/ç2¨MÚíkY/¦ìÛ šÑ¼ô—œ£½=§›XfMŠ©%ålPÍøÁ¯81 cZŸ]ž“´=±Ëùá•ëHnbÅrä﹑ð¡Ga#”›r:0‹–Ïstµhçù®®–«±Çd­  ¢!ÃH+¨£ºƒj(ƒ²*µZµaͼ•“jó/íÇ]ùIÚ- bØ™®üë`ÐF=Ä>óäÁ¹Ù©»VéT·Ñ,Êp:]2–Иá±ÚŒ¦›wçÝ^Ò T@E¥*OO»¤ì…£bÆ´»¤”,Z(ÖgÑ(¯8û¹ûöŽæ"·ŸŒú3›PØÌºjÓ)N (&?ã2ñÚ¡·EÏÃhÔ)ã%°C¼]ZšñÚ,<ñ9ÍYY9JEVsNgDZ–6Q"÷üÌï™ñío‘šéûÿBÍ­´!,y!~CV [<²¹a< ñáe{éÿ‡¡Oû¯×îˆùo }Ÿû¿2ghùóBn¡|â.hQ˜ŒZØF5€¥ L¯W•³xäI’TºÂ¨T­æV© ÑB#Z¨•òJêmm7÷µš—a3‰Ì‚T:³hAûÔƒ%ãHÚît Ùxg¡ïcÞ:Ñ>qtŸrЛ2D¿ü{žY’žÂ¢­T]õéò3@#Ÿ±/íµ•Æ*¨†ªý\ri¼z«ÈTœ=ÃZnÒŠ,Ðe )æpU êz‹ñ ÅÄZí'Æá´Æ*:¼û@<$Cª~kvbQfRÆ6Xë{”Ã4s^cÔ›MG:º³ê ‹÷”¿µô¦QŒ|ý ÍåD3W¤hvZÑ'¹<½Ý}ÚŒYs”²÷$Kó@©l;7íCÚ ™ÃiÍ…®˜YZ(ÆŽ¹bž¤ý˜ñ;ò"‹ þVZ(y8ìŽáý28¨7”Õá Y:Šô 4  ôÙê 0ѦjsyIìŽý,ÄÁÙ8°7`å$Ž@óŸ£-V°þûºH+.|ep¯‘‘WÜ„üV1ÐåÚʪjÐYÕ Æx=àçŸÆ³ðüñe¢«PEW+kêÏ ²°(;P ozF€°t§Ý)”}. Œ²æ|P±ø]ä$mФTB¾8sb'¥ÊÛn‡Ä©‚üæfh²±È‰Þ¥lMßÈð Ži/‡¤ç.j¾ë.¨Ðˆ k†×¿\ÑØâCUÙ»×êÃvˆ4>ãüißš‹Îƒ>·Ÿ{Ð=b¼ Ãô2«Lä`©zKÁ‚p•Ò!¼¾`J3“07à£Ú‹_߬9'àÆ¾¹5VÃëßñ-tò×D±ÔŸº [üø4*Dkíæ„AªUgØËîJÚ–âéÑ à½VúIˆ¹:„MS=ÆÏ¡W_@Ïw›å6úóÔ}Þ÷üÔÆ{‰SÈïž?Ó*âüº,ƒÔVĪ‹Þ®X%@ãp¡9õö3|½-àÊÐå‹ðf-ú-öa™hì½R¾,îT¥­±Ã~’cƒ± fÛF}¼è?8W¾üõ«°žÍa_ì'eÌj èrŽœ±ø¿v Çü=^‚‚ÆÑ¢q:.º$œ”ÙÊDÓȵ¥Ñ?ŸI<;—©.°M²<™ ] oˆc$ˆ‡n'5 ª4îÉk^ÐY…–Àuúã½×~Φ“¥*P©­:#÷~¥A}Ç¡}{é* T¡ìÙküDôÇ)þ {Åg ¶.î"…v5v å†ß@áÎÅb¨1€•žSÐ(¼jGÙ5–F’÷›ÅzyÄd{{: ®Ëd2° y{Ä?àGÊÿendstream endobj 487 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1608 >> stream xœ­”}l÷ÇÏqbð ¥sOÛƒ¾wü1i“:h¥­¨¬…&!^Ú„$8y÷+~‹cŸ}—Ç>¿ûÎ&6±Cbœ&iÉ odôE‚1Ö¬}oÕV•ª¾ü1©?§g©»”hj¥nÒ¤ÝI÷ÇÝéžïsÏçùH°ÒL"‘ÜýtE…Zä)½ºóèÁG¶©ZÛ jíÊ“Ÿê„æ¯ÉåÝe —‚¼tògkz6}yç­×îÀVŽõݽ‡Ž¶×ttv=ºê°jì l7¶û ö4VUb?Ç~„ÉÅX)vUB—<^òwi})^ú^Ù³²C²YÙ—(¿á›×$æÈȬ¤p×ÍÀ’´P@[Q'ë²3.Mè~«>Ô ¸ÙÍdÂéè)21=‡ÖÀŸñ×k'wn¯­oí&\‹Mgê  ´zs§®ÑQ €„·ÉÙN·òX(-x”ú”“O&8.D°ÁðD`8óQ9›ˆN³‰øðfòù‹ççn>9ll¬Q 2S=ik l¸ê|ÏìçgÑfžóß} žÍ£‡o÷Pù†´0„rŠ/ö\ßQÕÐÒÕM_}«ñôúë€þN<~!yõ,à§Bzãcœ¤PZ¬vv0΃ ´ÚÁ4q¢~^#—`˜îO@*n{#¡ä«9´–äõãmWGÑÑt/ùØŒ6wíÕ<ÓÐÔøÌo„ÀÇ{Yòª /‘TNÏÏf&¿”ª?@Š=l9{{¨u^2+vgô„ìv†ÒR„µÆT{pý@*›bc,O"²pÙëcãÊ€'b÷tÒŒžø£ÇÀ8¡Oiw¨ÊÙî>FÔ µCݳ• Ö ?Há­7ªn][\8™$“»þÊpp2Óá¡““ñÁ ­GûvÕ;߯ŸùÓù±¯ÒsäéW.Μüzêq»Gû ¥!mÀ8šñ ßHŽ.¬&W|"ùðfþoR´°\ªH›Oè5ݺ.à sfôôHŽH ßJ¿£¥å àv{`l$”äÇÉñ·Çߎd¸qR^:ø\ÝCja³íö‚Q–È~zn,x<êîq Z]dï®Þ§€é}B鶸íp¯Ÿn»üÙ*’‰)LhÎ>ø6’åS¤™þ•˜)eIéº4=SÂ4’ÍŽjẂå|aHà‹MÏWÿ¢bµhÌË&BDîæÂÂ%À‡9k»•Or[q¥²~·ø#Í`ñ3Þñ„ "øHoìîÕ¶·Ni¯¾‚J¦‘<·Be{ ƒ|á«$Ë-…nÅÚ[·CQü@¦\ÆJá÷匛v…;CT8æ ‰«è×§9ôKÀŸ—弃NÚslÐC åÅô@+Ý¿”0X‡H´‘-{_†6Ñeáû¡W矆ì`=~àÁïõ³Q¤,œ.Lz}"ßÿý“kß§¥šÝ$Ó?Ø/®¨-Bcþ`Š]IûàïÄ)¢ÙßXHþ[TŸ‡°5jž1ÖPé1ÞË2¤×ï?1xçžd]h*=1Áñ‹Wæ§.ˆ…9:ìxÆ â÷ C–ôX.}vB7¹¯º¶I¥"ªUÚ~³ë‹ÂÖòÛìâÿ…]w!l)þÅc—Èùñ¸55>÷ç‘j‘ºa•Üàf´±‚ß;×üâÌèxŠ'F¦N¼ Á8Û"¶µ,Ÿ—Ì/IQde§èm€¦€`hwÝo©6©Û×¹2#?¸XÄ}ÎôórÝQtyÌ`_«Xè¸4›™HLjd>ñIJÒ3K«F]Þ¾bÔ¯Éïõuë4ê.U[ÅÂùÖžd-ì‡JsÍN×Ë ÙF8Zãñ£¢]ëþve£Á_ÔÈ_ŸËOŒæÃYÀ§Nöë(}ÿ²K[ªÜÇ]]àþßü¼ÆÔ@:4´ Lßó³tûa¬Ù¸Œ“,ZÀíÁâE”*/ˆ. ¯äQ-n…(¾'Î{2ä}r9†ý äÖ©5endstream endobj 488 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 780 >> stream xœkHSqÆÿÇmçœjèò´Ü˜ìtU* +ƒ ©Ð2°,ËX^æ,5²«-Ó´›keœíÝ–—µ.¤YvñR™’§}‹° AaPH¥AEÒðË{Æß°Õûáùðòãáù1DE†‰Ù”½­âà®CK“§W(û÷2µ„‡ÂÙЪ@«¾–bßOóTGþ&oýx.!©d>ÙF I a#EDMÞ2ÉÌ%f,ê*vFOªv& ËÊp$b»Â}qÂíðÐLyGqÓиâñtûŒ‚Î×Þ¦Û2+Ì’vÀN“ +ƒÕ°ÇÇ[¹xÝ·ë|½K¢ša s1_3üŸ-I›IÈ)…(°c¡ƒÔF[œu.×~É(H®cÕîc¦CVVXëë B¿Ip<„Ð#ñ2W ePðx½>LÅ ¦ÓzÍÊÿ죟ðØ$H½ðº%>"cEd”Q™ÁDŒWâ0Q~†ßôx˜.D=-0O¤[‘LŒRbU2XÌÇ…ƒûDšèÑeê,ûm…–ŸØ Ê"Ô"ãìE×Ë<ÀØ€¬J£½œ©ü(á,iåÁÜ;[ÀHæ-£"JA1øøJï€HwdZ9Œõiòð‹jA:Y]š“ç8|ö–ghÄ9ïåÁ¡'iùbô$3O WQ÷0÷”t•R‚6½•u&œØL À¯`ñþix½à7¶‚Zó„Š­£™m¿Û3üg–Þ› N¸Ài¬º ­fEÇFÆŸ!wö+\?óê¾ù¥RÞa±PµêSr+×PêÏí‚ç|Ç‹ßC{iüMó…Jpµß 7EÜȵ‚¿ö¬Û}Æa¶oÈòFL“2ÍÉê,j«ƒ]ç©©¹&ݨ¾zò–ŠøB{æÜ54é:.8kv·@Cð•PT¤Y\ 8[ü^oS³y`àuÁ÷úG`ÄÔ¨ ‰ÑŽ€’ãG[ÛÅ+OEvšyªz{…vJ§Ïçñx/xššºµZBþÐÀmendstream endobj 489 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 324 >> stream xœ9ÆþLMMathSymbols8-Regular‹‹ùtøe‹ ‹ ®÷¨âÝÙ asteriskmath¦‡,·÷¬ÿ:f÷w¹ùt÷Ž¢u‹}üÓ}u‹tt¡‹™øÓ™¡‹¢ÿBøa÷1‹‘û%Ë÷$Ë•˜‘‹ž‘‰¤hû%(š÷+œˆ¢o‹y‹}|Ž}šû,ûå~”…‹‡‹y{|x˜…•‡÷$Lû$K‡~…‹x…r®÷%î|û0†‡„”t£‹¦‹¡‰œ}÷+÷;¥y‹“‹—›š•³ù§²¡¹ ¹  W/ §Ž“Œ‘ŒŒ– ïR€Óendstream endobj 490 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 435 >> stream xœ¨WþLMRoman8-Bold‹ûVùùP‹ ‹ °øËÆÂqSR4ƒ7÷¬ÿ†ˆûV¿÷µøº´÷÷¨÷Y÷„ùûV¿¨IøåôYZ=_½Y§F‹û7%*ûûð-÷/Í‹ÀÌûPIWÁŽ®‹±‹²‹­‹ÁˆûJ÷ì‹y‹‡{t`QVj‹CPÉ÷÷Õ½Ðݾ=Xÿ¨}¿ø,¿÷/ºÏð÷êðøø÷^‹÷6Þ'Ÿû,ªCši·‹··ªÇö¢Î‰cÀÃ`–MsŽxŒ†¤‹¦Œ’£÷Hž‹—uŠŠttlm]¬S ;‹û=E"*`™a­d¿PÊ·‚÷ráy¦U‹_l}7û[B’®SL²‡ÈЫЛ{‹€‹o‹ƒtûHx‹¡—ŒŒ¢¢©¨Ñ]ç„¿‹÷HÉ÷ í}™øP–÷_•™¿ ÷  To ²ŽŒŽ““Œ˜É› Á¼ºvendstream endobj 491 0 obj << /Filter /FlateDecode /Length 4544 >> stream xœ¥\K“Û8’¾×_Ø9趬 ‹K¼Á™ÙÃLïvtìvOÄÌÖÄ쉺ª,³-•ÜíjÿûÍL$‚’ª&ú`•D‰|~ù`ÿºij¶ið?ÿïýá¦Ùìn~½aôíÆÿsØüùîæßÿf |S·MË6wnܶaVÕV¶£LÝ µ¹;ܼ­~êïo9þ­eõñ¶©% kÚª{¼Ýâ_–Ym«ýíVQ7¨~èâÇNøT «‡‡<Ñ ^%k‡7¸XÖ «þç -U­´ðýˆßsX]ýpž¢MûOoÂOºú.>nèOcß=9jZÕVþýên"[ 7á¶n$ÓÕØÝþãî¿'º‰y"„®™BÎÜ=ÜTŒÝÞýró_w7E–j|ÒÍZ] ¹áˆ·rÞ)6Ããæÿ6O°#WvóŸG·¦(†ôÈ +j —mlϸpbø¾ßÅ7=ÃáŠì÷·[)eÝZ^ýý§ƒ$,\—¸Ü àtµïN'Ï4««‡˜›ÝnèžeðÛñƒNØjŒ™;i’õ°Ð ÐT§qH9 zL¤›èÀÉo ;|ˆ–OV[}¾Ýr "µ2Óž Õš¶úBº¦9(ØØýñ)ÕC¯KŸc6I˜4Õ×þ!½ê|ÄCP'^½Ÿôæ›Wq¬6­ªíÕæ­ÓþFs­¹©‡>£ª¤x[ÑšZ ¾ÙGân#/iyKÄqÐÆT#S=MÉá .©–²OÙ]ƒÊ;¦ªïH3)Œ«D#Uko§ÇáçÏÃá‹cíÏ_ïG˜ÅBy[sØÈó ?ªxµÊâßE?jV÷ïný³žº!,4¼Š]ÕiaóH°ñØÆÁ»i¹!VT]ØÖ{rÇ­{§ù¬Y4¤ (t5ü±¹ûñæîßÞV_QóÙÛ‘¬S–´cº±ªîbΑÑA8‡˜ú0{ÅT²È3[Uý—wOnYË[/nAÑ%GËpŸˆî}̶qèUº‘\UþAkK:FD5:8-0Žî k¨q<%º(»DÙ„»ýþ褗~ž‰ˆŸÉåMß+•†ÃyŒ½vj®OxB#Aœáš­ÌIâ qˆß—XÓÚÖï'Ú’±¢V *|ˆ,¢„8ˆŽ; ’Ãe¤]ª¢³ÙóªH«AÛzç'Öz‡ÄpVã¾K€É‚_°Æ ‚Û´ˆK=¼AÀBqwaït¹Ò%®±' nnëŒCr¼t"L~éÂNREn$gXp‰· à1TgZ &ÙaôûC¬ûxytï}7Ð3&V¿K ^§å÷®”–[Ð@LŸ‘¥î{gÞô=Hçèÿ— ¾ÝYäð!lÄ æ_FV×xœññ~ÿå4–p…°µ–3¶zw M\ˆNžP‰|‡ sžÄz;Ÿ/ÀÇO—sr%è°MCn‘B¿ kÝxʞߎóv\xw[;ä¼’¿íKyµÊ©S Mz/zÞšì9LZ ) sÀ¸ëQÓ-VL9>º`ÃŒžÂÊŒâ¼úvðU£[‰›ïµí0¥`äÂB f'>¦{÷O‘OÜ…V¤öŠ1¼ES;§E1ƉŽ˜/¦À[ºìc%Kµ>&6‰2 ˜q[Apð†¨1Lƒ±®Ò6,×£?eËì‰HK\…σŽC’#þõ4Svt*¸%g%eêÜ@;ÈcC´þJbGqDg:Íò@×aŸç8°ùò7X~pylUJâ@þÅ$ΩFÈ0rË.×5…¬²,“¬ò–2 É()pûÈRÒÊi%>7ã Ǫ ô^éWOR ŠzZ¨0ÞPìÿ^À©'Õ3\ÕHm†õjQ¹L!”ª-ÓiaSCÕ¢ Ò–©Pr®þ´²#`ijïè!`-K¿m™©¹Ô-ù?—º–ü$¦ Íä'_»Š¦æÂ¿™¼P¶¥jEýP¥¤oFÆë¥8¾ -z¥ót¿¦i— "´?g¾•¬Hq²"kÉŠVÖ‡Âuá·$]IL†‘p¥¬xQ’d À—ލœ·ºdÑ7é,åœe‚q<;qQKp]yœƒ€k-Zyæ)™†J«R*C‰8Žã‡Ô¬–Ê(˜ ö*eÔF®'ˆ}ĉ²?®;tÀëOáºê?øM$(ÈèE®Umå#|ëËO÷±¨NŠŠ²–$à’»j\š ‘¥M^póÀ^êÜã†ò• Œ v´I”9ƒý1s–„Ûêû[‹ÚÁã²U+ûºR˜šMr„ñ„ ¥ÉS”¼º elU+PZs^ÜÇg@ ãš·°YtòMщn¥~›íApÚWwE‡a&Ü™§®¢AaP µEä€ÀÀZÎ1ÍqwG¢MQº ÷‘jÉPÚG¿2{t»Šk³Ç7+é  79uvãχÇñãñae§VMuK*7y6…œÃU"F¿¦P–o,ñïZEòWe¥˜?í!âòÑûˆ½FˆÌ7ì’8ð” 6 ÝH…7°4³tùô½~eíbÞ ÛB†‹2oyÞC3ÈÄ2ìý¸i58ݶ‰È´ pw¿ª2iBu k %OIJ<8äŒ@ûÙË0a QTÏUÚr—êº+zº®Ì+íéùŸµ‡ œÞun9(‰’‹q˜j;èY—匽‹iСrbviƒv0tq ²¶ع¢% @BÅÛ)½DŒ?¶YÉöEi$m~{>n;u©É]l®ºÅ€Ë‹™#¥î©—õrD&è¤ãÖP6CŸ¡¦V{T}*âѶ–°Z¾ØÕ*‹GSÒ¿_Ö KZFGî*_L;îÖÍw‘Õ(Maª÷½#e`ð{óðð·Uöê ‘_ È#+A™¬m-&wñ©è"ê†åAC·‡•äÑß@ª<Û¯WRQ3½VÙX1Û˜xŠ€lLu¦•rÉÉDà–†œ¬+ë %Ù#‰…Wûþ2bˆXè¦Î»y¹3©ËÆŠQˆ´µ î ,Æ ¡jò§¬žž)]è[†&Kˆ¬¿Oþ:¸6¥ÖJFI·1gð …‘¢ës¤áWt+þR*‡/æÀ5Gó…ÄñÖË8u”€­v/?]½ ϲm¸˜ bƾÿ4yÓ<$.hœ"Ó&­¦\Ê ±ª:EHhTãzã….¥t“UÆÒ2÷©w‰³h1¿Û庥õçå¿4á|-÷ÓÀ]CäíÛm–J´g«¶VB±yŸ?nK;!öoÚ›20ºHoƒØÇ¼ƒâ.j®¹©µµž¦†ªâMUm¸nUIŽyÏU™¾.çá"ª{fqÌ|!¢…!DŸfHIµ¼DÏ~ó©ŒP™:¦‘6ù)¶CLú ¥ÄÕŸö§ã<ö¸ænN(ð«Êa8P2#³ká9PàRý)P£_¾²Kºq£ïû4 u# ¤ŒF(È%¥a¹2ˆ.¼+‘Kåº÷«~2Y}ŠîDIÞx¿˜ÙÀ}ó‚ÅNf °ò|Í¥MÞA8_Œ aÅ®P C?*ÌB•Ëûd˜if‚òÒXfk+Ƀäáê\lªøM3\¦ú!t¦ %D&î:"ócë펇0¼«‡dx¸äî$ ÑHÓ»sí#'ŠõÆyŒD;×>Jjåj9Î1ùê|‹»%¥ù×Â|鹸ҺRðòí¼ÖF/¿à®FÌc»™8ú€'0XmõÍO‚‚ÛW0ô¿…•²ø"Qúh|§)¤G}yn9-ëüæ² ƒx]šÕ¦§.™›(ÍjkìPf£Ú¡‘}Ũ¶®š‘Ù‡HÇâ‘ÛCú’€ošµ§“ QEš7»ÞùgÊ#¤Y4ÈdKòO$îjës oñ6žPÈ‘¼TˆM‰í³KëçY^ÀØßüól¡m+(†7M=!_¯EeÃŒHYiéÕ…@¢êèFÔb1é»NŽMÒ\¸.…¼ö›ž‰‚ùà±8Íû²™}wánºoÅûòÈë/t©Ô3pÅ‚L‡þéfN®ðÉ‘1y¶M‘Ÿä¸uô©ê‚Mwáf(£-$âÄá‹W ži9£GmÍX»öbç…,ׂOºº.:Q‹ù„EQ }½‘/2ÁEØ>¹¶`³Rˆ¥2jâѰ닂xde†M£w P\2{ gYÁ‘DSñ9²N˜ 0›×Z¦%@*&jCWM§z1=É!•Äq«¹ì8 kMæ}ï:Y®¿ .B¿?^Ÿ«¹Ð¹HS’‰ÄrÙ?ø§„θ¤Ý´Ñ2ãÉ{î´bÜ»éÔ»šZ l¯hI6Ê&Yz¡/tV±bŠ­Açõ™qÏ®…–ã÷à=ãq˜:§FCò“!«‡ñ\¨±ÍO¾ u)Qõu:ö&ÔÏ–ê=ir•¼“sˆsØÓ|ŠûŸ ’ìÂè‰ò'PÃB +Fyev ‘6|ßs!õùx|½azã¯7ÿ•ÁE÷endstream endobj 492 0 obj << /Filter /FlateDecode /Length 270 >> stream xœ]‘Anƒ0E÷œÂ7`LÀN¤h6é&‹VUÛ {±ˆ±²èíëñ”.ºxHÆÀŸß_®/×´lª/«ÿ¤MÅ%…BõY<©™nKêô Ââ·_kWw¹ë/¯.}gRu€¢ø›»Sÿ1Mc»¥å_=²óT\ºQwÀsŒØQ ÿ铜˜ã>ªQ{Àª `&Ö `Ö˜"ë„X`5(€ ¬°íUGÀެ'ÀhV‡˜ëŒ˜ö!b (€±¬„ í7" `MU]wÁÔa¨kVÝòš#kͪ%¯g­YuË;¸¶¾}O¼Iîd¯@ùg)”¶V\+†ûXýu›×̧T¥ûÀ)zendstream endobj 493 0 obj << /Filter /FlateDecode /Length1 22268 /Length 8727 >> stream xœí| |SUžÿ9÷woÚÞ6iÒ”Òö¶µ<4´µP—$´¡J[ÛEE›&) ´ILR*ƒ(ά묣«®#ƒøà!ƒŒ‚"°Š ŽfU„Gtf|̬+³;»[ÖEשpùÿι7MZ "à㿟ͥ7çžó;¿Ç÷÷;¿ó»gœJ1’•HC}Si9áŸyÃÙÍÝé jÏÎç ¡-î¥%iü®ÿÁŽ œmÁE'd!P†}[u,kÓèg~AHòêv¯Ësin dµ;Ç·cG¹êO@zœO.iïŒÜ¨Ë‹à­¡#àvéòîÁÛ¥®ƒY‰—H„ˆ¬Sñ»:½9G ñY!dª)G®&Ož"ÄÎä+Á7xÍÚÖ^|n $á1ÚFÇÒ6ò<ùwÔ~*Ù@z!Ÿxµa/ûÞB¤Ç[‘òVñ6êÄïNq#püñòèXÒJnÀV±¸‘>Ov“?áì[é]ÒLéjFÍÕe¼>—^¥Ç¤‰ÂDÒ,vŠSÅíâ­âv¤èÛÄ[É6¼OÞ—‹o‰ËI3ӌֲ?¦YCgÑ"²FXC«h6­—Qç6:®¡“¥7¥7É»ä]Ú€”[H· Ó×è§´”6Óí8ësò9Íǧ ¡‚¥ÿ†¯&oC³$“5änš†OÏ“¨÷ŸÈ§$,"Wr·ô®p™ô.y•|L~‹ý„,¦ÞsaŒô.^ÇÈf²‘ù˜ Ò»†Œ„±Mø‚ôÐ ›„/hðJ£ùˆæup@l_ÿG*ÀXȇéx¿–QHïÒ5¨Ådž6º 騵åô¯ »ÐÆÉGhJ®– kÈGôIº5&ä6ú¤Ø’Ð*æ5†5b39ʰ!o ŽÇOÈO —“ÏE9µ´EÜÌ#ÅÒ˔Ђ„Y†4²ŠÎJøZB`YN2pô J¤—µ © ¹d•8AÝaE7ºŒ&B+yˆ_÷Ñ]ä>²‹„ ²€Ï&$J¬Šy›P\ãÙf»ªYy}AÁë€GÅœ l# ی˔]§N54‹9Ò‚mÒðmPœ¸M,.úøLƒ±ÎnhVvÑQŽ*­£¥ ;›š±Éž°ûU|ŒIÝ&㿚–mŠ»]¹Ã|GѤ;ÌÞIc®í„N5—Ä>”ôÿdðž 2šz$›‰$"Ix ¿ÙÂF¯ì›·º%ÉøDõY"yTorxLo‹Ø~VoK$…¼¦· $•¼£·‰…ü‹ÞN&¹ä¿õ¶1íajÖÛ&2.}«Þ6“äôõ¶…ˆé=(‘ŠI¨PYú1½MIV¦¢·’˜9^oQ2¯ÔÛ"¶¯ÓÛšy³Þ6¼ÌUz;‘fîÔÛÉdRæ{zÛX<)ˬ·M¤}ò,½m&Y“·ëm Iœüze ¸,ä[ÔQF¹G+åeec•ÖeÊt_$ y]V¥Æï.QìJ#£ +Þ°7´Ôë)‘O›:žMuº–v.ø)Ó]íg˜Xå]ìš×…‘àò/ò†WÈ«øüJ°«µÃçV„À¥¸Qi)#íÞ(Nnw 3ˆäŒ ÒŽÜe¯?ŒèrH G#3â ‡nŸ åÉž€»«Óë¸"LŸ6_:iãÈ'(M¶H7Â_8šk‚{r(àér{9 óµvE¼L¹ß+ºÙÝÑåaštû"í®*ÓéÓ1 ! JdÛFzfŽUéô2«e ávkœ +“Y)a/ú©}¨ªnþÑL9dd@Gd :.¨»ë´ Ì m]!? ôò‰ž€X•pWëb¯;Âz˜}m 6f;à÷ø˜áI²ìDv®ÖÀR/·@‹"®@_øtCXëe^ Æ"@SÂí®Ž¹Õ«£†jà*qõ³3àǸ)wP³•Ȳ ·Í…‚J4¥úvº–ájÁé_›š«#‚¡‡ dêòx¸åtlºB¨WW‡+$3AoØ·ÈÏÕX¤­UœÄ"ÔåF&a6#ªOx $ÆRF0WÇà ô9Q=bÜP=Ç2Åæ23'äe$§e0’ù%º<¼sÞŸÔyÂJaß:,d²£r![¶…2ôL­¾^Z½¸’×.ôÃdiÀ×§˜÷ƮŠâòrµvxÙ€f;rf 9æ”vWDiw…‘£×ßu±èö(]~®pLU™+§Yx6¯†1yãªæncNr),{àZ‰]î%®Eh®C@f¡úõ‚ªŸ(LX¨¢·£)5ӡ̨¯s*Mõ3œóí¥¦Iih¬ŸWSå¨R íMø\hUæ×8gÖÏu*HÑh¯s.Pêg(öºÊ욺*«âhnht45ÉõJÍœ†ÚöÕÔUÖέª©«V¦ã¼ºz§R[3§Æ‰Lõ|ªÎªÆÑĘÍq4VÎÄGûôšÚç«<£ÆY‡‡Ñ2tªëêç8äõsëªìΚú:eºM±O¯uhº¡)•µöš9V¥Ê>Ç^Í̉ adš918d6¡ÚQçh´×Z•¦Ge k Ž5ŽJ'§Dì‰Z®ne}]“㪹ØtQVyþLØñ_%׌›_‡æ2>ÎúFgŸ*ókšVÅÞXÓÄ<2£±Õeþ¬ŸÁ#`.âÉœW§ëË|ÄúN¤b³u«öZdØÄÔÀ¹-F—ãF·7a±­/n-5ò4ªåN+Z- `Wûqáj}¼‰Û®,¾ëhÙ-¶a³íت¥^ž>0ºq'ÒR¯g©3`˜¥’@H°dÒí ó•Ž[`g@Ûó”°«…á,¶Š8æJWN ÷©ÙoAÉÑÍ0òá”î/‚ÉDquaoÈ÷}éÛ·@‰YÀ¤Ä’ƒ¦Èâ.å[êíXV‚´!¶—qM|~¬Õ:uÓ9|îȤh©Qqæž@DÆŠ®D‘e^q]pét®¥íÅ©ƒd­RΧ’curžu|z¤'y7çŽîƒ¨±‚E¾ZI‰ÖJò÷£V’5?|cµ’¬-Ø ª•ä‹X+ɱZI9ÏZIîWœG­$Ÿ©VRνV’ãj¥øåÛ¯\Âý“ÄÅ*—d½\R.¨\’û©Ëß/vÉ$ûÊ—LòE-™d½dRοd’–LÊù”Lò %“òuJ&ÙiŸ7gV=SÛ>ó¼ª#9fù…TGr´:R.¤:’ã«#弪#yÐêH¹êˆk¿…ÒWøÈg,|”¯QøÈg/|”s(|d^øô¯¾º ‰Dém¼hKð«ä¬'W¥Ý¾%¾RfK‚íÁR= 8H#•$@‚d YDÚI„(dq“Ñø]NÊð‹­V¤PÈt¤‰0þ…ˆ—¸H'±bo ñ#} ¶ì¤/…4öñ ó'/~{qÎR¼{R>©ãû¤:QÒR”µçø‘šéáÂ9_Ob¶ã¼y¤ )ÜHëâܼ|†‹[¤ ?ÞƒHÓŠ|}H§àüJwñ±|š8—0j@zÏF•sŸÇµ£¬×¤u¿œLì7/:k̸¶ñ¹ÝO ™Ú5‰”âåÑé—"} Òð;„¶zùÜG¥yxqÎŒ8nQ”¢ž:=ØCÞ˽çEí¤i™¯.ާjY†4í|¦Ç‚\ï÷6C Äg°ø`\—@e ±ëêag²FÆk0Û5ï¹°Úé±.£ïÎÿ’Ïiý\üU;¸¿c6ûpDæ­ïaQÖɱ^‚}ôÀWéÂ,kàü:9·Ø:ðqÚù˜W·k—â×½nÕý®yK“¦Å˜ÏV®W€{ßÏçõµ¦I ׈c>= \œ‡†´¬óŒp-Æ“›Ó±8Ô¸G90jMw-–½|åj±W%…Üsl®‡‡¹^nœãÒí“ù*pc„vr.>ŧ [úJÕ§cLË5LÿƯýLb Ö䫯ƒÜ|vT· Âc­G#|T“!ŸE‚U_ÍnÔ¬‹sÑ0éæ1ÐγNDG¦“÷Å[µ!Ô/*5m»8†Ö8ï°v'÷§æk9.ƒ„q¶õ vXûì,åD᜵õ ñöé¨ö÷þÙ­Ž"§iì‹è×+u1‹º9ç$!ºÚxÖöëzã$zøÉ°òo†Äb¤ps~MÔm|Ñ2[ÔCn.ÛÃ5öéšNâ«Ó©kçBŽžb>ˆÏE1NÏ~¤è«!Ü6ºVbˆÅç€øy ·ÙÅ5—ynîkÚ^â:‹?|—StßwòïXþ8_DøNÄvN—nQI?¤Î6—a²Lß[4é ó6®£G¤§¡¾MS†©'ÎçñQÝA]|GôñœÑÁŸä>‹<\Sæ/‹úí«š¤huñèÑb7*c >᯴)ª¥¬[‹0÷ѹkÐ_Î@<Óͪû»ƒÏó!›Ë}Þ ñ<ëây%Æ7Úî‹Èèz¸{xõ<çåVD%us«<|~á ûaaŸÝgÈ8Ým ã¢L[3µö—V¾Þqºvéë 'KqÔ7b^r#ÇÙ¯¯ä ^ÚîåâÕÛ7#ÞïšÎÑyЕÒÎ3¼Â¿ÃºŽ^IgŠ“h®,w{øNàç~Çk0Tå8äâ}x¾k5¬WÞŠnItµEW«:új>£?Ç è%x_¤{LÛYTÉ}Yõ›ÌTg¶ªU_#}?lëCj&qp9õ¤Ÿ˜œz|r’ùXG6ò±ìS°ŽkÄ‘yøT…½UÜ/v>ÂÆ ùjœmƱžÌå¼4xg¼`ã­ðgö4éë›ë Í\†¹5¡fõØf¼ç`o-~;t:6£{æâ3kWV…jòêp–“¯6é¢iêÄþ˜ÔþZÕp‰QÍæàS#òŸ©Ú‘w çÇô·òúˆµët=5ä9w†ãÌxV¢Fµü‰õÎÅï¤kâxڹ͚¶u܆8®ÙâàhžÐ4ªÄï”Í(ªQ/'GIrê”VîGfOŸÏ¤ÎæTšfõº—Y;Æ¥DÇRÓƒá?¯Or·¿/…ÛïÄ'÷ùGùFc§šs`z˹Ü>;Ç¡žK˜ÎéŠ ÏÚ¾ˆkŒóJ%Ç‹ùi^Å%Ù9"MƒZåïÁ¢Cî“PÍísp¤j9uâè@úš¾-k¸­•:ÖO-¨C·’ÛÈ<{Juè1eçØõ·‚ùi>×?f…æ»~¯ŒÃ,æý:Ý»Q}œ\²sTæóµèàTvî릾52ƒ¯ß9ºæsû",–æêñYß§Y|£ë(Jw.¹Cã•Ý߃U<žju ›úÐÐ(ä³ðÕr—÷57ωôåíþ;w|Õ«FãëNk\®¯´,\Íi;ÐÅzµ·%mÏŠ½ëÄ×nƒ½aGߎµZ>Zõƪ-wkïDñU¯‡×çZ î«J¼ ôU&Ý|4¶§õ³“@¿÷<&ÙÅ÷~kŸ¬è^ã¥Õ•.^-0iáAÐ<ó%Ÿöfäû½&¥›·#zeÂìëÒiYÿ¼ GÏN÷2¨¢¶ V9ÄãâþêïR>Ž0«'Kt¾!}/‹aÂÐÎÕ:x=}ŒÛ$2ðTa°(NsÇZ&Ú“)ó|=ãúîO.ö©í÷é§ó þ•¼;N§ØYG”òÜNP;a‘¿³s%å´s%ùÿΕâΕb' ÿž+ÉývØïî\Iämíûp®$z®³èÛ9W’Ïr^ðíœ+Éäëž+ÅþW§‹y®[oýϕδûžùtI{?×*‰ïÛé’LúŸ. ~ºñíœ.ÉgAW‰Cðû}Ê$ó;½šùöO™äïñ)“<à”)ö®ûmž2É_yʤ|k§Lò×8eR¾±S&™c0¹ÎâÚjhÛqüÛ;;’õùwuv$Ÿvv¤|ggGòÏŽbg@ßüÙ‘ü5ÎŽÎÆ÷›=;ŠfÖ3ï(§ŸøÈçqâJs1O|ä :ñ9ýíüN|丟³;\ŒšÈiüm$vÒ s9ì©äþ›«RŽËü+åºyxÕTÂë× öõ¯ÆÎþ_¤±ÿ3ÿœz‚\MùØÿFXIG•-&¼_B Pg‰^Bzñ©ˆdá½Pï+ät¬ TáãùdÞóPÐ\>:œdã=‡äá}ïÉæ÷¡ü>„ß³ø=“frÍäO¬ 4·Óø=•šÈ OåO¬ ÔHSÈØgä}Fòi MÆœ!ñÀûJìK¦2}lðnÃ>Ö4‰ÏLä÷’Âïl†aûÏJ${:5p»$~9p‹ÞCùØN­€SW‚ªÂ‰/­Ò ¾´B¯ ý¢Zúë ø¢þ§>Wá3Ž«ðß{àSþK…c*ü%Žªp¤G–ލÐ#CMüÏÿ¥ÿ,‡ÿáß{áÏ÷fIVáßzá_{áOøð'«ð‰ ÿ¢ÂÇ*ü³ Tá½ðчC¥<ðáPø`]žôÞÿ}±ô~/ü¾~÷v±ô»^øí{Òo³à½wÍÒ{𮽓,Ràdø Rü¦ÞFþoÃÁŸ¦H‹à­_gHo€_H“~Ò`?ïÏ…73`ß{¤}*¼ñúBé=ðÆJñu۩׊¥×Âë6ñµbø'~å½÷˜¥½*¼:^Qáe^úå$é¥^øåÖé—“àņI/–à Ï[¤†Áó{R¥ç-°gwŠ´'v§Às(ì9v©ðl&<“ÿ¨ÂNv¨°}< Û²à)äóT/<‰_OöÂV¤ßš[ðkË xB…ÇGÀ/TجÂc*lRáç2lTáÑ &éQ6˜`ƒM\@­ï…u8e]¬Å¯µ½ðÿÈpxX…‡Ü#=¤ÂƒkJîWŠkî.–Ö,„56ñVct¬Vág%° '®Ê³‚ûqêý ü4îîûfÃ?à×?¨p/âpoÜc†»‹áïU¸K…;Uø‰ w¨ðw*üøöbéÇ*Ü^ «Âm*üM9ühüP…[UX™ ·Èp³ +T¸I…å½ðƒ^X¦B÷ÒMR· K7AW$Gêê…H„{!´nP!°J+ø{¡³:za‰ ‹Uð©ÐîN‘ÚËa‘ måàõÈ’W ›èn•%w ´ÊàjÉ”\« …Z¤–L¸^†ëTX¨Âµø|­ ×\#]£ÂÕøtu,P¡¹æ«0Ÿm§æ©0Wg4e@ãUÙRc/\…WeCC}¶ÔÐ õu©>ê,0'jggHµ™0{–Eš³jLÒ, Ô˜`f/TÏȪ3aF8z¡ªÒ$U¥B¥ ¦Û‹¥é½`Gžöb°MK•l*L»Ò$MK…+M0uŠQššSŒ0Ù“T˜˜W¨0!ÆW “ÆCŸ ©bT¼$Ž“Ò¸ ·R[ž"Í€±6±<./Û$]®Bò/Û¥)P’c¬“¤1½`Í,–¬“à2\êÑ*ŒÊ„‘C,ÒÈ<¡@q\R„\vIY ¥Â^(H…›¨d@¾ yy;<[Ê-†á©éÒðl¾ sƽbކeÏ–†­€lš=†ª0ÄY(-«2±/³2[Ååd$ùÐf3¦¦äñyùy’!!1IåñùùyÅrr^¾˜IöÓCbÆþÌCC×ZĵÅû,«GåÉÉù9 ¤)§Ñ”‘ÐP8g”ùDÏÞC=‡-iñs91>ÞcV?;jþìhÚ‰e³›ș̌#–!õ¯…Û“)]h».))INJNNI6&¥JEÃR†‡™†¦ZK’Jä’ä’”ãhebâä¤ÉòääI)“Œ³“fɳ’g¥Ì4v§tw'îNÚ-ïNÞ²ÛXl2˜L‰¦$“lLž`œ6úúÑI ÉBj)¡E…†ÌŒ¬|*fefˆ…#FZòèØòñãF”ÒZ1nüØò,qHø½ëÛܳ]Óhú‹êjoàÈŠ%G|‹k:§ýå¥ã'Üï‹SÕceec+.+IN*Z÷ÄŽEEÔ1{[º³ù9’xê¥+ìí)¿œ”>~øÄ^ËDÔ¹ŒjèZ ,™W¢šYC §taé÷«kh›cÇŠ´KGAiVæÓ??yBlÙå÷‚ÄAGÍÅbè¬&M; ÖEBé^´þÐþ24¶B$'pìÅÙ/C©ó¤ëP?3N&Ûr‡¬'M–õÒÁÄ}¦Õô°#wØôd[†HŒ‚9q,/?ÞÃP<Œ ö˜-ÛYŸ×’‡÷éÇð+*‘Î#B‹!é:kg×[TV?«kçÆðòåáð²eNî4È[ªÏª'ñzv!LøÅÚµ¿Ø¼nÝf´áqBv¢nÅÄg“™–$&Å04õËŸ}y;†§'Œ´”D£af†1mf~Ž1×<‚Á™ÊàÌ%¶+œ˜r¢çDÏDîüÒ)SŸr¸§ˆk¤ŒÚRóG–l¹rä=#Ÿ™°rˆÚWbØòÀ6oĹ@Ü]µ'øò>u5¥3êÚ‚ºÚÖ¸(ˆíÓŸXÙ›Ú;~rrž0Ó8|X÷’ÍkO¾/ÌܽäŸü½Ø²ñú– ë0Ž b V«“m9©@hʇ¬6Ói¤§-Õ‚‘˜‡ñø-×L8\ŽÀ[0”ílÉY™ƒÈ§£Rb=D[rLË äÂëh»`²dU—WÒ6uÍUÿØùÊ›t§°%xz¤äö[F¹nCë£LŸŒÕÒ#$tÚ†™¤ÄTXo¡;×919IH 0§™œÀ³·™×ÌÞfa·4ç5ˆ·‰á=eï‰){÷¦±Uº·çø6zè42-ýŒ¤šS- B4d¶- %TÙ’‘5…#*,E–±a,½A½ûÊkw©=½}»ôˆúÊ)¢×M8Ež>D? „^Iô\ þ cDÆ(yØvi’dç'“ß y˰ÖtТìÏsøÚ"L¨)¤h 5&“§æƒ1cò–OU¦Çõø L¨ÿzôó£Óø²³Õ–ŽœªL-˜6rŽ2§`¡²°À¯ø nVn.޼S¹³àaåá‚­ÊÖ‚” 2ËóÊò+ólùMy ùî¼–üÛòVæß—wOþ†¼uùÛó¶å›b–‰.ˆ©´8ꡊq—Œ†F–" ‚7\s•÷êS6sç­Oþߪ ßùÛ¿ÿÓÜðŸ#´_¨¾¨U5çÞÎÑ·Ÿ¼uSÛÂ77üj×ð¹õ%%Ô2<÷/Ì9Bš!×~m3>";ÄG|‰9Ñ|b Ï0Re¶¤†¤–¤`ÒÊ$㨀»¡` ‹ö'¶|¹Î¡~ÅY‰8'“!dŒ-ݰ>¬OÙ—¶zhÒôÔZ˜ž9y¨™-4}c:ZöÌ„ôiÙÕég7Ú ÑìŠwáåî+º»nº©‹P‡ºGý£úõ9Z ËŸX¿þ öG‰úºÚƒ×ëô š×}9UJC]† ÛP4ŠÊ¤ÌÜgÞa¢¸^ª-Fcª™©ÃsUé”ñ“½2›å{„—ôȉUJSWÍ™3q½0®zÆÿÊÂã'çèƒ÷ú‡Üú_¿|µ0L®UgH&qfÎQd¶mÄp\™û³e¯MË]Ÿr0iŸqGÑú´÷ÉA‘BŒ&[¦2Ý0yt4îXÌîái·q¶­c.½´åR–KYlŠq„%ûІXlG…x87ÍÚÞu@=NStmŸEÛÕ'Ôç}{Ý×í¼fÛÆžÀM7†ƒ7Ýôbëµ´²÷Kj¿Ö½é„EýTýD) CÆW¬Ù†«Ö¬Ýxÿªˆi>bš¹È@Þ±„\Q…\*Hì 1P¬h Å?J +SI$ æC;×âDaáÞ!l õ”ëuˆt$Áœ¨ÿIGRÛMì Íx)B™`æ mÂJáa°M¿^Âë ^ÿ̯cxeKD X"cu”N‡Ã0q¹„^£ÅñdŲÄd­±%ñFÃíôÇp»ôcÃ*²Š>ˆ÷Kk ›áú\‚&½ ƒ¬ Ÿ¶áE©Õj·Ør¢ _®ÓbŠå‘ Œ©lܧ‡ñzÌ´ßxH^o×Áô1,aº‘dLÆT¼·<䬊ø wÀësnÉáQ-ƒú—¸[TÔÜW¿ê±ÇV9fsn¯¾­>NçÑÒæ'°Þù°¼ì©‡~ªürõƒü|:fâ5!?.ÎqŒóG󞯎sËWÄù÷EãÜqr³è4.Ÿä=KE¯³hfk½”§©E J+%=…ðôaÈøkfÃha¢hŽaý3Ã6ÊlL–“D9%¤Ÿ[RL¥%¦Èd°¤ŠÉIFCšùД½åâßLÅ,¶ÌÇ÷–ã?¾giB1nÒÈ1t‚„;E±hPŸ¡³jÕ«Ûki¿=Nçˆ/o}ò®]êfÚ¼ë®'·Þõ mV7?£¢m¡nôt†d³°¦@lcâ<¼Þ“É#ýPÚ¯ÿò ÕÇŸËÑaøg` D^ÉËÉ)FSªÙ’–>ØiÝÿÚHfð»Èð9–~êÞ)»ã³Èï¸ÕcKÂŒ’@IîÐÉó – ©XmZHÖ8—Þƒ4çúIìÿxŒ;Õ¯ƒÆ)ø*Y,u’fø”la I»É–Äyäqi;Yï©4 /’-Ò-¤û¶àøµÂH7ä‹/j}l\,%£9_¡ìѧ·=µûúÔ)Ÿ‘|M‘W+îÚ“¨æ&ì4°ß»ìÓòÿ³Ë°¢endstream endobj 494 0 obj << /Filter /FlateDecode /Length 237 >> stream xœ]‘Mn! F÷s n0ž?H¤È›t“E£ªí0‹0ˆL¹}ǸÓEé òG{¾¼]R\UûQ÷E« 1ùBåY©™n15]¯|të¯ÕÕÝmnÚó»Í߯Lj+  ~µwj?§áP·:ir‹§G¶ŽŠM7jNx JþßQ7JÇöÒ0nÚ£zbPÓ³Ž(ÀX'À«F´g5(€©WP3²QݱZ@Yg@ׇ  ‰Õ£F³  ‡:ó>ÏAî¹)÷,…ÒZÓ®irˆ1Ñ߇ä%s—Úh~ºÒ}–endstream endobj 495 0 obj << /Filter /FlateDecode /Length1 21812 /Length 8292 >> stream xœí| t[Õµà9÷Ü+YG¶,Ùò?±¯d;8E±óÂ[vŒ¿ØŠ“@–%Ù–cKŠ$;¿†&¤Àã~  P y¼%ÍÐ6@™m¡Ÿ¼–^‹¼5kÚÀð˜Ðér=ûœ{õ±ã¤! Ÿ™5º÷œs÷Ùÿ½Ï¾›,#ŒÊBÛAÝ]½5uˆ<Ãpéóy#ê¼×ŒîóMÄå=ÿû=,¼óCƒ‘¡±7>yÆÂ£°vëÐèæA¾y;B™‘á€×ÿ%úëßg°¸dîTvè"˜W Å7iôÂåÒѰϫÎ{>‚‹<æÝyWj¾›ÍCÞ±@ùßÿè˜_—팄cñ«ðã BÎãìy$ˆ|òðÑy¹¬IëÇr\ƒñB<ˆ~†þ;ÃŒ/C“ät!¬b:†wàmââ þzý;¬ïÀ»ukuõÒï`g ?ß@o£{ÐqxL<€Ûa_;Ú#ìÁM¸7 oà=øé—Ò/Ñatw£§á»Q °w5ÞËÑ_Ð_pÌ ‹…üßðBt?ú-Y-µQLDÒa¼í.”£WÐ{èw°ŽÐà:—,Ã÷#ô$AÇÐ{Xë¬z›8(üö  øæà2R†®!oˆýâ«âÍ ȃ²”‘åp]Ë ÐôžnoöÝ Ž ¯„7лÀ=PÖ […=è]üCüΕðu{ÄÕèC&1ú-—¶›K{+ºUÔ¡H;îŸD/l¥ô2Fئ¿B—ƒvã+ô;ÉRXÝŠ~ŽžÄHzYýD†n.Ú  ¶„6Ðx³P"è!t>€ B`ļŸè$‘9dó>¡²Õ¿Ïyåjùµ5¶ŽSÙ¬—÷¡î}Y›åSSÝ«ÅiÍ>iÎ>R™±O¬,ïTß[àhë^-ïû7w“†ÕÝßk½«aÈf° ëî¦à<éÇ”¹(õñ£\”þÉf0pu ÏdFN/ƒ?f ðeTŒ—q(ö¹!mŒ‘fXÛ•‰¾¯ *DÏjcƯjc `þ¨u(ýYg ÆÚ؈æ‚ÕqVÎøF›Ð¢Ü×µ±­ ,(ÓjŠX4ÀR­µ@c”Ÿ×¢T˜·NT›7®E?¡%€9¬uÈ‘÷6Î@öü"mlD ù—hã¬Ê†ü¾äYmlFù—&x° ÂK4†#›£Á¡á¸\å›/×ÕÖ.”6Ë˃ñX<ðŽ9äÖ¯ZvŽÊ= *&÷bèDÀ_MOÚº„mõx'ÆF¡!y¹wø›#Þ¾qÙ7ì b²7ƒ!92>0ôÉþð˜7JÀôzC±åáQ¿Ü7ŒÒ–å3Yï DcÁpH®«¾¨^…a Èôƒáð‘‡ãñHCMÖ'Æ«cáñ¨/0ŽªCx3c3™“j’«b€< oœ_-Ÿ|ÕrËèæÈpLŽEÂÑxÀ/FÃc²+˜ÐXIÐàúWõ™N†ÒuÒ+«¬%BœöCO6ß[^žA9£^9õúcÞèz9<8 ¥ÝèX0ÆMŒÉÃhh E½!ݲƒX° 4zvÈñ°ì m–#`<؈ƒÆ‚ ¯ì¦)@Ƈ =ù|á±€3€ø0`-B1О«Ä>ùeo,ö½@úþñ±@(î3~ƒ£`¤*†‘o{Ãñ ~û|Î ѰÜàhüA,800è´ 0³otÜÏ8ÙŒ‡ÇãÀÌXP#Ä(DUUÚñÀ3qòX€IM¹ƒÄ†i4ŒfM8*Ç`€«šø3H3æm„):NUÕqB‡Á±NÚÀÌ08 Áßè˱°CŽŒ|q¶Âä ‚³1|á?Èäˆ5PêtÞðD€K zg é¡pÌSW™U")PŸÉ±aïè(hZ6 J¼Óä ‡À/¢òX8˜Ul9¾9ô¡j•©éOǼ›!Z`»?8dŽæƒëÁzý~.¹ª: Þ(ð5>êRFȈ‡Bœ!5VaóP¯ÄØŽ?±™”J ¸Â¼£³#Ðö$øHaöB£›å`š›S&N4Àê5Ë1¦Hf—DxÀçQ¾ic8êÉödÚíÄjgakç*Ë´kñ2€HbXÇÁL'á`’±À¦8DŒìD ¼¼£ö@•0³MeØ—‡½1ÀMÓ óº”wûåñ_c8Å*åÌ©žÎª1–æ33’WeÙb%ñúÖ{‡@0ˆÃP˜2Wý|N5$,`10:ȘZá–›»:=roW³g•«Ç-·öÊÝ=]}­Mî&Ùîê…¹Ý!¯jõ¬èZé‘¢ÇÕéY#w5Ë®Î5r[kg“Cv¯îîq÷öÒ®¹µ£»½Õ k­í+›Z;[äå°¯³Ë#··v´z©§‹oÕPµº{²wOã ˜º–·¶·zÖ8hs«§ps=²KîvõxZW¶»zäî•=ð6âM€¶³µ³¹¨¸;Ü  jìê^ÓÓÚ²Âã€MXtPO«ÉÝáêisÈ€¬ Dî‘9H5p 8dwÛÜ»ÂÕÞ./oõôzzܮ˴ÓÒÙÕá¦Í]+;›\žÖ®Ny¹Dq-ow«¼(í®Ö‡Üäêpµ0qD˜*NJ”mhqwº{\í¹·ÛÝØÊ ÇÖw£‡C‚îAíœÝÆ®Î^÷•+aà$tÕ 7'¸à¿FοÄex<]=ž$+«Z{ÝÙÕÓÚË,ÒÜÓì2{v5sX údÆëÔøe6bk'{@±Ýš€MnW; ìelÀ ÞåÞä DâÌ·µàVS#O£jîtp¯U“¸pKW]ãC8– ²ø©£f·ÔÍŽc‡šzyúHM½þ‰dÀK%á( ³d²1ã‘GàXX=óä˜wˆÁ.E r¥w¶Å’lN (š8 #Ñ lÙ Æ!™ÈÞqX·hÇpT;¦¸rJF%•Tþ£XN©àD`ts5ÀFÙYÆ9 † VÓDçêóÅ¥B\âÈýá8…Š®Z¦”W\ç\:iå{~ê ªÖAòÙÔA4UÉgYÑ“ë -Éû8¦Xâ̘¥@M,ô\j%9Q+ѯG­DU;|aµUöœj%zk%šª•䳬•è´ºà,j%zªZI>óZ‰¦ÕJéá;­\‚ó’Äù*—¨V.ÉçT.Ñiìò÷Æó]2ÑPX>ç’‰ž×’‰j%“|ö%Y2ÉgS2ÑYK&ùó”LÔãê븢‹±íZqVÕMI~.ÕMTGò¹TG4½:’Ϫ:¢³VGò¹TGÌY§J²ð¡§,|äÏQøÐÓ>ò>”>Ók‡¿]ÐÄðN^4Ðj¸UŸ¶sU³1¸>X„ ²©:2©ÑÒØ)úl¨…QmFQDChÅ‘Œª͇{ª…ïB „Œ–LÅàEäEcÈ«­(ðÕ0r¡QøÊ¨'‰+Æg¸`Ï\ýIÏ€ê’$UPšZ#°'ÐŒ/ìù|›`4ûúÐ8@øÖ˱ø/—H,!¸FfðN†ýa îåÏfâéåXbÀQàý°Ò¥íÜϧ€–Ï|—2ó0ç¼d½ÕOÓÀ² ‰åt49&UqÍÊL¯qÐJª¯_ƒŸøj€ Ã= š ð½Q®ÓjÀ€=ÍiØ:NØùdobϘÝÜöà1Œ6,³ôù±ÃÔO6Ì0ß„gÎwœû Ó@”ï`ÞŰNÌÐÊL9Rþ9>Í?O% …ïl²«¶ôÂ(]k'G Kžý—žQôÿ˜ŸÝÞ)™ƒð„òQœ¯0/ãº^ka°Àßâ…IÖÍñql©¨rž†ù³€&×§Ò¬îÐì®ZK¥¦ú˜êÏÎW˜[?Ä÷G´ÈS)„k\ó± æ^ŽCÕ4ÕpÆ93ýÉÇᘪشʻêËǪïÙÓ¼ÄÎ-Çöúù=ÆùòÁ¯&åQàãXâüIB?ƒ0Õ"©*ÉcŠËDŒÿ8ø¯êýŒbJ'l%£Æ||w‚?— Î}mžÆùS•= ‡Í>àlœcQu²‘ûÀ0Ï:qM3c|-]¢„ Ñi^©r;ÎuèH³q{ª¶¦i$»§Ã‘”³†g™cVãAÅÔ´:Ýú§—:¡9•ÛHң㜯”×¥$ÚÈõ1vFÑ0ȳvH“0FÑϯŒ†ƒß™&FÂÇñ©0 û òEÍl ù8m?ç8¨qÚÀ£Ó£qçŒažR6HÏE) œœ B×¢!6 6+)¥ç€ô}2—ÙË9§<7O÷5UêYâ==Ãü”“5Ûñ{*œ‰-âü$b'§W“¨zš¦N·—éd³v¶¨Ô™Î9~Í“F¹ŸF“+*§L§þ4›§{]âõò1ÈsÆ(ŸÑ¤D~Î)³W(MCÓÎU•R"‡z¹÷¨¾› 1S?±¿)S‚KªIò0/·Ñ™s0ÎL}ÌÆ›C³÷(ßUÍõpìLG 3ÃÙµó[] ÷n€ëåútq™Un;¹ Íð\•ÅÍ9P-¡rÔ÷n Í Z€/×£äÑ ÜŽLž&¾ŸQmãP*g]š•Ù8…¥ZÓ¥ÊÓ_’r/—¿¾2—ß+nàOàMøN ÇÀø¦\+¹|.®‡.Na9‡cZdúlOz\OšU¹¾˜ÝçMœ’‹k¤wVIØÒ­3›wÐ$….Ÿ›kªC÷‚Ýßš\Qý±•ËÚ¨éZÅ©ú½êíiÚmä22Ë^ TÝšO¹¸î¦KÁì´ŠóŸ’Bµ€K»6¦é,eýNͺ ~<œ²g­¬â±èæP.nëÞdŒ4óøíÐ8_™ô°TX©ùgW’³éúMÄQîLr‡Š+A{º›¸?µkö&µ¡BÐÓàUs—Î5ω'óöô“;½jLU£éu§#-צWjná°c3àR«êÛ’zf¥ÞuÒk·ÙÞ°oÇj-Ÿ¨zSÕ‡š»Õw¢ôª×ÏësµŒ%«’0¯ÃÉÊd#š:Ó#Zï$<í=Qöò³ß‘¤•8‹R¸ÔºÒË«F-6‹6O}BÑ“Þ #ü¼W©läã¸V™0ùÆ5X¶¾eÆÛp¢ÿs² äYme¶Ê!]ÿQnïˆö.äfõdµ†7Šïe)0 ¨}µ±VOyÃÖ€fv˜†Ò8÷s]S¤öèMÊóU¢ÇõÕwÎwÏ÷ëÔ¢ÓúA3+¯/®DgíÉ_r?ˆžQ?hz%ïKã)ÕëH@žYu¶ ýÊúJòI}%úÿûJi}¥T‡áÿξvÂ~u}%:ËÛÚס¯Dgí+¥$úrúJô4ý‚/§¯DÑçí+¥þ¯Óùì+¥âmz_éT§ï©»Kêû¹ZI|ݺKMï.ÍÞÝørºKô4Ú•Ó4øõî2Qîc'W3_~—‰~»LtF—)õ®ûev™èßì2É_Z—‰~Ž.“ü…u™(×A`½‚s«jÛÏ¿¼ÞÕæ_UÔ;’¿²Þ=eï(Õúâ{GôsôŽN‡÷‹í%2ë©O”“;>ô,:>é]šóÙñ¡çÔñ9ùíì:>4­ãsº¾ÃùèÐÄOÂïD©NåtجúþÍU ×ËzøÕpÞü¼jªæõkÖ¦WcŸïß³!‚ÐÔ'ð{ ]…fù¶;§þU!ïZÈ;ùäȤ# ùCyÛO~ÿ"ùBþ¥”."o)äM…üW…üV!¿Qȯe’~­_™È/±Mú¥B~±üüµÛ¤Ÿ+äçÅ×^]#½vym»øê?Ï“^]C^uŠÿ<ü…š$¯(äŸ&ÉË™äåíâA…üçIòÒ6òËÈÏòÂóé…<ï òÓŸ´H?ÝF~ÒB~…¬TˆG!½ éQÈ• éºw“®JÒi& iWH›B®˜$­“d…¬pŠÍî½R³BÜ{ISc‰Ô4IKH£S\î'Ë¢kq*äòei™ƒ\6I.UÈ% iPHý¢L©¾Ž\¬¥udÉb*-qN)d1%‹â¢…TZ”IRR§‹D‹tÑ6R[S"ÕúI ÌjJHµBLÇ…E’£\k‘oÀímd~•Iš_Hª. R•‰\@É<3©¬0I•u¤ÂDÊíf©ÜJìfbË®”l“DÆT’ëHY!)sŠ¥s©TšMæR2Ç@æ8Å’œ©d7)Ðb?)RH¡Ÿ($?äYMRž…XM$`rw“€Éi …˜³B²á–]ILp3µ‘¬B’©£B¨Jt71PbpŠúI¢ó @¤":‹‰ Æ„˜ˆ\ …S‚"* øößp;¾ð+ú ¯ŠðùþÌeyÂ:õ¾¸UÜŠ.@;ë³2“Q,+Í0z*––•6Pci™ˆ­wåÝ_8dAwáûÅ¡Ê]–þªRZf,ÑcTâ0é¿a¯2¿Õ¶zÚöåz®nÛgð\½úydŸ:xñšco;xÐ’SŸ‹ùèñÏŽ3+Ÿ|˜SP_ÛÖ»Zo6}`)¨×óë;v– #tÄ8R:R6"Øôý¹ýÖþ¼þüðü ëDž~Z‡I5.·ëò¬ùe¸çYE›}Þ¹¥xaÝ’Å‹æÕàj¼xQ…­._ܺ8ø›u#1ç5®·¨üJù öѶ%Þwã¢N¿ëàã¸ëc/SþT·héÂÒ kfõ];^9RQ‹ê–,ª¨Êˬzè–QÆÿÈSïKe £¹ ¥Î*TúμËxÆP6~°b¨pWvÂ%Æ J"em&c‰dÊɪ2?öÖ¡c–zŽ©€+àØQ³rüCó‡õµXo³29€ó¥D'–Ë‹-Yº¤ba˜gÕU.Aæ¤z)#ó³„;7|zËÒʉ•Iåý«W á²gßÇF£ò!ý=Á{.tõºÝØhS£ò§ÚšßÝþþMßüøª5ᬒ¬îkb°õå‰kA ºÛ¹2DI :Ɇ7ÂJCFƒÅd4‘›L» [ôFª×!É`1ÌËÈÊ1?ú:Èsªc²0Á,š-¥ôÒ`M‰Û¦kìûe Æëœå2’±l’³e³9±ÓäÌvš–~ÔûMýÙýæ~‹eæ†Õ[®M¿ ì™_ έ¼jÑÍ?–•þ€‡/h9|}n­ÔäåïÛ{â3±ÿàÈ‘ýE>°î£_ï8î¿îúudéÔëkƒŸd’‰ù€þ ÿ…hʹI.+;§¤¸(ÃV(ååçHù@17ÇbÎ6eeäeŠj0Š”ìRyEy™,”Ú¤Šòª „ùóà^)UT”7Ø ó²DŠæUhiÎ#óÉ®Š-ö|Zi·•è*ò º,#{š—ŸMó+‘®’V”g9ÌǽõÙ[Çrê™÷°Ø`WîU—^zôø¥Çê`^Ïâf†Þ’ÚKüÒ¦ªÍ9ÜáÌ‚Ž³dÖ™õæ ³ÁLÍFs¦9Ël2g›ÍfKÍp¸¤†Áç–.Ñ ÆÉÐKù¢$ö¾ÝýŒÁpƒrßR|ù’¡]e£Ê}±ìÌeK}ß™;Ê=Ôæyi(¾—ì =qgiÇE'ú„Ùß,_êü‡‡O¼-¬hëÈ¿øògï;ñ¶Øÿøµý™-¶B^‰‰ý¨ýÖÙ‘›#Xá4™¥lоdÊ6Q£É&z$Jp4Œ cÔI°%aÃ#Öþ,¼%˜³2uDÐYpö<®,(fùØàa9ò±‘]2Ù%‹]Lìbf—lv±°K»äò¼] æí£pãèuÇYcIš#¥ú4{h6ÀûkKðºl#&¬å·\±-å~ 9îÖxhCff³+ühé(z[¹Ï¶ö‘žÌÀÏ OŸx¾¾»àòæ§.øôÑǽýÝ[ÞÉÿ>ÓjÈ]9ÒwAW÷9—©”¢Ë”$k‘U”Ь~H**²6X%c à-Æ Ê*È/.*„ê$+Ó˜!‰#“`±›©‡•QºmŸ5©õì²0˜20 :¦údº;êÓ¼‡áh)U™/1—uinyîÂ\á½Ëph¡r÷Z‘\¶âù…Ê›ý@§[»ï¢ýˤï*ÿ4…”yæ|Z]5…þnû§ Á/cçN9œÍp:ÃKÝ…è:}i~À²t}W³ù™xjö^óØ=r§ú7áv€¼cŸusæQ”DAÄ‚ÄnÀ=ÒA©t A[$C5¢g‰7Ë£%Ùìd¦µ$S]iR b©æu5ÚêÒl†öcƒÖíÂvAh–ú¤A4ˆGt7“›u¬εåbð øŠ»ð^¼þDH¹AìÿìcbúôQà¿òÇ^°×´Ð9ÇtWÖý4¨ÖðÁbHs³° és‘5k.x-«[ÒjôãÖ¦Jm^¢Bô±5‡—¨ùâÞú·5>û¯·\çy¬uéšç®Vþª¼ÃÅV> uõ;µuþéøŽº‹”#eeüáf, m•ñÏÝè/xoÂ^"ò+ñ6ñ7R¾t‡ô¡îbîñ˜C±ÈcF(†ŸŽ "J:}†3³L³5ŽþßþˆèR~™~>2MMÁ³+Ìy š#0’À[õ(àÔ0¢L”…Lü)Âw³3ýdLŸ~„>šš¶€Ó{Y¥1tù].¢©¤¦>ÈèC—KûÑVò&Z [.¼óo¡+`íri)Ú!¾„Ú9¡öû?Ú÷ì ×f_ú *S‰¾²øög¸Ye¯ÿ#ÏÂIŽþ›Éîendstream endobj 496 0 obj << /Filter /FlateDecode /Length 237 >> stream xœ]‘=nÃ0 FwB70å¹.É’¡AÑö²D" Š3ôö1źC‡'àYñssºœ/i^uóQÿE«Žs …˳xÒÝæ¤L«Ãì×_«§¿»¬šÓ»Ëß?™ô (~uwj>‡ÁÔOF†üè‘§âÒÔ1¢¢þ]™^&¦¸G ÐyÜ´E¬aíPÛ²ö(Àر(ÀسZ`¬á°5ü†tÄz@ìÕ¡6°N(À¬°õ‘°+¡–êÎûr¼>¹÷¦ý³Jkm»¶É%Ήþ~H^2Oé õºì}°endstream endobj 497 0 obj << /Filter /FlateDecode /Length1 20816 /Length 7750 >> stream xœí| |Sçuøwï¹W–¯üÅ#Æöõ+à ldžɶl~(²xe£³,]Û[R$‡šiRè‹´ ¡,IIù§$¥Ä&„6 Mþûº6þ–u]š†.ëæ¦l#]çÂeçûîÕËJ€<¶ß_BÒ÷8ßyŸó{ššp„l²™qutÖÔörý~­ð xÃÚ¼ÃJ·Â·>&×Oíû!.üÎÕžpïÀÐPŸçä@oÿ† ¾ùfBŒoô)^Õ–ŒïrëT\œ×‡ ³Õ`!pÎ+úbwèôèùEý!ŸW§—…_ò€÷ŽðÏÄ២ó w@|1ìÂù«þN8ÝFž>Oˆí ÝG”pÏiá-œÿ„±›K†É |¿Hö“ÝÜ>œQþnÇ•½ü³d Ä•—¸Üv~6®í#§É빜€ýá–’9¸JÈ["OÎprq,à ¸íÂ!Á- ï 'É|!*œº„(7Wˆûð³~Äç“¿!%d˜{›DÉø Ì£B“CÞ†“°Ÿü© lHcyŒlD^ ¸¹‹ßÈ»qåñ$yß!Ü?Éíá^GîŽp_ o’o€À/!{¸7Q®ä÷ä àáïBÌá{ÿW×I<ÿ ‰ D|““ˆÊÏÂ5äiu³ï"˜-¾ÉÞ§É]HÙC3  2Ê‘ ÕØ>î%nÔðU²—¼·ÃϹ-B¹ð„°„ìÐ4]dâ~ž1ôpPvúÞH±óCB·ŸüFèÊèFÜ?¢!ÍC¼%ê!Gñ3d0£L ¹-°9¥»EädÆR¡Ï#†ŒM(5!!˜KÖâh#yšÈW:ým·®’ÿïêÒÙÖqSÙœ!$®ƒÙäáóç]«„BqõAqúA¨4*Ëß¹Øæ;³­Ë\«äƒçM:VGW®u®Â!á2®;šØ%zP¬Äήƒ²¯O¾×|oyý½f¥~6†Ê= ‘ä‹#é¯\¶’KfžÍyb&6b$D°ˆ}øK}é:î–Ĺo$ppÄ„3N?%Gõ1àúãúXÀñ³úX$Yä}l z±66’<ô0mlB›ÒÇÙùsœ>Î!7MÚ£ÍÄ4é5}œG„I¿@Šœ‰ ÕNzGsd²%OóÄh™¡×kô±€c‡>ÉTËŸéc)°Dõ±‘”Y¶éc©·<©³+ë-ïêãÒ·°H›Éä…[ôq1.|¨1Þ ôöÅ䙾*¹®¶vŽÜ½AnÄ¢±ˆâ°ÊΠ¯Z¶÷÷Ën •ÝJT‰¬WüÕÒGçÑ£ïúµ¡`¯Üàí»ÈÁ&e­wÅ º‚7Ø«DeoD‘A9<ØÝðÉþЀ7ŒÃtzƒÑ†Ph]Ê4e¸B‰D¡ \W}ãm9 'Dª1¢/ ××Ôøq}ý`u44ñ)=¡H¯RTbÍ Œò@¥H.ÏŒ*ŠÜ­ô‡†ªªåËà¸Znéßî‹Êp(SürO$4 Û#Êz•8 ¦¡AMC©d$)I%óÊk 5K³/ù’.4ÈeÛRG9•¼r,âõ+ÞÈ:9Ô3‹$¹”È@ ÊÔˆÊ}JDAZ½oE·¢ì(C¡ž­r,${ƒä0 „ºc¨±ªÀ+ûi !c}J\O>_h Œà Ö‡ØQËJ0ŠÚ+c*)«Bd~Ù†|/Ò“ü!ßà€Œyc”Ÿž@?i&ÅÈÈ¡žØª¿¬Šq‚f$äô) ?€‚ºc åAJ;`E3ûúý”“¡@¬/4Cf:!J!¢©ÑFžŠc•*µÄ$ÚgM¡a¥4kB9ª :€¬êâ#M™C´aªè˜¤©ŽêCǺà5CÏ`$ˆvÐ’£!«ì^«øbt…Ê×êGg£ùBA€Ê­—$¢óv‡Ö+LÍ‹ '†bh†¨¶J­Nz€¶'Gû¼ýýR·¢k ÙÀ(ñ¦É ¢_DäPD™Pl9¶!¬ôx‘PµÆTúî€wF ÷zÔѼý1t= R¯ßÏ$×TGÔA¾û½‰ò+Ñ@o±Ñ«Å*¢êõ!’(=ç':žE)!¦0oÿÄô3q>’ؽ`ÿ9âæ'¢ÐêŽÁÒA”*’Ú% úœa‡†BT.KÄa¥ßÊhØ–1•¡eZõxéV0’(ÖA´ÕÉúP Á˜rG #Fö†Ã^Þî~…nh²#f:’FéóÆä>o1*Á4P¯Kz·_ úu†“¬JŒ9MÂKY5ê§QÍÌFä•ûiöÀX‰†½¾uÞ^ ã0’¨«~8§J#… YTú{(SKrsG»Gîìhö¬´»²³Sv¹;V8›Mr™½çeVy¥Ó³¤c¹GF·½Ý³Zîh–íí«åeÎö&«ìXår;:;¥·ìlsµ:¸ælol]Þälo‘ð\{‡Gnu¶9=ˆÔÓÁŽê¨œŽNЬÍán\‚S{ƒ³ÕéYm•šžvĉ̹e»ì²»=ÎÆå­v·ìZîÆgâhB´íÎöf7Rq´9PDÔØáZív¶,ñXñ­’Çmor´ÙÝˬ2"ë@‘Ý2©F.‡ìXAw.±·¶Ê NO§Çí°·QXª–öŽ6‡Ôܱ¼½Éîqv´Ë ÅÞÐêÐxCQ[íÎ6«Üdo³·PqâD(˜&NR=Ðâhw¸í­V¹ÓåhtÒêÑév4z$ê5ÑÊØmìhïtܺ.NÂ*­\â`$P;þkdœ1ñÛQ\ŠÇÓáö$XYéìtXe»ÛÙI-Òìî@v©=;š™,G}RãµëüRѵ ½¡èi]À&‡½vR6pAJƒEïrÜáSÂ1êÛzpk©‘¥Q-wZ™×jI]¸%ˆ«­±!^KYìÖѲ[ò¦ױUK½,} wãM¤¥^ÿz3`”¦’PD Ñd2ˆ²HÇ+p ¤ÝyrÔÛÄð"…¹ÒÛÇ¢ 6ÓJŠ_†áH E1L&²wW#Ïé×pD¿¦˜rRJ%™4þ#J4Œ·T`½Ò¿¡a#ô.cœ‚X« è¢3õùbõñR!&÷2äþPLŠ®Z–$Vq]uét¹µìµ©ƒ$­’¯¤’’u|…uta¤'yÃߨɂEºšZIŽ×JÒ§£V’4;|dµ’¤ìUÕJÒ5¬•¤d­$_a­$¥ÕWP+I«•ä˯•¤”Z)5|ÓÊ%¼Ï1I\«rIÒË%ùªÊ%)]öÜx­K&)’¯ºd’®iÉ$é%“|å%“4¾d’¯¤d’&,™äS2Iûж¥”mû’+ªŽ¤¤äWSIñêH¾šêHJ­Žä+ªŽ¤ «#ùjª#ê¬i’(|¤‹>ò‡(|¤K>òe>+|Òk‡?]ÐÄâð6V4HÕøS}ÉÎUÍP`] &€äŽêp_¸FOcã:g¤‘„H˜l  ½¤ÄˆLf©Âß:R‹ï98êF™4 LŒDñ! ñ’bÅU' "|5Žì¤ß2q'pEÙLÁ_ϬÇo?BJ—Au^‚ª)­GZ´íDhʇÏ|8ŠM8Z‹çVA„ð!¬—aSØ /“HF,Aü#L7â œŒçCHÝËöÆãédX¢ÈQßë.²;ñê Æañ†Õ:äóF² zb =ì„&kL·•=†œ×“|ûuøõ_p!ü 4 ;arW#Ï4§`‹ë!n‹ -N÷¨nfµ"CK­qmtL1µà΄éc'¸f|ǘ=©"ìõŠuý8­Œ—#éCƒi>t1i$|O$»f3/ŽRµv¡7KdöU¼¥ËŠk—Û;)sw$6бêeL×ëp-„øS¼PÉ\ ßÖôþã©í)º\½ŒJP·ºU·»f-šæcš?[_!fý ;Ö#L£B¬1ÝǺxMÓ’Ž3ƸïO>GýPÃÇ@¡5Þ5_VX¼j¾W–â%eÌrô¬ŸýF_><ãÕå“XøÐC–Û‰ë§Gýz$ÍLð˜¤@ó å?†þ«y?¥˜Ô ] ³¨ñ#;çÆÏ$ˆ1_ëÆÝÛÕhH— `Õ£Ù‡œ 2,šN†˜ô±¬Ó53ÀÖR%ŠËIóJÛA¦CkŠuèx€ÙS³µ”’A¢xÚz9¬ 9kX‘f-4Ü]«éÖ¿´ÔqÍi܆c|%½.)ÑÓÇÀeQˆGCËÚA]B%…¢Ÿ}SVöK5±!| Ÿ·õã~=³Å-äc´ýŒã€Îi=‹NÎ1†XfHÚ 5%5pa&"|L†hl,KÈ=þ„„{ñÛ¶,ÅË´˜iw¿t³x¥ð:¨ÇAÜOÖãn`)ä¦ç Éa|k·——eT%q"ÕîÏñiÂHéc^f¿QG…yÒÅü$žë&ÊÝ~v™ÝSõ5‘V¥Í¥ÚðJc5ʲfü®NF[<’håП¨="ú‰tŒaæÑëð»W·˜vR¯’Yõ£ÌT—ª[‘˜~ö$4µ„8ÒŽ3J§g²ëH7Ûs⚌uœwVଠW›˜]ìl‡î—±h\‰cбƒ,g¸4nü¦¸Wã Å-³9-CøvÄEÏ:È*FÃØ:‘³SÜm¸ÚŠ¿ŽžhÄ•å8§ãB«P^;žò°Ø¡ç(/§\ORMçÊÉ(Æ9kÙñ/ÑwíˆÛÉðQþ­¬>¢ãvOMsn†êˆb¦8‘£V6£«Ëñ×…pLŸv&³Æm;“¡÷5YŒÍGøëBÚ¢ùò0-PJÒÊìHåibç)Õe Jã¬C·2'±TëºÔø ú_‘ ÜÉäoÅ·Ìä÷àŠ‡ÙÆŽøãxã¾ÓÂ0P¾%¦åL>;ÓC£ÐÀ਩>[çN±J#Óµ弉Q²3tN(I[ªu&ò)A¡…Éç`šjeШGÂ;+š?:™¬º®5œšßk>Ñš¢ÝF&#µì­HÕ¡û”é.] j§•Œÿ¤šìúwcŠÎ’Öo×­çÇÃ({&ÐÊJ‹eg¶îLÄH3‹ß6óå Kæ€åºv$8K×o<Žâp—“;4\qÚélbþÔªsؙІ!]¯–»x¯ùØsN,‘·ÓoîÔª1Y¦ÖÖ”\›Z hY¸…ÁŒƒK®jOKÚ•|ÖI­Ý&zÂŽ?kµ|¼êMVZîÖž‰R«^?«Ïµ0š¨JB¬ %*“!¶›¼ÓÃzï$”öœG){ÙÝoMЊßEI\Z]éeÕ¥@›¿¡¤ ž Ãì¾×¨ ±qL¯L¨|ƒ:,]ÿܸ§áxÿçBÈÚ .ËD•Cªþ#ÌÞaýY*À4LëÉjo„ÄŸË’:¡Ðúj㬞ô>Š­žŒï*Pô¦pîgº–ˆÖ££4%–¯â=®O¾ët­û²Ÿ¦~”Ö_y}tý iÂ~ü1÷ƒ¤Ëê¥Wò¾ž’½Ž8äåuP'ê°HŸX_I¾ ¯$ýÿ¾RJ_)ÙaøŸÙW’ÒnØO®¯$Mð´öiè+Iö•’}<}%éý‚§¯$‘ÛWJþ¯Nײ¯”Œ·ô¾ÒÅnß‹w—´çs­’ø´u—$’Þ]š¸»ññt—¤KhWNÑà§»Ë$1»°šùø»LÒ§¸Ë$ë2%Ÿu?Î.“ô'»LòÇÖe’>D—IþȺLÓÁ ĺ”q«iÛŽû_ïHšÐæŸTïHº w$b½#颽£dè£ïI¢wt)¼mï(žY/~£\Øñ‘® ã“Ú¥¹–éª:>>³]YÇGJéø\ªïp-:4± ðÛH²Ó 1:tV}ÿÍU ÓË:üÔ0Þü¬jªfõk×Ò«±Kÿ7gìÿ³Ì^çÛȯa~³íüU+€ÿª„?ÔÁî‚ßçÀ*œQá?*áßsàßvÁéJøÝ½vñw*¼¿ ~» FÇà_Çà_TøM=üs¼§Â?ÕÁ¯OuŠ¿Þ§ðT'¼û«ñÝ1øU ¼£Â/Ux»þ±~± þA…ŸçÃßo‚·ž‡¿Ságþ³Mðæ-â››àxýµBñu^+„ŸªðþV…«pr¼z¢X|U…ÅðÿêàoTxyKžøòtøÑd8®ÂK*üP…Uø ßWᘠ/¨pT…çU8’#[+ņŸ{^Vá¹ÃkÄ瞇ç6 ‡¿W)^c;‡mÂ÷*á ßÝϪðŒ UøŽ OûáÿäÀS*ŧüp`¾x öçÓÈô“cð„ «°O…oçÃc*<úHŽøh<’퇽²w|K…=g‰{Tx8 v?4MÜ퇇4‹MƒÍðM ¾¡Â»²ÅTØ• _ÇC_ß_ûjŽøµ™ðÕøÊ|yçóâ—Uعc¸óyعYØñ¥JqÇØa¾T ÷«pß«ÅûTøb5Ü‹bÞk‡í÷˜Äíp ¶áÂ6?lEMm­„-yðW*|áî<ñ *ÜŸWa³ w©`;ÿ—›6‰©Â¦Mp§6z,âÆJøœ T¸#†²`½ƒ*ÄÆ :‘1¸} Â*„TªÐ_ ëTX›× ®í„€ }› '=*(*øUð©Ð­‚·ºÆà³Y°F…?Sá6V¯’ÄÕc°J‚•“§‰+ë`… Ë‘òòðX “3‹SÁ]·.$Þª‚Ë*´·™ÅvÚÌЪÂ2ÜY¦ÂR§Y\: œEÙ¢Ó K²¡E…æ]àØM*4ò³ÅÆ1hxìËÀ¦ÂbnùL¾xK|fQ®ø™|X´0[\d;Ÿ ³¡^…*Ü<¿@¼y æÏ3‹ó `Þ\“8Ï sMpS1ÌɆºMb 7š ¶Æ$ÖfC ªggŠÕf˜ Ö:˜uC¥8Ë7Tå‹7TBU>ÌœQ)δÌJ¸¾Ò$^Ÿ •&¨P¡\…²\(E9KóAöCÉ£Å~(ʆé¨Áé*ŽÁu 0 'ÓT˜ê‡)¨©)*LÆC“§E…&©ù*䡬y `Þ¹~ÈQ!;k²˜­BBgM“ ’2U0"˜Q…Œ0øAÀM=À¸ *ð8çgg¢7Ìù·ÜÏÍúŸð"Ÿ4—|޼E>+þ\ØG ¤Ív¿àvN ?<'D²Û 6ˆÏž0<žÁñ¤B(Ï0Ÿ­[p#1Ÿ² vYçª á·f£þ~»º,“·ps9ñçüƒ`SEN«_V¿z˜ûé>î§ôïWl<ÿ®0[؈×S%9j›1­Ä4%3‡<9Å0’“'o-92}¤|8ï¾)Yd LÍÎ4šJÀXà¸ɾúÆh]]Þ$^süÔ™³gFÍ/¿o~?oAÞ‚üµ¶`mQmqmI­\[Z[¶x†­ÈVl+±É¶R[™«ÈUì*qÉ®RW™kFxÆ–¢mÅÛJ¶ÉÛJ·”휱wÆéÅñ£ñCñ]Å]%]rWi¸8\–Ã¥›‹7—l–7—N]íáÊ –‚Ésêæ}†›ŸW>7‡+/»~îMóæ”νéúò2CÆÜ[¸9u“ùco?õùÐ7G†‡½ç©çþÈñ?ÐuØ£»í?Nósz6vGß:TÕzîóû{¼/>òÂòïúbuõþ3ÎR]A]=f( &2Ül›#Y¹™#S-÷å>0äç·LÍ2¯k.¢F©;3Šš=uæ8ULíá®âÍÅ{‹ùdìh¬r”'’gæ‘×–ò¼9ðëÇ¿ò•ÇéçÜ—êŸÙø*9þÕÏÔŒð5'Þ{ï~x·ß«Uÿ€ï£^ÿÈ GBçß…WІ3È{¶EÙY|Ž©³¤Ø˜ÉgH%%Å ’©¸D°­Üv¡`«eûÔ‘{|ôÑSyù PÚO¡UÕÞ7ð~¾î^æœßæMYÁ¾W—=KfpÜÛÀtiºizVu¦U²š¬Y 3J M ³L2‘¹ ~¦4Ótäš‚Ë “gÏ,©’«J+fl•¶š¶fmÍΧQ…ç ’ÁY 9 f˜×A!LŠ2gÔT-®ú‹ª»ª6Wí¬Ú[uºjê²ævÎRÍiZ,áŠ9K*pn1js𻆫æ¨éë&ÃÛŸ¸mûöî¯->þíÿü»Û^êïyÙ{÷}ÊÛoüòÇ=‡„ÅOÏœéñØœ¥97|sûîÃååÇæÎ]}ë2WenÅ×ïÞóT±ö÷^æ£ñÿ]ÜC&Q«çˆÆ\x’äqGÛ$jY Fs~Nsùì¢ãø¯Ž…Äè™EÇGixÔ>û êˆË+µ”æL^ÈY¨_¢ƒÎÉㆸê–eÑ^xó‘mÛ° øáŽs{··?ø­×ø®Ü-í#X¤-EÛæ‘Z[Á”AòðâÎÎ<š!ŒÄØœOmV‡ÑVÇßxMW{È5é[“x¤©é(ýÊœ ,-qZw?>2Rdˤêép(?ïısÏ ]O÷øD‘Ñ»}é=¤7,¶¢ÏÜ#äl;G¢>3}溌ül²¤Àqù쩺Ѹ‹œ¡.Rk3åš 7î,Ü[("ù„Ð*ó-4 ÑÕI)Zå½ö‡]ß}ùåïºnoûöšsêϸٜaù#ÂܧfÍz÷äÉwgÍÚ_QÁ‘Ãåsõ匯d~ì°Í2ì&ÌânÌd7Çs†Ý¢ç¹ƒ<…'¸Ç3 |…@h‚\4š– ǫ̃}Œ˜!'ÍåhŠ|KäÇTÁ§«5ûÔšÃÜûû>/"ñ e@2È,[Žá˜ð 9Ê‹œQ ÍFŠœéþì(Joδeº2»2Ù(ý¤9Lïå/ãKèúã^CÁot{f¡~ËÈm¶ë ù™Ss‰¡(Ã’µ­H†á£ÓÌhá\£ÑàÊ3溦OÅtRNÓÉÙ³gGѶHkÑ¢SšoÑ´Mª­pU„+vVìÅ÷÷+Þ®8_‘‰ªg榖גMê@÷¡Êñƒ»¿sl$2¸cßHdèþ}##‹nøÜØ~çú~uîÏù=½ûØcç¶ñ{yèûžÛ†>ÒÛ}§ö7ލ+„ÇP3æÁ[l…ל‚Ñ8œs÷-ÊË7µLÁ¨àS2¡ùÔ)– £›dj¹ð—Å·¦2Á‘žÓÒc=5‘ù›ã¹ñ‰sO¤ý)yûW=;j1“´YÙsäž3’f9¡aYkË6‹6Ñ%v‰añ´hÐ …F2ü×(• ý_¸ e+ …$l« .s«ñÑò$'ŽdqÏOÉκoz¡…7ZŒdŸŸë˜Ž¨1ö˜uh8œ2ã=h>ó> E[Õâ¢pÑÞ¢Ÿ.“ÅÜb~±eq¡hͨ1Ö`ºÄ1.ć,¡ÂLLj2¥,‡±h‘i´ ^2Xew}6ëäsk_éöýdzF}…«:û+.c˜ÿö=ŽäðŸ½íØ+7Ýôô VîfNâ&qê/Ž?pèé=ºÏ ~”i™‡·V&ΰ-'o8ë¨ÄñFÒNïuš¿FµKkµs¯C]–¿µÐL2‘ù‡ï¼óëOŒ4|wðÅ—ùǨË|kutÅÿ;ö¹ˆ¼†ùùÇ|ßÄïä_åÏÀ ØÇ…ja-ó$ŽAhÏ¡Üuø1°ûÑaÌ”LYÙ9=˜þï~ ¨7ú-PýœÎ9¿9ús}ó¨1ˆ˜ 3ˆ‘dbõf"Y$›ä°]Âí$âeS3¦OO“ÓçÓ¸äÐpˆ¼%¼G6Šäˆ0‹„ œÌ‡¥8î!·Ó=~y1ã9B÷éX%·‹ùè_ûè3¿sä/r}@J4¢/ͽÿ@»º"££6…£ÿ›¯yáendstream endobj 498 0 obj << /BBox [ 1615.86 6196.34 4450.7 7330.27 ] /Filter /FlateDecode /FormType 1 /Group 323 0 R /Matrix [ 1 0 0 1 0 0 ] /Resources << /ExtGState << /R62 13 0 R >> /Font << /R252 324 0 R /R254 326 0 R /R256 328 0 R >> >> /Subtype /Form /Type /XObject /Length 858 >> stream xœ½VA¯7VBØ>½–ò|ÜEZ×ãÛãk%T©7x‘z(=U ¯‡þý~v’µ“ˆ*Ê!ÞoÇ3ã™ïïÇ")G³Ý­3™Í èh]m6ÃûágæÃ@¦ünß žœÚ”MÌ1Y¡ê%« iA6 ’¼ë âåÓÇfês3¼}6üò2zóîŸÁ™ýoü—ßËß.”Áûáf‡þ8Ðn½ÿ{½5¿®‘¡Þ¨uN¼˜õ[¤Ym %¶ÉG“\°JlÖÛáÏñ»iÖy:Þ›f±Y‘ãx"W„ñÁ÷Ó¬¥¶ŽbÈxïlN±<ÄûsÁp–qU}åH<>ž )k¾ú0ÑøÃ$%ˆÊx5Ñ_ë߇çëáEë)3ª¥]A½:gå¨@{¤UsN–ü¤í:q\ûz¹`_ØB9×B¯Ñ ºûé¶‘•(.Õf+‰“|]aê’ˆ÷$êDN[X6zF#K”àà =EÜÇÓŒr©Âõøêvò0 =Ë®Á^àÉåÞÉýiaƒÙ[V“È‹U.‰v@œø¯ªÙÛ8‰E.YÝ5Ø;9‡€‹U(Ð¹Ž–¤Ü«lÚ#›9x?ppAnzÁ” ®…¼#1 V¬ÊPÚŽÄVø9ÞT²«zøŸ|ᤚƒ…$8ÅbŽƒ‚–²iˆe5WWŒÉç¶ëØñ®‡ ö-£Ø ÆÕPH„Û®ê¸ÔUÕ‚óQ;vÊžfÌYŽÇö"êëiƑNjö‡Ný?Uå-z«ƒ˜œuÊk´ÊÞ•n¶šràdC花 K…FÉY¤í:ñ¼›Ä ÷-=äE=îá“e~–ÿŒ†b¤.½ì&õªzQÍ^GÛ†$_ÐØwXŽ{SŽGe¢°mC–mw=ŸF/ž¾–ÍIlÂ,L /c8ÕJ<-\̉s,-{£c¦ºW“õ  “P½7»› Tޏªúå½r‘dU؃ŸÑ:‡¬²†˜GÜo K(äá4ƒáœvªX6=šREµ3]5ÿ«š©&Ç%әȢ:Ę́‡*Nü™ÔÏE°Ðn‰ìSùªÁ“ó^Þâ2Æ Ê¹ØÍT®Âx_OàHº Û?™k¥Ï‹á?> stream xœZ xU¶®º(AR6©Ø*È&²# e à  °eì[gít'½¤»OÒK:û¾ï a »,vÄfUF¢0úÇQo9—ùÞ»ÕÝŸïº!ß­[·Î=ç?ÿùÏ-\¨þý(—+W­ŠŒˆ\¶#"îíiSÖLJ툮¼ƒ“~ë÷Û  q…!ý÷½2n’jŽ^ö×)ágÉ¢ˆÅ‘ïG}½$fi첸åñ^Ò„‰;W&íZµ{uàš ïàu{Öû„n ÷9köœÑcƾ±`á»Þô›4yÛ”©ÓRÞž.›AQ£©5ÔÊ›K­¥Þ ÖQã¨õÔxʇš@m Þ¤6R)_jµ˜ÚL½OM¡¶PPS©%Ô[ÔRjµŒz›ZNyQ3¨ÔLjµ’šM­¢VSs)15‚r§8Ê•êO‰(šz•zI ¤Q ¨!Ô Ô»ÔPjåI §¶RnKùS/QK‰KÈt­Ë8— ýØ~&WO×ýý—õ,ЦÝè¶¾¾f |o`Õ ƒN^7dðÝüÂÝ¡ 0¬äÅ·^,N /u“°SØO_ª¿"¾4b­û$÷6Ε»â‘ûò/wHæIò%÷^i}5ôµ9¯)_û|䨑Q#OŒbF¥Œ:úºëëÓ^÷y=ýõ/F¶Y;æîØLÔ:”¯뿬üë .-hÍ÷h+¯ogjó&µ!Ra_Áéö˲ R 5>©ädj\­L×¥iÂë ˜ÒeP¦&Ssáqh6m   óЄ×@™0§êÈ¿‚6‰1G£Aè’Ènê²úXÝ~µ!›;ÛÈ5‰MÍ1äL}¥–þðáðX›öÄ'2¬­Åd(Þ%YL§@ Y^° ˜h_Ü% è=ˆfÐEögö,ׄ–ˆØÆÇ%·÷Ÿ”œ†ÜÈô58ÛÝs[½ý¶)ÎÛ‡uR+ò·ºýh+´ ±í FåsÐ|q¾-è³…å—«NŸÊë*¸¾õvKiDƒ&\V %ÀÔÓóžÈDQ} ÓÓlÁÍîÂ[ÌtH¬Ú¹Ýk"0cé6ä/BÃiöÊ׿J³—‰ÂÄÊ-[¼g’•Yz?’ŠÐk4Ûïk([¬ôìS[ÑVP˜¸ ÷îÂÇe‚—böo“Q?>®ßW"7fYŽ8uª§ç"X[n?,þöóÏ®Â58½"uš°˜ÂÊ[¬.ßÚÐÏ6W>-›[cA$⪈Ø7gÇî„i°ì—Z4±½ùó/ÝÀ|Ò¹í‘YÉú”&hC¥±¢ä %ÆÚpHUºZ¥Í]rLDÃŽŠM€Å€%øåp¼"ÿ¥¿ŒFbàÇîâo„‡ã+zËŠ. X¸b‹±í³©l?_¿Hñ•öÝ [üÃëà~I»Ãv,Õh‚¢Àßã€ÕSÓŸ4ü!VE5›$l—"€nG;ÛvÊhäHô]%b™¥#ØÅÔ¤”wV,‘,„„û–c×9v¸âBÞ¥ÓŸJnÀÑÅ©3ÈàeV—(–¸«×£™«ÑDìA‚µó¹çSe‡A|ïA´“Fî$4hT=šE›ˆ.ÀÃM¢ïð2Ñ÷4ÁHöHÀÌsºauû܆D¶Z›–xGÅgc’/±À·Ðù3"6¹Ü`¬Ú# m²:0¾1¨nƒ&@Hñ‹·&@\†SµÕ û$‡Š¶Ð©‚]³5fÑ|ºjgMáGˆ3Ö­œ7fã•âoŠܱ} Ûï&´¼«ðr&H¼ùK<±ÙNŒz›‰‹» åÄ ðL©6A¾”ÃÁñ"äN«vjSÚ¡ ŒU†ò’‡œ¡Ü@&†€.Eµ“Áî$ DHG³µ‰™ñmàÑÆJC „©93o0O“ifwe“Ý¿á½ýˤ[!7×ÔÂãäfE©VW> —þ ¯ 3ypF¯‚œÆºŽæïàï®Ö%ë“›Á—mOúXPË´ª•x>ÏS§¼õSr·ì˜òVZÆFuÐö½Ó`+lÈ—ßbteºühp #e"§MÉŒi‚\(É*ëø0ø´®Ðt8úwË13¡VtÄêÖmCI¶Äm<ߊTbS“Ãõƒ{‡æ0†û¯ÛºÞµˆªEãkÑ”~ºE¬½§Ç”>Ù(¯ûaIA¥î o *Þx`7, Ç^axåìÃ9èlª!Ó?>S›Ð.a‡öƒ´ ªÁÔìápâeâP›·ÍÇöšÅïEnbC™±2ö‚FªMV¬òNƒw!÷”±–a·D"4·w8Yo<—f™¢;ŽÔ 9¤%^"òy¢™=H¨Àvß§wbmʤ®àëàqîXÜÝ«rýIÌbÎwä_wö¾‚76=%Œ;ÏÔö~v_gÖÒ{°¿‡ÐìJ¨O„{ŸÞÁ°£ ›’»$ä¦ýgV}D& ¸é=Ž÷~X Íž§ìu-„ÄR2½wŽ=îÀ§Änh5šZ¦º³Q|Q³2`üéÑgý®(ã="ö£·SçÊC% ÀÜjjùU?å’ßÍÞŽsS&}K¼y>Ì;ÔÀ°ËC3+¡Lr.Œi~Fÿ(ƒ8Õ•÷<ê@"ew)¢úpÃþÞ|E® Î!³{ïwÞ&<¡TÊ"Õm¾ƒ6»òù±O£†övRçà›>覨¡O$öv~}?4ï©€Jð('ˆ-mEžè\Ós>Îü´ºüùýù¹ò×ø7ˆcI-gð:IX‹<´Ê9NÇ'Ezê4G5‡”ŸêóC d½,^£Z‰_S%0zZ‡NŠŽ÷hÃ8rõùe*¡ Œ¸›‹ƒÔƒM¹Ö†×Þ7åT1Yt¦o˜­ÌM.ƒès‰¥ 1¨›k"–;ÜoÇÂU«»¯0C¼¼2L*Ã>Æå_Ýõ Ûá /Ö„—§Ôí7æætd[²²*²‹² Ñ|aòð-æ6§LbXÅRÅ©ÿ”tÀ§9§šÖ3¬ô˜~¿¤08y$žü“X—)Ý‘D&&ïö¥d„´™äÐÞ0ö”·´@[L䟉h‹;{×õ c=ÍB#ÑÑA¢GêŸÃdzV‘ñiã8ïëìOöpìÍ1#ú™J=H?Äð$BÊ &™ôO{Eü™WÚåC…±Ò!´RA>¨í©u–fùÞ¾›ÝåöÔ ê=ÈyN àDëjä`åý¬n÷ÑfìC¾³ÉwÍÕw²ïùm2ÚL”§÷ÿ“u”@+ •”‘$ð^®©Ì$a8µ©­²/Q½Y}8EVaûSÓÖ ×ó$¬ét3}ÿfH×k<vÏIŽ ô Ò¥êrr³ ©ZcjYŒ„ýhT$$eF«vÔï:áâÌù(…÷#yÌR/>O—örîBšˆ\Ħ†P+ÒuŠeZÔÖE0Ö\)þÖr¬ @’Y@Ÿ¡ )•Õ„­.552×Ç€?`O˜‡_I‘€‡|ñr4Nü`(u"~ž•§? äé¬K!H¨¸{º:¼žÞIÄ,z<öç’‚eŠÁcþ¨@oV׾¾ÇÕÐ$Š\(©Ê=1¼ó¬CáK>šË¢ ÛZ°Ovš1.'Ш2*óUPÅ–ü"£±È\yš°Éü'ÑŽu<ú,ÔC$—ô»]³ýËvŸà/µWYùš7ÿQY‰ÂÓ#K¶ƒv![Ðׄð‹Ò‘œ…Îú–F†]¬ÖÉ>«˜EsÄlûú ï¹ïJ>¿«ÅÝ%ßßþì \„ë3|žÕ–ŸÎ"+ñè7üO!øzoL×Ò žD ÇkU­2Cx,ë[¹¸×à/} ðßøHQýãmNH‰¾<š Ð`ÞO¶ÍÕöò|òù'è%B¹Q¼´OI¡MO ß´>#<Áë„î.ƒNÒ•¤B˜;Êí÷x0qÎx)ưxhÂWãX‚8èú†ÈŸ­h´—Óu×/|NÁùåØg(_‚΋¡Ã) xOt”þÐ.‰B«­„úzr‘Y–+N_%ÿ aCÂúpét˜ÒÊÌÚ“E÷r?ÎïÊ¿\~´úBkÁ¸ ­fãV¹§bu[£á„y6Ú’mKï½kCƒî¹³;ùzþŒ8ï“ùÄ9óaö6ÙÌŒÜø>’kù4kZ‚q}êwMï²?Žf—ŸB]"4´¼[Œ‡Òì–ÎÂ[—HôÐgv·CÔ–˜œ¶­´"­ÕÅÞTÅ‘ >Æ{ŠKzƒ&ŠûÍ÷6%œnF+…³Òrßÿ¦ø!áeåFŸ¥“TBZÑ/ô÷м4c£“>A‹Î}ü zï“ðO܊ϲ¥Ø6yÄç×Ú¤çíMùUž«eÍ@[ô¾{öÒî|Yhù6ɘã)›­Ú^°7?1-%-^®ɋɑÏóW,Ó)d³¾[^á3 «èksGƉ­õŒ"gwÕÛÀ,¡•ªìT­ô¢Œ"Co¹PYFc‘9aGiuÙmqÇ%àëkDæ²Ó½MM™ò†ê‚cQVVT•*J¡¶€öî¤yõ ð… °§3÷4ÃþõÅsy'œ’œ¶­d§Ç0«æmãaÙ‡9G eÅ-í %¹p<”êßMJ¤ÎrÄÎ.öS*×ÿ󌪭þÃb)êÏœR•<¾½ÿ$xüé3*Gc)(}DÛ–ÛL¶@ÂcÝ ¾ý¡ØÔ"œá¤ §vázeFP2D‚å¨àLå}šmÑT++åù×:­9‡Šî®ºƒŒ-éË5JÌ íå-ºœ`º>²\š¯ÚAúJ±B^ʰß) jSÚ$ŸBû_sö3ãÑOb埵Ӏyß~ç5š½K=€6o¥_O†Þxì† ¶´Çî¬ßÞ#¤F?§öñè>I(²wëø…> qì©¶f'là«ÄƆ¤ªHâ‹èøÌHMdY|4@]•#ÿìôãö¥-Ö&>O]á쇫çl*cA™œÒî[@ ©+ÌX:[±¼Ýëo±È5Š«Wÿ-ð‹ïFïÄ?cH=ÃVÖg—e—f—…:›ãxÌ9»c†5UAnQQK{øù”‹ÂéÙ½ûO»=»ˆr±e EP0ŒXîÍßêu² ¡÷B†R½—aÉ÷:XÉ=Í!{„}ûô_‹ú3Ø»Žîs2óŒP[ÝêžK¾£Îò[M~ñ%_ö¬;{Ú“Ïë a´FDí=‘ñT4›ÈU žÚ§ìöì ±7ž|ýìÜΊޖ·›¿…&ÔägX-¦!×$=g%Ä}Îv•UQ[è¢ÛnˆØ ê!~KĦSŽóê§Ðô\'Fà@¸Í·!Éýÿð·zÎÄ}™xþGÒ(O__ðØëO•ýzÎÙ_ÕÙ…ÐÜ´?JÀî¾õ<ÃO*аóè¹íé6]ù°žîxNœàé}he„£Ã÷~^û<=ûô,,|ÜÙã|™CÀÃ!¤á ¤†O‡pØž²;£-¦l/^¡²Èx†½ÝdH€$IhÏ^*a¼ã‚’ÍÎS÷{аdZƱǻ‹w’TC~²bÅn,ãŸ'¶›¿»¡¸›L‡ÿgº°åW|I Í<‡f† ™îìrþW»x²»}ýTuÿèݵ¤ƒ½›´:ÅWé¡§eh ˜5ÕqAØ2HÝRÍÇ[SW™šeÊ.Ï>SÄâúœ•,èiÊHGI´fê“ }H éZ=rI=/¬0æA&"P’0%ZÕ‡±—÷¶Í®(Cál'*ðÂf1Ž¡Qú§ÈqîÖlE³ˆ[F —…Ö‰K\ý)!à¯òoAë8¤êsèP%ÐL†&4—sڤ̸(“)7¯µåHÙy¸­‹+dóßY3‡pÞ*KâÇfSniJ¤À¤Bh†z·lîµ%¨? á€èoÊ‘«ó°_êßE:~)±Ð1çânÜ|Á'Ùwç~ô:¢î܇6(R5jZMž[œPGì# M“åxÔ™‰Ä—OÅ/ìÁþ»púãÅìÍjÿ¯*Ð"Šd³Þ[÷>¬€ðãéVu¹&»(¯Ëvâs¸ ‡—§- É“òç‰ 7žérüwZ[’JØ™ñÚDÕÎAŽí`('•Òx;^ùŽJÂýt2õÞv¢QÊóM§PZ_½P]–m(G·Q§ ŸÆ_çu†ZÒ Â™RÀéRAÚ@6b)3–’ÔGÛÿïd­J)šs»‚f'¸ðåh‹ØÜr`¼èÃhœè]@ 4·;éV4 ¿#>/< #B+Á/pcÿ×Ñwi9€:DÒNÌ\¢wàq„z{  ƒñ0½@›”Ÿ\ Í`i4ìCC¹ŸþèÂçNƒ„7„^baɱvC¯Ä[Õä+¯Dï‰-Çåð¨ú6´›kÍì”Y6)”*¹6MW(­' g]¹£ð‹í×0“gîpVá0ȌѦ¨9,J{ï½´E™±rL¡9a8• 0V©Ošcµ±AZš@ò?(SµM6÷£w­PÙko³pXUk(1ïç[ùgw ®08y‹}ò¶î³œ´ûøà§yÌ/OÜÅ›|·z)ö¡îbZ»¿r“ˆ¹]htÒv¡1]nH|6HàÚ.’Ú¡ùsâÂ[gý` ø­•{¦-l\ ŽÃ±ó7¤{$6”ɉE±ž¨’?áþ³„S§k5z•6±0¥œ$úƒÈ+3çó¿-ãÌySV³ùÉ/âÂQ6ÃfØê¶H¾¨Þûœ€Î 7là-be@\$‰8û¥R,Ġª› I×\®ÞI*ò űQr Y}ÎË‘êúÐâ(e€°>á[±¡\aIÏÁyÈ‹CWWAN±ÅPîa¬N.H!ÎÓêS2ðã]\º:U©MÔ¥™¹*tr…Ùú\R¬+ ŒÕv°û^¹sÅ…ïäÝ4ƒ„v?¢edGQ«€"ôoŠVÑx2™´W€*þ7Ú^2IÒa¯iˆîS»Ý¾tAœ]¨ÎÏÈÁ'Q 'ÏÕfe$•Ê3ã´‰ùÊ<ÊÃ^¾‚½ä*Á≯Ry aocVq.O¡]\ž¹ˆìÇn Ðzyng«)¸ßW±È£õ/}lE#ћߖå[ŒÙÅY}E4D–bn;ÎMÀƒ›ß®ß|hñgëk€©ƒÜŠ,‹}­{d­ñĸ 48웨;¯¯8KjYz‚^©KÍU™´hv‘ãYŠÉã×à‘xâ´äô .U¯ÌN¨¦q¢\;¢¬¿!±±‡‚&Ó¨ßocDhr6ör²1fþóNfLo#ózN š+n(ëʶ+kÉ×5ñmÄF')iÍ25hLv0à!¤·NNTT,#"×z%<[‰ÈlOrI'×!¢ MíÙdœ, "לÙ-”94ÜýT+ㆀ]® UÖÆ@CN–%;zÕæy¦B›¨Ñ&èR ’K¡ë™2ÔïÙÞѱbÄüö—§òÇ«pLã~ÿ!VNî3îõÜ9 Ùº‹/O·{µ÷–ÐÕ¾FßïçtD×…B „‡iÂTAuÑ-°šš2 Ï' ®ÃÜŸZÐyÆQ…΋IË8¹“:&¼§fE†W‰Ý…W÷¤C/7¡Ìò|q ž0Z Á ªEjи»n†õô›±x¼Ã=è„ðqáý}ŦÆ‚~,1˜÷™šëÑ,ÎXk<´¹éhme«©VèRŒµ9–šýÝÙÄ,¨4kà$ÁÒ­¤…ÎЩ•›5‘©osê`mj`ÊîÔÍzÒG‚T« ¯ÑçAQZÕ†(ü§ WúwFì;£:ö3ÿ§Êu¨ %’æ/Î×ë{ì4ú_ê`hDPÊUrßÙ :†µ¥è¥:MdfL©¦Êá°ùäþž¼ÃMë£fŒ½Ä¬ Òù’e±‡Äƺž·ÏF‘ Π/ŸDÔͯ=w±ðKRìgÜÄCH™©ód³ÕAuŠR¡x”² t…Êœª£§›?æض¥ÎP,ñ^ëéƒMx5§Pª5Z™ów Ï¡©Çñh“í±¢˜ÖÔ›•±YØ%;çlšÏ,mm ¨[e d‡’.Ï,ôªN¬Ù…gqª]y¡âV‡¦oÕgFड़&BŒÇéœ^'.…{ðCEãíl³å„©¡øμÏP¼¿ä@ñ±¬g‚)û"Úbu»ÔÕ6Ú¶ïïåÍh±¸àjÐ…ÕM]û:Îåž)¼±ê ¼ð\è'_ªÙ[%«°ûÁÔ]”™§5t4_”íe8¬ôׄKCÂモctÁºµ™© ‰p¦ÕQšÍ}—§¯M_½|å4’ÓžùIf“Ål¨0Ö¤VÄ@ĤjBS§ß[‹†r‡?d†*òù÷óÑÂ|c>mdüÚ þ>‘Cî/1g ?¦ £yÈŠúîŽò¹endstream endobj 500 0 obj << /Filter /FlateDecode /Length 2368 >> stream xœÅYÛnÇ}ß_È˼y6;}¿äM1†ÙÒ~ AXÒ“ŒI&ùýœêîê®YѲ"ŽcYgNWU_ëôÌÏ‹VfÑô¯ÿovz¹Úý¼3]úÏñfùËa÷§×‘Ut1ËáÇ]kb–l–’*.,‡›ÝjõþðsÚ“UÙF48\ìÎ×——û3­tÈ&Ǽ>>^ßîÉ Åç¼^íÏœ³ª”õð¾Â.]Ö-çHN•éAkÍúêþB°6Qî÷?¾Þ}uØ}W;è´Ja1ÑÜâJÌ*ù%ØbT ËýåòýrûÑÑp:/I9_‚•ÃaLÆXØ% ÇÁç:&‡7ßÒ à±SÉDƒõµýjb6TìÅë7/$è+ú·/? ¾üþ¯¾yEXíßw4Yv¹z ä}*„%DãU(‹sQ«–B?ÙrOÏ‘¼M*D–ð÷Å.ª\´IËе¯ñ?âa„ÌòrºLÁ¨ì—›Ï&*còÓîÍdå\”.’ÕÉŠÚF…ÞM#–‰N#YÙ°œFªQ²:²ay—•Þøê±Îû(hêo(-ú;Œ"ØE%2³²XT:Oë¸3Ñ$ùÔeDÛa7ïÄgÄÛÆèí]P¾L÷Í<îFôþ|$×›Ÿ¤D÷|LAÙ"'g %ã8ð1[Ѩh8 °icLû¸ó c* iaO°ƒa¶µ#šá c«D¢ÛhÁI ÆÈºy8éE홣\PÁøà ò6;œ„¿16˜òn"¤ÓF0³r¢í°›÷Ú #˜$ Ó.ªˆÕ¿Eï9³Þö$wêNL®K"tĘÅ¿:’]TްcTØÆlÑ~b±ñ•·ÂÛ-µ`$àÔX¦Ÿ” "D³©'Á N²;Øö¢öLãªÇÜ®)„X-Ctƒ.Š ;S½åjÆö¬˜“ÑêáôÀv‹1+¦·ìÊ`>¶Ë1š=+ædp–ìaÛªtP>«˜ä=À€Çøàз1Ôâ½ ª$Ø‘î­Ã†‰X=±1Eå…ƒföÄg@0š»Œ5%t›ôƒSî6=h²¸s;±g'‚"ÄB)‹¡¨+™²Ä¡NÓÞmŠê³DE¨ gx`»Å¨yvg^®yvµŠͦœ38Kö°íGëN\šäqÒLãcj¦I¡ªañkúňFi×)[6E–Øn1¨#1Щ6= V”1š]G#mœ%{Øöãyä ”㪄3(MÚ»õ¤>¡ ['º6TJÁNCÊ“3€I²Ë7áAš€ eìaLì$ `’Ê> stream xœ¥ZmoÛFþî¿Ðû øËQw»ï»îp{Iz‡4mmýP FRl’è’t\÷×ßÌì’Ú%©¤AQ ‰¤ÝÙyyæ™Ùüº`9_0ü/ü¹ÞŸ±ÅÝÙ¯gœ¾]„?ÖûÅW×g_^ü&/XÁ×ïϼ_8¾°Úæ…Ô‹ëýYÆÍòúXìl²ØŠÜ ×›³Ÿ³×ÛåŠåL;îŒËº®:,ñ£.”sÙÝr%¥È‹"»¾§¯¥å¬ÈÒ5-.’yá þà Ͼk6Ѫä”fù¿ëÿ‚b\èX³•¹ÖJ.VRçί`S6õ~ ?êœ1“5ÛºÙl›í†6YqÁraÅbÅe®U!¼¸úñÛåÊJÍ2™3.¶g·P ¦Ëxnÿ · Aç×oήÿösvqy»Ù~¨Ê®ªp5a„Ί\YÐÇ=ŠÜ9 _IÚ#n?lÁjé\,¯p5¬ûc¿º¸…Õ Ñv,g Oä"…_7如so›ò ÌÏéÎ`tR.Ò·œvíõäž¶ÕÝ} 6™Ë--–‰Í,~eùÿ¶MW•°Ä‚Ö"ç¯æŽ" ¦)è«^äÍÕråct!I» «U®È fj›7åïÏ·ew»ÛîºûåŠ3¸%¦"« ›˜Ü23xed¨7Û²ínÛ_ËfÛ{Ö‚U67ª¢¿ý÷ÕmÛºV€ú eôvÅxbŸÂÒWƒÔËá²Ö°Ôš6Z%Ñóm]7Ûáò"Ï·éýxÎ)˜åÔHo·ûòp¶Ž6¹âEz´Î¥ÃØGaÖøM¾, øC‰Óò(”¸ÀMW½|MÑ‹éKl‘šÿÏá+q\_‡``l¿©x{fÝ`É1Ö ±i‡K—Ý#¡ŒrPª)w»ç¥ÃÀÐ&{v8,×î£U[²oΠѾ/¤ÑNe+R…TR™ÌÿF¤E^…Ë6( š™mbLlÛj_íʦê–ÂA¹ì9¬,L¶/»¦úÍfLfåz)L^hn³X˜ü°„ËNª=)<omöÜl mG(>zìm‚NÖÚ`†›¬Ü=ž‚ç6Ø®ð>R®ûœ‚ôîx¹u‚íU8Üc„…ÏeY#ÝûmÝõÖ7ƒWüöe7—³cÇ)Æá£Éî¼¢_ªÄEò€t"ëPB€ÊÙ>YQ¶ÑÑ©ƒ[ˆ…qö •Î/KkA¤7˜ì¯Ûx5 ]¤7Ô׃6~¯©6´ÜZ¿gH“ÿEò)ñ@W}è#0Ytò*kh%(‡Ó!;R-1²ýO\…Àð?ÄÊLJ¬ã8ÀrýÖ†{9‰¶£´0çÞvðIÉu3¼qhÐj« /[Œ1 &Púsü„àvÆwZAQ¢B^UXL Ì Î?•@°¢ŽÌéUQŸ‘­tXv“X¶…fù“ó8i=³ËÚûúév騀éo÷Ûî¾Þ´7Ùù¦j»ó›¥ç†#"i5Vþžvuo’"ûË 'o‚ºZdu¬®Ïæ•t¸ÌèÙSìºjM8'¬Êî•Èû<¿!ç„tõ憘Îv5R©È£eLY7ABφ8É0ÇØ»zâCâ¥!~³Ì}Ô+Ñv€´ë¥ƒÔ0¯REö¡JnG5l¥4ÃZÇ7­÷‘Ý|ª*,—zŠ“(n-$Nu—€X¹ B€âqý*»Òÿ€QÞ—+ˆ~Bø ¼á:ÈÖ ¼Ñ©º/«Öä·”ÝNÙ$šwÝqw9Üp½ù£ì ±#5–te]öäN»áPÃS_ ¨ôZ•¥:jŒ?“b±fSl ì¡Ú—wÛ› 鯓‡£îæÈhì‹„pÜ•Dº0Ö„¤øbXò‹>L¥†iB8gÁÆ"‰ÕE¨çpæª6ĸåVôps’4P¥d†¢ò1"]] F›_øD—@²Ä\‘FK¸±QS¤N íăž £N2Kåø!Iùy:ä?Ró )‰/ÞGU¸edØúãð6O›”Ê5O¬L°>ci((`hÙ[zÄPƒq§h“Ôà·EWãÆ±P„À ZÓ¦Œ‰€©(‘OðF<à“t_ͱ.u+P>-E) 5jàÒÜì†u>ˆ»¸´TÝ$Ó?ÁT:…u=SÝ6·ÛfÿØyÀ›1|û9g{ÃOo RnÌ1i+‚õÄ´Dà÷ˆ®GÇô1P[Kilð#¢qfŸ@FIAž·Ú×^ábĺàá4•¢Q½Æ¸¾i¾šŽ^ö9áþ6!ƒô=вyrE?#/Ѫ†zÍšJ»ƒ/C/Éåñ›%<¡‚.añ” ¿î_îqzƒ¤Öôòý¡g`®›ÍE õF̽nzí¦ÄÛÅ¢¦=v?µýrI¥œÖÓèèEG^ƒ$*!)Ép‘Ó!ébû1†°Œ2X Ï£ðÖÍ'\VÍ\z˜tÀ!Ú@-¦2Æ,ÃXG¹û9ìÅðaLeüÍÞ™lê—‰^¨ŒILHEH1Ê&oÈéàˆŒá¦Y&|oœÖê¤µÞæt#€µ›T=D2é/í¸ yæ–Þöà°w´Bi}ž/¨‚á¡do/f{iž+­‡^ ^Ö÷Ô‚†ó¶pä*ºÑà}òiÆWCÔöðäpÈ6.3=rürŠÎ$¸BU[i˜+­^;†3I1µ2I 4êd}@Aà¾;…nƒ¬hÂʦµ$þø´i¶ŸoåŒÌ!ìƒ×§J>·9w"nå¤ÏïôE¬í ð‘9ÛS°¤sÓlCY$w­÷ä«Uh6s™i.™·Ê‘L1§{ì°Ï€Œ+îhî9ª©ï£ˆ"¥¥'6éü=žìJ"{žv¸D&aJS£ñli¶Þ䜶¦øV¢gÚç¡ÕèWÉÙr¯Aäõ¤WU® ezR^ªc¯¸êîên{‰d ÖÆûFïÐ+%’÷ÛWÕÝÌÌíÈc_^Ÿýp柬õ¢ùܧj¥LιYˆÂå‚z¯–˜aÛÏÞOó\[žì—û|†¯’Wfi-]õOIbÿ Ÿ`³¾h×໛췛å‹ð8E9h#ÿIgÿì¥dv~IïÔç/ŽYMý0»öÕÅ›«—7hÆô=+R£¾ûz³=JýcÕo-®êǽß^„ÝFÏyôVá¬Awõ±{öïïþªžYý¡«~y©Õ‚ãÈÔMqhôÐ]CKY £'è¯ëýCÙTÌXëÛ–Mõ…Ï,dU@«šía)qT }oi½.-E-‡ÀÅ5=É¥Mp|€sp|‚Bõ o£Õ³Ï,‡’Èçg·œÑŸœÑâ:¥çG-s` ͼ4ß6èï…Ýd1yQêÒ\÷h.RÚ mýUH]Ä`=AmºÎâï(6HVÑQXœ…³šgý2 ÍÌì«ïYûßÌÛɦ¿Ô’¦êu,ä̰õdzTQºã­&Sk´¤šLXePòÈ8šçÛ/?ôáýô|~¦cñE¾Ÿ6lf{]luM‡ á}›Ú}6óžG“ö_écržg ¨ Ï£™O–ýVî“jrj²™§­s­©—KF_B¡î+*$gx1]NŽz„DO@ŠÖ3$çkp¾{áLŒØX˜oXR‰ñÑgrÍl`ÔÚ{gH;"Ή[N§dh0§¼Fæ£ùΉV@œž…Fó¾@N¶Ííèõ¾ïx1ÉKÚKÉÀ$ýˆ«Sû~‚Žÿ9ö =h ÅDÁ¦ÀÎÿ,{ZäLÉ~'؃°œ–žbáõdÙ>¿¾úþüÅù¥xy•Ûó‹Ë«‹¡ b™ýæëc}Ùù럒߽ùî<.ùÇuÌ Ž•hˇ‡ÝóM¯é@²W?¾=’—¨†¿<¬Ñƒ ‚]l¯DKŸÄ&b"°"èE®øáìÿIîAendstream endobj 502 0 obj << /Filter /FlateDecode /Length 3289 >> stream xœ¥Zßoã6~ÏßpF_JbUü) ¸; íõ®=-Ú¸‡M±Õ&^G[ÛÚJJœÜ_3CR"%9Ùí"‘mr8Î|óÍP¬òŒ¯rüóÿoùjwñǧoWþßÍaõÕÕÅ?ü&+󒯮Þ^¸)|eùªÐEVJ½º:\0!ÖWï`°-’Á…Ȭ00áêöâû÷v½É³\[ne}_×øQ—ÊZ¶[o¤YY²«;úZ–Ô¦›æ€}â9Îõp ²Ñ9˜¤Ä̦fH‰µ­CÊQnæ „V+às€ã‚è½ÈMÆ%ÒûœJ•Îj:SPužýv[–°‰ê}çü0†/™_À£–eðÍ/až.ÑÙÄ¢`CáY!Çü %M~0dn¥E,©ZÀz—˜b÷ÿ"á=y‰C`,@†z&…Üú™:…äß^YékžðY³SlÛM+Ç­¨ó«¤yeÌœm³k«C`?œt9›Zý~r3 YR×”s\s?¨iºKâpJ´G*5ŽÎ «yï> -ÆÉ©Ï,Ãê”öA˜1 ‹ ]Óóg­ÒúÕ (θËÝmãèeY°Sç€7KõÜaÂijî£Ã:ÄS:(% òà«Ê>½_Øž‹ýè-¡•¥¬Å ÑÁ<Âþ`É EQZØTq"ëü(8мDA/@Ï >®¯æD¾M%Í@ÃZ%'rÊ¢¦›  ö†r¦,Ìù™sVTùxðI†àk¡\è~;CZgæ‚6ÞFˆa"8µCB2¶ñÏÁ­{pX0@Iñ’”ˆãA¥Œ‡H )¢ñÔ,61KuUK‰©²jqOéÓ®¯oü÷ðøP'Œ«Ú×ÿ‹72ñÑ0 $ïe€´MB1ü¤°Ö?wͰ¤”öǶž8˜£¤†TóœBò9ÅÔq‘nùø¼õ€ê=ÔƒÍþù×KͱCmÛTmëª ×'ÏEòiàJ2Uª¤üˆ£²ìî)z’]TÞ}"í2,3ù>Ûe—¤ô7W?]¸^¬^µÛƒÒf…P+Éu0ŠØW웩ëîì¡^†Nªd¿D_ûPG¦•’¹ýÁc°á§£ûÊcŸ-Jv:ÁÕ.Ð6ð5È×í  \¨6%ØWMߥ͈¨*Æ`b~¬íTQ€¿ÈØvìza{#KC¿m¨fµ…#ÿ¢¬U"!S±ܯHŒ·„,¾A5ã÷Ÿvò\¡óË•(m¦DAÚËL¡öÒÜ/T,ñUèM)ri±nÔì÷$†ÂüäGä“Ñ`¬Lè¿«~)S[W@ÇÉ¥«c4؇E]¯-ŽeÉ_f9zÑ 5`qãU_ªý¨ô£š0Ž\Á5å¼±æÖ4Ó |˜1Áر‘u6;ºd¶ÙpPµ­ ñÐ;Õ3D:‘‰ó‚ÐñO¦Z'­}Jx†«ÃDðè–ƒs;$æ©ibò«:@ê‚f|n/ü^ó”w}u¶ ØÆ©¸5ËÐžàŒ µ¦êPMìâ¶.'5Ø»´=§‡g ×s[Êæ¸Uߣµ)ëÆ#$ÐýÍ*ìªK8[5 ”Á ž¾Ô‹YÑ/ 3Ÿ}á] :p _àzÔD'V|›¤ö ûð\dwç¯0½÷Áqð%0ó¡žÜçÑx%£•Ǧ_:èåÃæ_n"½ÕÙñ¬¡fµ V í”@ˆ.(év²pÁ~J½ƒFœðAPp"wÞD¥«nÄÜsø*@žÓÒ½õŒë.¥-¹Y CÃäK5Œ4’¢ÂwhZãÑ M¦îXiUsçEÖîÛ‹”.MGKž¡¦K² ã4ìQ/L±ïfí¹´Á'”ÌŠÒ~JƒOgÜ$H¯…¶~ÀšÎ9ü¼± ¹ùý}?\08íâCœc­÷Á%õ'wÀÆXáôgwP‡]¡ro¤;ݨÜd›sI;Å­ŽI¦ÁgØOs‰“u~i•’¼sñgÑjÃþ`FOQÖ´CBÀD?Hí»&,©g:S—^—/ÝÜŽ75u»æÈöŠe†é£‹TénX´Ù/çSƃn…kô-$9?²3iD4®ªUJ5î‡NIœQVºOáÊ 2cB4Ò£©Z_—ñɰ´ìÞ‡šB§ì;m}Oo•g7x2ºK(¦1· "¶ëý̦£Ù¨Ÿ IøOöDÃ%Cžß¶ëãkµáò~(R\ëIQªš6•ÖI§a¿÷Ù[XÓX@IX*&¦{öÒê;e51üÊhíBÌ‚t5m»Êu³u-ç-$ML¾=׳eÍaÿäÅË\βK]ÓycKK¯Ûšša = R­K¢£_~7BZŒ-K¸Æ<½âñÚaÉé¡|þ ŠW›²HÞjI[Ï›s7¤’ޱ)"NT¤€½_¥ˆ¥^áÛ T*±£G~|j¸þYºW‰kÜJVNÙìTIj„^û{Žœµ©Ç[©h¸œîn¿õëº6Ç̧݅Ÿ˜¤g ñyz¢Á`Á ê&~Ô††‡ ͹pa¶Oƒ0{æåU.¼¼óxæ ¶›j¿½f—Ñ»_Ûc¿Þ£Š^Jû×—ßÿòÍðºÏäN,}o(ñaGsñ€ž¦X@ÏPo¤½4a°*¤[ù ònÌŒŽ4 ž»0ŽÀŸnÛèƒö­r÷I.u¨¹k¦¯Ò| R¸•>ài“{‰Ïd`¶q«ׯ>»x|‰[Åâ÷ƒÁ öãB_„”gø>½ÆPi¡Xøñe~åó>½ìè2Û.À í5+Ð@ˆ¤¯¸Þl¿v/ÌÎ`‡G/̶Íéõ¾z³Ýw£ 3E½ÏŸ.þ‚æÒendstream endobj 503 0 obj << /Filter /FlateDecode /Length 13876 >> stream xœ­} ˜_E‘/ ax…å%Dt|Üå?læŸóêó@ä¡À¢CÂÀLf&@PAq?p ‹„‹¨ìF]/*\W@@ÀDy¨¬r• ¨,¢°lU÷9§«úô©“?ìǧ3©ùuuuuuuuשsNúáp€ÿ•?—MÃ+‡N 5u¸ü±lrx¯%C‹Í3 ô‹ ‡—3dš„Ãa®úyR g*ë±^29tTï ñe#þ;MzÇŽý@ÅY½±#£ø¯<ÌÓ¼712Çq?âÞþc6ƒ¨Z«@! Š8ê±¶Ó ±qÒÂÞ;W릪Hr Ï"=‚Ö½ý§¦W¦ãÇ/¬þ”öö¦ÝMÏÌŽ­2ÒªèíµšüÕŒ$)rI”÷ƒ$L{³c#ï]òÐIPÄqÚjfÉò¡^,9nèíK†A•FÀ;N‡•J“~ž‡IõÓd8Œ“¨dÃÓ+†^5S‘¥0!Q‘Àÿ§q1<½²Ñ6Îb€EÃ9ˆ¥âÚ3Tµ?bË4æ-¡I¶¶L±Mœ(l©o™GýL½¬>‹°Ÿµ6ŒtÃ(† o˜Hc- –-ƒ G%±·eJó·´ 0ï«Ü/˜Á¤«¸MúPËe¡g’R0‚¤eÜ”¨~µ²l U þì`ŸÂϰKY3ßÅ)ûírJj(àï­v#ް(úAÑ!WàRì…)¬ö—c‚Y¤À{u±ÿ“·’¼¨²–c‹Z-HÁÊë2¤,…EÖ5ÓY†«³‹Sk§ÕEÄqãH=a™3šTëTçD¦eÎ[°Ê:äÊXO­Ü“HË•¡–³ bÜóPõã¢ÍHrå,²ë’u‘ÃϨËxsðùQ«s‘|j®Â~Øå»ò—æË’>-p3ê`ŸÁÒke/JŸÃzì²Ã¼€¥×n‡Â¬¬Ç.s*BXzë(­{žÅa?íšé"ile>Pѽ!*oÝ,(ÍܽÇ3º TÚ¶,P±‰ÒN‹»å½¤u^¤uXí[´Ñ~R膳0¡-!€Ÿ­ sÜCT¤»Œ"Þ0„Öî4¤.#XaÓš1¬°–…€Ú÷±v=§AË«}Ð’è –W‡¥A Ë«cëIƒ VR‡Hƒ¼} ¢4X_~ ƒÆÎ¶žzCÜq»Ø‡°Ý½Ó á :–tư»¬(L`!¶î2âìl­‘‡(=!â7’†ðר5tƒÓBµúI08-„­}š6ºcKØÀhËŽ a‹¡,Æ.“‹º¶Ö4Š`‰µú8f¡”9®íLÅ\ÊÎÉ­Áˆ8¾c—ÁE*îg]¥°îº&Âù~Ú©‡Ú÷È@ÕP¬•Ö—§zËrû“ ¥+ŒX'mVQêQX$Ý*‘T!í-J¯Ú EÓþG9ª†B!µhwJ,®ŒJ(´ô)—^KݵŸ9¥Ñ ÕØrwB…¶4<¡f[œw¡Œ[œw©´[S*öUR¸¸%IEᢒ Åå…âqqK ÊeÝEæþGܪ†BṬ¡]\rº°.äbõv—JÕEI¥òuQ7RI»Ü£Pæ.,)±ð]PŒPö.‹)”ÂËŠËãû–êãeQÅšyIT±d^èQ®˜z”JæEåÈeôBä,UÑË¢ •õ5F¨¢—‡Ó^Y/F¬¶"n©Ø^ôÖr¾°?ÈÅøãŠðX•wã{´j[fR1¾G=¶¥XïÉ~Ù–íÕø5F.¼÷Üê‘–Rá½ç¾Ç¶ ï-H,²÷ÄlK¡ÈÞwef …÷$ÖØ7o«lC±Ä^Xb/ÙŽXb/™«\b/R(±¯Ar5½4 ©šÞ‚ÄÂyiØRἉ…ó¢ôbá¼drá¼´ØäÊyQÚLªœÕ(VÎ{®mlK©r^0;¹p^¥T8ï úl;±–Þ³ûØ–b-½Ð£PIoAb%½4ir)½8 ¡”Þ‚ÄRzq†ÄRzÉ(ÄJzi¹I•ô²°by½dùry½Ø¥P^oAB)=IÝ š–*ée«“Ëë%«“ëëE…‰õõbŸB}½8N¹è^9;Šî[½EGͽçMŸ¶¥PsO@Ò«t±„Š{qÖÄ2| ÊðÅõ×U›/ &׿·Æ›]¥ù훺Xš/z6±^Ÿ€¤ÚüV7ÐUš/‰%”æËÚï¨×„•Ëõ¥.År}ÉÈär}ÉHåú$VæK‚I•ùÔ^…oA/+úèªÂfCªÂ· ±à^ÔŒXp/I,¸¶™Ž‚{±O¡àž€¤ÚúFj˶*ëåM¬£Ü^PEG¹½Ô§Pn/R¨À—6¶Ž¢|iˆrQ¾`›åÛ–rQ~ãÒš4ìŽõ»ÊïÛu(ßK:”‹ï¥hG.¾û6¯i úß?ÄÚûvó’*ïEÍ‹Õøí:•kñ9ÅR|É!K¥ø$–ÝKF/ÕÝw&ã ¡‚TŒoABá½ Eö$VÔKa”XQ/©F*©· ®KÛŽêyQr¡zÞ‚„By kâ…Y–Kâ…8^ªˆ· ±øÝó@+iÙ^ünAB¡»,¼Xü.Ê%U¿»ÏõÚVB黉¥ïBΣ£ô]Ègˆµï5Hª}· ±Î]:×É…îÂ,Juî$Ô¹[P{I»Åˆåë’ÍHõë$ÖªKZJÕ-H¬JgG¬J—†-W¥Kö,W¥ÇÍb;ÛR¨JïèS(U· ¡*]Xþrº8©P=Òæ`Þ`[¾T×6 Õ=Ú¶¥Xªn^n %Ë÷“–R­ºç%®¶¥P«ŽßEÎÃ`XEk$ÅpÂé(¯~T_D¾Hƒ[ÏŠŸ^ÆOQâ——C8¸¨a…a)hIzñˆÂÏGqoÅìØDÿˆñå³Çêï7‚‹ ÀZFã &Ä[²¼ ?pŪ•>„)ňÛ4€Ý¿ó|ØŠ,lÉqCš)LåZ‚L×ÕW¡ÁHGÃ+g*=”ùx Åc`à|:ÆæÉCáð;àÇÁˆ÷ÊáP{„9Fñð¤¥àg’'†ã„É!}A­2Ïß›,àLªd Cš„ù€3Q’R ãl;Rp¶ÁˆB*ZÉGyA®Àl¢àk¤¤!Ÿ"„UJAkۦⓜaJ`Â@«Üj0Ê•¾c¥˜’„Œê/¶ZÜt§ yœsTIÓ¼¼áð¢<¢CÔª ehšW TŽâüiYÚrehˆ‚ß@Û~TƒWùlC•4D¡AEŠó§=¦j—£ Pì2Y ¨ÉÊ<ÂQ††¨BŸ9ŠÓ(*ƒA; M"By žÞ2ÜV”¦NĵGô©Š<$aÔ„øæEá¶ã 4Írb nhÔôÀ¿©ÜAZ9/aØ‚jðÊ‚só UÒÞ vŽâüia‚û#G¢Ôd«~r”¡éiÆî;(N£(àÄÊЈX>P“U¢7Ž24JñÈï ¢ÌsIeh¥%CLæGyz,¬“ä42DbìY‡!N¹ƒÒ4ÂÊ j°J|ð†£ JE@Ü܈â9.qP%­´š(ñ£<Æ ñl9(CCTªsºÅùÓͳXehzígöùQM^EÒwAšD”E œ7íÍÑj0‚) RŽ1$"Ã0Þ¬·°öDMk ÀUÖ‚jðÊ ˆE@{Ú¡ÊðYŽ24ÂÊòÈžâ JÓ+rN‰ôÜN§Þs9Mï¹1F¡~T“W¡ìšç4ílõ#µÅùÓÁ(£ÈAš^ó…6Y/ªÉËy„‰Q†1$?Ʊ{º BŒ\”¡iTyM?ªÉ öçÀ¹i+ieÔœ*Åø“ËÇܪ¤éiQ:€ô¡<ÒG˜ wP†VÆ\99ìY‡!ÔJÓˆæ½ —U`F‰ É2b*%[?šÏ 𢙄¨h¤9ø Oê£IDŠa¬i_V/–Ô”:·Ë›Ó'rì‹Zxã"qP†V-ñ¤Õä•Çä”Ñ´‹ðÁ>†røÓñÚ&tP†VNM¤ZPM^àD™‡²4¢.bìi‡qZea\aåyd/êÛ[‡¦YE:e(Nc(…O)8(M#byA Vn‡†FX3¯t¦MÁG9xQ«)l„ÃiD,rسC Y”¦V^PƒUûc4*•ñ$ÜdM#……‚S’PQÚO½˜óŒ"…ŠŽC¼H£ÎØö€;‹#†)IˆIüˆ—("'/FÒ¯¬I<ý€RëkhBÐ^Gßøx ‹$±a!h•èl2‡p¶¬£¸ÎK1RéjÀéø1 F!ìÿH“j›¡ÎÚö¥Š"·{%Ók@|"guÞΡyÈÑÕ#8¾úƈÓÊ¥ŒèE5yOrehD, âìY‡Ý—8­¼/oÒ‚jð‡'\”¡±ˆ±§â#.ÊÐ+È#{bSÕœFXQ[~v=ëú(¦$•S–ì5Ŧ¼ƒbJ’f£«à Μt‡DG•4½¨4Þ‹òˆ®tYGZÈ@ ÀQœ?í1#Ï-pZ95*iA5x•õ] UÒôRÕ9Žâüi¦$Ž£ ­Œ!UÚ‚jòÊé0£•rÊáÏz ëÜC#Fê5XeöÛ¡VÄ%¥²ã¡'rP†FYy@5Xth„•"óJf:]G!G•4ÂÊòMŠÉ*¥i–9«€® X¯õ®Ïi“õÍ›Õä•ÇöÑN+Q8©åð§=êòEÒ$É0íïÅ4Ùôƒ%-Ù?S¦¬zŸÎh„ärjo=p" GeT‰øLˆ‹2´rg‹ŠTƒWY7ÈP%­¾â Ξv¨bksœ¦Q9ZŒÕä•úï)ôïŒ-íÈÔ•r”¡Ù£·åº°§‘É# ‡=ë0´÷èœFXyA V*¨/¯•Ê‚¨ö¨2MQ+‡šæƒ_1jA¹³’’ýŒÑˆ@ä𦽥äÁN#¬| àY}Îrh„1«·Ë ,è#”Dø41žå”à{Y8F“,ŠqÂ+pEEdo«9M£ Œ5½(Oð–Ö¤º´*^.\ãO{Äìeá  MûÃË‹jðŠëÌ!!h.Þdìß9[Ú¹VrhzhÉjò*|¾”£ Ìqö´Cðö6×Àh¥±¤m¨&/˜—@9(CÓ(elƒ þ´Ç0w a}]©÷‡Æß›,bz-ÌhDKDx³®Èc œFøxAœOT=´í qÔE˜“§•!Zž· š¼ÀåX‡Êh¥&#åðg=j¿æ 4ŒÐ j²*êä³C£¬(ˆIJe‡K­€Ð4J飦Ôd±I9(C#R1åN»ÓEý£IdËð‚\F½¦$"ÅpÞ´7Ež€á4ÂÊòžÕ Z‡FXõ¢Ô©âq't †fùxAŸ8°—yœ¦Q…vTÅhæä¡7FÓ«*F‹ô£š¼L±?GZ9Ã…‹âüY!Vå9(M#ºò‚¬Ì+8ÊÐÈ$S”Cc(r—ÍiD,/¨ÉªÀrA¥i”qR•Æä“’#Ä35–:(M#œÈ `hHƒÏïÊÐ+È),MtPšFXQ»ÄŸ$„  ×_Œ¦Í8Á[?ªÁ ôY?MÄiˆÊr|š›£8{Òa\øR*†*ie0’µ <ÂÃÙ>ÏÌhVY ÄÙÓsû<‚C+7ܰÔ`• }§UÒ¨TD¹“îÌ‹6Æ´‡úÜj02/Õ`CÒŒt–Š欻„ä(اÔ`…™ŽØAaÅ@LR&{TWL84ÂÊ rY% IÂZ¬hdöÈ1º ¢œ”0aå5Y%y³CC#ñ CqC…ýÌ…U²É\x1 FJÙ²N#ã# ÎvgýÈÁháã4¥Në"‡F¯Èœ´„"È•´Ò/F~Pƒ>,™9 ’†œ]ÓÇPœ;é.MìcöŒDçÁ4ø$½ÎH¥kÅô#qEe>ÊÈQ†Fdò¬¸idH¥gÍCŽa$‚I òÈ §i”~g¡Õì,%M¡•;6Þ+rcO;4¯¬á(C#a’å¾ )F#Z' ‡=ë0¬+±aå5X¡†œãEI£RY£@ªRˆUæ  M£ryQM^)}²“ÑJ^Aî¢ÚcHžöæ4½ƒ`9³Ôdë§¡8ÊЬ¶(ˆs'ÝÁ{íHI„Óàc^KÄ0†¤ùèÇ~8ˆÓ( {uQ†Fdò<ÚÅåЫˆ®@6¡tŠÍû8ÊÐÈöïE5yõ×O‹r p(ÊáÏzLú© b%€~Hƒ²84‰˜˜TpÌ“: MÒ˜TG´>LƒQù>%†*iDrŽ¢ìi)-Ôb42<¨)yN’mŒV ….ŠÑŠ$§9Hå5X™7[q”¡ÑAQœÆP4ÎhD,/¨ÉŠ”`qeEë´Ø¬R -h¢›Ñ+Èg2Ò¢ŠfYQh‘Ð ëÉêÒ7NCfòü O—¦6ËÉi:–uΖ¡{Û_š“ 6FÒŒt–Új ^اE9IÇ^ÚÏ3 çM{Ãׇ‡ÊÐ4+ݱÕà•Åq}ÓãÐJ±Cqþ´Ç>¨ÀhÄ| &«”h8M;ÿÅiýÐiRȵ`šŒàg£;CÓ(“$å(ÊžöÑ@F#ªòœTlÏœ¦Wi¢ó5åÐ(*QöÆ™ÓHxéE5y¥$¡Íid„ÄÙÓÍëô8ÊЈ{ô¢š¼TX?ÖæÐˆX ÄØ³ÉS œFXyA V‰ã×S¶m¥ö$ÂlŒZœ ']_Òô¤è°øQ ^å{õª¤•¬ ŽrøÓÍË9ÊÐôø¼>õ£<Òg,“ChDWÄÙÓSú|£Qëô€<²çõK›aEA\D¥ia_àÐ+È7;öbÚ¡YVä¸zêüÃÄžî8°òš¬pßsQ†¦í/ôGqE%I¹2Zi3*jA5yA DÊÐÊs”åð§=Æ©Ib46yQM^* Ø1Q=1ö´C|˧•4ÂÊòÈN溺 †â4†ŠêÛ-‡FÄò‚¬’®æ(C#¬(ˆÏ+iUÐ#•%Q­7!M>æå™ehÄû3§QTš×wœHåy:Ì꜎C#¬ˆ‡§4^ ˜±$ xA£òœS’ÊPý9Ìiwpö P§¤‘Áù@ÉÉ9§V…bñ‘”Éž7\1šeå5X…{ý¡VÄ;ô”¤¶‚ÓôÜ:>ò¢š¼°ªÐíÑÐ4*ÂçÄ9Šó§=Æ´Z‘Ñ´"b,Hñ£š¼TQW‹9´I{ãÇPœ?íѼƕ£ M›y‚Û‹òHOïŽL#9ìY‡a]/àÐ+/¨Á ¼}ž9(C£Rä]fLL¥1{)¡•ê!{Q ^`nî%mI#bÞv˜äìV„FXù@ÙÉÍ)§V䬺.2e_?FI„‘ÒäƒÙ?ehä$ËPœFQæ½¹ehZ Nó{Q ^E‘g³ÍŽ‚ö¬Ã„Üœ2Q–Ô`UÄä–’Ñ+ Âwþ†‘y H›â$LŠŸe­Þ{Ûþ¾Ûò“·Yl‚è!*®)Z‡FPAœÕEb.«ê•Å”•K#¨@ÙŒÃ:Ä5 §C‡fQ)~,/mc¥_SpVÍ¢+WR+ €¢²»4‹’Y)p« WƒK³(ÂêÖ—9§HéAâûœCÆ·6äi1¬‚¬Ÿãëœ{K{cKGêw(Ÿ8am;½Ko‘>qo¬td[ýž`¤~¯(>{›(C{0´hïúß^C‹ŽN†í?ª`hÑ^‹÷·í»h߉¡Eû,Þm·E‹§W,_6;5 h35±zrÕ ¶€_§¦g†ãÝw:`Ÿá5—~øñǵâ5wë’bÝ#ÿÐìy—Ýù³ë®;ï›;ýîo7{±øð_~ðú7žuîÇ{›²Í«†ÎŸpE°xþŸ.È.=7ZtàÛ·úèæg¼âúw.ÿLúãpð…3{|⮵üÉcŸÿþEϽxùs§\þÜA·ýëÿòׯ}gñ%·sïÛþÿ~óv[sÔ~{coî‡æn±Í¯Þ¹éºï¿ûâÓžþÄßoÌ¡ç¼lã7nð@¶]qcïÐÇ×}ö»[ÍlxÚÌî»ÿètvvüÓlsËUs.~Ó›ý®‹ÿõMê’­¿t]°ãû.½ëoÖ¼ðà¢+þòoG_~øümžókÝ{ø«O~æ™»íÂý?°hþ†\¾[öÖmÏYwâ‰ûŸ1ûÇDs—>tÎ5÷Î}úU‡|mèKŸÜx³mpÖÝ÷MÿuÏÄg¶úýçÿá ó?xËezéþÓÙhÏÉÓnúòYé £ŸýÃÖÜõð_úåmg~lù?ú£uúðôqÑmoýÿyõ¹áܧþ8}_ú†³/Ýòª]Ÿyz¿“_àNïß᪫Î8ìgžqÆ[^}Ó{®š¿ã™¯ýìæCGŸ¶÷×þlËw]xûGïÞnÞÓwŒœñ«?­ûçG^¼õÆ¿ìþúí7\pdzKÞòèo6¹´øë×ÇŸýÚ¢ßý…??wêÞ\³ÛÍ?_ûÔ ÷=qä ûn0÷º›{ö™ù·^¶û̾øà±{/üùi¯á]/ÙðôEÛܘ^þ›£×lôÿNúᯋþ™{žpø‹ßÛ`ë/|d«¹ü`ï×W«|ìãû|ïø#Þu‡7oØ»á²9ß8tí5^vùÆŸ¼ïÿþñuKΚ³èùñýw=þ´¯Ûô?øáf¯9û#ëî{ÕÆ¿³zŸ§/ÚðŽ3·»÷u·…î—½í7Ææ½zÓ±=–ýîËÛ]yõ¹_½øô=îÚåŠ}Wîî5týÿþ»:ä “Güûcç\yÖâ÷„ÁéËoyçgç¥ ?½Á.7ÝûÔs¯>?¾bíóF6š?«ìýħŸ¹õ—WÜýä¿ÜôÐNŸÜàü¥«ôþökÿEzÇî×޼à [q÷uGnyFîíߺéß÷Ýì«¿\µöÊïâcg½oþžÛl}î¹¾oÞ¼O_þgK®Øø+›<úðÝ=vÂÁ“¾mbò°ßrî{Üÿ±í7™¹äƇ—ܱٕßßñäµ§®»ç²ËÏ=äé‹¿þ¦'fï_¼ùáÓ]ýçÇ–÷Ä·èÏûÀä m{Ãc·|ë+?þYðºðØoí=qÞ5ç?3÷çkŽÿöŽ¿X°çŠoßìçn ÏÜéý«÷{òO¿i£ûǯ=~l›bã-wùý§~òæóÎ>xbñæÇ}exÍç]²ã-'o1÷î÷_wíC|ßêÎyÏ¿ Ï<ÐÿÆOW|ägïÊ>ýãÉÑ×ýg˜¾ö3W_|ßÙ¯ÎNzvâè5û?þŽ/.½÷??kášy×þó§~$}ôìh³_·î½mvôF{¾ê'¿¹É¦lyσ_9~§ŸŽÍýógÞä“7®yìù?yÁe›Î{éÅS³ä]tþ†¯›ó_ßóÛÍ/}ÛÚ3÷ùÉ5O|ú¡ >¼ú‰ýæ-Yó©sOýÜç§¿yÿâ‰+_µçŽÇ?û†Ûý×ú×ÿnŸ§søßÙz|o>öÉï¾ï°ko¼õü©ý¢/m>qíÚÛöØö­;üÇ&/|ûúýÏýæFÇmvëé{Îß÷éÓ¾ë½_à=ï[wý¥Ìþöý v›úé³Oí²ÅNüÓßÝs«:èéÓþk£/|꣧½ý€áC|Û³ëOŸMÍO|=l]ïóW`Ðúã­2ÿT›%D¸8oÓà€—ÃoTнPÞ÷ò‡Ú*è¡…ÕÛþ|ƒAØxÙ¿æÆ"Ü~JÀlFÞ]&ÆÓsEw*¨eŸ)hãþÕ§3y÷Ò_ ‹ò–Ý+yE{לdƒÛ_š³`Á‚™™™eË–Í›7oÎùçŸÞyç]}õÕ;ï¼óœgžyæÎ;ï\ºté1Ç3çùçŸòÉ'×®]{É%—¼éÞN2vâŠé` çÝ ?âÿ¥þ–>¤—%xá”bðÑ^z{^ÿêîWŸ?g‹3‚y}û¥—.Üï5Wõ»»Ï›Üwë½n{Û‚ ?wÈü[¿8w‹÷~û‚Kþ4ºë–£]ùMG&ŸbÇV¼ôèïì¸øöí¾wûÇ»á–ÛNYpíõŸ}ø —ŸzÙ÷ßöû[®™³ç‘sŸ+Š33T¥‡™"´b•èwˆW É¡8Kõks*Ê„USÂú}þ1æ’Š¢j A9üiµ>KµŠÕb,®T:Åfbµ£zA_ŒÂ1@Ái·ê_ña¹^ôzÙ Æ~Ö>´1áQ=ôº Šćús1¾Z €£x) ]›%¼ïøÊÕ<½bdTW¨¥ª—î:2šD ¿þÑ[2’CH€°'àçˆð·)-ЏwgR‚“HãÞÌÈ(–WÄ }’ã( òÞª‘«œ‹ÞìØìøÔ*ÝXIžcƒ‚÷¢öÇ”ü“¬~ÅvP‹kqñy˜§yolzzl®4Mƒ$JòÞò’uõƧÇuG0¶0?Ø&c³c%,Oz“c³Óãkú …8ÔHm—£†þfJI°áª’®âÞUÇìøäØÄÄ)2qdžš6Ý›•GieH‰Ó‰um °á%-Ù娞ÑO’GEÑ«š)Ç0 ‘Q4ÅLnrì„ò ƒRS¦Éò’'ÚxpÒ¢†ØšÖ nùyÖØeñ;å0lǂ˅jPõB5ÿ\Y1+ÜéX:Ò/ÝVT0CùðèYz÷ÝGF±˜!Á­‚Q/í­YXQâÞäŠÙc§–—ÿÒÞ[-øísØË3†«(ä{„ñq®O:jÌ#íåšQ㸎{4²7ÉãêÆðÔ[^¤´iæ&´Ôv ‡ ÙŽ±ÜÅå§äÜD¸Ë~ÊÀ;bý(w|S³%‡ k{‚ ˆŸjø$½Z`8_³C”Î&C`¢Øªœ™eG±ª×¨Ðç.3 ±w.·£z†xÅ·WÁLj'’¨ ú„2A­º’«¶ fã8š2Þi³°J°ókЧ˜æÚÂu™Äí§ŒÔr}(@p)¨’ ÖyÓL˜×ôú€‘»á¤!«F8©eOüÁŸ™T7ø3›ð¸VöÕD§¹d“lî——|Tê‘­5nÄÌ'ã„úÏhžCˆ»%kÏVWŸñ‹rpÀ*Ï€!žÿ=sˆ¨F 3ÐÙ°ìw=¬e€è¥íh˜¦pÄÔÛ¨¹NÐGC”Ïs:ÔbÇÞÓay[PñiÎ œ”¦¿ÃºÃÓ¡‘/ÎË­ÜhŠmcµ-ž¢'h?d3v" ÷sOºÂOƒ¬m¿6³ûÊ÷k|™(H5á\¡zÅû5~.KcÊÏ^–ÛZ:‚Ûåh’Äz+}›?àó~’Y–›£ïˆSGicÓLQÕþf–õ*mm OÛåÖ:§–±UÕõ€9mÖç=I×¾‡-ÁB´eâÅž«ÍQ³è¹{kiS3õ4skZ ¬«r dõF_ÝiÕŽZË”öø9Æ»Ó'\‚™*œQÉ0–JéoC˜•÷£?Gô£"-ŒâU_Á|ª ÐçʽVLCØ´3®”,Ñ÷%¸€ðÖ)ƒ£ùôäˆ~ ØWÏVrÂ*ß<’"Ãð•›vG`ÝI‘+Ü‹k•Åv¤·->Ää´/<ÅÚ%ôrW&~Í­`lÃ"_ÑÚŒÍZ',þŠo”#iQ¼Iñ‘ý(æó‡y…/D‹7×Û‰‚¸~Ú,© à‡KX¯xŠ‹"ÁÛü5Ž¢¬ç®\dY´_ LêUœg[ÿ•éêÆÀß·qñF# s«i~w¢“±‰SNu(•ê¥nd(€è\#œ4‚¼\+/…u“Ôs¬ûGXß/ÕûÏ(¯¨ìÑ:‚ÄE]; @Ò`cœyY d3»)çæÄ?1e6>Ø@O.àfÆ&éU+nÑúO Äšã§ÒDóÝà\ð;¿Eö–¸»=6sh Jôq¨ŒÞrÖZ9Ýàæ$£g‡ó˜° ƪñB¤85]Kp?9Åó"«ÚÄ›r®Ê´Œ\ÌÌN¯&ÚìvqÖ Œ…¹ûÈË0ÓÊéšBuXPxT¨ïΰa·¥kÚòêÂíݾ­#¤°«ý÷h½3% aˆè’ÀD{fAXÅ—] ñë&vZ™¨¸nº¦‘‹r/E°θs80ÜŠFø§é°_®÷é ¯—k˜ºëõÍžYgT‰Pm‡‰¶ûHÛ¯Û½Ë5™Gr‡Î%[mcz~BØlO1¡w”p½ëj¡ÌØ%úF~̈3¦9†ômÍKgÚ_Ñ ê„ë/µ$uÜ:@Cª›Ð½Â™qå4[N-½'Á Ãl# VüjæŠõ](¢òÊ_`ª¦·r̬1ø0c&ç#‰µøÀtň§Ú.wùFädm˜¸—e'S$)æ¹"hÞˆá—ÃÄ‚ø#>ÓÖ&«§FÌ5ì¯m ª¶€Dçδ_JŒ–IìËæ;¿ª*3Û&L×A¢oTt±ät²4Ý€6­¨á5´‹z';71HŽ@ÙÇ–ÈØ[w•™R¸3VþÞ“’›¥;²ÖcVÊê2g÷‘l{0)Ø"í•Ís,YÚf‰|ÏÑÑNRÞU€7òäÇ™×ö¤NLªO øú~£1~ô*$+ujffœžuˆšthsŒSQŸ·ŽÚf×ÀÔZ3ŸåY$564>³+ª¯ÒÞ~ã'Õ¦àæuçöp  «ÑAØêBêøóä7zõÊ7/ÃÒ܆ð$$ª›ä™¹ÀÄß•jÞÀ`w‰¾:Ö«qT‡h&fk[ˆO|úÞêòšîÄn¯a ûXO›@¸¸õ6Zh—íŠmXF$âĹÆÆÕ “Ô3é£õ-OÛ‘c¦'/(§1Êê8ê€Û§< gK>0D6÷‹Ö{j1”ÁO«æqïð™r?1­VV#O¹ÊÆëdëé~Xà‰¦Ð\£ÆGнƒÝc×O2Ù4ln„nßzÚ·É‹mò¸ùüE†WˆE=¢S¤e›"z™ÇÅ(ƒhQÎ̘³È*¹f¦&N§On­,eÃŒ-„p䑇©ò/àG–òqЉ\ÀyyÉjLu•]´B>D_AG™ÕÉõ,î-9Œ€ÓáTsGß)g£68ÁÓÝïôÍHšŽ% WâÎæÃÌdŠå;&©=hVåÜ éqQ‰iâTŸ1yÅÔD( é:F𹇠¢á)ûŒÊLÕNŒ#´$IÔ"fnü«äq›«kÕœdL&t6²éSJæ…>•“é8¦¾ËnÉŽ{ì$Á6Qñ‰Ù‘·º–Úin*¨Õ¼7ŽZ Cˆ$‰¥Rš[XŠ_¥×ñ1]óèKËÛÑ“|W öØ„7¾*dG`ßs)´ŠƒúÄ<Ã\{uo[wãK÷&a?Ä‹Ws,ï×wl‡ ý7bxìendstream endobj 504 0 obj << /Filter /FlateDecode /Length 3943 >> stream xœµ[KsÜÆ¾ó/D‡-^„M¸0æ LUœ*)–JNl'¶xS´»"aí.($Íüút÷Ì3–”,§|éîéÇ×?-²”-2üÏý»ÞŸd‹Ë“O'ŒÞ.Ü?ëýâùùÉ7¿9¼IMfØâüÉݬPi!Í"Wyj„ZœïOÞ$?Vë%Çg-“«e–fJä,3I¹]®ð©`….’Ýr%„H³L$¯ÊpY‹« ìV1XaO¢½Ín–iÆ’ÞÐVedï;|ÏawòªnÑêã™ÿI'Ù5UÛUåÁJc”Ižß¿Ú“HSÀIx‘f’é¤+—ÿ9ÿèDg¡N„Ð)S¨™óÍIÂÕòüWXø ­¤d‹•­iëÞ$íºÜÁᘑ\%§‡ú°=%òL¤J¾8ÿáäüÏo’Ûmó¾nqaa²,yùì‡×/h”:͹^¬hCQ÷«íîù¯â_‘òÜÀ™ß~¸C+®²äý ÚäÉ¡Üo7î1ýÃB|’ 7•ÜUÝÕðû×]UZ÷ ôßÕþo–À±nve·õodÒÔwÃÒò°Öõîfðl5ÉWÖ۶ׄòzh·MU"Û·ûmwU‘Bf`/>œB|É)>_¨žó°ÄŠ0HIê˹®]Sƒ»sM<¿Dº~¯?ÙuÙÀînÛ´!ê&0ÁÕvxxDd’Óº— áµ}ð’‚rÚÓ3Ï%§ “èÅÀY†¾9¬ÈscÒ"ùé›g.n¸)˜à:•^m\±þüëʳîLÛ à]]¾Ý—]Sýv6Há½Â[íÛAw§WÛ²Û—×§gƒîÂH°¾Nç=ü"Ù\,µàxêe_>‚®>VH[rtH1qÝ¿,W¹¸Ìx±(”÷üõ¿Oñ Dj²JM¨Ôúý¯Ûu7è¤þ0¨s½+[ò%•¼©Þ^o›ýMG²=õ'ÌŠäzéÓ9GG-«ÀGƒÒnA‚Úz­=]äµ|µ¯7ÛAÂMé@–±T*ÕÀpf<~YbÃòÝöpiÃæ‘P%š«žh™o¶\i–c‰d_YéšÃš‚3K>×µßo›®:\ïê.rãÐÖƒ‚ßw6¨¹v4ÆÉ)äܦ?Yp#Š}ЭD± “f‰  „ôGœÜâ,¨ ˆlÜ:i[û>“€³Q/›¦ 9]Ú_u&¹,rù”mÓ Ì’6äUS¦6\$w·_é¤êÿæÉËê2Lí‘D¨³ç'?ŸØ’H-šã¥P¬Y_ £S ¼`>.–BIŽ9Ø‘ýRz2“©.tHïMR¶î8F&¥SøÅXKà´ŒçÉûРMëšF– Ê+ø 0OÆZ .H¨•6Œ›Ð›ªË+ËÀH™Ü.•FN`µÝÍ”—@9! B„ȶ¡pHuà±ÃGªÅ ‹äÞ8Þ¢H.’'ÝnºNcig}¨¿q,3ÉÇöb™¨3Eé᧺Û:‘u{{Ù Æùzæng³€TqEØ¥?}ž!ªë& øˆú°I&ï~ñU¹Ê Fu’BÌ¢k^HΗKA.){,r¼˜ˆ‰ïžZ(Ô.3ƒ‘@(MÐE Z‚[- éâûÞ‡À7êf?ä.ûê©'ázO|€”1ÂÁ&.éìÜ3NÎÈ4Ý:t²Ig¬\aâéÄîÄŠ.¬túnj¦²l#Ìg¡´ån爃žÇ­•ÝV¡ÃÊ#é—„tý`PòÑ3R­›*PëÜÄ9‡x*Äýˆý¾/'é|ÉþŸŸþÉlW,3F甬 Çd1_YªFé˜Õ$y=ß…ÖŠô¹îöó™ èñÈbÔ6<ÔâàIØÄ)Ò ¤O<ãDc±’ÚD~Äñ\]=<ŽôS£^`¢Zj3UµNäÔËq캪q®·,“2œ7ÅÊ¢¶m G毾4™ñr pÑ¥n¶¬ä‚¢(Åéâ3K9;•jˆ…“tÀ…çÕ¡lð86ÚØâ‡ Æ .ñžÙ1†Ï¯¡¾V}Š^…øNĥʨˆƒ¿ âlÅ샂BvRýK¼‡1Ê p´ÄA€SÌ!Ô<"#xÿ)tŠªÛºeЀ>gMÛV‚^rc¯?þN‡º‘‰v;E.{«nW(>{Ü+%¤!/> ¤ '³Ñ¨¼SDÿ8å¶ö’û ä¹uµÙÖKR–pvLìVÅ,NTEÈÙÎÞTHˆeÃ{mÔÍEÀOîàÂí0Cã ^ãàŸ8:±ãm±ÿTätc"Ã|MEbut`믛Ʊžõ^V'sr‰àhF?ºeëøåÒ Ôì-Œ7)ªª"B·þr5¦O1I“26GÐh}ïõ§hЕ±&"…ýr4‹Ý#]{‹å ñÀË"Jåa­à× gÜVìöéÆÿïFÿçÆýâ‡å7‡FtZì†Ü*¼>,½Ø¬Žæ ÁÈ¥_ó?v€*°áÊÕ‚i“jí>>ü>tƒý2àòåð&•,"Lh§Øx¡¯UÑ徿[Hõ2×±&¬Çê!ø¹·¡Í9ª[ã®·jæÄ”’Ä2þ°0¼Ô‹Êô8#΀ÄÑ( êIö±[ÀèâïxÆ‹¢ên>šK÷9Ä¿¥ì/Ù4²bQ<ð)¬­•ül4¸-c¹Op¯"œ¢Ëv¬¬4öï’®{éeîšNÅ1U²ÔFbÜÆ·£Ó)°‚”î#ª&M4ç‰/Z°–ã^‹¾`„i/—ªˆië„Tö4p(JÙp†Q83…÷ëîz< ^†öo½.r[ØcÙÚjš»]j©èã'a¿>˜´^ö6JGûÂ)Œ¸¦Žpè÷†aiÁÅ‚ €%hÀ)ÆŸÇ7´ÑG#_}[0GÏþ8Ôƒ„K®#ºÌì+PeØPE¢:Ô+ìÌ?ëôLäø&̶¼yªA¡¾6:_æôÝôw‡öªº>ÒÆšTHiü.ú\CÓÈa<ÞEi1B'£cèÑÍ*:™k?ŽŽË(2[KJAÜ÷'/ äÂN=†ï "øjFuD +øEýz„Ž<·—‹¸‚K/Sü¶‰. b­W€I¼.ÌÑÛ¢±ãó¸Ï>Ž ¢ÑfCIl,è"p#{ÕØ$©HøÉÍ mÅùtøÿ —«‹±¶ÛÙ|¬h¸_:Ù÷PÅ'LÛ¿UF—ªþk´»ÈœWÁä¨ Q‘> œhâeÓ…x`ÆPúsWMªù:q 4ySw¥³Íx«#Zµ~ ŸùnŃ>Ë:ƒ¹C;Õ_¼Ûq˜›tl:oûÏ.üæ züUÛðLÖãMéFÄx‰NKŸûG—\MX›ôß 9®~üæ¶j¢1ðÜDÇâþƒáîóW¼Ì?"jƒÄUL/ÒÓÏ'ÿkÙkendstream endobj 505 0 obj << /Filter /FlateDecode /Length 2895 >> stream xœíY{¬E÷Ôv+ü! $¥a¹Z:Çܳgç±3»¥½„KK{Á’öö¶ ÞÛÇé=ÛÛSÎ9{{Îéä6&Š­ò0JÛ@Š’TÁ´`Q#Q  hL£ˆZ| Fj|}3»³;{m@ýÃhšæî™ý3ßüæ÷}ßìVÛu°íÊÉßɺåÚSÖV «Q;ù3Y·‡Ç¬Ò¨/`Ä ÜÛc›¬XÛØ÷Ÿ¶ð„PÏ«[ãhYu²@äoÎÐæ‚ë¸Ø P9,å/ûÜGµB‘Rê¸.EK˦XKJ í P‚rºÍA©Ì£ë·)U/`>Œ·å8m´4j6 £Õ›õ+Ž®1Ý5«­vµÜˆgxÞf¼WÂVB|Çe˜£v¹°vì:ˆ w͘PÊìÉÈŒU,„½ÂØkñ˜µBê ×ñ‰o{œ6ÁÄs߯ÂuØÍÐ^c7Îê ›;$H>þÔáØ·!áDÆ–•¨žy¯À»RaX8”ØDÀ”\ï|˜5—»?·¿üÉC‹gÿh¿âw·:¸pã®§ž>õèþ_f}âÂ=ï¹õî3Wnz0úõÇ_¼ÿcO¼{Yû‚ƒ§NýâãÏ}÷õ×î>ýûçÞwæ¹ n›s%{ôÕ#ÑÏ<}àöWVÏYUãÕBôãÑŸ<2R=þ©“óÏ_ì;hõCgÖ}ñЇG7nþÌ=—½Z9P8ó‘Ã|`çm:ì=o]ü…‹ÐÒ§×Ͻ<Ú_zœ\Öª íºãÓß¿kï3ûö~ïÎ÷^¾÷†÷»þÂcË.>6ò¾Esg®›g­ûά«f ”þ>úØ3Öâ{…D*±§Z ß#³w~®ƒÿ[qK¬N((¸`–B¥Z+-âîš ÕÓáÂcv­”ç9®ŸŽä¤|#¦P<`Êpi0CH䤈óM©d$'Å`ŒšõHNJΔšs×#9)9ÕÜ´âSFG&2cÕÿ û6s1ã ßw(“‘åNŸsWq×&®äÐ &î!Ò=D»‡X÷×=Ä»‡„Á30&Ï`pÇÇ&ÏÈ%ö¢t:ߦZ&ô$RÈÿ”§&Ž£Ñ0jä* Á¨Û)Â? 2HQ„äÿtú?O§PèI§PP&-ÖÓ“"º¥<Œ0š£ÓTJÓi*”Ñ©–ÉèT ™tšJ¥tšJtšJ¥tšJtšJ¥tšJtšJi:M…2:íŒL&ôöéÔs™ã ñ_G§”zA *“NaÉŠN;ßö¥ÓÞ¡Ê—³i‰É ÄwM˜W—ø×V§Ì*¹&Å<”Ïd~¡Èv&hY¹Ý¬îLÞa‚Z¹v bÖç £ŒŸÒ E›’œaÔ6µSåì´ÚåF®~7Ú†0éEu˜ˆ>(ž!ŒC;±ÉÐ…$· ¾èë» íCÚ‹˜)·ËNÒ&™¨²À9“Åv´§Tîü8*=Hj2LQö¸ (Ÿe4)j…Íj¹N ÊDA™ÆÔñ ^ö؇­±uXˆ]CšÌµ(ØáÒs¢mÜN¶-—«`kg“µr«¥^¡ àxýtجok—ÛÕ¨1oP«øhC ">¯×l&£F»\m´2“† m€ í¡Ì|-=uŠ6ɰÇ*>ÂÅzT ³VÊIó…±Ã‘vÚ3â«BÛʤkac 6.ý0q;¨‡íÍQœÞ‹©MµI Ò(a!iÅ€P:ày8¨ÓqÄ8î¸I¨«ß2 -Y›ì‹B=âQG¸¼ÛÕµ€KXjW0Nó¡U ¤–+Pš›dAa•zr×ÔÎK Ü£§ÔIÌx·c«ò®Äïæ''gºp²RÔø˜ Ûëaias‚Õ+@wÀ݉+Cyå;’^¸¦u]šÂt%™ãºZ-Š™ø`G'Œ•¥íˆ¹`§­@’kå´:XÙäúÙë[Û]jb¿ÕÖE"•w»É]rÇiɼƒZñý1MXU©“˜Uåì!gô›ÇÛJ]±àêíjɲ†íÁó D Aõ-V)Ô©ª¦é*S7‡åÊ„¹ÿÑD!- eÚJÊÔ.yÐñÀK ËzTZÇk E Wn%§Y݈]¨Á°µŽ¯|DüLØ#ZFù躙ÅÙ³ÒϘÏ®òÄ”|ö(2¿2ŸÆæÂÌïYó L"—"ã2±PLâò·ÚÊóEí£úeÚ%4ËvR×yÆv¢Y÷±ÂTÑvNyv¯äŸ%f(‰erR]˜|†Ê5Ï&Y>Åò:„¢ø«¬Ôh93ÁÞZÃ&gí1Õ°UwÊ8˜«N-Ø¥Ç]òZרZîF4£3ÚQ5WÓ·ðTþŸ®ÖËS¡"Äîp¤ÚŒ„'zŸ{XÌ9z„˜ü¸TTírº®¸z‹ êW´C³ ÕŒCŸôhãÿù™yé-l„@0W šü šø0 Fröd~V9§“·0´JR¸yé-ª êóJªº5 <´0ˆ¿© $„ÖÑFŸÃj4˜QÙY<„ŠDÃÊ@Êš½KísMÁ—AŒ~y8Ë3ú¤©ÊÃZ+J~4/Õ§ \•›ÚãÝ’ŒW•4QAWÉI/„):w„`´õ”D÷µ‹2)kW2‰„-0•ìÙ¸6;- Ù~`Ób-jµJõ®ÒïÁ¹éÑü„Ü—‹tC˜}¥V“tý·^FQ™U’þM´Â&?Wý„ú Q!­å“©ÉÉÕäéfüY8MÏøŒ)T²ÛØÔ ÌRêÂì­©6˜Ý²@@XóÖ?‹Ÿ÷_endstream endobj 506 0 obj << /BitsPerComponent 8 /ColorSpace /DeviceRGB /Filter /DCTDecode /Height 150 /Subtype /Image /Width 150 /Length 8394 >> stream ÿØÿîAdobedÿÛC    %,'..+'+*17F;14B4*+=S>BHJNON/;V\UL[FMNKÿÛC $$K2+2KKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKÿÀ––"ÿÄ ÿĵ}!1AQa"q2‘¡#B±ÁRÑð$3br‚ %&'()*456789:CDEFGHIJSTUVWXYZcdefghijstuvwxyzƒ„…†‡ˆ‰Š’“”•–—˜™š¢£¤¥¦§¨©ª²³´µ¶·¸¹ºÂÃÄÅÆÇÈÉÊÒÓÔÕÖרÙÚáâãäåæçèéêñòóôõö÷øùúÿÄ ÿĵw!1AQaq"2B‘¡±Á #3RðbrÑ $4á%ñ&'()*56789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz‚ƒ„…†‡ˆ‰Š’“”•–—˜™š¢£¤¥¦§¨©ª²³´µ¶·¸¹ºÂÃÄÅÆÇÈÉÊÒÓÔÕÖרÙÚâãäåæçèéêòóôõö÷øùúÿÚ ?§usw§ß¼P¼‘[ÆøtQþÿžÒ@׃“!ù$$’Iû• ²dòù$α÷?ÂH#ò¨­­åŠmÍåy~[•×åùpyôÿÐ}€ãÖÑ£›f]kVO–rU²yíqßûÄŸ­-¹’YÖÜȪ‡iè ” ùîoÌÕs Ä&U0@ÿ–`z{~\ô榊2²#|¹ þBèJ;¬ŽÈKÕÁ穌±=¼úÓZ9VèF¼¶›Ê+Î6îeÇ^˜P? ŒC.d!Støëøõî9éÍ)†_µï!6ù™€s“Û©ÿw¯lqŠ0'¶·ym¼÷Fi)$ÜsÀ)¯lŸÎ›<æHy”c=w(ëØŒŠŽ¥H\aH+&0¡¸!ˆuúçŽçšC »Ø°L”ô Ô§¾Gn§¥×p&¶ó'»†Ò\´R¢ÊѶpĦIüê³} DŸë2Y<ö GV?X‚&£›ƒlÇÜêÞÇ=sTšÚcj‰¶-Á˜òËŽƒüûuïËV¸2ìÖï³LˆÊéÈœ†,A=zàJÉ$ztWH™ãr_œ–Þwôb?€Á0€+„ FùB½ž½¾½*O)þÃN#qÔ÷ûÝ×>ÝN)|ú,Ö¬šm´ë ¦c½Æw7úúùRÚÚ±yÑoóüÏ7p?>ß»ž{Uya´èb7+2€/âÆð'×µ>Þ)Wì*~ì¿D ×Óæü3jZÛp,XÙ ¹$Iá*$n¡À,¹c×¹TV‹$løQʧÝÌè tãëß¶h©—5ôe+£ñåœòKÄ;žÌ7~|Ô`܃åÆÑÈxÏaè?úÞ¼f¬%–]ð**1Ê–„Ì@ÿx)ÝõɦÇ«|È€í#!qÉ^6ú‘þ÷Nsƒw$§÷6ü«·or08þ]½ºŸ—^ëCW?çúáÆWÈ@Ä ÿ]Ÿá ?ñà~£åç@ˆa*î£ÊÀÚTŒùˆÆ~N ۷帶*Æ7L0exeÉ?L&ùǧ¤<8ʯ\d‘×}sì>oSœUè(e4_&Ì|·30~cŽàñž:`c…UXD6‡.y“´ò0qÁÆ~lŒõÉÆAÌ;žQUBýÒýÕíçÇãIj@GÊ'(ünP» øüÕˆ‚M÷( g!B7’Aãøˆ\ñÛ=³ŽsI°Èª°ÆªèÉŸÞŒ@ÙÆyÀõç_ Û?1þ>1Èùr)ãýc|«÷q»+žž˜Ýøgw㚟 nˆ@÷˜ä)SÆ9ùˆã°ùp3´©@dÞ#]·NNÜ“÷±ÁÁ6}óÎIp±[yÕs?ˆãúzçŠHxü©Ôó‘ê=\ò?‹"­®ÅB2meâM ±—Ž89\sÀÁÇB¾vFK™7ðx^Ç¿Sü]2Ý(¸XL³°Â‚eÎr¤ýÓØ Çð8ô㊨p \Ç^…ãÇl~\úñŠ¿+#¨ò À|‡p\$À Ïðä`qÒ¡h˜ Qy’1Æ1üfá»9?.F?‡uÀëK·6é *°nw.rÜÇñýìd Ü,Saû¬íS’~Rxëê~CÿÖ”ÿ6‚IÆqôÛŒÿÀ1Žù«lch#‰arŸ3¿‚u^ÝT~¼‘˜ãy±«ÝæmŸg^˜é³ÿϽ Ì¿.?³ÀþæçÁíE[‰¡„“4d†.Û |Ü’3ÏnvôÀéE.`°¶7>TÑù!Ž2z’ ?WŠÒæ;…óv¢ü¨-€;tÉç×¾iÖÍ(‘Gtè ¬¨FO@T04¦ànKœmç|óŽÝsÓÐã¨ÖìcBJØC†²NÁønðÀéÅ]xd†¥G³÷«ò€Tdò?Ý8çŽ1Œ QË §îäãè>ùÈídõâ­©fHƒ¬pÜ»¹ã#ŒŽwz᳌œ9 Xµ›‰fÈÁOÊà ò1ÇéÇ@8w•+þð*P% õÚFF÷¸<õéÉìEó΢L*È3Éžã7\ûƒëÚ7ãw—»‚6ªö$s®@3Î:P‹Å%œI-¡F}£Êù%TõþtY[OqæÆ¢!$(Å÷WHÀ ã§8Å4eQ0hÔw\éœ/@p3ïéInβ¬Ìûp¶²ðq¼Ï¶qS­‡ÔkÅ"ÈFØþc´cÔ‡>Ûˆü2:qOX&;å?,GæcvÜ××®sžýê&-½¸~9îqž=ó€O÷°zñṄC>ðl&=qýßlãsÀ§¨ É$RÉ7ïòÆÞ[…ãÓƒž0xàã‚å‘þP˜l0ïï|õõïž”€¶ç,6[‡Á|ö랸=F\ðF[yÀld·Ž1Œv'îúFhÓA,vR\2ÆbŽmŒÙƒƒÁûŽ?*¬lîZ ˜€È¸c”Á$ q×å?§^1.æÂDŒÉ’ÒÆßâ^9êIÎyöª¥¥)òîw“‚üØíž:uǡϩ¤® |QÍ#Ç{6Îy]ÓÁíŽÞ¼ã½O16ácóP2·M¹*XqÓ·\q] ‡O @lç¦G;±ßÓó©Q›Ëó66PHlž¤ã$tt9¦îx‘÷Û&Ï>_<¦3ŽA×°²+AŸ1Aû9ýî÷ï6ã÷Æ3ïHû„ W&RNå\ G?ÄÝÇÔw “å‡!sþh ·Ó~q»=³ŒvÍ7ÙQL«Ã±U¶ÞWçqžžžÔR‚¬¹‘‘x3¨`x0GS×P­ÔDÐéóß:Ü@ʉ)ܡ؂9=v€?*Ž)"—œWnCwq…íž çéÚ…ž+KÚ‹†FÃH³cqÉç>´Ë'Î*§aãÎÏ ¹#ñ-~CÐvTà`Uvõ^¤ycø¼¤ý=êq ÀáùŒ‚Täƒ {s°ãê3žj¹¶P—Œü§¼¡~ã øg­OÙ Bˆ±º®|Âù} O—pÿ¾yÆh~@2)£³˜\M²òð¥IÊðO+ê§ô¦° Â`¬í$gkrÝë…>Ôë[?´]ŠháFòá¾RöÈö¦4 $Ucv”ÆÍk øÏ|ƒŽƒipÔr¯öF'¸ábQV2 S€{Œcç+w»S?+Û+ œ¸1è;ÑoÝÉäÛ”µuË Á(Æ Çlÿúê0#²‰£Y¡™\",¸òqÁäu9ç¦=(üÃoAHÚ̬ŒK,r:åŸáé¹ú{Ó„EœÝ;÷ç‘’¿{:ào™䫗lƸPäyƒT°x‚¹÷Í/–«>ͨҳy~gš89#~>«œtçÚ€»m÷[º±î Œn~û¹ÇÊsߥ"9ŽÅe,KŒ‘ÒL*ô^ǯéDp åFHÔ‡Æd€+œ÷ÈúcÞ“ÉXY˜”†u8rW_âÆ=»Q ˆÚÚ3{'úˆ[Ëe ó ´‘‘Œgך®lœÂ"Pî?7nðú©üǽMYH¶UX¥‰þfBer‚@ãõª¬!.bCbóú‚Nsßpðz2P¢@°FŒ$lB Àî'…Î0jUBñ 5âhÕ‘‰n ?8힊G×Û5ÙÒÄ™Ñ>Á 䀹ϨÎ}ê@Š–©9Ñ21‰Ê3´ŒõäÙöô¡ù×),"ÅQ„°\’»On>\ÿëJ&KMžb9û|Í¥yßÓÏð¦Él«gÌñ´2“¶0,õÎìäô?:;o;ìâ9c‡ÎÝåüàù[zõ<çߥ¢‹¨ìùÒG|ƒaS‚€ÎG¯OÖŠXmä²Ã:[• Å‹+n 2' cÞŠ^çP÷º nªò¡y" OGHÙºž¥ŽïÏš† ùê ‘‘°tHÇP3Ðþ}~3RF× :ˆ–á£Ýò˜CÆOM¤ }2qçþnݽsœqß×§¾1Ž)÷›Ûoþü¿ÉôÇåÁ«C„Œ†RHn(p>làã'Ûžsî>oQœT°.nšñ,{<ÜÝŽzäg®{ç>ôÂÈ9YrÓgÏû=qÛàt§ÔWiVIc|ëÀÎÜ.séœîÏ^q»¯|ÐCå¾`8wuÎÓŸÇv3þÖ;óIûÔœ€XÛ“Ž>è_SÛn? cŒ` Ü[fÔ6@Ü\\0;Ž3Ž(Œ³1 Ã'æÁÆqëÜwö¹‘†ü9þþxÚ9çw\wëƒÖ J°a¹±³Ó½;gîûôÁ¤2Eùa,¬¥„˜ FÓИ`1éÇ5U³ä%ŒõÙëNœôÏUÈ÷2—p„°ÜdÏ–ÞCdã9ëN{檓sä¯2y™9À=;wúãß>äˆ+3 Ø“‚1ž¸lç¿'ø²q÷… 4‘L$ŠI7íÛˆÎóÓåãsžF8ç„ î \îxùðwή@Ê烎NxX¡y' ÷†ÎަAë÷@ÎyûÝú÷…p`7mÀl1Œr?Øê:´À“oÙÕ^Ùó!$)üÆÆ¨ã=óÖ’Þ5‘Y&ueDs’P£s´wsŽÃôi‚¦YÈ$áÛÏ}Õ:þn…IfpdWY|²x=X¿¯n)tŒf &à€ü`  ÚO>œöÅ< óËøÜ“Ýx\}ìçŒõÈϦٙ˜Æ3ËggÓƒß=ÏÍÐS€!ØØ#f<ÌO»Œ‘ÇÝëÛ¨¦@0—Dvò²Ã‡Üª§¯?ÝàdãŽ89áÑ®÷&G, $‡| ¶}:ŽÀ“ÏJ˹$‚Y'qÀçïŒóÁè?MDh’NÜ‘ÃmÆ0{Žàêxè bÀUŽ,e|å“jlp_hR Á#ò29öªÆ(ü¦DÀ9Î:ž¼ãžÈì1×ü7©Iå,}Ç­U!¼7É»=~Ð8ç®9ëÓ·'¸¤†Ç"“±FhÏÊw¾®sÉôÏ|{c½J€2ٔ‚“ ÙŒdỌÎ88ò"TxÂ;ùpĆÚzÿxŒþ×CÒ¥@V0ä·Ì¬r é÷ú½{—©Ø6æ‹ÉiÊRJØ^¿Âý~€qšvçBžS·îóåì;³ž»zn÷ézkDâùÁr~a•cõ“oÃúS¼¦}÷“÷“8õÀýç¶>ïz]òD3I¹ŽÊÎs‚01ÓׯP"2Œ`1^~tiq;ÇNOFê(£@$û=Äòù–PÇ4LsÍ1ažäóI †ÚxÚ˜É'ORF}rsU÷F/>ã“¿’$ :žÅIEjÐ…ØŽË'—¿OÿW|÷,ìEóäàa¦$)Îvõ*ãà ÇLT‰R¯*탡CeqæG<Øì01ÐU ÄÓ÷Ž;ycú`}yéÅYˆ©x‚‚Á‚NF>^ÜNüãŒda4¶ímê×2OE6îBî‘sÔ7·Ú£o(0`e1£—bB’#<†õÉœõÈçµEdckѰm§,¥†08À#Ÿ|ÿ>"sž=ÊKùì7qÎ==ºSÖ‹j.ÄÙüËòðÁÈWˆ*±n ^qŽ~¹¦ˆÌ¨«j­$±†ó„ª‡`< ð3ÓÛ5 ‰ŒËˆ”¡ç–ùÇðö>ÿÆ£ ¶ˆìcY0m#®rH9ü1øÑ`¹cljX1”16à¶Òúo }8éšvÅgó9„6òÄ.Dy'vzçõÉ=êžè·J9¹÷Yþ™õçâœLl?+y›ñœñÔóéœûõ%Ø.ZQhc˜Ê³a—bí ¼´8Á!¸èp3Ú‚±¹"##üÌFð¤Ü!ú“ÁõÍV„ÇåHT6Éy=<ð=9Æ¡Ï {ßîß.{dàg®zñNùéJÁrÚ)·"iÁK!d‘UC£íÁŽBçŽ:}*&…ü±„bÀ’FØø {rCÀg ¢O11a‚H ~ïû¼Ç|\•žÍn¶‰û·ò·6ñp=º/pxi6Å{l#d JòU•/œGLc?p `XP9¹T`ñ°] “é÷C8È󊥘„ …lykÐãw©Ï~øü*Udûgklò¤ã#8Ü;ô?—·S¬;–Bmã‰cr„™#;J¨ötrGOZDkx¼¡póGånóöàlÏÝÆ:g¾ßƪÍåfÂX'å‚:õn‡ðŸnc?cÚ1û27mõÎÝøcô[@¹f'´‡-w,Ñ!T¡ÚK‡ièONqÅ¡VgÙòð™Ü¥¿„c¡ãóíŠ*ZWÔh[i ‚DIšuo˜JŒXž¤qŸ¥Cnb!”DAÈV3×П`jtk8æQs /0?;4®œžÊü2²ùŠR8GÊzJÄà›¨î3ùñ“Š®ûˆƒË#i1ðö=0 ÇáƒôÀëÍ\Y"DÚ\ÈPC`ão'ŒŒzdg¡¨Š.vco¼6‚ņ̃=r*dòNÅfüÊäœlëÆÛß°ÝŒœ ÜV(šKåDìû3û¿•¶õž1ÈÀëÓÞ®$NKmØÁÇmÙàž=êże¦QlU%Ù÷‘ÕŽÜp0Ä co=xï†:&ðÌÞBŸ3‘'sŽ™Î8ØÏá‘×à™òª£9Ü[Ǧìƒí}iû"%ʈÀÀ,<ÏáÚp{lÈõÇ'œ v!ó0R3>pÌ;ƒóÎ:g98Î=ñƒNàD©“#¢f2Y²¹ÚGsÏ8äd}1ÞˆÔG!gM¼KÔ`·ãϨT¡ƒ‚HbT8ÆÜ|Ã'œ—[¼ab^Il•POŽ»søƒíV¨ˆ9DQ°J„tàuÆHüqÛ4Œ(21 N g‘Î3žzûcšbH™c6…joùUz‘ócvÓ’8Ç÷rCnÿ×õ¨¶!xÈ· ÑþéÉØNvsÀê;õ÷§lgòü´b\Ÿ/ËÎ:íÏO|þ+F¢Þ6}†Ô“å¡qµO±1ïÔåBG“Ùö®wy\¿ÞÆâ3žû±ŽÙ¢ã±ä‚9ƒ’"Â'wltýh©bØjB0ÁbŒ­•ÇÊâ:˜ä÷Á¢•ýìå²Gn-Ziùä >c“Ï$Ò †[6¹([jœü ïq‘øóбemöƒ¿aûFþ|ß?fþO;{TQA¶eÿB1üª?×g¨ŽqíŸjZ]hþ\ääey=:‘ÿ|aÆ®‰¢‰aŒÇ6ïÏðŸ¸?à$¡ÿ€÷ïS?ì@Æ3Ó?.?löÆ{Õ³— Ry&/õ‹æïÏÝþ³·9ï³Þ›U<»m_ÉŸnwœ‘·°ãÐm…¢†Re'j¶Ocæo¡8?‡JU“Èu“&ß ¯›ÃôÈÛlc=öûÐÃ$¸;G™ænû¹ó1ß8ÎÞØÇz`<´rÆ‚ÁL†Év9Êí^8Ï|KI-ÕY¦‰¥…‘¼•Ï1àÙÎ:Ÿ¯JtÃ쑤žY²Ëówy™ùTã® -#óŒˆ-ÌÞR7î¼ÍžVA=‹=}©t¤.Ñol)P9až«ÔÁ2¿ãN˜Êѱ¸Û€ùà>>÷ç“Ó¿N´Ž6»(Œ¸ÝØùvûc;3ß9íOTÜSì'™çoéÆwíüs|v¦7FÏ!„‹q% ?t}õüFÑéÅ´bCæ!7=X¼ÿÀ‡áNo’G‹aæ)ånÎsü9ÿkÏm¾ôCó¿ú²ùÃ}ìgqwü¦?‡­NlË E.L¹IIáFÓÜð¼tªžm—ÂÆ"p¼ô9äõî ­:yV8‡ÉÙ.ß´oݳŒmﻟƠh3_±g;<ﻜŒçßöÛïIXÈšcf ñu)“’™áyôlšž6„&挛RŒR,ò«Œø¶^ß…DŸ;$b2ä°O/v3ŽvgÛ;³ïŠ–5Ïî<œíV_³ïÆÜ‚ÛwwÎ7g¶Üw¦À®ÍD^BM‘'Ê‹$ΗQ׿§I2oÙÿw¼Ÿ³äÿ«ÇÞÏ^¿áAù‡‘´¿—“ölãË÷Ý߯ëíLwû7¬ ÿ{ìùÿз~”÷Äæ:ÿ¢?’Àüä“Ê6Žè8ÿ)_³ c)µÜÅwc~í¸Çm½3ß­$úÑrÆÍîÖ)’XÑdä+À²2z±äýj$µ1Ì£ÌS¯ú¥{~Yçבފ+gÌÑvЃ!¸;¸{å¶zzŒû— «o“oĆÊ»B…? $üÝyÚp?‡#VrQQ¥[]²•gÆ[aã#98ùzvÈ©H ­!ÎÄpr$qÁãïu={QE>—%ؤÒ~ð3•Û•;‡'éøÒÙÅö™'‰X)âè6TžázvëE?bãûV"`L¬Jp ³8Ç=sŽÀmèiê™§åXüÝ¥A8Æìnëž~÷\ä÷¢Šl¾"™¡l³oò÷.e²3·ÓÇ|Œô¢æ°ÇÊX+|À67üSüCƒEú\:“É“a%Ó°dŠ]…B±#+ã;ã·N•¶,»7¯Ë†Ï”½É1þÏ^ùµT&ì; LI$pŒ‚Ïå‚À0 Ù#oÆ¥Ž0Ò`pÈ –* œ©l…è:ŽäƒÔQESÓî"ÜWµùƒCÉrASÈ&0½{ZI-¼ÂÁ›ìÄnÚÛ7n錓¯8ëÞŠ*’ÖÂè2æá4ø•DvdË ®äu°íÐQE¬!FìÎRiÙÿÙendstream endobj 507 0 obj << /Filter /FlateDecode /Length 8000 >> stream xœí\TTG÷±PD‰@ÝhÔ]…e_Ï`CÄŠ"ED°,E\VvWÁ‚%6ì$š¨Q ö°û%KìŠ(¶¨±£¨±WŒÿ™yïí¾·»øåK¾œó?çÿ?9Þ›wçÎÌ[~÷ÎlÒ5¦ÐÀÿ„¿ñ©.E’Kº †ZŸøTE`„‹Ë€5§á0Eľ ¦ÀXJÍ’œ‚¡5GPŠˆT—eˆ.^…ÃwšTUiÔŠ`0 §Ô&ªüà‹±4«LQù¡ÖheW­”Ì©8ЛÂ(8WÊú|agR­Á”=F ®G² ÝÛqÐ[ÙUoH“0Õ ó?ÑÊNÒá :£I§MãgÃQœ2p„ä+¿’cÁJpV­!1ZiÒªDt2¡5R™­Æ((™ˆ%ƨ"’]:G¸ô"ešÅYE㜚d8†SjŽU`ŒF£f8…!Q¥Hû¨ü £ Õ8Çárùjc Ž«q‡òW†iÓô©–ÑÁ¨jš£ó\ÁÈ`’8¦¤!´†ëcàîvsñïîÖ%ÐÅ?J¹øwÔÿÀÐN ÖÅ?Ø?8ÅÅ?(4 À?Ô˜ ‹7é Œ}ô)#RÓŒ°xÔŒ ¢];—nAŠÌ%Õ÷ÅôøÖ¡ÊíÕjE퉎zØâË}NÉ¡¡Õ‚lá¹íÜŠ‹B»Nœ÷ÛðF}»NßHíHè¶,qmYØY|)ý,ôÛÄä䬕ï¿únZî]=vv[üØâ#£;1Þ³=z†ü«bÜûÚÆ™³Ú§|9¦d¸isÇ&Dµ94ðCµ—¯\–8.Kwë}£qdº¦Ý¤¨¼C«Ïº/:c 76[3P‘}ãZƒ¶ÅœcËk¥Ù÷˜lïqó_§µxQRtqU‡ÑÇ‚ƒ·älÛµÓä3ÏønçËÆaN“•»(;Ç-ˆwnuÄøèLôc>¯Þ4­³ßöÅü_’g'?¬ÛgCئ€PåŒØ×¾:Ò—í±0»¥žåüÜçÜqžj|=)*³":öª«Ï#’¾Ës9ÖËãÙHŸ’¾³^œøÐ0¤OßqAýè©Ñ±nO"›í1x0¶Ê¶“§ KYphfØÃŽØ³…鹋{ç¨Û)—Öjås¸åƒçs6kt±žòý°á G¾©½o­»ìQ}à §½ê¯ùÝ3³T›UõÀÉ—ÎÝ} ¢âŠ$£ P~ g(EPŸîà_2P¸..Öš€´#ÍšbHt wÁYœV3 â05A+RÍ-Œ†ƒ$¥"ŠRkXs‹Œ >ƒÅ¥TB‹ŒŠÄI5ÎH©„&þJ¨„ôRÀX$TB‹ŒŠÃM‘R*¡EJ%,ÛB$‘Cå&Ì*H5ƒ“¤Ô„q–U$”£& ™°Í|{AR r(~¸6̶M#m"x_dKe‡!qQj†”¹ à5]¹Ç ‘Ç þAÚzŒÄÈa)9‰žÎ—Ÿ¿\ºñaiꉡ–zûÆž~"¡GЭ\—;„Ý«Îw¯G¹÷ÌÞçþI7§äYŸ;}ÞËs×á [? þe†wÁ–MÛ¿_? C·ãÅÕqÏ—ßF¾ÜŸ?þêYËž-¹;ê¤êI—òOf=¸sÂÁ¸ºs—]™ôÝîKE ;×ûº—ãX&©±ó®UÙy뙃^#PGÝ}Üâ‘ëÏ-ˆ×{ùyxQÑ’ÕCØzY×>䯉¹AÕ¾óôãUÉ›þôyßõNë·^û%÷è®ôMA=MY㺟+<—±Ú{æK¯i!sWí ×—¦?><;kLý÷Wñ£×Ý'ÿqØùÄœ¨UnïãFÔ½nšµ/|`À·3úhp­,C_[²ÇýRZF-·S÷û5nãùÙ¸=É­’B2zM/`¦þxäíí£äÜiµ*&îlu}öÎÓg.|{tÕ‰÷þ8nÚ½kHtQƒÁ9U‹Ú± ™Ñž·Î÷mÖÓÖ+ëb÷\•½øÝÜyúŸ×=¥Uó'åsêܪù²eÌæ»‘ÓÞ׺TôóÿcÓBüU1oï¸ï~ÿ}üKC¶Î¹üà üÆ­Kc¢n*_z;ÐØ³xͰª#Ûä¦'EuPÕOŸÿbQëüZsÆ„ŒÏ3†·fû¼ia;°ö{6eŸÎØ}|×ÒômëOÜ—-ºzMÂÄÀì*Ë|†eé{tÛ~ò¢ë¿†õõ¼²»üø­å!þź½‡Ú õ¬ØuõÑ…{|ôýõí=^\ÉÊ}Ú¾ó§5’;F,?ܲ֠¬¨³;½òoìwh4îGvàŽé·Œ[{±_]ØÒ¯Ú²%£{×»Õ¡oäœ*±jï%ñ=šÈÝÑ.6óùòòŠæÎ Óº5í[mÕòŽÔøå>>_Ÿó4™ö„f®š³mô¤Øà¥-Oöo—õÓÑ!Ÿ‘ž‘óTµÙšCT'j u¨îÐfvk×ç‰ó\ë÷ÚxÑ–T§””39³ú44lÁ~xø°¨æÆ¦¹Uó&Õÿb2RôûÚ&Ýiªšïv®`Dc¿àæuO,Žê_älèêá—×9¬ôù罿î±äÍÖ¤MY÷#¯jªRÅf<¾2»UãÉUß®õëZ8÷óùµÏN/x£{Åöª_o«öaòÄ 9~m†yygÆo?þhtÛœ>Ùã‹îöNXUOÿmŒÏ &¿ktwBÐ>ºNÜkEä¿"Šg:G•—næv ˜¬Þ°y1ævpði-wúÈó3­¸F.7O8ú4à«Å½n,ν]tìÊ@2 Ñ`Gÿ“Ƕ‘Ë>$Æ5:31;õòªÝ’"GÍðz¸Ó†ÐÈyn£™{+pë?:oŽ1 °_§ÑËË?hj)Z½åV–Ÿý¡Æþø².ãÍ»öêvè¬Çƒ›å»TIov¤t³coì{ÅØ›m¨É>Å?ÿ–³ðÊ´í âûtmÚϵbÎ@S̪ÖÕÆ ÷î7©ÉìD];¶æ‰+ë.îo›åSàØ™kÛèbt•Rlî¢M½f¿öýçnWÝ6'håú¾¡½§fÕàXøäâý Ž'¢1`ÙN¹¾¥·k]C#žÇ¹µümn æ^#~¾ÓÁ;ïáõyeÕñ »'f_?ºò ® >á`ä)£é@wãʱùDæëïÖ=ü¼dnîÉ’C±NU¼œR†\ˆÜ9 Cñý›MNýº7¤ÓjÅÞ™U½†,˜ß û†ÃUÓ• &UåÚÙ£ßÝH¿êï—G¸çgŒì[hšõ™áúèþ‹g\Ÿžt|péeÀ**•G’Ÿö徉5œ7µ<ä1Úäé°H7ùu¼‡Ãà[§‹»úþ›÷_z)ßè[píÒsmçn/ëÔj8´Sï‚ßžªýìûOGVLJwè˜Ôk ýû‰|¦ 7/5,¦Íæm×îÕX|¦Þ´{¾CÁÍÙXäÖîþE¦’m<аŠ|¡äHâÏGý`„ÄLMS¤‚b@ÐgiÇkSÔ=Ó’LCaÌÂÕ£!@R£&8‚DÑŒ'ŠÒ%ð4 y`1kÌT(æÅ(CU@?8Î)M¦Þ[qµOÏó‡ä(pB¬Oh@ýXŸàò  )ÖQ†%ê *M S&$‚0k™}äO‚l ,èÿ‘ÿÿyäo­ v‘?H}9)„O5·H¯-¥Á œ•!3•ù›©$ÈßLeFþf* ò7S™‘¿™J‚üÍTfäo¦’ 3•ù›©$ÈßjÙ¢¿Œü) ©¦æ?ò'pŠôCÿÈWý¯\»{í<ýSèÿä8„þy•Bÿ¦3jª1fAñÖ‡6®X–|¾í¥Ô¬ö¶_ÝóÁur~7£ñdÛW¿úúmjù´â¿{^Ѳ>×ÓÓݫלj3 fë×68Õ ëAÙ^u^m{¯tý›ÜSá ¯þ1ôj^Ö#¢A¾o˜ñVνò‹2¿¼Ïfzš~èÙ¿þý¥ví|¯•úèj¾Ùwõ¦ß¹®?íšÝ¸ì“µ‘]KÒ²F=í_ì>`O£zíÑÔ] ¶•TTpçú–1_Ýw=)ñ}à²tÅõ:qs‡$§oûdÁ½ç£Öö­Wø…ãÈçÆTü²bê[]Iè¯ÌÌìäÛq›óÚß2…wZ¸ÙõndÇÞ^{ÛÞsÓïy‹ ‡,Zsj‹÷_®S+wst£õqE}¨\c㽪Î{{7ø—ü5ÊW[ß|SuetÿÓÉ˨ˡý·ÕݘP?"”Ž?¶ÈÕgÁÔÆý7º\\ÚñòI ãë0ç6NÝs}ž-ïðÝLríÀrâ)N=)üì¡[å7Òb÷a cð\ºÌTÿì9EÈŠsAWn:þùúð9»÷¯;½èÔsfëþY³ïÝPœý¬ýÄ€:Ó¶»­ö^êåR§ù´Æów»WŸêK¼õñò¸§öõÛw7V}¢ºÜwyìÉâ~xNáÅÓµúÝhpOqFq ë¹_mh¢›»qÿ¤—NNÇý^..¾95o«³ÿ¦Ÿ³uç•/·ŒüöhAÙì¶ñÇÛžœT«Ãoeªò«ÁkÝÏ*údV;Sövß?÷žëÂ\3¦ª®ÛEù§ªí]Y1ñì¯ÑGÖUÉŒutá ¾GÝÒußz±ãU+7yêÌΗ¿&›v{wš*¯R-œ[ûäáëO¶t©ócʺT{à³§ìâO+«Õuoè6ügï­›»Ý3ä±¶Éãú?´éÐ옦_æþh®^QãÇ#wñüjjYÛ¬ èu¿5OOí׫Õõp¢]þ>Ÿö½ƒÝÒÏx—8Å7<üPmÔm|úBÎ㜭µŽ…'iV|öRõ¸ _Þ§úÿÑÈyÃ÷§.žU‚º%íÜRµ|÷ÞˆÉûBÏ÷Ëœøupµ¡kžeqÕ§ëZ߸éSºX‘sàËJjñ.þÓ§±É/¾“ª_.XÓ~žrÁcÆW¼ˆ*Üâô"©¼JÎɪE“›](qª ë™ëô /Ý=SðüÞÏ~Ð}Iê}ët z–,Û¸¹õŒ– ïÿ:åÇg~'õµ}?›r±MÁ{·¶µ§˜VÝ:"äõø.ïÇ]¼õͬ³~ÊÏÓýn}z9€æî@úfP—VQõúo ¸zûø‘g,óö†òïÚ7x¸¤bmR.Nºû9MöÈÏ1}ú®þãáC#Ï$ÎZßã¬Ç™NÕÑ¡Crµ’¶í¾‰8þK\zªvÌïí^;V¿ÏKþ¬võ{/ÜšŸoÓ6{‚cîÅ*N.Ú4/y¹g~à ·ØËÏ×Ï+]ž·ó÷Úu«ä7Mr™ê¼V§ù#ì9rÌ5mQÕ~[F:¹ÑõïkZ¹ÿ}Ä¥1ŸyÒËŒÓÓƒŒ«UÛ}Ô™zÓ:|§èêxow‘gÅÞ#÷¦Œ4F…Voü zWáë;<)-ìïX}]ÇÇ̰Œ§½|>ë“Ûû›woŒ ß=½<§‘wáïÅÛ6ÙØ+gCÇþMï´ìôÅomÆ>œ±_í;¸lï„êg·TÙvÞä|¡æ´ÀâŠÖ­ÔݰÑÕñÊÂau¢µÑSÊâvÌ­áµørîÕOc¯—ì߸øü½YuZ oð87þMý|‡§:³º0cGäö¹qOÞÓ™Ô”îu½¦ä¹M³×·w‹å/íÝ>ænEûþÁ;cïÿÝY„ïÖn^ ¿$ì,÷ŸàwæÁïäŸÅïö—'/õ[Êï`É,Àú€úâñG°.Iv&‘(tPœ’h£ò#I¤˜2Dk2è2…o®4ÊŽJ¤givIbR©"Z˜Ò$ím‘Qê :£xÐB)¥\µ&­xˆÂ(SÑdÔIˆÈ‘€©K‚‹AcjWP8ÈɦHšfÕknùªD€$®ÆKŒP“ÉË/\¾É©NkÒéÓ„s°…!ÂgŽ$rèU~ð¸FÂ5ûá`¢@JÊ)ëP•ÈÌ@jF)ÃðÎàEÑð¥cX8:€"(’oà@~ð¤©k'ðÌ€¡Ás—(ðL0Œ²wÏÞ¡™%¤á€öIÄ7üeù§ÓáåÓ-‚dA~¨Ì” (^*é)–Dl ÞR…­'ieŒÑ^Ù ±PpÅÐjXðŠÑ4|&¡\pœÿÂ0…Þ !ú!Bœâyí6²"AfÂ'¢°Ä–¿ -jaÉp«áxqE¨X¨ü`¥Ú8‰äRD#¡1³Yj0úïH—?>¥ X“„`£@0«4V¦Í<+•‘þ;s&Õ¶1gÞ3ÈG2YNZ‡HMÄ ŒÍÉé¼ùÎ4NÓ8ƒÜ—…U:¥€+1YÁÖC!éÜ}‹ò¹‚>NŠU´2Ë·qÄPÎ$«Œ3_y%nƒ"%ÚÌ&ŸFýàpô)#U"Ä’ÏHœm=B¶TÃüxX…Aè„èg¶,h›&^¿X èrP¬p”ËɼhJŠN × ƒÃá‰pòF¡®²,мqº”è"^µ#;±X¶u4‚cA$nσ›C2šf+~¢ÂÍXp‡ð®#*‡æ½DóÀÏÃÛÑ[xˆ†Öü)< ”T\(mª-ì"ì­€]9²7Êg²„X¬y¯Ý Ì»€gédé-ƒh(ZŽ“„v°ËV³µTPG/ÀõŒ4Ë]®×£Dzbw]ŠÖ pº+§ÍŒ¯Éó ž'¶Ö$ŒdÇ„øIru boA8~Š„•ØGòfEÒÖîä#8 ì-ÃP(ºXï-?-ÊÆ]ð»öqw7î²0 Â ¹€tR¸k/¦¨ºTù/-ÿˆ2ÖT±b¶Vo2ŠÎAì ¢7ŒÑð81§Eì@:aÔóE ~€ $·Çm"𦔛žM„Àö‘:£NêÊSd„0…¥HÞ9Û”Àdh«Öù @°4sâ«C¶‰œÿ-LíM]¤²L/]ñ:…³0 Bî&ó>[g6$V‰î`8 5z©5Ä‘Ä>«‘jŒ ˜äèiê‹¥›dN³r³€u¥ðº \)ï MágG"ÔÇk0p;V•:Q¯…xTɈËÖ=t°tÑ‹1•{z³JÒ’Éè Ö/ÂDDÑ&«¬'dΕ57° •1YbÐIšåA¨µNJì@ÆH®ˆ¢D¢3 [ÏÑP,Þ_°C½Q´K—¤TeÊ…)*Y\B".µ=¦L—:IdÄв_µèSõIÂäÁ$[¹Èõ²Øo]f΢o‘Jø P2k«¤Lð™ë߯hSÄ`v¶Íμd%“ÑÒ›|š­T¯»HÑ[ ~™£L2hm½µÔx〞 ¢™.˜¬ 6iv*RÿIÖnÙPtÞöʆÐ% ½5˜ : 0tBdí–,<ÓDLœ·h˶80~q¾²> ¨3ÿØIDI(×ãǰ›™[^àOœà]@èUP‰ $oJu’šo·EÜ‚ÄäáI”iëÕѳ·ãh5pÕzqvj€°’#Öá²g¤«”µBÛC}æ°Ç4!+¯Š?ci« ¼ÁŽaJ‚:‰‚ºå†±­² §¸6i:ƒ¥-€ž*Ñ|ÆJðÅ»8c¥Y5A³ l"ïtýÝŒ•!Ô,NÈø U?ŒÃÑ7‘© x¾ÎÚX‡m†D'kòÌêcµTÔJ]^4  p„ò^Îÿ°0A¨Á0üÕ@‹ûûÂÄI5CR~ÿIúÄÂZa}qɿɛ1cRK02 bÛ‡ ÿ¢µuÒH¶œ ?$%r:äQp`´†xT²Äq+"+Ä#Ì är!‹ƒVxXî4v`i¨ •C¾<Þ(ÂêÔ`ei‡"X¾FªK•er¬¸©(YK†¸…ÑX¡­A^ÊC±N†¶s]Ih—BaƒUö5Gb5û1æ Ò¼K|gÑïÏÿ½^HŠô ¶GrH(µ`i¡“|v£—æ¦èH‚Ї²ª°’ªôJÈ»]‚ƒW¼,n—dÿùBîÖÈü£Ö«Â ‰Ã&¡z Òó¶©$Ày‚9¤ê‘¢YS€¥A7ÌF]ÐDäg²2t¯5Y‡r‘;‚OHJ¤­º@xF@\𕦭ëbv(Å&:ÙÎZ<"‰Û©xhÆÐPȨeìËT,##³ÀPFh‘,äÄòÄ¢e<_Œ_.üæ? pÐy®À€ëcþh‘&úd¤übøƒY e©ûÀe²vN1 ÀV…]¥ ¦Iäeœ ñ·H3Io£‰p {HCÛFƒ,UO*0¦ì8.È–¶W2Ÿ1#lG‰u?ñðØ"½Dmy0"¨ÕY‡ÍU˜Œ² *EovK‘ü ™Ý¢M ùh«“ǘJÕ^®Ð¨º6iÄ£l+°f]<@ ‚&‘=Ésò­IWIõ™¿ ÂWåÚb.¸ó³°W¬ú3U PáIJ¡q«úÒ°¥4ˆ&xxFK,® d.èÿ'Ûa5^–å0dèŒv£’%ѕÔd.>Ø„,!Ùµ08¼S‡ÑöKMö ¥&‡¡[P|QÜFUMÒÛžXÍÆŠCÄ@´4¸ÂÑ+Å5F¡3‡C´"Á5ÖtHñ±UiÛ~Øžlá¶Êœ(,R~5¬ÒÚW‚‹pðý8Ž!œÁ*‡‡há’šrš…Ã+ȶN…@7&Åk#KY¸5Šý™ºÄë’%"K¢{¹÷oE ìNp2~溄Cßäu‰`ÙTfD*",Š>P½,‡ÇP¾ð¾3…ñÅldíÀš@²#8IQ„à#pŽDqËæÊ&l§)¨îÐ×Â"jŠô×6Íñù(­°/L8mñ$`¥ ô±¶*†|¹Ý ãhæF–>JÇ®<¦êôVU43n Ýaºœ›CÓ”ý⫹ Á—^ùu“°:Œµºvg9„GB!ÿÝù3/‰`PçE¤eTK×ñ?—%Gendstream endobj 508 0 obj << /Filter /FlateDecode /Length 1587 >> stream xœ­WÛn7}×/ôe©¢bxÞŠ¶€Ó$n;YAâÂPmYVKÎjK¿¾‡Ü×Qœ5‚XZ.9gÎÌ™êC!¸,Dü×|ž^ŽD±}É´Z4§—ÅÃÙèÁÔÆDÅì|T‘…—…3ŽmŠÙåˆI?ž½Ãfï›â^Y˜Þ²ýÅx"¸0^zëYU­ÖãøhyÏ–ã‰ÖЇÀfiY;)îÙÆMšoã‹ú€•ìEy–í ”ã¿gÏFg£W q©da…p\R«æO¹(Þë[à…+ˆ«<Òj®­/œ2Ü1;z#QRjª7Ç/RÖ(À“Aìw˜Õ¶x´ÁfZËíH‚‘w¦ø˜gøÿ^ínmÌáO¹%nJÍ)Ü7× ¸MÕãorSd-÷á7÷#ÜnÝÁ R€Ü}q#HH»0à¶7=Úû&9 sånó?BîÆÑäZQ’uÄQNÿ_•ÄI&(nŒOäþú󻚤biZná.¢lÏÞ¢Êû"eéÜÝþ›ïªrÈŽÄ]dy »V—÷ÅŽ4°{qð⻺¼AOÞE˜·Ð»ã< BgV½~Ëž¬–×Y/Ñ”µ\côëxB*p!{z9_v¯»Š­;X¥{¿©šuAls^ s£ä¡–™=˧ƶš¯³çÓ|$¤3Š ŽËyU®>·8†gg6e³OR‹Y¿è0 [•«mãY°æÕ¼5«Y‰m\ ië4ôÒž:B½ó²XÞ^žÖcåÁÆÃÍÆc@þ“IZö%.ŠÆÁ.¼«1`¥4–ý4œ—õ“UÖ*M;¼²¦ã•º,f£ÙÏoÙvxp5¯V›v(kÝ90Fü0‚›ñ$z'•ÄlËȃ© >ט–MÍ·¸Œ';Êç´\Uñ‰@ϰß&Íw¯Ùv~uõþË1ÛüÒ®öäõóöÁ³ß[+š_¯O£ïÇìóñ¸YµñE™ÖÏ~i—m܃]m4páØáWuœN7ûLÁ4'd$¢+NP$ãZ¼©£×‡=™½éÉÙâcÔmï+–ë KÒ8ÃîM{Nûåül…—'åüSïp·úi±Z^T‹³äÔ¤s"Ѫv"Þ_&RPˆ71…ÔK2õ*CZ‘Α"¤OÔÏ Ê÷XÖ(!  ׌Ѥ$Þ¡¥14á¼øZEñRÑ*‰KœT= F‘õ²ÔÁëz@GF«B èzg^“6´+OiÔwq–ÎK©´N& ¤AWÙQ»Œîa¬¶º A©V³ÃL’ˆCD‹¸1=”BæÉr‘.ÌhétËÇ㤆¡,€*ß@8C‚¨…°H–í!0õ2-‘*Ó@zzÈ!pQ¥Ó%¦°ðVêUú-D=]j€¡pŸ×-† 1Ñ=!ê9†¶²ÃP6úÓb-j BéCü“FQ~O׋²ZÅÖ) ÞJvpÔÊßçÿ~9¹šW'ïë%:J—ăÅ|[l?\ÏËEV,‡ŽN¶–šj‰×òÏÁw«_#£Þã'EßAò§(ë#Tvt¶>á§³6 (½œ´ ™\±µ‹ïPúVy‰Öìz4Œ%¼èѬ 4§½HYèÐð ÈfhPt‡6”½FS§à’‚[r„>\‡Dõp‡³ÚäpJ‘ÃÙÝ% ÉÄú ¨ÒeÜŒˆîÁ,6¤ÂïÀPÞ”ƒyûu7É«B£î\Bæ¨Æ§þÕåϤ‚îQ5©P ”·\îúžesðu©X&¾90)åÂ> -Â7v*†2"0'’жíØÕ¢p7›rÑi½>äØóÅõå|½ÎÖ£7Ä^æ5Ô–ðt?Ž%Eª»éŦ®“Ýx©Pê~æ=O~R²‚ ?wíœ|ß=A ’}y ŽrðÃr Ì&%®’²5 xÛƒä}£‰Fµr£HÿeÔòO&¤Ð!7OVšwÞrI¹yä´ËC2bævŒ•(ø4BÀ‘ë>"PoÛ­ÕܬC«nà¼G‹ôødÒâ‡Vd|´ÇÉ Mk&m#ôâÕè?ê„×zendstream endobj 509 0 obj << /BitsPerComponent 8 /ColorSpace /DeviceRGB /Filter /DCTDecode /Height 150 /Subtype /Image /Width 150 /Length 3075 >> stream ÿØÿîAdobedÿÛC    %,'..+'+*17F;14B4*+=S>BHJNON/;V\UL[FMNKÿÛC $$K2+2KKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKÿÀ––"ÿÄ ÿĵ}!1AQa"q2‘¡#B±ÁRÑð$3br‚ %&'()*456789:CDEFGHIJSTUVWXYZcdefghijstuvwxyzƒ„…†‡ˆ‰Š’“”•–—˜™š¢£¤¥¦§¨©ª²³´µ¶·¸¹ºÂÃÄÅÆÇÈÉÊÒÓÔÕÖרÙÚáâãäåæçèéêñòóôõö÷øùúÿÄ ÿĵw!1AQaq"2B‘¡±Á #3RðbrÑ $4á%ñ&'()*56789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz‚ƒ„…†‡ˆ‰Š’“”•–—˜™š¢£¤¥¦§¨©ª²³´µ¶·¸¹ºÂÃÄÅÆÇÈÉÊÒÓÔÕÖרÙÚâãäåæçèéêòóôõö÷øùúÿÚ ?Áù­œpBßµ?í$ö&‹®H÷ªêŽJ“ùWº—28›å4â¸Àn*U»[šÎŒŒ6¥JŸu¹íPâŠR5bºóõ«s]/–ÿAY~õnSû·ç°¬œUÍ+Ét1ÿר¥“ aO>õ^Fã­#Èpµª‰ “;·oΜíiæ¢y>SH¬ \ö§mq^& Â7çBÂÒuSR;sÒ éEÝ‚Åý:Ð’ùRzV‡Øøû­ùÔZqÆþ=*þ㎕Ë9;š¥¡Mlþcò·çRµ™Ú>SS+|ÇŠ•Ê8¨æc±@Yò~SJ–Ÿì7_Zµ»“Å"¹ôïO™…Š“Zr>Füè«2¹ÈãµÓacœ¹ÅúU3Á¿JѼUü©í?0®¨½ dŠÀy`ó•út©¢u9çµE•?0¨1“ò*Ór6.¤€z·$£Ë|ŽÂ³á¹«SnÉÇaYIjhž…Fe óúS•AÇÌ:zTXùFH欪( ’*Þ„­D1‚‡æ•D#ù—æ•\(»"˜±Ã *T‡aL_íÊ \›ô©™û .Ì*/¡V4´è¾ÿÌ;v­+¼?*­§ªÿ0íWö¦>ð®Y=MQEó˜~U+Eò˜~TäUÜ~aR•]£æ Œ©år~aùR,_í¾•cjäüšªž£­;ˆ¯,c#æ=(©d ‘ÈéE4ÀçîãÊ÷ªf.½k^îTÛþ±*¦eNx¿•tE»Ñ* sQw75¡+¦ïò¨|ä ?x?*ÕIÒ3ù·8åþUaÜÈ®29‡q!8pxô¨ÕLýŽç+MýHÛÐXá8ïÅZ‰IÆAàRÇ2ãýbþUf)@þ5ééYÊL´À‡Ë<b©ßÐÕå‘|³ó¯åLWRÿ}*Îì«B{t(p85dÈ£ø×ò§C"à~ñ*‹²¬_°Cóð{Uí‡ Ga*øuíÚ¯yÃoß_ʹ¤ÝËETC“Á©Z3°pjd˜düëùT¦UÛ÷×ò¨mŒÏØyàÓU¡ëW|ÑÏο•0L?¼½})ÝJD9”U§˜d|ËÓÒŠwb8k¹>Z¤Ò š±,€íÏ'µV•†~ízQF ˆÌ Z`Ç$ ñëRªå[ÐTˆ !;GJ«Ø›\†Æ}9«sF6Iô‰X`Ï­Z–<+ôè;ÔJZ”–†ú¿÷•ZFÀö¡Ð ð*°#“‚¡éZüF |?Èy¤GùúöªÊøCœtD–cÇJŽRîh3Ó¡“¥Ti§Å À⣗B®t6}ÿ¯ùœu¬k)F_ð«¾oËÞ¹eM.$œš”ÉòÖrKÉ©Œ£oz‡Ü›ÌäóMY=ûÕo3­1dúõ§Ê,Èü¥QåäuéEW(\æ|Ô êi’8ÏSùT®W<Ô,¹Úv«2XŠÜö:ØyíTâ ÏÊ;U˜•°FÑÒ”"ÂÈç½[•ScóØUVÏnµnEbô“Ü´gHžj¬Š£œõ«.ƒÒ 1’yaÓÒ¶‰ ¯þ« —ùT±‘†!ºŠ c˜?ué·ùV›™ìHÎàô©#‘ÏJ0§½:=£¡–jس’üzUì¾:U];ißÎ:V†z¹$õ6[¡|ž*R_oJ.ãÍJÛvŽjW/“Å"—ÏNõ0 “óR \ýîôînÈãµ4йûݨ¦˜´,C ÷5#9ã¯çQ¾c©÷©Œ>ÕÖís>÷¾‚¬#|­ôõ¨a‹ïqéV/•¸íY»‰Pä­[”áè*²EÏNõnX†Çã°¬žå£&FªÒ¶ÿ^­ÉµW–>´Z!”äb$ åM&dÅ;ËÂp+KQbÑ1äãëÒ¤\±ëÞŒcÖ˜I…¿Ù­73ØÛÓò óéWùÇZÏÓ%??>•¢dã­qÏs¦; \î<Ô­£š‰eù5#KòŽjÆ äóH™Ï^ô y<ÒÇ'={Ó³g=h¥šNzÑMVÎÃ$ýO÷jÙ°Æ>üv¥²ÇËõ«MŒŠ™MÜEX¬>÷Ïéü5:ØáçíéVbÆè*eÇ–~•›“*ÄÙr>~þ•jk,+ý‡j’ƒ¯¥VÑ!2ãS,‡kp(¢©ˆ¨e9< Y%<ÑEU„ej“Wñª*ç“EÕî˜ÉêL’œu52Hvu= T´4Bò& %Ž9ëEq%Œf0QEV‰&ŒÛiÙÿÙendstream endobj 510 0 obj << /BitsPerComponent 8 /ColorSpace /DeviceRGB /Filter /DCTDecode /Height 150 /Subtype /Image /Width 150 /Length 2940 >> stream ÿØÿîAdobedÿÛC    %,'..+'+*17F;14B4*+=S>BHJNON/;V\UL[FMNKÿÛC $$K2+2KKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKÿÀ––"ÿÄ ÿĵ}!1AQa"q2‘¡#B±ÁRÑð$3br‚ %&'()*456789:CDEFGHIJSTUVWXYZcdefghijstuvwxyzƒ„…†‡ˆ‰Š’“”•–—˜™š¢£¤¥¦§¨©ª²³´µ¶·¸¹ºÂÃÄÅÆÇÈÉÊÒÓÔÕÖרÙÚáâãäåæçèéêñòóôõö÷øùúÿÄ ÿĵw!1AQaq"2B‘¡±Á #3RðbrÑ $4á%ñ&'()*56789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz‚ƒ„…†‡ˆ‰Š’“”•–—˜™š¢£¤¥¦§¨©ª²³´µ¶·¸¹ºÂÃÄÅÆÇÈÉÊÒÓÔÕÖרÙÚâãäåæçèéêòóôõö÷øùúÿÚ ?æ~çÓùSÃŒ­:a;|g×¥}çÅ…–¤Wµ]\l“ëô©ã:†‹L°c­8=BåïùÒ†uüê,UÉÃÔê°lúþu.î{Ô´;–ÔªüЬüæ¤Väu¨he”~G5v'ùG=ë9§Z¹|£žõœ‘HÐf™°sS¿Sþ4Ï_ñ¢àE³å4®Ÿ(üiÿÂÆœãå;N 4§Êjp8?Zaû¦ÀɽSö–ã°þBŠ’õA¸n;ä(­ÓÐÍ­Jn£Þ£u\ ‚y?ç¥XuàÔl1Ôwô«L–ˆITQÇÊ¥ùGcÛ¿ÿZŽˆ>§·Ò¢g'§8éOrv,¸ž´óÆ*vîGøR±W%VSÛõ©w/§ëU²IÿëT„üßýj–†™aXz~µ*°ÈãõªÁº…H­óð¨h¢Ò0Èãõ«‘0Ú8ïëY¨Ý?®D~Qõ¬äŠEÆQ“ÇëMÚ0xýjVqçô¦àsÏéYF`ñúÒ²£ZpŸÒœàmjw£Žþ´Ò£iãõ©” ­4°óúQp2¯Wý!¾ƒù *[ÅÿHlzä(­ÓÐÍ¢‹ƒQ°­M ¨˜qÓ½ZÂÁÀïý*-¨xϧj•€ÀȦ6{¯¥Z%‘€ªóeO|}Ú“ŒŽGoZ9Àã{Ô\(îÊžäìHq»ž¥Hq»¯5 ÐqëR1éǘÑ0íÒž¿xTŠ˜qPÑH1Ç5r"6Ž{Õ<Ž*äGåw¬äZ5ÙFãó~”Ý£Ÿ›ô©˜|Çåýi˜8?(üëžæƒŒ›ô§:ƒŸZP8?/ëNqòŽ=h%QƒÏzfÑ´üߥLŽôÂ>SòÐ#2ð¤7à!E:ô¤7nòVëbJ*&«.8¨Û5i’WeÊŠŒäš²ßtqQjÓ%¢¹î:SJ Ïêlœ_­4·N8ªL›åäJ‘ÉȽh,sòŽ)$ÆÙì=?ÏùâžâØxõ"òÚˆJ=)ë(Ü2*Ze&‰ÐœŠ¹£ëYé!ÈÇZ¹£žõœ‘hè›;7žjf1úûÓ1×üMqš‘ŒàÓ܃ñ¥ƒÿ×§8ùãë@(8o­3†¦QÃ}}é˜ùÿ^˜w£ý!¾ƒù *[ÑþßAü…²zQqQ°«.§Ò¢e>•Iˆ®ÃQ¸ö«,§Љ”úU¦"=ª28©öœ}ÑL àqT™6!­$ÃÅK´œñM”6ËúU'¨šÐ«÷û?ʤ'æ6ïOÒ’Œ8ÂŒvéW¹¡ù‡Ò®Ä~Qõªͼ vô«‘´qÞ²’4‰Ù2Æ›ƒƒS2ÇùSvå^}΂ )îÁøÒ…8<Êžêv~Ô\T7Ö£ÁØ °ªpܾ•ðð;v§p2ïGúC}òT—ª~ÐÜvÈQZ§¡%'N'µh¼C DÑx4Ô…bƒ!Ú8¨Y=«I¢]£ƒùÔ&5ô5jB±@¯ŠiCÇ¥^1®šbèj¹…b‰CžEG*œôæ´!ž†£’1“ÁªRŒâè?*k#nò«æ%ÇCùÓ C#ƒùÕ)Êgò„>_åV¢q´}h’1Žüê˜È$~ïùõªþ"~ÑJ|ÍÇéI³¯x¢on­7ËNxn•äóv)àñOtùµhF˜èÝ)òF» Þ—0X ©ÃqÞ™³ä+ÙI4q6Ó&Y>ROoj”Ê»F½ª¸Fã9äv©_î~Õ-!¦Ç,ªeAçÒ'Ê}xçÅèÜÏ¥îŸÂ•‡snÆAä®oJ*;õ+×¥Í%©²Ø²˜Ç_Ò¤ãÖ˜Œ=?Z”2ú~µ,c—úÓÀ<ÓU—Ö¤¸éúÔ±ŽP0ÜÓÔ ¯4ŠëƒÇëO ¼qúÔŒL õ©ëþsHsÓõ§‡_O×Þ¤¨ëR äsÚ:ç§ëR#®G­K¨:r*ìc÷c§Z«®G­]‰×`ã¿­g!£Ê¥ Ôœ})€ 9çÚ¬JWbŒ€;Ó7/wõ¯a=6µ"ùU8ÈíÒ¤fR£–‡ÿ¯C*xèÿ֣UòðH;sùSÜ[£wÌß÷Ïÿ^—inÔÇùˆÂžƒ¥HXnéÇ×ÚÍk¾Jüǧ¥ÛˆŽÔW4·7[ u5(ÔÔF:þ•&G¯éRÆL `|Ƥcï…JàsúT€®?¥C2¨Áù<ÇÌjÛ†çô§¹þ• JÏÞ4ð£ûÇüš‡åÏ_Òž6úŸËÞË*£?xÔˆ£#æ=*¸Ûž§ò©nG'§¥Kb51«‘¨Ø>cÖ¨&Þ9?•\nÁÉëéYÈhóITqä fÞÌy4ùã¯?JgëúW¬ŽF 0§æ=Go­3~í£¯¥?ƒÜv¥bÛG@? b"fÙØ@<¨âž~ö3øãž”dó·ñéÖ‚@~O§Jb5,Na_§¥Y7î—éíErËsu±]næÏÞ÷È©òbÌ?ï‘E«H”Ù*ÝÍýáÿ|Š•næé¸ß"Š*CLx»›æÿ²)Âòoï?ÙQSdPáy7÷‡ýò*Qw7÷‡ýò(¢¥¤$“xß"¤Kɲ>aÿ|Š(¨iJ—“d|Ãþùv+ɶ˜uþ袊‰$4srYÅ€6ŠìqtQEn›"È œ[OÈ:ëM6Q |£ó¢Š|ÌVCMœGøE i÷GùQO™…‘Bây,æ(„Æ01œQEÓ¦“h甚vGÿÙendstream endobj 511 0 obj << /BitsPerComponent 8 /ColorSpace /DeviceRGB /Filter /DCTDecode /Height 150 /Subtype /Image /Width 150 /Length 2601 >> stream ÿØÿîAdobedÿÛC    %,'..+'+*17F;14B4*+=S>BHJNON/;V\UL[FMNKÿÛC $$K2+2KKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKÿÀ––"ÿÄ ÿĵ}!1AQa"q2‘¡#B±ÁRÑð$3br‚ %&'()*456789:CDEFGHIJSTUVWXYZcdefghijstuvwxyzƒ„…†‡ˆ‰Š’“”•–—˜™š¢£¤¥¦§¨©ª²³´µ¶·¸¹ºÂÃÄÅÆÇÈÉÊÒÓÔÕÖרÙÚáâãäåæçèéêñòóôõö÷øùúÿÄ ÿĵw!1AQaq"2B‘¡±Á #3RðbrÑ $4á%ñ&'()*56789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz‚ƒ„…†‡ˆ‰Š’“”•–—˜™š¢£¤¥¦§¨©ª²³´µ¶·¸¹ºÂÃÄÅÆÇÈÉÊÒÓÔÕÖרÙÚâãäåæçèéêòóôõö÷øùúÿÚ ?çù»mÇåÿÖ©’_”~=(™§Z¬NÌ€p£ß¥{ŸÅð—ÄÃõ§ùÃ@9ÇÞïOÞHÆj\JR4VQÄSüÑ´Un?çš“wNj\J¹xL75nzš¦äóJëSÊ;—ĦY†Ò³•¾µ*±Áæ¥Äw/‰…J“ ÎV5*1¨qΆÊaór{t«‚_sXöL~o®+}kžQÔ´ËÂ_sKç{š¤ëJûÔòŽåÑ/M)›Ž¦©úÓ·w¥Ê4RosESG4TòŽçŸÌ8ïùU7' Õù±Š¦ü“Šõ¢ÎY"¿ £ƒŒþTüŽ>ž´»ÐS ÙÉû½‡¥k¹žÅ„#üúÓÉæ¡C8íþ4òÜôõ¨h´ÉAþ4ån;Ô@õãÖœ­ÇãSa“©þU" WVþU* KE"e525VV©PÔ43fžÿáW«>Äýÿ®)÷®y-M6ê]Õ>ô¹÷¨°ÉƒRî¨A÷§gÞ‹aŠM6‘™F;þUM”dñúUù±Ž•Qºð+Ћ1ebƒ183gýzcþ5¢dXˆŠ8ù—_Òœqœö'ñ£'o9#ëÞ˜IV<þïœ.~íVäìH1’8Ï=éÁ‡LÊ£Ës†ù±ÉÏZp#©'¹¥aÜ”R!àôéëUÔôëùÔŠ['ëÍKE&N¬*T?ç5YO©ýjT'×õ¨h¤lØ·ßü*ê·+:Àä>yéWWé\ÒZš"mÞÔ»½ª.=) ‘’†ö¥ÝíQ zR¥+aŠ(©°Ì ÇÞýj›“ÏëW&UFλ"dÈq×õ¦0éÏëR²ŒwëLeõ¢ ‡qëMo¾Ã#w99ëR0ùF3ÛúÓHùAç9äâ­ÈÉÀí³ ýÚŒ‡ã#ÐÜàçñŠ€’¤€p½‡¥=ű:çŽGçOB0zT9‚ ééïS.6¶ééïI”‡©ô©Pûb SéŸÊ¦SõüªHÖ°~ÿé[¿Z¦ãšÂ2e4g5Ÿû¥FlÿÛý+A…FG&´Rb±œÖ_íþ•²Ï;úûV‹•8JLV(úiÓÚšm?Ûý+@¨ç­D©IŠÅ³Àûÿ¥DÖ=üΞբÀcð¦2Œ½*”˜XÍ6?ôÓô¨ÞÀùj?*Ñ*=úzS$QïùU)²lŒ®tÒ@o1dü6ÓÆ B‘·¾~õ—÷ê*ˆAäíã·Oþµl’’»3mÅÙ¿´KpSð*Q¨îO½TÜòOàøÐ6ã«uþïÿ^Ÿ$C™šQ=vûcu9oÊž?F¬ðF:ŸÊž1ž À….D>fh-Þ=9ÿjЍ6àrýÿ†ŠŽTUÙéÖ©¿Z»7Cõªoּ蛲¨ÏSRµF{Õ¡?j°©_ ¨û ± =ê6©Oz©¡ nŸ…FÝÒ¤n”Æèztª@D¥2CO?…2O©ËÔþfR;gúU§ëÐÕýHr¿CÒ¨`l=zë]PøLe¹N1J¬qô9ü(`3Ü}zS@{ŸÒµÜÏbNØüJz¶æâ£gðüz*|{¨=:}jYHœ8Àüh¦W½,ôùº­S~¿]˜ð~µQúד¥°¨ˆëS5FzšÑ…ÇJ •ê> stream ÿØÿîAdobedÿÛC    %,'..+'+*17F;14B4*+=S>BHJNON/;V\UL[FMNKÿÛC $$K2+2KKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKÿÀ––"ÿÄ ÿĵ}!1AQa"q2‘¡#B±ÁRÑð$3br‚ %&'()*456789:CDEFGHIJSTUVWXYZcdefghijstuvwxyzƒ„…†‡ˆ‰Š’“”•–—˜™š¢£¤¥¦§¨©ª²³´µ¶·¸¹ºÂÃÄÅÆÇÈÉÊÒÓÔÕÖרÙÚáâãäåæçèéêñòóôõö÷øùúÿÄ ÿĵw!1AQaq"2B‘¡±Á #3RðbrÑ $4á%ñ&'()*56789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz‚ƒ„…†‡ˆ‰Š’“”•–—˜™š¢£¤¥¦§¨©ª²³´µ¶·¸¹ºÂÃÄÅÆÇÈÉÊÒÓÔÕÖרÙÚâãäåæçèéêòóôõö÷øùúÿÚ ?ç,r‡Ž;U›‹m`8¡2ņáÀô¨Ýͱ*§*J÷w8¶,ˆŸÊáÇJo’øûËÒ˜·M³¡éþ{R‹¦ÙÈÿ?•E¤UÑrŸbüËÖ†‰üϼ½?Ïjd7o±xïþ{RµÓïŸÊ¢ÎåhJ‘>Öù—¯ùíQˆ_züËÛüô§¥Ën;ÔhmÃJZB%ö™ÏáZWоÔù—üþ–.[`ãüþU¥}tÛSŽÿçµD¯t5b…ð~eÿ?…I/†ù—üþܶÿÏj|w-µ¸ÿ?•'qèkèоɾeþëíZ‚ÇÞOóøVNrÛ&ãû¿×Ú´ÅÃcîÿŸÊ¹§~bÖÂù/¼Ÿç𩼗Ý÷“¿ùéU¾ÐØéþ*›í-»îúÿž•ã#–ù¾dÿ?…4Bü|Éþ Igo›åÿ?•7í ÇËþ*v`H!}ÇæOóøQL ¸ü¿çò¢‹088ByÓ§øTWŠ»ÇOóŠ|8ó§OO¥6ì.ðÏjô×Äs=Ф˜ÏªÒŸ¸àw¡ö?…0‘ ©õíZîFÄñ»ý)Í!¡Ï=©±7ʼwíC_¥GRº¤§k|½ý)žwÍ÷{Ô±’U²Zh7FíSa’ [`ùJо‘𜾕ÎÁòšÐ¾'jpj%º)lB%m§Žþ”ô•¶7¯¥F ÁàÓã'kpi1šÚ<­²nðöúÖ˜•½?JÌѳ²nðÿZÓôjæŸÄh¶Íltý*_1·tõíQsŽRó»£w¨ ’·<~”ß5°¼~”醦úpÔÀ­¸ñúQ@ûdž¢€9xa_1¾SÓ×éL¼‰|ÁòŸóŠ|,þcp:…6í›Ì~¿JìW¹B“ †‰xùM:F!‡¯ÖšÌÄŽ?Z×R4!$ÄØ^#¥;$®áÉÍá‰É÷¨øˆw۟ʯrv,Ä_¾´¿?”ôdõ¡“÷güúT*¥pqëéU¹;’­À=*õÞJ®F? ÝúÖà]‹ó޾µÝ¶)Ô`~tô' €?:üÝÿ½OŒ ›õ¤ÆhèÌBM•ÃßëZ‚OaùÖ~I¾oîÿÖ´†1÷¿ñêåŸÄi†yœt)› ïQñ½úÔ¿.ï½ëüU ¢'`ñL )ò†çõ¦8ù¿ñêb'Ìxýh¥Ü~oüzŠÈ‡cp>ïøSn‚ïóŠÔ†ñ|Æù?‡×éM»½ÇÈ?¥j¤ï±60¦ ¹xô¤;r¼w­oFñò¾´†ðn'ZÓ™ö&ÈÊr¾wNßÒ‘ØlcþqNú‡B„ ožÝéžµ$¨»ÇÌ{R\˜õ­.IR@¾qç·ô¤!|³Z’T_4üǧô¤(¾_Þ=jîIŒx+r{ÐPda©â1µ¹õ§p*°ù'­>r üÀPÑÇæ=h‡\7J¢JŒÅOû?ʤVùO¥ «ëÅ 5ÀÎßåZ±©£1Û7ø­j+5eivÍ€Ýïõ­%cýÏÖ¹*|LÞ;%±R;ºzÔ%Ž>çëO.w}Ï^õŠËm=i™l´®NÓò~µãò~´Ðî4S7Çäýh  ¸4•ó÷ÿÃýϧ½6ëI]ã÷ßøçÓÞµ ½o÷™s÷×üúW7<®]‘.’»Çï½?ƒÿ¯GöJä~û¿÷?úõ§(ùÇáF9ZÓžB²0åÒWÍ?¾íýÏþ½'öBùë»ÿsÿ¯Z²ß7Ò‚?wøÕ{Iw*1_IPTùý¿¹ÿש–¡[÷Þ¿Áÿ×­ Jv>VüióÈ\¨Æ:R—?¾ïýÏþ½WƒOî̸Çû?ýzÛÇÌ~µRÍqæ}Æ­NV*3›I‡ïÿñÏþ½#éc yýG÷?úõªÃæ¦8ù–©T—qr£'þA9ùŒ«!Çqÿ맦° ÿVß÷ÕÚ±ôêk%TÆw7Ý­£5w¹“n.Ëc`êËõmùÐÚ¿ÎG’Ýÿ‹ÿ­Y%”Ó°KäSöqvm D4y(à w¨Æ¤¸#qïT‘”Gƒ×Š‹r€j|̼ڠ vÇñ¢³\ƒ“ïE_³b9ÙéðcÍo÷™sÃüúU˜7y­þï¯Ò™u»xÿ¥y)êu™Òãxü(ã#ëRËãðïGÍ‘õõ­."”¸óÒƒ,ýjI·yÍôõ£-埯­Pвã—­øÔ’ãüi~m­ø÷§p*ñ¸ýj­¡¼úÿ^ù·¯­S³,Lœ÷õúÕ­„ Ý)­ÉS1mßýzc–Ü¿ãMËÖÊŸSY,rµ­­ýÖsßéYk¸œç]tþ îWéô«j~aAVôýj™ÑGéZ_˜„¹K8ùMAŽN•v&8êFTã§ëP¤hÕʹÀ?Z*W úúÑV™=. ?zß7ðÿ…2âO˜|߯ҖûÖàýß_¥2çï?Ïã-ÎÒ´²|ãæô H8çø©²ýñòúP:”ýïZÐDR¸ó=©K,óÞ™.<ãòö ÿ«éÞ¨C%qÍO”üÞ´ÉGƒùÐGÊxõ¦!¡Æãów¨-Êø=ý>µ/ñ;Õkl~óŽÿãV¶)q»¯zk2î^}iºccrp{Ó°µ0Œ©œÚ³.GéWu@6¯äÖkà'ZÞšÐÎOQçò©’(ÉP~«T‡ÔU”#p­$‰Nä.í°ÁàÒ”·<9ýhb~aÇ_ëPýÏLcòªJä·bÒ…+ÉÏáEB¤c>´TØw=2|Öçø™rõçüñEä­Î²œ ïúQƒ‘Ïz(­ +ÊÎ<öþ”ÞYç½U¸æ—ksëEÄEƒ¸óÞªZnýç=ÿÆŠ+E°‡¶íÝi»)ÍS@gêä…LŸâ5š[+É4Q]4þc-Æœæ¥Wùû÷¢Š¶J$ ô¨YF9æŠ*PÙ7—žN3ùQEªFM´ÏÿÙendstream endobj 513 0 obj << /BitsPerComponent 8 /ColorSpace /DeviceRGB /Filter /DCTDecode /Height 150 /Subtype /Image /Width 150 /Length 3087 >> stream ÿØÿîAdobedÿÛC    %,'..+'+*17F;14B4*+=S>BHJNON/;V\UL[FMNKÿÛC $$K2+2KKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKÿÀ––"ÿÄ ÿĵ}!1AQa"q2‘¡#B±ÁRÑð$3br‚ %&'()*456789:CDEFGHIJSTUVWXYZcdefghijstuvwxyzƒ„…†‡ˆ‰Š’“”•–—˜™š¢£¤¥¦§¨©ª²³´µ¶·¸¹ºÂÃÄÅÆÇÈÉÊÒÓÔÕÖרÙÚáâãäåæçèéêñòóôõö÷øùúÿÄ ÿĵw!1AQaq"2B‘¡±Á #3RðbrÑ $4á%ñ&'()*56789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz‚ƒ„…†‡ˆ‰Š’“”•–—˜™š¢£¤¥¦§¨©ª²³´µ¶·¸¹ºÂÃÄÅÆÇÈÉÊÒÓÔÕÖרÙÚâãäåæçèéêòóôõö÷øùúÿÚ ?çÉ0HüªÄ¾¿¥/ôïôªŸê9<©ý+ÜÒHãøM&'aýàý*3»ÌÿX?J«æåqÏ_Z7 Ùù¿:\£¹­!÷ƒ§µ+1ß÷ÇAéTpuüép_ðë>VW1¥Œ7¯éO$à|ëÓÚ³¢—åjy“ ¥Ê;“ÈN﾿¥hdóó޾ՆìKŽjï›×ëJQËÀëó޾Õ8c°üëúVOó¯×Ö§ü¦¡Ä«V–IY~uíéïWOÜ?:þžµ‡¥K•—ð«Æ_ÿžõË(êh™mz}õý)çï¯éT–^49ëK”.[Ç?}Jh7ο¥Só9ëH$á¹§Ê/ªü£ç_ÒŠ¦²£žÔRåŒ,¹|žßҨ˴Ž2y«Y}Ò}?¥U}Øç×Ò½HœÌƒý_®ÜþU*¶{óC.s×?JŒ“`—éÒ´ÜÏbu qÆzÐAßÓ°©"¢ŸcNÚ¥úzv¨¹¥†¢‘`ΔƒÇ½jTAå·ò§Ç•Š­ãÖ®`àñßÖ¡xÆáÁ«¡¯ZR`‘_ko^;úÔà§Ö“bï^½jp‹´ðj[)#WK ‰xôïõ«¤6ÃÇëïPih»eàöþµt¢ì<ä“ÔÑÔ6­! žŸ­N±®ƹèi\el6z~´ Øn?Z›Ë\ô4‚5ÃpiÜCvÑÇoZ*evŽ ®3–1¨gùGO_j£p º:úÕöfÜý:z{V}Áb;~UÛÌdB,8ýjA•åAüj0[#§åS&⣧åZ²QQ™¡rƒҜ²1ƒD«— ©4Â|¬qòõçµ^älN²9Œ€y¥ß.婈ã>”ã Ü>Z‹< EH%“iù»úT+/Ì0K¹@#iàúÔ´4'›&õù»Õ…–M§æý*¶Tºü§¯­N¬»O­&4méRÈV_›Óµ^2I°üÿ§½PÒJí—ƒÛ½^%vç\’ÜÕl"É'=äÏÞ¤R¼p: \ô?HÆï“wÞ <˜ošÝÐþt ®ƒùÓêÒm7j(V]£ƒÓÖŠ@b2)/†íý*ŒÑ¯÷«D‘—àtþ•FSϺ¢fÊʈªdDÛ÷ª ~aòŠž3òŽZ¶J*H¨d!O4×AÐñO}Þ{ai$-…ãô«DŒUò°HÌg©ô¥Ü¥‡‡ÉA‘UÀ*Þ©üª’¹-Ø´¥3’<¿'åèj¼{qÛ¯­HÁ·7'ï–ŠL0Þ;ûÔªí´üŸ­UPûÇ^¾•0 ´òi44Íí*B\§¥^2ü‡äÿ9¬Ý0K’{UÒÃÉ®I-M–ÃÖ^Ÿ%^~åD úÒÏZ›ñ(Ý÷(Œ7ÉP…ç­pÜÓ²ÒÊ»GËÚŠWåö¢•€Ê.rÿOéTݘ“Ån¯ÉéëíT&÷'ó­ã"3 6G½êh™°8ïS¼9?N€mêzúÕ¹‘œA2ž?ZlÊxàôõ©¥ÇœÜšFÀA‚ERb± Så‚sÒ¢Ø6÷éVýÜ?Œ¿ï·_Z¤ÄÑ[ý_ÓùVŒnn¿xÑl}öëëTdvG 7ÉØg¥?ˆ_ ycùÇ^µ/–6žµœž¤šrÈüà÷¤âÆ¤Ž§LŒb^½ªáA°õÿ&±4¦lMÐt«¥›açüæ¹%M“ж¨1Þ‚ƒ5IY¸æ‚Ížµ<£¹k`Í Eùª fÝր͆ù©Ø.^U]¢Šªö›µ¬Ù”ôþ•BmßÝ5¬Árüöþ•B`¾µqbeݸ|¦¦MÛ~é¥wjhÂíÕ¶JF\»¼æùM!ÜP|§­Y™GšÜÓYW`çÖ´¹6+°l ƒþMD¼ÏºjÓ…ÞœÔ` çžõI‰¡Ñ«tõªn™Éõ­±Ž½ê„‹ûÂ2iÅê)-•vÁ۟ʧ@9äu /“Ò U(ßìÿ*½ÉØè4­¤MóÕt…Ø~aYzNà%àöéW‰m‡å5Ç5ï­‰T/0¤!s÷…B¬Ü|¦”³gîŸÊ•†<Ý÷….æfÝ÷OåJ¾o”þTX .ÑÏj*0Í´|­ÓÒŠV¤:h%ÿ}Ûû¾ÕBm0ùmÿŽÖæS/ÏoJ£1\õ­sFLÑ£(i£pý÷þ;SG¦ƒ÷Ýÿ»S‚»‡?ΦŒ®ÁÏz·&MŒItÀeoßã´‡Lﻟá«ò•ó›ŸçHJì÷>µ|Ò‘&˜SçãµÓ†â|îÿÝ­)Jü¼Ö¢ryþuJR "ôáõßøíPm4nÿ]ÿŽÖÜevõ­Qb»ºÿ:q“H§ýš 7ï»v þÌÇï‡ýóZ€®Æç·½BÅw¯#­Rœ…ddý—»æóÿ ¸£ûH÷xúѪ`…ôæ³@ÛþåtÆ*JïsÜ]‘¦5OÖ”êC”þuœ6nàÔ‡gÐá©2迺x¾‡š »7{Ô£fzÔ¸¡¦Í¿ ÐQU_o¯aEO**ìôm£/ôþ•FUäñWA9§ôªRžMyÑ7d~qÅMüƒŽõ?8©£?(úÕ±ä_ß7…~QÇsK!>sRò­X†J¿sŠˆ/'Š–bp• žM4"hÔmªL¿9⮡;j“œÓˆ1Á~Fãµ@Ëó¯ê`NÆúTLNõúÕ¡Z˜ ƳðÛæ´uCÂñÞ©g÷gƒ]P~錖¥uVFÉoò© ÐNTðjTÖ»™lY\Îj@WwZ¯Ô¥?¸v©h´ËnËëØQP¸útT$UÏMËý?¥Q—<ÕÁŸæ=?¥R” Ÿ˜×—¥ ï4yÚ>µxùKGÌzÕ±$ϜԄ£ëJàyÍó £æ=j€Ž`pµ ƒ“SL8_˜Ô*:üÆ©™3¶©°;Í[Aòýê¨Ãç?1¦ŠØßJ…ƒo_­L l?1¨˜|ãæ=jŒÝD úÕ2§Ë<š¿~8çš«ƒåŸð®ˆ½ šÔ¯´…9¨úžƒò«§ü*.{ÒµL††PäýÚx#ÀÇÒ†(ÏLzS ÛÛäút§¹;Y—Žj*2Àã#< *l]ÏPU?§ôªr(ÉàQEy:ÊûFñÀ©£Q´p:ÑE[Q”yÍÀ¡€Ú8h¢¨C&jð*QÏŠ*‰QFÞ‚ª°ÛùQE4¨£p7Ž_J(ªB(ê`¾•WÈz~TQ[Çbälß!à~Uo§OJ(­ Wo“ ééQ±ÊƒÏµSBdnÞQõQEh’fM´ÏÿÙendstream endobj 514 0 obj << /BitsPerComponent 8 /ColorSpace /DeviceRGB /Filter /DCTDecode /Height 150 /Subtype /Image /Width 150 /Length 2964 >> stream ÿØÿîAdobedÿÛC    %,'..+'+*17F;14B4*+=S>BHJNON/;V\UL[FMNKÿÛC $$K2+2KKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKÿÀ––"ÿÄ ÿĵ}!1AQa"q2‘¡#B±ÁRÑð$3br‚ %&'()*456789:CDEFGHIJSTUVWXYZcdefghijstuvwxyzƒ„…†‡ˆ‰Š’“”•–—˜™š¢£¤¥¦§¨©ª²³´µ¶·¸¹ºÂÃÄÅÆÇÈÉÊÒÓÔÕÖרÙÚáâãäåæçèéêñòóôõö÷øùúÿÄ ÿĵw!1AQaq"2B‘¡±Á #3RðbrÑ $4á%ñ&'()*56789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz‚ƒ„…†‡ˆ‰Š’“”•–—˜™š¢£¤¥¦§¨©ª²³´µ¶·¸¹ºÂÃÄÅÆÇÈÉÊÒÓÔÕÖרÙÚâãäåæçèéêòóôõö÷øùúÿÚ ?çÙ¼œ2‡ÿ©£mÇ"L~]¹=je¦\Ü2?yßÐTû¾o¾?!Y›ùžµ6ÿŸ©©qΣIlùŸ¼ôì=êéÆ÷Ÿ ¬]%ù“¯oëWKðÜšä”}ãDô,œqûÏÐR±óÐ~B¨—÷4¬þæŽP¹hãwúÏÐSWï?AU üÝM"·Ìy4ùBåðÖ~‚Ц§&ŠV‹Ú£Ìü?•RœsVÜ¿©Hz“ø×§šDd˜ªŸÒŸ¸õ¡°F?FO”p3·?•k¹¡˜…éßÒ¤3÷¥CÒ™'½OòƒøVn×-l;Í%òªþiÚ8íéS±2AíUÕ†Ñô¤1ÂFÿ"®¤¬¸ïéTÀ{õ«ŠÀ»RÐ [pã¿¥Oæ¶þŸ¥A•ÈúÔùë6R6´™[2qéÛëW|ÖÁãôªzI_Þ~Ö¯|¸jå—Äh¶"2·~”4­éúR¼PÛi ÍmÝ?JE•·?J˺š¡wb%oOÒŠp E!œ›GÃõíTÚ sœõ­B¼?NßÊ©¸#=:×lY‹EY¢PF3Mò”©ÎjiÉÜ8½µiwblQ$ÂÛWî*‘$-’Oj%MÇ$ЇýVyÊŸÒ´Ñ¢6-#†Iâ™òŽ2x∠–ÎE@ÏJž¥t%P»rOz˜¸Ø=êº?È8ïJÎ ·Ö¥¡Ü”ÉÈç½Oæ Ýj†ðXz±¼nïRâ4΋J—™0}?­\óN²´¶“¯oëW3Áë\²Zš­‰L§ŽiZSU‰éÖ†#Þ•†MæÔÑ)Üj üÝéùZvpJÞÔUqøÑJÃ(; ȪLS‘SºŸÚ©:A]FltÛ ŠFd‚EA6ÜŽ#(ÇAZ$EÅ‘wW¦ICŸåGE8ãžÂ‚Ø{Uê-"˜ˆ$‡ô§¥JMW'aÿgùSÜ‹`(P1Þ†Œ—;A¨C÷õ«!Žöæ¥Ýµ#òŸ¨ÎséR˜Ü7CHä žµ1c¿©©m#[IÏ™€{Z½åI†ëU´†9““ÛúÕíÇæä×$ß¼l¶+˜¤ã­ ž†¥.xäÐÌ}M+° ò¤ÝÞE&îÿ•M¼îêiÎ°†OÊŠ•\úš)]ŒÄa÷úþ^ÕJQõü«eƒaþcþERpÇ?1­ã"2ä?Ê•Á¿åW%V>cC+ûƵæ"Å0£a'4ÙxàÕ‰ #q¨$f+÷ÍRbb P¸r M1`»‰æžá²~cNöbµÊL|±¿Ê®G´³qúÑå±QóUVc~_åOâÂ[P»‡ýjo—ÌéúÖzHÀç&žeù³ëIÅI>‘´ùŸ‡­^pƱ4™dã¸þµ|H9®9ÇÞ6OBÑ þM üš¤eô4‚—(îZÂîÿëЪ»¿úõHH7w¥YFîýéò…ÍUÿ&Ц²ûš*yBämœ?·òªoœt=kM·|ÿ‡òªOº´‹)LáÁ çoCSÍ»p îÛZ\’„¹ÁàþU]òW€*¿.pjÎÚÒ,–ˆ!ÿYƒœæ¤prpZXË êV-“õ¡½D‘VØ85VD!Ž}kCçÚ9ªSïÍT^¢’УGËüªm£vM œdÔLÛ?ÜþU{‘±¿¥™:vþµ{ûÝ++IÚL™öþµ |ÕÇ5ïØqíÒ†ü*"‘‚R°Çÿ ÷¿:Œß@TÝùÓÒæŠb*bŠ:6Òò÷‡·ðû}j“霬=»ÿ×­¬¯óz*¤øÁù»×,e#F‘—6™óÞûçÿ¯Jt¿—ýaÿ¾úõro¾>jwð}êÓšDÙ2é§‘æûçÿ¯U›M8ÿXïŸþ½jÍŒýê¬ßïw­˜¬Šqéy”~ó¿÷úõ+i|ŸÞwþïÿ^¬Ãþ·ïw©_©ù¨sY?²ò¿ëýóÿתRi|Þûçÿ¯[`|Ÿz©È8ûÔã9 ¤g0ãýaéýßþ½Aý–JçÌÿÇúõª?Þ¨€ýßÞ­ä.Tbó¥žò+Ÿ¦1RG©g?!÷£T;9Ï&³1IãùVñŠš»ÜÉ·e±­öâOÝ?FoÉ'ä?P3Ôm9ûÝiû4ìÑKÂH;MKö¢0p{ÖR£–éSyƒjüÕ.jF¬wgoCEgE(ÛÖŠ‡¹IÏÊüz*¤ç¯êñnðþUIۃ׭yñ7dœqKŸ“¥$ÍóŽ´»¾Nõb*Ì~n•\Ÿnõffæ«ã¿ZÑt'÷Ý;Ô®yµQ0n¨Ô7—R`ÿ“Q¨>_ÿ^¬F}êW#½g²…ÉéZ·|‘ßÖ¨I·å­àô2’+g½<Ǟ°ÇÝ©³ÀùZÕ²+sÿgùT¡þQÏHn‚«ãéÖŠ+DI$÷Õ+¯&Š)=Æ ¿%S•x?Z(§1»y¦*.Š*ÄS¼EÈúÖt±®øQEmDˆ|µÛÿÖ©üµÀ¢Š¶Ù)ËàÔE(ªM‰¢&o+Ýh¢ŠÕ+™7fÿÙendstream endobj 515 0 obj << /Filter /FlateDecode /Length 2937 >> stream xœ¥ZmsÛ¸þîßÐÍÜj-@$˜i;“Üø&×ó¥WG÷ÉΨŒD;ÌI¤BRvÜNÿ{wñBå\®“‘H`±Ø—gŸ]ùÓ9Ø9Åöÿõߟ}:cúé¹ýo½;µ<ûöZ¥ð$ÊhÆÎ—wgf ;gJFJdç©L£ŒËóåîì†üT®ç1~Où0§•Ð8ùh—¨Úç‡w¤OSý6Î ¨üm  ÆîÆ{ŒpšHm¯GŒ”K<\«ròâI ÐÝhO©²Ð®DJ:»ü”-ŠÕŒPÌk< –¤€¼µU.]îöÞÆmpð:Õ€ÜéÁÝRö†²…&0Üeí¿EÓ@uÈb˜ÆYAr’·úóà,Aîæƒ¿ÒTAÕÁS’8Ib0*п;ʂǮ²àŠA™âîZ&ZPÃÕá9ØÀ9ÊÆ¾¡N³¡nv˜Z¨š7÷ï­³ª©µÆªr¹kmpj“"Š•°ñ³©‡ad‘‚ðKÍÄyÏ›ðÒGâc¥Â•[‹áSgª!Ùq› “Yái½ ïüèoœ¥˜£É5P\§Ö{±mk»=‹‰æøò*ßL_ˆ”¡W‰1;ˆcžÙÍ«©`ÖfŸ¶:@N‚œ)¨AdB¡ L˜h5gÇh’µ¤‘BUž÷$ç™sö )Ñ<œ!nÇ$>óí‘w¹ág”1Y“X óc¸Ó‚ŠX@í„™dŒKú°|U1ª"ÁCñ(¥¶`.[ìâ×ñè­!Ž °‡MibŠ×ÏFŒ¨ÊT$#Ô Æ‚St¤">XçmX޼eZ_š€¾*@¦¦Þ&"Z/ZÜà?ž” ® ¹ódLH;úe9.TgY€~§qŒÖ®v“ãu¤ k[kŸ+i ^3c¤ koÐÏx¢rûÆ‘–Å5¯ÑŸÁÅ:sl½l⡾SG궃ØG_[ÛÃÅЄ}ÜìÍv‰$6cÉ&¤œ9±?¶ªL’ ®šµ&0f8TT!0tÇö¤žŽ’„E€NC¬€ÔíNÕC¡I÷D¼°8‹RÖƒZKÊ™w‚s­ý"©Í‹ˆb#¬‹î#¬Eà4ô¬`š•8x@N-ŒgÕ]©É@Î}HXìn8˜J§ôsÜ¢6ä,Nבÿ<%´Þ \ݵ. DDÁ¨N[/Kõ¸6ðó1>ãÒS ¢(^øä)|Ön0&NHy¼> ìúü©Ÿ‹>e‘-’1”Äñ4‚§Îosc©xì­vE÷¡Þ¬šG6…’(ò—Å0\¹;Tk\|K>_ cG°ûY×_‡o~¹ºº˜Š?Ï¡\d’ºþ¥æx›ÛâÓ*ßÖÕý-Ù”;8ôvŽÿ†µÿéGY N¦AÛ|¿ß>ÝNou:3éݤôj %Qz)û™Ö÷røòMY}3L»Œö½N 4P?|S¾ÓjOœRlÛböæ¥7䕞¥œ·þ{zÖ4Ì͚Ɖ–NÒ€t'Ìó0Ï %‰žøðÝÔØ”ÃÍ0 Çë^\êÜ1KM*%©nž¾‚øà< @4ıO‡ã<ø‡?ÂA+Xã^TNd8Ú/eÏ„z» M¯‚œ£!-†V @y<êòð9•–ÜþB£ t‰i¸¦èEÏâ<‹XKD2G)z¾D)—Qœòç(Å­ñ9!$Ôä0BD±ègF_êÛ‡Á!8 M ×–pãDè¢9þ ¥˜æ“ˆÚ1£ÊdË“±±OÉÛSoYú,O”œÆ¿»ãÄ«A©†±uó«ë>Ê¡ÖôDÂ]27°Ûå]SNº Ž¢ýÈèë§vq*]+†#µ§É#∃w„½•ô,˜M4£º!d®ÊJé=ô A$÷@Kgí¦ø8mt§‚½Ž¢Òû­è¦ï! £êÎQ,H»‰a–™2êÉë“í 䘲´†BÚ‰n‰¬ãS”ÉtKmÀ[›ž‹ ”òÇÿu}L)ŽêFP‹‰!•ʼ¦Ñ˜œÇ`á?ÎF$Ë ¢qÄ.ºÕ˜aÜ’™‰¿ÙÅ@2foŠÇÕµ¡³‹áW«Sô䥈 ï³ëØš]nŠª³?`Á@¢Šf6Un¿¬¾í™G€þí‡_™~·ö“trØÊ}SÛ ÃN B5Õ*C+NüúìNÝzppâ'ýz8qºÇÂ3q”Žø­Ïgã~fHq A™ßØCE|4ñ×Ï%?F}(\4˜èÓG]Ÿú ÇI‡ ù^§ÏkôýeCrÔŽq˸Ež¼F ‘.QnKbÆ#ú²*C؉䅻•±‰DÀñÌQ&´C&÷‘8* n °èE ½a]g/ÿq9›/Rnþtaöêòåèëjùöç™ÖÅ>úqä½®Ú®É˪ØÌ¦°àFúg|§e*ó'³×EÞíò½/ó›b3ó ³~vuu9;†‡›ÌüS‘W³Î@àˬøŸ¿ ._Wyu¿-ŒüEo¦`nvÃø»¡7˜]ë¿ô˜Ù>gÖŸ‚.—gÿ„ÿΪggendstream endobj 516 0 obj << /BitsPerComponent 8 /ColorSpace /DeviceRGB /Filter /DCTDecode /Height 150 /Subtype /Image /Width 150 /Length 3147 >> stream ÿØÿîAdobedÿÛC    %,'..+'+*17F;14B4*+=S>BHJNON/;V\UL[FMNKÿÛC $$K2+2KKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKÿÀ––"ÿÄ ÿĵ}!1AQa"q2‘¡#B±ÁRÑð$3br‚ %&'()*456789:CDEFGHIJSTUVWXYZcdefghijstuvwxyzƒ„…†‡ˆ‰Š’“”•–—˜™š¢£¤¥¦§¨©ª²³´µ¶·¸¹ºÂÃÄÅÆÇÈÉÊÒÓÔÕÖרÙÚáâãäåæçèéêñòóôõö÷øùúÿÄ ÿĵw!1AQaq"2B‘¡±Á #3RðbrÑ $4á%ñ&'()*56789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz‚ƒ„…†‡ˆ‰Š’“”•–—˜™š¢£¤¥¦§¨©ª²³´µ¶·¸¹ºÂÃÄÅÆÇÈÉÊÒÓÔÕÖרÙÚâãäåæçèéêòóôõö÷øùúÿÚ ?ãY–4†(IÀÏÝéíþqOvœ“÷ØuïÇ?Èþ;§™:ö|ÄãùûÐÌTÿÜ‘Ãþ··×œtŒH3€[#?6GåN.2XöëúÿŸJA!ÇñßcÊ—Ì=·cý—/˜¥SheùOsÿê«,HdV$ƒƒéɪÍ!Â}ÿ»ÝóÜû“R“‚œ'#¶Ð:Ÿzì4Iöl8ðyÏûU±œô¬M ÿâ[Þè‹ýªØFÿ{ó  [êTzƒw×ó©ý:°­R+t¨ÔªzPèÜÔÈÕ]Ö¦C@R)â¡¥^” 4ài‚œ(âŠóä£å!x;Žî}©e?ð&ü°?¦id8àòOOëDŸ{ãsÐUBóœ÷Î)ü»ssŽ(à®Ý¼g>Ô}ÌqÇN;õ¨Vîþáè}Ïõ«cÝc·¹¨îXøçaëï™ÔŒeAïî}è¯Ðóý›:`÷ÿj¶#ÍchmÿØzô?úlF}Y©R¡ÍJ†€&SR¯j…MJ½¨dëS¥@‡š™ J*TéPƒR§J”S…0S…o.>ã©ÿÒ— îãÏ^­þ59vò±å.7uÉÿErâ5?)î}ýè2Da>EÛ´žIã’;Ÿç¥X’l´gbp§³úŸz'‘ŽÌÄ£åõ?ß>õH€`¤d“Ÿ—šítNtèN1Áãþ[ðkA”ÿeÔQ׿û_Z×Y÷GOZ´ J‡éUüÎz¾µ"Iì:zÐ¥?J•MUWãµJ¯Óé@óS¡ª¨ü¥Ms@©TñUÃT¨ÜPâž*zSÔЊjš(ÎäÑì¶ÜŽO?3SG²ÿž#ïâojÛ‘:S?™  Oìk,ãÈÿy©F²ÿžþújÙÙÏÿZ¥bÿcÙœfÇO™¾´“h¶;“÷=þ&÷­„Se^G¡ îæ}6êH-äòíãÆÕÚÜ€{óÖ¦‹Yº.Ò8¸?Âv67³ò@ùzaXä˜Or¤ƒÊôÿëPBºÅÙÇúGoîð«k9_ßõëòð®mg*WŒóŽGz–ÆTàzô ¡u[ŒŸßzÿÿ š=Vã'÷Ýåá\Ú\ò~UïSÇ8çÉ€:Hu[’ä»ÿt…Z‹S¸ç÷½¿º?¹˜§ýæp3ÿÖ«q\dœÒ€:Ô®?{ÿŽð«Qj½ÿÇGøW8“ò8r¾N‚€7ÅôÜ~óôáS-ì¿óÓ¿¥b‰Ï föMm­Ü˜ûÿ¥œ’åzÔP?JkZÒ˜Éüèô†¦ÙHR€ "™/n½*ÁJŽDéÒ€8­ms?ø¬;µ‡ÊyÇNµÒkq¶O„îóø À¸ˆíP>´L¸ùN3ùõªhIùNÆéA‹æ\ªýê‰FÂrp×忀-«Ç†Ï?ËéVŽOÊÜ‘T˜ï\c®MJ®1ã¨õç­_ˆüùÁÿ9«P¶wuéT€“¨hç·JµÝE]Fäu«°·îÇZÍGŽž¾õnϽ@JÝ*·^½MRW^GoéS«Œ}îæ€4c´`a¾EÇç­!!Tp1ÿ õàsÓüý,äá~a£Œûž9<öõªå±ŒõÚ>R8õ4-ó€? ´ŒsÛ§¯½\…¾^¾½ª‚¿=ON¼Õ¨dz ÑVû¸öïV¿™ªhç ò¯oéS«Œt^§½iDÜQQFão@:t¢€:ÆJiJ°ËM+@öPR§ÙHR€+”¦:{Ê­¨Ý(‘Ö"cy1öþB°î#| õǵtÚ¬érò;!X—1ƒ‘Ò€2š6ã9ëQ2¸îàuÈ}¢ÏñµÄvŸ¥gn?*ã|£üiàg ž6åGó« Éäw¦¼GŽz ®ìc9 y8qéNŽhÎvŽÜü¼ÿ:'1ÈíÏçTãŒF²fEÛ·“ÏjÒY£Ü3Ðx÷«pÜ/–3·?OαÆ8ן¯øUÄoÝŒôù¹  •ž—°þ¥N·ó€>ñþÉR¹_œt÷öö«!°[ýó@QΛ~P3ÚŠ§àg¾ò¢€=!…4Š˜¨¤*(RSm…EBE1…X*)Œ´Ëê‹›¹xôíì+ávô®RMÌœz!YĸJÈd>Ÿ¥Dèpx=ëI¢ONþµ®€2™N{wõ¦:ž:t÷毴KÏ_΢’%Ú>”:Ÿ+8qÏ>õK+àgOq[1&ÌãœÿÖ©²&sƒŽÿ>ýTC•9?wè~^Ïÿª­ÄkÊÿÐÁ~^Ü|øïP³yxàìÏ®1çý(òºå~|ñÛð«AÆæù‡úÃÜÕŸ˜òœñÿ-½Å?Înx?y†wŸÊ€6"`ˆúQTÒf1ŒŽÃ©ÏéE{˜§‘IŠn)1OÅ&(„S{Tئ@Z€ÿH“Oä+.àr8íé[WÃ÷ï×·¥fN½:ôõ  ç¢uùOËÛÒ®²û·_Z†E[¯ýõ@̽¶úö¨Ý9_—ø} \eÿ{ó¨¤^^ŸÞ  W þŽ>QÛ·ÿZ¨ù[å==ǵk\/îG-ÐR`GñIÿ}P|Šv7Ê9öÿëTs¯Ü>_?¼þþyÁÃ|Òôþñõª“ýñËõ9ÃÿŸÂ€3Ñ$ëòõçøÃüþö·›'È@óÇðûšÌÜŸ½¹À#øOøÓŠ3ÒÀì ÿgß·zØ3|§GO ¢¡†B§;›n|£ð=è rÅ¢ŠLQŠ( Ò´Q@—‹ûçü;VtÈOJ(  ìƒÛ¯¥Dè¸?áE]£ß•E$kÓŽ”Q@Ü òÂñœÕMãÇ\gýÑEÇzr?º=jœè…ÀïØwéE·ù“ùGø}*"*[;vîÈì:åE 0³Q,ª*’ùŠ( ÿÙendstream endobj 517 0 obj << /Filter /FlateDecode /Length 2613 >> stream xœµYݓ۶׿ÐŽ^ µM|€§íLÚIÒtÜØ©Õ'_æBK¼;ú$Q&y>'}vñA”dç:žñ‘Ðbw±¿Ý?fEN³ÿù¿ëݬÈnggÔ®fþÏz—ýc5{ñßWrSš­nfn Í4Í”T¹á2[íf„‰Åêk•+–kV†ÕföŽ|_/–E^HMu©É04û¾J#´&·‹%ç,7†¬îì2W´0$¥é‘ˆçF—øƒÛPRòºÛDT‰”nñóêß'§XÍ–\æº,~ß{)i^ŒT{|†|dh80%Ÿ«Ý!Òo›H{¾X–…‚<.˜Æ‡·[®Š“‡hgÖÑñ‘ú¤¤K¸÷ñöí´¥š´7NÛR3¢Ý£æŠ¬ãÝí>>4CÌmh’Ÿ«­?½6n.:y‹™mbÆÁÂÂsòºu^£‰ ^6c䇮éïü«Ð“óìvÎÄ4µk,ºYZ÷SžKaX¶z5[ýù6èªDÉ ØQx¥”\KÿíjöÓÌ¥ˆÌº§¦-0ã™*t.¦Ç»Äµ—§(ùn¡1äÑà·)IdÙv»MB°‡0“ÌÀÑù‘C×$›b]³^0ÈUf‰ͲÑàd…á;l)´ÐWämâ;47…äxl†ßba÷ßáGQ±Ÿj=c&¶¹Z ¸üQ§p¥38¬*R¶c S”åBË–F\Ÿ¬%×9S,ñq¾X ÉOY-´÷4µÖÙdWÝ£ Z–£ÿeI>-d‰pSB\ô¿‹ÏiðÇ TuÕû &9 šTn[ÉÊ’)¥¾·ÎY2o<ÀÒæ†Ö×q^´^%¡Ä×n½ô{(¯ðBPAuWÄ‘MÂöjñÜõçk‡ë@Iº$ïGIÊ‚œE|~ ˜–F ÔE޶<ƒR-=þ8ˆ?œS`™ÒƒùX ØSHÈGÂLì¶ñÄGÓÛ“€ë«.(&Ô òÇ™êørnkÄšäURMF:í-áöœZÂIo»æÖOÏ`{ ýQ ÕƒÕS€Î©çr_E™Ñq6 x(J¯¿#ž¸ØTCuEæ¿ç¿£dŒ´jÔõzW ]óÙ/B`ýu‰ÏYš“êpØþzåÊÁ»çËòççG:ö<ÐQ ž{/mš¹¨kiL>â&º^XVrtŒ;5¸v,‹.LA’ÀÇH,ïÊŠ¯ýör,·nwµM^“Ò] v^¤HÝôCþIΟ€ˆEã¼_,ÝÁçie1_+Z>‰íIÁvü„°; ãä±÷zRvZ"\Zé!R‹ñ%æ{ªøçXÜ%- nAàa`\L›’qFú&¦¹ 4åIžØcIž6U;»Žù5ªp&gÆÙDéS­g°) ÌÏ=þÀmL\þ§4è.¶QI8¥ééEB_…s:ìkz/ÔøG[•RÓŒÕÇÆÏolé•§ÆCFÐÚþ'±ö½‹Xo±×ÛæÀ ¦OŠugEì5î¼N,‡1ÖÛ8¼19›vþv—«P»„¼Z`¶µ84.½ž4ô¢(lC_"'sÁ¯–è¤,¹n‰iðW\cO‚×’AfUî± ‚¬â–ì'äâIbï|MbgK/DZ‡»çSZ4¿Ÿä?«0´×Ï™oIzoL¨ÈS„±R¡¨O:ç°f\x“RêŸD.®KåÑÑñãȯ]_Ÿ»|OÆV÷zë‹ e2®6BXìs“/Aw}¨»ÝÃàÜoGå´rg#‘–:çFøH|_w¿påǪi ¹bÊ“çŽbÒö-X‘2š-Ǧ -7tÇǸ[ûùSì/t {.ÅúŠlP®âV0ôxPæ»fßb-™_‰ÅÀpò·ã#µc†©É®îÚÍqÏHHÉ|õö͉¿¢RªÕ‘;LÓÿO½bµ‚1£ÕÄÚg=o»óB…®¥}ÿ¡^G‰öÎ(8f[õ½ý‰ü2«gãÁ4ùe yvnŒX·û¡jöý‘eŒwc¯þ 4h»þh”{óãm 6õQC"œ0š )1Þ «ŸU¯#õ¶Þßb­ ï΋^|bt—ãg2C§Pr[Žì=”âÂØ+É·oÆSËpf´ÚžïÜ©I¿2ü€¯Ô8ìauGC ÷—Ø59t°q\N>9 e“Ù­ë­ ¬,Àôº}§#¸Æ"jrµà®Ž¶wÕmíÅ©IaµÍ%î.&Õº ¢K–Î)–€ÎfÛ·~/M‹Â´\YICCˆƒò‚ÏxW¨•Lø~ÁÈér¿T ;hê¼Ò"ôoáþ#jw®T–‰†grb—Ü2&ÆÆ:ˆ^c2Æö›˜¢óWÝÆÖÞÅ Eš/L—†t«ÎÍè·õp=&ÉµË ˜ÙÌÍ£´ßW»:`žŒ!m~W[sÍÇ™û EAŒ^âˆå2ì_n÷¹Ëûf¿‰(}éFÔ ùøÓ&ÆÝ>ÁäWÐ~oõQŠPx (°K}¨á¿ý€#ÆÈâpØ6uÄØyö‡zÝÜ4u$æ2:ŽŠçAEŽgÍÏfËD/ÛYôïÚíKì(ŒmØ@¤joê›êa;õûTmj™n PŒR¯o\õ(ÈÖÖb0kPXÄ‘tëø4&«Ï§å6øyö.¾"cþúÕëëu»;l롞]úó co“c\~™ùÿ{õ*ºÔBž£ò2Ÿlöæª ËnûÞ+d³"û~¦)ÔV°œ•Ù²_Áoj\ÙÎÞ^¾9×E`¡ ó®ºa†qEï(q¼:Ç ,à /…yr* ¥³%Ïu¡C™^ÝÙË÷™ÁÏq¯¾ÀÛ±½z_þ'è¬lEaÆfO³_o6õ&j{Q˜ w¶ 0ƒcÁ‚Gh EKû!+ÒÄø©Á^w؉.Ú¥¤ÿepûPŠ÷;ÿÌ϶ðJ1Û,+®–ƒ »´ÿ†vSwµNYW£þnÔÆ'Š…ÈåC™CÑÀ ÃË`FBl°Ð\P 1±¥ªLÅöBBÒR?¾äÒúðKK ÛŽ¿`‰"/K ž”îkÉÝ0^¾xñøø˜×ÛÚ&[ßtõ,•·Ýí‹ñcÊO³ß¥aendstream endobj 518 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 192 >> stream xœcd`ab`ddôñ ÊÏM̳РJM/ÍI, Jtwÿþ©ËÚÍÃÜÍòþ»¦Ð)ÁãüG@€ÑAˆ‰‘‘%ðû¾ÿL Ýk~¬^sºœñ{ý-æÁbk2Øu:¦oÿ±Ÿ}YgO\RrX±N7Gû²îƒÝG—qü™ÊžÖQ¯#—‘Ŷ¥ïa÷ |Ô½¥ƒƒ¯lÁçYßó§N^À¶†ë:·KH>çò˜0¡§wòi"Eendstream endobj 519 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 195 >> stream xœcd`ab`ddôñ ÊÏMÌ3Ó JM/ÍI, Jtwÿèý©ËÚÍÃÜÍòþ»¦Ð)ÁãüG@€ÑAˆ‰‘‘%ðû¾ÿLÉR Ý›~ÌßtºœñûÒ‡Ì?zÅ6%°«tÏX#ÿcûÊöî\9OoÕîônŽö¥Ýg»/çøÓËžÕ]§"—Âv¨ÿf÷a ¼Ù}¨ƒ¯lÁçYßó§N^À¶‰ë·KH>çêžÞž¾žÞI=½“óð00¾Eãendstream endobj 520 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 2528 >> stream xœ•V PSg¾!{”K Öî½®­/ª­ŽcѶÛJ-ŠºRA+h@@H‚ y&9 y?sóàb•PQDT*j§Ò¥e×ên·¶âvÕ¶Nmùã\;Ýŵ³cÛÙûg&3ɹÿÿç|ßwŽswÃÁŒ 7+R¥iAK6ÇË2åR•ëÇÙÀÅÞ¿¿Å¼…àíÞý¬÷?¹ ¾À4Vg #°]GÝ×…Îl”$F’çîq¾9çÏ͸·ù"òî]äK-¯C¼­Ú©ˆŽÎ’BH™Œ£J‡~ú¡†™ÞÎÁS Ý0 ½)­IRC$H 0·•E‹4amcs¬~“ã¨ýº„\è<„äbä·è[ÎsKTfl%ÏCÆ:à RÀf᫵{hˆ÷D ˆÒã:}n¨‰ô¶œŽ¶Ž†NÊç'AM¦aˆAæv}å "ä/†ãY–ÌŽ¤C²ª7ê•«ë`˜èêpÜDXÕË*#e(€’: ꡪ…¾7AuA© ò)®°°¤TÞ.¯L‚ H^™R¯ìȤíò#Ń…ƒû›´í95EL6ÄËæCÞ<åçg (m¾²ˆ<(ÚKsþxÖV -ÍÔʃuŽØ~-çзïãË4á=.6,Úå÷øÂ:2V y ÝBÓÅÊ-ør™l-|ÙL¡N4åæ¡ \¿"ñù@-¡ÂÉO¾àl"ÎýïCévùðc|ºG5§‡Cðˆé‡<)¬ ¹žäx ¾4j}ðË¥}g(ôÏ©®€v)Íâ ÒþD[Voñ18 ¶Âð²Èlj{_À М !š˜ÉªðUºÚnÚÙŽwk¯Q +ŠÕ†À.~…@l9!gðkÆý —é VQ*¹¨·|úø5 ½ÚÇZ`²#ƒ–2~—¾B«Æ?æáÇ8KnˆÏ)"p DÉdp²‘BÁ8Or{Lo¡w¢€X±Fº^Þ–c¶´´šûb*€¶˜OVÛ€Ž_F'ã[t¯—®M NÌÜq© º“~ù³#g­õ¹ZZa“õÍf.5\£¹Õ§Å$øzêÎ;í§>þ ZRÉ“ÈR`µPª-*…½„¦*»£¾±¦âB9Lœ/Qd ¶¾n·íM&º¡ÕÒ`b3h$|@ˆ7¿³„"C5‹Þ8q¶±æÃëô¿D]ÈW¿’~<5 )ZýÏàüôÁa-lO”‡zt[Döý\Y¿19üöÜ ø½æQ­åŽI„ùÝ@Ø žä ªä¯ZVq”v qr˜{ÞuæÕ%<ÅÛïtÜØfxy¢h 2 Üù­¸SmJMU«SSMêÎN“ÉÕ;Ýn†¸àx¿:!¼áŒg¡LqQ—éaÕ£ V äoã‰Ñ\fØÏÓ‚÷ö$Ø7—Ú-u—#·‡æÎuk v7>ì®îfCu룚ߠ5­ž "û¬‹½ÊG³Ž©ÐÙÆcJµAv’ wpsÑ–¯?ï?:Z>‹Åµ:~âÜÊxŸÕ×C.dçæq༜JœdŸšu$,GB­ÇT¾ï✹ÃI3ß-€¼YûµrWVî²[›vÖã\ó­ÎUxþJ=¨~æÔËÎqò£_,m?œ€&ý€«`ÂȽØÔà©b¦FO™ë#!Ëî»H´íg$ú¬É=ékÚW=;¶K[ ÎÇu¯€U°}ÛžhBÿµˆ´þ_Ãè„}zjälóî5¿Äª'Á¿:•„ ¾D˜EžÛÔ O!UÚ e¶;ƒ›PÚÁÊvë9áEyºG(¼§™ F~à‡ ª÷½½1ì?¥,Ì'endstream endobj 521 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1710 >> stream xœ…TPwߘ°Ù«4ëzztv½£:VåÎ+=ku:BüÑ–A[<[±@‘†K€$IL8^ˆ€üN¤$½€ŠV)7¢6w¬ìXlÍqxÞt´µ^=êØ»i¿ë|íÌmˆU:N{ûßwç½÷yŸ÷Þç#!d³‰D³I¥ÒiuÏÅoÍÉ5d‡þÅ.w“# R ‘²£OPO(õø•è‘"ô)´ºÂb½Á”•½+'7/¿`õ¯C)D*±…x…x•H#¶Jb=±ØH¼H¼D$*"–ˆ&bZ„$d„•8+y^Ò;kã¬#ÒuÒó²8™Sö]ÄRIzÈ›ò_Ê•r+êz€G>…W|D©ÁŸÓCB[Ó_6™ÈÛ¯=—¾³lwKûjo²kɽ:ÐìöB÷d<|¡•d»úB™\J"éw¾š82<Ü®Oe±^#ß«ã|¡¸¥Óqœˆ¼ŸGyÉ_‚¨3(òQƒbâoã¿Çà˜[K‘ ÉnM¡6©‘ùmŠR©L¹|ãó±Ç/]P=ÍŠp1–óhä~û6±ýù‚5Thöïî`YzV™6¥§ŽZëµ?hü^×6žNúÿp|Ï{@!éÔ-¤à’æ=ü¢rý®«gÙKrzîÈÈðùñ‘žag -qWfb:ßZµu“>më—Óãý•Mù,–‘–0”ƒû¬yøB.²ýX'c)šMÒ ï\¼†Ö®öUµåîvúÂcúˆGoàŸð¨™qÌ@ † üúŽì·‹ëã;²^jª·Ï÷Åö|£­ÓyáPôÂpwr¼œ¾Ú^aÿ[UØœÎס (¼Î²B·í]}k%w¸Ä·ÿ?æÞê+Vx*Ðæ-ÛœÝ=bb«ºª[t@©Á`âVÈ-PØ×ÑÞè;ÄžÎ;]â„V{n¿¿ÇE›hY‚â4¦„4Ä0GŠ ÜlªÑÔ²5;²ù@%AÀáR” 0qœp•ì·š¥/Oã¬Y%7ÂnMh3Ÿb ÷IÞÇׯGƒ¡;J9/qåR¡^ˆcúBGŠçNë4¹ŸŒ¨%«½æ¿VþÉò~µC ¹Pm1o)W[Ó«‹©Zò5t2âôŒ±Ï!-…b¶|Ü9|­1§G$¶`ìÍÎQ÷U[—­²‘vSÕ`t¦Ø­'À=Ðxìº6ßçþ0ù”ÐÞä§‚È(rOý¡ÞÌ–h,eQ®|2e/ܹµ={<Ã)ÖgwAPWþ¼{3‡×ÔàùéðE—¯WMµNÀñK'æ{Ð;‚Á€J²MÝ_–ûTǦ¾ÙÿîðÃ(ÆöPIQÁ¿¤‚I˜nK“ѺŒl•¥,kP+7Ž_?ãÿÍu¶×ÂA®«ÆVk«°ç{÷9€òvuyÿ¶ÒqÒf›€£¾Z‚¢QœÿvÇ~âzgñŠÃa‰Y:„`#§ü®°œ4vf»·‰&]¶ ?ÎÑU8úÆRD :™@ÙIv"ìøô,C÷§½±:qcêG×?ç/^=ýû46̉CsxÉû“¨yB*ìºOk¯5DK¿õe(‡-ðìaÓ- ‘]=p QÉÿÆ ŽZ¾ÏÆ1ÿ]‚æ¢_ ÝðpkÑ“ n&;ÿyáøp NìlL¤BîQ:†VŸß> stream xœ­[sÇ‘…ßñ+æm{6‚½}¿ì›%k¶ÉuX@„,?@$Ž=ÀÈ ´Zþû­îÉÌ©s2¤ä ‡CRÏé¬ê¬ªüªº*ÿÜUe½«–ÿÉ?ß>\U»û«^ÕëÕüãíÃî«›«ÿønX®”s5×»›÷Wç[êÝTïÆ~,ç¶ßÝ<\Ͱ¿ù{O#ˆÇ¦œš!Ýpóîê¯Å·wûWUYõS= Sñü|xÜ/ÿÙÏÝ4÷ûWmÛ”ó\Ü|X/·c]Íj>.¢¶œ§aùá|ÃP~z—© ”§ýßnþxõÍÍÕ_–Giv÷ÓƒöUSvã¸ëªåº]7´SÙ·»fœÚ²nvOw»ïw«Wºrjëi÷Kzð?¦ÿÿ=]üöj®Æ²ëú]?×S™~ÆrÛn7õe×ôSºÿê«««ynʦjhLu|>åìMÕM*¹oÄT]u9 NÕÏeÝUƒ˜jº¡ jÕÌe?V­ˆÚ¶.k²4¶»aJ®j-¯«ûršœ©±7S‹ª¯*W«d+µz“Õ½Oni½­a5UKµ†±rÕJ¢v±TëŽ}ÕjNžê»QDS;—ÞP]õÉUö|sroP§f°š__5U•Üë- Yó5ÕÜæUz¸jÖ¦º´Â1ºBw¯>,¶ê1õÂÙ¹³®»¥m¤êM3´eT«ÍºBÓvSYÍÞC.êÒ𙼥FºJÓ×ã2*œ‘fñw/¢!¥¨:M]öƒUz˜Æ²ò¦êÔ»ÆTãXGêæ¼U¦~pµZ¼4—cÝi³Ì]]6~(¤®qi»¶JÍUªš²Jµu h£7Õ7Ù¨jë¹\5O‹:5ÕLUT«¹ÎÇ^Û©½ƒ\×é MÕ%¯Õúr‰›ªêÛ®ì"[Sr©Ù’ój?êfÊÆL›žÖÕ+9~j¬O­ªi*‡`ŒöK9Úil£z¥{óÚÏýÕ«kLu}ÕUé?}O邏wu3Fõ©«zéÅRR×Ô)(ûp7YO_EóU§ï³ñ`hÓ¨ºv14 ‡º±Á©òž`l ŒucƒˆRYMcWŽÑºë§ !yÛ¡j5©®/!S0¸ l ¸¦!Ñ;j)@¸qEÒ,è» e;b£„ë°¡|Fr#w–’ý”)#‰´†.nÎ-)X´à¸¬Zñ  é0ÈWÈGå{=ä—³<ã÷—%vÔŠ ¸çåsAã»Xj|p.l)H3FÃ+pÊZÇðàTùÕð@~§®xp! €¤xpXç%*¸—j”,2%xTôY°RHpC7PœB‚ýB¢o’Ïê S RÁP5FycŒ`S5Ú“üE´€$ùrîìÊ1¼‚w HT vcD®J B­1‚L­±¶fFðæmcŒ ÆZ…‰ˆß 6T)áLå#Â0ÁªuÐ[„TN«p<'œ­|t(X£ÞHáT0ýWT¸gÌ'2Æ V!”Üás†*¸gAè6TpÏ"Tp#æ,4T°çÿŠ î¤s´”àØ€å3NÓqöhœ S0-2LðxnÌë×JpÍç`Á¥åÓc7 L Ü;sÎ#ÜÌ'E‰6õ­qÜ ‰2‚D RÑë…©V”t:hŒ¤‚EºÅû\´¾Ê€•‹Æ2d ÿd ‡²Åöítgpª­Ôï~À&{Á ñŸ å/!,ü“h /­ØçÍ4øsiË`Ÿu:®±Ÿü„ ýìñ<YäçâÚ¼ÞøI´„ŹÕņÆ}.NKÒˆ/¿?¤+©…²²á¼KÞž)¸ÖðâÏÀÀ«R$poƒ)‰1Áº…ÙÚÛ ÜþsÖlÆöcŸ¿C5(p,€—PÊ65å£Ü @*z£Tà~ÙäuW(¸áï” ®a`½¢X Çã»dÂëšù{Dã;­\•à¥@ƒ&¾R*pËä“f…;Sû“{J-ê4Z‡6F‹ñ€D* $‰¾Ò€E0YVpJQek¹r ¯à]´f 7Ö ¹*õ&"‹0ƒLáÂB‘Á"x»¦È Q¼fà¦ø(3ØŒa…[Š— ¬‚qgØ OÑÔ\¹álåÆÀáêJVá^€¢Ãy+º¡À©òdhà64*H„s$ã¹ bºák•ÏŒÜÒø¤Š— <&0¤+¸@XÈ(x@çóƒ—‡/Æ”®³i„ÁDÊcÃù{p/”Ø@>[3 °ÕÊŽu9^Ü?bpuòÙ±â€-êŒ nÈåó…B7§AÕÍS©àT°JW,°ŠfÚÂVÁZI¹À"Œ¿àA´¼Õ†í\‰÷l _‚I¸gK¸&‘pÏ–Â}hç©|]­ážE¸kqŽö¬Á7îŸ`>~Žö®Þ°`ÖhïTðP£=;*\$¸‚f¥©ûÚR—NvŒ®Ð]2u"øî Q\ˆàTH=!‚SÁë‚5ÑZÁ5s>R °Gm‰#,`#ˆ…¶œœ 7@ñ»ÐÀ5_>­Q¸Qï¦h§Á×ö«…®îÈ(Áo½:X+°ÏyCâL7Ãh7n`cFøàzLòÏ|pŠ6¢]u`Ž(hp½%܈v*ˆ¡alSÜPå6X…›«J6¾?r¦hÇ…B!-À‡(­P Kñ"€MÁ›?£™ÂƒGJ¥ÌØ.‡ßìÊ1ºBwÉFáÁ¾„&VzˆN…)=H…ŒQ|°©p±àT¸' ø`†û ÞDWE«,< ÎÑþ‚/–:ŠVáÂCÙÀ½4‡»¡;`¸¿àÜò 2ãƒsVÈ6ïû$¢÷ïÊîZÑbÁ âýmD;KC°½àj¡ZÙ@>§3VÊöT>a44p<Ë'±†ש4poö ذ !|`À,ÏøÀä3>ôí´ûù H…Çx”l ÏÌ(ØÔlB³CŒQ"WmR‚LmP‚LáŒ_)!¢€¡O-|©ç1ºBw  T­ð¨+‹èŒ•P‚}¡Ý(A*:<$”p¦ +%ØG)ÁŘ­”`[¸9®”àz!—”®öðâI)álÁºRÂu@Ø÷VJ T%xXÀV®Q‚ÝXrå…”àªÃºQ‚ûœ}RJpÿ‹Î+¹& !ÁÅAhWH(†Çx¦àŠã¹X¥ùœÞ`)%¸V°¿¬”`§ç³L£;!'¥R‚ÃlÄ%¸#'•\½ó‰¶A†|z+)¤­¦]º!ýcZ=–ŒWKjÈ<,ÉÓnHÑdšæ%7ä¯Å×·OûWËPœÆ©8žöë¿Ö}ñËîO‡ã?öÉSó8öÅÝã£ýôiMÛHãr¬—^_ÝüûbgßTe TÅÿì›n͹}ܽ9=ÞÞ¸}´;¦ºYî(¾>Þ>ÝíÿÍY9eµùÇî›ÛÏ|k ûï绯öiôTM۷ǰŽtÛòŸíò€í\$ßïSo§¦¸“Rƒ{®­¨$MÚ:/j»†×§Ÿ×ÚT¿zž­„µ‚ÝZÁâ÷§Ç»ûÛãú4냟½³Ä51ªŠk³UMdkÿüãÚzóÐÇÃcæ SµÖ‘puKW%DæÔ/9$ó}tŸ5ï–@Zdjá!_¨Íêç/ñÆõK]&wypôÊÏ”!MÞЩX¹¨¢GLÂÇÝëÛSB‡h¸|{{üeŸ&RU5¤&µñisàlÞp®g3Pwºõ§}êwO©kÈ ùÄãÇž.b»ˆ‹aÞeaàâÉôȇ»?¿¿øåöøÉL¿><ÜÉÀû¦8¼ÝŽÔ pzÆ×§Çû÷æˆÓÓ;k˜‡»[?’~y*×*oǦ(¹´ðÔNÅ ;ºÿùÅn^¼YËß>¾==<œ}¸>îO»×w‡çå饩Q‡½9üôÓ]6p—æ¬^hØ-=µî¥ ¾O=!U O£ëùîé½õ·äÚÈÿgo›êß›_ô†U•šrUbÔzM³»vÁÚBÖ4Ïëoßî?<ïžO»?<æÖR×\fŸÓX<Ü>Ng>UçyAâëši·ÞìëmõP¬Ï>¦ù^!´kÆ î•®>[ùÝêÌ©jŠ­²~8›IOµ{{÷b}^.4T¾¹}Ê{þí} *®÷Ç»Ý7??~ºK¨þÝÛç%M”ªÿæ6u]EYrùáí‡çKÖæ_~ebjòÜ:qMµŸÒDdINý¡¸ýa¿¼¼¤¦nšæw›éŸ/¦~¶ËÂdÚÈ,ÓE3‹pƒHÍ,‚Ë%U×Í,¤Ó²pf•í”êš¼÷£kfgÖ²dfKxúM¿ÎpÈDÖÂ,¢ RY ³ŠòçŰ«9dÛÊZ˜E¼Ì]×Â^½1u­û÷ºv®Âw޲v%☬…½ ŽDÈZØ9 ³dd-ìTøSÖ®D<ö!kaçyÜz”Űkjxï­‹aö‘Õ°:ºR”…°û^ïÉ:ØUwæd!ìšÖ¸²f®Le!ìDð:QÂÎãphBÂ*zH«ÞÔPMgWŽÑºëü6J×Ë®ÀüÀ˜.—¹Uìü„,”]P„Á²Pv!_•êBÙYüëT?>ó·=ºPö£% %+eßÁó­ ]*{U¾½`d¨ûL6rÊŒ $¢ÝE©ðݘqTtªC¹@*z“¨pÈUî…ÂLá^¡Â,Áë,ƒûjˆà@"¤¨²!JÙÀ¢0]Ç›‚]$ƒs:„j…ƒ+¢pp® áàJ„’ Wb´Æ*:Þ¬pà.ƒ]á@*;J­XàæË'F00*£€í4˜ƒ£h`à9e÷t:qç<Çä” "Jazm¤Æ®£+t—„i…˜h«ÍõH R °%ȬQ*ðó«” Ô*ˆFE×iÎç¹®¢û[ð5×ð…¢Á tŒúg4pτ须~ FÐÐÌ)X [9~ÊVQÔ68[°#¢lp¶ðø™°Á× Òt„  rû9 g ,ØïÉñÀ¶(©UøÀ*:¯(€pžˆÎf{GD€pâÔú ï8#!€p*Ìu@8ÏãI „ïÀ-«pVáT°)¬€`žŒ>8ÑœÄs- ‘] áDxR Á΃ ÷|0ÿRH°ŠRœÁ"Œ‘ g öí$ä;Q¾™¨`Q¸æê !€ë/€ !€ó9NÀ. àê¤Õ‘àï¬ ‚¿/~]à ådÓØ¯¢‡t%5Qá¼ë e!„«d– \¥`U |X>©ÖcÓø@*ŠÊR…É=,£qJáùl…C.rÇ'” d)|«Ä–èƒ1B²„§Ï $ ¿ãêï‹ ì&$ŸbUx®@°À»»†v9ŠP,°Ïñ£*Š®"F±ÀõÂAŠçXƒ(œ#à°†rŸÏ£(Ø®g” ŠŸ–Q6¸VŽ>ãZ&%†Q¥È^5} Á¾K"»„½’Ä/Ÿùéú:~}Fá¼Ï> ýP•íF¦“1‚DŸfˆ`Ñ2æŽA"Hð6Dh ìc2D䢭=¤+S»|6Q¯Ã+x—œ°S’PðÕHBUÇ%% ‰0VIÂ"Ø’piJ#e7Ið­g“…„ $ÂY°„„ZT~pÛBn¯ñƒT”6©ü QFùÁ¶ðeòƒÇ/)ØÑ{''Šr{ØMoÜàGÃJ ~4\w(9ØÖ”»ÜÐÁ cZ±Áóò•<Àí  2ƒ˜¡ªÐ`~u@¡ÁUÂ$!…ÜÚ<¤À`;˜’¤Àpª|Ýl¡ß©‚¯x_fYÛ†'Êwæ”ÎùG#Œ¬‚wÂÆ‚6Ñš²" X¤!W1@¿c˜T Šáü^1 ¢ËWôÊ1¼‚wáW¸@DŠb éÒÄ‚·b€,Y`V°“ ¸+ذDÀØx[ðZJøàëñÁ©€5Â/Ê·E”~ K_wà‘ðÁµì@üÖ4Ï6Å©Yó`0'+yÖ¥íäyPYúUYU]m9X”ß“%õU%ÅF[ÙYKÕ6’ý6Ó7Ç0{“}òdz0of_^Š\¸õ Ý—e´öÿB¾èçr½ò¤Üþ˲r)®}!îËÒÝ|žÚË©ˆ©A>m¦W~qÞ\¤KÞœæÒã3ŸÇ©Ë3Ÿ§jØÈ|þmIn1&.‰oÉšøÖ×[™r/åA¾40Ã<Ì[ã{í ]ðÅüèµlÌ4n*ÊF®ÒÐù¢ê/ÍòÎJy19™Òˆå–ƒ·Kñ]1m¥ªRñ>g8H4ý¹ÜÔo£!eKn›ºŽ2²õ·(ÃósÙÉùÓcNy–ùËÙ›Í2 l„Z/'2jŽâ¯JžüMÉœÎʯÏ&ý²<ÐÏçxžú3Ù›—DÐÿïìÍu :.³7i¢Š³¿úÃ~5ÿ*-TÊ6Mˆ_5mÙ§iݹ:ÿu¸ÿ9§ö_ÿbè‚§ñ?Sÿèºà_É ÛªŸŠ§gûk¢íXü”Ý<=ëß%íŠ÷ëÝÔ$Z®ž^þéš½|¹ÁÊ%íTÿªééép/Ìô¬Lc^,¤zºÍ»?WoH“Ån*à/š>îÓ\1Ρx–²RÈÉo~'v‡ú…ª‘G¥–Íê°KY'ùêçÿ’J5ú1 ߉…®/þðtøøAªÐÅ»ü‘ŸoµÊcñÌ=—y§ù?;>]øendstream endobj 523 0 obj << /Filter /FlateDecode /Length 3026 >> stream xœµZ_ܶ߯<,üRn{«ŠIQASÀg\¶q€WôÁW¸:ïzOµvu–t>_?}g†¤DJÚØnÐäÁ^i8šÿó›¡?¬Ó„¯Süßýùö¸JׇՇ§§k÷ÇÛãúòzõÇW&‡'I‘|}ýneð57*1²Xç*OŠL­¯«×ìeõv#ð·–ìn“&©Êrž¬Üo¶øËp£ «7Û,Ë’4ÍØeHÖ!U§•"E&Xt¶½ÀÃ2I9ûÛU…4ð¼ÇçN³›ö0­Þ_øWš½?×V]_•'+M¡ vù¼µšÈ€&Â$©äšõåæŸ×›è4´I–é„+´ÌõnÅD¾¹þ÷j+%_o30’Öøø5{þޏK‘§’õ±V›­{‚ê¬nÊ](}¨ÊÉ4˜%gýÙJ˜\q´=× Ï– ®ãkXç>XdðQÖ»`¹öÅyP€ î,ÛB)0F msŒ„ïÜ×¹bUç8K2Ž|½ŒR°ûPFø|"3{_,_ DÛ€ãD¡€³`äƒ4S–QTŠ…îêB™¬“¸P‘—8ˆ¥sç¥Û}ÛW§ûºéoàK豩Wsže©_³¾ñZrö±êÂ/—uõ+·ÐZäl*È6q Ï×[ž%JÂq´Ö‘Fd¬€¨Îå܃Y‘Qdܰ͢^²HxaœZ÷ÕÌxN%)Ï¥ñJ½ C¢yä©wî»Ôë÷ÃäìÌ€!aä ³ÊÏ;‚y>JÂÑ‘(<Ð/«‚&©P_î.¨("óª•uÝP P);•½ ¾Ú´NüT±Ò¾>Åih1MVT £ò3‘PöU2½Ù$¤+ER¦¹‹c¬Ì—eÛa­’9ÕªY€H…?Y×—!Ó]@U¶ho)©šΩa…jô²`M`œeè"™þbh“ä"÷þ ½0ƒãoœ¸ë7½®Ù±|OŽ4™¬ v´Þ…23/ÚJfX¼ˆÔD‘Î)§I¬CÍ]p¸ ׺ÓFEa몱3`û4J?ÉZïç,G &™ÿnd ªeYšRážz{LÌ6úõ. kZÏ8ÍAza0 #¢WP…±hÖÅÓ·k¬À %OØyO‘ùƒ‹ƒ9¦°ÆÒ×®ò´¯“îÃCÙî»sae ÚéÊN7q]±²Céì&-'2réÍéؓ™ Ø‡'kŠKz¡£¸¨K‡rÍÞ[ ]P%ünÅa—¸º' x B}ä“i’ƒ#¬¦Þl•°½pvÞ]7§î®ºïž¥Õd?­®³u8vï1z­áu*Ø÷þ`æ\ÒW58d³Œ}PH™û^O¢M@ÕÀVÝ´Õ!Â2eí^òÌ¢Ñm}7röCuÙN»ìÕõê—•EµjÝžG³±ôÍ Î“ œNu"µ@4Ë †ŸcûõütbRò{ ¼#Z­ÁÌ“:HåLdl†­ÈHÙ¬>úç‘%ØG‚SÅ5;cCëhΦk§½ëryaéȽżüm¥ Ç®7¡>€„Ʊ0Zôjw\æ^|“ÌÕŽ$Áâš[E)^—oÎ'û}H‚ [“9brpM\“¾„v‚PØiÁ´¡±Nö9¢áiI%z°Ô­õ"4“&¬¨;¤€D³ l,®g«n{xrG ¾;@òD68ú·R—WÁ‹ç_ôJ@ÁÆ¯Ä 54ÿ<ÆòuèöcÔb€ë'€cP§m;?:òB’§öïüßWóiÁquÓ‚çµ€j\´“¾šÀ€,eÑP4Ô>R¶ Ý;OÀ‰¨Ñ·9Ùw~œ4½Áuq»uŒ2ŽÝÖϘfÞ®i …n;†@ĦëÇ™·ó6wmŠ`XŠC´„By¦+Ø^Àj{3þõO[WÒ ‚ž¶*ûý›v¿TósvÜ÷wÍÎW}Výg—WÏŸ]Œ¯ÞBü;”Ó²7õË«‘X€ýîÈ8ÅÐA&(€úF[í;"¦èá©ÄÀ’á¿ÁËÊÛà‡æádå×ìöm7 l#ËjªØ¿^^ýnüU Z@£¿Û²Bö£[-Çw}3Új1¾ØŽvh÷ýC{ªN‡ñíí¾ë¿ÖŸŸéÕÍÅ(ÉoéÛKÍ:S)Aá8À¸qý=Miö·) ½o« ¢ ¡²Œ}r¼!é«ÎQŸ©ßÛGõ› 3Ÿ4Æà[ÕÉΤÿo”ó¢JùZJ,!ò·£„§J‡ü%„ÈGÆ­¤9Õ°çÞt&.âuÜì[gm˜l¿ªá[÷çÎE†æ}"«[»jÒ œ@k9ΕŽÝ1É}P Ñâƒêã:g E)Î1$vS7d–x:¾º›è%îsŒ&ÿKngÞÒ?Vì2ŽÔ~ ËôÔcפc£aí©r`­âÊŽÔ)€ý8j«Þóɘë:{Eã¥*fX†"[ëO¥eì¿2Þ!"J˜vZÉqceØB;šˆc[- »Ãê‘„à1\¯¾‰cQkaØ{Q&Yüq€ =1'ý`@7X꯸Ű\¢ÕimýÁšhÛú¯ûÎ7èò0Áqa0c1ü8…8ŽÂ‚½²x•ËhènËú; qkƒŸ›±ã/!}.âPë›Öï©!¦úCŒ&Û¶´‰Äì6„Œ<žéÂ…õâdÑøÅ;'ôC˜Ê·èGP½!l×EáP?ùÓ¹ß Ú=ü)þš•§6¶ålÙmiÍ…ö³ •)ã}"·@Ïb˜3EàŽ¿Ø@Cœ;ùÒqÒŸÇO„òž€ðÓ¢mÌ$ºiøõ›©IfÆ{¿ o9 ø¥n6;”[oøÔÌ€¸­å¡7–¡aë¸Ò—µ³é^ß… ÈÙxÜk°Ðc ¤X½ZÐÌh21™Ód‹þÞ†¡˜,o—˯ʪ~Ä(†Y0cv†ƒ¯úkÊûEÛbÒD‰}¸sZªÿ!5m¤F=[[ü?—ÏœaEÉÝFg¶*Á[ è)X¸ü@b~iár5Ƹ̤_…Œ+L%CÙbBÓ79fElÏaÖÆ<ý´…4Á#ŸéiÄ †ìCÛÄU`Q¯Å;*€‡w–Q¡¦IäjBÍÄíÒzÅ™`’½'ÇSNÆ9{í4¥®côµs2K¼'ªëáN+D8“EÝ û6ˆ„ÖΊ0=ƒqr:, çÚÞ‡áU#9à\w³gûÝœ_0|ê=Y΢,åèî2ì;;÷| <ª~4,3=¨2¬LR¼\à¹Ý÷7˜[„Eµ1 =Œ¨¢4¨¹”VÄix9.Ý_±WÍÒÙªôÂ3CÄ<Ü;{-q,µšÅ;1× d¼µè*w©‚§$é€þF'// âõydUë#‹©§•íŒ[Û±ˆ YeÉB3}õ†¡½­N;wûMà€A]åv,¥ýnY ˆïGÃþ ˜h1šr!`Ùîi¬ßï<Ïâs<‡ÑX²Æ½Ž§?unaÒ„áWîò½hÚ7¯ì‚áåÕ8u¿lšvÿ&«}¬~Þ?ËÓÉ?§ºï¹FsÌh)¿ä@ fT”Ä9e·ÚÞÁ0¡ÓA©ë ŸTò,Ùð™ ø»C0òü*ï¬+ÜfÑŒž2µóV?Ìô–©¦ M:H†û¥òSuôWŽ–rï(s9ŸƒRl~,Þ–Ýt˜÷ÇçÓ‡ä$k¾‰~Mî£úš ê³ØyÍxñkýI i7Vù/º´âÓ¿²ð÷pÕ0\îx0g)¨k4Ï"lÉšš.IcÄê9áöâàå…¥ÝÎ'· /°ÏT~7.yt?YÆþsŽœSqÐÊ­t¡•Uç5¿ó&š<³Ád‘¡Žm:ì†õìzß>óûbºtï¤ììÿ†Þv+^ØŒXŽòëÞ‚dh3ãDÇ4¾2ìé~3ÙÛqÛ”0Äí…nqf)ÃÞ*ÒÜÜüʽÊò-r4MÖÕ!„ Õ·QüÆ»B†f}ínYh4ìÙ~YýŠ »ˆendstream endobj 524 0 obj << /Filter /FlateDecode /Length 2006 >> stream xœ­›ÍrÛ6E÷| îJ-Œ ÝÅÍ_ÓüWÓ.š.TÛU”Q¬DV&“·/ á c\NÒN&ÖP:¼HAÖGócÝ Y·á_|¼x_µõºúXÉã³u|¸x_Ÿ/«_›ðŒp­“õòŸê´‹¬­¬‡~N÷õò}Õ(»X¾ó°Fð „UÆï°¼¬þl]-ÎZÑöVZc›Ãas½›½ë¬mÖ‹3­•p®Y¾=>­ÙºfÌÜH gMxá´ƒ‘Í‹ýeFªì-ŸT–Õ«p(ª^߄ղJÖÒèkݵR[+e1¸zUÿQ_W¾Žƒ®?ûƒ~âÿ¿ó§éQ%u u?ôúZvF JûG%v®~«¤ÕF7† ä¬âIJj?OÓ¤)¤#Ü\’?Zaº¨Z¡ ‡üÙm­×GuÚÿ4þç~]©ABÒøóªRÖhagòuëêgŽYK¯©¯§uÛ‰v.ªë[á…æPïÑk>¥zè:¡ç’¬“¢&M ‚fFÊð8†ú‰f#hÈ!’gå¨03S0 +™F!˜ÆëÁ*©”¤¢¤¢œ¢#ORÑ(HUžÀL*^VQa`Ugœvƪ4T’Š%%§(¥(¥(¥(£ÊP¾N±¨¤… ­—œ¢QPŠBPŠÍ^RŠ&Á(* ŒÒÊí ËpRjD S N•³2§(§è¨’Tœ‚U´ ¬¢¤¢õ’Uœ‚V¬`²ŠB°Š×ƒVt“W´ ¼âÊ@,ïŽ0rf©AÅÀrTþÈ)˜Å†•Ä¢¼âõ ‚X J^QZQZÑ‘'¯h´*O`¶ZñzЊ «ÚÎN¢’V#ª¨U9+[®(©è¨’Uœ‚V´ ¬¢¬¢õ’Vœ‚W¬`òŠBЊ׃Wt“X´ ¼âÊD±:ë¬h;¾\¡ÂoV4 Zq(jÅ¡h‡¢TŠRq(JE!8E Ì)âPtŠCQ)2y™R<**ÅeQCß 5ýš85j•Œ*'eŸ´^RŠBPŠBPŠBPŠN±¨ä… ­—œ¢QpŠBpŠM_RŠ&A)j ”2R‰ÎÌ(5‚J~$*wŠSŠ +IE!HÅëÁ*©”¤¢¤¢œ¢#ORÑ(HUžÀL*^V±z¬y¬[[¡œëB?84ŽÏBYÖŸ6ÿ™êTøU-tï…²ì„ ù˧Us¾øá´= Çퟱ_¿ï·›èáz ÇáÇ/‰<½ò$‘§= ÐÓIܳIÜó½˜@/Ãvl‹wR ëÂ\!ÃNþÈž®®/ý™Zm·»‹Õa³»GêáN¨ðuçØ¹èCWU«f·Ý\\Õ7‡š×@ûú|W^È^´²“Íêpµ¯o>}ø°ýò5ÐËÝÅa·¿£âï ë+JÓ\ùˆÅ7×+¿åßµ­jûæ®Ð×Wõ~·{_ß\¼Ýí¶ytáëÕf› q¡Â¢Ó5_î<ª8œ{ë8%]³¹ø´=|Ú/dÛ¬¶õÅn÷¡¾c 7ë·Ù Ž=þWßxC¹îøVñì?‹Óõ¦Y½Y¤ÀÛ‹JÞ…«w6Åù%m¬Céû Öá1UZ‡IÖío‹Š«0‡â*Ì¡¸ s(.Š‹0…°s(.Š‹0‡âÌ¡¸“É»]ƒyR\‚)”ŒêµõÊÍ5¢ŠF•³2£(£(£(£(£(£”Œ¢Œ¢Œ¢Œ¢Œ*O^fM‚Q JFigÂI1jD*geFQFQFQFQFQF1(E!E!E!Eg/)Už½L)ZJ1()¥z“~ûC…/´4) E!E!E!E!E!Å $… TʾÎÎPPŠSPª<}Y“d& RQ*Y%à ™¹P>†JV±¤d…`…`…`…`…`ƒ’U‚Ue(·ŠS°ŠS°ª<}¹U< VQ V)wú%ŸZ5† VÑ$XÅ¡h‡¢UŠVq(ZÅ¡h…`‡¢Uʬš¡¢U3T´ŠL_fÕLV´ŠSÉ*ûU‡nò‡cQø«±RFÖuc\"L"<","*#É ‚À‚@žâéOâ” HSœ $L9²”5€(ƪÐ{àËÏ*-?å¤ÜNANÁNANÁNA J%‡88“Øü$™(ŸØ$&¥h¬¢Î@¬^;Ñ•¾ûA¬T«œ”‹Å)ˆÅF•¼¢´¢¬¢¤bPrŠBPŠB0ŠB0ŠB0ŠÍ^2Š&Á(ý‡î¿¶½Ð­9v]¶ÿOºìOîjÅϵÿŸ¡óßÜ›´ÿ_NÚÿçwµÿ§—ŽWîO w´ÿUoý<¹pdßÔ°'½uWîè÷ßÛBÿ®«§Ð‹ý7_ÔøöKÿ[ûß/>µòKKïúÓ|½iþÎn@x³8Ö>“5~jÏ*åp÷ÃÍúSï¯N7(´½kìO‹³Î¿ËœUã[£šÃn¡†p;ÃÐ|¾Î›Ñ-òWÂÎ]8«Íeöôê°Š©²knÆ÷YÄü§{&´pF7»ýf½Ék®¶¸Ãø/ÇÎo¨ñ*É)Í©f•']Æ ÞOÈí¾,v´…„®oòÓ{3ð7ƒØæüAöü=œ õÕTŠÛ»A^UÿtùN±endstream endobj 525 0 obj << /Type /XRef /Length 375 /Filter /FlateDecode /DecodeParms << /Columns 5 /Predictor 12 >> /W [ 1 3 1 ] /Info 3 0 R /Root 2 0 R /Size 526 /ID [] >> stream xœí–Ï+aÇßÙd–™±X¬ÕÊ®=(¥ÄA䤔›òëÂÁ:û$å‚“£Z$'äàD‰ÂÑeJ{rA‰“´7Æ|?ûGÌÌáÓÓ3Ïû}~¼Ïá}1˘ü219¬ˆ!¥o’Ÿ§m´ov´á£oz*gÁí—¢Û7}ÓŸ> 6¡4mB¸é›Ñ¢6áî*Ú„pÓ7E½’¯Ú„Ô·ØTÂ>„³b~@Œ;bö1 Õ8-;ùKü˜Øü$zÑí­ ÌŠ5ïØûDL±îµ)<“äÚ&þö‰Î1ÙGDû’,›Ä_ˆ ‹lrO¯*ôrØœM­Šdi¦Ç¶ 4çQ[[‡ÅÚ±åzžÅ:{ÔyC=(Ççˆ?¢£eüûdôÈR=£JºWø;(殫v×gÉžG‹òNóòâÐ5œÓï®ÔrKÌH›¾\jsÛ¨óži¼ ÀÄܾªßã–4­ÿ;êëéݮۉw3ô˜5,_GI endstream endobj startxref 321344 %%EOF seriation/inst/doc/seriation.R0000644000176200001440000002704414724364730016132 0ustar liggesusers### R code from vignette source 'seriation.Rnw' ################################################### ### code chunk number 1: seriation.Rnw:120-123 ################################################### options(scipen=3, digits=4) ### for sampling set.seed(1234) ################################################### ### code chunk number 2: seriation.Rnw:1025-1026 ################################################### set.seed(1234) ################################################### ### code chunk number 3: seriation.Rnw:1029-1035 ################################################### library("seriation") data("iris") x <- as.matrix(iris[-5]) x <- x[sample(seq_len(nrow(x))),] d <- dist(x) ################################################### ### code chunk number 4: seriation.Rnw:1041-1043 ################################################### o <- seriate(d) o ################################################### ### code chunk number 5: seriation.Rnw:1054-1055 ################################################### head(get_order(o), 15) ################################################### ### code chunk number 6: pimage1 ################################################### pimage(d, main = "Random") ################################################### ### code chunk number 7: pimage1-2 ################################################### pimage(d, o, main = "Reordered") ################################################### ### code chunk number 8: seriation.Rnw:1080-1081 ################################################### cbind(random = criterion(d), reordered = criterion(d, o)) ################################################### ### code chunk number 9: pimage2 ################################################### pimage(scale(x), main = "Random", prop = FALSE) ################################################### ### code chunk number 10: pimage2-2 ################################################### o_2mode <- c(o, NA) pimage(scale(x), o_2mode, main = "Reordered", prop = FALSE) ################################################### ### code chunk number 11: seriation.Rnw:1130-1132 ################################################### methods <- c("TSP","R2E", "ARSA", "HC", "GW", "OLO") o <- sapply(methods, FUN = function(m) seriate(d, m)) ################################################### ### code chunk number 12: seriation.Rnw:1135-1137 ################################################### timing <- sapply(methods, FUN = function(m) system.time(seriate(d, m)), simplify = FALSE) ################################################### ### code chunk number 13: pimage3-pre (eval = FALSE) ################################################### ## o <- ser_align(o) ## for(s in o) pimage(d, s, main = get_method(s), key = FALSE) ################################################### ### code chunk number 14: pimage3 ################################################### o <- ser_align(o) for(i in 1:length(o)) { pdf(file=paste("seriation-pimage_comp_", i , ".pdf", sep="")) pimage(d, o[[i]], main = get_method(o[[i]]), key = FALSE) dev.off() } ################################################### ### code chunk number 15: seriation.Rnw:1266-1268 ################################################### crit <- sapply(o, FUN = function(x) criterion(d, x)) t(crit) ################################################### ### code chunk number 16: crit1 ################################################### def.par <- par(no.readonly = TRUE) m <- c("Path_length", "AR_events", "Moore_stress") layout(matrix(seq_along(m), ncol=1)) #tmp <- apply(crit[m,], 1, dotchart, sub = m) tmp <- lapply(m, FUN = function(i) dotchart(crit[i,], sub = i)) par(def.par) ################################################### ### code chunk number 17: seriation.Rnw:1309-1311 ################################################### list_seriation_methods("dist") list_seriation_methods("matrix") ################################################### ### code chunk number 18: seriation.Rnw:1315-1316 ################################################### get_seriation_method("dist", name = "ARSA") ################################################### ### code chunk number 19: seriation.Rnw:1333-1339 ################################################### seriation_method_reverse <- function(x, control = NULL, margin = seq_along(dim(x))) { lapply(seq_along(dim(x)), function(i) if (i %in% margin) rev(seq(dim(x)[i])) else NA) } ################################################### ### code chunk number 20: seriation.Rnw:1347-1352 ################################################### set_seriation_method("matrix", "New_Reverse", seriation_method_reverse, "Reverse identity order") set_seriation_method("array", "New_Reverse", seriation_method_reverse, "Reverse identity order") ################################################### ### code chunk number 21: seriation.Rnw:1357-1364 ################################################### list_seriation_methods("matrix") o <- seriate(matrix(1, ncol = 3, nrow = 4), "New_Reverse") o get_order(o, 1) get_order(o, 2) ################################################### ### code chunk number 22: seriation.Rnw:1398-1399 ################################################### x <- scale(x, center = FALSE) ################################################### ### code chunk number 23: seriation.Rnw:1406-1407 (eval = FALSE) ################################################### ## hmap(x, margin = c(7, 4), cexCol = 1, row_labels = FALSE) ################################################### ### code chunk number 24: seriation.Rnw:1417-1418 (eval = FALSE) ################################################### ## hmap(x, method = "MDS") ################################################### ### code chunk number 25: seriation.Rnw:1428-1433 ################################################### #bitmap(file = "seriation-heatmap1.png", type = "pnggray", # height = 6, width = 6, res = 300, pointsize=14) pdf(file = "seriation-heatmap1.pdf") hmap(x, margin = c(7, 4), row_labels = FALSE, cexCol = 1) tmp <- dev.off() ################################################### ### code chunk number 26: seriation.Rnw:1435-1438 ################################################### pdf(file = "seriation-heatmap2.pdf") hmap(x, method="MDS") tmp <- dev.off() ################################################### ### code chunk number 27: seriation.Rnw:1504-1506 ################################################### data("Irish") orig_matrix <- apply(Irish[,-6], 2, rank) ################################################### ### code chunk number 28: seriation.Rnw:1516-1521 ################################################### o <- c( seriate(dist(orig_matrix, "minkowski", p = 1), method = "TSP"), seriate(dist(t(orig_matrix), "minkowski", p = 1), method = "TSP") ) o ################################################### ### code chunk number 29: seriation.Rnw:1525-1530 ################################################### get_seriation_method("matrix", name = "heatmap") o <- seriate(orig_matrix, method = "heatmap", dist_fun = function(d) dist(d, "minkowski", p = 1), seriation_method = "TSP") o ################################################### ### code chunk number 30: seriation.Rnw:1535-1537 (eval = FALSE) ################################################### ## bertinplot(orig_matrix) ## bertinplot(orig_matrix, o) ################################################### ### code chunk number 31: bertin1 ################################################### bertinplot(orig_matrix) ################################################### ### code chunk number 32: bertin2 ################################################### bertinplot(orig_matrix, o) ################################################### ### code chunk number 33: binary1 ################################################### data("Townships") bertinplot(Townships, panel = panel.tiles) ################################################### ### code chunk number 34: seriation.Rnw:1614-1616 ################################################### ## to get consistent results set.seed(10) ################################################### ### code chunk number 35: binary2 ################################################### o <- seriate_rep(Townships, method = "BEA", criterion = "ME", rep = 10) bertinplot(Townships, o, panel = panel.tiles) ################################################### ### code chunk number 36: seriation.Rnw:1655-1659 ################################################### rbind( original = criterion(Townships), reordered = criterion(Townships, o) ) ################################################### ### code chunk number 37: seriation.Rnw:1726-1730 ################################################### data("iris") iris <- iris[sample(seq_len(nrow(iris))), ] x_iris <- iris[, -5] d_iris <- dist(x_iris, method = "euclidean") ################################################### ### code chunk number 38: dissplot1 (eval = FALSE) ################################################### ## ## plot original matrix ## dissplot(d_iris, method = NA) ################################################### ### code chunk number 39: dissplot2 (eval = FALSE) ################################################### ## ## plot reordered matrix ## dissplot(d_iris, main = "Dissimilarity plot with seriation") ################################################### ### code chunk number 40: seriation.Rnw:1752-1758 ################################################### pdf(file = "seriation-dissplot1.pdf") ## plot original matrix dissplot(d_iris, method = NA) tmp <- dev.off() pdf(file = "seriation-dissplot2.pdf") ## plot reordered matrix dissplot(d_iris, main = "Dissimilarity plot with seriation") tmp <- dev.off() ################################################### ### code chunk number 41: seriation.Rnw:1785-1786 ################################################### set.seed(1234) ################################################### ### code chunk number 42: seriation.Rnw:1788-1790 ################################################### l <- kmeans(x_iris, 10)$cluster #$ ################################################### ### code chunk number 43: dissplot3 (eval = FALSE) ################################################### ## res <- dissplot(d_iris, labels = l, ## main = "Dissimilarity plot - standard") ################################################### ### code chunk number 44: seriation.Rnw:1803-1816 ################################################### pdf(file = "seriation-dissplot3.pdf") ## visualize the clustering res <- dissplot(d_iris, labels = l, main = "Dissimilarity plot - standard") tmp <- dev.off() pdf(file = "seriation-dissplot4.pdf") ## threshold plot(res, main = "Dissimilarity plot - threshold", threshold = 3) tmp <- dev.off() ################################################### ### code chunk number 45: seriation.Rnw:1831-1832 ################################################### res ################################################### ### code chunk number 46: seriation.Rnw:1851-1853 (eval = FALSE) ################################################### ## plot(res, options = list(main = "Seriation - threshold", ## threshold = 3)) ################################################### ### code chunk number 47: seriation.Rnw:1867-1870 ################################################### #names(res) table(iris[res$order, 5], res$label)[,res$cluster_order] #$ ################################################### ### code chunk number 48: ruspini ################################################### data("ruspini", package = "cluster") d <- dist(ruspini) l <- kmeans(ruspini, 3)$cluster dissplot(d, labels = l) seriation/inst/README_files/0000755000176200001440000000000014706533255015355 5ustar liggesusersseriation/inst/README_files/configuration-1.png0000644000176200001440000004110714724362460021071 0ustar liggesusers‰PNG  IHDR  äV× pHYsÃÃÇo¨d IDATxœíÝu@iðg¶ˆ¥;¥DEQl L TT°õôÄÀ8ë=»».ì:=ûLìÆ@ÁBA,‘îX6fÞ?ð”XÔswÇïç÷õf‡ÝßîÎ>ßyfžy†b†»p]|{xBÀ°€…ð,„€`!< !àXÀBxBÀ°€…ð,„€`!< !àXÀBxBÀ°€…ð,„€`!< !àXÀBxBÀ°€…ð,„€`!< ñ]ÀGüîîñƒG/Ýy–˜)R7°rnÔ¡—׆æjÿÅkI߆¬[±õRlšXà6|ÃoþÂSSûý!áèuYvhЧ2üþ™¼gׯÆfÓ”¶SË6µô(B¿Ù?vØ–X)×Âÿ]£Ý¸Š.@U)Ãà‡ÁäGn ì÷ë?Oòè ÷mY1»VÀŠ=[FÕ×ú¶/'{±®_·I¡… !„ŸÙ2!ü¤ÈëW¯sL3é*ÿü» _œØkö ÏeZXôROaŠ^G\»zGÂuhC‚€øBx€ïFú|sŸvcÏeЄP¡…[='½â¤'ÑÏÓŠóbŒõÉå„:}Ëßdqdøƒ"†Püzc¶/ hRƒCdŽmúô5–R:žfÊz~ŽÒvmÐ×^Ê1­g¤¬5¨<ÀwB'íš8í|M(~«l jhÀ!„ˆŽþÒeÀ–QÊÙ™óNìõÓ}¿zNÌ©¿w¸ó6—š×lÔ±ßÐÞ MþýÅÊb6 ÿÏ[ÏeĶeõ"Ö¯?—Å5qó8.°ƒ­:!Lê•õœ¼ð@ÄB‘âwÑa7u]›9êf¥$'K8¢\q©Ò¤©·÷oÝwþnãÐyÜ4¿Ôå~‹ðœ‡oÛ8ІC$aKzκXÀšüzxi'mB!yç¦÷^~KL Û/:6£¿t=ÛÿhójÛªM—õ÷Íj¥F‘¦Þ;´cßù»OßåHz–5uêÿS/#nI‘¿ï»˜$#„ÐiW×Ϝݶ߬†™ÉÉÉR.'OòñÃûºOà‡ÄÀ÷ }²¬‘€"„pmG]È)óPÞéaæB×vÂuqÉ’ˆß»Xñ©Ò?UŠcÐtÚźäOÄáS¹„ž‹¯í+R\Óî;d #}¼¨¿ôßs¬‚BÄtÒÆ¶j„ŽÉÏçŠß¿ºøé¶žÖ^‹Ò®ß¿—;ŸÂo°è±”aFt| EQë²#ãýËÓ;º¨B(ÇE¥ëá7œòÛÈšj!ê½0 #ŽÝØÅœWæŠgÕkW¼´œ"Õ}wçHŸ.kÄ'„p&ßüVŸÀGÀ¾ &ãÆÕ‡†žƒÿOmtÊ<¦å³ñyVvvvFÔ’¦|BH^Èô€)g% G·vÏ_æ-øß€F&\Bg†¯´ÿ]™sçÒ''?·h7hd`@S EYÊé›ïK ×vЖK§g6B(uï…¯ú¥~9Gì¤1¿ üFÂptku ÒÒ0vÿ‘(Éç+ÊGölÛ¼mÏÄum-‡"LÆ‘Ù3μ“ž…Wàœ•«—ýê_G‡ÃHƒ¬¿+!\ÛA[.ìîÄ#„pkôßtùÂ’ÂOŸò[|?$Eïaü$³Üx„¢Þ}On¥kÒÉ;ºjS„^Íñ!Ù%}Ô¨EMÔ)B(çÒX)ó±ÏJ©y̹WÈ0 È#纗¼B·¿³Jž*g·¯:!„ö="*yîO{ð¢ k.!„k=øX*Í0ŒôÍ.?S!_؃'”v“ÿ/xßk‡ÍiîìèèT{ØÁô’?Í?è¯EB©û(`†a¤ÖçBx.ÓîH†aÊöà¿á§ðƒAà»`DE"†Bñ45•®)¾w-¬€!DÐ(pB+Ý’ãÍuFuR„‘D‡†g1Wæ:uéá®A!„ïâQWHB˜ââb¦œ'.‡ôɵÐw2B¸5ü~îlLB¸Vþj|ñÐuމÿœyl5ß·,ü¦óo<}þüكߚ$Ý<½Ó’ñ½¦(`aCË5Œÿ{~ì‚AvßGß@CˆŒ‘¤§e1ÄŒªhE&/%¥€&„:Õ´ü°Né8×´à’gRYÊ»4š}X®¡©ñáô9ŸÇ£©NšÑ)IÉ4!„kãd÷oc pruä‘YuÞÝ\K;›2û/â„“ Æýoý¹§ÙR†BQŠT£Èïúi° zðß×¶^]=!DòàzxnÙÇèøC½š6mÚ¬ÍôKE”šš€"„qAA©SáLAA!Cùðð·Áár !„ý…LÑÇW—[ºQ‘D.ïå¿äÔ“¾]‡ %[]º÷ôÀ`£jÔÿ}? VAÀ|Í»ûs¡3Ž-û=¢°Ô#w·þ¾ÿæ­[·îek˜ ˆ†³« ¦(ìܵ{Åç.'Ëáè8Õ4ÿv?[ž£-"}~'³$Õ™´×—dGQ!„0¹9¹ï“ŸNOM—ã»ìÙ©àhC¸cvŸ\7}Dï¶õµ2s«3ÅÎ÷ü4Ø¿ €ïD·óÔIµ(ÂÞ]عý˜µÇo<ˆºw-xݸN=V>3„Òm8ÈKxî~~ÎßG÷[ÖÄ­=zn+.ňŸÿ=¸¶¡®eóñÁÉܲלóëuîdÉ%„=\ïWËÄмv·ùwÅ:r4<—–-̸„Й§G»êjë:ìNàò(B•CBÇÔÒŒK"KÜÞ¯^ÓI§ó?yŽïùi° àûá; ÜveØ¶Žºæ~¡xºNíƒ6\½½{À¿ãÜ(ÃŽ^9½ÄßÝO1Ò¢"1Cquœ;O;tmÏÀ/à^>ʸdžÓ[†ÔÓçQ„ŠgÚjÆ_%WÏ$l»h÷ÜVê!„PM‡î+÷ÏiÊ/ïé>¡ÙnáÎi-Íøa¤E”mŽŒ³çB$7þøóŽ„Böœ4ÁCŸK1¢äØÈ¸¬ÏzñßóÓ`Ša0Ê໓d½~‘”%VÓ·tp²Ò©àriî›§ÏßæÒB3‡šv¥S—É}y7òMÃѱoXߺäÊ0&óiø£d Ã1¨Ù¤ŽŸ"K}›NS\“ZÍ](BˆøÝÃÛϲhJ`^§‰³þÇŽ:S”ò4&>WݦN-“„eMÜgÜ“š¯Ž½>ÉþC'@’óô]±¦•K-k&åQø“ šâ™º5s1¤Ê­çqöëç/³…®¶º|"K‹ M“1þ”Bd9 Ñ ÕMk9™0‰î½Ì¥) ëzžö:küÚOàƒ€ø‘åäxª€áÚ ;²Ê[’&Ÿߦç¦'bŽÝ/WžüæUù5û ¼ð?2&7tf›ÎËîç3ßÈÉÝ^=%öqbžŒí»¶£—%Nâ¨,<ÀŽÉ{|xõ²G®EŧRšÆ¶ušw:iÊ O#œàPexÂ8BÀ°€…ð,„€`!< !àXÀBxBÀ°€…ð,„€`!< !àXÀBxBÀ°€…ð,„€`!< !àXÀBxBÀ°€…ð,„€`!< !àXÀBxBÀ°€…ð,„€`!üM|é^#¤0Ÿ,–Å®ëÝiñm‰Bj€o€§è@1dñ¶ŒI¢.Þ }¹é=ªÔƒLÑã—ïÖJ+¬<øJÃ|Ú{ƒøÒDa‡s˜¢Ì¤|5Sc!·Ì£WËiàºÃ ÛêSü=(7ü­ø°¿Éú–.µÆÉVAÀÿàh©XÆð?Æ;#)Qš8w ÚÐoûÁqxLâ™eAc·>”"z¸Î×NGK[ϦýìË)8 Âð?¸ÂëÓ:ú-8 ææÝÞiÓ/j÷_÷×|¯·kýz:WÑÅÀCÀÿØÄá&µ\z"¨67óâ‰PžÏ´å£O^7ǧèò¹±¢ËûÖŠCg4vy¼@Ñuü÷pªõÇÆäåäk;8šr)¹E{.ô6¤Ñ44TÏÍÊfÝ𠫇Cîÿ·çwo§¥èZ@DÝòFöÉRŠÃ¨kZ»6lÞÐN½&PøÏÉÕ1çÀ¹Û9-mo=‘ë1§½)EHaÄÅÐ,“ÎfÊÕR19/¢Rê8éq«^·”^§%Û£ÿç;nèèîžöFš¼—r´­\í ñ{€Ê0…O/íY(âEº”P| !¯8?O$%|¡®æJµjÿ´éØÆ~|EW @! üÐèw‡Öàó44Õ(ŽYÀw´ôÙ¶>ŽÚúó"Š]\YÒ¨yî|uó†=YsøÎÛ"ú žBdUÁ^‹À{ÃÛ/yJø±E,jbäì¿æÂÓL1Ã0 ]ô.âÀÿ¼ëvùãAnÎËKK}, ºÿŒ- ”.“iòÝààÐ7‚ºÝûµ³×½Ø3eù#ס‡77ýò®òB–õäòÑüsüÚÓ\¡S«žýú÷ïïׯ¹]ú¢Ô—o²$åmò”ÐÌÁJWÉÞ1(›¢SCmFñw=ÛÚI³ÔRúõZïºÇ¢/Œ6žÛ ]ü¢Ä]ÝÔV#À¿ð zŠS"/ùçÀƒ'Ãâ%& :ôïß? KC uÌ»ÿ)&sgWëŵ.ŬlZæ |Öîî5æ;]Õäõj¯ú7Ç&í‡A xøS’\¨ijkB¥&$ç—{Å;GËÌÖT¨Ä‘)Ɉ9»iÆä%'^2„âé9µê=bÚœ í¬«8ÿYüæÊ¶ß7½ŸZHi›×lì3x„w=%~« ,dÏV·òX¡5÷ÄÞI ßï%Oî>ðh½½±Û[>YÔ¥Ó ŸÐ»³ëà`(þkТB1_S]õ~ÊŇýõúœôÙ—¶?L¿Ï!Qyë¨÷9”}°·Òh¤ ÞÜ=|:ôi¶ÀªaǽüüÚÚgß<¸eíÖ+êã¯F/i\ñŸ‹cÖumýË5Ž{§®­ëXj¥ÄE†œ¹–h5&øú ‘ñPQì¶Á]ÇIÖwkPÇF[”úìÁý—²ºã÷Za»½iý¥¢ÀCWÿô1¦ÄN*Öæ#ૃÉüÏÊ?ï»N_Ö×&ÿÆÂn½…fh8v›»gÇÄFºªô‹f²_FÆåèÚ»ÛqÞ¥¢§`²õu–0æüùÍ>ôØ% û·þdø{sÐíyÄ_9´ÿdhô«L1ßÀƽuïÁþÍ,Õ˜¬Ç¡±B¦¶ZJô«¯Sq›?©‘®¢‹“ƒB‡ø©:ýÈs®¶ó཯dÒØ¥žj:MÙºco uç)7EŠ®Žý¤1kûu6góéÈ”ò?mÙ»ð_Š«ä)ÄáS…]vf|2ÈYrgš‹°ËŽO|B–ø—¿K»•¥Š.¾‹ÊÚ|E×&\÷+¿üKûOHzoßÙÇ€‰[}2Ú¨ïñE?wÐè˜â²íâSi³º*øaÊžZwò©´¼‡x5»íê¬D]Z®ëØ}§*[cÖ$`p¥OAñ¦ ¯€!¥;Y²‚üBJ à¡ã•ã˜zÔÖœ|æêë‰uì”è§ÿ‘ÊÚ|E×&Ì$EaŠrsiÓF:aÒ®_‰Òh9¹™¢g¨ÏÉÎÊQÍ3²ç6®;]üá¿™âì””Ã3uk9ºá¥ø×‡¦þï`§“‡•Áµõ_±¼O*'æá¹uhkºjÅ„M·j`PòÞD¯ÏÌúuWVÓå-0îªÂu³uÕËÑý2Föv³ÔUû°ÍQ#Ke• ÕUi›¯èâä‚€—¥WÓÅøUÈ…'3\¨¿þ á¶ÚÒJH“yõÂ]‰YSåšõM^‚ÎëžÄ¯+³Hšvw甡SÂíê»*ÉÖÁáòxï{×EqWOßKᙸÔs³7Õ(LŒ¾÷à S«×¨ÖFòTo9gëÄ;}Æ7²Zààêl­Ïɉ~_hÑsíß?U½?:æÝ_þMÇ„ˆ ¹s÷Ðü2q¬‚.½\×SرH¥m¾¢‹“ ÙUƒìÅ–nÍÆ\*P#Eb›1ç"Öµz¾²cϹWs›ýyï|£tv¿•‚³ÃýÞÌ?h¦D=&åðÀ†AïFÜ7½•YIC*˸óÇ¿ßu~»³·Ü¥Š“ïÛwäjdBºˆ£cáÒħo@g%z£ ´d9‰qÉåΔÄ×·¶7ÑøîÁ©’6?ûR¢««¾zŠ_‡9y'M·Iï€æ–|éý c¶¤¶ùË€ú캊Z6ÙÕçõâ·‡”è°5“¼µ“ÓŸ¯?XP¿ô¡Ù£…žM¯|va¤9«¾P*Ýæ+ÉAX•¡Vë׿ÿÅó³e“s%ôy#/'•¼8F”™”QTfg<Ü3oÏÛÑ.ꊪª\tnf¶ŒËûl(š輜<š˜Ës …ÉrvßñÛ Ùâ²{¶<‡S‡7F?*•uhÛ¥×å ¡´ëõù¹­5Îó°M9m¾"Ë©|õH³_>¸ÿ4­ˆþtöµãŽzžŒ]Ó\O¿ŸåPÎD7”°Öˆ½#ë(×ÖÁ­ÑÈÓxö–y;üwÿìòïLà…Oþž»)ڸǪr!‘>ù½K£)aÄÜÉÑ\Xæ/ø9 Ưd†B˜‚èàëÂÄТÌäÔ<1£fU¿ËïaxÖ‘¾»uðŸ‹1©…²2=ŽîÒÅÓU“üpˆ¾d϶totæ´ÌGFñõëŒÚ}ù.ª8y“ùâÞóŒ²ÝP\¡©cM=åÛ_¡“޶é¿ãaýÖ^õì Hf|TèÕûÖC÷]ÙÚÓBަUöh‘§çNÏ#a:›°hÈ(Rqâµuc‡,|Ýïäµ¥^ÚŠ®¾%&ëÌHîÛ’õœmô¥xŽÉÝÛ§V—Üðò“ܘT³ý…®GÏ,ôx<½å8îÆÈUòîm6ü‚OðÙñ.ÊÕÝe+&çÑÑ÷_Œx‘ZÈÑ1wnØ. 0°‡›œ3î‰/Ž´í/ÞúvGÁ\'|wÅ¡3Zf̸·¹»ð WøbLú®öã…'íë©YõÚ 2 ö3–:÷æ©Inª9|©$7&?îyª­ïàö5tyÆ=s×D§ó½m›O^x¢åÂCöú©ÂÄ…Ÿ’ÜZ3tu¸¸²U(ï›G×S’-…Ò­ÝkÚú^_xpŒkëâP¼ãfTQOÕü½BÅ®¹ÿ;žß½]ùCC«\á‹QB}]–PGI~$ðÐi‰I²ZÝ|]U¶µÀ)7ŠÃåâ"CáêêÆÜŒO°UçXשEm ‹‘ø5U¾cÚU¢´-Ì "ÖžK  ÜëÖ´Š’ŸE=xž©îÒ¶“»aÉAoIvfC”dVzQÂùµ‹~û'ôñ›,›‰!ç›_šyÛyÜØÎòäÚ \2ëüÀžmÓ'ŒíÙØÁDøqûçèØÔv2RÁ¯Þ£ô:-Ùø?ßqCGw÷´7Òü8“£måjoÈ«r…ª_„.ÌHΕ9êI‹’ooX|¼°æg4§ìÂ1rvÖ{~3ývƒwygw8zž3®fcûaYþÓý#ÝÍjúNß|ìÒÍ;÷>Šx¨èÚä‚sðU¨h`ž½›Ö›˜BskAzBAÃÕ÷.OP†Y]«Mrmœcä ‡Êœ`È;ÒÏnŠÉÑg´T¦.­($¨f·[.]YÜTãÚ¸š“Œ‚ïέ+y¼¢CÓßœÿy¹ÍGŽãh¢ôWI9Òrç)Ñ4¶1×QÅïÞ+J}ù&KRî—+4s°ÒåV¹BÕ¯!I}ŸóɨT¾Ž¥“³¥66¶a’6¶³RÞ)LŽ#{óÝ ª6Sªœ$|ӲˣOßúw`ÝýùÖ¯ì_<3ÔgÏ_ îì>ùTlÑÔÿ'_•LwB—›Çp8Ÿök(Eggå”{Y…¡ï?Ȩ?pDcŠH>,UwíÛÇcÁî¨×2ŸšU êF6öFÿe‘ 8&öÎ&_µBÕø&.ž%OÁH ²² ‰PO_ÈWÑ÷PÊtÀžØ…åîªFtªF• óùÀºL=ï½f­{ժ咻1{g4Wt…_‰_¿Eczâò—[-kûï…c²´+‹–žÕ]T[™ºï„PšBM&=%UFìJïÐi)iŒPKSÎFݰ“{tÍâõÇn=}›×`éý­»ÖÄ7?²•%OÞäx¬{ÛçÎúmÿµ'"šPj†®­üÇΛØÔXE÷ò¡B\s{Eñ5ð•*=°Žoçh³wh“uÏ^fäö·:£Qòùq,~Ž\é¥\y(ŽåàUKƒÛÿÒ©æ‰æmš¸Zh¾‹½}åæs™Ç¬³Ãì”kÒȨ̂wóéÓÆNòؽ¤{É"FšvcÙÔM î¿¶“ç2xLtÃnÅQ«»µ™vÏ •_'OÉÎ< Ã%ïNÍèøOØß7vXqäX¡jâ‡+»µiÚqØœqžÎ¦êy‰ÑW÷m™ÐözÜ™›+[c‘}$É7¶.^±ëRT|ºpБ{ŸÍ;¥;xBïÚÚ*ñ]+z€’“>YÞDìӒs/rè¬e®\³ô™¼|ÍÌn6Ë.37l*±yOè[™¢KýrÒ”;»çöônä^»NýfûMúý܋ªÿL$ GF×ÓåPjúÆz¡¥KM3MŽZîÊY®4za}u‡ÀÓ)Òÿ¶NP:ãC½6«2Œèp€ž÷†·4CçܘZGÃeÚ‰+ÈAt>Ð\à2îrVéuâ›| 4ÛmLTáFÊE'î(à{ô ìeQ#(¤ðÑŸÌÕôš,¸¥èÒä‚|å¸Î#Wüzª×œÞ³]ÒþÔÑá˜ÔÛ‡·Ü8{/züÑÆÎ†1 ï]O!<·q§ÃµzyN\Jf+º¼ª!à«@ézͽ?âyº¦šv„‡E »ƒld´J¬û¼ÿ̃·yŸ .ç×0§måÛ@øÆõ|GÕóý¢¿ÅD7,Fi 5™´”tšè–NYIZj&GS¨FU½‚¯¡ëèdœù2>‡ilXj}iBÜkƲµ%;Zø /*"ζ÷¶&òñC<›>ý¼ÆÏT`YòS¾ö[ q„5…„Ö¿.öh¿4¶ÉêÝ뙊332þ]âªëè Uò³,º5»M›¥±ê65ŒÔË4qj¤Ý,R[QuU@”påÀáëÏ3Et™½®y»±cÛšUÙ{ÂD7,ÆuíîWsÙŠóÜþšÑºdSœxnÖŒ}E­×z áTµ‚^SWø´ê?“»2ȧ®¥§83.lÿ¢ñ«ÞuÙPÝw–…¼ì”T!¥ç>¤3RÒèo=ÝñDÑ甓4')..>µ–æ$Žø×Ó5=ì5ÊÙÑçX…È7ÓŠ²_WCÓcz˜JÌÑ!KÜÕÓ˜ÃÑ4­Y¯aYMúoy.ÏiuLtÃnE1Ûû9kR ##m®NZŽFj¡ËÐý/%ò®P‘m¾&zÿÒÕ,¹.Žâ©« 8%ÿ;wX*çy|PtÚ¡~¦š®ƒ¶Edˆ.ð° )–e?XßÃRPsª¢k“ &º)“´±ÝØÇCÎ&Ì‹ëRÁD”q÷•»Ç•LÑN©[ÕoVS_%FU–•¿ßÏlžÓåÇË+ÿñ&ysûyº›níló¥=mLtÃz¢··N=ûIR.­iêäÙ±wÏ54ªµByžœÝy3©¼ÛÀ@ kùø75G'ž]˜´Ë³üú­¸™-4Ò*Îå[;’Ÿ&k¶œwôØÌf*p÷|¹$éϽ.2p¬c)‰MÌ£ !„N>Ø#¸Ñž}ŽB%0rSÀ‰ IDATp±ª`¨—&¹;ݽíÍŸ#B&9)}ÂKïϪ×2ê‰'ë)ºPBһ˺¯Ò]³otÙ è¤}#îû_XÕQ--6ªÀÚÝV뛆0-*ó5Õ±kÈ^²ìØKGO\‹ŠOñô¬ë´ìÑǧ¶j|áJߪ+ßÈ©þû Ïìë–üƒ±Ž©¡±_ªåàî®ÒS”Á¯3feÐõÀ^OÙ¹¾¡ÆÇÍ–£ïPÏ^O‰v`¸V5Õö„†gòùª²Šß\Ùöûæ£×¢âS )móš}O˜à®Loª%ùÆß‡"²%/Nߺ!Üþ§¸ìHvq‰3ê^E á=ZïÛa'·±oßþýû÷éP×ø‹îÌä?þgåŸ÷]§/ëk“ca·Þ‹B34»Íݳcb#%¹#|+ùÑBéúmÝ];sí¨èb¾zðå’f½zž”ÿÉL­tþÃÙKw;´“¡š@ÇÂúý¸4J`âTÛZ5&>(«ø°¿^ŸC¢òRïs(û`oµï]Q%¤9¶Ì{ê9fb?¯šfÚg¥4-\]Íå/ŽY×µõ/×8®c©Q”ræZ¢Õ˜àët0TÁo‰XäÕks‚¬8;9‡ch¢Söü ÅѰîºìàZ?KŽ85òüá<–P¬_»]ï~ýû÷ëÞ¼:]z&ãè :þ'´lº¸# pEÓzKy£Wœœ»ä‰ÿå‡+›)Óモ´±]Ð Úíû 0°ŸoÓ*wÈVÁc”SE÷Œªˆê²£ó“_¾(ßËä|åt&šç^Á'žû¼(yÙÑYý ´ͺYzžqüÞ¾5Ôë͈ÙoTš8$ÈÆ}¶<·u¤ ÞÜ:´æ—^,59-Ûý~]2*µXžÉ=Ð[Û(à`Í0²«š©[žÏgÙëµ­5ÝçEaÛ§EŸÛ6o„O]5Š«mßjЬ-çc3Uç{F¾\ôàÓ’>Þ šâéZÚšh¼N«kac$ß-Éዉ³3‹Ë!§f`e¥_õ>™äÖÔZíbg½>9Ä ôž¸ôîô:m¢}}r¨ªí ÃGŒT,¥ø|®¼ß¡(9"ø÷_§üòVÌJ`ä־ߘ³G63®¸CϤnídÿG£ë‘ =¸©;ºÙOÖÙõzŸŸÉÛïg1½Æ™ç¿«â|Õ iöó§Ž9rôØ…ˆ ]Î}‡Y3ZÑEU çàËÅÓ·qÕ/gy÷ÿÏdÅ\‰æÛ:8h©~ ÐYOüs.*鳉nj÷à¦Lˆ@ßʾ¼oE~_ ` ò R&Éeù…”@ÀSý/óGF'^Ûy(2¯¼@nv?÷q/¹”Y–wólpð±ààsá …ZöM{Mžê×½…éÛË{7®ØñAѽ«“*¼/!¥WÓÅøUÈ…'3\¨¿þ á¶ÚÒJH“yõÂ]‰YS ¡g-žžSëÓZù tlíÌé¿ûc AÀ³ƒ4ûåƒûOÓŠh†¦ áÆ‰“!wîGÇe ,Ýê7nÓkôÄ@ï*{ê­(|V+ïeOÕ­l ÊÎå¥VÜjZ€›¢êªÀWNtÃsëÐÖtÕŠ ›nÕàý8XÑë3³~Ý•Õty ­*þ”š,ñÚŽõ»“?wc$y©É™E4¥ïÔb¨ãÀÞîñ']¼?$:1tmÕmàŠi~ÝÛÖ3û÷È[/_—B«€+·r'V|É« ù¸é^ÍÆx-$Eb›1ç| e+;öœ{5¯ÅŸ~ª1²ª‰%G…œ:qâÄÉS—ï'Iõ][õŸ5»¯¢«’¢Ï(;éÓÍ]Ì?ïÚqÔM={ÿü“o35®qÇu1ªy¾d¢úÓÃs”ët{ù¾~¢†¡Ó.ýÚXŸÃÑ0qòháݶe{}>¥fã·%VôWߟ,+úÀ8O}Ëž;㥠#¾¹ [Ñ‹w^ŠÍ(ÿ÷*K¸ò÷ÞUÞ2FôêúÞu«~ß}#QÌ0Œ$býˆ‘swßÏR…ŸTO~Äöñ=›Øhq)JÝ´^—‘ ÿºSÁÆ£œp¾r’“j¶¿Ðõè™…m<àp’Ð{ãá1™óF]ð >;Þ…ÇäܚשÃzÛ¿^ìï­ŠWgŸj5ÅôÔ£e¢B!âä»Çö¹™.âèX¸4ñéÐÁ7úd)Éiu[]xïÎL7t°¡Z˜¤MÝZüÅïÒ«w¯^]½uUoRþf]¡˜ü¸ç©¶¾ƒÛ×ÐåyYl-ìóËàÆÍ¸ëO´\xbÈ^?]Ý&ƒÚ¬™û‰¤w_#hèÝ<ï¯ðicG¥ßdIoÞqòýºt'„Ì<&y|“¢@Ùqtõu¸:zï/Qgòb®Y¼þØ­§oó,½¿ÕbךøfãG¶²”ó—¾»uðŸ‹1©…²2}#ŽnÓáS}íU/ B”ùˆãq£äµ©„”¾UW,ŠÃåâ"CØ›k0“re„ð­ëÔ¢6…ÅHüšò™ÂüZ &P©€Éyõ(!›&„Ú?äŒnïójòÈÎveî¾¢g[ÛF™fîøÝˆÓŸÄæZԵס!LÚõ¿öÄ™{wiçnòESž€rç$§ç—M]iî³s6Eêu^jÂ!„G­îÖfÚ=ƒV~<%;ó$ —¼;5£ã?aߨPÑ] Ê`²ÎŒiÖ}[²žƒ³^™=ÇD¿ç_ûoúŽ@Á(.—H’ol]¼b×¥¨øtá #÷>›wJwð„ÞµUcÞEŸ#PrÒ'Ë›h˜uZrîE»µ‘€Ãwu"!+r~CÍ:sHd™÷7ö²Ø»Z¤èJ«Et¨O•õ©÷9¤d§¥%Ù÷7ù;™¹÷_°óä•ð»÷>ŠˆI*¬â‹ãŽNjm©ÎÿxżôùÊ&|B(Mûî+nfà ªª«àNB”šmïÏ¥ ÃÐÿøêµYý¨aD‡ô¼7¼¥:çÆÔ:.Óä¼QLÁ‘¾:ºÞ«Uµ¹;ÐÉLJ; xÆ={YÔ )|ôgs5½& n)º4¹ à«@g_ŸçeÌÓêwTÄä]bÆ¡¡(Šâê97nâf®Éáè7úõbšŠÅC%óÛ°s¢›üë“]ËvS·_ÿØ6Ë ÞÞ?±r@mm®±ïŽ×U­åFçÄß¿}«¬Ûw"_¤‹ÞoÇ’[ÿsúîÎf˜RÏ0’û³j }¶Ëõ–%üÑRØtåsl+?IäܺꎧSdŒ4z‡mPˆ˜a$ ùëvWtmrÁ!ú*Pº^s¯Æxž®) Zí¶Ý¿ÖxÕÚR¤zÚZF­ûÌöë׳‘¹ª᥄¦v¦Š®¢š¸.ãO=XáD7•œüd²Ný¹-ÎiRèÉ¥J¹àhZÔï6eWÓÂz?ÿ±ãñ 9upUuQ:¶õÙV¶‚¦P“IKI§‰néž¾$-5“£)T“çˆ+ÇÈÙYïùÍð”ÉŽæ*q„¾J^TDœmïmL8äã­y6}úyŸ©À²ä‡€—GM“Ÿ•šQCψgÞ¬[ߢ†š6¨ñmoI¥HtæýÝË—n;sïÅ»¢ŽÛ^Î-Û)êöËO¥›™ý‹'º‘=¿ÿ°¸Ö€þ Ê=/Á±ðØnÜÀû HöÜFèUÙ„¸®Ýýj.[1bžÛ_3Z—¬Î'ž›5c_Qëµ^B¹ž_Ãkêª^þÛôˆôSÛÚ–zjšÕ½!TH ò²SRE„”ž$ƒÎHI£åÛ^ _•â' ëñË$ߣi{ºs“ÃÖŒìò[ߺ™_ŸÖ¶šï×áè6:±«*vÿ˜ÜÐí|V½´éØ«}Ý+û ¥„/‹ÛÔú؃c×ï |3·Šί]ôÛ?¡ßdÙL 9ßüÒÌÛÎãÆvv¨tH#•J)mÝ ¯„ãëèh,Q1CˆÒ½aŸ8f]·÷wêÜÿý„Ö °ä›eèœÈM¿¬¼mÝ_Á¥ÉIÑ甜,aC;m†c÷ÜI*¤3O°åSêúfºJ`äP·Þ{—Ê9FGÙÈÖµÑ2ïõw‚˜¡“6¶ÕísHÄ0tꉟl5š¯~¡lg¥q;zXðÔ¬šŒòohXo^TÁ͹ ø¦6ÄV:ù„ìõºÖæÃÏäWð´O–5R3ýùœ’)„ê‘÷NBE‰áÿœ7yLàˆQ¿ÌZ½7ôUuÌIs’âʳ—¦Z#mAtê¥-Œy_×X_]ÍÄ©–•6—gÚfÑÍlEW&|å²÷tZ¹,b†)8ÜWG§ÍêÇ… ýns{M¹Þ*³âÓCL‡Ÿ1L©€g˜â‹#ÍõW²Ä+º<¦†¦Çô°š_kW^””aŠ-÷Ò6~¦ÒVZörm-a£ÙåÍØWü|«¯)Ïrøéœÿ¬pøÄáS…]v~z=„äÎ4a—4#º>½‘K`p»yfŜ۾lúø‘#ƒ¦.Üt2:Cen<‰Cô•chšðÕÔ8„F”—G»uöuÑ ¤PÀ§hšsRšZE¯Rrb\j)“ŸšZ¨iªd÷>¦ï?Ȩ?pDcŠH>,UwíÛÇcÁî¨×2Ÿ oB8v?ÿ¾ Ø{j‡&'ü:Úß»¡“¹6W”‘z|ÛÊ»h÷ß7¿ο«¶*ï$$põpÈýßùðüîíª}ÛÜw/Ó‹µÍm $É¯Ò Ëè‰[J²“vh”ßí^Wuè8̵ãÇå’ð…~›}á â*“¾r:ÍÛ{¦.œÿ{¿&{ê6kSoöÍ[)bõˆ9«¯èz­¥úŸ¿Q¯žÆæŒøÍ~S!„†)xv`òü³Âއ<•ëâJS¨É¤§¤Êˆ]éó¥tZJ#ÔÒ¬|oD½îÄ“áÖóÆMû}X‡EwÍ(®¾›ß³Nõ®úN5 Üª¼“¥×iÉöèÀÿùŽ:º»§½‘æÇ{Lp´­\í +ù=ïè:öñ³ ó⺎ —³ÎÁ³Iq쉭â¥97¯Ü{V¼öØ2M!{ûŸ›f+ª¶êÀ\ôUE­ìÚqæ•|·úµ,É«[w_ÓÅ´y×EÛæ·7y ”ÀÈÁÅRÉ:¼rbrï¬é×{æÙ$¾‘“ɘ¹êd<}MêNØzu'SåzGt¦Nõ¦e Ú²{I÷䮓Œ‚ïÌ4¿µ, ÇRѯ¡S]ää(ˉ¿z3òerŽDÝÀÒ©W wK!²˜ôËÓ»öYyWdäàêl­Ïɉ~_hÑsí¹}#\ÔˆäÊXûvëérþRà½!þÒh‹Š·÷ôç^8Ö±”ÄÇ&æ•÷ªÜÀ'˜ìƒCN)¦ Ò“EBsC²_+Å׫}b²‚ª«|U˜¤míÆ\)oŸýUßygò㯻ñ"¥€h[¸6ëêß­¡©rußKH_ßcØæ(‘®‘FA¡ÐÞJöúy–Q·ßNí]GCž'`ò_†ž9{ýþó¤l‰†‘[ ŸnÞuŒ•ñ­Â—©ìNBE©/ßdIÊ=¾.4s°ªÎ½DQvZNé9(ކž±¶$Va’6¶s½øîp€fÕ++%|•d¹ï*8ëöªž~cD™oßåñŒ,Ì´?Ù9‘¤…íº¬>¤¯‡œ…ˆ%|ÁÇú$i‘gœ¾ñøu–DÍÈ®~[¿ÞmÔóseÚ:•L^ôŽI?ýoçý Oh`¤Ëe¥eÑB'ßi›6O÷6E7*GgÜݱhñßÜQ—VuÌÞæScÄùâQ|ë1ç^¬óF³ -ÓOuòSnâ´˜°;Oã…Ý˦eY‘û :vÞ†Ó±yÊ5‹kõÑ©!ó}섊Šoèñóžg…i×WjU×ÁÚÂÔP[À¡”f.ú‡«†L9›\Ñ%{tNÔŽ‘[/¨|ªZFòt£ WÓ©çüCwß”<™$ûÅ•-c››ð4j?ÉèU›,ïUDhtêûÍDôêâÚ©?ñ¿•{“J.¡”$¿ˆK+¢†a$o¯oœ6<À/`ØÄE;ÃÞÉq9 rz´«:GݼÅâÛb†NÙÚQä×o'l˜Õ·®žN³Å÷1;=ëˆÓbÂî¼|Õ…j¶ÿøŠFoí[SHñN›ÓFÃzìùÛ ›hS\-s[sm.%¬;ñ¢J'BΩŸ,¸|³Ãç¬þsÍü‘m¬õÜÛy™ Œ=üFNš6cÆÌyËÖ¼—¢×Á?[Ý\CX{ôñÄÏ"\òöòR_{ ŽºÃƒo++–~·»§ÀyäÙÔÏ¿´¢Ç¿·3à»üz«ø[ ß‘,ù /¥= XÄ0Œ,éЀ\J`P£†¡Å5ï²éÎÕÝíÔ)B(¾I‹—^\WS£iâTÇÍF_@ñ,ýþޝâ§«ãíyú­ß)¹Ð’NÙÚQÃ*(DÌ0 “>«¡a“¥Ñ•ÎŪåCû¿$FÊ0LQÄgí¿¢+” ¾|â{³ëªë5µùbôÃ?½5¬žÛÛ€gÞ{w‚˜a c7ùš©¹Ï‹TÝËà‹CÆX œ'ßü·×Qts²3ç2%L)§ê¿Ü?ÄY]ÃeøáW?òü˜ýã›s¹ Gîˆ*çòöÒèÔ]„:¾—ï Ã0â»3j©9Lº‰ZEíïc¢V£ëÂÃá y4ÃH¢æÖåk4˜žC3ÒÔIîê†N¦ìLÁù&á;úØþ?J-.¹ágí¿¢k” ¾\âí5<—ÆH†~»Á[êK{¾Û¬ˆ÷ùR|ý;õf«ã”£‡ûD‡ý5Ô{îËû° ÿŸÞšê~û•¶…’¼ U[¨î4h_œ˜‘¦ÜøÍ¿¦£n×eÁù7rt¼%·­©ÑdųŠziÅg‡itÝ™©ÊÇd~d>Zfƒ‚ÿ¿N»ÔS ë·ïý6:yKG ÇdTHÉΫìͺ6jü†Kb?l E§†ªwÜšRé·¿ÝG]oàñû¿tæñ ­|WÞ{ß È^ýÙJ³ö¬ûª»Ëe|lÿ†a˜üàŸ·ÿ +®:”` •2*ˆ{‘lÚ¬¹#—†ÂäDÝ.ÒmT|kû滄Âd%óeÏÎlÜ$täB¥åÖµ_ ùf³V C8‚R#×xjj\JÌSÚÙôyVÝ×_:ªÙ¥ÏOÞI‡­cN†»ÿ¼ýÖò!îºr]–ÄÐ4¡(ªÂu)Šzÿ? ‚âèº=›¼ß˜Ôë!ÑÜf#½õKþ›Ò··Ó“%ãß8&ÎNzÜ8ý7”ãêêëPo$ÒJ_‚Ã!‡óa¡ô}¿êûña‰XL‰0`™%>¶ÿ„"‰ Í·îÕ©Îû¸äÙ:ØPÇW]5 àËÃÈd2Bq8þ3/1—K+ƒ.•^ëÙª Ë%ÿâX9ù«TÀ« Ži‡UN »õX®Ñkçý=mä±Ìµ­éÈÙ~7‹q,ïyÒ˜°Û¹íUãþPðšp>üXón\¾K×ÑÒèß/š‹%„â©óß/ x|~õ÷äœœÍ N_»_ܵ©Úç2a¡)»Á6hNY¢Lû/‹½ríŽW›ú:Dâb1Që%Iå¡tjº˜'_¿òTJ!tÃç¨wXÿ,-½DÚ“õ>:ÂŽëž~X½ÜKe/‚W!”AËùgÎ.n%=»léÙÄÊ»\eþÎØÇß›:½hÁ•ÌÏûXâçÛgnxjÛ«OC|…*ʉºùzCa2Ϲ\`׺Շ[;Š^ÏãRšåäruxö pHØ2uUDþg1éç/9Kµòïb†C@,Qºý—ÆÇð›z7ýw¦ &ýfèc®³Ë“v9ËÅ÷<Äuã’^þÅã;Qûb¥^“þ} )¿½öÛÄÅ—4ºíõw2Rº[¦Ë)¾¾Ø×gÛû=<:õa‘˜^âë³ýÃ.ŸÀkæá-” ôR¯mÞ|5¹Ôäa^Ö¶öõ~7¦¿ÇûL8f­G¶2©ðÛàXô_6oˉ=ZeÌ[1ë§v.ú|BSôöö‘?fMûã†á°cS«Æ.9|n˜/§ß(_ÝøÁu²Ž/?’ã8µW}!„Ð9ü:bm¼›&•~võ‚4mB‘%ÜÍ•¦Ÿ^½ E»ä¯é×·²™ª&2xNÛ4åR·¹m›ÇΘ;¡o{Ú\"Ézqëô®UóWÎj¹æðkt—Øâcûï£û`Óꇚí'ûP„”´ÿ#¦ŸQïºWÑ5ÊGу”–èùþÑÍ,…\Š¢xa‡}… ÃÈÞll§IQ\ýF“ÏUxa¶*(¾2»m‹*´}E9.‹šç^Õ~(Ï}^×Á3 }o}ÿZ:ŠâjYÛ;Úšë (Š˜·œz"èUº¬»«¾€"”šeÛE¡Ù4Ã0â±Ö<ŠR·óÛmYUô ¼7¼­rˆ%ygð†F<ŠPO]¨©Æ¥¡øÆž#¶Gåb€&»|lÿ9ºµÚ'aT²ýÇLv•“æ¥Æîì¼ÙåÀ½eÍùLnÄ?»¢´[õèTÇ@iÇ£A%d™.Ÿ¾vÿEržLÝÀÚ­iß®ÍmTuJ(e¦æ«i–ü4e ç·žËróéîe#×,Æò¾JaÒƒ«o>z•’#Õ0²­Ó¬}ÛFÖ˜ž¥¤yi´®‰®€"„lÿð,„sðU iz÷îÝçÏŸÏÍÍuww·¶¶¾yófff¦››Û¸q㬭­]à×*,,ܰaCxx8!¤I“&AAAššÊÛ£ ݽ{÷›7olmmþùç T÷222þüóÏhjjz{{6ŒÇï€%bcc7nÜøüùs ‹Þ½{ûøø|²Â«W¯Ö®]khhصk×>}úT÷âHš¦÷îÝ{îܹœœœºuëŽ7ÎÜÜüÛ½P.Ÿ´ÿãÆ333StQÕ¡èsJ­  ÀËË«¢ÎÄÄäÔ©SŠ®ñ«$$$ØÛÛ—~SvvvñññŠ®«|S§Nýä+X¾|yµžáîÝ»Ÿü>4h••õ ßÓÖ­[?Ù<~úé'šþxr<88ø“ºví*WcüEaaaëÖ­?i.]ºô¼P¼ÏÛ“+W®(º®j@ÀWfÞ¼y•ìBÌÍÍ‹Š”rzWùôèÑãó7åëë«èºÊZîW#ÿ“Ô®]ûóg˜8qâW6|oß¾-wó8vìXÉ ùùù¦¦¦Ÿ¯°~ýzù_eÑ¢EŸ?C5$ÌaÇBå¶ÿ¶¶¶RiU#z•NVæøñ*¦+z÷îÝÎ;===¿O=ß–T*ý¼OC9qâDxx¸@ \—mÙ²¥Üå›6mÉóçÏÿ›·ŠTQû¯´£”>‡¹—*Tù -Z´pwwÿ>Å|sE=úóå£Fú8µ·Ò4h‰‰É' KKËù †††ýû÷ÿ|ù˜1c¾¶8P´Ž;–ôÔ?1bĈ’4hРÜCñÕúöË]¹¢—UWnûߥK[[Ûï^Ë—Rô†²[»vmé\QSû8§uûöí“’’]àW‘H$&L(½=Œ7NiG ]½zÕÁÁáC©nnn÷îÝ«Ö3äææ”~¿K–,ùª…ï,66¶ôh++«“'O–^!11ÑÛÛûà ¦¦¦ÿýwu_eÆ ¥„.]º¤¥¥}»7Êå“öß××7==]ÑEUÎÁW----,,¬ä:H++«°°°ŒŒŒ:uêxxx(º´o#>>þÎ;„FÙÙÙ)ºœÊˆD¢›7o¾~ýÚÞÞ¾yóæ_6PàñãÇ‘‘‘Íš5S±«Z¡R4M‡‡‡?{öÌÒÒ²Y³fZZZŸ¯sïÞ½G7kÖìËFϤ§§‡……egg»»»«î¶ªØÐÜÂ"“&zj¹3Ä7W“ù²`žY¬l¶}Íö³#SÕMª»÷>¨e%Í\Ñ%1·ìØwþÎ˨„ V»BÅ®í{ôjã [ÜUì8¹w‰C¿ŸX½öàíHÖÊÙ­Y»ÎÞõLDùáeqwöüµñøýHi9'žƒ{64Î}R,Æ2ÈbomûsãñÀX5›zMšwèܾ¶QÞšqA» utú¸­îJˆˆ¸ècSýÞ8w[º¤‹ÕW[!Kfäõ}Û÷»›"з®ÑÔ§_¯Vv:¹§ø^› û^!ù¸+ü€*xõ† kôçØK·þX|rð6/}\}øñÉÂÿlªFDD÷¦ð<Ïó™7~“gA ïŸr¦‹øË]ˆHXköCiÖ›’×ûúÙ‹?ýŒÈÚÇ×E!"åÈ‹™Ù…Sÿhe*ÌžŽš·›8¨Ž<Ýuû7=k".áæâ&Â<çF§ö¨ã‘Òœ¥M{²ÖÛRí‹Ó £]}ÐðÏ}EúhNmC¬Ù SÉŸßå>^_ÜÚü‹`ŒÐ¨ñ´óïdÙk¼ÜUˆHTÖîùn,küË™ þÓNo ""ío7еš_ü<‹ÚýǵɳþlyÏUO3r¾žksÜʱ_®»ºMݯ³7ߥú‚Bqrv õæÃG×É•ñÖ Áo§c¸/ Vê6ÖÏF=÷žaÙegNü",ƒäöd!‘Z]ŸÊ¹¶#4ñ\zûS®õ)x·‘-®Ÿ÷â#kïÍï‹’¾9<¼¶Î»ƒ¦m÷í/¿÷&(á¾WÔãîÛT!³àÞmë Ã#ö\ûFöõ <ü Jà%/~o¢ÍÈOMºë6n`k Ê9›ä:Ñ$__U!"†›ÕnT¯’Þç$˜“ù¸ÇZ ˆˆÕí6fâØÞä'@F\Þù4²à?šŠ"bÔ-\» 9¬OÇrB†ˆØrwDs|þ$·'Ù ‰XÓA§S?¯÷ÛÝ]Låµ%VǺa»Î\mtåçn¶\ë !²¬9fÆÖ–òÆÜ|‘V³Ï0 èÚÕiè\QO /Êõ>"ß’û3kˆ"b4Ìë{õêÛ«£«µü/°z.­€àù| ÅÉÙ%†e‘mƒ&õm²×5íuè=—§ Ã0 #2°qªçh&Îʈ‚Šc.gyr¼<Ø6hR?ûe„¶£’Š²Û¤¾¹éÄ´FòMhá·öÂ¥»¯“óý¢¤A«šÉ«á¬Žm3ßžÝZV/'rYòLò=7AI÷½¢wE;  ˜Ïó\Üv/m†µF+‚‘ῆ?Å|òéÁæ"b„6½ö½Îäy^sjxõ¬j[ΉF¹©CDŒvÃÙ·>q[ßÁ„•ç¢QÓä‹•u$b Ž\ëõþã§á‰\>yºH«YX‚'¶B»¿ž$ñ<ÏK·ù±DDBûÉ·%<ÏKŸÎw£éþWVmQúri‘šÛüƒýe('g— FÝqäéÏóÒ·GV‘'yòäÉÃÝý­Yâ3ã_^Ø}:XFDÄgfJŠÚqº¤qX¯é³[³D$0ï0w¢§6Cħݼp=%÷dŒn‡ñ] X"×èÒ±¦ˆˆˆOú”Ì{XýöSç¶1‘ÐÂ{Á”Öº ŸtéÔ•”¢í6E!}z. RFD¢ú}8Ëw$µjý§þÚÍ××·£³~ZÆ÷Û%Ü÷$E:îŠùÍä·{³f5k ˆÏ ¼Xį±,A';Pe\Üóç±2":4kj–}9˺·¨£vøÂçê¥áAÁé< «5¨£õ&kÞ¼EuáùÛ9÷?IƒŸ¿’òD${ýÏ`Ï3YáøDùé“‹{ùò#ïn¢ëޥѱƒ±œìý½= ïíYȨUskÝ®c·þ½Û8hæM-{òZ±Ʀr¦†¾ “[Þͽ¦Zδ‚*M›X°÷Ãd²7¯BÒ©¾öçO¬ë×7-䢽h«Y(¶B®ÔÐÑ–ŸA²Ò#6­â ñøè–uÏ߸ÿøYpT’„Wàv¨’ÆÖjæfó˃qãfU…§nKø´×¡Q2²ÏéúÆ™›æ|­šY«"ŸSñ–AX£iãò9s¬Ð¬yM‘ÿ•L>õÕ‹™ôCv›ü¯ûò’†‡„ˈˆ5¨VÝ"{#°&^ öx}žè;m‚’í{E<îŠv@å?‹ll“ ,EH>……Åqd*kHððÑ>Þ4jñ…ŽæÞs—øÙ”ä>åäOIòÓµ–vîî>úåòv¹å““Sx""VWO7çÁêäzAD|r’<÷ìòϾœ—ŸÈ‘‰À´ÇŽËš5¬Ü~ôzØ'O|FÜÓ ÿ<½°óå]6_ÜÝ«R>+Ä'&|≑ž¾vÎ’ÉÒÓ%DDŒX¬™{q-m-†ˆx>-5§Ï'YF[G»°ºxÑVó[ ™ƒ,lgOû_gòD «nP±¶³“^رÿBŠyS ã0b­Ü[;ëë"ÊÌø²’÷½Ö…kåÚD9ÛÏHKç‹´Û%Ág¦¦Ëx"b´ ÙÌßi”lß+âqW´*§D¾»7£g Çÿ)>‘'‹b­¤êC‚‡÷î{c8:T³ØÏ†ˆˆ ©…ð<—ëÿ<Óåä.YDX„”¬Õ²çÃå™NÏ@%’‘,úm´Œtå)Xõ&2÷¨:Œ¶ŽCï‰Ñj³"`‘‡úËÁˆM+Ê Ší}fîð™™àäðá#þ½KçùÌðƒÓW]ïöGã|nØbYy»¾Œû¼ÂòFú ¥ñ\\ø›"ýì÷3Þ¼ŽâˆˆQ/o¨ÍäÔŸ¿­h«©¸´ó‹&xÉ3âZCþÞ<«³³‰E­oq¢¸Ù¥¤qdaodduvãÞ¾~+#"†526*ò•Lñ–Aö&ôŒŒ„¹_khlÈ2)EØmŠ2<£º¾&Cé<÷>ú”(k/â’c^¿Ká‰Y›êf~§MP²}¯ˆÇ]Ñ(Ž ÅÉä;/âöþ|%ðÃa´uå÷q±oÞ¦‘ôí›(£©­ÕJ ”wâ–E„Ed秤‡÷_æ>‘1FÕª ˆHöæÀÖs‰Yïf>ÞñÏ<-Ò›šŽ:,I9ò*+ZêµûòD:Ôª®Îñ™ï3ôke©aÊE†‡„'r"â?^ß<Μ9sæo¿a\»í/³7ž ŒÚÒÑ%"Ù»°ðÔüÖ™5(oÀñ²O I9çLQ­Κ ŸrnËîðìóµÓñxŽˆQsjP[-¿h)Új*L~ÿAGD"ç¾»×1Ñ`ˆ’ï 3óžEÅî]½*°D|Æíù݇n8}åÂî™{® ÍS³eÊ·õk­ÏIî­³ôÜ«™Ò¤à“³»µìÐÙ×·ëЂY†QÌ…ßçÌž={戡Svß ÿð)éCxà•ÁI< ,ímómŒXU±QgˆdQQ9ód ½t¬ÀñÉ“½‡þð(èÑÅÍ#½ÆžLà‰½–ý}­Šwi5Æhd5çJî_çÿ(4äá™U¿ŒÝý*˜âH_­îÞeöÞ WÏïœêÓgã£Q§OZEn²,î2ÈB×öôµçÂÕó»ftê¹.TFÄh8õëí,,ÒnC #¿ôà?„G$áY«Ž~Å ³sDŸe'_½º½ç·_·¼–±å[y7Ñøn› ¤û^ÑŽ»"}3ß oŒ"¶¼­m¹"w-;J»?À×2-o’Ïå8£f?ú|BöÍ0²ð ­¾è ÏhXZ ˆrߟ8·Î—}²Úº:ìnHC7µËÛ€ËtõtXÊsÿ˜ä冶²N; òY§eF­R¯½oä3L¹1­vþ½ÒYöC êF¼ÂUˆ·ß—ëvYäÞ•¾3‡ˆ¡y§­!Òì²9#,Ê?Ÿ»¡Š¶š… t“{éGzê0DÄš=ŸÁó¼ôÙây¿kFXÞP¾%•Ç]Í(h©¾ `œœÛäfÖ¢¼åµë̸‘=~P~ ðÕ –EZ†<÷Á±…´ë~žã·w›Ì‹#-³š¦X‘VÝyòè&ýáÒ&ú_¬QëuA’|uùî’%Ú÷ŠxÜá€*p<ÏóÒç‹ê‰ˆm¯ïq›ÜWPƒ‡ZqÇ.¬ìj–s†`„åªûÌ>rnyóœœÎZ ܼë·&¦jÙ§ãF£wî[í‹.l¢ZSOž_5°‰žü”Ϩ›¹OÙ½°õ—£Æ * Ø}zMïZò1iV»ZÏõ{&×þâô-´|à¿]¿¶°Ñ0<Ïq<ψ+zŒøëÂõmݲNÐâ†sÏœY9ÀÍZûsýƒaÅVM†þ}nÏÀüzر۴¯)bøôëg.'åzÛÌwË•“‹zÔ5ÎpQ7ªÝuî±k{ú)Òý°h«© AÕ±ÛÿîWS_>öŠ@Û¦ÍÌ“·7´×cˆHºiÁŽ·E«I–4ލÞÔ½«ýªÊ“ #е÷YàbvÃb ï_¼ePk8xF÷Zåå_*£nTÓwÑñ\süön#r3·³CÄs’ ‰¬€J¼zÍßü/nÞÔJœ“5­šŽÚp`Há÷øêr)Ù¾WÄã®Ta¸¨ gK‰»uðDþk ¯È-ÿ\JôË ðB}‹*ö–ºùf!IÂëçAÑiÆvUmÊ©eF=ºõ*ž#F»b:ÖyÎè\jLÐó7™¶ÕlÊ ß?¿ö,VÆ3æµêÛænàÓc_= ˜Vu´Ö ZРöô{¦\?ÿ¨­ír÷âÓcƒ_„}àô-l*šë«çwjá3Þ†„E}L‘©éšTªRé[ áÂV{Ts)àÛÞà=] ¾˜˜KŽ~õê͇Lµr¶væ:yO}éoï„$rÄêÚÔu²ü<.¼,öéõçï9b4-k׳Ñ-új~]0ßYð^\úNÊ3êf5Øewæ3âß¼ û¤k[ÕJWH”ýèÖËxŽrмT_|Å#¹9¡šÛò`ixïŒ=ÒS+)òù‹·éÚV¦Z¹ç’ïä¿ç|cø¤°»Þ¤òÄ–wpq4æ>†>‰W·®n_!ÿýÝFúäEtšÈ bU3-¶/ŠO{ô:.]T¾¢ƒ‰øËŠÚ÷Úr í{ŸKõ¸+ð›)xÜëÕUÇ\ÊÔ÷Ýõj¿_ydø¯”vÀ ó¿ µ­,,,,*ºÏË#Lwz¸½ˆ!b4š­ÿ?ŒƒÉ}<ÜÛ„%F«åú%ÍîGXMåÉwpCP]ùã„v㮦•ö²ü˜ÐD@D¢ºÛ–ûùöíëÿf·¨ãÙ­W·ÖNÕ;¬ ’ðŒ¦ãÈÙ}ŠÙ™M!ŒAû©ã]Ä”ð׆À’=]¼ ?Âj|IVo|,aʵ6Î¥Ðç4–a¥}…ðƒÅ^û£_ÃÏ?ûÃjY¹ \uõ]!€ûÞR®M¨®Æ°FÝöÅ)©ËбšÊ|Y" ýËC›a´-}*ùöÔe~ƒÈK‹ }ù:6Y¦¦gjSź\>½ˆ•ŠOº¹aÎîgœ}·ÙÃ)ðüî"*íÕT >áù¥ë¡)< LœZÔ1+ÁˆðÃãbÎ,_|ü­¸ÁàY½¿"² Á¨ üä ‚àT<€ B‚PAHð* @!Á¨ $x„ ‚àT<€ B‚PAHð* @!Á¨ $x„ ‚àT<€ B‚PAHð* @!Á¨ $x„ ‚àT<€ B‚PAHð* @!Á¨ $x„ ‚àT°´@YþüóOÿÒ^ €Ÿ‰ƒƒÃêÕ«K{)”+((h̘12™L²?×÷Ãð<_ÚË ^^^Çk®­2‚{TTSFX9=%ENN‘()²¹‰–’"‘¾º’"Ÿ¼¡¤ÈD¤«-RRä& L•öÓ§Ä¿×/ŠŠRFð‡¿¿ÿœ9sÆ_Ü‚ñññ ,ˆŒŒTÆR)jð Ò´­Ge6±ÐPFX9ûª†JŠŸ˜©¤Èv•”uQBDÆFšJŠ|ÿ•’"Qy¥]—Ô©k£Œ°>Ä)#ì¨|ùònnnÅ-õîÝ;e,Œòà7x„<”-<Wü_§(RºPƒPA¨Á@Ã_üú¸EJjð* @¡‰Êž+~{»EJjðP K“ƒjè[5è±øìeÝG ßjðP0¶|ë™k9 ‰ˆËŒ¹¸ù÷éÚÄ_¼»ÄUYÃŽÀw‚…ЬܤSg÷ìá6ý|*ÆÛõ>pàÞ|W·,×ÁÏC›øŠ|\Y쀲Šãùû¹ ‰ ƽ]ã¡¶æókÖÐsù…±µs£ÆE½s\ð{{=†dæÌÞ›é»ëĺΆ Q»6 ´›;M^¼{’Ç0óÖ>Mø±GÏÅ÷éQŽ‘½8øïã 7“ìѺ‹ä ņËÕÉŽxIbøõ+§x´ã.œ_Kþ”,5§fnz qQ—.¾Pk8¶óñÃ""ÒkäYM¶êîc)YThÓÑmÔÄ£ç{tÕyvðàSSŸ•nšÄE\Ä$x(DÞNvä×¥F¦c»…ËN ÙÙQ‹ˆc1q±1q²¤Ký­ç.ÎhX|’©·íè:fÚÑ‹Ÿ:Ù<øÜ²óš†êDÒŠä ð]ñ ÝÔŽûàA•i×t¶$‡¿Žãä¯Y&«†Íhéh ̇dð¹qi»‰‰ˆ1içã’vîè…ÿ ªäÛ­¾Ú7‹ä "dñ//ü{Õš]g£3”=3$x(†Ô§¯dšfæ†_î7‚J Ç]újn$¯…³í;Öûí×ˉµæv­),ReQè>ø6ÑË^m=ãªÉ¸€ÿ7Ö“¼XëÝxìð…Þ~w+`˜>öدƒÿ–:+OJÇV²z¡KÈ̦Õ][4utêÚxÌúénšDD\äö5ªµ\(ù®sD àÿ@£ÆèãŸ8ð34Ѩ $x„&z(søâ··+P¤t¡ ‚Pƒ€²…'R`¨Z¾øEJjð* @¡‰Ê^‘¡j¶z$ø²$3öÑÅóן¾‰—hVªÕ¤E{ƒ¬áCøø[×Þ±è3²¥¥"m:² ÃËJÚÿÖÕQY£¨@1!Á— üûË‹úõ2\¦cja$HŒŠú˜!vèºd×ßCtâ?^÷'«8 IDATß<mƒfÃKðÒ C‹æ§XF‚øaà7ø² ýþbo¯Y·-Gî{ó!2$øÍû„ˆ«yqGFuzðOÄZöÙ~ûøoµq½eO<Çÿïgk£Ç]õq!Ç/¼k>ú܉¥Mt²ÞS3u¶õHR¨ÓŒ%[¦ûLqH ½êˬ·½™C©v­ºeÞÏÏèÖöƒ÷5Íì]Úy»Yeè.}ÿèü™Ï£Ò´¬j6kã^E÷óàÕ\üóSGN?Š˜9·éØÜN‡!"þõÍÚôêaÊñol]ߪï0Os6ùÞÎÕw­¨ùñâ¿G?Ôß½¦Kxuå\À½·BûVÝ%§V]3î—]Š ^õ½úwçuj±~bc¼ï‹ì‡í¾æ£mÌŸpsËü?ë6ÖÒ’åSïŒ¹³ùæ¥Äju¬Rž,œ<©ÆÌó—gÕפ´{KÛ´žv[äPÛF-êñÃÑF}÷^ÛÔјˆHöv¿º¿Èl¬…‘/B'Îô]nw?[!÷áêÆùÛ›·œ“à¯mš¿©‰çOs&ùîŽkíéöàe§ÕêŽø{œäÕ?Ïa'R+V·”†Í^ÚÈUtþMÇVƒ‘à€S§ê»wó1ÕpobôÕs¢ŠÎ® «”ûúR²Ð³Õ7=|võìùûwu×~¸u÷] QÒ‰e oXO¿úøúÕ{Á÷—7ŒÚõçÁHy_TÉÝ Ñ=φ…=zq﯇~¿+æ›íYÒ[w –<~ýèìÔú1ÛÇŒ?k:ùRÈ‹{÷ƒ_nðLú=Öà `rÍ•eÙ|–Š ^õ9ûu«švjåŸÒò¾Ï'œßqäÍ×Íóâ¢nþ»ç\¤ió>—ï8u?ìé÷ÿ®>ÆI_>NÍžRöúÖ­h »¬V^&˹¼É–ëÊÖLø³ ”쥋zSŒ…€<àUŸ¨ö¸•Ã*=^ØÑwÞ‰ Dy¿5YâóCS¼NÒ*ÆÀ½?=¯¯ßø]a""â3SS¥mm1CDÄEí·âV"OD©Ï6OXy·œwOmb4Åš|Ä«¡"¢Ô§ë—ˆÍ·aLP©c·þ¿ÿy/‰'â?^YºêBZ~”Ç)ò÷sÁoðe£ß|ÅÙ5{™ß¡êluKK½Ô·o>··ÿÁ¤m §9ŽÐqàßm}GÖ¬¸¶–~ò«ûÏ2œføw7eˆˆÕ¯fû~YS›ªWF<}™f;d×âöú ‘¹Ï`¯%}'¹Ö:ÑÐ*åÉõ§Ú66‚ôü¢ l‡oøóz»Mªì«i%yP½[ÇÊAAêjh¦P|Ù ´h¿8àÕÈ»çÏß ŠNU3²«×¢¥‹µ6“a{a¯ÌJÈd601³#vî5}’Ž]v;FÓ©çô‰Z¶"ÖÒoçC§þþg¼IQ32Ã¥¥‡cy!‘̾ӔٽüV<éíµÔ¸º‹‡{]sM""b-zì ¬vüH@`Pè§n«FÔ‹ØzIßœ%b´ëö™>Aß6{F¤æ0`ïg_x’`èÚÙ+y®Ý†Ü½ÿ àËFlQÏ«_½<ï©ÛW%"ÒlÐojƒ¬÷ÄN=§9åšF³V÷©µ²_°zö-zÙ·ÈY`ï3ÑžˆÈªË0—¯g,0¬í=¨¶wöËSåÿh×é5­NÎT’ëÓv¿éwò̄ѭ‰(õÒ˜ ñ6Ýê}}û>@Éð<¯@/zR H©B‚‡„¨®_O›õ3;´~ѹqFðÙ}þ\·F:aPÚ?áG¡VcÜ™'gç´4ÎüÏÚ÷Ùpóî–Î¥@A¨ÁDÍÔµ÷D×Þ¥½ òøâ;«@‘Ò… € B ÊžWh¨Ze,Š2¡ ‚àTšè ÌQ`ÜY U ð©RI×±¦¡2"7©/øöDж5\I‘‡6ÔQRä[ß+)2Yšˆ¿=‘B<š()2Y[(ëÛ>rúµ2¦$TFX(-h¢PA¨Á@ÙÂóÄÿ¦vŠ”.ÔàTjðPæ(p<ÿ³=l5x„ ‚ÐDeŒBσG=”>$ø2ÄRd9ò¢äókiøþ>¶ڵǞ‰-Íš$—F[‹=Ö¼ýÙ‰ø¡¡‰¾¬â¢ŽlÓï zÿ½'oUzPvð õ¢Ç}ðð3àãÎo×s»¬û?§ÿê`öy'Èüòàöݧ‰¹ëù1¯Þ}§E^¾pùÎó¨dY>*$ œ,%úÙ½{/Þ¥>bRßÜ¿rãeüç7¸¸gW¯<ŒÊø« PÆ Á—=|ü•º¬ûÔqë™ ,³GT—FïfmjçÜ ž£µ™]«YçÞqDD|‰‰­û.\1¸^•:žíZºT·²ª7òH$WøG…$’¾9<ÆÅÔÀ¼zݺÕ,¬M8“õÁ³uÝÜ{ÿý2û*!óæb¯æƒvE`'(>œ;Ë>ñö¢Ž=rœw|³_Åœ_h¤OVtíñwJÇmb““Þ^]V?x±o¯ aÙ9hëOÚíMHM‰¹2ÕáÕßÓÖJ ÿ¨à€² Õ½ú¬‹¨7ïlðûá—f[ù¯ü÷­ŒˆHܸcký‡ÇŽ¿–Ï6óÖ#om}»Õý¿"(8^‘¿Ÿ |™’þä¯.^ ÃõM¤ú¿ÌÌy?ãÊú5÷­Glø£G-#-ms×a–uѼ¼yÏ‹¬Ê4SyÐʹm­Å¬ÀÐeH¯ú‚ؘœnyùTp@éƒíoª{/Û6ѳryK×á~÷Ëî ÕÔ§•îƒc'"8"ʸùï‘Hû.]k¡Ÿ€pò,K¸÷—O½ûeßµÅ:K]ZÏýeEëÿ¦ÔT'"Yø;ïDFLèñƒò)ù÷†ü«çÁRªJDŒF­ú5ÕåŸ0šbMæsÈü?*8 äÓÇG¡‚FSÚeÑóhíª¾/ˆˆ´›ù´ÔêyìdÔÈa†×÷‰vÜÕ»(|g<¯ÈMíüÏÖÉgϲ„ÑkõÇÉ5^æB~Þº¡gZ/øeY›KÓkkŸ”˜ÄsÑg×ÿuósî6jÔ°’vÖ¥UО’ïG…ÌŒÎ$¡‘Žf®Fôy‚'N-4ú=õ®¯Íc±µGv±WâS×T|YÂèT®b.$"F·Ù¼uÃδ^ôËÒ¶Wf:«±Z çÞÒV#kRiÊÇéjå4ˆ’˜[`@MAª©Væ³ça²ŽòÜÍ'FD$ä\ëzø´Ppôða³cïëŽ÷µE~P ~ƒ/£Ýfs׳z´xð¢»i¬…‡gµ¤›öGdýæžþxY +‡!þ‰ 6HPÃ¥µ»VàßËNÆÉÅO¹·zÍ…\÷Êéyvl. ˜7á`|ƒn*bÿ¥à8^¿Ò^êâÁ ´Ìbt›Î]7ÌúñÒÁ ogTµ|¤ÉÙÁ u9uÆøM>Ë·žµ¦ºØ°r£ž‹ÏG}9ÂHá Z†¸4u±3ÈÝAN·éÜ 3ÛÜÙu2J×cÙ¥;F8Óëû"ijOß;2¼ª‘È´f7‡rÙå‘I&ìË1…ÄèP­úÿ‡ç´3Š{ö4Τçö ÿŒn×´¶¹zVFߥqM‘V3?o3ì :2î/ðòž}]ÏwáÆUë½ù»OëÑ'ã¿jȸ3׻ˊg•‡­=||ÿ2?Ë3½;-{,Ud†ÌO×-Tÿnk»±‚5ÁGz)Ú€ çååejåêXÓõ;-YêêJì0lk¸’"m¨£¤È‰I_VøýXšˆ•ÙÌXY‘‰ÈÚBYßö•Û1Ê›’üñÈî QQQÊþãð÷÷_¸ø÷q–·`Xè‹©ûI¥ %[¢¤Ã½*u»×ï¿{Ë]ÅD²ð5-«ý&[ü"`”uîºLæÅ‘•[ÿ×çÚýuÕˆˆÿ¸ÇצoȯwïͪYìsêHðãà¢Ï_ÿÛÂsšíû¶7,Yvø‘dÞ=ÿß'«¶êɯ)–Þð·Ï^JÈ[ÉNO×®Ö¬“Gu5ùKFÇʺ“š’ªÈӸЋ~ÒGk{ûlÉt¸~—ò;¨>>8ø=kWÍ.;ë²ì«”“] “Q¹\™X·Íâ3m²_ÈŸíYw4ʼu+GEFôD‚‡‡Z«¿ß&ÿŨ«áæ8P&ž¸âW‰eRÏóK–,)h‚¶mÛÖ¨Q£€9&%&ñB+œº «_N>%~Êÿgò̳#ºlO’è7^pvisíb/-!ÁÃF¨®VÚ‹yµøøø|?eYV&+¸»;OÄåi™äy"® {ï„NCÿÞÕìÍ£“kWÌí>Êþ¿M>ÅïvŒe Ï+ò[q알±Y/ÝÚýWê¿ê;Ì®ä!~"<)Ò‹^VýÒ…Nv* @¡‰Êžxî+Wä/¥ 5x„<”5¼B÷Á£“”6ÔàË .áÉñvŸ¸þ,"A¦elW·E—Þ]\ÌòŽÖ"ywûÀÖ=gn¿ŒIaô,k4õدµ­V)-0”jðe÷îüt{§NÓö*,àGÿ m~ÙòîÖ–©½¼f]TÊhò* ^å%^8xö“]¯mËù°õZC†6eøg<=~sÆÔ1å; îZáþò!³O…|ÊH XöËœ‹âöƒ}-܇¾{@È•¥²@d?øàu‹%§­Ü|a&ODŒ@»RÓþ·Îíç¤'oTì³ë¢ÚÔá“û¹Îäx"bÔÍ\l^¿´»9KDÄ´ýýߥñ½f´·[@D¼†uëÙû×ù™0DŠ]Ö~÷€ð|¡V±íŒým§&E¾|õ6ITÁÆÖÚPóËš²¦½ßÊ Ý¾{õ"ì}†ÈÀÊÞÞL;÷4Œ^ý_½øåí³g)æÕ­ô²ºæ3úí–ž­ªV=û7sF·Íâ³UÔª‹ ý¨°€å½Vœ­©îˆá@ äCÕ·”EJ|™"Ð1¯êl^è$Œ¦q'ã*~Îj[8Ö·øâM¡IÆ&¹_;ºó£BŠLk46-t9 Pø¹@¡e Ï¿O¼EJjð*5x([x^‘s?ÝóàQƒPAHð*MôPæp_=[ëÛE~²z$xPifÆb»Jzʈ,*ñIw·¾WRäá.ºJмöÆ'%E&¢u´”¹YC%Ž·`e¡­¤È‡N¿VFØÔ”Te„…Ò‚&z„<”9 <Ü÷Á@éC‚PAh¢€²E±nèx_ºPƒPA¨Á@ÃóŠÔà²>v¨Á¨"ÔàU‹äéþ¥ÿ>—æ¼f¡fyëÚîí<ª /šú`×z~cÛÛ|cÂ’ããol]{Ç¢ÏÈ––¸ÂP$xÕ’ùxßü9§õíl ÕäoÈÒßG„½K7ô\væØØZ—äSï̲î¨ÿG‚ÿx}óüµ š +,Ás¯·õïuªá¦ÝÔ¾@P¦ð µ·ÿl·Á#Á« ¡ãXÿ듪dgE.þÆœv-çÏšýo¯C½ •8¾jѱ–}¶ßn+¶)tïãÓcžßb™ú³R?$x•Ç4ýK㥿صê–y??£[ÛÞKÔ4³wiçíf•Ó }pâØÅWéFÕ4kjýïºÕFö®§ýñÚæ múõ0e‰ˆø7¶®¿oÕw˜§9“zÕÿ–Yo{3-†ˆHúþÑù37žG¥iYÕlÖÆ½Š.# >¶bí…(iÜ•¿ç¯ò0ª•ÚòŠ ¾,`X–Xm]m–ˆ0­ƒï²GêöÕÌ3æï:ûÈ¡©.ú /8<Üãøuq5‹”ÇW'Nržùâ”ÚêòÖ{æÎæ›—«Õ±Jy²pò¤3Ï_žU_“øO7tðš}=ÃÌÁF#fÂ-çšô@<¡w¯zâW7ÎßÞ¼åàœmÓüMM<‡xš³ 7·Ìÿ³nÓa--YJ»·´Mëi·EµmÔ¢?mÔwïµMí3cß'Ixiò‡wqŸ2Q‹€ï‹/~½EJêE*K¸·nËUSWo%ÖyTË-Þܹz}càÜ n¦Ë'å?œ;Ëϸùôê™ó÷îî®swÓ?÷$òd¡g«ozøìêÙó÷îê®ýpëÌ;‹Î ´›þ8ðeøÝåŽ!wÂeÅY¼¤ËÞ°ž~#ôñõ«÷‚ï/oµëσ‘lõÞKfv´™¶™²z~[üP\HðªGúäÏŽuäj;ÚšYº.IéàЄšBJ>·}ÿ»†¿.îi«ADŒ®óØy¬Âü>Êêw/ª?lš·¹€ˆC·j‚Ô””ì+VQ½aÓ¼-„DÄ6iVS’œÂ“äöÞ}!ýOm\ž!"qõÁ †:³UH*•ò’¤ÄŽˆ„•GžˆŠ:Üßû%@ ¡‰^õ°Õ=½•—w§“¥Æ>>½çÄîUG†xް {òzùÌ«‰Q¡ªVÑoû×Áþ'n„¦ˆ-¦5iÛ±œ€ˆˆ;÷š>A/çŽ4F»Nïé¿éUd}4IÇ.ç#M§žÓ'jÙ ˆˆ5í°îÎÓžG_KÑ®ÜÄ»MÆÇ€'DDÄZôØXíø‘€À ÐNÝV¨±õ’¾9KÄè701³ké·ó¡Sÿ³Þ¤¨ ™áÒÒñ¼ˆÓÞŸ¸«gWþ‡T¯ÐÃÝ¿Çóàeñ/¯ü£åÐÈ£YmSõ&K{{ëôéë/ãdz¶½¼˜©)43æ§ûQ~h’K£mÛ<™øòü‹Roòòò²¯Ö̹nceϺ‘@9Žž{£¤ÈºŠ(¾míOJŠLDêh))r³†¦JŠLD5ª–SRä?6=QFØÔ”øË'¦EEE)#øÃßßú¬¥»Ï*nÁèÈà”J¥ßž4©+}ÚL H³°7N Ψ>îà™¥ž_ ÎEֲϦ—ë¶ê‘O_¥Û Øä¿®‹uñï.*õ“0€ê“½Ú0zÆU“qá¡O‚Þ®v}³jøÂké_N–|zÖÈ- -þ~zÿîó°ûkšÅm>ñàêâHðð]±fM‡LÜØ;ü¸xâx^¿ÌRrhï-¦ÅøInz ‘šÃ i½,^Øs=#ïd’»§Î¾¯Ü{rß*DDâªg ²O 8s[RüYâ7xø®v§N+í…øÑ¤=¼ÿœjù5ÒÏj’W«ÓÔU¼öÁƒ·œGå\5"^\¥EO‹VöŸäY†e„"E’5<€’q¢c2Xà 9£Œ‘ÐШ]-£Ü ^­þ¨Íõ?¿äcO­Þù ùœº ŒV‚–T([x"Žã‹û'•fÊd2¦,ËþóÏ?Ï2#-Ôtt>wse´t´(--½ÀvIô¥]ûýÃwùc¡—ÝzQƒø6@$ìEϨk¨Sfrr&QÖ½q|JR ¯žÿøà\ülÌŽq IDAT½MOÞöÜ Í´S&57SèHðPÆ(ö°™’<ž547Uã¢ã>r¤#o:—}|Ϙ˜›|ÕžùêŸí†Ìl6ñð¾IlÅŠÏSñÅ€"ѨUב]»™”õZxõVŠ‘“ó—÷·gÜ™×eÈ Ãñ§ïŸS’ìN¨ÁƒjÓ×S36Rx Þ¨«+ñ™¶–&%:ª ¡¼ÅVÞX4D´å^Š’"wn£¡¤ÈDd WÐ8e%•¦Œ°™é_Ý” ß r'?—93W¯è=©–÷öß•»Ã­»öh¤ND$‰‹“XU2’žY½þyÕñ÷f5-_â 8<”-<‘Íí%ö•­Y١ɤgv½]4¾¶‰0ñõ½cëvhxgÛ­}=-K|yÈhÙ6ñjQ¥ä6Àà¡0™W×®¸¡Û÷ÈÙmõå<òòëZKàè7s宿{\¥/1&Þ‹ö}yG(|¨:Aa2b¢ãy} síÏ4dÊ·1kLçÙ£¥s±W~ïçf[^¬©káä=ù૬ѬÓCŽÌð­_©¼XM]ǸªÇàõw¿jßâÂW5n¢/J€ãy<ÿ³à¡0bg—ZÂ'ô´âè½ÈÔ¬½[Çeè²¥ýDDDé÷vh;íªQŸ?öÚ6±îÛõ=ÚL¼˜B$}°¨“ßÊWÕÆ¬?|ÊÛ̦ÉFuŸw³ÐßÚ(A=Fà0úŸï†NÞ8ÑgÇuê Ý=š·lßÅ·…½KD|¼ÿÒ•¶“nïŸYKDD-ì?Ýw^³ïÆòfNoÓ,ÚΘ¶a¬«:5o,¼±×/èe2ïbPЬøÄ‹0•€‚ ÁCá4l»¬8ï;/úѵ€€€ Î^8xÍìI.“öïa( ¼t-Ùa Oõ¬ã…Õ'_‰MšjŒ¨ÃÒˆøŒøˆWAO.ÂW-´‹)_ì"Šà‰¸âŸ\~º6z4ÑC¡8Žãˆ±i­=]´åøÝ𨛻—¿»tÈâ›’}ˆûÀ›~ƸP¬«+ñ w×jl£¯SÁ¡©ßø57>i¨}«®@(<"借®¸åúè\—­ýš}ç­ÇF<~ò‘gutuøq¹ìOù„W7¯Ff¤œŸÜiôiýá‡_|HŒ }xiÿxñ7²µE¤@'»Ÿî>x$x(„†£SUºµkûã´\oòïß áMì«0"§FõÕŸ;öR*ÿH²¹_3¯¥·Ò#ï?ˆÕo3r´‡®ˆ¸˜Ð/püYñ‹@Áð<Bà0lÙèýí§{4z4¤_˚溔xbÓÚ#Ôvã875b*øNº¢å<Ÿ^ü¬~õtÂÌ_p×¢çœz¦¢ªúñ'ÿ\áoÐÚøÓÓ“k®¹ÍÉì^<ŒNijRÀ¬L«XÄL ¢Å„'†Ño¶8àÊÖ_ì".Û¯»_ÿñ¿ŸJ¬7åðÕ=ý* ˆˆ´/$x„&z(cxEnjçÑD¥ @¡‰ÊºùÙFªE @¡…‘~xzñÌ•Goxí •›·hh­kBøÉñÄ+rüÏV…ÇÙ ’²{@íJ5ÛX¼ýÐáÝ«§õnb[¹ÙÔs︒å^oëëÖmÝ %„áÂ7º+£ÓÎg‘¯ݾu?(*úáúfo–÷µÿ] ®bùô˜ç÷ŸD¦þdÂ?$xÈ_êó×ÒkšÒÕV,ƒÑ©ÞoÞpç„SG¯edOÄ'‡þ·gí²ÅËþÚyîEBvÕžÿpmÓµÑ9¯?ÞØ²pÍùHN|lÅÚ QÒ¸+Ï_uæ GD$‰ <¶yåÒåkvž}‘˜Ó8|oç¢ —c% /ÎnZ²ç‘ôÿ³ÎPFðÄñ|qÿp<¨‘Ž®˜ ¾x&(õó{»_â"7w?ø#3hKךÕ[ ^¸ãàÎe#ÚÖ¬ÖîÀT""îÃÕóÿ:ù9Á_Û4õùHŽÏHŒ}Ÿ$á¥ÉÞÅ}Êäù÷S›8Ôë>}󽫯zÕ¨â¹àFOD|òÝ ÖØ<´¡kÿ?/„¡¾PlHð?õæ#Æ7äÏu®ìÜaÈÌ¿\z—AŒH¬«+q¯7{L½Ï¡¯ßy|f”É¥©CW?/ìÇuaõÞKfv´™¶™²z~ÛÔ³Óú/j¹åaØ“;wƒB¯/p œ;`ÁÍtùÄÒ[w –<~ýèìÔ†¢ÿà ¨$xø_{wÅÖüÌÝ!Ý!¥€”" (-Øvbwöµ0®ÝumEEÁ@ÅB@PZ‘RºYvwfÞ¶‚÷ug÷ªìóÿñvwž=Ì3§Û f» .åÖ¡EºU ;f r5WUÐr Yóª!„ˆ¢è3‰¤Çœå~ „MÙmÉÂ>ÏÎEåüßÃç⎜y×uÆ_!†b!L¦Ëô•£´_E_üÔ ßyä< Èí~#"ˆŸþ!)0þ`šh›¸v÷áKº_‚ðú7Ïn]9dÇ®e‰ùç“ȼÊyEj†tVÂ><“île€âr^áÈèÿ Ž¿JÙHç$l˜–÷ñ2³ñ9‹[TPŒ#;„Ó7Ô€ Pàœ@AëRÿY¾üxʇærº´¶­ÿ„µçî«Y|úðµº÷7c_€‰IˆcDkEIÇ[¹•Ãæ Q¥/è¸Y² Ðð}XL\B¾žÀ+¨ÁƒÖ•ÝÙ½úN³÷@+{‘Ï7Jêèu !œ ]ÏP;”ö¼’´UyŸž=~Iêzè¼ÿJ‘8þ©5‹ó:ïÍ÷ ÷t-}m.î1}éù÷Èòg1·+ t U X$/«Ö0Š´ÝÐÉÛ1~úéÌúßi¢6íÀâÏd½zÈ!š¦ÿG·qyl)Ž"+ï¬Yu¾®sÿ@:ÂÄ%Äɉù„jÊØ½ñlÙ—ÿ$ãaŠ^{Òbׯ¼Y†#„§àÌŒ ~s.½ebß–ÀOƒ-F/b2æÜsׄK±OÞ4ŠMXÓ+ÀÃDîý}4Íà“)f—£âS²ò+­mdWxè¶œ !„© ÝC?û LÖH£«>òÌq\t̃üF ÍE.>ž t„¤l‡-ž#gHÿE/þ|àÁ0•Ìz6ëÙÖݘ´¡{Èd÷Vî¡+YõcÕç㟠,>þ*ªí:r–ë§Šk; súöp)›ÐE6<—ôÁ:$Aüüå&znqÜÚanÔ啺Í9•ÙüÃGsÒÿY¶ïQÓóCàÁkI^Ð'ü¾lÿ5û¶N4{³w˜×Ô+Õm^4U±›æo¼ø‚Åûe4ÑW%âïç:SnXæ(P“Èk³Ùë/öš¢óuM›¬}qíâõ;±G÷œ.½©<#Ôà’D8Iþìµyðì'7nÕiûôµ{¿A']«O_òÑõÛ5ß%Šo=xþn¡˜²<Å 0²:7·‚fdfô±ÝœÖ¡£±žŸõêÛeÀèfa'nݽ{÷Úg‘o£üh¢ \Þo6ó³p.NÄüùóÛz@PPƒƒCOY_[O2´å¥?­äE“SEuµu‚›] øw†a&//ßÖäääÚ<˜Dˆüf’D¨Õý;ø<ðï0Œ†aؼyóx9˜&#'‹qkkH$ö>͵5µ¤Œ¬ŒàzÊ!ÁƒöLZ’©('*ˆÈ’ìÿ{ãûŸ§£)- È4š Vú×Ö”Pd„¼¬@>D„ÐÔŒÚv·V@‘§í,ˆ°eeüVÿnx1Gi&oh¨LÞÈÎÇ‘!„Èʼ¼j†AG=Á­Ø ƒìAcÚxºÉ¾ºzù9!„ù.6: ³óì¡ ¸íµ Á'í=sše^ÄÈIû®ßK8¹0xnœRèüaº4„Y~5|hÈŒrøÛ„ €!AðòC‰ˆÕ¼Èós ž„÷ëé75’r(f‹·<†BdcÖÍ3§/§TR|†o@<ð_`hô^z¾÷Òïn§éN¿Û2ý›¥C¢šC(=Ôà€vjð„ ‰óÏ8c]0 ´CPƒ dH^ªãZjðB¬ñùáñNâ´÷Ë/Ò²F>‹.°?ÜK–%l[¸1¶˜¿ƒ:üG Á )²æÊt¿±§Zv'æW66Õ–dÄ­s.Ü: <© !„Qõðø–C‰ï ÁÀ ¼bÝ>q¶ÔdÚ¾¿‡;ê)HˆË¨™ºMس’îË}ûï°Yýàñ«z¢©àé݇y7;bWæ={ô$£°–ó!Y™yïÎãWõŸ®Èêìw}:âûCBÜ·ÏŸ¼n$›KRîܼóøeIÃ×k;pꊳž=NÉ.m¢e3ÿ!!œ öGûÂ$x!E°98ÑP^ÑüÅm"Ö“]84¾qÓÎ]UÀ)½ºfò¢398â^šå¬£fÔÅÁÎBGݨ÷²¸wBdýõ…½Ý&Ÿ-ûø­Ç3w‡¸E$µqBdMÌ\¯ák6³3¶ñðíÕÍ\[ÛnrÔû®òÝõ…®º´Lmº˜h¨t°'õ¿1ÐN@‚R.ýü” ÷öw˜±éd|ú»f!$¢ÝÕÏÏNƒŽ˜ÝWݽ<ÃBÔ`ÂùÔ lPú¦Á{?+k¨/JÜ`ŸûWÿÐ=¯š¶7ñòê÷Ͻõ\Öwˆ—Æmã÷ÏÎÍ:´%Ý÷L~MSãÛ» Mrö.Ú•ÂE¨%aŘ¯œw<+on©Í>Lš»ä|åvÍ ¿HðB SxðÎùå}ÕrŽ- éÙY]Q½³ÇÐ…ûî¶|ÿØ–»»w$ëLÚ³%ØRYRJÃ1lφâwœÌÄi:¶-·¢ãëBÏŽJUâ!ýƒC><½Á˜Í+|t$ht¥nãCíéeoËD6¾)§¹ywVeJ­:yxŠ­Èù¶„‰AòòógirÂKܨÏâC}Å©‰7o^¿ráìÖñ'÷ŸÙ3ÍâˬŠ<~üŽ©Œå_>_øþ²BL‰Ìy™ËEfºA6 ×Eßiìï/þ::2¥Cà*WI„g·}ˆ)B³´ïüaPL\BüýnJ˜Œ³_©‰3œnèãéæêîê$-¸ ]ƒ/¤JS2if.Tè4I ëÞì{›½2cKËì•®;â/þù¡d}m=I”^ß½=éó¶†ÊN]õ¤H„hzÖ‹¶\¾×ìkõL­ï_ÎâqtB‰JJ¶òÕ£ŒJîxlßÑÈ«;§ÿ½ Q̸ﺓG&ZKê]€ö ¼z²©oÿœ…é‰sŒ>W‘%L}ÌçÝ~÷®žD_$xš’Š2M²ëÊØƒ>bnâ6VU±DÄBtý€@Ë¥».?È5Œ|ªÕ}WÑ;¤¡ÍB±ªK«$ìF­t»qªÒ#›³àŸ «cÕ·a2@‘¼ ‰‡QôàÏ`ëÞ]âÉÎe§ò¿èsoLýçL2­SGÅOù”$¢iº{˜ÕÇì?Sø¡õ|ƒ§¶ÉøèZ!„è†}-ÞÅìY~æ©ÞÀÁ¶L„þõ6p’W9ëZMk@!¦‚Eo I¼¾®éûŸ€ßÔà…”Zèß»oõ9¬óý½\;kÈ ú”„ëë­—]™lFGa¢b¢Dá}[  ›²qò¹€q]b‚ÜE__;~þu÷Íú}¸ ™/[|²ÐrùnË_(ºy›‡´®™]›íúk˜kí Þfrõ—O\döÞÓO®B|E"„ÿü"^T÷ƒÿÏÁ¹SX1tNNÙ0´“hÍë¬Ì‚z‡ñ»î¤Ç/é*Bˆ¦3hé’ ¯nÜËk@rîn?8:© zü¬PÂ=<öiÔDÓOñèÆýÆqw2ÄôS{?Öö!LµÎ.Î& [ 0¦j'§Ž Bböá×ã÷Œ³Âó'=¯Tð^qõᙑºð`$   }  D­ô íœÅà:{þ=µ™FÔpmM)EFÉËŠ (rÄÞ4EFm»[+ ÈùG» "lYYYŸÿ’’Aÿ}DGGOž¹Z×zÚÏØPý:5a —ËD©šèÌýicì ‰h Áí4Ñ.$‰pæÁÿiCÖ ´Cà€všè’·Qô(‰@A h‡ Ú3'[UG'}ADf0¸NTìkE–”Ô¿ü•!”WÒ, ÈsF™ (2BhúØÎЬ?ì®@â²kT÷÷CÂRµø3A‚Ú!h¢ \H„ðŸŸÔóàðëA‚Ú!h¢ \HÄË(zùµ ´Cà€všè…žwxÜø#ùx+waâ=W\\Ô)nþ ýV™e _@û# ÝÀù[ab -,$p„Âó®í»Vc;x ­†ÂD5¥1Ä)M»s_«êOû6ø¼0¢iø,Øâóþ÷–óƒÜÈö]¸u±9ýãýdů*÷çç´sP‚ÚDÖ&Þ°%2½ZLÛaÀ´iýL¥ß/¿ŽW>=¹}ï¥GâšVÞ#§ sRe"„ÈÚ+óŸï¸bTýŽåçòIy=‡à¹ójfYµùBz­”Qϱó&¹k0Bˆõ:nÿÎ éÅ ty}»€±“‡tQx?¤¥àæþ]§_–4Kjwî5rê0{%'<€“'hÙôp¥Oè¡Jí®Žúõ7Ö î5%ºŠD‘W¦89ÚBÓïd(žul’[×§‹ „┦Ý:¿8pà¡&k/O“æ[B{{y¹ 9XmÐÍV.çøì>Ãö¾""ŠŽqðY[£jé`£K>ú{„kß¿sp„ùöÌGï%W«”Ì­ è)ûƹûoHÿã.šà·5xÐ:²!ô4n¶‰B³<Å-]þ¹žÊ pCO#fïë²åéå‰L„ð¹½v=ÿ¯±}þvE‘ ¯ã ûýä14Å¢J¿ÿ¹²‘÷“VÚˆ!|€L®ÅÊ{)-“t®Ÿ¾Áñßuó|¨2†9§k_í1ñ¦ÉÔ\?~±Ê}Û³sc:`Íë©ä¹8ýi)a¡ס~"æÁá%âü†¿-~‹4 ôÄ>=Ž©g¨‹•—~˜sÇ£>“”–ü."ª’-åßÝÊ@EZZÇo×ËóõÄz‡ï›Ö1c•¯©²¢¶÷¨eÇ“a$?ð|=°ƒþ‡{E\–Æ^';J D³›y9kD~V~”ž©ž¢(FŽsH/—5•Ç$§Fe(|™YØ(¢¬c §& _Pà œ?…¦dêÜýÛªœU¿ø›ùÍ߈&¥ia¯ùýQÝ?? “Òµí®ÛÆóˆ*èwVøüHmë®ÚŸ¢Èhu²×úùÿ'’D쟟¡ÃÃÔù_ šè€vjðÀ¯ÎNŒ¿•òVÒÄÉÝÕJMT O €p!xj¢§¼|SÊæ ï¹ñÍšUs§¶˜Ï<m½‡Òÿ=Dù§A= pxΞ©KUgÆä§g¥üíøfëÄ5÷¹’$x@Ðð¼ §bž³æ9Ëb‰˜ŒYªùúìÉû-‚{JHð„ P‰ýì QiMoNM~‰,{8}ÜãCĦ‡£DÙ³gE‚›}ð =«®®())Dd† ×׫­~+ Èl– Ê]_Û, È!V£ Ú1ß¾•Pd„¬T£ B³Ê–]'°¿œËâå=l©Fåçç·u¿¶¶6ƒÑFV%*K߶Д:(}ªV3””Ðý¢R¨ª ´[†††çÏ9öȯ.ø}­]ù«KÀ]EÖ77Xìß…ŠŠŠ²X½rùß?{ ŽãEyzz¶õ€•+W·~ÙÒÌB"ÒÒ"ŸnÁ$¥%Qs3Kp àB‚íVDDDDDį.à÷booŸ——÷_?+&*&ŠØ l„>Ì#ëIQÑÿ+Ο}ð€€Ñ”4ÔDˆÊòªO]îxUE5¦ª¡*¸4 41K[ ”v/©þÃßœ”ćÊÖ]t7ž< htƒ¾ƒ»q¯ý½;•…"ŠÎm>Q 30ØI€‹Ùa$ù§íp üyXÏ·öš“$ac§Y“ò°X{ê…¸u=× øopËŸÅDÅ¿¬ÓíÐÇYK\ O h‡ h‡ Áí$x ‚´Cà€v<ÐA‚Ú!Hð@; h‡ Áí$x ‚„[ã½-ãg}ÿêrü6Èw±«Æ/‰|Cð?4QzmÓŠ³Ù߽׬'ì¼W+]1vc‹Ú§‹ç™?~ÝÍ*صüi Áá&*^qoÿ±;ïþ¬³7'aª™‘ë°Å{c_Trø“¥Åì>û¸žŸAÙå¹i©©)÷¢öï:{ëYêמ޾°wÛá»oùqIArXMŸ5¼»9ÛÖ ì›JLš,7çüž‹Ï[øP¾VàeÉ‘‡b³q„Èúg{'xusp´ðl‹±sãOœI*'‹®,èâàì;nkb….ÞÀï‰@¨5ÖyÛø­¼’YÅæodnj¸%£­<Œ!ßÑ{î…¼žBãowÎÐUK’†‰ªXL^êþ›F‚OåÆß]Ÿçb?x[B~—?¹Ùë˜?8 a"†So6P|’†g÷7‘c~»·6&ÚiÉSµÐœWgÆ98;‚:£i IDATô°¨§XÊooφj11™(É~¸ÀLDÚ<`ä%½°¸zб[ž®v¡‰Ø­Éà¥G˜ÝC‡{HȸmËåóË¿)Hð@¸µ\›ecaª)CÃ0Œ!.-÷ÕQ,J±ñ¦çÛ½U­BVº|çñ³”'‰WŽ®f£m5þà„È]3ÝÕ%­—?£pY×åßùç¯IÖªb]Z¿ÇÐE{®fTP»N!ÞmmÑQMC)!óÅ¢`6ûoÁÙÕEy¹¹Y1SÍÔ‚¾ÌýZ^Þ›ŠfªW'xÑÞÞÒ²v÷^8¿¡¯¶¢×êK±1g"†wRí±éÅ 7nÖÎ~VÊ¢Âè"’_¾#JÎ¥S*uΆnbÚÃΗrI’}¶¡¨éü‡-$Qyj€¢òÈjÅnŠ©,é´:¥$‰w}¤ä޼%HNÊ2K‰n!à ‡6+º¡WØd#nkw1 :Qûÿh¼¾~ås¯Ciýå?Ô+-mœ¼ü-ÇZÏŒ IØèªXÜqÕ…Œ¥VV<>MZ¯{ð¼îÁó¶T§G®Ÿ>#bÍøck¦ªXö2|ì¨ÀÎ Û× ’dK]Ûº4ðð1ëÝËœÕÝw}ìèƒþ²¼?%MÉ~ðDšgkíÚ4E[5ÞËŒ^ZTB·Ú[•ŽðœÛ·‹´|¬E&cb¦Ñô ˜JdDÖ7êºy›K"Ô˜”ðtÜàÝC˜‘¹ípa Ž  ¶ýƒ„]ßcôx„ÆK^f6è‡Z~[0«.úÅGî¿Á»ëë(W¼-£ðdsqrÜ¥ÈÈȨ˷_T1Ômû8«ß<µvо=£Î?Øí«ôÓ‰MÂÌoŒ…2µ “2èæR“qõh¢Fß>–R-Ù§ÎÙ–XÓ¡ëððU#-¥)e}’ÕÌ‘”d"„úÆÚožå´ 3 †±§›äŽË8þž"¼[Á¦ÿX*…k­ƒjâVf.YdŸ;›¦à¶ÊЉY“ñ¼“‘¡“VQ›•]GZÑ®¾ÚØe±«"†;3-“+cFíÍŒ_Ý„À¯GÔgÅl_ç¥À•ɧÖMéÛU[ŠŽÑeô»ž½ùìý×õŸÊŒï÷‘–ès¼†ç²7¾¾}|ãÂ)c†>nú²íQ)åû±I’$ɺ›ÓMÄ0q¯}o nÖ&gIqƒ^ÃCœ5D; 8ùŽZ#=7kƒ˜ÞÈÈ.I6_¥¢?éf#I’u—†«(¿L­«…$I’d¿M:¶vÖ¸Ðý§|ÅÊŒ;ÿ°¸™zTüõî^²bšvbL£wšˆš‡»Ç9©2d}öQŒÝpkš¡ˆ¼™›«©CÎ{_ÎÍ¿¸8ÐDŠi43‘oø@‚ÂŽ[pj˜¡MTÉÀ\WNbÀÙ†Œ5v¢b†CŽæPtÇÉ9¤É”Ôs ¾nÓ¦uá3‡¹H1T}wg6¥FôTëx¤—+ vü$=e3Ï‹wE'—¶–g8É»ÇOØõ”·!|-Ù‡‡Šct) s‡îÝ:é)Šat%祷ª¨%a¢üˆ¿”¢ïž¼–÷ YT}tLI6Þ˜¨#夂bðÒsCu˜˜”ÿ‘r¼6f”¦¨ºãуºª‰¨ >SF±‡Ÿ¨MZå¢@§Kk˜uT“´ O­ ‘¥+8-½]Iyd#Qõpï¬ÿA³§Ö$þz‡¾uà’+…|¸ bå_Z=¶¿_àèµ×Š8$Ù7Õ¬c1{“ëø5üæ ÁáFTžÒAÒrRd^^²«§ì€³,¯ºî$+tœjb I’óöþþ¹ƒ];étPST7²óŸ¸5¾M’ÜÌÓk"¢³›x Û\WÏukð7{zËHYM<›ÝðñåsÊlö×1œA­æÇÍXe#Ñc[N’Ä»ý^JÃ.5’$‰íp“´Y•AyÈ>·âYÔÈ´F’$ªîïãhïì;~ÛýrªŸ"çùÊ.bj¾*¸- “õ¬ÃS¹$+ïd¨ž¨ÙÂÇ‚ú†Û\ßÐ^8@<nœä·¹þÛÖê‹“¥n£Éw›37`ûØ„§œ/Þûnñ¼3‹Ö¿ò\;wÝÉÑë¾»·ãÀyzd玆ÎÙ§köÚÇB’‡Ð4$^»'rac#ñ71”»NݹàbÇݱ/¸NÖ<Ÿ4hJªÊØëÌÒ¬Š<}—Ñ}£8B¨)#-—îK½[˜®hÕgÔû‹röa»c¨|(½u3Ó$ìÈT;Eú§EDõ,ÑåòÝ7ÈVŸZü–ò¬”ô‚ö×+MÑÌÓV‹Zd„"ØÍ,ñ)6Q=¡[¸æùôupòoÿà3BŽÃæ`Læ·ƒÃ1:ÃqœÒò7ïHi žÖ³‡•8_ÙºzUéûñÜ$«¦¬†E"Œ&*%Mo®kâ’4YÛ.~ý,$yΖ$‡Å"$ee¾™·N“–“£±šYTÞL9plŸÅC‚³k<í{Î[“qbîŒE‡+:‡»«ÿ¶£ºÙl6ùn"?AG8NmѲòÚ ·þÛžÑ&â¾³å&¥K²êîªàanÔs¿ŠŽI¹mSþmßlÀOð1áÆ´qs&¢7nJªþâLÝ’up{4ËÖÑêG«³ü+Lià¦]žM;ü¨¸‰_‹‡%—–––––džª#ÕqPDlfyss]MCSÅóÈ¥ž²-*Á“ü~~äü—¥–µ¶Ñ/8½=²ð˹ƒ É;ö$0­lM(U 0ž{ok)-g=bóÙˆ> XKÆ•‹%ÛnÆÓ¼–˜0#-ñQ-1aFZ­3 ‹¡´MÇÅU7mïšs¯¾X]ެLØv0E¥«ƒ6•ÐDÁñ5{ ­]Í|WÛðµê+c©DF¹{æšgú“DžZÒSYgÐß1±Ñ'V÷5Ô Üqt¢>œù…F’Öð'çà ž.³:ºu“θVÝe´CËÈ›åWÅ]Ÿo#þïÇ· ÏÞ5hÐΔâœür6MDBR‚ùé¬Ê°˜ëÖj8ÕOm¾fLÎVfÝɾº‡½^ÆŽSÁšgÙŒ£HYßí÷ú @@=vL£Qg“-OîØuæÆSm<7éµi¯¥ÑÓ'zPÉîè_H¡R‡Âßä½"t†ë}’Ƥtt«ŸÔ‘H™B%ëà·ó~b·M[Ž^¹r4¶ŽSÒµò]=g’·þo—èÆ~Óf½ÿÕgÒ4A= ¦àö×d·½;]N¬S•®HM“¶µgûô¡vJÔj˜””$ûeq9´ø]¥&YMͤ„”$†’Ð7RÉ™ÃE*Lqû^N5³cÒ×të'!ð«Gùðkµ´ð6—ì—Âßìp—óü;ë˲U7§˜ˆhMJøÍ^÷ED/]]·ui¬½t5[¥Û+⟾ç;¼$vãò3Y߯ùñþù;y_j€$I/½8ÞBÛyÆñGÅ|~ýìû³ Å-gß©"H¢âˆ¿¬Ux*çýªµÒFsðyßð{‚‹8 ÜZ.Ð_Zé3$$$8ÐÅ@†¯õ¨æÒ—/KšZëÃ$ÔMMÕxo! iϽ͆³SÒ˜`×NZ2œ²œÇчÆÕôØ6Å™z=¯/|ž’UÖôõ(CLLÛÖÅTághÊ]C§"Ü®CÙqøLZy«MÊ]y÷ÕriŒáè‹?ÞyM¬ÏÜý¼tZ°Ës3K¹9QûwUJû75$ƒûöÂÞm7‚FLt’å!ô{œÇû"îÔÖål µß‚1Å$E?w$ˆôØ\yy Ï‘bÚO˜ëvd‚«QetÉ~~=f„öÎs“}§<»¥Ñ%àO}ð@¸o®oZ¿ýä¹ë)åt {ßAÁ!!½¬U¨ôa„§-·± Om­_˜aþôé²ÎTú…·ôÖß‹Ãw^¸ŸWÃ!1†´¦•gèì• šIQœoÆy±³Ç´ØRî·§šæ¤ùÛÝ~§Ü€ç]Û›Ûj×û' C¯1½yYDÏÙàd>÷a›ûñb"†S®¦luç}N"QúàÌÕ­ƒéêN#¼MxŽü»$)êjM—^†Ø»øsÿºÅVw±,|¸¥ ¬U+ Á€âVgÝŠ:}êÔ騄—uÒ&n}ƒCB†P­ÒsjKK¿œÞÌm,Ë}pv㊃ÕN^ÝàI¥Ÿü3’ÝXSÏfJËJ‰ð§ù7^Ç/¾ç®™Ê‹|YFŒÆ§ò,‚kÒhÁnl"ĤÄxº–âÔV²¸YÛ‚ÆTÌ_áøÕ¥ †‰Èªk*ŠA¦¿-Hð|‰]öøÄŠ)sv?ª 0 {ßÁ!#Ç÷2æãæÍ÷çX»_é?uÕaN¬7 Ç_LÊ*®3µk–ú£DÌ®wg%ŠAÉ’]Æ=ž$-0¡ÔÀÐ 7i „Éa5³?w, ÷º†Öo*<äÃ{¿Ù—ô´ÅØÅL›à!„ô9"„¸¥wöm=v7·²ù뮚¢÷òÝã, ¶ýƒÏ„"ê_'ÅFEFFF]½ŸW/®ë8(ÈÏV"ëÊÉ…þ»λ~wµ#…Åá¾"naiˆjaS»²&˯ÏêÕokCËD©1÷­{ÄøâmƒÂÒ\6Æœ›f%A%²¨”½²¤”Lø]¡¦›N¿š7¢õ& ;QÌî)ÛG Yr1«†óõÀÑN‹U)µm`t 9éš×ÉO_å†Á}ŽxÖÖÞs“l\ôe™_^›ÐD™4hw¿x¿^zÿàòq¾ÖjâÆT0é9|áÎKOKš?­ÕÝòrmWQå1±|™Þœ½' ƒxï}ÔvOkº5U_Ô äPzÁ:7HÎ}g1A6<ßî«"Ñ}s.Åðš’#Û× ’dK]Ûº4ðð1ëÝËœÕÝw}ìèƒþ²¼¿ÝÿÒð@©Ô?üÑt ±E¤¤$ÔŒ(¼pðǃ„›ˆÏþ i©¶ó·”Ëì.<…¦)té;jLÙW³Â0LDNßÉ¿}jç]6›ƒ‰ˆ|ׯL£Ó'I„xIYœ9ßoí.I3#~÷Ë#ÄÊ9uöaà§OédD²šY"’’L„CßXûͳœd&Á0öt“ÜqùÇß“ÂÜA¦¬šö×Sát Ìì\LIk÷é[ƒ3Vuá=ô?GÞÃ"„d¯°‘+F,Øé}x’µ¬L+œ Áá†IHK!²!ûê‘cWŸä–6ZÏ86œqý¹œ‹{GYŠgELÙiä'þó s7¹¿·­ŽóÙÐKþãÜ ÛNšM°£6JÂÄ{ÕéY­`“bt´0®Ý}úJ©G š†™ ¶3.©©»DsiI Qïк Tbüøs¤X@)ëÁ5\§Ùª¯ÐÖQ•úâTOS¼/v‘=œüÛ?øŒ°ÃßœÕsÄñB)=C©ÊWø`®_ÎJ¿Õ}÷^=2Ôrs4^ñääŽ=g㟽ª`Ñd4L»z…†õ1¦:W]Ò3|ûžÁ>¦W\ÜÕ š_W.{õqTlžÆ”Ka¦ÔkÙ|]èæA6iІÍ°sH_ãŠÃ¯¢ûù²ûõ¬òÖzu%y·À»Ÿ(EùáçH­€œG«CÂJ9 ìßÃà›Av²–ü™¢ ~{¿z¿QynHIËI‘yMxÉ®ž²βH¼ê~¸“¬|Ðñ2Š”¸¯Ž Ðfbâšv¾Ác§LêßU[‚&a>ñò[> }"jÓÏÿ5±¯«™±‘‰•³ÿØ•gÓkù—±Ã[ÑJ iNŠÿ—8åV<‹:™ÖH’DõÃã}í}Ço»_NõSÌÜægbø5=5&ÆÐ9Km¬$I’‚ú‰ÒÝâÓn7Q.øsÁM–ìö4Þ锘¼Ü Úi…|ô@ÈqØŒÉü¶U£Ó1Ç)]ýâ…)©Õæc–5þb¢´˜Qè²ñÛ]J*À]Œ©µ¥·”g¥¤Ô|ÓÁLS4s±ÕâýÚ¬ÈÍ­ï2öaÃÈ­_phHH«¾4…˜M™WÏÜ+icº£÷ÀnjP©¿z¿·üɱðÑþÎV¦FF¦]zô¼ñJ.^ŸšÞ/ð_{MQŒ&®jêàæååæ`¦*AÃ0éÎÖÄ–PYoŽ?IS!4ª™Bˆ¶ïNŒèd¨"!„0º¨¤Ôg2Æ3oSdÇ}¹ÖN¢Û†œo^9ž¿ÙYÂníKJû¡³.•W{íÛ[nLP—½È¢šä¦¯¶Sè¾(öͧ7œU·¤‡¢¸Ýš þîâN4½IØ6ÌRކ‰¸ïäkd Œ ‰·Æ{[fžS˜¶qزý¡Ëø’&"!%%õ¡êdì:ÀøÓ=JJF]BˆÞÐôã-Nÿ&%%É~Y\N -~×øР]ÝØH<åô±ä°å¶Ÿë½)ÇN%3µ'ªPz%Ls+³ú­Ç¢K{öSûTF¢,öxlµñDJç9¢èæµawÃ{k}Š#ªé±të䋎×n/0Ó¦ý=²¹4%þò¥K—¢c⟕Ê–>ÁCþý°×Tp'òܵ‡™Å5QEÝήAƒ|-ù° ø3@=nÜäÅV=Nκ>B·õx{i¢ç” Ï5³ƒº¨Kð}9ÁhIÝàéº UÝÌp/k=Tõ*åÚÑý—òµg]¿¿Î™ÒØy²öÖ<¿­ïÌ‚BL:0ßå'_=yæ‰äè¨ûÛ½xŸ¼ž½ÞÑ:j`Zâ,ƒ/¯Aˆ×[\-Nù%'Í5nóÐ-t}îÍó§#/F_¾ñ¤°ITݦWP¿þýûù9Êòá#eçávê]ÝÄ\_Õåæ¼®‘rZtîRxù?éÛxö«›øµˆšë¼müV^ɬÀo¢:=æHTJ=I’¬¬S3í]§H©£8Í™´¢‡©–CØâ_4£K)øî+áÃdøÆ×·o\8eÌð¡ÃÇM_¶=*¥œÒ^0ŸµÏÿ™d£!EÇB˜ˆ¼‘ëèÍ·KùÒÐMT?;6 “QI&"«eí;igâ;ê¡›ã&hŠ[L½QþEß^?³³¸fØ JÝ$ìøIšLi]Ç37¾÷ºžâ.A_Ãßìé-#e5ñlvÃÇï§ìÁf ÉÔú,ÀŸjð@¸±¯ÏvœuåÝ›¬âz’.&%%ú¹æ$xøõ¡>T&«×Çϰ÷ÝZàº÷Õ•‘µ›]»,.uØµéÆ¹lÇÃÏO¦°vQúàÌÕ­ýïÒÕz›PÚhô¿¨ù-õ5 \Q9~ÌT4üõ±AÝG]bwòös1×Qm,J¹u%áw ñÌ0] um²2÷e‹†©º¸Þƒº“ý4æ(_ÈÙíùåHQ¢hGÏŽ»Ÿ­´††úö>c Üè†^a“Zígt¢¶ÿIEä–ýå=w§_£Bd9óX6øÂ¹ý>ô›²f'b« Sä}ÑWµnƒGu£R¸¶…‡§L–yæåú~Fï—`á–'mÝÞ˜•½Ò#œ(.ÏéÎOMË«b_]Ðd »u5 ²€/Iˆöa›ó–âG±7_°Ô­º;ZªKPOžtÝ¡'êìßø÷‰ëQ‡.5"ICÛ!›#æŒí¡N­%S44Cˆõ&áøá‹IYÅu£vÍR”ˆÙõîLµ£œä°X„¤¬Ì7³hÒrr4V3 êuÂáW7!Ð^q3VÙHôØV€“$ñn¿—„Ò°K$IâE;Ü$mVQ~Í*ËLŠ¿ûëßPk­=ÑWJcüõofà…Û]%,'Sk¨ox°¢›­•ŒË° Oåõ i|ybjmiýéwÙ$I5·Ø~ØnÕ Ü‘ÖH©ÈF”]›a%EcÊét2TwßYX´ÏK’¡î½åÕbsž-±Õ =óæË¬þéêî²òýOVÁ.ñBjð|Ä)K޽’TÀ–×·vv³Ó¢º6 MIU{™ÃBšU‘§ï2ºïqG5e¤åâÒ}¥)U,·Ð k~5×oHÕ;“°ÈÓ@æ«sFç©2LV]™î;ü¤¨oØì C:Bø‹í36¥v9¿²;‘´cJØì1Û\ïÏ7£TÓ&òcãQ›õA©DÇnÝí ©¯<×|gUØÎú>žínx}ˆêNDSs.©eÇÜ©{ýîPÚža9yíˆÓý‡X>=à×ÓJ_E‚ý6ãÖ¥èGM]7ìè cì„į¾Âàa¿¹ÞßÁPMUÏ~Ð_ ï꟮ë¡ðq”4&ª×ÿKª#‘ˆŠóÁª"¬=œõ%éêC#+‰–ô¦yꊊۯ¥VÇ_mq“ë¾øjæ»Ú†¯5²(ކ\Í›n)鵟ê>_‹÷ô’Têâãž/Üç+¬˜²Ç?l0Ó’8ÓPÌfõ ^ßlîÛ[ °P”ê½ïA’$'ïP?­÷+ÿ`4y»™WJ)‹ã<[b!ÑsW1A’$ëÜ 9÷ÅI’ì{3 ¤ŽQ‹M’$‰W<>¼ ÄÝR_MYIEËÄÁ†+y°ýŒð€„Ô£EDirþ£ÃFûšË+vuµ–Öô]wíåÛÊ·Y76h1¤½÷SÖÜ~bш ¿~“¶Ý+'H²îtˆ®yïé§²(.Q#À…nH’x=ÞX”.oÚ{èäyËV._0i`7-qº¢[DÚ·ëÈü'xΛSC´ÄlWgPŠL’$IâõEi÷nÞøÚÍÄLèƒÐ„TÉ;º•s×÷‹}Ë88[2‰ëh|l¢§©hkаšš©?`3l¦¯ñœ<[V0 ÝÐm‡¯9>| £â9ÿl‰*kÎ=8ÞåÀ†˜„ØçMç&Þ]`þÓ¯ƒ®®¥Þx3íîÓ‘ŽP]BÌm–ÑøŸ–÷ã¼H{Ahöãm_¼w))ï ýƒ:˜6À~ŸØ¤ða"L¹³¥ëVN BF¼DOÒ3|ûžÁ>¦W\ÜÕ š_W.{õqTlžÆâ-ÖIDAT”Ka¦¼‡E!ÄÉØÙ§×ôØηã&hš“näowƒÍfÚ?Hð@H$MLüã”/qq1 û*Ýbü…Ô˜´ÒÓ7<©Šøö˰ útYgžó2çñ¾ˆ;µu9[Bí·`L1É/fï‹ôØœ=FJñq.Ng¼H”½x\.ßÉL“ÍMÙqø,1¿Ööƒ§)vQçe©Z†e`݈ˆ‰+Í#Btò·¯¸P£7ÙÏâýi¬KÙ¾x_žîh žÎs HFNæC±¸ ·Ëä]Ü,?Åb2™ˆøî£ýI4õÀ}ûìÚùOìÃw:"EO³Œ¦Ÿ81µŸ¹ Åw¼%a늛ƒ i};;=^ú,0Y§e ¹Ã“>Éoì`Ó³»¡ †" šL§«VOï×‘× ‰r}ÝÙæOuQšïBÆÎßž"ÖcrÏ;ÚrŠc¯‰¥»ïq•á-xSifnY çñÙÝûe;öTïøUfgÞõw¥Év4U«.}ÇF¦Tç{‚?ׯÀ¯1@ìßþ7Äœ¥4ÈNƒÆ¿Ö\¿où´ÑÁý,¹RQ“rår*…ãñW»Š‹Z-HªoåNÎë£ýÔ˜:“(Ž:lx°ÂQ‘Îç…n‡“w<ÄèÃ2²4YÇ•I’ÄóŽŽqÒ—¡1Ôý÷fò«W¿­ -¥Æ\íÙG™c;†¥¹lŒ97ÍŠ—•èÎ PѸµ fT«í œ¤¹ænq¡ž,íÄs‹/Y}¢ŸöØW#™çª#õMŸ…˜””(¿·¾åÖ»ŒGÓß1»÷´VAá¹G§.º-ï5vrhWUž?SVå›’;)Üc•Ü®‹Ó¿^ˆ£‰)hhȉð—,=h5ûûÃ_ìÆº&‰ÑŤ¤Å>=M}LTʆîÐ ßþA‚@@ðìýûnJÌ}]ÑBbü4þIóíi½cºí¾øa´7Âd3v ò˜[7?íÖtƒŸN•dÙ~oÝ%º v{¶šWˆ¢Æ;_ËÞÂ{bÀ³þêf{k\þÕ1|ï³øC‘U/ïf2­»R[×ðKM™WÏÜ+ÁôLÒÌ{`7µßñr ðôÁ 4þ7ëfü[çÙ뇛Kc-o”´·0dsï„uÓ ä~6"&ÓAY´®¨¸ŽD­6Zày„BO*¥¦«›šHŸ-}‡#e8ñ „ÂäºÑ?ôYpËS¯_V£`îìl£-Íë-aâ=„%4ø?@@1hü#6›ƒ‰ˆ|WצÑiŽ“$B?]#íÚËU$l÷îÔA‹­¾•…Š8Q¨âjDiD¶´oøº“£ÃT6-îúM#½°a\^1qæöûöGÞï#ŠšS#ü=æÆWà$Â*náçÏ/t’ã¡ZO–ìîÝqéåì­=  @+ †¹›‹Üím«ãÞ~±Ñ-·ð¶S…fŽv<Í Æ: \6Ïòå ¿§SÊ9Ÿn'êó®mÜsü%FЪÝxéÆ3ÖuW–—————W¶™z57ùÀøîz2’ròŸ)w_—ñÃfåöæAxÀ€M/ô†- ±d D³ôÓ{Óݼü”¨Å3VŒ\y¿åߣ´†Äqœêì|ÐNõ54‚ðrsoŸmœ°KWýoøD¼hm¯y†ÙÌ+Wf˜ò^þá h<†µšwé*cì°eCºl”R72ÖV#êKs3_Uqå,GˆÜ2X“§ M½×¬õJ•?ÑHµÏâ³}_~×u)W¦ÐBdÉåsw¹ÝÖnæ¬OCú‹·½ˆ±ÞsöÑ&§î¿º˜àÏ >Sî:ávÊŽÃgÒZªOSîªL-Ÿ d4LÑqö…—CŸFŸ½ÿè囊&šºQ×þóz èm.ÏóÕˆ »*þXiM6ãõ>¼§u‰ñ‰.‹ý>,2@×·ê,õ.7!Þ<É©.ÌÎÊjóäŽ1åµô;Àìx! >Sê6tÆûEhT‚§8ð9xÄwÓ=Th!„ɘ³QýdϸãRË7‡RXª–©b0TAÛ4ýuy]NÝÈÊÎBõ_× ø œwO:{7£°J1hÃ:ëܘZ3{u~>ßàËUp[Çßk6îúy!&“‰xof'Þþ3Ì⟶è…$x‚[‘|î` X8ظ`ï >›Ó¿hª§ëŽ9=«3/ÿ}[úzæˆÝæ§þm…ºåÍÕµã&üWãux5…R—ÜŒ˜;oÓ™ä²[”`tiƒ^a+7,dN}.Y÷p¿Ï²{ÕŽêD˜ÙŽøáQý®Z,мî¢ LsçÔÉ—)-CDjyW®èáúiÅ|¢øyzµ¬¹¯±iŠÞËwŽn{&&nÀÛêüàó«WÚ jxº©·cÏ}À&¹/ÖØŠªõœ0sL ½†]ÉsytJ)¯KÂýj$&n:æü›/Ö¬#jS³‘§1”»M=‘QÏóªeœ¼#ýµ˜t«A‹öDÝN~‘•ñøÆ©ˆ)žzâ4¹®‹oSÛûœ$IÎó•]ÄÔ|#Up[&ëY‡§rIVÞÉP=Q³…¶àßoi££„Œí´“³2®-u‘£«Žˆþ¸‚`Sö‘ÁÚLÑWêx‰KïtךœÀŸÝxÁ<üÆJšo."n2âHz N’$÷Å[ñ÷K±5W¹¨˜ÏºÝÚz°ÿΛ ãÌ%ÄŒ‡Ìg“$É)¾¹&@_œ&aÔoý­R*I½§·¬ˆÁ°S¯Z¾¹‡¨IZé"ÏÔŸ’ÐH!>Iâoþv•°ZñœK’$ûc‚'InæZ; §ˆhÓ–ºßÎ…ÃdìoSòϾk ¼?BˆÍf#‘ïú~é :¶©]â§Dgæ'ß¼pêÜõÔŒK:2BGâ> þIJ:з | ¾DðYqÚóje_»ÖÇ1:zº«$Ç&TðžÏhª^q—f©\_ßHV&l;˜¢ÒÕAèv5Å$5¬Üƒõó0WüðÒ]¦=µ{ñ`+Þ§,t|ðé…öÐÇ ²€ïZZØ_ ‘Fˆn2÷~ÍlóÃI#ª*ªÔ÷”†)º®ºrE2¨ÏÚ‚‚:‚£ÓHVc)®%ÓÖÐjLFVc57Sªf3lfmŸv=0¸Óm=j+Kä6L|ž}9U|Ð?sœxYC|‡!¯cJqŸcÐn@‚€ÏTµ4èEÏ3ªIÛ{ª`t¦È§\NÖf¤`T•xk=Kºs»åS’uš½Ð{ʼÁM›G~Üõ›&oìÐYí§³%&£©)]—•YJôÒi­dì칤z jÕlLÁí¯;Én{wºœX§*]‘š&m=jÏöéCíx|;mƒÝäà3¢xŸé”Ò‰ñ‰9J{'+e¥‹ã:é q“ZM¤ÿF‹Žý°û^Ä}ç«aê?_©¯ 5œ÷0Âå»Rãûût™üvæÓ‡‹(l×6ö›çù2&¼,¾h Ôàà3šFèêyÝ—úp·í\8 ÓÇU²>;zÓÔIkÓ gÄà)»#„Î&Üjùá59MÞ˜·=ìeý.èê8w`©øê}ZèŒ[ùäÐÌáÓ¯Ë 3ã1»“õiÇÂ—í¼’ò–#£ï¼hÝlwÙÜK;Äf”Ö46T¦=iÿx™œ°uà PPƒ@ÈÊ»k‡ [uµ€T2îÜI_YŒSý:ýYæ;¶œÝ¤g6êü–—ÖÄ»¸ÅýCÖß«‘5tp²5TÇ« Ó“î§–ú¶\84®“OaÉòs!–ƒNÕ¨wén«M/I¾“®4jºÎÙuÑ,M#ui&SBI¿çÔuózv€<| Ai~}ûì©È¸¤ÌÂòzRJÅк‡ðPÿμ‘þ/p+’ÏíÝöúƒŒ7U,º´ªA—þ¡ãFxHòš}ÉÊ£}´ÇNM¸³¦›4†PÓãÅNÝ×¼4›Ÿ°ÆQr:‚  PxÆ*{Ûc·2Ö9¼o·à>žoÑ=*ðnú_v¿eCí ]Žã˜„ÔçLJVš&&. •w <ÐA‚Ú!èQv÷Àúuªï+dÙí·Ü²ÄCŸn@ˆÖÁyÄ'eh´€`@ ð´å66á©?\Åžaþôé²Î¿õüþ4àFñã †Ñh4¨¿ÀWà€vÙí$x ‚´Cà€v<ÐA‚Ú!Hð@; h‡ Áí$x ‚´Cà€v<ÐA‚Ú!Hð@; h‡ Áí$x ‚´Cà€v<ÐA‚Ú!Hð@; h‡ Áí$x ‚´Cà€v<ÐA‚Ú!Hð@; h‡ Áí$x ‚´Cà€v<ÐA‚Ú¡ÿT-§ ѧb²IEND®B`‚seriation/inst/README_files/seriation-2.png0000644000176200001440000010622714724362460020225 0ustar liggesusers‰PNG  IHDR àõîHc pHYsÃÃÇo¨d IDATxœìÝw\Iðg“!ôŽ‚ €Š`Cì ‚]°—³Ÿž½{öÞ{?Û©gï Å‚½¬(Dé’Ý÷ÐT@æEÂïûɚݙì.ûìÌÎÌ2Ç(^i~=x„ €à<€B€P@ð @!À( x„ €à<€B€P@ð @!À( x„ €à<”\äÉñ­œ[Ͻž^òü2o-hãâììܲç_qɳû…Øð“ãÛº¸t˜}%ž+í²üè7ÙoE(†äíö®ÎÎÎέg\Lúÿ–®¤R®ÌníììììÚwëkI1’Ý\Ú£sçλÚLÆ¬Š† ;6¶µ‹‹ÇÜ«q¿á©ª ¥]ùãÒB}oÞ¸™A$Ôþ ®TlÔëÛ7n¤püJv¿ÕʼnûzfêØ¼¿˜œÙP‹)íÒüè7ÙoE(—ðááÍþbRQ˜ùÿ-]II"ünݸ‘F|«z ,¿ˆÉÄ!¼<Ϥ¿jÕÉÙ;EÆ¬Š†W¡E#­‘›Žß _èúxuSµ_š9H¡ (R¬˜q8ŒUm0z| \/Ë+žFK+++++s}a oò~aVù` :O\ŸùvëÔMo~¯†0…<”O’×[Œ=*!å&3O-tå9©Ïúg™Ä·øï¿,²ï¹Ä·÷¾ùð}ª^Í6ƒÇõ. Sq¤Ï‘ÿŽ^ö H2j8àïñŽÏ§÷ÿçE&£â<ÏkN3¥ìµØØç§þÛwö¾ÿ—tu+—?ww4Túîõ¹ýûÏÞyù1&] U±Z]—.}º7©$,챡nóÏdt:`Å'"bÃŽŽ°å•˜¶CÿÛØ>ñÔ†õGߨNÝ3¾® hÅ âßz8èuûÅÇèt%J5µëÕ·cMœŠAá›(â~+¼$%ÿE=|DúìÞ°ý¬o¤²…c³–»v¨eÀ'6üظþ›_ЉQ®7ñЊºY0õæ‚îó¯'sŒ¦ÛÂ#3pÄŠt|eÜ-¶"}SÓ âk)çFåÌ/í=råQ@X\:OݰrÍFþèÛÖF“!"6ìô¬‰»®>Î$"bÃÏÌèõ©NÏË»›1ùfU̳bm³ =›ö\zš¢b\Ãù‘CZUQÍZOÅq؈ÆÆßôY·ìüÐÝîÚ¿a£SYÇ(<ÉÇ Í•‰ˆHØõp2Çq—qÿoizìOÈY/äge""üçâ¬/3ƒ ´å^{%óÎݪ0Dį4úzFvâßu­+²×c&í§ ©«DDŒ¨çñ´¬•ظËÜŒß\ÉZcΆŠsJ›úr³G%åï.vŒz!Ç>æ®ôñ‹ùµ”âUr!)ûç¼_ÕH™ˆH©þ܃‹šèðˆxF]L/Z186æÞ²6&ß„4y%BòÓMq¿ý¼$%üE=|ßÊ|8ÍF@D¤\¯sgË<û€»®x˜Àqâ×Kê)1DÄèô<Ÿ.ýúh3>1Z]F³ùç]”ã[‚Ý’°ßCHDÄ·úû~FVfwç7Ñå}¿E‹?K8Ž¿]VÿÛ{¢¬óÿǬŠ{VÔ4±í7?ƒ§çºþUzî9±»£CŒÈuó' ¿<”%ð™þkš©3Ò‹˜fåzM¬t”r®Wy"DÒ­I¶Ê 1+x†íÿy™Èq—ùqwg‘ÀzÚÃì-pœ$x}3e"Fèº5´ »W<”2øôk£L¥—^·-9MˆläþÎÒÇ…9"ö@guie®Ÿg|ÎF7»ª1y<¾­• CDJŽKýscãtVcˆˆg:òZ:Çqq:I+x|ýº½gl:y?(^,I‰øòåË—ˆØ”ük9lôîª ‘RÝůs›§s+Rß¿(Å¿˜ï DD$¨>ýQn‹ªøå¢:J  ªMñÉ,pEÜoEÛ!%øE=|?Ê ð<.û#³¾«£CDŒV¯‰œ$xCsi°¶št/ƒãØÐ-®B†ˆ§Óóhlþùåø–d·p?Fe69ìí«—/_¾ Oæ8ŽMy{qž‹ˆH©þ²·Y[(J€/öYÁ¯<îVÎŽÛç¡Ê¯âð+¹‰¹Œë£+ñ‰xúƒÎ¥qðk¡“@ب7o"%D$°iѼbv"FßÙ­®ò©«¹êÅß¾OãˆHPÝ©®zÖ—<“–n5W挲¿óNÌ‘$xßP׋YÙqñï%ÒmÄpÎÆšÎÝÛœ9ÉJ¾>9´äÉ¡%ŒŠAõ&mÚwê9¨_[ÕüǽH>grD<£ †ù¬Á7¯_¿Bö÷E*†Î‡€ 1ñôš8Û+çfT­y3SÞÓ ‰äÓ»À4ª¯žÿ&Š¸ßŠ¶CdÿÍ%E;|…ÔlÞT/ça‹a‹–öJ^·3¸”wþ!žu§ž§Þºš* ¾xá岕o\òI爧Ӧ{+í‚2üùñÍ,ÁnÉ#ªPÍFèwú¿-'®Üê÷ú}Xb&'Û EqqÏ žažóQ¨¡.7ßnœghlȣ̄  (–L1°ëWB€E#öÛ1fÙÕ8–ø& –÷²(Áè].)!‘#"bÔÔóöÓÒÖý¶Ã/—””Ìñ4µ4s®P<<ÿ!".)QšõúÖ×ßoŒgɘ_á½·Tí¯Ýsú^P‚„#.=êÕÕ}¯®î_·ªûÎëûVÉçqñq £¤¥­žOWdF]#÷ë"C3--“ˆˆ‰TófȨ©«1DÄq©)iå^Ê¿ÛD‘ö[ÑvHNŠbÿ ŽŠvø ÈÔò쀜"pé©iñL=z6ûûÚÅñ[ï‹ïÿ¶»t'™#žn›înZgøÓã[’Ý’IÐþ>.ƒgpD OE§r­:µµ‚ÎÜ,öÐ4IqÏ "úéžf´t´"âbã92-n™ 0ð h؈Ǟ‡aI`Syܲ^DDTH•…ãØ<ÿþf½œ- “¹rö¾°ß¬§¥£Å#’$üs¸„4¥!Xö)4ï¬:Œº†C_‰Qk»úÚR•ïÊÁˆ*T–&Ywž³·óœ´/¾×¼ž˜µþ^ÏuM¿ËFD<ˆˆ•°?­›©Œž6C©õñS2QN}4ýSpKDŒŠž¾:ó}e,§4EÛoEÛ!,å§(iyÑE;|…‘|úðIB‚¼ÿ#"ž¾‘>ˆ©àÞ£ÅÄKç“Ä/Î{ú|=†%ž~›î-5 Íó'Ç·A vK>R¯,z,8ƒcDÃþÝ9·kc!…mu;'C€”è¬(+‘þ•0<ÔÞ5ìQP4Œº¦CDÄF~úœJDDâÏŸÂ$DDŒªºº4ˆ2|´W¯$$($; '>÷ªÇT¯nÄ'"ɧc».Çg}›á·wߣo¦7ã[ØÛiðˆHüÂÓó]Vn)w÷ù&7C †ˆËøš®eç¥f64ðýû÷ãY%âbîí\4þüù‹öˆ$ASòûÍ<='IˆKüÙÕµ(Å %§:ª —|ù¿ƒ³ƒ vtÇÙX–ˆQ®íTK¹ÀMq¿©$%øE=|…¿=²÷nö>O¹³û°¿˜ˆU8Uàcر§‹:C\ƃ sN†Jˆ§×¶°ø^”ã[’Ýò#ÉǧϢX"Rª3`JïºÆB†(É÷Ñ›Bö@wÃ%;+ ÚZ|\ù¿óW/ŸÜ<¾y…¬¡<9½è“/ ‘>ßdø-&ï¾xûÚÑE«dÎí¥•à5PÚ“˜Q¯5dë…[WÌnc’5P.§=±¿‹ˆxÆ­—\ ˆNÏLxwnv }ñ ºŠ`9.áDo†ˆµÚ#ö? þŸð5øáþ¡vÒîÚU'ßÏ¿WXüá®ê ‘À~®ožʹC¥súR±}¢‘ôi8üµíêsÿç×vŒ¨+­3Úw‡±…l¢ˆû­H%)ɯ(êáûAžarŒÀ¤íœƒWn_Þ?«uEt¸™ãÒWÙ%a¿è’;-0ϰÿ™:Håø–d·üÐ3N´®©´3žFƒÉžÏßûz¯ëY5kbºnkýÝ|팰’¹ÿ›Ïeø.¨ûý4og).-ò½P4«mjQÙD[%¿ —÷90(,&Y¢¬i\¥Z•Ÿ½îƒ ÚèRcÜÍtž‡ßê.½|§}ö}ÏOÓ¢^íJª?¤)B1ˆˆM ÷îSt†²®©UUo;ñÿlEßo–ä—üŠ¢#7ÏÄ ÇÏ>¥pÄÓ³ihgÄÆ|x«b^ÃÚ0ŸÃÀ~XÛÌvâÝ žñŸgßïl[´÷üéøÊ²[$‘¯î½ùÊ£Z©–£…fV.=öÓ» M+[3MQFø Ÿ€X–¾Kûá¥xª’Ne[›Šj¼ü³ÊúÑÅ>+¸hÿ{¯"Ä£RÑÞ©ªt ¼ÑÅvÜÍ ínÞí¥Wø)ÅWÚw ãÆäZf¦¦¦¦•>’Τ#‰òi­Ä1Â?þfádcNõ3æ£Öjk&ýü?Jò]ÒD!âUr!¹´ S¶dJ_  ¨:ñNji—E!¡×"@É)ÕëÔN7&ôóçàóÜêºöìÛ³Mí·¼ÍäU»Ñóú›ýþÐ3&5Qʵ¶ù–±w˜—Q7æ¸8Õ¬ÚhædŽøUzöo!*í"•)‰W7n÷ËdtÛ͜ذÐ7%‚Œà~µF /]^;°AE6ÎÿêÑG/¾ˆ’ˆÌš ^wùʲæ…‹þe6#WŒª®$y½mÅ©¯xô&\bð³G/ÃS8†§QsøÚ©½òÃí]q(”Uk8miD"¹À3x€_ˆMü™$QÖª`QÍ\7ŸþÆrÅ%>Ø6ÿàkֺ缑5ñHS¾Ø°ûG½ßdj[ÔjèTUÓ†ûåâªeg?‹œ†Îík÷ýl>ðk À( 4Œ( x„ €à<€B€P@ð @!À( x„ €à<€B€P@ð @!À( x„ €à<€B€P@ð @!À( x„ €à<€B€P@ð @!À( x$(íȈ ¼¼¼J»e‰ÍÆK»òõöíÛqãÆI$Ò–­ýÃpWÚe ww÷³~BÒ´’GævÚŒ<²•25T‘SÎZjJrÊYIIŽÍ¶Uu䔳’@ŽÅ–ß>1ÔW•G¶qqq . “Gæ¿//¯ùóçOš4©¸ ccc/^*RÉjð ÐÔÍ;yd¬c(ÇoRI$§œõµåu렢—SÎDT»Ž‘œrV–ç}‰üö‰™‰º<²ŒŒ”G¶¿!==½&Mš7UDD„< #?x €Pƒ€ò…#b‹ÿtZ†$¥ 5x„<”3qůˤt¡ €àšè ¼áØâ··Ë¤t¡?Á%øœÑ³q5c ¡P]ßÌ¡ÕÞŸ2dÏý¼ÉEÕtäµ "bW7Vµœx7󗕤Pƒ‡Be¼\Û±ÙÔ×UûMX:©–± >øÉ™­K:6x´ÛçHŸJ%¾=dÔ¬š¹»UÓÃ}&À¯†…ɸ³yõ}Íž—¶·ËššÕ½W¾]¯9kï÷XÓ¸¤Óž2ÆKx”¼˜ÅÀq²´·—¹™ÝQu‚¤ å´MMÔsçeeôÜFÍ×µfödªläí5›Xé‰T5Mk{L;ñ.Mú}Z çìnõ«è‰”U4Œl]†n}ÿÃûq}3Qn}Q’@‘ ÀCaDu:^®8dõé'¡)YÑV£áð•+ÕV""J{º¤c»™w ú¯;rr÷”zŸ·þÑvÊõd"ñ³¥]z­}W}ÜÖS¼vÏižtlLï… }Ö.CÙ°œ,Ÿ²MôP¾ÍØ}{#†OÛ>¥óÞÉ*ú¶ œ]Z¶êн››µˆ¸X¯k}­¦><:ÇA‰ˆÜ¬žÖÙtäþªµ?§š¶›=sÛøF*DÔ²©àþá^o’¸†¾Œ‹/0‰_ë ¨à¡pB«î«¯t[þâîµk×®^½|jÉÐMó¦6œzôô"}±ïÍ»I6ƒ;×Èz/¨1ívÔXRUf”:®8בˆK |÷öåõ½÷“9ÛB`1zÅNB=ŠeY–ˆUppë3aég {¶³·ÞãÖ=È$ItT4cTÑ(÷¥˜‘¦¦H‰ˆ‹{¼uHS m C›æ½&mºŸ TþY=\†$2àˆX–“áSÚ/x(Dò±^š¢V[ÃóœÕ|mû †;òBü^Æp< M .:*†Í^ÊŽ{pÛ74=ùÊ´.c½µGžòŽúðüæÑI E?‰Ö2$([$±7Oü»~Ó‹¾áéòÞ<BhWÛ–|ìñKÍó%óôq gl]M‡QªÝ¸¾Êë3gÄÒE’À[¸¯ðI }ú,R»íè±.š"b¿~H*üÞWRü$eIŠïÚvÕk¸^º}ú6&_ùZèEŽ‹½4²š¨þ2‰lÛÃ3x(ßfÄʱG;ÌriübØÀVö&š”â{nÇfOj·}beb »M¾ºÕÂÎ}¹¹5>z.ZüØ´Ï|7­ J¶Ú±ç7¬öÒic”ðêüæ%›²’ªþÏÓ›°© Õ LRQ 7¢ð É4¾„Mô’wÛÆÎ¾c<ñÚeMµ2ý7{4?r‰Ç‹5M„”1òÌ„¡ÿ¾בy‹¸pBaíË®ÝÞõWÕKÇìÝkФ5â§Ÿºsh`e>‘zÓ%<§9nÑÙcà²ûúî=·ÒUƒ4Ú/?²¸YÔÖ.ÎÝ&íùÒj÷ý#ìƒÖuã[Ð_ˆ IÊ IàÉÃ>ŒÛ¤©M´"e›!3ûš;t¯€†z6ôȘї¨¢°O*Qƒ‡ŸàéÔî·ôH¿¥-˜¶ž}¤õìïS5Ÿrèá”<ßÔ÷‹Û ýרk©£²Ö2w+e\’”m©ÏŸ¾!‡^³&%åºÍ‰6?{ö™u±ü¡ª- Þ5|ü£V›rǼ”y“¨Á@ù"ª¶øŸl’ÿ’ÎÓ7Ôωº}]úò9üÇì™o7™Ðeëªö%ŠÑ¨Áü\LLLxx¸®®nA+¬_¿¾_¿~ù/ãÒSÓHYCC9çFMCRSÓ¾™þbÍàyá}NœtÓá],Qà ¼áØâϢŲ˜ïR§¥¥U`bFE¨BIID*YEHNLæTT¾›ï#åÑ’?—%þunQ M†Jðbn"x€¢ÓÑ)pÂíÂðôM*(³áQ1,iHÛÝ%1_ccã¼­ð\̉E«_UlãzyÕüËD’÷ÏR%W7-Û»ÒD¿˜îàäMèPÏŽß}8Î\‹ˆ(Ó÷ŽO²AË:æü¼kñt¬ê׋‰¸{%‚ˆˆ‹ ÍàRÞß¿*N³ì7 P‘ =æJ6 žoÙ¥WÃùs6n}î1ÕAÈ~>¾öàGó4V!"ÊŒ Šë˜U1è°úZ‡œ4ÞCL<^ Ûcš ¿ÀŒ †^ôrdz¶qIÃÀ9Ík4rknW{·Ñ¸­³š¨±¡{þ¨Y½Õ ß_û~lÔàþ„5Çž}Ñôœçµ7qÂÁ‹Ý=šTR•.`´þ9{n’“éwõt¾•û”Ù É:XYu-FÏP.¯¬¹)Çùõ,+Ê+s±D^9«È)_""‹K2¹0ªÂ2y ”Ó[ÍÊÚËÒJ 4¦ª%""Am¿j{|÷-£í4h–Ókó­Ü'Ï’}ch¢P@ð ¨L6O”Wüöv’”.ÔàjðP¾pD2LUË?IéB @!À( 4Ñ@9ÃÉ2UmYk¡G€/—؈ÿþ{3"¿ó›Q®ÙcJ³Ö]Óê5¾ƒ…,ó@éC€/¸¸×—Oq !oB2 ¬, TˆˆQJãIõŸî_´²R½1ðe|yÄ·yâÙHé¿ÓOôÒí0úÔ£Y5r‚9÷µ´J q²LU[ÖÚèà¡`lÜëó'/¾Œš9¶óhf®šý=—ôᦗ÷£Éª¦µ\;´´Ñ–öÕLyv`½É€ÎÂK;Ï}àtªÔwïîj¥ÿúÜñ ¯âÕ«¶èì^×0ë„}qéÜÍ—¡I|‹z­Û7³PÏž0^üõÅ•‹÷ß„¥ª™Ù·hë\MS.3É(<xÈ'95Òåì=QuÓd¿;S¦ÖYtëúôZ*DoÿëÓv”g”ž^BÀŒ‰S\Wœ?1¾–ˆ¸”§û.ŒõÞôIÓÞ2Íoùœÿdyí_m[ƒð‡w§-têéöºLòƒ…níæûªØ8Xi&}x>e¢éÐ÷6·Óc(õÉŠ¶mf>T²©e¡æ÷|¬Á€Ãwwt2BŒ(6 “ƒüqÑ—/q³¼ºsñÊÓç{k<Þ±ïI&¼cÔø3*ýOúû=zôþâã›3†o|#‘¦bÃ_Ó€K/\¾òÄg­³øî†-É“ïúݼtË×kœE˜ç‰DñgV®xj5çþ‡—÷oßléŽ IDATó z²´ÎÇ}»®&Q⹕Kî›ÏºÿÁïÞ'jv`ÉPy½G Ê-ŽXŽ“áSÚå.x(€Rý3=LøDÄè7lRŸ’œÌûÙëèÎuòü&"â8Ïžá!zvÜó]V„¹î FD|GÇJJ&]Gõ4‘¨^C{Ar||&‘Jóy—îo/mñW2ªd¬,IMÉàˆH,s™‰ñÉ, ,GŸ ;5¨ÎQàâ ùcÔ«ÚTÊ>=ø¾´™\ô.ˆ3u°×Ïn5g4ìkYRл i€g„Ú:Ùê>OÏP?+_õ/aE»šÚAžkfÜ£];›?O%fÝ«·=®ÎçuÎæfuÚöŸ´ü O´’¦*úñÀ/Ʊ,WüOi—»˜à!Œ²ŠrϾ¿ùšŠT¶R¹ˆÓCëÚ»Ïõú¨dټפÎoù#û&€Ñn±ønà«‹›ÇºD]ß0ÜÍ®V¿Ã!eío à·€ÅÁ¯bU™ yáÏ“ž=zÃU¶2/jwM6ôÄúýá-7=¸¾wåŒQý;;×ÐeÄÒÜØ°Ç]­Ð²ÿ”U{/< zµÉ9úøÆcAˆðŇÅÁ3íØ½]^5ß;\BD\ô­%‹N$ØwëdSä–t‰XÂ引‰yøÏ–Ë ˲DìWï…zM:”IDD\FJŠ˜¯®.B'zøÕXV–OÙ‚arP,¼*C7¯½Þf´‡í…šÕõâýý>©º¬87ÞN@T´Fz^¥ÎC=VY¯þ±º þ/¢m;4°`¯­´Òêà߃§wÛ=`´}åÍUµ“Þ=}^{¶Wï ðŇ_Þ ªw›9'¦©aÞ¶FT§ï¬ÉZVÙµrF½n¿YkYò‰ˆ”m†÷kqýŒ÷ãOÉÂáKZ¹»fMtÈêô5U£jV*^—Q³Lkdg,¨Þmæ,IMeâUêsè…ƒ·çµ×ñê–“7¹5®,~î²Ûûse%^¥^ûŸ×äuéÙ§deƒa³¶r±ÓÃ) ¦Ì½Á ˆÜÝÝ?ÄXëU¬#ÌïDÊñg@-‘œrÖÓV‘SÎj"9ÞŠÕ³7SÎêÊrÊ™ˆyµ>™VT—G¶‘‘‘îÃÂÂä‘ùïÃËËkåªuón(nÂ÷oF ï%‹åQ*yÀ3x„ €ð€ÊO—¹'Ú¨Á( Ôà |á8’å}ðò(Š<¡ €àšè Ü‘aÞYLU ð11P1«$—Ic,+ʱ?íß9åÜ»†¼.Q:šrœ1&>1CN9'&eÊ)g’çD7êJòÈ6QnûJšèjðP¾p±ÅÔ.C’Ò…<€B ÊÆÁsÅORºPƒP@ð MôPÎp\yh¢G€W,lÔ뻯£r‡:3Œ@UÏÌÚº’æO´ø‹ßƒ • ªéÈkìn®´Ï¾Â4-5å¿-€ò ^±¤^ݪ÷É´o¿dTÍ\§î>8ÇY¿pÊÅ›Òjf%ÏOÿ¶’ã„%Rlè‘Q­6;]ñ_Ó¸àé:¸Èë×=©6jb¿i:3cŸ=|ò&4Q’ýø‹ßÇÁÉ\j˜ï­«·½ K’|›$ãë»§_†$ЉÒÞßy–AD©!Ïî<JÊù‹HûüìΣ DŽˆY;T7QÏmPÈL}ûì‘o@xVÎ\lÀýGA‰lÊÇ'·}ÊØ_Ào¾àééó‰¤7Ÿâ3“š˜W¨ZÇÉÑμbÕÖs/ç©#siûúÙ™VoÔÌ©†¹¹ãøs‘I[ïÛ X²z¨cµº®í[5¬afæ8Ú3TšŒ ÷žÞܼ¢u]Çšæ:ú5ºÍ˜2 ÍøS‘,IBoÕ»ö½ûùð¨Vý¶½‘±_ŽiÕ{“Ÿ˜ˆˆ‹¸4£EeÃJ¶uêØ˜Ywßö2Ä/÷N™ïù13üÂ’Ñ3¾ûî~~ ^ñq±7¯<5nf# ñËÕ=þø7¹Óîg‘I‰Ÿï¬¬ÿ~Y·¾Û‚²B<ûõðÜ&ëüã’“¾Üžiû~óôM/²jýâ·»Ö½lôC\Jò—Û3lÞý;s‹¯˜ˆ Þ1¨÷êÀÚ .¾ûroU½—[>/ÖÛ;Ò¯/²*¨É¦gQ©éñÇþà{N™}"ZÐtÑí³ìT,‡Ÿx~ez]t€_‹ådù”-¸r*öÓÙ%“¾HûÂs™‰aϯ^ ®6ûÀ²Öê”~}릧æ£n¯ûÃA…ˆضòžmï‡ü‡Î°%"âY Y3¿­™ ‘jÃÁ½ê¬XÉñ‰ˆË!k´3W!5Ö·þʹ_"Y’øïÛzï±{÷T7C†HoȦõ®·ß]ŒÂr)!Ÿ¢xUÛÚë©0dÕyÑ¡SíâªÊ½›€ÂC€W<\J¸ÿs_Ué$)‘‘é< ŽxD’E(0ΞÉZ÷«PŸ{÷潘l‰ˆQ­Uß^Eº„ª ótºg„¹‹TEªÒEI¾Oüy'´5Ì^S½IK'ážè¢–ÑlÒ¡¹úÈ Nov÷psnáÒ¢mgB;ß”ÇÉ2¨+kìàßæ¯½W¦Vˉ’©/W´n0{ò¶÷ÿNŽOäØðK[ÿy» 7¨¢.=m‘¦FAg„ŠšÚ‹¸”¤$V`¤¡šû•’®¾&“o€çòÿãà[ó|j½oûÞS6ß8=YX­ËòC{FÖ–ËKÜÊxŧjëÞ®úìU$¼F<µ ½ÿk'ÌZ(NމISÖ%?gFËÐP˜ð&HÒÉFz?ÁEŒÍ`õ%*ŸÎri±á1"Ç?¶øk!eƼ<5óþ“§è|á/Ãâ—r “]9À…*”’(智¸VO<·ãhHV¤Mó[éff3Ì+^Ɔ'Õ†-)ûþ»ò|ÖäyI7n¹™žµU¾€Ï~yÿ!Qšw­ƒ§ƒ ý™O5©\küå$""%]»Ö®vj’Ä„”앵&1(d_ÖzÙ!À—Œš†:#ùøY¯1fÕhãKC4î9zÆìI4s÷¾é¢…]õdœ1–©ðÇ‚©õbv÷tr4qòÈNÚïJ4ÑžT¼J-ÜlROs¶`Õ²©=›u?«ñãf”êôü£zÌîþ-zŒ™9oöØî-†Wj=¤k1*B6äÊöõ»n~Æd7 Ä¡——öw®YQÇ jÃΓû§æ»VFðÙ¹ÝÍuTUDú–û,»&ãHaxÅÂ7´kÖ¼®™ê7‘”ѩߡKSõ§Þ~Œ¶ËÊ›÷÷ŽªCÁOŸ…ˆ\æy?ñi«LD¤TÁ¾Y#kÝœ3B¹‚}³FÕtyY‹šØèfgÊ(×lÖØZ—!"Õz3/Þ=<£•nÄ«W_+öÝs}Sí¬õ”ëÎ<{~Moó/×ì¿Vkþéã\ë[h2DŒÐ´v3'+-†ˆ„õç]º¶mh-Ià£~Ѻm\ð9:¨2ˆgÞsÎìΆAWî&•±Ûf€¥?]ìî1ïžV·%Û׬þéßþmÆžýáê–þhG÷Õ¯-Gl>uöèÊ^·æxtYé'Î/ßaÊ\·@ø­eÞkÕö唀+£LKýæÑÝÝ=oofá(Ì%9þáìñ•״½k¾’Lt4å8¸±AyuÉà1r|ß‘@ ¯Ì­­´å‘íר¨¾}º†……É#ó߇——×’ek&N^YÜ„AügL(Ël‰Oõ­ÒóÉÀOV5I>njUýoÉ2ÿkcÌó^,3®¶ls£ÿݧ‹ë)s¨›Å€À ŸÌµ/öø¢R¿(¼ŒÇWn$˜µëâ("įäÑʼn{xéfÜ·u…´4õê-º¸ÔȺaf4ÌÌu™”äYT¢=üRŒ¨¢}S‘…¯ÈÅžÿ•WµzÕì¨Ë3´®¦+¹ý6HBºy"±fÛeÛfÿGÿúЖÓa&mZÛüæÍ‚!ÀÃ/%pœæu±´ P(ŽØâW‰%b ÇqË—//h…víÚÕ¬Y³€-&Æ'r3ܾƽ8¿yõ‚Þc¬oìè\±ØÔà |á8’aP;Ãã3 ³lÙ2Y6ÉÓÔÖbÄñqIeÍÎÆÇÅsšZšùÇmžAM×5©C·¶FÕF.Û7Í=Ïü¤Eݦ,€¢ct¬¬ ¸²+ù\t``¬ÀÒºÊ7a[ühu·v£‡ä<@`ômm )"ì‹ ½ìàäM©®›³VÐ…³~DDÄEx{=`Ýšë~ÓlÏÓ¡°kû\ù’ݾ yø(Œ©lUY†—p¡‰Ê¶øsÀ”p¦Z¶Ç94Y:hT¥­¢Ï.œrY¿¯gÿÊ<"â¢.ÌŸ¸?¾Í¼U},{l¿bД®£'v´E?9´|éã>'zW’¡:ŽŠLSMI_[E9‹å9ÑMïòšœ÷Ы49å<¼,ÃxŠ(&V^Å–+y½ù8øS¢<²‘áSPdʵ¦ž:!;m^×}qÂÊûì:·¤­CDÄ%¿½zôÈã1+úT5é³ëbæìékWüõ_T†È´V«I'—Lí /ËÐcx€ÿIë9'ZÏùá{^åñ·ÓÇgý‡Ñ¬5hý…AëÁæJž@‘,½èehÕ/]èd €àšè œáˆ“¡'«¼:¿Ê jð 5x(o8™ÆÁ£“”6ør¤‡kõ¾â<_pq÷–÷vuë»æa/,ü¿?ߨ«ÍDϨ2vo ð{C}9rÿæ}ÃØÜ0šôxe÷Yo꯹4¢¾¦,³$ý"\Ü»û·^6MÿþUŠò!Û8x®„sÕþß!À—S©~ÿôè8óeíeÞÇÆÔT-íÒÀ¯†&úò(=࿾í&úT›ïubbµìoÓ‚/m˜ÔÏ£]‡îCfn¿*}ãqñç§¶üßÓ§»'tviêÒ¾çˆÅ'Þ$r?YTH†DD)ïÏoœ1¬GÇŽ½Ç¬¾˜5Í8svJëvs®æÌ†ÍEžšÐºÃ¼ëÉrÝŠ ¾¼á2ƒýÙvä5³égNOwÊišO¹¾ƒcûyW’LkØh‡›Ð²~÷ïÄDD™á/nž[Ó¿ã¬G: ÛºX%]^ÜÓyèñ¯\á‹ É0ãÕ†îSú«T¶lïÝ|ø™X–ˆm[£¤ëÛößÈ èÜ—3ÿîxÀ·´ýßw(6ŽX–+ö§¬õ¢G}ù"þì9rÄ CA¼úCº;jç<òf?ïý{öƒªóï^›á $âfõíØnúÜÓ]tÕ&"62Hgùã«“m•‰2Z©:4Ý{Õ7³»«RÁ‹fØE|löÜj}ùü×ɈG\lŸ±ZÿÃY¯rÇN3מ¾“Ú¡µ*qá^Çn ܶ·—é-Jåjðå upÔ@¯Ê³×ýeölÉÐ5~Ùæ\ôeÏ[—áÃí…DDÄh;X3ñöõì>÷ÊMúõ·Q&""%Kk ~¦8§3~¾‹ É0í¾÷‡¡S;ñˆˆã‡8JÓß²c'ûïÓ÷ÒˆØÐÓGïÛôj«‹ø ÔàË.SÅqÙ¹ã“ë°o¶Yôת¶7g8¨I>ø”™>¯™ýÊìh*Ž ÎŒµŒ–ÆqF­¢INuŸaòFÜüœaf\ô—eëê9/Êæ™ÚTSg>¿ª»‡Ý¼gf8W9}ü¾Z»ƒ­µå²' <ãdšµMôðãUè1s\]u"j±pˈ‹mÿµ¢í­Ùµ…Äðyº-Ưã÷„àéÛ*%Ãð ªG翨À UT/ª2⤤4"•œ,x9Yð­=té£TÖCû™Ü_8xÁÙ×_ÓÅ oON4zÛs¾‰Ž¬Ï¿ ÎP`ßïO§´S“ÿ\{ãcBr¤ï¾q£wæçnGPÃÃÝ2øè¡Gz5Ã}Y!À—_Y!þåÊ¡‹}xÎKOþÓ:r]';CUemÛ>§4G84Ö†ÿó\  ^`†üjcöíf|oªKe-uãz“ÞwÛ2ÝI)7¥ ¦‡{Uß¼k¯ÆÂ_ð+Ê)<ƒ/GŽ]=¦oŸ÷ˆ3š-–\¼ß58M'S«ù×¾}Wú¿ N™T­ZI++æ2ÚíW\²U®¡”“¦í²KÕ”k(ºˆˆ ÊH`Þu£OûYo_%¨šÕ¨^QîaÚÉÀ0ûf“c9ŽoÙµ§“²\÷”[²MU+C’Ò…_Ž4hÖà‡ïDfuššeÿ‡Q5¶­güÝãšMó~'0²kbôÓE…d(]"4²©—½nE‡&³pñWwú`Ù·g]¥üÒ@Ñ ‰~7f»Ô¯÷Ç®$·‰Õƽ'@Ià* ¿AåÆí[Sǽw2Ç­'ÈÇ¿O¼ IJ<ü>x•ÛLZÔ¦´K à |á¸rñ>x4„( x„&z(wXöçë|Ÿ¤ŒµÐ#ÀƒBSR⩨È>_!T~¾Šìt4å5ÉÏðòš^`ëƒD9åLD ErÊY,‘ã5[GK^Ç‘WàÛŸJ¤à—JA™„&z„<”;2¼Ü½ÌƒG @!À( 4Ñ@ù"ÛD72t¼/]¨Á( Ôà œá8Yjðe¬jðŠ5ør$=ÒïæÕ{¯Câ$jFUë9»8š«ƒÇ%}ô¹zíaÀ—dF«RÍfm\ìôå51 È|ù þ|aþà«/bµM+éóÂB¢Òuê \±kÝ šjÙë„xMëý׆{1ªÆ• q¡a±é¢ƒ¶yném)¯ù¸J'S{{Y&úò€‹öëÚy…g¢¾~zrgS‡ŒÃµì¾í½˜ˆˆ’}æwêµ)²Åº{Ÿ£ÂߊN°Ñ-aï¾k_‰Kù@±¡¯øRï,³=¬þÒû§þ®‘]W©Ðhè—t3{OŸ|¸ÓɾÁ»¦¯}c7ËgïÈšYë(Ô¹}ÙuËþÿîô™¸¦±´¥žKúpÓËûÑÇdUÓZ®ZÚhKïSžXïc2°—ÏžOâU+Z7lïÑÄLø“E…d˜ôdÿÆÇfƒÿ´¹~üttýI½íq¦ .› /íæÞƒÁF½6ލñ]C;cÜyÖ‡c ÷x~éíæyø.¹lûËî›u]µW¯+YJÿ›ñö¿>mGyFéÙØè%̘8ÅuÅùãk‰ˆKyºÑJæÑÎ7ã«×5K~¹dÚÔšs®Üš[_µE…e˜ôxïâÍÖôpèJoåz£þøÿÚYPNpÅo£—!IéB½¢“>~£ìØ¢‘ÚËøVÍš™Š}=O~ñØ«Z¿®Þ÷ï’UªÓ´iMc%"bƒwŒF¥ÿIÿ`¿GσÞ_c|sÆðo$YÛùpÉ·ÆŽç¯ï\ºòôùÞêÏw|œY袟d(ößu€¿Ü/øÅ¥r{€âB€Wtl|l<©éé ó[ÈÓ3Ðc’bbâãâÒMm­BÞÉ~ö:z‡s<¿ƒ‰€ˆxγgxˆž÷|—•GÌô0£ß¬…=?9)9ûn7ßE?ÍìMíh‚Ø xEÇÓÒѤ䘘´ü²qѱœºŽŽ–¦¦—ÿcû›‘š’’.!’½ âLìõ³o ûZ–ô.H‘•µYö›×ùAž{…üý,CZX™àü€_O:Um±?e­=. ŠŽoQ·¶NÆÃ÷“\&ùpóÖ'¥:N¢µª3>¢¿?}Oö¯ e7í~Vcû75|F(ReØœé JJ5¼¨ U‘*NOYá ªðT›÷ïeqdɶ×ß.à"<nz¦Ýn GU§îuÙk›6?û¦¢ÏÅ\'*ZXרװ^e¼-8ÊÝ7ù´ëâõg¾¦+é˜Ù7oí\]/÷Q¶rܯÅõ3Þ?% ‡/iåîš5/ #ªÓwÖTªÙUoFµvŸYSÔ¬ø….*,CõzýgMÖ¶B]䀓éåî¿â}ð’Ø€;×nø~Q³iìÒ¢V•VKýìãí}/ J¢eÕÔÝé¢lÓ…3eî¡@¹»»«ë9V³mPÚ)¶èØt9å,¿nÀ[$Ê)g"Zèn$§œÅ9^u´äõ‡*fšòÈ6&æë´¿û‡……É#ó߇——׬¹+ºöž[Ü„á¡ï·ÿ3Z,–yòîßµÛN¹–jjm”üþ}z‰'.®pÕÿ¾ 2zjD«þ;øæ5­TB_½K«úç¯-ÝÍ‹_áÁ3x¹“¼Û6vöã‰×>~xùö³ïÆFŸÖ\r÷‡ÌIÞsGÿçöï«/ž>~ôtS‹¨]#§œøaŒS À@9Ñ ½èKÖ& ú†š7ÖÎj’W®Û¼‘(òÙ³Ïß>ÙçDÕÜú jmÛ ÏcxŒ@I–sèd gltø—tž¾¡~NµZ o K÷>‡KÈ2OU[¹þ˜õsÿËE^ظß_§åüz2LÛ<”/É2U­Xœ!‘H˜ðx¼}ûö¼ÉôÔ4RÖÐÈíxɨi¨QjjZíþ™á7W÷hÚk×}ÝwB^RÔà~ŽÏWâóù2ö¢gT„*”‘””A”56ŽKNLæTT”ó‹Ülì““‡NÛýF§íÌ Û¦¶¬(Ó˜ax(g8b‹ÿrw’äâé›TPfãbXÊš€Dó5–161þ¡!=ãݾ?Û;‘ÑbÊ©#S;Z‰dߦìÅ€":Ô³£ws&ŒÈô½ã“lP»Î÷ãÛÓ-ì>ìœþ$ï'gç—$ºjð Ø¬-µêÈeޱøLjUøÄŒŸ¯$“˜Ø|ßü ,4,Ñ•¨p³ÏDÈ)çž¶M%ö $§K䔳Eˆ\¦JNŠ‘G¶@DD|Ë.½Ο³qës©Böóñµ?š÷ø£± QflHP”XÇ¬ŠøâÆ­ol'=™Û\¯Äpx(_8"šÛK8ë!ÏrØÆ%ZMn^ã´£iœ¯O¨Ù¸“³š¨±¡{þ¨ù÷—±w^/=}'þ°±cÕy“öÙ{gQãâv¤G€ø?Ö{öEÓsž×ÞÄ /v÷hRIUº€Ñnøçì¹IN¦|&£^ÿÙs’¾»—`4êU”¡>ðÿ!0¨íñWmï¾e´Ír’þ»Ã¤9~ÕÆ~Q>eÇ¿^†$¥ ½èjðPÎüÿÇÁ—Ôà<€B€‡q ~gôl\ÍXC(T×7sh5d…÷§ÎÀÂ%Þõ¾õ6¡Œµt€"‘Žƒ—áS¶ ÀC2^®íØlÀö ëK÷œq²¼žC=(Q†‚—ëY}úIhJÖy­ÑpøÊƒj+e¾\Ý©õ/j¿`ï‰ýË{hޜӡÝ<ŸÔÂòTvYãwkf-aµq—>=\à$ˆôÖ²ç–PÇ¿w;¼îÏJÏ–x¸N¸Ÿµ-ö뙉£=u.m‚ IDATû®Ùý·Óÿ¯½@Q ‰òÇ·»ooÄðiÛ§tÞ;YEß¶³KËVºws³Öâ%_^»ÚGwÈ9¯5nêDÔ¾[»é¦5^÷Ð,0SeM=u%F ®g¨¯Á¼X3ïpF·ç¶tÕgˆÚ·uRoY{Ú²ƒS]F˜a·åÚšZLÙ@Pƒ‡‚­º¯¾òþËçg÷-ì¤xjÉж5,›Î¼ö•#¿½÷ Æ ]·æêYk«Ôíêa™üðÞKq¡™æbÃn^÷WnàæÈÄDGGGGGÇi5v­.yþØ/+åÚ-š ºÀ¯Ç±WÜO™k£G  À²,ñxn}&,•ĽØ;¦ûðÖux½ªn\L<òsÖç›3±Ñ±EícÏF~‰’$Þd~*ï·ŒÐ4Aà c#9¾a@Á¡ù;ÖKSÔjkxžV¾¶ý€Ãy!~/c8ž–ŽE}‰ÊîÆÅÅÄ‘¦¶æ§›ŸðcØgÔ4Ôø&#¯¥sy±©'zf…uƒê;ȉ ì0„]m[ò9°Ç/o¯9.æéã@ÎØºš#°iä¤uáÄíä¬eÏŽ{­Z¿‘½€ˆ†Ë þ’ ×?ü8î_¥“QÔõ O²·ÀEŸíTûÏ#‘eíàw„&zȟ͈•cv˜å񿁡­ìM4)1Ä÷ÜŽÍžÔnûÄ&ÊDÊn&8ŸÝ¯“ú¢±- cîl›»2Ðöïíº Q[íˆÃ³§5Qîc™üp猅>d™•/Çc£?{cdÛdì”f'öìÄMûËÍZ%èÌòÙ;b:Ÿli€Š;@É!ÀCþíˮݮ¹bÙ¿'–Ž_ÂhT¨V·åôS3Çu¨Ì'"R®9ùôáÔÿLé¹.YhR»ý‚³+þn ""Òè°üàüÄ¿·ŒtÛ˜©R¥Ë²™•f–fË7wíÞ|Ó¼1Í__÷]2òøe•ÓÖ̸1Ydjç<êØÞiíô"Ôá@Ž8ŽØâOÉ)C’ÒÅ”¹nP†ˆ“¾Æ3:zjüŸ¯*îîîuë»95h.ÌÅb9þ­Ç'ÊkjŸ˜Ø49團”)§œ‰hö™9åÜÓVEN9Qrº¼¦d¶0Q“G¶ÉI1gL “Gæ¿//¯©3–·ì0­¸ £">ß;Q,.êP¡R‡<È‘@]_¯´ËP>!À@yñÅo½–!IéB/z„ €ÐDå Ç[üikÊÜL7¨Á( Ôà Ü‘¡6^ÖúØ¡ ˆPƒE&à3ÊJr¹‹UÊñoG®“ÆÈ‰X"ÇÚü¦£9ò&]N9QïB9å,ËeoË)[(-ðP¾p$K';Œƒ€Ò‡ €ÐDå 'Ë ö2÷n6Ôà<€B=”;2LtSÖfªE @¡Z»`~Bö+ÃWѬhߪK›êÚ¸)€²#N–qðe­ Z³`qªYµ j ±qaÁ¡Sf¶˜wòôô†Li— ‡ÚŒ1êµó™ŸŸŸŸŸß«·!áþ{ o-œ²3ˆ-í‚ÀÏ ÀCQ «tÖ©’äC@˜ˆ(éÉþ¥ÛnEfÆù_Ú±üÐ 1Qf¤ï™kW¬Ú´ÿ’¼ô6€‹óÙµxùÉ·âœ|R}.^|Ð7Eú¿|’9À/ÂËqÅý`<(.Iȳ_•«×¬& ".éñÞÅ›íÞ Ñ  WƒR8îëµÍl{ÏÚyìðúñî5«¹.¾Ç£Î Ø?wêŽGÙ¯OI¼´fü¢saê*D$É'óRüÕežÁCÁ¸„G{οÅ'".3>ðæñ ÑN ª”}[(ößuÀé€_°‡‰%^6hUX«ÿžïîg%äž®ìì:ûÏÅ.ÏV6¬åÑÑl­×ߥ D WŽ]Hª?««Ÿ/Î, ‰Êw™@q¡…H ¼yòøñãÇ?áyþÖ«¨”¤0ÿ€ˆ< æöƒ¦v4Q"¢¤Ë{ŽF4˜°¬•ˆÍ:ãþiäuú…˜”êvêhtÖ류ˆâ/óNiÔ³‹9¯°$ßeð+qD,[ìWÖº¡cŒzí|ösvŒÍ ;?Þ­sïÞ†ÏnÿmÍ#"ZX™ðˆˆ$A/ß$ó3¯¯˜}Ϙì—&þü1TB¤R¯SÇŠ›¼¼üç:˜^:z1½ÙòΦ¼B“8~“9<™RÅ6“†8î˜~ñFä$kc"bTEªÒÌefd’Ц¾¾¾~vLÖw2ÛÍÆŠ!"åú:o9ã0¼ÊÑË™-Ö¸3?K’7s(>x(Ã'‘ü0Ý¿’…™@¢ê:~Noi|梞»ùÕÒ\‰ˆH¥A§ö†ÛOïÝl|…uý§ƒóó$rÃÉ2k ‹^ô °$W×þ÷ˆ³nÚØèûó†ÑkÓ£%Ï{Å«‘"¢ÌG'tî:ùÌ%iìViÔ¹½Þ“µË¼y­zµÓcŠ’J5x(yd¨ã]uiÀ'†~Šæ×úÛs¼½€è»;Y^Å~·\o3¸M•ö–Ê¡¾~ÉÓO-l¡šµ\ظS;Ãwf´éÝ&«¾^X’2v› e W>^6ƒš8gFÎ\ôÄ0UƒªM:º741êõúÏš¬mÅÏ^_¹×žg†z»ÿ!Yd:³Y;7;]~nfÊU,M• l{»iæ~W`’2€bB€‡M˜3·¥êuûάûÝwªf{ŒhœßÚbÿcÇžëvœï¢^¤$ùeÅ€gð oâ—çþÝ¿ßJ?ËCœE¥]"Že‹ÿ)q½8ôòÒþÎ5+êTmØyòaÿÔB×Î|y`îö‡)²oä.=â¹OH¥;ÎvR)í²”’ô§‹Ý=æÝÓê¶dûú‘Õ?ýÛ¿ÍØó±Þ4p1Þ«§­:ý:MöÛ 4у¼ êNð¼=¡´KPªϯÙèg>æÆÁ¹DD+Wÿ{ÅþYmƘ[Óæâ__<}é–÷ÞmG>KÚ–d‹¨ÁÀÿڻ︚Þ?àϹ«½wZ´hP¤¡ÒIÙÙ+{ïý5BÈž_²IIF‰ìÙ²J{ïqç9¿?~î¹÷«nŸ÷«?8÷Þçm A Aüé¹uðì§q·ªu|úÛ|¨¤jûõïF<¾~»òûBñ¼ÛÇ¿“#®¢@2BC€„Œ¨x÷®”bdjô¥ßœ¢Ú±ƒ"ïCz&ï»{RM'Eܺsçε¥ rç„.zm˧ÍfþËÃq|Á‚?»ƒ¿¿·nÝ~rÊšª‚¦£ Әɋ"¯(‡ª«ª…·º<ð{†a¦  ð³;ÈËËÿôÁBBMòtB8)sÿoà€ßÃ0 †aóçÏççÁYy9Œ[UYK ñOa¯ª¬"dåd…7Rˆ2:"&ÖúòáÑhÂÊÇ/¼WCAŽäpá¯Ô±¾¦”!fâB*!tò%SH%é"”÷‘Åimž“ÀÇŒ9R“ì0CC"îíR¦!„Qöþ}Í c{áýBÁ$;@Øè]Ü]ä2c/§±BEW£b6î=…·½x@èd¼g…X¼=eÿõ{ ' wCyØ‚z„Q»bxÐÌ‚íª‚ !ŽóóG ÃrþÅóó ž®èÕ{úEZÐá˜mÞŸv×$êÒãÏœ¾œ\&Ø1ƒþ ´vžËÎ{.ûá8EoÆÖŒïÊE6‘:´à-xm ëÏ…¸b]8 ˆ hÁhc~šã­­-ø¶‚[°)¨‹šåS²EŒ"©í0~ÏÓÏ{ãï·ØK̺Çá¯pVÔp9Éþ'kX_ä@€o ð˜i½|ÅK Üõ8=;ç}jâ©%U§¦ôê½þ9!„)»„l^ÚOˆ•ü· À‹>¢"fÑÄ%ÎÛoÅïœÚÛ¦ƒ¶–~'ÇA‹"â#F)=Þ°4¢€@˜¸ZG ÓvÒBq Óî>ͪ#ò“㟼ίmš{S—žô$ùmAí98’=NÍ®þzKCNÒݧ™µ}[Ìܤ»O2k„§ íî³ìz„xU÷’ò>-%˜Åéϓޕq·èÅݧYµ­®W ÐÒñpâOÿ„¹/ŒP@€}Eçv.¶š:ÁXìÛØªÏ²ð- {©Öã/<7ÍcÈ®4.Bˆ¨Œ™ç5rÝ–ñ6º¸ùzØ™éèØLü~‰¢ë‹œõTµMºt³6n§ÖqàÞ_’mõ)»û·3´îÞÍBOÃ8 ìY âåDLô±ÿÍ—ˆçžšâ1|ïkBDYÔl¯±û®ìh¤aÜ7,™KT?Ùêg ¨nÒźƒ¶YঠS]Ó²n„†±'^~_Vžý`o5vvàâ[u¿­/ëÐâÓíCŸçôeÆ-\ð¼Ó†»¹Õ•™Ñ#˶…%²ðô m‚Yô¢/¿€IÑÒÕj¼–c>;¸ìø‹/óé¨3çx~ÿÌ`ìÖU>ºbIÚMf»iya1ŽˆúœìŠ‘‹wg%1 ú¯9yѧÒèób˜Œ×šs\Õ1„ºÛ³;õ®GÄáøõ.¾¿®Q«0póÚ~¦tDT\ØQì¸~ÇÔš„z-›~ÑrEƒÀ^ø‚àkQ{k롇ßP)1™¬ÆÿóÊ3S’“Ù!Ôóü¹¤Ì°Yž M‚‰[ØvþÜ¡IHJ|Úí“uèÝSzòÌnö·ú¹»8»:{ûËPB,„­“‹“ê—]‘$íû¸)í{þ"›çû›y{ ÓÎÆt„â¾~šÄÔÒMóó…ÕÐÎV…r›Ô3€6 ºèEŸ¡¡ïÕóÔÆ/徿ZBBBBBÂðÁZÍ`1)©f®ý¨"ŸÇ‡2®J ŸÑßÎ@Ól`xRý§Û(Ò²Ò_w=Ädd¥1›óÃ/A4ÙQ“Q§º¡®¶IÉH5–A‘–•Þ6Š ê À‹¾î}½UK.î¿Pø}´åf\»þŽû%1+ Ê%mƬ>tåéDz¢Ô“ÃÑsž( Bˆ›õ.«q>Q•ñ¶¢¥«ñÃå^RXÒì´9ŠŠº*‘÷1·±>¬¼ì"ÁŽóó÷·ëýg À‹>Ïù {ò"g ]s»èk8gç\™7bó?ImÃy¾ÆAÏrÆZ„¢+š{º™Kñjªë „âeDìŠ)ùôñ¯y²mûu¢»«†QiT¼ð݇šO·T'F\Êj6lÓL<=t‹/½RJ „žwöȵêVöm€ÆàÛZ‡ÉgòûYéj¸ß¶kgùú©Ÿ”[.8¦3|ïÿ]Ý:p¨éî #œ«=Måk^^ޏD÷ÜО‚^"L\¶æ\]Þ`? ÚÛØS±¹VËãFëRÒvv7^².¤ï„7~úuONí«ÁTš+]ÌnÞ–Ñ—tªˆ÷3å<‹yÂ5Ñ ÖÐ ÷@ЄxÞAHv?øÿ´àÛŠªÛºÛ¯Ÿ\6 ³<« §‚Ñ1àŸ¸'‘ó¼ç†ÍõjGÅĵ¬œºÊa!D×èìä`¬øeü£«wr²ï¨ˆ!$n»âúͽã-yBˆ÷v“ƒÅ6Ëè»ÝÄ~ûØæõíÛ×ÁÉËÞÁEÕüOäþ>…*ªX¿¿_X,!¦$Š{X(¤’e$„Ø‹yò%ó÷wâ˘.RÂ(¶¾®"!jQ~~¾0 o9¢££§ÎZ«gò§¬­ÈJIXÊåþÉÌ¥¿ ºèA AÕiÇ»=}r0¶zb5VFô–ifÓv9òÝà`<ÿLÁwÇÍ Û×íܽèT¦bâ¼òÚ Ö߀?àAË!aà³à Ï‚¿] à´-xÞᎷ¶)k0EAà]ôÚ>w“BM„ Zð€‚<e*J:í¤…Q²PWÄÊHÓ…TrVvJ¦P„¸÷Ÿ~ްªÍå ñÓEX™–=N*$v½šPÊmyHU €Ö < ‚ ‹@ÛB ÄûóEí°x@A=€¶…@üÌ¢çã!´àAÐEß–Õ½¿~ìй۩ٕ„´ªµÇàQvš_R¬f—*.A‡‹@€ˆD7@”¥×Bì,|œËkßÙ¢ƒ+åà$'KOë?ÝÎKßâ¤Üue2÷ïV ßFq“¶ÏÞÓ}Ë£+!ÆŒO‡ê“×y8.Ÿº£Ï½ù&Âʰ ŽIŠ[]sZðmTýë´÷¨ƒ‡·£ñ¤Å˜©Pi.qo µ?ýñø¡»Ò¸!fÖõ°ÙÃý|z»xÿ<6Bq_„uØò”ÓXFmÜR÷ɧrqô“‡ DT]™ï|èùó#3ý]]}'­=ÿºæËwõ1~ׂqCü|û ´ìÈãÒÖÖ%-ø6JBO_O9´æè³’ÆðŒ©>ðøá&w1DÕqØM…ª`0nh *ëÅöÞ6¾+âjµÌŒåsÎÎìe;ð@Ñ e^Eï?—ôå¶6þØžøòv4(è'Aq RoÇ„Žè³ä‰‚·«aíµ.ãÏ•…gFõð^[®lfe@MÞ?޵Ϧ­î¢Zè¢o£èvsæÝ¾c¬Í©¹FÝ]ÜzõríåÖ«»‘< !„(ê6~Þ7,N1õØÛŠ’»ØÒ‡F+ïÝ\d!ޱ$pªÏÂå—N8øû(¹ór­ ¡º[¯ÕXÏdLÅsÍùÉCäBxq¦Â?Oãçš0b{HX8‹Oæ ìUwýø¥r×°¤scU1„æ÷Rv_òâYn® סA"ÖÁ‘EÑðÝú(;ãöÉÍò®n èØ±Û‚èlÎw÷$ÊnD&ò\'Nì,ŽB“w™2ªSÍ„d.’têï­ø6&&ƒ‡ª¿}ñZM·Á ¨¿zB!†ÃðŸÇþéõ©.!LBIIŠ›váàµô B2>[>ÿw$Dwà´àÛ2Št{ÇÀéŽÓâV¼‰?þÏü%›† Sž0£Ã7³ìx¹²9œ‚N7}Ùñ›[‘Å©0(ã"$éÔß[þDÌ•¬&‰ckz,í¯KùõCB˜”f;ù/·`Ø—‰{®Øò1d¯ÉR)- {·ÞASC†Z+B„€?¾Š[ì¶ž5ãü¦ÞŸã,MÁØsÚ~ÍŠä.ë®ß­é üÍ}©4*EÑyÆöiß~\(Ê& „TO/¹À˜«¹.ÆÖ:­ô×¢ „ÿê!u! £`èG4Ý~›oöYþñÙíø„øØ3»ÇØG¾¹ýh­¸ÀŸ?  #_]ô­l39è¢o«¤ØïDœN(oòÅëj”’’D“àKkon"Y]Š8öüÌNñc̹G… BI»ô÷”~}éâ…+u®Cúªa¿ÈOð^ý;{Òʨ|)]ÛÞcæo=›xh¨Lúõ›y‚ú ò À·Q6ãfº°OŽõ²÷FjVQYyQVʵãÆ†g™à&õùNDC]=ŽŒçøáí¬^uùU)‹[~aîè©{S¨í>]H»ô÷”H\?ÿBƒûÞÊŸŽýæ!Íäª’Ž®[¸æÜË2Î)qñÜý*£ê°( P8BâÿøX:ÿwA€o£h&¾º«9ÃÓ²½º²’z{+ßÅ÷´&ŸŠ^ë …B 33Åìžê ¬¿°Ó³x[?sU †¼IÐEÙI'NN7þxe\û{H^C¼¸ô¯Ò,Šîèͼ™Ç›«HÒÅ•;½¡rtS?9a¾ ª0‚hm×$üúöíëïïïææ&ŒÂqa~oªªYB*9+»FH%SšU! ñ÷ò„T2W˜2&[XÃK‡žÕ ¥\v¥ZÖšüü|¡ÞbDGGO_K7œö§äÔd•?]Îå¶šä0É@ÛBˆýç“ìø˜—÷wA= ‚ ü7xoïÞ¼•\(elïêl©!&Ô“A€жà|uѓ޾>y«¿÷¼› ZÕêÞMg™Í:m£›²ðf¯@= t¼Œ½Ó—ÞUŸuóã‡é¹É;zdoŸ¼îSˆg„ïý…S0÷Ùóä0„ÆcÓÊ:{ò¾°–Ì ðÚ¡zûÓ?&"Ó›Þòü5²èiÿeF—ž=$‹“’r…77Æà(+))ÉÎÎFÉB]_SËRÉ……ÂY?Ð/³“UUQ$¤’yÂL/Îâí§›Y/”bÙÕB)¶åáq™ˆYüÇcU „>|øð³Ûutth´ŸDU¼¬ EQVUnü¦Ð”UÑýÜ2Ò·<Y†††{÷îÝ»wïß®¦'´’õÍÌ„VvK¡¦¦¦"^£R²ãOÈãñrrwwÿÙV¯^=tèÐæo#X LÄ‘a4Á¤d¤PCSxטàÈ ýÛµ´,¶¶¶ïß¿ÿ¯ÏЉ‰‹!vm-¡Ïk㈺š:BLŒ³è€V‹¢ÜNƒ—•”7ŽÛðÊK+0õvê Ãàa·èjŽRï=ü²'ùî£:+k]áí— 6ªAÿÁvÜk;ö¤0Bxî¹­u µb2;ØMø0ÓÂúyÌ}(ÙÅF«2ùQžÎô 7þé¥(¼1xðÀƒ[’yóu¥¸ž]_?m ¡ž < ‚` AàAàAàAàAàAàhή«eòþv-~†÷îüêM±yøw‡‰²[a ¦pþJ~÷þÌ‚ ÿÄ— cû‹º{Û&Ì<öJï˜0« €0A€!Dp˜õu_ÕÅÏéj0é›t¹•/¯»”R‹b½==ÛϾ[OÿC)5|‹ú‚7©))É·Îî9y/9¥©§ñ§wï8ý¬ŠL("òwûèXùMÛtúAN½`cEŽ›q~ï¥4–@KýDL¢ôÞ‹„……Ym!«{w3âÌÃ!^î•eƒœº9øŽß~·ôû C ²Ú¶Ú¤ŒåéßïÉŒ‰uZúŒC®èêøÆâ˜„×þBœ›¾ÅAJÂÀcdC;1Õ'‹p¾Jd?˜cHýÅ÷“ê²ê9¹Z7¼¹°*ØÃD‘ŽQeô{_¼7öe)›T‰_q2ÏŒïf?þð£Ü:ž€Šü¯|ðw—Þ«¯¼)Tm ­Úì›S´~ÚÈÂ*«oäsù,œõlm7Y ÃfÝK.^p¬Ÿ"½ã°‘î’².a} å‚Ú6^î>O9›Éû.œßÔ_GÉkmÔÕ˜3¡#;©÷ÜòŠd ÀKŽö‘VòÝûžEÜôº‰iÇTD]Üd]é>GKù‹ð ¥ß¿{÷úø°vÆS£Òß5õþCn‹\¥±ŠS.ï^8¬§,S³ì;uã©ûÙuüUú3nzx€¥¹Š†0*CJVþ+e‡ /ø dŸª{mvs-Y †a4 ™oŠ–WÉl©ÕæVÞ[i§¨Þcü¦Wï>MNzr;jÿ’þfºóOݺqfëx[%¹^»>ðuUQ3ZEÊ~mr-AàE‡|¤åû-Ä Nòr I;2U­M0ý´RÜWOSi>;7Žó—bK_Û¾ˆ0pó1õô0c:ún¼|¨Ü÷-ûÿ^œ“›ôÒc ¢øNBšŒÛbg„pc3}âQNŽ”~Õÿ q%}%D(,ŠhO·22á¿z¿ÁPéì;±³ïĵ ¹‰M[>/j×B™öý†3v¨³®ÄŸIQ¶<™âÞ\1E©«©ñBª¡×¤©FÜæn¢t"õ;'ÄjÅçÖ„V޹òtSÉχ,»:õö5òïzoØýE»íÄÞ›‰É›8UûOOCTçåÕé¹x›I!T÷0áÑc“·*†0#3#ÊU­ xжÌ&CJŠŽ¢éwÐÉNÊ`!SIZw©]—sú¸3ø.𢬮‚e½É`"­ò‹§ïÐ÷ö@Õ¿L}Ç“éO*4cŠ&NÝŠŸG.6áÕR“´îÂÃIl^“Ö,h$N¢ä¯¸oïÄDFFF^ºö8›%×Áu„¿—þ<òÈ4·ðã›o_ŸaNÿãZw0®‹@*÷ª¾[ð7¡+”Á IDAT-Äjs?¼Jçï,Ùä(¦bi©òòî“JÂ\U¿½TIA1Žþ8Àc2jj…éo« KʵӱuÖKœ•0„ØoRßpe÷ @Ëö·»ø«¸éÿto?úb>— ®ŒQÓŸ_GDuÔH5¥‘—Iuíxéù¡ê U+7})ªæð‹e8ëʼnw=1 Ûõ/IõìxáÙaÚtL6(’I°-4eȘõ=°‹2£ý¤5¤J&X™q»r7Sf`˜¸š…Ïø•¯¦•|íù¯½3ËXÌdá~ËçU¥_;´~þ”à#FOœ½z_ì›JA lã5é1;—L58`à?w™…£n®lváÃ×Ï?lЀ“™Ì77Î?Êk ](žÀ[F¥Ï¾w߬à•wçYJèN»Å"˜©«ºÊ¸ïÉãkd¤öVˆ!CÁÔÅÙDž&ï½ÿ#ûáÒ’~ÆÒt£Y¤+Zð Ã Î ×¥cÒ}Ž–ðªbÆh‰iöØ]ƒ¡6øL1©!g‚ ˆÚ‹Gù÷˜v¯'ˆêÓAzfž3N¥“Œ ¼ŒMvâ:#Îp ‚}Ž¡˜É‚G,/;5PIet ©Âñ¼p7nÓ7ž¸ý®²™Ë^Aôò1Ë¢óù*½öùVïvtŒ.¯kaçä`cª-ÏÀèí|¶%Õ’©3AÁýxj„¡8ELÙÀLO^ràÙÚ—ëlÄÄ ‡Ë =é¯z¸ÆI‘J•igÚQCÊbEJMdUÑ~Ùí2²Ÿ†¤MÎJ4yc¯1óVmܲyýÒévZâbúÃÏæ6$.¶PÓ ¾\ÎïI˜¢ÖŽл_ðúk¹‚`ݘnÚ±çØ}Ï«IV´àà–&E¼˜ZGxÅ£ð >=l|'„Ý/!Þ‚S_]G.è°Ct¥úŸ¬%‚ûz½¸áìûl‚ 8ÉË;Kyì+$UqNmu½ž9÷Åڮ⊎‹¯f7^ƒ0sn,í©$a³Žl—FÙ¹!ªRS.¾¯çåïî%7ð,“à•ß_a/§àœä…'mµµ¸†oèãR.+aj{«)\‚ùþä°öb¦‹ž\hA3ëÆöiþö&Ú* ÊZ&öfxXÌ%γÃËwÅg |Mh;` ª’¥ßK„Bò¶“öÄLlñaëûéKŸQìæÎë»s\Â3Nÿs)ð‚[ñoŒ'n£DmÌ!$¦?pÉøPëËw²ñ®ú|W›“rpv8sØŽéanÓ¼ÕzÔ k~Kþ„W““–œ^\Ïk’÷ôèI®`Ð:@€@hðü˜9ã÷Þ/¨Ç›üÂR”Ž”'3ÉŽj4$ØqÌގ÷4rï¦éLÚæ(^õxï¼Y+¢p§=R|•ùìøú5w?göáÖ–•Õr £IÈJðjjY8Ó0³é>¦{‰O°˜L$« ÷]9y9ŒÙÀ$—£†Ãæ`tú÷ë0*ãñxäŠf³ÙˆÁøaJ!•FE<N¦lªL]ÊÉ#ªÓ&Úšó±¢â78¯ÂýÜB®p¿¯!E‹àåüt ‚Lv MbÅL2Ò6YÇŠ™d¤Ý<£I1ä’—±îoš¾+ÛfIDä±[Yó G®Ä^:¼ÐMË øØž@eR Ü(ºãO] 4”Tw˜²ÿÜJ ¢òiT\}÷…'÷Žä3<û±      çÎj;9%Ç9'e×0ë*«ëk²÷Œ6Á©Ý¦Ž¶"Ó$ êX[+& Kø6•^v{Çá§ Ö]tH…8z¿Ì÷kxv˜‹ÉQÇ›aÃ\»> É>á/ATDŽ´Þd›8ÏXð6A`ßœb8¨pÛsC¿½á¾XÓÍ.nÔ‹›ÓtI´ xYÿ:މbwòîíd¦«,V—›y%•ÖûàÝ3#ôȽœŒC½&^fvt±“yy­Â:¸+îb|Iç57®/èÂǪýoå =ûmz­Ø½—QÕ­Tù¾~êo£/§Hž¸s8@“ÄëÁ}¼ÖkÜÉ÷9é+xq)iqZãKÎpÚœ¬Á÷e ‘¿Û­Ã!·§¶ÐÏø@=h“¨z‡ÌþôOŸ)!Â9ÑÐÀĤ¤¤0„(ê†ú´ão²xÈ„ªÐËÓbľë¹sŒÉ„J¡!ª2?”)u6øn¦Ó^›ÈÎÌå!2µ¦ê ?ùH÷Àæ×#GÕ!)5îC¶†Î×S“t¢9ûÜâä®ÝgâžÉêðÞ=Ì2ñX=c²·¹èŽÂ]6$>wÙ·ëðå»Õê2¥)©2Vcöîœ1ÜF™Ü[HÑê9zŠrms,j;;I–BbÒÒÔ²ü62&ýüA«õ·gù ²ê¢GªÈ:mH©%Þ»Í=ä\w}ä}Zy/Ù}ã[>f³ï-¶Ñip ‡yo±ŽV³ô’›EϺ9Y‹ÑaÊ&‹³Xដ®»rB^P8ÉGì¼Sñý3ç}Œ^¿ò\¹ú»¥>í_©ê®k=¦RÑH—QP«2…k=Ëm¿ì¸ˆ+;úY†IÉH…y…<¤"ðLLF‘RòòYÉ7Q ,õIåúŒ]’–yñbdT|R!®ÒÉ{¨/ýÊ{gwŽ9¼ûâ¡ûç†ë’?Ba²,ô)oØ?d¨ùC?wõÑLUA ÷—'ùðwñr÷yÊÈÙLÞwáü¦þ:J^k£®Æœ ÙI½ç–W$³€óÞm¶“0ž}¯N05ý=¼âÒHM §mHÍùæ}Üí.£à¸$>ÍI[e­7å&›à\ÞI¢Ý¸«äö„Á+n-î¦m¼71³ZÀ)Ö™gþ¬í.>ð,©]ñš×Q[ç q2”§a)-[ÿiŽ'¼­hLB—GŽÐwØJþI|.¯úùZ'Yù ‹õ¤ŠùÕû( š‚–Zð mã¾zšJóÙ¹qœ¿[úÚöE„›©§‡ÓÑwãÕàC}H¬EÆ$e¤º ÿ³eÈ‚iùÕ?ˆ{¨µÔU“Î+ÿ|Œ¦î±d†óÁM·^q=møþÑàeœØYÜðîЧƒiâ’ߤu¡uZt÷ÎB3þg<ˆù„§gmúúÄ VeNÚõ}«7&ê­]Af)Bø‡Ó+Ö\”öè¿âT€¿—ŽÔw˜¬©çР<+>Šæ<\é:òxa“¡nMAn1Ï0dy/rœ_½¤ ­xжÌ&CJŠŽ¢éwÐÉNÊ`!SIZw©]—sú¸ó?©ûOí¿yÁÜNáÃ:þÞDMÊÉÈTºál-R3¹l6Nc0¾¿°¡R)ˆdVwŠJ‘³Å{77s€¢dM¦ó!$©¬£«üí]½övJ}Lg.=7ðÜP¾¯Ô¨Æ³oç/—þùj4tóþŠÖì1$X¼¦éØE\ÙØÅÏ·³ _E6úÕûH®dÐj@€m­£y‡ª=§¯¸õÓhgjŒ…ßxXïç*ÙP_ÊDÍNSÿÿaÊöÃ{Ó½G˜ŸŸ£««"ñM£uœ|úô¤|ba¶üdí\­‹þÙ°LÄdã/Ljš§;öÜ–´ 6%3“ S°ê7šŸ†.ß(ª-4x©ìæ®)þ ii„8EN>{çeN¹’ÿ¦¬ÞÅT™úØj’œÒGÑqŸ<Ï\?ó«÷Q8g-xжQFÌ>¤‡Ò#™‘ý|Ùý‡»—{kg^¹ˆÜÛ’šBj¯Î–¡áäßM[ªé$;ucRyH…Ùò£Žß¶<Êsz׎‡\-‰œ b÷ô¡+b/Ýg¹†ë#K®l$øD7¿‚—Ý9óQÕÕP–\ÁDõ£u}|–ßã¨wÔÄ?Š›.åHk¾øbÔ 'E²•fç%ÙyðÒÝ´el†¢n'‡>£&vÑ!›PçWï#É¢A«ñ·'ð×qK“"^L­#¼âQøŸ¶¾Âî—ÌïÉM[m%ÑeÍKÎïïÚâ°s÷-îe×¹£Q3›^ƒg‡ßÊÀ´¸Ú«ì)ÍDDšÅŠRùdY±ÓÌ ›2ÐQ’ `Ò¶kž³ÈÕš“¶ÚZ\Ã7ôq)—•0µ½ÕŠ.Á|rX{1ÓEOH¾»Ì´mn*ŠŒ¾½ß° Ó§âe¥.F‘ï¾ìn• ÒË é}­¬ƒ )v}&!ÅWÒ•¦x/Vwív3øMüTmAï*ƒç%þ{)­ÙTµ_`4`/ÃÕG'ŒD7ŸñÒ/m‹|Ó45!F•RïìîïÞQ†Ô›‰çììe|ÐõÑÓ¥æTέig)G>YÞ™ÊKß`g}yHZâLþ³ä¥'ú¿ <}c§ŸÖçÑ¢&yë÷E¥!O/!³K<§¼¨FFMQ`«óA+Ô¢¾þü Ì7'L[vR|AZT°*ƹ7ÏÄ/Zäú=‡’Û‡‹j:rnßà 'lî´šS; Av?ãEÏ"÷o¹š’Ç$F••"jk˜<£Ë()}  [#Cþ2¥ðjrÒ’Ó‹ë›Î©ÃÄuº:™ðß%ÍËÎø€;M[ÐYð‰n¨ýfÏ÷t©Ÿ°ÙlÄ`ü)©4*âñ~Ⱥû'¸oŸ§²æ.ï«õµtLÆrê’ ^žTæJüo[r:ÈxE™Ë   aƒûØj ôóZ ð c>\ÞÔÆ€¹«ä0„ÍrÂö¥ukÖî'¦›´ÙžDˆç½‹>“ÜP–>ßY{q“5aäW…Ѭ†mŒçŽ Ýµ<¨G{YÎ*yuu×ì釥VÜ<3Ú€Ô÷šó*ÜÏ-äjÁ«í(ZSâ>ìtá»M(ÌD7Ÿ° GŸ‹¹÷"»ŒE“×2µïد›&éÁl]'g½ÅûÖ´7PëËA¢,!ìP²šçF2K(Š*J—G Ôd`ÈÈŠ“‰É˜’÷‚ ÙGÏž_´k”aOÿ¡AÆ8wk™É—P@=hÛ8wftðJý:nªÎ7m]6 Ç êÒ‹ÆYÈ}*ˆw}Ù€À£ú^à¿ÿ»8-þÒùóçÏGÝzU«Üµ÷àaAæùY’/´{óÒpµq×¾Ÿ†ÅŠ›¨©0ì© hBľ;S_²÷‘òïsž,4‘ô:PLfzžî*ÕuÝkr[¨7‹›¾³ŸY{e1 !„ÑÄ¥¤¿’·[÷‚Ôñò Ajb†C&W|)‡W™vx˜‘¸úðȶ‰çCý»«ÛfºÙ˜w0ìØ©»×ˆÅG—ÈÜ¿ßg^–ª4Œ*£Õ©G/oÏž];¨ˆaˆ¢ÜmÄÁL³ûŠSžvf›¶FÑh¹ å‚.zжÑÍ,Mk¶ÿ]Ð+@£±ó/¾züjE‡ÉÆø~àÕoãÎ_¸ùì]A .©¢oí6pGG9’³îhí ±Ã'Ž¿2­CãR>¢"ñØÅ÷ò=uÉ- “–¦–å°¹Íf¢ÎÓ«ñLßУ-³ÎSäÌGíX}EfìSŽŸÿ+yïÏ,Þ˜é¾~^H¨g™:~KJZšõé…6÷lÞx\IEÛØ!„(µLå£áV¾»5****úêýŒj }ÇÁÃS0hñ ‹´qDÕ­ùN½·™úõ³7V¥×}x{òÌS©àÈû;½H.r®KÚ6°Ï¼«ÅR:¦&º2ÜÒïrëT¼7]>bI.·]Mâ|ïÐ|“Aã‚\:iËrŠ3žD>t½ÄzÃÝø¹H­ßoHÚêç¿O~Úö5cœ~H…Ö2±¢GjSgòi’{†u}¼ÞÖþü£½ù´ J#/iwþUXOáoU'8Ü¢g—NŸ½{çu¡ÐÁ©w@À€ýÜ­4ZÓ³äüí.þ:¼"é߃ìT¥h CNÛÊwJøÝ"ò}ÔÜk»Š+:.¾šÝðå3çÆÒžJ6ë^’.žWúpï4osU †FW1óš~ài9Ùn]¼(bT'C5I !„QžíG—í0ë6ùEÔ¼ªôk‡ÖÏŸÇ;Ék¬¿íê禬èÒãÖØ×7§édyî 7&jI˜Oûv¶5¯ôæ¬ÎZ“âÈuÁâ¥WC:5›ºážGzö5·:;)ñƵ«M]»õªŒLѼ¬íN’f‹Ÿ}—Ý•“¼¼³dϰ‚ïýnñ؉!ºRýOÖÁ}½ÞFÜpö}6ñé‘òØWHò}lx¹»&"©ÖÑD[V{ÊÍÚ;3ÛÓ¥-&Gå ¢î €s€ƒ™®º²²º®™CÀŒ]·òHÏTcßœ¢¥8,’ìD¬f±®Wg|œS^SÛD]=‹\+[8]Âë‰Á«’öOt뤣¦iê6ýÄëÚÜ £Ä>G]Œ¢Ømþ ²ñ²öxȉkus³i'N7š™XW>Ú3Þ^&çs —Ü‹]s*@Fgj‹ nÚ*k½)7ÙAàŽ¥ŒÉU´Ђm÷Õó4Ì)´ê§Ÿk¼àvÂk†Ó ÏÏ©ÃæV¦Øá·¸È„dfOº¦Ó¤P§IdëûLZZŠý:¯Gßdž(}÷®¦ó˜%#m´žÔT]Âë‰Á "F{Lˆï1ÀßžH»8Á/Ūá¹ô˜ãxèS>Þøg¸-×÷yµÅžÄ¢DŠîøS×)kÃ.¿Õ›²Ñr "ûiT\}÷…'wŒlGî­å²Ù8ñÃ*G*•‚´À´|û €¿$«4:æË⡊ˆ†Cè‡Æ6SÝ©IùáQä3Ùq*³’îÞŒkêæ£5¤Ú~¼‚KÌufœW'Øœsxé±¾²í§Þ¬h©_ ºKCx=1E¼$$·¿ãAp2¶:IPÔ‚¯4¾. ×'hŠußøV)ÿ‚—±ÕQJ½Ï®5_[ðxõãÝ¥U‚þvÝÀZð M¢jjkÖŧfò|:RªNˆ¹Í4šÐ³±9Ìy•ú × Û†­{¸Ú£÷Êe¼ï‡—i+ž=[Þ™ïâ9Oö‡&VUglf» £‹K‰}-‰Ñsë‹è±|ßbJV¬ø×òH=á$ºt—†ðzbŠó‹O;]*BÑôzØé0ªu´›ët- ÊÃúÒÏ@H«!(†ã·-òœÞµã!WK"§‚Ø=}èŠØK÷Y®áÇHÖ´àA›D³èç§:yµYh.T¶ŸÚÛüÓרNÞ¹dÿ{½à>椾DÅ¥“µ'Ÿ½9ßYWú»íÏÅ¥É\!›¶-òÖá÷µþ/zb„Fˆ«!ˆê{»×gôX5jÜzÇqßç½>µüäà•sH Z ð Âäì—'¼ùüÑÓuª]z9Êb!§Èv¸fí” ½;Ê ËTMc™³EÂÚþœUö.íUvÕ÷]»ŠÆöVíHÌûB¢¢8j¢ÓÀ£U¦ý'»ëc˜¬×ŠˆOïÛ³ÊÏ%çüÃý}ø» jO Q›õ4ñv!ÄûU‹ý/BøÇ̲Ɋx™${ï\ìÕQ€ùáy™¯²«yÅWŽî|TÛÏ kR4^uíðŽ}àÛŠ¿= ÑÅy,°“íØ½w²j8¿¿÷ŸÀKcC:5{"D7¯<åÜ–ùG ³'•™uûâíÌZ¾ ã$-5§Ë8oyÕܜņ¡®ò Ë•©|NVÃ+ï®pT¦b!„1ô‚Nçò‚`&®òè¤.F‘¶œWÊçË‘²Ââw4‹)d&ÙqÏï(íº+[9~ð²Ã¾¿õÀ¨Cx:Ð’A.z‹÷ògç /¸Ÿþ‡³jk¸£KÈJ}¯F6‡9ž¹ÍÙt67bßänêM–SatII:©Îæ«=ƒÜ§ÇT*é2 jûF¾ÝÉu¿MtÃW IDAT츈+;úð±©+ž»ËÍh…ö™¬£}šÍ‘Zwy´þÀœ•ïoLäwÄ™W•õ]O óöÚáûŠº &ÓS÷ñÙ³¬Ç¿…Iëué¢K"ó+^5Ù}ÚK÷u¡sü­5%2”€×f×áE'FxÞüp—oÓÎŒ&£®­*)èÕ• E‚.z‹¢é1{£rÙ/'v‘Ýþœ—Ÿ“/é³e¡WGAïÙþë h}]÷yþq8#jªª15­Ÿ5+Å´uÔ°´ò*iòà¨rz6z6ßï¹ølOþ k$¥ÛÅI—d¿!”Õu}„´F‡EöÕ21P‡XÞvA€@°0«~£­„{š¾iJjAŽ´þó]ÿ î¡BPÔRWM:¯üËùÔ=–Ìp>¸éÖ+®§ÍŸþhP”ÕU±âœ<6²jö¡Ì¬ù„¢²B DB\ Ä´¬]´(Ÿ_ÔúÌ;W?`z6NÝMUÈ-[­x‹—¶Ú¶Ç%ÿ–˜ mò6¦´aÉÙ!ÃæÊnžão¥!!Èý*ï‡ýÿLÉÉݺnÍ®cï½&üð‹Ãz½[Tm§…Ž_jÐ g5Qùlï¬I+Ï¢é,4¡…Q]ïÓ@ „I›ŽÚ½wˆ>¹" •hƒÍósg®™’‚‚‚‚‚‚FÏ÷ßßÝdÓNZRZ^á+5¿ƒ¤N.kçj]±aÿËگLjš§;öÜ–´µ3å'0P ‚WOÔ¸=ÓcÀºè7•_àñ*^^Xîç9ÿ¾zðšñÆ-u)[kƒçí;-’ç:cª»!æõ3}ì8å\Zfzâ¾AØéÉÓ ÑM[“ì,^êÊ.Ý#?]*ð<^ðàLì«f{tQ5íyK’9MýóM½=>`XºZOîÎCŒ‹>e@K¼8ΈÏN?nÞµ•£‚7Åçr:F†íœÊÜ·é9ÕHÕ~úÞ×ùé‘XØ×Ùêêë,K¾‹ÙxvVæ÷;µýÁø1fŸ¦åÓÛ9~—™yyÙ¨Tý‹ø¾•ж©ÒÞüMN9“¡¨mÜ¥KÇ?¿Ê ãgÍ@!ä<ÝY°%×Ô²†²Ÿ_ñüÄ[é »¹Ý×ÊÑét½¶mxª¸qã@ŸNq¡È›ê‘›ÿB”\Ÿí°ý%MÛX¹î]¡k脼°ÀI©N›cÎ…XòÕAŸ=uâµÚ+g§[~¿ލL:8{ÌÜ#/Õçùòߨf¾¿´nÎâѯ*¿LPÀèŠf}glØ8×W_€‰ÜZVÞ݈ÃTGÏöUKZï5òXÞ7ùéVóbŽæg3`--éüÔ´RÂVCDᵘ'Èz½£ü—÷ù*å-¡%êƒVàogÚ@ÄpSVXHX®Jê6¢õ·¦ë‹~Q3ÏÊ»†çáDmÚN_5IÇ­ïøË‹V~w¥£MÕmã“êoR¿±r®¯òѧHl¼UÀw>¾ú”P7e*]ÝnôêÃ1÷’_¿MO{xõßõcí5èTumIÂÚœ¶ÅÂËÛ)R0q»Mé\‚}gF{†AŸ‘>Uè4Ûâ^—òùbWÇŒÑdèô {ñöÉ‘á†t±îÓ?¹¥‰‹»ËHÚoÜó-xë¿𜤥撽vçáA4x‚`ß›e Ý÷ß >KÅ«ŸlrW£)õ\}¿'¼úÅ¿“m•¨4»é/Éì_ÏN]c#.i1ãjá÷/ ·èÚ IqëUÉÎåÛÒ]«M“í:3òCNûÎŒöŸÞDnáõ–*vë“YüÍ+¸<Íòs=&i>ãzNxIÔlc%EÑiýþ³ƒÖ–ÉÐ ±ÙŒÁøaüšB¥à<¿+c0™®s"o„Ù¿_åë3'lM€µíÈ#=×ÝHIÜ>Ä”ÄL8ÎãÇRt&îZç©öý¬ªªÇúðɺ/ºÏá»üÖèà™«…G7ùµÿ~Ë8ªšûºmCŠ6­<[ÊçÛHQ÷ {œùæ~Ì™SQ÷_?Þꮈ!„pœ¦l3zûõçWt%‘[´*0€`Q;N>ÿl˜¬¾0×uÓÌ\œäw„­½á³ÉCáËAnÎ…°S9¦mdIÌJ—ì4étœÄHï 3–‹[Ž;ödóP2¡!„^øüy¾ª{ÛæÓêŠÛôñÔØ™””;é¶Ç ¶Q w‡æ?#Ýܱá±÷XA~üÎM +Ùù}³àSõÛpÆÏÒ@kS10Qò9¤ÜWìÒk¨É'W YeËÆÅ>‰¼ú¾Ý´¨I&$/-Ä;Ž:/!é|íc ‘_ÂFÔÕÕc²r?Ýó“•—Ř Ì65·›ääe¯gèö›ÞT"Ú—ôqqëci ÄÛà B 8àh(šýö?zâ³;üÄÕGEºŒÜgéFÝfDDL0ã·ý^zçmEcÊõaK'¼™:dzoù®¥½T?芵ëÜÍPþO˧¨iiRsß¼­!º(4÷ØÚô×9ÔvÚªm§ùŽÒ$2Ò^5 öŸ{Ë1Ú7ã-x^ÚËr 52=1 Èd€h©ËH+ÔêdÀÇ&s»{‰M¾ÉþÕ=(ZSâ>ìtùãuðxî>ÓYÕ $,ìôÃF'¬´ ®vëdB_]/øsZ®u6â$×<¸>ÇìûW„¨JéæyÂâxÆ©AŠâàhMð²»—¬:|óu)¡dì¼rÃ$[,åÔ®c·2Š«êjÊ2“žÊ/|yc;«7mÁ7‡ÏÍÈ+«§Èjvèêê?<ȳÃO'$ð' ÀÐjpC =ŸLK»;ÇðSóŽ}5¸]¿7 _Ý™¥í=@Sð«@ëÁãᘤ´Tcû“–•¡ˆKÀb*À À"< ‚ Ñ ­ ïãõ]ÿT}ž……g=­ä\ßõOucRª®ÇÄÁV-n=à?“ìh58 SõÝvåþr±:Ã5<3ŽŸuð€V„Àqü×_Y £R`ä Ip©ˆ ð€‚ˆ ð€‚ˆ ð€‚ˆ ð€‚ˆ ð€‚ˆ ð€‚ˆ ð€‚ˆ ð€‚ˆ ð€‚ˆ ð€‚ˆ ð€‚ˆ ð€‚ˆ ð€‚ˆ ð€‚ˆ ð€‚ˆ ð€‚ˆ ð€‚ˆ ð€‚ˆ ð€ú‹÷§Rî~%BIEND®B`‚seriation/README.md0000644000176200001440000003457414724362460013553 0ustar liggesusers # R package seriation - Infrastructure for Ordering Objects Using Seriation [![r-universe status](https://mhahsler.r-universe.dev/badges/seriation)](https://mhahsler.r-universe.dev/seriation) [![Package on CRAN](https://www.r-pkg.org/badges/version/seriation)](https://CRAN.R-project.org/package=seriation) [![CRAN RStudio mirror downloads](https://cranlogs.r-pkg.org/badges/seriation)](https://CRAN.R-project.org/package=seriation) [![Anaconda.org](https://anaconda.org/conda-forge/r-seriation/badges/version.svg)](https://anaconda.org/conda-forge/r-seriation) [![StackOverflow](https://img.shields.io/badge/stackoverflow-seriation+r-orange.svg)](https://stackoverflow.com/questions/tagged/seriation+r) ## Introduction Seriation arranges a set of objects into a linear order given available data with the goal of revealing structural information. This package provides the infrastructure for ordering objects with an implementation of many [seriation](https://en.wikipedia.org/wiki/Seriation_(archaeology))/[ordination](https://en.wikipedia.org/wiki/Ordination_(statistics)) techniques to reorder data matrices, dissimilarity matrices, correlation matrices, and dendrograms (see below for a complete list). The package provides several visualizations (grid and ggplot2) to reveal structural information, including permuted image plots, reordered heatmaps, Bertin plots, clustering visualizations like dissimilarity plots, and visual assessment of cluster tendency plots (VAT and iVAT). Here are some quick guides on applications of seriation: - [Introduction the R package seriation](https://cran.r-project.org/package=seriation/vignettes/seriation.pdf) - [How to reorder heatmaps](https://mhahsler.github.io/seriation/heatmaps.html) - [How to reorder correlation matrices](https://mhahsler.github.io/seriation/correlation_matrix.html) - [How to evaluate clusters using dissimilarity plots](https://mhahsler.github.io/seriation/clustering.html) Implemented seriation methods and criteria: - [Documentation of the implemented seriation methods](https://mhahsler.github.io/seriation/seriation_methods.html) - [Documentation of the implemented seriation criteria](https://mhahsler.github.io/seriation/seriation_criteria.html) - [A visual comparison between seriation methods](https://mhahsler.github.io/seriation/comparison.html) The following R packages use `seriation`: [adepro](https://CRAN.R-project.org/package=adepro), [arulesViz](https://CRAN.R-project.org/package=arulesViz), [baizer](https://CRAN.R-project.org/package=baizer), [ChemoSpec](https://CRAN.R-project.org/package=ChemoSpec), [ClusteredMutations](https://CRAN.R-project.org/package=ClusteredMutations), [corrgram](https://CRAN.R-project.org/package=corrgram), [corrplot](https://CRAN.R-project.org/package=corrplot), [corrr](https://CRAN.R-project.org/package=corrr), [dendextend](https://CRAN.R-project.org/package=dendextend), [DendSer](https://CRAN.R-project.org/package=DendSer), [dendsort](https://CRAN.R-project.org/package=dendsort), [disclapmix](https://CRAN.R-project.org/package=disclapmix), [elaborator](https://CRAN.R-project.org/package=elaborator), [flexclust](https://CRAN.R-project.org/package=flexclust), [ggraph](https://CRAN.R-project.org/package=ggraph), [heatmaply](https://CRAN.R-project.org/package=heatmaply), [MEDseq](https://CRAN.R-project.org/package=MEDseq), [ockc](https://CRAN.R-project.org/package=ockc), [protti](https://CRAN.R-project.org/package=protti), [qlcVisualize](https://CRAN.R-project.org/package=qlcVisualize), [RMaCzek](https://CRAN.R-project.org/package=RMaCzek), [SFS](https://CRAN.R-project.org/package=SFS), [tidygraph](https://CRAN.R-project.org/package=tidygraph), [treeheatr](https://CRAN.R-project.org/package=treeheatr), [vcdExtra](https://CRAN.R-project.org/package=vcdExtra) To cite package ‘seriation’ in publications use: > Hahsler M, Hornik K, Buchta C (2008). “Getting things in order: An > introduction to the R package seriation.†*Journal of Statistical > Software*, *25*(3), 1-34. ISSN 1548-7660, > . @Article{, title = {Getting things in order: An introduction to the R package seriation}, author = {Michael Hahsler and Kurt Hornik and Christian Buchta}, year = {2008}, journal = {Journal of Statistical Software}, volume = {25}, number = {3}, pages = {1--34}, doi = {10.18637/jss.v025.i03}, month = {March}, issn = {1548-7660}, } ## Available seriation methods to reorder dissimilarity data Seriation methods for dissimilarity data reorder the set of objects in the data. The methods fall into several groups based on the criteria they try to optimize, constraints (like dendrograms), and the algorithmic approach. ### Dendrogram leaf order These methods create a dendrogram using hierarchical clustering and then derive the seriation order from the leaf order in the dendrogram. Leaf reordering may be applied. - **DendSer** - Dendrogram seriation heuristic to optimize various criteria - **GW** - Hierarchical clustering reordered by the Gruvaeus and Wainer heuristic - **HC** - Hierarchical clustering (single link, avg. link, complete link) - **OLO** - Hierarchical clustering with optimal leaf ordering ### Dimensionality reduction Find a seriation order by reducing the dimensionality to 1 dimension. This is typically done by minimizing a stress measure or the reconstruction error. - **MDS** - classical metric multidimensional scaling - **MDS_angle** - order by the angular order in the 2D MDS projection space split by the larges gap - **isoMDS** - 1D Krusakl’s non-metric multidimensional scaling - **isomap** - 1D isometric feature mapping ordination - **monoMDS** - order along 1D global and local non-metric multidimensional scaling using monotone regression (NMDS) - **metaMDS** - 1D non-metric multidimensional scaling (NMDS) with stable solution from random starts - **Sammon** - Order along the 1D Sammon’s non-linear mapping - **smacof** - 1D MDS using majorization (ratio MDS, interval MDS, ordinal MDS) - **TSNE** - Order along the 1D t-distributed stochastic neighbor embedding (t-SNE) - **UMAP** - Order along the 1D embedding produced by uniform manifold approximation and projection ### Optimization These methods try to optimize a seriation criterion directly, typically using a heuristic approach. - **ARSA** - optimize the linear seriation criterion using simulated annealing - **Branch-and-bound** to minimize the unweighted/weighted column gradient - **GA** - Genetic algorithm with warm start to optimize any seriation criteria - **GSA** - General simulated annealing to optimize any seriation criteria - **SGD** - stochastic gradient descent to find a local optimum given an initial order and a seriation criterion. - **QAP** - Quadratic assignment problem heuristic (optimizes 2-SUM, linear seriation, inertia, banded anti-Robinson form) - **Spectral** seriation to optimize the 2-SUM criterion (unnormalized, normalized) - **TSP** - Traveling salesperson solver to minimize the Hamiltonian path length ### Other Methods - **Identity** permutation - **OPTICS** - Order of ordering points to identify the clustering structure - **R2E** - Rank-two ellipse seriation - **Random** permutation - **Reverse** order - **SPIN** - Sorting points into neighborhoods (neighborhood algorithm, side-to-site algorithm) - **VAT** - Order of the visual assessment of clustering tendency A detailed comparison of the most popular methods is available in the paper [An experimental comparison of seriation methods for one-mode two-way data.](http://dx.doi.org/10.1016/j.ejor.2016.08.066) (read the [preprint](https://michael.hahsler.net/research/paper/EJOR_seriation_2016.pdf)). ## Available seriation methods to reorder data matrices, count tables, and data.frames For matrices, rows and columns are reordered. ### Seriating rows and columns simultaneously Row and column order influence each other. - **BEA** - Bond Energy Algorithm to maximize the measure of effectiveness (ME) - **BEA_TSP** - TSP to optimize the measure of effectiveness - **BK_unconstrained** - Algorithm by Brower and Kyle (1988) to arrange binary matrices. - **CA** - calculates a correspondence analysis of a matrix of frequencies (count table) and reorders according to the scores on a correspondence analysis dimension ### Seriating rows and columns separately using dissimilarities - **Heatmap** - reorders rows and columns independently by calculating row/column distances and then applying a seriation method for dissimilarities (see above) ### Seriate rows in a data matrix These methods need access to the data matrix instead of dissimilarities to reorder objects (rows). The same approach can be applied to columns. - **PCA_angle** - order by the angular order in the 2D PCA projection space split by the larges gap - **LLE** reorder along a 1D locally linear embedding - **Means** - reorders using row means - **PCA** - orders along the first principal component - **TSNE** - Order along the 1D t-distributed stochastic neighbor embedding (t-SNE) - **UMAP** - Order along the 1D embedding produced by uniform manifold approximation and projection ### Other methods - **AOE** - order by the angular order of the first two eigenvectors for correlation matrices. - **Identity** permutation - **Random** permutation - **Reverse** order ## Installation **Stable CRAN version:** Install from within R with ``` r install.packages("seriation") ``` **Current development version:** Install from [r-universe.](https://mhahsler.r-universe.dev/seriation) ``` r install.packages("seriation", repos = c("https://mhahsler.r-universe.dev", "https://cloud.r-project.org/")) ``` ## Usage The used example dataset contains the joint probability of disagreement between Supreme Court Judges from 1995 to 2002. The goal is to reveal structural information in this data. We load the library, read the data, convert the data to a distance matrix, and then use the default seriation method to reorder the objects. ``` r library(seriation) data("SupremeCourt") d <- as.dist(SupremeCourt) d ``` ## Breyer Ginsburg Kennedy OConnor Rehnquist Scalia Souter Stevens ## Ginsburg 0.120 ## Kennedy 0.250 0.267 ## OConnor 0.209 0.252 0.156 ## Rehnquist 0.299 0.308 0.122 0.162 ## Scalia 0.353 0.370 0.188 0.207 0.143 ## Souter 0.118 0.096 0.248 0.220 0.293 0.338 ## Stevens 0.162 0.145 0.327 0.329 0.402 0.438 0.169 ## Thomas 0.359 0.368 0.177 0.205 0.137 0.066 0.331 0.436 ``` r order <- seriate(d) order ``` ## object of class 'ser_permutation', 'list' ## contains permutation vectors for 1-mode data ## ## vector length seriation method ## 1 9 Spectral Here is the resulting permutation vector. ``` r get_order(order) ``` ## Scalia Thomas Rehnquist Kennedy OConnor Souter Breyer Ginsburg ## 6 9 5 3 4 7 1 2 ## Stevens ## 8 Next, we visualize the original and permuted distance matrix. ``` r pimage(d, main = "Judges (original alphabetical order)") pimage(d, order, main = "Judges (reordered by seriation)") ``` Darker squares around the main diagonal indicate groups of similar objects. After seriation, two groups are visible. We can compare the available seriation criteria. Seriation improves all measures. Note that some measures are merit measures while others represent cost. See the manual page for details. ``` r rbind(alphabetical = criterion(d), seriated = criterion(d, order)) ``` ## 2SUM AR_deviations AR_events BAR Gradient_raw Gradient_weighted ## alphabetical 872 10.304 80 1.8 8 0.54 ## seriated 811 0.064 5 1.1 158 19.76 ## Inertia Lazy_path_length Least_squares LS MDS_stress ME ## alphabetical 267 6.9 967 99 0.62 99 ## seriated 364 4.6 942 86 0.17 101 ## Moore_stress Neumann_stress Path_length RGAR Rho ## alphabetical 7.0 3.9 1.8 0.48 0.028 ## seriated 2.5 1.3 1.1 0.03 0.913 Some seriation methods also return a linear configuration where more similar objects are located closer to each other. ``` r get_config(order) ``` ## Breyer Ginsburg Kennedy OConnor Rehnquist Scalia Souter Stevens ## 0.24 0.28 -0.15 -0.11 -0.27 -0.42 0.21 0.61 ## Thomas ## -0.41 ``` r plot_config(order) ``` We can see a clear divide between the two groups in the configuration. ## References - Michael Hahsler, Kurt Hornik and Christian Buchta, [Getting Things in Order: An Introduction to the R Package seriation,](http://dx.doi.org/10.18637/jss.v025.i03) *Journal of Statistical Software,* 25(3), 2008. DOI: 10.18637/jss.v025.i03 - Michael Hahsler. [An experimental comparison of seriation methods for one-mode two-way data.](http://dx.doi.org/10.1016/j.ejor.2016.08.066) *European Journal of Operational Research,* 257:133-143, 2017. DOI: 10.1016/j.ejor.2016.08.066 (read the [preprint](https://michael.hahsler.net/research/paper/EJOR_seriation_2016.pdf)) - Hahsler, M. and Hornik, K. (2011): [Dissimilarity plots: A visual exploration tool for partitional clustering.](http://dx.doi.org/10.1198/jcgs.2010.09139) *Journal of Computational and Graphical Statistics,* **10**(2):335–354. (read the [preprint](https://michael.hahsler.net/research/paper/dissplot_JCGS2011_preprint.pdf); [code examples](https://mhahsler.github.io/seriation/seriation_cluster_evaluation.html)) - [Reference manual for package seriation.](https://mhahsler.r-universe.dev/seriation/doc/manual.html#seriation-package) seriation/build/0000755000176200001440000000000014724364730013360 5ustar liggesusersseriation/build/vignette.rds0000644000176200001440000000034014724364730015714 0ustar liggesusers‹uQÍ‚0 ?¢`HLx=ð&„Äx1ă׆.âFÆ ñæ“‹Eej“vÝú}í×lï!„LdÛ&2-H­‚¾7\8ýŠJF