shapes/0000755000176200001440000000000015076654732011554 5ustar liggesusersshapes/MD50000644000176200001440000001111715076654732012065 0ustar liggesusers6cb72f0c9eba30fb071b2950cb012d30 *DESCRIPTION e9269618e2bc6577a1386b62c7133e13 *NAMESPACE 5d2b4bb478e923f8b884bae081255a76 *NEWS.md 8a4ee67fc087d4fffcc817dfcabee32d *R/shapes.R 739f53aa1775e30253b9b465761e55ba *README.md 58c406f9101b335debe48209c6571a7d *data/T1mice.rda 989b7646db42481e8b9ca3503af2cc5d *data/apes.rda 4777acf2f0b5465737eb6554a1203205 *data/brains.rda cbfa1d9937988c395044c9ac9f7a56ed *data/cortical.rda 744967ba8d454a8258245e2a528cb9ad *data/digit3.dat.rda 8a5be6400aae319daf04ac5d6b234e7d *data/dna.dat.rda aae4353f09876f637fcf79f885160bce *data/gels.rda 7e303ec8300400e56c225b9b07f07069 *data/gorf.dat.rda fe79b336eba0fd573f2cd45e8cbe7f15 *data/gorm.dat.rda eb327393c7348701dd475667cbcc041c *data/humanmove.rda 9703983a92a40d0ea144ceecf10eca37 *data/macaques.rda b528ed7bcdbe467537c9f042f0c47848 *data/macf.dat.rda f185cd3653171013574b65b4ecc5d4fe *data/macm.dat.rda d9b7bcbf9314fa9b5e22d160e1c3066a *data/mice.rda e44adb91546a6e367ff0a2d25d9e6681 *data/nsa.rda 98da84537e72f7b1d1e910a667822c59 *data/panf.dat.rda 4cb78ead72d58a3cee27fa00b54af02b *data/panm.dat.rda 817911648e9a12f37290da87e11c0097 *data/pongof.dat.rda 7d679b78486146a23c0ac956306bfa18 *data/pongom.dat.rda fd4a9a48a88db316efbbb343371b8d10 *data/protein.rda 8bb009ff4513cfdbcb56fe55570b500f *data/qcet2.dat.rda 9e1b04168ae2d590258df9d82ecca993 *data/qlet2.dat.rda 10a43c29bb029510d2fb6cb40659bdb3 *data/qset2.dat.rda 0a9dc7360506716e9345b66d7a529354 *data/rats.rda 98cc9771c81f534ad6f99ea76f0633e5 *data/sand.rda 528079645331779ea8575026a0a53af0 *data/schizophrenia.dat.rda 7d2940799be704f5f8aef212f5bbbd85 *data/schizophrenia.rda c5d067e9d07bfc5727e356fb6f935d39 *data/shells.rda f6ed6fff085a1c6be8558ed5792cda58 *data/sooty.dat.rda 2d1667294180592a26b3483dfb3a384e *data/sooty.rda 19c60fc641f4b9265182f99dc722de59 *data/steroids.rda 410cc000136d80ba87a663749aa276f2 *demo/00Index 5d448fe971892a3483515f40c5402a34 *demo/shapes.R 77adc507dd93ee19c00dbb23402bf86c *man/T1mice.Rd 187661cd9bc47f539fe11488ee86ac25 *man/apes.Rd 774f9635e9fd367a3b1a74148965a2ab *man/backfit.Rd 8590d9043d9ab4ddbbf1b5615de2b6e2 *man/bookstein2d.Rd 43caf534efe53a155446b090fe16e932 *man/brains.Rd 1d98459f215fe87530fb33add80df3e2 *man/centroid.size.Rd bcd0f6edaa55805087fa425408721fdd *man/cortical.Rd 920cc57da48fc9f6ceff230f225bc89b *man/digit3.dat.Rd 70a3c688480c2c9aa1960d8ea8514b35 *man/distcov.Rd 78ae2e39a70b583ec19450667ff6d074 *man/dna.dat.Rd 745a3aa086294f219a2cc75a16607395 *man/estcov.Rd 0aa7454ac472b856572ad8f6935dff25 *man/frechet.Rd b4b6d3b94500e52e99fa346602c3ac4d *man/gels.Rd 30184d8c7803fa4b71e7d6b15e3ec8b7 *man/gorf.dat.Rd 619abe9a5bf87ecc32867ac3087f04dd *man/gorm.dat.Rd cb39b12f6e3aaf82bb2bf9fb09d9cadd *man/groupstack.Rd a560acbbe582cda4285edac716530a1d *man/humanmove.Rd b83ca76894d6959bcdc293101ed786f5 *man/macaques.Rd eae66ac549b345476fd3eb683e14696d *man/macf.dat.Rd 0fcd203a740a02c44ba423d990710de6 *man/macm.dat.Rd 7e8ec886d6c34ebdb81ab5b2d3d3c784 *man/mice.Rd c93330db34d3d22fe366b408ed7283e0 *man/panf.dat.Rd d611183f846a3d4ff67ef7e3969e82c1 *man/panm.dat.Rd aa923c97df9c4982094b54e1c95ecb33 *man/plot3darcs.Rd 8eb794436eea3ed408878f0f550f596e *man/plotshapes.Rd a41676199d9d3274a9dd47a0f0cbb55c *man/pns.Rd f49c8f2a4ba8d8e60cf201fd4b191cff *man/pns4pc.Rd c86a82b068f4d7aeda1e9a76912b7aa2 *man/pnss3d.Rd d7f329a153fc31189ffa89da13d6d1e8 *man/pongof.dat.Rd a97ac227ce1bf25de273abbd3a71608c *man/pongom.dat.Rd da19be8a7a8e2a687cb9faea228d7ed9 *man/procGPA.Rd 7cbedd3ee0a06fd232231d43114b27cf *man/procOPA.Rd 69f39b16127ff402d7623bd258a9d5d1 *man/procWGPA.Rd 5da5984fe879dc6d5b55cc0d69472e81 *man/procdist.Rd 368e229764a3341fd8a5c98b50e01005 *man/qcet2.dat.Rd 366347b1da7d6bbdf058f178e6d55cce *man/qlet2.dat.Rd 3850b0377362e2b587c44b4a587e2bf0 *man/qset2.dat.Rd f56a338357e5ad51782ebe29dee83664 *man/rats.Rd 48966fa9148a8bdc9d21130220487de2 *man/resampletest.Rd 2185b7b48c610ab1a10686e6a52a898f *man/riemdist.Rd 687e6994dd5e5b355dba77933b60c995 *man/rigidbody.Rd 36f7c49ad5f162187046f9101041b64e *man/sand.Rd c0c2ec3509ba14a0d765eb0a73172bf1 *man/schizophrenia.Rd ed8fda94455439858da784dc70b9385e *man/schizophrenia.dat.Rd b9571afd18359f92c5724c6d44637424 *man/shapepca.Rd 481bcd947b0e5017ffe074bc114aaacd *man/shapes-internal.Rd 7d9320fd3693191ebfff65300711c78c *man/shapes.cva.Rd e4ac610121f516f3737e3ac990253345 *man/shapes3d.Rd f23d5fc6b98042f0a441f549ee5c7020 *man/shells.Rd 01a0125ce0a534ae27c4922aa5e33876 *man/sooty.Rd 6b0467ae3d2530d8c6cad96dedd2d69c *man/ssriemdist.Rd 56f0de6b0747cebfe637d52107077290 *man/steroids.Rd 89e8e5ea592bf16f5c2a06f217320fd4 *man/testmeanshapes.Rd f2b16307f2c8faa20e1f8515a132d1a0 *man/tpsgrid.Rd 4427eddd390f9e67158f4e694e5c4990 *man/transformations.Rd shapes/R/0000755000176200001440000000000015066775151011753 5ustar liggesusersshapes/R/shapes.R0000644000176200001440000136376515067161141013373 0ustar liggesusers#----------------------------------------------------------------------- # # Statistical shape analysis routines # written by Ian Dryden in R (see http://cran.r-project.org) # (c) Ian Dryden # version 1.2.8 # 2003-2025 # # Includes contributions by many other authors, including # Mohammad Faghihi, Kwang-Rae Kim, Alfred Kume, # Gregorio Quintana-Orti, Amelia Simo. # ########################################################################### tangentcoords.partial.inv = function(v, p, R) { return(matrix(sqrt(1 - sum(v^2)) * c(p) + v, nrow = nrow(p)) %*% t(R)) } preshape2shape = function(z) { k = nrow(z) + 1 H = defh(k - 1) return(t(H) %*% z) } plot3darcs<-function(x,pcno=1,c=1,nn=100,boundary.data=TRUE,view.theta=0,view.phi=0,type="pnss"){ # points along principal arcs pns.out <- x k <- pns.out$GPAout$k m <- pns.out$GPAout$m n.pc <- dim(pns.out$resmat)[1] rad1<-sqrt(5/k)/50 rad2<-sqrt(1/k)/50 npts = 100 arc1 = t(get.prinarc(resmat = pns.out$resmat, PNS = pns.out$PNS, arc = 1, n = npts, boundary.data = boundary.data)) arc2 = t(get.prinarc(resmat = pns.out$resmat, PNS = pns.out$PNS, arc = 2, n = npts, boundary.data = boundary.data)) arc3 = t(get.prinarc(resmat = pns.out$resmat, PNS = pns.out$PNS, arc = 3, n = npts, boundary.data = boundary.data)) PNSmean = pns.out$PNS$mean GPAout = pns.out$GPAout { # cat("stdev of PNS1 score:", round(sd(pns.out$resmat[1, # ]), 4), "\n") # cat("stdev of PNS2 score:", round(sd(pns.out$resmat[2, # ]), 4), "\n") # cat("stdev of PNS3 score:", round(sd(pns.out$resmat[3, # ]), 4), "\n") } rng = c * sd(pns.out$resmat[1, ]) val = c(seq(-rng, 0, length = nn + 1)[-(nn + 1)], 0, seq(0, rng, length = nn + 1)[-1]) lu.arc1 = t(get.prinarc.value(PNS = pns.out$PNS, arc = 1, res = val)) rng = c * sd(pns.out$resmat[2, ]) val = c(seq(-rng, 0, length = nn + 1)[-(nn + 1)], 0, seq(0, rng, length = nn + 1)[-1]) lu.arc2 = t(get.prinarc.value(PNS = pns.out$PNS, arc = 2, res = val)) rng = c * sd(pns.out$resmat[3, ]) val = c(seq(-rng, 0, length = nn + 1)[-(nn + 1)], 0, seq(0, rng, length = nn + 1)[-1]) lu.arc3 = t(get.prinarc.value(PNS = pns.out$PNS, arc = 3, res = val)) scores.arc1 = sphere2pcscore(x = arc1) scores.arc2 = sphere2pcscore(x = arc2) scores.arc3 = sphere2pcscore(x = arc3) scores.PNSmean = sphere2pcscore(x = t(PNSmean)) scores.lu.arc1 = sphere2pcscore(x = lu.arc1) scores.lu.arc2 = sphere2pcscore(x = lu.arc2) scores.lu.arc3 = sphere2pcscore(x = lu.arc3) U1 = matrix(0, npts, nrow(GPAout$pcar)) U2 = matrix(0, npts, nrow(GPAout$pcar)) U3 = matrix(0, npts, nrow(GPAout$pcar)) for (i in 1:npts) { for (j in 1:n.pc) { U1[i, ] = U1[i, ] + scores.arc1[i, j] * GPAout$pcar[, j] U2[i, ] = U2[i, ] + scores.arc2[i, j] * GPAout$pcar[, j] U3[i, ] = U3[i, ] + scores.arc3[i, j] * GPAout$pcar[, j] } } U.mean = matrix(0, 1, nrow(GPAout$pcar)) for (j in 1:n.pc) { U.mean = U.mean + scores.PNSmean[j] * GPAout$pcar[, j] } tan.lu.arc1 = matrix(0, nrow(lu.arc1), nrow(GPAout$pcar)) tan.lu.arc2 = matrix(0, nrow(lu.arc2), nrow(GPAout$pcar)) tan.lu.arc3 = matrix(0, nrow(lu.arc3), nrow(GPAout$pcar)) for (i in 1:nrow(lu.arc1)) { for (j in 1:n.pc) { tan.lu.arc1[i, ] = tan.lu.arc1[i, ] + scores.lu.arc1[i, j] * GPAout$pcar[, j] tan.lu.arc2[i, ] = tan.lu.arc2[i, ] + scores.lu.arc2[i, j] * GPAout$pcar[, j] tan.lu.arc3[i, ] = tan.lu.arc3[i, ] + scores.lu.arc3[i, j] * GPAout$pcar[, j] } } shapes.arc1 = array(NA, c(k, m, npts)) shapes.arc2 = array(NA, c(k, m, npts)) shapes.arc3 = array(NA, c(k, m, npts)) H = defh(k - 1) for (i in 1:npts) { # to convert from in expo map to partial tangent coords and then to icon configuration rho<-Enorm(U1[i,]) shapes.arc1[, , i] = preshape2shape(tangentcoords.partial.inv(v = U1[i, ]*sin(rho)/rho, p = H %*% GPAout$mshape, R = diag(m))) rho<-Enorm(U2[i,]) shapes.arc2[, , i] = preshape2shape(tangentcoords.partial.inv(v = U2[i, ]*sin(rho)/rho, p = H %*% GPAout$mshape, R = diag(m))) rho<-Enorm(U3[i,]) shapes.arc3[, , i] = preshape2shape(tangentcoords.partial.inv(v = U3[i, ]*sin(rho)/rho, p = H %*% GPAout$mshape, R = diag(m))) } rho<-Enorm(U.mean) shapes.PNSmean = preshape2shape(tangentcoords.partial.inv(v = U.mean*sin(rho)/rho, p = H %*% GPAout$mshape, R = diag(m))) shapes.lu.arc1 = array(NA, c(k, m, nrow(lu.arc1))) shapes.lu.arc2 = array(NA, c(k, m, nrow(lu.arc2))) shapes.lu.arc3 = array(NA, c(k, m, nrow(lu.arc3))) for (i in 1:nrow(lu.arc1)) { rho<-Enorm(tan.lu.arc1[i,]) shapes.lu.arc1[, , i] = preshape2shape(tangentcoords.partial.inv(v = tan.lu.arc1[i, ]*sin(rho)/rho, p = H %*% GPAout$mshape, R = diag(m))) rho<-Enorm(tan.lu.arc2[i,]) shapes.lu.arc2[, , i] = preshape2shape(tangentcoords.partial.inv(v = tan.lu.arc2[i, ]*sin(rho)/rho, p = H %*% GPAout$mshape, R = diag(m))) rho<-Enorm(tan.lu.arc3[i,]) shapes.lu.arc3[, , i] = preshape2shape(tangentcoords.partial.inv(v = tan.lu.arc3[i, ]*sin(rho)/rho, p = H %*% GPAout$mshape, R = diag(m))) } h <- defh(k - 1) zero <- matrix(0, k - 1, k) H <- cbind(h, zero, zero) H1 <- cbind(zero, h, zero) H2 <- cbind(zero, zero, h) H <- rbind(H, H1, H2) if (dim(GPAout$pcar)[1] == (3 * (k - 1))) { pcarot <- (t(H) %*% GPAout$pcar) GPAout$pcar <- pcarot } if (pcno == 1) { shapes.lu.arc <- shapes.lu.arc1 } if (pcno == 2) { shapes.lu.arc <- shapes.lu.arc2 } if (pcno == 3) { shapes.lu.arc <- shapes.lu.arc3 } if (type == "pca") { open3d() par3d(windowRect = c(20, 30, 800, 800)) view3d(view.theta, view.phi) plot3d(GPAout$mshape, type = "s", col = rainbow(k), radius = rad1, add = TRUE) lines3d(GPAout$mshape, col = rainbow(k), lwd = 5) pcu <- GPAout$mshape + c * GPAout$pcasd[pcno] * cbind(GPAout$pcar[1:k, pcno], GPAout$pcar[(k + 1):(2 * k), pcno], GPAout$pcar[(2 * k + 1):(3 * k), pcno]) pcl <- GPAout$mshape - c * GPAout$pcasd[pcno] * cbind(GPAout$pcar[1:k, pcno], GPAout$pcar[(k + 1):(2 * k), pcno], GPAout$pcar[(2 * k + 1):(3 * k), pcno]) spheres3d(pcu, radius = rad2, color = "black") spheres3d(pcl, radius = rad2, color = "grey") for (j in 1:k) { lines3d(rbind(pcl[j, ], pcu[j, ]), col = rainbow(k)[j]) if (j > 1) { lines3d(rbind(pcu[j - 1, ], pcu[j, ]), col = "black") lines3d(rbind(pcl[j - 1, ], pcl[j, ]), col = "grey") } } } if (type == "pnss") { open3d() par3d(windowRect = c(20, 30, 800, 800)) view3d(view.theta, view.phi) plot3d(shapes.PNSmean, type = "s", col = rainbow(k), radius = rad1, add = TRUE) lines3d(shapes.PNSmean, lwd = 5, col = rainbow(k)) for (i in 1:k) { lines3d(t(shapes.lu.arc[i, , ]), col = rainbow(k)[i], lwd = 1, lty = 2) spheres3d(head(t(shapes.lu.arc[i, , ]), 1), radius = rad2, color = "black") if (i > 1) { lines3d((shapes.lu.arc[(i - 1):i, , 1]), col = "black") } spheres3d(tail(t(shapes.lu.arc[i, , ]), 1), radius = rad2, color = "grey") if (i > 1) { lines3d((shapes.lu.arc[(i - 1):i, , 201]), col = "grey") } } } out <- list(PNSmean = 0, lu.arc = 0) out$PNSmean <- shapes.PNSmean out$lu.arc <- shapes.lu.arc out } ######## pnss3d<- function (x, sphere.type = "seq.test", mean.type="Frechet", alpha = 0.1, R = 100, nlast.small.sphere = 1, n.pc = "Full", output=TRUE) { k = dim(x)[1] m = dim(x)[2] n = dim(x)[3] if (n.pc =="Full" ) { n.pc=m*k-m*(m-1)/2-m } if (m==2){ tem1 <- array( 0, c(k,3,n) ) tem1[,1:2,]<-x x<-tem1 m<-3 } #if (n < ((k - 1) * m)) { # print("Note: n < (k - 1) * m.") # jj<- round( (k-1)*m/n + 0.5) # print("Adding extra copies of the data") # tem<- array(0,c(k,m,jj*n)) # tem[,,1:n]<-x # for (i in 2:jj){ # for (j in 1:n){ # tem[,,(i-1)*n+ j ]<-x[,,j] + 0*matrix( rnorm(k*m), k,m) # } # } # x<-tem #} k = dim(x)[1] m = dim(x)[2] n = dim(x)[3] out = pc2sphere2(x = x, n.pc = n.pc, output=output) spheredata = t(out$spheredata) GPAout = out$GPAout pns.out = pns(x = spheredata, sphere.type = sphere.type, mean.type=mean.type, alpha = alpha, R = R, nlast.small.sphere = nlast.small.sphere, output=output) pns.out$percent = pns.out$percent * sum(GPAout$percent[1:n.pc])/100 if (output){ print("Radii of spheres") print(pns.out$PNS$radii) print("PNS percent explained") cat(c(round(pns.out$percent,2),"\n")) print("PCA percent explained") cat(c(round(GPAout$percent,2),"\n")) } pns.out$GPAout = GPAout pns.out$spheredata = spheredata return(pns.out) } pc2sphere2<-function (x, n.pc, output=TRUE) { k = dim(x)[1] m = dim(x)[2] n = dim(x)[3] GPAout = procGPA(x = x, scale = TRUE, reflect = FALSE, tol1=1e-8,tangentcoords = "partial", distances = TRUE) if (output){ cat("First ", n.pc, " principal components explain ", round(sum(GPAout$percent[1:n.pc]),2), "% of total variance. \n", sep = "") } H = defh(k - 1) X.hat = H %*% GPAout$mshape S = array(NA, c(k - 1, m, n)) for (i in 1:n) { S[, , i] = H %*% GPAout$rotated[, , i] } T.c = GPAout$tan #- apply(GPAout$tan, 1, mean) out = pcscore2sphere2(n.pc = n.pc, X.hat = X.hat, S = S, Tan = T.c, V = GPAout$pcar) return(list(spheredata = out, GPAout = GPAout)) } backfit <- function( scores, x , type="pnss", size=1){ npc <- length(scores) if (type=="pnss"){ PNS.object<-x PNS<-PNS.object$PNS GPAout<-PNS.object$GPAout z1 <- PNSe2s(matrix(scores,npc,1),PNS) pcscores<-c(sphere2pcscore(x=t(z1))) #note the PC scores are from the inverse exponential map tangent coordinates mu <- GPAout$mshape k<-dim(mu)[1] m<-dim(mu)[2] H = defh(k - 1) U<- GPAout$pcar[,1]*0 for (j in 1:npc) { U = U + pcscores[j] * GPAout$pcar[, j] } # to convert from in expo map to partial tangent coords and then to icon configuration rho<-Enorm(U) xout<-preshape2shape(tangentcoords.partial.inv(v = U*sin(rho)/rho, p = H %*% GPAout$mshape, R = diag(m)))*size } if (type=="pca"){ GPAout<- x pcscores<-scores #assume partial tangent coordinates mu <- GPAout$mshape k<-dim(mu)[1] m<-dim(mu)[2] H = defh(k - 1) U<- GPAout$pcar[,1]*0 for (j in 1:npc) { U = U + pcscores[j] * GPAout$pcar[, j] } xout<-preshape2shape(tangentcoords.partial.inv(v = U, p = H %*% GPAout$mshape, R = diag(m)))*size } xout } projectPNS <- function( x , PNS){ #obtain the PNS scores for new spherical data with respect to a PNS object PNSobj <- PNS x<-as.matrix(x) k <- dim(x)[1] n <- dim(x)[2] d <- k-1 scorescheck <- matrix(0,n,d) currentSphere <- x for (i in 1:(d-1)){ center <- PNSobj$PNS$orthaxis[[i]] r <- PNSobj$PNS$dist[i] res = ( acos(t(center) %*% currentSphere) - r ) scorescheck[,d+1-i]<-t(res)*PNSobj$PNS$radii[i] #rescale by actual radius of (sub)sphere where fit is carried out ##### cur.proj = project.subsphere(x = currentSphere, center = center, r = r) NestedSphere = rotMat(center) %*% currentSphere currentSphere = NestedSphere[1:(k - i), ]/repmat(matrix(sqrt(1 - NestedSphere[nrow(NestedSphere), ]^2), nrow = 1), k - i, 1) ############## } S1toRadian = atan2(currentSphere[2, ], currentSphere[1, ]) # meantheta = geodmeanS1(S1toRadian)$geodmean meantheta <- PNSobj$PNS$orthaxis[[d]] scorescheck[,1] = (mod(S1toRadian - meantheta + pi, 2 * pi) - pi )* PNSobj$PNS$radii[d] #rescale by actual radius of fitted circle scorescheck } pcscore2sphere3 <- function (n.pc, X.hat, Xs, Tan, V) { d = nrow(Tan) n = ncol(Tan) W = matrix(NA, d, n) for (i in 1:n) { W[, i] = acos( sum(Xs[i,]*X.hat) ) * Tan[, i]/sqrt(sum(Tan[, i]^2)) } lambda = matrix(NA, n, d) for (i in 1:n) { for (j in 1:n.pc) { lambda[i, j] = sum(W[, i] * V[, j]) } } U = matrix(0, n, d) for (i in 1:n) { for (j in 1:n.pc) { U[i, ] = U[i, ] + lambda[i, j] * V[, j] } } S.star = matrix(NA, n, n.pc + 1) for (i in 1:n) { U.norm = sqrt(sum(U[i, ]^2)) S.star[i, ] = c(cos(U.norm), sin(U.norm)/U.norm * lambda[i, 1:n.pc]) } return(S.star) } fastpns <- function (x, n.pc = "Full", sphere.type = "seq.test", mean.type="Frechet", alpha = 0.1, R = 100, nlast.small.sphere = 1, output = TRUE, pointcolor = 2) { n <- dim(x)[2] pdim <- dim(x)[1] if (n.pc == "Full") { n.pc = min(c( pdim-1 , n - 1)) } Xs <- t(x) for (i in 1:n) { Xs[i, ] <- Xs[i, ]/Enorm(Xs[i, ]) } muhat <- apply(Xs, 2, mean) muhat <- muhat/Enorm(muhat) TT <- Xs for (i in 1:n) { TT[i, ] <- Xs[i, ] - sum(Xs[i, ] * muhat) * muhat } pca <- prcomp(TT) pcapercent <- sum(pca$sdev[1:n.pc]^2/sum(pca$sdev^2)) cat(c("Initial PNS subsphere dimension", n.pc + 1, "\n")) cat(c("Percentage of variability in PNS sequence", round(pcapercent * 100, 2), "\n")) TT <- t(TT) ans <- pcscore2sphere3(n.pc, muhat, Xs, TT, pca$rotation) Xssubsphere <- t(ans) out <- pns( (Xssubsphere), sphere.type = sphere.type, mean.type=mean.type, alpha = alpha, R = R, nlast.small.sphere = nlast.small.sphere, output = output, pointcolor = pointcolor) out$percent <- out$percent * pcapercent cat(c("Percent explained by 1st three PNS scores out of total variability:", "\n", round(out$percent[1:3], 2), "\n")) out$spheredata <- (Xssubsphere) out$pca <- pca out$muhat <- muhat out$n.pc <- n.pc out } fastPNSe2s <- function( res , pns ){ out<-pns GG <- PNSe2s( res , out$PNS ) n<-dim(GG)[2] muhat <- pns$muhat n.pc <- pns$n.pc ### now work out the PC scores for the original high-dimensional coordinates s<-acos( GG[1,] ) HH <- diag(s/sin(s))%*%t(GG[2:(n.pc+1),]) ones<-rep(1,times=n) #Preferred approx back on sphere (it is unit size) #This is exact if n.pc = "Full" approx1 <- t(GG[2:(n.pc+1),])%*%t(out$pca$rotation[,1:(n.pc)])+diag(cos(s) )%*%ones%*%t(muhat)/Enorm(muhat) approx1 } fastpns_biplot<-function(pns, varnames, view1=1, view2=2 ){ pns1<-pns nd <- dim(pns$resmat)[1]+1 ndhigh<-length(pns$muhat) palette(rainbow(min(ndhigh,1024))) res<-matrix(0,41,nd-1) res1<-res res2<-res res1[,view1] <- (20:(-20))/10*sd( pns1$resmat[view1,]) res2[,view2] <- (20:(-20))/10*sd( pns1$resmat[view2,]) mshape <- fastPNSe2s( t(res1)*0 , pns1 ) aa1 <- fastPNSe2s( t(res1) , pns1 ) -mshape aa2 <- fastPNSe2s( t(res2) , pns1 ) -mshape nl<- dim(aa1)[1] aa1<-t(aa1) aa2<-t(aa2) plot(aa1[1,],aa2[1,],xlim=c( min(aa1),max(aa1)) , type="n", col=2, ylim=c(min(aa2),max(aa2)) ,xlab=c("PNS",view1), ylab=c("PNS",view2)) for (i in 1:(ndhigh)){ lines(aa1[i,],aa2[i,],col=i) arrows( aa1[i,2],aa2[i,2],aa1[i,1],aa2[i,1],col=i) text( aa1[i,1],aa2[i,1], varnames[i],col=i,cex=1) } title("fast PNS biplot") palette("default") } #================================================================================== # PNS The Principal Nested Spheres code (PNS) for spheres and shapes has # been written by Kwang-Rae Kim, and builds closely on the original matlab # code for PNS by Sungkyu Jung #================================================================================== #================================================================================== pns = function(x, sphere.type = "seq.test", mean.type="Frechet", alpha = 0.1, R = 100, nlast.small.sphere = 1, output=TRUE , pointcolor=2, distr="normal", penalty=0) { n = ncol(x) k = nrow(x) PNS = list() if (abs(sum(apply(x ^ 2, 2, sum)) - n) > 1e-8) { stop("Error: Each column of x should be a unit vector, ||x[ , i]|| = 1.") } svd.x = svd(x, nu = nrow(x)) uu = svd.x$u maxd = which(svd.x$d < 1e-15)[1] if (is.na(maxd) | k > n) { maxd = min(k, n) + 1 } nullspdim = k - maxd + 1 d = k - 1 if (output){ cat("Message from pns() : dataset is on ", d, "-sphere. \n", sep = "") } if (nullspdim > 0) { if (output){ cat(" .. found null space of dimension ", nullspdim, ", to be trivially reduced. \n", sep = "") } } if (d==2){ PNS$spherePNS<-t(x) } resmat = matrix(NA, d, n) orthaxis = list() orthaxis[[d - 1]] = NA dist = rep(NA, d - 1) pvalues = matrix(NA, d - 1, 2) ratio = rep(NA, d - 1) currentSphere = x if (nullspdim > 0) { for (i in 1:nullspdim) { oaxis = uu[, ncol(uu) - i + 1] r = pi / 2 pvalues[i,] = c(NaN, NaN) res = acos(t(oaxis) %*% currentSphere) - r orthaxis[[i]] = oaxis dist[i] = r resmat[i,] = res NestedSphere = rotMat(oaxis) %*% currentSphere currentSphere = NestedSphere[1:(k - i),] / repmat(matrix(sqrt(1 - NestedSphere[nrow(NestedSphere),] ^ 2), nrow = 1), k - i, 1) uu = rotMat(oaxis) %*% uu uu = uu[1:(k - i),] / repmat(matrix(sqrt(1 - uu[nrow(uu),] ^ 2), nrow = 1), k - i, 1) if (output){ cat(d - i + 1, "-sphere to ", d - i, "-sphere, by ", "NULL space \n", sep = "") } } } if (sphere.type == "seq.test") { if (output){ cat(" .. sequential tests with significance level ", alpha, "\n", sep = "") } isIsotropic = FALSE for (i in (nullspdim + 1):(d - 1)) { if (!isIsotropic) { sp = getSubSphere(x = currentSphere, geodesic = "small") center.s = sp$center r.s = sp$r resSMALL = acos(t(center.s) %*% currentSphere) - r.s sp = getSubSphere(x = currentSphere, geodesic = "great") center.g = sp$center r.g = sp$r resGREAT = acos(t(center.g) %*% currentSphere) - r.g pval1 = LRTpval(resGREAT, resSMALL, n) pvalues[i, 1] = pval1 if (pval1 > alpha) { center = center.g r = r.g pvalues[i, 2] = NA if (output){ cat( d - i + 1, "-sphere to ", d - i, "-sphere, by GREAT sphere, p(LRT) = ", pval1, "\n", sep = "" ) } } else { pval2 = vMFtest(currentSphere, R) pvalues[i, 2] = pval2 if (pval2 > alpha) { center = center.g r = r.g if (output){ cat( d - i + 1, "-sphere to ", d - i, "-sphere, by GREAT sphere, p(LRT) = ", pval1, ", p(vMF) = ", pval2, "\n", sep = "" ) } isIsotropic = TRUE } else { center = center.s r = r.s if (output){ cat( d - i + 1, "-sphere to ", d - i, "-sphere, by SMALL sphere, p(LRT) = ", pval1, ", p(vMF) = ", pval2, "\n", sep = "" ) } } } } else if (isIsotropic) { sp = getSubSphere(x = currentSphere, geodesic = "great") center = sp$center r = sp$r if (output){ cat( d - i + 1, "-sphere to ", d - i, "-sphere, by GREAT sphere, restricted by testing vMF distn", "\n", sep = "" ) } pvalues[i, 1] = NA pvalues[i, 2] = NA } res = acos(t(center) %*% currentSphere) - r orthaxis[[i]] = center dist[i] = r resmat[i,] = res cur.proj = project.subsphere(x = currentSphere, center = center, r = r) NestedSphere = rotMat(center) %*% currentSphere currentSphere = NestedSphere[1:(k - i),] / repmat(matrix(sqrt(1 - NestedSphere[nrow(NestedSphere),] ^ 2), nrow = 1), k - i, 1) ########### if (nrow(currentSphere) == 3) { PNS$spherePNS = t(currentSphere) } if (nrow(currentSphere) == 2) { PNS$circlePNS = t(cur.proj) } ############################# } } else if (sphere.type == "BIC") { if (output){ cat(" .. with BIC \n") } for (i in (nullspdim + 1):(d - 1)) { sp = getSubSphere(x = currentSphere, geodesic = "small") center.s = sp$center r.s = sp$r resSMALL = acos(t(center.s) %*% currentSphere) - r.s sp = getSubSphere(x = currentSphere, geodesic = "great") center.g = sp$center r.g = sp$r resGREAT = acos(t(center.g) %*% currentSphere) - r.g BICsmall = n * log(mean(resSMALL ^ 2)) + (d - i + 1 + 1) * log(n) BICgreat = n * log(mean(resGREAT ^ 2)) + (d - i + 1) * log(n) if (output){ cat("BICsm: ", BICsmall, ", BICgr: ", BICgreat, "\n", sep = "") } if (BICsmall > BICgreat) { center = center.g r = r.g if (output){ cat(d - i + 1, "-sphere to ", d - i, "-sphere, by ", "GREAT sphere, BIC \n", sep = "") } } else { center = center.s r = r.s if (output){ cat(d - i + 1, "-sphere to ", d - i, "-sphere, by ", "SMALL sphere, BIC \n", sep = "") } } res = acos(t(center) %*% currentSphere) - r orthaxis[[i]] = center dist[i] = r resmat[i,] = res cur.proj = project.subsphere(x = currentSphere, center = center, r = r) NestedSphere = rotMat(center) %*% currentSphere currentSphere = NestedSphere[1:(k - i),] / repmat(matrix(sqrt(1 - NestedSphere[nrow(NestedSphere),] ^ 2), nrow = 1), k - i, 1) ########### if (nrow(currentSphere) == 3) { PNS$spherePNS = t(currentSphere) } if (nrow(currentSphere) == 2) { PNS$circlePNS = t(cur.proj) } ############################# } } ############################## else if (sphere.type == "distr") { if (output) { cat(" .. with data distr \n") } for (i in (nullspdim + 1):(d - 1)) { sp = getSubSphere(x = currentSphere, geodesic = "small") center.s = sp$center r.s = sp$r resSMALL = c( acos(t(center.s) %*% currentSphere) - r.s ) sp = getSubSphere(x = currentSphere, geodesic = "great") center.g = sp$center r.g = sp$r resGREAT = c( acos(t(center.g) %*% currentSphere) - r.g ) if (distr=="normal"){ #### normal case NEWsmall = n * log(mean(abs(resSMALL)**2)) + (d - i + 1 + 1) * log(n) + penalty*( r.s - r.g)**2 NEWgreat = n * log(mean(abs(resGREAT)**2)) + (d - i + 1) * log(n) # qqnorm(resSMALL) # qqnorm(resGREAT) } else { outtem1 <- mledist( abs(c(resSMALL)) , distr=distr ) outtem2 <- mledist( abs(c(resGREAT)) , distr=distr ) mx<- max( c(abs(resSMALL), abs(resGREAT) )) # plot( density(abs(c(resSMALL))), xlim=c(0,mx) , main = " ") # lines( density(abs(c(resGREAT))) , col=2 ) # print(distr) distr0<-distr if (distr=="exp"){ # probPlot(abs( resSMALL ) , distr="exponential", plots="QQ") # probPlot(abs( resGREAT) , distr="exponential", plots="QQ") } if (distr=="weibull"){ # probPlot(abs( resSMALL ) , distr="weibull", plots="QQ") # probPlot(abs( resGREAT) , distr="weibull", plots="QQ") } if (distr=="lnorm"){ # probPlot(abs( resSMALL ) , distr="lognormal", plots="QQ") # probPlot(abs( resGREAT) , distr="lognormal", plots="QQ") } ###### more general NEWsmall = -2*outtem1$loglik + (d - i + 1 + 1) * log(n) + penalty*( r.s - r.g)**2 NEWgreat = -2*outtem2$loglik + (d - i + 1) * log(n) } if (output) { cat("NEWsm: ", NEWsmall, ", NEWgr: ", NEWgreat, "\n", sep = "") } if (NEWsmall > NEWgreat) { center = center.g r = r.g if (output) { cat(d - i + 1, "-sphere to ", d - i, "-sphere, by ", "GREAT sphere, \n", sep = "") } } else { center = center.s r = r.s if (output) { cat(d - i + 1, "-sphere to ", d - i, "-sphere, by ", "SMALL sphere, \n", sep = "") } } res = acos(t(center) %*% currentSphere) - r orthaxis[[i]] = center dist[i] = r resmat[i, ] = res cur.proj = project.subsphere(x = currentSphere, center = center, r = r) NestedSphere = rotMat(center) %*% currentSphere currentSphere = NestedSphere[1:(k - i), ]/repmat(matrix(sqrt(1 - NestedSphere[nrow(NestedSphere), ]^2), nrow = 1), k - i, 1) if (nrow(currentSphere) == 3) { PNS$spherePNS = t(currentSphere) } if (nrow(currentSphere) == 2) { PNS$circlePNS = t(cur.proj) } } } else if (sphere.type == "ks.test") { if (output) { cat(" .. with ks.test \n") } for (i in (nullspdim + 1):(d - 1)) { sp = getSubSphere(x = currentSphere, geodesic = "small") center.s = sp$center r.s = sp$r resSMALL = c( acos(t(center.s) %*% currentSphere) - r.s ) sp = getSubSphere(x = currentSphere, geodesic = "great") center.g = sp$center r.g = sp$r resGREAT = c( acos(t(center.g) %*% currentSphere) - r.g ) mx<- max( c(abs(resSMALL), abs(resGREAT) )) out <- ks.test ( abs(resSMALL) , abs(resGREAT) ) if ( out$p.value > 0.1 ) { center = center.g r = r.g if (output) { cat(d - i + 1, "-sphere to ", d - i, "-sphere, by ", "GREAT sphere, \n", sep = "") } } else { center = center.s r = r.s if (output) { cat(d - i + 1, "-sphere to ", d - i, "-sphere, by ", "SMALL sphere, \n", sep = "") } } res = acos(t(center) %*% currentSphere) - r orthaxis[[i]] = center dist[i] = r resmat[i, ] = res cur.proj = project.subsphere(x = currentSphere, center = center, r = r) NestedSphere = rotMat(center) %*% currentSphere currentSphere = NestedSphere[1:(k - i), ]/repmat(matrix(sqrt(1 - NestedSphere[nrow(NestedSphere), ]^2), nrow = 1), k - i, 1) if (nrow(currentSphere) == 3) { PNS$spherePNS = t(currentSphere) } if (nrow(currentSphere) == 2) { PNS$circlePNS = t(cur.proj) } } } ###### else if (sphere.type == "var.test") { if (output) { cat(" .. with var.test \n") } for (i in (nullspdim + 1):(d - 1)) { sp = getSubSphere(x = currentSphere, geodesic = "small") center.s = sp$center r.s = sp$r resSMALL = c( acos(t(center.s) %*% currentSphere) - r.s ) sp = getSubSphere(x = currentSphere, geodesic = "great") center.g = sp$center r.g = sp$r resGREAT = c( acos(t(center.g) %*% currentSphere) - r.g ) mx<- max( c(abs(resSMALL), abs(resGREAT) )) # plot( density(abs(c(resSMALL))), xlim=c(0,mx) , main =" ") # lines( density(abs(c(resGREAT))) , col=2 ) out <- var.test ( resSMALL, resGREAT ) if ( out$p.value > 0.1 ) { center = center.g r = r.g if (output) { cat(d - i + 1, "-sphere to ", d - i, "-sphere, by ", "GREAT sphere, \n", sep = "") } } else { center = center.s r = r.s if (output) { cat(d - i + 1, "-sphere to ", d - i, "-sphere, by ", "SMALL sphere, \n", sep = "") } } res = acos(t(center) %*% currentSphere) - r orthaxis[[i]] = center dist[i] = r resmat[i, ] = res cur.proj = project.subsphere(x = currentSphere, center = center, r = r) NestedSphere = rotMat(center) %*% currentSphere currentSphere = NestedSphere[1:(k - i), ]/repmat(matrix(sqrt(1 - NestedSphere[nrow(NestedSphere), ]^2), nrow = 1), k - i, 1) if (nrow(currentSphere) == 3) { PNS$spherePNS = t(currentSphere) } if (nrow(currentSphere) == 2) { PNS$circlePNS = t(cur.proj) } } } else if (sphere.type == "small" | sphere.type == "great") { pvalues = NaN for (i in (nullspdim + 1):(d - 1)) { sp = getSubSphere(x = currentSphere, geodesic = sphere.type) center = sp$center r = sp$r res = acos(t(center) %*% currentSphere) - r orthaxis[[i]] = center dist[i] = r resmat[i,] = res cur.proj = project.subsphere(x = currentSphere, center = center, r = r) NestedSphere = rotMat(center) %*% currentSphere currentSphere = NestedSphere[1:(k - i),] / repmat(matrix(sqrt(1 - NestedSphere[nrow(NestedSphere),] ^ 2), nrow = 1), k - i, 1) ########### if (nrow(currentSphere) == 3) { PNS$spherePNS = t(currentSphere) } if (nrow(currentSphere) == 2) { PNS$circlePNS = t(cur.proj) } ############################# } } else if (sphere.type == "bi.sphere") { if (nlast.small.sphere < 0) { cat("!!! Error from pns(): \n") cat("!!! nlast.small.sphere should be >= 0. \n") return(NULL) } mx = (d - 1) - nullspdim if (nlast.small.sphere > mx) { cat("!!! Error from pns(): \n") cat("!!! nlast.small.sphere should be <= ", mx, " for this data. \n", sep = "") return(NULL) } pvalues = NaN if (nlast.small.sphere != mx) { for (i in (nullspdim + 1):(d - 1 - nlast.small.sphere)) { sp = getSubSphere(x = currentSphere, geodesic = "great") center = sp$center r = sp$r res = acos(t(center) %*% currentSphere) - r orthaxis[[i]] = center dist[i] = r resmat[i,] = res cur.proj = project.subsphere(x = currentSphere, center = center, r = r) NestedSphere = rotMat(center) %*% currentSphere currentSphere = NestedSphere[1:(k - i),] / repmat(matrix(sqrt(1 - NestedSphere[nrow(NestedSphere),] ^ 2), nrow = 1), k - i, 1) ########### if (nrow(currentSphere) == 3) { PNS$spherePNS = t(currentSphere) } if (nrow(currentSphere) == 2) { PNS$circlePNS = t(cur.proj) } ############################# } } if (nlast.small.sphere != 0) { for (i in (d - nlast.small.sphere):(d - 1)) { sp = getSubSphere(x = currentSphere, geodesic = "small") center = sp$center r = sp$r res = acos(t(center) %*% currentSphere) - r orthaxis[[i]] = center dist[i] = r resmat[i,] = res cur.proj = project.subsphere(x = currentSphere, center = center, r = r) NestedSphere = rotMat(center) %*% currentSphere currentSphere = NestedSphere[1:(k - i),] / repmat(matrix(sqrt(1 - NestedSphere[nrow(NestedSphere),] ^ 2), nrow = 1), k - i, 1) ########### if (nrow(currentSphere) == 3) { PNS$spherePNS = t(currentSphere) } if (nrow(currentSphere) == 2) { PNS$circlePNS = t(cur.proj) } ############################# } } } else { print("!!! Error from pns():") print("!!! sphere.type must be 'seq.test', 'small', 'great', 'BIC', or 'bi.sphere'") print("!!! Terminating execution ") return(NULL) } S1toRadian = atan2(currentSphere[2,], currentSphere[1,]) meantheta = geodmeanS1(S1toRadian,mean.type=mean.type)$geodmean orthaxis[[d]] = meantheta resmat[d,] = mod(S1toRadian - meantheta + pi, 2 * pi) - pi if (output){ par( mfrow = c(1, 1), mar = c(4, 4, 1, 1), mgp = c(2.5, 1, 0), cex = 0.8 ) plot( currentSphere[1,], currentSphere[2,], xlab = "", ylab = "", xlim = c(-1, 1), ylim = c(-1, 1), asp = 1 ) abline(h = 0, v = 0) points( cos(meantheta), sin(meantheta), pch = 1, cex = 3, col = "black", lwd = 5 ) abline( a = 0, b = sin(meantheta) / cos(meantheta), lty = 3 ) l = mod(S1toRadian - meantheta + pi, 2 * pi) - pi points( cos(S1toRadian[which.max(l)]), sin(S1toRadian[which.max(l)]), pch = 4, cex = 3, col = "blue" ) points( cos(S1toRadian[which.min(l)]), sin(S1toRadian[which.min(l)]), pch = 4, cex = 3, col = "red" ) legend( "topright", legend = c("Geodesic mean", "Max (+)ve from mean", "Min (-)ve from mean"), col = c("black", "blue", "red"), pch = c(1, 4, 4) ) { cat("\n") cat( "length of BLUE from geodesic mean : ", max(l), " (", round(max(l) * 180 / pi), " degree)", "\n", sep = "" ) cat( "length of RED from geodesic mean : ", min(l), " (", round(min(l) * 180 / pi), " degree)", "\n", sep = "" ) cat("\n") } } radii = 1 for (i in 1:(d - 1)) { radii = c(radii, prod(sin(dist[1:i]))) } resmat = flipud0(repmat(matrix(radii, ncol = 1), 1, n) * resmat) if (d>1){ if (output){ ### plot points on the 3D sphere (pointcolor), with 2D projection (white) rgl.sphgrid1() sphere1.f(col="white",alpha=0.6) sphrad <- 0.015 spheres3d(-PNS$circlePNS[,2],PNS$circlePNS[,1],PNS$circlePNS[,3],radius=sphrad,col="White") spheres3d(-PNS$spherePNS[,2],PNS$spherePNS[,1],PNS$spherePNS[,3],radius=sphrad,col=pointcolor) } yy <- orthaxis[[d-1]] xx <- c(-yy[2], yy[1] , yy[3]) c1<-Enorm( c(xx[1],xx[2],xx[3])- c(-PNS$circlePNS[1,2],PNS$circlePNS[1,1],PNS$circlePNS[1,3])) costheta<- 1 - c1^2/2 angle<-(1:201)/(200)*2*pi centre<- xx*costheta A<- xx-centre B<- diag(3)-A%*%t(A)/Enorm(A)**2 bv<-eigen(B)$vectors b1<-bv[,1] b2<-bv[,2] cc<- sin(acos(costheta))* ( cos(angle)%*%t(b1) + sin(angle)%*%t(b2) ) + rep(1,times=201)%*%t(centre) if (output){ lines3d(cc,col=3,lwd=2) } ###### if (output){ lines3d(cc,col=3,lwd=2) # Note this provides a plot of the PNS mean in gold (updated calculation) if (mean.type=="Fisher"){ sum<-0 for (i in 1:n){ sum=sum+ ( acos( cc%*%c(-PNS$circlePNS[i,2],PNS$circlePNS[i,1],PNS$circlePNS[i,3])) )**2 } #different PNS mean mean0angle<-which.min(sum[1:200])/200*2*pi meanpt<- sin(acos(costheta))* ( cos(mean0angle)%*%t(b1) + sin(mean0angle)%*%t(b2) ) +t(centre) spheres3d( meanpt, radius=sphrad * 1.5,col=7, alpha=0.8) } if (mean.type=="Frechet"){ ddout<-rep(0,times=n) sum2<-rep(0,times=200) R <- sin(acos(costheta)) for (jj in 1:200){ for (i in 1:n){ ddout[i]<- ( mod( acos( sum( (cc[jj,]-centre)*(c(-PNS$circlePNS[i,2],PNS$circlePNS[i,1],PNS$circlePNS[i,3])-centre) )/R^2),2*pi) )**2 } sum2[jj]<-sum(ddout) } mean0angle <- which.min(sum2[1:200])/200 * 2 * pi meanpt <- sin(acos(costheta)) * (cos(mean0angle) %*% t(b1) + sin(mean0angle) %*% t(b2)) + t(centre) spheres3d(meanpt, radius = sphrad * 1.5, col = 7, alpha = 0.8) } } ########### } PNS$scores = t(resmat) PNS$radii = radii PNS$pnscircle <- cbind( cbind( cc[,2],-cc[,1]) , cc[,3]) PNS$orthaxis = orthaxis PNS$dist = dist PNS$pvalues = pvalues PNS$ratio = ratio PNS$basisu = NULL PNS$mean = c(PNSe2s(matrix(0, d, 1), PNS)) if (sphere.type == "seq.test") { PNS$sphere.type = "seq.test" } else if (sphere.type == "small") { PNS$sphere.type = "small" } else if (sphere.type == "great") { PNS$sphere.type = "great" } else if (sphere.type == "BIC") { PNS$sphere.type = "BIC" } else if (sphere.type == "bi.sphere") { PNS$sphere.type = "bi.sphere" } varPNS = apply(abs(resmat) ^ 2, 1, sum) / n total = sum(varPNS) propPNS = varPNS / total * 100 return(list( resmat = resmat, PNS = PNS, percent = propPNS )) } #high-res sphere plot #from stackoverflow answer (Mike Wise) sphere1.f <- function(x0 = 0, y0 = 0, z0 = 0, r = 1, n = 101, ...){ f <- function(s,t){ cbind( r * cos(t)*cos(s) + x0, r * sin(s) + y0, r * sin(t)*cos(s) + z0) } persp3d(f, slim = c(-pi/2,pi/2), tlim = c(0, 2*pi), n = n, add = T, ...) } #adapted from the package "sphereplot" to remove text and axes (Aaron Robotham) rgl.sphgrid1 <- function (radius = 1, col.long = "red", col.lat = "blue", deggap = 15, longtype = "H", add = FALSE, radaxis = TRUE, radlab = "Radius") { if (add == F) { open3d() } for (lat in seq(-90, 90, by = deggap)) { if (lat == 0) { col.grid = "grey50" } else { col.grid = "grey" } plot3d(sph2car1(long = seq(0, 360, len = 100), lat = lat, radius = radius, deg = T), col = col.grid, add = T, type = "l") } for (long in seq(0, 360 - deggap, by = deggap)) { if (long == 0) { col.grid = "grey50" } else { col.grid = "grey" } plot3d(sph2car1(long = long, lat = seq(-90, 90, len = 100), radius = radius, deg = T), col = col.grid, add = T, type = "l") } if (longtype == "H") { scale = 15 } if (longtype == "D") { scale = 1 } # rgl.sphtext(long = 0, lat = seq(-90, 90, by = deggap), radius = radius, # text = seq(-90, 90, by = deggap), deg = TRUE, col = col.lat) # rgl.sphtext(long = seq(0, 360 - deggap, by = deggap), lat = 0, # radius = radius, text = seq(0, 360 - deggap, by = deggap)/scale, # deg = TRUE, col = col.long) if (radaxis) { radpretty = pretty(c(0, radius)) radpretty = radpretty[radpretty <= radius] # lines3d(c(0, 0), c(0, max(radpretty)), c(0, 0), col = "grey50") for (i in 1:length(radpretty)) { # lines3d(c(0, 0), c(radpretty[i], radpretty[i]), c(0, # 0, radius/50), col = "grey50") # text3d(0, radpretty[i], radius/15, radpretty[i], # col = "darkgreen") } # text3d(0, radius/2, -radius/25, radlab) } } sph2car1<-function (long, lat, radius = 1, deg = TRUE) { if (is.matrix(long) || is.data.frame(long)) { if (ncol(long) == 1) { long = long[, 1] } else if (ncol(long) == 2) { lat = long[, 2] long = long[, 1] } else if (ncol(long) == 3) { radius = long[, 3] lat = long[, 2] long = long[, 1] } } if (missing(long) | missing(lat)) { stop("Missing full spherical 3D input data.") } if (deg) { long = long * pi/180 lat = lat * pi/180 } return = cbind(x = radius * cos(long) * cos(lat), y = radius * sin(long) * cos(lat), z = radius * sin(lat)) } pns_biplot<-function(pns, varnames=rownames(q),view1=1,view2=2,fastPNS=FALSE){ if (fastPNS){ pns1<-pns nd <- dim(pns$resmat)[1]+1 ndhigh<-length(pns$muhat) palette(rainbow(min(ndhigh,1024))) res<-matrix(0,41,nd-1) res1<-res res2<-res res1[,view1] <- (20:(-20))/10*sd( pns1$resmat[view1,]) res2[,view2] <- (20:(-20))/10*sd( pns1$resmat[view2,]) mshape <- fastPNSe2s( t(res1)*0 , pns1 ) aa1 <- fastPNSe2s( t(res1) , pns1 ) -mshape aa2 <- fastPNSe2s( t(res2) , pns1 ) -mshape nl<- dim(aa1)[1] aa1<-t(aa1) aa2<-t(aa2) plot(aa1[1,],aa2[1,],xlim=c( min(aa1),max(aa1)) , type="n", col=2, ylim=c(min(aa2),max(aa2)) ,xlab=c("PNS",view1), ylab=c("PNS",view2)) for (i in 1:(ndhigh)){ lines(aa1[i,],aa2[i,],col=i) arrows( aa1[i,2],aa2[i,2],aa1[i,1],aa2[i,1],col=i) text( aa1[i,1],aa2[i,1], varnames[i],col=i,cex=1) } title("fast PNS biplot") palette("default") } else { pns1<-pns nd <- dim(pns$resmat)[1]+1 palette(rainbow(nd)) res<-matrix(0,41,nd-1) res1 <- res res1[,view1] <- c( (20:(-20))/10*sd( pns1$resmat[view1,])) res2 <- res res2[,view2] <- c( (20:(-20))/10*sd( pns1$resmat[view2,])) aa1 <- PNSe2s( t(res1) , pns1$PNS ) -pns1$PNS$mean aa2 <- PNSe2s( t(res2) , pns1$PNS ) -pns1$PNS$mean plot(aa1[1,],aa2[1,],xlim=c( min(aa1),max(aa1)) , type="n", col=2, ylim=c(min(aa2),max(aa2)) ,xlab=c("PNS",view1), ylab=c("PNS",view2)) for (i in 1:(nd)){ lines(aa1[i,],aa2[i,],col=i) arrows( aa1[i,2],aa2[i,2],aa1[i,1],aa2[i,1],col=i) text( aa1[i,1],aa2[i,1], varnames[i],col=i,cex=1) } title("PNS biplot") palette("default") } } #================================================================================== pns4pc = function(x, sphere.type = "seq.test", alpha = 0.1, R = 100, nlast.small.sphere = 1, n.pc = 2) { if (n.pc < 2) { stop("Error: n.pc should be >= 2.") } out = pc2sphere2(x = x, n.pc = n.pc) spheredata = t(out$spheredata) GPAout = out$GPAout pns.out = pns( x = spheredata, sphere.type = sphere.type, alpha = alpha, R = R, nlast.small.sphere = nlast.small.sphere ) pns.out$percent = pns.out$percent * sum(GPAout$percent[1:n.pc]) / 100 pns.out$GPAout = GPAout pns.out$spheredata = spheredata return(pns.out) } pns.pc = function(x, sphere.type = "seq.test", alpha = 0.1, R = 100, nlast.small.sphere = 0, n.pc = 0) { k = dim(x)[1] m = dim(x)[2] n = dim(x)[3] if (n.pc == 0) { GPAout = procGPA( x = x, scale = TRUE, reflect = FALSE, tangentcoords = "partial", distances = FALSE ) spheredata = matrix(NA, k * m, n) for (i in 1:n) { spheredata[, i] = c(GPAout$rotated[, , i]) } pns.out = pns( x = spheredata, sphere.type = sphere.type, alpha = alpha, R = R, nlast.small.sphere = nlast.small.sphere ) resmat = pns.out$resmat PNS = pns.out$PNS npts = 200 prinarc1 = get.prinarc( resmat, PNS, arc = 1, n = npts, boundary.data = FALSE ) prinarc2 = get.prinarc( resmat, PNS, arc = 2, n = npts, boundary.data = FALSE ) prinarc1.ar = array(NA, c(k, m, npts)) prinarc2.ar = array(NA, c(k, m, npts)) for (i in 1:npts) { prinarc1.ar[, , i] = matrix(prinarc1[, i], nrow = k) prinarc2.ar[, , i] = matrix(prinarc2[, i], nrow = k) } scores.prinarc1 = shape.pcscores.partial(PCAout = GPAout, x = prinarc1.ar) scores.prinarc2 = shape.pcscores.partial(PCAout = GPAout, x = prinarc2.ar) out = pns.out out$GPAout = GPAout out$scores.prinarc1 = scores.prinarc1 out$scores.prinarc2 = scores.prinarc2 } else { pns.out = pns4pc( x = x, sphere.type = sphere.type, alpha = alpha, R = R, nlast.small.sphere = nlast.small.sphere, n.pc = n.pc ) GPAout = pns.out$GPAout resmat = pns.out$resmat PNS = pns.out$PNS npts = 200 prinarc1 = get.prinarc( resmat, PNS, arc = 1, n = npts, boundary.data = FALSE ) prinarc2 = get.prinarc( resmat, PNS, arc = 2, n = npts, boundary.data = FALSE ) scores.prinarc1 = matrix(NA, npts, n.pc) scores.prinarc2 = matrix(NA, npts, n.pc) for (g in 1:npts) { size1 = acos(prinarc1[1, g]) size2 = acos(prinarc2[1, g]) scores.prinarc1[g,] = prinarc1[2:(n.pc + 1), g] / (sin(size1) / size1) scores.prinarc2[g,] = prinarc2[2:(n.pc + 1), g] / (sin(size2) / size2) } out = pns.out out$scores.prinarc1 = scores.prinarc1 out$scores.prinarc2 = scores.prinarc2 } return(out) } #================================================================================== rotMat = function(b, a = NULL, alpha = NULL) { if (is.matrix(b)) { if (min(dim(b)) == 1) { b = c(b) } else { stop("Error: b should be a unit vector.") } } d = length(b) b = b / norm(b, type = "2") if (is.null(a) & is.null(alpha)) { a = c(rep(0, d - 1), 1) alpha = acos(sum(a * b)) } else if (!is.null(a) & is.null(alpha)) { alpha = acos(sum(a * b)) } else if (is.null(a) & !is.null(alpha)) { a = c(rep(0, d - 1), 1) } if (abs(sum(a * b) - 1) < 1e-15) { rot = diag(d) return(rot) } if (abs(sum(a * b) + 1) < 1e-15) { rot = -diag(d) return(rot) } c = b - a * sum(a * b) c = c / norm(c, type = "2") A = a %*% t(c) - c %*% t(a) rot = diag(d) + sin(alpha) * A + (cos(alpha) - 1) * (a %*% t(a) + c %*% t(c)) return(rot) } #================================================================================== ExpNPd = function(x) { if (is.vector(x)) { x = as.matrix(x) } d = nrow(x) nv = sqrt(apply(x ^ 2, 2, sum)) Exppx = rbind(matrix(rep(sin(nv) / nv, d), nrow = d, byrow = T) * x, cos(nv)) Exppx[, nv < 1e-16] = repmat(matrix(c(rep(0, d), 1)), 1, sum(nv < 1e-16)) return(Exppx) } #================================================================================== LogNPd = function(x) { n = ncol(x) d = nrow(x) scale = acos(x[d,]) / sqrt(1 - x[d,] ^ 2) scale[is.nan(scale)] = 1 Logpx = repmat(t(scale), d - 1, 1) * x[-d,] return(Logpx) } #================================================================================== objfn = function(center, r, x) { return(mean((acos(t( center ) %*% x) - r) ^ 2)) } #================================================================================== getSubSphere = function(x, geodesic = "small") { svd.x = svd(x) initialCenter = svd.x$u[, ncol(svd.x$u)] c0 = initialCenter TOL = 1e-10 cnt = 0 err = 1 n = ncol(x) d = nrow(x) Gnow = 1e+10 while (err > TOL) { c0 = c0 / norm(c0, type = "2") rot = rotMat(c0) TpX = LogNPd(rot %*% x) fit = sphereFit( x = TpX, initialCenter = rep(0, d - 1), geodesic = geodesic ) newCenterTp = fit$center r = fit$r if (r > pi) { r = pi / 2 svd.TpX = svd(TpX) newCenterTp = svd.TpX$u[, ncol(svd.TpX$u)] * pi / 2 } newCenter = ExpNPd(newCenterTp) center = solve(rot, newCenter) Gnext = objfn(center, r, x) err = abs(Gnow - Gnext) Gnow = Gnext c0 = center cnt = cnt + 1 if (cnt > 30) { break } } i1save = list() i1save$Gnow = Gnow i1save$center = center i1save$r = r U = princomp(t(x))$loadings[,] initialCenter = U[, ncol(U)] c0 = initialCenter TOL = 1e-10 cnt = 0 err = 1 n = ncol(x) d = nrow(x) Gnow = 1e+10 while (err > TOL) { c0 = c0 / norm(c0, type = "2") rot = rotMat(c0) TpX = LogNPd(rot %*% x) fit = sphereFit( x = TpX, initialCenter = rep(0, d - 1), geodesic = geodesic ) newCenterTp = fit$center r = fit$r if (r > pi) { r = pi / 2 svd.TpX = svd(TpX) newCenterTp = svd.TpX$u[, ncol(svd.TpX$u)] * pi / 2 } newCenter = ExpNPd(newCenterTp) center = solve(rot, newCenter) Gnext = objfn(center, r, x) err = abs(Gnow - Gnext) Gnow = Gnext c0 = center cnt = cnt + 1 if (cnt > 30) { break } } if (i1save$Gnow == min(Gnow, i1save$Gnow)) { center = i1save$center r = i1save$r } if (r > pi / 2) { center = -center r = pi - r } return(list(center = c(center), r = r)) } #================================================================================== LRTpval = function(resGREAT, resSMALL, n) { chi2 = max(n * log(sum(resGREAT ^ 2) / sum(resSMALL ^ 2)), 0) return(pchisq( q = chi2, df = 1, lower.tail = FALSE )) } #================================================================================== vMFtest = function(x, R = 100) { d = nrow(x) n = ncol(x) sumx = apply(x, 1, sum) rbar = norm(sumx, "2") / n muMLE = sumx / norm(sumx, "2") kappaMLE = (rbar * d - rbar ^ 3) / (1 - rbar ^ 2) sp = getSubSphere(x = x, geodesic = "small") center.s = sp$center r.s = sp$r radialdistances = acos(t(center.s) %*% x) xi_sample = mean(radialdistances) / sd(radialdistances) xi_vec = rep(0, R) for (r in 1:R) { rdata = randvonMisesFisherm(d, n, kappaMLE) sp = getSubSphere(x = rdata, geodesic = "small") center.s = sp$center r.s = sp$r radialdistances = acos(t(center.s) %*% rdata) xi_vec[r] = mean(radialdistances) / sd(radialdistances) } pvalue = mean(xi_vec > xi_sample) return(pvalue) } #================================================================================== geodmeanS1 = function(theta,mean.type="Frechet") { n = length(theta) if (mean.type=="Frechet"){ #kk candidates angles kk <-1000 meancandi = mod(mean(theta) + 2 * pi * (0:(kk - 1)) / kk, 2 * pi) theta = mod(theta, 2 * pi) geodvar = rep(0, kk) for (i in 1:kk) { v = meancandi[i] dist2 = apply(cbind((theta - v) ^ 2, (theta - v + 2 * pi) ^ 2, (v - theta + 2 * pi) ^ 2), 1, min) geodvar[i] = sum(dist2) } m = min(geodvar) ind = which.min(geodvar) geodmean = mod(meancandi[ind], 2 * pi) geodvar = geodvar[ind] / n } if (mean.type=="Fisher"){ mm <- atan2( mean(sin(theta)), mean(cos(theta)) ) geodmean <- mod(mm, 2*pi) geodvar <- 1 - sqrt( mean(sin(theta))**2 + mean(cos(theta))**2 ) } return(list(geodmean = geodmean, geodvar = geodvar)) } #================================================================================== PNSe2s = function(resmat, PNS) { dm = nrow(resmat) n = ncol(resmat) NSOrthaxis = rev(PNS$orthaxis[1:(dm - 1)]) NSradius = flipud0(matrix(PNS$dist, ncol = 1)) geodmean = PNS$orthaxis[[dm]] res = resmat / repmat(flipud0(matrix(PNS$radii, ncol = 1)), 1, n) T = t(rotMat(NSOrthaxis[[1]])) %*% rbind(repmat(sin(NSradius[1] + matrix(res[2,], nrow = 1)), 2, 1) * rbind(cos(geodmean + res[1,]), sin(geodmean + res[1,])), cos(NSradius[1] + res[2,])) if (dm > 2) { for (i in 1:(dm - 2)) { T = t(rotMat(NSOrthaxis[[i + 1]])) %*% rbind(repmat(sin(NSradius[i + 1] + matrix( res[i + 2,], nrow = 1 )), 2 + i, 1) * T, cos(NSradius[i + 1] + res[i + 2,])) } } if (!is.null(PNS$basisu)) { T = PNS$basisu %*% T } return(T) } #================================================================================== PNSs2e = function(spheredata, PNS) { if (nrow(spheredata) != length(PNS$mean)) { cat(" Error from PNSs2e() \n") cat(" Dimensions of the sphere and PNS decomposition do not match") return(NULL) } if (!is.null(PNS$basisu)) { spheredata = t(PNS$basisu) %*% spheredata } kk = nrow(spheredata) n = ncol(spheredata) Res = matrix(0, kk - 1, n) currentSphere = spheredata for (i in 1:(kk - 2)) { v = PNS$orthaxis[[i]] r = PNS$dist[i] res = acos(t(v) %*% currentSphere) - r Res[i,] = res NestedSphere = rotMat(v) %*% currentSphere currentSphere = as.matrix(NestedSphere[1:(kk - i),]) / repmat(matrix(sqrt(1 - NestedSphere[nrow(NestedSphere),] ^ 2), nrow = 1), kk - i, 1) } S1toRadian = atan2(currentSphere[2,], currentSphere[1,]) devS1 = mod(S1toRadian - rev(PNS$orthaxis)[[1]] + pi, 2 * pi) - pi Res[kk - 1,] = devS1 EuclidData = flipud0(repmat(PNS$radii, 1, n) * Res) return(EuclidData) } #================================================================================== randvonMisesFisherm = function(m, n, kappa, mu = NULL) { if (is.null(mu)) { muflag = FALSE } else { muflag = TRUE } if (m < 2) { print("Message from randvonMisesFisherm(): dimension m must be > 2") print("Message from randvonMisesFisherm(): Set m to be 2") m = 2 } if (kappa < 0) { print("Message from randvonMisesFisherm(): kappa must be >= 0") print("Message from randvonMisesFisherm(): Set kappa to be 0") kappa = 0 } b = (-2 * kappa + sqrt(4 * kappa ^ 2 + (m - 1) ^ 2)) / (m - 1) x0 = (1 - b) / (1 + b) c = kappa * x0 + (m - 1) * log(1 - x0 ^ 2) nnow = n w = c() while (TRUE) { ntrial = max(round(nnow * 1.2), nnow + 10) Z = rbeta(n = ntrial, shape1 = (m - 1) / 2, shape2 = (m - 1) / 2) U = runif(ntrial) W = (1 - (1 + b) * Z) / (1 - (1 - b) * Z) indicator = kappa * W + (m - 1) * log(1 - x0 * W) - c >= log(U) if (sum(indicator) >= nnow) { w1 = W[indicator] w = c(w, w1[1:nnow]) break } else { w = c(w, W[indicator]) nnow = nnow - sum(indicator) } } V = UNIFORMdirections(m - 1, n) X = rbind(repmat(sqrt(1 - matrix(w, nrow = 1) ^ 2), m - 1, 1) * V, matrix(w, nrow = 1)) if (muflag) { mu = mu / norm(mu, "2") X = t(rotMat(mu)) %*% X } return(X) } #================================================================================== UNIFORMdirections = function(m, n) { V = matrix(0, m, n) nr = matrix(rnorm(m * n), nrow = m) for (i in 1:n) { while (TRUE) { ni = sum(nr[, i] ^ 2) if (ni < 1e-10) { nr[, i] = rnorm(m) } else { V[, i] = nr[, i] / sqrt(ni) break } } } return(V) } #================================================================================== trans.subsphere = function(x, center) { return(repmat(1 / sqrt(1 - (t( center ) %*% x) ^ 2), length(center) - 1, 1) * (rotMat(center)[-length(center),] %*% x)) } #================================================================================== get.prinarc.value = function(PNS, arc, res) { d = length(PNS$orthaxis) n = length(res) prinarc = matrix(NA, d + 1, n) for (g in 1:n) { newres = matrix(0, d, 1) newres[arc] = res[g] T = PNSe2s(newres, PNS) prinarc[, g] = T } return(prinarc) } #================================================================================== get.prinarc = function(resmat, PNS, arc, n, boundary.data = FALSE) { d = nrow(resmat) if (boundary.data) { mn = min(resmat[arc,]) mx = max(resmat[arc,]) } else { mn = -pi * tail(PNS$radii, arc)[1] mx = pi * tail(PNS$radii, arc)[1] } prinarcgrid = seq(mn, mx, length = n) prinarc = matrix(NA, d + 1, n) for (g in 1:n) { newres = matrix(0, d, 1) newres[arc] = prinarcgrid[g] T = PNSe2s(newres, PNS) prinarc[, g] = T } return(prinarc) } #================================================================================== get.prinarc.subsphere = function(resmat, PNS, arc, n, subsphere = arc, boundary.data = FALSE) { if (subsphere < arc) { stop("Error: subsphere >= arc.") } if (subsphere < 1) { stop("Error: subsphere >= 1.") } prinarc = get.prinarc( resmat = resmat, PNS = PNS, arc = arc, n = n, boundary.data = boundary.data ) d = nrow(resmat) prinarc.sub = prinarc if (subsphere < d) { for (i in 1:(d - subsphere)) { prinarc.sub = trans.subsphere(x = prinarc.sub, center = PNS$orthaxis[[i]]) } } return(prinarc.sub) } #================================================================================== get.data.subsphere = function(resmat, PNS, x, subsphere) { if (subsphere < 1) { stop("Error: subsphere >= 1.") } d = nrow(resmat) x.sub = x if (subsphere < d) { for (i in 1:(d - subsphere)) { x.sub = trans.subsphere(x = x.sub, center = PNS$orthaxis[[i]]) } } return(x.sub) } #================================================================================== mod = function(x, y) { return(x %% y) } #================================================================================== repmat = function(x, m, n) { return(kronecker(matrix(1, m, n), x)) } #================================================================================== flipud0 = function(x) { return(apply(x, 2, rev)) } #================================================================================== sphere.obj = function(center, x, is.greatCircle) { di = sqrt(apply((x - repmat( matrix(center, ncol = 1), 1, ncol(x) )) ^ 2, 2, sum)) if (is.greatCircle) { r = pi / 2 } else { r = mean(di) } sum((di - r) ^ 2) } #================================================================================== sphere.res = function(center, x, is.greatCircle) { center = c(center) xmc = x - center di = sqrt(apply(xmc ^ 2, 2, sum)) if (is.greatCircle) { r = pi / 2 } else { r = mean(di) } (di - r) } #================================================================================== sphere.jac = function(center, x, is.greatCircle) { center = c(center) xmc = x - center di = sqrt(apply(xmc ^ 2, 2, sum)) di.vj = -xmc / repmat(matrix(di, nrow = 1), length(center), 1) if (is.greatCircle) { c(t(di.vj)) } else { r.vj = apply(di.vj, 1, mean) c(t(di.vj - repmat(matrix(r.vj, ncol = 1), 1, ncol(x)))) } } #================================================================================== sphereFit = function(x, initialCenter = NULL, geodesic = "small") { if (is.null(initialCenter)) { initialCenter = apply(x, 1, mean) } op = nls.lm( par = initialCenter, fn = sphere.res, jac = sphere.jac, x = x, is.greatCircle = ifelse(geodesic == "great", TRUE, FALSE), control = nls.lm.control(maxiter = 1000) ) center = coef(op) di = sqrt(apply((x - repmat( matrix(center, ncol = 1), 1, ncol(x) )) ^ 2, 2, sum)) if (geodesic == "great") { r = pi / 2 } else { r = mean(di) } list(center = center, r = r) } #================================================================================== tr = function(x) { return(sum(diag(x))) } #================================================================================== Enormalize = function(x) { return(x / Enorm(x)) } #================================================================================== sphere2pcscore = function(x) { n = nrow(x) p = ncol(x) scores = matrix(NA, n, p - 1) for (i in 1:n) { size = acos(x[i, 1]) scores[i,] = (size / sin(size)) * x[i, 2:p] } return(scores) } #================================================================================== pcscore2sphere = function(n.pc, X.hat, S, Tan, V) { d = nrow(Tan) n = ncol(Tan) W = matrix(NA, d, n) for (i in 1:n) { W[, i] = acos(tr(S[, , i] %*% t(X.hat))) * Tan[, i] / sqrt(sum(Tan[, i] ^ 2)) } lambda = matrix(NA, n, d) for (i in 1:n) { for (j in 1:d) { lambda[i, j] = sum(W[, i] * V[, j]) } } U = matrix(0, n, d) for (i in 1:n) { for (j in 1:n.pc) { U[i,] = U[i,] + lambda[i, j] * V[, j] } } S.star = matrix(NA, n, n.pc + 1) for (i in 1:n) { U.norm = sqrt(sum(U[i,] ^ 2)) S.star[i,] = c(cos(U.norm), sin(U.norm) / U.norm * lambda[i, 1:n.pc]) } return(S.star) } pcscore2sphere2 = function(n.pc, X.hat, S, Tan, V) { d = nrow(Tan) n = ncol(Tan) W = matrix(NA, d, n) if (n.pc > min(d,n) ) { stop("Error: n.pc must be <= min(n,d)") } for (i in 1:n) { W[, i] = acos(tr(S[, , i] %*% t(X.hat))) * Tan[, i] / sqrt(sum(Tan[, i] ^ 2)) } lambda = matrix(NA, n, d) for (i in 1:n) { for (j in 1:n.pc) { lambda[i, j] = sum(W[, i] * V[, j]) } } U = matrix(0, n, d) for (i in 1:n) { for (j in 1:n.pc) { U[i,] = U[i,] + lambda[i, j] * V[, j] } } S.star = matrix(NA, n, n.pc + 1) for (i in 1:n) { U.norm = sqrt(sum(U[i,] ^ 2)) S.star[i,] = c(cos(U.norm), sin(U.norm) / U.norm * lambda[i, 1:n.pc]) } return(S.star) } #================================================================================== pc2sphere = function(x, n.pc) { k = dim(x)[1] m = dim(x)[2] n = dim(x)[3] if (n.pc < ((k - 1) * m)) { stop("Error: n.pc must be >= (k - 1) * m.") } GPAout = procGPA( x = x, scale = TRUE, reflect = FALSE, tangentcoords = "partial", distances = FALSE ) cat( "First ", n.pc, " principal components explain ", round(sum(GPAout$percent[1:n.pc])), "% of total variance. \n", sep = "" ) H = defh(k - 1) X.hat = H %*% GPAout$mshape S = array(NA, c(k - 1, m, n)) for (i in 1:n) { S[, , i] = H %*% GPAout$rotated[, , i] } T.c = GPAout$tan - apply(GPAout$tan, 1, mean) out = pcscore2sphere( n.pc = n.pc, X.hat = X.hat, S = S, Tan = T.c, V = GPAout$pcar ) return(list(spheredata = out, GPAout = GPAout)) } #================================================================================== rot.mat = function(Y, X, reflect = FALSE, center = TRUE) { svd.out = svd(t(X) %*% Y) R = svd.out$u %*% t(svd.out$v) if (!reflect) { if (det(R) < 0) { u = svd.out$u v = svd.out$v if (det(u) < 0) { u[, dim(u)[2]] = -u[, dim(u)[2]] } else if (det(v) < 0) { v[, dim(v)[2]] = -v[, dim(v)[2]] } R = u %*% t(v) } } return(R) } #================================================================================== Procrustes.dist.full = function(x1, x2) { m = ncol(x1) z1 = preshape(x1) z2 = preshape(x2) Q = t(z1) %*% z2 %*% t(z2) %*% z1 ev = eigen(Q)$values sign = ifelse(det(t(z1) %*% z2) >= 0, 1,-1) dF = sqrt(abs(1 - sum(sqrt(abs( ev[1:(m - 1)] )), sign * sqrt(abs( ev[m] ))) ^ 2)) R = rot.mat( Y = z2, X = z1, reflect = FALSE, center = FALSE ) scale = sum(svd(t(z1) %*% z2)$d) return(list(dF = dF, R = R, scale = scale)) } #================================================================================== tangent.coords.partial = function(x, p) { k = nrow(x) m = ncol(x) if (abs(norm(p, "F") - 1) > 1e-15) { print("||p|| is not 1. Normalised one is used.") p = Enormalize(p) } tmp = Procrustes.dist.full(x, p) R = tmp$R scale = tmp$scale pre.p = preshape(p) pre.x = preshape(x) ident = diag(k * m - m) tan = (ident - matrix(pre.p) %*% t(c(pre.p))) %*% c(pre.x %*% R) tan.scale = (ident - matrix(pre.p) %*% t(c(pre.p))) %*% c(pre.x %*% R * scale) return(list( tan = c(tan), tan.scale = c(tan.scale), R = R, scale = scale )) } #================================================================================== shape.pcscores = function(PCAout, x, tangentcoords = "partial") { if (tangentcoords == "partial") { if (abs(norm(PCAout$mshape, "F") - 1) > 1e-15) { print("||PCAout$mshape|| is not 1. Normalised one is used.") mshape = Enormalize(PCAout$mshape) } else { mshape = PCAout$mshape } if (abs(norm(x, "F") - 1) > 1e-15) { print("||x|| is not 1. Normalised one is used.") x = Enormalize(x) } opa.out = procOPA(mshape, x, scale = FALSE) matched = opa.out$Bhat tan.out = tangent.coords.partial(matched, mshape) mean.tan = apply(PCAout$tan, 1, mean) scores = t(tan.out$tan - mean.tan) %*% PCAout$pcar scores.scale = t(tan.out$tan.scale - mean.tan) %*% PCAout$pcar return( list( rotated = matched, tan = tan.out$tan, tan.scale = tan.out$tan.scale, scores = c(scores), scores.scale = c(scores.scale) ) ) } } #================================================================================== shape.pcscores.partial = function(PCAout, x) { n = dim(x)[3] scores = c() for (i in 1:n) { s = shape.pcscores(PCAout, x[, , i], tangentcoords = "partial") scores = rbind(scores, s$scores) } return(scores) } #================================================================================== plotshapes3d.pns = function(x, type = "p", col = "black", size = 5, aspect = "iso", joinline = TRUE, col.joinline = "#d4d2d2", lwd.joinline = 0.5, tick = FALSE, labels.tick = FALSE, xlab = "", ylab = "", zlab = "") { k = dim(x)[1] n = dim(x)[3] aa = c() bb = c() cc = c() for (i in 1:n) { aa = c(aa, x[, 1, i]) bb = c(bb, x[, 2, i]) cc = c(cc, x[, 3, i]) } xlim = range(aa) ylim = range(bb) zlim = range(cc) plot3d( x[, , 1], type = "n", xlab = "", ylab = "", zlab = "", box = FALSE, axes = FALSE, aspect = aspect, xlim = xlim, ylim = ylim, zlim = zlim ) for (i in 1:n) { plot3d( x[, , i], type = type, col = col, size = size, add = TRUE ) } if (tick) { axis3d( edge = 'x', labels = labels.tick, tick = TRUE, pos = c(NA, 0, 0), cex = 0.6, lwd = 0.5 ) axis3d( edge = 'y', labels = labels.tick, tick = TRUE, pos = c(0, NA, 0), cex = 0.6, lwd = 0.5 ) axis3d( edge = 'z', labels = labels.tick, tick = TRUE, pos = c(0, 0, NA), cex = 0.6, lwd = 0.5 ) } else { } r = cbind(xlim, ylim, zlim) pos = r[2,] + apply(r, 2, diff) / 20 text3d(pos[1], 0, 0, texts = xlab, cex = 0.8) text3d(0, pos[2], 0, texts = ylab, cex = 0.8) text3d(0, 0, pos[3], texts = zlab, cex = 0.8) if (joinline) { for (i in 1:n) { lines3d(x[, , i], col = col.joinline, lwd = lwd.joinline) } } } #================================================================================== Plot3D = function(x, type = "s", col = "black", size = 1.2, aspect = "iso", joinline = FALSE, col.joinline = "#d4d2d2", lwd.joinline = 0.5, tick = TRUE, tick.boundary = FALSE, labels.tick = TRUE, xlab = "", ylab = "", zlab = "") { n = nrow(x) plot3d( x, type = "n", xlab = "", ylab = "", zlab = "", box = FALSE, axes = FALSE, aspect = aspect ) plot3d( x, type = type, col = col, size = size, add = TRUE ) if (tick) { axis3d( edge = 'x', labels = labels.tick, tick = TRUE, pos = c(NA, 0, 0), cex = 0.6, lwd = 0.5 ) axis3d( edge = 'y', labels = labels.tick, tick = TRUE, pos = c(0, NA, 0), cex = 0.6, lwd = 0.5 ) axis3d( edge = 'z', labels = labels.tick, tick = TRUE, pos = c(0, 0, NA), cex = 0.6, lwd = 0.5 ) } if (tick.boundary) { tks = pretty(x[, 1], n = 10) axis3d( edge = 'x', labels = labels.tick, tick = TRUE, at = c(tks[1], tks[length(tks)]), pos = c(NA, 0, 0), cex = 0.6, lwd = 0.5 ) tks = pretty(x[, 2], n = 10) axis3d( edge = 'y', labels = labels.tick, tick = TRUE, at = c(tks[1], tks[length(tks)]), pos = c(0, NA, 0), cex = 0.6, lwd = 0.5 ) tks = pretty(x[, 3], n = 10) axis3d( edge = 'z', labels = labels.tick, tick = TRUE, at = c(tks[1], tks[length(tks)]), pos = c(0, 0, NA), cex = 0.6, lwd = 0.5 ) } r = apply(x, 2, range) pos = r[2,] + apply(r, 2, diff) / 20 text3d(pos[1], 0, 0, texts = xlab, cex = 0.8) text3d(0, pos[2], 0, texts = ylab, cex = 0.8) text3d(0, 0, pos[3], texts = zlab, cex = 0.8) if (joinline) { lines3d(x, col = col.joinline, lwd = lwd.joinline) } } #================================================================================== col2RGB = function(col, alpha = 255) { n = length(col) out = c() for (i in 1:n) { out[i] = rgb( red = col2rgb(col[i])[1], green = col2rgb(col[i])[2], blue = col2rgb(col[i])[3], alpha = alpha, maxColorValue = 255 ) } return(out) } #================================================================================== project.subsphere = function(x, center, r) { n = ncol(x) d = nrow(x) x.proj = matrix(NA, d, n) for (i in 1:n) { rho = acos(sum(x[, i] * center)) x.proj[, i] = (sin(r) * x[, i] + sin(rho - r) * center) / sin(rho) } return(x.proj) } ##############################################################end of PNS########### ##### Penalised Euclidean Distance Regression #================================================================================== ped <- function(X, Y, method = c("AIC")) { if (method == "AIC") { aicmin <- 999999999 for (lam in c(0.2, 0.5, 1.0)) { for (cofp in c(0.75, 1, 1.35, 1.5)) { out <- pedreg( X, Y, nlambda = 1, constc0 = 1.1, constc1 = cofp, lambdainit = lam ) if (out$aic < aicmin) { minout <- out mincofp <- cofp aicmin <- out$aic } } } out <- minout } if (method == "BIC") { bicmin <- 999999999 for (lam in c(0.2, 0.5, 1.0)) { for (cofp in c(0.75, 1, 1.35, 1.5)) { out <- pedreg( X, Y, nlambda = 1, constc0 = 1.1, constc1 = cofp, lambdainit = lam ) if (out$bic < bicmin) { minout <- out mincofp <- cofp bicmin <- out$bic } } } out <- minout } if (method == "khat") { aicmin <- 999999999 for (lam in c(0.2, 0.5, 1.0)) { for (cofp in c(0.75, 1, 1.25, 1.5)) { out <- pedreg( X, Y, nlambda = 1, constc0 = 1.1, constc1 = cofp, lambdainit = lam ) if (-out$khat < aicmin) { minout <- out mincofp <- cofp aicmin <- -out$khat } } } out <- minout } if (method == "CV") { n <- length(Y) cvmin <- 999999999 for (lam in c(0.2, 0.5, 1.0)) { for (cofp in c(0.75, 1, 1.25, 1.5)) { cverr <- 0 for (jj in 1:10) { subsample <- ((jj - 1) * 10 + 1):((jj - 1) * 10 + 10) out <- pedreg( X[-subsample, ], Y[-subsample], nlambda = 1, constc0 = 1.1, constc1 = cofp, lambdainit = lam ) cverr <- cverr + Enorm(Y[subsample] - out$intercept - X[subsample, ] %*% out$betahat) ** 2 } if (cverr < cvmin) { minout <- out minlam <- lam mincofp <- cofp cvmin <- cverr } } } out <- pedreg( X, Y, nlambda = 1, constc0 = 1.1, constc1 = mincofp, lambdainit = minlam ) } out1 <- list( betahat = 0, yhat = 0, lambda = 0, coef = 0, resid = 0 ) out1$intercept <- out$intercept out1$coef <- c(out$intercept, out$betahat) out1$betahat <- out$betahat out1$lambda <- out$lambda out1$delta <- mincofp out1$yhat <- out$yhat out1$resid <- Y - out$yhat out1 } ###########################function for PED##################### #================================================================================== pedreg <- function(X, Y, constc0 = 1.1, constc1 = 1.35, alpha = 0.05, LMM = 50, MIT = 10000, NUM_METHOD = 1, nlambda = 1, lambdamax = 1, PLOT = TRUE, BIC = FALSE, lambdainit = 1) { # NUM_METHOD = 1 = L-BFGS-B # LMM = Parameter M in L-BFGS method 1 # MIT = Max iterations for optimization p <- dim(X)[2] n <- dim(X)[1] constc <- constc0 Ymean <- mean(Y) Ysd <- sd(Y) Yinit <- Y pinit <- p ans0 <- rep(0, times = pinit) Xorig <- X Yorig <- Y vm <- rep(0, times = ncol(X)) vsd <- rep(0, times = ncol(X)) for (i in 1:ncol(X)) { vm[i] <- mean(X[, i]) } for (i in 1:ncol(X)) { vsd[i] <- sd(X[, i]) } #standardize to sphere X <- scale(X) / sqrt(n - 1) Y <- scale(Y) / sqrt(n - 1) X0 <- X Y0 <- Y lambdainit1 <- constc / sqrt(n - 1) * sqrt(sqrt(p)) / n * qnorm(1 - alpha / (2 * p)) if (nlambda == 1) { lambdainit1 <- lambdainit } METHOD1 <- "L-BFGS-B" xi <- -9999999 c1 <- 1 nlam <- nlambda betamat <- matrix(0, p, nlam) betamat.sparse <- betamat lambdamat <- rep(0, times = nlam) ximat <- rep(0, times = nlam) aic <- rep(0, times = nlam) bic <- rep(0, times = nlam) npar <- rep(0, times = nlam) selectmat <- betamat #cat(c("Lambda iteration (out of ",nlam,"):")) for (ilam in (nlam:1)) { #cat(c(ilam," ")) if (nlam == 1) { lambda <- lambdainit1 } if (nlam > 1) { c1 <- sqrt(n) + (ilam - 1) / (nlam - 1) * 1 / lambdainit1 c1 <- sqrt(n) + ((ilam - 1) / (nlam - 1)) * 1 / lambdainit1 * (lambdamax - lambdainit1 * sqrt(n)) lambda <- lambdainit1 * c1 } if (ilam == nlam) { x0 <- rep(1 / sqrt(p), times = p) } if (ilam != nlam) { x0 <- betahat + rnorm(p) / sqrt(p) } #x0<-rnorm(p)/sqrt(p) pedfun <- function(pars, Y = 0, X = 0) { p <- length(pars) pars <- matrix(pars, p, 1) ped <- Enorm(Y - X %*% pars) + lambda * sqrt(Enorm(pars) * sum(abs(pars))) ped } pedgrad <- function(pars, X = 0, Y = 0) { GM <- sqrt(Enorm(pars) * sum(abs(pars))) gradL <- rep(0, times = p) gradL <- -t(X) %*% (Y - X %*% pars) / Enorm(Y - X %*% pars) gradL <- gradL + matrix( lambda / 2 * pars / Enorm(pars) * sum(abs(pars)) / GM + lambda / 2 * sign(pars) * Enorm(pars) / GM , p, 1 ) c(gradL) } if (NUM_METHOD == 1) { repeat { #,ndeps=1e-3,factr=1e-5,pgtol=1e-5 res2 <- optim( par = x0, fn = pedfun, gr = pedgrad, method = METHOD1, control = list(lmm = LMM, maxit = MIT), X = X, Y = Y ) betahat <- res2$par if (res2$convergence == 0) { break } x0 <- rnorm(p) / sqrt(p) } } oldxi <- xi xi <- sqrt(Enorm(betahat) / sum(abs(betahat))) - sqrt(n) / (constc * c1 * p ^ (1 / 4)) dif <- (xi - oldxi) REGC <- 0.0001 betamat[, ilam] <- betahat / (Enorm(betahat) + REGC) lambdamat[ilam] <- lambda ximat[ilam] <- xi ximat[ilam] <- sqrt(Enorm(betahat) / sum(abs(betahat))) MM <- constc1 / (sqrt(n)) select <- (abs(betahat) / (Enorm(betahat) + REGC) > MM) selectmat[, ilam] <- select betamat.sparse[, ilam] <- betamat[, ilam] betamat.sparse[select == FALSE, ilam] <- 0 * betamat[select == FALSE, ilam] pp <- sum(select) npar[ilam] <- pp bic[ilam] <- log(Enorm(Y) ** 2 / n) * (n) + log(n) * (1) aic[ilam] <- log(Enorm(Y) ** 2 / n) * (n) + 2 * (1) if (sum(select) > 0) { aa <- lm(Y ~ X[, c(1:p)[select]] - 1) pred <- predict(aa) # Use AIC with finite sample correction aic[ilam] <- log(Enorm(Y - pred) ** 2 / n) * (n) + 2 * (pp + 1) + 2 * (pp + 1) * (pp + 2) / (n - pp - 2) # Use AIC/BIC bic[ilam] <- log(Enorm(Y - pred) ** 2 / n) * (n) + log(n) * (pp + 1) aic[ilam] <- log(Enorm(Y - pred) ** 2 / n) * (n) + 2 * (pp + 1) } } best <- 1 if (nlam > 1) { ###########################################choose best via AIC best <- c(1:nlam)[aic == min(aic)][1] select <- as.logical(selectmat[, best]) lambdaaic <- lambdamat[best] ###########################################choose best via Corollary 1 with khat best2 <- nlam if ((sum(ximat > 0.25)) > 0) { best2 <- c(1:nlam)[(ximat) > 0.25][1] } #################### biggest xi from Corollary 1 xism <- (ximat) if (sum(diff(xism) < 0.01) > 0) { best2 <- c(2:nlam)[diff(xism) < 0.01][1] - 1 } ############## biggest sqrt( Enorm(beta) / norm(beta)_1 ) best2 <- c(1:nlam)[ximat == max(ximat)] selectcor <- as.logical(selectmat[, best2]) lambdacor1 <- lambdamat[best2] if (BIC == FALSE) { best <- best2 select <- selectcor } } ################last part######estimate with reduced p########### if (sum(select) > 0) { X <- as.matrix(X[, select]) p <- sum(select) p14 <- sqrt(sqrt(p)) final <- c(1:pinit)[select] } ####### lambda <- constc / sqrt(sqrt(p)) / sqrt(n) * qnorm(1 - alpha / (2 * p)) if (sum(select) > 0) { x0 <- rep(1 / p, times = p) if (NUM_METHOD == 1) { repeat { res2 <- optim( par = x0, fn = pedfun, gr = pedgrad, method = METHOD1, control = list(lmm = LMM, maxit = MIT), X = X, Y = Y ) betahat <- res2$par if (res2$convergence == 0) { break } x0 <- rnorm(p) / p } } ans0[final] <- betahat } #ind<-which(abs(ans0/Enorm(ans0))<10^(-5)) #ans0[ind]<-0 out <- list(betahat = 0, yhat = 0, lambda = 0) out$betahatscale <- ans0 out$yhatscale <- c(X0 %*% ans0) if (nlam > 1) { out$lambdacor1 <- lambdacor1 out$lambdaaic <- lambdaaic out$betamat.sparse <- betamat.sparse out$betamat.rescale <- betamat out$betamat <- betamat for (i in 1:nlam) { out$betamat.rescale[, i] <- c(out$betamat[, i] / vsd) * sd(Yorig) } out$lambdamat <- lambdamat out$ximat <- ximat out$MM <- MM out$fmax <- res2$value out$npar <- npar out$selectmat <- selectmat } #use AIC out$aic <- aic #use BIC out$bic <- bic #use khat out$khat <- ximat out$lambdath3 <- lambdainit1 * sqrt(n) out$lambda <- out$lambdacor1 if (BIC == TRUE) { out$lambda <- out$lambdaaic } if (nlam == 1) { out$lambda <- lambdainit1 out$constc1 <- constc1 } sol <- sd(Yorig) * c(ans0 / vsd) inter <- drop(mean(Yorig) - sd(Yorig) * (vm / vsd) %*% ans0) out$intercept <- drop(mean(Yorig) - sd(Yorig) * (vm / vsd) %*% ans0) out$betahat <- sd(Yorig) * c(ans0 / vsd) out$best <- best out$Yinit <- Yinit out$yhat <- Xorig %*% sol + inter out } ############################################################ # # FUNCTIONS FOR CALCULATING NON-EUCLIDEAN MEANS AND DISTANCES # OF COVARIANCE MATRICES # ############################################################ # Log Euclidean mean: Sigma_L #================================================================================== estLogEuclid <- function(S, weights = 1) { M <- dim(S)[3] if (length(weights) == 1) { weights <- rep(1, times = M) } sum <- S[, , 1] * 0 for (j in 1:M) { eS <- eigen(S[, , j], symmetric = TRUE) sum <- sum + weights[j] * eS$vectors %*% diag(log(eS$values)) %*% t(eS$vectors) / sum(weights) } ans <- sum eL <- eigen(ans, symmetric = TRUE) eL$vectors %*% diag(exp(eL$values)) %*% t(eL$vectors) } #================================================================================== estPowerEuclid <- function(S, weights = 1, alpha = 0.5) { M <- dim(S)[3] if (length(weights) == 1) { weights <- rep(1, times = M) } sum <- S[, , 1] * 0 for (j in 1:M) { eS <- eigen(S[, , j], symmetric = TRUE) sum <- sum + weights[j] * eS$vectors %*% diag(abs(eS$values) ** alpha) %*% t(eS$vectors) / sum(weights) } ans <- sum eL <- eigen(ans, symmetric = TRUE) eL$vectors %*% diag(abs(eL$values) ** (1 / alpha)) %*% t(eL$vectors) } # Riemannian (weighted mean) : Sigma_R #================================================================================== estLogRiem2 <- function(S, weights = 1) { M <- dim(S)[3] if (length(weights) == 1) { weights <- rep(1, times = M) } check <- 9 tau <- 1 Hold <- 99999 mu <- estLogEuclid(S, weights) while (check > 0.0000000001) { ev <- eigen(mu, symmetric = TRUE) logmu <- ev$vectors %*% diag(log(ev$values)) %*% t(ev$vectors) Hnew <- Re(Hessian2(S, mu, weights)) logmunew <- logmu + tau * Hnew ev <- eigen(logmunew, symmetric = TRUE) mu <- ev$vectors %*% diag(exp(ev$values)) %*% t(ev$vectors) check <- Re(Enorm(Hold) - Enorm(Hnew)) if (check < 0) { tau <- tau / 2 check <- 999999 } Hold <- Hnew } mu } # Hessian used in calculating Sigma_R #================================================================================== Hessian2 <- function(S, Sigma, weights = 1) { M <- dim(S)[3] k <- dim(S)[1] if (length(weights) == 1) { weights <- rep(1, times = M) } ev0 <- eigen(Sigma, symmetric = TRUE) shalf <- ev0$vectors %*% (diag(sqrt((ev0$values)))) %*% t(ev0$vectors) sumit <- matrix(0, k, k) for (i in 1:(M)) { ev2 <- eigen(shalf %*% solve(S[, , i]) %*% shalf, symmetric = TRUE) sumit <- sumit + weights[i] * ev2$vectors %*% diag (log((ev2$values))) %*% t(ev2$vectors) / sum(weights) } - sumit } # Euclidean : Sigma_E #================================================================================== estEuclid <- function(S, weights = 1) { M <- dim(S)[3] if (length(weights) == 1) { weights <- rep(1, times = M) } sum <- S[, , 1] * 0 for (j in 1:M) { sum <- sum + S[, , j] * weights[j] / sum(weights) } sum } # Cholesky mean : Sigma_C #================================================================================== estCholesky <- function(S, weights = 1) { M <- dim(S)[3] if (length(weights) == 1) { weights <- rep(1, times = M) } sum <- S[, , 1] * 0 for (j in 1:M) { sum <- sum + t(chol(S[, , j])) * weights[j] / sum(weights) } cc <- sum cc %*% t(cc) } #================================================================================== ild_estSS <- function(S, weights = 1) { M <- dim(S)[3] k <- dim(S)[1] H <- defh(k) if (length(weights) == 1) { weights <- rep(1, times = M) } Q <- array(0, c(k + 1, k, M)) for (j in 1:M) { Q[, , j] <- t(H) %*% (rootmat(S[, , j])) } ans <- procWGPA( Q, fixcovmatrix = diag(k + 1), scale = FALSE, reflect = TRUE, sampleweights = weights ) H %*% ans$mshape %*% t(H %*% ans$mshape) } #================================================================================== ild_estShape <- function(S, weights = 1) { M <- dim(S)[3] k <- dim(S)[1] H <- defh(k) if (length(weights) == 1) { weights <- rep(1, times = M) } Q <- array(0, c(k + 1, k, M)) for (j in 1:M) { Q[, , j] <- t(H) %*% (rootmat(S[, , j])) } ans <- procWGPA( Q, fixcovmatrix = diag(k + 1), scale = TRUE, reflect = TRUE, sampleweights = weights ) H %*% ans$mshape %*% t(H %*% ans$mshape) } #================================================================================== estRiemLe <- function(S, weights) { M <- dim(S)[3] k <- dim(S)[1] if (M != 2) print("Sorry - Calculation not implemented for M>2 yet") if (M == 2) { P1 <- S[, , 1] P2 <- S[, , 2] detP1 <- prod(eigen(P1)$values) detP2 <- prod(eigen(P2)$values) P1 <- P1 / (detP1) ^ (1 / k) P2 <- P2 / (detP2) ^ (1 / k) P1inv <- solve(P1) P12sq <- P1inv %*% P2 %*% P2 %*% P1inv tem <- eigen(P12sq, symmetric = TRUE) A2 <- tem$vectors %*% diag(log(tem$values)) %*% t(tem$vectors) logPs2 <- weights[2] * A2 tem2 <- eigen(logPs2, symmetric = TRUE) Ps2 <- tem2$vectors %*% diag(exp(tem2$values)) %*% t(tem2$vectors) P12s <- P1 %*% Ps2 %*% P1 tem3 <- eigen(P12s, symmetric = TRUE) P12sA <- tem3$vectors %*% diag(sqrt(tem3$values)) %*% t(tem3$vectors) Ptildes <- (detP1 * (detP2 / detP1) ^ weights[2]) ^ (1 / k) * P12sA Ptildes } } ##########distances################################# #================================================================================== distRiemPennec <- function(P1, P2) { eig <- eigen(P1, symmetric = TRUE) P1half <- eig$vectors %*% diag(sqrt(eig$values)) %*% t(eig$vectors) P1halfinv <- solve(P1half) AA <- P1halfinv %*% P2 %*% P1halfinv tem <- eigen(AA, symmetric = TRUE) A2 <- tem$vectors %*% diag(log(tem$values)) %*% t(tem$vectors) dd <- Enorm(A2) dd } #================================================================================== distLogEuclidean <- function(P1, P2) { eig <- eigen(P1, symmetric = TRUE) logP1 <- eig$vectors %*% diag(log(eig$values)) %*% t(eig$vectors) tem <- eigen(P2, symmetric = TRUE) logP2 <- tem$vectors %*% diag(log(tem$values)) %*% t(tem$vectors) dd <- Enorm(logP1 - logP2) dd } #================================================================================== distRiemannianLe <- function(P1, P2) { dd <- distRiemPennec(P1 %*% t(P1), P2 %*% t(P2)) / 2 dd } #================================================================================== ild_distProcrustesSizeShape <- function (P1, P2) { H <- defh(dim(P1)[1]) Q1 <- t(H) %*% rootmat(P1) Q2 <- t(H) %*% rootmat(P2) ans <- sqrt( centroid.size(Q1) ^ 2 + centroid.size(Q2) ^ 2 - 2 * centroid.size(Q1) * centroid.size(Q2) * cos(riemdist(Q1, Q2, reflect = TRUE)) ) ans } #================================================================================== ild_distProcrustesFull <- function(P1, P2) { H <- defh(dim(P1)[1]) Q1 <- t(H) %*% rootmat(P1) Q2 <- t(H) %*% rootmat(P2) ans <- riemdist(Q1, Q2, reflect = TRUE) ans } #================================================================================== distPowerEuclidean <- function(P1, P2, alpha = 1 / 2) { if (alpha != 0) { eS <- eigen(P1, symmetric = TRUE) Q1 <- eS$vectors %*% diag(abs(eS$values) ^ alpha) %*% t(eS$vectors) eS <- eigen(P2, symmetric = TRUE) Q2 <- eS$vectors %*% diag(abs(eS$values) ^ alpha) %*% t(eS$vectors) dd <- Enorm(Q1 - Q2) / abs(alpha) } if (alpha == 0) { dd <- distLogEuclidean(P1, P2) } dd } #================================================================================== ild_distCholesky <- function(P1, P2) { H <- defh(dim(P1)[1]) Q1 <- t(H) %*% t(chol(P1)) Q2 <- t(H) %*% t(chol(P2)) ans <- Enorm(Q1 - Q2) ans } #================================================================================== distEuclidean <- function(P1, P2) { ans <- Enorm(P1 - P2) ans } ################## #================================================================================== distcov <- function(S1, S2 , method = "Riemannian", alpha = 1 / 2) { if (method == "Procrustes") { dd <- distProcrustesSizeShape(S1, S2) } if (method == "ProcrustesShape") { dd <- distProcrustesFull(S1, S2) } if (method == "Riemannian") { dd <- distRiemPennec(S1, S2) } if (method == "Cholesky") { dd <- distCholesky(S1, S2) } if (method == "Power") { dd <- distPowerEuclidean(S1, S2, alpha) } if (method == "Euclidean") { dd <- distEuclidean(S1, S2) } if (method == "LogEuclidean") { dd <- distLogEuclidean(S1, S2) } if (method == "RiemannianLe") { dd <- distRiemannianLe(S1, S2) } dd } #================================================================================== estcov <- function (S, method = "Riemannian", weights = 1, alpha = 1 / 2, MDSk = 2) { out <- list( mean = 0, sd = 0, pco = 0, eig = 0, dist = 0 ) M <- dim(S)[3] if (length(weights) == 1) { weights <- rep(1, times = M) } if (method == "Procrustes") { dd <- estSS(S, weights) } if (method == "ProcrustesShape") { dd <- estShape(S, weights) } if (method == "Riemannian") { dd <- estLogRiem2(S, weights) } if (method == "Cholesky") { dd <- estCholesky(S, weights) } if (method == "Power") { dd <- estPowerEuclid(S, weights, alpha) } if (method == "Euclidean") { dd <- estEuclid(S, weights) } if (method == "LogEuclidean") { dd <- estLogEuclid(S, weights) } if (method == "RiemannianLe") { dd <- estRiemLe(S, weights) } out$mean <- dd sum <- 0 for (i in 1:M) { sum <- sum + weights[i] * distcov(S[, , i], dd, method = method) ^ 2 / sum(weights) } out$sd <- sqrt(sum) dist <- matrix(0, M, M) for (i in 2:M) { for (j in 1:(i - 1)) { dist[i, j] <- distcov(S[, , i], S[, , j], method = method) dist[j, i] <- dist[i, j] } } out$dist <- dist if (M > MDSk) { ans <- cmdscale( dist, k = MDSk, eig = TRUE, add = TRUE, x.ret = TRUE ) out$pco <- ans$points out$eig <- ans$eig if (MDSk > 2) { shapes3d(out$pco[, 1:min(MDSk, 3)], axes3 = TRUE) } if (MDSk == 2) { plot(out$pco, type = "n", xlab = "MDS1", ylab = "MDS2") text(out$pco[, 1], out$pco[, 2], 1:length(out$pco[, 1])) } } out } rootmat <- function(P1) { eS <- eigen(P1, symmetric = TRUE) if (min(eS$values) < -0.001) { print("Not positive-semi definite") } else{ Q1 <- eS$vectors %*% diag(sqrt(abs(eS$values))) %*% t(eS$vectors) Q1 } } ########################## #================================================================================== shapes.cva <- function(X , groups , scale = TRUE, tangentcoords = "residual", ncv = 2) { g <- dim(table (groups)) ans <- procGPA(X , tangentcoords=tangentcoords, scale = scale) if (scale == TRUE) pp <- (ans$k - 1) * ans$m - (ans$m * (ans$m - 1) / 2) - 1 if (scale == FALSE) pp <- (ans$k - 1) * ans$m - (ans$m * (ans$m - 1) / 2) pracdim <- min(pp, ans$n - g) out <- lda(ans$scores[, 1:pracdim] , groups) print((out)) cv <- predict(out, dimen = ncv)$x if (dim(cv)[2] == 1) { cv <- cbind(cv, rnorm(dim(cv)[1]) / 1000) } if (ncv == 2) { eqscplot(cv, type = "n", xlab = "CV1", ylab = "CV2") text(cv, labels = groups) } if (ncv == 3) { shapes3d(cv, color = groups, axes3 = TRUE) } cv } #================================================================================== groupstack <- function(A1, A2, A3 = 0, A4 = 0, A5 = 0, A6 = 0, A7 = 0, A8 = 0) { out <- list(x = 0, groups = "") dat <- abind(A1, A2) group <- c(rep(1, times = dim(A1)[3]), rep(2, times = dim(A2)[3])) if (is.array(A3)) { dat <- abind(dat, A3) group <- c(group, rep(3, times = dim(A3)[3])) if (is.array(A4)) { dat <- abind(dat, A4) group <- c(group, rep(4, times = dim(A4)[3])) if (is.array(A5)) { dat <- abind(dat, A5) group <- c(group, rep(5, times = dim(A5)[3])) if (is.array(A6)) { dat <- abind(dat, A6) group <- c(group, rep(6, times = dim(A6)[3])) if (is.array(A7)) { dat <- abind(dat, A7) group <- c(group, rep(7, times = dim(A7)[3])) if (is.array(A8)) { dat <- abind(dat, A8) group <- c(group, rep(8, times = dim(A8)[3])) } } } } } } out$x <- dat out$groups <- group out } ########################### #================================================================================== procdist <- function(x, y, type = "full", reflect = FALSE) { if (type == "full") { out <- sin(riemdist(x, y, reflect = reflect)) } if (type == "partial") { out <- sqrt(2) * sqrt(abs(1 - cos(riemdist(x, y, reflect = reflect)))) } if (type == "Riemannian") { out <- riemdist(x, y, reflect = reflect) } if (type == "sizeandshape") { out <- ssriemdist(x, y, reflect = reflect) } out } #================================================================================== transformations <- function(Xrotated, Xoriginal) { # outputs the translations, rotations and # scalings for ordinary Procrustes rotation # of each individual in Xoriginal to the # Procrustes rotated individuals in Xrotated X1 <- Xrotated X2 <- Xoriginal n <- dim(X1)[3] m <- dim(X1)[2] translation <- matrix(0, m, n) scale <- rep(0, times = n) rotation <- array(0, c(m, m, n)) for (i in 1:n) { translation[, i] <- -apply(X2[, , i] - X1[, , i], 2, mean) ans <- procOPA(X1[, , i], X2[, , i]) scale[i] <- ans$s rotation[, , i] <- ans$R } out <- list(translation = 0, scale = 0, rotation = 0) out$translation <- translation out$scale <- scale out$rotation <- rotation out } #================================================================================== iglogl <- function(x , lam, nlam) { gamma <- abs(x[1]) alpha <- gamma / mean(1 / lam[1:nlam]) ll <- -(gamma + 1) * sum(log(lam[1:nlam])) - alpha * sum (1 / lam[1:nlam]) + nlam * gamma * log(alpha) - nlam * lgamma (gamma) - ll } #================================================================================== procWGPA <- function(x, fixcovmatrix = FALSE, initial = "Identity", maxiterations = 10, scale = TRUE, reflect = FALSE, prior = "Exponential", diagonal = TRUE, sampleweights = "Equal") { X <- x priorargument <- prior alpha <- "not estimated" gamma <- "not estimated" k <- dim(X)[1] n <- dim(X)[3] m <- dim(X)[2] if (initial[1] == "Identity") { Sigmak <- diag(k) } else{ if (initial[1] == "Rawdata") { tol <- 0.0000000001 if (m == 2) { Sigmak <- diag(diag(var(t(X[, 1, ]))) + diag(var(t(X[, 2, ])))) / 2 + tol } if (m == 3) { Sigmak <- diag(diag(var(t(X[, 1, ]))) + diag(var(t(X[, 2, ]))) + diag(var(t(X[, 3, ])))) / 3 + tol } } else { Sigmak <- initial } } mu <- procGPA(X, scale = scale)$mshape #cat("Iteration 1 \n") if (fixcovmatrix[1] != FALSE) { Sigmak <- fixcovmatrix } ans <- procWGPA1( X, mu, metric = Sigmak, scale = scale, reflect = reflect, sampleweights = sampleweights ) if ((maxiterations > 1) && (fixcovmatrix[1] == FALSE)) { ans0 <- ans dif <- 999999 it <- 1 while ((dif > 0.00001) && (it < maxiterations)) { it <- it + 1 if (it == 2) { cat("Differences in norm of Sigma estimates... \n ") } if (prior[1] == "Identity") { prior <- diag(k) } if (prior[1] == "Inversegamma") { lam <- eigen(ans$Sigmak)$values nlam <- min(c(n * m - m - 3, k - 3)) mu <- mean(1 / lam[1:(nlam)]) alpha <- 1 / mu out <- nlm(iglogl, p = c(1) , lam = lam, nlam = nlam) #print(out) gamma <- abs(out$estimate[1]) alpha <- gamma / mean(1 / lam[1:nlam]) newmetric <- n * m / (n * m + 2 * (1 + gamma)) * (ans$Sigmak + (2 * alpha / (n * m)) * diag(k)) #dif2<-999999 #while (dif2> 0.000001){ #old<-alpha #lam <- eigen(newmetric)$values #out <- nlm( iglogl, p=c(1) ,lam=lam, nlam=nlam) #gamma <- abs(out$estimate[1]) #alpha<- gamma/ mean(1/lam[1:nlam]) #newmetric <- n*m/(n*m+2*(1+gamma))*( ans$Sigmak + (2*alpha/(n*m))*diag(k) ) #dif2<- abs(alpha- old) #print(dif2) #} } if (prior[1] == "Exponential") { lam <- eigen(ans$Sigmak)$values nlam <- min(c(n * m - m - 2, k - 2)) mu <- mean(1 / lam[1:(nlam)]) alpha <- 1 / mu gamma <- 1 newmetric <- n * m / (n * m + 2 * (2)) * (ans$Sigmak + (2 * alpha / (n * m)) * diag(k)) #dif2<-999999 #while (dif2> 0.000001){ #old<-alpha #newmetric <- n*m/(n*m+2*(2))*( ans$Sigmak + (2*alpha/(n*m))*diag(k) ) #lam <- eigen(newmetric)$values #mu <- mean(1/lam[1:( nlam)]) #alpha <- 1/mu #newmetric <- n*m/(n*m+2*(2))*( ans$Sigmak + (2*alpha/(n*m))*diag(k) ) #dif2<- abs(alpha- old) #} } if (is.double(prior[1])) { newmetric <- (ans$Sigmak + prior) } if (diagonal == TRUE) { newmetric <- diag(diag(newmetric)) } if (fixcovmatrix[1] != FALSE) { newmetric <- fixcovmatrix } ans2 <- procWGPA1( X, ans$mshape, metric = newmetric , scale = scale, sampleweights = sampleweights ) plotshapes(ans2$rotated) dif <- Enorm((ans$Sigmak - ans2$Sigmak)) ans <- ans2 cat(c(it, " ", dif, " \n")) } } if ((priorargument[1] == "Exponential") || (priorargument[1] == "Inversegamma")) { ans$alpha <- alpha ans$gamma <- gamma } cat(" \n") ans } #================================================================================== procWGPA1 <- function(X, mu, metric = "Identity", scale = TRUE, reflect = FALSE, sampleweights = "Equal") { k <- dim(X)[1] n <- dim(X)[3] m <- dim(X)[2] sum <- 0 for (i in 1:n) { sum <- sum + centroid.size(X[, , i]) ** 2 } size1 <- sqrt(sum) if (sampleweights[1] == "Equal") { sampleweights <- rep(1 / n, times = n) } if (length(sampleweights) != n) { cat("Sample weight vector not of correct length \n") } if (metric[1] == "Identity") { Sigmak <- diag(k) } else{ Sigmak <- metric } eig <- eigen(Sigmak, symmetric = TRUE) Sighalf <- eig$vectors %*% diag (sqrt(abs(eig$values))) %*% t(eig$vectors) Siginvhalf <- eig$vectors %*% diag(1 / sqrt(abs(eig$values))) %*% t(eig$vectors) Siginv <- eig$vectors %*% diag (1 / (eig$values)) %*% t(eig$vectors) one <- matrix(rep(1, times = k), k, 1) Xstar <- X for (i in 1:n) { Xstar[, , i] <- Xstar[, , i] - one %*% t(one) %*% Siginv %*% Xstar[, , i] / c(t(one) %*% Siginv %*% one) Xstar[, , i] <- Siginvhalf %*% Xstar[, , i] } mu <- mu - one %*% t(one) %*% Siginv %*% mu / c(t(one) %*% Siginv %*% one) ans <- procGPA(Xstar, eigen2d = FALSE) ans2 <- ans dif3 <- 99999999 while (dif3 > 0.00001) { for (i in 1:n) { old <- mu tem <- procOPA(Siginvhalf %*% mu , Xstar[, , i], scale = scale, reflect = reflect) Gammai <- tem$R betai <- tem$s #ci <- t(one)%*% Siginvhalf %*% X[,,i] %*% Gammai*betai/k #Yi <- Sighalf%*% ans$rotated[,,i] + Sighalf%*%one%*% ci #Zi <- Yi - one %*% t(one)%*% Siginv %*% Yi / c( t(one)%*%Siginv%*%one ) Zi <- Sighalf %*% Xstar[, , i] %*% Gammai * betai ans2$rotated[, , i] <- Zi } sum2 <- 0 for (i in 1:n) { sum2 <- sum2 + centroid.size(ans2$rotated[, , i]) ** 2 } size2 <- sqrt(sum2) tem <- ans2$mshape * 0 for (i in 1:n) { ans2$rotated[, , i] <- ans2$rotated[, , i] * size1 / size2 tem <- tem + ans2$rotated[, , i] * sampleweights[i] / sum(sampleweights) } mu <- tem dif3 <- riemdist(old, mu) } z <- ans2 z$mshape <- tem tan <- z$rotated[, 1,] - z$mshape[, 1] for (i in 2:m) { tan <- rbind(tan, z$rotated[, i,] - z$mshape[, i]) } pca <- prcomp1(t(tan)) z$tan <- tan npc <- 0 for (i in 1:length(pca$sdev)) { if (pca$sdev[i] > 1e-07) { npc <- npc + 1 } } z$scores <- pca$x z$rawscores <- pca$x z$stdscores <- pca$x for (i in 1:npc) { z$stdscores[, i] <- pca$x[, i] / pca$sdev[i] } z$pcar <- pca$rotation z$pcasd <- pca$sdev z$percent <- z$pcasd ^ 2 / sum(z$pcasd ^ 2) * 100 size <- rep(0, times = n) rho <- rep(0, times = n) x <- X size <- apply(x, 3, centroid.size) rho <- apply(x, 3, y <- function(x) { riemdist(x, z$mshape) }) z$rho <- rho z$size <- size z$rmsrho <- sqrt(mean(rho ^ 2)) z$rmsd1 <- sqrt(mean(sin(rho) ^ 2)) z$k <- k z$m <- m z$n <- n tem <- matrix(0, k, k) for (i in 1:n) { tem <- tem + (z$rotated[, , i] - z$mshape) %*% t((z$rotated[, , i] - z$mshape)) } tem <- tem / (n * m) z$Sigmak <- tem return(z) } #================================================================================== testshapes <- function(A, B, resamples = 1000, replace = TRUE, scale = TRUE) { if (replace == TRUE) { out <- bootstraptest(A, B, resamples = resamples, scale = scale) } if (replace == FALSE) { out <- permutationtest(A, B, nperms = resamples, scale = scale) } out } #================================================================================== testmeanshapes <- function(A, B, resamples = 1000, replace = FALSE, scale = TRUE) { if (replace == TRUE) { out <- bootstraptest(A, B, resamples = resamples, scale = scale) } if (replace == FALSE) { out <- permutationtest(A, B, nperms = resamples, scale = scale) } if (resamples > 0) { aa <- list( H = 0, H.pvalue = 0, H.table.pvalue = 0, G = 0, G.pvalue = 0, G.table.pvalue = 0, J = 0, J.pvalue = 0, J.table.pvalue = 0 ) aa$H <- out$H aa$H.pvalue <- out$H.pvalue aa$H.table.pvalue <- out$H.table.pvalue aa$G <- out$G aa$G.pvalue <- out$G.pvalue aa$G.table.pvalue <- out$G.table.pvalue aa$J <- out$J aa$J.pvalue <- out$J.pvalue aa$J.table.pvalue <- out$J.table.pvalue } if (resamples == 0) { aa <- list( H = 0, H.table.pvalue = 0, G = 0, G.table.pvalue = 0, J = 0, J.table.pvalue = 0 ) aa$H <- out$H aa$H.table.pvalue <- out$H.table.pvalue aa$G <- out$G aa$G.table.pvalue <- out$G.table.pvalue aa$J <- out$J aa$J.table.pvalue <- out$J.table.pvalue } aa } #================================================================================== permutationtest2 <- function (A, B, nperms = 1000, scale = scale) { A1 <- A A2 <- B mdim <- dim(A1)[2] B <- nperms nsam1 <- dim(A1)[3] nsam2 <- dim(A2)[3] pool <- procGPA( abind (A1, A2) , scale = scale, tangentcoords = "partial", pcaoutput = FALSE ) tempool <- pool for (i in 1:(nsam1 + nsam2)) { tempool$tan[, i] <- pool$tan[, i] / Enorm(pool$tan[, i]) * pool$rho[i] } pool <- tempool permpool <- pool Gtem <- Goodall(pool, nsam1, nsam2) Htem <- Hotelling(pool, nsam1, nsam2) Jtem <- James(pool, nsam1, nsam2, table = TRUE) Ltem <- Lambdamin(pool, nsam1, nsam2) Gumc <- Gtem$F Humc <- Htem$F Jumc <- Jtem$Tsq Lumc <- Ltem$lambdamin Gtabpval <- Gtem$pval Htabpval <- Htem$pval Jtabpval <- Jtem$pval Ltabpval <- Ltem$pval if (B > 0) { Apool <- array(0, c(dim(A1)[1], dim(A1)[2], dim(A1)[3] + dim(A2)[3])) Apool[, , 1:nsam1] <- A1 Apool[, , (nsam1 + 1):(nsam1 + nsam2)] <- A2 out <- list( H = 0, H.pvalue = 0, H.table.pvalue = 0, J = 0, J.pvalue = 0, J.table.pvalue = 0, G = 0, G.pvalue = 0, G.table.pvalue = 0 ) Gu <- rep(0, times = B) Hu <- rep(0, times = B) Ju <- rep(0, times = B) Lu <- rep(0, times = B) cat("Permutations - sampling without replacement: ") cat(c("No of permutations = ", B, "\n")) for (i in 1:B) { if (i / 100 == trunc(i / 100)) { cat(c(i, " ")) } select <- sample(1:(nsam1 + nsam2)) permpool$tan <- pool$tan[, select] Gu[i] <- Goodall(permpool, nsam1, nsam2)$F Hu[i] <- Hotelling(permpool, nsam1, nsam2)$F Ju[i] <- James(permpool, nsam1, nsam2)$Tsq Lu[i] <- Lambdamin(permpool, nsam1, nsam2)$lambdamin } Gu <- sort(Gu) numbig <- length(Gu[Gumc < Gu]) pvalG <- (1 + numbig) / (B + 1) Lu <- sort(Lu) numbig <- length(Lu[Lumc < Lu]) pvalL <- (1 + numbig) / (B + 1) Ju <- sort(Ju) numbig <- length(Ju[Jumc < Ju]) pvalJ <- (1 + numbig) / (B + 1) Hu <- sort(Hu) numbig <- length(Hu[Humc < Hu]) pvalH <- (1 + numbig) / (B + 1) cat(" \n") out$Hu <- Hu out$Ju <- Ju out$Gu <- Gu out$Lu <- Lu out$H <- Humc out$H.pvalue <- pvalH out$H.table.pvalue <- Htabpval out$J <- Jumc out$J.pvalue <- pvalJ out$J.table.pvalue <- Jtabpval out$G <- Gumc out$G.pvalue <- pvalG out$G.table.pvalue <- Gtabpval out$L <- Lumc out$L.pvalue <- pvalL out$L.table.pvalue <- Ltabpval } if (B == 0) { out <- list( H = 0, H.table.pvalue = 0, G = 0, G.table.pvalue = 0 ) out$H <- Humc out$H.table.pvalue <- Htabpval out$J <- Jumc out$J.table.pvalue <- Jtabpval out$G <- Gumc out$G.table.pvalue <- Gtabpval out$L <- Lumc out$L.table.pvalue <- Ltabpval } out } #================================================================================== bootstraptest <- function (A, B, resamples = 200, scale = TRUE) { A1 <- A A2 <- B mdim <- dim(A1)[2] B <- resamples nsam1 <- dim(A1)[3] nsam2 <- dim(A2)[3] pool <- procGPA( abind (A1, A2) , scale = scale , tangentcoords = "partial", pcaoutput = FALSE ) tempool <- pool for (i in 1:(nsam1 + nsam2)) { tempool$tan[, i] <- pool$tan[, i] / Enorm(pool$tan[, i]) * pool$rho[i] } pool <- tempool bootpool <- pool Gtem <- Goodall(pool, nsam1, nsam2) Htem <- Hotelling(pool, nsam1, nsam2) Jtem <- James(pool, nsam1, nsam2, table = TRUE) Ltem <- Lambdamin(pool, nsam1, nsam2) Gumc <- Gtem$F Humc <- Htem$F Jumc <- Jtem$Tsq Lumc <- Ltem$lambdamin Gtabpval <- Gtem$pval Htabpval <- Htem$pval Jtabpval <- Jtem$pval Ltabpval <- Ltem$pval if (B > 0) { Apool <- array(0, c(dim(A1)[1], dim(A1)[2], dim(A1)[3] + dim(A2)[3])) Apool[, , 1:nsam1] <- A1 Apool[, , (nsam1 + 1):(nsam1 + nsam2)] <- A2 out <- list( H = 0, H.pvalue = 0, H.table.pvalue = 0, J = 0, J.pvalue = 0, J.table.pvalue = 0, G = 0, G.pvalue = 0, G.table.pvalue = 0 ) Gu <- rep(0, times = B) Hu <- rep(0, times = B) Ju <- rep(0, times = B) Lu <- rep(0, times = B) pool2 <- pool pool2$tan[, 1:nsam1] <- pool$tan[, 1:nsam1] - apply(pool$tan[, 1:nsam1], 1, mean) pool2$tan[, (nsam1 + 1):(nsam1 + nsam2)] <- pool$tan[, (nsam1 + 1):(nsam1 + nsam2)] - apply(pool$tan[, (nsam1 + 1):(nsam1 + nsam2)], 1, mean) cat("Bootstrap - sampling with replacement within each group under H0: ") cat(c("No of resamples = ", B, "\n")) for (i in 1:B) { if (i / 100 == trunc(i / 100)) { cat(c(i, " ")) } select1 <- sample(1:nsam1, replace = TRUE) select2 <- sample((nsam1 + 1):(nsam1 + nsam2), replace = TRUE) bootpool$tan <- pool2$tan[, c(select1, select2)] Gu[i] <- Goodall(bootpool, nsam1, nsam2)$F Hu[i] <- Hotelling(bootpool, nsam1, nsam2)$F Ju[i] <- James(bootpool, nsam1, nsam2)$Tsq Lu[i] <- Lambdamin(bootpool, nsam1, nsam2)$lambdamin } Gu <- sort(Gu) numbig <- length(Gu[Gumc < Gu]) pvalG <- (1 + numbig) / (B + 1) Ju <- sort(Ju) numbig <- length(Ju[Jumc < Ju]) pvalJ <- (1 + numbig) / (B + 1) Hu <- sort(Hu) numbig <- length(Hu[Humc < Hu]) pvalH <- (1 + numbig) / (B + 1) numbig <- length(Lu[Lumc < Lu]) pvalL <- (1 + numbig) / (B + 1) cat(" \n") out$Hu <- Hu out$Ju <- Ju out$Gu <- Gu out$Lu <- Lu out$H <- Humc out$H.pvalue <- pvalH out$H.table.pvalue <- Htabpval out$J <- Jumc out$J.pvalue <- pvalJ out$J.table.pvalue <- Jtabpval out$G <- Gumc out$G.pvalue <- pvalG out$G.table.pvalue <- Gtabpval out$L <- Lumc out$L.pvalue <- pvalL out$L.table.pvalue <- Ltabpval } if (B == 0) { out <- list( H = 0, H.table.pvalue = 0, G = 0, G.table.pvalue = 0, J = 0, J.table.pvalue = 0 ) out$H <- Humc out$H.table.pvalue <- Htabpval out$J <- Jumc out$J.table.pvalue <- Jtabpval out$G <- Gumc out$G.table.pvalue <- Gtabpval out$L <- Lumc out$L.table.pvalue <- Ltabpval } out } #================================================================================== Lambdamin <- function (pool, n1, n2, p = 0) { censiz <- centroid.size(pool$mshape) tan1 <- pool$tan[, 1:n1] tan2 <- pool$tan[, (n1 + 1):(n1 + n2)] kt <- dim(tan1)[1] n <- n1 + n2 k <- pool$k m <- pool$m if (p == 0) { p <- min(k * m - (m * (m - 1)) / 2 - 1 - m, n1 + n2 - 2) } HH <- diag(k) mu1 <- pool$mshape if (dim(tan1)[1] == k * m - m) { HH <- defh(k - 1) mu1 <- preshape(pool$mshape) } if (m == 2) { mu <- c(mu1[, 1], mu1[, 2]) } if (m == 3) { mu <- c(mu1[, 1], mu1[, 2], mu1[, 3]) } dd <- kt X1 <- tan1 * 0 X2 <- tan2 * 0 S1 <- matrix(0, dd, dd) S2 <- matrix(0, dd, dd) for (i in 1:n1) { X1[, i] <- (mu + tan1[, i]) / Enorm(mu + tan1[, i]) S1 <- S1 + X1[, i] %*% t(X1[, i]) } for (i in 1:n2) { X2[, i] <- (mu + tan2[, i]) / Enorm(mu + tan2[, i]) S2 <- S2 + X2[, i] %*% t(X2[, i]) } sumx1 <- 0 sumx2 <- 0 for (i in 1:n1) { sumx1 <- sumx1 + X1[, i] } for (i in 1:n2) { sumx2 <- sumx2 + X2[, i] } sum1 <- apply(X1, 1, sum) sum2 <- apply(X2, 1, sum) mean1 <- sum1 / Enorm(sum1) mean2 <- sum2 / Enorm(sum2) bb1 <- mean1[1:(dd - 1)] cc1 <- mean1[dd] bb2 <- mean2[1:(dd - 1)] cc2 <- mean2[dd] A1 <- cc1 / abs(cc1) * diag(dd - 1) - cc1 / (abs(cc1) + cc1 ^ 2) * bb1 %*% t(bb1) M1 <- cbind(A1,-bb1) A1 <- cc2 / abs(cc2) * diag(dd - 1) - cc2 / (abs(cc2) + cc2 ^ 2) * bb2 %*% t(bb2) M2 <- cbind(A1,-bb2) G1 <- matrix(0, dd - 1, dd - 1) G2 <- matrix(0, dd - 1, dd - 1) for (iu in 1:(dd - 1)) { for (iv in iu:(dd - 1)) { G1[iu, iv] <- G1[iu, iv] + t((t(M1))[, iu]) %*% S1 %*% (t(M1))[, iv] G1[iv, iu] <- G1[iu, iv] G2[iu, iv] <- G2[iu, iv] + t((t(M2))[, iu]) %*% S2 %*% (t(M2))[, iv] G2[iv, iu] <- G2[iu, iv] } } G1 <- G1 / n1 / Enorm(sumx1 / n1) ^ 2 G2 <- G2 / n2 / Enorm(sumx2 / n2) ^ 2 # eva1 <- eigen(G1, symmetric = TRUE, EISPACK = TRUE) eva1 <- eigen(G1, symmetric = TRUE) pcar1 <- eva1$vectors[, 1:p] pcasd1 <- sqrt(abs(eva1$values[1:p])) # eva2 <- eigen(G2, symmetric = TRUE, EISPACK = TRUE) eva2 <- eigen(G2, symmetric = TRUE) pcar2 <- eva2$vectors[, 1:p] pcasd2 <- sqrt(abs(eva2$values[1:p])) if ((pcasd1[p] < 1e-06) || (pcasd2[p] < 1e-06)) { offset <- 1e-06 cat("*") pcasd1 <- sqrt(pcasd1 ^ 2 + offset) pcasd2 <- sqrt(pcasd2 ^ 2 + offset) } Ahat1 <- n1 * t(M1) %*% (pcar1 %*% diag(1 / pcasd1 ^ 2) %*% t(pcar1)) %*% M1 Ahat2 <- n2 * t(M2) %*% (pcar2 %*% diag(1 / pcasd2 ^ 2) %*% t(pcar2)) %*% M2 Ahat <- (Ahat1 + Ahat2) # eva <- eigen(Ahat, symmetric = TRUE, EISPACK = TRUE) eva <- eigen(Ahat, symmetric = TRUE) lambdamin <- eva$values[p + 1] pval <- 1 - pchisq(lambdamin, p) #print(lambdamin) #print(pval) z <- list() z$pval <- pval z$df <- p z$lambdamin <- lambdamin return(z) } #================================================================================== Goodall <- function(pool , n1, n2, p = 0) { tan1 <- pool$tan[, 1:n1] tan2 <- pool$tan[, (n1 + 1):(n1 + n2)] kt <- dim(tan1)[1] n <- n1 + n2 k <- pool$k m <- pool$m if (p == 0) { p <- min(k * m - (m * (m - 1)) / 2 - 1 - m, n1 + n2 - 2) } top <- Enorm(apply(tan1, 1, mean) - apply(tan2, 1, mean)) ** 2 bot <- sum(diag(var(t(tan1)))) * (n1 - 1) + sum(diag(var(t(tan2)))) * (n2 - 1) Fstat <- ((n1 + n2 - 2) / (1 / n1 + 1 / n2) * top) / bot pval <- 1 - pf(Fstat, p, (n1 + n2 - 2) * p) z <- list() z$F <- Fstat z$pval <- pval z$df1 <- p z$df2 <- (n1 + n2 - 2) * p return(z) } #================================================================================== Hotelling <- function(pool , n1, n2, p = 0) { tan1 <- pool$tan[, 1:n1] tan2 <- pool$tan[, (n1 + 1):(n1 + n2)] kt <- dim(tan1)[1] n <- n1 + n2 k <- pool$k m <- pool$m S1 <- var(t(tan1)) S2 <- var(t(tan2)) Sw <- ((n1 - 1) * S1 + (n2 - 1) * S2) / (n1 + n2 - 2) if (p == 0) { p <- min(k * m - (m * (m - 1)) / 2 - 1 - m, n1 + n2 - 2) } # eva <- eigen(Sw, symmetric = TRUE,EISPACK=TRUE) eva <- eigen(Sw, symmetric = TRUE) pcar <- eva$vectors[, 1:p] pcasd <- sqrt(abs(eva$values[1:p])) if (pcasd[p] < 1e-06) { offset <- 1e-06 cat("*") pcasd <- sqrt(pcasd ^ 2 + offset) } lam <- rep(0, times = kt) lam[1:p] <- 1 / pcasd ^ 2 Suinv <- eva$vectors %*% diag(lam) %*% t(eva$vectors) pcax <- t(pool$tan) %*% pcar one1 <- matrix(1 / n1, n1, 1) one2 <- matrix(1 / n2, n2, 1) oneone <- rbind(one1,-one2) vbar <- pool$tan %*% oneone scores1 <- matrix(vbar, 1, kt) %*% pcar scores <- scores1 / pcasd F.partition <- ((scores[1:p] ^ 2) * (n1 * n2 * (n1 + n2 - p - 1))) / ((n1 + n2) * (n1 + n2 - 2) * p) FF <- sum(F.partition) pval <- 1 - pf(FF, p, (n1 + n2 - p - 1)) z <- list() z$F.partition <- F.partition z$F <- FF z$pval <- pval z$df1 <- p z$T.df1 <- p z$df2 <- (n1 + n2 - p - 1) mm <- n - 2 z$T.df2 <- mm z$Tsq <- FF * (n1 + n2) * (n1 + n2 - 2) * p / (n1 * n2) / (n1 + n2 - p - 1) z$Tsq.partition <- F.partition * (n1 + n2) * (n1 + n2 - 2) * p / (n1 * n2) / (n1 + n2 - p - 1) return(z) } James <- function(pool , n1, n2, p = 0, table = FALSE) { tan1 <- pool$tan[, 1:n1] tan2 <- pool$tan[, (n1 + 1):(n1 + n2)] kt <- dim(tan1)[1] n <- n1 + n2 k <- pool$k m <- pool$m S1 <- var(t(tan1)) S2 <- var(t(tan2)) Sw <- S1 / n1 + S2 / n2 if (p == 0) { p <- min(k * m - (m * (m - 1)) / 2 - 1 - m, n1 + n2 - 2) } # eva <- eigen(Sw, symmetric = TRUE,EISPACK=TRUE) eva <- eigen(Sw, symmetric = TRUE) pcar <- eva$vectors[, 1:p] pcasd <- sqrt(abs(eva$values[1:p])) if (pcasd[p] < 1e-06) { offset <- 1e-06 cat("*") pcasd <- sqrt(pcasd ^ 2 + offset) } lam <- rep(0, times = kt) lam[1:p] <- 1 / pcasd ^ 2 Suinv <- eva$vectors %*% diag(lam) %*% t(eva$vectors) pcax <- t(pool$tan) %*% pcar one1 <- matrix(1 / n1, n1, 1) one2 <- matrix(1 / n2, n2, 1) oneone <- rbind(one1,-one2) vbar <- pool$tan %*% oneone # scores1 <- matrix(vbar, 1, kt ) %*% pcar # scores <- scores1/pcasd # F.partition <- ((scores[1:p]^2) * (n1 * n2 * (n1 + n2 - p - # 1)))/((n1 + n2) * (n1 + n2 - 2) * p) # FF <- sum(F.partition) # pval <- 1 - pf(FF, p, (n1 + n2 - p - 1)) ######### # ginvSw<- pcar%*%diag(1/pcasd**2)%*%t(pcar) ginvSw <- Suinv pval = 0 T1 <- sum(diag((ginvSw %*% S1 / n1))) T2 <- sum(diag((ginvSw %*% S2 / n2))) T1sq <- sum(diag(((ginvSw %*% S1 / n1) %*% ginvSw %*% S1 / n1))) T2sq <- sum(diag(((ginvSw %*% S2 / n2) %*% ginvSw %*% S2 / n2))) Tsq <- (t(vbar) %*% (ginvSw) %*% vbar)[1, 1] if (table == TRUE) { AA <- 1 + 1 / (2 * p) * (T1 ** 2 / (n1 - 1) + T2 ** 2 / (n2 - 1)) BB <- 1 / (p * (p + 2)) * ((T1 ** 2 / 2 + T1sq) / (n1 - 1) + (T2 ** 2 / 2 + T2sq) / (n2 - 1)) kk <- rep(0, times = 1000) for (i in 0:999) { alphai <- i / 1000 kk[i + 1] <- qchisq(alphai, df = p) * (AA + BB * qchisq(alphai, df = p)) } pval <- 1 - max(c(1:1000)[kk < Tsq]) / 1000 } ####### z <- list() z$pval <- pval z$Tsq <- Tsq return(z) } #================================================================================== tpsgrid <- function (TT, YY, xbegin = -999, ybegin = -999, xwidth = -999, opt = 1, ext = 0.1, ngrid = 22, cex = 1, pch = 20, col = 2, zslice = 0, mag = 1, axes3 = FALSE) { k <- nrow(TT) m <- dim(TT)[2] YY <- TT + (YY - TT) * mag bb <- array(TT, c(dim(TT), 1)) aa <- defplotsize2(bb) if (xwidth == -999) { xwidth <- aa$width } if (xbegin == -999) { xbegin <- aa$xl } if (ybegin == -999) { ybegin <- aa$yl } if (m == 3) { zup <- max(TT[, 3]) zlo <- min(TT[, 3]) zpos <- zslice for (ii in 1:length(zslice)) { zpos[ii] <- (zup + zlo) / 2 + (zup - zlo) / 2 * zslice[ii] } } xstart <- xbegin ystart <- ybegin ngrid <- trunc(ngrid / 2) * 2 kx <- ngrid ky <- ngrid - 1 l <- kx * ky step <- xwidth / (kx - 1) r <- 0 X <- rep(0, times = kx) Y2 <- rep(0, times = ky) for (p in 1:kx) { ystart <- ybegin xstart <- xstart + step for (q in 1:ky) { ystart <- ystart + step r <- r + 1 X[r] <- xstart Y2[r] <- ystart } } TPS <- bendingenergy(TT) gamma11 <- TPS$gamma11 gamma21 <- TPS$gamma21 gamma31 <- TPS$gamma31 W <- gamma11 %*% YY ta <- t(gamma21 %*% YY) B <- gamma31 %*% YY WtY <- t(W) %*% YY trace <- c(0) for (i in 1:m) { trace <- trace + WtY[i, i] } benergy <- 16 * pi * trace if (m == 3) { benergy <- 8 * pi * trace } l <- kx * ky phi <- matrix(0, l, m) s <- matrix(0, k, 1) for (islice in 1:length(zslice)) { if (m == 3) { refc <- matrix(c(X, Y2, rep(zpos[islice], times = kx * ky)), kx * ky, m) } if (m == 2) { refc <- matrix(c(X, Y2), kx * ky, m) } for (i in 1:l) { s <- matrix(0, k, 1) for (im in 1:k) { s[im,] <- sigmacov(refc[i,] - TT[im,]) } phi[i,] <- ta + t(B) %*% refc[i,] + t(W) %*% s } if (m == 3) { if (opt == 2) { shapes3d(TT, color = 2, axes3 = axes3, rglopen = FALSE) shapes3d(YY, color = 4, rglopen = FALSE) for (i in 1:k) { lines3d(rbind(TT[i, ], YY[i, ]), col = 1) } for (j in 1:kx) { lines3d(refc[((j - 1) * ky + 1):(ky * j) , ], color = 6) } for (j in 1:ky) { lines3d(refc[(0:(kx - 1) * ky) + j , ], color = 6) } } shapes3d(TT, color = 2, axes3 = axes3, rglopen = FALSE) shapes3d(YY, color = 4, rglopen = FALSE) for (i in 1:k) { lines3d(rbind(TT[i, ], YY[i, ]), col = 1) } for (j in 1:kx) { lines3d(phi[((j - 1) * ky + 1):(ky * j) , ], color = 3) } for (j in 1:ky) { lines3d(phi[(0:(kx - 1) * ky) + j , ], color = 3) } } } if (m == 2) { par(pty = "s") if (opt == 2) { par(mfrow = c(1, 2)) order <- linegrid(refc, kx, ky) plot( order[1:l, 1], order[1:l, 2], type = "l", xlim = c(xbegin - xwidth * ext, xbegin + xwidth * (1 + ext)), ylim = c( ybegin - (xwidth * ky) / kx * ext, ybegin + (xwidth * ky) / kx * (1 + ext) ), xlab = " ", ylab = " " ) lines(order[(l + 1):(2 * l), 1], order[(l + 1):(2 * l), 2], type = "l") points(TT, cex = cex, pch = pch, col = col) } order <- linegrid(phi, kx, ky) plot( order[1:l, 1], order[1:l, 2], type = "l", xlim = c(xbegin - xwidth * ext, xbegin + xwidth * (1 + ext)), ylim = c(ybegin - (xwidth * ext * ky) / kx, ybegin + (xwidth * (1 + ext) * ky) / kx), xlab = " ", ylab = " " ) lines(order[(l + 1):(2 * l), 1], order[(l + 1):(2 * l), 2], type = "l") points(YY, cex = cex, pch = pch, col = col + 1) points(TT, cex = cex, pch = pch, col = col) for (i in 1:(k)) { arrows( TT[i, 1], TT[i, 2] , YY[i, 1], YY[i, 2] , col = col + 2, length = 0.1, angle = 20 ) } } } # #================================================================================== rotatexyz <- function(x, thetax, thetay, thetaz) { thetax <- thetax / 180 * pi thetay <- thetay / 180 * pi thetaz <- thetaz / 180 * pi Rx <- matrix(c( 1, 0, 0, 0, cos(thetax), sin(thetax), 0, -sin(thetax), cos(thetax) ), 3, 3) Ry <- matrix(c( cos(thetay), 0, sin(thetay), 0, 1, 0, -sin(thetay), 0, cos(thetay) ), 3, 3) Rz <- matrix(c( cos(thetaz), sin(thetaz), 0, -sin(thetaz), cos(thetaz), 0, 0, 0, 1 ), 3, 3) y <- x n <- dim(x)[3] for (i in 1:n) { y[, , i] <- x[, , i] %*% Rx %*% Ry %*% Rz } y } #================================================================================== rigidbody <- function(X, transx = 0, transy = 0, transz = 0, thetax = 0, thetay = 0, thetaz = 0) { if (is.matrix(X)) { X <- array(X, c(dim(X), 1)) } m <- dim(X)[2] n <- dim(X)[3] Y <- X if (m == 2) { #xx<-as.3d(X) if (dim(X)[3] < 2) { xx <- array(as.3d(X), dim = c(nrow(X), 3, 1)) } else{ xx <- as.3d(X) } for (i in 1:n) { for (j in 1:m) { xx[j, , i] <- xx[j, , i] - c(transx, transy, transz) } } yy <- rotatexyz(xx, thetax, thetay, thetaz) Y <- yy if ((sum(abs(yy[, 3, ]))) < 0.000000001) { Y <- yy[, 1:2, ] } } if (m == 3) { for (i in 1:n) { for (j in 1:m) { X[j, , i] <- X[j, , i] - c(transx, transy, transz) } } Y <- rotatexyz(X, thetax, thetay, thetaz) } Y } #================================================================================== as.3d <- function(X) { k <- dim(X)[1] if (is.matrix(X)) { X <- array(X, c(dim(X), 1)) } n <- dim(X)[3] if (dim(X)[2] != 2) { print("not 2 dimensional!") } Y <- array(0, c(k, 3, n)) Y[, 1:2, ] <- X if (n == 1) { Y <- Y[, , 1] } Y } #================================================================================== abind <- function(X1 , X2) { k <- dim(X1)[1] m <- dim(X1)[2] if (is.matrix(X1)) { tem <- array(0, c(k, m, 1)) tem[, , 1] <- X1 X1 <- tem } if (is.matrix(X2)) { tem <- array(0, c(k, m, 1)) tem[, , 1] <- X2 X2 <- tem } n1 <- dim(X1)[3] n2 <- dim(X2)[3] Y <- array(0, c(k, m, n1 + n2)) Y[, , 1:n1] <- X1 Y[, , (n1 + 1):(n1 + n2)] <- X2 Y } #================================================================================== shapes3d <- function(x, loop = 0, type = "p", color = 2, joinline = c(1:1), axes3 = FALSE, rglopen = TRUE) { if (is.matrix(x)) { xt <- array(0, c(dim(x), 1)) xt[, , 1] <- x x <- xt } if (is.array(x) == FALSE) { cat("Data not in right format : require an array \n") } if (is.array(x) == TRUE) { if (rglopen) { open3d() } if (dim(x)[2] == 2) { x <- as.3d(x) } if (loop == 0) { k <- dim(x)[1] sz <- centroid.size(x[, , 1]) / sqrt(k) / 30 plotshapes3d( x, type = type, color = color, size = sz, joinline = joinline ) if (axes3) { axes3d(color = "black") title3d( xlab = "x", ylab = "y", zlab = "z", color = "black" ) } } if (loop > 0) { for (i in 1:loop) { plotshapestime3d(x, type = type) } } } } #================================================================================== plotshapes3d <- function (x, type = "p", rgl = TRUE, color = 2, size = 1, joinline = c(1:1)) { k <- dim(x)[1] n <- dim(x)[3] y <- matrix(0, k * n, 3) for (i in 1:n) { y[(i - 1) * k + (1:k),] <- x[, , i] } if (rgl == FALSE) { par(mfrow = c(1, 1)) out <- defplotsize3(x) xl <- out$xl xu <- out$xu yl <- out$yl yu <- out$yu zl <- out$zl zu <- out$zu scatterplot3d( y, xlim = c(xl, xu), ylim = c(yl, yu), zlim = c(zl, zu), xlab = "x", ylab = "y", zlab = "z", axis = TRUE, type = type, color = color, highlight.3d = TRUE ) } if (rgl == TRUE) { if (type == "l") { points3d(y, col = color, size = size) for (j in 1:n) { lines3d(x[, , j], col = 8) } } if (type == "dots") { points3d(y, col = color, size = size) } if (type == "p") { spheres3d(y, col = color, radius = size) } if (length(joinline) > 1) { for (j in 1:n) { lines3d(x[joinline, , j], col = 8) } } } } #================================================================================== plotshapestime3d <- function (x, type = "p") { par(mfrow = c(1, 1)) out <- defplotsize3(x) xl <- out$xl xu <- out$xu yl <- out$yl yu <- out$yu zl <- out$zl zu <- out$zu n <- dim(x)[3] for (i in 1:n) { scatterplot3d( x[, , i], xlim = c(xl, xu), ylim = c(yl, yu), zlim = c(zl, zu), xlab = "x", ylab = "y", zlab = "z", axis = TRUE, type = type, highlight.3d = TRUE ) title(i) } } #================================================================================== plotPDMnoaxis3 <- function (mean, pc, sd, xl, xu, yl, yu, lineorder, i) { fig <- mean + i * pc * sd k <- length(mean) / 2 figx <- fig[1:k] figy <- fig[(k + 1):(2 * k)] plot( figx, figy, axes = FALSE, xlab = " ", ylab = " ", ylim = c(yl, yu), type = "n", xlim = c(xl, xu) ) text(figx, figy, 1:k) lines(figx[lineorder], figy[lineorder]) for (aa in 1:9999) { aaa <- 1 } } ################################# #================================================================================== shapepca <- function (proc, pcno = c(1, 2, 3), type = "r", mag = 1, joinline = c(1, 1), project = c(1, 2), scores3d = FALSE, color = 2, axes3 = FALSE, rglopen = TRUE, zslice = 0) { if (scores3d == TRUE) { axes3 <- TRUE sz <- max(proc$rawscores[, max(pcno)]) - min(proc$rawscores[, max(pcno)]) spheres3d(proc$rawscores[, pcno] , radius = sz / 30, col = color) if (axes3) { axes3d() } } m <- dim(proc$mshape)[2] k <- dim(proc$mshape)[1] if (scores3d == FALSE) { if ((m == 2)) { out <- defplotsize2(proc$rotated, project = project) xl <- out$xl yl <- out$yl width <- out$width plotpca(proc, pcno, type, mag, xl, yl, width, joinline, project) } if ((m == 3) && (type == "m")) { # plot3Dmean(proc) # cat("Mean shape \n") # for (i in 1:length(pcno)) { # cat("PC ", pcno[i], " \n") # plot3Dpca(proc, pcno[i]) # } for (i in 1:length(pcno)) { cat("PC ", pcno[i], " \n") plotpca3d(proc, pcno[i]) } } ## correct length of tangent vector if in Helmertized space h <- defh(k - 1) zero <- matrix(0, k - 1, k) H <- cbind(h, zero, zero) H1 <- cbind(zero, h, zero) H2 <- cbind(zero, zero, h) H <- rbind(H, H1, H2) if (dim(proc$pcar)[1] == (3 * (k - 1))) { pcarot <- (t(H) %*% proc$pcar) proc$pcar <- pcarot } if (((m == 3) && (type != "m")) && (type != "g")) { if (rglopen) { open3d() } sz <- centroid.size(proc$mshape) / sqrt(k) / 30 spheres3d(proc$mshape, radius = sz, col = color) if (axes3) { axes3d() } for (i in pcno) { pc <- proc$mshape + 3 * mag * proc$pcasd[i] * cbind(proc$pcar[1:k, i], proc$pcar[(k + 1):(2 * k), i], proc$pcar[(2 * k + 1):(3 * k), i]) for (j in 1:k) { lines3d(rbind(proc$mshape[j, ], pc[j, ]), col = i) } } } } if ((m == 3) && (type == "g")) { if (rglopen) { open3d() } for (i in pcno) { pc <- proc$mshape + 3 * mag * proc$pcasd[i] * cbind(proc$pcar[1:k, i], proc$pcar[(k + 1):(2 * k), i], proc$pcar[(2 * k + 1):(3 * k), i]) tpsgrid(proc$mshape, pc, zslice = zslice) } } } #================================================================================== plotpca3d <- function (procreg, pcno = 1) { par(mfrow = c(1, 1)) out <- defplotsize3(procreg$rotated) xl <- out$xl xu <- out$xu yl <- out$yl yu <- out$yu zl <- out$zl zu <- out$zu k <- dim(procreg$mshape)[1] subx <- 1:k suby <- (k + 1):(2 * k) subz <- (2 * k + 1):(3 * k) evec <- cbind(procreg$pcar[subx, pcno], procreg$pcar[suby, pcno], procreg$pcar[subz, pcno]) for (j in 1:10) { for (ii in-12:12) { mag <- ii / 4 scatterplot3d( procreg$mshape + mag * evec * procreg$pcasd[pcno], xlim = c(xl, xu), ylim = c(yl, yu), zlim = c(zl, zu), xlab = "x", ylab = "y", zlab = "z", axis = TRUE, highlight.3d = TRUE ) title(pcno) } for (ii in-11:11) { mag <- -ii / 4 scatterplot3d( procreg$mshape + mag * evec * procreg$pcasd[pcno], xlim = c(xl, xu), ylim = c(yl, yu), zlim = c(zl, zu), xlab = "x", ylab = "y", zlab = "z", axis = TRUE ) title(pcno) } } } ############################## #================================================================================== Hotelling2Djames <- function (A, B) { z <- list(Tsq = 0, pval = 0) n1 <- dim(A)[3] n2 <- dim(B)[3] n <- n1 + n2 k <- dim(A)[1] m <- dim(B)[2] if (m != 2) { print("Data not two dimensional") return(z) } else { pool <- array(0, c(k, m, n)) pool[, , 1:n1] <- A pool[, , (n1 + 1):n] <- B poolpr <- procrustes2d(pool, 1, 2) S1 <- var(t(poolpr$tan[, 1:n1])) S2 <- var(t(poolpr$tan[, (n1 + 1):(n1 + n2)])) gamma <- realtocomplex(preshape(poolpr$mshape)) Sw <- (S1 / n1 + S2 / n2) p <- 2 * k - 4 # TT<-eigen(Sw,symmetric=TRUE,EISPACK=TRUE) TT <- eigen(Sw, symmetric = TRUE) pcar <- TT$vectors[, 1:p] pcasd <- sqrt(abs(TT$values[1:p])) ####### add small offset if defecient in rank if (pcasd[p] < 0.000001) { offset <- 0.000001 cat("*") pcasd <- sqrt(pcasd ** 2 + offset ** 2) } ####################################### pcax <- t(poolpr$tan) %*% pcar h <- defh(k - 1) zero <- matrix(0, k - 1, k) H <- cbind(h, zero) H1 <- cbind(zero, h) H <- rbind(H, H1) meanxy <- t(H) %*% V(gamma) realrot <- t(H) %*% pcar one1 <- matrix(1 / n1, n1, 1) one2 <- matrix(1 / n2, n2, 1) oneone <- rbind(one1,-one2) vbar <- poolpr$tan %*% oneone scores1 <- matrix(vbar, 1, (2 * k - 2)) %*% pcar scores <- scores1 / pcasd F.partition <- ((scores[1:p] ^ 2) * (n1 * n2 * (n1 + n2 - p - 1))) / ((n1 + n2) * (n1 + n2 - 2) * p) FF <- sum(F.partition) pval <- 1 - pf(FF, p, (n1 + n2 - p - 1)) ginvSw <- pcar %*% diag(1 / pcasd ** 2) %*% t(pcar) T1 <- sum(diag((ginvSw %*% S1 / n1))) T2 <- sum(diag((ginvSw %*% S2 / n2))) T1sq <- sum(diag(( (ginvSw %*% S1 / n1) %*% ginvSw %*% S1 / n1 ))) T2sq <- sum(diag(( (ginvSw %*% S2 / n2) %*% ginvSw %*% S2 / n2 ))) Tsq <- (t(vbar) %*% (ginvSw) %*% vbar)[1, 1] AA <- 1 + 1 / (2 * p) * (T1 ** 2 / (n1 - 1) + T2 ** 2 / (n2 - 1)) BB <- 1 / (p * (p + 2)) * ((T1 ** 2 / 2 + T1sq) / (n1 - 1) + (T2 ** 2 / 2 + T2sq) / (n2 - 1)) kk <- rep(0, times = 1000) for (i in 0:999) { alphai <- i / 1000 kk[i + 1] <- qchisq(alphai, df = p) * (AA + BB * qchisq(alphai, df = p)) } pval <- 1 - max(c(1:1000)[kk < Tsq]) / 1000 # z$F.partition <- F.partition # z$F <- FF z$pval <- pval z$Tsq <- Tsq # z$df1 <- p # z$T.df1 <- p # z$df2 <- (n1 + n2 - p - 1) # mm <- n - 2 # z$T.df2 <- mm # z$Tsq <- FF * (n1 + n2) * (n1 + n2 - 2) * p/(n1 * n2)/(n1 + # n2 - p - 1) # z$Tsq.partition <- F.partition * (n1 + n2) * (n1 + n2 - # 2) * p/(n1 * n2)/(n1 + n2 - p - 1) return(z) } } MGM <- function(zst) { nsam <- dim(zst)[2] k <- dim(zst)[1] Mhat <- matrix(0, k - 1, k - 2) lamhat <- rep(0, times = (k - 1)) Sighat <- matrix(0, k - 2, k - 2) kk <- k * 2 - 2 t1 <- reassqpr(preshape(zst)) / nsam # t2 <- eigen(t1,symmetric=TRUE,EISPACK=TRUE) t2 <- eigen(t1, symmetric = TRUE) reagamma <- (t2$vectors[, 1] + t2$vectors[, 2]) / sqrt(2) gamma <- Vinv(reagamma) muhat <- gamma for (i in 1:(k - 2)) { Mhat[, i] <- Vinv(t2$vectors[, 1 + (2 * i)]) } for (i in 1:(k - 1)) { lamhat[i] <- t2$values[(2 * i) - 1] } for (j in 2:(k - 1)) { for (l in 2:(k - 1)) { sum <- 0 for (i in 1:nsam) { zi <- preshape(zst[, i]) sum <- sum + st(Mhat[, j - 1]) %*% zi * st(zi) %*% Mhat[, l - 1] * st(zi) %*% muhat * st(muhat) %*% zi } Sighat[j - 1, l - 1] <- 1 / (lamhat[1] - lamhat[j]) / (lamhat[1] - lamhat[l]) * sum / nsam } } SR <- Re(Sighat) SI <- Im(Sighat) S1 <- cbind(SR, SI) S2 <- cbind(-(SI), SR) S <- rbind(S1, S2) offset <- 0 #es<-eigen(S,symmetric=TRUE,EISPACK=TRUE)$values es <- eigen(S, symmetric = TRUE)$values nn <- length(es) if (es[nn] < 0.000001) { offset <- 0.000001 #cat("Warning: test: small samples, lambda I added to within group covariance matrix \n") cat("*") } invS <- solve(S + offset * diag(nn)) invSR <- invS[1:(k - 2), 1:(k - 2)] invSI <- invS[1:(k - 2), (k - 1):(2 * k - 4)] invS <- invSR + 1i * invSI Mhat <- st(Mhat) MGM <- st(Mhat) %*% invS %*% Mhat MGM } #====================================================================================== resampletest <- function(A, B, resamples = 200, replace = TRUE) { A1 <- A A2 <- B B <- resamples k <- dim(A1)[1] m <- dim(A1)[2] nmin <- min(dim(A1)[3], dim(A2)[3]) ntot <- dim(A1)[3] + dim(A2)[3] M <- (k - 1) * m - m * (m - 1) / 2 - 1 if (M >= ntot) { cat("Warning: Low sample size (n1 + n2 <= p) \n") } if ((M >= nmin) && (replace == TRUE)) { cat( "Warning: Low sample sizes : min(n1,n2)<=p : * indicates some regularization carried out \n" ) } permutation <- !replace if (is.complex(A1)) { tem <- array(0, c(nrow(A1), 2, ncol(A1))) tem[, 1,] <- Re(A1) tem[, 2,] <- Im(A1) A1 <- tem } if (is.complex(A2)) { tem <- array(0, c(nrow(A2), 2, ncol(A2))) tem[, 1,] <- Re(A2) tem[, 2,] <- Im(A2) A2 <- tem } m <- dim(A1)[2] if (m != 2) { print("Data not two dimensional") print("Carrying out tests on Procrustes residuals") out <- testmeanshapes(A1, A2, resamples = resamples, replace = replace) return(out) } zst1 <- A1[, 1, ] + 1i * A1[, 2, ] zst2 <- A2[, 1, ] + 1i * A2[, 2, ] nsam1 <- dim(zst1)[2] nsam2 <- dim(zst2)[2] k <- dim(zst1)[1] LL <- (MGM(zst1) + MGM(zst2)) * (nsam1 + nsam2) LL1 <- cbind(Re(LL), Im(LL)) LL2 <- cbind(-Im(LL), Re(LL)) LL <- rbind(LL1, LL2) #Tumc<-min(eigen(LL,symmetric=TRUE,only.values=TRUE,EISPACK=TRUE)$values) Tumc <- min(eigen(LL, symmetric = TRUE, only.values = TRUE)$values) m1 <- preshape(procrustes2d(zst1)$mshape) m1 <- m1[, 1] + 1i * m1[, 2] m2 <- preshape(procrustes2d(zst2)$mshape) m2 <- m2[, 1] + 1i * m2[, 2] m0 <- preshape(procrustes2d(cbind(zst1, zst2))$mshape) m0 <- m0[, 1] + 1i * m0[, 2] d <- length(m1) H <- defh(k - 1) b <- m1 a <- m0 bt <- b * c((st(b) %*% a) / Mod(st(b) %*% a)) abt <- c(Re(st(bt) %*% a)) ct <- (bt - a * abt) # ct <- ct / sqrt(st(ct) %*% ct) ct <- ct / c(sqrt(st(as.vector(ct)) %*% as.vector(ct))) At <- a %*% st(ct) - ct %*% st(a) salph <- sqrt(1 - abt ** 2) calph <- abt Id <- diag(rep(1, times = d)) U1 <- Id + salph * At + (calph - 1) * (a %*% st(a) + ct %*% st(ct)) b <- m2 a <- m0 bt <- b * c((st(b) %*% a) / Mod(st(b) %*% a)) abt <- c(Re(st(bt) %*% a)) ct <- (bt - a * abt) # ct <- ct / sqrt(st(ct) %*% ct) ct <- ct / c(sqrt(st(as.vector(ct)) %*% as.vector(ct))) At <- a %*% st(ct) - ct %*% st(a) salph <- sqrt(1 - abt ** 2) calph <- abt Id <- diag(rep(1, times = d)) U2 <- Id + salph * At + (calph - 1) * (a %*% st(a) + ct %*% st(ct)) yst1 <- t(H) %*% U1 %*% preshape(zst1) yst2 <- t(H) %*% U2 %*% preshape(zst2) ybind <- cbind(yst1, yst2) zr1 <- array(0, c(k, 2, nsam1)) zr2 <- array(0, c(k, 2, nsam2)) zr3 <- array(0, c(k, 2, nsam1 + nsam2)) zr1[, 1, ] <- Re(zst1) zr1[, 2, ] <- Im(zst1) zr2[, 1, ] <- Re(zst2) zr2[, 2, ] <- Im(zst2) zr3[, 1, ] <- cbind(Re(zst1), Re(zst2)) zr3[, 2, ] <- cbind(Im(zst1), Im(zst2)) yr1 <- array(0, c(k, 2, nsam1)) yr2 <- array(0, c(k, 2, nsam2)) yr3 <- array(0, c(k, 2, nsam1 + nsam2)) yr1[, 1, ] <- Re(yst1) yr1[, 2, ] <- Im(yst1) yr2[, 1, ] <- Re(yst2) yr2[, 2, ] <- Im(yst2) yr3[, 1, ] <- cbind(Re(yst1), Re(yst2)) yr3[, 2, ] <- cbind(Im(yst1), Im(yst2)) Gtem <- Goodall2D(zr1, zr2) Htem <- Hotelling2D(zr1, zr2) Jtem <- Hotelling2Djames(zr1, zr2) Gumc <- Gtem$F Humc <- Htem$F Jumc <- Jtem$Tsq Gtabpval <- Gtem$pval Htabpval <- Htem$pval Jtabpval <- Jtem$pval if (B > 0) { Tu <- rep(0, times = B) Gu <- Tu Hu <- Tu Ju <- Tu cat("Resampling...") cat(c("No of resamples = ", B, "\n")) if (permutation) { cat("Permutations - sampling without replacement \n") } if (permutation == FALSE) { cat("Bootstrap - sampling with replacement \n") } for (i in 1:B) { cat(c(i, " ")) select1 <- sample(1:nsam1, replace = TRUE) select2 <- sample(1:nsam2, replace = TRUE) zb1 <- yst1[, select1] zb2 <- yst2[, select2] zbgh1 <- yr1[, , select1] zbgh2 <- yr2[, , select2] if (permutation) { select0 <- sample(c(1:(nsam1 + nsam2)), (nsam1 + nsam2), replace = FALSE) select1 <- select0[1:nsam1] select2 <- select0[(nsam1 + 1):(nsam1 + nsam2)] zb1 <- zr3[, 1, select1] + 1i * zr3[, 2, select1] zb2 <- zr3[, 1, select2] + 1i * zr3[, 2, select2] zbgh1 <- yr3[, , select1] zbgh2 <- yr3[, , select2] } LL <- (MGM(zb1) + MGM(zb2)) * (nsam1 + nsam2) LL1 <- cbind(Re(LL), Im(LL)) LL2 <- cbind(-Im(LL), Re(LL)) LL <- rbind(LL1, LL2) #lmin<-min(eigen(LL,symmetric=TRUE,only.values=TRUE,EISPACK=TRUE)$values) lmin <- min(eigen(LL, symmetric = TRUE, only.values = TRUE)$values) Tu[i] <- lmin Gu[i] <- Goodall2D(zbgh1, zbgh2)$F Hu[i] <- Hotelling2D(zbgh1, zbgh2)$F Ju[i] <- Hotelling2Djames(zbgh1, zbgh2)$Tsq } Tu <- sort(Tu) numbig <- length(Tu[Tumc < Tu]) pvalb <- (1 + numbig) / (B + 1) Gu <- sort(Gu) numbig <- length(Gu[Gumc < Gu]) pvalG <- (1 + numbig) / (B + 1) Hu <- sort(Hu) numbig <- length(Hu[Humc < Hu]) pvalH <- (1 + numbig) / (B + 1) Ju <- sort(Ju) numbig <- length(Ju[Jumc < Ju]) pvalJ <- (1 + numbig) / (B + 1) cat(" \n") out <- list( lambda = 0, lambda.pvalue = 0, lambda.table.pvalue = 0, H = 0, H.pvalue = 0, H.table.pvalue = 0, J = 0, J.pvalue = 0, J.table.pvalue = 0, G = 0, G.pvalue = 0, G.table.pvalue = 0 ) out$lambda <- Tumc out$lambda.pvalue <- pvalb out$lambda.table.pvalue <- 1 - pchisq(Tumc, 2 * k - 4) out$H <- Humc out$H.pvalue <- pvalH out$H.table.pvalue <- Htabpval out$J <- Jumc out$J.pvalue <- pvalJ out$J.table.pvalue <- Jtabpval out$G <- Gumc out$G.pvalue <- pvalG out$G.table.pvalue <- Gtabpval } if (resamples == 0) { out <- list( lambda = 0, lambda.table.pvalue = 0, H = 0, H.table.pvalue = 0, J = 0, J.table.pvalue = 0, G = 0, G.table.pvalue = 0 ) out$lambda <- Tumc out$lambda.table.pvalue <- 1 - pchisq(Tumc, 2 * k - 4) out$H <- Humc out$H.table.pvalue <- Htabpval out$J <- Jumc out$J.table.pvalue <- Jtabpval out$G <- Gumc out$G.table.pvalue <- Gtabpval } out } #================================================================================== prcomp1 <- function (x, retx = TRUE, center = TRUE, scale. = FALSE, tol = NULL, svd = TRUE) { x <- as.matrix(x) x <- scale(x, center = center, scale = scale.) if (svd == FALSE) { a <- eigen(cov(x)) r <- list(sdev = 0, rotation = 0, x = 0) r$sdev <- sqrt(abs(a$values)) r$rotation <- a$vectors r$x <- x %*% a$vectors } else { s <- svd(x, nu = 0) if (!is.null(tol)) { rank <- sum(s$d > (s$d[1] * tol)) if (rank < ncol(x)) s$v <- s$v[, 1:rank, drop = FALSE] } s$d <- s$d / sqrt(max(1, nrow(x) - 1)) dimnames(s$v) <- list(colnames(x), paste("PC", seq(len = ncol(s$v)), sep = "")) r <- list(sdev = s$d, rotation = s$v) if (retx) r$x <- x %*% s$v class(r) <- "prcomp1" } r } #================================================================================== defplotsize3 <- function(Y) { out <- list( xl = 0, yl = 0, zl = 0, xu = 0, yu = 0, zu = 0, width = 0 ) n <- dim(Y)[3] xm <- mean(Y[, 1,]) ym <- mean(Y[, 2,]) zm <- mean(Y[, 3,]) x <- Y x[, 1,] <- Y[, 1,] - xm x[, 2,] <- Y[, 2,] - ym x[, 3,] <- Y[, 3,] - zm mn1 <- min(x[, 1, ]) mn2 <- min(x[, 2, ]) mn3 <- min(x[, 3, ]) mx1 <- max(x[, 1, ]) mx2 <- max(x[, 2, ]) mx3 <- max(x[, 3, ]) xl <- -max(-mn1, mx1) yl <- -max(-mn2, mx2) zl <- -max(-mn3, mx3) width <- max(-2 * xl,-2 * yl,-2 * zl) out$xl <- -width / 2 * 1.2 + xm out$yl <- -width / 2 * 1.2 + ym out$zl <- -width / 2 * 1.2 + zm out$xu <- width / 2 * 1.2 + xm out$yu <- width / 2 * 1.2 + ym out$zu <- width / 2 * 1.2 + zm out$width <- width * 1.2 out } #================================================================================== procOPA <- function(A, B, scale = TRUE, reflect = FALSE) { out <- list( R = 0, s = 0, Ahat = 0, Bhat = 0, OSS = 0, rmsd = 0 ) if (is.complex(sum(A)) == TRUE) { k <- length(A) Areal <- matrix(0, k, 2) Areal[, 1] <- Re(A) Areal[, 2] <- Im(A) A <- Areal } if (is.complex(sum(B)) == TRUE) { k <- length(B) Breal <- matrix(0, k, 2) Breal[, 1] <- Re(B) Breal[, 2] <- Im(B) B <- Breal } k <- dim(A)[1] if (reflect == FALSE) { R <- fort.ROTATION(A, B) } else { R <- fort.ROTATEANDREFLECT(A, B) } s <- 1 if (scale == TRUE) { s <- fos(A, B) if (reflect == TRUE) { s <- fos.REFLECT(A, B) } } Ahat <- fcnt(A) Bhat <- fcnt(B) %*% R * s resid <- Ahat - Bhat OSS <- sum(diag(t(resid) %*% resid)) out$R <- R out$s <- s out$Ahat <- Ahat out$Bhat <- Bhat m <- dim(Ahat)[2] out$OSS <- OSS out$rmsd <- sqrt(OSS / (k)) out } #================================================================================== defplotsize2 <- function(Y, project = c(1, 2)) { out <- list( xl = 0, yl = 0, xu = 0, yu = 0, width = 0 ) n <- dim(Y)[3] xm <- mean(Y[, project[1],]) ym <- mean(Y[, project[2],]) x <- Y x[, project[1],] <- Y[, project[1],] - xm x[, project[2],] <- Y[, project[2],] - ym out <- list(xl = 0, yl = 0, width = 0) mn1 <- min(x[, project[1], ]) mn2 <- min(x[, project[2], ]) mx1 <- max(x[, project[1], ]) mx2 <- max(x[, project[2], ]) xl <- -max(-mn1, mx1) yl <- -max(-mn2, mx2) width <- max(-2 * xl,-2 * yl) out$xl <- -width / 2 * 1.2 + xm out$yl <- -width / 2 * 1.2 + ym out$xu <- width / 2 * 1.2 + xm out$yu <- width / 2 * 1.2 + ym out$width <- width * 1.2 out } #================================================================================== plotshapes <- function(A, B = 0, joinline = c(1, 1), orthproj = c(1, 2), color = 1, symbol = 1) { CHECKOK <- TRUE if (is.array(A) == FALSE) { if (is.matrix(A) == FALSE) { cat("Error !! argument should be an array or matrix \n") CHECKOK <- FALSE } } if (CHECKOK) { k <- dim(A)[1] m <- dim(A)[2] kk <- k if (k >= 15) { kk <- 1 } par(pty = "s") #if (length(c(B))==1){ #par(mfrow=c(1,1)) #} if (length(c(B)) != 1) { par(mfrow = c(1, 2)) } if (length(dim(A)) == 3) { A <- A[, orthproj, ] } if (is.matrix(A) == TRUE) { a <- array(0, c(k, 2, 1)) a[, , 1] <- A[, orthproj] A <- a } out <- defplotsize2(A) width <- out$width if (length(c(B)) != 1) { if (length(dim(B)) == 3) { B <- B[, orthproj, ] } if (is.matrix(B) == TRUE) { a <- array(0, c(k, 2, 1)) a[, , 1] <- B[, orthproj] B <- a } ans <- defplotsize2(B) width <- max(out$width, ans$width) } n <- dim(A)[3] lc <- length(color) lt <- k * m * n / lc color <- rep(color, times = lt) lc <- length(symbol) lt <- k * m * n / lc symbol <- rep(symbol, times = lt) plot( A[, , 1], xlim = c(out$xl, out$xl + width), ylim = c(out$yl, out$yl + width), type = "n", xlab = " ", ylab = " " ) for (i in 1:n) { select <- ((i - 1) * k * m + 1):(i * k * m) points(A[, , i], pch = symbol[select], col = color[select]) lines(A[joinline, , i]) } if (length(c(B)) != 1) { A <- B if (is.matrix(A) == TRUE) { a <- array(0, c(k, 2, 1)) a[, , 1] <- A A <- a } out <- defplotsize2(A) n <- dim(A)[3] plot( A[, , 1], xlim = c(ans$xl, ans$xl + width), ylim = c(ans$yl, ans$yl + width), type = "n", xlab = " ", ylab = " " ) for (i in 1:n) { points(A[, , i], pch = symbol[select], col = color[select]) lines(A[joinline, , i]) } } } } #================================================================================== BoxM <- function(A, B, npc) { #carries out Box's M test #(see Mardia, Kent, Bibby 1979, p140) #in: data arrays A, B #out: z$M M statistic # z$df degrees of freedom for approx distn of chi-squared statistic # z$pval p-value z <- list(M = 0, df = 0, pval = 0) n1 <- dim(A)[3] n2 <- dim(B)[3] k <- dim(A)[1] m <- dim(A)[2] if (m > 2) { print("Only works for 2D data at the moment!") } if (m == 2) { C <- array(0, c(k, m, n1 + n2)) C[, , 1:n1] <- A C[, , (n1 + 1):(n1 + n2)] <- B Cpr <- procrustes2d(C, 1, 2) p <- npc ng <- 2 n <- n1 + n2 S1 <- var(t(Cpr$tan[1:npc, 1:n1])) S2 <- var(t(Cpr$tan[1:npc, (n1 + 1):(n1 + n2)])) Su <- ((n1 - 1) * S1 + (n2 - 1) * S2) / (n1 + n2 - 2) S1inv <- eigen(S1)$vectors %*% diag(1 / eigen(S1)$values) %*% t(eigen(S1)$vectors) S2inv <- eigen(S2)$vectors %*% diag(1 / eigen(S2)$values) %*% t(eigen(S2)$vectors) logdet1 <- sum(log(eigen(S1inv %*% Su)$values)) logdet2 <- sum(log(eigen(S2inv %*% Su)$values)) gam <- 1 - ((2 * p ^ 2 + 3 * p - 1) / (6 * (p + 1) * (ng - 1))) * (1 / (n1 - 1) + 1 / (n2 - 1) - 1 / (n - ng)) M <- gam * ((n1 - 1) * logdet1 + (n2 - 1) * logdet2) df <- (p * (p + 1) * (ng - 1)) / 2 pval <- 1 - pchisq(M, df) z$M <- M z$df <- df z$pval <- pval } return(z) } #================================================================================== Goodall2D <- function(A, B) { #Calculates Goodall's two sample F test for 2d data only #in: data arrays A, B k x 2 x n data arrays #out: z$F F statistic # z$df1, z$df2 degrees of freedom # z$pval: p-value z <- list( F = 0, pval = 0, df1 = 0, df2 = 0 ) n1 <- dim(A)[3] n2 <- dim(B)[3] k <- dim(A)[1] m <- dim(A)[2] if (m != 2) { print("Data not two dimensional") return(z) } p <- 2 * k - 4 Apr <- procrustes2d(A, 1, 2) Bpr <- procrustes2d(B, 1, 2) top <- sin(riemdist(Apr$mshape, Bpr$mshape)) ^ 2 bot <- Apr$rmsd1 ^ 2 * n1 + Bpr$rmsd1 ^ 2 * n2 Fstat <- ((n1 + n2 - 2) / (1 / n1 + 1 / n2) * top) / bot pval <- 1 - pf(Fstat, p, (n1 + n2 - 2) * p) z$F <- Fstat z$pval <- pval z$df1 <- p z$df2 <- (n1 + n2 - 2) * p return(z) } #================================================================================== Goodalltest <- function(A, B, tol1 = 1e-07, tol2 = tol1) { #Calculates Goodall's two sample F test #in: data arrays A, B: #out: z$F F statistic # z$df1, z$df2 degrees of freedom # z$pval: p-value z <- list( F = 0, pval = 0, df1 = 0, df2 = 0 ) n1 <- dim(A)[3] n2 <- dim(B)[3] k <- dim(A)[1] m <- dim(A)[2] p <- min(k * m - (m * (m - 1)) / 2 - 1 - m, n1 + n2 - 2) Apr <- procrustesGPA(A, tol1, tol2) Bpr <- procrustesGPA(B, tol1, tol2) top <- sin(riemdist(Apr$mshape, Bpr$mshape)) ^ 2 bot <- Apr$rmsd1 ^ 2 * n1 + Bpr$rmsd1 ^ 2 * n2 Fstat <- ((n1 + n2 - 2) / (1 / n1 + 1 / n2) * top) / bot pval <- 1 - pf(Fstat, p, (n1 + n2 - 2) * p) z$F <- Fstat z$pval <- pval z$df1 <- p z$df2 <- (n1 + n2 - 2) * p return(z) } #================================================================================== Hotelling2D <- function (A, B) { z <- list( Tsq.partition = 0, Tsq = 0, F.partition = 0, F = 0, pval = 0, df1 = 0, df2 = 0, T.df1 = 0, T.df2 = 0 ) n1 <- dim(A)[3] n2 <- dim(B)[3] n <- n1 + n2 k <- dim(A)[1] m <- dim(B)[2] if (m != 2) { print("Data not two dimensional") return(z) } else { pool <- array(0, c(k, m, n)) pool[, , 1:n1] <- A pool[, , (n1 + 1):n] <- B poolpr <- procrustes2d(pool, 1, 2) S1 <- var(t(poolpr$tan[, 1:n1])) S2 <- var(t(poolpr$tan[, (n1 + 1):(n1 + n2)])) gamma <- realtocomplex(preshape(poolpr$mshape)) Sw <- ((n1 - 1) * S1 + (n2 - 1) * S2) / (n1 + n2 - 2) p <- 2 * k - 4 # pcar <- eigen(Sw,EISPACK=TRUE)$vectors[, 1:p] pcar <- eigen(Sw)$vectors[, 1:p] pcasd <- sqrt(abs(eigen(Sw)$values[1:p])) ####### add small offset if defecient in rank if (pcasd[p] < 0.000001) { offset <- 0.000001 cat("*") pcasd <- sqrt(pcasd ** 2 + offset ** 2) } ####################################### pcax <- t(poolpr$tan) %*% pcar h <- defh(k - 1) zero <- matrix(0, k - 1, k) H <- cbind(h, zero) H1 <- cbind(zero, h) H <- rbind(H, H1) meanxy <- t(H) %*% V(gamma) realrot <- t(H) %*% pcar one1 <- matrix(1 / n1, n1, 1) one2 <- matrix(1 / n2, n2, 1) oneone <- rbind(one1,-one2) vbar <- poolpr$tan %*% oneone scores1 <- matrix(vbar, 1, (2 * k - 2)) %*% pcar scores <- scores1 / pcasd F.partition <- ((scores[1:p] ^ 2) * (n1 * n2 * (n1 + n2 - p - 1))) / ((n1 + n2) * (n1 + n2 - 2) * p) FF <- sum(F.partition) pval <- 1 - pf(FF, p, (n1 + n2 - p - 1)) z$F.partition <- F.partition z$F <- FF z$pval <- pval z$df1 <- p z$T.df1 <- p z$df2 <- (n1 + n2 - p - 1) mm <- n - 2 z$T.df2 <- mm z$Tsq <- FF * (n1 + n2) * (n1 + n2 - 2) * p / (n1 * n2) / (n1 + n2 - p - 1) z$Tsq.partition <- F.partition * (n1 + n2) * (n1 + n2 - 2) * p / (n1 * n2) / (n1 + n2 - p - 1) return(z) } } #================================================================================== Hotellingtest <- function (A, B, tol1 = 1e-07, tol2 = 1e-07) { z <- list( Tsq.partition = 0, Tsq = 0, F.partition = 0, F = 0, pval = 0, df1 = 0, df2 = 0, T.df1 = 0, T.df2 = 0 ) n1 <- dim(A)[3] n2 <- dim(B)[3] n <- n1 + n2 k <- dim(A)[1] m <- dim(B)[2] pool <- array(0, c(k, m, n)) pool[, , 1:n1] <- A pool[, , (n1 + 1):n] <- B poolpr <- procrustesGPA(pool, tol1, tol2, approxtangent = FALSE) S1 <- var(t(poolpr$tan[, 1:n1])) S2 <- var(t(poolpr$tan[, (n1 + 1):(n1 + n2)])) Sw <- ((n1 - 1) * S1 + (n2 - 1) * S2) / (n1 + n2 - 2) p <- min(k * m - (m * (m - 1)) / 2 - 1 - m, n1 + n2 - 2) eva <- eigen(Sw, symmetric = TRUE) pcar <- eva$vectors[, 1:p] pcasd <- sqrt(abs(eva$values[1:p])) ####### add small offset if defecient in rank if (pcasd[p] < 0.000001) { offset <- 0.000001 cat("*") pcasd <- sqrt(pcasd ** 2 + offset) } ####################################### lam <- rep(0, times = (k * m - m)) lam[1:p] <- 1 / pcasd ** 2 Suinv <- eva$vectors %*% diag(lam) %*% t(eva$vectors) # check <- p # for (i in 1:p) { # if (pcasd[p + 1 - i] < 1e-04) { # check <- p + 1 - i - 1 # } # } # p <- check pcax <- t(poolpr$tan) %*% pcar one1 <- matrix(1 / n1, n1, 1) one2 <- matrix(1 / n2, n2, 1) oneone <- rbind(one1,-one2) vbar <- poolpr$tan %*% oneone scores1 <- matrix(vbar, 1, m * k - m) %*% pcar scores <- scores1 / pcasd # tem<-c(t(vbar)%*%Suinv%*%vbar) #(=Dsq)# F.partition <- ((scores[1:p] ^ 2) * (n1 * n2 * (n1 + n2 - p - 1))) / ((n1 + n2) * (n1 + n2 - 2) * p) FF <- sum(F.partition) pval <- 1 - pf(FF, p, (n1 + n2 - p - 1)) z$F.partition <- F.partition z$F <- FF z$pval <- pval z$df1 <- p z$T.df1 <- p z$df2 <- (n1 + n2 - p - 1) mm <- n - 2 z$T.df2 <- mm z$Tsq <- FF * (n1 + n2) * (n1 + n2 - 2) * p / (n1 * n2) / (n1 + n2 - p - 1) z$Tsq.partition <- F.partition * (n1 + n2) * (n1 + n2 - 2) * p / (n1 * n2) / (n1 + n2 - p - 1) return(z) } # Hotellingtest<-function(A, B, tol1=1e05,tol2=1e05) # OLD VERSION using $tan rather than $tanpartial #{ #Calculates two sample Hotelling Tsq test for testing whether #mean shapes are equal (m - Dimensions where m >= 2) #in: A, B the k x m x n arrays of data for each group #out: z$F : F-statistic # z$df1, z$df2 : dgrees of freedom # z$pval: pvalue # z <- list(Tsq.partition = 0, Tsq = 0, F.partition = 0, F = 0, pval = 0, # df1 = 0, df2 = 0, T.df1 = 0, T.df2 = 0) # n1 <- dim(A)[3] # n2 <- dim(B)[3] # n <- n1 + n2 # k <- dim(A)[1] # m <- dim(B)[2] # pool <- array(0, c(k, m, n)) # pool[, , 1:n1] <- A # pool[, , (n1 + 1):n] <- B # poolpr <- procrustesGPA(pool,tol1,tol2) # S1 <- var(t(poolpr$tan[, 1:n1])) # S2 <- var(t(poolpr$tan[, (n1 + 1):(n1 + n2)])) # Sw <- ((n1 - 1) * S1 + (n2 - 1) * S2)/(n1 + n2 - 2) # p <- min(k * m - (m * (m - 1))/2 - 1 - m, n1 + n2 - 2) # pcar <- eigen(Sw)$vectors[, 1:p] # pcasd <- sqrt(eigen(Sw)$values[1:p]) # check<-p ## checks to see if rank is reasonable # for (i in 1:p){ # if (pcasd[p+1-i] < 0.0001){ # check<-p+1-i-1 # } # } # p<-check # pcax <- t(poolpr$tan) %*% pcar # one1 <- matrix(1/n1, n1, 1) # one2 <- matrix(1/n2, n2, 1) # oneone <- rbind(one1, - one2) # vbar <- poolpr$tan %*% oneone # scores1 <- matrix(vbar, 1, m*k) %*% pcar # scores <- scores1/pcasd # F.partition <- ((scores[1:p]^2) * (n1 * n2 * (n1 + n2 - p - 1)))/((n1 + # n2) * (n1 + n2 - 2) * p) # FF <- sum(F.partition) # pval <- 1 - pf(FF, p, (n1 + n2 - p - 1)) # z$F.partition <- F.partition # z$F <- FF # z$pval <- pval # z$df1 <- p # z$T.df1 <- p # z$df2 <- (n1 + n2 - p - 1) # mm <- n - 2 # z$T.df2 <- mm # z$Tsq <- (FF * (mm * p))/(mm - p + 1) # z$Tsq.partition <- (F.partition * (mm * p))/(mm - p + 1) # return(z) #} #================================================================================== I2mat <- function(Be) { zero <- rep(0, times = dim(Be)[1] ^ 2) zero <- matrix(zero, dim(Be)[1], dim(Be)[2]) temp <- cbind(Be, zero) temp1 <- cbind(zero, Be) tem <- rbind(temp, temp1) tem } #================================================================================== tpsgrid.old <- function (TT, YY, xbegin = -999, ybegin = -999, xwidth = -999, opt = 2, ext = 0.1, ngrid = 22, cex = 1, pch = 20, col = 2) { k <- nrow(TT) if (xwidth == -999) { bb <- array(TT, c(dim(TT), 1)) aa <- defplotsize2(bb) xwidth <- aa$width } if (xbegin == -999) { bb <- array(TT, c(dim(TT), 1)) aa <- defplotsize2(bb) xbegin <- aa$xl } if (ybegin == -999) { bb <- array(TT, c(dim(TT), 1)) aa <- defplotsize2(bb) ybegin <- aa$yl } xstart <- xbegin ystart <- ybegin ngrid <- trunc(ngrid / 2) * 2 kx <- ngrid ky <- ngrid - 1 l <- kx * ky step <- xwidth / (kx - 1) r <- 0 X <- rep(0, times = kx) Y2 <- rep(0, times = ky) for (p in 1:kx) { ystart <- ybegin xstart <- xstart + step for (q in 1:ky) { ystart <- ystart + step r <- r + 1 X[r] <- xstart Y2[r] <- ystart } } refc <- matrix(c(X, Y2), kx * ky, 2) TPS <- bendingenergy(TT) gamma11 <- TPS$gamma11 gamma21 <- TPS$gamma21 gamma31 <- TPS$gamma31 W <- gamma11 %*% YY ta <- t(gamma21 %*% YY) B <- gamma31 %*% YY WtY <- t(W) %*% YY trace <- c(0) for (i in 1:2) { trace <- trace + WtY[i, i] } benergy <- 16 * pi * trace if (m == 3) { benergy <- 8 * pi * trace } l <- kx * ky phi <- matrix(0, l, 2) s <- matrix(0, k, 1) for (i in 1:l) { s <- matrix(0, k, 1) for (m in 1:k) { s[m,] <- sigmacov(refc[i,] - TT[m,]) } phi[i,] <- ta + t(B) %*% refc[i,] + t(W) %*% s } par(pty = "s") if (opt == 2) { par(mfrow = c(1, 2)) order <- linegrid(refc, kx, ky) plot( order[1:l, 1], order[1:l, 2], type = "l", xlim = c(xbegin - xwidth * ext, xbegin + xwidth * (1 + ext)), ylim = c( ybegin - (xwidth * ky) / kx * ext, ybegin + (xwidth * ky) / kx * (1 + ext) ), xlab = " ", ylab = " " ) lines(order[(l + 1):(2 * l), 1], order[(l + 1):(2 * l), 2], type = "l") points(TT, cex = cex, pch = pch, col = col) } order <- linegrid(phi, kx, ky) plot( order[1:l, 1], order[1:l, 2], type = "l", xlim = c(xbegin - xwidth * ext, xbegin + xwidth * (1 + ext)), ylim = c(ybegin - (xwidth * ext * ky) / kx, ybegin + (xwidth * (1 + ext) * ky) / kx), xlab = " ", ylab = " " ) lines(order[(l + 1):(2 * l), 1], order[(l + 1):(2 * l), 2], type = "l") points(YY, cex = cex, pch = pch, col = col) } # # #================================================================================== V <- function(z) { #input complex k -vector #ouput vectorized 2k vector of real stacked on imaginary components x <- c(Re(z), Im(z)) x } #================================================================================== Vinv <- function(x) { #input vectorized 2k vector of x1 stacked on x2 components #input complex k -vector of the form x1 + 1i*x2 nel <- length(x) / 2 zx <- x[1:nel] zy <- x[(nel + 1):(2 * nel)] z <- zx + (1i) * zy z } #================================================================================== Vmat <- function(z) { #as Vinv but input is a k x n complex matrix # output 2k x n matrix of stacked real then complex components x <- rbind(Re(z), Im(z)) x } #================================================================================== bendingenergy <- function (TT) { z <- list( gamma11 = 0, gamma21 = 0, gamma31 = 0, prinwarps = 0, prinwarpeval = 0, Un = 0 ) k <- nrow(TT) m <- dim(TT)[2] S <- matrix(0, k, k) for (i in 1:k) { for (j in 1:k) { S[i, j] <- sigmacov(TT[i,] - TT[j,]) } } one <- matrix(1, k, 1) zero <- matrix(0, m + 1, m + 1) # P <- cbind(S, one, TT) P <- rbind(S, t(one)) Q <- rbind(P, t(TT)) O <- cbind(one, TT) U <- rbind(O, zero) star <- cbind(Q, U) star <- matrix(star, k + m + 1, k + m + 1) A <- eigen(star, symmetric = TRUE) deltainv <- diag(1 / A$values) gamma <- A$vectors starinv <- gamma %*% deltainv %*% t(gamma) gamma11 <- matrix(0, k, k) for (i in 1:k) { for (j in 1:k) { gamma11[i, j] <- starinv[i, j] } } gamma21 <- matrix(0, 1, k) for (i in 1:1) { for (j in 1:k) { gamma21[i, j] <- starinv[k + 1, j] } } gamma31 <- matrix(0, m, k) for (i in 1:(m)) { for (j in 1:k) { gamma31[i, j] <- starinv[i + k + 1, j] } } prinwarp <- eigen(gamma11, symmetric = TRUE) prinwarps <- prinwarp$vectors prinwarpeval <- prinwarp$values ####need to rotate to compute affine components Rot <- prcomp(TT)$rotation TT <- TT %*% Rot if (m == 2) { meanxy <- c(TT[, 1], TT[, 2]) alpha <- sum(meanxy[1:k] ^ 2) beta <- sum(meanxy[(k + 1):(2 * k)] ^ 2) u1 <- c(alpha * meanxy[(k + 1):(2 * k)], beta * meanxy[1:k]) u2 <- c(-beta * meanxy[1:k], alpha * meanxy[(k + 1):(2 * k)]) u1 <- u1 / sqrt(alpha * beta) / sqrt(alpha + beta) u2 <- u2 / sqrt(alpha * beta) / sqrt(alpha + beta) Un <- matrix(0, 2 * k, 2) Un[, 1] <- u1 Un[, 2] <- u2 Vn <- Un Vn[, 1] <- cbind(Un[1:k, 1], Un[(k + 1):(2 * k), 1]) %*% t(Rot) Vn[, 2] <- cbind(Un[1:k, 2], Un[(k + 1):(2 * k), 2]) %*% t(Rot) Un <- Vn } if (m == 3) { meanxy <- c(TT[, 1], TT[, 2], TT[, 3]) alpha <- sum(meanxy[1:k] ^ 2) beta <- sum(meanxy[(k + 1):(2 * k)] ^ 2) gamma <- sum(meanxy[(2 * k + 1):(3 * k)] ^ 2) mu <- meanxy[1:k] nu <- meanxy[(k + 1):(2 * k)] omega <- meanxy[(2 * k + 1):(3 * k)] ze <- rep(0, times = k) u1 <- c(ze , alpha * beta * omega , alpha * gamma * nu) / sqrt(alpha ^ 2 * beta ^ 2 * gamma + alpha ^ 2 * gamma ^ 2 * beta) u2 <- c(alpha * beta * omega , ze, beta * gamma * mu) / sqrt(beta ^ 2 * alpha ^ 2 * gamma + beta ^ 2 * gamma ^ 2 * alpha) u3 <- c(alpha * gamma * nu , beta * gamma * mu, ze) / sqrt(alpha ^ 2 * gamma ^ 2 * beta + beta ^ 2 * gamma ^ 2 * alpha) u4 <- c(ze , ze , omega) / sqrt(gamma) u5 <- c(-beta * gamma * mu , alpha * gamma * nu, ze) / sqrt(alpha * gamma ^ 2 * beta ^ 2 + beta * gamma ^ 2 * alpha ^ 2) tem <- c(-gamma * beta * mu , ze, beta * alpha * omega) / sqrt(beta ^ 2 * alpha * gamma ^ 2 + beta ^ 2 * gamma * alpha ^ 2) tem2 <- tem - u5 * sum(u5 * tem) u4 <- tem2 / Enorm(tem2) Un <- matrix(0, 3 * k, 5) Un[, 1] <- u1 Un[, 2] <- u2 Un[, 3] <- u3 Un[, 4] <- u4 Un[, 5] <- u5 Vn <- Un Vn[, 1] <- cbind(Un[1:k, 1], Un[(k + 1):(2 * k), 1], Un[(2 * k + 1):(3 * k), 1]) %*% t(Rot) Vn[, 2] <- cbind(Un[1:k, 2], Un[(k + 1):(2 * k), 2], Un[(2 * k + 1):(3 * k), 2]) %*% t(Rot) Vn[, 3] <- cbind(Un[1:k, 3], Un[(k + 1):(2 * k), 3], Un[(2 * k + 1):(3 * k), 3]) %*% t(Rot) Vn[, 4] <- cbind(Un[1:k, 4], Un[(k + 1):(2 * k), 4], Un[(2 * k + 1):(3 * k), 4]) %*% t(Rot) Vn[, 5] <- cbind(Un[1:k, 5], Un[(k + 1):(2 * k), 5], Un[(2 * k + 1):(3 * k), 5]) %*% t(Rot) Un <- Vn } z$gamma11 <- gamma11 z$gamma21 <- gamma21 z$gamma31 <- gamma31 z$prinwarps <- prinwarps z$prinwarpeval <- prinwarpeval z$Un <- Un return(z) } #================================================================================== shaperw <- function(proc , alpha = 1, affine = FALSE) { rw <- proc if ((alpha != 0) || (affine == TRUE)) { k <- dim(proc$mshape)[1] m <- dim(proc$mshape)[2] n <- dim(proc$mshape)[3] if (dim(proc$tan)[1] == (k * m - m)) { if (m == 2) { He <- t(defh(k - 1)) Ze <- He * 0 HH <- rbind(cbind(He, Ze) , cbind(Ze, He)) proc$tan <- HH %*% proc$tan } if (m == 3) { He <- t(defh(k - 1)) Ze <- He * 0 HH <- rbind(cbind(He, Ze, Ze) , cbind(Ze, He , Ze) , cbind(Ze, Ze, He)) proc$tan <- HH %*% proc$tan } } nconstr <- m + m * (m - 1) / 2 + 1 M <- k * m - nconstr if (m == 2) { bb <- bendingenergy(proc$mshape) Gamma11 <- bb$gamma11 Be <- rbind(cbind(Gamma11, Gamma11 * 0) , cbind(Gamma11 * 0, Gamma11)) Un <- bb$Un Bedim <- 2 } if (m == 3) { bb <- bendingenergy(proc$mshape) Gamma11 <- bb$gamma11 Ze <- Gamma11 * 0 Be <- rbind(cbind(Gamma11, Ze, Ze) , cbind(Ze, Gamma11, Ze) , cbind(Ze, Ze, Gamma11)) Un <- bb$Un Bedim <- 5 } ev <- eigen(Be, symmetric = TRUE) evpw <- eigen(Gamma11, symmetric = TRUE) Beminusalpha <- ev$vectors %*% diag(c(ev$values[1:(M - Bedim)] ** (-alpha / 2), rep(0, times = nconstr + Bedim))) %*% t(ev$vectors) Bealpha <- ev$vectors %*% diag(c(ev$values[1:(M - Bedim)] ** (alpha / 2), rep(0, times = nconstr + Bedim))) %*% t(ev$vectors) evbe <- ev SS <- Beminusalpha %*% var(t(proc$tan)) %*% Beminusalpha ev <- eigen(SS) relw.vec <- ev$vectors relw.sd <- sqrt(abs(ev$values)) # ratio of eigenvalues of warps (quoted in book) rw$percent <- relw.sd ** 2 / sum(relw.sd ** 2) * 100 sgnchange <- sample(c(-1, 1), size = m * k , replace = TRUE) rw$pcar <- Bealpha %*% relw.vec %*% diag(sgnchange) rw$pcasd <- relw.sd rw$rawscores <- t(t(relw.vec) %*% Beminusalpha %*% proc$tan) sd <- sqrt(abs(diag(var((rw$rawscores) )))) rw$scores <- (rw$rawscores) %*% diag(1 / sd) rw$stdscores <- rw$scores rw$scores <- rw$rawscores ## partial warp scores n <- proc$n evbend <- eigen(Gamma11, symmetric = TRUE) partialwarpscores <- array(0 , c(n , m , k)) for (i in 1:m) { partialwarpscores[, i, ] <- t(t(evbend$vectors) %*% proc$rotated[, i, ]) } rw$principalwarps <- evpw$vectors[, (k - m - 1):1] rw$principalwarps.eigenvalues <- evpw$values[(k - m - 1):1] rw$partialwarpscores <- partialwarpscores[, , (k - m - 1):1] sumvar <- rep(0, times = (k - m - 1)) for (i in 1:(k - m - 1)) { sumvar[i] <- sum(diag(var(partialwarpscores[, , k - m - i]))) } rw$partialwarps.percent <- sumvar / sum(proc$pcasd ** 2) * 100 } if (affine == TRUE) { dimun <- dim(Un)[2] rw$pcar <- Un %*% diag(sgnchange[1:(dimun)]) pcno <- c(1:dimun) rw$rawscores <- t(Un) %*% proc$tan sd <- sqrt(abs(diag(var( t(rw$rawscores) )))) rw$pcasd <- sd rw$percent <- sd ** 2 / sum(proc$pcasd ** 2) * 100 rw$scores <- t(rw$rawscores) %*% diag(1 / sd) rw$rawscores <- t(rw$rawscores) ####### tem <- prcomp1((rw$rawscores)) npc <- 0 rw$stdscores <- tem$x for (i in 1:length(tem$sdev)) { if (tem$sdev[i] > 1e-07) { npc <- npc + 1 } } for (i in 1:npc) { rw$stdscores[, i] <- tem$x[, i] / tem$sdev[i] } rw$pcasd <- tem$sdev rw$percent <- tem$sdev ** 2 / sum(proc$pcasd ** 2) * 100 rw$pcar <- Un %*% tem$rotation rw$rawscores <- tem$x rw$scores <- rw$rawscores } rw } #================================================================================== bookstein2d <- function(A, l1 = 1, l2 = 2) { #input: A: k x 2 x n array of 2D data, or k x n complex matrix #l1,l2: baseline choice for sending to (-0.5,0),(0.5,0) #output: z$bshpv - Bookstein shape variables array (including baseline) # z$mshape - Bookstein mean shape (including baseline points) z <- list( k = 0, n = 0, mshape = 0, bshpv = 0 ) if (is.complex(sum(A)) == TRUE) { n <- dim(A)[2] k <- dim(A)[1] B <- array(0, c(k, 2, n)) B[, 1, ] <- Re(A) B[, 2, ] <- Im(A) A <- B } if (is.matrix(A) == TRUE) { bb <- array(A, c(dim(A), 1)) A <- bb } k <- dim(A)[1] m <- 2 n <- dim(A)[3] reorder <- c(l1, l2, c(1:k)[-c(l1, l2)]) A[, , ] <- A[reorder, , 1:n] bshpv <- array(0, c(k, m, n)) for (i in 1:n) { bshpv[, , i] <- bookstein.shpv(A[, , i]) } bookmean <- matrix(0, k, m) for (i in 1:n) { bookmean <- bookmean + bshpv[, , i] } bookmean <- bookmean / n bookmean[reorder, ] <- bookmean bshpv[reorder, ,] <- bshpv glim <- max(-min(bshpv), max(bshpv)) #par(pty="s") #par(mfrow=c(1,1)) #plot(bshpv[,,1],xlim=c(-glim,glim),ylim=c(-glim,glim),type="n",xlab="u",ylab="v") #for (i in 1:n) #{ #for (j in 1:k){ #text(bshpv[j,1,i],bshpv[j,2,i],as.character(j)) #} #} z$mshape <- bookmean z$bshpv <- bshpv z$k <- k z$n <- n return(z) } #================================================================================== bookstein.shpv <- function(x) { #input x: k x 2 matrix or complex k-vector #output u: k x 2 matrix of Bookstein shape variables # with baseline sent to (-0.5,0) (0.5,0) if (is.complex(x)) { x <- complextoreal(x) } nj <- dim(x)[1] j <- rep(1, times = nj) w <- (x[, 1] + (1i) * x[, 2] - (j * (x[1, 1] + (1i) * x[1, 2]))) / (x[2, 1] + (1i) * x[2, 2] - x[1, 1] - (1i) * x[1, 2]) - 0.5 w <- w[1:nj] y <- (Re(w)) z <- (Im(w)) u <- cbind(y, z) u <- matrix(u, nj, 2) u } #================================================================================== bookstein.shpv.complex <- function(z) { #input z: complex k vector #output u: k-2 complex vector of Bookstein shape variables # with baseline sent to (-0.5) (0.5) nj <- length(z) x <- matrix(cbind(Re(z), Im(z)), nj, 2) j <- rep(1, times = nj) w <- (x[, 1] + (1i) * x[, 2] - (j * (x[1, 1] + (1i) * x[1, 2]))) / (x[2, 1] + (1i) * x[2, 2] - x[1, 1] - (1i) * x[1, 2]) - 0.5 u <- w[3:nj] u } #================================================================================== cbevec <- function(z) { t1 <- reassqpr(z) # t2 <- eigen(t1,symmetric=TRUE,EISPACK=TRUE) t2 <- eigen(t1, symmetric = TRUE) reagamma <- t2$vectors[, 1] # print(t2$values/sum(t2$values)) gamma <- Vinv(reagamma) gamma } #================================================================================== cbevectors <- function(z, j) { t1 <- reassqpr(z) # t2 <- eigen(t1,symmetric=TRUE,EISPACK=TRUE) t2 <- eigen(t1, symmetric = TRUE) reagamma <- t2$vectors[, j] gamma <- Vinv(reagamma) gamma } #================================================================================== ild_centroid.size <- function(x) { #returns the centroid size of a configuration (or configurations) #input: k x m matrix/or a complex k-vector # or input a real k x m x n array to get a vector of sizes for a sample if ((is.vector(x) == FALSE) && is.complex(x)) { k <- nrow(x) n <- ncol(x) tem <- array(0, c(k, 2, n)) tem[, 1, ] <- Re(x) tem[, 2, ] <- Im(x) x <- tem } { if (length(dim(x)) == 3) { n <- dim(x)[3] sz <- rep(0, times = n) k <- dim(x)[1] h <- defh(k - 1) for (i in 1:n) { xh <- h %*% x[, , i] sz[i] <- sqrt(sum(diag(t(xh) %*% xh))) } sz } else { if (is.vector(x) && is.complex(x)) { x <- cbind(Re(x), Im(x)) } k <- nrow(x) h <- defh(k - 1) xh <- h %*% x size <- sqrt(sum(diag(t(xh) %*% xh))) size } } } #================================================================================== ild_centroid.size.complex <- function(zstar) { #returns the centroid size of a complex vector zstar h <- defh(nrow(as.matrix(zstar)) - 1) ztem <- h %*% zstar size <- sqrt(diag(Re(st(ztem) %*% ztem))) size } #================================================================================== ild_centroid.size.mD <- function(x) { #returns the centroid size of a k x m matrix if (is.complex(x)) { x <- cbind(Re(x), Im(x)) } k <- nrow(x) h <- defh(k - 1) xh <- h %*% x size <- sqrt(sum(diag(t(xh) %*% xh))) size } #================================================================================== complextoreal <- function(z) { #input complex k-vector - return k x 2 matrix nj <- length(z) x <- matrix(cbind(Re(z), Im(z)), nj, 2) x } #================================================================================== ild_defh <- function(nrow) { #Defines and returns an nrow x (nrow+1) Helmert sub-matrix k <- nrow h <- matrix(0, k, k + 1) j <- 1 while (j <= k) { jj <- 1 while (jj <= j) { h[j, jj] <- -1 / sqrt(j * (j + 1)) jj <- jj + 1 } h[j, j + 1] <- j / sqrt(j * (j + 1)) j <- j + 1 } h } #================================================================================== full.procdist <- function(x, y) { #input k x 2 matrices x, y #output full Procrustes distance rho between x,y sin(riemdist(x, y)) } #================================================================================== genpower <- function(Be, alpha) { k <- dim(Be)[1] if (alpha == 0) { gen <- diag(rep(1, times = k)) } else { l <- k - 3 # eb <- eigen(Be, symmetric = TRUE,EISPACK=TRUE) eb <- eigen(Be, symmetric = TRUE) ev <- c(eb$values[1:l] ^ (-alpha / 2), 0, 0, 0) gen <- eb$vectors %*% diag(ev) %*% t(eb$vectors) gen } } #================================================================================== isotropy.test <- function(sd, p, n) { #LR test for isotropy with Bartlett adjustment #in: sd - square roots of eigenvalues of covariance matrix # p - the number of larger eigenvalues to consider # n - sample size #out: z$bartlett - test statistic (e.g. see Mardia, Kent, Bibby, 1979, p235) # z$pval - p-value z <- list(bartlett = 0, pval = 0) tem <- sd ^ 2 bartlett <- (log(mean(tem[1:p])) - mean(log(tem[1:p]))) * p * (n - (2 * p + 11) / 6) pval <- 1 - pchisq(bartlett, ((p + 2) * (p - 1)) / 2) z$bartlett <- bartlett z$pval <- pval return(z) } #================================================================================== linegrid <- function(ref, kx, ky) { n <- ky m <- kx w <- n * m newgrid1 <- matrix(0, w, 2) v <- m * 0.5 k <- 0 for (l in 1:v) { k <- k + 1 a <- (n + m - 1) * (k - 1) + 1 b <- n * ((2 * k) - 1) d <- 2 * n * k for (j in a:b) { newgrid1[j,] <- ref[j,] } for (u in 1:n) { down <- d - u + 1 up <- b + u newgrid1[up,] <- ref[down,] } } newgrid2 <- matrix(0, w, 2) for (i in 1:v) { z <- (2 * i) - 1 for (x in 1:m) { r1 <- m * (z - 1) + x e <- n * (x - 1) + z newgrid2[r1,] <- ref[e,] } } y <- v - 1 for (p in 1:y) { f <- 2 * p for (q in 1:m) { r2 <- m * (f - 1) + q s <- n * (m - 1) + f - n * (q - 1) newgrid2[r2,] <- ref[s,] } } order <- rbind(newgrid1, newgrid2) order } #================================================================================== mahpreshapedist <- function(z, m, pcar, pcasdev) { if (is.double(z) == TRUE) z <- realtocomplex(z) if (is.double(m) == TRUE) m <- realtocomplex(m) w <- preshape(z) y <- preshape(m) zp <- project(w, y) k <- length(pcasdev) / 2 if (pcasdev[2 * k - 1] < 1e-07) pcasdev[2 * k - 1] <- 1e+22 if (pcasdev[2 * k] < 1e-07) pcasdev[2 * k] <- 1e+22 Sinv <- (pcar) %*% diag(1 / pcasdev ^ 2) %*% t(pcar) Z <- V(zp) d2 <- t(Z) %*% Sinv %*% (Z) dist <- sqrt(d2) dist } makearray <- function(x, k, m, n) { #makes a k x m x n array from a dataset read in as a table tem <- c(t(x)) tem <- array(tem, c(m, k, n)) tem <- aperm(tem, c(2, 1, 3)) tem } #================================================================================== movie <- function(mean, pc, sd, xl, xu, yl, yu, lineorder, movielength = 20) { k <- length(mean) / 2 for (i in 1:movielength) { plotPDMnoaxis(mean, pc * (-1) ^ i, sd, xl, xu, yl, yu, lineorder) } plot( mean[c(1:k)], mean[c((k + 1):(2 * k))], xlim = c(xl, xu), ylim = c(yl, yu), xlab = " ", ylab = " ", axes = FALSE ) } #================================================================================== ild_Enorm <- function(X) { #finds Euclidean/Frobenius norm of a matrix X if (is.complex(X)) { n <- sqrt(sum(diag(Re(st(X) %*% X)))) } else { n <- sqrt(sum(diag(t(X) %*% X))) } n } #================================================================================== partial.procdist <- function(x, y) { #input k x 2 matrices x, y #output partial Procrustes distance rho between x,y sqrt(2) * sqrt(1 - cos(riemdist(x, y))) } #================================================================================== partialwarpgrids <- function(TT, YY, xbegin, ybegin, xwidth, nr, nc, mag) { # #affine grid and partial warp grids for the TPS deformation of TT to YY #displayed as an nr x nc array of plots #mag = magnification effect k <- nrow(TT) YY <- TT + (YY - TT) * mag xstart <- xbegin ystart <- ybegin kx <- 22 ky <- 21 l <- kx * ky step <- xwidth / (kx - 1) r <- 0 X <- rep(0, times = 220) Y2 <- rep(0, times = 220) for (p in 1:kx) { ystart <- ybegin xstart <- xstart + step for (q in 1:ky) { ystart <- ystart + step r <- r + 1 X[r] <- xstart Y2[r] <- ystart } } refc <- matrix(c(X, Y2), kx * ky, 2) TPS <- bendingenergy(TT) gamma11 <- TPS$gamma11 gamma21 <- TPS$gamma21 gamma31 <- TPS$gamma31 W <- gamma11 %*% YY ta <- t(gamma21 %*% YY) B <- gamma31 %*% YY WtY <- t(W) %*% YY R <- matrix(0, k, 2) par(mfrow = c(nr, nc)) par(pty = "s") #AFFINEPART phi <- matrix(0, l, 2) s <- matrix(0, k, 1) for (i in 1:l) { s <- matrix(0, k, 1) for (m in 1:k) { s[m,] <- sigmacov(refc[i,] - TT[m,]) } phi[i,] <- ta + t(B) %*% refc[i,] } newpt <- matrix(0, k, 2) for (i in 1:k) { s <- matrix(0, k, 1) for (m in 1:k) { s[m,] <- sigmacov(TT[i,] - TT[m,]) } newpt[i,] <- ta + t(B) %*% TT[i,] } order <- linegrid(phi, kx, ky) plot( order[1:l, 1], order[1:l, 2], type = "l", xlim = c(xbegin - xwidth / 10, xbegin + (xwidth * 11) / 10), ylim = c(ybegin - (xwidth / 10 * ky) / kx, ybegin + ((xwidth * 11) / 10 * ky) / kx), xlab = " ", ylab = " " ) lines(order[(l + 1):(2 * l), 1], order[(l + 1):(2 * l), 2], type = "l") points(newpt, cex = 2) for (jnw in 1:(k - 3)) { nw <- k - 2 - jnw phi <- matrix(0, l, 2) s <- matrix(0, k, 1) for (i in 1:l) { s <- matrix(0, k, 1) for (m in 1:k) { s[m,] <- sigmacov(refc[i,] - TT[m,]) } phi[i,] <- refc[i,] + TPS$prinwarpeval[nw] * t(YY) %*% TPS$prinwarps[, nw] %*% t(TPS$prinwarps[, nw]) %*% s } newpt <- matrix(0, k, 2) for (i in 1:k) { s <- matrix(0, k, 1) for (m in 1:k) { s[m,] <- sigmacov(TT[i,] - TT[m,]) } newpt[i,] <- TT[i,] + TPS$prinwarpeval[nw] * t(YY) %*% TPS$prinwarps[, nw] %*% t(TPS$prinwarps[, nw]) %*% s } R <- newpt - TT + R order <- linegrid(phi, kx, ky) plot( order[1:l, 1], order[1:l, 2], type = "l", xlim = c(xbegin - xwidth / 10, xbegin + (xwidth * 11) / 10), ylim = c(ybegin - (xwidth / 10 * ky) / kx, ybegin + ((xwidth * 11) / 10 * ky) / kx), xlab = " ", ylab = " " ) lines(order[(l + 1):(2 * l), 1], order[(l + 1):(2 * l), 2], type = "l") points(newpt, cex = 2) } #percentage (need to normalize) d2 <- sin(riemdist(YY, TT)) ^ 2 d3 <- sin(riemdist(R + TT, TT)) ^ 2 percentaff <- (d2 - d3) / d2 * 100 print("percent affine") print(percentaff) } #================================================================================== partialwarps <- function(mshape, rotated) { #obtain the affine and partial warp scores for a dataset #where the reference configuration is mshape and the full procrustes #rotated figures are given in the array rotated #output: y$pwpwercent percentage of variability (squared Procrustes distance) # in the direction of each of the affine and principal warps # y$pwscores: the affine and partial warps scores # y <- list(pwpercent = 0, pwscores = 0, unpercent = 0) k <- nrow(mshape) n <- dim(rotated)[3] msh <- mshape rot <- rotated TPS <- bendingenergy(msh) FX <- rot[, 1,] FY <- rot[, 2,] U <- TPS$prinwarps[, 1:(k - 3)] partialX <- t(U) %*% FX partialY <- t(U) %*% FY Un <- TPS$Un UnXY <- t(Un) %*% rbind(FX, FY) scores <- matrix(0, 2 * (k - 3), n) for (i in 1:(k - 3)) { r <- 2 * i - 1 scores[r,] <- partialX[k - 2 - i,] scores[r + 1,] <- partialY[k - 2 - i,] } scores <- rbind(UnXY, scores) percwarp <- rep(0, times = (k - 2)) sumev <- sum(eigen(var(t(scores)))$values) for (i in 1:(k - 2)) { sum1 <- sum(eigen(var(t(scores[(2 * i - 1):(2 * i),])))$values) percwarp[i] <- sum1 / sumev } unpercent <- c(0, 0) unpercent[1] <- var(scores[1,]) / sumev unpercent[2] <- var(scores[2,]) / sumev y$unpercent <- unpercent y$pwpercent <- percwarp y$pwscores <- t(scores) return(y) } #================================================================================== plot2rwscores <- function(rwscores, rw1, rw2, ng1, ng2) { par(pch = "x") glim <- max(-min(rwscores), max(rwscores)) plot( rwscores[1:ng1, rw1], rwscores[1:ng1, rw2], xlim = c(-glim, glim), ylim = c(-glim, glim), xlab = " ", ylab = " " ) par(pch = "+") points(rwscores[(ng1 + 1):(ng1 + ng2), rw1], rwscores[(ng1 + 1):(ng1 + ng2), rw2]) } #================================================================================== plotPDM <- function(mean, pc, sd, xl, xu, yl, yu, lineorder) { for (i in c(-3, 0, 3)) { fig <- mean + i * pc * sd k <- length(mean) / 2 figx <- fig[1:k] figy <- fig[(k + 1):(2 * k)] plot( figx, figy, axes = TRUE, xlab = " ", ylab = " ", ylim = c(yl, yu), xlim = c(xl, xu) ) # par(lty = i + 1) lines(figx[lineorder], figy[lineorder]) if (i == -3) title(sub = "mean - c sd") if (i == 0) title(sub = "mean") if (i == 3) title(sub = "mean + c sd") par(lty = 1) } } #================================================================================== plotPDM2 <- function(mean, pc, sd, xl, xu, yl, yu, lineorder) { par(lty = 1) k <- length(mean) / 2 plot( mean[1:k], mean[(k + 1):(2 * k)], axes = TRUE, xlab = " ", ylab = " ", ylim = c(yl, yu), xlim = c(xl, xu) ) for (i in c(-3:3)) { fig <- mean + i * pc * sd figx <- fig[1:k] figy <- fig[(k + 1):(2 * k)] # if (i < 0) { par(lty = 1) par(pch = "*") } if (i == 0) { par(lty = 4) par(pch = 1) } if (i > 0) { par(lty = 2) par(pch = "+") } points(figx, figy) lines(figx[lineorder], figy[lineorder]) } } #================================================================================== plotPDM3 <- function(mean, pc, sd, xl, xu, yl, yu, lineorder) { par(lty = 1) k <- length(mean) / 2 figx <- matrix(0, 2 * k, 7) figy <- figx plot( mean[1:k], mean[(k + 1):(2 * k)], axes = TRUE, xlab = " ", ylab = " ", ylim = c(yl, yu), xlim = c(xl, xu) ) for (i in c(-3:3)) { fig <- mean + i * pc * sd figx[, i + 4] <- fig[1:k] figy[, i + 4] <- fig[(k + 1):(2 * k)] } for (i in 1:k) { # par(lty = 2) # lines(figx[i, 1:4], figy[i, 1:4]) par(lty = 1) lines(figx[i, 4:7], figy[i, 4:7]) } } #================================================================================== plotPDMbook <- function(mean, pc, sd, xl, xu, yl, yu, lineorder) { par(lty = 1) k <- length(mean) / 2 figx <- matrix(0, 2 * k, 7) figy <- figx plot( bookstein.shpv(cbind(mean[1:k], mean[(k + 1):(2 * k)])), axes = TRUE, xlab = " ", ylab = " ", ylim = c(yl, yu), xlim = c(xl, xu) ) for (i in c(-3:3)) { fig <- mean + i * pc * sd figx[, i + 4] <- fig[1:k] figy[, i + 4] <- fig[(k + 1):(2 * k)] u <- bookstein.shpv(cbind(figx[, i + 4], figy[, i + 4])) figx[, i + 4] <- u[, 1] figy[, i + 4] <- u[, 2] } for (i in 1:k) { # par(lty = 2) # lines(figx[i, 1:4], figy[i, 1:4]) par(lty = 1) lines(figx[i, 4:7], figy[i, 4:7]) } } #================================================================================== plotPDMnoaxis <- function(mean, pc, sd, xl, xu, yl, yu, lineorder) { for (i in c(-3:3)) { fig <- mean + i * pc * sd k <- length(mean) / 2 figx <- fig[1:k] figy <- fig[(k + 1):(2 * k)] plot( figx, figy, axes = FALSE, xlab = " ", ylab = " ", ylim = c(yl, yu), xlim = c(xl, xu) ) lines(figx[lineorder], figy[lineorder]) for (ii in 1:1000) { aa <- 1 } } } #================================================================================== pointsPDMnoaxis3 <- function(mean, pc, sd, xl, xu, yl, yu, lineorder, i) { fig <- mean + i * pc * sd k <- length(mean) / 2 figx <- fig[1:k] figy <- fig[(k + 1):(2 * k)] points(figx, figy) text(figx, figy, 1:k) lines(figx[lineorder], figy[lineorder]) } #================================================================================== plotpairscores <- function(scores, nr, nc, ng1, ng2, ch1, ch2) { #plots pairs of scores score 2 vs score 1, score 4 vs score 3 etc #in an nr x nc grid of plots par(pty = "s") par(cex = 2) par(mfrow = c(nr, nc)) k <- ncol(scores) / 2 + 2 glim <- max(-min(scores), max(scores)) for (i in 1:(k - 2)) { plot( scores[1:ng1, (2 * i - 1)], scores[1:ng1, (2 * i)], pch = ch1, xlim = c(-glim, glim), ylim = c(-glim, glim), xlab = " ", ylab = " " ) points(scores[(ng1 + 1):(ng1 + ng2), (2 * i - 1)], scores[(ng1 + 1):(ng1 + ng2), (2 * i)], pch = ch2) } } ################################# #================================================================================== plotpca <- function (proc, pcno, type, mag, xl, yl, width, joinline = c(1, 1), project = c(1, 2)) { k <- proc$k zero <- matrix(0, k - 1, k) h <- defh(k - 1) H <- cbind(h, zero) H1 <- cbind(zero, h) H <- rbind(H, H1) if (project[1] == 1) { select1 <- 1:k } if (project[1] == 2) { select1 <- (k + 1):(2 * k) } if (project[1] == 3) { select1 <- (2 * k + 1):(3 * k) } if (project[2] == 1) { select2 <- 1:k } if (project[2] == 2) { select2 <- (k + 1):(2 * k) } if (project[2] == 3) { select2 <- (2 * k + 1):(3 * k) } select <- c(select1, select2) meanxy <- c(proc$mshape[, project[1]], proc$mshape[, project[2]]) if (dim(proc$pcar)[1] == (2 * (k - 1))) { pcarot <- (t(H) %*% proc$pcar)[select, ] } if (dim(proc$pcar)[1] != (2 * (k - 1))) { pcarot <- proc$pcar[select, ] } par(pty = "s") par(lty = 1) np <- length(pcno) nr <- trunc((length(pcno) + 1) / 2) if (type == "g") { par(mfrow = c(nr, 2)) if (np == 1) { par(mfrow = c(1, 1)) } for (i in 1:np) { j <- pcno[i] fig <- meanxy + pcarot[, j] * 3 * mag * proc$pcasd[j] figx <- fig[1:k] figy <- fig[(k + 1):(2 * k)] YY <- cbind(figx, figy) tpsgrid(cbind(proc$mshape[, project[1]], proc$mshape[, project[2]]) , YY, xl, yl, width, 1, 0.1, 22) } } else { if (type == "r") { par(mfrow = c(np, 3)) for (i in 1:np) { j <- pcno[i] plotPDM(meanxy, pcarot[, j], mag * proc$pcasd[j], xl, xl + width, yl, yl + width, joinline) title(as.character( paste( "PC ", as.character(pcno[i]), ": ", as.character(round(proc$percent[i], 1)), "%" ) )) } } else { if (type == "v") { par(mfrow = c(nr, 2)) if (np == 1) { par(mfrow = c(1, 1)) } for (i in 1:np) { j <- pcno[i] plotPDM3(meanxy, pcarot[, j], mag * proc$pcasd[j], xl, xl + width, yl, yl + width, joinline) title(as.character( paste( "PC ", as.character(pcno[i]), ": ", as.character(round(proc$percent[i], 1)), "%" ) )) } } else { if (type == "b") { par(mfrow = c(nr, 2)) if (np == 1) { par(mfrow = c(1, 1)) } for (i in 1:np) { j <- pcno[i] plotPDMbook(meanxy, pcarot[, j], mag * proc$pcasd[j],-0.6, 0.6, -0.6, 0.6, joinline) title(as.character( paste( "PC ", as.character(pcno[i]), ": ", as.character(round(proc$percent[i], 1)), "%" ) )) } } else { if (type == "s") { par(mfrow = c(nr, 2)) if (np == 1) { par(mfrow = c(1, 1)) } for (i in 1:np) { j <- pcno[i] plotPDM2( meanxy, pcarot[, j], mag * proc$pcasd[j], xl, xl + width, yl, yl + width, joinline ) title(as.character( paste( "PC ", as.character(pcno[i]), ": ", as.character(round(proc$percent[i], 1)), "%" ) )) } } else { if (type == "m") { par(mfrow = c(1, 1)) for (i in 1:np) { j <- pcno[i] cat(paste("PC ", pcno[i], " \n")) movie( meanxy, pcarot[, j], mag * proc$pcasd[j], xl, xl + width, yl, yl + width, joinline, 20 ) } } } } } } } par(mfrow = c(1, 1)) } ############################################## #================================================================================== plotprinwarp <- function(TT, xbegin, ybegin, xwidth, nr, nc) { # #plots the principal warps of TT as perspective plots #the plots are displayed in an nr x nc array of plots kx <- 21 k <- nrow(TT) l <- kx ^ 2 xstart0 <- xbegin ystart0 <- ybegin xstart <- xstart0 ystart <- ystart0 step <- xwidth / kx r <- 0 X <- rep(0, times = l) Y2 <- rep(0, times = l) for (p in 1:kx) { ystart <- ystart0 xstart <- xstart + step for (q in 1:kx) { ystart <- ystart + step r <- r + 1 X[r] <- xstart Y2[r] <- ystart } } refperp <- matrix(c(X, Y2), l, 2) xstart <- xstart0 xgrid <- rep(0, times = kx) for (i in 1:kx) { xstart <- xstart + step xgrid[i] <- xstart } ystart <- ystart0 ygrid <- rep(0, times = kx) for (i in 1:kx) { ystart <- ystart + step ygrid[i] <- ystart } TPS <- bendingenergy(TT) prinwarp <- TPS$prinwarps phi <- matrix(0, l, k - 3) s <- matrix(0, k, 1) for (i in 1:l) { s <- matrix(0, k, 1) for (m in 1:k) { s[m,] <- sigmacov(refperp[i,] - TT[m,]) } phi[i,] <- diag(sqrt(TPS$prinwarpeval[1:(k - 3)])) %*% t(prinwarp[, 1:(k - 3)]) %*% s } phiTT <- matrix(0, k, k - 3) for (i in 1:k) { s <- matrix(0, k, 1) for (m in 1:k) { s[m,] <- sigmacov(TT[i,] - TT[m,]) } phiTT[i,] <- diag(sqrt(TPS$prinwarpeval[1:(k - 3)])) %*% t(prinwarp[, 1:(k - 3)]) %*% s } par(mfrow = c(nr, nc)) for (nw in 1:(k - 3)) { zgrid <- matrix(0, kx, kx) m <- 0 for (i in 1:kx) { for (j in 1:kx) { m <- m + 1 zgrid[i, j] <- phi[m, k - 2 - nw] } } zpersp <- persp(xgrid, ygrid, zgrid, axes = TRUE) # NB the following is an S-Plus function : use trans3d() in R # points(perspp(TT[, 1], TT[, 2], phiTT[, k - 2 - nw], zpersp), # cex = 2) } } #================================================================================== plotproc <- function(proc, xl, yl, width, joinline = c(1, 1)) { #provides plots of the full Procrustes rotated objects in proc #proc is an S object of the type output from the function procrustes2d #xl, yl lower xlimit and ylimit in plot #width = width (and height) of the square plotting region par(pty = "s") plot( proc$rotated[, , 1], xlim = c(xl, xl + width), ylim = c(yl, yl + width), type = "n", xlab = "", ylab = "" ) for (i in 1:proc$n) { points(proc$rotated[, , i]) lines(proc$rotated[joinline, , i]) } } #================================================================================== plotrelwarp <- function(mshape, rotsd, pcno, type, mag, xl, yl, width, joinline) { #provides PC plots: similar to plotpca but different argument #here rotsd is the rotation x s.d. , and can be from the usual # PCA or from using relative warps #pcno is a vector of the numbers (index) of PCs to be plotted #e.g. pcno<-c(1,2,4,7) will plot the four PCs no. 1,2,4,7 #type = type of display # "r" : rows along PCs evaluated at c = -3,-2,-1,0,1,2,3 sd's along PC # "v" : vectors drawn from mean to +/- 3 sd's along PC # "b" : vectors drawn as in `v' but using Bookstein shape variables # "s" : plots along c= -3, -2, -1, 0, 1, 2, 3 superimposed # "m" : movie backward and forwards from -3 to +3 sd's along PC # #mag = magnification of effect (1 = use s.d.'s from the data) #xl, yl lower xlimit and ylimit in plot #width = width (and height) of the square plotting region #joinline = vector of landmark numbers which are joined up in the plot by #straight lines: joinline = c(1,1) will give no lines # k <- nrow(mshape) pcarot <- rotsd par(pty = "s") par(lty = 1) meanxy <- c(mshape[, 1], mshape[, 2]) np <- length(pcno) if (type == "g") { par(mfrow = c(1, np)) for (i in 1:np) { j <- pcno[i] fig <- meanxy + pcarot[, j] * mag * 3 figx <- fig[1:k] figy <- fig[(k + 1):(2 * k)] YY <- cbind(figx, figy) tpsgrid(mshape, YY, xl, yl, width, 1, 0.1, 22) } } else { if (type == "r") { par(mfrow = c(np, 7)) for (i in 1:np) { j <- pcno[i] plotPDM(meanxy, pcarot[, j], mag, xl, xl + width, yl, yl + width, joinline) } } else { if (type == "v") { par(mfrow = c(1, np)) for (i in 1:np) { j <- pcno[i] plotPDM3(meanxy, pcarot[, j], mag, xl, xl + width, yl, yl + width, joinline) } } else { if (type == "b") { par(mfrow = c(1, np)) for (i in 1:np) { j <- pcno[i] plotPDMbook(meanxy, pcarot[, j], mag, xl, xl + width, yl, yl + width, joinline) } } else { if (type == "s") { par(mfrow = c(1, np)) for (i in 1:np) { j <- pcno[i] plotPDM2(meanxy, pcarot[, j], mag, xl, xl + width, yl, yl + width, joinline) } } else { if (type == "m") { par(mfrow = c(1, 1)) for (i in 1:np) { j <- pcno[i] movie(meanxy, pcarot[, j], mag, xl, xl + width, yl, yl + width, joinline, 20) } } } } } } } par(mfrow = c(1, 1)) } #================================================================================== ild_preshape <- function(x) { #input k x m matrix / complex k-vector #output k-1 x m matrix / k-1 x 1 complex matrix if (is.complex(x)) { k <- nrow(as.matrix(x)) h <- defh(k - 1) zstar <- x ztem <- h %*% zstar size <- sqrt(diag(Re(st(ztem) %*% ztem))) if (is.vector(zstar)) z <- ztem / size if (is.matrix(zstar)) z <- ztem %*% diag(1 / size) } else { if (length(dim(x)) == 3) { k <- dim(x)[1] h <- defh(k - 1) n <- dim(x)[3] m <- dim(x)[2] z <- array(0, c(k - 1, m, n)) for (i in 1:n) { z[, , i] <- h %*% x[, , i] size <- centroid.size(x[, , i]) z[, , i] <- z[, , i] / size } } else { k <- nrow(as.matrix(x)) h <- defh(k - 1) ztem <- h %*% x size <- centroid.size(x) z <- ztem / size } } z } #================================================================================== ild_preshape.mD <- function(x) { #input k x m matrix #output k-1 x 1 matrix h <- defh(nrow(x) - 1) ztem <- h %*% x size <- centroid.size.mD(x) z <- ztem / size z } #================================================================================== ild_preshape.mat <- function(zstar) { h <- defh(nrow(as.matrix(zstar)) - 1) ztem <- h %*% zstar size <- sqrt(diag(Re(st(ztem) %*% ztem))) if (is.vector(zstar)) z <- ztem / size if (is.matrix(zstar)) z <- ztem %*% diag(1 / size) z } #================================================================================== ild_preshapetoicon <- function(z) { #convert a preshape (real or complex) to an icon in configuration space h <- defh(nrow(z)) t(h) %*% z } # # # #prcomp1<-function(x, retx = TRUE) #{ # s <- svd(scale(x, scale = FALSE), nu = 0) # remove column means # rank <- sum(s$d > 0) # if(rank < ncol(x)) # s$v <- s$v[, 1:rank] # s$d <- s$d/sqrt(max(1, nrow(x) - 1)) # if(retx) # list(sdev = s$d, rotation = s$v, x = x %*% s$v) # else list(sdev = s$d, rotation = s$v) #} #================================================================================== prinwscoregrids <- function(TT, TPS, score, xbegin, ybegin, xwidth, nr, nc) { #grids displaying the effect of each principal warp at `score' #along each warp. Grids displayed in an nr x nc array par(pty = "s") par(mfrow = c(nr, nc)) k <- nrow(TT) xstart <- xbegin ystart <- ybegin kx <- 22 ky <- 21 l <- kx * ky step <- xwidth / (kx - 1) r <- 0 X <- rep(0, times = 220) Y2 <- rep(0, times = 220) for (p in 1:kx) { ystart <- ybegin xstart <- xstart + step for (q in 1:ky) { ystart <- ystart + step r <- r + 1 X[r] <- xstart Y2[r] <- ystart } } refc <- matrix(c(X, Y2), kx * ky, 2) # TPS <- bendingenergy(TT) for (jnw in 1:(k - 3)) { nw <- k - 2 - jnw phi <- matrix(0, l, 2) s <- matrix(0, k, 1) for (i in 1:l) { s <- matrix(0, k, 1) for (m in 1:k) { s[m,] <- sigmacov(refc[i,] - TT[m,]) } phi[i,] <- refc[i,] + sqrt(TPS$prinwarpeval[nw]) * score * t(TPS$prinwarps[, nw]) %*% s } newpt <- matrix(0, k, 2) for (i in 1:k) { s <- matrix(0, k, 1) for (m in 1:k) { s[m,] <- sigmacov(TT[i,] - TT[m,]) } newpt[i,] <- TT[i,] + sqrt(TPS$prinwarpeval[nw]) * score * t(TPS$prinwarps[, nw]) %*% s } order <- linegrid(phi, kx, ky) plot( order[1:l, 1], order[1:l, 2], type = "l", xlim = c(xbegin - xwidth / 10, xbegin + (xwidth * 11) / 10), ylim = c(ybegin - (xwidth / 10 * ky) / kx, ybegin + ((xwidth * 11) / 10 * ky) / kx), xlab = " ", ylab = " " ) lines(order[(l + 1):(2 * l), 1], order[(l + 1):(2 * l), 2], type = "l") points(newpt, cex = 2) } } #================================================================================== procdistreflect <- function(x, y) { #input k x m matrices x, y #output reflection shape distance (rho*) between them #if x, y are not too far apart then (rho*)=rho (Riemannian dist) if (sum((x - y) ^ 2) == 0) { riem <- 0 } if (sum((x - y) ^ 2) != 0) { m <- ncol(x) z <- preshape(x) w <- preshape(y) Q <- t(z) %*% w %*% t(w) %*% z ev <- sqrt(eigen(Q, symmetric = TRUE)$values) # riem <- acos(sum(ev)) riem <- acos(min(sum(ev), 1)) } riem } #================================================================================== procrustes2d <- function(x, l1 = 1, l2 = 2, approxtangent = FALSE, expomap = FALSE) { #input k x 2 x n real array, or k x n complex matrix #mean shape will have landmarks l1, l2 horizontal (l1 left, l2 right) # #output: # z$k : no of landmarks # z$m : no of dimensions (=2 here) # z$n : sample size # z$tan : the real 2k-2 x n matrix of partial Procrustes tangent coordinates # with pole given by the preshape of the full Procrustes mean # z$rotated : the k x m x n array of real full Procrustes rotated data # z$pcar : the columns are eigenvectors (PCs) of the sample covariance Sv of z$tan # z$pcasd : the square roots of eigenvalues of Sv (s.d.'s of PCs) # z$percent : the % of variability explained by the PCs # z$scores : PC scores normalised to have unit variance # z$rawscores : PC scores (unnormalised) # z$size : the centroid sizes of the configurations # z$rho : Kendall's Procrustean (Riemannian) distance rho to the mean shape # z$rmsrho : r.m.s. of rho # z$rmsd1 : r.m.s. of full Procrustes distances to the mean shape d1 # z <- list( k = 0, m = 0, n = 0, rotated = 0, tan = 0, pcar = 0, scores = 0, rawscores = 0, pcasd = 0, percent = 0, size = 0, rho = 0, rmsrho = 0, rmsd1 = 0, mshape = 0 ) if (is.complex(x) == FALSE) { x <- x[, 1,] + (1i) * x[, 2,] } # cat("Procrustes 2D eigenanalysis \n") k <- nrow(x) n <- ncol(x) h <- defh(k - 1) zp <- preshape(x) gamma <- cbevec(zp) cbmean <- t(h) %*% gamma theta <- Arg(cbmean[l2] - cbmean[l1]) cbmeanrot <- exp((-0 - 1i) * theta) * cbmean gamma <- h %*% cbmeanrot tan <- project(zp, gamma) icon <- array(0, c(k, 2, n)) tanapprox <- matrix(0, 2 * k, n) size <- rep(0, times = n) rho <- rep(0, times = n) mu <- complextoreal(cbmeanrot) sum <- 0 for (i in 1:n) { tem <- tanfigurefull(tan[, i], gamma) icon[, 1, i] <- Re(tem) icon[, 2, i] <- Im(tem) sum <- sum + icon[, , i] size[i] <- centroid.size(x[, i]) rho[i] <- riemdist(x[, i], c(cbmeanrot)) } xbar <- sum / n rv <- Vmat(tan) if (approxtangent == TRUE) { for (i in 1:n) { tanapprox[, i] <- as.vector(icon[, , i]) - as.vector(xbar) } tanapprox <- tanapprox / centroid.size(xbar) pca <- prcomp1(t(tanapprox)) z$tan <- tanapprox } if (expomap == TRUE) { temp <- rv for (i in 1:(n)) { temp[, i] <- rv[, i] / Enorm(rv[, i]) * rho[i] } rv <- temp } if (approxtangent == FALSE) { pca <- prcomp1(t(rv)) z$tan <- rv } z$pcar <- pca$rotation z$pcasd <- pca$sdev z$percent <- z$pcasd ^ 2 / sum(z$pcasd ^ 2) * 100 z$rotated <- icon npc <- 0 for (i in 1:length(pca$sdev)) { if (pca$sdev[i] > 1e-07) { npc <- npc + 1 } } z$scores <- pca$x z$rawscores <- pca$x for (i in 1:npc) { z$scores[, i] <- pca$x[, i] / pca$sdev[i] } z$rho <- rho z$size <- size z$mshape <- mu z$k <- k z$m <- 2 z$n <- n z$rmsrho <- sqrt(mean(rho ^ 2)) z$rmsd1 <- sqrt(mean(sin(rho) ^ 2)) return(z) } #================================================================================== testmeanshapes.old <- function(A, B, Hotelling = TRUE, tol1 = 1e05, tol2 = 1e05) { if (is.complex(A)) { tem <- array(0, c(nrow(A), 2, ncol(A))) tem[, 1,] <- Re(A) tem[, 2,] <- Im(A) A <- tem } if (is.complex(B)) { tem <- array(0, c(nrow(B), 2, ncol(B))) tem[, 1,] <- Re(B) tem[, 2,] <- Im(B) B <- tem } m <- dim(A)[2] if (Hotelling == TRUE) { if (m == 2) { test <- Hotelling2D(A, B) } if (m > 2) { test <- Hotellingtest(A, B, tol1 = tol1, tol2 = tol2) } cat( "Hotelling's T^2 test: ", c("Test statistic = ", round(test$F, 2)), c("\n p-value = ", round(test$pval, 4)), c("Degrees of freedom = ", test$df1, test$df2), "\n" ) } if (Hotelling == FALSE) { if (m == 2) { test <- Goodall2D(A, B) } if (m > 2) { test <- Goodalltest(A, B, tol1 = tol1, tol2 = tol2) } cat( "Goodall's F test: ", c("Test statistic = ", round(test$F, 2)), c("\n p-value = ", round(test$pval, 4)), c("Degrees of freedom = ", test$df1, test$df2), "\n" ) } test } #================================================================================== procGPA <- function(x, scale = TRUE, reflect = FALSE, eigen2d = FALSE, tol1 = 1e-05, tol2 = tol1, tangentcoords = "residual", proc.output = FALSE, distances = TRUE, pcaoutput = TRUE, alpha = 0, affine = FALSE) { # # n <- dim(x)[length(dim(x))] # if ((n > 100) & (distances == TRUE)) { # print("To speed up use option distances=FALSE") # } # if ((n > 100) & (pcaoutput == TRUE)) { # print("To speed up use option pcaoutput=FALSE") # } if (scale == TRUE) { if (tangentcoords == "residual") { tangentresiduals <- TRUE expomap <- FALSE } if (tangentcoords == "partial") { tangentresiduals <- FALSE expomap <- FALSE } if (tangentcoords == "expomap") { tangentresiduals <- FALSE expomap <- TRUE } } if (scale == FALSE) { #all three options are equivalent if (tangentcoords == "residual") { tangentresiduals <- TRUE expomap <- FALSE } if (tangentcoords == "partial") { tangentresiduals <- TRUE expomap <- FALSE } if (tangentcoords == "expomap") { tangentresiduals <- TRUE expomap <- FALSE } } approxtangent <- tangentresiduals if (is.complex(x)) { tem <- array(0, c(nrow(x), 2, ncol(x))) tem[, 1,] <- Re(x) tem[, 2,] <- Im(x) x <- tem } m <- dim(x)[2] n <- dim(x)[3] if (reflect == FALSE) { if ((m == 2) && (scale == TRUE)) { if (eigen2d == TRUE) { out <- procrustes2d(x, approxtangent = approxtangent, expomap = expomap) } else { out <- procrustesGPA( x, tol1, tol2, approxtangent = approxtangent, proc.output = proc.output, distances = distances, pcaoutput = pcaoutput, reflect = reflect, expomap = expomap ) } } if ((m > 2) && (scale == TRUE)) { out <- procrustesGPA( x, tol1, tol2, approxtangent = approxtangent, proc.output = proc.output , distances = distances, pcaoutput = pcaoutput, reflect = reflect, expomap = expomap ) } if (scale == FALSE) { out <- procrustesGPA.rot( x, tol1, tol2, approxtangent = approxtangent, proc.output = proc.output, distances = distances, pcaoutput = pcaoutput, reflect = reflect, expomap = expomap ) } } if (reflect == TRUE) { if (scale == TRUE) { out <- procrustesGPA( x, tol1, tol2, approxtangent = approxtangent, proc.output = proc.output, distances = distances, pcaoutput = pcaoutput, reflect = reflect, expomap = expomap ) } if (scale == FALSE) { out <- procrustesGPA.rot( x, tol1, tol2, approxtangent = approxtangent, proc.output = proc.output, distances = distances, pcaoutput = pcaoutput, reflect = reflect, expomap = expomap ) } } out$stdscores <- out$scores out$scores <- out$rawscores if (approxtangent == FALSE) { out$mshape <- out$mshape / centroid.size(out$mshape) for (i in 1:n) { out$rotated[, , i] <- out$rotated[, , i] / centroid.size(out$rotated[, , i]) } } rw <- out rw <- shaperw(out, alpha = alpha , affine = affine) rw$GSS <- sum((n - 1) * rw$pcasd ** 2) rw } #================================================================================== procrustesGPA <- function (x, tol1 = 1e-05, tol2 = 1e-05, distances = TRUE, pcaoutput = TRUE, approxtangent = TRUE, proc.output = FALSE, reflect = FALSE, expomap = FALSE) { z <- list( k = 0, m = 0, n = 0, rotated = 0, tan = 0, pcar = 0, scores = 0, rawscores = 0, pcasd = 0, percent = 0, size = 0, rho = 0, rmsrho = 0, rmsd1 = 0, mshape = 0 ) if (is.complex(x)) { tem <- array(0, c(nrow(x), 2, ncol(x))) tem[, 1,] <- Re(x) tem[, 2,] <- Im(x) x <- tem } k <- dim(x)[1] m <- dim(x)[2] n <- dim(x)[3] x <- cnt3(x) zgpa <- fgpa(x, tol1, tol2, proc.output = proc.output, reflect = reflect) if (distances == TRUE) { if (proc.output) { cat("Shape distances and sizes calculation ...\n") } size <- rep(0, times = n) rho <- rep(0, times = n) size <- apply(x, 3, centroid.size) rho <- apply(x, 3, y <- function(x) { riemdist(x, zgpa$mshape) }) } tanpartial <- matrix(0, k * m - m , n) ident <- diag(rep(1, times = (m * k - m))) gamma <- as.vector(preshape(zgpa$mshape)) for (i in 1:n) { tanpartial[, i] <- (ident - gamma %*% t(gamma)) %*% as.vector(preshape(zgpa$r.s.r[, , i])) } if (expomap == TRUE) { temp <- tanpartial for (i in 1:(n)) { temp[, i] <- tanpartial[, i] / Enorm(tanpartial[, i]) * rho[i] } tanpartial <- temp } tan <- zgpa$r.s.r[, 1,] - zgpa$mshape[, 1] for (i in 2:m) { tan <- rbind(tan, zgpa$r.s.r[, i,] - zgpa$mshape[, i]) } if (pcaoutput == TRUE) { if (proc.output) { cat("PCA calculation ...\n") } if (approxtangent == FALSE) { pca <- prcomp1(t(tanpartial)) } if (approxtangent == TRUE) { pca <- prcomp1(t(tan)) } npc <- 0 for (i in 1:length(pca$sdev)) { if (pca$sdev[i] > 1e-07) { npc <- npc + 1 } } z$scores <- pca$x z$rawscores <- pca$x for (i in 1:npc) { z$scores[, i] <- pca$x[, i] / pca$sdev[i] } z$pcar <- pca$rotation z$pcasd <- pca$sdev z$percent <- z$pcasd ^ 2 / sum(z$pcasd ^ 2) * 100 } if (approxtangent == FALSE) { z$tan <- tanpartial } if (approxtangent == TRUE) { z$tan <- tan } if (distances == TRUE) { z$rho <- rho z$size <- size z$rmsrho <- sqrt(mean(rho ^ 2)) z$rmsd1 <- sqrt(mean(sin(rho) ^ 2)) } z$rotated <- zgpa$r.s.r z$mshape <- zgpa$mshape z$k <- k z$m <- m z$n <- n if (proc.output) { cat("Finished.\n") } return(z) } #================================================================================== procrustesGPA.rot <- function (x, tol1 = 1e-05, tol2 = 1e-05, distances = TRUE, pcaoutput = TRUE, approxtangent = TRUE, proc.output = FALSE, reflect = FALSE, expomap = FALSE) { z <- list( k = 0, m = 0, n = 0, rotated = 0, tan = 0, pcar = 0, scores = 0, rawscores = 0, pcasd = 0, percent = 0, size = 0, rho = 0, rmsrho = 0, rmsd1 = 0, mshape = 0 ) if (is.complex(x)) { tem <- array(0, c(nrow(x), 2, ncol(x))) tem[, 1,] <- Re(x) tem[, 2,] <- Im(x) x <- tem } k <- dim(x)[1] m <- dim(x)[2] n <- dim(x)[3] # print("GPA (rotation only)") x <- cnt3(x) zgpa <- fgpa.rot(x, tol1, tol2, proc.output = proc.output, reflect = reflect) if (distances == TRUE) { if (proc.output) { cat("Shape distances and sizes calculation ...\n") } size <- rep(0, times = n) rho <- rep(0, times = n) size <- apply(x, 3, centroid.size) rho <- apply(x, 3, y <- function(x) { riemdist(x, zgpa$mshape) }) } tanpartial <- matrix(0, k * m - m, n) ident <- diag(rep(1, times = (m * k - m))) gamma <- as.vector(preshape(zgpa$mshape)) for (i in 1:n) { tanpartial[, i] <- (ident - gamma %*% t(gamma)) %*% as.vector(preshape(zgpa$r.s.r[, , i])) } if (expomap == TRUE) { temp <- tanpartial for (i in 1:(n)) { temp[, i] <- tanpartial[, i] / Enorm(tanpartial[, i]) * rho[i] } tanpartial <- temp } tan <- zgpa$r.s.r[, 1,] - zgpa$mshape[, 1] for (i in 2:m) { tan <- rbind(tan, zgpa$r.s.r[, i,] - zgpa$mshape[, i]) } if (approxtangent == FALSE) { z$tan <- tanpartial } if (approxtangent == TRUE) { z$tan <- tan } if (pcaoutput == TRUE) { if (proc.output) { cat("PCA calculation ...\n") } if (approxtangent == FALSE) { pca <- prcomp1(t(tanpartial)) } if (approxtangent == TRUE) { pca <- prcomp1(t(tan)) } npc <- 0 for (i in 1:length(pca$sdev)) { if (pca$sdev[i] > 1e-07) { npc <- npc + 1 } } z$scores <- pca$x z$rawscores <- pca$x for (i in 1:npc) { z$scores[, i] <- pca$x[, i] / pca$sdev[i] } z$pcar <- pca$rotation z$pcasd <- pca$sdev z$percent <- z$pcasd ^ 2 / sum(z$pcasd ^ 2) * 100 } if (distances == TRUE) { z$rho <- rho z$size <- size z$rmsrho <- sqrt(mean(rho ^ 2)) z$rmsd1 <- sqrt(mean(sin(rho) ^ 2)) } z$rotated <- zgpa$r.s.r z$mshape <- zgpa$mshape z$k <- k z$m <- m z$n <- n if (proc.output) { cat("Finished.\n") } return(z) } #================================================================================== project <- function(z, gamma) { #input z: preshape, gamma: preshape (k-1 x 1 matrices) #output Kent's tangent plane coordinates #of z at the pole gamma (k-1 complex vector) nr <- nrow(z) nc <- ncol(z) g <- matrix(gamma, nr, 1) ident <- diag(nr) theta <- diag(c(exp((-0 - 1i) * Arg(st( g ) %*% z))), nc, nc) v <- (ident - g %*% st(g)) %*% z %*% theta v } #================================================================================== read.array <- function(name, k, m, n) { #input name : filename, k: no of points, m: no of dimensions, n: sample size #output x: k x m x n array of data #e.g. for 2D data assume file format x1 y1 x2 y2 .. xn yn for each object tem <- scan(name) tem <- array(tem, c(m, k, n)) tem <- aperm(tem, c(2, 1, 3)) x <- tem x } #================================================================================== read.in <- function(name, k, m) { #input name : filename, k: no of points, m: no of dimensions #output x: k x m x n array of data ( n: sample size) #e.g. for m=2-D data assume file format x1 y1 x2 y2 ... xk yk for each object #for m=3-D data: x1 y1 z1 x2 y2 z2 ... xk yk zk tem <- scan(name) n <- length(tem) / (k * m) tem <- array(tem, c(m, k, n)) tem <- aperm(tem, c(2, 1, 3)) x <- tem x } #================================================================================== realtocomplex <- function(x) { #input k x 2 matrix - return complex k-vector k <- nrow(x) zstar <- x[, 1] + (1i) * x[, 2] zstar } #================================================================================== reassqpr <- function(z) { j <- 1 nc <- ncol(z) nr <- nrow(z) stemp <- matrix(0, 2 * nr, 2 * nr) repeat { t1 <- matrix(z[, j], nr, 1) vz <- rbind(Re(t1), Im(t1)) viz <- rbind(Re((1i) * t1), Im((1i) * t1)) stemp <- stemp + vz %*% t(vz) + viz %*% t(viz) if (j == nc) break j <- j + 1 } stemp } #================================================================================== relwarps <- function(mshape, rotated, alpha) { #find the relative warps for a dataset with mshape as the reference #and `rotated' as the array of Procrustes rotated figures #alpha is the power of the bending energy # alpha=+1 : emphasizes large scale # alpha=-1 : emphasizes small scale #output: # z$rwarps : the relative warps # z$rwscores : the relative warp scores # z$rwpercent : the percentage of total variability explained by each #relative warp z <- list( rwarps = 0, rwscores = 0, rwpercent = 0, ev = 0, unif = 0, unscores = 0, lengths = 0 ) k <- nrow(mshape) TPS <- bendingenergy(mshape) Be <- TPS$gamma11 stackxy <- rbind(rotated[, 1,], rotated[, 2,]) n <- dim(rotated)[3] msum <- rep(0, times = 2 * k) for (i in 1:n) { msum <- msum + stackxy[, i] } msum <- msum / n meanxy <- msum cstackxy <- matrix(0, 2 * k, n) for (i in 1:n) { cstackxy[, i] <- stackxy[, i] - meanxy } Bpow <- genpower(Be, alpha) Bpowinv <- genpower(Be,-alpha) IBpow <- I2mat(Bpow) IBpowinv <- I2mat(Bpowinv) if (alpha == 0) { IBpow <- diag(rep(1, times = (2 * k))) IBpowinv <- diag(rep(1, times = (2 * k))) } stacknew <- IBpow %*% cstackxy gamma <- matrix(0, 2 * k, 2 * k) pcarotation <- eigen(stacknew %*% t(stacknew) / n, symmetric = TRUE)$vectors pcaev <- eigen(stacknew %*% t(stacknew) / n, symmetric = TRUE)$values pcasdev <- rep(0, times = 2 * k) for (i in 1:(2 * k)) { pcasdev[i] <- sqrt(abs(pcaev[i])) } scores <- t(IBpow %*% pcarotation) %*% cstackxy percent <- rep(0, times = 2 * k) for (i in 1:(2 * k)) { percent[i] <- pcasdev[i] ^ 2 } Un <- TPS$Un UnXY <- t(Un) %*% cstackxy z$unif <- Un %*% t(matrix(c(sqrt(var( UnXY[1,] )), 0, 0, sqrt(var( UnXY[2,] ))), 2, 2)) z$unscores <- t(UnXY) z$lengths <- sqrt(abs(percent)) z$rwarps <- IBpowinv %*% pcarotation %*% diag(pcasdev) z$rwscores <- t(scores) z$ev <- pcaev percentrw <- percent / sum(percent) * 100 z$rwpercent <- percentrw return(z) } #================================================================================== ssriemdist <- function(x, y, reflect = FALSE) { sx <- centroid.size(x) sy <- centroid.size(y) sd <- sx ** 2 + sy ** 2 - 2 * sx * sy * cos(riemdist(x, y, reflect = reflect)) sqrt(abs(sd)) } #================================================================================== riemdist <- function(x, y, reflect = FALSE) { #input two k x m matrices x, y or complex k-vectors #output Riemannian distance rho between them if (sum((x - y) ** 2) == 0) { riem <- 0 } if (sum((x - y) ** 2) != 0) { if (reflect == FALSE) { if (ncol(as.matrix(x)) < 3) { if (is.complex(x) == FALSE) { x <- realtocomplex(x) } if (is.complex(y) == FALSE) { y <- realtocomplex(y) } #riem <- c(acos(Mod(st(preshape(x)) %*% preshape(y)))) riem <- c(acos(min(1, ( Mod(st(preshape(x)) %*% preshape(y)) )))) } else { m <- ncol(x) z <- preshape(x) w <- preshape(y) Q <- t(z) %*% w %*% t(w) %*% z ev <- eigen(t(z) %*% w)$values check <- 1 for (i in 1:m) { check <- check * ev[i] } ev <- sqrt(abs(eigen(Q, symmetric = TRUE)$values)) if (Re(check) < 0) ev[m] <- -ev[m] riem <- acos(min(sum(ev), 1)) } } if (reflect == TRUE) { m <- ncol(x) z <- preshape(x) w <- preshape(y) Q <- t(z) %*% w %*% t(w) %*% z ev <- sqrt(abs(eigen(Q, symmetric = TRUE)$values)) riem <- acos(min(sum(ev), 1)) } } riem } #================================================================================== riemdist.complex <- function(z, w) { #input complex k-vectors z, w #output Riemannian distance rho between them c(acos(min(Mod( st(preshape(z)) %*% preshape(w) ), 1))) } #================================================================================== riemdist.mD <- function(x, y) { #input k x m matrices x, y #output Riemannian distance rho between them m <- ncol(x) z <- preshape.mD(x) w <- preshape.mD(y) Q <- t(z) %*% w %*% t(w) %*% z ev <- eigen(t(z) %*% w)$values check <- 1 for (i in 1:m) { check <- check * ev[i] } ev <- sqrt(eigen(Q, symmetric = TRUE)$values) if (check < 0) ev[m] <- -ev[m] riem <- acos(min(sum(ev), 1)) riem } #================================================================================== rotateaxes <- function(mshapein, rotatedin) { #Rotates a mean shape and the Procrustes rotated data to have #horizontal and vertical principal axes #output: z$mshape rotated mean shape # z$rotated rotated procrustes registered data # z$R the rotation matrix # z <- list(mshape = 0, rotated = 0, R = 0) n <- dim(rotatedin)[3] S <- var(mshapein) R <- eigen(S)$vectors msh <- mshapein %*% R ico <- rotatedin for (i in 1:n) { ico[, , i] <- rotatedin[, , i] %*% R } z$mshape <- msh z$rotated <- ico z$R <- R return(z) } #sigma<-function(x) #{ # length <- sqrt(x[1]^2 + x[2]^2) # if(length == 0) # sig <- 0 # else sig <- length^2 * log(length^2) # sig #} #================================================================================== sigmacov <- function(x) { # other radial basis functions/covariance functions are possible of course hh <- Enorm(x) if (hh == 0) sig <- 0 else { if (length(x) == 2) { sig <- hh ^ 2 * log(hh ^ 2) # null space includes affine terms (2D data) } if (length(x) == 3) { sig <- -hh # null space includes affine terms (3D data) } } sig } #================================================================================== st <- function(zstar) { #input complex matrix #output transpose of the complex conjugate st <- t(Conj(zstar)) st } #================================================================================== ild_tanfigure <- function(vv, gamma) { #inverse projection from complex tangent plane coordinates vv, using pole gamma #output centred icon k <- nrow(gamma) + 1 h <- defh(k - 1) zvv <- tanpreshape(vv, gamma) zstvv <- t(h) %*% zvv zstvv } #================================================================================== ild_tanfigurefull <- function(vv, gamma) { #inverse projection from complex tangent plane coordinates vv, using pole gamma #using Procrustes to with scaling to the pole gamma #output centred icon k <- nrow(gamma) + 1 f1 <- tanfigure(vv, gamma) h <- defh(k - 1) f2 <- t(h) %*% gamma beta <- Mod(st(f1) %*% f2) f1 <- f1 * c(beta) f1 } #================================================================================== tanpreshape <- function(vv, gamma) { #inverse projection from tangent plane coordinates vv, using pole gamma #output preshape z <- c((1 - st(vv) %*% vv) ^ 0.5) * gamma + vv z } #================================================================================== plot3Ddata <- function(dna.data, land = 1:k, objects = 1:n, joinline = c(1, 1)) { dna <- procGPA(dna.data[, , 1:2]) w1 <- defplotsize2(dna.data[, 1:2, ]) w2 <- defplotsize2(dna.data[, c(1, 3), ]) w3 <- defplotsize2(dna.data[, c(2, 3), ]) width <- max(c(w1$width, w2$width, w3$width)) xl <- min(c(w1$xl, w2$xl, w3$xl)) xu <- xl + width yl <- min(c(w1$yl, w2$yl, w3$yl)) yu <- yl + width n <- dim(dna.data)[3] k <- dim(dna.data)[1] m <- dim(dna.data)[2] par(mfrow = c(1, 1)) par(pty = "s") view1 <- 1 view2 <- 2 view3 <- 3 lineorder <- joinline for (j in 1:1) { for (ii in objects) { par(mfrow = c(2, 2)) mag <- 0 pcno <- 1 plotPDMnoaxis3( c(dna.data[land, view2, ii], dna.data[land, view3, ii]), c(dna$pcar[((view1 - 1) * k + (land)), pcno], dna$pcar[((view2 - 1) * k + (land)), pcno]), mag * dna$pcasd[pcno], xl, xu, yl, yu, lineorder, 1 ) mag <- 0 pcno <- 1 plotPDMnoaxis3( c(dna.data[land, view1, ii], dna.data[land, view3, ii]), c(dna$pcar[((view1 - 1) * k + (land)), pcno], dna$pcar[((view2 - 1) * k + (land)), pcno]), mag * dna$pcasd[pcno], xl, xu, yl, yu, lineorder, 1 ) mag <- 0 pcno <- 1 plotPDMnoaxis3( c(dna.data[land, view1, ii], dna.data[land, view2, ii]), c(dna$pcar[((view1 - 1) * k + (land)), pcno], dna$pcar[((view2 - 1) * k + (land)), pcno]), mag * dna$pcasd[pcno], xl, xu, yl, yu, lineorder, 1 ) plot( c(0, 0), c(50, 50), xlim = c(0, 0), ylim = c(0, 0), type = "n", xlab = " ", ylab = " ", axes = FALSE ) title(as.character(ii)) } } } #================================================================================== plot3Ddata.static <- function(dna.data, land = 1:k, objects = 1:n, joinline = c(1, 1)) { dna <- procGPA(dna.data[, , 1:2]) w1 <- defplotsize2(dna.data[, 1:2, ]) w2 <- defplotsize2(dna.data[, c(1, 3), ]) w3 <- defplotsize2(dna.data[, c(2, 3), ]) width <- max(c(w1$width, w2$width, w3$width)) xl <- min(c(w1$xl, w2$xl, w3$xl)) xu <- xl + width yl <- min(c(w1$yl, w2$yl, w3$yl)) yu <- yl + width n <- dim(dna.data)[3] k <- dim(dna.data)[1] m <- dim(dna.data)[2] par(mfrow = c(1, 1)) par(pty = "s") lineorder <- joinline par(mfrow = c(2, 2)) mag <- 0 pcno <- 1 ii <- 1 view1 <- 1 view2 <- 2 view3 <- 3 plotPDMnoaxis3( c(dna.data[land, view1, ii], dna.data[land, view2, ii]), c(dna$pcar[((view1 - 1) * k + (land)), pcno], dna$pcar[((view2 - 1) * k + (land)), pcno]), mag * dna$pcasd[pcno], xl, xu, yl, yu, lineorder, 1 ) for (ii in objects) { pointsPDMnoaxis3( c(dna.data[land, view1, ii], dna.data[land, view2, ii]), c(dna$pcar[((view1 - 1) * k + (land)), pcno], dna$pcar[((view2 - 1) * k + (land)), pcno]), mag * dna$pcasd[pcno], xl, xu, yl, yu, lineorder, 1 ) } view1 <- 1 view2 <- 3 view3 <- 2 plotPDMnoaxis3( c(dna.data[land, view1, ii], dna.data[land, view2, ii]), c(dna$pcar[((view1 - 1) * k + (land)), pcno], dna$pcar[((view2 - 1) * k + (land)), pcno]), mag * dna$pcasd[pcno], xl, xu, yl, yu, lineorder, 1 ) for (ii in objects) { pointsPDMnoaxis3( c(dna.data[land, view1, ii], dna.data[land, view2, ii]), c(dna$pcar[((view1 - 1) * k + (land)), pcno], dna$pcar[((view2 - 1) * k + (land)), pcno]), mag * dna$pcasd[pcno], xl, xu, yl, yu, lineorder, 1 ) } view1 <- 2 view2 <- 3 view3 <- 1 plotPDMnoaxis3( c(dna.data[land, view1, ii], dna.data[land, view2, ii]), c(dna$pcar[((view1 - 1) * k + (land)), pcno], dna$pcar[((view2 - 1) * k + (land)), pcno]), mag * dna$pcasd[pcno], xl, xu, yl, yu, lineorder, 1 ) for (ii in objects) { pointsPDMnoaxis3( c(dna.data[land, view1, ii], dna.data[land, view2, ii]), c(dna$pcar[((view1 - 1) * k + (land)), pcno], dna$pcar[((view2 - 1) * k + (land)), pcno]), mag * dna$pcasd[pcno], xl, xu, yl, yu, lineorder, 1 ) } } #================================================================================== plot3Dmean <- function(dna) { land <- 1:dim(dna$mshape)[1] w1 <- defplotsize2(dna$rotated[, 1:2, ]) w2 <- defplotsize2(dna$rotated[, c(1, 3), ]) w3 <- defplotsize2(dna$rotated[, c(2, 3), ]) width <- max(c(w1$width, w2$width, w3$width)) xl <- min(c(w1$xl, w2$xl, w3$xl)) xu <- xl + width yl <- min(c(w1$yl, w2$yl, w3$yl)) yu <- yl + width par(mfrow = c(2, 2)) par(pty = "s") plot( dna$mshape[land, 1], dna$mshape[land, 2], xlim = c(xl, xu), ylim = c(yl, yu), xlab = " ", ylab = " " ) text(dna$mshape[land, 1], dna$mshape[land, 2], land) lines(dna$mshape[land, 1], dna$mshape[land, 2]) plot( dna$mshape[land, 1], dna$mshape[land, 3], xlim = c(xl, xu), ylim = c(yl, yu), xlab = " ", ylab = " " ) text(dna$mshape[land, 1], dna$mshape[land, 3], land) lines(dna$mshape[land, 1], dna$mshape[land, 3]) plot( dna$mshape[land, 2], dna$mshape[land, 3], xlim = c(xl, xu), ylim = c(yl, yu), xlab = " ", ylab = " " ) text(dna$mshape[land, 2], dna$mshape[land, 3], land) lines(dna$mshape[land, 2], dna$mshape[land, 3]) title("Procrustes mean shape estimate") } #================================================================================== plot3Dpca <- function(dna, pcno, joinline = c(1, 1)) { #choose subset w1 <- defplotsize2(dna$rotated[, 1:2, ]) w2 <- defplotsize2(dna$rotated[, c(1, 3), ]) w3 <- defplotsize2(dna$rotated[, c(2, 3), ]) width <- max(c(w1$width, w2$width, w3$width)) xl <- min(c(w1$xl, w2$xl, w3$xl)) - width / 4 xu <- xl + width * 1.5 yl <- min(c(w1$yl, w2$yl, w3$yl)) - width / 4 yu <- yl + width * 1.5 k <- dim(dna$mshape)[1] lineorder <- joinline par(mfrow = c(1, 1)) cat("X-Y view \n") view1 <- 1 view2 <- 2 view3 <- 3 land <- c(1:k) for (j in 1:10) { for (ii in-12:12) { mag <- ii / 4 plotPDMnoaxis3( c(dna$mshape[land, view1], dna$mshape[land, view2]), c(dna$pcar[((view1 - 1) * k + (land)), pcno], dna$pcar[((view2 - 1) * k + (land)), pcno]), mag * dna$pcasd[pcno], xl, xu, yl, yu, lineorder, 1 ) } for (ii in-11:11) { mag <- -ii / 4 plotPDMnoaxis3( c(dna$mshape[land, view1], dna$mshape[land, view2]), c(dna$pcar[((view1 - 1) * k + (land)), pcno], dna$pcar[((view2 - 1) * k + (land)), pcno]), mag * dna$pcasd[pcno], xl, xu, yl, yu, lineorder, 1 ) } } #choose subset par(mfrow = c(1, 1)) cat("X-Z view \n") view1 <- 1 view2 <- 3 view3 <- 2 land <- c(1:k) for (j in 1:10) { for (ii in-12:12) { mag <- ii / 4 plotPDMnoaxis3( c(dna$mshape[land, view1], dna$mshape[land, view2]), c(dna$pcar[((view1 - 1) * k + (land)), pcno], dna$pcar[((view2 - 1) * k + (land)), pcno]), mag * dna$pcasd[pcno], xl, xu, yl, yu, lineorder, 1 ) } for (ii in-11:11) { mag <- -ii / 4 plotPDMnoaxis3( c(dna$mshape[land, view1], dna$mshape[land, view2]), c(dna$pcar[((view1 - 1) * k + (land)), pcno], dna$pcar[((view2 - 1) * k + (land)), pcno]), mag * dna$pcasd[pcno], xl, xu, yl, yu, lineorder, 1 ) } } #choose subset par(mfrow = c(1, 1)) cat("Y-Z view \n") view1 <- 2 view2 <- 3 view3 <- 1 land <- c(1:k) for (j in 1:10) { for (ii in-12:12) { mag <- ii / 4 plotPDMnoaxis3( c(dna$mshape[land, view1], dna$mshape[land, view2]), c(dna$pcar[((view1 - 1) * k + (land)), pcno], dna$pcar[((view2 - 1) * k + (land)), pcno]), mag * dna$pcasd[pcno], xl, xu, yl, yu, lineorder, 1 ) } for (ii in-11:11) { mag <- -ii / 4 plotPDMnoaxis3( c(dna$mshape[land, view1], dna$mshape[land, view2]), c(dna$pcar[((view1 - 1) * k + (land)), pcno], dna$pcar[((view2 - 1) * k + (land)), pcno]), mag * dna$pcasd[pcno], xl, xu, yl, yu, lineorder, 1 ) } } } #================================================================================== banner1 <- function(char) { par(mfrow = c(1, 1)) plot( c(0, 0), c(1, 1), axes = FALSE, type = "n", xlab = " ", ylab = " " ) a1 <- char if (length(a1) == 2) a1 <- paste(a1[1], a1[2]) if (length(a1) == 3) a1 <- paste(a1[1], a1[2], a1[3]) if (is.character(a1) == FALSE) char <- as.character(a1) title(a1) } #================================================================================== banner4 <- function(a1, a2, a3, a4) { par(mfrow = c(2, 2)) plot( c(0, 0), c(1, 1), axes = FALSE, type = "n", xlab = " ", ylab = " " ) if (length(a1) == 2) a1 <- paste(a1[1], a1[2]) if (length(a1) == 3) a1 <- paste(a1[1], a1[2], a1[3]) if (is.character(a1) == FALSE) a1 <- as.character(a1) title(a1) plot( c(0, 0), c(1, 1), axes = FALSE, type = "n", xlab = " ", ylab = " " ) if (length(a2) == 2) a2 <- paste(a2[1], a2[2]) if (length(a2) == 3) a2 <- paste(a2[1], a2[2], a2[3]) if (is.character(a2) == FALSE) a2 <- as.character(a2) title(a2) plot( c(0, 0), c(1, 1), axes = FALSE, type = "n", xlab = " ", ylab = " " ) if (length(a3) == 2) a3 <- paste(a3[1], a3[2]) if (length(a3) == 3) a3 <- paste(a3[1], a3[2], a3[3]) if (is.character(a3) == FALSE) a3 <- as.character(a3) title(a3) plot( c(0, 0), c(1, 1), axes = FALSE, type = "n", xlab = " ", ylab = " " ) if (length(a4) == 2) a4 <- paste(a4[1], a4[2]) if (length(a4) == 3) a4 <- paste(a4[1], a4[2], a4[3]) if (is.character(a4) == FALSE) a4 <- as.character(a4) title(a4) } ####### #exact Gaussian MLE - isotropic distribution #######not fully tested yet #================================================================================== isomle <- function(x) { if (is.complex(x)) { tem <- array(0, c(nrow(x), 2, ncol(x))) tem[, 1,] <- Re(x) tem[, 2,] <- Im(x) x <- tem } k <- dim(x)[1] m <- dim(x)[2] n <- dim(x)[3] if (m > 2) { print("Only valid for 2D data") } if (m == 2) { pm <- rep(0, times = 2 * k - 3) tem <- procrustes2d(x) tem1 <- bookstein.shpv(tem$mshape) sigm <- sum(diag(var(tem$tan))) / (n - 1) / 2 #cat("Isotropic shape MLE \n") pm[1:(k - 2)] <- tem1[3:k, 1] pm[(k - 1):(2 * k - 4)] <- tem1[3:k, 2] pm[2 * k - 3] <- 10 ans <- nlm(objfuniso, hessian = TRUE, pm, uu = x) #while (ans$code!=1){ #print("code not equal 1") #print(pm) #pm<-pm+rnorm(2*k-3,0,0.1) #pm[2*k-3]<-abs(pm[2*k-3]) #ans<-nlm(objfuniso,hessian=TRUE,pm,uu=x) #print(ans) #} out <- list( code = 0, mshape = 0, tau = 0, kappa = 0, varcov = 0, gradient = 0 ) mn <- matrix(0, k, 2) mn[1, 1] <- -0.5 mn[2, 1] <- 0.5 mn[3:k, 1] <- ans$estimate[1:(k - 2)] mn[3:k, 2] <- ans$estimate[(k - 1):(2 * k - 4)] out$mshape <- mn out$code <- ans$code out$loglike <- -ans$minimum out$gradient <- ans$gradient out$tau <- sqrt(1 / ans$estimate[2 * k - 3] ** 2) out$kappa <- centroid.size(mn) ** 2 / (4 * out$tau ** 2) out$varcov <- solve(ans$hessian) out$se <- c(sqrt(diag(out$varcov))) out$se[2 * k - 3] <- out$se[2 * k - 3] * out$tau ** 2 out } } #================================================================================== objfuniso <- function(pm, uu) { k <- dim(uu)[1] h <- defh(k - 1) zero <- matrix(0, k - 1, k) L1 <- cbind(h, zero) L2 <- cbind(zero, h) L <- rbind(L1, L2) mustar <- c(-1 / 2, 1 / 2, pm[1:(k - 2)], 0, 0, pm[(k - 1):(2 * k - 4)]) mu <- L %*% mustar obj <- -loglikeiso2(uu, mu, 1 / pm[2 * k - 3]) obj } #================================================================================== loglikeiso <- function(uu, mu, s) { nsam <- dim(uu)[3] sum <- 0 for (i in 1:nsam) { sum <- sum + log(isodens(uu[, , i], mu, s)) } sum } #================================================================================== loglikeiso2 <- function(uu, mu, s) { nsam <- dim(uu)[3] sum <- 0 for (i in 1:nsam) { sum <- sum + isologdens(uu[, , i], mu, s) } sum } #================================================================================== isodens <- function(usam, mu, s) { k <- dim(usam)[1] u <- kendall.shpv(usam) uuu <- u[, 1] vvv <- u[, 2] up <- c(1, uuu, 0, vvv) vp <- c(0, -vvv, 1, uuu) usu <- t(up) %*% up beta <- c(t(mu) %*% up, t(mu) %*% vp) sin2rho <- 1 - t(beta) %*% beta / (usu * c(t(mu) %*% mu)) kappa <- c(t(mu) %*% mu) / (4 * s ** 2) #finf<-gamma(k-1)*pi/(pi*usu)**(k-1) dens <- oneFone(k - 2, 2 * kappa * (1 - sin2rho)) %*% exp(-2 * kappa * sin2rho) dens } #================================================================================== isologdens <- function(usam, mu, s) { k <- dim(usam)[1] u <- kendall.shpv(usam) uuu <- u[, 1] vvv <- u[, 2] up <- c(1, uuu, 0, vvv) vp <- c(0, -vvv, 1, uuu) usu <- t(up) %*% up beta <- c(t(mu) %*% up, t(mu) %*% vp) sin2rho <- 1 - t(beta) %*% beta / (usu * c(t(mu) %*% mu)) kappa <- c(t(mu) %*% mu) / (4 * s ** 2) #finf<-lgamma(k-1)+log(pi)-(k-1)*log(pi*usu) dens <- loneFone(k - 2, 2 * kappa * (1 - sin2rho)) - 2 * kappa * sin2rho c(dens) } #================================================================================== loneFone <- function(r, x) { #note this is log 1F1(-r,1,-x) if (x > 1) { sum1 <- r * log(x) sum <- 0 for (j in 0:r) { sum <- sum + choose(r, j) * x ** (j - r) / gamma(j + 1) } out <- sum1 + log(sum) } if (x <= 1) { sum <- 0 for (j in 0:r) { sum <- sum + choose(r, j) * x ** (j) / gamma(j + 1) } out <- log(sum) } out } #================================================================================== ild_kendall.shpv <- function(x) { k <- dim(x)[1] h <- defh(k - 1) zz <- h %*% x kendall <- (zz[2:(k - 1), 1] + 1i * zz[2:(k - 1), 2]) / (zz[1, 1] + 1i * zz[1, 2]) kendall <- cbind(Re(kendall), Im(kendall)) kendall } #================================================================================== oneFone <- function(r, x) { #note this is 1F1(-r,1,-x) sum <- 0 for (j in 0:r) { sum <- sum + choose(r, j) * x ** j / gamma(j + 1) } sum } #================================================================================== permutationtest <- function(A, B, nperms = 200) { A1 <- A A2 <- B B <- nperms nsam1 <- dim(A1)[3] nsam2 <- dim(A2)[3] Gtem <- Goodalltest(A1, A2) Htem <- Hotellingtest(A1, A2) Gumc <- Gtem$F Humc <- Htem$F Gtabpval <- Gtem$pval Htabpval <- Htem$pval if (B > 0) { Apool <- array(0, c(dim(A1)[1], dim(A1)[2], dim(A1)[3] + dim(A2)[3])) Apool[, , 1:nsam1] <- A1 Apool[, , (nsam1 + 1):(nsam1 + nsam2)] <- A2 out <- list( H = 0, H.pvalue = 0, H.table.pvalue = 0, G = 0, G.pvalue = 0, G.table.pvalue = 0 ) Gu <- rep(0, times = B) Hu <- rep(0, times = B) cat("Permutations - sampling without replacement: ") cat(c("No of permutations = ", B, "\n")) for (i in 1:B) { cat(c(i, " ")) select <- sample(1:(nsam1 + nsam2)) Gu[i] <- Goodalltest(Apool[, , select[1:nsam1]] , Apool[, , select[(nsam1 + 1):(nsam2 + nsam1)]])$F Hu[i] <- Hotellingtest(Apool[, , select[1:nsam1]], Apool[, , select[(nsam1 + 1):(nsam1 + nsam2)]])$F } Gu <- sort(Gu) numbig <- length(Gu[Gumc < Gu]) pvalG <- (1 + numbig) / (B + 1) Hu <- sort(Hu) numbig <- length(Hu[Humc < Hu]) pvalH <- (1 + numbig) / (B + 1) cat(" \n") out$H <- Humc out$H.pvalue <- pvalH out$H.table.pvalue <- Htabpval out$G <- Gumc out$G.pvalue <- pvalG out$G.table.pvalue <- Gtabpval } if (B == 0) { out <- list( H = 0, H.table.pvalue = 0, G = 0, G.table.pvalue = 0 ) out$H <- Humc out$H.table.pvalue <- Htabpval out$G <- Gumc out$G.table.pvalue <- Gtabpval } out } #================================================================================== permutationtest <- permutationtest2 #================================================================================== frechet <- function(x, mean = "intrinsic") { if (mean == "intrinsic") { option <- 1 } if (mean == "partial.procrustes") { option <- 2 } if (mean == "full.procrustes") { option <- 3 } if (mean == "mle") { option <- 4 } if (is.double(mean)) { if (mean > 0) { option <- -mean } } n <- dim(x)[3] for (i in 1:n) { x[, , i] <- x[, , i] / centroid.size(x[, , i]) } if (option < 4) { pm <- procGPA(x, scale = FALSE, tol1 = 10 ^ (-8))$mshape m <- dim(x)[2] k <- dim(x)[1] ans <- list( mshape = 0, var = 0, code = 0, gradient = 0 ) out <- nlm( objfun, hessian = TRUE, c(pm), uu = x, option = option, iterlim = 1000 ) B <- matrix(out$estimate, k, m) ans$mshape <- procOPA(pm, B)$Bhat ans$var <- out$minimum ans$code <- out$code ans$gradient <- out$gradient } if (option == 4) { pm <- procGPA(x, scale = FALSE, tol1 = 10 ^ (-8))$mshape m <- dim(x)[2] k <- dim(x)[1] if (m == 2) { theta <- c(log(centroid.size(pm) ** 2 / (4 * 0.1 ** 2)), pm) ans <- list( mshape = 0, kappa = 0, code = 0, gradient = 0 ) out <- nlm( objfun4, hessian = TRUE, theta, uu = x, iterlim = 1000 ) B <- matrix(out$estimate[-1], k, m) ans$mshape <- procOPA(pm, B)$Bhat ans$kappa <- exp(out$estimate[1]) ans$loglike <- -out$minimum ans$code <- out$code ans$gradient <- out$gradient } if (m != 2) { print("MLE is only appropriate for planar shapes") } } ans } #================================================================================== objfun <- function(pm, uu, option) { m <- dim(uu)[2] k <- dim(uu)[1] pm <- matrix(pm, k, m) sum <- 0 for (i in 1:dim(uu)[3]) { if (option == 1) { sum <- sum + (riemdist(pm, uu[, , i])) ** 2 } if (option == 2) { sum <- sum + 4 * sin(riemdist(pm, uu[, , i]) / 2) ** 2 } if (option == 3) { sum <- sum + sin(riemdist(pm, uu[, , i])) ** 2 } if (option < 0) { h <- -option sum <- sum + ((1 - cos(riemdist(pm, uu[, , i])) ** (2 * h)) / h) } } sum } #================================================================================== objfun4 <- function(pm, uu) { m <- dim(uu)[2] k <- dim(uu)[1] n <- dim(uu)[3] kappa <- exp(pm[1]) pm <- matrix(pm[-1], k, m) sum <- 0 for (i in 1:n) { sin2rho <- sin(riemdist(pm, uu[, , i])) ** 2 sum <- sum + loneFone(k - 2, 2 * kappa * (1 - sin2rho)) - 2 * kappa * sin2rho } - sum } #================================================================================== MDSshape <- function(x, alpha = 1, projalpha = 1 / 2) { mu <- procGPA(x)$mshape k <- dim(x)[1] n <- dim(x)[3] m <- dim(x)[2] H <- defh(k - 1) sum <- matrix(0, k - 1, k - 1) for (i in 1:n) { Z <- preshape(x[, , i]) if (alpha == 1) { sum <- sum + (Z) %*% t((Z)) } if (alpha == 1 / 2) { ee <- eigen((Z) %*% t((Z)), symmetric = TRUE) sum <- sum + ee$vectors %*% diag(sqrt(abs(ee$values))) %*% t(ee$vectors) } } eig <- eigen(sum / n, symmetric = TRUE) lam <- eig$values if (m == 2) { if (projalpha == 1 / 2) { meanshape <- cbind( t(H) %*% (sqrt(lam[1]) * eig$vectors[, 1]) / sqrt(lam[1] + lam[2]) , -t(H) %*% (sqrt(lam[2]) * eig$vectors[, 2]) / sqrt(lam[1] + lam[2]) ) } if (projalpha == 1) { lambar <- (lam[1] + lam[2]) / 2 meanshape <- cbind(t(H) %*% (sqrt(lam[1] - lambar + 1 / m) * eig$vectors[, 1]) , -t(H) %*% (sqrt(lam[2] - lambar + 1 / m) * eig$vectors[, 2])) } } if (m == 3) { if (projalpha == 1 / 2) { meanshape <- cbind( t(H) %*% (sqrt(lam[1]) * eig$vectors[, 1]) / sqrt(lam[1] + lam[2] + lam[3]) , t(H) %*% (sqrt(lam[2]) * eig$vectors[, 2]) / sqrt(lam[1] + lam[2] + lam[3]), t(H) %*% (sqrt(lam[3]) * eig$vectors[, 3]) / sqrt(lam[1] + lam[2] + lam[3]) ) } if (projalpha == 1) { lambar <- (lam[1] + lam[2] + lam[3]) / 3 meanshape <- cbind( t(H) %*% (sqrt(abs( lam[1] - lambar + 1 / m )) * eig$vectors[, 1]) , t(H) %*% (sqrt(abs( lam[2] - lambar + 1 / m )) * eig$vectors[, 2]) , t(H) %*% (sqrt(abs( lam[3] - lambar + 1 / m )) * eig$vectors[, 3]) ) } } if (riemdist(meanshape, mu) > riemdist(meanshape, mu, reflect = TRUE)) { meanshape[, m] <- -meanshape[, m] } meanshape } ################################################################################################ #The Procrustes routines in the next part were initially # written by Mohammad Faghihi (University of Leeds) 1993, although many improvements, corrections, # and speed-ups have been done since then. # add(a3) compute the summation of a3[,,i]'s # bgpa(a3) compute the scaling coefficients (bi's) # close1(a) adds one additional row to matrix a that is the same as the first row # cnt3(a3) replace each a3[ , , i] by fcnt(a3[ , , i]) # del(po, w1) plots point of po and joins them by contiguity matrix w1. # dif(a3) compute sum( tr (xi-xj)'(xi-xj) )/n^2 for i kk) { # qq<-diag(cov(vec1(zd))) qq <- rep(0, times = nn) for (i in 1:n) { qq[i] <- var(omat[i, ]) * (n - 1) / n omat[i, ] <- omat[i, ] - mean(omat[i, ]) } omat <- diag(sqrt(1 / qq)) %*% omat n <- kk Lmat <- t(omat) %*% omat / n eig <- eigen(Lmat, symmetric = TRUE) U <- eig$vectors lambda <- eig$values V <- omat %*% U vv <- rep(0, times = n) for (i in 1:n) { vv[i] <- sqrt(t(V[, i]) %*% V[, i]) V[, i] <- V[, i] / vv[i] } delta <- sqrt(abs(lambda / n)) * vv od <- order(delta, decreasing = TRUE) delta <- delta[od] V <- V[, od] h <- sqrt(s / aa) * V[, 1] } if (kk >= nn) { zz <- cor(vec1(zd)) h <- sqrt(s / aa) * eigen(zz)$vectors[, 1] } h <- abs(h) return(h) } #================================================================================== close1 <- function(a) { a1 <- matrix(0:0, nrow = dim(a)[1] + 1, ncol = dim(a)[2]) for (i in 1:dim(a)[1]) { a1[i,] <- a[i,] } a1[dim(a)[1] + 1,] <- a[1,] a1 } #================================================================================== cnt3 <- function(a3) { #zz <- array(c(0:0), dim = c(dim(a3)[1], dim(a3)[2], dim(a3)[3])) #for(i in 1:dim(a3)[3]) { #zz[, , i] <- fcnt(a3[, , i]) #} zz <- apply(a3, 3, fcnt) zz <- array(zz, dim(a3)) return(zz) } #================================================================================== del <- function(po, w1) { plot(po, type = "n", xlab = "x", ylab = "y") text(po) n <- dim(po)[1] for (i in 1:n) { for (j in i:n) { if (w1[i, j] > 0) { a1 <- c(po[i, 1], po[j, 1]) b1 <- c(po[i, 2], po[j, 2]) lines(a1, b1) } } } } #================================================================================== dis <- function(a, b, c) { d <- 0 d[1] <- sqrt((a[1] - b[1]) ^ 2 + (a[2] - b[2]) ^ 2) d[2] <- sqrt((a[1] - c[1]) ^ 2 + (a[2] - c[2]) ^ 2) d[3] <- sqrt((c[1] - b[1]) ^ 2 + (c[2] - b[2]) ^ 2) d } #================================================================================== dif.old <- function(a3) { s <- 0 for (i in 1:(dim(a3)[3] - 1)) { for (j in (i + 1):dim(a3)[3]) { s <- s + ((Enorm(a3[, , i] - a3[, , j])) ^ 2) } } return(s) } #dif<-function(a3) #original (slow) version #{ # s <- 0 #n<-dim(a3)[3] #mshape<-add(a3)/n #psum<-0 #for (i in 1:n){ #x<-a3[,,i]-mshape #psum<-psum+sum(diag(t(x)%*%x)) #} #psum*n #} #dif<-function(a3) ##faster version #{ #x<-sweep(a3,c(1,2),apply(a3,c(1,2),mean)) #z<-Enorm(as.vector(x))^2/dim(a3)[3] #z #} #================================================================================== dif <- function (a3) { #version that does not depend on scale of original measurements # assumes already centred cc <- centroid.size(add(a3) / dim(a3)[3]) x <- sweep(a3, c(1, 2), apply(a3, c(1, 2), mean)) z <- Enorm(as.vector(x) / cc) ^ 2 / dim(a3)[3] z } #================================================================================== fJ <- function(n) { zz <- matrix(1:1, n, n) H <- diag(n) - (1 / n) * zz H } #================================================================================== fcel <- function(n, d) { v <- ceiling(sqrt(n)) p <- matrix(c(0:0), n, 2) for (i in 1:v) { for (j in 1:v) { if ((v * (i - 1) + j) < (n + 1)) { p[(v * (i - 1) + j), 1] <- (d / 4) * (-1) ^ i + (d * j) p[(v * (i - 1) + j), 2] <- i * ((d * sqrt(3)) / 2) } } } p } #================================================================================== fcnt <- function(a) { aa <- fJ(dim(a)[1]) %*% a aa } #================================================================================== fgpa.singleiteration <- function(a3, p) { # Note this is an approximation to GPA - # It carries out an initial match by optimally rotating all the data, # the rescaling the observations, then rotating the observations # NB it does not repeat this until convergence, but in practice # for many real datasets this gives an excellent registration # zd <- list( rot. = 0, r.s.r. = 0, Gpa = 0, I.no. = 0, mshape = 0 ) zd$rot. <- rgpa(a3, p) zz <- rgpa(sgpa(zd$rot.$rotated), p) zd$r.s.r. <- zz$rotated zd$Gpa <- zz$dif zd$I.no. <- zz$r.no. zd$mshape <- msh(zd$r.s.r.) return(zd) } #================================================================================== fgpa <- function(a3, tol1, tol2, proc.output = FALSE, reflect = FALSE) { # # Fully iterative fgpa (now assumes a3 is already centred) # # zd <- list( rot. = 0, r.s.r. = 0, Gpa = 0, I.no. = 0, mshape = 0 ) p <- tol1 if (proc.output) { cat(" Step | Objective function | change \n") } if (proc.output) { cat("---------------------------------------------------\n") } x1 <- dif(a3) if (proc.output) { cat("Initial objective fn", x1, " - \n") } if (proc.output) { cat("-----------------------------------------\n") } zz <- rgpa(a3, p, proc.output = proc.output, reflect = reflect) x2 <- dif(zz$rotated) if (proc.output) { cat("Rotation step 0", x2, x1 - x2, " \n") } if (proc.output) { cat("-----------------------------------------\n") } ii <- 1 zz <- rgpa( sgpa(zz$rotated, proc.output = proc.output), p, proc.output = proc.output, reflect = reflect ) x1 <- x2 x2 <- dif(zz$rotated) rho <- x1 - x2 if (proc.output) { cat("Scale/rotate step ", ii, x2, rho, " \n") } if (proc.output) { cat("-----------------------------------------\n") } if (rho > tol2) { while (rho > tol2) { x1 <- x2 ii <- ii + 1 zz <- rgpa( sgpa(zz$rotated, proc.output = proc.output), p, proc.output = proc.output, reflect = reflect ) x2 <- dif(zz$rotated) rho <- x1 - x2 if (proc.output) { cat("Scale/rotate step ", ii, x2, rho, " \n") } if (proc.output) { cat("-----------------------------------------\n") } } } zd$r.s.r. <- zz$rotated zd$Gpa <- zz$dif zd$I.no. <- ii zd$mshape <- msh(zd$r.s.r.) return(zd) } #================================================================================== fgpa.rot <- function(a3, tol1, tol2, proc.output = FALSE, reflect = FALSE) { # Assumes that a3 has been centred already zd <- list( rot. = 0, r.s.r. = 0, Gpa = 0, I.no. = 0, mshape = 0 ) p <- tol1 zz <- rgpa(a3, p, proc.output = proc.output, reflect = reflect) x1 <- msh(zz$rotated) ii <- zz$r.no. # zz <- rgpa(zz$rotated, p,proc.output=proc.output,reflect=reflect) #x2<-msh(zz$rotated) #rho<-riemdist(x1,x2) # while (rho > tol2){ #print(rho) #x1<-x2 #ii<-ii+1 # zz <- rgpa(zz$rotated, p,proc.output=proc.output) # x2<-msh(zz$rotated) #rho<-riemdist(x1,x2) # } zd$r.s.r. <- zz$rotated zd$Gpa <- zz$dif zd$I.no. <- ii zd$mshape <- msh(zd$r.s.r.) return(zd) } #================================================================================== fopa <- function(a, b) { abar <- fcnt(a) bbar <- fcnt(b) q1 <- sum(diag(abar %*% t(abar))) q2 <- fos(a, b) ^ 2 * sum(diag(bbar %*% t(bbar))) q3 <- 2 * fos(a, b) * sum(diag(fort(a, b) %*% t(abar) %*% bbar)) gs <- q1 + q2 - q3 gs } #================================================================================== fort.ROTATEANDREFLECT <- function(a, b) { x <- t(fcnt(a)) %*% fcnt(b) xsvd <- svd(x) t <- xsvd$v %*% t(xsvd$u) return(t) } #================================================================================== fos.REFLECT <- function(a, b) { abar <- fcnt(a) bbar <- fcnt(b) z <- ftrsq(abar, bbar) / sum(diag(t(bbar) %*% bbar)) z } #================================================================================== fos <- function (a, b) { z <- cos(riemdist(a, b)) * centroid.size(a) / centroid.size(b) z } #================================================================================== ftrsq <- function(a, b) { z <- sum(sqrt(abs(eigen( t(b) %*% a %*% t(a) %*% b )$values))) z } #================================================================================== graf <- function(a3) { l <- 0 xmin <- 0 xmax <- 0 ymin <- 0 ymax <- 0 for (i in 1:dim(a3)[3]) { xmin[i] <- min(a3[, 1, i]) xmax[i] <- max(a3[, 1, i]) ymin[i] <- min(a3[, 2, i]) ymax[i] <- max(a3[, 2, i]) } l <- c(min(xmin), min(ymin), max(xmax), max(ymax)) plot((min(l) - 1):(max(l) + 1), (min(l) - 1):(max(l) + 1), type = "n") for (i in 1:dim(a3)[3]) { lines(close1(a3[, , i])) } } #================================================================================== msh <- function(a3) { s <- 0 # print("finding mean shape") m <- apply(a3, c(1, 2), mean) # print("found mean shape") # for(i in 1:dim(a3)[3]) { # s <- s + a3[, , i] # } # m <- (1/dim(a3)[3]) * s return(m) } #Enorm<-function(a) #{ # return(sqrt(sum(diag(t(a) %*% a)))) #} #================================================================================== rgpa <- function(a3, p, reflect = FALSE, proc.output = FALSE) { # assumes a3 already centred now if (reflect == TRUE) { fort <- fort.ROTATEANDREFLECT } zd <- list( rotated = 0, dif = 0, r.no. = 0, inc = 0 ) l <- dim(a3)[3] a <- 0 d <- 0 n <- 0 # zz <- cnt3(a3) zz <- a3 # print("Rotations ...") # print("Iteration,meanSS before,meanSS after,difference,tolerance") d[1] <- 10 ^ 12 d[2] <- dif(zz) a[1] <- d[2] s <- add(zz) # print(c(d[1],d[2])) if (dif(zz) > p) { while (d[1] - d[2] > p) { n <- n + 1 d[1] <- d[2] for (i in 1:l) { old <- zz[, , i] zz[, , i] <- old %*% fort(((1 / (l - 1)) * (s - old)), old) s <- s - old + zz[, , i] } d[2] <- dif(zz) a[n + 1] <- d[2] # print(c(n,d[1],d[2],d[1]-d[2],p)) if (proc.output) { cat(" Rotation iteration ", n, d[2], d[1] - d[2], " \n") } } } zd$rotated <- zz zd$dif <- a zd$r.no. <- n zd$inc <- d[1] - d[2] if (proc.output) { cat("-----------------------------------------\n") } fort <- fort.ROTATION return(zd) } # sgpa<-function(a3) #{ # zz <- a3 # a <- bgpa(zz) # for(i in 1:dim(a3)[3]) { # zz[, , i] <- a[i] * a3[, , i] # } # return(zz) #} #================================================================================== sgpa <- function(a3, proc.output = FALSE) { #assumes a3 is centred zz <- a3 di <- dim(a3) a <- bgpa(zz, proc.output = proc.output) i <- rep(dim(a3)[1] * dim(a3)[2], dim(a3)[3]) sequen <- rep(a, i) zz <- array(as.vector(a3) * sequen, di) if (proc.output) { cat(" Scaling updated \n") } return(zz) } #================================================================================== sh <- function(a) { u1 <- (a[2, 1] - a[1, 1]) / sqrt(2) u2 <- (a[2, 2] - a[1, 2]) / sqrt(2) v1 <- (2 * a[3, 1] - a[2, 1] - a[1, 1]) / sqrt(6) v2 <- (2 * a[3, 2] - a[2, 2] - a[1, 2]) / sqrt(6) d <- c(0, 0) d[1] <- (u1 * v1 + u2 * v2) / (u1 ^ 2 + u2 ^ 2) d[2] <- (u1 * v2 - u2 * v1) / (u1 ^ 2 + u2 ^ 2) d } #================================================================================== sim1 <- function(n, d, s) { a <- fcel(n, d) sig <- matrix(c(1:1), n, 1)[, 1] sig <- sig * s b <- a b[, 1] <- rnorm(n, mean = a[, 1], sd = sig) b[, 2] <- rnorm(n, mean = a[, 2], sd = sig) b } #================================================================================== vec1 <- function(a3) { #zz <- array(c(0:0), dim = c((dim(a3)[1] * dim(a3)[2]), dim(a3)[3])) #for(i in 1:dim(a3)[3]) { #for(j in 1:dim(a3)[2]) { #for(k in 1:dim(a3)[1]) { #zz[((j - 1) * dim(a3)[1] + k), i] <- a3[k, j, i #] #} #} #} zz <- matrix(a3, dim(a3)[1] * dim(a3)[2], dim(a3)[3]) return(zz) } #================================================================================== fort.ROTATION <- function(a, b) { x <- t(fcnt(a)) %*% fcnt(b) xsvd <- svd(x) v <- xsvd$v u <- xsvd$u tt <- v %*% t(u) chk1 <- Re(prod(eigen(v)$values)) chk2 <- Re(prod(eigen(u)$values)) if ((chk1 < 0) && (chk2 > 0)) { v[, dim(v)[2]] <- v[, dim(v)[2]] * (-1) tt <- v %*% t(u) } if ((chk2 < 0) && (chk1 > 0)) { u[, dim(u)[2]] <- u[, dim(u)[2]] * (-1) tt <- v %*% t(u) } return(tt) } ############end of Mohammad Faghihi's (adapted) routines #alias functions (all lower-case) hotelling2d <- Hotelling2D hotellingtest <- Hotellingtest procrustesgpa <- procrustesGPA goodall2d <- Goodall2D goodalltest <- Goodalltest # alias TPSgrid <- tpsgrid #if you wish the default to *not* include reflection #invariance (as is normal in shape analysis) then you need the line below. fort <- fort.ROTATION ################################################################################ # # Datasets # ################################################################################ #================================================================================== # Gorillas #================================================================================== gorf.dat<-array(c(5,193,53,-27,0,0,0,33,-2,105,18,176,72,114,92,38 ,51,191,55,-31,0,0,0,33,25,106,56,171,98,105,99,15 ,36,187,59,-31,0,0,0,36,12,102,38,171,91,103,100,19 ,23,202,48,-30,0,0,0,39,3,103,33,180,84,112,94,28 ,30,185,62,-25,0,0,0,32,11,101,37,168,85,106,96,21 ,4,195,65,-21,0,0,0,34,-4,100,15,180,69,120,102,34 ,37,195,62,-32,0,0,0,35,20,101,50,173,102,105,105,22 ,41,191,58,-34,0,0,0,34,15,100,47,175,93,105,99,18 ,40,190,52,-33,0,0,0,38,13,107,44,176,88,113,102,31 ,-4,179,62,-21,0,0,0,29,1,89,9,164,70,111,100,36 ,41,206,53,-25,0,0,0,39,11,104,47,177,95,111,95,26 ,33,197,55,-30,0,0,0,35,7,106,39,175,89,111,95,24 ,-12,205,52,-15,0,0,0,38,-10,111,4,187,66,129,80,44 ,13,186,56,-32,0,0,0,34,8,101,25,166,80,105,97,26 ,20,186,45,-31,0,0,0,34,10,96,31,165,84,104,90,19 ,29,183,55,-31,0,0,0,32,10,98,39,163,82,106,95,17 ,11,203,57,-28,0,0,0,39,-2,106,23,182,77,122,100,36 ,37,187,54,-27,0,0,0,34,11,100,43,171,84,106,93,28 ,49,191,53,-31,0,0,0,35,21,102,54,172,94,98,99,18 ,-8,191,57,-34,0,0,0,32,-7,93,6,173,71,119,101,30 ,43,184,49,-32,0,0,0,33,14,100,49,165,91,99,98,20 ,57,185,62,-37,0,0,0,35,22,103,61,169,96,100,104,24 ,-10,196,55,-20,0,0,0,38,-10,107,5,181,73,123,88,46 ,20,195,60,-28,0,0,0,32,6,101,33,173,84,114,100,30 ,35,202,59,-27,0,0,0,34,6,108,41,182,83,117,99,31 ,1,188,60,-19,0,0,0,35,-2,99,12,170,70,119,93,45 ,24,194,52,-24,0,0,0,39,8,105,34,174,80,115,95,32 ,25,204,55,-27,0,0,0,34,7,108,35,185,83,118,92,32 ,36,198,47,-30,0,0,0,39,14,110,43,177,92,105,98,25 ,8,198,53,-35,0,0,0,34,4,101,22,175,82,111,100,24),c(2,8,30)) gorf.dat<-aperm(gorf.dat,c(2,1,3)) gorm.dat<-array(c(53,220,46,-35,0,0,0,37,12,122,58,204,93,117,103,28 ,57,219,50,-43,0,0,0,37,13,119,61,198,102,110,104,20 ,89,227,52,-47,0,0,0,32,35,120,93,201,131,92,104,4 ,46,222,51,-45,0,0,0,30,11,113,54,196,101,117,101,16 ,85,220,48,-38,0,0,0,39,28,125,87,203,121,106,103,7 ,64,208,43,-39,0,0,0,36,22,111,67,191,104,102,101,18 ,67,216,51,-37,0,0,0,35,17,119,68,191,108,109,94,15 ,35,236,61,-42,0,0,0,33,2,119,43,211,90,126,104,30 ,116,218,40,-38,0,0,0,41,41,124,116,201,133,94,103,12 ,56,234,60,-34,0,0,0,34,12,121,58,215,109,119,112,28 ,40,223,58,-36,0,0,0,34,9,113,46,202,97,120,112,24 ,94,223,49,-57,0,0,0,33,31,122,94,206,136,99,113,-1 ,68,222,59,-41,0,0,0,30,18,119,68,204,104,114,98,11 ,65,224,56,-33,0,0,0,35,15,130,67,205,108,115,95,20 ,67,214,52,-47,0,0,0,36,26,115,74,192,114,105,104,11 ,110,213,52,-46,0,0,0,37,42,121,109,190,133,97,108,-8 ,46,219,50,-42,0,0,0,36,11,121,56,199,104,108,102,21 ,79,209,66,-43,0,0,0,35,24,114,84,193,108,115,109,14 ,58,244,74,-22,0,0,0,37,7,131,64,219,98,128,100,29 ,43,236,64,-43,0,0,0,33,12,124,52,215,110,121,105,7 ,70,226,54,-37,0,0,0,39,28,121,74,204,122,105,107,7 ,68,224,55,-37,0,0,0,35,18,121,71,207,109,108,98,13 ,34,247,63,-35,0,0,0,35,4,124,45,225,104,135,110,29 ,49,236,59,-40,0,0,0,38,19,127,59,219,105,121,109,25 ,98,195,44,-44,0,0,0,36,30,116,98,177,121,89,105,10 ,109,208,49,-40,0,0,0,36,29,125,105,189,120,102,102,12 ,61,224,51,-35,0,0,0,41,15,122,67,206,107,121,103,25 ,43,213,49,-57,0,0,0,28,20,111,58,194,112,106,108,6 ,26,249,67,-14,0,0,0,38,-11,130,33,225,87,148,97,53),c(2,8,29)) gorm.dat<-aperm(gorm.dat,c(2,1,3)) #================================================================================== # mice #================================================================================== qset2.dat<-array(c(117.98,219.62,114.52,41.93,166.15,113.59,206.54,121.79,165.11,142.92,62.07,136.58 ,105.52,235.08,109.96,57.31,165.44,126.42,223.05,140.88,169.58,156.83,59.5,138.02 ,142.83,222,132.08,40.2,188.8,115.39,236.9,125.08,193.18,142.22,83.37,141.47 ,126.35,204.27,113.2,36.04,171.77,102.43,228.93,111.75,173.55,131.8,66.26,126.65 ,99.11,231.52,119.58,44.52,169.28,129.51,219.93,141.98,167.65,154.41,56.83,141.64 ,134.14,228.48,129.09,56.98,175.85,125.39,217.57,138.01,179.29,152.67,73.84,153.08 ,119.8,219.48,122.36,48.52,171.44,115.58,216.57,131.13,170.86,148.36,65.8,138.8 ,105.62,222.74,96.27,51.3,152.13,119.07,205.02,131.95,157.36,141.61,52.35,142.73 ,122.15,202.41,128.75,32.09,176.88,102.84,220.81,119.41,177.78,131.04,76.65,120.61 ,127.78,223.48,117.65,53.94,183.45,123.87,236.96,133.84,184.24,149.04,77.96,149.95 ,123.4,200.6,116.57,28.43,172.67,97.33,221.34,106.24,175.29,122.05,64.69,115.53 ,132.4,227.96,127.46,50.4,171.57,118.67,203.72,131.91,175.25,152.38,71.98,138.5 ,123.39,216.23,113.96,29.9,167.68,105.58,202.15,114.18,172.01,133.8,65.78,125.86 ,136.83,207.84,117.37,33.67,178.1,100.65,233.17,111.44,184.05,124.85,69.8,129.69 ,143.31,219.71,122.1,48.08,177.23,113.52,221.38,122.32,180.86,140.87,80.11,151.72 ,105.96,218.06,100.46,48.73,155.23,119.51,217.76,130.01,159.11,145.49,51.29,139.66 ,115.73,234.14,115.74,56.11,168.42,128.73,220.32,135.6,169.4,154.65,66.02,152.32 ,101.73,215.74,102.67,35.73,151.69,110.19,199.12,120.24,151.6,136.36,48.82,132.42 ,124.93,222.42,130.09,46.89,163.86,118.81,197.76,137.59,165.11,148.92,67.45,139.67 ,104.68,231.95,88.17,53.4,150.87,128.76,203.38,143.96,151.59,152.11,41.85,151.15 ,123.93,242.1,121.99,64.08,175.47,143.77,211.56,155.4,173.07,164.91,68.98,158.26 ,137.21,207.27,130.76,34.56,188.92,105.07,242.85,109.74,187.67,127.43,80.29,127.14 ,107.35,212.21,89.5,38.88,151.63,105.73,196.56,113.82,152.69,133.73,46.53,135.99),c(2,6,23)) qset2.dat<-aperm(qset2.dat,c(2,1,3)) qcet2.dat<-array(c(168.59,35.66,159.99,215.17,104.93,141.07,49.01,115.13,101.69,110.87,227.11,120.51 ,165,38.35,163.89,214.32,108.26,144.79,50.17,124.02,103.5,113.13,220.43,122.65 ,166.97,39.44,163.63,221.62,108.18,147.07,54.11,137.43,109.15,118.11,227.89,128.32 ,164.02,44.22,171.76,237.29,95.93,161.44,32,131.85,95.91,126.54,222.54,133.51 ,153.46,40.67,156.62,225.12,103.81,152.44,43.65,139.01,99.95,120.7,216.62,132.9 ,148.3,52.66,147.61,239.16,90.37,164.39,32.39,145.13,88.1,130.85,209.22,145.88 ,141.33,32.7,128.49,215.09,71.39,135.31,18.32,115.62,77.48,102.92,186.28,125.49 ,130.21,18.71,136.38,201.17,68.85,125.19,11.43,94.64,64.22,90.83,184.64,107 ,130,26.8,134.24,217.41,77.07,141.93,14.66,122.68,74.56,105.14,189.9,109.31 ,134.99,22.44,116.08,205.87,74.69,130.05,22.18,96.09,68.08,95.91,185.97,115.99 ,146.87,22.6,111.5,201.74,77.67,124.1,23.04,97.03,80.91,85.93,192.2,118.4 ,146.26,23.38,119.94,209.46,75.94,125.31,19.72,100.92,82.97,87.47,192.22,109.63 ,138.32,25.44,119.25,208.88,71.18,133.17,16.68,103.45,69.21,98.08,178.43,123.71 ,142.57,19.25,99.1,197.59,62.7,111.06,3.94,86.78,69.17,79.06,180.48,117.38 ,144.57,21.44,129,204.76,80.93,121.11,18.96,103.58,82.35,90.59,191.23,111.98 ,137.6,19.71,120.16,214.71,77.7,128.06,16.08,102.22,73.54,90.19,193.21,118.14 ,123.81,22.67,118.93,207.44,73.63,129.11,4.94,104.21,71.72,100.35,191.62,119.61 ,131.1,28.64,94.82,211.86,59.44,129.47,3.89,102.71,70.28,95.52,178.71,131.69 ,155.84,22.41,112.53,207.45,68.64,118.65,8.37,97.65,78.78,85.28,184.6,114.92 ,174.04,27.44,108.13,202.49,80.74,111.51,20.1,79.49,96.21,80.84,205.25,127.23 ,127.85,20.44,119.59,208.01,61.98,125.83,4.2,112.66,80.06,90.68,182.45,108.83 ,146.48,28.36,113.82,214.92,75.14,127.12,14.06,98.64,81.57,96.68,198.33,125.63 ,139.46,33.99,99.48,220.24,73.24,135.58,8.99,105,75.01,103.38,191.51,135.63 ,152.27,30.86,138.67,226.92,91.78,137.46,24.93,121.51,92.28,107.03,216.37,131.07 ,139.15,28.78,133.63,210.56,88.84,131.16,26.42,112.92,87.97,99.71,201.01,119.24 ,153.32,20.49,109.35,201.5,76.58,109.87,10.91,91.13,74.45,85.03,183.14,119.64 ,166.02,23.04,140.31,215.68,91.82,128.43,26.01,109.78,94.61,99.14,212.09,119.48 ,127.79,22.26,136.79,202.76,89.87,131.73,26.63,113.72,88.85,90.81,198.88,105.03 ,169.22,26.47,158.71,210.32,102.37,134.39,30.64,108.87,100.56,97.55,220.44,125.16 ,146.88,23.83,116.78,218.55,84.03,132.22,25.08,111.84,89.31,94.31,194.7,129.03), c(2,6,30)) qcet2.dat<-aperm(qcet2.dat,c(2,1,3)) qlet2.dat<-array(c(134.26,224.28,122.34,36.86,174.35,111.24,235.79,127.9,174.49,142.43,51.5,141.89 ,139.29,231.38,80.82,47.82,159.37,105.97,236.93,120.91,162.59,139.69,39.92,163.16 ,151.57,219.95,104.42,49.26,162.95,105.68,241.12,123.23,181.45,133.49,60.47,151.83 ,146.16,231.16,95.78,46.87,170.85,111.77,234.72,109.48,178.8,140.05,56.79,157.8 ,150.16,222.81,81.59,53.08,161.66,102.76,238.7,94,173.74,131.99,42.42,166.01 ,134.04,218.32,84.43,40.37,155.91,104.39,227.07,112.75,163.69,135.45,45.04,154 ,141,221.6,98.86,46.69,160.43,112.77,218.15,114.61,162.83,136.17,37.06,153.86 ,123.63,231.23,66.42,46.17,140.02,108.31,217.82,118,147.98,137.78,25.35,159.24 ,137.62,226.64,96.5,39.64,164.59,105.39,235.04,102.87,169.37,134.5,46.83,150.8 ,173.79,206.17,90.39,27.9,161.84,84.83,234.85,91.6,180.59,110.28,55.57,160.27 ,117.39,233.75,114.47,42.63,167.1,124.53,229.45,135.47,167.66,150.42,40.92,142.56 ,131.55,225.48,102.05,26.81,161.73,103.06,244.48,115.44,170.49,133.86,38.65,144.13 ,134.78,226.28,110.56,41.28,170.17,112.5,231.45,114.1,176.5,139.26,51.28,145.88 ,115.95,227.77,85.99,46.33,156.48,111.17,220.59,117.43,161.6,140.85,43.06,154.56 ,133.09,226.95,99.38,40.42,160.22,111.1,236.36,117.74,168.23,138.63,44.79,149.37 ,125.36,216.11,93.92,36.95,161.42,103.33,220.04,104.98,165.19,129.44,43.48,133.74 ,123.1,202.86,99.27,42.82,157.22,98.93,206.46,111.18,162.05,129.3,64.39,123.39 ,121.37,217.11,108.09,34.09,155.47,105.03,214.66,121.61,160.24,135.04,48.64,133.8 ,120.54,232.1,85.37,53.23,157.81,109.98,213.66,117.86,169.01,146.01,38.88,151.63 ,126.42,222.64,82.96,46.57,157.34,100.52,218.67,101.9,165.27,131.51,42.51,147.56 ,126.91,220.11,105.38,35.76,158.15,109.6,207.12,117.23,160.11,138.72,40.17,142.75 ,117.87,227.17,113.96,49.9,163.19,119.44,228.16,124.54,163.3,152.93,42.17,141.99 ,125.23,224.48,93.4,39.47,166.22,109.39,234.83,108.47,165.65,139.89,42.06,144.54), c(2,6,23)) qlet2.dat<-aperm(qlet2.dat,c(2,1,3)) #================================================================================== digit3.dat<-c(9,27,12,31,17,36,26,39,34,37,36,33,38,27,35,19,30,15,21,14,21,8,16,6,8,5 ,17,40,21,38,26,36,27,32,25,28,22,27,19,29,24,25,26,20,28,16,26,13,18,14,15,17 ,19,38,24,38,29,33,30,29,27,24,21,25,17,26,27,24,30,22,31,19,31,16,27,15,24,15 ,9,40,15,43,24,41,29,36,24,30,20,26,12,22,20,22,24,20,21,16,18,14,13,12,9,10 ,14,41,21,42,29,42,35,37,32,33,26,30,16,26,25,26,29,24,33,20,30,16,23,11,16,12 ,24,39,28,40,35,38,38,35,34,30,29,27,22,24,27,24,29,22,31,19,28,15,20,11,13,12 ,9,39,15,39,21,40,25,36,23,31,21,27,19,25,21,25,23,24,25,22,22,19,15,17,8,17 ,8,38,14,41,25,43,29,38,25,33,18,29,8,28,12,27,16,25,18,23,13,21,7,21,1,22 ,4,34,12,39,22,42,31,36,27,30,23,28,11,25,20,25,22,24,22,22,19,19,13,18,8,18 ,21,36,25,37,31,36,33,32,32,28,29,25,27,22,29,21,31,20,31,18,28,16,24,16,20,16 ,14,40,20,39,25,37,27,31,26,28,20,29,16,31,21,28,25,23,28,16,25,13,17,15,13,18 ,12,40,20,42,30,42,36,33,31,24,23,22,16,23,25,22,31,18,33,13,31,9,24,8,17,8 ,9,35,17,36,26,34,30,31,26,27,20,25,13,27,19,25,23,21,26,15,22,12,12,12,7,13 ,17,38,24,39,30,37,34,34,31,28,22,25,16,28,21,26,27,24,30,20,26,15,18,14,10,17 ,21,35,27,36,36,35,39,28,38,22,34,18,28,19,31,18,33,17,31,15,26,15,20,17,14,20 ,16,40,20,43,25,39,27,31,24,24,19,21,17,23,19,22,21,21,23,21,22,18,19,16,15,16 ,15,41,21,45,34,44,40,39,36,35,26,30,16,29,24,25,28,20,31,16,28,14,21,14,12,12 ,11,42,22,42,32,39,35,34,32,29,25,26,20,27,25,26,31,23,35,19,31,14,21,12,16,15 ,5,44,15,43,24,41,29,36,22,28,13,28,5,29,14,28,24,26,29,22,26,19,17,17,10,20 ,14,37,19,39,25,38,28,32,25,26,20,22,14,23,17,23,21,20,23,17,21,15,16,15,11,15 ,16,35,22,38,30,36,32,29,29,23,23,20,17,20,20,19,24,17,26,14,21,11,16,12,12,15 ,14,38,17,40,25,42,28,38,27,32,24,28,20,25,23,25,26,24,28,21,24,18,18,17,10,18 ,7,40,13,43,22,45,31,42,27,38,21,34,13,32,18,31,24,30,27,27,23,23,15,22,6,22 ,14,35,21,36,26,34,31,30,28,26,25,22,21,18,21,17,22,16,23,15,20,12,13,10,5,10 ,10,46,17,47,27,43,29,36,26,30,22,29,16,28,20,27,21,25,23,21,21,19,15,20,9,20 ,18,39,24,42,33,41,38,35,37,30,32,28,28,27,33,22,37,18,41,15,37,13,29,11,21,12 ,18,38,22,42,30,42,34,36,33,32,29,30,22,28,25,26,28,24,28,20,27,19,22,18,18,18 ,9,41,17,43,30,40,34,31,30,23,23,19,11,19,15,17,18,13,21,10,17,8,12,7,5,7 ,8,36,12,42,20,43,25,38,24,35,23,33,21,32,20,31,20,30,20,27,16,25,9,24,2,25 ,19,41,24,45,33,45,38,38,36,31,28,27,21,23,24,22,26,20,28,17,26,14,20,13,14,11) digit3.dat<-array(digit3.dat,c(2,13,30)) digit3.dat<-aperm(digit3.dat,c(2,1,3)) digit3.dat[,2,]<- -digit3.dat[,2,] #================================================================================== dna.dat<-array(c(23.825,12.021,13.002,25.742,18.923,13.225,22.784,25.153,15.445,17.418 ,28.811,17.309,12.468,29.084,21.876,8.439,26.152,26.442,5.606,21.087 ,29.894,6.200,14.944,33.112,8.585,12.034,38.280,14.445,8.903,39.890 ,20.638,10.881,42.477,21.716,27.837,44.502,24.662,23.765,40.767,25.795 ,17.985,37.076,24.130,12.686,33.111,20.240,10.380,28.222,14.758,7.779 ,24.003,9.126,10.368,21.474,7.514,14.143,16.620,5.636,20.061,13.796 ,9.181,24.591,9.975,15.219,27.372,7.792 ,24.426,12.320,12.815,25.129,18.383,14.600,22.555,25.151,16.215,17.277 ,28.975,17.620,12.170,28.852,22.133,7.779,25.623,26.239,5.167,20.176 ,30.154,6.302,14.201,32.961,8.863,11.842,38.282,15.019,9.028,40.102 ,21.051,10.202,42.586,22.535,27.544,45.013,24.570,23.693,40.375,25.299 ,18.777,35.736,23.716,12.495,33.049,19.815,9.500,29.441,13.961,7.614 ,25.021,9.187,10.748,21.303,7.266,14.440,16.882,5.328,20.518,13.417 ,9.450,24.724,9.887,16.128,27.037,7.757 ,24.824,12.355,12.721,25.459,18.787,14.482,22.545,24.678,16.606,17.068 ,28.216,18.062,11.696,28.643,22.449,7.256,25.495,26.539,4.443,20.008 ,29.999,5.302,14.541,33.584,8.475,12.111,38.538,14.696,9.392,40.333 ,21.118,10.517,42.136,23.203,27.877,44.420,25.594,23.483,39.833,25.459 ,18.596,35.894,23.239,12.499,33.283,19.753,10.123,28.758,14.685,7.357 ,24.571,9.730,10.141,20.369,7.686,14.172,15.883,5.535,20.148,13.033 ,9.722,25.009,10.287,16.126,27.525,8.623 ,24.562,12.271,12.907,25.641,18.820,14.322,22.811,24.763,17.048,17.248 ,28.619,18.489,11.519,27.989,22.598,8.070,25.157,27.032,3.894,19.924 ,29.213,5.220,15.143,33.490,8.348,12.542,38.506,14.119,9.535,40.897 ,20.276,10.987,42.136,23.192,28.071,44.539,25.274,23.775,39.509,25.630 ,18.350,35.879,23.652,12.505,32.860,19.781,9.775,28.642,14.454,6.712 ,24.583,9.440,9.756,20.462,7.865,14.225,16.493,5.837,20.340,13.680 ,9.425,25.287,10.594,15.637,27.792,8.320 ,24.498,12.655,13.535,26.012,19.043,14.582,22.839,24.695,17.030,17.673 ,28.305,18.898,12.275,28.466,22.641,7.960,25.669,26.958,4.000,20.256 ,29.476,5.319,15.623,33.821,8.755,12.476,38.043,14.771,9.263,39.758 ,20.522,10.340,41.694,22.720,27.780,45.260,25.492,23.558,40.577,25.904 ,18.294,35.791,23.664,13.116,32.898,19.581,9.743,29.357,14.351,7.149 ,25.092,10.135,9.427,20.128,7.067,13.562,15.964,5.322,20.148,13.918 ,9.684,24.717,10.987,15.626,27.045,8.706 ,24.253,12.608,13.053,25.931,19.065,13.470,23.190,24.682,16.697,17.355 ,28.266,18.178,11.941,28.445,21.624,8.302,26.165,26.289,4.645,20.902 ,29.472,5.834,15.445,33.346,9.014,13.039,38.182,14.821,8.706,39.192 ,20.416,10.356,42.138,21.676,27.355,45.520,25.249,22.900,41.575,26.118 ,18.221,36.773,23.771,12.865,32.905,19.117,9.404,29.920,14.366,7.244 ,25.218,9.684,9.810,21.100,7.052,13.603,16.361,5.871,20.211,14.759 ,9.332,24.692,10.714,14.984,27.381,8.114 ,23.794,12.783,13.221,26.116,19.069,14.260,22.944,24.986,16.310,17.113 ,28.409,17.881,11.562,28.432,21.504,7.479,25.690,25.928,4.418,20.599 ,30.049,5.580,15.584,34.067,9.173,12.544,38.631,15.060,9.018,38.984 ,20.102,10.329,42.574,22.345,27.701,44.920,25.689,22.778,41.294,26.502 ,17.802,36.716,23.573,12.346,33.446,19.038,9.376,29.982,14.359,7.379 ,25.213,9.768,10.069,20.982,7.294,13.751,16.439,5.559,20.199,13.972 ,9.213,24.830,10.359,15.581,27.031,7.719 ,23.617,12.350,13.813,25.639,19.130,14.870,22.756,25.155,16.183,16.854 ,28.676,17.591,11.233,28.507,21.359,7.934,26.050,26.376,5.116,20.641 ,29.944,5.718,15.029,32.991,8.692,12.395,37.840,14.732,8.728,39.201 ,19.511,9.906,43.019,22.376,27.740,44.419,25.920,23.168,41.030,26.208 ,18.416,36.239,23.729,12.432,33.529,19.435,9.740,29.434,14.798,7.666 ,24.759,9.937,10.295,20.754,7.938,13.711,15.998,5.671,20.047,14.131 ,9.114,24.716,10.494,14.954,26.951,7.747 ,24.012,12.503,13.953,25.912,19.342,14.449,23.029,25.100,16.549,17.484 ,28.586,18.903,11.667,28.481,21.397,7.785,26.260,26.607,4.911,20.648 ,29.762,5.753,15.350,33.300,8.908,12.434,37.994,14.578,8.736,39.552 ,19.979,10.470,43.119,22.662,27.821,43.727,25.443,22.420,41.221,26.247 ,17.848,36.494,24.167,12.379,32.929,19.582,9.488,29.216,14.702,7.711 ,24.595,9.384,9.829,20.604,7.131,13.683,16.123,5.060,20.085,13.915 ,8.908,25.200,11.222,14.847,27.059,8.911 ,23.851,12.509,13.804,25.990,19.002,14.469,22.931,24.771,16.634,17.508 ,28.373,18.286,11.915,28.212,21.270,7.770,25.930,26.098,5.343,20.386 ,29.828,5.846,15.077,33.966,9.031,12.428,38.933,15.099,8.924,39.810 ,20.518,10.602,43.163,21.689,28.245,42.375,25.115,22.774,40.248,25.516 ,17.567,36.126,23.642,11.533,33.571,19.658,9.291,29.426,14.590,7.776 ,24.159,9.043,9.992,20.933,7.292,14.245,16.582,5.694,20.509,13.985 ,8.699,25.401,10.715,15.055,27.404,8.281 ,23.695,12.829,13.504,25.764,19.437,13.969,22.597,25.450,15.948,17.092 ,28.423,18.022,11.790,28.676,21.803,7.059,25.934,26.430,5.091,20.793 ,30.234,5.589,15.473,34.066,8.997,11.769,38.160,14.696,8.522,40.353 ,19.819,10.878,44.196,22.554,28.318,43.074,25.597,23.197,40.337,25.806 ,17.780,36.375,23.787,11.741,33.154,19.557,8.962,29.841,14.286,7.574 ,25.083,9.196,9.944,20.748,7.313,14.236,16.045,5.646,20.541,13.471 ,9.889,25.682,11.896,15.361,27.634,8.380 ,24.570,13.140,12.786,26.102,19.946,13.576,22.686,25.498,15.318,17.702 ,28.165,18.723,12.523,28.503,22.326,7.233,26.220,26.025,4.907,21.266 ,30.023,5.678,15.793,33.796,9.233,12.043,37.348,14.858,8.771,40.203 ,19.898,10.903,44.171,21.444,28.378,42.556,25.142,23.227,39.449,25.636 ,17.412,36.446,23.332,11.752,33.264,18.848,9.020,29.643,13.468,7.620 ,24.944,9.220,9.848,21.160,7.691,13.422,15.760,6.713,19.640,13.470 ,9.683,25.976,12.855,14.939,27.417,8.986 ,24.627,13.046,12.380,25.895,19.776,12.833,23.067,25.155,15.595,18.103 ,27.715,18.877,13.546,27.639,23.414,7.305,26.190,26.006,4.724,20.975 ,29.586,5.140,15.664,33.846,9.195,11.925,37.119,15.034,8.789,39.473 ,20.075,10.553,43.273,21.398,28.628,42.349,25.145,23.406,40.183,25.822 ,18.112,36.110,23.461,12.655,32.655,18.873,9.201,29.785,13.440,7.458 ,25.414,8.322,9.906,21.597,7.603,13.366,16.335,6.232,19.783,14.282 ,9.705,25.919,12.853,14.983,27.636,9.035 ,24.787,13.151,13.411,26.120,19.950,13.492,22.909,25.361,15.449,17.724 ,28.036,18.727,13.426,27.879,23.848,7.001,25.988,26.517,5.155,20.872 ,30.584,5.420,15.382,34.616,9.694,11.348,37.645,15.821,8.699,39.613 ,20.186,10.669,43.251,21.809,28.473,42.674,25.263,23.078,39.879,25.499 ,17.890,35.848,23.637,12.841,32.064,18.802,8.835,28.782,13.400,7.644 ,24.509,8.059,10.687,21.628,7.038,13.879,16.268,6.444,19.486,12.936 ,9.772,25.582,11.871,15.490,27.474,8.755 ,24.879,12.862,13.363,25.855,19.829,14.067,22.454,25.488,15.988,16.932 ,28.288,18.371,13.232,28.098,23.747,7.640,26.351,27.493,5.631,20.657 ,30.620,5.432,14.891,34.055,10.077,11.331,37.364,15.912,8.673,39.810 ,20.365,10.935,43.227,22.006,28.874,42.468,25.377,23.089,40.458,25.434 ,18.097,36.265,23.154,12.725,32.439,18.303,8.809,29.316,12.224,7.154 ,25.247,8.256,10.648,21.434,6.867,13.846,16.261,6.495,19.229,12.785 ,9.444,25.660,11.445,16.015,27.106,9.083 ,24.569,13.132,13.356,26.118,20.059,13.598,22.943,25.493,16.332,17.156 ,28.220,18.641,12.640,27.993,23.201,6.940,26.026,26.789,5.822,20.299 ,30.624,5.577,14.426,34.013,9.260,11.671,38.441,15.405,9.037,40.045 ,20.732,11.190,43.389,22.255,28.629,41.898,25.166,23.030,39.331,25.211 ,17.886,34.989,22.927,11.813,32.321,18.034,7.986,30.112,12.507,7.039 ,25.429,7.760,10.850,22.086,6.699,14.098,16.608,6.578,19.622,12.735 ,9.516,25.603,10.904,15.494,27.452,8.388 ,24.374,13.368,13.547,25.968,20.247,13.246,23.008,25.503,15.953,17.295 ,28.819,18.144,12.941,28.253,23.238,7.486,25.753,26.647,5.568,20.694 ,30.577,5.546,14.753,34.301,9.336,11.829,38.770,14.971,8.889,41.320 ,20.733,10.856,43.703,22.427,28.706,42.112,25.228,23.369,39.109,25.342 ,17.710,35.477,23.173,11.708,32.903,18.173,7.920,30.467,12.415,7.036 ,25.282,8.608,10.579,22.073,6.742,14.416,16.828,6.456,19.579,12.318 ,9.521,25.792,11.092,15.795,27.217,8.544 ,24.523,13.575,13.730,26.283,20.256,14.113,22.742,25.391,16.837,16.910 ,28.361,18.931,12.169,28.452,22.750,7.157,25.331,26.758,5.413,20.606 ,30.489,5.381,15.019,34.458,9.238,12.654,38.882,15.055,9.116,40.835 ,20.612,11.073,44.104,22.835,28.368,41.865,25.681,23.191,38.900,25.820 ,17.319,35.189,23.205,11.268,33.056,18.536,8.055,29.949,12.768,7.279 ,25.385,7.923,10.343,21.699,7.260,13.681,16.484,6.793,20.112,13.511 ,9.567,26.174,11.279,15.334,27.686,8.372 ,24.006,13.405,12.592,26.309,20.061,13.619,23.040,25.554,16.139,17.822 ,28.432,19.405,12.417,28.345,23.022,7.234,25.262,26.351,5.410,20.248 ,30.270,5.563,14.632,34.272,9.276,12.834,39.126,14.824,9.049,40.659 ,19.558,11.043,44.656,22.847,28.845,41.482,25.470,23.095,38.692,25.220 ,16.932,36.035,22.990,11.096,33.874,18.029,7.900,30.415,12.609,6.544 ,25.900,8.550,9.951,21.714,7.448,13.457,16.513,6.870,19.847,13.544 ,8.872,25.764,11.318,14.641,27.537,7.839 ,23.936,13.085,12.376,25.865,19.427,13.664,23.213,25.058,16.283,18.112 ,28.607,19.261,12.743,28.401,22.584,7.267,25.067,26.234,6.259,20.058 ,30.295,5.223,14.693,34.091,8.846,12.606,38.941,14.581,8.891,40.367 ,19.148,10.977,44.551,22.080,28.672,41.808,25.625,23.181,39.061,25.517 ,17.658,35.650,23.555,11.141,33.784,18.422,7.879,30.872,13.176,6.986 ,25.093,9.595,10.402,21.787,7.283,14.052,17.155,6.272,19.831,13.550 ,8.912,25.658,10.834,15.066,27.919,8.719 ,24.228,13.221,11.812,25.933,19.620,13.289,23.382,25.319,15.563,18.068 ,28.246,18.967,13.613,28.286,22.944,8.360,25.533,27.070,6.114,20.845 ,30.299,5.328,14.990,34.186,8.986,11.480,38.107,14.578,9.012,40.742 ,18.999,11.541,45.355,21.695,28.682,41.301,25.220,23.429,38.858,25.281 ,17.872,35.522,23.677,11.484,33.448,19.107,8.155,29.984,12.684,7.155 ,25.575,10.248,10.120,21.324,7.475,14.113,16.755,5.670,20.340,13.921 ,9.459,25.472,10.983,15.771,28.089,9.318 ,24.316,12.458,11.843,25.508,18.965,13.747,23.278,24.916,16.394,17.774 ,28.402,19.187,12.378,28.542,22.605,7.252,25.365,26.306,6.069,20.368 ,29.967,5.496,14.233,33.573,8.681,11.885,38.394,14.356,9.525,41.153 ,19.296,11.200,44.990,21.956,28.698,41.790,25.477,23.507,38.898,25.134 ,17.916,35.541,23.580,11.891,33.423,18.965,7.818,30.491,13.199,7.030 ,25.775,9.665,9.849,21.557,7.725,13.950,16.492,6.011,20.248,14.478 ,9.515,25.732,11.493,16.071,28.073,8.995 ,24.069,12.514,11.576,26.193,19.281,13.560,23.049,25.025,15.906,17.225 ,28.166,19.122,12.145,27.688,22.386,7.635,25.248,26.821,5.438,20.677 ,30.447,5.051,15.003,34.500,9.197,12.486,38.468,14.699,9.325,40.616 ,19.694,10.810,44.394,21.784,28.486,41.204,25.422,23.303,39.170,25.769 ,17.606,36.130,23.125,11.743,33.599,18.675,8.250,30.057,12.399,6.446 ,25.964,9.671,9.713,21.051,8.200,13.572,16.156,6.096,20.125,14.059 ,9.421,25.580,11.507,15.633,28.168,9.245 ,24.382,13.415,12.005,26.227,19.807,13.778,23.018,25.170,16.477,17.422 ,28.183,18.648,12.599,27.936,22.634,7.930,25.547,26.937,5.015,20.995 ,30.642,5.322,15.062,34.391,9.387,12.104,38.000,14.870,9.037,40.766 ,20.116,11.114,44.270,22.390,28.993,40.814,25.331,22.929,39.238,25.429 ,17.057,36.390,22.793,10.993,34.070,18.588,7.965,30.069,11.850,6.919 ,26.147,9.683,9.913,20.736,7.799,13.653,15.823,5.725,20.032,14.331 ,9.347,25.125,11.310,15.548,27.697,8.797 ,25.071,13.359,12.219,25.922,20.228,13.700,22.969,25.646,16.479,17.218 ,28.753,18.370,12.285,28.254,22.454,8.012,26.006,26.558,5.684,20.677 ,30.618,5.143,14.471,34.316,8.841,12.183,39.055,14.522,8.799,41.346 ,19.438,10.811,44.824,22.870,28.797,40.740,25.663,23.231,38.089,25.721 ,17.236,35.440,22.782,11.278,33.869,18.262,8.303,30.135,11.771,6.803 ,25.902,9.355,9.961,21.065,8.367,13.499,15.573,5.697,19.805,14.183 ,8.787,25.293,11.196,14.928,27.345,8.810 ,24.555,13.167,12.945,26.062,19.730,14.230,23.077,25.395,16.617,17.485 ,28.522,18.766,12.427,28.226,22.678,7.346,25.153,26.424,5.141,20.778 ,31.057,5.181,14.573,34.397,9.210,12.140,38.451,14.821,8.758,40.470 ,20.120,10.521,44.182,22.452,28.993,40.984,25.474,23.382,38.705,25.796 ,17.536,35.590,23.012,12.041,32.760,18.130,9.197,29.415,11.158,6.757 ,26.335,9.712,9.912,20.939,7.884,13.871,15.872,5.667,20.538,14.465 ,9.330,25.550,11.486,15.120,27.100,8.018 ,25.137,12.870,12.482,26.450,19.304,14.192,22.839,25.036,16.498,17.098 ,27.988,18.477,12.516,27.594,23.342,6.652,25.339,26.480,5.038,20.611 ,30.998,5.596,14.238,33.760,9.367,12.383,38.383,14.898,8.935,40.587 ,20.080,11.064,43.809,22.269,28.515,41.425,25.532,22.994,39.101,25.689 ,17.577,35.290,23.238,12.103,32.263,18.131,8.696,29.280,11.572,6.737 ,25.943,9.747,10.059,20.420,7.506,14.235,15.951,5.520,20.764,14.883 ,9.477,25.594,12.102,14.816,27.279,8.341 ,24.811,13.177,12.248,26.359,19.647,13.791,22.819,25.076,15.935,17.259 ,28.137,18.816,12.031,27.817,22.524,7.139,25.285,26.476,5.233,20.844 ,30.918,5.023,14.625,34.304,8.951,12.113,38.641,14.903,9.183,40.263 ,19.489,10.837,44.214,22.943,28.849,41.934,25.785,23.491,38.818,25.458 ,17.501,35.809,23.084,12.499,32.507,18.711,8.415,29.596,11.995,6.648 ,25.674,9.782,9.834,20.682,7.330,14.037,16.282,5.679,20.535,14.148 ,9.529,25.973,12.347,14.857,27.412,8.891 ,25.461,13.475,12.459,26.240,19.803,14.240,22.439,25.184,16.246,17.018 ,28.482,18.729,12.138,27.810,22.628,6.935,25.500,26.392,5.181,21.303 ,30.774,5.269,15.405,34.596,9.057,12.253,38.675,14.733,9.098,40.950 ,18.928,10.930,44.884,22.702,28.490,41.516,25.756,22.649,39.048,26.150 ,16.724,36.124,23.328,11.649,32.925,18.644,8.006,30.218,12.586,6.889 ,25.838,9.876,10.168,20.938,7.544,13.875,16.115,5.352,20.441,14.098 ,9.147,25.602,11.691,14.869,27.495,8.845 ,24.646,13.201,12.498,26.020,19.910,14.081,22.700,25.203,16.348,16.921 ,28.147,18.532,12.219,27.992,22.139,7.297,25.197,26.330,5.477,21.167 ,31.099,5.289,15.822,35.342,8.801,12.200,39.234,14.381,9.267,41.504 ,19.133,11.253,44.763,22.661,28.604,41.983,25.373,23.002,39.097,25.724 ,16.979,36.597,23.274,11.205,33.696,18.583,7.895,30.512,12.581,6.908 ,26.393,10.461,9.886,20.595,7.139,14.317,16.469,5.308,21.069,14.978 ,8.870,25.450,10.652,14.988,27.488,7.901) ,c(3,22,30)) dna.dat<-aperm(dna.dat,c(2,1,3)) # # # #================================================================================== macf.dat<-c(54.33203,24.10905,69.5 ,141.80250,21.59643,69.5 ,132.23880,62.78124,69.5 ,88.22106,52.28123,69.5 ,147.10890,26.61518,90.0 ,107.42800,27.77578,101.0 ,99.74427,46.85715,97.0 ,58.35540,29.57223,67.0 ,134.87930,26.38988,67.0 ,120.57150,66.43083,67.0 ,79.14922,52.19386,67.0 ,138.17850,37.67144,86.0 ,101.76780,34.47324,97.5 ,90.83484,54.19082,92.0 ,50.04349,15.22191,71.5 ,139.76850,21.33820,71.5 ,124.26710,63.79000,71.5 ,80.94720,51.47673,71.5 ,147.78980,32.26446,94.0 ,102.32870,25.23133,105.5 ,90.64163,47.04449,98.5 ,41.93115,24.83244,70.5 ,138.72930,22.35828,70.5 ,122.68840,65.04043,70.5 ,74.09913,53.69709,70.5 ,142.63240,35.36625,92.0 ,97.04822,33.37946,111.5 ,89.51760,56.40900,96.5 ,48.44877,35.75250,68.0 ,134.68970,33.55962,68.0 ,120.88830,73.77755,68.0 ,77.94841,65.53058,68.0 ,135.42950,42.75692,91.0 ,101.92880,40.64505,99.5 ,87.04530,59.04715,92.5 ,44.05272,36.38397,70.0 ,133.47320,45.07240,70.0 ,114.88450,83.74655,70.0 ,70.13158,71.71946,70.0 ,139.94810,54.24338,87.0 ,97.87708,47.19924,105.5 ,80.04594,65.13947,96.5 ,53.94042,32.50219,69.0 ,136.19530,33.46588,69.0 ,120.75410,74.12678,69.0 ,78.24210,60.88469,69.0 ,142.38210,44.35960,89.5 ,100.75480,38.09180,101.0 ,87.92361,55.80280,94.5 ,45.11740,11.62884,68.5 ,132.08950,17.75877,68.5 ,112.66980,57.22899,68.5 ,71.76939,47.64127,68.5 ,136.93780,26.69818,88.5 ,96.43125,21.78416,101.0 ,84.39475,41.89694,95.0 ,42.09966,16.11359,69.0 ,131.92440,19.70687,69.0 ,121.73400,57.71608,69.0 ,72.94730,49.99466,69.0 ,136.93340,26.92302,89.0 ,96.84825,26.58288,103.0 ,84.30907,48.96717,94.5) macf.dat<-array(macf.dat,c(3,7,9)) macf.dat<-aperm(macf.dat,c(2,1,3)) macm.dat<-c(34.82811,16.50834,77.5 ,138.91980,15.13858,77.5 ,125.15760,58.60464,77.5 ,72.28854,49.79207,77.5 ,146.19080,22.68885,100.0 ,99.30268,24.86908,117.0 ,91.79910,46.49960,107.0 ,40.40179,3.73932,73.0 ,132.23560,7.56574,73.0 ,114.63210,53.28955,73.0 ,70.66502,33.57051,73.0 ,139.58480,21.61227,90.5 ,97.93692,8.49867,108.5 ,79.90506,28.91153,100.5 ,40.54510,9.51130,75.0 ,136.61260,15.82863,75.0 ,106.90960,63.82611,75.0 ,76.19816,46.63517,75.0 ,145.02210,30.40421,94.5 ,101.72660,19.45746,113.5 ,86.97967,43.98130,105.5 ,21.11454,16.57673,75.0 ,131.52700,23.12809,75.0 ,109.44810,63.03707,75.0 ,61.73774,53.69610,75.0 ,135.91480,34.78890,101.5 ,90.65395,25.30813,117.5 ,75.66082,49.38123,105.5 ,30.79976,19.21503,73.5 ,134.92160,32.11148,73.5 ,115.81510,69.88405,73.5 ,67.15240,57.06633,73.5 ,139.56950,44.82271,97.5 ,95.38217,25.95223,112.0 ,78.97741,47.89584,107.0 ,18.88770,10.47136,74.5 ,130.35790,12.40497,74.5 ,114.85390,57.63774,74.5 ,63.47649,48.13175,74.5 ,138.25830,25.62929,97.5 ,89.01810,18.95535,117.0 ,75.67622,43.31009,104.5 ,40.28789,14.90687,69.0 ,134.29020,14.66977,69.0 ,125.54870,56.83236,69.0 ,75.68020,53.65364,69.0 ,142.36350,24.22211,92.5 ,99.44497,25.41932,106.0 ,87.63929,45.45810,99.5 ,25.38359,10.64805,72.5 ,130.99770,9.63434,72.5 ,118.65580,54.78021,72.5 ,68.79280,48.67834,72.5 ,139.77820,20.83856,97.0 ,91.36346,16.29169,111.5 ,75.55544,44.28398,101.0 ,27.93545,5.21197,71 ,130.98990,4.76235,71 ,103.16230,51.99304,71 ,70.59641,43.71388,71 ,136.03820,13.90246,92 ,91.75840,14.31955,109 ,79.95213,35.70748,95) macm.dat<-array(macm.dat,c(3,7,9)) macm.dat<-aperm(macm.dat,c(2,1,3)) #================================================================================== sooty.dat<- c(-1426,-310.4167 ,-1424,-160.4167 ,-1117,320.5833 ,-755,854.5833 ,1238,1363.5833 ,2330,471.5833 ,1435,-748.4167 ,771,-557.4167 ,433,-395.4167 ,-176,-299.4167 ,-376,-290.4167 ,-933,-248.4167 ,-1000.20254,-1601.5969 ,-1076.57007,-1266.4282 ,-1124.65334,-635.6890 ,-1193.94980,147.7853 ,-61.16474,1895.7533 ,1484.57069,2113.5422 ,1649.32657,746.7048 ,1212.33458,388.9087 ,730.79486,166.1701 ,156.62415,-383.9590 ,-88.03479,-533.8656 ,-689.07556,-1037.3256) sooty.dat<-array(sooty.dat,c(2,12,2)) sooty.dat<-aperm(sooty.dat,c(2,1,3)) #================================================================================== panf.dat<-array(c(47,-23,0,0,0,32,12,87,21,156,31,133,66,92,83,20, 63,-22,0,0,0,29,6,89,14,157,23,136,62,101,95,24, 56,-11,0,0,0,31,2,89,4,159,17,141,54,107,86,34, 51,-27,0,0,0,29,12,89,30,156,39,135,71,94,86,18, 51,-19,0,0,0,35,8,97,23,169,36,143,67,101,85,25, 54,-23,0,0,0,34,14,84,36,155,44,133,76,87,89,19, 53,-21,0,0,0,30,5,90,24,162,31,139,63,99,86,21, 56,-23,0,0,0,33,16,92,30,156,40,131,75,95,95,15, 55,-20,0,0,0,33,12,89,13,157,31,136,63,97,91,22, 35,-23,0,0,0,26,9,81,11,153,26,131,64,92,84,18, 48,-25,0,0,0,30,23,89,44,160,49,139,81,95,95,18, 35,-34,0,0,0,30,10,84,23,153,36,128,68,95,94,13, 46,-23,0,0,0,28,4,92,14,163,27,137,60,101,86,27, 42,-23,0,0,0,30,19,88,33,163,45,130,77,95,93,20, 50,-19,0,0,0,32,7,90,14,157,25,139,68,101,87,23, 54,-19,0,0,0,29,6,92,9,163,20,140,64,104,92,26, 46,-31,0,0,0,25,3,89,2,167,24,136,63,95,85,19, 47,-19,0,0,0,29,7,84,6,148,22,126,58,89,80,24, 46,-27,0,0,0,31,12,86,23,156,35,130,72,93,89,18, 49,-23,0,0,0,29,14,88,25,159,36,133,76,90,90,16, 50,-23,0,0,0,32,9,92,14,167,31,141,71,97,87,28, 40,-23,0,0,0,30,13,92,30,167,40,140,74,99,91,21, 32,-25,0,0,0,36,7,96,12,170,22,147,61,108,81,35, 41,-30,0,0,0,29,18,87,31,160,43,135,74,87,89,10, 46,-25,0,0,0,29,15,88,23,163,37,134,70,91,85,22, 43,-22,0,0,0,33,-1,96,10,178,24,153,66,105,87,32),c(2,8,26)) panf.dat<-aperm(panf.dat,c(2,1,3)) select<-c(5,1,2,3,4,6,7,8) panf.dat<-panf.dat[select,,] panm.dat<-array(c(43,-21,0,0,0,34,14,101,25,179,40,150,75,104,90,31, 48,-23,0,0,0,31,5,92,11,166,24,144,63,99,82,24, 43,-23,0,0,0,29,13,92,21,161,33,138,68,100,84,21, 45,-32,0,0,0,30,8,100,14,163,28,143,74,102,97,21, 40,-27,0,0,0,29,7,93,12,166,23,147,69,102,90,25, 49,-19,0,0,0,33,3,94,11,165,23,144,64,108,89,30, 55,-17,0,0,0,31,6,97,17,168,29,144,69,101,85,23, 49,-27,0,0,0,26,11,92,16,178,30,152,78,100,89,23, 48,-23,0,0,0,29,10,96,32,166,42,139,69,96,87,21, 49,-19,0,0,0,29,3,100,14,172,25,152,63,109,87,32, 49,-26,0,0,0,34,8,91,22,168,34,140,74,93,93,17, 52,-26,0,0,0,32,7,92,10,172,28,143,66,100,93,23, 36,-26,0,0,0,28,11,92,25,165,34,140,71,98,90,18, 46,-26,0,0,0,33,12,94,20,174,35,145,71,106,93,24, 47,-22,0,0,0,31,10,88,29,156,34,138,68,93,91,20, 47,-25,0,0,0,30,0,97,2,172,19,147,62,102,82,26, 53,-19,0,0,0,29,6,80,2,142,13,123,54,100,91,31, 49,-24,0,0,0,29,5,90,14,168,31,144,77,96,89,22, 52,-25,0,0,0,30,6,93,15,167,25,147,74,99,92,24, 42,-27,0,0,0,32,11,87,26,159,37,137,76,95,87,21, 37,-25,0,0,0,29,-2,87,-2,175,16,152,63,107,91,33, 41,-27,0,0,0,25,6,87,13,167,29,141,70,99,89,28, 46,-24,0,0,0,35,12,98,15,175,31,152,76,106,92,27, 45,-22,0,0,0,29,8,90,12,176,24,151,70,104,88,24, 46,-27,0,0,0,29,2,88,6,166,23,138,67,100,86,24, 43,-20,0,0,0,33,7,94,17,165,30,143,70,93,81,24, 44,-20,0,0,0,29,1,87,0,154,19,133,64,98,80,16, 52,-28,0,0,0,28,2,84,18,155,25,135,63,97,93,21),c(2,8,28)) panm.dat<-aperm(panm.dat,c(2,1,3)) select<-c(5,1,2,3,4,6,7,8) panm.dat<-panm.dat[select,,] pongof.dat<-array(c(43,-31,0,0,0,29,13,90,45,150,48,126,74,80,91,19, 49,-31,0,0,0,33,28,93,70,152,72,130,86,78,85,-5, 51,-36,0,0,0,32,34,100,74,152,74,131,87,73,92,-2, 48,-26,0,0,0,32,10,89,35,154,40,136,65,88,86,14, 56,-29,0,0,0,24,11,87,44,155,48,133,72,82,91,12, 49,-30,0,0,0,29,25,96,72,159,69,137,85,78,93,9, 51,-28,0,0,0,26,11,94,50,162,49,132,75,87,89,13, 57,-24,0,0,0,35,10,98,55,164,53,138,77,88,93,21, 37,-29,0,0,0,38,30,93,63,161,68,129,86,68,87,6, 53,-30,0,0,0,29,5,88,39,147,38,131,64,84,90,14, 58,-24,0,0,0,30,0,88,14,151,24,133,59,91,88,21, 54,-26,0,0,0,36,11,106,41,173,48,146,78,94,99,24, 59,-25,0,0,0,29,4,102,28,177,34,156,63,100,90,25, 32,-36,0,0,0,25,26,90,71,144,69,124,82,72,91,3, 52,-30,0,0,0,35,21,99,55,164,59,143,79,90,95,22, 51,-27,0,0,0,35,11,92,37,152,42,132,69,88,95,26, 47,-24,0,0,0,35,7,98,36,163,38,138,66,89,87,21, 60,-23,0,0,0,23,-2,82,28,158,32,135,56,90,89,25, 46,-31,0,0,0,25,4,87,34,145,37,120,66,80,89,20, 46,-28,0,0,0,36,29,94,73,148,71,123,82,74,92,11, 32,-37,0,0,0,36,32,88,81,140,81,117,91,63,90,-5, 43,-27,0,0,0,25,2,90,32,159,37,131,62,91,87,22, 38,-27,0,0,0,30,4,93,30,160,36,136,60,92,86,27, 38,-27,0,0,0,34,14,92,53,155,48,129,71,82,84,24),c(2,8,24)) pongof.dat<-aperm(pongof.dat,c(2,1,3)) select<-c(5,1,2,3,4,6,7,8) pongof.dat<-pongof.dat[select,,] pongom.dat<-array(c(49,-45,0,0,0,26,25,106,68,190,68,151,84,80,100,14, 64,-28,0,0,0,31,10,106,46,185,53,156,77,95,99,14, 55,-31,0,0,0,33,23,113,72,186,72,160,92,95,102,21, 64,-25,0,0,0,36,5,109,35,188,42,165,69,102,101,33, 46,-39,0,0,0,31,36,106,97,155,89,133,95,74,92,1, 53,-28,0,0,0,33,17,111,54,185,59,159,87,88,98,16, 47,-36,0,0,0,36,35,114,72,183,74,150,94,81,105,15, 44,-35,0,0,0,37,15,110,69,183,74,153,84,89,94,11, 55,-43,0,0,0,26,24,105,71,172,75,146,91,81,104,1, 49,-33,0,0,0,35,11,113,58,188,56,159,79,92,93,24, 45,-32,0,0,0,29,20,107,67,184,67,155,85,82,93,11, 48,-34,0,0,0,32,33,116,89,192,91,160,100,81,99,5, 41,-51,0,0,0,29,50,100,127,139,115,119,105,53,96,-19, 60,-45,0,0,0,32,36,102,108,163,97,129,98,75,98,-6, 65,-35,0,0,0,30,24,112,65,188,72,158,88,87,103,18, 54,-28,0,0,0,33,7,114,33,206,42,172,74,98,94,28, 41,-39,0,0,0,34,24,115,79,188,79,154,93,79,99,2, 42,-40,0,0,0,39,41,114,112,187,102,147,112,70,97,-14, 65,-27,0,0,0,30,17,109,62,187,66,151,83,82,96,18, 54,-36,0,0,0,30,29,122,65,204,70,176,93,87,96,9, 55,-37,0,0,0,32,25,116,75,190,71,155,88,84,98,8, 50,-35,0,0,0,26,8,101,39,172,49,148,75,87,98,18, 78,-31,0,0,0,28,15,119,56,204,60,179,91,94,103,8, 42,-32,0,0,0,34,37,117,102,181,99,148,102,83,97,5, 52,-39,0,0,0,38,15,111,58,201,63,158,89,91,95,-8, 47,-37,0,0,0,23,37,98,85,160,83,136,89,75,94,-5, 49,-37,0,0,0,34,37,115,105,179,98,151,96,80,97,5, 48,-32,0,0,0,36,10,113,53,189,57,166,79,100,99,21, 41,-24,0,0,0,39,4,128,42,209,47,178,73,102,93,21, 50,-32,0,0,0,39,27,121,73,198,75,166,95,89,101,15),c(2,8,30)) pongom.dat<-aperm(pongom.dat,c(2,1,3)) select<-c(5,1,2,3,4,6,7,8) pongom.dat<-pongom.dat[select,,] #================================================================================== schizophrenia.dat<-c( 0.345632 , -0.0360314 , -0.356301 , 0.0234333 , 0.0119311 , 0.17692 , 0.37789 , 0.480402 , 0.719631 , -0.41189 , 0.397921 , -0.140558 , 0.351751 , -0.385748 , 0.333756 , -0.655051 , 0.032181 , -0.275235 , 0.112563 , -0.506533 , -0.233126 , -0.28334 , -0.667337 , 0.0522613 , 0.188945 , -0.142714 , 0.237198 , 0.048306 , -0.340236 , 0.0997385 , -0.0161814 , 0.201017 , 0.301584 , 0.516546 , 0.510795 , -0.323537 , 0.269407 , -0.0562209 , 0.239301 , -0.253218 , 0.229339 , -0.48236 , 0.0201328 , -0.122625 , 0.048306 , -0.341874 , -0.200997 , -0.122698 , -0.62316 , 0.120534 , 0.124688 , -0.0262477 , 0.341616 , 0.048306 , -0.408509 , 0.119819 , -0.00814926 , 0.277322 , 0.39797 , 0.62498 , 0.591116 , -0.299441 , 0.35776 , -0.0361405 , 0.27143 , -0.249202 , 0.273516 , -0.530553 , 0.032181 , -0.110577 , 0.0724024 , -0.34589 , -0.188949 , -0.138762 , -0.707498 , 0.140615 , 0.124688 , -0.0262477 , 0.329567 , -0.10832 , -0.359859 , 0.0341931 , -0.056342 , 0.152824 , 0.377668 , 0.474464 , 0.673363 , -0.462009 , 0.373825 , -0.228912 , 0.323639 , -0.450005 , 0.34179 , -0.735372 , 0.0924219 , -0.295315 , 0.100555 , -0.540522 , -0.181195 , -0.260518 , -0.651361 , 0.0963372 , 0.174798 , -0.178741 , 0.193021 , 0.0683864 , -0.539516 , 0.210918 , -0.16074 , 0.333555 , 0.293246 , 0.639288 , 0.520753 , -0.301366 , 0.245311 , -0.0281084 , 0.142916 , -0.28133 , 0.128938 , -0.510473 , -0.152558 , -0.118609 , -0.0761516 , -0.379879 , -0.414127 , -0.127988 , -0.848201 , 0.246974 , -0.00592517 , -0.00203414 , 0.337599 , -0.076192 , -0.356431 , 0.146356 , 0.068156 , 0.201017 , 0.520571 , 0.464342 , 0.601074 , -0.518234 , 0.321616 , -0.208831 , 0.251349 , -0.409844 , 0.197211 , -0.695211 , -0.00797966 , -0.251139 , -0.00787855 , -0.500361 , -0.26726 , -0.201009 , -0.719602 , 0.25526 , 0.110557 , -0.140611 , 0.223261 , 0.228767 , -0.431293 , 0.230133 , -0.0439952 , 0.389752 , 0.23941 , 0.819652 , 0.641234 , -0.088515 , 0.377841 , 0.140566 , 0.339703 , -0.10864 , 0.393998 , -0.345813 , 0.0201328 , -0.0583678 , 0.172844 , -0.283494 , -0.268058 , -0.0890055 , -0.777652 , 0.251188 , 0.154806 , 0.12832 , 0.243341 , -0.052358 , -0.451374 , 0.145795 , -0.0480112 , 0.297382 , 0.408185 , 0.574616 , 0.56291 , -0.538339 , 0.31561 , -0.190749 , 0.251349 , -0.437957 , 0.169098 , -0.715291 , 0.00005 , -0.194914 , 0.000153631 , -0.492329 , -0.278085 , -0.117118 , -0.797732 , 0.255204 , 0.122674 , -0.0905492 , 0.287518 , 0.0600918 , -0.503583 , 0.121699 , -0.0861578 , 0.307424 , 0.355977 , 0.614776 , 0.603071 , -0.277295 , 0.303562 , -0.0100258 , 0.259382 , -0.293379 , 0.241387 , -0.538584 , -0.0521564 , -0.114593 , 0.0443303 , -0.343735 , -0.274068 , -0.0930217 , -0.805764 , 0.138738 , 0.12669 , 0.00182023 , 0.319646 , 0.20467 , -0.431294 , 0.153827 , -0.0660775 , 0.391762 , 0.29172 , 0.793493 , 0.771746 , -0.00420256 , 0.407979 , 0.166681 , 0.387896 , -0.12872 , 0.393998 , -0.394006 , 0.0864079 , -0.0382915 , 0.168828 , -0.279477 , -0.225876 , -0.109086 , -0.779633 , 0.126677 , 0.190947 , 0.126318 , 0.303582 , 0.208686 , -0.395149 , 0.302422 , -0.00985258 , 0.387746 , 0.388105 , 0.72522 , 0.611103 , -0.289343 , 0.327658 , 0.0743116 , 0.283478 , -0.229121 , 0.201226 , -0.494408 , 0.00608663 , -0.0141951 , 0.0362983 , -0.279477 , -0.24194 , -0.00466831 , -0.699312 , 0.339529 , 0.12669 , 0.0901736 , 0.287518 , -0.0362937 , -0.428786 , 0.133507 , -0.0801519 , 0.233129 , 0.374063 , 0.614792 , 0.671344 , -0.478098 , 0.383883 , -0.134524 , 0.315606 , -0.417876 , 0.265483 , -0.675131 , 0.0342193 , -0.19491 , 0.0443223 , -0.466226 , -0.266036 , -0.201455 , -0.735453 , 0.202987 , 0.176577 , -0.0906634 , 0.251373 , 0.212702 , -0.42477 , 0.149571 , -0.124329 , 0.345579 , 0.145148 , 0.767403 , 0.671344 , -0.00821852 , 0.424044 , 0.138569 , 0.407976 , -0.116671 , 0.44219 , -0.377942 , 0.122573 , -0.0583636 , 0.202939 , -0.283647 , -0.14957 , -0.0970378 , -0.755533 , 0.114633 , 0.180593 , 0.0940755 , 0.29555 , -0.0362937 , -0.348465 , 0.000976592 , -0.0480233 , 0.148792 , 0.273662 , 0.458166 , 0.65528 , -0.341552 , 0.371835 , -0.106411 , 0.327655 , -0.377715 , 0.333757 , -0.65505 , 0.0984763 , -0.247119 , 0.118601 , -0.500514 , -0.181699 , -0.253664 , -0.675212 , 0.0182479 , 0.192642 , -0.122792 , 0.309487 , 0.265173 , -0.3438 , 0.289185 , 0.0199632 , 0.482141 , 0.355444 , 0.735605 , 0.613122 , -0.156788 , 0.357761 , 0.128518 , 0.315607 , -0.132736 , 0.305644 , -0.36991 , 0.0121007 , 0.0380178 , 0.100555 , -0.223253 , -0.182924 , 0.0134128 , -0.623245 , 0.301185 , 0.162814 , 0.142714 , 0.193021 , 0.305334 , -0.472766 , 0.163996 , -0.172808 , 0.38174 , 0.0847168 , 0.829799 , 0.538908 , 0.114214 , 0.249327 , 0.273096 , 0.199141 , 0.0319229 , 0.273516 , -0.165091 , -0.0360921 , 0.0340017 , 0.0563381 , -0.141071 , -0.257222 , -0.0263121 , -0.791835 , 0.0884059 , -0.00382644 , 0.178572 , 0.39784 , -0.011935 , -0.440185 , 0.132558 , -0.00814926 , 0.309451 , 0.470037 , 0.542738 , 0.580994 , -0.385704 , 0.389889 , -0.212847 , 0.283478 , -0.401812 , 0.237372 , -0.675131 , 0.0201328 , -0.267203 , 0.0644106 , -0.508393 , -0.23742 , -0.196261 , -0.711598 , 0.184719 , 0.0944764 , -0.130548 , 0.269326 , 0.0844506 , -0.327735 , 0.048221 , -0.0242135 , 0.253226 , 0.257186 , 0.643139 , 0.601074 , -0.1849 , 0.325632 , 0.0160683 , 0.307574 , -0.217073 , 0.301629 , -0.442199 , 0.0803737 , -0.126641 , 0.112603 , -0.351767 , -0.153083 , -0.13602 , -0.635293 , 0.0280923 , 0.158733 , -0.00605034 , 0.217118 , 0.212965 , -0.416089 , 0.192799 , -0.104535 , 0.353627 , 0.229073 , 0.727476 , 0.601074 , -0.1849 , 0.293503 , 0.112454 , 0.267414 , -0.112655 , 0.285565 , -0.402039 , 0.0281649 , -0.0101749 , 0.0844909 , -0.259397 , -0.221356 , -0.0275863 , -0.743727 , 0.188735 , 0.0944764 , 0.118448 , 0.293423 , -0.076192 , -0.327736 , 0.0442049 , -0.0121653 , 0.160856 , 0.357587 , 0.394143 , 0.572961 , -0.457993 , 0.281455 , -0.228912 , 0.263398 , -0.470085 , 0.189179 , -0.679147 , 0.00005 , -0.259171 , 0.02425 , -0.524458 , -0.193244 , -0.208309 , -0.583084 , 0.0883332 , 0.142669 , -0.178741 , 0.289407 , 0.0201935 , -0.351832 , 0.164687 , 0.00389893 , 0.265274 , 0.40578 , 0.510609 , 0.49264 , -0.433896 , 0.3176 , -0.120478 , 0.235285 , -0.329523 , 0.201227 , -0.554649 , 0.00406852 , -0.17885 , 0.0081857 , -0.403976 , -0.245452 , -0.107908 , -0.647341 , 0.228896 , 0.0583318 , -0.0622752 , 0.301455 , 0.0603542 , -0.391993 , 0.224928 , -0.0121653 , 0.341579 , 0.441925 , 0.594946 , 0.45248 , -0.389719 , 0.29752 , -0.0963815 , 0.17906 , -0.30141 , 0.140986 , -0.570714 , -0.02806 , -0.106561 , -0.0560713 , -0.391927 , -0.245452 , -0.0556988 , -0.683486 , 0.293153 , 0.0583318 , -0.00605033 , 0.237198 , -0.0922563 , -0.396005 , 0.00807245 , -0.116583 , 0.11668 , 0.29333 , 0.402175 , 0.47256 , -0.502169 , 0.22523 , -0.22088 , 0.17906 , -0.433941 , 0.157051 , -0.634971 , -0.0320761 , -0.271219 , -0.0400071 , -0.500361 , -0.257501 , -0.260518 , -0.69955 , 0.0521888 , 0.0382515 , -0.158661 , 0.321535 , -0.0641438 , -0.379941 , 0.108474 , -0.0201975 , 0.192985 , 0.445941 , 0.450368 , 0.49264 , -0.506185 , 0.325632 , -0.184735 , 0.203157 , -0.365667 , 0.124922 , -0.675131 , -0.0119958 , -0.206962 , -0.0279589 , -0.476265 , -0.285613 , -0.192245 , -0.651357 , 0.176687 , 0.0944764 , -0.126532 , 0.317519 , -0.0761919 , -0.219297 , -0.0300639 , 0.072172 , 0.140776 , 0.40578 , 0.430287 , 0.580994 , -0.457993 , 0.345712 , -0.216863 , 0.287494 , -0.417876 , 0.2695 , -0.663083 , 0.096438 , -0.259171 , 0.0764588 , -0.496345 , -0.165131 , -0.24847 , -0.518831 , -0.00808046 , 0.162749 , -0.178741 , 0.363819 , -0.132663 , -0.295482 , 0.140679 , 0.178874 , 0.174894 , 0.568759 , 0.29153 , 0.593042 , -0.550362 , 0.345712 , -0.297185 , 0.267414 , -0.50623 , 0.136969 , -0.74742 , -0.0039636 , -0.275235 , 0.0724427 , -0.520442 , -0.239946 , -0.153262 , -0.524623 , 0.229146 , 0.194967 , -0.196981 , 0.255389 , 0.160493 , -0.435309 , 0.214068 , -0.124316 , 0.357623 , 0.267522 , 0.65901 , 0.597058 , -0.136708 , 0.305552 , 0.0763094 , 0.255365 , -0.140768 , 0.257451 , -0.402038 , 0.032181 , -0.0382875 , 0.084491 , -0.279478 , -0.243962 , -0.0167163 , -0.761587 , 0.231107 , 0.0945651 , 0.0881595 , 0.279486 , 0.00788297 , -0.330892 , 0.141779 , 0.0222759 , 0.267264 , 0.386119 , 0.484248 , 0.574959 , -0.365648 , 0.33569 , -0.102395 , 0.263398 , -0.345587 , 0.233355 , -0.566697 , -0.0180098 , -0.178854 , 0.0965392 , -0.387911 , -0.233908 , -0.12515 , -0.627023 , 0.206999 , 0.0681437 , -0.0866473) schizo.dat<-schizophrenia.dat schizophrenia.dat<-array(schizophrenia.dat,c(2,13,28)) schizophrenia.dat<-aperm(schizophrenia.dat,c(2,1,3)) schizo.dat<-array(schizo.dat,c(2,13,28)) schizo.dat<-aperm(schizo.dat,c(2,1,3)) braincon.dat<-schizo.dat[,,1:14] brainscz.dat<-schizo.dat[,,15:28] ###################### Additional functions by other authors ################## # # ============================================================================= # Authors # ============================================================================= # Gregorio Quintana-Orti # Depto. de Ingenieria y Ciencia de Computadores, # Universitat Jaume I, # 12.071 Castellon, Spain # Amelia Simo # Depto. de Matematicas, # Universitat Jaume I, # 12.071 Castellon, Spain # # ============================================================================= # Copyright # ============================================================================= # Copyright (C) 2018, # Universitat Jaume I. # # ============================================================================= # Disclaimer # ============================================================================= # This code is distributed in the hope that it will be useful, but # WITHOUT ANY WARRANTY EXPRESSED OR IMPLIED. # # This module contains several modifications of some functions provided by # the noteworthy "shapes" package by Ian L. Dryden. These new implementations # have been accelerated to be much faster for medium and large datasets # than the original codes. All the other functions in the library that employ # the accelerated ones will also take advantage of this performance # improvement. # # The new code includes the original code in commented lines with four "#" # chars as a reference. # # ============================================================================= # ============================================================================= uji_preshape = function( x ) { # # It computes the preshape in a faster way on medium and large datasets # on real (non-complex) data. # # Written by G. Quintana-Orti and Amelia Simo, University Jaume I, Spain. # This code is distributed in the hope that it will be useful, but # WITHOUT ANY WARRANTY EXPRESSED OR IMPLIED. # if ( is.complex( x ) ) { # # Complex case. # k <- nrow( as.matrix( x ) ) h <- uji_defh( k - 1 ) zstar <- x ztem <- h %*% zstar size <- sqrt( diag( Re( st( ztem ) %*% ztem ) ) ) if ( is.vector( zstar ) ) z <- ztem / size if ( is.matrix(zstar ) ) z <- ztem %*% diag( 1.0 / size ) } else { # # Real case. # if (length(dim(x)) == 3) { # # Argument X is a 3D array. # k <- dim( x )[ 1 ] #### h <- uji_defh( k - 1 ) n <- dim( x )[ 3 ] m <- dim( x )[ 2 ] z <- array( 0, c( k - 1, m, n ) ) for ( i in 1 : n ) { #### z[, , i] <- h %*% x[, , i] # Accelerated code. z[ , , i ] <- multiply_by_helmert( x[ , , i ] ) size <- uji_centroid.size( x[ , , i ] ) z[ , , i ] <- z[ , , i ] / size } } else { # # Argument X is not a 3D array. # k <- nrow( as.matrix( x ) ) #### h <- defh(k - 1) #### ztem <- h %*% x # Accelerated code. ztem <- multiply_by_helmert( x ) size <- uji_centroid.size( x ) z <- ztem / size } } return( z ) } # ============================================================================= uji_centroid.size = function( x ) { # # It returns the centroid size of a configuration (or configurations). # Input: # k x m matrix, or # a complex k-vector, or # a real k x m x n array to get a vector of sizes for a sample # # It computes the centroid size in a faster way on medium and large datasets. # # Written by G. Quintana-Orti and Amelia Simo, University Jaume I, Spain. # This code is distributed in the hope that it will be useful, but # WITHOUT ANY WARRANTY EXPRESSED OR IMPLIED. # if ((is.vector(x) == FALSE) && is.complex(x)) { k <- nrow(x) n <- ncol(x) tem <- array(0, c(k, 2, n)) tem[, 1, ] <- Re(x) tem[, 2, ] <- Im(x) x <- tem } { if (length( dim( x ) ) == 3 ) { # # Argument x is a 3D array. # n <- dim( x )[ 3 ] sz <- rep( 0, times = n ) k <- dim( x )[ 1 ] #### h <- defh( k - 1 ) for ( i in 1 : n ) { #### xh <- h %*% x[, , i] #### sz[ i ] <- sqrt( sum( diag( t( xh ) %*% xh ) ) ) # Accelerated code. xh <- multiply_by_helmert( x[ , , i ] ) sz[ i ] <- uji_Enorm( xh ) } sz } else { if ( is.vector( x ) && is.complex( x ) ) { x <- cbind( Re( x ), Im( x ) ) } k <- nrow( x ) #### h <- defh(k - 1) #### xh <- h %*% x #### size <- sqrt( sum( diag( t( xh ) %*% xh ) ) ) #cat( "pepe\n" ) # Accelerated code. xh <- multiply_by_helmert( x ) size <- uji_Enorm( xh ) size } } } # ============================================================================= uji_defh = function( nrow ) { # # It generates a Helmert matrix in a faster way on medium and large datasets. # The use of this function should be avoided when the Helmert matrix is # just built to multiply another matrix or vector. # In this case, the "multiply_by_helmert_implicitly" and # "multiply_by_transpose_of_helmert_implicitly" should be employed since # this approach is much faster. # # Written by G. Quintana-Orti and Amelia Simo, University Jaume I, Spain. # This code is distributed in the hope that it will be useful, but # WITHOUT ANY WARRANTY EXPRESSED OR IMPLIED. # k <- nrow h <- matrix( 0, k, k + 1 ) if( nrow > 0 ) { for( j in seq( 1, k ) ) { val = -1 / sqrt( j * ( j + 1 ) ) h[ j, seq( 1, j ) ] = val h[ j, j+1 ] = - j * val } } h } # ============================================================================= uji_Enorm = function( X ) { # # Accelerated version of the original function for medium and large datasets. # # Written by G. Quintana-Orti and Amelia Simo, University Jaume I, Spain. # This code is distributed in the hope that it will be useful, but # WITHOUT ANY WARRANTY EXPRESSED OR IMPLIED. # if( is.complex( X ) ) { #### n <- sqrt( sum( diag( Re( st(X) %*% X ) ) ) ) n <- sqrt( sum( Re( X )^2 + Im( X )^2 ) ) } else { #### n <- sqrt(sum(diag(t(X) %*% X))) n <- sqrt( sum( X^2 ) ) } return( n ) } # ============================================================================= uji_distProcrustesFull = function( P1, P2 ) { # # Accelerated version of the original function for medium and large datasets. # # Written by G. Quintana-Orti and Amelia Simo, University Jaume I, Spain. # This code is distributed in the hope that it will be useful, but # WITHOUT ANY WARRANTY EXPRESSED OR IMPLIED. # #### H <- defh( dim( P1 )[ 1 ] ) #### Q1 <- t( H ) %*% rootmat( P1 ) #### Q2 <- t( H ) %*% rootmat( P2 ) # Accelerated code. Q1 <- multiply_by_transpose_of_helmert( rootmat( P1 ) ) Q2 <- multiply_by_transpose_of_helmert( rootmat( P2 ) ) ans <- riemdist( Q1, Q2, reflect = TRUE ) ans } # ============================================================================= uji_distProcrustesSizeShape = function( P1, P2 ) { # # Accelerated version of the original function for medium and large datasets. # # Written by G. Quintana-Orti and Amelia Simo, University Jaume I, Spain. # This code is distributed in the hope that it will be useful, but # WITHOUT ANY WARRANTY EXPRESSED OR IMPLIED. # #### H <- defh( dim( P1 )[ 1 ] ) #### Q1 <- t( H ) %*% rootmat( P1 ) #### Q2 <- t( H ) %*% rootmat( P2 ) # Accelerated code. Q1 <- multiply_by_transpose_of_helmert( rootmat( P1 ) ) Q2 <- multiply_by_transpose_of_helmert( rootmat( P2 ) ) ans <- sqrt(centroid.size(Q1)^2 + centroid.size(Q2)^2 - 2 * centroid.size(Q1) * centroid.size(Q2) * cos(riemdist(Q1, Q2, reflect = TRUE))) ans } # ============================================================================= uji_distCholesky = function( P1, P2 ) { # # Accelerated version of the original function for medium and large datasets. # # Written by G. Quintana-Orti and Amelia Simo, University Jaume I, Spain. # This code is distributed in the hope that it will be useful, but # WITHOUT ANY WARRANTY EXPRESSED OR IMPLIED. # #### H <- defh( dim( P1 )[ 1 ] ) #### Q1 <- t( H ) %*% t( chol( P1 ) ) #### Q2 <- t( H ) %*% t( chol( P2 ) ) # Accelerated code. Q1 <- multiply_by_transpose_of_helmert( t( chol( P1 ) ) ) Q2 <- multiply_by_transpose_of_helmert( t( chol( P2 ) ) ) ans <- Enorm( Q1 - Q2 ) ans } # ============================================================================= uji_estSS = function( S, weights = 1 ) { # # Accelerated version of the original function for medium and large datasets. # # Written by G. Quintana-Orti and Amelia Simo, University Jaume I, Spain. # This code is distributed in the hope that it will be useful, but # WITHOUT ANY WARRANTY EXPRESSED OR IMPLIED. # M <- dim( S )[ 3 ] k <- dim( S )[ 1 ] #### H <- defh( k ) if ( length( weights ) == 1 ) { weights <- rep( 1, times = M ) } Q <- array( 0, c( k+1, k, M ) ) for ( j in 1 : M ){ #### Q[,,j]<-t(H)%*%(rootmat(S[,,j])) # Accelerated code. Q[ , , j ] <- multiply_by_transpose_of_helmert( rootmat( S[ , , j ] ) ) } ans <- procWGPA( Q, fixcovmatrix = diag( k + 1 ), scale = FALSE, reflect = TRUE, sampleweights = weights ) #### H%*%ans$mshape%*%t(H%*%ans$mshape) # Accelerated code. auxMat = multiply_by_helmert( ans$mshape ) return( auxMat %*% t( auxMat ) ) } # ============================================================================= uji_estShape = function( S, weights = 1 ) { # # Accelerated version of the original function for medium and large datasets. # # Written by G. Quintana-Orti and Amelia Simo, University Jaume I, Spain. # This code is distributed in the hope that it will be useful, but # WITHOUT ANY WARRANTY EXPRESSED OR IMPLIED. # M <- dim( S )[ 3 ] k <- dim( S )[ 1 ] H <- defh( k ) if ( length( weights ) == 1 ) { weights <- rep( 1, times = M ) } Q <- array( 0, c( k+1, k, M ) ) for ( j in 1 : M ) { #### Q[,,j]<-t(H)%*%(rootmat(S[,,j])) # Accelerated code. Q[ , , j ] <- multiply_by_transpose_of_helmert( rootmat( S[ , , j ] ) ) } ans <- procWGPA( Q, fixcovmatrix = diag( k + 1 ), scale = TRUE, reflect = TRUE, sampleweights = weights) #### H%*%ans$mshape%*%t(H%*%ans$mshape) # Accelerated code. auxMat = multiply_by_helmert( ans$mshape ) return( auxMat %*% t( auxMat ) ) } # ============================================================================= uji_centroid.size.complex = function( zstar ) { # # It returns the centroid size of a complex vector zstar. # # Accelerated version of the original function for medium and large datasets. # # Written by G. Quintana-Orti and Amelia Simo, University Jaume I, Spain. # This code is distributed in the hope that it will be useful, but # WITHOUT ANY WARRANTY EXPRESSED OR IMPLIED. # #### h <- defh( nrow( as.matrix( zstar ) ) - 1 ) #### ztem <- h %*% zstar # Accelerated code. ztem <- multiply_by_helmert( zstar ) size <- sqrt( diag( Re( st( ztem ) %*% ztem ) ) ) size } # ============================================================================= uji_centroid.size.mD = function( x ) { # # It returns the centroid size of a k x m matrix. # # Accelerated version of the original function for medium and large datasets. # # Written by G. Quintana-Orti and Amelia Simo, University Jaume I, Spain. # This code is distributed in the hope that it will be useful, but # WITHOUT ANY WARRANTY EXPRESSED OR IMPLIED. # if( is.complex( x ) ) { x <- cbind( Re( x ), Im( x ) ) } #### k <- nrow( x ) #### h <- defh( k - 1 ) #### xh <- h %*% x #### size <- sqrt( sum( diag( t( xh ) %*% xh ) ) ) # Accelerated code. xh <- multiply_by_helmert( x ) size <- uji_Enorm( xh ) return( size ) } # ============================================================================= uji_preshape.mD = function( x ) { # # Input: k x m matrix # Output: k-1 x 1 matrix # # Accelerated version of the original function for medium and large datasets. # # Written by G. Quintana-Orti and Amelia Simo, University Jaume I, Spain. # This code is distributed in the hope that it will be useful, but # WITHOUT ANY WARRANTY EXPRESSED OR IMPLIED. # #### h <- defh( nrow( x ) - 1 ) #### ztem <- h %*% x #### size <- centroid.size.mD( x ) # Accelerated code. ztem <- multiply_by_helmert( x ) size <- uji_centroid.size.mD( x ) z <- ztem / size return( z ) } # ============================================================================= uji_preshape.mat = function( zstar ) { # # Accelerated version of the original function for medium and large datasets. # # Written by G. Quintana-Orti and Amelia Simo, University Jaume I, Spain. # This code is distributed in the hope that it will be useful, but # WITHOUT ANY WARRANTY EXPRESSED OR IMPLIED. # #### h <- defh( nrow( as.matrix( zstar ) ) - 1 ) #### ztem <- h %*% zstar # Accelerated code. ztem <- multiply_by_helmert( zstar ) size <- sqrt( diag( Re( st( ztem ) %*% ztem ) ) ) if( is.vector( zstar ) ) z <- ztem / size if( is.matrix( zstar ) ) z <- ztem %*% diag( 1.0 / size ) return( z ) } # ============================================================================= uji_tanfigure = function( vv, gamma ) { # # Inverse projection from complex tangent plane coordinates vv, using pole # gamma. # Output: centred icon # # Accelerated version of the original function for medium and large datasets. # # Written by G. Quintana-Orti and Amelia Simo, University Jaume I, Spain. # This code is distributed in the hope that it will be useful, but # WITHOUT ANY WARRANTY EXPRESSED OR IMPLIED. # zvv <- tanpreshape(vv, gamma) #### k <- nrow( gamma ) + 1 #### h <- defh( k - 1 ) #### zstvv <- t( h ) %*% zvv # Accelerated code. zstvv <- multiply_by_transpose_of_helmert( zvv ) return( zstvv ) } # ============================================================================= uji_tanfigurefull = function( vv, gamma ) { # # Inverse projection from complex tangent plane coordinates vv, using pole # gamma # Using Procrustes to with scaling to the pole gamma. # Output: centred icon # # Accelerated version of the original function for medium and large datasets. # # Written by G. Quintana-Orti and Amelia Simo, University Jaume I, Spain. # This code is distributed in the hope that it will be useful, but # WITHOUT ANY WARRANTY EXPRESSED OR IMPLIED. # f1 <- uji_tanfigure( vv, gamma ) #### k <- nrow( gamma ) + 1 #### h <- defh( k - 1 ) #### f2 <- t(h) %*% gamma # Accelerated code. f2 <- multiply_by_transpose_of_helmert( gamma ) beta <- Mod( st( f1 ) %*% f2 ) f1 <- f1 * c( beta ) f1 } # ============================================================================= uji_kendall.shpv = function( x ) { # # Accelerated version of the original function for medium and large datasets. # # Written by G. Quintana-Orti and Amelia Simo, University Jaume I, Spain. # This code is distributed in the hope that it will be useful, but # WITHOUT ANY WARRANTY EXPRESSED OR IMPLIED. # k <- dim( x )[ 1 ] #### h <- defh( k - 1 ) #### zz <- h %*% x # Accelerated code. zz <- multiply_by_helmert( x ) kendall <- ( zz[2:(k-1),1] + 1i*zz[2:(k-1),2] ) / ( zz[1,1] + 1i*zz[1,2] ) kendall <- cbind( Re( kendall ), Im( kendall ) ) kendall } # ============================================================================= multiply_by_helmert = function( x ) { # # This code multiplies the "x" argument by the transpose of the Helmert matrix # of the corresponding size. # # Written by G. Quintana-Orti and Amelia Simo, University Jaume I, Spain. # This code is distributed in the hope that it will be useful, but # WITHOUT ANY WARRANTY EXPRESSED OR IMPLIED. # # # threshold chosen as 30 # if( nrow( x ) < 30 ) { xh = multiply_by_helmert_explicitly( x ) } else { xh = multiply_by_helmert_implicitly( x ) } xh } # ============================================================================= multiply_by_helmert_explicitly = function( x ) { # # This code multiplies the "x" argument by the transpose of the Helmert matrix # of the corresponding size by explicitly building the matrix. # # Written by G. Quintana-Orti and Amelia Simo, University Jaume I, Spain. # This code is distributed in the hope that it will be useful, but # WITHOUT ANY WARRANTY EXPRESSED OR IMPLIED. # k <- nrow( x ) h <- defh( k - 1 ) xh <- h %*% x xh } # ============================================================================= multiply_by_helmert_implicitly = function( x ) { # # This code multiplies the "x" argument by the Helmert matrix of the # corresponding size without explicitly building the matrix in order to # increase performances. # # Written by G. Quintana-Orti and Amelia Simo, University Jaume I, Spain. # This code is distributed in the hope that it will be useful, but # WITHOUT ANY WARRANTY EXPRESSED OR IMPLIED. # m = dim( x )[ 1 ] - 1 n = dim( x )[ 2 ] result <- matrix( 0, m, n ) vsum <- rep( 0, n ) if( m > 0 ) { for( i in seq( 1, m ) ) { val = -1 / sqrt( i * ( i + 1 ) ) hi = val hip1 = - i * val vsum = vsum + x[ i, ] result[ i, ] = vsum * hi + x[ i + 1, ] * hip1 } } return( result ) } # ============================================================================= multiply_by_transpose_of_helmert = function( x ) { # # This code multiplies the "x" argument by the transpose of the Helmert matrix # of the corresponding size. # # Written by G. Quintana-Orti and Amelia Simo, University Jaume I, Spain. # This code is distributed in the hope that it will be useful, but # WITHOUT ANY WARRANTY EXPRESSED OR IMPLIED. # k = nrow( x ) if( k < 30 ) { result = multiply_by_transpose_of_helmert_explicitly( x ) } else { result = multiply_by_transpose_of_helmert_implicitly( x ) } return( result ) } # ============================================================================== multiply_by_transpose_of_helmert_explicitly = function( x ) { # # This code multiplies the "x" argument by the transpose of the Helmert matrix # of the corresponding size by explicitly building the matrix. # # Written by G. Quintana-Orti and Amelia Simo, University Jaume I, Spain. # This code is distributed in the hope that it will be useful, but # WITHOUT ANY WARRANTY EXPRESSED OR IMPLIED. # #### m = dim( x )[ 1 ] m = nrow( x ) h = defh( m ) result = t( h ) %*% x return( result ) } # ============================================================================= multiply_by_transpose_of_helmert_implicitly = function( x ) { # # This code multiplies the "x" argument by the transpose of the Helmert matrix # of the corresponding size without explicitly building the matrix in order to # increase performances. # # Written by G. Quintana-Orti and Amelia Simo, University Jaume I, Spain. # This code is distributed in the hope that it will be useful, but # WITHOUT ANY WARRANTY EXPRESSED OR IMPLIED. # #### m = dim( x )[ 1 ] + 1 #### n = dim( x )[ 2 ] m = nrow( x ) + 1 n = ncol( x ) result <- matrix( 0, m, n ) rowAccum <- rep( 0, n ) if( m > 0 ) { for( i in seq( m, 1, by = -1 ) ) { val = - 1 / sqrt( ( i - 1 ) * i ) hi = val hip1 = - ( i - 1 ) * val if( i == 1 ) { result[ i, ] = rowAccum } else { result[ i, ] = hip1 * x[ i - 1, ] + rowAccum rowAccum = rowAccum + hi * x[ i - 1, ] } } } return( result ) } # ============================================================================= # ============================================================================= uji2_centroid.size = function( x ) { # # It returns the centroid size of a configuration (or configurations). # Input: # k x m matrix, or # a complex k-vector, or # a real k x m x n array to get a vector of sizes for a sample # # It computes the centroid size in a faster way on medium and large datasets. # # Written by G. Quintana-Orti and Amelia Simo, University Jaume I, Spain. # This code is distributed in the hope that it will be useful, but # WITHOUT ANY WARRANTY EXPRESSED OR IMPLIED. # if ((is.vector(x) == FALSE) && is.complex(x)) { k <- nrow(x) n <- ncol(x) tem <- array(0, c(k, 2, n)) tem[, 1, ] <- Re(x) tem[, 2, ] <- Im(x) x <- tem } { if (length( dim( x ) ) == 3 ) { # # Argument x is a 3D array. # n <- dim( x )[ 3 ] k <- dim( x )[ 1 ] sz <- rep( 0, times = n ) for ( i in 1 : n ) { xh <- multiply_by_helmert( x[ , , i ] ) sz[ i ] <- Enorm( xh ) } sz } else { if ( is.vector( x ) && is.complex( x ) ) { x <- cbind( Re( x ), Im( x ) ) } #### k <- nrow( x ) #### h <- defh(k - 1) #### xh <- h %*% x #### size <- sqrt( sum( diag( t( xh ) %*% xh ) ) ) # Accelerated code. xh <- multiply_by_helmert( x ) size <- Enorm( xh ) size } } } uji3_centroid.size = function( x ) { # # It returns the centroid size of a configuration (or configurations). # Input: # k x m matrix, or # a complex k-vector, or # a real k x m x n array to get a vector of sizes for a sample # # It computes the centroid size in a faster way on medium and large datasets. # # Written by G. Quintana-Orti and Amelia Simo, University Jaume I, Spain. # This code is distributed in the hope that it will be useful, but # WITHOUT ANY WARRANTY EXPRESSED OR IMPLIED. # if ((is.vector(x) == FALSE) && is.complex(x)) { k <- nrow(x) n <- ncol(x) tem <- array(0, c(k, 2, n)) tem[, 1, ] <- Re(x) tem[, 2, ] <- Im(x) x <- tem } { if (length( dim( x ) ) == 3 ) { # # Argument x is a 3D array. # n <- dim( x )[ 3 ] k <- dim( x )[ 1 ] z <- multiply_by_helmert_implicitly_3d( x ) sz <- rep( 0, times = n ) for ( i in 1 : n ) { sz[ i ] <- Enorm( z[ , , i ] ) } sz } else { if ( is.vector( x ) && is.complex( x ) ) { x <- cbind( Re( x ), Im( x ) ) } #### k <- nrow( x ) #### h <- defh(k - 1) #### xh <- h %*% x #### size <- sqrt( sum( diag( t( xh ) %*% xh ) ) ) # Accelerated code. xh <- multiply_by_helmert( x ) size <- Enorm( xh ) size } } } # ============================================================================= multiply_by_helmert_implicitly_3d = function( x ) { # # This code multiplies the "x" argument by the Helmert matrix of the # corresponding size without explicitly building the matrix in order to # increase performances. # # Written by G. Quintana-Orti and Amelia Simo, University Jaume I, Spain. # This code is distributed in the hope that it will be useful, but # WITHOUT ANY WARRANTY EXPRESSED OR IMPLIED. # # Initialize result and vsum. k <- dim( x )[ 1 ] - 1 m <- dim( x )[ 2 ] n <- dim( x )[ 3 ] result <- array( 0, c( k, m, n ) ) vsum <- matrix( 0, m, n ) if( m > 0 ) { for( i in seq( 1, k ) ) { val = -1 / sqrt( i * ( i + 1 ) ) hi = val hip1 = - i * val vsum = vsum + x[ i, , ] result[ i, , ] = vsum * hi + x[ i + 1, , ] * hip1 } } return( result ) } # =========================== # Replace original functions # =========================== # ============================================================================= defh = function( nrow ) { # # Written by G. Quintana-Orti and Amelia Simo, University Jaume I, Spain. # This code is distributed in the hope that it will be useful, but # WITHOUT ANY WARRANTY EXPRESSED OR IMPLIED. # if ( nrow < 100 ) { return( ild_defh( nrow ) ) } else { return( uji_defh( nrow ) ) } } centroid.size <- function(x){ if (is.vector(x)==FALSE){ k<-dim(x)[1] m<-dim(x)[2] if ( ( m == 2 ) | ( m == 3 ) ) { # Matrices with 2D or 3D landmarks. if ( k < 40 ) { return( ild_centroid.size(x) ) } else { return( uji3_centroid.size(x) ) } } else { # Often square or nearly-square matrices where m is larger if ( k < 85 ) { return( ild_centroid.size(x) ) } else { return( uji2_centroid.size(x) ) } } } else{ return(ild_centroid.size(x)) } } Enorm<-uji_Enorm preshapetoicon<-ild_preshapetoicon preshape<-ild_preshape distProcrustesFull <- uji_distProcrustesFull distProcrustesSizeShape <- uji_distProcrustesSizeShape distCholesky <- uji_distCholesky estSS <- ild_estSS estShape <- ild_estShape centroid.size.complex <- uji_centroid.size.complex centroid.size.mD <- uji_centroid.size.mD preshape.mD <- uji_preshape.mD preshape.mat <- uji_preshape.mat tanfigure <- uji_tanfigure tanfigurefull <- uji_tanfigurefull kendall.shpv <- uji_kendall.shpv ########################################################################## shapes/demo/0000755000176200001440000000000013334626562012473 5ustar liggesusersshapes/demo/00Index0000754000176200001440000000007407730546542013632 0ustar liggesusersshapes Examples of statistical shape analysis shapes/demo/shapes.R0000754000176200001440000000335111672130356014077 0ustar liggesusers#2D example : female and male Gorillas (cf. Dryden and Mardia, 1998) data(gorf.dat) data(gorm.dat) n1<-dim(gorf.dat)[3] n2<-dim(gorm.dat)[3] k<-dim(gorf.dat)[1] m<-dim(gorf.dat)[2] gor.dat<-array(0,c(k,2,n1+n2)) gor.dat[,,1:n1]<-gorf.dat gor.dat[,,(n1+1):(n1+n2)]<-gorm.dat plotshapes(gorf.dat,gorm.dat) gorf<-procGPA(gorf.dat) gorm<-procGPA(gorm.dat) plotshapes(gorf$rotated,gorm$rotated) gor<-procGPA(gor.dat) shapepca(gor,type="r",mag=3) cat("First 3 PCs for pooled gorilla data") for (ii in 1:1000000){a<-1} shapepca(gor,type="v",mag=3) cat("First 3 PCs for pooled gorilla data") for (ii in 1:1000000){a<-1} gor.gp<-c(rep("f",times=30),rep("m",times=29)) x<-cbind(gor$size,gor$rho,gor$scores[,1:3]) pairs(x,panel=function(x,y) text(x,y,gor.gp), label=c("s","rho","score 1","score 2","score 3")) #Some tests test1<-testmeanshapes(gorf.dat,gorm.dat) print(test1) cat("Highly significant difference in mean shape") gorf<-procGPA(gorf.dat) gorm<-procGPA(gorm.dat) mag<-2 TT<-gorf$mshape YY<-gorm$mshape par(mfrow=c(1,2)) YY<-TT+(YY-TT)*mag tpsgrid(TT,YY,-150,-150,300,2,0.1,22) title("TPS grid: Female mean (left) to Male mean (right)") cat("##########################################################\n") cat("#3D example\n#") cat("##########################################################\n") # Male macaques data (Dryden/Mardia 1998) data(macm.dat) out<-procGPA(macm.dat) par(mfrow=c(2,2)) plot(out$rawscores[,1],out$rawscores[,2],xlab="PC1",ylab="PC2") title("PC scores") plot(out$rawscores[,2],out$rawscores[,3],xlab="PC2",ylab="PC3") plot(out$rawscores[,1],out$rawscores[,3],xlab="PC1",ylab="PC3") plot(out$size,out$rho,xlab="size",ylab="rho") title("Size versus shape distance") shapes/data/0000755000176200001440000000000015076647712012465 5ustar liggesusersshapes/data/humanmove.rda0000644000176200001440000000325215076647713015157 0ustar liggesusers‹]WkPTe^¼@j‘ÃhFÅK fˆ¨YG[ ¹¹ì²rQн°»‡…eQÙ³Y Ç2&Ë;išM5Y Õ:Ó7Žš`Ž©ãÎÄXÓ`ƒŠc:™MË>ÏéGgfù8ç|ïýyŸ÷;&CqJLqŒN§Ó뢢"túÈпQúП]”.:´F[½Îu.§»¾*´gBèù"phOèÚ+”2ˆ³Ë†EÅ’²®éIÑv ÏåTÃÆ´øfáý÷FŸo›gßlat݈ùu‘Q¶õŸ©¸µLø:{;ׄsöµ]½¡³^Ù.äž½ãg«O°Fÿô–È /‹ŒùeWãNWµÐ¿õ2ä¬E¾ù;ºG‰¶a蓱ֿª;×5I,£ÝÜ~ÊÏnÝ«÷Î[šo¤^<´^TdµöÉé÷…:šöGo¹DíTÝÈ%Ò„/‘Û›õàóB„þF#Þ—=?Ô'°Ï}î‘æ¼Ô!<³¡7Å`hJ>?Fäe å ø¿©z,eý×/G¼.Ô¹gBW¯p·B®Æ½É±°›ß{Jä¨?‡q©´Ÿq<â°ë!Äþù­­÷Ö/Œ±±SÆ¥žJJ‚ý¾õ¿!Îe ÏM¶„ºùr vVž¸—&ä8ÔuÑÐP—¾üiQ0¶õHóÙA¡è) ÿl€5òmwç#¿é¬¯‰öý—cS£s„÷UÔy¦Ï7¦£ävHxr ?Nü0Q¸Pÿ ÆoÎ~,v?$7Q?% kúÚ†á—Ü»Þýȧ1ù5 Ýœ[ŽGE ›ø› y󪎂ÿrñÓø_ þ̳g`üÞÊúÙÞ…Ÿêdè“=¸¯=}O'í¼, Óç¨O`5ôla½«ÆIÁÞ… 9z=éáUJÖò§ùϼoî\ù˾¥cz„ú,ôiu“o‡íI†VÔÍL+ïÃÿâ£D‹ß»n/ô¹¾ ¯Ró_È>VraÇ·q˜y¯–±þ¬[µÖ+­¢}K?ê DÂúRØÓô«Ä‘kiÿ®?“Â>/\G)ßb©ÉÙß%ŠJ·ÿ;ìóv!ŽLêWÈŸS Û¤0/H¹w}ŸVŽN%q…§¶Ýt ÿÛ”gž—kö+ÑWNÚ±û!åÑ~)ù&p rÊ\ì÷Ú®#.™òÞ4Ô'“¼¥å?P ?[úw÷Ö/8–3‚»¿PDÝrä19aÚàÂ7Ë…©q‡ýfò½ý®Î$~Ç¡µ:äój@Ÿ+'áwy»*Žö—ÒŸÓèßšÃÀDž0Û;¿z¯oP6"á_9ê$T åËP?™õÏfÿÖä†é¸/º \©È‹ëô:‰_#ùÑÒˆþ÷³ïêa_Á`z~ã¡:‰?ò¶#΋TÀ¾]ÍüùiÇÛ‹ý9äuÕœíào»™ö‰§bæÕÏ>õ÷YZÿX±:ißvö5ÿK¶S>Šóq"ìer>©k ·šóÃÖü‰›ÒÁm~¸]8Ÿ=y‚sRA^ÝäÏ:öÇ òŽÖJük9¼¹5þŠG>Ü1¨í}àpp$rÙJ‹.ÕÙ}Q4_Cvö»:ú\´çyÖ'%‘ÿr}´ÏùÞtùØ°ø5@Ÿ y5˜“ÒrêËãõÿBþ³¢¿Ö]ÂüWK¿óRCdæÏeBI¹¬Ï*ö¹_…¾†MÐS œ µšýϾsþöO2’·Œ]À©Ÿ}â#´¾P7Ã~õËÈ¿ü*‰;çPËß°SOþÌ×ø§çã±g?į¹ó³…óË»zVò\¡6áÞ‘‰ý¶Zâ7u³—ZöpþNÚ¥Ù'/Ùiߊ¹"B_ÑbÄø q*¯à¹GÃÏå¸÷ò<§ñý‘ïÿøñ©Ó9ÿ^>êx®ZHþÓú<°yofý¬¿s~Jœ¿äŒüÏëìL?÷Ú,QHþ€ÿ…È×zÎa­ÿÜ'Q?ùÌ_ÃømÒä±oý,•¿ó“ùw­ãHÊ&O˜Ï`U¦Áo_xS;ר5xîâ¹¹}/å0¿– ù¯8©çÌïìصÄ)T7üqÍ€ÿö~̯⣈üï繫~ìç°¯Ô*ÔÃy„ò8WKyìÿRÖÃϼyÉÃÙ|¯">g"øÃŽºJùìß5\ýKˆ?žcW&Òžÿªï¢mC˜ÿ«È;k?ª˜Òý¿”ÈJ›3´ŒùpáoäõÈ7ͨÐ߿n±áåç shapes/data/shells.rda0000644000176200001440000000056415076647713014455 0ustar liggesusers‹ r‰0âŠàb```b`aad`b2Y˜€# 'f+ÎHÍÉ)*«b`âÒu P`ÿJßn•Ûøº• ØßÑøz¨?FCýÍ™ 0 Cý=)r;ˆ6ÿÁâë\¶K0Ô_C5.ÿlŒ<†ú[Ý׉T=ÄPÿÕÕ?B‡«G „ù W¾Á4߶ä3 õOp„ç °Æ7 õAÁ³ø:†z\á+|p©Ròp5¦ûq„ÎðÇá_\îÇeþ3é—úç1à%Ú=ÏÁÎáÂPlmÑꯢ†B=È•îë0Ô_A g¸<®ð¼Žj/B=(™|=L´_Àü…R*0§dæ)^ŠAÒ¢@üˆAE„¨ƒÄ‡(Î?¡¡44ðü( åCåCqÑPua Øép(‰J£y5/17XÞ1€=d*-ƒ²XŠ3«R¡ÞüÊ8Ã?shapes/data/sand.rda0000644000176200001440000001313315076647713014104 0ustar liggesusersBZh91AY&SYì;=éÿÿsL@DUÿÿÿÿÿÿÿÿÿÿÿ@@@@@@@@@@@@@A`>x¼x ß>†¯Žð-ÖMwá—z4Uã@Pª©ÿ€¥P¦™4 ÐEOÀ$ST@h‘“@Ä0ÚP¦¤zž?TLÈLˆ4i §‚TM ¥4iê~5H S bÕ?Ô iú¦òS OÑ$ I¥=1§¦¦¨y#ÍOz…#OF=2'ª•TýPg©Ðdh †žOQA#L†!ˆ2@‰$ˆ›*xÓ)3SôÕ<$<‘µ¦OD= h4Ð4 FOF¶Þý¬VˆÑm?µÈÜš-ç-Á¤Îp®sšqÎqÌãœY¶Ä„„0mƒC›vl ! ¦ì7d M66˜ ¡ Ù6Òm;1¶XnÃB³vM»ÝË6Û,„Ý›°Ó° ¶›NÍ´Ó°›M°I‚Bhc±f&Ä!‚`›mƒM¡Ù¶6†—ó"€Ú>3‘7Ûr$ÆГpj47q261§„Ln˜q+EÌ2@Šd´!LtÂ:A Šä ÅQ —LB3bI‘†Í$ÊK ÌtÔIHa$´ÊŠ”#ª$R²5£±<Ä:—.'Nc$c "-U”ºå²R`gp´ÙƒÈõU©Í8 9“]62ee›”s2b¡:±&å72°Ñ^*†f=[hY˜Ü-I 8àÃrИÒn¤èq…Œ) ÇF`@…€œ¯x„ÒzPì *”Åõ€X#)ˆU’q‰×QhbYFEhŒ‰¹‘ŽÌ³A‹ Õ!&£±á‰ÎµDÄM´$º²‚›¥}ÙAJv€'´ ©Ño¤&p§L¤ÎÜN2D¦‹œÒwNa[U|M"HäùØhp7¦Ð7ÎJ຦f‹äiC¨MÃMlûy—)U©€\ˆP…”=U²þÅØ"ªã߇lK1ûñ†¥ÅÆ•µÃI²k\:ñ=Æ#`º"Xºž•Î ˆbŒìª]ÎÄòÃY¦Àó’A ‘*,Þñ¢E' ca¶,Ö؉ËwÜ1±cÀº—; 7†Ž½–`‡)–ÚFÏЈق)"£•Ø¥c]cÁ Fp\Q”µ·JÜ s›¾È"É àªÌ¦iŒ8Ë.,¸\ ˆ1®Ôâ"$(ÁÊZôœ(ÕmøEÆ+7Üú°’Ø‚ fV=’Ý7°&ÁdÍd§!áUõÎ ˆ$”ªµò}†ñ­+yÈÏB5Õ ×€Q… uˆžÍð„€B6Ý÷#cjÚ#Ü…1K±5…@Þ(à1{ u×~#»¬èA¸ÀŸƒEïVlæÒuCTY+ ÎÒrÛ‚ Æn„âeî ‰M.‹^‘Ñ´ XÌTµµ‡~0Ô‡B\Z:¢¶iŠ·dldOµ9î9Ž÷µí˜r¨½¿3”Îk9NouΗr…ß° „£3–d‰ðANb˜Aš2曜ycÑÃñι7?<2ç°áw‹ã†+Kj=°‡I{ÃI>=y%d¹Õ­3g^àKÈBÌÓ§¡%ÀÉ×Y~JèR¬7Èó†òϺÏ$3FÜ•¾é——q®±! á;ôH·lb>ËÜóÐ" Ë8üÅé W¡1¸€øÆ æÈ@Þ{V”Žg«zþrß=ÀÍú3Ð÷zß<&Šü}âð^³/ó9x?“ ÝB›×rD0UŸ£Ø“Â2 ý!暤wTlýÆ×/©ÞO°Qõ }cáÀýSEíÃ@/¬hX?Y‡ë‰·ùqkú¨ú“NÊ‚qF¨_×áôû FU@ ùðh„´OÓ±„ýtœõývß°#ð rG1þÑT ý»°±GîB„65ûÛ¤s¦xé‡üWÑØÞ¥Zñ{ø’Ä,B_þì:i5:‡V¡øη_®NGK¤ð!A*zŸ/ù|êç"ªižtâ÷Ó{î.¾Î‚€¨ÿ•U G™X¬§^Š€T/Öt7%¡pT^°‘TD$A*+XhÙ¶ —fê%2¤voØ©¯¯ØÀ';b´tõwžZÚqÞ-{zÅHßÞº‰K žš¨¶·"ƒ}›Å–çéÃHŸ>/£Rú€éTæÏwƒtÄUX³Q—;ï‘.›wöîÑ÷{îñÒã“°äÓ§ˆÝ7IÞt÷—À-áxWXoŸM©€A⎯YJߥªˆf”U-OQÔñ¨z¦ q¾±àæ®ÇP¢à”æ­‹:QGÅFx“[—o=-šÔ¯ãx®KÕÐP  f¥¹2³«ÌàïJé±ÖoPÖx^44Âg"o5SlÁguĵÖ-WnqhBG‡R½¸Ænd­¹w$Ýæè†hlCkHÆù½EÎ’â¶áBOtfåB‘ 7v `Ä7ÆÕníØðn•ƒ ÕF²©Ç¹ë²eGºv›¾èŽôSlÒKTw¨$èwg{]ïÆ@ñ¹rðñö7u“¾!9T¤˜ˆiÈT4‰- ÑšUÌ;ƒ¹Æ44;5èŽÐQëí~#ŒXëñvãñcؼw³ms•)1B†SryDùF+H©ò~S¸W¯JæL«ë¼0h»…/TG×38JJ×.‹2'¿{w²w¿IwLpžzgÒìŽ$i†òAË8ô—¥.”Å4l‡‡±$¹‘6[ å!…Ã8,Ú‡\¬‹wPp¥ò¥Æ©ã¼ [.Á0›Ç»àòõ ¶+{ªF)à°NV»¾±FÅ°®½Š¯äJã=gêÊc=S|Æ>Ï^-{ª•Á}=yc¦Zb ˆÈÓQuõß­áÛöNÛñ[òL}™pù ƒpJà|njy=Ÿ9ϘEd@$#c2ÆØÉ”„Ä ’)3 3#bP6Rš22 ˆKf2¢$L3Æ£&!¤€(4jLš#e$Ñ¢HÚ4i ‚ŠK32-Éi)M‰1¨¨Ø“4cDc*(ˆÑX µ,Q‹cITŃd‹(ÑM¢Á¨,’›‚¡-’ IPDEC- Ih0ZÁ(´Q¬fR[FÄjMˆÆ*Š4TlIchÆ*ƒj5d¬lQZ -&#%Qm¢66’ŨƒF*£h*ŠŠ*MX ¨ÖŒb©–±cThÛDj-EQb£X±cZ5±FµŠ‰"´mcTTUEQ¶£j‹lh´k¬m©šÆÆØÚ6Ø5h­ŠÅŒ˜ÑmE«¢ÑŠ’¨ÛlmQ¬h±¶Å£kb¤Ö‹E±´X«M¬m£cmF-%¬‹ ª5%¨6#Uª4VX£VŠ h£h¢Ø‹Q±«´šÖ)5FÅ¢¹KUÆÆÑ‹Q¶¬j-EmŠÕ4kQµmÿšÚâ¢ÔVlm¶6µ¤ÕÔZ€­Qµ¢Œc[zmKâÄPÒÅ©¨T-*µ,I¦iÂÌ*b¬U1ä`T’·ŠËÚômÉèø< z8²ñ`'.׆†‹UÝ)µ`½ø2*Š‚ŠË‚Sq5–¥¬r%î¢ÕbÀàóØD:O{ˆd_Y” ©E’Ф¿K×F2(>†@H â ¢I{¯O‘óSé\ܵ"ÛŻӞ‰†r{þO69åéWÄù@;D°#®^Sظ¸ÃÙ·¨!اŸ$;¯jFüTš¬a~‡n$EóÅ”ÞÔÂdörwfÚ­ô }…ÈI$öÚÀZ‘¦‡Yä‘×ÖÒ! zʇ?Ÿ?£Ñ}Rz~p"#ƒP„”aÃ/ †DÁ†¡€Ð\ɘ˚¦k£Ut³k] fKK³ÓT(ïOxµi”7èa#œïV$º:I¦ó路CFm›CiÞv| m»Ú8¶ñý9©-zÑmVvÔçO$^Þì|ž›ºº²u'WWp⺽?GuÉÏF5+.Œ2î·¢C¢0ô´ijŸ8ƒ Ð¹æΊÊMšñh:mšÌiºmgw®Á6½f§zWªZq—rg\ÞŠ;í;åiìòÌ…`ãZbA òUðdUðEJoÛ×LòU¸ÓlG3åïr£…إʋª–ôÊßiÆ…Êv—swåÏ£—V°¶›1kh¶¸ô,ƒÒàÜX74vÜÚr8Öå ̹#–¾è&Qu¸LnÝ!aè’=QS§.øpo~Ä:TÛFñ—!Ý„Bœ'l;´ßq¡wQ`î.m¿S‘l€må”g¡3¿ˆû”wpðŸ ê\-pð¬zÄ+ÄrÑÂN¯ Ç€ õcÔT¶"ôÃc9Ϫ„Þª[kWm{°b窆ù¢ujNá|r´ñ]ΛÄi"íë5?"3Ô .ûLÊŒ]¾BF%¯iqadaýB8£ K}ƒ®òbàQÛ¬µ¬}u‡ë.š¨Ðppƒ:ãó[*ä[õ¸ïÔúäà-6àÁÍ FkɱêÓçš©qS…úÆÙî<ûÒ††2e¿#]°F÷lçjûÌ/(Ú»KÎ/< ßØ.çŸ}UíPp(ŽG<ǘ<Ãiù_•ù“7ú~[èZ hЊ7¬7ä¸í·µÄíÞ"}ëÔj¶¦)Â©Û ¬U5zžsK' ˆsô Ñ{:(a‹$1϶ŽëD±Iñ+w8¸­µ½·g«¯‚ÚÅ­‰kBÔÍz»ëf¼ù×:\äçuQO •ó ,ãçÏÖ9ßLÒB30wWŽ–2㼚ó£ŸHŽw±3Êæ£ ;ùì‚hÅHlD­Ö­kÃ×5ì2Æä†j«2À9³K°¯&5…ù¤Ž´•Fuà¦è£š“Ê™*3Ã3ô3³¹Ëa@å‹•ð«O|¶ñÛ=¼¼ÚY¯N“‹TŽm\‹-€ÜŠ¤Hìßzé[4·’®Æ(W™toâKYÌBØNÓ»Ÿe£|ß ®¹ÇgrN)w €†×áR4ƒ‰q4ðÛ´w6›téÒÚѱÒ-¼y.ª—ÿrE8Pì;shapes/data/rats.rda0000644000176200001440000000466515076647713014142 0ustar liggesusersBZh91AY&SY~VíÌÿþs|DUE~aåiwýÿÿÿÿÿÿÀ@@@@@@@@@@@@A` P(ƒï{΋¨‰! B‘? ˜#@È4§ª§€„I¡éC@2h 4b=@Òš€˜&A€&&††` ‘ &C “ bda RdÙLÒô™h4Ðb4 ‡Ðƒ@È@I¤’$jb€yO= SÔóÔš‡”PÄÐ Ó ª~©ò‡{ú—pnÀôúÙW$çûkÂ0&Áʺ`VÃ-Yhm+0È!ßbë*s“fKˆUíÄUÂ\äÒ"1ŠºÈ¶(¬ãb3²¸ÂD¦0†¢Ui;­0Ô¤=ÜšXÙ`6I§ ½HUÓšÄæ!y$º½³lìKX Á.2V‹)³’B(e«X"e¡Hzç8pSš¬Qúòã ’«´­ü¾[­2©CI8A³¦Ep fça¤xàÒk»’ˆð hP›´ÀM&vŸzÅÂïkçLœ…ó‡ìkÈÖÙÔÀ[M¸étºE¢¯'w]¦¿Æq‚€àN«òì [„1¨‰’0›Î$V"t D×͉ÀLk–*ü„–;ö²UÐLÅ°\ÆÓšÚÈkV’ŒÐCDžc%ä11œ \d4h@hjX½W…å[Tö©j3Çë•Ôq´r‡<*é©Öì'6Í®ÂÎFQšæ²‘­­\™¼c‹ïGšÙ¾°7Aµ™O‡Ž6‹ðVëiqƒ‚¢,Äë…mV9&5PDDWN[ëÅ{´ºjvb`˜'[Lö.Ü0 ZéK:îmH$ÈkuË–]ísD ˆ_+`lj1½YÙ¿DF" ehã\ÂЗfÔ­p᪜ ž‹bdS—Ô¦Ô3m8/–™–D± €Æ\ö°…ð*–åT•Påššj#>4½@H!|Í}ËïD¿€SAA×d…¦¸¨9¾×ÓWâØ5¡ÐL¸Jk ­„Ï6mÅ­f œ*$µ¶FÝ‚¥P›k³”,s0"å/*Y!q ¤Œìà†ñèà•-N´­¬”eCía~n`7Ë;4- %&­Öc,ïÌ÷ÍpÔy ·#Ð![æuÐÂ0 ³ËIÂÈ­qBeb± i•Åðt® 2tgmw(é£;Âĺà&`˜9Ø0Š{[6x!¨ÙOzŒ„1¥¤Ç:óÛ(“¤´Zã'sÓ,iT#}ÍS ©Ô|N›dfèsÙÜŠÏ£ ¡1'1¨q:¹Æß ]N{¿àÓ«»O;:}}ЄŸ´wêðñã¯JÝh:ï/%xÙÈ’”(w‚Ä@s< @NŸŠsŒC«¸ºLD´*Jlt‰z…‚>¡î" Õñ`’L°hFB¢¤@h£’ Fj.ÆßÂ"¨«*ƒ+#.Á8DeQöƒn‰Pé ÊTP¦Cœrß‹ºOåyNé«ó.›ž¢ èˆ «ª¿BV"yô ž4Å3«¹ï{(_À(ÃH`Äü„dwî‘N‰CZu‘% 03±‚ NŽ}z!Ù¥‚pøUnV[ƒ ¸odq˜Åôœrêâ–ÆÕBÚUJÕYs,Œ¦20ŠÈ*Ë6üÛËk…ÃÐÕµµ›[{;›Úó÷m¾×m³¸ñîÕú3è!ô±`Hº@ z\î‚jæÆY‚¨}]_»@8ó‡óìÖ(›Ýæ ¨ì‘TG¨êôô:V­ü‘:ÙÈ&UÒÍõaÿ{p`ª°ô ¹@𰞪}ÎwC¥!ìÏo>Ρ¥ÅÃR3¾¦ÜPô~"¨ŠŠ ÷ç¹=hÎjl„Gù?sóÃ#öÐÿ”Ö`gú†3iÓ KÔªŒß¬Øot똥&œ qDÑ!V>è{ƒø¤y{M#„Ä;Rïaì q TRÓžœbÎe £K€¨/¯')Þ= úxxOk[{?hÍêž~ȯûÜá̇7y‰Å~6ÅCdç%D‰™ŠLÝK±‚t¼Rn7›¡½ÑãèYYG Ë‹zmhÓ4ßoÕÝ"Bì±e*h‚$„d„!„ ”-Ü€0BTÐ4)M+TÒ”"ÓÚöÁ$!4'ñ9àîLÏ­S)Cð^‰¸èUg 5Q« A¡8µ‹²^T†Hʆâ;”›•vÝ›†!‰f•äò#—‘ø¬YèIÃbžP8™ˆÇN¡¯ ÐÖˆsÎx£ÉC"ÈŽ…Øx<¡c„åêRq3ô±å§«Ý³¢ÃrùŽnÑ™ÜÖ®&b ‹U¦‡SPîD¦ÆÛ‚o"DV$&9–#2¼Ž¿M ˜B$d„fµuØ:BD2@Á$C$Á$‡âT|Þ½lÁ$¤HP¡@Ò€§,å‡ø!Y®¯S-P÷ys‚a˜‡¡ -K«±â=ˆŽçN1&†,>E0Ðmyþüã8ó—35­¶Ílk ’í¤6æγ¥ D8!$Xõ½yg®wáÂm²6ð]É*bf×Ų‚ì¦26i³XksžñN*D’nÚq¨“ÃIÛò¨w|ª)Y¦E‚‰t ™ ²ES²ž8y!<’õ£©)¤³$ÌÂu!:pI:~¬ÔÌBgCͯ„º'jO"T> *åBÍ)øu/T<J'ÃÜ uWÙTºª?‹ÍßPq˜ÿ“ ú t5„F [æ”Ì\ Å b1$ øm­½žshapes/data/apes.rda0000644000176200001440000000526515076647712014115 0ustar liggesusersBZh91AY&SY-OÑ™•Ýÿs|tUUÿÿÿÿÿÿÿß@@@€À@@` ˜>‚âÀ§J=³{DU?šdi¢` ¤ôÓ¦„ÈG´‘¦™š§¤Ñ£ ¦ž§¢yŠzM<z@i†¦Lž Ðy# OH*¥ 4 Ó(d4@4žª¥@ €bÐЀhÑ¡ÀÐhh4ihd 4dd@¦¦AOSM<‰ Ñ™C@ €hƒ@È4¯3þŒ!"‹QB#"Êj5’˜B2YJ ,’,þmµ©ÅZF½í˦R#J¢‘ÕF,€(²áùÐæXbá&JîÞîà8B[EŽÈóF\2å¤âåÆ…Žé0É1ìÂÚÍí âå¡t’I7¶ôÂc{™e­»ØH…Ô»Ò@³! »;0E··o4{IÅæÖd/0“rÅkQ¼í]£—Œn·gys,è5¨\Û¦÷7ivdç(PÔ«UØ´eN—kC$X’+#MÂ6H‹ 2°„ÄbDF¤¤…*ÀŒZH²2A‘ƒ‘¡„ÔFT$"ÈHÈF FC$!$HÆ^ôÇ›2u“-.íÝÞ—w27$›²äÉ“zîïL¼zgY¸Ë]Ë-Ûîîݸ`ñ:9¯qØeIÛš·-™"\,yŒïæ|·î~‡ãýçîç‹/Ÿ——ã³”QŒmÜ[>uúQ0×?G@úbÕ#óxªVéÚ[|]“vá-”—5ÀäéÅ„‹äK’~“G©µ‚JÌIJ6ù Çwš÷ÕÄY ¬·±CW\N£hF!Ô* š›òÕ,ÏQØjBlœ34%C›| là5^ZЕ„ðC0MY%‹ õE4lú•œËs¢Ÿ$ý8%:˜Žø€i÷ëœÚk)2N;®Eà‚F‹0@=o¢P¥äÄ¢ÄtA~-ÔòÁ.†¿:ý$¾«)·O¢#è/Âbwf[°×6F=wËéW‰áä{8ð¾‰ðK‡A6‰jË3ŠËŸÝª$ÂЙ¬ÉDñ¸4Ubx Gô/C8e6lw绿^çä¤J`] 3êæ¤S©mRÁª¨bà@[ªKºbº§}·?u0?"i¿(K/i']Ó2!Ê?^{¨ +o’,›Ž×ì¿TÙb͆®Hc€úqñ‘Zýaøʨ#„Q¼ß¾Û`¶D€„ÑO¾b1ƒBzÃJ‰ !DŽ¾<L¹#eP˜6k†­…àyæÎÙÈŽÝ»]·ð‘Mê+¬Àù¶•TBÞ$Žì{¹•¶[ (Èl/‘“ʧ³ƒ¢ÈriöÐÐ6‡“ÈQÁˆ¥¼ 3^ ¼Þ‘ëÄ»:ðN¥«j(d2œ ¤ I)TbÅáiUb4¤7eÆ‘6*&fz½ôgº‚nDC?k_DÐÞÍ1Éñ5øó‹j½{Zç˜Å$’&Ÿ@çs0ižª1â Èüƒ»×öÌ%.í7+U¦]–£X´Q ³’9²GÊõKñ²ê6S„¥.¾Ø©>½fîlÄQEèËnRÍ‹v+j=œ¸x{¹ìèÒþ,nÏ%|;NNÔ¤”‰@$m÷óîgÛ>ù°§/+ønøÏb(ïTTííãZš_*î¹ã½ë‰ºæ8b¶ÚÆÊÃC_Q{(9ßþ}—8CÎ$¤¼Ð Tõ|ìÕ°D¯Þƒ­@ ´ÔQ”¢SUR¦k"Ý Y`Ÿm–¥A.ÞØÉÙÿX€Û©Q¤.U~ˆ¢ýb (aˆˆ-º‹Zvå6£JXD@À,T‘‰@Z¢+QC€AòD@;ÐÁgÄ$-‰JšA„FJT/¡è6x€ÜśƟ7ŒTŸÃÍIІ¬-³¾RÀ‚ƒ)F5£hÚ¢6ÆتìZ¸j[)µ)Y¥©¬µ›-e¥RÍ*›R¦ªJÙ²´ÚèÚFœy9ús–_/”1[‚óÉYVàtUëçû'æNn¾aßÓªÙ1ß¡ûW 5î RØ4¢ §ÒÇT\¹ëGÐ5Ûe›Û­1‰|B ‚êfñNé¡@‹5WJß:5¤Ò°¢=B2Xùê®*ŠŒš Eª°í:eÌÌì¬8mS s9ÐÇ©‰S=Ø3ÜXÀÆØ×d–UT„ª5%3ÇàŽbÈK0n#n7vKÂË$.KH©"’]]¤!-’™™mÝ¥·Li-¸·îJf7Lr¬¦¡p/3Ó³²e’H‚$»µ¥¦¥Ë­­r}7´jŸö„x6RµoHªeCÀ]x+ 2¦µ»ØšáaaF&¹¨µitšk& U\rŒ;²¨Ñsiª¼J¶« …re4‰9£ä R¬áf Q®¹]ÓW¹ê¼V¥´J«IEiwuƒF0JÔ#J*Ñh Š£VIK§pI›(h#³Še¢‹Eˆ¬FKF Ñ`´Qj4QŠ‹)Š,P” id!© Œ,eL*VX¥¥HLc$Ù¢”YJ„•J’eˆÙ„L1‚@¢DĦ)”V4iD’h˜¨†"cPcE‰5˜™„`$ŠÁÂD¤Fš3%$h؈ÑFaD212 6 „0ÐE&É‘Z5(ÔŠÅ‹HÄY"ƒhÔc&Œ¦(¢@º»[‰›Y¦ÖlÚÍ5JšÉªRÌݲ® ¤ÚR±³5 °Š ‚!†”D¹Ù©AAǽ´ ¶˜‘¸§oqW`îÎ+¬ ´‡BZÄ«;õÂÕy·öà-ÏÞi£ej¯RÝB†òX®[´)Ò½¥E:…òýLˆ"`³3.íëÖòczªÉG(Èø`ŸMÀ ÞGL.â9/¿0iæÐ]eÔ9uêxG1ÉÆbm_2LaþÏwAùýd&bŠð¼ÁÔÞÞÞï®^Ùµ£›µÏdîx­@ $H”Pî0ÐÁÚª{ÙDkbb8ò­AÔúœì™›S,"“¬p_Ï‚lK¶nü5ÓH¶äxg]}8 E«ß ¼’nb aÊ.±ÞÜœ´šŸ69°ÞMmÕ5lûp¶=v(Åê±\2E‰±»š”ëi¹Hy!!¶¢6‡«Ø‚ %h¨ðhðÚ+0µqF)DFœ„A€‹j§%º(»œAYŒ"h0Ìauñ“ÂïâÍœ¤Ãè$øgI´£ eF†rìêÜ=a§‹rõb°Ïu"¹\°‘”EÄ#E`rÉ­¦n [qt€HÈÖБ7¥Â“ì j;i©êeM³Æšà’[}éÜ!ïzÛ^Ÿ¨8ß.T*O+xT‡—OŒßˆß_ãïãIàù]¾,8ZF¹0”uˆîrRšsô(Î@€‚Y!ŒÏžK…ÞZÓý'<\]ðT®ÕSz¥-ÆÖâ¿vŠªn»ÛÌmhu Û#1oT8Õ’/:öœ÷^ŽNnq1ÙÔWb‘ðX±&º”Í-›I+pAyéRN<¤$C™.Ýv$ª£`REÅqp‚ϱ¶v‹¹"œ(H4C½€shapes/data/qset2.dat.rda0000644000176200001440000000216415076647713014766 0ustar liggesusers‹]–klUÇ·íjeŒXÖ„ˆ”HÔ, !ÑšÛvu·ÍwKÅ}ÌÌÎìììîtv+¥­/R|âƒ&¢i¡FÅG|cª±úA’Èùà­&6¨H•‘¤:Ãïô‹“loïÝsÿçþç1ÛËD#™H(j …à ¡Æ&ÿßp£ÿ§!-ð׃CÎpô–’5ìÛ,òÏ[”¾e*ýÇÖ”öZ|oË#3ª´ï[ÿ9 Üïd¿gkëTú¸ºç’Ù¯vh+•74ißø†Šõ—=ÓJsüã¶3ÊØä/³_+ëgÿ4Ò®¬Åìs8ùQÎKÁ.¾Wy3cþ3®œ(vë¾ ªÙ'ß ª0î[·lVÖ€²ÇÅ à•u½ùke Üúnâ¨.‡_ß4xžø‰]ƒö#qîj „PÖ7Äe}ÀZx©-~Žñ¸úÄéìœw%ßÇ°O­Ý®$wHž2÷ONòn<É÷Ú ¼ÍíèZ¾v6§û äû(º¥çˆ§&ó¤{58ºð0Gñc_+Å=CúO›Ÿ³èéƤßC‡Ô |¼fx¶ÿNü9\MêÆüTúKøY×JÞ‡Žå.xÕ—ã¯Ò€}ZêÓý¾ê{xd%ïùÃð.¬Á¯¹ý¬cð2¶q^^?ï}ìËÒÿ}Íðñ@ŸDµùzy‘üY»˜¯E™¯9Ñ%{½ô]Eð×J?¿ûMtð:à“бסOLéßâ­è`ˆn'dþKÝ9 ¥~ž‘þ•¾J=Ïz žÉEÄo.áž)sÀîÃÞ–ø²àg¥Šg¸W="qʽD•:è—zïzËoGGãrüXÒwæs2Ÿn—}'ø¥Íì«SÄ;ÿþJ–ùp€{q©'}VTøMÈûk„5w3÷7DäûCØ»5™Wq;~mŽ:è™$.s©Ìgé» ¼â¯ØçÙŠþ'É{¿ðs^GÇôÜúMÉûÅ:'s°^iBúl¿ø½‰{f†}EâȃS‘8ûä}í¯#Nr’ï¼ÌíÂ!øö“¯ÜÄ»Á¤Ÿ‹§Ñ¥úüí«Éw¼ Ýú·Á§k#~rRÚ°ÌéO¤žþ½àÿ?`šJnÝ_ÿúŸ‹/üÖ …–øŸ¹àóhìç shapes/data/macm.dat.rda0000644000176200001440000000226715076647713014651 0ustar liggesusers‹…• LSWÇË[QA‘¹1Å@eC¥+ˆþ@[Ê«xoµÜB‘0Êu<”âãa(dÜ©X”Á"¶Â2^êD© ¾ ˆ¨°™ânÓë’™4»É¹¿sî=É÷Ëw¾sÉ£8–”%‹Å2f™š±ŒM让1ý2b™²fÓœ•¬HH^¨H£§XÑc5’Þä¸j:¡ˆÝÉÚz;q¡‹–Fî–ƒ´Ù³K9X†xÁâY%Æé zâ‡\‡dÂ9M\0vŽcáßþg°Z0ñ§ÛÏ›‘xóÙ˜„ƒñùj>R;§sŠ”‹çöI’Aíý++Býâ—O²õVcÞˆCIµ÷ïXDP+¦zÚúeJ0h7Ïh6óÚãêK–dÞª’™¥ðŽ¶¨'+A2ñ QrBÏÆ›!ßzÃ늅%ÛÖ×¾@ô%Ï£K‚ ž{îLpŸ9â.̱^ÑéŽìïBˆ\lÔÔ w5ôÂɬÝÞö¡n•ìWSVˆVOM¦š"˜ˆ€s½ü¶dŠ2$pO_bçãþëÒuma ™übã)còÍp=¹Ÿ|oä»úÝ>,Ó FVs¶lc)D;‚ª•—!-°¬gCRu‹°»fr$ôî”ãe°‹Nµ•`­CÇoŸ÷"ò æB]o/Bµô¬¸]HœViû+º_ztä{k»–Y8ú_O)ãûŽ§_—Ú†Wáyÿ¾+¬.È&?9ÆÖXa}{óèØ4^w.5?^„¨¾t¥Ë½ˆ5_?Pqœà¾v®GK¥ °âM›Ùú‚È(¤èCøá}Ù›â>… IDN¸­T"ßÁ/ª|ÃMÉÄ5DŠ¡Œõßúä<„èTe äa©#õ[Ê!»Xî–»‘—_—õìÜ…0hFVØ I€Kþ#“Z£ÁlpUp~.±[ œËuÊ[Ü8ˆðîòÝýªqçë×…[n·< þcp& »E>WÁ?ó£EÚÖà ™u5Ä·žÿõé¬-ŽÙ¾òö"§ªq öC%½+iŸÃ›‹ÏGBÑYÞÑœkêNfBêö»ØøX·|°ê7"èJÊçX%yòþèùùÿ,¯µÅ¿¡=ÕʦšxyÝqO±ßî6ªÀóÈ,.4/ÿߣ¯èlÆûžžÜxÎdˆÍ1ÈãÆè„™"¶jêÄÑU÷@pÔ¾ž < Èxdr¾a’›cMÒó7x6NcYØÕ5•”N¼6ÏÍ‹n#,¡TkT¡¤§OÚÖgü›úÀUqè giÚPÌHÆÃ)Æ7†ñ“2cŸqe½£iÏšÀ_ÚÇ!íHø(o¶ ˆ ×b-”Py{Ü(‡äÙW'V ~5^GWlµVUCO°pîéÌŒíŽy£;^£À¿-ß–ùÃ&¸^³ö­LÇÊ“Ç­4wO!àVÁO !{A0õfˆQL]Ƽͯþû;÷€IbR2yº.Ý,ê~ÍèÚ?¬#³ÊJshapes/data/dna.dat.rda0000644000176200001440000001541015076647713014470 0ustar liggesusers‹]›˜ceÕÇX`é°Ì̶)Éͤ'“äææÞ¼ÉÙ7“ÌR”âº"àŠˆôÞ¥HSŠ4é½Rô£ JïÑ‘O‘" íKæÿ»û=Ϸϳ›Irïû¾çœÿùŸÿ9w‹ÎRwõ¥«Ïš5kÅY³g¯0kÅ•ºÿ½b÷ŸfÍžµZ÷uÕe»ï0¶l‡}»ŸX»ûÓ6x¶ÚûcÍÜ©uŽ÷¹ÊèK%ÛH½Þ½ñ¿lm`ê’Gî:ÚÿªueÖÛyïb÷ÛøºOòÞÞm¿f›ÏësÁ½ÚGå³Ì‡÷œ²­Í~»¹lëÁkíh÷‡Ì‡÷Ú‘¡ÞmfÛÑ;v9ü“?%la£ »Ñw­·Žî_?Kûnò½Ü ½å,²¹}tÎcœSå« /úíþÛÚ_Z'?h{õü…ÿÛK¥î;Öž¬õµú|û½7º¸…Ÿ9 ;mõ½ÎŽ½å,°“'ôŽã°î÷j‹}ëTÖ{Ç>më³d·ÚA]«nú¬-_xëæo3bógôÕ—›Ëlâ­k$/{×wÓõM\ëöOîZkƒëmeZç™ùÆê=Ë-?‡¾kô½3·ÝÙÆoû“óÔ«ÛÛ±Õ´žÚZºž|ï8³¶~ªöa6‘øIõ©ž;ìeóoöÌ}u¾ýÛý»®h‡º«~æ½_ØþÞj·²Îßwêý±å˜ö•¹LçãîØ[FÍšÔÏ{kÃOÎéþ9׆ì:PÚš‹zËÛÇzE­§°“ö“þ¥ìààw£ß›qpÛÄÿ‚å/îìÿsùmbÖÌ;¼ïŒ#Ød÷ŸîÆmáüûGÝåmù±­ß¦so®¦8È^¢÷‹U{9ÐyV°‹ïhñž`'ÒZ=DçÜU¼t8שõûé#¯þôµ]b;e­«õgù=V~=¾ç«Ûw=Æš•{/›ØÚ¦§v7·åWºïÎÝÃæ~¯¸I<ÐýwáÅvdUÅUý™÷ºÞÍšýô¾ÿÅq…8J÷¼|NÅ­¢ï­wïvsm?þÿŠ|®6¬uÕn8gÍÙ=¿¿üúû®Þ%û·Ó¹$öëà¿íðŒ[,µÄEb/í»SÃ@~^.»˜Ãu]oEw±¯ûé©Km†¸qÀÁä½6ÿ"| é~ý£'­{vÏ ?´™/åW£²ÿÐnºßè†]7>ð÷¶°Tûó’3dÍŠ]w¾ú3ÛùWn]ùËèiºœýÕOѺÌåúœîVëÒÄ} û¬÷±›t¿BøVï ¬7­x *:3-?2ÄIp¥¾_}p&ÙÂ?ºÛ»ï|ëp½übÞ7Žëz¬u^TÜ—¸NæÇ䋧…;õ{• µßæçò7“‘½ªo —ÆÀõ,ù$±ž¾ŸüDñÎÕ>‚dG÷›ºovEå‰Ä‰Ê _ÔºG+ÏÈ8j6’Ÿ6±gö)á]árÙµ²¦òœ{˜Ö韣ë5çh½ã~ïǯXû[ùsÛ*n:{?Õ3àÿùCGþݾ[çÜzWþlw¾‡—+>ëg*n½ý…åïùm•“^wë?”Ý+iþóòãʵZw†syAû]ÜìÇîñ£t^Eìä#üð{Û¾ÕšÃÄKÌkÂÁàjÅAõ ánáWÝ·¹ÛŽN ÷¾a;Šïþ䇉í´þü"ûÕ™Øêä»e×p3ÎáᄹFøïõ`å«l ÿÏ| û9Çjý£×ë{Í{ÿÙÐ'Ïܺëû¹0Ç&_7œ?*.ó#Šçê·(/7×Îæñ»bVû®¬ªû¸¯êó>qØøPv?Hù×¾.?i¯,ÿm¿¢|Þùƒðmšøêl¤Ï·^Õ÷-x3¾Ömæi=ù¶ô–ð-ÿüìÞ—ÇCüûà-þgÞV> ÊÊë•­{{ˆM“obçjÿsÏè_Ÿ·D×sÈ;EüÑë›ó´­]/Y¬ójDyä~å³êü¤ðλ’‡æÒs ŸYÿ)ΤŸ¼Í’ªëjõëgˆ‘ ;:×p/#7CX­÷wáQÄãrë+Eû½YqÓd¿>|Å­ËîÙÛõ{ç ùÉà':ÿDÄË<ùµçë<ê7*^›;Ès‹”rïj½å›„ënQv©]ÄùlD¾8Pö¶Äc{žöÛƧÖSþœ†ßvŽMî(?°ûhŸãoÈM s«-ÐçÊÛʯ‹ð$ù/Öèàm<ª8hÀý÷t¿Ê ð?ÿýSv^ïZñ¿ÍuîÎR­sl˜|½P|Î_ >Ü ¼lA~>­›λÒVÉC…[´ÞÄ Âó!øß@¨u;ðÝR~öSå½*çRÿLŸ ww—˜tþÞ9òÿü9; ÌEüáá_|«¼"©©¸7ÄíÄšÊo­9:×öׯmpvŠ|4M^í\!<žÜF¼ÇÞ&\ÿ| ÿxü\ÞSöÈcçQΘ:'¸<¿ìÌÞʬ·ÖYSàïõUßþÊ'/«žŠï(þTä÷Õ£”çüíu}ƒŸ6ˆûàv]·º‡Î¥ˆß'^–ßpîQ€ßá™_)_W©[MZø‚GᑳƚÊsx<¶¶â;óˆp#NxRü©y§êˆ¿qÁ¹ÌKÊ󉃅ÃàÕèYÊŸù]Þšz­S?5>å/Ö9¹~yLë¨P—Ö¶68¯qìd×ç&9¿ö9ŠŸ©£„/Ó5ùAçháÁä°âÀÞ«|8¾‡Î¯~ìãÝ-¿+}A]Ô?ýLq?ÌkÞ`^—ß«*ÏWÀëôו¿Fà“ëËæñ½øSŠ×bZñPýìíGºÃ^â?ÅòŸzN<£z†øP‘zϹOø5x¬xcúÄòëߨsÊ® ­~CyÑ€ƒáÏ„×á!ÂçƤðÔ»Byz ?ÊP—ÅÁåQp¼ùŒø¤ÿê+xcžî'†ÿ z"®ä¿%\õú¯†º²¹Žì‘ Þ _(Ÿ¨øw_Õ¾+»6ÎSüŽ£‡Ø+•·&¿Ô¹µß™:E?O½$ÿ¼2ÉùÚý•ÇÉ«õ³…Óù¾<"¾˜ÇRÔoñgägÁ‹Ú§¡Îöá•£ti¾7Ò§×~t–yà‚CÝ4æ*DuxרËÿkÔ%òIŠS'ñÓp{}/hè¾ê4|ÏY]׆G$Ð]rä*õ»!¯4wAÀßóè6cœƒ ïó·Ïh¬¢ü0±²ÎÏrŽ“×Ê; Ä[¦ûõû© 'íÛ´ÎI£ëÙKÄŸÆÑåêð‘ZFzq ^Õ;Yô½øÇèÛ+Í«ú\°žüÆ](—'†8ß¹øwß)âƒÎwtcè$ÞúŠ×8o’º®‰òÓþ²‡û²ì˜‹t-xÉ0v˜ßNì¬}?’¿åXO•|ñÉæ-âwMxqƒºÙCÇ.m)N£oÅO×ÏIêÁ?¾§|ïªoéz÷Ðsò爇樗«)žÍÂ&vÏwÙ_?J¬ËôÐïËÎ xÑ8~kéÏLÂÚwÈ/¦.U3UÐú:ó”O&×¾Ø-©7Ò¹®_§Ë_—ý ?U>ÏþZ¼ÚA'©ƒß êEÿô³ÐásÄé }™>êî~tœÄw„›¥H()ÞkO ¯M[ï›*Ï—‰/¹Ôs9úb1ô‰AâhöNÐWûâ2·©¾WE'7ÔÓ!õcÝÆÀ—=ê 1p'E\G¼$¹DõXxâ+@Ÿ¨ WdÁÿø5ÂÙáÓÏIú-yøf½ÊŸ›ôrÄA¾1FÜ»·ë\p²ñ#ßy²µõÅ3ò§öÊËS+ïL->·Ñ%[ä3‹Î>¤×:¼¦†¿—Ñû²œKš>f¤+Ö£óû#z̾âWeòCŽ:r<€ÿ÷ß.ü…§•èƒxß‚—âïf{ð‡ú'àó.ý•ÌÞâ¡1ôßE¨^€ýòty%샟VŸÓ:Í¡²{ˆž’_ßn{Wé\ŠœOŠº'Žn’ü³ü;¤Þ ´_w>|~¿½@ù+ È£OTâ™æ*Åe3Ò¡è÷Ù¥D>q·SÝüNvi¢#Oo­U…w“øãr>y}-xF‡ûNÆ߶Žîý5úYÔ5ο<)ÜÊÂRø½“~ÕOU~‰ôCÿ=á~…ú1K¾^îÍãÜð_‡|4ö¤üÅ?ýú÷1èwþ[Šo—>Rv%Åíùyá£:ç…ô7øûñžkëóõœ9<êï*Ÿ5¿ÐÏU„/}Õ8—¦NuæÊS;há%Š‹=¹ò?:·4úÁyxsIR¿\áMõ"»9WqÒÜGü+ÏÊó¹rÄŸÐE‚*üáaáúzekݯ]Wê¬,œŸºQü ó¾Ößþ…î×:ýA‚› ß™ÝÄë}xS™z'{ õºk <®ƒ{=8€W6>fÑ«‡8̵%ô"ôÊ"|Õûîçï&»ô$ƒ‚ý^3Ô³qêå…¬cx“`Þ¡„þ“Cóð{ ©kÂH§ê¡[^¥©OâÔ-Iì’Gú€xV]j„ü88*ž“Ìè:øDõ ð ¾Þ ´ßü|ñÍúb =Âå:}À:ãõA+¥<ÖÞ]Ü™zQ~3E¿¾}’®ÛºS¸a÷Q¼L€>CÖŸ+.SÏfà7)ìG·­£|ÖØPûóÉ'åèþòë ù§Ÿþd?yáÿéÞùòKÿ÷è3×k݆~dàÉþ.út–×pwœXTŸ%ÀÙ1æ.ò)ñð¨Oe–Ñ·ˆxqi¶¢¯@9šÏÈF¸FŸ*•D¿ ”…³•ÍåG)ÖcCÑ< uXžyxl„GÍè}tå‚Ñ9•™»qÑyü»T'6à!ô=[ä6s ]”?§×RœuÞ¦ÿI>k-»Ûãäçãà‡ÁŸj7éç2:cžz7Eÿ.ÆœA<ß`^'ÀxP†¹‰AêÂ~êªtç$­¯ˆXåú>}8.ðÜG÷rÑA³ô[âèŒCÄ×"êº8ë,âç¹(/1dÐ9¢¾EõMÐc=úöEòL¿rà)p4üƒ¾Ì×kÄŸRôíGÎÑúÒ_IÐ'˽N¿6Ú/¼µ‰>%þòà@9¡÷«ß£ŸŠ]"¾3>Õr¿íŸŠ?v¶ßœ¦NêÜ)¿lÃ&g+Îì;ʳ»ÈŽ†þ\ífæ/Ž¦ï¤À‰ô¤;›—Ðïé,¯·àÍCÔ“ àñ}ÓúâÄu‘~S•¾¯Žb.–ÿøsÀü•‹îŸÛ:l(®ü´€õÆÉcü>Ç|^5ÊGô%BôÞ}ÐP7{¼_D§Ì¢_Æá—É¡O’÷‚1ôYòJ ?A_]õ—Ð+«Ï LÔ£îÌÐÉcÇ28\…×ùÔ øáyºµúäð‡1ñÏéiK‡ùöqŠ§s»LP?˜yô7©#+Ôçyâ/I|Ä™G¬Gù=3ØAçîbÿ<8cža>} hž-Ò1¢þ…Ë|O-Ò=Á³Þ®£^\$ûeÁéQæφðçòµó†Ö[B?Šú…Ux¸×CæBt`s¼ÎÑ#î‹Ô+©…ßó^iæ¦Bx|ÿªpž)øL bûŽÒ_‰òÀòyôÊ:% ?Ì¡w”˜ór?R~úÉMêÿ øo ;¶×t¨G¦¯Ó};WÂ/Xoëù—¥þ§¾5§£mA¾¸[ü9ÿ‚îŸD×qÀ‰zT—Ян*èøôÜ!xæ|æ`ú¹_œüY€—U©Ãjÿ"^fž »ÁÑ[é÷ÃøÃ|ôä|¿ÌüR†¾{ôý:?‡èE!~c¨{=ü­€Žš¾_xœ ÿ):²“ oß èV¸nG¢Ó$ø|žõFyÉP_…ð·tÄ#WÞ+/¬–˜—;W~ÚØL¸4ŽŸØ‡e×6úyçtå™iæ;è‡mæ_Z÷3s³ì6q˜üÈ0ïU£?P†×°OŠy8y¼ÎA£‚~Oÿ½b„'™¯ ÓþX¯ýà_} ‡ý±k>_c>ÑÌ}ðé˜ò‡{­ì‘yLuF‚ú#†}æGý2ü¸„îœeþ¦ ÞtÞº¶yƒpÏ`<ƒ'eÀ3‡þa’xÉ‹ºHšæ÷±#´îì+A¿(Oà±/ƒ¿‡ôåÒèkyü¨„®Yþøä±ýÕ‰½eÿ–ÕõڑΞŽüã\ÅYûLáÝ$óAö1ÅçÄÚÌ0·Í9—ÁñúBšzß¡/W'?4Ðíú‡옥o9B¾è[G¸ͳ9àHÔß÷¢¹tìˆç/¯ƒé/¹?Þ¥©ã£>Åuúqçà_¥ùâM9êÓêì>2WÐŒøЉÌ%|!;ŒÑÌ0‡±\ _†èþ[ä Î3IüŒü·ê‹EôËÏ2ß@\{è$¿h2•aþ2Ïü|¼táß>}¯FÄÑy[®ð¸Í|b‡yòi‡úsgݯÍÜèdEù¦5GuáDçIášG^ºBõT].E<Ä£¹gpØ0÷î¬ßWàýt¬ùv š‹¡O'ïÁ÷*¼ÄG÷3WËoÌ­²§þºðÿ4øîPïÇ~£xx˜>$ó¿EúÔ9æy¼ˆ÷°¿½!lIWŠú>ÐG2ø]œ9Ö$:Rø|²©ûTè禰c ¼XMp^9毫Oˆïæá›Ô9Î#î•ÿt™+ôàuÙ:h }£}œòb‡ù¹iú;¾ß^Cù©E¼Úw´Ÿ üÆPÕÀõusHÑWŽãuø~ƒ9†`}Õï•C椆Àï>ú }ð‡ù‘åó“Q$ÒÐñ ºcÀË|S þ’à9Ÿêý¨.D‡ƒ¿å˜Ï©2×h¾«<2ÇÂï¢çtn–¼TÝ”ùŠ¨…žÝŒpo‰öáÏsTèfì¿ṘÌùÌsTÐ 3ÌËƉ£…ï+Ž’ è+ºCô¼IsæoÈßΫLÞ%oð¦zËxcéû¶+ÌUo,|šzMŸïÜ,¼iŸ¨}·®P\ظòÄ8~oè?xÄm ¼(rx` œ¯ó¼Eƒ9>Ý·2©õgÀAp³¦¾s<º>sÕè¹Öa¢¾ë~ÌOòüƒ{³t tôü¸3Äœîó‰H?@OÉmM½¾kÖWñëæÓ<÷±¡îë1ŸP„ŸeÀ¼L2_¾( àå•#xþûÄà- £çÜÀ¯<Äãy4ó ÏS€ëêè<}Ï~è2è£ó6ð× êëq×ÞB¼¡ƒ§©Ó;Ô!mæˆ[ø‰µºî8s©†ýyØ»=GD˜ŸEzŒa¡ûÌßVà•êËEÄe”'ú±ƒ3$û©ç\æ|æi õj9@—q™wÈFº4uË0ú_ÿÎ<§ÃsÅ;ègÑç®2WdÐÿB昚藆z zN-ê·eèc8ðÖ$<1„_ûWÊ>eö™ÞDy;Fž[D\Œò¼A½Ù‹žƒ÷7© 3Ø·@ü—ÑI\æŠ}ú ðg~Þâ¾í%:·ÎAÊ?Óè/ôí6þ4IÜÚý™«ÿ™ç™¯Žæõ˜_Œúpiòcœyô:|¬±²ðƇï—ßÀàCC<ÇÓÏœs?uKœý˜­ò<¢5ùˆ¹FÃùshapes/data/cortical.rda0000644000176200001440000040562415076647713014771 0ustar liggesusersý7zXZi"Þ6!ÏXÌä ïÿ])TW"änRÊŸ’ÙTªµ&²†‹KQR”èiʶéüIÐ× %®ÝS ®.ýâ*rÏÖL).=R/‹…‚)OMý†vgÄß<”“1W°žO5H!ÑÑ[pþ,mŒ¯½ÞMè’#dŒµ ¢¼¸‘eßÝá_i«ËlÂÚþ9¬—y­lk”Ëq¶& D^8‡#:Fo‚½5”¢™K™¯l¹ÁÑ‚§ÿž~½°×K×0Õ¾“V÷(‹LE®åÛP¿Ÿšó]ߪÿq@R!oaŸoØÏ½Ø ´fŽkª¶n¾ šë?’YšŸ„C%ö[*Ö÷,7ç– ò¢ìÏ$“¢]¶¯(2':äºõ†áŒuJz3…¤¿9‚¥¥RzÓP…$\Éú7‘š-³‡C™–Ú´»¨¶ÿ•ëÛ™·ºgô o ôn®µ@/{ÇÿLï©ÀT¹ |Ö_Ï–øÐuÉ|¬qµf  ð¨!.»¸îeP˜ë£š²Vðc°[>Ù³ “²Zjk3HV6 4áW¬ŒZ0•›eAµ±Cq5¤:~¾6îópaÂ0Ñ]A,òFáRé40.q0TÅ,je×ïÖ›ãø˜ðà ‹ íxÎ |$ àδ¹»œD„ü³g|3é_÷XV%Ë.KÕ~´>#—µ.Ÿ}T]èÀmÌ€ôíà 3ÝÑ8uYÖ‰»ß{ey–CZB€Îd=X÷P9ÌÄ ’0è¿žª¦åæ& ÀJrId­uÔ^-nüêä•k–fð§\23RMö™€e]šÖ¥åˆòM\ M¡ð¥oJ>Þ ?t_þLm¨v<Ôl6ÓõÀôôQý«ñóù¦Œ ÄrRl¬ –õÄý`ròm½‚úg\'XxÄAÆ5|U(E™»b CܹHjŸ+¥[–;ø uD0¢î_T»ÀÚ›·wk¤%;lhß*pá9³0ì…A±¥iQJqTàÏ¡²x±‹¢3š½ØrûWõdèjJ³´Íf²Æéi›IkÌ?pÔT” û°Y•K‘i‡C"¶]›iL$ç?ƒ±g/-[4²ª‰~‚`* ˆq õ Ÿ·ƒ)È‹IcF{+§€B$،깋=vÍaðŽ±¤§G":ËΟ@ÓÍL¸…D»×%¥®~…ÿŠÂhÔ^ÍÛjOæ›qòWL›þV§häiÈÄ\¦Ò¸o¼­§o¥oEE‡kI…t„Õô?0žÿcdø$¿eƒ¹àrð³_x#ž›äÛÕIÁ¶àî“`ƒ¹-aÚ$[Íì¢Dºdð¶ÿ}¸P½›fð4Ñ.\N„OÇ­™‘³î#MRÃÕÃKvò2¯îLÙ}l`gˆ¥<íÆáO¶j²êèËê%÷ò߬Ùänj ’ÌÅ õbõS®¸e£1@¬oOÇY?O”{½:e__Hº#'= ¤µ7ãÜÃôxÒ;£ç«Ñ‚,•tù †%¢w¦/Šq¶L~Ó±vô4 Sðô{9ÿWÈ µO 4V~†R|XáiÛŸ¿zf&8 (ÂÀû¡„¼Cgpmi—wé‡_ãC;0NcpÖ´VHì]Á[)Þ)Ê´ùÜ¡D›2«¢°6š;v“´ Ñg„¯u<.ñÚõ ‹J €(WáWñh]=áÐ#À‘y߯†¡k¼Ç°Ùq÷ ð™½dTÅ &vè³Vˆ¸–[eR[± àqL¨I²ª4XóøöÔ VX5Œ&Ôh‹c}© [ÍAŒ{Ç•ví„<ŒŒw‡l1C³Ü³cÍ)ÃxÉjÃØ=Ÿ²UKk~.²AI_&JV7[Þº¯2}y~{P ƒšU*5±Ç—w°›¶’ÝHH æ‘2· ãTJðmé Ùõ¤DW&‰?ï5cÓí\hô¾ãÜXÝæù*,ý¥±Í/º¥ùÛ0Ë?®ð4U@Ž[|Ï€Ähé² š1íË)ñiGC6 ¼ñaŒËÝШ]¸éI‹µSŠìù¶™h È´Ñ eþÎq°áûÍÄtvò¥wŒ£:ÑľaIÉ8Ù•øëu$š?æžÇùȧî0uà‘àÀoÒwÒk;,[2&––š‚Üs™ð§Hw˜ÚRaë’éŸÍžy†+R“…z¤QxÂôfKBš_®;ËÊ]]n¹Æž=Kœ MÀÈVNÎkWá ` šävw˜÷y)µøwgÐú*ü åöp»õîÜV§ÐáëµòíÏ8>7þ;üÌo®=wÓYÎq_vìÃÊ(³ÒuüYÆÇÔغŽ¸½¶Œñãù+Ÿ%Îjî`Eœj,s²‹H¸úú)§17'cÚ;ÄÙ²®rY¤ÔNAPm™ŠG‘*,牪þJP®èò¨’TW¯9ö{¨I1ö¡kŽ:߸àf¢;—Ã' oêèb}wÓÏåeȽ5FæWhrì$ƒ™Ÿ­5y·]¼Ôè’Š¾T,c_WR_yÆýäÚ :±Ë,c;3(G b(îa 7Wå‰,D#Û3‚zG®¶Š ÄÈÉÙZ-1 B¼í%‘Sê•Ð mTK?Z´®"y=¬Ïн}€Ÿò‘8^}싽,—Râf$¨™oð_žÊ”j4ÿÁ¤/ŒW°å„Y5ý´W³ûû0?ÌŠ»F;@UAüîz¯@8#JÙЦ$‚s¦´~ÓS·£ SÅS\uÁ§ ÷?%ÝCc®k?_æɦ6«{®©sò‘e›çN&¿Ü«³âÈYß;ôazŠ ¼‹º¬W·ôä:•Jf¾PºN·ó¡ k¥ÂXDÐc¥]¯mÔ¡êv>bÚYx`KñŒÌ}±ŽµÜ;UŸ,¥Jñ õeß®òPI.«Ú;Y[›º8l"äüîB&dû.ž¥ØwŒÚ³ÌNj#åÌ/h–ø€#tªW±–ëØ_æµÞBG=bñ¸k¹7¥ÿÂøôÈ×lT2+JÑ(ü¤¿L CBo¨È.63àì/ƒ«.éŠË‚X+‹cä„‘¶q<Ü}yPŒ\;ÔÛWzïX’ÜD5¥#š‰Ž34‡PæpÝ®rúon<°èYüÀ{Ö¦Õ~¿fØÄÀ8?&SHÁÃ'›ß?û+Ä«¥P¯Ø ¦üaUb>ƒÄ^®˜$õ³mâä-ëYå˜Æ&š*8¸ÏHç®Oï¨0µP^®~̺P™†‰³s>tÞ2áµkå«I ´þÁ½­qÝÅÞžyTl§ôë€1ÄÑ;;–/)¹dBÝîò§m®®!é÷ý•WQoŠ„[¯Ì®j6®×Ø ¦ùÿÔ\TÍ`9)]®¡.EË…‹yÅܺöF­ð+8‰ ±€ò4NcÚ˜ñƒv$HðòñêÏÖ¡]Å\±‡1‰ÎšP†0œ3ÇØ4dLøz&/ÓÿHÉ-kÅ{Ù"}s¶ü½Œ6ûý†2²­cñ€ ôíÙe³.MÁÚ6"6ßóŠåZÆøFÁŒ~ÔÃáø\‚ow+,§²2ÕA`\A‚«œvùÃ[Ó>Ô‚6{Ð?†Ê‹#3/˜ÜŸÑ$’ýk׊MÊÄéÛ2»‹Ûli¾%ð)EÃCZæìft†Ü{º%wÆH¤Vþ®‘ù›£Õ° O=žuÖsós<‚ð‘¿Oàs;}ÎxÞE2)¤ Ø+ä½+YÉ9(QŸçŸ®+¦žå>ö=‚L ¶O'……~GÔ\PO¦âyŸcó¶vk#â&c™9q 1›óá)6ó’f:Ï«çMÊît½¢>¯þÙvЧ$ÌVêTtʘÆû®Ï¯¾©r~˜ÞäQ>Gú›ax¼ŽWŽ@‚ßÎg¸ÓJ%?”S«uÅeÑØ(õ™3jÉ!½ã,×A>¦¦®@™˜eNY\Ñ-&ùîû1®.”ÖQ±”~óÇڱͱÅeå ï‹u¢ø–”ƒ¡¼ºÁi`¡.# ¨’Óè¢\‰Nn§5‡Ñ X¤—SçQhFøø±—:Ó5ŽQ™-óÄTNÍ •Ñáï $À›´Ïðgstutg¸§äÍ.‘ÀÍ"ºÚo¢ëþ–è~<ï§Å4t?<´ÕÅReb ìN2|Ø­úÍI Í*¸àA•”Ýê7œ[}ó:R_Iã$²oh¤8gáøšÂ`þö%ìæ˜Û£0Ioó¦™ùA4ƒ†`›b9Ë5,h“FÍVLß½ôðÞ’èi«4…S¤ò•¤µ·³wª¹Ù…Ÿ£Ô\cI`ÃÊ?xIŽÓ\±H†qØD|f‡-@dhcjŠ½æ<Ü.í~¥ôjõ~õ–ùÔ‚B,POÿ„—2R†PPÕMÕ˜h"!#B=´&[Ï¡,]-“b† *…;’§f•3§mâú©y\Á Q]ŸJ¥Eûú¢šýÙL›ô­æÅ>-{ê®­TÉ›)*ó®@Sº±ýÕî1?ãíÿäî¨u·Ík q¿`! /oÌü¤g èÂb×ÑÇÆc½4sñ7i[èœö?ÑEŸ¸¤6°¯ØÍÝ¥$E9šJí£öÇ:I˜I»ò<û5< Þ_˜Ãs¢šÍ“Œbý' ¢5Ž*l=‘÷1g³î‡ŽU€d˜òñ­ØV˜Züº÷˜ŠÓU½*ãH3èf=#F=â7 =oÂ(d™»*Yî‹P¯ØDÖæÚ-ïí‘f#Í%¡s!dIbN×f«„‹8Ív$Cœsa„Î %©cg¼ÈžDÆ}òïe_Wèf¬Ê¹@ˆPÃåµÊÜqJÊš-G€Âòêˆd‘KX6Á䇳jÉ.–s]* ¹kÁg9at 'L´éÆíð=SGÄ_í$½ñk®²?x9L·jwÆÖ--wýÒyq b3ñ¼t!ÖÙŠ,nš ä©Yéâq-Ê„.ã ÐFÊ°û»+ ÉnzFʾQËYO±´©eù”Ä,õÀ3fmÔæÁžÖôôs '6p0Š˜ÿªDàz(^ÎR™+º«x²Y颂óçs9KM†wÐHîìÂ’¿åGÁ,õ w®Ddí -¯‚àxã§[y¦‰²Cp±ãè':ØÍð×-‚ ì7†¢çUgw <ÓñC3™-È s°¦9Db›X|gL,¡FåΗº¢j›>L©ÃÈïgj9ç'³…ªÌçyoMn̹Pþñr‹â“´/«çµ£(OI6áÿ-nĤq¸& ¸V§;7º‚qÔÅ(˜‡Ý*})/ÖEŸýxÚ8—ŽàÉSgg0%<à•xTø´œ{ éUü­s-Oå…6™¾ \Ò˜Ò i„Þ,ª2@0è´A4õz¢Îw½÷Ãý•Mp“Œübžâ7£% ¨‡lqBéàË\”®æG¤—òÑÛ½ªhÃOÄ[ÞÞëIæ6Ï‹‹Ã…PQÉaufFPo/^Å—<ž}BÈ *ƒyE-.ŒÄ© ´Yæ 9’@<Š{ݤTCáxñIS\¦ûl¾°É¢WD_¼¿.9·ë7‹ï„bÚ¹aüL¾M ùÈ…Ø9¨ìߪ$yä±£æ€ý–½-‰¿S MÃôißÀ Ý牾ljÈ«ÇEW‰¹ŒÏ\ꉢ…Â$ƒmF °ÛùÄ þŒŒŒ&mŸ9¸á>…í'IÇìê‚ʃ}\/&àΠÙâiq~z0Œ˜ÂÓ½%\æ]¬}…kÍ,qwÅAYM¸Bö7ÌŠ)&ü .}Å}¢±ipk^[¢ü¢e&dî½¾ÅæߎsõOJ–MnØ®mû´¢Ì]؉ßxˆY…Åncè}Ìÿ õW‡wžáôÄl¨/ñV<3—ñ‹3dÆ3v§Ûª%ß•û¥›ìOj™?o ¬¹ŸTÿ4(wmvI.Vƶz'_‘ @.ã–!×S8µæ^ëÁ>‘V&¦`t  ÃË= ‚¯ó 8dÌí¬;º^ý88åò(]Qp-¢9ÔT—ø"?^Ðün§%f^Xê,QÊó.ZÌ¥KžDò)ÿ²l‹œõëFNî!y{œe8êÓélß.yÎ|øg§WŸúFËÄÓØ…hÞ'(úú(†¢»— åÂ*KöŸ?Ô(¢šº¾÷ËÔ0zæøù®×" >Ó2ô¶)"㢚üÎ(˜zÂn°*CÅ¡*¾“{3¡ b’Ú]ø1Úi‘hGSfýa™¾ëZ{¨«âA’\ûù¬–A²Iï@£lÚ¼7ÄÕ¡ÚQ¹3ÍI¦Msl._#½¾îœ ¿[àÖȵ—›XzãYñ¦~¼OS’C˸ÝäîTƒ^ÛÉ…+?ÀÐk€·,UoDðQïÁ´—}CBô 6rƒú×ò^–¨QMöl[I¾pDùl­=· BpÝ”‰]lAÄo´ ÀW‚Ô˜ŠFd!_éqˆáÖ`±¨©íZΧ͈_èuñ2ÀBq<ÅtµèU6Xâ |€Vë{â0zZÆ°$šÛˆp{3›¥•a™é 84°ÉÚ°\LÂCÿÏáçRuÅn”©ŠÐ™ çpâèI@ðAPu$û7D"¹!È`ªÕwL•ñ–´;ùMLÅ2ô@#«”_2ì<äÒ5dT¶^®â·w®7t°¯ +üåüÕÀnãƒqw:0—iÂxÓ#¸V*uõ× ^½ƒ»¶nÑ}ÉR5Ó†-‡{•ð¼øW­¨YB>†VÑѳºAÑ[ñÆn›m¿ËT€1]겇ƒ#}Xž£L¬¼g©½_€°Oó–¬|Cj»{ÈÐ$؃£ç´ô`ä;*¨’ÙÂ_Dºâ= µLma@ƒM¢ý²áÁ!÷$(Eb°WÊ/cõß)‡hEüÝê•Ìn9¥Qôx¦dy\’ªä\^àÙFVtÏ2jÙGºðÕéc„çõу—Øü˜#]7¼À»ÎVmNËœÁUÃWI^Ý1~7ô@hðŒÁÆ; ¶’ µ%I„Ø®õñD ‡ µÍbbøÒ*ªîlaDÖ¬àñº~Z‘)BçòÃÃ3oŸZx š×Æ ÃµGPO?#Fö 2‹{¶çUj3Ú:âKµà›ˆLéî¤Ç¦ï”v_ó¨jV¸«þ:ͤ+¹2¨å}V =y[äúò5Iëmí£wÕ OFûï¡c÷ÔOêO¢L“â—½Ó%ÀªD¾º®N䌹,ßo )æ/XøÇM«õÒ˜~.H‡a[ŠwÑñ_ôôAiçeÂêlùKu™÷'DñÝÉO³^ÛÕÒ¬ bÝ òˆ0°ÇØ«ÊŽÑbM\R¡>¾ÿ`>±<ê ²•®àn÷¯Š;d~ŒÎ©Ú–2ù ¦5—éòz 9BS€SˆÒ¿)ëd ùTð"à_´iêGµ˜*ËÔ ½Gv sÌŠ9c·Ë)¶ã¶çôFŒ\ÛnkX ‘ÀSÛKÚ^Š?)€—ôf•6'†­¨¡A/)ב{AäIN² c¶(hvC¿4+ÄP.} BwÀȲ€ïJf+JÌ›ãpQëZáÌ™,àtÉ÷R<“i·õ‘%?ïDœò›j[9zÒ¢€Ñb­Ë³ìé_ÿJÀŒ)E¯übºÒ}[®4ßÉìò,šÌ2`3îI ºÿ'=V&ƒx˜·í`UœÑ°‚ôè‘ÖÙB¨57˵6©Z(=ƒ˜´eH®j[¶‘¿~,0#-)ÿA )‚êŽ)ùžVâ·òY_aò÷ŠÅ€®"ý2Bþ4‰¥é5wG³wy9Hê®hÕ&(/O\k7›%peÑÇ-y5Å2C»à·´ã¦È&“úsÖ3û’|ì€Áåª4¥u+kbPÊ—… þGrÔÒçóÝA%ÅÒv²\"#¶r5$9AD0³*ÝŠ¸‡Xˆ¬ò0N-‚Ѹ|.Zõ†6gòëùÀ £âû‘Ŭø©ÎÏ2'ŒšäÍfMWqÃýUÊrœÜ¶é“fäú‰Žxÿ~Dåf˜:…Ðz÷‹fÿ+UDK¨ùá—#Eù‹o'}nkPåÛFu¡IÈñ†šLÕJÇ65Gï'(ô\øQò7d¸ÆŠ(òÑ‘|pß:•=Õ)Èðž_]Â:‹Ê+†æÝ"+Ǥ?.Hz‰—CYÏÒOà¹lŽêa%•5Ô¾K 1‡´kì8¨à°¦F2Ñá½èW´€Y†:ÅÝÿ·žñÍa …© ö°µ¥¹—:6lnð†Z! 圱 Á˽š=ÒSÇLG¶Éãÿ0Éj ¡“«¿:°TŒûöl&X4"°U\ÁB5±eŪàrxÄû!»×xŽµ¥:“¥ì…¢»Œ•â@þóò¸0CÖÝDâBeÇ$SÂTœ<Õ2ö(ÛYÂbŠ–R;à·R9u‹÷?‚0ÓО‘ˆh{bpêf¨!Ôy,­Jr‘˜ÌƒH^§5Lå«… ØëžBwø”}~ü¡KhIÏö啧™D1k+«rÝ7Ô °@«tvœ3Ü‚ì“lÅv1Ô’Î?g’ýÎÄüìušú6ùUù:_²4)ïM,ÕsÊHÀ+n¯t+¬inΟќQM=œÇøl˜‹ë²_=(Pì[íýÃ$NÂË6sòd‰°Æäô +#ðë¹]‰]HáÅL©ÁØ»­ú…=Bó'ÉþYÔE€ÈF®–*S ›+Œ„1Mçë¥Ü9Ò–=u˜\kéï÷<ÜÖÚâ9¹àØ…ÂyŒöWwd[¤©£g*߯)kk¤jà^* ìcétþžOÚGfÝPJ”ëE™b‚(ÔÔe'¯‚§•+þ õÔíšWþ°çoiâáÓ=b[ m cWMKV7Çñ¦EV.ÚŸQŽ#(s^<Õ ¶µ‰MF„ø´4m±´ß—6ªw>3=¾F­M¡,÷·7tˆöÚXž5úÔÚiƒ;ÎK­—?OóŠxDêÕý.ÄÅ€Õj>“ÞiÛ›˜5´h°¹KÖ°ª8דü_Õ!~Š›tiÏ!ê´Ðþ;~±ì©qïS5Ãià}íKH"­MQßNc‰¤øõaÉ–¸&âȤ›”1¸=ºžFüp¨º""ÝFïWÍ2¼ƒÝƒ”*”ÞKØæTÞÀ™×™\op.ºæçRŧྱó逵ʣo2y¥ú¿A¹µo©BÁ‚•Ó’˜G¾ Éäñ0!0ÛÚ¸uN-*%õuò…P±FÞ=RC4¶ñ6ìlA‹Ò˜2ÏçX¿;3†éK(.ÃÎ\Yc¶É÷8 `xð‘™ø*ðÇïʦº¶m„*yzàu/ZˆÌU÷lÔÞé­ïêÕ*0P í.ÌîYRþléÈÁÈÉèpÆÒÓ#o%NڧФ˜^t¯S¬* tÉ=ð׶ê|ÿŠ,5£\²fQu}/gÙ¢x<%'íza£›ÑÿŽÊ~«)vw>F/`)ß[ç­ñ-Y§îøm+¿¡ðÎÓ '¾hÞ¢8·ïzrÛú2¾É¨B]³âËZ׎Y\aùÄ{¢æÙOð‹—ÐÊUó;eŠhÓ@RIƒ*ú$!;Â6‡5ëqÀûã) l³Gÿ>ù®¼ñípé!Ú5EQ@Ô³ç4~çooèÅŽV%‡gœËñÈK¨ªþS£ÌŽ;g-ö¼fl)â-$ý¸hû/çT]íŽÍu Óð÷RÈ‚$ÂèYE¹!5Ù«F«¼žn_ ÿá¥8}s ôùK\Ec­ý¥ cgÊOÍ7ý¤Æ…YE\Ñ'‡Â˜ôö?m.~†z¸ðHuí«ò¬± öD´N&%$Ú°ŒFrgHD.F¹\ˆþMŸýö «'éâN—jÒÇŸ ?lEpÕ0—zz|•<+V…¾ÎLw‰“»ê ÙXQ÷9Šš°–Õ>â´š‡Ô¨o»Y/¿‰]k{€;m´ñÐ B}uÆ3á› j ëlT ®O„+kÖß‚‰o53S§g3Þ+—Sü±5m£ûϹõ§nÚM¯U‪ÓJÒÖ(»›ùÔ"[ä®;võƒ4ðø¾CqlUuÓ'»–ôã%Ú1RHMb€Y°ïòCŒ¶€ÉøuíA!F±ø€>ü U²ïc¢ÄôSÔ5G”ÿâéà\õ¢ð~: 3 @tNxOŽ@w;\!ÚÞÝÔýjLW$Q'tÀ[¸¢fž²ð#þíx>I¹l²–13Çöò÷Xå¡b˜pÙ¯ˆfy»‘é$æ£e¤ø_–rwúúPþ&Ì ö¢øR»ÐíÍ—ò3SO݃ŒnÌäaüþU—ã£S¶\±89inIûøˆùšp†ãf3 tË¥E(§r8nl¡˜w߃U)çÌ|»ù­ ï7ºÙ«””,©ŸñäeEd»]z»ßˆ–'f`üÛõšÇlFÜ×üw¤U#·’ß~¿p|õÒš’…L¥ôä¼ Í…ÝqUn³úô  .âÏYƒ¼Ã×b²©1Å:& Ÿ+Ó‡œC@:ìWÜÊ3Ü•”¡&uE,pÈðnŠ>^Ì#ìÅöž²ʳ)êª{j`º}wjzÖr¿{›€e0þ:XKÙˆi‹:kõ*ÚŽû“j¢ŸÐ½’I„e³ÿtŠ$W4&Ãñ¢’àKsµžñÊÖ@—s¥…A'Í™¨èÀjöÉßÊGûÀh”³9¾ôÙ1ÕOèñhõ{Ž|Å$Õõ˜a j»ª¾W[ø3Ý#óF”iMÛÌ,Ð% }Ó6dæzÒï³;™¹¸gEn¼eç ðs^¬ž…ðûÜåLg2ö‡j§Ð£­Rq}u¨ë*˜–ôùRï—ΈU NÓg*Õž W2êgºp ³Ì—¯â¤¦ÓObÞÁ~òÑ)¹\øÜÂ7’>Pdzœ¶MÖ[;@ÓØÉ BbRiW|‘åЄn<ÂAºç@!–üágã’/ŠÏ¨…Œì¿`xZà*„™>Ðûd´;¹ á21#,­c À|>h’8î”IÄI;*ŠÏðk¿î#d®Ë>C2¶æa—µBº ~þÔš¼ ‰?º)ÔÊZé¨1‡e@Þ[wiï7D­†VòLXd=%AŸu>î9ÕaŸ†òmÁ¶ŒÕcÉMƒ7ÅÛ±u¸Œ}Çe•ó'4î8~ˆ¤‡¡HNí!tô!§¦T°C.H5Xt›‰~T_ÐQÛÐáñ VIvN8P™À¸B ôxËNž¿ˆÈumÁôhùRV»±7·8±ãE¤B²²±fÒç8Á¸züûR1WÔŽ #ÓØÃHS¶ø—s€…®M¿¥FðÛÀÚ0¢?Yï»›ÜÂÊ¢ÌkÈšäAâ}$¶¤Òµ—zþH²ÿH^ –Þ-TÒ"[pŠKO÷Oç9ྷŒáî8„MFC¥u{<Æ(Z:Ô†&ðy&5¶ÛF$:l®Ú5²¬È-['J*ø%òAøYÜ#;·žç#hë’^IósU=ó»J .²¤©Ê•RIì$ ¬¶ *—&9䳪ÝKØoß+ª|ýÈì7a¯}6›êùÆánˆ)lcmSììÐ0‰Èá, 9æçÉ|œMgtµÈÓ†¼L‡údB×¹æûèR11LD¦¨ˆªàä`a6âäæ?5XÚ@ƒ«’e®÷¢vc1-F•j,ÊØÃŽ»ªEŽI|¿tä;áxZüÖ—‰\AA«4°„­ïº¶$»5b¢'°x*g›Îs¨Í²™S[…i$ìÞ9GÒa¡`ß Ä—ûbÕ)‚C”5Þ u8xŠ‰è™“:'I£§øñYÆ>ÏÂHåÿ¨"þBÔÞK¦‚CŠ L&%Õd¯OØ=%q‹_:ÊÝ£Êä`cæ>ip)ÚÄR¿Ó™Gnæ˽bZØðÂc…}KlN5öÚ(B€m•ur* ¦§S®oƒŸÝSî^ctdY‹[¯׳®éGƒëÕÐ-4öÁ< dXw Òì‚Ùœ¯’„ç\¤cƒå¾ÖŠÙÒ¬ûM™[@?šþ¤ÛÒþ' §vNÞÊ—óû,ìúóÂΪ¹‚…ZƒÍ=«+.·æœ¾5>£´¬XÍtµý6ß2v‘V²7¼­Y[t`ìn¸×>ÃUÊdjäV(Ñã ¼›Y šYœöÈHîÃÎ[‘@Ü¢*ðPøˆÓ`GŽ°l„²èEA‹ ¬Q-YªËK+D8!*ø?‚$±©äßóNà­/Æò>»Gi¨,Òu¬cÜ;hnüZ\¸‘¥ˆKL#à™\IŸ<¾’L $¡˜Ž-{¢Lm#2Þ…‰â‘¸÷CY¥÷‘W¦Ut<>àÿÌ99jýÂñ3\x­&€zúâìßåãƒ1Ýeg¯|ð¬¡a¤ÇˆÍübS½„ÉôÀžƒv|‰»îì0—¥»˜ŠfÉJÍÊ/8|I}ëLœÈ0{\Ñ h€S\ü»ÃÏÖ£`ÃÑèζ²Îºö»A(³ýßBÞ5JA w£ ²+;F- `³9ù¦ã þ©Œ>”Ê¡P®[… F­“Z<97ÂI¬µ|»,’JJ5BP·*#X¾HƒÓðå½ÆÃy ‡IT˜’GÒC0ÍûÈ¥FÕ‚Õˆã±Uk‰úÇâ¿–!„[[ž·¡Âw&1²²Ae4WM Óf²G©i}> ZWx@{ô‡µ'ì1‰“ÿur€ø(̡߯ZëÌ ÷ˆáhls Š œ‡”›Zrsýg«Ù9o„_àNí§Å(N«4ª¬{ÒIŠ[µ «8=ý <êì Õð¥ýæ§þ›#åŽ[͉³%ñ²ó£/{äøfQMìHÀ»çÑfož(¯@¥&l¹jÍnœó¬åô¨ û:õ±¬ ß¿ˆ 8#ªÃ$N‘GX[s®í˜ýx*'þh^qí"Tà/òܱÐ>IRȈ³­zó¨)j }‹ÞPXV^T•pÇ0,ŒÄ¯áÕDæµhµé©lч-µÎ*¯vªÑØ'¡E¢ú2zÒ„‘Ÿ:?êHRþéTÛæÁª¸Ü@§ú“?íL°@7Õ™à옷]¨4ÅܺDTi6s·‡yù›ƒB•ˆ}÷ˆâƒÉפªK–T•Ðq©ÜÙ×^ë|äRwÂ⊩¥F³ÛÌpŠHÍ“¨X¥0MîÆ¥âFoæVàŒ„NhWL‰G¸òT¥l<€¶ám°U‡s§Ã¼ñÓè dåˆEŒ’ÚÁ55òBY·€/f(#ѧˉãîóXKíúQ–82÷®‘Të—虄,GB_·’IEìÞXsãœþd]Š÷ðñ&ﯔæ´ovXl-Æ€Ò¤¶S·ÖNwGsö¬ÅŒ×í¤ÆÓD`'²ýÕ|æÎïEqŒL8d¡4y•Å:iÝžèÊßA™˜k×…Šî<_Õÿ†Õ™{ªì\b8ø`3gÓ·‹‚ü'ºð=,M,5yïT—˜u`L0#¹AžÞlråM9JG}ŒVèVÑÀÜ„+ÍÃ{Õ!Í­ÐÈ ]:9ó¼œï‰È‹¤mMžÂ“Ý4joÊ¿QjäÂÞãX§–>ïYžöä5¾ô#ÀÑÖTs¦Ÿ›bGi›ºÇ± 9Ý=9\¿Ì7.¡Û´à‹šŽsÎjä¬Ç,”´~+å$¢û¼á¿ol˜CZo¯Yw5óC©‚{[©)\[–/|Ï;jîn¸þépÅh9·< :­†ÒN0jQl tqvÜ>Ö¬¨€º3GqÁ( ÚÔbešS‰\u’õB9Â¥Gµ¾‡Ê·– ¶çÂW5³_¢«6°°¦Çs`=ËêM ”8Š|ÈÛÇ=e^G´šr|îò²ùšØêI7‰ÜšVç}#`Ü¥ôî‚·Øn÷eX;ª=øüBRCñu„uÕRG·¶÷ßÍ+6¶û~Óe!¸ñ‘Þó5(¶¸Ò¾·x"‰¦ø^æGψSˆh€¬ äæƒ7”‘»S”/>0èJ¤hžÿqÿœ<4±û¤W{‰}‹›§¾‹쉴¢ï-¦,dó9Y œÝNÒžïí²æŠŸpOìØ–_vT‹Œñæc¥xyxB!xš'cïŸ`%9ÿŒÿVZÖŸ ¤#bï°Q d „ì[J]{D~­ ƒ¸Ž.yk f$ºì›nÈûLFµ#×l,}Så£säóÛ¶@—G–owÂÃÇ¢°™=°Cð'íõ¬@ššÊ°Ñ*­ØÓ¨™±Ù×¥ Zf– í݇7—˜´6–è5¶™ÚÐŒ°ÝjB–åF0+ôÁÎЦ߷@¤Ò=$…aEžl±(cáÐg«,†bè‘6 ˆ“…¥>ìçF¶9Êt¬Û¨¨QðÉS0&’fÂ0Î%pÔ¥¨ËÍœW†Tñ{ ­9êÝÔUy|&õ2š¯¤ñ320W´]®ulNÀE[‘·9{"ô¨ØÑ%‚©(ÏØB }K¬$¼p²Ã[¡f»¾±Ï+³µ5d5;ÄÙÿy%ÄB%€rMŒ0¥r¡—yV#NjÕÁ9U3¸˜‚“¦­(‡)–P€n¨O †§E2N4©PÒUáN°º¤ô¡ð,@7Mn&U9Ñ·éü]Ê!-&JNâX?|<¿u­ïèЯ6‘ÁÄ¿ÍÿÛì;ŽbX« ´­œ9ÎüǶV|p;ÚNæ~, âY–­ÙäøSf£¶YØH±è£!Ž¹dw°Vñò}x¥ÓMçpüù¾P9Gž¨n÷‹Pãeû€‹´3cVJñtËØhõŽ›& a¨^cäõ1ÕBðXÌF[¿Lcû':—ùnšZô?-5Q¹»?¡xâãÌ,uøW˜¸ÛÌœ¶ Êót‹g˜ éÏE ¼ê‰ƒ8Öw)\1k[ÛoÑÁ°Á­ÍzÍâ¥k îÃVœBàÌ3Áp%SóOÔÓÂø¼½Ê¾?X¼qR/µí~Ô5S†üf+îZ7-ªÐ_³H %T…üt¸CL•ÉÓM2%KPˆ•F¦³Sᇣpóœ^û)0¡…±¤½^· Òbnsmµ 1·Ú ¹èš=Æ©¿StñšX*ÏÕb(È3Ó˜š!¢¨ýþ‡+¦-º6iv¹Ç).?î¿Yê%ºoÀˆ[…^Y¹¸´áqËT°¤t¹,ášcÆkÄ<‡ÃŠÞäÝ1×€Ë\öÏF%ØVC]9*èwø„^âí\8aôï+Dÿ‹Âs8³Åð=à ³ÄÀÞaø%_=üWp´¤§FŽs+¾È7WŽöÑZ×PY¼@röDµUHXÀÍdVµÛ0³`å» ¾!ýxfÓ€í $èb×dÖ›DVÃËDæiÑÝœ¤cï VWø¿ÆíÚA†)ÓÇu­ÍÌi׃¾X–~ˆŒ\‘–Úñ´×Lå°¾®Êë¹Xñ²Ë1XîJÿ˜ª1Ö »ÈT CòN“×*®tÙe)jŸc¨»îéˆéaz{©+ÜΓ šu¹ÙÄZd»PmÿËßÅÍèºÝe=«q{£3ã(ìº4â•Ùu¦ Eô¡\Ô¾Õ5-rÒƳØAâ–j®µ\ÿÒ2ºX›Žáì[˜,¦äÒu‚Iòš ^’Žd¡c`7ÖÀÆAZ„§» àF,ôMB|ƒXÅñÕ„+›Ÿ'²ãgô~#Ÿ×…VÃë ;°gTMÚoH?˳Þ6•j HZW[M>Ÿõà­Óš©+Ežswº=§U®&F®ÜI„ý)®³fØÑw.P0q»ü;RèP)šÔ½‡4ÍIwŸö«Ò³Þ¾ÅLXÍ~LÝBCTtZ z°¸Ì{ÛGï‘ÈŠrØ“¡‘’້4³åÖaE* ÷\“‘iÀ“ݟǘG3¾?Ó¦b5æļ©Åé -‡¥óèú3 Ì§óÞêj1֫𧧊Új=ŠŒT-ëSptÏ¥SP§x8ÏðÅã뻄ãíÿkA\›=n6ž2”Ö;û£ä[üsŒ¸/ÒÝÙ°°ÌfHy(+ fY¥nÍÝ\²¸×r“z|ìæÐrtÈ!¢ùÐœªÌƒÚ•)«é*g·o`'NÏ„‰d’“¹\ƦâH‰–66àw š_Oÿt0>C“5 ßÕó¼0rò¦Ò3øçk®À’ÀM³îÔù˜A«G.QÅñ…BV0TÖ1ŒI4UzÐñÀ¬S¸¥÷ìÜ6^,›©A{·tb ¨Ä›gUÉ'XOF'µ€2ÚÙJô½Øãò ­È9\qk„Ù¹ÒLsþ‹ò)°vùoŒÔwO:*æb"¯cV˜«¯‚`% ëz²_K)(ÕáåÈѤCô™m…×7A2§ æsz™;9e·ÃÚÍ[Ò.5d1ÌŽ»1pP{Lª³ëø} Õx÷ð”¢ÎüÜçÀåÚ6dÜÖÂpÆÓxñäiapÐ1³ú±º[Mò9é©û¡'ÔŬŸZô¸¤ýÏŸæKô¤BåKÏùçèÓÄÇ8WJG÷Å‘ ÅËåå$‚Ek ° טUíÃNWšðý Ñ|;èê¿øÑJØæ³vsñ/ÿÏ}ÞûQrŒ6wuÀ0eæd K ¶bÉáKÍKð áHໞ†„$̽?ÙµžÎ\ŒÇ ){!”ÙÅô¥k˜âvÊGoÎ^f¢„ôtáW7 `a £$¦zâüÐu>]ñaî^§, ÍVÛMs4Ò‘`]½G€-ˆJÛ/l-ÊeMSÚ¯bdºDÓ†ÉK“ §V¢xw•>x^‹N{)Ë”•(Éšƒ¸L˜oƒ‘/hW´ê@„6s»dÑÃø«Ò|ø ÿhc NT®©"éæˤ.ŠJÂ÷…¯–M´òšw®[CÓ‹à* ø‰ãïr{äbz‡ä,TzÙâÑà“©¯jƹëͳwKu˜„ƒÖKŸsÎ#Ò>¹ð@õ¼aMY.b¯Pñ£“¹±%š3Áº¨bѽBÞV /¹2÷ÿUvó¥‘L›2¸ÔõpÝŸyZWù…`¨&0–(¢Òˆ¾›RºÖ-̳{!c76/RcÁbltÞ©EÚ-õúIÚ7VŠ9TêÎՎʨÈÍåt‹[ÇdwÝîßÎ@¶#X‰üøe“®ié€S*ãŒLEJ¸Ç†Lªy‡ÔÈ]ö‘VEdS‰¹ýñ´¬NË8Ål•“}°¨TÈéiê¨ ûqŠè»+ÆíëØUøŠ¬-3¢`z–¤~ „bË;fLÚÚéÒÇÚgÓí@8š*¥ÒÎÁrwoĆ êž'¹çhñw—yÐ 6WÊi5B»DÛÆ!Ýgeà3Yçþ.võÀ¦ØRKUÆ;’s‰rcX‡f¥Üýêñ¿ eì ~¯_º…\ìßÂÔ½K]:Ò†Îý$펟âÕyVÒÚàk7…v‹Û€Wúê¬@VÀêpÌ^¾Ö¶…o˘ҡm'ôÚÝ~bVd[Hæ9˜Ó,%·sƒáשҀL i䢛D²’¬fç(}89~n%v¸_($EUƒ×MB9 ­ñ†aª¡•Š˜œäž÷›P¹ƒóTëL©"ÛÍ Ÿêz Ð Xõžs« ¿³n‰42[Å£íÆn¤?a ÙÄ»<²|=vá¼Äcz6®XW#jEt“è’’'Ó‰!Š.Ü‘æýv| M³N ð 3J 7ow… Œ™AUjX2‰ÿŽ+yÅW«ŒD½vcr´—ÃèdùXY$/Wƒy Íö–gˆ¼ P›ÓO£µà]ŒîÍȺ›L8Š€¾Å`0'½ ¬$ªÕ»z…R“CÓ sv‚;Ñ­rá0>=U‹†Šb›tl[=Žˆ/±é¸ÚƸááI»hè|ö2Núã ÝbÿöúŽ«Ëútüù¼™iÁN‡á©ÅÔˆhÖóÁä&kAït™ñ—ìb6ªw¸z9º\Ýåþ*Ø ÅTßÆkc;vž/53Q€a²Ù>eæÕÈx¿°ÍÉ2úU[åÕJŠÈYÓ©«éâ 8Fó¶ÅÓ³«V¸eÉeÉœóöAùÍÁ ­¸0i•{”«´ö½ Ø ¡!£ÐïH†qñÍûZ›á•c>CƒÛ¸ÄŸ¤Ü }pÜVÄÿÁ&wðöá2­'Y’òœÓùéaº++A=oÜÒc¸Ø6êzœèÉæ¦Û:M·É³_¨ám{¤vtC`üUÆ>5Ñ&³¿Î=?'öÑ:BW~ÅákÌ·ÁõÅ!ÜC'"«¶nø3­®+7£æ϶~s²,Û‡¾oð‚Ô%Žœa¶2 €Ë]F +!N¼ðç̯„mŒ@½·hæÈ'Ëx!é57ůs,B,JÞÎìIä×ìÓÈÉ𪦷ٶŸDÌä'ÑbFê9Fõø¶÷ᆃͯv‰ªH‰ã“³.v m®r„•ù„D u¦¯ýe u¬PG8^ööÙ†•_Œ&í5‰Õf«Âu£"ùCùhRâÕ$4Õ¨öáÛõ¥ ¡@ èªÑD ¾™ZøpSÉ=ÁŸÂÎ}qÑqÕäó‹h$u¨P†Mo½àë»™b#é‘–ŽŒp;Ý(‡—§í9ÓÔvøÓ8å¦ïþøPl?mç–³i“[šŸVqäqG„ŒM#÷ŒÆ¬Ñ—túÌä"ô Óg%Gô»þ‰»«ö tÇÛøz-1Ï©’vГ¦'˵Àå] ’R+—ž‘Ñ>ˆ*”n ‡ÕFÌW‰â¤FBeê¤â4ûÔÿ`¯ÂWû:™¨Ì±¶Ã—4ª!N¹Šñëx&2“·¡“é¯"›–‹>µé¬ï¯=pÇ]ù™FZj„½Ð¡ïù*E(‘_WÙó·ƒ\¯éHéŽÂiãÂíç©+-?Âú&“´ ÍG/X¬/¦/ñê Qkì§+f¬…°y“mí\}Ý`0)ôÇÅü=o’Þ'õf^P"ìÒv–Œ—*ªÖ¯÷[Õ@6gpçÚƒWrºjà÷Gp¦ˆ·þÛc›“ž<…¬}S^Ø$.•6•ªW '6sNWø˱Ÿ C#¹„¨0&Ê"÷0Ì´¢Î¯´‡É‘¹Þó-AÐo²æŽšÏ“ˆD'mWÜUžýå€"1Rçáû Í'ÏÉ_ö÷®Èüšžà\ß4L¾ «-y¸AÔ¾uJ §â’ó 5ÇÀÊÂvÇky§e\wÛyW·\Ê6òÅÆÀ¤ü_¶º¥Ý2§³tWp6M£zê›æ÷Nß÷Œ±Õd6ãjšnªþÅ˱:è%ϵC§9×~pÐÞ¬JQšÂ ûš|þÅà­œˆD«ðÇä÷Eµ®¨6L¨P±N¿è+[aòÀ5´8‰^‹Ïæ s¯ï^xØyšÑæÅ@>«H² ¼@ |RYfJôy)ú+ÿ¿¸a BªÀ?MÝã{í; üfª[4Ð;yz:Ÿ0ÖgK¢)uÃ/ᆩ¦¾¸ý”¡D&&øe®H¹~Š˜Í’¦O¼Ì9©°È³ Ìm¬,ž['²~Œ`ëvµjQíý†½’2fʸ×ùm%of^c¹ÞS$À”)WÓ¾@¢mËY\qP]ÔÆƾùIܹ껩í¶× å¶f8‡ §QnW˜`É2ÌãmTÔC½hÑ1]Ö9ñ4Zh\³ô-%p¦³pCÛ)°qˆˆTK2—À%ãÃ3ljße¦Ý¥¬¤jÁRˆðš`¥tVŽúe'ðKèÍ“W‚ⶇ /r/ü=î@*.Ïf<¾Œš/Ið%ZvI÷m¾íÄëb?u²`÷7çÅeñˆE€Vò£I’å®…×ÝhÀ†yŠ‹¬;©ð&mà’ ª[±WêwòL£Ãœ=Ûˆy)€³Ýï¨8œóÛŒ ®t¤3ìjVa„¶Ňá„"¶9Š¡$0Bm„#Ù ¢?E*“=æÕKlܬ¾KOòé ÀÃtãø<ŸÒu (Ø6†€£ÐHh¨*ä¡Á¤laá#\ü‡HxÒvOiíªZbcÎå6§O]~>Àî9' ö,Xi¸-^ú²=vÂØ^¬EÌÖ?*XO¶ßU¶¼ñ§-¾A X½ü ýyÌxQâí«Œ~Q¸±zv,h T¾RÑʼnõZ‰,SG¢bdc{CÍ°oÝ-K®ÎáÃzõðµ5ǦEù‘Rcùö‚K‚]1Óyä $¶Z½óÁ:d{†ó`WË úYlÄ‘ZŠÂ»aˆ¾©¾Ôôa}>öì•êM²AŒIHy ›&+XOßéëè,^9yT1³ª n"ƒÛApíUO©.À³GýHÉ(Y]©0õ\\Ÿ|—‘¦QW"U„ i=”¬‰ rêm€Ö"T¬/Ògr©šI¢èL\®žcub´qéq…¹Ø7“úI Õ>Ÿá"æ†QÞ’>o퉠 2@ÃíH⚌ø!Á¸–ÔÙ`'ÙSàM3‹‹ŒŽ'¡vëyƒïc œ<-mÑ£Ùœm‹‚ê"%œ_*nûOS~èI·–nú&ˆ§Ú¸Eó‡ç3­ÇvïŹX—%VÀôÜ-#Eb,£¾·é#$?̳CÚ”<Õèՠ漄‹ûaÓ[ •½<Ô‘ÎFúòCc¥þUYÐú4×’£ÆÃlgw’ž!ñ}!4H£?^gÑ©,xEÛð¿)ŽÑ &›/U{ñ¥àˆ$¤ÀôH³0Ž2.ƒö$±Krç~벉‘®ñÐdYÔ÷Me{+>-ÖwH|uå£t½8Á“ K6+«Ç,d¶k[&ý–hµ@Å—™JT’D&sE<¦ $3rŸ×’ðÆڌѫ¼8X`ÊúÕsä S¢Ö±'º£Ì¿Ý°ÄJ#öH‡ÈÉúWíõLØ%7í5‰"ÅÃ'¹ßU² Ü'@ã<ž“ËòTZ]ëùf#æûž4X<£t(þšû¦ÛçÏáí¾‹v±Î9 1Ø2JöŽQ©a1Kl„´~ý§ïònņÁLË«KÐ’Ú ‡øÆë9»¯énx©ÊÂ=1 O£×˜a¿Ëm<‘„Zq\{¹!}Ür¶O’‚‰íˆ›fGOÕÀoXœÂÔÀçUœ±yˆw\¬!Å´&W"ògåêA:Œö »%¸ÑÓÉiwe•„.YW¢pHMÔ$Z/xòQÊj=ŸGrg‘6Nv <{—Ÿ„ÔAeÕ‚Ýc¢¹m DòéC(x8ª÷Ò¸*~Hˆä3ä€V„壟v\§ÍÖ—¦~n³ì˜Ì?>!nKñÕ`Å×}háL9dï:6WXf6EMámµTÀš}4©¸‘—nÓYCúštÒ#‹Â£¸Íã€Ô±:´`¯í0oäÄÞÄOQ÷5Χôv,z­¡t-';³{'a¨¯Yà×hs%`ÓV:³ÇÏÞ êCß9žE~Œ!K+ù”WV3û¦Æ>Š³¤d\[Ú‹%ü^4\=´s-R+P^øÀ“ŠJµýdV6eÅÓ­©)M¾/’¿Uó(æ•\øXäΉ[LÙì—F\âýûØò.1u”jßõ]3Y—AªŸP™¥ÙƒùoÛOºR—Rßx¡º†ÑM•ÿý!$hté·Zš×V\WhÛšÏÕ‹FǺ{%¨ÛqÉW‚¨4ÿ ®Obù¡ÜÁ(—¿HvûbB É _1…®×ø¾J*2SÏšîi—j–;Ë’óRÉBir ;é_XÎ,}‹ö‰™µž‘PiY2ÆÙÈg|Ûå%j2齶=‚©léP¬OIõÈ@C«¡R«ÝÏĪþ[xÝbv%ºÓUñüÑrz+B†‹»1g\ Vˆ4iß= ¡¯†sýnÙ´óò‹àµHHõ -$­³d\çv‰u»çÇ ½ì‘2~IŠ3A5=ÜM~O ¡n{ÿ\!yüj hlÈb3° V~›õƒwÖ!ÖSaŠèà^„3ðD–°IŽbN¸öÒø>j&‘‚¯vRñ5 d„wýaa‚pœXÍ8žsäGZtÍ} mz!êŸ=éõø·b‚oÎ=íý¿ÁC6æ¾é µ3hâFÞœ®øg(é~µà]‰_³&¼µæ…¯U–3¶u“áòôŽãBðå&”¬¼•(veŸ¨Áu½˜˜<Ä}‘J˜Z2›kJ?O äuÛ+%K3u.äZ,‰U0š“_þÁùW÷æµ J…2Ænê'«iÉk§>Ð,È©`îVW^RCƒ¸i}ßµe}²<«m…n ¦Lý Z¾ó©›Aïo^ ¼É‡—†[ ['–¼Ÿì7ö›zYãºI¦ØÍ»dD™Æt|…ô\yŽ¼DDá®} ñvʼ“ŠHUêJË¿“ž€‡2ójøôTûx!Ï`ŠII¢7ƒ;"¡Í¦²n¬c­‰‘CÝëÌï¹z» E  Éö¢‹ænùŽ(cA ïpœeF¦±¥‹„Óù°kÁ±Á(ëf<•ê\eµrÎui³’À)–ëÔsQ¯ øFÖ\fOHéì¤Ü^Yú–cSq\ëó¤ ÜYA}Ú{ß0Ž³—2æÇkHm¯ =X˜ô´àüpÃä®>š]%‹SKR|7ä Âûš[N s|ê_±¥Õéø©f ûx;ì ×¢üU/ÏÁ,`JèÕp¶¦©jÊPP<àÚ¤Y€²û{TÏKjÁV·^(«Lnd,Ù›L%áþï1Ú6‚I :þËrßüèÝeLƒà°pð®”sõ¥ÇN^ˆÃîqp›Ç{/¬½pé‡õWÆSñÕ+Ìá{uÂKûx#äñë€Á¥°ò€‡ ï9yLëœ~X&\ÜÖ—‚,ƒ×0úÊž¡æȳ˜É»ãdgL3µ¸žéªaŸ:c0Ýø‚_Ëk#Ý, ë.Ú:yàÜ0&RÛ¤8–qéºås™¢óî"t>¬¹*|’sȧ ¢À‘ŸÞ¹ÔcT'¾i¬“çG€ æì\®gß{Sƒò|øã­llÄ㨹Ab€Úl‚oE$^:àíðXØe›Äå–í^†&v;!}U]Ï©qã:4{´ /úã~½kVO±(¤eXYØ&à[ºKO÷üðQRSÚ}¶L²Lö±m]&”[*(ž"{ðP/ÄKIoör‹‰9ÏÂ(¥°jð#U¢n9¿G _WùoÕÓñ ¿‚Ço¦?•Eð¦óÐÍÜLt$_çNÌlM•7t¸õ½TcDÖƒ<§hfà\Ų ŸžŠ sÜ™=h Ü' AöÌÏŽÂbnkÑðK7²/¬Ã¬qqtT|Ð?@Í}?gV¦³lbw˜žÛµ‘¹ÿPØIÏU’8ÉS ð”ô_ßÖ;€LWxyRý½ e5BN˜¾Zuf-É(’ äOÈ'¥²—V¾"8ÁY¯H“ÀCg=6z)“xþÑƺ$A‹ìÍ´»¶¶SŽ(%C‰È ¦9…ŒL­´q-ŽÅ›ï‘—çiüþŽŸÉdJa#%ËÀ°(‘j¨ºÄËãnWVQ4³ÄYÒKà<þ€™;›3Q/Ž$œÇìú…i”6J4=á3]×¢ ¿ZZ¯-ÃäÍ#Ãí‘46 iß6m©X»Öš)[ÊlÎÞgY–hZòòu*úò͈{%’ÁFIÕDBî‡ÍeÑy&DL±è'$—-õVFµ±ÝQqÍ& %‚w³œ­Ì¢(]·§î¡ åv4„ʸC]™e>vj¢myxc©íÛu§DICÖEÈdI’ëhŽI¥v.xÇg›ì_MãèbX¡ÇX{©˜Ò†~J|ÁúÓ¥†ôŒ¡>º¯Óäãö¦I=âÅì@&±o½0dÄ]ôolUU9bkŠˆ t *cÑÀ‡¢–Sb’üÂ:òºeu j[´VHÜÿÕ#UG|Ù´.áx\J1ìú<-=|á¤KœÚñÒ—tÑt$çÈ0¬J^ÿl›a8^wª`Á°Å•$!’×A) 3†¼*¬Ì"~ç©è(‘f²¶ oÖ¾ŸbÎã?Èmýà2×á<éÂr Œ¡4í Âe ËY9Ãô*D·¾Ü†"ò=”ž\J³gz¸ªÄéF…EQn2ÃLõžªuQ °›Ìv¯ ¨ÿÒK=uveyZ+Z`Tuæ¯~µwÙÇ©ÇÏ ²Ü)UÄ\Gœ2xñfúžÎ Œ"ðÜk!9-‰PðÉgU¶%Y׆ËÙ-RM1!&¤…§>â%{"¾×GÛì´®ÊOa÷žA3>Áx'ǃRÆ<‰Ô´Á}uè,¶‘ùª˜µwÈeg ßQy/ü¤óÚ‡ù:Ÿ#–}³D’ÉÐÒe÷ŒÒkÉBtmÂz^?ü~ƒQPœœ ç ”rž* ¦ƒ'^QTÏìÝz©÷>ÙCÕГš¾‹Eüú±â‘iYW³³—¢ä›:`õ9FGîiëƒî ¥ÉæOþ÷™ˆ†æ§EÄ®è{;b¢ÀSMØX›Ù=tùèö7QÃt™³Öø 4Çv2ý ×5» `ȪC{ˆÝ b‚ã _±&@è }n`IyΣ–”$À¼(v¤ð°'eæ‚RÿÓ‡©øPb‘¤ cêÍs?‰´ÂÁ²[h|óc¨hì˜U½´ƒ?+cˆõ‰Â¨CüÅ6./E ÞŒîàÜÜUÄYµ8qÉ“9kN õ­? •ýj-bÊD‡Ñ0„xŽ%/ߪ5ÊÉÐúí]°Ÿï&ÓIrO¡!@:ßåìŸÒuyœK77F­¶ J"Þè;XÚ ‡P©½7<É%VU3 UÛ¤I‡KKÃe­¦)‚€OãÔig¯;:× Ëûj¯d­P_pZÅÁ¼Xjb+R¯á¸aà‡%Š¼Cõ;½Œp«9Ww"ľl=mS¼“¹û¾èÿ9èc_ è42E²¹mE+“S`K×E® ´3þ˾XÐñï‚ñdMº‹›Nòn³F §)·ÆUÎCµ¯£ûŽ Ž8Ù&ÆcÕ*x2GF0ˆ ðƒ¨»N¤Ô‡ŸoXÊÀÍ S+îb£Ã5³îx‹ÓdƒÆ;º…L?›‹ Xúñ&Y‰¤I „³[Ó à…ÜþSf[¹Ä"Å,]A¦H«#‰ý¹³}s©c pA­]ŠnôèüjM¹¢Ä=}U0ÅòÒѫ篩¾$üÔïy-@ÅГœƒ.­ = ¥ãa'-dÂkRò„k6(m™3ðû“«²”é1ü³È?hÞç¦ÐºYh­•›Å·‚SõOÍdb1ŽCÁ¢ì¡÷Yb5 “l²×䥮eú†ÚQœ¥;*}l³·|´^‚.Mµ“•p.ŽEÚ‘Ã|³€Øï䄹TLù3h^éx÷ M<“q˜úPÀè}<|¦’ÚˆA“….»eÊs0˜Î"³B°Š5Ê,¬G]BîÍdkÍTò½ëq͸¶b“¯)ÍǘÀ8‡e˜Ð˜‹Ðû@>7ܳuáÒ>®Ît:¹N‘¢èQ[6óuÔñpwÕhßÒ˜%kf] õWúÆ£\Íûh,t|d&<ЦBžy«sGßl{··åS? ´-æî=ƒ²Ë?‹¹"ÚC6d‰z¡}–›•›ÄÎ=ÄÛ`ÿÍܼ`ƽ­Ã@AÔWwE ²6"ùOBgcéÛ–ìâ—št‚|²Â^}Ë#á@8f²/p.Ôhd£”Ÿ¦ÓxÒ1¯^¤PX ”cÞÉ»€D81pè x;ݹõ¿ÒGqŒ]0:ìí:ãgfºê–;›ŸìôDX BùÜ?âT6-¥*@@[*Iç~S[ EŒ=ª@ð;‡Šü \G"ÎÒªÖJ;)Öw¸±é…ÚÁÚæ“¿!\þ–ý¨³îÉüÏâ¥À¬YŸ»ìn#jè:Ä#:vî¶ ïý£ó—½7Ô"ͼöƒÐüMÒåvF Âú!èX×¾Run. ü0½[}V_ÈR显Sñ¦xÍze‰lbÔQ^Æîð˺Sñ?ê<´Vs_+Sï— QU¬b¼™jv³Pì²\*Ô§æŽX ‹¼ë:R}q¤ã÷+€guTQ-@hVýXºGòŠŠÓd粘]Š[“w“Çå–Ðj ®9ƒ¼ðÞvý¶ó†Vb§|Ä'¾8I1Û;I™Ì8AgIêÖ3mgI®m_óæk!Ín¾ž°±{2ºƒ 3;äoNf¤žoà/0¢øEš¬ŠŸTJ;u{ÙòÈM‘ý ‹ Î:©ëáyL3üÓÕÖ6de˜ub¡c3 +/%òÎ* B5"Ó6‚‹g†XÖÕ»ºHE¡Q½x:y'üÄöVÃ`Œ\\•v­\ êÕ×Eç×tâĬ ƒûw.È{‡a«:®‹%‹7£JÍ&ø‰„€c &Zÿë¯*O>vyÎ,êöRõ`§˜üŸ7¯í½:›>Àhô¹0Vjl| –ç º'èWD‹s2p0PàCVãçj«c”µXu›¢çNÐùkÚ@Á¹÷-ƒ+€¨2ÑÝ}oMÏúàÚÞYŽ¶C‚vЕ s3<¢lS\rÃ@Â,yllB?Ð|x=FeX¾ ËF‘ªÂ¡x ³ð×óÊ…î·Çµa&8  ´d\W¨Xä´X³ž£#« U™êŠøÉþ±øÃ&C “æ/Ø•¿ÈV¡Èë_<%¯¢ŒìKÄðjtº0 dh4¼#ÂÄÃÃ…ˆßµ/Ç,!S6p²Ð@5Äu§‡€5Ù  ¿I2 ›*¯ÇNÊ–¶TzKƒècX¦/ªƒdwäâÇ¥‘ßÝD½p%‚¼øym¤ªÍh3ü“ô†]õyƒMæÓdÆazðv»ñt ?Î_˜~‡ÍÏÁÀCʱdõ¼$ï!«X‡:C>í¬‹õ+¦Pôà}[€«¨’èëƒ='„LÝ—ØCºÌñÖuÔÚ2Õâ*é=Ù‚ú·ÖÕ}ÿ&ëNŽ#ˆNÞáIú<©~s~?”b[Éá +²Áíª"Öm­Ÿ²±¼¢~úP””:z¯¹vžwù•ÁWq'©pyÀ‰ä·è®n—’‚9ŒÚ±KFؤ¨¢Ï:8sæ' "ÍsÛC'è‘wª[ÀØéSé‚ãMÿüBÈ T<°8Å4ýGe¿°ª ,ƒ’·$;õ³q{=dr,@ƒÅ ·‡Zk¯ õsNqÔ1ÖÃ>f ›“¾. Ä1rfMŽ‡S¨0¦‹B€™×È7FÅ4M²5`ÂéÎ,Yˆ³¡ç_˜]ZoQ"ú;õg܇Ø_V´íh7²à~JØ£QŽL°ïŠÐñÊ4œ;Ò®Rr烼ÑZ#‘zð´†]9æVeÞUW‚î\n D]]úc§Ë?÷4ø˜6¯Ç„Ž ß!Ç­Ï…9¼†ìes.ʬk1I@øø”Ñb"|.W[ˆY“ÄÜ’]—t…7ŠI§‰oS‘Á€c¤þj¢ƒežzˆœâ)UE4”®)™4ˆœ¢ÄÌu•þÕf£Ÿf¢Ë’ÏÍZ—Yó²„ñm=¨ô2—´œvYš“BŸ´D¾¯¢ÆqK°ðJœX¢þ’è¼å- ømÖ€‹–M'fÈ<ûh¡°ñ‹—¢š¢Ù¾×⟓2d‚2¥šÐÃàF¢þ X·S’‰›Å}e–rq° Ϯѡ–ÍžùpûºNß+DmG{ØljMä U9í}RËéFG»+DšLÄ5VW9:'XìÉ)cT àl$mŽÜX ,ü„&>·1T¨ƒýArD~4½IÜ— ¼ýÜ „Ÿ¶GzË”Fï¤<¿9Ü[áÆ©§¢~ï¸p­Ký~Ä(`*ÞiËb¶OË测˜ï ¶ÝÇÆ ö=òÍa'V¦· pi ã²ñ’vv#CÙ%–첸ؕËðýC3b€ Œ¼™_¸'~~Aµ÷µOÅÂè£$h£çYM9v2?èµXB6 )DÌöÉý!sá¹ 'σ‡’dSA¶Û#$7~&E*÷„N~ÐAü·è›l.û$ÌmÚÓ3)r¦SF™ªÁùÉ¡ìZj6KQ£cO2ðªTp'$VÒ½§ÃÇ÷Ñp+ðÛõ˜|ó:®š8"±†ß9[ç"µCKéR˜ä³N=»õ€ÿ ñ„ÖÄ¢W;ìí“Mç:¬‚|ç¢%£ƒér4e½•Ü›Häe£ …`íÀFÈ©£oâN|6üEÚŒj…áÓõ¬®GÞV¬™ 6šCΡ~X¥d|ÜñQ@š–Ùv.„pâ:Û5ÙZC”(9)-r[QÏ.´¡ì6_|þ°0áÄ5$õÖ,Uì•,M¶oè•›ð5[ê¡[Fåer×€.•¢e§M({\ T°’Ï ¹€Û’,¿¬fÄ7›î%ÏùE¶¶ë®eB‹ N¹VUQMÐ+±>kÝÜ “‰BðÀ{ErïPäçŒïšFÁ>*î¯hBÄ{4ú_N®˜ìxªwæ_¶–¡&Á”nñ¹\EG NžUbRbÈße7Q ©¥Hi’O³²TËØ<=$«Æ§§~¡S¢wùø*n—èo£?¨LçtˆàTÕ1Ƈçós|k§µôßÙE ˜j£a”òÃÒÚ%@7‘Q›Ñ%zbA†s™–¸Ý ðÆd±°j껿GXÇΨ™0“°o¾ÇéWnúpÔE‰:Î%¬8Òê`$ËÉ{tᇨþAj’SÑ „å©ä¸€¼¢–¶é:÷K"0vëþölÕ8ßýC vö¡è1M·–´˜”î˯|öäæ'•ì¤'ZÏ»i…í‚{³~¯³Ö vpî'€Ø螯¦“"šB9P£¹‚p ±ý)®æhèƇÿ—Ž$$.És<÷ð\¤Qô­“i.w@aý9Àb-oµ†q9kl±|‹e§ê‘¹a=f ¹ÉßV‹Ö•q»Àœ¢ø¢:g\–°œ¯:?òéºW†[ÂØgvØ<(.ìl¿öòQsÐÈ”0áòÖÁP¹cÏúÆýù£8lŸG3å’‹¸•,쀚-¶XÇ nÉNYüœA,.ïŠçû,ã່¼Dû>Ùš=D–„ˆ8‘ýÕá ÆÈ•LWù³ XIà€ô·d=ÖRñÀªÔ+®ÄíJîPæqÌò å1y.wRK­w¿ß ‡‡È+èX›MÙcY@o<¬íIüm„œŸ¥Œ¯ÛF´FÛ»Šs"»4<[#þÄÀ—±;^µÆòã$¿š©ÍŽc·§¹¡iµTµ]÷¥Ñ§¢‡_YG„à*2ï™F?ý‹óâï?*\Þ8OQq:ö6µ§ûÔ[ƒ|’,®›5ú•=æï|¢ççÜwy=¤×ž¶èG®`­0ñ‹ñ&üzBz@¤b¯ãÃßû2õxUñ ìµBþ£º¯åá­ËF­“(± 7äþ(€÷åD;®ÂªºVás˜º˜¼ŠxF-‹Ñت$e9‡«·o2G˜eÊõ&˜m¬ªAÇ s×׿<{ ÷ Â~Ù}ª¢ƒd7'ƒñ©’m²so)vÔ·¹”!µÚàSòÈvÀDp¾*?|ä™#Õ&À&µ7†}•"±gˆ“€k~½™>ÌÞªŽi 4àEΧA·µ©9î7Ïm»®ÃŒ›a¶¬|ô­Ž\Ü<£±?vM“ÔÙÜŸ6µHËVÖ$‹]Q¦ºyùº{>ó¼ˆËüSݤèu+!·'¤GŒk°.±ðˆäùÌÎ;!W†X£Ú`8×D}…Ù šJa»,HΛÅP~o×ܦ*ìp­CÀFP*óCAsº¯uÛø$&±ƒ”uˆxÙ=óañÓÇm~ÃãFÁO+HøèÍÌ{ô?à÷÷_äÚ÷d]=U:²«úöˆÕó9¸¨+µüÆ¢â/ÍÛŠAÞ©“x*Ö*mß›wœM$i Ñ]kö“ýp^@U[*Œ4¶)35D¬?AïÌ7€v "6hVøYœO¦£²Ê1bfѼÌÏÒ£ º­µ É<‡At“¢‰O~ 1tôf.j?·ÅHß–ªS¦ žúì_zM\‘OÞéH¿Ã L6s C±ÜŠo ùš*-ÌÅ$žkBBù–ŽÇH;9iìýví¾VZcµ©4åŒǵé„Ô#ƪÇ&ŠeŠ%ºI™=^ƒuAâIKÈ3ç£e;=è¤dai^ˆDÍÚ+,¯, üéµ9(<)p]&Î:¾(öLÛÄDJ³¶núÌGt6¶±çú {•r3rËqë ‹q&ðf |:Aɉcˆ¡fGdžë¹fÛgîS®|—™*Ò„ä³”ú“é&8Ì­ÖCò··²1  !4Ù«!Å$Ùcî˜zË ô~œhÃM±3¬ÿ$V v­ù´ §eTñ+2ô#”`Á„ú˜n¼Ý¹â ¡æŸqÏÓÄŒö2𠪙H utÃö…=]+ MØh†z3Ùt¿ÝqßÐaÀÌ;Ç6y–!ÙQ3¶×àfyMuHó\¾´¸)r\¨ßwã$qÄIüλGè6É¥š}fµŸ„㙣2Ž¢Mîªd9³4èYƒó KYP(HüDh=M…¢+6}™JPä/Q¼ÄG=ÚÄPÂtTõ[ZÏœÛþ·’`‰Ø7Ÿ¶­÷2u"Q@çéU— ú*•¦â v‡*‡iY¦ÌDeXBñÁNÄó¬î²È4/€Eî“pÿûÕÕög£y£!ݼë;æð–qg!„‹Ø}¨ã{¤gLµ$®—Œ‡$QæP؃b¨oVNÖCdÆ b%%‘üùf5ð $tÛu^€Ï`~»@Ýmè×4}I¬ºGJö&“yx®+rÇÔ‰ª*k­§îlÙq'üM˜Ùe=¡)'”“íxGû‹%-ôxŽK`ý7lÆEñ‘ˆÌÚ˜ÎR‰õìèÙGW!ACç¬1²~"Ûôg‘°BŒênqˆ•]˜bƒs’$jC¹ãÊø=&¯žT$‹âw5óÌ/½”I¢å¬É_©'•?"+eSš·ºÜñ×F&ìMºN#¤;Çwöö»˜ý%JEÅc»`ž1ŸΑR§Kö¢¥lؘÙÿ0^~oª/>Ÿ¥âã´9»Œ‘éö™ÌÃÔ–~#Ó@D¢ba#EOÖÅ 95%©Úùr;=\PJV±È™.`jéå6;98è7ây–ޜ¯Ä cá*ݸ)ì뱤ÕøÏù¶ Äw¦Z°jƒ/æ [yÜÒÇêø$­OÅ%Á¼EC•»œ õºŠì`:¬£S“þ¿¯÷#¥Ë=fâ¾¼É5»k¸Øz“~yÿƒe§pG_ÚÖÿ{ 4G]ódeR):ë _gãßÃÝ @&–Éi\ê;QïŠê&gÊ®kÊã©;“¥™P-ˆ|ˆŒ!ƲX 3"N­‡‚ßhÛ¶ÚŒ-ŠeDÿmÊ’ ŸxïPº¡7Í¢^»!B_}#x¯`av-,ý7¶R‰1'°åÆŽ a¢z0^¤©"7õßÅ›á­EÖ›I¶ã3\Ì?Íí¯»+-¾ýGa^tb¤jµŒÈ;BþzÐö}Ý#jÙ¾þœÐA‰ÀlÓ‡ïá}¢žf¦œy€ÞíY¤êââ[ÆüÃxž‘-ÙèsSüFÇÜòd‡^f´(Óc«ðµ#™pbœ„dvúŽ*ÒéãÁ“eIÃØ”×Îà™»±¥ºâŠt×"92÷T¬p¦Ž¬§ÿ.÷vaÑß,=O3³ÌÍìU¯"™­°¶v:¦tñ¿a¨Îö3¢ÏþàDZ=s»Íbr_ü§ö²›@¸©bÏÕ"#\&¸û(tô›Â(J;ëä!pù‹Ü2¨q໘Çø¸G{BéRwâ—D fúøÕ ÃT?tÌ^H´: (Ï@ÐmÒÉÜ}¿I/S?Ó‘öé€/u;ÉçL£Ü!ªÆþ^°½¯àƒ\@ÚVòy,FÌ“7êÖþ3Yþ&{Êl8ål"«HÛ(Èžý'ÁyÁœŵ«é«:ÁfT0Lq)(›å„÷ŽÚœÿ¬ñûg:Í}`„.‡¡ìÒ&Ê>JWž3Í’PyPOG‘ÁXVš°êf›úÆë«Ÿ=b…)QD¬Ài‹Ó§ÝýÛë”ÄožPaÄ–b{Û¡š\l;ŸHý\¥>háä ÃåæöÔÝ}e„‰4Á¢XLÞíA°XüD:¦„+'4Õt²«È†dC°9æŠæÐóü›£G®Õ×ôRî3µVd-\´¼MˆèÈ2ß'ü÷¸,#·`„{ Gí¤¯îRí¤½@èe‹‡îe“wúü`«àÙot\àá™ ´çÁÈhv5î`'š%£UþØ´6Ä+2X0ò1ýÙÙÍÖ)!ZWY‚›?زxXå¼VXc8Ê:î-ãÖ×kMbØEkêÏBæFÜÍN’¾wÌ6 LÁ«ÙgóíÜÓ®oÁ׶6]ÓéÑ@¶¬ z;´p‹öûTæO UŠ ô8bbûz "ÝKIœYÃð-r)HZghŸ/É´/Te—ä—bÅÀJ)”´~”Þ«QoÒ¬bÜÁ¾±UÔ>Û´{ÃÓ Þç6]†¼WÈêÃFƒ”sOÑ¢ž~M)ÿ¬dn\ÆP“{Åjæ·ìh˜ó‚»µ²(ž»¿~ÎþÉ~›?—ïˆo*&Ew÷ ^)aƒá"“’ðȪ¶‘Áã¬hn*àVô›d¼pÉØ™%ÿwDÙ÷Ç7àd†ÒÏõ;7*wïÚ[7EBâÅDȱÀ+‡.ð¸±^¿… D¢Œ{?+š‰«â ¾=Ó‡™ù¨.l#qÔ·ß]cx³4…˜@Î,†ÊTL¶xKæ+ªFùÓmˆU¹|]iþD §HI¹„gUB—p¹XIVd0˜éüÖ°² ”êæ‹Vô¼ÚIƒèÿ¬Šæ–Ëò30Í|Œ0×Ó' ˜•þ'jfo¸Oq•ÚM› ÊÝ(ÄV1‡^ÞL~˜ïÿ|@#ÅqLÇyVq†•øû/‘äzß/–k’ˆØLÆOxå´Ïî[ò.N¨Å­‚–‹ðæzî*l‡>‡*³™üþ*KL Q³ç0µcF0¿ý]æsÁ‘Ï€ÅâèÁÚœñ~³¡ch^¬#Û&ÓKŒužkwÀ¦Ìþ}cÑ·C³pâžl>?o×a¶¤¹aq½¼3›ôüú|Éæ+?Ú8N~Bn¥‚ù1¹y¾üÉ{ØFbW/u©¥Ú¸föLmñƒ¹óã¹Â†âÐäëöO[§Øe4)PƒV]÷±Å0ýc‹¬I7î>´é ¯Ú¾ŽSk[eØýeß ôþ>«èRóâ5¾ÞY¼Ó Ï÷krnÊ¥ˆæ¼µÙæ·“9xAr¸V-ßÇuI¸„C uë|†“¶'’ÒŸí 1ô|-ó9‰lªË„îs±O©ÅY§ªïä¦( KźìuÔóö{.ÜÓ­h’~BÒ ‘è2ð d&*o[lGd%:²Æ¸ûµƒ+èfò¸xÿƒª|&³ sðHP]åXh°28ä#—XjØ”?hò h†Y\Ý»â5Z“ ɧö½YùË AØÒÜV0Šs—š³YÀ¡w®>ÿEƱì¬J<Ý›¡Þ'¿öï2€°™èXøXŸâr »Ø5Q*ÆŠ)pÈš5¼83lyÙsÖ­$o3e¥S\e9ÚO˜/w0 ¤å€±ÐŽ™$ ±à„áÿuÅ"ñ$ŽüÚº°ÏˆðS±ùØÿ|_ªÙžb¿ÿÛr6ðûï¤B<]7›f"uk8ªw,ÜN‰G"op¤?<—×±s˜°‘PK¬P§^%¼š ÷•Ìã‰# ðÝU¯a‚›iÖØy ËÅPp¼QM„»Öl£—«ô>ÖÍW·èòbŠtî?Ä´äGíài†dø~>J¶¼–³"™0Í÷!?–+ÍýŽ¢HÀGkÜsçñ­íí±E:~þéÒ¢Ó+fÙ×7ûŸ%}ÙêH[ünÍÜ7òBúláÃ&”b?ƒßá;`]Ÿ]±6ï»^d«ý`„[ªý ²(é5)àŒÿvTN% Ëûˆ5ÛQKæ!©²hðy¼ÿ >{ì Ý2Þ;"eôí¯‰À4á gƒµ›n:éŠãÍ´´ (¹tw·—W€73¾"‚·bh<ùlTÒŒPÊÒÀL]°cZ³ÿ¦&ꡆ |AjÐë«ÄÅb|¬ÃìÐj_Ù€«†JEñ@˜9«¥éLÛ¿Gr¯‡†žïßkÆ[°ÆF¬ð öùÖû „,ÚˆIzr–—)ygÁZhOgÚ_²Ên{+Q‹°žOpð0îÆAhM3‘C ˼žà«T8ŸZTÔX?fœú%)Ÿ&X±[ž9ÂBü1@n«!Q`- —Õ–iÂåŸ@à zB³YÑ*Œþ8U݈UÃÌ“Ž/‡—Œ2âø3›;Ó˜Â,ˆé°0äx«|¹)pWWBÊPs*€‘Úu1hnðéÒ’Y2؆ݯϲ£:sUœýî&Ü×…ŽÆGxI‚Ûk S¨Ì+@;¹å ,nàrªøÉÎt½e c‡k¥„›$û¢hjËêð¢÷Aº«úßÔ¼iáKUÃ;ë…00ý4U&x=óï€ï³TU>"­eþ³ka²‡ì·Ô±Êâ?É[#q=d:¾1à¿wL’¾€zÖ[÷î#e–ð 穽DýÀ:¯ª²WÔ>&™C«hYÌ<ñ¯¿‚/Q3"UÚjæò XzÉ-²Œõ5p› y©€¨2øÍ8“*,tÛÊí¤Ðé=¯ÝúÿçÀ¶†yÜ™J*dP /ÐLíBN–&¶ú×0ZM,Cüd¦ñÅ‘w¢Æòï'·¼ÍW›,ëŽ51 DÚK˜hÜÈeQD¨ÚdÂ#§ùÂEÎM»Xb’Br}$«”VSzëë¢5­VF¼zÒcg—Q¦"äÍôG×Ol$ÑįŒK70aäŠ^ºkè5êY’M>æk‡.ŒdZÖË ºÉ”˹ÚZhEi ìÒÁGÌ3m"°£AzÙ\U±æ[Ø£»¿¸Itë׌ä+v, ¡óêcè¼ñž\·ÍEF=ÿshEØ¢ùd9ˆÒµªp¸Íƒ¦=uÈc¥0& ì¾ÀX’°ÏÆ-ZÇ6= í¤tRÔÒ?õ%ÝĤA@Ɔ™æA²ROÎu`@'+c›Çñ‹ –0Þ3hÀ©0\‘åP!â…q:-…úЭþEç0®ì³èF<:Õ3m'QQ¾ûÒ"È´RÆî"ì?9b€dο¹à4_ÉÞì¼n—QDÎõ7Í`¶DÆ~þMSx>šäíbžr.ãnßlpöÍ’‘£œe¢ðäô©ì bakZ>ŸIÔÃÑzYÿÕpP‰mÜkFÔÃÐ+„7–ƈ¥«Çßú@%˦ÍJ¹IKÖC°Ú6n‘Û,H‡jÞ²÷éÃð ㋇š„qü€15c°¯+ ?y/Þ?D)W–*árƒZå‚ü íì‚ܘ[{²j17yN{¿LF4D îꔵñÒÕnÜ´ AI 5ÈåÖ;&Á¶±&ŽŒjP•l,†dô‘óšÒ®çÜG'td­½KtâY{„,ù;)¯?’?7æ §5e¯ƒ8/ª—ßyø¹¸Lê5ç +=š£ÆÕÐ çÌÖûØɨvEæÀ¤˜i{¶P Üréso0ÚÂâ‰\¡ Ñ™i𡕇˜³P `ÿ¦ÿðPµÿ…—B}lNaUj°C™CàÜÔ /‡½6S¾A!abÁ[&m°§´•oZü#¶(þ”@ª¶íÇOÙäD›H½ý{D ЫXÚ„R>²‘ª0áD:m6Çy†_[lSBË»ÁèœCÜèåÂß]‰íÓH R˜q˜¬ù¨ö±£e€‚ÁL‡‘òYyåisÃ"Ó"{fññ´o´i2ÀzX!âS¸G:iÃ9œˆQ¼0ø^°»G9Fˆ®_•,øÐh¬+Âæ¯h±¨ƒ iîåkñ6`°¯_âÿ9KâÀ˜}ÂŽÉß·‹ÒÀ3í 27@Æ ¥*Vfôdÿer©)9ªW’ÏAø|ÃL.œÌpXf™3D$Ÿ¬x»£|ötö#Z=¾#\ot`£'ò‹¯áÖ:¬Mà(£Òq¬ þ'õ’‹¡é ›çÉ!Bˆ!ÎÖ,ÃúÔµo4ç=„Tœò|ß·³¶âþ½ì3«!W Üp—*ü9G‘8à`·—›^)Ì{Åë—w¤Ž öóvøG±ö*^•»ÈbüÄ_úŒŠª†1'R;”yCÝn¶,¤‰X‡‚`òŸ ×.~ŒSüŠ3­ÛËeµï?tÖÓb±²?ééÎ}!¬Õ£“ïh %ðœ£I|ä"J±Û¸Qt1ÐBß>¬hdãÜúeî¶JU©Î¦Ž•/áÞFl¨Îr›Kd˜äÔ$àþìÓü‹©ª;?N*“å¶ð¡ªˆ»`îN™02ñ )ôIÃT›ƒW?qeIRš5©JΪdû5™Þ¤IY¾Þïñ,ÇV"†+}èçâÛ¿HìgÕ†ÊçËM3ÑZq=ÒpIrÆB‡Ô®’",çY«HFPh§å‰7È]ÙÞŽ¡Ô® ȶlA&ß|9&Åì©æL Ep‰¥€…T¾{¢ñ§ ,)(£µ‰2ÙË7Û½a‹Û‘d¾ùºny%úSÑãi@,ç}KAÔ Âé?'2#Ï„_ý|¥ƒ"rU]`]c«½­œ[û÷»é±j–¬¯BHü 3zçþù>À*ÛBÎ ·¦ö±âš ÌC‰'ëæ› Ò¡Iå¦nÍÂ'¯ÏÚ )÷˜ô™¹˜» ó"p€°¸ qÀ–¢ä6¼òb¶ÁÜõ¤ëŸ }•ÇíÓEðŽÜäI-—mPøäfþ –ÅT ö•Í½ó• ¡šr?¶ ¿ÿ\Q®lÏy¬GÈDƒÁ]¼Ì…ôyûœ– î-ÅË÷¾¤º'Ëzä"æe•vÓkoóZËpá‡a\z?p!E(Kñ2w“¨…·¬”q‚ðÉÞ3ï(’Èp*ã˜K¿Ÿi¨ë>Ïï¿œ$KÆB»åì$DËmBå ¸"›–…ŠÂ*/¾bu˜œ¶ÂÄu4Òí†ôf LéÏEód³¹Ù¢Æçð÷˜˜ß}úÏ:Ë”ý=³µ \™ºº¿ÃhìVZstAÍbCÇ ÷ëL³àóŸ fŒ$ ù LþËÑúÚìØ4vA ‹¬]a¤ErÌÊ’¹WG–±‚ýúƒzåm΢ԕ[ë].&µE¥NÙe®ÃÇÔKÉÛÈ·ß­X®Õk› òÂHA°sèrGˆ£Dž zS÷àŠKŸ«º[³Órj»­ØÙn"î?´2s„šr#ÏÉIM™Ò^+ ®ý І#Sd4·±ùÐ%<…°ï Æz ¶e—DGõ%K²Æ©º‚öL ryíÓ·ìŒæ–]y]ÊgÖUAoá&ª¼(즽/Tæ™Ú”–¸<;cÈó• º¥knóêkŸ†€S‰@­ÍVÁ*O1chV»W–§ ™wXʈϔ2›K…æûú÷aýi&?•Œ¦ï†¤‚—¹«²5ݧ ÛÄìϦº†5`¦« µÓŸØM\¹5¢þE€¡Gë]¼;y!ù-¾g€z5¾¡wüÈa-\¨¡d^¿Ïµ ¼@|¬mÊ]éþ±ISÎSl "ÃìlÎ%¶o÷ž€3¾†N²v0 ŒÄ«!Iõ5x¼Ífñ!œÿ¶×ø»¹]ÚÉ_¶L[hjÝW6»{æâ$_£ƒ‚Ýé[Ù$ϵax²Z0 o°Ä¨rjù&XYyG¾ö(<¡åØï–„XÇb)v¢¶ù2'0´ßQóÒÇå6ôhF³uû”aUŸMÆê{÷Œû8(±Êàñ—Üí¾¹t2š¸–Í‚RHçå)hA­øA‹*p±êzu™½,&\âÊöùSÇ2Fžêo­çVc‰©”£<™ßQÐÔ3…çŸçdU9TcWý?%‰§äq@%DÊñþ”Ì}îw‹Ë%þ¶ºž8QTå=ó"‰v›PÎépc½º]úƒ?O³ÁU™ÚK»úˆ(¼š”VPಆ´[¬¹3ž¹œéúZuCÙ ÁýŸã·ÁÎq_'ÖØ?Ð ·ÿ;JäŽi©‹s6%r».ÀR+hÀš?I0ýÓ èü!Óå øðå9Üith ´Hò䤔®P*zj Û"dl#v~˯b­èµð¶*Ï‚²ï^¿WɶëßòG7êqÊN Ê LQ¹QŽ¤*ƒÂ¸1¢myo›£¬É‰þ7¯Ô•[ûY¼]È.ªgda1p~vô‰PËU:h…]9ŒÝ å»ÂÏ'ÂØh–lè•)Ñ5֬Ƞqûº?FŒì´Øý#Óv¤-n¹E—àpH)•œVl½6U·eÊÀ«q¤IÕgmøËeŠhò›Ó݃ÆV:HÈã'Ó¡ß@e€zíw·xè-AW—DzcuÁžášWâ\.mÜWGË)Ok<ä½hªoôVHà¸÷iï¬|ûa:WÒžõšãá"öâ ÎÅ:žR¬ J´!ñhÓƆ¹·/Lv«EÕ£;ᆠí@3o&Š‹ú.äSFîß‹œT6=èTFÖU”Úi (zRëejjí³Ñº—Ç/>$å;ÓNbÊú­òóÙ&AÇ +œãÅ^…tå›"ÇW¹vû½q•GÜL®óa»ïMå…‹nÀMâ©°ô,deÇdœûØÈÌ\ må[r;Ìd1QyÕøî”&›vÿ(Ç6c>áëcaßµÖ >u¬EÝŠÊÇÞ7–e¦ÈŽäò'Éá#¨¨w춱lÜ)@ø¸Á›§&ôàaçK~>óvŒô7Ô9ª=Ê´ ––‡¨2ÃZÄÞʲ"ófé’ª. Pú…pvêb¤y;Û-£¤úeRö²QöiNhKë]ê…I‰o_¯œŸÝF»…ß ¥ÐÈÈÞÎÖRëªúÃ,Ï'û©Ìþ+«(ÐÔ ¼Düˆÿs¯Â,${ZŠG—5 ñ‚¾Öàç…JH¶ò.Ý{cqíBV)¹å¡Ø²]V‘L×yI2÷„ÏJ€Ûh·®}Ö†lóW¥èÌÆlî+ƒ“gLi7È;…Ÿøø¿—KåÍíUòBú1nm6ÃVØ{+€g¦W.âr¨¦½G—–WÖ|P736XzqSªé½Sµ†û‚ûš8BaïÎbŽÈn¢DÈÓâôw}¼’ÅÕñÆè}:?pŠÜmù;Œcd Àò\ èÞ¨ŸçGK Äì58ûÂ6Òjÿe„1R–»ðÛ:Í sRx YøCÚÔTE_‹2þÝ=Ë…ã(F8…œÃrÚýp¾/Œ£©_°™È˜ö±ëCã |$×™Q=q|À ZõWÔsòìm4Y…ï–"ÇÚid¿¬:™Ûmш‘¯M‡±¤³ï±"\¹ |u³Œ1°kaÜŸþMù4‘éú‡'ë gK›Î"daßo5šcÒaÀOýô¹ibéò“xº³~eù¿%0ܵڶ}.èŸVg†s“­5ðÕ Ææê?la½çU””ÔÂÂy]~g–î2ô’ÝÎvvÿï575‰BêÌqçù´Ï鯷G¬©ý[«Ž”%¦(ý1#…øòæÐdÉ©ã´¡ Þgs4¯¼È/܈Mu¥¹_Y”DMœë¿÷üÑ$Ï)öˆÙZO?Z'U3ô^Ž¢ÿ×GP5ݧ4( dÞOÈ”Z¨)‡Ï†sÆ ³ŠÌ«eÄ>Xæh¬î<¼”mÄžà¦ùü"¦‰Äý#î출]öŸÒî§<…&þ)ßÆjiM©ª‚&Q0ç@lÈÊ,0”éS'xý“ÞülB˜xf[õó 3vpe©Ð'É¿‹péã÷9ò">þ¿ß÷é%eÙ+dTµäæž7E|óa•ŽŠ`Ú¶jgJ4|¨ú“µâë¥?EYÏÁô¾P:8›oKVÀ£Ù)B³ùñ™ÿ¡0wÏ¡ÔsK4/Z-kg~°0wÒÎ| ½QR´¶“Cõ|?b'ß X™ªÒ\ˆe1g©Ó3ÉXyª…$«H\Ý^wÖSf ’¨ÝìÇ>!ñƒ*µf¢‰òÙ7B*Ë‘vj®¤OÌ Š×ßÞÜ’‰Õ©½Á÷ÂCûŸ­Ýh¼9y£Zë´Ä™åbq݆^ª„§l–l'Q„¥‘#>m±PE·G^Ww㻫r÷ÁáÞF=,Ü(­Èåù#)ÓêD;~ÜÍÅçòùIm 4¥9®Ð%õ£¡D¥Tìšk4ßʾûñ&ZvDÜC4È£Ûña‹“´K'òU†äj•uœå#²ô4²ã¢M»ÿ:¤1 ÔBy6²^[,§%!Ò5NB>gŠÁ\Ï««û9á!ì&&‘~ŽyªN˜õw}Vº1q®ÓÕsÇÊù–Ù26;¦˜ž»¡ü™]ƒ@2°ÑB1ßÃïXœVÅU®‰i,þù;c«‡¶=W2?…½?Ôƶ»®kWÒWQ×iêï3ÏjCïd¬šÕMÒ#¿ñ#)ÂÌÊ1ÎÓœ©ßú9:$áO]sD IÉXLèuú(XÈJ ÀÙ+@`ä"rà\µ¢Ö0BDâ,º<ûW,9^u™U ʼ†{áø†3åP r¦cQúŒÁð€[qn€c¿!zá¶ù‰­|¨no×#>z$o(»z+“Œ¿—|4·ŠÒ'U.ù×Ñ1_é 8áÖt-lP0ÔƒòÝa²çŠw:›º=ÿQºggœÅ§AªÆ ÇçW´Fæ™å ‰"sG‹‹æUÌE,¬ƒDfÆ%¶µ½ØbÚJ>ïÅÜ(“;«7Šžn¦ª3×yc8 ÂU¨ô&§Ì¾Éœ¤l eM}O]*œ­¦YøH⿽JrÇø8?ÿBHÄ& ))º^û··¶®ãµ`#S¦â[p‡x½ô"Fûj›”;Uv§‡ü@æFB Ÿd*hY|žŽ&ï‹L#µƒ—mh„$8®òéR±e™mJP\òåk$0ʹK´ê®Î@®#!ðöÙ ä?VyÈ{~ß×üØjpP "‹mjíùäˆr{óøÃ~zPTàŽûØžùœ.‰¾2i‡ó%¶Vç”öÜLy Õíy‰Å§[ž¼Â…W©ÙÂûwÍmzêd_"B¸Ê½8TÛ//îíÎ W˜Œc}:RqÁèÛ¹ò±§’"^ԸÚ بmé0¸ÔŽJ\ÖìÁ¯òfmP¹NtTEZ†¿wÁ쉋9kÍí4˜uÑw?aq)«ÆÞ®Î÷½YJ¼"¶$Ư1Êî÷¾Q]$ô ‡ÃËš!I˜y›Võ?‰C‰ŸÜ= Û&óû‰¤8!ýi+y/öZð¹ìŠ ¶Tq¤xeIŒéîøFú1u#û},?B(§ãã-pè¾õ\‘ý¾C[ÌOÖ× ø¬‰ô%5½6+ Z…:¶Pƒ:1–ÑêBç†é‰u ƒªâÎûZÿb¨ÝþmÓNC’Œ˜%§QìÊØ.†ùὸmNteL#‚Æå¥LíDû©jSÏdk"Ù”Ó¥Ù*Ÿ`íÑÈ,âÈm¾ÎÖâh¹Ùm…˜Ö7¡þˆY9$ «ùí4¤égðÊ_R}¤dÚ¨±¶dÙ´ÀH^2+\ÈŽh{^—פ>0ÍŒ|–Oó4B¦É5±ˆ(ª\'Làø=´yr§>5d.BÇW,=7¿Hó!q‹PãB&ÛÄ °£”” ž©9–ÿqô©†–;y¹‰O'åÄø¢öÕÒ÷^²¾Ëšá‡ûÚb^€4•xPvÏ8Ýd˜ú‰9-f\åLÏ9µh IŠ&‚ý‡»í_éêVšxí‘‘ÏÛ•UæÔË'RÓ‚Ñëê´Ìa'Ò·°²ÕZìÿWßaJÐý,´WTÂÆœßìFß)@<« k—$fÕT:ïC@,Ì´lDTrúŒïs¥òtÆÀ:4Rq.Nµd:OsC?³î^©åóÓ@ûOb¤‡Ó™§HÉ¡Ø;¸å!ÐYÉ®MIÜk„l~eÓ¯,µOû·“5} ÃËÒ.LÖò¨'ã2c«Þ°|'€…S]¼2×°íegæ¿îv·%à&”"ƒúÿr^+çe;µX™s½Ñ ËâP+=Ž§¼ ¤A»ìS£NC»w­2Û ú™Oí ®}Tj-¬žÌe×Ñ«6ÀMY¿‡Z•UîFð6OÚD\IÀw»­!¯ÆÃ8Ù1XcË’£LÝï´ >˜¤™œy¾*<,âÎô«¡Ü£jUvd'fHRáyŽàQ0¥ ÝP½%á^H. -{€Jà­JQ Ä%¹%Ë u2€Øñ‡ ¬sÕ'°˜A«çB‡>€‹Þô[²Ö„i9âìÚµ¿Çaºˆ‹¿èS¡‰÷ðÖEn„aºöxÑÊÆ\~kðae¾§i˜™1.9JÕX†¦ÕæÏ*¨!dmúŽÊGgи³R§gDÛÎís¡CCò¸˜‘t%º4û´…š{†OIø°£e2’X+&X{=y;øjäƒf4õÓ¶m±WÕ<ãQ¨Z<¼^Á§;µ®Xíd (ú)6ïWÇàòA‚æ=á ¡‰ž^b ¸Ÿ¾,7¶w—Œ40Ä·Ð }—­_ºÉ·êiz*PÆÝ·:ÄcYÚR¡.óhÇü1Ô…U¶@†Ÿ¨§ ÝÉK–Þv7W&X)¶4Ýu^¼è4¼ÃǤ݄OöÚÁ¢öœ©Âïê#ì¢9=ÕÂN.I;Ww4I}!÷K[KÅD ‡·ç°fûBƒ´ôuõýŸ9¥yå¼{Ì‚Ý~¿•w¿3äOø9Æ…>~rÃ’è:~YÓbù%t‰qøŽ7Ç=ˆš¢¯ žÜÏ¿wVO¤‡•SzX›öæ¤C\CˆuJsë~É* ðnP¥"ýôS…ûG5€6â8}_EîðĬ3æ‘A .ë…ÀÝo¦¢Dóâ‚\ÿñ¤ÚÀ™ð¾¤æ `8z“¸©AÉ8l;Ĉ±¶fqÑø<Ð9÷Õ<•]ºÔ„0oE­ŒÈ³¯•¾Øp(—g{Eª'¡;#Áâ§|f¼i?œ¢™’Fæ´îÀlͨGÆÿ¾ÝK ÄRu0†æ/aSªnó\΀Õ9]ý±EMW¿u35)±k‹é½ðï—Y†á'¶L‰ ªæÕÀc*•ãdè5Weòÿ±”«,Ÿâ™¼$KwÞp„P/2qƒ˜~Ðõõ_Æ]\ñVHÏ9@^¶VãÎ̸ŠJ6k{gºêynïçõ;Õßd)RN‡]#ÌÕ!´£‡Ã|¡„òqKh,x3á5O¤¯Qa˜ïÒÄ „ ¿³ÿ§àÖ"J$8r!Ù¦J67v‘ülôòô8½°˜·š¬·ì¸e |ŠÂw±ý†ïâHKËOjÞå=àx@¦¿êaÂ(Tá­›=ãBÛã‰Æp°ïf¶…Wù‘‘1^®mÐÈ¡ ó*„þÃHcRYºX›–[Ép”è…ëÒa«ô‹@óÎD¬òÞX7`ùǘ›üiª¬F»™äv­µÒU°[Hw =KÇ=yüÝÐõò²¼Ì öË™Y¦Ô7d¡º²ŠUß~¯‚ ÂãR±×[Ý»,3¸.f¢|Áá¿ lK£40hb±¸°ŠdºÉRüK¡wz¿Å^îxÌyx‰ë’äwMWNÑþø¡*õ<êà·Lœà3Ðß{bf)œµp[à;‡Ü„Õñÿ+z¦ÂÐFpÙ¸Y`–nLBê)í Di€]é,3ðàŠâˆo "§½ é¯Yð½Å.’|ÕªZ’nzsvš´» ˵Âó-ø¨“û©AD°œe¶ëõÊ +GXgücdqãˆ[¸qi™¯§nOí )?ß{5¨e»Òô¡¼%4^ À£Š[€¬i<üÍvê# §ŸøÌO`ZNÏOÂ: ͯ=èì…©/ñÚw»ªÌî¿Yõò=¹ÔÐÈÞÁ,o_D"ÂzwLá#=P)]›gHvW’˜2FÂÜÉ‚"…3m8žK½þ¤Xým’Q'‰RT¼°~ö7 Ø/ÓCc¶¨ (¼W«Î"U¾Hªdýâ\½­TË%®]¤ /(ûKÍZ"Éð¶¿d»t󺛵@¿ÔQ„¥«¯.Ê<)ˆaSìc×K>ÎÈFÕ_ÅÓ2?¡ûÇ’R¹øë9ž­B@ Lߊœø#âÍRàٔ͜ rCõ–f‹ƒ¼e½òòئÆö¹‹nͤ}H#ãF!µ†ªÈ04bšXÀÄ.Á=½bç­ (¾*QƒÛÛütŽ(tÈ´ôþC§PØ]zðü©íMì®Is˜ZBÔºjÂ89G|?x¦`ª^ΣaLkzŸäLÓÆCšes;ÕÂ[}‘Èê‚õô)…‚-VNµh,¶Þö %ƃ;6n¼N¤þ)â¶^ÀFx~ö…]gC þq+ñŠˆz|Áä*\0d!Ó¨)¤Øx}€yT..#9/£Ó«;¢gŒ«QÂ$›Q oOyR|ð@š;¤PBȉäZÅâtYn0;Í¢”o™b9qT¬3ÊQ\&üT[}k‚ÊÞS²ˆ±)èé-Ü5ÃçBNŒ|ƒ.>¢!ñÓÖG‡Îe ˆ,Oa²u°äå÷®Ž8ì˜Ôx”5#o0›næåØ=yONƒ Eqz»¼ÿµËr(o«‹!µbo“øMPhaKS%¸Â¾R-+øBfCÇ^ àådÌŒ¤3²ã–DÄ0œ¦ò¥½t0¾ñb'‘{¢ÔÇäÿv=ëmÀÛõYoÜO¡êè½ÁÒÈY"®æâZ°òÀÃþjåcå\ÉVŸu¦s¨Ïn8tO!âF²…å. &ˆîƒ?˜œ °[ó¬åöó"}î¾Ù‹ÕتÜc¡ù|Ð'é{ÕÂ<0Dˆ/áäàÚÍoCAk´§~$ luuÀ´€Ï°FEd9¶µºÞdOÞÅr&•@ŒuìÙñ€ÅõÔ=Ô4ÝFå…Œ:À‹5,Î8X÷_±Â¦åå†mZm‘Ù×Þ+F8c*j¯‹Êõv/“èÎ×’kÅÑÉŸšÄÄuŠÍ_4ÐKv¢Q7¡¶ê!wi„ åkf¬d'k1c@Ò³’==Ž`Uƒz‘çS£ô=ßß:eV9/ÍÈ6SH<Ÿ¤åa.‹½±¯ÔȲ‰0Í\(mOJ6ÖnáR[5E²Ð©ÀC;ÔzÉÌVÙÀæ%…)B¡¬Í~ðE^ëK݆5 b3aïÄ°r¶Ì»°à{=ÚêÆa?§Šv*½£~´TGÉþd$:ß| ®öWÿöX­ÎêóƒÈX»©ú}õ¡¼AÝ`9&°”m(J~kH‹ì¼ 1²¬µoê<‡hóA!f;û ÃâÉZ4¡ž¹'‹ÐmÀ1ò½i:Գʩëà>&5vàn67æöØšä©9c}éÏ)¨ÿ4½5m‡aœ¥(&ܦ¦/ø¤ø:šó¡ØJ«ó©æfÖcX[~cˆD eçø2îíàéN‰6©î¾†g5Pª5ƒÌ¡ùWHŠ&Û,󜡇d´bVÇ™ºÅ(*«!ï¢*_‹°Jx­@•7³N 2Ê>™3ï|Ñ~ Fi“Òzùs•îæ¯ìI´ €†½:²ts0>e^A—Æ.1[Ù§ï]F¢3%ªºäOG¦‹uŠŠ˜½S:n†yœ¬·zXË1Sz»Â•ªù^S¡¯W0CëËB˜PŒ@ ZTkMOeDk… E1 ¹C¤Á³Vºx€•:aøHí3¹¨~¯þN¼!¾i· ?W- NÏžMl Ž{3ðÄìçøáHvLfgP´VjŸÙù\-@\ ¿ÝÌ·HLó'€9•öH¹õRŠj‹¦ æƒÛW¡­o¨HÂÅ[ÓXÁ§±»t<6ÈŽ„0™˜­Î’ ñ’)ëªUd£ry:N¸‚ósÇ+ó[œW:÷ªÖo¯ VUÈTÀêkèÏLO¥fh[}Ë È'É–åf8¸vßíëùm=·ÈÔ›yk€?eUj”0{˜¡µ´áón§2¯¬õŽh§ â«áïŽÍg±˜åšvR:‰÷Ö`˜‡'@Ý’% ñPöVþo•è3@€£Ž›˜dp+"~ÑYFåÞGêf¤3b@m°4–ârðªH³”#c»‡F¬T>ÙO–Aré΃PýÒ…@y[Ò/†ÐÃ}{’ûùsŽˆÂÅѨ𣪜¦¥Pþ^^êÅ7ÉíjJùsP{Êœlî)KTÞüz·ô1#Œ>,w[w’þz ¤Tv ¬š›É)·´gv cØ‚ÖÞy­—:ÆlãWÿŠ×‹ï€ÿp‹±ŽøDOøÔá÷Ѐzmt0ÔüV&ùuêM@Ô@QÓ à×æ4k/±#TÉkä±™ÆB|1æÚœL›°E6‡u? ‡ªóÚ1°­yÔ¶Ú ´¡å—¾ñ~C-ÙbÌ_5;€Už;žW~“¡â u¸ËՌߕ=øà6¹8Å[¯Ž/0€¤•°<¼Õwd6AtøHpÁÌã=þó*›‡a…±ÍU¢Î8·ñ©Z©ç=Í~|»ôÕs¼Ïòf/îgg´³Ý7‘H–Ÿõ䋵êüEÄHWicuû.ˆ9á3wÈ¥BäjöËãëJÁL’d6†¤z²o]ÜãmldØ7~Ru ñMOûzìâÁ¤[1 ¡yšOá`ÓÆ}TdÀÀ£{{@è ¯Èn_„)ÕÌeª!óEÿBâÿÆ0¤PW†}ŽöjY\X‰QŠ Ü®ah' º²›é±%*:îË*!ïž”äš/ª`௼â õ!¬ TÏ®¶pL¯W= Á?¾~Ù9Hê]šû´›WHÔ¹_¿®r 3ª+m¼’¹¾ 1:îß42Ò•5ï~ÕÆ×Èâ^-/ÆfjÖëy¨°ÇZ+ÖUÁC4œ ÅÐ6™ ¹ë3ÕÔ½ƒ»bº ªU þ`·O¼BеŠP¦zÄÛÁÄ™:¨z«‘¤v®3mÕꉄ*k6·ÑÁÈÉ"s<—.XZØM ›³v?ßÑk™iŸ¢2j‹²n/oo”r7$¥3©5"Öô™™`òÒâ>‘ërVOÊžŽØëdÎÚ”A•ÕKå4ÏZîwhƒ¸¢9B)fbù:Q.ñêv ‡¡ ø*ÓjèN”ç^œ Á©ª†~!ô+¨3|´ìÑgíœ{ÙåÉK3) ÀÇfU=U M 3íqe^¿ÎAß¼¬-tj>9U›´Ñ®‘ÈߊÍì¬E•0Xµ:è † ×ã«ŽÎÓ¹ë=XOà.¡‘G4Mí§æfs«iàLÓzU>—/ aæë&Èv½Æ£”oGI¸iª‡¢;èö@éüä¡ö·×ì#jë–Ml]ü˜‹==fŸ%ÑUR—§½p¢ñ’®xWèCrî²X¸©RÓÆö¿ªT¹ù«ˆaª‚™xgÿ¦ÔN›ÏÙ¯–æ\éÏ,œp¾nDï Ä.~û›Œ~VUëL‹û2駆¼€eã³ê…‹ÕjͽB¸ EÊ ‰mÉâ²­“Úû÷ô¡ïác¼aM¾Ã–ÝSóa¬¸q#hëÝ"ñr¾À¡aDW;X¢<Ùߵ߱ӳ‰½¶×sJ´ÐLÃðÁC§›deeÃå >7~ÎþpÁï'‡[çÁnb€‚mB;ÍEÖ}®fÿ»É§à$Ò/ƒ™rza|‹öÕÈÞ WŒÅ~þÄ!mõ±ý–Öiö àúd ïÊó?_n¦ÿ°“ÒvŸäÇhÉcÁM‘gûn³y~È’3ÄZæµ$]?³´œ#èeÛàÖ# õéãm|·Ÿ „m1ÿ¡;o\† ‡@0IÜéF M¤ô¹…˜%µß‰ž–Pd5dL'^cÍàcÚ;{IQ/µãwþRE ê?ý©B¿,>½ f¤ÈUDÕ† pˆØ>ΫD½È¥rm³BƒßïF~¦žéæêÀMüõíh5lQf;Ï™¢yãO5s»ÑI’5ÿ$yrK9/™§<¡ÿ²KŠE+ *+¤wØÓæºõ‰Ò—<¹‘’°NQ ‚²ÏÖ¼ `žùüðÁô\ž@¢”ÇÄ¿lÖ¯ß‘à‰¢Õ‚¾aí…Öÿe¼)¨;w)Hn䥣Iå>‡æõÈõrÎ ìLhõ–búpA`tBUU̘-P€³ŸÄ¸rùJFôÈ(#'ÊÍ!áhÛâvlj;$I¹˜:!‹ÏÅܶ£å*í–>`V¥{ŒÅÿXŒ/†¥ñË®Ó,dÍ}Lª¬A¢Ÿ#ŽÈ¿p¿‹'»DÿìÖƒæé3† [»Üœ‘«°Ï]V°„÷ d·E×çv‡/fvuÓ@t:)´UºÊµî­§óœ[¶3x«T‚Âø6cÀh!c:€=¹BË]µWÂù¿¢©\'Û ™ãMÜ6û¢r¶×˜òã|=¤Æ¢PV ”[C¨<·j8HG‡?krgVÏIDÜ:Q†Жñæ1` Šs­º¥Ý95G\þ=³¨"ƒ…Úcõëȱså—¢Eg'.òÎ!Ž"ŒÂ‚…SÔ~“=½>€ˆN÷Þ:m™E‡Ä±5ÝmìIáì™tüö€1‡/‚‘´íì"ý©²:ççš‘pî|Áµt¹-ÌoÆW·*÷–8EH/Þ¹8(ï`øaEZ¼+.Ë”kXS­ä–°T®¯ì%r'`K£:—_šÈ‚:ý¨a‡<´D€xìÜzË0¤x:MîÓN(.}~î³ kD&Eî„‘ Û…S!vÄg³„[Té¼å<ìþP³ô”¬d%;½kÂ×YÚÚÈÏÎ •4AYó¶¶ w¼„CuÑÆF0ÖÇç~ª«÷†²$9n§_cŸÆ—Í$_º%‚®FBd)˜e ôØdC6iÜAÎ #ô ‡|—øùŠQÉ’ý”ú_Q×ÿ˜T §'B—÷H´wùä†hÚ˜ö{àÏzØ\þ¼’C`ÞŠ<ìqD!)”ôÉúPc“tä š" ´FR1 è •ˆ¬r Hq!bHIåwn3ª“OëulšÓ›£äödæ>òíÔËH¸HÔÝ”ÊcêN¶«9´4Ó«ª4ú—i-!g«gñÉStéy<\ß3NK¾¦wº¯³ã®!bHiüebOˆ¿Ëû´¡ ÷È!Ä6¨!Ä1“â嬯2=ÿ4I²Ý‰8œŒD(B.•mV¾«}ybÛs‘=t©=Tvä){Eä—:ˉšïaÓ µ“¦%@3ÔY—¾²•ø9¡f ×®‡/ŒPUr™ý²¥±²g¨ØÛ*îmxðQR6Ù¶?ž3©¯}„ ŠÍÍn‹ÚwÉP>}+pÆnìGþë”þ¶6©¾@tFøæœæØC¯ÒÒ Õ "ú¨.ëˆË©æsÐÔ©cn´ð[ï+;¡@R^VDª›ÂÁÒ4Á—òpé8>çÍÿ“ÖØÏŸœö X‚Y’z†G¬•Ž²™|Žså}pÿâ: Ž™7YOFõNç|¹,›¤òøðd*WeêŸ`–a#’ÞòСúP §Çs xpaeWµDVÎ@‚-‘}]ÓÇ$²EÏ_±ú*eò1[ÆéF6䲘jóÀp¹{`“ðF÷`Ó¹yìžÙ±E¹‰~‚ Âåm¶ö D^Ä=ÍÖkr°íuá¤Üˆ&KòrCŒ¯$T*ã¾1 ü8¾«ðÓjzºìôqaYš& ñ¥– ¥{Æ.a˜95¯ºe”Π̧(¢üYDPlÎbPt™°?­|$«”1_‰§ì‹‘Ìq"î{æ¾ÛRlƒµC¨ˆ Ø¿G@¢ŽG>nïù4úV°­K pcÜ¿9ûýF¥ÝCi •¨ÊtŸ·{[ì’í×?„©7ê”[=¾„ºZl{ÙþèqÓ.NC-Ö>R0¿D†¦-Íuv¤®µ%›MjÞ&3¢¡Ä½Íƒ­Ù?zž#á/D€üË>£i‡Ž†ÏSrˆÎ9×q­žž;sŽšf½ŸPöD¸¢Ö}{ö<0ê«{*-‰¸Ñq_|¿¨ÿ¡õƒM¼eÆiÌþ–nØ–ï!˜é¾7G«~}ÏžÑX ~«ät&ôçdÇ‚µŠÚxK çš&z~qÈ+{ËîÅ\11žÒh*rQYŠ=lÞ *þóvD§— ôœ§c×õdÝý,Ä¢ˆ‰ãbð¦«+yP¢×óʶå‰äŽÇ¦ÕÕŸ›þè*L*¬/P²P°âñh/Ðï¡vÝ4»,bÉkP¶y'ú-DÑ?„Žãƒ‚ËqÖµi,JþÝ:êdlž0t÷¶|ýQô¨i“]óßÖØ ¬þÛD¡ås‹5‰;PsVg7}´ qŒçt€j5qûŸ×)Óöè86°.·iõÌŠ«oÁ4”ãD”æÖÕzwœ’_)-MÄå®ãÁ3gô#N‹*yHa;&5Ù¼gUl«7“p Ê=0s(öcñƒ*Ô&nfÑ ø %'¸Ž›IF:£",©ÉÅ1ݱ²ü¿YéDl5ÈF,ĸij Ød9“õ8òù3WªA 鱓ÙßÃRŒà“È‚¡[•²ûÎ^G[B“bEZ³él'‚Ãßæép„\š2Û»QF¢ÅEEÃs6+: -±¯uÔOK]È&»cÁ}ÄL¾C\†ØZé=yl«ÿ¢í’‰áèFÇ<i’%SN´Zì)Îïå W®•W~ñšo»&­`v„°%¦4f…±=.`¨*(YðVŠóZfܶc¨uOµ­ùo€{¸¶Î—$¢ß’³»”Ÿ¥ÿ…Uø‘OÃ\ËõMU³j÷_CM‰¯”òiЪ:W_ë‰FOTÍs¥ÝwÛ2¿ TbQþ@¢Ëí»šµÞnåü)ßAÊ}¹ÞwÇëF¶ø*QUe=¼ê¦«T¢¤ðlu¹”vµ6`°Ta½•§§ó·A/ÖíaYBµ?½Sû¦÷ái#Ò"ƒß_qñíÁ$˜¤ým3•^4H÷Ëû½V„J#­u¦ÒÑ÷Ñw‘®cè,Æ 8ôÙtLòϦgðßÓQ‚K#FÖá0"Ð éGkݾ•ì«]T'#`hx¨?ñæ!Íy.ÉIVû¡?U¦9Ø3®BJZ9…x cóôßE.kE‚Æ”ko1kñëœÇUôÖïªa=j8̋焆s7 g´×mÕ\ж)ôaJ#˜Ÿ&9.m:Þøö˜±Z93î–a~‚ûåXy5Ì7 u ²©Nû±Ô£JABãYO0ì ×D”‰6Šf8$›„ëOòø|«\+‹PQXíåsÇÑ1s6‘¯6 MÜS{“² ñUí"ÄçM~·¤ÍÜʵo%Ò Àio1SG”¸;`¶äØ>ÙðTyÖ…oyÒtº¡É[ì„ ÿÃ`§iY.E>_q´“…ë³Ìüü nzíd-¢ÛŸežé%§¡úèîž•Mÿ0„q@wO¶#ƒ}pðFb×ÞÉc˜ó`Lôøç,}æc³“`(R6§B ³ý¬ÃßõOÎ'1×Nr|ËLÒï-…ZLˆKiÀB]zFàJÆÄ÷ªa½\¸€±kcÿÝ+½=(Z‰´DÖÅ!®¸E±mµ0„Û<âGL{€S}ykEâæÂ~ ô*^í²ÄKU¨'×´kó[É2KÌWŽHŸïŸú©üÎ Ó`ñpï“.Ò7(¥À)a1|Ðヌ.:Ž²} ?MY.>ô*ƒ£ÊgEÏfР—7δҜ¾¤P“-¥›SÖizuº(óõò™oòs*N$ŽïÙ,bÁ¤àØ!e~²!cž´|ç8I…Ú‘e+#ꇜℂÚ2s\F™ñ¶Yöi©‘?©ÚŽXZöX5ÉÜ»¿ì™!ýd`;¶]óPô±èX¸ÿ0,sq`œ²1Y£ð‘S–ãfËòNüoq¼NŽ…Ûwö.¡†ïƒ”¸ÅÔ«U>nÌ—F…èïu·y-÷8HvsŠ%_!SZKq nÂRØ#*FšEìAñ›ïQþhݵï°1·ø¯ÄæŽÏZ7ö·ÐK£$Se¾ÄrQ¯?̸¦5RS$$¼,èw2úÎŽ㭵ƂÞ]À¨L?q¿„¸JŒPòp3‰iŠ¸§T>{ÛJôòÆdT‚…¾=l`\öLŒQ KV`è8“‹É€÷‡‰•õ»I6°y%‹ã„ƒjëwÄX£q"¶gÏHÒ`nQ¼&µ+”n4Í?›gÂú\²~ƒ~YX›(Ë[/E~¸—&ó»~ –p\Fö`t.üê¿êÆ8|nôGæÒd ¯.,#>yX’ÚP 0!‚µ¥e9óìgaŠÃ£|Awj(9¡.ɱè”çWXŠ¸(eλY²vý?jV?O# ý Ú^»Íh@Ì ‚%j¨5¨E/sU +`› ¶õUÎZz× §Gº/ÆoùåHxC+ƒçÁÖ“ô‚C3™ÅI=Wá=uò^C¶<æ™ /+y¹ä$Þº„©«–IŸÁú¶´Oâµëªq5ò¼Éå®æëÀU ³¦øɤð¡Î šï.x)¸“ ×7“1€¥BŠÓ _+Z¨9ytt®J>6þ*¢,U¹7qM–|ÞãÁâÝ¡ädÁ¥ô¯/³·DÒ}©#OÏœk+œ5ò|  t‘Ò¦¦äáPãËâH •³òüâ \Ùù* ÈGg>l2böðšÆ?éÕïq:p%QôáËô+‚ñºŒšã—Ê©ÞѹÔuÚ®7š±Ê›Ó`ȃç2¦·.Ñ -j‚RÎ÷3<óo\ ¾4/ò½“̼Ìê‘ÉÄÒzðK HÑñýÆR˜@*Ò¤)ë7!„ n1uÑ%*¢3!·‡ÒÊPPü7¡5“ÌAÅEÚò¯¢”ì¬êTå—3Þ0ù"}5QòÝ£gŒXE]œv”ö CÑ:Ô½ílk(uÈ÷íJr.ªÿýƒ_mñåï\a¯•­ÜÕ¶÷ëeg³â²g€~ªÓ\Õ*'y|\×ÌÈù3#g¯Èv' j‡sy¶[ c2üˆUÒ¼,9XN8o\Y솛%!Nl.Üš•õJÀ˜´æ*æp®&¿É¡¶f2 øüÅ’†²ûTà%¶Q‹I‚8³}4Ôúšš½†O#AsA12Ÿ|1[œeä'™ßð•Î•ÑÉq²¦FIü+ÒÆB ÅV3\ |ÿ6·srKþÙÒ¹êßÛ€€(5ÁMÌRŸ>ªZò}?<FAgåÊ´c—±¢°Ú…‹ñŸ!ñ‘„Þ!p3‰y÷A4æK¶íêƒÝ•®ê­µƒ qvÁ¹Öþº”%¨}ܸE:ɪ…½lèÒ^Y€Õ8çc,­œÙ;X™Û˜€éúIŒº´qøQo¾IžÜnF)—ÏÅnÎ ýðª#L?Ûrja’ þJצ®Â£Ά|ÀzÓæãÐ_ᤷ8]Ötÿ` Z=d¨êðj™#ÿ€£akJ|Eãf¾ êÿÕîBÈ0‚È?ª*ÄŒGã…ÍÊK£QNá¼².É}Í pK¢S‰¨˜ ‹D£qΧŒÄF‘yVŠ)ræ†ÎÁ±w‘9¨¨ù¿Ú_qÃØ.õgQÍHI·š`·Dã”dº}e$Ãí%Ú´ ~j£-Ó˜|‚Üš(I¦Œ¢çÕ,V0‡Z·~x/×鶃TÉ*ã3BÉ™(ög3Eqˆ‡2µÜ¬ö“íÞÌ,=˜¤YTð•"‡ûXF`%·©nÊŠÆé—¢‡ËªÂ°¤ÿW[\ d§w ÚžbZ”G'œ'D–=’®Ê¹"¿—^PÞM‡SI>ŒÏî %ÇSœå•å¨;ý«(ÜL]¨åóÅiåEúußFøÀÒc²d]ƽ|+`=DÇEÕaƒèv)‘ l bôQØ¢È@P00ÙJ¬!½¦€ÈCfP²wHäh èóW«rçö)öãÊ`‘:ƪ<Ýì¤<’q“Û'X­àêC~°ÿ5€›¤<|¾õëDb¾G|´}–4FñÑFÇÑó%¹°Ej¢¨Û׉WSè=iRê?fÔk› Z!Ëx¯:Ç%›e—3Rh¾9un¦6µµpmç)3l½‹ÐVÒ_0‰žiî0!‡¡ Ó…i»ÐÂoWíB—m³À„3ý®Êş˵•Á`<™”‚?#¼‘æäÝIÔ¬2ù® ÕDŒ˜¢Å`õJs?€XL(×ÈU¹‡ÿ*"¢÷ŒÚQéi¿sü5»3ïÔ'¸-´ƒ Š~ò—òä—âJNê®Éõ‚Õ›£)^+Dd"zt G z ³‰Ïv*?5Ar&]“ ‡‚j‰°¨5M™Â-ur{ƒt8'T‡tTñºçAc'-€.¨š>#d‰û©$Æ@ºé–[O ]@¦ì á”Ö!Ž4óÜ €=é­ÃïXjYDǤ°Á³qÛ¥|ˆ®ÊšÍÐ ! ¾ `à$Ÿ<Ìn"·zTVˆ´[»j4ðz_š³;µVŽ?#@ã÷íL#†3=çþÊ¡äÚô)ìx›ç™z²‚Wý¿øÉíà Åc”ŽSLBvâ4)ÓA7ÒC9>ÎYÎ6ht±þ2o=ë´YÊ ~\ÐÄz ?꾉^ †°DÀËvÒSCã í/P=ÎÊÖA'r?D.™Ù<ç2Ñ4Q˲„™ýã¦C‹}Nslõš€üšûÈð&‰¯þ÷ßãÒ·Œ¿ âq¯Ù†y ¯¾ ¸¯Í¼®k7HXC³ÞSVE¯Å¤Q¶¿ÞÉû’¤È ÔpkÐ/Î&Ðê^ÏT2¦g2ÁYó`þQÍ;Ð>Š3œ!Ä“(K ¶NêdÑE‡æ[`rÞQW ÚãÑWô/¸A\ø[*+qÉÒ…æùhjeEµ!KÈ5Ù•>RWÑ{:<ôë'˜:-4åÝí-š«U•=tîÐéÖ!%H‹èÊ:Áì6ÿRÚÉZ 8¼O«V+eÀÏ<à衽rè¢ät ÈDš¤¹}R‘qé!{ª u˜Ð`aª~joaVÛAi˜ƒ½|å:NtÞosý9â³ÆT‰¶‡ä^0ÛQÛý¦ðÖpÉ j/Þ×æ"Ë YY Õôäñ % ù›Ý+¯.Nœ8NÝ >OØŸ§ME¶äïl‰»úÑ 9Êý lZ"í7óЗ‘›«Ÿã£OLÜ`Ü e"œ¬,Bƒ<­1{ëÚ†àP‘©˜Ú®â™Åì*«E'Äw‰Ÿ SQºÙ§¤ aOæiÔ8@³@úô;–˜WŸBÐdo¥ˆjeY€ Ó†¿©uU[×ÅR+dœ÷‰ô²ž1Ã*»©uæ•H·.A/Ú»àÂ^Yÿ0&Øi©p_âçØãZ«sïù½p¸ZIÇD_^êé¿ÙÉy k}›D´kR4iݱ'Rd@båRÌ„ÈdXEuBìJ4]!DÒF3|Òh½ó¶ÇãÞ¥Mv„oƒK¸Ëm4çòðMâ²iN¡xô_L<¡FÁûHK²®µutÏŒya¥Î¸´ïÓW0ÆLmž×ÿ AÿËZñ½WçRH{Ž=v >ín}èéb8yG2/¢½)¸Ê¨1×n®âKTV+˜ðið€ÌùtröŠæôà^Ë3>š¼Ã\º!ÕÞYüê݃ۋ»ÑÄ°"Ü1œ t9¾B¸IŒ$Okª°!¶Û²°iÒ<^¾V¹lJå™ëFÓý·BäàN*/A'™¿#ÄYr‘ ˜¤Y¤›Ð­ü_Ζú\&m _gDfÞÉlkUÍä?@Hàó\%ÝqYàÕTqÏGò”#Á( ÃÇÉÔÿm¬÷ÔH£ïÖ¨…B^÷fˆ~u¯¨~¦o« L0Uô<üŽŠ!5^"I_Šû0ñ×ò¢Fë»jÇYàGâSô‰ßLáü%¢z›:å’‰JžB¶ýr¶2C.p‚?!Ý»â NhªNŠg¬¬)9jÿP$sÜèË|`®‘öð¤èwÔõE]Ôê6ƒ(wu÷y…"hò-HAN›vÈsgúKÿJŽÿ^½tˆ¢!ç]¯l%6è"4ŠXãƒ)v—!¸»<&C¾f£íåQ_À9ü@/–•nÙ]Ý3™…iu¼Çý†Vb«JxÕåI¤×eèÑØ û¿X혇хÁû¼ô‡âòrá±¼Ùbzu’Yӭ㲞/…nùù3½CB5ºØ¢( ø¡–Õh¾H3“ÍUŠ\tÀp6¸/ád$^LCpã›R®/‚²“wL cåqÅ}’mx¦?dWÓ-¸ï„°`*xvü‚¥X4;Ÿ¼gS´/5‡@óaZWÝBhysšgî j™]¢ht xï†e£.+^ÛsÀSb$#Ê\7b1;0e ugß¾ß?…/•-³”Øk„ @XÒ^cŸ‚Â4(Y‡—e Hק8žºws”¤ Ë7fõΓ7¨Ê™û æÔ¤†—$üFÞÓ+`n®~@uŠlÇMÀ…Ýb»¸tG^dñzÒ oÅWp ks!ü;Ö¢›òód¤žqÑï§=NO‚Ê/u3©¶šˆxï½ÓL9û¢q_ϵŠe¹s O*@ðkIÑGJyJ=¼ÅíÖià‚§B(\?«HåEAO|é#åÏ5 àEâzECùµ ¼¡[Þÿº(à‘Bå­tU4eÈ.eïbH©<§ñ´CM¶"‡¼‘‚ÎÄé?©Þ†ÀË ;Ÿµ°äÒyÈ«S$XF',ÂK=|¢Þ¿»ó›ùµ ãëöB›Ý°äæÓf•!¯å{-‡?gaP²—ÂùWqf ï‚e2Þ®§ŽŠ¢ö™Ú-Î|;X¡EãÖøƈ ИMü’î µÁbÂ(¹Ä“j¢—r 6Õ—ÇŽ9ÈZðëØû‘:Wæ×µs„Å·Ž:9­<ÓSäÌOo‡žY/ϳ¨°vö',€ž.BHs¬ÇcÔ½Zƒµƒú…Pë#ªÜ³©Ñý#p0ú¢‚TkQmi'ÉËD´á(ñ’ñ´Ë—N×Åç;…ü…û«b÷ ­­[,—ðèB„èÕ+2)“yVý@óbYéfñÔý_êÛ£{Þðëþ«÷y(bIn¶û¾Ší !‚ÁaSJè¼i!¹ýŠ|-¸‚Õ t¿¹î"¶úÓÀ_¡c«Ï 7;%øš¢ÄÕ#½—9ø€]^w¬qëÇ©½¤bmàºdÒä'uóÀkq@í€ßTåBS$H’ù©áMç–,Ÿ©å¾Í_ukqͶú+®bN´:ϦØEJ¸´‚ûUÃFD½ jxµÌ©žeE9‡Ë¨³‡ÿC^ò:loƒf¢ôµË,º½)- Ïé™ñˆR5±0;ô¢Ø_T¦c¯9ƣljT(ýèa¥Ämçyªe™ ª‚Ë3£æK‡YWÖÏx‹óÈX{ç&µ³øÈ upÂqý×ÍjŠhS]#Ã52MŒ£Ò³cèY'Ô¸#Cf5˜ç©þ‹~¡çC1ùq_1 ]ÙÃÙˆ£®[³¸ñ…ÃWë&}ÚÑzÕ‰ ››—ø“ ª °û3H“Ü)”¾¯f/²/Ÿ2™9Ht¼Øs©7LaP¥Ðbƒa„ÍéÎÝ7¢ žaõ²0ÌZÄoÒ&•5ÞêôŽ)¨Lä୉Ű>yŒÒ¸C·µ×ŽäYge•÷ò÷zW´—|˜ýAJÓà+‡&0,WáÙ>,Ùdmä;øxCN¥š ŽÖz¬=¦â›º³ËMª["xqCú» jæM£ë;!"²“ñ įٜÁ`¾´óÏШÊJUF±øÙÇK²IB>„f#WŒÑ0Þ‘Éb‘2—ØÎEÅB£Ë€Y^»CÛ¢xµx9¿ì|ƒmÝÞ¯8½SÁŒ¬Îlô'Q*@ÄO-qáSÚøêñŠ(!ŠÍ—fÑ`î¬Ñ’Õ}·S¦A*S±þ§Éc1o |¤z¿£ÓD¿ðÒ+¯]O È$!“f¦RZ³þÙSÏ›xߨƕCáO_EŠwíiùÁÊFùµvs@kÂjØ%“‡d癤î"ûëï:`†0ܶg(UyålJ§=Û}ó¥¦**ç(K¯ù;£Üá—’ñö¬Â«Š?,µrgÔʬÂ_øR³«®&ɳOsn~Ëx+RS®·ùºæçȧ1`Bý`W¥Ò é,}£ëŒêP9Е7ò(ß»íï­Gå9ÙIˆù±;³íŸ¹+ÖŠ•üÆ´D¡À^Gtc‚$A•• ïóB–B»è`eØEä÷ž_Cׇp¸Aà×c©¿b¹ÇÝF«" ùÉ´8hL­aѯV—v<Žß®‘ `!ãÓ-`q*Α²ýô7Ö÷W±µ™+50¸ö‹ˆGÍÎÊ ó×jøG²V`?Î|†¹èÂÁ:öüŸkĔߙ‘ÚZ·î<6òW ÊYüïÁï^D‘ÛóT…®^¤h}vQu²!'ë-á n9ÕŸf‚ZÌHáA‹J®ôãÝ=kÇsêõQ‡ß¤ºµùÎ Q”ƒ/ñûœn•¦¯!%/ž¼3(FÇ4˵W¨ã¡¯è¢P§8? ¶ÐÛo"¤îý žRu«ì›1*pê[wˆFÔˆ_ÿmŒ#£p¯£pî4—Is´òcÎ7•øºÔw â@ëVÅ£a4úUaÚ´?o v±ë6CB߸c‹©œ{À:8FïOýEÙ?‘üHÆ(="“,6¨n'rhawId† æ1妯…jûÒÅá~h] ŠøÅ5ç{·-aÈÀ¿p N7î»0µiNkÓ¢@³ÀB{§~^£XEGª û÷Sù±=ý1dXw©ÿm5­Iv…%öµP aô,9‡C£ªåW æ w÷©ë”yk+óT4ê“çïÓË'…SgcÃ;«*ŠXr®/ J¯n0 ož9,ß!SAþ–´fçÞ¯Fßôeë&:¸ßòkÄ(Zû=Ž .!†²:ûqC-ygølc¤B`íîD%8æ­•ŒjŒD¼ðKm©!+L#dÔïÊëÎÁ×lèe?Å$¹u`RЉå†Á/\Üÿi*Aùœo—’®:ænó ¼MZ Ôìߦ׬GÜ4—1,7¤éÊ¥^±ÐÈa4Ÿœ*‡€m>¹4½—`ƒ)%„m¢Šq¿e¦Ÿ÷:t¸(ªp¶ñs8²³á•.ôJ¾±B6m)ÕlãQÆOàƒíŒÄx Ý&÷´~ Ëê¶pV?DY#&×;kDU#xÿuÄÕR™Àø4€Å6©¾P•iÎGõ+þá­JkLûÂèÐCÜ þGÑG÷À­òƒ‘<” ÂßÐB™Œ¨ì^G@¦¹r1á^ vtn¢P´Ò0 ¨”¼ØK§‚þ½œõÞÜ…¾%ÔåX æÆ éÇ­UÞ‡6Ö^¥>5]‡ k%3"Šû*̧Žç’Àÿ @OŽ‘qŽAM4™•ñv{—JA¾Áéh™ ž&8B‘«n";‚¬W°w†§+úu4«­E"Ëv~F½!ÜÍ,J£Z(º†î€¸“µäÔ²A^)¯_#‚ި΄øœÙ9Ëï?Zî “c©XpôU¹®|zƒJ!7u$Kjp¯¨ K{ºÃ™Aó€²{_QœSê›@ mú!÷ì!›"’Œ¦nï:ù,ãÖÙŒ·L¶–¬¿v‘W1'lya?Ò"ª*`qx|ÛrÓÎâ,9˦5fñ¤ª÷âjw]¹Å²Ê{zý™Ð4DšâÔ Þ–$æŠên½CW:/îÊ3O—wjë ðsB¯¹dÍ 6býÛ9 êš@…ݽL+É ÷¥˜`¯}#MÁ‡©ÁþAM-tDáý{8Ž^Ù@‰ˆÐ@øœD_Ú™S]3ͦSæ÷:ÏqÆ¢>@C|@‹µ/‘Š‚€dÂ,Ž¢gB7gÚíجq—^—ÀŸlAŠúêPã"ç€ê‡Žk¼‡£¨@¿˜Â›€]ˆŽÿÏ¿FÚë%ã€Í ZN긨jÜZv”èåîãÌx ’ÕQnlPAžÉyŠ©Ò­CjÉÆ 7ƒ–L±>íòS⬞ãÂñçÙ4 iHàÌÈJìþýe@¿®\µµ^'öµÙcdÍT²¥¢]ÜC= Ðy+ZÄ\ºrT¾* ëî>¢³˜>„†+¢ß65Võ‰­©Éµ?Á]JN Qö•Â­~²³²„ùö[VÞžŒ¥3åÝ©Çì2N…ò°W yŒÔ*`Ä…B˜6 ÐÚôxNžHãªhjA´£JÁ¨Û<£¥'o ÅÃu>Ãðø¸ÉŸ 䃣#Xc’¨iÒ…¯¡lëÍm—ø1ƒ[£ûÔíØF߸nºQ&ÌÐXe(i|u²ùÄ´ÁìÓ;>Oßúª C0‡tG“e¯Â(®+Êœªb&k~»kµl¼UJ”`vþ ,”ôW>Zeb"ãôÆúnå]rº*ˆRB˼ký7òß¡”?'Kô¢?@¬aÇ6S» *3¯eÒÂáÇô~‚†hùßl«÷o/וëªÄÔxðNœ Òɵ·¿–ò¡z~?3èx*Nhí=˜R0 ³‹=™u.nþþ×K¿²ŽyLrg·ÊçPuÔv½·…P)2¢K¯uü£üâ|ö§´uקmËÖ x ÞãÈ°FhbӃꪭ«$óÛw]Œª¬¨tòðìpíåõIGû¼œÜ*ëk£Ý%žÚÑófþŒUñm!=‰m"FIºô1 9(õØJEÂ~2sG=TgźèrM^ju˜?àº9-nS7ÕåNĄ¶â8B;—© |¸\z¹ŒUAïcÐk«˜E¶ßZ-‚£î½iO;U ‚Çpƒ'$2½Í/e’ºSpMÊUñ‚ÃkÃÚø¯ãN˜zØ P;¨«>ãÃ1sšÃÓ,$æ¬j—ï³Ö÷Ü5Dä†ÿêCÎ;ª Ìž¹Áh­7EôƒØ±ê›Ä \¸§ñ5Cë|áöwôM’±Øx/ Æ-JÏyœó»Ÿ¸ µ‘¸›‚ÀÑ0‡ëUÅèþ¢L#(²Ý÷a™…ód3µ¥ëã"Z½7óÏ% _Ȉ¿‘xŠbÑïNéR Žë÷4…ÖôÔ9Y¤·Mv0ê‘^ ˆÃÌàÏc‰µý½ÿyï9-2!HØâ2²ý ±¬^Œø5Y7ÜGL'!Ñ"h¬½ô5 Ÿ@ü¥(Ef j ‰'#Š±2zM€ ì:ZáaÜÖ¾mƒ×µIW߬cg*8¡ÿFí춤}R<¡9JúóÐD¸‚Ö1][1¶’cÚ3è†^ýZ@ÕO~$d4Âõç;¬ 7ißf4¸¶³”£Ð(×#K|7¸1'Àö¿[¢·l“ÔÀyû˜Ïú£Îá48ix¿¥7µÁS*þ!½$EøqE@[ŠOõú®«Ì¡È‘éŒ2¨¶ªäÿQ4 Ô]r˜ äž^Idër"’p‘¢£•à&:wÀÝÒ¤¤ÏÛ«à$!€j8Õ±ã6¬xÀ’¼of ƒ¸Ý‹fåúU·îÔöæ2Ùv‹ŸkÅ+Î?òÁ(÷B¤J6¸O]W¼øKçÉžÇNª”Z…Îei_|7©]ýÂ-Œ]¿ò·ô‡ý$˜mÎk4ƒã¼­­±Ý"× Âw;¸sêí¿RÒÄÛÉ&^ž–¼yÐûVø%/'fi~@Þý–ú8œå\åÉÊÀgò9yjKɉ~®$ÈÓÓ ¸në‹ìBÜ9þøpúP¬y©úÌö­ÍêÞü§åÃêñô54]íQ¢èó7h¥¶dº7ÀfP“¨›ñ ðÞŸç"3ë¾á)cEW–œÑU¦‹P0,®•W•tÓjµÀ5ou @™ W–Šý(~ î}9+ º„†ïöa‹—ôt¥mZÇ¿`*8ðûA#Rœœ ø,nð(ç–ªAôOê@:‡cKñKfy|æû¢–ü\åŒ&ψW)Ò]žä·<ƒ 6ªã¤Êš@®ðøZ­¼Ãk§K®VÛSöÔÞ€F¾‰P¯$qø©¸n>­Ía¥JP-yÒ‡…íøR'ÖëpÆ׈Ž¤—‰ƒ·†—¡%7»?ïBDk˜úèr˜¸P†Ÿ¥±:=ƒU럳6Ëˤ‹_ÿJw߶aEâ@þë™àšku_e`\]–óyýj±Ë,¡!åã"[@ÞgâÔ•´ùŸJ¤B9®áÑ©ëFtõ‘nNaÚ4ŒžY+Z1t@²Ï¡\Öëš•+_2üªE -]»(•²™~íu©Ä–^¸wþÐ}¦C(‰BõÏþròtCÉ•g‡±¨ôv šžv‹ ¥±â¼â[Ïÿ••}-• ~‰b£±€Å¬+(¨Š8½𳧞g£@T±aàaV™[ã é3Zv˜]fèÉ#IÕôÅV,( é*¸îßr„w bœ¾Ù÷!]–F=Ý…ÑM¯Xˆ¦o#<rl®K:·ð¯[ò,‘n€‚B¡Hé9*3È–&cšKóðw€"ëÞ¯Ù·rͪ»ÕÓÿ EˆCŸµP­q16¬uì;«]z£y2˜¿¤×?‘Õ!Î4*7¢]í*ö—#$W Z'¶¢µ¡À|à *§K’Á#Óm¾ž 3ýͤÛä!ÙAÞl|…ÿ°ê”÷oâÎ&gLàà>q0&ør¡¢Rc+àÙü|”ÏÀ#­Æðãÿߢã™_‚Ô†í0’Æí+7hꬾÊEÑÎhÈîYÝg4PG$Ô)Ùã}<_p¶.jˆ€5:qæ†*ªN ëU§Ê Þ±lq¶XU×S‚dƒsS-冶™¤Q¹"¶OìDõ<Ùœ £2*ýµŽ‡ºÕäþˆÔÅ1ªcŸú¯d"¾ †ŠÓ‰æÞ«ïƒ×‡Ä³o-\ÃݵéÃÄ k"éÿJ¹·8Œ­æM'gBúÑíFxí_8/rƱ€¹"Ê˜Ó uý;ÅÖr'RÿÂø1¥¿ž™Oð3þéÎt«²r= Ó¨.ÀQòÛ‚±Aâ½Ê¾¼÷zÑY!ëá¯~6IJy¼¶Öÿʱ„UL&-iü·£æ6n£)pCú4é ,™–àÝË6ä¤ñks#è»^Òe ²ôŒÏh]ꀼt`ëdž ÏÍ +€¹@±}U~¥¸Æv¹“f«7S¢•“ˆºO'ã®úî‡Ds¼"ùÌ€ê:µFe–Ò©ì×Üdï¸cä«&î×f—ž*1ÕýLú…ëeÌÔúÕ¦èQjޙlj ÏÜà~sXÞWŠõ¬‹¦ r5ÐW¥›ßix3sNä»Ý†]xDrè<D=‹õ1OZùê4儘NþÚ–$ëÇ ©“f˜+˜ODaßd‡4ŠšÚ œšÿM—ê~ʶ4w™«L¼id@Sù½þt':ñLLLqs©ïßg/œl´?»fiü9 ô3äòóõ.*º~Öa¾Â}¥ÄÔ7+™0¬©¶­ÎìŽgE6ýöªá»ßøAÝÞ–zF&Ùo§õ˶C­Zfý›³d#M9ÅòB‚}‹ZÝ™?ÈQ†¸Âïþâg¿PÒߥŠS˜çX ,ŽÛE{?f¨je3«w§µ¾1õ1 ”±“D3-aM2ÖAbFÙõjƒªZÜàãD\kÉÛP£±­Ç‡¿„(qu’ã&ôµIE:œwÙ jüu¯ŸçÐ * ÜT>-Z `ö"¡¤Zj-¾j t|ÉfÓ øQDMå·‰Oòå:žG›ñàÜz{TO§ÂÓ±2©Ñ½ÖÁ,¢[¨Í¥*Þ󒕈1ô~ KçûŽ­ì"ô†Ï.´;÷S½ù IH#¤5#©*ï¿iæ€Õ¨6)L;ÿð!ûá# æ†sO¶uƒ>Á<@åFžƒÅ½±ì¼¯@[«sEh¡AÛg9ž)n+y±Â¼·ìµ°km(ÅÛ0ÙÎŒ°b¢®â‹z Ûr.‰5uÈ* Å{ªP›Ú|êó’ÕñeMð:LÉgv·ÑÇÓ(†€|)>ôŽùLùž¡\a¼Öeè›,©xJ}NØœ tÒ§ ÓX¥åi¾ÅÏ™¤Â-> ’òâ3ÓŠ9Ÿ‚³êUà4ßÝ]’Á¦ËDbýê¢k.óT„ÔÛÛÁ<ý'ç|¯ºUcÎÍ_ÈCŒÑL!!åÝŽUú¹@%óÃ`}/OLÐXq©Š…=±Èb®qÀ^Áóºzn&s†EŠR~~©,Ñ| Ké1zâJUåßxÁY¯ÐR½-”æLH§#b9Zª³DSkŠBY:F™T¶™‡Uco¥®«!¶?´ÇvUÌ°°¬JIÀ×æØNà_ >=éã÷ä2­·ðªö0rc˜ÓÚ™—Ü•Ìã5˜ªàMi ¦ÍÓ*Niƒ>þп]/àêÙ6äØÇ Ó»úM¢Üâ“͘+$ÈøÊì2rí°Ü|huèCšðFÎJ^eY“tž˜õŵŠ›q÷ȵگCñ.öÿ·Ä‡ª v€AÞëfCî"RZ²oÇ4×äóƒÁe4ª¹üËî•dùNïªg[ÕÕäBS9~oT~’,´ð¨l9IÑVä¬U˹ëù£òŠBÌð?vâØϾo•!j •†:~*ö‰ô]¯¢÷D¨U%¯v]„êºÕr‚¶ʆ¦Ìpë‰ñ¥Á“íCs§ˆPÙ±3¡1¡yÄÈÞ]‡(àË®jIªv¸È° ‰Æ'i—l¿y¹-ýÖW¬#ž<3¹Ê@2#ãðädùB­¹mv´nÑê\x¯ŸÅFÓpF‹2½‘ëª01'%YZ5Ÿ<žgŒµ”Š¤ßò¥ÁÁí9 ûg Eâ+ñïþBÆk 5,zœžNaÒ²M6Ø}äM’ÒAÿvLq?úÙk OÅöøÛÌ*Ööœû wÇ)Q£Ñ>ßÝÅUù™ªgý–ª4'ÑAÐ+ƒäàw~È0åpÅLo4†SÛîèûœ¨Íqa&ÓÙàR¹3Ò¹Í"tj@à 3 ÜÙWÊ9ÊŒƒ\©9_õnWƒ*„ïù §D¯nnûoJh*ò ð•3j•U‘û'^ÆßÆÐÖ  ‡”%ï9C Ô’yåòZ³)DPÄD–‹Í4mt{G­%e.ßÂ(Bjñ<Ü&¼ÁËÙfüBJ¨} ui¨{š÷æš3àÛ v\;"!ÍßíµÒd2ä#£4ï¡4.µ…YJÀ4›ê°ÓCÂ&°Ç£RöwÍ^ÌŒìùz`Qs¹lVIk|¿jÒ§®UŒÉ|å bf™ü¨’®Eh.X86Ï œ(’Ì2­Í¥ƒ(Ü‚Þ­Ô6¾ÉæP”âQÐ`ù³B“²çn¯çšï<¾ö3ã@i‚ ?é¿2Û–Êœ Þ[ɹ<ñJÑM%õ{aØî·/tîQiGƒhXwÇîë-`p']GÅõxì÷îÜ:Eˆ«måT“e‘úóy©”®i4^P1¾ÂÑŽú#NG™ÁH‰¨Ññ;xKôéËŸˆ¤‡k^×MiqtÕ Jr £Ú÷d僚N;ˆhtV4à]O7ôT[s2DÁ³•QÅ[¸G¦¼;¿ 6ÈLHLýû$$²ÙŒjBéú“´=˜ûŽõ Ÿ› Z€J'ñUZúâ,åäÐ^ø€ó+f@V0°, =nôp¹{Ò ².Žœ-§Gwzo'Q?RF£‹¾± ÖÑ;1—=‰ˆ`‘ò‰”K}@ JWвòxOG¦ŠJ NrçªIô C¬ãšNÂîÙˆ!ü;oî„/¤Ù¥bo½HKR'å,Ü“-ýØÒ îœ,Ž2üÂýu è9ÍU/Xtò›3;:SóuÔ!7ý&ÆÇ@DläŠoMÜ7x/¬•Ä~ûœ¸ªfFk*ªeíŽDžIRfý=PU÷ÈhGó¤ j|;Ä”‡M³0 ŒõxÎ!fFs/×: WÖ6Ô rwø†8Á›É}±uCÐîXëô•GÇÿkðyÙþwû nÑÏôÅC9º{,ƒ{¢ãæf!f2`Ò¢œF¤Å9At¢ô§½¥æȺ³ÏŽÔZH+ò}Y6çX‹x;D¤OžM……ÅOÞqÈøŒ?îžÉ‡/G Úr?y@:Ñ_øp Ù*wRìƒÁÆ9ÅÞØ[;·ÿ“å9 :ìàäŽÅÂ3‘C<ÜáaŒCsyøs.6¢×ðqÃÃP¿¨ 4åðÆõËä\¶ÅW |M ].ºQGŽ•÷;Fþ9ÞTî“~m—€9ßq+ëZWΔä~uŒôßîvÖ,J’œ78/Wáù.MOßø8´€f¦}£}tz“jmO3¤‘´ªhß.ÇvEîív•SÂsÄ4À¤OCë[^³&ãHÅcbœ9CŸt¡h4×'¹!¸@Lï:ÔL^ ½¬%ÜÒ§KDö‰Þ¹£:)Ç$iqzf''Rt†&Ža@:úÏÉBůKRæ?ã*nuš{ Ä¢à“Iõ?Òû4ÌéÐ'+” äXnˆ +Ë·N6<^2SœÅ…!Jº¾«…Þ~3áäT4W;Üæa½‚ÎvÞÅÔ‡"9zpô¥Ü”;Ìn4´Ó}'Å…@æa‡fPªÞ‚†ï…H¾ö_°ÃÛ®«uiÇ¥vŠwÀÎFSü¼ÿh¿z91üÆáöÓ1ß«*VÛfÈpÈy,f]Îñ&ؾ}Z+ú7±)½®„mÓþëÿu»=ærë‹gÇ“!:X󶱻m ,öiuçOÅÑTePkPNš³X¼žùa8fmœÔpuL‡×;’ !KŠ$h³ÝjòÜ|~ë–™çÚÜyž?câ Ï´rÓIõ¼ž¿6-bP¥‘¸í¢ÆUSl?áfs ë¯ùY¨°EXŽrÖnu,:fûg#£jÚ! 1uf‚…ô¦,’ù¬°ä &¶öp²‡+ÌádåÕ½½&éžTt1Ö"àhKÖö~95ÂfÁ<È] >}·ýŠð!’Qîƒûó‹j|A¢Äô­z@–Ë[˜Z5/múXêEëû$ð´iÅù$•’ô3пŽbéâDzÔàªÔ'þ´v»¾2? °pëmƒ¤PÓ¢Q¯­N±®L›Ô>x6wvðQ†/Ä ú—=˜¤øÓ<ÀÃݧAx;¹îS­¤jºªÕS¡Ÿ+9Þñy­s,þ"EžíÇ#G\–Ôý–9ÿǎ䚥¿>(2Wh{_EäoàgÍy…B/_a‘BHt&ÏÕWl€J$;ƒ1OÈMì¥Ûš à-Õ•Ì­kÞ'ÿ" Doܾ®«›Ø6ùôyx]¦¹¨qŠ-³æ ã³iSJ3\:þ Wä>Å/21€Q¸Õ{·§º‘AÏRu˜þÌ4©ÿ]œ¨¯!TÈäf5ÙeÂ2·¢MåÛ .œ¥¦o “k3ò•Û/b™û¿Ã~`ˉ8M?ðm3(Üï7Ub+­Ô/ÈI~E³Òœ8L¶˜Ä#Ιg--¡2Á¾fŽ Äföù7Î ö>™ ôI­KɹÑžHÄÎeÃb PÛâƒç"ê“ÊD…EQvçÖ k"…‰(\ÀÂ)^­©æ»Ñ<Óê¤MИ¢¦—N‰äÑê²Á\/Aï³®\\¾^/G¨á¢¹çëg¡MA†&/õ„ä/ó:h ‡ø¨k(ø†#™¸bR.rÈ¥¿?G»ú\[Ärˆ6À(iYôk?/Ì›…=&!Ⱦµ®w­FL'nÔ5rÜh“Æ^b¸ëmün8’ç'½ H“ßL‘Á¯);Õ’ÆÓ1é/jæÀÒ«æiAÅ mßaCñºžË±Ëîá•Ó$J|;à;>0{0Y€¼d´yzaÄ}¶ªDî7Š¼øÀŸš˜Q¢\ZA>8Ì=ð„“%×ø1úUš/ÖŠÜš‘ÉÈ4fÄw4ŽŒpœ'~=%ïPž {©s©î¿¿_¯¾à‚ãvc.ü<ƒ‹›ÜÌf¿&<§iUíi¡Ýø õ7Ô3_‘T;¥¶˜J "RiŸÉ©]mP[È #Ç»¼ïç«‚¦ÑðÆ…h툸š x6áSؾÿ ¸hÛ2T¬A@EÂeÈÙ†bˆÊPRýÔÓ9‰ÔmW†–(ÿC’&=Û§÷—½Îbd$ð·ÅDÁÌÙoî‹ò^§AÚ3Oü0Z§'TaØêT(µE·ª ;ŽÎ 6GÍ{ _r¬Ó¤PØ<$²yDÕ–‡ Þƒè¦¯OÒ`_ 01äࡦÖ¯þs&“”é@KᎱ·!ղŹÉ¿Ó®k­Þœ¹9éñfrÿƒÛ3dDøØÅ­zYØq!;zttÈ?<³ÌˆEÜpHÕÌÚÕLl¤}úÈ…uãóò• ý% YŒ¤Ñ຀ž]äÆ Ìëqªi¦Ógê¤/Æh™6É6”…)¨doîÈŽ!}@ÿ_ Â%mû~$á9v¡è«úS\ÆBõy)t Ș*b¶ü´ 1®“ò >~¢?žEö‡ó7×°K6ù±;N¥ž•p5bG‡3T·–ö&áÍJòÃSÁ(+äPZØQr“|Ø- }(Þê›}9;tŒïæA>¦¸0Ž¸/ƒ¥ÆÆDgá$ýРO*ÇqÎÂUPà$dbÚYÕñKzM!*2¯æ(¸m ?ûÆE”"h•5b?f '<¾Á¦þÛÚœb¬ùÖí`éäÕðufmGsÞ85²yÄd¨Ð\(Hiá=¿Ê©i3y¤ãB¿Ï¹f b§>™ÕwºÔHcÌïüÉû4HûBé•a³¦izîeûÛk¿ÅTÆt ì¯`á½$ën@1‚Qàh9Þ¥¬ç*ø‘7ßk6c¹¬S*ý¸F<œzH†Ê{‘áóÆ!3,Cœ½«ëQ°Žã›t`‰¬|A„  fÖUM¸,|<2ËŒƒ%¿o¯”œzôuç zÁ9$®û+.‰/V)‘0%åy›²ç .Ov æÞxüUvw©ìÒyìË.¨ÂÃâ#ïp`US‚L²ñîŸD8åÌGÒg%?Úw¼_èžü¤âþ¢þVÏÀîu«š˜yæõò´k„=_.Üiʲ.À\¿)ÎwÆÀ¤Dîµý´‹bÓæK½¨×i–a«Î=ìXrk]æÉí<°*Òã1V«ý>HLÔΰEÁ–@;()W§C¡RÛt9øP@0â:Sb x^wˆÿ¸ë$q6s]s$oó»)à+F°Í5Áô}Îlœ\c§%Ⱦĉ¸ø‘JÈ<úRùÿ©^ (žßµån„šá¾ÖšjÑ‘¡/½ç¿ À“0bÆ N¥_,Arqé’DÞˆ|Ážr«¥ ýŸØ›²™Ä×u-$Wô³%oŠmaµ:A!¸TÑõå"qÛL#ËDçæ%›7C®t(!´ 2|q%¦ n“é>ʆ=8A{Ç1ùŠ×ShÑèÌ<»Éì2ðzŽ/v¥ó*¤¢B€ÏÿÛÛù Ãœ»BÄkµ¿’Z‰ÌÄŽòk šóÔÉ2™`–U7ˆOæ£G¸«Í¦ƒ±ré'¬•7–Iäõ· ºXhA¶iÎC†76¾É0¢+6Äå³W ¦¯Û™¾  *™s"ÙÈ4×íFËw¿8Fé?2ö³w3þ,{¤ß0Lt%ÄDP=õ¢X2Bãe2åï9‹ i9~l^¸v,D_J݉öBmó¡ÀµØb0|Uùa¼~² ¼`Œêü¯SÔ6ªÏÕ±¼[ _£IÉ£ÑL ;y–Ž×)žÒ¿ÃÏh9ò Ñ=[<èh Ù2^Uo‡CGL-ž.ëmb ¦YTÇkÌnEÁtá~LYËk±šû¸ è@X%]õ'¿×RivlU΢ ðxzb–Œò|Üe~ pmÙ\ÒtÇ]™k-¡7³K7â?QSê&üëVž´ÆÝ>Š€pn£cuÑ(ÀƒÂëÐ4DÞeZ"x(S&ÕxéÞœÖ65 ”õ¬=ÊÚ ýÒ6Ä‘øÔÜ÷}cê#aÚWŠä¤yÕ¯[Øýf¥øªÔ;WnÒ‰­fÓËM]à LlieȽW(0Q75Ý §ínÝYæéo#/ëàÈâ¨k¢óßçK7jbkÁ€® l—kúcÎ{xF*Õ» 1’¥ïD»GÎëè‚oµÞÀ\éòÞÂ'»Ï5¬  šcÒÉ*& yv³‚qy¹˜?Öî™:1+7©µ÷sbW !xOG‹U¶n”šº=æ’Jë©¢†mÖ124y«1C="ž‘Ñ{/{T S˜I°úg,…*åõŸ2GAQç 1¾°½¡šç!IP 8÷#ÐSCânó•é‘EÝ8ðê)ï±O^H8éÄW:½I{A ‰D¶‡·¿œ&èëY±jq¾3 ñIÔSî6Ç%ÕÁôemÊú¶¶ý5wŒ…PWŽ´îBJ:1]?/N¡ÏÅŒñkè&ï.hÕà¼q1”«·­,¾0ËËÿ/Q«S[©NáÜÚns£Ìõ?Kµ7©>fº- éãÝsúÛl@€Õ>îq½5 ÎGÉg£o$iÄBŒÆKªüCHœü”çÞÑÎ_ýÌz/°àìÝHRìð6ÃM~%GËJ[ ³k\µ1açбøÀ[mÚß×\ªÔåò“– qv…„ÄRSîŒ%™1D¯œüt›_B¶‡ùŒÖãu‚†P@£ÒŽ§‡^€–ñƒÝôÍåÏggÏÉ,S]ˆ7ƒÝ¡A^ 8Ñr÷{Ðl5:ß~§ÚÛº„$”ô›Fžð¶4Bc:¯¨,•:‰UB?&/> J*´½2Ä1X_ è¡l±bÀEL§Ã:L5ÌŠÞÜC–² JhaspÆV‚°…³’¶Ê3XÙ¶8xjÛFéH¨˜œ•<#ÒVmáðµÞwrúÿŸ¡qS¼#A§_•rfάä:u¸PÕo·&Œ‘b—O8{5û¦‰^GâQ±åÙ«qÕ.³8ƒ+>8Uê‘âJÒÚÎ1…M6~Ô¥¶äTí!ÙF3‡õìšö ø“‡nŽ £F Üs(õË>„7¢3ÅžÊHT"dûó5¯hÏÆW sŒ’±VUðFÞ€ÊȽýæ³_/åSW¤u΋#ôµ^\yþ0÷rbà|YYÅO@ڥ͇< ¤\|´ÃÀäÝPswŽïÇéêÉø§ÕA¡“=ÇZÓfþ§úö©ßd|ŸŸ¬ôÝ݆ »3YÔµnRåäSêÃ'•·š~HVäÓ]߸žžAdíh{Ÿ«Á* ·™·©[üPÿ1›“è†óÒs14#xÖÅlGà³ï„cêh$}Ô9”²Èœzv"-˜0ˆ¿™…ã¿Àq¿+ÓvDIô’P2·ÓO¼ú¥9üI«;u6>‰ Y~*~ÒTVA’>aéÚ¢[×<…ùÊÚP)Ø«¾>|äuMˆ1†£mÚÆAc¶DWrÊ«õZqÝôŸò¶ØçRIÌîKl{ÏÔ©ì;ZgÁùvÞ€n1•b)ˆÔ¿âyd –ÛÅ“ŠI‰ÖIÒ G­O7×êÄtíjãÒ«·oYnƒAƒ+yVA"“§¤—ÚŠ‰#sÒÑ•C*¬‘æhìÖÝR%›ËƒágOÆû“À(k Õa€Ðà˜#ƒðk}qyÁc"*Ö¥ü±ˆ5­%›ì„à÷ìýÒ”‘æ7ø£ïþ’xó…•TFýSXß\$&%|’‡^×fwøóN¥{r'L}úY›©ÎxuÔÖ›fà´h&œlf|eTÞاªêþï躦uBTMÜìjddí±#¢ß6”œÀ—m¢”Fw¡¶l£Ça1MDmº}¾Ë™Xrœ©r+ÑXŒˆ“¦øÝ(a­µkDS*\&¥ŸFH¯èØ.yŸ(©®&óŠI‚v¦Âa:D{A¬¤€rž²Œàw%Œx fù–À˜]Xµpêó­F»MÁóOjÓpØbé;")±R"•œJ«Ê>ZüKYñ/I.Æä>ñÛ.RGŒÇ/G<<‘ç¹ lk2þ;bpáäG -¦.¤×çÊ×a·sãê&g[ø’Y8x˜‹îFNûƒ‹zÃ-ÝŒ9eñ✭ºJI,4r0' Înæ¨8ÛJhÊRÉw¶ï¤òȯL5£·žûðÞ ©TŒýëu¨ou‚X(Ñ~-Ñ%3®TGh¢R'Á¢  Ýæ†ÐÀŚƵ–ôo½ÔØñ—|D Š(BÂ4˜Þµz­CE´'s¼Hžóæ=ˆØwEÅKÙ=Ñ–cœ„¥c2á¬*Òº"M™ ²3"íñn?wR b>Ýj7lÚ?“tÒÉØ¢ƒXsÏÐ}uñÞæƒ `'áÔ°¼¹ùÆÌÀñ®6ÀB`Ú•Œ³Ãû§(;7©àÃοÇévÔ ª/‹ï~ÐPá= 3Qèá$äM¦çü:f[ #¹aÃL)NTøÞX¶H³yÍB¸Œê_·ºnDeC¤Êò#Õa¿È¿ÂG%)·Û+(Ž-ÂS^½wvŒö%“ØÓª-OQAþÛbž3ÿSïÔTÉ\CˆÐFÂiĹ38ÉzPÛ'/5ífÚÜ-Fá✱ݫУÜñ%ߤæwnD7=çŒëÀG/JäòQAë²÷Y·?hÍ ·é¦IãÁ?qO‹ÀR)C\ÐÕgÔ¨uáÞ Ÿâêø׎:/` _ûã@_@‚çò ¹†ò¯VH ' ~ƒýkÅaÈNÚ(D s^”2ªíè^ÅÛoÜ—•ÜP º”cÏyÇ;Ε6Q—-ÜÞ|jê½,·š¼‡hlØýÐlYTĬ­‹ß ŒÚƒË ~cfJ†‰<Ý£ëÚ”AÎê<ÚËÝ"3‘[WУ½­ñ(Ó_ ¼ÕûÂPFõEðaþüÿ‹nå\Z·á²w­[Hþ6Â\W…¥Ô/QD””Õ[*f¢‹úÃhîµQ,$]`…BÒóVÀ-n)‹­óþË+ëípº)ž¥œ a@û  H,×1$çïé*Ø+î´º÷Ïã·‰ga 9›(ÁMÛeÌÈéì3íØj[‚.Îã¿=.€—*PïÊt¦_Gy¾{Šòú0îô]4‘ç:éqgƒÖLgÞ¨b<®NÿϬ­Kq#Ú‰²žOÒQ?DîM­ùSwmõË&^ýº‰5bFœq/ÌfRgž„®à6ØÄOÔ°ÎT="¿: ‰ŸÑ“Oй8¶h]‘#¾9äÝŠk™Ï |›Y3=A¯T^+WM*#tç5ÁW$ÝôÿTFÆÈ ò0Êù~ï)-ý CáO@ú¤ÂZ¬JäÃeœa¼ ú“ŒrÚ£™1Ýö(À‡*\v3ôïiX¹€þÿ iËr8úž¶A4ëBć·×¿¦"ÇaM¼£ñQ¸fe !ÞE·o1´ìOû¼Ÿq:Úx)bk×6ˆ Ÿ,aÈ«÷ú—qÍ—“Yjž¬œ!Róи¾H÷ 7>Ø\"zzDæKãóµapÁw…ѸÕÇÉ#†ÌÃ2JåŠætÅ[Ö !ÇH—™HõfM% {Y±—²ÛbNoïuµüü.  Ž&MQBïÎVz5N|c´(x9Þˆm‹öpûlÖƒYè©}%”¤ƒ÷wÖ¸à»A-ωŒbe¢"I:Øö8¸dÏé¯dd9åä®QáÄáÒ®çµ_[gs…´ïÎȯÂî~.£iñ<uQª×;ôDJUBßÄÔ2¹”eŸÚ¨¨ƒ·üädVPÓ vî:9@ú·Àl¢+Ì’ù²ðå„”nRçuÞ1j*´¤"ÑíN©]Àháq ðzúQâ…ô°~ÆOçe€–à_ïOˆ‚\Þ|o°Ü½Ù=튧ÔÜŸ¨*}¼Â@ût‡é©aÆXÈV©"GUz”ÿÇÈç$åöXû7*© ®fÞÔ@Õíô} UÌü§ƒ/ËЊI·%¹ÝàÂV µc½Ÿû­ÛWc‚”m_ á%H—ÈmÖ똋ÚÈH‘C=/p¬ý7À˳½3rlLÅS_“zŸ`àøä‰Y¼¦ J—`Ê#t—ôæ…-ªç©g€…–å"²ŠLfƒ|¤ÿÒQy–´ñ’«=; [ÂÞCª˜È7=ǘÍÑž’§v& 7ö8G²jÀ-ˆW¬ƒ=†ÃDzöÓµ—Ñðî†kõD}–ƒÎÕ¿:Y¶ÉkÙkhQ (´PV´Ÿ 0Ö’,f§RŽW·‚?¾Þy ï<~4ý‡ƒ%>÷aJ·&tßÿ0²¥˜ç ×ÿ „—Óc¢mîSIÿûúÌŒü…É$s¨ž Y ˜ï-Õ3‘y%Ôå”ßïÔG÷—ü1æ÷EYUJ2îÒêp_ÎŒ Š%«û)?£à‡â"ÛÆÝ¿ì/ë_®…{£Œ4ý¦Ìn0dH9â«SÄ_ÎŒ»7âØÉÓ1ºÙåÁkÃÂRó™Ù ¹ sââ Ðx›×3]Z’³jG41U¦;Ê'=k>S1c5e¢± M> ;ûG$mjã&öÓ®§§²‘Y57agtçQc"fÀE^‘MÌ7û[#&JúÆ0¾¨š.û° ºov ‚ùgÊ„ANVóbßT&–(¨wDÄ#×ø®„—: >s„á‘M»°î šc‚婤OyŽãõn Ù`‡Äs&h; ùõL†Ìº8Ñ¿'h ¶[†j°6 WSÂbý¦â%›|i2Ú“§äú.Î1ë£["„—`)ÿ>UúGÎ\.yôSè+r“·äI¦_ÂÀ1hDš¢êœ[ƳfJ ø&ûš*..kOpN#òt¼KDÿç(›Qíb¢#fªQ*•ðµ«.Z¨B‚Üe_䇴Ĭ¸„.ô:|ë,áG"r#Ï"“ÀáoŸòz"•wZ¼/+ÑZË ÒIôœìûH+ˆAFÉ’nvz*éle+EŒÎð¯Uô†@-^¥°ºS<©ýÒ)ôvç]¥L¿¢;nïoõÓ(åÐ&r¨Z1é=o­@CÖTtüÛŽû ÔÏ8R–ëœö»_døkŽÉ럽íøÄÓiÄþQ,–Ö€fK6é«ä¸ü»’%õD>(r“£.3?’@” u_ÏC,¬a‚ŒÜÔ¹ãú‰à9³×h½t²ÙF{ÄúYÓœR¢áPдëÇ-;m#({B.SÍ?5¦·f.WcPò&5"o¦§ 9ËÑbcSaÜRÖcv—¬Žwí%OëÕCÉýDl¨÷¸ÞeÚ­˜ÓbÝöÅŒrw›Î$qbjÕ¬_2X˜YygÆÄ2÷*#H"2a¿·Q2<ÞÀ,Çå$WW,Ü&f<3fbf 3¦jÇÖ¹9“!½ór ÖæïƳ;õ°ÑÎ7¦l‰c¼;š¯ì)ÿX'âXŸšt"ñí=´áë.ìHÈOKæhÑ(|¡ÀCÅuó[Ë‚^2Ž‘zâ>ýM[ ‡š„.Šà‘Ö¨†­HÜ'¦eâ„ðþñà v˜±Øzù~VßÁì}€M8Û@ø2œQ¨âÿEáê]ytd°¯†¤ûô\Ž¶æÀ}q…#ÅÀ»m«»È£H7œq)^…€–ÄÀ7«E¨ Dœs“…Ê!Þ~¥õÌûøÑ.ïI£ÌÿWïâ‘D@w¢I™ü†ÝÂa†ÙÁß7³Ô€ xM8/h莘BOl¬á Êr'6Êqy Ï߇ù éKÕ“(‚°øI~^Mº-£C+øÙ0˜êzÞ“†¾#ßÀ^v¢Bî,×e¤æS2”F?r¯µkÿ™V mŠÎLϺºe?¥)ËR+~•]ü,»,P±›zpªàÑÚ0;ª7ãEqMcÝøaKOÚM@}8W›S|ªh­Ë9{+‘¡z/IX'”9´+æà)G.ê… #©‚Ÿœñ~p@ƒ² ˽RU‰1¤ß-ÞW›$²‰Àóë\Vû«pãR›Áì²-Òæ[ø‚ZïFŒhcìj¤Úå„âª%\É«%fÐJ8”ù,¥(¢_ÉŒW)„?D¯Üh$‡£­O¶O1MO-®¬ÀÅ<Êëdw¨®Û%à†8ª5±=Ï*<—«RÒëáÓ˜§$ñp‚âxþ €çÕ2Y58,zœ2#’Ù¦¥S!¯²ZˉÕD~Õô~ð—l•ƒh4Lx,½SÒå‹g†P¨¬kh~j—©„õ"2æqžÐ !n ÚƒÙn£ËÚÂ{Í<,&Ìé½R8rU•B8¡Nh|?ß±%÷àXŸ«ŠLˆøáñÔŒAKÙôp€ƒnŒÝjáGÈǬöe‘øqoÄ\ûÌ–m-/c¿~Œ€0¹KÇ@Ç,/‡*›CYÊ¢E[,ÊÍ*]Ç‚¤è²ûе$Ô˜ð熭OQ–‰Óû9~‘~.šüŸ'T³À~xÌ"QNÑ""dµŸ7{˜lçùë~­.±›)3£"\ã Ò¾7O\ØyØÄbsNøØPA0›dKûI–/Ñãpðø·´ÎèQêÐùÄíÔšÖ ‹óœÀk`zÀ‹Ÿ7AóPn^r·œlŒŠÃnçwž.>—U¬„Ïþ^FeSqM%Ö„N @"ŠçÖ Éw^ìêóíZlÄ¢·ÅP{¡öìd‰ÓW±ë=d’hY+FÚ4Ex%L"ªGÿ‹®ÀÅï-éºe˾ZZ^ÒcÜ­þ¿?«”2—i¿üØÑ |xø–Y™ŒˆKøëP¾ÑZOÁí!Ày“p‘4‚Šç£6VÍÏáÃ3õº]Èëª7/É4%áM¨ö9"§'ïäSª ·?”œc9Ðae"øÁcŒ|‰¡ŽŠŸ]I1tšVÄŽÌúº`5(n}FE ®é¶,^Χ’OVBÝαW=„?®ô7¨¿ÜR¬½kÄÕãuIÕ±G;Æל‘Cyb÷ #!Ò±QN¡?žŒÁ!^–eqùzû¶¢tDÞʇý(D½5aŠÔ+çÞ—dÀ‹%tâ“ÃjB¥%h}ÆóŸáT—þúîPíæu:| ßÊú †ÔÆ upÜÁ2›[Rc~öD´5 톉(bßsÍÕ'$:æÂò[(÷È 5Â]ýê«œWÁBî°=íWN„¥ö:bÕ‘_|Ÿ0N$>® = šµâ!Rßž~O”`¨ûðhÛf¢ùL9–ÁÛ–IÛ6áéFßKb§a1$>]EÌÊ5ªÑëuš,#ñ(M`c›h\@κÀåKØ{œ»â\Þ¶§keí/ü<ž«>qMüwÃXÕ Õyí¥$"Æød€ xLÙ×êÆTf3…ÞøÀ ª8ü+7Á Pé ˜”,ì´¨õ>øßKùo‚ÛFÚY—K^tPÎÇd“ž À³w\ÞåªÇg6öh¼ÜÙðg Ä°ARé•}{¡€š…)pZ‡C3q¬:âÆœ¤žD¹õÂZ…VO9âZéÀ,‰>fcª¼ÎY¹¨çŽ KÃlÁ­o"« [*fJÒ·_b„褱9 ¯#è¾Ï©!ñÞëÍë_¼oÓééúÃ6g;^ìÃ’æWÛ¸—3`S#[ãwBYn—opž”«yì~\´I¸Þã®%>Cîfš÷½%šžÖ\å§ ôreÛÂJ^÷¼f‚<ƒ‹ }‹«-jgXÐ׈é‰R‚.N_@­4«îø6Q?³g¶ZqÍÈ°øò\S*ÛƒíŒðr,êËçt•üDÌ€t6,œ“ôY¾Ë"º†l,–­­ÿ¾öY1víÒ·”‹äÓ•iG? _×"ðÁøŸ!¾I>ôÔWRæòêH¯M²jµÃ²:†9GZ}ÑJIµ(6ô.˪Žåà¤æ´ýn&)x'RƒƒÎU¢'šâÛŽ9ñaj#¹Û“ sÃÉ[ŠUXÐÅs(Ìo\²¬À¨B;„)_ó( zqÇ„¶ßœÑ¹ô”¶Ó¶BÈçpÂ5„,heÅÎÊ‘“Ïž[Aid'W-ÑÑ«ð*0_6S©ËþÒr¡îù/ ·¡DË‹=D¥}W{LeÕÈ&¸ûr>0J‰Jßçc&‹½¿‡Y0õç§hz,îþ‡µ³Í}žÊIŽñ%úû÷ W÷ÀÇæHê.¥Ô×*Ÿ£%èÝ Þ—Êcd÷qÒq.™Èà¸Ø#‰cn?¼L(Ó‡S¯ŒˆÃ2m ½@Æ*‹òÁy\êWÝ% ÁdˆN5Š‘Ÿ4vÙ©fáúžï¥—¦Ÿœˆ[js‘À¤ÒÙð8«¬¦pâ:´YwjëG+1ÂêJ¯štz_ØlÅ3ïÌIˆÃÇt¹ò·ºDw?qƒÏSŶo´a¼æ«ˆ€d!-ßEfÓ ’±Àïå(é‘ï´ÞTT„9cÊÅ~5p„ôíFô8ƒaÅ4â‚uÌ|(m7œ¿oÆPèu_5³yü% IQV €e¾|µŒ.–ÙÔyüJ›Et¦ø5ð7Í¿•AØo§¨;‚92BÖSlÅiýLd‹z÷zÂåJ« ¡kI¢«M+ó{˜[E üù.WÜ‚kÌÑÔmvšGÞ:©­É'2¦ß‡®cÎ}ÎØRdÑ'êQ\o¿hv¥êZ¦jEõ“$ÿ;²U¥Ö­ÊÕ1Òœ³ôbEk†ÁaÓ° Ž§îy=ß"´R\Yò3÷±lðÞù‹Ëgg12sNw¬£nmŠ²J¶‹!4]ÈGˆÚ$Û|q‡æ°qýÔ’Ùf/ŠK¡ASZ[ëåØÄkÀžmé9yã.“E [™®Ì*ÅïJKvdòt_ii—-­ºI>,0÷rjlXÎp¼ÆÑKz¯cxíVt#`‚—88J‡\]ё쟕jÝðrf AˆŸ§Ÿãÿ`{o1Ï _ð&¢Ö{Ö^G†;(mÈ€¡H‘ïbÉ3U£V+rˆ²®Žξ؛ØgÒæÀŒRÌ­cF¿ƒÈ­á¯rhdÓ‚ÿÀA)‘™*‰»Fô9±)°³ò8é¾HÖ)ѾÁ‰‘¤.q¢\0ô¬ŒJ¿+£yoñj³€‚(Þ*¬Þ”C<ÞèpÃ*]Œ¹Ì¥‘…`ªËt1}Ýßík!§¸nû¡ ëÍž—÷GUÂ1¸¾ðH‚^t=QK?ŸšbŸçZ%d­äôò»‡³ö*NcG=Ê>B¤«÷A^´FÙ_ö²J±–ðƒÓÀ«\ñˆ§ ³vº¢ÝÝ£s/F©?Ü4pÊ"'îÍ. ¶?Z^°†®Ma'+ì&“ãúOüuGk®sŠ¥ÛK9¾-úwÒ´Ц҅Éò),à¨wfrn´èƱì §ÛÛÏ5ó“ꇑfS:fáÏþº¡åBêù´ŠÀC—!C¬_GÚÆh9ÖÿÕó&}½ég@WjG­©ØÏ’îCëW¶FaØ£Ð]ó½=;ºú‚¾ˆŽ`JˆoD#r“ t#>"q7¤½|UOr¾ÚÕ9T™ÛänªšQ–ä°áÙ¹{v)êŒV– W1Eœ¬/}Ü(ÿ ñSk4x\ræFšL7„‚8åEË·›döï½Õ£ïA©™!~£˜H a yó•ÛÈ«XZ?yaÑü' 1­+Þ74­T(1ËÍÀ6ÊŽL¬æ¾UÜü翇Ӿë~ÂŽ ô¾Ë.!å>f¦ÀNè …j±¢IcÂçKMw mm‚àD<>Ó1?£ûÑ©[©«x5_Ȩo+æÿ°õ•!ÇN}Óƒ>ÔF[™œßê¦Ì’DúA<Þ¨õ-ºöm„·Z3GÈ”ÿ*ø­¦Ì f@~aÒR¯Ä¸ÎM ¦.‰F–&yýaw$ÎØT›üZ×à$£¨“±UëÈ<\³b·ÿpÈ4Ok îšÔfnd§£ðÆÃÚ¨Îac‡ü Žþ}p ¯"IB¢¬i¿xó2PèÍ;ÿ³‹Hùê¿G_$T³€L§P©qóˆçêMLÊR­ç°~¾@w=+Ž n¾.ôu› _¸NžÀT’ÛÉÌ{ÂSLIè‡ÄcµÕxçŒ^Þ’¥ ŸI÷·yõy—xª 8}LQP0°×ž@D’”±&Þå#ke‡zŠ´–nŸíwëQµêo·×nxZoÖ'±Ì»JÁ`,hVýù:–QnŠ ƒË-˜T ñ”ÑkKœ|Aiû|G;¼m°cÔŽ›cýîúã;ʇêWxR-s7k™.;<ÈÕÚB´_u±¤¡Êç³)#!¸±$"Ìeöà¼øƒêUNƒ/Ó¸@d)$äp K7 n ë™éj›÷0Œƒ®1G ÕÝ?Þ©b¨5ÀÎÃ}“S…ª9¦ÅÑG~Tú0ó'©;œÛÂÂêrXåw:­2nŠÁLñÃÀþî7Cš}ó§9Cزhà—O%*üké'oŒóJ¹¹Îק>\_žûdns|‡I²È§ž)h+|ëÍ È0Wü€ñÞ—ÆÇË]þãžô)9ö€Üfô×%ÂЉÌæ¾Á¢ýÚ1Š9Žû¯£Âð† OîѪâØ]­n—:Ên¶%ÜÍñOŽFQ™Ï„dÍ]µ0ákÉÂìâQQ<›eÒI”VNõ}ZkÎ<»ÊƒÚMBVÓ=ÇE¸Ĺgºcr ‡ÌÄçrhœÒ¿¾á‚Ù`”ä­ßÛAÅüÃ#ë\h×HÃÐj%I H1Ûmû:Ôp`V4ô:Jcù÷¨H£.h––~Õÿå©8Í-–ö½N–WÂШA.¾þ%„[ˆ`á5$™«¬‹WBÈ/!ÿ3¾ƒ$¥•Àö¾¦%×Ö¢Ž‰8ëƒRn8^%æR}m;¯žÎ"ý}f¸ #´Ûœ"ÆPo^öµv¤©µsaëܨbfܼðÇ$$ën—Æ(ÞXÀªùЯ”ϧØŠÿ¡ãF?D/ÜσÒgRžõµÜ-‹ŸLÐü8¬w´Òg``àx– =õL|u³/ó$ÙFïÈp'/~v‹¨ŽI”–=³mÌ-° :Yy½2]~‰Ý>SÌ*Á¿ø^PM¬ÄÅu©ï˜zBØ9î«_W“Àrö,ähr*Ÿmldiìb²$ bk§Ì\BU…üª‘7f0ûÕë<¡Ý¥"ã©Ø™é[šwñ{uÁ¦%rëc SDâã?FGåÉ›º5òŽrw#L_ÀéE"¬,Á”isxÇ!î¿ÓP‰ý*BŠ†ùÿ½S^å“"Õ=dõàAÓdX.‰‚î+Lð$ •Càðñ“Ò]z£ 䂲 ¯OSç\pFi+ bkÙ]è}N²M•w›çuSËXÀ(]Q‰wy†)5†Hì¯Zëœñb3<À ŠçLoæÖBƒñvÃEžƒ›^ƒÊ׆&çMˆÝmʪ'w ¦ã(P<»Žâ3a¡¥"¢a´8(=ð Ì:£t8´à!ûr[ê>*£Pz$md# l•ZóÀÒ ¡€•ÅìwÕ/ñ©v{(c7.ÃNn3šgÌ+àÀO’esjÅ îhÎ×°b­IJþIf«í’cö¢‚£fÆW›mnÈ;‡n¿áôû¡íª×iQ£¹og\Çô×ÀÐânlÅ®n¢™]. Êc‹'׈ IBË£ùÖÜ0Gö ì*¿<þÝÚ¹úXKö©Ó,ÃsÈKk²höM#db¥ÎZù ?KÃɃSõVz8žôà§8Wž}Ö¯£_»§è8âö š}\ªM¶þY`ÇÚ=_E¢dlæ]+B©TÌ“ð ÇËÚ°µ¼ÁèpHõg/B´ã1˜ƒD}B¨MÀ.ÉúD/„-Uªm¤Ð3×É^õ-çŃNxð_Ÿlñ:Ê¢7šóÌhΑvAVyfNÂçk©PøÒ«…ÁWòú^kJp†hÑc™3Æ7ÙØ;ü‹=8Ö²Kh#fÖ¤Ùîñ5ØÃÞX›=§èc ÿbL?Ä)1jOÑjÙâ›K *D9­úÛ£ûïV¦É€óá_ñŸ´tõéRˆýRÛP%Îy*ÙSf©½Âämò]ãÏkó‚ÎU³¶’‚”ž‡ÓÈ6Uv_þºÉÉÞQt=dûANéDÚ¢¯k¨òl‹Wß߀²ù’øùèêS/ðæ²4ïæ‘"¶|Üwý 5E ¥eo5Ž6¯Â_U@vÁ älAm§"ML§œÚ0r4 Ô3'tŽëTÙ mÛ£(C'ÿ<ó "§±úôq#-Ù…z¤Ô%o¡¯ŽË¬ýÑSæ5úhX㶪o@rꯨ:9´öj‡ˆL4Õ~P™ÒS;³øä¤Þãñ·ÿá½êFõ·˜Ä:UIC<îíõCâ-üüñŒÏùKõLŸ¥(c£ì¯+ •g’ÌÔƒ„…@‹®É óD×^Þn¡wÏc58¢óŽùúò‹G<¡?éû×c–fÀê4‘«ï7ØJ ˆ$Ž• ýYk%ý˜ê= ÞCv|wyv\=çÕ}ù²Âèé:S´‚4"ïXLm97Ýí(xèUiádºŒÅn‰ŸD ¤F»šÈÐ"Ú€¶°`Y"¨÷8„ >ñe¼hø&£  GcEì­:ˆ¾G)–¦d º¤­yQ°9ª‡î üÉ2’™~[)8Öîpn.\ë¤aÉ’D«øí8ýóÙèÈxŒè]´V ÚÁâ¥KÎŽYÊ£|‘z•>h TJçY{‹ÎÊ%`2¢ôuÚ³a•Ž‰ôFó¨[k0R¶}$=}XÒUs²’'%‘L…‰œ*§û ïW§‡JP5}š·ï¿Ê•uC­'f ZÐúÒ[%ËfÅ~m¡Í‚õ½ƒã0HZ“ n [ÿm,$&Ãùߣ賺ÞÙÄés€ðX‚4k-ÃcŽŠ²²ãá •áu»G8Ö»ÆP3x…ò— ²êû<æj¸=Ï|wíüü0¦ùoË.gÎؽÏ\N˜e‡·Üf^#¹â¸‘­Å@þ¡C ¯„ꎻ£òÔ/i'E5å3g»u•`½c;›; ‰ÅR­„o¼9Q#CÚVP¢Êìš5ùÀ¼Êù{ýÏ«Å+#¸uð(ÚÙ +$%äŸô·Ghœ!"F-lÙ&ÏŽuwC±Nþ~¦$W›ÆëÍ—M>|·ŽÆq \lÐÿÖX}2“ê-ß—Ð{7ìéG• ð¸_¢ô‘V7¹: DØÔ·“jiò€² 7žÿ äF É÷Á|`›ÞÄŽThi.gB‰‚÷úªqs|“Þ­‚Ìü'áuDð¾EÖ i•u¿¼€CdÇÙwÎ,N9p·m¯Þe2Påm#ƒ/PÜhlpßžIàð m¯§C£–÷&Và¿™Þ¥û6!ÿ¾Æ?þÚŒƒF»²ðiJ^"-ú17„.R´Õ6Ù°À:“ÁÊÓbÓØåÂ!Rð8œKVä#Vº+ š ÀöµÞ×Ëb•Ô¥ráG—$:EVŒ ºÐŒºÍöhSB½bAÑbó~7X?C¯þceaL±æˆBÙaRp\gê=V-wYÖ èâ\‚“… Šv›n÷#;¥FÄ™!)jŒ}­*©‘ÍÂœþcC'!ƳuëP´#‰ðiB+N¿æß¼,”ŠØ?ø°*ÁÀ<ÇÏ[Xf–·ÒÒS·{S3Ja>ˆñ¹ÕµböëÅ ˜Ô¥ 뻇5n4­ö¤®b½ÏJ}·yJù°JxL¦ø⤔õyÎ?pU9Ho‹Ö¬>Bâª.׿ ]Ç0¯™*T¤Aßc`ô.Õ&S{›”Ê•½°›EÝ´+Ïz)ì+pqÔùàñ$–84"Å«CDÍC8£ýX¥_Z1Mz·=•'eìJ.¢ÛÎÓÚR“"»ÖÈ£»Ðzà¢4Ç yž$¹þ¼–Iÿ!ïÓ,´ð ö lD[ª«‰Ä=ee)(vÁî&$Vš\n*xè)ô°Šâ<¤öTÙ„wC*ˆ³1pÉ&¸q½s_“=,¸ûY(ñžÛ©t†b(~Oäx®¸ÆõÉÿE; */g™äœq4&°é!Æ€4À×6ÀàË×ZÒÙ¡§Œ÷ÊwM‰ŸAÑ}´f"o±a_i7ˆObf7*^/$†äˆ²‚ÙPBƒÓ«JͨS÷NhƒáH)“j~' )@G8º6öný 5©-nƒbUIŽH©Þ5™‚_†àÿmÛ³÷e2ì®roÃlˆZR®{ät®fˆ:ÖΡl“@z¡•­v/AšN×S<›m¬§=&vêÀ U`?ú‰­¿íÒ|̃_ëêßgoå¤ÒŸ_Ø•¦„üŒ…º8-ÙÅÆ5403©jl}‡¸¸‰54 ¿»¢pàb7ˆÓþ¾³H‘3†Œ"—€ûN. M{ )_¯¢èM#Oü‘ßa·"‹Ä2#ï#D ÂL¹¯þ¶&tüؤå3ô#8k¸IÊÿϺÕÓã9h¶t8¡Î7VÚFx¶y %2)Ô¢'ÑØÿ.ij xy´ôËÝyu‹¤€â¬¼â7A¡·UKã8×ã¾{ÕB„Àçʺbe®beíE»‹Ÿ'I­ˆ*1rÜ×á!2Ø¥DªO&*6¢ê4U¥ˆ¸w?Y˜˜$ÏÎìsì#£  -^\O¢V; Y/±Ñ› ËÙ8Å} Nÿè–S>ÀÁ¹ Ö^Ln¡Uà#Œ*ìÌT©€]GêÄB•Ž„Bx¡ý¼‚–#P}¼µHjÉ͸·©áídø®>ßgW*c‹yÌ¿ Ï•01±àðÚïdÖà¦Ð)ú ¤q›Qlóµw¬ÄÅE™àaƒßkÛð¾ j\+c ÞDÖ $9±v>èEC¬ï8CGI¿£‹Ž'^ÇåʶãcrÍQ4ZÅß<•Íd–­*CJ€_ñ;ùŒûàÍ +EßS^- œ)PLá{½þŒ‹AJbï]ð=­5 zbÂÙ’å›ýûÉÐ9¹³"_A5Àuy+yì­¢5ëikØKüê[¶âfÚc™ŒÜƒý‹ãýˆ[/ãåå³äð}Ÿœõáa’áž­Ó®¿Jwb—`´ZXƒõ¢µ£æ ¸Îw’Ì6WMvè¢uþ·@¾‚Š> £hÖ¶0í-¾âftFKcð¶If¾tK–àÛ Íq8È W‚Œ’ª«{z¢ñåêŽQ—Ôe*ªÕØx¨­á‘@­—‰wäØ©l¡=~¬9 ±ª%—Eú3±Ã̃Åj‰Q”“Æ»D%Ç F€øÚ,ŠÅD…µV‘•ÿ<Þ9Ãx®»¯—Ó¨a.×þl½\‹ ¶Ê¡ )lM 6*/ ¡ºð£ßM•žµ1™[LØ×AÏÞ6ùÞœõsóìc·îmÚÔßÿM¤ƒ³ìb2™Ô@Höé Ð>cûPiÇV$ì0º,<SsYÍþŠ6žO”;þ Œâ;(ðEÓÛºÏ6eGªEVm¨$ÎxgWÝÅ‘5Áõ’Z­µ­&KP†ü5åŸbç˜ôá%ƒzjÉ¿úêEBŽ)·ƒtÔÌ“mjµ§F¿3ém¸h§¦0é=hÄkÌl`­„ym_øÁ+Û²üUŽú>ƒ¢ðSâ…™‹Ö©3ÌèÀ»Ù5?à@R0è+©£z Tu>jOŒ2øjâx%{IMΈü‚L91§sºŽ7ÿ!~`üwÒFaW+S~¥Ôâ½á„„³Œÿ…–€¼,%6¶_r,¿—1ìÒI{ï°‡®µ±uÃÆË|†ÃæR/Íe78¼€j7WgÌVܬ’Ø&øö§dždtöZˆá€¼D㎟¯C]ÿ¶M徑þDç ´=D©¨äyûä? T•­ »‹¨–äØ5«~²7»Ð¤^Î{Ç”Qtn¢Î_˜CÞëâ-[ÖÅáf× ´À˜×†¾„ ç¹‘á¼æÚ4”»ý¦‚[Zøo'ûÖŸ¤¬2Œúºkùì?ð{ ˆ.»QÙÝMÁzçZ›‰açq£eêÖªÚ¿^Åv\±í$6b1KiLîÍ”¡ þ5#SkÐÊâCoP $F/7ß=ü FªëóÂ2êöòÝ-ìŸÞÍÔr“‰ÏôeCŽeÀô³L⤹6~r˜Æ+„yÅàõÒ¦¨ØûWC¿©læo‚Æ;>[ªi„èSdÞ•Ñ;'÷è0\÷~$Á6ZuðY\3ߣPRÅÿÍ\¼tˆDéßtÅ×»)‡-Æáš Ò?M=*§Äؼ·vדÈÛ(”˧ô€Ü(¯¹=Í“a…ñÓ|IáX˜y:kTt¾sgói˜º6œœ‡x½GgìÚc³¡Ïÿk<‡òA_R°®|I€4³È#­! ¼x¸O¢gصšéNžq:3š®’ìʇÞG/aÍÚöó.Ž-‰^Y&•KrÙ5.Ù’›n4ãxüæ|Šj–Òœfÿ¬¨ 0tÿw>"D¨¶þã.¬0Y;Â2½Yõí9óiŠ“G0Pÿ~Úõ"/ J¬ÅCK/½.jéjI2—}Qâ5¬“u›|@‡ðDÈÅK½}õ¶Ã.Li¢ã­V¢´huœÎx6yEin—ìBËÿ@ØSÃjru÷~Å3mb]0Þ“¨/µÕé…ÃW¦çò 2X]x¦ÕVå ôG£‡¥ ]o¦™<¼çŠ°v±q §ù¸?#–í›áõh{CÔ?a© ¶P¼?—Ã|B榤•|ú‡]:o–c•ENž»[}÷ OL‰à´¥ÖØ Ï©¸)TCCx-…àÏëÊfô‘ɱ‰cªçâ…ÝÆ6iA`i¥VÕT<¾éì¬ð[Æ<õ®°VÏq–rÇA\2+é%k5™ ÝC³µ Þ,æås£â–/½¾)t½“Úq'œP üÿS¿gY˜yRÅJ—£Ã)©gŸÄv÷Ø åÁæ™\K°_ñ864”¼£rö‡QùE*w¥O„#úìU*7IWå>ï£i:q=©ZâqÒÒ¶‡ÛõÄÒ(¼±‚|{S‰>_U ®ñÛÅ÷¡öÓbº¯ˆÓåõÕ“0ßR•¡\ñæ=J˜³)Þ*C&#ø*QïjÑ®WB<u˜…áöƒ¦nN¥Ä¸w¼â¬—žzÉÝá×bwU£®¥0x€ûN±Çf¼.fÇÖbó4,¢Ä•ñäý& ÃÒÃa’…¥àA¶í®ÿº*öNÿút»öOG µ¢ï]¥#GeNq‰q/N„ÔÅ8ÁyåR:”Gy?ãnÚ/êൺ„ ()FôÚdV0Ê›aæZÚÏ ,¥Ù]¯ú¶¸€Œf/ã"ŒhðéúMWåÔGîç¤Mœ,ߪÛåàtÊ%¬ùgßéxº »« èÙÇ`í±DÜî¼ú<7â›7>€gº'Àj•pmæW”Á(X"¹}  ‘òÙœà.Wÿå¡­m 'Ñ ýæõ¼ÑÛ^W„—×nÏ]W/ˆ¯HœQSŸ®Â1q<®¾JÓwÅ0¨!3]B¡î—~¾ë?'•Xø$m¬x@IMÒbûø‚V“¿»ü Jç>|~sEüÿ®ÖJ[ euߌå©túOmõVî­9”`Ä'Œ(¬E;ÏÄwýŸcÒ°aŒ´õÚËœq«€ ª‹†F TÚ.Hó¼7Tš{rqÈ߆†h4é .Ðþ5ak2¤Má² ç·`‚ÈÛGm2j¬$%7ㇲ$ *;4—Z–G’Œt3~õÈ:ãÏ®¡¨Dbõ¶ ’7¢E„cµªEv!Ó¢hë“ÑCÙ´îM*ÅS>[J¥kù/ dymwºÊðF<ÞÉù‘Š¹¬PyLïpÂk¿Û Z,Ý×J9ê×\ž[)W~+çü&Ër[Uw²ØŽÊBÀ^tÔCI3}Î88Èí0#Ÿ¥zǾ6쨇Ìx@su´IŒi×ʾXázùî!_DV‡é©Û‡HBôt*/ï·ƒŽuÛ˜ŸË r½Š¦c;ÈM9MÖ¤cÁ!bü•¸Ì…Ü“ž™äR^qe0ô%úòñÕT¸•t%ü.à/¾Öý1/“§&(G(œÐƒó……}0xK‹‚ñˆírÌ3 :4Qq,À5›âqðÑ/ ÈÓû1çZùM©#ÞjHÈ:ânR x»Å+Dòüd-=鮑/F³£/s ¹Ñõš¦P•>w?‘ûÚ ¬ÆÝÃï¡œDýE"[fV«§àì„6#_˜n~íHy;€).FO}^áÏ©4 v(]½”Á¶¢ t•_¶CLË𴆹Hí£¼ÂZËJ²j®­ÖÏ@²†ªùG[™2:àÎgŠ@µ+·kÖ+‚S7,í­F‹ÝÁÉØÕ_®‚¶›öh…¾å4Ëñg”ª›Q7ÐÒÍs1+kÇžÖÍú>ÃßÂЖØæòp^¤±ÔÕ“´ÊóÝæ‹ ÐÎcéžê£›XµûÞjþ:œ&”äàµc2€­©ÕjE£ë[‹0ô¤"ƒ¦”Ëw›1ª(CŸ9Ùd’Ä?xðû¤˜ÛŽŽ Œî²ë·®D_£ T0r¼~k>ÚžÈ{27Ï‚ö¹¾’Æ^¨J!NXF×7ÈX§K|AZF~Ð"÷R¢WøXÎ…!Š84 ûày»âÕËY Ê Ê¶ëBJ¹ês(Ôj懺Áç©R °Ñ#nÞ_½ÇìõQìÆeœÒé\AøƒôRÒ4ø’ ÄIC ï½ ¹Þ]3ªž›_âu‚zÓJûM€S‰,Õ?¢ñ|N°î±0QKÒ¤ñu`¢~¤aöD$- yÊÀů“Éé¥ûxÆ„½éLSÂ~m‰—yŠXSTGή’¦„ 7Çf =p[¯¶!\)Cö·Ñ³G€LR³ÿAdÆ2‹u‰b0D·ùEÈ÷#$½ºþÄhv!f”§.N·&õ%nÎSõ¸;h…ÿ7[’ÏЛk1 ¾Û-Ý!aшž6Êßµ*5h,ô·%{eÑúJ`áopKßšÅQ`.9Œ$Ò楠 ñeÑ0SÙz¨ÐÍ„Ç–'¢W§f7w._C~ÆFYnN‡¸ÔT¸´*pW¦‡”%~¢ÁXMN+„6 ÷[?Ý @ÍOP£½¡ó3·ú ™Ï«d¸°ÛÁ(‘cÝ… †vhÈým:ÿß´R(¸øˆÈ%àî4O‚¡0ƒ’cNÔQ oq<Õ[àv‡I^Õ¢­¡G匹mCy|Öð è*ì¤]ÜgºPÆ,ª™ëéÙF˜þÊ7üôÔp<ÒÔIBùsÈEýÞ\b ¥•=ùÇû^†";kôøŒâ?þO®‡§ÓðÔfFUNhk›‚»‰+…͘[Mú‚®}ž¤·o¢G“dä¼°4ZqlÈ [&ÚR3ur@¬«+á/„©€ûÎͬŽË4ýrrÝïþy@AKr<ÖZ/Î&½Ñ¥†´±R‰µUÇ´t“µ«ÿwYé 5Ðßx3§" »iˬã‘ìärbW!§t)?:A¤Í”…ɱNGçHò#~·H-·q¤hlh¢7]š&ë©ýô¸ÿsNÏTB‚Tí2Üü3žVÎàRˆåÁµ¯ÛH™G0µß‹¢Z›¥ºw„ëcáR¸Ž?(Õnx7Gµ]¥è¢oûq£Ÿ2½Õ ß>6hµ7~D>ߟt X¼!Ôq ¸Ž¨Ëu·lO•„o‰4{ xÀÉA…,+PˆþüU~g5ÿã×C~åÄU¾îÐ’ p9´E­B‡ØX„æ¹·ŠýIÌyop)â©YZµ‡†¡ÜCBÌ"ç(¡Ü¹’cцiæôXØXØÆXœüef¢®mÞCÜv]ì',Ü>ƒ†Ä#š(>;Œ}½ÑV§©U¾H«¤½è¾3SßÁ”Y‡¼Š°&ÙÊZDNÝÝw¦ H')»ûe¨œ’!¬õú&Í… 噚]!»v•1ÊÝê{K+ЛÅÍjÊý«‘ogUî¯ød:Ñ"cuT |ØÜ>ÓŠ6‰öá–YULJôK=úÎÁV~òlôd d4O–7^GýÇ[jF}•Q8äJTv¦Dh":™'³¹w[üúròšìÇgQ?2¿?Ý}ŽÌ¸ Q „V¦‘RTL=‘ÚéçXéËML(PüùÉOµv­§±õP“oAöu‡çL» ‡‚Q†@ª rW?„ÍGÂþ¢³Cùq­4-i×C@D¸ÉÔÏ»‰1Ä>çµu"³ öd Œ 0d÷®õŒ/×~º¢W3gÎÍžÉMH"`]ãvØ*öŠ—’<[oÀ<ý+xú|#2•ž ËÌóν3{±¨¤ÿhmäsXçëë·8ã7§tŠ{Ǻ²è­•êÒ—ÈW€g­zVLàZô“¶ZÖ»¡¥hK? Ûö¥Ì ˜æªðÓVã´2uŸV×@ó‰Né´—ìºù}%ª½gt0— pƒïÕë·˜ƒ´ ‹%ˆÔU:§¸G¬¾ew罨\궦£òTqµ'qoÞ]¢L“f:Á'©åøïÛù:3šF—÷áas4Þç"^-¸q ³Û|ëC ŸjZ¿ó|e+n¸Ëw„ŽÙwÉW˜‚õôn}ˆ¼ßf(¿µÙy™uwÜèg‡7š„ËÉ@ɹïÅ…eQb[ƒ¿pu|ûà§ø^>bÃÔ¡37>÷w:(’èÇÔ½Ä8ð3äs:}£Ñ#  ]ñr¯þ+Ç ‹züSû£„[ób¹f‹ú—™5s?L;¢Ápâ­m'í™(´È]¿Šî%T8\í4Ývíß9_aIíê‹^Âr1›Îtá ×?§ÌŽJ.öìÊ¿¼TíàÔ§W´ÞoíËÈ[ONËÝ6ÿ)†äDLT…¾Œ/‚O²ý âïRÍùãªIõÐpÅ¿¹€óå ¢Âe3„­g ‘iTäkÄ- 1²ét3±E>6“ßÐJ´)fœºª…a²2¬þy‚îbé¬EÖl–:ÆGRWPÃ<ˆ&‡vUµ ‰ƒ P¦Í ;²oø~LŠth„vƒ ”5¢t+ccmFúÒ¼†¸íV~óþÕLØCh¦øSBq‰:¥Tå«q Z|ðw×-¹“hy7Ôó Êö~./•Š™^ÿî ¬¡-l™ 9ämÄL3û0ôËÍYìF9Ç®‡E5Fá¹.Ò±:ý/"w#“Òù올3r¡¤Ø#À³x$Ö\ë€F¾BbA8vðzµõ(vÁüg½¶ÛþјËã-_1QµµÇ°nv=Ò±¢%CÌd˃¹ð¶²cªq†¡Èš}Ìk®ê®n°kþ[zÜ8¹N|‰Ê8r.aÀf b|?tøx•4&Dö×ɽ*ç·$’jņçã–X6Ìɿ©ì]mÿº+ÇBR/ªU²CÝÙªÁb?.ÑäÛJg±Ëôpôæ]!¤›6Ü-¤àèÈx\ çÍ Š7“Ù¥³ hËÒÓ©Óçú֭ΆßD§å@jêÅ{á¾"àw®u•ÿç­fÄòd $ôš[Øœùÿæ¢3”µ{¬í¯²c ½(§0Â4¯U}T9a¡|è·òÕ°Slj{ëŒ@¶ì0ÖÀ{«wb1¦,}Rü凎,“¤¬ùjµéŽcnYŠõ)é¢qËæÚµÒbv¶H^üÔÖ”£C”Û'(Ám%¶ß=æa©ÀIA[W‡T“[“Ä|ĵÐY¡¼šêˆCloE¸ÝÝ]n¶F¹‘à2ž>÷çŠ^[™ ¥Ÿ"#lâÒ‚‰D¼’‰Á$«õþ]úzÁNÖÙ ‚Ëa¢—ïFï«ž™a@é´ÀsñË ÿÀê_ªëpSò sJ‡ŠÁlôì´¯ùöÇêúKéãÖN5ß·ùÞ=Œ§(ìc6è}JÐÇ ­q’eŒxŒ.9ŽgÎ|KÎ+›Õ†«„¶©:p™L†dñÈ´OÇè°p=B!•æC#rÉ»{±û¿#qÃ)Õš¾ÿ€³^ÒW¹aè?9§ØE²-‡÷(çþp{ÞɨFlšýÍ>œã™¼©È1·t€¿Ì<+6ÙfgjŒuýŠ«ˆNî4ý$¬n¸[‘SÎÝŽ“ÄYaZr“füjQ“ËeCηÂ)Jîè‹°¸Zd¢™ýHš†ú_…X$_¨úH®ˆDµ–h=ÉŸ™a=ÙµÙüG­Žü‹o• Æ>XåGÞÃÆ]‹¦ð.}Cˆ×ìn®ÎC¿z‹QL$÷>ä²KéZÞÒT¤+Û_1½)¢DmÜæ¿‘Üg¾·ˆí'±VŸ´ðõ¥b¶Á >C$’ÆÂÏ4P¼°PÔ§B—Š^ªÇ‹on »³,úGKŠmma!(I#fäåÑÄLš ÌïŽßûŒ•† ù÷ªô¯ÕOåkYØ/pZ"è’vûÉöJ§y)æ Ï•q»ûnÙlªÏŠ(!{VæÒb ÄgX켌­ˆê¼$áÙ8÷×yÙÿ&%S$6©<²Åë3Ç®q9lëhŽC=naJûïéÈezÜÒ þa£òKç4 9ü½‡TãØ>ÊÞ¬RóÅÚaä~N¡lÝs·æ÷»Â±/|W é  l7\ÐÒ¿åé™|ºïl±+Fo”Õ²“Ö[|ø¢Cþ|­aÀ;¸ ·¶yqáÌá—OµçùhEßh4z}GæáÔöž8þѹù.9÷Ý S÷¤E¨:†ÝÒÄEÙ2‰¤IÙÕÒ&ü”Ùq+R\3øg¤óJ nÕoéeo.d>’µKÑ}ÍTt¸ Ï›Ðò}u5Ú°¬Ž íü¼¬b¾aÐÍž_ U1ëà‘d7âOG‡GhcCòí=¯xRÃö×a Öêv›?érf"+K§õJeèì—’~Q¤+Bî,,eèÒƒ.È’C#V¦™h¥„¾BBÏô œocà¿“dVëÉéÖ‡Vp½f3Çl•˜’JÈÜð QE¦t$ ´åLß³ñ|%'6:ùò©°SÔèøÜÝþ”U4è9¿@üŠÙ羿Ã$Ñ‚‹©nwúA–,RN–Ù¥µ®’‡•Å=˜~\®¬:%BB"‰«í+I´t ‹;um7È‚×ÁZŒÚ\o•» R¼–Ö†cþ—HZâ”ÿéÒ¦»ý$‚—LÀ”f?ÖÀÑë:6W\yZ'ÉITÙ¸s³ïÆÐlgXÖI¯É"´Ïa7•ÍTÛUa3FÅõßL󦮻¬¼d÷xª¥Ê/Ƈ|æ ÿb;üÜZ´‘«=c¿bF–oá®™väÜ.¥6Û‚‰SFBÿM/«µÈIÞãÈBI«TO·\@Ý:M’QÔáÑz0à]d´æ Ï&䢤ÖcoÆ’dôIxiø&¤ŸòÆ•1;(È»k¡ÑCÙbººñ”åÇÚñwÁšÄjxÙýÜbzJ[ó苾kÝJ7 †e@ÁsyÍՃΑZ(úÆ#œ½É¼ç÷†&3׸¸®e%Où#[óV5tþ\¾²Xçävå%¢¥èdº›àE±‰´„. •6û”íô6ê«>… Y"šŸKD,—ø TâNÙ«Ì£åbòa¡FUwžTŒ|Æ?è>6{péà­¼(ÕSFrlÊ;aŠâá綊€¦óç3šÝ*ÎÄg•âQ×öûìÐÑ7KñÏAIÀ~ù`®FZ‹å¨1°¦)oa©l%á‡YŸ—;$ñî jru(s;K ÙÞê÷dº?ò¼"á1 „/_>v/²ëÎN }ØÔ@ŠÔ>»ƒ_0À·ó=Ð6åí" 15HùëMÍ¬Ü íК ÅN?¿¾Ÿv[Täíð–ß?nju®6Ímíã~lèƇn…ùò‚ÙŒaéö{qÈhíˆÒõKAüó•V³©žÌL`–½ºn¤ÚUh"Øú-,Ü͆sšê´ ä±|U ?Ú]0&¸IEó•÷„ºi“ûÜl惃!žs3ÑýwQd%¹2ôÈEW±·ÓúmjÐuò~2P0͘ßÞÃ#1ðÅôÖ¸ôjÕ5šBX©§\zµk•çV¾{ÔÖ &Z RbZ›ÏÈÕp¶+iÑ÷HuñöÅUq»Œä9ýmk¬[¶&ª¡¥µDøJYì`oíï–GÉ žö{×æUÄd´{s›‰OĉGhÇe©H'³Clj³‡ ?Õ¥ó٩ݦ™Õ}ƒfä¼/ ÞkÞ8WO[Ñ{M~ÏyþÄÝ’£×L[‰‹Ö;9ú‡”Ã=‹]R"ÎΑc3Æ-.åÚ•UTùaø3ùûUêÐwé?³6NÝRBS±¹ã›¾mø1éên¾Òÿg†|½¸Yb+‹´#à®+<% !RF@r]×™ÿÞv£ƒæ²s¡vžU¥MHØößÄa@gíE¸wx¬h*&-²d-±è´:è8ìR“¤µ…kýrÍZ—Ñ8߸Д*ïðÔì@’¯_—âv®Dûœ›Ìäu÷ãéÅ °þ¯iºêÓ¦øù€û`=×¾M kfÊŒœWƒ5õ?µO"R€†îª15Hoõlkk—O­ºc¯ÉJÒÙÁ†ü=^2³ðµtçò·1"Ę[WÁ·M.­ß4lï”üS\Ì+R÷òù"a•¥,Ô%™¢$ßúGJk¹#x€?x{ÙlÕ“t˜M½ÂIE-sðÏ]wZTY·º ¿¿ A ߇\*Ž¿¬‡É*hW©ôT 4f$íÏkkÍ©ø@iÀˆÛçT.n–Æ8ÖkµêÛøLÒÅ^Å>„xpI̤JΰãYÈ347a”_'Nåm€uMh'göo^sÇìÇ7·lŸs°ïÿ›é}ÏšUÙÝGkçÙ~J^¶uÍ–ƒœÆ^‘k[ijôDQ CÐÉ´úæ8[r\NOÎ*öÌ‚Ðn˜Ï›FÑëû¸xwŠ9/íE¡Ô¿Eåk<ÆY0­,ÇBq—cs*ï#·M’˜/úÌ¥÷Y¿Åi”ÝaYô˜ÑTYÌH‚ÌÛD‚¢ëNAŠ /õa.±cŠÞEŲb5yoLï…‹GëÜ'†£w­–“˜”å»B iñ>ßáy¯ bW7šEÙœ rû‹g˜R“#% cF¢xë é/T—U _س« ¢%‹ð˶YR,ó:ŠF]ºRF‹;4XPÔVÇVÅàmáÅ.RvS¡Kã,äOÍ0Èâ&θPZŠ¹X%õv¼;€´žÖ4¡|Y¨Oðò(¤asn¬g<¼|*Ëä&ˆB{ä¿Ò÷‹™#nXuþžœ-T¹Á˜B5cÝœ„s`‰ÃîΙ¬IöñÌZQe Že™…U×jêY¼Dl3• îáYå?Û@«t\Dçø*‹`»åx™.uÖSùÛD„ÉQf A¶\ñ¾½« ÈWY[Àj†j¼CX}®|®Ìe\bÅõž :TüF(`ù4RïÇtˆJÒ}Iš¢ÞvŠJÚ$ûR& J{´ÀÓ‡‰×ôÐD¸ì@²àÏðÏ¢OºåO=ÇŸ-Ì?Š¥Ôî «­î¹$-ŸÙ]Øv‰¤ÁM`Q(Ù¿Š·®ÆœW ›×,¯XL"RºYà«IÉÿJ®†§õ*ôw A4óvGøXÞü¸[÷Ùvý½€†!ÁUT!þ„eø…`c'þ?xÏVÅë•/$UŒ&oUU\³ ˆ&„göˆ9Ä?vãMJ”?ù¢É J%lr›ámß?_‚—Ý´p…ëcé‹«MܹZ¯ÊaÔ®Ûï_0<àËäLŸbã«Ï?®éó“jOÉ“•á ~¥¶ïþœƒNãZƒÒëÜÛÊ®ÛTÿ¼ßb’èAå'(¹È¤h>ÁœÏOÌø§d‚Ì9E/‰4“—$÷†lï]<ä¨ÐÛ²œÕ8ùb×RGS]ø`UÈB‡«=wófÕBžð4±Èõ²¾ø7‘ð. šÄF·(ÃÏß)O‹Ïªˆ9}¢Q£EéŸsŧ©b *Q±¸§$ Ò™•ŒÓwu7š~ïX-zÿ Œá†hç*§•Åš®ížÆ•×“_“ÓPžão#@Ì%En`JÞèÏmA¢=æØ–p¦‹æ¡úÞ.Ðâò|s^¾Êf»ŒA›I˜Ê E+™Õß6;à–|<ëÌÙm‚ºØ§ ¦âªÖ—§3H€ˆ,œ3˜PºÈd9¿Ã+ÆF!žD«k×ÌÆÅÀ¾Éz„6åj4G¹í} üO…Yr+tgî9œxPFtY‘ïnû² ç°fÚãdeËúÞíÊ_u>4[¢t»¢[?fÞ_ýMBÞפªÔ‘™á%n@1Uð÷±¶£1 v™x‚뵚ôºtà—A}hƒ®;ujb,© Ýxâñ/ƒÿËõí×Ìáö¡# uû ­Ã9NVF¹•0ˆ›¹m#q|PßÓTz~æóÆk¶¾>Åâ.ƒz{nEYÏ¿`¤åÏ9oÄ%z‘ót‰“Ú[/ôLx'/Åárðb |Ž½)V„ø­O°4yæǵ þ&I_f½õë°ãl0r¼únZè’„j·f/¦ïóØ^+›­E8Ärè¥ýxc°·mvê²¥iw&é‘Ó…èäU©_ËrÜRÁö>úoöb8ö£:ƒH"xÏ&mR58={ÎÅO„;);[°l¤‰¼±v„›H ix¶q~°„à¹AÙgË®Ÿ‡8œÑ:÷B¸—;˜’LÌ™,Кt-‘€<>k®¥m¯Èž Üwèï:B‡/ŒŸµ h~‹½Æ›ÔtªñÝjÕ œ”™„ƒáˆtEõB?TóþænŸÒ‡ìü®è¹å.âBð·ï..¹yvv±÷·ôƒ±JÍxzàF|ñ,kš}‚êù¦Üi"¬9™œV´ª%Œ= ÏJñ…£ô«*í‚PÒðÁç{J.ÐðÍø%;wÏô;ҽŤ4Ã:å£3ÝÝ–Rú?(¦ŽSòR²:¸@¶h²¦å _ºÈtѸ Úò‘œ°†ò¿i÷oh¯§áo)¡#˜ë¢Sä%×…–… ÜÜõŠôÓp%wØÎwâØÿ7Ä“(â¬oâlI"=Ó Ïþre~3•/œ%…j+n> i4^½õ%ïŽÞÒ5é2w.ššpZ™^sô&Ã6.taïºÒé2öÅsíQ$¶µN° <2–ÌÜra„’…¸­@„^üßÓÌ_êÛr|s+­ RXn“{Â$Âu(O›Ä~ œkHÞõ"¼ò£^Ë *;­7Ót[¼'™c#À$|¶åÖGÎ \|Vc2nïî8&öR¥¶láT}gn©Rª‚´#fJq ùÞsE/«Ykx'R8ã±”§wfg®ÔŠ”»¿TC_oäàÿ^Å 4'–Ÿ1XÉlO˜èBq?ƒ µ ºä´ÇV5æø5 N.â‰sƒxÔueQЯ§ReÑé„þ¾§eÉPñæé%bÕ£Ö»?qwyØـȂfaˆþ×þ¾\ÝO† žàø^Ì ßoB` Ng"1hO¥rºÆ:kõÝ)yþ|<> ¨MKdâö¸ª!ëî‰K9l“'LäŸzÇ_À‹åíûˆ‘Ñð‡…ÀÅPùºHkÍpÁ¸»¹˜¥XIÀ›Fiò,× |ÈhÈàâ^aý‡Òކlj£ã”ANYR~äŸVvHiŲ¹o‡dZA‰YŠAŒiVóÿÛøÄäΑ|>U8›ñ­° ÅÚî×;ÐW9.Ú ¯â@T89ë§aÑöø[@¢OÑqó#P„:oå$U°ø\ƒ±I,‚n ‘YG_üºçý¶”€C¸“@” kË2ÍVÃg;I¹ðÁÜóÏ;©GD›}…±HŠßÑ…-’S n:owKÖ‹:ì$7(í"æBsÜô–ˆL͵Œ>ûøЫwx ƒ õx¤f¸ÃÆEÙôédè–ðÜúŸzM¡éÛ6î?H~A&j‘ÓŸëd%<Ä+ŠaVüyÐdêæ¼Ãà-Œ š8¸ èõTgÆ˺ÝKž Ÿ®~Ï°ÆîZGêšm–p™œ¯–tM÷réë¸]ˆØ]Ø«ËÚÌV6@Ç:K›ˆšÇuUK¥"0Àl6Ki{ Å󜉄ý·Ðº¦óBÏ39±oð?¤Þ_ßäé›6Œ×]°[­p?Y3Ù„5$(£¥4Ž#ÏÞa«æYèD&ÚÑ&)M¢fËô Û!Ù)÷1békuNp*É+‰Õ€Ãzƒ^(aÞ–«±„G±ý'0s˜“«ùðÔ‡-¡3¼?l!¤*S>¿“5Ì&6´ÃAaCMB¡d!u;düùÌø/É®9 ‚ÃŽl‹Ë;ÜT•08îâJÊœð|m]™8âí÷¸2©‚°[*J•ä‰Ç,Ùm˜ˆ j'Þ ¶Ï§Âfçob–,Kü—s¿dÝŸƒý Âþ‰–8ñtwÝ—3M/x::‰ë½2qìx ¤¨Ä6»ÌÛò@y ©Uapê'"@Ê_¼gm×HŽKäÔé'õÇÒ ôlòñºëEŸ²«Æä7 ¬ä´3‡-÷§)ÂÄæ‰Þðhûìå7SŠ‘‹©–„Q‚»^2Sp6C¶Ñ0.·íŠ”nÉg‚ôק}Òe…»Žcoñ˜“>ÈÐÞͪNZ¡âÑ”¶V¯¢øýò«ã4D®Öê;?-ý ¶uX‹ƒöÝIŽåÛçU9ö™Ç°±[o[T"£K²¬EúlhW¹ 0Ú&…|+¬¥)ÑÖ]ƒ(öŸÅ.®s£o(HyÈ—&uO.Kò¥¦ªðJà=þTÖ¦=€>¤%¯Õvù~8€ò«ºÈêzØdÔë²NÑIá‡s“¥:Ñ"sçÑîÞA/Æ¥ƒKd7uÌ“TÔ´³ÀâJ¦D3Ñ(%ñpg…–Ãz°Á-Üd´ÕVÓFÊœh}þL|YìäSƒYJ þâÉ»ƒ¯em)©ÎjˆzúµGdÔZìó&/ûKE¼¢ï ˆ —«!–b÷{E^ÐØ߸HåiÒ¦î“ɺû¥ïƒÀMpß’¶(³… *‡´ÑtiØa…Ž ñ!f }øŸ‹!rš’ &¶ƒÙÞxnäêÙ„~d:X‹Š¢³¿» oziRÖïŒ<þ@ÝQýâÃlø¥[!ö7zaõ > #[P[ݦ .˜¶mbš®|³Ý[;¸Úm6‘djû&ëP®×Œxd"È÷¼-Ü$é€v eL‘•8›OOösJÇ"tÿ¡²ÜöN$[ÀŽ’¾™K¹ëÓÝ —#5Æ+«·w‡§^ª9äþlew Á‰Œ ¡ÀúR‡öäËõîóÃG= Ѐ*á0ÖŠVŽ™œÇHW“)7õµñ¹~ ®åÙ¢ñ ô$Þ~¢Z¬þGàAŠïÅ^ç ö‘uÆ_c··ìôM8©Ô:Ý!”aV]rúûmÄubív-õ©Êâ:t,}|r̺ؠ& 1øŽ›¥¤qÖÿ>CØ=›ž[ŠªþÊåtÜýú^j{yþé“^­ÌªHæ´Åë½z´¹VnÏQê` öÚÏh+ðÞ¶[ߺÝFEE˜@á­ÛÁ–«j¥ùˆ÷þíèN‹g€Û+fêÝ3јû'dNWIVù¶Cµ¿ æ³±Üáø‡«ùÜY ϸäæSqÈæ•E&ó 7[¶ÚˆŒI{¸1ŽÌ[;ؤ‹EBp¤ƒÃb˜ð ÓAÒ—ŠEï0½ÄóŠðì˜9$Ãà?2a Ÿ=³ÝYžhVu3‘ÀlÞU.47Lv³(‘cá›ï$÷¨Yßý«ÎÆ©2Bt“õ§ó„"±eʆžÙÕñŠœ?xØ6MNɶŸáêç!ìäÓ­$A_¶ÑÑq«PYùš.¥Ö0ÞæR\E ê~Ù^ˆÈUøÆE2†$ê¶hnãn#ãXçTwP˜6 ïgi²DàbÌĆÖäÐÈl-\öWªR«>1؈L±4^=%]O»™‘vR?k ÍÒ_³Œ‚vŸ©Èê Dé#l&ñe¦²VjÓi¢˜^3 ýúž÷MúŸ0ê¶0BÎ ¹±Â„ÇXâ|iÑßݼ¤”dVVú÷Ù!œ˜»‘"ŸiÙÕÌ£gÄþ3˜áÿ´¹Ç”ã+Ý7¸>PK- (ÅÁ{á«»ñNEkg®uã©Þåâ·-¶Ã›È DSØŸ(büp¢2Il·Ìi§GõéÀNƒçÝtÐíýÓS>÷ÜÀéX€/øçGjîN¬ä]= ŠõZ`›eð¸úSוÌÄ %:¹n‹ô n Û>ˆåi’WÕÆ4Z£‰…Q¿\L#Ž"[=œD „ÞñÔ惓Auÿ"\ŸøÙó‘+B˜ÎŠS“h,æìßí9¬ïõ§†-%NéùåUFójýðŸ"½Z•*¹[Zghñ+5vQ®'µOšÿ¦[ímäOœášJÇ°Prí5"“]Í1DdÌ\‡`ÃwîȦíðíd¹¬ôå߉oôPë$™†ª7q<} 7œEŠê­XјÀÂsE@¿®Î®™\ì¸Ò[tÏ­A3˜Æ$òÜ">4XjƱó;…Ķ[ÂðZ H¸©"çY(…diÊ@-h2)ÓøŽ*ùSÊœ·„Î †ÊN㇙ Q—·¡‡0€¤-¯Ÿø!‡fh«Øɲéþ-¦;d‹“&þ׸§IÕ·¯™ÛõÜÍB6Msî òœ©Éy¶ Ï{¼²<§i•,úÂ?&çñÉëЧs ,#ÉþQAB¯çÆhQTµãñr@¶r Âw€n„¯«É!ÐÔRÚ¸<¼ ÇVm®*dfÐu8¶ð{_—ILÐ#JK[ý o®q–sÞ8ÙùCK–œˆ‘œÑçâ•|”Œtè5Õ] ng„Æ™ÞìÎí“l¸)Ùœ/×:©°!³w|åDW®qq63ÀQí2¨[wó`ŽOÊxTÅÎíèL'Õõ´ä¯†°0¨®ß¸HŽM€mœô÷–TI PÖdÿtÀkb}ý¾@ØwË,N“ßBÈ+ÕÀ(ÆÕNeŒ‡U¦¯– NHJ²ÃºÛÝÜ«òçÁVêï߇Õ?÷7Ñc:Ó¢ÎõòÍþ>kw5÷`›©½ÿB¬¸§¤) ‚¼Õá=¦ï£&Q”~–ıÃIñ ÈHÌÌ)  *a]4ÙAEŒòj“‚Ðá-OÒáýþ:?eä­·Ó ךÇËÅÀ4+/P­hLÓkõmiB·_BÒ{²Jk¨Þ\€~h“X¬àÏß;m l³pűh%Ó‘ž„èâÊþâeÛMZ@¹dýžÛN¢Š¤€Ý1twS4˜‡€&$ĈÚ0$Ço:@† ðDáÝ?$.ÆG ¯gÖåÅóµ÷4»{ÿkqŸ -Á›ð5UÉ$VË1iY2#˱1éY7™›Kq͉T6üè¢ €©¸ÊÿLïv ‚Ó(nî”ûõL|ÍL’?­ãdñê{^€}‹ƒˆÎòtÏ6/¡Ä àV'ÖA»t|*-Õ•®O6mÃXÄÐ Mö”MÔðûºl°o3.¨"J\ Ó«&Ðò›•qIx˜˜ó ˆÑB!idEm¤óUrÍG©¾øÒIͪqµu%Ý @W¿ºÞ¶Ð±ÕÀÞ˜$¥ÍÒâeÜÌÓƒ2”Šb[áPر⿌ú'ÆÊÖP½•|r òLº4g2jiO¢õ¶òß5,ýÙ=˜L>K¤9ºlhêtÒáæiFì"yM¯û*ÑÚI?+‰µçAñ wAœ‚X•þæ‹bñì²Îä„R)@ŒhÏ® ÖT¤2“5pZfZoŽ«:ÂUâÏWIæܦô1ú˜ãñ¼tÅéb̤¾@€­âaÛžuß«‚Z‰Mz1ù§Èü„;)†×Å™Ó öm7Tjçã©FÐBLÞçmÂ^ù@›ç7Ý~Š„?;§‹ï<5'ýs×â˜*#µÊ/u”8guUuĨ…n¢ {þƒÚc†™ {‘QÃÒ'âœ}μòñîægWh‰Ø!·Ã˜7IêõGJ@f7žH¼Oˆ›ÃLš*ß;¹VjãõªUõM«+‘PµjÀKÎVäiN±W-P…à`›é@ôHC|€ö–)Þ–oz·Î»V"˜¾ÍÀ43؃eŹäŽ¬€„+·ãÐ墠G,è,3kéÒeáAþ×ܳ!H‚$£Æb hÒS7´§Nwrý4÷*ˆÌêõ’¬¹C'Òú0œÞs›`Á§%ÝÄoƒDXÙþ#¤[Uò¯ÐÇ»ÎFî9}îŽá}ÕSwÈè%Ç L¤¶}OÆGk\’û ¶[ºûxºÆNð‚.ŽR¦ÈÖ™äZ ©+ñ™ÊuF'Ī\€¿:6§°^Šrö}”«MˆÝ槨s¬\1%??’üïµdá \ü±;Yæu í&X,"“4ûÍ8˜FÃ;KoÍø#íŸx`w/òš{Ö­R«Qè·,GM¼…IòèÐio÷Ö,»uõqõ]y‰g^î[ðßSijÝ͉¨…ø\Þ—m cÅZ>å¿iFoÈd(( ac:¨=+Á™Q¬Ùë*宂ªø>ï®^`xA§ÝüدW‡ÙÖ\ ˆ¶÷l3 :³«á‘ g¶–"jH¢í EÈ~;ød•ŒLTbÐ[3׊& 0à~9H3~ÇX8SÁ~ûñ¹ÅÖë³èD)Uø6ÿì:+yýÄ‹n60ô1!"6¯\I›J_lÎôÛŸ4{ÂL§mß ìRóŠäYÿŒ†š:íè¯/½‘é#N¡K¥«ÏDpàs©öâA‘\:,ƒƒ,+ ·ÃŠSþšAÁĹ·¶Nâæõ†gŸ³ø£[à=Ô‚; ´`‰úèK¥*˜®‰âcôÚ7¤³$/bœº~nÇ"³/Ó"gonJ9ûÞvÍÓ¡’& _ÒÆåÞN‡“xõQÜ>®º- ºù–öÒ¾ßÿ~—v”]¿tÆ×ÞØ,Qjð¿ŽLtyök×NÔdÞ_õr×ö‡§ý6l«w®ÁÃÖ«áb­²3àJ°B·P‡. ÏmùÈ„ùsä¢Ëð÷÷,âÔfÊ vÃÁ0mó€pœâ~¦«HÔ*æ0­.ùd9Õ[ayžMæuä2 Î.9ϵŠ·ÇÜ]ëY¾è®“ œ†¶ º'9µm½¹.ãÔìŽSE³óùß|År“ÆÚГÖ8m²‰lÅè( ÷y“Ó$×Me`AÝõûci™Ø…¼Wkãd+!c áC£¿Š]¹pì^y6³$—±w¨Õ¬ðÒiÎoªo°˜yºG+aa(6ªñôwF%Ù ßœqe¡AÌÒ[à&ü) £ôæ¼­aÖ~eÅ==ƒ«zÚ5F¼?Tz(šLùWw†2)Ü£kÄ#Â…w êó|Õh°g‹}ÃjvZ<]e¶)Xh ¯ #½RÖ VàªÙ£'ÇŽB$ŠBM û"€ÂíödKò(ÄŠ(ùs á w´Õ³ÀªÅȉí'žñȤÜúÓ¸2MUªç0vÛ3 S,_®©…xª2Ù2F%(õõAÜÇh4<ØŠÆ^¬Š°û¼‚4àÚ=T‹0™y[ìávdÊ®¹ (ú1ê®Kl†ch¤)mðæSH°ø4Ð¥LÃD7ø݇¡óšß¥Š,“=¦sãYˆùPT-¡â?ÅJm–Ç P_4Í´ m«†ûaL¤®qر;¿sœä(8;?×µßÁñ°òûJË-”xÔu÷â±àu÷HÝê=”Fku'Toàˆ©6›;Ј Q× ;˜|ò䫸µ=Š¬•°.¡Ý¢\&sëµoZa«÷s¡BeS®£ŒÏ2”|ÖZ¼Cp­ ápŒˆ È?– z›ÍUò ÿÚ†®Ý,‚Ûj6‰7vR< êˆBb©,¤#9qN5™žÊAöWüˆgáW³µ;t¤:Ûak´] €ÑI¹¨Àäh}^O¾m­«…8N Pälgt ¾:þØA†Ï¦Ûå¥H¼ù†RmŠûÆýGPóôÙ˜ †-@ɶo2e‰cŠZðýðÒ8¥l¦$tÏ·Þ%ø9`B–Ž/Þ'ñ$3Ñ@Ð_¤T”®ýÑÆÔƒœºÜ:¯Ž‰:GYk2ôøRÀÿJ'{½ y%uÛT|Â$Å :ÔÏ  ñRûe’ ˜ùØŸ~ʵ8ôÕxÙFõÞÖrFµjéTTmNË@„Î^ÂÂç]ÔC}¾vDc'×hÌÍSÕn’Œü®2n5«eö¿M?€øKi=^¢º<;Çe¯û@µ)žÆ‘GŒZzY÷ý0 Ãý‡e8iÖRq™WØ`× Þ\ç>_ð-ÀoЗâþÕóiüÿ jªUp<gÜ}q‰äŠ ¬ôÅ{ÂÖ631r(nY~;¹¹ ¡Üt#´õnCüÝiìF*‘20äѪ‚—˜â³E“2mZAJÑjaQé˜ÏF„*÷ÞX˜‚‹û˜YUô5-ÂéÁã§>‡dø/‹[Wó_꺤²pH‚ÆæsñvGèP–'ÉòtFpÄÑ(éÒøiE2o]¥q©ÚÞ_Ic'êëz‰½º ÑÍa@N­¥ l:§·Ø+,•”»˜½PñOâ©Ÿ#+Á1²,Œ.%æ}߃ö°u½Àq¢äŒ”BÅ¡¦l¼Y8”sºÆ|ö†W¯êÕ­8k/’ #Ë¿O9Tß]  ˆ…ÂÚŸƒ§ÄúßEDo6çÕ Ë3=sZ½XCìbò᢫žK>2“¯ïfÆjz#GwâÚ?Õ¡fEµn”ä Ê¡€Û3}m˜kX ºÙ`ô8ô$Mí9é?ç8%bžaH ’€èªdìnbœŽè@Z6;†Ë%èÛì)W³ów„ÿ¤&‡Ç·È‚™xôÿTÀË'PìiöÒµ Êrtiy‹¦½ˆ2¹K v­ÙJßôݘl“QÙ”G`[Éðg¥²ÏXQLìSüØ«ëI ÃË—Þä?·¼£ÖiÄDÓ5üÎ♽˜V°Õå·¢ˆ[OàŠ¶kñlب$å"†·Øñì& BK[l5Z¨€ê=!qÌä«yª[4 7<«}M%Í ¸âɨÎ;œÙµ¥PÙf»Œ?ßnï@x…­B+Ymé.ú9B+t¶e·x˜¢}œÓŠUú4yâ]=õ«É¤|†á«Ñ¦iëé'¤É#@oøÄlGý*BĆŸ÷WÙGRl.d³;g໩Ž?$n`¤‡ªuÆSÌ.ˆtÌØ8èc0“ž>lôdÕ[Ž'ý_×Ñêù•-)a/ÃÏ †+9¬µã^œýoÝ¥]ŠmìnÝp-’¤²àÎñ£™Ì@èé[¼—»†šzüб~¿EѱN f‚íÝÞŠªÕÒŽî$jÝÔ_]aw•kÚ!x“¶º­äÃsÍD–å(‚÷ 3ù óú¿ým4{šš^*ÆM²à›'føi1+qˆôº\Mö(|ÃåkVvÎ2àM“Ø™Jš©³o¼¯KÉ6{<¢øÝ[t±›‘—‹†±!ˆ“¼ÒJ÷jÂwÒÍa19ÄÝ—Óª}ÕÆkz L©gyBä=$=08{&HÍ5!²[½A ä ñYh\»[‹øU…ée{4×Cãø‘k°~ÍfCm°'aÆ|ÙËþqt„>*6¬É\ï’•p~}û@§NRŸîsò`*ÿ€.YXLÊ3£‚ Íî¾ÏC½¥zlÄÕþÙìG¾Í{JTÿ©¨ áà ®ãhÒ´G÷±j®+†E\cë«Ö @bœ-³&o)ÁHØqîVŸâ`+Çg^ºÑîÂöûæªá}Às.¼ µf@á¿ñµ ~˜Å¢­(%ÉÙþ°–R#Ñ_Äùgä8ØBP¿Çg³£‘ ŒQü%E†˜öF1TÅ]ÚÐ)Õ—ÅÞ ÍÙZMà•…Ùê«  8+ŸX¾ÿ¼fXÞ³Ÿû¸2ð»H"Òpg°|»æ¹–ûÜ5••Û(&8wÙ „‹‘ÈXÙ„¸sXø#H$ë‰Ý*q£ë>ˆâ¶ªä¡…eY©ÇjP4­E`$Úq¿‹û#˜zÄöÞïé€Ãìt\ŽR{*HçanØt&œûõ1·“?ÇÈú˜þ {ñÃvHÿ4fÿO }£çw%?£#þ¿®Ÿ¦œD/‚#ßšÞâÛÝõ°$7Ïÿ ’kÜ€ÆÎä°žIû-ߊ£žy”zäâèMÐ@ÀRŒUWs×ên­.ìJ&çç§øÖÜàfZÞ Ñ­št,5"€V“á¿Ä§w‹úd8âeA*ååhT®H8ñY‚G³GùœBDV^ÀÄE«¹ÆG>{P2< >ÆWÃ6 ­ƒÎ¬Æ[2;MÝ0 {ØÁ,ú¥æÉ ¤Br¢°ýf<¾JºØúŠŒÏŠqà*®c:år<î GJ÷x† ±SýæäP:š¡{ÝUƒŽø¯FÅâÎT8ÑÆP›¶ñeˆ¨‰Rç'”3PÒÅïzæáÄÒw¢놂i/õƬ9fªñhc´ŽDŠ¡N4ù +Ж! á`ðó£Šûž·êBÕס½iÎs¿²ÝCg@v¼ú{ÏŒ!ÊSíÑ=½“Ìûe¯ï$ªc²W}òFYh-#Æ?Íô¯èsþ/T¸l'²ÜÑV¨_Ô›jæ¤üpý$í“ ›?r v²±¼ø†$lÈÉÀ{á™ÕÐOö%>–m¡˜nÍ·ë£'¬ã5p%W² öÆ„¡LîUérô¸ªÉNíŒÉ»?±Vz <‰þÐýàs4l=ÇëÀ¸üwe-áF·Ø›h¼ÊÒ:.š‰¸™öV ‡Hw¸5´[sÎX>;„æ¼ÍD©>’†•èÅ—Wp/Å9Fß×éùQ+¸¨iª`.6„UŸâè?¦ÉwòšH~šå½qÆ¿È^-箢dìc¶³b¯ò$Íah: Ÿô({¡Ra®wð4F‹du!.† ÚØLÜÀ]°×œqf‹à ·»µØ­µÆ¥³\”᩸ðøp¤P¥„D0<ËU1m¥Œº2³± ë‡6̘ ò×9ÎFÔ$u}ò]9¸eÎO|ÓˆÂÈ DŸS*–‚†žiµjy2*Ä^ƒj´¹Š2©ÝèJ‘}o‡²¼Å´˜}£-\tŸ­Òð%f@yŸ{³"Gã^ðòµ©Hn²$%~%Ã(Vî LΆð¤¦Íc­5p¿r‹âçÖcÅ{Tÿ*>ŠF‘‚©}jæOà>6ÍÝS´®TuÔ+tª„OK¾GhÞ<ï3Ž|Óy—rh£óÛ Ê¡¿Í‡rŒ=²éŸãœØm?#ïO]\Lƒª¨o¾ZòÒ¶©óý÷â¶$$@OÍL©Ô°V7gdÅý<æ2@‘ªVfûݤºy©¾ìLÄGª„cÖW¿CŒ‘Áƒfw“"3!š~ÔMU¯)õÑñYúD“ˆ^×pêhéð×:Üc†®ýú{øž\ýõŠ,ÁrãÓÿ†S”_¦Ï‚„û_W1…}1j,¢º^ZÆ·91D´' 3µÎÉ%ÿ°~am·«)£ø³`N¥«&Tµd¡Õ¶-4Ä»R4?Y&Úý.þ0V»î™Hqn` Ü¡ûÕKñ”·mŽ~¹˜f–dJ±}Á¿Äby<³®GÖRôöË DåŸÒÏAÊ%±&Í,0‚Ãìaí>Ϲ‰Î~m45øïgúUñ$ÚþØIî.%®màÙÙ·öNH¿ý$óA[ž`¦oémd‡þGz35V[æ Uü]œšÏ¦÷Q«G¦[­ÄFÑ ,µø½ÎjÇÆ0HhviT"q d¤+‹=urõU¾~Ws>|à±$îleä-mãÊ…I Žþö(lÓZO \ñÑ£óiÙ«¡*·^Î4~yÀ:`Bè¢Ð¤(Ú È&dÈ…ŸÚ¢òž¬“)„Žåu_®ÎÎ]¶ö:¢\UšÉçá:´œ m{ûF*–k­öa»K‹õø6¤ KŽV;²áÙ’dÁ'¹h¬ kÆeûT´Ü Î(gÁÄ;lRÐßzF«i=‡À•+€¡ýÕr¥5F—kB[ò¤ðO<Ö qT”+°,ÐÉ¡4â£#YSPŠ'ñûÏ:Þ ‘êáQªYH%ªã÷\7éƉøÃ/äľ’ãH­$‰| Æ8ÍÕRÂ?=‡ 9«è—êœÙ# q:á…'ÛìiôK‰~±ª^ª·+t¢™© Dy ~Ý.K`þuîó ŒÙù×¹°F eáK \ËŠIU(§SöéÖõÉ—I±sRàÈé~]džK‚%t«Rè6:ü;ï§2ª¾<4AyDB[=„‹Ÿ µC…^)™k zw+¦ÃÐ\ššÏUû Ûô!8?Ü(™Ž©zðÓsÔ'¯¬€X†#!K’kåüî$áØ´Ë„c/3¢?Æy¥ö¯²,ýÎz³ªÐêM¡Í1èŽôÝaçtS($Ù`¶ç딨óCèQÝäeTm=±m‡œ;ƒH#BYضfæWÈÉ2qteß }—"ZÁiA?†Œ¡OïT½®t&…q–M¡mâ~­ÆLUzxG:Oû‰8Ñ/‚‚ì=”qm¢nz&Eˆ¯xnÌ=Ë|± ÃJdœÚïÕ)ä´ðIÌ üãJ+駄°`ÅöE? J¤ÓâÂYÁΧÈäüðL¶‡Ç‘,!€¬Ò¿B}—›.Ý%F¤F´ôµ£KRöâez„§À¥+^áÔ˜äóãÖ ×jydùÿ‰²P P8—…ƒ¸Ò‰@OFFÑ5§AN¿ˆûþÈ /ñÐõ~ž?Ž¥w¿–˜wÄ:Ë›ÏÆñÃ!Þ.¶ú¹h¯Z6šÙGŽ›˜t¤x@à6°òtÆ%=ñé[½ýµû%+Çhcl{jÆÎ4ãg÷ý}©Kʈ9 {ÓPŸbÛª¨G·gˆÌûÉA±ÄËІ³V“çtŽŽ^Ãß9ACW\˯ O›aLû›jf6”Ó0-R{\KPÁ·àòΛ)ƒ)w…Ãå GþœmÎâõ¿™vüä÷p¾1êó×W¡àN"¾§pŒ¯÷¥hõ,÷2›jÜqLçzÛøJn¹xEa¤ú j³Ç>6¢ÑÄÕ#0E®$él<˜yXöÝ'îÙÇݲüu Ü#²å {Wã&íºðí‡)4¡¾«2ÆšqU\¨Cø¹+xó³Ù¹e›™IÆ'àJ0Š¼Av®„—¯çLSáj#6P,;ùùl_>ëù‹… ¯Â>Êmh¾– Û_îNAy_³Åê‚õ 9QÁ/©éI;GAnuÀØÇ4Ã7‰Üám×ȧŸ cù[ºÙó° mp)\/üÖÍJ MêÑnÖ ™l™¤•îï¾Ô¢N¤³A>I¸»Ù¯ UÓB¼”Ð<àƦ®G±Ÿ$›€¶kÙNʳâ>í‰7’]€‰Ñrú( ׺š?LÌ€ ÕÊï×­cã:©?òXÓEkH„|¤ƒsÓoCÈ$x÷PAn~òÊ÷¿lÈÀ×üYŠlâ3Ïv$·ù®k‚kÂQ•fn·ܱšÍ`¥Ì¾â[ÇÐâI+'ÒAf´:×4¯`l›£nA Çí¨/“ãC¶T3ñÑ–¹ã ?ÙÓiE´:V#¹ÃI¬¢Í#ýìÚªÓAd3 & ×⑤{ó0–Z;hØ¥´òÍ2Ï,#’Ac{&‰¿`ž ë¡/eZ T–-ªQiüúÒU°qLÞT«-0$ž7s].uÇGÌüyáVxäé^³’¶DýÔ?ß¼K{Aä—øèyDT ½ú™Bb¤nÍ-´Ì#l¼–¤yvòÈväÐS§¦]"DƒÂÇÌÌeÜë2.%Có»jßQ)|Tÿêjм×÷w{» D­©ëAN-¬¾˜S¡¢µø\aàp ˜¤èE«\öèuÀœÚlª¯‚yÜ¿s9šˆÁ”ãâýìwu4Þ+ÅUª(©|qñù>…·Ô „›\¡W>üiJbÖÀJC}¾bÀù§Õj?Ô@¼ .{Pcáãó̵]¦ Ì!È‚ßJÝ|ûp)wLÿ$@ºœ(Ž1ÀL(Å «_†R)fú V¬§*˜T»Ešj±Iýå„)Ò[t˜ÎúÈ•iZ´í‹f—Ò³œ¶$÷ájjít_ñ2·k®éãÐ|#g¯7°4ÍͺŒ"ˆßÄz^ üõ–ß:×£<Í Ó)¬vD¡ÞZatŠ“wpö<ûóK½jü èù62‰Å}¾ˆ÷»`ëž¹< ¤)‡$LŠ‡°¸À›…°¦»åFBI¼*VeUÉÊII»_Ù9Jn…IÚv7ñ–*CCkcˆ‹n?kÔ´ÿ¼&çõ}j 9Ã6ø¶ˆXÇçüiïgÉŸÛó´’c9KFƒ¸—šš´PÎÂÛ†ö½È·•£þjò+aYÜô¢È¥‡Màsðx/åtû©ä©¹G\¨]õv²¬ð ?}ôQÈæÑÑÞИŸNK‰Ëd›OG°xŽ °DŒƒ‰«óèu[±ªhzëû"y¹­¹*€§'`eïÁ+˜m^^2Û­TëÍ=þÔM:Ç.|mKíõ‘ ùŽe@™Ë¿ 1ìµ=mraØ°‡û0 á‘`µ„ hŸË±LÐqh%g\á0 ÒÕ³²7Ó Â+©¥†œDû)[Òããóä^ÈäÁ6«ü.<¯&þ‡‘ïX-Áµ˜‚ó³W Ó®šÅÞƒxvšàá‚ÐxYáüS ÀÈo©ôA‘C?üþø6ˆó"’]’)F8{š4_?ÏcH… ïÕtbŠ«aziÑë]ýØX´qè>MZéƒ|ç•H•Œ!Ýak;¨[!>!àZϲðê(°ÂÎ2bÑ 'M­¾X¡Yv˜Ÿ5ê––Pª''’ÃMç²áÛ—ÝadÒ­qÅ°€<™Ç)WÚe óäXÄÈbþæ–`[¾cÞÔHHš@Ó»…q!é:Aw4gLߎ¶®Øܶ³Ÿ[î‹šH;/ƒÝ(ÿ}½•{ºÄo+'ªý,ys -/¯„%Οï}~¾ìj±_IT\cÈ6³^$…>#F–ËÝ7ôÊç +MCFöN…ûæ!eJç0a¾âÉ0?þ*[z×­ÝÁö€ÖWd®´ÉžGÞ‹©ójñu’¶aé®ôæ#å€]Nö Z2yïR„ļW7J­Þ¯µåå5¦d0¬|šCMm<|/}K† ”t\½››x/¨‹<²ï0ô˜T GN¡gë!ô©ïmÄ7³:ån†d,äÑ9dⵋñ µ¸ïGÁÒÚ”wQcOîŒ~Ç<ÿ’.ñ¡wîÏ/æw•ô=‘WÀþ¾TqñîÌ©¯¢²ƒg7% èåç¹z{w ÓÐW‘¶On^¡]¬v`Ú½$Lhî}ÿ«Õ`ú| ÖÎ/·¤ÿ‘A¾äâlrüåëÛ°?X¼Çréƒ7‰¼ ᧜æ¼õðG h“×·NÊ®¹e½H•K½ŒÁ ѵ„>ìZkokÎàõÞéW×ëpÕBœZjŸx1³ ¬$ØÔ\Ñÿa£1¤?¿€à=’øøHqTûý£­»nöøyTš‹ç(:u Rÿ'Ö§ñ Úì¿´vM•Üë*ø#¡2“Ò"áCþÍHÕjV8h¿ P_9êÇx„ÌßG낵F2£ðåãÀpå0>=þÓ!Ü{†-°ë›:.ABI?‚YX6Â\šÁï»0ÒæX¼ëð¬Çhc#CôÒóçû›",ìH4žU½RQ&ñEº‹‘”†¶tˆýŸ7­zÇ¢dts~,ã1ÌIf}.ˆ#]G›Þð¸0ß2Ž‰G+Ìa/ò¸·_’ï[ÂWݤϨÀxÏáDuYQIòá°hÎPÙ¥æ›4 »mÃ2ñ‰î,üô:OÆÃ2jÇsD—@JË( !%í%¦‹˜¥Y#Ñ„U!Í ÜÕ/;µ[*IîQi ¾s™õ*ÕPáØZØÄs-‡„‘7“î§ÈóïÓ [U\µÉy•jÞ8”4J1¸´™øTR¶ög Süã[Ó78ZäÞº¼Z`õòd³0éñ ‚‘Ñèvd`&ƒ¬~ĉÊKhog6ƒ õŒ-‚{ãZ­Ce™ƒèÅÑdYOzEĺ²Å2CCÞ2ùLÆÚMˆ( ëBl·ŠŽ¨Çý ï+ª‹-Ô“¶;ŠJμœ®·!ÎïåÅ:=7W<»ÿßÙcww˜1ý2ÑRÀ÷§]¥ª.Ù}ø©²3#K°#xÿº+èDÆ6ó¾Fü,ªV;{bmŽÉÝV‰ÍÜiê ã ñF"HÛš{£©Ö•„×MÓQÚ†‰;ÐN¨Óhµ5©ÜëKõaÅ¿­(W,P@ã†ðj—±‚ÎCrWRà§IWª³zèºf¨Çà Êås…ªGâ8(€¹…1ÀDÛ•öd­ ûtÊÂë¡ 2ÄÎë|v’Yšâ_BÌá'hõ˜ÐÉ,ìå‚&‰©y†ä Kfûà•—âòÁ^s¨ºEÚO—1gô—”1&œ:õÙ¿5¼æÎDzŒ’Ê Ò£tï6ZQ÷X]yc/3X•ñkê2eª~¶ÇƆ³öâËÊØ ùÎG”Š‰¯ä•;Àkü%¾žœ€.ô>k®Gèsô¶:E‰m/ž¡Ô•··Ç¯MSs3/ä¿È7Ù¹F³™^ÙlG¾b¶èŒ5ÂÞÎ)³ž gëmA“ÖL¹÷^h‰Y·Å’»s€Ž!ºÞ iR-)ô,e:XÁŽ_Ï 8eü{A&#:WÚ•\žo¼’ñ‹9‰ ?Y[<Êtö=éÚÊþöEùx²Ÿ°ÙÚFÎñr®œ4Ÿ%L (!H.üà¿Aì¢Öõøf`Ú„ÑͲÃOè'?Esaâ%±AÏNí¼K€q3-}í¹Š›SڟšÓ"öHß'IC9ŸFl*B-Ò”³L·‰ðî\Èù+1+ÑÁåÈS¶M… MR;=é+¯GèBÖv¶ÔÕ,Fìë¾·›ž²T¼_÷ÈÀò;oêö¡Nq ÈGSs´o©@„å¬tÊÁÃ:Pï}›r\—ߛܺ èEHG®Á*žw©qôu(:ó•{(z¶Ô¥L¾ƒ‚æ<¦ ü¼Æ.ó|;MVÃ@©¤GÞ…©Ê&_%¯>Â6Úùõí@þøþ 4ëÅ hÔäû·? bj*c©ðí„ÏÞV%òPsŠb Oƒ…îƒe'k¯éïøØTÞ³Ý)Ñ+fÉ£Ý[nž§GùšC8Šáã1,?*Ã¥Þ棙|j¹» ~aÙ}8CPŒ^ˆ*br“ð¨’iŸi«Õ3œj’Å;²вãôœ?°‹Êi•Á[kÆÔ–ªÓžÛ¾Ý¸²á¾¢¦eƺÛϯ…ÁOWÍ~œ]Å 7bKáÌs«â`Ö(å ¡évüîD{·¹üÃSÿ}Ýï-åðq|·ñO\½4hÂ5fH¦§£›ò~Õ¹ËÒÇ"à#¤+uá z¥sSŸïí›"ª^Å ¼É°ñ± ¦Û…o£YÍTŒÍVožAÓ_PᙊË>ùæy+ÆÙ3྅{ñÜ×I‡ÑSÅ'ßȈդõe6Ý ¢ïä×"–v$( !kO±- õúHß;<¹9H?üT'h{,ä#¥^Â\MA¶ [éÄ ’Ǧª=`ì…ÖŸR°H;±«={ìÊ”ú[…÷BŽ—;^@ù='1bȆºÍ#ž‘¤Hkp® …€•Ú¶ÂÄ鳶pµerБ…£Ü’ËÊØך#œIÄy((iîW!¶¿R¾‡5ì6ºÂ¤#áÃÏ1S û½;r¶Ýò—Í•B›2¾K#j$pf^wcýN‰Þ³ŸEË òqÞKŠ_ÝÅg\¥)FÜÀ§-fAUîÒ©îéL8ùÇ—±¥2eÿÀûic 4!»ïÐFú¦f¯ÔäzútŒ^þI€!›àÓWÊ ªÏL<~)»Ë‡®®üœŒEê!Áuˆ8Ò£®˜GÃÏ)°Ï=?¢ª·fÊTüßáàæU   U¦m &EöeÆÚÕ-gH ¼¦O[P\Aî8‘]% )ü>¤B¤mùª;?ÅéŠïºglØÈl{)tÌû,ùLfˆ½’;Îèè´[a,vˆþR¶G&>Ö‚ ¸#¡œ©”l)/ o x&rC•õü¹:ƒ‹žIý[gã— ¯‘&²8*Ù±A7¶•†ñxp,{ÁrÃÎðþ1P"ÛZÌáˆèY]m„ár)tP/ðw®‡òÿC#34&JöeŽn[ØýÊ´ÜÚ<®û^oDWJ·Âɇ96à²÷ò ¸……œ¢ZÚ8ŸÏ¸x?ƒ!±žø& ®Rå/×Âñˆ f2vúi û ÒHA¿ªÅùöÃ÷iž›"ØÇNÇŸTçwÖ(«^ӄáOÝÖl`Ü°cô¡(×. k¨‘EWóiOvª6¿cƒÄã3ç‡è¦Y«:p”´8¯\ÍËRñ¾G©™.id*˜ãؤZeIE˜×µð­¥¿ŽÓ5yYs¥@pn`ÖÅÁp†¨Y2Þ¦¹Fç¸ÇÕw´D´ùŠ{ºÉR”ËÔeS@ðŠ¶ÙnÍ]ž9ç©€QËyšöÏeíÙÁ>¢gBzm L‡ ûÈ”rv…_ÆX‰…ð7SŽãë Ï 4úød?³Íqà ïø[®ß[œ`HˆY'õ£ÛMC¡(b¢ÄSÿµÂA^ʤ ‘³±´ìZDУ$rã”A7»š…bì#Å>'5Q_zÑEuByuKX Ps>Ã)¹³1Xžßlüzh©¤ˆw?s¥›LTt¯£êi¬´Gù€ç3SŽQn/~cÕBÔÕ|<þ‡g )ñH;Ésž+èI#÷Î^÷ÅÁz4¸”:ÈÐüéŸ=¯Ê€¶ú "-Ô{rp »®×È%3fsK ñm±³2*"oݶ41±ÐmK›ÏBØØVtçS£&)Û-iu;]úIIeyä!µmý&ÐS9ÏŸ“ð«Ÿ•¶]gõó '>«ÆÜïãßZ•e‡‹P̶è=b<ò7ú’6{5RÀV4 Ï1ŽÎÊ輘fœûé’"7¾Zá|×èµNêsÚåž·€o}œX#b½ûŒú ù¶õvÅŠ?zšqs¹k ¸•·V”›;騢 fúâ|Ä<ÊeyŽÄÍV=þ.T«#º“sÖ(=.X’{ÀĹ›©³õk›‚#}yŸs™¿@ØgÖ¶t„Øzç‘}Ž–2ï|™‚$.hRòáAmå‡ÞO¬ò-flˆIØ¥¨ÆcšWD­‚2Ø5²Ðþ„t=(²4l@‰8š)Þqcä×PÅ’tÕí.I ‘€¬ÇÊŽŠvüöAOÌ!ò"8d*œ¨ª8[hf×c ‚;¼³ßþyd Û Ïï¡uõT7~ Uó†Oñy¦$X?Òà‹n¬`£Ê=T ,ZãCƒcf쬶¬pó„zvVQÞÿË£iµ:œñ¯d<ÔIOâ+‰NÚ´¡j,Ÿ+>×â&¯t½…à– X1¾Ü>À£§ª/þ2Xjje^v’cøòD<N)‘ï@FC¨¯j׉˜Ì‹•Ž#XŠÍ|î*£êi;èO‘ñnVX•?¢Lš‰í—ÙLOdþç¯:ÉÒ…±pÒWg¢õE-ëŠÎ/³7~BÐE8c*ËÓþ}lò› åñrY±,ùš-ÚæTÃѤýkÄ]GºŠÞ¦ftàÑ”6"\XÏZ›_zcm‚ñ0‘C°•x(*p'Iw ²(žÊã8]2×>Sq¥ònŠCÎsŒHŒ0­¬u€½KϘ«ÁÇi} ñÅ©·NÕ(`ô£?K?ú·IÁ™b2ìu‘PqÛQ|N–6jƒ½aVp ‘xÄuRÂÀg‡h516ô[ –ˆU&TBñê`j“îäÆ*±ÈpÄ•,bËŽªÍžÖÜÏ4Nx»Ã?Ù¯žõ‘hûoÛÿû:z®}¾„ybtKÖzñ !KµãÝ[äúB7°3F®±Ï¢Ú&¥êC¼° Ÿ…,áåY‹ÄÙãÏNÐØuûäC œ #U•!¦Øé1|…ÙUÝ‘,¨plºï˜  ˜¸À­±ˆÃž¯0ú£±Ø.Yª~.îþ0"Ɔ»[5ÓŒ§Þ‡oE†.Zi·Õ׳7ÚŽŽføã®ít³Ã…iÌge·ŠàÒ û†™ —èF•:¼&õFt©–æWL”š·!„ùÎãáê(5a*=C?Zü¼cäUüYw›yãdÓºî7Rò>Š±ŒŸç5eÌý÷®¨£3)3E’‚ßv¨ˆ:‰2Z2ázìyƒVÏß½l%:ùé׻ϊÖCheå©V³vB)¼ÎöÀ^Æ!npy¹Ó¬JD>£M[Ÿênóê+ƒHîjÇé9„åO?ß«#CI\²æŵ ZèZI< ëL*JmãK«#V"êdÜÇ9÷ÀÁú&ÝÚº#Pg&ÏyÊ 9œËï!=S!Ó/¤q¨'À.ÍK'äR+áΤçU`¸[TÆAð™†/¬wwÔí°é^u‡ùâÓ ôªµ1M&L¢˜tšI ¢B‚~K ·æ"zì´Ô8y¿A|9Ã6úÎvØaÃMu°="é©·ºÐðþé¾s€b|Lœø, •y/OГ‰máòD¨Sy;xðY°\FÊøä'þ¿b„Vµû Fb†ÉÅUžãðzÖ3¹LXîÎÅE–¥rÌ< GgWKöÞ*6¨ÖK>®”´£Uƒézúúw‡ÙZÐø~Æ{—±“YRÅ[•!ÌÔàÚTIâ('k%nè*…à'„l?Ž÷Þbñº©™ÅJÎÂ*  ¯'·[ Æöl…¼ÖX kÈ\c¯ÐŸ˜½Q€{cä¬÷l¼â[¹=‘Ù@8&ÐÙ%ß_²é_áp»sÂý‚iºœ¢ý0n–T]pØfR1»åïOgü)D°.·±Ì/íÐöÔq1@í¶“_3],G[J*¥ž}ÚúÓSsˆhÛ òßÇÎÕŒx:¼‡¶µþæ°IÕ4°ÇÖ$3½a.±¿Á9\ZZ~ú ÊPÑ6—^5¨ŽN5IÆ3–ÉwÖFÜQ÷ú»1G‘ùu‰eËy™YµD€fÇÊ=kX¶ðèÇÑ îyטZ|ªDä_JD—ÙÄd²ØM®faœMuoOÐ5lYu¶U7NGt+‰«e"k4 '±MÁ8eÕ1Û{ú*'©)³ØZÝÖ¼\mšÆ]€µXÛ”À™ÍÚ–ƒP-rkÎX]([ær3VìyQ¡ôÒ©…ªPhA'ù $RíÐ%»#fçß('V±ñm·g¡Qõ±­¶>P*c¶ôáÍcV¼ ï¿ÆªnÎOÁá#ý²éBCü›¹¼/üÔʶªbò×ÛaƒCkówïTVÜå–íe& 0<™›*AE—è" í©G´t»ýÙ‘4~uEIè•D_ÁðNMÝx~ŽrÕ׈®zlºç?Ý•êÛ|ô«Y)4¨µwáIø½«Ífª~ìÝIcÆ ‹Ä4#̨+ ÈåIƒS”eaȆ|y;í£WSZó¼—‹\¤æQ|G?ó¯Å®½NÛÑ0‘§,ùòuzzå0¢ëõ”·r$A'ó—Z‡V©o,yËlI·ðKSŠpXÔ vÉ…7HìÞóœ„+«©é‡¯3jš|»û3ÙèÞ(cúÛ&çN·þˆðk6[ŒT—ecµjŸ?U<ÛNÌo¬‹ø<ß E¾Ú¢„èû>VkéôÌæ¢&r!ñú8þåF€ªW‡‰ä`^õSG;ñ{7:œ†WsÔ|þçÿ®¡“jPPoK5d«."šàaõ—œ™éhÛæñîg)KQ I–Ä,îLñ6ƒ¦ýž|';ù™w=̇¢šƒ„”ÁqݨîÛPÏ¡÷/ÔÚ6Êõ*[¼Kf-c\^<$?DÂÊýjËê€@{à'VÝɬúþœFãûG'Ó®@#ö»Pÿ aN`¨íu,¥š+?=Ä£®SÌL¿uN9á ‡ ¦¿{C„îí&/¿§…(¯«ðÃuNMÓ/°òºPµíƒŸSçüŒ-·«žðÅÓùÝk1õªR®&[Ù ËÅš¾¾½Ü}»QiÝÊUF¦ßžÂ‰:€µØâ­ä°ÔרʴjlLÍYj*Š“@Àµò¾åø‡E¿ µÅ/2Ô#Rx/Mzµ.›ÕÎpT‘ ±Dí—…‡Ìpg<ŽØüÁ;/%Ø«¿)ašü/ú¬ ŠîBAÎ¥JΆýÊ *æ u%†ø׌ÀºøH<ƒÀQ©cø=g`¡BØÜ<憑áb£^Bú³Ôºª—¾àÚÄLí³í®Š‡5ÿ.¢Gî†ãZjL('Y{’æ›ÉA¸nóÔ?úÔaÏ‚Ø·{›ëó뵕+öŠ±,340©×;V­d£†ßÁ>ÐÛ©dHöà$…0Ô/¦±É–°äWvýÁQËBgŸoÆ©ÉZK¾7N3.Ä0dQ ~Ì—l|ˆ™?Ág"bö_ ®ª:¦.ÈǤsÈ°/íÏve`ßÄ» ó¹nüH®Ï Bĺs¡uÕvUiP{ñ½·SÔÖôÊ´b‚°(@?°åðyVdGÝ["áÅx“Í_Å7Ù~Ð×ä3Æêè¹ÊL{,Ð<0…2ÆsÙ_èi$Â.6a ®º<éúO…dµ'v¸( ½‚ÃPˆ 9;]3·sâb¢”Ï#õ}1yT€Gù÷ë‡ ø`Э¶oVóãÅèJÚN“ÛŸÙ({y+H¿¥†ø­¥œ‹þŽJá;ÀªõX娤DiêImtâw¡%óýb}/°”¨eš>ƒ•î:c©q€#þiW|ÅÌ!å»I‡îÞ>ħ<7ßú3ÂéÐÒ]ù-tÚ²sT½®¢ûˆÍÏRèA o_¸!*1:$5=Ýy˜ cs}ÆŽß+gó^¼ˆîEÄM<ãF×Ñ$“Ì$í{c Ìl„N‚bƒ¨ªL+0µ§°o¨ÔPpKµäHR‚hBl)ŽO*&Hð‘¾;bÝy ±±LÅHëOÚD¬E'q„PÕJÖ­!‰?ÿÊœÛe¼Ja{A\½ ¤'H‹økeX¨<ÝD^q›k¦ÖZJ˹ݟ~§j,ì–¬´oÙ›è ØýcÝQkZj‚´úp&D+_ ‡Þ"dÛÉuNÞ÷Hw‹]|†µ)Vj¯%W´FÙþb¸:Â-PçéT(…ÿ¾ÐÑ¡0[‡SSfK’éÔ]ýxŽÇ t0Â9¶ïG·¸Ú¤ ʺ!Ë‹ä‹»T ÿ >\$x̺ß}¿À,S<£Ç^¸ ;À¼«.gz?Ú¢\.©t‘ŒSg8讀-û$ÍY‘âágÃPI=pˆwÞ^(PlÎ.c VÈÀ¯ÐR®‰øN¨õ2ûœ×m„ÌX•©žò ËK½’ïHôˆa¶XfGÛÒ ,S}îðò‰ "söïù™ÌÇ°½Ì!`ÄUõ&²:«hÝÏò&vlÖ\Þ¡/mÀ€R©–KA/E æá*vC\ýðŠ÷ƒç½2Åï=ŠÂ\â0…ZLæüM"ël8º+õ!ˆ¿éêÄ+{Í-fÚøæg.¡(õÙó¹´gk8}šH‰8AN™6>õ÷‡*Ï~j-·1xzS¤mŸZˆJôÀ`±»3tàØžHðïìnòJÍ:á«3è;­ àÀ:Xâ)] OkëoªÄUG¾Œ˜pªÀˆË"¼áݭО€Û ±H¯4¬B¦ä½~iþTž·_ûpWÿ€2 ÁtÍÌQŒZ¢,ëIÂÙ0A>'pé‡í?©‚õîùl…ÊÅ«ˆþ®6\Xô~—WÓËîû)±cë Ÿg›ÛÍè{šœÐgŸ´9%Ú,³î" š©žž˜OjßÖ7°‚sÍI­›®^TU5ðl´ƒÃí40[ûl&ñ`b능.–äÞçè*¬òÝÎ|ê¤ëu×SžE(>ƒtäl%°X ¼‡GWk©î˜7KfÛõÜ?&3Û"ÙÕéúÇo9•Tµ¾ØND®Z:œ5º4â¡¥ hŽ‹+ÓŽÍž&ßêk1J¸7mˆ£(ÜZßñˆ…«"œ»!Ö(‡²Önµr#-È9 °¤Ta\WÌMF£í©nÄ5«ÕÝ£aã!‘»MÃRVññh±@=ä21¼~¿d?ê¶|¡±WFÑ¢#ÒNz†7Ó"2e#©á(E?Æô¤<" Þ6°°öMû©Nã¯qiFqXán¿_7¼fŸŒ4;DªaLØ1ŸôûÇÄM­ß.!µ´&­²0FRpäÛNÚ§ûûUaЧ1YúKL9­yè=~ÎHOì°‘ †³œdf‹3‹‚rú™A²¨R#Œ{JóÆ?Á©~OQ<É‹µðC°2Ѩ¦ÄHÜØïk'mpJ}7È‹ê…ÈÓ@Pµl–fþ²tGåˆL¯îòbO8Ô™Ó0”Ù#•y-.yпEe†õ kòØ[0üHÒÞB`…:n2{²›=ž×';VÁ ÐÚw’ ™¨¥ÉKŒñÝßd¹c4pU HŠ´øì‘ïå6d†Ç»# ¢'Û¤)G==µˆ¤d^f¤‰×|c¥h"¶P#u³JbT]ã coÙ1µPJ¯ær4•ßu`VÌ"¾$Mæqœ)øØe¥Îƒà—Ñg7Ðö¢ãöÙW z@Ãw»³=—åêǾDVŸ_i…AÙða¦œ³ñi\'ÛѨföæœä¥³[‰4qG.ç¶ëøÌ߳䬞HÇ^ æé¸{yÜë5KÂ5Š!oÀ[6–Fÿ¹øÙUmšìþ§œ5JÓýí€ è¢ÄƒDØçê˜Ö†DžÔÜÁGÔcÅ¡¼Ý*|Š†=µ¶Œƒid¡þ¬„[=•‡HÉûµë6à…Q}ÿó L}!âªv—׮걘ƒ–Cëíb¡>à¬É ‰ùZ¯ ùÕ•MN;d?¬œØÒXTÜuÔoþcO%×Ç°Y’£C¾Î,£¹k¹ïôĬtÿQ˜q¶šû®ÀÀÊ‚úS„³n0!³$7º` “k(¬­yBÛödemP3`ËššiMæ¶I̓ ?ØD¤ §?2[ýò ·­fRœ ’|S÷6¨´2‡a=Ïô/¸'N¤mjðu>³&~¤æð?ã­gïÁ^ )Êq6€h~]šr0‰`;Èøo?MO)÷9y§YùnÑž,6n¿û´¦ópgÂÂcýérÈ×("átS3?TÕ§Ó0êÈ­ X‡?ÚW¶Vü»×„P’þè{ w ª5UÄS‘rº˦´¿(RûhÙ‹ç0É´ÂÖtÇ¡Ño…š˜ÏssY¼¡»âòÁìL¦\é&c:‚š·gû(¬´ü/X=ภS¨=;à ´° ¿ïyp;úµ‚<¦e¿ËA8†ÜƒÖ +u%Ø~bA_Œ‹€)~ Ä }§ª4÷Óú',O@s-£A’ß±a &jíŒÐ‚q«ôM"7ÂÿÓ"”"Qzþ¯HÇŽ/ih r¨­ $„ÙÀÖ@,ôˆÈº}¹&Ûƒº*py‹ Z×ëBþô‚%¢zšOù3àÑÁÖý öUH2­Åú*OUH€A:Ë<}aº¬¹v*”³˜’¾s†ó…x0GÕX2 7¸òîd ïüôd_`Êø¬dã…}»ªûÓØ=AWx F ?¨›9€@¦­Öóà˜&ð:fC+7Nï5óK‚&ßÇ,2 !±«Ý/ò¯r7ugö-…¯¶8ºwv½È¬MÇðžqwÒN߯Äj½w¸úg)öÔ\/ÙPªî¶o¢Ô°š«DùN†=n#G†ÿí1«ƒ'~óTe"µ4zV“üF˜ ú{bð¯G[Øÿà Ë)4…cäÍðDù33ÎÏ(Fç™h¾©¯ˆF_ÒcŠÅBtÒååljfgnvÜÏ/=W´Õ[a˜š»è¸¸ƒfÓ­€ä?ÇäNq¥Á'ÈI7§Œ/Á8  5ØS)S%ÊN§çl~ h üŽ Ñ'oÏ9f ìŽÝÇÁ´¹6ö‚ŠDÏ>†`G 4!\‡´”.öi7ïÕÝYÌè dqZ¯2Ý2ùß–l4Ø/Ž¡Ë¡åa©ÅMØÏœá2˜Tý˜À‹¸â4Ý:_ˆ³|rŠÒOâÈDrº ˜ÖAÆ*ÕÂSÆÕ}êy–äˆx¡ö³ù\k²µ ^óœ”䊑ƒ®ÞQ×ÃÖd]'-úX “B¼ˆ\(Õ wU’˜¸¤³´ížA«œF hGd’®­¨!]´Œ6ª…·Õ6‡È$‹Å¡ÍÿxV'bð¢àWIàKÙ6¿ pÉÆô·âùñï·àpã!óÂ|sÒ鲓%½î=²2Æ'‰÷4Ê°»UõIëša–u꫹÷)JacL&ql˜=Ž9VÕPOR¿`I¿¾æ˜~»D{¬ž&¤Áä àB¶šDóÝ/iÛÐ:€Qõ-3ËX#6Lââµ½ù÷5¹¨Ã ÃN‰¦Ž©¢äÞXDÜÑ.›½£"ÔÒRÇQNÿùÙ=Õl¾ j9ð>˜ö˜±ñÀ‚5©póéZû¶[I>6´ŒEuE\ )vS¥»©: ˆ¼Ö7|è9Õ–m)9UaÎ4þQÆÊ Ž;%&ü¯¶Ÿ6XWv’×ʺ$›Ǧãcç̓:äåd äb8‚t¿Zv¼1¼¨k`Ê >â®»šÇÇTÜò=8ÆN×®$lîÇ^Ó^ƒ9ÿs! [N¬:¡TÃY=ê óiéÙH¯\!ÿ©—únqÌÖjƒ–óKV%âjwa7"Ó‘üFi‹@ê úÛà‡‚²Küö£bå?iÅõ_ø_aº4¨œ®znÈAã=Ÿ07~À O Ru64îLFðRLâšÁ<ƒXHCÚõ2²Å/;8É(¾}³º¯4Í¿ªÙhc`THש¾"­¿€tpHÑ%MÆ ÚØ“ÿwOjJÏ”11ýRŽýX¢U4¦@'Á,<¼>ÉwcåÈ^JÆ pRî«è@œÿá Zœ™®zuÀôŸ2×a8öQKz!“B@)¿Ö¶o˜p\¥ÅqË’Ö*rÖü(FkôðI*7&X« iû­5Q²2/´˜P·‰ŽmÕÒHå™äÉ®ËmþÌhKT8AÛØcÒ©]ß'OU¹㥻gø¶xãm3ò”£¯f*˜Ìû°éj‘ݵܦS°“£i/]§¨.àÇÓ¯øH6#g„†u²™&y å$ ÅëÜ}³,N®ÖÏ7uœúüÀ¿pôëðÔxáù1Š¢®Ò6&áÁ½3ì=R w`’€–ð8BŽzrAÓ–ÔVá‚"yŸå‚bäVÌ]vhZ~xj>“Å3­õ¬Ê5*iÜoj^Š«„uU»Ïöµ~ƒ o¹ ~ªÐÇ+î)‰ÙðtV³ønh‡ùw“xn[Änbô¬Y€ük1&ñå¾ ý „5&u¸·D…SˆÁSáˆÆΡÎ3:1ï[»ÀÝÉ&°¯†î ª©álÕ¸Xħ"ƒŸT+rÖ¹VBbôs>'ø!cÔ¡_LüÈ[)h§–clÄyíÝ+J3unÐÅ*³KƒW’æ^þsÂý™ÑRŸ-P‚:¤tˆ1&eè(¾|h¦ÕÙ; ï‹ù‰oíeаe¡¯eÕÖÍ}¦£* ¯%"Zñ&«lÓ:dÈÆoUí\×Ï6±¹ç.┟l··1¤‡¦Ø,Ä•0Þ ùè¢>wÄ5{ÑìýÁÛêñšÞ. A Ã2±œ±º|nCüJÎ雼kÇaJ¯dq"¬@°E9¥ÆZÔ*?ïçp¹ÎBŽM^ ½ø-‚¡[­ sw_ð®45œïÆñ1–—9XviW«¹uØpäÒ™Fž‹x"Ì|£X­ZW’2± ˜d½ó½Y%N~ „25Ø…cDúòg=óÆDß4Qƒú¬“Œvš£<†…‰aV^]áççLÅ—Ï'-öm5†Œfæ‰/8ló„ ÏƱUãj}0„7[ÇPÓ¨”¯ˆ¢yG|k`Ýh(¥nGZ†sT÷M5æÕÒ2< #[kSËtæ9EB*6;<[yÙÊr=W·Ñ&„ kvuT½Ztܸµ:¢öl‘ãtƒVRHïÂØ™ÐåÙÑ`²7©ñŸ÷òÁwÊ”ì÷Rx‡ïUæé'ŒhÏ¿Ð1RùŠ´Ùêá#ø“U±ªÉ\mH¯Úád4à¡;E’p™{ØÎz:NS@»Þ†‘Ú…Cäïx{4uûü›A¢ì+¿©T¤Ü9˜,f 5?åU»kë”Ñ!âº3 ëÆeÑâ{”SFÏœ™™¸ç¾WôÚ]‡gÙ÷è?Þר;zyI@€Ž¶èåf½“€ËK¼ˆŠüø}(ŒßôMm’]þ¤YI$ŒË7Í0¦1üøWêg¨¯0ÃÜ¥`pbaó‹~Ô@à)¡žw㪔v~/ZÄÉÌU˜îA§qPYLf~X$çÔxô\HtCm¡f}ý #ìÓ¿g<¾á¾Ò`2ANø«|;$UÎñwâ{(Œ7ù1XR«’^äŠY0[‹†…ÊušŸˆ„9|´­QÏ=Æ.[¶f'y°Lwž=$—hxTtÚ (߉Äÿµ¥ýÔ'´ ûÐÒ”qùÓû€ÂÙÐ6B› U䃧‡+ƒXݵ½VÇ’‘Œ`'Âq`“‹[ÍÃËÊ€•Ã‘AÍÒ l±ý!ä:à]©Ç3©Î=<÷d5ñ*‹œ¡”ãÓ?7%)7Ø×|öþR¦â»¸+L.É[íDùÚhæóŠÄ4’¼µ¡"-Ê°ÿLÎëÀ&¯!JŠZ~Gƃ¢b¤°ëÍÑKIWâ&SÖ~YÊFV!^õÿZ½Ž¦Ý¦à=ÝK“ñóšÌmÌ©IŽÑF­íÕ1BO…‘…œ:-˜ .= AºZLæy>_ô(wHŒ­•œ|‘mÚdìó¹Ð+ˆ)ļKM™Ë€gæJyÈKRàÑ®v²Ûº;h¹»Ã ʃÐþî ;X–w®TV Ðj°};}gám`To ‹°NœvtÜ—·«[/»‚¸‰†<ˆk@îÜäQ‰9­?6y‘¦/ô†#ŒÑëÛGîz5[è ¾&»c+âíØçEB³Ò¼`#_r×äŸÅ÷lª$`«š’"õN± Áõ ꕶ!l»&ƒF'ñ ðŠXåŠAjð¬^-©¾¥,÷j')6áxË%¹?³_»èšà9AuPîôÈÞôtÆâœÑ¸hCÜ!^á1p”Ï3Y®¸bÿ±O.½ÛýbÛ²æ©Gʼnwò©‘UÄ‘þò;n£™¯¦"‡Ñð6Ô'árQ¹˜¥*ý;Þc9ÂíÔr9ù›pö.`ÓøG»¡´]z*p"w5¤ë÷]‹§eÝTȤå'L’Ô˜ClßãÎDüîZ´¬¾Ð#CJÜó}²ÁÝ0˜&!)åÓ|0[¥Ýž‘c¯\úÏ¥Oò˜6ûÛx×±#ßûÚºÖØÊ.ÚcÉy±ôBLàK+-7Jbòƒ ‡å°Ùø{X©†YP ´DñÞKWÈfÇÀûÏe£,$…q™ éÀ‰¾.ô…zö¼¸^aÌNô» î¹Ü)Å7‘$¤Qé¨ý.Ýs}Ö±0ÿÃXÇI:Å°~‡"ÍU>ÕGI¼Ôþ”³OÆú–ø~± >âòõúØYçøàuÏ„v¾g7XE|¢µ‚þ֌☮M;$ÿî…7í\ƒ¦ÀŽŽ[~纨ioVÚêúÇzãrž{½ÖN¥²SIÜsF˧Œþ¾ãϦ>V°l㊊Côž¹D!ºhh¤ðmIè¡3 6fkIJQeý+1»–§Œ`S˜(ÚÒI« ö¦ÑIºê8ðj½õ/à ^öønÉš€-;`Ç[Êm\ú^©d²Ö‹ˆk`‘æ–ý“ªXº{ÁN|Ç‚K%7@WwÚ^ktíY„,‘žWŒ Iºp8/V.\¶þ;FçV>R­Áæå ¸ª§ þàµA:Ù–~l?¶¥‚à©-Ò©[Ƽ$•ªÜQ3 X•Â¤WÉ`®]tä!wI+Ñó.i;oÛ„ÖºÞáS°È(„B÷â½Q"m”[o‰È#­ ¥D>ì'N2ܯµdÔXðÓ¥ÍßILÄ–úégeS¹­%2'TSÃÑ-~4‘œ6¦Çár}fž¶¾0‚i€q«¼[ìœS ¤Èa‡=¬ô`R‡·‘W<¯Èuýžw-ߥÎæk–ú©±Ä3[t˜:·×8V)H¸Ýiïͼ‰ö“ po µEq•!ÚPO)~;ÙŸ¥r×_“õOênå¢6íçb“?MÝ]ç'˜ÜÛnlµH6sPCƒÆgœYrÈ@/A÷ÌÚï˜D‡“y+KÇO8Bp¹¿bÞkú×í% `T°*©¯ÒÓ„0²ÅçÄ¢\Et‚`ºÊgïkýG˸ÉÁ9“^ÒúÔ¥ú>1†¯_¤"‚Õ &’ jÊŽpmyTàÄ"Ì;33ÎóãM£ðGÍbù³ˆû+¡UAlZÚ•Zêo’؇'4ŠöÐ&@ãÕŸþ3–3o…:ØûËR,_QE7Ý7ø9-jàBºÝ¯> z"U‡l´â\ç|à K¿ýéÝÆ‚ïx›#ß¡ÅÄ+sÌ.^ñ¸+0KžjöŸ2`лø¯ëÞ¶°#©ïVé5CÞ´O š óÈqó’U˜á*ˆ~\ØöÜ ¡J»šH;\@u*ë„wÓ/kJÌ2ˆY¤ÿôÂÚñ‡Ò9ÙØ’¹.pÂS§–[HK'óSåw’·¬³¥ñdÐêlçvÕÝÍíÌÃwÎÒf×53Ó¶K—‚vsJ¯tyˆºIGì…Ûe‘¿¹+þñ;”Ÿ¹3Bšl1]%†Ö•¾¯EfX¸Œˆ\ƒá”Mç ¬yú@qrçBí*Ç/mÙ WyÀéêšÁH|ݧm‰9} Ï*îg†<œï??¡Ÿ µª¬[ ™¨5Ëp”}Äüìœ!·]~Z·kDmÒÖïP®©l«Ž¢ºÅî¿`6£ÔÜWúø<'Fê×rZoôü('{G­¸#íµDûgG#BžÈúËŸSE sÜMMiû”ÌIF”„*_įú2¤ÎIƒ°KT˜î©LÂßI:Ì)c¤P-µv3î†Tà®ÿ:99(›Â¢Œ~µ;r‘ŸíBœO~·Ó’ôÛ–ᢟkd2“Dº„ÿÄÓ=iýý´}ùǨº\'_Ù}éÍ–”šÜ”åTZ†Þ‡¤C·m¦¦bžŸQöž™éÔ±'n£„ÖìiA¥.Zoy}p€%&}°ãùÙl ±Ë”Œˆ2&ÍH?w™ÞM›¢ç!ŸàY©üæqŸ*ËIWê‡üÍR†‡z2Ú wjÇ  ÷2µm“ ¶X àÉí.šÊŽ¯ªò®/›)¢°`b4ØùŠ¤¢ Jêb·Vh6bÊm¡è]›çô¿¨‚ º2©u€ÛüöÁI¸4ŸÇ±åÎ&°Â_0„mÂÒŽ±xäb™5¨>Ï e3ÊP¥Ú€ïiezˆÞ“—ŠCé DŽ&±ÉÎõ™0ÎoΘ×P$a`\½ºd…íbö#ª°õƒìEØ£qcàÝNç ö"" 8Gßý[å´´û­µÂ¿¥³:-øf3!ðH×J¨wcÀÔ–®bbO n´õÓ^:«gñ SÝQ±Üê—çŠÊ0tŽ‡…ê–ì0D§èÂüñµå­†VË-"â€YâI5`RÑ}Û®aô¡;z ˜;›ã+š2Úg5@E+‹l$îcjäî¨øHî¨ù?I¹âˆQxª?9ˆ>I3’ÿ݃;Æ$ëœWnKC&uω$gíÃ9h~‘‹„Ž[Ãpãê“:çÛvdœH_÷/µuØèU½¹Š˜×µæ90‡á™ìk]÷àÄo«ê]Š'è¢û¼Ä#åZì+ ¿šûLB/D ì&§°Zo¦Ÿ½:AãnÝE ‚—Ÿyn¡´Ðöu¨Å@x¼ï:ü0”}ûD/ç÷ª1"¢H…ÆZ/·¹XçÅšÈëiZ½¾Ýý’¬ë‘ª5¾˜|/êg¹‰°ríe[=Œ¶¬,J(Ä7¬ÕÚMöÓ¿‰¼ãeô¬;&Ó®Q¤ÀºÝ±»èQ¾,€Z†íòÎÙã  ›v@h5ÿËïvÞ|ƒ{ñyœ[ÝÅO¤º²\Gªgî­%Ÿsðc ¦g ¸;‡Ðöº2Ùo®Lc<\YÁÏ/ EàJ»“…ZÅ…W…È›Zx‰seO#.9‹tZû>Ig=†÷8eÔüõÃrÛÓi|3±u#ù¥k´)ì‡Iÿ¥Ò *rû9Ãç‰ÙâAAŒñr—Œ ÚKt¨}·þ[±Î>å£ß ž²‚‡Yì0 Ì9¦­0ÆÔ©•ÏÐSéÿþ"°8˜;q$ˆWºÓâÁ~1ˆw…ijÈ&ß²+ÿö1Æ¢‘ÏÕá ²¿¤]Ï)û.Ôæêž)b/üÙ:}É“Û=k íF¨äò—b.Ôðü”‰ vì2ò§{!› aÁOvÕ€R˜ƒ¼¼1ãXÜrH­ù8ÇÂ*=aM`rxn!‡U¬„´èð0Ÿ¤™B69§€yçÿ‹Ò†o;=U·…`ÛrOoÑ…»‰ª#V ò™å5VDø¡Ëª³r€Æ–²Y­–ľµŸ}•FÚ#é&§ËW'ůlÉ–Ù'ÕÂètQ9Q qÄu:TÊŒ/üø±P×ˆÊ ]¿Xèô?æä÷Ï«~ʬÞÌØRQ%ªôE„–¡œÄ ‰ê5LGø€®Øú«IÜ_#wLjND–ŠÜs…XÓLYdãÖåìûë¼J0À øâòƒS…Õ­—£ûÿÜ_°Û"é£iÅõ÷¡’¡, À—;OdS½¸?èhØi©8”’†ÂŒ—:-§Š£c=ÀŒñ³4è5è³:·<ÞCÓ”S²_µùéönñÔÀ±QšR`ŸÂMºçÏÊ)íANÍÐ?Zq‹ÕVG¾N©­,/óÌÁƽ«wêWød,ûsÔÚ» E(Y;ï$dœ*Hîpežè ÛÁÚWëö¶1ÒŠÑ ¢¡æ2êc“ É,TÏ—¥6¡¢…?k®1-³._€Ï9¼>±Vã3àwã¿e·×”f¹Šõv¯ä˜Ú_zsí Y¯ÝƒÇ$ªMà “CÜeÊàF+±=(:'+ÓK49!yóÖGpR}VŽ7_¸| ôàz_qL¥ó\,¯Y»i­Ã*5~DŒñ â —6òØÓ`!àPÁœW.üâ†,e‡Ö3,¡õv¢£š£¨³Â|0_89 h>CßlœÜ« Ë(ý»çŒ­¾ÄíQpt¢vFÆ Öõ”2U—¸Ê M *†ZažÇ`™Ðz)Í4â!#¼kƒ#hD§Tu‡À%w˜~IÏÙp™PU}ùû’sÓ´‡åÀS`påLoß2ô¶{>-÷‰ø¥¯îŒëº'”Õ§x|¸SØj‡}º*Àôd£õZRLb çLX¡bEÿ÷<ëý£“*pIÚÙJI…꣧ÀÖå^z7¹¤¬[;SEý—}8¢»ÉùŠZtÜx[ëR¾\vš¹mrCMïî 5«-NmÊ;˜…#ˆÔòhZ¶"è.NL$}Ú:£ò”ÆÀý…ûÑÀ8çà_‹êj;wÒæÛ´| K%æ]ÛVüé+`õ°ÈD* ¯.Í\ì•úúó’ßÓmðò€°xg¤áox`È—é|mV"Æ)QQ1 ~OÚ*N”ZÓ¡V—~(ìÖ¤•?qt5õÁ`&&h¦Møé×Ú’Éœý¢}(™oÑá>®×K4ƒÞ{û5ûx ùÆ‚Ó/“ù3­3Ÿ¨¹”¤0*QJ0Á6‹Lær2˜çT`ˆ,Òq)bתN„/ŸÁŽ¨÷®µN½0àõš¬4[0@›ªkÌ–aŸ/÷8ù=6Á¹Ü”B„"GÍzÎÃæfInéxÒZ´µH#’‘àXõ ßk…>ÞCcfÍžnˆc©ÿïÔ\à͇A Ôy§—v=ý/â¹âChMÙ½dÒØ+w É"6kv”n žÁ¼•s&Öè|‰.ˆ'¦qu;ƒÕŠó^§Gl“‰Õ™:—ãÈÅÙ¥X,>žâú óÒÓí­›c‡wlÊui$E=½xõ&;Æ©x žÙ;bQÎÁÊÙW_bj_m!ù@×4ÿúJ Kß““&WL1Þ{ ›š°½ú¿PÌœ.ó·_´ân„^´ÔfÝ¡d•B³éaç¡u‰]5âüï2'#ÅÀo0ó¨Ú,ãi„Ò´äŠØ]Œ÷jk ÍwÑ ïùÜ¿ËFI¯ð|£:`IºÈëeÉ“´¶5m4Õ¥5ÓÕ"†÷ý†¯Ó/ÍýíŠS·¸ÜX\0œ»愹S†IÙ®nÏ\vö"£ÈÃYŠ‰ˆ~ÕãÙ·ÿr,“i #ˆ@zÓ;;­7Í´Œá,z§ò+Tƒ¡&¨èc‰3g¾ZÚ­¢¿;ÄðH’5?íÆòƒ«do.ë§íû ¬ž•lR}6èL`fa ýÖÍ ã€Úú}ÍŸ… ¢@åuiŠ`»ˆè߈NÉWáã¾û K½V5‘;‰ÅY2Ü·äzT\I3C %°¶\ÈP¤RºÛo¦À£Æ $ãЮ.i@¨‘Õ‰"*”Ú {×$€œ7_Áe#w~‹v•pw6¨5è3àLµyÔ| M¶ä…3ž5Õγ1l<å%+GWÚú$¢Q›Øsªµ«ЈI²éFJeôm¤—Ò~ŒQ¾–½i}dT‡2 KZ<;ñEÒ¯3ÿàõ..FÑÁúzO¦<¼ñ. Ï[‘³{¡vÉÂ>ƒl ßœ©eéì”/%þ0caÙ©¾CËÍKaZÙùf-2©òZ«uU;·iî°ø¥8å‘ žÅ1¬¦ë’äÆó;Öl% Ð:G§ˆe~J²CAx~SxýÆHâb*€lÖði½.ã=©yÒ.¸ò¨èî 3ÞΓ$’«'ÓÎw7îiÂÖ•±òÙ´•&%ƒûÑ5ÿf’ 3è -ÍFÌ”¯TŽU”îÁÿŒ)=I¸œ *%~š;.MÙÊÖahpxµ°+Ún›õê!MU!QÉdÄKG³b,-Í-õ#Ü‹ 3úGýî^ž¦ñ2ë÷“Á^™&–BƒËõ;Lh@e'UÇ dYà©’¤B¶´4J† ÁÍ‹˜I ñŒ“>eY®L•ï3rû+r°›}ø·³úæœá— Y%Qƒù­øO)BüïZJã‹_´ùGÿ®’‡˜êÝu8R¶áŒ,nV¸É[eöÍu: ÅútgãÁøÆz‰‹ùçR#s®J‚Uo ™ú­Í>Ï¢]rü-÷‰øt$õ¯† æ7Ò‹w“ܭ̹à/-|…s(~iLéªU†u3âC«/)gĪÉïUyp=³z1¸ ±LÇtîLw Œn© e:¤¤•#±#á“öŸ‘—#¨8 Ì·ñ&®`ʤqß.¸D,ÒºORÕ/ë%ÏßÔ­wmsžUôƒ¯YóÕ»MøS;rðƨcôSW ð¾#o÷S¬š‘aú®=5€Öû]Ïaý—²ZQ¸g¢³¡êYôÏíÔð;§ôKtɽ3\‡×(¹Õ½rüEa\€¶lýZ’‹ØW7¸yÀ(n#²Ÿ´öíª Ëš+=ðLŠÕ?®OS$(´çF©2Ê7,o Û}VüQK]3Ç)Âdt¼&I…`EÔŒ›¿í>ˆÔ} @Í’ÌA¤G¿9ú¢™Y Á·ú%ÌÍg@š–ÀŒeÚë`éăãyØü‘HÕB‹`¥ÁÀõôÉzœœSo˜FþäV2~òï«:ç7²eÌ]Ôd’Î š~†}¯IÃV…ÝÚîÃ_°©k1kXßè*Å*²•*’ºÈ¤7kHãõ. „¶š!ï­3åç-…âÍûS*YE2V‡uÕ9^7« q¨)^ÏΉéè$!ÕAó…뎿ëfù|N²¶ ,¦ÝtKzÀ̤ïCeÄøó]mm¶íÀÕ¿“³fx ’÷™î3|ÐWx*6¹âÉg+¨ è1]û)k'1gnQ½½QH‰-)”0 Í°³ZÙ )²æiÂðV¥Ÿ²¹ó>ñýH½¡5xgÁ qçFî8ËÖÍ-Ù—?Έ8N ‘ËGÐy“ÊÔt£DˆíÞ|?Š˜©~ýð- 9·éo 0Ô—Ý<—úÂqö‹v¯MÇ—)AM–PâÝ—h_8îˆðƒÒ¯Ž×2@%Wd©¯¤"Á›{*þ2ñ¦MªÃ¹/ßç ¨.´2(ì1óNƒ¢ÞÁv ¤4aåÐyãþð?*®eÀ7é ㅴںЕµàˆ‰,‡>ɤJC<86·[;GKWQ2¸… ½ä(£–žÆ€÷R¹lD055³ ÏBŠÏí?‚}×[kêß•Nߢ'¥Ähcñht=òm°ÄÃSe‚ÿ@Â~…¥¾•\Á0´ Ÿïƒ£†§šrí]D‰)5®~Ù²Lé~Òç|©.ÔAh£wmC¦Ii°å¯›eLÜ ¢xö*êi:«tµ•9®yJÎMjCdEIY%. =sï»ìOHTià÷HyØv{þ7:V™\9z UX’²QzÀBæìw~à ÿîaͪÓj÷=;`D# S‹íç¯Ö$¾÷*»°úX|¨Çþ©µyÛ…6“"N€LÝÀ” `§,Ǽâ©`g±5Á5›Îu œã¼/‘µÄë kvãUq;»ÿó‹Ñ™„0fƒêÑk 7ƒ«£rãÖŒ;ŽÊp2ës>;ÞûØšWIËEb;n±Ëêt2tÞÆn£½¯æUËÖ^kO«/ïP¹­¶´؃ÖO@Ý:ŒA¡bh5¥ÂTïÞLíÀ©mWIôjr÷uç>>ñѸ#*µW¸¼jsÞk1¬ã^_ÒÛ¿çM­’¯ùл%V—e¨Ù J.aׯ2ä!<âäqi +ÿm5gIÝ ¥ÉÛ”õ»8LÛ,PxðÒ¯s•=pǸËpräϾ•ÁW¬+Š¶Æñt’Ê{ИuQI#A3-¬w.6~ ’qr•y7R>÷ƒ-ö"Fhlè({™Õÿ\ô­×¸ˆÚ¥vaIÒ µ’nWc&áêÖôLµßn—êazÑSGM×ì}ú_Î’£}@Áóüéàâ}Ûdì–B¸iÕh@ ëf”'Ý[Ÿ°Æ!o{Ÿ™ø¡í'n54a´e‚˜ªÏæ5ÄÓ:æÞùV"8tŸwŽ—}§ËÈJ °ÔãõÞcÌvâ‚Ô3qŽO¢T$íÜzLÐ) m£§Ðº=&èqÄcèáã‚5©~ðàòŽ0Sl;ŸCÛ XYLgÝØŸ´Ü<¢¥:­åLÔÜ!] ¿å¡|é ”ëý’Ù^jQ¹l²z\­% W¾¯Ì%'-©F„d òiÿË¿Çe€\z^Î×^õÆ”X¾®²2Õ€ZbýˆúöÆÿðMœz^õGìÛ ´o“ÿ&áMçÄäš.ÝB`Aí4v= tÃÐÏF nï Œhú£|3N‘ ˜ÓOa£LÕºA>êùñŽ,’ãÂÜ"SÌ;‚‹OͭƉz| ¯Ë1‚Ê¥¾)]T–èùó<%N”JüÉoµ£â¬”°¦d>ôSHø( ˜[•—ëúÊÁ,îÔ>è¢ÉŽ…Fd;n¢g¾Ž°Ï† 'Ä]ä¶M°0-T#\šjß’®¾q’Ñ‚'ÑqƒÒž¥PH&ÃÕ0³Í€évˆ?,ËËм Ô¸ÍÄÜojwgåݵó—ÀpÂÖ(ôÒÐKsÚp¬±0tŠíPRZcJÙ^G8ßý<¨‰™FÄ &Äü~HÅÛù!ok²FÒX¬Íäɬ¤v¼rk#ÔV*Ì·œ”ÈÂJÏç8ô$“ð÷«~²³r¨«ÐÆ&~‡£kÿ¾Z=s7u:¼rÞþ;#›Esý®‰žw¥½[¢ƒdËžu>+^}ÙÃÏäšÃ· ÀZ)Φ>B6¬¦ý€—8KQ7]HÛwØÞûeȸŒ±g0ö)ü#ÓDK !xL-¾ÅÎ@Qø/!ýüÝŸqÚ®¯ƒ¬ÝGÎ7]֣̔ÈÞìKТŽÙîØN¼‰clòÝ)$åKãï%aÑÔf…ìqªP­T¸¿¨€X–ô?oÈÃáËQˆÿü\KMËU¯t6Ø‚ÄY¶¾cÿÅo[p àF†,:a¼ÛŠ“KÔ ‰GEε(rCuGÇ—ô^ån„$¥ÎÎæ!ZM’*v2Æ0gܧÉÉh4ŒmFä‰/µÂY…šÐÊ‘€Èø9±Pµ9ÜöRƒ·tXTÙ²ÙrR­¾²€­˜±Â›E@›ÊhýHÎáaƒÀ¼Âw”Ä4BÂ1O¯Âk³T’í„ûG‚ÐNŽ‰NÜ7v|H4¤uVÕ¢qQ+´¿‡‘¯†åÓUÝ%Ò<…ÇæèÔéUçOl¬>Ø!ÝQÙVÑ%jJîé^@}…éùô€Ï/°þ±Ñ9ì;Ø{Æ˰͘²P[â_~çkµµší®{,BÎÈóŸ:µ§ˆXâ/0”ÐíõÒ}¡AIÓ4ŦÐ>;‹¹ÅŠ¿) 0 2U8”O96ÄÃ[½À¨w/H Ý„^ÒÎ3¿¾K0éónµë£h/¬®î¯=|t—È“¸„1Äö*½EÖ3î#8”Ôïˆ.u%ýÚnWŽ,…XJw•AàŸš+ÆèEè£h›Ýëü=Ÿr8R¡ðô&˜OiËy:jBáUvŽ’fRpÃ&ÃnÛB¨¦…§Q9! ž”ÎRB¹3ª«Ãà×ø“@µÏíl€pïTþš–BËûÚÇþ»àqõcÅ-–I­HT§ÀüÚ¨¯§-B"uà@‹¶š±f_Šo’Pïm§6ùÀš§yÖ¶í«-Á\ÙBÔp‘Ìü RTC-ë'a×Ñ´[S!ƒƒ|d‡h%»"ûþ;B‚—¶·¡ùH_àñ§¨$`Ñqúù¹Æ9SÕá­8ÁŒ¬GV ¨«=,—šáO ÊôˆËïp “ÜÌ—’*N£5p_òb׺„Q\B°¢ò/{!¡J%ãˆËµâ¯¦¨ñ˜ZobçdW³¿WÝ^Jq™Æi¹âŸ¸á× -Ü@(&{[[©†x),Ð(ÖFþìm7àºÕh†Qà£J¡‰0dzrÈð0Í ¥6B¢âmí0Ó?ÞH®ùs+‹hº®©*Yú¤õã”îkžŧ–RM£™Ùuu°0´à]gI?¶Ý7ŽAߌ6Ö Ã¦£ ³û¯í"{<ŸåÚ\ÒƒŽï(s«õ¨™‘–ÍnͺE-/‡h؆1û}½Éð«TÍ4^RŽµ»@7zEÑW¾èà‰p|YªG¹è!íç¿Qÿq¶1ã*žÌöÆA¸Q øjÿ^®çÜÉ×û¯°üšG5|føS­cš þ™mEÎçdÁ Á…=% ßÓ+tÙ¥-bUvŽ_@òãüö.í5ŒÄ$çrº”=ibg0³§R6CÀܳSÑÏû¤Å‚T³c“±GM:}ÉÌ Õ¸x{§® ´ºêÃGce3Ÿz›òuæ1ÑÁ-ÈáIùµy«äÏÚ?öˬ]0GJœº£¿A×e´ÇXbÎ1„wŠ%Œ\õ!„(”®#ÓÌÊoiͱÓå?¯4ˆò‰IY…S$•ì¿lNc—”ùý{@,f˜ÎY†ÔåGlãs@3Gê†  #Ÿç!¹èYùß]ßúë@_@ (+|n®µ–×#ܯK eciˆs'º£Ÿ·§–=Ôö.ÚùÍÇ5YÛ?1K¿nÙ#Ü4‡¾ùãK¥õÊÝ÷¢ÌEƒ¤ÂTúµvÓ9GTüg °ħ½›à¬8-=¶ÝÝcbxd(²!xGæΩŽ——CËéëžhñ^ÿekêÛIrÄÞœç·fa _4D±º>Xw‡õêg0¥Ikþ·f§×ÿt‘ÜÆ—*ÏÙ]ê̈ÖØÙ2FÅ”*j•2ò¿½Âòžèîòý"iKŸfæw¬ðõÈÑò©0hÃßEÏLGùºLm‹XrÕ)ñ¹s®ê+4 Ì_Uœö|*1T14¨!/ õ¬Žb^7éxkz}|€KD{™ÝVâ³Ta¨{P)ˆ!ÏŒ†*ïí#Ì+Ï´Á¹vÝêÿØüê¾vöíª×êœê °šNAò¢°szHÌ/‹ìf[µU‚ô‚ Ù5-OB;^D°Zšf,E#>Ëç ö•Åð÷µÖåÎ_i’….OÓÂaj·eN%‹¹Å ® xÁ/–_XtÚ–ŠA£H%Ì«=á´L‡“°l? õádÌ|¸a›Õêñ@Â¥ííÚÚ¸&'øp’¶XÅ6ßÃ@ÍKwfFX/4ÕäÆŸ€[éGJuø9¿Ý×™¤$Zzúáƒ"ýºà›¬;ß ´÷Ð=‹Šû‚æ G kFÀL­Ûß{ü'OªYåS¤±Šž@€-“A ]¬Ãˆ-pPî‹iZli5¨»É2‘³)ÆPš(©ù ¶€pïÚ…?\¹Ïe¢ ˆ'U^Y‡*q" ZhdÐ9“=Z ™fq] bæI–Mõš¨›‚háòÊ,mlÿ3G£Ô?ÈÎi§™ÓL7fhFPäÔÚ°ió•/*zW%í2¦Fã#‚â ³Yú5nϨf8}ÑgOÀx(3_¸ºÓ¨Ù”÷Öbc€ßýÓV³MIJ1îL-ýä;ˆ´¦D ·è5]G`̯#?/í.|ÄUÖV,Ïl²C€^}R¶‡ñÖ:DzQ¯Ób2Ö?à­-wµ¾2?Gáë!3âUyY›ÖÆ B&·4ù]%Î<×É¿ Ò^l©®R¢nÐ8@ålC#„€ö ;/õ ¤°ðˆ]F”Sf/4m÷Aâx±&^؆¶´¹ÃżE4ïUYít/pü…NË® ~µç’Hæ¾ÌØÓ dˆí–‡õ1>.>0 ‹YZshapes/data/sooty.rda0000644000176200001440000000136715076647713014342 0ustar liggesusers‹U”kHSaÇÏætLrY’DdEtA™—…â"-tF1I‰ÎD³¥2§ ʪ™iNes–—,Bº©Xm{wÓ%è¢}Q?TXdBEEÚ¶çïœýÎóœ÷ù?—÷=;yDªA,H$"Aä{”ˆ}?"A"È| .ÓjËõ¾÷rŸÑÏ-i‚ÿâFl)'­²65ñ^ÑrX¿™XNë ¢®–Ø´‡XV80ÕmøÈ ÂTwI_²r™*.ïÊVÖðt Ca—3³R•nÍ•²}ÀÏUá«”¼®„X9Lñ—W¹›¨%=ÞœÒ=u¼WÎM¯Syé–QÞÒÚ¼7á!oí›´æ†üáJsd|Úþ/¬=.-ÿ—µ›ux•EgFJXë÷¬Î#fv}:g¾9UÁ4me%£Zt ædsÓŒó‘Û2™MCs´#Ú1w."º?ÊƤDísýO;è=·'¯ Û]xìŸWG«€„èRCˆ‚ÉÐËDž9Ô»ùûˆÎäÑÇ“ßû›lútO"_ úC}»zÁ%¬_@ü"æÿOä}‹yx¡wlÝÐûL¶­ 4ëÐO'òLbNß0§÷èÿtf‘·qc˜K"ꨡãêG½ÅÐ; DôïŠGƒ Ð?½°&ßsœŸ8/¶Fôù{B1§Ø7Pÿ.ä=<À(òÛP¯ó*ò¿ÃúeÔ­€lw4êN ¾ìŸ8§¶í¨{u—¡ŽaèCoëVÏ­ûêÆwãœAéй ?êNÆú}ˆÏ&¿7þÄFæâ‚ß{zb®5®AÅ}ó?únÿYò¿–úîeÿý¼’eŸshapes/data/nsa.rda0000644000176200001440000000113015076647713013732 0ustar liggesusers‹]S=hAÞ»ÛBWLãjÔ"F°8Å"Æ& '¯0˜NŒ‚w·s·;3;{»1ND”ô@ÿÅNA£`E#‰vþtSBRY(jQu&ßT̾™7û¾÷}ïÍŒ(zeÏqœ¼ãº9'_ÐK7¯?9ÇuÖj[˜8Éõi^ž¡±×Å•—×)¹× Rº^©u¢aí-þ ñ~ùàŒ?Eµû}ó‡?w(é2@ñ„?©O(ößê±@áéí!q8Õ £¾Pú¸Ôšîz$þ"NîÒ°+¯ˆÝ…<àW"Ç j¼óLɇÀ“æxr™ê ¦D|ÿ«é}J§ÁWÅ^h–}óTÿ ËÛ°A¯åwø|ËM=n¯'fgˆgP/¹øâ#ôó¢Ix‚jyð矀w,D\úùâ«à™òàð?Ûoà¶Qfõ¨;à§ÊØó³8—ý؇m[ŸVþFßäSðªÍ‚?߈¾U;°xÛ_±Ùò™E¼X„?Ü ½éCs”âí°òt1Ûßh }­´P‡lÎò^^q†¸àò‡/пÊ>Ä5 È×B=’%àÔŸãžð%øÙ&ô%» ^êúÛ¾Fç'rÈÇ.¯¾".F]äèds¶ïÀ³lõŒ?A“7à•Üïè:x‰#ÈS³:’øUuT=ÈÙw!¯'ÄýÛ÷¡nX{€Ãlý¢G°•Eðh>ƒž´z¿ ;r#rسÕtìÿ§gMmÖ›¥æØ×ó™ÿuj+shapes/data/sooty.dat.rda0000644000176200001440000000062515076647713015105 0ustar liggesusers‹ r‰0âŠàb```b`aad`b2Y˜€# 'æ,ÎÏ/©ÔKI,ªá ˜æÁ¦9@è‰%º}˜v˜¡™@èi9ºCBW @Ô§1@èòÝ«¡‹ÓV×üä@ oèl[ö%œ¡F‰52][VÍ4ØÇç0Õ/ÔgF<»Cm%Xü@{rhÚyÇO³!tÅ6ˆþ"­¡ó!æèwœwÖk!ß —ÜäIî<0qÒ\VM“µ&-?3#žíû¿©bÆÚ/¦y$}1ÏaæQ¿ŒØíÙ“>†ÍQÞ>Õ¡íZôý~w‡äÉ?9³wöc²üoêÖŽYûÛÅÌdK¶<ðúÝÉ'·UñO˜~ ùn³PÞô^‡¤JEÝrà sç3' ;ø;,hû¯=tqžÞÆ#~]œL÷RŽ–ö)N;Pþ?B É÷ò†uoöoŒ?0ÁÔ7KLÎ-‚˜S2s/ˆ Ä<คà à5xZãshapes/data/panm.dat.rda0000644000176200001440000000117515076647713014664 0ustar liggesusersBZh91AY&SYm“å¦ÏÿÕüs4dEUÿ÷Øÿù#D@@@@@@‘K…Øfi<”ôž¡§¢zšcLSFLFÑ é=A õ©ù‚4f¡  C@h4Ñ ©ú’¦ŒÔщ‘„DÉ„Á4À!£ÓF¥TÍ@Ð4 †€dhPÓëxŸÄ‚‘Bd’$„˜äLf°»d!”\Å8*%Ýã¹x;.ñpÎdJ@„P@„I0!!k;*•QÝ;[¶¢Ú80PPžx·›±ÝF¨Ü9õI^Ükƒ/F8±º³‹™aFõ<ÚÊkœدMÛµëPZYg›6óJO ÷¬ ã~ü{ÞÍEã%A|(iFVe Ø”Y±§j®÷ÂGÇ®,w áAŒïÒÇíÁM7¦¶»³F£uaõ¹3­k>ôäEFÊi1)çX­¬j ÖÞ ‰¹&å·Yˆº`]ÿÃ{| ìo@*›°‚‘hŸ±"´H¢d&Õ ïH»V¬£¨´Ú|ŸÍ@,;ÁŒb!¢!˜–f I(Gõˆ9•=4&ùhÎè`fióšÈÁ®¸ìÝí¡FFwP 2BaìÉÓÞɘ!{Á€Jœ³# &f ³ 1˜©2 ®@PRDÄ513CHESDÁE5CIÄÃTÀ@Ó IUѱ‚¼½w™¯ÍÕ"©HD d@‚¿ª{˜ì‹~æ ƒ^KÔÒÓÔ"˜Hã8|Š1|àA 9O1OrŒúô…•~ïÜ( (­CªV´¬œ.çõR¬ 9:,¡AÓã_ñw$S… Ù>Z`shapes/data/schizophrenia.dat.rda0000644000176200001440000001227215076647713016577 0ustar liggesusers‹e˜y8”ý÷Ç‘²´+Kí W‘*^ÉýZ&sk–º'qò2gšŽ“”ÚÕJç®N‡ÆMõêgŽvcSŸ°ôã&„½»—:uÚIJfì?¡ož)Mð4³Ü@0ÒŸÝŸª—´aÚ>àWìÕñj2Rê7ñ¬óÍÄ‘ß:<ÿPN Ž“’&OÉ.òD‘k¤EÐÄ{Ø[„º úÎì[1½ÿ ö* æ l)D¢­ó# gìàq­ŸwC™‰“ÞY¿ŸßX¹õ\ØM„Gʄ˘Ö% µHÕY h°ôf©Y0µ»¢6›„ˆ6`Ù.! —MØVrsÆqýˆž4j¬óÓÞ<ü ;é/Cã»C±¦F{Áá†h¨ùvÓb_êÌSÈsÏîgïÛÕwT>`ûöK^aцˆÍ \Ç+$ ÿ“¬Ø$ºJEÙ‡¥”yAõš7}7J¡n7%s z*6‰»æñW}Í—Óuõ“0üàaÑ-Íqôhî^>Ýã e¿Æ¬#wI[ï@ÆùŽÊé˜ÒKs ,Fª¤&JŒw`~‹Ëú¤CPlô(šŸùBÇ¿µµõíÁûBº‘H×Û+ž¥–Ž ¼û3€âò”5ú§W(­§AËoßbéN7åd‘;‹GµŽN?†J$ß›†B‰Y|¤f‡7VïI3/Ádžr*E—˜p{×è¼UìþáKøÄ  Ÿ°ˆå tD¸ú =FZû÷Qw,T+=þA3Ûnù/61cñ¨”íí<6ÆE^ŒÙ¡‡=Ü ^ %"Yuh>CHZ(½÷«/âåCà ]ÝÐÔÔg™…tJÞ £>sPI¾í’ tŒÜÁ$E36“çpB‹ßXgÊîeém(‹ÑÃò» 7m‹g?‚q¯³Mè?Þ±]\Ðôj>2ÇŸºßOÊaj’™§#·eþ“ T/N’ET%tµŸ}WÁ\CËÜwUi`% 以 ÔI[ì†úB,½­é¡JÁ–äèk^gÀóëiÇß•a}hà`çÇ…pÏE*€¨éMZ¿Àþòõ_ÞéÚWl«ŽÖ†„ì1õ…œtŽÅ¿êAïžÂY‡tmh™¸î¹·jÜœj6¹XþåQŒ¿™øV'Ç’F|Ov!Ùù˜†Óä 1üå'xÙèÙ ±1h ˆˆ¦w@å,u³¡¥0.Ù?î']ƒ·¹qâÙP¬¶n¢¤¡(7Ï¿ÜZ}žÉ¾'ÊcÕú¬Ô÷áW!î›Bn={,_òähö›=´ñ¥rã*{µ8ÂÐîè9û8Z†Ô£Z±Cj6›%)6_w ¨¾†¾‚—^À˜üøƒÛMío V;ç”Äæƒt7Åû><§±áLµ~ŽÎW¬²‘R­dñâöèé=¶OÑÏÁ2Ünñe(ý’¸ÊÆ<„¥‹…ÁÒ¬çuJTˆÏÕiÍ·Æò°nOÈ¢±Øš§“Büv—í”Um1Q›M±gÙÙ‡nÁX#¶ak!gt{;úÐC§F“x‘5ÕÍŠTáû4÷§qóõ÷‡%hPbð8U«‘ÔjÝÊÙ¬þ<³½$×~o׎I H½/;<ÖÊúNdŽÑÔêŽ#·{˜R5¢÷…>Ql~‹lžÌÕŒGbÑ®­‚_9±/á)¡m¿/”«Ï }tÍׯâè¿4.ƒÊGcc©•/ u÷sVZ€úeÝò]ìüÓÅ¢šU28Pâ¦ù’Å×ö}ÞÎÒÑlŽH±6±ëžŠÜ|È}Â)-‘˜ÏÎ?Tß—Œ³rŸ­ùÅÑ^¸üñ•H‡¾.´þñåî»6ï¶õŸ…æc&õl…¡a %~ísc°º©ö®$IÎw³·Š¤%¦LCl´Ž9uyûó~×›Ò™d¯pÂR¢æ3w¡j¹sšÕYi>6ñô§yZ]ÄöÊÉ‚ëYXÒò’E,¶Hz.0l‰½˜¦îr0 ýºl±µ­DrÅãXø´:³ØHºÎ”9›1­o. ÷CÓ!¾‘@R¶ Û4³²ûÓqÀ½.Dy+tL]J¾3ÿ4ñ»1 „Ñ+\5¼P¾°Y'’¬…1…åÿê…ñbrŽåS7^v=Ýky7W\bד:X2h¢zêk¯Pfä•€Öqi«Ç‚CÀä«—1ÙƒŒqÉ©a}>ÌÿDZ頞”Ôlöiä|Cyƒ…Úaoy®(aë﹉É>‘m†_ZÁ]ÿÞ¤ˆu~TV¤Šú±÷!­F›LY’Âb†Õ6M. VʪôÉ@×;]㫃Pß<œî²ë©­sïbñ™ö‘/6ÆøâV£’l’oܸø=­rSÝ íáyx–éB<Šy±«»#‡ŸÎÀ¬Ø-(î*~¸rÈZ‹UvÎÇʹ–§`½f]‘TX+¶W¥»´nÏÄþ£©Y%H™Û¢8´±óÜß¼”ïpÙD +õ9>,;Àš÷a<þ§Õä1·&Q cXêkmÆüAèÐ][äøŸÞþø[-ç¢Ë7ZÎ0-yCÐ/xß|o’;ÆÄ©sß=¬†Ô?绿åmü³D#¶_§_,8£V4…¿uĬBïÆm_¡ƒÚ¬Wû@{ä’ú"vÛcõ˳î¹Q¾Ør^8è['Û¯kÝ Yäw»n­“mHÛ„ÄǷƇyð$åÛû,•“7šè1‡fErc½À»¹dÞèTIk½Î>?ç}ݦÝ×ìÂXüª§21ep ¾àùé[6¯pÞY!$’[}6Vmœ§¬½ñ öDk¸ˆ7×CeóÔCåkÚ,?Ðÿœo±5‚Ò[¤¿@9÷D*Ï@´ûS]w+z±ý îwžùG•¾ÒÇgÙ~Ð]ùëc#©ów©1zÜwýv[eÛZ4º&] @êˆô‰çÏ|€0p²kñ¹qè“×ZÆGä€>–ØY „]Ï_¿.ó“¢Ý;¼¢º¡jöedÞ‹n:áÆ ¹÷?œ—òÞšÜm×OêñSJÑ9=U,ý¶jH–Ú åœ•ß×Lî‚՘†uE@M°w˜´:ƒ½sö^VŽMó—«|‘\†=ò|ûˆëípèm§ñ"~òûÄ××¾ÉtaÅmˆÒñ×ӜҳX£˜l}Ý¥ÈF‡DÒ}/a{‡ˆvb_1bÓ6«SQ#@ù3™«WYεCÓƒ-_#€|rnq$ä›ËÊ?'°÷o9æW£ò¦ðÂ?>5šµ¯Wò.®n©o‡Ê{¼k%@ݹ0ÿ KS 3…ã-‚á˜yáÒXæþ’È!Yþót,c6`9wZÈ+2¶ÌF\žLe幋GÒ'\YùçK†ë€ ¯]6¤l ¤9›P¬…ÜàدÇG—…Å„vÑH›kw×kÎîþ?‹îyÖ6ö¬Ûâ¹—îso‹²®s×ÿC×íÀ+shapes/data/qcet2.dat.rda0000644000176200001440000000257615076647713014755 0ustar liggesusers‹]VklUÞ>@(–"­&$¦–`±*-µ­,o¥ÒR­u_³³;;»wfw»»³[ÒÆ*¦ÕDM’ Ä˜¨(HˆDÄðH”`EQ£ü@JM5*ñAùXœáûö‡N²{çÞ9÷œï|çq¯¯Sm*SË\.W±«´´ÈU\b¿–ÛE®R×|{œ?”H 75$a[f¡½ž©Å“]cU£"qe¬jd²[DVo®>àýUt?Ñå,ˆp¾næèö¨È'°Þñ͈³AXSƒ»¾+[#Œkœ=îýÅ–ÚЫq>‰ä+.çÉG±O[„õ ×ÛZë.Šð9|Ï=ùºãöó¹°N@¯¹8âE£Ý°Û»Ã~^ɉ2GP$‡S[œ÷.¬r mäò´¿îöçÞ·a ¾&LvŒzØ×·@Ÿ,ÃzòqàM=‚}¡¿¡_¸€;t r¹SÀ·þFàØ‹y²8äh³óˆøNÛÌÌ1!ß¾Dƒè&‘xxÂa¼çkÈ«—ÁG®ëAàÌ/Ãò¾·€Çͼðr=}øw"ß²¹¿|©s`§oÑ+àÇÔ §±Žüøkcþ<3Œ³{ôeÛ€+ÎuµþGá‡N9“õ¦_nÇfÖQàcø‘¹øÛ ä½Å¼Ž“‡°¸‚gY—ì7z€Oÿø½ŸÁ~ãùéEû{áÿ*òc±Îän|ŸA\ÔÍà3öûÓWЯ~?û˜”óöWÿvðÙÌ|ȼ‡uíðße>s®«Ào.†~Yƒ}öϦà <»éièo-Ä÷EÖkx ³Þ”ÝاÍ2ï›Qo1ÆÓŸ‡ŸÌwŸ‰úË,‡|3óßúsYÜágÀ§² ¼éO!Ocì7úAàö1.•G¡×{žõE97ó<Ëu¹Œy_Î8ÜõiöÑð‡öo/ó¦¢ø¼Ï_¿‚y;ëÍbÊ•äçmèM"¿äðŸAœ¢K¡Ç[¿jAÞϸ¥+ÃÁ÷ìyâä9¢f1Y÷Qö¡ÔØÓæ1ßW"Ž-K¸~g÷ þ« ñíC}iç0÷O`_ ñ‰Ÿd}\$Ž)¬ßÿô-bŸ ”€þ“k)ä¿ xâ!o¢·!?ÆGkźÙ»ÑaæËqø¿‚ü’XÏœ@¼Û£Èë{öOöE•ýS½úã…úÝ=êYŒ>Ú[z üùoúwÈ æun ôÊ?a7º Ÿ†œ¼‰yØoGùñ¹“ùºóÜð´–çB^gý³Å$ôDŽ@^Îý$ÏË}ا0>žü ÎÂN¶¸ÚɇÅ<‘)òÏþ¦²ïè_€‡ã¢)ˆŸ¿òµ§x¾ðœîÿqhyŒùÔ>´M°§ð~dŸÖB<’ä×ØÊóüôxŠÁkèuÔõäÏ‹ýI–³ß a¿ÊüÐÏ8ãcð¦çUÎygÈ»ûnÈgÙå&æßFöÞ»"ô#Å{G‚ý*ÌûÉZö0ï99ö/ïaÏ 9Î{%Ï3•ý&Îï&óYç}'È~¸ŠýSáù”a|Úx¿ÍyQß’÷A|…xO“5Wyúß»$™°‡rçÕþͽzw¹ªí߬óûÒõ²þ£ shapes/data/pongom.dat.rda0000644000176200001440000000133215076647713015223 0ustar liggesusersBZh91AY&SYúØ+á!ÕüstEU~ÿÿÿÿÿÿóÄ@@@@@@ðŽ`Ä5SñM¦™“MÔÐzFêhhyC@4Ÿ¢QB d OPÈ220š`DÈq“ÐÈdddÐЃ#ƒF™ C@*”õLQ¡ i  š Ó#iƒ+6!€+öœ‡+„êŽ?ò’ùTAR;ˆ\ƨ„EÑ@ƒm4&šl¸XVE4 ŽéC¼yiy¢F˜62Ìl ¦Ð4Ä0bÏè}v>ýŽ¿CSa3$·w´ÖËßÆ›8­(•²Á:$øä š3ÁË·»Ï—fǾJg†S#óÕ½%¨º;»{ëK-¦Ðæ v+˜)ó31Œ4ʺâ«íïÅ`GäêA'¥JÂiGd²\„¾ÓºÐ ÇgG ¼¹qÝc¯«Ö=‡¬œWjÚÙÂ…püà+¹þÌ, D°fÆá *ƒIiÀÇ‘€¬íÕ‡OñØý_¼Ó:B“BîfQADÀFyò5È´GO¼O±ht·7þQ³ÄäÛØg"/¦¬Ÿ3b «Ø¸þá­¡ q9°ÚzqÙ;UwÜhEÕRÔŠºR«FEUji\Œ™dLBÊR´TDÌÑUA@QIKM!E,Q4PS0ÍMKQ%Q1 KJ”%rM3$A2A¥‚Q+@§FT ì•Ë4½¾|ÎN6jc y´0PþBc¯ðfH)Ö·x\Í*)Œx“úuÙ»Rtñºû‚ä0ä3xFMLóŠ3 質AçNØ–û†Wζ[ax̆¯%dX8”qÛÚ¨ík<ài†öµ§®Í\nÉ¡i’+ETÞbšèEäÆn´vöðpÎê´•Ü(t«N¸#®t\àFeiênù0+hKˆ”óBaENé÷,ýIYn{¾~X¾H$0#{†aˆ‰a9w~C ]&…O? áð9Ò¶Y–è[[ÔPoÝí?êz>ƒX8“7ò1ªL¼æqÇðʨkt°;¥óÞ–Z; {ñOíP*ù¬ò<ì z¸9`yÙºZOW³¾-ÚqZý͸›wм?¹>5ÈKЮ H!H~Ñïa¼„ºš”–ǹèú páÅÓymtÖÀÓƒÍLi ÈØ"<¥U²–ÌgÀœB‚FÞöÙܳd$¬hÉj0L[“ŸÉÉû7W݈T|ùËŒ”„SŠÑ§æcOv8ysÑGŠúùæØ7Êñ½·Ð.ÊÑ5 óg¥Å#àöñ½xîT‡=æ0ø¡µDc6G(db²tØ©3sCC©¸·É2ë=…Í-µàSܲÀè~äížV‚Mâ&B›twÂU$e%Ì‚|Ø`„Ý=a†V5ƒŽåˆY¨Ù8À8°82Z³8m¶ IZ? ’ôw““²„Ù6“]0ÌKéÜSL5í-Ö¿ë]Sg3ûÐNPY}¶™T«,”ÕöÒEï&h Ã/å•Ž5·H ­½Zr÷Ü>_síƶFhÀšJaUI,„´ka¨ûžæ7ñ’¼Ý5¼æë¤U'I³h³í—ë‚ú‡JØ+“–ˆ¶\)çÚ¹çgS^óknúÞåõ¡8lŠS¢¼š[êÏrÞ*׌É^—/„¨ux pì»h’\Q=rÿc~qêÌ&¬ñŽ©À}¥¾M b¸p!¿¾×+‚£z}XoÁ$¨3²Ú@‰ªJ5X Î_ÈW؉ÂûÿÑ>ámĤ¹ž–Ž¹_•K%³6%¾aB†ÖPÉcUÏ}( F÷š¾DMÑß~_’5°ïá ê¥úÝ-‡®x¸·/f%ÕMzû`«¥É®ïÿæÖVI1&çf&Œ†Osµ üOBšèùÅV{­M$׈î·0Ü¿„÷8ÇY¨}¶×ä“;æ¼3A×8Þmv…üD¶ÓÇÍ ‡LX|ÔF¾”–³ø0%o7žŠ´Ô íhi^ì\1Ã%‘yM«Ìr)Bˆ>Y·‰Æi> ®lSa_‰} )Ýpã&Æ€&ºmªJšÃñÿ¿ Æ†xºÐÓv_™áà¯NLIY¤Ç¡R³²)ž7ÿ"O:Â+LÎT>Bg•&¤E÷' ƒ‘Ç·^‰7aÜ6ÒaFeÌ‘U±ã¶×æyÓ)"{C‚뫈\rþ–Ö§+~œBJ¥ãRrÆÂBRÈ]S:ÊoV䈊ԓœÎ 56¸ŠN¢°»Îföa­ÊˆƒD/mnô’†9>e¾ƒïà Ïì˜r̾‘¥5Ã`ŒÕPR¯úùUd4Œm­UŸ¿)²ìz±Z–¹8<È©7±àú¯Ýñ•ÆîÊïO‹óÐH&»Ìgíu¿íÀaF¼v›eÙƒï¼nyу–K Ÿ†ô* ¢ðÿlH¶òÝ ÂZÿ1¿É ™'VõÜêx(Åc8Ž›ËEþss‹¸9ói¸¡î€Šg+é/ä ⨅uÜãs4¢ëRïÀ}Â4âe7æN@@38 ^TãCGU)Ý"2É×.ÃOÂ’õ™¤É…ÛÃæÀŠ7ïZ!•áré%›hzT%÷‹ßå™\ß{3 X-½\Wem9|ù±,òJ8‡R¤w¹G;Øqî9ÙÇŸèžibÚÈÿ©íŒ"×­'´þ¯4Þ]QËU›m/û{x»ˆl¶º…¾nÆ7-Øù)Kiîl7%̇ºêz³©À=Ø3ôCãPw¹@öáéýsé-äÛGô±„dÇ}轃½Çæ‹ŒE+°J?®NVK\à“ ‡–¤’V´òº±·ñsó'º%îbøœZ34äD 7L¸‹ÛÊwF€íŸ-ÁÇ_Ó@åVJFfzíLí™­¯Íåü—®8cÛºµ]z¸È® y–S%£²ÔI2‚jªúÙ ´ÖŽ¹îŠ]¹9´×¼@ÄŽ¢ã@uò509›N¦t¿³~Ïx› h‹¤s¾eðÞ+h¨ŽÂe>(ÎVš—‰ê Pê \y¶0YÓ{$Ø)ŽÎó¥IÁz™?#.’‘LQ ×ðdûVÙJÎìu§a“m9ŒÇÑ¢À ![ÔÒ'ìn;ˆÖaåÅiÒi{Qt§ oê€ÁLú¦1]\3îÑ—ç$ót|Ø¿fŽpìG/MPÑ5T".¤³ib¿âC§ä|ˆ™©U4n_?Ë/Þ«V73`Œý‰u_01¥wòI­A XÝÛ‚ ¬Ð¶c?ÒH6Þ;–3@ÌÏ5ï)6A…\º¦ÂÊW*r嵄 ‡yBαrUƒç1S}Ö€£§î4]É0ÆQ¿™À÷çfùélÇbLc §kÓ’HŽV}E%ø÷d}(áÞRsŒM™yïy¢àa߉ð üu^‡¥¦Í»ù"+l²ª_¾‹' {›þæJïJvÚ·B‡òíMù‚õ• á˜Wœj,ÊJ¾ÊÔ*Ñþ[²K—ØbÆ{þŽþÇ{§ÎK|*kv"ÿ/O7… õ`¥%çƒf‘jj×áx{ñ]zé‡wÆE¯ØO]ÐVL)È(7¦{¶,HÓfÞ.É2…û•z}<=?߇vMd­Z¸}óR§|~S`¨8¡š”ù“gákÞ è¹Ô¥•·ÓV†ŸP–Þ8gI|j&7`S¶dOõ¯"öOŸH¾©jBlëIf8ëOá Xâ63"%ÐÞÞTɲ Þ†Öx¥»ÓE @¼¹E{˜|Û{t«B–{lâЕ§§ý#]°xeÞm³¶W/oìmŠ\XmôKùŒM/¨ÕOÿ˜½„¥¾jb¼8©¯Ssl› ìè¡ÊÇú¿ËÍÖ[@N÷};Ziýr¬ä†;\*|š§íÁש+ÄQàöñ9çNç–‚uFŒzª2†tŸ=X{<{ M³Ó6‘˜Ò`Õ¼ ôÄ™/è“-Ï1yðvÅ°ùù²†qEø&Õo{ìöEÄy3Fü4tŽÇœŽ¿›Ëqò5ý€Ü÷œ3¾o´)Šù³<í÷©ôë³ «®¥”<À€µO¤ÃÅig+V­žpíô}¾¯C²6‹f]£ú‰8åvòîS¡Z7]³šCŸ{d¸eñHdy¬>t¹JÈ Áù‹ÃB"ý˜Ö±syF$!¤ñ!Ý—Û²©s/º×äH…õ„Æ9;Öy4Jvü‡gâ÷Þ.Œ(AOU¡FÊM:D„ù3T0 µ:gØÈP½Öˆÿz±HÕ¦uLM¸ð¢+zîHT.×à v‰óÝêaTQÖN ¦ø5I¹?Œ­ß9ý&Í¢z[¡ë–Ž¨þšðɽ›´ ÚUôÔg˜>Ý»%ö:«yä<ô¸Ú•^ð0<±r±¿a\=4ŠkPÏD–éÎvÿM¾1–ÿŒ`Õù¾`°qu¬á*±t_¹ÃS9=•;‡¨¢–F»iQü¡ÍV©½Ü!A²”‹Ûâ"€}üõ÷ÕÐÜGwK-ØÈ å¨` ¬œ ñîH,qŸ·ŸÅÂpwŒYd]cW­ÉyyXëfŽ.ɶIjT<Ê¢*qäÝ4ÈÍkÛ>‘ò‡‘š8ñi^'<ÃÁ€v—ÖòöæòÚ*±kÙöd$ò ‰¢mA¬m0àO ]œK ϯ ð¦B¬ÿ¼à~-4^x˃èÿäzµŒ ýÈB1ÞºÞ>EFTå´øYCÇñ‰ý”¯çn뇹/#u>Ó ?É îŠø~¥lÕŽÄ X¾õÄ‚Ä”òõ5Ù<‰6ÆPaT{ž|¥7)-£ÃMöeTÉóãõ}-ߤ‰ÊL‘€¿*$S«:$ ÀQ H0“ÚJbIƒ’ŒÖŒDsŸ ‘6ƒ—±~[ÃA¡vBƒ^¤9[]büìÿ>\Ö}¿Ò!‰ä瀢àÝÏf£—¨5ð˜{“ ˜Ý[g†Q.ZÖ“Kxēݨ Á*¾h¤â¼Ùý«#ÚÊšÆiv±UE¢VdÄœŒBßM°5í´Þ»W‚ÃÐê‚?Q ê¿Ü*í´á•j§©êi à$©Ä}´‚5O€‡÷yÖ«° ‰æ[¨&ï·ˆ1yiEð“1o5¡%øÍÖw‘úOc¸|d½ƒb_ñ§4}.viÃÀ´æáAZ ÎA g£°w†"¾ƒµ Kÿ•lÎõ{Ã1Kw•^g“+X­4f}vì˜-TºA9$Á}"…K¢Í‡Ø~ý©0Pãþ!û'ˆúèEe¥I?gË$þ ie±[:Ëàßû‘(¬3ÒSíöîœý`Ëö!>jjˆþæö¹eõ—ˆËŠ_£ EðBÈvÁ¸Â ±dK÷„“ØókþUÏøÇî”õœb•%«jò uöY9PÙÏ~v;¿=Ѷb4äR$h¤F|ª¼»×«¯öö#¥£ûóÌ~.¸PKb¡,+õ«r…:/ s}ÿkÒàbª»ÿ`Q†t+ÕÂHK¾Ž½ÂÚ7d$%%n=›)Ð<ê~†¯5ëG@Sàìkzû›€&µŠ$`eã ';|ünrýë°lËýï[åP‘Ìí™I®Ý+òÊþ¢V¡w3î†HC˜Š&JÇ9s€˜@€múÓù°ÓèYùZÍpWù|lÁsSGàD×n¿ã À.,ÜbÝ$«›®YSÔãÖü„e=bÚÏ =Fþ¢bu³œÚßž¹sùšV#ù­ìÐÏÐ ZQt®uVn?ìeÃb'wžàð\Ô^÷í› f‹ù8,ôdÃrLªh úë½’£ùåó@ó÷ßæz㸠qåâHKÐ4×µgñVJ;á?4pe›…Ñ麅2£å ÜϲÞqšQCòwÚ2¬"HÚ*€ð¨˜iíî>'MÀtüÊ‚g•ž9í@ O8ºøaªºê1Ok·¶8!¶'}KîN ŽTÓ~—êeoAÅéκwöë…IÒî:#7—Tž )ž•ÓÇ[—™Ð\y¶ÑzèR&¢´ÿa«î~ƒëJk/TF »¿´£Ýº¬§U$ÜçšGU^­ yAÉá;¾æ'.ûÿñë¥i \»Vã¢úÍË°¤²]¾‹"oŒäþ §“æ>AOónìBfN&!^K~j|=üõB¸æœÞƒŒhUÄàe YZ¼áùbûþÃÞ†áó¦Òj%¸?íÐ0¾çÌVê4kŠ[ÊUnç#»p`} *v–Ðb…q· }ý—6¯s«õ´‚fåã;Gˆ2ê í»À üÀ@ÅI[M)žšçÕæì^WhìÍߟÍ;CQže¾=›ðé9êÀSÓÅv1wõ…@>&—Þg«3f½òà/AÞГ"~ÎÛ—Dvèû„ÉU2›`ÞºörìG™ô˜éä©“V¤£Ûy& WmÒôÇ>k‡©£=£í…Þ›ÜÖBã}°RN-¹…C~U½Ü§ô„ ‚ÍiYÀÞº¦)Œ :ŽN ·‘ û~›~m<¡¦E ›ç!ÌGkPÀº»kŸ^ÌàÙ&F€ð/dm ¹É3„‡Wv¡[Ábu­Ö(šEp‚rfEˆÍ<ϸyˆO¶ eïÂü•hEåʈß×í{0Ù›žå³D™ˆÔâf\ر³ð©t3;v8k„M-î–á}µ½´GU’›À/‘[hOÁv%+”š4XËj‹ô)§a—$÷ʾV#è{—ºöeI™LK…S&C(OáÞI‚5;!ôïµÉ|òb\·;8Í.gvT;¥,}Ÿ-¿Xí¡n—]°þ·“K¶!‹‹!¶“2N죂ïæmðvBúqÀi·µ•¡ßДs®Ì½¯ÞIUÌ—·Ù£”`2ûÝø"%¶“gî˜~äVåV*Ž’>ÓkÏ?‚OÂÿHF/¢ãí, šIßk5ô”©½Vf'°í}ê ë°ƒÙ-šcÓY)û6œvpF ÉéN}Æ0 Aæ.²œÌÂ&Äe6‡W,· žrº”‹Y¤‘i”ôÚe&õ/ ±ø±Øá™É%-Ü©ñEHvß•µËô4Ó¯áU…2—õ;ðRÏG„Aš€!Z'°æÓh³.ŠÚ­iIƒ¶„&åD_ØC÷Ü&íBönåJvcðÊï¦ #夆ŽòÁÌi&}6p>K™ßÎÑÚÓ<,«`]cÎÄç¼3À Ök_ˆ;|¢þ¶ÉH·%n¤Æ“šStWu É:‘*úL{j ë€tf¨£c êtþe Ô +#„]±{/(_þ–ò“IÅ”JjþyùrÕ!îeÏAXqynzò6ødbê¤|‡öÎPÐÜù»Z<,ÖŠ`í¼ &8$S éùŸt¶W7ÅôaÁ5tÌŸ·Akª8™ØÛ¬0ÞvJTgv |•Ú[U4Ö%§þÚñ}Õ¸Uæ>ï+è—þâ xC„I“ˆH¡@ ó܆èCu›WÔYüzhwŠHIKŒnÙëï`.¸\£ÇÏ9²BÏ“¹¯*¹ô9ê@º­46VÉY&Ü)ñÅ+‹°Ì^ñê…R( ©8|¯áS¿ý„bˆœ© ùEEG÷k‰ª¨•Iášçª äµsuÌ„;aô$©¯üË@žÑ^»f‰ëÒ M_@¹Ç1¤›Ž¹-ºbì§ ÈŽ¹ºËWž`Š^‹ó#õ|³F—€9ÝÝÜ_Þ0æa«¹!ù0Q+Éß©wåŽ '‘SÎÍœ_ =+"19;y¸¨å€Qìrü]Ž">Ï’:½#Ó¸Y˜âŒ–Ö‚fÒ­/»ÕHŒksn‹ÌǶô·qfÂ|2–r‡÷¤ÌNý£2YÑ3çæëK]še ÌÈÁeå|¿Ñvq²%ß²Zþ¥ÆÔ“aêñ > a*ºòl“×/FU?fŸÄNš`¡&ˆEìnµ*Ò»gCþ=u—mû·ïyQYtu(/“• @¼Áí§)³K\J1¼P½Ê Q2dy1“l‚GÜ–DKôÓ‰ë§ÁEéùì£ñÒ1†Çb’“I&»7¦&ÍäXTK/§N`ÛßsµÆf0”JÍ:ŠRÝxhã0Êm¹uÖ+> ÂFŠ.[ÙÂíðIX'¼ùA«®A[‰rò’¾×ØÏCHÑ¡t¨‹Û¾BÁnuÚó’fX3™KÏøx¸ ™ßU«l Sƒê\õÌ~}zrå™÷8̶Y4¾êágj ²í†:Z2Ü@Çv0f},om;§þr ß:êçµÈqJ “ “’(!²æ±Nœî|²jVÇ;K¢?E,a?<Š_@\‡ÿ¢Ý]SòØ%CaL-A@Z>aT0¸©×J2FŠåŒ³\xs&ÇûI]€|µ%sø¬ŸhýŒï#p5¨B;ª@NBçŒrñuxèU ËdäLÕa3¬ç5¤Ôt€ø°½‰F‹s‘¦WŽÎÆø 0T^n5 $^êš ¨䦌9R¿³¡nÙrÝ þŒlB]Ó7C/#]ƒD‚(„P;Ì~×Çp®Œ©@Œ pû­u¥„[GOj÷U3 ëîzÿUÝC"ǶP÷Ê%ŠõþáÔ>™˜-£Ú+1)ßà#nî¼7Ó›&å@"MKèÔçž ŒþM ÄB¤T¹—}¼õ$”ŸŒÀàx QJf ?Ö~ׇsQJß´¤z\¹V†ÏnÈ`ÎÆðe.Émpô ð"´{÷W£7 ¬0$úIÈi1_¶À³™ýv¦±²žß’ùhl³p:-'©öSzý !VâËö§âšÐÑØ¥n™ìì9Ä#úôÞ³/ô~X–”PöëÎ=K»£X^ M·ó¶ªÂ©#ÀÜe¡©C'«WÜËš0;køaº«)–t‚ú-Ñ@c©0:ƒ&–hÊ»B2È’ì ”\¼›@Þà±ßjXÔfŽ³‚–Ûd„gñ5ÁØ`BÄWÒ¯™«’î,î3˜’ÁšÀ8w ìLöTÂv±Xd¹›ÏŽWEÈ‘‰T;7_=.¬Y»‚ÿ•Ëì4¶Ûo…›`ó¼ÈSß ^í^‹œ[¦5ð€ÁÇ—HîbÔÇLùU+‹X¦3Títññ:«÷rþO«ì~hW,¾U%Ä4r*§µôØ.J¾OžmÑˬ¾çŽ@ÞƒL°°ÐêPh¥ûv €€×àYN׉ÇÏã¤%K`µëMóƒé Ýñ¸æ½›idF›¯Ñ÷hÁÎÁ—T©HÄï6¸°±.êéœL”_)TÆ/­€Óü¡ ;‹œ¯,þj껤ë·QÙÚÍrq8_5ì—sÞmĆˆ”¾|Dq|\iCTYâ6‡Ö°ˆ£hRí½E†ˆ#újâò·ŠôÖži”â M¹ÛØ»¼):P´Q¦‘žÝ+¦¢:/zD…F€Ä_„Œ¶B(6*ìqùuÔv&PYðBS ÿ¸óÖcÄ@q#Ö»ôôûÜÂ㫹í–íø÷£ê?‹aÒÜ2›Évx¦Ê¼éºO$äÞ­¹Ò¥î%ê[ ™„a|‰¹€ÓUþW8Ÿyae±¿|Õï"8Aexß…½±~:ñ .VV[[ëŽ Úì¥.Ñ_ÑÇu²Žï.€&¯{eµÅ·¦Gb<+6~Þ-1¦4…¹•ne¸è¥]JöÔ¿tÂÜ8–· 0ýZ¸CµÖ•KKÊ{bÄQ}ý¨Z”CÌ&k…Å®]{Vâ’>Z DûE]ª_€ø„(ÎÛ^óißiâHK¡a@ƒ¶+wAæI¼K\†CÇÝnú+êüŠ£ÒA™¥ÊaáÜ$” ^kêA8M.zÇAâ;ø R(Ùjø1uÓ%FP[ZJl*ß‹ð–w}ôWn{Ü<$wMU°ÖÖÛ‘~ r²YYuqÁ¬Ë9YÁ›ì“#íÌc¹Ä}ZxŠª †ëq¢ äíõ&¾%bÅch”VµÊó="íÍaÅaˆõClŽxôv¾z­•–älýGè°‰›Çˆ-az ÏL«ñɳŸoòþµ9ÆýÔ}sÒ YG¼=7Ýé†;שּׁžIiG­PÂKø&òî-}ÇF-V´—ª:²I®ú• ,c"íÝ.Æöd¾[à¹À£MBlkO6R!wPx( º4¨¢Pnç …ŒÞM£ÒMcz–.;VæŸÛ­Á×Ré¢Qªº%X£·-l{fÝ;áÉ¢>‘ÓÒ!> ZìÃ/»?–AD-n ^¡ÉipÒ™Ž¤hÝkùŽÚlÄ[?Hš2<ˆt¤Âi”Çý™° ÚbO#Ï"Sò_R °“à,û—× <–«^±<ïÍé`¢¤¢‰ ÜZ -ã'îae܇©`^çÚ òá› ­o›düJv÷=ý]—% gJß½ Q"aÈ2“"ižÕ+O•‰VRBTú‰“Ùq ƒóGP侩´È±À¨,]hñ·1ë_‚>ƒ#kNË¡ïUâÝ+áÁÌ k0òaòÁ ¤Á\©‚·—GÜ~âÞE4É=§(_¥<l²QåüÑ-¾RrÐúD4ºTöþHµ%¤JË°qìÃøîü5>Õ1¦§‚¿–¯*5 VCÁÉ.D¹g§YYˆ.!xÒ80:èqþÕg‰»ôàÂè*ÐÏ'–¨˜$.aùlšË£V¿}]b)3ë_¨™_÷ÚVO‡£¶&WÒv{}¯È$¤ÝWOgƒ·óUŸL­Îüªè¥|w—ßìÜ2{¹óÙ¼æ¦[íµ<¤‘VZ[ö%›Â8¨KbëÛt÷¢}º “r ÷­YŽ=HÎ&È„ºîž­Ù·r¿ªR¬{…ʺ›~:FžE;«LDKÃ#nç¾ãå°D-/+ZÍ̪õø°\rYn³hüÀ%ª%ÈìÇ5µ=„3²ÖBm£¾¨˜9 “²þüTÄw`=™Èa·IvxB–êŒî1|žûøv@S„cÉE ÑÍx«½ƒC•›› TñÛÙþ:1“.Äšî8¾†@ Ÿ«sêuCà ´Zý!JˆÅ\ï‚ÌÝB8ØÉ«©…S”“.ÌO2`ÚµÌFL>00 ³„§.WnÊLBïk./˜n¾€¶“’©¸ 8öD ñçñdã4ŽB÷eTŽB¿D]C¼ÁÇæí×\íÓÑ{6rÃFé:è˜õ^ßRN(fìÆ6줉d½ š;†gÄL·f{£‘ÎEàù”(Ò~67ü#³rwHýøJ„Ò H®¸Æê;Ææ&h¶qÞÅ• ‡`þÜ>Ç{YÕg0«+¼F"INñƒ4è7œ:éýètÙ/·g2Æåš&¿¤»ü¤6sG@”†’=IÀ¸,™¾¹F„÷û’§ô {7õ$¥CÕŒ·9ˆÛÍÓY#ÆXõãC—Jå3^4åm’(Ó8ƒmíÕüÌS3;¾Òñ=BˆÍ ‹q˜(¼ûâµÑqÍ1;Çgq樣8(ÏeV¯ÐH@Æ0Dz¯Ð%g%PÁ]+ù»Q%ð¾éÆÈ+ÊMæQÅ`ÍiåÈœ¼šA[=3%Š;%µ¨´ŠQYoND1 Ü%éù ½ž¨] 4„yJ!­€¢ÇeÐ2lKæ¥6{Þ¾_†÷ÿjÏxtOÝšiïEòŽ@}õöµ„Ïç°·bBC‡÷à1ó¦^јþ|qAÏ%S$pæÇt]µ)ÆðÚWÜÆà§ylÃOÎE±y+fº °U‰Åì.ã j 탻q=5!Ý¿&~v5ŠÙ®@¢ßkêªT>ì÷ÁáÍKߺó{Ùü_ÙMmÜ ›¿Tâ6®‰Áò³’œ\xv éRÁíjòapüù.Ÿ©7<ÕR>J(™Oš=÷ ¼„)þ3éD;˜ê«F耥…3®ì\K2ã«È¹úÜAà$“õçGÂUÁCaÉîÕú3ˆ-5£ ¦Ó Ê#‰Ÿ¬J ÑqšRõ+°žQËœ²Èp<W6¯¯s#yÚTF®!w)À bêa€Èôàë° p$¨‹¡ÆäÔíB•Ýª¨¤î§ˆìdñp5»…Iµ Ú¼x­ðÒ@ÞVh?|]ÜÚAÆ&m@ÄC}ûD|þ<$ýçãƒÃœÐOB꿧!p”ñíd²òq émsë—kÿøP×HÃYŸý¾ì9¯Ñ·_Ú<ÒlI»7Эq8!‹¬0>€ïáÏé»û¯L![6›®ÌOÉò­wâ0¤ÄÉZg?Ý'x*ç‘üÈFéº×ptPÁÀDÚÚívm!¤QºaªW>újÁ_¾×&€3§(RûšI†í™(ñlàl9`Ò]Ä|Ì÷– ½_–‹ªN“…´cÿçàíag¦ôtPª >ÖÀ$ϧŸ”­mFÁYg›dïœrÕ‹ªŸ;âÏ•É´2õq­”wŠÄq™ÁÆ‘Ù2­}9ïÙHý®OM4á>ËúºJ3ÕµÕ eiìMI·ž¿MÅRýé‚fþ4qÕ>+èÀ5|` ŠÁk:ìû¬æ¤xÍðeDv…pÑ.G¾”` äüüU$\ÕG‹O–Ò» Y£ Po³eBøbÓG¬ç[Ú¯öf˜‚3¥k£ãA„9÷Xfâ.]èD“R„¶y»S$¿eòv’ðgŽ¡¿µ@›z¼ëÐ/ˆ)v¥¢] eìs– ò|¡‘&Àiç\É0Èj´F(ø‹dmI[Þ{AKô r.…NJÖ \³ä¡ù @Bžï¹9"ÎäÆK!sÛí¬MOW3è =Ëš™(ýªB´†% (Ÿû‡À¿M"¾$L,€‹a3+ÆW#aXšÀ[»æcNŒófLkº»±åÖ–·«`Åæð9PÙ×Aݯ@Iïdáé¦Ì21³ð…ÓÐNd â¾½—£™¿*Áø­'zÀc±ìèâÈHL¡ËÂ~x–ð©ƒI3C@–­Ë$z-at¼XA¥Rݬö³Ê¨ŒÉKú5ruéÇ{½Á„#1f°kÔ_~‘aqu´˜´ÒõìBy-j«¸Ê’[ãPÜ5¼A’7Íů«m¦–+qÂЫõïÉÖã—»®j~ÔÓy +³ #¥‘èfN¤4æz»n ì*œZUþ›xz´"I×ÊâùŽ£ŸÊ_O@§7[P ì§CyÛ l°é|,¿i½¶`‘ÑŸëÚŽ´Tsgl‹<ÜpÓ/ÈÈdûmŽ¸¢&TàúmÜ%ÒÚL6¨(,ÄK!çdš!¢¸Î4fmz5#/ ·´úØ\£xq6iâŲjÍ\¶B¼WìYW.yÁ!Å"Q0Т¥dêmä/W<–züJ© ßÝ<¯êú4­ž¨sëzèäÃL·ÄQ³þhø2|]+èãGb«úø‡hù”ÖÇ9ù/Ûè½€Ô2D€ÜsPiŠ X•Iëõ{Ú70«nfn°:ÊYƒÃÄ'Èј1K&ªþ}¤M2îšö¬#~äQïƒïÜÐ#[U (á3*¤Ôª%&ˆ¸l}/} ¶S$€ôÚð-P*:=ì7{4+å…•íݨˆ²!à¸R‰‡g„³íöqH†ú¥ƒ“÷— àÆZN`ˆ5½…Zï]Ä¸Û SÂ-¿õ`äý*Ú_ =5ëç‡ ý1h°}Ÿp†N=+kw6÷ &£’wuúöE$P”Û5ýãSÅS£Ò‚ñ/¹ެØڔغ1ÅŒ¦u±­z´ë€ëƒ t¸j¯r¬ÍH&¤þjÚ­€~¯º°ûø…IR:_È<Œ™  šrEhÇŇ-9ýž™†1$q€ÊÏؽ(–ò³ö&4Éû;ª¾1@ûyøÏœÏ5*(uêA"÷}i&ÌFø¦‰.iá¶w×[wV‚Ú„)ú=5Ót~þ+†PùÈÂô5\¨Ð0éMVÖ+ª*WSè×8j.‡_Ü6¢L«Ïɱ;Œ¿Ó§óG'èïŠ>©“P\Û\œãà°~ˆû.ùy² Ã)g˜¸aYO¡íC¹ÆWz¬"]bP$Ë ˆÜ$#aß¾–Õ=ƒC^á [e''Ë:“íŽ9à •lVqÜaU ¶2íÚ¾DœiÓdý$aK<9¡vf´púôn“þ°™'Ò¥”T\~¿ðÆ“û•ÒoÁiÍ aXEOÆ 8þªëü4èg™aùñÿþá„0íÉєşE”âêås¸TŸÖ !ë†Ë§{^;€04NÜÁ‰­‹Ö¬[s;𯀥öO›PVy'’²˜z *ƒTßm¿ `Ó9Ì“ ç.õÛël‹òFQ¥{™¢_î·"7LÔSX9†N ú ÂÚ’‰Ñàvviÿ8¸¤¨t7Š«7mF¯QÚj_I²n +êH–AmÙQ}¸ýÚœ¯ìArèNcž¤ÅÜÉE{q!vÖè-òÀŽ]äDqg„%<é{gYø8¦”]6I€wëOÎÄ”°ŠÉÎþÇË,1óCö»Ò˜¡"ÙUô”ülš*yÙ`89—G£_Øý÷<‘ *k¿òäùJ8”ÀJŠÍöªZÆrmäwób”%VdyQ¨ò-ŸŒÔå øS”ÉA—p^ ÐÈñDð^|Y•EÌŽpËÓGpÌK,7ˆ|¥(h+eau­,\Ðò.Sœ• æ9(¶… °áß¾é— ÏÑQ 88ýïlìjm«ßŒ’”q`2‹ˆ+Ž^i÷Ò÷ÇéêõJŒ»î6OˆÎ.°ûL‡8ÈEY ¯:„ÙkæqÀmFãšF3Àïó€ó¤á3«[šÃí@qŒõEæTÉw´ð§ÄyŽ[“ÄHàÒî„fNƒù‘8ÇñùÊnÚ4CeJ„†xQŒ}ý±û?¹šÔ L°¢ôûN)8ü~úê\ʨÓÝn·FÃT ,ŸÂu©Í… ?¾L9|™ïÌhËSßÞ=I(×cÄ®«è¯~@Oêj9ôlŽ =‹ËüÙk{ê&V`‚¾P¶êºÿ¸´FR|v¢‹Ý³ok•³í¯Dé7üW Ý]ðeSm“w¾¬áD•ò@Ø”. 5W»WÐ4ùŒ<~€”ùjUS´úTQ£¶¨”2r`¶iKâæ!Hš%LM÷Ù¢¾EéÝZ–ü\°]äüœTEwéOMäk+ŠDà"«@?xpñF†#„áÛÃU™ˆS ñè‰s©a´›^V9)~Ù¯Ñ2¥¶‚ ¡Ä=M_²0cÆÝX¦RGÁg?ÐJ¿¹ÊKùÛ7‚( >ìøs²õ-û©=á×DˆF©J{Jºßä/R(g´Ì¤ ’ÍrÐChñ³Ûªži¼u±B£)`aÀq3˜m7¬$3=õ³ßýCÄë´h¬’….•(·,bsppü­B¢¤O¬£58ØÝ « œ¾þ{b¡l’—ÅïЇèO¾¼jQôÈÛ=âSÔUï|ø|áJDùH’;“Å„óÊÞ!dU~˜ôáŸb´Ä»nlÅâÉÖ!@Åè÷Õ(zá ¸¾´Ë®¡Æé»ÜPW jFÍÛû$²‹‹Ñ°Z ˜²Ÿ¼»åPÆá½ã7f3în3=X=înÉWV±Í¥g¬÷}†¿ÁW3åëÀ¾g÷©˜*†›Ì‚ÈÄÔ˜Ù leBù PŽqó†b~efÂÇiË$Ü÷ß@³{÷Pô´üé"Id?¢MŒåcæk­žF+_ÕJæûU“¥·7ÎAI¶6|"mÊWÚ5žÍ3耶ÃÓüyúf˜ê¸ÌlŠ§çJüù6f‘¿öHñì̳2‰B#+Í~^B©öƒïGˆ¨„ÿ°Î3ÞdËhnN:ÊT³ˆ;:zksué(=cMŠ·2ÞðïÙ\â¸O®bÏg!"`ž.¤kVö¥Øl®‰{E~àŸë/|GP>Y6‰Ñ#ü c¬u9ÝØnˆ÷ÇÎFÜž­Qµ ii´-I ÜrG$OZ€ö~Šðb+›§gÓ‡'™‹V&¢ÂXzœë=TÙhövÞ 43¬“´Â>Å\"rìŒN©Jt–3¨Æļá£s¯Ð¤êÓ;•hÞ¥!qFjtvMY¼¡ìq¼b/øæc v•Am¡¥b;ö’éKŸýX­´Xvaž„&Ž5Éa öOž¶<š,.© £äÜoxÝÝ uª?®[5[l"yfwù³脦ý9O˜/—<}«Çb"!Go»¼EFüë6u !:c^*Ç*ÿƒ‘,Ž_½cF~îf671¤wtý|°¦^'F£@hJ¢bÈÍzУ—šÂXœÊ/hÒZ ˆˆ8+  ¢žPè±ñoÌyé3ý£ñʈÂóã—Uy¸Ê÷*¦‚¬…Öª!Ïe2­±Á7â7-vìË¡Ù¶ýF@¨+{œ8ÞçÈ3þqôv,»‚QJHßp¾RÓÚ¿Ë«‹Óé¬ößñÄ dm²q¦þ d²]wK¿ý&s‡X%»(§Yy¹`6ƒÂ×MB{6•ão1(Ÿå—ï=ÚßÔõ7¾ˆðž»kŸ¾¥ŸñW†É¼¿ÞæÌ+ZŽ´†o¿Í’ÂƈšPW[oBË™81MÚ3ôã¶eŠZ#B{†eI¸¦= ª=‰ìºæ!ëçè‚»bKaŽàëc/Š628¸Ë7Éå÷¢¼ü…`¬ [a¾eGÂyuÛ©Ÿâ'[-H÷º¨~WgÛQ·†×!ãsÅ Ð]ŸQMÀ:47Ü*/Ù,C#oÝìQ+ÊÓ°©é Ÿ?$Q8Oq' §~Vl :¹vд^‡Î0:#E”øaÔ÷Ë—F¯@e¦48V'FI–žíWUµ$vPª…òw¤z›ŸÒµ|œ°wQõn;à"霋KGLú®ãƒ»KjéqY¾@áÄxc€à¬‡ŒaÒ®ðZÚèwZIÂ._MÅqfM‚w\o® C½pŠî´jäÃïg ÝNï‰SÝN²øùM’Ï#¶ÏãuÚ¥€…§¿÷ÃzâÕïÿWiéßçÔ]ÓŒ‚J×-¸ª€lÏR6’¾lÉh¬³Ê‘£>fÏsèo7Ÿ¿Yóg„mò^ê†ÄH?ˆ*Ì¿)ŽCŽ Ò†·î¢ï„ž¼^[EÒ‰ËLF}¦9ó¢­ÁÖaoFM9’xq¥3Tw~“©ŒæqáþŽ1?`Üúù¯pý­±Ëê» 0uz¼aÁ6³…½òLlZЭ¨ŽHJMC§Å›­ÛQ ßÿ91Mÿ€SöÊ ÍWû"r ráccãmÀi€(Î>¹ô¦UuîÒCÍRµæ¤ôb`BY) /`Ng§5?}9.|,k²Å¢Ècº›M ÷³6Ç0¢°[âööÃ*ܳå<ÐÇ?ƒ{Œé§·’WeNYaÜõñ·X†>&UHå½Ñ¬äÖÏ=1M›Ûùµ+‡C\÷ƒSâB¸‰KZ»qÓ=6F\ƒC\‡‡¬‡JW™àŠòJø€g?‰†1ØÅRüöøªTÍr‚º¹ÙØÍ=‘ç~›J›f§´_ó¤SÜ/Žâ=É]-“Iw E3–éxk"V(>BD×ÕeWB€ÇàcµF,Þ`L2ž•ÝÑàʵA„Äö¦-ÕçœÉ© Ö7¡(¸\Aq!2W–õ¬ß_¤äò`x'/.kb2Źh…~S.ìÅúT"îoÀmîÓÀB½Z¥R ÚÌB V…ÇX¼Ÿ•*÷ÙH–SE·­ßAbÏr ÁÒ,6ÀV͌ͻœ<"&–q ‡Rjà’Ê,ü^hŦ›€ö[-ª‡Y·Nç÷øÝ€ƒÈ•³þJÉ?V^¼º57:ãm°°AÌEƒy›L Œì¯ëq—µ«­ç´¢EÈ_» dÞ©-/Gè,‚x¢â÷OíúShNW¡B"^9aý­¸Œmð¿ª84Šl µ±Ùõpíú;~´£$J À8ŽTûÇ–ž::€Š=,àWYJ¹?…óƒo¼Œ‘Ó(TˆÔhQ9)q^µüa]EùÄ2€¾Ñà`јfÄ,åÔÓ,. „ÊæQ=«!(ts”6ã6‰‚Ö®0níÑž ÿ[²» ­Ìûìª1Œ£Ia(éwt^@øÊ¥¸¸Ô± ^ø'6i%aßM=Ñ©Ñѵùîð¥Ú Äì6èù;((ÚÝ<£ÛR6‚àI6«@Žl& Ü9ÿo£ eô*¶$%½íaÆJJÿ«ÿ1GÀ7ºáA–Écº@»¶¯(ä4ŒíËć‰Û8öŽp‰7ƒ˜úÎ÷¬ù!Y%ež½Ë?J:˜ PY/÷Ƴ¥EгÛpøßÆë12—€¾·Û/¿¡š”T0õöåG4¬¡L",z”Ô¨qåöã—]0™éå¶rmQœ‰"dÔLà„íßì•|?sÀ°:§¨Wé ¢p“Øh>7_“tœ¥ á…¶}½<õ6>id®!=­ÈfâßF,*Ÿ8- £Œ«tä*ÐÄñ^«yX±úÃhìÞ)aÝ|Éaû±nÀIôÏCÎQ½VA´i ›ˆbnÁ9;åCcp1Rdíƒ\¿¿@¼nñ'à•ÅQ¹œ¸=|G] À­#EÑ·äÃ)EN¿‚g­ïy?C‰_÷.0@˜>\kÛ*øDx<ŸÑä‹CuŸ€|xPBmÕ³!Í—reÛâ/;_èñ>Ë­ßÒ%;Öîô½õÚ×7’™¤7}Ÿá»AlkmÞ¿;—K«ÈpŒ—eöçžå´$ª®LMî†Ëú9^„ûfÉÆÌôÀ@ìD|Z>Oþl}/ú¤¹¢¤Aq®-Ngik²Ü”¹aOöÙ.»áÑŸ¶T¸ìÅv£IW®ÝvH¶ã ÙkÁcðvú…m ƒ hÛ6¢É°MU0›ò²ŒV¡Î ƒæþlo¨$e²!kõ`Œ¾MªËeù‹L ¹¶»s¤€¤?ü…ž:¡‘-TrŠFK£ÒL¹÷yªL¾¿dè(N•^xÏóÝ Ç¤²Ž:³í4I%žh…ð¨“цÚFÉ\ö˜/РÊÏ -Ë%LZCîÙ¶ük”€À¸[RÍH©ðÁe8õH”ïg:J™Éf½:¸ƒÁ|ø[´oœóÈhu¬Âk1A– @ÕO»Œ|Sc;R¯~zœËŸ£Ô£&Ó Z¥Xzß±•쥈ÇMõ_Çë.lX‚n€3†ú»ýPL± Sã›À»PæjMEKÂÚ#À†wp¨¦˜Y¸A~i`„:È"k½§;¦±V ½õáÌð;T¾ßf½éåtô²Šh¼t]Õ¢ÚQÆЊìW‡¼?HÅ–mï*7$KÆáqèªòx/MRüdÓ_=&­UhÂJ€9#·!ž ¦òøð‰üûeÜ‘Ç~X Û½nu™hèzûuÆàžÔ{Z-ã "D®äbVÛD¹!ûj×N(BÒÒmð¾E"Ê“Ù¨üJ×ê˜rNw”­“³íÇuVôa¹ÿ†êÝ-3>»,ŒVñN´ï.´ÛÓšcÙ:ŒÉ8VПŠH*úíÓI„ ã$ô³`ޑ픡ðB­&«Iq¸ßÍWµ»ƒW·+Ç0dgð¶ásQÜõÌ7ôBÎ¥¿[s-.ÿ®|˜ÍÀ%¼² jZoE—”õ¸Æ´ÿ3¯&;ÓïÏ<#¤o‚Œ|A ‘ÞI ` ðùäžfÊÞA±c£çÂot4ÿ¿ƒ÷”Þ‚$d·tžó^¼%P×/+o­E[äš\h{°þ~ÞÜ#ÈÇ0E¾ü)üV«´ú§c'W.>Á\·äíÔ òÙœ!gOånþ6h˜œàL/,¥åàÌ ×¤¦ ½ô‚…;7±CìP”ûøMº?OEwȽ[ôgÿU&UŒgåÚf.Þ­ó<êÐ. bBCÿ3qéÊjQÿ­nû<ŠâIí .‰ß¥í•¿ÜÁI¶ñ†cã‹7óE,€¨õ*dƒÝêä}¸löûÉ£¬§÷MD¾·¯¥‰ûä[»Ý½kê­Â6 q‘×UL)+b’@M¦Ú;‚Êéû0äÿæs£€yå(}\½t:’EÐ!N?5d>*P–L3Ü=¿õdA0戌"6xvBøù2rêBïC¶~ŒÈÄ»“\~LU2e õ"ÆM’êV‹íùˆ>™µï­'"|ÝʈSÿWQ`A$ø”Ÿª[Äv;‚+õ7d»ÿ›l¯\XX{'°xE!'Ylj7Ö¤F;· »WH ¾¤þd·^P–äVd¾Ê@|pRDË^óðê«áI¦¦ñL„¢ßËßÜdœŽ‰ò.¬ì%þ£¿6h%ò­ ÖÎQî‘z×çÚZè¡‚ìGmÒ×\8cÒ=¶¡¢À„ǧæQÆ»QNíÉÒú]æ¨*ÉÎ6ûJu È‘¥§-gk[vÓljr6è“‹U@”æ\¯´¤Õ!kA ’.Êÿç¸ô‹<¥Yo\(çûÚß…b¡8µJyäj Õ\oè<Òi¦¤’–gW TdyÇ ô2»h¥®¶úœ¯¹_‹Im s`P2{¥NBØ`'àüÆ<áÏá¨ÖÐÃò©r3âvÜ5ËøÕRæ2Eg/2 iYþ¢cn*ÿ«ˆ’èO»àn¼°µò½®½> •HÙz¿û[/ãŠÙÂõ–WÊc )‡g7¥Ò_4,/eR»pŠi‚%AêCt}œÙTLo×çs1sÞxãì·Ù¢N¦O8 šâîe÷ò8Q‡pÓ ˆQÕE0ªNj©G.‚yÏßîœ✊»–ã6ì0»üîG Cq /¨¤4Ë‘P㇯~ÿ\kÅðF¶ˆÀÉlÊ›W:Ìb—fW ¢X½H!ó„À¨# Uô` h]ÁO:  XKbƒÑÍ¥1%¥Ø*ã'ªÍIdA'à䨘ÎMÕÛ†Ô—«éOgoö÷­yF–|·˜ý›ã¥XŒ@VJÿUb´üCÂ뮡Æ`Ȳ¨ÇùRÛ$!PÇçnTL'Ý?!5êôL„ ¤“:/ƒ|¦m¡AÙälnsCC¡š>’ÀKfXhè~?†ˆgùþ8ïOœo ìi&Y‘ï(sæp*E­Žª‚¡µÒåUä-»¼Ê˜Ï¯§X=—W=ä‚ž=Îì’¨wI$´Óúǃ2™žò´“Kój §N žžð¸/Ê-›lŽD0õÍoSöÌõEõ‡Á£áµPº~R4—,l­zw49Û1 ö}è6‰¥ç¼ay™B GÏ M»ç¹Ä¤áàÙ ÖœNæH§SÏËQ8ZèÔ F”œIùòm¹ª!âÆ1¼ ¯Ø7ºTÇ ±èN*yù[-Ƥ@Hð:m"óüÝi¶NùõìʳFáb×’ºùæ"·¸ìͼ®M°œËÌw\|•”ïY¼è î†~ïE(bA¹iÐG ˆ\6^ÂU­]ÆaìÍpʉbàøS\Ù. ®¸£*¼³hðŸƒet« $Üc¯ñVi©¢•ŠC,Ã@ŠÌ»%XƵ:4(O±·ï¼€XA4› )ÁbEÃ;V€wÙü nU<}tX6th–86U¾S$,é$¼?¾ÿ5¾>Þ·ßÞ:V_Š…©p÷ #è|yYÀÐCË©Š¤Á‹RXLÙzýÀØ°QJÞ¢Æ\8߈¤ÏÁ3ø!4™é+1›gtGðldž{„ ˜Š¡ ºx]ÄåTL5²¢\YSáǽwŒuöæ‹`M™°´¡*Ý0"Ù”Ñr¢0Û <³Àìø»@†æBóa×òÇo Øé¨{Y¶á”gãH¡TH(±ubËÖÑ-Òyk¬{TÙç]ÖªŽ¬Ì‰„ÎüàÿŒÐXÎ&ž¦ÿñI`À³Ø医”Î ð…É+xáýˆõ/ø\å›æ.ž]Ïòñ.sn&°Êq5¸ýé¤óÖo ¤é¹[ÏnÉš¦*—æLÍUÀœ[x8µ1’ù‘p9(=¹­ÀwS¸Þ]^Ãeú d4AÑO~;0üZFúrŒ±N§Ým•ñgËgŒ&¶äW, ¥@€5k‰'^G%鱓U,o†1>3‚uØÄ–$˜œÞÛÆ®¹.Š;÷»’CŽvˆxž¤½Y¸ÜJjÎÃ+­A ûò’­|„º’ÌÉAæ­£ÐËúçлˆË±äsÅØU†ÖJ Aý°–ºS+Ï„ž§Økú5…Yü4Ÿ@Ïh÷Êw¦Xíß ¥»9 5·¤PÀ(D²C,ÇšÂ! ±Kw ® p)]õñ¬My«¹ç¡{K=U.9¡Áäý^§ D“˜X÷Zf ÏfGx-‹ê'ýõâ£vûȪ‡ì6’Ãà“£ÜÌwÍU$›Ðw¸ø—¹#d–råDíä9ñÑ1uŒ Y€úù—ìCE`÷Gô¹ü÷n,ó¡Œüòê½%P,k´Dà“ÃÔ>Z†f´0Q¥I‰vCÈ·-he! ·þmãŠrª!膧·ÊsÞë»ø'bÙiDz‚Þ§SÔýɯÄ@:Ð×={P·R1ySbCzÏÕV1ˆ×šÎ!-Ì)ìäö2V‰ž•ÎážhWfëaRÏžk™)>³95ïq"ÙüÊÖå^&zE-€”=<'/.b/ò*Ƨ‰Pç>WÎßöìÅxÛpø«¢?} ñ»´ôã}ŠfˆZâ–ðÝ!ºŸ ¶È—T-nÿêY-¨óê¬ÿmÂSs¿·¢Ô\Â’ q±‚i¼#Z¸â'îºÿ˜ò0'²[y¦ØAr±¬ù‡ø3låyLU oÀš|©y$:PlŠŒÝ¤ž@’-xq€½ÝL^wÿppàæX¸Æ´ôð³ =;¦wV8F ãÙƒv«åò&ÛA$vrè,E“ .u›²(M}ªÍÀœ-3ÙÕ9¯=ÕËZZoÝÔ8gÂWM?å?èQ8¤•b†˜–ÃFòܲ£múÜ÷]|ÄCÉ•¬¿A ="`• ùpí5Žû $P—q8u’É;yŠ›ê—y1$TžjóHâGTÌÜõ–#„ò#(ÀÎÂå¨ó~ÌzDB΃|N_ ð9ì>i·ÝW}Nç øsß)zpiS}J¥XòPÊ<”óÈup€Q=UþI°«Œ8BŸ(* |wvÐj˜šë~k'VpfÂ4TÕº¢íÈû·x7qënEO>˜®h Vyú Æ#,ªÀQ!Ì|àZ>„a0¾²yþÍójjÒ•´S/󆿅¿  KrÓ=£ü!¦:y9²ý£áoÎ)úI¼Xál¡‹¦:½ÑlkÿˆÌ¯³³‰8QOÓ¡ª¸ÈµcH¼\м]ÚpX.ôyBÞ½}Ñy³vžðÖ­EQ3ƒÉÚI™gÁ¼ú¾ E„‹ÕvœŽ„Ç6ÿ?&gØáÓ¡šüï"z­]±JM…-ŸŠ’þ5G `M7¶6ÿ‘x”ŠÿöãzÜ$dyÓ†h°ÎeqÃ'ˆÝ¾¥ µgWJ­äªVxøvÈw¶"·® ÔÍ=ß–›é Š6Ñ }H—–¹Q割ì}5n™X Ëï™­Eð£ì~¥y^yåF×ÀÙû ;Aƒ\S0šžBÛa–ÑíT¶Xí”!j”•"W* Z>‡™’¡»éâ+•«2Ý81û¨¬EFä’=½Ü#À0Ñ8[-%éØUT+¼–²ToÚCŒÄ37ö|ÝSˆO~ˈsëØSŠzšxsCçŸ 5ÚJnìUÃzôN*nÂÉCü”žØ×–Ž» ­,áógOž‹ER¤ö#3JÄžM …ÄÌxõÜäcsÄóµTÝÖØ.ˆl¬Éû?¢l¤ ~í·ƒ5¨Êä\WÔžÓnð*æó"-EG‰.¤Â>™õs£Nbœk”ßè¨ ®ºëyzšYëvÓV†cÖ[a þ!M3F V\¤ —×ûÁõy4±¸44 œ•ºÃ¸¦ó~K„¶äÒvŒ¹‘˜14nÛ5ÔF­5 §P¨Á‚¨¾x•ñÇ>·0éXO+ ÿ¼ZW“k'ú É41k“lòeEŒËI9œ=´—WŸã—ƒ o——N"WÏÅq84òãÝ8Å-¯Ý¶'GëÖ× `Æc¤›Ô¨SíýH"›f×ÊùëqK‚¡3¤ÉYlx+kžD¾H¨CBe\º„/›ÍHØ·ôxg;„A¡‚†)Ê=Çz²ÔXÀT5=œ#Bä3,Ï‹‡ îzñ˧҄¢Î}|'t“ú/!F=² Š2çóŒÈö51Ó7i¬~J\C'©w;`¸bý‘ àÀxs™Ü.K„0’teI(ørŒÖ,′†Õ¹¥Aßã_ßvhZ•/–Ú߸ñéWª+Íè-àwobb•Ñ¿ 4ØX^‡jŒpz8·+›¹ñ¨c™Kôbcø …pAÄI#†£ÆÍF÷å¿; »A%Ûêt¼óßœIƒ€qkéÖΩü^:!ÁÛÅøAfYç%åY«@Ì 1-¨;´¢ë”â4¾û¤Œ•ˆ^¤D5mÅ×t@Ìl ›ÑIñ‡ý7áoî/pl þ¾rŽ„·oÜô¿ÚE®‰–™õ2 {ç^1½Ä\DLÂìcÐ!ç™;KNPˆ<‰>Š»›‚Ás#jKÇ/.œü^Õœù­½Ön¡k6ëI¥»ð¼ÐÊ$¸œ²WMï<.ÄŸÓmYàM}¢õr±Yæ¢óTtå~ÆæM¦a l9x·\«¨‡Ç[;þ»)Y¢:‡àù‹â™ì ïæ0©³¤’ç!‡†9C´áå«æuN„YžâB6™œÕ2 ãÉÜµÞ ©hûƒˆâµ‡ÕÚ°ίsöpo˜v¤w°šê®—ѪW„ߧh¥B‘Š™/ƒ=ÝäÃÅÍÈ 6Ò©þ_û_5'VöyÈÖ‡Tþ)å÷Q!n|º]á½L÷!0Ñ…I>wÑh5îpGIÊ'»ŽU=tž¨ü? I…Fž”ÓOôlg›ŽSºëŽ]†£]‹È?éƒêÚÆã|Ã6ÍŠóxóË¡ T·‹ÚX@ï¼ m°w ÇØv –”.ùu…O`ÐWá{è(¥ÄñàU$êÙiVd>¶öís€¡føoMêM¶‡ƒçU‹‚+­Øå÷Ìw üµ±A¼ó9q[š›4†‡9ƒ›zò¯g Z,«Å¼. ’Òh­œç ÂùèÓ¦ÂR$&{×éY‘¬jù¼V>çg“®|EÇHtKÞï‰Ék‡ý½Þ£ònYâhT²¾El4Îßc-ö€åæÛH®ý÷»©ˆpƒüñbT¾ ëaÞ-‚þ !#2(pÅ™lìÃ1ÞÚ7=j€-Dƒú&ñtÇà«pilqDÄ@yç5í¯g h NY*BŠä`´O5/5–‹›O뮘XÍ#‚ôMÚåónÝ)Ê^3òæL³{†L<¤ÃèÂçUNÿƒ99 @í—2úhßÒèÙ/F`Û&4º·<Œ>ŠÚ5šî…’ãæ´Ëqw[,ïÊ•˜ßT Ñ¿2´D’äŲoíýÀ¹Ÿâ—ø÷e“y&e˜-·Óǧ~Y-ÎO²¦ x«Bét>ï7eÍG›~ø ømCŽô](­÷[.Û\¹ö×ÒÍÔ³û <¢,&×òù[žÖz9î¼BÒ¨ } ’=T®Bz¹®ä[ Ä¢tY±×M‚¢'¥°ˆyyòúä˜×$D'—±Œq¦W—ÒÑ ŽLPg[.Ápêjª’@Ԍ͛96ÐÌÔªĽ ­Õ¹= iéQÁ&¸Ò ‘áƒýwÙ±DGÇqÁ’iñ© }Щ$‰§ñoBå]F^HܼT]%ç„#ûÜ„%ý6L„y#fS,Êe¥ &&³=ç±ÌSºÆ®¼³1ãä Ž‚RÌã:É!&Òq£bÆ!Lò_-Z»GP®V”¤¼ÆžŒ™ËƬJ`g"ðÏÂ1*}6PíäO9Txºào˜Ë¦W—ä/«×”©ÃVW€›ÇAÀÄ™´Ã$"ŽÏ˜U£Vv{ô°§ãjkxw__˜˜öËc×\)Ó¬un/Š’ïŽÙÃp-¶Ýözz‚!ÉŸÕ4Qc1-*zå:ë(Sų–ÚÄ«Ú4®—(.êId%¨/†§NÖ*}?ߺVðfNñÿP‡ýÑJ'rj;”ŒßöñdG‡¦ÁWµ±î$›3ãó=µŒùâî#‹é‚Œngžÿ#,ôD*C3å4Nr ’¢³•mÍÊ\L׆GŽ#Ž6iäîÕ…¶qÖ­‡ôy•¶s‚±-;ÆÙ 36ŠËTßj^$ô^€ϧóHFƒN;Ï»:ŸIÒ­•ž(1”^7zŽ; ñ£È@‚}Ž'¿7t)föaa(Ãý!~ýûÝ®ø:MƒÝI1øð×U^Ú“µw·xà~8U}¤õfôã*ø¤ú—Aæ䀯0åŒá¢ÕkD½Ú©˜‹ƒïÜÒMæ!¯Â‘)`k¨Ò5ÙfÒêZ;QÃ^/ìñÎL  F·/Äuø×%/ª1N4€–M×kþ¹Nqy©²30ía^ÑHÜ„œ0-¿zbÞŽü6ÝЊøÚ¨™€6´=³æ„‡=¥‡]BJ°54³Ð Kh ãÆ;B”Ôۙ椥Må®>ª_㣾Ömk õ\ÛµÊÈ*eŸÃéiÍŒ5WnK±ÈŠs[†>TæÁ›X³3›’ÏÌÈz%váÃ×EƒÿÔEï@Ûõº¯áÆ‹‡.=à»LöÓá­nˆŽ`OóêÐòùJxƒXz"å~- °½žà÷ù£X’ÕTþûÊ ä° 5ËÓ?Q{|hC‘k»0æš@cÄÁÛö³ê Óˆ‚”)³l®«oÕfBÁ)Î^||vÝñȲКÅAÿf˜7‹W˜®«~7ˆHû¹Ã^M~‹34è èÒˆP¾æÆ(œy$²sQ¬‡äõÄõyª‰á‚m§t¥ÔxÇÛb/Õ#•m{d" z|Õ— -€H±(ËͱÜ=§é•}¯ÂJj³±äÙ³÷ÕÈ´ÅZ5·GÐPùBæ>ÌTkƒá ¸€®¸ôøJï±2„äQâ°Ý qôíÞžâ£I’µ¿*„ˆj¯ˆŠêŠ3ìb;ŽEb ïì±­ŸÃèNË #ŒJNVZ&ëÞ¾ J/œÙNêÇ ‚ßÓrÁ^³!زäpÁœèƒ•Äybñ H×€]Â8øÂ¥h–ž¸®‰HßÙl=&û`>ÔóìDQºjkWü•]ŽVíÇð¥\*À8B%Ò­M#(Œ™Eç‚ù…6ÒF*ìöF'ŒMÊÜ(ÿèØí™e¼ƒaåç ØÆB#f¯üm¾Í5š¢ûŠ8·Ñ ñ^]n;ɈÆÌ~‡ùøû™N#Šwñ³†Ò!~“|¦€=´d'm§ºtÖæ>xÀlëÄÕáöM<û‚(\î]Ð7c¢“ˆ‰[•ÆMÓÕÁ^¿ $¾™ÂK´­îá~(DJe‡tø­û$…øͤ&×¹‰cuçƒâ# RÖ÷÷ €ãe"P;dr²òwqŒH¢óÕÖýQæwËǯf*ªÒähòÌRG6ŸÕݪÓéõw±ªI!{á¹óu2Á°>tGïm‡˜áIËWFø3Ôn*>‰¶ý$8̵+³ë,†œmÞŸ·MuäƒÑ òÄ6 ¬Ú!Ž[ÍG-/ÆnõñÐ ¦²0ýª¶U5m?ÓsÏ)ë=>"Ív—>‡_(3 Ÿ«R³–^¼žÆNƒ¬)mƒÍ뜠o¿­«ú¤*¥Y¾\=D-ÍdƒÕ{ë­-ãÜiIc¤çú…l=*î~‹2ak [n¸äjPÕ×ïM¹OŽ¹=ùRˆÀ¥^f•+Ð-µLmf7ÞÏ(ܯ #p'—3ñÕÅÛ_ÐãCMñ‡—Áµ`Ñ_Q¾¯ïäÁq3(°÷Ú?Š ·0^#x?Ô&ës]åÃ*i½–ÆÏ©X‚˜ËFÕ,ýGõÀÁc´¾³EäˆgÂÿ*¼­£gðãß <†öÀYj˜ @ ‚nË-\¹=A_„»ST¾ÞÜÿ½Zd#Bj[Ü)o÷X…úª xú†wLBžšœ8+µÚ…«,½1„w·ÞAUQá~+±«_2&ÐåkdA€–¼Â†V³ÝÍ?DY¦ _À/þC{Á4Ù½1jH¶jlænt°¨ôGÑhg¯OFØ“ @?þónX°V]PP:â¹ð‚ü,€æ¹0¬Xšf uáÚtpcßACc 7Þ=¶à&Qµìg B\sT–]m‚›æ™ Õ!-x\7rA+h)v]¦§&̉` æÛ¸­"7Åàx¤üÇZgÙ•6A{M1~ý2ú4:ŠzÒÒ aþf0ÖíÿÞ˜|Qù”Ðh\ tש†Å/âqåëÜÝu ²ä„„}Çc‡Ò äß™Øgʼn.Þ@>Ø-Wß'˜g).ÿÝùû &†4 qÁLë±®Ô iè|î•+½œâÐg,Pb4àLWÇGú¥´ø´ñ!ÔDAÈO ‡™~ å€ø9™¦Ãl²söÒsZ'Hãg#1öEKö˜7C¯¯”s ì x?68KÂ/´»‡W¬5¾Ô Û¶¥Ofò²È-˜¿‘_ýŒSÏPÞ~Òs8Lž%îÂ=!Wp|Ð.6 *EÔ˜T¤£’7ómŽõæG¼-`³ä–°‚#·A¬G&ƒË>ÓïýRQÆ°?jg…b,<ÿõÛ˜vrûßF Sæs…ºµ»¸;gœTëîΧm„ê&›…É!^›•®sçFš®>_.’Ž5–­BíÃí ¤PDùç„üð#¡~XŽÛȽܴN˜n(…bž¬ÇžáR¤ 1k­#<(›dèA›oÌä5è‹©]IBÅ´T”9é˜2•(BÕ§9xÁoø ¡Ã¥éšVá#d;&\}-º¿1Þˆ)¥¦;3Ag¡SÈNEÏKˆå|ŠKG‡ûPãgí´¶©Ô>´Êç’µtÀsƒÇ8ýciW†ÑwÊeüþ§îÀoOZƒÅN ø@òãdݬ£p 1(MùŒ¨Åüfø¹/¾ÒïpÓK„9RjƒeÁ{#[AŠ)‘ÂßÏÐNÖþ^7ô:Ü«e[£¡ž Få¾ð–ÂG¼ýRLùú–Ò±½·?:g÷·4'Dwy}XuA:Ñðö’Pg½Öã…–°æŽ«åÞÓVë+.¥à.‚<ë+öY!jƒ($…)ÛóÖÅG‹ý“ˬáîÂò•úa3WHˆ¤UùÁxœýÏÈÔbQ…s€¶C­¿ëC>9Ô0NIæÉšJêá§QåÙn¯Åq\Pòü$5£þÆi *ßbA±²3Wœ¢4 f#g†â|©× *lH,£väîÆù½¤\ ¹ï¬Š(Xî~Ò°Ž‰Ä‘°"øVúŽýTˆÁ‹…é²÷…0'D3Aüå-s ³~þ.K”lŒºœ‘Wh»sLÂûåÅ“ù†Ô^{¬Gyä¡ëÎèŒuYHY„ñR›ás³¢Ú½'¼¾[+ù$™ ^sìCÝ0%Zvu($¥­/Å#Ztgv¹½£co è ©ú]V{¯˜µéøKMzg—Qæ‚ ÛñW–*(Ç®¼eêé É°;ò FgxTj…Û“†£,ëESæÅlç3•~ŒOø Izjsó ¬=L¼½Êû„VçÈB¯P=ž¡hó;¸w’ahk”Z¬º³f¼•‚Î’ú³HÃ.ìW{@Q.|c‰ 3{‹·¬ÕVò’‹Ý°üAâ¯xks"ŒÐç(óã.UêTS® É?ì‚öÒj¨ø¤qx_G ¾®ñ¹påI•s,ysÞ<Ô† BRèof³›¾mSmx¡=ÉöÒ>© «Y2QG‡m- Õúªàq’`Ö½|ŸBíy¨±'oWnßZN*'ô3á“HŽ;bY{{Q³’„l@QÑß’õcañ‹½ÂVÚÿ¬^(ÕµžÐIwÀwTId7Øâ ¥„ØÿX<_ý²Ôì÷ëzÈÛeÙ¾ ¦ ôe-¸Ê6?ˆ9lèËlaˆ»ÿ 3,Ô+w>W$%øpj+1Äà Zž¦ÁåÝ[­œy´'¹ÕÏ/_Â;‡è…œÂ[Ú!+aµàźºYHðâ6QK¸6hŽ¶i°_4 =ùÓwL—˜«Î´2²Áäz±Ý›8Ͳž¦Ž.¯[0g½Ýq©I Q°Ó˜YØþËËà`+^ñ¿h„ ”C<ö¤VÐÒíúÏ:–Z5ðM¤š(òbSNJ‰XÓÈpþà(Ze%Ö,tù°úWç6‰óqA¥ŠÉh­â²È<ëáñä‹ó­¨3§.Ú$D ¨ÈÙLQƒ‰…½ì l Cj]$ÙâÔ˜æè…èì_@mì®YYž.™üØ".Ä´¬X£4±‘n¦LvpQùícçᔇí›7¹Ÿ> 6:´œªn‰Âµ2àö"  ÷+Æ*ØÅ9ÞnD ´tŠqeµ^×ÉÜ § ]íp½{­J¢:ÈËñ –?F^eŠYÔôRŽ0ª0 ‹YZshapes/data/panf.dat.rda0000644000176200001440000000115615076647713014654 0ustar liggesusersBZh91AY&SYèoF]†ÝüstTUUÿÿÿÿøÿ#D@@À@@@r-†š$”ò=Rm¤O)½!SÊz›Ñ å šzž§ Ê ú i‘*2hÐ1 @ L  9„Ñ‘¡¡Â42hÐˆÉ *Q'¨4 €2P@¾ßFºL,űü¾îY$.º”#"§¹ˆw)% äÈ”4°"Š ¤Q*€A*PËEÊ÷Úó–ãhX "KÔÓ}”xR±`âäÄØa<»1㎣•*«4ptfš$óh<û«ÓD¯à’姘\ñ¹l«>ÉlâÛvGž‡ü¬viÅ£HVmzâsy¢gIb¯§kÔ}Ç‚dØ„ £jºTݾ8í.õ4ÁÁk â1–‹¤ÛÞ)Ÿ`o>\igÑì=jz60†ÌlìbÆv¡Ú?ÙG<ƒý€3ȨE¸Р¡ˆpO¤#ç´²˜‚žÇéÚȈnu9i ‰d$&H(%âoÎB‹¯6sVYek#Ë#+”.âx½B‹Þ*` AHÏ(E9rΔéå“dŒ¸1s¢Æ,†I$Æ 8°PÒbJOÄ‹‚ˆ*¢ Š™‰ª˜d˜Š¢©(’€ªªJ(£0éÊë§2 Ý| ¦r]¾6¤À ÕQj´¨+.®ÆFþˆ½ÿÆɯ׫N!k’óŠ‹3‹·@ãx(Kë³ìÑdhf÷ N&NNYçŸH·’‹¢J#HcUĬ$ÂB@!4Øÿªñw$S… †ôeÐshapes/data/macaques.rda0000644000176200001440000000436115076647713014761 0ustar liggesusers‹W 8”k²´JhÉ’6dëm;}3ŒÄ 9Ž"BûQI m(´HŽJ¤úû‹•T¤”::§pNœošoº®ú¯¹ú¿ëzç~çûÞùÞûzžû¹ßgX\ÃÑÜÑ4Mš&##E“ANe¤É)š m‰##!‚è¸Ð•äå/ëhÒ äã؆o˜Ws ‚ÅQ´ŸÛÒä:IÝk,¥Õ+â;sÌT™%î½ Õ^—Ûà|ÐŽe§}ƒæî¿mN`óÃGý«¡ððXòðm5œ;ƒÓª•aRÆ·jMYûZ¹ŽìÝp²yÿ{ú¶°ù4á%y4.†ýjEè`ù¨ñÍxðÙ6Jº] …B Šv–¹õ‚˜ó%IœHpÿJñ¨{ {Ý ójŒ{­‘UdÞu{‚[©;×ããbœ:¹5µ²Ö0Ω¾8ša¢8kH–¯üäÏ° Á¢ö—„œ<úkP¼)tp¼þÀl å¬e‹ÊÞÃï¢Éó®éö`-9áÔ"‡`scÆëV·|Ý!b#|jÊ_5T4CK¶NMåE5ô íèÿô+ÀëUußJ8Ð>c ë°Ï„ Œâ¦Oµ0‡ãçl+ù›n`Qñ‘„¾Ï*¾~«±’YWƒ¿â‰þ´Üøœú5×'žíËí‹â/ÿ™9ºÀÎÉGÄÔFy°^»>í×¼zƱŒ›¹¶0Õ¨_à]3¼6Õœ+on†k+¹*hl— ·þi †gGö®×‡á\Ö #¯±å‡ÈçíÖ<]–7Øÿô–“JƒJ«ÂÉ—o* <öxšM¸ íÕŽmüe G1¯q¼å™Î8Ì?š£Póôl¥Ÿ qIAéMúRºôÇ—ºï67åãÆã–\(QIèp&}ô˜Mg8 :-FpÈZÕGÄ4øµ-ñ›^<ÜÞ#êGy&0S%åœ7ã¥GÞúEÃ+d¸XmÎc¸j “‚½óCk£ªu­`ñ߃›ò~Ÿ§ÈŠÉÜçSAPú“„œußÆQ_=Qók1j»Þ P;#öÒÒ°ëÒšFêCàxÞ1¿þ xÑZGrVgsn¹L-o&¬ö$yÕÛÃ<äöüÅ^X”½§bhd)\§Ü K£yÃîþ»š¾œ°µÌÐ +nS"êõÎOÇ"*>’ÐG¬Kþ·ñu‘Ý­²³õ3©Ãý;¼žZ h¡1ÁÛòp÷åÓþŽù'oï¨eÒ’IU\ÍLMÄ‚èÃt)¯í0æˆüÈ«S½’èÚ —j٤ɚ™­÷ÓšÀ°0‹æï€ÓæÓ­óR:@Pº“„¾O±oróDèðI¿›sÿ¾œˆ¾3XüEN`máêø€ ù apí'âÔ>G á_;Íf÷§Õ•v<‚‰¥åûÛû°Èn_عw—IŸ7·®Õ§Ã¶¤Ã©D%(Û£c0áÜ ec‚ÚW~Õ'Å›«!BgF´[ÎùÍà?P’½$ufä)bçöÚòËmîWÁï©Yuó,¼Äè¸ô™ûàsõ¥é°}FFO½¸‘Ÿw{ŠXÑ×Ê ó/ø({gGþó+s[TáÀÚ5¼_;[ÈöÖ‚â! 9TþÅ~$ö)¦Üå_»õÀ/õA•ÙÇ_°ûA¤.kÜlt‚dÎýÛEà®ÑT™5oé·%ìPiØèôÜae€¹Õ!ÌL-Þ½7„Æâ͘ü¾Óoà6CWy)átp]¹üX,rîQÎ4 ëÊ«$ô©ý.ïO×þ ’KH‡@NXæH·ŸO: Ø;“…€ Á|ÎøàÑ…Ç–|þž©®˜ÀéÚ8úR JHK¬T²Úcàmµ9'ä¿@>(ªIöcj§‘ Ü^^Ev2?ôyÅO\ï⾄¹Sî¯Lf,øDç]ÀÜvÚÝŠÉ ÞY•îøtué8æpU’W|¦Úï]/§]ÛO„Ì} ®’rÔ?÷C^Û¹é¦pjš¨Yðá#ÌË«º‹* `|SÔŸ8¼'»G˳ ¨øHBŽÆw<©ø:Ž%»‰ð“ÈSrÜ&.hÓ¼Ó –¥ðXZ{ø)»ÿ€kâr1ÐØ>Ê7~Ûº]t5‹OºÊ0:ûqyñY¸·nXZØça’>ñæÝn£^íh„ù^ÓÜ“ÉÊpNl` ?ÿãxRÈ«ý&žßõý#–„G’0N8%‡<…Jä"§ã¨¹ôÿ1¤~<¾ÙZ."tUhù‡ƒ¦øå ¢»R?‰'‘ß­— ‰¬/ÿú’Ÿ!±Q1"ºß._.ˆ ýŸ·¯? ‹‰Š[!úmè_ˆ_SC shapes/data/gorm.dat.rda0000644000176200001440000000132215076647713014667 0ustar liggesusersBZh91AY&SYú³ãÜúÿßüspFUUwÿÿûÿõÿ”@@À@@@@ðŽ1ÁÚˆ„dOLSj=LOSi<£F&&hCG¤h =@4 ¨zDQG¦“M£Fšz†ž¡£F€d@£@j¥*HàY`ÂÓcLþL0"SpÍ0¤—Ãir©L{Hs6NÍØEìâÄRv¹ICEØÕDCb1µM¢SM±1•.Ìl(±f¦í»ù½K‘ƒ›ÎÖÙßÙÍ»«èÖâØÐÞoYñ\Ϋ‘ðŠX¿°0-2ÜiBɆ8Ô¢ª˜ìŸ~cˆêÕõ®žÝ[‘§óÑ“fspJªLð!Cé²²( ÛBréOHädÈë4»“z ˆ¿L.¹^ð…} …ø´4–O0ˆˆˆgì@%^ˆts’„_x‹SÛýIÈ~E@È %D;H*È €A¢²…OHü§Å(E‰=þM¬£ï/¨X•ÐiE_µÀö»tŽüÛ+Úù`Z9ÚÉ7¼¶É>íÚªùË&ŸwKê¹Z©‹ì6ЖԶÁ!KCD´-yšª’JØi´Zb& %LË•Ï.$ €góBÅbÅRª(Áb ˆ*‘TUV"DcV Š,Š(¢‚È#Å`  ¢*¥X_1dc""£îÊc*2AIŽÈ™”„¶¼²ÁRb«‹‡+h´dD¡‘™Z¢’°~Åq^Är­‡í^žöî!âùmO4ôñkëTïhã~ZÃ6Š±Z˜ñF93×hEâ©QÖºð¤qÅ•QS{S²Ô‡YxÐ!´6í‹Ûƒñ6EçÙT·¢Qha-Û&":Be¼†#230d`ÈŠž»n"xß`sñw$S… «>=Àshapes/data/T1mice.rda0000644000176200001440000000603515076647712014303 0ustar liggesusers‹؉“åÆga¹‰®ˆ¬ ‚\A!+°ËñîÅìÉÎÌεÃÂÎìô1³3³ ""†(" ‚ ˆ $ )$*—RBE@bD+@ºù}¤Jÿ3US=ÓýõÛïñ<Ïû~í)öklîp8:ÒÓÓ Y?|Þá÷t8ÒXÒéŽfÖ±±·o*ÕŽ·Xÿ¬+ Z[ß’h¸hͽ­ýâ/xéõ#•Äk®Ê˜üU‘˜i—'gHÙìüç§5î*ÉÆ‹7MܾV|?|ÙyÏÑ°DÚrH2ÕíĤO¯J ·ºÓâëÉuãê+/O‰{nÛ½´”äUëlîL ´ÜX7õâ—¢m»ûPŸöK$yºÝ¼7Ö‰¿b×k¥øÞ>Ry~×1{Ù‡Û¤üÛ½tIâˆø{ÛæJ$êÿʹ*ã©ïáþnzÇõâW¾ï‡•ÿß6®›3WÚHE#ë©Ê$ùöØeû›Û½<ÑòŸ©8œ£Iݚ姬 Hé´Æ–C™âÞ9§ºÇ¹-RûIé¶å§^O7Û­’h6lÊ÷scâÓ|ˆeI´½–WíæIb}s›çTKñEâto5L¢,°> Å}vs'}zåÇuâ¿ßJו³¢ï´VM9)ñ¦öí=%kã›Mûv;!#ý¸®pé‡~‚xK/bÇ,úÈú|,%síp=y¸OûÅ›’øªíkÛHÎ^âu âž¼ºÓÖ—Þç2+»S/‰¶?\†|l‡’pÉz+qwJüì!Ûô^H}]ˆ+ü®¤è uÔ´6µåûÎHžf™)|Uj¢Ö屯Irxý‹V&eÐëÔÍ×ÿkf‚wºå]íÑ—Z‡òO¤(i‡ù°D{»£íˆä5.\ºó½Ç¥bxº ‰Î‡—¿’ãèXlñÏÑ쉶pH¬=Î߇ߥO¢Ÿ‘ùäµ°–ó±N6|3¤üÙ‹¶ÀKø|ˆwβ…Q²zÑ'Jßʱ .áÔÉyܘ]-˜-?-N…³ð×ð¡NÃïî×éš%Î^ö/©Q¸(›ÉýÚn…ßFèpÄIˆí…9w(ýœIÿ‰´E bäQïÏsr7ÂÛð"ð0Á­s6záj…þÕf wN?zdVØå$yÍ~š—d‚þYøv}GÁE´}gø­Cé?DLýó—t²!a¥s’m¹Q?_RÍÀwt;õuÊs¼h§ˆ³òiâ3n‡•½ÁQN=yLFÀi´ýí!^ãzìbÓø.‰}}ÿ[èëý+¨sâ;kÙÎ÷-ÇÁ›Á‘™N+zÂÏX[ðà=„¢ð|Îï1ÑLt(¸þ˜§Ñ{÷ô­Xô2PÌÿܵô“Tûúò4Ò®™ŸÛ…í.®+ä3æ£þU·ág¥×‰ß`Oë…ž'ÓÇãèN‰êÏæeþ{®‘ßB¥»‰‘ðB? ƒ·€¿¸N]Êç`×8IÝ‚º8¨\'ÆÂw­+zí? þ̹Ïu ½Š=M_õ?Íœà\§ž‚ûŒKôÛª)\Ïà~矈ÇlBüŸí³J¿9–LÜ!‰×èïÑ[‰3‚ZsøZvœzwÛ„þ³xZ‚§l^mgH][Õw—0g„n%¯µ-ÐÊÝðÒx‡¹#ϲŸg©Zðb,€UÓT½ÓÉKÑeú@l,xðÖOîdt;õs”ö ëBSÉŸ±}©¸ ÎÍ àÙ»›:úÞ¦:Pý"ºš€.ß [E/gópêùûCrèÉÖôµsY°7sGl>8vöÿÆßÀ:} ¦6àg´\L«=Jô¶!ïæaî÷5Å.'ïQsQgôÜ”üëÙøUÑ3çsô7FG_ïøÖkûáEÕì›èMÉatÙØOÿª\BÝŠšÇ¤Ç ³ó^Ñ‹¨Ãèß+ÝêB•Ì f {Uâ\©æˆ¿`GËïPOæ ó¼ÒÕ4ôÖ³Ïð)}Ë’¯dGð£ï7¡W˜+Ì4tËÄŸØÔÓ? ÝìÿWô.µ¾¥¥w°/1¢ŸÞçcuô½@&ç‡(¿Žz&sdu:d .ÅÚŸÏ…½¬Åä?™ÿZ úˆbÇ|üx–Ñc›És 38ËÝÈõTGìê>òV3KÕ£Ž8ÝÔ¾ÌÃ:÷æ£Càcr–š“kÉC é+±Wú¬âO5úïm‚½|Õ·“•VÚÝÿ]ñfÔtÙ˜J<®Éøa>†.ç¾ìæø™ø¸‰¦1wV§£#‘ó¬s&Æmè•·:XøÏKþ:ê°3ê)pn$À³§7xˆõQúð~vg.HVoý]ê:r7Ï1_ä¿;Ü™¥ç¹/ÿ^ô$á€Útpê­æNüu½ƒ¾÷Àƒ`!ý/×DëÔܦý„žUårŸþüžKŒ ü<É>°xõK= ôëz?úNìjÃÐß 'ýC;Ä\ç­bý /óc²©ÚwÎä9¡»è[µiÄëZ ¯t57z—Á;QóQ|õ‰nf¿(Qý&ýv5Wú~‰¼„–ÒgŠS¯ÔóÌMú µQóRô=üód°Î¨F?½èc¹›éwuuà3z‘¸‚ç‰ßlMž<›É«ù&¼«~< }?kø­RõÝK´ztÞ£tÞlÌ<¨G¯lßɾÔ3Ú™8C}à‡ž¾{V±_6¾æØ­æ¾Ãªÿ®Wz9Ý­PGý }Ú9Ÿþ¬gÐw}?².Ÿ*c1bàs´êŸÚú~ÉvæY£/ë}ŠïCgç”_£×ˆ»z¹Òó2xê~ ÿL97ðò(í˜Ó’}àY´y ]£ßD»â¯ççcÄx…y£Û»ôä<Ž£_`ÊÄ¿p=øÕFí—Ôù*µÏrL=Ǿ(2¼úöq;‘V ±Fê}Ux9l—z¿³˜IDx~tþç3ïè¨G…OÍcãÿú¨ýÜtæ–ä0ø¤§NÕߪýËëÔ«2Mõó…i,²ñªMg€ì©±¿0c‚•ŸL¿ÏÙâŒh$l¿±¼Q»‡žRèî~Nÿ/ž’dÇ}Wn.2>«^}k0~Ò‡½ßƒÍ[øÂ}åïÉ>)ªö›Ûú8`ïÌáC_m„°èhµ\úY¤mø§É£s'–•šÿ¹€ Ê~&¯ÞÜiÿo<ËŸlÏ!Ic+÷û|S³˜Lïh$»tÉÜ‹Û 8`ð7•Û¡õ-fœhÉõЗr`ê:Ìk /á³Ôñ0x]<ýÉ“k¤Ï7GÙ&à@ë$—Èõ,¨6®Êúñ :y=2•!γ|¡»¥ TÅÍ}ÝF±û ê[±+øžŒÑá³HÔœåi) cgC_•×étöÛÒ©Œ”¡+ýe[èØwäSýŠˆHJ>™î©˜ ù‰÷æ™›6auï÷mi@ÈõÜ}½ûTòO]ÐÀÊеmaV@© èËR†Þ$Þ‹~ÐtA¼5¥ÊhñÆ.†Ò_0=„·ç+¯]‡Y7_µú£4¶{.öÓýé„cbNVÖÃçÐùàlÎt]+dxV]t+~u? ­ø〪ûE@8;®ŠUÀf°X?ÁŒ!Ø×MçÉ!…ýØÝ{òØ{ºþú?¹:Xb´‰ÄÑ¿éÇ>rÌ4c©éèæ ƒùÐC¸±µM‡"IÕ­@}¸›Æg¾iMÓüŸ¦ ÃþÕ®,gèMðñ¾Ýc …ŸA{BK¸Úµ¬@^íÔî“­ÊNŠ@3O©]OÐc}ܲüÕ£H®Mëk¿Ã\3ÕœiP¤åôJ—û'fyžx&ï¥å…õ"µçÌYõÓ•WãÅ·£{ÃeV`]Á×ó™ <°}oÿ©Õ÷náHnˆÞýI‰ÌH ±—cJàÂ.~f&fG‘ÖIgï[ÞXöë5¹¡!”ÌQdßÑZŸÜ£”ðÅ-ÿ ÃÄ£Ðøìû³-ï–Á€Ï쳤•@ßv—Ó÷I P‹3^Ð"@›¼ŠùVQT‹–½L8Žd‰ÎâŽHeé¿eïxÉ *H©m1%#@<¤˜–•§ Ä«?o¹f}<ÓØ\qÞì}ÐR¡p sÆÔvEäAÙ~§o¼XØÔ‚¼á¯¶®¡ÍŒËSúÍLÔ/]EŠX%çËm©˜[»Ä=‰ó–:Q5ø¡ÔªN*wU:4mlP6?уŒcÕK>ŽbBØÛ;©SG ]4kÆúúçPÞZA “ "ýYù©zÎF¡>¹þ1)ÛÀ¦TÍOBrÃFîµ¾™8ú‡€ïËð×sbRcÒäYéÅPžh!ìH\Íû$ó»3d,z"±í°(ϼy¥è#õ`x!²–«í¡Œ{½¢< e®{:òEÌc„ðŠµeÕ<Ö àüþˆfÚ-AˆO§Ùš°ñ ƒÜ°d1™TÉYh°òS—»ga0÷7hÖï#’=Nj‰Òñ„aY¶†Ï%Hñ‰ô¤A—`EîÓH°H)ª(>Þ‰ù­Îë®@±îƒh>zä žúÖÞª ”7‡ï jF"Mk¿X–R:&<ð Ð˲wÊc¾U ˜^T!¿Ž ­¿y‹‰;Í”3EîL=ªvbrä!¼–-‘xo %†ñ‘ªÞXs`4Í ¾êÈ(Ù!áæî±y+Yù9Î&š<ø‰*_ÈIg[tù«ôí+œµKW‡¦Ñ‰kžû» ÖÍ¡v£³É_=Šñ.‰o4rt ™®;Áûh7’œNª8L.ÇQ_|‚¶ºON‹FˆBs@D¬­*g)›tLŒncýp€èosãFD²¡XiíDIc].>ßRs žèÊTO܉Uë²R߇_…¸K¯ 9µ¬±|ñ£Ù?\0zHw“»ëÃmŠæ5Çr4¾âP•…¤b%S/nžÞgùýìL­ÙBé—Ä•F!L\,–*`~¯³"‚¼®žHO3n¹ñ.ë÷…,äŠõÀ¶<·Û,> ¯l‰Úd€½ËÎßw ÆZÑe‘J×¹¡æYú×P*–æÔÿTw0²âÓ5nQþØò5fwúá\Œ¬·rq}Ô $Ç¢ƒ¨™ù¯~k•ˆŠ›„æ´ÃÕçZ˜þˆ‘ó²CϾ2=EÍwÛmbEäu Ë8u⻦Tž0ì?9±SkÞABº•ÊÔW! íjg¾06÷Z'±&‰ë= ÷¯Êrë`}íB­·"«±óÞ.ý%W ÙUwNŸÆ²9™± b*÷žYÊXˆÎ¥êžé&¨¯ó­K+Z…íq;Ë­x± ¼QMã¾5µU¢2+±â¡Jƒ c@^},FÔ·(j™—§CL«²]Xrâd–S6†ÓçrÍf¿ãpCÌýÊîò¿ùzeÛá Ö@HyªÐV×´¸æ ?úë`Xý†þgÅSTû+,¢M,þ„m…ìµRèC KâARÔTÓRa „P=˜ „M×Þ§B‰öÃTµ&PjìTöìÍfæ牥Ìú½YóN’_hýÙá±f:Ð:óhŒªPþè8R‡÷¡)E] Ès^_àÅÒo‘-³“¹ªñH(Ú½Eà+;ö'<®n?è åÊ3ÇCféëñ\Çžë•AåƒwïR+ŸAÛž§L'Ä…]ÇÊzv²u³üO7SÕœ®Ú†ƒ…!nªÏ™úúÁÏÙx#Î)R¬Kì¾£ 3r±K‰'æ³üÅ÷ÙÇÅãLßçcity¬l?¾î<¦ mx¹ç¶ÅÛ­ç¡åä½I-K!h\MŽ_óT©˜ÙTzW’$æ»Y[€GEÒb†6YNÇœµÆ¼ßñ¦t%Yƈ°”hºÑÌm¨Zæ”æ_5 $¦›M|½:#ižf—±£r²àšq–´>g*K¤ ?å1Á>LSv>†Õ÷ìº-±­½DbùÃXø¸ƒ2³ÈˆšNäå9›0­Î @óÞÑ@b¶ Y4’²°òÓyȽ>dï蜲I¾5ÿ4óŸ¼> ÕcWÄ9jy |A‹F$I c Ë_k…ñ`rŽÉc7 V<ƒ=kx6UØ°âI*ÒW¼ uWÈ3;åÚi³Åƒë0x¤cô÷!}\bjä/æÿöãØ|XKRr6ûU³¿"¿ÂBõ°7ÜWä±íwßÄdŸÀÈv¯@©àlx¯_Ĭ…å©"~¬yH›îF&¤°˜n¶U•Ã(UcÒ ýÛ {Ÿ•¦ÞÕ!hh™3N·YñT ƒÚ…·±øÄJýø =|v£ÉG^º I.ƒ×/OÀ!³ÜT7kxže°O`^쪽ˆ#àá§18+zŠ»‹ï¯Ö…¶bE9þ]ó±—¿ò5DzlP­/’ kÃŽªtç¶í™8p"5«‹¿ÉsS»v–Ÿûë·“òÝlõ%±òÛ‡¥‡˜ý>ŒÛßTIéscY†¥¾T§Ï‚ÎÍ5EÞ‰ÿâí¿Õ±/´uY` 8Ã0 ä A¿àó½‰î§Ìyû¨RþÔ÷@ë›ø'‰º,¾N¿\`®T4…¿q„¬B玲_¡“Ò¢UwoöÊ$õGì±ÆšççÝs£|±õ¢PÐ=·._×¹2•ßyì¾±Vº1m#ÞâêG)ߎ[·b©ÌN݉^#hÑVcJnlà;7‘€Ìë] im×Xõó·ÿÐÖnÜãhÆÔ¯Z S:@×wÁ— ?}ó¦åNû +„HtkÈƪ óöªox…½Ñ*Îb- PÙ2u¯£:“Ž}Î×ÇØZ©ÍR_ œs"•{0:ü)®{ä¼X|PÿÛÏü«Gå¿ÒÆfY|ÐSù«€±‰ØeÃYª‡w]¿ÝTXÉâƒÖCM®IŽH•:ýô‰Tžé^taúwª-å%°A?ìLŠç/_—ùí‚Õ[¼¢¸¾jöydÞ‰n>íƇ¹w?\”ôÃÞÚÜ­×Χ”¢ ZŠXúmå°4¥ÊÙ+¿¯žÜÕfïdׯ-J‚µÝ¤™9öÍÑ{Y96Ï_¦ðEb)öîä=@Xg…Ãoºôò‘þ'¾tü¶­g+æÔ†ð! žz9Í.5‹µrÉç®9wI÷ˆpº¯ vt «'ö#6o5;5 ä?ý—±j¥ÉŒ`4ßÛüµ10HgæG’@rYZ~êi5kþ–ó§5íÝ^Xâ‡#gDzôiB¾ìåU­ Py‡§kÍɨ¿ædb4Æ‘°“¯=ô_Xb™q´¨¿àÊÍê?ÄîÐØj0†ØmÞÍzòsë9ÒFHü˜é»þÍXâßÞ“v]!ïRÞƒ‡Ø„v…Ú(ßHººnïB ·;µÝ†îÙ1íZòl½PÝí¤ìŠrAµê`"¾T8g&r\¬zG¢íÜ„2Ž™‹¢Uûó…èÚ¥œ)pœñq»ràäïÄöÎHu¾ªš{ðÓCñöc*=ƒžáL•;KœÊ8q¬®îѽ'RÊy[ûû#æÊý•ýÊuàh«_jd!qêØ«ï7Çî{^• Ê~ð¼²¾ŽánTöÛäëþÑ™9¤Ü,qŠb™†”oˆ>ÅTXÕËä}¿ð dÍ­Cãq |gþÞ$«{ÿ¼/z,Ãn~O|²Ë8N£ÿ)ò.¿}w©âVêcoÁ_¤®ö'Ä/\OžÞfáér¿=Wî`?èg?sü+×RóvÁÿ^žÂv^b-íC=Oxf¾Š®)¥+èØû$¼‚wÑ/W‚ŸyüÌ׹ߙ‡ïVÞ ©ËYüvQ_g+ùÒîxÞ-uÏ`箆‡q}P}œåäãÓÉyi>çúYâ4éÿ[8Ï /ÌÓÇéãÔ¡R¯,u²¿Ç= œ5Ï㧻_ú¨.ñî;Âyã0ù¯ø ÒkÄ6ž!®žƒU‰o¾(ÏÅipCé{=Ãý™‡Ñ£¹~Ùî¯-ÏþýÝ)â;’Ÿ=Fåíàê»Ðwd'«ÿy§”¸Ò7]2ʇÐÏüçÏþººI±§áoìÅÏÏ?”>«_ßUröáŸÛ”º™Oàﬥ_\yÞÍ¿éÂô‰'¼Ñ]wÂ;+ý>Š.¹›©·ñ%~UÞÎnü½AÑçÎKÓÄÕmèØ|¿x+ÿ›2Ÿ2ò<ŸcWe^8yx»o‘_MæLq“ð½}‚mô•~ºg?’ýVâön”º}GÜʽ2ß–àoK¿Z¿tÑ3XNÏ¥¬•ö­‡¸Ï>O[æ§uó¥ q¼Iü‡ßߟO]Ò£ÔµÙJýú÷ —1NžÕ ÒÿJúçwêP“¹“}½7±ƒ¶~Ül¼‚o™9éÓòöËR{TðÇàYû@Þ_2½Ïè×Æiꯥž™gÁvÑGt0êÒ?«åý"ýâLó\T7 ‹¹YøÖ©(ó^7à•üÐǯï7tªÊs[½äýþ1¸5‰[”ù«¿þ—¹¯ß#Ÿ¬Ô9¼œ>O×ùetÀËyýÜ+/æ÷¿?0­ºÑŒ–yñÏèsÉÅÿ:‰Ä5ÑçŸøó/콨 shapes/data/macf.dat.rda0000644000176200001440000000226515076647713014640 0ustar liggesusers‹…•0”yÇ×úQH?Ž.Qdra]G¬Uo‹õ³Ö³kÏZÇ>éÎ$j¶Ó¥„rQMRWTŠB8Çq”®°tsÒt8G%Ò]ÍÝ‘R9êærÏž§?®™¾3ßçõ}æùÎ|_óþ|¾óHü¨(#‡Ãåèéép¸ºÌRËzñõÌ›wÇesÂ!ìk~Q0Á1›þ\BÌ®;]X„0õô¹Ú(c=)Ö;‚3Í ý/Í÷ÿ:ùÄ!ñ=/ÄÌ3wÌç5#\pf¤¥Võ;DFå¡<Èó 7]ÊNy~îvÑþ8«ÎðtÄáFæŠ>Ûsâ‡ÖÄp&‚šôSdô¶ý?ûg÷ÀÓËC¥ÌK@@fmÿéC î³ùiaëÉzREÓô›p!ûºAG /Û"ºjvó½R@’EÙ+t£@÷þ' Ê÷}CR} $m£P[¬‚GŸEGÍи+ϺŽ#Lx<®a¬ÁýüÕj|ª‡ªÍR€oŽÚ»ÎCèGš¶qÁž«oòS°Þ”Í4=U!2¡¼ùžþsˆöèÿ}µP鮺–Ð6(7~­ÞòÕ¶Ûãµ=r,:ŸûLzÖ@{qQ—¹$ª«´)˜úÓãúݯäðW>hu¼m ?É‘©vIX›eÈäô€`=´‘dëO½É—õ´ìÛ8âe]’4ç9¢O—ý*±SgæÊZÐid_We'¨ä%fË^oE8÷iµô.„®ö»%Ç :àça•†ð'í;ÊŒAŒ¿¨EÈbÓxÌE@þî:áŒY |lšëš‚­«6ÊÔoÕõ žŒ©¾‚Кk>Ñ<ße;“!=œ¦ ô þòö_AÎ[WZÑ*ƒìïE‰Ös³\5áÅ—5ZvìgnûÖ(¬Sygd3þÎ3b¶ôØÀ×Xmáþ`!Ú–í. ÖK IÖïÍ}`ûAtØà¯\Q”¿¸XœmF”ã 秋 @Œyך(mÍÝf/2e™ÏŒS-ôÍÛc`Ÿ B¯O×6¦]N"´P|ÊY…€žùKÊŸƒ_wy¤²±nךêz{á÷¬stŽ ›6’6oy²ùúÏj­¨Š2ƒ25·Fl²Ñ›_,é~‰ èˆÓ}ÐVƒ¿~Ê=è»h·5™¶ÿxà  xVf^¦XY?¾¹*K¡ñÃœbô‰[à„þq¨ü¼Ugϧ™"0å†çÔÍ9ïΓ¥\ý¿<ßúènؘÈÀD³dæ –šO¯5ó_O2c"Jshapes/data/brains.rda0000644000176200001440000001024115076647712014431 0ustar liggesusersBZh91AY&SY4Ÿ,;ÎÿÕÿsH@@ÿÿÿÿÿðçÝ@@@@@@àÀ@=À€ûäQFàžx€Páªy@ši¤#h¡ê€SÑÒ€Tð zTö©êz@£#@§”…UFÐdÀM4i£#L4Ä@ =Tªž *fÔõO#BhšhÉ£O$34Èz# ˆ= Ó&‚DDj I €hzFž§© 2£O+ø¯êZâÇÄn4ç8±®4WRpý— k$œÉÉÉ’G)\Br¬œhÌriU!ÄX‰‘¥ˆÁœPI©E'%ÊQÌTI \\& rÔÕTTÜ f„€Š"ú¿êæ<À‡1Å+"„\•ëÿw»Þ÷w`i¦%ÆÉeœõ:`ˆ*$ÂT”ï9Ààá9J9Ñé»Ìæ“£çUy¼Ç„ò'ºw|Ñ3V7.øÓ»ÜêkÜÞº¬¤ ¼úïè{8\UÚ<øÜ㚪„Hªºww†B28äAN÷»Ã¤Ù æ÷w¸pfyhî¡Þp…… ɤ…©e±•‚¤Õ-1[Ý×`C¬æ¤ñ<œʯQîÝNqJ²plU„°b’òh†ˆªN,Ë–*G¶pͪ@R±]U]ÂÛ0´ªiÝ7Ü7@U2§WŽè¸’¯-×­°P•7CvŠ™6!ÜTa¤QWUs‹œÈÌ+‘n65Ää %!›šî€¸58c*ˆˆRÄÃœlS—36±ÄAr„Q”R9Ý‹Mäá8Ì..HD¥Y“€ÃŽ:Â½í¸©sKaêŽ%19Œ’ä„à%Þdo·{Ãܸ{w}¶Î[màêJ™2d“LË`î—G_<wwœÝžo³œïv¼gqCƒLáˆÙ½ç¹½ä¯wžÝH¼=•( ZÆ*ªÉ‹»¼áÕ÷NžrÁ™›%ª³2YyÞg•&BC˜Gñ<4] \,¹Ï^·Ùï).5ˆå¯¹r¡iß'q nÝ9—\el„Å F*T¤© ²V*Q©Än&ZÄRÎ&ósS‚9¹£«ˆ#NYCƒ£ kXÔRk†ªlV-[ÝÌ8‰Âgœá™¨s)i±º]æeœ†Ì»ï5s3©`¡hCO<æð#h›%lr&ç}7»tŸ)8•›ß §NÂà ·¼wΛ¢¡Oxðæ.ƒ””sNqìÉÎvõ©ì< âÎwÏgŸ9.iÑôp8õžrÌçk¼Ý Ô8r0òíãñHY ALW'ª’O‘ÉIã;f§8ºô±x`2±a&:¡#¦$×l€Çdä°åÊh=ÆhûÆPNM´åÕ÷82Þÿz¹8#Ý"È¡ðø?,ÊćY)êÐÿŸççÛ&žÐÒÁÓ[acšÑ,ò6.¦u k’7&áT¶ê»†o‚ ÜÑÂõªXºk0:$¾›r)Ká¬g’¢4Äõ¥V\†kèô­h3úÏëõ¹töÆÓ´'#!…Ìæß x=z3“þÎñˆWÁ窫2µÿ7HäD_ÃH?‰» z*Ï'£s¾0é‰K8‘çg e{ñÿ%–9‹7¿|Bw$éÊÚµ¶Ì,[Úºi?–ÃU$ŸŒßqIYW_ŽC5ÅŽE××OoœÛÓ¾>âztôìK¦Ghä÷|¾3 Z˜w³o‹«LeèxôÁŠ D+²‡4YK›§2=ãØùoóD\ƒö.DSò¶ú-#­QöÝ‘±„¯ä4Xn[wr —7Î.Ù†p{çÌ·éÝMe)ƒ´8¤Èw)b¥¾YÇžŠˆáÞ˜î¾JfG]þn5˜¥ußStü/ŽÉU).²õµ|ÙÖÕ¤ŽhM „ 9õ@}¥$qè©<… ­}°BËÓäå4Ö¤é9i“ÖØdcºµYG cÀ"ìƒo)¡=×@–†\¡¾U¢”`¹S¼Bu*å’•[ؤž@͕кØ`òò-”ÙkD äQ›|5önéRe­26Ñ ã:+Äk<|1]ÙÌ°!áuZA‹$ôÙ»3%m o2ÉT”ìÌ%¯[H«×G*x1üáB¸~Waóà2øþÝvë^íts6±º[Ûè«Zgˆ·Qy˜ºÍ„X#)騔ƒ0üê£/N—D¬wæ–Ôì ÎÔý´YnêQ9ÜÌU‚b•ÛqV' ógº³VË¡©Ôq­,'m©®J.Þ˜8{#À'˜Šþ“xy"•JæöÉ fÀ˜³zÚ¶ Zñ@ qA‹‚rDQ‚fΆvÞ¬µsMþõ0NñQáà±Mü±ºæ1ÃU½=UÉKR6Ofæ^¨¾è:·Z…ªøpŠmB@ª ´´1H+8¢f®í|¥àlr4n­ÔÄÚmu\4Ûi¯b{öÚ«kä×:&Fc$M4$§Kœˆ£&®•òõ{ZÖ×ÍôÀL/môKñþ8tÛþ&“N[j $–BB%‚ËŽ5g¨h ,@’(Ð’BDŸŸÞ·âÀì+0_p$“i! HzVÐj¶¶¸Ükd-]:Ò«cz5†]T PövÁæèĤ*rÒ£<7 ŠXh˜"­ãºo¦S;«¾°ÔÜK1¤!´–$0I%¨Ûos1ãÙ»½áÜ¿À>ífÄ¢¾~GÁögß9«÷•wJø‘´žHJjfð^8V(JÌé]â1`bž”ÅL|]R¤—jtˆÛ\L"®Öè°ÔK-%`Ë×}(UµÃ ï"V·r)&c¥èy\·(¿oÙÐ/˜¥4¾±Kcžð//¨Ã öÂ8ÙÆa²f9]#GlÔûa^ƒ•!‘ š &„[“ZúôÁ›^jqë…w WŽ.7ÄÏ•ºÄj³ËD@qRÆâ^ûeŠÚ"ç`µ1ÚÒP{µq«ð)xqÎnçâBrc;ã%fÒAñ7kÜí±f !´-^*êÈdí^ç*A„*sÑNáY¥ 9 Ž4Ûf%°G¦_°ùø îFìú䥷aà“Ÿ?# d¡C27£¬(kBþ«hê­±õ4jLaDš¨Í¶hõƒ¨Ú¶#i¼Óëùi/©8}•væ°\†ÜÍ ÷ûºUÏ#".˜ÝV€õmA;3fµh>ë=à‰)›.åˆ} ÝXmôÒ³U¯EÞ‰ú!ˆ\#6&Oš®ÉSBc¥}~Òn!Ô^}s,PØá|Y"èTåâ4”¥=­$ÅQÇ Ú++ÉTÙö^\Ï"g&¯2½Ô7E;±whk~¤-ÅŒŽ -¤»l¡=ùSÇe¯Sk¨"ÑQ§›èfŠ ¯nd=«ƒ-hQ’Ü1 çR)2O0£Bó}£¢²*ÚzNR4’8SY„ÿ“ÞÁijÊÊŽÈeíë›x„CÂs‘°—‰Ë-üô£¶žÓ Q£o;y_o&æ3eÎ{Ð4¸3gutí9eCoB$$U°–"G£¼Láݬd2=QÛi«Í~^R±¦$n—yöïó³†>|d®{ÒB…ÒuÅwÅœBl¿ N¬a 1=\<^]•—TÄðçÓKTš õÓʘbxÉð IéV&|‰åÑîΩMbQà§Ï^•‡/¯¬AÌÌÎwÆ•vRw1°!;MùªÔA¯DºÆ²§I¥)2]L^Ûc à]/ÀIJÅWœL“žÍAB¦A§{Ò{‚ €‚Pˉދº‘ŠûŽÝ^Ä]‘öDo²4,y¾™›9ìî ˆ‘Zòüí(&õO`Ê\᫾ûꊿØ,Ç£_‹%fLWÛMfäZ¥8OÊý[m§vÞ“»]9[ê³£—¯<îìU¤±Þ†¤˜‰’¼¼™½Ef¤˜­Å³wq UU-æqžO]šÇ4ˆMŒŒ3‹‹ÞºÒ»R¤b ·4ŠÚæd15š'MëQ_xÉ„»†( Á!x hHü pÊ„„†ŠÔŒ* e°¡x>P$D—Á"š:‚B‡-òP•&{çÉ5MønÈûs>thtó¡Ñ«â£ÐÍ6³h&×—¾&¹¤Ao¬SÅÓÂÌ„OB´µôRb“ñ«Ô-fg›yÖ• [ß®½6ÆÑàV¼Æ|.üb%è"½¹í1­†Ëž˜azà÷¯$5ªùQœˆ†ù~v`ú ²¹.´‘ò¦ô(± !ÞcL@‚ÌöSƒ‰¹N‹x> ÇeŽr[5¸½féC˜@8m¶ïzÁVy¯Lýë[Ýö±3aÜŒÚÖ\U}9¢‰&#ŽÊ!œ–%TÌ.”/.¡+'B)ý™B‹  ´ú53“É,­*™Yè®pÐ=c7”^œ3-©HçiH¸)触ǡ–Ħ{c´JÒdJ'§ U£ð¢:@„÷Â\yÖÏã $ÕÅ1Wß3o*&¶‚š`ÃÃ9š‘dÀsMÃhê¨*”ˆ`Æœ¢² ](æ̨a¨Z‘ Æ¢F ÎA,Y+k«jÈÝ&)V8‚Úé#yÌÿñw$S… IòÁshapes/data/steroids.rda0000644000176200001440000004541415076647713015022 0ustar liggesusersý7zXZi"Þ6!ÏXÌátåJÐ])TW"änRÊŸ’ÙTªµ&²†‹KQR”èiʶìØ#hgë4®[‰+íÔCñ<å6ç•ð)ZWqÓ¶¡KLjËmƯÞÃð×éFk×›ÙU" !(jÐ!­8sg®º‡„zR¡Ç·\@:ÌØ4µiù\oÞCãˆïVExïìß©.~„1âÒ™ÝÑ€Á·"0&Öcî:äÂý½#žp´ ^¸„C:5)5ÌVD¹!B²^Ø}Ôáa¤ˆñ©?=(þ]‚ÅFVa7¶ûC.µïæŸ 3XÔTÃø¥v/Öò®½Y’»Κb ›Ó†öüDþ_&±ˆ©ž”4`&v8I½(§Ü vAäb×ÚZg¢¡’~1óÌÈäO¿x¤*Çw(°õŽ…¥þh_]±ý!)Ïþ§¯ÁÄɲý‰(k‚ý¨ÌØ‘@Ï"s„„s'#ö:±!:sÆþŸýŒÌÓ}ÑÕì‚k„_\Y÷÷ºïj+U(=a`œ ‡€$1/áSÔœNÐUjÎC6½ÂßL )¼›ÚÖnsìÿ²SÿÔâL£•×å)t÷„šÌ™èz’BɈØÄø–äGŸ¤a;»÷’Þd(žÐ˜ðߧ«7Ç_So©H¥dÒø¾5gŽŸÝI xpEÜÁý90¸ûeé‰\Äî̧ÛÞ g‰ ø½ èg]Ò¥'õ šÈµà{Ø<Ì:¯lD}%`XüA€o¹9r»[Èyhæ &/Ðáõz €Ê6XçóïÅe“d™Ä–ÊRôXÖ¡øÆʪ¹±{T¾Fÿa™iº•Pæ@:L6ÐÄd<õ½e´_˜ì|6ž™óÇt ‹<ÕŠô‘®g0&ênÀeåŸ×Íaq+q}Þ9FãÿYQ7åŒ8Ÿ›Œ9\Á nG¬ucr%@ʱ )« £Bœni!|•z/ï·z¨›ž%ùæC#æ7}ȃÙË·¾~pÙ1MÆ2/7Öã@68IÅ_ET¸’ïá5gÀ¥Õ«šb°ª– L(·pÍF#Bz žü¬ÖÚ¹ýA$:PÝñž¾ï@8l{1¾Cª4Ó&F˽zôÏútiŽ”l¬pêê6Ÿ÷yuB¤ ²ðÔI§ÏùúaúéÔ‚MP·Wh ó}q¸Wša:¤»<•w1 îÕú×NÀGñº;¨‹ ™–Á-òAzдEV9ˆA:QeŠp¢#ì¦ëè]¦`þqgT†/®äOúÊž/a,ún ¼J¼, Ïò-V ¾ÎK/F–)ô˜9[·š96G_w¡¨³<%X£ÍÔ·!ÃÒAÒêšÿMâØ@ÈzñׄÍmÓ¿ÒüšOEÆAýYRÈ9,\ ö–ÖG@ŒX”±оB ¬k½ M}?wGÉh,YFà»v «Œ÷¯wmdCÐ gG«¹Çv6«`@7n©Ì;3f³¡DuÁßÇŽ* sÅíć特ľžù¦Ø(éRéÓ¥2ÄbÑÁoðx:öÿ´ÜÓ.þ,Q¥xd‚0Ë#ó2)ÕÀÐP¹´²Ta$ hUš3CqÛƒŒØÄêãó¯°<Ñ3‘á`R¥{qñªo³vü‘Cø·èE>~Ú˜gן±S¢{EûÞxHˬŽ[Î$wÕÌ,:n=˜gâ&Aözr\UŒ % $êïÈ5ó¼ïAKÌ•âð†3Í•P <ê ¹$yÑþ¨HS!ïî g›“‹Ÿ=‰*?’\ç#\gS§3‰gƒF)ÛxúNËgnˆùgý\ÎéžÍ0ú¥ºöª—þÃo‘·6áf‰tÿ©Àî9¨ÁŸ.a.©?ž"sÒ×+7ä6¦ê%oú1âÕ]mÓþz³eÖE0¾ÖöÍñPtjân{U"2ìèQ²öî ÐöQáp MžÃ«¹ÀΤÙwjÖb«yâ}ö>首R…}Öÿ<ºpƒ nÓ"mñ´«ìPcù£¿ù {¼%ÇA/‘U”¹ÎèiJG¢…În‹˜À0É ™¼«Ñba“´»r•Û+÷ÙÀD58ê&ˆ s±%˜|Vôüåu—¯nF^øm5„6Q·ÖiøQ«Ž%°ÌŽ]‡ZÛ4 Õ;=B*Þx\v,à‡F1“¸Tô€)ÏrÖ[^ ¿‚ƒ6˜ÝÖ>6ì—qZ!,õƒ›Oë@oÁ-Ñë  •õÑͤ6;’x_Y³…Èç )¯’X0ߟä€ìø=¡0¯,®©«µk¥2D’W_v¸ª5Až‰ÂÚá=×ðW)]-Ī‹Ü^UdðrUkd?Òúôƒ,LaF«ãNëç)Žqäân ¯:L7‡w6b%þt^ª¢;Î?~¸Eür)7îüCNú¿±Ë¢! p¹€€ÔX€4 ÎêÈ7ŽMu ?P…€á!J4þJÜènmõœ'°v†{®Á¹“W‹aKҔŗœülsHûOÀ®—X0¢0 y4;ÜNÑ.N;Ãc¼½?$·x\º Ú¯¼‹Âme'¬RµÂCMwÈoÓÿ¹KrKŠ€ö°Þz4)—Úƒ1´çG.Y=@¨óCŠíJÓ—RµÛ>²&ÒHMÝŸ Äš .:3ÿ¯ŠK$þƒG‹ç‚£üŸ7”@xXðÍÌÐ ;†ˆ6ö§pKàx¯b`´‹‹ ó¬ñû(¨Î q¤Ý£ÈÄCÄò'Ñ¢JŸ:Ÿc¡Ïë€×ãa…×8Ðá,Aè¿zÄím‡|Ð(JêVê.`i)×\q™ì)ut‡—•Û;¹…ã,¥•i§Íõƒàn@Õ<ö–cÝI”­²¥‘œË賆rÓÁíáÅ…lóùÊdªþठ"ºßPŸ9 Íè_çþl •½-"!&ȸ ê”\:X8? L™KŠ™1š[ò°Ø§Œ=c«àÅ„ÔèëúÎ=¢^þ.¥«$Y–&ÿó‡À7u¨ˆ» ¥Wš7V-Ci0 ,líp|<È\$O¾£Òò•M¯@q£mæ)¹ÿ°ôå)c÷ã(ÃKšh›ì!8=g¸UBϯH‘”Lâp64…3¢×í£Èâ5bÏ99açM ù餛e¸Ín)Ò§ž͹ó6¢œ \ï> ?¨ì*‰Ì£±€ô.¢‘ÊEÀõ±Î)ky(A•ïVñzDæ oMb›ÃumR*ÄØÐ÷’d¬» `ÓÉ8VØ̯0_.î…¸ET¥‰mh|¢NJq$ß™‡¸»é²ðù©(鼈 ¼ïg,§P€–º&´NSÙ”·çª ׯ®‡8b¹© ú&ùƒm률µ}ü_ƒÑ 1<Ñ•+ÒW ‚‹’v;òž •Ò\úSç—/m 5 tJlÔ¥^Bèª [ˆú‰`T´öþÓBW\ éÝŽ †¼¯ _ð¼k©ë›¡¤¥ `9e’èÆŽ× ™xZÒADÁÍÛ:1éSöÛÇÑ< Ø»ÇÇ{%ü¸åÙÓÓC£,ÈUÆŠ »íäª4—ñùȆ ÂvÙw™kj;W HÅtn¨†•*„ö’jµXû´«(s'è¦WP?ŸD¿·§l@¦8Ó„T=² ‚v âçÅáÞà«Ö³]äòR×±Þ˹ø©%RÓ”õ(v7‡9^9´©H7\ñqY¼å…Þ€8B&y@5!tò¹{xÏè£Q’½‡¢úüQÃhØ=³ö"3‹û1 GDò¶ß’èÎ!lžIà Y¤cP¸8£°!ávˆÝȯh8Ãj¶ Ûݾ?ÄŠÊgÅÔÃÑôˆ:å äÐQGøÜMC0í7Fê6D€¹³‹}¸±\Ò ë¹Çç¬ñ×g÷]_и:‚;§²{xr\PÁ½È1™¸{ƒÔ»˜‘âa8s[‚LÒó¡Ìª’Ü*°öÃ.è©Þ}êÝÖý“9ìá¶qîö°r¯o†ÅæXO>^ lÓÖþ%™ÛZŠ»ëQ~Ë*]3>å.$—–îdyÒë—Jµco´x ¼,¢cºÀjfHs  hbÍ« 'õ«>@ÝBa¼Â; mI zº®†?<Œj&!žzW:K+ÙM¸DÊ7sJ†Êªµ·bŸ2ºÚü]T|1gÕÒ1çq hÚ¬{./¤¹g ŠƒhJjÚ°:aŽívrBÓ¤*æ«©RyÙvèsßÅÓWhP@ªfŠ#ƒd„ ]öZ€sû$ÒÂæjÕ1SGT＿p§ÛUÚÓQÖG€††‹…ÌIâ‚<Íe•½'Sº×ûœýßx^€¶ÁѺÏJò¥CíHþ,´:[E"Þ.:a‰'™ºíê.çßzÈ}›s’±„ﱪC=>“MÊ9po:ð"W¶5BѪ]H™hEäV¥“rêRÙÑêukÌ3°–†<ò&1vó²Ž]}àKkç GÂ:EK¼ªõÄX„Þ QoÁ^¼€èÁÜ{=QZòèÛ?T1.õÃ9ím³Ø”$v{R \Øm|µ{'OϮ퇔­ô±a'¯™ÔÏ]Y½)Ø!ÖÑüñF‡w†QƒÊ(݉û!Ð4ªB;ê_dÃŽNt¢qøFÁ=ÕÙoqù$˜ë¦ßHþ§ÛŽü‚õw0òJêˆ#’`•F6CyVë …FW‰ôù:B!5¥vq”³b+#„Âßq±Û«u<,ø}ûUþ²‹ŠZ™|+øÜ3<_›heì[¢mÈV±ôCéL†(*@¦[«—ióY˜ ‚&ÈL|[8\zã] ò-¹Ç×ÒÅ*¹jèw<¥Å[k'U·š•C6.üžã&?®{?d®:÷i“yà…e¡*ùQ)ŒÐß©«àÙø‘!§+Qs?TA_‘IçŒÑº÷…°‰–üKé»êIì›û`Ü÷¬çƒP4Õiâ{¨æöàIÍ%zÎPm°?ѱ¦ÃJ‰Hh+щ%¥.I•@XìvŒjc®=V~ŠÅ/ÁÒ0{ØöhÛ®ñØðF+íL‹ó¼p,ÙÎí:ȦÓ£ç÷M¼ÌIûÀLÒ·˜^Û–ìümäC)3)öÈ œm­FÛï¥?i¼¾)Æ´ñnn*Rܸ©VËÐBý5/üÕ|_ZŽû%÷dqß üÊ:“=Ù” Ë•ÿ4iµ¬vŸæIoMÐ rñêœLعý•‡2|¼õÙŠ'\sÃßcʇ†sZ!™;†\E³U¡Lˆè*%@¹^–ÿ¥ŸD¢ ”À^Xä‰÷)ÿÉŠrr¬ÝE>Sÿâ3kÜKì˜Æìק¿J&›¬QG5B²Y>˜.6÷éc¶.b¾£qɱØhQÈTišÕkNYÒXK½ßµÕ3.m¹´뿹Ñzêû¯ð‰Ôo^YÆìÈÞa‡¥! LjxëJ›k‚ ƒ¯2†S=aíÍm+l2Æ(±+šŽ‘)]×Ê´LŽu|cÕE#²/% ?7ªQ9¦k!¢oêÝ vªÒ«l'w”o¾`מ¬gÿ(…:Û¥¹¡ÄI÷B¾ü9æÙÞ‡ª¾ösÛ9lžÕéáÄxJc–'àÿì«ùr (æ濫l=‚#ÁõÞôÌ ê£Ò-ÓƶÙÚ±þW– Ã:Ð÷,Éc–)'!è6¥kµM °yÖ³è5$sËp)°ï§ÄÜC#¢©ÈjƵ›Eè¦4+êq®®ž Ó.í…{ú‚Zþ+ËÞéß¼hîà?Ó­ô”Ö f¸Mtýv=Ç{)_õ¼£ZÈ ª á\–6`r6t„R€?ÎRL…¯P“ðåŒÔù"@PÃ~l¼·$ùË\8jwñ™‡.ÒÄrÎÝŒÀMGÛÌ5ÃÚòÜŒ’-ƒhÃ>^SàGÕ7µÿ`oW g¯Ê¤Ú²•ÍÅî•=ç°+M¶²dúO[ÒHe«ïÍ/ ¾ñtC«ïQn]yÓp´PIcˆ!œÃØÙ*¥¿ûž”VÔ¯Ý' ñ½)¤¥™­Ê%¤bÑÂ`uf’Fª4Wˆv¯Û¦ö2ó Àâ?rˆ`¶BitŸ(F[92ÇïçoÓýxOn¼d+•b Em½?ñ»9½óåû؉zfšP®M|k…ݧ±õÀ¹ÿÄc¹Ú/Òð0ˆq©0@Ø7“\21ÆI†jw*ækª Q¤Ò²> eâ!à3xB ˆäðñ¬µ*p4‰skÈm98k†£;/5Ü#Pj,4jÎ^@4¢5KbxN€³žÞ–Á¾ü”VOåýÃN®ˆˆŽº'k”ÅugðË«[¹ÜÊ]\¹P2—=ibêÕ°–úâtP*¬»qAPÀž‚Ï”j­ë»ÐøA-KKÔ#ŸP’8dÞv•·s¹*7HòX‹t_eÆ]-+±Ä $l¡ñJ–g]Ky] ®ýDt/ Ç™\è‚ÝÙöê¹Xš¯Ž`8cvÈ¢¬Dû¦4gKE»ß-s˜eý¢[€?0ž…gkŒî+E6\jkZa«™Åx¢rŠ¯ŸaÔ¾K0¶´YpGò)–`/YY9Q•@˜ž+×Í,¹Ü—{¡°yj cé›s)ÛuкHË!,ÆY¦Îƒ¨™‰Ñ¬V‹pYϯÑÒo…æØ*û•öÖ_s>\5N_~gh7°ÌhÄoô*~<   »†Dšƒ7#]°Oߦsÿ>ðdDXéÚ%2yê ¹–ÙAË,äÏŽ0îÀ¬Lü—¿¤F}­N¬Á£¨%…s b‘à¡ÜhàÆ`_°ù¡¡ÂxpÕ€ B‰íÿÖ[ùx˜Á 8oÓÌá”Î~†M‘qü+Œ¨6ŒLHv1Yš ¼' ¬míh›Œ Ft1PpÓÞßÏO¯ù¦‘8K¸P_ŒHásS˧9ûi.òvqÒˆÝë‹Z2|b—yÐHÚJðº÷kÑ=D\2oÉ}7]^ÒÎ΄ÄïAs‰wO¾k ùÖlj¦À¸%r‰*d´¡®>×ó#ÇkïŠë0Þeþ³º'‰’ÛÍ·GâG]LªÏâè!¸x»ïÌM’S³SÈp"µãÕ9€77ºÔôö¼ôV.™™•†ˆO@#µÞïÉáÑKl&ééI îÑ57ˆÅ0Þ¹ qp¡¨U)ïBx̓·TêŸcüÒß‘.×ãCæÓ,·Ó…fê,4@"‘ËâæpÊ;ÑŸ%-§¬üÄõIïôäØ€ä±÷Rã桾 ²$ý.^Fsû¹bñÙ{ï6+> Φ+œÙ6©?Nÿ•p|~^–‘ø 2ÉŸ«àó¦ñ&uq®-Dn¸F܃ËAÐ\ð:Ç¿£ßXïÒµe’y¥NÛÀ3Iú9zÂÊc’E×·ÃÀÖ ‘Ì’‰•ÄßØKG±_ÇdœŠt™¶pì´¦­û7Ñgo ᤤ„fa`c±à”bpmÏö*Øjí_Á¾%Àl‘Êï ª»á̯Ûh:µÞßk î^J¡œ¼±ùÿò©JåB W«-<:yfïÁŸ›ó‚—'F{g±Ë½ç Þü¡xÖv"”‰–Õ[a­Ls1ôdEV›cxE-F´zrŸQex{¯“†RæŸI´¦¼Àké‘Ïãés§½s‡/ íæ^Ïx&X¶-—€Ê·é@p˜xÏ÷–jcó¯Ã­y¯'Æ=a³¹¡=yÉq[Ý_GibeK.åäô',—ë?ãiCœ·€ÎGšh ASðãèç©€)‰»'-×dvHiò†t`ª+ÓYÕúÍPþ!¥ô»¯‚s ŒÞ¡2aò³ÞÑÝð”.c§ ¢Š»éGä&ü­öêLçæè¶M¶C·[5†.O)L¬d›“§Lþ °zŽŒ~¿biNQÍ<€äŠ*¸yàü)¾˜³^OýrÄk¶³•E9=¹$ç[‹šê‘k_À0³L­œÃ½èÚÑöÉŒúÎ"fYT/~Æõ¬òøBc·Ø7pçè«íç%n¡có»6½Ëž³¨Ì^ó$d¯~B—ؤc¡K‰+®‚phÀ-¶(Ñ5¥9ÕDi^b» d±Ö"Þƒ’%žm¡•~ƒj»÷)™T2”¾•”¯ÎiŽ—µéÞ^‡{ qßh˳uR¥±ñúöJHc jé394Niê[½•æõ&‹OÄ@ÜäX¡C(€uØÔ-¾Éÿœ^WÅ~׸a‹Ø;®ußÎ^Ð$ûˆáø] 6Ó¢žP õUnÅ­-~6öæa"GŒ~'˜”—«´ì–P(·†KåÓÔôdzëìÌ;¶ñ¢^ðäÁ› Õèæiß%ç4»5¬wôMб\Íà‘ñ<iy´R=¹FåŠaõõ d]ŸÙïË!¹ltîõüâõ”™ 1á){ʵ“×-S‡ h‰ÃÔºªµÇ¨­ˆÑhKÑAi=GÎn,h!:~βâÏ1½0-4¢†½þ“±¤ŠM¦ý¢ÔW"PñÁ’d9MÁÛ_õ=yŽÝšqef Ø$yð³*扪äª-|FýëQízŽuq˜öXKcgLJÀpî«Øè0øðvå_?{XAÌ7!Þwf.’6\϶±¸q"‘[÷8þ Ç5ïÆ¿Iž©ã!T^ÄFWuîzØGx:;3! Zd@5ºfŽ¯s$ *x*O„«; i®3j ¬…*[˜uRª'ØÞ *HQgPy"ð5@¹_§äÅÂÐyÁö´Vd X=ó†|ˆ@$±!ÅÈãõf²³ÀVv 9¡î¬J7xøƒGgt€%ûßÓ¬Ž9OUžfhŽá ª%/­Em ­(tNèŒXÂÛ0_´‹©ÇÄ¥Š1’С€av Cè˸Ü[äK»¡^"ÍDÔáƒ}ð¹ó Í#[>DS1u¾ 'WÉáS9Ë—kBÃ< ”QS»ka …ÞƒxRíéi­ªc±ÅØ=üò6ŽzkÞ”lÇ&1̹÷ä(ñ‘œpçMX\[䥶(`vgä-ø±¨Åꨧ2ûÌÖÞ¡UÕ_¨µ°…n!£$˜ý‰‡šñÖRØ'‚¿6j„}bYIÀfRuLc0<×!3ü£e9¯/)Ð'ðKܶœ—,†£÷éÒ´>LDuÖ¼b³¢¥ÞÖˆú‘Ág<÷€· Ö Éöƒ¢úéć­uøójT»4ÚDJ µJEY.øhˆßeÜ+127om¶ùžàÅoúpðN•žÜ"ÌGº"±öݘÅñš»Á)ëÀÐTU´3iQ+˜)—à!¤A>S=G´¤`\ÅZçùVâŸÒ¬IëÓ©µ¹‘íÎ[žºœ¢·óª¾å¥sàHH@ (‰(°ïs2‰¿YmtV#ñƒ-5·ÐÚz‘s&¡zÒ!ÇÚ>‚`3sCÖÌ9Ø,̤+>o@­sW&”ü­w/É_œ€á5kźÕîgr’°jé~4*®ˆˆÏ›y¯] kG”EÎ8m®í3Ú¬Ð?I‚ý¬ÿÉkÖÒyÞÍX´Î¡/-€-ÜÊ ›¬e =äHË/\΀‰ aJÒ*x1wú¦éqqÖ"Æ*e~žLñ5&’Ùd‰Q¸¹å¤ÛÓËm I7PýËÓô/íΤkwk´v„ÓÊ_F'˜ÁÈ=—Rzç< µß£ƒÚ{l½ºGþ€âts…Vç³kÿvÑ9× ¤šÒc÷´F]uð<<à§Ô¯Þ¼žÛ²z§nïÓl£u?›ˆ|ï%ózË:Ð8¼×˜¬‹Lÿõi𨉛£Ÿna)¼ÁmS 6ú¯R;~£¾ç-—äÃÉ Yì[L r Ðª¢N‡˜)ïÏ<Þªp‚£~™VUÍÔû‚Ùm¶{“¬.EfÃÓ{– eßLJVwé1|T_’‰ø7Å[¯M\–ˆñR‡œØœo0gh'«Š²æ=ݵÚ+ïÑzدz™|IœÙÎ[øå‰IagÎÐ7D Gãr4¹žFz“ÕXÈfý3›#âûý„»ª‰ÕÃG\¬6Ê[Ð05Ž­)3]“ÿMÃhv¢žñX·È;µ‚ú)#|Þë×* wÀKûÑ ~é²Pžã õ[—i}PnÇ_P8ÀŽ£¼ ™†:àf<~þ¡…ô,ܬñZ¹ñ¼uZªB˜™?Rñ$ƒlž‚‹UÑ“œÄÇ–W›&”¦7[që +›žRtaËÌÜÀ„ «ÁÀ>¡ìvüOÚ`Ÿ!K÷šóõ=«ÿÉ\„Ü„òÝ¢²{ƶ“/c1(uˆnxV#€D+CÀ¶BýÈD1ž¾zõÚ+&_ŠU©ºŒ ˼¶1|ð]ɤÖUóÒ5Wº`˜8:åëêì‚Y°ÀwÜ…3ŒJèËŸá°ˆF5œ€z6Ó5a‹çRÜ{åÛHD¨¤h-t¾G¶Q÷ß{¯.>Sg]UI†¼a¥°zœQ r`šß ã*‚›¾ŒëvðIàN=æº<5V#8ö‘Ńj}¤:ª_¯€²a?o ÀZ[˜ã\BHŒ8Iƒá™„?V¯ˆÂʃ©:³C[U&¸Úò\Ó³ª t­û#È7fu(™ÐI>p -ƒ|m5¸hçôàÄ]v‘[ÊŸRØKpá¿é7þÁzÝD´î=&k O+§F¬ËœgM.W³Šá‰¤=Øn1Çî7óJÆbûÒý„Tqž§„OFÎ äF«Ø™Ck³(lÐÀÏ’˜át hí‡ÁˆjÚŸdÅ¢Ve^̈Æ÷‘÷Ö{•ióÏ/'øiµ#%¨>ö1–)hFâ¹Ò¡Ë /g*÷ ¹Ñ4×î|•—Á(GíúËdà3ÑJ®³&ØÚÑ9 H<.)½™Lñ9Ö¨l•“ÍJw‡PpÑ×Á rúb…žð½³×ˆP˜. 3¾ãƦv¼”ÿãâÝ»+¢ÂR7iÏŸQ¶Ð呇|çM†ô?¬åTÉŠ–™¸Ýˆ…aµèJ,㶅z%L;392Í[CÛpêû÷6â~Àü€“2’ý7ÑX{g,N l2Ž‰ž91{W t „Vo+©çŽ÷T–_tÁ¶â­A¬7¨5CW:96rpß]2NÂ`Öy^[ôCE3dZµÑÕ9ýuŠw¦he@:Yš”äÂÆIŒBϽÆ¥¨ØǾ’"wòeÒGV¥¶C{w~àŠlçÂG|}i.á…‹çË!™_]}U—Š8…2½ÂÊPØ5éI·FƒNñÙ‚¨gNlÔÞŽ4_lÚ=á HŸ£fð[ñx@{„½ |DÑÈ€l Ÿ­½ªÜ][&™0[+äiÆ?É!x‰þxú—[í"´OúŒ|pu”û}ˆ”U•“äd‘éÿ>yÃ…‡Î`S<Ø‚å„ýl‘®¢‚úwgÊAæP勇´Ô9.-ˆ\cÐ:B@Hcys†X¯ @>š·¢éVqòQ ñ L­d˜.£\ ·P£ûÅÔh™ü›‘>Úr6ÖÏ2Ðsßb¾Ç×pìšiú”[†ÅÞÙ†7µLšá¸µjµ#:RÃc×MjôVÇeßãœe‡‚=®ƒ··©„!£ 5Àì35îA €÷W¿&¹c?Ü4`]%zrN„¸´àä¨A˜+ýqÉOeÔ(„^_ò« ‡ªÛã“J¿ùÈ¡X( ãÔ{Ìè\DÀ)«#L£hnÛÙ_O¡†ufø “‘*·ëß$à ¼X%ÜOY }~ë‡Áœ,‰âè—SOÎÛ¡¡vû¡©bçí΀ãbÍ´ý¥[Ϙ»ÂÁíßÙJggu¹E-óø>ÞÇwê&ZBçÐÞêoÈ„õ3fË°S½z‹) éR ·Ë®HÄÞkÕ׿Ãÿ¨ Uq³ZÇê(§Í¶ÐüÅ ÎXcnj>4ÐßÕÊ ];Ù*Ã'»fÒ,ߨpqz@%k‹¾ o |ŒyšyZöß„ÅM×:)é¬ç;O¿î“ϦÀÊã°ÛÕxò”³A¾§U ^gä•!¹²’ÌÖ¹ÃÙ+¸s–*iE]O;šÙÿ»Ëµ$&Ä´AtKú…í=,¹ÜÀCkO›ïÙMÈ“Ö¦ï?SUjÀ¯ÒÀÎQÚÕðвâBB }õ6•ø;LdÃ5wEÆ—£gk^wiMZ¤Ç ?¡ÉÑvRð’ÿßò£<)úÔehàÞ*ó0O Ô f~y{# ½²è˜€²sZÜE#‡KädIÀ¶(ÇB3¡D,6ù"“ êjŒA\6ÓÆä“–öR¾>”\[äÎý÷M­Ã¥-@Ì8†óì÷Å6Xð1ýÆŸDæìšÄÛÆ0]5U¢Vâ ßßJì: »3]Ò‡Ïäi ˆšù5Gâ²}´¼-±s_s‘šž=êñë¿^Ë ÅU+ô½Ä–!H=úë®q(¹\¼mi9o€µ™Ï‹€på¿'ÝtNhôÈ1W(…,})è^ª]Çq†ÿÁ‘Þr¹N`‡mçpø^ ¦â8r´7ö•œ¿¾ÁÖ·ån,Ì#ÄÝwâÀ>~à=Š‘s#owéöo›ªȺû3A>*.¢²‡2 s8:dô°Æ‘žÄ|ÎnŸø7¯0Øi’MGñ¾>y.àžHaiî}^1ÎÕ±⬠(Ý4^‘#_¼î94zqÐjÁ¸FáÕD í-¡ÕÃÆj‡6œì—1*;$BÔ¢ì; OkórœÅ?[tcHQówO=ìÝ"“eôîOÊ/ú¶F`àš¯¼GY‰@æwÈ>¿«¾3&š³ 'dZIÄÍ“îÀÈ{Íx«Ë¬ VibxW4ôþÒKÉ¢¸¶oTP¾±1ÌÁ+Ý@9ÆÃ.&â —ŽyU Ï1*•÷\È Ö §iG¯ÎöõNŠ—‡RE–™:W–¸eê(Ÿ–Å掰^œÒ{ßRҋăÏÿ® Ž<Úê©f²øâ3Ýrl*4ÉR#ìäEwúø—ŽáÁí<7Í‘ë«ä¸H'éæE<ƒ÷Ý£0µÒ £' Œž÷=þØU) ÉíIt|Ÿ{pmáF{O3 $º~4§/\;sn¾û¦÷|oÛ®ŠÂú³× >n]ûR÷ze±_nº@rõëÖŽQ™ïêõqÝ ….iƒ­»ÎŸÕŸk‹òĨ Ù_jÚtóuI¾<\$Þ°¼ ”œuÝT£íï9%†±ãÇ<]ÇÄÍkÛü…%„z¶‘}ÞŸY„Cj°”:gQ¤ˆ@ZÁÕ ¨ÊL_œØK)€ÛÞhe_"ZªB5[RƒãÚ‚9˜Âì#U—¡úsLþÀ–`¥,7·…VžcÄ;,.fa¯NjìkÓû…–l¸––‚ùsÚKb©ѵݨ3†({Õ§ gDS—”«›d³ÖÅNAûÀ éVa Œ¦ð®YÊ:V:.:Çì—Óê”w,‘$;¶¡äSr:£D±3BðùLÌ Jž7òp^íb¼L¼3»F’]eî@wÅ_Š5h<ï¡zDxœcžßá¼®;)º…¹ v©Žä'ኦˆpb·a&K‡>æàÙÅÀ]ŠÄðÇÉn~Ö¦cæ$¦’Û¼&Kô–WÜËHÄá{0Œ ü“®¤ØÈc‘(“=øÃýµ77.èð>÷z3x[ŽAi©1ÞôëâËßµÏ.¢¯Þ¿xÔƒW2•ïǺ4‘¸t Ë].Mɤ&Üg-¤¥ŽZZĈ0pʇ=}*HŒÎ¶%|ÈŠ æN d+Þó^Ë’°½G¯ž'Ëj ÞªŠiU“ Ó|ÃpŒ›Âj3 Ý=n“C³:çðre-^1¨uÝÞuFçb­ù¤$ûýúŠ’Ú>tðèžÚ…Šre´püJÃl§7(Íuê;ô˜yOÿ£V‡hÙߺpÁ‰^b]t©§fï{œ“^”—ˆ€bx±Æ”ÊÏœ¼i‰Kõ•–˜4¹Ö2åM2VÉ>cZ'ƒúCw˜5è]2hïË´ô¬À:„BjZ—K$Ï¿!} ¬sv ‘Û^#»¢9Œ¾Oç´J†‘¥^«Ùh© Z»ÌÅÒÆÎQ‰ÿ EO:Q²Ê@¼®ãuµõÓ­“œøÉ°s”c à`‰Iü8'”[$×Vs•XÝj;U"{0©C6w/ÄÍŸÖE‡•¹}B¬)WÅ »P`ô }‚Dõ9fBždzh”DøåJ?Âj#¹þÐ…§KÀ¡Ô4Ô'”cNö”vác¶ˆDZk·fiÁƒX Flüxõö©«1È, µçÿ"\ë]h]Õ£ðàË}êU°™ÞxŠ,hØ{:ã•MË ³¦:›„8^-Íg¦°” ˆQT2ÈúÖiÍ6µIk“{ÜGþœúéXA„¼+‹™¼P”|—¦$ÙÊ 7éI»½d­ÿ_3šâÿ¢d; Ô ©òççrnžÔô®c6rd#PvAú½nè´góüq]óqmîáú‡ô`‚œ¥Uî8±8r“W¿vjG”‘ÌWR–«¼‚>hƒÄ%°V Üÿ4ÈÔà )W(>ñW6¸ŽÙý¡]ùR[dƒ&*¡þz°Æ[8ݪ@¼ªˆ¹rj3µÅv¸,ÚÆ€Z–ý™§Å½ Ž¿‚È ñÔVö~ëL òÚöÙ®Ñ=Àþ<¯+2nèhÊץ<èRDtõÓàÓfãí¢/¢»™ƒÇ—-étÌ£nȨóH!ÏYô˜Šû„®³‰¶ ·“h•˜Šrº E‘/Æ5?õ†fæÃþñ-K2‚´`Ù«kØ€A`Ê… ëAÓõèdšíœRbB«qãk4«Oª©&v0 NÐ⸴¡í(½Äż±®Ä¢ÎÞ}? ­¹¢XyÉ]ÆD[Žß™µ¤Ü›Í‘&J2AZPS-“…IS¼ðs?x”©Sâ)#â΂8 œqŠŸÎ™W‚êtóÿ祩ÜrP'4 qê—^Ûš/+TžÅãƒuÉ6ˆäÜ~®‡AóT( ­­ÖOv³ÿK…Ê'[aß²W©êÝ…^iwº¯xASm+4Ïd(Ÿ[â!„¦BP5ßȉ†¿éˆÖ7Œ¼2Tàk}§W*û’‚s¯AÕ°IõÈÃËÍžig§à]xDƒH&ÚVt×5z.{×.wTêDÕžÂñpH¿SYn°M ¨±#Dæ]mrG™å©Ô(äÚ¶²w/s]»ò’I·µã6°}¿ÍÃN«f¸³*gùÁáª˱­ 1ò\m,Ãá2_iÕh·8ÎÌÙòâôëÑwÀ >åuÜ]WÞ‘ï ¾¤Sáʘ\)Wˆ äÂo{Fj=½0¢7z[œ+qµMo‘sðù…Fº¡±®0$ì¡âxC¸ÒH»” óœë+†f_’¹=x=Cîô/e4B[÷J{1b“„Á~_s¹ß@+oõ‡Ê*¬–öÇ –Ÿ±³°Ç9ô»¼ œ¾Ýa Âë—”û^힢|ô‰ö‹i}Á¶‚7ãÞ1²õv©M™{—=‡ï–š$ éíšÛ½vÍ÷@‰ ú0ck œÀ&íš±–j'©«ÒPâ‘O0á\™LÃ5Óo9ÚNt…4ð—Ø–ÇDPèeý”95¬7cæÖ^•8,–€Jëz&›ü)Z1åeæ·Ë]L ØÑÁ•:w>[ŽÅâ,~ÍÕŸp§w„5/#Íw‘Rìm J#‘æ6—ѳù9ð§zä 1ø8a)â™fŒÔyÆìàjÞ¬âßë$º–7Úw«2[”TŠºÛÖµÐy+[³ürSãšß}錯„\è‘B½V rëo«g-ª¡7Mοè1ŸzXe£žƒÇ»ù6~¤DR’~€sBœþeî4s*KT·7áúÇŒ ól¶] å‹C˜u9-$ÆLÍó»7Âx¿üÒœœá V¢ ¶æô¥™*×…Ô´ÃÊN¾Â¸í7W⎌ú^Ú÷ÝUÈcÕNTã}q6š`Ecy6ÌMÛ´õ¿[4Î `éì.>ÞA7`V=d“ÃŽ [Êóš»ss­¿¯`‹(•£bBÞÏÄ ©Ÿ«À¨)V±HÞÑàJ’Ùu ƒQÐüF`…-¡ásG̼5‰]„6Åê ÞÓt{º¸Ëª5î=†“ú\1Ïòs;:ˆ`)YQITÊØãÍ9Û úFÓª·‡²?šš ·Ñ;ûiì ò¾ÉY»ñ+×ÿ}M=ïJ/0¼žt¯J5p˜š ?ñW1]·óìŠíªÇ7¹;g9V N›|!&NpÏÑ{ZTÌ,ÑUPŸÕõƸ%“ÿV$gß)4J!”âç—ŒÿELœ×`p*¢!J‘byªöÁ®ðL+†Ùçÿç(åot˲nlñÕ–ÁèA‹|±«Ù5£Õ"i€SÔÑ?lx4Wçh]j )Ó+WæLÛã!°ƒÅå-`“Î=¿¡?È™D›ÊûÀ—ÌPæ‰ñòÉ2KÍvù,ÖÙÜÎÿz*ëí“0§s;@þ%gùfµ;u©ŠùñoȬÌüoÚö{8LrؾCMåï'W‰<‘GŽÑ@æ½É •™° >Úºîä'%´0éÄÿ"Ó+=L¹é]¡Æçk‚§$€T¦Ðï&øÌúÈn 8Ç*õÔøÒØ@Híš]JI4R'쫃CL›áÐÅöáÿè·?ê«7›…>Àú2ŸÝœëJÊ—w/2¸…C•VæÉ| ’O ¹þl¾û.|–'×–MÍÔU¼VgËø D0Ò=ŸüˆÍ G3üYâä ÑçÒŸ[‰ôINW‰§2ì,°ŽA‚Ü2fA©’ùÕŸïn&Wý3™BÇïé –pŽ¬‘Wø%-ñ´UkBd¡1µ}s{öJV8Àáî¶üòõqmãü†ßÄC*‘í,ƒ.Þ¬„žmD¾WíäTçúˆþ$u·ü¨ Üñ®lÏ‘s’µzŸ£¼¢î;Ã¥®å±óÖÅ•JH?×Ù£âñ~¾s‘É®Éb­¹«žE1¥NﲧK Câ–÷=¦Ìe(ÔÇ4oJÝ6&îdM7ŠÐr{lIѨ>‹ÿÚEÖ†d„±ä[_ç¤Ê²êVå7‘üeÿô¹z~å#p­û-A)T‘öN Ý3«„vÌö3`ëƒÐ@± {>n?hñÃÆ•è@˜kƒùjÞ–ÌÇTªòTC;+Eû "›ÞÞLõŒ«rõ’‰#(õ)$a ¢ (k1NÅäÞ }ëòfPªBÔ½²F,Vë§!WÆ°_šCòÑÍt”] Q2ñ[ø ·÷tH4£¥¬pXø½È¹¡SX”¤Ææ¦Rp»oG)+ÔðÐ!zßÈeíÕ£; ßÖ×@·Ó,,±ñA2˦Ö2*åÄdÝ|P²ÈQªÉœ¶'zÍ-OݨQSf^N%G›È†ÅÐ:˘×aÍîfGmn¡—‹0Ãí½ƒä)’£ âPwÚ ¢+LðêèÌ:Ù~2ý±‘ö²êÍh…W9*Ânßc¢éâ@X`]™Rø¡s¯F’Œ—ècÓ­»'y!"Î"sþk’6å®qÚu˜#d°)ª¿l=›VQ(iCËx5·b*`ÖÍ\ ¦–1ÿ>Ã[‡vEÈ_Åëwškí±ÿä«m¬8{­@u·=]v<ãV±ÈØ4Ã:*ÂIN“y~-ÍéˆÝŒ°?Y¦ä<1™¹£Ö•wf\jˆ­aÔÀ nnÍçgYµŽ9 n“kÑ̯a s‡ìùõ)/Ó0Ê-Ç ¿T<¶Åûö©,2µßÜ{Q6”7+cªpr?ŒIÈÖ|,Nƒ€ƾr² òJg(7{ °ÓM-l9¨Fý“È5*÷N­îÆȱ´ž)P'P14™VAJ Òžüs¨Vz£D¸6U(ÀC¢VÛŸ¥4èˆ CÞªýü˜gé]1÷71Ifu9œˆ€W5åèá<ðZHR±ÐuÊ6²4K±wFl£xöóÏú›Ÿª³b0ÀIv×ÂâüàÒLã¸[ ji6¥¯d„õˆË„€ZiK^Í>.ôôÀõ_Þïzâ®sG¼eË…söhêFê“Å°þx!;·”E[p^§‰ÿ}ƒs€ªUlÑ<`k¯˜ ‘—ïœåê8²q€x0tBHE»oœ\¡pA´\:?3þ‡ýñvÃA€¸±Ç9Ô~qshÈZRäJËÄqaÇWzp3™Ïîp‘5ßúÚÔ³Ëcç®3ó,[°Jù÷’: D€lX†œqéÝò·½a7eK¤ÞI,ÙÅÀAE¶_"íòΛŽÂÌ[ð¨>‹‘DÑﻪ¢ˆä©«”€·éð†ExÉ ®ÏtÇ䮺>' Wéy&:›!Ÿy/?ÍŽé}‚;¤Ö¶´]Ï@‰4 ýÁèF‘q µ[àÍ¿Å×¢úø%µuµß!XðŠbhÖ²Þ÷Ú L¹O"#I;>÷g±-üÇQjíJ¡}ÝÚvANâ”°lCžÈY!ÌNG˜P$ôN*;H¯íð â ®¹hZD—õ*u_~^5²štdʽ;ÈôLêDZòŽ=Õm ªñVw¢ÄÍ°©“©@š‘"¤À0IxØ d’ú½ùw%âŒß:Pn/UÅùdàÓ?xrùëmœŸúìOYn„Ì=÷åú«·Xâ×nN5æ“Põ²tiyÀ <¼,Z€%-'ìAn"c+¹ìUº/@ÿè`0ô.¤øØxN-•3•ÁvWÒZ*¥•§ÏÛ2˜¢•Ä6j²®[ßòÄ™}¡pïV–îÅž† ©bËïVKžh´ŒL9®S¬¤ñÛH?D­ÙÓ£•yÕO¸$¾·iîe†ó˜(;éÕ«{Ñ%Ìn#ÁöJº FñFæeñ '¤§ ç<ÿ]ö%š¥GÆe®[àZ[·¿aâO¾ÝÅ4yêoª9 Üç`Jî)$üálx<"Ñ÷ô›v«•NÚÄ ÿ ‰ÅT‘Fñëÿ]¯Ÿ^“3 Å3Æã¤ý$ENx¢¡itÕàr²l¢M²ü+ɪ{äÐZè¿ÑÐNž­L?=êU{ÒÙ]Oý¯ZΕe×IØÇ?}r`sm ×»;þrqµ³†òÞ@·æOÛÎ af]Õgë +(UÏt7D›Ç-D¸Ûó €(EÇU(DòaÕðð9ÙÝx´€É…Šn™Qoí "•ƒàÉfö©@Ñd£ûÙÖŸ7'es¬ÙH«h7F¹ÒªG­ê³MƒDy^Ô8h5Ê2ˆµ ‹“™9`=ÉØpÊž¨¬xí°îÓžö@¬¼N`am9Á­ÏÖDqV…w㽓‘ŽöÆwÆ'¿£ózet\~‘--.ײ$•#X¦%ÝÔÿóª·àGBëϽàI‡¨”„—ˆD«xû,6xúFxÂiÒ27Ÿî>&Ó´,ÿÖG¹ºÞ! )~Óx0鎃Pf Ácú±!>‘ÙÅŽKÄt„sØìxº­Ë²¶ž•žuª ˆ(F0òS¢B }Æ‘‚Û‘°üìÏj²g„›·ÄÒÉzÝ–Yïdøa¢E‡çu"0ë1å6q®>¡ˆ¦Aã «—:¯Y78óµòòþ"¾5¬¼q0PÕH2?¶\±ò$7hGŸGöõ{¿"ÆÙ0¹ö4 E^ßÅßðQ?¦m„E`ÝXÚ"•Š3—Z-|™„&á2§ß,Q7Xk~K.G}°ñQò]H ù=Õ:Wão‘·¹@»¯žŒÑáA?ÊcàE8ë#ƒÞ¡ WH*øÔžI¿ßƒúvQï®àH £ÑòShí«œê!ñrUØiŒ‘Ø?.±¥«‘-jHÐé ÈH¬›$l%JIFÄkOKë/骼tÉ ñY‚îiæ«aty(aDÁûш´,êQH"ë³wùÊö`Y•£xçœãcÉx©•f‡ ÿrõ»ôåÙ&›€ê©#…   ƒT¡VŒ»˜©$¿Ñ¥k9 3íÆ(A^®°s>v%D>Œ’kz¬«34pì­` fŸ¹‰M­•I+BGãN‡ »“ÀQñ™ß]ó‚âùÆü¡ªÇiétyppŽù'ê±Ü p~!¬W‘Œ—t4³ë^R«Š†Ög‹ž"ˆÚS­Ò çW_i}A[¯IürÍŒ8ó¹¤mUÁ%èâ³ —y2#Ý´Œ”PïL—TxQÌÿñ-âçÜýê±T|͹þ7ªd£ùqP"Š«â`‰Í½çتC3e¼Ü[b€9\m¾A‰ã˜îŠ÷þ¨hd ^™Èa $c:]JV¤£K¡"WØþŒðšŒ+qg”ezß4KE‹Í@ÎÚ´b¾Ê¸x”NùTU£º‡rÿ8ù‘ºá‰Þõœ°¹“ µŠ­‹ôð›Î.…±q†ëþ]‡ Ñ;lh•Áê1˜ÇÖ`oC‹ÆT,‡dÅ m@›Q%ÎÏ+2F¥onH¹´cò`#xéXíD5ýr·9rÌ6ˆÖWÊ\eEW¸ùå_Hö9RÒQ9¨µ»´gEŸAÒ‰: \/çJ›ˆ‘­Ì‹WA¦ÃŠ½“úÍÁ‹ߧÚb´ËD¡'X##P춆¸Óòcß°LE±”‰kÙ”l6û–YÂ\Þ–F0 Ïz}Pa”Î÷»¼LfiÈnæþp’•×-3²ƒù0ãÝE¡×å„q.± ¹‰á¸)[\sÝdà0mÇò¤œ+ JIÊ+µ±ÐO)}Ã3¨âïÏ£Zdõ,„Žÿ ¦ø* ^J7Õ锉– }c(ß™(&½³"½Ñªª¢¥‚¡Ûž¬81ä<ͨNØÀWô î¾1DENN"¼=$0(Öªb%lô2 ¾V$ˆzNTIÂò¼Á7íÉ^7uÒœ+ëÊmpÊWz%¬ÍkK]Â/þe6jÂMÖ¯•Qc%ÑWh”[ÖÒÜ”“÷Nwã%”ˆ+±èå]‡Ž­@ÿ™eKZJ±[Ÿ‰k1¾ ûVº™È<úþšà`ƒâÑ\Λ _‘Íä"êT2|…-ÏušÀ* çÁ¨<&Šíc¿‡ÞÖl^O±¢9Pl´P N+шó§µÝ SÉiÇÈ3ûúC¢Á©ùÏü¨{,$È2“!踲 jT;Y`(ï±AšÒÈ$NÜ -îûÅÇ£ˆàƒÜ…¬ÀSÏ*ÐåTßÖê÷|”Ð"ÜZôª4ù’&×Ö®ÄNÕø`1D®”gúK×ð@á=€ÇŸg÷Ye¤…¶±öu’'Hyå¹ÆYædI ŽyŒÒê"0±)áqáXSnÆ)+U¶wPìšV£yÍv‘0¯Ý‰çN-4§¢ý•1:gÈOÅEåÖ#Û:yêö ñ_,Ë‚b¶x°áF@»Â‘1‡Ç4÷§€S œ+`Vîþ@o0‚*n¾›p¨¾€ø¬@2l\Ýž.¢+ݳû--0B>ÄØAoESö؃-õ­\¶ðþ™*™ZÞŸ4µ¡"\Ïqçø,8d†lÚµ“~‚Ý´È Oä7€Œ\K¬v#, úñrgá °'e_ìvÞnuÈã¹[†øD: æn ¾ÀI¬²íûXïÕmß»»§-ߢ#WÀ( <†”NRS2O‘T¡ ,ZM8Œ4Ž:Ò«Žfc¥‚ó#¤£š¦xã;êSæ;oبc!j©¸,y FoÛd(i­®;e8ò¾7kPª'µ®ü5a3ïj·\±iPÏ›f‘Ä„«‰y´°ÞPãçqpÄ;!B ÛËÛ|~Àõ€¢r‡f¦FÑ×€”ÇÊËdgCÊnX6ŸøoKuš'0c}¦–;nŒ“”[SR»>ëÕt°J°:M¦¤‡¦¶={F~UbŸ¦å—ÈM“Cœ£™¬Ú*TÄYm J™ßÕÍ¡M¼¼A9N¥õ•&ˆë2}œˆcxsÂqjxÔK4¼ðÔ_OØ/ˆ_ìùll9ªå‹{Ú̾u%ùŒÈ|ïy®:37i¯‘#·‹zø’§:á:"#ÏC6Eóf•ü~DŸ˜¦J£„‘ÁãÚ»K£'ñ¬Rjл ׎ ÖP}Ü!Œš 0“Õ‹°JB¤I„,†œ±lí÷SÙçzÇò–Žéë9>—¬=Ëä_ª;„†mb úïf;%ÖÊ@’ VÔyXºs|uÕt^ÁŒTxÇ‘J:1¯– Zï~~7”†OsÚo—ìaŽ›Ù†$÷R=–³üÿ…é@4ƒ¡È~/ò}O8R1$o¦\á„Zö@° Z.zñŽÚâ%É’¾}kŒè*…¯•Á–±ZøÀïÁvÊÀ­I.¼úæz¡Ùåñ qQíÐĶW û³ò4'MæP¤wzÈ®-÷Wª.›KÉT³Ÿ¢+ËÇš]^5Ï’&ë¨=п›³(äÆiGL#fJ£èÁ<qPúSËu=„é73¡^wN£áØéP>Å”Úi‰^Ì) {iE¦…;›ÄQÁ‘µR+; /º¾¶û¼À}¼hNȦmú"Ñ/ê:eäÁ2Á¢­—Ø3tÕ´ÆnÐ~Χ_¿ CzìSÀV?IŸº©=è3˯?ÑÒÆs+W éåëP_¶\u”sié&›¦OÎÙNço(ÏèSº†sâÊEdV,ˆ‡áfã_²Uðaú î*‡0á~B«iyv­jøúÒ*Ï5צåçÝó¢z¯&jéç €si$ùð‹o<Ãù1ô­a{Iv7¸—Æ¥¢$ !;ÀO‰kb'Mn`QhŠwÐß~?0÷N*z¹µj7ÞïtâÚC Õ»Ë:žÂ/BEÇGéY×G©ýf¼ â5‚¹'*­µçù­ Ûöfëêƒ@K‡›|Jî)Æâ6‰Äz¯ ëÝÔÆñ{e ©ú~nšÜ¡‹|uÛÉÂà'Óö×J•XV&ž–+áUÌŒ³ºç"Ö`‚ò›žäßÆ@UδÖa²¡ì«DVÕÄOâ¾}зiS^²[ƒ`+‚C>oÑÞ­â•ôÞë8™ôÊg”Ô¢¸‡> <{¶k ¢mï o»Ëž0¦¼÷.¥º`ÐÃè•æé’¡Ê>0 ‹YZshapes/data/protein.rda0000644000176200001440000003540415076647713014644 0ustar liggesusersý7zXZi"Þ6!ÏXÌà¼Ð:Æ])TW"änRÊŸ’ÙTªµ&²†‹KQR”èiʶQÞíD…¾Ýjý¬Z’µ²è<Ư/ÒôŽ±JŒNΤ¼&Ñ/Â¥ofŸØÝ7ÐJb»êÛe´4^‡Ù!V-Ï"•…±C ÂR—3xõ~ÜI*<ÁÞÅ•ÁM©3×xþ£L±Õ@hÉÈù Cµ’cèhŽ ÇÎ3à5ô'QnýÊô÷?Ð×–ú°Ö‹ÎP÷´ô_ÀRŠ'l}C ›d>\©dÚ¢ÊËj®’•cWà¡Ú¿Yào7>c Y4H)°9AíUºÊÆõííè•"Zþ ¯øSŠHÝûuö/f2ÿÔËCBžs|®ÁÆئдƒå(pz?;Ám†1?1–70&\£×2ikÂ>e_c²/ô«ièZ¡bÙ„ ÛR¦±jJ~‹Þ:tkÑvýQjáW󄼌¢MåÈíÎ‹Ô l­òfºÔR褽êer˜&fŽ:7°µ;7˜v²ðÊ›]÷6(a–î˜A¸„¶nvEÐn„AËáàV@d•glv |C#•@ıïFôQº·™DºzN¿µ+ÿ£ºÊ‰ž‘™ÃÃ;ý¢Ü‘Øþ9l³ÀÒ›HóR U‹鉛ÅåŒé½ùÒ×,”Þ¿ùû߆,3‹ÅÈû#ÄûÏØ›@¼›?)¹¼ KD°q„L6‰”×tý”Ñ"ãÐpìHFkl}>–@1Cÿc#x¢T°ÛF"'_m ï]c­/’è‰úZªòÁQ¨–G$%òÔ s)§ÃZ¿68·oêínlÂÓ¼5ýñKd0ñ@£þF¿ÝÔnO>ûrÿ†Ò¨ò1†yÏïÕůäl±é€ú³WWÍ ¿,*0µz^pš_%0"â=uøø½ùIé:j`2»=JW“Ö'•5ƒ™îäèiHJê Ð†Úþu Ø©ÝÕŠEgw Ä‡JzÇáÎYÇ6KJÀs}Q<–|">UïEÿáöRëÆYæè½Qrépwõwuç‡à¡ÒLäTøS7®›×=ªI¼æ4oñ¡bµ$iÜPægb_AvÚ:™Ñj}¸úãeƒ‰!;îm˜­9HäsTpH\W§¿îD77í¹NK#˜ä ØIþ×îvÅr‚œ7~Ñœll7.H}(µ¾½Dùrn©%­d^óÚ’j(ž>8É4V|Ñ€Ï~èÜ;jØ~Þ:zGß³àyÔøç4‚WWÑM«·Øg‚~Ì¥‡ý"ÆßQœÿaµ+ÕE³¦¨÷­ü_ç^Ž®55P¼½sž’T}{µr-¼¾¿_”„ x€ë“XZåÜsï¼ Æ Ð"ˆ¶ˆ÷RïÑÙwj{~á*,ÿb{óØ{~o›fó›ƒ]áÛ–IüáÅ!åÝÓé)p›Ãô6du7ô›3y ókBFâù°Ò’”qËç8ÊÎk¯îÀž*aäE•´¯¡0únÒa¬h‰^íLjK³E‹EG`[lâ (8‹C|­³'ËU~¨>cî_ ‚aChf²ñK8k]Ýd¹¹”žs\´æ0ï/²ZcõÓxåh„ñ×̯å·w»õ_,D3úF‰ðÞË+=&~~×Ëeù(·Ýç3^¬™†Ì±!Û¨kÀ’Þæs¼„^ë_Ã&ÄñâEx좠ùá«óšPûÿp©ÊT¹pBTl'Q×ÁK®&Í3CGPZ#}(ùbØQÈßAŠOIÇëgè0jï>W'j5topôx*"Æñ;†©³Vö%Î,'ˆŠ+²„X«ŠìEd¸„e'.„#zþ™M‰ûÅR8tƒ–Ü+Ðë°ÖR¿67DMä{`;Æ3˜lx_»ÏJ‡Ô[ôñòl‚ŽŸ‹þB'›K´1¦P-ë¡ÁRóZ` ÞN05€À¼Æ“}¯Rtåóئ]¯JJeA¦šM©qz×ÞcøÆ|²¹8¹–M6E]Aw†Ø³ Ÿ¾ÏÍY®7¨n> såçŸûêìö"èwá¼Ó<}‚¯¥å½}ðÊdZ}aHlÒN¨‘鵦_™š³ ûô åÎB݇Z3e™×>ÀŠ~˃+ ŽQÌ®FfZQåùÇÂ;ï?šÈ €°£×ÂÍ${–7åÈ¡Ñ ‘IjõšPpdÓ¢qfBÜÇõb.ØHgÚ".dá«{°H'´å:dÒ+3ï”´/³=ñ’Å\£±UÐcnðõ‹[õše#Q=ñxM5Ïþ× D(cvÎ ÷«¸!@®­Q)Kðeüðcw–HÞŠÅèÁ²3u–¥³ [üœæ?My’R-©.û¦‘7=¥?ÝÆå>‡«ðÎ’‹kbjMÒHÛ÷þÈ›Ž0ü¿‚'Ú–+½Wï1¼Ž³= ê]·ŸMá<Ñ3wñÕK¥®ì³Õjè‘l´ÅV 0„Ÿaáå@™3J³^‘+œûjWöŽV›¯ 6°îsöa(\5F­Tk¹Bõ°DXV7î¤l«Š*ú ðL•Õ<ÿÏp)Ф½£ q¹´m“DÊÕÁ×KY•Â·#ßñÀN0ÀðÜ0Aµ)E_"ñYÁdôvÞÎ&‚”@S`xtŒgNR$ !×"­kÆ0á,2 $–{W‹!~샵Œçv¿Ïblo0à_aáRÄW¨1t[@Ò#àxцXžšôéž[JÂ)Ññ°ƒÒ°SÍ﨓5õ1úoÝEÁ™œzÎ!?(Ë8‘ÊL?Áb %“re2ú$u4Ä¿/à‚·®ßWkå Ï€aɃ2',û;9k´Ô}˜¢¡£K ¼Lÿ)ìáÒÊi²Ò0í PŸf-Þ¸Jåþe3Zü¬ѧvz^òcÔV„ׂÝðY÷M`›žË!Ìu ŠÚ÷sŠ£ XH˜Ùªœw=ã&ÇFÒ ï<œÿPYïuò…y—h{a¡ÁW m6¥æ¡ž¬B`ßÿ8?†34o›}d©:U"³ÔÉò=1˜?ÌÜ? ;®W øG‹h/”_ Ó(µ}¾U»š/B?4x‰òûý×·_®I‡]R–Fâ*À¡ˆXðT£ù08Pß¾¹ÆÎòžÿ-ôM(?pþ+Œ¹»êO¸87jÔ$ +¾Ð!ÿ¶¹¥Î/ àÄÔkú)ôhà*€ÁÊmÅ»bÌÂïò½E˜&Œ¿4.܈cm²+µT¸;¬òÂ5Ëù ºKk›;ŸeFèoÔÅíøûjnA%uœ ô½™­¦åõ}ò*É­•È¥t¾“ÉÞ&x\Û+ñGÙqò#*ÜŠ`œ"¤mTˆ‡ôLRÎÀã:bùºë’¸¬Á´¦pÔZØ¡&‘›pÞk,Pˆ‘ ½(îVÞnh 0ëæÈN§¼Þf¤Æðå)¸\ᑬ4|çà¡ÍH!æcyý/ªÑ_®xl$'Êñë6š}î,¤d˜Azùoæo)ÊeþÐïõ^¬*h¨W)Üý8ÚË j"a¬‚ëN/G9v¾<ú§Ö€ÑY†§ÖSÐ Šz0¦#¬NÀ-µÓà(¼Rˆt«j’¢ÒË\àŸ®½‘§Î³ƒ"Õ¡¢¼¾&l[ËþŒgÞ*=Uáîúý˜´$t‰£ùªPz·Bq–Ð>òžk¦Eó¶„ô+ôçU'QH{ÀnörCyš¦sõ0nÛ r@”w+.Ÿ¬ÓšŒ£Ý2:ãü@¬5Ôg£¯õûÁ¤^ݶÔK_0 C»Joç×EšýÅžkLëD!õ›*€"–ž¨/8ç2-2dOE·è8!‹úow A¨.3?/t’/—ª*« ©B»µôœùd¦£?Çž §´L%v —qp创Óq?xìð!6‰ôŸÎƒ­õø&X­1öþ>µcÖñ%v€ÕÈi§ÁŽkm¹s¡+Á0Ó-B<>Cš5cn`¢wÑå"m¹JÜ£VñÙ¾Ðqa„†?°Ã‡ïùÑudÐLq©,ª ø ̺)”yÿ!Åç|εj³«k~ääIÿR}O“–åž´Šm8Lö?Z9ûȺ#¥¥ó¾HKÉ0nZú7‘9zýº ´ @˜šµÕ5XaÈ¥ðÚ=RÖ`É[,A…Ž&UØmaë˜&ssÔ×ÌÄ1IÏ%ºlI2ÈLP¨XÎ µ¶ÿ‹GO1˜ˆ—Žº3?÷ÓLPÆD]–ÔW*@Zýß{ÂÒ¤GaÁ]nÓÂ\‰ÓÀ^çç ^ ÝÔn²lÙ]áC¨X¯Ô‹Á8æ£ü¯/ Æ2û{çh캻Põ ÉÊöí-ü- ìoů²òÇá&×)ä² U¦¯Ùí8’Ï´‚ÝØ$„)x6r[ò–}û˜¿nÓ|òÂ+Ô_îˆZê/ß;ô¼bˆT;íc#Ý‚*sÆAÁNq& ôæ,ο՛fy[¦ç* /¿•8òQóÚIo/P UýFÅa–Ô¡ñÂ)8µ× ƒÑ"øèP€¢¸&I¨ W}xPë¡ ™F²#{:é_ÎK¯ÿZ)I#tò<{?@¦KÀïO2Ä AÔR­à¿Æ cXl­õ໸əÉI¼ª– TgÑ ¹¶­}ŒJÑZ0Š“¯BŒÖj¯Ö7“ÊŒœ³wÀ¿èÔ§%¦j»•úÖÒ“—\ Æõ؇¾ÅeE(Ê"K9Ðïæ*ÿûdŸ7Õ£¬ªñ–“y!¤90kD_)E§a­\æ=Aw#$O<åÑŠã6þ¦tˆ’ ‹€0ª êd|–‰™ÿ7 /ªÉÖú!«·È$ 2¢ßξH‰³uì(šÈ•?&Lt½;z/Qu'Íš˜¯ç%íßùzÁ¾%›lË”¢±j9™CÈÓ¤)äPmÙmšã3FZ*³œiÃﮂ:7aÍ«R—³&æê×/»ZƒÎd飳ԲRN!uÕqw”F¥<9”Ö3àcFöŸÓ`€Óƒbøý³»ÓUÓ,Z+¿íª¬9ý¹Íï¾–i‰f‚.@Uï‰XʆN²ãߧ‹n¤!ŸNy•xë7…djZï…i£9_dX¸Ìc¹{´’2ßÈÜ@¶£Å$ñ§‹,«ö¥5õwSg%¾œ´—¤¦Þ¤ÞƱ>LÌÛº/a‚ÿ…p):Iy¬ëóÜç˜Ê¹ûp¬#„Æ78PT³³ƒ€¾»>ÿŸÁ˵àÜNQ>NTQ˜¡ë7ì¼Ê4[º*ùåTW|£ÕžJ*¾h ÿxݱUé¬ï"M,·±Áõ·¤ƒN³ºf·eØ:X÷y_cþô>yjG/¶ªæmøV¯Ã/ÔïDUv©yvN¯åÌÊÏ/Éug‹o©~ü‘! õâÎÉÏÐ9ís<íå¨J+9*Ñ Tf•Î"Ö}€ƒá8¼Tt-øE¯*- o’A‹îqUýP’GÌ_‹Þ#§ˆeÏ2ÛÓÐMv"µ {¬ù›ÎA­UÓð`Rç5ꡲ;ôô 82˼¤výwÆ;6ùN¾ð¹:ÃŒ ÂßJÏÅrØ eyY”Þ ‡-±íæòlØPÀ>ñÌðÍ5¿Ñaiî‡L#bµ/ÀƒÌÈTy(ÅÚ*¨˜*삃٠æcˆÉKBâ  Ÿ&€Ò<þ‘6œÎÙS óBìdí œ|÷âeÔv@ݬX¿þÕ\‚˜iea^eë¡ -„1âÞY¤¾YŸc—Êˈ’Z¨J&55bþr É%VuÎj÷Î|b•Ç¿ÑðÒOÐUÁÆ(ËÂÀµÍtv dð¥ Iãet™3 þ³qNÊ5níàÔ>£ÒP»ûľL“Éù “Ø æÝ»Åé­Ãº.Án­Ü¿•p)Ebk• Æâl axØùNÜ·‚ð¼f}º| ¬€øý¶SûŠXU»œ¢ô-ZýX0F´@^Û}<¦îÉâ„äÀ|ø>0øƒý‡9 _Nª?‡„Oqsøñª®ÀLº=}‘SŸû”q×Ù@JUzµÌÇfÆ[Y‚îen­ê§ l\ÉHå “"ÂBêt`1(—ŽM°Ä£ÙêÝ*²Žî#½ŒYX>2o ¥‚!Éõ¸åP^¯j5ÉEŠRè6fV@¢OøO’`ß·™‚{„%dk«’ð úWD©…S‘F؃dXâ|ìã4±ûŠ±bÒÁÖÝÆ;IpÍé%.¸7¬ôýq·$¤Ÿ¢%S¯þ?¬ûË6ȸ­%Jã’2°¶³ñÛÔa;î³@ÝÂB“/n!ä¤ )I™ž/Q¯Hød3]ÿúпE¬tØ·\ü’—7í ÕG!–­Y×gºÁóš%·˜.þ¶ ïá´‡Ì3ÙäÄÀ¦¾x$ê¿nRÛ:h$pä¢fï «ŒiEƒ0VtèñÙë!F™ó, {ž¸@y³‹ž A¸[ѹ|ký;¸­ÓlÐv´0Ÿª ’:´I˜;aóÜô8U/¥$PÙϬï¶ÀnÀßk%$«¡í02! í)ÙÙrrï*é4ÿ§V)2gt[»´„óÂÕZ€(ú;KLaÔƒÄ_¢ fü˜}T²LȾÖ!ÉË–,hƨM0'S– ×ÍðÎkøÃê¶×Í«]ûì2ÄRh8ÛLsxí{ŠŒÑÖb éÂÂΰÁŽ^CÓŸ'ÍZ?²Oº··6øÅHÀcNÝËô–”YC@höÍÝk€Ûפ)„ä[Í–p†ÎT)t²­í{\ÕYýž²¾µ‡²ª]»ãižSW¹ìP𮽧–ÿWYW>™"8ÆI5¯2uÿDåv§,nÐ<>¡ut5<ª=—2ž;±ÞJ7éQ Ôk>£€Uù¥à’lâ’t _^N[ lÔ*#± ‚—õŽ#Ѹ‚,WðÊÛÁ%‘=5ê: ©y3RÜ®q­Ó™Ÿ–c®o°PC©ØyÇËY0Æ40~%„0ó±±Í×Y´q†¢Ì¼¦G¤ˆÝ¯¼ksÙ×M½ÈÁ¢+‘j:[N§` ‚«†6f¸èŽí'ÔóhÝ'.Q¨ß?S`‘øtm4Ön­ ßê׼ˢƑ‡„œú¬ËH¾þ>=“§›IÉæfoר‰gDB5òÀä° Ä<ŽwgV[³hiÞ±Ez gn¸+†Þ2îúùF“¢€•ÉÑ%›>yZE?ZcâÂ]¨ àt´%Ž’éÊófÇeº&ô33´¤tÛÑt¦Ö:µäè>lÖ…Ošøðtvu.cåAÀ¨9ª‚hC^àÒQà“VÖ™` ζz©?k`ß΢ÌÜÇÂ1ï4<Çí¢ú2WœZñÕ$‘'i‚h™õ˜äOÈð)˜#w'{ùÐa³9F&aĹªª^ç‡&(5õ_aU©ÿQB;`¥§ô å¬×9TY¦F¸Fš1¨Ño,RRó·a•„Z­³ýÙÀé‚ÿØí,˜œ# 4wÁíl·û:*üÿ,[gßé茂¯ßíBÑS׼Ÿ»ÓC9ºC¬gZÔÉòK‰ŒÝÕM“ÔœÑ\–¾¶Äeö¼ÀžyÔøàŒéô’b”ã·…°ev‰ ÓïÍ»±¡‘i› ¡~½j$t–r}ÿ4é ínqþ•2I¼8:ÙÃÄàâ$;I^oÕ–~¥m‘}Ù¿álÒ:¹aHLÿļíšÜ®ÝÒy–l¼+ðüZÛžµFººÙ}·d«ë¢_:{ïf&„ôržéž I9äKÕQ›B¿^¡…‹®¬§·Wî‘îî¹õ¬r}Û}Œxªä!€†bWŠØÏŠŸ^_“4ÑÝ°Å@ôzïÈñ»‰8Bß@¢uV±ÖIÉÿ02Ãýóóíª ’_ø?KGÆÄP4®xz,OZ»sCêpè(â(€$Ú*Â]®VÝj*öG¹ÅŸx$ìhý°»õXÝý6ÖëËþ·¨qÄôFtŸbz. #LÉñìËM<—³Î¢‹cO° \'ÑžDñ!Mô|œ£HÃ4kÞ}¢ÈVž­« Nö ‡î1=G§y²)äwe2£¡SÂúBêô]0qÁ…מ½ •:þåžC©®<ø›üAM{ Ä Ý©_¯Í/òƒ¿«zñžóx¶N%l"7¢íK ðl,séŽ ß>¶JÔQ‹çÇîŽc=ÔøìæáœåY÷­®#}g(5×N¹D>A26'š³ïÒ*uŽŒ¯¬ßG¨ÿ-x[ ûÌˈ­rÏ@ý5’ï®(¥náû—UEõzhžÚé`¼nÔ¹f¾»$ùhg ð‚/ý1¨8pƒÃì–°ÿµÞNqíÔ8AU¢uUkÙ¼ˆ%Å—j¨Ê·‘!…Uz÷Ý1¿âáUÈá‘*÷S»l3¶²‚\¦¼R'=Š›'Ÿ.yó@ ”±¬×ÆÒáã±”¢_$mÀ+“äUäÆŠ´½Êxdt½5ixzÁ˜Ý¸OdQ‚WO±zý”çýM&ÓCÃó×MñR£R‹+°ô z>žD†¬OrXæà6  ®Ë+ø5%ŸCfߊtv"*›œu‚g:±]•  'â|j“¹A:²;b:·Øeþç/Žûr4†M+æR·ùâc==C`T‘¬hA|”¦« ¸äôø¬ãä6Fš;¾úÒÌñ&Sÿ«· =õà}B5’.eË£ÕH6ºŸ4Ûª[Nè]õ«Z#ß]u¡­ Ê$€~¢üö¤]ó£J+V™×ªd}íÈ>nÚ¶_Ofܶ…ÉK:~û(ëB_ö[ü®åÂÈM„Ò|¤‰€/à.á9`ßdÞÈMçzãAi^u¢  ½ó¤³.Wv³l¯nµ)›®Ss¸ Ð°<Ú´Jª÷4ÏÅd‹T©x–kÓŸÔS ’Ü Îî½ü•êÏïwi²êºS+=Y­ê¬6ùÀλ« ´Ø`r­àKÈ8aœeµ€C@Î¥öѪ6¥IÛxrVÙ‰w67Nµs­ª¼Èò‚›ñ‚ý'y…óÛ_´{. Z^%šÁàöWôgâK„ðI=„ø€8NÁî’^S"ùþŸ—R÷õÝ;²¸†Ö`„QFbâW‹Í!©Ä½Q%šX‹,ƒ¿;ã]#w% ŠÖi»èÚTy#H¾œ0ÞeÑýUËHn»(‡£ÿ­q±Ù^L†åý’ÖGV5¶ ((e (H ޳ߙwxjhÌ$BjŽ;€$,R²cG—÷Œº…ü2ílÙ{Û}kž8µ/²ËžšUåP­ºü×Xâ-ú¦4¿”5Óè’_Xñkw»Äyå-l÷ð¨‰(’/ÏLOùÖ(éÎïŸC¤D(qï§j“ë%®Î¾ bÛ E¥e®Ì\ð¥6’¤NWžF¾ X•œ{ÈÕx#Ÿç1¶«Î¢o_^DqFÍHµÇ-iE]ÉÚˆ'yA1ÛàáµÝ®bÚ~_Zt^ Ü,¡!o½VöëÙ.}ĪK1GHøðæÏ—þ{ííÒÊK‰Úë‹C (Þ~mPÏÏ0Эìš/Þ"õ4ÙÑ7˜Ê=¸¢¥:cN'ôÕpå(É%Ïrž#îû“Û¦t gUɃ<\ìºõ$&R—.£7“Tñôñ[P’±Z1w í÷„kŽgf>í6=¦3Ê£sJÃ] …²¹°Ywqd?"ã0¢ÒÆùi)H¡"Ç"ñ9y¹—2µ“X,RÚE :r8l”Ôßì¼|ch󧳟¡ÏDŠ¨®PŒA`Kô»bŒÉµb RIÖêÞGú]Ù*ËG˜7lzöVBX‰§¶ÂA&ÃÑO‹ce¬¦þgÁ&B) ïsïJ98æD'ô+³µfŠÀcÍ›8VÙuø¨N b³Ô=µó¶Ÿ/cé «Ô3yU© å?Ã. VgT¥Ä€téñž7ï¶aüçpôÌg¦”ý‡ ‡kÜõJpÌ`ÍŽM>ƒAÃXÉÝÝ›KqaÌKä¼ó&<¬6 ñ{î@®jV‡êý@øe€Í7éHÐãTXnž[!ŸŽ²ß”[˜ÈI/|åÂÓ ìCžïÞH‚|å§Ò$ñ'¥9ÍŒJ¢M‘Uk4bó¸§ã˜ ‚ï:í©K™O ^íP§Y±pr¼N÷#°}wd$™ðõ±Í›ÊW±‹Ÿƒö®´ÈAT“3¿„êž.òOþÖãÞ_=VEW6¤ºþ‰mÊpÄ1~ éýDJÀÞݽ¨3úgåJÚèl”C–'K0–%¯ÁH&÷P' º˜–,F¥ðb’=´omÍÚanÛÔßnºÊ ÅP¦k}‚¿#˜$ <ó‘¢=58êoý‡íÙ*~=SÂÇŽ…˜¯¬|äj/yÁÜ÷†Ìy DôQƒÏ%>áç¨dxI<uáƒxwð½`š%î\ð&cÁOÔï÷éÓcË‹:6bï<󭯽ù3ç¤Qì?”ˆئßð'Ç&çÇëɺÉÈÿ1‘zz1°¤žn“í]ê-R g-­·›qÌ .XæQŒ‘ Ýóðdb˜LeZjöXùES+w'ÿse»ƒŒK~Í'íDó %ÕìÏ6MÇ ú¡nÄW³¢R¯6à>­H·jD ÷Ðß–lí`*× º^öçÄõr6Í«c·9Ù` Z×ó€Iy/#½}…)öd1 7[/xzNFýÛ16'uâ‹Ëî qÁAå¹·Ô-¬Ä” È¿ò@;>ë ÜìÜ™ùJc_ƒdÄŒF(W@£ÈÛ ÿë.ªxÇr"í0í¦=š©´ï’ÆsC]óðRßÝÿ¡H¥\ñU3çÏ)3Ê®¬Œ­Ó¹+Bƒäáå ö?„L¹a;?áì ÎǧýcöL $ID6IS³ÂG‹Ñ ¼w8§x±ü´ï–H¼èÂ:½¼ÀÊi¶êŒÜß^¹HIÀœbµ"ìÔúxpÕÿ±þ@B¹}®C·Ï!GÿÒÎ+ë%+[+ω¤†Ï¥\Åçi‰ÙÂê{+kÆ#Žå»IxSh¨S§æbá¡oÈSlæÛ"m²°ýÏÊçÝŸ±„þÃÀM†ùEé‰=ÈÄHx`cªÐCQ2Û争^btº†ñ‚q¨,ôò[¬Cƒ£N°¶âü_]@gý•Pq(A]q6 /Ý5¨x‰ÖzÌ2Tég«{ß"ZÒ ô·ûÂcÕí44rn29m[\‚Ú=˜‘’^XYJ/…â=ì–íÙû³Å(ð¸V<ïì*<óŒq…šQéz~‡ä£”–ą̊×+DÓ—„QpÜêOœÑs%"(GžÛG @$ÅÃLñ:õÀ$]@'6\Væ¶òŒ´‚ ý@æ”=æ›-ˆ*’OÛ%Š¬(ב&Y¸D4YiÝðÐ×È>ÀnSt€ea£Ó>Ý*oXÒÄ¥“bÓšs ížš}}LaaF£f©TuA¶øcæè³ÈQ½Àà¥~IC†¿òªsŒþfIžï§òÖŽHÍì•mÈë½Q7¦3‚£µ¿?LP…VÊ·$jšãr¸6™v.§î®w‚rþŸµâ“qÄæ6cŠÄHÒÀ=¦k3ˆ"ñ»tk™Bµ=€ðÁP=rûFDôPþq4)µ Õ‹–TÌj*„Ø E¶qô•©Œ•gãßÎs°ÔæM9VÊ8æž%yvЛë²"5u½£Gº¯P'xõ²uh%Å*|àزõöŽ†õ'MðYv¸²hL˄錠Ñj9Û’¼y˜ÔïVÉõ*ë¢y~p¤A¢ñüZ7›Uio«èw-7é9c«ÖáÞ©5¯ù]A|ðwíŠÅ)•Ÿö!¸‰Úê:#q!Zì?G¥F­1œª@ Ú‚g ?©Í8ùC¦4Fáñë¨&:3ûŸ<“_ý*ò“"cщ=àbp§Qƒ8¯ ՟ʯKE=óØâmm©3«*ïéñg‡Á·©äe\@ƒø÷ÆUÛ}v -¥d,[·7²mßzøÑ¿çc~‡…5Å)E¶{È{<Uq˜çÄ>Á“§¨ÍB²YÐ\£›wés)CŸø0v"V¢ÎžŠ(Í”B]âVÅh(irȘ¥ìcÓ§”2û0<ñÀÉÎ^xØYÀ°y<Ñô ‹ð£OuµSá;ë‘^E»& hÕw§Þ°[¹Ý¿í)•Ôþ@2`³ô ‚BÉG0K›‘U(–0%Û#Øeœ¾Žšß|änqøu«Cé*\Úö³F‹»M.}ö#ÌrU$_Zv¡ä÷É UÊR`.iÖ; ‡ :]Ö£öÖ¢9Ë£³B,gZéÚ-‚ùK.ø'ÀÙR•–FcŠ~·ÙŸœ”5d†ƒó0Þãì€Êû"d½ì¾ØI¶wÇôV`åšÖ ¾#ôóÅ-qù¼Q]̶UC…© •[jÔX7[%0*ZgÒonæÇ Zî¿E\Í6 iÍÖ­xóÙÍrëÿ ÃMR<€™vtí÷­Ø…‰«†xr;²I5®º× 3ùIV>© [ᚣ“1» Û¢Y§&‹~·6™ÔæB“…çä~ø±4ñCø‰çËKs–Q1Ê^–ayìÿ”üT³[õ9 5/ŽpD¬ ð"ÂâdíÆÅnŸ~Áâc%yVÌ”6]æž•šœ¢‚ .E§$Æ¡‘t£$Ñ•=?ò†B {Z¢¢þÜÞgÞÏPZcð,@¤ÙŠx‡ÏÛAaÜy é½_çM]EËç+õÁ¸Döc+K[VXyDSM¢o¯-'ËçÏò¡Ë͇B¶’«ø™˜q» d!âŸ;ô‡ÑíÏï>ÖIqǽö”N8ÐßȻЬZ•ç%8ÅQÆ…ëhh2uL÷«ØW©»·êh%ë؇؆ÿ3th?‡0"x»Z +²s™í3m¸SB<2Žyˆ ënŒøŒØîC¿ö•£ÜŠÀ<¿P}m¹?µ¾›Ä.BñS-ƒjY±þæ*$C© eì%p ïƒj¢Y¾|ýªžÕ(<x\°ù²:å¥>‘ð•_:â±à3’pÔa:WK`’AoŒªîŽâ¨Ò¦O|ÑÀô>´¤Æ¼7´ÎIe£&NH_¹W럔@C6.àæã ( û`Ñ>ëÈå|ŠWªâ”ý®¿ã Ůұâ‡À0—\móœ£Ê("hHÙÜŸí·ÎšZM¦•MªËÍï} NT6]Pæ„8òÊP%ÕenŠöë†båGüçSœdÎÛµ‚twµçElÍCñ¸]!LÉI}jåâ±%6^âÃYŠSt}wk¸µŸ|Ç8w;eî¡©NmÚølUJ0æažÈ¶™Æ ATѼ¦d;6 ³0žÏŽ¿zÉ…‹kÇ–´rr3ã_ ãE«õv¦¬ÇdÉ}€eaŽ=u•ùÏfÚØ×ÃüàØ’=丂i(i“4Dr„¡É ÇàÅJÝ1Þÿ¦¶VT÷œLM(ü¬MâoÖÌ~&)C¼˜ÌÆ0tÒå]C§©`¡‹:¦ø¸êÊG[”Ò,vO†P>‹Ès1»tŠÆËsÔqwÏ#Árˆ¥5©ã€ö—{‘ „*1?P ½R‰¶×ö2¤:}årt'÷± H`Ô ]Ç9¢-+c³Õ,Y¦TñA¶êBöã·À~àtêrYÝ^S?‡µúØOD÷;Äÿv+cîá©D¾≨Æj¹îÀè ÷$g¼»uÙ~FÈVS üêˆÝ‡9 Éôþ–Ê7 ëÑ®lœøj2/›Z²‚{c iufè®d|¼«ˆyý/ÖëÄÄø{ý(½“ÇŸeñeËa-Gë¤6ÎWç*‚"#ìà^ˆÇȯyîA_ ^Pþ2­°Ç@Urï*mié4Çb 6º¤b9€§ \–à<› ê?ׄÂφm£ô‚ÐÇf×@ÂìµÖc£^ˆ©ø¤3ˆ/ v3 £¿`+©£Æ#Žµ”~Ûf+e¼euÌ·9¾1 AÓäûoª@öüÑÔÚüŸÓ´êHƒ^ãZ™ŽÍJÔÞ*ÎDI´|âãè÷–ÔrÂÊp"±Üª<m !±§„øEéI5+‚É(âéìPÖ’à¯ícšãö€NÊØ/9g¹…×¼˜õ´e_r~ŠëÏ |)ïJÒgÞÊ™Rbwå§ÂÊ¿7Û¿2”سO÷ÙML íª©\¸¸4èþ¬ze” ¦Tœè"‚qCŠ§q&5ªì’ªùóHªù6 ºI,Þ­òFÅh«ÂÁÌÿ'Óî}ÊGhÙar–Ã"!þêÿûzé¾Ù¾v>*itgé|®(jØž£x¡Yöçìý˜køë0ïÒnäPg“ׯì›vj´ƒšæ²¼<ïÞ©ÐÞꛪ‘l<§õ2/Bý~¾Òp[å¾ÝN, òhbnX˜~† Ò‹iØLø?[³(` v-ÞÆØôƒP?ÈA-çËô®."gcÉ—ã¬:¬mµ£n#@í~ý·8ª¬;ÆZe‹²×'8HÝ¢å—ïß”³ºb“Öi›×ƒ—O¯BÓبUÓ VÐ^0ú>¬ Ã?ncïÈY=˜Ò #0”ž,¹AÀñÐ O NH¥Â@>d;ß×g>)«¼J&¼Ôd)ØŽåà”>%ù²L3n"™7±}£ÃêCSÕ¨l»®ø‰–ÁøL½?@øÇ”®ç…QEüWw»g‹ìÜP€vU#E~(ŠRM!dhæçd’Çx¢º8’ÂŽæFsUC`é˜úuä;¬{?¬ g»L,&ãoÉvéEÂH•[»“ØœaÁCJ÷I¦­Ð¸@qM ['k9¸Q7êð¦Zsïhñæðr+nù½¢BÆCþf+¦H »$j2mÀÍZÛ‰žbå΀{ïßú«ÓS,¨tŽhÕR=´²1[— „mrž÷¨ôE.íË1Çe¡ A¸\.Q(Àhbø›Ýh'¯Ñ©Æ0z¹èíýèülÚû#€D¤&e‚À?ç©7ÝJÿpš4Þ×›#Z}y‚Ñë¥U}ŽqÖ_–&iÓ71×Y¼²~›×~ÒçúÈ<þE©DPÁ•¸ÂK^ ò›^iüÊ·)Vp'Œ ê{œÁS²Ð<ÄPdŠ –Äß~ྈ!ñ®öT#¾"ë¶7#A,qå«{²›~—)dEôYxF 8ë@p̆•'¾z_»y>¹âÝ'ýÛ¸ETztî;³ú¢T?Ë´Š½ „+ .8wŠËò¯œÔ|Ä^þë­åp¯§/ _«>èÙ™=ÿ7ûÔ(M[ÕdŸi’+Òü#ØÕFª ÔܘìÌö43ç2™Çÿ'›IðUTÄã¦H¨£B%5Êh'™lô T¬‰bÄŽ-§ööžoünP›õ“þ®w&%‹D—@yº•·>öSGðŒL[¤<'9MDþ5~jà—ÓÔÂ9]ð)rxµ{=º@Â-‡Îq0‹ã´wNº¯#0ût°å¥ð;sö;$P…BÎÚ%>’]ÔZجPï+&¨š*eä,1ÙƇ`hM–’sý‘t¦Fm@“o'¿dÛ#DMN³¸õ†X‰âúÐéä#‰n·7’N|y֜ȀŠc=û¾¬ê|Jˆr×Iãq÷wÙ~t A{©Èµ|¥A—†ÛÕt¸ÚÏ5ñÆœ‹œHêJ¢Žâ¨P™(rú±Ïè<žtðºØ§@pb’éÊ`ÜüèÁ—ÆÕºÆÑ”ãéÀÏKB§UGӳζd•wƽl1sŠÆR¢¾)Û\òòÐ=íÿIÒûÑžëžG³ê‹x9½l”äh•3ù%뉉ŠµÚüª¤)£Âhl NtnýZ³5nxna#XêoZ¤÷!r50ÊÝR\HA¨{‰ÄfÉÔYwŸ|*}²Ü5xÂ0^ŽÚŸæ€N8¤ÿŽ£T<T Ó¥JÀ’p·áÉ.`% XÑ/;ÊÐ’‹qGo€óhø“PÁ%'¾P.t2¯ THi%üáÀðWóç qnNtû~Ú¾zÎP aó\:`Œ²¤rÀWë•@¬SA`|Ízn`9ë^ëˆ*dÄÃbK'DtdaþªK_\@/Q.ÿq‰¡‚âÉz±à œüºïõ¸? cͨ‚«“YÉýüŠÖ¶{ˆ}>óf­€áÆÖ!4³~·³ãÅÓ•¿AhIØ^–Œ'è,;èô·SÂ@˜ÐR˜‡»4%êMãœ8Ïã±­OÊ2n”ÔPÅÐѹ¦ltþ1Ï“™Qä Ãy”øTa2ôH|:rGÐ ÙÑð“Åyð↴ºt5~pÁ¢K–j¡Ì©|çùíKb´(8[¹N+ ¸OÕ(Ëbx(4´/‘íl¤ áùE/%¼zÉY ÍÔúw…/{I»mk °9x6üÁ¼9A=³´Ïا{ðÏRËZý=ià Í_d†³âŒG (¡…-ó1ÉkœCø "ú3æ,\*dF Nÿ7Ù„j¼Tv=ž­3¬à’X„]³áºÑº1ž1Ý}¼P¶±‘-çú¯bpr„~YÈ‚òŠVÜc2j!Ǹ°¡­‰èe$á"®E'O ä,ð·8i?é×P5­ £sýˆ×ª…|ç’ö YÉÔn|~œ_ˆ¥+œ‹™9ï¼ VkÍû€Öz­¯K‚îÓE\S Hà¥Pm¿(J§¢–X§ã9ÒÝ•6°¯o`Ñ7Ã`ÅS\Åb£ÉÒß‚ñ™´eÄ9ì.èñ~*Pã&Ö2ƒ ÿb›-`7!:•’¾ pÉû-EUSQ[oa_SØyÝ„-³ŠAœúÓ,R —zþ%«’âÂŽqP¸ïsR+iðzž—¹þkùF÷‚nƒc£ÞuÑù2˜Ì>0 ‹YZshapes/data/pongof.dat.rda0000644000176200001440000000117115076647713015215 0ustar liggesusersBZh91AY&SY`0åÚ(ÕüstTUUÿÿÿÿóÿ£Ä@@@@@q8w#sOMDŸ¤ôš4Éêj~§¤ žSÔÈÆ=&4FA¦DR @dÐC#CÔh 5R€ÐÓ@ •=4D`4'¨Ó4Á10€20h€Ñö×±LeÝwºh„ ÇQ"¤H‚—è*r”i” NIC©A4$nr%’$•nÝPnÕÙ”7vë»×Ñß–×ç¥!ÎÇ.9£”è‘UÉxp„ %=¸Ç‡"á›JÍ–‰ƒMY‘rvßÏíZ”ÎvGC‡¨zÔ_mZ½Øø¾Æ ¨¤ •™TîŠr[·T¹ƒbÝšð Šì×k«×z½µudW.þøÎ!6ùh‚¼Ñæ夀4™¿åDE½|¢ %誰•Ã¤ˆŒˆ B"­"ÐŽ4 X©þ…Šš*M2P;sßµÝaY…D-@ŒÄPb0Dk|U¥ß\­L°÷Û©gR¶å4¸¢…i`°õ"šö—H Q>ï ¬édìð•S;¡$BD* €™E‘'d°D‹J P€ ¢ÄX¢*ňÁAUˆƒb1`Æ,F(,PQQPP)I0†(»B×âˆÜr2¥º€$Tìà_¿bùmÝJÌOY\F4}óu}C„G;×=ËT.‘4M´õ1Y˜‚ÒmÄáÄݶwQB¨Wó}92ýƒJ âçPnqÀ‹ÐAdÍHTA€® PU¦ Š,Æ©JÙ®‹¹"œ(H0ríshapes/data/digit3.dat.rda0000644000176200001440000000141115076647713015105 0ustar liggesusersBZh91AY&SY'¯¡ Äü7DEUUÿÿ€@$¢@@@P ^pRìO&€(ô©ú)½SÙSjhõÔôЉ&€š¡ “ÕR¦€ÐLA€4a¡ 4‰*žš†!£C&@ zŸ°È¼6Ó˜ò"ÔÅuÕ”¹½Ò`ýÁìq„¶&æýÞ©¸¸ì1‹5uš’;Z TªÀBð0u ‚õgwÏ2¤ø@úÆEt:4ml› Ž8Ñm/ ˆŒi†¤…Ò¤|'ŸoB=´ZÕÐ'‹Í.dNíq‘^øºV̦xÏ R!<È3«g 9…_[Wˆas”¦>ñÍÓ¦BÐá*‚/Œ§Š¦,±# ˜½˜“zÞ01P£Éà$ aLˆo‘NlV} (Ô(ÕÔAVGä± ~P©­™¾(ѹÔËmÄ4Ûm‹¡BÕKb2kãPÉ+¦´T“¢Ë'‹d\ˆ—¨Yƒˆ›BcÍ2“Àï• %š&Áò’fb,óÒÜ¥…ôÍÄT‡sï”ÖØ­¸$ ÕÈCô,K³bMÒ©˜ª²ƒ! B°6² U³M¡‹<&÷hˆñA˜ròqbõÎEÊ¥„‚¡žÁýõ'Ñ`×õñ×sMÏ¿¬ú¯=9&VE³xcÁíË“¼îMT Vªó•_–ëºÐPþŠ§ÄMqP„¶{dAjÚán&¹¼ür®gȃÇš‰ÊE6le–š‘ ¥eþ«‰©ice EiÑZã[—pÁYYmš„U5M³i­5˜µ*›SiAˆ+€Å „ÚZjæVÚ®QX5k0µ†$ä«’Í–i©¦Ù–i¶+ ŸuH†î<¿ºv7®°º®8 30. Added an option to pns and pnss3d to choose the mean.type. Previously was Frechet and now can be Fisher if desired. ## Fixes Fixed a bug in the plot of the PNS mean in the function pns Included more (1000) values to search for Frechet mean at last stage, rather than just n (which may be small). Hence this is more accurate. # shapes 1.2.7 ## Features * New backfit function for backfitting from PNSS or PCA scores * Added tangentcoords option to shapes.cva and output all the CV scores (rather than just 3) * Improved the 3d sphere plot for pns() * speed up pnss3d when n < km-m(m-1)/2-m ## Fixes * changed rgl.open to open3d and rgl.bg to bg3d # shapes 1.2.6 ## Features Added in pnss3d and plot3darcs for displaying the PNSS modes of variation # shapes 1.2.5 ## Features Faster versions of some functions kindly supplied by Gregorio Quintana-Orti and Amelia Simo, University Jaume I, Spain. ## Fixes Corrected bug in estcov for method="Power" when exit occurred in some zero eigenvalue cases, by including abs(eigenvalue) # shapes 1.2.4 Added Principal Nested Spheres (pns) Added Principal Nested Shape Spaces using PCA (pns4pc) Updated some references in help files # shapes 1.2.3 Minor adjustment to Penalized Euclidean Distance regression function, including a different name ped() # shapes 1.2.2 Added in a function to carry out Penalized Euclidean Distance regression, which is a sparse regression method (Vasiliu et al., 2017, arxiv). Renamed the function sigma() to sigmacov() prevent a warning that the same function name is used in the `stats' package. # shapes 1.2.1 corrected a bug in the calculation of principal warp eigenvectors in the function shaperw, which in turn is used by procGPA (thanks to Paolo Piras) # shapes 1.2.0 corrected an error in apes$x[,,60] data, which should have been the same as panf.dat[,,1] (thanks to Katie Severn) # shapes 1.1-13 Corrected a bug in shaperw for the m=3 case (transposes needed) (thanks to Valerio Varano and Paulo Piras) internal expression of bendingenergy (benergy in TPSgrid) has correct constant now. (thanks to Valerio Varano) # shapes 1.1-12 procdist - function added to compute different types of Procrustes shape distances # shapes 1.1-11 MDSshape - function added to compute MDS mean shape Several new datasets added # shapes 1.1-10 procGPA fixed recently introduced error in reading in complex matrices procGPA( , scale=FALSE,pcaoutput=FALSE) was still calculating PCA, so this has now been fixed. The internal function prcomp1 now uses eigen() rather than svd(), due to some convergence issues in LAPACK for some singular matrices. transformations() :relative translations between centroids now given, rather than just translating the original to have centroid at the origin. shapes/README.md0000755000176200001440000000053014602612554013022 0ustar liggesusers# shapes This is the development version of the R package *shapes* (which will eventually be version 1.2.8). The current released version 1.2.7 is on CRAN at https://cran.r-project.org/web/packages/shapes/index.html To use this library in R: ```xml library("devtools") install_github("iandryden/shapes") library(shapes) ``` shapes/man/0000755000176200001440000000000015076647712012327 5ustar liggesusersshapes/man/dna.dat.Rd0000754000176200001440000000042111672137500014111 0ustar liggesusers\name{dna.dat} \alias{dna.dat} \title{DNA data} \description{Part of a 3D DNA molecule moving in time, k = 22 atoms, 30 time points} \usage{data(dna.dat)} \format{ An array of dimension 22 x 3 x 30 } \examples{ data(dna.dat) plotshapestime3d(dna.dat) } \keyword{datasets} shapes/man/ssriemdist.Rd0000754000176200001440000000234613353165756015012 0ustar liggesusers\name{ssriemdist} \alias{ssriemdist} %- Also NEED an `\alias' for EACH other topic documented here. \title{Riemannian size-and-shape distance} \description{Calculates the Riemannian size-and-shape distance d_S between two configurations} \usage{ ssriemdist(x, y, reflect=FALSE) } %- maybe also `usage' for other objects documented here. \arguments{ \item{x}{k x m matrix (or complex k-vector for 2D data) where k = number of landmarks and m = no of dimensions} \item{y}{k x m matrix (or complex k-vector for 2D data)} \item{reflect}{ Logical. If reflect = TRUE then reflection invariance is included.} } \value{ The Riemannian size-and-shape distance d_S between the two configurations. (for the Riemannian shape distance use riemdist) } \references{ Le, H.-L. (1995). Mean size-and-shapes and mean shapes: a geometric point of view. Advances in Applied Probability, 27:44-55. } \seealso{procOPA,procGPA,riemdist} \examples{ data(gorf.dat) data(gorm.dat) gorf<-procGPA(gorf.dat,scale=FALSE) gorm<-procGPA(gorm.dat,scale=FALSE) ds<-ssriemdist(gorf$mshape,gorm$mshape) cat("Riemannian size-and-shape distance between mean size-and-shapes is ",ds," \n") } \author{Ian Dryden} \keyword{multivariate}% __ONLY ONE__ keyword per line shapes/man/shapepca.Rd0000754000176200001440000000464613204275144014401 0ustar liggesusers\name{shapepca} \alias{shapepca} %- Also NEED an `\alias' for EACH other topic documented here. \title{Principal components analysis for shape} \description{ Provides graphical summaries of principal components for shape. } \usage{ shapepca(proc, pcno = c(1, 2, 3), type = "r", mag = 1, joinline = c(1, 1), project=c(1,2),scores3d=FALSE,color=2,axes3=FALSE,rglopen=TRUE,zslice=0) } %- maybe also `usage' for other objects documented here. \arguments{ \item{proc}{List given by the output from \code{procGPA()} } \item{pcno}{A vector of the PCs to be plotted} \item{type}{Options for the types of plot for the $m=2$ planar case: "r" : rows along PCs evaluated at c = -3,0,3 sd's along PC, "v" : vectors drawn from mean to +3 sd's along PC, "s" : plots along c= -3, -2, -1, 0, 1, 2, 3 superimposed, "m" : movie backward and forwards from -3 to +3 sd's along PC, "g" : TPS grid from mean to +3 sd's along PC. } \item{mag}{Magnification of the effect of the PC (scalar multiple of sd's)} \item{joinline}{A vector stating which landmarks are joined up by lines, e.g. joinline=c(1:n,1) will start at landmark 1, join to 2, ..., join to n, then re-join to landmark 1.} \item{project}{The default orthogonal projections if in higher than 2 dimensions} \item{scores3d}{Logical. If TRUE then a 3D scatterplot of the first 3 raw PC scores with labels in `pcno' is given, instead of the default plot of the mean and PC vectors.} \item{color}{Color of the spheres used in plotting. Default color = 2 (red). If a vector is given then the points are colored in that order.} \item{axes3}{Logical. If TRUE then the axes are plotted in a 3D plot.} \item{rglopen}{Logical. If TRUE open a new RGL window, otherwise plot in current window.} \item{zslice}{For 3D case, type = "g": the z co-ordinate(s) for the grid slice(s)} } \details{The mean and PCs are plotted. } \value{ No value is returned } \references{Dryden, I.L. and Mardia, K.V. (2016). Statistical Shape Analysis, with Applications in R (Second Edition). Wiley, Chichester. Chapter 7.} \author{Ian Dryden} \seealso{procGPA} \examples{ #2d example data(gorf.dat) data(gorm.dat) gorf<-procGPA(gorf.dat) gorm<-procGPA(gorm.dat) shapepca(gorf,type="r",mag=3) shapepca(gorf,type="v",mag=3) shapepca(gorm,type="r",mag=3) shapepca(gorm,type="v",mag=3) #3D example #data(macm.dat) #out<-procGPA(macm.dat) #movie #shapepca(out,pcno=1) } \keyword{hplot} \keyword{multivariate} shapes/man/gorm.dat.Rd0000754000176200001440000000134713204275624014326 0ustar liggesusers\name{gorm.dat} \alias{gorm.dat} \title{Male gorilla data} \description{Male gorilla skull data. 8 landmarks in 2 dimensions, 29 individuals } \usage{data(gorm.dat)} \format{ An array of dimension 8 x 2 x 29 } \source{Dryden, I.L. and Mardia, K.V. (2016). Statistical Shape Analysis, with Applications in R (Second Edition). Wiley, Chichester. Chapter 1. O'Higgins, P. and Dryden, I. L. (1993). Sexual dimorphism in hominoids: further studies of craniofacial shape differences in Pan, Gorilla, Pongo, Journal of Human Evolution, 24, 183-205. } \references{ http://www.maths.nott.ac.uk/personal/ild/bookdata/gorm.dat Data from Paul O'Higgins (Hull-York Medical School) } \examples{ data(gorm.dat) plotshapes(gorm.dat) } \keyword{datasets} shapes/man/T1mice.Rd0000754000176200001440000000176714636606454013754 0ustar liggesusers\name{T1mice} \alias{T1mice} \title{T1 mouse vertabrae data} \description{T1 mouse vertebrae data - 4 landmarks in 2 dimensions, in 3 groups (30 Control, 26 Large, 29 Small mice). The 4 landmarks are obtained using a semi-automatic method at points of high curvature. This particular strain of mice is the `QE' strain. } \usage{data(T1mice)} \format{ mice$x : An array of dimension 4 x 2 x 85 of the two dimensional co-ordinates of 4 landmarks for each of the 85 mice. mice$group : Group labels. "c" Control, "l" Large, "s" Small mice } \source{ Dryden, I.L. and Mardia, K.V. (1996). Statistical Shape Analysis with Applications in R, 2nd Edition, Wiley, Chichester. } \references{ Mardia, K. V. and Dryden, I. L. (1989). The statistical analysis of shape data. Biometrika, 76, 271-281. Data from Paul O'Higgins (Hull-York Medical School) and David Johnson (Leeds) } \examples{ data(T1mice) plotshapes(T1mice$x,symbol=as.character(T1mice$group),joinline=c(1,4,2,3,1)) } \keyword{datasets} shapes/man/groupstack.Rd0000754000176200001440000000270513204275545014776 0ustar liggesusers\name{groupstack} \alias{groupstack} %- Also NEED an `\alias' for EACH other topic documented here. \title{Combine two or more groups of configurations} \description{Combine two or more groups of configurations and create a group label vector. (Maximum 8 groups). } \usage{ groupstack(A1, A2, A3=0, A4=0, A5=0, A6=0, A7=0, A8=0) } %- maybe also `usage' for other objects documented here. \arguments{ \item{A1}{Input k x m x n real array of the Procrustes transformed configurations, where k is the number of points, m is the number of dimensions, and n is the sample size. } \item{A2}{Input k x m x n real array of the Procrustes original configurations, where k is the number of points, m is the number of dimensions, and n is the sample size. } \item{A3}{ Optional array} \item{A4}{ Optional array} \item{A5}{ Optional array} \item{A6}{ Optional array} \item{A7}{ Optional array} \item{A8}{ Optional array} } \value{A list with components \item{x}{The combined array of all configurations} \item{groups}{The group labels (integers)} } \references{Dryden, I.L. and Mardia, K.V. (2016). Statistical Shape Analysis, with Applications in R (Second Edition). Wiley, Chichester.} \author{Ian Dryden} \seealso{procGPA} \examples{ #2D example : female and male Gorillas (cf. Dryden and Mardia, 2016) data(gorf.dat) data(gorm.dat) groupstack(gorf.dat,gorm.dat) } \keyword{multivariate} shapes/man/cortical.Rd0000754000176200001440000000223712563416116014412 0ustar liggesusers\name{cortical} \alias{cortical} \title{Cortical surface data} \description{Cortical surface data, from MR scans. Axial slice outlines with 500 points on each outline. 68 individuals. } \usage{data(cortical)} \format{ cortical$age ( age) cortical$group ( Control, Schizophrenia) cortical$sex ( 1 = male, 2 = female) cortical$symm ( a symmetry measure from the original 3D cortical surface ) cortical$x (500 x , y coordinates of an axial slice through the cortical surface intersecting the anterior and posterior commissures) cortical$r (500 radii from equal angular polar coordinates ) } \source{ Brignell, C.J., Dryden, I.L., Gattone, S.A., Park, B., Leask, S., Browne, W.J. and Flynn, S. (2010). Surface shape analysis, with an application to brain surface asymmetry in schizophrenia. Biostatistics, 11, 609-630. Dryden, I.L. (2005). Statistical analysis on high-dimensional spheres and shape spaces. Annals of Statistics, 33, 1643-1665 } \references{ Original MR data from Sean Flynn (UBC) in collaboration with Bert Park (Nottingham). } \examples{ data(cortical) plotshapes(cortical$x) } \keyword{datasets} shapes/man/backfit.Rd0000644000176200001440000000260214255157466014221 0ustar liggesusers\name{backfit} \alias{backfit} \title{Backfit from scores to configuration} \description{Backfit from PNSS or PCA scores to a representative configuration } \usage{ backfit(scores, x, type="pnss", size=1) } %- maybe also `usage' for other objects documented here. \arguments{ \item{scores}{n x p matrix of scores} \item{x}{ An object that is the output of either pnss3d (if type="pnss") or procGPA (if type="pca") } \item{type}{ Either "pnss" for PNSS or "pca" for PCA } \item{size}{ The centroid size of the backfitted configuration. The default is 1 but one can rescale the backfitting if desired. } } \value{A k x m matrix of co-ordinates of the backfitted configuration } \references{ Dryden, I.L., Kim, K., Laughton, C.A. and Le, H. (2019). Principal nested shape space analysis of molecular dynamics data. Annals of Applied Statistics, 13, 2213-2234. Jung, S., Dryden, I.L. and Marron, J.S. (2012). Analysis of principal nested spheres. Biometrika, 99, 551-568. } \author{Ian Dryden} \seealso{pns, pns4pc, plot3darcs} \examples{ ans <- pnss3d( macf.dat, sphere.type="BIC", n.pc=8) y <- backfit( ans$PNS$scores[1,] , ans ,type="pnss") riemdist( macf.dat[,,1] , y ) #should be close to zero ans2 <- procGPA( macf.dat, tangentcoords="partial") y <- backfit( ans2$scores[1,] , ans2 ,type="pca") riemdist( macf.dat[,,1] , y ) #should be close to zero } \keyword{multivariate} shapes/man/pongom.dat.Rd0000754000176200001440000000106010706112555014646 0ustar liggesusers\name{pongom.dat} \alias{pongom.dat} \title{Male orang utan data} \description{Male orang utan skull data. 8 landmarks in 2 dimensions, 30 individuals } \usage{data(pongom.dat)} \format{ An array of dimension 8 x 2 x 30 } \source{ O'Higgins, P. and Dryden, I. L. (1993). Sexual dimorphism in hominoids: further studies of craniofacial shape differences in Pan, Gorilla, Pongo, Journal of Human Evolution, 24, 183-205. } \references{ Data from Paul O'Higgins (Hull-York Medical School) } \examples{ data(pongom.dat) plotshapes(pongom.dat) } \keyword{datasets} shapes/man/rats.Rd0000754000176200001440000000132212551013461013546 0ustar liggesusers\name{rats} \alias{rats} \title{Rat skulls data} \description{Rat skulls data, from X rays. 8 landmarks in 2 dimensions, 18 individuals observed at 7, 14, 21, 30, 40, 60, 90, 150 days. } \usage{data(rats)} \format{ rats$x: An array of landmark configurations 144 x 2 x 2 rats$no: Individual rat number (note rats 3, 13, 20 missing due to incomplete data) rats$time observed time in days } \source{ Vilmann's rat data set (Bookstein, 1991, Morphometric Tools for Landmark Data: Geometry and Biology, pp. 408-414) } \references{ Bookstein, F.L. (1991). Morphometric tools for landmark data: geometry and biology, Cambridge University Press. } \examples{ data(rats) plotshapes(rats$x,col=1:8) } \keyword{datasets} shapes/man/schizophrenia.dat.Rd0000754000176200001440000000276311171647350016233 0ustar liggesusers\name{schizophrenia.dat} \alias{schizophrenia.dat} \title{Bookstein's schizophrenia data} \description{Bookstein's schizophrenia data. 13 landmarks in 2 dimensions, 28 individuals. The first 14 individuals are controls. The last fourteen cases were diagnosed with schizophrenia. The landmarks were taken in the near midline from MR images of the brain: (1) splenium, posteriormost point on corpus callosum; (2) genu, anteriormost point on corpus callosum; (3) top of corpus callosum, uppermost point on arch of callosum (all three to an approximate registration on the diameter of the callosum); (4) top of head, a point relaxed from a standard landmark along the apparent margin of the dura; (5) tentorium of cerebellum at dura; (6) top of cerebellum; (7) tip of fourth ventricle; (8) bottom of cerebellum; (9) top of pons, anterior margin; (10) bottom of pons, anterior margin; (11) optic chiasm; (12) frontal pole, extension of a line from landmark 1 through landmark 2 until it intersects the dura; (13) superior colliculus. } \usage{data(schizophrenia.dat)} \format{ An array of dimension 13 x 2 x 28 } \source{ Bookstein, F. L. (1996). Biometrics, biomathematics and the morphometric synthesis, Bulletin of Mathematical Biology, 58, 313--365. } \references{ Data kindly provided by Fred Bookstein (University of Washington and University of Vienna) } \examples{ data(schizophrenia.dat) k<-dim(schizophrenia.dat)[1] n<-dim(schizophrenia.dat)[3] plotshapes(schizophrenia.dat) } \keyword{datasets} shapes/man/plotshapes.Rd0000754000176200001440000000273511042043445014767 0ustar liggesusers\name{plotshapes} \alias{plotshapes} %- Also NEED an `\alias' for EACH other topic documented here. \title{Plot configurations} \description{ Plots configurations. Either one or two groups of observations can be plotted on the same scale. } \usage{ plotshapes(A, B = 0, joinline = c(1, 1),orthproj=c(1,2),color=1,symbol=1) } %- maybe also `usage' for other objects documented here. \arguments{ \item{A}{k x m x n array, or k x m matrix for first group} \item{B}{k x m x n array, or k x m matrix for 2nd group (can be missing)} \item{joinline}{A vector stating which landmarks are joined up by lines, e.g. joinline=c(1:n,1) will start at landmark 1, join to 2, ..., join to n, then re-join to landmark 1.} \item{orthproj}{A vector stating which two orthogonal projections will be used. For example, for m=3 dimensional data: X-Y projection given by c(1,2) (default), X-Z projection given by c(1,3), Y-Z projection given by c(2,3).} \item{color}{Colours for points. Can be a vector, e.g. 1:k gives each landmark a different colour for the specimens} \item{symbol}{Plotting symbols. Can be a vector, e.g. 1:k gives each landmark a different symbol for the specimens} } \value{ Just graphical output } \author{Ian Dryden} \seealso{shapepca,tpsgrid} \examples{ data(gorf.dat) data(gorm.dat) plotshapes(gorf.dat,gorm.dat,joinline=c(1,6,7,8,2,3,4,5,1)) data(macm.dat) data(macf.dat) plotshapes(macm.dat,macf.dat) } \keyword{hplot} \keyword{multivariate} shapes/man/digit3.dat.Rd0000754000176200001440000000113113204273562014533 0ustar liggesusers\name{digit3.dat} \alias{digit3.dat} \title{Digit 3 data} \description{Handwritten digit `3' data. 13 landmarks in 2 dimensions, 30 individuals } \usage{data(digit3.dat)} \format{ An array of dimension 13 x 2 x 30 } \source{ Dryden, I.L. and Mardia, K.V. (2016). Statistical Shape Analysis, with applications in R (Second Edition). Wiley, Chichester. Chapter 1. } \references{ http://www.maths.nott.ac.uk/personal/ild/bookdata/digit3.dat Data from Cath Anderson } \examples{ data(digit3.dat) k<-dim(digit3.dat)[1] n<-dim(digit3.dat)[3] plotshapes(digit3.dat,joinline=c(1:13)) } \keyword{datasets} shapes/man/procGPA.Rd0000754000176200001440000001360313335566341014110 0ustar liggesusers\name{procGPA} \alias{procGPA} %- Also NEED an `\alias' for EACH other topic documented here. \title{Generalised Procrustes analysis} \description{Generalised Procrustes analysis to register landmark configurations into optimal registration using translation, rotation and scaling. Reflection invariance can also be chosen, and registration without scaling is also an option. Also, obtains principal components, and some summary statistics. } \usage{ procGPA(x, scale = TRUE, reflect = FALSE, eigen2d = FALSE, tol1 = 1e-05, tol2 = tol1, tangentcoords = "residual", proc.output=FALSE, distances=TRUE, pcaoutput=TRUE, alpha=0, affine=FALSE) } %- maybe also `usage' for other objects documented here. \arguments{ \item{x}{Input k x m x n real array, (or k x n complex matrix for m=2 is OK), where k is the number of points, m is the number of dimensions, and n is the sample size. } \item{scale}{Logical quantity indicating if scaling is required} \item{reflect}{Logical quantity indicating if reflection is required} \item{eigen2d}{Logical quantity indicating if complex eigenanalysis should be used to calculate Procrustes mean for the particular 2D case when scale=TRUE, reflect=FALSE} \item{tol1}{Tolerance for optimal rotation for the iterative algorithm: tolerance on the mean sum of squares (divided by size of mean squared) between successive iterations} \item{tol2}{tolerance for rescale/rotation step for the iterative algorithm: tolerance on the mean sum of squares (divided by size of mean squared) between successive iterations} \item{tangentcoords}{Type of tangent coordinates. If (SCALE=TRUE) the options are "residual" (Procrustes residuals, which are approximate tangent coordinates to shape space), "partial" (Kent's partial tangent co-ordinates), "expomap" (tangent coordinates from the inverse of the exponential map, which are the similar to "partial" but scaled by (rho/sin(rho)) where rho is the Riemannian distance to the pole of the projection. If (SCALE=FALSE) then all three options give the same tangent co-ordinates to size-and-shape space, which is simply the Procrustes residual X^P - mu. } \item{proc.output}{Logical quantity indicating if printed output during the iterations of the Procrustes GPA algorithm should be given} \item{distances}{Logical quantity indicating if shape distances and sizes should be calculated} \item{pcaoutput}{Logical quantity indicating if PCA should be carried out} \item{alpha}{The parameter alpha used for relative warps analysis, where alpha is the power of the bending energy matrix. If alpha = 0 then standard Procrustes PCA is carried out. If alpha = 1 then large scale variations are emphasized, if alpha = -1 then small scale variations are emphasised. Requires m=2 and m=3 dimensional data if alpha $!=$ 0.} \item{affine}{Logical. If TRUE then only the affine subspace of shape variability is considered.} } \value{A list with components \item{k}{no of landmarks} \item{m}{no of dimensions (m-D dimension configurations)} \item{n}{sample size} \item{mshape}{Procrustes mean shape. Note this is unit size if complex eigenanalysis used, but on the scale of the data if iterative GPA is used.} \item{tan}{The tangent shape (or size-and-shape) coordinates} \item{rotated}{the k x m x n array of full Procrustes rotated data} \item{pcar}{the columns are eigenvectors (PCs) of the sample covariance Sv of tan} \item{pcasd}{the square roots of eigenvalues of Sv using tan (s.d.'s of PCs)} \item{percent}{the percentage of variability explained by the PCs using tan. If alpha $!=0$ then it is the percent of non-affine variation of the relative warp scores. If affine is TRUE it is the percentage of total shape variability of each affine component.} \item{size}{the centroid sizes of the configurations} \item{stdscores}{standardised PC scores (each with unit variance) using tan} \item{rawscores}{raw PC scores using tan} \item{rho}{Kendall's Riemannian shape distance rho to the mean shape} \item{rmsrho}{root mean square (r.m.s.) of rho} \item{rmsd1}{r.m.s. of full Procrustes distances to the mean shape $d_F$} \item{GSS}{Minimized Procrustes sum of squares} } \references{Dryden, I.L. and Mardia, K.V. (2016). Statistical Shape Analysis, with applications in R (Second Edition). Wiley, Chichester. Chapter 7. Goodall, C.R. (1991). Procrustes methods in the statistical analysis of shape (with discussion). Journal of the Royal Statistical Society, Series B, 53: 285-339. Gower, J.C. (1975). Generalized Procrustes analysis, Psychometrika, 40, 33--50. Kent, J.T. (1994). The complex Bingham distribution and shape analysis, Journal of the Royal Statistical Society, Series B, 56, 285-299. Ten Berge, J.M.F. (1977). Orthogonal Procrustes rotation for two or more matrices. Psychometrika, 42, 267-276. } \author{Ian Dryden, with input from Mohammad Faghihi and Alfred Kume} \seealso{procOPA,riemdist,shapepca,testmeanshapes} \examples{ #2D example : female and male Gorillas (cf. Dryden and Mardia, 2016) data(gorf.dat) data(gorm.dat) plotshapes(gorf.dat,gorm.dat) n1<-dim(gorf.dat)[3] n2<-dim(gorm.dat)[3] k<-dim(gorf.dat)[1] m<-dim(gorf.dat)[2] gor.dat<-array(0,c(k,2,n1+n2)) gor.dat[,,1:n1]<-gorf.dat gor.dat[,,(n1+1):(n1+n2)]<-gorm.dat gor<-procGPA(gor.dat) shapepca(gor,type="r",mag=3) shapepca(gor,type="v",mag=3) gor.gp<-c(rep("f",times=30),rep("m",times=29)) x<-cbind(gor$size,gor$rho,gor$scores[,1:3]) pairs(x,panel=function(x,y) text(x,y,gor.gp), label=c("s","rho","score 1","score 2","score 3")) ########################################################## #3D example data(macm.dat) out<-procGPA(macm.dat,scale=FALSE) par(mfrow=c(2,2)) plot(out$rawscores[,1],out$rawscores[,2],xlab="PC1",ylab="PC2") title("PC scores") plot(out$rawscores[,2],out$rawscores[,3],xlab="PC2",ylab="PC3") plot(out$rawscores[,1],out$rawscores[,3],xlab="PC1",ylab="PC3") plot(out$size,out$rho,xlab="size",ylab="rho") title("Size versus shape distance") } \keyword{multivariate} shapes/man/tpsgrid.Rd0000754000176200001440000000515613204274452014267 0ustar liggesusers\name{tpsgrid} \alias{tpsgrid} %- Also NEED an `\alias' for EACH other topic documented here. \title{Thin-plate spline transformation grids} \description{Thin-plate spline transformation grids from one set of landmarks to another. } \usage{ tpsgrid(TT, YY, xbegin=-999, ybegin=-999, xwidth=-999, opt=1, ext=0.1, ngrid=22, cex=1, pch=20, col=2,zslice=0, mag=1, axes3=FALSE) } %- maybe also `usage' for other objects documented here. \arguments{ \item{TT}{First object (source): (k x m matrix)} \item{YY}{Second object (target): (k x m matrix)} \item{xbegin}{lowest x value for plot: if -999 then a value is determined} \item{ybegin}{lowest y value for plot: if -999 then a value is determined } \item{xwidth}{width of plot: if -999 then a value is determined} \item{opt}{Option 1: (just deformed grid on YY is displayed), option 2: both grids are displayed} \item{ext}{Amount of border on plot in 2D case.} \item{ngrid}{Number of grid points: size is ngrid * (ngrid -1)} \item{cex}{Point size} \item{pch}{Point symbol} \item{col}{Point colour} \item{zslice}{For 3D case the scaled z co-ordinate(s) for the grid slice(s). The values are on a standardized scale as a proportion of height from the middle of the z-axis to the top and bottom. Values in the range -1 to 1 would be sensible.} \item{mag}{Exaggerate effect (mag > 1). Standard effect has mag=1.} \item{axes3}{Logical. If TRUE then the axes are plotted in a 3D plot.} } \details{ A square grid on the first configuration is deformed smoothly using a pair of thin-plate splines in 2D, or a triple of splines in 3D, to a curved grid on the second object. For 3D data the grid is placed at a constant z-value on the first figuure, indicated by the value of zslice. For 2D data the covariance function in the thin-plate spline is $sigma(h) = |h|^2 log |h|^2$ and in 3D it is given by $sigma(h) = -| h |$. } \value{ No returned value } \references{ Bookstein, F.L. (1989). Principal warps: thin-plate splines and the decomposition of deformations, IEEE Transactions on Pattern Analysis and Machine Intelligence, 11, 567--585. Dryden, I.L. and Mardia, K.V. (2016). Statistical Shape Analysis, with Applications in R (Second Edition). Wiley, Chichester. Chapter 12. } \author{Ian Dryden} \seealso{procGPA} \examples{ data(gorf.dat) data(gorm.dat) #TPS grid with shape change exaggerated (2x) gorf<-procGPA(gorf.dat) gorm<-procGPA(gorm.dat) TT<-gorf$mshape YY<-gorm$mshape tpsgrid(TT,YY,mag=2) title("TPS grid: Female mean (left) to Male mean (right)") } \keyword{multivariate}% at least one, from doc/KEYWORDS \keyword{hplot} shapes/man/frechet.Rd0000754000176200001440000000406613204275654014237 0ustar liggesusers\name{frechet} \alias{frechet} \title{Mean shape estimators} \description{Calculation of different types of Frechet mean shapes, or the isotropic offset Gaussian MLE mean shape } \usage{ frechet(x, mean="intrinsic") } %- maybe also `usage' for other objects documented here. \arguments{ \item{x}{Input k x m x n real array, where k is the number of points, m is the number of dimensions, and n is the sample size. } \item{mean}{Type of mean shape. The Frechet mean shape is obtained by minimizing sum d(x_i,mu)^2 with respect to mu. Different estimators are obtained with different choices of distance d. "intrinsic" intrinsic mean shape (d = rho = Riemannian distance); "partial.procrustes" partial Procrustes (d = 2*sin(rho/2)); "full.procrustes" full Procrustes (d = sin(rho)); h (positive real number) M-estimator (d^2 = (1 - cos^(2h)(rho))/h) Kent (1992); "mle" - isotropic offset Gaussian MLE of Mardia and Dryden (1989) } } \value{A list with components \item{mshape}{Mean shape estimate} \item{var}{Minimized Frechet variance (not available for MLE)} \item{kappa}{(if available) The estimated kappa for the MLE} \item{code}{Code from optimization, as given by function nlm - should be 1 or 2} \item{gradient}{Gradient from the optimization, as given by function nlm - should be close to zero} } \references{ Dryden, I. L. (1991). Discussion to `Procrustes methods in the statistical analysis of shape' by C.R. Goodall. Journal of the Royal Statistical Society, Series B, 53:327-328. Dryden, I.L. and Mardia, K.V. (2016). Statistical Shape Analysis, with applications in R (Second Edition). Wiley, Chichester. Kent, J. T. (1992). New directions in shape analysis. In Mardia, K. V., editor, The Art of Statistical Science, pages 115-127. Wiley, Chichester. Mardia, K. V. and Dryden, I. L. (1989b). The statistical analysis of shape data. Biometrika, 76:271-282. } \author{Ian Dryden} \seealso{procGPA} \examples{ #2D example : female and male Gorillas (cf. Dryden and Mardia, 2016) data(gorf.dat) frechet(gorf.dat[,,1:4],mean="intrinsic") } \keyword{multivariate} shapes/man/humanmove.Rd0000754000176200001440000000125012563137647014614 0ustar liggesusers\name{humanmove} \alias{humanmove} \title{Human movement data} \description{Human movement data. 4 landmarks in 2 dimensions, 5 individuals observed at 10 times. } \usage{data(humanmove)} \format{ humanmove: An array of landmark configurations 4 x 2 x 10 x 5 } \source{ Alshabani, A. K. S. and Dryden, I. L. and Litton, C. D. and Richardson, J. (2007). Bayesian analysis of human movement curves, J. Roy. Statist. Soc. Ser. C, 56, 415--428. } \references{ Data from James Richardson. } \examples{ data(humanmove) #plotshapes(humanmove[,,,1]) #for (i in 2:5){ #for (j in 1:4){ #for (k in 1:10){ #points(humanmove[j,,k,i],col=i) #} #} #} } \keyword{datasets} shapes/man/transformations.Rd0000754000176200001440000000302313204274355016035 0ustar liggesusers\name{transformations} \alias{transformations} %- Also NEED an `\alias' for EACH other topic documented here. \title{Calculate similarity transformations} \description{Calculate similarity transformations between configurations in two arrays. } \usage{ transformations(Xrotated,Xoriginal) } %- maybe also `usage' for other objects documented here. \arguments{ \item{Xrotated}{Input k x m x n real array of the Procrustes transformed configurations, where k is the number of points, m is the number of dimensions, and n is the sample size. } \item{Xoriginal}{Input k x m x n real array of the Procrustes original configurations, where k is the number of points, m is the number of dimensions, and n is the sample size. } } \value{A list with components \item{translation}{The translation parameters. These are the relative translations of the centroids of the individuals.} \item{scale}{The scale parameters} \item{rotation}{The rotation parameters. These are the rotations between the individuals after they have both been centred.} } \references{Dryden, I.L. and Mardia, K.V. (2016). Statistical Shape Analysis, with Applications in R (Second Edition). Wiley, Chichester.} \author{Ian Dryden} \seealso{procGPA} \examples{ #2D example : female and male Gorillas (cf. Dryden and Mardia, 2016) data(gorf.dat) Xorig <- gorf.dat Xrotated <- procGPA(gorf.dat)$rotated transformations(Xrotated,Xorig) } \keyword{multivariate} shapes/man/bookstein2d.Rd0000754000176200001440000000234613204273375015037 0ustar liggesusers\name{bookstein2d} \alias{bookstein2d} \title{Bookstein's baseline registration for 2D data} \description{Carries out Bookstein's baseline registration and calculates a mean shape} \usage{bookstein2d(A,l1=1,l2=2)} \arguments{ \item{A}{a k x 2 x n real array, or k x n complex matrix, where k is the number of landmarks, n is the number of observations} \item{l1}{l1: an integer : l1 is sent to (-1/2,0) in the registration} \item{l2}{l2: an integer : l2 is sent to (1/2,0) in the registration} } \value{A list with components: \item{k}{number of landmarks} \item{n}{sample size} \item{mshape}{Bookstein mean shape with baseline l1, l2} \item{bshpv}{the k x n x 2 array of Bookstein shape variables, including the baseline} } \references{Dryden, I.L. and Mardia, K.V. (2016). Statistical Shape Analysis, with applications in R (Second Edition). Wiley, Chichester. Chapter 2. Bookstein, F. L. (1986) Size and shape spaces for landmark data in two dimensions (with discussion). Statistical Science, 1:181-242. } \author{Ian Dryden} \examples{ data(gorf.dat) data(gorm.dat) bookf<-bookstein2d(gorf.dat) bookm<-bookstein2d(gorm.dat) plotshapes(bookf$mshape,bookm$mshape,joinline=c(1,6,7,8,2,3,4,5,1)) } \keyword{multivariate} shapes/man/plot3darcs.Rd0000754000176200001440000000354514031055254014665 0ustar liggesusers\name{plot3darcs} \alias{plot3darcs} \title{Modes of variation plots for PCA and PNSS} \description{Modes of variation plots for PCA and PNSS based on 3D views and arcs along a mode. c * sd : the extent along lower and upper principal arcs. The lower principal arc -> 0 -> upper principal arc has a total of 2*nn+1 configurations with: nn configurations along the negative principal arc to 0; one configuration at the PNS mean; nn configurations along the positive principal arc. } \usage{ plot3darcs(x,pcno=1,c=1,nn=100,boundary.data=TRUE,view.theta=0,view.phi=0,type="pnss") } %- maybe also `usage' for other objects documented here. \arguments{ \item{x}{Output from pnss3d} \item{pcno}{The number of the PC/PNSS component. The default is 1, the first PC/PNSS} \item{c}{Number of standard deviations along each arc} \item{nn}{In total 2 * nn + 1 configurations: n configurations on arc from negative to 0; 1 configuration at 0; nn configurations from 0 to positive} \item{boundary.data}{Logical for whether to use boundary data or not. } \item{view.theta}{Viewing angle theta} \item{view.phi}{Viewing angle phi} \item{type}{"pnss" principal nested sphere mean and arc, or "pca" Procrustes mean and linear PC.} } \value{A list with components \item{PNSmean}{the PNSS mean} \item{lu.arc}{the configurations along the arc} } \references{ Dryden, I.L., Kim, K., Laughton, C.A. and Le, H. (2019). Principal nested shape space analysis of molecular dynamics data. Annals of Applied Statistics, 13, 2213-2234. Jung, S., Dryden, I.L. and Marron, J.S. (2012). Analysis of principal nested spheres. Biometrika, 99, 551-568. } \author{Kwang-Rae Kim, Ian Dryden} \seealso{pns, pns4pc, pnss3d} \examples{ ans <- pnss3d(digit3.dat, sphere.type="BIC", n.pc=5) #aa <- plot3darcs(ans,c=2,pcno=1) #bb <- plot3darcs(ans,c=2,pcno=1,type="pca") } \keyword{multivariate} shapes/man/distcov.Rd0000754000176200001440000000264612021403052014251 0ustar liggesusers\name{distcov} \alias{distcov} %- Also NEED an `\alias' for EACH other topic documented here. \title{Compute a distance between two covariance matrices} \description{Compute a distance between two covariance matrices, with non-Euclidean options. } \usage{ distcov(S1, S2, method="Riemannian",alpha=1/2) } %- maybe also `usage' for other objects documented here. \arguments{ \item{S1}{Input a covariance matrix (square, symmetric, positive definite)} \item{S2}{Input another covariance matrix of the same size } \item{method}{The type of distance to be used: "Procrustes": Procrustes size-and-shape metric, "ProcrustesShape": Procrustes metric with scaling, "Riemannian": Riemannian metric, "Cholesky": Cholesky based distance, "Power: Power Euclidean, with power alpha, "Euclidean": Euclidean metric, "LogEuclidean": Log-Euclidean metric, "RiemannianLe": Another Riemannian metric.} \item{alpha}{The power to be used in the power Euclidean metric } } \value{The distance } \references{Dryden, I.L., Koloydenko, A. and Zhou, D. (2009). Non-Euclidean statistics for covariance matrices, with applications to diffusion tensor imaging. Annals of Applied Statistics, 3, 1102-1123.} \author{Ian Dryden} \seealso{estcov} \examples{ A <- diag(5) B <- A + .1*matrix(rnorm(25),5,5) S1<-A S2<- B%*%t(B) distcov( S1, S2, method="Procrustes") } \keyword{multivariate} shapes/man/shells.Rd0000754000176200001440000000163512563415537014113 0ustar liggesusers\name{shells} \alias{shells} \title{Microfossil shell data} \description{Microfossil shell data. Triangles from 21 individuals. Lohmann (1983) published 21 mean outlines of the microfossil which were based on random samples of organisms taken at different latitudes in the South Indian Ocean. } \usage{data(shells)} \format{ shells$uv Scaled shape coordinates (Bookstein shape co-ordinates with base (0,0) and (1,0). shells$size Centroid size } \source{ Bookstein, F. L. (1986). Size and shape spaces for landmark data in two dimensions (with discussion). Statistical Science, 1:181-242. Lohmann, G. P. (1983). Eigenshape analysis of microfossils: a general morphometric procedure for describing changes in shape. Mathematical Geology, 15:659-672. } \references{ The data have been extracted from Fig. 7 of Bookstein (1986). } \examples{ data(shells) plotshapes(shells$uv) } \keyword{datasets} shapes/man/steroids.Rd0000754000176200001440000000311012054717114014432 0ustar liggesusers\name{steroids} \alias{steroids} \title{Steroid data} \description{Steroid data. Between 42 and 61 atoms for each of 31 steroid molecules. } \usage{data(steroids)} \format{ steroids$x : An array of dimension 61 x 3 x 31 of 3D co-ordinates of the 31 steroids. If a molecules has less than 61 atoms then the remaining co-ordinates are all zero. steroids$activity : Activity class (`1' = high, `2' = intermediate, and `3' = low binding affinities to the corticosteroid binding globulin (CBG) receptor) steroids$radius : van der Waals radius (0 = missing value) steoirds$atom : atom type (0 = missing value) steroids$charge : partial charge (0 = missing value) steroids$names : steroid names } \source{ This particular version of the steroids data set of (x, y, z) atom co-ordinates and partial charges was constructed by Jonathan Hirst and James Melville (School of Chemistry, University of Nottingham). Also see Wagener, M., Sadowski, J., Gasteiger, J. (1995). J. Am. Chem. Soc., 117, 7769-7775. http://www2.ccc.uni-erlangen.de/services/steroids/ } \references{ Dryden, I.L., Hirst, J.D. and Melville, J.L. (2007). Statistical analysis of unlabelled point sets: comparing molecules in chemoinformatics. Biometrics, 63, 237-251. Czogiel I., Dryden, I.L. and Brignell, C.J. (2011). Bayesian matching of unlabeled point sets using random fields, with an application to molecular alignment. Annals of Applied Statistics, 5, 2603-2629. } \examples{ data(steroids) shapes3d(steroids$x[,,1]) } \keyword{datasets} shapes/man/riemdist.Rd0000754000176200001440000000237613353166034014435 0ustar liggesusers\name{riemdist} \alias{riemdist} %- Also NEED an `\alias' for EACH other topic documented here. \title{Riemannian shape distance} \description{Calculates the Riemannian shape distance rho between two configurations} \usage{ riemdist(x, y, reflect=FALSE) } %- maybe also `usage' for other objects documented here. \arguments{ \item{x}{k x m matrix (or complex k-vector for 2D data) where k = number of landmarks and m = no of dimensions} \item{y}{k x m matrix (or complex k-vector for 2D data)} \item{reflect}{ Logical. If reflect = TRUE then reflection invariance is included.} } \value{ The Riemannian shape distance rho between the two configurations. Note 0 <= rho <= pi/2 if no reflection invariance. (for the Riemannian size-and-shape distance use ssriemdist)} \references{ Kendall, D. G. (1984). Shape manifolds, Procrustean metrics and complex projective spaces, Bulletin of the London Mathematical Society, 16, 81-121. } \seealso{procOPA,procGPA} \examples{ data(gorf.dat) data(gorm.dat) gorf<-procGPA(gorf.dat) gorm<-procGPA(gorm.dat) rho<-riemdist(gorf$mshape,gorm$mshape) cat("Riemannian distance between mean shapes is ",rho," \n") } \author{Ian Dryden} \keyword{multivariate}% __ONLY ONE__ keyword per line shapes/man/estcov.Rd0000754000176200001440000000404412021403414014075 0ustar liggesusers\name{estcov} \alias{estcov} %- Also NEED an `\alias' for EACH other topic documented here. \title{Weighted Frechet mean of covariance matrices} \description{Computes the weighted Frechet means of an array of covariance matrices, with different options for the covariance metric. Also carries out principal co-ordinate analysis of the covariance matrices} \usage{ estcov(S , method="Riemannian",weights=1,alpha=1/2,MDSk=2) } %- maybe also `usage' for other objects documented here. \arguments{ \item{S}{Input an array of covariance matrices of size k x k x n where each matrix is square, symmetric and positive definite} \item{method}{The type of distance to be used: "Procrustes": Procrustes size-and-shape metric, "ProcrustesShape": Procrustes metric with scaling, "Riemannian": Riemannian metric, "Cholesky": Cholesky based distance, "Power: Power Euclidean, with power alpha, "Euclidean": Euclidean metric, "LogEuclidean": Log-Euclidean metric, "RiemannianLe": Another Riemannian metric. } \item{weights}{The weights to be used for calculating the mean. If weights=1 then equal weights are used, otherwise the vector must be of length n.} \item{alpha}{The power to be used in the power Euclidean metric} \item{MDSk}{The number of MDS components in the principal co-ordinate analysis} } \value{A list with values \item{mean}{The weighted mean covariance matrix} \item{sd}{The weighted standard deviation} \item{pco}{Principal co-ordinates (from multidimensional scaling with the metric)} \item{eig}{The eigenvalues from the principal co-ordinate analysis} } \references{Dryden, I.L., Koloydenko, A. and Zhou, D. (2009). Non-Euclidean statistics for covariance matrices, with applications to diffusion tensor imaging. Annals of Applied Statistics, 3, 1102-1123.} \author{Ian Dryden} \seealso{distcov} \examples{ S <- array(0,c(5,5,10) ) for (i in 1:10){ tem <- diag(5)+.1*matrix(rnorm(25),5,5) S[,,i]<- tem%*%t(tem) } estcov( S , method="Procrustes") } \keyword{multivariate} shapes/man/macf.dat.Rd0000754000176200001440000000076213204275414014265 0ustar liggesusers\name{macf.dat} \alias{macf.dat} \title{Female macaque data} \description{Female macaque skull data. 7 landmarks in 3 dimensions, 9 individuals } \usage{data(macf.dat)} \format{ An array of dimension 7 x 3 x 9 } \source{ Dryden, I.L. and Mardia, K.V. (2016). Statistical Shape Analysis, with Applications in R (Second Edition). Wiley, Chichester. Chapter 1. } \references{ Data from Paul O'Higgins (Hull-York Medical School) } \examples{ data(macf.dat) plotshapes(macf.dat) } \keyword{datasets} shapes/man/panm.dat.Rd0000754000176200001440000000104610706112524014302 0ustar liggesusers\name{panm.dat} \alias{panm.dat} \title{Male chimpanzee data} \description{Male chimpanzee skull data. 8 landmarks in 2 dimensions, 28 individuals } \usage{data(panm.dat)} \format{ An array of dimension 8 x 2 x 28 } \source{ O'Higgins, P. and Dryden, I. L. (1993). Sexual dimorphism in hominoids: further studies of craniofacial shape differences in Pan, Gorilla, Pongo, Journal of Human Evolution, 24, 183-205. } \references{ Data from Paul O'Higgins (Hull-York Medical School) } \examples{ data(panm.dat) plotshapes(panm.dat) } \keyword{datasets} shapes/man/schizophrenia.Rd0000754000176200001440000000315112054472361015453 0ustar liggesusers\name{schizophrenia} \alias{schizophrenia} \title{Bookstein's schizophrenia data} \description{Bookstein's schizophrenia data. 13 landmarks in 2 dimensions, 28 individuals. The first 14 individuals are controls. The last fourteen cases were diagnosed with schizophrenia. The landmarks were taken in the near midline from MR images of the brain: (1) splenium, posteriormost point on corpus callosum; (2) genu, anteriormost point on corpus callosum; (3) top of corpus callosum, uppermost point on arch of callosum (all three to an approximate registration on the diameter of the callosum); (4) top of head, a point relaxed from a standard landmark along the apparent margin of the dura; (5) tentorium of cerebellum at dura; (6) top of cerebellum; (7) tip of fourth ventricle; (8) bottom of cerebellum; (9) top of pons, anterior margin; (10) bottom of pons, anterior margin; (11) optic chiasm; (12) frontal pole, extension of a line from landmark 1 through landmark 2 until it intersects the dura; (13) superior colliculus. } \usage{data(schizophrenia.dat)} \format{ schizophrenia$x : An array of dimension 13 x 2 x 28 schizophrenia$group : A factor of group labels `con' for Controls and `scz' for the schizophrenia patients. } \source{ Bookstein, F. L. (1996). Biometrics, biomathematics and the morphometric synthesis, Bulletin of Mathematical Biology, 58, 313--365. } \references{ Data kindly provided by Fred Bookstein (University of Washington and University of Vienna) } \examples{ data(schizophrenia) plotshapes(schizophrenia$x,symbol=as.integer(schizophrenia$group)) } \keyword{datasets} shapes/man/macm.dat.Rd0000754000176200001440000000075613204275446014304 0ustar liggesusers\name{macm.dat} \alias{macm.dat} \title{Male macaque data} \description{Male macaque skull data. 7 landmarks in 3 dimensions, 9 individuals } \usage{data(macm.dat)} \format{ An array of dimension 7 x 3 x 9 } \source{ Dryden, I.L. and Mardia, K.V. (2016). Statistical Shape Analysis, with Applications in R (Second Edition). Wiley, Chichester. Chapter 1. } \references{ Data from Paul O'Higgins (Hull-York Medical School) } \examples{ data(macm.dat) plotshapes(macm.dat) } \keyword{datasets} shapes/man/pns4pc.Rd0000754000176200001440000000354314040120153014003 0ustar liggesusers\name{pns4pc} \alias{pns4pc} \title{Principal Nested Shape Spaces from PCA} \description{Approximation of Principal Nested Shapes Spaces using PCA } \usage{ pns4pc(x, sphere.type = "seq.test", alpha = 0.1, R = 100, nlast.small.sphere = 1,n.pc=2) } %- maybe also `usage' for other objects documented here. \arguments{ \item{x}{k x m x n array of landmark data.} \item{sphere.type}{ a character string specifying the type of sphere fitting method. "seq.test" specifies sequential tests to decide either "small" or "great"; "small" specifies Principal Nested SMALL Sphere; "great" specifies Principal Nested GREAT Sphere (radius pi/2); "BIC" specifies BIC statistic to decide either "small" or "great"; and "bi.sphere" specifies Principal Nested GREAT Sphere for the first part and Principal Nested SMALL Sphere for The default is "seq.test". } \item{alpha}{significance level (0 < alpha < 1) used when sphere.type = "seq.test". The default is 0.1. } \item{R}{the number of bootstrap samples to be evaluated for the sequential test. The default is 100.} \item{nlast.small.sphere}{the number of small spheres in the finishing part used when sphere.type = "bi.sphere".} \item{n.pc}{the number of PC scores to be used (n.pc >= 2)} } \value{A list with components \item{PNS}{the output of the function pns} \item{GPAout}{the result of GPA} \item{spheredata}{transformed spherical data from the PC scores} \item{percent}{proportion of variances explained.} } \references{ Dryden, I.L., Kim, K., Laughton, C.A. and Le, H. (2019). Principal nested shape space analysis of molecular dynamics data. Annals of Applied Statistics, 13, 2213-2234. Jung, S., Dryden, I.L. and Marron, J.S. (2012). Analysis of principal nested spheres. Biometrika, 99, 551-568. } \author{Kwang-Rae Kim} \seealso{pns, pns4pc, pnss3d, plot3darcs} \examples{ pns4pc(digit3.dat,n.pc=2) } \keyword{multivariate} shapes/man/testmeanshapes.Rd0000754000176200001440000000717413204274653015644 0ustar liggesusers\name{testmeanshapes} \alias{testmeanshapes} %- Also NEED an `\alias' for EACH other topic documented here. \title{Tests for mean shape difference, including permutation and bootstrap tests} \description{ Carries out tests to examine differences in mean shape between two independent populations, for $m=2$ or $m=3$ dimensional data. Tests are carried out using tangent co-ordinates. H : Hotelling $T^2$ statistic (see Dryden and Mardia, 2016, equ.(9.4)) G : Goodall's F statistic (see Dryden and Mardia, 2016, equ.(9.9)) J : James $T^2$ statistic (see Amaral et al., 2007) p-values are given based on resampling (either a bootstrap test or a permutation test) as well as the usual table based p-values. Bootstrap tests involve sampling with replacement under H0 (as in Amaral et al., 2007). Note when the sample sizes are low (compared to the number of landmarks) some minor regularization is carried out. In particular if Sw is a singular within group covariance matrix, it is replaced by Sw + 0.000001 (Identity matrix) and a `*' is printed in the output. } \usage{ testmeanshapes(A, B, resamples = 1000, replace = FALSE, scale= TRUE) } %- maybe also `usage' for other objects documented here. \arguments{ \item{A}{The random sample for group 1: k x m x n1 array of data, where k is the number of landmarks and n1 is the sample size. (Alternatively a k x n1 complex matrix for 2D)} \item{B}{The random sample for group 2: k x m x n2 array of data, where k is the number of landmarks and n2 is the sample size. (Alternatively a k x n2 complex matrix for 2D)} \item{resamples}{Integer. The number of resampling iterations. If resamples = 0 then no resampling procedures are carried out, and the tabular p-values are given only.} \item{replace}{Logical. If replace = TRUE then bootstrap resampling is carried out with replacement *within* each group. If replace = FALSE then permutation resampling is carried out (sampling without replacement in *pooled* samples).} \item{scale}{Logical. Whether or not to carry out Procrustes with scaling in the procedure.} } \value{ A list with components \item{H}{The Hotelling statistic (F statistic)} \item{H.pvalue}{p-value for the Hotelling test based on resampling} \item{H.table.pvalue}{p-value for the Hotelling test based on the null F distribution, assuming normality and equal covariance matrices} \item{J}{The James $T^2$ statistic} \item{J.pvalue}{p-value for the James $T^2$ test based on resampling} \item{J.table.pvalue}{p-value for the James $T^2$ test based on the null F distribution, assuming normality but unequal covariance matrices} \item{G}{The Goodall $F$ statistic} \item{G.pvalue}{p-value for the Goodall test based on resampling} \item{G.table.pvalue}{p-value for the Goodall test based on the null F distribution, assuming normality and equal isotropic covariance matrices)} } \references{Amaral, G.J.A., Dryden, I.L. and Wood, A.T.A. (2007) Pivotal bootstrap methods for $k$-sample problems in directional statistics and shape analysis. Journal of the American Statistical Association. 102, 695-707. Dryden, I.L. and Mardia, K.V. (2016). Statistical Shape Analysis, with applications in R (Second Edition). Wiley, Chichester. Chapter 9. Goodall, C. R. (1991). Procrustes methods in the statistical analysis of shape (with discussion). Journal of the Royal Statistical Society, Series B, 53: 285-339. } \author{Ian Dryden} \seealso{resampletest} \examples{ #2D example : female and male Gorillas data(gorf.dat) data(gorm.dat) A<-gorf.dat B<-gorm.dat testmeanshapes(A,B,resamples=100) } \keyword{multivariate}% at least one, from doc/KEYWORDS shapes/man/brains.Rd0000754000176200001440000000147212054347444014072 0ustar liggesusers\name{brains} \alias{brains} \title{Brain landmark data} \description{24 landmarks located in 58 adult healthy brains} \usage{data(brains)} \format{A list with components: brains$x : An array of dimension 24 x 3 x 58 containing the landmarks in 3D brains$sex : Sex of each volunteer (m or f) brains$age : Age of each volunteer brains$handed : Handedness of each volunteer (r or l) brains$grp : group label: 1= right-handed males, 2=left-handed males, 3=right-handed females, 4=left-handed females } \references{ Free, S.L., O'Higgins, P., Maudgil, D.D., Dryden, I.L., Lemieux, L., Fish, D.R. and Shorvon, S.D. (2001). Landmark-based morphometrics of the normal adult brain using MRI. Neuroimage , 13 , 801--813. } \examples{ data(brains) # plot first three brains shapes3d(brains$x[,,1:3]) } \keyword{datasets} shapes/man/pns.Rd0000744000176200001440000000716515065271031013411 0ustar liggesusers\name{pns} \alias{pns} \title{Principal Nested Spheres} \description{Calculation of Principal Nested Spheres } \usage{ pns(x, sphere.type = "seq.test", mean.type="Frechet", alpha = 0.1, R = 100, nlast.small.sphere = 1, output=TRUE, pointcolor=2, distr="normal", penalty=0) } %- maybe also `usage' for other objects documented here. \arguments{ \item{x}{a (d + 1) x n data matrix where each column is a unit vector in S^d and n is the sample size. } \item{sphere.type}{ a character string specifying the type of sphere fitting method. "seq.test" specifies sequential tests to decide either "small" or "great"; "small" specifies Principal Nested SMALL Sphere; "great" specifies Principal Nested GREAT Sphere (radius pi/2); "BIC" specifies BIC statistic to decide either "small" or "great" at each level; "distr" specifies the residual distribution for a likelihood ratio test to decide either "small" or "great" at each level; "ks.test" specifies Kolmogorov-Smirnov test to decide either "small" or "great" at each level; "var.test" specifies F test for equal variances to decide either "small" or "great" at each level; and "bi.sphere" specifies Principal Nested GREAT Sphere for the first part and Principal Nested SMALL Sphere for last parts. The default is "seq.test". } \item{mean.type}{ a character string specifying the type of circular mean calculation at the last stage. "Frechet" specifies the Frechet mean on a circle; "Fisher" specifies the Fisher mle a.k.a. resultant mean. } \item{alpha}{significance level (0 < alpha < 1) used when sphere.type = "seq.test". The default is 0.1. } \item{R}{the number of bootstrap samples to be evaluated for the sequential test. The default is 100.} \item{nlast.small.sphere}{the number of small spheres in the finishing part used when sphere.type = "bi.sphere".} \item{output}{Logical. If TRUE then plots and some brief printed summaries are given. If FALSE then no plots or output is given.} \item{pointcolor}{A number or vector indicating the color of the data points plotted on the sphere S2} \item{distr}{The distribution to be used in the likelihood ratio (LR) test, if sphere.type="distr"} \item{penalty}{A log-prior penalty to be used in the LR test} } \value{A list with components \item{resmat}{the residual matrix (X_PNS). Each entry in row k works like the kth principal component} \item{$PNS}{= the list with the following components.} \item{radii}{the size (radius) of PNS.} \item{orthaxis}{the orthogonal axis v_i of subspheres.} \item{dist}{the distance r_i of subspheres} \item{pvalues}{the p-values of LRT and parametric boostrap tests (if any).} \item{ratio}{the estimated ratios. Now unavailable.} \item{mean}{the location of the PNS mean.} \item{sphere.type}{the type of method for fitting subspheres.} \item{percent}{proportion of variances explained.} \item{spherePNS}{The co-ordinates of the data points projected to the sphere in 3D (also plotted)} \item{circlePNS}{The co-ordinates of the 2D circle projections on the sphere in 3D (also plotted)} } \references{ Dryden, I.L., Kim, K., Laughton, C.A. and Le, H. (2019). Principal nested shape space analysis of molecular dynamics data. Annals of Applied Statistics, 13, 2213-2234. Jung, S., Dryden, I.L. and Marron, J.S. (2012). Analysis of principal nested spheres. Biometrika, 99, 551-568. } \author{Primarily Kwang-Rae Kim: R translation of Sungkyu Jung's matlab code, with some additions by Ian Dryden} \seealso{pns4pc, pnss3d} \examples{ # out <- pc2sphere(x = gorf.dat, n.pc = 2) # spheredata <- t(out$spheredata) # pns.out <- pns(x = spheredata) } \keyword{multivariate} shapes/man/mice.Rd0000754000176200001440000000230412054433320013511 0ustar liggesusers\name{mice} \alias{mice} \title{T2 mouse vertabrae data} \description{T2 mouse vertebrae data - 6 landmarks in 2 dimensions, in 3 groups (30 Control, 23 Large, 23 Small mice). The 6 landmarks are obtained using a semi-automatic method at points of high curvature. This particular strain of mice is the `QE' strain. In addition pseudo-landmarks are given around each outlines. } \usage{data(mice)} \format{ mice$x : An array of dimension 6 x 2 x 76 of the two dimensional co-ordinates of 6 landmarks for each of the 76 mice. mice$group : Group labels. "c" Control, "l" Large, "s" Small mice mice$outlines : An array of dimension 60 x 2 x 76 containing the 6 landmarks and 54 pseudo-landmarks, with 9 pseudo-landmarks approximately equally spaced between each pair of landmarks. } \source{ Dryden, I.L. and Mardia, K.V. (1998). Statistical Shape Analysis, Wiley, Chichester. p313 } \references{ Mardia, K. V. and Dryden, I. L. (1989). The statistical analysis of shape data. Biometrika, 76, 271-281. Data from Paul O'Higgins (Hull-York Medical School) and David Johnson (Leeds) } \examples{ data(mice) plotshapes(mice$x,symbol=as.character(mice$group),joinline=c(1,6,2:5,1)) } \keyword{datasets} shapes/man/shapes3d.Rd0000754000176200001440000000242213204274123014311 0ustar liggesusers\name{shapes3d} \alias{shapes3d} \title{Plot 3D data} \description{Plot the landmark configurations from a 3D dataset} \usage{shapes3d(x,loop=0,type="p", color = 2, joinline=c(1:1), axes3=FALSE, rglopen=TRUE)} \arguments{ \item{x}{An array of size k x 3 x n, where k is the number of landmarks and n is the number of observations} \item{loop}{gives the number of times an animated loop through the observations is displayed (in order 1 to n). loop > 0 is suitable when a time-series of shapes is available. loop = 0 gives a plot of all the observations on the same figure. } \item{type}{Type of plot: "p" points, "dots" dots (quicker for large plots), "l" dots and lines though landmarks 1:k if `joinline' not stated} \item{color}{Colour of points (default color = 2 (red)). If a vector is given then the points are coloured in that order.} \item{joinline}{Join the numbered landmarks by lines} \item{axes3}{Logical. If TRUE then plot the axes.} \item{rglopen}{Logical. If TRUE then open a new RGL window, if FALSE then plot in current window.} } \value{ None } \references{Dryden, I.L. and Mardia, K.V. (2016). Statistical Shape Analysis, with Applications in R (Second Edition). Wiley, Chichester. } \author{Ian Dryden} \examples{ data(dna.dat) shapes3d(dna.dat) } \keyword{multivariate} shapes/man/resampletest.Rd0000754000176200001440000001046613204275231015317 0ustar liggesusers\name{resampletest} \alias{resampletest} %- Also NEED an `\alias' for EACH other topic documented here. \title{Tests for mean shape difference using complex arithmetic, including bootstrap and permutation tests. } \description{ Carries out tests to examine differences in mean shape between two independent populations. For 2D data the methods use complex arithmetic and exploit the geometry of the shape space (which is the main use of this function). An alternative faster, approximate procedure using Procrustes residuals is given by the function `testmeanshapes'. For 3D data tests are carried out on the Procrustes residuals, which is an approximation suitable for small variations in shape. Up to four test statistics are calculated: lambda : the asymptotically pivotal statistic $lambda_min$ from Amaral et al. (2007), equ.(14),(16) (m=2 only) H : Hotelling $T^2$ statistic (see Amaral et al., 2007, equ.(23), Dryden and Mardia, 2016, equ.(9.4)) J : James' statistic (see Amaral et al., 2007, equ.(24) ) (m=2 only) G : Goodall's F statistic (see Amaral et al., 2007, equ.(25), Dryden and Mardia, 2016, equ.(9.9)) p-values are given based on resampling as well as the usual table based p-values. Note when the sample sizes are low (compared to the number of landmarks) some regularization is carried out. In particular if Sw is a singular within group covariance matrix, it is replaced by Sw + 0.000001 (Identity matrix) and a `*' is printed in the output. } \usage{ resampletest(A, B, resamples = 200, replace = TRUE) } %- maybe also `usage' for other objects documented here. \arguments{ \item{A}{The random sample for group 1: k x m x n1 array of data, where k is the number of landmarks and n1 is the sample size. (Alternatively a k x n1 complex matrix for 2D)} \item{B}{The random sample for group 3: k x m x n2 array of data, where k is the number of landmarks and n2 is the sample size. (Alternatively a k x n2 complex matrix for 2D)} \item{resamples}{Integer. The number of resampling iterations. If resamples = 0 then no resampling procedures are carried out, and the tabular p-values are given only.} \item{replace}{Logical. If replace = TRUE then for 2D data bootstrap resampling is carried out with replacement *within* each group. If replace = FALSE then permutation resampling is carried out (sampling without replacement in *pooled* samples).} } \value{ A list with components (or a subset of these) \item{lambda}{$lambda_min$ statistic} \item{lambda.pvalue}{p-value for $lambda_min$ test based on resampling} \item{lambda.table.pvalue}{p-value for $lambda_min$ test based on the asymptotic chi-squared distribution (large n1,n2)} \item{H}{The Hotelling $T^2$ statistic} \item{H.pvalue}{p-value for the Hotelling $T^2$ test based on resampling} \item{H.table.pvalue}{p-value for the Hotelling $T^2$ test based on the null F distribution, assuming normality and equal covariance matrices} \item{J}{The Hotelling $T^2$ statistic} \item{J.pvalue}{p-value for the Hotelling $T^2$ test based on resampling} \item{J.table.pvalue}{p-value for the Hotelling $T^2$ test based on the null F distribution, assuming normality and unequal covariance matrices} \item{G}{The Goodall $F$ statistic} \item{G.pvalue}{p-value for the Goodall test based on resampling} \item{G.table.pvalue}{p-value for the Goodall test based on the null F distribution, assuming normality and equal isotropic covariance matrices)} } \references{Amaral, G.J.A., Dryden, I.L. and Wood, A.T.A. (2007) Pivotal bootstrap methods for $k$-sample problems in directional statistics and shape analysis. Journal of the American Statistical Association. 102, 695-707. Dryden, I.L. and Mardia, K.V. (2016). Statistical Shape Analysis, with Applications in R (Second Edition). Wiley, Chichester. Chapter 9. Goodall, C. R. (1991). Procrustes methods in the statistical analysis of shape (with discussion). Journal of the Royal Statistical Society, Series B, 53: 285-339. } \author{Ian Dryden} \seealso{testmeanshapes} \examples{ #2D example : female and male Gorillas data(gorf.dat) data(gorm.dat) #just select 3 landmarks and the first 10 observations in each group select<-c(1,2,3) A<-gorf.dat[select,,1:10] B<-gorm.dat[select,,1:10] resampletest(A,B,resamples=100) } \keyword{multivariate}% at least one, from doc/KEYWORDS shapes/man/procWGPA.Rd0000754000176200001440000000732313204273756014241 0ustar liggesusers\name{procWGPA} \alias{procWGPA} %- Also NEED an `\alias' for EACH other topic documented here. \title{Weighted Procrustes analysis} \description{Weighted Procrustes analysis to register landmark configurations into optimal registration using translation, rotation and scaling. Registration without scaling is also an option. Also, obtains principal components, and some summary statistics. } \usage{ procWGPA(x, fixcovmatrix=FALSE, initial="Identity", maxiterations=10, scale=TRUE, reflect=FALSE, prior="Exponential",diagonal=TRUE,sampleweights="Equal") } %- maybe also `usage' for other objects documented here. \arguments{ \item{x}{Input k x m x n real array, where k is the number of points, m is the number of dimensions, and n is the sample size. } \item{fixcovmatrix}{If FALSE then the landmark covariance matrix is estimated. If a fixed covariance matrix is desired then the value should be given here, e.g. fixcovmatrix=diag(8) for the identity matrix with 8 landmarks.} \item{initial}{The initial value of the estimated covariance matrix. "Identity" - identity matrix, "Rawdata" - based on sample variance of the raw landmarks. Also, could be a k x k symmetric positive definite matrix.} \item{maxiterations}{The maximum number of iterations for estimating the covariance matrix}, \item{scale}{Logical quantity indicating if scaling is required}, \item{reflect}{Logical quantity indicating if reflection invariance is required}, \item{prior}{Indicates the type of prior. "Exponential" is exponential for the inverse eigenvalues. "Identity" is an inverse Wishart with the identity matrix as parameters.} \item{diagonal}{Logical. Indicates if the diagonal of the landmark covariance matrix (only) should be used. Diagonal matrices can lead to some landmarks having very small variability, which may or may not be desirable.} \item{sampleweights}{Gives the weights of the observations in the sample, rather than the landmarks. This is a fixed quatity. "Equal" indicates that all observations in the sample have equal weight. The weights do not need to sum to 1. } } \value{A list with components \item{k}{no of landmarks} \item{m}{no of dimensions (m-D dimension configurations)} \item{n}{sample size} \item{mshape}{Weighted Procrustes mean shape.} \item{tan}{This is the mk x n matrix of Procrustes residuals $X_i^P$ - Xbar.} \item{rotated}{the k x m x n array of weighted Procrustes rotated data} \item{pcar}{the columns are eigenvectors (PCs) of the sample covariance Sv of tan} \item{pcasd}{the square roots of eigenvalues of Sv using tan (s.d.'s of PCs)} \item{percent}{the percentage of variability explained by the PCs using tan. } \item{size}{the centroid sizes of the configurations} \item{scores}{standardised PC scores (each with unit variance) using tan} \item{rawscores}{raw PC scores using tan} \item{rho}{Kendall's Riemannian distance rho to the mean shape} \item{rmsrho}{r.m.s. of rho} \item{rmsd1}{r.m.s. of full Procrustes distances to the mean shape $d_F$} \item{Sigmak}{Estimate of the sample covariance matrix of the landmarks} } \details{The factored covariance model is assumed: $Sigma_k x I_m$ with $Sigma_k$ being the covariance matrix of the landmarks, and the cov matrix at each landmark is the identity matrix.} \references{Dryden, I.L. and Mardia, K.V. (2016). Statistical Shape Analysis, with applications in R (Second Edition). Wiley, Chichester. Goodall, C.R. (1991). Procrustes methods in the statistical analysis of shape (with discussion). Journal of the Royal Statistical Society, Series B, 53: 285-339. } \author{Ian Dryden} \seealso{procGPA} \examples{ #2D example : female Gorillas (cf. Dryden and Mardia, 2016) data(gorf.dat) gor<-procWGPA(gorf.dat,maxiterations=3) } \keyword{multivariate} shapes/man/procOPA.Rd0000754000176200001440000000477213204273243014116 0ustar liggesusers\name{procOPA} \alias{procOPA} %- Also NEED an `\alias' for EACH other topic documented here. \title{Ordinary Procrustes analysis} \description{ Ordinary Procustes analysis : the matching of one configuration to another using translation, rotation and (possibly) scale. Reflections can also be included if desired. The function matches configuration B onto A by least squares.} \usage{ procOPA(A, B, scale = TRUE, reflect = FALSE) } %- maybe also `usage' for other objects documented here. \arguments{ \item{A}{k x m matrix (or complex k-vector for 2D data), of k landmarks in m dimensions. This is the reference figure.} \item{B}{k x m matrix (or complex k-vector for 2D data). This is the figure which is to be transformed.} \item{scale}{logical indicating if scaling is required} \item{reflect}{logical indicating if reflection is allowed} } \value{ A list with components: \item{R}{The estimated rotation matrix (may be an orthogonal matrix if reflection is allowed)} \item{s}{The estimated scale matrix} \item{Ahat}{The centred configuration A} \item{Bhat}{The Procrustes registered configuration B} \item{OSS}{The ordinary Procrustes sum of squares, which is $\|Ahat-Bhat\|^2$} \item{rmsd}{rmsd = sqrt(OSS/(km))} } \references{Dryden, I.L. and Mardia, K.V. (2016). Statistical Shape Analysis, with applications in R (Second Edition). Wiley, Chichester. Chapter 7.} \author{Ian Dryden} \seealso{procGPA,riemdist,tpsgrid} \examples{ data(digit3.dat) A<-digit3.dat[,,1] B<-digit3.dat[,,2] ans<-procOPA(A,B) plotshapes(A,B,joinline=1:13) plotshapes(ans$Ahat,ans$Bhat,joinline=1:13) #Sooty Mangabey data data(sooty.dat) A<-sooty.dat[,,1] #juvenile B<-sooty.dat[,,2] #adult par(mfrow=c(1,3)) par(pty="s") plot(A,xlim=c(-2000,3000),ylim=c(-2000,3000),xlab=" ",ylab=" ") lines(A[c(1:12,1),]) points(B) lines(B[c(1:12,1),],lty=2) title("Juvenile (-------) Adult (- - - -)") #match B onto A out<-procOPA(A,B) #rotation angle print(atan2(out$R[1,2],out$R[1,1])*180/pi) #scale print(out$s) plot(A,xlim=c(-2000,3000),ylim=c(-2000,3000),xlab=" ",ylab=" ") lines(A[c(1:12,1),]) points(out$Bhat) lines(out$Bhat[c(1:12,1),],lty=2) title("Match adult onto juvenile") #match A onto B out<-procOPA(B,A) #rotation angle print(atan2(out$R[1,2],out$R[1,1])*180/pi) #scale print(out$s) plot(B,xlim=c(-2000,3000),ylim=c(-2000,3000),xlab=" ",ylab=" ") lines(B[c(1:12,1),],lty=2) points(out$Bhat) lines(out$Bhat[c(1:12,1),]) title("Match juvenile onto adult") } \keyword{multivariate} shapes/man/sand.Rd0000754000176200001440000000240412054346746013541 0ustar liggesusers\name{sand} \alias{sand} \title{Sand particle outline data} \description{50 points on 24 sea sand and 25 river sand grain profiles in 2D. The original data were kindly provided by Professor Dietrich Stoyan (Stoyan and Stoyan, 1994; Stoyan, 1997). The 50 points on each outline were extracted at approximately equal arc-lengths by the method described in Kent et al. (2000, section 8.1)} \usage{data(sand)} \format{A list with components: sea$x : An array of dimension 50 x 2 x 49 containing the 50 point co-ordinates in 2D for each grain sea$group : The types of the sand grains: "sea", 24 particles from the Baltic Sea "river", 25 particles from the Caucasian River Selenchuk } \references{ Kent, J. T., Dryden, I. L. and Anderson, C. R. (2000). Using circulant symmetry to model featureless objects. Biometrika, 87, 527--544. Stoyan, D. (1997). Geometrical means, medians and variances for samples of particles. Particle Particle Syst. Charact. 14, 30--34. Stoyan, D. and Stoyan, H. (1994). Fractals, Random Shapes and Point Fields: Methods of Geometric Statistics, John Wiley, Chichester. } \examples{ data(sand) plotshapes(sand$x[,,sand$group=="sea"],sand$x[,,sand$group=="river"],joinline=c(1:50)) } \keyword{datasets} shapes/man/qset2.dat.Rd0000754000176200001440000000114613204275350014411 0ustar liggesusers\name{qset2.dat} \alias{qset2.dat} \title{Small T2 mouse vertabrae data} \description{T2 mouse vertebrae data - small group. 6 landmarks in 2 dimensions, 23 individuals } \usage{data(qset2.dat)} \format{ An array of dimension 6 x 2 x 23 } \source{ Dryden, I.L. and Mardia, K.V. (2016). Statistical Shape Analysis, with Applications in R (Second Edition). Wiley, Chichester. Chapter 1. } \references{ http://www.maths.nott.ac.uk/personal/ild/bookdata/qset2.dat Data from Paul O'Higgins (Hull-York Medical School) and David Johnson (Leeds) } \examples{ data(qset2.dat) plotshapes(qset2.dat) } \keyword{datasets} shapes/man/gorf.dat.Rd0000754000176200001440000000135413204275600014307 0ustar liggesusers\name{gorf.dat} \alias{gorf.dat} \title{Female gorilla data} \description{Female gorilla skull data. 8 landmarks in 2 dimensions, 30 individuals } \usage{data(gorf.dat)} \format{ An array of dimension 8 x 2 x 30 } \source{ Dryden, I.L. and Mardia, K.V. (2016). Statistical Shape Analysis, with Applications in R (Second Edition). Wiley, Chichester. Chapter 1. O'Higgins, P. and Dryden, I. L. (1993). Sexual dimorphism in hominoids: further studies of craniofacial shape differences in Pan, Gorilla, Pongo, Journal of Human Evolution, 24, 183-205. } \references{ http://www.maths.nott.ac.uk/personal/ild/bookdata/gorf.dat Data from Paul O'Higgins (Hull-York Medical School) } \examples{ data(gorf.dat) plotshapes(gorf.dat) } \keyword{datasets} shapes/man/apes.Rd0000754000176200001440000000206313204273311013526 0ustar liggesusers\name{apes} \alias{apes} \title{Great ape data} \description{Great ape skull landmark data. 8 landmarks in 2 dimensions, 167 individuals } \usage{data(apes)} \format{ apes$x : An array of dimension 8 x 2 x 167 apes$group : Species and sex of each specimen: "gorf" 30 female gorillas, "gorm" 29 male gorillas, "panf" 26 female chimpanzees, "pamm" 28 male chimpanzees, "pongof" 24 female orang utans, "pongom" 30 male orang utans. } \source{ Dryden, I.L. and Mardia, K.V. (2016). Statistical Shape Analysis, with applications in R (Second Edition). Wiley, Chichester. O'Higgins, P. and Dryden, I. L. (1993). Sexual dimorphism in hominoids: further studies of craniofacial shape differences in Pan, Gorilla, Pongo, Journal of Human Evolution, 24, 183-205. } \references{ Data from Paul O'Higgins (Hull-York Medical School) } \examples{ data(apes) par(mfrow=c(1,2)) plotshapes(apes$x[,,apes$group=="gorf"],symbol="f") plotshapes(apes$x[,,apes$group=="gorm"],symbol="m") } \keyword{datasets} shapes/man/shapes-internal.Rd0000744000176200001440000001275315000776434015713 0ustar liggesusers\name{shapes-internal} \alias{fastPNSe2s} \alias{fastpns_biplot} \alias{pns_biplot} \alias{pcscore2sphere3} \alias{projectPNS} \alias{fastpns} \alias{sphere1.f} \alias{rgl.sphgrid1} \alias{sph2car1} \alias{pc2sphere2} \alias{pcscore2sphere2} \alias{preshape2shape} \alias{tangentcoords.partial.inv} \alias{multiply_by_transpose_of_helmert_implicitly} \alias{multiply_by_helmert_implicitly_3d} \alias{uji3_centroid.size} \alias{uji2_centroid.size} \alias{multiply_by_transpose_of_helmert_explicitly} \alias{multiply_by_transpose_of_helmert} \alias{multiply_by_helmert_implicitly} \alias{multiply_by_helmert_explicitly} \alias{multiply_by_helmert} \alias{uji_preshape} \alias{uji_centroid.size} \alias{uji_defh} \alias{uji_Enorm} \alias{uji_distProcrustesFull} \alias{uji_distProcrustesSizeShape} \alias{uji_distCholesky} \alias{uji_estSS} \alias{uji_estShape} \alias{uji_centroid.size.complex} \alias{uji_centroid.size.mD} \alias{uji_preshape.mD} \alias{uji_preshape.mat} \alias{uji_tanfigure} \alias{uji_tanfigurefull} \alias{uji_kendall.shpv} \alias{ild_preshape} \alias{ild_centroid.size} \alias{ild_defh} \alias{ild_Enorm} \alias{ild_distProcrustesFull} \alias{ild_distProcrustesSizeShape} \alias{ild_distCholesky} \alias{ild_estSS} \alias{ild_estShape} \alias{ild_centroid.size.complex} \alias{ild_centroid.size.mD} \alias{ild_preshape.mD} \alias{ild_preshape.mat} \alias{ild_tanfigure} \alias{ild_tanfigurefull} \alias{ild_kendall.shpv} \alias{ild_preshapetoicon} \alias{Enormalize} \alias{ExpNPd} \alias{LRTpval} \alias{LogNPd} \alias{PNSe2s} \alias{PNSs2e} \alias{Plot3D} \alias{Procrustes.dist.full} \alias{UNIFORMdirections} \alias{col2RGB} \alias{flipud0} \alias{geodmeanS1} \alias{get.data.subsphere} \alias{get.prinarc} \alias{get.prinarc.subsphere} \alias{get.prinarc.value} \alias{getSubSphere} \alias{mod} \alias{objfn} \alias{pc2sphere} \alias{pcscore2sphere} \alias{plotshapes3d.pns} \alias{pns.pc} \alias{project.subsphere} \alias{randvonMisesFisherm} \alias{repmat} \alias{rot.mat} \alias{rotMat} \alias{shape.pcscores} \alias{shape.pcscores.partial} \alias{sphere.jac} \alias{sphere.obj} \alias{sphere.res} \alias{sphere2pcscore} \alias{sphereFit} \alias{tangent.coords.partial} \alias{tr} \alias{trans.subsphere} \alias{vMFtest} \alias{ped} \alias{pedreg} \alias{sooty.dat} \alias{MDSshape} \alias{distCholesky} \alias{distEuclidean} \alias{distLogEuclidean} \alias{distPowerEuclidean} \alias{distProcrustesFull} \alias{distProcrustesSizeShape} \alias{rootmat} \alias{distRiemPennec} \alias{Enorm} \alias{estChol} \alias{estShapes} \alias{estEuclid} \alias{estLogEuclid} \alias{estPowerEuclid} \alias{estLogRiem2} \alias{distRiemannianLe} \alias{estCholesky} \alias{estRiemLe} \alias{estShape} \alias{estSS} \alias{Hessian2} \alias{iglogl} \alias{Lambdamin} \alias{nsa} \alias{protein} \alias{James} \alias{select} \alias{procWGPA1} \alias{rotatexyz} \alias{objfun} \alias{objfun4} \alias{bootstraptest} \alias{testmeanshapes.old} \alias{permutationtest2} \alias{Goodall} \alias{Hotelling} \alias{abind} \alias{tpsgrid.old} \alias{shaperw} \alias{BoxM} \alias{Goodall2D} \alias{Goodalltest} \alias{Hotelling2D} \alias{Hotelling2Djames} \alias{Hotellingtest} \alias{MGM} \alias{I2mat} \alias{TPSgrid} \alias{V} \alias{Vinv} \alias{Vmat} \alias{add} \alias{as.3d} \alias{banner1} \alias{banner4} \alias{bendingenergy} \alias{bgpa} \alias{bookstein.shpv} \alias{bookstein.shpv.complex} \alias{braincon.dat} \alias{brainscz.dat} \alias{cbevec} \alias{cbevectors} \alias{centroid.size.complex} \alias{centroid.size.mD} \alias{close1} \alias{cnt3} \alias{complextoreal} \alias{defh} \alias{defplotsize2} \alias{defplotsize3} \alias{del} \alias{dif} \alias{dif.old} \alias{dis} \alias{fJ} \alias{fcel} \alias{fcnt} \alias{fgpa} \alias{fgpa.rot} \alias{fgpa.singleiteration} \alias{fopa} \alias{fort.ROTATEANDREFLECT} \alias{fort.ROTATION} \alias{fort} \alias{fos} \alias{fos.REFLECT} \alias{ftrsq} \alias{full.procdist} \alias{genpower} \alias{goodall2d} \alias{goodalltest} \alias{graf} \alias{hotelling2d} \alias{hotellingtest} \alias{isodens} \alias{isologdens} \alias{isomle} \alias{isotropy.test} \alias{kendall.shpv} \alias{linegrid} \alias{loglikeiso} \alias{loglikeiso2} \alias{loneFone} \alias{mahpreshapedist} \alias{makearray} \alias{movie} \alias{msh} \alias{norm} \alias{objfuniso} \alias{oneFone} \alias{partial.procdist} \alias{partialwarpgrids} \alias{partialwarps} \alias{permutationtest} \alias{plot2rwscores} \alias{plot3Ddata} \alias{plot3Ddata.static} \alias{plot3Dmean} \alias{plot3Dpca} \alias{plotPDM} \alias{plotPDM2} \alias{plotPDM3} \alias{plotPDMbook} \alias{plotPDMnoaxis} \alias{plotPDMnoaxis3} \alias{plotpairscores} \alias{plotpca} \alias{plotpca3d} \alias{plotprinwarp} \alias{plotproc} \alias{plotrelwarp} \alias{plotshapes3d} \alias{plotshapestime3d} \alias{pointsPDMnoaxis3} \alias{prcomp1} \alias{preshape} \alias{preshape.mD} \alias{preshape.mat} \alias{preshapetoicon} \alias{prinwscoregrids} \alias{procdistreflect} \alias{procrustes2d} \alias{procrustesGPA} \alias{procrustesGPA.rot} \alias{procrustesgpa} \alias{project} \alias{read.array} \alias{read.in} \alias{realtocomplex} \alias{reassqpr} \alias{relwarps} \alias{rgpa} \alias{riemdist.complex} \alias{riemdist.mD} \alias{rotateaxes} \alias{schizo.dat} \alias{sgpa} \alias{sh} \alias{sigmacov} \alias{sim1} \alias{st} \alias{tanfigure} \alias{tanfigurefull} \alias{tanpreshape} \alias{testshapes} \alias{vec1} \title{Internal function(s)} \description{Internal function(s)} \keyword{internal} shapes/man/sooty.Rd0000754000176200001440000000123713204275045013763 0ustar liggesusers\name{sooty} \alias{sooty} \title{Sooty mangabey data} \description{Sooty mangabey data skull data. 12 landmarks in 2 dimensions, 2 individuals (juvenile and male adult) followed by three individuals, female adult, male adult. The first entries are rotated, translated versions of the 3rd and 7th figure. } \usage{data(sooty)} \format{ An array of dimension 12 x 2 x 7 } \source{Dryden, I.L. and Mardia, K.V. (2016). Statistical Shape Analysis, with Applications in R (Second Edition). Wiley, Chichester. Chapter 1. } \references{ Data from Paul O'Higgins (Hull-York Medical School) } \examples{ data(sooty) plotshapes(sooty,joinline=c(1:12,1)) } \keyword{datasets} shapes/man/procdist.Rd0000754000176200001440000000260513204273212014427 0ustar liggesusers\name{procdist} \alias{procdist} %- Also NEED an `\alias' for EACH other topic documented here. \title{Procrustes distance} \description{Calculates different types of Procrustes shape or size-and-shape distance between two configurations} \usage{ procdist(x, y,type="full",reflect=FALSE) } %- maybe also `usage' for other objects documented here. \arguments{ \item{x}{k x m matrix (or complex k-vector for 2D data) where k = number of landmarks and m = no of dimensions} \item{y}{k x m matrix (or complex k-vector for 2D data)} \item{type}{string indicating the type of distance; "full" full Procrustes distance, "partial" partial Procrustes distance, "Riemannian" Riemannian shape distance, "sizeandshape" size-and-shape Riemannian/Procrustes distance} \item{reflect}{ Logical. If reflect = TRUE then reflection invariance is included.} } \value{ The distance between the two configurations.} \references{ Dryden, I.L. and Mardia, K.V. (2016). Statistical Shape Analysis, with applications in R (Second Edition). Wiley, Chichester. } \seealso{procOPA,procGPA} \examples{ data(gorf.dat) data(gorm.dat) gorf<-procGPA(gorf.dat) gorm<-procGPA(gorm.dat) distfull<-procdist(gorf$mshape,gorm$mshape) cat("Full Procustes distance between mean shapes is ",distfull," \n") } \author{Ian Dryden} \keyword{multivariate}% __ONLY ONE__ keyword per line shapes/man/centroid.size.Rd0000754000176200001440000000114213204273433015360 0ustar liggesusers\name{centroid.size} \alias{centroid.size} \title{Centroid size} \description{Calculate cetroid size from a configuration or a sample of configurations. } \usage{centroid.size(x)} \arguments{ \item{x}{For a single configuration k x m matrix or complex k-vector For a sample of configurations k x m x n array or k x n complex matrix } } \value{ Centroid size(s) } \references{ Dryden, I.L. and Mardia, K.V. (2016). Statistical Shape Analysis, with applications in R (Second Edition). Wiley, Chichester. } \examples{ data(mice) centroid.size(mice$x[,,1]) } \author{Ian Dryden} \keyword{multivariate} shapes/man/macaques.Rd0000754000176200001440000000134213204275477014413 0ustar liggesusers\name{macaques} \alias{macaques} \title{Male and Female macaque data} \description{Male and female macaque skull data. 7 landmarks in 3 dimensions, 18 individuals (9 males, 9 females) } \usage{data(macaques)} \format{ macaques$x : An array of dimension 7 x 3 x 18 macaques$group : A factor indicating the sex (`m' for male and `f' for female) } \source{ Dryden, I.L. and Mardia, K.V. (2016). Statistical Shape Analysis, with Applications in R (Second Edition). Wiley, Chichester. Chapter 1. } \references{ Dryden, I. L. and Mardia, K. V. (1993). Multivariate shape analysis. Sankhya Series A, 55, 460-480. Data from Paul O'Higgins (Hull-York Medical School) } \examples{ data(macaques) shapes3d(macaques$x[,,1]) } \keyword{datasets} shapes/man/gels.Rd0000754000176200001440000000073312563416154013545 0ustar liggesusers\name{gels} \alias{gels} \title{Electrophoresis gel data} \description{Electrophoresis gel data. 10 invariant spots have been picked out by an expert on two electrophoretic gels. } \usage{data(gels)} \format{ An array of dimension 10 x 2 x 2 } \source{ Dryden, I. L. and Walker, G. (1999). Highly resistant regression and object matching. Biometrics, 55, 820-825. } \references{ Data from Chris Glasbey (BioSS) } \examples{ data(gels) plotshapes(gels) } \keyword{datasets} shapes/man/rigidbody.Rd0000754000176200001440000000200011171654551014553 0ustar liggesusers\name{rigidbody} \alias{rigidbody} %- Also NEED an `\alias' for EACH other topic documented here. \title{Rigid body transformations} \description{Applies a rigid body transformations to a landmark configuration or array} \usage{ rigidbody(X,transx=0,transy=0,transz=0,thetax=0,thetay=0,thetaz=0) } %- maybe also `usage' for other objects documented here. \arguments{ \item{X}{k x m matrix, or k x m x n array where k = number of landmarks and m = no of dimensions and n is no of specimens} \item{transx}{negative shift in x-coordinates} \item{transy}{negative shift in y-coordinates} \item{transz}{negative shift in z-coordinates} \item{thetax}{Rotation about x-axis in degrees} \item{thetay}{Rotation about y-axis in degrees} \item{thetaz}{Rotation about z-axis in degrees} } \value{ The transformed coordinates (X - trans) Rx Ry Rz } \examples{ data(gorf.dat) plotshapes ( rigidbody(gorf.dat , 0, 0, 0, 0, 0, -90 ) ) } \author{Ian Dryden} \keyword{multivariate}% __ONLY ONE__ keyword per line shapes/man/pongof.dat.Rd0000754000176200001440000000106411171646262014647 0ustar liggesusers\name{pongof.dat} \alias{pongof.dat} \title{Female orang utan data} \description{Female orang utan skull data. 8 landmarks in 2 dimensions, 30 individuals } \usage{data(pongof.dat)} \format{ An array of dimension 8 x 2 x 30 } \source{ O'Higgins, P. and Dryden, I. L. (1993). Sexual dimorphism in hominoids: further studies of craniofacial shape differences in Pan, Gorilla, Pongo, Journal of Human Evolution, 24, 183-205. } \references{ Data from Paul O'Higgins (Hull-York Medical School) } \examples{ data(pongof.dat) plotshapes(pongof.dat) } \keyword{datasets} shapes/man/panf.dat.Rd0000754000176200001440000000105210706112511014264 0ustar liggesusers\name{panf.dat} \alias{panf.dat} \title{Female chimpanzee data} \description{Female chimpanzee skull data. 8 landmarks in 2 dimensions, 26 individuals } \usage{data(panf.dat)} \format{ An array of dimension 8 x 2 x 26 } \source{ O'Higgins, P. and Dryden, I. L. (1993). Sexual dimorphism in hominoids: further studies of craniofacial shape differences in Pan, Gorilla, Pongo, Journal of Human Evolution, 24, 183-205. } \references{ Data from Paul O'Higgins (Hull-York Medical School) } \examples{ data(panf.dat) plotshapes(panf.dat) } \keyword{datasets} shapes/man/pnss3d.Rd0000754000176200001440000000471514767604313014035 0ustar liggesusers\name{pnss3d} \alias{pnss3d} \title{Principal Nested Shape Space Analysis} \description{Approximation of Principal Nested Shapes Spaces using PCA: 2D or 3D data, small or large samples } \usage{ pnss3d(x,sphere.type="seq.test",mean.type="Frechet",alpha = 0.1,R = 100, nlast.small.sphere = 1,n.pc="Full",output=TRUE) } %- maybe also `usage' for other objects documented here. \arguments{ \item{x}{k x m x n array of landmark data.} \item{sphere.type}{ a character string specifying the type of sphere fitting method. "seq.test" specifies sequential tests to decide either "small" or "great"; "small" specifies Principal Nested SMALL Sphere; "great" specifies Principal Nested GREAT Sphere (radius pi/2); "BIC" specifies BIC statistic to decide either "small" or "great"; and "bi.sphere" specifies Principal Nested GREAT Sphere for the first part and Principal Nested SMALL Sphere for the last part. The default is "seq.test". } \item{mean.type}{ a character string specifying the type of circular mean calculation at the last stage. "Frechet" specifies the Frechet mean on a circle; "Fisher" specifies the Fisher mle a.k.a. resultant mean. } \item{alpha}{significance level (0 < alpha < 1) used when sphere.type = "seq.test". The default is 0.1. } \item{R}{the number of bootstrap samples to be evaluated for the sequential test. The default is 100.} \item{nlast.small.sphere}{the number of small spheres in the finishing part used when sphere.type = "bi.sphere".} \item{n.pc}{the number of PC scores to be used (n.pc >= 2). The default "Full" is to use all PCs.} \item{output}{Logical. If TRUE then plots and some brief printed summaries are given. If FALSE then no plots or output is given.} } \value{A list with components \item{PNS}{the output of the function pns} \item{GPAout}{the result of GPA} \item{spheredata}{transformed spherical data from the PC scores} \item{percent}{proportion of variances explained.} } \references{ Dryden, I.L., Kim, K., Laughton, C.A. and Le, H. (2019). Principal nested shape space analysis of molecular dynamics data. Annals of Applied Statistics, 13, 2213-2234. Jung, S., Dryden, I.L. and Marron, J.S. (2012). Analysis of principal nested spheres. Biometrika, 99, 551-568. } \author{Kwang-Rae Kim, Ian Dryden} \seealso{pns, pns4pc, plot3darcs} \examples{ ans <- pnss3d(digit3.dat, sphere.type="BIC", n.pc=5) #aa <- plot3darcs(ans,c=2,pcno=1) #bb <- plot3darcs(ans,c=2,pcno=1,type="pca") } \keyword{multivariate} shapes/man/shapes.cva.Rd0000754000176200001440000000254714035642324014647 0ustar liggesusers\name{shapes.cva} \alias{shapes.cva} %- Also NEED an `\alias' for EACH other topic documented here. \title{Canonical variate analysis for shapes} \description{Carry out canonical variate analysis for shapes (in two or more groups) } \usage{ shapes.cva(X,groups,scale=TRUE,tangentcoords = "residual",ncv=2) } %- maybe also `usage' for other objects documented here. \arguments{ \item{X}{Input k x m x n real array of the configurations, where k is the number of points, m is the number of dimensions, and n is the sample size. } \item{groups}{The group labels} \item{scale}{Logical, indicating if Procrustes scaling should be carried out} \item{tangentcoords}{The type of Procrustes tangent coordinates to use (as for procGPA)} \item{ncv}{Number of canonical variates to display} } \value{A plot if ncv=2 or 3 and the Canonical Variate Scores} \references{Dryden, I.L. and Mardia, K.V. (2016). Statistical Shape Analysis, with Applications in R (Second Edition). Wiley, Chichester.} \author{Ian Dryden} \seealso{procGPA} \examples{ #2D example : female and male apes (cf. Dryden and Mardia, 2016) data(pongof.dat) data(pongom.dat) data(panm.dat) data(panf.dat) apes <- groupstack( pongof.dat , pongom.dat , panm.dat, panf.dat ) shapes.cva( apes$x, apes$groups) } \keyword{multivariate} shapes/man/qcet2.dat.Rd0000754000176200001440000000115213204275274014373 0ustar liggesusers\name{qcet2.dat} \alias{qcet2.dat} \title{Control T2 mouse vertabrae data} \description{T2 mouse vertebrae data - control group. 6 landmarks in 2 dimensions, 30 individuals } \usage{data(qcet2.dat)} \format{ An array of dimension 6 x 2 x 30 } \source{ Dryden, I.L. and Mardia, K.V. (2016). Statistical Shape Analysis, with Applications in R (Second Edition). Wiley, Chichester. Chapter 1. } \references{ http://www.maths.nott.ac.uk/personal/ild/bookdata/qcet2.dat Data from Paul O'Higgins (Hull-York Medical School) and David Johnson (Leeds) } \examples{ data(qcet2.dat) plotshapes(qcet2.dat) } \keyword{datasets} shapes/man/qlet2.dat.Rd0000754000176200001440000000114613204275321014400 0ustar liggesusers\name{qlet2.dat} \alias{qlet2.dat} \title{Large T2 mouse vertabrae data} \description{T2 mouse vertebrae data - large group. 6 landmarks in 2 dimensions, 23 individuals } \usage{data(qlet2.dat)} \format{ An array of dimension 6 x 2 x 23 } \source{ Dryden, I.L. and Mardia, K.V. (2016). Statistical Shape Analysis, with Applications in R (Second Edition). Wiley, Chichester. Chapter 1. } \references{ http://www.maths.nott.ac.uk/personal/ild/bookdata/qlet2.dat Data from Paul O'Higgins (Hull-York Medical School) and David Johnson (Leeds) } \examples{ data(qlet2.dat) plotshapes(qlet2.dat) } \keyword{datasets} shapes/DESCRIPTION0000744000176200001440000000176715076654732013276 0ustar liggesusersPackage: shapes Title: Statistical Shape Analysis Date: 2025-10-24 Version: 1.2.8 Authors@R: person(given = "Ian", family = "Dryden", role = c("aut","cre"), email = "ian.dryden@nottingham.ac.uk") Description: Routines for the statistical analysis of landmark shapes, including Procrustes analysis, graphical displays, principal components analysis, permutation and bootstrap tests, thin-plate spline transformation grids and comparing covariance matrices. See Dryden, I.L. and Mardia, K.V. (2016). Statistical shape analysis, with Applications in R (2nd Edition), John Wiley and Sons. Imports: minpack.lm, scatterplot3d, rgl, MASS, fitdistrplus Depends: R (>= 3.5.0) License: GPL-2 URL: https://github.com/iandryden/shapes NeedsCompilation: no Packaged: 2025-10-24 10:07:06 UTC; pmzild Author: Ian Dryden [aut, cre] Maintainer: Ian Dryden Repository: CRAN Date/Publication: 2025-10-24 10:50:02 UTC